software: Added more and more
authorPhilipp Hachtmann <hachti@hachti.de>
Thu, 1 Oct 2015 17:52:51 +0000 (19:52 +0200)
committerPhilipp Hachtmann <hachti@hachti.de>
Thu, 1 Oct 2015 17:52:51 +0000 (19:52 +0200)
Signed-off-by: Philipp Hachtmann <hachti@hachti.de>
202 files changed:
sw/SPACE/SPACE.PA [new file with mode: 0644]
sw/SPACE/original-space.pal [new file with mode: 0644]
sw/SPACE/space.pal [new file with mode: 0644]
sw/SPACE/space.pal.bak [new file with mode: 0644]
sw/f4/FRTSRC/BUILD.BI [new file with mode: 0644]
sw/f4/FRTSRC/EXIT.BI [new file with mode: 0644]
sw/f4/FRTSRC/FMAIN.BI [new file with mode: 0644]
sw/f4/FRTSRC/FMAIN.OL [new file with mode: 0644]
sw/f4/FRTSRC/LINK.BI [new file with mode: 0644]
sw/f4/FRTSRC/PLOT.RA [new file with mode: 0644]
sw/f4/FRTSRC/RALF.PA [new file with mode: 0644]
sw/f4/FRTSRC/RALF.err [new file with mode: 0644]
sw/f4/FRTSRC/READ.ME [new file with mode: 0644]
sw/f4/FRTSRC/TMP.BI [new file with mode: 0644]
sw/f4/FRTSRC/abs.ra [new file with mode: 0644]
sw/f4/FRTSRC/acos.ra [new file with mode: 0644]
sw/f4/FRTSRC/adc.ra [new file with mode: 0644]
sw/f4/FRTSRC/alog.ra [new file with mode: 0644]
sw/f4/FRTSRC/alog10.ra [new file with mode: 0644]
sw/f4/FRTSRC/amax.ra [new file with mode: 0644]
sw/f4/FRTSRC/amin.ra [new file with mode: 0644]
sw/f4/FRTSRC/amod.ra [new file with mode: 0644]
sw/f4/FRTSRC/asin.ra [new file with mode: 0644]
sw/f4/FRTSRC/atan.ra [new file with mode: 0644]
sw/f4/FRTSRC/atan2.ra [new file with mode: 0644]
sw/f4/FRTSRC/cabs.ra [new file with mode: 0644]
sw/f4/FRTSRC/carith.ra [new file with mode: 0644]
sw/f4/FRTSRC/cexp.ra [new file with mode: 0644]
sw/f4/FRTSRC/chars.ra [new file with mode: 0644]
sw/f4/FRTSRC/chkeof.ra [new file with mode: 0644]
sw/f4/FRTSRC/clk8a.ra [new file with mode: 0644]
sw/f4/FRTSRC/clock.ra [new file with mode: 0644]
sw/f4/FRTSRC/clog.ra [new file with mode: 0644]
sw/f4/FRTSRC/cmplx.ra [new file with mode: 0644]
sw/f4/FRTSRC/cos.ra [new file with mode: 0644]
sw/f4/FRTSRC/cosd.ra [new file with mode: 0644]
sw/f4/FRTSRC/cosh.ra [new file with mode: 0644]
sw/f4/FRTSRC/csin.ra [new file with mode: 0644]
sw/f4/FRTSRC/csqrt.ra [new file with mode: 0644]
sw/f4/FRTSRC/dabs.ra [new file with mode: 0644]
sw/f4/FRTSRC/datan.ra [new file with mode: 0644]
sw/f4/FRTSRC/datan2.ra [new file with mode: 0644]
sw/f4/FRTSRC/date.ra [new file with mode: 0644]
sw/f4/FRTSRC/dble.ra [new file with mode: 0644]
sw/f4/FRTSRC/dcos.ra [new file with mode: 0644]
sw/f4/FRTSRC/dexp.ra [new file with mode: 0644]
sw/f4/FRTSRC/dexp3.ra [new file with mode: 0644]
sw/f4/FRTSRC/dim.ra [new file with mode: 0644]
sw/f4/FRTSRC/dlog.ra [new file with mode: 0644]
sw/f4/FRTSRC/dlog10.ra [new file with mode: 0644]
sw/f4/FRTSRC/dmax1.ra [new file with mode: 0644]
sw/f4/FRTSRC/dmin1.ra [new file with mode: 0644]
sw/f4/FRTSRC/dmod.ra [new file with mode: 0644]
sw/f4/FRTSRC/dsign.ra [new file with mode: 0644]
sw/f4/FRTSRC/dsin.ra [new file with mode: 0644]
sw/f4/FRTSRC/dsqrt.ra [new file with mode: 0644]
sw/f4/FRTSRC/exp.ra [new file with mode: 0644]
sw/f4/FRTSRC/exp3.ra [new file with mode: 0644]
sw/f4/FRTSRC/expcc.ra [new file with mode: 0644]
sw/f4/FRTSRC/expci.ra [new file with mode: 0644]
sw/f4/FRTSRC/expdd.ra [new file with mode: 0644]
sw/f4/FRTSRC/expdi.ra [new file with mode: 0644]
sw/f4/FRTSRC/expdr.ra [new file with mode: 0644]
sw/f4/FRTSRC/expic.ra [new file with mode: 0644]
sw/f4/FRTSRC/expid.ra [new file with mode: 0644]
sw/f4/FRTSRC/expid2.ra [new file with mode: 0644]
sw/f4/FRTSRC/expii.ra [new file with mode: 0644]
sw/f4/FRTSRC/expir.ra [new file with mode: 0644]
sw/f4/FRTSRC/f4.pa [new file with mode: 0644]
sw/f4/FRTSRC/fcomp.bi [new file with mode: 0644]
sw/f4/FRTSRC/float.ra [new file with mode: 0644]
sw/f4/FRTSRC/idint.ra [new file with mode: 0644]
sw/f4/FRTSRC/ifix.ra [new file with mode: 0644]
sw/f4/FRTSRC/libra.pa [new file with mode: 0644]
sw/f4/FRTSRC/load.pa [new file with mode: 0644]
sw/f4/FRTSRC/ltr.ra [new file with mode: 0644]
sw/f4/FRTSRC/onqib.ra [new file with mode: 0644]
sw/f4/FRTSRC/p2ocfg.pa [new file with mode: 0644]
sw/f4/FRTSRC/pass2.pa [new file with mode: 0644]
sw/f4/FRTSRC/pass3.pa [new file with mode: 0644]
sw/f4/FRTSRC/pause.ra [new file with mode: 0644]
sw/f4/FRTSRC/real.ra [new file with mode: 0644]
sw/f4/FRTSRC/realtm.ra [new file with mode: 0644]
sw/f4/FRTSRC/rfcv.ra [new file with mode: 0644]
sw/f4/FRTSRC/rfdv.ra [new file with mode: 0644]
sw/f4/FRTSRC/rsw.ra [new file with mode: 0644]
sw/f4/FRTSRC/rtl.pa [new file with mode: 0644]
sw/f4/FRTSRC/rts.pa [new file with mode: 0644]
sw/f4/FRTSRC/sign.ra [new file with mode: 0644]
sw/f4/FRTSRC/sin.ra [new file with mode: 0644]
sw/f4/FRTSRC/sind.ra [new file with mode: 0644]
sw/f4/FRTSRC/sinh.ra [new file with mode: 0644]
sw/f4/FRTSRC/sngl.ra [new file with mode: 0644]
sw/f4/FRTSRC/sqrt.ra [new file with mode: 0644]
sw/f4/FRTSRC/tan.ra [new file with mode: 0644]
sw/f4/FRTSRC/tand.ra [new file with mode: 0644]
sw/f4/FRTSRC/tanh.ra [new file with mode: 0644]
sw/f4/FRTSRC/xfix.ra [new file with mode: 0644]
sw/images/hachti/d [new file with mode: 0644]
sw/images/hachti/system_museumsnacht_2010.rk [new file with mode: 0644]
sw/os8/v3d/dsk.rk [new file with mode: 0644]
sw/os8/v3d/ready_to_use.rk [new file with mode: 0644]
sw/os8/v3d/sources/fortran/dectapes/dectape2/tand.ra [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/README [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape1/ASR33.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape1/C2BOOT.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape1/CREF.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape1/EPIC.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape1/FLOAT.SB [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape1/LIBSET.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape1/LOADER.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape1/README [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape1/RK08NS.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape1/RK08SY.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape1/SRCCOM.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape1/TD8EA.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape1/TD8EB.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape1/TD8EC.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape1/TD8ED.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape2/BAT.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape2/DF32NS.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape2/DF32SY.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape2/FORT.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape2/FPATCH.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape2/README [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape2/RF08SY.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape2/RK8ESY.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape2/SABR.CO [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape2/SABR.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape2/SPATCH.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/ATAN.SB [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/BITMAP.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/C3BOOT.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/CD.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/CR8E.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/CS.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/DUMP.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/INTEGR.SB [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/IOH.SB [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/IOPEN.SB [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/IPOWRS.SB [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/L645.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/LINCNS.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/LINCSY.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/LPSV.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/LSPT.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/POWERS.SB [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/PT8E.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/README [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/RF08NS.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/RK8ENS.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/ROMMSY.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/RWTAPE.SB [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/RX01SY.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/SQRT.SB [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/TC08NS.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/TC08SY.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/TD8ESY.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/TDCOPY.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/TDINIT.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/TM8E.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/TRIG.SB [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/UTILTY.SB [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/VR12.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape3/VT50.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape4/BUILD.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape4/DTFRMT.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape4/KL8E.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape4/LQP.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape4/PIP.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape4/README [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape4/RX01NS.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape4/RX78B.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape4/RXCOPY.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape4/TDFRMT.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape5/CCL.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape5/DTCOPY.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape5/HELP.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape5/README [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape5/RKLFMT.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape5/SET.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape6/BOOT.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape6/CAMP.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape6/DIRECT.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape6/MCPIP.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape6/PAL8.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape6/README [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape6/RESORC.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape7/EDIT.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape7/FOTP.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape7/HELP78.HL [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape7/HELP8.HL [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape7/OS8.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape7/PIP10.PA [new file with mode: 0644]
sw/os8/v3d/sources/system/dectapes/dectape7/README [new file with mode: 0644]
sw/plot_standalone/PLOT.FT [new file with mode: 0644]
sw/plot_standalone/PLOT2.FT [new file with mode: 0644]
sw/plot_standalone/PLOT3.FT [new file with mode: 0644]
sw/plot_standalone/PLOT4.FT [new file with mode: 0644]
sw/tools/BINSTA.PA [new file with mode: 0644]
sw/tools/BLDR.PA [new file with mode: 0644]
sw/tools/KERMIT.PA [new file with mode: 0644]

diff --git a/sw/SPACE/SPACE.PA b/sw/SPACE/SPACE.PA
new file mode 100644 (file)
index 0000000..8543c5a
--- /dev/null
@@ -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 (file)
index 0000000..2d216a4
--- /dev/null
@@ -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.
+/
+
+\f
+
+/      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
+
+\f/
+/      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
+
+\f
+/
+/      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
+
+\f
+/
+/      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
+
+\f
+/
+/      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
+
+\f
+/
+/      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
+
+\f
+/
+/      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
+
+\f
+
+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
+
+\f
+
+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
+
+\f
+/
+/      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
+
+\f
+
+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
+
+\f
+
+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
+
+\f
+/
+/      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
+
+\f
+
+       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
+
+\f
+
+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
+
+\f
+/
+/      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
+
+\f
+
+       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
+
+\f
+
+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
+
+\f
+/
+/      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
+
+\f
+
+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
+
+\f
+/
+/      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
+
+\f
+/
+/      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
+
+\f/
+/      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
+
+\f
+
+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
+
+\f
+/
+/      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
+
+\f
+
+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
+
+\f
+/
+/      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
+\f
+/
+/      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
+
+\f
+
+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
+\f
+
+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
+
+\f
+/
+/      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
+
+
+\f
+/
+/      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
+
+\f
+/
+/      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
+
+\f
+/
+/      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
+
+\f
+
+SINARG,        0
+SINPSH,        SINLST
+SINLST,        0
+       0
+       0
+       0
+       0
+       0
+
+SINTAB,        SINES-1
+
+COSINI,        0
+       CIA
+       TAD P132
+       JMS SINEIN
+       JMP I COSINI
+
+\f
+
+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
+
+\f
+
+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
+
+\f
+/
+/      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
+
+\f
+       *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
+\f      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
+\f      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
+/
+\f
+/
+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
+
+\f
+/
+/      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
+
+\f
+       *7400
+
+DISBUF,        0
+
+/      THE DISPLAY BUFFERS BEGIN HERE AND EXTEND UP SOMEWHERE TO
+/      AROUND 7575 OR SO.
+/
+/
+/
+/
+/
+
+\f
+
+        $
+
+////////////////////////////
+/
+/       THIS IS THE END
+/
+///////////////////////////
+
+
+
+
+
+\f
\ No newline at end of file
diff --git a/sw/SPACE/space.pal b/sw/SPACE/space.pal
new file mode 100644 (file)
index 0000000..a604b28
--- /dev/null
@@ -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 (file)
index 0000000..120029c
--- /dev/null
@@ -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
+
+\f
+/
+/      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
+
+\f
+/
+/      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
+
+\f
+
+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
+
+\f
+
+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
+
+\f
+/
+/      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
+
+\f
+
+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
+
+\f
+
+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
+
+\f
+/
+/      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
+
+\f
+
+       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
+
+\f
+
+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
+
+\f
+/
+/      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
+
+\f
+
+       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
+
+\f
+
+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
+
+\f
+/
+/      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
+
+\f
+
+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
+
+\f
+/
+/      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
+
+\f
+/
+/      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
+
+\f/
+/      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
+
+\f
+/
+/      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
+
+\f
+
+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
+
+\f
+/
+/      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
+\f
+/
+/      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
+
+\f
+
+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
+\f
+
+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
+
+\f
+/
+/      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
+
+
+\f
+/
+/      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
+
+\f
+/
+/      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
+
+\f
+/
+/      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
+
+\f
+
+SINARG,        0
+SINPSH,        SINLST
+SINLST,        0
+       0
+       0
+       0
+       0
+       0
+
+SINTAB,        SINES-1
+
+COSINI,        0
+       CIA
+       TAD P132
+       JMS SINEIN
+       JMP I COSINI
+
+\f
+
+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
+
+\f
+
+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
+
+\f
+/
+/      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
+\f      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
+/
+\f
+/
+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
+
+\f
+/
+/      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
+
+\f
+       *7400
+
+DISBUF,        0
+
+/      THE DISPLAY BUFFERS BEGIN HERE AND EXTEND UP SOMEWHERE TO
+/      AROUND 7575 OR SO.
+/
+/
+/
+/
+/
+
+\f
+
+        $
+
+////////////////////////////
+/
+/       THIS IS THE END
+/
+///////////////////////////
+
+
+
+
+
+\f
\ No newline at end of file
diff --git a/sw/f4/FRTSRC/BUILD.BI b/sw/f4/FRTSRC/BUILD.BI
new file mode 100644 (file)
index 0000000..148a20f
--- /dev/null
@@ -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:<FMAIN.BI
+
+/ CHAIN INTO IT
+.SUBMIT SYS:FMAIN.BI
diff --git a/sw/f4/FRTSRC/EXIT.BI b/sw/f4/FRTSRC/EXIT.BI
new file mode 100644 (file)
index 0000000..4a7f8dc
--- /dev/null
@@ -0,0 +1,25 @@
+$JOB FORTRAN IV BUILD - FINAL CLEANUP
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/ 
+/ FINAL CLEANUP
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+.DELETE SYS:FMAIN.BI
+.SQUISH SYS:/O
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/ 
+/ FINISH!
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+$END
diff --git a/sw/f4/FRTSRC/FMAIN.BI b/sw/f4/FRTSRC/FMAIN.BI
new file mode 100644 (file)
index 0000000..8bd11c3
--- /dev/null
@@ -0,0 +1,230 @@
+$JOB FORTRAN IV BUILD - MAIN PART
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/ 
+/ PAL-8 ASSEMBLY
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/ *******************************************************************
+/ FORTRAN IV COMPILER, PASS 1
+/ *******************************************************************
+/
+.PAL F4
+.LOAD F4
+.SAVE SYS F4=0;12200
+.DELETE F4.BN
+/
+/ *******************************************************************
+/ FORTRAN IV COMPILER, PASS 2
+/ *******************************************************************
+/
+.PAL PASS2
+.LOAD PASS2
+.SAVE SYS PASS2=0;5000
+.DELETE PASS2.BN
+/
+/ *******************************************************************
+/ FORTRAN IV COMPILER, PASS 2 OVERLAY
+/ *******************************************************************
+/
+.PAL PASS2O<P2OCFG,PASS2
+.LOAD PASS2O
+.SAVE SYS PASS2O=0;7605
+.DELETE PASS2O.BN
+/
+/ *******************************************************************
+/ FORTRAN IV COMPILER, PASS 3
+/ *******************************************************************
+/
+.PAL PASS3
+.LOAD PASS3
+.SAVE SYS PASS3=0;400
+.DELETE PASS3.BN
+/
+/ *******************************************************************
+/ RALF ASSEMBLER
+/ *******************************************************************
+/
+.PAL RALF/W
+.LOAD RALF
+.SAVE SYS RALF.SV=0;200
+.DELETE RALF.BN
+/
+/ *******************************************************************
+/ FORTRAN IV LIBRARIAN
+/ *******************************************************************
+/
+.PAL LIBRA
+.LOAD LIBRA
+.SAVE SYS LIBRA=0;200
+.DELETE LIBRA.BN
+/
+/ *******************************************************************
+/ LINKING LOADER
+/ *******************************************************************
+/
+.PAL LOAD
+.LOAD LOAD
+.SAVE SYS LOAD=0;200
+.DELETE LOAD.BN
+/
+/ *******************************************************************
+/ FORTRAN IV RUNTIME SYSTEM
+/ *******************************************************************
+/
+.PAL FRTS<RTS,RTL
+.LOAD FRTS
+.SAVE SYS FRTS=0;200
+.DELETE FRTS.BN
+/
+/ SQUISHING.
+.SQUISH DSK:/O
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/ 
+/ RALF LIBRARY ASSEMBLY
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/
+.COMPILE ABS.RA
+.COMPILE ACOS.RA
+.COMPILE ADC.RA
+.COMPILE ALOG10.RA
+.COMPILE ALOG.RA
+.COMPILE AMAX.RA
+.COMPILE AMIN.RA
+.COMPILE AMOD.RA
+.COMPILE ASIN.RA
+.COMPILE ATAN2.RA
+.COMPILE ATAN.RA
+.COMPILE CABS.RA
+.COMPILE CARITH.RA
+.COMPILE CEXP.RA
+.COMPILE CHARS.RA
+.COMPILE CHKEOF.RA
+/.COMPILE CLK8A.RA
+.COMPILE CLOCK.RA/8
+.COMPILE CLOG.RA
+.COMPILE CMPLX.RA
+.COMPILE COSD.RA
+.COMPILE COSH.RA
+.COMPILE COS.RA
+.COMPILE CSIN.RA
+.COMPILE CSQRT.RA
+.COMPILE DABS.RA
+.COMPILE DATAN2.RA
+.COMPILE DATAN.RA
+.COMPILE DATE.RA
+.COMPILE DBLE.RA
+.COMPILE DCOS.RA
+.COMPILE DEXP3.RA
+.COMPILE DEXP.RA
+.COMPILE DIM.RA
+.COMPILE DLOG10.RA
+.COMPILE DLOG.RA
+.COMPILE DMAX1.RA
+.COMPILE DMIN1.RA
+.COMPILE DMOD.RA
+.COMPILE DSIGN.RA
+.COMPILE DSIN.RA
+.COMPILE DSQRT.RA
+.COMPILE EXP3.RA
+.COMPILE EXPCC.RA
+.COMPILE EXPCI.RA
+.COMPILE EXPDD.RA
+.COMPILE EXPDI.RA
+.COMPILE EXPDR.RA
+.COMPILE EXPIC.RA
+.COMPILE EXPID2.RA
+.COMPILE EXPID.RA
+.COMPILE EXPII.RA
+.COMPILE EXPIR.RA
+.COMPILE EXP.RA
+.COMPILE FLOAT.RA
+.COMPILE IDINT.RA
+.COMPILE IFIX.RA
+.COMPILE LTR.RA
+.COMPILE ONQIB.RA
+.COMPILE PAUSE.RA
+.COMPILE PLOT.RA/8
+.COMPILE REAL.RA
+.COMPILE REALTM.RA/8
+.COMPILE RFCV.RA
+.COMPILE RFDV.RA
+.COMPILE RSW.RA
+.COMPILE SIGN.RA
+.COMPILE SIND.RA
+.COMPILE SINH.RA
+.COMPILE SIN.RA
+.COMPILE SNGL.RA
+.COMPILE SQRT.RA
+.COMPILE TAND.RA
+.COMPILE TANH.RA
+.COMPILE TAN.RA
+.COMPILE XFIX.RA
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/ 
+/ LIBRARY BUILD
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/
+.R LIBRA
+*SYS:FORLIB.RL[20]/Z<ABS,ACOS,ADC,ALOG10/C
+*<ALOG,AMAX,AMIN,AMOD/C
+*<ASIN,ATAN2,ATAN,CABS/C
+*<CARITH,CEXP,CHARS,CHKEOF/C
+*<CLOCK,CLOG,CMPLX/C
+*<COSD,COSH,COS,CSIN,CSQRT/C
+*<DABS,DATAN2,DATAN,DATE/C
+*<DBLE,DCOS,DEXP3,DEXP/C
+*<DIM,DLOG10,DLOG,DMAX1/C
+*<DMIN1,DMOD,DSIGN,DSIN/C
+*<DSQRT,EXP3,EXPCC,EXPCI/C
+*<EXPDD,EXPDI,EXPDR,EXPIC,EXPID2/C
+*<EXPID,EXPII,EXPIR,EXP/C
+*<FLOAT,IDINT,IFIX,LTR,ONQIB/C
+*<PAUSE,PLOT,REAL,REALTM/C
+*<RFCV,RFDV,RSW,SIGN/C
+*<SIND,SINH,SNGL,SIN,SQRT/C
+*<TAND,TANH,TAN,XFIX=200$
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/ 
+/ END OF JOB!
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/ CHAIN BACK TO DSK:
+.SUBMIT DSK:EXIT.BI
+
+
+
+
+
+
+
+
+
+
diff --git a/sw/f4/FRTSRC/FMAIN.OL b/sw/f4/FRTSRC/FMAIN.OL
new file mode 100644 (file)
index 0000000..8a590f4
--- /dev/null
@@ -0,0 +1,326 @@
+$JOB FORTRAN IV BUILD - MAIN PART
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/ 
+/ PAL-8 ASSEMBLY
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/ *******************************************************************
+/ FORTRAN IV COMPILER, PASS 1
+/ *******************************************************************
+/
+.PAL F4
+.LOAD F4
+.SAVE SYS F4=0;12200
+.DELETE F4.BN
+/
+/ *******************************************************************
+/ FORTRAN IV COMPILER, PASS 2
+/ *******************************************************************
+/
+.PAL PASS2
+.LOAD PASS2
+.SAVE SYS PASS2=0;5000
+.DELETE PASS2.BN
+/
+/ *******************************************************************
+/ FORTRAN IV COMPILER, PASS 2 OVERLAY
+/ *******************************************************************
+/
+.PAL PASS2O<P2OCFG,PASS2
+.LOAD PASS2O
+.SAVE SYS PASS2O=0;7605
+.DELETE PASS2O.BN
+/
+/ *******************************************************************
+/ FORTRAN IV COMPILER, PASS 3
+/ *******************************************************************
+/
+.PAL PASS3
+.LOAD PASS3
+.SAVE SYS PASS3=0;400
+.DELETE PASS3.BN
+/
+/ *******************************************************************
+/ RALF ASSEMBLER
+/ *******************************************************************
+/
+.R PAL8
+.PAL RALF/W
+.LOAD RALF
+.SAVE SYS RALF.SV=0;200
+.DELETE RALF.BN
+/
+/ *******************************************************************
+/ FORTRAN IV LIBRARIAN
+/ *******************************************************************
+/
+.PAL LIBRA
+.LOAD LIBRA
+.SAVE SYS LIBRA=0;200
+.DELETE LIBRA.BN
+/
+/ *******************************************************************
+/ LINKING LOADER
+/ *******************************************************************
+/
+.PAL LOAD
+.LOAD LOAD
+.SAVE SYS LOAD=0;200
+.DELETE LOAD.BN
+/
+/ *******************************************************************
+/ FORTRAN IV RUNTIME SYSTEM
+/ *******************************************************************
+/
+.PAL FRTS<RTS,RTL
+.LOAD FRTS
+.SAVE SYS FRTS=0;200
+.DELETE FRTS.BN
+/
+/ SQUISHING.
+.SQUISH DSK:/O
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/ 
+/ 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<ABS.RA/A
+*ACOS.RA<ACOS.RA/A
+*ADC.RA<ADC.RA/A
+*ALOG10.RA<ALOG10.RA/A
+*ALOG.RA<ALOG.RA/A
+*AMAX.RA<AMAX.RA/A
+*AMIN.RA<AMIN.RA/A
+*AMOD.RA<AMOD.RA/A
+*ASIN.RA<ASIN.RA/A
+*ATAN2.RA<ATAN2.RA/A
+*ATAN.RA<ATAN.RA/A
+*CABS.RA<CABS.RA/A
+*CARITH.RA<CARITH.RA/A
+*CEXP.RA<CEXP.RA/A
+*CHARS.RA<CHARS.RA/A
+*CHKEOF.RA<CHKEOF.RA/A
+*CLK8A.RA<CLK8A.RA/A
+*CLOCK.RA<CLOCK.RA/A
+*CLOG.RA<CLOG.RA/A
+*CMPLX.RA<CMPLX.RA/A
+*COSD.RA<COSD.RA/A
+*COSH.RA<COSH.RA/A
+*COS.RA<COS.RA/A
+*CSIN.RA<CSIN.RA/A
+*CSQRT.RA<CSQRT.RA/A
+*DABS.RA<DABS.RA/A
+*DATAN2.RA<DATAN2.RA/A
+*DATAN.RA<DATAN.RA/A
+*DATE.RA<DATE.RA/A
+*DBLE.RA<DBLE.RA/A
+*DCOS.RA<DCOS.RA/A
+*DEXP3.RA<DEXP3.RA/A
+*DEXP.RA<DEXP.RA/A
+*DIM.RA<DIM.RA/A
+*DLOG10.RA<DLOG10.RA/A
+*DLOG.RA<DLOG.RA/A
+*DMAX1.RA<DMAX1.RA/A
+*DMIN1.RA<DMIN1.RA/A
+*DMOD.RA<DMOD.RA/A
+*DSIGN.RA<DSIGN.RA/A
+*DSIN.RA<DSIN.RA/A
+*DSQRT.RA<DSQRT.RA/A
+*EXP3.RA<EXP3.RA/A
+*EXPCC.RA<EXPCC.RA/A
+*EXPCI.RA<EXPCI.RA/A
+*EXPDD.RA<EXPDD.RA/A
+*EXPDI.RA<EXPDI.RA/A
+*EXPDR.RA<EXPDR.RA/A
+*EXPIC.RA<EXPIC.RA/A
+*EXPID2.RA<EXPID2.RA/A
+*EXPID.RA<EXPID.RA/A
+*EXPII.RA<EXPII.RA/A
+*EXPIR.RA<EXPIR.RA/A
+*EXP.RA<EXP.RA/A
+*FLOAT.RA<FLOAT.RA/A
+*IDINT.RA<IDINT.RA/A
+*IFIX.RA<IFIX.RA/A
+*LTR.RA<LTR.RA/A
+*ONQIB.RA<ONQIB.RA/A
+*PAUSE.RA<PAUSE.RA/A
+*PLOT.RA<PLOT.RA/A
+*REAL.RA<REAL.RA/A
+*REALTM.RA<REALTM.RA/A
+*RFCV.RA<RFCV.RA/A
+*RFDV.RA<RFDV.RA/A
+*RSW.RA<RSW.RA/A
+*SIGN.RA<SIGN.RA/A
+*SIND.RA<SIND.RA/A
+*SINH.RA<SINH.RA/A
+*SNGL.RA<SNGL.RA/A
+*SQRT.RA<SQRT.RA/A
+*TAND.RA<TAND.RA/A
+*TANH.RA<TANH.RA/A
+*TAN.RA<TAN.RA/A
+*XFIX.RA<XFIX.RA/A$
+/
+/ SQUISHING.
+.SQUISH DSK:/O
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/ 
+/ RALF LIBRARY ASSEMBLY
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/
+.COMPILE ABS.RA
+.COMPILE ACOS.RA
+.COMPILE ADC.RA
+.COMPILE ALOG10.RA
+.COMPILE ALOG.RA
+.COMPILE AMAX.RA
+.COMPILE AMIN.RA
+.COMPILE AMOD.RA
+.COMPILE ASIN.RA
+.COMPILE ATAN2.RA
+.COMPILE ATAN.RA
+.COMPILE CABS.RA
+.COMPILE CARITH.RA
+.COMPILE CEXP.RA
+.COMPILE CHARS.RA
+.COMPILE CHKEOF.RA
+/.COMPILE CLK8A.RA
+.COMPILE CLOCK.RA
+.COMPILE CLOG.RA
+.COMPILE CMPLX.RA
+.COMPILE COSD.RA
+.COMPILE COSH.RA
+.COMPILE COS.RA
+.COMPILE CSIN.RA
+.COMPILE CSQRT.RA
+.COMPILE DABS.RA
+.COMPILE DATAN2.RA
+.COMPILE DATAN.RA
+.COMPILE DATE.RA
+.COMPILE DBLE.RA
+.COMPILE DCOS.RA
+.COMPILE DEXP3.RA
+.COMPILE DEXP.RA
+.COMPILE DIM.RA
+.COMPILE DLOG10.RA
+.COMPILE DLOG.RA
+.COMPILE DMAX1.RA
+.COMPILE DMIN1.RA
+.COMPILE DMOD.RA
+.COMPILE DSIGN.RA
+.COMPILE DSIN.RA
+.COMPILE DSQRT.RA
+.COMPILE EXP3.RA
+.COMPILE EXPCC.RA
+.COMPILE EXPCI.RA
+.COMPILE EXPDD.RA
+.COMPILE EXPDI.RA
+.COMPILE EXPDR.RA
+.COMPILE EXPIC.RA
+.COMPILE EXPID2.RA
+.COMPILE EXPID.RA
+.COMPILE EXPII.RA
+.COMPILE EXPIR.RA
+.COMPILE EXP.RA
+.COMPILE FLOAT.RA
+.COMPILE IDINT.RA
+.COMPILE IFIX.RA
+.COMPILE LTR.RA
+.COMPILE ONQIB.RA
+.COMPILE PAUSE.RA
+.COMPILE PLOT.RA
+.COMPILE REAL.RA
+.COMPILE REALTM.RA
+.COMPILE RFCV.RA
+.COMPILE RFDV.RA
+.COMPILE RSW.RA
+.COMPILE SIGN.RA
+.COMPILE SIND.RA
+.COMPILE SINH.RA
+.COMPILE SIN.RA
+.COMPILE SNGL.RA
+.COMPILE SQRT.RA
+.COMPILE TAND.RA
+.COMPILE TANH.RA
+.COMPILE TAN.RA
+.COMPILE XFIX.RA
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/ 
+/ LIBRARY BUILD
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/
+.R LIBRA
+*SYS:FORLIB.RL[20]/Z<ABS,ACOS,ADC,ALOG10/C
+*<ALOG,AMAX,AMIN,AMOD/C
+*<ASIN,ATAN2,ATAN,CABS/C
+*<CARITH,CEXP,CHARS,CHKEOF/C
+*<CLOCK,CLOG,CMPLX/C
+*<COSD,COSH,COS,CSIN,CSQRT/C
+*<DABS,DATAN2,DATAN,DATE/C
+*<DBLE,DCOS,DEXP3,DEXP/C
+*<DIM,DLOG10,DLOG,DMAX1/C
+*<DMIN1,DMOD,DSIGN,DSIN/C
+*<DSQRT,EXP3,EXPCC,EXPCI/C
+*<EXPDD,EXPDI,EXPDR,EXPIC,EXPID2/C
+*<EXPID,EXPII,EXPIR,EXP/C
+*<FLOAT,IDINT,IFIX,LTR,ONQIB/C
+*<PAUSE,PLOT,REAL,REALTM/C
+*<RFCV,RFDV,RSW,SIGN/C
+*<SIND,SINH,SNGL,SQRT/C
+*<TAND,TANH,TAN,XFIX=200$
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/ 
+/ END OF JOB!
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/ CHAIN BACK TO DSK:
+.SUBMIT DSK:EXIT.BI
+
+
+
+
+
+
+
+
+
+
diff --git a/sw/f4/FRTSRC/LINK.BI b/sw/f4/FRTSRC/LINK.BI
new file mode 100644 (file)
index 0000000..e2bfbed
--- /dev/null
@@ -0,0 +1,53 @@
+$JOB FORTRAN IV BUILD - LIBRARY BUILD ONLY
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/ 
+/ LIBRARY BUILD
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/
+.R LIBRA
+*SYS:FORLIB.RL[20]/Z<ABS,ACOS,ADC,ALOG10/C
+*<ALOG,AMAX,AMIN,AMOD/C
+*<ASIN,ATAN2,ATAN,CABS/C
+*<CARITH,CEXP,CHARS,CHKEOF/C
+*<CLOCK,CLOG,CMPLX/C
+*<COSD,COSH,COS,CSIN,CSQRT/C
+*<DABS,DATAN2,DATAN,DATE/C
+*<DBLE,DCOS,DEXP3,DEXP/C
+*<DIM,DLOG10,DLOG,DMAX1/C
+*<DMIN1,DMOD,DSIGN,DSIN/C
+*<DSQRT,EXP3,EXPCC,EXPCI/C
+*<EXPDD,EXPDI,EXPDR,EXPIC,EXPID2/C
+*<EXPID,EXPII,EXPIR,EXP/C
+*<FLOAT,IDINT,IFIX,LTR,ONQIB/C
+*<PAUSE,PLOT,REAL,REALTM/C
+*<RFCV,RFDV,RSW,SIGN/C
+*<SIND,SINH,SNGL,SIN,SQRT/C
+*<TAND,TANH,TAN,XFIX=200$
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/ 
+/ END OF JOB!
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+$END
+
+
+
+
+
+
+
+
+
diff --git a/sw/f4/FRTSRC/PLOT.RA b/sw/f4/FRTSRC/PLOT.RA
new file mode 100644 (file)
index 0000000..bbd91a5
--- /dev/null
@@ -0,0 +1,268 @@
+/
+/ VERSION 5A 4-27-77  PT
+/
+       LINC=6141
+       PDP=2
+       DIS=140
+       COMMZ   #PAGE0          /STANDARD PAGE 0
+       ORG     17
+       0                       /ALPHA REG FOR PDP-12
+       ENTRY   #DISP           /THIS IS SO #PAGE0 CAN BE LOADED
+#DISP,
+DISPLY,        0
+       TAD     BUFADR+2        /GET BUFFER ADDRESS
+       DCA     BUFADR
+       TAD     DBFLD           /SET UP CHANGABLE CDF
+       DCA     FLDDB
+DBFLD, HLT                     /GO TO FIRST FIELD OF BUFFER
+       TAD     PLTXR+4         /NUMBER OF POINTS
+       CMA
+       DCA     NPTS            /NEGATED
+       JMP     ENDDL           /BEGIN DISPLAY
+DSPLUP,                                /START OF DISPLAY LOOP
+       IFSW    8 <
+       TAD%    BUFADR          /GET X VALUE
+       6053                    /LOAD X DISPLACEMENT
+       CLA
+       ISZ     BUFADR          /BUMP ADDRESS
+       SKP CLA
+       JMS     BUMPF           /BUMP FIELD
+       TAD%    BUFADR
+       6054                    /LOAD Y DISPLACEMENT
+       CLA
+       ISZ     BUFADR          /INCR ADDRESS
+       SKP CLA
+       JMS     BUMPF           /INCR FIELD
+       6052                    /SKIP ON BEAM POSITIONED
+       JMP     .-1
+       6055                    /INTENSIFY POINT
+       >
+       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
+\f      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
+\f      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
+\f      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
+\f      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
+\f
diff --git a/sw/f4/FRTSRC/RALF.PA b/sw/f4/FRTSRC/RALF.PA
new file mode 100644 (file)
index 0000000..5b3d399
--- /dev/null
@@ -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.
+/
+/
+/
+/
+/
+/
+\f/     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    <RALF=1 /GO RELOCATABLE THEN>
+/
+/      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       /\ fTEMP 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       >
+\fBASER,        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
+\fLPAGE1,       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
+\f/
+/      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
+\fRDLOOP, 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
+\fFORMFD,       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
+\f/
+/      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
+\f/
+/      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
+\f/
+/      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
+\fTRYEQU, 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
+\fTRYBLK,       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
+\f/
+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    </IF EXPVAL IS RELOCATABLE,
+RELERR, 0              /GIVE ERROR MESSAGE
+       TAD     EXPVAL+1 /CAUTION: THIS ROUTINE IS
+                       /SOMETIMES CALLED WITH NON-ZERO AC
+       AND     [7770   /JUST ESD BITS
+       SNA CLA
+       JMP I   RELERR  /ITS ABSOLUTELY FINE
+       TAD     EXPVAL+1
+       AND     [7      /REMOVE ESD
+       DCA     EXPVAL+1
+       JMS I   [ERMSG
+       2205            /*RE*
+       JMP I   RELERR  >
+/
+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
+\fFPMRL,        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
+\fFPPS5,        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
+\f/
+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>
+\fFPPS4,        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
+       >
+\fGETADR,       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
+\f      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
+\f/
+/      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
+\f/
+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
+\f/
+/      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>
+\fNOTDOT, 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
+\fADR,    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
+\fUNDEF,        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
+\fADRADD,       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 >
+\fADRAND,       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
+/
+\fADRMUL,       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
+\fDIVERR, JMS I   [ERMSG
+        0626            /*DV*
+        JMP I   (OPR8R  /CONTINUE
+\fPDPOPR,       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
+\f        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
+\fISP0,   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
+\fNEWLIT,       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    />
+\f/
+/      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
+\f/
+/      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*
+\f/
+/      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
+\fNODGT,        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
+\f/
+/      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
+\f/
+/      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
+\f/
+/      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
+\f/
+/      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
+\f/
+/      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
+\f/
+/      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
+\f/
+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
+\f/
+/      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 >
+\f/
+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!>
+\fPRNTST, 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
+\f      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  >
+\f/
+/      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
+\f/
+/      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
+\f/
+/       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
+\f        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
+\fDMPLIT, 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 >
+\fEXPON,        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 /  >
+\f      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
+\f/
+/      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
+\fBORG, 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
+\fNEWESD,       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
+\f/
+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
+\f/
+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    />
+\f/
+/      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
+\f/
+/      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
+\fIFSWX,        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
+
+       
+\f      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
+\fOOPEN,        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
+\f/
+/      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
+\fFULCHK,       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
+\f/     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
+\fLOOKP,        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
+\fCLEAR,        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
+\f      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
+\fNORM, 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
+\fFMPTEN,       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
+\f      PAGE
+\f      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    />
+\f/
+/       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>
+\fOKBIN,        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
+\f      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
+\f/
+/      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
+\f      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"
+\f      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
+\fLDADR,        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
+\fSTPRNT, 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
+\fNXTBKT,       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
+\f/     PAGE 0 LITERALS
+       FIELD   1
+       *10000
+\f/
+/      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
+\f/
+/      BUCKETS FOR USER-DEFINED SYMBOLS
+/      AND PDP8 OPERATES AND IOTS
+/
+       PNDL
+       ZBLOCK 33
+\f/
+/      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
+\fAL,   .+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        >
+\fDL,   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  >
+\fFL,   .+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
+\f      .+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
+\f      .+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
+\f      .+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
+\fGL=   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    <TRUE>
+       IFNZRO  RALF    <FALSE>
+       .+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
+\f      .+5             /IFPOS
+       0620;1723
+       PSUDO
+       IFPOSX
+       .+5             /IFRALF
+       0622;0114
+       PSUDO+0600
+       IFNZRO  RALF    <TRUE>
+       IFZERO  RALF    <FALSE>
+       .+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       >
+\fJL,   .+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       >
+\f      .+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
+\fML=   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    <PL=0   >
+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
+\fSL,   .+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
+\fTL,   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
+\fUL=   0
+VL=    0
+WL=    0
+XL,    0               /XTA
+       2401;0
+       FPPSF4
+       0030
+YL=    0
+ZL,    0               /ZBLOCK
+       0214;1703
+       PSUDO+1300
+       ZBLKX
+\f      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
+       $
+\f
diff --git a/sw/f4/FRTSRC/RALF.err b/sw/f4/FRTSRC/RALF.err
new file mode 100644 (file)
index 0000000..078a1fa
--- /dev/null
@@ -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 (file)
index 0000000..54d9fe8
--- /dev/null
@@ -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 (file)
index 0000000..b50c152
--- /dev/null
@@ -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<ABS.RA/A
+*ACOS.RA<ACOS.RA/A
+*ADC.RA<ADC.RA/A
+*ALOG10.RA<ALOG10.RA/A
+*ALOG.RA<ALOG.RA/A
+*AMAX.RA<AMAX.RA/A
+*AMIN.RA<AMIN.RA/A
+*AMOD.RA<AMOD.RA/A
+*ASIN.RA<ASIN.RA/A
+*ATAN2.RA<ATAN2.RA/A
+*ATAN.RA<ATAN.RA/A
+*CABS.RA<CABS.RA/A
+*CARITH.RA<CARITH.RA/A
+*CEXP.RA<CEXP.RA/A
+*CHARS.RA<CHARS.RA/A
+*CHKEOF.RA<CHKEOF.RA/A
+*CLK8A.RA<CLK8A.RA/A
+*CLOCK.RA<CLOCK.RA/A
+*CLOG.RA<CLOG.RA/A
+*CMPLX.RA<CMPLX.RA/A
+*COSD.RA<COSD.RA/A
+*COSH.RA<COSH.RA/A
+*COS.RA<COS.RA/A
+*CSIN.RA<CSIN.RA/A
+*CSQRT.RA<CSQRT.RA/A
+*DABS.RA<DABS.RA/A
+*DATAN2.RA<DATAN2.RA/A
+*DATAN.RA<DATAN.RA/A
+*DATE.RA<DATE.RA/A
+*DBLE.RA<DBLE.RA/A
+*DCOS.RA<DCOS.RA/A
+*DEXP3.RA<DEXP3.RA/A
+*DEXP.RA<DEXP.RA/A
+*DIM.RA<DIM.RA/A
+*DLOG10.RA<DLOG10.RA/A
+*DLOG.RA<DLOG.RA/A
+*DMAX1.RA<DMAX1.RA/A
+*DMIN1.RA<DMIN1.RA/A
+*DMOD.RA<DMOD.RA/A
+*DSIGN.RA<DSIGN.RA/A
+*DSIN.RA<DSIN.RA/A
+*DSQRT.RA<DSQRT.RA/A
+*EXP3.RA<EXP3.RA/A
+*EXPCC.RA<EXPCC.RA/A
+*EXPCI.RA<EXPCI.RA/A
+*EXPDD.RA<EXPDD.RA/A
+*EXPDI.RA<EXPDI.RA/A
+*EXPDR.RA<EXPDR.RA/A
+*EXPIC.RA<EXPIC.RA/A
+*EXPID2.RA<EXPID2.RA/A
+*EXPID.RA<EXPID.RA/A
+*EXPII.RA<EXPII.RA/A
+*EXPIR.RA<EXPIR.RA/A
+*EXP.RA<EXP.RA/A
+*FLOAT.RA<FLOAT.RA/A
+*IDINT.RA<IDINT.RA/A
+*IFIX.RA<IFIX.RA/A
+*LTR.RA<LTR.RA/A
+*ONQIB.RA<ONQIB.RA/A
+*PAUSE.RA<PAUSE.RA/A
+*PLOT.RA<PLOT.RA/A
+*REAL.RA<REAL.RA/A
+*REALTM.RA<REALTM.RA/A
+*RFCV.RA<RFCV.RA/A
+*RFDV.RA<RFDV.RA/A
+*RSW.RA<RSW.RA/A
+*SIGN.RA<SIGN.RA/A
+*SIND.RA<SIND.RA/A
+*SINH.RA<SINH.RA/A
+*SNGL.RA<SNGL.RA/A
+*SQRT.RA<SQRT.RA/A
+*TAND.RA<TAND.RA/A
+*TANH.RA<TANH.RA/A
+*TAN.RA<TAN.RA/A
+*XFIX.RA<XFIX.RA/A$
+/
+/ SQUISHING.
+.SQUISH DSK:/O
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/ 
+/ RALF LIBRARY ASSEMBLY
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/
+.COMPILE ABS.RA
+.COMPILE ACOS.RA
+.COMPILE ADC.RA
+.COMPILE ALOG10.RA
+.COMPILE ALOG.RA
+.COMPILE AMAX.RA
+.COMPILE AMIN.RA
+.COMPILE AMOD.RA
+.COMPILE ASIN.RA
+.COMPILE ATAN2.RA
+.COMPILE ATAN.RA
+.COMPILE CABS.RA
+.COMPILE CARITH.RA
+.COMPILE CEXP.RA
+.COMPILE CHARS.RA
+.COMPILE CHKEOF.RA
+/.COMPILE CLK8A.RA
+.COMPILE CLOCK.RA
+.COMPILE CLOG.RA
+.COMPILE CMPLX.RA
+.COMPILE COSD.RA
+.COMPILE COSH.RA
+.COMPILE COS.RA
+.COMPILE CSIN.RA
+.COMPILE CSQRT.RA
+.COMPILE DABS.RA
+.COMPILE DATAN2.RA
+.COMPILE DATAN.RA
+.COMPILE DATE.RA
+.COMPILE DBLE.RA
+.COMPILE DCOS.RA
+.COMPILE DEXP3.RA
+.COMPILE DEXP.RA
+.COMPILE DIM.RA
+.COMPILE DLOG10.RA
+.COMPILE DLOG.RA
+.COMPILE DMAX1.RA
+.COMPILE DMIN1.RA
+.COMPILE DMOD.RA
+.COMPILE DSIGN.RA
+.COMPILE DSIN.RA
+.COMPILE DSQRT.RA
+.COMPILE EXP3.RA
+.COMPILE EXPCC.RA
+.COMPILE EXPCI.RA
+.COMPILE EXPDD.RA
+.COMPILE EXPDI.RA
+.COMPILE EXPDR.RA
+.COMPILE EXPIC.RA
+.COMPILE EXPID2.RA
+.COMPILE EXPID.RA
+.COMPILE EXPII.RA
+.COMPILE EXPIR.RA
+.COMPILE EXP.RA
+.COMPILE FLOAT.RA
+.COMPILE IDINT.RA
+.COMPILE IFIX.RA
+.COMPILE LTR.RA
+.COMPILE ONQIB.RA
+.COMPILE PAUSE.RA
+.COMPILE PLOT.RA
+.COMPILE REAL.RA
+.COMPILE REALTM.RA
+.COMPILE RFCV.RA
+.COMPILE RFDV.RA
+.COMPILE RSW.RA
+.COMPILE SIGN.RA
+.COMPILE SIND.RA
+.COMPILE SINH.RA
+.COMPILE SIN.RA
+.COMPILE SNGL.RA
+.COMPILE SQRT.RA
+.COMPILE TAND.RA
+.COMPILE TANH.RA
+.COMPILE TAN.RA
+.COMPILE XFIX.RA
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/ 
+/ LIBRARY BUILD
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/
+.R LIBRA
+*SYS:FORLIB.RL[20]/Z<ABS,ACOS,ADC,ALOG10/C
+*<ALOG,AMAX,AMIN,AMOD/C
+*<ASIN,ATAN2,ATAN,CABS/C
+*<CARITH,CEXP,CHARS,CHKEOF/C
+*<CLOCK,CLOG,CMPLX/C
+*<COSD,COSH,COS,CSIN,CSQRT/C
+*<DABS,DATAN2,DATAN,DATE/C
+*<DBLE,DCOS,DEXP3,DEXP/C
+*<DIM,DLOG10,DLOG,DMAX1/C
+*<DMIN1,DMOD,DSIGN,DSIN/C
+*<DSQRT,EXP3,EXPCC,EXPCI/C
+*<EXPDD,EXPDI,EXPDR,EXPIC,EXPID2/C
+*<EXPID,EXPII,EXPIR,EXP/C
+*<FLOAT,IDINT,IFIX,LTR,ONQIB/C
+*<PAUSE,PLOT,REAL,REALTM/C
+*<RFCV,RFDV,RSW,SIGN/C
+*<SIND,SINH,SNGL,SQRT/C
+*<TAND,TANH,TAN,XFIX=200$
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/ 
+/ END OF JOB!
+/
+/ *******************************************************************
+/ *******************************************************************
+/ *******************************************************************
+/
+/ CHAIN BACK TO DSK:
+.SUBMIT DSK:EXIT.BI
+
+
+
+
+
+
+
+
+
+
diff --git a/sw/f4/FRTSRC/abs.ra b/sw/f4/FRTSRC/abs.ra
new file mode 100644 (file)
index 0000000..b5db257
--- /dev/null
@@ -0,0 +1,21 @@
+/
+/ VERSION 5A 4-27-77  PT
+/
+       SECT    IABS
+       ENTRY   ABS
+       BASE    0
+ABS,   FLDA    0               /GET RETURN ADDRESS
+       STARTD
+       FSTA    RETRN
+       FADD    TWO             /GET ADDRESS OF ARG POINTER
+       FSTA    3
+       FLDA%   3               /GET ARG ADDRESS
+       FSTA    3
+       STARTF
+       FLDA%   3               /GET ARG
+       JGE     RETRN           /POSITIVE, SKIP NEGATE
+       FNEG
+RETRN, 0;0
+TWO,   0;2
+       END
+\f
diff --git a/sw/f4/FRTSRC/acos.ra b/sw/f4/FRTSRC/acos.ra
new file mode 100644 (file)
index 0000000..0ce8251
--- /dev/null
@@ -0,0 +1,78 @@
+/
+/
+/      A  C  O  S
+/      -  -  -  -
+/
+/SUBROUTINE    ACOS(X)
+/
+/ VERSION 5A 4-27-77  PT
+/
+       SECT    ACOS
+       JA      #ACOS
+       TEXT    +ACOS  +
+ACOSXR,        SETX    XRACOS
+       SETB    BPACOS
+BPACOS,        FNOP
+       0
+       0
+XRACOS,        F 0.0
+ACOS8, F 0.0
+ACOS7, F 0.0
+FPI2AC,        1               /PI OVER 2
+       3110
+       3755
+F1ACOS,        F 1.
+FPIACS,        2               /PI
+       3110
+       3755
+       ORG     10*3+BPACOS
+       FNOP
+       JA      ACOSXR
+       0
+ACSRTN,        JA      .
+       BASE    0
+#ACOS, STARTD
+       FLDA    10*3
+       FSTA    ACSRTN
+       FLDA    0
+       SETX    XRACOS
+       SETB    BPACOS
+       BASE    BPACOS
+       LDX     1,1
+       FSTA    BPACOS
+       FLDA%   BPACOS,1        /ADDR OF X
+       FSTA    BPACOS
+       STARTF
+       FLDA%   BPACOS  /GET X
+       FSTA    ACOS8   /SAVE IT
+       JEQ     ACOSEQ  /IF 0 RTN PI OVER 2
+       LDX     -1,0    /JUMP TIME
+       JGE     .+5
+       LDX     0,0
+       FNEG
+       FSUB    F1ACOS  /1-!X!
+       JLE     ACOSOK  /IS IT <1.?
+       EXTERN  #ARGER
+       TRAP4   #ARGER
+       JA      ACSRTN  /AND RETURN
+ACOSOK,        FLDA    ACOS8   /X
+       FMUL    ACOS8   /X^2
+       FNEG            /-X^2
+       FADD    F1ACOS  /1-X^2
+       FSTA    ACOS7
+       EXTERN  SQRT
+       JSR     SQRT    /CALL SQRT
+       JA      .+4     /SQRT (1-X^2)
+       JA      ACOS7
+       FDIV    ACOS8   /SQRT (1-X^2)/X
+       FSTA    ACOS7
+       EXTERN  ATAN
+       JSR     ATAN    /CALL ATAN
+       JA      .+4     /ATAN (SQRT(1-X^2)/X)
+       JA      ACOS7
+       JXN     ACSRTN,0        /NO SIGN CHG NECESSARY
+       FADD    FPIACS  /ADD PI IF MINUE
+       JA      ACSRTN
+ACOSEQ,        FLDA    FPI2AC  /RTN PI OVER 2 IF 0
+       JA      ACSRTN
+\f
diff --git a/sw/f4/FRTSRC/adc.ra b/sw/f4/FRTSRC/adc.ra
new file mode 100644 (file)
index 0000000..7d68eaf
--- /dev/null
@@ -0,0 +1,59 @@
+/
+/ VERSION 5A 4-27-77  PT
+/
+       ADSK=6534
+       ADRB=6533
+       ADST=6532
+       ADLM=6531
+       ADCL=6530
+       SAM=100
+       LINC=6141
+       ESF=4
+       PDP=2
+       SECT8   ADC             /AD SAMPLER (UNBUFFERED, UNCOLCKED)
+       BASE    0
+       STARTD
+       FLDA    0               /GET RETURN ADDRESS
+       FSTA    ADCRET
+       FADD    L2              /GET ADDR OF ARG POINTER
+       FSTA    0
+       FLDA%   0               /GET ADDR OF CHANNEL NUMBER
+       FSTA    0
+       STARTF
+       FLDA%   0               /GET THE CHANNEL NUMBER
+       ALN     0               /FIX IT
+       FSTA    CHANEL          /STORE IT FOR ADC8
+       TRAP4   ADC8            /GO TO PDP8 CODE TO DO THE SAMPLING
+       FLDA    SAMPLE
+       FNORM                   /GET THE SAMPLE AND NORMALIZE IT
+       FDIV    L511            /SCALE BETWEEN -1 AND +1
+ADCRET,        JA      .
+L2,    0;2
+L511,  F       511.
+SAMPLE,        13;0;0
+CHANEL,        0;0;0
+ADC8,  0                       /PDP8 MODE END OF ADC
+       IFSW    8 <
+       ADCL                    /CLEAR AD LOGIC
+       TAD     CHANEL+2                /SET MULTIPLEXOR CHANNEL
+       ADLM
+       ADST                    /START CONVERSION
+       ADSK                    /WAIT FOR IT
+       JMP     .-1
+       ADRB                    /READ CONVERTOR BUFFER>
+       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>
+\f
diff --git a/sw/f4/FRTSRC/alog.ra b/sw/f4/FRTSRC/alog.ra
new file mode 100644 (file)
index 0000000..3c710f7
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/alog10.ra b/sw/f4/FRTSRC/alog10.ra
new file mode 100644 (file)
index 0000000..1517ea7
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/amax.ra b/sw/f4/FRTSRC/amax.ra
new file mode 100644 (file)
index 0000000..1004595
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/amin.ra b/sw/f4/FRTSRC/amin.ra
new file mode 100644 (file)
index 0000000..a5addcf
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/amod.ra b/sw/f4/FRTSRC/amod.ra
new file mode 100644 (file)
index 0000000..47f3352
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/asin.ra b/sw/f4/FRTSRC/asin.ra
new file mode 100644 (file)
index 0000000..a4c9b4f
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/atan.ra b/sw/f4/FRTSRC/atan.ra
new file mode 100644 (file)
index 0000000..ab73d75
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/atan2.ra b/sw/f4/FRTSRC/atan2.ra
new file mode 100644 (file)
index 0000000..0c1df14
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/cabs.ra b/sw/f4/FRTSRC/cabs.ra
new file mode 100644 (file)
index 0000000..ab166b0
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/carith.ra b/sw/f4/FRTSRC/carith.ra
new file mode 100644 (file)
index 0000000..e2770c3
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/cexp.ra b/sw/f4/FRTSRC/cexp.ra
new file mode 100644 (file)
index 0000000..7a9dbd0
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/chars.ra b/sw/f4/FRTSRC/chars.ra
new file mode 100644 (file)
index 0000000..58ae83d
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/chkeof.ra b/sw/f4/FRTSRC/chkeof.ra
new file mode 100644 (file)
index 0000000..18416a0
--- /dev/null
@@ -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 (file)
index 0000000..ccf875e
--- /dev/null
@@ -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
+/
+/
+
+\f
+
+
+
+
+
+       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
+\f      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
+\f      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
+\f/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 >
+\fSETCLK,       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
+\f      DCA STFLG+1     /TRIGGER FLAGS.
+\f      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
+\fDOSYNC,       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
+\fIDOCLK,       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
+\fFCNPTR,
+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
+\f
diff --git a/sw/f4/FRTSRC/clock.ra b/sw/f4/FRTSRC/clock.ra
new file mode 100644 (file)
index 0000000..a994281
--- /dev/null
@@ -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
+\f      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
+\f      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
+\f      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
+\f/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 >
+\fSETCLK,       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.
+\f      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
+\fDOSYNC,       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
+\fIDOCLK,       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
+\fFCNPTR,
+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
+\f
diff --git a/sw/f4/FRTSRC/clog.ra b/sw/f4/FRTSRC/clog.ra
new file mode 100644 (file)
index 0000000..995e613
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/cmplx.ra b/sw/f4/FRTSRC/cmplx.ra
new file mode 100644 (file)
index 0000000..a1886ff
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/cos.ra b/sw/f4/FRTSRC/cos.ra
new file mode 100644 (file)
index 0000000..2bc39bd
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/cosd.ra b/sw/f4/FRTSRC/cosd.ra
new file mode 100644 (file)
index 0000000..021d4fa
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/cosh.ra b/sw/f4/FRTSRC/cosh.ra
new file mode 100644 (file)
index 0000000..3715b77
--- /dev/null
@@ -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.
+\f
diff --git a/sw/f4/FRTSRC/csin.ra b/sw/f4/FRTSRC/csin.ra
new file mode 100644 (file)
index 0000000..cc2b02b
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/csqrt.ra b/sw/f4/FRTSRC/csqrt.ra
new file mode 100644 (file)
index 0000000..161769d
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/dabs.ra b/sw/f4/FRTSRC/dabs.ra
new file mode 100644 (file)
index 0000000..fcdf597
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/datan.ra b/sw/f4/FRTSRC/datan.ra
new file mode 100644 (file)
index 0000000..fcd488b
--- /dev/null
@@ -0,0 +1,203 @@
+/
+/
+/ SUBROUTINE DATAN(X)
+/
+/ VERSION 5A 4-26-77 (MH)
+/
+/X,THE ARGUMENT, IS REDUCED TO 
+/0<X<1/2
+/BY THE IDENTITIES:
+/ATAN(-X)=-ATAN(X)
+/IF X>1.0 THEN ATAN(X)=PI/2 - ATAN(1/X)
+/IF .5<X<1.0 THEN ATAN(X)=ATAN(1/2)+ATAN(2*X-(1/(X+2)))
+/ATAN(X)=X FOR X<2^(-15)
+/
+/
+/
+       SECT    DATAN
+       JA      #DATAN
+       DPCHK
+/
+       TEXT    +DATAN +
+DATNXR,        SETX    XRDATN
+       SETB    BPDATN
+BPDATN,        F 0.0
+XRDATN,        F 0.0
+DATFP1,        F 1.0
+       F 0.0
+DATLOW,        -15
+       2000
+       0000
+       0000
+       0000
+       0000
+/
+       ORG     10*3+BPDATN
+       FNOP
+       JA      DATNXR
+       0
+DATRTN,        JA      .
+/
+LAMBDA,        0004
+       3057
+       7537
+       4017
+       0276
+       4536
+DATB0, 0005
+       3221
+       3522
+       3121
+       3352
+       5066
+DATA1, 0007
+       5372
+       4104
+       3437
+       1766
+       6167
+DATB1, 0003
+       3135
+       1757
+       0565
+       4141
+       4270
+DATA2, 0001
+       5473
+       7524
+       1112
+       4701
+       2723
+DATB2, 0002
+       2065
+       4070
+       1015
+       2710
+       3176
+DATA3, 7775
+       5374
+       4326
+       3317
+       1675
+       3124
+DATB3, 0001
+       2410
+       5255
+       0370
+       2076
+       6374
+PIS2,  0001
+       3110
+       3755
+       2421
+       0264
+       3013
+ATN1S2,        7777
+       3553
+       0634
+       0530
+       3443
+       6406
+DATP5, 7777
+       3777
+       7777
+       7777
+       7777
+       7776
+X,     F 0.0
+       F 0.0
+C0,    F 0.0
+       F 0.0
+DT1,   F 0.0
+       F 0.0
+DATFP2,        F 2.0
+       F 0.0
+Z,     F 0.0
+       F 0.0
+/
+/PICK UP RETURN AND ARGUMENT
+       BASE    0
+#DATAN,        STARTD
+       FLDA    10*3
+       FSTA    DATRTN
+       FLDA    0
+       SETX    XRDATN
+       SETB    BPDATN
+       BASE    BPDATN
+       LDX     1,1
+       FSTA    BPDATN
+       FLDA%   BPDATN,1
+       FSTA    BPDATN
+       STARTE
+       FLDA%   BPDATN  /GET X
+       LDX     -1,0    /SIGN
+       JGE     .+5
+       LDX     0,0     /SAVE SIGN
+       FNEG
+       FSTA    X       /SAVE ARG
+/
+/CHECK ARGAINST LOWER LIMIT
+       FLDA    X
+       FSUB    DATLOW  /TOO SMALL?
+       JLE     DATGO   /YES ATAN(X)=X
+       LDX     -1,1
+       FCLA
+       FSTA    C0
+/
+/REDUCE X TO RANGE 0<X<.5
+DATA,  FLDA    X
+       FSUB    DATFP1  
+       JLE     DATB    />1?
+       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
+\f
diff --git a/sw/f4/FRTSRC/datan2.ra b/sw/f4/FRTSRC/datan2.ra
new file mode 100644 (file)
index 0000000..7ebae2c
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/date.ra b/sw/f4/FRTSRC/date.ra
new file mode 100644 (file)
index 0000000..875cd4d
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/dble.ra b/sw/f4/FRTSRC/dble.ra
new file mode 100644 (file)
index 0000000..46c42e8
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/dcos.ra b/sw/f4/FRTSRC/dcos.ra
new file mode 100644 (file)
index 0000000..90fba9d
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/dexp.ra b/sw/f4/FRTSRC/dexp.ra
new file mode 100644 (file)
index 0000000..842162d
--- /dev/null
@@ -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<R<1/8
+/AND M+N+R=M+F=X*LOG2(E)
+/
+/(2^M)*(2^N)*(2^R)=E^X
+/
+/2^M IS CALCULATED BY SUCCESSIVE MULTIPLIES
+/2^N IS CALCULATED BY LOOK UP
+/2^R=1+<A4/((B4/R)-C4+(D4*R)+(H4/(R+(B4/R))))>
+/
+/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
+\f\1e
diff --git a/sw/f4/FRTSRC/dexp3.ra b/sw/f4/FRTSRC/dexp3.ra
new file mode 100644 (file)
index 0000000..7038be8
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/dim.ra b/sw/f4/FRTSRC/dim.ra
new file mode 100644 (file)
index 0000000..88cf1c3
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/dlog.ra b/sw/f4/FRTSRC/dlog.ra
new file mode 100644 (file)
index 0000000..00a6fe7
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/dlog10.ra b/sw/f4/FRTSRC/dlog10.ra
new file mode 100644 (file)
index 0000000..f08abc3
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/dmax1.ra b/sw/f4/FRTSRC/dmax1.ra
new file mode 100644 (file)
index 0000000..db589ee
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/dmin1.ra b/sw/f4/FRTSRC/dmin1.ra
new file mode 100644 (file)
index 0000000..d28a86e
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/dmod.ra b/sw/f4/FRTSRC/dmod.ra
new file mode 100644 (file)
index 0000000..4b40494
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/dsign.ra b/sw/f4/FRTSRC/dsign.ra
new file mode 100644 (file)
index 0000000..a84de31
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/dsin.ra b/sw/f4/FRTSRC/dsin.ra
new file mode 100644 (file)
index 0000000..4e70550
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/dsqrt.ra b/sw/f4/FRTSRC/dsqrt.ra
new file mode 100644 (file)
index 0000000..520a86d
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/exp.ra b/sw/f4/FRTSRC/exp.ra
new file mode 100644 (file)
index 0000000..141e20e
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/exp3.ra b/sw/f4/FRTSRC/exp3.ra
new file mode 100644 (file)
index 0000000..67da383
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/expcc.ra b/sw/f4/FRTSRC/expcc.ra
new file mode 100644 (file)
index 0000000..691dc0c
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/expci.ra b/sw/f4/FRTSRC/expci.ra
new file mode 100644 (file)
index 0000000..9b9b76b
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/expdd.ra b/sw/f4/FRTSRC/expdd.ra
new file mode 100644 (file)
index 0000000..bdf0e51
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/expdi.ra b/sw/f4/FRTSRC/expdi.ra
new file mode 100644 (file)
index 0000000..fb3f8ff
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/expdr.ra b/sw/f4/FRTSRC/expdr.ra
new file mode 100644 (file)
index 0000000..d0ec51c
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/expic.ra b/sw/f4/FRTSRC/expic.ra
new file mode 100644 (file)
index 0000000..7c2d22c
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/expid.ra b/sw/f4/FRTSRC/expid.ra
new file mode 100644 (file)
index 0000000..e37ee9e
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/expid2.ra b/sw/f4/FRTSRC/expid2.ra
new file mode 100644 (file)
index 0000000..80f39a4
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/expii.ra b/sw/f4/FRTSRC/expii.ra
new file mode 100644 (file)
index 0000000..02a5e33
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/expir.ra b/sw/f4/FRTSRC/expir.ra
new file mode 100644 (file)
index 0000000..3167ba4
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/f4.pa b/sw/f4/FRTSRC/f4.pa
new file mode 100644 (file)
index 0000000..8bebc29
--- /dev/null
@@ -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
+\f/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
+\f      *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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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 <CURRENT ONE
+       TAD I   OLDN3
+       JMP     LOOK            /CONTINUE SEARCH
+HOOKIN,        TAD I   OLDN3           /HOOK NEW ENTRY INTO LIST
+       DCA I   NEXT
+       TAD     NEXT
+       DCA I   OLDN3
+       DCA I   NEXT            /ZERO TYPE WORD
+       DCA I   NEXT            /ZERO EQUIVALENCE/DIMENSION POINTER
+       TAD     (NAME1          /PREPARE TO STICK IN THE NAME
+       DCA     PNAME
+       CDF
+ENTERN,        TAD I   PNAME           /MOVE NAME INTO S.T.
+       CDF     10
+       DCA I   NEXT
+       CDF
+       TAD I   PNAME
+       ISZ     PNAME           /END OF NAME?
+       AND     [77
+       SZA CLA
+       JMP     ENTERN          /NO, KEEP GOING
+       CDF     10
+STCHEK,        TAD     NEXT            /CHECK FOR S.T. OVERFLOW
+       CIA CLL
+       TAD     (4740           /5000 STARTS PASS2 SKELETON TABLES
+       SZL CLA
+       JMP     RLOOKU
+       CDF
+       JMS I   [ERMSG          /S.T. FULL
+       2324
+       JMP I   (ENDX           /TREAT AS END OF INPUT
+OLDN3, 0                       /ADDR OF PREVIOUS ENTRY
+N3SIZE,        0                       /SIZE OF ENTRY
+LTEMP,
+PNAME,                         /POINTER TO NAME BUFFER
+LUKUP2,        0                       /LOOKUP FOR FIXED LENGTH SYMBOLS
+       TAD I   LUKUP2          /GET THE BUCKET START
+       DCA     OLDN3           /SAVE IT AS THE PREVIOUS ENTRY
+       ISZ     LUKUP2
+       TAD I   LUKUP2          /GET THE ENTRY SIZE
+       ISZ     LUKUP2
+       DCA     N3SIZE
+       TAD     LUKUP2          /SAVE RETURN ADDR
+       DCA     LOOKUP
+       TAD     NOCODE          /IS CODE GENERATION OFF ?
+       SZA CLA
+       JMP I   LOOKUP          /YES, JUST RETURN
+       CDF     10
+LOOK2, TAD I   OLDN3           /GET ADDR OF NEXT ENTRY
+       SNA
+       JMP     HOKIN2          /IF 0 ITS END OF LIST
+       IAC
+       DCA     X10             /START OF VALUE INFO
+       TAD     (WORD1-1        /SETUP POINTER TO PROTOTYPE
+       DCA     X11
+       TAD     N3SIZE          /AND TEMP OF ENTRY SIZE
+       DCA     LTEMP
+CHKVAL,        CDF
+       TAD I   X11
+       CIA CLL                 /COMPARE THIS WORD OF THE VALUE
+       CDF     10
+       TAD I   X10
+       SZA CLA
+       JMP     NOTSM2          /NOT THIS ONE
+       ISZ     LTEMP           /INCR SIZE COUNT
+       JMP     CHKVAL          /MORE STUFF
+       JMP     RLOOKU          /RETURN WITH THE GOODS
+NOTSM2,        SZL
+       JMP     HOKIN2          /NEW SYMBOL < CURRENT ONE
+       TAD I   OLDN3           /CONTINUE SEARCH
+       DCA     OLDN3
+       JMP     LOOK2
+HOKIN2,        TAD I   OLDN3           /HOOK NEW ENTRY INTO LIST
+       DCA I   NEXT
+       TAD     NEXT
+       DCA I   OLDN3
+       TAD     (WORD1-1        /PREPARE TO STICK IN THE VALUE
+       DCA     X11
+       DCA I   NEXT            /ZERO TYPE WORD
+       CDF
+ENTERV,        TAD I   X11             /MOVE VALUE INTO S.T.
+       CDF     10
+       DCA I   NEXT
+       ISZ     N3SIZE          /INCR SIZE COUNT
+       JMP     ENTERV-1
+       JMP     STCHEK          /STORE TYPE AND CHECK FOR OVERFLOW
+STOP,  TAD     (STOPOP         /OUTPUT STOP OPERATOR
+       JMS I   [OUTWRD
+       ISZ     DOEND           /DO ILLEGAL ON STOP
+       JMP I   [NEXTST
+\f/ EXPRESSION ANALYZER
+       PAGE
+EXPR,  0                       /POLISHIZE EXPRESSION
+       TAD     EXPR
+       JMS I   [PUSH           /SAVE RETURN ADDR
+       JMS I   [PUSH           /MARK STACK
+UNOPR, JMS I   [GETC           /LOOK FOR UNARY OPERATOR
+       JMP     MISARG          /THERE HAS TO BE AN OPERAND
+       TAD     (-253           /UNARY+(NOP)
+       SNA
+       JMP     UNOPR
+       TAD     (253-255        /UNARY-
+       SNA
+       JMP     UMINUS
+       TAD     (255-256        /.NOT.
+       SZA CLA
+       JMP     OPRAND
+       DCA     BUCKET          /FOR CKNOT
+       JMS I   (TRUFAL         /.TRUE. OR .FALSE. ?
+       JMP     CKNOT           /NEITHER, IS IT >.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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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/
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f      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
+\f/ 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
+\f      PAGE
+\f/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
+\f/ 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
+       $
+\f
diff --git a/sw/f4/FRTSRC/fcomp.bi b/sw/f4/FRTSRC/fcomp.bi
new file mode 100644 (file)
index 0000000..6f0f1a5
--- /dev/null
@@ -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 PASS2O<P2OCFG,PASS2
+.LOAD PASS2O
+.SAVE SYS PASS2=0,7605
+.DELETE PASS20.BN
+/
+/ *******************************************************************
+/
+.PAL PASS3
+.LOAD PASS3
+.SAVE SYS PASS3=0;400
+.DELETE PASS3.BN
+/
+/ *******************************************************************
+/
+.PAL F4
+.LOAD F4
+.SAVE SYS F4=0;12200
+.DELETE F4.BN
+/
+/ *******************************************************************
+/
+.R PAL8
+.PAL RALF/W
+.LOAD RALF
+.SAVE SYS RALF.SV=0;200
+.DELETE RALF.BN
+/
+/ *******************************************************************
+/
+.PAL FRTS<RTS,RTL
+.LOAD FRTS
+.SAVE SYS FRTS
+.DELETE FRTS.BN
+/
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/ 
+/ RALF LIBRARY ASSEMBLY
+/
+/ *******************************************************************
+/ *******************************************************************
+/
+/
+.COMPILE ABS.RA
+.COMPILE ACOS.RA
+.COMPILE ADC.RA
+.COMPILE ALOG10.RA
+.COMPILE ALOG.RA
+.COMPILE AMAX.RA
+.COMPILE AMIN.RA
+.COMPILE AMOD.RA
+.COMPILE ASIN.RA
+.COMPILE ATAN2.RA
+.COMPILE ATAN.RA
+.COMPILE CABS.RA
+.COMPILE CARITH.RA
+.COMPILE CEXP.RA
+.COMPILE CHARS.RA
+.COMPILE CHKEOF.RA
+.COMPILE CLK8A.RA
+.COMPILE CLOCK.RA
+.COMPILE CLOG.RA
+.COMPILE CMPLX.RA
+.COMPILE COSD.RA
+.COMPILE COSH.RA
+.COMPILE COS.RA
+.COMPILE CSIN.RA
+.COMPILE CSQRT.RA
+.COMPILE DABS.RA
+.COMPILE DATAN2.RA
+.COMPILE DATAN.RA
+.COMPILE DATE.RA
+.COMPILE DBLE.RA
+.COMPILE DCOS.RA
+.COMPILE DEXP3.RA
+.COMPILE DEXP.RA
+.COMPILE DIM.RA
+.COMPILE DLOG10.RA
+.COMPILE DLOG.RA
+.COMPILE DMAX1.RA
+.COMPILE DMIN1.RA
+.COMPILE DMOD.RA
+.COMPILE DSIGN.RA
+.COMPILE DSIN.RA
+.COMPILE DSQRT.RA
+.COMPILE EXP3.RA
+.COMPILE EXPCC.RA
+.COMPILE EXPCI.RA
+.COMPILE EXPDD.RA
+.COMPILE EXPDI.RA
+.COMPILE EXPDR.RA
+.COMPILE EXPIC.RA
+.COMPILE EXPID2.RA
+.COMPILE EXPID.RA
+.COMPILE EXPII.RA
+.COMPILE EXPIR.RA
+.COMPILE EXP.RA
+.COMPILE FLOAT.RA
+.COMPILE IDINT.RA
+.COMPILE IFIX.RA
+.COMPILE LTR.RA
+.COMPILE ONQIB.RA
+.COMPILE PAUSE.RA
+.COMPILE PLOT.RA
+.COMPILE REAL.RA
+.COMPILE REALTM.RA
+.COMPILE RFCV.RA
+.COMPILE RFDV.RA
+.COMPILE RSW.RA
+.COMPILE SIGN.RA
+.COMPILE SIND.RA
+.COMPILE SINH.RA
+.COMPILE SIN.RA
+.COMPILE SNGL.RA
+.COMPILE SQRT.RA
+.COMPILE TAND.RA
+.COMPILE TANH.RA
+.COMPILE TAN.RA
+.COMPILE XFIX.RA
+/
+/
+/
+/ *******************************************************************
+/ *******************************************************************
+/ 
+/ END OF JOB
+/
+/ *******************************************************************
+/ *******************************************************************
+$END
diff --git a/sw/f4/FRTSRC/float.ra b/sw/f4/FRTSRC/float.ra
new file mode 100644 (file)
index 0000000..22d3427
--- /dev/null
@@ -0,0 +1,18 @@
+/
+/ VERSION 5A 4-27-77  PT
+/
+       SECT    FLOAT
+       BASE    0
+       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
+RETRN, 0;0                     /FLOAT IS A NOP
+TWO,   0;2
+       END
+\f
diff --git a/sw/f4/FRTSRC/idint.ra b/sw/f4/FRTSRC/idint.ra
new file mode 100644 (file)
index 0000000..08d9b9c
--- /dev/null
@@ -0,0 +1,39 @@
+/ VERSION 5A 4-27-77  PT
+/
+       SECT    IDINT
+       JA      #DINT
+       DPCHK
+       TEXT    +DINT  +
+DINTXR,        SETX    XRDINT
+       SETB    BPDINT
+BPDINT,        F 0.0
+       F 0.0
+XRDINT,        0;73;1
+       F 0.0
+       ORG     10*3+BPDINT
+       FNOP
+       JA      DINTXR
+       0
+#GOBAK,        JA      .
+       BASE    0
+#DINT, STARTD
+       SETX    XRDINT
+       FLDA    10*3
+       FSTA    #GOBAK,0
+       FLDA%   0,2
+       SETB    BPDINT
+       BASE    BPDINT
+       FSTA    BPDINT
+       STARTE
+       FLDA%   BPDINT
+       JLT     NEGFIX          /NEGATIVE ARG
+       ALN     1               /FIX POSITIVE ARG
+       FNORM
+       JA      #GOBAK          /RETURN
+NEGFIX,        FNEG                    /FIRST MAKE POSITIVE
+       ALN     1               /THEN FIX
+       FNORM
+       FNEG                    /THEN RE-NEGATE
+       JA      #GOBAK
+       END
+\f
diff --git a/sw/f4/FRTSRC/ifix.ra b/sw/f4/FRTSRC/ifix.ra
new file mode 100644 (file)
index 0000000..f283f82
--- /dev/null
@@ -0,0 +1,30 @@
+/
+/ VERSION 5A 4-27-77  PT
+/
+       SECT    IFIX
+       ENTRY   AINT
+       ENTRY   INT
+       BASE    0
+AINT,
+INT,   FLDA    0               /ADDRESS OF CALL
+       STARTD
+       FSTA    RETRN           /SAVE RERN
+       FADD    TWO             /INCR BY TWO
+       FSTA    3               /GIVES ADDRESS OF ARG POINTER
+       FLDA%   3               /GET ADDR OF ARG
+       FSTA    3
+       STARTF
+       FLDA%   3               /GET ARG
+       JAL     RETRN   /LEAVE BIGGIES ALONE
+       JLT     NEGFIX          /NEGATIVE ARG
+       ALN     0               /FIX POSITIVE ARG
+       FNORM
+       JA      RETRN           /RETURN
+NEGFIX,        FNEG                    /FIRST MAKE POSITIVE
+       ALN     0               /THEN FIX
+       FNORM
+       FNEG                    /THEN RE-NEGATE
+RETRN, JA .
+TWO,   0;2
+       END
+\f
diff --git a/sw/f4/FRTSRC/libra.pa b/sw/f4/FRTSRC/libra.pa
new file mode 100644 (file)
index 0000000..aad1f39
--- /dev/null
@@ -0,0 +1,1424 @@
+/LIBRA: F4 LIBRARIAN, V24A
+/
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/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.
+/
+/
+/
+/
+/
+/
+\f/LIBRA: FORTRAN IV LIBRARIAN
+/
+/
+/      BORN OF JUD LEONARD, UNDER THE
+/      SIGN FOR WHICH IT IS NAMED.
+/
+/
+/ CHANGES FOR V23
+/ .PRINT VERSION NUMBER
+/ .ACCEPT INPUT FROM CONSOLES WITHOUT PARITY
+/
+/
+/ CHANGES FOR OS/8 V3D BY PAULA TIRAK
+/ .CHANGED VERSION NUMBER TO 24A
+/ .PUT IN NEW DATE ALGORITHM
+/ .NO LONGER MISNAMES THE SECOND OUTPUT FILE
+/
+/
+/      OS/8 CONSTANTS:
+VERS=24
+PATCH="A
+/
+FETCH=1
+LOOKUP=2
+ENTER=3
+CLOSE=4
+DECODE=5
+CHAIN=6
+ERROR=7
+USRIN=10
+USROUT=11
+/
+OUTF1=7600     /LIBRARY
+OUTF2=7605     /CATALOG LISTING
+OUTF3=7612     /UNUSED
+INF=7617
+/
+EQHI=7642
+SWATOL=7643
+SWMTOX=7644
+SWYTO9=7645
+EQLO=7646
+DHRES=7647     /HANDLER RESIDENCY TABLE
+SYSDAT=7666    /SYSTEM DATE
+DCTLW=7760     /DEVICE CONTROL WORD TABLE
+/      DEVICE CONTROL WORDS HAVE THE FORM:
+/      BIT 0   FILE STRUCTURED
+/      BIT 1   READ ONLY
+/      BIT 2   WRITE ONLY
+/      BITS 3-8 DEVICE TYPE
+/      BITS 9-11 DIR BLOCK OF CURRENT TENTATIVE FILE
+/
+/      INTERNAL DEFINITIONS:
+F0=00
+F1=10
+CATBUF=2000    /IN FIELD 1
+CBUFS=1                /NUMBER OF BUFFERS FOR CATALOG
+MODBUF=2400    /LIKEWISE
+MBUFS=12       /BUFFERS FOR MODULE
+ODEVH=7200     /OUTPUT DEVICE HANDLER (ROOM FOR 2-PAGE)
+IDEVH=6600     /INPUT DEVICE HANDLER
+\f/
+/       PAGE 0 FOR LIBRA
+/
+        *1
+TMP1,   0
+TMP2,   0       /SOME TEMPS
+TMP3,   0
+TMP4,   0
+TMP5,   0
+TMP6,   0
+TMP7,   0
+X0,     0       /AUTO-INDEX
+X1,     0
+X2,     0
+X3,     0
+X4,     0
+X5,     0
+X6,     0
+X7,     0
+USR,    200     /CURRENT USR CALL ADDRESS
+                /LIBRA ASSUMES USR ALWAYS PRESENT
+LIBDVH, ODEVH   /ADDRESS OF LIBRARY DEVICE HANDLER
+LIBU,   1       /UNIT CONTAINING LIBRARY; INITIALLY SYS:
+CATLEN, 0       /LENGTH OF CATALOG
+CATBLK, 0       /CURRENT CATALOG BLOCK IN CORE
+LAVAIL, 0       /NEXT AVAILABLE LIBRARY BLOCK
+LIBNAM, TEXT    "FORLIBRL"
+       *.-1
+INFP,   INF     /CURRENT PLACE IN INPUT FILE LIST
+MODU,   0       /UNIT CONTAINING CURRENT MODULE
+MODDVH, IDEVH   /INPUT DEVICE HANDLER ADDRESS
+MODLEN, 0       /LENGTH OF THIS MODULE
+MODBLK, 0       /FIRST BLOCK OF MODULE
+INLSW,  0       /NON-ZERO IF IN LIBRARY INPUT
+INFST,  0       /FIRST BLOCK OF INPUT FILE
+INBLK,  0       /NEXT INPUT BLOCK NUMBER
+THSBLK, 0       /READIN CONTROL
+FULFLG,        0       /-1 IF CAT FULL
+\fENAM1,        0
+ENAM2, 0       /HOLDER FOR ESD NAMES
+ENAM3, 0
+       0       /TEXT STOPPER FOR ENAME
+ESDCTR,        0
+PCAT,  CATBUF  /POINTER TO CURRENT CATALOG BLOCK
+INCLUD,        -1      /SW FOR NAME INCLUDED IN CATALOG
+CHANGD,        1       /0 IF CAT BLOCK MODIFIED
+PMOD,  MODBUF  /POINTER TO CURRENT MODULE BLOCK
+/
+TTFLAG,        0       /NON-ZERO WHEN TTY HAS INITIALIZED
+PCHR,  TTO     /OUTPUT ROUTINE
+TTPOS, 0       /TTY POSITION COUNTER
+CATCNT,        0
+IOERR, 0
+       7421    /ERROR CODE TO MQ
+       JMP I   .+1
+       IOMES   /LOG THE ERROR
+\f/     LIBRA MAIN CONTROL
+/
+       *177            /MAKES IT EASY TO CALL START
+START, CDF     F0
+       JMS     TTWAIT  /ALLOW TTY TO COMPLETE
+       CIF     F1
+       JMS I   USR
+       DECODE
+TXTRL, 2214            /RL DEFAULT EXT
+       TAD     (INF    /RESET INPUT FILE POINTER
+       DCA     INFP
+       TAD     (TTO    /AND IO DEVICE
+       DCA     PCHR
+       DCA     FULFLG
+       CDF     F1
+       TAD I   (OUTF1
+       SNA             /NEW LIBRARY SPECIFIED?
+       JMP     LASTLB  /NO, USE LAST ONE
+       DCA     LIBU    /GET LIBRARY UNIT
+       TAD     (OUTF1
+       DCA     X0
+       TAD I   X0
+       DCA     LIBNAM  /MOVE
+       TAD I   X0      /IN
+       DCA     LIBNAM+1 /NEW
+       TAD I   X0      /NAME
+       DCA     LIBNAM+2
+       TAD I   X0
+       SNA
+       TAD     TXTRL   /IF NO EXT, FORCE .RL
+       DCA     LIBNAM+3
+LASTLB,        TAD     LIBU    /REGET UNIT
+       AND     (17
+       TAD     (DCTLW-1        /ADDRESS DEV CTL TABLE
+       DCA     TMP1
+       TAD I   TMP1
+       CDF     F0
+       SMA CLA         /IS DEVICE FILE-STRUCTURED?
+       JMP     NOTFS   /NO, BOMB
+       TAD     (ODEVH!1
+       DCA     OHADDR  /ALLOW 2-PAGE HANDLER
+       TAD     LIBU
+       AND     (17
+       CIF     F1
+       JMS I   USR     /GET THE HANDLER
+       FETCH
+OHADDR,        ODEVH!1
+       JMS     IOERR   /YOU'RE KIDDING
+       TAD     OHADDR  /NOW THE REAL ADDRESS
+       DCA     LIBDVH
+       JMP     ZTEST
+\fNOTFS,        JMS     TTOTXT
+       FLSTR-1
+       JMS     CRLF
+       JMP     START
+/
+IOMES, CLA
+       TAD     (TTO
+       DCA     PCHR    /ENSURE IT COMES OUT ON TTY
+       JMS     TTOTXT
+       IOMSG-1
+       JMS     CRLF
+       JMP     START
+       PAGE
+\fZTEST,        CDF     F1      /FIND OR CREATE LIB.
+       TAD I   (SWYTO9 /GET SWITCH WORD
+       AND     (2000   /TEST FOR /Z
+       CDF     F0
+       SZA CLA
+       JMP     NEWLIB  /YES, ENTER NEW ONE
+OLDLIB,        JMS     FNDLIB  /LOOKUP THE LIBRARY
+       LOOKUP
+       JMP     NEWLIB  /COULDN'T FIND IT
+/
+       TAD     LIBBLK  /FIRST BLOCK OF LIBRARY
+       DCA     ZCATB
+       TAD     (CBUFS+MBUFS^200!F1
+       DCA     ZCATC   /READ ALL YOU CAN
+       JMS     ZCAT    /DO THE READ
+       CDF     F1
+       TAD I   (CATBUF /LOOK AT CONTROL WORD
+       CLL RAR
+       SZA CLA         /IS IT A LIBRARY?
+       JMP     NOTLIB  /NO, ERROR
+       TAD I   (CATBUF+3
+       CDF     F0
+       DCA     CATLEN  /LENGTH IN BLOCKS
+       TAD     LIBBLK
+       DCA     LAVAIL  /WILL BE UPDATED DURING SCAN
+       TAD     LAVAIL
+       DCA     CATBLK  /CURRENT BLOCK IN BUFFER
+       TAD     CATLEN
+       CIA
+       DCA     TMP2    /COUNTER
+CSLOOP,        TAD     (CBUFS+MBUFS
+       TAD     TMP2
+       SMA             /WILL THE REST FIT IN BUFFER?
+       JMP     CSLAST  /YES
+       DCA     TMP2
+       TAD     (-CBUFS-MBUFS^100
+       DCA     TMP1    /ENTRIES NOW IN CORE
+       JMS     SCAT    /SCAN CATALOG
+       TAD     ZCATB   /NEXT BLOCK WE'LL READ
+       DCA     CATBLK
+       JMS     ZCAT    /READ SOME
+       JMP     CSLOOP
+\fCSLAST,       CIA             /NO OF BLOCKS WE DON'T NEED
+       TAD     (CBUFS+MBUFS
+       JMS     R6L     /NO OF ENTRIES WE CAN LOOK AT
+       CIA
+       DCA     TMP1
+       JMS     SCAT    /LOOK FOR END
+FULCAT,        JMS     TTOTXT  /RAN OFF THE END
+       CATFUL-1
+       JMS     CRLF    /**
+       JMP     LCLOSE
+/
+SCAT,  0
+       TAD     (CATBUF-1
+       DCA     X0
+SCLOOP,        CDF     F1
+       TAD I   X0
+       CMA             /TEST FOR END
+       SNA CLA
+       JMP     GETINF  /THAT'S IT
+       ISZ     X0
+       ISZ     X0      /IGNORE REST OF NAME
+       TAD I   X0      /GET LENGTH
+       TAD     LAVAIL  /ADD TO ST BLOCK OF FREE AREA
+       DCA     LAVAIL
+       ISZ     TMP1
+       JMP     SCLOOP
+       CDF     F0
+       JMP I   SCAT    /GO FOR NEXT BUFFER LOAD
+/
+NOTLIB,        JMS     PRLBNM  /PRINT LIBRARY NAME
+       JMS     TTOTXT
+       UNLIB-1
+       JMS     CRLF
+       JMP     START
+       PAGE
+\fNEWLIB,       JMS     FNDLIB
+       ENTER
+       JMS     IOERR
+       TAD     LIBU
+       AND     (7760
+       CLL RTR
+       RTR
+       SNA             /DID HE GIVE A LENGTH?
+       STL RTL         /NO, USE 2
+       DCA     CATLEN
+       CDF     F1
+       TAD I   (EQLO   /HOW MANY EXTRA BLOCKS WANTED
+       CDF     F0
+       TAD     CATLEN  /PLUS CATALOG REQUIREMENT
+       CLL
+       TAD     LIBLEN  /MINUS AVAILABLE LENGTH
+       SZL CLA         /CHECK FOR ENUF ROOM
+       JMP     LSZERR  /NO ROOM, GIVE MESSAGE
+/
+/      WRITE EMPTY CATALOG
+/
+       TAD     (CATBUF-1
+       DCA     X0
+       TAD     (-MBUFS-CBUFS^400
+       DCA     TMP1
+       CDF     F1
+       DCA I   X0
+       ISZ     TMP1
+       JMP     .-2
+       TAD     (CATBUF-1       /RESET FOR LATER USE
+       DCA     X0
+       CLA CMA
+       TAD     CATLEN
+       SPA SNA         /MORE THAN ONE?
+       JMP     CATB0   /JUST ONE
+       CIA
+       ISZ     ZCATB   /START WITH SECOND CAT BLOCK
+ZCLOOP,        CLL
+       TAD     (MBUFS+CBUFS
+       DCA     TMP1
+       SZL             /FULL WRITE?
+       TAD     TMP1    /NO
+       CIA
+       TAD     (MBUFS+CBUFS
+       JMS     R6R
+       TAD     (4000!F1
+       DCA     ZCATC   /SET CONTROL
+       JMS     ZCAT
+       TAD     TMP1
+       SPA
+       JMP     ZCLOOP  /MORE TO GO
+CATB0, CDF     F1
+       CLA IAC         /1 IS LIBRARY CODE
+       DCA I   X0
+       TAD     (VERS
+       DCA I   X0      /MARK LIBRA VERSION #
+       TAD     LIBLEN  /JUST A GUESS
+       CIA
+       DCA I   X0
+       TAD     CATLEN
+       DCA I   X0
+       CLA CMA         /END OF CAT INDICATOR
+       DCA I   X0      /MARKS FIRST AVAIL SLOT
+       CDF     F0
+       DCA     CHANGD  /FORCE A WRITE ON THIS ONE
+       TAD     ZCATB
+       DCA     LAVAIL
+       TAD     LIBBLK  /LIBRARY START BLOCK
+       DCA     CATBLK  /IS CURRENTLY IN BUFFER
+       JMP     GETINF  /BEGIN
+/
+ZCAT,  0
+       CDF     F0
+       JMS     CCHK    /LOOKOUT FOR CONTROL C
+       JMS I   LIBDVH
+ZCATC, F1
+       CATBUF
+ZCATB, 0
+       JMS     IOERR
+       TAD     ZCATC
+       JMS     R6L
+       AND     (17
+       TAD     ZCATB
+       DCA     ZCATB
+       ISZ     CHANGD  /SET UNMODIFIED SW
+       JMP I   ZCAT
+       JMP     .-2
+/
+FNDLIB,        0
+       TAD I   FNDLIB
+       DCA     USRCOD
+       ISZ     FNDLIB
+       TAD     (LIBNAM
+       DCA     LIBBLK
+       TAD     LIBU
+       AND     (17
+       CIF     F1
+       JMS I   USR
+USRCOD,        0
+LIBBLK,        LIBNAM
+LIBLEN,        0               /NEG, REMEMBER
+       JMP I   FNDLIB  /COULD'T DO IT
+       TAD     LIBBLK  /FIRST BLOCK
+       DCA     ZCATB   /OF CATALOG
+       ISZ     FNDLIB
+       JMP I   FNDLIB
+LSZERR,        JMS     TTOTXT
+       SMALL-1
+       JMS     CRLF
+       JMP     START   /GO FOR MORE
+       PAGE
+\f/
+/      SETUP POINTERS AND THINGS FOR NEXT INPUT MODULE
+/
+GETINF,        CLA CMA
+       DCA     INCLUD  /SET NO-NAME-INCLUDED SW
+       TAD     INLSW   /ARE WE GETTING INPUT FROM A LIBR?
+       SZA CLA
+       JMP     INLIB   /YES-GET NEXT MODULE THEREIN
+NXTINF,        CDF     F1
+       TAD I   INFP    /UNIT AND LEN OF NEXT IN FILE
+       SZA             /IS THERE ONE?
+       JMP     FTCHIN  /YES
+       TAD I   (SWATOL
+       AND     (1000   /TEST FOR /C
+       CDF     F0
+       SNA CLA
+       JMP     LCLOSE  /NO MORE
+       JMS     SAVRES  /PRESERVE DEV HANDLER RESIDENCY
+       JMS     TTWAIT  /FINISH ANY TYPING
+       CIF     F1
+       JMS I   USR     /NEW LINE CONTINUES OLD
+       DECODE
+       2214            /RL DEFAULT EXT
+       0               /DO NOT DELETE TENTATIVE FILES
+       JMS     RSTRES  /RESTORE RESIDENCY TABLE
+       TAD     (INF
+       DCA     INFP    /RESET INPUT FILE POINTER
+       JMP     NXTINF  /TRY AGAIN
+\fFTCHIN, DCA     MODU    /UNIT CONTAINING INPUT MOD
+        ISZ     INFP
+        TAD I   INFP
+        DCA     INFST   /START OF INPUT FILE
+        ISZ     INFP
+        TAD     INFST
+        DCA     MODBLK  /IN THIS CASE, FILE=MODULE
+        TAD     MODU
+        AND     (7760
+        CIA
+        CLL RTR
+        RTR
+        DCA     MODLEN
+        TAD     (IDEVH!1
+        DCA     INDVH   /TENTATIVE HANDLER ADDR
+        CDF     F0
+        TAD     MODU
+        AND     (17
+        CIF     F1
+        JMS I   USR
+        FETCH
+INDVH,  IDEVH!1         /TENTATIVE INPUT HANDLER ADDR
+        JMS     IOERR   /DON'T GIVE ME THAT
+        TAD     INDVH
+        DCA     MODDVH  /DEVICE HANDLER ADDRESS
+        DCA     THSBLK  /FORCE READIN TO READ
+LUKMOD, TAD     MODBLK  /FIRST BLOCK OF MODULE
+        DCA     INBLK   /INITIALIZE READIN
+        JMS     READIN  /GET FIRST BLOCK
+        CDF     F1
+        CLA CMA         /-1
+        TAD I   PMOD    /LOOK AT IDENTIFIER
+        CDF     F0
+        SNA
+        JMP     GOTLIB  /ITS A LIBRARY
+        CLL RTR
+        SZA CLA         /IS IT A MODULE
+        JMP     BADINF  /BAD INPUT
+        TAD     LIBBLK  /MAKE SURE
+       CIA
+        TAD     LIBLEN  /THAT MODULE
+        TAD     LAVAIL  /FITS IN LIBRARY
+        CLL
+       SNA             /CHECK FOR TOO LONG HERE TOO**
+       JMP     OVFLO   /IT IS TOO LONG
+        TAD     MODLEN
+        SNL CLA
+        JMP     NXTEBK  /GO GETTUM
+OVFLO,  JMS     TTOTXT
+        TOOBIG-1
+       JMS     CRLF
+        JMP     GETINF
+\fBADINF,       JMS     TTOTXT
+       NOTMOD-1
+       JMS     CRLF
+       JMP     GETINF
+/
+GOTLIB,        TAD     MODLEN
+       SNA CLA
+       JMP     LB2BIG          /CAN'T DO A LOOKUP IF G. T. 255
+       ISZ     INLSW   /SET IN-LIBRARY SWITCH
+       JMP     INLIB
+LB2BIG,        JMS     TTOTXT
+       L2BMSG-1
+       JMS     CRLF
+       JMP     START
+       PAGE
+\f/     GET NEXT MODULE FROM LIBRARY
+/
+INLIB, TAD     INFST   /START OF INPUT FILE
+       DCA     INBLK   /IS WHAT WE WANT
+       JMS     READIN  /BRING CATALOG INTO MODULE BUFFER
+       TAD     (3
+       TAD     PMOD
+       DCA     TMP1
+       CDF     F1
+       TAD I   TMP1    /GET CATALOG LEN
+       CIA
+       DCA     TMP1    /HOLD COUNTER IN CASE OF FULL CATALOG
+       TAD     INFST
+       DCA     INBLK   /WE WANT THE SAME ONE AGAIN
+       TAD     INFST
+       DCA     TMP3    /INIT ACCUMULATED MODULE START BLOCK
+       DCA     MODLEN  /INITAIL MOD LEN IS ZERO
+INLSC1,        JMS     READIN  /GET CATALOG BLOCK
+       TAD     (-100
+       DCA     TMP2    /COUNT ENTRIES IN CAT BLOCK
+INLSC2,        CDF     F1
+       TAD I   PMOD    /LOOK FOR END-OF-CATALOG WORD
+       CMA
+       SNA CLA
+       JMP     NDLSC   /END OF SCAN
+       TAD     (3
+       TAD     PMOD    /POINT TO LENGTH
+       DCA     TMP5
+       TAD I   TMP5
+       SNA CLA         /FIRST ENTRY FOR A MODULE?
+       JMP     NOLEN   /NO, DO NOT UPDATE
+       TAD     MODLEN
+       TAD     TMP3    /UPDATE MODULE STARTING BLOCK
+       DCA     TMP3
+       TAD I   TMP5    /GET THIS LENGTH
+       DCA     MODLEN  /FOR THIS MODULE
+NOLEN, TAD     MODBLK  /COMPARE LAST MODULE STARTING BLOCK
+       CMA CLL
+       TAD     TMP3    /TO ACCUMULATED START BLOCK
+       SNL CLA         /INTERESTING?
+       JMP     NOTYET  /NO
+       TAD I   PMOD    /YES; WAS NAME DELETED?
+       SZA CLA
+       JMP     GLMOD   /NO, WE'VE GOT A GOOD MODULE
+NOTYET,        TAD     (4
+       TAD     PMOD    /POINT TO NEXT NAME
+       DCA     PMOD
+       ISZ     TMP2    /END OF CAT BLOCK?
+       JMP     INLSC2  /NO
+       ISZ     TMP1    /YES; END OF CATALOG?
+       JMP     INLSC1  /NO, GET NEW BLOCK
+NDLSC, DCA     INLSW   /YES, NO LONGER IN A LIBRARY
+       JMP     NXTINF  /GET ANOTHER FILE
+\fGLMOD,        TAD     TMP3    /GET STARTING BLOCK
+       DCA     MODBLK  /OF MODULE
+       JMP     LUKMOD  /AND GO GET THE MODULE
+L2BMSG,        TEXT    "INPUT LIBRARY TOO BIG";0
+       PAGE
+\f/       PROCESS LOOP FOR ONE MODULE
+/
+NXTEBK, TAD     (3
+        TAD     PMOD    /ADDR OF FIRST ESD-1
+        DCA     X0      /RESET POINTER TO NAMES
+        TAD     (-52    /PER BLOCK COUNT
+        DCA     ESDCTR
+ESDLUP, CDF     F1
+        TAD I   X0
+        DCA     ENAM1
+        TAD I   X0
+        DCA     ENAM2
+        TAD I   X0
+        DCA     ENAM3
+        TAD I   X0      /TYPE CODE
+        CDF     F0
+       TAD     (ESDTAB /DISPATCH FROM TBL
+       DCA     TMP1
+       JMP I   TMP1
+ESDTAB,        JMP     ESDEND  /0=END OF ESD TABLE
+       JMP     DUPLUK  /1=ENTRY=LOOK FOR
+                       /DUPLICATE NAME
+       JMP     ESDLND  /2=EXTERN=IGNORE NAME
+       JMP     ESDLND  /3=FORT COMMON=IGNORE
+       JMP     DUPLUK  /4=PROG SECTION
+       HLT             /5=MUL ENTRY=DOESN'T
+                       /EXIST
+       HLT             /6=MUL SECTION=DITTO
+       JMP     DUPLUK  /7=SECT8
+       JMP     ESDLND  /10=COMMZ
+       JMP     DUPLUK  /11=FIELD1
+\f/
+/       LOOK FOR DUPLICATION OF THIS ESD SYMBOL
+/
+DUPLUK,        TAD     CATLEN
+       CIA
+       DCA     TMP1    /COUNT LENGTH OF CAT
+        TAD     CATBLK
+        CIA
+        TAD     LIBBLK  /ARE WE AT FIRST BLOCK?
+        SZA CLA
+        JMS     CHGCHK  /CHECK FOR BLOCK MODIFIED
+        TAD     LIBBLK
+        DCA     NXTCAT  /SETUP FOR FIRST BLOCK OF CAT
+       TAD CATLEN
+       CIA
+       DCA CATCNT
+GETCB, JMS     GCATB   /GET IT
+       TAD     (CATBUF-1
+       DCA     X1
+       TAD     (-100   /COUNT ENTRIES/BLOCK
+       DCA     TMP2
+       CDF     F1
+CBSRCH,        TAD I   X1      /LOOK AT NAME
+       CMA
+       SNA
+       JMP     CHKI    /END OF CATALOG-LOOK FOR /I
+       IAC             /COMPLETE THE CIA
+       TAD     ENAM1   /COMPARE
+       SZA CLA
+       JMP     NOMTCH
+       TAD I   X1
+       CIA
+       TAD     ENAM2
+       SZA CLA
+       JMP     NOMTCH
+       TAD I   X1      /LAST CHANCE
+       CIA
+       TAD     ENAM3
+       SNA CLA
+       JMP     GOTMAT  /EQUAL!
+NOMTCH,        TAD     X1
+       AND     (-4
+       TAD     (3      /BUMP TO NEXT
+       DCA     X1
+       ISZ     TMP2
+       JMP     CBSRCH
+       JMS     CHGCHK  /CHECK FOR MODIFIED BLOCK
+       ISZ     TMP1    /END OF CATALOG?
+       JMP     GETCB   /NO, GET NEXT
+       JMS     TTOTXT
+       CATFUL-1
+       JMS     CRLF
+       CLA CMA
+       DCA     FULFLG
+       JMP     ESDEND  /PUT THAT, IF POSSIBLE
+\fGOTMAT,       CDF     F0
+       JMS     TTOTXT
+       ENAM1-1         /PRINT THE NAME
+       JMS     TTOTXT
+       NDUP-1          /WHICH TO KEEP?
+       CDF     F1
+       TAD I   (SWATOL
+       CDF     F0
+       AND     (10     /TEST /I
+       SNA CLA
+       JMP     CHKR    /NO, LOOK FOR /R
+GMASK, JMS     TTOTXT
+       KEEP-1
+       JMS     WAITOP
+       JMP     ESDLND  /DEFAULT TO THE OLD ONE
+       TAD     (-"O
+       SNA
+       JMP     ESDLND  /KEEP OLD
+       IAC             /IS IT "N"?
+       SZA CLA
+       JMP     GMASK   /TRY AGAIN
+       JMP     DELTO   /DELETE THE OLD
+       PAGE
+\fCHKR,   JMS     CRLF
+        CDF     F1
+        TAD I   (SWMTOX
+        AND     (100    /TEST /R
+        SNA CLA
+        JMP     ESDLND  /DEFAULT:KEEP THE OLD ONE
+DELTO,  CDF     F1
+        TAD     X1
+        AND     (-4
+        CIA
+        CMA             /BACK UP POINTER
+        DCA     X1
+        DCA I   X1      /CLEAR
+        DCA I   X1      /OLD
+        DCA I   X1      /NAME
+        ISZ     X1      /SKIP OVER LENGTH
+        DCA     CHANGD  /BLOCK HAS BEEN MODIFIED
+        JMP     NXTE    /ENTER AT END OF LOOP
+NDSCN, CDF     F1
+        TAD I   X1      /LOOK AT NEXT
+        CMA
+        SNA CLA
+        JMP     ENDCAT  /NOW WE'RE THERE
+       TAD     X1
+       TAD     (3      /BUMP TO NEXT NAME
+       DCA     X1
+NXTE,   ISZ     TMP2
+        JMP     NDSCN
+        JMS     CHGCHK  /LOOK OUT FOR CHANGES
+       ISZ CATCNT      /END OF CAT ?
+       SKP
+       JMP FULCAT      /NO MORE PUSSY
+        JMS     GCATB
+        TAD     (CATBUF-1
+        DCA     X1
+        TAD     (-100
+        DCA     TMP2
+        JMP     NDSCN
+\fCHKI, TAD I   (SWATOL /LOOK AT /I SW
+       AND     (10
+       SNA CLA
+       JMP     ENDCAT  /NOT SET
+       JMS     TTOTXT
+       ENAM1-1         /TYPE ESD NAME
+       JMS     TTOTXT
+       NCLUD-1         /INCLUDE IT?
+IANS,  JMS     WAITOP
+       JMP     ENDCAT  /DEFAULT TO INCLUDE
+       TAD     (-"Y
+       SNA
+       JMP     ENDCAT  /YES, INCLUDE
+       TAD     ("Y-"N
+       SZA CLA         /IS IT "N"?
+       JMP     IANS    /NO, TRY AGAIN
+       JMP     ESDLND
+ENDCAT,        TAD     X1      /POINT TO EMPTY SLOT
+       AND     (-4
+       CIA
+       CMA
+       DCA     X1
+       JMP     INSERT
+       PAGE
+\f/     THIS ESD GOES IN THE CATALOG
+/
+INSERT,        CDF     F1
+       TAD     ENAM1   /MOVE
+       DCA I   X1      /NAME
+       TAD     ENAM2   /TO
+       DCA I   X1      /LIBRARY
+       TAD     ENAM3   /CATALOG
+       DCA I   X1
+       ISZ     INCLUD  /IS THIS THE FIRST?
+       SKP
+       TAD     MODLEN  /YES, GET THE LENGTH
+       DCA I   X1      /AND STORE 4TH WORD
+       DCA     CHANGD  /SET CAT MODIFIED SW
+       CLA IAC
+       TAD     X1      /CHECK FOR END OF BLOCK
+       AND     (377
+       SZA CLA
+       JMP     MARKND  /NO, MARK END OF CAT
+       JMS     CHGCHK  /WRITE THIS BLOCK
+       CDF     F1
+       TAD     (-400
+       DCA     TMP1    /SET COUNT FOR BLOCK LEN
+       TAD     (CATBUF-1
+       DCA     X1      /SET POINTER
+       CLA CMA
+       DCA I   X1
+       ISZ     TMP1
+       JMP     .-2     /CLEAR THE BLOCK
+       DCA     CHANGD
+       ISZ     CATBLK
+       JMP     ESDLND
+MARKND,        CLA CMA
+       DCA I   X1      /MARK NEW END OF CAT
+ESDLND,        CDF     F0
+       CLA STL RTL     /TWO TO SKIP VALUE
+       TAD     X0
+       DCA     X0
+       ISZ     ESDCTR  /DONE WITH BLOCK?
+       JMP     ESDLUP  /NO, GET NEXT
+       JMS     READIN  /GET NEXT BLOK
+       JMP     NXTEBK  /RESET POINTERS AND CONTINUE
+ESDEND,        ISZ     INCLUD  /CHECK FOR ANY NAMES OUT
+       JMP     CPYMOD  /YES, COPY MODULE INTO LIBRARY
+       JMS     TTOTXT  /SORRY, DIDN'T MAKE IT
+       NONEIN-1
+       JMS     CRLF
+       ISZ     FULFLG
+       JMP     GETINF  /TRY NEXT
+       JMP     LCLOSE
+\fCPYMOD,       TAD     MODBLK  /GET IN FILE STRT BLOCK
+       DCA     INBLK
+       TAD     MODLEN
+       CIA
+       DCA     TMP1
+       TAD     LAVAIL  /FIRST AVAILABLE BLOCK
+       DCA     NXTOBK
+CPYLUP,        JMS     READIN  /READ BLOCK OF INPUT
+       TAD     PMOD
+       DCA     PNXTOB
+       JMS I   LIBDVH  /CALL OUTPUT HANDLER
+       4200!F1
+PNXTOB,        MODBUF
+NXTOBK,        0               /NEXT OUTPUT BLOCK NUMBER
+       JMS     IOERR
+       ISZ     NXTOBK  /BUMP BLOCK NUMBER
+       ISZ     TMP1    /CHECK LENGH
+       JMP     CPYLUP
+       TAD     NXTOBK
+       DCA     LAVAIL  /UPDATE AVAILABLE POINTER
+       JMP     GETINF  /GO FOR NEXT
+       PAGE
+\fCHGCHK,       0
+       CDF     F0      /PRECAUTION
+       TAD     CHANGD  /HAS BLOCK BEEN MODIFIED?
+       SZA CLA
+       JMP I   CHGCHK  /NO, NOTHING TO DO
+       TAD     CATBLK
+       DCA     ZCATB   /WRITE THE BLOCK
+       TAD     (4200!F1
+       DCA     ZCATC
+       JMS     ZCAT
+       JMP I   CHGCHK  /OK
+/
+/
+GCATB, 0
+       CDF     F0
+       TAD     NXTCAT
+       CIA
+       TAD     CATBLK  /IS IT IN CORE?
+       SNA CLA
+       JMP     SOEZ    /YES, ITS EZ
+       TAD     NXTCAT
+       CIA
+       TAD     LIBBLK
+       TAD     CATLEN
+       SPA SNA CLA     /CHECK FOR INTERNAL ERROR
+       JMP     FULCAT  /**
+       TAD     NXTCAT
+       DCA     ZCATB
+       TAD     (200!F1 /SET FOR READ
+       DCA     ZCATC
+       JMS     ZCAT
+       TAD     NXTCAT  /NEXT BLOCK
+       DCA     CATBLK  /IS IN CORE
+SOEZ,  ISZ     NXTCAT
+       JMP I   GCATB
+NXTCAT,        0
+       PAGE
+\fLCLOSE,       JMS     CHGCHK
+       TAD     USRCOD
+       TAD     (-ENTER /DID WE ENTER A NEW FILE?
+       SZA CLA
+       JMP     CATLST  /NO, GO LIST CATALOG
+       TAD     LIBBLK  /GET LEN
+       CIA
+       CDF     F1
+       TAD I   (EQLO   /GET USER EXTENSION REQUEST
+       CDF     F0
+       TAD     LAVAIL  /PLUS CURRENT END
+       DCA     TMP1
+       TAD     TMP1
+       CLL
+       TAD     LIBLEN  /CHECK FOR POSSIBLE
+       SNL CLA
+       JMP     .+4
+       TAD     LIBLEN  /CAN'T GIVE ALL HE WANTS
+       CIA
+       SKP
+       TAD     TMP1
+       DCA     LCLEN   /SET CLOSE LENGTH
+       TAD     CATLEN
+       CMA
+       TAD     LCLEN   /COMPARE CAT LEN TO LIB LEN
+       SPA SNA CLA
+       JMP     NOLIB   /THERE'S NO POINT
+       TAD     LIBBLK  /GET FIRST BLOCK
+       DCA     NXTCAT
+       JMS     GCATB
+       CDF     F1
+       TAD     LCLEN   /ACTUAL LIBRARY LENGTH
+       DCA I   (CATBUF+2
+       CDF     F0
+       DCA     CHANGD
+       JMS     CHGCHK  /WRITE IT
+       TAD     LIBU
+       AND     (17
+       CIF     F1
+       JMS I   USR
+       CLOSE
+       LIBNAM
+LCLEN, 0
+       JMS     IOERR
+       JMP     CATLST  /GO LIST THE CATALOG
+/
+NOLIB, JMS     TTOTXT
+       WHYCLS-1
+       JMS     CRLF
+       JMP     START
+       PAGE
+\f/     LIST THE CATALOG
+/
+CATLST,        JMS     OOPEN   /OPEN LISTING FILE
+       JMP     START   /NONE DESIRED
+       TAD     (OCHAR  /SETUP FOR DEVICE-INDEPENDENT
+       DCA     PCHR    /OUTPUT
+       TAD     (214    /AT TOP OF PAGE
+       JMS I   PCHR
+       JMS     CRLF
+       JMS TTOTXT
+       LBV-1
+       JMS     TTOTXT
+       CATOF-1
+       JMS     PRLBNM  /PRINT THE NAME
+       CDF     F1
+       TAD I   (SYSDAT
+       CDF     F0
+       SNA
+       JMP     NODATE  /DON'T KNOW THE DATE
+       DCA     TMP1
+       JMS     TTOTXT
+       ON-1
+       CLA                     /THE FOLLOWING CODE GETS THE DAY
+       DCA     TMP2
+       TAD     TMP1            /GET THE DATE
+       RTR                     /ROTATE THREE RIGHT AND MASK
+       RAR                     /TO GET THE DAY IN OCTAL
+       AND     (37
+       JMS     MAK8BT          /MAKE IT 8-BIT AND PRINT
+       DCA     TMP2
+       TAD     TMP1            /GET THE DATE BACK
+       AND     (7400           /MASK TO GET THE MONTH BITS
+       JMS     R6R             /MONTH*4 (IN OCTAL)
+       DCA     TMP2            /PUT IN TEMP. VARIABLE TO SAVE IT
+       TAD     TMP2            /GET IT BACK
+\f      RTR                     /MONTH
+       TAD     TMP2
+       TAD     (MONTHS-6
+       DCA     .+2             /ADDRESS OF MONTH FROM TABLE
+       JMS     TTOTXT          /PUT IT IN THE TEXT LINE
+       0
+       TAD     TMP1            /GET THE DATE---TO FIND THE YEAR
+       AND     (7              /MASK TO GET THE YEAR OFFSET BITS
+       DCA     TMP4            /SAVE THEM
+       DCA     TMP2
+       TAD I   (7777           /GET THE DATE EXTENSION BITS
+       AND     (600
+       CLL RTR                 /ROTATE TO GET THEM INTO BIT
+       RTR                     /POSITIONS 7 AND 8
+       TAD     (106            /ADD 70(ORIGINAL BASE YEAR)
+       TAD     TMP4            /ADD IN THE YEAR OFFSET BITS
+       JMS     MAK8BT          /MAKE 8-BIT AND PRINT
+NODATE,        JMS     CRLF
+       JMP     PRCAT   /TITLE IS DONE, PRINT CAT
+MAK8BT, 0                      /ROUTINE TO CONVERT TO 8-BIT AND PRINT
+       CLL                     /FIRST CONVERT TO DECIMAL
+CONVYR, TAD    (-12            /KEEP SUBTRACTING 12
+       SPA                     /HAVE THE YEAR
+       JMP     GETDG1
+       ISZ     TMP2            /HOLDS THE FIRST DIGIT OF YEAR
+       JMP     CONVYR
+GETDG1, TAD    (12             /GET THE SECOND DIGIT
+       DCA     TMP3            /SAVE IT
+       TAD     TMP2            /GET THE FIRST DIGIT
+       SNA                     /FIRST DIGIT IS A ZERO
+       JMP     PRDIG2          /PRINT THE SECOND DIGIT
+       TAD     (260            /MAKE FIRST DIGIT OF YEAR 8-BIT
+       JMS I   PCHR            /PRINT IT
+PRDIG2, TAD    TMP3            /GET THE SECOND DIGIT
+       TAD     (260            /MAKE SECOND DIGIT OF YEAR 8-BIT
+       JMS I   PCHR            /PRINT IT
+       JMP I   MAK8BT          /RETURN
+       PAGE
+\f/     LIST ALL ENTRIES IN THE CATALOG
+/
+PRCAT, TAD     CATLEN
+       CIA
+       DCA     TMP1
+       TAD     LIBBLK
+       DCA     NXTCAT
+       CLA CMA
+       DCA     TMP3    /SET LINE COUNTER
+CATLUP,        JMS     GCATB
+       TAD     (CATBUF-1
+       DCA     X0
+       TAD     (-100
+       DCA     TMP2
+CATLP2,        CDF     F1
+       TAD I   X0      /GET FIRST WORD OF NAME
+       SNA
+       JMP     EMPTY   /NOT AN ESD NAME
+       CMA
+       SNA
+       JMP     NDCATL  /END OF CATALOG
+       CMA             /RESTORE FIRST WORD
+       JMS     TTO2    /PRINT
+       JMP     NDNAM   /A SHORT NAME
+       CDF     F1
+       TAD I   X0
+       JMS     TTO2
+       JMP     NDNAM
+       CDF     F1
+       TAD I   X0
+       JMS     TTO2
+       NOP
+NDNAM, ISZ     TMP3    /MORE ROOM ON THIS LINE?
+       JMP     SAMLIN  /SURE
+       JMS     CRLF
+       TAD     (-10    /SETUP FOR 8 PER LINE
+       DCA     TMP3
+       JMP     EMPTY
+SAMLIN,        JMS     TAB     /SPACE OVER TO NEXT NAME
+EMPTY, TAD     X0
+       AND     (-4
+       TAD     (3
+       DCA     X0      /POINT TO NEXT
+       ISZ     TMP2
+       JMP     CATLP2  /GO FOR NEXT
+       ISZ     TMP1    /MORE BLOCKS?
+       JMP     CATLUP  /YES
+       JMS     CRLF
+       JMS     TTOTXT
+       CATFUL-1
+NDCATL,        JMS     CRLF
+       TAD     (214    /EJECT PAGE
+       JMS I   PCHR
+       JMS     OCLOSE  /CLOSE THE FILE
+       JMP     START
+       PAGE
+\f/     USEFUL OUTPUT THINGS
+/
+TTO,   0
+       DCA     TTOCHR
+       JMS     TTWAIT
+       TAD     (200
+       KRS
+       TAD     (-217   /CRTL/O CHECK
+       SNA CLA
+       KSF
+       SKP
+       JMP I   TTO
+       TAD     TTOCHR
+       TLS
+       DCA     TTFLAG
+       JMP I   TTO
+TTOCHR,        0
+TTWAIT,        0
+       TAD     TTFLAG
+       SNA CLA
+       JMP I   TTWAIT
+       JMS     CCHK    /BEWARE OF CTRL/C
+       TSF
+       JMP     .-2     /WAIT TILL DONE
+       DCA     TTFLAG  /CLEAR BUSY FLAG
+       JMP I   TTWAIT
+CCHK,  0
+       KSF
+       JMP I   CCHK    /NOTHING TO WORRY ABOUT
+       TAD     (200
+       KRS
+       TAD     (-203
+       SNA CLA         /WAS IT CONTROL C?
+       JMP I   (7600   /YES
+       JMP I   CCHK
+TTO2,  0
+       DCA     TMP7
+       TAD     TMP7
+       JMS     R6R
+       JMS     TTO2A
+       TAD     TMP7
+       JMS     TTO2A
+       ISZ     TTO2
+       JMP I   TTO2
+TTO2A, 0
+       AND     (77
+       SNA
+       JMP I   TTO2
+       TAD     (-40
+       SPA
+       TAD     (100
+       TAD     (240
+       JMS I   PCHR
+       ISZ     TTPOS   /BUMP POSITION COUNT
+       JMP I   TTO2A
+\fR6R,  0
+       CLL RTR
+       RTR
+       RTR
+       JMP I   R6R
+R6L,   0
+       CLL RTL
+       RTL
+       RTL
+       JMP I   R6L
+TTOTXT,        0
+       CDF     F0
+       TAD I   TTOTXT
+       DCA     X7
+       ISZ     TTOTXT  /BUMP PAST POINTER
+       TAD I   X7
+       JMS     TTO2
+       JMP I   TTOTXT
+       JMP     .-3
+CRLF,  0
+       DCA     TTPOS   /RESET POSITION
+       TAD     (215
+       JMS I   PCHR
+       TAD     (212
+       JMS I   PCHR
+       JMP I   CRLF
+TAB,   0               /PSEUDO-TAB GENERATOR
+       TAD     (240
+       JMS I   PCHR
+       ISZ     TTPOS
+       TAD     TTPOS
+       AND     (7
+       SNA CLA         /IS POSITION A MULTIPLE OF 8
+       JMP I   TAB
+       JMP     TAB+1   /NO, TRY MORE
+       PAGE
+\fWAITOP,       0
+       TAD     (277    /QUESTION
+       JMS     TTO
+       DCA     RETCHR
+WREP,  JMS     TTI     /WAIT FOR REPLY
+       TAD     (-215
+       SNA
+       JMP     DFALT
+       TAD     (215-240        /PRINTING?
+       SPA
+       JMP     WREP    /NO, TRY AGIAN
+       TAD     (240
+       DCA     RETCHR
+       TAD     RETCHR
+ECHO,  JMS     TTO
+       JMS     TTI
+       TAD     (-215
+       SNA
+       JMP     GOTREP
+       TAD     (215-377        /LOOKOUT FOR RUBOUT!
+       SNA
+       JMP     RUBOUT
+       TAD     (377
+       JMP     ECHO
+RUBOUT,        JMS     CRLF
+       JMP     WAITOP+1
+GOTREP,        ISZ     WAITOP  /GOT A REAL ANSWER
+DFALT, JMS     CRLF
+       TAD     RETCHR
+       JMP I   WAITOP
+RETCHR,        0
+/
+TTI,   0
+       KSF             /WAIT FOR A KEY
+       JMP     .-1
+       KRB
+       AND     (177    /TAKE CARE OF PARITY
+       TAD     (-3     /CTRL C?
+       SNA
+       JMP I   (7600   /YES
+       TAD     (203    /GET ORGINIAL CHAR BACK
+       JMP I   TTI
+PAGE
+\f/
+/      INPUT BUFFERRER AND STUFF
+/
+READIN,        0
+       CDF     F0
+       TAD     INBLK
+       TAD     THSBLK  /-FIRST BLOCK FOLLOWING BUFFER CONTENTS
+       CLL
+       TAD     (MBUFS
+       SNL             /IS IT IN CORE?
+       JMP     MUSTRD  /NO, WE HAVE TO DO A READ
+       CLL RTR
+       RTR
+       RAR             /TIMES 400
+SETP,  TAD     (MODBUF /PLUSS BUFFER ADDR
+       DCA     PMOD    /POINTS TO BLOCK
+       ISZ     INBLK   /READY FOR NEXT
+       JMP I   READIN
+MUSTRD,        CLA             /THIS ONE'S HARDER
+       TAD     INBLK
+       DCA     RDBLK
+       TAD     INBLK
+       TAD     (MBUFS
+       CIA
+       DCA     THSBLK
+       JMS I   MODDVH
+       MBUFS^200!F1
+       MODBUF
+RDBLK, 0
+       JMS     IOERR
+       JMP     SETP    /OK
+\f/     ROUTINES TO SAVE AND RESTORE
+/      DEVICE HANDLER RESIDENCY TABLE
+/
+SAVRES,        0
+       TAD     (DHRES-1
+       DCA     X0
+       TAD     (SVRES-1
+       DCA     X1
+       JMS     MOVRES
+       JMP I   SAVRES
+RSTRES,        0
+       TAD     (SVRES-1
+       DCA     X0
+       TAD     (DHRES-1
+       DCA     X1
+       JMS     MOVRES
+       JMP I   RSTRES
+MOVRES,        0
+       TAD     (-17
+       DCA     TMP1
+       CDF     F1
+       TAD I   X0
+       DCA I   X1
+       ISZ     TMP1
+       JMP     .-3
+       CDF     F0
+       JMP I   MOVRES
+SVRES=7400
+\f/     PRINT THE LIBRARY NAME
+/
+PRLBNM,        0
+       TAD     LIBNAM
+       JMS     TTO2    /FIRST 2 CHARS
+       JMP     PREXT
+       TAD     LIBNAM+1
+       JMS     TTO2
+       JMP     PREXT
+       TAD     LIBNAM+2
+       JMS     TTO2
+       NOP
+PREXT, TAD     (".
+       JMS I   PCHR
+       TAD     LIBNAM+3
+       JMS     TTO2
+       JMP I   PRLBNM
+       JMP I   PRLBNM
+       PAGE
+\f/     OUTPUT HANDLERS STOLEN FROM PIP
+OUFLD=F1
+OUCTL=MBUFS^200!4000!F1
+OUBUF=MODBUF
+/
+/      INITIALIZE FOR OUTPUT
+/
+OUSETP,        0
+       TAD     (OUCTL&3700     /BUFFER SIZE IN DBL WORDS
+       CIA             /NEGATE IT (PAL10 BLOWS)
+       DCA     OUDWCT
+       TAD     (OUBUF
+       DCA     OUPTR   /INITIALIZE WORD POINTER
+       TAD     OUJMPE
+       DCA     OUJMP   /INITIALIZE 3-WAY CHARACTER SWITCH
+       JMP I   OUSETP
+/
+/      STORE CHARACTERS IN OUTPUT BUFFER
+/      IN PS8 FORMAT (YOU KNOW, 3 CHARS
+/      IN 2 WORDS THE WRONG WAY)
+/
+OCHAR, 0
+       AND     (377
+       DCA     OUTEMP
+       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     F0
+       JMP I   OCHAR
+OUTEMP,        0
+OUPOLD,        0
+OUPTR, 0
+OUJMPE,        JMP     OUJMP
+OUDWCT,        0
+/
+/      MOVE OUTPUT FILE NAME TO FIELD 0
+/
+OFNAME,        0
+       TAD     (OUTF2
+       DCA     X0      /NAME OF CAT LIST FILE
+       CDF     F1
+       TAD I   X0
+       DCA     OUFNAM  /FIRST 2 CHARS
+       TAD I   X0
+       DCA     OUFNAM+1
+       TAD I   X0
+       DCA     OUFNAM+2
+       TAD I   X0
+       SNA
+       TAD     TXTCA   /DEFAULT CAT EXT
+       DCA     OUFNAM+3
+       CDF     F0      /RESTORE FIELD
+       JMP I   OFNAME
+OUFNAM,        ZBLOCK  4
+TXTCA, 301
+       PAGE
+\fOOPEN,        0
+       CDF     F1
+       TAD I   (OUTF2  /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 I   OOPEN   /NOTHING TO OPEN
+       TAD     OUNAME  /RESET ENTER CALL
+       DCA     OUBLK
+       TAD     (IDEVH!1
+       DCA     OUHNDL
+       TAD     OUELEN  /THE UNIT
+       CIF     F1
+       JMS I   USR
+       FETCH           /ASSIGN, FETCH HANDLER
+OUHNDL,        0               /OUTPUT DEVICE HANDLER ENTRY
+       JMS     IOERR           /HUH?
+       TAD     OUELEN  /UNIT AGAIN
+       CIF     F1
+       JMS I   USR
+       ENTER           /ENTER OUTPUT FILE
+OUBLK, OUFNAM          /REPLACED WITH STARTING BLOCK
+OUELEN,        0               /REPLACED WITH LENGTH OF HOLE
+       JMS     IOERR   /YOU BLEW IT!!!
+       DCA     OUCCNT
+       JMS I   (OUSETP
+       ISZ     OOPEN
+       JMP I   OOPEN
+\fOUTDMP,       0
+       DCA     OUCTLW  /STORE THE CONTROL WORD
+       TAD     OUCCNT
+       SNA
+       ISZ     OUCTLW
+       TAD     OUBLK
+       DCA     OUREC   /COMPUTE STARTING BLOCK
+       TAD     OUCTLW
+       JMS     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 ?
+       JMS     IOERR   /YES - ERROR
+       CDF     F0
+       JMS I   OUHNDL
+OUCTLW,        0
+       OUBUF
+OUREC, 0
+       JMS     IOERR
+       JMP I   OUTDMP
+\fOCLOSE,       0
+       TAD     (232    /OUTPUT A CTRL/Z
+       JMS I   PCHR
+FILLLP,        JMS I   PCHR
+       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 F1
+       TAD I   (OUTF2
+       CDF     F0
+       JMS I   USR
+       CLOSE           /CLOSE THE OUTPUT FILE
+OUNAME,        OUFNAM          /POINTER TO OUTPUT FILE NAME
+OUCCNT,        0
+       JMS     IOERR   /ERROR WHILE CLOSING - BAD!!
+       JMP I   OCLOSE  /ALL DONE
+       PAGE
+\f/     MESSAGES
+/
+LBV,   TEXT    "LIBRA V "
+*.-1
+VMESG, VERS&70^7+VERS+6060
+       PATCH&77^100+40
+       4000
+NONEIN,        TEXT    "MODULE NOT INCLUDED";0
+FLSTR, TEXT    "LIBRARY MUST BE ON A FILE-STRUCTURED DEVICE";0
+SMALL, TEXT    "INSUFFICIENT SPACE FOR LIBRARY";0
+NOTMOD,        TEXT    "INPUT NOT A MODULE";0
+TOOBIG,        TEXT    "INPUT TOO BIG FOR LIBRARY";0
+UNLIB, TEXT    " IS NOT A LIBRARY";0
+NDUP,  TEXT    " IS DUPLICATE NAME";0
+KEEP,  TEXT    "; KEEP OLD OR NEW";0
+CATFUL,        TEXT    "CATALOG IS FULL";0
+NCLUD, TEXT    ": INCLUDE";0
+WHYCLS,        TEXT    "LIBRARY TOO SMALL FOR USE; START OVER";0
+IOMSG, TEXT    "I/O ERROR";0
+CATOF, TEXT    "CATALOG OF ";0
+ON,    TEXT    " ON ";0
+CS197, TEXT    ", 197";0
+MONTHS, TEXT    "-JAN-@@@@@-FEB-@@@@@-MAR-@@@@"
+       TEXT    "-APR-@@@@@-MAY-@@@@@-JUN-@@@@"
+       TEXT    "-JUL-@@@@@-AUG-@@@@@-SEP-@@@@"
+       TEXT    "-OCT-@@@@@-NOV-@@@@@-DEC-@@@@"
+       $
+\f
diff --git a/sw/f4/FRTSRC/load.pa b/sw/f4/FRTSRC/load.pa
new file mode 100644 (file)
index 0000000..4f2244c
--- /dev/null
@@ -0,0 +1,3084 @@
+/ OS/8 F4 LOADER, V24A
+/
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/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.
+/
+/
+/
+/
+/
+/
+\f/
+/ FIXES FOR V23        J.K.    1975
+/
+/ .CORE ROUTINE- RECONIZE CORE RESTRICTION
+/
+/
+/
+/      CHAMGES FOR OS/8 V3D AND OS/78 BY P.T.
+/      .CHANGED VERSION NUMBER TO 24A
+/      .PUT IN NEW DATE ALGORITHM
+/
+/
+VERNUM=24
+PATCH="A
+
+ESDPG= 7400            /START OF ESD REFERENCE PG IN FIELD 1
+LHDR=  7200            /WD0 IN CORE OF LDR HDR IN FIELD 1
+OS8SWS=        7643
+OSJSWD=        7746
+OS8DCB=        7760
+OSDATE=        7666
+AC7776=        CLL STA RAL
+AC7775=        CLL STA RTL
+AC4000=        CLA STL RAR
+AC2000=        CLA STL RTR
+AC0002=        CLA STL RTL
+
+/      PASS0 DEFINITIONS
+/      ----- -----------
+
+MCTTBL=        6000            /MODULE COUNT TABLE BASE
+OVTLEN=        2^20^7+2+1      /2 WORDS/OVERLAY, 2 FOR MAIN & 1 FGL
+OVLTBL=        MCTTBL-OVTLEN   /(FGL = FOR GOOD LUCK)
+MODTBL=        21^7+MCTTBL+3   /START OF MODULE TABLE
+NUMMOD=        7200-MODTBL%3   /NUMBER OF ENTRIES IN MODULE TABLE
+PTRIO= NDX6            /FLD1;INIT SET TO 7617-1
+RALFBF=        7000            /FLD1;BLK TO READ"ESD"FOR FILE CHK
+\f/LOADER IMAGE HEADER BLOCK DUMMY SECTION
+
+       NOPUNCH
+       *LHDR
+       2               /LOADER IMAGE FILE ID
+QRTSWP,        ZBLOCK  2       /SWAPPER ARGS TO LOAD AND START USER MAIN
+QHGHAD,        ZBLOCK  2       /HIGHEST ADDRESS USED BY THIS PROGRAM
+QVERNO,        0               /LOADER VERSION NUMBER
+QDPFLG,        0               /"D.P. HARDWARE REQUIRED" FLAG
+QUSRLV,        ZBLOCK  40      /USER OVERLAY LEVEL DSRN INFO
+LDBUFS,        ZBLOCK  50      /PASS2 BUFFER POINTERS
+       ENPUNCH
+
+
+       /RTS ENTRY POINTS
+       /** SOME OF THESE MAY CHANGE IN FUTURE VERSIONS OF RTS **
+       /**     (I HOPE NOT)
+
+JARGER=        204
+JBAK=  210
+JDATE= 203
+JDEF=  213
+JDISMS=        412
+JENDF= 211
+JEOFSW=        16
+JEXIT= 223
+JHANG= 524
+JIDLE= 227
+JINT=  403
+JRDAO= 217
+JREADO=        221
+JRENDO=        206
+JRETRN=        235
+JREW=  212
+JRSVO= 207
+JRUO=  215
+JSWAP= 222
+JT812= 225
+JUERR= 204
+JWDAO= 216
+JWRITO=        220
+JWUO=  214
+\f      *0
+TMP0,  0               /TMP0-TMP4 FOR GEN. USE
+TMP1,  0
+TMP2,  0
+TMP3,  0
+
+       *10             /INDEX REGISTERS
+NDX0,  0
+NDX1,  0
+NDX2,  0
+NDX3,  0
+NDX4,  0
+NDX5,  0
+NDX6,  0
+NDX7,  OVLTBL-1        /POINTER INTO OVERLAY LENGTH TABLE
+
+USR,   200             /USR CALL: COULD BE 200 OR 7700
+PPACK, PACK            /CHANGED TO TTYO BY ERROR ROUTINE
+IOFLG, 0
+SYMTM3,        SYMTBL-3
+ORGFLG,        0
+RFPTR1,        0
+GPTR,  0
+LBPTR, 0
+TRPCNT,        0
+P2FLG, 0
+CZFLG, 0
+F1FLG, 0
+S8FLG, 0
+OVRFLO,        -1
+SWITZ, -1
+SVMAIN,        -4              /0 IF /S SPECIFIED
+DPFLG, 0
+        
+\f/MORE PAGE ZERO LOCATIONS
+GTYP,  0
+EPTR,  0
+EPT2,  0
+ETYP,  0
+BPTR,  0
+BPT2,  0
+REFPTR,        0
+RLEN,  0
+FTMP0, 0;0
+RBLK,  0
+FATAL, 0
+BP,    LDBUFS  /POINTER INTO PASS2 BUFFER ARRAY
+A1,    1;0     /CURRENT ADDRESS IN FIELDS 1-7
+LNONUM,        0
+LBCNT, 0
+BLKCNT,        0
+TRAPV, 0;0
+BLKSIZ,        0
+BSECTP,        0       /POINTER INTO BINARY SECTION TABLE (PASS 2)
+OUTINH,        0
+BLKBEG,        0
+NEWBLK,        0
+NEWLEN,        0
+MCNT,  0
+MBGCNT,        0
+TMP4,  0
+TMP5,  0
+       PAGE
+\f/LOADER STARTS AT 200
+
+       ISZ     .+2     /NON-CHAIN ENTRY
+       JMP I   .+1     /CHAIN ENTRY
+       START
+
+/COME HERE TO READ/WRITE THE LOADER IMAGE.
+        
+LDRIO, 0               /AC=4000 FOR WRITE, 0 FOR READ
+       DCA     LDRIOC  /STORE READ/WRITE
+       JMS I   (NEWBUF
+       TAD     BP
+       DCA     LDRIOA
+       ISZ     LDRIOA
+       TAD I   LDRIOA
+       DCA     LDRIOB  /BLOCK #
+       ISZ     LDRIOA
+       TAD I   LDRIOA  /NUMBER OF BLOCKS LEFT IN SECTION
+       SPA SNA
+       JMP     LDRIOR  /NULL BUFFER - JUST IN CASE
+       TAD     [-4
+       SMA
+       CLA             /IF >4 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
+\fSETBGX,       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
+\f/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
+\fRTNOS8,       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
+\f/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
+\f/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
+\f/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
+\f/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
+\f/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
+\fNXTESD,       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
+\fADVOVR,       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
+\fBY7,  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
+\fNXTOVR,       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
+\f/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
+\fYECCH,        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
+\fGETTYP,       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
+\f/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
+\fSYMMAP,       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 **
+\fDUNMP,        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
+\fHAFWD,        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
+\f/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
+\fCVRT, 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
+\fCVLOVL,       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
+\f/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
+\f/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
+\fSETREF,       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
+\fBLDTV,        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
+\f      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
+\fNEWORG,       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
+\fPROVLY,       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
+\f/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/
+\fMERGE,        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
+\f/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.
+\fNEWBB,        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
+\f/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
+\f/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
+\f/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
+\f              /** 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
+\fGETTXT,       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
+\f/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
+\fBADDY,        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
+\f/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
+\f
+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
+\f/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
+\fPRGSCN,       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
+\fENTMN2,       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
+\fMNS8, 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
+\fSTPAS1,       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
+\fLBFLD,        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
+\fRDLBR,        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
+
+\f/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
+\fDUNMN,        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
+\fLOP6, 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
+\fDUNLVL,       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
+\fALLDN1,       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
+\f      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
+\f/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
+\fDO8S, 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
+\fFIT,  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
+\fLEVLUP,       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
+\fGETLEN,       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=        .
+\f/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
+\f/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
+\f      *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
+\fGETDAT, 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
+\fMONTHS, 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
+\f      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
+\f      *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)
+\fTRPSYM,       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
+\f/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
+\f/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
+\f/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
+\f/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
+\f/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
+\fLIBRAR,       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
+\f/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
+\fMAXRLF,       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
+\fMIERR,        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
+\f/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
+\f/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
+\f      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
+\f/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
+\fINIBFS,       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
+\f      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
+\f/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
+
+       $$$$$
+\f
diff --git a/sw/f4/FRTSRC/ltr.ra b/sw/f4/FRTSRC/ltr.ra
new file mode 100644 (file)
index 0000000..0951798
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/onqib.ra b/sw/f4/FRTSRC/onqib.ra
new file mode 100644 (file)
index 0000000..2357697
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/p2ocfg.pa b/sw/f4/FRTSRC/p2ocfg.pa
new file mode 100644 (file)
index 0000000..f9db3cf
--- /dev/null
@@ -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 (file)
index 0000000..0a6b273
--- /dev/null
@@ -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
+\f/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  <OVERLY=0>
+       IFNZRO  OVERLY  <NOPUNCH>
+       *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
+\f/ 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
+\f/ 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
+\f/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
+\f/ 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
+\f/ 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
+\f/ 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
+\fLTRNE,        TEXT    '#NE'
+       TEXT    '#GE'
+       TEXT    '#LE'
+       TEXT    '#GT'
+       TEXT    '#LT'
+       TEXT    '#EQ'
+       PAGE
+\f/ SOME TEXT
+
+P2,    TEXT    '+2'
+XVAL,  TEXT    '#VAL'
+DP4,   TEXT    '.+4'
+FADD,  TEXT    'FADD'
+FLDA,  TEXT    'FLDA'
+FSUB,  TEXT    'FSUB'
+\f/ 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
+\fSATEMP,
+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
+\f/ 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'
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\fENDM, 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'
+\f/ 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
+\f/ 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
+\f/ 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 <XXXXXX>
+       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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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'
+\fJNE,  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'
+\f/ 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
+\f/ 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
+\f/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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\fDNA,  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
+\f/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'
+\f/ 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
+\f/ 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
+\f/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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/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
+\f/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
+\f/ 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
+\f/ 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
+\f/ 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
+\f/ 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
+\f      FIELD   1
+       *5000
+       0                       /THIS IS THE START OF
+                               /THE ERROR MESSAGE LIST
+                               /WHICH WORKS BACKWARDS
+\f/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
+\f/ 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
+\f/ 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
+\fLETABL,       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
+\fANDTBL,       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
+\fEQVTBL,       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
+\f/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
+\f/ 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
+\f/ 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
+\f/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
+\f/ 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
+\f/ 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
+       $
+\f
diff --git a/sw/f4/FRTSRC/pass3.pa b/sw/f4/FRTSRC/pass3.pa
new file mode 100644 (file)
index 0000000..62dac35
--- /dev/null
@@ -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
+\f/ 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
+/
+/
+\f/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
+\f      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
+\f      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    <PAGE>
+\fENDX, 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
+\f/ 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
+\f      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
+\f      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'
+\fPAGEN,        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
+\fMOVE, 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
+       $
+\f
diff --git a/sw/f4/FRTSRC/pause.ra b/sw/f4/FRTSRC/pause.ra
new file mode 100644 (file)
index 0000000..76419a4
--- /dev/null
@@ -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 (file)
index 0000000..9fed56c
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/realtm.ra b/sw/f4/FRTSRC/realtm.ra
new file mode 100644 (file)
index 0000000..b721892
--- /dev/null
@@ -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
+\f      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.
+\f      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
+\f
diff --git a/sw/f4/FRTSRC/rfcv.ra b/sw/f4/FRTSRC/rfcv.ra
new file mode 100644 (file)
index 0000000..48c509b
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/rfdv.ra b/sw/f4/FRTSRC/rfdv.ra
new file mode 100644 (file)
index 0000000..b864b16
--- /dev/null
@@ -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 (file)
index 0000000..d824a4f
--- /dev/null
@@ -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
+/
+/
+\f      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
+\fDORITE,       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
+\f
diff --git a/sw/f4/FRTSRC/rtl.pa b/sw/f4/FRTSRC/rtl.pa
new file mode 100644 (file)
index 0000000..13c43ea
--- /dev/null
@@ -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.
+/
+/
+/
+/
+/
+/
+\f/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
+\f/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
+\f/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
+\f/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
+\fNOTLI,        JMS I   (RLERR
+       NOLI
+       JMP     LICD
+
+LDIOER,        JMS I   (RLERR
+       LIOEMS
+       CDF CIF 0
+       JMP I   (7605
+       PAGE
+\f/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.
+\f/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
+\f/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
+\f/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
+\fNOFPP,        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
+\fTAKCAR,       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
+\fGETHAN,       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
+\f/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
+\fHCWTBA,       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
+\f/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
+\fSTDSRN,       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
+\fNONUM,        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
+\fTSTSWS,       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
+\fSPMDCD,       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
+\fGETION,       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
+\f/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
+\f/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=  .
+\f/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
+\f/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
+\f/RANDOM FPP CODE FOR D.P. I/O
+DFSTM2,        FSTA+LONG
+       DFTMP2
+       FEXIT
+
+       PAGE
+\f/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
+\fSKPZRO,       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
+\fDRDCPT,       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
+\fDBLDIG,       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
+\fDSCLDN,       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
+\f/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
+\f/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
+\fDFIXUP,       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
+\f/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
+\f      *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
+\f/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
+\f/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
+\f/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
+\f/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
+\f/"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
+\f      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
+\f      *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
+\fNOBTCH,       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
+\fGOAWAY,       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
+       $$$-$$$-$$$
+\f
diff --git a/sw/f4/FRTSRC/rts.pa b/sw/f4/FRTSRC/rts.pa
new file mode 100644 (file)
index 0000000..7fd43cf
--- /dev/null
@@ -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.
+/
+/
+/
+/
+/
+/
+\f/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
+\f/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
+\f/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
+\f/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
+\f/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
+\f/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?
+\f/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__>
+\f/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
+\fKBD,  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
+\f/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
+\f/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
+\f/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
+\f/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)
+\f/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
+\fFMTGCH,       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
+\f/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
+\f/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!
+\fMORE, 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
+\fENDREC,       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
+\fCHTYPE,       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
+\f/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
+\f/"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
+\f/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
+\f/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
+\f/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
+\f/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
+\f/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
+\fGETCH3,       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
+\f/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
+\f/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
+\f/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
+\f/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
+\f/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
+\f/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
+\f/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
+\fINMINS,       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
+\fSCALDN,       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
+\f/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
+\f/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
+\f/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
+\f/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
+\f/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
+\fECHO, 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
+\f/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
+\f/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
+\f/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
+\f/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
+\f/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.
+\f/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
+\f/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
+\f/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
+\f/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
+\f/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
+\f/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
+\fPCHWD,        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
+\fPRTCR,        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
+\f/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
+\f/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
+\f/
+/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
+\fOADD, 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
+\f/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
+\f/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
+\fMAKCDF,       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
+\f/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
+\f/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
+\fHPLACE,       /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
+\f/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
+\f/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
+\f/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 **
+\f/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
+\f/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
+\f/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
+\f/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
+\f/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)
+\f/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
+\fDCDIDX,       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
+\f/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
+\f/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
+\f/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
+\f/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
+\f/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
+\f/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
+\fFPPKG=        .               /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
+\fMDONE,        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
+\f/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
+\f/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
+\f/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
+\f/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
+\f/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
+\f/"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
+\f/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
+\f/PAGE 7400 UNUSED RIGHT NOW
+
+LPBUFE,        ZBLOCK  177
+       LPBUFR
+       FIELD 1
+\f
diff --git a/sw/f4/FRTSRC/sign.ra b/sw/f4/FRTSRC/sign.ra
new file mode 100644 (file)
index 0000000..50137b1
--- /dev/null
@@ -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
+\f
diff --git a/sw/f4/FRTSRC/sin.ra b/sw/f4/FRTSRC/sin.ra
new file mode 100644 (file)
index 0000000..bf938a1
--- /dev/null
@@ -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<PI/2
+       JLT     SINPP           /YEP.
+/
+       FLDA    FPISIN          /SIN(X)=SIN(PI-X)
+       FSUB    SIN2
+       FSTA    SIN2            /AND STORE IT BACK.
+/
+SINPP, FLDA    SIN2            /GET THE MAGIC NUMBER.
+       FSUB    SINTST          /SEE IF ITS CLOSE TO AN EDGE
+       JGT     SINPPP          /IT IS NOT
+       FLDA    SIN2            /RECALL NUMBER IF TOO SMALE
+       JXN     SINRTN,0                /EXIT IF SAME SIGN.
+       FNEG                    /ELSE NEGATE IT.
+       JA      SINRTN
+SINPPP,        FLDA    SIN2            /RECALL NUMBER TO BE WORKED ON.
+       FDIV    FPI2SN          /DIVIDE BY PI OVER TWO.
+       FSTA    SIN2            /AND STORE BACK.
+       FMUL    SIN2            /MULTIPLY OUT.
+       FSTA    SIN1
+       FMUL    SINC9           /NOW DO THE STANDARD ITERATION.
+       FADD    SINC7
+       FMUL    SIN1
+       FADD    SINC5
+       FMUL    SIN1
+       FADD    SINC3
+       FMUL    SIN1
+       FADD    FPI2SN          /ADD IN PI OVER 2
+       FMUL    SIN2            /DO THE FINAL MULTIPLY.
+       JXN     SINRTN,0                /SHALL WE NEGATE
+       FNEG                    /YEP
+       JA      SINRTN          /AND RETURN.
+\f
diff --git a/sw/f4/FRTSRC/sind.ra b/sw/f4/FRTSRC/sind.ra
new file mode 100644 (file)
index 0000000..66ac14c
--- /dev/null
@@ -0,0 +1,48 @@
+/
+/
+/      S   I   N   D
+/      -   -   -   -
+/
+/SUBROUTINE SIND(X)
+/
+/ VERSION 5A 4-27-77  PT
+/
+       SECT    SIND
+       JA      #SIND
+       TEXT    +SIND  +
+SINDXR,        SETX    XRSIND
+       SETB    BPSIND
+BPSIND,        FNOP
+       0
+       0
+XRSIND,        F 0.0
+SIND91,        6
+       3451
+       3560
+SIND1, F 0.0
+       ORG     10*3+BPSIND
+       FNOP
+       JA      SINDXR
+       0
+SNDRTN,        JA      .
+       BASE    0
+#SIND, STARTD
+       FLDA    10*3
+       FSTA    SNDRTN
+       FLDA    0
+       SETX    XRSIND
+       SETB    BPSIND
+       BASE    BPSIND
+       LDX     1,1
+       FSTA    BPSIND
+       FLDA%   BPSIND,1        /ADDR OF X
+       FSTA    BPSIND
+       STARTF
+       FLDA%   BPSIND  /GET X IN DEGREES
+       FDIV    SIND91  /CONVERT TO RADIANS
+       FSTA    SIND1
+       EXTERN  SIN
+       JSR     SIN     /CALL THE SINE
+       JA      SNDRTN
+       JA      SIND1
+\f
diff --git a/sw/f4/FRTSRC/sinh.ra b/sw/f4/FRTSRC/sinh.ra
new file mode 100644 (file)
index 0000000..1c300a3
--- /dev/null
@@ -0,0 +1,105 @@
+/
+/
+/      S  I  N  H
+/      -  -  -  -
+/
+/SUBROUTINE SINH(X)
+/
+/ VERSION 5A 4-27-77  PT
+/
+       SECT    SINH
+       JA      #SINH
+       TEXT    +SINH  +
+SINHXR,        SETX    XRSINH
+       SETB    BPSINH
+BPSINH,        FNOP
+       0
+       0
+XRSINH,        F 0.0
+SINH6, F 0.0
+SINH7, F 0.0
+SINH8, F 0.0
+F1SINH,        F 1.
+F2SINH,        F 2.
+       ORG     10*3+BPSINH
+       FNOP
+       JA      SINHXR
+       0
+SNHRTN,        JA      .
+/
+SINHLG,        0
+       2613
+       4412
+/
+SINH1, F .1
+/
+SINH2, F 87.929
+/
+SINH3, F 6.
+/
+SINH4, F 120.
+       BASE    0
+#SINH, STARTD
+       FLDA    10*3
+       FSTA    SNHRTN
+       FLDA    0
+       SETX    XRSINH
+       SETB    BPSINH
+       BASE    BPSINH
+       LDX     1,1
+       FSTA    BPSINH
+       FLDA%   BPSINH,1        /ADDR OF X
+       FSTA    BPSINH
+       STARTF
+       FLDA%   BPSINH  /GET X
+       FSTA    SINH8           /SAVE THE ARGUMENT.
+       JGE     .+3             /MAKE IT POSITIVE.
+       FNEG
+       FSTA    SINH7           /AND SAVE ABS VALUE IN CASE WE NEED IT.
+       FSUB    SINH1           /IS IT LESS THEN .1?
+       JLE     SINHSR          /YES. USE SERIES APPROXIMATION.
+       FSUB    SINH2           /IS IT GREATER THEN 88.029?
+       JGE     SINHAP          /YES. USE LOG(2) APPROXIMATION.
+       EXTERN  EXP
+       JSR     EXP             /EXP(X)
+       JA      .+4
+       JA      SINH8
+       FSTA    SINH7
+       FLDA    F1SINH
+       FDIV    SINH7           /1/EXP(X)
+       FNEG                    /-1/EXP(X)
+       FADD    SINH7           /EXP(X)-1/EXP(X)
+       FDIV    F2SINH          / 1/2(EXP(X)-1/EXP(X))
+       JA      SNHRTN          /AND RETURN NOW.
+/
+/
+SINHAP,        FLDA    SINH7           /RECALL ABSOULTE VALUE.
+       FSUB    SINHLG          /ABS(X)-LN(2)
+       FSTA    SINH7           /EXP(ABS(X)-LN(2))
+       EXTERN  EXP
+       JSR     EXP
+       JA      .+4
+       JA      SINH7
+       FSTA    SINH7
+       FLDA    SINH8           /GET SIGN OF ARGUMENT.
+       JGE     SPLR            /LOAD POSITIVE IF ARG WAS POSITIVE.
+       FLDA    SINH7
+       FNEG                    /ELSE NEGATE IT.
+       JA      SNHRTN          /AND RETURN.
+SPLR,  FLDA    SINH7
+       JA      SNHRTN
+/
+/
+SINHSR,        FLDA    SINH8           /X  SERIES IF X<.1
+       FMUL    SINH8           /X^2
+       FSTA    SINH7           /X^2
+       FMUL    SINH8           /X^3
+       FSTA    SINH6           /X^3
+       FMULM   SINH7           /X^5
+       FDIV    SINH3           /X^3/6
+       FADDM   SINH8           /X+X^3/6
+       FLDA    SINH7           /X^5
+       FDIV    SINH4           /X^5/120
+       FADD    SINH8           /X+X^3/6+X^5/120
+       JA      SNHRTN          /VOILA. WE ARE DONE.
+\f
diff --git a/sw/f4/FRTSRC/sngl.ra b/sw/f4/FRTSRC/sngl.ra
new file mode 100644 (file)
index 0000000..dc24e71
--- /dev/null
@@ -0,0 +1,21 @@
+/      SUBROUTINE SNGL  -   DBL PREC TO REAL
+/
+/ VERSION 5A 4-26-77 MH
+/
+       SECT    SNGL
+       DPCHK
+       BASE    0
+       FLDA    0
+       STARTD
+       FSTA    RETRN
+       FADD    TWO
+       FSTA    3
+       FLDA%   3
+       FSTA    3
+       STARTE
+       FLDA%   3
+       STARTF
+       JA      RETRN
+RETRN, 0;0
+TWO,   0;2
+\f
diff --git a/sw/f4/FRTSRC/sqrt.ra b/sw/f4/FRTSRC/sqrt.ra
new file mode 100644 (file)
index 0000000..a8fb8e5
--- /dev/null
@@ -0,0 +1,128 @@
+/
+/
+/      S  Q  R  T
+/      -  -  -  -
+/
+/SUBROUTINE    SQRT(X)
+/
+/ VERSION 5A 4-27-77  PT
+/
+       SECT    SQRT
+       JA      #SQRT
+       0                       /THE MANTISSA ND EXPOENT DIDDLE AREAS.
+       0
+SQRTEX,        0
+       0
+SQRT13,        0
+       0
+       13                      /PHONEY EXPONENT PATCH.
+/
+       EXTERN  #ARGER
+SQRTM1,        TRAP4   #ARGER
+       TEXT    +SQRT  +
+SQRTXR,        SETX    XRSQRT
+       SETB    BPSQRT
+BPSQRT,        F 0.0
+XRSQRT,        F 0.0
+SQRT1, F 0.0
+SQRT2, F 0.0
+SQRT3, F 0.0
+F1SQRT,        F 1.
+F2SQRT,        F 2.
+       ORG     10*3+BPSQRT
+       FNOP
+       JA SQRTXR
+       0
+SQTRTN,        JA      .
+SQRTS1,        0                       /IF BETWEEN 1/4 & 1/2
+       3200
+       0
+       0                       /IF BETWEEN 1/2 & 1
+       2240
+       0
+/
+SQRTS2,        7777                    /IF BETWEEN 1/4 & 1/2
+       2327
+       7772
+       7777                    /IF BETWEEN 1/2 & 1
+       3300
+       0
+       BASE    0
+#SQRT, STARTD
+       FLDA    10*3
+       FSTA    SQTRTN
+       FLDA    0
+       SETX    XRSQRT
+       SETB    BPSQRT
+       BASE    BPSQRT
+       LDX     1,1
+       FSTA    BPSQRT
+       FLDA%   BPSQRT,1  /ADDR OF X
+       FSTA    BPSQRT
+       STARTF
+       FLDA%   BPSQRT  /GET X
+       JEQ     SQTRTN  /IF =0 JUST RTN
+       JLT     SQRTM1  /IF <0 THEN ERROR
+       FSTA    SQRTEX+1        /SAVE NUMBER AWAY FOR A SECOND.
+       FLDA    SQRT13          /GET A RIGHT ADJUSTED 13 IN THE FAC.
+       FSTA    SQRTEX-2        /STORE AWAY RIGHT AHEAD OF THE EXPONENT.
+       FLDA    SQRTEX          /NOW RETREIVE THE EXPONENT AS HIGH ORDER WORD.
+       ALN     0               /CHOP OFF CRAP.
+       JEQ     SQRTSC          /IS IT EXACTLY ZERO? IF SO, SPECIAL CASE.
+       FNORM                   /NORMALIZE IT.
+       FSUB    F1SQRT          /NOW SUBTRACT ONE FROM IT.
+       FDIV    F2SQRT          /CHOP IT IN HALF NOW.
+       FSTA    SQRT1           /AND SAVE 1/2 EXP IN A TEMP.
+       ALN     0               /NOW FIX THE EXPONENT.
+       FNORM                   /AND NORMALIZE IT TO REMOVE UNDESIRABLE BITS.
+       FSUB    SQRT1           /NOW SUBTRACT OFF EXTRANEOUS BITS.
+       FMUL    F2SQRT          /EXPAND IT AGAIN [FAC =0 OR -1], OR 0 TO +1
+       JGE     .+3             /MAKE SURE ITS POSITIVE.
+       FNEG                    /NOW MAKE IT 0 IF NO BIT OR +1 IF BIT
+SQRTBK,        ATX     1               /SAVE IN AN INDEX.
+       FSUB    F1SQRT          /SUBTRACT ONE TO MAKE IT -1 IF NO BIT OR 0 IF BIT.
+       ALN     0               /AND NOW SHIFT IT RIGHT.
+       FSTA    SQRTEX-1        /AND SAVE IT OVER THE OLD EXPONENT.
+       FLDA    SQRT1           /RECALL OLD PART
+       ALN     0               /FIX IT UP, NOW.
+       FSTA    SQRT1           /AND STORE IT BACK FOR LATER USE
+/
+/              SQRTEX IS NOW 1/4 <X< 1
+/
+       FLDA    SQRTEX+1        /RECALL NUMBER.
+       FSTA    SQRT2           /SAVE IN A TEMP.
+/
+       FMUL    SQRTS1,1        /MULTIPLY BY CORRECT CONSTANT.
+       FADD    SQRTS2,1        /AND NOW ADD IN CORRECT CONSTANT.
+/
+/              NOTE: INITIAL APPROXIMATION DEPENDS ON WHETHER X IS 1/4<X<1/2 OR
+/                   1/2<X<1
+/
+       FSTA    SQRT3           /SAVE IN A SECOND TEMP.
+       FLDA    SQRT2           /RECALL INITIAL.
+       FDIV    SQRT3           /CALCULATE X(0)/X(1)
+       FADD    SQRT3           /X(1)+X(0)/X(1)
+       FDIV    F2SQRT          /1/2(X(1)+X(0)/X(1))
+       FSTA    SQRT3           /SAVE AGAIN. NOW X(2)
+       FLDA    SQRT2           /RECALL ORIGINAL.
+       FDIV    SQRT3           /X(0)/X(2)
+       FADD    SQRT3           /X(2)+X(0)/X(2)
+       FSTA    SQRTEX+1        /NOW STORE AWAY FOR FINAL EXPONENT DIDDLING.
+/
+       STARTD
+/
+       FCLA                    /ZERO HIGH ORDER EXPONENT PART.
+       FSTA    SQRTEX-1
+       FLDA    SQRT1           /RECALL MODIFIED EXPONENT.
+       FADDM   SQRTEX          /UPDATE FRACTIONAL EXPONENT.
+/
+       STARTF                  /RETRUN TO FLOATING MODE.
+/
+       FLDA    SQRTEX+1        /PICK UP THE ANSWER.
+       JA      SQTRTN          /AND RTN
+/
+SQRTSC,        FSUB    F1SQRT          /SPECIAL CASE FUDGE.
+       FSTA    SQRT1           /SET EXPONENT ADD ON TO -1.
+       FNEG                    /AND SET ODD BIT ON.
+       JA      SQRTBK          /AND GO BACK UP.
+\f
diff --git a/sw/f4/FRTSRC/tan.ra b/sw/f4/FRTSRC/tan.ra
new file mode 100644 (file)
index 0000000..89193f3
--- /dev/null
@@ -0,0 +1,56 @@
+/
+/
+/      T  A  N
+/      -  -  -
+/
+/SUBROUTINE    TAN(X)
+/
+/ VERSION 5A 4-27-77  PT
+/
+       SECT    TAN
+       JA      #TAN
+       EXTERN  #ARGER
+TANER, TRAP4   #ARGER
+       TEXT    +TAN   +
+TANXR, SETX    XRTAN
+       SETB    BPTAN
+BPTAN, FNOP
+       0
+       0
+XRTAN, F 0.0
+TAN1,  F 0.0
+TAN2,  F 0.0
+       ORG     10*3+BPTAN
+       FNOP
+       JA      TANXR
+       0
+TANRTN,        JA      .
+       BASE    0
+#TAN,  STARTD
+       FLDA    10*3
+       FSTA    TANRTN
+       FLDA    0
+       SETX    XRTAN
+       SETB    BPTAN
+       BASE    BPTAN
+       LDX     1,1
+       FSTA    BPTAN
+       FLDA%   BPTAN,1 /ADDR OF X
+       FSTA    BPTAN
+       STARTF
+       FLDA%   BPTAN   /GET X
+       JEQ     TANRTN  /IF 0 RTN NOW
+       FSTA    TAN1    /SAVE FOR A SECOND
+       EXTERN  COS
+       JSR     COS     /TAKE COS(X)
+       JA      .+4
+       JA      TAN1
+       JEQ     TANER   /COS=0. A NO-NO
+       FSTA    TAN2    /SAV IT
+       EXTERN  SIN
+       JSR     SIN     /NOW TAKE SIN(X)
+       JA      .+4
+       JA      TAN1
+       FDIV    TAN2    /DIV BY COS(X)
+       JA      TANRTN
+\f
diff --git a/sw/f4/FRTSRC/tand.ra b/sw/f4/FRTSRC/tand.ra
new file mode 100644 (file)
index 0000000..3c5144c
--- /dev/null
@@ -0,0 +1,48 @@
+/
+/
+/      T  A  N  D
+/      -  -  -  -
+/
+/SUBROUTINE    TAND(X)
+/
+/ VERSION 5A 4-27-77  PT
+/
+       SECT    TAND
+       JA      #TAND
+       TEXT    +TAND  +
+TANDXR,        SETX    XRTAND
+       SETB    BPTAND
+BPTAND,        FNOP
+       0
+       0
+XRTAND,        F 0.0
+TAND91,        6
+       3451
+       3560
+TAND1, F 0.0
+       ORG     10*3+BPTAND
+       FNOP
+       JA      TANDXR
+       0
+TNDRTN,        JA      .
+       BASE    0
+#TAND, STARTD
+       FLDA    10*3
+       FSTA    TNDRTN
+       FLDA    0
+       SETX    XRTAND
+       SETB    BPTAND
+       BASE    BPTAND
+       LDX     1,1
+       FSTA    BPTAND
+       FLDA%   BPTAND,1        /ADDR OF X
+       FSTA    BPTAND
+       STARTF
+       FLDA%   BPTAND  /GT X IN DEGREES
+       FDIV    TAND91  /CONVERT TO RADIANS
+       FSTA    TAND1
+       EXTERN  TAN
+       JSR     TAN     /CALL THE TANGENT
+       JA      TNDRTN
+       JA      TAND1
+\f
diff --git a/sw/f4/FRTSRC/tanh.ra b/sw/f4/FRTSRC/tanh.ra
new file mode 100644 (file)
index 0000000..9c6a3d5
--- /dev/null
@@ -0,0 +1,52 @@
+/
+/
+/      T  A  N  H
+/      -  -  -  -
+/
+/SUBROUTINE TANH(X)
+/
+/ VERSION 5A 4-27-77  PT
+/
+       SECT    TANH
+       JA      #TANH
+       TEXT    +TANH  +
+TANHXR,        SETX    XRTANH
+       SETB    BPTANH
+BPTANH,        FNOP
+       0
+       0
+XRTANH,        F 0.0
+TANH1, F 0.0
+TANH2, F 0.0
+       ORG     10*3+BPTANH
+       FNOP
+       JA      TANHXR
+       0
+TNHRTN,        JA      .
+       BASE    0
+#TANH, STARTD
+       FLDA    10*3
+       FSTA    TNHRTN
+       FLDA    0
+       SETX    XRTANH
+       SETB    BPTANH
+       BASE    BPTANH
+       LDX     1,1
+       FSTA    BPTANH
+       FLDA%   BPTANH,1        /ADDR OF X
+       FSTA    BPTANH
+       STARTF
+       FLDA%   BPTANH  /GET X
+       FSTA    TANH1   /SAV IT
+       EXTERN  COSH
+       JSR     COSH    /CALL COSH
+       JA      .+4
+       JA      TANH1
+       FSTA    TANH2   /SAVE COSH(X)
+       EXTERN  SINH
+       JSR     SINH    /CALL SINH
+       JA      .+4
+       JA      TANH1
+       FDIV    TANH2   /SINH/COSH=TANH
+       JA      TNHRTN
+\f
diff --git a/sw/f4/FRTSRC/xfix.ra b/sw/f4/FRTSRC/xfix.ra
new file mode 100644 (file)
index 0000000..c10f7d2
--- /dev/null
@@ -0,0 +1,16 @@
+/
+/ VERSION 5A 4-26-77 MH
+/
+       SECT    #FIX
+       JA      .
+       JLT     NEGFIX
+       ALN     0
+       FNORM
+       JA      #FIX
+NEGFIX,        FNEG
+       ALN     0
+       FNORM
+       FNEG
+       JA      #FIX
+       END
+\f
diff --git a/sw/images/hachti/d b/sw/images/hachti/d
new file mode 100644 (file)
index 0000000..c3074bf
Binary files /dev/null and b/sw/images/hachti/d differ
diff --git a/sw/images/hachti/system_museumsnacht_2010.rk b/sw/images/hachti/system_museumsnacht_2010.rk
new file mode 100644 (file)
index 0000000..ff0ec59
Binary files /dev/null and b/sw/images/hachti/system_museumsnacht_2010.rk differ
diff --git a/sw/os8/v3d/dsk.rk b/sw/os8/v3d/dsk.rk
new file mode 100644 (file)
index 0000000..526ed44
Binary files /dev/null and b/sw/os8/v3d/dsk.rk differ
diff --git a/sw/os8/v3d/ready_to_use.rk b/sw/os8/v3d/ready_to_use.rk
new file mode 100644 (file)
index 0000000..526ed44
Binary files /dev/null and b/sw/os8/v3d/ready_to_use.rk differ
diff --git a/sw/os8/v3d/sources/fortran/dectapes/dectape2/tand.ra b/sw/os8/v3d/sources/fortran/dectapes/dectape2/tand.ra
new file mode 100644 (file)
index 0000000..3c5144c
--- /dev/null
@@ -0,0 +1,48 @@
+/
+/
+/      T  A  N  D
+/      -  -  -  -
+/
+/SUBROUTINE    TAND(X)
+/
+/ VERSION 5A 4-27-77  PT
+/
+       SECT    TAND
+       JA      #TAND
+       TEXT    +TAND  +
+TANDXR,        SETX    XRTAND
+       SETB    BPTAND
+BPTAND,        FNOP
+       0
+       0
+XRTAND,        F 0.0
+TAND91,        6
+       3451
+       3560
+TAND1, F 0.0
+       ORG     10*3+BPTAND
+       FNOP
+       JA      TANDXR
+       0
+TNDRTN,        JA      .
+       BASE    0
+#TAND, STARTD
+       FLDA    10*3
+       FSTA    TNDRTN
+       FLDA    0
+       SETX    XRTAND
+       SETB    BPTAND
+       BASE    BPTAND
+       LDX     1,1
+       FSTA    BPTAND
+       FLDA%   BPTAND,1        /ADDR OF X
+       FSTA    BPTAND
+       STARTF
+       FLDA%   BPTAND  /GT X IN DEGREES
+       FDIV    TAND91  /CONVERT TO RADIANS
+       FSTA    TAND1
+       EXTERN  TAN
+       JSR     TAN     /CALL THE TANGENT
+       JA      TNDRTN
+       JA      TAND1
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/README b/sw/os8/v3d/sources/system/dectapes/README
new file mode 100644 (file)
index 0000000..1fd55f4
--- /dev/null
@@ -0,0 +1,5 @@
+This area contains directories that hold the files associated with the
+original release DECtapes of the system sources of OS/8 Version 3D.  Each
+area contains a README file that describes the particular section of the
+release. 
+
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape1/ASR33.PA b/sw/os8/v3d/sources/system/dectapes/dectape1/ASR33.PA
new file mode 100644 (file)
index 0000000..b13f5ec
--- /dev/null
@@ -0,0 +1,198 @@
+/3 TTY HANDLER FOR BUILD
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/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
+       -1
+DEVICE AS33;DEVICE TTY;0;1;ZBLOCK 2
+
+       TTYVERSION="A&77
+
+/V3 FIXES:
+
+/1.    NOW RECOGNIZES PARITY ^Z ON OUTPUT
+/2.    NOW RECOGNIZES ^Z ON OUTPUT EVEN IF NOT
+/      FOLLOWED BY 0'S
+/3.    VERSION # IS NOW 1.
+
+       *200
+       /TELETYPE HANDLER - NOT VERY INTELLEGENT.
+       /ONLY RECOGNIZES ^Z AND ^C ON INPUT
+       /AND ^C AND ^O ON OUTPUT
+       /OH WELL, WHAT CAN YOU EXPECT IN ONE PAGE.
+       / THE LOGIC IS VERY SIMILIAR TO THE PTR AND PTP HANDLERS.
+TTY360,        360             /MUST BE FIRST LOC ON PAGE!
+TTY,   TTYVERSION
+TT7600,        7600
+       RDF
+       TAD TTYCIF
+       DCA TTYXIT      /SAVE RETURN FIELD
+       TAD I TTY
+       AND TT70
+       TAD TTCDF
+       DCA TTYCDF      /DATA FIELD OF BUFFER
+       CLA CLL CML RAR
+       TAD I TTY
+       AND TT3700
+       CMA
+       DCA TTYWC
+       ISZ TTY
+       TAD I TTY
+       DCA TTYCA       /SAVE BUFFER ADDRESS
+       ISZ TTY
+       ISZ TTY
+       JMP TTKLG
+TTYLP, SNL CLA
+       JMP TTYGLP      /ZER LINK MEANS READ
+       JMS TTYTST      /TEST FOR ^C
+       TAD TTYM14      /-203-14=-217 =-"^O"
+       SNA CLA
+       JMP TTYCTO
+       TAD I TTYCA     /CHARACTER 1 IS LOW ORDER 8 BITS OF WORD 1
+       JMS TTYPCH
+       DCA TTYGCH
+       ISZ TTYCA
+TT7400,        7400
+       TAD I TTYCA     /CHARACTER 2 IS LOW ORDER 8 BITS OF WORD 2
+       JMS TTYPCH
+       CLL RTR
+       RTR
+       TAD TTYGCH
+       CLL RTR
+       RTR             /CHARACTER 3 IS HIGH ORDER 4 BITS OF WORDS 1 AND 2
+       JMS TTYPCH      /WILL SET LINK ON!
+TTLOOP,        ISZ TTYCA       /AC HAPPENS TO BE ZERO HERE
+TT70,  70
+TTKLG, ISZ TTYWC
+       JMP TTYLP
+TTYRTN,        TAD TTYCDF
+       CLL CIA
+       SNL CLA
+       ISZ TTY         /SKIP PAST ERROR RETURN
+TTYXIT,        HLT             /RESTORE CALLING FIELDS
+       RAL
+       JMP I TTY
+TTYPCH,        0               /MUST SET LINK ON!
+       DCA TTYTST
+       TAD TTYTST
+       TAD TTYM32      /ONLY CARE IF LOW ORDER 7 BITS ARE -32
+       AND TTY177      /SO ONLY LOOK AT THESE BITS
+       SNA CLA
+       JMP TTYRTN      /WAS A ^Z
+       TAD TTYTST      /GET BACK ALL 12 BITS
+       JMS TTPRNT
+       AND TT7400      /BUT RETURN ONLY LEFT THIRD
+       STL             /**** CRUD
+       JMP I TTYPCH
+TTY212,        212
+       IFNZRO .-TTY360-100     <ER3700,QQQQ>
+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 <TTYERR,QQQQQ>
+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 <NICE,QQ>
+TTYCTO,        6032            /SHOULD BE AT REL LOC 175 FOR PATCHERS
+       JMP TTYRTN
+TTY14, 14
+       $
+\f
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 (file)
index 0000000..a525de9
--- /dev/null
@@ -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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f
+/      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
+\fGETBYT,       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
+\fMON,  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
+       $
+\fGETBYT,       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 (file)
index 0000000..a68fc90
--- /dev/null
@@ -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.
+\r/
+/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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+
+\f/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
+\f
+/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
+\f      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
+\f
+       *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
+\f      *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
+\f      /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
+\f
+       *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
+
+
+
+\f
+/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
+\f
+       *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
+\f
+
+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
+
+\f
+
+
+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
+\f
+       *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
+\f
+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
+\f\f     *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
+\f
+/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
+\f
+       *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
+\f      *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
+\f
+
+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
+\f
+       *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
+
+\f
+       *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
+\f      *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
+
+\fGETLIN,       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
+\f
+
+       /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
+
+\f
+
+       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
+\f      *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
+\f\f\f\f
+       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
+\f      "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
+\f
+       "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
+
+\f
+/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
+
+\f
+
+/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
+
+
+
+\f      *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
+\f      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!!
+$$$$$$$$$$$$$$$$$$
+\f
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 (file)
index 0000000..0fe9959
--- /dev/null
@@ -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.
+/
+/
+/
+/
+/
+/
+\f/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
+\f       
+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
+\f       
+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
+\f       
+/HERE FOR SYS:<PTP
+        
+PTIN,  TAD LSPFLG
+       SNA CLA
+       JMP .+4
+       IAC
+       DCA I (OUTTBL
+       TAD (LSPRDR-HSPRDR
+       TAD (HSPRDR
+       DCA RDCHR
+       TAD I (OUTTBL
+       DCA USRDEV
+       RFC
+       JMS I RDPBLK    /GET 1ST PBLK
+       JMS RDERR
+       TAD DATBUF      /GET NAME
+       DCA NDX0
+       TAD NAME
+       DCA TMP1
+       TAD M4
+       DCA TMP0
+       TAD I NDX0
+       DCA I TMP1
+       ISZ TMP1
+       ISZ TMP0
+       JMP .-4
+       ISZ NDX0        /BY RELBLK
+       TAD I NDX0
+       DCA BLKW        /FILE LEN
+       TAD PATFLG
+       SZA CLA         /RDING A PATCH?
+       TAD (LOOKUP-ENTER
+       TAD (ENTER      /ENTER=NO PATCH
+       JMS I USR
+       CLL
+       TAD FLEN
+       TAD BLKW
+       SNA             /DOES IT FIT?
+       JMP     .+3
+       SZL     CLA
+       JMP NOFIT
+       TAD BLKW
+       DCA FLEN
+       DCA RBLK
+       TAD FLEN
+       CIA
+       DCA FCNT
+       JMS I (ICHKB    /SEE IF WE GOT
+                       /THE RIGHT BLK
+LOP3,  TAD SBLK        /ABS STR BLK
+       TAD I RELBLK
+       DCA BLKW        /=BLK TO DO
+       JMS I HANADR
+       4200            /WRITE 1 BLK
+       BUFADR
+BLKW,  0
+       JMP I IOERR
+       ISZ RBLK
+       ISZ FCNT
+       JMP BY3
+       TAD (CLOSE
+       JMS I USR
+       JMP I GETCD
+BY3,   JMS I RDPBLK
+       SKP
+       JMP LOP3
+       MTHREE
+       TAD ERCODE      /EOT IS ONLY
+                       /LEGAL ERROR
+       SNA CLA
+       JMP IFEOT
+       JMS RDERR       /RETRY
+       JMP LOP3-1
+IFEOT, TAD PATFLG
+       SZA CLA
+       JMP I GETCD     /PATCH MODE
+                       /TERMS ON EOT
+       JMS I TYPTXT
+       EOTMSG
+       JMS I TYPTXT
+       NTMSG
+       JMS I CRLF
+       CLA CMA
+       JMS I LPWT
+       JMS I RDPBLK
+       JMS RDERR
+       JMP LOP3-1
+        
+\f       
+RDERR, 0
+       MTWO
+       DCA ERCNT
+LOP4,  TAD ERCODE
+       TAD (AMSG
+       DCA TMP0
+       TAD I TMP0
+       DCA .+2
+       JMS I TYPTXT
+       0
+       JMS I CRLF
+       CLA CMA
+       JMS I LPWT
+       JMS I RDCHR
+       CLA
+       JMS I RDPBLK
+       SKP
+       JMP I RDERR
+       ISZ ERCNT
+       JMP LOP4
+       JMP I IOERR
+ERCNT, 0
+FCNT,  0
+        
+NOFIT, TAD (16
+       JMS I TYDEV
+       TAD NAME
+       JMS I TNAME
+       JMS I TYPTXT
+       BIGMSG
+       TAD USRDEV
+       JMS I TYDEV
+       JMP I GETCD
+        
+       PAGE
+\f       
+PTAP,  JMS I RDSWIT
+       PSTBL
+       TAD I NAME
+       SNA CLA
+       JMP I (PTIN     /PTAP INPUT
+       TAD I (OUTTBL
+       DCA USRDEV
+       TAD LSPFLG
+       SNA CLA
+       TAD (HSPPCH-LSPPCH
+       TAD (LSPPCH
+       DCA WRCHR
+       PLS
+       TAD (LOOKUP
+       JMS I USR
+       TAD PATFLG
+       SNA CLA         /PUNCH PATCH ?
+       JMP NOPAT
+       CLL
+       TAD EQBLK       /CHK FOR =N
+       TAD FLEN        /OUT OF RANGE
+       SNL CLA         /?
+       JMP .+4
+       JMS I TYPTXT
+       BEQMSG
+       JMP I GETCD
+       TAD EQBLK
+NOPAT, DCA TMP0
+       TAD TMP0
+       TAD SBLK
+       DCA BLKR        /1ST BLK TO PCH
+       TAD TMP0        /PUT REL BLK
+       DCA I TMP3      /IN HDR
+       TAD FLEN
+       CIA             /=FILE LEN
+       ISZ TMP3
+       DCA I TMP3
+       ISZ TMP3
+       DCA I TMP3      /0 TO LST HDR
+                       /WORD
+       TAD PATFLG      /ONLY 1 BLK
+       SZA             /PATCHES AT A
+       DCA FLEN        /TIME
+       TAD LSPFLG
+       SNA CLA
+       JMP .+3
+LOP2,  CLA CMA
+       JMS I LPWT      /ON PUNCH
+       TAD MAXLEN
+       CIA
+       TAD MAXCNT
+       SZA CLA         /PCH L/T ?
+       JMP .+3         /NO
+       JMS WLT
+       JMS WLT
+LOP1,  JMS I HANADR    /READ 1 BLK
+       200             /OF FILE
+       BUFADR
+BLKR,  0
+       JMP I IOERR
+       ISZ BLKR
+       JMS I (PWRITE
+       ISZ I RELBLK
+       ISZ FLEN
+       JMP BYDUN
+       TAD EOTFLG
+       SNA CLA         /PCH EOT ?
+       JMS EOT         /YES
+       JMP I GETCD
+BYDUN, ISZ MAXCNT
+       JMP LOP1
+       JMS EOT         /PHYSICAL END
+                       /OF PTP
+       TAD LSPFLG
+       SZA CLA
+       JMS I LPWT
+       JMS I TYPTXT
+       EOTMSG
+       JMS I CRLF
+       JMP LOP2        /NEXT PTP
+        
+\f       
+WLT,   0
+       TAD LTCNT
+       DCA TMP0
+       TAD P200
+       JMS I WRCHR
+       JMS I CHKC
+       ISZ TMP0
+       JMP .-4
+       JMP I WLT
+LTCNT, -LTLEN
+        
+EOT,   0
+       TAD (377
+       JMS I WRCHR
+       JMS WLT
+       JMS WLT
+       JMS WLT
+       TAD MAXLEN
+       DCA MAXCNT
+       JMP I EOT
+        
+       PAGE
+\f       
+PREAD, 0               /READ A PTP BLK
+       JMS I RDCHR
+       SNA
+       JMP PREAD+1     /ITS L/T
+       TAD (-200
+       SNA
+       JMP PREAD+1     /L/T
+       RAR CLL         /201 PCH MUST
+       SNA CLA         /SEPARATE L/T
+                       /AND DATA
+       JMP ONBLK
+       TAD (-377       /ONLY OTHER
+       TAD INCHR       /POSSIBILTY IS
+       SNA CLA         /END OF PTP
+       IAC             /EOT CODE
+       IAC             /L/T ERR
+BYTERR,        IAC
+BLKERR,        DCA ERCODE
+       JMP I PREAD     /P+1=ERR RTN
+ONBLK, JMS I (ISETB
+       DCA PARFLG
+       JMS GETBYT
+       ISZ BYTCNT
+       JMP .-2
+       JMS I RDCHR
+       CIA
+       TAD BCC1
+       SZA CLA
+       JMP BLKERR
+       JMS I RDCHR
+       CIA
+       TAD BCC2
+       SZA CLA
+       JMP BLKERR
+       TAD PARFLG
+       SPA CLA
+       JMP BYTERR
+       ISZ PREAD       /GOOD BLK
+       JMP BLKERR+1
+        
+\f       
+GETBYT,        0
+       TAD LSPFLG
+       SNA CLA
+       JMS I CHKC
+       DCA PARCHR
+       TAD M4
+       DCA CNTR0
+LOP6,  MTHREE
+       DCA CNTR1
+LOP5,  JMS I RDCHR
+       DCA I FRMPTR
+       ISZ FRMPTR
+       TAD INCHR
+       JMS I DOCRC
+       ISZ CNTR1
+       JMP LOP5
+       MTHREE
+       TAD FRMPTR
+       DCA FRMPTR
+       JMS PACK
+       ISZ CNTR0
+       JMP LOP6
+       JMS I RDCHR
+       JMS I DOCRC
+       TAD INCHR
+       CIA
+       TAD PARCHR
+       SNA CLA
+       JMP NOPAR
+       CLA CMA
+       DCA PARFLG
+       TAD ABORT
+       SPA CLA
+       JMP BYTERR
+       FOURK
+NOPAR, TAD INCHR
+       DCA I PARPTR
+       ISZ PARPTR
+       JMP I GETBYT
+        
+\f       
+/HERE TO PACK 3 8 BIT FRAMES INTO
+/2 12 BIT WORDS
+        
+PACK,  0
+       TAD I FRMPTR
+       RTL CLL
+       RAL             /1ST FRM TO
+       DCA I BUFPTR    /B1-B8
+       ISZ FRMPTR
+       TAD I FRMPTR    /PUT HI HALF OF
+       RTR CLL         /2ND FRM INTO
+       RTR             /B9-B11 AND LNK
+       RAR
+       DCA HOLDW2
+       TAD HOLDW2      /PUT 1ST FRM IN
+       AND (7          /B0-B7,AND PUT
+       TAD I BUFPTR    /HI HALF OF 2ND
+       RAL             /IN B8-B11
+       DCA I BUFPTR    /YOU AINT SEEN
+       TAD I BUFPTR    /NOTHING YET.
+       JMS I (DOPAR
+       TAD HOLDW2      /LO HAF OF 2ND
+       AND (7400       /FRM IS IN
+       ISZ FRMPTR      /B0-B3. PUT
+       TAD I FRMPTR    /WITH 3RD FRM
+       ISZ BUFPTR
+       DCA I BUFPTR
+       TAD I BUFPTR
+       JMS I (DOPAR
+       ISZ FRMPTR
+       ISZ BUFPTR
+       JMP I PACK
+PARFLG,        0
+CNTR0, 0
+CNTR1, 0
+ABORT, -1
+HOLDW2,        0
+        
+       PAGE
+\f       
+PWRITE,        0               /HERE TO WRITE
+                       /1 BLK OF PTP
+       JMS ISETB
+       JMS I (WLT
+       TAD (201        /START OF DATA
+                       /BLK CHAR
+       JMS I WRCHR
+       JMS PUTBYT
+       ISZ BYTCNT
+       JMP .-2
+       TAD BCC1
+       JMS I WRCHR
+       TAD BCC2
+       JMS I WRCHR
+       JMP I PWRITE
+        
+ISETB, 0
+       TAD (FRMADR
+       DCA FRMPTR
+       TAD (PARADR
+       DCA PARPTR
+       TAD DATBUF
+       DCA BUFPTR
+       DCA BCC1
+       DCA BCC2
+       TAD (-NBYTS
+       DCA BYTCNT
+       JMP I ISETB
+        
+LPWAIT,        0
+       HLT
+       RFC
+       CLA
+       JMP I LPWAIT
+        
+\f       
+PUTBYT,        0
+       DCA PARCHR
+       TAD M4
+       DCA CNTR2
+LOP7,  TAD I BUFPTR
+       JMS DOPAR
+       TAD I BUFPTR    /PUT 2 WORDS IN
+       RTR CLL         /3 8 BIT FRMS
+       RTR
+       DCA F2
+       TAD F2          /B0-B7 OF 1ST
+       AND (377        /FOR FRM 1
+       DCA F1
+       TAD F2          /LO 4 BITS OF
+       RAR             /WORD 1
+       AND (7400       /TO B0-B3 OF
+       DCA F2          /FRM 2
+       TAD F1
+       JMS I WRCHR
+       TAD F1
+       JMS I DOCRC
+       ISZ BUFPTR
+       TAD I BUFPTR
+       JMS DOPAR
+       TAD I BUFPTR    /PUT B0-B3
+       AND (7400       /OF WD2
+       RTR CLL         /INTO B4-B8
+       RTR
+       TAD F2          /NOW PUT LO 4
+       RTR             /BITS OF WD1
+       RTR             /(B0-B3) AND HI
+                       /4 BITS OF W2
+                       /INTO B4-B11
+       JMS I WRCHR
+       TAD OUTCHR      /=CHR JST PCHED
+       JMS I DOCRC
+       TAD I BUFPTR
+       AND (377        /LO 8 OF 2ND
+       JMS I WRCHR
+       TAD OUTCHR      /=F3
+       JMS I DOCRC
+       ISZ BUFPTR
+       ISZ CNTR2
+       JMP LOP7
+       TAD PARCHR
+       JMS I WRCHR
+       TAD PARCHR
+       JMS I DOCRC
+       JMS I CHKC
+       JMP I PUTBYT
+CNTR2, 0
+F2,    0
+F1,    0
+        
+        
+\f       
+/HERE TO COMPUTE PARITY (EVEN ODD)
+/12 BIT WORD IS IN AC.
+/AFTER EACH (SPA,CML,RAR) SEQUENCE
+/AC B0=0 IF THE
+/NUMBER OF ALREADY PROCESSED 1
+/STATE BITS IS EVEN. OTHERWISE AC B0=1.
+        
+DOPAR, 0
+       DCA TMP0
+       TAD (-13        /-13 BECAUSE 2
+                       /BITS ARE
+                       /PROCESSED
+                       /INITIALLY
+       DCA TMP1
+       TAD TMP0
+       RTR             /LNK HOLDS
+                       /NEWBIT,AC B0
+                       /HOLDS STATUS
+                       /TO DATE.
+       SPA             /CHNG FROM ODD
+                       /TO EVEN ?
+       CML             /YES CHANGE
+                       /STATUS
+       RAR             /GET NXT
+       ISZ TMP1        /DONE ?
+       JMP .-4         /NO
+       CMA RAL         /SET LNK=1=EVEN
+       CLA             /LNK=0=ODD
+       TAD PARCHR      /UPDATE PARITY
+       RAL
+       DCA PARCHR
+       JMP I DOPAR
+        
+       PAGE
+\f       
+TTOTXT,        0
+       TAD I TTOTXT
+       DCA TMP0
+       ISZ TTOTXT
+LOP8,  TAD I TMP0
+       RTR
+       RTR
+       RTR
+       JMS DOHAF
+       JMP I TTOTXT
+       TAD I TMP0
+       JMS DOHAF
+       JMP I TTOTXT
+       ISZ TMP0
+       JMP LOP8
+        
+DOHAF, 0
+       AND (77
+       SNA
+       JMP I DOHAF
+       ISZ DOHAF
+       TAD (-40
+       SPA
+       TAD (100
+       TAD (240
+       JMS I (LSPPCH
+       JMP I DOHAF
+        
+TYCRLF,        0
+       TAD (215
+       JMS I (LSPPCH
+       TAD (212
+       JMS I (LSPPCH
+       JMP I TYCRLF
+        
+PHYSIO,        JMS I TYPTXT
+       IOMSG
+       JMP I GETCD
+        
+\f       
+TYPNAM,        0
+       DCA TMP2
+       TAD TMP2
+       DCA TMP0
+       MTHREE
+       DCA TMP1
+LOP9,  TAD I TMP0
+       RTR
+       RTR
+       RTR
+       JMS DOHAF
+       JMP DOEXT
+       TAD I TMP0
+       JMS DOHAF
+       JMP DOEXT
+       ISZ TMP0
+       ISZ TMP1
+       JMP LOP9
+DOEXT, TAD P3
+       TAD TMP2
+       DCA TMP0
+       TAD I TMP0
+       SNA CLA
+       JMP P3+1
+       TAD P256        /.
+       JMS I (LSPPCH
+       TAD I TMP0
+       RTR
+       RTR
+       RTR
+       JMS DOHAF
+P256,  256
+       TAD I TMP0
+       JMS DOHAF
+P3,    3
+       TAD (240
+       JMS I (LSPPCH
+       JMP I TYPNAM
+        
+\f       
+OCTOUT,        0
+       RAL
+       DCA TMP0
+       TAD M4
+       DCA TMP1
+LOP11, TAD TMP0
+       RTL
+       RAL
+       DCA TMP0
+       RAL
+       DCA TMP2
+       TAD TMP0
+       AND (7
+       TAD (260
+       JMS I (LSPPCH
+       TAD TMP2
+       RAR CLL
+       ISZ TMP1
+       JMP LOP11
+       TAD (240
+       JMS I (LSPPCH
+       JMP I OCTOUT
+        
+       PAGE
+\f       
+/HERE TO SEE IF WE READ THE CORRECT
+/BLK OF THE CORRECT FILE.
+        
+ICHKB, 0
+       TAD PATFLG      /DONT CHK IF
+       SZA CLA         /IN PATCH MODE
+       JMP I ICHKB
+LOP12, TAD M4
+       DCA TMP0
+       TAD LSPFLG
+       SNA CLA
+       JMS I CHKC
+       TAD DATBUF      /COMPARE NAMES
+       DCA NDX0
+       TAD NAME
+       DCA TMP1
+LOP10, TAD I NDX0
+       CIA
+       TAD I TMP1
+       SZA CLA
+       JMP NAMERR
+       ISZ TMP1
+       ISZ TMP0
+       JMP LOP10
+       TAD RBLK        /CHK BLK
+       CIA
+       TAD I RELBLK
+       SNA CLA
+       JMP I ICHKB     /GOOD BLK
+       JMS I TYPTXT
+       NMSG
+       TAD RBLK
+       JMS I (OCTOUT
+       JMS I TYPTXT
+       FMSG
+       TAD I RELBLK
+       JMS I (OCTOUT
+RECHK, JMS I CRLF
+       CLA CMA
+       JMS I LPWT
+       JMS I RDPBLK
+       JMS I (RDERR
+       JMP LOP12
+NAMERR,        JMS I TYPTXT
+       NMSG
+       TAD NAME
+       JMS I TNAME
+       JMS I TYPTXT
+       FMSG
+       TAD DATBUF
+       IAC
+       JMS I TNAME
+       JMP RECHK
+        
+\f       
+/CRC GENERATOR
+/COURTESY OF MARIO S. ROOT
+/COUSIN TO MARIO LEONARD
+        
+CRC,   0
+       DCA TMP0
+       TAD (-7
+       DCA TMP1
+       TAD TMP0
+       AND BCC2
+       CIA
+       CLL RAL
+       TAD TMP0
+       TAD BCC2
+       CLL RTR
+       SPA
+       CML
+       RAR
+       ISZ TMP1
+       JMP .-4
+       SPA
+       JMP .+4
+       DCA TMP1
+       TAD BCC1
+       JMP .+5
+       DCA TMP1
+       TAD BCC1
+       RAR
+       CML RAL
+       DCA BCC2
+       TAD TMP1
+       AND (60
+       CLL RTL
+       DCA BCC1
+       TAD BCC1
+       AND BCC2
+       CIA
+       CLL RAL
+       TAD BCC1
+       TAD BCC2
+       DCA BCC2
+       TAD TMP1
+       CLL RTR
+       RTR
+       DCA BCC1
+       TAD BCC1
+       CLL RAR
+       CLL RAR
+       DCA TMP1
+       TAD TMP1
+       AND BCC1
+       CIA
+       CLL RAL
+       TAD BCC1
+       TAD TMP1
+       DCA BCC1
+       JMP I CRC
+        
+       PAGE
+\f       
+/CHK FOR MASTER INPUT DEVICE ONLY
+        
+CHKMI, 0
+       TAD (INTBL-1
+       DCA NDX0
+       TAD I NDX0
+       SNA CLA
+       JMP BY1         /NO MI
+       TAD (-10
+       DCA TMP0
+       ISZ NDX0
+       TAD I NDX0      /MUST HAVE NO
+       SZA CLA         /OTHER IN DEVS
+       JMP BY1         /FOUND 1
+       ISZ TMP0
+       JMP .-5
+       CLA CMA         /MI ONLY SET
+BY1,   DCA MIFLG       /MI FLAG
+       JMP I CHKMI
+        
+        
+\f       
+DOUSR, 0               /HERE TO DO A
+       DCA N1-1        /USR CALL
+       TAD NAME        /EITHER LOOKUP
+       DCA N1          /,ENTER OR
+       TAD FLEN        /CLOSE
+       DCA N1+1
+       TAD USRDEV
+       JMS I (GETHAN
+       CIF 10
+       TAD USRDEV
+       AND P17
+       JMS I P200
+       0
+N1,    0;0
+       JMP USRERR
+       TAD N1
+       DCA SBLK
+       TAD N1+1
+       DCA FLEN
+       JMP I DOUSR
+USRERR,        JMS I TYPTXT
+       USRMSG
+       TAD N1-1
+       JMS I (OCTOUT
+       TAD USRDEV
+       JMS I TYDEV
+       TAD NAME
+       JMS I TNAME
+       JMS I CRLF
+       JMP I GETCD
+        
+       PAGE
+\f       
+SETDV, 0
+       JMS CHKP37
+       7600-1          /OUTPUT INFO
+       OUTTBL-1
+       4
+       -3
+       JMS CHKP37
+       7617-1          /INPUT INFO
+       INTBL-1
+       1
+       -11
+       JMP I SETDV
+        
+CHKP37,        0
+       DCA TMP0
+       TAD (TM-1
+       DCA NDX1
+       TAD I CHKP37    /P37 ADDR
+       DCA NDX0
+       ISZ CHKP37
+       TAD I CHKP37
+       DCA TMP1        /PERM TBL
+       ISZ CHKP37
+       TAD I CHKP37
+       DCA TMP3        /ENTRY LEN-1
+       ISZ CHKP37
+       TAD I CHKP37
+       DCA TMP2        /-NUM TO DO
+XLOP2, CDF 10
+       TAD I NDX0
+       SZA             /BLANK ENTRY ?
+       ISZ TMP0        /NO
+       CDF
+       DCA I NDX1      /TMP SAV
+       TAD NDX0        /ADV PTR TO NXT
+       TAD TMP3
+       DCA NDX0
+       ISZ TMP2        /DONE?
+       JMP XLOP2       /NO
+       TAD TMP0        /WAS P37
+       SNA CLA         /BLANK ?
+       JMP BY0         /YES USE SET OF
+                       /DEV LAST
+                       /SPECIFIED
+       TAD TMP1
+       DCA NDX1
+       TAD (TM-1
+       DCA NDX0
+       TAD I CHKP37
+       DCA TMP0
+       TAD I NDX0      /NEW UNIT
+       DCA I NDX1
+       DCA I NDX1      /0 TO SBLK
+       ISZ TMP0
+       JMP .-4
+       DCA I NDX1
+BY0,   ISZ CHKP37
+       JMP I CHKP37
+        
+\f       
+/ROUT TO INTERPRET PS/8 SWITCHES
+        
+SWITCH,        0
+       TAD I SWITCH    /PTR TO TBL
+       DCA TMP0
+       ISZ SWITCH
+       CLL
+       TAD (7757
+       AND SATOL
+       TAD SMTOX
+       SNA SZL CLA
+       JMP I SWITCH    /NONE TO READ
+XLOP0, TAD I TMP0
+       SNA             /END OF TBL ?
+       JMP I SWITCH    /YES
+       DCA TMP1        /PTR TO FLAG
+       CLA CMA         /SET TO YES
+       DCA I TMP1      /STATE
+XLOP1, ISZ TMP0
+       TAD I TMP0      /AC=P37 SW ADDR
+       ISZ TMP0        /=PTR TO MASK
+       SNA             /MORE ARGS FOR
+                       /THIS SWIT ?
+       JMP XLOP0       /NO DO NXT
+       DCA TMP2
+       TAD I TMP2
+       AND I TMP0      /CLR NON SWITCH
+                       /BITS
+       CIA             /COMP WITH MASK
+       TAD I TMP0
+       SZA CLA         /IF ALL OK
+                       /LEAVE SWITCH
+                       /ALONE
+       DCA I TMP1
+       JMP XLOP1
+        
+\f      PAGE
+\f       
+WRITE, 0
+       TAD WRITE
+       DCA READ
+       FOURK
+       JMP READ+1
+        
+READ,  0
+       DCA RWBIT
+       JMS I CHKC
+       TAD I READ
+       DCA DVPTR
+       ISZ READ
+       TAD I DVPTR     /UNIT
+       JMS I (GETHAN
+       ISZ DVPTR
+       TAD I DVPTR     /PUT NUM BLKS
+       AND P17         /IN B1-B5
+       RTL CLL
+       RTL
+       RTL
+       RAL
+       TAD BUFFLD
+       TAD RWBIT
+       DCA IOLST
+       ISZ DVPTR
+       TAD I DVPTR
+       DCA IOLST+2     /SBLK
+       JMS I HANADR
+IOLST, 0
+       2000
+       0
+       JMP .+3
+       ISZ READ        /NON ERR RTN
+       JMP I READ
+       CLA
+       JMS I TYPTXT
+       IOMSG
+       MTWO
+       TAD DVPTR
+       DCA TMP0
+       TAD I TMP0
+       JMS I TYDEV
+       TAD I NAME
+       SNA CLA
+       JMP .+3
+       TAD NAME
+       JMS I TNAME
+       TAD IOLST+2
+       JMS I (OCTOUT
+       TAD RWBIT
+       SMA CLA
+       JMP DONALL
+       TAD (337
+       JMS I (LSPPCH   /BACK ARROW
+DONALL,        JMS I CRLF
+       JMP I READ
+RWBIT, 0
+DVPTR, 0
+        
+       PAGE
+\f       
+\f       
+GETHAN,        0
+       AND P17
+       DCA TMP1
+       TAD TMP1
+       TAD (DEVRES-1
+       DCA TMP0
+       CDF 10
+       TAD I TMP0      /IS HANDLER IN
+       CDF             /IN CORE ?
+       SZA
+       JMP NOFET       /YES
+       MTWO
+       TAD TMP1
+       SNA CLA
+       TAD (1200
+       TAD (6001       /ENABLE 2 PG HANDLERS
+       DCA .+5
+       TAD TMP1
+       CIF 10
+       JMS I P200
+       FETCH
+       0
+       JMP FETERR
+       TAD .-2
+NOFET, DCA HANADR
+       JMP I GETHAN
+        
+FETERR,        JMS I TYPTXT
+       USRMSG
+       TAD (FETCH
+       JMS I (OCTOUT
+       JMP I GETCD     /ABORT
+                       /COMMAND
+        
+TYPDEV,        0
+       AND P17
+       TAD (DMTBL-1
+       DCA TMP0
+       TAD I TMP0
+       DCA .+2
+       JMS I TYPTXT
+       0
+       JMP I TYPDEV
+        
+       PAGE
+\f       
+COMPAR,        JMS I RDSWIT
+       CSTBL
+       TAD I (OUTTBL
+       DCA USRDEV
+       TAD USRDEV
+       DCA CD1
+       TAD (INTBL
+       DCA INPTR
+       TAD I NAME
+       SNA CLA
+       JMP CDEV
+       TAD (LOOKUP
+       JMS I USR
+       TAD SBLK
+       DCA CD1+2
+       TAD I INPTR
+       DCA CD2
+       CDF 10
+       TAD I (7620
+       CDF
+       DCA CD2+2
+       JMS DOCOMP
+CDEV,  JMP I GETCD
+        
+DOCOMP,        0
+LOP14, JMS I (READ
+       CD1
+       JMP I GETCD
+       TAD (2400
+       DCA I (IOLST+1
+       JMS I (READ
+       CD2
+       JMP CERR
+       CLA CMA
+       DCA BADB
+       TWOK
+       DCA I (IOLST+1
+       TAD (1777
+       DCA NDX0
+       TAD (2377
+       DCA NDX1
+       TAD (-400
+       DCA ZCNT
+       CDF 10
+LOP13, TAD I NDX0
+       CIA
+       TAD I NDX1
+       SZA CLA
+       JMP BADCOM
+LOP15, ISZ ZCNT
+       JMP LOP13
+       CDF
+       ISZ CD1+2
+       ISZ CD2+2
+       ISZ FLEN
+       JMP LOP14
+       JMP I DOCOMP
+BADCOM,        CDF
+       ISZ BADB
+       JMP BYBLK
+       TAD CD1
+       JMS I TYDEV
+       TAD CD1+2
+       JMS I (OCTOUT
+       TAD CD2
+       JMS I TYDEV
+       TAD CD2+2
+       JMS I (OCTOUT
+       JMS I CRLF
+BYBLK, TAD BADFO
+       SZA CLA
+       JMP I GETCD
+       TAD BADBO
+       SZA CLA
+       JMP DOMORE
+       TAD (400
+       TAD ZCNT
+       JMS I (OCTOUT
+       TAD NDX0
+       DCA TMP0
+       CDF 10
+       TAD I TMP0
+       CDF
+       JMS I (OCTOUT
+       TAD NDX1
+       DCA TMP0
+       CDF 10
+       TAD I TMP0
+       CDF
+       JMS I (OCTOUT
+       JMS I CRLF
+DOMORE,        JMS I CHKC
+       CDF 10
+       JMP LOP15
+CERR,  TWOK
+       DCA I (IOLST+1
+       JMP I GETCD
+CD1,   0;1;0
+CD2,   0;1;0
+BADB,  0
+BADBO, 0
+BADFO, 0
+ZCNT,  0
+        
+       PAGE
+\f       
+/FILE EDITOR FOR OS/8.
+        
+FED,   TAD I (OUTTBL
+       AND P17
+       DCA USRDEV
+       TAD I NAME
+       SZA CLA
+       JMP ITSNAM
+       TAD USRDEV
+       TAD (DLTBL-1
+       DCA TMP0
+       TAD I TMP0
+       DCA FLEN
+       DCA SBLK
+       JMP .+3
+ITSNAM,        TAD (LOOKUP
+       JMS I USR
+       DCA SRWD
+       CLA CMA
+       DCA MSKWD
+       DCA MODF
+       TAD USRDEV
+       DCA OUDEV
+       IAC
+       DCA OUDEV+1
+       JMS I (RD
+LOP16, JMS I (GINP
+       JMS I (G6BIT
+       JMP GOTCMD
+       DCA ENDCT
+       TAD (CMDTBL-2
+       DCA NDX0
+       ISZ NDX0
+       TAD I NDX0
+       CIA
+       TAD ENDCT
+       SZA CLA
+       JMP .-5
+       TAD I NDX0
+       DCA CMDTBL-1
+GOTCMD,        JMS I CMDTBL-1
+       JMP LOP16
+        
+       QMARK
+CMDTBL,        2200
+       R
+       2700
+       W
+       0300
+       C
+       2300
+       SR
+       1700
+       O
+       0500
+       EX
+ENDCT, 0
+       QMARK
+        
+QMARK, 0
+       TAD (277
+       JMS I (LSPPCH
+       JMS I CRLF
+       JMP I QMARK
+        
+\f       
+C,     0               /STATUS COMMAND
+       TAD RBLK
+       JMS I (OCTOUT
+       TAD MODF
+       SNA CLA
+       JMP .+3
+       TAD (306
+       JMS I (LSPPCH
+       TAD MODB
+       SNA CLA
+       JMP .+3
+       TAD (302
+       JMS I (LSPPCH
+       TAD (240
+       JMS I (LSPPCH
+       TAD CLOC
+       JMS I (OCTOUT
+       TAD SRWD
+       JMS I (OCTOUT
+       TAD MSKWD
+       JMS I (OCTOUT
+       JMS I CRLF
+       JMP I C
+        
+       PAGE
+\f       
+GETC,  0               /GET AN INPUT
+       TAD I BUFPTR    /CHAR
+       TAD EOLWD
+       SNA CLA
+       JMP I GETC
+       TAD I BUFPTR
+       DCA INCHR
+       ISZ BUFPTR
+       TAD INCHR
+       TAD (-254       /,
+       SNA CLA
+       JMP I GETC
+       ISZ GETC
+       TAD INCHR
+       JMP I GETC
+        
+G6BIT, 0               /8 TO 6 BIT
+       JMS GETC
+       JMP I G6BIT
+       AND (77
+       RTL CLL
+       RTL
+       RTL
+       DCA TMP0
+       JMS GETC
+       JMP EX6
+       AND (77
+       TAD TMP0
+       DCA TMP0
+       JMS GETC
+       JMP EX6
+       JMS BUPTR
+       JMS BUPTR
+       JMS BUPTR
+       JMP I G6BIT
+EX6,   TAD TMP0
+       ISZ G6BIT
+       JMP I G6BIT
+        
+\f       
+GOCTAL,        0               /GET OCTAL DIGIT
+       TAD BUFPTR
+       DCA TMP2
+       JMS GETC
+       JMP I GOCTAL
+       JMS BUPTR
+LOP17, DCA TMP1
+       JMS GETC
+       JMP FOCT
+       TAD (-260
+       DCA TMP0
+       TAD TMP0
+       AND (7770
+       SNA CLA
+       JMP .+4
+       TAD TMP2
+       DCA BUFPTR
+       JMP I GOCTAL
+       TAD TMP1
+       RTL CLL
+       RAL
+       TAD TMP0
+       JMP LOP17
+FOCT,  ISZ GOCTAL
+       TAD TMP1
+       JMP I GOCTAL
+        
+BUPTR, 0
+       CLA CMA
+       TAD BUFPTR
+       DCA BUFPTR
+       JMP I BUPTR
+        
+\f       
+RD,    0               /READ A BLK
+       DCA TMP0        /=REL BLK TO DO
+       CLL
+       TAD FLEN
+       TAD TMP0
+       SNL CLA
+       JMP .+3
+       JMS I (QMARK
+       JMP I RD
+       TAD TMP0
+       DCA RBLK
+       TAD RBLK
+       TAD SBLK
+       DCA OUDEV+2
+       JMS I (READ
+       OUDEV
+       JMP I IOERR
+       DCA MODB
+       DCA CLOC
+       JMP I RD
+        
+R,     0               /R COMMAND
+       JMS GOCTAL
+       TAD RBLK
+       JMS RD
+       JMP I R
+        
+W,     0               /WRITE COMMAND
+       TAD MODB
+       SNA CLA
+       JMP .+5
+       JMS I (WRITE
+       OUDEV
+       JMP I IOERR
+       CLA CMA
+       DCA MODF
+       TAD RBLK
+       IAC
+       JMS RD
+       DCA MODB
+       JMP I W
+        
+EX,    0               /EXIT TO DECODE
+       TAD MODB
+       SNA CLA
+       JMP I GETCD
+       JMS I (WRITE
+       OUDEV
+       JMP I IOERR
+       JMP I GETCD
+        
+       PAGE
+\f       
+GINP,  0               /GET KBRD INPUT
+       TAD MAXLEN
+       DCA OCNT
+       TAD (BUFADR
+       DCA BUFPTR
+       JMS I [LSPRDR
+       AND     [177
+       TAD     [200
+       DCA     INCHR
+       TAD     INCHR
+       TAD (-212
+       SNA
+       JMP LFEND
+       TAD (212-203
+       SNA
+       JMP I [CTRLC0
+       TAD (203-215
+       SNA
+       JMP LFEND-1
+       TAD (215-225
+       SZA
+       JMP TRYRUB
+       TAD (336
+       JMS I (LSPPCH
+       TAD (325
+       JMS I (LSPPCH
+       JMS I CRLF
+       JMP GINP+1
+TRYRUB,        TAD (225-377
+       SZA CLA
+       JMP PUTC
+       TAD MAXLEN
+       CIA
+       TAD OCNT
+       SNA CLA
+       JMP GINP+5
+       CLA CMA
+       TAD OCNT
+       DCA OCNT
+       CLA CMA
+       TAD BUFPTR
+       DCA BUFPTR
+       TAD (334
+       JMS I (LSPPCH
+       JMP GINP+5
+PUTC,  TAD INCHR
+       JMS I (LSPPCH
+       TAD INCHR
+       TAD (-240
+       SNA CLA
+       JMP GINP+5
+       TAD INCHR
+       DCA I BUFPTR
+       ISZ BUFPTR
+       ISZ OCNT
+       JMP GINP+5
+       IAC
+LFEND, DCA I BUFPTR
+       TAD I BUFPTR
+       CIA
+       DCA EOLWD
+       TAD (BUFADR
+       DCA BUFPTR
+       JMS I CRLF
+       JMP I GINP
+        
+\f       
+O,     0               /OPEN LOC N
+       JMS I (GOCTAL
+       JMP .+3
+       AND (377
+LOP20, DCA CLOC
+       JMS DOLOC
+       TAD EOLWD
+       SZA CLA
+       JMP I O
+       TAD CLOC
+       IAC
+       AND (377
+       SZA
+       JMP LOP20
+       JMS I (W
+       JMP LOP20+1
+        
+DOLOC, 0
+       JMS GETWRD
+       JMS I (OCTOUT
+       TAD (257
+       JMS I (LSPPCH
+       JMS GINP
+       JMS I (GOCTAL
+       JMP I DOLOC
+       JMS PUTWRD
+       JMP I DOLOC
+        
+GETWRD,        0
+       TAD CLOC
+       TAD I (IOLST+1
+       DCA TMP0
+       CDF 10
+       TAD I TMP0
+       CDF
+       JMP I GETWRD
+        
+PUTWRD,        0
+       DCA TMP0
+       TAD CLOC
+       TAD I (IOLST+1
+       DCA TMP1
+       TAD TMP0
+       CDF 10
+       DCA I TMP1
+       CDF
+       CLA CMA
+       DCA MODB
+       JMP I PUTWRD
+        
+       PAGE
+\f       
+SR,    0               /SEARCH COMM.
+       JMS I (GOCTAL
+       SKP
+       DCA SRWD
+       JMS I (GOCTAL
+       SKP
+       DCA MSKWD
+       TAD EOLWD
+       DCA ISVEOL
+       DCA MATFLG
+       TAD SRWD
+       AND MSKWD
+       CIA
+       DCA BCC1
+       CLA CMA
+       DCA SRBFLG
+LOP18, JMS I (GETWRD
+       AND MSKWD
+       TAD BCC1
+       SNA CLA
+       JMP SRMAT
+LOP19, ISZ CLOC
+       TAD CLOC
+       AND (377
+       SZA CLA
+       JMP LOP18
+       TAD (377
+       DCA CLOC
+       TAD ISVEOL
+       SZA CLA
+       JMP EXS
+       JMS I (W
+       TAD CLOC
+       SNA CLA
+       JMP LOP18-2
+       JMP EXS
+SRMAT, TAD SRBFLG
+       SNA CLA
+       JMP .+3
+       TAD RBLK
+       JMS I (OCTOUT
+       CLA CMA
+       DCA MATFLG
+       DCA SRBFLG
+       TAD CLOC
+       JMS I (OCTOUT
+       JMS I CRLF
+       JMS I (DOLOC
+       TAD EOLWD
+       SNA CLA
+       JMP LOP19
+EXS,   TAD MATFLG
+       SNA CLA
+       JMS I (QMARK
+       JMP I SR
+SRBFLG,        0
+MATFLG,        0
+ISVEOL,        0
+        
+       PAGE
+\f       
+/TABLES FOR FPIP
+        
+DLTBL, -6260           /DEVICE LENGTHS
+       -6260           /FOR UNITS 1-17
+       0               /SYS,DSK,TTY
+       0               /LPT
+       -1341;-1341             /DTA0-
+       -1341;-1341             /DTA7
+       -1341;-1341
+       -1341;-1341
+       0
+       0
+       0
+        
+DMTBL, SYMSG
+       DKMSG
+       TTMSG
+       LPMSG
+       D0MSG
+       D1MSG
+       D2MSG
+       D3MSG
+       D4MSG
+       D5MSG
+       D6MSG
+       D7MSG
+       PPMSG
+       PRMSG
+       CDMSG
+        
+AMSG,  PARMSG
+       PARMSG
+       LTMSG
+       EOTMSG
+\f       
+PSTBL, EOTFLG
+       SATOL
+       200             /E
+       0
+       LSPFLG
+       SATOL
+       1               /L
+       0
+       PATFLG
+       SMTOX
+       400             /P
+       0;0
+CSTBL, BADBO
+       SATOL
+       2000            /B
+       0
+       BADFO
+       SATOL
+       4000
+       0;0
+        
+\f       
+TM,    0
+       0
+       0
+       0
+       0
+       0
+       0
+       0
+       0
+OUTTBL,        1;0
+       0;0
+       0;0
+       0
+INTBL, 5;0
+       0;0
+       0;0
+       0;0
+       0;0
+       0;0
+       0;0
+       0;0
+       0;0
+       0
+        
+\f       
+S0FLG, 0               /CM
+\f       
+SYMSG, TEXT "SYS:"
+       0
+DKMSG, TEXT "DSK:"
+       0
+TTMSG, TEXT "TTY:"
+       0
+LPMSG, TEXT "LPT:"
+       0
+D0MSG, TEXT "DTA0:"
+       0
+D1MSG, TEXT "DTA1:"
+       0
+D2MSG, TEXT "DTA2:"
+       0
+D3MSG, TEXT "DTA3:"
+       0
+D4MSG, TEXT "DTA4:"
+       0
+D5MSG, TEXT "DTA5:"
+       0
+D6MSG, TEXT "DTA6:"
+       0
+D7MSG, TEXT "DTA7:"
+       0
+PPMSG, TEXT "PTP:"
+       0
+PRMSG, TEXT "PTR:"
+       0
+CDMSG, TEXT "CDR:"
+       0
+EOTMSG,        TEXT "END OF TAPE "
+       0
+NTMSG, TEXT "ENTER NEXT "
+       0
+BIGMSG,        TEXT "IS TOO BIG FOR "
+       0
+PARMSG,        TEXT "PARITY ERROR "
+       0
+LTMSG, TEXT "L/T ERROR "
+       0
+USRMSG,        TEXT "USR "
+       0
+IOMSG, TEXT "I/O ERROR "
+       0
+NMSG,  TEXT "NEED: "
+       0
+FMSG,  TEXT "FOUND: "
+       0
+BEQMSG,        TEXT "BAD =BLK"
+       0
+        
+\f       
+PARADR,        0
+       *PARADR+41
+FNAME, 0;0;0;0;0
+FRMADR,        0
+       *614+FRMADR
+AAFREE,        0
+       *6600-10
+HDATA, 0               /TYPE (HOLDS
+                       /VERS FOR NOW)
+       0;0;0;0         /NAME
+       0               /REL BLK
+       0               /LEN
+       0               /CONTINUATION
+                       /WD 0 FOR NOW
+BUFADR,        0
+        
+       LTLEN=124
+       MXPBLK=40
+       NBYTS=41
+       MTHREE=7346     /CLA CLL CMA RTL
+       MTWO=7344       /CLA CLL CMA RAL
+       TWOK=7332       /CLA CLL CML RTR
+       FOURK=7330      /CLL CML CLA RAR
+       FETCH=1
+       LOOKUP=2
+       ENTER=3
+       CLOSE=4
+       DECODE=5
+       CHAINE=6
+       ERROR=7
+       USRIN=10
+       USROUT=11
+       INQUIRE=12
+       RESET=13
+       PLS=6026
+       PSF=6021
+       RFC=6014
+       RRB=6012
+       RSF=6011
+       DEVRES=7647
+       ATOL=7643
+       MTOX=7644
+       YTO9=7645
+       IFZERO  PTAPE   <
+       NSLOTS=S0END-S0FLG
+       >
+        
+        
+       $
+\f
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 (file)
index 0000000..81078aa
--- /dev/null
@@ -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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/     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 <F.P. VARIABLE>
+       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 <VARIABLE>
+       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 <F.P. VARIABLE>
+       DCA     FAD
+       TAD     ABS#
+       DCA     FAD#
+       CLL STA RAR     /=3777
+       DCA     ABSSW
+       JMP     ED1     /GO INTO ADD ROUTINE...
+
+       PAGE
+\f
+
+/      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
+\f/
+/      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 <F.P. VARIABLE>
+       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
+\f
+/
+/              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
+\f/
+/      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 <INT. VARIABLE>
+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
+\f
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 (file)
index 0000000..866e8ad
--- /dev/null
@@ -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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f      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
+\f      *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
+
+\f      *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
+\f      *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/
+\f      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
+\fPTP=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
+\f      *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
+       $
+\f
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 (file)
index 0000000..56c7901
--- /dev/null
@@ -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.
+/
+/
+/
+/
+/
+/
+\f/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
+\f/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
+\f/
+/      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
+\f      *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
+\fSIX,  0
+SEVEN, 0
+
+LWOWIE,        CDF CIF 10
+       JMP I (SIOERR
+CORLOC,        CORX
+CORV,  1400
+CORSIZ,        1
+TEMP,  0;0;0;0
+       PAGE
+\f/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
+\f/     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
+\f/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
+\fFASIGN,       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      <FINERR,_ERROR>
+\f      /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
+\f      /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
+\fFOSETP,       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
+\f      *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
+\fCHGBNK,       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
+\fLDRZZ1,       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
+\f      *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.
+\f/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
+\f      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
+\fLKATMP,       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
+\fBUILD,        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
+\fBUILDX,       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
+\fCVTREC,       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
+
+\fMAPIO,        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
+\fOUSETP,       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
+\f/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
+\fLOAD, 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
+\fIJMP, 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
+\fXX7600,
+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
+\f/ 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     <LBRERR,        _ERROR>
+\f/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
+\f/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
+\f/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
+\f/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
+\f/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
+\f/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
+\f/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
+\f/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
+\f/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
+\f/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
+\f/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
+\f/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
+\fPAGES,        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
+\f/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
+\f/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
+\f/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
+       $
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape1/README b/sw/os8/v3d/sources/system/dectapes/dectape1/README
new file mode 100644 (file)
index 0000000..583a608
--- /dev/null
@@ -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 (file)
index 0000000..e8d82fb
--- /dev/null
@@ -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 <ADRERR,QQQ>
+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
+\fRLOOP,        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
+\fRNEXT,        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
+       $
+\f
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 (file)
index 0000000..ff09ee2
--- /dev/null
@@ -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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/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
+\f      *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'
+\f      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
+\f      /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
+\f      *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 <BADLOC,XXXX>
+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   <NZERR,XXX>
+       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   <TOOBIG,XXXX>
+       $
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 (file)
index 0000000..ef99e80
--- /dev/null
@@ -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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/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    <CORE=2 /DEFAULT IS 8K SYSTEM>
+       MPARAM=7643     /COMMAND DECODER PARAMETER BLOCK
+
+       IFZERO  CORE-2  <F1=0   /FIELD FOR FILE 1
+                       F2=10   /FIELD FOR FILE 2
+                       LNBEG=2000   /BEGINNING OF LINE BUFFER
+>
+       IFZERO  CORE-4  <F1=20
+                       F2=30
+                       LNBEG=20
+>
+                       BUFLIM=FBLOCK-1001 /END OF LINE BUFFER
+                       INBUF=FBLOCK-1000        /INPUT BUFFER
+\f/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=.
+\f
+
+       /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
+\fSETUP,        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
+\f      *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
+\f      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
+\fOCLOSE,       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
+\f/     PAGE 0 LITERALS
+       FIELD 1
+\f      /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
+\f      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
+\fMOVEUP,       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
+\fCOMPL,        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
+\fGLINE,        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
+\fGCHAR,        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
+\fGETIN,        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
+\f/     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
+\f/     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
+\fPNTBTH,       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
+\fPNTAST,       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  <IAC>
+       IFZERO  CORE-4  <TAD    [-1>
+       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
+\fOCHAR,        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
+\fOUSETP,       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
+\fSRCOPT,       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
+\f/PAGE 0 LITERALS FOR FIELD 1
+       $-$-$   /END OF ASSEMBLY OF SRCCOM
+\f
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 (file)
index 0000000..5ef0b4a
--- /dev/null
@@ -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
+\f
+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\ f 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
+\fTRY3, 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
+\f      *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
+\f
+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
+
+\fGCHK, 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
+$$$$$$$
+\f
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 (file)
index 0000000..ac199fb
--- /dev/null
@@ -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
+\f
+                       /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\ f 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
+\fTRY3, 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
+\f      *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
+\f
+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
+
+\fGCHK, 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
+$$$$$$$
+\f
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 (file)
index 0000000..c143c29
--- /dev/null
@@ -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
+\f
+       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\ f 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
+\fTRY3, 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
+\f      *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
+\f
+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
+
+\fGCHK, 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
+$$$$$$$
+\f
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 (file)
index 0000000..13fb1c9
--- /dev/null
@@ -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
+\f
+       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\ f 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
+\fTRY3, 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
+\f      *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
+\f
+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
+
+\fGCHK, 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
+$$$$$$$
+\f
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 (file)
index 0000000..5c0086a
--- /dev/null
@@ -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
+\f      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
+\f/THIS ROUTINE GETS THE NEXT CHARACTER TO BE PUT INTO THE BUFFER
+BATGET,        0
+       0               /IF LAST CHAR WAS <CR> 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 <LF>
+       DCA BATGET+1
+       CLA CMA         /SET TO INDICATE <CR>
+       JMP BATGEX
+
+BATLF, DCA BATGET+1    /ZAP THE JMP TO HERE
+       TAD BLF         /RETURN <LF>
+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
+
+$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
+\f
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 (file)
index 0000000..0c0501e
--- /dev/null
@@ -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
+\f      *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 <S3700,     3700>
+       IFNZRO RF08 <S377,      0377>
+T1,    0
+T2,    0
+       ZBLOCK 224-.
+       IFNZRO .-224 <ADRERR,QQQQ>      /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 <SKP        /SENSE OF SKIP IS REVERSED>
+       JMP SYSER
+       ISZ RF
+SFIELD,        HLT             /RETURN TO PROPER FIELD
+       6601            /CLEAR TROUBLESOME FLAG
+       JMP I RF
+       $
+\f
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 (file)
index 0000000..a84dbbc
--- /dev/null
@@ -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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/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    <SKP>
+       HLT             /ERROR READING SYSTEM IN
+ENDB,  JMP I B7605
+\f      /BOOTSTRAP FOR DISK MONITOR IS AS FOLLOWS:
+
+       /       LOCATION        CONTENTS
+       /       7750            7600
+       /       7751            6603
+       /       7752            6622
+       /       7753            5352
+       /       7754            5752
+\f      *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 <SKP        /SENSE OF SKIP IS REVERSED>
+       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     <IFNZRO .-7700  <NZERR>;        SKP;    HLT>
+       JMP SHNDLR+3
+SCIF,  CIF 0
+SYSCNT,        0
+       IFNZRO DF32     <IFNZRO .-7700  <NZERR>;        SKP;    HLT>
+S6603, 6603
+S70,   70
+S7400, 7400
+       IFNZRO  DF32 <S3700,    3700>
+       IFNZRO RF08 <S377,      377>
+       SCA=7751
+       SWC=7750
+       $
+\f
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 (file)
index 0000000..fde72a0
--- /dev/null
@@ -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.
+/
+/
+/
+/
+/
+/
+\f/
+/ 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
+
+\f/     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/
+\fITTAB=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
+\f      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
+\fC40,  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
+\f      *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 <LABEL>'
+       6044
+       TAD I   L16
+       JMS I   PRCRL
+       JMS I   PRINT
+       TAD I   L16     /PUNCH '<LABEL>,'
+       JMS I   CLAB
+       JMS I   PRINT
+       JMP I   LDNEXT
+
+PTEM,  0
+
+LIST,  0               /PUNCH THE SOURCE STATEMENT
+       TAD BASE        /GET THE POINTER
+       DCA PTEM
+       TAD I PTEM      /PUNCH A CHARACTER PAIR...
+       JMS I P2
+       TAD I PTEM
+       ISZ PTEM
+       AND C77
+       SZA CLA         /END OF THE BUFFER?
+       JMP LIST+3
+       JMS I PRINT     /YES, PUNCH A CR-LF AND RETURN
+       JMP I LIST
+
+CMNT,  JMS I   PRINT   /WE HAVE A COMMENT
+       DCA     L24
+       JMS     LIST
+       JMP     START1  /ALLOW COMMENTS BEFORE SUBR. OR FUNCTION STMT.
+
+
+BAREA1,        AREA1
+BAREA2,        AREA2
+RCD,   LRCD
+SSTYP, STYPE-1         /POINTER TO STATMENT TABLE IN FIELD 1
+WIPE,  LWIPE
+STMT,  LSTMT
+SWAP,  LSWAP
+\f      *400
+/ THE FOLLOWING ROUTINE IS ENTERED WITH THE BUFFER POINTER IN THE AC
+/ IT PUTS ONE LINE INTO THE BUFFER,
+/ CHECKS FOR COMMENTS AND COUTINUATION LINES, AND IF IT IS A
+/ CONTINUATION IT SETS KOUNT TO THE PROPER COLUMN
+/
+LRCD,  0
+       DCA TEM1        /SAVE THE BUFFER POINTER
+       DCA I TEM1
+       DCA CHK         /ZERO CONTINUATION FLAG
+       DCA L20         /ZERO THE EQUALS FLAG
+       DCA L61         /ZERO THE COMMENT FLAG
+       TAD CM111       /BUFFER LIMIT IS 72 CHARACTERS
+       DCA IX
+LRCDL, CLA
+       JMS LPTRIN
+       AND D177
+       SZA             /LEADER OR BLANK TAPE?
+       TAD CM177
+       SNA             /RUBOUT?
+       JMP LRCDL
+       TAD (177-15
+       SNA
+       JMP LCAR
+       TAD (15-11
+       SNA
+       JMP TAB
+       TAD (11-40
+       SPA
+       JMP LRCDL
+       TAD (40-75
+       SNA             /AN '=' ?
+       ISZ L20
+       TAD C75         /CHAR OK... RESTORE IT & PUT IN BUFFER
+       JMS KRONK       /PUT IT IN THE BUFFER...
+       JMP LRCDL       /AND GET ANOTHER
+
+LCAR,  TAD IX          /PROCESS A CAR RETURN...
+       CIA
+       TAD CM111
+       SNA CLA         /NULL STATEMENT?
+       JMP LRCDL       /YES, IGNORE
+       JMS KRONK       /PUT A ZERO IN THE BUFFER
+       TAD I TEM1
+       TAD CM3
+       SNA
+       JMP     COMNT
+       TAD     CM20
+       SZA CLA         /TEST FOR "S" IN COLUMN ONE
+       JMP     TINUE
+       JMP I   (SCODE
+COMNT, ISZ L61         /SET COMMENT FLAG...
+       TAD     C40
+       JMP     STORSL
+
+TINUE, TAD TEM1        /CHECK FOR CONTINUATION...
+       TAD C3
+       DCA P           /SET THE POINTER TO COLS. 6 AND 7
+       TAD I P
+       AND C5700       /NON-ZERO OR NON BLANK IN COL 6
+       TAD C4000       /MAKES THIS A CONTINUATION...
+       SNA CLA         /IS IT?
+       JMP LRCDA       /MAYBE...
+LRCDX, TAD B7          /YES, MAKE IT START IN COL 7
+       DCA KOUNT
+       ISZ CHK         /INCREMENT THE CONTINUATION FLAG
+       TAD I   TEM1
+STORSL,        TAD C5700       /MAKE THIS INTO A COMMENT LINE
+       DCA I TEM1
+       JMP I LRCD      /THEN RETURN
+
+LRCDA, TAD I P         /NUMERIC AND NON-ZERO IN COL 7 MAKES
+       AND C77         /THIS A CONTINUATION...
+       TAD CM61
+       SPA CLA         /IS IT?
+       JMP LRCDX+3     /NO, RETURN
+       IAC             /YES, MAKE IT START IN COL 8
+       JMP LRCDX
+
+TAB,   TAD C40         /PROCESS TAB CHARACTERS...
+       JMS KRONK       /PUT SOME SPACES IN THE BUFFER
+       TAD IX
+       TAD C3          /MAKE 1ST TAB GO TO COL 7
+       SMA             /ARE WE AT END OF THE BUFFER?
+       CLA             /YES, FORCE TERMINATION
+       AND B7
+       SZA CLA         /MODULO 8?
+       JMP TAB         /NO, PUNCH SOME MORE SPACES
+       JMP LRCDL       /YES, GET ANOTHER CHAR
+
+KRONK, 0               /PUT A CHARACTER IN THE BUFFER...
+       DCA CAR
+       CLA     IAC
+       TAD IX          /FIRST COMPUTE BUFFER ADDRESS...
+       SNA             /PAST COL. 72?
+       JMP I   KRONK   /YES-RETN.
+       TAD     C111    /NO
+       CLL RAR
+       TAD TEM1
+       DCA P
+       TAD CAR         /PICK UP THE CHARACTER
+       AND C77
+       SZL             /ZERO LINK SAYS WE WANT THE LEFT HALF
+       JMP .+5
+       RTL
+       RTL
+       RTL
+       DCA I P
+       TAD I P         /ADD IN THE LEFT 6 BITS
+       DCA I P         /AND SALT THEM AWAY...
+       ISZ IX          /BUFFER OVERFLOW?
+       JMP I KRONK
+
+LPTRIN,        0               /PAPER TAPE READER INPUT ROUTINE
+       RSF
+       JMP .-1
+       RRB RFC
+       JMP I LPTRIN
+
+CAR,   0               /TEMPORARY, HOLDS THE CURRENT CHARACTER
+P,     0               /THIS IS THE BUFFER POINTER
+TEM1,  0               /THIS CONTAINS THE CURRENT BUFFER ADDRESS
+IX,    0               /THIS IS THE CHARACTER COUNTER
+CM111, -111            /MINUS THE BUFFER LIMIT PLUS ONE
+C111,  111             /THIS IS THE BUFFER LIMIT PLUS ONE
+D177,  177
+CM177, -177
+C75,   75
+B7,    7
+C5700, 5700
+CM61,  -61
+CM20,  -20
+M1700, -1700
+\f      *600
+CAL,   TAD     KOUNT   /SUBROUTINE CALL STMT PROCESSOR
+       DCA     COUNT3
+       JMS I   ENTITY
+       JMP I   ASSIGN
+       JMP     ON
+COUNT3,        0
+Q12,   12
+       JMP I   ASSIGN
+ON,    JMS I   GNB
+       SNA             /ANY ARGUMENTS?
+       JMP     CR2     /NO
+       TAD     CM50
+       SZA             /MAYBE, IS THIS A '(' ?
+       JMP I   ASSIGN
+       JMS I   ZZZ     /YES, PUNCH STMT NR, IF ANY
+       TAD     COUNT3
+       DCA     KOUNT
+       ISZ     L44
+       DCA     L46     /AC SWITCH
+       DCA     L52     /IF STATEMENT SWITCH
+       JMS I   GENER   /LET TRIPLE GENERATOR PROCESS IT
+       DCA     L46     /ZERO AC AGAIN
+       JMP     START   /COMPLETE, GET NEXT STATEMENT
+CR2,   ISZ     L32     /NO ARGUMENTS
+       JMS I   SYMTAB
+       TAD     L77
+       DCA     GLU
+       JMS I   ZZZ     /PUNCH '<LABEL>, CALL 0,<NAME>'
+       JMS I   FPROP
+GLU,   0
+       JMP     START
+LGNB,  0
+       JMS     LGTC
+       DCA     GLU
+       TAD     GLU
+       TAD     CM40
+       SNA CLA
+       JMP     LGNB+1
+       TAD     GLU
+       JMP I   LGNB
+LGETCH,        0
+       JMS I   GNB
+       SNA             /IS IT A END OF CARD
+       JMP     PUNC    /YES ITS PUNTUATION
+       TAD     QM32
+       SPA SNA         /IS IT ALPHABETIC
+       JMP     ALPHA           //YES
+       TAD     CM40
+       CLL
+       TAD     Q12
+       SZL             /IS IT NUMERIC?
+       ISZ     LGETCH  /NUMERIC
+PUNC,  ISZ     LGETCH  /PUNCTUATION
+ALPHA, CLA             /ALPHABETIC
+       TAD     GLU
+       JMP I   LGETCH  /RETURN
+/      THIS ROUTINE DETERMINES WHETHER SYMBOL IS FP OR INTEBER
+/      ROUTINE SKIPS IF SYMBOL IS INTEGER
+LMODE, 0
+       SMA             /IF ITS PLUS WE HAVE AN INTEGER
+       JMP     AINT    /WE HAVE AN INTEGER
+       RAL             /GET NEXT BIT
+       SPA             /CHECK THIS BIT
+       JMP     FV      /ITS EITHER A FCON OR VARIABLE
+       RTL             /GET NEXT TWO BITS
+       SNL             /IS IT AN OPERATOR
+ERR2,  JMS I   LUNCH   /YES
+AFP,   SMA CLA         /CHECK THIS BIT
+       JMP     AINT    /ITS AN INTEGER
+       JMP I   LMODE   /SYMBOL WAS F P MODE
+FV,    RAR             /RESTORE AC TO ORIGINAL CONTENTS
+       CIA             /SET NEGATIVE
+       TAD     L47     /ADD START OF FCON TABLE
+       SPA             /IS     /SYMBOL FCON
+       JMP     AFP     /YES
+       CIA             /NO     /RESTORE AC AGAIN
+       TAD     L47
+       DCA     ATEM    /SAVE THE RESTORED NUMBER
+       TAD I   ATEM    /GET THE POINTER TO THE VARIABLE
+       TAD     CM1100  /SUBTRACT AN I
+       SPA             /IS IT LESS THAN I
+       JMP     AFP     /YES    ITS FLOATING POINT
+       TAD     CON1    /NOW SUBTRACT AN N
+       SPA CLA         /IS IT LESS THAN N
+AINT,  ISZ     LMODE   /YES
+CON1,  CLA             /CLEAR THE AC FOR THE RETURN
+       JMP I   LMODE
+ATEM,  0
+CM1100,        -1100
+QM32,  -32
+LGTC,  0               /GET A CHARACTER FROM THE BUFFER
+       TAD     KOUNT
+       ISZ     KOUNT
+       CLL RAR         /LINK TELLS IF LEFT OR RIGHT HALF
+       TAD     BASE
+       DCA     GLU
+       TAD I   GLU
+       SZL             /WHICH CHARACTER
+       JMP     MMSK
+       RTR
+       RTR
+       RTR
+MMSK,  AND     C77
+       SZA
+       JMP I   LGTC
+       TAD     CHK
+       SPA CLA         /DO WE WANT A NEW LINE YET?
+       JMP I   LGTC    /NOT YET...
+       TAD     BASE2   /YES, USE THE ALTERNATE BUFFER
+       JMS I   RLCD
+       TAD     CHK
+       SZA CLA         /IS IT A CONTINUATION?
+       JMP     .+4
+       CMA             /NO, SET FLAG AND RETURN W ZERO AC
+       DCA     CHK
+       JMP I   LGTC
+       JMS     LSWAP   /YES, SWITCH BUFFERS AND CONTINUE
+       DCA     CHK
+       JMP     LGTC+1
+
+RLCD,  LRCD
+LSWAP, 0               /SWITCH THE LINE BUFFER POINTERS
+       TAD     BASE
+       DCA     ATEM
+       TAD     BASE2
+       DCA     BASE
+       TAD     ATEM
+       DCA     BASE2
+       JMP I   LSWAP
+\f      *1000
+/      THE POINTER TO THE CURRENT LOCATION IN THE PUSH LIST IS
+/      IN LOC 41,  THE CURRENT TRIPLE NUMBER IS IN LOCATION 40
+/      LOC 44 MUST BE SET TO 0 IF THERE IS AN '=' , TO 1 IF NOT.
+PBEGN, AREA2           /START OF THE PRECEDENCE LIST
+BINTEG,        TAD     L32     /HERE IF ENTITY SENT AN INTEGER
+       JMP I   BPUSH   /PUSH IT INTO STACK
+FLPT,  JMS I   FCON    /HERE IF ENTITY FOUND A FLOATING POINT CON
+       SKP             /ENTER IT INTO FPTABLE
+BLPHA, JMS I   SYMTAB  /HERE IF ENTITY FOUND A VARIABLE
+       TAD     L77     /PICK UP POINTER INTO SYM TAB OR FLPT TAB AN
+       JMP I   BPUSH   /PUSH IT DOWN
+LABELX, JMP I  LGENER
+LGENER,        0               /ENTRY POINT
+       TAD     C5000
+       DCA     L40     /*
+       DCA     L21     /ZERO THE SYMBOL TABLE SWITCH
+       TAD     L71
+       DCA     L41     /SET PUSH DOWN POINTER
+       DCA     L22
+       DCA     BPAREN  /ZERO OUT THE PAREN SWITCH
+       TAD     C4000
+       DCA I   L41     /FIRST PUSH DOWN LEFT CLOSURE NAMELY 0
+BNEXT, JMS I   ENTITY  /THIS WILL GET THE NEXT DATUM TO BE PROCESSE
+       JMP     HOO     /END OF STATEMENT RETURN,TREAT LIKE PUNCTION
+       JMP     BLPHA   /VARIABLE RETURN
+       JMP     BINTEG  /INTEGER RETURN
+       JMP     FLPT    /FLOATING POINT RETURN
+HOO,   TAD     CM50    /PUNCTIOATION RETURN,
+       SNA             /IS IT (
+       JMP I   BPAR    /YES
+       TAD     C7753
+       SZA             /IS IT AN '=' ?
+       JMP     BRET
+       TAD     L44     /WE HAVE AN '=',  IS IT LEGAL?
+       SNA CLA
+       JMP     BRET    /IT IS
+       TAD     IMPDO
+       SZA CLA         /ARE WE IN AN IMPLIED DO LOOP?
+       JMP I   PIOEQL  /YES - TERMINATE LOOP CODE
+ERR3,  JMS I   LUNCH
+PIOEQL,        IOEQL
+BRET,  TAD     C0075
+       DCA     L63
+       TAD I   L41     /CHECK FOR A UNARY OPERATOR
+       TAD     C4000
+       AND     C7000
+       SZA CLA         /WAS IT AN OPERAATOR AT ALL
+       JMP     PREC    /NO, STILL NOT UNARY OPERATOR
+       TAD     L63
+       TAD     C7725
+       SNA             /IS IT A '+'  
+       JMP     BNEXT   /YES, IGNORE IT
+       TAD     CM2     /NO
+       SZA CLA         /IS IT A '-' ?
+       JMP     ERR3
+       TAD     C4643   /THIS IS THE UNARY MINUS
+       JMP I   BPUSH
+PREC,  TAD     PBEGN   /HERE IS WHERE WE FIND THE PRECIDENCE
+       DCA     L17
+       DCA     L65
+       SKP
+RETUR, ISZ     L17     /PICK UP NEXT OP CODE IN LIST
+       TAD I   L17     /TO GET THE NEXT LIST ITEM
+       SMA SZA         /IS THIS THE END OF THE LIST
+       JMP     BMORE   /NO, THE ASSUMPTION IS THAT THE PRECIDENCE
+       TAD     L63     /IS ZERO
+       SZA CLA         /IS THIS THE RIGHT TABLE ENTRY
+       JMP     RETUR   /TRY AGAIN      (IT WASN"T)
+       TAD I   L17     /TO GET THE PRECEDENCE
+       DCA     L65
+BMORE, CLA IAC         /HERE WE ARE GOING TO SEE IF THERE IS A PREC
+       TAD     L41
+       DCA     L64     /L64 NOW POINTS TO THE PREVIOUS OPERATOR
+       TAD I   L64
+       TAD     C4000
+       AND     C7000
+       SZA             /IS THERE A VALID OPERATOR ON THE STACK?
+       JMP     ERR3    /APPARENTLY NOT...
+       TAD I   L64     /IF THE PRECEDENCE OF THE PREVIOUS OPERATOR
+       AND     C700    /IS NON-ZERO, AND ITS PRECEDENCE IS GREATER
+       SNA             /THAN OR EQUAL TO THE PRECEDENCE OF THE
+       JMP     NO      /CURRENT OPERATOR, THEN PROCESS THE PREVIOUS
+       CIA             /OPERATOR; IF NOT WE WILL PROBABLY PUT
+       TAD     L65     /THE CURRENT OPERATOR ON THE STACK AND GET
+       SMA SZA CLA     /ANOTHER ITEM FROM THE STATEMENT BUFFER...
+       JMP     NO
+       ISZ     L40     /YES, INCREMENT THE TRIPLE NUMBER AND....
+       JMS I   TRIPL   /PROCESS THE PREVIOUS OPERATOR
+       ISZ     L41     /*****NOTE      WHAT IF IT WAS UNARY************
+       TAD I   L41
+       TAD     C3135   /THIS IS MINUS UNARY MINUS
+       SZA CLA
+       ISZ     L41     /DELETE THE LAST 3 ITEMS AND REPLACE WITH TR
+       TAD     L46
+       DCA I   L41
+       JMP     BMORE   /TRY FOR ANOTHER TRIPLE
+NO,    TAD     L63
+       SNA             /IS IT A END OF STATEMENT MARK
+       JMP I   LCDONE  /IT WAS--WE ARE ALL FINISHED, EXCEPT CHECKING
+       TAD     CM51
+       SNA             /IS IT A ')' ?
+       JMP I   LKPAR   /YES
+       TAD     CM3
+       SZA             /IS IT A ',' ?
+       JMP     NCOMMA  /NO
+       TAD     BPAREN
+       SNA CLA         /IS A COMMA LEGAL HERE?
+       JMP I   LCDONE  /MAYBE...
+NCOMMA,        TAD     CM21
+       SNA CLA         /IS IT AN EQUALS SIGN?
+       ISZ     L44     /YES - SET EQUALS SWITCH ON
+       TAD     L63     /PUT THE OPERATOR ON THE STACK
+       TAD     L65     /ADD THE PRECEDENCE
+       TAD     C4000
+       JMP I   BPUSH
+/
+BPUSH, PUSH
+C5000, 5000
+BPAR,  ALPAR
+C7753, 7753
+C0075, 75
+C7000, 7000
+CM21,  -21
+C7725, 7725
+C4643, 4643
+C700,  700
+C3135, 3135
+LCDONE,        CDONE
+LKPAR, KPAR
+FCON,  LFCON
+\f      *1200
+PUSH,  DCA     L63
+       CLA CMA
+       TAD     L41     /SPACE THE POINTER UP ONE
+       DCA     L41     /*
+       TAD     L63
+       DCA I   L41     /*
+       JMP I   LBNEXT  /BACK TO BEGINING
+/      THIS IS TO PROCESS SUBSCRIPTS OR FUNCTION CALLS---
+/ IF ARITHMETIC, JUST DELETE BOTH ( AND )
+KPAR,  TAD I   L64
+       TAD     C3730   /MINUS LEFT PAREN
+       SZA             /IS IT (
+       JMP     BCON    /NO-- CHECK SOME MORE
+       TAD I   L41     /DELETE PARENS
+       DCA I   L64
+       ISZ     L41     /UPDATE POINTER
+LAPP,  ISZ     BPAREN  /DO PARENS BALENCE
+       JMP I   LBNEXT
+       TAD     L52     /YES
+       SNA CLA         /SHOULD WE RETURN IF BALANCED
+       JMP I   LBNEXT
+       TAD     L46
+       SZA CLA
+       JMP     CDONE
+       TAD I   L41
+       DCA     L77
+       JMS I   XTAD    /GENERATE TAD OR (TAD I)
+       DCA I   L41     /ZERO IS INTEGER
+CDONE, TAD     L41
+       CMA
+       TAD     L71
+       SZA             /WELL...
+ERR6,  JMS I   LUNCH   /HA...YOU GOOFED
+       JMS I   XZQ
+       JMP I   .+1
+       LABELX
+BCON,  IAC             /IS IT FUNCTION
+       ISZ     L40
+       SNA
+       JMP     BFOUT   /YES
+       IAC             /NO-- NOW IS IT SUBSCRIPT
+       SNA     
+       JMP     SOUT    /YES
+       TAD     C7772   /NO
+       SZA             /IS IT COMMA
+       JMP     ERR6    /NO - BYE BYE CHARLIE
+       ISZ     L64
+       ISZ     L64
+       TAD I   L64
+       TAD     C3724   /IS IT A COMMA
+       SNA
+       JMP     BFOUT   /FOUND TWO COMMAS,MUST BE FUNCTION
+       TAD     C5      /NO
+       SNA             /IS IT A PRIME
+       JMP     BFOUT   /GOT A FUNCTION
+       IAC             /NO
+       SZA CLA
+       JMP     ERR6    /SORRY, IT AIN'T NUTTIN
+SOUT,  JMS I   PLSBSC          /PROCESS A SUBSCRIPT
+       CMA
+       TAD     L22
+       DCA     L22
+       SKP
+BFOUT, JMS I   FUNCT
+       JMP     LAPP
+FUNCT, LFUNCT
+/ THIS IS WHERE WE FIND OUT WHAT KIND OF LPAR
+ALPAR, CMA
+       TAD     BPAREN
+       DCA     BPAREN
+       TAD I   L41
+       TAD     C4000
+       AND     B7000   /IS IT AN OPERAND
+       SZA CLA 
+       JMP     CUNT    /NO     , TRY SOME MORE
+       IAC
+       JMP     PRIME
+CUNT,  TAD I   L41     /PICK UP TOP LIST ITEM
+       TAD     C2      /ADD TWO TO FIND THE DIMENSION INTO(INFO)
+       DCA     L64
+       TAD I   L64
+       AND     C20     /JUST WANT ONLY THIS ONE BIT(DIMENSION)
+       SNA CLA         /IS IT DIMENSIONED
+       JMP     PRIME   /NO     ITS GOT TO BE A FUNCTION CALL
+       ISZ     L22
+       CMA
+PRIME, TAD     C4047
+       JMP     PUSH    /GO PUSH A PRIME, IT IS THE FUNCTIONS LEFT PAREN
+XZQ,   LXZQ
+LBNEXT,        BNEXT
+C3730, 3730
+C7772, 7772
+C3724, 3724
+C5,    5
+D7,    7
+B7000, 7000
+C20,   20
+C4047, 4047
+XTAD,  LXTAD
+LPUTCH,        0
+       CLA CMA
+       TAD     KOUNT
+       DCA     KOUNT
+       JMP I   LPUTCH
+
+LASIGN,        TAD     L20     /ARITHMETIC STATEMENT PROCESSOR
+       SNA CLA         /IS THERE AN '=' IN THE STMT?
+ERR9,  JMS I   LUNCH   /NO, BETTER COMPLAIN...
+       TAD     D7      /SET POINTER TO COL 7
+       DCA     KOUNT
+       JMS I   ZZZ     /PUNCH THE LABEL, IF ANY
+       DCA     L46
+       DCA     L44
+       DCA     L52
+       JMS I   GENER   /PROCESS IT...
+       TAD     L63
+       SZA CLA         /WAS TERMINATOR A <CR/LF> ?
+       JMP     ERR9    /NO, ILLEGAL STATEMENT ERROR ...
+       JMP     START
+PLSBSC,        LSUBSC
+
+LPRCRL,        0               /SUBROUTINE PRINTS CREATED LABELS
+       DCA LPRCTM
+       TAD C36         /PUNCH '^'
+       JMS I PRINT
+       TAD LPRCTM      /PUNCH THE LETTERS
+       JMS I P2
+       JMP I LPRCRL
+C36,   36
+LPRCTM,        0
+\f      *1400
+PRET,  ISZ     LENTT   /PUNCTIONATION EXIT POINT
+FRET,  ISZ     LENTT   /FLOATING POINT EXIT POINT
+XIRET, ISZ     LENTT   /INTEGER EXIT POINT
+XARET, ISZ     LENTT   /VARIABLE EXIT
+ERET,  JMP I   LENTT   /CR END OF LINE EXIT
+LENTT, 0               /ENTRY POINT
+       CLA             /WIPE OUT PSEUDO ACCUMULATOR
+       DCA     L32
+       DCA     L31
+       DCA     COUNT2  /RESET ALL KINDS OF THINGS TO ZERO
+       DCA     L36
+       DCA     L37
+       DCA     L30
+       DCA     FPSW
+       DCA     ESIGN
+       TAD     CM6
+       DCA     L65     /SET UP FOR MAXIMUM OF 6 CHARS
+       JMS I   GETCH   /GET THE FIRST INPUT CHARACTER
+       JMP     .+3     /ALPHA RETURN
+       JMP     PUNCT   /PUNCTIONATION RETURN
+       JMP     DIG     /DIGIT RETURN
+       JMS     PACK    /STORE THIS CHARACTER
+       JMS I   GETCH   /GET ANOTHER CHACTER
+       JMP     .-2     /ALPHA- IS OK
+       SKP             /PUNCTUATION
+       JMP     .-4     /DIGIT--IS OK PROCESS IT
+       JMS I   PUTCH   /PUT THAT PUNCTUATION BACK IN THE BUFFER
+       TAD     L32
+       AND     CC7700  /MAKE SURE NAME IS <= 5 CHARACTERS LONG
+       DCA     L32
+       JMP     XARET   /RETURN WITH VARIABLE
+
+PACK,  0               /THIS PACK CHARS INTO L30 L31 AND L32
+       DCA     L64     /SAVE THE CHAR...
+       TAD     L65
+       SNA             /DO WE HAVE SIX CHARS ALREADY?
+       JMP I   PACK    /YES - IGNORE
+       STL; RAR
+       TAD     P33
+       DCA     LTEM
+       ISZ     L65
+C7,    7
+       TAD     L64
+       CDF 10
+       SNL             /DO WE HAVE LEFT OR RIGHT HALF?
+       JMP     .+5
+       CLL RTL         /MUST BE LEFT HALF...
+       RTL
+       RTL
+       SKP
+       TAD I   LTEM
+       DCA I   LTEM
+       CDF 00
+       JMP I   PACK
+LTEM,  0
+
+PUNCT, SNA             /HERE TO PROCESS PUNCTION---IS IT A CARIAGE RET
+       JMP     ERET    /YES,   GO RIGHT BACKTO THE CALLER....BY-BY
+       TAD     C7722   /IS IT A PERIOD
+       SNA
+       JMP     CC      /YES--WE ASSUME THAT THIS LENTT IS A FLOATING
+       TAD     C7
+       SNA             /IS IT A QUOTE?
+       JMP I   QUOTE   /YES - CHARACTER LITERAL
+       TAD     CM3
+       SZA             /IS IT AN ASTERISK
+       JMP     NAH     /NO
+       JMS I   GETCH   /YES- PEEK AT NEXT CHAR
+       JMP     NOASS   /ALPHA-- PUT IT BACK
+       JMP     ASSCK   /PUNCTUATION-- CHECK FOR AN ASTERISK
+NOASS, JMS I   PUTCH   /DIGIT---PUT IT BACK
+NAH,   TAD     X52     /RESTORE CHARACTER TO WHAT IT WAS
+       JMP     PRET    /THATS ALL---IT WAS PUNCTIONATION
+ASSCK, TAD     CM52    /ANOTHER PUNCTUATION--IS IT (*)
+       SZA
+       JMP     NOASS   /NO---PUT IT BACK
+       TAD     C45     /IT WAS-- CHANGE ** TO PERCENT
+       JMP     PRET    /---ALTERED PUNCTUATION
+DIG,   AND     C17     /FIRST CHAR WAS A DIGIT,        DONT KNOW IS INTEGER O
+       DCA     L32     /AT ANY RATE SAVE IT IN THE PSEUDO ACCUMULATER
+CA,    JMS I   GETCH   /GET ANOTHER CHACTER
+       JMP I   LTESTE  /ALPHA--GO SEE IF IT IS AN -E-
+       SKP             /PUNCT
+       JMP     BONT    /DIGIT GO PROCESS IT
+       TAD     C7722   /PUNCTUATION HERE,      IS IT A PERIOD
+       SZA
+       JMP I   LCOP    / IT IS . WE HAVE A FLOATING POINT NUMBER
+CC,    TAD     FPSW
+       SZA
+ERR10, JMS I   LUNCH   /TOO MANY (.)
+       ISZ     FPSW
+       DCA     COUNT2
+       JMP     CA      /GO BACK AND GET ANOTHER CHAR
+BONT,  AND     C17     /***COME HERE WITH ANOTHER DIGIT.
+       DCA     L36     /SAVE IT
+       ISZ     COUNT2
+       JMS I   LMUL10  / AC = AC * 10 + DIGIT
+       JMP     CA      /GO GET ANOTHER CHAR
+P33,   L30+3
+CM6,   -6
+C7722, 7722
+X52,   52
+CM52,  -52
+C17,   17
+LTESTE,        TESTE
+C45,   45
+LCOP,  COP
+LMUL10,        MUL10
+QUOTE, LQUOTE
+
+
+DMPLIN,        0               /SUBROUTINE TO DUMP "LAST LINE" BUFFER
+       ISZ     L24
+       TAD I   L24     /GET NEXT CHAR
+       JMS I   PUNCH   /PUNCH IT
+       TAD I   L24
+       TAD     CM212
+       SZA CLA         /IS CHAR A LINE FEED?
+       JMP     DMPLIN+1        /NO
+       CLA IAC
+       DCA     L24     /RESET POINTER
+       DCA     L12     /ZERO CONTENTS FLAG
+       JMP I   DMPLIN  /RETURN
+CM212, -212
+CC7700,        7700
+\f      *1600
+TESTE, TAD     C7773   /IS IT E
+       SZA
+       JMP     COP     /NO, GO PUT IT BACK AND PROCESS
+/      HERE IF EXPONENT FOLLOWES
+       DCA     L37     /IT WAS AN E
+/ THIS ROUTINE IS TO PROCESS THE EXPONENT THAT FOLLOWES THE -E- THAT WE
+/
+       ISZ     FPSW    /MAKE SURE THE FLOATING POINT SWITCH WAS KICKED
+       JMS I   GETCH   /GET ANOTHER CHAR
+       JMP     ERR12   /ALPHA  , CANT BE-- SO LONG, ITS BEEN NICE
+       SKP             /PUNCT
+       JMP     CD      /DIGIT, GO PROCESS IT
+       TAD     X7725   /IS IT PULS SIGN
+       SNA
+       JMP     CF      /YES, IGNOR IT
+       TAD     CM2
+       SZA             /IS IT MINUS
+       JMP     COP     /NO, GO PROCESS THE FLOATING POINT NUMBER
+       CLA CMA
+       DCA     ESIGN   /YES- REMEMBER THAT THE EXPONENT WAS MINUS
+CF,    JMS I   GETCH   /GET ANOTHER CHAR
+       JMP     COP     /ALPHA, ALL READY TO PROCESS
+       JMP     COP     /PUNCTUATION, READY TO PROCESS
+CD,    AND     X17     /DIGIT
+       DCA     L36     /SAVE IT IN 36 AND..
+       TAD     L37     /MULTIPLY THE - EXPONENT TO DATE- BY 10
+       RAL CLL
+       DCA     L37
+       TAD     L37
+       RAL CLL
+       RAL CLL
+       TAD     L37
+       TAD     L36     /AND ADD IN THIS DIGIT I.E. 37C10*
+       DCA     L37     / L37 = 10 * L37 + L36
+       JMP     CF      /GO DO IT AGAIN
+COP,   JMS I   PUTCH
+       CLA CLL         /PROCESS THIS NUMBER
+       TAD     FPSW    /IS IT AN INTEGER
+       SZA CLA
+       JMP     CH      /NO, MUST BE FLOATING POINT
+/      INTEGER IS IN ACC
+       TAD     L30     /YESS
+       SNA             /MAKE SURE INTEGER IS VALID
+       TAD     L31
+       SZA CLA
+       JMP     ERR12
+       TAD     L32
+       SPA CLA
+ERR12, JMS I    LUNCH   /TOO BIG
+       JMP I   .+1     /TAKE INTEGER RETURN WITH INTEGER IN 32
+       XIRET
+CH,    TAD     L37     /WAS THIS AN E-CONVERSION NUMBER
+       ISZ     ESIGN   /EXPONENT POSITIVE?
+       CIA             /YES
+       TAD     COUNT2  /ADD POST-DECIMAL COUNTER
+       CLL
+       SNA
+       JMP     CM      /NOTHING TO DO
+       SMA             /DETERMINE WHETHER TO
+       CML CIA         /MULTIPLY OR DIVIDE
+       DCA     COUNT2
+       RAL
+       TAD     CJ
+       DCA     CK
+       JMS     XFLOAT  /SET UP THE NUMBER
+CK,    HLT             /JMP I (MULT OR JMP I (DIVIDE
+       ISZ     COUNT2
+       JMP     CK      /LOOP ON COUNT
+       JMP I   LPOLIS  /FINISH UP
+
+CM,    JMS     XFLOAT
+       JMP I   LPOLIS
+CJ,    JMS I   .+1
+       MULT
+       DIVIDE
+
+/ THIS ROUTINE CONVERTS THE NUMBER TO FLOATING POINT
+XFLOAT,        0
+       CLA CLL
+       TAD     L32     /CHECK IF THE ACCUMULATED NUMBER IS ZERO
+       SNA
+       TAD     L31
+       SNA
+       TAD     L30
+       SNA CLA
+       JMP I   LFRET   /IT WAS ZERO SEND A FLOATING POINT ZERO BACK--
+       TAD     C2440   /IT IS NOT ZERO--SET THE EXPON TO 36 BASE 10
+       DCA     L37
+       JMS     NORMAL  /GO TO THE NORMALIZE ROUTINE
+       JMP I   XFLOAT  /AT THIS POINT THE MANTISA AND EXPON ARE SEPERA
+/      ALSO NOTICE THAT WE HAVE 36 BINARY DIGITS I E THE WHOLE 3 WORDS ARE U
+/      NORMAL IZATION OF A F P NUMBER
+NORMAL, 0
+DA,    TAD     L30     /WE MUST SHIFT UNTIL THE HIGH ORDER WORD GOES N
+       SPA CLA
+       JMP I   NORMAL  /IT IS NEG.,    ALL DONE
+       JMS I   LLSHIF  /GO DO A TRIPLE PRECISION LEFT SHIFT
+       TAD     L37     /AND SUBTRACT ONE FROM THE EXPONENT
+       TAD     C7770   /NOTE-- THE 3 LOW ORDER BITS ARE NOT USED
+       SPA             /IF THIS DOESNT SKIP WE HAVE F P OVERFLOW
+       JMP     ERR12   /BY-BY  NUMBER TOO LARGE FOR THE MACHINE
+       DCA     L37
+       JMP     DA
+/ THE FOLLOWING ROUTINE SAVES THE ACC IN THE MQ
+C7773, 7773
+X7725, 7725
+X17,   17
+C7770, 7770
+LPOLIS,        POLISH
+LFRET, FRET
+C2440, 2440
+LLSHIF,        LSHIFT
+
+SCODE, CDF 10          /SHIFT S-CODE 2 COLS. LEFT
+       TAD I   (TEM1
+       CDF 0
+       DCA     SLOC1
+       TAD     SLOC1
+       IAC
+       DCA     SLOC2
+       ISZ     L61     /SET COMMENT FLAG
+SCODL, TAD I   SLOC2
+       DCA I   SLOC1
+       TAD I   SLOC2
+       AND     C77
+       SNA CLA         /END OF LINE?
+       JMP I   (STORSL+2
+       ISZ     SLOC1
+       ISZ     SLOC2
+       JMP     SCODL   /AND CONTINUE PROCESS
+
+SLOC1, 0
+SLOC2, 0
+\f      *2000
+XSAVE, 0               /-- THE F.P. AC IS IN LOCS 30-32
+       TAD     L30     /-- THE "MQ" IS IN LOCS 33-35
+       DCA     L33     /---THE EXPONENT IS IN LOCS 37
+       TAD     L31
+       DCA     L34
+       TAD     L32
+       DCA     L35
+       JMP I   XSAVE
+/ SHIFTS THE PSEUDO-ACC LEFT ONE PLACE
+LSHIFT, 0
+       CLA CLL
+       TAD     L32
+       RAL
+       DCA     L32
+       TAD     L31
+       RAL
+       DCA     L31
+       TAD     L30
+       RAL
+       DCA     L30
+       JMP I   LSHIFT
+/ THE FOLLOWING ROUTINE ADDS THE MQ TO THE ACC
+ADD,   0
+       CLA CLL
+       TAD     L32
+       TAD     L35
+       DCA     L32
+       RAL
+       TAD     L31
+       TAD     L34
+       DCA     L31
+       RAL
+       TAD     L30
+       TAD     L33
+       DCA     L30
+       JMP I   ADD
+/ THE FOLLOWING ROUTINE SHIFTS THE ACC RIGHT ONE PLACE
+RSHIFT, 0
+       CLA CLL
+       TAD     L30
+       RAR
+       DCA     L30
+       TAD     L31
+       RAR
+       DCA     L31
+       TAD     L32
+       RAR
+       DCA     L32
+       JMP I   RSHIFT
+/
+/
+MULT,  0               /ACCCACC*10 MQ
+       JMS     RSHIFT
+       JMS     XSAVE
+       JMS     RSHIFT
+       JMS     RSHIFT
+       JMS     ADD     /THIS FINISHES THE MULT BY 10
+       TAD     L37     /NOW DIDDLE THE EXPONENT
+       TAD     C40
+       SPA             /OVERFLOW TEST
+ERR14, JMS I   LUNCH   /FLOATING POINT OVERFLOW
+       DCA     L37
+       JMS I   LNRMAL  /MAKE SURE THE F P NUMBER IS STILL IN NORMAL FO
+       JMP I   MULT
+DIVIDE, 0              /DIVIDE THE F P NUMBER BY 10
+       JMS     RSHIFT  /BASED ON THE FACT THAT .1 BASE 10 C .000110011
+       JMS     XSAVE   /THAT IS WE MULTIPLE BY ONE TENTH
+       TAD     C7766   /THIS IS A COUNTER**********************
+       DCA     ZCTR
+DB,    JMS     RSHIFT
+       JMS     ADD
+       ISZ     ZCTR
+       SKP
+       JMP     DC
+       JMS     RSHIFT
+       JMS     RSHIFT
+       JMS     RSHIFT
+       JMS     ADD
+       JMP     DB
+DC,    TAD     L37
+       TAD     C7750   /********INSERT HERE THE CONSTANT************
+       DCA     L37     /WE HAVE JUST DIDDLED THE EXPONENT BY THE PROP 
+       JMS I   LNRMAL  /MAKE SURE IT IS STILL NORMALIZ D
+       JMP I   DIVIDE
+ZCTR,  0
+MUL10, 0               /THIS MULTIPLIES THE TRIPLE PREC. INTEGER INT E
+       JMS     LSHIFT  /BY 10
+       JMS     XSAVE
+       JMS     LSHIFT
+       JMS     LSHIFT
+       JMS     ADD
+       TAD     L36     /NOW CRAM THE DIGIT THAT WE WANT TO ADD INTO TH
+       DCA     L35     /*
+       DCA     L34
+       DCA     L33
+       JMS     ADD     /AND ADD IT TO THE ACC
+       JMP I   MUL10   /IN OTHER WORDS ACCCACC*10 DIGIT
+POLISH, CLA CLL        /THIS TAKES THE SEPARATE MANTISSA AND EXP--ENT.
+       TAD     C400    /AND PUTS THEM INTO 7090 FORM.  THIS IS THE R-U
+       DCA     L35     /27 DIGITS
+       DCA     L34     /ROUND FACTOR IS CRAMED INTO THE MQ
+       DCA     L33
+       JMS     ADD     /AND ADDED TO THE INTEGER IN THE ACC
+       SNL             /IF THE LINK IS ON, WE OVERFLEW ON THE CARRY
+       JMP     POLSH   /WE DIDNT
+       TAD     C4000   /SET THE ACC TO .1000000000     (THE REST OF IT IS
+       DCA     L30
+       TAD     L37     /DIDDLE THE EXPONENT BY ONE. THIS IS A FINKIE N
+       TAD     J10
+       SNA
+       JMP     ERR14   /EXPONENT OVERFLOW ...
+       DCA     L37
+POLSH, TAD     C7767   /NOW SHIFT THE ENTIRE ACC RIGHT 9 TIMES
+       DCA     ZCTR    /( THATS SO WE WILL HAVE ROOM TO STICK IN THE E
+HOOP,  JMS     RSHIFT
+       ISZ     ZCTR
+       JMP     HOOP
+       TAD     L37     /CRAM THE EXP
+       TAD     L30     /INTO THE ACC
+       DCA     L30     /AND VOILA, WE ARE DONE. GO TAKE THE FPOINT EX
+       JMP I   .+1
+       FRET
+LNRMAL,        NORMAL
+C7766, 7766
+C7750, 7750
+C400,  400
+J10,   10
+C7767, 7767
+\f      *2200
+/      THE FOLLOWING ROUTINE LOOKS FOR A STATEMENT NUMBER
+LSTMT, 0
+       JMS I   CLEAR   /CLEAR THE PSEUDO ACC AND MQ
+       TAD     C7240   /DON'T LET LGTC GET ANOTHER LINE YET(CHK MUST BE NEG., BUT NOT 4000!!)
+       DCA     CHK
+       IAC
+       DCA     KOUNT
+LABEL, JMS I   GTCL    /GET A CHARACTER
+       SNA             /IS THIS A CAR RET?
+ERR15, JMS I   LUNCH   /YES, INCOMPLETE STATEMENT
+       TAD     CM40
+       SNA             /SPACE?
+       JMP     SPACE
+       TAD     CM32
+       CLL
+       TAD     C12
+       SNL             / 260 <= CHAR < 272 ?
+ERR16, JMS I   LUNCH
+       DCA     L36     /SAVE THIS DIGIT...
+       JMS I   MULT10  / ACC = 10 * ACC + L36
+SPACE, TAD     KOUNT
+       TAD     DM6
+       SPA CLA         /END OF STMT NR FIELD?
+       JMP     LABEL   /NOT YET...
+       JMS I   GTCL    /SKIP OVER COL 6
+       SNA CLA         /IS IT A CAR RET?
+       JMP     ERR15
+       TAD     L31     /SEE IF STMT NR IS LEGAL...
+       SZA
+       JMP     ERR16
+       TAD     L32
+       SPA CLA         /IS STMT NR < 2048 ?
+       JMP     ERR16   /NO, STMT NR TOO BIG
+       JMP I   LSTMT
+CLEAR, LCLEAR
+GTCL,  LGTC
+MULT10,        MUL10
+CM32,  -32
+DM6,   -6
+C12,   12
+/
+/      SUBROUTINEE TO PRINT A SYMBOL
+/
+/      JMS I   PRSYM
+/
+LPRSYM,        0               /THIS ROUTINE PRINTS SYMBOLS
+       DCA     LCH
+       TAD     LCH
+       SMA             /IS IT AN INTEGER CONSTANT
+       JMP     ICON    /YES PROCESS IT
+       RTL             /SHIFT THE NEXT BIT INTO THE LINK
+       SNL             /IS IT A TEMPORARY
+       JMP     TEMPO   /ITS A TEMPORARY
+       RTR             /RESTORE THE SYMBOL
+       CIA             /SET IT NEGATIVE
+       TAD     L47     /SUBTRACT THE BEGINNING OF THE XFCON TABLE
+       SPA CLA         /DO WE HAVE AN FCON
+       JMP     XFCON   /YES PROCESS IT
+       TAD     LCH
+       TAD     C2      /ADD TWO TO THE SYMBOL TABLE POINTER
+       DCA     LP2     /AND SAVE IT
+       TAD I   LP2     /GET THE CONTROL BITS FOR THE SYMBOL
+       RAR             /GET EXTERNAL SUBROUTINE BIT IN LINK
+       SZL CLA         /IS THIS AN EXTERNAL SUBROUTINE
+       JMP     SKPIT   /YES...DONT PUT OUT THE BACK SLASH
+       TAD     C34
+       JMS I   PRINT
+SKPIT, TAD I   LCH
+       JMS     LP2     /PRINT THEM
+       ISZ     LCH
+       TAD I   LCH
+       JMS     LP2     /AND PRINT THEM
+       ISZ     LCH
+       TAD I   LCH
+       AND     X7700   /MASK SO WE DONT PUT OUT CONTROL BITS
+       JMS     LP2     /AND PRINT IT
+       JMP I   LPRSYM  /NOW RETURN
+LP2,   0               /THIS IS THE ROUTINE THAT PRINTS TWO CHARACTERS
+       DCA     UNCH    /SAVE THE CHARS
+       TAD     UNCH    /GET THEM AGAIN
+       RTR             /ROTAT FIRST CHAR INTO POSITION
+       RTR
+       RTR
+       AND     C77     /MASK SECOND CHARACTER
+       SZA             /IS IT AN ACTUAL CHARACTER
+       JMS I   PRINT   /YES PRINT IT
+       TAD     UNCH    /GET THE TWO CHARS AGAIN
+       AND     C77     /MASK OUT FIRST CHARACTER
+       SZA             /IS IT ACTUALLY A CHARACTER
+       JMS I   PRINT   /YES PRINT IT
+       JMP I   LP2     /AND RETURN
+ICON,  CLA             /INTEGER CONSTANT, PUNCH A '('
+       TAD     K50
+       JMS I   PRINT
+       TAD     LCH     /AND THE NUMBER
+PROCT, JMS I   PROTAC
+       JMP I   LPRSYM  /RETURN
+TEMPO, RTL
+       SPA CLA         /SUBSCRIPT TEMPORARY?
+       JMP     SBSCR
+       RTL
+       TAD     D33     /PUNCH '[' FOR INTEGER AND ']' FOR FLOATING PT
+       JMS I   PRINT   /AND PRINT IT
+       TAD     LCH
+       SPA             /DO WE STILL HAVE A TEMPORARY
+       JMS I   TEMPOR  /YES GET THE TEMPORARY NUMBER
+       JMS I   PRINT   /AND PRINT IT
+       JMP I   LPRSYM  /RETURN
+SBSCR, TAD     D33     /SUBSCRIPT TEMPORARY, PUNCH A '['
+       JMS I   PRINT
+       TAD     LCH
+       JMS I   SUBTEM  /AND 4 DIGITS
+       JMP     PROCT
+XFCON, TAD     C35     /FLOATING POINT CONSTANT...
+       JMS I   PRINT   /PUNCH A ']'
+       TAD     LCH
+       CIA
+       TAD     L50     /SUBTRACT FROM END OF TABLE
+       JMP     PROCT
+D33,   33
+C35,   35
+K50,   50
+C34,   34
+X7700, 7700
+LCH,   0
+UNCH,  0
+SUBTEM,        LSBTEM
+TEMPOR,        LTMPOR
+\f      *2400
+/
+/      SUBROUNTINE TO DO SYMBOL TABLE MANIPULATIONS
+/
+C300,  300
+C212,  212
+C215,  215
+SCOUNT, 0              /CURRENT NUMBER OF SYMBOLS
+XCTR,  0               /COUNTER
+FCOUNT, 0              /CURRENT NUMBER OF FCONS
+LSYMTB, 0
+       CLA             /CLEAR THE AC
+LOOP1, TAD     L56     /GET BEGINNING OF SYMBOL TABLE
+       DCA     LSYMTM  /AND SAVE IN TABLE
+       TAD     SCOUNT  /GET NUMBER OF SYMBOLS CURRENTLY
+       CMA
+       DCA     XCTR    /USE AS A COUNTER
+       TAD     C7700   /GIVE SEARCH A MASK TO USE ON LAST SYMBOL
+       JMS     SEARCH  /LOOK FOR OCCURRENCE OF SYMBOL IN TABLE
+       JMP     ZCHECK  /SYMBOL IS IN TABLE CHECK IT
+       TAD     L57     /TELL ENTER WHERE TO PUT THE SYMBOL
+       JMS     ENTER   /ENTER THE SYMBOL
+       TAD     C3      /UPDATE THE POINTER
+       DCA     L57     /AND SAVE IT
+       DCA     L21     /ZERO SWITCH SINCE SYMBOL JUST LOADED
+       ISZ     SCOUNT  /UPDATE COUNT OF SYMBOLS
+       JMP     LOOP1   /GO BACK AND CHECK IT
+ZCHECK,        TAD     L77     /GET POINTER INTO SYMBOL TABLE
+       TAD     C2      /MOVE TO LAST WORD
+       DCA     LSYMTM  /SAVE IT
+       TAD I   LSYMTM  /GET THE CONTROL BITS
+       AND     L21     /AND THE MASK
+       SZA CLA         /ARE ANY ILLEGAL BITS ON
+ERR54, JMS I   LUNCH   /ERROR 54 ... PROBABLY IN EQUIVALENCING ...
+       TAD     L32     /NOW OR IN NEW BITS
+       CMA
+       AND I   LSYMTM
+       TAD     L32
+       DCA I   LSYMTM
+       JMP I   LSYMTB  /RETURN
+/      FLOATING CONSTANT IS IN 30 THRU 32
+LFCON, 0
+       CLA
+MLOOP, TAD     L47     /GET BEGINNING OF FCON TABLE
+       TAD     C3      /MOVE TO ACTUAL START OF TABLE
+       DCA     LSYMTM  /AND SAVE
+       TAD     FCOUNT  /GET NUMBER OF FCONS SO FAR
+       CMA
+       DCA     XCTR    /AND USE FOR A COUNTER
+       CMA             /GIVE SEARCH A MASK FOR THE LAST WORD
+       JMS     SEARCH  /SEARCH THE TABLE FOR THE CURRENT FCON
+       JMP I   LFCON   /ITS ALREADY IN THERE JUST RETURN
+       TAD     L47     /TELL ENTER WHERE TO PUT THE FCON
+       JMS     ENTER   /ENTER THE FCON
+       TAD     CM3     /AND UPDATE IT
+       DCA     L47     /AND SAVE
+       ISZ     FCOUNT  /UPDATE NUMBER OF FCONS
+       JMP     MLOOP   /GO BACK AND CHECK
+/      THIS IS THE ROUTINE THAT SEARCHES THE TABLES FOR
+/      OCCURRENCES OF THE CURRENT SYMBOL OR FCON
+SEARCH, 0
+       DCA     ENTER   /SAVE THE MASK
+MBACK, ISZ     XCTR    /SEE IF WE HAVE PROCESSED ALL SYMBOLS
+       SKP             /NO GO ON
+       JMP     QRET    /YES
+       TAD I   LSYMTM  /GET FIRST WORD OF SYMBOL
+       CIA             /NEGATE
+       TAD     L30     /SUBTRACT FIRST WORD OF CURRENT SYMBOL
+       ISZ     LSYMTM  /INCREMENT POINTER
+       SZA CLA         /DO THEY MATCH
+       JMP     I1      /NO GO TO NEXT SYMBOL
+       TAD I   LSYMTM  /YES GET SECOND WORD OF SYMBOL
+       CIA
+       TAD     L31     /SUBTRACT SECOND WORD OF CURRENT SYMBOL
+       ISZ     LSYMTM  /ADVANCE POINTER
+       SZA CLA         /DO THEY MATCH
+       JMP     I2      /NO GO TO NEXT SYMBOL
+       TAD I   LSYMTM  /SEE IF NEXT WORD MATCHES
+       AND     ENTER   /MASK OUT DESIRED PORTIONS
+       CIA
+       TAD     L32     /SUBTRACT THIRD CURRENT WORD
+       AND     ENTER   /K AGAIN
+       ISZ     LSYMTM  /ADVANCE POINTER
+       SZA CLA         /DO THEY MATCH
+       JMP     MBACK   /NO GO TO NEXT SYMBOL
+       TAD     LSYMTM  /YES
+       TAD     CM3     /MOVE BACK POINTYER
+       DCA     L77     /PUT POINTER IN PAGE ZERO
+       JMP I   SEARCH  /RETURN
+QRET,  ISZ     SEARCH  /SET UP RETURN FOR      NOT FOUND
+       JMP I   SEARCH  /RETURN
+I1,    ISZ     LSYMTM  /ADVANCE POINTER
+I2,    ISZ     LSYMTM  /ADVANCE PIINTER
+       JMP     MBACK   /GO TO NEXT SYMBOL
+/      THIS ROUTINE ENTERS THE CURRENT SYMBOL INTO THE TABLE SPECIFIED
+ENTER, 0
+       DCA     LSYMTM  /SAVE ADDRESS
+       TAD     L47     /GET BEGINNING OF FCON TABLE
+       CMA
+       TAD     L57     /SUBTRACT END OF SYMBOL TABLE
+C7700, SMA CLA         /IS THERE ROOM FOR ANOTHER SYMBOL OR FCON
+ERR17, JMS I   LUNCH   /NO
+       TAD     L30     /YES GEYT FIRST WORD
+       DCA I   LSYMTM  /STORE IT
+       TAD     LSYMTM
+       DCA     L11     /SET UP AUTO - XR
+       TAD     L31
+       DCA I   L11
+       TAD     L32
+       DCA I   L11
+       TAD     LSYMTM  /GET THE ADDRESS BACK INTO THE AC
+       JMP I   ENTER   /AND RETURN
+DUMPLN,        DMPLIN
+LSYMTM=.
+LPRINT,        0               / CONVERTS FROM TRIMMED TO EIGHT BIT ASCII
+       DCA     LFCON   /SAVE THE CHARACTER
+       TAD     L75     /S GET THE SUPPRESS PRINTING WITCH
+       SZA CLA
+       JMP I   LPRINT
+       ISZ     L24     /IS THIS A NEW LINE?
+       SKP             /NO
+       JMS I   DUMPLN  /YES - DUMP THE OLD ONE FIRST
+       TAD     LFCON   /NO...GET THE CHARACTER
+       SNA             /IS IT A CR
+       JMP     CRLF    /YES...PUT OUT CRLF
+       AND     C40     /CHECK BIT SIX
+       CLL RAL
+       CIA             /AC CONTAINS 0 OR -100
+       TAD     C300    /NOW CONTAINS 300 OR 200
+       TAD     LFCON   /NOW ADD THE CHARACTER IN
+\fPRIT, DCA I   L24     /AND STORE IT IN THE BUFFER
+       JMP I   LPRINT
+CRLF,  TAD     C215    /GET AN EIGHT BIT CR
+       DCA I   L24     /STORE IT IN THE BUFFER
+       ISZ     L24
+       TAD     C212
+       DCA I   L24     /STORE A LINE FEED TOO
+       CLA CMA
+       DCA     L24     /SET SWITCH TO DUMP LINE ON NEXT CHAR
+       JMP I   .+1
+       PRIT+1
+\fLCOMON, CLA
+       JMS I   LOOK    /CHECK REST OF STATEMENT NAME
+               -2      /TWO CHARACTERS
+               -17     /O
+               -16     /N
+GETVAR, JMS I  ENTITY  /GET A VARIABLE
+       SKP             /NOT A VARIZBLE
+       JMP     VARI    /WE GOT A VARIABLE
+       NOP
+B20,   20
+ERR18, JMS I   LUNCH   /ERROR
+VARI,  TAD     C40
+       TAD     L32     /PUT IN COMMON BIT
+       DCA     L32
+       TAD     K37     /GET MASK FOR SYMBOL TABLE SWITCH
+       DCA     L21     /PUT IN THE SWITCH
+       JMS I   SYMTAB  /PUT SYMBOL IN TABLE
+       JMS I   ENTITY  /LOOK FOR A COMMA
+       JMP     START   /THAT'S ALL GOT A CR-LF...
+K37,   37
+K27,   27
+       JMP     .+3     /ERROR
+       TAD     CM54    /CHECK FOR COMMA
+       SZA CLA         /IS IT A COMMA
+       JMP     ERR18   /NO...ERROR
+       JMP     GETVAR  /GET ANOTHER VARIABLE
+LDIMEN,        JMS I   LOOK    /LOOK FOR REST OF STATEMENT
+               -5      /FIVE CHARS
+               -16     /N
+               -23     /S
+               -11     /I
+               -17     /O
+               -16     /N
+QAGAIN,        CLA CMA         /-U
+       DCA     REDY    /SET SWITH FOR VARIABLE
+QGET,  JMS I   ENTITY  /GET WHATEVER IS NEXT IN LINE
+       JMP     QDONE   /IT EAS A CR
+       JMP     .+4     /IT WAS A VARIABLE
+       JMP     ASUBSC  /IT WAS ONE OF THE SUBSCRIPTS
+       JMP     ERR18   /WE BETTER NOT GET ANY FP NUMBERS
+       JMP     QPUNC   /IT WAS A PUNCTION
+       ISZ     REDY
+       JMP     ERR18   /WE WERENT READY FOR A VAR
+       TAD     B20
+       TAD     L32
+       DCA     L32
+       TAD     K27     /GET THE MASK FOR THE SYMBOL TABLE
+       DCA     L21     /PUT IN THE SWITCH
+       JMS I   SYMTAB  /PUT SYMBOL IN TABLE
+       CMA CLA
+       TAD     L47     /GET BEGINNING OF TABLE
+       DCA     L16
+       TAD     L77     /GET TABLE ADDRESS
+       DCA I   L16
+       CLA CMA
+       DCA     V       /SET WITCH TO SAY WEVE GOTTEN A VAR
+       JMP     QGET    /GET NEXT THING
+QPUNC, TAD     CM54
+       SNA             /IS IT A COMMA
+       JMP     COMMA   /YES
+       TAD     C3
+       SNA
+       JMP     QRPAR   /RIGHT PAREN
+       IAC
+       SNA             /IS IT A LEFT PAREN
+       ISZ     V       /PRECEDED BY A VAR
+       JMP     ERR18   /NO - ERROR
+       CLA CMA
+       DCA     XLP     /SET SWITCH TO SHOW LPAR
+       JMP     QGET
+ASUBSC,        ISZ     XLP     /DID WE JUST GET LPAR
+       JMP     SECOND  /NO...BETTER BE SECOND SUBSC
+       TAD     L32     /GET INTEGER
+       DCA I   L16     /PUT IN DIMTAB
+       CMA CLA
+       DCA     QONE    /SET SWITCH TO SHOW WE HAVE ONE SUBSC
+       JMP     QGET
+COMMA, ISZ     QONE    /DOES THIS COMMA SEPARATE SUBSCS
+       JMP     RIGHT   /NO...LAST CHAR BETTER HAVE BEEN L      RPAR
+       CMA CLA
+       DCA     SEC     /SET SWITCH TO EXPECT SECOND SUBSCRIPT
+       JMP     QGET
+SECOND, ISZ    SEC     /IS THIS SECOND SUBSCRIPT
+       JMP     ERR18   /NO...ERROR
+       TAD     32      /GET INTEGER
+       DCA I   L16
+       CMA CLA
+       DCA     R       /SET SWITCH FOR RPAR
+       JMP     QGET
+QRPAR, ISZ     QONE    /HAVE WE GOTTEN ONE SUBSC
+       JMP     QTWO    /NO...CHECK FOR TWO
+       IAC             /ONLY ONE SO USE 1 AS SECOND
+       DCA I   L16
+QBACK, CMA CLA
+       DCA     RIG
+       TAD     L47     /GET BEGINNING OF TABLE
+       DCA     L50     /SAVE IN LOW CORE
+       TAD     L47
+       TAD     CM3     /SUBTRACT THREE FROM ADDRESS
+       DCA     L47     /AND SAVE
+       JMP     QGET    /WE EXPECT COMMA OR CR
+QTWO,  ISZ     R       /HAVE WE GOTTEN TWO
+       JMP     ERR18   /NO...ERROR
+       JMP     QBACK
+RIGHT, ISZ     RIG     /DID WE JUST GET RPAR
+       JMP     ERR18   /NO...ERROR
+       JMP     QAGAIN
+QDONE, ISZ     RIG
+       JMP     ERR18
+       JMP     START
+QONE,  0
+RIG,   0
+R,     0
+REDY,  0
+V,     0
+XLP,   0
+SEC,   0
+\f      *3000
+LGOTO, TAD     L74
+       DCA     L16     /USE AUTO INDEXING
+       DCA     L76
+       JMS I   ENTITY
+       NOP
+       SKP
+       JMP     ALAB    /WE HAVE A LABEL
+       JMP I   ASSIGN  
+       TAD     CM50    /IF PUNCT...CHECK FOR LEFT PAREN
+       SZA CLA         /IS IT (
+       JMP I ASSIGN
+ANEXT, JMS I   ENTITY
+       NOP
+       SKP
+       JMP     THERE   /WE HAVE A LABEL
+       NOP
+ERR28, JMS I   LUNCH
+THERE, TAD     L32     /GET THE LABEL
+       DCA I   L16     /PUT IN LIST
+       ISZ     L76
+       JMS I   GNB
+       TAD     CM54    /CHECK FOR BEING A COMMA
+       SNA             /IS IT A COMMA
+       JMP     ANEXT   /YES GET ANOTHER LABEL
+       TAD     C3      /CHECK FOR BEING A RIGHT PAREN
+       SZA CLA         /IS IT A )
+       JMP I ASSIGN
+       JMS I   GNB
+       TAD     CM54    /CHECK FOR ANOTHER COMMA
+       SZA             /IS IT ANOTHER
+       JMS I   PUTCH   /IGNORE ANYTHING ELSE ...
+       JMS I   ENTITY  /GET THE CONTROL VARIABLE
+       SKP
+       JMP     .+4     /WE GOT IT
+       NOP
+       NOP
+ERR29, JMS I   LUNCH
+       DCA     L21     /ZERO THE SYMBOL TABLE SWITCH
+       JMS I   SYMTAB  /PUT VARIABLE IN SYMBOL TABLE
+       TAD     L77     /GET ADD RESS OF SYMBOL
+       JMS I   MODE    /CHECK THE MODE OF THE VAIABLE
+ERR30, JMS I   LUNCH   /ITS FLOATING POINT
+       JMS I   ZZZ     /PUT OUT STMT LABEL
+       JMS     LXTAD   /LOAD VARIABLE WITH TAD OR TAD*
+       JMS I   PROP    /PUT OUT OP CODE
+Q6066,         6066    /OP CODE IS TAD
+       JMS I   CREATE  /GET THE NEXT CREATED LABEL
+       JMS I   PRCRL   /PRINT THE CREATED LABEL
+       JMS I   PRINT   /PUT OUT CR LF
+       JMS I   PROP    /PUT OUT OP CODE
+               6071    /OP CODE IS DCA
+       TAD     GO7
+       JMS I   PROTAC
+       JMS I   PRINT   /PUT OUT CRLF
+       JMS I   PROP    /PUNCH 'TAD I 7'
+               OPTADI
+       TAD     GO7
+       JMS I   PROTAC
+       JMS I   PRINT
+       JMS I   PROP    /PUNCH 'DCA 7'
+               OPDCA
+       TAD     GO7
+       JMS I   PROTAC
+       JMS I   PRINT
+       JMS I   PROP    /PUNCH 'JMP I 7'
+               OPJMPI
+       TAD     GO7
+       JMS I   PROTAC
+       JMS I   PRINT
+       TAD     L76     /PUNCH 'CPAGE <N+1>'
+       IAC
+       JMS I   PIFF
+       TAD     L53     /PUNCH '<CR.LABEL2>, <CR.LABEL2>'
+       JMS I   CLAB
+       TAD     L53
+       JMS I   PRCRL
+       JMS I   PRINT
+       TAD     L76     /NOW PUNCH THE LABELS
+       CIA             /SET NEGATIVE
+       DCA     L76
+       TAD     L74
+       DCA     L16     /USE AUTO INDEXING AGAIN
+       TAD I   L16     /GET THE NEXT LABEL
+       JMS I   PLAB    /PRINT THE LABEL
+       JMS I   PRINT   /PUT OUT CRLF
+       ISZ     L76
+       JMP     .-4     /NO
+       JMP     START
+/      THE FOLLOWING SECTION IS TO TREAT REGULAR GOTO S
+ALAB,  JMS I ZZZ
+       TAD     L32
+       JMS     PRJUMP  /PUT OUT A JUMP TO THE LABEL IN "L32"
+       JMP     START
+
+LXTAD, 0
+       TAD     L77     /GET ADDRESS AGAIN
+       JMS I   DUMARG
+       TAD     CM3
+       TAD     Q6066   /TAD OR TAD*
+       DCA     OP      /USE AS OPERATOR
+       JMS I   PROP    /PUT OUT OP CODE
+OP,            0
+       TAD     L77     /GET ADDRESS AGAIN
+       JMS I   PRSYM   /PRINT THE SYMBOL
+       JMS I   PRINT   /PUT OUT A CR LF
+       JMP I   LXTAD
+
+LLEAD, 0               /PUNCH SOME LEADER...
+       DCA     L7
+       JMS I   PUNCH
+       ISZ     L7
+       JMP     .-2
+       JMP I   LLEAD
+GO7,   7
+
+PRJUMP,        0       /SUBROUTINE TO PUT OUT A JUMP
+       DCA     LLEAD   /STORE THE LABEL
+       JMS I   PROP
+               6044    /JMP
+       TAD     LLEAD
+       JMS I   PLAB    /PUT OUT THE LABEL
+       JMS I   PRINT   /PUT OUT A CRLF
+       TAD     LLEAD
+       DCA     L12     /SET CONTENTS OF LAST LINE TO LABEL
+       JMP I   PRJUMP
+\f      *3200
+/      THE FOLLOWING ROUTINE PUNCHES OCTAL NUMBERS
+
+LPRTAC, 0
+       DCA     TMP     /SAVE THE NUMBER
+       DCA     TM
+       TAD     CM4     /PUT OUT FOUR CHARACTERS
+       DCA     DCTR    /CHARACTER COUNTER
+BK,    TAD     TMP     /GET THE NUMBER
+       RAL             /ROTATE IT LEFT ONE
+       RTL             /ROTATE TWO LEFT...THAT MAKES ONE OCTAL DIGIT
+       DCA     TMP     /SAVE THE ROTATED NUMBER
+       TAD     TMP     /GET IT IN ACCUMULATOR
+       AND     C3
+       RAL             /GET THE DIGIT INTO THE LOW-ORDER AC
+       ISZ     DCTR    /IS THIS THE LAST DIGIT?
+       JMP     .+4     /NO, CONTINUE
+       TAD     C60     /MAKE IT LOOK LIKE A TRIMMED ASCII DIGIT
+       JMS I   PRINT   /PRINT THE DIGIT
+       JMP I   LPRTAC
+       SZA             /DO WE HAVE A ZERO DIGIT?
+       JMP     .+4
+       TAD     TM
+       SNA CLA         /YES, IS IT A LEADING ZERO?
+       JMP     BK      /YES, IGNORE IT
+       TAD     C60
+       JMS I   PRINT
+       ISZ     TM      /DON'T SUPPRESS ZEROS ANY MORE
+       JMP     BK      /NOW...PUT OUT ANOTHER
+TMP,   0
+TM,    0
+CM4,   -4
+C60,   60
+LIF,   TAD     CM4
+       DCA     COUNT1  /SET UP COUNTER
+       JMS I   GNB
+       TAD     CM50    /CHECK FOR      LEFT PAREN
+       SZA CLA         /IS IT A (
+       JMP I ASSIGN
+       JMS I   PUTCH   /YES...PUT IT BACK FOR GENER
+       JMS I ZZZ
+       ISZ     L52     /SET BALANCED PARENS SWITCH FOR GENER
+       ISZ     L44     /SET SWITCH FOR RIGHT SIDE OF EQUALS SIGN
+       JMS I   GENER   /NOW CALL GENER AND PROCESS EXPRESSION
+       TAD I   L41
+       JMS I   MODE    /WHAT IS ITS MODE
+       JMS I   GETHI   /GET HI ORDER P.P. AC
+       TAD     CDCA41
+       DCA     LIFDCA  /SET UP INSTRUCTION TO STORE LABELS
+LABL,  JMS I   ENTITY  /GET A LABEL
+D34,   34
+       SKP
+       JMP     INTEG   /WE GO A LABEL
+C46,   46
+ERR31, JMS I   LUNCH   /DIDNT GET A LABEL
+INTEG, TAD     L32     /GET THE LABEL
+       ISZ     LIFDCA
+LIFDCA,        .-.             /STORE LABELS IN L42 THROUGH L44
+       DCTR=LIFDCA
+       ISZ     COUNT1  /HAVE WE GOTTEN TOO MANY LABELS
+       SKP             /NO
+       JMP     ERR31   /YES
+       JMS I   GNB
+       SNA             /SEE IF ITS A CR
+       JMP     .+5     /ITS A CR
+       TAD     CM54    /CHECK FOR COMMA
+       SZA CLA         /IS IT A COMMA
+       JMP     ERR31
+       JMP     LABL    /YES
+       ISZ     COUNT1  /DID WE GET THE RIGHT NUMBER OF LABELS
+       JMP     ERR31   /NO
+       TAD     L42
+       CIA
+       TAD     L44
+       SNA CLA         /IF THE JUMPS FOR AC<0 AND AC>0 ARE EQUAL
+       JMP     ISPECL  /WE CAN SAVE SOME CODE
+       TAD     L43
+       CIA
+       TAD     L44
+       SNA CLA         /IF THE JUMPS FOR AC=0 AND AC>0 ARE EQUAL
+       JMP     SPCONL  /WE CAN ALSO SAVE SOME CODE
+       JMS I   PROP    /PUT OUT OP CODE
+               6105    /OP CODE IS SNA
+       JMS I   PRINT   /PUT OUT CRLF
+       TAD     L43
+       JMS I   PRJMP   /OUTPUT THE ZERO BRANCH
+SPCONL,        JMS I   PROP    /PUT OUT OP CODE
+               6110    /OP CODE IS P SPA CLA
+       JMS I   PRINT   /PUT OUT CRLF
+       TAD     L42     /OUTPUT THE NEGATIVE BRANCH
+IFCOMN,        JMS I   PRJMP
+       TAD     L44
+       JMS I   PRJMP   /OUTPUT THE POSITIVE (>0) BRANCH
+       DCA     L46     /ZERO AC
+       JMP     START   /GO GET NEXT STATEMENT
+ISPECL,        JMS I   PROP    /PUNCH 'SNA CLA'
+               OPSNA
+       JMS I   PROP
+               OPCLA
+       JMS I   PRINT
+       TAD     L43
+       JMP     IFCOMN  /OUTPUT THE ZERO AND POSITIVE BRANCHES
+PRJMP, PRJUMP
+COUNT1,        0
+LCREAT, 0
+       ISZ     L53     /INCREMENT BY ONE...
+       TAD     L53
+       AND     C77
+       TAD     CM33
+       SMA CLA         /HAVE WE BEEN HERE 26 TIMES?
+       TAD     C46     /YES, BUMP THE HIGH ORDER DIGIT
+       TAD     L53
+       DCA     L53     /AND SAVE
+       TAD     L53     /NOW RETURN IT IN AC
+       JMP I   LCREAT  /RETURN
+LPLAB, 0               /THIS PRINTS REGULAR LABELS
+       DCA     TMP     /FIRST SAVE LABEL
+       TAD     D34     /NOW PUNCH A '\'
+       JMS I   PRINT
+       TAD     TMP     /GET LABEL
+       JMS I   DECOUT  /AND PRINT IT
+       JMP I   LPLAB   /RETURN
+GETHI, LGETHI
+CDCA41,        DCA     L41
+CM33,  -33
+DECOUT,        LDCOUT
+
+/TELETYPE OUTPUT ROUTINE FOR ERROR MESSAGES
+LTTYPE,        0
+       TSF
+       JMP     .-1
+       TLS
+       CLA
+       JMP I   LTTYPE
+
+\f      *3400
+DORET, JMP I   XDO
+ISZDO, JMS I   PROP
+               6170    /ISZ
+       TAD     L30
+       JMS I   PRSYM
+       JMS I   PRINT
+       JMP     DOSUBT  /GO GENERATE THE LIMIT TEST
+NUMB,  0
+SWIT,  0
+DM5,   -5
+CM24,  -24
+C5001, 5001
+LEQI,  EQI
+
+LDO,   JMS I   ZZZ
+       JMS I   ENTITY  /LOOK FOR THE SCOPE LABEL
+C55,   55
+       SKP
+       JMP     SLAB    /WE GOT THE SCOPE LABEL
+E53,   53
+       JMP I ASSIGN
+SLAB,  TAD     L32     /GET THE INTEGER
+       JMS     XDO     /PUT OUT DO-LOOP CODE
+       JMP     START   /NORMAL EXIT
+       JMP     ERR35   /IMPLIED DO EXIT - ERROR
+
+XDO,   0               /DO LOOP SUBROUTINE - ENTERED WITH
+                       /TARGET LABEL IN AC
+       DCA I   L15     /PUT IN DO END PUSH DOWN LIST
+       TAD     L74
+       DCA     L16     /SET UP LIST OF DO ENDS
+       DCA     L21     /ZERO THE SYMBOL TABLE SWITCH
+       CMA CLA
+       DCA     SWIT    /SET SWITCH FOR CONTROL VARIABLE
+       TAD     DM5
+       DCA     NUMB    /SET COUNTER OF NUMBER OF PARAMETERS
+GETMOR, JMS I  ENTITY  /LOOK FOR A PARAMETER
+       JMP     .+3     /ERR
+       JMP     CVAR    /GOT A VARIABLE
+       JMP     DPAR    /GOT AN INTEGER
+C21,   21
+       JMP     ERR35
+CVAR,  JMS I   SYMTAB  /PUT SYMBOL IN TABLE
+       TAD     L77     /GET ADDRESS
+       JMS I   MODE    /DETERMINE MODE OF SYMBOL
+       JMP     ERR35
+       TAD     L77     /GET ADDRESS AGAIN
+DOSTOR,        DCA I   L16     /SAVE
+       ISZ     NUMB    /HAVE WE GOTTEN TOO MANY PARAMS
+       SKP             /NO
+ERR35, JMS I   LUNCH   /YES, DO ERROR ...
+       JMS I   GNB
+       SNA             /IS IT CR
+       JMP     ALLDNE+1        /YES WERE DONE
+       TAD     CM51
+       SNA             /IS IT A RIGHT PAREN?
+       JMP     ALLDNE  /YES-FINISH UP AND TAKE IMPLIED DO EXIT
+       TAD     CM24
+       SZA             /IS IT =
+       JMP     MCOM    /NO
+       ISZ     SWIT    /IS SWITCH SET FOR IT
+       JMP     ERR35   /NO
+       JMP     GETMOR  /YESS...GO BACK FOR ANOTHER PARAMETER
+MCOM,  TAD     C21     /CHECK FOR COMMA
+       ISZ     SWIT    /IF NO EQUAL SIGN YET
+       SZA             /OR IF THIS ISN'T A COMMA
+       JMP     ERR35   /THEN ITS AN ERROR
+       JMP     GETMOR  /GET ANOTHER
+DPAR,  TAD     L32     /GET THE INTEGER
+       ISZ     SWIT    /HAVE WE SEEN AN EQUAL SIGN?
+       JMP     DOSTOR  /YES - SAVE THE INTEGER AND PROCEED
+       JMP     ERR35   /NO
+ALLDNE,        ISZ     XDO     /BUMP RETURN POINTER IF TERMINATOR WAS RPAR
+       CLA IAC
+       DCA I   L16     /STORE A ONE IN THE FOURTH (OR FIFTH) ARGUMENT
+       TAD     C2
+       TAD     NUMB
+       SPA CLA         /DID WE GET AT LEAST THREE ARGS?
+       JMP     ERR35   /NO
+       ISZ     L44
+       TAD     L74     /GET ERASABLE LOCATIONS
+       DCA     L16     /USE THE AUTO INDEX REGISTERS
+       TAD I   L16     /GET CONTROL VARIABLE
+       DCA     L30     /AND PUT IN THIRTY
+       TAD I   L16     /GET INITIAL VALUE
+       DCA     L31     /AND SAVE IT
+       TAD I   L16     /GET FINAL VALUE
+       DCA     L32     /AND SAVE IT
+       TAD I   L16     /GET INCREMENT
+       DCA     L33     /AND SAVE IT
+       TAD     L74     /GET ADDR OF ERASABLE AGAIN
+       IAC             /INCREMENT ONCE
+       DCA     L41     /TELL TRIPL WHERE TO FIND THE DUMMY TRIPLES
+       TAD     L74     /GET IT AGAIN
+       DCA     L16     /USE AUTO INDEX TO STORE TRIPLE
+       DCA     L46     /ZERO THE AC
+       TAD     C5001   /SET UP INITIAL TRIPLE NUMBER
+       DCA     L40
+       TAD     L33
+       CIA
+       TAD     L31
+       SNA CLA         /IF INITIAL VALUE = STEP SIZE
+       JMP     STCTLV  /NO NEED TO COMPUTE THE DIFFERENCE
+       TAD     L33     /GET STEP SIZE
+       DCA I   L16     /PUT IN TRIPLE
+       TAD     C55     /PUT IN A MINUS SIGN
+       DCA I   L16
+       TAD     L31     /GET INITIAL VALUE
+       DCA I   L16
+       JMS I   TRIPL   /PROCESS THE TRIPLE
+STCTLV,        JMS I   LEQI    /STORE ANSWER IN CONTROL VARIABLE
+       JMS I   CLAB    /PUT A CDREATED LABVEL ON THE NEXT STATEMENT
+       TAD     L53     /GET THE CREATED LABEL
+       DCA I   L15     /AND PUT IN     DO END LIST
+       TAD     L74
+       DCA     L16
+       TAD     L33     /GET STEP SIZE
+       CLL RAR
+       SNA             /IF STEP SIZE=1 THEN
+       JMP     ISZDO   /WE CAN USE AN ISZ TO INCREMENT
+       RAL
+       DCA I   L16
+       TAD     E53     /WERE GOING TO ADD
+       DCA I   L16
+/      L30 IS IN THE THIRD POSITION SINCE WE CALLED "EQI"
+       JMS I   TRIPL   /ADD STEP SIZE TO CONTROL VARIABLE
+       JMS I   LEQI    /STORE ANSWER IN CONTROL VARIABLE
+DOSUBT,        TAD     L74
+       DCA     L16
+       TAD     L30     /GET THE CONTROL VARIABLE
+       DCA I   L16
+       TAD     C55     /WERE GOING TO SUBTRACT
+       DCA I   L16
+       TAD     L32     /GET FINAL VALUE
+       DCA I   L16
+       JMS I   TRIPL   /SUBTRACT CONTROL VARIABLE FROM FINAL VALUE
+\f      DCA     L46     /CLEAR THE AC FLAG
+       JMS I   PROP
+               6110    /SPA CLA
+       JMS I   PRINT
+       JMS I   PROP
+               6044    /PUT OUT A JMP
+       JMS I   CREATE  /TO A CREATED LABEL
+       DCA I   L15     /PUT CREATED LABEL IN DO END LIST
+       TAD     L53     /GET LABEL
+       JMS I   PRCRL   /AND PRINT IT
+       JMS I   PRINT   /CRLF
+       ISZ     L55     /INCREMENT UNENDED DO COUNTER
+       SKP
+ERR38, JMS I   LUNCH   /TOOO MANY UNENDED DOS
+       JMP I   .+1
+       DORET           /RETURN FROM SUBROUTINE "XDO"
+
+EQI,   0
+       TAD     L74
+       DCA     L16
+       TAD     L46     /GET RESULT OF PREVIOUS COMPUTATION
+       DCA I   L16
+       TAD     E75     /GET EQUALS SIGN
+       DCA I   L16
+       TAD     L30     /GET CONTROL VARAIBLE
+       DCA I   L16
+       JMS I   TRIPL   /PROCESS
+       DCA     L46     /WIPE AC SWITCH
+       JMP I   EQI     /RETURN
+LFUNCT,        0
+       DCA     ARGCNT
+       TAD     L46     /GET AC
+       SZA CLA         /IS IT ZERO
+       JMS I   STORE   /NO...STORE THE AC
+       TAD     L53     /GET CURRENT CREATED LABEL
+       DCA     L73     /AND SAVE
+       CLA CMA         /AC IS MINUS ONE
+       TAD     L41     /PUSH LIST POINTER
+       DCA     L42     /PUSH LIST POINTER MINUS ONE
+CKFNCT,        ISZ     L42     /INCREMENT POINTER
+       ISZ     L42     /AGAIN
+       TAD I   L42     /GET    THE OPERATOR
+       TAD     CM4047  /SUBTRACT THE FUNCTION OPERATOR
+       SZA             /IS THIS THE FUNCTION OPERATOR
+       JMP     CKSBSC  /NO
+       CLA IAC         /YES...THE FUNCTION NAME IS IN THE NEXT LOCATIO
+       TAD     L42     /THIS POINTS TO IT
+       DCA     SAVE    /AND SAVE
+       TAD I   SAVE
+       TAD     C2
+       DCA     EQI
+       TAD I   EQI
+       AND     CM2
+       IAC
+       DCA I   EQI
+MOR,   CLA CMA         /NOW EXAM THE ARGUMENTS
+       TAD     L42     /WERE POINTING TO THE FIRST ARGUMENT
+       DCA     L42     /SAVE THE POINTER
+       ISZ     ARGCNT
+       JMS I   LCHNG   /CHECK L42 FOR ZERO OR DUMMY ARG
+       DCA I   L42     /REPLACE IT BY UPDATED VALUE
+       TAD     L42     /IT WASNT...SEE IF IT WAS THE LAST ARGUMENT
+       CIA
+       TAD     L41     /SUBTRACT THE END OF ARGUMENT LIST
+       SNA CLA         /IS IT ZERO
+       JMP     OUT     /YES...WE'VE COMPLETED THIS PHASE
+       CLA CMA         /NO...MOVE THE POINTER BACK ONE
+       TAD     L42
+       DCA     L42     /AND SAVE
+       JMP     MOR     /NOW CHECK THE NEXT ARGUMENT
+OUT,   TAD     SAVE    /GET THE POINTER TO THE FUMCTION NAME AGAIN
+       DCA     L42     /AND PUT IN 42
+       TAD I   L42     /GET THE ARGUMENT
+       DCA     FUNOP   /USE FPROP TO PUT OUT THE CALL TO THE FUNCTION
+       TAD     ARGCNT  /GIVE FPROP THE NUMBER OF ARGUMENTS
+       JMS I   FPROP   /PUT OUT THE CALL TO THE FUNCTION
+FUNOP, 0
+       TAD     L73     /NOW RESTORE THE CREATED LABEL LOCATION
+       DCA     L53
+MNEXT, TAD     L42     /GET THE POINTER
+       TAD     CM2     /MOVE POINTER TO ARGUMENT
+       DCA     L42     /AND SAVE
+       TAD I   L42     /GET NEXT ARGUMENT
+       JMS I   PSYMOT  /GENERATE AN "ARG" FOR THE ARGUMENT
+       TAD     L42     /GET THE POINTER
+       CIA             /SET IT NEGATIVE
+       TAD     L41     /ADD
+       SZA CLA         /ARE THEY EQUAL
+       JMP     MNEXT   /NO THERE ARE MORE ARGS
+       TAD I   SAVE    /YES...GET THE FUNCTION NAME
+       JMS I   MODE    /WHAT MODE IS IT
+       TAD     E400    /ITS FLOATING POINT
+       TAD     L40     /ITS INTEGER
+       DCA     L46     /PUT THE TRIPLE NUMBER IN THE AC SWITCH
+       TAD     SAVE    /YES...CHANGE PUSH LIST POINTER
+       DCA     L41     /STORE POINTER TO NAME IN PUSH LIST POINTER
+       TAD     L46     /GET CURRENT TRIPLE NUMBER
+       DCA I   L41     /AND PUT IT IN THE PUSH LIST
+       JMP I   LFUNCT  /RETURN
+CKSBSC,        IAC
+       SZA CLA         /IS IT THE SUBSCRIPT OPERATOR?
+       JMP I   CKF     /NO - KEEP LOOKING
+       JMP I   .+1
+       ERR39
+PSYMOT,        SYMOUT
+SAVE,  0
+ARGCNT, 0
+E75,   75
+CM4047,        -4047
+E400,  400
+
+       TAD     C47
+       JMS I   PPACK
+LQUOTE,        JMS I   PGTC    /GET A CHARACTER
+       SNA
+ERR37, JMS I   LUNCH   /CARRIAGE RETURN - ERROR
+       TAD     CM47
+       SZA
+       JMP     LQUOTE-2        /IF NOT A QUOTE, STORE IT
+       JMP I   .+1
+       FRET
+C47,   47
+CM47,  -47
+PGTC,  LGTC
+PPACK, PACK
+CKF,   CKFND
+\f      *4000
+LCONT, JMS I   LOOK    /CHECK REST OF LINE
+               -4      /LOOK FOR FOUR CHARACTERS
+               -11     /I
+               -16     /N
+               -25     /U
+               -5      /E
+       JMS I   ZZZ
+       JMS I   PROP    /PUNCH 'NOP'
+               6047
+       JMS I   PRINT   /PUT OUT A CRLF
+       JMP     START   /GO GET NEXT STATEMENT
+
+LPAUSE,        JMS I   LOOK    /CHECK REST OF STATEMENT TYPE
+               -1      /JUST ONE CHARACTER
+               -5      /E
+       CLA CMA
+LSTOP, DCA     SW      /SET SWITCH FOR STOP OR PAUSE
+       DCA     L32
+       JMS I   ENTITY  /LOOK FOR THE OPTIONAL INTEGER
+       JMP     MCR     /WE GOT A CR
+       SKP             /ERR
+       JMP     .+3     /WE GOT AN INTEGER
+       NOP             /ERR
+       JMP I ASSIGN
+
+MCR,   JMS I ZZZ
+       ISZ     SW      /PAUSE OR STOP?
+       JMP     STOP
+       JMS I   FPROP   /PUNCH 'CALL 0,CKIO'
+       6116
+       JMS I   PROP    /PRINT OP CODE
+               6066    /OPCODE IS TAD
+       TAD     L32     /GET THE INTEGER
+       JMS I   PRSYM   /PRINT IT
+       JMS I   PRINT   /CR
+       JMS I   PROP
+               6121
+       JMS I   PRINT
+       JMS I   PROP
+               6124
+       JMS I   PRINT   /PUT OUT CRLF
+       JMP     START   /GO GET NEXT STATEMENT
+
+STOP,  JMS     OSTOP
+       JMP     START
+
+OSTOP, 0               /PUNCH 'CALL 0,CKIO'
+       JMS I   FPROP
+               6116
+       JMS I   CLAB    /PUNCH '<LAB>, HLT'
+       JMS I   PROP
+               6121
+       JMS I   PRINT
+       JMS I   PROP    /PUNCH 'JMP <LAB>'
+               6044
+       TAD     L53
+       JMS I   PRCRL
+       JMS I   PRINT
+       JMP I   OSTOP
+
+SW,    0
+LFRMAT, JMS I  LOOK    /CHECK REST OF STATEMENT TYPE
+               -2      /TWO CHARACTERS
+               -1      /A
+               -24     /T
+       ISZ     OSTOP
+       TAD     L74
+       DCA     L10
+       DCA     L76
+       JMS I PROP
+       6044
+       JMS I CREATE
+       JMS I PRCRL
+       JMS I PRINT
+       JMS I   GNB     /READ UNTIL A PAREN IS GOTTEN
+       TAD     CM50    /SUBTRACT A (
+       SZA CLA         /IS IT A (
+ERR39, JMS I   LUNCH   /NO...ILLEGAL CHARACTER
+       TAD     C50     /GET A LEFT PAREN
+       JMP     PAREN   /AND GO START COUNTING PARENS
+AGAIN, JMS I   GTC
+       SNA             /IS IT A CR
+       JMS I   PUTCH   
+PAREN, RTL CLL         /SHIF CHAR LEFT
+       RTL
+       RTL
+       DCA     L32     /SAVE THE CHAR
+       JMS I   GTC
+       SNA             /IS IT A CR
+       DCA     OSTOP
+       TAD     L32     /PACK THE TWO CHARS (SOME DONE AT FRMTCK)
+       JMP I   FRMTCK  /GO CHECK IF FORMAT STMT. TOO BIG
+FRMT,  TAD     OSTOP   /GET BALANCED PAREN SWITCH
+       SZA CLA         /ARE THEY BALANCED
+       JMP     AGAIN   /NO GET SOME MORE CHARS
+       TAD     L76
+       JMS I   PIFF
+       TAD     L74
+       DCA     L10
+       TAD     L76
+       CIA
+       DCA     L76
+       JMS I   ZZZ
+       TAD I   L10
+       JMS I   PROTAC
+       JMS I   PRINT
+       ISZ     L76
+       JMP     .-4
+       TAD     L53     /PUNCH '<LABEL>,'
+       JMS I   CLAB
+       JMS I   PRINT
+       JMP     START
+GTC,   LGTC
+PXSUBR,        XXSUBR
+C50,   50
+
+LPIFF, 0               /PUNCH 'IFF <N>'
+       DCA     LZZZ    /ENTER WITH N IN THE AC
+       JMS I   PROP
+               6102
+       TAD     LZZZ
+       JMS I   PROTAC
+       JMS I   PRINT
+       JMP I   LPIFF
+
+LZZZ,  0               /PUNCH THE CURRENT LABEL, IF ANY
+       TAD     L54
+       SNA             /IS THERE A LABEL?
+       JMP     ZZZRET  /NO
+       JMS I   PLAB    /PUNCH '<LABEL>, '
+       TAD     C7240
+       JMS I   P2
+ZZZRET,        DCA I   PXSUBR  /MAKE SUBROUTINES AND FUNCTIONS ILLEGAL
+       JMP I   LZZZ
+FRMTCK,        CKFRMT
+\f      *4200
+LTRIPL,        0
+       JMS I   XZQL    /FIRST CHECK IF A TRIPLE IS LEGAL HERE
+       TAD     L41     /GET PUSH LIST POINTER
+       IAC             /INCREMENT TO POINT TO OPERATOR
+       DCA     L42     /OPERATOR POINTER
+       TAD     L42     /GET IT AGAIN
+       IAC             /INCREMENT IT
+       DCA     L43     /OPERAND TWO POINTER
+       TAD I   L42     /GET OPERATOR
+       AND     C77     /MASK GARBAGE BITS
+       TAD     CM41    /SUBTRACT AN ADD INDIRECT OPERATOR
+       SNA CLA         /IS OPERATOR  <DOLLAR>
+       JMP I   LADDIN  /YES PROCESS IT
+       TAD I   L43     /NO...GET OPERAND TWO
+       JMS I   DUMARG  /SEE IF ITS A DUMMY ARGUMENT
+       SKP             /YES IT IS
+       JMP     CK2     /NO ..CHECK THE OTHER ARGUMENT
+       TAD I   L42     /YES    GET THE OPERATOR
+       AND     C77     /MASK GARBAGE BITS
+       TAD     EM75    /IS IT AN EQUALS SIGN
+       SNA             /IS OP C
+       JMP     LEQUIN  /YES USE C*
+       IAC             /SEE IF ITS ALREADY EQUALS INDIRECT
+       SZA CLA         /IS OP C*
+       JMS I   LDUMTW  /YES TWO IS DUMMY ARG
+CK2,   CLA
+       TAD I   L41     /NO IS OPND ONE A SYMBOL
+       JMS I   DUMARG  /SEE IF ITS A DUMMY ARGUMENT
+       JMS I   LDUMON  /IT IS
+       CLA CLL         /NOW LETS SEE WHAT THE OPERATOR IS
+       TAD I   L42     /GET THE OPERATOR
+       AND     C77     /MASK OUT GARBAGE BITS
+       TAD     CM53
+       SNA             /IS IT  
+       JMP I   LAADD   /YES
+       IAC
+       SNA             /IS IT *
+       JMP I   LMUL    /YES
+       TAD     CM3
+       SNA             /IS IT -
+       JMP I   LASUB   /YES
+       TAD     CM2
+       SNA             /IS IT /
+       JMP I   LDIV    /YES
+       TAD     CM16
+       SNA             /IS IT C
+       JMP I   LEQU    /YES
+       IAC
+       SNA             /IS IT C*
+       JMP I   LEIND   /YES
+       TAD     J27
+       SNA             /IS IT **
+       JMP I   LEXP    /YES
+       TAD     C2
+       SNA             /IS IT A UNARY MINUS
+       JMP I   LUMIN   /YES
+ERR40, JMS I   LUNCH   /NO BETTER COP OUT
+LDMARG, 0
+       SMA             /IS HIGH ORDER BIT ON
+       JMP     INC     /NO...ITS NEITHER A SYMBOL OR A TRIPLE NUMBER
+       RAL             /GET NEXT BIT
+       SMA             /IS IT ON
+       JMP     MAYBE   /NO...WE MIGHT HAVE A SUBSCRIPT THOUGH
+       RAR             /YES...RESTOR THE PARAMETER
+       CIA             /SET IT NEGATIVE
+       TAD     L47     /SUBTRACT IT FROMTHE START OF THE FCON TABLE
+       SPA             /IS THE RELULT POSITIVE
+       JMP     INC     /NO...ITS AN FCON NOT A SYMBOL
+       CIA             /YESS...RESTORE ORIGINAL PARAMETER
+       TAD     L47
+       TAD     C2      /YES    MOVE POINTER TO CONTROL BITS
+       DCA     L23     /SAVE
+       TAD I   L23     /GET THE CONTROL BITS
+       AND     C10     /MASK ALL BUT DUMMY ARG BIT OUT
+INC1,  SNA CLA         /IS THIS SYMBOL. A DUMMY ARG
+INC,   ISZ     LDMARG  /NO...INCREMENT THE RETURN
+       CLA             /CLEAR THE ACCUMULATOR
+       JMP I   LDMARG  /AND RETURN
+MAYBE, AND     F400    /MASK THE SUBSCRIPT BIT OF THE TRIPLE NUMBER
+       JMP INC1        /AND CHECK BECAUSE WE TREAT SUBSCS AS DUMMY ARG
+ARET,  JMP I   LTRIPL  /THIS IS THE RETURN FROM TRIPLE
+
+LEQUIN,        TAD     C74
+       DCA I   L42     /SET OP TO =*
+       JMP     CK2
+C74,   74
+/
+/      THIS ROUTINE CHECKS THE REST OF THE CHARS FOR A STATEMENT
+LLOOK, 0
+       JMS     GLOOK   /GET CHARACTER COUNT
+       DCA     LTRIPL
+ABACK, JMS I   GNB
+       JMS     GLOOK   /ADD IN THE TEST CHAR
+       SZA CLA         /WERE THEY EQUAL
+       JMP I   ASSIGN  /NO...IT MUST BE AN ASSIGNMENT STATEMENT
+       ISZ     LTRIPL  /THEY MATCH...ARE WE DONE
+       JMP     ABACK   /NO
+       JMP I   LLOOK   /RETURN
+
+GLOOK, 0
+       CDF 10
+       TAD I   LLOOK
+       ISZ     LLOOK
+       CDF 00
+       JMP I   GLOOK
+/
+LAADD, AADD
+LADDIN,        ADDIND
+LASUB, ASUB
+LEQU,  EQU
+LEIND, EIND
+LEXP,  EXP
+LUMIN, UMIN
+CM41,  -41
+EM75,  -75
+LDUMTW,        DUMTWO
+CM16,  -16
+C10,   10
+F400,  400
+LDUMON,        DUMONE
+CM53,  -53
+LMUL,  MUL
+LDIV,  DIV
+XZQL,  LXZQ
+J27,   27
+
+CKFND, TAD     L42     /SEE IF POINTER IS INTO SYMB. TABLE
+       TAD     K2000   /(IT HAS HAPPENED!)
+       SZA     CLA
+       JMP I   CKFNCP
+       JMP I   .+1     /YES-ERROR
+       ERR39
+CKFNCP,        CKFNCT
+K2000, 2000
+\f      *4400
+ /     FIGURE OUT WHATS IN AC
+LCHECK,        0
+       TAD     L46     /GET WHATS IN THE AC
+       CIA             /SET NEGATIVE
+       TAD I   L41     /SUBTRACT
+       SNA CLA         /ARE THEY EQUAL
+       JMP     ONE     /YES
+       TAD     L46     /GET AC AGAIN
+       CIA             /SET NEGATIVE
+       TAD I   L43     /SUBTRACT TWO
+       SNA CLA         /ARE THEY EQUAL
+       JMP     TWO     /YES
+       TAD     L46     /GET THE AC
+       SNA CLA         /IS IT ZERO
+       JMP     NONE    /NO     YES YES YES
+       JMP     SOME    /JUST SIMETHING IN AC
+ONE,   ISZ     LCHECK
+NONE,  ISZ     LCHECK
+SOME,  ISZ     LCHECK
+TWO,   JMP I   LCHECK
+
+/      FINDS TEMPORARY THAT TRIPLE NUMBER IS ASSIGNED TO
+
+LTMPOR,        0
+       DCA     LFPROP  /SAVE TRIPLE NUMBER
+       TAD     LFPROP
+       JMS I   MODE    /DETERMINE ITS MODE
+       TAD     C30     /FLOATING POINT
+       TAD     TTAB    /INTEGER
+       DCA     LCHECK
+       TAD     CM30
+       DCA     FOP     /SET UP COUNT FOR SEARCH
+LTLP1, TAD I   LCHECK
+       CIA
+       TAD     LFPROP
+       SNA CLA         /IS THIS THE ONE?
+       JMP     ZEROIT  /YES - ZERO IT OUT AND RETURN IT
+       ISZ     LCHECK
+       ISZ     FOP
+       JMP     LTLP1   /LOOP OVER ENTIRE TABLE
+       TAD     LCHECK  /NOT FOUND - WE HAVE TO ASSIGN IT
+       TAD     CM30
+       DCA     LCHECK  /RESET POINTERS FOR ZERO SEARCH
+       TAD     CM30
+       DCA     FOP
+LTLP2, TAD I   LCHECK
+       SNA CLA         /IS THIS TEMPORARY FREE?
+       JMP     TEMPTY  /YES
+       ISZ     LCHECK
+       ISZ     FOP
+       JMP     LTLP2   /CHECK THEM ALL
+ERR41, JMS I   LUNCH   /OUT OF TEMPORARIES
+TEMPTY,        TAD     LCHECK
+       CIA
+       TAD     L45
+       SNA CLA         /ADJUST THE NUMBER OF FLOATING POINT TEMPS
+       ISZ     L45
+       TAD     LCHECK
+       CIA
+       TAD     L51
+       SNA CLA         /ADJUST THE NUMBER OF INTEGER TEMPS
+       ISZ     L51
+       TAD     LFPROP  /STORE TRIPLE NUMBER IN THIS TEMPORARY SLOT
+ZEROIT,        DCA I   LCHECK
+       TAD     FOP
+       TAD     C31     /GET POSITIVE NUMBER FROM TABLE COUNTER
+       JMP I   LTMPOR  /RETURN
+C31,   31
+
+LFPROP,        0               /THIS ROUTINE PUNCHES SUBROUTINE CALLS
+       DCA     FOP     /SAVE THE NUMBER OF ARGUMENTS
+       JMS I   PROP
+               6113    /PUT OUT THE CALL
+       TAD     FOP     /GET THE NUMBER OF ARGUMENTS
+       JMS I   PROTAC  /PRINT IT
+       TAD     C54     /GET A COMMA
+       JMS I   PRINT   /PRINT IT
+       CDF 10
+       TAD I   LFPROP
+       CDF 00
+       JMS I   PRSYM
+       JMS I   PRINT
+       ISZ     LFPROP  /INCREMENT RETURN
+       JMP I   LFPROP  /RETURN
+FOP,   0
+/      COME HERE IF OP IS -
+ASUB,  JMS I   SMODE   /MAKE SURE THAT BOTH ARGS ARE OF SAME MODE
+       TAD I   L43     /GET OPERAND TWO
+       JMS I   MODE
+       JMP     FSUB    /ITS FLOATING POINT
+       JMS     LCHECK  /ITS INTEGER...CHECK WHATS IN THE AC
+       JMP     STWO    /TWO IS IN THE AC
+       JMS I   STORE   /SMETHING IS IN THE AC
+       JMS I   LADDON  /NOTHING IS IN THE AC...ADD ONE TO IT
+ASBCMN,        JMS I   LCOMP   /ONE IS IN AC...COMPLEMENT IT
+       JMS I   LADDTW  /ADD TWO TO IT
+       JMP I   LRETUR  /AND RETURN
+STWO,  JMS I   LCOMP   /TWO IS IN AC...COMPLEMENT IT
+       JMS I   LADDON  /ADD ONE TO IT
+       JMS I   LCOMP   /AND COMPLEMENT IT AGAIN
+       JMP I   LRETUR  /AND RETURN
+FSUB,  JMS     LCHECK  /FLOATING POINT...CHECK THE AC
+       JMP     FS      /TWO IS IN AC
+       JMS I   STORE   /SOMETHING IN AC...STORE IT
+       JMP     FAS     /NOTHING IN AC
+       JMP     ASBCMN  /ONE IS IN AC - COMPLEMENT AND ADD TWO
+FAS,   JMS I   LADDTW  /NOTHING IN AC...ADD TWO IN
+FS,    IAC             /WE HAVE ONE ARG
+       JMS I   FPROP
+               6011
+       JMS I   ARG     /PUT OUT THE ARG PSEUDO OP
+       TAD I   L41     /GET ARGUMENT ONE
+IRET,  JMS I   PRSYM   /AND PUT IT OUT
+       JMS I   PRINT   /PUT OUT CRLF
+       JMP I   LRETUR
+TTAB,  ITTAB           /THIS IS THE STARTING ADDRESS OF THE TEMP TABLE
+LCOMP, COMP
+LADDON,        ADDONE
+C30,   30
+CM30,  -30
+LRETUR,        RETURN
+LADDTW,        ADDTWO
+
+/CHECK SIZE OF FORMAT STMT.
+/
+CKFRMT,        DCA I   L10     /CONTINUE PACK ROUTINE
+       ISZ     L76
+       TAD     L76
+       TAD     M174    /IS IT TOO BIG
+       SMA     CLA
+       JMP I   ILCON   /YES-GIVE IT ILLEGAL CONT. MESSAGE
+       JMP I   LFRMT   /NO-GO BACK
+LFRMT, FRMT
+M174,  -174
+ILCON, ERR1            /ILLEGAL CONTINUATION MESSAGE
+\f      *4600
+/      PROCESS  *
+ADDIND, JMS I  CHECK   /CHECK WHATS IN THE AC
+       NOP             /TWO IS IN AC
+       SKP             /N SOMETHING IS IN AC
+       SKP             /NOTHING IS IN AC
+       JMS I   STORE   /STORE WHATEVER IS IN AC
+       TAD I   L41     /GET OPERAND ONE
+       JMS I   MODE    /WHAT MODE IS IT
+       JMP     FLOT    /YES    IT FLOATING POINT
+       JMS I   PROP    /IST INTEGER...
+               6063    /PUT OUT A TAD*
+LOOP6, TAD I   L41     /GET THE FIRST OPERAND AGAIN
+       JMP I   LIRET   /GO TO THE RETURN ROUTINE
+FLOT,  IAC             /WE ONLY HAVE ONE ARG
+       JMS I   FPROP   /PUT OUT A CALL TO A FLOATING POINT ROUTINE
+               6132    /PUT OUT A CALL TO FLOATING INDIRECT ADD
+       JMS I   ARG     /PUT OUT THE ARG PSEUDO OP
+       JMP     LOOP6   /AND JUMP BACK
+/      THIS PUTS OUT OPCODES FOR AN ADD
+ADDL,  0
+       CLL RAR
+       SNA             /TEST FOR 0 OR 1
+       JMP     ADSPCL
+       RAL             /NOT 0 OR 1, TREAT NORMALLY
+       JMS I   MODE    /WHAT MODE ARE WE IN
+       JMP     LOOP7   /YES
+       JMS I   PROP    /PUT OUT A TAD
+               6066
+       JMP I   ADDL    /RETURN
+LOOP7, IAC             /WE ONLY HAVE ONE ARGUMENT
+       JMS I   FPROP   /PUT OUT A CALL TO A FLOATING POINT ROUTINE
+               6003    /PUT OUT A FLOATING ADD
+       JMS I   ARG     /PUT OUT THE ARG PSEUDO OP
+       JMP I   ADDL    /AND RETURN
+ADSPCL,        ISZ     ADDL
+       ISZ     ADDL    /BUMP RETURN POINT PAST ARGUMENT TO "TAD"
+       SNL             /0?
+       JMP I   ADDL    /YUP - DON'T PUT OUT NUTTIN
+       JMS I   PROP
+       OPIAC           /PUT OUT "IAC"
+       JMP I   ADDL
+
+/      STORES CONTENTS OF AC IN TEMPORARY
+/      PUT OUT DCA OR CALL STO
+/      FOLLOWED BY THE TEMPORARY LOC
+LSTORE,        0
+       TAD     L46     /GET THE AC
+       JMS I   MODE    /WHAT MODE IS IT
+       JMP     FSTO    /ITS FLOATING POINT
+       JMS I   PROP
+               6071    /ITS INTEGER...PUT OUT A DCA
+STORET, TAD    L46     /GET THE AC AGAIN
+       JMS I   PRSYM   /PRINT WHATEVER IS IN IT
+       JMS I   PRINT   /PUT OUT A CRLF
+       DCA     L46     /ZERO THE AC
+       JMP I   LSTORE  /AND RETURN
+FSTO,  IAC             /WE ONLY HAVE ONE ARG
+       JMS I   FPROP   /PUT OUT A CALL TO A FLOATING POINT ROUTINE
+               6006    /PUT OUT A CALL TOFLOATING STORE
+       JMS I   ARG     /PUT OUT THE ARG PSEUDO OP
+       JMP     STORET  /AND JMP BACK
+COMP,  0
+       TAD     L46     /GET THE AC
+       JMS I   MODE    /WHAT MODE IS IT
+       JMP     FCOM    /ITS FLOATING POINT
+       JMS I   PROP    /ITS INYTEGER
+               6135    /PUT OUT A CIA
+       JMS I   PRINT   /PUT OUT A CRLF
+       JMP I   COMP    /AND RETURN
+FCOM,  JMS I   FPROP
+               6140    /TO FLOATING CHANGE SIGN
+       JMP I   COMP
+/      COME HERE IF OP IS *
+MUL,   JMS I   SMODE   /CHECK FOR SAME MODE
+       JMS I   CHECK   /CHECK WHATS IN THE AC
+       JMP     TMUL    /TWO IS IN THE AC
+       JMS I   STORE   /SOMETHING IS IN AC...STORE IT
+       JMS I   KADDON  /NOTHING IS IN AC..GET ONE IN AC
+AMUL,  TAD I   L43     /GET OPERND TWO
+       JMS I   MODE    /WHAT MODE IS IT
+       TAD     EM6
+       TAD     C6022
+       DCA     FML     /SAVE OPCODE
+       IAC
+       JMS I   FPROP   /PUT OUT A CALL TO A FLOATING POINT ROUTINE
+FML,           0
+       JMS I   ARG     /PUT OUT THE ARG PSEUDO OP
+       TAD I   L43     /GET OPERAND TWO
+       JMP I   LIRET   /AND GO TO THE RETURN ROUTINE
+TMUL,  TAD I   L41     /GET OPERAND ONE AND REPLACE OPERAND TWO
+       DCA I   L43
+       JMP     AMUL    /AND JUMP BACK
+KADDON,        ADDONE
+LIRET, IRET
+EM6,   -6
+C6022, 6022
+
+LSUB,  JMS I   LOOK    /CHECK REST OF STATEMENT
+       -6      /
+       -17     /O
+       -25     /U
+       -24     /T
+       -11     /I
+       -16     /N
+       -5      /E
+       JMP I   .+1
+       TART
+
+LCLEAR,        0               /CLEAR THE PSEUDO ACC AND MQ
+       DCA     L30
+       DCA     L31
+       DCA     L32
+       DCA     L33
+       DCA     L34
+       DCA     L35
+       JMP I   LCLEAR
+       *5000
+/      THIS ROUTINE TAKES CARE OF TWO BEING DUMMY ARG
+DUMTWO, 0
+       TAD I   L41     /GET OPND ONE
+       DCA     FDV     /AND SAVE
+       TAD I   L43     /GET OPND TWO
+       DCA I   L41     /ZERO OPND ONE
+       JMS     DUMONE  /PROCESS DUMMY ARGUMENT
+       TAD     FDV     /GET SAVED OPERAND
+       DCA I   L41     /AND USE AS OPERAND
+       TAD     L46     /GET TRIPLE NUMBER
+       DCA I   L43     /AND REPLACE
+       JMP I   DUMTWO  /RETURN
+/      TAKES CARE OF ONE BIING DUMMY ARG
+DUMONE, 0
+       TAD I   L42     /GET OPERATOR
+       DCA     ASTOP   /AND SAVE
+       TAD     E41     /GET ADD INDIRECT OPERATOR
+       DCA I   L42     /AND REPLACE OPERATOR
+       CDF 10
+       TAD I   TRIPL
+       CDF 00
+       DCA     FEX     /AND SAVE RETURN
+       JMS I   TRIPL   /CALL TRIPL
+       TAD     L46     /GET TRIPLE NUMBER
+       DCA I   L41     /AND REPLACE OPERAND
+       TAD     ASTOP   /RESTORE OPERATOR
+       DCA I   L42
+       ISZ     L40     /ADVANCE TRIPLE
+       TAD     FEX     /RESTORE RETURN
+       CDF 10
+       DCA I   TRIPL
+       CDF 00
+       JMP I   DUMONE  /RETURN
+/      COME HERE IF OP IS /
+DIV,   JMS I   SMODE   /CHECK FOR SAME MODE
+       JMS I   CHECK   /CHECK WHATS IN THE AC
+       JMP     DIVE    /TWO IS IN AC
+\f      JMS I   STORE   /THERES SOMETHING IN THE AC...STORE IT
+       SKP             /NOTHING IS IN AC
+       JMS I   STORE   /THERES SOMETHING IN THE AC...STORE IT
+       JMS I   MADDTW  /GET TWO INTO THE AC
+DIVE,  TAD I   L41     /GET OPERAND ONE
+       JMS I   MODE    /WHAT MODE IS IT
+       TAD     FM6
+       TAD     C6025
+       DCA     FDV     /SAVE OERATOR
+       IAC
+       JMS I   FPROP   /PUT OUT A CALL TO A FLOATING POINT ROUTINE
+FDV,           0
+       JMS I   ARG     /PUT OUT THE ARG PSEUDO OP
+       TAD I   L41     /GET OPERAND ONE
+       JMP I   MIRET   /JUMP TO RETURN ROUTINE
+/      COME HERE IF OP IS **
+EXP,   JMS I   CHECK   /CHECK WHATS IN THE AC
+       JMP     FEXP    /TWO IS IN AC
+       JMS I   STORE   /THERES SOMETHING IN THE AC...STORE IT
+       SKP             /NOW NOTHING IS IN AC
+       JMS I   STORE   /THERES SOMETHING IN THE AC...STORE IT
+       JMS I   MADDTW  /GET TWO IN AC
+FEXP,  TAD I   L41
+       JMS I   MODE
+       TAD     C6
+       DCA     FDV
+       TAD I   L43     /GET OPERAND TWO
+       JMS I   MODE    /WHAT IS ITS    MODE
+       TAD     C3      /FLOATING POINT
+       TAD     C6207   /INTEGER
+       TAD     FDV
+       DCA     FEX     /SAVE REOUTINE POINTER
+       IAC
+       JMS I   FPROP   /PUT OUT A CALL TO A FLOATING POINT ROUTINE
+FEX,           0
+       TAD I   L41     /GET OPERAND ONE
+       DCA I   L43     /SAVE IN OPERAND TWO
+       TAD     FEX     /GET THE OP CODE JUST PUT OUT
+       TAD     CM6207  /SUBTRACT THE INTEGER TO INTEGER CASE
+       SZA CLA         /WAS THIS THE INTEGER INTEGER CASE
+       TAD     L50     /NO, GET A FLOATING POINT POINTER
+       DCA I   L41     /AND SUBSTITUTE IT FOR OPERAND ONE
+       JMS I   ARG     /PUT OUT THE PSEUDO OP ARG
+\f      TAD I   L43     /GET THE REAL OPERAND ONE IN THE AC
+       JMP I   MIRET   /JUMP TO THE RETURN ROUTINE
+/COMES HERE IF THE VARIABLE TO THE LEFT OF THE '=' IS SUBSCRIPTED
+EIND,  TAD     C132    /GET AN ASTERISK
+       DCA     L60     /PUT IT IN SIXTY
+/COMES HERE IF THE OPERATOR IS AN '='
+EQU,   JMS I   CHECK   /CHECK WHATS IN THE AC
+       NOP             /TWO IS IN THE AC
+       JMS I   STORE   /THERES SOMETHING IN THE AC...STORE IT
+       JMS I   TADDON  /NOTHING IS IN AC...ADD ONE TO IT
+       TAD I   L43     /GET OPERA ND TWO
+       JMS I   MODE    /WHAT IS ITS MODE
+       JMP     FEQU    /ITS FLOATING POINT
+       TAD     L46     /GET THE AC
+       JMS I   MODE    /WHAT MODE IS IT
+       JMP I   LFIX    /ITS FLOATING POINT
+EFIX,  TAD     L60     /GET EQUALS INDIRECT LOCATION
+       TAD     C6071   /ADD A DCA
+       DCA     ASTOP   /AND SAVE OPCODE
+       JMS I   PROP    /POT OUT THE OPCODE
+ASTOP,         3
+EQRET, DCA     L46     /ZERO THE AC
+       TAD I   L43     /GET OPERAND TWO
+       JMS I   PRSYM   /PRINT IT
+       JMS I   PRINT   /PUT OUT A CRLF
+       DCA     L60     /ZERO SIXTY
+       JMP I   .+1     /AND RETURN
+       ARET
+FEQU,  TAD     L46     /GET THE AC
+       JMS I   MODE    /WHAT MODE IS IT
+       SKP             /ITS FLOATING POINT
+       JMS I   LFLOAT  /ITS INTEGER...FLOAT IT
+       JMP I   .+1
+       XXX
+
+LARG,  0
+       JMS I   PROP
+               6201
+       JMP I   LARG
+
+TADDON,        ADDONE
+E41,   41
+MADDTW,        ADDTWO
+FM6,   -6
+C6025, 6025
+MIRET, IRET
+C6,    6
+C6207, 6207
+LFIX,  FIX
+C6071, 6071
+LFLOAT,        FLOAT
+CM6207,        -6207
+C132,  132
+\f      *5200
+XXX,   TAD     L60     /GET THE INDIRECT EQUALS SWITCH
+       SNA CLA         /IS THE SWITCH ON
+       TAD     CM140   /NO, FLOATING POINT STORE
+       TAD     C6146   /YES...ISTO
+       DCA     FSTOP   /SAVE OPCODE
+       IAC             /WE ONLY HAVE ONE ARG
+       JMS I   FPROP   /PUT OUT A CALL TO A FLOATING POINT ROUTINE
+FSTOP,         6146
+       JMS I   ARG     /PUT OUT THE ARG PSEUDO OP
+       JMP I   .+1     /JUMP BACK
+       EQRET
+/      THIS ADDS OPERAND ONE TO THE AC
+ADDONE, 0
+       TAD I   L41     /GET OPERAND ONE
+       JMS I   LADDL   /PUT OUT OPCODES FOR AN ADD
+       TAD I   L41     /GET FIRST OPERAND
+       JMS I   PRSYM   /PUT OUT SYMBOL
+       JMS I   PRINT   /PUT OUT CR LF
+       TAD I   L41     /GET OPERAND ONE
+       DCA     L46     /PUTN THE AC
+       JMP I   ADDONE  /RETURN
+UMIN,  JMS I   CHECK   /CHECK WHATSN THE AC
+       NOP                             /TWOSN AC
+       JMS I   STORE   /THERES SOMETHINGN THE AC...STORET
+       JMS     ADDONE  /NOTHINGSN AC NOW...PUT ONEN AC
+       JMS I   MCOMP   /AND COMPLEMENTT
+       JMP     RETURN  /AND RETURN
+AADD,  JMS I   SMODE
+       JMS I   CHECK   /CHECK WHATSN THE AC
+       JMP     AONE    /TWOSN AC
+       JMS I   STORE   /THERES SOMETHINGN THE AC...STORET
+       JMS     ADDONE  /GET ONEN AC
+       JMS     ADDTWO  /ONESN AC
+       JMP     RETURN  /RETURN
+AONE,  JMS     ADDONE  /ADD ONE TO TWO
+       JMP     RETURN  /AND RETURN
+LPROP, 0
+       CDF 10
+       TAD I   LPROP
+       CDF 00
+       JMS I   PRSYM   /AND PRINT THE SYMBOL
+       TAD     C40     /GET A SPACE
+       JMS I   PRINT   /PUT OUT
+       ISZ     LPROP   /INCREMENT RETURN
+       JMP I   LPROP   /AND RETURN
+/      THIS ADDS OPERAND TWO TO THE AC
+ADDTWO, 0
+       TAD I   L43     /GET OPERAND TWO
+       JMS I   LADDL   /PUT OUT OPCODES FOR AN ADD
+       TAD I   L43     /GET SECOND OPERAND
+       JMS I   PRSYM   /PRINT THE SYMBOL
+       JMS I   PRINT   /PUT OUT CR LF
+       TAD I   L43     /GET OPERAND TWO
+       DCA     L46     /AND PUTN AC
+       JMP I   ADDTWO  /RETURN
+LXZQ,  0               /CHECK FOR EXPRESSION LEFT OF =
+       CLA
+       TAD     L22     /GET SUBSCRIPT NESTING DEPTH
+       TAD     L44     /GET EQUALS SIGN SWITCH
+       SNA CLA         /ARE THEY BOTH ZERO
+ERR42, JMS I   LUNCH   /N      YES ...THATS AN ERROR
+       JMP I   LXZQ    /RETURN
+RETURN, TAD I  L41     /THISS THE RETURN...GET OPERAND ONE
+       JMS I   MODE    /WHAT MODEST
+       TAD     G400    /ITS FLOATING POINT...TURN F.P. BIT ON
+       TAD     L40     /ADD CURRENT TRIPLE NUMBER
+       DCA     L46     /PUTN AC SW
+       JMP I   NARET   /AND NOW RETURN FROM THE ROUTINE
+FLOAT, 0
+       JMS I   FPROP   /PUT OUT A CAL TO THE FLOAT ROUTINE
+               6127
+       JMP I   FLOAT   /AND RETURN
+FIX,   JMS I   FPROP   /PUT OUT A CAL
+               6143    /TO THE FIX ROUTINE
+       JMP I   .+1     /AND JUMP BACKLADDL,    ADDL
+       EFIX
+C6146, 6146
+LADDL, ADDL
+MCOMP, COMP
+G400,  400
+NARET, ARET
+LSMODE,        0
+       TAD I   L43     /GET FIRST OPERAND
+       JMS I   MODE    /FIND WHAT ITS MODE IS
+       JMP     IBM     /ITS FLOATING POINT
+       TAD I   L41     /GET OPERAND TWO
+       JMS I   MODE    /THIS BETTER BE INTEGER TOO
+       JMP     .+5     /ITS NOT, LUNCH
+       JMP I   LSMODE  /GREAT, RETURN
+IBM,   TAD I   L41     /GET OPERAND TWO
+       JMS I   MODE    /THIS BETTER BE F.P. TOO
+       JMP I   LSMODE  /IT IS RETURN
+ERR43, JMS I   LUNCH   /ERROR
+LPUNCH,        0
+       PSF             /IS PUNCH READY
+       JMP     .-1     /NO, TRY AGAIN
+       PLS             /YES, PUNCH THE CHARACTER
+       CLA             /CLEAR THE ACCUMULATOR
+       JMP I   LPUNCH  /AND RETURN
+CM140, -140
+
+LFINI, 0               /FINAL CLEANUP AT END OF COMPILATION
+       JMS I   FPROP   /PUNCH 'CALL 0,OPEN'
+               OPEN
+       JMS I   PROP    /PUNCH A 'PAUSE'
+               6060
+       JMS I   PRINT
+       JMS I   PRINT   /FORCE LAST LINE OUT
+       TAD     CM100
+       JMS I   LEADR   /PUNCH SOME LEADER
+       CDF     10
+XFINI, HLT             /JMP I LFINI, FOR DISK SYSTEM ...
+       CIF     0
+       JMP I   D1000   /BEGIN NEXT COMPILATION
+D1000, 1000
+CM100, -100
+LEADR, LLEAD
+
+FORST, JMS I   PRINT   /FORTRAN STARTING POINT
+       JMS I   (LIST
+       DCA     .-1
+       TAD     (LPUNCH
+       DCA     PUNCH
+       TAD     CM50
+       JMS I   LEADR
+       JMS I   PROP
+               FORTR
+       JMS I   PRINT
+       JMP I   .+1
+       START1
+
+PAGE
+\f      *5400
+LLAST, TAD     C4000   /END OF COMPILATION, SET CHK SO THAT
+       DCA     CHK     /LGTC WILL NOT READ ANOTHER LINE...
+       JMS I   GNB
+       SZA
+       JMP I   ASSIGN
+       JMS I   (OSTOP  /PUNCH A 'HLT' ETC.
+       TAD     L55
+       TAD     C25
+       SZA CLA         /IS DO LIST EMPTY?
+ERR44, JMS I   LUNCH   /NO, COMPLAIN...
+MORDUM,        TAD     L56     /GET POINTER INTO SYMBOL TABLE
+       TAD     C2      /ADD TWO TO IT FOR CONTROL BITS
+       DCA     L72     /SAVE ADDRESS OF CONTROL BITS
+       TAD I   L72     /GET THE CONTROL BITS
+       AND     E10     /MASK ALL BUT THE DUMMY ARG BIT
+       SNA CLA         /IS THE DUMMY ARG BIT ON
+       JMP     LEDOUT  /NO, PUT OUT DUMMY SUBSCRIPT DEFNS
+       JMS I   DEFN    /YES, PUT OUT THE VARIABLE NAME
+       JMS I   PROP    /PUT OUT THE OP CODE
+       6154            /WHICH IS BSS
+       TAD     C2      /RESERVE TWO LOCATIONS
+       JMS I   PROTAC  /PRINT THE TWO
+       JMS I   PRINT
+       ISZ     L56     /ADVANCE THE POINTER
+       ISZ     L56
+       ISZ     L56
+       JMP     MORDUM  /GO BACK AND DO THE NEXT ONE
+LEDOUT,        DCA     L72     /ZERO LOCATION 72
+LEDOT1,        TAD     L25     /GET THE NUMBER OF SUBSCRIPT TEMPS
+       CMA
+       TAD     L72     /SUBTRACT FROM THE NUMBER WEVE DEFINED
+       SNA CLA         /HAVE WE DEFINED THEM ALL YET
+       JMP     GOOON   /YES, NOW PUT OUT THE END
+       TAD     K5200   /GET SUBSCRIPT DESIGNATOR
+       TAD     L72     /GET WHICH SUBSCRIPT
+       JMS I   PRSYM   /AND PRINT IT
+       TAD     C7240   /GET THE TERMINATOR
+       JMS I   P2      /PRINT IT
+       JMS I   PROP    /PRINT THE OP CODE
+       6154            /WHICH IS BSS
+       TAD     C2      /RESERVE TWO LOCATIONS
+       JMS I   PROTAC
+       JMS I   PRINT   /CRLF
+       ISZ     L72     /GO ON TO THE NEXT ONE
+       JMP     LEDOT1
+GOOON, JMS I   PROP
+               6157    /PUT OUT AN END
+       JMS I   PRINT   /PUT OUT A CRLF
+       DCA     L65     /ZERO THE PSEUDO LOCATION COUNTER
+       TAD     START   /CLA = -600
+       JMS I   LEAD    /PUT OUT LOTS OF LEADER CODE
+       JMS I   PROP
+               6162    /PUT OUT A LAP
+       JMS I   PRINT
+SYM,   TAD     L57
+       CIA
+       TAD     L56
+       SZA CLA         /ARE THERE ANY SYMBOLS
+       JMP     SYM1
+       TAD     MIKE8
+       SZA CLA         /NO, IS THERE ANY EQUIVALENCING?
+       JMP I   LPTEMP
+       JMP I   .+1
+       PTEMP
+SYM1,  TAD     L56
+       TAD     C2
+       DCA     L72
+       TAD I   L72     /GET THE CONTROL BITS
+       DCA     L72     /SAVE THEN
+       TAD     L72     /GET THE BITS
+       AND     E7      /MASK
+       SZA CLA         /ARE THEY FUNCT NAME,
+       JMP     UP      /YES
+       JMS I   DEFN    /PUT IT OUT
+       TAD     L72
+       AND     E20     /MASK ALL BUT THE DIMEN 
+       SNA CLA         /IS EITHER ONE ON
+       JMP     NORM    /NO
+       TAD     L56
+       JMS I   DIM
+       DCA     L26
+       TAD I   L14     /GET THE SECOND DIMENSION
+       CLL CIA         /AND NEGATE
+       DCA     L73     /SAVE
+       SZL
+ERR36, JMS I LUNCH
+       TAD     L26
+       ISZ     L73
+       JMP     .-4
+ACK,   DCA     L26
+       TAD     L56
+       JMS I   MODE    /DETERMINE MODE OF SYMBOL
+       TAD     L26
+       RAL CLL
+       TAD     L26
+       SZL
+       JMP ERR36
+       DCA     L26
+       TAD     L72
+       AND     C40
+       SZA CLA
+       JMP     COM
+       JMS I   BSS
+UP,    ISZ     L56
+       ISZ     L56
+       ISZ     L56
+       JMP     SYM
+NORM,  IAC
+       JMP     ACK
+C25,   25
+E7,    7
+K5200, 5200
+DEFN,  LDEFN
+E20,   20
+E10,   10
+LPTEMP,        EEK
+LEAD,  LLEAD
+COM,   JMS I   PROP
+               6165
+       TAD     L26
+       JMS I   PROTAC
+       JMS I   PRINT
+       JMP     UP
+\f      *5600
+C7600, 7600
+C177,  177
+LBSS,  0
+       TAD     L65     /GET THE LOCATION COUNTER
+       TAD     L26     /ADD THE CURRENT AMOUNT TO IT
+       AND     C7600   /MASK ALL BUT THE PAGE BITS
+       DCA     L64     /SAVE THE NUMBER OF PAGES
+       TAD     L65     /GET THE LOCATION COUNTER AGAIN
+       TAD     L26     /ADD THE CURRENT DISPLACEMENT AGAIN
+       AND     C177    /NOW GET THE NUMBER OF LOCATIONS OVER A PAGE
+       DCA     L65     /AND SAVE
+L,     TAD     L64     /GET THE NUMBER OF PAGES TO BE RESERVED
+       SNA             /ARE THERE ANY TO BE RESERVED
+       JMP     CRAM    /NO...JUST PUT OUT STRAIGHT NUMBER OF LOCATIONS
+       TAD     C7600   /YES...SUBTRACT ONE FROM THE PAGE COUNT
+       DCA     L64     /AND SAVE IT
+       TAD     L65     /GET THE NUMBER OF EXTRA LOCATIONS
+       DCA     L26     /AND PUT IN THE DISPLACEMENT LOCATION
+       JMS I   PROTAC  /PUT OUT A ZERO
+       JMS I   PRINT   /PUT OUT A CRLF
+       JMS I   PROP    /PUT OUT THE OPCODE
+               6151    /WHICH IS THE PAGE PSEUDO OP
+       JMS I   PRINT   /PUT OUT A CRLF
+       JMP     L       /NOW SEE IF WE HAVE PUT OUT ENOUGH PAGES
+CRAM,  JMS I   PROP    /NOW PUNCH 'BLOCK <N>'
+               BLCK
+       TAD     L26
+       JMS I   PROTAC
+       JMS I   PRINT
+       JMP I   LBSS
+LDEFN, 0
+       TAD     L56     /GET THE POINTER TO THE SYMBOL
+       JMS I   PRSYM   /PRINT THE SYMBOL
+       TAD     C7240   /GET THE TERMINATOR
+       JMS I   P2      /PRINT IT
+       JMP I   LDEFN   /AND RETURN
+AFCON, TAD     L47     /GET START OF FCON TABLE
+       TAD     C3      /UPDATE IT
+       DCA     L56     /SAVE UPDATED ADDRESS
+FLOOP, TAD     L50     /GET END OF FCON TABLE
+       CIA
+       TAD     L56     /SUBTRACT FROM CURRENT POINTER
+       SNA CLA         /ARE WE DONE
+       JMP     ALTHRU  /YES
+       TAD     CM3     /NO, GET MINUS THREE
+       DCA     L63     /TO USE AS A COUNTER
+       JMS     LDEFN   /DEFINE IT
+       TAD I   L56     /GET THE FIRST WORD
+       ISZ     L56     /ADVANCE THE POINTER TO THE NEXT WORD
+       JMS I   PROTAC  /PRINT THE WORD
+       JMS I   PRINT   /PUT OUT A CRLF
+       ISZ     L63     /HAVE WE PUT OUT ALL THREE WORDS
+       JMP     .-5     /NO...PUT OUT ANOTHER
+       JMP     FLOOP   /YES...GET THE NEXT CONSTANT
+PTEMP, TAD     K561
+       DCA     L56
+FTLOOP, TAD    L45
+       CMA
+       TAD     L56
+       SNA CLA
+       JMP     ITEMP
+       TAD     C3
+       DCA     L26
+       TAD     K5400   /GET F.P. DESIGNATOR
+       JMS     LDEFN   /PRINT THE SYMBOL
+       JMS I   BSS     /RESERVE THE LOCATIONS FOR IT
+       ISZ     L56     /INCREMENT THE POINTER
+       JMP     FTLOOP
+ITEMP, TAD     K531
+       DCA     L56
+ILOOP, TAD     L51
+       CMA
+       TAD     L56
+       SNA CLA
+       JMP     SUBOUT
+       IAC
+       DCA     L26
+       TAD     K5000   /GET THE INTEGER TEMP DESIGNATOR
+       JMS     LDEFN   /PRINT IT
+       JMS I   BSS     /RESERVE LOCATIONS FOR IT
+       ISZ     L56     /INCREMENT THE POINTER
+       JMP     ILOOP
+ALTHRU,        TAD     D6      /PUNCH AN 'IFF 6'
+       JMS I   PIFF    /SO THAT ENTRY WILL NOT BE AT END OF THE PAGE
+       JMS I   PROP
+               6055    /PUT OUT AN EAP
+       JMS I   PRINT
+       TAD     L70     /GET THE SUBROUTINE FUNCTION POINTER
+       SZA CLA         /IS IT ZERO
+       JMP     THRU    /NO...WE MUST BE IN A SUBR OR A FUNC
+       JMS I   PROP    /YES ...WERE IN A MAIN PROGRAM
+               6052    /PUT OUT ENT
+       TAD     C6000   /POINTER TO THE SYMBOL MAIN
+       JMS I   PRSYM   /PRINT THE SYMBOL
+       JMS I   PRINT   /PUT OUT A CRLF
+       TAD     C6000   /GET THE POINTER TO MAIN AGAIN
+       JMS I   PRSYM   /PRINT  IT
+       TAD     C7240   /GET A COLON
+       JMS I   P2      /PRINT THEM
+       JMS I   PROP
+               6047
+       JMS I   PRINT   /PUT OUT A CRLF
+THRU,  JMS I   FINI
+       6201            /CDF FIELD 0
+       JMP I   C7600   /AND RETURN TO THE MONITOR ...
+C6000, 6000
+SUBOUT,        DCA     L56
+SUBOT1,        TAD     L25
+       CMA
+       TAD     L56
+       SNA CLA
+       JMP     AFCON
+       JMS I   PROP    /PUT OUT THE OP CODE
+       6176            /WHICH IS DUMMY
+       TAD     X5200   /GET SUBSCRIPT DESIGNATOR
+       TAD     L56     /GET THE POINTER 
+       JMS I   PRSYM   /PRINT THE SYMBOL
+       JMS I   PRINT   /CRLF
+       ISZ     L56
+       JMP     SUBOT1
+K5000, 5000-ITTAB
+K5400, 5400-FTTAB
+K531,  ITTAB+1
+K561,  FTTAB+1
+X5200, 5200
+FINI,  LFINI
+D6,    6
+\f      *6000
+/FUNCTION AND SUBROUTINE STATEMENT PROCESSOR
+LFUNC, JMS I   LOOK    /CHECK REST OF STATEMENT
+MFOUR,         -4      /
+               -24     /T
+               -11     /I
+               -17     /O
+               -16     /N
+       CLA IAC         /SET SWITCH
+TART,  DCA     L67     /THIS IS THE SWITCH
+       TAD     FIRSTF
+       SNA     CLA     /INSURE SUBR. OR FUNCT. IS FIRST STMT.
+ERR47, JMS I   LUNCH
+       JMS     SUBB
+       CLA CMA
+       TAD     C6275   /THIS IS THE PLACE TO STORE FUNCTION NAME
+       DCA     L11     /USE AUTO INDEXING TO STORE THE NAME
+       TAD     L30     /GET THE FIRST WORD
+       DCA I   L11     /PUT IT IN THE SYMBOL TABLE
+       TAD     L31     /GET THE SECOND WORD
+       DCA I   L11     /PUT IT IN THE TABLE
+       TAD     L32     /GET THE THIRD WORD
+       IAC             /TURN THE EXTERNAL SYMBOL BIT ON
+       DCA I   L11     /AND PUT IT IN THE TABLE
+       TAD     C6275   /GET THE POINTER
+       DCA     L70     /AND PUT IT IN LOC 70
+       JMS I   PROP
+               6052    /PUT OUT AN ENT
+       TAD     L70     /GET THE SUBROUTINE NAME
+       JMS I   PRSYM   /PRINT IT
+       JMS I   PRINT   /PUT OUT A CRLF
+       CLA CMA
+       DCA     READY   /SET SWITCH
+       TAD     L70     /GET THE SUB NAME
+       JMS I   PRSYM   /PUT IT OUT
+       TAD     C7240
+       JMS I   P2      /PUT IT OUT
+       JMS I   PROP    /PUT OUT THE OP CODE 'BLOCK 2'
+               BLCK
+       TAD     C2
+       JMS I   PROTAC
+       JMS I   PRINT
+       DCA     WHICH   /ZERO THE SWITCH WHICH TELLS WHICH WORD
+MORE,  JMS I   GNB
+       SNA             /CHECK FOR END OF CARD
+       JMP     CKCR
+       TAD     CM50    /CHECK FOR LEFT PAREN
+       SNA             /IS IT A LPAR
+       JMP     GET1    /YES
+       TAD     MFOUR
+       SNA             /IS IT A COMMA
+       JMP     XGET    /YES
+       TAD     C3
+       SNA CLA         /IS IT A LPAR
+       JMP     START   /YES
+       JMP     ERR48   /NO
+GET1,  ISZ     READY   /WERE WE READY FOR LPAR
+       JMP     ERR48   /NO, ERROR ...
+XGET,  JMS     SUBB
+       TAD     L32
+       TAD     TEN
+       DCA     L32
+       TAD     C77     /GET MASK FOR SYMBOL TABLE
+       DCA     L21     /AND PUT INTO THE SWITCH
+       JMS I   SYMTAB  /AND PUT IN SYMBOL TABLE
+       JMS I   PROP
+               DUMMY
+       TAD     L77
+       JMS I   PRSYM
+       JMS I   PRINT
+DLOOP, JMS I   PROP
+               6063    /PUT OUT A TAD*
+       TAD     L70     /GET THE FUNCTION NAME
+       JMS I   PRSYM   /AND PRINT IT
+       JMS I   PRINT   /PUT OUT A CRLF
+       JMS I   PROP
+               6071    /PUT OUT A DCA
+       TAD     L77     /GET ADDRESS OF SYMBOL
+       JMS I   PRSYM   /PRINT IT
+       TAD     WHICH   /GET THE WHICH SWITCH
+       RAR             /GET THE LOW BIT INTO THE LINK
+       SNL CLA         /IS THE WHICH SWITCH BIT SWITCHED
+       JMP     NEXT    /NO...THAT MEANS WERE ON THE FIRST WORD
+       TAD     E43     /YES...WERE ON SECOND WORD...GET A "#"
+       JMS I   PRINT   /PRINT IT
+NEXT,  JMS I   PRINT
+       JMS I   PROP    /PUT OUT AN INC (ISZ WHICH DOES NOT SKIP)
+               6237
+       TAD     L70     /GET THE FUNCTION NAME
+       JMS I   PRSYM   /AND PRINT IT
+       TAD     E43
+       JMS I   PRINT
+       JMS I   PRINT   /PUT OUT A CRLF
+       ISZ     WHICH   /INCREMENT THE SHICH SWITCH
+       TAD     WHICH   /GET THE SWITCH
+       RAR             /GET LOW BIT IN THE LINK
+       SZL CLA         /IS THE LOW BIT ON
+       JMP     DLOOP   /YES...WORK ON THE SECOND WORD
+       JMP     MORE    /GO GET SOME MORE
+READY, 0
+SUBB,  0
+       JMS I   ENTITY
+       SKP
+       JMP I   SUBB
+E43,   43
+TEN,   10
+       JMP     ERR48
+WHICH, 0
+C6275, 6275            /SUBROUTINE OR FUNCTION NAME POINTER
+CKCR,  ISZ     READY
+ERR48, JMS I   LUNCH
+       JMP     START
+
+IOEQL, CLA CMA         /ROUTINE TO TERMINATE IMPLIED DO LOOPS
+       TAD     IMPDO
+       DCA     IMPDO   /REDUCE THE DEPTH BY 1
+       JMS I   DONEXT  /GENERATE END-OF-LOOP CODE
+       JMS I   GNB
+       TAD     CM51
+       SZA CLA         /SKIP TO A RIGHT PAREN
+       JMP     .-3
+       JMP I   .+1
+       IOH0
+DONEXT,        LDNEXT
+\f      *6172
+C6030, 6030
+LWRIT, JMS I   LOOK    /LOOK FOR REST OF STATEMENT
+               -1
+               -5
+       TAD     C3
+LREAD, TAD     C6030   /GET THE POINTER TO READ AND WRITE
+       DCA     IOP     /USE AS A PARAMETER WITH FPROP
+       JMS  I  GNB
+       TAD     CM50
+       SZA CLA         /IS THIS A LEFT PAREN?
+       JMP I   ASSIGN
+       JMS     SUBA
+       JMS I   ZZZ
+       TAD     C2
+       JMS I   FPROP
+IOP,   0
+       JMS I   ARG
+       TAD     L32
+       JMS I   PRSYM
+       JMS I   PRINT
+       JMS I   ARG
+       JMS I   GNB
+       TAD     CM54    /IS IT A COMMA
+       SZA CLA
+       JMP     ERR50   /NO, ERROR ...
+       JMS     SUBA
+       TAD     L32     /GET FORMAT
+       SMA
+       JMS I   PLAB
+       SPA
+       JMS I PRSYM
+       JMS I   GNB
+       TAD     CM51    /CHECK FOR A RIGHT PAREN
+       SZA CLA         /IS IT?
+ERR50, JMS I   LUNCH
+       JMS I   PRINT
+IOH0,  JMS I   GNB
+       SNA
+       JMP     IOH2
+       TAD     CM54
+       SNA CLA         /IS IT A COMMA
+       JMP     IOH3    /YES ...
+IOH1,  JMS I   PUTCH   /NO...PUT IT BACK
+       JMS I   GNB     /THIS STMT IS TRANSFERRED TO!
+       TAD     CM50
+       SNA CLA
+       JMP I   IOPEN   /OPEN PAREN - MAY BE IMPLIED DO-LOOP
+IOH1BK,        JMS I   PUTCH
+       DCA     L52     /SET SWITCHES FOR GENER
+       DCA     L46
+       ISZ     L44
+       JMS I   GENER   /START PROCESSING THE IO LIST
+       TAD     L41
+       DCA     L42
+       TAD     L53
+       DCA     L73     /SAVE CREATED LABEL LOC
+       DCA     L23     /ZERO TEMPORARY FOR "DUMARG"
+       JMS I   LCHNG   /TEST FOR 0 OR DUMMY ARG
+       DCA I   L41
+       TAD     L23     /GET TEMPORARY FROM "DUMARG"
+       SZA CLA         /ZERO MEANS NON-VARIABLE NAME
+       TAD I   L23     /NON-ZERO POINTS TO FLAG WORD OF VAR
+       AND     Q20
+       SNA CLA         /DO WE HAVE AN ARRAY NAME?
+       JMP     NOSYMB  /NO
+       JMS I   PROP
+       OPCMA           /PUT OUT A "CMA" TO DISTINGUISH THIS CALL
+       JMS I   PRINT   /FROM A REGULAR CALL TO "IOH"
+       TAD     C2
+       JMS I   FPROP
+       6036            /OUTPUT A "CALL 2,IOH"
+       JMS I   ARG
+       TAD     L23
+       TAD     CM2
+       JMS I   DIM     /GET THE DIMENSIONS
+       DCA     IOP
+       TAD I   L14
+       CIA
+       DCA     L44
+       TAD     L23
+       TAD     CM2
+       JMS I   MODE    /GET THE MODE OF THE ARRAY
+       TAD     C4000   /FLOATING POINT - ADD 4000 TO AC
+       TAD     IOP
+       ISZ     L44
+       JMP     .-2     /COMPUTE PRODUCT OF DIMENSIONS PLUS MODE BIT
+       JMS I   PROTAC  /PRINT IT
+       JMS I   PRINT
+       JMP     IOHRSM  /GO PRINT ARRAY NAME
+NOSYMB,        TAD     L46
+       SZA CLA
+       JMS I   STORE
+       IAC             /THERE WILL BE ONE ARGUMENT
+       JMS I   FPROP   /PUT OUT THE CALL TO IOH
+               6036
+IOHRSM,        TAD     L73
+       DCA     L53     /RESTORE CREATED LABEL LOC
+       TAD I   L41
+       JMS I   QSYMOT
+       TAD     L63     /GET TERMINATING CHAR
+       SNA CLA         /WAS IT A <CR>?
+       JMP     IOH2    /YES
+IOH3,  JMS I   GNB     /GENTLY LOOK AHEAD ...
+       SNA CLA         /DO WE HAVE A ',<CR>' ?
+       JMP     START   /YES, DO NOT TERMINATE YET ...
+       JMP     IOH1    /NO, PUSH IT BACK & PROCESS NEXT ITEM
+IOH2,  IAC             /THERE WILL BE ONE ARGUMENT
+       JMS I   FPROP   /PUT OUT A CALL TO IOH
+               6036
+       JMS I   ARG     /PUT OUT THE PSEUDO OP ARG
+       JMS I   PROTAC
+       JMS I   PRINT
+       JMP     START
+SUBA,  0
+       JMS I   ENTITY
+       JMP ERR51       /ITS A CR
+       JMP ERR51+1     /ITS A VARIABLE
+       JMP I   SUBA
+Q20,   20
+ERR51, JMS I   LUNCH
+       DCA     L21     /ZERO THE SYMBOL TABLE SWITCH
+       JMS I   SYMTAB
+       TAD     L77
+       JMS I   MODE
+       JMP     ERR51
+       TAD     L77
+       DCA     L32
+       TAD     L32
+       JMS I   DUMARG
+       JMP     ERR51
+       JMP I   SUBA
+IOPEN, IOOPEN
+QSYMOT,        SYMOUT
+\f              *6400
+LRET,  JMS I   LOOK    /CHECK REST OF STATEMENT
+               -2
+               -22
+               -16
+       JMS I   ZZZ
+       TAD     L70
+       SNA CLA         /ARE WE COMPILING MAIN PROGRAM?
+ERR60, JMS I   LUNCH   /YES
+       TAD     L67
+       SNA CLA
+       JMP     INT     /ITS A SUBROUTINE
+       TAD     L70     /GET HE NAME OF THE FUNCTION
+       JMS I   MODE    /IS IT FP OR INTEGER
+       JMP     .+4     /ITS FP
+       JMS I   PROP
+               6066    /OPCODE IS TAD
+       JMP     .+5     /PUT OUT THE SYMBOL
+       IAC             /THERE IS ONE ARGUMENT
+       JMS I   FPROP
+               6003
+       JMS I   ARG
+       TAD     F34     /GET A BACK SLASH
+       JMS I   PRINT
+       TAD     L70     /GET THE NAME OF THE FUNCTION
+       JMS I   PRSYM   /PRINT THE NAME
+       JMS I   PRINT   /PUT OUT A CRLF
+INT,   JMS I   PROP
+               6077    /OPCODE IS RTN
+       TAD     L70     /GET THE FUNCTION NAME
+       JMS I   PRSYM   /PRINT IT
+       JMS I   PRINT   /PUT OUT A CRLF
+       JMP     START   /WERE DONE
+
+LGETHI,        0               /PUNCH 'TAD ACH'
+       JMS I   PROP
+               6066
+       JMS I   PROP    /PRINT THE OP CODE
+       6226            /WHICH IS ACH (HIGH ORDER AC)
+       JMS I   PRINT
+       JMS I   FPROP   /PUNCH 'CALL 0,CLEAR'
+               6204
+       JMP I   LGETHI
+LDIM,  0               /GETS THE 1ST DIMENSION OF THIS VARIABLE
+       DCA     LGETHI  /SYMBOL TABLE ADDRESS IS IN THE AC
+       CMA
+       TAD     L50
+       DCA     L14
+LK,    TAD I   L14     /SEARCH THE DIMENSION TABLE
+       CIA
+       TAD     LGETHI
+       SNA CLA
+       JMP     .+4
+       ISZ     L14
+       ISZ     L14
+       JMP     LK
+       TAD I   L14     /EXIT WITH DIMENSION IN THE AC
+       JMP I   LDIM
+/      THIS PROCESSES SUBSCRIPTS
+SUBRET,        JMP I   LSUBSC  /RETURN FROM SUBSC
+LSBTEM,        0               /THIS ROUTINE MAKES AN ENTRY
+       DCA     TRIP    /IN SUBSCRIPT TEMPORARY TABLE
+       TAD     FBASE
+       DCA     POINT
+       TAD     CM40
+       DCA     PCTR
+LOOP,  TAD I   POINT   /LOOK FOR CURRENT TRIPLE NR
+       SNA             /OR END OF TABLE...
+       JMP     YES
+       CIA
+       TAD     TRIP
+       SNA CLA
+       JMP     GOT
+       ISZ     POINT
+       ISZ     PCTR
+       JMP     LOOP
+ERR53, JMS I   LUNCH
+YES,   TAD     TRIP
+       DCA I   POINT
+GOT,   TAD     FBASE
+       CIA
+       TAD     POINT
+       DCA     POINT
+       TAD     POINT
+       CIA
+       TAD     L25
+       SPA CLA         /IF TEMPORARY NR > L25
+       ISZ     L25     /BUMP L25
+       TAD     POINT
+       JMP I   LSBTEM
+LWIPE, 0               /ZERO THE SUBSCRIPT TEMP. TABLE
+       TAD     FBASE
+       DCA     POINT
+       TAD     CM40
+       DCA     PCTR
+LOOP2, DCA I   POINT
+       ISZ     POINT
+       ISZ     PCTR
+       JMP     LOOP2
+       JMP I   LWIPE
+LZER,  0
+       ISZ     LZER    /INCREMANT
+       JMS I   PROTAC  /PUT OUT A ZERO
+       JMP I   LZER    /AND REUTURN
+LCLAB, 0
+       SNA     /IF NO LABEL IN AC,
+       JMS I   CREATE  /CREATE A LABEL
+       JMS I   PRCRL   /AND PRINT IT
+       TAD     C7240   /PUT OUT A COLON AND SPACE
+       JMS I   P2
+       JMP I   LCLAB   /RETURN
+FBASE, 4600
+POINT, 0
+PCTR,  0
+TRIP,  0
+F34,   34
+LSUBSC,        0
+       TAD     L46
+       SZA             /IS THERE ANYTHING IN THE AC?
+CHANGE,        SKP CLA         /********************************
+/              TRY CHANGING THIS LOCATION TO A "JMS I MODE"
+/              TO LIMIT THE CHECK TO THE INTEGER AC!
+/              COULD SAVE UP TO 30% IN HEAVILY SUBSCRIPTED F.P.
+/              EXPRESSIONS! (IMPORTANT - TEST WITH F.P. SUBSCRIPTS)
+       SKP             /NOTHING IN THE AC
+       JMS I   STORE   /YES - STORE IT
+       IAC
+       DCA     L63
+       TAD     L53
+       DCA     L73
+       TAD     L41
+       DCA     L42
+       ISZ     L41
+       TAD I   L41
+       TAD     CM4046
+       SNA CLA         /WAS IT A PRIME
+       JMP     BACK
+       JMS I   LCHNG
+       DCA     L63
+       ISZ     L41
+       ISZ     L41
+       ISZ     L42
+\f      ISZ     L42
+       IAC
+BACK,  ISZ     L41
+       DCA     SYMOUT
+       JMS     CHNG
+       DCA     L65
+       ISZ     L42
+       ISZ     L42
+       JMS     CHNG
+       DCA     LDUM    /SAVE ARRAY POINTER (OR 0 IF DUMMY)
+       TAD     L73     /NOW RESTORE THE CREATED LABEL LOC
+       DCA     L53
+       TAD     SYMOUT
+       SNA CLA         /HOW MANY SUBSCRIPTS?
+       JMP     .+7     /ONE - SKIP OUTPUTTING "TAD"
+       JMS I   PROP
+               6066
+       TAD I   L41
+       JMS I   DIM
+       JMS I   PRSYM
+       JMS I   PRINT
+       TAD I   L41
+       JMS I   MODE
+       JMP     FP
+CASUB, TAD     H200
+       TAD     L40
+       DCA I   L41     /STORE TRIPLE NUMBER WITH MODE BITS IN PD STACK
+       TAD     SYMOUT  /GET NUMBER OF ARGUMENTS (2 OR 3)
+       TAD     C2
+       JMS I   FPROP   /PUT OUT A CALL TO THE SUBSCRIPTING ROUTINE
+               6173    /TO THE SUBSCRIPTING ROUTINE
+       TAD     SYMOUT
+       SNA CLA         /ONLY ONE ARG?
+       JMP     .+3     /YES - DON'T OUTPUT FIRST SUBSCRIPT
+       TAD     L63
+       JMS     SYMOUT
+       TAD     L65
+       JMS     SYMOUT
+       TAD     LDUM    /GET THE ARRAY NAME
+       JMS     SYMOUT  /OUTPUT IT AS AN ARGUMENT
+       TAD I   L41
+       JMS I   PRSYM   /OUTPUT THE DESTINATION TEMPORARY
+       JMS I   PRINT
+       TAD I   L41
+       DCA     L12     /MARK IT AS THE CONTENTS OF THE LAST LINE
+       JMP I   FSUBSC  /RETURN
+FP,    JMS I   PROP
+               OPCMA                   /OPCODE IS CMA
+       JMS I   PRINT
+       TAD     H400    /SET MODE TO FLOATING POINT
+       JMP     CASUB
+SYMOUT, 0
+       DCA     CHNG
+       TAD     CHNG
+       SNA CLA
+       JMS I   CLAB    /CREATE LABEL IF DUMMY ARG
+       JMS I   ARG
+       TAD     CHNG
+       SNA             /IS IT ZERO
+       JMS I   ZER     /YES PUT OUT A ZERO
+       JMS I   PRSYM   /OTHERWISE PUT OUT SUBSCRIPT
+       JMS I   PRINT   /PUT OUT A CRLF
+       JMP I   SYMOUT
+
+LDSPCL,        DCA     L24
+       JMS I   CREATE
+       JMS I   PRCRL   /CHANGE LAST LINE TO STORE IN NEW DESTINATION
+       DCA     L12     /MARK LAST LINE USELESS FOR OPTOMIZATION
+       JMP     LDMRET
+LDUM,  0
+       ISZ     LDUM    /INCREMENT RETURN
+       TAD I   L42     /GET THE THING WHICH IS DUMMY
+       CIA
+       TAD     L12     /DID WE JUST PUT THIS OUT AS A SUBSCRIPT
+       SNA CLA         /DESTINATION??
+       JMP     LDSPCL  /YES - SAVE OODLES OF CODE
+       JMS I   PROP
+               6066    /PUT OUT A TAD
+       TAD I   L42
+       JMS I   PRSYM   /PUT IT OUT
+       JMS I   PRINT   /PUT OUT A CRLF
+       JMS I   PROP
+               6071    /PUT OUT A DCA
+       JMS I   CREATE  /CREATE A LABEL
+       JMS I   PRCRL   /AND PRINT IT
+       JMS I   PRINT   /PUT OUT A CRLF
+       JMS I   PROP
+               6066
+       TAD I   L42
+       JMS I   PRSYM
+       TAD     H43
+       JMS I   PRINT
+       JMS I   PRINT
+       JMS I   PROP
+               6071
+       TAD     L53
+       JMS I   PRCRL
+       TAD     H43
+       JMS I   PRINT
+LDMRET,        JMS I   PRINT
+       JMP I   LDUM    /RETURN
+CHNG,  0
+       TAD I   L42     /NO...THERES TWO SUBSCRIPTS
+       SNA
+       TAD     H6041
+       DCA I   L42
+       TAD I   L42
+       JMS I   DUMARG  /SEE IF SECOND SUBSC IS A DUMMY ARG
+       JMS I   DUM     /YES IT IS A DUMMY ARG
+       TAD I   L42     /GET THE SECOND SUBSC
+       JMP I   CHNG
+
+H400,  400
+H200,  200
+H43,   43
+FSUBSC,        SUBRET
+H6041, 6041
+\f      *7000
+IOHTMP,MCHAR,  0
+NPOINT,LLUNCH, 0
+       CLA
+       DCA     L75
+       DCA     L24     /ZERO "BUFFER WAITING TO PRINT" FLAG
+       DCA     IMPDO   /ZERO IMPLIED DO LOOP FLAG
+       TAD     TTYPE   /CHANGE TO TTY OUTPUT
+       DCA     PUNCH
+       JMS I   LLIST   /TYPE THE CURRENT LINE
+       CLL CMA RAL
+       TAD     KOUNT   /USE THE BUFFER POINTER AS AN INDEX
+       SMA
+       CMA
+       DCA     L7
+       TAD     C40     /NOW PUT OUT SOME SPACES...
+       JMS I   PRINT
+       ISZ     L7
+       JMP     .-3
+       TAD     D36     /AND AN '^'
+       JMS I   PRINT
+       JMS I   PRINT
+       TAD     LELIST  /NOW TYPE THE ERROR MESSAGE
+       DCA     L10
+UNCH1, TAD I   L10
+       SZA             /END OF TABLE?
+       TAD     LLUNCH
+       SNA CLA         /IS THIS THE MSG WE WANT?
+       JMP     UNCH2
+       ISZ     L10     /NO
+       JMP     UNCH1
+UNCH2, TAD     BASE
+       CIA
+       TAD I   L10
+       JMS I   LLIST   /FAKE LISTER INTO PRINTING ERROR MESG
+       JMS I   PRINT   /FORCE BUFFER
+       TAD     EPNCH   /BACK TO PUNCH OUTPUT
+       DCA     PUNCH
+       ISZ     L75     /SET THE NON-PRINT SWITCH
+       TAD     CHK     /IF ERROR OCCURED WHILE PROCESSING END STMT.
+       TAD     C4000   /CHK WILL BE 4000-WANT TO ABORT IMMEDIATELY
+       SZA     CLA     /WAS IT END STMT?
+       JMP     START   /NO-GO PROCESS NEXT STMT.
+       JMP I   (THRU   /YES-CLEAN UP AND ABORT
+LLIST, LIST
+D36,   36
+LELIST,        ELIST-1         /ERROR LIST ...
+TTYPE, LTTYPE
+EPNCH, LPUNCH
+CTR,   0
+TEM,   0
+/      THIS ROUTINE PRINTS THE CONTENTS OF THE AC IN DECIMAL
+PARCT,LDCOUT, 0
+       DCA     TEM     /SAVE THE AC
+       TAD     CM3     /WE WILL PUT OUT FOUR CHARACTERS
+       DCA     CTR
+       TAD     ASE     /THIS IS THE ASE OF THE CONVERSION TABLE
+       DCA     NPOINT  /SAVE IT IN THE POINTER
+       DCA     FLAG
+LOP,   DCA     MCHAR   /ZERO OUT THE CHARACTER
+       TAD     TEM     /GET THE NUMBER AGAIN
+       TAD I   NPOINT  /TO GET THE ITEM IN THE TABLE
+       SPA             /IS THE RESULT POSITIVE
+       JMP     LOPRST  /NO...RESTORE THE NUMBER
+       DCA     TEM     /AND SAVE THIS VALUE
+       TAD     D60
+       DCA     FLAG    /SET FLAG TO SHOW THAT WE HAVE SOMETHING
+       ISZ     MCHAR   /YES...INCREMENT THE OUTPUT CHARACTER
+       JMP     LOP+1   /TRY THE SEQUENCE AGAIN
+LOPRST,        CLA
+       TAD     MCHAR
+       TAD     FLAG
+       SZA             /DO WE HAVE A SIGNIFICANT DIGIT?
+       JMS I   PRINT   /YES - PRINT IT
+       ISZ     NPOINT
+       ISZ     CTR
+       JMP     LOP     /AND GET THE NEXT DIGIT
+       TAD     TEM     /GET THE CHARACTER TO OUTPUT
+       TAD     D60     /PUT IT IN TRIMMED ASCII FORM
+       JMS I   PRINT   /PRINT IT
+       JMP I   LDCOUT  /YES...RETURN TO CALLING PROGRAM
+ASE,   THOU
+FLAG,  0
+
+
+IOOPEN,        TAD     KOUNT
+       DCA     IOHTMP  /SAVE POINTER TO LEFT PAREN +1
+       CLA CMA
+       DCA     PARCT   /INITIALIZE PAREN COUNTER
+       TAD     KOUNT
+       DCA     TEM     /TEM POINTS TO ENTITY  (OR PREV ONE IF A VAR)
+IOPENL,        JMS I   ENTITY  /GET SOMETHING
+ERR52, JMS I   LUNCH   /END OF STMT - BAD
+       JMP     IOPENL  /VARIABLE - DON'T UPDATE TEM
+D60,   60
+       JMP     IOPENL-2        /CONSTANT - UPDATE TEM
+       TAD     CM51    /PUNCTUATION - TEST FOR RIGHT PAREN
+       SNA
+       JMP     IORPAR  /YES
+       IAC
+       SNA             /LEFT PAREN?
+       JMP     IOLPAR
+       TAD     CM25
+       SNA CLA         /IF CHAR IS AN EQUAL SIGL
+       TAD     PARCT
+       IAC
+       SZA CLA         /AND WE ARE ON THE TOP LEVEL OF PARENTHESES
+       JMP     IOPENL-2
+       TAD     TEM     /THEN WE HAVE AN IMPLIED DO
+       DCA     KOUNT
+       JMS I   DO      /GENERATE DO LOOP CODE
+       JMP     ERR52   /NOT TERMINATED WITH RPAR - ERROR
+       ISZ     IMPDO   /BUMP IMPLIED DO COUNT
+       TAD     IOHTMP
+       DCA     KOUNT   /RESTORE CHAR PTR TO BEGINNING OF LOOP
+       JMP I   .+1
+       IOH1+1          /COMPILE INNARDS OF LOOP
+
+IOLPAR,        CLA CMA
+       TAD     PARCT
+       JMP     IOPENL-3        /BUMP PAREN COUNT  UP AND LOOP
+
+IORPAR,        ISZ     PARCT   /BUMP PAREN COUNT DOWN
+       JMP     IOPENL-2        /LOOP IF NOT BALANCED
+       TAD     IOHTMP
+       DCA     KOUNT   /BALANCED - NOT AN IMPLIED DO
+       JMP I   .+1
+       IOH1BK          /COMPILE NORMALLY
+CM25,  -25
+DO,    XDO
+\f      *7200
+EQUI,  JMS I   LOOK    /CHECK REST OF STATEMENT TYPE
+       -7      /THERE ARE 7 MORE CHARACTERS
+       -26     /V
+       -1      /-A
+       -14     /-L
+       -5      /-E
+       -16     /-N
+       -3      /-C
+       -5      /-E
+RETA,  ISZ     SNUM    /INCREMENT THE STRING NUMBER
+       JMS     CCCC    /GET AND CHECK THE NEXT NON-BLANK CHARACTER
+       SKP             /ONLY LEGAL CHAR HERE IS A "("
+       JMP     RETB    /WE GOT THE "("
+       NOP
+       JMP     ERR59
+RETB,  JMS I   ENTITY  /LOOK FOR A VARIABLE
+       SKP
+       JMP     LA      /GOT IT, ANYTHING ELSE IS AN ERROR
+       NOP
+       NOP
+       JMP     ERR59
+LA,    ISZ     L32     /TURN EQUIVALENCE BIT ON
+       ISZ     L32
+       TAD     K57     /GET MASK FOR SYMBOL TABLE
+       DCA     L21     /PUT IN THE SYMBOL TABLE SWITCH
+       JMS I   SYMTAB  /PUT IN SYMBOL TABLE
+       TAD     L77     /GET THE POINTER
+       ISZ     MIKE4   /AND PUT IN EQUIVALENCE TABLE
+       DCA I   MIKE4
+       TAD     SNUM    /GET THE CURRENT STRING NUMBER
+       ISZ     MIKE4   /AND PUT IT IN THE EQUIVALENCE TABLE
+       DCA I   MIKE4
+       ISZ     MIKE8   /INCREMENT NUMBER OF ENTRIES
+       JMS     CCCC    /GET NEXT PUNCTUATION
+       JMP     ERR59   /C/R, THAT'S AN ERROR ...
+       JMP     .+3     /LEFT PAREN, VARIABLE IS SUBSCRIPTED
+       JMP     LB      /COMMA, NOT SUBSCRIPTED, STRING CONTINUES
+       JMP     LC      /RIGHT PAREN, NOT SUBSCRIPTED, END OF STRING
+       JMS I   ENTITY  /LOOK FOR SUBSCRIPT
+       NOP
+       SKP
+       JMP     LD      /GOT IT, ANYTHING ELSE IS ERROR
+       NOP
+       JMP     ERR59
+LD,    CLA CMA /SUBTRACT ONE FROM
+       TAD     L32     /FIRST SUBSCRIPT
+       DCA     INTA    /AND SAVE
+       JMS     CCCC    /GET NEXT PUNCTUATION
+       NOP             /CR IS ILLEGAL HERE
+       JMP     RETB-1  /SO IS LEFT PAREN
+       SKP             /COMMA, DOUBLY SUBSCRIPTED
+       JMP     LF      /RIGHT PAREN, SINGLY SUBSCRIPTED
+       JMS I   ENTITY  /GET OTHER SUBSCRIPT
+       NOP
+       SKP
+       JMP     LG      /GOT IT
+       NOP
+       JMP     LD-1
+LG,    TAD     L32     /SET IT NEGATIVE
+       CIA
+       DCA     INTB    /AND SAVE IT
+       JMS     CCCC    /GET NEXT PUNCTUATION
+       NOP
+       NOP
+ERR59, JMS I   LUNCH
+       TAD     L77     /RIGHT PAREN IS ONLY LEGAL CHARACTER
+       JMS I   DIM     /GET DIMENSION INFORMATION
+       DCA     CCCC    /AND SAVE
+       SKP             /GO TO TEST PART OF LOOP
+       TAD     CCCC    /THIS LOOP IS A MAKESHIFT MULTIPLY
+       ISZ     INTB    /ARE WE DONE
+       JMP     .-2     /NO
+       TAD     INTA    /YES, ADD FIRST SUBSCRIPT
+       DCA     INTA    /AND SAVE
+LF,    TAD     L77     /GET POINTER TO VARIABLE
+       JMS I   MODE    /WHAT MODE IS IT
+       TAD     INTA    /F.P., MULTIPLY BY THREE
+       RAL CLL /INTEGER
+       TAD     INTA
+       IAC             /ADD ONE TO ANSWER
+       ISZ     MIKE4   /AND PUT IN EQUIVALENCE TABLE
+       DCA I   MIKE4
+       JMS     CCCC    /GET NEXT PUNCTUATION
+       NOP
+       JMP     RETB-1  /CR AND "(" ARE ILLEGAL HERE
+       JMP     RETB    /COMMA MEANS STRING NOT FINISHED
+       JMP     LI      /")" MEANS STRING FINISHED
+LC,    CLA IAC /HERE WE CRAM A ONE INTO EQUIVALENCE
+       ISZ     MIKE4
+       DCA I   MIKE4
+LI,    JMS     CCCC    /WE FINISHED A STRING, ARE THERE MORE
+       JMP     START   /NO
+       SKP
+       JMP     RETA    /YES
+       JMP     RETB-1  /"(" AND ")" ARE ILLEGAL HERE
+LB,    CLA IAC         /CRAM A ONE INTO TABLE
+       ISZ     MIKE4
+       DCA I   MIKE4
+       JMP     RETB    /AND GO BACK
+/
+/      THIS"ROUTINE GETS AND CHECKS THE NEXT NON-BLANK CHAR
+/
+CCCC,  0
+       JMS I   GNB
+       SNA             /PUNCTUATION IS WHAT WE WANT
+       JMP I   CCCC    /ITS A CR
+       TAD     CM54
+       SNA             /IS IT A COMMA
+       JMP     XCOMMA  /YES
+       TAD     C3
+       SNA             /IS IT A ")"
+       JMP     XRPAR   /YES
+       IAC
+       SNA             /IS IT A "("
+       JMP     XLPAR   /YES
+       JMP     RETB-1  /NONE OF THE ABOVE
+XRPAR, ISZ     CCCC
+XCOMMA,        ISZ     CCCC
+XLPAR, ISZ     CCCC
+       JMP I   CCCC
+K57,   57
+
+LFIN,  JMS I   GNB
+       SZA CLA
+       JMP I   ASSIGN
+       JMS I   ZZZ     /PRINT LABEL ON "FINI"
+       JMP I   .+1
+       IOH2
+
+/THE FOLLOWING CODE IS TO PROCESS THE EQUIVALENCE TABLE
+/AT THE END OF A COMPILATION
+\f      *7376
+EEK,   ISZ     MIKE4
+       ISZ     MIKE4
+       DCA I   MIKE4   /SET END OF LIST
+       JMS     INIT    /INITIALIZE POINTERS
+AAB,   TAD     MA      /SET POINTERS TO STRING NUMBERS
+       TAD     C3
+       DCA     MB
+       ISZ     MA
+       ISZ     MA
+AAC,   ISZ     MB
+AA,    ISZ     MB
+       TAD I   MA      /GET FIRST STRING NUMBER
+       CIA
+       TAD I   MB      /SUBTRACT FROM SECOND
+       SZA CLA         /ARE THEY THE SAME
+       JMP     KICK1   /NO, ADVANCE POINTERS
+       ISZ     MA      /YES, MOVE TO LINEAR SUBSCRIPT
+       ISZ     MB
+       TAD I   MA      /GET FIRST SUBSC
+       CIA
+       TAD I   MB      /SUBTRACT FROM SECOND
+       SPA CLA SNA     /IS FIRST ONE SMALLER
+       JMP     KICK2   /NO, JUST ADVANCE POINTERS
+       TAD     MA      /YES, SWITCH PLACES
+       TAD     CM2
+       DCA     MA
+       TAD     MB
+       TAD     CM2
+       DCA     MB
+       TAD     CM3
+       DCA     INIT
+RAUCH, TAD I   MA
+       DCA     L76
+       TAD I   MB
+       DCA I   MA
+       TAD     L76
+       DCA I   MB
+       ISZ     MA
+       ISZ     MB
+       ISZ     INIT
+       JMP     RAUCH
+       TAD     MA
+       TAD     CM2
+       DCA     MA
+       JMP     AA      /NOW THEYRE SWITCHED, CHECK AGAIN
+KICK2, CLA CMA         /MOVE BACK FIRST POINTER
+       TAD     MA
+       DCA     MA
+       JMP     AAC
+KICK1, ISZ     MA      /MOVE UP FIRST POINTER
+       ISZ     MIKE7   /ARE WE OUT OF ENTRIES
+       JMP     AAB     /NO
+/
+/      NOW THE SORTING IS DONE
+/
+       JMS     INIT    /INITIALIZE POINTERS
+       DCA     TOTAL   /ZERO OUT TOTAL
+MIKE2, ISZ     MA
+       TAD I   MA
+       JMS I   PRSYM   /PUT OUT THE SYMBOL
+       TAD     C7240
+       JMS I   P2      /PUT OUT THE TERMINATOR
+       IAC
+       TAD I   MA
+       DCA     L14
+       TAD I   L14     /GET CONTROL BITS FROM SYMBOL TABLE
+       AND     P20
+       SNA CLA         /IS IT DIMENSIONED
+       JMP     MIKE5   /NO
+       TAD I   MA      /YES, COMPUTE THE TOTAL LENGTH
+       JMS I   DIM
+       DCA     L26
+       TAD I   L14
+       CIA
+       DCA     L73
+       TAD     L26
+       ISZ     L73
+       JMP     .-2
+       SKP             /GOT IT
+MIKE5, IAC             /IF NOT DIMENSIONED, USE ONE A LENGTH
+       DCA     MB      /SAVE LENGTH 
+       TAD I   MA
+       JMS I   MODE    /WHAT IS THE MODE OF THE SYMBOL
+       TAD     MB      /FP, MULTIPLY BY THREE
+       RAL CLL
+       TAD     MB
+       DCA     INIT    /SAVE IT
+       TAD     TOTAL   /GET TOTAL REMAINING LENGTH OF STRING
+       CIA
+       TAD     INIT    /SUBTRACT CURRENT LENGTH FROM IT
+       SPA CLA         /WHICH IS BIGGER
+       JMP     .+3     /REMAINING PORTION IS BIGGER
+       TAD     INIT    /CURRENT PORTION IS BIGGER, REPLACE REMAINING PORTION
+       DCA     TOTAL
+       ISZ     MA
+       TAD     MA
+       TAD     C3
+       DCA     MB
+       TAD I   MB      /GET NEXT ENTRY STRING NUMBER
+       CIA
+       TAD I   MA      /SUBTRACT CURRENT STRING NUMBER
+       SZA CLA         /ARE THEY EQUAL
+       JMP     MIKE1   /NO
+       ISZ     MA      /YES, GET THE DIFFERENCE
+       ISZ     MB
+       TAD I   MB
+       CIA
+       TAD I   MA
+       DCA     MB      /AND SAVE
+       TAD     MB      /SUBTRACT DIFFERENCE FROM TOTAL REMAINING
+       CIA
+       TAD     TOTAL
+MIKE6, DCA     TOTAL   /SAVE
+       TAD     MB      /GET THE DIFFERENCE
+       DCA     L26
+       JMS I   BSS     /RESERVE THAT MANY LOCATIONS
+       ISZ     MIKE7   /ARE WE DONE
+       JMP     MIKE2   /NO
+       JMP I   ROGER   /YES
+MIKE1, TAD     TOTAL   /SWITCH TOTAL TO THE CURRENT LOCATION
+       DCA     MB
+       ISZ     MA      /EQUALIZE POINTERS
+       JMP     MIKE6
+/
+INIT,  0
+       TAD     MIKE8   /GET ENTRY COUNT
+       CIA             /SET NEGATIVE
+       DCA     MIKE7   /SAVE
+       TAD     POINTZ  /GET TABLE POINTER
+       DCA     MA      /SAVE
+       JMP I   INIT
+/
+ROGER, PTEMP
+P20,   20
+$
+
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape2/FPATCH.PA b/sw/os8/v3d/sources/system/dectapes/dectape2/FPATCH.PA
new file mode 100644 (file)
index 0000000..20517db
--- /dev/null
@@ -0,0 +1,498 @@
+/OS8 FORTRAN II COMPILER OVERLAY V5            ***FPATCH.05***
+/
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/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.
+/
+/
+/
+/
+/
+/
+\f/
+/FIXES TO FPATCH FOR V4                J.K.  1975
+/
+/ .CHANGED USE OF 17645 SO /N CAN BE PASSED TO LOADER
+/      BIT 0 OF 17645 INDICATES THAT SABR WAS CHAINED
+/      TO FORM FORT INSTEAD OF WHOLE WORD
+/
+/  .VERSION NUMBER VIA /V--OPTION
+/      WILL BE PASSED ONTO SABR
+/
+/
+/
+       FIELD 0
+       JSBITS=7746
+       MOFILE=7600
+       MPARAM=7643
+       LLUNCH=7001     /TAKE OUT WHEN MERGING WITH COMPILER
+       DO=7173         /"
+       ELIST=1162      /"
+       EMSG1=1270      /"
+       EMSG14=1520     /"
+       FLST=242        /"
+       FORST=5362      /"
+       FPROP=144       /"
+       GOOON=5455      /"
+       KOUNT=113       /"
+       LPTRIN=545      /"
+       LPUNCH=5333     /"
+       LTTYPE=3372     /"
+       L75=75          /"
+       OSTOP=4052      /"
+       XFINI=5354      /"
+\f      *200
+START, CLA CMA
+       DCA     FCHFLG
+       CIF 10
+       JMS I (7700
+       10      /ESCAPE
+       ISZ     FCHFLG
+       JMP     .+5
+       CIF 10
+       JMS I (200
+       5       /COMMAND DECODE
+       0624    /.FT ASSUMED EXTENSION
+       CDF     10
+       TAD I   (MPARAM+1
+       CDF 0
+       AND     (4
+       SZA CLA
+       JMS     VERNUM
+       CLA IAC
+       CIF 10
+       JMS I (200
+       4               /CLOSE OPERATOR USED AS DELETE
+       OUSNAME         /DELETE FORTRN.TM IF IT EXISTS
+       0
+       CLA             /IT DIDN'T EXIST
+       CLA IAC         /ENTER A FILE ON "SYS" - MAXIMUM SIZE
+       CIF 10
+       JMS I (200
+       3       /ENTER
+OUSREC,        OUSNAME
+HOLSIZ,        0
+       JMP I (OUERR    /WHATS GOING ON HERE?
+       CLA IAC         /DEVICE "SYS"
+       CIF 10
+       JMS I (200
+       2
+PTSABR,        SABR
+FCHFLG,        0               /USELESS LENGTH WORD
+       JMP I (BIGGIE
+       TAD PTSABR
+       DCA I (CLSABR
+       TAD OUSREC
+       DCA I (OUTREC
+       TAD HOLSIZ
+       DCA I (OURCNT
+       TAD (1000
+       TAD I (JSBITS
+       DCA I (JSBITS   /SET "UNSTARTABLE" STATUS BIT
+       JMS I (FNEWF    /INITIALIZE FIRST INPUT FILE WHILE I/O MON IS IN CORE
+       CDF 10
+       TAD OUSREC
+       DCA I (7620
+       CLA IAC
+       DCA I (7617
+       CLA CLL CML RTL
+       AND I (MPARAM
+       TAD I (MOFILE+5
+       SNA CLA
+       DCA I (FLST
+       TAD I (7600
+       SNA CLA
+       TAD I (MPARAM
+       AND (41
+       SNA CLA         /DID HE SPECIFY A "L" OR "G" OPTION WITHOUT A
+       JMP FCDF0-3     /RELOCATABLE OUTPUT FILE?
+FTADNM,        TAD BDFALT      /YES - GIVE HIM ONE
+       DCA I B7600     /NAMED "FORTRL.TM"
+       ISZ FTADNM
+       ISZ B7600
+       ISZ B7773
+       JMP FTADNM
+       CLA CLL CML RAR
+       TAD I   (7645
+       DCA I (7645     /SABR IT WAS CHAINED TO BY FORT
+FCDF0, CDF 0
+       JMP I (1003     /START COMPILATION
+
+BDFALT,        1               /DEVICE "SYS"
+       TEXT    /FORTRLTM/
+B7600, 7600
+B7773, 7773
+/
+VERNUM,        0
+       TAD I   POINT
+       CDF CIF 10
+       JMS I   VPRINT
+       ISZ     POINT
+       ISZ     COUNT
+       JMP     .-5
+       JMP I   VERNUM
+/
+POINT, VERN
+COUNT, -12
+VERN,  306
+       317
+       322
+       324
+       240
+       326
+       265
+       301
+       215
+       212
+/
+VPRINT,        VERPRT
+
+\f      /ADDITIONS TO FORTRAN ERROR MESSAGES
+
+       *ELIST+1
+       NUMSG1
+       *EMSG1-2
+       -ERR61-1;       EMSG15
+       -ERR62-1;       EMSG16
+       -ERR63-1;       EMSG17
+       -ERR64-1;       EMSG20
+       0       ;       EMSG14
+       /DUMMY PAGES TO CONSOLIDATE CORE IMAGE
+       *1600
+       0
+       *2000
+       0
+       *2400
+       0
+       *3000
+       0
+       *5600
+       0
+\f      *5400
+FNEWF, 0
+       CDF 10
+       TAD I FILPTR
+       SNA
+       JMP EOFERR      /END OF INPUT REACHED BEFORE END STATEMENT
+       DCA INWCNT
+       TAD I FILPTR
+       AND (7760
+       SZA
+       TAD (17
+       CLL CML RTR
+       RTR
+       DCA INRCNT
+       ISZ FILPTR
+       TAD I FILPTR
+       DCA INREC
+       ISZ FILPTR
+       TAD (5001       /FORTRAN ALLOWS TWO-PAGE HANDLERS
+       DCA INHNDL
+       TAD INWCNT
+       CDF 0
+       CIF 10
+       JMS I (200
+       1       /ASSIGN AND FETCH HANDLER
+INHNDL,        5000    /LOCATIONS 5000-5377 ARE FREE
+       JMP IOERR       /SOMETHINGS SCREWY
+       CLA CMA
+       DCA INWCNT
+       DCA INEOF
+       JMS MOUCOR
+       JMP I FNEWF
+FILPTR,        7617
+GETCH, 0
+       KSF
+       JMP .+5
+       KRS
+       TAD (-203
+       SNA CLA
+       JMP I (7600
+       ISZ JMPGET
+       ISZ INWCNT
+JMPG,  JMP JMPGET
+       TAD INEOF
+       SNA CLA
+       JMP JUSTRD
+GETNXT,        CIF 10
+       JMS I G7700
+       10      /ESCAPE
+       JMS FNEWF
+JUSTRD,        JMS I INHNDL    /INHNDL CONTAINS LOCN OF DEVICE HANDLER
+       0200    /READ 2 HALF-RECORDS INTO FIELD 0
+INBFPT,        INBUF
+INREC, 0
+       JMP RERROR
+       ISZ INREC
+       ISZ INRCNT
+       SKP
+ENDFIL,        ISZ INEOF
+       TAD (-601
+       DCA INWCNT
+       TAD JMPG
+       DCA JMPGET
+       TAD INBFPT
+       DCA INPTR
+       JMP GETCH+1
+JMPGET,        JMP .
+       JMP INCHR1
+       JMP INCHR2
+INCHR3,        TAD JMPG
+       DCA JMPGET
+       TAD I INPTR
+       AND (7400
+       CLL RTR
+       RTR
+       TAD INTMP
+       RTR
+       RTR
+       ISZ INPTR
+       JMP GCHCOM
+INCHR2,        TAD I INPTR
+       AND (7400
+       DCA INTMP
+       ISZ INPTR
+INCHR1,        TAD I INPTR
+GCHCOM,        AND (377
+       TAD (-232
+       SNA
+       JMP GETNXT
+       TAD (232
+       CIF 10
+       ISZ GETCH
+       JMP I GETCH
+RERROR,        SMA CLA
+       G7700=RERROR
+       JMP ENDFIL
+IOERR, JMS I (SFATAL
+       CIF 10
+ERR62, JMS I (LLUNCH
+INPTR, 0
+INWCNT,        0
+INTMP, 0
+INRCNT,        0
+INEOF, 0
+EOFERR,        JMS MOUCOR      /KICK MONITOR OUT
+       JMS I (SFATAL
+       CIF 10
+ERR61, JMS I (LLUNCH
+MOUCOR,        0
+       CDF 0
+       CIF 10
+       JMS I (200
+       11
+       JMP I MOUCOR
+\f      *3200
+P377,  377
+P7400, 7400            /WARNING ***DO NOT MOVE THIS***
+
+PUTCH, 0
+       DCA PUTMP
+       RAL
+       DCA PUTLNK
+PUTCHX,        ISZ JMPPUT
+       ISZ OUWDCT
+JMPP,  JMP JMPPUT
+       CLA CLL CML RTL
+       TAD OURCNT
+       SZL
+       JMP OUERR+1
+       DCA OURCNT
+       ISZ CLOSCT
+       ISZ CLOSCT
+       JMS I (7607
+       4400
+OUBFPT,        OUBUF
+OUTREC,        0
+       JMP I (IOERR
+       ISZ OUTREC
+       ISZ OUTREC
+       TAD (-1401
+       DCA OUWDCT
+       TAD OUBFPT
+       DCA OUPTR
+       TAD JMPP
+       DCA JMPPUT
+       JMP PUTCHX
+JMPPUT,        JMP .
+       JMP PUTCH1
+       JMP PUTCH2
+PUTCH3,        TAD PUTMP
+       RTL
+       RTL
+       DCA PUTMP
+       TAD JMPP
+       DCA JMPPUT
+       TAD PUTMP
+       AND P7400
+       TAD I OUPOLD
+       DCA I OUPOLD
+       TAD PUTMP
+       RTL
+       RTL
+P201,  AND P7400
+       TAD I OUPTR
+       DCA I OUPTR
+       ISZ OUPTR
+       JMP PCHCOM
+PUTCH2,        TAD OUPTR
+       DCA OUPOLD
+       ISZ OUPTR
+PUTCH1,        TAD PUTMP
+P200,  AND P377
+       DCA I OUPTR
+PCHCOM,        CIF 10
+       TAD PUTLNK
+       CLL RAR
+       JMP I PUTCH
+
+EOFORT,        SZA CLA         /ANY ERRORS?
+       JMP I SF7600    /YES, DO NOT ASSEMBLE
+       DCA PCHCOM
+       TAD (232
+       JMS PUTCH
+       TAD OUWDCT
+       TAD (1400
+       SZA CLA
+       JMP .-5         /FILL BUFFER WITH ^Z
+       TAD I (JSBITS
+       RAR
+       CLL CML RAL
+       DCA I (JSBITS   /NO NEED TO SAVE CORE ON THIS MONITOR CALL
+       CIF 10
+       JMS I (7700
+       10      /ESCAPE
+       CLA IAC         /DEVICE "SYS"
+       CIF 10
+       JMS I P200
+       4       /CLOSE
+       OUSNAM
+CLOSCT,        0       /CLOSING LENGTH
+       JMP OUERR-3
+       CIF 10
+       JMS I P200
+       6               /RUN
+CLSABR,        0
+BIGGIE,        JMS I (MOUCOR
+       JMS SFATAL
+       CIF 10
+ERR63, JMS I (LLUNCH
+       CLA CLL CMA RTL
+       AND I (JSBITS
+       DCA I (JSBITS   /WHOOPS - GUESS WE SHOULD RESTORE CORE AFTER ALL
+OUERR, JMS I (MOUCOR
+       JMS SFATAL
+       CIF 10
+ERR64, JMS I (LLUNCH
+       INBUF=1600
+       OUBUF=3600
+OURCNT,        0
+OUPTR, OUBUF
+OUWDCT,        -1401
+PUTMP, 0
+OUPOLD,        0
+SFATAL,        0
+       PUTLNK=SFATAL
+SF7600,        7600            /CLEAR AC
+       CDF 10
+       TAD SCDIF0
+       DCA I (177
+       TAD (5601
+       DCA I P200
+       TAD SF7600
+       DCA I P201
+SCDIF0,        CDF CIF 0
+       JMP I SFATAL
+\f      *2200   /CANNOT GO PAST 2373
+SABR,  TEXT    /SABR/
+       TEXT    /SV/
+OUSNAM,        TEXT    /FORTRNTM/
+NUMSG1,        TEXT    /ILLEGAL CONTINUATION/
+EMSG15,        TEXT    /NO END STATEMENT/
+EMSG16,        TEXT    #I/O ERROR#
+EMSG17,        TEXT    /SABR.SV NOT FOUND/
+EMSG20,        TEXT    /NO ROOM FOR OUTPUT/
+\f      FIELD 1
+       /THESE ARE THE PATCHES OVER THE COMPILER.
+
+
+       *FORST  /HEADER PRINTER
+       NOP
+       NOP
+       NOP
+
+       *FORST+5        /LEADER OUTPUT
+       CLA CLL CMA RTL /3 CHARACTERS OF LEADER
+
+       *LPTRIN+1       /HIGH-SPEED READER ROUTINE
+       CIF 0
+       JMS I .+1
+       GETCH
+
+       *OSTOP+1
+       JMS I FPROP     /PUNCH 'CALL 0,EXIT'
+               6253
+       JMP I OSTOP
+
+       *LPUNCH+1       /PUNCH ROUTINE
+       CIF 0
+       JMS I .+2
+       CLA SKP
+       PUTCH
+
+       *XFINI-3        /TRAILER PRINTER
+       CLA CLL CMA RTL /3 CHARACTERS OF TRAILER
+
+       *XFINI-1        /ENDING SEQUENCE
+       CDF CIF 0
+       TAD L75         /PICK UP ERROR FLAG
+       JMP I .+1
+       EOFORT
+
+       *GOOON+4        /TRAILER AFTER "END" STATEMENT
+       CLA CLL CMA RTL /3 CHARS ETC.
+
+
+       *LTTYPE+1       /REVERSE TTY WAIT MODE
+       TLS
+       TSF
+       JMP .-1
+
+/
+*4753
+VERPRT,        0
+       JMS I   VPUNCH
+       CDF CIF 0
+       JMP I   VERPRT
+VPUNCH,        3372
+/
+       $
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape2/README b/sw/os8/v3d/sources/system/dectapes/dectape2/README
new file mode 100644 (file)
index 0000000..48ec621
--- /dev/null
@@ -0,0 +1,16 @@
+This area contains the files contained on system release DECtape #2.
+
+Directory of OS/8 V3D DECtape 2 labeled:  AL-4692C-SA     2/7/78
+                                         OS/8 V3D SRC DT  2 OF 7
+                                         (replaces DEC-S8-OSYSB-B-UA2)
+
+
+FORT  .PA 264 01-AUG-77    BAT   .PA  12 01-AUG-77
+FPATCH.PA  21 01-AUG-77    RK8ESY.PA  15 01-AUG-77
+SABR  .PA 296 01-AUG-77    RF08SY.PA   9 01-AUG-77
+SPATCH.PA  48 01-AUG-77    DF32SY.PA   9 01-AUG-77
+SABR  .CO  44 01-AUG-77    DF32NS.PA   8 01-AUG-77
+
+  10 files in  726 blocks -    4 free blocks
+
+
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape2/RF08SY.PA b/sw/os8/v3d/sources/system/dectapes/dectape2/RF08SY.PA
new file mode 100644 (file)
index 0000000..985049b
--- /dev/null
@@ -0,0 +1,182 @@
+/2 RF08 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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/MAINTENANCE RELEASE CHANGES:
+
+/1.    REMOVED SOFSET
+/2.    CHANGED LENGTH OF PLATTER
+
+       DF32=0
+       RF08=1
+       VERSION="B&77
+
+       *0
+       -1
+       DEVICE RF08;DEVICE SYS;4064;2007;0;1777
+
+       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    <SKP>
+       HLT             /ERROR READING SYSTEM IN
+ENDB,  JMP I B7605
+\f      /BOOTSTRAP FOR DISK MONITOR IS AS FOLLOWS:
+
+       /       LOCATION        CONTENTS
+       /       7750            7600
+       /       7751            6603
+       /       7752            6622
+       /       7753            5352
+       /       7754            5752
+\f      *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 <SKP        /SENSE OF SKIP IS REVERSED>
+       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     <IFNZRO .-7700  <NZERR>;        SKP;    HLT>
+       JMP SHNDLR+3
+SCIF,  CIF 0
+SYSCNT,        0
+       IFNZRO DF32     <IFNZRO .-7700  <NZERR>;        SKP;    HLT>
+S6603, 6603
+S70,   70
+S7400, 7400
+       IFNZRO  DF32 <S3700,    3700>
+       IFNZRO RF08 <S377,      377>
+       SCA=7751
+       SWC=7750
+       $
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape2/RK8ESY.PA b/sw/os8/v3d/sources/system/dectapes/dectape2/RK8ESY.PA
new file mode 100644 (file)
index 0000000..13c4377
--- /dev/null
@@ -0,0 +1,237 @@
+/3 RK8E SYSTEM HANDLER FOR OS/8 BUILD
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f      VERSION="C&77
+
+       *0
+
+       DECIMAL;RKLEN=3248;OCTAL
+
+       -3
+       DEVICE RK8E;DEVICE SYS;4231;2007;0;RKLEN
+       DEVICE RK8E;DEVICE RKA0;4231;1007;0;RKLEN
+       DEVICE RK8E;DEVICE RKB0;4231;SHNDL1&177+1000;0;RKLEN
+/ONE RK8E IS TREATED AS TWO LOGICAL DISKS
+/EACH OF 3248 OS/8 BLOCKS.
+
+/THIS HANDLER CONTAINS ENTRY POINTS FOR THE SYSTEM DEVICE
+/AND RKA1.
+/THIS HANDLER ALLOWS BOOTING OFF OF ANY UNIT
+
+       DCLR=6742
+       DLAG=6743
+       DLDC=6746
+       DRST=6745
+       DSKP=6741
+       DLCA=6744
+       DMAN=6747
+
+       RKEBLK=7750     /12 BITS OF BLOCK NUMBER
+       SERRCT=7751     /HOLDS RETRY COUNT
+       PAGCNT=7752     /PAGE COUNT
+       RKECMD=7753     /BASE OF DLDC COMMAND
+       CHKHED=7754     /CHECK HEADER FLAG
+
+/MAINTENANCE RELEASE CHANGES:
+
+/1.    FIXED BUG RE INTERACTION WITH NON-SYSTEM HANDLER
+/      [APRIL DSN]
+\f      BOOT-BLAST
+
+       RELOC 0
+
+BOOT,  TAD I BOOTX1
+       DCA I BOOTX2
+       TAD I BOOTX3
+       CDF 10
+       DCA I BOOTX4
+       CDF 0
+       TAD BOOTX2
+       SZA CLA
+       JMP BOOT
+       JMP I B7605
+BOOTX1,        177
+BOOTX2,        7577
+BOOTX3,        46
+BOOTX4,        7646
+
+       ZBLOCK  30-.    /DSKP GOES OVER 30
+
+       DSKP
+       JMP .-1
+       AND RK6
+       DCA I RKUNIT
+       JMP BOOT
+
+RK6,   6
+RKUNIT,        SYSUNT+400      /CHANGED BEFORE IT IS MOVED
+B7605, 7605
+BLAST, RELOC
+\f      /THE BOOTSTRAP IS RK8E ONLY
+       /30     6743
+       /31     5031
+
+       /LOAD ADDRESS 30 AND START
+
+/BOOTSTRAP FOR OTHER UNITS:
+
+/      25      7604
+/      26      6746
+/      27      6743
+/      30      7604
+/      31      5031
+
+/LOAD ADDRESS 25, PUT UNIT # IN BITS 9&10 OF SWITCH REGISTER,
+/CLEAR CONTINUE.
+\f      *200
+
+       RELOC 7600
+
+       ZBLOCK 7
+SHNDLR,        VERSION         /SYSTEM HANDLER ENTRY POINT
+       CLA CLL         /GUARD AGAINST RANDOM AC
+       TAD SHNDLR
+       DCA SHNDL1      /SETUP COMMON EXIT AND PARM ADDR'S
+       JMP SHNDC       /JUMP TO COMMON CODE
+
+/VARIOUS CONSTANTS TO PAD E.P. FOR RKA1 TO 7621
+S6260, 6260            /SIZE OF ONE LOGICAL DISK
+S4070, 4070            /USED TO GET READ/WRITE AND DF BITS
+S3700, 3700            / " TO GET PAGE COUNT
+SCIF,  CIF 0           / " TO RESTORE USERS FIELD
+S37,   37              /USED TO CHECK FOR CYLINDER CHANGE
+
+       IFNZRO .-7621 <ERROR1,  BARF>
+
+SHNDL1,        VERSION         /2ND E.P. FOR RKB0 AND TEMPORARY
+       CLA             /GUARD AGAINST NON-ZERO AC
+       TAD S6260       /RKB1 IS SECOND HALF OF PACK
+SHNDC, DCA SHNDLR      /SET BLOCK DISPLACEMENT ACCORDING TO SYS OR RKB0
+       CLA CLL CMA RTL /AC=-3
+       DCA SERRCT      /RETRY COUNT
+       RDF
+       TAD SCIF
+       DCA SFIELD      /RESET USER INST FIELD FOR EXIT
+RETRY, TAD SHNDL1      /AC=-2 IF ERROR ENRTY
+       DCA SHNDL1
+       TAD I SHNDL1    /GET ARG1
+       AND S4070       /GET R/W AND DF BITS
+       TAD SYSUNT
+       DCA RKECMD      /BASE COMMAND TO RK8E(DLDC)
+       TAD I SHNDL1    /GET ARG1 AGAIN
+       ISZ SHNDL1      /POINT TO ARG2
+       AND S3700
+       SNA
+       STL CLA RAR     /4000
+       DCA PAGCNT      /SAVE PAGE COUNT
+       TAD I SHNDL1    /GET ARG2
+       ISZ SHNDL1      /POINT TO ARG3
+       DLCA            /LOAD CURRENT ADDRESS REGISTER
+       TAD I SHNDL1    /GET ARG3
+       CLL     
+       TAD SHNDLR      /SYS OR RKB0 DISPLACMENT
+       DCA RKEBLK      /LOW PART OF RK8E BLOCK NUMBER
+       SZL             /STILL OFF IF BELOW BLOCK 10000
+OVRFLO,        ISZ RKECMD      /TURN ON EXTENDED BIT IF OVERFLOWED
+RELOOP,        DCA CHKHED      /SET CHECK HEADER FLAG TO EITHER
+                       /0 OR 4000(WHICH GETS RTR'D BEFORE USED)
+                       /AND CAUSES EITHER A "DATA" OR "ALL"
+                       /TRANSFER
+       TAD PAGCNT      /TEST TO SEE IF ONLY 1 PAGE WANTED
+       AND S7600
+       SNA CLA
+       TAD S400        /100 WAS IN PAGCNT
+       TAD CHKHED      /ADD IN CHECK HEADER FLAG
+       CLL RTR         /SHIFT TO CORRECT BITS
+       TAD RKECMD      /ADD IN BASE COMMAND
+       DLDC            /LOAD COMMAND REGISTER
+       TAD RKEBLK
+       DLAG            /LOAD BLOCK REGISTER AND GO
+       DSKP            /WAIT ON FLAG
+       JMP .-1
+       DRST            /READ COMPLETION REGISTER
+       CLL RAL         /GET RID OF SUCCESS BIT
+       SZA CLA         /AND SEE IF ANYTHING LEFT
+       JMP SERROR      /AN ERROR
+       IFNZRO .-7700 <ERROR2,  DOUBLE BARF>
+       SKP             /PROTECTION AGAINST JMS I 7700 FIELD 0
+       HLT             /HE'S HAD IT
+       TAD PAGCNT
+       TAD S7600
+       SPA SNA
+       JMP RKDONE
+       DCA PAGCNT
+       TAD RKEBLK
+       CMA
+       AND S37         /IF BLOCK IS AT A 37 MAKE
+                       /NEXT OPERATION DO A CHECK HEADER
+       SZA CLA
+       STL RAR         /SET AC TO "ALL" FLAG
+       ISZ RKEBLK      /BUMP BLOCK NUMBER
+       JMP RELOOP      /TRANSFER SOME MORE
+       JMP OVRFLO      /PAST BLOCK 7777-SET EXTENDED BIT
+\f                      /RECALIBRATE ON ALL ERRORS
+SERROR,        DCLR            /CLEAR STATUS REGISTER
+       STL RTL         /AC=2
+       DCLR            /RECALIBRATE DRIVE
+       DSKP            /WAIT ON FLAG
+       JMP .-1
+       DCLR            /CLEAR STATUS REGISTER
+       DRST            /WAIT FOR STATUS TO CLEAR
+       SZA CLA
+       JMP .-3         /V3C STILL DOING RECALIBRATE
+       CLA CLL CMA RAL /AC=-2
+       ISZ SERRCT      /SKIP IF WE TRIED 3 TIMES
+       JMP RETRY       /TRY AGAIN
+       JMP .+3         /ERROR EXIT
+RKDONE,        ISZ SHNDL1      /NORMAL RETURN
+S7600, 7600            /GROUP 2 CLA
+       ISZ SHNDL1      /IF JUMPED TO HERE- ERROR RETURN
+SFIELD,        HLT             /RESET USERS INST FIELD- WE NEVER TOUCHED DF
+       JMP I SHNDL1    /EXIT
+
+S400,  400             / " FOR 128 WORD TRANSFER MODE(RTR'D IN CODE)
+SYSUNT,        0               /SYSTEM DEV UNIT # (SET BY BOOTSTRAP)
+       RELOC
+       $
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape2/SABR.CO b/sw/os8/v3d/sources/system/dectapes/dectape2/SABR.CO
new file mode 100644 (file)
index 0000000..4649a85
--- /dev/null
@@ -0,0 +1,422 @@
+/SABR ASSEMBLER, V17
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT  (C)  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 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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/NOTE: WHENEVER ABOVE VERSION NUMBER IS CHANGED
+/BE SURE TO ALSO CHANGE VERSION NUMBER FOR TYPEOUT.
+/THIS IS AT VERSN+13 (ABOUT P. 83)
+/
+/THERE ARE TWO BASIC PHASES OF OPERATION WITHIN
+/SABR:(A) COLLECTION AND (B) ASSEMBLY. IN PASS 1
+/SABR COLLECTS A FULL PAGE OF DATA AND THEN
+/ASSEMBLES THE FULL PAGE. IN PASS2 COLLECTION
+/AND ASSEMBLY ARE CARRIED OUT ON A LINE-
+/BY-LINE BASIS RATHER THAN PAGE-BY-
+/PAGE. FOLLOWING IS A DESCRIPTIVE FLOW CHART OF
+/THE PRINCIPAL METHODS OF OPERATION USED IN
+/THE PROGRAM DURING PASS1.
+/(1) BEGINNING AT START THERE ARE TWO ROUTINES NECESSARY
+/TO INTIALIZE THE ENTIRE PROGRAM. IOINIT CARRIES
+/OUT THE DIALOG WITH THE USER TO DETERMINE WHICH
+/I/O DEVICES WILL BE USED. INITA INTIALIZES ALL
+/THE FLAGS AND TABLES WHICH ARE USED CONTINOUSLY
+/THROUGHOUT THE PROGRAM.
+/(2) THE DRIVER FOR THE FULL PAGE-BY-PAGE ASSEMBLER
+/IS CONTAINED IN THE LOOP THAT RUNS FROM RSTRT
+/TO RSTRT6-1. THIS LOOP OPERATES AS FOLLOWS.
+/FIRST IT CALLS INILPT WHICH INITIALIZES ALL
+/THOSE FLAGS AND TABLES WHICH MUST BE
+/REFRESHED OR REBUILT FOR EACH PAGE OF CODE.
+/THEN IT CALLS THE MAIN LINE-BY-LINE
+/COLLECTION LOOP (WHICH IS DESCRIBED IN ITEM 3).
+/WHEN A FULL PAGE OF CODE HAS BEEN COLLECTED
+/THE DRIVER THEN CALLS L55 TO ASSEMBLE THE
+/PAGE (SEE ITEM 8).
+/(3) THE COLLECTION LOOP RUNS FROM RSTRT1 THROUGH
+/THE CODE AT RSTRT6. THIS LOOP FIRST CALLS
+/INCPT WHICH PREPARES FLAGS AND INCREMENTS
+/TABLE POINTERS FOR EACH LINE OF CODE. IT
+/THEN CALLS THE LINE DECODER DCIL (SEE
+/ITEM 4) FOLLOWED BY SETCT, THE ROUTINE WHICH
+/INCREMENTS THE PAGE COUNTERS AS REQUIRED
+/FOR THE GIVEN LINE (SEE ITEM 6). THEN
+/THE COLLECTIONS LOOP PROCEEDS TO INTERPRET
+/THE DATA LEFT BY DCIL AND STORE IT, PROPERLY
+/CODED, ON THE PAGE TABLE. IF THERE WAS
+/A TAG ("LFS" FOR "LOCATION FIELD SYMBOL") IT
+/IS NECESSARY TO CALL RECT FOR A PAGE RECOUNT.
+/(SEE ITEM 7). THEN THE SIZE OF THE PAGE SO
+/FAR COLLECTED IS TALLYED UP BY CPGES. IF
+/IT IS STILL .LE. 200. EVERYTHING IS FINE AND WE
+/RUN THROUGH THE LOOP AGAIN. IF NOT WE
+/FIRST SAVE (USING PUSHIN)
+/ALL THE KEY INFORMATION ABOUT THE LINE WHICH
+/CAUSED THE OVERFLOW AND THEN EXIT FROM THE
+/COLLECTION LOOP TO ASSEMBLE THE PAGE.
+/(4) CERTAIN NOTES ABOUT DCIL MAY BE HELPFUL. THIS
+/ROUTINE CONTROLS INPUT OF THE SOURCE. INDEV
+/(SET BY IOINIT) POINTS TO THE PROPER INPUT
+/ROUTINE, HSR OR ASR. THESE ROUTINES
+/READ ONE CHARACTER AT A
+/TIME FROM THE INPUT DEVICE. THE ROUTINE CALLED
+/R DRAWS CHARACTERS ONE AT A TIME FROM THE
+/INPUT BUFFER (DATA). WHEN THIS BUFFER IS
+/EMPTY R REFILLS IT USING @INDEV. FETCH
+/USES R TO EXTRACT ONE CHARACTER AT A TIME FROM
+/THE INPUT BUFFER AND DOES SOME PRELIMINARY
+/SCREENING. RLN USES FETCH TO READ A
+/FULL LINE OF CODE INTO THE LINE BUFFER.
+\f/L65 READS ONE CHARACTER AT A TIME FROM
+/THE LINE BUFFER. GTSYM READS THE LINE
+/ITEM-BY-ITEM. IF THE ITEM IS A SYMBOL, GTSYM
+/CALLS SRSYM TO LOOK UP THE ITEM IN THE
+/MAIN SYMBOL TABLE OR ENTER IT IF IT IS NOT
+/ALREADY THERE(SEE ITEM 5).
+/**IMPORTANT**
+/WHEN A SYMBOL HAS BEEN PLACED ON THE SYMBOL
+/TABLE THE ADDRESS OF THE FIRST WORD OF THE
+/ENTRY IS RETURNED AT "SYMBOL." THIS ADDRESS
+/IS UNIQUE FOR EACH SYMBOL AND IN THE
+/RANGE 2000-7575. THIS NUMBER IS USED
+/THROUGHOUT THE PROGRAM AS THE IDENTIFIER FOR
+/THIS SYMBOL. ** DCIL CONSIDERS EACH ITEM
+/OF THE LINE AND ACTS APPROPRIATELY. FOR
+/STANDARD INSTRUCTIONS A STRING OF KEY DATA ABOUT
+/THE LINE IS LEFT. IF THE LINE IS A PSUEDO-OP
+/DCIL WILL IMMEDIATELY CALL THE APPROPRIATE PSUEDO-OP
+/HANDLER TO TAKE ALL NECESSARY ACTION. MOST
+/OF THE PSUEDO-OP HANDLERS RETURN TO THE
+/BEGINNING OF DCIL WHERE THE NEXT LINE CAN BE
+/PROCESSED AS IF NOTHING UNUSUAL HAPPENED. THE
+/EXCEPTIONS TO THIS ARE THOSE PSUEDO-OPS WHICH
+/CAUSE A PREMATURE PAGE ASSEMBLY.
+/THE ROUTINE SKIPL IS ACTUALLY A SMALL PART OF
+/DCIL. IT HAS TWO PURPOSES. ONE, IT WATCHES
+/FOR LINES WHICH SHOULD BE IGNORED BECAUSE THE
+/FORTR PSUEDO-OP IS IN EFFECT. SECONDLY IT
+/MUST WATCH FOR SEMI-COLONS SO THAT
+/IF ONE IS ENCOUNTERED(OUTSIDE A COMMENT)
+/THE REMAINDER OF THE LINE CAN BE SAVED FOR
+/PROCESSING AS THE "NEXT" LINE.
+/(5)ONLY TWO MAIN ROUTINES SRSYM AND
+/OBSYM, TOGETHER WITH THEIR SUBSIDIARYS RUSVL AND SUSVL
+/MAY DIRECTLY CONTACT THE MAIN SYMBOL TABLE.
+/THESE ROUTINES COMMUNICATE WITH THE REST OF
+/THE PROGRAM THROUGH FOUR IMPORTANT
+/CELLS IN PAGE 0:
+/USE CONTAINS THE CODE WORD FOR THE SYMBOL ENTRY.
+/VAL CONTAINS THE VALUE OF THE SYMBOL.
+/SYMBOL CONTAINS THE ADDRESS OF THE FIRST WORD OF THE
+/ENTRY(NAMELY THE CODE WORD).
+/VALPTR CONTAINS THE ADDRESS OF THE VALUE WORD
+/OF THE ENTRY.
+/SRSYM, AFTER LOCATING A GIVEN SYMBOL IN THE TABLE
+/(OR ENTERING IT IF NECESSARY)
+/CALLS SUSVL TO FILL THE FOUR CELLS WITH THE
+/PROPER INFORMATION ABOUT THE SYMBOL.
+
+\f/OBSYM USES A SYMBOL IDENTIFIER TO GET
+/THE FOUR ESSENTIAL BITS OF INFORMATION, AGAIN
+/CALLING SUSVL TO DO THE WORK. HOWEVER
+/BEFORE EITHER SRSYM OR OBSYM DO ANYTHING
+/THEY BOTH MAKE USE OF RUSVL. RUSVL IS A
+/VERY IMPORTANT ROUTINE. HERE IS HOW IT WORKS.
+/LET US SUPPOSE THAT THE PROGRAM HAS OBTAINED
+/USE, VAL, SYMBOL AND VALPTR FOR A GIVEN
+/SYMBOL(USING SRSYM OR OBSYM). FURTHER, LET
+/US SUPPOSE THAT THE PROGRAM WISHES TO
+/MODIFY BOTH OR EITHER OF THE CODE AND VALUE
+/WORDS FOR THIS SYMBOL IN THE SYMBOL TABLE.
+/THE PROGRAM DOES NOT DIRECTLY ACCESS THESE
+/WORDS IN THE SYMBOL TABLE. INSTEAD THE
+/PROGRAM MERELY MAKES THE DESIRED MODIFICATIONS
+/TO USE AND VAL. NOW SYMBOL AND VALPTR
+/ARE THE POINTERS FOR STORING THIS NEW INFORMATION
+/BACK IN THE TABLE. IT IS VERY IMPORTANT THAT
+/NO PART OF THE PROGRAM EXCEPT SRSYM AND OBSYM
+/EVER MODIFY SYMBOL OR VALPTR, AND BEFORE
+/EITHER OF THESE MODIFY THEM THEY ALWAYS CALL
+/RUSVL. RUSVL TAKES USE AND VAL
+/INCLUDING ANY MODIFICATIONS THAT HAVE BEEN
+/MADE TO THEM AND STORE THESE WORDS BACK
+/IN THE TABLE USING THE STILL UNCHANGED POINTERS
+/SYMBOL AND VALPTR. IN THIS WAY MODIFICATIONS
+/TO THE SYMBOL TABLE ARE MADE IN TWO STAGES.
+/THE FIRST STAGE CONSISTS OF A SIMPLE REFERENCE
+/TO ONE OF TWO PAGE 0 LOCATIONS, AND THE
+/SECOND STAGE IS TAKEN CARE OF AUTOMATICALLY
+/DURING FURTHER OPERATION OF THE PROGRAM.
+/(6)SETCT AND CPGES DEAL WITH FIVE SEPARATE PAGE
+/COUNTERS. THE SUM OF THESE IS THE NUMBER
+/OF WORDS OF CORE NECESSARY TO ASSEMBLE THE CURRENT
+/COLLECTED DATA. PTSZE (PAGE TABLE SIZE) IS THE
+/NUMBER OF ITEMS - CONSTANTS,ADDRESS PARAMETERS
+/AND INSTRUCTIONS - WHICH HAVE BEEN SO FAR
+/COLLECTED. LTSZE IS THE NUMBER OF DISTINCT LITERALS
+/WHEN ARE REQUIRED ON THE CURRENT PAGE. PGEESC
+/WILL BE EITHER 2 OR 4. IT IS
+/2 IF THE LAST COLLECTED INSTRUCTION WAS NOT A
+/SKIP INSTRUCTION, 4 OTHERWISE. THESE ARE THE
+/NUMBER OF WORDS REQUIRED FOR THE PAGE
+/ESCAPE. THIS ITEM IS IGNORED WHEN THE AUTO-
+/MATIC PAGING SWITCH IS NON-ZERO. OPSCTR
+/IS THE NUMBER OF POINTERS TO OFF-PAGE SYMBOLS
+/WHICH ARE REQUIRED ON THE CURRENT PAGE.
+
+\f/THIS ITEM IS DETERMINED BY USE OF THE
+/PAGE SYMBOL TABLE. TWO TYPES OF SYMBOLS
+/ARE STORED ON THIS TABLE: TAGS(LFS'S) ON THE
+/CURRENT PAGE AND SYMBOLS WHICH ARE REFERENCED
+/BY MEMORY REFERENCE INSTRUCTIONS(AFS'S) ON THE
+/CURRENT PAGE. IN THIS TABLE SABR KEEPS TRACK OF
+/WHETHER THE SYMBOL IS ON-PAGE(I.E. IF IT OCCURS AS
+/A TAG ON THE PAGE) AND WHETHER IT HAS BEEN
+/REFERENCED EITHER SIMPLY OR WITH A NUMBER SIGN
+/(MEANING <SYM>+1). IF THE SYMBOL IS OFF-PAGE
+/AND HAS BEEN REFERENCED ON THE PAGE, ONE POINTER
+/IS REQUIRED ON THE ASSEMBLED PAGE FOR
+/EACH TYPE OF REFERENCE USED (SIMPLE OR #).
+/IN ADDITION CERTAIN INFORMATION REGARDING OBACTR
+/IS KEPT IN THE P.S.T. OBACTR KEEPS COUNT OF
+/THE NUMBER OF EXTRA INSTRUCTIONS WHICH MUST
+/BE GENERATED ON THE CURRENT PAGE. THESE
+/INCLUDE CDF'S TO CURRENT BANK (CODE05 6201'S),
+/CDF 00'S FOR REFERENCE TO COMMON,                     /(*)
+/JMS CDFSK/SKP PAIRS FOR CDF CUR'S FOLLOWING
+/SKIP INSTRUCTIONS, AND JMS CDZSK/SKP PAIRS FOR
+/CDF 00'S FOLLOWING SKIP INSTRUCTIONS. SUCH
+/CDF'S ARE NEEDED FOR OFF-PAGE REFERENCES WHENEVER
+/THE BANK REFERENCED IS NOT THE SAME AS PREVIOUSLY
+/(0 INSTEAD OF CURRENT=1 OR VICE-VERSA) OR WHEN
+/THE BANK IS UNKNOWN (=-1) AS AFTER A TAG,
+/AT THE START OF A PAGE, OR FOR ALL JMS'S.
+/OBACTR ALSO KEEPS COUNT OF EXTRA INSTRUCTIONS
+/NEEDED TO GENERATE OFF-PAGE INDIRECT REFERENCES.
+/FOR THESE EITHER 2 OR 4 EXTRA INSTRUCTIONS
+/ARE NEEDED DEPENDING ON WHETHER OR NOT THE
+/PREVIOUS INSTRUCTION WAS A SKIP INSTRUCTION.
+/IN THE PST AN UP-TO-DATE RECORD IS KEPT OF THE
+/NUMBER OF INCREMENTS TO OBACTR SPECIFICALLY
+/DUE TO EACH OFF-PAGE SYMBOL. IN VIEW
+/OF THE RECOUNT PROCEDURE DESCRIBED IN ITEM 7
+/IT WOULD SEEM THAT THIS INFORMATION IS REDUNDANT
+/AND UNNECESSARY. HOWEVER, DURING THE DEBUGGING
+/STAGE OF THE PROGRAM WITH PASS 2 INCLUDED
+/I ENCOUNTERED SEVERAL SITUATIONS, WHICH I FIND
+/VERY DIFFICULT TO DESCRIBE, WHERE MORE IMMEDIATE
+/INFORMATION ABOUT OBACTR WAS NEEDED. I
+/AM NOT EVEN COMPLETELY SURE I UNDERSTAND WHY.
+/OBACTR MUST BE WATCHED CLOSELY. AT 6652 IN THE
+/PROGRAM THERE IS SOME CODE TO ASSIST IN
+/DEBUGGING THE PROGRAM IF PROBLEMS ARISE WITH
+/THE PAGE COUNT.
+/WHENEVER A NEW TAG IS ENCOUNTERED ON A
+/PAGE, SETCT USES CPLFS TO REDUCE
+/BOTH OPSCTR AND OBACTR APPROPRIATELY
+/SINCE WHAT PREVIOUSLY WERE OFF-PAGE REFERENCES
+/MAY NOW HAVE BECOME ON-PAGE REFERENCES.
+\f/(7) WHENEVER A TAG IS ENCOUNTERED ON A GIVEN
+/PAGE RECT IS CALLED TO GO THROUGH THE
+/ENTIRE CURRENT PAGE TABLE AND RECOUNT
+/THE PAGE. IT DOES THIS BY CALLING SETCT
+/AGAIN, ONCE FOR EACH ITEM ON THE PAGE TABLE.
+/THE ONLY THING REALLY ACCOMPLISHED HERE
+/IS THAT OBACTR IS RESET. OPSCTR IS
+/UNCHANGED AS WELL AS THE OTHER PAGE COUNTERS.
+/THE NEED TO RECOUNT OBACTR IS SHOWN
+/BY THE FOLLOWING EXAMPLE:
+/      A, TAD   B
+/         TAD   C
+/      B, 0
+/         <PAGE FILLS UP>
+/      C, 0
+/NOW BECAUSE BANK IS UNKNOWN AFTER "A,"
+/AND B IS UNDEFINED AS YET, "TAD B"
+/REQUIRES A CDF CUR. HENCE INCREMENT OBACTR.
+/"TAD C" IS OFF PAGE TOO, BUT REQUIRES NO
+/CDF SINCE IT IS IN THE SAME BANK.
+/HOWEVER WHEN B IS DEFINED ON PAGE, THE
+/CDF IT CAUSED IS NO LONGER NECESSARY,
+/BUT NOW THE "TAD C" REQUIRES A CDF.
+/(8) THE ROUTINE L55 CAUSES EACH PAGE TO BE ASSEMBLED.
+/DURING PASS 1 THERE ARE TWO SUB-PHASES TO THE ASSEMBLY.
+/FOR THE MOST PART BOTH PHASES RUN THROUGH THE
+/ENTIRE PAGE OF COLLECTED CODE USING THE
+/SAME ASSEMBLY ROUTINES. THE DIFFERENCE IS
+/THAT DURING PHASE 1 (ACTR=0)
+/ACTUAL OUTPUT IS SUPPRESSED. THE KEY
+/PURPOSE OF PHASE 1 IS TO DEFINE ALL THE
+/TAGS THAT OCCUR ON THE PAGE. CLEARLY THE
+/TAGS COULD NOT BE DEFINED DURING COLLECTION
+/BECAUSE AT THAT POINT WE WERE NOT SURE
+/WHAT SYMBOLS EVEN WERE ON PAGE, AND THUS
+/NOT SURE HOW MANY EXTRA INSTRUCTIONS
+/WOULD BE NECESSARY. THUS SUB-PHASE 1 OF THE
+/ASSEMBLY IS REQUIRED SO THAT IN THE
+/SECOND PHASE OF THE ASSEMBLY ON-PAGE
+/FORWARD REFERENCES CAN BE RESOLVED. HENCE
+/L55 CALLS THE ASSEMBLY ROUTINE ASMBL
+/TWICE FOR EACH PAGE OF CODE.
+/(9)AFTER INITIALIZING THE VARIOUS PAGE TABLE POINTERS
+/ASMBL GOES INTO A LOOP WHEREIN THE
+/LINE-BY-LINE ASSEMBLY ROUTINE ASM02 IS
+/CALLED ONCE FOR EACH ITEM ON THE PAGE TABLE.
+/ASM02 IS A HUGE ROUTINE OCCUPYING ABOUT
+/THREE FULL PAGES OF CODE. ASM02 FIRST
+\f/EXAMINES THE CODED DATA PERTAINING TO THE GIVEN
+/ITEM ON THE PAGE TABLE TO DETERMINE WHAT
+/TYPE OF INSTRUCTION IS TO BE ASSEMBLED AND
+/WHAT THE CURRENT BANK AND SKIP SETTINGS
+/ARE.  THEN DEPENDING ON THIS ANALYSIS THE ROUTINE
+/TRANFERS TO THE PROPER SUBSECTION OF ITSELF
+/FOR HANDLING THIS TYPE OF INSTRUCTION. THERE
+/ARE A DOZEN OR MORE CASES WHICH MUST
+/BE DEALT WITH. THEN THE ROUTINE MOVES
+/TO ONE OF ITS VARIOUS EXIT STRINGS
+/TO COMPLETE THE ACTION AND SET THE BANK AND
+/SKIP CONDITIONS FOR THE NEXT LINE. AFTER ALL
+/ITEMS ON THE PAGE TABLE HAVE BEEN ASSEMBLED
+/IN THIS WAY ASMBL THEN CALLS THE ROUTINE
+/A2. A2 PRODUCES (IN PHASE 2) THE PAGE ESCAPE AND
+/THEN OUTPUTS THE ENTIRE LITERAL TABLE WITH
+/ALL THE OFF-PAGE POINTERS INTERMINGLED.
+/(10) SPECIAL CONSIDERATION SHOULD BE GIVEN TO OFF-
+/PAGE FORWARD REFERENCES SINCE THEY WILL REMAIN
+/UNRESOLVED WHEN THE CURRENT PAGE HAS BEEN
+/ASSEMBLED. DURING ASSEMBLY WHEN 
+/A REFERENCE TO AN OFF-PAGE, OR AN AS YET
+/UNDEFINED SYMBOL IS ENCOUNTERED THE SYMBOL'S
+/IDENTIFIER IS STORED ON THE LITERAL/OFF-PAGE POINTER
+/TABLE. THEN WHEN A2 IS OUTPUTTING THE
+/LITERAL TABLE ANY STILL UNDEFINED SYMBOLS ARE
+/DEALT WITH AS FOLLOWS. THE SYMBOL'S INDENTIFIER
+/TOGETHER WITH THE LOCATION RESERVED IN THE CURRENT
+/PAGE FOR ITS VALUE ARE STORED ON THE OCCURRENCE
+/TABLE. THE LOCATION WHERE THE POINTER MUST BE
+/STORED IN THE CURRENT PAGE IS MERELY LEFT
+/BLANK AT THIS TIME. THEN LATER ON WHEN THIS SYMBOL IS
+/ENCOUNTERED AS A TAG THE ROUTINE LFSCK
+/WHICH PROCESSES TAGS DURING ASSEMBLY WILL
+/REMOVE THE ITEM FROM THE OCCURRENCE TABLE AND
+/OUTPUT IT PRECEEDING THE POINTER BY AN ORIGIN
+/TO THE CORRECT LOCATION.
+/(11) DURING PASS2 (THE LISTING PASS) MOST OF
+/THE SAME CODE IS USED TO PRODUCE THE
+/ASSEMBLY LISTING. HOWEVER THE TIMING IS
+/DIFFERENT. NOW THE COLLECTION-ASSEMBLY
+/ALTERATION IS CARRIED OUT ON A LINE-BY-LINE
+/BASIS RATHER THAN ON A PAGE-BY-PAGE BASIS.
+/(HOWEVER ALL THE PAGE TABLES AND COUNTERS MUST
+/STILL BE MAINTAINED JUST AS IN PASS1.) THE
+/PASS2 OPERATION DIFFERS FROM PASS1 IN THE
+\f/FOLLOWING RESPECTS. EACH TIME A LINE HAS
+/BEEN COLLECTED AND ITS DATA ENTERED INTO THE
+/PAGE TABLE IN THE NORMAL FIRST PASS WAY,
+/A CALL IS ISSUED TO THE LINE-BY-LINE
+/ASSEMBLY ROUTINE ASM02. SINCE ALL SYMBOLS
+/ARE NOW DEFINED THERE WILL BE NO UNRESOLVED
+/FORWARD REFERENCES ON OR OFF-PAGE. ASM02 ACTS
+/DURING PASS2 EXACTLY AS IT DOES DURING PASS1
+/WITH ONE BIG EXCEPTION: THE BINARY OUTPUT ROUTINE
+/OUTBN IN SUPPRESSED AND IN ITS PLACE IS
+/SUBSTITUTED THE LISTING ROUTINE WRITE.
+/WHEN THE PAGE COUNTERS INDICATE THAT THE PAGE
+/IS FULL THE DRIVER ROUTINE WILL CALL L55 AS
+/USUAL. HOWEVER IN PASS2 THE TWO CALLS
+/TO ASMBL ARE BY-PASSED AND INSTEAD A SINGLE
+/CALL TO A2 IS ISSUED SO AS TO GET THE
+/LISTING TO THE PAGE ESCAPE, THE LITERALS AND
+/THE OFF-PAGE POINTERS.
+/(12) THE REASON FOR HAVING SEPARATE LITERAL TABLES FOR THE
+/COLLECTION AND THE ASSEMBLY PHASES OF
+/THE PROGRAM IS THAT DURING PASS2 BOTH
+/PHASES OF THE PROGRAM ARE OPERATING SIMUTANEOUSLY
+/AND BOTH ARE BUILDING LITERAL TABLES IN A
+/DIFFERENT WAY.
+/(13) THE PAGE ESCAPE TABLE, PEBSE, IS NECESSARY
+/IS THAT DURING PASS2 LOCATIONS
+/CANNOT BE ASSIGNED FOR LITERALS AND OFF-PAGE
+/POINTERS UNLESS THE FINAL PAGE ESCAPE
+/FOR THE PAGE IS KNOWN. HENCE THESE NUMBERS
+/ARE SAVED DURING PASS1.
+/(14) THE PAGE OP TABLE IS ACTUALLY A PART OF
+/THE PAGE TABLE.
+/(15) EXTERNAL SYMBOLS ARISE IN TWO WAYS:
+/FROM ENTRY STATEMENTS AND FROM CALL STATEMENTS.
+/THEY ARE ENTERED IN THE E.S.T. IN ORDER OF
+/APPEARANCE IN THE PROGRAM AND NUMBERED
+/ACCORDINGLY. THESE ARE THE NUMBERS WHICH THE
+/LOADER REFERS TO AS "LOCAL EXTERNAL NUMBERS."
+/(16) EQUIVALENCING OF TAGS
+/IS TREATED AS A PSEUDO-OP AND IS
+/HANDLED BY THE ROUTINE PBSS2. (INCIDENTALLY
+/SOME OF THE ODD NAMES IN THE SOURCE WERE
+/PASSED ON TO ME FROM THE ORIGINAL ICS
+/PROGRAM. I DID NOT CHANGE THEM MERELY BECAUSE
+/THEY MADE NO SENSE.) THE OPERATION IS THIS:
+/ALL EXTRA TAGS TO BE DEFINED AT A GIVEN LOCATION ARE
+/ENTERED AS A GROUP IN THE EQUIVALENCE TABLE,
+/AND A CODE BIT IS SET ON THE PAGE TABLE TO
+/INDICATE THAT SUCH A GROUP IS TO BE DEFINED
+/WHEN THE LOCATION HAS BEEN DETERMINED DURING
+/ASSEMBLY. ANUMCK DOES THE WORK OF DEFINITION.
+\f/(*)
+/V03   CHANGE NOTICE:
+/      AS OF V03 THE SABR SYSTEM HAS
+/      BEEN CHANGED SUCH THAT COMMON
+/      WILL RESIDE IN FIELD 1 INSTEAD
+/      OF FIELD 0.
+/      THE ONLY CHANGES REQUIRED TO SABR
+/      ITSELF ARE AS FOLLOWS
+/      (1) HICOM=177 INSTEAD OF 777;
+/      (2) PARG & ASMBL MUST NOW OUTPUT 6211'S
+/      INSTEAD OF 6201'S FOR CDF'S TO COMMON.
+/      NOTE:
+/      THE COMMENTS HAVE NOT BEEN CHANGED TO
+/      REFLECT THIS CHANGE.
+/      ALSO, BANK = 0 IS STILL THE CONDITION
+/      FOR REFERENCES TO COMMON. (BANK=1
+/      STILL MEANS BANK KNOWN TO BE CURRENT
+/      AND BANK = -1 STILL MEANS BANK UNKNOWN.)
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape2/SABR.PA b/sw/os8/v3d/sources/system/dectapes/dectape2/SABR.PA
new file mode 100644 (file)
index 0000000..32107b2
--- /dev/null
@@ -0,0 +1,5589 @@
+/SABR ASSEMBLER V18
+/
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/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.
+/
+/
+/
+/
+/
+/
+\f/     VERSION SABR.17
+/      OCTOBER 26, 1971
+/      C. MCCOMAS
+/      R. LARY
+/      B. CLOGHER
+/SABR.V17  DEC-08-A2D2-17
+/      OCTOBER 26,1971
+/COPYRIGHT      1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD MASSACHUSETTS 01754
+/              C. MCCOMAS/R. LARY/B. CLOGHER
+
+
+//
+/
+/FIXES TO SABR FOR V18         J.K 1975
+/
+/ .LITERAL POOL OVERFLOW
+/ .INCORRECT LINE NUMBER WITH ERROR MESSAGE
+/
+/
+/ASSEMBLY, LOAD AND SAVE INSTRUCTIONS
+/
+/      .PAL SABR.PA
+/      .PAL SPATCH.PA
+/
+/      .LO SABR$SPATCH$
+/
+/      .SA SYS SABR
+/
+/
+FIELD 1
+/
+/
+/      DEFINE LOCATIONS OF MONITOR SUBROUTINES
+/
+DISPL=10
+CDFSK=35+DISPL
+CDZSK=41+DISPL
+DUMS=57+DISPL
+LINK=23+DISPL
+OBIS=45+DISPL
+OPIS=52+DISPL
+RTN=30+DISPL
+
+
+*1
+USE,   0
+VAL,   0
+SYMBOL,        0       /PTR TO CURRENT USE WORD IN MST
+M7,    -7
+AS0,   S0
+OTP,   CORE1-1         /OCC. TAB. PTR (NEXT FREE WORD BELOW)
+STT,   STTP            /PTR TO 1ST FREE WORD OF SYM. TAB.
+                       /(KEEP STT AFTER OTP FOR INITA)
+
+X0,    0               /LINE BUFFER INDEX
+X1,    0               /TEMP AUTOS
+X2,    0
+X3,    0               /HSR BUFFER INDEX
+
+K2,    2
+K4,    4
+K3,    3
+K130,  130
+K30,   30
+
+/      INDIRRECT REFERENCES
+/
+ICPLFS, CPLFS          /CHECK FOR AND PROCESS COLLECTION LFS
+CPGESI,        CPGES
+CTYPE, L61             /CHARACTER TYPEOUT ROUTINE
+CRLF,  L73
+DUMMY, DUM             /DUMMY ROUTINE
+GETCHR, L65            /ROUTINE TO READ NEXT CHAR
+GETSYM, GTSYM          /ROUTINE TO  INPUT AND DECODE NEXT SYMBOL
+INI,   INILPT
+LFSCHK, LFSCK          /CHECK FOR A LFS
+OBSYM, OBNSYM          /OBTAIN SYMBOL FROM MST
+DCIL1, RDL1
+NULLP, NULL
+OTYPE,  L62            /OCTAL TYPEOUT ROUTINE
+OUTBIN, OUTBN          /ROUTINE TO OUTPUT COMP WORD AND REL BITS
+OUTSKP,        OUTSK           /ROUTINE TO OUTPUT A SKIP INSTRUCTION
+POPEXP,        POPEX
+PRSYMP,        PRSYM
+PUNCH, L63             /BINARY PUNCH ROUTINE
+RDIL,  DCIL            /READ AND DECODE ONE INPUT LINE
+RECTI, RECT
+L55I,  L55
+SKIPL, L72             /SKIPS UNTIL A RETURN OR SEMICOLON
+SLITAB, SLTAB          /SEARCH LITERAL TABLE
+SPSTAB, SPSTB          /SEARCH PAGE SYMBOL TABLE
+SREST, L66             /ROUTINE TO SEARCH EXTERNAL SYMBOL TABLE
+STCE,  SETCT
+TEST,  TSCHR           /ROUTINE TO TEST CHARACTERS FOR EQUALITY
+TYPE,  L64             /TTY TYPE ROUTINE
+WLNP,  WLN
+WRITEP,        WRITE
+/
+/      IMPORTANT VARIABLES
+/
+ACTR,  0               /ASSEMBLY COUNTER
+BSSSW, 0               /BSS 0 IN PROCESS SWITCH
+CHR,   0               /LOC TO HOLD CURRENT CHARACTER
+CSUM,  0               /BINARY CHECK SUM
+EQVOPR,        EQUTB           /EQUIVALENCE TABLE OUTPUT POINTER
+EQVIPR,        EQUTB                   /EQ. TB. INPUT PTR.
+ILC,   0               /CURRENT LOCATION
+LFSPTR, 0              /POINTER TO LFS TABLE ENTRY
+LINE,  0               /NO OF LINES SINCE LAST LFS
+LITSZE, 0              /SIZE OF LIT TAB (ASM PHASE)
+LTSZE, 0               /SAME FOR COLL. PHASE
+LSTSKP, 0              /LAST INSTRUCTION SKIP INDICATOR
+LSTBNK, 0              /LAST INSTRUCTION BANK INDICATOR
+OBACTR, 0              /OFF BANK INSTRUCTION ADDITION COUNTER
+OPSCTR, 0              /OFF PAGE SYMBOL COUNTER
+/***** KEEP ITEMS SO INCLOSED IN THE GIVEN ORDER FOR INITA
+HICOM, 0177
+PAG,   0200            /CURRENT PAGE BITS
+ESTSIZ, 0              /HOLDS SIZE OF EXTERNAL SYMBOL TABLE
+EQVBIT,        0
+APMSW, 0               /AUTOMATIC PAGING MODE SWITCH
+TEM7,  1               /SPECIAL VARIABLE USED BY ASME5
+CPSW,  1
+DSW,   0
+FORFLG,        0               /FORTR PSUEDO-OP FLAG
+                       /POS NON-0 MEANS IGNORE DATA
+SCOLON,        0
+/*****
+PASS,  0
+PGEESC, 0              /HOLDS SIZE OF PAGE ESCAPE REQUIRED FOR CUR PAGE
+PUPGE, 0
+PHASE, 0               /PHASE SWITCH
+PSTCPR, 0              /PAGE SYMBOL TABLE CODE POINTER
+PSTSPR, 0              /PAGE SYMBOL TABLE SYMBOL POINTER
+PSTSZE, 0              /SIZE OF PST
+PTCPR, 0               /PAGE TABLE CODE POINTER
+PTOPR, 0               /PAGE TABLE OP CODE POINTER
+PTSPR, 0               /PAGE TABLE SYMBOL POINTER
+PTSZE, 0               /SIZE OF PT
+TEM1,  0
+TEM2,  0
+TEM3,  0
+TEM4,  0
+TEM5,  0
+PTSIZ=PTSZE            /KEYPUNCHING ERROR
+LITSIZ=LITSZE          /KEYPUNCHING ERROR
+/
+/LISTING VARIABLES
+LFLG,  0               /0 IF NULL LINE
+EFLG,  0               /ERROR FLAG, 6BIT CHAR. IN LEFT HALF
+VFLG,  0               /0 IF NO VALUE TO OUTPUT
+AFLG,  0               /DITTO FOR ADDRESS
+CODE,  0               /RELOCATION CODE
+ADDRES,        0               /INSTR. ADDRESS
+VALUE, 0               /INSTR. VALUE
+
+/LINE INFO
+LFS,   0       /KEEP THIS LIST ORDERED AS GIVEN
+OP,    0       /TO AGREE WITH TLFS LIST
+IB,    0
+AFS,   0
+UMIC,  0
+NSGN,  0
+EXP,   0
+SK,    0
+CURSKP=SK
+BANK,  0
+S0,    0
+S1,    0
+S2,    0
+S3,    0
+
+
+/      FREQUENTLY USED CONSTANTS
+/
+K5,    5
+K7,    0007
+K10,   0010
+K20,   0020
+K40,   0040
+K77,   0077
+K100,  100
+K177,  0177
+K200,  0200
+K240,  240
+K400=L55I
+K600=GETSYM
+K3000=LFSCHK
+K1000=INI
+K4000=PRSYMP
+K7600, 7600
+M200=K7600
+M254,  -254
+LINAX, LINBUF-1
+M2,    -2
+M3,    -3
+K2000=RDIL
+M3000=STCE
+M7600=K200
+/
+/      CORE LAYOUT POINTERS
+/
+PTOPTB=K200            /PAGE OP CODE TABLE 1 IN BANK 1
+BSEEST=K100            /BASE OF EXTERNAL SYMBOL TABLE IN BANK 1
+MST=K2000              /BASE MAIN SYM. TAB IN BANK1
+LFSBSE=K600            /BASE OF LOCATION FIELD SYMBOL TABLE IN BANK 1
+LITBSE=L55I            /BASE OF ASSEMBLY PHASE LITERAL TABLE IN BANK 1
+PSTBSE,        PSTB            /BASE OF PAGE SYMBOL TABLE IN BANK 0
+PTBSE, PTB             /BASE OF PAGE TABLE IN BANK 0
+LTBSE=K1000            /BASE OF COLL. PHASE LIT. TABLE IN BANK 1
+PTB=7176
+PSTB=6776
+
+
+
+IERROR=JMP I .         /ERROR MESSAGES
+       ERRI
+CERROR=JMP I .
+       ERRC
+SERROR=JMP I .
+       ERRS
+
+\f*0200
+/
+/      MAIN CONTROL LOGIC
+/
+START, CLA
+       JMS I   INITIO
+       DCA     PASS
+       DCA I   ICALSW
+       JMS I   INITAP
+RSTRT, JMS I   INI     /INITIALIZE PAGE TABLE POINTERS
+       SKP
+RSTRT1, JMS I  INCPTI  /INCREMENT PAGE TABLE POINTERS
+       JMS I   RDIL    /INPUT AND DECODE ONE LINE
+       JMS I   CKCSWP          /CK FOR MISSING ARG
+       DCA     BSSSW           /ALSO CLR BSS IS PROGRESS SW
+       JMS I   STCE    /SET COUNTERS FOR CURRENT LINE
+       TAD     OP      /OP CODE
+       CDF 00
+       DCA I   PTOPR   /TO PT OP CODE WORD
+       CDF 10
+       TAD     SK              /OR IN SKIP BIT
+       SZA CLA
+       TAD     K40     /SKIP INST
+       TAD I   PTCPR   /IN CASE LFS BIT IN ALREADY
+       DCA     TEM1
+       TAD     IB      /OR IN INDIRECT BIT
+       SZA CLA
+       TAD     K400    /YES
+       TAD     TEM1
+       DCA     TEM1    /FOR NEW PT CODE WORD
+       TAD     EXP     /DO WE HAVE A PAR?
+       SZA CLA
+       JMP     RSTRT5  /YES
+       TAD     UMIC    /A MICRO INST?
+       SNA CLA
+       JMP     RSTRT4  /NO AN MRI
+       TAD     K4      /OR IN OPERATE BIT
+       JMP     COMP    /EXIT TO COMPUTE PAGE SIZE
+/
+/      PAR FOR AN OP CODE
+/
+RSTRT5,        TAD     K10     /PLACE PAR BIT ON PAGE TABLE
+       TAD     TEM1
+       DCA     TEM1
+RSTRT4,        TAD     M2
+       TAD     AFS     /IS AFS A CONSTANT
+       SZA
+       JMP     .+6     /NO
+       TAD     K20     /YES ... CONSTANT BIT
+RSTRT2, TAD TEM1       /+PT CODE WORD
+       DCA     TEM1    /FOR NEW PT CODE WORD
+       TAD     S0      /ACTUAL BINARY CONSTANT
+       JMP     COMPGO  /EXIT TO COMPUTE PAGE SIZE
+       IAC
+       SZA CLA         /IS AFS A LITERAL
+       JMP     .+3     /NO
+       TAD     K2      /YES ... LITERAL BIT
+       JMP     RSTRT2  /SAVE AS CONSTANT FROM THIS POINT
+       TAD     AFS     /PLACE AFS ON PST
+COMPGO,        DCA I   PTSPR
+       TAD     NSGN    /CK FOR # REF
+       SZA CLA
+       TAD     K2000   /YES
+COMP,  TAD     TEM1    /GET ALL THE BITS
+       DCA I   PTCPR   /TO THE CODE WORD
+/
+/      NOW COMPUTE THE CURRENT PAGE SIZE
+/
+       TAD     LFS     /IS THERE AN LFS
+       SZA CLA
+       JMS I   RECTI   /YES ... EXIT TO RECOUNT PAGE
+       JMS I   CPGESI  /COMPUTE ACTUAL PAGE SIZE
+       TAD     M200    /SUBTRACT PHYSICAL PAGE SIZE
+       SPA SNA CLA     /IS SIZE .GT. PHYSICAL SIZE
+       JMP     RSTRT6  /NO ... GET NEXT
+       JMS I   PSHINI  /YES ... PUSH CURRENT INPUT LINE
+       TAD     PUPGE   /RESTORE LAST PAGE ESCAPE
+       DCA     PGEESC  
+       CLA CMA         /DECREMENT PAGE TABLE SIZE
+       TAD     PTSZE
+       DCA     PTSZE
+/
+/      ASSEMBLE THE CURRENT PAGE
+/
+       JMS I   L55I    /ASSEMBLE CURRENT PAGE
+       JMS I   UDPG
+       JMS I   FIXI            /FIX ILC IF PASS 2
+       JMS I   POPINI  /POP LAST INPUT LINE
+       JMS I   INI     /INITIALIZE PT POINTERS
+       DCA I   RECTI           /CLR RECOUNT FLAG FOR CPLFS
+       JMP     RSTRT1+2     /EXIT TO PROCESS POPPED LINE
+/
+RSTRT6,        TAD     PGEESC  /SAVE CURRENT PAGE ESCAPE
+       DCA     PUPGE   /IN CASE NEXT LINE OVERFLOWS PAGE
+       TAD     PASS
+       SZA CLA
+       JMS I   LASMP
+       JMP     RSTRT1
+LASMP, ASM02
+INITAP,        INITA
+ICALSW, CALLSW
+INCPTI, INCPT
+POPINI, POPIN
+PSHINI, PUSHIN
+FIXI,  FIXILC
+CKCSWP,        CKCSW
+/      PAGE PSEUDO OPERATION
+/
+PPAGE, JMS I   SKIPL
+       CLA CMA         /DECREMENT PAGE TABLE SIZE
+       TAD     PTSZE
+       SNA             /WATCH FOR ZERO
+       JMP     .+3
+       DCA     PTSZE   /FOR NEW PAGE TABLE SIZE
+       JMS I   L55I    /ASSEMBLE CURRENT PAGE
+       JMS I   UDPG
+       JMP     RORGX   /INITIALIZE AND INPUT ANOTHER LINE
+/
+/      REORG PSEUDO OPERATOIN
+/
+PRORG, JMS I   GETSYM  /GET NEXT INPUT ITEM
+       NOP             /NOTHING THERE
+       SKP             /SYMBOL
+       SKP CLA         /CONSTANT
+       IERROR          /LITERAL
+       JMS I   SKIPL
+       TAD     S0      /NEW RELOCATABLE ORIGIN
+       AND     K7600   /MASK OFF PAGE DISPLACEMENT BITS
+       SNA             /ARE WE TRYING TO REORIGIN BELOW 200
+       IERROR          /YES ... NOT ALLOWED
+       DCA     RORG1   /SAVE NEW ORIGIN
+       CLA CMA         /DECREMENT PAGE TABLE SIZE
+       TAD     PTSZE
+       SNA             /IS THIS THE BEGINNING OF A PAGE
+       JMP     .+3     /YES
+       DCA     PTSZE
+       JMS I   L55I
+       TAD     RORG1   /NEW ORIGIN
+       DCA     PAG     /TO PROPER LOCATION
+RORGX, JMS I   FIXI
+       TAD     RSTRTX          /RETURN AT RSTRT INSTEAD OF RDL1
+       DCA     DCIL1
+       JMP I   NULLP   /RE-INITIALIZE AND GO
+RORG1, 0
+RSTRTX,        RSTRT
+UDPG,  UDPAGE
+INITIO,        IOINIT
+\f*0400
+/
+/      ROUTINE TO CAUSE CURRENT PAGE TO BE ASSEMBLED
+
+/THIS ROUTINE ACTS AS THE DRIVER FOR THE ASSEMBLY
+/PROCESS.  MOST OF THE ACTUAL ASSEMBLY WORK
+/IS DONE BY ASMBL,A1,A2,& ASM02.
+/FUNCTION:(PASS1)
+/      CALL ASMBL TWICE.  THE FIRST TIME
+/      (ACTR=0) PROHIBIT OUTPUT BY CONVERTING
+/      "JMS OUTBIN" TO "JMS DUMMY". BUT
+/      ALSO CONVERT "JMS DUMMY" TO "JMS OUTBN"
+/      SO THAT OUTPUTTING OF OCCURANCES
+/      WILL OCCUR IN FIRST CALL TO ASMBL.
+/      IN GENERAL, IN THE FIRST RUN THRU ASMBL
+/      NOTHING HAPPENS EXCEPT THAT TAGS ARE
+/      DEFINED (BY LFSCK).  AS THE TAGS ARE
+/      DEFINED LFSCK ALSO CAUSES THE
+/      OCC.TAB. TO BE SEARCHED FOR PREVIOUSLY
+/      UNRESOLVED FORWARD REFERENCES TO THIS
+/      TAG.  IF FOUND, RELOCATABLE POINTERS TO
+/      THE TAG ARE OUTPUT AT ALL REQUIRED
+/      ADDRESSES DURING PHASE1 OF ASMBL.
+/      AFTER THE 1ST ASMBL, OUTBIN & DUMMY ARE
+/      SWITCHED BACK TO NORMAL & ASMBL
+/      IS CALLED AGAIN.  DURING 2ND ASMBL
+/      THE TAG DEFN. SECTION OF LFSCK IS
+/      BY-PASSED & ALL CODE EXCEPT OCCURANCES
+/      IS OUTPUT.
+/      (PASS2)
+/      DURING THE LISTING PASS MOST OF THE
+/      ASSEMBLY IS DONE ON A LINE-BY-LINE
+/      BASIS BY ASM02 SO L55 HAS LITTLE
+/      TO DO.  IT JUST CALLS A2 TO 
+/      OUTPUT THE LITERAL POOL & THEN 
+/      A1 TO INIT. ASSEMBLY OF THE NEXT
+/      PAGE.
+/
+L55,   0
+       JMP I   L55B            /CHANGED FROM V16 TO FIX LISTING BUG
+L55C,  TAD     PASS
+       SZA CLA
+       JMP     L55L
+       JMS I   L55A            /CHECK COMMON PUNCHED
+       TAD     L56     /SET DUMMY ROUTINE TO OUTPUT
+       DCA     DUMMY
+       TAD     L56+1   /SET OUTPUT ROUTINE TO DUMMY
+       DCA     OUTBIN
+       DCA     ACTR    /CLEAR ASSEMBLY COUNTER
+       TAD     EQVOPR          /SAVE FOR 2ND ASSEMBL
+       DCA     TEM55
+       JMS I   ASSMBL  /ASSEMBLE PAGE FIRST TIME
+       TAD     L56     /RESTORE OUTPUT ROUTINE
+       DCA     OUTBIN
+       TAD     L56+1   /RESTORE DUMMY ROUTINE
+       DCA     DUMMY
+       ISZ     ACTR    /SET ASSEMBLY COUNTER
+       TAD     TEM55           /RESTORE AS BEFORE 1ST ASSEMBL
+       DCA     EQVOPR
+       JMS I   ASSMBL  /ASSEMBLE AND OUTPUT THIS TIME
+       JMP I   L55     /RETURN
+L56,   OUTBN
+       DUM
+ASSMBL, ASMBL
+L55A,  HCBPS
+L55B,  EQVFIX
+TEM55, 0
+
+
+
+L55L,  JMS I   A2P
+       JMS I   A1P             /INITIALIZE NEXT PAGE
+       JMP I   L55
+A2P,   A2
+A1P,   A1
+
+
+
+/
+/COLLECTION PHASE ROUTINE
+/RECOUNT THE CURRENT PAGE BECAUSE OF AN LFS
+/CALL WITH AC=0, LEAVES AC=0
+/FUNCTION:WHEN A NEW TAG IS DEFINED ON PAGE
+/      OPSCTR & OBACTR MAY NEED TO BE
+/      REDUCED.  CPLFS TAKES CARE OF OPSCTR
+/      BUT OBACTR REQUIRES REVIEWING THE
+/      ENTIRE PAGE.
+/OPERATION:    (1) CALL CLNPST TO CLEAR BITS 1-9
+/              OF ALL PST CODE WORDS-WIPES OUT
+/              SHARE OF OBACTR DUE TO EACH SYM.
+/              (2) RE-INIT PAGE & CLR OBACTR
+/              (3) FETCH ITEM FROM PAGE TABLE
+/              (4) SET ALL INSTR.TYPE FLAGS ACCORDINGLY
+/              (5) CALL SETC
+/              (6) INC PAGE TABLE PTRS TO NEXT ITEM
+/              & LOOP BACK TO (3)
+/              CONTINUE THRU ENTIRE TABLE.
+/
+RECT,  0
+       TAD     PSTSZE          /ANYTHING ON PST?
+       SZA
+       JMP I   CLENUP          /YES, CLEAN PST CODES
+
+RECRET,        JMS I   INISS           /DO INITS.
+       DCA     OBACTR  /ZERO OFF BANK ADDITION COUNTER
+       TAD     PTSZE   /SIZE OF PT
+       CIA
+       DCA     RECT1   /TO INDEX LOCATION
+/
+/      THIS IS THE RECOUNT LOOP
+/
+RECT2, CDF 00
+       TAD I   PTOPR   /OP CODE FROM PT
+       CDF 10
+       DCA     OP
+       TAD I   PTCPR   /CK FOR SKIP INST
+       AND     K40
+       DCA     SK
+       TAD I   PTCPR   /CK FOR # REF
+       AND     K2000
+       DCA     NSGN
+       TAD I   PTCPR   /PT CODE WORD
+       AND     K4      /IS IT AN OPERATE INSTRUCTION
+       DCA     UMIC
+       TAD I   PTCPR   /CK FOR PAR EXP
+       AND     K10
+       DCA     EXP
+       TAD I   PTCPR   /PAGE TABLE CODE WORD
+       AND     K400    /MASK OFF INDIRECT BIT
+       DCA     IB      /PLACE IT IN PROPER LOCATION
+       TAD I   PTCPR   /PT CODE WORD
+       AND     K20     /IS AFS A CONSTANT
+       CLL RTR
+       SZA
+       JMP     .+3     /YES
+       TAD I   PTCPR   /PT CODE WORD
+       AND     K2      /IS AFS A LITERAL
+       CLL RAR
+       SNA
+       TAD I   PTSPR   /ADDRESS FIELD SYMBOL
+       DCA     AFS
+       TAD I   PTSPR   /ACTUAL LITERAL
+       DCA     S0      /TO LITERAL LOCATION
+/
+/      AREA WHICH CALLS COUNT ROUTINE
+/
+RECT3, TAD I   PTCPR   /PT CODE WORD
+       AND     K201            /IS THERE A TAG OR AN EQUIVALENCED TAG?
+       SNA CLA
+       JMP     .+3     /NO
+       CLA CMA         /YES ... SET BANK UNKNOWN
+       DCA     BANK
+       JMS I   STCE    /CALL COUNT ROUTINE
+       ISZ     RECT1   /OVER YET
+       SKP             /NO
+       JMP I   RECT    /EXIT
+       JMS I   ISZPT1
+       JMP     RECT2   /GO GET NEXT LINE
+RECT1=L55
+INISS, INISUB
+CLENUP,        CLNPST
+K201,  201
+ISZPT1,        ISZPT
+PAUS1, PPAUS1
+/
+/      END PSEUDO OPERATION
+/
+PEND,  TAD     FORFLG          /IF FLAG ON, TURN OFF &
+       SMA SZA CLA     /GO TO RDL1
+       JMP I   PAUS1   /GO TURN OFF FORTR P-OP
+       CLA CMA         /DECREMENT PT SIZE
+       TAD     PTSZE
+       SNA             /ARE WE AT THE BEGINNING OF A PAGE
+       JMP     PCSM    /YES
+       DCA     PTSZE   /NO ... NEW PAGE TABLE SIZE
+       TAD     PAG     /CHECK FOR OVERFLOW INTO 7600 PAGE
+       TAD     K200
+       SNA     CLA
+       SERROR          /OVERFLOW-ERROR S
+       ISZ     APMSW   /LEAVE AUTO PAGING MODE FOR LAST PAGE
+       JMS     L55     /ASSEMBLE CURRENT PAGE
+PCSM,  JMS I   OUTBIN  /OUTPUT CKSUM
+       CSUM
+       10
+       TAD     PASS
+       SZA CLA
+       JMP     ENDEND
+       JMS I   LEAD    /OUTPUT TRAILER CODE
+       JMS I   PRSYMP  /TYPE OUT SYMBOL TABLE
+       ISZ     PASS
+       JMS I   INITAI
+       JMS I   A1P
+       HLT
+       JMP I   REE
+ENDEND,        JMS I   WLNP            /LIST THE "END" STATMT
+       HLT CLA
+       JMP I   K200            /RESTART AT 200
+REE,   RSTRT
+INITAI,        INITA
+LEAD,  LEADER
+
+
+\f*600
+/READ INPUT ITEM
+/      IGNORES SPACES & TABS TO 1ST CHAR OF ITEM
+/ASSUMES AC=0
+/CALLING SEQ: JMS I GETSYM
+/              NULL RETURN (IF NO ITEM FOUND BEFORE CR ; / *
+/              SYMBOL RET. (WITH SYM PACKED IN S1-S3
+/                      AND S0=SYMBOL LENGTH)
+/              CONST. RET. (WITH VALUE IN S0)
+/              LITERAL RET. (WITH VALUE IN S0)
+/SYNTAX: LITERALS: (000                NUMERIC LIT.
+/              (-000           NEG.
+/              (K000           OCTAL
+/              (D000           DECIMAL
+/              ("A             ASCII LIT.
+/              (-"A            NEGATIVE ASCII
+/      CONSTANTS: 000,-000,"A,OR -"A
+/      NOTE: AFTER A VALID QUOTE ANY ASCII CHAR MAY APPEAR
+/              AND WILL BE STORED AS THE CONST OR LIT VALUE.
+/              THIS INCLUDES CR ; / * SO THESE DO NOT
+/              TERMINATE A LINE AFTER A QUOTE.
+/ALL EXITS LEAVE AC=0
+/NOTE: TO PROVIDE A CHECK OF THE PUNCTUATION
+/CHAR.  FOLLOWING PREVIOUSLY READ SYMBOL, GTSYM
+/DECREMENTS THE LINE PTR BEFORE STARTING
+/THE READ.  IF THIS IS NOT WANTED
+/CALL TO GTSYM MUST BE PRECEDED
+/BY "ISZ X0"
+
+GTSYM, 0
+       CMA                     /DECREMENT CHARACTER PTR
+       TAD X0
+       DCA X0
+       TAD DSW         /SAVE NUMERIC MODE
+       DCA TEM4
+       CMA                     /SIGN=-1 FOR POSITIVE
+ITM4,  DCA     SIGN            /SIGN=0 TO FORCE NEGATION
+ITM2,  JMS I RC                /READ 1ST CHAR
+       JMP ITM5        /DIGIT: GET NUMERIC CONST
+       JMP ITM3        /ALPHA: GET SYMBOL
+       JMS I TEST              /SORT LEADING PUNCT.
+               SL2-1
+               BL2-SL2
+       CERROR                  /ILLEGAL CHAR
+/
+/READ IN A SYMBOL
+/ASSUMES 1ST CHAR ALREADY READ IN & SAVED IN CHR
+/LEAVES SYMBOL PACKED IN 6BIT CHAR PAIRS IN S1-S3
+/      S0=NUMBER OF CHAR PAIRS ACTUALLY USED
+
+ITM3,  ISZ SIGN                /CK FOR -SYMBOL
+       CERROR                  /YES
+       DCA S0          /CLR FOR SYM LENGTH COUNT
+       DCA TEM1                /CLR FOR CHAR COUNT
+       DCA TEM3                /SET PTR FOR LEFT BYTE
+       TAD AS0         /AUTO-INDEX STORAGE IN S1-S3
+       DCA X2
+RSM2,  ISZ TEM1                /COUNT CHAR
+       TAD TEM1                /ARE MORE THAN 6 CHARS IN?
+       TAD M7
+       SMA CLA
+       JMP RSM1        /YES, IGNORE
+       TAD CHR         /NO, GET ASCII
+       AND K77         /MASK TO 6BIT
+       ISZ TEM3                /WHICH BYTE?
+       JMP RSM3        /LEFT
+       TAD TEM2                /ADD ON LEFT HALF
+       DCA I X2        /STORE CHAR PAIR IN S1-S3
+       JMP RSM1
+RSM3,  RTL CLL         /MOVE 6BIT TO LEFT BYTE
+       RTL
+       RTL
+       DCA TEM2                /SAVE WHILE WAITING ON RT BYTE
+       CMA             /SET PTR FOR RT BYTE
+       DCA TEM3
+       ISZ S0          /COUNT 1 SYMBOL WORD
+RSM1,  JMS I RC                /READ NEXT CHAR
+       JMP RSM2        /DIGIT
+       JMP RSM2        /ALPHA
+       ISZ TEM3                /PUNCT=END OF SYM: CHECK BYTE PTR
+       JMP .+3         /NOTHING IN TEM2
+       TAD TEM2                /SAVE THE ODD CHAR
+       DCA I X2
+       TAD I   IFCTP           /SKIP SYM TAB IF IF-COUNT NOT UP
+       SMA CLA
+       JMS I  SRS              /LOOK IT UP IN SYM TAB. & ENTER IF NEC.
+       JMP ITM14       /EXIT
+
+/READ DIGIT STRING
+/ASSUMES 1ST DIGIT ALREADY READ AND ASCII SAVED IN CHR
+/      SGN=-1 IF NUM. IS TO BE NEGATED
+/      DSW=0 FOR OCTAL CONVERSION, 1 FOR DECIMAL
+/LEAVES AC=OCTAL VALUE OF DIGIT STRING (NEG IF SGN=-1)
+/      CHR=ASCII FOR TERMINAL PUNCTUATION
+
+ITM5,  DCA TEM1                /CLEAR FOR ACCUMULATION
+RDS1,  TAD CHR         /REDUCE CHR TO OCTAL VALUE
+       TAD M260A
+       DCA TEM2
+       TAD DSW         /OCTAL OR DECIMAL CONVERSION?
+       SZA CLA         /OCTAL, CK FOR 8 OR 9
+       JMP MUL1        /DECIMAL, 8 OR 9 IS OK
+       TAD TEM2                /VALUE = 8 OR 9?
+       TAD M7
+       SMA SZA CLA     /NO, GO ON
+       CERROR                  /YES
+               /MULT. PREV. VAL. BY CONV. FACTOR
+       TAD TEM1
+       CLL RTL         /ARG *4
+       JMP MUL1+3
+MUL1,  TAD TEM1
+       CLL RTL         /ARG * 4
+       TAD TEM1                /PLUS ARG=ARG*5
+       RAL             /*2
+       TAD TEM2                /ADD NEW DIGIT
+       DCA TEM1                /SAVE ACCUMULATED VALUE
+       JMS I RC                /READ NEXT CHAR.
+       JMP RDS1        /DIGIT
+       CERROR                  /ALPHA
+       TAD TEM1                /PUNCT.; GET TOTAL
+ITM6,  ISZ SIGN                /IS NEGATE SW. SET?
+       CIA             /YES
+       DCA S0          /STORE CONST VALUE
+       TAD TEM4                /RESTORE NUMERIC MODE
+       DCA DSW
+       JMP ITM13       /EXIT
+ITM7,  JMS I   GETCHR          /READ ALPHA CONST.
+       SNA
+       IERROR          /NOTHING THERE
+       DCA TEM1
+       JMS I GETCHR            /READ NEXT CHAR FOR BENEFIT OF SKIPL
+       CLA
+       TAD TEM1
+       JMP ITM6
+ITM8,  JMS I CKIFP             /MOVE PTR TO LITERAL EXIT
+ITM9,  JMS I RC                /READ 1ST CHAR OF LIT.
+       JMP ITM5        /DIGIT: NUMERIC LIT.
+       NOP             /ALPHA: MUST BE K OR D
+       JMS I TEST              /LOOK FOR K,D,",-
+               SL3-1
+               BL3-SL3
+       CERROR                  /ILLEGAL CHAR
+ITM10, DCA     SIGN            /SET FLAG FOR NEG. LIT.
+       JMP ITM9
+ITM11, IAC             /FORCE DECIMAL LIT.
+ITM12, DCA DSW         /FORCE OCTAL LIT.
+       JMP ITM9
+ITM13, JMS I CKIFP             /CONST. EXIT
+ITM14, JMS I CKIFP             /SYMBOL EXIT
+ITM15, JMP I GTSYM     /NULL EXIT
+M260A, -260
+SRS,   SRSYM
+RC,    RCH
+SIGN,  0
+IFCTP, IFCTR
+CKIFP, CKIF
+AERROR=JMP I .
+       ERRA
+CALLSP,        CALLSW
+/
+/CHECK FOR TOO FEW ARGS
+/AERROR IF CALLSW MINUS
+/
+CKCSW, 0
+       TAD I   CALLSP          /CK
+       SMA CLA
+       JMP I   CKCSW           /OK
+       ISZ I   CALLSP          /COUNT MISSING ARG
+       NOP
+       AERROR                  /FLAG
+/
+/CHECK FOR TOO MANY ARGS
+/AERROR IF CALLSW POSITIVE
+/
+CKCLS, 0
+       TAD I   CALLSP          /DO WE WANT THIS ARG?
+       SMA CLA
+       AERROR                  /NO, ARG COUNT OVERFLOW
+       ISZ I   CALLSP          /YES, COUNT THIS ARG
+       NOP
+       JMP I   CKCLS
+\f*1000
+/
+/      ROUTINE TO INITIALIZE POINTERS FOR THE COLLECTION OF A PAGE
+/
+INILPT,        0
+       CLA IAC
+       DCA     PTSZE   /SET PAGE TABLE SIZE
+       DCA     PSTSZE  /ZERO PAGE SYMBOL TABLE SIZE
+       DCA     LTSZE   /ZERO LITERAL TABLE SIZE (COLL. PHASE)
+       DCA     LITSZE          /& ASMBLY PHASE LIT TABL
+       DCA     OPSCTR  /ZERO OFF PAGE SYMBOL COUNTER
+       DCA     PHASE   /SET PHASE SWITCH TO COLLECTION
+       JMS     INISUB
+       CLA CMA
+       DCA I   BNKSV
+       CLA IAC
+       DCA I   LSTSKK
+       TAD     EQVBIT          /ANY EQUIV. LEFT FROM LAST PAGE?
+       SZA
+       JMP     EQSAV           /YES, SKIP TABLE REINIT & SAVE BIT
+       DCA     EQVIPR          /NO, RE-INIT EQ. TAB. PTRS
+       DCA     EQVOPR
+EQSAV, DCA I   PTCPR   /INITIALIZE PAGE TABLE CODE WORD
+       DCA I   PTSPR   /INITIALIZE PAGE TABLE SYMBOL WORD
+       CDF 00
+       DCA I   PTOPR   /INITIALIZE PT OP CODE WORD
+       CDF 10
+       TAD     LFSBSE  /INITIALIZE LFS TABLE POINTER
+       DCA     LFSPTR
+       DCA     OBACTR  /ZERO OFF BANK ADDITION COUNTER
+       TAD     RDL1X           /RESTORE IN CASE OF REORG OR PAGE PSUEDO
+       DCA     DCIL1
+       JMP I   INILPT  /RETURN
+
+RDL1X, RDL1
+BNKSV, BNKSAV
+LSTSKK,        SKPSAV
+M211,  -211
+
+
+/
+/GENERAL PAGE TABLE INITALIZATION
+/DOES PARTS OF INITALIZ.  COMMON TO SEVERAL
+/ROUTINES
+/
+INISUB,        0
+       TAD     PTBSE   /INITIALIZE PAGE TABLE CODE POINTER
+       DCA     PTCPR
+       TAD     PTBSE   /INITIALIZE PAGE TABLE SYMBOL POINTER
+       IAC
+       DCA     PTSPR
+       TAD     PTOPTB  /INITIALIZE PT OP CODE POINTER
+       DCA     PTOPR
+       CLA CMA         /SET LAST BANK UNKNOWN
+       DCA     LSTBNK
+       CLA IAC         /SET LAST INSTRUCTION SKIP INDICATOR ON
+       DCA     LSTSKP
+       CLA CMA         /SET CURRENT BANK UNKNOWN
+       DCA     BANK
+       JMP I   INISUB
+
+
+/
+/SUBR. TO WRITE A LINE
+/MAY BE USED ONLY DURING PASS 2 (LISTING)
+/FUNCTION:TYPES (OR PUNCHES) EACH LINE OF SOURCE
+/      WITH PROPER ASSEMBLY ADDR. & CODES
+/      AT BEGINNING OF LINE (OR SPACES IF
+/      THESE ARE OMITTED).
+/LINE FORMAT:
+/ADDR  VALU RC   CONTENTS OF LINE BUFFER
+/ERROR FLAGS TYPED BETWEEN ADDR & VALU
+/COLUMNS.  RC=RELOCATION CODE.  THE LINE
+/BUFFER IS IN FIELD 1 AT "LINBUF."
+/
+WLN,   0
+       TAD     LFLG            /NULL LINE?
+       SNA CLA
+       JMP     WLN3            /YES
+       TAD     AFLG
+       SZA CLA
+       JMP     .+4
+       JMS I   CTYPE           /IF AFLG=0 TYPE 4 SPACES
+       JMS I   CTYPE
+       JMP     .+3
+       TAD     ADDRES          /OTHERWISE TYPE 4 DIGITS
+       JMS I   OTYPE
+       TAD     EFLG            /TYPE ERR. FLAG & SPACE
+       JMS I   CTYPE
+       TAD     VFLG            /SAME TREATMENT FOR VALUE
+       SZA CLA                 /AS FOR ADDRES
+       JMP     .+4
+       JMS I   CTYPE
+       JMS I   CTYPE
+       JMP     .+3
+       TAD     VALUE
+       JMS I   OTYPE
+       TAD     K240            /SPACE
+       JMS I   TYPE
+       TAD     CODE            /2 DIGITS OR 2 SPACES
+       JMS I   CTYPE
+       CDF 00
+       TAD I   LINEB           /IS THERE ANY LINE TO TYPE?
+       CDF 10
+       SNA CLA
+       JMP     WLN3            /NO, EXIT
+       JMS I   CTYPE           /2 SPACES
+       TAD     K240            /3RD SPACE 
+       JMS I   TYPE
+       TAD     LINAX           /INDEX LINE BUFFER
+       DCA     X1
+       DCA     CHARCT          /CLR COUNTER
+WLN1,  CDF 00
+       TAD I   X1              /GET CHAR
+       CDF 10
+       SNA
+       JMP     WLN3            /END OF LINE
+       DCA     CHR
+       TAD     CHR             /CK FOR TAB
+       TAD     M211
+       SNA CLA
+       JMP     WLN2            /YES
+       ISZ     CHARCT          /COUNT 1 CHAR
+       TAD     CHR             /OUTPUT IT
+       JMS I   TYPE
+       JMP     WLN1
+WLN2,  TAD     K240            /SIMULATE TAB
+       ISZ     CHARCT
+       JMS I   TYPE
+       TAD     CHARCT
+       AND     K7
+       SZA CLA
+       JMP     WLN2            /CONTINUE TAB
+       JMP     WLN1
+WLN3,  JMS I   CRLF
+       DCA     VFLG
+       DCA     EFLG
+       DCA     AFLG
+       DCA     CODE
+       CDF 00
+       DCA I   LINEB
+       CDF 10
+       JMP I   WLN
+
+LINEB, LINBUF
+CHARCT=TEM5
+/
+/PATCH FOR SETCT
+/NOT USED BY ANY OTHER PART OF PROGRAM
+/(ADDED AT V15)
+/
+/FUNCTION: SET BANK=1 AFTER A "CALL"
+/(MUST BE DONE FOR BENEFIT OF RECT ROUTINE)
+/
+SETCAL,        0
+       TAD I   PTCPR           /CK FOR CALL CONST.
+       AND     K100
+       SNA CLA
+       JMP     .+3             /NO
+       IAC                     /YES, BANK TO CURRENT
+       DCA     BANK
+       TAD     EXP             /DO 2 INSTRUCTIONS THAT
+       TAD     UMIC            /WERE KNOCKED OUT OF SETCT
+       JMP I   SETCAL
+
+
+\f*1200
+/
+/      ASSEMBLY PHASE PAR
+
+/
+/PPAR1 IS ACTUALLY A PART OF THE BASIC ASSEMBLY
+/ROUTINE ASM02.
+/IT ASSEMBLES ALL PARAMETERS
+/TYPES ARE:    RC=00   ABSOLUTE CONSTANT
+/              RC=01   RELOCATABLE ADDRESS
+/              RC=05   CDF TO CURRENT FIELD
+/              RC=06   CALL CONSTANT (#ARGS+EXT.SYM.#)
+/              ALSO LITERALS USED IN ARG STATEMENTS
+/              SUCH LITS. ARE PUT IN LIT. POOL
+/              AND RC=01 ADDRESS OF LIT. PUT WHERE
+/              THE ARG STATEMT OCCURS.
+/ADDRESS PARAMETERS ARE ACUALLY TAKEN
+/CAR OF BY SUBR. PPAR3S.
+/
+/
+PPAR1, DCA     PPARY           /CLR OUTPUT CODE
+       TAD I   PTCPR           /CK FOR LITERAL ARG OR PARAM.
+       AND     K2
+       SZA CLA
+       JMP     PARLIT          /YES
+       TAD I   PTCPR   /PT CODE WORD
+       AND     K20     /IS IT PAR CONSTANT
+       SNA CLA
+       JMP     PPAR3   /NO
+       TAD I   PTSPR   /YES ... ACTUAL CONSTANT
+       DCA     TEM1    /TO DIRECTLY ADDRESSABLE LOC
+       TAD I   PTCPR   /IS THIS A SPECIAL CONSTANT USED BY CALL
+       AND     K100
+       SNA CLA
+       JMP     .+5
+       IAC                     /YES, SET BANK TO CURRENT (NEW IN V15)
+       DCA     BANK
+       IAC                     /& FORCE CODE=06
+       JMP .+5
+       TAD I   PTCPR   /IS THIS A CDF INSTRUCTION TO THIS BANK
+       AND     K1000   
+       SNA CLA
+       JMP     .+3         
+       TAD     K5
+       DCA     PPARY
+       JMS I   WRITEP
+       JMS I   OUTBIN  /OUTPUT IT
+       TEM1            /NO RELOCATION
+PPARY, 0
+       SKP
+PPAR3, JMS     PPAR3S  /DO ALL WORK
+       JMP I   PPAR5-1
+SERALI,        SRALT
+
+PARLIT,        TAD I   PTSPR           /PUT LIT ON TAB.
+       DCA     S1
+       IAC
+       DCA     S0
+       JMS I   SERALI
+       AND     K177            /GET PAGE ADDRESS
+       TAD     PAG             /+ PAGE BITS
+       DCA     TEM1
+       ISZ     PPARY           /CODE FOR RELOCATABLE ADDR.
+       JMP     PPARY-3
+/
+/      SUBROUTINE TO ASSEMBLE PAR SYMBOL
+
+/
+/ASSEMBLE ADDRESS PARAMETER
+/SYMBOL MAY BE ABSOLUTE OR RELOCATABLE
+/NORMAL OR # REF.
+/IF SYMBOL IS YET UNDEFINED, AN ENTRY IS
+/MADE FOR IT & THE CURRENT ADDRESS IN THE
+/OCCURANCE TABLE.
+/
+/
+PPAR3S, 0
+       DCA     PPARX           /CLR OUTPUT CODE
+       TAD     ACTR    /WHCH TIME ARE WE ASSEMBLING THIS PAGE
+                       /NOTE: ACTR REMAINS 1 DURING PASS 2
+       SNA CLA
+       JMP I   PPAR3S  /FIRST TIME JUST RETURN
+       TAD I   PTSPR   /SYMBOL
+       DCA     AFS     /TO DIRRECTLY ADDRESSABLE LOCATION
+       JMS I   OBSYM   /GET IT FROM MST
+       AFS
+       TAD     USE     /MST USE WORD
+       AND     K400    /IS IT DEFINED YET
+       SNA CLA
+       JMP     PPAR4   /NO ... OCCURANCE
+       TAD     USE     /MST USE WORD
+       AND     K3000   /IS SYMBOL ABSOLUTE
+       SZA CLA
+       ISZ     PPARX           /OUTPUT RELOCATABLE
+       JMS I   NSCHKI
+       TAD     VAL             /INCREMENT IF # REF.
+PPAR6, DCA     TEM1
+       JMS I   WRITEP
+       JMS I   OUTBIN      
+       TEM1
+PPARX, 0
+       JMP I   PPAR3S  /RETURN
+PPAR4, TAD     AFS     /SYMBOL
+       DCA I   PPAR5   /TO SUBROUTINE LOCATION
+       TAD     ILC     /CUR LOC
+       DCA I   PPAR5+1      /TO SUBROUTINE LOC
+       JMS I   NSCHKI
+       CLL RTL
+       DCA I   PPAR5+3         /SET ATEM2 FOR NORMAL OR # REFERENCE
+       JMS I   PPAR5+2      /CREATE AN OCCURANCE
+       JMP     PPAR6      /OUTPUT ZERO WORD FOR LOADER
+       ASM01
+PPAR5, ATEM3
+       ATEM4
+       L53B
+       ATEM2
+NSCHKI,        NSCHK
+
+/
+/TWO CHARACTER TYPEOUT
+/FROM PACKED ASCII PAIR
+/CALL WITH 6-BIT PAIR IN AC
+/L61A ACTS AS SUBR FOR L61
+/
+L61,   0
+       DCA     TEM1    /SAVE CHARACTERS
+       TAD     TEM1
+       RTR             /SHIFT HIGH 6 BITS TO LOW
+       RTR
+       RTR
+       JMS     L61A    /MASK AND TYPE FIRST CHARACTER
+       TAD     TEM1
+       JMS     L61A    /MASK AND TYPE SECOND CHARACTER
+       JMP I   L61     /RETURN
+
+L61A,  0
+       AND     K77     /MASK CHAR TO 6 BITS
+       SNA             /ZERO MEANS SPACE
+       JMP     L61B
+       JMP I   L61CP           /HAVE DO SOME OF THIS WORK ON ANOTHER PAGE
+L61D,  JMS I   TYPE    /TYPE CHAR
+       JMP I   L61A    /RETURN
+L61B,  TAD     K240    /SPACE
+       JMP     L61D
+L61CP, L61C
+
+/
+/      ROUTINE TO TEST CHARACTERS AND TAKE SELECTIVE EXITS
+/
+/      CALL IS
+/      JMS I   TEST
+/      SORT LIST ADDR -1
+/      BRANCH LIST ADDR - SORT LIST ADDR
+/       RETURN IF ALL TESTS UNSUCCESSFUL
+/      ASSUMES AC=0 & CHAR TO LOOK FOR IS IN CHR
+
+/SORT ENDS UNSUCCESSFULLY AT
+/NEGATIVE NUMBER FOLLOWING SORT LIST
+/IF SORT IS SUCCESSFUL, A BRANCH IS
+/TAKEN VIA BR. LIST ITEM CORRESPONDING
+/TO MATCHING SORT LIST ITEM.
+/
+TSCHR, 0
+       CLA
+       TAD I   TSCHR   /GET SORT LIST ADDR -1
+       DCA     X1      /AUTO-INDEX SORT LIST
+       ISZ     TSCHR   /MOVE ARG PTR
+       CDF 00
+TSCHR2,        TAD I   X1              /GET SORT LIST ITEM
+       SPA
+       JMP     TSCHR3  /NEG = END OF SORT LIST
+       CIA             /COMPARE ITEM WITH CHR
+       TAD     CHR
+       SZA CLA         /0 = MATCH FOUND
+       JMP     TSCHR2  /NO MATCH, TRY NEXT ITEM
+       TAD     X1      /GET ADDR. OF MATCH
+       CDF 10
+       TAD I   TSCHR   /+BR. LIST ADDR - SORT LIST ADDR
+       DCA     TSCHR   /= PTR TO BR. LIST ITEM
+       CDF 00
+       TAD I   TSCHR   /GET BR. LIST ITEM
+       DCA     TSCHR   /= BRANCH PTR FOR THE MATCH
+       SKP
+TSCHR3,        ISZ     TSCHR   /NO MATCH ON LIST
+       CLA CLL
+       CDF 10
+       JMP I   TSCHR   / RETURN UNSUCCESSFUL
+
+
+\f*1400
+/
+/      CALL PSEUDO OPERATION
+/
+PCALL, JMS I   GETSYM  /GET NEXT INPUT ITEM
+       NOP             /NOTHING THERE
+       SKP             /SYMBOL
+       TAD     CHR     /CONSTANT
+       TAD     M254    /LITERAL
+       SZA CLA         /IS BREAK CHARACTER A COMMA
+       JMP     CALERR  /NO ... ERROR
+       TAD     S0      /SAVE ARG COUNT
+       DCA     ARGCT
+       ISZ     X0              /PROHIBIT FLAGGING THE COMMA
+       JMS I   GETSYM  /GET SUBROUTINE NAME
+       SKP             /NONE THERE
+       JMP     .+3     /SYMBOL
+       NOP             /CONSTANT
+CALERR,        IERROR          /LITERAL
+       JMS I   SKIPL
+       JMS I   SREST   /SEARCH EXTERNAL SYMBOL TABLE AND OUTPUT TV DEF
+       DCA     PCALL1  /SAVE EXTERNAL SYMBOL NUMBER
+       TAD     LFS
+       DCA I   CALLFS
+       TAD     ARGCT   /SET ARG COUNT IN DYNAMIC LOCATION
+       CIA
+       DCA     CALLSW  /SET CALL - ARG IN PROCESS SWITCH & COUNTER
+       TAD     ARGCT   /COUNT OF ARGS
+       RAL CLL         /*2
+       TAD     ARGCT           /*3 IN CASE USING LITERAL ARGS
+       TAD     K2      /+2
+       JMS I   PARG2   /CAN THE CURRENT PAGE HOLD IT
+       SKP             /YES
+       JMS I   INI     /NO ... INITIALIZE PT PTRS ... HAD TO ASSEMBLE PAG
+       TAD I   CALLFS
+       DCA     LFS
+       JMS I   ICPLFS  /PROCESS COLLECTION LFS
+       TAD I   PTCPR   /PT CODE WORD
+       TAD     K30     /ADD CONSTANT BIT & PAR BIT
+       DCA I   PTCPR   /TO PT CODE WORD
+       TAD     PARG6   /PLACE JMS LINK INSTRUCTION
+       DCA I   PTSPR   /AS CONSTANT
+       JMS     PARG5   /INC PT PTRS & ASSMBL IF PASS 2
+       TAD     K130    /CORRECT BIT PATTERN FOR CALL
+       DCA I   PTCPR   /TO PT CODE WORD
+       IAC                     /A CALL FORCES BANK TO CURRENT
+       DCA     LSTBNK          /(NEW IN V15)
+       IAC
+       DCA     BANK
+       TAD     ARGCT   /COUNT OF ARGS
+       CLL RTL         /TO HIGH ORDER AC
+       RTL
+       RTL
+       TAD     PCALL1  /OR IN EXTERNAL SYMBOL NUMBER
+       DCA I   PTSPR   /PLACE IN PT SYMBOL WORD
+       JMP     ARGPP0          /COMMON EXIT
+/
+/      ARG PSEUDO OPERATION
+/
+PARG,  JMS I   GETSYM  /GET NEXT INPUT ITEM
+       IERROR          /NOTHING THERE
+       JMP     PARGSM  /SYMBOL
+       JMP     PARGCN  /CONSTANT CODE IS 2
+       JMS I   SKIPL   /FIXES BUG IN V16
+       JMS I   SLITAB          /PUT LIT ON TABLE
+       CMA                     /LIT CODE IS 1
+PARGCN,        TAD     K2
+       SKP
+PARGSM,        TAD     SYMBOL          /PAR ADDRESS
+       DCA     AFS
+       JMS I   SKIPL
+       JMS I   CKCLSP          /CK FOR TOO MANY ARGS
+/
+/      ROUTINE TO PUT A CDF IN THE PAGE TABLE
+/
+       TAD     K30     /PT CODE WORD
+       DCA I   PTCPR   /TO PT
+       JMS I   ICPLFS  /PROCESS ANY LFS
+       TAD     K6201   /CDF
+       DCA I   PTSPR   /TO PT SYMBOL WORD
+       TAD     M2
+       TAD     AFS     /IS AFS A CONSTANT
+       SNA
+       JMP     ARGPP4  /YES
+       IAC             /IS AFS A LITERAL
+       SNA CLA
+       JMP     ARGPP5  /YES
+       JMS I   OBSYM   /NO ... SYMBOL ... GET ITS POINTERS TO MST
+       AFS
+       TAD     USE     /AFS MST USE WORD
+       AND     K40     /IS IT A COMMON SYMBOL
+       SNA CLA
+       JMS     CDFCHG  /NO
+       JMS     ARGPP2  /INCREMENT PT PTRS AND PUT OUT A PAR
+       TAD     AFS
+       DCA I   PTSPR   /PLACE SYMBOL IN PT SYMBOL WORD
+ARGPP0,        JMS     PARG5   /INC PT PTRS &ASSMBL IF PASS 2
+       JMP I   POPEXP  /EXIT TO GET NEXT LINE
+
+/
+ARGPP5,        JMS     CDFCHG
+       JMS     ARGPP2  /INCREMENT PTRS AND PUT OUT A PAR
+       TAD     K2      /SET LITERAL BIT
+       JMP     .+3     /SAVE AS CONSTANT FROM HERE
+/
+ARGPP4,        JMS     ARGPP2  /INCREMENT PTRS AND PUT OUT A PAR
+       TAD     K20     /SET CONSTANT BIT
+       TAD I   PTCPR   /PT CODE WORD
+       DCA I   PTCPR   /FOR PROPER WORD
+       TAD     S0      /PLACE CONSTANT IN PROPER LOCATION
+       DCA I   PTSPR
+       JMP     ARGPP0
+/
+/      ROUTINE TO INCREMENT POINTERS AND SET UP FOR A PAR IN THE PAGE TABLE
+/
+ARGPP2, 0
+       JMS     PARG5   /INC PT PTRS & ASSMBL IF PASS 2
+       TAD     K10
+       DCA I   PTCPR
+       JMP I   ARGPP2  /RETURN
+K6201, CDF 10
+
+ASMIF1,        0
+       TAD     PASS
+       SZA CLA
+       JMS I   ASM02S          /ASSMBL NOW IF LISTING PASS
+       JMS I   INC
+       JMP I   ASMIF1
+
+ASM02S,        ASM02
+INC,   INCPT
+
+ARGCT, 0
+CALLFS=PRSYMP                  /TEMP
+CALLSW, 0
+PARG2, IFFSUB
+CKCLSP,        CKCLS
+PARG5=ASMIF1
+PARG6, JMS     LINK
+M10,   -10
+
+/ROUTINE TO CHANGE CDF 10 TO CDF *
+CDFCHG,        0
+       TAD I   PTCPR
+       TAD     K1000           /SET CDF * BIT IN P.T.
+       DCA I   PTCPR
+       TAD I   PTSPR   /CHANGE 6211
+       TAD     M10     /TO 6201
+       DCA I   PTSPR
+       JMP I   CDFCHG
+PCALL1=CDFCHG          /TEMP
+
+
+\f*1600
+/
+/      COMMN PSEUDO OPERATION
+/
+PCOMMN, JMS I  GETSYM  /GET ADDRESS FIELD SYMBOL
+       NOP             /NOTHING THERE
+       SKP             /SYMBOL THERE
+       SKP CLA         /CONSTANT
+       IERROR          /LITERAL
+       JMS I   SKIPL
+       TAD     LFS
+       SNA CLA         /IS THERE AN LFS
+       JMP     COMMN2  /NO ... JUST INCREMENT COUNTERS
+       JMS I   OBSYM   /GET POINTERS TO LFS
+       LFS
+       TAD     USE     /MST USE WORD
+       AND     K3      /SAVE SYMBOL LENGTH
+       TAD     K440    /ADD CORRECT BITS
+       DCA     USE     /FOR NEW MST USE WORD
+       TAD     S0      /NO OF COMMON LOCATIONS
+       SNA CLA         /ARE THERE ZERO
+       JMP     COMMN1  /YES ... EQUIVALENCE OUTPUT
+       TAD     HICOM   /NO ... HIGHEST COMMON LOCATION USED
+       TAD     S0      /+SIZE OF THIS BLOCK
+       DCA     TEM1    /FOR TENTATIVE NEW HIGHEST
+       TAD     TEM1    /ACTUAL ADDRESS
+       AND     K7600   /ARE WE OVERFLOWING ONTO THE LAST PAGE
+       TAD     M7600
+       SZL CLA
+       SERROR          /YES ... ERROR
+       TAD     HICOM   /LAST COMMON ASSIGNMENT
+       IAC             /+1
+       DCA     VAL     /GIVES NEW ADDRESS
+       TAD     TEM1    /NEW HIGHEST COMMON LOCATION
+       DCA     HICOM   /TO PROPER LOC
+COMMN0,        TAD     VAL
+       JMP I   NULLP   /GO GET NEXT LINE
+/
+/      EQUIVALENCE GENERATED COMMON OUTPUT
+/
+COMMN1, TAD    HICOM   /PLACE LAST COMMON ASSIGNMENT
+       IAC             /+1
+       DCA     VAL     /IN MST AS ADDRESS
+       JMP     COMMN0  /EXIT
+/
+/      NON LOCATION FIELD SYMBOL COMMON ASSIGNMENT
+/
+COMMN2, TAD    HICOM   /LAST HIGHEST
+       TAD     S0      /+CUR ASSIGNMENT
+       DCA     HICOM   /FOR NEW HIGHEST
+       TAD     HICOM   /NEW HIGHEST
+       AND     K7600   /ARE WE OVERFLOWING ONTO THE LAST PAGE
+       TAD     M7600
+       SZL CLA
+       SERROR          /YES ... ERROR
+       JMP     COMMN0  /NO ... EXIT
+K440,  0440
+
+/TEXT PSUEDO-OP
+
+PTEXT, TAD     FORFLG
+       SMA SZA CLA
+       JMP I   DCIL1
+       JMS I   GETCHR          /LOOK FOR STRING START
+       JMS I   TEST
+               SL1-1
+               BL1-SL1
+       TAD     CHR             /SAVE OPENING DELINEATOR
+       CIA
+       DCA     DELIN
+       DCA     TEXCTR          /CLR CHAR CTR
+       TAD     X0              /SAVE AUTO-INDEX TO START OF STR
+       DCA     TEXSUB
+TEX1,  JMS I   GETCHR          /LOOK FOR END OF STRING
+       SNA
+TEXERR,        IERROR                  /TOO SOON END OF LINE
+       TAD     DELIN
+       SNA CLA
+       JMP     TEX2            /THE END OF THE LINE
+       ISZ     TEXCTR          /KEEP STRING TALLY
+       JMP     TEX1
+TEX2,  JMS I   GETCHR          /MOVE LINE PTR TO CHAR. AFTER DELINEATOR
+       CLA
+       JMS I   SKIPL
+       JMS I   PUSH            /SAVE INFO FOR A MINUTE
+       TAD     TEXCTR
+       IAC
+       CLL RAR                 /DIV BY 2
+       JMS I   IFFS            /SEE IF STR WILL FIT ON PAGE
+       SKP CLA
+       JMS I   INI             /HAD TO ASSMBL: RE-INIT PT
+       JMS I   POP             /POP LINE INFO
+       JMS I   ICPLFS          /PROCESS LFS
+       TAD     TEXCTR
+       CIA
+       DCA     TEXCTR
+       TAD     TEXSUB          /RE-INIT STRING INDEX
+       DCA     X0
+       DCA     BYTE            /SET FOR LEFT BYTE
+TEX5,  JMS I   GETCHR
+       AND     K77             /EXTRACT 6 BIT
+       ISZ     BYTE
+       SKP
+       JMP     TEX4            /RIGHT BYTE
+       CLL RTL
+       RTL                     /MOVE LEFT
+       RTL
+       DCA     TXSV
+       CMA                     /SET PTR TO RT BYTE
+       DCA     BYTE
+       SKP
+TEX4,  JMS     TEXSUB
+       ISZ     TEXCTR
+       JMP     TEX5            /NOT DONE
+       ISZ     BYTE            /CK FOR ODD CHAR LEFT OVER
+       SKP                     /NO
+       JMS     TEXSUB          /YES
+       JMP I   POPEXP
+
+TEXSUB,        0
+       TAD     TXSV            /COMBINE LEFT & RT BYTES
+       DCA I   PTSPR
+       TAD     K30             /PAR CONST BITS
+       TAD I   PTCPR
+       DCA I   PTCPR
+       TAD     X0              /SAVE INDEX
+       DCA     TXSV
+       JMS I   ASIF            /INC PTRS & ASSMBL IF PASS 2
+       TAD     TXSV            /RESTOR INDEX
+       DCA     X0
+       JMP I   TEXSUB
+
+PUSH,  PUSHIN
+POP,   POPIN
+ASIF,  ASMIF1
+IFFS,  IFFSUB
+DELIN, 0
+TEXCTR,        0
+TXSV=S3
+BYTE=DELIN
+
+
+
+/
+/WRITE LINE IF IN PASS 2
+/
+WLNIF1,        0
+       TAD     PASS            /WHICH PASS?
+       SZA CLA
+       JMS I   WLNP            /LISTING
+       JMP I   WLNIF1
+
+/
+\f*2000
+
+/READ & DECODE 1 LINE
+/IGNORES NULL LINES & COMMENT LINES
+/      EXP=NON-0 IF NO OPERATION ON LINE (CONST, LIT,
+/      OR ADDRESS ONLY)
+/      SK=NON-0 IF SKIP INSTR.
+/      UMIC=NON-0 IF OP CODE IS 6 OR 7
+/      IB=NON-0 IF INSTR IS INDIRECT
+/      NSGN=NON-0 IF AFS IS # SYMBOL
+/      OP=OP CODE
+/      LFS=PTR TO LFS IN SYM. TAB., IF ANY
+/***   AFS=2 IF CONSTANT PARAMETER OR CONST. AFS***
+/***   AFS=1 IF LITERAL PARAMETER OR LIT. AFS***
+/      AFS=SYM. TAB. PTR. TO ADDRESS PARAMETER OR AFS
+/
+DCIL,  0
+RDL1,  JMS I   RLNP            /READ IN A LINE
+       DCA LFS         /CLR STORAGE FOR LINE INFO
+       DCA EXP
+       DCA OP
+       DCA SK
+       DCA IB
+       DCA     NSGN
+       DCA UMIC
+       DCA I   RECTI           /CLR RECOUNT FLAG FOR CPLFS
+       ISZ     LINE            /INC LINE COUNT
+       ISZ     X0              /DO NOT BACK UP X0
+       JMS I GETSYM            /READ 1ST ITEM
+       JMP     RDL11           /NULL LINE OR COMMENT
+       JMP RDL7                /SYMBOL - POSSIBLE LFS
+       JMP     .+3             /SET AFS=2 FOR CONSTANT
+RDL3,  JMS I   SLITAB          /PUT LIT ON TAB
+       CMA                     /AFS=1 FOR LITERAL
+RDL2,  TAD     K2
+       ISZ EXP         /SET PARAMETER EXPRESSION FLAG
+RDL5,  DCA AFS
+       JMS I SKIPL             /SKIP TO END OF LINE
+       JMP I DCIL              /RETURN
+RDL7,  TAD     CHR             /CK FOR COMMA
+       TAD     M254
+       SZA CLA
+       JMP     RDL9            /NO, SHOULD BE SPACE,TAB,CR,OR ;
+       JMS I   WHATPP
+       SKP
+       IERROR                  /OP SYMBOL AS TAG
+       TAD SYMBOL              /NO, ENTER PTR TO LFS
+       DCA LFS
+       ISZ     X0              /PROHIBIT FLAGGING COMMA
+       JMS I GETSYM            /GET ITEM AFTER LFS
+       JMP I PB0               /NULL AFTER LFS IS BSS0
+       JMP RDL9                /SYMBOL-OP OR PARAMETER
+       JMP     RDL2            /CONSTANT
+       JMP RDL3                /LITERAL
+RDL9,  JMS I   WHATPP
+       JMP RDL4                /NO-MUST BE ADDRESS PARAMETER
+       TAD USE         /IS SYMBOLE A PSUEDO-OP
+       AND     K40
+       SZA CLA         /NO
+       JMP RDL18               /YES
+       TAD     USE             /IS SYMBOL AN MRI?
+       AND     K400
+       SNA CLA
+       JMP RDL14               /NO-OPR OR I/O INSTR.
+       TAD USE         /MRI-PUT OP SKIP BIT
+       AND     K20             /INTO SKIP FLAG
+       DCA SK
+       TAD     VAL
+       DCA     OP
+       SKP
+RDL10, ISZ IB          / SET INDIRECT FLAG
+       JMS I GETSYM            /READ SYMBOL AFTER MRI
+       IERROR                  /NOTHING THERE
+       JMP RDL12               /SYMBOL
+       IAC             /AFS=2 FOR CONST. AFS
+       IAC             /AFS=1 FOR LIT.AFS
+       JMP RDL5                /SKIP TO END OF LINE
+
+RDL12, TAD SYMBOL              /CK FOR I
+       CIA
+       TAD IBTI                /SYM. ADDR-I ADDR
+       SNA CLA         /NOT I
+       JMP RDL10               /IT IS I
+       JMS I   WHATPP
+       JMP     .+3
+       IERROR                  /AFS NOT USER SYMBOL
+RDL4,  ISZ     EXP     /ENTER HERE ON ADDRESS PAR.
+       TAD     CHR     /CK FOR #
+       TAD     M243
+       SZA CLA
+       JMP     .+4
+       ISZ     NSGN    /YES
+       JMS I   GETCHR          /PREVENT FLAGGING #
+       CLA
+       TAD SYMBOL              /SET PTR TO AFS
+       JMP RDL5
+RDL13, JMS I   WHATPP
+       IERROR                  /ELIM USER SYM
+       TAD USE         /CK FOR OPR OR I/O INST.
+       AND     K4440   /ELIM. MRI, PSUEDO
+       SZA CLA         /OK
+       IERROR                  /ILLEGAL SYMBOL 
+RDL14, TAD USE         /COMPARE NEW MICRO-GRP
+       AND K300                /WITH OLD, IF ANY
+       SNA
+       JMP RDL16               /GRP0 OK WITH ANYTHING
+       DCA TEM1                /NEW IS NOT 0
+       TAD MGRP                /CK OLD MGP, IF ANY
+       SNA             /THERE IS ONE
+       JMP RDL15               /0 OK WITH ANY NEW
+       CIA             /COMPARE OLD
+       TAD TEM1                /WITH NEW
+       SZA CLA         /SAME-OK
+       IERROR                  /ILLEGAL COMBINATION
+RDL15, TAD TEM1                /MICRO-GRP=NEW
+       DCA MGRP
+RDL16, TAD VAL         /OR NEW VALUE INTO OLD OP
+       CMA             /NOT A
+       AND OP          /AND B
+       TAD VAL         /+A
+       DCA OP          /=A OR B
+       TAD USE         /GET NEW SKIP BIT
+       AND     K20
+       SZA CLA         /NON-SKIP
+       ISZ SK          /SET SKIP FLAG
+       JMS I GETSYM            /GET NEXT INSTR OF STRING
+       JMP     RDL17           /NONE THERE - END OF SRTING
+       JMP RDL13               /SYMBOL (AS EXPECTED)
+       NOP             /CONST, ILLEGAL
+       IERROR          /LIT ILLEGAL
+RDL17, ISZ UMIC        /SET MICRO INST FLAG
+       JMP RDL5                /SKIP TO END OF LINE
+IBTI,  II
+MGRP=UMIC
+RLNP,  RLN
+PB0,   PBSS2
+K4440, 440
+K300,  300
+WHATPP,        WHATYP
+M243,  -243
+
+/NULL LINE OR COMMENT
+
+RDL11, JMS I   SKIPL
+       JMP I   NULLP
+
+/PSUEDO-OP
+
+RDL18, TAD VAL         /GET PSUEDO-OP ADDRESS
+       DCA TEM1                /STORE PTR
+       JMP I TEM1              /TO PROPER PSUEDO-OP HANDLER
+
+\f*2200
+/
+/END OF LINE PROCESSOR FOR COLLECTION PHASE
+/LOOKS FOR SEMI-COLON BEFORE A SLASH
+/STAR OR SLASH OR 000 (CR) MEANS NORMAL
+/END OF LINE.  SEMI-COLON MEANS WE MUST
+/SAVE CURRENT ADDRESS IN LINE BUFFER FOR
+/START OF "NEXT" LINE.
+/THIS ROUTINE ALSO HAS THE IMPORTANT
+/FUNCTION OF WATCHING THE FORTR PSUEDO-OP
+/FLAG.  IF FLAG IS ON L72 CAUSES LINE
+/TO BE TREATED AS NON-EXISTENT.  L72 MUST
+/BE CALLED FOR EVER INSTR. LINE OR PSUEDO-OP
+/LINE (EXCEPT END, PAUSE, FORTR) BEFORE
+/ACTUAL PROCESSING OF THAT LINE BEGINS.
+/
+L72,   0
+       SKP
+       JMS I   GETCHR
+       JMS I   TEST
+               SL6-1
+               BL7-SL6
+       IERROR
+L72S,  TAD     X0
+       DCA     SCOLON
+L72X,  TAD     FORFLG          /IF FLG=1 WE ARE SKIPPING
+       SMA SZA CLA             /1ST HALF OF FORTRAN OUTPUT
+       JMP I   DCIL1
+       JMP I   L72
+
+/KLUDGE TO RESET ILC BECAUSE A1 COMES BEFORE UDPAGE IN PASS 2
+
+FIXILC,        0
+       TAD     PASS
+       SNA CLA
+       JMP I   FIXILC
+       TAD     PAG
+       DCA     ILC
+       JMP I   FIXILC
+
+
+
+/
+/COLLECTION PHASE ROUTINE
+/SEARCH PAGE SYMBOL TABLE FOR SYMBOL
+/CALLING SEQUENCE:     (ASSUMES SYM.ID.IS IN "SYMBOL")
+/              JMS     SPSTB
+/              RETURN IF NOT FOUND (HAD TO ENTER IT)
+/              RETURN IF FOUND
+/THE SEARCH IS AT L31; ENTERING DONE BY L32.
+/
+SPSTB, 0
+       TAD     PSTSZE  /SIZE OF PST
+       SZA             /IS IT EMPTY
+       JMP     L31     /NO
+L32,   TAD     PSTSZE          /IS PST FULL?
+       TAD     PSTMAX
+       SMA CLA
+       SERROR                  /YES
+       TAD     PSTSZE  /SIZE OF PST*2
+       RAL CLL
+       TAD     PSTBSE  /+BASE
+       DCA     PSTSPR  /GIVES POINTER TO SYMBOL
+       ISZ     PSTSZE  / INCREMENT COUNTER
+       TAD     SYMBOL  /PHYSICALLY MOVE SYMBOL
+       DCA I   PSTSPR
+       TAD     PSTSPR
+       IAC             /ADD 1
+       DCA     PSTCPR  /FOR CODE WORD POINTER
+       TAD     PASS
+       SNA CLA
+       JMP     L32A            /ASSEMBLY: JUST ZERO CODE WORD
+       JMS I   OBSYM           /LISTING
+       SYMBOL
+       TAD     VAL             /CK IF SYM IS ON PAGE FORWARD REF.
+       AND     K7600           /EXTRACT PAGE BITS
+       CIA
+       TAD     PAG
+       SZA CLA
+       JMP     L32A            /NOT ON PAGE
+       TAD     K4000           /ON PAGE: SET DEFINED BIT
+       ISZ     SPSTB           /& SET FOR "FOUND" RETURN
+L32A,  DCA I   PSTCPR
+       JMP I   SPSTB   /NOT FOUND
+/
+L31,   CIA             /PLACE - COUNT OF TABLE
+       DCA     TEM1    /IN INDEX LOC
+       TAD     PSTBSE  /PLACE TABLE BASE
+       DCA     TEM2    /IN ADDRESS LOC
+L31B,  TAD I   TEM2    /-SYMBOL
+       CIA
+       TAD     SYMBOL  /+ REQUESTED SYMBOL
+       SNA CLA
+       JMP     L31A    /FOUND
+       ISZ     TEM2    /NOT FOUNE ... INCREMENT ADDRESS
+       ISZ     TEM2
+       ISZ     TEM1    /OVER
+       JMP     L31B    /NO ... TRY AGAIN
+       JMP     L32     /YES ... PLACE ON TABLE
+L31A,  ISZ     SPSTB   /FOUND ... INDEX FOR EXIT
+       TAD     TEM2    /POINTER TO SYMBOL
+       DCA     PSTSPR  /TO PROPER LOC
+       TAD     PSTSPR  /SYMBOL POINTER
+       IAC             /+1
+       DCA     PSTCPR  /GIVES CODE POINTER
+       JMP I   SPSTB   /EXIT
+/
+PSTMAX,        -100            /MUST BE (PSTB-PTB)/2
+
+
+
+/
+/OUTPUT 6 CHARACTER ASCII NAME
+/TO BINARY TAPE
+/FOR EXTERNAL SYMBOL DEFN.
+/USED BY LFSCK (FOR RC=03) & 666 (FOR RC=17)
+/OUTPUT GOES VIA TYPE PTR, BUT PTR IS 
+/CHANGED TO L66E SO CHAR CAN BE PUNCHED
+/& ADDED TO CK.SUM INSTEAD OF TYPED.
+/668 IS USED ONLY IN PAS1-
+/ASSEMBLY PHASE1
+/
+L68,   0
+       TAD     PASS
+       SZA CLA
+       JMP I   L68             /EXIT IF LISTING
+       TAD     L66B    /FOOL OUTPUT ROUTINE
+       DCA     TYPE    /SO IT THINKS PUNCH IS TTY
+       DCA     S1
+       DCA     S2
+       DCA     S3
+       TAD     AS0
+       DCA     X1
+       TAD     SYMBOL  /MST SYMBOL ADDRESS - 1
+       DCA     X2      /TO AUTO X2
+       TAD     USE     /MST USE WORD
+       AND     K3      /SYMBOL LENGTH
+       CIA
+       DCA     TEM4    /-WORDS TO LOC
+       CDF 00
+       TAD I   X2      /OBTAIN SYMBOL
+       CDF 10
+       DCA I   X1
+       ISZ     TEM4
+       JMP     .-5
+       TAD     AS0
+       DCA     X2
+       TAD     M3
+       DCA     TEM4
+       TAD I   X2
+       JMS I   CTYPE   /PUNCH IT EXPANDED
+       ISZ     TEM4    /MORE
+       JMP     .-3     /YES
+       TAD     L66D    /RESTORE TYPE ROUTINE
+       DCA     TYPE
+       JMP I   L68
+/
+/      DUMMY TYPE ROUTINE FOR EST TV DEFINITION
+/
+T8=SPSTB               /SCRATCH LOC
+L66E,  0
+       DCA     T8      /SAVE CHAR
+       TAD     T8
+       TAD     CSUM    /ADD CHAR TO BINARY CHECK SUM
+       DCA     CSUM
+       TAD     T8
+       JMS I   PUNCH   /OUTPUT CHAR ON BINARY TAPE
+       JMP I   L66E    /RETURN
+L66B,  L66E
+L66D,  L64
+
+
+/
+/INITIALIZATION THAT WONT FIT IN "INITA"
+/
+INITMR,        0
+       DCA I   VALPTP
+       DCA I   LLFSP
+       DCA     LINE
+       JMP I   INITMR
+VALPTP,        VALPTR
+LLFSP, LLFS
+
+\f*2400
+
+
+/
+/COLLECTION PHASE ROUTINE.
+/SEARCH LITERAL TABLE FOR VALUE IN S0.
+/PLACES LITERAL ON TABLE IS NOT THERE.
+/OTHERWISE DOES NOTHING.
+/
+SLTAB, 0
+       CLA
+       TAD     LTSZE   /SIZE OF TABLE
+       SZA             /IS TABLE EMPTY
+       JMP     SLITB1  /NO ... SEARCH IT
+       TAD     LTBSE   /BASE COLL. PHASE LIT. TABLE)
+       TAD     LTSZE   /+DISPLACEMENT
+       DCA     TEM1    /GIVES ADDRESS POINTER
+       TAD     S0      /PHYSICALLY MOVE LITERAL
+       CDF 00
+       DCA I   TEM1
+       ISZ     LTSZE   /INCREMENT COUNT
+       CDF 10
+       JMP I   SLTAB   /RETURN
+SLITB1, CIA            /PLACE - COUNT
+       DCA     TEM1
+       CMA
+       TAD     LTBSE   /LTBSE-1
+       DCA     X1      /TO AUTO X1
+SLITB2, CDF 00
+       TAD I   X1      /-TABLE
+       CDF 10
+       CIA
+       TAD     S0      /+REQUESTED LITERAL
+       SNA CLA         /SAME
+       JMP I   SLTAB   /YES, RETURN
+       ISZ     TEM1    /MORE SYMBOLS TO TEST
+       JMP     SLITB2  /YES
+       JMP     SLTAB+5      /NO
+
+
+/
+/COLLECTION PHASE EQUIVALENCE PROCESSOR
+/(FORMERLY CALLED BSS0 PROCESSOR)
+/ENTERS SYMBOL ID. IN EQ. TAB
+/
+PBSS2, JMS I   SKIPL
+       TAD     LFS     /LOCATION FIELD SYMBOL
+       SNA CLA         /IS THERE ANY
+       JMP I   NULLP           /NO
+       CDF 00
+       TAD     BSSSW   /ARE WE PROCESSING A BSS 0 SEQUENCE
+       SZA CLA
+       JMP     .+5     /YES ... SKIP INITIALIZING
+       TAD     EQVIPR  /NO ... INITIALIZE 
+       DCA     CTPTR   /SET INPUT POINTER TO COUNT LOCATION
+       DCA I   CTPTR   /ZERO COUNT
+       ISZ     EQVIPR          /INCREMENT INPUT POINTER
+       TAD     LFS     /LOCATION FIELD SYMBOL
+       DCA I   EQVIPR  /PLACE LFS ON EQUIVALENCE TABLE
+       ISZ I   CTPTR   /INCREMENT COUNT
+       CDF 10
+       JMS I   ICPLFS  /PROCESS IT FOR COLLECTION
+       CLA CMA         /REMOVE LFS FROM LFS TABLE
+       TAD     LFSPTR
+       DCA     LFSPTR
+       ISZ     BSSSW   /SET BSS 0 IN PROGRSS SWITCH
+       CMA                     /REMOVE EXTRA LFS BIT
+       TAD I   PTCPR
+       AND     K7577X          /REMOVE EXTRA BSS0 BIT
+       TAD     K200    /PLACE BSS0 BIT ON PT
+       DCA I   PTCPR
+       TAD     PSTCPR          /SAVE PST ADDRESS IN CASE NEXT LINE OVERFLOWS
+       DCA     EQVBIT
+       ISZ     EQVIPR          /INCREMENT POINTER
+       JMP I   NULLP   /EXIT FOR NEXT LINE
+CTPTR, EQUTB
+LFSBSI,        LFSBSS
+K7577X,        7577
+
+/
+/ASSEMBLY PHASE EQUIVALENCE PROCESSOR
+/EXTRACTS ENTIRE GROUP OF TAGS EQUIVALENCED
+/TO SAME ADDRESS FROM TABLE & DEFINES
+/THEM BY USING LFSCK FROM LFSBSS ON.
+/
+ANUMCK,        0
+       TAD I   PTCPR   /PT CODE WORD
+       AND     K200    /MASK OUT BSS 0 BIT
+       SNA CLA         /IS IT A BSS 0 SYMBOL
+       JMP I   ANUMCK  /NO ... EXIT
+       CMA
+       DCA     BANK            /BANK UNKNOWN
+       TAD     AANUM7  /CHEAT RETURN ADDRESS
+       DCA I   LFSCHK  /SO IT LOOKS LIKE A JMS FROM SOMEWHERE ELSE
+       JMS     GNEQ    /GET COUNT
+       CIA             /NEGATE
+       DCA     OPICTR  /SAVE IN INDEX LOC
+       JMS     GNEQ    /GET SYMBOL
+       JMP I   LFSBSI  /PROCESS SYMBOL
+ANUM7, JMS I   SPSTAB          /SET DEFINED BIT ON PST IN CASE
+       NOP                     /THIS WAS CARRIED OVER
+       JMS I   PSTD            /THE LAST PAGE
+       ISZ     OPICTR  /ANY MORE ?
+       JMP     ANUM7-2 /YES
+       JMP I   ANUMCK  /EXIT
+PSTD,  PSTDEF
+AANUM7,        ANUM7
+/
+/      ROUTINE TO GET NEXT ITEM OFF EQUIVALENCE TABLE
+/
+GNEQ,  0
+       CDF 00
+       TAD I   EQVOPR
+       ISZ     EQVOPR
+       CDF 10
+       JMP I   GNEQ
+/
+/SUBR. TO LIST A LINE IF IN PASS 2
+/
+/CALLING SEQUENCE:     JMS I   WRITEP
+/              JMS I   OUTBIN
+/              LOCATION OF WORD TO OUTPUT
+/              CONSTANT=RELOC. CODE
+/              RETURN
+/(CALL TO OUTBN MUST ALWAYS FOLLOW CALL
+/TO WRITE.)
+/ASSUMES CURRENT PC IS IN "ILC"
+/SETS FLAGS FOR PROPER LISTING
+/& CALLS WLN TO DO THE DRUDGE WORK.
+/
+WRITE, 0
+       TAD     PASS
+       SNA CLA
+       JMP I   WRITE           /PASS 1
+       ISZ     WRITE
+       TAD I   WRITE           /ADDRESS OF VALUE
+       DCA     VALUE
+       TAD I   VALUE           /GET VALUE
+       DCA     VALUE
+       ISZ     VFLG
+       ISZ     WRITE
+       TAD I   WRITE           /GET RELOC. CODE
+       DCA     CODE
+       TAD     CODE
+       SNA
+       JMP     WRITE2
+       RTR                     /CONVERT TO 6BIT
+       RAR
+       AND     K7
+       TAD     K60
+       CLL RTL
+       RTL
+       RTL
+       DCA     ADDRES          /TEM SAVE
+       TAD     CODE
+       AND     K7
+       TAD     K60
+       TAD     ADDRES
+       DCA     CODE
+WRITE2,        TAD     ILC             /CURRENT ADDRESS
+       DCA     ADDRES
+       ISZ     AFLG
+       ISZ     LFLG
+       JMS I   WLNP            /LIST
+       ISZ     WRITE
+       JMP I   WRITE
+K60,   60
+OPICTR=WRITE
+CDZSKP,        JMS     CDZSK
+\f*2600
+/
+/      BLOCK PSEUDO OPERATOR
+/
+PBSS,  JMS I   GETSYM  /GET NEXT INPUT ITEM
+       JMP I   PBSS2I  /NOTHING THERE (BSS 0)
+       SKP             /SYMBOL
+       SKP CLA         /CONSTANT
+       IERROR          /LITERAL
+       JMS I   SKIPL
+       JMS I   IPSHIN  /SAVE ALL CURRENT INFO
+       JMP I   PBSS4I          /CHECK BLOCK SIZE
+PBSS5, JMS     IFFSUB  /CAN THIS FIT IN CORE
+       SKP CLA         /YES
+       JMS I   INI     /NO ... INITIALIZE PT POINTERS
+       JMS I   IPOPIN  /POP CURRENT INFORMATION
+       DCA     BSSSW   /CLEAR BSS0 SWITCH
+       JMS I   ICPLFS  /PROCESS CURRENT LFS
+       TAD     S0      /-BLOCK CONSTANT
+       CIA
+       DCA     TEM12   /TO INDEX LOCATION
+PBSS1, TAD     K30     /PAR CONSTANT PT BIT STRUCTURE
+       TAD I   PTCPR   /DONT LOSE LFS AND BSS 0 INFORMATION
+       DCA I   PTCPR
+       JMS I   ASMIF           /DO THEM INDIVIDUALLY IF PASS 2
+       ISZ     TEM12   /MORE
+       JMP     PBSS1   /YES
+       JMP I   POPEXP  /EXIT TO GET NEXT LINE
+PBSS2I,        PBSS2
+TEM12, 0                       /RESRV STORAGE CTR
+PBSS4I,        PBSS4
+
+/
+/      CPAGE PSEUDO OPERATION
+/
+PIFF,  JMS I   GETSYM  /GET NEXT INPUT ITEM
+       NOP             /NONE THERE
+       SKP             /SYMBOL
+       SKP CLA         /CONSTANT
+       IERROR          /LITERAL
+       JMS I   SKIPL
+       JMS I   WLNIF           /LIST IF PASS 2
+       TAD     S0      /BINARY CONSTANT
+       JMS     IFFSUB  /USE GLOBAL IFF SUBROUTINE
+       JMP I   DCIL1   /DIDNT HAVE TO ASSEMBLE PAGE
+       JMP I   RSTRTI  /GO INITIALIZE
+/
+/      IFF SUBROUTINE
+/      CALL IS         TAD PAGE INCREMENT
+/                      JMS IFFSUB
+/                      OK RETURN
+/                      HAD TO ASSEMBLE PAGE RETURN
+
+/FUNCTION:  TO SEE IF GIVEN NO. OF WORDS
+/WILL FIT ON CUR. PAGE; IF SO, RETURN
+/AT OK RET.; OTHERWISE ASSEMBLE PAGE WE
+/HAVE NOW & INIT A NEW PAGE & RET. AT
+/SECOND RET. LOC.
+/IFFSUB IS USED BY CPAGE,BLOCK &
+/SEVERAL OTHER P-OPS
+/
+/
+IFFSUB, 0
+       DCA     TEM1    /SAVE INCREMENT
+       JMS I   ICPGES  /COMPUTE PAGE SIZE
+       TAD     TEM1    /ADD INCREMENT
+       TAD     M201    /IS TOTAL .GT. PAGE SIZE (1 EXTRA BECAUSE
+       SPA SNA CLA             /PTSZE INCREMENTED BEFORE PSUEDO-OP
+       JMP I   IFFSUB  /NO ... RETURN
+       CLA CMA         /YES ... DECREMENT PAGE TABLE SIZE
+       TAD     PTSIZ
+       SNA             /WATCH FOR AN EMPTY PAGE
+       JMP     .+4     /LEAVE THINGS ALONE IF PAGE EMPTY
+       DCA     PTSIZ
+       JMS I   L55I    /ASSEMBLE THE PAGE
+       JMS I   UPDATE
+       JMS I   FIXIL
+       ISZ     IFFSUB  /INCREMENT FOR EXIT
+       JMP I   IFFSUB  /RETURN
+IPSHIN, PUSHIN
+IPOPIN, POPIN
+WLNIF, WLNIF1
+ASMIF, ASMIF1
+RSTRTI,        RSTRT
+UPDATE,        UDPAGE
+ICPGES=CPGESI
+M201,  -201
+FIXIL, FIXILC
+
+
+/      ERROR ROUTINE
+/
+K6200, 6200
+FATAL, 0
+
+ERRE,  TAD     K6200           /0500
+ERRS,  ISZ     FATAL           /SET FATAL ERROR SWITCH
+       TAD     K600            /2300
+       JMP     .+3
+ERRM,  TAD     LFS
+       DCA I   LLFSI
+       TAD     K400            /1500
+ERRI,  TAD     K600            /1100
+ERRC,  TAD     K200            /0300
+ERRA,  TAD     K100            /0100
+       DCA     EFLG
+       TAD     PASS
+       SZA CLA
+       JMP     ERREX           /LISTING PASS
+       JMS I   CRLF    /TYPE CRLF
+       TAD     EFLG    /TYPE E#
+       JMS I   CTYPE   
+       TAD     AT
+       JMS I   CTYPE
+       JMS I   CTYPE   /TYPE 2 SPACES
+       TAD I   LLFSI
+       DCA     INDEX
+       CDF 00
+       TAD I   INDEX
+       ISZ     INDEX
+       AND     K3
+
+       CMA
+       DCA     COUNT
+       TAD     M3              /SET 6 CHAR PRINT CTR
+       DCA     MSCTR
+       ISZ     COUNT
+       SKP                     /NOT DONE YET WITH SYMBOL
+       JMP     ERR1            /DONE : SEE IF SPACES NEEDED
+       CDF 00
+       TAD I   INDEX
+       CDF 10
+       ISZ     INDEX
+       JMS I   CTYPE           /TYPE THE LETTERS OR SPACES
+       ISZ     MSCTR
+       JMP     .-11
+ERR11, TAD     SPPLUS  /TYPE SPACE +
+       JMS I   TYPE
+       TAD     LINE    /TYPE LINS FROM LAST LFS
+       JMS I   OTYPE
+       JMS I   CRLF
+ERREX, TAD     FATAL           /FATAL ERROR?
+       SNA CLA
+       JMP     .+3             /NO
+       HLT
+       JMP I   K200            /IF YES GO TO START AFTER HALT
+       TAD     PHASE   /WHAT PHASE ARE WE IN
+       SZA CLA
+       JMP I   ERR2    /ASSEMBLY
+       JMP I   NULLP   /COLLECTION
+ERR2,  ASM02R
+
+LLFSI, LLFS
+INDEX=S1
+COUNT=S2
+MSCTR=S3
+AT,    0124
+SPPLUS,        253
+
+ERR1,  JMS I   CTYPE           /FILL OUT THE REST WITH SPACES
+       ISZ     MSCTR
+       JMP     .-2
+       JMP     ERR11
+
+\f*3000
+
+/
+/ASSEMBLY PHASE ROUTINE TO CHECK FOR A
+/LOC. TAG (LFS) & PROCESS IF FOUND.
+/FUNCTION: (ASMBLY PHASE 1 - ACTR=0)
+/         (1) DEFINE TAG
+/         (2) OUTPUT VALUE AT PAST OCCURANCES OF
+/        FORWARD REF. TO THIS TAG
+/         (3) CONDENSE OCC. TAB IF POSSIBLE.
+/
+/         (ASMBLY PHASE 2 - ACTR=1
+/         (THIS INCLUDES ALL OF PASS 2 AS
+/          ACTR STAYS=1 IN PASS 2)
+/         (1) OUTPUT EXT. SYM. DEFN. ON REL-TAPE
+/
+
+LFSCK, 0
+       TAD I   PTCPR   /PT CODE WORD
+       RAR
+       SNL CLA         /IS THERE A LFS
+       JMP I   LFSCK   /NO ... RETURN
+       CMA
+       DCA     BANK            /BANK UNKNOWN
+       TAD     PASS            /MOVE BACK PTR IF IN LISTING PASS
+       CIA
+       TAD     LFSPTR
+       DCA     LFSPTR
+       CDF 00
+       TAD I   LFSPTR  /ACTUAL LFS
+       CDF 10
+       ISZ     LFSPTR
+LFSBSS,        DCA     LFS
+       JMS I   OBSYM   /OBTAIN LFS FROM MST
+       LFS
+       TAD     ACTR    /WHICH TIME ARE WE ASSEMBLING THIS PAGE
+                       /ACTR REMAINS 1 DURING PASS2
+       SZA CLA
+       JMP     L67             /SECOND TIME: NO TEST
+       TAD     USE             /CK FOR MULTI DEF.
+       AND     K400
+       SZA CLA
+       MERROR                  /YES
+       JMP     LFSCK1
+L67,   TAD     USE     /MST USE WORD
+       AND     K200            /(L67 HAS NO EFFECT IN PASS 2)
+       SNA CLA         /IS IT AN ENTRY
+       JMP     LFSCK1  /NO
+/
+/      EXTERNAL SYMBOL DEFINITION
+/
+       JMS I   OUTBIN  /OUTPUT BINARY DEFINITION
+       ILC
+       3
+       JMS I   L68I    /PUNCH SYMBOL ON TAPE
+LFSCK1, TAD    ILC     /CUR ILC
+       DCA     VAL     /PLACE ON MST AS DEFINITION
+       TAD     USE     /SYMBOL TABLE USE WORD
+       AND     K7377   /MASK OUT DEFINED BIT
+       TAD     K400    /ADD IN DEFINED BIT
+       DCA     USE     /SYMBOL IS NOW DEFINED IN MST
+/
+/      NOW LETS SEARCH OCCURANCE TABLE TO SEE IF WE
+/      CAN CLEAR OFF A FEW
+/
+       TAD     OTP     /SIZE OF OCCURANCE TABLE
+       CMA
+       TAD TOPCOR
+       SNA
+       JMP I   LFSCK   /RETURN IF EMPTY
+       CIA
+       DCA     TEM1    /PLACE - SIZE IN INDEX LOC
+       TAD     OTP     /PLACE TABLE BASE IN TEM2
+       DCA     TEM2            /TEM2=PTR TO SYMBOL
+       CDF 00
+L51,   DCA     L51FLG          /CLR # SWITCH
+       ISZ     TEM2
+       CMA                     /CK 1ST WORD FOR # FLAG
+       TAD I   TEM2
+       SZA CLA
+       JMP     .+4             /NO
+       ISZ     L51FLG          /YES, SET SWITCH
+       ISZ     TEM2            /MOVE PTR & CTR
+       ISZ     TEM1            /PAST EXTRA WORD
+       TAD I   TEM2            /- OCCURRING SYMBOL
+       CIA
+       TAD     SYMBOL  /+SYMBOL JUST DEFINED
+       SNA CLA         /ARE THEY EQUAL
+       JMP     .+7
+       ISZ     TEM2
+L51E,  ISZ     TEM1    /NO ... ARE THERE MORE
+       ISZ     TEM1            /(2 WORDS PER OCCURRANCE)
+       JMP     L51     /YES
+       CDF 10
+       JMP I   LFSCK   /NO ... RETURN
+/
+/      AN OCCURANCE FOUND ... OUTPUT IT
+/
+       ISZ     TEM2
+       TAD I   TEM2    /ACTUAL ADDRESS
+       CDF 10
+       DCA     TEM4
+       JMS I   DUMMY   /OUTPUT ADDRESS AS ORIGIN
+       TEM4
+       4
+       TAD     VAL
+       TAD     L51FLG          /ADD 1 IF # REF
+       DCA     TEM4
+       JMS I   DUMMY   /OUTPUT SYMBOL VALUE AS RELOCATABLE DEF
+       TEM4
+       1
+       CDF 00
+/
+/      NOW MOVE OCCURANCE TABLE UP 2
+/
+L51G,  TAD     OTP
+       DCA     TEM4            /SAVE
+       TAD     TEM2
+       DCA     OTP             /RESET
+       TAD     L51FLG
+       TAD     K2
+       CIA
+       TAD     TEM2
+       CIA
+       TAD     TEM4
+       SNA
+       JMP     L51E            /NOTHING TO MOVE
+       DCA     TEM3            /CTR FOR MOVE UP
+       TAD     TEM3
+       CIA
+       TAD     TEM4
+       DCA     TEM4            /TO PTR
+L51J,  TAD I   TEM4
+       DCA I   OTP
+       CMA
+       TAD     TEM4
+       DCA     TEM4
+       CMA
+       TAD     OTP
+       DCA     OTP
+       ISZ     TEM3
+       JMP     L51J
+       JMP     L51E
+
+
+L68I,  L68
+K7377, 7377
+TOPCOR,        CORE1
+MERROR=JMP I .
+               ERRM
+
+/
+/      PUNCH ROUTINE
+/
+L63,   0
+       PLS             /SELECT IT
+       PSF             /WAIT FOR PUNCH
+       JMP     .-1
+       CLA             /EXIT WITH CLEAR AC
+       JMP I   L63
+
+
+
+
+/
+/UPDATE "PAGE" TO NEXT CORE PAGE
+/I.E., PAGE =PAGE+200
+/
+UDPAGE,        0
+       CLA
+       TAD     PAG             /OLD PAGE SETTING
+       TAD     K200            /+SIZE OF ONE PAGE
+       DCA     PAG             /FOR NEW PAGE SETTING
+       JMP I   UDPAGE          /EXIT
+
+L51FLG=UDPAGE
+\f*3200
+/
+/      SUBROUTINE TO OUTPUT ASSEMBLY PHASE LITERAL
+/      TABLE AND REMEMBER OCCURANCES
+/
+OAPLT, 0
+       TAD     ACTR            /SKIP IT THE 1ST TIME
+       SNA CLA
+       JMP I   OAPLT
+       JMS I   SAVLNI          /PREVENT ANY LINE TYPEOUT
+       TAD     LITSIZ  /SIZE OF TABLE
+       SNA
+       JMP I   OAPLT   /RETURN IF NONE
+       CIA
+       DCA     ATEM1   /PLACE - SIZE IN LOC
+       CLA CMA
+       TAD     LITBSE  /BASE - 1
+       DCA     X2      /TO AUTO 12
+       TAD     APMSW   /ARE WE IN AUTO PAGING MODE
+       SZA CLA
+       JMP     .+3     /NO ... OK
+       TAD     PGEESC  /YES ... SUBRTACT SIZE OF PAGE ESCAPE
+       RAR CLL         /DIVIDED BY 2
+       TAD     LITSIZ          /& SUBTR. LITSIZ
+       CIA
+       DCA     LITPTR          /TEM SAVE
+       TAD     LITPTR
+       TAD     PAG     /INITIALIZE PAGE ADDRESS
+       TAD     K200
+       DCA     ILC
+       TAD     LITSIZ          /INIT LIT TBL PTR
+       CLL RAL                 /(MULT BY 2)
+       TAD     LITBSE
+       DCA     LITPTR
+       IAC
+       SKP
+/
+L52,   ISZ     ILC             /INC PAGE LOC
+       TAD     M3      /DECREMENT LIT TBL PTR
+       TAD     LITPTR
+       DCA     LITPTR
+       CDF 00
+       TAD I   LITPTR  /CODE
+       DCA     ATEM2
+       ISZ     LITPTR
+       TAD I   LITPTR  /SYMBOL OR LITERAL
+       DCA     ATEM3
+       CDF 10
+       CLA CMA
+       TAD     ATEM2   /IS CODE 1 ... LITERAL
+       SZA CLA
+       JMP     L53     /NO ... SYMBOL
+       JMS I   ILC4P   /YES ... OUTPUT PAGE ADDRESS AS ORIGIN
+       JMS I   WRITEP
+       JMS I   OUTBIN  /OUTPUT LITERAL WITH NO RELOCATION
+       ATEM3
+       0
+L52A,  ISZ     ATEM1   /MORE
+       JMP     L52     /YES
+       ISZ     ILC             /SET FOR ESCAPE
+       JMP I   OAPLT   /NO ... RETURN
+L53,   JMS I   OBSYM   /OBTAIN SYMBOL FROM MST
+       ATEM3
+       TAD     USE     /MST USE WORD
+       AND     K400    /IS SYMBOL DEFINED
+       SNA CLA
+       JMP     L53A    /NO ... OCCURANCE
+       JMS I   ILC4P   /YES ... OUTPUT ORIGIN
+       TAD     ATEM2
+       AND     K4
+       SZA CLA
+       IAC                     /ITS A #
+       TAD     VAL     /ACTUAL VALUE
+       DCA     ATEM3   /TO DIRRECTLY ADDRESSABLE LOC
+       JMS I   WRITEP
+       JMS I   OUTBIN  /OUTPUT VALUE
+       ATEM3
+       1               /RELOCATABLE
+       JMP     L52A    /TRY MORE
+L53A,  TAD     ILC
+       DCA     ATEM4
+       JMS     L53B    /PLACE ON OCCURANCE TALBE
+       JMP     L52A    /TRY MORE
+/
+/      SUBROUTINE TO CREATE AN OCCURANCE IN OCCURANCE TABLE
+/
+L53B,  0
+       TAD     OTP
+       CIA CLL
+       IAC                     /ALLOW FOR # FLAG
+       TAD     STT     /+TOP OF MST
+       SZL CLA         /OVERFLOW?
+       SERROR          /YES ... OUT OF CORE
+       TAD     M2
+       TAD     OTP     /OT SIZE - 2
+       DCA     OTP     /GIVES ADDRESS ON OCCUR TABLE
+       TAD     OTP
+       DCA     X1
+       CDF 00
+       TAD     ATEM3   /SYMBOL
+       DCA I   X1      /TO OCCUR TABLE
+       TAD     ATEM4   /PAGE ADDRESS
+       DCA I   X1      /TO OCCUR TABLE
+       TAD     ATEM2           /CK FOR #
+       AND     K4
+       SNA CLA
+       JMP     .+6             /NO
+       IAC                     /SET FLAG WORD
+       DCA I   OTP
+       CMA                     /MOVE DOWN PTR
+       TAD     OTP             /PAST EXTRA WORD
+       DCA     OTP
+       CDF 10
+       JMP I   L53B    /TRY MORE
+/
+ATEM1, 0
+ATEM2, 0
+ATEM3, 0
+ATEM4, 0
+SAVLNI,        SAVLIN
+LITPTR,        0
+
+PFORT, ISZ     FORFLG          /SET TO 1 FOR 1ST PASS THRU FORTRAN CODE
+       NOP                     /END PSUEDO SETS IT TO -1 TO NULLIFY
+       JMS I   SKIPL           /SO BACK TO 0 FOR 2ND PASS
+       JMP I   NULLP
+
+/
+/DO SOME WORK FOR L61A
+/
+L61C,  DCA     TEM2            /SAVE 6-BIT CODE
+       TAD     TEM2
+       AND     K40
+       SNA CLA
+       TAD     K100            /ADD CORRECT LEADING BITS
+       TAD     K200
+       TAD     TEM2            /ADD CHAR BITS
+       JMP I   L61DP
+L61DP, L61D
+ILC4P, ILC4
+
+\f*3400
+/
+/      ROUTINE TO PUNCH WORD AND RELOCATION BITS ON TAPE
+/      CALL IS
+/      JMS     OUTBN
+/      ADDRESS OF WORD
+/      BITS
+/
+OUTBN, 0
+       CLA CLL
+       TAD I   OUTBN   /ADDRESS OF WORD
+       DCA     OUT1
+       ISZ     OUTBN
+       TAD I   OUTBN   /RELOCATION BITS
+       RTL             /SHIFT LEFT 4
+       RTL
+       DCA     OUT2    /SAVE
+       TAD     PASS
+       SZA CLA
+       JMP     OUTEX
+       TAD I   OUT1    /ACTUAL WORD
+       DCA     OUT1    /MUST DO THIS SINCE WE DO A JMS OUTBN;CSUM;10
+       TAD     OUT1    /AT LOC. PCSM, AND OTHERWISE CSUM WOULD CHANGE AFTER CALL TO SUM.
+       RTL             /ROTATE HIGH 4 BITS TO LOW
+       RTL
+       RAL
+       AND     K17     /MASK
+       TAD     OUT2    /ADD REL BITS
+       JMS     SUM     /ADD TO CHECK SUM
+       JMS I   PUNCH   /PUNCH IT
+       TAD     OUT1    /REMAINDER OF WORD
+       AND     K377    /MASK TO 8 BITS
+       JMS     SUM     /ADD TO CHECK SUM
+       JMS I   PUNCH   /PUNCH IT
+OUTEX, ISZ     OUTBN   /INDEX FOR EXIT
+       JMP I   OUTBN   /RETURN
+SUM,   0
+       DCA     TSUM
+       TAD     CSUM
+       TAD     TSUM
+       DCA     CSUM
+       TAD     TSUM
+       JMP I   SUM
+TSUM=NSGN
+OUT1=IB
+OUT2=TEM5
+K377,  377
+K17,   17
+/
+/      ROUTINE TO SEARCH ASSEMBLY PHASE LITERAL TABLE
+/      FOR 2 WORD ENTRY IN S0-S1
+/      PLACES ON TABLE IF NOT THERE
+/      RETURNS PAGE ADDRESS IN AC
+/
+SRALT, 0
+       CLA
+       DCA     TEM2    /ZERO SEARCH COUNTER
+       CDF 00
+       TAD     LITSIZ  /NO OF ENTRYS
+       SZA
+       JMP     L40     /NON ZERO ... SEARCH
+L39,   TAD     LITSIZ  /NO OF ENTRYS - 1
+       RAL CLL         /MULTIPLY BY 2
+       TAD     LITBSE  /ADD BASE OF TABLE
+       DCA     TEM1    /GIVES ADDRESS OF NEW ENTRY
+       ISZ     LITSIZ  /INCREMENT COUNT
+       TAD     S0      /FIRST WORD
+       DCA I   TEM1    /TO TABLE
+       ISZ     TEM1    /INCREMENT ADDRESS
+       TAD     S1      /SECOND WORD
+       DCA I   TEM1    /TO TABLE
+       TAD     LITSIZ  /ENTRY NO
+
+/      COMPUTE PAGE ADDRESS FROM DISPLACEMENT IN TABLE
+/      AND STATUS OF AUTOMATIC PAGING MODE SWITCH AND SIZE OF PAGE
+/      ESCAPE REQUIRED
+/
+L40A,  DCA     TEM1    /SAVE LOCATION IN TABLE
+       TAD     PASS
+       SZA CLA
+       JMP     L40C            /LISTING
+       TAD     APMSW   /ARE WE IN AUTOMATIC PAGING MODE?
+       SNA CLA
+       TAD     PGEESC  /YES - COUNT ESCAPE WORDS
+L40DR, CLL RAR         /(OVER 2)
+L40D,  TAD     TEM1    /NO ... COMPUTE PAGE ADDRESS
+       CIA             /BY STRAIGNT COMPLEMENTATION METHOD
+       AND     K377    /MASK
+       CDF 10
+       JMP I   SRALT   /EXIT
+                       /FOR AUTO PAGING MODE
+
+L40,   CIA
+       DCA     TEM1    /- NO OF ENTRYS TO LOC
+       CLA CMA
+       TAD     LITBSE  /BASE OF TABLE - 1
+       DCA     X1      /TO AUTO 10
+L41,   ISZ     TEM2    /INCREMENT SEARCH COUNTER
+       TAD I   X1      /- FIRST WORD FROM TABLE
+       CIA
+       TAD     S0      /+FIRST COMP WORD
+       SZA CLA
+       JMP     L40B    /NO MATCH
+       TAD I   X1      /-SECOND TABLE WORD
+       CIA
+       TAD     S1
+       SZA CLA
+       JMP     .+4     /NO MATCH
+       TAD     TEM2    /MATCH ... CTR TO AC
+       JMP     L40A    /RETURN
+L40B,  ISZ     X1      /INCREMENT FOR NO SECOND COMPARISON
+       ISZ     TEM1    /OVER
+       JMP     L41     /NO ... TRY MORE
+       JMP     L39     /YES ... PLACE ON TABLE
+L40C,  CDF 10
+       TAD I   REDUCP          /GET PAGE ESC COMPUTED BY A1
+       JMP     L40DR
+REDUCP,        REDUCE
+
+/
+/      HAS COMMON BEEN PUNCHED YET SUBROUTINE
+
+/IF IT HAS ALREADY BEEN PUNCHED, EXIT
+/IF NOT, PUNCH IT & SET FLAG
+/THIS ROUTINE IS CALLED ONLY ONCE PER PROGRAM
+/BUT IT COULD BE CALLED FROM ANY OF SEVERAL PLACES
+/
+HCBPS, 0
+       TAD     CPSW    /COMMON PUNCHED SWITCH
+       SNA CLA         /HAS IT BEEN PUNCHED
+       JMP I   HCBPS   /YES ... RETURN
+       DCA     CPSW    /NO ... CLEAR SWITCH
+       JMS I   OUTBIN  /AND PUNCH HIGHEST COMMON ASSIGNED
+       HICOM
+       12
+       JMP I   HCBPS   /EXIT
+
+DUMSUB,        JMS     DUMS
+
+
+/
+/INCREMENT PAGE TABLE PTRS
+/TO PREPARE FOR NEXT INSTRUCTION (OR PARAMETER)
+/
+INCPT, 0
+       ISZ     PTSZE   /INCREMENT PAGE TABLE SIZE
+       JMS I   ISZPT2
+       DCA     EQVBIT          /CLR
+       DCA I   PTCPR   /INITIALIZE PAGE TABLE CODE WORD
+       DCA I   PTSPR   /INITIALIZE PAGE TABLE SYMBOL WORD
+       CDF 00
+       DCA I   PTOPR   /INITIALIZE PT OP CODE POINTER
+       CDF 10
+       TAD     CURSKP  /MOVE CURRENT SKIP INSTRUCTION INDICATOR
+       DCA     LSTSKP  /TO LAST INSTRUCTION SKIP INDICATOR
+       TAD     BANK    /MOVE CURRENT BANK
+       DCA     LSTBNK  /TO LAST BANK
+       JMP I   INCPT   /RETURN
+ISZPT2,        ISZPT
+//
+//FOLLOWING CODE MOVED HERE TO MAKE ROOM FOR V03 IN ASME3
+ASMEXT,        JMS I   OUTSKP          /YES, OUTPUT SKP
+       TAD     ILC             /GET PG.LOC.PTR.
+       AND     K177
+       TAD     K5204           /OUTPUT JMP .+4
+       DCA     TEM1
+       JMP I   .+1
+       REEASM
+K5204, 5204
+
+
+\f*3600
+
+/      ABSYM PSEUDO OPERATOR
+/
+PABSYM,        TAD     K400
+       JMS     DEFSUB
+       CLA
+       JMP     DEF1
+
+/SKPDF & OPDEF PSUEDO-OPS
+
+
+SKPDEX,        TAD     K20     /PUT IN SKIP BIT
+OPDEX, TAD     K3010   /STANDARD OP BITS
+       JMS     DEFSUB
+       CLL
+       AND     K7000   /CK TYPE OF INST
+       TAD     K2000
+       SNA CLA
+       JMP     DEF1    /IOT
+       SNL
+       JMP     DEF3    /MRI
+       TAD     S0      /OPR, BUT WHICH GRP?
+       AND     K401
+       CLL RAR
+       SNA CLA
+       JMP     DEF2    /GRP1
+       SZL
+       TAD     K100    /GRP3
+       TAD     K200    /GRP2
+DEF1,  TAD     TEM5
+       DCA     USE
+       TAD     S0
+       DCA     VAL
+       TAD     VAL
+       JMP I   NULLP
+DEF2,  TAD     K100
+       JMP     DEF1
+DEF3,  TAD     K400
+       JMP     DEF1
+K401,  401
+K3010, 3010
+
+
+/
+/UTILITY FOR PABSYM & OPDEX
+/CALL WITH MST CODE WORD EXCEPT BITS 10-11
+/IN AC. EXITS WITH SYMBOL VALUE
+/AS DEF. BY SOURCE TAPE IN S0 & IN AC.
+/
+DEFSUB,        0
+       DCA     TEM5
+       JMS I   GETSYM  /GET THE SYMBOL NAME
+       JMP     DEFERR  /NULL
+       JMP     .+3     /SYMBOL
+K7000, NOP
+       JMP     DEFERR  /CONST. OR LIT.
+       TAD     S0      /ADD IN SYM LENGTH
+       TAD     TEM5
+       DCA     TEM5
+       JMS I   GETSYM  /GET VALUE
+       NOP             /NULL
+       SKP             /SYMBOL
+K7410, SKP             /CONST
+DEFERR,        IERROR          /LIT.
+       JMS I   SKIPL
+       TAD     S0      /VALUE
+       JMP I   DEFSUB
+
+/
+/OCTAL TYPEOUT
+/CALLING SEQUENCE:     TAD     (OCTAL#)
+/                      JMS     L62
+/                      RET.    AC=0
+/
+
+L62,   0
+       CLL RAL         /PUSH THRU LINK
+       DCA     TEM1
+       TAD     M4      /SET CTR
+       DCA     TEM2
+L62A,  TAD     TEM1
+       RTL
+       RAL
+       DCA     TEM1
+       TAD     TEM1
+       AND     K7
+       TAD     K260
+       JMS I   TYPE
+       ISZ     TEM2
+       JMP     L62A
+       JMP I   L62
+M4,    -4
+K260,  0260
+
+/
+/DUMMY OUTPUT ROUTINE
+/REPLACES OUTBN DURING ASMBLY PHASE 1
+/CALLING SEQUENCE:     JMS     DUMMY
+/                      ADDR. OF ARG
+/                      RELOC. CONST.
+/                      RETURN
+/NOTE: SAME CALLING SEQ. AS OUTBN
+/
+DUM,   0
+       CLA CLL
+       ISZ     DUM     /INDEX FOR PROPER EXIT
+       ISZ     DUM     /INDEX FOR PROPER EXIT
+       JMP I   DUM
+/
+/      ROUTINE TO SEARCH EXTERNAL SYMBOL TABLE
+/      FOR CUR SYMBOL - RETURNS EXTERNAL SYMBOL
+/      NUMBER IN AC - PLACES SYMBOL ON TABLE
+/      AND OUTPUTS BIN CODE FOR TV IF NOT ON TABLE
+/
+L66,   0
+       TAD     ESTSIZ          /IS TABLE FULL?
+       TAD     M100
+M100,  SMA CLA
+       SERROR                  /YES
+       TAD     ESTSIZ  /SIZE OF EST
+       SZA             /IS TABLE EMPTY
+       JMP     L66A1   /NO ... SEARCH IT
+L66A3, CLA CMA         /YES ... PLACE SYMBOL ON IT
+       ISZ     ESTSIZ  /INCREMENT TABLE SIZE
+       TAD     BSEEST  /BASE
+       TAD     ESTSIZ  /+SIZE
+       DCA     TEM1    /GIVES ADDRESS OF NEW ENTRY
+       TAD     SYMBOL  /PHYSICALLY PLACE ON TABLE
+       CDF 00
+       DCA I   TEM1
+       CDF 10
+       TAD     USE     /MST CODE WORD
+       AND     K403A   /SAVE LENGTH AND DEFINITION BIT
+       TAD     K2000   /ADD EXTERNAL BITS
+       DCA     USE
+       JMP     L66A    /GO TO PUNCH TV DEF
+L66A1, CIA
+       DCA     TEM2    /PLACE -SIZE IN INDEX LOC
+       DCA     TEM3    /ZERO COUNT
+       CLA CMA
+       TAD     BSEEST  /BASE OF EST - 1
+       DCA     X1      /TO AUTO X1
+L66A2, ISZ     TEM3    /INCREMENT COUNT LOC
+       CDF 00
+       TAD I   X1      /-TABLE SYMBOL
+       CDF 10
+       CIA
+       TAD     SYMBOL  /+ CUR SYMBOL
+       SNA CLA         /COMPARE
+       JMP     .+4     /SAVE
+       ISZ     TEM2    /NOT SAME ... ANY MORE
+       JMP     L66A2   /YES ... KEEP TRYING
+       JMP     L66A3   /NO ... PLACE ON TABLE
+       TAD     TEM3    /PLACE COUNT IN AC
+       JMP I   L66     /RETURN
+/
+/      OUTPUT BINARY EXTERNAL SYMBOL
+/
+       HCBPS
+L66A,  JMS I   .-1     /CHECK TO SEE IF COMMON HAS BEEN PUNCHED
+       JMS I   OUTBIN  /TV DEF FOR 1 SYMBOL
+       K1
+       17
+       JMS I   L62A1   /PUNCH ASCII CHARS
+       TAD     ESTSIZ  /EST NO TO AC
+       JMP I   L66     /RETURN
+L62A1, L68
+K403A, 403
+K1,    1
+
+\f*4000
+
+
+
+/
+/SYMBOL TABLE LISTING ROUTINE
+/TYPES TABLE FROM "STTP" UP
+/WITH NAME-VALUE-FLAG
+/POSSIBLE FLAGS ARE:  EXT, COM, UNDF, ABS, OP
+/FLAGS TYPED BY "STFT"
+/TABLE LISTED ALPHABETICALLY WITH NUMERIC
+/CHARACTERS .GT. ALPHABETIC
+/
+
+PRSYM, 0
+       DCA     PFLG            /CLR PRSYM-PASS FLAG
+       TAD I   LSTDEP
+       SNA CLA
+       JMP     .+3
+       TAD     PUNCH           /LIST ON H.S. PUNCH
+       DCA     TYPE
+       JMS I   CRLF
+PRS1,  TAD     PST             /INIT SPTR AT TOP OF PERM. S.T.
+       DCA     SPTR
+       TAD     M3              /FILL S1,S2,S3 WITH 7777'S (MAX)
+       DCA     ALEN
+       TAD     APTR
+       DCA     X1
+       CMA
+       DCA I   X1
+       ISZ     ALEN
+       JMP     .-3
+       TAD     K3              /AND LENGTH=3
+       DCA     ALEN
+       DCA     FOUND           /CLR EXIT FLAG
+PRS2,  TAD     STT             /HAS SEARCH HIT END OF TABLE?
+       CIA
+       TAD     SPTR
+       SNA CLA
+       JMP     PRS7            /YES, USE THE A-SYM WE HAVE
+       JMS I   OBSYM           /NO, GET NEXT MST ENTRY
+               SPTR
+       TAD     BCODE           /EXTRACT LENGTH
+       AND     K3
+       DCA     BLEN
+       TAD     BPTR            /INDEX NEW ENTRY
+       DCA     X2
+       TAD     BLEN            /SET ENTRY CTR
+       CIA
+       DCA     BCTR
+       TAD     ALEN            /SET A-SYM CTR
+       CIA
+       DCA     AACTR
+       TAD     APTR            /INDEX A-SYM
+       DCA     X1
+       TAD     PFLG            /IS THIS THE FIRST TIME THRU THE TABLE?
+       SZA CLA
+       JMP     PRS3            /NO
+       TAD     BCODE           /YES, CLR ENTRY BIT 0
+       AND     K3777           /(THE HAS-BEEN-PRINTED FLAG)
+       DCA     BCODE
+PRS3,  TAD     BCODE           /HAS THIS SYMBOL BEEN PRINTED ALREADY?
+       SPA CLA
+       JMP     PRS6            /YES, IGNORE IT
+PRS4,  TAD I   X1              /NO, COMRARE A-SYM WORD
+       CIA CLL
+       CDF 00
+       TAD I   X2              /WITH B-SYM WORD
+       CDF 10
+       SNA
+       JMP     .+4             /MATCH SO FAR
+       SNL CLA
+       JMP     PRS5            /A-SYM WORD IS BIGGER-- USE B-SYM
+       JMP     PRS6            /VICE-VERSA
+       ISZ     AACTR           /IS A-SYM DONE?
+       SKP                     /NO
+       JMP     PRS6            /YES, STICK WITH A-SYM
+       ISZ     BCTR            /IS B-SYM DONE
+       JMP     PRS4            /NO, TRY NEXT WORD
+PRS5,  ISZ     FOUND           /YES, B-SYM IS NEW A-SYM
+                               /SET CONTINUE FLAG
+       TAD     BPTR            /INDEX B-SYM
+       DCA     X2
+       TAD     APTR            /CLR STORAGE FOR NEW A-SYM
+       DCA     X1
+       DCA I   X1
+       DCA I   X1
+       DCA I   X1
+       TAD     APTR            /RESET A-SYM INDEX
+       DCA     X1
+       TAD     BLEN            /CTR FOR TRANSFER
+       CIA
+       DCA     ALEN
+       CDF 00
+       TAD I   X2              /MOVE B-SYM TO A-SYM
+       CDF 10
+       DCA I   X1
+       ISZ     ALEN
+       JMP     .-5
+       TAD     BLEN            /NEW LENGTH
+       DCA     ALEN
+       TAD     BVAL            /NEW VALUE
+       DCA     AVAL
+       TAD     BPTR            /NEW PTR
+       DCA     ASAV
+PRS6,  TAD     BPTR            /MOVE SPTR TO NEXT MST ENTRY
+       TAD     BLEN
+       TAD     K2
+       DCA     SPTR
+       JMP     PRS2            /CONTINUE SEARCH
+PRS7,  TAD     FOUND           /HAS ANOTHER SYMBOL BEEN FOUND?
+       SNA CLA
+       JMP     PRS8            /NO, EXIT
+       JMS I   OBSYM           /YES
+       ASAV
+       TAD     USE
+       TAD     K4000
+       DCA     USE             /SET HAS-BEEN-PRINTED BIT
+       ISZ     PFLG            /SET PASS FLAG
+       JMS I   CRLF            /POSITION PRINT
+       TAD     APTR            /INDEX SYMBOL
+       DCA     X1
+       TAD     M3              /SET CTR
+       DCA     ALEN
+       TAD I   X1              /PRINT SYMBOL
+       JMS I   CTYPE
+       ISZ     ALEN
+       JMP     .-3
+       JMS I   CTYPE           /PRINT 2 SPACES
+       TAD     AVAL            /PRINT VALUE
+       JMS I   OTYPE
+       TAD     USE             /MOVE TYPE BITS TO LOW AC
+       RTL                     /& DEF. BIT TO LINK
+       RTL
+       JMS I   STFTI           /TYPE FLAGS IF ANY
+       JMP     PRS1            /LOOK FOR ANOTHER SYMBOL TO PRINT
+
+PRS8,  JMS I   CRLF
+       JMS I   CRLF
+       JMP I   PRSYM
+
+
+STFTI, STFT
+ASAV=UMIC
+PFLG=TEM3
+PST,   STTP                    /TOP OF PERMANENT SYMBOL TABLE
+ALEN=S0
+APTR=AS0
+BPTR=SYMBOL
+BVAL=VAL
+BCODE=USE
+FOUND=TEM4
+SPTR=TEM5
+BLEN=LFS
+BCTR=OP
+AACTR=IB
+AVAL=AFS
+K3777, 3777
+LSTDEP,        LSTDEV
+
+
+\f*4200
+
+/
+/ROUTINE TO PUSH DOWN CUR.LINE FOR NEXT PAGE.
+/SAVES ENTIRE LIST OF VITAL INFO
+/(LFS, OP, IB,...,BANK, S0) IN TEMP.LOCS
+/(TLFS, TOP, TIB,..., TS0)
+/BOTH LISTS MUST BE KEPT IN SPECIFIED
+/ORDER.
+/IF THERE IS AN LFS ON LINE MUST MARK IT
+/NO-LONGER-DEFINED-ON-PAGE IN PST.
+/
+
+PUSHIN, 0
+       TAD     LFS     /IS THERE AN LFS
+       SNA CLA
+       JMP     PSHIN2  /NO
+       JMS I   OBSYM
+       LFS
+       JMS I   SPSTAB  /GET ITS POINTERS TO THE PAGE SYMBOL TABLE
+       NOP
+       TAD I   PSTCPR  /KILL THE DEFINED BIT
+       AND     K3777A
+       DCA I   PSTCPR  /SET PAGE SYMBOL TABLE CODE WORD OFF PAGE
+PSHIN2,        JMS     PUSHER
+               LFS-1
+               TLFS-1
+       JMP I   PUSHIN  /RETURN
+/
+/      ROUTINE TO POP UP A PUSHED DOWN INSTRUCTION
+/
+POPIN, 0
+       CLA
+       JMS     PUSHER
+               TLFS-1
+               LFS-1
+       JMP I   POPIN   /RETURN
+TLFS,  0       /KEEP THIS LIST ORDERED AS GIVEN
+TOP,   0
+TIB,   0
+TAFS,  0
+TUMIC, 0
+TNSGN, 0
+TEXP,  0
+TSKZ,  0
+TBANK, 0
+TS0,   0
+
+
+/
+/TRANSFER ANY LIST OF 10 (12 OCTAL) ITEMS
+/FROM ONE LIST TO ANOTHER
+/CALL SEQ.:    JMS     PUSHER
+/              ADDR-1 OF FROM-LIST
+/              ADDR-1 OF TO-LIST
+/              RET.
+/
+
+PUSHER,        0
+       TAD     M12A
+       DCA     TEM1            /CTR
+       TAD I   PUSHER
+       DCA     X1              /INDEX FROM LIST
+       ISZ     PUSHER
+       TAD I   PUSHER
+       DCA     X2              /INDEX TO LIST
+       TAD I   X1
+       DCA I   X2
+       ISZ     TEM1
+       JMP     .-3
+       ISZ     PUSHER
+       JMP I   PUSHER
+M12A,  -12
+K3777A,        3777
+/RETRN PSUEDO-OP
+/
+PRTN,  JMS I   GETSYM  /GET NEXT INPUT ITEM
+       SKP             /NOTHING
+       JMP     .+3     /SYMBOL
+       NOP             /CONSTANT
+       IERROR          /LITERAL
+       JMS I   SKIPL
+       JMS I   SREST   /PLACE SYMBOL ON EXTERNAL SYMBOL TABLE
+       DCA     PRTN0   /SAVE SYMBOL ID
+       JMS     PUSHIN  /PUSH LFS INFO IN CASE OF PAGE ASSEMBLY
+       TAD     K2      /SET AC TO 2
+       JMS I   PRTN1   /ARE THERE 2 LOCATIONS ON THIS PAGE
+       SKP CLA         /YES
+       JMS I   INI     /NO ... HAD TO ASSEMBLE PAGE ... INITIALIZE PT
+       JMS     POPIN   /POP LFS INFO FROM PAGE PUSH LIST
+       JMS I   ICPLFS  /PROCESS ANY LFS
+       TAD I   PTCPR   /PT CODE WORD WITH POSSIBLE LFS BIT
+       TAD     K30     /ADD SPECIAL RELOCATION BIT
+       DCA I   PTCPR   /PLACE PROPER CODE WORD ON PT
+       TAD     DOTRTN
+       DCA I   PTSPR   /PLACE JMS .RTN INSTRUCTION IN PT SYMBOL WORD
+       JMS I   PRTN3   /INCREMENT PT POINTERS
+       TAD     K130    /PROPER BIT PATTERN
+       DCA I   PTCPR   /TO PT CODE WORD
+       TAD     PRTN0   /PLACE EXTERNAL SYMBOL NUMBER ON PT
+       DCA I   PTSPR   /AS SYMBOL WORD
+       JMS I   PRTN3   /INCREMENT PT POINTERS
+       JMP I   POPEXP  /EXIT FOR NEXT LINE
+DOTRTN, JMS    RTN
+PRTN0, 0
+PRTN1, IFFSUB
+PRTN3, ASMIF1
+
+/
+/      @PAUSE@ PSEUDO OPERATION
+/
+PPAUSE,        JMS I   WLNIFI          /LIST IF PASS 2
+       CLA HLT         /WAIT FOR OPERATOR ACTION
+       RFC             /SELECT READER
+       JMS I   INITRP
+       JMS I   SKIPL
+PPAUS1,        CMA             /WE REACH THIS ONLY IF FORFLG. LE. 0(ALSO COME FROM *PEND*)
+       DCA     FORFLG  /SHUT OFF FORTR IN CASE GUY
+                       /HAS STARTED HIS TAPE IN
+                       /THE MIDDLE
+       JMP I   DCIL1   /RETURN FOR NEXT LINE
+
+WLNIFI,        WLNIF1
+
+
+/
+/OVERAL ASSEMBLY INITIALIZATION
+/
+INITA, 0
+       CDF 10
+       DCA I   FATALP
+       JMS I   CRLF
+       JMS I   CRLF
+       TAD     PEB
+       DCA I   PEPTRP
+       JMS     PUSHER  /INIT HICOM, PAGE, ESTSIZ, EQVBIT & APMSW ETC
+               K777-1
+               HICOM-1
+       JMS I   INITRP
+       TAD     PASS
+       SZA CLA
+       JMP I   INITA
+       DCA     SYMBOL          /PROTECT FROM RUSVL
+       JMS I   INITMP
+       DCA     CSUM
+       TAD     K10             /SET PUSH CTR=-2
+       JMS     PUSHER  /INIT OTP & STP
+               OTPR-1
+               OTP-1
+       JMS I   LEADI
+       JMP I   INITA
+OTPR,  CORE1-1         /KEEP STTR IMMEDIATELY AFTER OTPR
+STTR,  STTP
+/***** KEEP ITEMS SO INCLOSED IN GIVEN ORDER
+K777,  177
+       200
+       0
+       0
+       0
+       1
+       1
+       0
+       0
+       0
+/******************
+INITRP,        INITR
+FATALP,        FATAL
+PEPTRP,        PEPTR
+LEADI, LEADER
+PEB,   PEBSE
+INITMP,        INITMR
+\f*4400
+/
+/      ROUTINE TO SEARCH SYMBOL TABLE FOR SYMBOL IN S0-S3
+/      PLACES SYMBOL ON TABLE IF NOT THERE
+/      CALL IS
+/      JMS SRSYM
+/      NOT FOUND EXIT
+/      FOUND EXIT
+
+/RETURNS WITH SYMBOL CODE BITS IN "USE"
+/SYMBOL VALUE (0 IF NOT DEFINED)
+/IN "VAL"
+/& PTR TO SYM.TAB. ENTRY IN "SYMBOL"
+/THE LATTER ADDRESS IS REFERRED TO HERE IN
+/AS THE SYMBOL "ID"
+/SRSYM CALL RUSVL TO STORE USE & VAL
+/OF LAST REFERENCED SYMBOL IN MST
+/IN CASE THEY HAVE BEEN CHANGED
+/IN THE MEANWHILE.
+
+/
+SRSYM, 0
+       JMS     RUSVL
+       TAD     MST             /START AT SYM. TAB. BASE
+SRS1,  DCA     SYMBOL          /SET PTR. TO NEXT ENTRY
+       TAD     STT             /COMPARE PTR. WITH SYM. TAB. TOP
+       CIA
+       TAD     SYMBOL
+       SNA CLA                 /CONTINUE SEARCH
+       JMP     SRS2            /NAME NOT IN TABLE ENTER IT
+       CDF 00
+       TAD I   SYMBOL          /GET ENTRY CODE WORD
+       CDF 10
+       AND     K3              /EXTRACT SYMBOL LENGTH
+       DCA     TEM2
+       TAD     TEM2
+       CIA                     /NEGATE FOR COMPARE & CTR.
+       DCA     TEM1
+       TAD     TEM1            /COMPARE ENTRY & LOOK-UP SYMBOL LENGTHS
+       TAD     S0
+       SZA CLA                 /SAME LENGTH; COMPARE LETTERS
+       JMP     SRS5            /NOT SAME; GO TO NEXT ENTRY
+       TAD     AS0             /AUTO-INDEX LOOP-UP SYMBOL
+       DCA     X1
+       TAD     SYMBOL          /AUTO-INDEX TABLE ENTRY
+       DCA     X2
+SRS3,  CDF 00
+       TAD I   X2              /GET TABLE ENTRY CHAR. PAIR
+       CIA
+       CDF 10
+       TAD I   X1              /COMPARE LOOK-UP SYMBOL CHAR. PAIR
+       SZA CLA                 /SAME
+       JMP     SRS5            /NO MATCH
+       ISZ     TEM1            /CK SYM. LEN. CTR.
+       JMP     SRS3            /NOT DONE, TRY NEXT CHAR. PAIR
+SRS4,  JMS     SUSVL           /GET USE & VAL WORDS
+       JMP I   SRSYM
+
+SRS5,  TAD     SYMBOL          /PTR TO LAST ENTRY
+       TAD     K2              /+2 FOR USE & VAL WORDS
+       TAD     TEM2            /+ENTRY SYMBOL LENGTH
+       JMP     SRS1            /=PTR TO NEXT ENTRY
+/
+/CURRENT SYMBOL NOT ON TABLE ... PLACE IT THERE
+/
+
+SRS2,  TAD     OTP             /WILL NEW ENTRY FIT BELOW
+       CIA CLL                 /OCCURANCE TABLE?
+       TAD     SYMBOL
+       TAD     S0
+       SZL CLA                 /0 LINK=YES
+       SERROR          /NO, SYMBOL TABLE OVERFLOW
+       TAD     S0              /ENTRY CODE WORD = SYM. LEN.
+       TAD     K1000           /+REL BIT
+       CDF 00
+       DCA I   STT             /PUT CODE IN 1ST WORD OF NEW ENTRY
+       TAD     STT             /AUTO-INDEX ENTRY
+       DCA     X2
+       TAD     AS0             /AUTO-INDEX SYMBOL TO BE STORED
+       DCA     X1
+       TAD     S0              /SET SYM. LEN. CTR.
+       CIA
+       DCA     TEM1
+ERS1,  CDF 10
+       TAD I   X1              /MOVE SYMBOL CHAR. PAIR TO TABLE
+       CDF 00
+       DCA I   X2
+       ISZ     TEM1            /CK. CTR.
+       JMP     ERS1            /NOT DONE
+       DCA I   X2              /CLR VALUE WORD
+       TAD     STT             /SAVE PTR TO NEW ENTRY
+       DCA     SYMBOL
+       TAD     X2              /RESET PTR. TO SYM. TAB. TOP
+       IAC
+       DCA     STT
+       CDF 10
+       JMP     SRS4
+
+/
+/OBTAIN GIVEN SYMBOL'S VITAL INFO FROM MST
+/CALL SEQ:     JMS     OBNSYM
+/              ADDRESS OF SYMBOL ID
+/              RET.
+/OBNSYM LEAVES SYMBOL ID IN "SYMBOL",
+/      SYMBOL CODE WORD IN USE,
+/      SYMBOL VALUE IN VAL.
+/OBNSYM CALLS RUSVL BEFORE ACTION
+/FOR SAME REASON AS SRSYM DOES.
+/
+OBNSYM, 0
+       JMS     RUSVL
+       TAD I   OBNSYM  /ADDRESS OF SYMBOL
+       DCA     TEM1
+       TAD I   TEM1    /ACTUAL SYMBOL
+       DCA     SYMBOL
+       ISZ     OBNSYM  /INDEX FOR EXIT
+       JMS     SUSVL   /SET UP USE AND VALUE WORDS
+       JMP I   OBNSYM  /RETURN WHEN FOUND
+/
+/      ROUTINE TO SET UP USE AND VALUE WORDS
+/
+SUSVL, 0
+       CDF 00          /OFF TO BANK 1
+       TAD I   SYMBOL  /MST USE WORD FROM BANK 1
+       DCA     USE     /TO BANK 0 USE LOCATION
+       TAD     USE
+       AND     K3
+       IAC
+       TAD     SYMBOL
+       DCA     VALPTR
+       TAD I   VALPTR  /MST VALUE WORD FROM BANK 1
+       DCA     VAL     /TO BANK 0 VALUE LOCATION
+       CDF 10          /RESTORE DATA FIELD
+       JMP I   SUSVL   /RETURN
+
+RUSVL, 0
+       CDF 00
+       TAD     USE
+       DCA I   SYMBOL
+       TAD     VAL
+       DCA I   VALPTR
+       CDF 10
+       JMP I   RUSVL
+
+VALPTR,        0       /PTR TO CURRENT VAL WORD IN MST
+/
+/READ A CHARACTER
+/      IGNORES LF, FF, RO, LEADER
+/      ALSO CHECKS CHAR AS TO TYPE
+/CALLING SEQ:  JMS RCH
+/      RETURN IF CHAR IS A DIGIT
+/      RETURN IF CHAR IS ALPHABETIC
+/      RETURN FOR ALL OTHER (PUNCT,ETC)
+/LEAVES        AC==0
+/      CHR=ASCII VALUE OF INPUT CHARACTER
+/CALLS SRT
+
+RCH,   0
+       JMS I GETCHR    /GET 1 CHAR
+       SNA
+       JMP     RCH3            /0=END OF LINE
+       TAD M260
+       SPA
+       JMP RCH3                /TAKE PUNCT.EXIT (200-257)
+       TAD M12
+       SPA
+       JMP RCH4                /TAKE DIGIT EXIT (260-271)
+       TAD M7
+       SPA
+       JMP RCH3                /TAKE PUNCT, EXIT (272-300)
+       TAD M37A
+
+       SMA
+
+RCH3,  ISZ RCH         /PUNCT, EXIT (337-376)
+       ISZ RCH         /ALPHA EXIT (301-336)
+
+RCH4,  CLA             /DIGIT EXIT
+       JMP I RCH
+M260,  -260
+M12,   -12
+M37A,  -36
+
+
+/FORCE BUFFER FILL ON FIRST READ
+
+INITR, 0
+       TAD     MBE
+       DCA     X3
+       JMP I   INITR
+
+MBE=LINAX              /=LAST WORD OF DATA BUFFER
+\f*4600
+
+/SUBR TO READ 1 LINE INTO LINE BUFFER
+
+RLN,   0
+       DCA     LFLG            /CLR NON-NULL LINE FLAG
+       TAD     SCOLON          /IF LAST LINE ENDED WITH ;
+       SZA                     /NO NEED TO READ ANOTHER
+       JMP     RLN4
+       TAD     LINAX           /INIT STORAGE AUTO-INDEX
+       DCA     X2
+RLN2,  JMS     FETCH           /GET A CHARACTER
+       JMS I   TEST            /IS IT A CR,TAB,SP,FF,LF?
+               SL7-1           /IF SO GO TO RLN15,3,3,2,2
+               BL6-SL7
+       ISZ     LFLG            /OTHERWISE A NON-NULL LINE
+RLN3,  JMS I   STOREP          /OTHERWISE PUT IT IN THE BUFFER
+       TAD     X2              /IS BUFFER FULL?
+       TAD     LINEND
+       SZA CLA
+       JMP     RLN2            /NO
+       CMA
+       TAD     X2
+       DCA     X2              /IF SO MOVE BACK PTR
+       JMP     RLN2
+RLN15, DCA     CHR             /TERMINATE LINE WITH 0
+       JMS I   STOREP
+       DCA     AFLG
+       DCA     EFLG
+       DCA     VFLG
+       DCA     CODE
+       TAD     LINAX           /INIT LINE INDEX
+RLN4,  DCA     X0
+       DCA     SCOLON          /CLR
+       JMP I   RLN
+
+
+STOREP,        STORE
+LINEND,        -LINBUF-107
+
+/SUBROUTINE TO READ 1 CHARACTER VIA INPUT DEVICE
+/IGNORES 200'S & 377'S
+
+FETCH, 0
+       JMS     R
+       AND K177
+       TAD     K200            /FORCE FULL 8BIT ASCII
+       DCA CHR
+       TAD CHR
+       TAD     M200
+       SZA 
+       TAD M177
+       SNA CLA
+       JMP FETCH+1
+       JMP I FETCH
+M177,  -177
+
+/SUBR TO GET NEXT CHAR FROM HSR BUFFER
+/REFILL BUFFER WHEN X3 REACHES END OF BUFFER
+
+R,     0
+       CDF 00
+       TAD     X3
+       TAD     BUFEND  /CK FOR END OF BUFFER
+       SNA CLA
+       JMP     RG              /REFILL
+R1,    TAD I   X3              /GET NEXT CHAR
+       CDF 10
+       JMP I   R
+RG,    TAD     BUF             /INDEX THE BUFFER
+       DCA     X3
+RG1,   JMS I   INDEV
+       DCA I   X3
+       TAD     X3              /CK FOR FULL
+       TAD     BUFEND
+       SZA CLA
+       JMP     RG1             /NOT FULL
+RG3,   TAD     BUF             /RESET PTR
+       DCA     X3
+       JMP     R1
+
+INDEV, HSR
+BUF,   DATA-1
+
+BUFEND,        1-LINBUF
+
+/GET 1 CHAR FROM LINE BUFFER
+
+L65,   0
+       CDF 00
+       TAD I   X0
+       CDF 10
+       DCA     CHR
+       TAD     CHR
+       JMP I   L65
+
+/
+/      ROUTINE TO PUNCH LEADER TRAILER CODE
+/
+LEADER,        0
+       TAD     K7600
+       DCA     TEM1
+       TAD     K200
+       JMS I   PUNCH
+       ISZ     TEM1
+       JMP     .-3
+       JMP I   LEADER
+
+/
+/      ROUTINE TO TYPE RETURN-LINE FEED
+/
+       0215
+       0212
+L73,   0
+       CLA
+       TAD     L73-2
+       JMS I   TYPE
+       TAD     L73-1
+       JMS I   TYPE
+       JMP I   L73
+
+
+/DECIM & OCTAL PSUEDO-OPS
+
+PDEC,  JMS I   SKIPL
+       IAC             /SET ARITHMETIC CONVERSION TO DECIMAL
+       SKP
+POCT,  JMS I   SKIPL
+       DCA     DSW     /SET ARITHMETIC CONVERSION TO OCTAL
+       JMP I   NULLP   /GO GET NEXT INPUT LINE
+
+
+
+/
+/ROUTINE TO STOP NEXT LINE FROM BEING LISTED
+/THO IT IS ALREADY IN THE BUFR.
+/E.G., STOP LISTING OF PUSHED DOWN LINE
+/WHILE ASSEMBLING LIT. POOL
+/
+SAVLIN,        0
+       CDF 00
+       TAD I   LINEB2          /SAVE 1ST CHAR OF LINE
+       SNA                     /IF ANY
+       JMP     .+3             /THERE ISNT ANY
+
+       DCA     SAVEIT
+       DCA I   LINEB2          /CLR  TO PREVENT TYPEOUT
+       CDF 10
+       JMP I   SAVLIN
+
+
+/
+/REENABLE LISTING OF LINE WHICH SAVLIN
+/PREVENTED
+/
+
+RELINE,        0
+       CDF 00
+       TAD     SAVEIT          /RESTORE 1ST CHAR OF LINE
+       DCA I   LINEB2
+       CDF 10
+       JMP I   RELINE
+
+SAVEIT,        0
+LINEB2,        LINBUF
+
+
+/ROUTINE TO LIST NULL, COMMENT OR PSUEDO-OP LINE
+
+NULL,  DCA     VALUE           /IF ANY GIVEN
+       TAD     VALUE           /SET TYPEOUT FLAG IF NON-0
+       DCA     VFLG
+       JMS I   WLIF            /LIST IF PASS 2
+       JMP I   DCIL1           /GO BACK TO RDL1 FOR NEXT LINE
+WLIF,  WLNIF1
+
+/
+/      TYPE ROUTINE
+/
+L64,   0
+       TLS             /SELECT IT
+       TSF             /WAIT FOR TTY
+       JMP     .-1
+       CLA             /EXIT WITH CLEAR AC
+       JMP I   L64
+\f*5000
+/
+/      ROUTINE TO SET THE CORRECT COUNTERS FOR THE CURRENT
+/      OP CODE AND ADDRESS FIELD SYMBOL
+/
+/THIS IS A MAJOR ROUTINE.  IT IS CALLED ONCE
+/FOR EVERY NORMAL (MRI,OPR,IOT) INSTR.  COLLECTED.
+/IT IS ALSO CALLED DURING PAGE
+/RECOUNTING, ONCE FOR EVERY ITEM ON THE 
+/PAGE TABLE.
+/CALLING SEQ:  AC=0,JMS,RET WITH AC=0
+/FUNCTION: DETERMINE THE TYPE OF LINE BEING
+/READ AND SET THE VARIOUS PAGE COUNTERS
+/AND FLAGS ACCORDINGLY.
+/A FLOW CHART OF TYPES & FLAG SETTINGS IS GIVEN BELOW.
+/CONSIDERABLE OVERLAPPING IS USED TO ACHIEVE
+/THE MIN. CORE USAGE. THIS IS SOMETIMES AT THE 
+/EXPENSE OF LOGICAL CLARITY.
+/ALL POSSIBLE CONDITIONS EXIT VIA SETC00
+/SETC00:(1) IF LAST INSTR. WAS A SKIP & LAST BANK
+/      IS NOT= CUR.BANK, BANK=-1.
+/      (2) IF CUR. INSTR. IS A SKIP, PGEESC=4
+/      OTHERWISE PGEESC=2.
+/      (3) LASTSKIP CONDITION= CUR. SKIP CONDITION
+/      (4) LAST BANK= CUR. BANK
+/
+/FLOW OF INSTR. TYPES
+/SETCT:        IF (PARAMETER OR MICRO-INSTR.) SETC00
+/      IF (LITERAL AFS) SETC02
+/      IF(CONSTANT AFS) SETC01
+/      CALL OBNSYM(AFS)
+/      IF (INSTR. IS INDIRECT) SETC07
+/      IF (AFS IS IN COMMON) SETCO4
+/      IF (ABSOLUTE AFS) SETC05
+/      CALL SPSTB (AFS)                /SEARCH PST FOR AFS
+/      CALL SETSUB
+/      IF (AFS NOT BEFORE ON PST) SETC06
+/      IF (AFS WAS IN PST BUT NOT DEF. ON PAGE)SETC12
+/      IF (OP CODE=JMS) BANK=1
+/      GO TO SETC00                    /ON PAGE MR1
+/SETC01:IF (CONST.AFS ON PG.0)J2
+/      IF (INSTR. IS INDIRECT) ERROR
+/      CALL SLTAB(CONST. AFS)          /PUT CONST. IN LIT.TAB.
+/J1:   IF (BANK NOT=1) SETC13
+/      GO TO SETC00
+/      J2* IF( INSTR.INDIR.) J1        /PG.0 INDIRECT
+/      GO TO SETC00                    /PG.0 DIRECT
+/SETC04:IF(BANK NOT 0) CALL INCOBA     /INC OBACTR
+/      CALL NUMSGN
+/      S0=RESULT+COMMON ADDR.
+/SETC02:CALL SLTAB(S0)                 /LIT.OR. COMMN. ADDR. TO LIT. TAB.
+/      GO TO SETC00
+/      IF (AFS NOT PREV. ON PST) SETC11
+/      IF (AFS WAS ON PST BUT NOT DEF. ON PAGE) SETC11
+/      GO TO J3
+/SETC10:CALL NUMSGN
+/      IF (ABS.AFS ON PAGE 0) J3
+/SETC11:AC=1                           /FORCE BANK=1
+/SETC09:AC=AC+1                                /FORCE BANK=0
+/SETC08:AC=AC-2                                /FORCE BANK=-1
+/      CALL INCOBA                     /INC OBACTR
+/      AC=BANK                         /(BANK OFFSET BY -1)
+/      GO TO SETC13                    /(TAKEN CARE OF AT SETC13)
+/SETC12:IF (NEW PST CODE BITS 10-11=OLD SAME (IN TEM 3)) J3
+/SETC06:INC OPSCTR                     /OFF PAGE SYMBOL
+/J3:   IF (BANK=1) SETC00
+/      INC AC
+/      CALL INCOBA
+/J4:   IF (THERE HAS NOT BEEN A PST SEARCH) SETC00
+/      ADD CHANGE IN OBACTR (OBACTR-OLDOBA) TO PST CODE BITS 3-9
+/      GO TO SETC00
+/
+/NOTE: CONDITION AT J4 IS TESTED BY SETSUB HEADER
+/WORD (OBFLG).  THIS IS ALWAYS CLEARED
+/WHEN SETCT STARTS AND WILL NOT CHANGE
+/UNLESS THERE IS A CALL TO SPSTB BECAUSE
+/A CALL TO SETSUB ALWAYS FOLLOWS CALL TO
+/SPSTB IN SETCT.
+
+
+/
+\fSETCT,        0
+       JMS I   ICPLFS  /CHECK FOR AND PROCESS ANY LFS
+       DCA     OBFLG           /CLR
+/NEXT 2 LINES MOVED TO
+/SETCAL (AS OF V15) TO MAKE ROOM FOR FOLLOWING INSTR. & PTR
+/      TAD     EXP     /IS IT PAR OR A MICRO INST?
+/      TAD     UMIC
+       JMS I   SETCAP
+       SZA CLA
+       JMP I   SET00I  /YES
+       CLA CLL CMA RAL
+       TAD     AFS
+       SNA             /IS AFS A CONSTANT
+       JMP     SETC01  /YES
+       IAC
+       SNA CLA         /IS AFS A LITERAL
+       JMP I   SET02I  /YES
+       JMS I   OBSYM   /NO ... GET POINTERS TO AFS
+       AFS
+       TAD     IB      /INDIRECT BIT
+       SZA CLA         /IS IT SET
+       JMP     SETC07  /YES
+       JMS     USETST  /TEST FOR OFF BANK OR ABSOLUTE
+       SETC04          /OFF BANK
+       SETC05          /ABSOLUTE
+       JMS I   SPSTAB  /IS AFS ON PST
+       CMA             /NOT FOUND
+       JMS     SETSUB
+       JMP I   SET06I  /NO ... MUST BE OFF PAGE
+       TAD I   PSTCPR  /YES ... PST CODE WORD
+       SMA CLA         /IS AFS ON PAGE
+       JMP I   SET12I  /NO
+       JMP I   SET00I
+/
+/      INDIRECT MEMORY REFERANCE INSTRUCTION
+
+SETC07, TAD    USE     /AFS MST USE WORD
+       AND     K20     /IS AFS DUMMY
+       SZA CLA
+       JMP I   SET08I  /YES
+       JMS     USETST  /TEST OFF BANK OR ABSOLUTE
+       SETC09          /OFF BANK
+       SETC10          /ABSOLUTE
+       JMS I   SPSTAB  /IS AFS ON PST
+       CMA             /NOT FOUND
+       JMS     SETSUB
+       JMP I   SET11I  /NO
+       TAD I   PSTCPR  /YES ... PST CODE WORD
+       SMA CLA         /IS AFS ON PAGE
+       JMP I   SET11I  /NO
+       JMP I   SET6P1  /YES
+/
+/      CONSTANT FOR AN ADDRESS FIELD SYMBOL
+/
+SETC01, TAD    S0      /ACTUAL BINARY CONSTANT
+       AND     K7600   /IS CONSTANT ON PAGE ZERO
+       SNA CLA
+       JMP     SET01A  /YES
+       TAD     IB      /NO ... IS IT INDIRECT
+       SZA CLA
+       IERROR          /YES ... ERROR
+       JMS I   SLITAB  /IS CONSTANT ON LITERAL TABLE
+                       /IF NOT SUBROUTINE PUTS IT THERE
+       TAD     OP
+       SPA CLA         /IF OPCODE IS JMS OR JMP THEN BANK IS IRRELEVANT
+       JMP I   SET00I
+SET01B,        CLA CMA
+       TAD     BANK    /BANK SETTING
+       SNA CLA         /IS IT SET TO THE CURRENT BANK
+       JMP I   SET00I  /YES ... NO PROBLEMS
+       JMP I   SET00J  /EXIT TO; COMMON AREA
+/
+SET01A, TAD    IB      /IS INDIRECT BIT SET
+       SZA CLA
+       JMP     SET01B  /YES
+       JMP I   SET00I  /NO
+SET00I, SETC00
+SET02I, SETC02
+SET00J,        SETC13
+SET00B,        JMP I   SETCT   /OFF PAGE RETURN
+SET06I, SETC06
+SET08I,        SETC08
+SET11I, SETC11
+SET12I, SETC12
+SET6P1,        SETC6A
+SETCAP,        SETCAL
+
+
+/ROUTINE TO TEST MST USE WORD TO DETERMINE WHETHER A SYMBOL IS
+/OFF-BANK OR ABSOLUTE
+
+USETST,        0
+       TAD     USE
+       AND     K40
+       SZA CLA         /IS IT OFF BANK?
+       JMP     USESUC  /YES- RETURN INDIRECT THROUGH FIRST ARG
+       TAD     USE
+       AND     K3000
+       ISZ     USETST
+       SNA CLA         /IS IT ABSOLUTE?
+       JMP     USESUC  /YES- RETURN INDIRECT THROUGH SECOND ARG
+       ISZ     USETST
+       JMP I   USETST  /NEITHER - RETURN TO CALL+3
+USESUC,        TAD I   USETST
+       DCA     USETST
+       JMP I   USETST  /TAKE PROPER BRANCH
+
+/
+/SETSUB IS A UTILITY USED BY SETCT ONLY.
+/USED ONLY IMMEDIATELY AFTER A PST SEARCH.
+/CALLING SEQUENCE:     JMS     SPSTB
+/              CMA             /SPSTB MAY SKIP
+/              JMS     SETSUB
+/              RETURN IF SPSTB SKIPPED OVER CMA
+/              RETURN IF SPSTB DID NOT SKIP
+/HAS SEVERAL FUNCTIONS:
+/(1) SAVE COPY OF OLD VALUE OF OBACTR BEFORE
+/CHANGING STARTS- SO IT MAY BE USED AT SETC13.
+/(2) IF INSTR IS INDIRECT, THAT'S IT- EXIT
+/(3) OTHERWISE SAVE OLD VALUE OF PST CODE BITS 10-11
+/FOR LATER USE AT SETC12.  WARNING: THIS
+/IS SAVED IN TEM3, SO TEM3 IS NOT
+/TEMPORARY FOR A FEW MINUTES.
+/(4) SET PST CODE BIT 10 IF THIS IS A #REF,
+/OR BIT 11 IF IT IS A NORMAL REF.
+/ALGORITHM IS A.OR.B=(.NOT.A.AND.B)+A
+/
+
+SETSUB,        0
+       DCA     TEM1    /0=FOUND, -1=NOT
+       TAD     OBACTR          /SAVE FOR SETC11,12,6,13
+       DCA I   OLDOBP
+       TAD     IB              /OMIT CHANGING PST BITS IF INDIRECT
+       SZA CLA
+       JMP     SETSX
+       TAD I   PSTCPR  /SAVE OLD CODE
+       AND     K3
+       DCA     TEM3
+       TAD     NSGN
+       SZA CLA
+       IAC             /#
+       IAC
+       DCA     TEM2
+       TAD     TEM2    /OR INTO CODE
+       CMA
+       AND I   PSTCPR
+       TAD     TEM2
+       DCA I   PSTCPR
+SETSX, ISZ     TEM1    /FOUND?
+       ISZ     SETSUB  /YES
+       JMP I   SETSUB
+
+OLDOBP,        OLDOBA
+OBFLG=SETSUB
+
+
+
+/SUBR TO STORE CHARACTER IN LINE BUFFER
+/ASSUMES X1 SET
+/CHAR MAY BE IN AC OR IN CHR
+
+STORE, 0
+       SNA
+       TAD     CHR
+       CDF 00
+       DCA I   X2
+       CDF 10
+       JMP I   STORE
+
+
+/
+/ROUTINE TO CHECK NSGN FOR SETCT
+/USED ONLY BY SETCT ROUTINE.
+/CALLING SEQUENCE:     AC=0
+/              JMS     NUMSGN
+/              RETURN WITH AC=0 IF
+/              NSGN=0,AC=1 IF NSGN
+/              NOT=0.
+/NOTE:NSGN MAY BE NON-0 AND NOT=1.  THIS
+/IS THE REASON FOR NUMSGN.
+/
+
+NUMSGN,        0
+       TAD     NSGN
+       SZA CLA
+       IAC
+       JMP I   NUMSGN
+\f*5200
+/
+/      AFS ABSOLUTE
+/
+SETC05,        JMS I   NUMSGP
+       TAD     VAL     /ABSOLUTE SYMBOL VALUE
+       AND     K7600   /MASK OUT PAGE BITS
+       SNA CLA         /IS ABSOLUTE SYMBOL ON PAGE ZERO
+       JMP     SETC00  /YES ... EXIT
+       JMS I   NUMSGP
+       TAD     VAL     /NO ... ABSOLUTE SYMBOL VALUE
+       DCA     S0      /TO LITERAL TABLE SEARCH LOCATION
+       JMS I   SLITAB  /SEARCH LITERAL TABLE FOR VALUE
+                       /IF NOT THERE ROUTINE PLACES IT THERE
+       JMP     SETC06+1        /EXIT
+/
+/      INDIRECT ABSOLUTE
+/
+SETC10,        JMS I   NUMSGP
+       TAD     VAL             /ACTUAL AFS VALUE
+       AND     K7600
+       SNA CLA         /IS ADDRESS FIELD SYMBOL ON PAGE ZERO
+       JMP     SETC6A          /YES
+/
+/      INDIRECT DUMMY ADDRESS FIELD SYMBOL
+/
+SETC08,        TAD     M2              /SET BANK UNKNOWN
+/
+/      OFF PAGE INDIRECT
+/
+SETC11,        IAC                     /SET BANK TO CURRENT
+/
+/      OFF BANK INDIRECT - SET BANK TO 0
+/
+SETC09,
+       JMS     INCOBA          /SET BANK & INCR. OBACTR
+       TAD     BANK
+       JMP     SETC13+1        /EXIT TO COMMON AREA
+/
+
+
+/      ADDRESS FIELD SYMBOL NOT ON PAGE SYMBOL TABLE.
+/
+SETC12,        TAD I   PSTCPR          /HAS NEW TYPE REF BEEN ADDED?
+       AND     K3
+       CIA
+       TAD     TEM3
+       SZA CLA         /YES
+SETC06,        ISZ     OPSCTR          /INCREMENT OFF PAGE SYMBOL COUNTER
+       TAD     OP
+       SPA CLA         /DON'T WORRY ABOUT BANK FOR JMS'S AND JMP'S
+       JMP     SETC00  /WHICH ARE NOT EXPLICITLY INDIRECT
+SETC6A,        TAD     BANK
+       SMA SZA CLA
+       JMP     SETC00  /YES ... EXIT TO COMMON AREA
+SETC13,         IAC
+       JMS     INCOBA          /SET BANK TO CUR. & INC OBACTR
+       TAD I   OBFLGP          /WAS THERE A PST SEARCH?
+       SNA CLA
+       JMP     SETC00          /NO
+       TAD     OLDOBA          /YES GET CHANGE IN OBACTR
+       CIA
+       TAD     OBACTR
+       CLL RTL                 /IN BITS 1-9
+       TAD I   PSTCPR          /ADD TO PST CODE
+       DCA I   PSTCPR
+/
+/      COMMON AREA
+/
+SETC00,        JMS     CMNSET  /SET BANK=1 AFTER JMS
+       JMS I   SETCMN  /UPDATE BANK AND LSTSKP
+       SZA CLA         /IS CURRENT INSTRUCTION A SKIP?
+       TAD     K2      /YES ... PAGE ESCAPE = 4
+       TAD     K2      /NO ... PAGE ESCAPE = 2
+       DCA     PGEESC
+       JMP I   .+1     /RETURN
+       SET00B
+SETCMN,        ASMCMN
+
+/ROUTINE TO SET BANK TO CURRENT AFTER A JMS
+CMNSET,        0
+       TAD     OP
+       TAD     K4000
+       SZA CLA         /WAS OP A JMS?
+       JMP I   CMNSET  /NO
+       IAC
+       DCA     BANK
+       JMP I   CMNSET
+
+OLDOBA,        0
+OBFLGP,        OBFLG
+/
+/      DIRECT OFF BANK REFERANCE
+/
+SETC04, TAD    BANK    /BANK INDICATOR
+       SZA CLA         /IS BANK SET TO OFF
+       JMS     INCOBA          /NO, SET BANK TO COMMN & INC OBACTR
+       JMS I   NUMSGP
+       TAD     VAL     /YES ... ACTUAL BANK 0 ADDRESS
+       DCA     S0      /TO CONSTANT - LITERAL LOCATION
+/
+/      LITERAL FOR AN AFS
+/
+SETC02, JMS I  SLITAB  /PLACE LITERAL ON LITERAL TABLE
+       JMP I   SET1AP
+/
+/      COLLECTION ROUTINE TO CHECK FOR AND PROCESS AN LFS
+/
+/CALLING SEQUENCE:     AC=0
+/              JMS     CPLFS
+/              RETURN WITH AC=0
+/FUNCTION:     USED DURING COLLECTION PHASE
+/      EXCEPT WHEN RECOUNTING A PAGE.
+/      IF TAG OCCURS ON CURRENT LINE, CPLFS
+/      LOCATES (OR ENTERS) IT IN PAGE SYM.TAB.
+/      AND SETS THE DEFINED-ON-PAGE BIT IN
+/      THE PST CODE WORD.
+/      ALSO SETS BANK CONDITION TO UNKNOWN
+/      SINCE USER CODE CAN JUMP TO TAG
+/      FROM ANYWHERE.  ALSO SAVE
+/      TAG IN LLFS & RESET LINE COUNT
+/      IN CASE WE GET A MULT.DEF. ERROR
+/      IN PASS1 WE MUST ALSO DO THE
+/      FOLLOWING IF THE SYMBOL IS ALREADY
+/      IN THE PST WHEN WE GO LOOK FOR
+/      IT: (1) REDUCE THE OFF-PAGE SYM.
+/      CTR.  BECAUSE OFF-PAGE POINTER (FOR
+/      EITHER NORMAL OR # REFERENCES) ARE
+/      NO LONGER NEEDED.  (2) REDUCE
+/      OBACTR BY THE NO. OF EXTRA WORDS
+/      OF CODE DUE TO THIS SYMBOL.
+/SUBRS. CALLED: OBNSYM(LFS),SPSTB,PSTDEF
+/
+CPLFS, 0
+       TAD I   RECTI   /ARE WE RECOUNTING?
+       SZA CLA
+       JMP I   CPLFS   /YES ... RETURN
+       TAD     LFS
+       SNA
+       JMP I   CPLFS           /NONE THERE
+       CDF 00
+       DCA I   LFSPTR  /PLACE ON LFS TABLE
+       ISZ     LFSPTR  /INCREMENT LFS TABLE POINTER
+       CDF 10
+       ISZ I   PTCPR   /SET LFS BIT ON PAGE TABLE
+       JMS I   OBSYM
+       LFS
+       JMS I   SPSTAB  /IS IT ON THE PAGE SYMBOL TABLE
+       JMP     CPLFS3  /NO ... SKIP DECREMENTING
+       DCA     TEM1    /CLR
+       TAD     PASS            /SKIP DECREMENTING IF PASS 2
+       SNA CLA
+       TAD I   PSTCPR  /CK USE
+       AND     K3
+       CLL RAR
+       SZL
+       ISZ     TEM1    /NORMAL
+       SZA CLA
+       ISZ     TEM1    /#
+       TAD     TEM1    /SUBTRACT
+       CIA
+       TAD     OPSCTR
+       DCA     OPSCTR
+       TAD I   PSTCPR          /EXTRACT SHARE OF OBACTR DUE
+       AND     C3774           /TO THIS SYMBOL
+       CLL RTR                 /MOVE TO LOW ORDER
+       CIA                     /SUB. FROM OBACTR
+       TAD     OBACTR
+       DCA     OBACTR
+CPLFS3,        JMS I   PSTDEP
+       CLA CMA CLL     /SET BANK UNKNOWN (THE CLL IS USED ELSEWHERE)
+       DCA     BANK
+       TAD     LFS             /SAVE IN CASE OF ERROR
+       DCA     LLFS
+       DCA     LINE    /ZERO LINE COUNT FROM LAST LFS
+       JMP I   CPLFS
+C3774, 3774
+NUMSGP,        NUMSGN
+PSTDEP,        PSTDEF
+LLFS,  0
+
+
+/
+/UTILITY FOR SETC04,SETC08,SETC13
+/NOT USED ELSEWHERE
+/CALLING SEQUENCE:     DESIRED BANK SETTING IN AC
+/              JMS     INCOBA
+/              RETURN WITH AC=0
+/FUNCTION:(1) SET BANK AS SPECIFIED
+/      (2) INCREMENT OFF-BANK ADDITION CTR
+/      BY 1 OR 2: 2 IF PREVIOUS INSTR.
+/      WAS A SKIP-TYPE, 1 OTHERWISE.
+/
+INCOBA,        0
+       DCA     BANK
+       TAD     LSTSKP  /LAST INSTRUCTION SKIP INDICATOR
+       SZA CLA         /WAS LAST INSTRUCTION A SKIP INSTRUCTION
+       ISZ     OBACTR  /+ OLD VALUE OF OFF BANK ADDITION COUNTER
+       ISZ     OBACTR  /FOR NEW VALUE OF OFF BANK ADDITION COUNTER
+       JMP I   INCOBA
+SET1AP,        SET01A
+\f*5400
+/
+/      ROUTINE TO ASSEMBLE THE PAGE HELD IN THE CURRENT SET OF TABLES
+
+/THIS IS THE MAIN PASS1 ASSEMBLY ROUTINE
+/(NOT USED BY PASS2)
+/ASMBL GOES THRU ENTIRE PAGE TABLE
+/FLOW: (1) CALL A1 TO INIT. PAGE ASSEMBLY
+/      (2) GET ITEM OFF P.T.
+/      (3) CALL ASM02 TO ASSEMBLE ITEM
+/      (4) LOOP BACK TO (2) TIL DONE WITH PAGE
+/      (5) CALL A2 TO ASM. LITERALS
+/ASMBL IS CALLED TWICE BY L55 FOR
+/EACH PAGE OF CODE.
+/
+ASMBL, 0
+       JMS     A1
+       JMS I   ILC4PT                  /OUTPUT PAGE ORIGIN
+       JMS I   INIS            /DO INITS.
+       TAD     PTSZE   /PLACE - SIZE OF PAGE TABLE
+       CIA
+       DCA     INDX1   /IN AN INDEX LOCATION
+       TAD     LFSBSE  /SET UP LFS TABLE POINTER
+       DCA     LFSPTR
+       CLA CMA
+       DCA     PHASE   /SET PHASE SWITCH TO ASSEMBLY
+       JMS I   ASM02I  /SKIP INCREMENTING POINTERS THE FIRST TIME
+       JMS I   ISSI    /INCREMENT PAGE TABLE POINTERS
+       ISZ     INDX1   /OVER YET
+       JMP     .-3
+       JMS     A2
+       JMP I   ASMBL
+ISSI,  ISZPT
+
+
+/
+/ASSEMBLY ROUTINE TO FINISH OFF A PAGE
+/(1) PUTS OUT PAGE ESCAPE
+/(2) LITERAL POOL (BY CALLING OAPLT)
+/(3) GET READY FOR NEXT PAGE
+/
+A2,    0
+       JMS I   SAVLNP          /STOP NEXT LINE LISTING
+       TAD     APMSW   /ARE WE IN AUTOMATIC PAGING MODE
+       SZA CLA
+       JMP     A2NONA  /NO ... DONT SEND PAGE ESCAPE
+       TAD     PGEESC  /SIZE OF PAGE ESCAPE REQUIRED
+       RTR             /2 BIT TO LINK
+       SZL CLA
+       JMP     ASM01A  /2 INSTRUCTION PAGE ESCAPE
+                       /4 INSTRUCTION PAGE ESCAPE
+       JMS I   WRITEP
+       JMS I   OUTBIN  /JMP NEXT TO LAST LOC ON THIS PAGE
+       K5376
+       0
+       ISZ     ILC             /FOR BENEFIT OF "WRITE"
+       CLA CMA
+       JMS     A2SUBR  /OUTPUT JMP AND LITERAL TABLE
+       JMS I   OUTSKP  /OUTPUT 2 SKIP INSTRUCTIONS
+       JMS I   OUTSKP
+       JMP     ASM01B  /RETURN
+/
+ASM01A,        JMS     A2SUBR  /OUTPUT JMP AND LITERAL TABLE
+       JMS I   WRITEP
+       JMS I   OUTBIN  /PLACE A NOP IN THE LAST LOCATION
+       K7000
+       0
+ASM01B,        JMS I   RELNP           /RESTORE NEXT LINE FOR LISTING
+       TAD     ACTR            /REMAINS 1 DURING PASS 2
+       SZA CLA
+       JMP I   A2      /EXIT IF LISTING OR 2ND ASSEMBLY
+       TAD     PUPGE           /SAVE  ESCAPE ON PUSH DOWN LIST
+       CDF 00
+       DCA I   PEPTR
+       CDF 10
+       ISZ     PEPTR           /MOVE STACK PTR
+       JMP I   A2      /RETURN
+
+A2NONA,        JMS I   OUAPLT
+       DCA     PUPGE           /CLR
+       JMP     ASM01B
+
+/SUBROUTINE TO ELIMINATE SOME COMMON CODE
+/
+A2SUBR,        0
+       TAD     K177
+       TAD     PAG
+       DCA     A2TEMP  /SET ILC IN CASE NO LITERALS
+       JMS I   WRITEP
+       JMS I   OUTBIN
+       K5377
+       0
+       JMS I   OUAPLT  /OUTPUT LITERAL TABLE
+       TAD     A2TEMP
+       DCA     ILC     /SET ILC TO 176 OR 177 IN PAGE
+       JMS I   ILC4PT
+       JMP I   A2SUBR  /RETURN
+A2TEMP,        0
+
+
+ILC4PT,        ILC4
+ASM02I, ASM02
+INDX1, 0
+INIS,  INISUB
+OUAPLT,        OAPLT
+SAVLNP,        SAVLIN
+RELNP, RELINE
+PEPTR, PEBSE
+REDUCE,        0
+CDFSKP,        JMS     CDFSK
+
+
+/
+/INITIALIZE A PAGE ASSEMBLY
+/
+A1,    0
+       TAD     PAG     /MOVE PAGE TO ILC
+       DCA     ILC
+       DCA     LITSIZ  /ZERO LITERAL TABLE SIZE
+       TAD     PASS
+       SNA CLA
+       JMP I   A1              /EXIT IF PASS 1
+       CDF 00
+       TAD I   PEPTR           /GET NEXT PAGE ESC FROM STACK
+       CDF 10
+       ISZ     PEPTR           /MOVE PTR
+       DCA     REDUCE
+       JMP I   A1
+/
+/      DUMMY PSEUDO OP
+/
+PDUMMY,        JMS I   GETSYM  /GET NEXT INPUT ITEM
+       SKP             /NOTHING THERE
+       JMP     .+3     /SYMTOL
+       NOP             /CONSTANT
+       IERROR          /LITERAL
+       JMS I   SKIPL
+       TAD     USE     /MST USE WORD
+       AND     K3403   /SAVE SYMBOL LENGTH, TYPE BITS, AND DEF BIT
+       TAD     K20     /ADD CORRECT MST BIT FOR DUMMY
+       DCA     USE     /FOR CORRECT CODE WORD
+       JMP I   NULLP   /EXIT TO GET NEXT LINE
+K3403, 3403
+
+
+/
+/COMPUTE CURRENT PAGE SIZE
+/ENTER WITH AC=0
+/EXIT WITH PAGE SIZE IN AC
+/
+CPGES, 0
+       TAD     APMSW           /OMIT PGEESC IF NON-AUTO PAGING
+       SNA CLA
+       TAD     PGEESC  /+SIZE OF ESCAPE REQUIRED
+       TAD     PTSZE   /SIZE OF PAGE TABLE
+       TAD     LTSZE   /+SIZE OF LITERAL TABLE
+       TAD     OPSCTR  /+OFF PAGE SYMBOL COUNTER
+       TAD     OBACTR  /+OFF BANK ADDITION COUNTER
+       DCA     PSTDEF  /STORE IN TEM.
+       TAD     PSTDEF  /GET IT BACK
+       TAD     PAG     /AND CHECK FOR 7600 PAGE OVERFLOW
+       AND     K7600
+       TAD     K200
+       SNA     CLA
+       SERROR          /OVERFLOW-ERROR S
+       TAD     PSTDEF  /O.K. GET PAGE SIZE, WHICH
+       JMP I   CPGES   /IS DESIRED RESULT
+
+
+/ROUTINE TO SET DEFINED BIT ON PST
+/USED BY CPLFS & ANUMCK
+
+PSTDEF,        0
+       TAD I   PSTCPR  /PROTECT CODES
+       SMA
+       TAD     K4000   /SET DEFINED BIT ON PST
+       DCA I   PSTCPR
+       JMP I   PSTDEF
+\f*5600
+/
+/      CONSTANT FOR AN ADDRESS FIELD SYMBOL
+/
+ASM05, TAD I   PTSPR   /ACTUAL BINARY CONSTANT
+       AND     K7600   /IS IT ON PAGE ZERO
+       SZA CLA
+       JMP I   ASM5CI  /NO
+       TAD I   PTSPR   /ADD IN PAGE ZERO ADDRESS
+       DCA     TEMP6       
+       TAD I   PTCPR   /YES ... IS IT INDIRECT
+       AND     K400
+       SNA CLA
+       JMP     ASM00   /EXIT TO COMMON AREA
+       TAD     TEMP6
+       JMP I   ASM5AI
+ASM5AI, ASM12E
+ASM5CI, ASM05C
+/
+/      OFF BANK DIRECT (COMMON DIRECT)
+/
+ASM08, JMS I   NSCHKP
+       TAD     VAL     /ACTUAL ADDRESS IN BANK ZERO
+       DCA     S1      /TO 2 WORD LITERAL TABLE SEARCH LOCATION
+       CLA IAC
+       DCA     S0      /ABSOLUTE SEARCH
+       JMS I   SERALP  /GET A PAGE ADDRESS
+       TAD     K400    /ADD INDIRECT BIT
+       DCA     TEMP6
+       TAD     BANK            /BANK INDICATOR
+       SNA CLA                 /IS IT SET
+       JMP     ASM00
+       DCA I   ASMX5I
+       TAD     KCDF1A
+       DCA I   ASMX4I
+       TAD     CDZSKI
+       DCA I   ASMX6I
+       DCA     TEM7
+       JMP I   ASME7I
+ASMX5I,        ASMX5
+ASMX4I,        ASMX4
+KCDF1A,        KCDF10
+ASMX6I,        ASMX6
+ASME7I,        ASME7
+CDZSKI,        CDZSKP
+SERALP,        SRALT
+NSCHKP,        NSCHK
+
+/
+/ASM02 IS THE HEART OF ASSEMBLY
+/IT IS CALLED ONCE FOR EACH ITEM ON
+/THE PAGE TABLE.
+/IT CONSISTS OF MANY PARTS, ONE FOR
+/EACH BASIC TYPE OF INSTR. TO BE
+/ASSEMBLED PLUS VARIOUS COMMON EXITS
+/
+ASM02, 0
+       DCA     LFS     /ZERO LFS INDICATOR
+       TAD     PASS
+       SZA CLA
+       JMS I   GETBAP          /RESTORE BANK & LSTSKP IF PASS2
+       JMS I   LFSCHK          /PROCESS LFS IF ANY
+       JMS I   ANCHK           /PROCESS BSS 0 IF ANY
+KCDF00,        CDF 00
+       TAD I   PTOPR
+KCDF10,        CDF 10
+       DCA     OP
+       TAD I   PTCPR
+       AND     K40     /IS IT A SKIP INSTRUCTION
+       DCA     CURSKP  /YES ... SET SKIP INDICATOR
+       TAD I   PTCPR
+       AND     K10     /IS IT A PSEUDO OP (PAR)
+       SZA CLA
+       JMP I   ASM03I  /YES ... EXIT
+       TAD I   PTCPR
+       AND     K4      /IS IT A MEMORY REFERANCE INSTRUCTION
+       SZA CLA
+       JMP     ASME1   /NO
+       TAD I   PTCPR   /PT CODE WORD
+       AND     K20     /IS AFS A CONSTANT
+       SZA CLA
+       JMP     ASM05   /YES
+       TAD I   PTCPR   /PT CODE WORD
+       AND     K2      /IS AFS A LITERAL
+       SZA CLA
+       JMP I   ASM06I  /YES
+       TAD I   PTSPR   /AFS ID WORD FOR SYMBOL TABLE
+       DCA     AFS     /TO DIRECTLY ADDRESSABLE LOCATION
+       JMS I   OBSYM   /GET ITS POINTERS TO MST
+       AFS
+       TAD I   PTCPR   /PT CODE WORD
+       AND     K400    /IS OP INDIRECT
+       SZA CLA
+       JMP I   ASM2AI  /YES
+       JMS I   UZTST   /TEST FOR OFF BANK OR ABSOLUTE
+       ASM08           /OFF BANK
+       ASM09           /ABSOLUTE
+       JMP I   ASM07I  /NO
+ASM2AI, ASM02A
+ASM03I, PPAR1
+ASM06I, ASM06
+ASM07I, ASM07
+ANCHK, ANUMCK
+UZTST, USETST
+/
+/      END OF LINE NECESSITIES
+/
+ASM00, TAD     TEMP6
+ASME1, TAD     OP
+ASME2, DCA     TEM1
+       JMS I   WRITEP
+       JMS I   OUTBIN
+       TEM1
+ASME1X,        0
+ASM01, JMS I   CMNASM  /SET BANK=1 AFTER A JMS
+       JMS     ASMCMN  /SET BANK AND LSTSKP
+       DCA     SKPSAV  /SAVE CURSKP IN SKPSAV
+       TAD     BANK            /SAVE FOR PROTECTION DURING LISTING
+       DCA     BNKSAV
+       ISZ     ILC     /INCREMENT ILC
+ASM02R,        JMP I   ASM02   /USED AS OFF-PAGE RETURN
+       SERROR          /ILC OVERFLOWED 7777 - PROGRAM TOO BIG
+CMNASM,        CMNSET
+GETBAP,        GETBAS
+BNKSAV,        0
+SKPSAV,        0
+OPISUB,        JMS     OPIS
+OBISUB,        JMS     OBIS
+
+/SUBROUTINE TO UPDATE BANK,LSTSKP,LSTBNK
+/
+ASMCMN,        0
+       TAD     LSTSKP  /IS LAST INSTRUCTION A SKIP INSTRUCTION
+       SNA CLA
+       JMP     .+10    /NO
+       TAD     LSTBNK  /YES ... LAST BANK
+       CIA
+       TAD     BANK    /+CURRENT BANK
+       SNA CLA         /ARE THEY THE SAME
+       JMP     .+3     /YES
+       CLA CMA         /NO ... SET BANK UNKNOWN
+       DCA     BANK    
+       TAD     CURSKP  /PLACE CUR SKIP INDICATOR
+       DCA     LSTSKP  /AS LAST SKIP INDICATOR
+       TAD     BANK    /PLACE CURRENT BANK
+       DCA     LSTBNK  /IN LAST BANK INDICATOR
+       TAD     LSTSKP
+       JMP I   ASMCMN
+\f*6000
+/
+/
+/      INDIRECT DUMMY ARGUMENT
+/
+       DUMSUB
+ASM10, TAD I .-1
+       DCA     TEMP6
+       CLA CMA         /SET BANK UNKNOWN
+       JMP     ASME3   /EXIT FOR SKIP CHECK
+/
+/      OFF BANK INDIRECT (INDIRECT COMMON)
+/
+       OBISUB
+ASM11, TAD I .-1
+       DCA TEMP6
+/
+
+TEMP6=EXP
+ASME3, DCA     BANK            /SET C(AC) IN BANK
+       TAD     LSTSKP          /WAS LAST A SKIP?
+       SNA CLA
+       JMP     ASME4           /NO
+//FOLLOWING 6 LINES HAVE BEEN
+//MOVED TO 6600 TO MAKE ROOM FOR V03
+       JMP I   .+1
+       ASMEXT
+//     JMS I   OUTSKP          /YES, OUTPUT SKP
+//     TAD     ILC             /GET PG.LOC.PTR.
+//     TAD     K4              /+4
+//     AND     K177
+//     TAD     K5200A          /OUTPUT JMP .+4
+//     DCA     TEM1
+REEASM,        JMS I   WRITEP
+       JMS I   OUTBIN
+       TEM1
+       0
+       ISZ     ILC             /INCREMENT PG.LOC.PTR.
+ASME4, JMS I   WRITEP
+       JMS I   OUTBIN          /OUTPUT JMS TO
+       TEMP6           /OBISUB,OPISUB, OR DUMSUB
+       0
+       ISZ     ILC
+       JMS I   ASM10B          /PPAR3S
+       ISZ     ILC
+       TAD     OP
+       TAD     K407
+       JMP I   ASME2P
+ASME2P,        ASME2
+ASM02A, TAD    USE     /AFS MST USE WORD
+       AND     K20     /IS AFS A DUMMY ARGUMENT
+       SZA CLA
+       JMP     ASM10   /YES
+       JMS I   UZETST  /TEST FOR OFF-BANK OR ABSOLUTE
+       ASM11           /OFF-BANK
+       ASM12           /ABSOLUTE
+       JMP I   ASM13I  /NO
+ASM10B, PPAR3S
+ASM13I, ASM13
+K407,  0407
+ASME5A,        TAD     OP
+       SPA CLA         /BANK NEED NOT BE CURRENT FOR A JMP OR JMS
+       JMP     ASME6+2 /WHICH IS NOT EXPLICITLY INDIRECT
+ASME5, TAD     BANK
+       SMA SZA CLA
+       JMP     ASME6+2
+ASME7, TAD     LSTSKP
+       SZA CLA
+       JMP     .+7
+       JMS I   WRITEP
+       JMS I   OUTBIN
+ASMX4, KCDF00
+ASMX5, 5
+       ISZ     ILC
+       JMP     ASME6
+       JMS I   WRITEP
+       JMS I   OUTBIN
+ASMX6, CDFSKP
+       0
+       ISZ     ILC
+       JMS I   OUTSKP
+ASME6, TAD     TEM7
+       DCA     BANK
+       TAD     K5
+       DCA     ASMX5
+       TAD     KCDFA
+       DCA     ASMX4
+       TAD     CDFSKI
+       DCA     ASMX6
+       IAC
+       DCA     TEM7
+       JMP I   .+1
+       ASM00
+CDFSKI,        CDFSKP
+ASME1I,        ASME1
+KCDFA, KCDF00
+UZETST,        USETST
+
+/
+/      SYMBOL TABLE TYPEOUT FLAG TYPEOUT ROUTINE
+
+/CALL SEQ.:    TAD     USE             /GET TYPE BITS
+/              RTL
+/              RTL
+/              JMS     STFT
+/              RETURN
+/USED ONLY BY PRSYM
+/
+STFT,  0
+       AND     K3      /MASK OUT TYPE BITS
+       SNA
+       JMP     STFT3           /ABSOLUTE SYM.
+       TAD     M3              /CK FOR NEW OPDEF
+       SNA
+       JMP     STFT2           /YES
+       IAC
+       SNA
+       JMP     STFT5           /EXTERNAL
+       SZL CLA
+       JMP     STFT1           /DEFINED
+       TAD     K2516           /"UN"
+       JMS I   CTYPE
+       TAD     K0406           /"DF"
+STFT0, JMS I   CTYPE   /TYPE FLAG
+STFT1, CLA             /WE MUST HAVE A CLEAR AC
+       JMP I   STFT    /RETURN
+K2560, 2560
+K1720, 1720
+
+STFT2, TAD     K1720           /TYPE "OP"
+       JMP     STFT0
+STFT3, TAD     USE
+       AND     K40
+       SZA CLA
+       JMP     STFT4           /COMMON
+       TAD     K0102           /"AB"
+       JMS I   CTYPE
+       TAD     K2300           /"S "
+       JMP     STFT0
+STFT4, TAD     K0317           /"CO"
+       JMS I   CTYPE
+       TAD     K1500           /"M "
+       JMP     STFT0
+
+K0102, 102
+K0317, 317
+K2300, 2300
+K1500, 1500
+K2516, 2516
+K0406, 406
+K0530, 530
+K2400=SLITAB
+
+STFT5, TAD     K0530           /"EX"
+       JMS I   CTYPE
+       TAD     K2400
+       JMP     STFT0
+\f*6200
+/
+/      LOCAL DIRECT REFERANCE
+/
+ASM07, JMS I   SPSTAB  /IS AFS ON PST
+       JMP     ASM07A  /NO ... ROUTINE PLACES IT THERE
+       TAD I   PSTCPR  /PST CODE WORD
+       SMA CLA         /IS SYMBOL ON PAGE
+       JMP     ASM07A  /NO
+       JMS     NSCHK
+       TAD     VAL     /AFS MST VALUE
+       AND     K177    /SAVE PAGE ADDRESS
+       TAD     K200    /ADD PAGE BIT
+       JMP I   AS00I4  /
+ASM07A, TAD I  PTSPR   /ACTUAL SYMBOL
+       DCA     S1      /TO 2 WORD LITERAL TABLE SEARCH LOCATION
+       JMS     NSCHK
+       CLL RTL
+       TAD     K2      /RELOCATABLE SEARCH
+       JMP     ASM05C+3
+ASM09B,        JMS     NSCHK
+       TAD     VAL             /DIRECT NON-PAGE 0 ABSOLUTE
+       SKP
+/
+/
+/      NON PAGE ZERO CONSTANT ADDRESS
+/
+ASM05C,        TAD I   PTSPR   /ACTUAL BINARY CONSTANT
+       DCA     S1      /TO 2 WORD LITERAL TABLE SEARCH LOCATION
+       CLA IAC
+       DCA     S0      /ABSOLUTE SEARCH
+       JMS I   SERALT  /GET A PAGE ADDRESS
+       TAD     K400    /ADD INDIRECT BIT
+       DCA     TEMP6
+       JMP I   .+1
+       ASME5A          /EXIT FOR SKIP CHECK IF OP IS NOT JMP OR JMS
+/
+/      DIRECT ABSOLUTE OR EXTERNAL
+/
+ASM09, JMS     NSCHK
+       TAD     VAL     /ABSOLUTE SYMBOL VALUE
+       AND     K7600   /IS SYMBOL ON PAGE ZERO
+       SZA CLA
+       JMP     ASM09B  /NO
+       JMS     NSCHK
+       TAD     VAL     /ADD IN PAGE ZERO ADDRESS
+       JMP I   AS00I4  /
+AS00II,        ASME5
+/
+/      LITERAL FOR AN ADDRESS FIELD SYMBOL
+/
+ASM06, TAD I   PTSPR   /ACTUAL LITERAL
+       DCA     S1      /TO 2 WORD LITERAL TABLE SEARCH LOCATION
+       CLA IAC
+       DCA     S0      /ABSOLUTE SEARCH
+       JMS I   SERALT  /GET A PAGE ADDRESS
+       JMP I   AS00I4  /EXIT FOR SKIP CHECK
+AS00I4, ASM05+5
+OUTSK, 0
+       JMS I   WRITEP
+       JMS I   OUTBIN
+       K7410
+       0
+       ISZ ILC
+       JMP I   OUTSK
+SERALT,        SRALT
+/
+/      INDIRECT ABSOLUTE
+/
+ASM12, TAD     VAL     /AFS MST USE WORD
+       AND     K7600   /IS IT ON PAGE ZERO
+       SZA CLA
+       JMP     ASM12F  /NO
+/
+/      INDIRECT PAGE ZERO ABSOLUTE SYMBOL
+/
+       JMS     NSCHK
+        TAD    VAL     /SAVE PAGE ZERO ADDRESS
+ASM12E,        TAD     K400    /ADD INDIRECT BIT
+       DCA     TEMP6
+       JMP I   AS00II     
+/
+/      INDIRECT NON PAGE ZERO ABSOLUTE SYMBOL
+/
+       OPISUB
+ASM12F, TAD I  .-1        
+       DCA     TEMP6
+       TAD     BANK
+       JMP I   AS00I3  /EXIT FOR SKIP CHECK
+AS00I3, ASME3
+K5377, 5377
+/
+/      LOCAL INDIRECT REFERANCE
+/
+ASM13, JMS I   SPSTAB  /IS AFS ON PST
+       JMP     ASM14   /NO ... MUST BE OFF PAGE
+       TAD I   PSTCPR  /YES ... PST CODE WORD
+       SMA CLA         /IS AFS ON PAGE
+       JMP     ASM14   /NO
+       JMS     NSCHK
+        TAD    VAL     /AFS VALUE FROM MST
+       AND     K177    /SAVE PAGE DISPLACEMENT
+       TAD     K600    /ADD PAGE AND INDIRECT BIT
+       DCA     TEMP6   /SAVE
+       JMP I   AS00II  /GO OUTPUT INSTRUCTION
+/
+/      OFF PAGE INDIRECT
+/
+       OPISUB
+ASM14, TAD I   .-1        
+       DCA     TEMP6
+       CLA IAC         /SET BANK TO CURRENT
+       JMP I   AS00I3  /EXIT FOR SKIP CHECK
+NSCHK, 0
+       TAD I   PTCPR
+       AND     K2000
+       SZA CLA
+       IAC                     /ITS A #
+       JMP I   NSCHK
+
+
+/"IF" - CONDITIONAL ASSEMBLY PSUEDO-OP
+
+PIF,   JMS I   GETSYM
+       JMP     PIFERR          /NOTHING THERE
+       JMP     .+3             /SYM
+       NOP                     /CON
+       JMP     PIFERR          /LIT
+       TAD     CHR             /CK FOR COMMA
+       TAD     M254
+       SZA CLA
+       IERROR                  /NOT A COMMA
+       ISZ     X0              /PREVENT FLAGGING COMMA
+       JMS I   GETSYM          /YES, SET CTR TO SKIP N LINES
+       NOP
+       SKP     
+       SKP                     /I WANT A NUMBER
+PIFERR,        IERROR  
+       TAD     USE             /IS SYMBOL DEFINED?
+       AND     K400
+       SZA CLA
+       DCA     S0              /YES, CONTINUE NORMAL ASSMBLY
+       JMS I   SKIPL
+       TAD     S0              /GET THE NUM.
+       CIA
+       DCA     IFCTR
+       JMP I   NULLP
+
+IFCTR, 0
+
+ILC4,  0
+       JMS I   OUTBIN
+       ILC
+       4
+       JMP I   ILC4
+
+
+/LAP & EAP PSUEDO-OPS
+
+*6372  /MUST BE AT 6372 OR AT PAGE BOUND. +172 FOR K5376 TO WORK AS  SKIP
+PLAP,  JMS I   SKIPL
+       IAC                     /LEAVE AUTO-PAGING MODE
+K5376, 5376    /THIS REPLACES A SKIP.*******DO NOT MOVE********
+PEAP,  JMS I   SKIPL
+       DCA     APMSW           /ENTER AUTO-PAGING MODE
+       JMP I   NULLP
+
+\f      *6400
+LISTON,        1411
+       2324
+       1116
+       0700
+       1716
+       0000
+HISP,  1011
+       0710
+       0023
+       2005
+       0504
+       0020
+       2516
+       0310
+       7700
+RDER,  0022
+       0501
+       0405
+       2277
+       0000
+       /       PART OF MAIN PROGRAM
+       /       RECOUNT ROUTINE
+       /FOLLOWING CODE CLEANS UP PST CODES BEFORE RECOUNTING
+CLNPST,        CIA
+       DCA IOINIT              /SET COUNTER
+       TAD PSTBSE
+       IAC
+       DCA PSTCPR              /CODE POINTER
+       TAD I PSTCPR            /LOOP
+       AND K4003K              /KILL OBAC DUE TO THIS SYM.
+       DCA I PSTCPR
+       ISZ PSTCPR              /MOVE PTR
+       ISZ PSTCPR
+       ISZ IOINIT
+       JMP .-6                 /NOT DONE
+       JMP I   .+1
+       RECRET
+       K4003K, 4003
+/
+/
+/COMMON EXIT FOR DATA-GENERATING PSUEDO-OPS
+/
+POPEX, DCA     BSSSW
+       TAD     LFS             /CK FOR TAG
+       SNA CLA
+       JMP I   DCIL1           /NO TAG
+       CMA                     /DECREMENT PTSZE
+       TAD     PTSZE
+       DCA     PTSZE
+       JMS I   RECTI           /YES RECOUNT THE PAGE
+       ISZ     PTSZE           /RESTORE PTSZE
+       JMS I   ISZPTX          /RESTORE PT PTRS
+       JMP I   DCIL1           /RETURN FOR NEXT LINE
+ISZPTX,        ISZPT
+
+
+
+/ROUTINE T0 INITIALIZE I/O DEVICES
+
+C2=JMS I CTYPE
+
+IOINIT, 0
+       CDF 10
+       TAD     JL64
+       DCA     TYPE
+VN,    JMP I   VERSI
+IOI,   JMS I   CRLF
+       TAD     JHISP
+       DCA     X1
+       TAD     M5
+       JMS     QUERY
+       JMP     RGO
+       TAD     JRDER
+       DCA     X1
+       TAD     M5
+       JMS     QUERY
+       JMP     RGO
+RGO,    JMS     KSR
+        TAD     JHSR
+        TAD     JASR
+        DCA I   INDEVP
+        JMS I   CRLF
+       TAD     JHISP
+       DCA     X1
+       TAD     M11
+       JMS     QUERY
+       NOP
+       JMS     KSR
+        JMP     .+4
+        TAD     TYPE
+        DCA     PUNCH
+        JMP   IOX
+        TAD     JL63
+        DCA     PUNCH
+        JMS I   CRLF
+       TAD     JLIST
+       DCA     X1
+       TAD     M17
+       JMS     QUERY
+       NOP
+       JMS     KSR
+       IAC                     /1 = PUNCH, 0 = TYPE
+IOX,        DCA     LSTDEV
+        JMP I   IOINIT
+
+
+
+QUERY, 0
+       DCA     JCOUNT
+       TAD I   X1
+       C2
+       KSF
+       SKP
+       JMP I   QUERY
+       ISZ     JCOUNT
+       JMP     .-6
+       ISZ     QUERY
+       JMP I   QUERY
+KSR,    0
+        KSF
+        JMP     .-1
+        KRB
+       DCA     TEM1
+       TAD     TEM1
+       JMS I   TYPE
+       TAD     TEM1
+       TAD     M331
+       SZA CLA                 /0="YES"
+       ISZ     KSR             /NOT "YES"
+        JMP I   KSR
+LSTDEV=QUERY
+M331,   -331
+JHSR,   HSR-ASR
+JASR,   ASR
+INDEVP, INDEV
+JL63,   L63
+JL64,  L64
+JCOUNT=TEM3
+JHISP, HISP-1
+JLIST, LISTON-1
+JRDER, RDER-1
+VERSI, VERNUM
+M5,    -5
+M11,   -11
+M17,   -17
+
+\f*6600
+//
+//PART OF MAIN PROGRAM MOVED FOR V03
+//
+/ROUTINE TO RESTORE BANK AND LSTSKP FOR PASS2
+/WILL NOT FIT INTO ASM02 WHERE IT BELONGS
+
+GETBAS,        0
+       TAD I   BNKSAP
+       DCA     BANK
+       TAD I   SKPSAP
+       DCA     LSTSKP
+       JMP I   GETBAS
+
+BNKSAP,        BNKSAV
+SKPSAP,        SKPSAV
+
+/INPUT ROUTINES
+
+HSR,    0
+        DCA     TEM10           /CLR TIMER
+        RFC
+HSR1,   RSF
+        JMP     HSR2
+       RRB
+        JMP I   HSR
+HSR2,  DCA     ASR             /WASTE SOME TIME
+       ISZ     TEM10           /CK TIMER
+        JMP     HSR1            /KEEP TRYING
+REXIT,  TAD     X3              /CK FOR EMPTY BUFFER
+        TAD     BUFBEG
+        SZA CLA
+        JMP    .+4            /NO, WE HAVE A PARTIAL BUFFER
+        CDF 10
+        JMP I   .+1             /YES TAPE HAS ENDED WITH NO END STATMT
+        ERRE
+       DCA I   X3              /FILL END OF BUFFER WITH 0'S
+       TAD     X3
+       TAD     BUFEN
+       SZA CLA
+       JMP     .-4
+       JMP I   RG3P            /NOW RET. FOR PROCESSING
+
+ASR,    0
+        TAD     M50
+        DCA     TEM11
+        DCA     TEM10
+ASR1,   KSF
+        JMP     ASR2
+        KRB
+        JMP I   ASR
+ASR2,   ISZ     TEM10
+        JMP     ASR1
+        ISZ     TEM11
+        JMP     ASR1-1
+        JMP     REXIT
+
+
+M50,    -50
+TEM10,  0
+TEM11,  0
+BUFBEG, 1-DATA
+RG3P,   RG3
+BUFEN, 1-LINBUF
+/
+/      ENTRY PSEUDO OPERATION
+/
+PENTRY, JMS I  GETSYM  /GET NEXT INPUT ITEM
+       SKP             /NOTHING THERE
+       JMP     .+3     /SYMBOL
+       NOP             /CONSTANT
+       IERROR          /LITERAL
+       JMS I   SKIPL
+       JMS I   SREST   /PLACE SYMBOL ON EXTERNAL SYMBOL TABLE
+       CLA
+       TAD     USE     /AFS MST USE WORD
+       AND     K403    /SAVE SYMBOL LENGTH (& DEF. BIT FOR PASS 2)
+       TAD     K2220   /ADD IN PROPER BITS
+       DCA     USE     /FOR NEW MST USE WORD
+       JMP I   NULLP   /EXIT FOR NEXT LINE
+K2220, 2220
+K403,  403
+/
+/
+/
+/INCREMENT PAGE TABLE POINTERS
+/
+ISZPT, 0
+       ISZ     PTCPR   /INCREMENT PAGE TABLE CODE POINTER BY 2
+       ISZ     PTCPR
+       ISZ     PTSPR   /INCREMENT PAGE TABLE SYMBOL POINTER BY 2
+       ISZ     PTSPR
+       ISZ     PTOPR   /INCREMENT PT OP CODE POINTER
+       JMP I   ISZPT
+/
+/CK CONSTANT FOR BLOCK PSEUDO-OP
+/
+PBSS4, TAD     APMSW           /AUTOMATIC PAGING?
+       SNA CLA
+       TAD     K2              /YES, 176 IS MAXIMUM
+       TAD     M200            /NO, 200 IS MAX
+       TAD     S0              /CHECK CONSTANT
+       SMA SZA CLA
+       IERROR                  /TOO BIG
+       TAD     S0              /IS CONSTANT 0?
+       SNA
+       JMP I   PBSS2J          /YES, EQUIVALENCE TAG
+       JMP I   PBSS5I          /NO, CREATE BLOCK OF THIS SIZE
+PBSS2J,        PBSS2
+PBSS5I,        PBSS5
+
+/
+/PATCH TO DELETE DEFINED BIT IN PST FOR A TAG
+/EQUIVALENCED TO A LINE THAT OVERFLOWED THE PAGE
+/
+EQVFIX,        TAD     EQVBIT          /WAS THERE SUCH A TAG?
+       SNA CLA
+       JMP I   L55CP           /NO
+       TAD I   EQVBIT          /YES, GET PST CODE FOR THIS TAG
+       TAD     K4000           /CANCEL DEFINED BIT
+       DCA I   EQVBIT
+       TAD     K200            /SET EQUIVALENCE BIT FOR NEXT LINE
+       DCA     EQVBIT          /WHEN NEXT PAGE GETS GOING
+       JMP I   L55CP           /RETURN TO ASSEMBLE THE PAGE WE HAVE
+L55CP, L55C
+
+
+/
+/CK FOR TYPE OF SYMBOL
+/CALL SEQ:     JMS WHATYP
+/              RET. IF USER SYMBOL
+/              RET. IF OP SYMBOL
+/
+WHATYP,        0
+       TAD     USE
+       AND     K3000
+       TAD     M3000
+       SNA CLA
+       ISZ     WHATYP
+       JMP I   WHATYP
+
+
+/
+/EXECUTE ISZ GTSYM (MOVE RETURN POINTER) ONLY IF IFCTR .GE. 0
+/OTHERWISE MOVE LINE PTR TO NEXT SLASH, SEMI-COLON OR CAR.RET.
+/& ISZ IFCTR & TREAT AS A NULL LINE.
+/
+CKIF,  0
+       TAD I   IFCT            /IS CONDITIONAL NON-ASM IN EFFECT?
+       SPA CLA
+       JMP     .+3             /YES: DO NOT ASMBL LINE
+       ISZ I   GETSYM          /NO, MOVE RETRN PTR & CONT. AS USUAL
+       JMP I   CKIF
+       ISZ I   IFCT            /COUNT IGNORED LINE
+       NOP
+       TAD     CHR             /MOVE LINE PTR TO END OF LINE
+CKIF2, SNA
+       JMP     CKIF3           /FOUND A CR
+       TAD     M257
+       SNA
+       JMP     CKIF3           /SLASH
+       TAD     M14
+       SNA CLA
+       JMP     CKIF3           /SEMI-COLON
+       JMS I   GETCHR          /TRY NEXT
+       JMP     CKIF2
+CKIF3, JMP I   .+1
+               ITM15
+M257,  -257
+M14,   -14
+IFCT,  IFCTR
+\f*6776
+
+/PAGE SYMBOL TABLE (200 WORDS)
+/DOUBLE WORD ENTRIES
+/REBUILT FOR EACH CORE PAGE OF CODE
+/EVERY SYMBOL DEFINED OR REFERENCED ON
+/GIVEN PAGE IS ENTERED
+/TYPICAL ENTRY*:       WD1=SYMBOL ID
+/                      WD2=CODE BITS
+/SYMBOL ID=ADDRESS OF SYMBOL ENTRY IN MAIN SYM. TAB
+/CODE: BIT0=1 IF SYM. DEF. ON CUR. PAGE
+/      BIT11=1 IF SYM REFERENCED NORMALLY BY A MR1 ON THE PG.
+/      BIT10=1 IF SYM. REF'D. WITH A #
+/      BITS 1-9 USED FOR COUNTING AMOUNT OF OBACTR
+/      WHICH IS DUE TO THIS SYMBOL
+/SYMBOLS ARE ENTERED ON PST IN ORDER OF APPEARENCE
+/IN SOURCE
+/NO MORE THAN 64 (DEC) SYMBOLS MAY BE REF'D.
+/ON ANY PAGE.
+/NOTE: THE SIZE OF THIS TABLE SHOULD NOT BE
+/INCREASED UNLESS LFS TABLE IS ALSO INCREASED.
+
+
+*7176
+
+/PAGE TABLE (402 WORDS)
+/DOUBLE WORD ENTRIES
+/ONE ENTRY FOR EACH INSTRUCTION TO BE ASSEMBLED
+/ROOM FOR 1 EXTRA ENTRY TO COVER PAGE OVERFLOW
+/A NEW TABLE FOR EACH PAGE OF CODE
+/TYPICAL ENTRY:        WD1=CODE BITS
+/              WD2=SYMBOL WORD
+/CODE: BIT1=1 IF # REF
+/      BIT2=1 IF CDF TO CUR BANK
+/      BIT3=1 IF INDIRECT
+/      BIT4=1 IF BLOCK 0 (FOR EQUIVALENCED TAGS)
+/      BIT5=1 IF SPECIAL CALL CONST
+/      BIT6=1 IF SKIP INST.
+/      BIT7=1 IF AFS IS CONST
+/      BIT8=1 IF PARAMETER
+/      BIT9=1 IF OPR OR IOT INST.
+/      BIT10=1 IF AFS IS LITERAL
+/      BIT11=1 IF LFS OCCURS
+/      BIT0 UNUSED
+/THE SYMBOL WORD=0 IF CODE BIT9=1
+/      =THE ACTUAL CONST OR LITERAL IF BITS2,5,7 OR 10=1
+/      =THE SYMBOL ID (MST ENTRY ADDR.) FOR AN ADDR. PARAMETER
+/      OR FOR THE AFS OF AN MRI
+
+
+/
+/TYPE VERSION NUMBER
+/(THIS IS ONCE ONLY CODE)
+/(OVERWRITTEN BY P.S.T.)
+/
+*7000
+/
+VERNUM,        JMS I   CRLF
+       TAD     JVERS
+       DCA     X1
+       TAD     M26
+       JMS I   MTYPE
+       NOP
+       TAD     K7000X
+       DCA I   VNOP
+       JMP I   .+1
+       IOI
+JVERS, VERSN-1
+MTYPE, QUERY
+M26,   -15
+VNOP,  VN
+K7000X,        NOP
+VERSN, 2004                    /PDP-8 SABR DEC-08-A2C2-V#
+       2055
+       7040
+       2301
+       0222
+       4004
+       0503
+       5560
+       7055
+       0162
+       0462
+       5561            /- VERSION # (1ST DIGIT)
+       7001            /2ND DIGIT AND PATCH LEVEL
+
+
+\f
+/SABR BANK 1 SECTION
+
+/TABLES
+
+FIELD 0
+
+
+
+*0
+EQUTB, 0               /EQUIVALENCE TABLE
+                       /100 WORDS
+                       /TABLE IS REINITIALIZED BEFORE EACH PAGE BEGINS
+                       /COLLECTION, IF NO EQUIV. IS LEFT FROM PREVIOUS PAGE
+                       /MULTIPLE WORD ENTRIES
+                       /ONE ENTRY IS MADE FOR
+                       /EACH LOC. TAG WHICH HAS
+                       /EQUIVALENTS
+                       /1ST WORD OF EACH ENTRY
+                       /CONTAINS NO. OF OTHER WORDS
+                       /IN THE ENTRY
+                       /OTHER WORDS ARE SYMBOL ID'S
+                       /(MST ADDRESSES) OF SYMBOLS
+                       /EQUIVALENT TO THE PARTICULAR
+                       /LOCATION TAG
+
+
+*100
+
+/BSEEST, 0             /EXTERNAL SYMBOL TABLE
+                       /100 WORDS
+                       /SINGLE WORD ENTRIES
+                       /CONSISTING OF THE SYMBOL ID (MST ADDRESS)
+                       /EACH EXT. SYM. IS      ENTRED IN
+                       /THE TABLE WHEN IT FIRST
+                       /OCCURS IN THE SOURCE AND
+                       /ASSIGNED A LOCAL EXT. NUMBER
+                       /ACCORDING TO ITS PLACE IN THE
+                       /TABLE.
+
+
+*200
+
+/PTOPTB, 0             /PAGE OP CODE TABLE
+                       /200 WORDS
+                       /SINGLE WORD ENTRIES
+                       /ONE FOR EACH ENTRY IN PAGE TABLE
+                       /ENTRY=ACTUAL OP CODE FOR
+                       /ALL MRI, OPR OR IOT'S
+                       /OR 0 FOR ALL PARAMETERS
+                       /NEW TABLE FOR EACH PAGE OF CODE
+                       /NOTE: THIS TABLE MAY OVERFLOW BY 1 WORD DURING COLLECTION
+                       /OVERFLOW CAUSED BY PUTTING INFO ON TABLE BEFORE CK FOR OVERFLOW
+                       /NO HARM IF ASSEM. PHASE LIT. TAB FOLLOWS
+
+       CDF CIF 10      /CODE FOR START AT 200
+       JMP I   .+1
+       START
+
+*400
+
+/LITBSE, 0             /ASSEMBLY PHASE LITERAL TABLE
+                       /200 WORDS
+                       /DOUBLE WORD ENTRIES
+                       /MUST BE SEPARATE FROM COLL.
+                       /PHASE LIT. TAB. BECAUSE BOTH
+                       /GOING AT ONCE IN PASS 2.
+                       /THIS TABLE CONTAINS NOT
+                       /ONLY LITERALS BUT ALSO
+                       /OFF PAGE POINTERS
+                       /1ST WORD OF ENTRY = 1 OR 2 OR 6
+                       /1 MEANS  LITERAL &
+                       /2ND WORD CONTAINS ACTUAL VALUE
+                       /2 MEANS OFF PAGE SYMBOL PTR
+                       /& 2ND WORD CONTAINS SYMBOL ID.
+                       /6 MEANS OFF PAGE SYM. PTR
+                       /WHERE SYMBOL REFERENCED BY A #
+                       /2ND WORD AS FOR 2
+                       /TABLE BUILT ANEW FOR EACH
+                       /PAGE OF CODE.
+
+
+*600
+
+/LFSBSE, 0             /LOC FIELD SYMBOL TABLE
+                       /100 WORDS
+                       /SINGLE WORD ENTRIES
+                       /EACH=SYMBOL ID (MST ADDRESS)
+                       /OF THE GIVEN LFS
+                       /LFS'S ARE ENTERED IN ORDER
+                       /OF THEIR APPEARENCE IN SOURCE
+                       /TABLE REBUILT FOR EACH PAGE OF CODE
+                       /NOTE: THIS TABLE MUST BE AT LEAST AS LONG
+                       /AS THE PST TO PREVENT LFS OVERFLOW
+
+
+
+*700
+
+PEBSE, 0               /PAGE ESCAPE PUSH DOWN LIST
+                       /40 WORDS
+                       /SINGLE WORD ENTRIES
+                       /EACH ENTRY IS 0,2, OR 4
+                       /BEING THE VALUE OF THE
+                       /PAGE ESCAPE (0,2,OR 4 WORDS)
+                       /OF EACH PAGE ASSEMBLED
+                       /THESE NOS. ARE SAVED DURING
+                       /PASS 1 & USED DURING
+                       /PASS 2
+\f*740
+/SORT LISTS
+
+/SORT LIST FOR INITIAL CHAR. OF LITERAL
+SL3,   242             /QUOTE
+       255             /MINUS
+       304             /D
+       313             /K
+       -1              /SORT LIST MUST BE FOLLOWED BY A NEGATIVE
+
+
+
+/BRANCH LISTS
+BL6,   RLN15
+       RLN2
+       RLN2
+       RLN3
+       RLN3
+
+/SORT LIST FOR BEGINNING OF INPUT ITEM
+SL2,   255             /MINUS
+       250             /LEFT PARIN
+       242             /QUOTE
+SL6,   273             /SEMI-COLON
+       257             /SLASH
+SL1,   240             /SPACE
+       211             /TAB
+       000             /CR
+       -1              /SORT LIST MUST BE FOLLOWED BY A NEGATIVE
+/BRANCH LIST FOR BEGINNING OF INPUT ITEM
+BL2,   ITM4            /NEGATIVE
+       ITM8            /LITERAL
+       ITM7            /ALPHA CONSTANT
+       ITM15           /NULL ITEM
+       ITM15           /NULL ITEM
+       ITM2            /IGNORE SPACE
+       ITM2            /IGNORE TAB
+       ITM15           /NULL ITEM
+/BRANCH LIST FOR INITIAL CHAR. OF LITERL
+BL3,   ITM7            /GET ASCII VALUE FOR LITERAL
+       ITM10           /SET NEG. SW.
+       ITM11           /SET MODE TO DECIMAL
+       ITM12           /SET MODE TO OCTAL
+
+
+
+
+
+
+*1000
+
+/LTBSE,        0               /COLLECTION PHASE LITERAL TABLE
+                       /100 WORDS
+                       /SINGLE WORD ENTRIES
+                       /CONTAINING ACTUAL VALUES
+                       /TABLE CONTAINS NOT ONLY
+                       /LITERALS BUT ALSO
+                       /POINTERS TO CONSTANT
+                       /AND ABSOLUTE ADDRESSES.
+                       /TABLE BUILT ANEW FOR
+                       /EACH PAGE OF CODE.
+
+/INPUT DATA BUFFER
+/546 (OCTAL) WORDS
+/ALL DATA CHARACTERS READ DIRECTLY INTO THIS BUFFER
+/1 CHAR. PER WORD
+/THE ACTUAL SIZE OF THE BUFFER IS ARBITRARY.
+
+*1100
+
+DATA,  0
+
+
+
+/LINE BUFFER (73 WORDS)
+/CONTAINS ASCII CHARACTERS, 1 PER WORD
+/NULLS & RUBOUTS DONT MAKE IT
+/END OF LINE MARKED BY A 0000
+/CR,LF,FF DON'T GO INTO THE BUFFER
+
+/BUFFER IS LAID OUT AS FOLLOWS:
+
+*1646
+LINBUF,        0       /110(OCTAL) WORDS FOR LINE CHARACTERS
+
+*1756
+/LINEND,       0       /1 EXTRA WORD TO PREVENT OVERFLOW
+                       /(GETS THE 0 WHEN LINE IS TOO LONG)
+*1757
+SL7,   215
+       214
+       212
+       240
+       211             /SORT LIST MUST BE FOLLOWED BY A NEGATIVE
+       -1
+BL1,   PTEXT   /SPACE
+       PTEXT   /TAB
+       TEXERR  /000
+BL7,   L72S
+       L72X
+       L72+2
+       L72+2
+       L72X
+
+\f
+
+/MAIN SYMBOL TABLE
+
+*2000
+
+
+/ENTRIES ARE COMPOSED OF THE FOLLOWING:
+/      FIRST A 1 WORD HEADER CODE
+/      THEN THE SYMBOL ITSELF IN PACKED 6BIT ASCII (1-3 WORDS)
+/      FINALLY THE 1 WORD BINARY VALUE OF THE SYMBOL
+
+/THE HEADER CODE IS LAID OUT AS FOLLOWS:
+/(A) FOR OP CODE SYMBOLS:
+/      BIT0=1 AFTER THE SYMBOL HAS BEEN PRINTED BY PRSYM
+/      BITS1&2=3  (THESE ARE THE SYMBOL TYPE BITS)
+/      BIT3=1 FOR MEMORY REFERENCE INSTRUCTIONS
+/      BITS4&5=THE MICRO-GROUP FOR OPR INSTRUCTIONS (0 FOR MRI AND IOT INSTS.)
+/              (NOTE: MICRO-GROUP IS SET TO 0 FOR CLA)
+/      BIT6=1 IF THE SYMBOL IS A PSUEDO-OP
+/      BIT7=1 IF THE INST. IS A SKIP TYPE INST.
+/      BIT8=1
+/      BIT9=0
+/      BITS10&11=THE NUMBER OF PACKED ASCII SYMBOL WORDS IN THE ENTRY
+
+/(B) FOR OTHER SYMBOL TYPES:
+/      BIT0 AS ABOVE
+/      BITS1&2=0 FOR ABSOLUTE AND COMMON SYMBOLS
+/              =1 FOR RELOCATABLE SYMBOLS
+/              =2 FOR EXTERNAL SYMBOLS
+/      BIT3=1 AFTER THE SYMBOL HAS BEEN DEFINED
+/      BIT4=1 FOR ENTRY SYMBOLS
+/      BIT5=1 IF THE SYMBOL IS EVER REFERENCED BY A #
+/      BIT6=1 IF THE SYMBOL IS IN COMMON
+/      BIT7=1 IF THE SYMBOL IS A DUMMY SYMBOL
+/      BITS8-11 AS ABOVE
+/MST=.
+       3053      /ABSYM
+       0102
+       2331
+       1500
+       PABSYM
+       3052      /ARG
+       0122
+       0700
+       PARG
+       3412      /AND
+       0116
+       0400
+       AND 0
+       3053      /BLOCK
+       0214
+       1703
+       1300
+       PBSS
+       3052      /CALL
+       0301
+       1414
+       PCALL
+       3053      /COMMN
+       0317
+       1515
+       1600
+       PCOMMN
+       3112      /CIA
+       0311
+       0100
+       CIA
+       3012      /CLA
+       0314
+       0100
+       CLA
+       3112      /CLL
+       0314
+       1400
+       CLL
+       3112      /CMA
+       0315
+       0100
+       CMA
+       3112      /CML
+       0315
+       1400
+       CML
+       3053      /DECIM
+       0405
+       0311
+       1500
+       PDEC
+       3053      /DUMMY
+       0425
+       1515
+       3100
+       PDUMMY
+       3412      /DCA
+       0403
+       0100
+       DCA 0
+       3052      /EAP
+       0501
+       2000
+       PEAP
+       3052      /END
+       0516
+       0400
+       PEND
+       3053      /ENTRY
+       0516
+       2422
+       3100
+       PENTRY
+       3053    /FORTR
+       0617
+       2224
+       2200
+       PFORT
+       3212      /HLT
+       1014
+       2400
+       HLT
+       3051    /IF
+       1106
+       PIF
+       3053      /CPAGE
+       0320
+       0107
+       0500
+       PIFF
+       3432      /ISZ
+       1123
+       3200
+       ISZ 0
+       3412    /INC (NON-SKIP ISZ)
+       1116
+       0300
+       ISZ 0
+       3112      /IAC
+       1101
+       0300
+       IAC
+       3012      /IOF
+       1117
+       0600
+       IOF
+       3012      /ION
+       1117
+       1600
+       ION
+       3412      /JMP
+       1215
+       2000
+       JMP 0
+       3412      /JMS
+       1215
+       2300
+       JMS 0
+       3012      /KRB
+       1322
+       0200
+       KRB
+       3032      /KSF
+       1323
+       0600
+       KSF
+       3052      /LAP
+       1401
+       2000
+       PLAP
+       3112      /NOP
+       1617
+       2000
+       NOP
+       3053      /OCTAL
+       1703
+       2401
+       1400
+       POCT
+       3053    /OPDEF
+       1720
+       0405
+       0600
+       OPDEX
+       3212      /OSR
+       1723
+       2200
+       OSR
+       3052      /PAGE
+       2001
+       0705
+       PPAGE
+       3053      /PAUSE
+       2001
+       2523
+       0500
+       PPAUSE
+       3012      /PLS
+       2014
+       2300
+       PLS
+       3032      /PSF
+       2023
+       0600
+       PSF
+       3053      /REORG
+       2205
+       1722
+       0700
+       PRORG
+       3053      /RETRN
+       2205
+       2422
+       1600
+       PRTN
+       3112      /RAL
+       2201
+       1400
+       RAL
+       3112      /RAR
+       2201
+       2200
+       RAR
+       3012      /RFC
+       2206
+       0300
+       RFC
+       3012      /RRB
+       2222
+       0200
+       RRB
+       3032      /RSF
+       2223
+       0600
+       RSF
+       3112      /RTL
+       2224
+       1400
+       RTL
+       3112      /RTR
+       2224
+       2200
+       RTR
+       3232      /SKP
+       2313
+       2000
+       SKP
+       3053    /SKPDF
+       2313
+       2004
+       0600
+       SKPDEX
+       3232      /SMA
+       2315
+       0100
+       SMA
+       3232      /SNA
+       2316
+       0100
+       SNA
+       3232      /SNL
+       2316
+       1400
+       SNL
+       3232      /SPA
+       2320
+       0100
+       SPA
+       3112      /STA
+       2324
+       0100
+       STA
+       3112      /STL
+       2324
+       1400
+       STL
+       3232      /SZA
+       2332
+       0100
+       SZA
+       3232      /SZL
+       2332
+       1400
+       SZL
+       3232      /SPC=SPA+CLA (USED BY COMPILER)
+       2320
+       0300
+       SPA CLA
+       3412      /TAD
+       2401
+       0400
+       TAD 0
+       3052    /TEXT
+       2405
+       3024
+       PTEXT
+       3012      /TLS
+       2414
+       2300
+       TLS
+       3032      /TSF
+       2423
+       0600
+       TSF
+
+
+ACH=20
+ACM=21
+ACL=22
+
+       0452      /ACH
+       0103
+       1000
+       ACH
+       0452      /ACM
+       0103
+       1500
+       ACM
+       0452      /ACL
+       0103
+       1400
+       ACL
+
+II,    0451    /I
+       1100
+       0400
+
+STTP=.
+\fCORE1=7600
+*CORE1-1
+
+/THE OCCURRENCE TABLE EXTENDS DOWNWARD FROM HERE
+/TOWARD THE MAIN SYMBOL TABLE
+/& SHARING THE SAME SPACE WITH IT.
+/THIS TABLE IS VARIABLE, BEING COLLAPSED
+/AS MUCH AS POSIBLE DURING USE. THE ONLY
+/THING LEFT ON IT AT THE END ARE UNDEFINED
+/SYMBOLS.
+/THE OCC. TAB. CONTAINS AN ENTRY FOR EVERY
+/REF. TO AN AS YET UNDF. SYMBOL. EACH
+/TIME A SYMBOL IS DEFINED THE  TABLE IS SEARCHED
+/TO SEE IF FORWARD REFERENCES TO IT EXIST.
+/IF SO THEY ARE OUTPUT & THE TABLE
+/CONDENSED.
+/ENTRIES CONSIST OF 2 OR 3 WORDS
+/STRUCTURED AS BELOW:
+/HIGH WORD:    LOCATION OF REFERENCE
+/LOW WORD:     SYMBOL I.D.
+/OPTIONAL WORD:        # FLAG
+/THE LOC. WORD CONTAINS THE PROG. ADDR. WHERE
+/THE VALUE OF THE SYM. MUST BE ASSEMBLED
+/THE # FLAG=1 IF IT EXISTS. IT WILL
+/EXIST ONLY FOR THOSE ENTRIES WHERE THE
+/SYM. WAS REF'D. BY A #.
+/THE TABLE IS ALWAYS SEARCHED IN REVERSE
+/FROM LOW CORE UPWARD
+/THE O.T. PTR (OTP) ALWAYS PTS. TO THE NEXT FREE
+/LOCATION BELOW THE TABLE
+/THE TABLE HAS NO IMPORTANCE DURING PASS 2.
+
+
+                       /MEMORY IS NOT USED
+
+
+$
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape2/SPATCH.PA b/sw/os8/v3d/sources/system/dectapes/dectape2/SPATCH.PA
new file mode 100644 (file)
index 0000000..192eac7
--- /dev/null
@@ -0,0 +1,847 @@
+/OS8 SABR ASSEMBLER OVERLAY            ***SPATCH.07***
+/
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/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.
+/
+/
+/
+/
+/
+/
+\f/
+/FIXES TO SPATCH FOR V18       J.K.    1975
+/
+/ .CHANGED USE OF 17645 SO /N CAN BE PASSED TO LOADER
+/      BIT 0 OF 17645 INDICATES THAT SABR WAS CHAINED
+/      TO FROM FORT
+/ .ALLOW TWO PAGE OUTPUT HANDLER
+/
+/
+/SABR ASSEMBLER, LIKE 8K FORTRAN UNDER OS/8, RUNS
+/IN FIELD 1 WITH ITS TABLES IN FIELD 0.
+/      OCTOBER 26,1971
+/
+/MODIFIED SO THAT SABR WILL, AT RUN TIME, DETERMINE IF THE USER
+/SPECIFIED I/O DEVICES REQUIRE TWO PAGE HANDLERS, AND IF SO
+/SABR WILL ALLOCATE SPACE FOR THEM.  ALSO IF ALL I/O IS DONE VIA THE
+/SYSTEM DEVICE, SABR WILL NOT RESERVE ANY SPACE FOR I/O HANDLERS
+/SPACE FOR TWO PAGE HANDLERS IS MADE BY SHRINKING THE INPUT
+/BUFFERS-CURRENTLY 4 PAGES-TO 2 PAGES.  B.CLOGHER  10/71
+/
+
+       FIELD 0
+       SDVHND=772
+       MPARAM=7643
+       DVHNDL=7647
+       JSBITS=7746
+       MOFILE=7600
+       CORE1=6200      /UPPER CORE LIMIT OF OCCURRENCE TABLE(VARIES WITH I/O HANDLERS NEEDED!!)
+       SABR=201        /SABR V17 FIRST LOC AFTER "JMS I IOINIT"
+       PASS=110        /SABR V17
+       SERROR=JMS I 177/SABR V17
+       ERRE=2701       /SABR V17
+       PRSYMP=41       /SABR V17
+       TEM1=123        /SABR V17
+       TEM2=124        /"
+       M4=3704         /"
+       CLOC1=6         /"
+       CLOC2=3162      /"
+       CLOC3=4356      /"
+       CTYPE=23        /"
+       CRLF=24
+       CHR=61          /"
+       SYMBOL=3        /"
+       LLFS=5364       /"
+       LINE=67         /"
+       L64=4772        /"
+       TYPE=54         /"
+       PUNCH=42        /"
+       INBUF=6200      /6200-7177 OR 6600-7177
+       PRJ5=4051
+       PRNOP=4136
+       PRJ2=4170
+       PRS2=4025
+       PRS5=4101
+\f      *30     /CCL PATCH; GOES HERE AS A HACK
+CCLKLG,        TAD     [SKP
+       DCA I   [CCLSKP
+       CDF     10
+       TAD I   [7645
+       SMA CLA
+       JMP I   [NOTFRT
+       TAD I   [7645
+       AND     P3777
+       DCA I   [7645
+       CDF
+       JMP I   [SETCOR
+P3777, 3777
+
+       *200    /INITIALIZATION - GETS DESTROYED DURING SABR EXECUTION
+
+START, ISZ I [FSWITC   /SKIPS SINCE FSWITC=-1. ENTRY FROM "R SABR"
+FSTART,        JMP CCLKLG      /ENTRY FROM 8K FORTRAN VIA "RUN SABR" MONITOR CALL
+       CLA CMA         /USED AS TEM. BY SUBR. DNUM
+       DCA I [FSWITC   /USED AS TEM. BY SUBR. DNUM
+PTEM1, CIF 10
+       JMS I [7700     /CALL I/O MONITOR
+       10              /AND ASK IT TO STICK AROUND
+       CIF 10
+       JMS I [200
+       5               /COMMAND DECODE
+       2302            /.SB ASSUMED EXTENSION
+NOTFRT,        CDF 10
+       TAD I [MPARAM
+       AND [100
+       CDF 0
+       SNA CLA         /IS /F SWITCH ON?
+       DCA I [FSWITC   /NO - ZERO OUT FSWITC
+       TAD I [JSBITS
+       TAD [1000
+       DCA I [JSBITS
+CCLSKP,        JMP .+5
+SETCOR,        ISZ I [FDSW     /SET DELETE SWITCH
+       CIF     10
+       JMS I   [7700   /CALL I/O MONITOR--LOCK IT IN
+       10
+       CDF     10
+       TAD I   [MOFILE /CHECK FIRST TWO OUT DEV. SPECS.--NEED 2 PAGE HNDLR?
+OUTL,  JMS     DNUM
+       JMP     OSYS    /NO OUTPUT OR SYS DEV.
+       JMP     TWOPAG  /NEED TWO-PAGE HANDLER
+DONE,  TAD I   [MOFILE+5       /1 PAGE HNDLR-LOOK AT 2ND OUT DEV.
+       ISZ     CNT     /DONE BOTH?
+       JMP     OUTL    /NO-GO ON
+       CLA             /YES-
+       TAD     PTEM2   /ARE BOTH OUT DEVS. SYS: OR NOT THERE?
+       SZA     CLA     /IF SO-ALLOT 0 PAGES FOR OUTPUT HANDLER
+       TAD     [-200   /NO-ALLOT 1 PAGE FOR HANDLER
+DONE1, DCA     OPGES   /-SIZE OF OUT HANDLER NEEDED
+INLP,  TAD I   TEM     /NOW LOOP THRU 9 POSSIBLE INPUT SPECS.
+       JMS     DNUM
+       JMP     ISYS    /INPUT NOT THERE OR SYS DEV.
+       JMP     TWOPG   /TWO PAGE HANDLER NEEDED
+ILP1,  ISZ     TEM     /ONE-MOVE PTR TO NEXT
+       ISZ     TEM
+       ISZ     CNT1    /DONE ALL 9?
+       JMP     INLP    /NO
+       TAD     TEM3    /YES-ARE ALL INPUTS FROM SYS OR NOT THERE?
+       SZA     CLA     /IF SO-DON'T SAVE ROOM FOR INPUT HANDLER
+       TAD     [-200   /NO-NEED ONE PAGE FOR HANDLER
+IDONE, DCA     IPGES   /STORE AS SIZE OF INPUT HANDLER
+       TAD     IPGES
+       TAD     OPGES
+       TAD     [400    /NEED MORE THAN A TOTAL OF 2 PAGES FOR HANDLERS?
+       CDF     00      /BACK TO DF 0
+       SMA     CLA
+       JMP     NOTWO   /NO-GO ON
+       DCA I   [INREC1 /YES-ADJUST INPUT ROUTINE FOR ONLY 2 PAGE BUFFERS
+       TAD     [200
+       DCA I   [INBFPT-1
+       DCA I   [INRD1
+       DCA I   [INRD1+1
+       TAD     [6600   /RESET ADDRESS OF INPUT BUFFER
+       DCA I   [INBFPT
+       TAD     [400
+NOTWO, TAD     [6200   /RESET UPPER CORE LIM. OF OCCURRANCE TABLE
+       TAD     IPGES
+       TAD     OPGES
+       DCA     [CORE1
+       TAD     OPGES
+       TAD     [200
+       SPA     CLA     /MORE THAN ONE PAGE OUT HNDLR NEEDED?
+       IAC             /YES
+       TAD     OPGES
+       TAD I   [INBFPT /ADJUST HANDLER FETCH FOR TWO PAGE HANDLER
+       CDF     10      /BACK TO DATA FIELD 1
+       DCA I   [OUHND
+       CMA             /PROPAGATE CHANGES INTO MAIN PART OF SABR
+       TAD     [CORE1
+       DCA I [CLOC1
+       TAD I [CLOC1
+       DCA I [CLOC3
+       TAD     [CORE1
+       DCA I [CLOC2
+       TAD     IPGES
+       TAD     [200
+       SPA     CLA     /MORE THAN ONE PAGE FOR INPUT HNDLR?
+       IAC             /YES-ADJUST IN HNDLR FETCH ROUTINE
+       TAD I   [CLOC2  /(CONTAINS START ADDRESS OF CORE FOR IN HNDLR.)
+       CDF     00
+       DCA I   [ADEVN  /STORE FOR HNDLR FETCH ROUTINE
+       CDF     10
+       JMP I   [LCHK
+ISYS,  ISZ     TEM3
+IPGES, 0
+       JMP     ILP1    /INPUT SPEC. NOT THERE OR SYS DEV.
+TWOPG, TAD     [-200   /INPUT SPEC-NEEDS TWO PAGES
+       JMP     IDONE-1 
+TWOPAG,        TAD     [-200   /OUT HNDLR NEEDS TWO PAGES
+       JMP     DONE1-1
+OSYS,  ISZ     PTEM2   /OUT HNDLR NOT NEEDED OR SYS. DEVICE
+OPGES, 0
+       JMP     DONE
+/
+/ROUTINE TO CHECK DEVICE SPECS. LEFT BY COMMAND DECODER AND SEE
+/IF WE NEED ANY TWO PAGE HANDLERS. ALSO CHECK IF ALL I/O IS FROM
+/SYS DEVICE IN WHICH WE DON'T HAVE TO SAVE ROOM FOR ANY HANDLERS
+/RETN. TO CALL + 1 IF DON'T NEED ROOM FOR ANY HANDLER
+/RETN. TO CALL + 2 IF NEED 2 PAGES FOR HANDLER
+/RETN. TO CALL + 3 IF NEED 1 PAGE FOR HANDLER
+/
+DNUM,  0
+       AND     [17     /MASK DEV. #
+       DCA     FSTART+1        /STORE
+       TAD     FSTART+1
+       CLL
+       SNA             /ANYTHING THERE?
+       JMP I   DNUM    /NO-TREAT LIKE SYS. DEV
+       TAD     [DVHNDL-1       /CHECK IF THIS HANDLER CO-RESIDENT WITH SYS.(TD8/E--UNIT 1)
+       DCA     FSTART+2
+       TAD I   FSTART+2
+       TAD     [200
+       SZL     CLA     /IS ENTRY PT. ABOVE 7600??
+       JMP I   DNUM    /YES-JUST LIKE SYS DEV.
+       TAD     FSTART+1
+       TAD     [SDVHND-1       /NO-PICK UP TABLE WD WHICH TELLS IF 2 PAGE HNDLR.
+       DCA     FSTART+2
+       TAD I   FSTART+2
+       ISZ     DNUM    /BUMP RETN.
+       SMA     CLA     /BIT 0=1? I.E. DOES IT NEED TWO PAGES?
+       ISZ     DNUM    /NO-NORMAL RETN. TO CALL+3--NEED 1 PAGE
+\f      JMP I   DNUM    /YES-RETN. TO CALL+2--NEED 2 PAGES
+TEM3,  -11
+CNT,   -2
+CNT1,  -11
+PTEM2, -2
+TEM,   MOFILE+17
+\f*400
+LCHK,  TAD I   [MPARAM+1
+       AND     (4
+       SNA CLA
+       ISZ     STSABR
+       TAD I [MPARAM+1
+       AND [40
+       SNA CLA         /IF /S IS ON
+       TAD I [MOFILE+5
+       SZA CLA         /OR IF THERE IS NO LISTING OUTPUT FILE
+       JMP NSPEED
+       TAD [PRS5&177+5200      /SPEED UP SYMBOL TABLE SORT
+       DCA I [PRJ5
+       DCA I [PRNOP
+       DCA I [SYMXX    /AND PRINT "U" MESSAGE FOR UNDEFINEDS
+       TAD [PRS2-1&177+5200
+       DCA I [PRJ2
+NSPEED,        CDF 10
+       TAD I [MOFILE+4 /GET EXTENSION OF BINARY OUTPUT
+       SNA             /IS IT THERE?
+       TAD [2214       /NO - SET TO .RL
+       DCA I [MOFILE+4
+       TAD I [MOFILE+11
+       SNA
+       TAD [1423       /SIMILIARLY SET LISTING EXTENSION TO .LS
+       DCA I [MOFILE+11
+       DCA I [OUTINH
+       TAD I [MOFILE
+       SNA CLA         /BINARY OUTPUT?
+       JMP NOBNOT      /NO
+       CDF CIF 10
+       JMS I [TSTNTR   /YES - OPEN IT
+       CDF 10
+       JMP YESBOT
+NOBNOT,        TAD [MOFILE+1
+       DCA I [PFILE
+       ISZ I [OUTINH   /INHIBIT OUTPUT
+YESBOT,        TAD I [MOFILE+5
+       CDF 0
+       SZA CLA
+       DCA I [LSTFLG
+       CDF 10
+       TAD I [MPARAM
+       AND [41         /"L" OR "G" FLAGS ON?
+       CDF 0
+       SNA CLA
+       JMP NOLOAD
+       JMS I [MINCOR
+       CLA IAC         /DEVICE "SYS"
+       CIF 10
+       JMS I [200
+       2       /LOOKUP
+ALOAD, LOADER
+       0       /LENGTH GOES HERE AND IS IGNORED
+       JMP NOLODR      /COULDN'T FIND IT
+       TAD ALOAD
+       DCA I [LDRBLK
+       CDF 10
+       TAD I [OUTREC
+       CDF 0
+       DCA I [REMEMB
+NOLOAD,        JMS I [OPENFL   /OPEN FIRST INPUT FILE WHILE MONITOR STILL IN CORE
+       CDF CIF 10
+       JMP I .+1
+STSABR,        SABR    /FIRST LOC IN SABR AFTER "INITIAL DIALOGUE"
+NOLODR,        TAD [1200
+       JMP I [ERROR
+LOADER,        TEXT    /LOADERSV/
+\f      *1100   /FILE OPENER - RESIDES IN PART OF THE OLD SABR INPUT BUFFER
+O7760, 7760
+OPENFL,        0
+       CDF 10
+       TAD I FILPTR
+       SNA     /IS THERE ANOTHER INPUT FILE?
+       JMP I (ERROR+1  /ERROR - NO END STATEMENT IN PROGRAM
+       DCA OTEMP
+       TAD OTEMP
+       AND (17         /EXTRACT DEVICE NUMBER
+       TAD (DVHNDL-1
+       DCA OTEMP2
+       TAD I OTEMP2
+       DCA OTEMP2
+       ISZ FILPTR
+       TAD I FILPTR    /GET STARTING BLOCK #
+       CDF 0
+       DCA I (INREC    /STORE IT AWAY
+       ISZ FILPTR
+       TAD OTEMP
+       AND (7760       /EXTRACT LENGTH
+       SZA             /LENGTH OF 256 IMPLIES MAY BE LARGER
+       TAD (17
+       CLL CML RTR
+       RTR             /GET LENGTH AS A NORMAL NEGATIVE NUMBER
+       DCA I (INCNT    /STORE THAT AWAY TOO
+       TAD OTEMP2
+       SZA
+       JMP GOTIT
+       JMS I (MINCOR   /GET MONITOR
+       TAD     ADEVN   /THIS LOC. SET UP BY INITIALIZATION ROUTINE
+       DCA ADEVNO
+       TAD OTEMP
+       CIF 10
+       JMS I O200
+       1               /ASSIGN
+ADEVNO,        5600            /FORCE HANDLER INTO PAGE 5600
+       JMP I (DELERR   /GIVE S ERROR
+       TAD ADEVNO
+GOTIT, DCA I (INDEV
+       JMS I (MOUCOR   /GET MONITOR OUT
+       CLA CMA
+       DCA I (INCHCT   /FORCE BUFFER LOAD ON FIRST READ
+       JMP I OPENFL
+OTEMP, 0
+OTEMP2,        0
+FILPTR,        7617
+O200,  200
+ADEVN, 0       /SET UP BY INIT. ROUTINE-PAGE ADDR. OF IN HNDLR
+\f      *1600
+MINCOR,        0
+       RDF
+       TAD MINCIF
+       DCA MINXIT
+MINCIF,        CDF CIF 0
+       CIF 10
+       JMS I SYSTEM
+       10      /ESCAPE
+       TAD MIN200
+       DCA SYSTEM
+MINXIT,        0               /RESTORE CALLING FIELDS
+       JMP I MINCOR
+MOUCOR,        0
+       CDF 0
+       TAD SYSTEM
+E7500, SMA
+       CIF 10
+MN7700,        SMA CLA
+       JMS I SYSTEM
+       11      /GET OUT
+       TAD MN7700
+       DCA SYSTEM
+       JMP I MOUCOR
+SYSTEM,        200
+MIN200,        200
+ERROR, TAD E7500       /MAKE SABR ERROR "B"
+       DCA MINCOR
+       JMS MOUCOR      /KICK MONITOR OUT
+       CDF CIF 10
+       DCA I EPASS     /SET PASS=0 SO ERROR WILL PRINT
+       TAD EL64
+       DCA I ETYPE
+       TAD MINCOR
+       JMP I .+1
+       ERRE
+EPASS, PASS
+EL64,  L64
+ETYPE, TYPE
+\f      *7200
+SPAUSE,        0               /"PAUSE" STATEMENT PATCH
+       TAD FSWITC
+       CLL RAL
+       TAD I (FILPTR
+       DCA I (FILPTR   /RESET FILE POINTER IF CALLED FROM FORTRAN
+       JMS I (OPENFL   /OPEN NEXT FILE
+       CDF CIF 10
+       JMP I SPAUSE
+FSWITC,        -1              /AS ADVERTISED
+
+DELETE,        TAD I (MPARAM
+       RTR             /PUT "K" SWITCH IN LINK
+D7600, 7600
+       CDF 0
+       TAD I (JSBITS
+       RAR
+       CLL CML RAL
+       DCA I (JSBITS   /MARK "DON'T CARE IF MONITOR AREA DESTROYED" BITS
+       TAD FDSW
+       SZL SNA CLA     /DELETE ONLY IF CALLED FROM FORTRAN WITH
+       JMP NODLET      /"K" SWITCH(IN LINK) ZERO
+       JMS I (MINCOR
+       CLA IAC         /DEVICE "SYS"
+       CIF 10
+       JMS I (200
+       4       /CLOSE - USED AS DELETE
+       NAME    /NAME FOR CLOSE PROCESSOR
+       0       /NO BLOCKS - WILL BE DELETED
+       JMP DELERR      /ERROR
+NODLET,        TAD LDRBLK
+       SNA CLA         /WAS A LOADER BLOCK STORED
+       JMP GETOUT
+       CDF 10
+       TAD I (L64
+       CDF 0
+       SZA CLA         /IF WE USED THE TELETYPE ROUTINE,
+       JMP GETOUT      /THEN THERE WAS AN ERROR
+       TAD REMEMB
+       CDF 10
+       DCA I (MOFILE+1
+       CLL CML CLA RAR
+       TAD I   (MPARAM+2
+       DCA I (MPARAM+2
+       CDF 0
+       JMS I (MINCOR
+       CIF 10
+       JMS I (200
+       6       /RUN
+LDRBLK,        0
+REMEMB,        0
+FDSW,  0
+GETOUT,        TAD I (SYSTEM
+       CDF 10
+D7700, SMA CLA
+       CMA
+       DCA I D7700
+       CDF 0
+       JMP I .+1
+       7605
+DELERR,        TAD (1700       /GIVE A "S" ERROR
+DELER2,        TAD (200
+       CDF CIF 0
+       JMP I (ERROR
+NAME,  0617;2224;2216;2415
+
+INREAD,        0
+       AND D7700
+       SNA CLA
+       JMS I POPNFL
+       JMS I INDEV
+       400     /OR 200 IF NEED TWO PAGE HANDLERS-REDUCE BUFFER SIZE TO MAKE ROOM
+INBFPT,        INBUF
+INREC, 0
+       JMP INERR
+       ISZ INREAD
+       ISZ INREC
+INREC1,        ISZ INREC       /OR 0000 IF TWO PAGE HANDLERS-SINCE IN BUFFER IS 1/2 SIZE
+       JMP I INREAD
+INDEV, 0
+INERR, SPA CLA
+       JMP DELER2
+       JMP INREC+3
+POPNFL,        OPENFL
+
+CLSMBE,        0               /SUBR TO CLOSE OUTPUT FILE IF ONE EXISTS
+       CDF CIF 10
+       TAD I (OUTINH
+       SNA CLA
+       JMS I (OUCLOS
+       CIF 0           /IN CASE WE DIDN'T CLOSE IT
+       JMP I CLSMBE
+\f      *7400   /END OF PASS CRAP AND INPUT ROUTINE
+P40,   40
+PASEND,        ISZ I (PASS     /BUMP PASS COUNTER
+LSTFLG,        JMP SBSYMT      /ZERO IF LISTING FILE EXISTS
+       JMS I (CLSMBE   /CLOSE BINARY FILE
+       CDF CIF 10
+       JMS I (TSTNTR   /ENTER LISTING FILE
+       TAD I (FSWITC
+       SZA CLA
+       JMP .+4
+       TAD (7617
+       DCA I (FILPTR   /RESET FILE POINTER TO BEGINNING
+       JMS I (OPENFL   /AND OPEN FIRST FILE
+               /IF CALLED FROM FORTRAN WE DONT HAVE TO DO THIS
+               /BECAUSE OF THE PECULIAR NATURE OF FORTRAN OUTPUT
+       JMS I (MOUCOR   /KICK MONITOR OUT
+       CDF CIF 10
+       TAD I (MPARAM+1
+P200,  AND P40         /MASK OUT "S" SWITCH
+       DCA I (OUTINH   /INTO "OUTPUT INHIBIT" FLAG
+       JMS I (SYMPRT   /PRINT SYMBOL TABLE UNDER CONTROL OF /S
+       DCA I (OUTINH   /ZERO FLAG FOR LISTING
+       TAD I (MPARAM+1 /SYMPRT RETURNS WITH DATA FIELD=10
+       RTL
+       CIF 10
+       SNL CLA         /"N" FLAG IS IN THE LINK
+       JMP I (ENDRSM   /HE WANTS A LISTING - GO GET IT
+SBREND,        CIF 0
+       JMS I (CLSMBE   /CLOSE OUTPUT FILE
+       JMP I (DELETE   /DELETE FORTRN.TM AND CHAIN OR RETURN
+
+SBSYMT,        TAD (TDUMMY
+       CDF CIF 10
+       DCA I (PUNCH    /INHIBIT ALL FUTURE OUTPUT
+       JMS I (SYMPRT   /CHECK SYMTAB FOR UNDEFINEDS
+       CDF 0
+       ISZ I (JSBITS   /SET "DON'T CARE ABOUT USR CORE" FLAG
+       JMP SBREND      /NOW GO CLOSE BINARY OUTPUT FILE AND RETURN
+
+INCHAR,        0
+       ISZ INJMP
+       KSF
+       JMP .+5
+       KRS
+       TAD (-203
+       SNA CLA
+       JMP I (7600     /EXIT TO MONITOR IF ^C TYPED
+       ISZ INCHCT
+INJMPP,        INJMPE
+       TAD INCNT
+INRD,  JMS I (INREAD
+       DCA INCNT       /RETURN HERE ON EOF
+INRD1, ISZ INCNT       /SET TO 0000 IF 2 PAGE HANDLERS FORCE INPT. BUFF. TO 1/2 SIZE
+       SKP             /       "       "       "
+       TAD (600
+       ISZ INCNT
+IN7400,        7400
+       TAD (-1401
+       DCA INCHCT
+       TAD INJMPP
+       DCA INJMP
+       TAD I   (INBFPT
+       DCA INPTR
+       JMP INCHAR+1
+       INJMPE=JMP .
+INJMP, INJMPE
+       JMP INCHA1
+       JMP INCHA2
+INCHA3,        TAD INJMPP
+       DCA INJMP
+       TAD I INPTR
+       AND IN7400
+       CLL RTR
+       RTR
+       TAD INTEMP
+       RTR
+       RTR
+       ISZ INPTR
+       JMP INCOM
+INCHA2,        TAD I INPTR
+       AND IN7400
+       DCA INTEMP
+       ISZ INPTR
+INCHA1,        TAD I INPTR
+INCOM, AND (177
+       SZA
+       TAD (-177
+       SNA
+       JMP INCHAR+1
+       TAD (145        /CHECK FOR ^Z
+       SNA
+       JMP INRD        /^Z ON INPUT MEANS GO TO NEXT FILE
+       TAD (232
+       CDF CIF 10
+       DCA I (CHR
+       JMP I INCHAR
+INPTR, 0
+INCHCT,        0
+INTEMP,        0
+INCNT, 0
+       FIELD 1
+\f      *6400   /OUTPUT ROUTINE INTERFACE - CANT GO PAST 6423
+OUCHAR,        0
+       DCA I POUTEM
+       TAD OUTINH
+       SZA CLA
+OUCRET,        JMP I OUCHAR    /DOUBLES AS OFF-PAGE RETURN
+       ISZ I POUJMP
+       ISZ OUCHCT
+       JMP I POUJMX
+       JMS OUTDMP
+       JMP OUCHAR+2
+POUJMP,        OUJMP
+POUJMX,        OUJMX
+POUTEM,        OUTEMP
+OUTINH,        0
+F3ERR, TAD O2100
+F2ERR, TAD O2100
+F1ERR, CDF CIF 0
+       JMP I .+1
+       ERROR
+O2100, 2100
+       *6457   /LOADS OVER OLD SABR INITIALIZATION ROUTINE
+TSTNTR,        0               /CALLED FROM FIELD 0
+       TAD PFILE
+       TAD C4
+       DCA PFILE
+       TAD I PFILE
+       ISZ PFILE
+       DCA ODEVNO
+       TAD     OUHND   /THIS LOC. IS SET UP AT INIT. TIME
+       DCA OUHNDL
+       CIF 0
+       JMS I (MINCOR
+       JMS I (200
+       13              /RESET OUTPUT DEVICE
+       TAD ODEVNO      /LOAD OUTPUT DEVICE
+       JMS I (200
+       1
+OUHNDL,        7400
+       JMP F2ERR
+       TAD PFILE
+       DCA ENAME       /POINTS TO FILE NAME
+       DCA OULNGT      /ZERO CLOSING LENGTH
+       TAD ODEVNO      /LOAD DEVICE NUMBER AND REQUESTED LENGTH
+       JMS I (200
+       3       /ENTER
+ENAME, 0               /POINTER INTO COMMAND DECODER AREA GOES HERE
+       OUCHCT=ENAME
+ELENGT,        0               /"0 LENGTH" MEANS AS LARGE A SPACE AS POSSIBLE
+       JMP F2ERR       /COULDN'T ENTER FILE - MAYBE BAD DIRECTORY
+       TAD ENAME       /GET STARTING BLOCK #
+       DCA OUTREC      /STORE IT AWAY
+       JMS OUSPTR      /INITIALIZE OUTPUT ROUTINE
+ENTRTN,        CDF CIF 0
+       JMP I TSTNTR
+OUSPTR,        0
+       TAD POUBUF
+       DCA I (OUPTR
+       TAD (-601
+       DCA OUCHCT
+       TAD (OUJMPE
+       DCA I POUJMP
+       JMP I OUSPTR
+OUTDMP,        0
+       CIF 0
+       JMS I OUHNDL
+       4200
+POUBUF,        1200    /REMAINDER OF OLD SABR INPUT BUFFER
+OUTREC,        0
+       JMP F3ERR
+       ISZ OUTREC
+       JMS OUSPTR
+       ISZ OULNGT
+       ISZ ELENGT
+       JMP I OUTDMP
+       JMP F2ERR
+OUCLOS,        0
+       TAD OUT232      /PUT A ^Z IN THE OUTPUT FILE
+       JMS OUCHAR
+       TAD OUCHCT
+       CMA
+       SZA CLA
+       JMP .-4         /FILL REMAINDER OF BUFFER WITH ZEROS
+       JMS OUTDMP
+       CIF 0
+       JMS I (MINCOR
+       TAD ODEVNO
+       JMS I (200
+C4,    4       /CLOSE
+PFILE, 7574
+OULNGT,        0
+       JMP F2ERR       /ERROR ON CLOSE
+       DCA OULNGT
+       CIF 0
+       JMP I OUCLOS
+OUT232,        232
+ODEVNO,        0
+OUHND, 0       /SET UP AT INIT. TIME TO ALLOW 2 PAGE HNDLR
+                       /IF NEEDED
+       *6610   /OUTPUT ROUTINE - CANT GO PAST 6661
+OUJMX, CDF 0
+       OUJMPE=JMP .
+OUJMP, OUJMPE
+       JMP OUCHA1
+       JMP OUCHA2
+OUCHA3,        TAD OUTEMP
+       RTL
+       RTL
+       DCA OUTEMP
+       TAD OUJMPP
+       DCA OUJMP
+       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
+OUCHA2,        TAD OUPTR
+       DCA OUPOLD
+       ISZ OUPTR
+OUCHA1,        TAD OUTEMP
+       AND OU377
+       DCA I OUPTR
+OUCOM, CDF 10
+       JMP I .+1
+       OUCRET
+OUPTR, 0
+OUJMPP,        OUJMPE
+OUPOLD,        0
+OUTEMP,        0
+OU7400,        7400
+OU377, 377
+\f              /PATCHES TO SABR TO HOOK INTO THESE WONDERFUL ROUTINES
+       *4574           /OLD "INITR" ROUTINE AREA - 4 LOCATIONS LONG
+SYMPRT,        0       /INTERMEDIATE ROUTINE TO PRINT SYMBOL TABLE
+       JMS I PRSYMP    /CALL SABR'S ROUTINE
+       CIF 0
+       JMP I SYMPRT    /BUT RETURN TO FIELD 0
+
+       *4641           /CODE IN THIS SECTION CAN'T GO PAST 4704
+FETCH, 0       /REPLACES ROUTINE IN SABR OF SAME NAME
+       CDF CIF 0
+       JMS I .+2
+       JMP I FETCH
+       INCHAR
+
+LDRCT, 7700    /FOR LEADER-TRAILER ROUTINE ON SAME PAGE
+
+USYMFG,        0               /ROUTINE TO GIVE UNDEFINED SYMBOL MESSAGES WHEN
+       JMS I CTYPE     /NO SYMBOL TABLE IS REQUESTED
+SYMXX, JMP I USYMFG    /ZEROED IF CHECKING FOR UNDEFINEDS
+       TAD SYMBOL
+       DCA I PLLFS     /SET UP SABR CELLS SO THAT ERROR ROUTINE WILL
+       DCA LINE        /PRINT THE NAME OF THE UNDEFINED SYMBOL
+       TAD U2300       /FUDGE FOR "U" ERROR MESSAGE - UNFORTUNATELY,
+       JMP I .+1       /THIS MESSAGE IS INSTANTLY FATAL - SERVES HIM RIGHT
+       F1ERR
+PLLFS, LLFS            /RANDOM LOCATION IN SABR
+U2300, 2300
+
+TDUMMY,        0               /DUMMY OUTPUT ROUTINE
+       CLA
+       JMP I TDUMMY    /AS DUMMY AS YOU CAN GET
+
+       *6133           /PATCH TO SYMBOL TABLE PRINTER TO USE ABOVE
+       JMS I 6177      /THIS REPLACES A "JMS I CTYPE"
+       *6177
+       USYMFG          /LUCKILY THERE WAS A LOCATION FREE
+
+       *3665           /REWRITE OF OCTAL TYPEOUT ROUTINE TO
+       DCA TEM1        /NOT KEEP INFORMATION IN THE LINK ACROSS
+       TAD M4          /A CALL TO THE OUTPUT ROUTINE
+       DCA TEM2
+L62A,  TAD TEM1
+       RTL
+       RAL
+       DCA TEM1
+       TAD TEM1
+       RAL
+       *3702
+       JMP L62A
+
+       *4317   /"PAUSE" PROCESSOR
+       CLA     /REPLACES CLA HLT
+       CDF CIF 0
+
+       *4332   /PATCHES TO INITIALIZATION ROUTINE
+       NOP     /DON'T GIVE
+       NOP     /TWO USELESS CARRIAGE RETURN - LINE FEED PAIRS
+
+       *4341
+       NOP     /DON'T JMS I 4372 'CAUSE WE HAVE CHANGED 4372!
+
+       *4372   /MORE "PAUSE" FUDGE
+       SPAUSE
+
+       *4715   /ALTER COUNT ON LEADER-TRAILER
+       TAD LDRCT
+
+       *561    /"END" STMT PROCESSOR
+       CIF 0
+       JMP I PEND      /END OF PASS 1
+       ENDRSM=.
+
+       *565    /MORE ON "END"
+       NOP     /ELIMINATE HALT AT END OF PASS 1
+
+       *570    /STILL MORE ON "END"
+       CDF CIF 0
+       JMP I SEND      /END OF PASS 2
+
+       *576    /THERE ARE (WERE) TWO WHOLE FREE LOCATIONS IN THIS PAGE!
+SEND,  SBREND
+PEND,  PASEND
+
+       *2761   /FATAL ERROR HALT IN ERROR ROUTINE
+       CDF CIF 0
+       JMP I 166       /166 = LITERAL 7600
+
+       *4003   /LISTING ROUTINE
+       SKP CLA /ALWAYS PUT LISTING ON "PUNCH"
+
+       *PUNCH  /POINTER TO PUNCH ROUTINE
+       OUCHAR  /POINTER TO MY PUNCH ROUTINE
+/
+       *200
+       VERNUM
+       JMS I   .-1
+/
+       *7000
+VERNUM,        0
+       JMS I   CRLF
+       TAD I   POINT
+       JMS I   CTYPE
+       ISZ     POINT
+       ISZ     COUNT
+       JMP     .-4
+       JMS I CRLF
+       DCA I   TYPE
+       JMP I   VERNUM
+/
+POINT, TITLE
+COUNT, -5
+TITLE, TEXT    /SABR V18A /
+       $
+\f
+\r\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/ATAN.SB b/sw/os8/v3d/sources/system/dectapes/dectape3/ATAN.SB
new file mode 100644 (file)
index 0000000..eab3420
--- /dev/null
@@ -0,0 +1,151 @@
+/ARCTANGENT ROUTINE                       OS8 FORTRAN II LIBRARY
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/     VERSION 11A
+/      VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
+       ENTRY   ATAN
+
+ATAN,  BLOCK   1
+       11
+       TAD     ATAN
+       DCA     L4
+       TAD     ATAN#
+       DCA     L4#
+       INC     ATAN#
+       INC     ATAN#
+       CALL    1,IFAD
+L4,    ARG     0
+       CLL
+       TAD     ACH
+       SNA
+       JMP     EXIT
+       SPA
+       TAD     (4000
+       DCA     ACH             /TAKE ABSVAL OF ARGUMENT
+       RAR
+       DCA     SIGN            /AND REMEMBER SIGN
+       TAD     ACH
+       TAD     (-2014
+       SPA CLA
+       JMP     LSTN45          /IF ARG>1,
+       JMS     INVRS           /INVERT ARG - SUBTRACT RESULT FROM PI/2
+       CLA CMA
+LSTN45,        DCA     L4#             /L4# IS THE "PI/2-RESULT" SWITCH
+       TAD     ACH
+       TAD     (-1774          /THIS IS AN APPROXIMATE TEST TO SEE
+       SPA CLA                 /IF THE NEW ARG IS <2-SQRT(3)
+       JMP     LSTN15          /IF IT IS,
+       CALL    1,FAD           /PERFORM A "DIFFERENCE OF TANGENTS"
+       ARG     SQRT3           /TRANSFORMATION TO SUBTRACT PI/6
+       TAD     (20
+       JMS     INVRS           /FROM THE RESULT. THE ARG IS TRANSFORMED
+       CALL    0,CHS           /INTO SQRT(3)-4/(ARG+SQRT(3))
+       CALL    1,FAD
+SQT3,  ARG     SQRT3
+       CLA CMA
+LSTN15,        DCA     INVRS           /USE INVRS AS A SWITCH TO INDICATE THIS
+       CALL    1,STO           /TRANSFORMATION OCCURRED
+       ARG     T
+       TAD     (-4
+       DCA     L4
+       TAD     SQT3#
+       DCA     L3#
+ATLOOP,        INC     L3#             /NOW PERFORM A STANDARD TAYLOR SERIES
+       INC     L3#             /EXPANSION (WITH TRUNCATED COEFFICIENTS)
+       INC     L3#
+       CALL    1,FAD           /CONVERGENCE WILL BE GOOD SINCE WE
+L3,    ARG     SQRT3           /HAVE MADE THE ARGUMENT BE <.3
+       JMS     FMPT
+       JMS     FMPT
+       ISZ     L4
+       JMP     ATLOOP
+       JMS     FMPT
+       CALL    1,FAD
+       ARG     T               /FINISH UP THE SERIES
+       ISZ     INVRS
+       JMP     NOPI6
+       CALL    1,FAD           /ADD PI/6 IF NECESSARY
+       ARG     PIOVR6
+NOPI6, ISZ     L4#
+       JMP     NOPI2
+       CALL    0,CHS           /SUBTRACT FROM PI/2 IF NECESSARY
+       CALL    1,FAD
+       ARG     PIOVR2
+NOPI2, TAD     SIGN
+       TAD     ACH             /SET SIGN OF RESULT = SIGN OF ARGUMENT
+       DCA     ACH
+EXIT,  RETRN   ATAN
+
+INVRS, 0               /INVERSION SUBROUTINE
+       TAD     (2014   /ENTERED WITH AC=0 OR 20
+       DCA     L4      /AC=0 MEANS 1/FAC, AC=20 MEANS 4/FAC
+       CALL    1,STO
+       ARG     T
+       TAD     L4
+       DCA     ACH     /ACM AND ACL WERE CLEARED BY STORE
+       CALL    1,FDV
+       ARG     T
+       JMP I   INVRS
+
+FMPT,  0               /SUBROUTINE TO MULTIPLY BY T
+       CALL    1,FMP   /SAVES A FEW MEASLY LOCATIONS
+       ARG     T
+       JMP I   FMPT
+
+SIGN,  0               /CELL FOR HOLDING SIGN OF ARG
+T,     BLOCK   3       /FLOATING TEMPORARY
+
+       PAGE
+
+PIOVR6,        2004;1405;2216  /PI/6
+PIOVR2,        2016;2207;7325
+SQRT3, 2016;7331;7272  /SQRT(3)
+/THE NEXT 4 NUMBERS MUST IMMEDIATELY FOLLOW SQRT3
+       1756;0462;4562  /APPROXIMATELY 1/9
+       5764;4221;3403  /APPROXIMATELY -1/7
+       1766;3141;6672  /APPROXIMATELY 1/5
+       5775;2525;2337  /APPROXIMATELY -1/3
+
+       END
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/BITMAP.PA b/sw/os8/v3d/sources/system/dectapes/dectape3/BITMAP.PA
new file mode 100644 (file)
index 0000000..f510d93
--- /dev/null
@@ -0,0 +1,861 @@
+/1.1 OS8 BINARY MAP (BITMAP) V4
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT  (C)  1972,1973,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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/NO CHANGES MADE FOR OS/8 V3C
+
+       VERSION=        4
+       SUBVER=         01      /LOCATED AT "VERLOC" AS 60+VERSION^100+SUBVER
+
+XR=    10
+LOADXR=        11
+XFIELD=        20      /HOLDS FIELD WE ARE "STORING" INTO
+ORIGIN=        21      /HOLDS CURRENT ORIGIN
+OUT=   22
+B1=    23
+B3=    24
+C1=    25
+COLCTR=        27
+WD=    30
+WD1=   31
+WD2=   32
+FILPTR=        33
+FLDNO= 35
+
+/OS/8 EQUIVALENCES
+
+MPARAM=        7643
+JSBITS=        7746
+MIFILE=        7617
+PTP=   20
+DCB=   7760
+
+/BUFFER AND DEVICE HANDLER ASSIGNMENTS
+
+OUCTL= 4200
+OUBUF= 6000
+OUDEVH=        6400
+\f      FIELD 1
+       *2000
+
+BITMAP,        JMP CALLCD
+       JMP NOCD        /CHAINED ENTRY POINT
+NEXTCD,        TAD I   (MPARAM-1
+       SPA CLA
+       JMP I   (BUILD  /ALTMODE TERMINATES INPUT, STARTS OUTPUT
+CALLCD,        JMS I (200
+       5               /COMMAND DECODE
+       0216            /DEFAULT EXTENSION IS .BN
+NOCD,  TAD     (LDRPCH
+       DCA     OUT
+       ISZ     ONCE
+       JMP     CDCOOL
+       CLA CLL CMA RTL
+       CDF 0
+       AND I   (JSBITS /REMOVE "DON'T CARE ABOUT CD AREA" BIT
+       DCA I   (JSBITS
+       CDF 10
+       JMS I   (CTINIT
+CDCOOL,        TAD I (MPARAM+1
+       AND (100
+       SZA CLA         /IS /R SWITCH ON?
+       JMS I (CTINIT   /YES - RE-INITIALIZE LOADER TABLES
+LD7400,        7400
+       TAD (MIFILE
+       DCA FILPTR
+       JMP I   (NEWFIL
+ONCE,  -1
+\f/SUBROUTINE TO "LOAD" A WORD.
+/INCREMENTS TWO-BIT QUANTITY CORRESPONDING TO THE WORD.
+/FIELD 0 IS MAPPED INTO WORDS 00000-01377,FIELD 1 INTO 01400-02777
+/FIELDS 4-7 ARE MAPPED INTO 20000-25777
+
+LOADWD,        0               /ENTER WITH LOW 4 BITS OF ORIGIN IN AC
+       CLL RAL
+       TAD     (BITTBL-1
+       DCA     LOADXR
+       TAD I   LOADXR  /GET WORD IN THE 3-WORD SET
+       DCA     LDOFST  /(WHICH MAPS 16 WORDS)
+       TAD I   LOADXR  /GET THE LOW ORDER BIT OF THE PAIR
+       DCA     LDBIT   /WHICH MAPS THIS WORD
+       TAD     ORIGIN  /NOW FIND OUT WHICH TRIPLEWORD TO USE
+       RTL
+       RTL
+       AND     (7407
+       TAD     XFIELD
+       RTL
+       RTL
+       CDF 0
+       RTL
+       RAL
+       SZL
+CDF20Y,        CDF 20          /NOP'ED IF NO FIELD 2 IN MACHINE
+       CLL RTR         /FIELDS 4-7 MAPPED IN FIELD 2
+       DCA     LTEMP
+       TAD     LTEMP
+       CLL RAL
+       TAD     LTEMP
+       TAD     LDOFST
+       DCA     LTEMP
+       TAD     LDBIT
+       CLL RAL
+       TAD     LDBIT
+       AND I   LTEMP
+       SNA CLA         /IF COUNT IS AT 3 (MAX),
+       JMP I   LOADWD  /DON'T INCREMENT IT
+       TAD     LDBIT
+       CIA
+       TAD I   LTEMP
+       DCA I   LTEMP
+       RDF
+       CDF 10
+       SZA CLA
+       DCA I   (F4FLAG /SEARCH FIELD 2 IF WE STORED THERE
+       JMP I   LOADWD
+LDOFST,        0
+LDBIT, 0
+LTEMP, 0
+\f/BIT TABLE FOR MAPPING
+
+BITTBL,        0;2000;0;400;0;100;0;20;0;4;0;1
+       1;2000;1;400;1;100;1;20;1;4;1;1
+       2;2000;2;400;2;100;2;20;2;4;2;1
+       PAGE
+\fNEWFIL,       TAD (7001
+       DCA HANDLR
+       TAD I FILPTR
+       AND (7760
+       SZA             /LENGTH OF 256 BLOCKS IMPLIES AT LEAST 256
+       TAD (17
+       CLL CML RTR
+       RTR
+       DCA RCDCNT
+       TAD I FILPTR
+       ISZ FILPTR
+       SNA
+       JMP I   (NEXTCD /FILE POINTER = 0 MEANS NO MORE INPUT FILES
+       JMS I (200
+       1               /ASSIGN
+HANDLR,        7001            /LOAD INTO 7000 IF NOT ALREADY LOADED
+       JMP I (IOERR
+       TAD I FILPTR
+       DCA RECNO
+       ISZ FILPTR
+       CLA CMA
+       DCA CHCNT
+       DCA REOF
+       TAD I (MPARAM   /TEST FOR /I
+       AND (10
+       SNA CLA
+       JMP I (LOADER   /I IS NOT ON
+       JMP I (OERR     /NO!
+\fGETCH,        0               /GET-NEXT-INPUT-CHARACTER ROUTINE
+       JMS I   (CTCTST
+       ISZ JMPGET
+       ISZ CHCNT
+JMPX,  JMP JMPGET
+       TAD REOF
+       SZA CLA
+       JMP I GETCH     /EOF REACHED BEFORE LOGICAL END - ERROR
+       CLL
+       TAD     RCDCNT
+       TAD     (6
+       SNL
+       DCA     RCDCNT
+       SZL
+       ISZ     REOF
+       CLL CMA CML RTR
+       RTR
+       RTR
+       TAD     (1411
+       DCA     RCTL
+       CIF 0
+       JMS I HANDLR
+RCTL,  0               /READ RECORDS INTO FIELD 1
+PBUFFR,        BUFFER
+RECNO, 0
+       JMP RERROR
+       TAD     RECNO
+       TAD     (6
+       DCA     RECNO
+       TAD     (-4401
+       DCA CHCNT
+       TAD PBUFFR
+       DCA CHPTR
+       TAD JMPX
+       DCA JMPGET
+       JMP GETCH+1
+\fJMPGET,       JMP .
+       JMP CHAR1
+       JMP CHAR2
+       TAD JMPX
+       DCA JMPGET
+       TAD I CHPTR
+       AND (7400
+       CLL RTR
+       RTR
+       TAD CHTMP
+       RTR
+       RTR
+       ISZ CHPTR
+       JMP GCHCOM
+CHAR2, TAD I CHPTR
+       AND (7400
+       DCA CHTMP
+       ISZ CHPTR
+CHAR1, TAD I CHPTR
+GCHCOM,        AND (377
+       ISZ GETCH
+       JMP I GETCH
+RERROR,        SPA CLA
+       JMP I (IOERR    /AN ACTUAL READ ERROR - AMAZING!
+       ISZ REOF
+       JMP RECNO+2
+REOF,  0
+CHCNT, 0
+CHPTR, 0
+CHTMP, 0
+RCDCNT,        0
+\fZTST, 0               /TEST A BLOCK OF THE BITMAP FOR ALL ONES
+       DCA     B3      /LENGTH OF THE BLOCK IN AC
+       TAD     LOADXR
+       DCA     XR
+       STA
+       JMS I   (XCDF
+       AND I   XR
+       ISZ     B3
+       JMP     .-2
+       CDF 10
+       CMA
+       SZA
+       JMP I   ZTST
+       TAD     XR
+       DCA     LOADXR  /UPDATE LOADXR IF ALL ZEROES
+       JMP I   ZTST
+       PAGE
+\fITSOVR,       JMS ASSEMB      /GET THE CHECKSUM
+       CIA
+       TAD LCKSUM
+       SZA CLA         /IS IT GOOD?
+       JMP I (BADCKS   /NO
+       TAD I (MPARAM+1
+       AND L40
+       SNA CLA         /IF /S IS NOT SET,
+       JMP I (NEWFIL   /ONLY ONE PROGRAM PER FILE.
+LOADER,        DCA LCKSUM
+       JMS GETFLD
+       DCA XFIELD
+       TAD (200
+       DCA ORIGIN      /INITIALIZE FOR PROGRAM
+       JMS I (GETCH
+       JMP I (NEWFIL
+       SNA
+       JMP .-3
+       TAD (-200       /FIND SOME LEADER
+       SZA CLA
+       JMP LOADER+1
+LEADER,        JMS I (GETCH
+       JMP I (NEWFIL
+       SNA
+       JMP LOADER+1
+       TAD (-200       /FIND END OF LEADER
+       SNA
+       JMP LEADER
+NEWWD, SMA             /FIELD SETTING?
+       JMP FIELDW      /YES
+       TAD (200
+       DCA WD1         /STORE 1ST CHAR
+       JMS I (GETCH
+       JMP I (BADINP
+       DCA WD2         /2D CHAR
+       JMS I (GETCH
+       JMP I (BADINP
+       TAD (-200       /IF THIS IS LEADER, WE HAVE THE CHECKSUM
+       SNA
+       JMP ITSOVR
+       DCA WD
+       JMS ASSEMB
+       SNL             /ORIGIN OR DATA?
+       JMP DATAWD      /DATA
+       DCA ORIGIN
+       JMP GETNXT
+\fDATAWD,       CLA
+       TAD     ORIGIN
+       AND     (17
+       JMS I (LOADWD   /GO SET THE CORRECT BIT(S)
+       CDF 10
+       ISZ ORIGIN
+L40,   40
+GETNXT,        TAD WD1
+       TAD WD2
+       TAD LCKSUM
+       DCA LCKSUM
+       TAD WD
+       JMP NEWWD
+
+ASSEMB,        0
+       TAD WD1
+       CLL RTL
+       RTL
+       RTL
+       TAD WD2
+       JMP I ASSEMB
+
+FIELDW,        TAD (-32
+       SNA
+       JMP CTLZ
+       TAD (-46
+       SPA
+       JMP NOTXP
+       DCA WD1
+       TAD WD1
+       AND (7
+       SZA CLA
+       JMP NOTXP
+       TAD WD1
+       AND (70
+       DCA XFIELD
+       JMS I (GETCH
+       JMP I (BADINP
+       TAD (-200
+       SZA
+       JMP NEWWD
+NOTXP, CLA
+       TAD LCKSUM
+       SNA CLA
+       JMP LOADER
+       JMP I (BADINP
+LCKSUM,        0
+
+CTLZ,  TAD LCKSUM
+       SZA CLA
+       JMP I (BADINP
+       JMP I (NEWFIL
+\fGETFLD,       0               /ROUTINE TO CHECK FOR OPTION 0-7
+       DCA C1          /AND RETURN LOWEST-NUMBERED VALUE
+       TAD I (MPARAM+2
+       AND (1774
+       SNA
+       JMP I GETFLD
+       RTL
+       RAL
+       ISZ C1
+       SNL
+       JMP .-3
+       CLA CMA
+       TAD C1
+       CLL RTL
+       RAL
+       JMP I GETFLD
+       PAGE
+\fERPCH,        0
+       AND (77         /GET LOW ORDER 6 BITS
+       SZA
+       JMP NZCHAR
+       JMS ERR
+FILMSG,        TEXT    /, FILE 0/
+       JMP I   (BITMAP
+NZCHAR,        TAD     (240
+       AND     (77
+       TAD     (240
+       JMS I   OUT     /PRINT
+       JMP I ERPCH     /AND RETURN
+
+LDRPCH,        0
+       TLS
+       TSF
+       JMP .-1
+       CLA
+       JMP I LDRPCH
+
+ERR,   0
+       CLA
+       CDF 10
+       TAD I (FILPTR   /ZERO CHAR GETS REPLACED BY "FILE #"
+       TAD (322        /MAGIC NUMBER
+       CLL CML RAR     /AC NOW CONTAINS " #"
+       DCA FILMSG+3
+ERRLUP,        TAD I ERR
+       SNA
+       JMP EOMESG      /MESSAGE MUST BE EVEN NUMBER OF CHARS LONG
+       RTR
+       RTR
+       RTR
+       JMS ERPCH
+       TAD I ERR
+       JMS ERPCH
+       ISZ ERR
+       JMP ERRLUP
+EOMESG,        JMS I   (ECRLF
+       JMP I   ERR     /RETURN
+\fIOERR,        JMS ERR
+       TEXT    %I/O ERROR%
+       JMP I   (BITMAP
+BADINP,        JMS ERR
+       TEXT    /BAD INPUT/
+       JMP I   (BITMAP
+BADCKS,        JMS ERR
+       TEXT    / BAD CHECKSUM/
+       JMP I   (BITMAP
+NULERR,        JMS ERR
+       TEXT    /NO INPUT/
+       JMP I   (BITMAP
+OUTERR,        TAD     (LDRPCH
+       DCA     OUT
+       JMS ERR
+       TEXT    /ERROR ON OUTPUT DEVICE/
+       JMP I   (CALLCD
+OERR,  JMS ERR
+       TEXT %NO /I!%
+       JMP I   (BITMAP
+\fCTINIT,       0
+       CLA CLL CML RTR
+       DCA     C1
+       DCA     B1
+       DCA     0       /STRAIGHT-8 CROCK
+CTINLP,        CDF 0
+       CLA CMA
+       DCA I B1
+CDF20X,        CDF 20
+       STA
+       DCA I   B1
+       JMP     CTFLD2  /*** THIS INSTR SKIPPED IF 8K PDP-8!!!
+       DCA     CDF20X  /DUE TO BUG IN EXTENDED MEMORY CONTROLLER
+       TAD     ERR+1   /A CLA
+       CDF 10
+       DCA I   (CDF20Y
+CTFLD2,        ISZ     B1
+       ISZ C1
+       JMP CTINLP
+       CDF 10
+       JMP I CTINIT
+       PAGE
+\f/GENERAL OUTPUT ROUTINES
+
+       /JMS I (OOPEN           INITIALIZES THE OUTPUT ROUTINE
+       /ERROR RETURN           AC>0 IF NO OUTPUT DEVICE/FILE, AC<0 IF ERROR
+
+       /JMS I (OCHAR           OUTPUTS A CHARACTER
+       /ERROR RETURN           OUTPUT ERROR OR TOO MUCH OUTPUT
+
+       /JMS I (OCLOSE          CLOSES THE OUTPUT FILE
+       /ERROR RETURN           FILE TOO LARGE TO BE CLOSED OR OUTPUT ERROR
+
+       /JMS I (OTYPE           RETURNS DCB WORD OF OUTPUT DEVICE IN AC
+
+
+
+       /PARAMETERS NEEDED:
+
+       /OUBUF=         ADDRESS OF OUTPUT BUFFER
+       /OUCTL=         OUTPUT BUFFER CONTROL WORD (MUST BE NEGATIVE)
+       /OUDEVH=        ADDRESS OF PAGE FOR OUTPUT HANDLER
+
+       /ASSUMES I/O MONITOR IS RESIDENT IN CORE.
+       /CAN BE CALLED FROM ANY FIELD WITH BUFFERS IN ANY FIELD.
+
+OUFLD= OUCTL&70
+\fOOPEN,        0
+OU7600,        7600
+       TAD OU7601
+       DCA OUBLK
+       TAD (OUDEVH+1
+       DCA OUHNDL
+       CDF 10
+       TAD I   (7604
+       SNA             /IF OUTPUT HAS NO EXTENSION,
+       TAD     (1520   /GIVE IT THE EXTENSION .MP
+       DCA I   (7604
+OUASGN,        TAD I OU7600            /GET DEVICE NUMBER WORD OF OUTPUT FILE ENTRY
+       AND (17                 /STRIP OFF ANY LENGTH INFO
+       SNA                     /IS THERE AN OUTPUT DEVICE?
+       JMP USETTY              /NO - INHIBIT OUTPUT
+       JMS I (200
+       1                       /ASSIGN, FETCH HANDLER
+OUHNDL,        0                       /OUTPUT DEVICE HANDLER ENTRY
+       HLT                     /HUH?
+OUENTR,        TAD I OU7600
+       JMS I (200
+       3                       /ENTER OUTPUT FILE
+OUBLK, 7601                    /REPLACED WITH STARTING BLOCK
+OUELEN,        0                       /REPLACED WITH LENGTH OF HOLE
+       JMP OEFAIL              /FAILED - MAYBE WE ASKED TOO MUCH
+       DCA OUCCNT
+       JMS I (OUSETP
+       CDF CIF 10              /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         /YES - CANNOT ENTER THE FILE
+       TAD I OU7600
+       AND (17                 /MAKE THE REQUESTED LENGTH ZERO
+       DCA I OU7600
+       JMP OUENTR              /TRY, TRY AGAIN
+USETTY,        DCA     TTYNO
+       JMS I   (200
+       12
+       5524
+TTYNO, 0
+       0
+       HLT     /NO TELETYPE!
+       TAD     TTYNO
+       DCA I   OU7600
+       JMP     OUASGN
+\fOUTDMP,       0
+       DCA OUCTLW              /STORE THE CONTROL WORD
+       CDF 10
+       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           /YES - SIGNAL OUTPUT ERROR
+       CIF 0
+       JMS I OUHNDL
+OUCTLW,        0
+       OUBUF
+OUREC, 0
+       JMP I   (OUTERR
+       JMP I OUTDMP
+\fOCLOSE,       0
+       CDF 10
+       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
+       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,        TAD I OU7600            /GET THE DEVICE NUMBER
+       JMS I (200
+       4                       /CLOSE THE OUTPUT FILE
+OU7601,        7601                    /POINTER TO THE OUTPUT FILE NAME
+OUCCNT,        0
+       JMP I   (OUTERR
+       CDF CIF 10              /RESTORE CALLING FIELDS
+       JMP I OCLOSE
+       PAGE
+\fOUCTMP=       OUCTL&3700
+OUSETP,        0                       /ROUTINE TO INITIALIZE CHARACTER POINTERS
+       TAD (-OUCTMP            /GET SIZE OF BUFFER IN DOUBLEWORDS
+       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 CDIF0
+       DCA OUCRET
+       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
+       TAD     OUTEMP          /ORDER 4 BITS OF THIRD CHAR
+       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 OUCRET
+       TAD (OUCTL              /LOAD CONTROL WORD FOR A FULL WRITE
+       JMS I (OUTDMP           /DUMP THE BUFFER
+       JMS OUSETP              /RE-INITIALIZE THE POINTERS
+       JMP OUCRET
+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
+OUCRET,        HLT                     /RESTORE CALLING FIELDS
+       JMP I OCHAR
+OUTEMP,        0
+OUPOLD,        0
+OUPTR, 0
+OUJMPE,        JMP OUJMP
+OUDWCT,        0
+\fOTYPE,        0
+       RDF
+       TAD CDIF0
+       DCA OTRTN
+       CDF 10
+       TAD I (7600
+       AND (17
+       TAD (DCB-1
+       DCA OUTEMP
+       TAD I OUTEMP
+OTRTN, HLT
+       JMP I OTYPE
+
+DOBITS,        0
+       DCA     B3
+       JMS I   (XCDF
+       TAD I   LOADXR
+       CDF 10
+       DCA     B1
+BITLP, TAD     B1
+       CLL RTL
+       DCA     B1
+       TAD     B1
+       CMA CML RAL
+       AND     (3
+       TAD     (260
+       JMS I OUT
+       ISZ COLCTR
+       TAD     COLCTR
+       AND     (7
+       SZA CLA
+       JMP BITISZ
+       TAD I   (TTOFLG
+       SNA CLA         /IF OUTPUT IS NOT TO TTY,
+       TAD (240        /PUT A SPACE AFTER EVERY GROUP OF 8
+       SZA 
+       JMS I OUT
+BITISZ,        ISZ     B3
+       JMP     BITLP
+       JMP I   DOBITS
+\fCTCTST,       0
+       TAD     (200
+       KRS
+       TAD (-203
+       SNA CLA                 /IS THE TELETYPE BUFFER A ^C
+       KSF                     /WITH THE TELETYPE FLAG ON?
+       JMP I CTCTST                    /NO
+CDIF0, CDF CIF 0               /YES - GO TO MONITOR
+       JMP I (7605             /THROUGH THE "DON'T SAVE CORE" RETURN
+
+       PAGE
+\fBUILD,        STA
+       DCA     SOMTHN
+       TAD     (-10
+       DCA     FLDNO
+       TAD     MAPSKP
+       DCA     F4SKP   /INITIALIZE ONCE-ONLY SKIP
+FLDLP, TAD     FLDNO
+       AND     (4
+       CLL RTL
+       TAD     (CDF
+       DCA     CDFX    /STORE A CDF 0 OR CDF 20
+       TAD     FLDNO
+       RTR
+       SZL SPA CLA     /IF FLDNO IS 0 OR 4,
+       JMP     NOT04   /INITIALIZE LOADXR TO 0
+F4SKP, SKP
+F4FLAG,        JMP     MAPOVR  /ZEROED IF INFO IN FIELD 2
+       DCA     F4SKP
+       STA
+       DCA     LOADXR
+NOT04, TAD     (-1400
+       JMS I   (ZTST
+       SZA CLA         /FIELD EMPTY?
+       JMP     NONEMP  /NO
+FLDISZ,        ISZ     FLDNO
+       JMP     FLDLP
+MAPOVR,        ISZ     SOMTHN  /WAS THERE ANY INPUT?
+MAPSKP,        SKP
+       JMP I   (NULERR
+       JMS I   (ECRLF
+       JMS I   (ECRLF
+       JMS I   (OCLOSE
+       CDF CIF 0
+       JMP I   (7605
+
+NONEMP,        ISZ     SOMTHN  /HAVE WE OUTPUT ANYTHING YET?
+       JMP     NOTFST
+       JMS I   (OOPEN  /NO - OPEN OUTPUT FILE NOW
+       JMS I   (OTYPE
+       SNA CLA         /SET MODE OF OUTPUT - /T INVERTS
+       TAD     (20     /NORMAL TTY/NO TYY DISTINCTION
+       TAD I   (MPARAM+1
+       AND     (20
+       DCA I   (TTOFLG
+       TAD     (OCHAR
+       DCA     OUT
+NOTFST,        JMS I   (EJECT1 /PAGE HEADING
+       TAD     (-100
+       DCA     PAGECT
+PAGELP,        TAD     FLDNO
+       TAD     (270
+       JMS I   OUT
+       TAD     PAGECT
+       AND     (70
+       CLL RTR
+       RAR
+       TAD     (260    /OUTPUT LOC (HIGH 3 DIGITS) AT LEFT MARGIN
+       JMS I   OUT
+       TAD     PAGECT
+       AND     (7
+       TAD     (260
+       JMS I   OUT
+       TAD     (260
+       JMS I   OUT
+       TAD     (260
+       JMS I   OUT
+       TAD     (240
+       JMS I   OUT
+       DCA     COLCTR
+       TAD     (-14
+       JMS I   (ZTST   /IF ALL 64 WORDS ARE ZERO,
+       SNA CLA
+       JMP NO1ND0      /DON'T PRINT LINE
+       TAD     (-4
+       DCA     SOMTHN
+DOBTLP,        TAD     (-6
+       JMS I   (DOBITS /OUTPUT 4 TRIPLEWORDS FOR 64 LOCATIONS
+       TAD     (-6
+       JMS I   (DOBITS
+       TAD     (-4
+       JMS I   (DOBITS
+       ISZ     SOMTHN
+       JMP     DOBTLP
+NO1ND0,        JMS I   (ECRLF
+       CLA IAC
+       AND     PAGECT
+       SZA CLA
+       JMS I   (ECRLF  /SKIP A LINE EVERY PDP-8 PAGE
+       TAD     PAGECT
+       TAD     (41
+       SNA CLA
+       JMS I   (EJECT1 /NEW PAGE AT LOCATION 4000
+       ISZ     PAGECT
+       JMP     PAGELP
+       JMP     FLDISZ
+PAGECT,        0
+SOMTHN,        0
+
+XCDF,  0
+CDFX,  HLT
+       JMP I   XCDF
+       PAGE
+\fEJECT1,       0
+       TAD     FLDNO
+       TAD     (4070
+       DCA     FLDNUM
+       TAD     TTOFLG
+       SZA CLA         /TELETYPE STYLE OUTPUT?
+       JMP     EJKTTY  /YES
+       TAD     (214    /NO - FORM FEED
+       JMS I   OUT
+PRTFLD,        JMS I   (ERR
+       TEXT    / BITMAP  V/
+       *.-1
+VERLOC,        60+VERSION^100+SUBVER   /V5A, ETC...
+       TEXT    /   FIELD/
+       *.-1
+FLDNUM,        TEXT    / 0/
+       JMS     ECRLF
+       TAD     TTOFLG
+       SNA CLA         /IF NOT TTY OUTPUT,
+       JMP EJKLPT      /DON'T PRINT HORIZONTAL GUIDE
+
+       JMS I   (ERR
+       TEXT    /      0000000011111111222222223333333344444444555555556666666677777777/
+       JMS I   (ERR
+       TEXT    /      0123456701234567012345670123456701234567012345670123456701234567/
+EJKLPT,        JMS     ECRLF
+       JMP I   EJECT1
+\fEJKTTY,       TAD     (-13
+       DCA     EJKTMP
+       JMS     ECRLF
+       ISZ     EJKTMP
+       JMP     ECRLFX
+       JMS I   (ERR
+       TEXT    /----/
+       JMS     ECRLF
+       JMP     PRTFLD
+EJKTMP,        0
+
+ECRLF, 0
+       TAD     (215
+       JMS I   OUT
+ECRLFX,        TAD     (212
+       JMS I   OUT
+       JMP I   ECRLF
+
+TTOFLG,        0               /20 IF TTY-STYLE OUTPUT
+       PAGE
+\f      BUFFER=.
+       $-$-$
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/C3BOOT.PA b/sw/os8/v3d/sources/system/dectapes/dectape3/C3BOOT.PA
new file mode 100644 (file)
index 0000000..9b74295
--- /dev/null
@@ -0,0 +1,495 @@
+/2 OS/8 TERTIARY CASSETTE BOOTSTRAP V5
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f      VERSON= 5
+       SUBVER= 01      /SUBVERSION A = 01, ETC
+
+       BINARY=6200
+
+       FIELD 1
+
+       *5200
+
+       CIF CDF 0       /THE SECONDARY BOOTSTRAP BRANCHES HERE OF ALL PLACES
+       JMP I .+1
+       C3STRT          /WE WANT TO BE HERE
+
+
+
+/EXPLANATION:
+
+/THE PRIMARY (KEY-IN) BOOTSTRAP CONSISTS OF 32 WORDS
+/AND IS AWFUL PRIMITIVE.  IT BARELY MANAGES TO READ IN THE
+/SECONDARY BOOTSTRAP.
+/THE SECONDARY BOOTSTRAP CONTAINS A FULL-FLEDGED BINARY LOADER
+/AND IS USED TO READ IN THE NEXT FILE INTO CORE
+/(BUT NOT OVER ITSELF (LOCS 3600-4040)) AND DOES LITTLE IF ANY
+/I/O ERROR CHECKING.  THIS NEXT FILE IS IN FACT THE TERTIARY BOOTSTRAP.
+/THE SECONDARY BOOTSTRAP STARTS UP THE TERTIARY BOOTSTRAP AT
+/LOCATION 15200 WHICH THEN CONTAINS ANOTHER FULL-FLEDGED BINARY LOADER
+/AND IN ADDITION A COMPLETE TWO-PAGE CASSETTE HANDLER.
+/THIS TERTIARY BOOTSTRAP RESIDES IN BUFFER SPACE OF BUILD AND
+/READS IN BUILD WITH FULL I/O ERROR CHECKING.
+/WHEN IT IS THROUGH, IT BRANCHES TO BUILD AT LOCATION 02000.
+
+/RECORD SIZES:
+
+/C2BOOT                MUST BE 200 BYTES/RECORD
+/C3BOOT                MUST BE 200 BYTES/RECORD
+/BUILD         MUST BE 300 BYTES/RECORD
+/OS8           MUST BE 300 BYTES/RECORD
+/CD            MUST BE 300 BYTES/RECORD
+/MCPIP         MUST BE 300 BYTES/RECORD
+/OTHER CUSPS   CAN BE ANY RECORD SIZE.
+
+/C2BOOT AND C3BOOT MUST BE 200 BYTES/RECORD BECAUSE THAT'S WHAT THE PRIMARY BOOT READS.
+/THE ONES WHICH MUST BE 300 BYTES/RECORD ARE SUCH BECAUSE
+/THEY ARE USING THE OS/8 CASSETTE HANDLER TO READ IN.
+/OTHERS ARE READ IN BY MCPIP AND CAN BE ANY RECORD SIZE.
+\f      FIELD 0
+
+       *5400
+
+C3STRT,        CLA
+       JMS I (CSA0
+       3               /SKIP FILE
+L7400, 7400
+L200,  200
+M200,  -200
+       JMS I (CSA0
+       100             /SKIP HEADER BY READING PAST IT
+
+       BINARY
+M301,  -301
+       SKP CLA         /ERROR IS OK
+       HLT             /GOOD READ IS BAD
+LDABS2,        DCA CKSUM
+       JMS GCHAR
+       SNA
+       JMP .-2         /IGNORE BLANKS
+       TAD M200
+       SZA CLA         /IS IT LEADER?
+       HLT             /NOT BINARY
+LEADER,        JMS GCHAR
+       TAD M200        /STILL LEADER?
+       SNA
+       JMP LEADER      /YES
+NEWWD, SMA             /IS IT LESS THAN 200?
+       JMP FIELDW      /NO, IT'S A FIELD SETTING
+       TAD L200        /RESTORE CHAR
+       DCA WD1
+       JMS GCHAR
+       DCA WD2
+       JMS GCHAR
+       TAD M200
+       SNA
+       JMP OVER        /200 FINISHES US UP
+       DCA WD          /SAVE NEXT WORD FOR LATER
+       JMS ASSEMB      /ASSEMBLE PREVIOUS WORD
+       SZL             /IS IT AN ORIGIN?
+       JMP ORG         /YES
+XFIELD,        CDF 0           /ASSUMES BUILD STARTS IN FIELD 0
+       DCA I ORIGIN
+CDF0,  CDF 0
+       TAD ORIGIN
+       IAC
+ORG,   DCA ORIGIN
+NEXT,  TAD WD1
+       TAD WD2         /MAKE UP CHECKSUM
+       TAD CKSUM
+       DCA CKSUM
+       TAD WD
+       JMP NEWWD
+L70,   70
+\fFIELDW,       AND L70         /EXTRACT FIELD SETTING
+       TAD CDF0
+       DCA XFIELD
+       JMS GCHAR
+       TAD M200
+       SZA
+       JMP NEWWD
+OVER,  JMS ASSEMB
+       CIA
+       TAD CKSUM
+       SZA CLA
+       HLT             /BAD CHECKSUM
+       JMP I L200      /START BUILD
+
+ASSEMB,        0
+       TAD WD1
+       CLL RTL
+       RTL
+       RTL
+       TAD WD2
+       JMP I ASSEMB
+
+ORIGIN,        0
+WD1,   0
+WD2,   0
+WD,    0
+CKSUM, 0
+\fCHCNT,        -1
+CHPTR, BINBUF
+
+GCHAR, 0
+       ISZ JMPGET      /POINT TO CORRECT ROUTINE
+       ISZ CHCNT       /NEED WE READ?
+JMPX,  JMP JMPGET      /NOT YET
+       JMS I (CSA0     /CALL HANDLER
+       100             /READ ONE PAGE
+BINBUF,        BINARY
+L377,  377             /DUMMY BLOCK NO.
+       HLT             /I/O ERROR
+       TAD M301
+       DCA CHCNT       /NEW CHAR COUNT
+       TAD BINBUF
+       DCA CHPTR
+       TAD JMPX
+       DCA JMPGET
+       JMP GCHAR+1
+JMPGET,        JMP .
+       JMP CHAR1
+       JMP CHAR2
+TAD JMPX
+       DCA JMPGET
+       TAD I CHPTR
+       AND L7400
+       CLL RTR
+       RTR
+       TAD CHTMP
+       RTR
+       RTR
+       ISZ CHPTR
+       JMP GCHCOM
+
+CHTMP, 0
+
+CHAR2, TAD I CHPTR
+       AND L7400
+       DCA CHTMP
+       ISZ CHPTR
+CHAR1, TAD I CHPTR
+GCHCOM,        AND L377
+       JMP I GCHAR
+       PAGE
+\f      CODE=0
+
+       KCLR=CODE^10+6700       /CLEAR ALL
+       KSDR=CODE^10+6701       /SKIP ON DATA FLAG
+       KSEN=CODE^10+6702       /SKIP ON ERROR
+       KSBF=CODE^10+6703       /SKIP ON READY FLAG
+       KLSA=CODE^10+6704       /LOAD STATUS A
+       KSAF=CODE^10+6705       /SKIP ON ANY FLAG OR ERROR
+       KGOA=CODE^10+6706       /ASSERT CONTENTS OF STATUS A AND XFER
+       KRSB=CODE^10+6707       /READ STATUS B
+
+       BSW=7002        /BYTE SWAP      [8/E,F ONLY]
+
+/REWIND=10
+/BACKFIL=30
+/WRGAP=40
+/BACKBLOCK=50
+/SKPFIL=70
+
+/SPECIAL CODES
+
+/      0       WRITE EOF
+/      1       REWIND
+/      3       SKIPFILE/BACKFILE
+/      2       BACKBLOCK
+
+/      4-7     UNUSED (TAKES LOW ORDER 2 BITS ONLY CURRENTLY)
+
+       VERSION="B&77   /MODIFIED
+\fK3700,        3700            /MUST BE FIRST LOCATION ON PAGE
+UNIT,
+CSA1,  VERSION         /ENTRY POINT FOR CSA1
+       CLA             /PROTECT CODE AGAINST IGNORANT USERS
+       TAD CSA1        /PICK UP ARGUMENTS
+       DCA CSA0        /VIA CSA0
+       STL IAC RAL     /TAD (3         [8/I,L,E,F]
+       JMP .+3         /JOIN PROCESSING WITH UNIT 1
+CSA0,  VERSION         /ENTRY POINT FOR CSA0
+       STL CLA RTL     /TAD (2
+       BSW             /               [8/E,F]
+       DCA UNIT        /SAVE UNIT (0 IS 200, 1 IS 300)
+CS,    JMS T           /INITIALIZATION; REPLACED BY RDF
+       TAD KCIF        /FORM RETURN FIELD INSTRUCTION
+       DCA RETCIF      /STORE IN RETURN CODE
+       TAD I CSA0      /GET FUNCTION CONTROL WORD
+       DCA FUN         /SAVE IT
+       TAD FUN         /GET IT BACK AGAIN
+       AND K70         /ISOLATE FIELD OF BUFFER
+       TAD KCDF        /FORM CDF TO FIELD OF BUFFER
+       DCA BUFCDF      /STORE IN APPROPRIATE SPOT
+       ISZ CSA0        /POINT TO ARGUMENT 2
+       TAD I CSA0      /GET BUFFER ADDRESS
+       DCA BUFFER      /SAVE IT
+       ISZ CSA0        /POINT TO ARGUMENT 3
+       TAD I CSA0      /GET BLOCK NUMBER
+       ISZ CSA0        /POINT TO ERROR RETURN
+KCIF,  CIF CDF 0       /SEEK TEMPORARY SAFETY IN CURRENT DATA FIELD
+       SZA CLA
+       JMP NOT1ST      /NOT BLOCK 0
+       STL CLA RAR     /TAD (4000
+       AND FUN         /ISOLATE READ/WRITE BIT
+       TAD UNIT        /INSERT UNIT
+       JMS I QCAS      /CALL CASSETTE ROUTINE
+       REWIND-.        /TO PERFORM A REWIND/INITIALIZATION
+NOT1ST,        TAD FUN
+K200,  AND K3700       /ISOLATE NUMBER OF BLOCKS TO XFER
+       SNA
+       JMP SPCASE      /0 BLOCKS MEANS SPECIAL THING (EOF)
+RECLP, DCA BLKNT       /SET COUNT OF NUMBER OF BLOCKS
+       STL CLA RAR     /TAD (4000
+       AND FUN         /ISOLATE READ/WRITE BIT
+       TAD UNIT        /INSERT UNIT
+       JMS I QCAS      /CALL CASSETTE ROUTINE
+       RW-.            /TO INITIATE READ OR WRITE
+RETRY, SZA             /NON-ZERO AC MEANS ERROR
+       JMP RETCIF      /TOUGH LUCK BOOBIE - ERROR
+       TAD K7700       /GET READY TO XFER 100 DOUBLE WORDS
+       DCA DBWDCT      /SET DOUBLE WORD COUNTER
+       TAD BUFFER      /GET START OF BUFFER SEGMENT
+       DCA BPTR        /SET 'BPTR'
+BUFCDF,        HLT             /CHANGE TO DATA FIELD OF USER'S BUFFER
+       TAD FUN
+K7700, SMA CLA         /WHICH DIRECTION IS TRANSFER?
+       JMP READ        /WANT TO READ
+\fWRITE,        TAD I BPTR      /WANT TO WRITE, SO GET WORD FROM BUFFER
+       JMS I QGPCH     /WRITE
+       TAD I BPTR      /GET FIRST WORD AGAIN
+       AND P7400       /ISOLATE FIRST HALF OF BYTE 3
+       DCA T           /SAVE FOR FUTURE REFERENCE
+       ISZ BPTR        /POINT TO NEXT LOCATION IN BUFFER
+       TAD I BPTR      /GET SECOND WORD OF BUFFER PAIR
+       JMS I QGPCH     /WRITE BYTE #2
+       TAD I BPTR      /RETRIEVE WORD 2
+       AND P7400       /ISOLATE 2ND HALF OF BYTE #3
+       CLL RTR         /CREATE MYSTIC HIDDEN BYTE 3
+       RTR
+       TAD T           /GOOD THING I STILL HAVE THIS
+       CLL RTR
+       RTR
+       JMS I QGPCH     /WRITE BYTE #3
+       JMP COM
+\fREAD, JMS I QGPCH     /READ BYTE #1 OF TRIPLE
+       DCA I BPTR      /STORE IN WORD 1 OF BUFFER PAIR
+       JMS I QGPCH     /READ BYTE #2 OF TRIPLE
+       DCA T           /SAVE IT FOR POSTERITY
+       JMS I QGPCH     /READ BYTE #3 OF TRIPLE
+       RTL
+       RTL             /MYSTIC ROTATES
+       DCA T2
+       TAD T2
+       AND P7400       /AND MYSTIC CONSTANTS
+       TAD I BPTR      /FIX UP BUFFER WORD 1 OF PAIR
+       DCA I BPTR
+       TAD T2
+       RTL
+       RTL             /MORE ROTATION
+       AND P7400       /AND MORE
+       TAD T
+       ISZ BPTR        /POINT TO SECOND WORD OF BUFFER PAIR
+       DCA I BPTR      /STORE SECOND WORD
+COM,   ISZ BPTR        /POINT TO BEGIN OF NEXT BUFFER PAIR
+P7400, 7400            /PROTECTION AGAINST CORE WRAP AROUND
+       ISZ DBWDCT      /BUMP DOUBLE WORD COUNT
+       JMP BUFCDF      /REITERATE
+       JMS I QCAS      /CALL CASSETTE ROUTINE
+       CRC-.           /TO CHECK CRC
+       TAD BUFFER      /GET BUFFER SEGMENT ADDRESS
+       TAD K200        /ADD 200 TO GET TO NEXT SEGMENT
+       DCA BUFFER      /REPLACE
+       TAD BLKNT       /GET BLOCK COUNT
+       TAD K7700       /SUBTRAT 100
+       SZA             /ARE WE DONE?
+       JMP RECLP       /NO, REITERATE
+       ISZ CSA0        /POINT TO NORMAL GOOD RETURN
+RETCIF,        HLT             /RETURN TO USER'S DATA AND INSTRUCTION FIELDS
+       JMP I CSA0      /RETURN
+\f/     INTIALIZATION ROUTINE - ONCE ONLY CODE
+/              OVERLAID BY TEMPORARIES
+
+T,     0               /ENTRY POINT TO INITIALIZATION
+T2,    TAD KRDF        /REPLACE CALL BY RDF
+FUN,   DCA CS          /SO THAT WE'LL NEVER SEE YOU HERE AGAIN
+BUFFER,        TAD T           /CORRECT ADDRESS OF GPCH
+DBWDCT,        TAD KQX1        /BY ADDING IN CS+1
+QGPCH, DCA .   /STORE IT HERE
+BLKNT, STL CLA RTL     /CORRECT ADDRESS OF CAS IS 2 MORE
+       TAD QGPCH
+QCAS,  DCA .           /THAN GPCH.  STORE IT HERE.
+BPTR,  JMP CS          /RETURN TO MAIN PROGRAM
+KRDF,  RDF
+KQX1,  GPCH-CS-1
+
+SPCASE,        TAD FUN
+       AND L4003       /ISOLATE R/W BIT + SPECIAL CODE
+       TAD UNIT
+       JMS I QCAS
+       SPCODE-.
+       JMP RETCIF-1    /LEAVE GRACEFULLY
+K70,   70
+KCDF,  CDF 0
+L4003, 4003
+       PAGE
+\fGPCH, 0               /READ OR WRITE A BYTE
+       JMP AROUND      /GO TO REAL LOCATION OF THIS SUBROUTINE
+CAS,   0               /MUST BE AT GPCH+2; DO CASSETTE STUFF
+       DCA TEMP        /SAVE ARGUMENT IN AC
+       CDF 0
+       TAD I CAS       /GET UNRELOCATED RELATIVE LOCAL ENTRY POINT
+       TAD CAS         /RELOCATE IT
+       ISZ CAS         /POINT TO NORMAL RETURN LOCATION
+       DCA GPCH        /SAVE ENTRY POINT IN TEMPORARY
+       JMP I GPCH      /GO TO CORRECT ENTRY POINT
+
+RW,    TAD CAS
+       DCA RTRY        /SAVE RETRY ADDRESS
+       TAD TEMP        /GET ARGUMENT PASSED VIA AC
+       DCA FNUNIT      /SAVE
+       CLL STA RTL     /TAD (7775
+       DCA ERKNT       /SET ERROR COUNT TO -3
+ERETRY,        TAD FNUNIT
+       SPA
+       TAD (20         /READ CODE IS 0; WRITE IS 20
+       KLSA            /LOAD STATUS A
+       TAD FNUNIT      /***KLSA CLEARS BIT 0
+       SMA CLA         /READS HAVE TO BE INITIATED
+       JMS CWAIT       /READ
+       JMP I RTRY      /RETURN
+
+AROUND,        DCA TEMP
+       TAD FNUNIT
+       SMA CLA
+       JMP RDCHAR      /READ
+       TAD TEMP        /WRITE
+       JMS CWAIT
+       JMP I GPCH      /RETURN
+
+RDCHAR,        JMS CWAIT
+       TAD TEMP        /GET CHAR JUST READ
+       JMP I GPCH      /RETURN WITH IT IN AC
+\fCRC,  TAD FNUNIT
+       TAD (60
+       KLSA            /INITIATE READ/WRITE CRC
+       TAD FNUNIT      /***KLSA CLEARS BIT 0
+       SMA CLA
+       JMS CWAIT       /HAVE TO READ TWICE
+       JMS CWAIT       /WRITE CRC WRITES BOTH
+       KCLR            /WHY NOT?
+       JMP I CAS       /RETURN
+
+REWIND,        TAD (10
+       JMS UTIL
+       TAD TEMP
+       SMA CLA
+       JMP I CAS       /MERELY REWIND IF READING
+       JMP EOF
+SKIPF, TAD (20
+BACKBL,        TAD (10
+EOF,   TAD (10
+BACKF, TAD (30
+       JMS UTIL
+       JMP I CAS       /RETURN
+
+UTIL,  0
+       TAD TEMP
+       KLSA
+TRYAGN,        KGOA
+       KSBF            /WAIT FOR READY
+       JMP .-1
+       KRSB
+       AND (10
+       SZA CLA
+       JMP TRYAGN      /KEEP TRYING IF ERROR CAUSED BY DRIVE EMPTY
+       JMP I UTIL
+
+TEMP,  0
+ERKNT, 0
+FNUNIT,        0
+RTRY,  0
+
+SPCODE,        TAD TEMP
+       AND (3
+       TAD (JMP TABLE
+       DCA J
+       TAD TEMP
+       AND (4300
+       DCA TEMP
+J,     HLT
+TABLE, JMP EOF         /0 WRITE EOF
+       JMP REWIND      /1 REWIND AND WRITE EOF IF BIT 0=1
+       JMP BACKBL      /2 BACK BLOCK
+       TAD TEMP        /3 SKIP/BACK FILE DEPENDING ON BIT 0
+       SMA CLA
+       JMP SKIPF       /FORWARD FILE
+       JMP BACKF       /BACK FILE
+\fCWAIT,        0
+       KGOA            /ASSERT CONTENTS OF STATUS A
+       DCA TEMP        /SAVE ANYTHING READ
+       KSAF
+       JMP .-1         /WAIT FOR SOMETHING TO HAPPEN
+       KSEN            /WAS IT AN ERROR?
+       JMP I CWAIT     /NO, SO RETURN
+ERR,   DCA TEMP        /YES ... ERROR
+       KRSB
+       AND (30
+       SNA
+       JMP .+3
+       AND (20
+       JMP I RTRY      /END OF FILE IS SOFT ERROR
+       ISZ ERKNT       /SHALL WE TRY AGAIN?
+       JMP .+3         /YES
+       STL CLA RAR     /TAD (4000
+       JMP I RTRY      /RETURN WITH NON-ZERO AC
+       TAD FNUNIT      /RETRY
+       TAD (50         /BUT FIRST DO BACKSPACE BLOCK GAP
+       JMS UTIL
+       JMP ERETRY
+
+L7600, 7600
+       $
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/CD.PA b/sw/os8/v3d/sources/system/dectapes/dectape3/CD.PA
new file mode 100644 (file)
index 0000000..dd33663
--- /dev/null
@@ -0,0 +1,1610 @@
+/8    COMMAND DECODER FOR OS/8 MONITOR
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/APRIL 1977           RL/EF/HJ/SR
+
+/ABSTRACT--
+/COMMAND DECODER (CD) ACCEPTS TTY INPUT AND INTERPRETS
+/THAT INPUT AS A LIST OF OPTIONS AND FILE SPECIFICATIONS
+/FOR OS/8 CUSPS. TABLES ARE SETUP INDICATING THE SPECIFIED
+/FILES AND OPTIONS.
+/THIS VERSION OF CD IS CAPABLE OF RUNNING OS/8 BATCH.
+/MODIFICATIONS TO INITIALIZATION CODE HAVE BEEN MADE TO
+/ALLOW THIS.
+
+
+       DCB=7760
+       SHNDLR=7607
+       USERFG=40       /LOCATION IN MAIN OS/8 ASSEMBLY - VOLATILE
+       T1=41   /DITTO
+       MCDREC=51       /ALSO PRETTY VOLATILE
+       MOFILE=7600
+       MIFILE=7617
+       MPARAM=7643
+       FIELD 0 /JUSTINCASE
+
+       CDVERSION=6501  /5A
+       ODTVERSION=6401 /4A
+\f/V3 CHANGES TO CD:
+
+/1. FIXED LOTS OF BUGS
+/      A:B:C IS ILLEGAL
+/      15-BIT = OPTION DOESN'T DESTROY ALTMODE BIT
+/2.    ADDED ? SUPPORT IN SPECIAL MODE
+/3.    ALLOWED SPECIAL MODE UNDER BATCH
+/4.    REMOVED DCC CODE
+/5.    ^U, RO TO BOL, AND LF ALL REPRINT *
+/6.    VERSION # AT LOC ZERO
+/7.    DON'T LOAD HANDLERS FOR OUTPUT DEVICE
+/8.    CHANGED _ TO < STANDARD
+
+/V3 CHANGES TO ODT
+
+/1.    REMOVED DCC CODE
+/2.    FIXED CORE SIZE ROUTINE
+/3.    ALLOWED SOFTWARE CORE SIZE
+/4.    MODIFIED 'GO' COMMAND SO THAT IT DOESN'T RESTORE TRAP
+/      LOCATION TO UNMODIFIED VALUE
+/5.    FIXED BUG RE: JMS'S OUT OF FIELD WITH MAGIC LOCATION SET
+/6.    TURN OFF INTERRUPTS ON BREAKPOINT
+
+/CHANGES AFTER FIELD TEST RELEASE:
+
+/1.    FIXED BUG RE FILE LENGTHS GT 2047 BLOCKS
+
+/MAINTENANCE RELEASE:
+
+/      NO CHANGES
+
+/V3D CHANGES:
+
+/CHANGED FORMAT OF VERSION NUMBERS
+\f      *200
+CD,    JMP I NUMBER    /EXECUTED IN SYSGEN
+NUM,   JMP I T
+ANALYZ,        TAD [BEGLN-1
+       DCA XR
+       TAD I XR
+       SNA
+       JMP NOBKAR
+       TAD [-"<
+       SZA CLA
+       JMP .-5
+       CLA CMA
+NOBKAR,        DCA OUTSW
+       TAD [BEGLN-1
+       DCA LXR
+BEGGRP,        TAD OUTSW
+       SNA CLA
+       TAD BEGDIF              /DIFF BETWEEN INPUT & OUTPUT AREAS
+       TAD [MOFILE-1
+       DCA CLXR
+       STA
+       DCA DVFLAG
+       DCA DEV1
+FILLP1,        DCA DEV2
+FILLP, JMS I [GNAME
+       TAD ["A-":      /AC CONTAINED DELIM - "A
+       SNA CLA
+       JMP DEVNAM
+       JMS I [ASSIGN
+       TAD OUTSW
+       SNA CLA
+       TAD LIMDIF              /DIFF BETWWEN END OF OUTPUT & INPUT AREAS
+       TAD OUTLIM              /END OF OUTPUT AREA
+       TAD CLXR
+       SMA CLA
+       JMP CDER1
+       TAD OUTSW
+       SNA CLA
+LKUPSW,        JMP INFILE              /ZEROED IF IN "SPECIAL DECODE" MODE
+       CDF 10
+       TAD DVICE
+       DCA I CLXR
+       TAD NAME1
+       DCA I CLXR
+       TAD NAME2
+       DCA I CLXR
+       TAD NAME3
+       DCA I CLXR
+       TAD NAME4
+CDSKP, SKP
+INFILE,        JMS I [LOOKUP
+       DCA I CLXR
+DLOOK, CDF 0
+       STA
+       DCA DVFLAG
+       TAD DELIM
+       SNA
+       JMP CDOVER
+       TAD [-"[
+       SNA
+       JMP I [OLENGT
+       TAD ["[-",
+       SNA
+       JMP FILLP
+       TAD [",-"<
+       SNA
+       JMP BKAROW
+       TAD ["<-"=
+       SZA CLA
+       JMP I [CDER2
+EQUAL, DCA NUMFUJ
+       JMS NUMBER
+       DCA I [MPARAM+3
+       CLA CLL CML RAR
+       AND I [MPARAM-1 /PRESERVE  ALTMODE
+       TAD HIORD
+       DCA I [MPARAM-1
+       JMP DLOOK
+\fBKAROW,       ISZ OUTSW
+       JMP I [CDER2
+       JMP BEGGRP
+DEVNAM,        TAD NAME1
+       DCA DEV1
+       ISZ DVFLAG
+       JMP I [CDER2    /CATCHES A:B:
+       TAD NAME2
+       JMP FILLP1
+CDOVER,        TSF
+       JMP .-1 /LET PRINTER QUIET DOWN
+       TCF     /AND CLEAR FLAG
+       CDF CIF 10
+       TAD TMONIT
+       DCA I [200      /RESTORE "MONITO"
+       TAD TUSRFG
+       DCA I [USERFG   /RESTORE "USER FLAG"
+       TAD TFPUTX      /LOAD "USER CALLING FIELD" INTO AC
+       JMP I CD        /RETURN - MONITOR RESTORES CORE IF NECESSARY
+NUMBER,        4000    /USED BY SYSGEN
+       TAD CDSKP
+       DCA NUMADD      /SET NUMADD TO EITHER "SKP" OR "TAD NUM"
+       DCA HIORD
+NUMLP, DCA NUM
+       JMS NUMTST      /INTO PAGE 0 FOR RANGE TEST
+       SNL
+       JMP EONUM
+       DCA T
+       CLA CLL CMA RTL
+       DCA DELIM
+       TAD NUM
+ROTLP, CLL RAL
+       DCA NUMX
+       TAD HIORD
+       RAL
+       SPA
+       JMP I [CDER2
+       DCA HIORD
+       TAD NUMX
+       ISZ DELIM
+       JMP ROTLP
+NUMADD,        TAD NUM         /SKP IF OCTAL
+       TAD NUM
+       TAD T
+       JMP NUMLP
+EONUM, TAD ["0
+       DCA DELIM
+       TAD NUM
+       CDF 10
+       JMP I NUMBER
+\fCDER1,        JMS I [PRMESG
+       TEXT    /TOO MANY FILES/
+\f      IFZERO .&400 <*400>
+ASSIGN,        0
+       TAD CLXR
+       AND DVFLAG
+       TAD OUTLIM
+       SMA SZA CLA     /CHECK FOR OUTPUT OR FIRST INPUT
+       JMP ASNORM      /IF DEVICE WAS SPECIFIC, OR IF WE ARE ON THE INPUT SIDE,
+                       /PROCEED NORMALLY
+       TAD NAME1
+       SNA CLA
+       JMP ASGNST
+       TAD DFLTNM+1
+       DCA DEV2
+       TAD DFLTNM
+       DCA DEV1
+ASNORM,        TAD DEV1
+       DCA AS+1
+       TAD DEV2
+       DCA AS+2
+       TAD OUTSW
+       SNA CLA         /DON'T LOAD HANDLER IF WE ARE ON OUTPUT SIDE OF "_"
+       TAD NAME1
+SPKLG1,        SNA CLA         /OR IF THERE IS NO FILE NAME TO LOOK UP
+       TAD GETHND      /GETHND=11 NORMALLY, 0 IF IN "SPECIAL DECODE" MODE
+       IAC
+       DCA AS
+       TAD [1401       /ALLOW TWO PAGE HANDLERS
+       DCA ASADR
+       CIF 10
+       JMS I [200
+AS,    0
+       0
+       0
+ASADR, 1401
+       JMP I [CDER0
+       TAD AS+2
+ASGNST,        DCA DVICE
+       JMP I ASSIGN
+GNAME, 0
+       DCA NAME1
+       DCA NAME2
+       DCA NAME3
+       DCA NAME4
+       TAD [NAME1
+       DCA NMBASE
+       CLA CMA
+       DCA PERDSW
+       DCA NAMECT
+GTNMLP,        JMS I [GCH
+       DCA DELIM
+       TAD DELIM
+       TAD [-"?
+       SZA
+       TAD ["?-"*
+       SNA
+STARSW,        JMP I [CDER2    /"JMP STARNM" IF "SPECIAL DECODE" MODE
+       TAD ["*-".
+       SNA CLA
+       JMP PERIOD
+       JMS I [DECODE
+       JMP I GNAME
+\fSTARNM,       CLA             /THIS CODE HANDLES *'S AND ?'S CORRECTLY
+       TAD DELIM
+       AND [77
+       DCA DELIM
+       TAD NAMECT
+       TAD [-6
+       SMA CLA
+       JMP GTNMLP
+       TAD NAMECT
+       CLL RAR
+       TAD NMBASE
+       DCA TT
+       TAD DELIM
+       SZL
+       JMP .+4
+       RTL
+       RTL
+       RTL
+       TAD I TT
+       DCA I TT
+       ISZ NAMECT
+       JMP GTNMLP
+PERIOD,        TAD NAME1
+       SZA CLA
+       ISZ PERDSW
+       JMP I [CDER2
+       ISZ NMBASE
+       TAD [4
+       JMP GTNMLP-1
+LOOKUP,        0
+       DCA LNAME
+       TAD NAME1
+       SNA CLA
+       JMP LKUPST
+       JMP EXT1
+LKUPLP,        DCA LNAME
+       TAD AS+2
+       CIF 10
+       JMS I [200
+       2
+LNAME, 0       /NAME1
+LENGTH,        0
+       JMP LFAILD
+       TAD LENGTH
+       CLL
+       TAD [400
+       SNL
+       CLA
+       CLL RTL
+       RTL
+       AND [7760
+LKUPST,        CDF 10
+       TAD DVICE
+       DCA I CLXR
+       TAD LNAME
+       JMP I LOOKUP
+\fLFAILD,       TAD NAMECT
+       SNA CLA         /WAS THERE AN EXPLICIT EXTENSION?
+       TAD DEFALT      /NO - WAS THERE A DEFAULT EXTENSION?
+       SNA CLA
+       JMP I [CDER3    /YES OR NO - FILE NOT FOUND
+       ISZ NAMECT      /NO AND YES - SET FLAG TO FAIL NEXT TIME
+       JMP EXT2        /ZERO OUT THE EXTENSION AND TRY AGAIN
+CDER3, JMS I [PRNAME
+       JMS I [PRMESG
+       TEXT    / NOT FOUND/
+\f      IFZERO .+200&1000 <*600>
+       0               /V3 [FREE LOC]
+SLSHCH,        0
+/V3    SNA
+/V3    JMP I [CDER2
+       DCA DELIM
+       TAD [MPARAM-1
+       DCA T
+       JMS I [DECODE
+       JMP I [CDER2
+       SZL
+       TAD [32
+       CMA STL /THE FOLLOWING TURNS ON THE CORRECT OPTION BIT
+       DCA TT
+SLSHLP,        SZL
+       ISZ T
+       RAR
+       SNL
+       ISZ TT
+       JMP SLSHLP
+       DCA TT
+       CDF 10
+       TAD TT
+       CMA
+       AND I T
+       TAD TT
+       DCA I T
+       CDF 0
+       JMP I SLSHCH
+DECODE,        0
+       TAD DELIM
+       TAD [-"9-1
+       CLL
+       TAD ["9+1-"0
+       SZL
+       JMP DCDYES
+       TAD ["0-"Z-1
+       CLL CML
+       TAD ["Z-"A+1
+       SNL
+DCDYES,        ISZ DECODE
+       JMP I DECODE
+CDER0, TAD DEV1
+       JMS I [PRWD
+       TAD DEV2
+       JMS I [PRWD
+       JMS I [PRMESG
+       TEXT    / DOES NOT EXIST/
+\f
+RESTRT,        JMS I [CRLF
+       CDF 10
+       TAD [MOFILE-1
+       DCA XR
+       TAD [-47
+       DCA T
+       DCA I XR        /ZERO OUT THE COMMAND DECODER OUTPUT AREA
+       ISZ T
+       JMP .-2
+       CDF 0
+       JMP I [GLINE
+GCH,   0
+       TAD I LXR
+       TAD [-240
+       SNA
+       JMP GCH+1
+       TAD [240-"/
+       SNA
+       JMP SLASH
+       TAD ["/-"(
+       SNA
+       JMP OPENP
+       TAD ["(
+       JMP I GCH
+SLASH, TAD I LXR
+       JMS I [SLSHCH
+       JMP GCH+1
+OPENP, TAD I LXR
+       TAD [-")
+       SNA
+       JMP GCH+1
+       TAD [")
+       JMS I [SLSHCH
+       JMP OPENP
+OLENGT,        TAD OUTSW
+       AND NAME1       /[N] IS ONLY LEGAL ON THE OUTPUT SIDE OF THE "_"
+       SNA CLA         /AND ONLY AFTER A FILE NAME
+       JMP I [CDER2
+       TAD [-4
+       TAD CLXR
+       DCA NMBASE
+       CLA CLL CML RTL
+       DCA NUMFUJ      /SET "NUMBER" TO ACCEPT DIGITS 8 AND 9
+       TAD OLFUDJ      /LOAD FUDGE SO THAT "NUMBER" WILL BE DECIMAL
+       JMS I [NUMBER
+       CLL RTL
+       RTL
+       AND [7760
+       TAD I NMBASE
+       DCA I NMBASE
+       CDF 0
+       TAD DELIM
+       TAD [-"]        /IS THERE A CLOSING BRACKET?
+       SNA             /IF NOT, "DLOOK" ROUTINE WILL DETECT IT
+       JMS I [GCH
+       DCA DELIM
+       JMP I [DLOOK
+OLFUDJ,        NUM&177+1570
+
+CDER2, CLA
+       JMS I [PRMESG
+       TEXT    /ILLEGAL SYNTAX/
+\f      IFZERO .&1000 <*1000>
+       /TELETYPE INPUT ROUTINE FOR COMMAND DECODER
+GLINE, TAD (252        /SETS 1177=252 FOR * IN MESSAGE
+       JMS I PRINT
+       DCA RBFLAG
+       TAD [BEGLN-1
+       DCA LXR
+CHLOOP,        6031            /KSF
+       JMP CHLOOP
+       TAD [200
+       6034            /KRS
+       DCA NAME1
+       6032            /KCC
+       TAD [SPADR-1
+       DCA XR
+DSPCHL,        TAD I XR
+       SZA
+       TAD NAME1
+       SNA CLA
+       JMP I XR
+       JMP DSPCHL
+SPADR, -225;JMP CTRLU
+       -215;JMP CARRET
+       -377;JMP RUBOUT
+       -375;JMP ALTMOD /V3D MODIFIED BY SET
+       -376;JMP ALTMOD /V3D MODIFIED BY SET
+       -233;JMP ALTMOD
+       -200;JMP CHLOOP
+       -217;JMP CHLOOP /^O
+        -"_;JMP LESSTN
+       -212;JMP LFEED
+       -203;JMP CTRLC  /MUST BE LAST - SEE CLRLIN CODE
+       0
+       JMS PRNT
+CINSRT,        TAD NAME1
+       DCA I LXR
+       TAD LXR
+       TAD [-EOBUFR+2
+       SPA CLA
+       JMP CHLOOP
+       JMS CRLF
+       JMP I [CDER2
+\fCARRET,       JMS CRLF
+CLFINI,        DCA I LXR
+       JMP I [ANALYZ
+LESSTN,        JMS PRNT
+       TAD ["<
+       JMP CINSRT+1
+CTRLC,
+CTRLU, TAD [336
+       JMS I PRINT
+       TAD NAME1
+       TAD [100
+CLRLIN,        JMS I PRINT
+       JMS CRLF
+       TAD I XR
+       SZA CLA
+       JMP GLINE
+       CDF 10
+       CLA CMA
+       DCA I [7700
+       TSF
+       JMP .-1
+       JMP I [7605     /7605=CDF CIF 10
+CRLF,  0
+       TAD [215
+       DCA NAME1
+       JMS PRNT
+       TAD [212
+       JMS I PRINT
+       JMP I CRLF
+ALTMOD,        TAD [244
+       DCA NAME1
+       CLA CLL CML RAR
+       CDF 10
+       DCA I [MPARAM-1
+       CDF 0
+       JMS PRNT
+       JMP CLFINI
+\f/*** LOCATIONS ON THIS PAGE ARE MODIFIED BY SET
+/SEE SET FOR DETAILS.  DO NOT CHANGE.
+
+RUBOUT,        TAD LXR
+       TAD [1-BEGLN
+       SNA CLA
+       JMP RBSPCL
+       TAD [334
+       ISZ RBFLAG
+       JMS I PRINT
+       CLA CMA
+       DCA RBFLAG
+       TAD LXR
+       DCA T
+       TAD I T
+       JMS I PRINT
+LBCKUP,        CLA CMA
+       TAD LXR
+       JMP CHLOOP-1
+RBSPCL,        ISZ RBFLAG
+       JMP CLRLIN+1
+       TAD [334
+       JMP CLRLIN
+PRNT,  0
+       ISZ RBFLAG
+       JMP .+3
+       TAD [334
+       JMS I PRINT
+       DCA RBFLAG
+       TAD NAME1
+       JMS I PRINT
+       JMP I PRNT
+LFEED, JMS CRLF
+       DCA I LXR
+       TAD [BEGLN-2
+       DCA XR
+       TAD I XR
+       SNA
+       JMP LBCKUP
+       JMS I PRINT
+       JMP .-4
+
+       IFNZRO RUBOUT-1131 <_ERROR_>
+\f      *1200           /INITIALIZATION - STORED OVER BY LINE BUFFER
+       BEGLN=.         /LINE BUFFER
+CDINIT,        DCA TFPUTX
+       CDF 10
+       CLA IAC
+       TAD I [200
+       DCA TMONIT      /SAVE AWAY MONITOR CALL ADDRESS SINCE WE CALL
+       TAD I [USERFG   /THE MONITOR RECURSIVELY, LIKEWISE SAVE
+       DCA TUSRFG      /THE "USER FLAG" AND THE FIELD WE WERE CALLED FROM
+       TAD I [T1       /FETCH THE USERS ARGUMENT
+       DCA DEFALT      /STORE IN THE DEFAULT EXTENSION WORD
+       DCA I [7        /ZERO "DIRECTORY SEGMENT IN CORE" KEY
+       CDF 0
+       CIF 10
+       JMS I [200
+       13              /RESET ALL HANDLERS
+       0               /BUT NOT OUTPUT FILES
+       TAD DEFALT
+       TAD M5200
+       SZA CLA         /IS THIS A REQUEST FOR A "SPECIAL DECODE"?
+       JMP CDCONT      /NO
+       TAD ALTLIM
+       DCA OUTLIM      /YES - SET UP ALL THE PROPER LOCATIONS
+       TAD ALTDF1
+       DCA LIMDIF      /TO YIELD 1 OUTPUT FILE AND 5 INPUT FILES
+       TAD ALTDF2
+       DCA BEGDIF      /ALL OF WHICH ARE 5-WORD <DEVICE,NAME> ENTRIES
+       DCA I PLKUPS
+       TAD STARJM
+       DCA I PSTARS    /AND ALLOW * AS A FILE OR EXTENSION NAME
+       DCA DEFALT      /NO DEFAULT EXTENSION IN "SPECIAL" MODE
+       TAD CCLA        /STOPS FETCHES IN SPECIAL MODE
+       DCA I PSPKG1    /NO HANDLER FETCHES NECESSARY EITHER SINCE NO LOOKUPS
+CDCONT,        TAD I PRWD      /SEE IF BATCH FLAG IS UP
+       RAL
+       SPA CLA         /IF YES, GO TO PAGE0 CODE
+       JMP TT          /TT ETC. IS ONCE-ONLY CODE
+       JMP I CDRST
+\fCDRST,        RESTRT+1
+               /CONSTANTS NECESSARY TO SUPPORT "SPECIAL DECODE" MODE
+M5200, -5200
+ALTLIM,        1-MOFILE-5
+ALTDF1,        MOFILE+5-MPARAM+5
+ALTDF2,        5
+PLKUPS,        LKUPSW
+STARJM,        STARNM&177+5200         /"JMP STARNM"
+PSTARS,        STARSW
+CCLA,  CLA
+PSPKG1,        SPKLG1
+\f      *1314
+       EOBUFR=.
+PRMESG,        0
+       TAD I PRMESG
+       JMS PRWD
+       TAD I PRMESG
+       ISZ PRMESG
+       AND [77
+       SZA CLA
+       JMP PRMESG+1
+       JMP I [RESTRT
+PRWD,  7777
+       DCA T
+       TAD T
+       RTR
+       RTR
+       RTR
+       JMS PCHAR
+       TAD T
+       JMS PCHAR
+       JMP I PRWD
+PCHAR, 0
+       AND [77
+       SNA
+       JMP I PCHAR     /IGNORE NULLS
+       TAD [240
+       AND [77
+       TAD [240
+       JMS TYPE
+       JMP I PCHAR
+PRNAME,        0
+       TAD NAME1
+/      SNA             /WOULD LIKE TO FIND ROOM FOR THESE 2 LOCS
+/      JMP I [CDER2
+       JMS PRWD
+       TAD NAME2
+       JMS PRWD
+       TAD NAME3
+       JMS PRWD
+       TAD NAME4
+       SNA CLA
+       JMP I PRNAME
+       TAD [256
+       JMS PCHAR
+       TAD NAME4
+       JMS PRWD
+       JMP I PRNAME
+TYPE,  0
+       JMP .+3
+       TSF
+       JMP .-1
+       TLS
+       CLA
+       TAD [7000
+       DCA TYPE+1
+TYPRET,        JMP I TYPE
+       IFNZRO TYPRET-1377 <BATCHX,ZQWE>
+\f      *4001   /PROG TO WRITE CD AND ODT ONTO NEW SYSTEM DEVICE
+               /4000=JMS SYSSWP TO SWAP PGS 6600 AND 7600
+       TAD I (7777     /SET TO PROPER RECORD FOR FIELD 1 STUFF
+       DCA F1STUF
+       JMS I SYSHND
+       4600
+       0
+       MCDREC
+       JMP CERR
+       JMS I SYSHND
+       5011
+       0
+       ODTREC
+       JMP CERR
+       JMS I SYSHND
+       0110            /READ IN UPPER PG 7600
+       7600
+F1STUF,        0
+       JMP CERR
+       JMP I .+1
+       7605            /START HER UP
+CERR,  TAD .+3
+       DCA 4001
+       JMP 4000        /RESWAP AND HALT
+       HLT
+SYSHND,        7607
+       PAGE
+\f      *0
+       CDVERSION
+       HLT             /POWER FAIL RESTART PROTECTION
+NUMTST,        7777
+       JMS I [GCH
+       CMA
+       TAD NUMFUJ
+       TAD ["8         /TEST INPUT CHARACTER FOR RANGE
+       CLL CMA         /0-7 IF NUMFUJ=0
+       TAD [10         /0-9 IF NUMFUJ=2
+       TAD NUMFUJ
+       JMP I NUMTST
+       *15
+LXR,   0
+XR,    0
+CLXR,  0
+T,     CDINIT
+TT,    CDF 0           /***GETS SET TO CDF BATCH
+HIORD, TAD I DVICE     /CHECK TO SEE IF BOS IS REALLY THERE
+NUMX,  TAD OUTSW       /IF NOT, SIGNAL ERROR
+RBFLAG,        SNA CLA
+NAME1, JMP NAMECT      /IT'S O.K.....PROBABLY!
+NAME2, CDF 0           /BAD. SIGNAL ERROR TO MONITOR
+NAME3, ISZ I NUMTST
+NAME4, JMP I [7605     /AND RESTART BATCH MONITOR
+NAMECT,        CIF CDF 0       /*****GETS ALTERED******
+NMBASE,        JMP I .+1       /START UP IN CD AREA OF BATCH
+DEV1,  RESTRT+1        /***GETS ADDRESS OF CD AREA
+DEV2,  0
+PERDSW,        0
+NUMFUJ,        0
+DVFLAG,        0
+DELIM, 0
+OUTSW, 0
+DEFALT,        0
+DVICE, 0
+DFLTNM,        0423;1300       /DSK
+BEGDIF,        MIFILE-MOFILE
+LIMDIF,        MIFILE-MPARAM+2
+OUTLIM,        1-MIFILE
+GETHND,        11
+TMONIT,        0
+TUSRFG,        0
+TFPUTX,        0
+EXT1,  TAD NAME4
+       DCA NAMECT      /REMEMBER TYPED EXTENSION
+       TAD NAMECT
+       SNA
+       TAD DEFALT      /SUBSTITUTE DEFAULT IF ZERO
+EXT2,  DCA NAME4
+       TAD [NAME1
+       JMP I .+1
+       LKUPLP
+PRINT, TYPE
+\f      FIELD 1
+       EJECT INVISIBLE ODT
+       /INVISIBLE ODT FOR OS/8 MONITOR
+       /LOADS INTO FIELD 1 NOW, BUT LOADS & EXECUTES IN FIELD 0
+       /DEFINITIONS OF MONITOR SYMBOLS - VOLATILE!
+       ODTREC=60
+       UDNAME=7741
+       MREAD=7757
+       MGET=7667
+       KMREC=7
+       MTEMP=27
+       MARG1=7740
+       JSBITS=7746
+       *200
+READ,  JMS I [OCRLF
+READ5, DCA WORD
+       DCA WORD+1
+       TAD [-6
+       DCA TOTE
+REA,   KSF
+       JMP .-1
+       JMS I [CTCTST
+       JMP CTRC
+       TAD [203
+       DCA TEMP
+       KCC
+       TAD TEMP
+       JMS I [TYPN
+       TAD [TABL1-1
+       DCA 10
+CHFLP, TAD I 10
+       SPA
+       JMP SEX
+       CIA
+       TAD TEMP
+       SZA CLA
+       JMP CHFLP
+       TAD 10
+       TAD [TABL2-TABL1
+       DCA TEMP
+       TAD I TEMP
+       DCA TEMP
+       CLL
+       JMP FLDTST      /SEE IF FIELD SETTING IS LEGAL
+CTRC,  JMS I [DUMP
+       JMP I [7605
+\fTABL1=.
+       240
+       212
+       215
+       257
+       302
+       307
+       273
+       303
+       327
+       336
+       315
+       301
+       314
+       304
+       337
+       306
+       377
+       253
+       255
+       -270            /USED - SEE "SEX"
+\fEXAM, JMS TOTTST
+       JMP EX2
+       TAD WORD
+       DCA CAD
+       TAD WORD+1
+       DCA CAD+1
+EX2,   JMS I [LOAD
+       CAD
+       JMS I [PNUM
+       DCA SHUT
+       JMP READ5
+SEX,   TAD TEMP
+       CLL
+       TAD [10
+       SNL
+       JMP NO
+       DCA TEMP
+       CLA CLL CMA RTL
+       DCA CRL
+SROT,  TAD WORD+1
+       CLL RAL
+       DCA WORD+1
+       RTL
+       RAL
+       TAD WORD
+       RAL
+       DCA WORD
+       ISZ CRL
+       JMP SROT
+       TAD WORD+1
+       TAD TEMP
+       DCA WORD+1
+       ISZ TOTE
+       JMP REA
+NO,    CLA
+       TAD [277
+       JMS I [TYPN
+       JMP READ
+\fCRL,  0
+       JMS TOTTST
+       JMP I CRL
+       TAD WORD+1
+       ISZ SHUT
+       JMS I [STORE
+       CAD
+       CLA
+       JMP I CRL
+CRL1,  JMS CRL
+       JMP READ
+CRL2,  TAD [215
+       JMS I [TYPN
+       JMS CRL
+       JMS I [TYPN
+       ISZ CAD+1
+       NOP
+UPAR3, JMS I [TYPD
+       CAD
+       TAD [257
+       JMS I [TYPN
+       JMP EX2
+OPIN,  JMS CRL
+       JMS I [LOAD
+       CAD
+       DCA CAD+1
+       TAD INDFLD
+       DCA CAD
+UPAR2, JMS I [OCRLF
+       JMP UPAR3
+SEMI,  JMS CRL
+       ISZ CAD+1
+       NOP
+       JMP READ5
+\f      *400
+/NOTE THAT LOCATIONS BURP,BURP+1 GET ALTERED AFTER BRKTST
+/IS EXECUTED. THEY BECOME: CDF 10; TAD I [MARG1
+BURP,  JMP I .+1       /GO REDETERMINE CORE SIZE
+       BRKTST          /TO MAKE ILLEGAL FIELD GIVE ?
+       DCA SAC
+       IOF
+       TAD I [MTRAD
+       DCA TRAD
+       TAD I [MTRAD1
+       DCA TRAD+1
+       TAD I [MKEEP
+       DCA KEEP
+       TAD I [MPUNN
+       DCA PUNN
+       CLA IAC
+       AND I [7700
+       DCA LINK
+       TAD I [7700
+       CDF 0
+       AND [70
+       DCA DATFLD
+       TAD DATFLD
+       DCA INDFLD
+       TAD [KMREC
+       CDF 10
+       DCA I [MGET+4
+       CLA CLL CMA RAL
+       AND I [MGET+2
+       DCA I [MGET+2   /REMOVE LOW-ORDER BIT FROM CONTROL WORD
+       CDF 0
+       TAD KEEP
+       JMS I [STORE
+       TRAD
+       TAD TRAD+1
+       IAC
+       DCA GAME+1
+       TAD TRAD
+       DCA GAME
+       TAD KEEP
+       DCA INST
+       JMS I [IOTTST
+       SKP
+       JMP JMPLIP
+       TAD TRAD
+       DCA CAD
+       TAD TRAD+1
+       DCA CAD+1
+       JMS I [EFFADR
+       TAD CAD
+       DCA FROG
+       TAD CAD+1
+       DCA FROG+1
+JMPLIP,        JMS I [CTCTST
+       JMP I [7605
+       CLA
+       JMP I [LIP
+\fCTCTST,       0
+       TAD [200
+       KSF
+       STA
+       KRS
+       TAD [-203
+       SZA
+       ISZ CTCTST
+       JMP I CTCTST
+
+OCRLF, 0
+       TAD [215
+       JMS I [TYPN
+       TAD [212
+       JMS I [TYPN
+       CLA CMA
+       DCA SHUT
+       JMP I OCRLF
+TRAP,  JMS TOTTST
+       TAD [SHNDLR
+       TAD WORD+1
+       DCA TRAD+1
+       TAD WORD
+       DCA TRAD
+       TAD [7000
+       DCA I [SHNDLR
+       TAD [4
+       DCA WORD+1
+       TAD [UDNAME-MPUNN-1
+       DCA TEMP
+       TAD [BRKCOD-1
+       DCA 10
+       TAD [UDNAME-1
+       DCA 11
+       TAD I 10
+       CDF 10
+       DCA I 11
+       CDF 0
+       ISZ TEMP
+       JMP .-5
+       TAD I [JSBITS
+       RTR
+       SZL CLA
+       TAD [5
+       CDF 10
+       TAD I [J7600
+       DCA I [J7600    /CHANGE JMP 7600 TO JMP 7605 IF ODT AREA NOT USED
+       CDF 0
+       TAD I [JSBITS
+       DCA JSTEMP              /SAVE JSBITS BEFORE SETTING BRKPT
+       TAD [CIF 10
+       JMS I [STORE
+       WORD
+       ISZ WORD+1
+       TAD [JMP I 6
+       JMS I [STORE
+       WORD
+       ISZ WORD+1
+       TAD [UDNAME
+       JMS I [STORE
+       WORD
+       TAD JSTEMP
+       DCA I [JSBITS           /RESTORE JSBITS
+       JMP I [READ
+SUBT,  CML
+ADD,   TAD WORD+1      /MODIFY CURRENT LOCATION POINTER
+       SNA
+       IAC             /1 IS DEFAULT VALUE
+       SZL             /+ OR -?
+       CIA             /-
+       TAD CAD+1
+       DCA CAD+1
+       JMP I [UPAR2    /AND DISPLAY LOC AND CONTENTS
+\f      *600            /MONITOR ENTERS ODT HERE
+LIP,   HLT             /ERROR. AT INIT, THE CODE AT 600
+       JMP I .+1       /IS CHANGED TO: ISZ PUNN;
+TTYTST,        INIT            /JMP XCONT; TSF
+       JMP TTYOFF
+LIPTYP,        JMS I [TYPD
+       TRAD
+       TAD P250
+       JMS I [TYPN
+       TAD LINK
+       TAD [260
+       JMS I [TYPN
+       TAD [273
+       JMS I [TYPN
+       TAD SAC
+       JMS I [PNUM
+       JMP I [READ
+JUMP,  JMS TOTTST      /TEST FOR 'G' WITH NO ADDRESS
+       JMP I PNO
+       TAD WORD
+       DCA GAME
+       TAD WORD+1
+       DCA GAME+1
+       TAD WORD
+       DCA DATFLD
+       TAD [7000
+       DCA INST
+       DCA SAC
+       DCA LINK
+       JMP CONTX
+CONTIN,        TAD WORD+1
+       CIA
+       SNA
+CONTX, CMA
+       DCA PUNN
+       DCA I [7607     /IN CASE THERE WAS NO BREAKPOINT
+       JMS I [LOAD     /V3
+       TRAD            /V3
+       DCA KEEP        /V3
+       JMS I [OCRLF
+XCONT, TAD [JMP 4
+       JMS I [STORE
+       TRAD
+       CDF 10
+       TAD TRAD
+       DCA I [MTRAD
+       TAD TRAD+1
+       DCA I [MTRAD1
+       TAD KEEP
+       DCA I [MKEEP
+       TAD PUNN
+       DCA I [MPUNN
+       CDF 0
+       JMS I [SIM      /SIMULATE THE BRKPOINTED INST HERE
+       TAD LINK
+       DCA I [MLINK
+       TAD SAC
+       DCA I [MAC
+       TAD GAME
+       TAD [CIF 0
+       DCA I [MSTCDF
+       TAD DATFLD
+       AND [70
+       TAD [CDF 0
+       DCA I [MCDF
+       TAD GAME+1
+       DCA I [MSTADR
+       JMS I [DUMP
+       TAD I [JSBITS
+       RTR
+       SZL CLA
+       JMP I [MSWITC
+       JMP I [MREAD
+\fUPAR1,        JMS I [CRL
+       JMS I [EFFADR
+       JMP I [UPAR2
+EFFADR,        0
+       JMS I [LOAD
+       CAD
+       AND [177
+       DCA TEMP
+       JMS I [LOAD
+       CAD
+       AND [200
+P250,  SNA CLA
+       JMP .+3
+       TAD CAD+1
+       AND [7600
+       TAD TEMP
+       DCA TEMP
+       JMS I [LOAD
+       CAD
+       AND [400
+       SNA CLA
+       JMP NOIND
+       TAD TEMP
+       DCA CAD+1
+       JMS I [LOAD
+       CAD
+       DCA TEMP
+       TAD CAD+1
+       AND P7770
+       TAD P7770
+       SZA CLA
+       JMP NOAUTO
+       ISZ TEMP
+P7770, 7770    /SPA SNA SZL CLA - NEVER SKIPS - USED TO PROTECT ISZ
+       TAD TEMP
+       JMS I [STORE
+       CAD
+NOAUTO,        TAD INDFLD
+       AND [70
+       DCA CAD
+NOIND, TAD TEMP
+       DCA CAD+1
+       JMP I EFFADR
+TTYOFF,        AND I 0         /WASTE SOME TIME
+       JMS I [IOTTST
+       AND I 0
+       ISZ NOUGHT
+       JMP TTYTST
+       JMP LIPTYP      /IF THE TTY FLAG ISN'T UP NOW, IT'LL NEVER GO UP
+NOUGHT,        0
+\fTABL2=.
+       REA             /IGNORE BLANKS
+       CRL2
+       CRL1
+       EXAM
+       TRAP
+       JUMP
+       SEMI
+       CONTIN
+       WSER
+       UPAR1
+       MASKX
+       ACX
+       LINKX
+       DATF
+       OPIN
+       INDF
+       RBOUT
+       ADD
+       SUBT
+\f      IFZERO 1000&. <*1000>
+PNUM,  0
+       DCA PUNN
+       TAD [-4
+       DCA TEMP
+PN2,   TAD PUNN
+       RTL
+       RAL
+       DCA PUNN
+       TAD PUNN
+       RAL
+       AND [7
+       TAD [260
+       JMS I [TYPN
+       ISZ TEMP
+       JMP PN2
+       TAD [240
+       JMS I [TYPN
+       JMP I PNUM
+TYPD,  0
+       TAD I TYPD
+       DCA TEMP
+       TAD I TEMP
+       CLL RTR
+       RAR
+       TAD [260
+       JMS I [TYPN
+       ISZ TEMP
+       TAD I TEMP
+       JMS I [PNUM
+       ISZ TYPD
+       JMP I TYPD
+TYPN,  0
+       TLS
+       TSF
+       JMP .-1
+       CLA
+       JMS I [CTCTST
+       JMP I [CTRC
+       TAD [-14        /^O?
+       SZA CLA
+       JMP I TYPN      /NO
+       KCC             /YES
+       JMP I [READ
+\fWSER, JMS I [OCRLF
+       TAD LIMLO
+       DCA CKT+1
+       TAD INDFLD
+       AND [70
+       DCA CKT
+WSER1, JMS I [LOAD
+       CKT
+       AND MASK
+       CIA
+       TAD WORD+1
+       SZA CLA
+       JMP WSER2
+       JMS I [TYPD
+       CKT
+       TAD [257
+       JMS I [TYPN
+       JMS I [LOAD
+       CKT
+       JMS I [PNUM
+       JMS I [OCRLF
+WSER2, TAD CKT+1
+       ISZ CKT+1
+       NOP
+       CIA
+       TAD LIMHI
+       SZA CLA
+       JMP WSER1
+       JMP I [READ
+
+ACX,   TAD [SAC-LINK
+LINKX, TAD [LINK-MASK
+MASKX, TAD [MASK-DATFLD
+DATF,  TAD [DATFLD-INDFLD
+INDF,  TAD [INDFLD
+       DCA WORD+1
+       CLA CMA
+       DCA WORD
+       DCA TOTE
+       TAD [257
+       JMS I [TYPN
+       JMP I [EXAM
+\fBRKCOD=.
+       NOPUNC
+       *UDNAME
+       ENPUNC
+
+       DCA MARG1
+       RAL
+       RDF
+       DCA 7700
+       TAD PODT
+       DCA MGET+4
+       ISZ MGET+2      /DON'T REVERSE TAPE MOTION TO PICK UP ODT
+       CDF CIF 0
+J7600, JMP 7600
+PODT,  ODTREC
+P7603, 7603
+MTRAD, 0
+MTRAD1,        0
+MKEEP, 0
+MPUNN, 0
+
+       NOPUNC
+       *BRKCOD+MPUNN-UDNAME+1
+       ENPUNC
+
+DUMP,  0
+       TAD STOFLG
+       SNA CLA
+       JMP I DUMP
+       JMS I [SHNDLR
+       4200
+       1400
+GREC,  0
+       HLT
+       DCA STOFLG
+       JMP I DUMP
+
+RBOUT, TAD [277
+       JMS I [TYPN
+       TAD [240
+       JMS I [TYPN
+       JMP I [READ5
+\f      IFNZRO .-1200&4000 <*1200>
+SIM,   0
+       JMS IOTTST
+       JMS I [LOAD
+       FROG
+       DCA TEMP
+       TAD TEMP
+       DCA 0
+       JMS IOTTST
+       TAD [777
+       CMA
+       AND INST
+       RAL
+       CML
+       SNL SMA
+       JMP JMSJMP
+       CML RAR
+       DCA SOPR
+       TAD DATFLD
+       AND [70
+       TAD [CDF 0
+       DCA .+1
+       HLT
+       TAD LINK
+       CLL RAR
+       TAD SAC
+SOPR,  HLT
+       SKP
+       ISZ GAME+1
+       DCA SAC
+       RAL
+       DCA LINK
+       RDF
+       DCA DATFLD
+       CDF CIF 0
+EOSIM, TAD 0
+       CIA
+       TAD TEMP
+EOTST, SNA CLA
+       JMP .+3
+       TAD 0
+       JMS I [STORE
+       FROG
+       JMP I SIM
+
+IOTTST,        0
+       CLA CLL CML RTR
+       TAD INST
+       SZL CLA
+       ISZ IOTTST
+       JMP I IOTTST
+\fJMSJMP,       RTL
+       SZL CLA
+       JMP JMPX
+       TAD TRAD
+       DCA FROG
+       TAD GAME+1
+       DCA 0
+       CLA IAC CLL
+JMPX,  TAD FROG+1
+       DCA GAME+1
+       CML RAL         /PUT -LINK IN AC (0 IF JMP, 1 IF JMS)
+       JMP EOTST
+
+LOAD,  0
+       TAD I LOAD
+       JMS I [GETADR
+       NOP
+       TAD I ADR
+       CDF 0
+       ISZ LOAD
+       JMP I LOAD
+
+STORE, 0
+       DCA LOAD
+       TAD I STORE
+       JMS I [GETADR
+       ISZ STOFLG      /INDICATE THAT WE'RE CHANGING THIS RECORD
+       TAD LOAD
+       DCA I ADR
+       CDF 0
+       ISZ STORE
+       JMP I STORE
+\fGETADR,       0
+       DCA ADR
+       TAD I ADR
+       DCA FADR
+       ISZ ADR
+       TAD I ADR
+       DCA ADR
+       TAD FADR
+       SNA
+       JMP CKADR
+       SPA
+       CLA
+       TAD [CDF 0
+       DCA .+1
+FADR,  0
+       ISZ GETADR
+       JMP I GETADR
+CKADR, TAD ADR
+       RAL
+       SZL SPA CLA
+       JMP FADR+1
+       CLA CLL CMA RTL
+       AND I [JSBITS
+       DCA I [JSBITS   /MODIFY THE JSW TO INDICATE ODT AREA VIOLATION
+       TAD ADR
+       CLL RTL
+       RTL
+       RAL
+       AND [7
+       TAD [MTEMP+4
+       DCA GIREC
+       TAD I [GREC
+       CIA
+       TAD GIREC
+       SNA CLA
+       JMP NOREAD
+       JMS I [DUMP
+       JMS I [SHNDLR
+       0200
+G1400, 1400
+GIREC, 0
+       HLT
+       TAD GIREC
+       DCA I [GREC
+NOREAD,        TAD ADR
+       AND [377
+       TAD G1400
+       DCA ADR
+       JMP I GETADR
+\f      *1400
+       /INITIALIZATION CODE TO SET UP THE "MREAD" AREA IN FIELD 0
+       /WITH THE ODT CODE TO START UP A PROGRAM
+
+INIT,  TAD [MREAD-MSTADR-2
+       DCA TEMP
+       TAD [RSTCOD-1
+       DCA 10
+       TAD [MREAD-2
+       DCA 11
+       TAD I 10
+       DCA I 11
+       ISZ TEMP
+       JMP .-3
+       JMS CORE        /DETERMINE CORE FIELD SIZE
+       TSF
+       JMP .-1
+       JMP I [READ
+
+BRKTST,        JMS CORE        /GET CORE SIZE NOW THAT WE WERE
+       TAD KLIP
+       DCA I PLIP      /SETUP LOCATIONS AT 600
+       TAD KLIP+1
+       DCA I PLIP+1
+       TAD KLIP+2
+       DCA I PLIP+2
+       TAD KCDF10      /JUST BREAKPOINTED IN. THEN RESTORE
+       DCA I BURPO     /LOCS AT BURP SO WE NEVER COME BACK
+       TAD KCDF10+1    /HERE AGAIN UNTIL WE'RE SWAPPED
+       DCA I BURP2
+       JMP I BURPO
+KCDF10,        CDF 10
+       TAD I [MARG1    /SIMULATE LOCS AT BURP
+BURPO, BURP
+BURP2, BURP+1
+\fRSTCOD=.
+       NOPUNC
+       *MREAD-1
+       ENPUNC
+
+       SHNDLR
+       JMS I .-1
+       1000
+       0
+       MTEMP+4
+       HLT
+MSWITC,        TAD MLINK
+       CLL RAR
+       TAD MAC
+MCDF,  CDF 0
+       JMP MSTCDF
+MAC,   0
+MLINK, 0
+MSTCDF,        CIF 0
+       JMP I .+1
+MSTADR,        0
+
+       NOPUNC
+       *RSTCOD+MSTADR-MREAD+2
+       ENPUNC
+\fCORE, 0
+       CDF 0
+       TAD I M1
+       AND COR70
+       SZA
+       JMP USERC
+COR0,  CDF 0
+       TAD CORSIZ
+       RTL
+       RAL
+       AND COR70
+       TAD COREX
+       DCA .+1
+COR1,  CDF
+       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
+       TAD COR1
+       DCA I CORLOC
+       ISZ CORSIZ
+       JMP COR0
+
+COREX, CDF 0
+       TAD CORSIZ
+       CLL RAL
+       RTL
+USERCR,        CIA
+       DCA ZERO        /STORE AWAY NEG OF FIRST NON-EXISTENT FIELD
+                       /AT ODT'S LOCATION 0
+       JMP I CORE
+
+CORLOC,        CORX
+CORV,  1400
+M1,    -1
+\fCORSIZ,       1
+USERC, TAD L10
+       JMP USERCR
+L10,   10
+
+KLIP,  ISZ PUNN        /THESE INSTRUCTIONS GO INTO 600
+       XCONT&177+5200  /JMP XCONT
+       TSF
+PLIP,  LIP
+       LIP+1
+       LIP+2
+\f      *0
+ZERO,  ODTVERSION
+       HLT             /IN CASE BKPT WITH INTER ON
+STOFLG,        0
+PUNN,  0
+       *4              /PAGE 0 LITERALS AND CELLS
+       CIF 10          /PROTOTYPE BREAKPOINT
+       JMP I 6         /USED BY PROGRAMS WITH JSBITS(10)=1
+       UDNAME          /WHEN ODT IS RELOADED ON A BREAKPOINT
+
+       *12
+TOTE,  0
+KEEP,  0
+INST,  0
+SHUT,  -1
+TRAD,  0;SHNDLR
+WORD,  0;0
+LINK,  0
+SAC,   0
+CAD,   0;0
+CKT,   0;0
+GAME,  0;0
+FROG,  0;0
+TEMP,  0
+JSTEMP,        0
+DATFLD,        0
+INDFLD,        0
+MASK,  7777
+LIMLO, 0
+LIMHI, 7577
+ADR,   0
+FLDTST,        TAD ZERO                /LOC. 0 HAS FIRST IMAGINARY CORE FIELD
+       TAD WORD        /IF USER TRIES TO ADDRESS NON-
+       SNL CLA         /EXISTENT CORE, A ? RETURNS
+       JMP I TEMP      /HE'S OK.
+       JMP I PNO
+PNO,   NO
+TOTTST,        0
+       TAD TOTE
+       TAD [6
+       SZA CLA
+       ISZ TOTTST
+       JMP I TOTTST
+       $
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/CR8E.PA b/sw/os8/v3d/sources/system/dectapes/dectape3/CR8E.PA
new file mode 100644 (file)
index 0000000..3ff9aab
--- /dev/null
@@ -0,0 +1,302 @@
+/3 CARD READER FOR BUILD
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT  (C)  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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f      *0
+       -1
+DEVICE CR8E;DEVICE CDR;2030;4000;ZBLOCK 2
+
+       CDRVERSION="C&77
+
+/V3 CHANGES:
+
+/1.    VERSION # IS NOW 1
+/2.    FIXED BUG FOR CARDS WITH ODD NUMBER OF COLUMNS
+/3.    CARD DONE FLAG IS CLEARED AT END
+
+       *200
+
+RCSF=6631
+RCRA=6632
+RCSP=6671
+RCSE=6672
+RCRD=6674
+
+CDR,   CDRVERSION      /ENTRY POINT RELATIVE ZERO
+CDR770,        7700            /"SMA CLA" CLEARS THE AC
+CDRTMP,        0               /LESS THAN 400 - PROTECTS THE "SMA CLA"
+       JMP CDRSET      /INITIALIZATION - BECOMES "RDF"
+       TAD CDRCIF      /FORM "CIF CDF N" TO CALLING FIELDS
+       DCA CDRXIT      /SAVE CALLING FIELDS
+       TAD CDRCCF-1
+       DCA CDRXIT-1    /RESTORE THE "ISZ CDR"
+       TAD I CDR       /GET FUNCTION WORD
+       AND CDR070      /GET BUFFER FIELD BITS
+       TAD CDRCCF      /MAKE A "CDF N"
+       DCA CDBCDF      /SAVE IT IN THE GET CHAR LOOP
+       TAD I CDR       /GET FUNCTION WORD AGAIN
+       ISZ CDR
+       SPA             /IS IT A WRITE FUNCTION?
+       JMP CDRERR      /YES - HARD ERROR
+       AND CDR770      /GET COUNT BITS
+       CIA
+       DCA CDRWC       /SAVE WORD COUNT (DIVIDED BY 2)
+       TAD I CDR       /GET BUFFER ADDRESS
+       DCA CDRCA       /AND SAVE IT
+       ISZ CDR         /THE BLOCK NUMBER IS IGNORED
+CDRCCF,        CDF             /WE ARE IN FIELD 0
+       DCA I CDRIN2    /RESET ^Z FLAG TO ZERO
+CDRLP, JMS I CDRIN4    /GET A CHARACTER
+       DCA CDRTM1      /DATA FIELD STILL ZERO ON RETURN!
+       JMS I CDRIN4    /GET NEXT CHARACTER
+       DCA CDRTMP      /AND SAVE IT
+       JMS I CDRIN4    /GET NEXT CHARACTER
+       RTL
+       RTL             /GET THE FIRST FOUR BITS OF IT
+       DCA CDRTM2      /SAVE THE REST FOR LATER
+       TAD CDRTM2
+       AND CDR740      /ONLY 4 BITS
+       TAD CDRTM1      /ADD THOSE BITS TO THE 1ST CHAR
+CDBCDF,        HLT             /CDF TO BUFFER FIELD
+       DCA I CDRCA     /STORE 1ST CHARACTER
+       ISZ CDRCA       /BUMP POINTER TO BUFFER
+CDR740,        7400            /PROTECT THE ISZ AGAINST SKIPS
+       TAD CDRTM2
+       RTL
+       RTL             /NOW GET LOW ORDER 4 BITS
+       AND CDR7400     /AND ONLY 4 BITS
+       TAD CDRTMP      /ADD IN THE 2ND CHARACTER
+       DCA I CDRCA     /AND STORE THE WORD
+       ISZ CDRCA       /BUMP POINTER AGAIN
+CDR070,        70              /PROTECT THE ISZ
+       CDF 0           /CDRGCH NEEDS 0 DF ON ENTRY!
+       ISZ CDRWC       /DONE?
+       JMP CDRLP       /NO - LOOP
+CDRERR,        ISZ CDR         /HERE WITH NEGATIVE AC ON WRITE - FATAL ERROR
+       ISZ CDR         /IF ^Z THIS IS ZEROED
+CDRXIT,        HLT             /RESTORE CALLING FIELDS
+       JMP I CDR       /EXIT
+
+CDRCA, 0               /BUFFER POINTER
+CDRWC, 0               /WORD COUNT DIVIDED BY 2
+CDRTM1,        0
+CDRTM2,        0               /SPLIT WORD TEMPORARY
+CDRCIF,        CIF CDF 0       /TO FORM EXIT WORD
+
+CDRIN2,        CDRJMP-CDRLOC   /CORRECTED AT INITIALIZATION TIME
+CDRIN4,        CDRGCH-CDRLOC
+
+       0               /** FREE LOCATIONS - COME AND GET 'EM !
+       0
+       IFNZRO  .-277   <RESORC,_ERROR_>        /BUT THERE'S A CATCH
+CDRTBL,        0021;2223;2425;2627;3031;3203;4007;3502
+       2017;6364;6566;6770;7172;7514;0577;3637
+       1552;5354;5556;5760;6162;0104;1211;3374
+       0641;4243;4445;4647;5051;7316;3410;1376
+
+/DO NOT INSERT ANYTHING BETWEEN "CDRTBL" AND "CDRBUF"!!
+
+CDRBUF=.               /CARD BUFFER
+
+CDRSET,        RDF             /INITIALIZATION CODE
+       TAD CDRCCF
+       DCA CDRSE1      /SAVE CALLING FIELDS
+       CDF             /WE ARE IN FIELD 0
+       JMS .           /FIND OUT OUR LOCATION
+CDRLOC,        TAD CDRSE2      /ADDRESS TO MODIFY
+       TAD CDRLOC-1    /CORRECT IT
+       DCA CDRSE3      /SAVE IT
+       TAD I CDRSE3    /GET DATA TO MODIFY
+       TAD CDRLOC-1    /CORRECT IT
+       DCA I CDRSE3    /AND RESTORE IT
+       ISZ CDRLOC      /NEXT ADDRESS
+       ISZ CDRSE4      /MORE?
+       JMP CDRLOC      /YES - LOOP
+       TAD CDRSET
+       DCA CDR+3       /SET THE "RDF"
+CDRSE1,        HLT             /RESTORE CALLING FIELDS
+       JMP CDR+3       /AND BACK TO NORMAL
+
+CDRSE3,        0               /MODIFY POINTER
+CDRSE4,        -5              /FIVE LOCATIONS TO MODIFY
+
+CDRSE2,        CDRIN2-CDRLOC   /LOCATIONS TO MODIFY
+       CDRIN4-CDRLOC
+       CDRIN5-CDRLOC
+       CDRABF-CDRLOC
+       CDRTAD-CDRLOC
+\f*CDRBUF+50            /END OF THE BUFFER
+
+CDRGCH,        0               /GET A CHARACTER ROUTINE - ENTER WITH DF=0
+CDRJMP,        0               /THIS IS "JMP I CDRGCH" AFTER A ^Z
+       ISZ CDRCNT      /MORE CHARACTERS IN THE INTERNAL BUFFER?
+       JMP CDRGET      /YES - GET ONE
+CDRGE4,        ISZ CDRCT2      /GIVE A 215, 212 FOR EVERY CARD
+       JMP CDRCLF      /215, 212 ROUTINE
+       CLL CLA CMA RTL
+       DCA CDRCT2      /RESET COUNT TO -3
+CDRGNC,        TAD CDRABF
+       DCA CDRPT       /SET POINTER TO INTERNAL BUFFER
+CDRGE0,        KSF             /KEYBORAD FLAG UP?
+       JMP CDRGE7      /NO - TRY TO READ A CARD
+       TAD CDR760      /FORCE THE PARITY BIT ON
+       KRS             /READ STATIC FROM KEYBOARD
+       TAD CDR175      /IS IT ^C?
+       SNA
+       JMP I CDR760    /YES - TO MONITOR VIA 07600
+       TAD CDRM27      /IS IT ^Z?
+       SZA CLA
+       JMP CDRGE7      /NO - GET A CARD
+       KCC             /KILL FLAG
+CDRGEZ,        CLA CMA
+       DCA CDRCNT      /RESET COUNTS TO SKIP
+       CLA CMA
+       DCA CDRCT2
+       TAD CDRMOD
+       DCA CDRJMP      /SET TO GIVE 0'S
+       DCA I CDRIN5    /AND A SOFT ERROR
+       TAD CDR232      /^Z
+       JMP I CDRGCH    /EXIT
+
+CDRGE7,        RCSE            /SELECT A CARD
+       JMP CDRGE0      /NO GO - TRY AGAIN
+       DCA CDRSW       /SET PACKING SWITCH
+CDRGCL,        DCA CDRTIM      /INITIALIZE TIMEOUT COUNTER
+CDRGE1,        RCSP            /CARD DONE?
+       JMP CDRGE2      /NO - TRY FOR DATA READY
+       RCRD            /CLEAR CARD DONE FLAG
+CDRGE3,        TAD I CDRPT     /GET LAST TWO CHARACTERS
+       SZA             /BOTH SPACES?
+       JMP CDRGE5      /NO
+       CLA CMA
+       TAD CDRPT
+       DCA CDRPT       /BACK UP POINTER ONE
+       ISZ CDRCNT
+       ISZ CDRCNT      /AND TAKE COUNT DOWN BY 2
+       JMP CDRGE3      /TEST AGAIN OR...
+       JMP CDRGE4      /IF COUNT IS ZERO THE A BLANK CARD
+
+CDRGE5,        AND CDR077      /IS RIGHT HAND CHARACTER A SPACE?
+       SNA CLA
+       ISZ CDRCNT      /YES A SPACE - REDUCE COUNT
+       TAD I CDRPT     /GET LAST NON-SPACE
+       TAD CDR077      /THIS FORMS 7777 IFF WORD CONTAINS "_"
+       AND CDRCNT      /THIS MAINTAINS 7777 IFF CDRCNT IS -1
+       CMA
+       SNA CLA         /ARE BOTH CONDITIONS TRUE?
+       JMP CDRGEZ      /YES - MUST BE END OF FILE
+CDRGE6,        TAD CDR077
+       DCA CDRSW       /SET OFFSET FROM "CDRTBL"
+CDRGET,        ISZ CDRSW       /BUMP OFFSET
+       TAD CDRSW       /OFFSET INTO AC
+       JMS CDRGE8      /GET A CHARACTER
+       TAD CDR240      /MAKE IT ASCII
+CDRMOD,        JMP I CDRGCH
+
+CDRGE8,        0               /GET FROM BUFFER ROUTINE
+       CLL RAR         /DIVIDE BY 2 - AND INTO LINK IS INDICATOR
+       TAD CDRTAD      /ADDRESS OF "CDRTBL"
+       DCA CDRTM3      /SET POINTER
+       TAD I CDRTM3    /GET WORD
+       SZL             /SHIFT?
+       JMP .+4         /NO
+       RTR             /YES
+       RTR
+       RTR
+       AND CDR077      /GET 6 BITS
+       JMP I CDRGE8
+
+CDRGE2,        RCSF            /DATA READY?
+       JMP CDRGEX      /NO - TRY FOR TIME OUT
+       RCRA            /READ ALPHA
+       JMS CDRGE8      /GET TABLE ENTRY
+       ISZ CDRSW       /WHICH SIDE?
+       JMP CDRGE9      /LEFT SIDE
+       TAD I CDRPT
+       DCA I CDRPT     /FORM RIGHT SIDE
+       JMP CDRGCL      /CONTINUE
+
+CDRGE9,        CLL RTL         /SHIFT LEFT
+       RTL
+       RTL
+       ISZ CDRPT       /BUMP POINTER
+       DCA I CDRPT     /STORE LEFT SIDE
+       CLA CLL CMA RAL /-2 V3 FROM SIS BULLETING JAN  73
+       TAD CDRCNT
+       DCA CDRCNT      /COUNT THE CHARACTERS
+       CLA CMA
+       JMP CDRGCL-1    /CONTINUE - SET SWITCH
+\fCDRCLF,       CLA CMA
+       DCA CDRCNT      /SET MAIN COUNT TO SKIP
+       TAD CDRCT2
+       CLL CMA RTL     /ALL THIS DOES IS...
+       TAD CDRCT2      /MAKE A 2 OR -1
+       TAD CDR213      /SO THIS MAKES A 215 OR 212
+       JMP I CDRGCH
+
+CDRGEX,                        /TEST TIME OUT - FIRST DELAY USING CONSTANTS
+CDR760,        7600            /MONITOR ADDRESS
+CDR077,        77              /SIX BIT MASK
+CDRM77,        -7700           /-"_ "
+CDR175,        175
+CDR240,        240             /ASCII SPACE
+CDR213,        213             /215, 212 CORRECTION FACTOR
+CDR232,        232             /ASCII ^Z
+       ISZ CDRTIM      /THIS LOOP TAKES AT LEAST 100MS ON AN 8/E
+       JMP CDRGE1
+       DCA CDRCNT      /CLEAR COUNT IN CASE PARTIAL CARD READ (E.G. JAM)
+       JMP CDRGNC      /TIMED OUT - RESTART CARD
+
+CDRTM3,
+CDRTIM,        0               /TIMEOUT COUNTER
+CDRM27,        -27             /-27-3=-32 ^Z TEST
+CDRCNT,        -1              /MAIN COUNT
+CDRCT2,        -1              /215, 212 COUNT
+CDRPT, 0               /BUFFER POINTER
+CDRSW, 0               /SWITCH
+
+CDRABF,        CDRBUF-1-CDRLOC /MODIFIED LOCATIONS
+CDRTAD,        CDRTBL-CDRLOC
+CDRIN5,        CDRXIT-1-CDRLOC
+       $
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/CS.PA b/sw/os8/v3d/sources/system/dectapes/dectape3/CS.PA
new file mode 100644 (file)
index 0000000..6329fc3
--- /dev/null
@@ -0,0 +1,367 @@
+/4 OS/8 CASSETTE 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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+
+/      DEC-S8-UCASA-A-LA
+
+/      COPYRIGHT 1972
+
+/      DIGITAL EQUIPMENT CORPORATION
+
+/      MAYNARD MASSACHUSETTS   01754
+
+/      MOUTH/DORP
+
+       IFNDEF CODE <CODE=0>
+
+       KCLR=CODE^10+6700       /CLEAR ALL
+       KSDR=CODE^10+6701       /SKIP ON DATA FLAG
+       KSEN=CODE^10+6702       /SKIP ON ERROR
+       KSBF=CODE^10+6703       /SKIP ON READY FLAG
+       KLSA=CODE^10+6704       /LOAD STATUS A
+       KSAF=CODE^10+6705       /SKIP ON ANY FLAG OR ERROR
+       KGOA=CODE^10+6706       /ASSERT CONTENTS OF STATUS A AND XFER
+       KRSB=CODE^10+6707       /READ STATUS B
+
+       BSW=7002        /BYTE SWAP      [8/E,F ONLY]
+
+/REWIND=10
+/BACKFIL=30
+/WRGAP=40
+/BACKBLOCK=50
+/SKPFIL=70
+
+/SPECIAL CODES
+
+/      0       WRITE EOF
+/      1       REWIND
+/      2       BACKBLOCK
+/      3       SKIPFILE/BACKFILE
+
+/      4-7     UNUSED (TAKES LOW ORDER 2 BITS ONLY CURRENTLY)
+
+       VERSION="C&77
+\f      *0
+
+       -2              /THERE ARE TWO HANDLERS
+
+       2401
+       7001+CODE
+       0323
+       0160+CODE+CODE  /CSA0
+       270             /DEVICE CONTROL BLOCK (TYPE 27)
+       4000+7          /ENTRY POINT FOR CSA0
+       ZBLOCK 2
+
+       2401
+       7001+CODE
+       0323
+       0161+CODE+CODE  /CSA1
+       270
+       4000+1          /ENTRY POINT FOR CSA1
+       ZBLOCK 2
+\f      *200
+
+K3700, 3700            /MUST BE FIRST LOCATION ON PAGE
+UNIT,
+CSA1,  VERSION         /ENTRY POINT FOR CSA1
+       CLA             /PROTECT CODE AGAINST IGNORANT USERS
+       TAD CSA1        /PICK UP ARGUMENTS
+       DCA CSA0        /VIA CSA0
+       STL IAC RAL     /TAD (3         [8/I,L,E,F]
+       JMP .+3         /JOIN PROCESSING WITH UNIT 1
+CSA0,  VERSION         /ENTRY POINT FOR CSA0
+       STL CLA RTL     /TAD (2
+       BSW             /               [8/E,F]
+       DCA UNIT        /SAVE UNIT (0 IS 200, 1 IS 300)
+CS,    JMS T           /INITIALIZATION; REPLACED BY RDF
+       TAD KCIF        /FORM RETURN FIELD INSTRUCTION
+       DCA RETCIF      /STORE IN RETURN CODE
+       TAD I CSA0      /GET FUNCTION CONTROL WORD
+       DCA FUN         /SAVE IT
+       TAD FUN         /GET IT BACK AGAIN
+       AND K70         /ISOLATE FIELD OF BUFFER
+       TAD KCDF        /FORM CDF TO FIELD OF BUFFER
+       DCA BUFCDF      /STORE IN APPROPRIATE SPOT
+       ISZ CSA0        /POINT TO ARGUMENT 2
+       TAD I CSA0      /GET BUFFER ADDRESS
+       DCA BUFFER      /SAVE IT
+       ISZ CSA0        /POINT TO ARGUMENT 3
+       TAD I CSA0      /GET BLOCK NUMBER
+       ISZ CSA0        /POINT TO ERROR RETURN
+KCIF,  CIF CDF 0       /SEEK TEMPORARY SAFETY IN CURRENT DATA FIELD
+       SZA CLA
+       JMP NOT1ST      /NOT BLOCK 0
+       STL CLA RAR     /TAD (4000
+       AND FUN         /ISOLATE READ/WRITE BIT
+       TAD UNIT        /INSERT UNIT
+       JMS I QCAS      /CALL CASSETTE ROUTINE
+       REWIND-.        /TO PERFORM A REWIND/INITIALIZATION
+NOT1ST,        TAD FUN
+K200,  AND K3700       /ISOLATE NUMBER OF BLOCKS TO XFER
+       SNA
+       JMP SPCASE      /0 BLOCKS MEANS SPECIAL THING (EOF)
+RECLP, DCA BLKNT       /SET COUNT OF NUMBER OF BLOCKS
+       STL CLA RAR     /TAD (4000
+       AND FUN         /ISOLATE READ/WRITE BIT
+       TAD UNIT        /INSERT UNIT
+       JMS I QCAS      /CALL CASSETTE ROUTINE
+       RW-.            /TO INITIATE READ OR WRITE
+RETRY, SZA             /NON-ZERO AC MEANS ERROR
+       JMP RETCIF      /TOUGH LUCK BOOBIE - ERROR
+       TAD K7700       /GET READY TO XFER 100 DOUBLE WORDS
+       DCA DBWDCT      /SET DOUBLE WORD COUNTER
+       TAD BUFFER      /GET START OF BUFFER SEGMENT
+       DCA BPTR        /SET 'BPTR'
+BUFCDF,        HLT             /CHANGE TO DATA FIELD OF USER'S BUFFER
+       TAD FUN
+K7700, SMA CLA         /WHICH DIRECTION IS TRANSFER?
+       JMP READ        /WANT TO READ
+\fWRITE,        TAD I BPTR      /WANT TO WRITE, SO GET WORD FROM BUFFER
+       JMS I QGPCH     /WRITE
+       TAD I BPTR      /GET FIRST WORD AGAIN
+       AND P7400       /ISOLATE FIRST HALF OF BYTE 3
+       DCA T           /SAVE FOR FUTURE REFERENCE
+       ISZ BPTR        /POINT TO NEXT LOCATION IN BUFFER
+       TAD I BPTR      /GET SECOND WORD OF BUFFER PAIR
+       JMS I QGPCH     /WRITE BYTE #2
+       TAD I BPTR      /RETRIEVE WORD 2
+       AND P7400       /ISOLATE 2ND HALF OF BYTE #3
+       CLL RTR         /CREATE MYSTIC HIDDEN BYTE 3
+       RTR
+       TAD T           /GOOD THING I STILL HAVE THIS
+       CLL RTR
+       RTR
+       JMS I QGPCH     /WRITE BYTE #3
+       JMP COM
+\fREAD, JMS I QGPCH     /READ BYTE #1 OF TRIPLE
+       DCA I BPTR      /STORE IN WORD 1 OF BUFFER PAIR
+       JMS I QGPCH     /READ BYTE #2 OF TRIPLE
+       DCA T           /SAVE IT FOR POSTERITY
+       JMS I QGPCH     /READ BYTE #3 OF TRIPLE
+       RTL
+       RTL             /MYSTIC ROTATES
+       DCA T2
+       TAD T2
+       AND P7400       /AND MYSTIC CONSTANTS
+       TAD I BPTR      /FIX UP BUFFER WORD 1 OF PAIR
+       DCA I BPTR
+       TAD T2
+       RTL
+       RTL             /MORE ROTATION
+       AND P7400       /AND MORE
+       TAD T
+       ISZ BPTR        /POINT TO SECOND WORD OF BUFFER PAIR
+       DCA I BPTR      /STORE SECOND WORD
+COM,   ISZ BPTR        /POINT TO BEGIN OF NEXT BUFFER PAIR
+P7400, 7400            /PROTECTION AGAINST CORE WRAP AROUND
+       ISZ DBWDCT      /BUMP DOUBLE WORD COUNT
+       JMP BUFCDF      /REITERATE
+       JMS I QCAS      /CALL CASSETTE ROUTINE
+       CRC-.           /TO CHECK CRC
+       TAD BUFFER      /GET BUFFER SEGMENT ADDRESS
+       TAD K200        /ADD 200 TO GET TO NEXT SEGMENT
+       DCA BUFFER      /REPLACE
+       TAD BLKNT       /GET BLOCK COUNT
+       TAD K7700       /SUBTRAT 100
+       SZA             /ARE WE DONE?
+       JMP RECLP       /NO, REITERATE
+       ISZ CSA0        /POINT TO NORMAL GOOD RETURN
+RETCIF,        HLT             /RETURN TO USER'S DATA AND INSTRUCTION FIELDS
+       JMP I CSA0      /RETURN
+\f/     INTIALIZATION ROUTINE - ONCE ONLY CODE
+/              OVERLAID BY TEMPORARIES
+
+T,     0               /ENTRY POINT TO INITIALIZATION
+T2,    TAD KRDF        /REPLACE CALL BY RDF
+FUN,   DCA CS          /SO THAT WE'LL NEVER SEE YOU HERE AGAIN
+BUFFER,        TAD T           /CORRECT ADDRESS OF GPCH
+DBWDCT,        TAD KQX1        /BY ADDING IN CS+1
+QGPCH, DCA .           /STORE IT HERE
+BLKNT, STL CLA RTL     /CORRECT ADDRESS OF CAS IS 2 MORE
+       TAD QGPCH
+QCAS,  DCA .           /THAN GPCH.  STORE IT HERE.
+BPTR,  JMP CS          /RETURN TO MAIN PROGRAM
+KRDF,  RDF
+KQX1,  GPCH-CS-1
+
+SPCASE,        TAD FUN
+       AND L4003       /ISOLATE R/W BIT + SPECIAL CODE
+       TAD UNIT
+       JMS I QCAS
+       SPCODE-.
+       JMP RETCIF-1    /LEAVE GRACEFULLY
+K70,   70
+KCDF,  CDF 0
+L4003, 4003
+       PAGE
+\fGPCH, 0               /READ OR WRITE A BYTE
+       JMP AROUND      /GO TO REAL LOCATION OF THIS SUBROUTINE
+CAS,   0               /MUST BE AT GPCH+2; DO CASSETTE STUFF
+       DCA TEMP        /SAVE ARGUMENT IN AC
+       CDF 0
+       TAD I CAS       /GET UNRELOCATED RELATIVE LOCAL ENTRY POINT
+       TAD CAS         /RELOCATE IT
+       ISZ CAS         /POINT TO NORMAL RETURN LOCATION
+       DCA GPCH        /SAVE ENTRY POINT IN TEMPORARY
+       JMP I GPCH      /GO TO CORRECT ENTRY POINT
+
+RW,    TAD CAS
+       DCA RTRY        /SAVE RETRY ADDRESS
+       TAD TEMP        /GET ARGUMENT PASSED VIA AC
+       DCA FNUNIT      /SAVE
+       CLL STA RTL     /TAD (7775
+       DCA ERKNT       /SET ERROR COUNT TO -3
+ERETRY,        TAD FNUNIT
+       SPA
+       TAD (20         /READ CODE IS 0; WRITE IS 20
+       KLSA            /LOAD STATUS A
+       TAD FNUNIT      /***KLSA CLEARS BIT 0
+       SMA CLA         /READS HAVE TO BE INITIATED
+       JMS CWAIT       /READ
+       JMP I RTRY      /RETURN
+
+AROUND,        DCA TEMP
+       TAD FNUNIT
+       SMA CLA
+       JMP RDCHAR      /READ
+       TAD TEMP        /WRITE
+       JMS CWAIT
+       JMP I GPCH      /RETURN
+
+RDCHAR,        JMS CWAIT
+       TAD TEMP        /GET CHAR JUST READ
+       JMP I GPCH      /RETURN WITH IT IN AC
+\fCRC,  TAD FNUNIT
+       TAD (60
+       KLSA            /INITIATE READ/WRITE CRC
+       TAD FNUNIT      /***KLSA CLEARS BIT 0
+       SMA CLA
+       JMS CWAIT       /HAVE TO READ TWICE
+       JMS CWAIT       /WRITE CRC WRITES BOTH
+       KCLR            /WHY NOT?
+       JMP I CAS       /RETURN
+
+REWIND,        TAD (10
+       JMS UTIL
+       TAD TEMP
+       SMA CLA
+       JMP I CAS       /MERELY REWIND IF READING
+       JMP EOF
+SKIPF, TAD (20
+BACKBL,        TAD (10
+EOF,   TAD (10
+BACKF, TAD (30
+       JMS UTIL
+       JMP I CAS       /RETURN
+
+UTIL,  0
+       TAD TEMP
+       KLSA
+TRYAGN,        KGOA
+       JMS CTCTST
+       KSBF            /WAIT FOR READY
+       JMP .-2
+       KRSB
+       AND (10
+       SZA CLA
+       JMP TRYAGN      /KEEP TRYING IF ERROR CAUSED BY DRIVE EMPTY
+       JMP I UTIL
+
+TEMP,  0
+ERKNT, 0
+FNUNIT,        0
+RTRY,  0
+
+SPCODE,        TAD TEMP
+       AND (3
+       TAD (JMP TABLE
+       DCA J
+       TAD TEMP
+       AND (4300
+       DCA TEMP
+J,     HLT
+TABLE, JMP EOF         /0 WRITE EOF
+       JMP REWIND      /1 REWIND AND WRITE EOF IF BIT 0=1
+       JMP BACKBL      /2 BACK BLOCK
+       TAD TEMP        /3 SKIP/BACK FILE DEPENDING ON BIT 0
+       SMA CLA
+       JMP SKIPF       /FORWARD FILE
+       JMP BACKF       /BACK FILE
+\fCWAIT,        0
+       KGOA            /ASSERT CONTENTS OF STATUS A
+       DCA TEMP        /SAVE ANYTHING READ
+       JMS CTCTST
+       KSAF
+       JMP .-2         /WAIT FOR SOMETHING TO HAPPEN
+       KSEN            /WAS IT AN ERROR?
+       JMP I CWAIT     /NO, SO RETURN
+ERR,   DCA TEMP        /YES ... ERROR
+       KRSB
+       AND (30
+       SNA
+       JMP .+3
+       AND (20
+       JMP I RTRY      /END OF FILE IS SOFT ERROR
+       ISZ ERKNT       /SHALL WE TRY AGAIN?
+       JMP .+3         /YES
+       STL CLA RAR     /TAD (4000
+       JMP I RTRY      /RETURN WITH NON-ZERO AC
+       TAD FNUNIT      /RETRY
+       TAD (50         /BUT FIRST DO BACKSPACE BLOCK GAP
+       JMS UTIL
+       JMP ERETRY
+
+CTCTST,        0               /TEST FOR CONTROL/C
+L7600, 7600
+       TAD L7600
+       KRS
+       TAD (-7603
+       SNA CLA
+       KSF
+       JMP I CTCTST
+       CIF CDF 0
+       JMP I L7600     /RETURN TO OS/8
+       $
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/DUMP.PA b/sw/os8/v3d/sources/system/dectapes/dectape3/DUMP.PA
new file mode 100644 (file)
index 0000000..07c81c1
--- /dev/null
@@ -0,0 +1,385 @@
+/8     DUMP LPT HANDLER FOR OS/8
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/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 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-S8-UCASA-A-LA
+
+/      COPYRIGHT 1972
+
+/      DIGITAL EQUIPMENT CORPORATION
+
+/      MAYNARD MASSACHUSETTS   01754
+
+/      MOUTH/DORP
+
+       IFNDEF CODE <CODE=0>
+
+       KCLR=CODE^10+6700       /CLEAR ALL
+       KSDR=CODE^10+6701       /SKIP ON DATA FLAG
+       KSEN=CODE^10+6702       /SKIP ON ERROR
+       KSBF=CODE^10+6703       /SKIP ON READY FLAG
+       KLSA=CODE^10+6704       /LOAD STATUS A
+       KSAF=CODE^10+6705       /SKIP ON ANY FLAG OR ERROR
+       KGOA=CODE^10+6706       /ASSERT CONTENTS OF STATUS A AND XFER
+       KRSB=CODE^10+6707       /READ STATUS B
+
+       BSW=7002        /BYTE SWAP      [8/E,F ONLY]
+
+/REWIND=10
+/BACKFIL=30
+/WRGAP=40
+/BACKBLOCK=50
+/SKPFIL=70
+
+/SPECIAL CODES
+
+/      0       WRITE EOF
+/      1       REWIND
+/      2       BACKBLOCK
+/      3       SKIPFILE/BACKFILE
+
+/      4-7     UNUSED (TAKES LOW ORDER 2 BITS ONLY CURRENTLY)
+
+\f/     EDIT HISTORY:
+
+/      1976            S.R.    ORIGINALLY WRITTEN
+/      19-MAR-77       S.R.    FIXED BUG WITH BUFFER ENDING AT 7777
+
+       *0
+
+       -1
+       DEVICE DUMP;DEVICE DUMP;1360;DUMP&177+4000;ZBLOCK 2
+
+       DMPVER="C&77
+\f      *200
+
+LINK,  0               /POINTS TO 'LINC' ON NEXT PAGE
+       TAD I DUMP      /GET FUNCTION CONTROL WORD
+       DCA FNWD
+       ISZ DUMP        /POINT TO BUFFER STARTING ADDRESS
+       TAD I DUMP      /GET BUFFER STARTING ADDRESS
+       DCA BUFFER
+       ISZ DUMP        /POINT TO STARTING BLOCK #
+       TAD I DUMP      /GET STARTING BLOCK NUMBER
+       DCA BLOCK       /SAVE IT IN 'BLOCK'
+       ISZ DUMP        /POINT TO  USER'S ERROR RETURN
+       RDF
+       TAD KCIDF       /FOR 'CIF CDF' TO USER'S FIELD
+       DCA DMPRET      /NEED IT TO RETURN TO HIM LATER
+       TAD FNWD        /LOOK AT FUNCTION WORD
+       SMA             /BIT 0 IS READ/WRITE BIT
+       JMP ERRET       /TAKE FATAL ERROR IF GUY TRIED TO
+                       /READ FROM 'DUMP'
+       AND L3700
+       CLL RTR
+       SNA
+       JMP CLOSE       /0 PAGES MEANS PERFORM CLOSE
+                       /OPERATION, GO AWAY
+       CIA             /STORE AWAY NEGATIVE OF
+                       /NUMBER OF LINES TO DUMP
+       DCA KNT
+       TAD FNWD        /LOOK SOME MORE AT ALL-IMPORTANT
+                       /FUNCTION WORD
+L374,  AND L70         /ISOLATE FIELD OF BUFFER
+       TAD KCDF        /FORM 'CDF' TO FLD OF BUFFER
+       DCA .+1         /STORE IT IN NEXT LOCATION
+FNWD,
+BPTR,  HLT             /CHANGE DATA FIELD TO FLD OF BUFFER
+B,     TAD M40
+       DCA RKNT
+       JMS I LINK
+       TAD LOW-200
+       CIA CLL
+       TAD BLOCK
+       SZL CLA
+       TAD KLLS
+       JMS I LINK
+       DCA LPUT+1-200
+       TAD BLOCK
+       JMS I LINK
+       JMP BLK-200
+       JMS I LINK
+       JMP CRLF-200
+A,     JMS INIT
+       TAD RKNT
+       TAD L40         /MUST BE REAL 40
+       JMS I LINK
+       JMS PRINT-200
+       TAD KSLASH
+       JMS I LINK
+       JMP SPACE-200
+C,     TAD I BPTR      /GET WORD FROM BUFFER
+       JMS I LINK
+       JMS PRINT-200   /PRINT IT IN OCTAL ON LIST DEVICE
+       ISZ BPTR        /POINT TO NEXT WORD IN BUFFER
+       NOP             /V3D
+       ISZ CKNT        /DONE WITH THIS ROW?
+       JMP C           /NO, GO PRINT NEXT WORD
+       JMS I LINK
+       JMP SPACE-200
+       JMS INIT
+D,     TAD I BPTR
+       RTR
+       RTR
+       RTR
+       JMS I LINK
+       JMP PUT6-200
+       TAD I BPTR
+       JMS I LINK
+       JMP PUT6-200
+       ISZ BPTR        /POINT TO NEXT WORD IN BUFFER
+       NOP             /V3D
+       ISZ CKNT        /DONE WITH THIS ROW?
+       JMP D           /NO, GO ON TO NEXT WORD
+       JMS I LINK
+       JMP SPACE-200
+       JMS INIT
+E,     TAD I BUFFER    /GET WORD 1 OF PAIR
+       JMS I LINK
+       JMP PUTSAV-200  /PUT OUT THE CHAR AND SAVE THE WORD
+       ISZ BUFFER      /POINT TO WORD 2 OF PAIR
+       TAD I BUFFER    /GET WORD 2 OF PAIR
+       JMS I LINK
+       JMP PUTSAV-200
+       ISZ BUFFER      /POINT TO BEGIN OF NEXT PAIR
+       JMS I LINK
+       JMP THIRD-200   /PRINT THIRD CHAR FROM
+                       /REMEMBRANCES OF LAST TWO
+       ISZ CKNT
+       ISZ CKNT        /DONE WITH THIS ROW?
+       JMP E           /NO, GO ON TO NEXT PAIR
+       JMS I LINK      /YES
+       JMP CRLF-200    /PRINT CARRIAGE RETURN/LINE FEED
+       ISZ KNT         /DONE WITH BUFFER YET?
+       SKP             /NO
+       JMP OKRET       /YES
+       ISZ RKNT        /DONE WITH LAST ROW OF PAGE?
+       JMP A           /NO, GO ON TO NEXT ROW IN SAME PAGE
+       ISZ BLOCK       /BUMP BLOCK NUMBER BY 1
+       JMP B           /GO DUMP THE NEXT PAGE
+\fCLOSE,        STA             /-1 CHANGES CR TO FORM FEED
+       JMS I LINK
+       JMP CRLF-200
+OKRET, ISZ DUMP        /POINT TO NORMAL RETURN
+M40,   SMA SZA CLA     /AC 0 SO ALWAYS SKIPS
+ERRET, STL CLA RAR     /FATAL ERROR HAS AC NEGATIVE
+DMPRET,        HLT             /PERFORM 'CIF CDF' TO USER'S FIELD
+       JMP I DUMP      /RETURN
+
+INIT,  0
+       TAD M10
+       DCA CKNT
+       TAD BUFFER
+       DCA BPTR
+       JMP I INIT
+
+KSLASH,        57-40
+KCIDF, CIF CDF 0
+KCDF,  CDF 0
+M10,   -10
+L40,   40              /MUST BE REAL 40
+L3700, 3700
+BUFFER,        0
+RKNT,  0               /ROW COUNT
+CKNT,  0               /COLUMN COUNT
+BLOCK, 0               /CURRENT BLOCK NUMBER
+KLLS,  LLS
+       IFZERO .-375&4000 <ERROR>
+       *374
+L70,   70              /MUST BE AT REL LOC 174
+KNT,   0               /- NUMBER OF PAGES LEFT TO DUMP
+       IFNZRO L70-374 <ERROR>
+DUMP,  DMPVER
+       JMS LINK        /GET ADDRESS OF NEXT PAGE INTO LINK
+       IFNZRO .-400 <ERROR>
+       PAGE
+\f      LSF=6661        /SLIP ON LPT FLAG
+       LLS=6666        /LOAD LPT BUFFER
+
+       IFDEF   DMPTTY  <
+       LSF=TSF
+       LLS=TLS
+       >
+
+LINC,  0
+       DCA ARG
+       RDF
+       TAD HCDF
+TTY12, DCA TEMP
+HCDF,  CDF 0
+       TAD I LINC
+       DCA DOIT
+       ISZ LINC
+L77,   77
+TEMP,  0
+       TAD ARG
+CNT,
+DOIT,  HLT
+POP,   JMP I LINC      /RETURN
+L177,  177
+       IFNZRO  POP&177-15 <ERROR> /MUST BE AT 15 IN PG
+       IFNZRO DOIT&177-14 <ERROR>
+       IFNZRO TEMP&177-12 <ERROR>
+
+THIRD, TAD SAVE
+       DCA ARG
+       TAD ARG
+PUTSAV,        AND L7600
+       CLL RAL
+       TAD SAVE
+       RTL
+       RTL
+       AND L177
+       DCA SAVE
+       TAD ARG
+       AND L177        /FORCE 7-BIT
+       TAD M140        /DO RANGE CHECK
+       CLL
+       TAD (100        /FOR BETWEEN 40 AND 137
+       SNL             /SKIP ON SUCCESS
+TTY40,
+M140,  SZA CLA         /NEVER SKIPS
+PUTSPC,        TAD TTY40       /RESTORE CHAR OR BLANK
+PUTPOP,        JMS LPUT
+TTY215,        JMP POP
+\fLPUT, 0
+       NOP             /THIS MAY BE AN 'LLS' OR 0
+L7600, 7600            /CLA
+KBD,   KSF
+       JMP CHECKL
+       TAD L7600
+       KRS
+       TAD (-7603
+       SNA CLA
+       JMP CTRLC
+       KRB
+       TLS
+       AND L177
+       TAD (-15
+       SNA
+       JMP CR
+       TAD (15-70
+       CLL
+       TAD (10
+       DCA TEMP
+       SNL
+       JMP NOT         /NOT A DIGIT
+       TAD NUM
+       CLL RAL
+       CLL RAL
+       CLL RAL
+       TAD TEMP
+       DCA NUM
+       JMP CHECKL
+CTRLC, CIF CDF 0
+       JMP I L7600
+CR,    TAD NUM
+       DCA LOW
+       TAD (12-77
+NOT,   TAD L77
+       TSF
+       JMP .-1
+XTRA,  TLS
+       CLA
+       DCA NUM
+CHECKL,        LSF
+       JMP KBD
+       JMP I LPUT      /YES, RETURN
+NUM,   0
+LOW,   0
+\fPUT6, TAD TTY40
+       AND L77
+       JMP PUTSPC
+
+PRINT, 0
+       DCA ARG
+       TAD TTY40
+       JMS LPUT
+       TAD (-4
+       DCA CNT
+PRLUP, TAD ARG
+       AND L7600
+       CLL RTL
+       TAD L214        /14 SHIFTS TO 60 
+                       /AND L214 HAS AC0 = 0
+       RTL
+       JMS LPUT
+       TAD ARG
+       RTL
+       RAL
+       DCA ARG
+       ISZ CNT         /BUG IF TRY TO USE AS L214
+       JMP PRLUP
+       JMP I PRINT
+L214,  214             /COULD BE 'AND CNT'
+
+SAVE,  0               /MUST BE DEDICATED.  USED AS SHIFT
+                       /REG AND MUST BE ALMOST 0 ON ENTRY
+\fARG,  0
+
+SPACE, TAD TTY40
+       JMS LPUT
+       JMP PUTSPC
+
+BLK,   SNA CLA
+       DCA LOW         /BLOCK 0 INITIALIZATION
+       TAD L214        /FORM FEED
+       JMS LPUT
+       TAD ARG
+       JMS PRINT
+/      TAD (-10
+/      DCA TEMP
+/      TAD TTY3
+/      JMS SPACE
+/LUP,  TAD TEMP
+/      TAD (10         /MUST BE REAL 10
+/      JMS PRINT
+/      ISZ TEMP
+/      JMP LUP
+CRLF,  TAD TTY215
+       JMS LPUT
+       TAD TTY12
+       JMP PUTPOP
+       PAGE
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/INTEGR.SB b/sw/os8/v3d/sources/system/dectapes/dectape3/INTEGR.SB
new file mode 100644 (file)
index 0000000..3b92c40
--- /dev/null
@@ -0,0 +1,347 @@
+/INTEGER MATH PACKAGE                         OS8 FORTRAN II LIBRARY
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/     VERSION 5A
+/      APRIL 28, 1977
+/      VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
+/
+/
+       ENTRY   IREM
+       ENTRY   IABS
+       ENTRY   DIV
+       ENTRY   MPY
+       ENTRY   IRDSW
+       ENTRY   CLEAR
+       ENTRY   SUBSC
+
+/THE FOLLOWING DEFINITIONS ARE TO 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
+
+       LAP             /LV AUTO PAGING FOR PAL-III LIKE CODE
+
+AC,    0               /LOCATIONS USED BY MPY & DIV
+MQ,    0
+SIGN,  0
+CTR,   0
+LOC,   0
+SAV,   0
+
+MPY,   BLOCK   1
+       5               /INTEGER MULTIPLY SUBROUTINE
+       DCA     MQ      / CALL 1,MPY
+       TAD     MPY     / ARG <NUMBER>
+       DCA     MPY1
+MPY1,  NOP             /REPLACED BY CDF
+       TADI    MPY#
+       INC     MPY#
+       DCA     MPY2
+       TADI    MPY#
+       INC     MPY#
+       DCA     DIV
+MPY2,  NOP             /REPLACED BY CDF
+       TADI    DIV
+       JMS     MPYSB
+       RETRN   MPY
+
+MPYSB, 0               /INTERNAL MULTIPLICATION SUBR
+       DCA     DIV
+       TAD     (-14
+       DCA     CTR
+BACK,  CLL RAL
+       DCA     AC
+       TAD     MQ
+       CLL RAL
+       DCA     MQ
+       SZL
+       TAD     DIV
+       TAD     AC
+       ISZ     CTR
+       JMP     BACK
+       JMPI    MPYSB
+/
+       CPAGE   4
+DIVZA, DIVZ
+DVERR, 4411                    /"DIVZ" ERROR
+       2632
+DIV,   BLOCK   1
+       5               /INTEGER DIVIDE SUBROUTINE
+       SMA             / CALL 1,DIV
+       JMP     AD1     / ARG <DIVISOR>
+       INC     SIGN
+       CIA
+AD1,   DCA     MQ
+       DCA     CTR
+       TAD     DIV
+       DCA     DIV1
+DIV1,  NOP             /REPLACED BY CDF
+       TADI    DIV#
+       INC     DIV#
+       DCA     DIV2
+       TADI    DIV#
+       INC     DIV#
+       DCA     MPY
+DIV2,  NOP
+       TADI    MPY
+       SNA
+       JMPI    DIVZA        /ATTEMPTING TO DIVIDE BY ZERO
+       SMA
+       JMP     LOOP1
+       INC     SIGN
+       CIA
+LOOP1, CLL RAL
+       INC     CTR
+       SMA
+       JMP     LOOP1
+       CLL RAR
+       DCA     LOC
+       TAD     LOC
+       CIA
+       DCA     MPY
+       TAD     CTR
+       CMA
+       DCA     CTR
+       TAD     CTR
+       DCA     SAV
+       DCA     AC
+       TAD     MQ
+LOOP2, TAD     MPY
+LOOP3, ISZ     CTR
+       SKP
+       JMP     DONE
+       STL
+       SPA
+       CLL
+       DCA     MQ
+       TAD     AC
+       RAL
+       DCA     AC
+       TAD     MQ
+       CLL RAL
+       SNL
+       JMP     LOOP2
+       TAD     LOC
+       JMP     LOOP3
+DONE,  CLA
+       TAD     SIGN
+       RAR
+       CLA
+       DCA     SIGN
+       TAD     AC
+       SZL
+       CIA
+       RETRN   DIV
+
+IREM,  BLOCK   1
+       5               /INTEGER REMAINDER SUBROUTINE
+       CLA             / CALL 1,IREM
+       INC     IREM#   / ARG <UNUSED VARIABLE>
+       INC     IREM#
+       INC     SAV     /IREM MUST HAVE AN ARGUMENT
+       TAD     MQ      /BECAUSE IT IS A FUNCTION.
+       SPA             /IREM CAN BE CALLED ONLY ONCE
+       TAD     LOC     /AFTER EACH DIVISION ...
+       SKP             /SUBSEQUENT CALLS WILL RETURN ZERO.
+LOP,   CLL RAR
+       ISZ     SAV
+       JMP     LOP
+       RETRN   IREM
+/
+       PAGE
+\f
+IABS,  BLOCK   1
+       5               /INTEGER ABS VALUE FUNCTION
+       TAD     IABS    / CALL 1,IABS
+       DCA     IAB1    / ARG <INTEGER VARIABLE>
+IAB1,  NOP
+       TADI    IABS#
+       INC     IABS#
+       DCA     IAB2
+       TADI    IABS#
+       INC     IABS#
+       DCA     IRDSW
+IAB2,  NOP             /CDF TO ARGUMENT FIELD
+       TADI    IRDSW
+       SPA
+       CIA
+       RETRN   IABS
+
+IRDSW, BLOCK   1
+       5               /READ SWITCH REGISTER FUNCTION
+       CLA OSR
+       INC     IRDSW#
+       INC     IRDSW#
+       RETRN   IRDSW
+
+DIVZ,   CALL    1,ERROR        /ZERO DIVIDE ERROR
+        ARG     DVERR
+       CLA CLL CMA RAR
+        RETRN   DIV
+
+/THE FLOATING POINT CLEAR ROUTINE WAS ADDED TO "INTEGR"
+/SO THAT PROGRAMS WHICH DO NOT USE FLOATING POINT MATH
+/CAN RUN WITHOUT LOADING THE F.P. MATH PACKAGE.
+
+CLEAR, BLOCK   1
+       5               /FLOATING POINT CLEAR FUNCTION
+       DCA     IRDSW
+       DCA     ACH
+       DCA     ACM
+       DCA     ACL
+       TAD     IRDSW
+       RETRN   CLEAR
+
+\f
+/ THE FOLLOWING CAN BE USED FOR DOUBLY OR SINGLY
+/ SUBSCRIPTED ARRAYS.  ON ENTRY THE AC SHOULD BE
+/ NEGATIVE FOR FLOATING POINT VARIABLES.  THIS MAY
+/ BE ANY NEGATIVE NUMBER FOR SINGLY SUBSCRIPTED
+/ VARIABLES, AND MUST BE THE FIRST DIMENSION FOR
+/ DOUBLY SUBSCRIPTED VARIABLES.  SOME EXAMPLES
+/ FOLLOW:      (TO LOAD THE I,JTH ELEMENT OF AN FP ARRAY)
+
+/      TAD (-M         /DIMENSIONS ARE M BY N
+/      CALL 3,SUBSC
+/      ARG J
+/      ARG I
+/      ARG ARRAY
+/      LOC             /MUST BE A DUMMY VARIABLE
+/      CALL 1,IFAD
+/      ARG LOC
+
+/ TO LOAD THE JTH ELEMENT OF AN INTEGER ARRAY:
+
+/      CALL 2,SUBSC
+/      ARG J
+/      ARG INTARR
+/      LOC             /STILL A DUMMY VARIABLE
+/      TAD I LOC
+
+
+S1,    BLOCK 1         /ADDR OF 1ST SUBSC
+S2,    BLOCK 1         /ADDR OF 2ND SUBSC
+A,     BLOCK 2         /ADDR OF ARRAY
+R,     BLOCK 1         /ADDR FOR RESULT
+TM,    0
+FL,    0               /DOUBLE SUBSC FLAG
+N,     0               /DIMENSION -- NEGATIVE IF FLOATING
+MQA,   MQ              /FOR INDIRECT DCA
+
+SUBSC, BLOCK   1
+       5                       /FORTRAN SUBSCRIPTING ROUTINE
+       DCA N           /SAVE THE DIMENSION
+       TAD N
+       SPA             /... ALSO ABS VALUE
+       CMA
+       DCAI MQA        /WARNING **THIS ASSUMES DF=CURR FIELD**
+       CLA CLL CMA RAL /HOW MANY ARGS?
+       TAD SUBSC#
+       DCA 10
+       TAD SUBSC
+       DCA SUB1
+SUB1,  NOP             /REPLACED BY CDF
+       TADI 10
+       AND (100
+       SNA CLA         /DOUBLE SUBSCRIPTS?
+       JMP SB0
+       TADI 10         /YES, PICK UP ARGS...
+       DCA SB2
+       TADI 10
+       DCA S2
+       CMA
+SB0,   DCA FL          /SET DBL SUBSC FLAG
+       TADI 10
+       DCA SB1
+       TADI 10
+       DCA S1
+       TADI 10
+       DCA A
+       TADI 10
+       DCA A#
+       TAD SUBSC
+       DCA SUB2
+       TADI 10
+       DCA R
+       TAD 10
+       IAC
+       DCA SUBSC#
+       ISZ FL          /DBL SUBSCRIPTING?
+       JMP SB1
+       CLA CMA         /GET THE 2ND SUBSC
+SB2,   NOP             /CDF TO FIELD OF 2ND SUBSCRIPT
+       TADI S2
+       SZA             /IS IT A 1?
+       JMSI MPYSBA     /NO, MULTIPLY BY DIMENSION
+SB1,   NOP             /CDF TO FIELD OF 1ST SUBSCRIPT
+       TADI S1
+       TAD (-1         /MINUS ONE
+       DCA TM
+SUB2,  NOP             /REPLACED BY CDF
+       TAD A
+       DCAI R
+       INC R
+       TAD N
+       SPA CLA         /FIXED OR FLOATING
+       TAD TM
+       CLL RAL
+       TAD TM
+       TAD A#
+       DCAI R
+       STL CLA RTL     /FAST 'RETRN SUBSC'
+       TAD     SUBSC
+       DCA     SUB3
+SUB3,  NOP             /REPLACED BY 'CDF CIF'
+       JMPI    SUBSC#
+
+MPYSBA,        MPYSB
+
+       END
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/IOH.SB b/sw/os8/v3d/sources/system/dectapes/dectape3/IOH.SB
new file mode 100644 (file)
index 0000000..b7f4528
--- /dev/null
@@ -0,0 +1,921 @@
+/IOH SUBROUTINE                     OS8 FORTRAN II LIBRARY
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/     VERSION 10A
+/      APRIL 28,1977
+/      INPUT OUTPUT CONVERSION SUBROUTINE
+/      FOR 8K ALICS-FORTRAN SYSTEM
+/      VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
+/
+       ABSYM SACH 23           /SAVE FPAC FOR MANIPULATION OF AC
+       ABSYM SACM 24
+       ABSYM SACL 25
+       ABSYM N2 175            /LAST ACCUMULATED NUMBER
+       ABSYM ARGUMT 176
+       DUMMY   ARGUMT
+       DUMMY   FPNT
+       ENTRY   READ
+       ENTRY   WRITE
+       ENTRY   IOH
+/
+/      THE FOLLOWING IS NECESSARY BECAUSE CERTAIN SUBROUTINES SKIP
+/
+       OPDEF TADI 1400
+       OPDEF DCAI 3400
+       OPDEF ANDI 0400
+       OPDEF JMPI 5400
+       OPDEF JMSI 4400
+       OPDEF ISZI 2400
+       SKPDF JMSKP 4000
+       LAP
+
+/
+A2,    BLOCK   14
+/
+/      IOH ERROR ROUTINES
+/
+ERRNO, BLOCK   1
+ERR2,  ISZ     WHI     /SEE IF THIS WAS I FORMAT OR THE EXPONENT
+ERR3,  ISZ     ERRNO   /IN E FORMAT
+       ISZ     ERRNO
+       SKP
+ERR1,  ISZ     DV      /ERR1 IS ALWAYS FATAL
+       CLA
+       TAD     DV
+       SNA CLA         /WAS THIS AN INPUT ERROR FROM THE TELETYPE?
+       CLA CLL CML RAR         /YES - NON-FATAL
+       TAD     (615
+       DCA     IO
+       TAD     ERRNO           /IOH ERROR NUMBER
+       TAD     (2461           /MAKE INTO BCD
+       DCA     SW              /TO ERROR COMMENT
+       CALL    1,ERROR
+       ARG     IO
+
+       JMP     RETRY           /DO ENTIRE READ STATEMENT OVER
+DV,    0                       /SAVE DEVICE CODE
+CS,    A2                      /INITIAL PUSH POINTER
+PARN,  0
+       NOP             /CDF N
+       TADI    WRITE#
+       INC     WRITE#
+       JMP I   PARN
+CH,    0
+TW,    12
+READ,  BLOCK 1
+       10                      /ENTRY POINT FOR READ
+RETRY, TAD     READ            /SNEAK IN
+       DCA     WRITE
+       TAD     READ#
+       DCA     WRITE#          /SAVE SECOND RETURN WORD
+       JMP     ET
+       CPAGE 4
+IO,    0
+SW,    0                       /LEFT OR RIGHT HALF OF FORMAT
+WRITE, BLOCK 1
+       10                      /ENTRY POINT
+       CLA IAC                 /INITIALIZE SWITCH
+ET,    DCA     IO
+       DCA     CH              /CLEAR CHARACTER
+       DCA     ERRNO           /ZERO ERROR NUMBER IN CASE ERROR RESTART
+       TAD     WRITE
+       DCA     PARN#
+       JMS     PARN
+       DCA     DEVNO1
+       JMS     PARN
+       DCA     7
+DEVNO1,        NOP             /CDF N
+       CLA CMA
+       TADI    7               /PICK UP DEVICE NUMBER
+       CLL RTR                 /ROTATE IT INTO BITS 0-3
+       RTR
+       RAR
+       DCA     DV
+       TAD     CS              /INITIALIZE PUSH STACK
+       DCA     PUSH            /-
+       JMS     PARN
+       DCA     FPNT01
+       JMS     PARN
+       DCA     FPNT
+       CLA IAC         /SET UP "SW" TO START FORMAT
+       DCA     SW      /FROM SECOND CHARACTER (FIRST IS LPAREN)
+       DCA     BA      /ZAP END-OF-LINE SWITCH
+       TAD     PENTER  /FAKE RE-ENTRY TO SET UP FIRST LPAREN
+       DCA     GLST    /ON PUSHDOWN STACK
+       RETRN   WRITE
+PENTER,        FENTER
+
+FPNT,  0
+GFRM,  0
+       TAD     SW
+       INC     SW
+       CLL RAR
+       TAD     FPNT            /FORM ADDRESS IN AC AND LEFT/RIGHT
+       DCA     7               /SWITCH IN LINK
+FPNT01,        NOP                     /CDF N
+       TADI    7
+       SZL                     /LEFT OR RIGHT?
+       JMP     HR
+       RTR
+       RTR
+       RTR
+HR,    AND     (77
+       JMP I   GFRM
+       CPAGE   5
+       0               /I1000
+       0               /I100
+       0               /I10
+I1,    0               /I1
+       4000
+SV,    BLOCK 3         /FLOATING POINT TEMPORARY
+       CPAGE 3
+TN,    2045            /10.0
+       0
+       0
+\f      PAGE            /EXPERIMENTAL
+RETN,  DCA     SACH            /SET SACH TO 0
+RTUR,  JMS     GFRM            /GET NEXT CHAR IN FORMAT
+       CPAGE 24
+       JMS     CHTYPE  /CLASSIFY FORMAT CHARACTER
+       DG              /DIGIT EXIT
+       -57;    SL
+       -56;    PER
+       -54;    CM
+       -51;    RPAR
+       -50;    LP
+       -47;    QT
+       -40;    RTUR
+       0;      SVCHR
+SVCHR, DCA     CH
+       JMS     NU              /GET THE ACCUMULATED NUMBER
+       CMA                     /KRONK IT
+       DCA     N1              /AND SAVE       COUNT FOR ALL CONVERSIONS
+       TAD     CH
+       AND     (7757
+       TAD     (7770           /THIS TESTS IF CH IS AN ,X, OR ,H,
+       SNA CLA
+CM,    JMS     PR              /IT WAS , PROCESS IT
+       JMP     RETN            /NOT X OR H, KILL NUMBER AND TRY AGAIN
+N1,    0
+
+SL,    JMS     PR              /GO PROCESS THE PREVIOUS ITEM (IF ANY)
+       JMS     EJ
+       JMP     RETN
+QT,    JMS     PR              /PROCESS PREVIOUS ITEM, IF ANY
+QT1,   JMS     GFRM
+       TAD     (-47
+       SNA                     /ANOTHER QUOTE?
+       JMP     RETN
+       TAD     (47
+       JMS     PRINT           /PRINT CHAR
+       JMP     QT1
+DG,    JMS     DGT             /ACCUMULATE DIGIT INTO SACH
+       JMP     RTUR            /TRY ANOTHER CHARACTER
+LP,    ISZ     PUSH            /LEFT PAREN
+       CLA CMA                 /COUNT NESTING DEPTH, NEGATIVE
+       TAD     NPAR
+       DCA     NPAR
+       TAD     SW              /PICK UP THE FORMAT POINTER
+       DCA I   PUSH            /CRAM IT INTO THE LIST
+       ISZ     PUSH            /KICK AGAIN
+       JMS     NU              /THERE MAY BE AN ACCUMULATED NUMBER
+       CIA                     /SAVE NUMBER
+       DCA I   PUSH            /*
+       CLA CLL CML RTL         /HERE WE SEE IF THIS IS A POSSIBLE
+       TAD     NPAR            /RESTART POINT
+       SPA CLA                 /IF FIRST SAVE SW IN S1
+       JMP     RETN            /NOPE- FORGET IT
+       TAD     SW              /YES--FIRST CRAM FORMAT---
+       DCA     S1              /---INTO SAVE1
+       TAD I   PUSH            /AND THAT STUFF IN THE LIST---
+       DCA     S2              /---GOES INTO SAVE 2
+       JMP     RETN            /READY FOR ANYTHING, HERE WE GO
+PUSH,  0               /PARENTHESIS PUSHDOWN LIST POINTER
+
+RPAR,  JMS     PR              /PROCESS PREVIOUS ITEM, IF ANY
+       ISZ I   PUSH
+       JMP     TR
+       CLA CLL CMA RAL         /-2
+       TAD     PUSH            /DELETE THIS ITEM FORM THE LIST
+       DCA     PUSH            /PUSH = PUSH-2
+       ISZ     NPAR            /NPAR = NPAR +1 ]-1[ SINCE MINUS COUNT
+       JMP     RETN
+       JMS     WH              /THIS PAREN WAS THE BALANCING PAREN
+       TAD     S1              /GET THE FORMAT POINTER OF THE--
+       DCA     SW              /RESTART POINT AND CRAM IT
+       TAD     S2              /GET SWITCH AND THE COUNT
+       CIA
+FENTER,        DCA     SACH
+       CLA CMA
+       TAD     SW              /TEST TO SEE IF SW IS ORIGINAL POINTER
+       SNA CLA
+       JMP     L2              /YES - FAKE A RESTART
+       ISZ     PUSH            /NO - PUSH ORIGINAL POINTER
+       CLA IAC                 /SINCE WE ARE RETURNING TO DEPTH 2
+       DCA I   PUSH
+       ISZ     PUSH
+       CLA CMA                 /SET COUNT = 1, SWITCH = 1
+       DCA I   PUSH
+       CMA
+L2,    DCA     NPAR            /PARNRN = -1
+       JMP     LP
+
+TR,    CLA CMA                 /GET OUT THE FORMAT POINTER--
+       TAD     PUSH            /*
+       DCA     N3
+       TAD I   N3
+       DCA     SW              /HAA-- IT IS NOW RESTORED
+       JMP     RETN            /AWAY WE GO
+N3,    0                       /W FOR E AND F CONVER
+PER,   JMS     NU              /GOT A PERIOD, MUST BE  OR F TYPE
+       DCA     N3
+       JMP     RETN
+S1,    0
+S2,    0                       /SAVE THE COUNT AND SWITCH
+NPAR,  0
+\f      PAGE            /EXPERIMENTAL
+
+EX,    JMS     GLST            /THIS IS E FORMAT CONVERSION
+EE,    JMS     NR      /CHECK IF INPUT - IF NOT, GET NUMBER INTO [.1,1]
+       TAD     C
+       DCA     GLST            /STORE C AWAY IN A SAFE PLACE
+       DCA     C
+       CLA CMA
+       DCA     EFLG            /SET "E FORMAT FAKEOUT" FLAG
+       TAD     (-5
+       JMP     FFAKE           /FAKE OUT "F" FORMAT TO PRINT DIGITS
+PRNTE, TAD     (5              /PUT OUT THE E
+       JMS     PRINT
+
+
+/      NOW PRINT 'C' DIGITS UNDER I3 FORMAT
+       TAD     GLST
+       SPA SNA CLA
+       CLA CLL CMA RAL
+       TAD     (55
+       JMS     PRINT           /PRINT A MINUS OR PLUS
+       TAD     GLST
+       SPA
+       CIA
+       CALL    1,DIV
+       ARG     TW
+       TAD     (60
+       JMS     PRINT           /PRINT
+       CPAGE 4
+       CALL    0,IREM          /IREM NEEDS AN ARGUMENT TO IGNORE
+EFLG,  0
+CRX,   0
+       TAD     (60
+       JMS     PRINT           /PRINT SECOND DIGIT
+       JMP     EX              /DONE, DO NEXT
+
+FX,    CLA
+       JMS     GLST            /THIS IS F      FORMAT CONVERSION
+FF,    JMS     NR      /CHECK IF INPUT - IF NOT, GET NUMBER INTO [.1,1]
+       DCA     EFLG
+       TAD     C               /C CONTAINS NUMBER OF MULTS TO RANGE NUMBER
+       SMA
+       CLA CMA                 /0 MULTS NEEDED OR ALREADY THERE
+FFAKE, TAD     N3              /NUM3 IS THE FIELD WIDTH
+       CIA                     /MINUS SPACE FOR DADP+DP
+       TAD     N2
+       JMS     SA              /PUT OUT REQUIRED BLANKS + SIGN
+       TAD     C
+       SMA
+       JMP     PRZRO   /NO LEADING DIGIT - PRINT A ZERO FOR LOOKS
+       CIA
+       JMS     DT
+PRDCPT,        TAD     (56
+       JMS     PRINT
+       TAD     C               /GET MULTIPLY COUNT
+       SPA SNA
+       JMP     PAS2
+       CMA                     /THEY WERE MULTIPLIES, 0 TO N OF THEM
+       DCA     CRX
+       TAD     N2              /DIGITS AFTER DEC POINT, DADP
+       CMA
+       DCA     NR
+       JMP     PASA            /TEST FOR 0 MULTIPLIES
+RETR,  TAD     (60             /PUT OUT A ZERO
+       JMS     PRINT           /ALL MULTIPLIES REPRESENTED
+PASA,  ISZ     CRX             /NO, TRY RUN OFF FIELD
+       SKP
+       JMP     PASS            /YES
+       ISZ     NR              /ALL WIDTH ACCOUNTED FOR%
+       JMP     RETR            /NO, TRY NEXT POSITION
+
+
+PASS,  TAD     C               /YES, GET MULT COUNT
+       CIA                     /-MULT COUNT
+       SKP
+PAS2,  CLA
+       TAD     N2              /N2-MULT COUNT
+       SMA SZA                 /IS MULT COUNT .GE. N2?
+       JMS     DT              /NO - PRINT REMAINING DIGITS
+       ISZ     EFLG            /WERE WE FAKED OUT BY "E" FORMAT?
+       JMP     FX              /NO
+       JMP     PRNTE           /YES - GO PRINT EXPONENT
+PRZRO, CLA
+       TAD     (60
+       JMS     PRINT
+       JMP     PRDCPT          /GO BACK TO PRINT THE DECIMAL POINT
+
+SA,    0
+       TAD     SN
+       SMA                     /THIS IS -(NUM OF BLANKS)
+       JMP     AS3             /POSITIVE, NUMBER TOO BIG FOR FIELD
+       DCA     CRX
+       SKP CLA
+RETC,  JMS     PRINT           /HERE WE PUT OUT THAT MANY BLANKS
+       TAD     (40
+       ISZ     CRX
+       JMP     RETC            /YES
+       CLA
+       TAD     SN
+       SNA CLA                 /IS SIGN MINUS?
+       JMP I   SA              /EVIDENTLY NOT
+       TAD     (55
+       JMS     PRINT           /PUT OUT A MINUS SIGN
+       JMP I   SA
+
+\f      PAGE            /EXPERIMENTAL
+FN,    TAD     N3              /GET WIDTH, INPUT FOR E OR F FORMAT
+       CMA                     /1'S COMPLEMENT
+       DCA     CR              /TO COUNTER
+       DCA     D1              /0 TO D1
+       CALL    0,CLEAR
+       CMA
+       DCA     D2              /-1 TO DECIMAL POINT SWITCH
+       CMA             /-0 TO SGN FLAG
+RRTSGN,        DCA     SN
+RRT,   CLA
+       ISZ     CR              /INDEX TO SEE IF WIDTH EXCEEDED
+       SKP
+       JMP     FP              /GET AN INPUT CHARACTER AND TEST IT
+       JMS     GCHR
+       CPAGE 20
+       JMS     CHTYPE  /CLASSIFY INPUT CHAR
+       FDIGIT          /DIGIT
+       -56;    PUNT
+       -40;    RRT
+       -53;    RRT
+       -55;    RRTSGN
+       -5;     EPRO
+       0
+PERR3, ERR3
+FDIGIT,        DCA     IS
+       CALL    1,FMP
+       ARG     TN
+       CALL    1,STO           /SAVE FLOATING POINT ACCUMULATOR
+       ARG     SV
+       TAD     IS
+       CALL    0,FLOT          /FLOAT NEW DIGIT
+       CALL    1,FAD
+       ARG     SV
+       INC     D1              /COUNT OF DIGITS
+       JMP     RRT
+PUNT,  ISZ     D2              /TST DP SWITCH
+       JMPI    PERR3           /***** TWO DECIMAL POINTS *****
+       DCA     D1
+       JMP     RRT
+EPRO,  CLA CMA                 /AN E
+FP,    DCA     IS              /-1 TO IS IF E, 0 TO IS IF END OF FIELD
+       ISZ     D2              /TEST DP SWITCH
+       JMP     FA              /ONE HAS OCCURRED
+       TAD     N2              /ONE HAS NOT OCCURRED, GET NDP
+       SKP
+FA,    TAD     D1              /COUNT OF DIGITS AFTER EXPLICIT DP
+       CMA                     /-COUNT
+       JMS     DH              /DIVIDE FPAC BY TEN COUNT TIMES
+       TAD     ACH             /IF ACH=0,DON'T CHK. SIGN
+       SNA
+       JMP     ZR              /ZERO-DON'T CHECK
+       ISZ     SN              /TEST SIGN
+       TAD     (4000           /SET SIGN BIT
+       DCA     ACH
+ZR,    ISZ     IS      /DID WE GET AN "E"?
+       JMP     VZA     /NO - STORE RESULT AND GET OUT
+       JMP     VQ      /YES - FAKE INTEGER ROUTINE TO ACCEPT EXPONENT
+D1,    0
+D2,    0
+IS,    0
+CR,    0
+
+PRO2,  CMA             /GOT EXPONENT - MAKE IT NEGATIVE
+       ISZ     SN      /WHAT WAS ITS ORIGINAL SIGN?
+       JMP     VZB     /NEGATIVE - DIVIDE BY 10^EXP
+       DCA     D1              /SAVE COUNT
+       JMP     VZD
+VZC,   CALL    1,FMP
+       ARG     TN
+VZD,   ISZ     D1              /INDEX COUNT
+       JMP     VZC
+       JMP     VZA
+VZB,   JMS     DH
+VZA,   CALL    1,ISTO          /STORE IN PLACE
+       ARG     ARGUMT
+       JMP     FX
+\f      PAGE            /EXPERIMENTAL
+XX,    JMS     MR              /TEST FOR MORE
+       TAD     IO              /TEST FOR INPUT-OUTPUT
+       SNA CLA
+       JMP     XX1             /INPUT, PSEUDO-JUMP
+       TAD     (40             /OUTPUT A BLANK
+       JMS     PRINT
+       JMP     XX              /CYCLE
+XX1,   JMS     GCHR            /IGNORE SPACES ON INPUT
+       CLA
+       JMP     XX
+
+HH,    JMS     MR      /THE H FIELD PROCESSOR
+       JMS     GFRM    /SAME AS XXX, BUT PRINT NEXT
+       JMS     PRINT   /----- FORMAT CHARACTER
+       JMP     HH      /OUTPUT ONLY
+
+PRINT, 0
+       TAD     (-40
+       SPA
+       TAD     (100            /CONVERT 6-BIT TO 8-BIT
+       TAD     (240
+       TAD     DV              /ADD ON DEVICE NUMBER IN BITS 0-3
+       CALL    0,GENIO
+       JMP I   PRINT
+
+WH,    0
+       JMS     EJ      /END THE RECORD
+       TAD     ARGUMT#
+       SNA CLA         /TEST PARAMETER FOR 0
+       JMS     GLST    /RETURN TO MAIN PROGRAM ON 0 PAR
+       JMP I   WH      /MORE AGRUMENTS RETURN
+
+EJ,    0                       /ROUTINE TO END RECORD
+       TAD     IO
+       SZA CLA                 /INPUT OR OUTPUT?
+       JMP     E1              /OUTPUT
+E2,    CLA
+       TAD     BA
+       SZA CLA
+       JMP     BG              /CARRIAGE RETURN SEEN - GOODBYE
+       JMS     GCHR            /GET A CHARACTER
+       JMP     E2              /KEEP LOOKING FOR CR
+BG,    DCA     BA
+       JMP I   EJ
+E1,    TAD     (7715           /7715 TRANSLATES TO 215
+       JMS     PRINT
+       TAD     (7712
+       JMS     PRINT           /PRINT CR-LF
+       JMP I   EJ
+
+BA,    0               /THIS IS THE END OF LINE SWITCH
+BH,    ISZ     BA      /ENTRY TO LOOK FOR AN END OF LINE
+BL,    TAD     (40
+       AND     (77             /KEEP THIS - BL IS REFERENCED BY GCHR
+       JMP I   GCHR
+
+GCHR,  0               /GET AN INPUT STRING CHARACTER
+JD,    CLA
+       TAD     BA      /GET EOR SWITCH
+       SZA CLA
+       JMP     BL      /IS EOR, RETURN BLANK
+       CLA CLL CML RTR         /****** IF # OF DEVICES IS CHANGED,
+       TAD     DV              /THIS SHOULD BE CHANGED TOO *****
+       CALL    0,GENIO         /CALL GENIO WITH OFFSET DEVICE NUMBER
+       AND     (177            /STRIP PARITY
+       TAD     (7763
+       SNA                     /CARRIAGE RETURN?
+       JMP     BH
+       TAD     (7655
+       CLL
+       TAD     (100            /IS CHAR IN RANGE 237<CHAR<340?
+       SNL
+       JMP     JD              /NO - IGNORE
+       JMP     BL              /CONVERT TO SIXBIT AND RETURN
+\f      PAGE            /EXPERIMENTAL
+/     GET F.P. NUMBER INTO THE RANGE   .1 .LE. N .L. 1.0
+NR,    0
+       JMSKP   BB      /CHECK DIRECTION OF I/O
+       JMP     FN      /INPUT
+       CALL    1,IFAD  /OUTPUT - LOAD NUMBER INTO FLOATING AC
+       ARG     ARGUMT
+       DCA     SN      /CLEAR THESE LOCS
+       DCA     C
+       TAD     ACH
+       SNA
+       JMP     NREX    /NUMBER IS ZERO
+       SMA             /IS IT A MINUS F P NUMBER
+       JMP     RETM
+       TAD     (4000   /YES-- MAKE IT POSITIVE
+       ISZ     SN      /SET SIGN
+       DCA     ACH
+RETM,  CLA                     /MULTIPLY BY 10 UNTIL NR .GT. (1.0)
+       TAD     ACH
+       TAD     (5764
+       SMA CLA
+       JMP     TB      /GOT IT IT IS .GE.1
+       CALL    1,FMP
+       ARG     TN
+       ISZ     C       /AND COUNT
+       JMP     RETM    /GO TRY TO DO IT AGAIN
+TB,    JMS     SE      /NOTE SE ' XR-1
+       CALL    1,STO
+       ARG     SV
+       TAD     (2004
+       DCA     ACH     /200400000000=.50000 IN AC
+       TAD     CH      /TEST FORMAT
+       TAD     (7772
+       SNA CLA         /IS IT E FORMAT?
+       TAD     C       /NO - COUNT # OF MULTS NEEDED
+       CIA
+       TAD     N2      /< DADP
+       SMA
+       CMA             /NUMBER OF THIMES TO DIVIDE .5 BY 10 TO RND
+       JMS     DH      /DO THE DIVIDES
+       CALL    1,FAD
+       ARG     SV
+       JMS     SE      /REDUCE TO NORMAL RANGE AGAIN
+
+
+GD,    TAD     ACH
+       RAL
+       SPA CLA
+       JMP     ZP      /NUMBER IS ? 1/2
+       TAD     ACH
+       CLL RAR         /WE ARE GETTING EXP TO 200
+       DCA     ACH
+       TAD     ACM
+       RAR
+       DCA     ACM
+       TAD     ACL
+       RAR
+       DCA     ACL
+       TAD     ACH
+       AND     (7774
+       TAD     ACH
+       TAD     (10
+       DCA     ACH
+       JMP     GD
+ZP,    TAD     ACH
+       AND     (7
+       DCA     ACH
+NREX,  JMP I   NR
+SN,    0
+
+C,     0                       /COUNTER FOR DEC. EXP.
+SE,    0                       /DIVIDE BY 10 UNTIL N < 1.0
+XR,    TAD     ACH             /TEST NUMBER FOR .GE. 1
+       TAD     (5764
+       SPA CLA
+       JMP I   SE              /NUMBER IS IN RANGE, RETURN
+       CLA CLL CMA RAL
+       JMS     DH
+       CLA CMA                 /REDUCE COUNT
+       TAD     C
+       DCA     C
+       JMP     XR
+\f      PAGE            /EXPERIMENTAL
+GLST,  0               /GET NEXT ARGUMENT ROUTINE
+       CALL    0,CLEAR /CLEAR FLOATING AC
+       ISZ     IOHCNT  /ARE WE IN AN ARRAY I/O LOOP?
+       JMP     ARMORE  /YES - GET NEXT ELEMENT
+       INC     IOH#
+       RETRN   IOH     /RETURN TO USERS PROGRAM FOR MORE DATA
+ARMORE,        TAD     ARGUMT#
+       TAD     IOHINC  /BUMP ARGUMENT POINTER BY ELEMENT LENGTH
+       JMP     IOHBAK  /RESUME I/O CONVERSIONS WITH UPDATED ARGUMT
+
+       CPAGE 33
+IOH,   BLOCK   1
+       10      
+       SZA CLA         /IS THIS A SCALAR OR AN ARRAY CALL?
+       JMP     IOHAR   /AN ARRAY CALL
+       CLA CMA
+IOGTAR,        DCA     IOHCNT  /SET UP ARGUMENT COUNT FOR THIS CALL
+       TAD     IOH
+       DCA     IOH1
+IOH1,  NOP             /SET DATA FIELD TO ARGUMENT LIST
+       TADI    IOH#
+       DCA     ARGUMT
+       INC     IOH#
+       TADI    IOH#
+IOHBAK,        DCA     ARGUMT#
+       JMP I   GLST    /RETURN TO I/O CONVERSION
+IOHAR, INC     IOH#
+       CLA CLL CML RAR
+       AND I   IOH     /GET TYPE OF ARRAY
+       CLL RTL
+       CML RAL         /FORM A 1 OR A 3, DEPENDING ON ARRAY TYPE
+       DCA     IOHINC
+       CLA CLL CMA RAR
+       ANDI    7       /GET THE ELEMENT COUNT
+       CIA
+       INC     IOH#
+       JMP     IOGTAR  /SAVE IT AND GET ARRAY POINTER
+IOHINC,        0
+IOHCNT,        0
+
+CHTYPE,        0               /SUBROUTINE TO CLASSIFY CHARACTERS
+       DCA     CHCH
+       TAD     CHCH
+       TAD     (7706
+       CLL
+       TAD     (12
+       SZL             /IS THE CHARACTER NUMERIC?
+       JMP     JMPOUT  /YES - TAKE FIRST EXIT
+       INC     CHTYPE
+CHLOOP,        CLA
+       TAD I   CHTYPE
+       INC     CHTYPE
+       SNA             /CHARACTER LIST EXHAUSTED?
+       JMP     JMPOTX  /YES - TAKE LAST EXIT WITH CHAR IN AC
+       TAD     CHCH
+       SNA CLA         /MATCH?
+       JMP     JMPOUT  /YES - TAKE EXIT WITH AC=0
+       INC     CHTYPE
+       JMP     CHLOOP  /NO MATCH - GO ON TO NEXT CHAR
+JMPOUT,        DCA     CHCH
+JMPOTX,        TAD I   CHTYPE
+       DCA     CHTYPE
+       TAD     CHCH
+       JMP I   CHTYPE
+CHCH,  0
+
+DT,    0
+       CIA
+       DCA     CHCH    /STORE COUNT
+RETT,  JMS     LS      /LEFT SHIFT 1
+       TAD     ACL     /SAVE THE FPAC
+       DCA     SACL
+       TAD     ACM
+       DCA     SACM
+       TAD     ACH
+       AND     (17
+       DCA     SACH
+       TAD     SACH
+       DCA     ACH     /TRIM AC TO 28 BITS
+       JMS     LS      /LEFT SHIFT 2
+       JMS     LS
+       TAD     ACL     /ADD THE DSAVE TO THE ACC
+       TAD     SACL
+       DCA     ACL
+       RAL             /*
+       TAD     ACM
+       TAD     SACM
+       DCA     ACM
+       RAL             /*
+       TAD     ACH
+       TAD     SACH
+       DCA     ACH
+       TAD     ACH
+       CLL RAR         /ROTATE 3 RIGHT
+       RTR
+       AND     (17
+       TAD     (60     /MAKE DIGIT
+       JMS     PRINT   /DUMP IT AND SEE IF ANY MORE
+       ISZ     CHCH    /LOOP ON COUNT
+       JMP     RETT    /*
+       JMP I   DT
+
+LS,    0               /LEFT SHIFT THE FPAC 1
+       TAD     ACL
+       CLL RAL
+       DCA     ACL
+       TAD     ACM
+       RAL
+       DCA     ACM
+       TAD     ACH
+       RAL
+       DCA     ACH
+       JMP I   LS      /DONE
+\f      PAGE            /EXPERIMENTAL
+PR,    0
+       TAD     SACH    /GET THE LAST NUMBER ACCUMULATED
+       DCA     N2      /SAVE IT
+PR2,   TAD     CH
+       SNA
+       JMP I   PR      /NOTHING TO DO
+       CPAGE 22
+       JMS     CHTYPE  /CLASSIFY CH
+       ERR1            /DIGIT IS ILLEGAL
+       -30;XX
+       -11;II
+       -10;HH
+       -6;FF
+       -5;EE
+       -1;AA
+       0;ERR1
+
+MR,    0               /MORE?
+       ISZ     N1      /SEE IF IT GOES TO ZERO
+       JMP I   MR
+       DCA     CH      /NO MORE FIELDS, FIRST WIPE CHAR
+       JMP I   PR      /GO BACK TO FORMAT SCANNER
+NU,    0               /ROUTINE TO FETCH THE ACCUM NUMB
+       TAD     SACH
+       SNA             /IF IT IS ZERO, SET IT TO 1
+       CLA IAC         /IT IS AND WE DO
+       JMP I   NU      /GO HOME
+BB,    0
+       JMS     MR      /MORE?
+       TAD     ARGUMT#
+       SNA CLA         /IF ARG=0,
+       JMS     WH      /END RECORD AND RETURN TO USERS PROGRAM
+       TAD     IO      /TEST IN OUT SWITCH
+       SZA CLA         /OUTPUT
+       INC     BB      /INPUT
+       JMP I   BB
+AX,    JMS     GLST
+AA,    TAD     N2
+       CIA
+       DCA     CX
+       JMSKP   BB
+       JMP     AR
+AS,    JMS     GADR    /GET CHARACTER ADDRESS
+       TADI    7
+       SZL
+       JMP     ASNORT
+       RTR
+       RTR
+       RTR
+ASNORT,        AND     (77     /MASK 6 BITS
+       JMS     PRINT
+       ISZ     CX
+       JMP     AS      /LOOP FOR CHARACTER COUNT
+       JMP     AX      /GET NEXT ARGUMENT(IF ANY)
+
+AR,    JMS     GCHR
+       DCA     DH      /GET AND SAVE INPUT CHAR
+       JMS     GADR    /GET CHARACTER POINTER
+       TAD     DH
+       SZL             /WHICH HALF?
+       JMP     ARNORT  /RIGHT HALF
+       IAC
+       RTL
+       RTL
+       RTL
+       SKP
+ARNORT,        TADI    7
+       TAD     (7740   /CANCEL BLANK CHAR
+ARCOMN,        DCAI    7
+       ISZ     CX
+       JMP     AR
+       JMP     AX
+
+GADR,  0               /SUBR TO COMPUTE CHARACTER ADDR FOR "A" FMT
+       TAD     ARGUMT
+       DCA     AS1
+       TAD     N2
+       TAD     CX
+       CLL RAR
+       TAD     ARGUMT# /AC=WORD POINTER, LINK=LEFT/RIGHT FLAG
+       DCA     7
+AS1,   NOP             /SET UP DATA FIELD OF ARGUMENT
+       JMPI    GADR
+CX,    0
+
+DH,    0
+       DCA     CX      /DIVIDE FPAC BY TEN CX TIMES
+       JMP     DTA
+DTB,   CALL    1,FDV
+       ARG     TN
+DTA,   ISZ     CX
+       JMP     DTB
+       JMP I   DH
+AS3,   CLA             /PRINT ASTERISKS FOR WHOLE FIELD SIZE
+       TAD     N3      /GET FIELD SIZE, E OR F
+       CMA
+       DCA     CX      /-COUNT
+       JMP     QQ
+QQA,   TAD     (52     /PRINT CX ASTERISKS
+       JMS     PRINT
+QQ,    ISZ     CX      /INDEX COUNT
+       JMP     QQA
+       JMS     GLST    /TEST FOR MORE
+       JMP     PR2     /RETURN TO FORMAT PROCESSOR, SAME TYPE
+\f      PAGE            /EXPERIMENTAL
+IN,    TAD     N2      /INTEGER INPUT, GET WIDTH OF FIELD
+       CMA             /1,S COMP TO COUNTER, CR
+       DCA     CR
+       CMA
+VQ,    DCA     WHI     /-1 TO NUMBER ACCUMULATED
+       CMA             /-1 TO SIGN
+RRSIGN,        DCA     SN
+       DCA     SACH
+RRS,   ISZ     CR      /HAS WHOLE NUMBER BEEN ACCUMULATED
+       SKP
+       JMP     PRO
+       JMS     GCHR
+       CPAGE 14
+       JMS     CHTYPE  /CLASSIFY CHARACTER
+       DIGIT           /ITS A DIGIT
+       -40;    RRS
+       -53;    RRS
+       -55;    RRSIGN
+       0;      ERR2
+DIGIT, JMS     DGT     /ACCUMULATE DIGIT INTO SACH
+       JMP     RRS     /GET NEXT DIGIT
+PRO,   TAD     SACH    /WE HAVE AN INTEGER ...
+       ISZ     WHI     /WHAT KIND?
+       JMP     PRO2
+       ISZ     SN      / 'I' FORMAT
+       CIA
+       DCA I   ARGUMT
+
+IX,    CLA
+       JMS     GLST    /INTEGER CONVERSION
+II,    JMSKP   BB      /TEST MORE AND NON ZERO CURRENT LIST ITEM
+       JMP     IN      /INPUT
+       TAD     AB
+       DCA     SACL    /OUTPUT
+       TAD     (-4
+       DCA     WHI     /-4
+       DCA     SN      /0
+       TAD I   ARGUMT
+       SMA             /SET SN 0 FOR PLUS, 1 FOR MINUS
+       JMP     XZ      /PLACE MAGNITUDE IN 20
+       CIA
+       ISZ     SN
+XZ,    CALL    1,DIV
+       ARG     TW
+       DCA     SACH
+       CPAGE 4
+       CALL    0,IREM  /IREM NEEDS AN ARGUMENT TO IGNORE
+AB,    I1
+WHI,   0
+
+
+       DCA I   SACL    /SAVE REMAINDER
+       CMA
+       TAD     SACL    /SACL=SACL-1
+       DCA     SACL
+       ISZ     WHI     /INDEX COUNT
+       TAD     SACH    /AND CHECK NUM FOR 0
+       SZA
+       JMP     XZ      /CYCLE
+IB,    TAD     N2
+       DCA     N3      /IN CASE OF OVERFLOW
+       TAD     N2
+       CMA
+       TAD     WHI
+       TAD     (4      /COMPUTE NUMBER OF LEADING BLANKS
+       JMS     SA      /PRINT LEADING BLANKS AND SIGN
+ID,    INC     SACL    /POINT TO DIGIT TO PRINT NEXT
+       TAD I   SACL    /GET IT
+       SPA             /TERMINATOR?
+       JMP     IX      /YUP
+       TAD     (60
+       JMS     PRINT   /NOPE - PRINT THE DIGIT
+       JMP     ID      /GET NEXT
+
+DGT,   0
+       DCA     SACM
+       TAD     SACH
+       CLL RTL
+       TAD     SACH
+       RAL
+       TAD     SACM
+       DCA     SACH
+       JMP I   DGT
+
+       END
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/IOPEN.SB b/sw/os8/v3d/sources/system/dectapes/dectape3/IOPEN.SB
new file mode 100644 (file)
index 0000000..3c90848
--- /dev/null
@@ -0,0 +1,184 @@
+/IOPEN SUBROUTINE                          OS8 FORTRAN II LIBRARY
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/     VERSION 21A
+/      VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
+/      SUBROUTINES TO MANIPULATE OS/8 FILES
+/
+
+       ENTRY   IOPEN   /OPEN AN INPUT FILE
+       ENTRY   OOPEN   /OPEN AN OUTPUT FILE
+       ENTRY   OCLOS   /CLOSE AN OUTPUT FILE
+       ENTRY   CHAIN   /CHAIN TO A PROGRAM
+
+       OPDEF   TADI    1400
+       OPDEF   ISZI    2400
+       OPDEF   DCAI    3400
+       OPDEF   JMPI    5400
+
+       LAP             /LEAVE AUTOMATIC PAGING - WE NEED THE 2 LOCATIONS
+
+IOER,  1117;0522       /"IOER" ERROR MESSAGE
+IOPEN, BLOCK   1
+       21
+       TAD     ASDVM1
+       JMS     SETUP   /PUT 2 WORDS OF FIRST ARGUMENT INTO "ASDEV"
+       TADI    INHNDL  /DATA FIELD IS 0 HERE - GET INPUT HANDLER PAGE
+       SNA
+       JMP     IOERR   /NO /I GIVEN - ERROR
+       DCAI    10      /STORE IN "ASPAGE"
+       JMS     GFILNM  /MOVE FILE NAME INTO LOCS 00000-00003
+       TAD     FLUKUP  /LOAD POINTER TO "FLUKUP" IN RUN-TIME ROUTINES
+CALASN,        6202    /CIF 0
+       JMS I   FASIGN  /SET DF=CURRENT AND GO LOOKUP FILE
+       RETRN   IOPEN   /** FASIGN SKIPS BUT SECOND WORD IS SMALL **
+IOERR, CALL    1,ERROR /I-O ERROR  - GIVE MESSAGE AND QUIT
+       ARG     IOER
+
+OOPEN, BLOCK   1
+       21
+       JMS     OOCOMN
+       TAD     FENTER
+       JMP     CALASN  /SEE "IOPEN" FOR COMMENTS
+
+OOCOMN,        0               /COMMON SUBR BETWEEN "OOPEN" AND "OCLOS"
+       TAD     OOPEN
+       DCA     IOPEN
+       TAD     OOPEN#
+       DCA     IOPEN#  /MOVE CALLING ADDRESS TO IOPEN
+       TAD     ASDVM1
+       JMS     SETUP   /SET UP DEVICE NAME IN FIELD 0
+       TADI    OUHNDL
+       SNA
+       JMP     IOERR   /NO /O GIVEN - ERROR
+       DCAI    10      /STORE IN "ASPAGE"
+       JMS     GFILNM  /PUT FILE NAME INTO 00000-3
+       JMPI    OOCOMN
+
+OCLOS, BLOCK   1
+       21
+       JMS     OOCOMN  /SET UP DEVICE AND FILE NAME
+       TAD     OCLOS
+       DCA     IOPEN
+       TAD     OCLOS#
+       DCA     IOPEN#  /SET UP IOPEN FOR RETURN
+       TAD     CHAIN   /=7177
+       DCA     OOCOMN
+OCLOOP,        TAD     CHAIN#  /=1632 =^Z ON DEVICE 4 OUTPUT
+       CALL    0,GENIO
+       ISZ     OOCOMN
+       JMP     OCLOOP  /FORCE OUT THE LAST BUFFER
+       TAD     FCLOSE
+       JMP     CALASN  /DO WORK AND LEAVE
+
+SETUP, 0
+       DCA     10
+       TAD     IOPEN
+       DCA     SETDF
+SETDF, 0               /SET CALLING DATA FIELD
+       TADI    IOPEN#
+       DCA     GETWD#  /SAVE FIELD OF ARGUMENT
+       INC     IOPEN#
+       TADI    IOPEN#
+       DCA     SETDF   /SAVE ADDRESS OF ARGUMENT
+       INC     IOPEN#
+       JMS     GETWD   /TRANSFER TWO WORDS FROM THE
+       JMS     GETWD   /ARGUMENT LIST TO WHERE XR 10 POINTS
+       JMPI    SETUP   /RETURN WITH DATA FIELD =0
+
+GETWD, 0
+       NOP             /SET ARGUMENT FIELD
+       TADI    SETDF
+       INC     SETDF
+       6201            /CDF 00
+       DCAI    10
+       JMPI    GETWD   /DO NOT RESTORE DATA FIELD
+
+GFILNM,        0
+       CLA CMA
+       JMS     SETUP   /MOVE TWO WORDS TO 00000 AND 00001
+       JMS     GETWD   /MOVE THE THIRD WORD
+       TAD     DA
+       DCAI    10      /SUPPLY AN EXTENSION
+       JMPI    GFILNM
+
+DA,    0401            /.DA EXTENSION
+INHNDL,        74
+OUHNDL,        75
+FASIGN,        541             /*****************
+ASDVM1,        552             /               CAUTION!
+FLUKUP,        567             /ALL THESE LOCATIONS ARE VERY VOLATILE!!
+FENTER,        741             /WATCH OUT IF YOU REASSEMBLE THE LOADER!
+FCLOSE,        757             /*****************
+
+CHAIN, 7177            /USE "CHAIN" TO STORE CONSTANTS
+       1632            /SINCE IT IS ONLY CALLED TERMINALLY
+       TAD     CHAIN
+       DCA     IOPEN
+       CALL    0,CKIO  /WAIT FOR DEVICE
+       TAD     CHAIN#
+       DCA     IOPEN#
+       JMS     GFILNM  /GET FILE NAME INTO 00000-00003
+       ISZI    INHNDL  /FORCE INHNDL NONZERO SO IOPEN WONT FAIL
+       TAD     SV      /CHANGE ASSUMED EXTENSION
+       DCA     DA      /FROM .DA TO .SV
+       TAD     (0310
+       DCA     IOER    /IF IOPEN FAILS GIVE "CHER" MESSAGE
+CALOPN,        CALL    1,IOPEN
+       ARG     SYS     /CHAIN WORKS FROM THE SYSTEMS DEVICE ONLY
+       6201
+       0               /"ARG 0" POINTING TO 00000!
+       TAD     (6
+       6201            /SET DF TO 0
+       DCAI    K2      /MODIFY "LOOKUP" INTO "CHAIN"
+       DCAI    ZRONAM  /ALSO KILL LOC WHICH ZEROS FILE NAME PTR
+       JMP     CALOPN  /GO BACK - THIS TIME IOPEN WILL CHAIN.
+
+SYS,   2303            /***** 2303+2326 =4631 = "SYS"! WATCH IT!
+SV,    2326
+K2,    571             /**** SUPER VOLATILE LOCATION ****
+ZRONAM,        557             /****     DITTO               ****
+
+       END
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/IPOWRS.SB b/sw/os8/v3d/sources/system/dectapes/dectape3/IPOWRS.SB
new file mode 100644 (file)
index 0000000..af382a3
--- /dev/null
@@ -0,0 +1,163 @@
+/INTEGER POWERS OF NUMBERS               ...INTEGER AND FLOATING POINT
+/
+/OS8 FORTRAN II LIBRARY
+/
+/
+/
+/
+/
+/
+/
+/
+/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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/     VERSION 2A
+/      VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
+
+       ENTRY   IIPOW
+       ENTRY   FIPOW
+       OPDEF   TADI    1400
+
+       LAP
+
+FIPOW, BLOCK   1
+       2
+       TAD     FIPOW
+       DCA     IIPOW
+       TAD     FIPOW#
+       DCA     IIPOW#
+       CALL    1,STO
+       ARG     X       /SAVE BASE
+       JMP     FIFI
+
+X,     BLOCK 3
+RSLT,  BLOCK 3
+N,     0
+FISW,  0
+IIPOW, BLOCK   1
+       2
+       DCA     X       /SAVE BASE
+       IAC
+FIFI,  DCA     FISW
+       TAD     IIPOW
+       DCA     II
+II,    NOP
+       TADI    IIPOW#
+       DCA     NCDF
+       INC     IIPOW#
+       TADI    IIPOW#
+       DCA     N
+       INC     IIPOW#
+NCDF,  NOP             /GET FIELD OF EXPONENT
+       TADI    N       /GET EXPONENT
+       CLL
+       SPA
+       CIA CML
+       DCA     N       /SAVE ABS VALUE
+       TAD     X
+/*********    THE FOLLOWING CODE MAY BE REPLACED BY JUST "SNA CLA"
+/*********    IF THE RULES ARE THAT 0**ANYTHING=0 FOR FLOATING
+/*********    POINT TOO.  (REMEMBER 0**0 AND 0**-1!)
+       SNA CLA
+       TAD     FISW
+       SZA CLA
+/*********
+       JMP     IPRTRN  /BASE=0 MEANS RESULT=0
+       TAD     FISW
+       SZA
+       JMP     DCARSL
+ACHONE,        TAD     (2014
+       DCA     ACH     /INITIALIZE FPAC TO 1.0
+DCARSL,        DCA     RSLT    /INITIALIZE RSLT TO FISW
+       SNL             /THE LINK SHOULD CONTAIN THE EXPONENT SIGN
+       JMP     BACK    /POSITIVE - ALLS WELL
+       TAD     FISW
+       SZA CLA
+       JMP     IPRTRN  /I**-N = 0
+       CALL    1,FDV
+       ARG     X       /THERE'S A 1.0 IN THE AC, REMEMBER?
+       CALL    1,STO
+       ARG     X
+       CLL             /FAKE A POSITIVE SIGN
+       JMP     ACHONE  /GO BACK AND RESTORE FPAC TO 1.0
+
+BACK,  TAD     N       /USE STANDARD POWER-OF-2 ALGORITHM FOR POWERS
+       SNA
+       JMP     DONE
+       CLL RAR
+       DCA     N
+       SNL
+       JMP     LOOP
+       TAD     RSLT
+       SNA
+       JMP     FPMULT  /RSLT=0 MEANS FLOATING POINT
+       CALL    1,MPY
+       ARG     X
+STRSLT,        DCA     RSLT
+LOOP,  TAD     N
+       SNA CLA
+       JMP     DONE
+       TAD     FISW
+       SNA CLA
+       JMP     FPSQR
+       TAD     X
+       CALL    1,MPY
+       ARG     X
+       DCA     X
+       JMP     BACK
+
+FPMULT,        CALL    1,FMP   /DO THE SAME STUFF IN FLOATING POINT
+       ARG     X       /THAT WE DID ABOVE IN INTEGERS
+       JMP     STRSLT
+
+FPSQR, CALL    1,STO
+       ARG     RSLT    /SAVE FLTG AC
+       CALL    1,FAD
+       ARG     X
+       CALL    1,FMP
+       ARG     X
+       CALL    1,STO
+       ARG     X       /SQUARE X
+       CALL    1,FAD
+       ARG     RSLT
+       DCA     RSLT    /KEEP RSLT ZERO!
+       JMP     BACK
+
+DONE,  TAD     RSLT
+IPRTRN,        RETRN   IIPOW
+
+
+       END
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/L645.PA b/sw/os8/v3d/sources/system/dectapes/dectape3/L645.PA
new file mode 100644 (file)
index 0000000..0ca9c8d
--- /dev/null
@@ -0,0 +1,198 @@
+/1 ANALEX LINE PRINTER 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
+DEVICE L645;DEVICE LPT;1040;0;ZBLOCK 2
+
+/V3 FIXES:
+
+/1.    ADDED VERSION NUMBER
+/2.    ADDED PARITY ^C
+/3.    ALLOWED ^C TO WORK EVEN IF LPT OFF
+/      S.R.
+
+       LPTVERSION="A&77
+
+       *200
+       /LINE PRINTER HANDLER FOR "OLD STYLE" LINE PRINTER
+       /RECOGNIZES TAB,LINE FEED,VERTICAL TAB AND FORM FEED
+       /IGNORES CARRIAGE RETURNS, TREATS ^N AS "CARRIAGE RETURN
+       / WITHOUT LINE FEED" CONTROL CHARACTER.
+       LSE=6651
+       LCF=6652
+       LLB=6654
+       LSD=6661
+       LCB=6662
+       LPR=6664
+LPT,   LPTVERSION
+LP7700,        7700
+LPT11, 11      /FALLS THROUGH HARMLESSLY, CLEARING THE AC
+LPT214,        RDF
+       TAD LPTCIF
+       DCA LPTXIT
+       TAD I LPT
+       AND LPT70
+       TAD LP6201
+       DCA LPTCDF
+       CLA CLL CML RAR
+       TAD I LPT       /LINK IS NOW 1 IF COMMAND WAS A "WRITE"
+       AND LP7700
+       CMA
+       DCA LPTWC       /LPTWC=WORD COUNT/2
+       ISZ LPT
+       TAD I LPT
+       DCA LPTCA
+       ISZ LPT
+       TAD I LPT
+       ISZ LPT
+       SNL
+       JMP LPTERR
+       SZA CLA
+       JMP LPTCDF
+       LCB
+       JMS LPWAIT
+       TAD LPT214
+       JMS LPTPCH      /FORM FEED, INITIALIZES COUNT
+LPTCDF,        HLT
+       JMP LPT7
+LPTLP, TAD I LPTCA
+       JMS LPTPCH
+       TAD I LPTCA
+       AND LP7400
+       DCA LPTTMP
+       ISZ LPTCA
+LP7400,        7400
+       TAD I LPTCA
+       JMS LPTPCH
+       TAD I LPTCA
+       AND LP7400
+       CLL RTR
+       RTR
+       TAD LPTTMP
+       RTR
+       RTR
+       JMS LPTPCH
+       ISZ LPTCA
+LPT7,  7
+       ISZ LPTWC
+       JMP LPTLP
+LPTRTN,        ISZ LPT
+LPTXIT,        HLT
+       JMP I LPT
+LPTWC, 0
+LPTCA, 0
+LPTPCH,        0
+       AND LPT177
+       SZA
+       TAD LPM140
+       SMA
+       JMP I LPTPCH
+       TAD LPT106
+       SNA
+       JMP LPTCTZ
+       TAD LPT13
+       CLL
+       TAD LPT6
+       SZL SNA
+       JMP LPTCTL
+       TAD LPT11
+       LLB
+       JMP LPTKSF
+LPWAIT,        -1
+WEIGHT,        LSD
+       JMP NOTDON
+       LCF
+       ISZ LPLPTR
+       JMP I LPWAIT
+       CLA IAC
+LPTCTL,        SNA
+       JMP LPTTAB
+       TAD LPTTAD
+       DCA LPTXXX
+       TAD LP7607
+       DCA LPLPTR
+LPTXXX,        HLT
+       SNA
+       JMP .+3
+       LPR
+LPTKSF,        JMS LPWAIT
+       JMP I LPTPCH
+NOTDON,        KRS
+       AND LPT177
+       TAD LPM3
+       SNA CLA
+       KSF
+       JMP WEIGHT
+LPTCIF,        CDF CIF 0
+       JMP I .+1
+       7600
+LPTCTZ,        TAD LPT214
+       JMS LPTPCH
+       JMP LPTRTN
+LPT6,  6
+LPTTAB,        TAD LPT40
+       LLB
+       JMS LPWAIT
+       TAD LPLPTR
+       AND LPT7
+LPM140,        SZA CLA
+       JMP LPTTAB
+       JMP I LPTPCH
+LPTERR,        CLA CLL CML RAR
+       JMP LPTXIT
+LPTTAD,        TAD .
+LPT70, 70      /LF
+LPT13, 13      /VT
+LPT177,        177     /FF
+       0       /CR
+LPT40, 40      /CR, NO LF
+LPM3,  -3
+LPT106,        106
+LP7607,        7607
+LP6201,        CDF 0
+LPTTMP,        0
+LPLPTR,        0
+       $
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/LINCNS.PA b/sw/os8/v3d/sources/system/dectapes/dectape3/LINCNS.PA
new file mode 100644 (file)
index 0000000..b7400de
--- /dev/null
@@ -0,0 +1,205 @@
+/1 LINCTAPE HANDLER FOR BUILD
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/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
+       -10
+DEVICE LNC;DEVICE LTA0;4170;10;ZBLOCK 2
+DEVICE LNC;DEVICE LTA1;4170;11;ZBLOCK 2
+DEVICE LNC;DEVICE LTA2;4170;12;ZBLOCK 2
+DEVICE LNC;DEVICE LTA3;4170;13;ZBLOCK 2
+DEVICE LNC;DEVICE LTA4;4170;14;ZBLOCK 2
+DEVICE LNC;DEVICE LTA5;4170;15;ZBLOCK 2
+DEVICE LNC;DEVICE LTA6;4170;16;ZBLOCK 2
+DEVICE LNC;DEVICE LTA7;4170;17;ZBLOCK 2
+
+       LINCVERSION="A&77
+
+       *200
+       /LINCTAPE HANDLER FOR PS/8 - CRUDE VERSION (WRITE OPERATION CHECKS
+       /AFTER EACH BLOCK)
+       /ALL 8 HANDLERS ARE IN THIS PAGE - SEE DECTAPE HANDLER FOR
+       /DUMB COMMENT
+
+       /PDP-12 OPCODES NEEDED
+       LINC=   6141
+       PDP=    0002
+       CLR=    0011
+       AXO=    0001
+       TMA=    0023
+       TAC=    0003
+       STDI=   0436
+       COM=    0017
+       ROLI1=  0261
+       ESF=    0004
+
+LTM203,        -203
+LTA,   0
+LTA7,  7
+LTA30, 30
+LTA70, 70
+LTA702,        702
+LT3700,        3700
+LTATMP,        LINCVERSION
+DTA0,  ISZ LTANO
+DTA1,  ISZ LTANO
+DTA2,  ISZ LTANO
+DTA3,  ISZ LTANO
+DTA4,  ISZ LTANO
+DTA5,  ISZ LTANO
+DTA6,  ISZ LTANO
+DTA7,  ISZ LTANO
+LTA200,        200
+       TAD LTANO
+       CMA
+       TAD LTATAD
+       DCA LTANO
+       CLA CLL CML RTR
+       TAD LTANO
+       DCA LTADCA
+       RDF
+       TAD LCDIF0
+       DCA LTAXIT
+LTANO, 0
+       DCA LTA
+       TAD LTAISZ
+LTADCA,        0
+       TAD I LTA
+       DCA LTARG1
+       ISZ LTA
+       TAD I LTA
+       DCA LTARG2
+       ISZ LTA
+       TAD I LTA
+       CLL RAL /MOVE ARGUMENTS TO WORK AREA
+       DCA LTARG3
+       ISZ LTA
+       ISZ LTA
+       TAD LTARG1      /GET CORE FIELD
+       AND LTA70
+       TAD LTCDF
+       DCA LTSET
+       TAD LTSET
+       AND LTA70
+       CLL RTL
+       RTL             /MOVE TO BITS 0-2. CONTROLLER
+       RTL             /WANTS THEM THERE
+SLTARG3,DCA LTATMP
+       TAD LTANO       /GET UNIT NO.
+       AND LTA7
+       CLL RAR
+       TAD LTATMP
+       TAD LTA30       /SET BIT 7 ON. EXTENDED ADD. MODE
+       LINC
+       AXO             /SEND DATA TO CONTROLLER
+       PDP
+LT7600,        7600
+       DCA LTANO       /RESET UNIT NO.
+       TAD LTARG1
+       RTL
+       AND LTA3
+       CLL RTL
+       TAD LTA702      /ADD TAPE INST; STORE IT
+       DCA LTINST
+LTALP, TAD LTARG2      /CORE ADDRESS TO CONTROLLER
+LTATAD,        TAD LTA200      /SAVE 129 TH WORD
+       DCA LTATMP
+LTSET, 0
+       TAD I LTATMP
+       DCA LTASVC      /SAVE LOC.
+       TAD LTARG2
+       LINC
+       TMA
+LTINST,        0               /TAPE INSTRUCTION HERE
+LTARG3,        0               /BLOCK NO. HERE
+LTAWLP,        PDP
+       CLA
+       TAD LTASVC      /RESTORE 129TH WORD
+       DCA I LTATMP
+       TAD LTA200      /ADD 200 FOR PARITY TTY
+       KRS
+       TAD LTM203      /TEST FOR ^C
+       SNA CLA
+       KSF             /IS FLAG UP?
+       JMP NOTFUG      /EITHER NOT ^C OR NO FLAG
+       TAD LTA30
+       LINC
+       ESF
+       PDP
+LT7700,        7700
+       TAD LTASVC
+       DCA I LTATMP
+LCDIF0,        CDF CIF 0
+       JMP I LT7600
+NOTFUG,        LINC
+       STDI
+       COM
+       ROLI1
+LTA3,  TAC
+       PDP
+       SNL
+       JMP LTAWLP
+LTADUN,        CLL IAC
+       CLA IAC RTL
+       AND LTINST
+       SNA CLA
+       JMP LTALP
+LTNERR,        TAD LTARG1
+       AND LT3700
+       TAD LT7700
+       SNA             /ALL DONE?
+       JMP LTAXIT
+       DCA LTARG1      /NO.. SAVE COUNT
+       TAD LTATMP
+       DCA LTARG2
+       ISZ LTARG3
+       JMP LTALP
+LTAXIT,        HLT
+       JMP I LTA
+LTAISZ,        ISZ LTANO
+LTARG1,        0
+LTARG2,        0
+LTCDF, CDF 0
+LTASVC=LTADCA
+$$$$$$$$
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/LINCSY.PA b/sw/os8/v3d/sources/system/dectapes/dectape3/LINCSY.PA
new file mode 100644 (file)
index 0000000..62e9246
--- /dev/null
@@ -0,0 +1,192 @@
+/2 LINCTAPE 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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/     SOFSET=7747
+       SBLOCK=7776
+       LINC=6141
+       AXO=1
+       PDP=2
+       TMA=23
+       *0
+
+       VERSION="B&77
+
+       -2
+       DEVICE LINC;DEVICE SYS;4171;2007;0;1341
+       DEVICE LINC;DEVICE LTA0;4171;1007;0;1341
+
+/V3D:  REMOVED 'SOFSET'
+\f      STARTB-ENDB-1
+
+       NOPUNCH
+       *7600
+       ENPUNCH
+
+STARTB,        ZBLOCK 16
+B4047, 4047
+B7647, 7647
+       1020;20;4               /IO PRESET
+       1020;20;AXO     /LOAD SOME LINCTAPE FLAGS
+       1020;7600;TMA   /LOAD MEMORY ADDRESS
+       720;1           /READ RECORD 1
+       PDP             /BACK TO PDP-8 MODE
+       CLA
+       TAD I B4047
+       CDF 10
+       DCA I B7647
+       CDF 00
+       ISZ B4047
+       ISZ B7647
+       JMP .-6
+       JMP I .+1
+ENDB,  7605
+
+
+
+       /THE BOOTSTRAP FOR A LINCTAPE SYSTEM IS AS FOLLOWS:
+
+       /LEFT SWITCHES=700,RIGHT SWITCHES=0
+       /I-O PRESET IN LINC MODE AND PRESS "D0". TAPE WILL MOVE
+       /WHEN TAPE STOPS PRESS "START 20".
+\f      *200
+
+       NOPUNCH;*7600;ENPUNCH
+
+       ZBLOCK 7
+SHNDLR,        VERSION
+S7600, 7600
+       RDF
+       TAD SCIF
+       DCA SXIT
+       TAD I SHNDLR
+       DCA SFUN        /FUNCTION
+       ISZ SHNDLR
+       TAD I SHNDLR
+       DCA SADR        /BUFFER ADDRESS
+       ISZ SHNDLR
+       TAD I SHNDLR
+/V3D   TAD SOFSET      /SOFSET=0
+       NOP             /SAVE ROOM
+       CLL RAL
+       DCA SBLOK       /BLOCK NO.
+       ISZ SHNDLR
+       CLL CML RAR
+       AND SFUN
+       RTL
+       RTL
+       TAD S702        /GET FUNCTION;CREATE READ OR WRITE
+       DCA SINST       /READ OR WRITE INSTRUCTION.
+       TAD SFUN
+       AND S70         /FIELD BITS TO AC 0-2
+       TAD SADCDF
+       DCA SADSET
+       TAD SADSET
+       AND S70
+       RTL
+       IAC RTL         /SET EXTENDED ADDRESS
+       RTL
+       LINC
+       AXO
+       PDP
+       CLA
+       TAD SFUN
+       RAL
+       AND S7600
+       DCA SFUN
+SADSET,        0
+SLOOP, CLA CLL CMA RTL
+       DCA SERRCT      /NO. ERROR TRIES
+STRY,  TAD SADR
+       TAD S200
+       DCA SADNXT
+       TAD I SADNXT
+       DCA SADSVC
+       TAD SADR
+       LINC
+       TMA             /CORE ADDRESS TO CONTROL
+SINST, 0               /READ OR WRITE
+SBLOK, 0               /BLOCK NO. HERE
+       PDP
+       CMA             /CHECKSUM HERE. 7777=GOOD
+       DCA SADSET
+       TAD SADSVC
+       DCA I SADNXT
+       IFNZRO .-7700 <NZERR>
+       SKP
+       HLT
+       TAD SADSET
+       SZA CLA
+       JMP SERR
+SOK,   ISZ SBLOK
+       TAD SADNXT
+       DCA SADR
+       TAD SFUN
+       TAD S7600
+       SNA             /ALL DONE?
+       JMP SDONE       /YES
+       DCA SFUN
+       JMP SLOOP
+SERR,  TAD SINST
+       RTR;RTR
+       SPA CLA         /WAS IT READ?
+       JMP SOK         /NO..WRITE. CONTINUE
+       ISZ SERRCT      /READ..RETRY IT?
+       JMP STRY
+       CLA CLL CML RAR /DON'T BOTHER
+       SKP
+SDONE, ISZ SHNDLR
+SXIT,  0
+       JMP I SHNDLR
+SFUN,  0
+SADR,  0
+SERRCT,        0
+S702,  702
+S200,  200
+S70,   70
+SCIF,  CDF CIF 0
+SADCDF,        CDF 0
+SADNXT,        0
+SADSVC,        0
+       $
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/LPSV.PA b/sw/os8/v3d/sources/system/dectapes/dectape3/LPSV.PA
new file mode 100644 (file)
index 0000000..395c4bd
--- /dev/null
@@ -0,0 +1,208 @@
+/5 LP08/LS8E/LA180/LV8E 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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f      LPVERSION="C&77
+
+       *0
+
+       -1
+       DEVICE LPSV;DEVICE LPT;1040;LPT&177;ZBLOCK 2
+
+/LPT HANDLER FOR EITHER LP08 OR LS8E LINE PRINTER.
+/HANDLES TABS, PASSES EVERYTHING ELSE ON TO THE HARDWARE.
+
+       LSF=6661        /SKIP ON FLAG
+       LSR=6663        /SKIP ON ERROR
+       LLS=6666        /LOAD LPT BUFFER
+
+       DBST=   6570    /SKIP IF DEMAND SET AND CLEAR IT
+       DBTD=   6574    /LOAD COMPLEMENT OF AC0-11 TO TRANSMIT BUFFER
+       DBSE=   6575    /SET INTERRUPT ENABLE
+       DBCE=   6575    /CLEAR INTERRUPT ENABLE
+
+       LA180=0         /SET TO 1 TO USE LA180
+
+/V3D CHANGES:
+
+/ADDED IN LA180 SUPPORT
+\f      *200
+
+LPWDTH,        -205            /-(WIDTH+1)    [USE -121 FOR 80 COLUMNS]
+LTERMC,        14              /4 FOR LV8
+LVCCNV,        -40             /0 IF PRINTER PRINTS LC
+LP7770,        7770
+LP0007,        0007
+LPT,   LPVERSION       /NORMAL ENTRY POINT
+       CLA STL RAR
+       TAD I   LPT     / R/W BIT TO LINK               L
+       AND     LP7700  /                               I
+       CMA             /TREAT 0 PG CNT AS 0 WD CNT     N
+       DCA     LPTWC   /SAVE -(DBLWD COUNT+1)          K
+LPT214,        RDF             /
+       TAD     LPTCIF  /                               M
+       DCA     LPTXIT  /SAVE CIF CDF RETRN FIELD       U
+       TAD I   LPT     /                               S
+       AND     (70     /                               T
+       TAD     (CDF 0  /
+       DCA     LPTCDF  /                               N
+       ISZ     LPT     /PT TO BUFFER                   O
+       TAD I   LPT     /GET BUFFER ADDRESS             T
+       DCA     LPTCA   /SAVE BUFFER PTR
+       ISZ     LPT     /PT TO BLOCK #                  C
+       TAD I   LPT     /GET IT                         H
+       ISZ     LPT     /POINT TO ERROR RETURN          G
+LPTCDF,        HLT             /                               !
+       SNL
+       JMP     LPTERR  /CAN'T READ FROM LPT
+       SNA CLA
+       TAD     LPT214  /OUTPUT FORM FEED IF BLOCK 0
+LPTELP,        JMS     LPTPCH  /PRINT 3RD CHAR OF DOUBLEWORD
+       ISZ     LPTWC
+       JMP     LPTLP   /GET 3 MORE CHARS
+       SKP
+LPTCTZ,        TAD     LTERMC
+       JMS     LPTPCH  /OUTPUT FORM FEED IF ^Z SEEN (EOT OF LV8)
+       ISZ     LPT     /BUMP TO NORMAL RETURN
+LPTXIT,        HLT             /RESTORE FIELDS
+       JMP I   LPT     /EXIT
+\f/UNPACKING LOOP - USES A SHIFT REGISTER METHOD TO GET THE
+/THIRD CHARACTER IN EACH DOUBLEWORD.
+
+LPTLP, STL             /GUARD BIT OF SHIFT REGISTER
+LPROTL,        RTL
+       RTL
+       SPA             /DO WE HAVE 8 BITS SHIFTED IN?
+       JMP     LPTELP
+       DCA     LPTCDF  /SAVE SHIFT REGISTER
+       TAD I   LPTCA
+       JMS     LPTPCH  /PRINT A CHAR
+       TAD I   LPTCA
+       ISZ     LPTCA   /BUMP INPUT POINTER
+LP7400,        7400            /PROTECT ISZ
+       AND     LP7400
+       CLL RAL
+       TAD     LPTCDF  /SHIFT HIGH 4 BITS INTO
+       JMP     LPROTL  /SHIFT REGISTER
+
+LPTERR,        STL CLA RAR     /PUT 4000 IN AC
+       JMP     LPTXIT  /AND TAKE ERROR RETURN
+
+LPTWC, 0
+LPTCA, 0
+\f/CHAR PRINT ROUTINE
+
+LPTPCH,        0
+       AND     (177
+       TAD     (-175
+       SMA
+       JMP     LPFLSH  /FLUSH CODES 175-177
+       TAD     (175-140
+       SMA
+       TAD     LVCCNV  /CONVERT LC TO UC IF DESIRED
+       TAD     (140-33
+       SNA
+       TAD     (11     /CHANGE ALTMODE TO $
+       IAC
+       SNA
+       JMP     LPTCTZ  /^Z - END OF FILE
+       TAD     (32-11
+       SNA
+       JMP     LPTTAB  /TABS MUST BE SIMULATED
+LPLFHK,        TAD     (11     /RESTORE CHAR
+       SZA             /FLUSH NULLS
+       JMS     LPCHAR  /
+       TAD     LPLPTR  /IF COL. CTR GT 0
+       SMA             /WE HIT A CONTROL CHAR
+       TAD     LPWDTH  /OR EOL- SET TO FULL
+       DCA     LPLPTR  /WIDTH (NOTE LPLPTR=1 !)
+LP7700,
+LPFLSH,        SMA CLA         /NEVER SKIPS
+       JMP I   LPTPCH  /RETURN
+
+LPCHAR,        0               /LOW LEVEL PRINT ROUTINE
+       IFZERO LA180 <
+       NOP             /NOP'S NEEDED FOR SET
+       LLS             /PUT CHAR IN LPT BUFFER
+       NOP
+       >
+       IFNZRO LA180 <
+       CMA
+       DBTD            /PUT CHAR IN LP BUFFER
+       CMA
+       >
+       AND     LP7770  /KLUDGE - CLEARS COLUMN CTR
+       TAD     LP7770  /ON CR, LF, VT, FF BUT ALSO
+       SNA CLA         /ON ^H,^N, AND ^O.  BIG DEAL
+       DCA     LPLPTR  /?SR RICHIE SAID 'LPCRFG'
+LP7600,        7600            /CLEAR AC
+LPCTCL,        TAD     LP7600
+       KRS
+       TAD     (-7603  /CHECK FOR ^C FROM CONSOLE
+       SNA CLA
+       KSF             /WITH FLAG UP
+       JMP     .+3
+LPTCIF,        CDF CIF 0       /YES, RETURN TO OS/8
+       JMP I   LP7600
+       IFNZRO  LA180   <DBST>  /NO     MUST BE HERE
+       IFZERO  LA180   <LSF>   /NO     FOR SET
+       JMP     LPCTCL  /WAIT FOR FLAG
+       ISZ     LPLPTR  /CHECK LINE OVERFLOW
+       JMP I   LPCHAR
+       TAD     (15
+       JMS     LPCHAR
+       CLA IAC
+       JMP     LPLFHK
+\fLPTTAB,       TAD     LPBLNK  /GET PSEUDO BLANK
+       JMS     LPCHAR  /PRINT IT
+       TAD     LPWDTH
+       CMA
+       TAD     LPLPTR  /GET # CHARS IN LINE
+       AND     LP0007
+LPBLNK,        SZA CLA         /LOOP 'TILL MULTIPLE OF 8
+       JMP     LPTTAB
+       JMP I   LPTPCH
+
+LPLPTR,        0
+       $
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/LSPT.PA b/sw/os8/v3d/sources/system/dectapes/dectape3/LSPT.PA
new file mode 100644 (file)
index 0000000..9350182
--- /dev/null
@@ -0,0 +1,178 @@
+/1 PTR/PTP HANDLER FOR LOW SPEED
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/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
+       -2
+DEVICE KS33;DEVICE PTP;1020;0;ZBLOCK 2
+DEVICE KS33;DEVICE PTR;2010;110;ZBLOCK 2
+
+       VERSION="A&77
+
+       *200
+PTP,   VERSION
+       CLA CLL CML     /SET LINK ON TO INDICATE PUNCH
+       JMS PSETUP      /DO COMMON CRAP
+PTPLP, KSF
+       JMP PTPCNT      /KEYBOARD FLAG OFF - DON'T WORRY ABOUT ^C
+       KRS
+       AND PTP177
+       TAD PTPM3
+       SZA CLA /IS THERE A ^C IN THE TTY BUFFER?
+       JMP PTPCNT      /NO
+PTPCIF,        CDF CIF 0
+       JMP I PT7600
+PTPCNT,        TAD I PTPCA
+       JMS PTPPCH      /FIRST CHAR IN LOW ORDER 8 BITS OF WORD 1
+       DCA PTR
+       ISZ PTPCA
+PT7700,        7700
+       TAD I PTPCA
+       JMS PTPPCH      /SECOND CHAR IN LOW ORDER 8 BITS OF WORD 2
+       CLL RTR
+       RTR
+       TAD PTR
+       RTR
+       RTR     /THIRD CHARACTER NOW IN AC
+       JMS PTPPCH
+PTPEND,        ISZ PTPCA
+PT70,  70      /JUST IN CASE WERE PUNCHING PG 7600 KEEP THIS LITERAL HERE
+       JMP PTPISZ
+PSETUP,        0
+       RDF     /GET FIELD OF CALLING PROGRAM
+       TAD PTPCIF
+       DCA PTPXIT      /SET UP RETURN SEQUENCE
+       TAD I PTP
+       AND PT70
+       TAD PCDF
+       DCA PTPCDF
+       RAR             /GET LINK(1=PTP,0=PTR)
+       TAD I PTP       /GET FUNCTION WORD
+       ISZ PTP
+       SPA             /CHECK CORRECT MODE
+       JMP PTPERR      /SIGNAL "UNRECOVERABLE DEVICE ERROR"
+       AND PT7700
+       CMA             /SET UP -(WORD COUNT)/2-1
+       DCA PTPWC
+       TAD I PTP       /SET UP STARTING ADDRESS
+       ISZ PTP
+       DCA PTPCA
+       TAD I PTP
+PTPCDF,        0               /SET DATA FIELD TO ACCESS BUFFER
+       PTPEOF=PTPCDF
+       SNA CLA
+       SZL
+       JMP PTPISZ
+       TAD PTP336      /INPUT INITIALIZATION - TYPE "^" AND WAIT
+       TLS
+       KSF
+       JMP .-1
+PT7600,        7600
+PTPISZ,        ISZ PTPWC
+       JMP I PSETUP    /LOOP FOR BUFFER SIZE (128 WORDS)
+PTPRTN,        TAD PTPEOF
+       SZA CLA         /DID WE RUN OUT OF TAPE?
+       ISZ PTP
+       ISZ PTP
+PTPXIT,        HLT     /EXIT CDF GOES HERE
+       JMP I PTP
+PTPPCH,        0
+       TLS
+       TSF             /NOTICE THE GLORIOUS LACK OF OVERLAP
+       JMP .-1
+       AND PT7400
+       JMP I PTPPCH
+PTPCA, 0
+PTR,   VERSION         /*** CORRECT ENTRY IN MAIN ASSEMBLY IF THIS IS MOVED!
+       CLA CLL
+       TAD PTR
+       DCA PTP
+       JMS PSETUP      /SET UP ADDRESS, COUNT, FIELDS
+PTRLP, JMS PTRGCH      /READ FIRST CHARACTER OF 3
+       DCA I PTPCA
+       JMS PTRGCH
+       DCA PTPPCH
+       JMS PTRGCH
+       RTL
+       RTL
+       DCA PTR
+       TAD PTR
+       AND PT7400
+       TAD I PTPCA
+       DCA I PTPCA     /HIGH ORDER 4 BITS INTO WORD 1
+       TAD PTR         /GET THE CHAR FROM THE PTR BUFFER
+       RTL
+       RTL
+       AND PT7400
+       TAD PTPPCH
+       ISZ PTPCA
+PT7400,        7400
+       DCA I PTPCA     /LOW ORDER 4 BITS INTO WORD 2
+       JMP PTPEND
+PTRGCH,        0
+       TAD PTPEOF
+       SNA CLA
+       JMP I PTRGCH
+       CLA CLL CMA RTL         /-3
+       DCA PTPEOF
+       DCA PTR
+PTTIME,        ISZ PTR         /TIMEOUT LOOP FOR LOW SPEED READER
+       JMP PTP232
+       ISZ PTPEOF      /TIMES OUT IN 132 MS(PDP 8/E) OR 205 MS(PDP 8)
+       JMP PTP232
+       TAD PTP232
+       JMP I PTRGCH    /OVERFLOWED - PTPEOF IS NOW 0, RETURN ^Z
+PTP232,        232             /WASTE SOME TIME
+PTP177,        177
+       KSF
+       JMP PTTIME      /READER NOT READY - CONTINUE TIMEOUT
+       KRB
+       JMP I PTRGCH    /RETURN WITH CHARACTER
+PTPERR,        CLA CLL CML RAR /SIGNAL A "PERMANENT I/O ERROR" ON THE DEVICE
+       JMP PTPXIT-2
+PCDF,  CDF 0
+PTP336,        336
+PTPWC, 0
+PTPM3, -3
+$$$$$$$
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/POWERS.SB b/sw/os8/v3d/sources/system/dectapes/dectape3/POWERS.SB
new file mode 100644 (file)
index 0000000..99a9981
--- /dev/null
@@ -0,0 +1,319 @@
+/POWERS SUBROUTINE                     OS8 FORTRAN II LIBRARY
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/     VERSION 5A
+/      VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
+       ENTRY   IFPOW   /     INTEGER TO FLOATING POWER
+       ENTRY   FFPOW   /     FLOATING TO FLOATING POWER
+       ENTRY   EXP     /     E TO A POWER
+       ENTRY   ALOG    /     NATURAL LOGARITHM
+/
+/
+       DUMMY   LXP
+       OPDEF   JMSKP   4000
+/
+/      INTERNAL SUBROUTINE POL
+/
+/      COMPUTES N TERMS OF POLYNOMIAL (NO CONSTANT TERM)
+/      N IN AC ... X IN FLOATING AC
+/      COEFFICIENTS START IN LOCATION WHOSE ADDRESS FOLLOWS JMS TO POL
+/
+POL2,  BLOCK   1
+POL,   BLOCK   1
+       CIA
+       DCA     POL2
+       CALL    1,STO
+       ARG     X
+       TAD I   POL
+       INC     POL
+/      DCA     ARG1#   /THIS CODE PROBABLY EXTRANEOUS
+/      SKP
+ARG2,  DCA     ARG1#
+       CALL    1,FAD
+ARG1,  ARG     EXS     /     ADDRESS STORED HERE
+       CALL    1,FMP
+       ARG     X
+       ISZ     POL2
+       JMP     POL1
+       JMP I   POL
+POL1,  TAD     ARG1#
+       TAD     (3
+       JMP     ARG2
+
+       CPAGE   17      /     CANT BREAK UP THIS TABLE
+EXS,   1464            /7.9608942E-9   CONSTANTS FOR EXP
+       2142
+       1421
+       1545            /6.3578287E-7
+       2525
+       2525
+       1625            /4.0690103E-5
+       2525
+       2525
+       1704            /1.9531250E-3
+       0000
+       0000
+       1754            /6.25E-2
+       0000
+       0000
+       CPAGE   3
+ONE,   2014
+       0000
+       0000
+       CPAGE   30
+COF,   5716            /-6.4535442E-3  CONSTANTS FOR LOGS
+       4674
+       1006
+       1744            /3.6088494E-2
+       4750
+       6073
+       5756            /-9.5329390E-2
+       0636
+       0162
+       1765            /1.6765407E-1
+       2726
+       6023
+       5767            /-2.4073380E-1
+       5501
+       3543
+       1775            /3.3179902E-1
+       2360
+       6176
+       5777            /-4.9987412E-1
+       7767
+       6001
+       2007            /9.9999643E-1
+       7777
+       7041
+       CPAGE   3
+ER16,  2014            /1.0644944
+       2040
+       5326
+       CPAGE   3
+LN2,   1755            /8.6643397E-2
+       4271
+       0300
+
+X,     BLOCK   3
+Y,     BLOCK   3
+\f
+/
+/      ALOG - NATURAL LOGARITHM
+/
+/      ALOG(X)=N*ALOG(2)+ALOG(M) WHERE 1/2 OR EQUAL TO M
+/      ALOG(M)=ALTERNATING SERIES (K**I)/I WHERE K=2M-1 AND M AS ABOVE
+/
+       CPAGE   4
+LGER,  0114            /     "ALOG" ERROR AT LOC XXXXX
+       1707
+ALOG,  BLOCK   1
+       5               /     ENTRY POINT
+       TAD     ALOG
+       DCA     TEM
+       TAD     ALOG#
+       DCA     TEM#
+       CALL    1,IFAD
+TEM,   ARG     0
+       INC     ALOG#
+       INC     ALOG#
+       TAD     ACH     /     GET EXPONENT
+       SPA SNA
+       JMP     LGERR   /LOG OF X<=0 - ERROR
+       AND     (3770
+       TAD     (5770   /     -2000
+       DCA     TEM     /     N INTO TEM
+       TAD     ACH     /       GET M WITHOUT SIGN
+       AND     (7
+       TAD     (2010   /     2M
+       DCA     ACH
+       CALL    1,FSB   /     2M-1
+       ARG     ONE
+       TAD     (D8     /     8 TERMS OF SERIES
+       JMS     POL
+       COF
+       CALL    1,STO   /     ALOG(M) INTO Y
+       ARG     Y
+       TAD     TEM     /     GET N
+       CALL    0,FLOT  /     FLOAT IT
+       CALL    1,FMP   /     N *ALOG(2)
+       ARG     LN2
+       CALL    1,FAD   /     N *ALOG(2) ALOG(M)(ALOG(X)
+       ARG     Y
+       RETRN   ALOG    /     EXIT
+LGERR, CALL    1,ERROR
+       ARG     LGER
+\f
+/
+/      EXP - E TO A POWER
+/
+/      E**X=SERIES (X**I)/(I!)
+/      IF B=E**(1/16) AND X IS BETWEEN -1 AND 1 THEN
+/      B**X=1 SUMA(I)*(X**I) FOR I FROM I=1 TO I=5
+/      WHERE A(I)(1/((I!)*16**2))
+/
+       CPAGE   4
+EXPER, 4530
+       2040
+EXP,   BLOCK   1
+       5               /     ENTRY POINT
+       TAD     EXP
+       DCA     XT
+       TAD     EXP#
+       DCA     XT#
+       INC     EXP#
+       INC     EXP#
+       CALL    1,IFAD
+XT,    ARG     0
+       CLA CLL CMA RAR
+       AND     ACH
+       TAD     (-2075
+       SMA CLA
+       TAD     ACM
+       CLL
+       TAD     (-4271          /TEST FOR FLTG. AC <88.2
+       SZL CLA
+       JMP     EXPERR
+       TAD     ACH
+       SZA
+       TAD     (40     /     X*16
+       DCA     ACH
+       CALL    1,STO   /     Y=16X
+       ARG     Y
+       CALL    1,FAD   /     EXPRESS Y AS INTEGER N AND FRACTION F
+       ARG     Y
+       CALL    0,FIX   /     GET N
+       SMA
+       IAC
+       DCA     ALOG    /     ALOG=N
+       TAD     ALOG    /     GET F
+       CIA
+       CALL    0,FLOT
+       CALL    1,FAD
+       ARG     Y
+       TAD     (5      /     5 TERMS OF SERIES
+       JMS     POL
+       EXS
+       CALL    1,FAD   /     PLUS 1
+       ARG     ONE
+       CALL    1,STO   /     GIVES B**F
+       ARG     Y
+       CALL    1,FAD   /     GET B
+       ARG     ER16
+       CALL    1,FIPOW
+       ARG     ALOG
+       CALL    1,FMP   /     B**(N+F)=(B**16X)(E**X)
+       ARG     Y
+       RETRN   EXP     /     EXIT
+EXPERR,        CALL    1,ERROR
+       ARG     EXPER
+       TAD     ACH
+       SMA CLA
+       CLL CMA RAR
+       DCA     ACH
+       DCA     ACM
+       DCA     ACL
+       RETRN   EXP
+\f
+/
+/      IFPOW - INTEGER TO FLOATING POWER
+/
+/      JUST FLOAT BASE AND GO TO FFPOW
+/
+IFPOW, BLOCK   1
+       5               /     ENTRY POINT
+       CALL    0,FLOT
+       TAD     IFPOW   /     FROM BANK
+       DCA     FFPOW   /     TO PROPER LOCATION
+       TAD     IFPOW#  //     FROM ADDRESS
+       DCA     FFPOW#       /TO PROPER LOC
+       JMP     ML      /     SNEAK INTO ROUTINE
+
+/
+/      FFPOW- FLOATING TO FLOATING POWER
+/
+/      IDENTITY USED ... X**Y=EXP(Y*ALOG(X))
+/
+       CPAGE   4
+FFPER, 4614
+       2027
+FFPOW, BLOCK   1
+       5               /     ENTRY POINT
+ML,    TAD I   FFPOW   /     GET CDF TO EXPONENT
+       DCA     LXP
+       INC     FFPOW#  /     INCREMENT TO EXPONENT ADDRESS
+       TAD I   FFPOW   /     GET EXPONENT ADDRESS
+       DCA     LXP#
+       INC     FFPOW#  /     INCREMENT FOR EXIT
+       TAD I   LXP     /     HIGH ORDER WORD OF EXPONENT
+       SNA CLA         /     IS IT ZERO
+       JMP     FFP5    /     YES ... RESULT=1
+       TAD     ACH     /     BASE IS IN FLOATING POINT AC
+       SPA
+       JMP     FFPERR
+       SZA CLA         /     IF BASE EQUALS ZERO ... RESULT EQUALS ZERO
+       JMP     FFP1
+       RETRN   FFPOW   /     ZERO RESULT EXIT
+FFP1,  CALL    1,STO   /     SAVE BASE
+FFP2,  ARG     X
+       CALL    1,ALOG
+       ARG     X
+       CALL    1,FMP   /     Y*LOG(X)
+LXP,   ARG     0       /     ADDRESS STORED HERE
+       CALL    1,STO
+       ARG     X
+       CALL    1,EXP
+       ARG     X
+FFP6,  RETRN   FFPOW
+FFP5,  CALL    0,CLEAR /     ANYTHING TO ZERO POWER IS 1
+       TAD     (2014
+       DCA     ACH
+       JMP     FFP6
+FFPERR,        TAD     (4000
+       DCA     ACH
+       CALL    1,ERROR
+       ARG     FFPER
+       JMP     FFP1
+       END
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/PT8E.PA b/sw/os8/v3d/sources/system/dectapes/dectape3/PT8E.PA
new file mode 100644 (file)
index 0000000..5e2e942
--- /dev/null
@@ -0,0 +1,187 @@
+/1 HI SPEED READER/PUNCH 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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/1 HI SPEED READER/PUNCH HANDLER
+       *0
+       -2
+DEVICE PT8E;DEVICE PTP;1020;0;ZBLOCK 2
+DEVICE PT8E;DEVICE PTR;2010;112;ZBLOCK 2
+
+       PTVERSION="A&77
+
+       *200
+       /THIS IS THE REAL HIGH SPEED HANDLER.
+       /HIGH SPEED PAPER TAPE HANDLER FOR BLEEP MONITOR
+       /PACKS 3 CHARACTERS IN 2 WORDS ON INPUT, UNPACKS ON OUTPUT
+       /PAGE RELOCATABLE
+PTP,   PTVERSION
+       CLA CLL CML     /SET LINK ON TO INDICATE PUNCH
+       JMS PSETUP      /DO COMMON CRAP
+PTPLP, TAD I PTPCA
+       JMS PTPPCH      /FIRST CHAR IN LOW ORDER 8 BITS OF WORD 1
+       DCA PTR
+       ISZ PTPCA
+PT7700,        7700
+       TAD I PTPCA
+       JMS PTPPCH      /SECOND CHAR IN LOW ORDER 8 BITS OF WORD 2
+       CLL RTR
+       RTR
+       TAD PTR
+       RTR
+       RTR     /THIRD CHARACTER NOW IN AC
+       JMS PTPPCH
+PTPEND,        ISZ PTPCA
+PT70,  70      /JUST IN CASE WERE PUNCHING PG 7600 KEEP THIS LITERAL HERE
+       KSF
+       JMP PTPISZ      /KEYBOARD FLAG OFF - DON'T WORRY ABOUT ^C
+PTPKRS,        KRS
+       AND PTP177
+       TAD PTPM3
+       SZA CLA /IS THERE A ^C IN THE TTY BUFFER?
+       JMP PTPISZ      /NO
+PTPCIF,        CDF CIF 0
+       JMP I .+1
+       7600
+PSETUP,        0
+       RDF     /GET FIELD OF CALLING PROGRAM
+       TAD PTPCIF
+       DCA PTPXIT      /SET UP RETURN SEQUENCE
+       TAD I PTP
+       AND PT70
+       TAD PCDF
+       DCA PTPCDF
+       RAR             /GET LINK(1=PTP,0=PTR)
+       TAD I PTP       /GET FUNCTION WORD
+       ISZ PTP
+       SPA             /CHECK CORRECT MODE
+       JMP PTPERR      /SIGNAL "UNRECOVERABLE DEVICE ERROR"
+       AND PT7700
+       CMA             /SET UP -(WORD COUNT)/2-1
+       DCA PTPWC
+       TAD I PTP       /SET UP STARTING ADDRESS
+       ISZ PTP
+       DCA PTPCA
+       TAD I PTP
+PTPCDF,        0               /SET DATA FIELD TO ACCESS BUFFER
+       PTPEOF=PTPCDF
+       SNA CLA
+       SZL
+       JMP PTPKRS
+       TAD PTP336      /INPUT INITIALIZATION - TYPE "^" AND WAIT
+       TLS
+       KSF
+       JMP .-1
+       JMS PTRGCH      /INITIALIZE THE PTR BUFFER CHAR
+       6032            /CLEAR AC AND KEYBOARD FLAG
+       JMP PTPKRS      /CHECK FOR ^C
+PTPISZ,        ISZ PTPWC
+       JMP I PSETUP    /LOOP FOR BUFFER SIZE (128 WORDS)
+PTPRTN,        TAD PTPEOF
+       SZA CLA         /DID WE RUN OUT OF TAPE?
+       ISZ PTP
+       ISZ PTP
+PTPXIT,        HLT     /EXIT CDF GOES HERE
+       JMP I PTP
+PTPPCH,        0
+       PLS     /NOTICE THE GLORIOUS LACK OF OVERLAP
+       PSF
+       JMP .-1
+       AND PT7400
+       JMP I PTPPCH
+PTPCA, 0
+PTR,   PTVERSION       /*** CORRECT ENTRY IN MAIN ASSEMBLY IF THIS IS MOVED!
+       CLA CLL
+       TAD PTR
+       DCA PTP
+       JMS PSETUP      /SET UP ADDRESS, COUNT, FIELDS
+PTRLP, JMS PTRGCH      /READ FIRST CHARACTER OF 3
+       DCA I PTPCA
+       JMS PTRGCH
+       DCA PTPPCH
+       JMS PTRGCH
+       RTL
+       RTL
+       AND PT7400
+       TAD I PTPCA
+       DCA I PTPCA     /HIGH ORDER 4 BITS INTO WORD 1
+       TAD PTR         /GET THE CHAR FROM THE PTR BUFFER
+       RTR
+       RTR
+       RAR             /PUT THE LOW ORDER BITS INTO AC 0-3
+       AND PT7400
+       TAD PTPPCH
+       ISZ PTPCA
+PT7400,        7400
+       DCA I PTPCA     /LOW ORDER 4 BITS INTO WORD 2
+       JMP PTPEND
+PTRGCH,        0
+       TAD PTPEOF
+       SNA CLA
+       JMP PT0BFR      /MAKE SURE BUFFER IS ZEROED
+       RFC
+       DCA PTPEOF
+PTTIME,        ISZ PTPEOF      /THIS LOOP OVERFLOWS IN APPROX. 100 MS ON A PDP-8,
+       JMP PGCHLP      /72 MS ON A PDP-8/E
+       TAD PTP232      /SEND ^Z TO BUFFER
+PT0BFR,        DCA PTR
+       JMP PTRXX       /AND 0 GARBAGE CHARACTER
+PGCHLP,        TAD PTPTMP
+       DCA PTR
+PTP232,        232
+PTP336,        336             /FALL THROUGH CONSTANTS TO STALL FOR TIME
+PTP177,        177
+       RSF
+       JMP PTTIME      /READER NOT READY - CHECK TIMING
+       RRB             /READER READY - READ CHAR
+PTRXX, DCA PTPTMP      /BUFFER READER BY ONE CHARACTER TO ELIMINATE
+       TAD PTR         /GARBAGE CHARACTER AT END OF TAPE
+       JMP I PTRGCH    /AND RETURN
+PTPERR,        CLA CLL CML RAR /SIGNAL A "PERMANENT I/O ERROR" ON THE DEVICE
+       JMP PTPXIT-2
+PCDF,  CDF 0
+PTPTMP,        0
+PTPWC, 0
+PTPM3, -3
+$$$$$$$$
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/README b/sw/os8/v3d/sources/system/dectapes/dectape3/README
new file mode 100644 (file)
index 0000000..4ba1096
--- /dev/null
@@ -0,0 +1,27 @@
+This area contains the files contained on system release DECtape #3.
+
+Directory of OS/8 V3D DECtape 3 labeled:  AL-4693C-SA     2/26/78
+                                         OS/8 OPRG SYS SRC TAPE  3 OF 7
+
+
+CR8E  .PA  21 01-AUG-77    UTILTY.SB  20 01-AUG-77
+TC08SY.PA  13 01-AUG-77    CD    .PA  65 01-AUG-77
+TC08NS.PA  14 01-AUG-77    POWERS.SB  15 01-AUG-77
+INTEGR.SB  16 01-AUG-77    RX01SY.PA  21 01-AUG-77
+L645  .PA   8 01-AUG-77    SQRT  .SB   6 01-AUG-77
+IPOWRS.SB   8 01-AUG-77    DUMP  .PA  19 01-AUG-77
+LINCNS.PA  10 01-AUG-77    VT50  .PA  11 01-AUG-77
+LPSV  .PA  12 01-AUG-77    LINCSY.PA   9 01-AUG-77
+TD8ESY.PA  20 01-AUG-77    BITMAP.PA  42 01-AUG-77
+ROMMSY.PA   9 01-AUG-77    TDINIT.PA  51 01-AUG-77
+RF08NS.PA  10 01-AUG-77    C3BOOT.PA  30 01-AUG-77
+PT8E  .PA  11 01-AUG-77    IOH   .SB  49 01-AUG-77
+CS    .PA  23 01-AUG-77    TRIG  .SB  13 01-AUG-77
+RK8ENS.PA  17 01-AUG-77    ATAN  .SB   9 01-AUG-77
+LSPT  .PA  10 01-AUG-77    RWTAPE.SB  10 01-AUG-77
+TM8E  .PA  28 01-AUG-77    IOPEN .SB  12 01-AUG-77
+VR12  .PA  20 01-AUG-77    TDCOPY.PA  79 01-AUG-77
+
+  34 files in  711 blocks -   19 free blocks
+
+
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/RF08NS.PA b/sw/os8/v3d/sources/system/dectapes/dectape3/RF08NS.PA
new file mode 100644 (file)
index 0000000..3f7c156
--- /dev/null
@@ -0,0 +1,204 @@
+/3 RF08 NON SYSTEM HANDLER / NULL:
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/     SR
+
+       RF08=1          /CHANGE TO 0 FOR DF32 HANDLER
+
+       *0
+
+       -2
+       IFNZRO RF08 <
+       DEVICE RF;DEVICE RF;4064;RF&177;ZBLOCK 2
+       >
+       IFZERO RF08 <
+       DEVICE DF;DEVICE DF;4124;DF&177;ZBLOCK 2
+       >
+       DEVICE RF;DEVICE NULL;0240;NULL&177;ZBLOCK 2
+
+       SCA=7751
+       SWC=7750
+
+       RFVERSION="A&77
+       NULLVERSION="A&77
+\f      *200
+
+INITLC,        0               /PATCH TO 232 TO HAVE NULL STORE ^Z IN BUFFER
+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
+T1,    0
+T2,    0
+
+CTLC,  0
+       KRS
+       AND (177
+       TAD (-3
+       SNA CLA
+       KSF
+       JMP I CTLC
+CIFCDF,        CIF CDF 0       /RETURN TO OS/8 IF USER TYPED ^C
+       JMP I S7600
+       ZBLOCK 224-.
+       IFNZRO .-224 <ADRERR,QQQQ>      /ENTRY PT MUST BE RELATIVE 24
+\fDF,
+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 SCDF
+       DCA RESRDF
+SCDF,  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 CIFCDF
+       DCA SFIELD
+       IFZERO  RF08    <6622>
+       IFNZRO  RF08    <6623>
+       JMP .-1
+       JMS CTLC
+       ISZ RF
+       6621            /SKIP ON ERROR
+       IFNZRO RF08 <SKP        /SENSE OF SKIP IS REVERSED>
+       JMP SYSER
+       ISZ RF
+SFIELD,        HLT             /RETURN TO PROPER FIELD
+       6601            /CLEAR TROUBLESOME FLAG
+       JMP I RF
+
+       IFZERO RF08 <S3700,     3700>
+       IFNZRO RF08 <S377,      0377>
+\fNULL, NULLVERSION
+       CLA
+       RDF
+       TAD CIFCDF
+       DCA NULRET
+       JMS CTLC
+       TAD I NULL      /GET FN WORD
+       DCA SFUN
+       ISZ NULL        /POINT TO CORE LOC
+       TAD I NULL      /GET START OF BUFFER
+       DCA T1
+       ISZ NULL        /POINT TO BLOCK NUMBER
+       ISZ NULL        /POINT TO ERROR RETURN
+       TAD SFUN
+       SPA CLA
+       JMP BYE         /LEAVE BUFFER ALONE ON A WRITE
+       TAD SFUN
+       AND S70         /ISOLATE FIELD OF BUFFER
+       TAD SCDF
+       DCA NFIELD
+       TAD SFUN
+       CLL RAL
+       AND S7600       /GET NO. OF WDS IN BUFFER
+       CIA
+       DCA T2
+       TAD INITLC
+NFIELD,        HLT             /GO TO FIELD OF BUFFER
+       DCA I T1        /ZERO BUFFER
+       ISZ T1
+       ISZ T2
+       JMP .-3
+BYE,   TAD SFUN
+       RAL             /PUT R/W BIT IN LINK
+       CLA CML RAL     /AC=1 IF READING
+       SNA
+       ISZ NULL        /POINT TO GOOD RETURN IF WRITE
+NULRET,        HLT             /BACK TO USER'S DATA FIELD, INST FIELD
+       JMP I NULL      /RETURN
+
+SYSCNT,        0
+S6603, 6603
+S70,   70
+S7400, 7400
+       $
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/RK8ENS.PA b/sw/os8/v3d/sources/system/dectapes/dectape3/RK8ENS.PA
new file mode 100644 (file)
index 0000000..22ba8f4
--- /dev/null
@@ -0,0 +1,245 @@
+/1 RK8E NON-SYSTEM HANDLER FOR OS/8
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+
+/DEC-S8-URK8B-A-LA             HJ
+
+/COPYRIGHT 1973
+
+/DIGITAL EQUIPMENT CORPORATION
+
+/MAYNARD, MASSACHUSETTS   01754
+
+/JANUARY 22, 1973
+\f
+/ONE RK8E IS TREATED AS TWO LOGICAL DISKS
+/EACH OF 3248 OS/8 BLOCKS.
+
+/THIS HANDLER CONTAINS ENTRY POINTS FOR THE 8 LOGICAL UNITS.
+/(RKA0,RKB0,RKA1,RKB1,RKA2,RKB2,RKA3,RKB3)
+
+
+       DCLR=6742
+       DLAG=6743
+       DLDC=6746
+       DRST=6745
+       DSKP=6741
+       DLCA=6744
+       *0
+       -10
+DEVICE RK05;DEVICE RKA0;4230;20;ZBLOCK 2
+DEVICE RK05;DEVICE RKB0;4230;21;ZBLOCK 2
+DEVICE RK05;DEVICE RKA1;4230;22;ZBLOCK 2
+DEVICE RK05;DEVICE RKB1;4230;23;ZBLOCK 2
+DEVICE RK05;DEVICE RKA2;4230;24;ZBLOCK 2
+DEVICE RK05;DEVICE RKB2;4230;25;ZBLOCK 2
+DEVICE RK05;DEVICE RKA3;4230;26;ZBLOCK 2
+DEVICE RK05;DEVICE RKB3;4230;27;ZBLOCK 2
+\f      VERSION="A&77
+
+       *200
+
+/THE FOLLOWING MUST REMAIN HERE BECAUSE OF THE R200 REF.
+R37,   37              /USED TO CHECK FOR CYLINDER CHANGE
+RKEBLK,        0               /12 BITS OF BLOCK NUMBER
+CHKHED,        0               /CHECK HEADER FLAG
+RKEARG,        0               /HOLDS RETURN ADDRESS
+RKENO, 0               /HOLDS ENTRY POINT COUNT
+PAGCNT,        0               /HOLDS REMAINING PAGE COUNT
+RKEISZ,        ISZ RKENO       /TO PUT BACK OVER THE EP ADDR
+
+CTRLC, TAD R200        /TO IGNORE PARITY
+       KRS             /READ THE KEYBOARD
+       TAD R7575       /SUBTRACT ^C
+       SNA CLA
+       KSF             /IS KEYBOARD FLAG UP?
+       JMP RWAIT       /NO
+RCIF,  CDF CIF 0
+       JMP I R7600     /BOOTSTRAP
+
+
+
+
+
+
+/NOTE: A LOCATION CAN BE EEKED OUT BY USING RKA0 BETTER
+RERRCT,        0               /HOLDS RETRY COUNT
+\f      ZBLOCK 220-.    /PAD ENTRY POINTS TO 220
+
+RKA0,  VERSION
+RKB0,  ISZ RKENO       /THE ISZ'S SET UP A COUNT OF
+RKA1,  ISZ RKENO       /OF WHICH ENTRY POINT WE CAME IN
+RKB1,  ISZ RKENO
+RKA2,  ISZ RKENO
+RKB2,  ISZ RKENO
+RKA3,  ISZ RKENO
+RKB3,  ISZ RKENO
+R400,  400             /AN INNOCUOUS AND INSTRUCTION WHICH
+                       /IS REFERENCED BY A TAD.
+       CLA CLL CMA RTL /AC=-3
+       DCA RERRCT      /RETRY 3 TIMES
+       TAD RKENO       /7-EP NUMBER
+       CMA             /EP-8
+       TAD RKETAD      /ADD ON INSTRUCTION
+                       /WHICH REFERENCES THE 400 TO GENERATE A
+                       /TAD CORRECT ENTRY POINT INSTRUCTION.
+       DCA GETENT      /WE EXECUTE TO GET USERS ADDRESS
+       CLA CLL CML RTR /AC=2000
+       TAD GETENT      /GENERATE A DCA INTO ENTRY POINT INSTRUCTION
+       DCA RKECMD      /THIS IS EXECUTED TO REPLACE ISZ RKENO
+       RDF             /GET USERS DATA FIELD
+       TAD RCIF        /BUILD A CIF FOR RETURNING
+       DCA REXIT       /STORE IT INTO THE EXIT CODE
+GETENT,        HLT             /WILL BE A TAD "ENTRY POINT"
+                       /WILL SAVE UNIT INFO HERE FOR ERRORS
+       DCA RKEARG      /SAVE USERS ADDR IN COMMON LOCATION
+       DCA RKENO       /ZERO COUNT FOR NEXT TIME
+       TAD RKEISZ      /GET THE ISZ RKENO
+RKECMD,        HLT             /THE DCA ENTRY POINT IS PUT HERE
+                       /AND THIS LOCATION IS USED FOR THE RK8E COMMAND
+\f
+
+RETRY, TAD RKEARG      /AC=-2 IF ERROR RETRY
+       DCA RKEARG
+       TAD GETENT
+       AND R6          /GET THE UNIT NUMBER
+       DCA RKECMD      /SET UP UNIT FOR COMMAND 
+       TAD GETENT
+       RAR             /PUT HI/LOW LOGICAL DISK BIT IN LINK
+       SZL CLA
+       TAD R6260       /DISPLACEMENT TO 2ND HALF OF DISK
+       DCA RKA0        /NICE PLACE FOR A CONSTANT
+       TAD I RKEARG    /GET ARG1
+       AND R4070       /GET R/W AND DF BITS
+       TAD RKECMD      /GET UNIT NUMBER
+       DCA RKECMD      /BASE COMMAND TO RK8E(DLDC)
+       TAD I RKEARG    /GET ARG1 AGAIN
+       TAD I RKEARG    /GET ARG1 AGAIN
+       ISZ RKEARG      /POINT TO ARG2
+       AND R7600
+       CIA             /TO MAKE 0 LOOK LIKE 40 PAGES
+       DCA PAGCNT      /SAVE PAGE COUNT
+       TAD I RKEARG    /GET ARG2
+       ISZ RKEARG      /POINT TO ARG3
+       DLCA            /LOAD CURRENT ADDRESS REGISTER
+\f
+       TAD I RKEARG    /GET ARG3
+       CLL     
+       TAD RKA0        /SYS OR RKB0 DISPLACMENT
+       DCA RKEBLK      /LOW PART OF RK8E BLOCK NUMBER
+       SZL             /STILL OFF IF BELOW BLOCK 10000
+OVRFLO,        ISZ RKECMD      /TURN ON EXTENDED BIT IF OVERFLOWED
+RELOOP,        DCA CHKHED      /SET CHECK HEADER FLAG TO EITHER
+                       /0 OR 4000(WHICH GETS RTR'D BEFORE USED)
+                       /AND CAUSES EITHER A "DATA" OR "ALL"
+                       /TRANSFER
+       DCLR            /CLEAR STATUS REGISTER
+       TAD PAGCNT      /TEST TO SEE IF ONLY 1 PAGE WANTED
+       TAD R200
+       SNA CLA
+RKETAD,        TAD R400        /7600 WAS IN PAGCNT
+       TAD CHKHED      /ADD IN CHECK HEADER FLAG
+       CLL RTR         /SHIFT TO CORRECT BITS
+       TAD RKECMD      /ADD IN BASE COMMAND
+       DLDC            /LOAD COMMAND REGISTER
+       TAD RKEBLK
+       DLAG            /LOAD BLOCK REGISTER AND GO
+RWAIT, DSKP            /WAIT ON FLAG
+       JMP CTRLC       /CHECK FOR CONTROL C WHILE WAITING
+       DRST            /READ COMPLETION REGISTER
+       CLL RAL         /GET RID OF SUCCESS BIT
+       SZA             /AND SEE IF ANYTHING LEFT
+       JMP RERROR      /AN ERROR
+
+/IF THERE WAS NO ERROR L=1 BECAUSE DONE FLAG
+       TAD PAGCNT      /CHECK TO SEE IF DONE
+       TAD R400        /ADD 2 PAGES ONTO TOTAL
+       SNL
+       JMP RKDONE      /NO MORE TO DO
+       DCA PAGCNT      /SAVE FOR NEXT TIME
+       TAD RKEBLK
+       CMA
+
+/THE R37 MUST REMAIN AT 200 SO THE FOLLOWING IS A 200
+R200,  AND R37         /IF BLOCK IS AT A 37 MAKE
+                       /NEXT OPERATION DO A CHECK HEADER
+       SZA CLA
+       STL RAR         /SET AC TO "ALL" FLAG
+       ISZ RKEBLK      /BUMP BLOCK NUMBER
+       JMP RELOOP      /TRANSFER SOME MORE
+       JMP OVRFLO      /PAST BLOCK 7777-SET EXTENDED BIT
+\f
+RERROR,        AND R1002       /AC WAS RAL'D AND WE WANT TO SEE IF
+                       /DRIVE SEEK FAILED OR CYLINDER ADDR ERROR
+       SNA CLA
+       JMP RKTST3      /WE TRY 3 TIMES
+/WE HAVE TO RECALIBRATE DRIVE
+       DCLR            /CLEAR STAUS REGISTER
+       STL RTL         /AC=2
+       DCLR            /RECALIBRATE DRIVE
+       DSKP            /WAIT ON FLAG
+       JMP .-1
+       DCLR            /CLEAR STATUS REGISTER
+       DRST            /WAIT FOR STATUS TO CLEAR
+       SZA CLA
+       JMP .-2         /STILL DOING RECALIBRATE
+RKTST3,        CLA CLL CMA RAL /AC=-2
+       ISZ RERRCT      /SKIP IF WE TRIED 3 TIMES
+       JMP RETRY       /TRY AGAIN
+       JMP .+3         /ERROR EXIT
+RKDONE,        ISZ RKEARG      /NORMAL RETURN
+R7600, 7600            /GROUP 2 CLA
+       ISZ RKEARG      /IF JUMPED TO HERE- ERROR RETURN
+REXIT, HLT             /RESET USERS INST FIELD- WE NEVER TOUCHED DF
+       JMP I RKEARG    /EXIT
+
+R6260, 6260            /SIZE OF ONE LOGICAL DISK
+R4070, 4070            /USED TO GET READ/WRITE AND DF BITS
+R1002, 1002            / " TO CHECK FOR RECALIBRATE ERRORS
+R6,    6               /TO PEEL OUT UNIT NUMBER
+R7575, 7575            /- ^C CONSTANT
+
+
+       $$$$
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/ROMMSY.PA b/sw/os8/v3d/sources/system/dectapes/dectape3/ROMMSY.PA
new file mode 100644 (file)
index 0000000..47e521a
--- /dev/null
@@ -0,0 +1,199 @@
+/2 ROM-TD8E 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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f      ROMFLD=70
+       VERSION="A&77
+/THESE ARE ASSEMBLY REFERENCES TO LOCATIONS IN THE ROM:
+
+       RGO=7405
+       F2SET=7552
+/      TD8E MNEMONICS:
+       SDSS=6771
+       SDST=6772
+       SDSQ=6773
+       SDLC=6774
+       SDLD=6775
+       SDRC=6776
+       SDRD=6777
+       *0
+
+       -3
+       DEVICE ROM;DEVICE SYS;4211;2007;0;1341
+       DEVICE ROM;DEVICE DTA0;4211;1007;0;1341
+       DEVICE ROM;DEVICE DTA1;4211;SDTA1&177+1000;0;1341
+\f      STARTB-ROMCT-1
+
+       NOPUNCH
+       *7360           /ROOM FOR DECTAPE HEADER WORDS
+       ENPUNCH
+
+STARTB,        ZBLOCK 20
+       CDF 0           /BOOTSTRAP TO MOVE FIELD 1
+       TAD I ROM1      /CODE UP TO FIELD 1
+       CDF 10
+       DCA I ROM2
+       ISZ ROM1
+       NOP
+       ISZ ROM2
+       NOP
+       ISZ ROMCT
+       JMP 7400
+       CIF CDF 0       /DONE
+       SDLC            /STOP THE TAPE
+       JMP I .+1
+       7605            /START HER UP
+ROM1,  7427            /FIELD 1 CODE GETS LOADED HERE
+ROM2,  7647            /AND GOES UP HERE
+ROMCT, -130
+\f      *200
+
+       NOPUNCH
+       *7600
+       ENPUNCH
+
+       ZBLOCK 7
+SHNDLR,        VERSION         /UNIT 0 ENTRY
+       CLA CLL
+       JMP SHND2
+S70,   70
+S6201, 6201
+SDTA1, VERSION         /UNIT 1 ENTRY POINT
+       CLA CLL CML
+       TAD SDTA1       /GET ARGS AT SHNDLR
+       DCA SHNDLR
+SHND2, RAR             /UNIT BIT IS IN LINC
+       DCA SUNIT
+       RDF
+       TAD S6203       /SETUP RETURN FIELD
+       DCA EFLD
+       TAD I SHNDLR
+       SDLD            /STORE FUNCTION WORD IN DATA REG.
+       AND S70         /SDLD DOESN'T CLEAR AC
+       TAD S6201       /ISOLATE FIELD OF XFER
+       DCA TFLD
+       TAD TFLD
+       DCA TFLD2
+       ISZ SHNDLR
+       TAD I SHNDLR    /BUFFER ADDRESS
+       DCA BPTR
+       ISZ SHNDLR
+       TAD I SHNDLR    /PS/8 RECORD #
+       CLL RAL         /TIMES 2 FOR ABSOLUTE BLOCK
+       DCA BLOCK
+       ISZ SHNDLR
+       CDF 0
+       CIF ROMFLD      /ROM IS IN FIELD 7
+       JMP I XF2SET    /INITIALIZE.
+\fGET,  0
+TFLD,  HLT             /ROUTINE TO LOAD DATA FROM BUFFER
+       TAD I XPTR
+       CIF ROMFLD
+       JMP I GET
+
+PUT,   0               /PUT DATA INTO BUFFER
+TFLD2, HLT
+       DCA I XPTR
+       CIF ROMFLD
+       JMP I PUT
+
+ERROR, CLA CLL         /FORCE TURNAROUND AT RGO
+       CIF ROMFLD
+       ISZ TRYCNT      /TRIED 3 TIMES?
+       JMP I XRGO
+S6203, CIF CDF 0
+       JMP SEREX       /YES..FATAL EXIT
+
+XRGO,  RGO
+XF2SET,        F2SET
+\f/EQUIVALENCES FOR HANDLER
+
+       EQUTMP=7750
+       BPTR=7751
+       XPGCT=7752
+       XPTR=7753
+       XWCNT=7754
+       WRQ=7724
+WRQUAD,        0               /WRITE A 12 BIT TAPE WORD
+       CIF ROMFLD
+       JMP WRQ
+CIFR,  CIF ROMFLD
+       JMP I WRQUAD
+
+RDQUAD,        0               /READ A 12 BIT DATA WORD
+       SDSQ
+       JMP .-1
+       SDRD
+       CIF ROMFLD
+       JMP I RDQUAD
+
+EQUFUN,        0               /EQUIVALENCE CHECKSUM
+       CMA
+       DCA EQUTMP
+       TAD EQUTMP
+       AND SCKSUM
+       CIA
+       CLL RAL
+       TAD EQUTMP
+       TAD SCKSUM
+       DCA SCKSUM
+       TAD EQUTMP
+       CLL CMA
+       CIF ROMFLD
+       JMP I EQUFUN
+
+SEXIT, ISZ SHNDLR      /NORMAL EXIT
+SEREX, TAD SUNIT       /STOP THE DRIVE
+       SDLC
+       CLA CML RAR     /EXIT CONDITION IN BIT 0
+EFLD,  HLT
+       JMP I SHNDLR
+
+TRYCNT,        0
+SXUNIT,        0
+SXFUN, 0
+SCKSUM,        0
+BLOCK, 0
+SUNIT, 0
+       $
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/RWTAPE.SB b/sw/os8/v3d/sources/system/dectapes/dectape3/RWTAPE.SB
new file mode 100644 (file)
index 0000000..4b41021
--- /dev/null
@@ -0,0 +1,204 @@
+/DECTAPE I-O ROUTINES                         OS8 FORTRAN II LIBRARY
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/     VERSION 2A
+/
+/      CALL 4, RTAPE(WTAPE)
+/      ARG UNIT
+/      ARG +-BLOCK (-MEANS START SEARCH FORWARD)
+/      ARG WORD COUNT
+/      ARG CORE ADDRESS
+/      VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
+/
+       ENTRY   RTAPE
+       ENTRY   WTAPE
+       DUMMY WCT
+       DUMMY CAD
+       OPDEF TADI 1400
+       OPDEF DCAI 3400
+
+       LAP             /ENABLE FIT INTO 1 PAGE
+/
+/DATA
+/
+DFUNC, 0
+DBLK,  0
+DWCT,  0
+DFIELD,        0
+WCT,   7754
+CAD,   7755
+DCORE,
+/
+/ARG PICKUP ROUTINE
+/
+GETARG,        0
+       TAD I   RTAPE
+       DCA     AA
+       INC     RTAPE#
+       TADI    RTAPE#
+       DCA     WTAPE#
+       INC     RTAPE#
+AA,    NOP             /SET DATA FIELD
+       TADI    WTAPE#
+       JMP I   GETARG
+/
+/ERROR
+/
+DTERR, CALL    1,ERROR                 /CK FOR ERROR
+       ARG     TAPERR
+/
+/DATA
+/
+/
+/START
+/
+WTAPE, BLOCK   1
+       2
+       TAD     WTAPE           /MOVE ARG ADDR TO RTAPE
+       DCA     RTAPE
+       TAD     WTAPE#
+       DCA     RTAPE#
+       IAC                     /WRITE FUNCTION
+       JMP     TARGS
+TAPERR,        2401                    /TA
+       2005                    /PE
+RTAPE, BLOCK   1
+       2
+TARGS, DCA     DFUNC           /READ=0, WRITE=1
+       JMS     GETARG          /GET UNIT #
+       CLL RTR                 /TO BITS 0-2
+       RTR
+       TAD     DFUNC           /COMBINE WITH R-W BIT
+       DCA     DFUNC
+       JMS     GETARG          /GET BLK #
+       SMA
+       JMP     RT2             /REV. SRCH.
+       CIA                     /FORWARD SRCH.
+       DCA     DBLK
+       JMP     RT3
+RT2,   DCA     DBLK
+       TAD     (400            /REV. SRCH. BIT
+       TAD     DFUNC
+       DCA     DFUNC
+RT3,   JMS     GETARG          /GET W.C.
+       CIA
+       DCA     DWCT
+       JMS     GETARG          /GET CORE ADDR
+       CLA CMA
+       TAD     WTAPE#
+       DCA     DCORE
+       TAD     AA              /GET CORE FIELD
+       DCA     DFIELD
+/
+/DEFINITIONS
+/
+OPDEF  DTCA    6762
+OPDEF  DTXA    6764
+OPDEF  DTLB    6774
+OPDEF  DTRB    6772
+SKPDF  DTSF    6771
+OPDEF  DTRA    6761
+/
+/START OF DECTAPE I-O
+/
+       TAD     DFUNC           /UNIT & DIRECTION
+       AND     (7400
+       TAD     (10             /+ SRCH MODE
+       DTCA DTXA               /SET STATUS & CLR FLGS
+       DTLB                    /CLR FIELD BITS
+       TAD     WCT             /USE 7754 AS ADDR TO
+       6201            /SET FIELD 0
+       DCAI    CAD             /STORE BLK FOUND
+DTSERR,        RTL                     /REENTRY FOR SRCH ERROR
+       RAL                     /ENDZONE FLAG TO LINK
+       CLA CML                 /CHANGE DIRECTION
+       TAD     (200            /DTA GO FLAG
+DTCONT,        SNL                     /CK DIR.
+DTREV, TAD     (400            /CHANGE DIR.
+DTSRCH,        DTXA                    /GO INTO SEARCH
+       DTSF DTRB               /READ CONDITION
+       JMP     DTSRCH#
+       SPA
+       JMP     DTSERR          /ERROR
+       DTRA                    /GET CUR. DIR.
+       RTL                     /TO LINK
+       RTL
+       SZL CLA
+       TAD     (3              /FOR REV GET BLK-3
+       6201
+       TADI    WCT             /# OF LAST BLK SEEN
+       CMA                     /CIA MIGHT BLOW THE LINK
+       TAD     DBLK
+       CMA
+       SZA CLA
+       JMP     DTCONT          /CONT. SRCH
+       SZL                     /FOUND, CK DIR.
+       JMP     DTREV           /IF REV, SNEAK BACK UP
+       TAD     DWCT            /SET WORD COUNT
+       DCAI    WCT
+       TAD     DCORE
+       DCAI    CAD
+LABEL, TAD     DFIELD          /LOAD FIELD BITS
+       DTLB
+       IAC                     /GET R-W FUNCTION
+       AND     DFUNC
+       CLL RTL
+       RTL
+       TAD     (130            /SET UP FUNCTION FOR
+                               /THE XOR TO GIVE SRCH
+                               /MODE CLEARED & SET CONTINUOUS MODE
+                               /READ=3, WRITE=5
+       DTXA                    /BEGIN TRANSFER
+DTWAIT,        DTSF                    /WAIT FOR W.C. OVERFLOW
+       JMP     DTWAIT
+       DTRA
+       AND     (200            /STOP-GO BIT
+       TAD     (2              /SAVE DTA & ERROR FLAGS
+       DTXA                    /STOP TAPE
+       DTRB                    /READ ERROR FLAGS
+       SPA CLA                 /CK FOR ERROR
+       JMP     DTERR           /YES
+       RETRN   RTAPE
+       END
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/RX01SY.PA b/sw/os8/v3d/sources/system/dectapes/dectape3/RX01SY.PA
new file mode 100644 (file)
index 0000000..59a1994
--- /dev/null
@@ -0,0 +1,334 @@
+/FLOPPY DISK (RX01,RX71) SYSTEM HANDLER FOR OS/8
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT  (C)  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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/FLOPPY DISK HANDLER SYSTEM
+
+/DEFINITIONS OF RX8/E IOT'S
+
+RXSVER=        "E&77
+
+DEVCOD=        750     /DEVICECODE
+
+LCD=   6001+DEVCOD     /LOAD COMMAND REGISTER
+XDR=   6002+DEVCOD     /TRANSFER DATA REGISTER
+STR=   6003+DEVCOD     /SKIP ON TRANSFER REQUEST FLAG, CLEAR FLAG
+SER=   6004+DEVCOD     /SKIP ON ERROR FLAG, CLEAR FLAG
+SDN=   6005+DEVCOD     /SKIP ON DONE FLAG, CLEAR FLAG
+INTR=  6006+DEVCOD     /INTERRUPT ENABLE/DISABLE
+INIT=  6007+DEVCOD     /INITIALIZE CONTROLLER AND RECALIBRATE DRIVES
+
+
+/NOTES ON THIS HANDLER:
+
+/THIS HANDLER READS AND WRITES THE DISK IN "12-BIT" MODE, IN WHICH
+/ONLY 6 BITS OF EVERY 8-BIT BYTE ARE USED. AN RX01 CARTRIDGE
+/CONTAINS 494 OS/8 BLOCKS UNDER THIS METHOD
+
+/TO MAXIMIZE SPEED ON THE DEVICE, THE HANDLER READS AND WRITES DATA
+/ON A TRACK WITH A TWO-WAY INTERLEAVE - I.E. RECORDS 1-26 ON A TRACK
+/ARE WRITTEN IN THE SEQUENCE:
+/  1,3,5,7,9,11,13,15,17,19,21,23,25,2,4,6,8,10,12,14,16,18,20,22,24,26
+
+/IN THIS WAY THE HANDLER CAN TRANSFER DATA AT A 5KHZ WORD RATE
+/MAIN CHANGE FROM RX01SY IS THAT THE NEXT DISK ADDRESS IS
+/CALCULATED DURING THE DATA TARNSFER TO/FROM THE DISK TO ITS
+/SECTOR BUFFER. THIS IS NEEDED FOR SLOW 8S !.
+\f      *0              /ORIGIN FOR BUILD
+
+       -1              /ONE ENTRY POINT
+       DEVICE  RX8E    /"RX8E" IS THE GROUP NAME
+       DEVICE  SYS     /"SYS" IS THE ENTRY POINT NAME
+       4250            /DCB WORD - DEVICE TYPE 25, DIRECTORY DEVICE
+       2007            /2000 MEANS SYS HANDLER,7 IS ENTRY POINT OFFSET
+       0               /THIS WORD ALWAYS SEEMS TO BE 0
+       DECIMAL
+       76^26%4         /THE NUMBER OF OS8 BLOCKS ON THE DEVICE
+       OCTAL
+
+       BOOTST-BOOTND   /LENGTH OF THE BOOTSTRAP
+\f
+       RELOC   2
+BOOTST,
+X7577, 7577
+SECT,  1
+FAKRET,        JMS GET1
+       DCA     CDF10
+       CDF 0
+       TAD     X7577
+       DCA XR
+       JMS GET1
+       JMS GET1
+       TAD     UNIT
+       DCA I   PUNIT
+       INIT
+       JMS I   X7577
+XR,    7600+BOOTND-BOOTST-1    /LOC 17
+PUNIT, S4UNIT
+
+GET1,  FAKRET
+       STL RTL
+       TAD     UNIT
+       LCD
+       CLA STL RTL
+       TAD SECT
+       JMS LOAD
+       DCA     SECT
+       CLA IAC
+       JMS     LOAD
+HANGGG,        SDN
+       JMP     LOAD+1
+       SER
+       SKP
+       HLT
+       SNA
+       JMP I   GET1
+       CLA STL RTL
+       LCD
+CDF10, CDF 10
+       JMS     LOAD
+       DCA I   XR
+LP,    JMP     CDF10
+BOOTND,
+       RELOC
+
+\f
+       NOPUNCH
+       *24
+BOOT,  STL RTL
+       TAD     UNIT
+       LCD
+       CLA IAC
+       JMS LOAD
+       JMS LOAD
+       CLL RAL
+
+START,
+HANGGG,        SDN
+       JMP     LOAD+1
+       SER
+       SNA
+       SKP CLA
+       JMP GOODRD
+       TAD UNIT
+       CIA
+       TAD     X6030
+       DCA     UNIT
+       JMP BOOT
+GOODRD,        LCD
+LP,    JMS LOAD
+       DCA     BOOTST
+       ISZ     .-1
+       JMP     LP
+
+LOAD,  0
+       STR
+       JMP     HANGGG
+       XDR
+       JMP I   LOAD
+UNIT,  7024
+X6030, 6030
+
+       ENPUNCH
+\f      *200
+       RELOC   7600
+
+       ZBLOCK  7       /SYSTEM SPACE
+
+/  OVERALL COMMENTS:
+/
+/  LINK REMAINS 0 THROUGH THE MAIN PROCESSING LOOP
+/  EXCEPT AS MANIPULATED BY DIVSUB
+/
+/  OVERALL LOOP CONTROL THROUGH BC IS MILDLY ODD.
+/  BC STARTS WITH MINUS COUNT OF THE # OF WORDS TO BE TRANSFERRED.
+/  BC IS INCREMENTED 77 TIMES AT THE SILO CODE, AND 1 TIME AFTER
+/  THE I/O OPERATION. 
+/  A READ OPERATION STARTS AND FINISHES AT THE MIDDLE OF THE LOOP.
+/  A WRITE OEPRATION STARTS AT THE TOP, AND FINISHES AT BOTTOM.
+/  THUS, A 1 BLOCK READ INCREMENTS 1, 77, 1, 77 AND EXITS FROM MIDDLE.
+/  AND, A 1 BLOCK WRITE INCREMENTS 77, 1, 77, 1 AND EXITS FROM BOTTOM.
+/
+/  DIVISION IS CARRIED OUT IN PARALLEL WITH I/O OPERATION BECAUSE OF
+/  TIMING CONSIDERATIONS OF THE VT78.
+/
+/  THERE IS NO ERROR RETRY, NOT PARTICULARLY CRITICAL FOR A FLOPPY.
+
+SYS,   RXSVER
+       CLL CML CLA RAR /SET LINK=0, AC=4000
+       TAD I   SYS     /TO PUT READ-WRITE BIT TO LINK
+S33,   AND     S70     /KEEP BITS FOR CDF
+       TAD     SCDF0   /ADDING IN CDF LITERAL
+       DCA     BUFCDF  /CDF INSTRUCTION TO USER'S BUFFER
+       CML RTL         /FUNCTION CODE, 0=WRITE, 2=READ
+       DCA     FN
+       RDF             /FETCH CALLER'S FIELD
+       TAD     SCDIF0  /MAKE CDF CIF TO HIS FIELD
+       DCA     SRET    /FOR RETURN
+       TAD I   SYS     /MAKE CONTROL COUNT
+S4UNIT,        RAL             /7004 (7024 FOR UNIT #1) DOUBLES AS
+                       /LITERAL FOR READ-WRITE COMMAND
+       AND     S7600   /MAKE CONTROL COUNT FOR TOTAL
+       CIA             /NUMBER OF WORDS
+       DCA     BC
+       ISZ     SYS
+       TAD I   SYS     /FETCH BUFFER ADDRESS
+       DCA     BUF
+       ISZ     SYS
+S70,   70              /THIS LITERAL MUST BE AT LOCATION 33!
+       IFNZRO  S70&177-33      <.ERROR.>
+       TAD I   SYS     /OS8 BLOCK #
+       CLL RTL         /TIMES 4 TO BE FLOPPY SECTOR #
+       DCA     REC
+       ISZ     SYS     /ERROR EXIT FROM I/O CALL
+       JMS     DIVSUB  /COMPUTE TRACK/SECTOR FOR FIRST I/O
+       TAD     FN      /READ OR WRITE START DIFFERENTLY
+       SZA CLA         /SKIP ON WRITE
+       JMP     STREAD  /GO TO READ
+/
+/  WRITE FALLS THRU.......
+/
+\f/
+/
+/ TOP OF MAIN PROCESSING LOOP
+/
+SETSLO,        TAD     FN      /SET SILO TO LOAD-UNLOAD DEPENDING
+       JMS     LDCMD
+       TAD     S7700   /SILO CONTROL COUNT 100 OCTAL
+       DCA     FLPWC
+BUFCDF,        HLT             /CDF TO USER'S BUFFER PLACED HERE
+TRLOOP,        TAD I   BUF     /FETCH A WORD IN CASE WRITE
+       STR             /WAIT
+       JMP     .-1
+       XDR             /AC TO SILO; OR; SILO TO AC
+       DCA I   BUF     /PLACE A WORD IN CASE READ; WRITE REPLACES SAME.
+       ISZ     BUF     /MOVE TO NEXT BUFFER LOCATION (MAY SKIP)
+S77,   77              /LITERAL 77, EXECUTES AS A NOP
+       ISZ     FLPWC   /DONE WITH 100 OCTAL SILO OPERATION
+       JMP     TRLOOP  /NO
+       TAD     BC      /INCREMENT BC BY 77 HERE, AND 1 LATER
+       TAD     S77
+MAGIC, SNA             /SKIP UNLESS READ DONE;NO-OP FOR LDCMD!
+       JMP     OKEX    /READ EXIT.
+       DCA     BC      /
+/
+/  MIDDLE OF MAIN PROCESSING LOOP
+/
+STREAD,        TAD     FN      /READ STARTS HERE
+       TAD     S4UNIT  /SET UP DO DO READ OR WRITE I/O
+       JMS     LDCMD
+       TAD     MQ      /LOAD PRECOMPUTED SECTOR INFO
+       STR
+       JMP     .-1     /IN CASE NOT READY
+       XDR
+S7700, 7700            /CLEAR AC, CAN'T SKIP (XDR LEAVES AC ALONE)
+       TAD     QUO     /TRACK
+       STR             /ILLEGAL 7700 ENTRY WILL HANG; THE FUNCTION
+       JMP     .-1     /IS NOT SET UP (LDCMD)
+       XDR
+S7600, 7600
+       ISZ     REC     /MOVE TO NEXT FLOPPY SECTOR
+       JMS     DIVSUB  /COMPUTE NEXT TRACK AND SECTOR DURING THIS I/O
+       TAD     MAGIC   /WAIT FOR I/O TO COMPLETE
+       JMS     LDCMD
+       ISZ     BC      /CHECK FOR WRITE EXIT
+       JMP     SETSLO  /NO, BACK TO TOP
+OKEX,  ISZ     SYS     /BUMP TO REGULAR EXIT
+SRET,  HLT             /CDF CIF FOR USER'S CALLING FIELD
+       JMP I   SYS     /GONE
+/
+\f/
+/
+/  LITERALS
+/
+SM15,  -15
+SCDF0, CDF 0
+SCDIF0,        CDF CIF 0
+/
+/  DIVSUB
+/
+/  MUST ENTER WITH LINK AND AC 0
+/  COMPUTES TRACK IN 'QUO', SECTOR IN 'MQ', FROM # IN 'REC'
+/
+/  REPEATED SUBTRACTS OF 13 DECIMAL LEAVE THE HIGH N-1 BITS OF
+/  QUOTIENT IN QUO, THE LOW BIT OF QUOTIENT IN LINK, AND THE
+/  REMAINDER IN AC. THE INTERLEAVE IS ACCOMPLISHED BY SHIFTING
+/  LOW QUOTINET BIT INTO LOW REMAINDER BIT.
+/
+DIVSUB,        0
+       DCA     QUO     /INIT QUOTIENT FOR DIVIDE
+       TAD     REC     /RECORD # MASSAGED IN AC
+DIVLP, SNL             /LINK USAGE REVERSED FROM RICHIE'S CODE
+       ISZ     QUO     /ISZ EVERY OTHER TIME, ==DIVIDE BY 26
+       TAD     SM15    /THE -13 DECIMAL
+       SMA             /SKIP ON DONE
+       JMP     DIVLP   /MORE
+       RAL             /LINK USAGE REVERSED; INTERLEAVE!!
+       TAD     S33     /ADD 233 (200 IRREL) MAKING SECTOR
+       DCA     MQ
+       JMP I   DIVSUB  /LEAVING LINK AND AC 0
+/
+/  LDCMD
+/
+FLPWC=.                /COUNTER IN ENTRY POINT FOR SILO LOOP ONLY
+LDCMD, 0
+       SDN             /WAIT
+       JMP     .-1
+       LCD             /COMMAND FROM AC, WHICH IS CLEARED
+       SER             /SKIP IF ERROR (I/O ONLY)
+       JMP I   LDCMD   /OK, RETURN
+       CLL CML CLA RAR /CONVENTIONAL ERROR RETURN 4000 IN AC
+       JMP     SRET    /SET CDF AND EXIT
+/
+/  USE DATA BREAK LOCATIONS FOR TERMPORARIES
+/
+MQ=7750
+BC=7751
+FN=7752
+QUO=7753
+REC=7754
+BUF=7755
+
+       RELOC
+
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/SQRT.SB b/sw/os8/v3d/sources/system/dectapes/dectape3/SQRT.SB
new file mode 100644 (file)
index 0000000..0bb2701
--- /dev/null
@@ -0,0 +1,117 @@
+/SQUARE ROOT SUBROUTINE                          OS8 FORTRAN II LIBRARY LIBRARY
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/     VERSION 4A
+/      VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
+       ENTRY   SQRT
+/
+/      SQUARE ROOT ROUTINE
+/      IF X0 IS AN APPROXIMATION FOR Y**(1/2)
+/      THEN (X0+(Y/X0))/2 IS A BETTER APPROXIMATION
+/
+X0,    BLOCK   3
+Y,     BLOCK   3
+CNT,   BLOCK   1
+/
+/
+       CPAGE   4
+SQER,  6321                 /"SQRT" ERROR FROM LOC XXXXX
+       2224
+SQRT,  BLOCK   1
+       4            /ENTRY POINT
+       TAD I   SQRT
+       DCA     IN
+       INC     SQRT#
+       TAD I   SQRT
+       DCA     IN#
+       ISZ     SQRT#
+       CALL    1,FAD
+IN,    ARG     0
+       CALL    1,STO        /Y=ARGUMENT
+       ARG     Y
+       CALL    1,FAD
+       ARG     Y
+       TAD     ACH          /IF Y NEGATIVE THEN ERROR
+       SMA
+       JMP     POS
+       CALL    1,ERROR
+       ARG     SQER
+       CLA CLL CMA RAR
+       AND     ACH
+POS,   SZA                  /IF Y=0 THEN ROOT=0
+       JMP     NONZ
+       RETRN   SQRT
+NONZ,  RAR CLL              /FORM INITIAL APPROXIMATION
+       TAD     (1004
+       DCA     ACH
+       TAD     ACM
+       RAR
+       DCA     ACM
+       TAD     ACL
+       RAR
+       DCA     ACL
+       TAD     ACH
+       AND     (4
+       SNA CLA
+       TAD     (2
+       TAD     ACH
+       DCA     ACH
+       TAD     (-3          /DO 3 ITERATIONS
+       DCA     CNT
+INIT,  CALL    1,STO
+       ARG     X0
+       CALL    1,FAD
+       ARG     Y
+       CALL    1,FDV        /Y/X0
+       ARG     X0
+       CALL    1,FAD        /(Y/X0)+X0
+       ARG     X0
+       TAD     ACH          /((Y/X0)+X0)/2
+       TAD     (7770
+       DCA     ACH
+       ISZ     CNT
+       JMP     INIT
+       RETRN   SQRT
+       END
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/TC08NS.PA b/sw/os8/v3d/sources/system/dectapes/dectape3/TC08NS.PA
new file mode 100644 (file)
index 0000000..3153562
--- /dev/null
@@ -0,0 +1,210 @@
+/2 TC08 HANDLER FOR BUILD
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/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 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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/1 TC08 HANDLER FOR BUILD
+       *0
+       -10
+DEVICE TC;DEVICE DTA0;4160;10;ZBLOCK 2
+DEVICE TC;DEVICE DTA1;4160;11;ZBLOCK 2
+DEVICE TC;DEVICE DTA2;4160;12;ZBLOCK 2
+DEVICE TC;DEVICE DTA3;4160;13;ZBLOCK 2
+DEVICE TC;DEVICE DTA4;4160;14;ZBLOCK 2
+DEVICE TC;DEVICE DTA5;4160;15;ZBLOCK 2
+DEVICE TC;DEVICE DTA6;4160;16;ZBLOCK 2
+DEVICE TC;DEVICE DTA7;4160;17;ZBLOCK 2
+       DTRB=6772
+       DTLB=6774
+       DTXA=6764
+       DTCA=6762
+       DTRA=6761
+       DTSF=6771
+
+       TCVERSION="A&77
+
+       *200
+       /DECTAPE HANDLERS(PAGE RELOCATABLE) FOR PS/8 MONITOR
+DFUN,  0
+DM203, -203
+DBLOCK,        0
+DBLKCT,        0
+D3,    3
+WC,    7754
+CA,    7755
+DERRCT,        TCVERSION
+DTA0,  ISZ DTANO
+DTA1,  ISZ DTANO
+DTA2,  ISZ DTANO
+DTA3,  ISZ DTANO
+DTA4,  ISZ DTANO
+DTA5,  ISZ DTANO
+DTA6,  ISZ DTANO
+DTA7,  ISZ DTANO
+D400,  400
+       CLA CLL CMA RTL
+       DCA DERRCT      /SET TO REPEAT THREE TIMES IN CASE OF ERROR
+       TAD DTANO
+       CMA
+       TAD DTATAD      /GENERATE "TAD DTAN" WHERE DTAN IS THE ONE THAT
+       DCA DTANO       /WAS CALLED.
+       CLA CLL CML RTR
+       TAD DTANO       /ALSO GENERATE "DCA DTAN" SO WE CAN RESTORE IT
+       DCA DTADCA
+       RDF
+       TAD DCDIF0
+       DCA DSTOP       /STORE CALLING FIELD FOR RETURNING
+DTANO, 0               /GET CALLING ADDRESS
+       DCA DTA         /SAVE IT
+       TAD DTAISZ
+DTADCA,        0               /RESTORE ENTRY POINT
+       DLOC=DTADCA
+DTAISZ,        ISZ DTANO       /BUMP DTANO FOR VARIOUS GROOVY REASONS
+                       /WHICH WILL BE APPARENT LATER
+       TAD I DTA
+       DCA DFUN        /STORE AWAY FUNCTION WORD FOR FUTURE USE
+       ISZ DTA
+DT7140,        CLL CMA         /THE "CLL" IS ONLY NECESSARY TO FORM THE 7140
+       TAD I DTA
+       DCA DLOC        /BUFFER ADDRESS -1
+       ISZ DTA
+       TAD I DTA
+       CLL RAL         /MULTIPLY BY 2 FOR 256-WORD SIMULATED RECORDS
+       DCA DBLOCK      /DECTAPE BLOCK #
+       ISZ DTA
+DTATRY,        TAD WC
+DCDIF0,        CDF CIF 0
+       DCA I CA
+       TAD DFUN
+       RAR
+       CLA CML         /COMPLEMENT OF BIT 11 OF DFUN NOW IN THE LINK
+       TAD DTANO       /DTANO = "TAD DTAN+1"
+       RTR
+       RTR             /THESE TWO ROTATES FORM THE FLLOWING NUMBER
+                       /IN THE AC: YYYF00101000, WHERE YYY =DTAN+1
+                       /AND F IS THE COMPLEMENT OF DFUN(11)
+       TAD DT7140      /THE MAGIC STEP - THIS SIMULTANEOUSLY BUMPS DOWN
+                       /THE RECORD NUMBER IN AC(0-2) AND TRANSFORMS
+                       /THE REST OF THE AC TO F10001000 WHICH IS A
+                       /SEARCH IN DIRECTION F(F=1 MEANS BACKWARDS) WITH
+                       /THE MOTION BIT ON.
+       DTCA DTXA
+       DTLB            /SET DECTAPE FIELD TO 0 FOR SEARCHING
+       JMP DC+3        /JUMP INTO THE BLOCK SEARCH ROUTINE
+DERR,  RTL             /DECTAPE STATUS REGISTER B IS USUALLY IN THE AC HERE
+       RAL
+D7600, 7600            /GET THE "END OF TAPE" FLAG INTO THE LINK AND CLEAR THE AC
+       TAD D200        /GET MOTION BIT
+DC,    SZL             /AND, IF LINK IS ON
+DTATAD,        TAD D400        /REVERSE DIRECTION OF MOTION
+       DTXA
+       TAD D200
+       KRS
+       TAD DM203
+       SNA CLA
+       KSF             /CHECK FOR ^C TYPED
+       JMP DTAWT
+       TAD D7600       /**PROBLEM: LINK IS RANDOM YET MUST BE 0
+       DCA DTA         /FAKE DTA SO WE GO TO LOC 7600 IN FIELD 0
+       JMP DSTOP1      /AFTER STOPPING THE TAPE
+DTAWT, DTSF DTRB
+       JMP .-1         /WAIT FOR SEARCH TO COMPLETE
+       SPA             /HAS AN ERROR OCCURED?
+       JMP DERR        /DO SOMETHING APPROPRIATE
+       DTRA
+       RTL
+       CMA RTL
+       SNL CLA         /WAS MOTIOZ OF TAPE FORWARDS?
+       TAD D3          /NO, SO ONLY SUCCEED IF WE ARE 3 BLOCKS IN FRONT 
+                       /OF TARGET BLOCK
+       TAD I WC
+       CMA
+       TAD DBLOCK
+       CMA             /AFTER THIS OPERATION WE HAVE THE FOLLOWING 4 POSSIBILITIES
+                       /1)AC=0, L=1    /SEARCH COMPLETE
+                       /2)AC=0, L=0    /RIGHT PLACE ON TAPE,WRONG DIRECTION
+                       /3)AC .GT. 0, L=0       /WEVE PASSED THE CORRECT BLOCK
+                       /4)AC .GT. 0, L=1       /WE HAVENT REACHED THE CORRECT BLOCK YET
+       SZA CLA
+       JMP DC
+       SNL
+       JMP DTATAD      /DC+1
+       TAD DLOC
+       DCA I CA        /SET THE CURRENT ADDRESS REGISTER TO THE BUFFER -1
+       TAD DFUN
+       DTLB            /SET FIELD TO BUFFER FIELD
+       TAD D7700
+D200,  AND DFUN
+       CLL RAL
+       DCA DBLKCT      /GET UNCOMPLEMENTED WORD COUNT INTO DBLKCT
+       RAL
+       IAC
+       CLL CML RTL
+       RTL             /FORM A 50 IF L=1, A 30 IF L=0
+DL,    DTXA            /XOR IN 50(WRITE) OR 30(READ) OR 0(CONTINUE PREVIOUS OP)
+       TAD D7600
+       DCA I WC        /READ/WRITE 128 WORDS FROM/INTO EACH BLOCK
+       DTSF DTRB
+       JMP .-1
+       CLL CML         /SET ERROR FLAG ON INITIALLY
+D7700, SMA CLA
+       JMP DJ
+       ISZ DERRCT      /ERROR-IS IT THE THIRD?
+\f      JMP DTATRY      /NO-TRY AGAIN
+       JMP DSTOP       /3 ERRORS-STOP TAPE!
+DJ,    TAD DBLKCT
+       TAD D7600
+       SNA             /BUMP WORD COUNT BY -128 AND SEE IF 0
+\f                      /ALSO REVERSE LINK.
+       JMP DOVER       /YES - DONE
+       DCA DBLKCT      /RESTORE BUMPED WORD COUNT
+       JMP DL          /AND LOOP
+DOVER, ISZ DTA         /SKIP ERROR RETURN
+DSTOP, HLT             /RESTORE CALLING FIELD
+DSTOP1,        TAD D200        /STOP THE TAPE
+       DTXA
+       DCA DTANO       /INITIALIZE DTANO FOR THE NEXT CALL
+       RAR             /GET ERROR CODE FROM LINK INTO AC0
+       JMP I DTA       /AND EXIT
+DTA,   0
+       $
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/TC08SY.PA b/sw/os8/v3d/sources/system/dectapes/dectape3/TC08SY.PA
new file mode 100644 (file)
index 0000000..f9890c9
--- /dev/null
@@ -0,0 +1,217 @@
+/2 TC08 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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f      VERSION="B&77
+       *0
+       -2
+       DEVICE TC08;DEVICE SYS;4161;2007;0;1341
+       DEVICE TC08;DEVICE DTA0;4161;1007;0;1341
+\f      STARTB-ENDB-1           /NEGATIVE OF LENGTH OF BOOTSTRAP
+
+       NOPUNCH
+       *7600
+       ENPUNCH
+
+STARTB,        TAD B600        /THIS CODE ONLY EXECUTED ON DMS-TYPE BOOTSTRAP
+       DTCA DTXA       /ALL IT DOES IS SIMULATE THE OTHER TYPE OF BOOTSTRAP
+       DTSF            /MORAL: DISK MONITOR SYSTEM SUCKS
+       JMP .-1
+       DCA BOOTX
+       DCA BOOTX+1     /FUDGE TO MAKE USE OF SOME COMMON CODE
+       TAD B620
+       JMP BOOT3       /START READING OVER OURSELVES WITH RECORD 0 AGAIN
+       ZBLOCK  7611-.
+BM7642,        -7641           /MUST BE BEFORE 7617
+BOOT1, TAD 7755
+       TAD BM7642
+       SNA CLA         /WATCH THE PROGRESS OF THE READ
+       JMP BOOT2       /WHEN IT GETS PAST 7643, SWITCH TO FIELD 1
+       NOP             /LOADS OVER DTSF IN 7616
+       JMP BOOT1       /LOADS OVER JMP .-1 IN 7617 - STARTS BOOTSTRAP
+BOOT2, TAD B10
+       DTLB            /ZAP A 10 INTO STATUS REG B TO LOAD INTO FIELD 1
+       DTSF            /FROM HERE ON - LOAD THE FIELD 1 RESIDENT INTO FIELD 1
+       JMP .-1
+BOOT3, DTXA            /CONTINUE READING NEXT RECORD(ALSO SEE CODE AT 7600)
+       DTLB            /INTO FIELD 0
+       TAD B7577
+       DCA 7755        /PAGE 7600
+       DCA 7754
+BOOTX, CDF CIF 10
+       JMP 7642        /JUMP INTO WAIT LOOP IN FIELD 1
+       JMP BOOT1       /DISK MONITOR FUDGE - JUMP INTO WAITING LOOP
+B7577, 7577
+B10,   10
+B600,  600
+B620,  620
+       ZBLOCK  7642-.
+       DCA 7744
+       DTSF            /THIS IS LOADED INTO FIELD 1 WITH MONITOR RESIDENT
+       JMP .-1         /IT IS IN THE CD OUTPUT AREA AND SO WILL BE ZAPPED
+       CDF CIF 0       /BY THE KEYBOARD MONITOR
+ENDB,  JMP 7605        /OK, FIELD 0 RESIDENT READ IN, START UP MONITOR
+
+       /BOOTSTRAP FOR DECTAPE MONITOR IS THE SAME AS FOR THE 
+       /DEC LIBRARY SYSTEM, RL MONITOR AND POLY BASIC - OR JUST
+       /READ RECORD 0 INTO 7600 AND TRANSFER TO 7600 A LA DISK
+       /MONITOR SYSTEM ON DECTAPE
+\f      DTRB=6772
+       DTLB=6774
+       DTXA=6764
+       DTCA=6762
+       DTRA=6761
+       DTSF=6771
+
+       *200
+
+       NOPUNCH
+       *7600
+       ENPUNCH
+
+       SBLOCK=7776     /RELIC FROM OS/8 ASSEMBLY
+       ZBLOCK 7
+SHNDLR,        VERSION
+       CLA CLL CMA RTL
+       DCA SYSCNT      /3 TRIES ON ERROR
+       RDF
+       TAD SCIF
+       DCA SFIELD      /RETURN FIELD SETUP
+       TAD I SHNDLR
+       DCA SFUN
+       ISZ SHNDLR
+       CLA CMA
+       TAD I SHNDLR
+       DCA SLOC        /BUFFER ADDRESS-1
+       ISZ SHNDLR
+STRY,  TAD S410        /SETUP DTA0 TO DO SEARCH REVERSE
+       DTCA DTXA       /BUT MOTION BIT IS NOT ON
+       DTLB
+       CLA CMA CLL RAL
+       DCA SCA         /7776=SBLOCK FROM OS/8 ASSEMBLY
+       TAD SFUN
+       RTR
+       RTR
+SERR,  RTL
+       RAL             /LAST 4 INST. PUT MOTION BIT IN LINK
+                       /IF THIS BIT WAS SET IN THE CALLING
+                       /SEQUENCE, SEARCH STARTS FORWARD.
+S7600, 7600
+       TAD S200
+SC,    SZL
+       TAD S400
+       DTXA            /ZAP MOTION BIT ON
+       DTSF DTRB
+       JMP .-1
+       SPA             /CHECK FOR ANY ERRORS
+       JMP SERR
+       DTRA            /NO ERRORS
+       RTL
+       CMA RTL         /COMPLEMENT OF DIRECTION TO LINK
+                       /IF LINK ON, SEARCHING FORWARD.
+       SNL CLA
+       CML RTL
+       TAD SBLOCK      /SEARCH FOR ONE RECORD BEFORE THE
+                       /REQUIRED ONE. THEN REVERSE DIRECTION
+       CMA
+       TAD I SHNDLR
+       TAD I SHNDLR    /X+X=2*X; RECORDS TO BLOCKS
+       NOP
+       NOP
+       CMA
+       SZA CLA         /IS IT PROPER RECORD?
+       JMP SC
+       SNL             /YES..IF LINK IS ON,WAS FWD SRCH
+       JMP SC+1        /REVERSE..REVERSE TAPE MOTION
+                       /AND SEARCH FORWARD
+       TAD SLOC
+       DCA SCA
+       TAD SFUN
+       DTLB            /SET UP FIELD
+       TAD SFUN
+       CLL RAL
+       AND S7600
+       DCA SBLKCT      /BLOCK COUNT
+       RAL             /FUNCTION TO BIT 11
+       IFNZRO .-7700   <NZERR>
+       SKP
+       HLT             /TO PROTECT AGAINST BAD PROGRAMMERS
+       IAC
+       CLL CML RTL
+       RTL             /FORMS EITHER READ OR WRITE
+SL,    DTXA
+       TAD S7600
+       DCA SWC         /TRANSFER 200 (8)
+       DTSF DTRB
+       JMP .-1
+       CLL CML         /IN CASE OF FATAL ERROR
+       SPA CLA
+       JMP SERR2
+       TAD SBLKCT
+       TAD S7600
+       SNA             /ALL DONE?
+       JMP SOVER       /YES
+       DCA SBLKCT
+       JMP SL
+SERR2, ISZ SYSCNT      /TRY AGAIN?
+       JMP STRY
+       SKP             /DON'T BOTHER
+SOVER, ISZ SHNDLR
+       ISZ SHNDLR
+       TAD S200        /STOP THE TAPE
+       DTXA
+       RAR             /GIVE FATAL RETURN
+SFIELD,        HLT
+       JMP I SHNDLR
+\fSCIF, CIF 0
+S400,  400
+S200,  200
+S410,  410
+       SBLKCT=7753
+       SYSCNT=7750
+       SFUN=7751
+       SLOC=7752
+       SWC=7754
+       SCA=7755
+       $
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/TD8ESY.PA b/sw/os8/v3d/sources/system/dectapes/dectape3/TD8ESY.PA
new file mode 100644 (file)
index 0000000..91f79c3
--- /dev/null
@@ -0,0 +1,384 @@
+/3 TD8E SYSTEM RESIDENT (12K)
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f      *0
+
+       -3
+       DEVICE TD8E;DEVICE SYS;4211;6007;0;1341
+       DEVICE TD8E;DEVICE DTA0;4211;5007;0;1341
+       DEVICE TD8E;DEVICE DTA1;4211;SDTA1&177+5000;0;1341
+\f      TDBEGN-TD77-1
+
+       RELOC 7360
+
+/THE BINARY GETS LOADED INTO 27220 INITIALY, AND
+/WRITTEN OUT AS PART OF RECORD 0. WHEN THE 30 WORD
+/BOOTSTRAP IS USED, THIS CODE GETS READ INTO 7400.
+
+
+
+       SDSS=6771
+       SDST=6772
+       SDSQ=6773
+       SDLC=6774
+       SDLD=6775
+       SDRC=6776
+       SDRD=6777
+
+TDBEGN,        ZBLOCK 20
+TDBOOT,        TAD K7600       /128 WORDS PER PAGE
+       DCA TDWCT
+       SDSS            /WAIT FOR A BLOCK MARK (TAPE IS
+       JMP .-1         /STILL MOVING)
+       SDRC
+       AND TD77
+       TAD KM26        /IS IT A BLOCK MARK?
+       SZA CLA
+       JMP TDBOOT+2    /NO..WAIT A WHILE LONGER
+       SDRD            /GET THE BLOCK NO.
+TDBKNO,        TAD TDM14       /NEED DECTAPE BLOCKS 154 & 155 (REC. 66)
+       SZA CLA
+       JMP TDBOOT+2    /NOT YET, BUSTER
+TDRGRD,        SDSS
+       JMP .-1         /NOW LET'S LOOK FOR A REVERSE GUARD WORD
+       SDRC
+       AND TD77
+       TAD KM32
+       SZA CLA
+       JMP TDRGRD      /KEEP LOOKING FOR IT
+       JMS TDRQD
+       JMS TDRQD
+       JMS TDRQD       /SKIP CONTROL WORDS
+       CDF 10          /LOAD UP FIELD 1
+TDREAD,        JMS TDRQD       /GET A DATA WORD
+       DCA I TDPTR
+       ISZ TDPTR       /ARE WE DONE?
+       JMP TDREAD      /NOT YET
+       ISZ TDBKNO      /YES..LOOK AT BLOCK 15
+       TAD KCDF20
+       DCA TDREAD-1    /LOAD UP FIELD 2
+       ISZ M2          /DONE THIS JUNK?
+       JMP TDBOOT      /GO DO FIELD 2
+       SDLC            /STOP THE TAPE
+       CIF CDF 0
+       JMP I K7605
+\fTDM14,        -154
+       -155    /USE RECORD 66
+TDPTR,
+TDWCT, 7600
+TDRQD, 0
+       SDSQ
+       JMP .-1
+       SDRD
+       JMP I TDRQD
+
+K7600, 7600
+KM26,  -26
+KM32,  -32
+KCDF20,        CDF 20
+M2,    -2
+K7605, 7605
+TD77,  77
+
+/      THIS BOOTSTRAP RESIDES IN BLOCK 0
+/      BLOCK 1/2 CONTAINS THE USUAL IMAGE OF 07600
+/      BLOCK 66 CONTAINS THE IMAGE OF 17600
+/      BLOCK 66 1/2 CONTAINS THE IMAGE OF 27600
+       RELOC
+\f      *200
+
+/TD8E DECTAPE SYSTEM HANDLER
+/THIS HANDLER CAN DRIVE UNITS 0&1, AND IS PERMANENTLY
+/RESIDENT IN FIELDS 0&2.
+
+       RELOC 7600
+
+       VERSION="B&77
+
+       ZBLOCK 7
+SHNDLR,        VERSION         /UNIT 0 ENTRY POINT
+       CLA CLL
+       JMP SHND2
+C3,    3               /MUST BE HERE FOR BUILD
+S70,   70
+SDTA1, VERSION         /UNIT 1 ENTRY
+       CLA CLL CML
+SC1000,        TAD SDTA1       /DOUBLES AS CONSTANT 1000
+       DCA SHNDLR      /GET ARGS AT SHNDLR
+SHND2, RAR             /UNIT #
+       DCA SUNIT
+       RDF             /SETUP FOR EXIT
+       TAD S6203
+       DCA EFLD
+       TAD I SHNDLR    /FUNCTION WORD
+       SDLD            /PUT IT IN DATA EGISTER
+       AND S70         /SDLD DOES NOT 0 AC..GET FIELD
+       TAD S6203       /CIF CDF N FOR TRANSFER FIELD
+       DCA TFLD
+       ISZ SHNDLR
+       TAD I SHNDLR    /BUFFER ADDRESS
+       DCA BPTR
+       ISZ SHNDLR
+       TAD I SHNDLR    /BLOCK #. TIMES 2 FOR REAL #
+       CLL RAL
+       DCA BLOCK
+       ISZ SHNDLR      /POINT TO ERROR EXIT
+       CIF CDF 20      /PUT UNIT # INTO FIELD 2
+       TAD SUNIT
+       DCA I SUNIT2
+       JMP F2SET       /TO FIELD 2 FOR INIT.
+
+F1GO,  SDRD            /INITIAL DIRECTION TO LINK
+       RAR
+       JMP RGO
+\fRENTER,       TAD BPTR        /DONE THIS BLOCK..NEXT ADDRESS
+       TAD SC200
+       DCA BPTR
+       ISZ BLOCK       /NEXT TAPE BLOCK..CAN'T SKIP
+       CLL CML         /FORCE FORWARD MOTION
+RGO,   CLA CML RTR     /LINK TO MOTION BIT
+       TAD SC1000
+       TAD SUNIT
+       SDLC            /MOVE THE TAPE
+       SDSQ
+       JMP .-1
+       SDRD            /KNOCK DOWN QUAD FLAG
+       SDSQ
+       JMP .-1
+       SDRD            /THIS IS NEEDED, ELSE TIME ERROR!!!
+\f
+SRCH,  SDSS            /WAIT FOR A BLOCK MARK
+       JMP .-1
+       SDRC            /GET MARK TRACK BITS
+       CLL RTL         /DIRECTION TO LINK
+       AND SC374
+       TAD SM110       /IS IT A N END ZONE?
+       SNA
+       JMP SENDZ       /YES
+       TAD SM20        /MAYBE A BLOCK MARK?
+       SZA CLA
+       JMP SRCH        /NEITHER..KEEP GOING
+       SDRD            /READ THE BLOCK #
+       SZL             /IF REVERSE, LOOK 3 AHEAD OF TARGET
+       TAD C3
+       CMA
+       TAD BLOCK
+       CMA
+       SNA             /IS IT THE RIGHT ONE?
+       JMP FOUND       /YES
+SM110, CLA SNA SZL     /SNA SUPERFLUOUS..ONLY SZL VALID
+       JMP SRCH        /HEADED FOR IT..KEEP GOING
+SENDZ, SDRC
+       CLL RTL
+       SZL CLA         /IF IN END ZONE FORWARD, GIVE ERROR
+       JMP RGO
+       CIF 20          /IF IT IS REALL END ZONE, AN ERROR
+       JMP ERROR
+
+FOUND, SZL CLA         /RIGHT BLOCK..HOW ABOUT DIRECTION?
+       JMP RGO         /WRONG..EXECUTE TURNAROUND
+       TAD BPTR
+TFLD,  HLT             /GETS CIF CDF N
+       CIF 20
+       JMP RDWT        /LET'S TRANSFER DATA
+
+SEXIT, ISZ SHNDLR      /NORMAL RETURN
+SEREX, TAD SUNIT       /STOP THE TAPE
+       SDLC
+       CML CLA RAR     /EITHER 0 OR 4000 IN AC ON RETURN
+EFLD,  HLT
+       JMP I SHNDLR
+
+       BPTR=7755
+       BLOCK=7754
+       SUNIT=SDTA1
+
+S6203, 6203
+SC200, 200
+SC374, 374
+SM20,  -20
+SUNIT2,        SXUNIT
+       RELOC
+\f      *400
+
+       RELOC 7600      /RUNS IN 27600
+
+XPTR,  0               /BUFFER POINTER
+F2SET, CLA CLL CMA RTL /3 ERROR TRIES
+       DCA TRYCNT
+       TAD SXUNIT      /MAKE SURE TAPE IS STOPPED
+       SDLC
+F26203,        CIF CDF 0
+       SDRD            /FUNCTION WORD
+       CLL RAL
+       AND CX7600      /PAGE COUNT
+       DCA XPGCT
+       SDRD
+       DCA SXFUN       /SAVE THE FUNCTION WORD
+       JMP F1GO
+
+RDWT,  DCA XPTR        /SAVE NEW BUFFER ADDRESS
+       TAD CX7600
+       DCA XWCNT       /128 WORDS PER BLOCK
+REVGRD,        SDSS            /WAIT FOR REVERSE GUARD WORD
+       JMP .-1
+       SDRC
+       AND X77
+       TAD XM32        /IS IT REVERSE GUARD?
+       SZA CLA
+       JMP REVGRD      /NO
+       TAD SXFUN
+SK7700,        SMA CLA         /READ OR WRITE?
+       JMP READ                /READ
+       SDRC
+       AND C300        /ERRORS ON WRITE LOCKOUT AND TIME
+       SZA CLA
+       JMP ERROR
+       JMS RDQUAD      /SKIP A WORD
+CX7600,        7600
+       TAD WRLP
+       TAD SXUNIT
+       SDLC            /TURN ON THE WRITE
+       CLA CMA
+       JMS WRQUAD      /WRITE 7777 IN REV. CHECKSUM
+       CLA CMA
+       DCA SCKSUM      /AND ALSO IN COMPUTE CHECKSUM
+WRLP,  TAD I XPTR
+       JMS WRQUAD      /WRITE THE DATA
+       ISZ XPTR
+X77,   77              /JUST IN CASE
+       ISZ XWCNT       /DONE 128?
+       JMP WRLP
+       JMS WRQUAD      /WRITE AND CHECKSUM A WORD OF 0
+       JMS GETCHK      /GET CHECKSUM
+       JMS WRQUAD
+       JMS WRQUAD      /LET CHECKSUM GET WRITTEN
+\f
+RWCOM, SDST            /CHECK FOR TIME AND CHECKSUM ERRORS
+       SZA CLA
+       JMP ERROR       /NOTE THAT LINK IS OFF AT RWCOM
+       CIF CDF 0
+       TAD XPGCT       /FINISHED TRANSFER?
+       TAD CX7600      /LINK GOES ON HERE
+       SNA
+       JMP SEXIT       /YES..GETOUT
+       DCA XPGCT
+       JMP RENTER
+
+READ,  JMS RDQUAD      /SKIP CONTROL WORDS
+       JMS RDQUAD
+       JMS RDQUAD      /GET CHECKSUM
+       AND X77
+       TAD SK7700
+       DCA SCKSUM
+SRDLP, JMS RDQUAD
+       DCA I XPTR
+       TAD I XPTR
+       JMS EQUFUN
+       ISZ XPTR
+C300,  300
+       ISZ XWCNT       /DONE ALL?
+       JMP SRDLP       /NO
+       JMS RDQUAD      /READ AND CHECKSUM LAST WORD
+       JMS EQUFUN
+       JMS RDQUAD      /GET CHECKSUM
+       AND SK7700
+       JMS EQUFUN
+       JMS GETCHK
+       JMP RWCOM
+
+ERROR, CLA CLL         /THIS CAUSES SEARCH REVERSE AT RGO
+       CIF CDF 0
+       ISZ TRYCNT      /EXHAUSTED ERROR TRIES?
+       JMP RGO
+       JMP SEREX       /YES..FATAL EXIT
+
+WRQUAD,        0               /WRITE A 12 BIT WORD
+       SDSQ
+       JMP .-1
+       SDLD
+       JMS EQUFUN      /SDLD LEAVES AC ALONE
+       JMP I WRQUAD
+
+RDQUAD,        0               /READ A 12 BIT WORD
+       SDSQ
+       JMP .-1
+       SDRD
+       JMP I RDQUAD
+\fEQUFUN,       0               /EQUIVALENCE CHECKSUM
+       CMA
+       DCA EQUTMP
+       TAD EQUTMP
+       AND SCKSUM
+       CIA
+       CLL RAL
+       TAD EQUTMP
+       TAD SCKSUM
+       DCA SCKSUM
+       JMP I EQUFUN
+
+GETCHK,        0
+       TAD SCKSUM
+       CLL CMA RTL
+       RTL
+       RTL
+       JMS EQUFUN
+       TAD SCKSUM
+       AND SK7700
+       JMP I GETCHK
+
+SXUNIT,        0
+XPGCT, 0
+SXFUN, 0
+TRYCNT,        0
+XWCNT, 0
+XM32,  -32
+SCKSUM,        0
+EQUTMP,        0
+
+/THE LAST 4 LOCS. ARE FREE FOR USE BY BATCH
+       ZBLOCK 4
+       RELOC
+       $
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/TDCOPY.PA b/sw/os8/v3d/sources/system/dectapes/dectape3/TDCOPY.PA
new file mode 100644 (file)
index 0000000..e211680
--- /dev/null
@@ -0,0 +1,1515 @@
+/TD8E DECTAPE COPY, V4
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1972, 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.
+/
+/
+/
+/
+/
+/
+\f
+
+
+/DEFINITIONS FOR PAL8 AND PAL10
+
+BSW=7002
+MQL=7421
+MQA=7501
+CAM=7621
+SWP=7521
+ACL=7701
+CAF=6007
+CDI=6203
+KCF=6030
+SDSS=6771
+SDST=6772
+SDSQ=6773
+SDLC=6774
+SDLD=6775
+SDRC=6776
+SDRD=6777
+FIXTAB
+
+
+HALT=HLT
+
+
+/UNIT NUMBER DEFINITIONS FOR TD8E IOT'S
+
+UNIT01=0770
+UNIT23=0760
+UNIT45=0750
+UNIT67=0740
+
+\f
+
+LIMIT=7600
+
+*11
+
+X11,   0
+X12,   0
+
+/PAGE 0 CONSTANTS AND VARIABLES
+
+*20
+INPUT, 0               /INPUT UNIT CONSTANT
+OUTPUT,        0               /OUTPUT UNIT CONSTANTS
+       0
+       0
+       0
+       0
+       0
+       0
+OCOUNT,        0               /NUMBER OF OUTPUT UNITS SPECIFIED
+OPOINT,        0
+LIST,  OUTPUT-1
+OUTNUM,        0
+IBLOCK,        0               /STARTING INPUT BLOCK
+OBLOCK,        0               /STARTING OUTPUT BLOCK
+NUMBER,        0               /NUMBER OF BLOCKS TO TRANSFER
+FIELDS,        0               /-(HIGHEST FIELD AVAILABLE)
+COUNT, 0               /TEMPORARY COUNTERS
+COUNT1,        0               /  "
+COUNT2,        0               /  "
+COUNT3,        0               /  "
+COUNT4,        0               /  "
+UNIT,  0               /UNIT CONSTANT--THIS TRANSFER
+VERF,  0               /VERIFY SWITCH (1=YES,0=NO)
+WDCNT, 0               /-(NUMBER OF WORDS PER BLOCK)
+RW,    0               /READ/WRITE BIT--THIS TRANSFER
+FLD0,  0               /# OF BLOCKS IN FIELD 0 BUFFER
+FLDN,  0               /# OF BLOCKS IN FIELD N BUFFER
+BUF0,  0               /START OF FIELD 0 BUFFER
+BUFN,  0               /START OF FIELD N BUFFER
+XNUMB, 0               /# OF BLOCKS LEFT TO TRANSFER
+BLOCKN,        0               /STARTING BLOCK NUMBER--THIS TRANSFER
+NUMB1, 0
+NUMB2, 0
+VB,    0
+END0,  0               /BEGINNING OF FIELD 0 VERIFY BUFFER
+ENTRY, 0               /ENTRY TO TD8E HANDLER
+INB,   0
+OUTB,  0
+OHOLD, 0
+\f
+MESSG1,        TEXT @TD8E COPY V4A@
+MESSG3,        TEXT @ 12-BIT WORDS PER BLOCK@
+\f
+*200
+
+START, TLS
+       JMS CRLF
+       JMS I [MESSGE
+       MESSG1          /@TD8E COPY@
+       JMS CRLF
+       DCA COUNT
+       JMP I [END      /ONCE ONLY CODE FOR MULTIPLE FIELD TEST
+START1,        JMS QUEST
+       MESSG4          /@FROM UNIT:@
+       SWP
+       JMS UNITNO      /MAKE UNIT NUMBER CONSTANT
+       DCA INPUT
+       TAD LIST
+       DCA OPOINT
+       SKP
+AGAIN, JMS ERR4        /*ILLEGAL RESPONSE*
+       DCA OCOUNT
+       DCA COUNT
+       JMS I [MESSGE
+       MESSG5          /@TO UNITS:@
+MORE2, JMS I [ANSWER
+       JMP AGAIN
+       ACL
+       JMS UNITNO      /MAKE UNIT NUMBER CONSTANT
+       MQL             /STORE IN MQ
+       MQA             /RESTORE TO AC
+       CIA
+       TAD INPUT
+       SNA CLA         /IS OUTPUT UNIT = INPUT UNIT ?
+       JMP MORE2+1     /YES--ERROR
+       ISZ OPOINT
+       ISZ OCOUNT      /COUNT ONE MORE OUTPUT UNIT
+       TAD OCOUNT
+       TAD [-10
+       SPA CLA         /WERE MORE THAN 7 UNITS SPECIFIED?
+       JMP .+3
+       JMS CRLF        /YES--CARRIAGE RETURN
+       JMP OALL        /IGNORE EXTRA ONE
+       SWP             /NO--
+       DCA I OPOINT    /STORE UNIT CONSTANT IN LIST
+       TAD COUNT
+       CIA
+       TAD OCOUNT
+       SPA SNA CLA     /ALL UNITS IN?
+       JMP MORE2       /YES
+\f
+OALL,  DCA COUNT
+       JMS I [MESSGE
+       MESSG6          /@FIRST INPUT BLOCK:@
+       JMS I [ANSWER
+       JMP WHOLE       /COPY WHOLE TAPE
+       TAD COUNT
+       SNA CLA         /WERE TOO MANY SPECIFIED?
+       JMP .+5
+       JMS I [MESSGE   /YES
+       ERROR4          /@ILLEGAL RESPONSE@
+       JMS CRLF
+       JMP OALL        /REPEAT THE QUESTION
+       ACL             /NO
+       DCA IBLOCK      /STORE
+       JMS QUEST
+       MESSG7          /@FIRST OUTPUT BLOCK:@
+       ACL
+       DCA OBLOCK
+       JMS QUEST
+       MESSG8          /@NUMBER OF BLOCKS TO COPY:@
+       ACL
+       SNA             /WERE 0 BLOCKS SPECIFIED?
+       JMP QUEST1      /YES--REPEAT QUESTION
+       DCA NUMBER
+       JMP .+4
+WHOLE, DCA IBLOCK
+       DCA OBLOCK
+       DCA NUMBER      /0 MEANS WHOLE TAPE
+       JMS QUEST
+       MESSG9          /@VERIFY OUTPUT (YES=1,NO=0):@
+       ACL
+       AND [7
+       DCA VERF
+       JMP I (SETUP
+\f
+/OUTPUT CARRIAGE RETURN/LINE FEED
+
+CRLF,  0
+       TAD (215
+       JMS I [TYPE
+       TAD [212
+       JMS I [TYPE
+       JMP I CRLF      /--RETURN--
+
+ERR4,  0
+       JMS I [MESSGE
+       ERROR4          /@ILLEGAL RESPONSE@
+       JMS CRLF        /OUTPUT CARRIAGE RETURN/LINE FEED
+       TAD [-4
+       TAD ERR4
+       DCA ERR4
+       DCA COUNT
+       JMP I ERR4      /--RETURN--
+
+\f
+QUEST, 0
+       TAD I QUEST
+       DCA MNUM
+       ISZ QUEST
+       JMS I [MESSGE
+MNUM,  0
+       JMS I [ANSWER
+QUEST1,        JMS ERR4
+       TAD COUNT
+       SZA CLA
+       JMP QUEST1
+       JMP I QUEST     /--RETURN--
+
+
+/CONVERT UNIT NUMBER TO A WORD OF THE FORM
+/000 XXX XXX 000 OR
+/100 XXX XXX 000
+/WHERE XY0 IS THE THIRD DIGIT OF THE IOT
+/AND 0 OR 1 REFLECTS THE TD8E UNIT NUMBER
+/ENTER WITH THE UNIT NUMBER IN THE AC
+/EXIT WITH SPECIAL CODE IN AC
+
+UNITNO,        0
+       AND [7          /MASK OUT ALL EXTRANEOUS BITS
+       CLL RAR         /SAVE 0/1 BIT IN LINK
+       MQL             /STORE ROTATED WORD, CLEAR AC
+       RAR
+       SWP             /PRESERVE 0/1 BIT IN MQ
+       TAD TABX        /GET DEVICE NUMBER CORRECTLY
+       DCA CRLF
+       TAD I CRLF
+       MQA             /OR IN 0/1 BIT
+       JMP I UNITNO    /--RETURN--
+
+TABX,  UNITS
+
+/SKIP 4 LINES AND FETCH MARK TRACK
+
+SKIPQ, 0
+IOTR5, SDSQ
+       JMP .-1
+IOTR6, SDRC
+       JMP I SKIPQ     /--RETURN--
+\f
+*400
+
+/USER RESPONSE HANDLER
+/USES MQ FOR TEMPORARY STORAGE
+/EXIT WITH RESPONSE IN MQ
+/EXIT TO CALL+1 IF JUST CARRIAGE RETURN
+/OR ILLEGAL CHARACTER, CARRIAGE RETURN
+/OR ;,CARRIAGE RETURN
+/EXIT TO CALL+2 IF GOOD DATA, CARRIAGE RETURN
+/INCREMENT COUNT AND EXIT TO CALL+2 IF GOOD DATA;
+/ILLEGAL CHARACTERS CAUSE WHOLE ANSWER TO BE IGNORED
+/AND EXIT TO CALL+1
+
+ANSWER,        0
+       CAM             /CLEAR AC AND MQ
+       TAD CLEAR
+       DCA SWITCH
+MORE,  JMS LISTEN      /FETCH A CHARACTER
+       TAD (-215
+       SZA             /IS IT A CARRIAGE RETURN?
+       JMP .+5         /NO
+       TAD [212        /YES--OUTPUT LINE FEED
+       JMS TYPE
+SWITCH,        NOP             /SET UP EXIT ADDRESS
+       JMP I ANSWER    /--RETURN--
+       TAD (215-260
+       SPA             /IS CHARACTER LESS THAN 260?
+       JMP BAD         /YES--ILLEGAL CHARACTER
+       TAD [260-270    /NO
+       SMA             /IS IT MORE THAN 269?
+       JMP SEMI        /YES--CHECK FOR SEMICOLON
+       TAD (270        /RESTORE CHARACTER
+       AND [7          /MASK OUT EXTRANEOUS BITS
+       CLL
+       SWP
+       AND (777        /MASK OUT FIRST DIGIT IF THERE ARE 4
+       RAL             /ROTATE 3 LEFT
+       RTL
+       MQA             /FETCH NEW CHARACTER
+       MQL             /STORE RESULT IN MQ
+       TAD SKIP        /SET UP TO SKIP ON RETURN
+       DCA SWITCH
+       JMP MORE        /FETCH ANOTHER
+
+\f
+CLEAR, NOP
+SKIP,  ISZ ANSWER
+
+BAD,   CLA             /ILLEGAL CHARACTER
+       JMS I [CRLF
+       JMP I ANSWER    /--RETURN--
+
+
+/TEST FOR SEMICOLON
+
+SEMI,  TAD (270-273
+       SZA CLA         /IS CHARACTER A SEMICOLON?
+       JMP BAD         /NO--ILLEGAL CHARACTER
+       ISZ COUNT       /YES--INCREMENT COUNTER
+       JMP SWITCH      /EXIT FROM ANSWER ROUTINE
+
+
+/TELETYPE INPUT AND ECHO HANDLER
+
+LISTEN,        0
+       KSF
+       JMP .-1
+       JMS I   [PARITY
+       TLS             /ECHO CHARACTER
+       JMS CHECK       /CHECK FOR CTRL/C AND CTRL/S
+       JMP I LISTEN    /--RETURN--
+
+/CHECK FOR CTRL/C AND CTRL/S
+/ENTER WITH INPUT CHARACTER IN AC
+/EXIT TO HANDLER OR WITH CHARACTER IN AC
+
+CHECK, 0
+       TAD (-203
+       SNA             /IS IT CTRL/C?
+       JMP I CTRLC     /YES--HANDLE IT
+       TAD (203-223
+       SNA             /IS IT CTRL/S?
+       JMP I [REPEAT   /YES--HANDLE IT
+       TAD (223        /RESTORE CHARACTER
+       JMP I CHECK     /--RETURN--
+
+CTRLC, LIMIT
+\f
+/MESSAGE OUTPUT HANDLER
+
+/EXPECTS MESSAGE ADDRESS TO BE IN LOCATION AFTER CALL
+/EXITS TO CALL+2
+
+MESSGE,        0
+       TAD I MESSGE
+       DCA FINDER      /SET UP POINTER
+       ISZ MESSGE
+       DCA LOC         /SET L/R SWITCH TO L (EVEN)
+LNEXT, TAD I FINDER    /GET WORD
+       BSW
+RHALF, AND [77
+       SNA             /IS CHARACTER 0 (TERMINATOR)?
+       JMP I MESSGE    /YES--RETURN--
+       DCA CHAR
+       TAD CHAR
+       AND (40
+       SNA CLA         /IS IT A LETTER?
+       TAD [100        /YES--301-337
+       TAD [200        /NO--240-277
+       TAD CHAR        /RESTORE CHARACTER
+       JMS TYPE        /OUTPUT IT
+       ISZ LOC
+       TAD LOC
+       RAR
+       SZL CLA         /WHICH HALF WAS THAT?
+       JMP .+3
+       ISZ FINDER      /RIGHT
+       JMP LNEXT
+       TAD I FINDER    /LEFT
+       JMP RHALF
+FINDER,        0
+LOC,   0
+CHAR,  0
+
+
+/TELETYPE OUTPUT ROUTINE
+
+
+TYPE,  0
+       TSF
+       JMP .-1
+       TLS
+       CLA
+       JMP I TYPE      /--RETURN--
+
+\f
+/INSERT IOT'S ACCORDING TO TABLES
+/UNIT CONTAINS APPROPRIATE UNIT CODE
+/COUNT CONTAINS -(NUMBER OF IOT'S TO TRANSFER)
+/COUNT1 CONTAINS ADDRESS OF ADDRESS TABLE
+/UNIT CONTAINS UNIT CODE OF CURRENT UNIT
+
+INSERT,        0
+       TAD I COUNT1
+       DCA COUNT3
+       TAD UNIT
+       MQL
+       TAD I COUNT3    /MAKE NEW IOT
+       AND (7007
+       MQA
+       CIA
+       TAD I COUNT3    /COMPARE WITH IOT FROM PROGRAM
+       SNA CLA         /ARE THE IOT'S THE SAME AS THE LAST UNIT?
+       JMP I INSERT    /YES--RETURN--
+INS1,  TAD I COUNT1
+       DCA COUNT3
+       TAD I COUNT3    /GET IOT FROM PROGRAM
+       AND (7007       /RETAIN ONLY SIGNIFICANT BITS
+       MQA             /OR IN UNIT NUMBER
+       DCA I COUNT3    /PUT IT IN PROGRAM
+       ISZ COUNT1      /BUMP COUNTERS
+       ISZ COUNT       /DONE YET?
+       JMP INS1        /NO
+       JMP I INSERT    /YES--RETURN--
+
+
+PAGE
+\f
+/COUNT THE NUMBER OF WORDS PER BLOCK
+/PLACE IT IN MWORDS
+/BE SURE ALL TAPES MATCH INPUT FORMAT
+
+SETUP, TAD LIST
+       DCA OPOINT      /SET POINTER TO I/O LIST
+       DCA COUNT2      /CLEAR COUNTER
+       TAD OCOUNT
+       CMA
+       DCA OUTNUM      /SET # OF UNITS
+SET4,  TAD (TABLE1-END1-1      /SET UP COUNTERS FOR IOT FIX
+       DCA COUNT
+       TAD (TABLE1
+       DCA COUNT1
+       TAD I OPOINT
+       DCA UNIT
+       JMS I [INSERT   /PUT THE PROPER IOT'S IN THE FOLLOWING ROUTINE
+       DCA WDCNT       /CLEAR WORD COUNT
+       TAD UNIT
+       AND [4000
+       TAD (2000
+IOTX7, SDLC
+       CLA
+IOTX8, SDRC
+       RTL
+       SZL             /DOES UNIT EXIST?
+       JMP .+3         /YES
+SELERR,        JMS I [ERR3     /@SELECT ERROR UNIT N@
+       JMP SETUP
+       AND (400
+       SZA CLA         /TURNED ON?
+       JMP SELERR      /NO
+       TAD UNIT        /GET 0 OR 1 UNIT BIT (0 OR 4000)
+       AND [4000
+       TAD [1000       /GET GO BIT
+IOTX1, SDLC            /START READING FORWARD
+       JMS SKIP4       /SKIP 8 LINES TO AVOID GARBAGE
+       JMS SKIP4
+IOTX3, SDSS            /LOOK FOR FORWARD BLOCK NUMBER (26)
+       JMP .-1
+IOTX4, SDRC
+       AND [77
+       TAD (-26
+       SZA CLA         /FOUND YET?
+       JMP IOTX3       /NO--KEEP LOOKING
+\f
+SET2,  JMS SKIP4       /YES--START COUNTING LINES BY FOURS
+       ISZ WDCNT
+       NOP
+       AND [77
+       TAD (-51
+       SZA CLA         /FOUND GUARD YET?
+       JMP SET2        /NO
+       TAD UNIT        /YES
+       AND [4000
+IOTX2, SDLC            /STOP UNIT
+       CLA
+       TAD COUNT2
+       SZA             /IS THIS THE INPUT UNIT?
+       JMP SET5        /NO
+       TAD (-11        /YES--SAVE THE COUNT
+       TAD WDCNT
+       CIA
+       DCA COUNT2
+       JMP SET3        /FIRST OUTPUT UNIT
+SET5,  TAD (-11        /NOT INPUT UNIT
+       TAD WDCNT
+       SZA CLA         /SAME NUMBER OF WORDS AS INPUT UNIT?
+       JMP ERR5        /NO*ILLEGAL FORMAT*
+SET3,  ISZ OPOINT      /NEXT UNIT
+       ISZ OUTNUM      /DONE YET?
+       JMP SET4        /NO
+       TAD COUNT2      /YES--PRINT MESSAGE
+       DCA I [MWORDS   /SET UP NUMBER OF WORDS PER BLOCK
+       TAD I [MWORDS
+       CIA
+       JMS I [PRINT    /PRINT 4 DIGIT NUMBER OF BLOCKS
+       JMS I [MESSGE   /YES--PRINT REST OF MESSAGE
+       MESSG3
+       JMS I [CRLF
+\f
+/IF WHOLE TAPE IS TO BE COPIED, IT IS NECESSARY TO
+/COMPUTE THE NUMBER OF BLOCKS ON THE TAPE (NB)
+/USING THE NUMBER OF WORDS PER BLOCK (WB)
+/AND THE FORMULA:
+/OCTAL:          NB=[63 6160/(WB+17)]+2
+/DECIMAL:       NB=[212,080/(WB+15)]+2
+
+       TAD NUMBER
+       SZA CLA         /COPY WHOLE TAPE?
+       JMP VERFQ       /NO--
+       DCA COUNT       /YES--COMPUTE NUMBER OF BLOCKS ON TAPE
+       TAD I [MWORDS
+       CIA
+       TAD (17
+       DCA COUNT1      /GET NUMBER OF WORDS PER BLOCK+17
+       TAD (-64
+       DCA COUNT2
+       TAD (-6160
+SUB,   CLL
+       TAD COUNT1
+       ISZ COUNT       /COUNT A BLOCK--TOO MANY?
+       SKP             /NO
+       JMP ERR5        /YES--ERROR
+       SZL
+       ISZ COUNT2
+       JMP SUB
+       CLA CLL
+       TAD COUNT       /COUNT IS [63 6160/WB+17]+1
+       IAC             /ADD 1 MORE
+       DCA NUMBER      /STORE AS # OF BLOCKS TO TRANSFER
+       JMP I .+1
+       VERFQ
+
+ERR5,  CLA
+       JMS I [MESSGE
+       ERROR5          /*ILLEGAL FORMAT UNIT*
+       JMS I [DECODE   /PRINT UNIT NUMBER
+       JMS I [CTRLR    /WAIT FOR CTRL/R
+       JMS I [CRLF     /CARRIAGE RETURN/LINE FEED
+       JMP SETUP       /TRY AGAIN
+
+
+
+
+/READ FOUR LINES AND FETCH MARK TRACK
+
+SKIP4, 0
+IOTX5, SDSQ
+       JMP .-1
+IOTX6, SDRC
+       JMP I SKIP4     /--RETURN--
+
+
+
+\f
+PAGE
+
+/IS TAPE TO BE VERIFIED?
+/SET UP DEPENDING ON RESPONSE
+VERFQ, TAD VERF
+       SZA CLA         /VERIFY?
+       JMP YES         /YES--
+       TAD (NOP        /NO--
+       DCA I VERF1A
+       TAD (OUTN
+       DCA I VERF2A
+       JMP CONT
+YES,   TAD (RAR
+       DCA I VERF1A
+       TAD (VERIFY
+       DCA I VERF2A
+CONT,  JMP I .+1
+       DOIT
+
+VERF1A,        VERF1
+VERF2A,        VERF2
+
+/WAIT FOR CTRL/R
+
+CTRLR, 0
+       JMS I [LISTEN   /FETCH CHARACTER
+       TAD [-222
+       SZA CLA         /IT IT CTRL/R?
+       JMP .-3         /NO--WAIT FOR ONE
+       JMS I [CRLF     /CARRIAGE RETURN/LINE FEED
+       JMP I CTRLR     /--RETURN--
+
+
+REPEAT,        DCA COUNT
+       JMS I [CRLF
+       JMS I [QUEST    /@REPEAT (YES=1;NO=0):@
+       MESS11
+       ACL
+       AND [7
+       SZA CLA
+       JMP I [CLEAN    /YES
+       JMP I [START+4  /NO--RESTART
+\f
+MESSG6,        TEXT @FIRST INPUT BLOCK:@
+MESSG7,        TEXT @FIRST OUTPUT BLOCK:@
+MESSG8,        TEXT @NUMBER OF BLOCKS TO COPY:@
+MESSG9,        TEXT @VERIFY OUTPUT (YES=1,NO=0):@
+MESS10,        TEXT @DONE@
+MESS11,        TEXT @REPEAT (YES=1,NO=0):@
+ERROR1,        TEXT @VERIFY ERROR BLOCK @
+ERROR2,        TEXT @TAPE ERROR BLOCK @
+ERROR3,        TEXT @SELECT ERROR UNIT @
+\f
+PAGE
+
+/SETUP FOR ACTUAL READ/WRITE/VERIFY OPERATION
+DOIT,  TAD [LIMIT-END  /SET UP NUMBER OF BLOCKS
+       JMS DIV1        /IN FIELD 0 BUFFER
+       DCA FLD0
+       TAD M200
+       JMS DIV1        /AND IN FIELD N BUFFERS
+       DCA FLDN
+       TAD IBLOCK      /SET UP RUNNING COUNTERS AND POINTERS
+       DCA INB         /FOR NEXT INPUT BLOCK
+       TAD OBLOCK
+       DCA OUTB        /FOR NEXT OUTPUT BLOCK
+       TAD NUMBER
+       DCA NUMB1       /FOR NUMBER OF BLOCKS LEFT TO TRANSFER
+       JMP .+4
+ALLDUN,        TAD XNUMB
+       SNA CLA         /DONE WITH ALL BLOCKS YET?
+       JMP REWIND      /YES
+/READ---
+READX, TAD LIST        /NO--SET UP POINTER TO OUTPUT UNITS
+       DCA OPOINT
+       TAD OCOUNT
+       CMA
+       DCA OUTNUM
+       TAD INB
+       DCA BLOCKN
+       TAD NUMB1       /SET POINTERS FOR TRANSFER
+       DCA XNUMB
+       TAD NUMB1
+       DCA NUMB2       /SAVE COUNTER FOR WRITE
+       TAD INPUT       /SELECT INPUT UNIT
+       DCA UNIT
+       DCA RW          /SET R/W BIT TO READ
+\f
+       TAD [END        /SET START OF BUFFERS IN CASE
+       DCA BUF0        /THEY WERE CHANGED BY VERIFY
+       DCA BUFN
+       JMS I [READY    /FILL THE BUFFERS
+       TAD XNUMB       /SAVE THE POINTERS
+       DCA NUMB1
+       TAD BLOCKN
+       DCA INB
+
+OUTN,  ISZ OPOINT
+       ISZ OUTNUM      /DONE WITH ALL UNITS YET?
+       JMP .+4         /NO--CONTINUE WRITING
+       TAD OHOLD       /YES
+       DCA OUTB
+       JMP ALLDUN      /READ ANOTHER BUFFER LOAD
+WRITEX,        TAD OUTB
+       DCA OHOLD
+       TAD OHOLD       /WRITE
+       DCA BLOCKN      /RESET POINTERS
+       TAD OUTB
+       DCA VB          /SAVE COUNTER FOR VERIFY
+       TAD NUMB2
+       DCA XNUMB
+       TAD I OPOINT    /SELECT OUTPUT UNIT
+       DCA UNIT
+       CLA CLL CML RAR /AC=4000
+       DCA RW          /SET R/W BIT TO WRITE
+       JMS I [READY
+       TAD BLOCKN
+       DCA OHOLD
+       JMP I .+1
+VERF2, VERIFY
+
+
+\f
+/SEE HOW MANY BLOCKS WILL FIT INTO BUFFER
+/ENTER WITH BUFFER SIZE IN AC
+/EXIT WITH # OF BLOCKS IN AC
+
+DIV1,  0
+       DCA COUNT1
+       DCA COUNT
+       TAD COUNT1      /TOTAL WORDS
+DIV2,  CLL
+       TAD I [MWORDS   /-NUMBER OF WORDS PER BLOCK
+       SNL             /RUN OUT OF ROOM?
+       JMP .+3         /YES--
+       ISZ COUNT       /NO--COUNT A BLOCK
+       JMP DIV2
+       CLA CLL         /IGNORE LESS THAN A BLOCK LEFT
+       TAD COUNT
+VERF1, RAR             /DIVIDE BY 2 IF VERIFY (NOP IF NO VERIFY)
+       JMP I DIV1      /--RETURN--
+
+/END OF OPERATION
+/REWIND TAPES TO INITIAL END ZONE
+
+REWIND,        TAD OCOUNT
+       CMA
+       DCA COUNT2      /SET NUMBER OF TAPES STILL SPINNING
+RLIST, CLA CMA
+       TAD LIST
+       DCA OPOINT      /SET POINTER TO UNIT LIST
+       TAD OCOUNT
+       IAC
+       CMA
+       DCA OUTNUM      /SET NUMBER OF UNITS IN LIST
+RUNIT, JMS I   [PARITY
+       JMS I [CHECK    /CHECK TTY FOR CTRL/S OR CTRL/C
+       ISZ OUTNUM      /DONE WITH WHOLE LIST YET?
+       SKP CLA         /NO
+       JMP RLIST       /YES--START THROUGH LIST AGAIN
+       ISZ OPOINT
+       TAD I OPOINT    /GET UNIT CODE
+       RTL
+       SZL CLA         /STILL SPINNING?
+       JMP RUNIT       /NO--TRY NEXT TAPE
+       TAD I OPOINT    /YES
+       DCA UNIT
+\f
+
+       TAD [-6
+       DCA COUNT
+       TAD [RTAB
+       DCA COUNT1
+       JMS I [INSERT   /PUT PROPER IOT'S IN THIS ROUTINE
+       TAD I OPOINT
+       AND [4000       /UNIT/READ
+       TAD [3000       /REVERSE/GO
+IOTR1, SDLC
+       JMS I [SKIPQ
+       JMS I [SKIPQ    /WAIT FOR DRIVE TO GET UP TO SPEED
+IOTR2, SDSS
+       JMP .-1
+IOTR3, SDRC            /GET MARK TRACK BITS
+       AND [77
+       TAD [-22
+       SZA CLA         /END ZONE?
+       JMP RUNIT       /NO--NEXT UNIT
+       CLA CLL CML RTR /AC=2000
+       MQA             /UNIT CODE STILL IN MQ FROM INSERT
+       DCA I OPOINT    /SET STOPPED BIT
+       TAD I OPOINT
+       AND [6000
+IOTR4, SDLC            /STOP UNIT
+M200,  7600            /CLA
+       ISZ COUNT2      /ALL TAPES STOPPED?
+       JMP RUNIT       /NO--NEXT UNIT
+       JMS I [MESSGE   /YES
+       MESS10          /@DONE@
+       JMP I [REPEAT
+
+\f
+
+PAGE
+
+/VERIFICATION ROUTINES
+
+VERIFY,        TAD VB          /SET POINTERS AND COUNTERS FOR TRANSFER
+       DCA BLOCKN
+       TAD NUMB2
+       DCA XNUMB
+       DCA RW
+       TAD END0        /SET BEGINNINGS OF VERIFY BUFFERS
+       DCA BUF0
+       TAD (3700
+       DCA BUFN
+       TAD CDF0
+       DCA COMP2
+       JMS I [READY    /READ VERIFY BUFFERS FULL
+       TAD COUNT1      /GET # OF BLOCKS IN LAST BUFFER FILLED
+       DCA COUNT3
+       CMA             /SET AUTOINDEX POINTERS TO BUFFERS
+       TAD [END
+       DCA X11
+       CMA CLL
+       TAD END0
+       DCA X12
+       TAD COUNT
+       CMA
+       TAD FIELDS
+       DCA COUNT       /SET NUMBER OF FIELDS WHICH WERE FILLED
+       JMS COMP4       /GET NUMBER OF BLOCKS
+       TAD FLD0
+       CIA
+       DCA COUNT4      /SET COUNTER
+       JMS COMP        /COMPARE THE BUFFERS
+\f
+COMP3, TAD COUNT
+       SNA CLA
+       JMP I [OUTN
+       JMS COMP4       /GET NUMBER OF BLOCKS
+       TAD FLDN
+       CIA
+       DCA COUNT4
+       TAD COMP2       /EACH FIELD------
+       TAD (10
+       DCA COMP2       /SET CDF INSTRUCTION PROPERLY
+       CMA CLL         /SET AUTOINDEX POINTERS TO BUFFERS
+       DCA X11
+       TAD (3677
+       DCA X12
+       JMS COMP
+       JMP COMP3       /DO THE NEXT FIELD
+
+
+/ENTER WITH AC CLEAR
+/EXIT TO CALL+1 WITH AC CLEAR IF
+/NORMAL BUFFER FILL
+/EXIT TO CALL+2 WITH # OF BLOCKS IN AC IF
+/LAST BUFFER
+
+COMP4, 0
+       ISZ COUNT       /LAST FIELD FILLED?
+       JMP I COMP4     /NO--RETURN--
+       TAD XNUMB       /YES--OUT OF BLOCKS?
+       SZA CLA
+       JMP I COMP4     /NO--RETURN--
+       TAD COUNT3      /YES--GET ACTUAL # OF BLOCKS
+       ISZ COMP4       /INCREMENT RETURN ADDRESS
+       JMP I COMP4     /--RETURN--
+
+\f
+/COMPARE PORTION OF VERIFY ROUTINE
+
+COMP,  0
+       TAD I [MWORDS   /SET NUMBER OF WORDS PER BLOCK COUNTER
+       DCA COUNT2
+COMP2, HALT            /SHOULD CONTAIN CDF N
+       TAD I X11       /GET CORRESPONDING WORDS FROM EACH BUFFER
+       CIA
+       TAD I X12
+CDF0,  CDF 0
+       SZA CLA         /DO WORDS MATCH?
+       JMP ERR1        /NO--VERIFY ERROR
+TRY,   ISZ COUNT2      /DONE WITH BLOCK?
+       JMP COMP2       /NO--CONTINUE
+       ISZ COUNT4      /DONE WITH ALL BLOCKS?
+       JMP COMP+1      /NO
+       JMP I COMP      /YES--RETURN--
+
+ERR1,  JMS I [MESSGE
+       ERROR1          /*VERIFY ERROR BLOCK *
+       TAD COUNT4      /GET CURRENT BLOCK NUMBER
+       CIA
+       TAD I (BLOCKS   /FROM BLOCK THIS OPERATION STARTED WITH
+       JMS PRINT        /PRINT 4 DIGIT BLOCK NUMBER
+       JMS I [MESSGE
+       ERROR6          /*UNIT *
+       JMS I [DECODE   /PRINT UNIT NUMBER
+WAIT,  JMS I [LISTEN   /WAIT FOR RESPONSE
+       DCA PRINT
+       JMS I [CRLF
+       TAD PRINT
+       TAD [-224
+       SNA             /WAS IT CTRL/T?
+       JMP I [WRITEX   /YES--TRY AGAIN
+       TAD [2
+       SZA CLA         /WAS IT CTRL/R?
+       JMP WAIT        /NO--WAIT FOR A GOOD RESPONSE
+       JMP TRY         /YES--IGNORE AND CONTINUE
+
+\f
+
+
+/PRINT A 4 DIGIT OCTAL NUMBER
+/ENTER WITH NUMBER IN AC
+
+PRINT, 0
+       DCA I [MESSGE   /TEMPORARY STORAGE
+       TAD [-4
+       DCA I [ANSWER   /SET DIGIT COUNTER
+       TAD I [MESSGE
+       RAL
+       DCA I [CRLF
+FOUR,  TAD I [CRLF
+       RAL
+       RTL
+       DCA I [CRLF
+       TAD I [CRLF
+       AND [7
+       TAD [260
+       JMS I [TYPE     /PRINT ONE DIGIT
+       ISZ I [ANSWER   /DONE YET?
+       JMP FOUR        /NO
+       JMP I PRINT     /YES--RETURN--
+
+
+/CLEAN UP UNIT TABLES AFTER REWIND
+
+CLEAN, TAD LIST
+       DCA OPOINT
+       TAD OCOUNT
+       CMA
+       DCA OUTNUM      /SET POINTER AND COUNTER
+CLEAN1,        TAD I OPOINT    /GET UNIT CODE
+       AND (4770       /MASK OUT EXTRANEOUS BITS
+       DCA I OPOINT    /REPLACE IT
+       ISZ OPOINT
+       ISZ OUTNUM      /DONE YET?
+       JMP CLEAN1      /NO
+       JMP I [DOIT     /YES--NEXT OPERATION
+
+
+
+\f
+PAGE
+
+/FILL ALL N FIELDS ONCE
+/ENTER WITH AC CLEAR
+/# OF BLOCKS FOR FIELD 0 IN FLD0
+/# OF BLOCKS FOR OTHERS IN FLDN
+/ADDRESSES OF BUFFERS IN BUF0, BUFN
+/R/W BIT (0 OR 4000) IN RW
+
+
+
+READY, 0
+       TAD [IOTLOC-TABEND-1
+       DCA COUNT
+       TAD [IOTLOC
+       DCA COUNT1
+       JMS I [INSERT   /PUT PROPER IOT'S IN HANDLER
+       TAD UNIT
+       SPA CLA         /EVEN OR ODD UNIT NUMBER?
+       CLL IAC RTL     /ODD
+       TAD [ORIGIN     /EVEN
+       DCA ENTRY       /SET UP ENTRY TO HANDLER
+       TAD RW
+       MQL             /STORE UNIT BIT FOR LATER
+       CMA
+       TAD FIELDS      /SET COUNTER FOR # OF FIELDS
+       DCA COUNT
+       CLL
+       TAD FLD0        /ADJUST NUMBER OF BLOCKS TO
+       JMS SUB1        /TRANSFER DEPENDING ON NUMBER
+       TAD FLD0        /LEFT TO BE TRANSFERRED
+       JMS SUB2        /RESET FUNCTION WORD
+       TAD BUF0        /SET UP BUFFER POINTERS
+       JMS SUB3
+       JMS TRANS       /TRANSFER DATA--FIELD 0
+ZOOM,  ISZ COUNT       /BEGINNING OF LOOP FOR EACH FIELD ABOVE 0
+       SKP             /DONE YET?
+       JMP I READY     /YES--RETURN--
+\f
+       TAD FIELDS
+       CIA CLL
+       TAD COUNT
+       IAC
+       RAL
+       RTL             /GET FIELD SETTING READY
+       MQL             /STORE IN MQ
+       TAD FUNCTN      /GET PREVIOUS FUNCTION WORD
+       AND [4000       /GET R/W BIT
+       MQA             /OR IN FIELD SETTING
+       MQL             /STORE
+       CLL
+       TAD FLDN        /ADJUST NUMBER OF BLOCKS TO TRANSFER
+       JMS SUB1
+       TAD FLDN
+       JMS SUB2        /AND RESET FUNCTION WORD
+       TAD BUFN
+       JMS SUB3        /SET UP BUFFER POINTERS
+       JMS TRANS       /TRANSFER DATA--FIELDS 1-N
+       JMP ZOOM        /FILL ANOTHER FIELD
+
+SUB1,  0
+       CIA
+       TAD XNUMB
+       CLL CML         /SET LINK=1
+       SMA             /ARE THERE LESS BLOCKS LEFT THAN A FIELD FULL?
+       DCA XNUMB       /NO--REDUCE COUNT OF BLOCKS LEFT
+       JMP I SUB1      /YES-TRANSFER BLOCKS LEFT--RETURN--
+
+SUB2,  0
+       DCA COUNT1      /LINK=1 IF BLOCKS LEFT, 0 IF NONE
+       SNL             /DONE WITH ALL BLOCKS YET?
+       DCA XNUMB       /YES--BUMP SWITCH
+       TAD COUNT1      /NO
+       BSW
+       MQA             /PUT # OF BLOCKS INTO FUNCTION WORD
+       DCA FUNCTN      /START REVERSE
+       JMP I SUB2      /--RETURN--
+
+\f
+SUB3,  0
+       DCA BUFADD
+       TAD BLOCKN      /SET STARTING BLOCK NUMBER
+       DCA BLOCKS
+       TAD COUNT1
+       TAD BLOCKN
+       DCA BLOCKN      /RESET STARTING BLOCK FOR NEXT TIME
+       JMP I SUB3      /--RETURN--
+
+
+/CALL TO THE HANDLER
+
+TRANS, 0
+       JMS I   [PARITY         /CHECK TELETYPE
+       JMS I [CHECK    /WAS ^C OR ^S TYPED?
+       JMS I ENTRY
+FUNCTN,        0               /FUNCTION WORD
+BUFADD,        0               /BUFFER ADDRESS
+BLOCKS,        0               /STARTING BLOCK NUMBER
+       JMP ERR         /ERROR RETURN
+       JMS I   [PARITY         /CHECK TELETYPE
+       JMS I [CHECK    /WAS ^C OR ^S TYPED?
+       CLA
+       TAD XNUMB
+       SZA CLA         /DONE YET?
+       JMP I TRANS     /NO--RETURN--
+       ISZ COUNT
+       JMP I READY     /--RETURN--
+       JMP I READY     /--RETURN--
+
+/TRANSFER ERROR HANDLER
+
+ERR,   SNA CLA         /FATAL ERROR?
+       JMP SELECT      /NO
+       JMS I [MESSGE   /YES
+       ERROR2          /*TAPE ERROR BLOCK *
+       TAD I (BLOCK
+       JMS I [PRINT    /PRINT BLOCK NUMBER
+       JMS I [MESSGE
+       ERROR6          /*UNIT *
+       JMS DECODE      /PRINT UNIT NUMBER
+       JMS I [CRLF
+       JMP I [REWIND
+SELECT,        JMS ERR3
+       ISZ FUNCTN      /TURN AROUND AND TRY AGAIN
+       JMP FUNCTN-1
+
+\f
+ERR3,  0
+       JMS I [MESSGE
+       ERROR3          /*SELECT ERROR UNIT *
+       JMS DECODE      /PRINT UNIT NUMBER
+       JMS CTRLR       /WAIT FOR CTRL/R
+       JMP I ERR3      /--RETURN--
+
+
+/DECODE UNIT NUMBER FOR PRINTING
+/PRINT UNIT NUMBER BEFORE RETURNING
+
+DECODE,        0
+       CLL
+       TAD UNIT
+       RAL
+       MQL             /SAVE ROTATED CODE IN MQ
+       RAL
+       SWP             /SAVE EVEN/ODD BIT IN MQ
+       RAR             /WORK ON IOT CODE
+       RTR
+       IAC
+       CMA
+       AND [7
+       MQA             /INCLUDE EVEN/ODD BIT
+       TAD [260        /MAKE ASCII DIGIT
+       JMS I [TYPE
+       JMP I DECODE    /--RETURN--
+
+
+PAGE
+
+\f
+/TD8E DECTAPE HANDLER
+
+/SLIGHTLY MODIFIED VERSION OF DEC-E8-UZTA-D
+/COPYRIGHT 1971  DIGITAL EQUIPMENT CORPORATION
+/      MAYNARD, MASSACHUSETTS 01754
+
+/THE CALLING SEQUENCE IS:
+/      JMS ENTRY
+/      FUNCTION WORD
+/      BUFFER ADDRESS
+/      STARTING BLOCK
+/      ERROR RETURN
+/      NORMAL RETURN (AC CLEAR)
+
+/FUNCTION WORD:
+/      BIT 0:          0=READ, 1=WRITE
+/      BITS 1-5:       # OF BLOCKS TO BE TRANSFERRED
+/      BITS 6-8:       FIELD OF BUFFER AREA
+/      BITS 9-10:      UNUSED
+/      BIT 11:         1=START FORWARD, 0=START REVERSE
+
+/ERRORS:
+/THE HANDLER DETECTS TWO TYPES OF ERRORS:
+/FATAL ERRORS:
+/      PARITY ERROR
+/      TIMING ERROR
+/      TOO GREAT A BLOCK NUMBER
+/FATAL ERRORS TAKE ERROR RETURN WITH AC=4000
+/NON-FATAL ERROR:
+/      SELECT ERROR (IMPROPER UNIT NUMBER OR NO UNIT NUMBER)
+/NON-FATAL ERROR TAKES ERROR RETURN WITH AC=0
+\fPAGE
+
+MFIELD=0
+ORIGIN=.
+
+DTA0,  0               /ENTRY POINT FROM UNIT 0
+       CLA CLL         /0 TO LINK
+       JMP DTA1X
+C1000, 1000
+DTA1,  0               /UNIT 2 ENTRY
+       CLA CLL CML     /1 TO LINK
+       TAD DTA1
+       DCA DTA0        /PICK UP ARGS AT DTA0
+DTA1X, RAR
+       DCA YUNIT       /LINK TO UNIT POSITION
+       RDF
+       TAD C6203       /GET DATA FIELD AND SETUP RETURN
+       DCA LEAVE
+       TAD YUNIT       /GET FUNCTION WORD
+IOT4,  SDLC            /PUT FUNCTION INTO DATA REGISTER
+       TAD I   DTA0
+IOT1,  SDLD
+       CLA
+       TAD MWORDS
+       DCA WCOUNT      /STORE MASTER WORD COUNT
+       ISZ DTA0        /TO BUFFER
+       TAD I DTA0
+       DCA BUFF
+       ISZ DTA0        /TO BLOCK NUMBER
+       TAD I DTA0
+       DCA BLOCK
+       ISZ DTA0        /POINT TO ERROR EXIT
+       CIF CDF MFIELD  /TO ROUTINES DATA FIELD
+IOT2,  SDRD            /GET FUNCTION INTO AC
+       CLL RAL
+       AND CM200       /GET # PAGES TO XFER
+       DCA PGCT
+IOT3,  SDRD
+C374,  AND C70         /GET FIELD FOR XFER
+       TAD C6201       /FORM CDF N
+       DCA XFIELD      /IF=0 AND DF=N AT XFER.
+       CLA CLL CMA RTL
+       DCA TRYCNT      /3 ERROR TRIES
+IOT5,  SDRC
+       AND C100
+       SZA CLA
+       JMP FATAL-1
+\f
+IOT6,  SDRD            /PUT FUNCT INTO XFUNCT IN SECOND PG.
+       DCA I CXFUN
+       TAD WCOUNT
+       DCA I CXWCT
+IOT7,  SDRD            /GET MOTION BIT TO LINK
+       CLL RAR
+       JMP GO          /AND START THE MOTION.
+RWCOM, SDST            /ANY CHECKSUM ERRORS?
+       SZA CLA         /OR CHECKSUM ERRORS?
+       JMP TRY3        /PLEASE NOTE THAT THE LINK IS ALWAYS
+                       /SET AT RWCOM. GETCHK SETS IT.
+       TAD PGCT        /NO ERROR..FINISHED XFER?
+       TAD CM200
+       SNA
+       JMP EXIT        /ALL DONE. GET OUT
+       DCA PGCT        /NEW PAGE COUNT
+       ISZ BLOCK       /NEXT BLOCK TO XFER
+       TAD WCOUNT      /FORM NEXT BUFFER ADDRESS
+       CIA
+       TAD BUFF
+       DCA BUFF
+       CLL CML         /FORCES MOTION FORWARD
+GO,    CLA CML RTR     /LINK BECOMES MOTION BIT
+       TAD C1000
+       TAD YUNIT       /PUT IN 'GO' AND UNIT #
+IOT8,  SDLC            /LOOK FOR BLOCK NO.
+       JMS I CRDQUD    /WAIT AT LEAST 6 LINES TO LOOK
+       JMS I CRDQUD
+CM200, 7600            /COULD HAVE SAVED A LOC. HERE
+SRCH,  SDSS
+       JMP .-1         /WAIT FOR SINGLE LINE FLAG
+IOT9,  SDRC
+       CLL RTL         /DIRECTION TO LINK. INFO BITS 
+                       /ARE SHIFTED.
+       AND C374        /ISOLATE MARK TRACK BITS
+       TAD M110        /IS IT END ZONE?
+       SNA             /THE LINK STAYS SAME THRU THIS
+       JMP ENDZ
+       TAD M20         /CHECK FOR BLOCK MARK
+       SZA CLA
+       JMP SRCH
+IOT10, SDRD            /GET THE BLOCK NUMBER
+       SZL             /IF WE ARE IN REVERSE, LOOK FOR 3
+                       /BLOCKS BEFORE TARGET BLOCK. THIS
+                       /ALLOWS TURNAROUND AND UP TO SPEED.
+       TAD C3          /REVERSE
+       CMA
+       TAD BLOCK
+       CMA             /IS IT RIGHT BLOCK?
+       SNA
+       JMP FOUND       /YES..HOORAY!
+M110,  SZL SNA CLA     /NO, BUT ARE WE HEADED FOR IT?
+                       /ABOVE SNA IS SUPERFLUOUS.
+       JMP SRCH        /YES
+ENDZ,  SDRC            /WE ARE IN THE END ZONE
+       CLL RTL         /DIRECTION TO LINK
+        CLA            /ARE WE IN REVERSE?
+       JMP GO          /YES..TURN US AROUND
+/IF WE ARE IN THE END ZONE GOING FORWARD, IT IS AN ERROR
+TRY3,  CLL CLA
+       ISZ TRYCNT
+       JMP GO          /TRY 3 TIMES
+       CLL CLA
+       JMP FATAL               /LINK OFF MEANS AC=4000 ON RETURN
+EXIT,  ISZ DTA0
+       CLL CML         /AC=0 ON NORMAL RETURN
+FATAL, TAD YUNIT
+       SDLC            /STOP THE UNIT
+       CLA CML RAR
+LEAVE, HLT
+       JMP I DTA0      /--RETURN--
+
+\f
+C6201, 6201
+C6203, 6203
+CRDQUD,        RDQUAD
+WCOUNT,        0
+BUFF,  0
+MWORDS,        0
+YUNIT, 0
+CXFUN, XFUNCT
+M20,   -20
+PGCT,  0
+CXWCT, XWCT
+C100,  100
+TRYCNT,        -3
+BLOCK=DTA1
+
+
+       *ORIGIN+170
+FOUND, SZL CLA         /RIGHT BLOCK. HOW ABOUT DIRECTION?
+       JMP GO          /WRONG..TURN AROUND
+       TAD YUNIT       /PUT UNIT INTO LINK
+       CLL RAL         /AC IS NOW 0
+C70,   70              /********DON'T MOVE THIS!!!!******
+C3,    3
+       TAD BUFF        /GET BUFFER ADDRESS
+XFIELD,        HLT             /INTO NEXT PAGE
+
+       *ORIGIN+200
+       XUNIT=EQUFUN
+
+       DCA     XBUFF
+IOT16, SDRC
+IOT17, SDLC
+       RAR             /NOW GET UNIT #
+       DCA XUNIT
+REVGRD,        SDSS
+       JMP REVGRD              /LOOK FOR REVERSE GUARD
+IOT11, SDRC
+       AND K77
+       TAD CM32        /IS IT REVERSE GUARD?
+       SZA CLA
+       JMP REVGRD      /NO.KEEP LOOKING
+       TAD XWCT
+       DCA WORDS       /WORD COUNTER
+       TAD XFUNCT      /GET FUNCTION  READ OR WRITE
+K7700, SMA CLA
+       JMP READ        /NEG. IS WRITE
+WRITE, SDRC
+       AND C300        /CHECK FOR WRITE LOCK AND SELECT ERROR
+       CLL CML         /LOCK OUT AND SELECT ARE AC 0 ERRORS
+       SZA CLA
+       JMP I CFATAL    /FATAL ERROR. LINK MUST BE ON
+       JMS RDQUAD      /NO ONE EVER USES THIS WORD!
+C7600, 7600
+       TAD C1400
+       TAD XUNIT       /INITIATE WRITE MODE
+IOT12, SDLC
+       CLA CMA
+       JMS WRQUAD      /PUT 77 IN REVERSE CHECKSUM
+       CLA CMA
+       DCA CHKSUM
+WRLP,  TAD I XBUFF     /GLORY BE! THE ACTUAL WRITE!
+       JMS WRQUAD
+       ISZ XBUFF       /BUMP CORE POINTER
+K77,   77              /ABOVE MAY SKIP
+       ISZ WORDS       /DONE THIS BLOCK?
+       JMP WRLP        /NOT YET..LOOP A WHILE
+       TAD XFUNCT      /IS THE OPERATION FOR WDSBLK PER BLOCK?
+       CLL RTR         /IF NO, WRITE A 0 WORD
+       SZL CLA
+\f
+       JMS WRQUAD      /WRITE A WORD OF 0
+       JMS GETCHK      /DO THE CHECK SUM
+       JMS WRQUAD      /WRITE FORWARD CHECKSUM
+       JMS WRQUAD      /ALLOW CHECKSUM TO BE WRITTEN
+       JMP I CRWCOM
+
+
+READ,  JMS RDQUAD
+       JMS RDQUAD
+       JMS RDQUAD      /SKIP CONTROL WORDS
+       AND K77
+       TAD K7700       /TACK 7700 ONTO CHECKSUM.
+       DCA CHKSUM      /CHECKSUM ONLY LOW 6 BITS ANYWAY
+RDLP,  JMS RDQUAD
+       JMS EQUFUN      /COMPUT CHECKSUM AS WE GO
+       DCA I XBUFF     /IT GETS CONDENSED LATER
+       ISZ XBUFF
+C300,  300             /PROTECTION
+       ISZ WORDS       /DONE THIS OP?
+       JMP RDLP        /NO SUCH LUCK
+       TAD XFUNCT      /IF OP WAS FOR WDSBLK-1, READ AND
+       CLL RTR         /CHECKSUM THE LAST TAPE WORD
+       SNL CLA
+       JMP RDLP2
+       JMS RDQUAD      /NOT NEEDED FOR WDSBLK/BLOCK
+       JMS EQUFUN      /CHECKSUM IT
+RDLP2, JMS RDQUAD      /READ CHECKSUM
+       AND K7700
+       JMS EQUFUN
+       JMS GETCHK      /GET SIX BIT CHECKSUM
+       JMP I CRWCOM
+
+WRQUAD,        0               /WRITE OUT A 12 BIT WORD
+       JMS EQUFUN      /ADD THIS TO CHECKSUM
+IOT13, SDSQ            /SKIP ON QUADLINE FLAG
+       JMP .-1
+IOT14, SDLD            /LOAD DATA  ONTO BUS
+       CLA             /SDLD DOESN'T CLEAR AC
+       JMP I WRQUAD
+
+RDQUAD,        0               /READ A 12 BIT WORD
+       SDSQ
+       JMP .-1
+IOT15, SDRD            /READ DATA
+       JMP I RDQUAD
+
+\f
+EQUFUN,        0               /COMPUTE EQUIVALENCE CHECKSUM
+       CMA
+       DCA EQUTMP      /ACTUALLY CHECKSUMS ON DECTAPE ARE
+       TAD EQUTMP      /EQUIVALENCE OF ALL WORDS IN A RECORD
+       AND CHKSUM      /SIX BITS AT A TIME. BUT SINCE EQUIVALENCE
+       CIA             /IS ASSOCIATIVE, WE CAN DO IT 12
+       CLL RAL         /BITS AT A TIME AND CONDENSE LATER.
+       TAD EQUTMP      /THIS ROUTINE USES THESE IDENTITIES:
+       TAD CHKSUM      /A+B=(A.XOR.B)+2*(A.AND.B)
+       DCA CHKSUM      /A.EQU.B=.NOT.(A.XOR.B)=A.XOR.(.NOT.B)
+       TAD EQUTMP      /A.EQU.B=(A+(.NOT.B))-2*(A.AND.(.NOT.B))
+       CMA
+       JMP I EQUFUN
+
+GETCHK,        0               /FORM 6 BIT CHECKSUM
+       CLA
+       TAD CHKSUM      
+       CMA
+       CLL RTL
+       RTL
+       RTL
+       JMS EQUFUN
+       CLA CLL CML     /FORCES LINK ON AT RWCOM
+       TAD CHKSUM
+       AND K7700
+       JMP I GETCHK
+
+CFATAL,        FATAL
+CRWCOM,        RWCOM
+XFUNCT,        0
+CM32,  -32
+C1400, 1400
+CHKSUM,        0
+WORDS, 0
+XBUFF, 0
+XWCT,  0
+EQUTMP,        0
+
+\fPAGE
+/
+/
+PARITY,        0
+       KRB
+       AND     [177
+       TAD     [200
+       JMP I   PARITY
+
+/IOT TABLES FOR TD8E SUBROUTINE
+
+IOTLOC,        IOT1
+       IOT2
+       IOT3
+       IOT4
+       IOT5
+       IOT6
+       IOT7
+       RWCOM
+       IOT8
+       SRCH
+       IOT9
+       IOT10
+       ENDZ
+       FATAL+1
+       REVGRD
+       IOT11
+       WRITE
+       IOT12
+       IOT13
+       IOT14
+       RDQUAD+1
+       IOT15
+       IOT16
+TABEND,        IOT17
+
+UNITS=.
+       UNIT01
+       UNIT23
+       UNIT45
+       UNIT67
+
+RTAB,  IOTR1
+       IOTR2
+       IOTR3
+       IOTR4
+       IOTR5
+       IOTR6
+
+
+/IOT TABLES FOR WORDS PER BLOCK ROUTINE
+
+TABLE1,        IOTX1
+       IOTX2
+       IOTX3
+       IOTX4
+       IOTX5
+       IOTX6
+       IOTX7
+END1,  IOTX8
+
+\fMESSG4,       TEXT @FROM UNIT:@
+MESSG5,        TEXT @TO UNITS:@
+ERROR5,        TEXT @ILLEGAL FORMAT UNIT @
+ERROR6,        TEXT @ UNIT @
+ERROR4,        TEXT @ILLEGAL RESPONSE@
+
+\f
+PAGE
+/ONCE ONLY CODE
+
+END,   JMS I (QUEST
+       MESSG2          /@HIGHEST FIELD AVAILABLE:@
+       ACL
+       AND [7
+       CIA
+       DCA FIELDS
+       TAD (CDF
+       DCA CDF00
+       TAD FIELDS
+       SNA             /MORE THAN 1 FIELD??
+       JMP LIM         /NO--NO PROBLEM
+       DCA COUNT1      /YES--ARE THEY ALL PRESENT?
+NEXT,  TAD CDF00
+       TAD (10
+       DCA CDF00       /SET FOR DATA FIELD CHANGE
+       TAD (HLT
+CDF00, CDF
+       DCA I (10       /TRY LOCATION 10
+       TAD I (10
+       CDF 0
+       CIA
+       TAD (HLT
+       SNA CLA         /IS FIELD THERE?
+       JMP NEXT1       /YES--TRY NEXT ONE
+       JMS I [MESSGE   /NO
+       ERROR4          /ILLEGAL RESPONSE
+       JMS I [CRLF     /CARRIAGE RETURN/LINE FEED
+       DCA COUNT       /CLEAR COUNT
+       JMP END         /TRY AGAIN
+NEXT1, ISZ COUNT1      /DONE YET?
+       JMP NEXT        /NO
+
+LIM,   TAD (LIMIT-END  /SET BEGINNING OF VERIFY BUFFER
+       CLL RAR
+       TAD [END
+       DCA END0
+       TAD (NOP
+       DCA I (START1-1
+       JMP I (START1
+MESSG2,        TEXT @HIGHEST FIELD AVAILABLE:@
+
+FIELD 0
+*200
+
+$
+\f\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/TDINIT.PA b/sw/os8/v3d/sources/system/dectapes/dectape3/TDINIT.PA
new file mode 100644 (file)
index 0000000..89a1682
--- /dev/null
@@ -0,0 +1,931 @@
+/2 TD8E INITIALIZER PROGRAM, V7A
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 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.
+/
+/
+/
+/
+/
+/
+\f
+/DECEMBER 21, 1973             GB/RL/EF/SR
+
+/ABSTRACT--
+/      THE ROUTINE DESCRIBED AND LISTED HERE IS A GENERAL
+/DATA HANDLER FOR THE TD8E DECTAPE SYSTEM. THE ROUTINE
+/CONTAINS SEARCH, READ, AND WRITE FUNCTIONS IN A FORMAT
+/WHICH IS COMPATIBLE WITH OS/8 DEVICE HANDLER CALLING
+/SEQUENCES.
+
+/      EXPLANATION:
+
+/THIS IS A SAVE FILE, WHICH MUST BE PLACED AS FILE # 1
+/ON THE OS/8 BINARIES TAPE.  (I.E. BLOCK 7)
+/FOLLOWING IT MUST BE THE FOLLOWING FILES, EACH 50 (DEC) BLKS LONG:
+/TDROM.SY
+/TD12K.SY
+/
+/TO CREATE SPECIAL BLOCK 0 FOR THAT TAPE, START THIS PROGRAM AT
+/LOCATION 200 AND FOLLOW INSTRUCTIONS.
+
+/TO THEN PERFORM THE INITIALIZATION FROM THE LIBRARY TAPES,
+/MERELY PLACE THE BINARY TAPE ON UNIT 0 AND BOOTSTRAP INTO IT.
+/THEN FOLLOW INSTRUCTIONS.
+
+/FILES TDROM.SY AND TD12K.SY ARE MERELY SYSTEM HEADS OF THE
+/APPROPRIATE SYSTEMS, THEY MAY CONTAIN ANY HANDLERS.
+
+/THE BLOCK 0 SPECIAL SECONDARY BOOTSTRAP READS IN THE FIRST
+/3 PAGES OF TDINIT (WORDS 200-777) AND BRANCHES TO 'STARTUP'.
+/THIS THEN READS IN THE REMAINDER OF TDINIT WITH ERROR CHECKING.
+
+/CODE LOC      BLOCK ON BINARY TAPE
+
+/CCB           16,17           (THESE ARE DECTAPE BLOCK NUMBERS, NOT OS/8 RECORDS)
+/0             20              SKIPPED BY BLOCK 0
+/200           21
+/400           22
+/600           23
+/1000          24
+/1200          25
+/1400          26
+/1600          27
+/2000          30
+/2200          31      TDINIT MUST HAVE USEFUL PART END AT OS/8 RECORD  75
+/7400          32,33   RECORD 15 CONTAINS IMAGE OF BLOCK 0
+
+/FIXES SINCE FIELD-TEST RELEASE:
+
+/1.    FIXED BUG RE CLA ON RETRY AFTER ERROR
+/2.    ALLOWED FINAL BOOTSTRAP TO BE INTO A WRITE-LOCKED DEVICE
+
+/OS/8 V3D CHANGES:
+
+/3.    FIXED BUG RE TD8E BUILD (V6B PATCH)
+\f
+/THIS ROUTINE CAN BE RE-EDITED AND ASSEMBLED TO PRODUCE
+/VARIATIONS ON THE BASIC TD8E SYSTEM. ASSEMBLY PARAMETERS
+/CONTROL:
+/A) WHAT DRIVES (UNITS 0-7) WILL BE USED
+/B) THE ORIGIN OF THE TWO PAGE ROUTINE
+/C) WHAT MEMORY FIELD THE ROUTINE WILL RUN IN
+/D) THE SIZE OF THE DECTAPE BLOCK TO BE READ/WRITTEN
+
+/FOLLOWING ARE THE PARAMETERS SET UP FOR THE STANDARD
+/DEC VERSION OF THIS ROUTINE:
+
+       DRIVE=10        /UNITS 0 AND 1 SELECTED
+       ORIGIN=400      /ENTER AT ORIGIN, ORIGIN+4
+       AFIELD=0        /INITIAL FIELD SETTING
+       MFIELD=00       /AFIELD*10=MFIELD
+       WDSBLK=201      /129 WORDS PER BLOCK
+
+/THE USE OF THE PARAMETERS IS AS FOLLOWS:
+
+/ DRIVE: DRIVE DETERMINES WHICH UNITS WILL BE SELECTED
+/      DRIVE=10 IMPLIES UNITS 0 &1
+/      DRIVE=20 IMPLIES UNITS 2&3
+/      DRIVE=30 IMPLIES UNITS 4&5
+/      DRIVE=40 IMPLIES UNITS 6&7
+
+/ORIGIN: ALTERING ORIGIN CAUSES ASSEMBLY IN A DIFFERENT
+/      MEMORY LOCATION. WHEN CHANGING ORIGIN KEEP IN MIND
+/THAT THIS IS A TWO PAGE ROUTINE.
+
+/AFIELD: AFIELD DETERMINES THE INITIAL FIELD SETTING FOR THE
+/      LOADER. PERMISSIBLE VALUES FOR AFIELD ARE 0 TO 7.
+
+/MFIELD: MFIELD IS USED IN A CIF CDF MFIELD INSTRUCTION.
+/      THE VALUE INSERTED FOR MFIELD SHOULD BE 10(8) TIMES
+/      THE VALUE FOR AFIELD. THE PERMISSIBLE VALUES ARE 00-70.
+
+/WDSBLK: WDSBLK GOVERNS HOW MANY WORDS THE ROUTINE THINKS ARE 
+/      IN A DECTAPE BLOCK. THE STANDARD VALUE IS 201(8) OR
+/      128 DECIMAL. NOTE THAT THE FUNCTION WORD BIT 10 CAN
+/      BE USED TO SUBTRACT ONE FROM WDSBLK. THE VALUE USED
+/      FOR WDSBLK SHOULD BE THE NUMBER OF WORDS THE TAPE WAS
+/      FORMATTED TO CONTAIN.
+
+/IF WE WANT A HANDLER FOR UNITS 2&3 TO RESIDE IN
+/FIELD 2 AT LOCATION 3000 AND READ/WRITE 256(10) WORDS
+/PER BLOCK, THE PARAMETERS WOULD BE:
+/      DRIVE=20
+/      ORIGIN=3000
+/      AFIELD=2
+/      MFIELD=20
+/      WDSBLK=400
+\f/THE CALL TO THE SUBROUTINE FOLLOWS BASICALLY THE
+/CALLING SEQUENCE FOR OS/8 DEVICE HANDLERS.
+/THE CALLING SEQUENCE IS:
+
+/      CDF CURRENT
+/      CIF MFIELD      /MFIELD=FIELD ASSEMBLED IN
+/      JMS ENTRY       /ENTRY=ORIGIN (EVEN NUMBERED DRIVE
+                       /AND ORIGIN+4 FOR ODD NUMBERED DRIVE.
+/      ARG1
+/      ARG2
+/      ARG3
+/      ERROR RETURN
+/      NORMAL RETURN
+
+/THE ARGUMENTS ARE:
+
+/ARG1: FUNCTION WORD   BIT0: 0=READ, 1=WRITE
+/                      BITS 1-5: # BLOCKS IN OPERATION
+/                      BITS 6-8: FIELD OF BUFFER AREA
+/                      BIT 9: UNUSED
+/                      BIT 10: # OF WORDS/BLOCK.
+/                      0= WDSBLK, 1=WDSBLK-1
+/                      BIT 11: 1=START FORWARD, 0=REVERSE
+
+/ARG2: BUFFER ADDRESS FOR OPERATION
+/ARG3: STARTING BLOCK FOR OPERATION
+
+/ERRORS: THE HANDLER DETECTS TWO TYPES OF ERRORS:
+/A) FATAL ERRORS- PARITY ERROR, TIMING ERROR,
+/              TOO GREAT A BLOCK NUMBER
+/      FATAL ERRORS TAKE ERROR RETURN WITH THE
+/      AC=4000.
+/B) NON-FATAL- SELECT ERROR.
+/      IF NO PROPER UNIT IS SELECTED, THE ERROR
+/      RETURN IS TAKEN WITH CLEAR AC.
+/FATAL ERRORS TRY THREE TIMES BEFORE TAKING ERROR RETURN.
+/THE NORMAL RETURN IS TAKEN AFTER ALL INDICATED
+/BLOCKS HAVE BEEN TRANSFERRED. THE AC IS CLEAR.
+
+/THE TD8E IOT'S ARE:
+       SDSS=7001-DRIVE /SKIP ON SINGLE LINE FLAG
+       SDST=7002-DRIVE /SKIP ON TIMING ERROR
+       SDSQ=7003-DRIVE /SKIP ON QUAD LINE FLAG
+       SDLC=7004-DRIVE /LOAD COMMAND REGISTER
+       SDLD=7005-DRIVE /LOAD DATA REGISTER
+       SDRC=7006-DRIVE /READ COMMAND REGISTER
+       SDRD=7007-DRIVE /READ DATA REGISTER
+
+/THE IOT'S IN GENERAL ARE 677X,676X,675X,AND 674X.
+/THE OTHERS CONTROL UNITS 2-7.
+\f      INITLN=7        /LENGTH OF TDINIT INCLUDING BLOCK 0 IMAGE (IN BLOCKS)
+       CTRLO=20
+       INCHAR=21
+       TEMPA=22
+
+ST,    CLA             /IN CASE CHAINED TO
+       JMP I (CREATE   /CREATE BLOCK 0  -IN HOUSE ONLY -
+STARTUP,JMS I (DTA0    /TD8E S.R. IS IN 200 NOW
+       603             /READ 3 BLOCKS INTO 1000-2377
+       1000
+       24              /GET REST OF INIT
+       JMP FERR        /REALLY BAD!
+       TAD (SKP CLA
+       DCA ST          /ALLOWS HIM TO RESTART AT 200
+RE,    JMS MSG
+       VNO
+       JMS I (CHKCOR   /USE ROM OR 12K SYSTEM
+       JMS MSG
+       INIT
+       JMS I (MOVSYS
+       JMS MSG
+       SWTCH
+       JMS TTY         /PAUSE
+       TAD INCHAR
+       TAD (-32
+       SNA CLA
+       JMP I (ZERO     /HE TYPED ^Z
+CPY,   JMS MSG
+       COPY
+       TAD (160
+       DCA B1
+       TAD (160
+       DCA B2
+RD,    JMS I (DTA0
+       3612
+       0
+B1,    0
+       JMS I (ER1
+       JMS I (DTA1
+       7612
+       0
+B2,    0
+       JMS I (ER1
+       TAD B1
+       TAD (36
+       DCA B1
+       TAD B1
+       DCA B2
+       TAD B1          /COPY OVER ABOVE 2700
+       TAD (-2600      /***
+       SPA CLA
+       JMP RD          /KEEP GOING
+       JMS I (DTA0     /COPY DIRECTORY
+       1412
+       0
+       2
+       JMS I (ER1
+       JMS I (DTA1
+       5412
+       0
+       2
+       JMS I (ER1
+RESTRT,        JMS MSG
+       DISMNT          /SETUP TAPES FOR INIT
+       JMS TTY
+       JMP I (BOOT
+\fTTY,  0
+       JMS MSG
+       STRIKE
+       KCC
+       KSF
+       JMP .-1
+       KRB
+       AND (177
+       DCA INCHAR
+       JMP I TTY
+
+MSG,   0               /MESSAGE TYPER
+       DCA CTRLO
+       JMS I (CRLF
+       TAD I MSG
+       DCA TEMPA
+       ISZ MSG
+WTMSG, TAD I TEMPA
+       CLL RTR;RTR;RTR
+       JMS PNCH
+       TAD I TEMPA
+       JMS PNCH
+       ISZ TEMPA
+       JMP WTMSG
+
+PNCH,  0
+       AND (77
+       SNA             /IGNORE NULL. _ MEANS CR/LF
+       JMP I PNCH      /? MEANS TERMINATE
+       TAD (-37        /IS IT _?
+       SNA
+       JMS I (CRLF     /YES
+       TAD (-40        /MAYBE ?
+       SNA
+       JMP I MSG
+       TAD (40
+       SPA
+       TAD (100
+       TAD (237
+       JMS I (TTYOUT
+       JMP I PNCH
+\fFERR, HLT
+       CLA
+       JMP STARTUP
+       PAGE
+\f/     THIS HANDLER USES DECTAPE BLOCKS NOT OS/8 BLOCKS !
+
+       *ORIGIN
+
+DTA0,  0               /ENTRY POINT FROM UNIT 0
+       CLA CLL         /0 TO LINK
+       JMP DTA1X
+C1000, 1000
+BLOCK,
+DTA1,  0               /UNIT 2 ENTRY
+       CLA CLL CML     /1 TO LINK
+       TAD DTA1
+       DCA DTA0        /PICK UP ARGS AT DTA0
+DTA1X, RAR
+       DCA UNIT        /LINK TO UNIT POSITION
+       RDF
+       TAD C6203       /GET DATA FIELD AND SETUP RETURN
+       DCA LEAVE
+       TAD I DTA0      /GET FUNCTION WORD
+       SDLD            /PUT FUNCTION INTO DATA REGISTER
+       CLL RTR         /AC STILL HAS FUNCTION. PUT # WORDS PER
+                       /BLOCK INTO LINK
+       SZL CLA         /KNOCK ONE OFF WDSBLK?
+       IAC             /YES
+       TAD MWORDS
+       DCA WCOUNT      /STORE MASTER WORD COUNT
+       ISZ DTA0        /TO BUFFER
+       TAD I DTA0
+       DCA BUFF
+       ISZ DTA0        /TO BLOCK NUMBER
+       TAD I DTA0
+       DCA BLOCK
+       ISZ DTA0        /POINT TO ERROR EXIT
+       CIF CDF MFIELD  /TO ROUTINES DATA FIELD
+       SDRD            /GET FUNCTION INTO AC
+       CLL RAL
+       AND CM200       /GET # PAGES TO XFER
+       DCA PGCT
+       SDRD
+C374,  AND C70         /GET FIELD FOR XFER
+       TAD C6203       /FORM CDF N
+       DCA XFIELD      /IF=0 AND DF=N AT XFER.
+       CLA CLL CMA RTL
+       DCA TRYCNT      /3 ERROR TRIES
+       TAD UNIT        /TEST FOR SELECT ERROR
+       SDLC
+       SDRC
+       AND C100
+       SZA CLA
+       JMP FATAL-1
+       SDRD            /PUT FUNCT INTO XFUNCT IN SECOND PG.
+       DCA I CXFUN
+       TAD WCOUNT
+       DCA I CXWCT
+       SDRD            /GET MOTION BIT TO LINK
+       CLL RAR
+       JMP GO          /AND START THE MOTION.
+RWCOM, SDST            /ANY CHECKSUM ERRORS?
+       SZA CLA         /OR CHECKSUM ERRORS?
+       JMP TRY3        /PLEASE NOTE THAT THE LINK IS ALWAYS
+                       /SET AT RWCOM. GETCHK SETS IT.
+       TAD PGCT        /NO ERROR..FINISHED XFER?
+       TAD CM200
+       SNA
+       JMP EXIT        /ALL DONE. GET OUT
+       DCA PGCT        /NEW PAGE COUNT
+       ISZ BLOCK       /NEXT BLOCK TO XFER
+       TAD WCOUNT      /FORM NEXT BUFFER ADDRESS
+       CIA
+       TAD BUFF
+       DCA BUFF
+       CLL CML         /FORCES MOTION FORWARD
+GO,    CLA CML RTR     /LINK BECOMES MOTION BIT
+       TAD C1000
+       TAD UNIT        /PUT IN 'GO' AND UNIT #
+       SDLC            /LOOK FOR BLOCK NO.
+       JMS I CRDQUD    /WAIT AT LEAST 6 LINES TO LOOK
+       JMS I CRDQUD
+CM200, 7600            /COULD HAVE SAVED A LOC. HERE
+SRCH,  SDSS
+       JMP .-1         /WAIT FOR SINGLE LINE FLAG
+       SDRC
+       CLL RTL         /DIRECTION TO LINK. INFO BITS 
+                       /ARE SHIFTED.
+       AND C374        /ISOLATE MARK TRACK BITS
+       TAD M110        /IS IT END ZONE?
+       SNA             /THE LINK STAYS SAME THRU THIS
+       JMP ENDZ
+       TAD M20         /CHECK FOR BLOCK MARK
+       SZA CLA
+       JMP SRCH
+       SDRD            /GET THE BLOCK NUMBER
+       SZL             /IF WE ARE IN REVERSE, LOOK FOR 3
+                       /BLOCKS BEFORE TARGET BLOCK. THIS
+                       /ALLOWS TURNAROUND AND UP TO SPEED.
+       TAD C3          /REVERSE
+       CMA
+       TAD BLOCK
+       CMA             /IS IT RIGHT BLOCK?
+       SNA
+       JMP FOUND       /YES..HOORAY!
+M110,  SZL SNA CLA     /NO, BUT ARE WE HEADED FOR IT?
+                       /ABOVE SNA IS SUPERFLUOUS.
+       JMP SRCH        /YES
+ENDZ,  SDRC            /WE ARE IN THE END ZONE
+       CLL RTL         /DIRECTION TO LINK
+       CLA             /ARE WE IN REVERSE?
+       JMP GO          /YES..TURN US AROUND
+/IF WE ARE IN THE END ZONE GOING FORWARD, IT IS AN ERROR
+TRY3,  CLA
+       ISZ TRYCNT
+       JMP GO          /TRY 3 TIMES
+       JMP FATAL               /LINK OFF MEANS AC=4000 ON RETURN
+EXIT,  ISZ DTA0
+       CLL CML         /AC=0 ON NORMAL RETURN
+FATAL, TAD UNIT
+       SDLC            /STOP THE UNIT
+       CLA CML RAR
+LEAVE, HLT
+       JMP I DTA0
+
+\fC6203,        6203
+CRDQUD,        RDQUAD
+WCOUNT,        0
+BUFF,  0
+MWORDS,        -WDSBLK
+UNIT,  0
+CXFUN, XFUNCT
+M20,   -20
+PGCT,  0
+CXWCT, XWCT
+C100,  100
+TRYCNT,        -3
+
+
+       *ORIGIN+170
+FOUND, SZL CLA         /RIGHT BLOCK. HOW ABOUT DIRECTION?
+       JMP GO          /WRONG..TURN AROUND
+       TAD UNIT        /PUT UNIT INTO LINK
+       CLL RAL         /AC IS NOW 0
+C70,   70              /********DON'T MOVE THIS!!!!******
+C3,    3
+       TAD BUFF        /GET BUFFER ADDRESS
+XFIELD,        HLT             /INTO NEXT PAGE
+\f      *ORIGIN+200
+       CIF MFIELD
+       DCA XBUFF       /SAVE ADDRESS
+       RAR             /NOW GET UNIT #
+       DCA XUNIT
+       SDRC
+       SDLC
+REVGRD,        SDSS
+       JMP .-1         /LOOK FOR REVERSE GUARD
+       SDRC
+       AND K77
+       TAD CM32        /IS IT REVERSE GUARD?
+       SZA CLA
+       JMP REVGRD      /NO.KEEP LOOKING
+       TAD XWCT
+       DCA WORDS       /WORD COUNTER
+       TAD XFUNCT      /GET FUNCTION  READ OR WRITE
+K7700, SMA CLA
+       JMP READ        /NEG. IS WRITE
+WRITE, SDRC
+       AND C300        /CHECK FOR WRITE LOCK AND SELECT ERROR
+       CLL CML         /LOCK OUT AND SELECT ARE AC 0 ERRORS
+       SZA CLA
+       JMP I CFATAL    /FATAL ERROR. LINK MUST BE ON
+       JMS RDQUAD      /NO ONE EVER USES THIS WORD!
+C7600, 7600
+       TAD C1400
+       TAD XUNIT       /INITIATE WRITE MODE
+       SDLC
+       CLA CMA
+       JMS WRQUAD      /PUT 77 IN REVERSE CHECKSUM
+       CLA CMA
+       DCA CHKSUM
+WRLP,  TAD I XBUFF     /GLORY BE! THE ACTUAL WRITE!
+       JMS WRQUAD
+       ISZ XBUFF       /BUMP CORE POINTER
+K77,   77              /ABOVE MAY SKIP
+       ISZ WORDS       /DONE THIS BLOCK?
+       JMP WRLP        /NOT YET..LOOP A WHILE
+       TAD XFUNCT      /IS THE OPERATION FOR WDSBLK PER BLOCK?
+       CLL RTR         /IF NO, WRITE A 0 WORD
+       SZL CLA
+       JMS WRQUAD      /WRITE A WORD OF 0
+       JMS GETCHK      /DO THE CHECK SUM
+       JMS WRQUAD      /WRITE FORWARD CHECKSUM
+       JMS WRQUAD      /ALLOW CHECKSUM TO BE WRITTEN
+       JMP I CRWCOM
+\fREAD, JMS RDQUAD
+       JMS RDQUAD
+       JMS RDQUAD      /SKIP CONTROL WORDS
+       AND K77
+       TAD K7700       /TACK 7700 ONTO CHECKSUM.
+       DCA CHKSUM      /CHECKSUM ONLY LOW 6 BITS ANYWAY
+RDLP,  JMS RDQUAD
+       JMS EQUFUN      /COMPUT CHECKSUM AS WE GO
+       DCA I XBUFF     /IT GETS CONDENSED LATER
+       ISZ XBUFF
+C300,  300             /PROTECTION
+       ISZ WORDS       /DONE THIS OP?
+       JMP RDLP        /NO SUCH LUCK
+       TAD XFUNCT      /IF OP WAS FOR WDSBLK-1, READ AND
+       CLL RTR         /CHECKSUM THE LAST TAPE WORD
+       SNL CLA
+       JMP RDLP2
+       JMS RDQUAD      /NOT NEEDED FOR WDSBLK/BLOCK
+       JMS EQUFUN      /CHECKSUM IT
+RDLP2, JMS RDQUAD      /READ CHECKSUM
+       AND K7700
+       JMS EQUFUN
+       JMS GETCHK      /GET SIX BIT CHECKSUM
+       JMP I CRWCOM
+
+WRQUAD,        0               /WRITE OUT A 12 BIT WORD
+       JMS EQUFUN      /ADD THIS TO CHECKSUM
+       SDSQ            /SKIP ON QUADLINE FLAG
+       JMP .-1
+       SDLD            /LOAD DATA  ONTO BUS
+       CLA             /SDLD DOESN'T CLEAR AC
+       JMP I WRQUAD
+
+RDQUAD,        0               /READ A 12 BIT WORD
+       SDSQ
+       JMP .-1
+       SDRD            /READ DATA
+       JMP I RDQUAD
+
+\fXUNIT,
+EQUFUN,        0               /COMPUTE EQUIVALENCE CHECKSUM
+       CMA
+       DCA EQUTMP      /ACTUALLY CHECKSUMS ON DECTAPE ARE
+       TAD EQUTMP      /EQUIVALENCE OF ALL WORDS IN A RECORD
+       AND CHKSUM      /SIX BITS AT A TIME. BUT SINCE EQUIVALENCE
+       CIA             /IS ASSOCIATIVE, WE CAN DO IT 12
+       CLL RAL         /BITS AT A TIME AND CONDENSE LATER.
+       TAD EQUTMP      /THIS ROUTINE USES THESE IDENTITIES:
+       TAD CHKSUM      /A+B=(A.XOR.B)+2*(A.AND.B)
+       DCA CHKSUM      /A.EQU.B=.NOT.(A.XOR.B)=A.XOR.(.NOT.B)
+       TAD EQUTMP      /A.EQU.B=(A+(.NOT.B))-2*(A.AND.(.NOT.B))
+       CMA
+       JMP I EQUFUN
+
+GETCHK,        0               /FORM 6 BIT CHECKSUM
+       CLA
+       TAD CHKSUM      
+       CMA
+       CLL RTL
+       RTL
+       RTL
+       JMS EQUFUN
+       CLA CLL CML     /FORCES LINK ON AT RWCOM
+       TAD CHKSUM
+       AND K7700
+       JMP I GETCHK
+
+CFATAL,        FATAL
+CRWCOM,        RWCOM
+XFUNCT,        0
+CM32,  -32
+C1400, 1400
+CHKSUM,        0
+WORDS, 0
+XBUFF, 0
+XWCT,  0
+EQUTMP,        0
+\fTBL,  CPY
+       ZER
+       LVAL
+       PAGE
+\fCREATE,       JMS I (MSG
+       WRITOUT
+       JMS I (TTY
+       JMS I (DTA1
+       4202
+       7400
+       0
+       JMS ER1
+       JMS I (MSG
+       OK
+       HLT
+       JMP I (7605
+       ROMSW=17
+
+/THIS ROUTINE COPIES THE SYSTEM ONTO UNIT 1.
+/IT COPIES FROM A SYSTEM HEAD FILE ON TAPE ON UNIT 0.
+/UNIT 0 MUST BE THE OS/8 BINARIES TAPE
+/1ST FILE: TDINIT.PA
+/2ND FILE: TDROM.SY
+/3RD FILE: TD12K.SY
+
+MOVSYS,        0
+       JMS I (TTY
+       TAD ROMSW       /GET ADDRESS OF START OF SYSTEM HEAD
+       SNA CLA
+       TAD (62^2       /12 K
+       TAD (7+INITLN^2 /ROM
+       DCA HEAD
+       JMS I (DTA0     /READ PAGE 0
+       212
+       0
+HEAD,  HLT
+       JMS ER1
+       CDF 10
+       TAD I (200
+       CDF 0
+       TAD (-4207      /CHECK FOR GOOD SYSTEM HEAD
+       SZA CLA
+       JMP WRGSYS
+       JMS I (DTA1
+       4212
+       0
+       0
+       JMS ER1
+       STL CLA RTL     /2
+       TAD HEAD
+       DCA KBM
+       JMS I (DTA0
+       0012            /READ 40 SYSTEM BLOCKS 7-26 (PAGES 16-55)
+       0
+KBM,   HLT
+       JMS ER1
+       JMS I (DTA1
+       4012
+       0
+       7^2             /WRITE KBM ETC
+       JMS ER1
+       TAD HEAD
+       TAD (43^2
+       DCA CD
+       JMS I (DTA0
+       3613            /READ 51-67 (PAGES 122-157)
+       0
+CD,    HLT
+       JMS ER1
+       JMS I (DTA1
+       7613
+       0
+       43+6^2
+       JMS ER1
+       JMP I MOVSYS
+\fWRGSYS,       JMS I (MSG
+       WRONG
+       JMS I (TTY
+       JMP I (CPY
+
+ER1,   0
+       CLA
+       JMS I (MSG
+       IOERR
+       JMS I (TTY
+       TAD I (INCHAR
+       TAD (-101
+       SNA CLA         /A?
+       JMP I (RE       /YES, ABORT
+       TAD ER1
+       TAD (-5
+       DCA ER1         /BACK UP, POINT TO CALL
+       JMP I ER1       /RETRY
+
+CRLF,  0
+       TAD (215
+       JMS TTYOUT
+       TAD (212
+       JMS TTYOUT
+       JMP I CRLF
+
+TTYOUT,        0
+       DCA TM
+       JMS I (TSTKBD
+       TAD CTRLO
+       SZA CLA
+       JMP I TTYOUT
+       TAD TM
+       TLS
+       TSF
+       JMP .-1
+       CLA
+       JMP I TTYOUT
+\fTM,   0
+       PAGE
+\fCHKCOR,       0               /DETERMINE CONFIGURATION
+       CDF 70          /CHECK FOR ROM
+       TAD I (7503
+       TAD (-SDSS
+       SZA CLA
+       JMP TRY12K
+       CDF 0
+       JMS I (MSG
+       ROM8K
+       CLA IAC
+ENTR12,        DCA ROMSW       /SET INDICATOR
+       CDF 0
+       JMP I CHKCOR
+TRY12K,        CDF 20
+       TAD ENTR12
+       DCA I (7600
+       TAD I (7600
+       CIA
+       TAD ENTR12
+       CDF 0
+       SNA CLA
+       JMP OK12
+       JMS I (MSG
+       HRDWR           /NO HARDWARE AROUND!
+       HLT
+       JMP .-1
+OK12,  JMS I (MSG
+       TD8E12
+       JMP ENTR12
+\fIN,   0
+
+ZERO,  JMS I (MSG
+       SPECIAL
+       JMS I (TTY
+       TAD INCHAR
+       TAD (-62
+       DCA IN
+       TAD IN
+       SPA
+       CIA
+       CLL RAR         /ALLOW ONLY -1, 0, 1
+       SZA CLA
+       JMP ZERO+1
+       TAD IN
+       TAD (TBL+1
+       DCA IN
+       TAD I IN
+       DCA IN
+       JMP I IN        /JUMP TO APPROPRIATE ROUTINE
+
+ZER,   JMS I (MSG
+       ZERY
+       JMS I (DTA1
+       4202
+       MTDIR
+       2
+       JMS I (ER1
+       JMP I (RESTRT
+
+LVAL,  JMS I (MSG
+       PRES
+       JMP I (RESTRT
+\fMTDIR,        -1
+       70              /SYSTEM TAPE
+       0
+       0
+       -1              /1 EMPTY FILE
+       0
+       6437+70         /-LENGTH OF DECTAPE
+
+BOOT,  TAD ROMSW
+       SNA CLA
+       JMP TDBOOT
+       JMS I (DTA0     /ROM BOOT
+       202
+       7400
+       0               /READ IN BLOCK 0
+       JMS I (ER1
+       TAD (CDF 10
+       JMS MOVE
+       7400
+       JMP I (7605
+
+TDBOOT,        JMS I (DTA0
+       202
+       7400
+       0
+       JMS I (ER1
+       JMS I (DTA0
+       202
+       7000
+       66^2
+       JMS I (ER1
+       TAD (CDF 10
+       JMS MOVE
+       7000
+       TAD (CDF 20
+       JMS MOVE
+       7200
+       JMP I (7605
+\f      XRIN=11
+       XROUT=12
+
+MOVE,  0
+       DCA MOVCDF
+       STA
+       TAD I MOVE
+       DCA XRIN
+       TAD (-200       /MOVE 200 WORDS TO LOCATION 7600
+       DCA MVCNT
+       ISZ MOVE
+       TAD (7577
+       DCA XROUT
+MOVLUP,        TAD I XRIN
+MOVCDF,        HLT
+       DCA I XROUT
+       CDF 0
+       ISZ MVCNT
+       JMP MOVLUP
+       JMP I MOVE
+
+MVCNT, -200
+       PAGE
+\fVNO,  TEXT    /TD8E INITIALIZER PROGRAM VERSION 7A ?/
+INIT,  TEXT /MOUNT A CERTIFIED DECTAPE ON UNIT 1 WRITE-ENABLED_/
+       TEXT    /ALWAYS KEEP ORIGINAL SYSTEM DECTAPES WRITE-LOCKED?/
+STRIKE,        TEXT /STRIKE A CHARACTER TO CONTINUE?/
+DISMNT,        TEXT /REMOVE AND SAVE TAPE ON UNIT 0_/
+       TEXT    /TAKE NEW TAPE (ON UNIT 1) WHICH WAS JUST CREATED_/
+       TEXT    /AND PLACE IT ON UNIT 0_/
+       TEXT    \IT IS YOUR NEW OS/8 SYSTEM TAPE?\
+SWTCH, TEXT    /DISMOUNT SYSTEM TAPE #2 FROM UNIT 0 AND SAVE IT_/
+       TEXT    /MOUNT ORIGINAL SYSTEM TAPE #1 ON UNIT 0_/
+       TEXT    /PREPARE TO COPY FILES OVER?/
+OK,    TEXT    /OK?/
+WRITOUT,TEXT   /READY TO CREATE BLOCK 0 OF UNIT 1?/
+COPY,  TEXT    /COPYING FILES FROM UNIT 0 TO UNIT 1?/
+ZERY,  TEXT    /ZEROING DIRECTORY ON TAPE UNIT 1?/
+PRES,  TEXT    /DIRECTORY ON UNIT 1 PRESERVED?/
+WRONG, TEXT /NOT ORIGINAL OS8 SYSTEM TAPE #2_/
+       TEXT    /MOUNT CORRECT TAPE ON UNIT 0?/
+ROM8K, TEXT /8K ROM SYSTEM?/
+TD8E12,        TEXT /12K SYSTEM?/
+HRDWR, TEXT /NEED ROM OR 12K?/
+IOERR, TEXT /FATAL IO ERR_/
+       TEXT    /TYPE A TO ABORT AND START OVER AGAIN_/
+       TEXT    \TYPE ANY OTHER CHARACTER TO RETRY THIS I/O OPERATION?\
+SPECIAL,TEXT   /TYPE 1 TO COPY FILES FROM UNIT 0 TO UNIT 1_/
+       TEXT    /TYPE 2 TO ZERO THE DIRECTORY OF UNIT 1_/
+       TEXT    /TYPE 3 TO LEAVE THE DIRECTORY OF UNIT 1 ALONE?/
+\fTSTKBD,       0
+       KSF
+       JMP I TSTKBD
+       KRS
+       AND (177
+       TAD (-3
+       SNA
+       JMP I (RE       /^C
+       TAD (3-17
+       SZA CLA
+       JMP NO
+       CLA IAC
+       DCA CTRLO
+NO,    KCC
+       JMP I TSTKBD
+       PAGE
+\f/TD8E SYSTEM INITIALIZER
+/THIS CODE IS PLACED ON THE BINARY TAPE
+/IN RECORD 0. WHEN THE 7470 OR STANDARD TD8E BOOTSTRAP
+/IS EXECUTED, THIS PROGRAM READS THE REST OF THE INIT
+/SYSTEM FROM THE FIRST FILE ON THE TAPE, AND
+/STARTR EXECUTION OF IT. A SHORT PROGRAM IS HERE
+/INCLUDED TO WRITE RECORD 0 ON THE TAPE. THE START ADDRESS
+/OF THAT CODE IS 200.
+
+SDSS=6771
+SDST=6772
+SDSQ=6773
+SDLC=6774
+SDLD=6775
+SDRC=6776
+SDRD=6777
+       *7420
+       NOPUNCH
+       *7400
+       ENPUNCH
+       TAD K177        /INIT FOR TAPE READ
+       DCA 10
+NUBLK, TAD KM200       /SET BLOCK WORD COUNT
+       DCA WCNT
+NOT,   JMS GET         /GET BLOCK # FORWARD
+       -26
+       SDRD            /THE RIGHT ONE?
+       AND KK77
+       TAD BLOCKK
+       SZA CLA
+       JMP NOT         /I GUESS NOT
+       JMS GET         /RIGHT. NOW GET REV. GUARD
+       -32
+       JMS RQD
+       JMS RQD
+       JMS RQD
+LP,    JMS RQD
+       DCA I 10        /READ THE INIT PROGRAM
+       ISZ WCNT
+       JMP LP
+       ISZ BCNT        /DONE ALL BLOCKS?
+       JMP CONT
+       SDLC
+       JMP I .+1
+       STARTUP
+CONT,  CLA CMA         /SET FOR NEXT BLOCK
+       TAD BLOCKK
+       DCA BLOCKK
+       JMP NUBLK
+
+RQD,   0
+       SDSQ
+       JMP .-1
+       SDRD
+       JMP I RQD
+\fGET,  0               /PICK UP A SPECIFIED TAPE FRAME
+       TAD I GET       /HOLDS 6 BIT MARK TRACK I.D.
+       DCA RQD
+GTIT,  SDSS
+       JMP .-1
+       SDRC            /FLAG IS UP. READ MARK TRACK
+       AND KK77
+       TAD RQD         /A MATCH?
+       SZA CLA
+       JMP GTIT
+       ISZ GET
+       JMP I GET
+
+KK77,  77
+KM200, -200
+BLOCKK,        -21             /SKIP CORE CONTROL BLOCK AND PAGE 0
+WCNT,  -200
+K177,  177
+BCNT,  -3
+       *200
+       $
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/TM8E.PA b/sw/os8/v3d/sources/system/dectapes/dectape3/TM8E.PA
new file mode 100644 (file)
index 0000000..b42ccdd
--- /dev/null
@@ -0,0 +1,413 @@
+/16 TM8-E MAGTAPE HANDLER FOR OS/8
+
+
+
+
+
+
+
+
+
+
+/
+/
+/COPYRIGHT (C) 1973,1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT  TO CHANGE  WITHOUT NOTICE
+/AND  SHOULD  NOT  BE CONTRUED  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.
+/
+/
+/
+/
+/
+\f      LWCR=6701       /LOAD WORD COUNT REGISTER AND CLEAR AC
+       LCAR=6703       /LOAD CURRENT ADDRESS REGISTER AND CLEAR AC
+       LCMR=6705       /LOAD COMMAND REGISTER AND CLEAR AC
+       LFGR=6706       /LOAD FUNCTION REGISTER AND CLEAR AC
+       CLT=6712        /CLEAR TRANSPORT
+       RMSR=6714       /CLEAR AC AND READ MAIN STATUS REGISTER
+       RFSR=6716       /CLEAR AC AND READ STUFF
+       SKEF=6721       /SKIP IF ERROR FLAG IS SET
+       SKJD=6723       /SKIP IF THE JOB IS DONE (MTTF IS SET)
+       SKTR=6724       /SKIP IF TAPE UNIT READY (TUR TRUE)
+
+       MTAVERSION="F&77
+
+/SPECIAL CODES USED WHEN PAGE COUNT=0 (CODES IN BITS 9-11 OF FN WORD)
+
+/0     (CLOSE) WRITE 2 EOF'S
+/1     REWIND
+/2     SPACE FORWARD/REVERSE RECORDS
+/      IF BIT 0 OF THE FUNCTION WORD IS A 0,
+/              THIS CODE ADVANCES RECORDS.
+/              THE NEGATIVE OF THE NUMBER OF RECODRDS IS SPECIFIED IN ARG 3
+/      IF BIT 0 OF THE FUNCTION WORD IS A 1,
+/              THIS CODE BACKSPACES RECORDS.
+/              THE NEGATIVE OF THE NUMBER OF RECORDS IS SPECIFIED AS ARG 3.
+/      UNDER NO CIRCUMSTANCES DOES THIS COMMAND CONTINUE PAST A FILE MARK.
+/3     SPACE FORWARD/REVERSE FILES
+/      IF BIT 0 OF THE FUNCTION WORD IS A 0
+/              THEN THIS FUNCTION ADVANCE FILE MARKS
+/              THE NEGATIVE OF THE NUMBER OF FILE MARKS IS SPECIFIED BY ARG3
+/              THE TAPE IS LEFT POSITIONED AFTER THIS FILE MARK
+/              BUT UNDER NO CIRCUMSTANCES DOES THE TAPE ADVANCE PAST
+/              THE SECOND MARK OF TWO CONSECUTIVE FILE MARKS
+/      IF BIT 0 OF THE FUNCTION WORD IS A 1,
+/              THIS CODE BACKSPACES PAST FILE MARKS.
+/              THE NEGATIVE OF THE NUMBER OF FILE MARKS IS SPECIFIED BY ARG 3.
+/              THE TAPE IS LEFT POSITIONED BEFORE THE LAST FILE MARK,
+/              SO THE USER PROBABLY WANTS TO DO A FORWARD RECORD NEXT.
+/4     REWIND AND PUT OFF-LINE
+/5     WRITE EOF
+/6     PERFORM OPERATION WITH SPECIFIED BLOCKSIZE
+/      THE NEGATIVE OF THE DESIRED BLOCKSIZE IS SPECIFIED AS ARG 3.
+/7     CURRENTLY UNUSED
+
+/NOTE: SKIP TO EOD CAN BE PERFORMED BY SKIPPING 4096 FILES
+
+/MAINTENANCE RELEASE CHANGES:
+
+/1.    MAJOR CODE OVERHAUL
+/2.    SKIP RECORDS RETURNS NON-FATAL ERROR IF IT DETECTS FILE MARK
+/3.    SKIP FORWARD FILES NEVER EVER PASSES EOD
+/4.    SKIP FORWARD FILES RETURNS ERROR IF IT STARTS IMMEDIATELY
+/      BEFORE A FILE MARK (UNLESS IT'S AT BOT)
+/      IT THEN REMAINS BEFORE THE FILE MARK
+/5.    FIXED TIMING PROBLEM FOR TS03
+/6.    CHANGED ORDER OF TEST FOR DATA DURING SKIP FORWARD FILES
+/7.    MADE UNUSED FUNCTION CODE 7 ACT SAME AS 0
+\f
+/BUILD DESCRIPTOR BLOCK
+
+       *0
+
+       -10             /8 ENTRY POINTS
+
+DEVICE TM8E;DEVICE MTA0;200;MTA0&177+4000;ZBLOCK 2
+DEVICE TM8E;DEVICE MTA1;200;MTA1&177+4000;ZBLOCK 2
+DEVICE TM8E;DEVICE MTA2;200;MTA2&177+4000;ZBLOCK 2
+DEVICE TM8E;DEVICE MTA3;200;MTA3&177+4000;ZBLOCK 2
+DEVICE TM8E;DEVICE MTA4;200;MTA4&177+4000;ZBLOCK 2
+DEVICE TM8E;DEVICE MTA5;200;MTA5&177+4000;ZBLOCK 2
+DEVICE TM8E;DEVICE MTA6;200;MTA6&177+4000;ZBLOCK 2
+DEVICE TM8E;DEVICE MTA7;200;MTA7&177+4000;ZBLOCK 2
+\f      *200
+
+PARITY,        402             /CHANGE TO 2 TO HAVE EVEN PARITY
+BLOCK0,        0               /SET TO 1 TO INHIBIT REWIND ON BLOCK 0
+MTATAD,        TAD MTA0        /USED TO MAKE HANDLER SERIALLY REUSABLE
+                       /CONTENTS MUST BE 13XX [V3C]
+MTISZ, ISZ MTANO       /DITTO
+STOP,  ISZ MTHX
+MTEXIT,        HLT             /CIF CDF TO USER'S FIELD
+       JMP I MTHX
+
+PNEXT, 0
+/V3C   CLA
+       TAD MTANO       /GET UNIT #
+       CIA
+       TAD MTATAD      /FIND WHICH ENTRY POINT
+       DCA MTFUN       /MAKE A 'TAD MTAN' AND EXECUTE IT
+MTFUN, HLT
+       DCA MTHX        /COLLECT ARGUMENTS VIA 'MTHX'
+       CLA STL RTR     /2000
+       TAD MTFUN       /MAKE A 'DCA MTAN' AND EXECUTE IT
+       DCA NBLOK
+       TAD MTISZ       /RESTORE DESTROYED ISZ
+NBLOK, HLT
+       TAD I MTHX      /GET FUNCTION WORD
+       DCA MTFUN       /SAVE IT IN 'MTFUN'
+       ISZ MTHX        /POINT TO BUFFER ADDRESS
+       STA             /GET ONE LESS THAN
+       TAD I MTHX      /BUFFER ADDRESS
+       DCA NBUFF       /AND STORE AWAY
+       ISZ MTHX        /POINT TO BLOCK NUMBER
+       TAD I MTHX      /GET BLOCK NUMBER
+       DCA NBLOK       /STORE AWAY
+       ISZ MTHX        /POINT TO ERROR RETURN
+       RDF             /GET CALLING FIELD
+       TAD MTCDIF      /CREATE CIF CDF TO USER'S FIELD
+       DCA MTEXIT      /STORE AWAY WHERE WILL BE USEFUL LATER
+MTCDIF,        CIF CDF 0       /GO TO FIELD 0
+       TAD MTANO       /GET UNIT NUMBER
+       CLL RTR
+       RTR
+       DCA MTANO       /PUT IN BITS 0-2 OF 'MTANO'
+       TAD MTFUN       /RETRIEVE FUNCTION WORD
+       AND L70         /ISOLATE FIELD OF BUFFER
+       TAD PARITY      /SET ODD PARITY BITS, AND DENSITY 8 (800 BPI, 7-CHANNEL)
+       TAD MTANO       /COMBINE WITH UNIT NUMBER
+       DCA MTAWD       /TO GET A USEFUL MTA COMMAND
+       TAD MTFUN       /ZERO BUFFER FOR PIP ON EOF
+       AND L70         /FIELD OF ORIGIN
+       TAD MTCDF
+       DCA USRCDF
+USRCDF,
+MTANO, 0
+       DCA MTANO       /RESET 'MTANO' FOR NEXT CALL
+       TAD MTFUN
+       RAL
+       AND P7600       /GET # OF WORDS IN BUFFER
+       SNA SZL         /ZERO BUFFER IF READING
+       JMP P7600
+       CIA
+       DCA MTH
+       TAD NBUFF
+       DCA ERROR
+MCLRLP,        ISZ ERROR
+L100,  100
+       DCA I ERROR
+       ISZ MTH
+       JMP MCLRLP
+P7600, 7600
+MTCDF, CDF 0
+       TAD BLOCK0
+       SNA             /OPERATE IN MULTIPLE-FILE MODE?
+       TAD NBLOK       /RETRIEVE BLOCK
+       SZA CLA         /IS IT BLOCK 0?
+       JMP BIGBLK      /NO
+       TAD MTATAD      /YES, REWIND [CAN BE 13XX]
+       JMS MTH         /CALL MAGTAPE ROUTINE
+MTAWD, 1000            /CA IMMATERIAL
+M7603, -7603           /WC IMMATERIAL
+L70,   70              /NO REWIND ERRORS (THESE CAN'T OCCUR)
+BIGBLK,        TAD MTFUN
+       JMS I PNEXT     /GO READ OR WRITE NEXT PAGE
+NBUFF, 0               /ONE LESS THAN ADDRESS OF BUFFER
+                       /MUST BE AT LOC AFTER CALL TO NEXT
+\f/     MTH
+
+/SET UP WC AND CA REGISTERS, LOAD FUNCTION AND GO
+
+/CALLING SEQUENCE:
+
+/      TAD (FNWORD
+/      JMS MTH
+/      BUFFER ADDRESS-1
+/      -WORD COUNT
+/      MASK FOR UNACCEPTABLE ERROR CONDITIONS
+/      <NORMAL RETURN>
+
+/      TAKES HANDLER ERROR RETURN ON ERRORS.
+/      IF ERROR, AC HAS ERROR CODE FROM MAIN STATUS REGISTER
+/      AC IS POSITIVE IF E.O.F. READ
+
+MTH,   0               /MUST BE AT 2ND LOC AFTER CALL TO NEXT
+       DCA ERROR       /SAVE FUNCTION TEMPORARILY
+       SKTR            /V3C
+       JMP .-1         /FIX TIMING BUG
+       CLT             /CLEAR THE WORLD
+       TAD MTAWD
+       LCMR            /LOAD COMMAND REGISTER
+       TAD I MTH       /GET CURRENT ADDRESS
+       LCAR            /LOAD IT
+       ISZ MTH         /POINT TO WORD COUNT
+       TAD I MTH       /GET WORD COUNT (TWO'S COMPLEMENT THEREOF)
+       LWCR            /LOAD IT
+       ISZ MTH         /POINT TO ERROR MASK
+       TAD ERROR       /GET FUNCTION BACK
+       LFGR            /GO BABY GO
+       JMS ERROR       /CHECK FOR ERROR
+       SKJD            /THROUGH?
+       JMP .-2         /NO
+       JMS ERROR       /YES, ANY ERRORS?
+E1,    ISZ MTH         /AMAZING WE MADE IT (NO ERRORS)
+       JMP I MTH       /NORMAL RETURN
+
+       IFNZRO MTH-NBUFF-1 <MTHERR,XXX>
+\fERROR,        0
+       TAD P7600       /YES
+       KRS             /IS IT CTRL/C?
+       TAD M7603       /ALLOW PARITY TELETYPES
+       SNA CLA
+       KSF
+       JMP SIFE
+       CLT             /ABORT I/O
+       JMP I P7600     /RETURN TO OS/8 KEYBOARD MONITOR
+SIFE,  SKEF            /SKIP ON ERROR
+       JMP I ERROR     /RETURN, NO ERRORS
+       RMSR            /WHAT'S CAUSING THE ERROR?
+       AND I MTH       /IS IT A GOOD ONE? (USE ERROR MASK)
+       SNA CLA         /IS ERROR ACCEPTABLE?
+       JMP E1          /YES
+       RMSR            /NOT ACCEPTABLE
+       AND L100        /IS IT AN E.O.F.?
+       SNA             /IF SO, LEAVE BIT 0 CLEAR
+       RMSR
+       JMP MTEXIT      /AND LEAVE WITH STATUS IN AC
+
+       IFZERO .-367&4000 <PERR,ZZXX>
+\f      *366
+MTHX,  MTAVERSION
+MTA7,  ISZ MTANO
+MTA6,  ISZ MTANO
+MTA5,  ISZ MTANO
+MTA4,  ISZ MTANO
+MTA3,  ISZ MTANO
+MTA2,  ISZ MTANO
+MTA1,  ISZ MTANO
+MTA0,  ISZ MTANO
+       JMS PNEXT       /GET ADDRESS OF FIRST LOCATION ON NEXT PAGE
+       PAGE
+
+       IFNZRO PARITY-200 <PARERR,ZZZ>
+\f      *400
+
+NEXT,  0
+       DCA RECNO       /READ OR WRITE AND HOW MANY
+       TAD NEXT
+       TAD KSTOP
+       DCA NSTOP       /ADDRESS OF RETURN ROUTINES
+       TAD NEXT
+       TAD KBLOK
+       DCA WC
+       TAD I WC
+       DCA WC
+       TAD I NEXT
+       DCA BUFFER      /GET BUFFER ADDRESS - 1
+       ISZ NEXT        /POINT TO MTH
+       TAD (3677       /V3C
+       DCA ERFLAG      /DEFAULT IS REPORT ALL ERRORS EXCEPT EOF
+       TAD RECNO
+       CLL RAL         /LINK SPECIFIES READ OR WRITE
+       AND L7600       /-(# OF BLOCKS)^200
+       SNA
+       JMP ZERO        /0 PAGE COUNT!
+       DCA RECNO
+       SZL             /READ OR WRITE?
+       STL CLA RTR     /WRITE.   +2000 TO CONVERT READ CODE TO WRITE CODE
+       TAD L2100       /READ (OR WRITE) & GO
+       DCA TEMP        /SAVE THIS COMMAND
+       TAD L7600
+       DCA WC          /OS/8 USES 128 WORD BLOCKS
+       STA             /V3C
+       DCA ERFLAG      /NOW DEFAULT IS REPORT ALL ERRORS
+RL1,   TAD TEMP
+       JMS GO
+       TAD BUFFER      /NEXT 200 WORDS
+       TAD L200
+       DCA BUFFER
+       TAD RECNO       /ANY MORE?
+       TAD L7600
+       SNA
+       JMP I NSTOP     /NO, FINISH
+       DCA RECNO       /YES, LOOP
+       JMP RL1         /REJOIN PROCESSING
+
+KSTOP, STOP-NBUFF      /USED TO RELOCATE 'STOP'
+
+KBLOK, NBLOK-NBUFF
+\fFLAG, 0
+
+COUNT,
+TEMP,  0
+
+EFL2,  TAD L5100
+       JMS GO          /ALL THIS CODE IS NEW FOR V3C
+EFL1,  TAD L5100
+       JMP GOO         /V3C
+
+GO,    0
+       JMS I NEXT      /CALL MTH
+BUFFER,        HLT
+WC,    0
+ERFLAG,        -1
+       JMP I GO
+
+L5100, 5100
+RECNO, 0
+NSTOP, 0
+L7,    7
+L2100, 2100
+\fZERO, TAD RECNO       /RETRIEVE FN WORD (MUST PRESERVE LINK)
+       AND L7          /ISOLATE SPECIAL CODE
+       TAD PJUMP
+       DCA .+1
+FN,    HLT             /BRANCH THROUGH JUMP TABLE
+
+TABLE, JMP EFL2        /0      CLOSE.  WRITE TWO EOF'S
+       JMP REW         /1      REWIND
+       JMP SPACE       /2      SPACE FORWARD/REVERSE RECORDS
+       JMP SEOF        /3      SPACE FORWARD/REVERSE FILES
+       JMP UNLOAD      /4      REWIND AND OFF-LINE
+       JMP EFL1        /5      WRITE EOF
+       JMP SPEC        /6      READ OR WRITE WITH SPECIAL BLOCKSIZE
+PJUMP, JMP TABLE       /7      UNUSED  SAME AS 0
+
+SEOF,  RAR             /LINK ON MEANS REVERSE
+       RTR
+       DCA FN
+       TAD WC
+       DCA COUNT
+       STA
+       DCA WC
+       RMSR
+       AND (3000       /CHECK BOT BIT
+       SZA CLA         /SIMULATE DATA IF AT BOT (OR REWINDING)
+FILE,  CLA IAC
+FILE2, DCA FLAG
+       TAD FN
+       TAD L6100       /V3C FORWARD [OR BACKSPACE] A RECORD
+       JMS GO
+       RMSR
+       AND P100
+       SNA CLA         /SKIP IF FILE MARK FOUND
+       JMP FILE
+       TAD FN
+       TAD FLAG
+       SZA CLA         /WAS THERE ANY DATA?
+       JMP CONT        /V3C YES, CONTINUE
+                       /EITHER SAW DATA OR WAS GOING IN REVERSE
+       STL             /NO, BACKSPACE ONE RECORD
+SPACE, CLA CMA         /V3C DON'T TOUCH LINK
+       DCA ERFLAG      /ALL ERRORS ARE FATAL
+       RAR             /LINK ON MEANS REVERSE (READ BIT)
+       STL RAR
+       STL RAR
+UNLOAD,        TAD P100        /ADD IN 'GO' BIT
+GOO,   JMS GO
+       JMP I NSTOP
+
+CONT,  ISZ COUNT       /V3C
+       JMP FILE2       /CONTINUE?
+       JMP I NSTOP     /CHECK FOR EOD BEFORE COUNT
+
+/FLAG .NE.  0 MEANS SAW DATA
+\fL6100,        6100
+P100,  100
+L7600, 7600
+
+SPEC,  CLA CMA         /V3C DON'T TOUCH LINK
+       DCA ERFLAG      /ALL ERRORS ARE NOW FATAL
+       SZL             /LINK STILL CONTAINS READ/WRITE BIT
+       STL CLA RTR
+       TAD L2100       /V3C
+       JMP GOO         /V3C
+
+REW,   DCA ERFLAG      /NO REWIND ERRORS
+       TAD (1000       /V3C
+       JMP UNLOAD      /V3C
+L200,  200
+       PAGE
+       $
+\f\v
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/TRIG.SB b/sw/os8/v3d/sources/system/dectapes/dectape3/TRIG.SB
new file mode 100644 (file)
index 0000000..0b1dc3a
--- /dev/null
@@ -0,0 +1,247 @@
+/TRIGONOMETRY ROUTINES                         OS8 FORTRAN II LIBRARY
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/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 5 HAS PATCH FOR IMPROVED ACCURACY AT LARGE ARGS
+/      INSERTED NOP INSTRUCTIONS AT PATCH1 AND PATCH2/C. STOLZ
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/     VERSION 6A
+/      VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
+       ENTRY   SIN
+       ENTRY   COS
+       ENTRY   TAN
+
+QUAD,  0       /CONTAINS ONE LESS THAN THE QUADRANT OF THE ARGUMENT
+Y,     BLOCK   3       /TEMPORARY STORAGE FOR ARG
+       CPAGE   22
+COEF,  5476            /-2.39E-8       CONSTANTS FOR SIN
+       3246
+       2500            /2.7526E-6
+       1565
+       6134
+       5170            /-1.98409E-4
+       5646
+       4006
+       0026            /8.3333315E-3
+       1724
+       2104
+       2065            /-1.6666667E-1
+       5765
+       2525
+       2525            /1.0
+       2014
+       0000
+       0000
+       CPAGE   3
+HALFPI,        2016            /1.5707963
+       2207
+       7324
+       CPAGE   3
+QTRPI, 2006            /7.8539815E-1
+       2207
+       7324
+       CPAGE   25
+TOEF,  1724            /9.5168091E-3
+       6766
+       1440            /2.9005250E-3
+       1705
+       7413
+       2741            /2.4565090E-2
+       1736
+       2236
+       2720            /5.3374060E-2
+       1746
+       6517
+       3023            /1.3339240E-1
+       1764
+       2114
+       0042            /3.3333140E-1
+       1775
+       2525
+       1517            /1.0
+       2014
+       0000
+       0000
+TAN,   BLOCK   1
+       6
+       DCA     QUAD    /SET QUADRANT OFFSET SWITCH
+       TAD I   TAN     /PICK-UP CDF
+       DCA     TARG
+       INC     TAN#    /POINT TO NEXT WORD
+       TAD I   TAN     /PICK-UP ADDRESS
+       DCA     TARG#
+       INC     TAN#    /POINT TO RETURN
+       CALL    1,FAD   /GET ARG IN FP-ACC
+TARG,  ARG     0
+BAC,   TAD     ACH     /LOOK AT HIGH ORDER WORD
+       SPA CLA         /IF NEGATIVE
+       JMP     OVT     /GO OM
+       CALL    1,FSB   /OTHERWISE SUBTRACT
+       ARG     QTRPI   /PI/2
+       ISZ     QUAD    /AND INCREMENT QUADRANT COUNTER
+PATCH1,        NOP             /ALLOW FOR SKIP
+       JMP     BAC     /UNTIL ARG IS NEGATIVE
+OVT,   CALL    1,FAD   /ADD PI/2 TO ARG UNTIL IT IS IN 
+       ARG     QTRPI   /THE FIRST QUADRANT
+       CLA CMA
+       TAD     QUAD    /BUT KEEP TRACK OF WHICH QUADRANT IT WAS IN
+       DCA     QUAD
+       TAD     ACH     /GET HI ORDER WORD
+       SPA CLA
+       JMP     OVT     /IF NEGATIVE REPEAT
+       TAD     QUAD    /FIND OUT WHAT QUAD IT WAS IN
+       RTR     
+       SMA CLA
+       JMP     OM
+       CALL    0,CHS   /SUBTRACT FROM PI/2 IF QUAD 2 OR 4
+       CALL    1,FAD
+       ARG     QTRPI
+OM,    TAD     (7      /USE A 7 TERM SERIES
+       CPAGE   3
+       JMS     POL
+       TOEF            /ADRESS OF COEFICIENTS FOR THE SERIES
+       CLA CMA
+       TAD     QUAD
+       RTR
+       SZL CLA
+       JMP     OM3
+       CALL    1,STO
+       ARG     Y
+       TAD     (2014
+       DCA     ACH
+       CALL    1,FDV
+       ARG     Y
+OM3,   RETRN   TAN
+/      INTERNAL SUBROUTINE POL
+/
+/      COMPUTES N TERMS OF POLYNOMIAL 
+/      N IN AC ... X IN FLOATING AC
+/      COEFFICIENTS START IN LOCATION WHOSE ADDRESS FOLLOWS JMS TO POL
+/
+POL2,  BLOCK   1
+POL,   BLOCK   1
+       CIA
+       DCA     POL2
+       CALL    1,STO   /STORE ADJUSTED ARGUMENT
+       ARG     Y       /IN A TEMPORARY
+       CALL    1,FAD
+       ARG     Y       /RESTORE FP AC
+       CALL    1,FMP
+       ARG     Y       /SQUARE IT
+       CALL    1,STO
+       ARG     X
+       TAD I   POL
+       INC     POL
+ARG2,  DCA     ARG1#
+       CALL    1,FAD
+ARG1,  ARG     COEF    /     ADDRESS STORED HERE
+       ISZ     POL2
+       JMP     POL1
+       CALL    1,FMP   /MULTIPLY AGAIN TO COMPLETE SERIES
+       ARG     Y
+       TAD     QUAD
+       RTR
+       SNL CLA         /FIND OUT WHICH QUADRANT
+       JMP     POLEX
+       CALL    0,CHS   /IF IN QUADRANT 3 OR 4 SET NEGATIVE
+POLEX, JMP I   POL
+POL1,  CALL    1,FMP
+       ARG     X
+       TAD     ARG1#
+       TAD     (3
+       JMP     ARG2
+/
+X,     BLOCK   3       /TEMPORARY FOR POL
+/
+/
+/ 8K FORTRAN TRIGNOMETRY ROUTINES
+/
+/
+COS,   BLOCK   1
+       6
+       TAD     COS
+       DCA     SIN
+       TAD     COS#
+       DCA     SIN#    /IT NOW APPEARS THAT SIN WAS CALLED
+       CLA IAC         /WITH QUADRANT OFFSET BY ONE
+       JMP     COSE
+SIN,   BLOCK   1
+       6
+COSE,  DCA     QUAD    /SET QUADRANT OFFSET SWITCH
+       TAD I   SIN     /PICK-UP CDF
+       DCA     SARG
+       INC     SIN#    /POINT TO NEXT WORD
+       TAD I   SIN     /PICK-UP ADDRESS
+       DCA     SARG#
+       INC     SIN#    /POINT TO RETURN
+       CALL    1,FAD   /GET ARG IN FP-ACC
+SARG,  ARG     0
+BACK,  TAD     ACH     /LOOK AT HIGH ORDER WORD
+       SPA CLA         /IF NEGATIVE
+       JMP     OVR     /GO ON
+       CALL    1,FSB   /OTHERWISE SUBTRACT
+       ARG     HALFPI  /PI/2
+       ISZ     QUAD    /AND INCREMENT QUADRANT COUNTER
+PATCH2,        NOP             /ALLOW FOR SKIP
+       JMP     BACK    /UNTIL ARG IS NEGATIVE
+OVR,   CALL    1,FAD   /ADD PI/2 TO ARG UNTIL IT IS IN 
+       ARG     HALFPI  /THE FIRST QUADRANT
+       CLA CMA
+       TAD     QUAD    /BUT KEEP TRACK OF WHICH QUADRANT IT WAS IN
+       DCA     QUAD
+       TAD     ACH     /GET HI ORDER WORD
+       SPA CLA
+       JMP     OVR     /IF NEGATIVE REPEAT
+       TAD     QUAD    /FIND OUT WHAT QUAD IT WAS IN
+       RTR     
+       SMA CLA
+       JMP     ON
+       CALL    0,CHS   /SUBTRACT FROM PI/2 IF QUAD 2 OR 4
+       CALL    1,FAD
+       ARG     HALFPI
+ON,    TAD     (6      /USE A 6 TERM SERIES
+       CPAGE   3
+       JMS     POL
+       COEF            /ADRESS OF COEFICIENTS FOR THE SERIES
+       RETRN   SIN
+       END
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/UTILTY.SB b/sw/os8/v3d/sources/system/dectapes/dectape3/UTILTY.SB
new file mode 100644 (file)
index 0000000..4bded7a
--- /dev/null
@@ -0,0 +1,436 @@
+/UTILITY SUBROUTINE PACKAGE               OS8 FORTRAN II LIBRARY
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/UTILITY SUBROUTINE PACKAGE               OS8 FORTRAN II LIBRARY
+\f/     VERSION 10A (APRIL 28, 1977)
+/      VERSION NUMBER IS AVAILABLE AT ENTRY POINTS
+/
+       ENTRY   OPEN         /INITIALIZING AND FLAG SETTING ROUTINE
+       ENTRY   GENIO
+       ENTRY   EXIT            /EXIT TO DISK MONITOR SYSTEM
+       ENTRY   ERROR
+       ENTRY   CKIO    /USELESS ROUTINE
+       OPDEF   KRS     6034
+       OPDEF   KCC     6032
+       OPDEF TADI 1400
+       OPDEF DCAI 3400
+       OPDEF   JMSI    4400
+       OPDEF JMPI 5400
+/      CARD READER IOT'S
+       OPDEF   RCSE    6672
+       OPDEF   RCSP    6671
+       OPDEF   RCSF    6631
+       OPDEF   RCRA    6632
+/LINE PRINTER IOT'S
+       OPDEF   LLB     6666
+       OPDEF   LSF     6661
+
+       LAP
+
+U17,   17              /*** MUST BE FIRST LOC IN PAGE ***
+
+IOER,  1117
+       0522            /"IOER" ERROR
+GENIO, BLOCK   1
+       10                      /GENERAL INPUT/OUTPUT ROUTINE
+       DCA     7       /SAVE ENTRY AC
+GENLP, TAD     7
+       RTL
+       RTL
+       RAL
+U200,  AND     U17
+       TAD     JMPITB
+       DCA     DSPACH  /INDEX JUMP TABLE BY DEVICE NUMBER
+       TAD     U200
+       KRS
+       TAD     UM203
+       SNA CLA
+       KSF             /CHECK FOR ^C ON TELETYPE
+DSPACH,        NOP             /NO ^C - DISPATCH TO I/O ROUTINE
+       CALL    0,EXIT
+
+JMPITB,        JMPI    DEVTAB
+DEVTAB,        TTYOUT
+       HSPOUT
+       LPTOUT
+       GENOUT
+       TTYIN
+       HSRIN
+       CDRIN
+       GENIN
+       TTYFUJ          /FUDGE - SEE TELETYPE INPUT ROUTINE
+       IOERR
+       IOERR
+       IOERR
+       IOERR
+       IOERR
+       IOERR
+       IOERR
+
+HSPOUT,        PSF
+       JMP     GENLP
+       TAD     7
+       PLS
+GENRTN,        CLA
+       RETRN   GENIO
+
+TTYIN, KSF
+       JMP     GENLP
+       CLA CLL CML RTR /****DEPENDS ON NUMBER OF DEVICES ****
+       JMP     GENLP   /TEST FOR ^C ONE LAST TIME
+
+HSRIN, ISZ     T1
+       JMP     HSRSF
+       TAD     U336    /TIME OUT-PRINT '^'
+       TLS
+HLP,   KSF
+       JMP     HLP
+       AND     U200    /GET 200 INTO AC 
+       KRS             /READ THE CHAR.
+       TAD     UM203
+       SZA     CLA     /IS IT CONTROL C?
+       KCC             /NO-CLEAR FLAG
+       RFC             /USER TYPED-TICKLE RDR-FALL THRU RFC
+HSRSF, RSF
+       JMP     GENLP
+       DCA     T1
+       RRB RFC
+       JMP     GENRTN#
+U336,  336
+T1,    0
+
+UM203, -203
+PCDRGC,        CDRGCH          /USED TO FORCE DF=CURRENT WHEN NECESSARY
+CDR215,        215
+CDR100,        100
+CDR240,        240
+PCDRTB,        CDRTBL          /CONVERSION FROM CARD CODE TO ASCII-240
+CDRCT, 0
+CDRLEN,        0
+CDRIN, TAD     CDRCT
+       SNA CLA
+       JMP     CDRNXT  /NEW CARD NECESSARY
+       ISZ     CDRCT   /ADVANCE TO NEXT COLUMN
+       JMP     CDRGET
+       TAD     CDR215  /NO MORE - SEND A CARRIAGE RETURN
+       JMP     GENRTN#
+
+CDREST,        KSF
+       JMP     CDRTST
+       KCC
+CDRNXT,        RCSE
+       JMP     GENLP   /CHECK FOR ^C WHILE WAITING FOR NEXT CARD
+CDRTST,        RCSP
+       JMP     CDRCOL  /NOT END OF CARD YET
+       TAD     CDRCT   /END OF CARD - SET UP FOR EXTRACTION OF CHARS
+       CIA
+       DCA     CDRLEN
+CDRGET,        TAD     CDRCT
+       TAD     CDRLEN  /FORM CHAR POINTER INTO TABLE AT 10100
+       CLL RAR
+       TAD     CDR100
+       6211
+       JMSI    PCDRGCH /INDEX TABLE AND PULL OUT CHAR (DF=10)
+       TAD     CDR240  /CHANGE TO ASCII
+       JMP     GENRTN# /RETURN
+CDRCOL,        RCSF            /ANYTHING YET?
+       JMP     CDREST  /KEEP LOOKING
+       RCRA            /READ IT
+       CLL RAR
+       TAD     PCDRTB
+       JMS I   PCDRGC  /GET TABLE ENTRY, FORCING DATA FIELD CURRENT
+       DCA     CDRLEN  /SAVE IT TEMPORARILY
+       TAD     CDRCT
+       CIA
+       CLL RAR
+       TAD     CDR100  /INDEX TABLE AT LOC 10100
+       DCA     DSPACH
+       6211            /CDF 10
+       TAD     CDRLEN
+       SZL             /WHICH HALF?
+       JMP     CDNORT  /RIGHT HALF
+       RTL
+       RTL
+       RTL
+       SKP
+CDNORT,        TADI    DSPACH  /ADD EXISTING LEFT HALF
+       DCAI    DSPACH  /SAVE UPDATED ENTRY
+       CLA CMA
+       TAD     CDRCT
+       DCA     CDRCT   /UPDATE COLUMN POINTER
+       JMP     CDRCOL
+
+
+       PAGE
+\fU377, 377             /MUST BE FIRST LOC IN THIS PAGE
+GENIN, 6201
+       TADI    IHNDLR
+       SNA CLA         /OPEN INPUT FILE?
+       JMP     IOERR   /NO
+       6202
+       JMS I   FICHAR  /GET A CHAR
+       JMP     IOERR   /INPUT ERROR
+UU200, AND     U377
+GRTN2, RETRN   GENIO
+
+GENOUT,        6201
+       TADI    OHNDLR
+       SNA CLA         /OPEN OUTPUT FILE?
+       JMP     IOERR   /NO
+       6202
+       TAD     7       /GET CHAR TO BE OUTPUT
+       AND     U377
+       JMS I   FOCHAR  /PUT A CHARACTER
+       JMP     IOERR   /OUTPUT ERROR
+       JMP     GRTN2
+
+IHNDLR,        122             /***ALL THESE LOCATIONS ARE VERY VOLATILE!! ***
+FICHAR,        606             /*******
+OHNDLR,        121             /*******
+FOCHAR,        651             /******************
+
+/
+/      INITIALIZING SUBROUTINE CALLED BY FORTRAN
+/      CLEARS FLOATING AC AND SETS FLAGS
+/
+OPEN,  BLOCK   1
+       10
+       TAD     (212
+       TLS     /PUT LINE-FEED ON TTY
+       LLB     /INITIALIZE LPT
+       KCC     /CLEAR KEYBOARD FLAG (AND AC)
+       PLS
+       RFC
+       CALL    0,CLEAR
+       6201
+       DCAI    IHNDLR
+       DCAI    OHNDLR          /ZERO DEVICE-INDEPENDENT IO FLAGS
+       RETRN   OPEN
+
+
+LPTOUT,        LSF
+       JMP     GENLP
+       TAD     7
+       ISZ     PFSTCH
+       JMP     NOFST
+       TAD     (-1262  /LOOK FOR CONTROL CHARS IN PRINT POSITION 1
+       CLL IAC
+       IAC
+       SNL
+       JMP     DCACH
+       CLL RAL
+       TAD     (212
+NOFST, LLB
+       TAD     (-1212
+DCACH, SNA CLA         /IF LINE FEED
+       CMA             /SET "FIRST CHAR" SWITCH ON
+       DCA     PFSTCH
+       JMP     GRTN2
+PFSTCH,        -1
+
+TTYFUJ,        TAD     UU200
+       KRS
+       DCA     7       /SAVE KEYBOARD CHAR
+       KCC             /CLEAR FLAG
+       TAD     7
+       TAD     (-212
+       SZA CLA
+       JMS     TYPE
+       TAD     7
+       TAD     (-215
+       SZA CLA
+       JMP     TYRTN
+       CLA CLL CMA RTL
+       JMS     TYPE
+TYRTN, TAD     7
+       JMP     GRTN2   /RETURN WITH CHAR IN AC
+
+TYPE,  0
+       TAD     7
+TYPELP,        TSF
+       JMP     TYPELP
+       TLS
+       CLA
+       JMPI    TYPE
+
+TTYOUT,        JMS     TYPE
+       JMP     GRTN2
+
+IOERR, CALL    1,ERROR
+       ARG     IOER
+
+CDRTBL,        0021;2223;2425;2627
+       3031;3203;4007;3502
+       2017;6364;6566;6770
+       7172;7514;0577;3637
+       1552;5354;5556;5760
+       6162;0104;1211;3374
+       0641;4243;4445;4647
+       5051;7316;3410;1376
+
+       PAGE
+\f
+PMESG, MESG
+MESG,  7777
+       7777
+       4005
+       2222
+       1722
+       4001
+       2440
+       1417
+       0340
+LIT7,  0007
+
+ERROR, BLOCK   1
+       10                      /ERROR PROCESSOR
+U7600, 7600
+       TAD     ERROR
+       DCA     TEM1
+TEM1,  NOP             /SET DATA FIELD OF "CALL ERROR"
+       TADI    ERROR#
+       DCA     TEM3
+       INC     ERROR#
+E60,   CLA CMA CML     /CML IS WINDOW DRESSING
+       TADI    ERROR#
+       DCA     10
+       INC     ERROR#
+TEM3,  NOP             /DATA FIELD OF MESSAGE&ENTRY POINT
+       DCA     CKIO    /ZERO "FATAL ERROR" FLAG
+       TADI    10
+       RAL
+       SZL             /NON-FATAL BIT ON?
+       ISZ     CKIO    /YES - SET "FATAL FLAG" TO NON-FATAL
+       CLL RAR         /STRIP NON-FATAL BIT FROM MESSAGE
+       DCA     MESG
+       TADI    10      /SECOND WORD OF MESSAGE
+       DCA     MESG#
+       TADI    10
+       DCA     TEM1
+       TADI    10
+       DCA     TEM3    /CALLING ADDRESS
+       TAD     PMESG
+       DCA     TEM2
+
+ERLP,  TAD I   TEM2
+       RTR
+       RTR
+       RTR
+       JMS     PR6BIT
+       TAD I   TEM2
+       JMS     PR6BIT
+       INC     TEM2
+       JMP     ERLP
+
+PRLOC, TAD     TEM1
+       RTR
+       RTR
+       JMS     ERTTY   /PRINT CALLING FIELD
+       TAD     (-4
+       DCA     TEM2
+NUMLP, TAD     TEM3
+       RTL
+       RAL
+       DCA     TEM3
+       TAD     TEM3
+       JMS     ERTTY
+       ISZ     TEM2
+       JMP     NUMLP
+       TAD     (215
+       DCA     7
+       JMS     TYPE
+       CLA CLL CMA RTL
+       JMS     TYPE
+       TAD     CKIO    /GET THE FATAL ERROR FLAG
+       SNA CLA         /WHADDOWEDO??
+       JMP     EXITX
+       RETRN   ERROR   /HE SAYS ITS NON-FATAL - LET HIM HANDLE IT
+
+ERTTY, 0       /DIGIT PRINTING ROUTINE
+       RAL
+       AND     LIT7
+       TAD     E60
+       JMS     PR6BIT
+       JMP I   ERTTY
+
+PR6BIT,        0               /6BIT TO 8BIT CONVERTOR
+       AND     (77
+       SNA
+       JMP     PRLOC   /MESSAGE OVER
+       TAD     (7740
+       SPA
+       TAD     (100
+       TAD     (240
+       CALL    0,GENIO /LOOK FOR ^C WHILE TYPING
+       JMP I   PR6BIT
+
+/
+/EXIT TO DISK MONITOR SYSTEM
+/
+EXIT,  BLOCK   1
+       10
+EXITX, CALL    0,CKIO
+       6203
+       JMPI    U7600   /RETURN TO MONITOR
+
+CKIO,  0
+TEM2,  10      /DUMMY SUBROUTINE TO WAIT FOR I/O COMPLETE
+CKWAIT,        6041
+       JMP     CKWAIT
+       RETRN   CKIO
+
+CDRGCH,        0       /GET A CHAR FROM A PACKED TABLE
+       DCA     TEM2    /WORD PTR IN AC, LEFT/RIGHT SW IN LINK
+       TADI    TEM2    /PRESERVE ENTRY FIELD
+       SZL
+       JMP     CDRAND  /RIGHT HALF
+       RTR
+       RTR
+       RTR
+CDRAND,        AND     CDR77
+       JMP I CDRGCH    /RESTORE CURRENT FIELD AND GET OUT
+CDR77, 77
+
+       END
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/VR12.PA b/sw/os8/v3d/sources/system/dectapes/dectape3/VR12.PA
new file mode 100644 (file)
index 0000000..ec64a3b
--- /dev/null
@@ -0,0 +1,337 @@
+/25    OS/12 SCOPE 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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+
+/      NOVEMBER, 1972
+
+/      MARIO DENOBILI, P?S
+
+/      THIS ROUTINE WAS WRITTEN VERY HASTILY.
+
+/      THE FOLLOWING FEATURES SHOULD BE PUT
+/      IN, BUT I WAS TOO LAZY TO DO SO.
+/      WITH A FEW HOURS WORK, A COMPETENT
+/      PROGRAMMER SHOULD BE ABLE TO COMPACT
+/      MY HASTY CODE AND EASILY ADD AT LEAST
+/      A FEW OF THE FOLLOWING FEATURES:
+
+/1.    TABS SHOULD BE HANDLED CORRECTLY.
+
+/2.    FORM FEEDS SHOULD SIGNAL A NEW
+/      SCOPE PAGE. [BRANCH TO LOCATION 'FULL']
+
+/3.    VERTICAL TABS SHOULD BE TREATED AS
+/      7 LINE FEEDS.
+
+/4.    THE HANDLER SHOULD RETURN AN ERROR ON READ.
+
+/5.    IF THE BUFFER OVERLAPS THE BETA REGISTER,
+/      OR WRAPS AROUND 7777.
+/      THIS SHOULD NOT CAUSE A CRAPPY 
+/      CHARACTER TO BE DISPLAYED.
+
+/6.    CTRL/Z SHOULD BE CHECKED FOR AND SIGNIFY
+/      END OF BUFFER. [BRANCH TO 'FULL' WITH
+/      LINK 0]
+
+/7.    THE DISPLAY ALGORITHM SHOULD BE IMPROVED
+/      SO THAT THERE IS LESS FLICKER.
+\f/MORE FEATURES TO BE ADDED
+
+/8.    THE RESTRICTION THAT THE USER'S BUFFER 
+/      START AT AN EVEN ADDRESS IS USELESS
+/      AND SHOULD BE REMOVED.
+
+/9.    THE STATUS OF THE SPECIAL FUNCTIONS
+/      REGISTER SHOULD BE SAVED AND RESTORED
+/      BEFORE EXITING.
+
+/10.   WHEN ANOTHER LOCATION IS FOUND, THE HANDLER
+/      SHOULD BE ABLE TO DETECT PARITY ^C
+
+/11.   SENSE SWITCH 0 SHOULD BE USED TO 
+/      SPECIFY SMALL OR LARGE SIZE CHARACTERS.
+
+/12.   OVERFLOW LINES SHOULD BE INDENTED SOME SMALL
+/      AMOUNT TO SHOW THAT THEY ARE A CONTINUATION
+/      OF THE PREVIOUS LINE
+\f/     OS/8 BUILD HEADER BLOCK
+
+       FIELD 0
+       *0
+
+       -1
+       DEVICE VR12     /DEVICE NAME
+       DEVICE TV       /HANDLER NAME
+       1300            /DCB WORD
+       4000+SCOPE-200  /2-PAGE FLAG AND RELATIVE ENTRY PT
+       ZBLOCK 2
+
+/      TWO PAGE SCOPE DEVICE HANDLER
+/      PAGE INDEPENDENT AND REUSABLE
+
+       LINC=6141
+       PDP=2
+       ESF=4
+       CLR=11
+
+       *200
+
+L26,   26
+SAVE,  0               /BETA REG SAVE LOC - MAY BE BETA REG
+LINKNT,        TAD SAVE        /COUNT OF # OF LINES
+YCOORD,        AND SCDF        /DISPLAY ORDIANTE
+BETA,  DCA .           /8-MODE ADDRESS OF BETA REGISTER 1
+CBASE, TAD SAVE        /POINTS TO CHARACTER DISPLAY TABLE
+BUFEND,        TAD XCIF        /END OF BUFFER
+BPTR,  DCA CBASE       /POINTS INTO BUFFER
+BUFFER,        TAD X           /BEGINNING OF BUFFER
+T1,    DCA BEGIN       /TEMPORARY
+L7410, SKP
+
+       TVERSION="A&77
+\fSCOPE,        TVERSION
+BEGIN, JMS SAVE        /ADDRESS MUST BE EVEN
+       AND L70         /GET DATA FIELD OF BUFFER
+       TAD KCDF
+       DCA SCDF
+       KCC
+       RDF             /GET DATA FIELD
+       TAD FULL
+       DCA XCIF
+X,     TAD I SCOPE     /GET FUNCTION WORD
+       CLL RAL
+       AND L7700       /GET # OF PAGES
+       ISZ SCOPE
+       SNA
+       JMP OVERX
+       TAD I SCOPE     /ADD IN BUFFER START
+       DCA BUFEND      /TO GET END OF BUFFER
+       TAD I SCOPE     /GET BUFFER START
+       DCA BUFFER      /[RESTRICTION: IT MUST BE EVEN]
+       CDF 0
+       TAD I BETA
+       DCA SAVE        /SAVE CONTENTS OF BETA REGISTER
+\f/MAIN LOOP - GET CHARACTERS AND CALL DISPLAY ROUTINE
+
+NEW,   LAS             /LINE COUNT FROM SWITCH REGISTER
+       DCA LINKNT
+       DCA I BETA      /GO TO LEFT MARGIN
+       TAD BUFFER
+       DCA BPTR        /POINT TO BEGIN OF BUFFER
+       TAD YINIT
+       DCA YCOORD      /GO TO TOP OF SCREEN
+ENTRY, JMS     DISP    /DISPLAY 3D CHAR ( ALSO SETS DF)
+       TAD     BPTR
+       CMA CLL
+       TAD     BUFEND  /COMPARE BUFFER PTR WITH BUFFER END
+       SNL CLA         /AT END OF BUFFER?
+       JMP     FULL    /YES - LINK OFF AT FULL MEANS EXIT
+ROTT1, RTL             /NOTE LINK=1 IF WE FELL INTO HERE!
+       RTL             /ROTATE HI ORDER BITS INTO SHIFT REG
+       SPA             /TEST FOR SHIFT REGISTER FULL
+       JMP     ENTRY   /YES - GO DIAPLAY IT
+       DCA     T1      /RESAVE SHIFT REGISTER
+       TAD I   BPTR    /GET NEXT BUFFER WORD
+       JMS     DISP    /DISPLAY LOW-ORDER
+       TAD I   BPTR
+       ISZ     BPTR    /BUMP PTR
+/      NOP
+       AND     L7410   /GET HIGH ORDER - THE 10 IS HARMLESS
+       CLL RAL
+       TAD     T1      /ADD HIGH ORDER TO SHIFT REGISTER.
+       JMP     ROTT1   /INVOLUTED CODE.
+\f/DISPLAY SUBROUTINE - DISPLAYS A CHARACTER
+
+DISP,  0
+KCDF,  CDF 0
+YINIT, AND L177
+       SNA
+       JMP     SCDF    /IGNORE NULLS
+       TAD     L7640
+       CLL CML
+       TAD     L100    /CHECK WHETHER THE CHARACTER
+       SZL             /IS OUTSIDE OF THE RANGE [40,137]
+       JMP     UGH     /YES - SUBSTITUTE SPACE OR L.F.
+       CLL RAL
+MAGIC, TAD CBASE       /ADD IN BASE ADDR
+       DCA RIGHT       /GET DISPLAY BIT PATTERN PTR
+       TAD I RIGHT
+       DCA LEFT        /GET LEFT HALF OF DISPLAY BITS
+       ISZ RIGHT
+       TAD I RIGHT
+       DCA RIGHT       /GET RIGHT HALF
+       TAD YCOORD      /PUT ORDINATE IN AC
+       LINC
+YINC,  1760            /DSC I
+LEFT,  0               /DISPLAY LEFT HALF
+       1760            /DSC I
+RIGHT, 0               /DISPLAY RIGHT HALF
+       CLR
+       ESF             /SMALL CHARACTERS!
+       PDP
+       ISZ I BETA      /LEAVE A BISSEL SPACE
+       TAD I BETA      /GET ABSCISSA
+       TAD LINEND      /COMPARE WITH RIGHT MARGIN
+L7700, SMA CLA         /AT RIGHT EDGE OF SCREEN?
+       JMP NEWLIN      /YES, GO TO NEXT LINE
+SCDF,  6001            /NO, SET PROPER DF
+       JMP I DISP      /RETURN
+\f/DISPLAY ROUTINE CONTINUED
+
+UGH,   TAD L26         /CHECK FOR LINE FEED
+LINEND,        RTR             /OR FORM FEED (LINK=0!)
+L7640, SZA CLA
+       JMP MAGIC       /OTHER CONTROL CHARS PRINT BLNK
+NEWLIN,        DCA I BETA      /BACK TO LEFT MARGIN
+       TAD YCOORD
+       TAD YINC
+       DCA YCOORD      /MOVE DOWN TO NEXT LINE
+       ISZ LINKNT      /AT BOTTOM OF SCREEN?
+       JMP SCDF        /NO
+       CLL CLA CMA RAL /TAKE QUOT ON DIV BY 2
+       AND BPTR        /AND LEAVE IN AC
+FULL,  CIF CDF 0       /YES
+       KSF             /GO TO NEXT SCOPE PAGE?
+       JMP NEW         /NO, REFRESH
+       DCA BUFFER      /GET NEW BUFFER 'START'
+       SZL             /END OF BUFFER ?
+       JMP NOW         /NO, REFRESH
+       TAD SAVE
+       DCA I BETA      /RESTORE BETA REGISTER
+OVERX, CLA STL RAL IAC /ADD 3
+       TAD SCOPE       /TO RET ADDRESS
+       DCA SCOPE
+XCIF,  CHRTBL-BEGIN-1  /RESTORE INST FIELD & DATA FIELD
+       JMP I SCOPE     /LEAVE
+L177,  177
+L100,  100
+NOW,   KRB
+/      AND L177
+       TAD M3
+       SZA CLA
+       JMP NEW
+       JMP I .+1
+       7605
+L70,   70
+M3,    -203            /** TEMP
+/BETTER STUFF, PRINTS ^C
+/NOW,  TAD L7600
+/      KRS
+/      TAD M7603
+/      SZA CLA
+/      JMP NEW
+/      JMP I L7600
+/L7600,        7600
+/M7603,        -7603
+       PAGE
+\f/THE TABLE OF PATTERN WORDS BEGINS HERE
+
+CHRTBL,        0000; 0000      /SPACE
+       7500; 0000      /!
+       7000; 0070      /"
+       7714; 1477      /#
+       5721; 4671      /$
+       6661; 4333      /%
+       5166; 0526      /&
+       0000; 0070      /'
+       3600; 0041      /(
+       4100; 0036      /)
+       2050; 0050      /*
+       0404; 0437      /+
+       0500; 0006      /,
+       0404; 0404      /-
+       0001; 0000      /.
+       0601; 4030      //
+       4536; 3651      /0
+       2101; 0177      /1
+       4523; 2151      /2
+       4122; 2651      /3
+       2414; 0477      /4
+       5172; 0651      /5
+       1506; 4225      /6
+       4443; 6050      /7
+       5126; 2651      /8
+       5122; 3651      /9
+       2200; 0000      /:
+       4601; 0000      /;
+       2410; 0042      /<
+       1212; 1212      /=
+       4200; 1024      />
+       4020; 2055      /?
+       4136; 3656      /@
+       4477; 7744      /A
+       5177; 2651      /B
+       4136; 2241      /C
+       4177; 3641      /D
+       4577; 4145      /E
+       4477; 4044      /F
+       4136; 2645      /G
+       1077; 7710      /H
+       7741; 0041      /I
+       4142; 4076      /J
+       1077; 4324      /K
+       0177; 0301      /L
+       3077; 7730      /M
+       3077; 7706      /N
+       4177; 7741      /O
+       4477; 3044      /P
+       4276; 0376      /Q
+       4477; 3146      /R
+       5121; 4651      /S
+       4040; 4077      /T
+       0177; 7701      /U
+       0176; 7402      /V
+       0677; 7701      /W
+       1463; 6314      /X
+       0770; 7007      /Y
+       4543; 6151      /Z
+       4177; 0000      /[
+       3040; 0106      /\
+       0000; 7741      /]
+       2000; 2076      /^
+       1604; 0404      /_
+
+       $
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape3/VT50.PA b/sw/os8/v3d/sources/system/dectapes/dectape3/VT50.PA
new file mode 100644 (file)
index 0000000..c23b53f
Binary files /dev/null and b/sw/os8/v3d/sources/system/dectapes/dectape3/VT50.PA differ
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape4/BUILD.PA b/sw/os8/v3d/sources/system/dectapes/dectape4/BUILD.PA
new file mode 100644 (file)
index 0000000..438ea28
--- /dev/null
@@ -0,0 +1,3466 @@
+/33 OS/8 V3D BUILD
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT  (C)  1971,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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/ABSTRACT--
+/BUILD IS THE SYSTEM CONFIGURATOR FOR THE OS/8 PROGRAMMING
+/SYSTEM. WITH BUILD, THE DEVICES WITHIN A PARTICULAR
+/SYSTEM CAN BE RAPIDLY AND EASILY CHANGED. BUILD ALSO
+/PROVIDES THE FACILITY FOR CREATING AN INITIAL OS/8 SYSTEM
+/FROM BINARY PAPER TAPES OR CASSETTES.
+
+/V3 CHANGES
+
+/0.    MADE BUILD SUPPORTABLE
+/1.    ADDED VE COMMAND (CURRENT VERSION # IS 3X WHERE X IS PATCH LEVEL)
+/2.    FIXED PROBLEM WITH Z'S AND 9'S IN FILENAMES
+/3.    CHANGED LENGTH OF DF32
+/4.    FIXED PROBLEM WITH RK8 BOOTSTRAP RECORD.
+/5.    ON LOAD, NULL EXTENSION FIRST SEARCHES FOR .BN
+/6.    CR TO $ DOESN'T GIVE ERROR
+/7.    FIXED BUG WITH BUILDING ROM SYS
+/8.    RUBOUTS TO BOL GIVE $
+/9.    ^U RETYPES $
+/10.   ASSUME DSK: IF NO DEV GIVEN WITH LOAD
+/11.   NO DOT IS PRINTED IF NO EXTENSION
+/12.   ^O STUFF NEW
+/13.   ALLOW PARITY ^C
+/14.   ADDED EXAMINE COMMAND
+/15.   FIXED BUG RE ACCESSING USR TABLE VIA POINTER
+/16.   CLEANED UP MOVE ROUTINE
+/17.   CLEANED UP NUMBER TOO BIG CHECKER
+/18.   OVERFLOW ERROR MESSAGE CHANGED TO 'BAD ORIGIN'
+/19.   DON'T ALLOW NAMES OVER 6 CHARS TO SPILL INTO EXTENSION;
+/      DON'T ALLOW MULTIPLE EXTENSIONS
+/20.   INCREASED NUMBER OF ALLOWABLE ENTRY PTS/HANDLER TO 16 (DEC)
+/21.   CLEANED UP SYMBOL PRINT ROUTINE
+/22.   GOT NAMES IN TABLE TO LINE UP.
+/23.   INSERT GRPNAME <CR> INSERTS FIRST HANDLER
+/24.   INSERT GRP,DEV1,DEV2,DEV3,...
+/25.   INSERT GRP,DEV1-5,...
+/26.   SAME FOR DELETE AND REPLACE
+/27.   COUNT DEVICES AND SLOTS ONLY ON BOOT
+/28.   FIXED BUG RE SYS RF08=4023
+/29.   GENERAL SUPPORT OF 2-PAGE SYS HANDLERS
+/30.   ADDED QL COMMAND
+/31.   SETS SA=00200, JSW=0
+/32.   UNLOAD UNLOADS AND DELETES
+/33.   ADDED DSK COMMAND
+/34.   BUILD COMMAND
+/35.   PRINT TELLS YOU ABOUT DSK
+/36.   TOOK OUT LOC DEPENDENT CHECK FOR SYSTEM HANDLERS
+/37.   INSERT ALLOWS SETTING # OF PLATTERS
+/38.   HANDLER HEADER LOADS DIRECTLY INTO DESCRIPTOR TABLE
+/39.   USES EXTRA CORE IF AVAILABLE (ALSO CHECKS SOFTWARE CORE SIZE)
+/40.   STOPS ECHOING ON INPUT LINE OVERFLOW
+/41.   *'S SYSTEM DEVICE
+/42.   REMEMBERS SYS ACROSS A BOOT
+/43.   'Y' INSTEAD OF 'YE'
+/44.   BO CHECKS DCB IN CORE TO SEE IF NEED REWRITE MONITOR
+/45.   ALLOW UNLOADING ENTRY POINT NAMES
+/46.   CTL COMMAND
+/47.   EACH COMMAND HAS ITS OWN MAXIMUM INPUT LINE SIZE
+/48.   ADDED CORE COMMAND
+/49.   FIXED ^U TO WRITE ZERO DIRECT MSG BUG
+/50.   HIT CONTINUE AFTER 'SYS ERR' TO RETRY
+/51.   PRESERVED DATE ACROSS BOOT
+/52.   MULTIPLE LOADS AND UNLOADS
+/53.   LOAD FROM SCRATCH USES INTERNAL ACTIVE HANDLERS
+/54.   CASSETTE SUPPORT
+/55.   SETS CORE CONTROL BLOCK
+
+/CHANGES SINCE FIELD RELEASE
+
+/A     'NO ROOM' DOESN'T PRINT 'BAD LOAD'
+/B     NO. OF ENTRY POINTS NOW CORRECTLY CHECKED FOR
+/C     FIXED BUG RE BUILDING TD8E FROM TD8E
+/D     BOOT CMD DISABLES BUILD CMD
+/E     JSW SET TO 1 BEFORE CHAINING TO ABSLDR
+/F     P CMD BUG FIXED
+/G     ALTER BUG FIXED
+/H     LENGTH OF INPUT LINE SYMBOLIC
+/I     SOFCOR STUFF OPTIMIZED
+/J     QL DOESN'T PRINT SPACE BETWEEN SYS'S GRP:NAME
+/K     FIXED BUG IN 32K
+/L     PAPER TAPE PUTS HLT IN 7600
+
+/THINGS TO DO:
+
+/?     DIES IF DATA OCCURS BEFORE *0
+/?     BOOT.ZE, .NZ  CMD?
+/?     GET 2-PAGE BIT OF CURRENT SYSTEM
+
+/CHANGES FOR MAINTENANCE RELEASE V3C:
+
+/      7-AUG-75
+
+/1.    CHANGED VERSION NUMBER TO V5
+/2.    INCORPORATED PATCH SEQ #1 (DSN APRIL 1975)
+/      ZERO LOCATION SOFSET WHILE BUILDING
+/3.    INCORPORATED PATCH SEQ #2 (DSN NOV. 1974)
+/      DISMISS USR AFTER ?NAME ERROR
+/4.    INCORPORATED PATCH SEQ #3 (DSN  MARCH 1975)
+/      DECREASE SYSTEM SIZE BY 5 (FOR ABSLDR) WHEN BUILDING FROM PAPER TAPE
+/5.    INCORPORATED PATCH SEQ #4 (DSN APRIL 1975)
+/      ADDED 'SIZE' COMMAND TO BUILD
+/6.    FIXED BUG WHICH CAUSES SYSXY.RS NOT FOUND TO BE PRINTED
+/      ON BOOTXY.RS COMMAND
+
+/CHANGES FOR V3D:
+
+/      1-MAY-77
+
+/1.    FIXED PROBLEM WITH CASSETTE BUILD (JSW WAS SET WRONG)
+/2.    ALLOWED SAVING OF HIGH-ORDER DATE BITS
+\f/BUILD PAGE 0
+       *1
+       HLT             /SAFETY HALT AND PATCH SPACE
+SAV1,  0
+SAV2,  0               /SAVES GROUP NAME
+       *10             /AUTO INDEX REGISTERS
+XR1,   0               /GENERAL PURPOSE REGISTERS
+XR2,   0
+XR3,   0
+XR4,   0               /USED TO BUILD IMAGE TABLES
+XR5,   0
+LXR,   0
+GNMXR, 0
+L600,  600
+
+       *20
+COUNT, 0               /GENERAL COUNTER LOCATION
+CHAR,  0               /CHARACTER BUFFER
+TEMP,  0               /TEMPORARIES
+TMP1,  0
+
+
+       BUFFER=5400
+       BINARY=6000
+       DEVBUF=0400     /FIRST HANDLER AT 10400
+                       /FOR REASONS TOO LONG TO GO INTO HERE,
+                       /BUT WHICH HAVE TO DO WITH CURIOUS
+                       /PROPERTIES OF THE NUMBER 0,
+                       /HANDLERS CAN'T START AT 0.
+                       /THEY COULD HAVE STARTED AT 200.
+       SOFSET=7747     /SYSTEM OFFSET. (CURRENTLY =0)
+       PG7600=BUFFER   /RECORD 0 (IMAGES OF BOTH 7600'S)
+
+       LDRCTL=4113     /CHECK OS/8 ASSEMBLY
+NAME1, 0               /NAME1-4 HOLDS FILE AND DEVICE NAMES
+NAME2, 0
+NAME3, 0
+NAME4, 0
+TABLMT,        DSCTAB          /HIGH CORE END OF DESCRIPTORS
+                       /FIRST FREE LOCATION
+SIZE,  0
+HNDPTR,        DEVBUF          /POINTS TO FIRST FREE LOCATION IN HANDLER TABLE
+
+       BLDSAV=75       /**** WILL DESTROY PREVIOUS FILES
+                       /START OF 40 BLOCK TO SAVE BUILD IN
+       HDRSIZ=10       /NUMBER OF ITEMS IN A DESCRIPTOR
+DSCPTR,        DSCTAB          /ALWAYS POINTS TO BEGIN OF CURRENT DESCRIPTOR
+\fSLOT, 0
+DSKG1, 0               /NAME OF 'DSK'
+DSKG2, 0
+DSKP1, 0
+DSKP2, 0
+NEWPAG,        0
+OLDPAG,        0
+NEWCOR,        0               /NEW CORE MAX
+SAVDAT,        0               /REMEMBERS DATE ACROSS A BOOT
+       DATEWD=7666
+FLAG2, 1               /0 IF PREVIOUS SYSTEM HAD A 2-PAGE HANDLER
+/SAMSYS,       1               /0 IF DIDN'T SPECIFY NEW SYS
+       BLOK66=0
+SYSDCB,        0
+       SA=7744
+       JSW=7746
+/BOOTDV,       0               /HANDLER ADDRESS OF DEVICE WE'RE BOOTSTRAPPING TO
+SAVHID,        0               /HIGH-ORDER DATE (BITS 3-4)
+\f/BEGLIN:      72 CHAR LINE BUFFER
+
+/NEW BUILD CORE ALLOCATION:
+
+/0000-5177     BUILD (ABSLD MUST BE ABOVE 4177)
+/5400-5777     DEVICE HANDLER FOR LOAD
+/5200-5377     PAPER TAPE/INIT/LINE BUFFER
+/6000-6377     INPUT BUFFER FOR LOAD (TEMP LOC OF USR)
+/6400-7577     DESCRIPTOR TABLE (DSCTAB)
+
+/BINARY MUST FOLLOW BUFFER
+/FIELD 1: HANDLERS (0400-7577)
+/10000-10377   BLOK66  BUFFER
+\f      *200
+
+       SKP CLA         /ENTRY FROM 'R BUILD'
+       HLT             /CHAIN ENTRY ADDRESS
+       TAD I [7600     /SEE IF SYSTEM ALREADY EXISTS
+       CIA
+       TAD [4207
+       SZA CLA         /IF NOT, BUILD SYSTEM FROM PAPER TAPE
+       CLA IAC         /NOTE FACT THAT OS/8 AINT AROUND
+       DCA I [RETSW
+       JMS CORE
+       DCA I (AMTCOR   /FIGURE OUT HOW MUCH CORE WE HAVE
+       JMS I (GOOD     /DO SOME INITIALIZATION; IT'LL DO YA GOOD
+CONFIG,        CDF 0
+       DCA I (ECHOFLG  /ALLOW TYPING
+       JMS I [CRLF
+DOLR,  TAD ["$         /OUTPUT A $ BECAUSE I'M JEWISH
+       JMS I [TTYOUT
+       DCA I [SWAPER   /USE CURRENT HANDLER, NO SWAP ON ^C.
+       TAD [-LNLNGT
+       JMS I [GTEXT    /READ TTY LINE
+       JMP DOLR
+       JMS I [GNAME    /INTERPRET THE COMMAND
+       TAD NAME1
+       SNA
+       JMP CONFIG
+       DCA CHAR        /ENABLE TEST TO WORK
+\f      JMS I [TEST     /LOOK FOR THE COMMAND IN LIST
+       -1417;LOAD      /LOAD DEVICE HANDLER BINARY
+       -2205;REPLACE   /REPLACE IN SYSTEM
+       -1601;NAME      /ALTER PERMANENT NAME
+       -0114;ALTER     /CHANGE DEVICE HANDLER LOCATION
+       -2022;PRINT     /SYSTEM STATUS
+       -2331;SYSTEM    /SPECIFY SYSTEM DEVICE
+       -0217;BOOT      /BOOTSTRAP THE NEW SYSTEM
+       -2516;UNLOAD    /DELETE INACTIVE HANDLER
+       -0405;DELETE    /DELETE ACTIVE HANDLER
+       -1116;INSERT    /INSERT HANDLER IN SYSTEM
+       -2605;VERS      /TYPE VERSION #
+       -0530;EXAMINE   /EXAMINE LOCATION
+       -2114;QLIST     /QUICK LIST
+       -0423;DSK       /DSK
+       -0317;KORE      /CORE
+       -0403;DCBCM     /DCB
+       -0324;CTLCM     /CTL
+       -2311;SIZCM     /SIZE
+BD,    -0225;BUILD     /BUILD
+       0               /MUST TERMINATE LIST WITH 0
+       JMP I [WHAT     /DIDN'T FIND COMMAND
+
+/NEW HEADER BLOCK:
+
+/      DEVICE GROUPNAME
+/      DEVICE PERMANENT NAME
+/      DCB     (R/W,TYPE,MAX # OF PLATTERS)
+/      1/2 PAGE, SYSTEM BIT, CORES BIT, REL ENTRY PT
+/      MUST BE 0
+/      SIZE OF 1 PLATTER
+\fCORSIZ,
+GETCHA,        0
+       TAD DSCPTR
+       TAD I GETCHA
+       ISZ GETCHA
+       DCA GETEM
+       TAD I GETEM
+       JMP I GETCHA
+
+GOTCHA,        0
+       DCA GOTEM
+       TAD I GOTCHA
+       TAD DSCPTR
+       ISZ GOTCHA
+       DCA GETEM
+       TAD GOTEM
+       DCA I GETEM
+       JMP I GOTCHA
+
+       PUT=JMS I [GOTCHA
+       GET=JMS I [GETCHA
+\fGOTEM,
+CORE,  0
+       TAD I [7777
+       AND [70
+       CLL RTR
+       RAR
+       SNA
+       JMS RELCOR
+       JMP I CORE
+
+GETEM,                 /POINTS INTO DSCTAB
+RELCOR,        0
+       CLA IAC
+       DCA CORSIZ      /MAKE RE-USABLE
+       TAD [7400
+       DCA CORX        /MAKE ROUTINE REUSABLE ON 32K MACHINE
+COR0,  CDF 0
+       TAD CORSIZ
+       RTL
+       RAL
+       AND COR70
+       TAD COREX
+       DCA .+1
+COR1,  CDF /N
+       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
+       TAD COR1
+       DCA I CORLOC
+       ISZ CORSIZ
+       JMP COR0
+COREX, CDF 0
+       STA
+       TAD CORSIZ
+       JMP I RELCOR    /LEAVE WITH HIGHEST EXISTENT BANK
+
+CORLOC,        CORX
+CORV,  1400
+       PAGE
+\f/GET  GETS DESCRIPTOR ITEM FROM CURRENT DESCRIPTOR
+/OP
+
+/PUT   PUTS DESCRIPTOR ITEM IN AC BACK IN SPECIFIED ITEM
+/OP    IN CURRENT DESCRIPTOR
+
+/ITEMS:
+
+/ACTIVE        BIT 0=1 MEANS ENTRY POINT HAS BEEN INSERTED (IS ACTIVE)
+/PERM1 PERMANENT NAME (FIRST 2 CHARS)
+/PERM2 2ND 2 CHARS
+/TWOPAG        BIT 0=1 MEANS 2-PAGE HANDLER, BIT 4 IGNORED, BITS 5-11 RELATIVE ENTRY POINT
+/PAGRES        BITS 7-11 GIVE PAGE OF START OF HANDLER WHEN ROTATED 6 RT
+/GRPNM1        GROUP NAME (DEVICE NAME) FIRST 2 CHARS
+/GRPNM2        2ND 2 CHARS
+/DEVSIZ        GIVES SIZE OF 1 PLATTER
+/PLATNUM # OF PLATTERS IN BITS 2-4
+/DSKBIT        BIT 1 IS FLAG FOR 'DSK' (USED TEMPORARILY BY BUILD)
+/MAXPLT        MAXIMUM NUMBER OF PLATTERS ALLOWED (IN BITS 9-11)
+/DCB   D.C.B. BIT 0: FILESTRUCTURED, BITS 3-8 DEVICE TYPE
+/      BITS 9-11 MAX NO. OF PLATTERS
+/CORES BIT 2 MEANS ENTRY PT IS CORESIDENT WITH SYS HANDLER
+/SYSBIT        BIT 1 IS A 1 IF THE DEVICE HAS NAME 'SYS' AND IS A SYS DEVICE
+
+/IF FIRST ENTRY OF A DESCRIPTOR IS GE 7600, THEN THIS
+/ENTRY IS A BOOTSTRAP ENTRY.
+/IT STARTS WITH THE NEGATIVE OF THE NUMBER OF WORDS IN THE
+/BOOTSTRAP (FOR THE PRECEDING DEVICE), FOLLOWED BY THAT MANY WORDS
+\f      GRPNM1=0
+       GRPNM2=1
+       PRMNM1=2
+       PRMNM2=3
+       DCB=4
+       MAXPLT=4
+       DVTYPE=4
+       TWOPAG=5        /BIT 0
+       SYSBIT=5        /BIT 1
+       ACTIVE=6
+       ENTPT=5
+       PAGRES=6
+       PLATNUM=6
+       DEVSIZ=7
+       DSKBIT=6        /BIT 1
+       CORES=5         /BIT 2
+\f/READ A LINE OF TEXT    RETURN 1 IS ^U RETURN
+GTEXT, 0               /ROUTINE TO COLLECT TTY INPUT
+       TAD (-BEGLIN    /AC IS NON-ZERO
+       DCA ENDLIN
+       DCA I (RUBFLG   /INITIALIZE RUBOUT TO \
+       TAD (BEGLIN-1
+RDTX,  DCA LXR         /BUFFER ADD. TO INDEX
+RDTXT, JMS I [TTYIN    /READ BLOODY TELETYPE
+       TAD CHAR
+       DCA NAME1       /SETUP FOR TEST AGAIN
+       JMS I [TEST
+       -377;RBOUT      /RUBOUT
+       -212;LFEED      /LINE FEED..ECHO CURRENT COMMAND
+       -215;CARRET     /LINE TERMINATOR
+       -233;ALTMOD     /ALT MODE IN SEVERAL FLAVORS
+       -375;ALTMOD
+       -376;ALTMOD
+       -200;RDTXT      /IGNORE BLANKS
+       -217;RDTXT      /AS WELL AS ^O
+       -203;CTRLC      /BACK TO CURRENT SYSTEM
+       -225;CTRLU      /CTRLU
+       0               /IF NOT ONE OF THESE, PUT IN BUFFER
+       TAD LXR
+       TAD ENDLIN
+       SNA CLA
+       JMP RDTXT       /LINE OVERFLOW, STOP ECHOING
+       JMS I [PRNT     /PRINT THE CHARACTER
+       TAD CHAR
+       DCA I LXR       /AND PUT IN LINE BUFFER
+       JMP RDTXT       /NO PROBLEMS YET
+\fRBOUT,        TAD LXR         /IS THERE TEXT TO RUB OUT?
+       TAD [1-BEGLIN
+       SNA CLA
+       JMP RBCR        /NO..SO DON'T DO ANYTHING
+       TAD ["\         /YES..ECHO BACKSLASH?
+       ISZ I (RUBFLG   /IF = -1, NO
+       JMS I [TTYOUT
+       CLA CMA         /IGNORE CONSECUTIVE RUBOUTS
+       DCA I (RUBFLG
+       TAD LXR
+       DCA TMP1
+       TAD I TMP1
+       JMS I [TTYOUT   /ECHO LAST CHAR
+XRBACK,        CLA CMA
+       TAD LXR         /MOVE INDEX BACK ONE
+       JMP RDTX
+CARRET,        JMS I [CRLF     /GENERATE 215,212
+CAR1,  DCA I LXR
+       DCA I LXR       /GUARD AGAINS CMD <CR>
+       TAD [BEGLIN-1
+       DCA GNMXR       /SETUP FOR GNAME ROUTINE
+       ISZ GTEXT       /TAKE NORMAL RETURN
+       JMP I GTEXT
+
+LFEED, DCA I LXR       /A 0 TO MARK END
+       TAD [BEGLIN-1
+       DCA LXR
+       JMS I [CRLF
+       TAD ["$
+       JMS I [TTYOUT
+ECHO,  TAD I LXR
+       SNA             /DONE ECHOING?
+       JMP XRBACK      /YES..REPOSITION LXR
+       JMS I [TTYOUT
+       JMP ECHO
+
+ALTMOD,        TAD ["$         /ALT MODE ECHOES AS $
+       JMS I [TTYOUT
+       JMP CAR1
+
+CTRLU, TAD ["^
+       JMS I [TTYOUT   /GENERATE ^U
+       TAD NAME1
+       TAD [100
+       JMS I [TTYOUT
+RBCR,  JMS I [CRLF
+       JMP I GTEXT     /TAKE ERROR RETURN
+\f      GETCHR=JMS I [GETC
+       BAKCHR=JMS I [BAKC
+
+ENDLIN,
+GETNUM,        0               /PICKS UP NUMBER FROM LINE BUFF
+                       /DELIM CHAR PUT IN 'CHAR'
+                       /PRINTS ERROR MESSAGE IF  GT 4095
+                       /IF NO NUMBER, TAKES RETURN 1
+                       /IF NUMBER, TAKES RET 2 WITH # IN 'SIZE'
+       DCA SIZE
+       DCA GOTSW       /HAVEN'T FOUND ANY DIGITS YET
+       JMP NCHAR
+ROT,   DCA TMP1
+       ISZ GOTSW       /FOUND A DIGIT
+       TAD SIZE
+       AND [7000
+       SZA CLA
+       JMP I [BADARG   /NUMBER .GT. 4095
+       TAD SIZE
+       CLL RTL
+       RAL             /BUILD UP THE DIGIT
+       TAD TMP1
+       DCA SIZE
+NCHAR, GETCHR
+       SNA             /0 ENDS THE LINE
+       JMP NUMOUT
+       TAD [-240       /IGNORE SPACES
+       SNA
+       JMP NCHAR
+       TAD (-30        /TEST LIMITS
+       CLL
+       TAD [10         /MUST BE BETWEEN 0 AND 7
+       SZL
+       JMP ROT
+       TAD (260        /RESTORE CHAR
+NUMOUT,        DCA CHAR        /SAVE AWAY THIS DELIMETER
+       TAD GOTSW       /DID WE GET ANY DIGITS?
+       SZA CLA         /?
+       ISZ GETNUM      /YES
+       JMP I GETNUM    /NO, RETURN
+\fGETC, 0               /GET THE NEXT CHARACTER, ADVANCE SCAN PAST IT
+       TAD I GNMXR
+       JMP I GETC
+
+GOTSW,                 /1 MEANS GOT A DIGIT
+BAKC,  0               /BACK UP SCAN TO THE CHARACTER JUST LOOKED AT
+       STA
+       TAD GNMXR
+       DCA GNMXR
+       JMP I BAKC
+       PAGE
+\f      INIT=JMS I [INI
+       ADVDSC=JMS I [DSCADV
+       ADVBOT=JMS I [BOTADV
+
+/      JMS PRMNAM      /SEARCH TABLE FOR A PERMANENT NAME
+                       /GIVEN IN NAME1-NAME2
+                       /POINT TO DESCRIPTOR FOR THIS NAME
+/      JMS ACTNAM      /SAME BUT PERMANENT NAME MUST BE ACTIVE
+/      JMS BIGNAM      /SEARCHES FOR PERM & GRP NAME (GRP NAME IN SAV1,SAV2)
+/      JMS GRPNAM      /SAME BUT SEARCH FOR GROUP NAME
+
+CHKNAM,        0
+       INIT
+CHKLUP,        ADVDSC          /ADVANCE TO NEXT DESCRIPTOR
+       ADVBOT          /ADVANCE OVER ANY BOOTSTRAP
+       JMP NFOUND      /NO MORE- ERROR
+       GET
+NM1,   GRPNM1          /GET GROUP OR PERMANENT NAME
+       CIA
+       TAD NAME1
+       SZA CLA         /DO FIRST WORDS MATCH?
+       JMP CHKLUP      /NO, TRY AGAIN
+       GET
+NM2,   GRPNM2          /GET 2ND WORD
+       CIA
+       TAD NAME2
+       SZA CLA         /2ND WORD MATCH?
+       JMP CHKLUP      /NO
+       TAD BIGFLG
+       SNA CLA         /WANT BOTH GROUP AND PERM NAME?
+       JMP NOBIG       /NO
+       GET             /YES
+       GRPNM1
+       CIA
+       TAD SAV1
+       SZA CLA
+       JMP CHKLUP
+       GET
+       GRPNM2
+       CIA
+       TAD SAV2
+       SZA CLA
+       JMP CHKLUP
+NOBIG, TAD ACTSW       /FOUND MATCH
+       SNA CLA         /MUST HANDLER BE ACTIVE?
+       JMP I CHKNAM    /NO, RETURN
+       GET             /YES
+       ACTIVE
+       SMA CLA         /IS IT ACTIVE?
+       JMP CHKLUP      /NO, TRY AGAIN
+       JMP I CHKNAM    /YES, RETURN
+\fGRPNAM,       0
+       TAD (GRPNM1     /WANT TO SEARCH FOR GROUP NAME
+       DCA NM1
+       TAD (GRPNM2
+       DCA NM2
+       DCA ACTSW       /NEED NOT BE ACTIVE
+       DCA BIGFLG
+       JMS CHKNAM      /GO SEARCH
+       JMP I GRPNAM
+
+ACTSW, 0               /1 MEANS HANDLER MUST BE ACTIVE
+
+PRMNAM,        0
+       DCA ACTSW       /AC MAY BE NON ZERO (TO MEAN ACTIVE ONLY)
+       TAD (PRMNM1     /WANT TO SEARCH FOR PERMANENT NAME
+       DCA NM1
+       TAD (PRMNM2
+       DCA NM2
+       DCA BIGFLG
+       JMS CHKNAM      /GO SEARCH
+       JMP I PRMNAM
+
+ACTNAM,        0
+       CLA IAC         /THEY MUST BE ACTIVE
+       JMS PRMNAM
+       JMP I ACTNAM
+
+BIGNAM,        0
+       DCA ACTSW
+       TAD (PRMNM1
+       DCA NM1
+       TAD (PRMNM2
+       DCA NM2
+       CLA IAC
+       DCA BIGFLG
+       JMS CHKNAM
+       JMP I BIGNAM
+
+/SOMETIMES CHKNAM CAME FROM DSKASK INSTEAD OF GETSYS ****
+
+BIGFLG,        0               /SET TO 1 TO CHECK GROUP & PERMANENT NAME
+\fNFOUND,       JMS I [PRNAME
+       JMS I [PRWD
+       TEXT / NOT FOUND/
+       JMP I [CONFIG
+
+NOROOM,        JMS I [PRWD
+       TEXT /?NO ROOM/
+       DCA I TABLMT    /RESTORE SENTINEL 0
+       JMP I [CONFIG
+
+VERS,  JMS I [PRWD
+       TEXT    /BUILD V6A/
+       JMP I [CONFIG
+
+/BUILD CORE CONTROL BLOCK
+
+BLDCCB,        -2              /2 SEGMENTS
+       6203            /FIELD 0
+       0200            /200 IS S.A.
+       0000            /JSW
+       0000            /0-7577
+       3710
+       0000            /10000-17577
+       3700
+/GOES INTO WORDS 200-377 OF BLOCK 37
+\fOK,   STA             /NOW USE ORIGIN TO TELL US HOW BIG A
+       TAD I (ORIGIN   /HANDLER WAS LOADED
+       AND [7600
+       TAD [200        /REMEMBER THAT ORIGIN IS ONE GREATER
+       DCA HNDPTR      /THAN ACTUAL LAST LOCATION.
+                       /BETTER TO USE 2-PAGE BIT
+       TAD I (NEWLIM
+       DCA TABLMT      /SET NEW TABLE TOP
+       DCA I TABLMT    /NEED 0 AT END
+       JMS I [COMMA
+       JMP I (LOAD
+       PAGE
+\f/LOAD A 1- OR 2-PAGE HANDLER INTO BUFFER
+/USE IT TO ABSLD
+
+SETUP, 0
+       TAD [NAME1
+       DCA FILPTR      /POINT TO FILENAME AREA
+       TAD (BUFFER+1   /LOAD 2 PAGE HANDLER INTO 'BUFFER'
+       DCA DRIVER      /SET UP ASSIGN DEVICE HANDLER
+       JMS I [GNAME    /GET DEVICE NAME
+       TAD NAME1
+       SNA CLA
+       JMP I SETUP     /NO ARG
+       ISZ SETUP
+       TAD I (RETSW
+       SZA CLA
+       JMP I (BLDLOD   /WHEN LOADING STANDALONE, USE INTERNAL HANDLERS
+       TAD CHAR
+       TAD [-":
+       SZA CLA
+       JMP I (SETDSK   /USE 'DSK ' IF NO DEVICE GIVEN
+       TAD NAME1
+       DCA DVNM1
+       TAD NAME2
+       DCA DVNM1+1     /LOOKUP DEVICE NAME
+GETU,  JMS I (GETUSR
+       CIF 10
+       JMS I [200      /FETCH HANDLER
+       1
+SUBLUP,
+DVNM1, 0
+LODTMP,
+DVNUM, 0               /NAME GOES IN HERE
+DRIVER,        0
+       JMP I (KICKM    /NO DEVICE. RELEASE MONITOR
+       TAD CHAR
+       SZA CLA
+       JMS I [GNAME    /PICK UP FILE NAME
+       TAD DVNM1+1     /DEVICE NUMBER
+       JMS I (DTYPE    /SEE IF FILE STRUCTURED
+       TAD NAME1       /IF FILE STRUCTURED WITH NO NAME
+       SNA CLA         /IT IS AN ERROR
+       JMP NMER        /V3C
+       TAD NAME4       /SAVE ORIGINAL EXTENSION
+       DCA TEMP
+       TAD NAME4
+       SNA             /IF NULL
+       TAD (0216       /TRY .BN FIRST
+TRYAGN,        DCA NAME4
+       TAD DVNUM       /GET DEVICE NUMBER
+       CIF 10
+       JMS I [200      /DO LOOKUP OF FILENAME
+       2
+FILPTR,        NAME1
+       0
+       JMP LDEXT       /DIDN'T FIND FILE. DO SOMETHING
+       CIF 10
+       JMS I [200      /KICK OUT MONITOR
+       11
+       TAD DRIVER
+LOADIN,        DCA I [DVICE    /ENTRY POINT OF HANDLER
+       JMS I (IOPEN    /IF HERE, IT WILL FIT
+       JMP I SETUP
+\fLOAD, JMS SETUP       /SET UP FOR INPUT
+       JMP I [NODEV    /NO LOAD DEVICE
+       STA CLL RAL     /-2 DO A HANDLER LOAD
+       JMS I (LDABS
+       JMP I [BADLOD   /BAD
+       TAD I TABLMT    /SEE IF HEADER INFORMATION IS OK
+       SMA
+       JMP I [BADLOD
+       TAD (20         /ALLOW 16 HANDLERS/BINARY
+       SPA CLA
+       JMP I [BADINP   /TOO MANY
+       TAD I TABLMT
+       DCA LODTMP      /# OF LOOPS TO EXECUTE
+       TAD TABLMT
+       TAD [PAGRES+1   /POINT TO FIRST 'PAGRES' WORD
+       DCA HDPTR       /GO THERE FOR DESCRIPTORS
+       TAD HNDPTR
+       JMS I [ROTL
+       DCA TEMP        /PAGE OF RESIDENCE
+PGLUP, TAD TEMP
+       DCA I HDPTR     /INSERT PAGE OF RESIDENCE
+       TAD HDPTR
+       TAD [HDRSIZ
+       DCA HDPTR
+       ISZ LODTMP
+       JMP PGLUP
+       TAD [2-HDRSIZ
+       TAD HDPTR
+       DCA HDPTR       /POINT TO AFTER DESCRIPTORS
+       TAD HDPTR
+       CIA
+       TAD I (NEWLIM
+       SNA CLA         /AT END?
+       JMP I (OK               /YES
+       TAD I HDPTR     /NO, MAYBE A BOOTSTRAP RECORD
+       CLL
+       TAD [200
+       SNL CLA
+       JMP I [BADLOD   /NO
+       TAD I HDPTR     /MAYBE
+       CIA
+       IAC             /OVER COUNT
+       TAD HDPTR
+       CIA
+       TAD I (NEWLIM
+       SZA CLA
+       JMP I [BADLOD   /NO
+       JMP I (OK
+\fHDPTR,        0               /POINTS INTO NEW HEADER
+
+/DESCRIPTOR TABLE DESCRIPTION:
+
+/'TABLMT' ALWAYS POINTS TO FIRST FREE LOCATION
+/'DSCPTR' ALWAYS POINTS TO BEGIN OF CURRENT HEADER BLOCK
+/ITEMS ARE OF 3 FORMS:
+/(A) GROUP COUNT: IN RANGE -1 TO -20  (IGNORED AND HAS NO MEANING)
+/      IT IS THERE FOR COMPATIBILITY WITH OLD BUILD
+/(B) HEADER BLOCK STARTS WITH NUMBER IN RANGE 0-7577
+/      CONSISTS OF 'HDRSIZ' CONSECUTIVE WORDS
+/      DESCRIBED ELSEWHERE
+/(C) BOOTSTRAP BLOCK: STARTS WITH NUMBER IN RANGE 7600-7757
+/      THIS IS THE NEGATIVE OF THE NUMBER OF WORDS TO FOLLOW
+\f/NON-SYSTEM HEADER INFO:
+
+/      - NUMBER OF ENTRY POINTS
+
+/FOR EACH ENTRY POINT:
+
+/0,1   GROUP NAME
+/2,3   ENTRY POINT NAME        (PERMANENT NAME)
+/4     R/W FILE-STR, DEVICE TYPE, MAX # OF PLATTERS
+/5     1/2 PAGE, REL ENTRY PT, SYSBIT, CORES
+/6*    PAGE OF HANDLER, ACTIVE BIT, # OF PLATS, DSKBIT
+/7     SIZE OF DEVICE
+
+/* SUPPLIED BY BUILD
+
+LDEXT, TAD TEMP        /DIDN'T FIND FILE
+       SZA CLA
+       JMP I (KICKM    /NO RESORT
+       ISZ TEMP
+       JMP TRYAGN      /TRY NULL EXTENSION
+
+NMER,  CIF 10          /V3C
+       JMS I [200      /DISMISS USR FROM CORE
+       11
+       JMP I [NAMERR
+       PAGE
+\fREPLACE,JMS I (DEL    /DELETE PERMANENT NAME SPECIFIED NEXT
+       TAD CHAR
+       TAD MEQ
+       SZA CLA         /AFTER ALL DELETIONS, MUST FIND A "="
+       JMP I [SYNTAX   /IF NOT, WARN THE GUY
+       JMS INS         /IF FOUND IT, NOW PERFORM INSERTIONS
+       JMP I [CONFIG   /THE GUY HAS BEEN HUMORED
+
+INSERT,        JMS INS
+TSTEOL,        TAD CHAR        /THERE SHOULDN'T BE ANYTHING AFTER EOC
+       SNA CLA
+       JMP I [CONFIG   /THERE WASN'T
+       JMP I [SYNTAX   /WARN BLOKE ABOUT EXTRA STUFF
+
+DELETE,        JMS I (DEL      /DELETE PERMANENT NAMES SPECIFIED
+       JMP TSTEOL
+
+SYSTEM,        JMS INS         /SYS IS SAME AS INSERT
+       GET
+       SYSBIT
+       RTL
+       SPA SZL CLA     /BUT SYSBIT OR CORES SHOULD BE ON
+       JMP TSTEOL      /JUST TO HUMOR IT'S NAME
+TWOSYS,        JMS I [PRWD     /AND FOR COMPATIBILITY REASONS
+       TEXT    /?SYS/
+       JMP I [CONFIG
+\fINS,  0
+       TAD (STL RAR
+       DCA I (ACTION   /SET 'ACTION' FOR INSERTIONS
+       JMS I [TSTNAM   /LOOK FOR A NAME
+       JMS I [GRPNAM   /GET GROUP NAME
+       JMS SAVNAM
+       JMS I [TEST
+MEQ,   -"=;ACT
+       -",;INSNAM
+       -":;INSNAM
+       4000;ACT
+       0
+INSNAM,        JMS I [TSTNAM   /GRAB A NAME
+INSGN, JMS I [BIGNAM   /GET PERMANENT NAME WITH SPECIFIED GROUP NAME
+       GET
+       GRPNM1
+       CIA
+       TAD SAV1
+       SZA CLA
+       JMP I [NFOUND   /MAKE SURE PERMANENT NAME FOUND
+       GET             /HAS GROUP NAME PREVIOUSLY SPECIFIED
+       GRPNM2
+       CIA
+       TAD SAV2
+       SZA CLA
+       JMP I [NFOUND
+ACT,   JMS I (SETACT   /SET ACTIVE BIT
+COM,   JMS I [TEST
+       -"-;HYPH
+       -",;INSNAM
+       -"=;INPLAT
+       0
+       JMP I INS
+\fINPLAT,       JMS I [GETNUM   /AN "="
+       JMP I [SYNTAX
+       TAD SIZE
+       SNA CLA
+       JMP I [BADARG   /=0 ILLEGAL
+       GET
+       MAXPLT
+       AND [7          /GET MAXIMUM # OF PLATTERS ALLOWED
+       SNA
+       IAC             /0 MEANT 1
+       CMA CLL
+       TAD SIZE        /COMPARE WITH USER'S REQUEST
+       SZL CLA         /IS HIS REQUEST OKAY?
+       JMP BADPLT      /REQUEST-SHMEST.  TOO MANY PLATTERS
+       TAD SIZE
+       JMS I [ROTR
+       DCA SIZE
+       GET
+       PLATNUM
+       AND (6177
+       TAD SIZE        /STORE AWAY HIS STATED NUMBER OF PLATTERS
+       PUT             /FOR FUTURE USE BY 'BOOT'
+       PLATNUM
+       JMP COM         /REJOIN PROCESSING
+
+BADPLT,        JMS I [PRWD
+       TEXT    /?PLAT/
+       JMP I [CONFIG
+\fSAVNAM,       0
+       TAD NAME1
+       DCA SAV1        /SAVE GROUP NAME
+       TAD NAME2
+       DCA SAV2
+       JMP I SAVNAM
+
+HYPH,  TAD NAME2
+       AND [77
+       CIA
+       DCA DETEM
+       GETCHR
+       AND [77
+       TAD DETEM       /GET CHAR AFTER HYPEN
+       SNA CLA         /REACHED IT YET?
+       JMP IGET        /YES, WELL TRY FOR MORE STUFF
+       BAKCHR          /NO, PUT IT BACK FOR FUTURE USE
+       ISZ NAME2       /FORM NEXT SEQUENTIAL NAME
+       JMP INSGN       /GO INSERT IT
+/DO WE REALLY HAVE TO START SEARCH AT CURRENT DESCR?
+
+DETEM, 0
+
+IGET,  GETCHR
+       DCA CHAR
+       JMP COM
+
+NODEV, JMS I [PRWD
+       TEXT    /?DEVICE/
+       JMP I [CONFIG
+       PAGE
+\fINTEM,
+SETACT,        0
+       GET
+       ACTIVE          /GET ACTIVATION BIT
+       RAL
+ACTION,        STL RAR         /ACTIVATE IT (SET TO 'CLL RAR' TO DEACT)
+       PUT
+       ACTIVE          /RESTORE
+       JMP I SETACT
+
+DEL,   0
+       TAD (CLL RAR
+       DCA ACTION
+DELNAM,        JMS I [TSTNAM   /PARSE OFF A NAME
+DELGN, JMS I [ACTNAM   /FIND IT AS AN ACTIVE PERMANENT NAME
+       JMS SETACT      /DEACTIVATE IT
+       GET
+       PLATNUM
+       AND [6177       /SET # OF PLATTERS TO 0
+       PUT
+       PLATNUM
+DCOM,  JMS I [TEST
+       -"-;DHYPH
+       -",;DELNAM
+       0
+       JMP I DEL
+
+DHYPH, TAD NAME2
+       AND [77
+       CIA
+       DCA INTEM
+       GETCHR
+       AND [77
+       TAD INTEM
+       SNA CLA         /REACHED FINAL NAME?
+       JMP DGET        /YES
+       BAKCHR          /NO, PUT FINAL LETTER BACK
+       ISZ NAME2       /YES, BUMP TO NEXT NAME
+L0423, 423
+       JMP DELGN       /DELETE NEXT ONE IN SUCCESSION
+\fDGET, GETCHR
+       DCA CHAR
+       JMP DCOM
+
+TTYIN, 0               /TTY INPUT ROUTINE
+       KSF
+       JMP .-1
+       KRB
+       SNA             /LOW LEVEL BLANK IGNORE
+       JMP TTYIN+1
+       AND [177        /HANDLE PARITY
+       TAD [200
+       DCA CHAR
+       JMP I TTYIN
+\f/DSK=ACTIVE PERMANENT NAME
+/DSK=GROUPNAME:PERMANENT NAME
+/DSK=<CR>      MEANS NO DSK SPECIFIED, USE 'SYS'
+
+/JUST REMEMBERS NAME (NOTHING ELSE)
+
+DSK,   JMS I [GNAME    /GET A NAME
+       TAD NAME1
+       SNA CLA
+       JMP NODSK
+       TAD CHAR
+       SNA
+       JMP NOCOL
+       TAD [-":
+       SZA CLA         /IS IT FOLLOWED BY A ":"?
+       JMP I [SYNTAX   /NO, ASSUME HE'S GIVING AN ACTIVE PERMANENT NAME
+                       /THIS IS FOR COMPATIBILITY WITH OLD BUILD
+/      JMS I [GRPNAM   /YES, ITS A GROUP NAME
+       TAD NAME1       /SAVE IT
+       DCA DSKG1
+       TAD NAME2
+       DCA DSKG2
+       JMS I [TSTNAM   /GET PERMANENT NAME
+PN,    TAD NAME1
+       DCA DSKP1       /DON'T WORRY NOW IF IT'S AROUND
+       TAD NAME2
+       DCA DSKP2
+       TAD CHAR
+       SZA CLA
+       JMP I [SYNTAX
+       JMP I [CONFIG
+
+NODSK, DCA DSKG1       /FIRST WORD 0 MEANS NONE SPECIFIED
+       JMP I [CONFIG
+
+NOCOL, JMS I [ACTNAM   /IT MUST BE AN ACTIVE HANDLER
+       GET
+       GRPNM1
+       DCA DSKG1
+       GET
+       GRPNM2
+       DCA DSKG2
+       JMP PN
+\fSETDSK,       TAD L0423       /DS
+       DCA I (DVNM1
+       TAD (1300       /K
+       DCA I (DVNM1+1
+       JMP I (GETU
+
+KICKM, CIF 10          /RELEASE MONITOR AND RELOAD
+       JMS I [200      /OUR DEVICES
+       11
+       JMP I [NFOUND
+
+GETUSR,        0
+       CIF 10
+       JMS I [7700     /LOCK IN MONITOR
+       10
+       CIF 10          /RESET RESIDENT HANDLER TABLE
+       JMS I [200
+       13
+       JMP I GETUSR
+\f/     CODE FOR USING INTERNAL HANDLERS ON STANDALONE LOAD:
+
+BLDLOD,        DCA I (FILPTR   /LOAD DEV
+       JMS I [ACTNAM   /MUST BE ACTIVE
+       JMS I [GETPG
+       DCA HNDLOK      /LOCATION OF HANDLER
+       TAD [-400
+       JMS I [MOVE
+       CDF 10
+HNDLOK,        HLT
+       CDF 0
+PBUFFER,BUFFER
+       GET
+       DCB
+       DCA BLDCB
+       GET
+       ENTPT
+       AND [177
+       TAD PBUFFER     /GET ENTRY POINT OF HANDLER
+       JMP I (LOADIN
+
+BLDCB, 0               /CONTAINS DCB OF CURRENT LOAD HANDLER
+       PAGE
+\fGETPG,        0
+       GET
+       PAGRES
+       JMS I [ROTR
+       AND [7600
+       JMP I GETPG
+
+/FORMAT:       NAME OLDNAME=NEWNAME
+
+NAME,  JMS TSTNAM      /SEE IF ARGUMENT SUPPLIED
+                       /SEARCH PERMANENT TABLES
+       JMS I [ACTNAM   /GET ACTIVE PERMANENT NAME DESCRIPTOR
+       TAD CHAR
+       TAD MEQL        /CHECK FOR =
+       SZA CLA
+       JMP I [BADARG
+       JMS TSTNAM      /GET NEW DEVICE NAME
+       TAD NAME1       /REPLACE THE NAME
+       PUT
+       PRMNM1
+       TAD NAME2
+       PUT
+       PRMNM2
+       JMP I [CONFIG
+\fEXAMINE,CLA IAC
+ALTER, DCA XSWTCH
+       JMS I [TSTNAM   /ALTER ALLOWS MODS TO A PARTICULAR
+       JMS I [GRPNAM   /HANDLER'S ACTUAL CODE.
+                       /LOOK AT DEVICE TYPE ENTRY
+       JMS GETPG       /GET PAGE OF RESIDENCE
+       DCA PAGAD       /SAVE IT.
+       JMS I [GETNUM   /GET RELATIVE LOC TO ALTER
+       JMP I [SYNTAX   /NO NUMBER
+       GET
+P2PAG, TWOPAG          /IS THIS A 2-PAGE HANDLER?
+       SPA CLA
+       TAD [7600
+       TAD [7600       /ALLOW 200 OR 400 MAXIMUM
+       CLL
+       TAD SIZE        /IS THE # TO ALTER TOO LARGE?
+       SZL CLA
+       JMP I [BADARG   /I GUESS IT IS
+       TAD SIZE
+       TAD PAGAD       /GET ABSOLUTE LOCATION
+       DCA PAGAD
+       TAD XSWTCH
+       SZA CLA         /EXAMINE OR ALTER?
+       JMP EXAM        /EXAMINE
+       TAD CHAR        /ALTER
+       SZA CLA         /CR?
+       JMP GETVAL      /NO
+       JMS EXAMSB      /YES, GIVE GUY  OLD VALUE FIRST
+ODTL,  TAD ["/         /ODT LIKE
+       JMS I [TTYOUT
+       TAD [-100
+       JMS I [GTEXT
+       JMP ODTL
+GETVAL,        JMS I [GETNUM   /GET NEW CONTENTS
+       JMP I (TSTEOL   /NO NUMBER
+       TAD SIZE
+       CDF 10
+       DCA I PAGAD     /REPLACE THAT LOC.
+       JMP I [CONFIG   /AND GET OUT
+PAGAD, 0
+
+/ALTER GROUPNAME,LOC=NEWVALUE
+/ALTER GROUPNAME,LOC
+/EXAMINE GROUPNAME,LOC
+\f/SIZE ACTNAM
+/SIZE ACTNAM=VALUE
+/DCB ACTNAM
+/DCB ACTNAM=VALUE
+/CTL ACTNAM
+/CTL ACTNAM=VALUE
+
+SIZCM, TAD (3          /SIZE COMMAND V3C
+DCBCM, TAD [-1         /EXAMINE DCB WORD
+CTLCM, TAD P2PAG       /EXAMINE CONTROL WORD
+       DCA PUTAT
+       TAD PUTAT
+       DCA LOOKAT
+       JMS I [TSTNAM   /GET A NAME
+       JMS I [ACTNAM   /IT MUST BE ACTIVE
+       JMS I [TEST
+MEQL,  -"=;INPDCB
+       4000;EXAMDCB
+       0
+       JMP I [SYNTAX
+INPDCB,        JMS I [GETNUM
+       JMP I [CONFIG   /IGNORE = NOTHING
+       TAD SIZE
+       PUT
+XSWTCH,                        /0 MEANS ALTER, 1 MEANS EXAMINE
+PUTAT, DCB
+       JMP I [CONFIG   /THE USER LIVES DANGEROUSLY
+
+EXAMDCB,GET
+LOOKAT,        DCB
+       JMS PUTNUM
+       TAD ["/
+       JMS I [TTYOUT
+       TAD [-100
+       JMS I [GTEXT
+       JMP EXAMDCB
+       JMP INPDCB      /NOW PARSE OFF THE REPLY
+\fEXAM, JMS EXAMSB
+       JMP I [CONFIG
+
+EXAMSB,        0
+       CDF 10
+       TAD I PAGAD     /GET CURRENT CONTENTS
+       CDF 0
+       JMS PUTNUM      /PRINT IT
+       JMP I EXAMSB
+
+PUTNUM,        0               /PRINT AN OCTAL NUMBER
+       DCA PTM
+       TAD [-4         /4 DIGITS
+       DCA PKNT
+PLOOP, TAD PTM
+       RTL
+       RTL
+       AND [7
+       TAD (60
+       JMS I [TTYOUT
+       TAD PTM
+       RTL
+       RAL
+       DCA PTM
+       ISZ PKNT
+       JMP PLOOP
+       JMP I PUTNUM
+PTM,   0
+
+PKNT,
+TSTNAM,        0
+       JMS I [GNAME    /COLLECT NAME
+       TAD NAME1       /IF NO NAME FOUND, GIVE ERROR
+       SZA CLA
+       JMP I TSTNAM
+NAMERR,        JMS I [PRWD
+       TEXT    /?NAME/
+       JMP I [CONFIG
+       PAGE
+\f/PRINT FUNCTION TYPES OUT THE STATUS OF BUILD ON COMMAND
+/AN * BESIDE A DEVICE INDICATES THAT IT IS CURRENTLY MARKED
+/FOR INSERTION IN THE SYSTEM BEING BUILT.
+
+TTY240,
+PRINT, STA
+       DCA OLDPAG      /SET ILLEGAL OLD PAGE
+       INIT
+       ISZ I (LINEUP   /MAKE THINGS LINE UP
+PRLUP, ADVDSC          /ADVANCE TO NEXT DESCRIPTOR
+       ADVBOT          /ADVANCE PAST A BOOTSTRAP (IF ANY)
+       JMP DONE        /ALL DONE
+       JMS I [GETPG    /GET PAGE OF NEW HANDLER
+       DCA NEWPAG
+       TAD NEWPAG
+       CIA
+       TAD OLDPAG      /COMPARE WITH LAST HANDLER'S PAGE
+       SNA CLA         /SAME?
+       JMP PRTPER      /YES
+       JMS I [CRLF     /NO, GO TO NEXT LINE
+       TAD NEWPAG
+       DCA OLDPAG
+       JMS PGNAME
+       TAD TTY240
+       JMS I [TTYOUT
+PRTPER,        GET             /GET ACTIVE BIT
+       ACTIVE
+       SPA CLA         /IS IT ACTIVE?
+       TAD ("*-STA     /YES, PRINT *
+       TAD TTY240      /NO, PRINT SPACE
+       JMS I [TTYOUT
+       JMS PNAME       /PRINT PERMANENT NAME
+       JMP PRLUP
+
+PGNAME,        0
+       GET
+       GRPNM1
+       JMS I (PRINTE   /PRINT GROUP NAME
+       GET
+       GRPNM2
+       JMS I (PRINTE
+       TAD (":
+       JMS I [TTYOUT
+       JMP I PGNAME
+\fDONE, DCA I (LINEUP   /NO MORE LINE-UP
+       TAD DSKG1
+       SNA CLA
+       JMP TELCOR
+       JMS I [CRLF     /TELL GUY ABOUT 'DSK'
+       JMS I [CRLF
+       JMS I [PRWD
+       TEXT    /DSK=/
+       TAD DSKG1
+       JMS I (PRINTE
+       TAD DSKG2
+       JMS I (PRINTE
+       TAD (":
+       JMS I [TTYOUT
+       TAD DSKP1
+       JMS I (PRINTE
+       TAD DSKP2
+       JMS I (PRINTE
+TELCOR,        TAD NEWCOR
+       SNA
+       JMP I [CONFIG   /NO SPECIFIED CORE LIMIT
+       JMS I [ROTL
+       TAD (6000
+       DCA CORMSG+3
+       JMS I [CRLF
+       JMS I [PRWD
+CORMSG,        TEXT    /CORE= /
+       JMP I [CONFIG
+\f/QUICK PRINT
+
+QLIST, INIT
+QLUP,  ADVDSC          /ADVANCE TO NEXT DESCRIPTOR
+       ADVBOT          /ADVANCE OVER ANY BOOTSTRAP IF NECESSARY
+       JMP DONE        /GO AWAY WHEN NO MORE
+       GET
+       ACTIVE          /GET ACTIVE BIT
+       SMA CLA         /IS IT ACTIVE?
+       JMP QLUP        /NO, IGNORE IT
+       GET             /YES
+       SYSBIT
+       RAL
+       SPA CLA         /IS IT 'SYS'?
+       JMS PGNAME      /YES, PRINT GROUP NAME TOO
+       JMS PNAME       /NO, PRINT PERMANENT NAME ONLY
+       JMP QLUP
+
+DT,
+PNAME, 0
+       GET
+       PRMNM1
+       JMS I (PRINTE
+       GET
+       PRMNM2
+       JMS I (PRINTE
+       TAD TTY240
+       JMS I [TTYOUT
+       JMP I PNAME
+\f      DCBTBL=7760
+
+WHAT,  JMS I [PRNAME
+       JMS I [PRWD
+       TEXT /?/        /FOR WHEN A COMMAND ERROR OCCURS
+       JMP I [CONFIG
+
+
+DTYPE, 0               /RETURNS TYPE OF OUTPUT
+       TAD (DCBTBL-1
+       DCA DT          /ENTRY AC HAD DEVICE #
+       CDF 10
+       TAD I DT        /IF FILE DEVICE, LINK=0
+       CDF 0
+       CMA RAL         /ALSO, IF FILE AC=0 ON EXIT
+       CLA RAL
+       JMP I DTYPE
+\fWRITCC,       0
+       TAD [-6         /PUT IN DATA BREAK FILLERS
+       JMS I [MOVE
+       CDF 0
+       K7750
+       CDF 0
+       PG7600+200+150
+       TAD (4200
+       JMS I [SYS      /WRITE NEW CCB
+       BLDCCB-200
+       37
+       JMP I WRITCC
+       PAGE
+\fTOOMANY,JMS I [PRWD
+       TEXT    /?HANDLERS/
+       JMP I [CONFIG
+
+BADLOD,        JMS I [CRLF
+       JMS I [PRWD
+       TEXT    /?BAD LOAD/
+       DCA I TABLMT    /RESTORE SENTINEL 0
+       JMP I [CONFIG
+\fTEST, 0               /TEST CHAR AGAINST ARGUMENTS
+       TAD I TEST      /PICK UP ARGUMENT FROM LIST
+       SNA             /0 TERMINATES
+       JMP I TEST
+       TAD CHAR        /SEE IF THEY COMPARE =
+       AND (3777       /COMPARE ONLY LOW ORDER, THUS ALLOWING '4000' TO MEAN '0'
+       SNA CLA
+       JMP TSTOVR      /THEY DO..DISPATCH TO TABLE
+       ISZ TEST
+       ISZ TEST
+       JMP TEST+1      /THEY DON'T. KEEP GOING
+TSTOVR,        ISZ TEST
+       TAD I TEST
+       DCA TEMP
+       JMP I TEMP
+
+K7750, 7750            /DATA BREAK FILLERS
+       7751
+       7752
+       7753
+       7754
+       7755
+
+SYS,   0               /SAVES A FEW WORDS IN SYSTEM CALLS
+       DCA SYCTL       /SAVE FUNCTION WORD
+       TAD I SYS
+       DCA SYBUF       /BUFFER BEING USED
+       ISZ SYS
+       TAD I SYS
+       DCA SYREC       /RECORD #
+       ISZ SYS         /THERE IS NO ERROR RETURN
+/IF SWAPER SET AND BOOTDV SET, USE SPECIAL BOOT HANDLER HERE
+GO,    JMS I SYSENT
+SYCTL, 0
+SYBUF, 0
+SYREC, 0
+       SKP CLA
+       JMP I SYS
+       JMS I [PRWD
+       TEXT    /SYS ERR/
+       HLT             /IF USER IS DARING, HIT CONTINUE TO RETRY
+       JMP GO
+
+SYSENT,        7607
+\f/*****************
+/
+/      SYS HANDLER IS 2-PAGES LONG IF LOCATION 7612 IS A 3
+/
+/******************
+
+CLRTBL,        0
+       TAD [BEGLIN
+       DCA XR1
+       TAD [-200       /ZERO OUT 5200-5377
+       DCA TMP1
+       DCA I XR1
+       ISZ TMP1
+       JMP .-2
+       JMP I CLRTBL
+
+/FOR HANDLER ONLY
+ORGLIM,        0               /THIS ROUTINE MAKES CERTAIN THAT
+       DCA CLRTBL      /THE ORIGIN FOR LDABS IS WITHIN
+       TAD CLRTBL      /THE BOUNDS SPECIFIED BY SIZE
+       TAD [7600       /AND THE CONTENTS OF HNDPTR
+       SPA
+       JMP BADORG      /ORIGIN BELOW 200
+       CIA
+       TAD [400        /IS ORIGIN WITHIN UPPER BOUND?
+       SPA CLA
+       JMP BADORG
+       TAD CLRTBL
+       TAD [7600       /NOW GIVE BACK RELATIVE BUFFER
+       TAD HNDPTR      /ADDRESS IN FIELD 1
+       DCA CLRTBL
+       TAD CLRTBL
+       AND [7600
+       TAD [200
+       SNA CLA
+       JMP I (NOROOM   /CAN'T 'ORIGIN' INTO PAGE 7600
+       TAD CLRTBL
+       JMP I ORGLIM
+
+BADORG,        JMS I [PRWD
+       TEXT /?ORIGIN/
+       JMP I (OVROUT
+
+/SOMEWHERE TEST IF HE GAVE US A 2-PAGE BUT REQ A 1-PAGE
+\f/     PG7600_0
+/      BLOK66_66
+/      IF OLD SYS WAS 1 PAGE, BLOK66/L_PG7600/L
+
+RECZRO,        0               /READS FIELD 1 CODE, EVEN FOR 12K TD8E
+       TAD [200
+       JMS I [SYS      /READ RECORD 0
+       PG7600
+       0               /THAT NORMALLY CONTAINS FIELD 1
+       TAD (210
+       JMS I [SYS      /READ RECORD 66
+       BLOK66
+       66
+       TAD FLAG2       /DID PREVIOUS SYSTEM HAVE A 2-PAGE HANDLER?
+       SZA CLA
+       TAD [-200       /NO
+       JMS I [MOVE     /YES
+       CDF 0
+       PG7600
+       CDF 10
+       BLOK66
+       JMP I RECZRO
+
+NOTNUF,        JMS I [PRWD
+       TEXT    /?CORE/
+       JMP I [CONFIG
+       PAGE
+\fUNLOAD,       JMS I [TSTNAM   /PULL OFF A NAME
+       JMS I [GRPNAM   /IT HAD BETTER BE A GROUP NAME
+       JMS I [TEST
+       -":;UNLPRM
+       4000;UNLGRP
+       0
+       JMP I [SYNTAX
+
+UNLPRM,        JMS I (SAVNAM   /UNLOAD PARTICULAR HANDLER
+UNLNAM,        JMS I [TSTNAM
+       JMS I [BIGNAM
+       TAD DSCPTR      /DELETE A SINGLE DESCRIPTOR
+       DCA SAVPTR      /DON(T DELETE HANDLER
+       TAD DSCPTR      /OR BOOTSTRAP
+       TAD [HDRSIZ     /NO RELOCATION NECESSARY
+       DCA LSTPTR
+       TAD TABLMT
+       JMP NOMOR
+\fUNLGRP,       JMS I [GETPG    /GET PAGE OF RESIDENCE
+       DCA TOMOV       /START OF HANDLER
+       GET
+       TWOPAG          /IS IT A 1- OR 2- PAGE HANDLER?
+       SPA CLA
+       TAD [200        /2 PAGE
+       TAD [200        /1 PAGE
+       DCA UNSIZE
+       TAD TOMOV       /DELETE HANDLER AND MOVE ALL FOLLOWING DOWN
+       TAD UNSIZE
+       DCA FROMOV      /GET FIRST LOCATION AFTER HANDLER
+       TAD HNDPTR      /GET NEXT FREE LOCATION FOR HANDLER
+       CIA
+       TAD FROMOV      /GET NUMBER OF LOCS TO MOVE
+       JMS I [MOVE
+       CDF 10
+FROMOV,        0
+       CDF 10
+TOMOV, 0               /UPDATE POINTERS; SEARCH DESCRIPTORS
+       TAD UNSIZE      /FOR REFS TO MOVED HANDLERS AND DECREASE
+       CIA             /THOSE REFS BY -UNSIZE
+       TAD HNDPTR
+       DCA HNDPTR      /FREES SOME BUFFER SPACE
+       TAD TABLMT
+       DCA OLDTOP      /REMEMBER ORIGINAL TOP OF STACK
+       STA             /BACK UP OVER GROUP COUNT
+       TAD DSCPTR
+       DCA SAVPTR      /REMEMBER THIS LOCATION
+       TAD UNSIZE
+       JMS I [ROTL
+       CIA
+       DCA UNSIZE
+       TAD DSCPTR
+       TAD [HDRSIZ
+       DCA LSTPTR      /'LSTPTR' POINTS TO FIRST DESCRIPTOR BEING MOVED
+\f/COMPRESS THE DESCRIPTORS ABOVE THIS ONE
+
+ADV,   ADVDSC          /ADVANCE TO NEXT DESCRIPTOR
+       JMP BADV        /ENCOUNTERED A BOOTSTRAP RECORD
+       JMP NOMORE      /NO MORE, THROUGH
+GT,    JMS I [GETPG    /GET PAGE OF THIS DESCRIPTOR
+       CLL CIA
+       TAD TOMOV       /COMPARE WITH PAGE OF DELETED HANDLER
+       SNA CLA
+       JMP SAMPAG      /THEY'RE THE SAME
+       SZL             /THEY'RE NOT THE SAME.  WHICH IS HIGHER?
+       JMP ADV         /IT WAS BELOW HANDLER.  NO SWEAT.
+       GET             /IT WAS ABOVE HANDLER, HAVE TO ACCOUNT FOR THIS
+       PAGRES          /POINT TO NEW HANDLER LOCATION
+       TAD UNSIZE
+       PUT
+       PAGRES
+       JMP ADV         /CONTINUE
+SAMPAG,        TAD [HDRSIZ
+       TAD DSCPTR
+       DCA LSTPTR      /NOTE LOCATION OF NEXT DESCRIPTOR
+       JMP ADV
+/ADVANCE PAST BOOTSTRAP OR DELETE IT AS NECESSARY
+BADV,  TAD DSCPTR
+       CIA
+       TAD LSTPTR
+       SZA CLA         /IS THIS BOOT PART OF GROUP BEING UNLOADED?
+       JMP BDV         /NO
+       TAD I DSCPTR    /YES
+       CIA
+       IAC
+       TAD DSCPTR
+       DCA LSTPTR      /SET 'LSTPTR' TO BEGIN OF NEXT DESCRIPTOR
+BDV,   ADVBOT          /ADVANCE OVER BOOTSTRAP
+       JMP NOMORE      /DONE
+       JMP GT          /GO ON TO NEXT DESCRIPTOR
+\f/ALL DESCRIPTORS FOR THE SAME HANDLER ARE CONSECUTIVE
+/MOVE DOWN DESCRIPTORS
+
+NOMORE,        TAD OLDTOP
+NOMOR, CIA
+       TAD LSTPTR      /MINUS # OF WORDS TO MOVE
+       JMS I [MOVE
+       CDF 0
+LSTPTR,        0               /FIRST DESCRIPTOR NOT CONSIDERED
+       CDF 0
+SAVPTR,        0               /POINTS TO INITIAL DESCRIPTOR BEING DELETED
+       TAD LSTPTR
+       CIA
+       TAD SAVPTR      /GET NUMBER OF WORDS DELETED
+       TAD TABLMT
+       DCA TABLMT      /UPDATE TABLMT
+       DCA I TABLMT    /MUST HAVE 0 AT TABLE END SO DON'T THINK IT'S A BOOTSTRAP
+       JMS I [COMMA
+       JMP UNLNAM
+
+OLDTOP,                        /ORIGINAL TOP OF DESCRIPTORS
+INI,   0
+       TAD (DSCTAB-HDRSIZ
+       DCA DSCPTR
+       JMP I INI
+
+       INIT=JMS I [INI
+
+/RETURN TO CONFIG IF EOL, OR BACK IN-LINE IF COMMA
+
+UNSIZE,
+COMMA, 0
+       TAD CHAR
+       SNA
+       JMP I [CONFIG
+       TAD (-",
+       SNA CLA
+       JMP I COMMA
+       JMP I [SYNTAX
+\fBOOTQ,        SZA CLA         /MAY BE OVERLAID
+       JMP SAMEE
+       DCA I (DRECT    /DON'T TOUCH DIRECTORY IF DIDN'T COPY SYS
+SAMF,  JMS I [SYSWP
+       JMP I (BOOT4
+SAMEE, JMS I (SYSCPY   /OR IF OLD DEV=NEW DEV
+       JMP SAMF
+       PAGE
+\fLOCSYS,       0
+       TAD (2331       /"SY"
+       DCA NAME1
+       TAD (2300       /"S "
+       DCA NAME2
+       DCA NAME3       /V3C
+       DCA NAME4
+       JMS I [ACTNAM   /LOOK UP 'SYS'
+       JMP I LOCSYS
+
+NOSLOT,        JMS I [PRWD
+       TEXT    /?SLOTS/
+       JMP I [CONFIG
+
+GOOD,  0
+       TAD [4207       /RESTORE 7600 TO NORMAL
+       DCA I [7600
+       TAD [5000
+       DCA I [7601
+       TAD (CDF CIF
+       DCA I [SA       /SET SA=00200
+       TAD [200
+       DCA I (SA+1
+       DCA I (JSW      /SET JOB STATUS WORD=0
+       STA
+       DCA I (DRECT
+       CLL STA RTL     /-3
+       TAD I [7612     /FUDGE FOR 12K TD8E
+       DCA FLAG2       /SET FLAG2=0 IF PREV SYSTEM WAS 2 PAGE
+       JMP I GOOD
+\fPACK, ISZ PROTECT     /OK TO PACK IT?
+       JMP PACKOK      /YES
+       STA
+       DCA PROTECT     /INHIBIT OTHER PACKS ALSO
+       JMP GNAME2
+PACKOK,        ISZ SWIT        /PACK LEFT OR RIGHT
+       JMP RIGHT
+       TAD CHAR
+       AND [77
+       JMS I [ROTL     /ROTATE 6 LEFT
+       DCA I TEMP      /STORE THE CHARACTER
+       JMP GNAME2
+RIGHT, CLA CMA         /RESET FLIP FLOP
+       DCA SWIT
+       TAD CHAR
+       AND [77
+       TAD I TEMP
+       DCA I TEMP
+       ISZ TEMP        /POINT TO NEXT WORD
+       JMP GNAME2
+PROTECT,0              /-1 MEANS DON'T ACCEPT CHAR, IGNORE IT
+SWIT,  0
+\fDOT,  CLA CMA
+       DCA SWIT
+       TAD (-3         /NOW ALLOW ONLY A 2-CHAR EXTENSION
+       DCA PROTECT
+       TAD (NAME4
+       DCA TEMP
+       ISZ DOTCNT      /HAD WE SEEN A DOT BEFORE?
+       JMP SYNTAX      /YES
+       JMP GNAME2      /NO
+
+DOTCNT,        -1              /-1 MEANS HAVEN'T SEEN A DOT
+
+EOL,   DCA CHAR
+       JMP I GNAME
+
+GNAME, 0               /COLLECT A WORD IN NAME1-NAME4
+                       /LEAVE DELIMITING CHAR IN 'CHAR'
+       CDF 0
+       TAD [-7         /MAX 6 CHARACTERS
+       DCA PROTECT
+       DCA NAME1       /FIRST CLEAR OUT COLLECTION AREA
+       DCA NAME2
+       DCA NAME3
+       DCA NAME4
+       CLA CMA
+       DCA SWIT        /L-R PACKING SWITCH
+       STA
+       DCA DOTCNT      /ALLOW ONLY ONE DOT PER NAME
+       TAD (NAME1
+       DCA TEMP
+GNAME2,        GETCHR
+       SNA             /A 0 ENDS THE SEARCH
+       JMP EOL
+       DCA CHAR
+       TAD CHAR
+       TAD (-"A        /GET ONLY A-Z OR 0-9
+       CLL
+       TAD ("A-"Z-1
+       SNL CLA         /IS IT A-Z?
+       JMP PACK        /YES..PACK IT AWAY
+       TAD CHAR
+       TAD (-"0
+       CLL
+       TAD ("0-"9-1
+       SNL CLA
+       JMP PACK        /FOUND 0-9
+       JMS I [TEST     /TEST FOR DELIMITING CHARS
+       -".;DOT         /ADVANCE POINTERS
+       0
+       JMP I GNAME
+\fSYNTAX,       JMS I [PRWD
+       TEXT /?SYNTAX/
+       JMP I [CONFIG
+
+DSKBAD,        JMS I [PRWD
+       TEXT    /?DSK/
+       JMP I [CONFIG
+\f      SRES=BEGLIN+60  /RESIDENCY TABLE
+       SDCB=BEGLIN+100 /DCB
+       SHND=BEGLIN+120 /SLOT ASSSIGNED?
+       SNAME=BEGLIN+140/NAME
+       SBUFF=BEGLIN+160/ADDRESS OF HANDLER
+
+
+/      SYSTEM TABLES:
+
+/THOSE IN USR:
+
+/PDNT  PERMANENT DEVICE NAME TABLE     (SNAME)
+/      POINTED TO BY LOCATION 10036 IN USR
+/      CONTAIN HASH CODE OF DEVICE NAME
+/      ADD TWO WORDS OF NAME TOGETHER AND TURN ON BIT 0
+/      IF SECOND WORD WAS NON-ZERO
+/      AN ENTRY OF 0 MEANS THERE IS NO DEVICE FOR THAT ENTRY
+
+/DHIT  DEVICE HANDLER INFORMATION TABLE        (SHND)
+/      POINTED TO BY LOCATION 10037 IN USR
+/      BIT 0           =1 IF THIS IS A TWO-PAGE HANDLER
+/      BITS 1-4        RELATIVE BLOCK LOCATION OF HANDLER ON SYSTEM DEVICE
+/                      (BLOCK SLOT).  ADD 15 TO GET ACTUAL BLOCK #.
+/      BITS 5-11       RELATIVE ENTRY POINT OF HANDLER
+
+
+/DHRT  DEVICE HANDLER RESIDENCY TABLE  (SRES)
+/      IN LOCATIONS 17647-17665
+/      ACTUAL ENTRY POINT OF HANDLER
+/      WE ONLY CARE ABOUT IT IF THE HANDLER IS RESIDENT.
+/      OTHERWISE IT'S ZERO.
+/      THE SYSTEM HANDLER AND ALL HANDLERS CORESIDENT WITH
+/      IT ARE ALWAYS RESIDENT IN CORE AND HAVE THIS ENTRY NON-0.
+
+
+/DCWT  DEVICE CONTROL WORD TABLE       (SDCB)
+/      RESIDES IN LOCATIONS 17760-17776
+/      BIT 0           1 IF DEVICE IS FILE STRUCTURED
+/      BIT 1           1 IF THE DEVICE IS READ ONLY
+/      BIT 2           1 IF THE DEVICE IS WRITE-ONLY
+/      BITS 3-8        PHYSICAL DEVICE TYPE
+/      BITS 9-11       DIRECTORY BLOCK # (WE SET TO 0)
+\f/PRE-ASSIGNED DEVICE TYPES
+
+/0     TELETYPE
+/1     HIGH SPEED PAPER TAPE READER
+/2     HIGH SPEED PAPER TAPE PUNCH
+/3     CARD READER
+/4     LINE PRINTER (ANY TYPE)
+/5     RK8 DISK
+/6     RF08 (1 PLATTER)
+/7     RF08 (2 PLATTERS)
+/10    RF08 (3 PLATTERS)
+/11    RF08 (4 PLATTERS)
+/12    DF32 (1 PLATTER)
+/13    DF32 (2 PLATTERS)
+/14    DF32 (3 PLATTERS)
+/15    DF32 (4 PLATTERS)
+/16    TC08 DECTAPE
+/17    LINCTAPE
+/20    TM8E MAGTAPE
+/21    TD8E DECTAPE (12K OR ROM)
+/22    BAT:
+/23    RK8E DISK
+/27    TU60 CASSETTES
+/30    VR12 (PDP-12 SCOPE)
+       PAGE
+\fBOOT2A,       TAD (15
+       DCA SLOT        /START ASSIGNING AT BLOCK SLOT 16 (16-25)
+       TAD (-17        /ALLOW 16 ACTIVE HANDLERS NOT COUNTING DSK
+       DCA COUNT
+       JMS I (CLRTBL   /CLEAR OUT IN-CORE TABLES
+       TAD (SHND+1     /ASSIGN SLOTS, COUNT ACTIVE HANDLERS
+       DCA XR1         /XR1 POINTS TO SLOT TABLE (DHIT)
+       TAD (SDCB+1
+       DCA XR2         /XR2 POINTS TO DCB TABLE
+       TAD (SNAME+1
+       DCA XR3         /XR3 POINTS TO PERMANENT DEVICE NAME TABLE
+       TAD (SBUFF+1
+       DCA XR4         /XR4 POINTS TO HANDLER BUFFER ADDRESSES
+       TAD (SRES+1
+       DCA XR5         /XR5 POINTS TO RESIDENCY TABLE
+       CLA IAC         /??
+       DCA OLDPAG      /SET 'OLDPAG' TO A RIDICULOUS VALUE
+       INIT
+SLTLUP,        ADVDSC          /GO TO NEXT DESCRIPTOR
+       ADVBOT          /ADVANCING OVER ANY BOOTSTRAPS
+       JMP BOOT2X      /ALL DONE CREATING INTERNAL COPIES OF TABLES
+       GET
+       ACTIVE
+       SMA CLA         /IS IT ACTIVE?
+       JMP INACT       /NO
+       ISZ COUNT       /YES, UPDATE COUNT
+       JMP ACTIV
+       JMP I (TOOMANY  /TOO MANY ACTIVE HANDLERS
+
+BOOT2X,/       TAD I (SNAME    /SEE IF SYS WAS SPECIFIED
+/      DCA SAMSYS      /0 IF DIDN'T SPECIFY NEW SYS
+/      TAD SAMSYS
+/      SZA CLA
+/      JMP CHKDSK
+/      CDF 10
+/      TAD I (7760     /DIDN'T SPECIFY SYS SO USE CURRENT SYS
+/      CDF 0
+/      DCA I (SDCB
+/      TAD (7607
+/      DCA I (SRES
+/CHKDSK,       TAD DSKG1       /WAS DSK SPECIFIED?
+/      SZA CLA
+/      JMP I (BOOT3    /YES, ALREADY SET UP
+/      TAD I (SDCB
+/      DCA I (SDCB+1
+/      TAD (7607
+/      DCA I (SRES+1
+/      DCA I (SBUFF+1
+       JMP I (BOOT3
+\fCHKRES,       0
+       JMS I [GETPG    /GET PAGE OF RESIDENCE
+       DCA NEWPAG
+       TAD NEWPAG
+       TAD OLDPAG
+       SNA CLA         /SAME OR PREVIOUS PAGE?
+       JMP I CHKRES    /YES, SAME PAGE
+       ISZ CHKRES
+       GET             /NO, A NEW PAGE, NEEDS NEW SLOT, ETC.
+       CORES
+       RTL             /GET CORES BIT
+       SPA CLA         /IS THIS ALLOWED TO START A NEW GROUP?
+       JMP I (TWOSYS   /NO, IT MAY ONLY BE CORESIDENT WITH SOMETHING EARLIER
+       TAD NEWPAG      /YES
+       CIA
+       DCA OLDPAG      /GOT NEW 'OLDPAG'
+       JMP I CHKRES
+\fACTIV,        JMS CHKRES
+       JMP SAMPG
+       GET
+       SYSBIT
+       RAL
+       SPA CLA         /IS IT A 'SYS' HANDLER?
+       JMP I (SETSY    /YES
+       JMS I (GETSLOT  /NO
+       JMS I (SETSLT   /SET BLOCK SLOT
+       DCA I XR1
+       TAD NEWPAG
+HNDLOC,        DCA I XR4       /STORE AWAY ADDRESS OF HANDLER (OR 0 IF PREVIOUSLY USED)
+       JMS I (GETDCB
+       DCA I XR2       /SET DCB
+       GET             /HASH CODE NAME
+       PRMNM2
+       DCA TEMP        /SAVE 2ND WORD
+       GET
+       PRMNM1
+       TAD TEMP        /ADD 2 WORDS
+       DCA TMP1        /SAVE SUM
+       TAD TEMP
+       SNA CLA         /WAS 2ND WORD 0?
+       JMP NO4C        /YES
+       TAD TMP1        /NO, FORCE BIT 0 ON
+       RAL
+       STL RAR
+       DCA TMP1
+NO4C,  TAD TMP1        /TAKE CODED NAME
+       DCA I XR3       /SET PERMANENT NAME TABLE
+       GET
+       CORES
+       RTL             /GET CORESIDENT BIT
+       SMA CLA         /IS IT RESIDENT?
+       JMP NORE        /NO
+       GET             /YES
+       ENTPT           /GET RELATIVE ENTRY POINT
+       AND [177
+       TAD [7600       /CORESIDENT ENTRY POINTS TO SYS MUST BE ON PAGE 7600
+NORE,  DCA I XR5       /SET RESIDENCY TABLE
+INACT, GET             /BUT MAYBE IT'S 'DSK'
+       DSKBIT
+       RTL
+       SNL CLA         /IS IT DSK?
+       JMP SLTLUP      /NO, IT'S TO BE IGNORED
+       JMS I (SLOTDSK  /YES ASSIGN 'DSK''S LOCATION SLOT
+       GET             /GET RID OF DSK BIT
+       DSKBIT
+       RTL
+       CLL RTR
+       PUT
+       DSKBIT
+       JMP SLTLUP      /REITERATE
+\fSAMPG,        TAD SLOT        /ALREADY HAVE SLOT
+       JMS I (SETSLT
+       DCA I XR1
+       JMP HNDLOC
+
+BADARG,        JMS I [PRWD
+       TEXT    /?ARG/
+       JMP I [CONFIG
+       PAGE
+\f/     STEPS IN BOOTSTRAPPING:
+
+/1.    ASSIGN DSK, IF SPECIFIED, MAKE SURE NFS         [BOOT2]
+/2.    ASSIGN SLOTS                                    [BOOT2A]
+/3.    GIVE ERROR IF TOO MANY ACTIVE OR TOO MANY SLOTS [BOOT2A]
+/4.    BUILD INTERNAL COPIES OF DCB, SLOT, NAME, RES   [BOOT2A]
+/5.    ALSO BUILD HANDLER ADDRESS TABLE, CONTAINS      [BOOT2A]
+/      HANDLER ADDRESS IF NOT PREVIOUSLY WRITTEN OUT
+/6.    COMPARE DCB'S OF NEW AND OLD SYSTEM, IF DIFF,   [BOOT3]
+/      COPY SYSTEM OVER.  LEAVE NEW SYSTEM HANDLER
+/      IN CORE
+/7.    ASK GUY ABOUT NEW DIRECTORY                     [BOOT4]
+/8.    READ IN USR, UPDATE ITS TABLES, WRITE OUT USR   [BOOTC]
+/      NAME TABLE, DHIT (SLOT, 2-PAGE,ENTPT)
+/9.    READ IN CURRENT PAGE 7600 IMAGES                [BOOT5]
+/      SET UP AS FOLLOWS:
+/      PG7600/L:       BOOT
+/      PG7600/H:       07600 IMAGE
+/      BLOK66/L:       17600 IMAGE
+/      BLOK66/U:       27600 IMAGE
+/      THIS IS ACCOMPLISHED VIA:
+/      PG7600_0
+/      BLOK66_66
+/      IF OLD SYS WAS 1 PAGE, BLOK66/L_PG7600/L
+/10.   MOVE DCB AND RESIDENCY TABLES INTO 17600 IMAGE  [BOOT6]
+/11.   MOVE BOOTSTRAP INTO PAGE 7600 IMAGES (2 PLACES) [BOOT7]
+/12.   WRITE OUT HANDLERS                              [BOOT8]
+/13.   ZERO DIRECTORY IF REQUESTED                     [BOOTD]
+/14.   PUT SYS, DATA BREAK, CORE LIM IN 07600 IMAGE    [BOOTE]
+/15.   WRITE 7600 IMAGES BACK OUT ONTO TAPE            [BOOTF]
+/      IF NEW SYS IS 1-PAGE, PG7600/L_BLOK66/L
+/      0_PG7600
+/      66_BLOK66
+/16.   READ BACK PAGE 7600 IMAGES.  MOVE IN FIELD 1 STUFF
+/      EXCEPT FOR CD AREA, RESTORE TODAY'S DATE,
+/      BRANCH TO 7600
+\fGETSLOT,0
+       ISZ SLOT        /USE NEXT SLOT
+       TAD SLOT
+       TAD (-26
+       SNA CLA
+       JMP I (NOSLOT
+       TAD SLOT
+       JMP I GETSLOT
+
+BOOT,  ISZ I (RETSW    /***?
+       CLA IAC
+       DCA I (BD       /DISABLE 'BUILD' CMD
+/SEE IF ARGUMENT WAS GIVEN; TREAT IT AS BOOT DEVICE,
+/SAVE HANDLER ADDRESS (MUST BE AN ACTIVE HANDLER)
+       JMS I (LOCSYS   /IN CASE DSK=SYS
+/      JMS I [GETNUM
+/      NOP
+/      TAD SIZE
+/      DCA BOOTDV      /CHECK THAT # IS GT 7600
+BOOT2, TAD DSKG1       /FIND OUT ABOUT 'DSK'
+       SNA
+       JMP GOTD        /DSK=SYS
+       DCA SAV1
+       TAD DSKG2
+       DCA SAV2
+       TAD DSKP1
+       DCA NAME1
+       TAD DSKP2
+       DCA NAME2
+       JMS I [BIGNAM   /FIND IT IN TABLES
+GOTD,  GET
+       DCB
+       SMA CLA         /IS IT FILE-STRUCTURED?
+       JMP I (DSKBAD   /NO
+       GET             /YES
+       DSKBIT
+       RTL
+       STL RTR         /TURN ON BIT 1
+       PUT
+       DSKBIT
+       JMP I (BOOT2A
+\fGETDCB,       0
+       GET
+       PLATNUM
+       JMS I [ROTL
+       AND [7          /GET # OF PLATTERS
+       SNA
+       IAC             /0 MEANS 1
+       TAD [-1         /SUBTRACT 1
+       CLL RTL
+       RAL             /TIMES 10
+       DCA TMP1
+       GET
+       DCB
+       AND [7770       /MASK OFF USEFUL INFO
+       TAD TMP1
+       JMP I GETDCB
+\fSLOTDSK,0
+       JMS I (CHKRES
+       JMP SMPG
+       TAD NEWPAG
+       DCA I (SBUFF+1
+       JMS GETSLOT
+       JMS SETSLT
+B,     DCA I (SHND+1
+       JMS GETDCB
+       DCA I (SDCB+1
+       TAD (5723       /'DSK' HASHED
+       DCA I (SNAME+1
+       GET
+       SYSBIT
+       RTL             /SYSBIT TO L, CORES BIT TO AC0
+       SNL SMA CLA     /IS IT EITHER SYS OR CORESIDENT WITH SYS?
+       JMP NORE2       /NO, SO IT'S NOT CORE-RESIDENT
+       GET             /YES, RESIDENT AT ALL TIMES IN 07600
+       ENTPT
+       AND [177
+       TAD [7600
+NORE2, DCA I (SRES+1
+       JMP I SLOTDSK
+
+SETSY, TAD NEWPAG
+       DCA I (SBUFF
+/      JMS SETSLT      /NO BLOCK SLOT
+       DCA I (SHND
+       JMS GETDCB
+       DCA I (SDCB     /SET DCB
+       TAD I (SNAME
+       SZA CLA
+       JMP I (TWOSYS
+       TAD (4631       /HASH CODING FOR 'SYS'
+       DCA I (SNAME
+/CHECK THAT NAME IS 'SYS'
+       TAD [7607
+       DCA I (SRES
+/CHECK REL ENTRY PT IS 7
+       JMP I (INACT
+
+SMPG,  TAD SLOT
+       JMS SETSLT
+       JMP B
+\fSETSLT,       0
+       SNA
+       JMP .+3
+       TAD [-15
+       JMS I [ROTR
+       DCA TMP1
+       GET             /
+       CORES           /
+       RTL             /
+       SPA SZL CLA     /
+       JMP I SETSLT    /SYS &CORES HANDLERS GET 0 ENTRY (UNFORTUNATELY)
+       GET
+       ENTPT
+       AND (4177
+       TAD TMP1
+       JMP I SETSLT
+       PAGE
+\f      USRBLK=13       /BLOCK OF USR ON SYSTEM DEVICE
+       USRNPT=36       /POINTS TO USR PTR TO PERMANENT DEVICE NAME TABLE
+       USRHPT=37       /POINTS TO USR PTR TO DEVICE HANDLER INFORMATION TABLE
+
+BOOTC, TAD [200        /READ FIRST BLOCK OF USR
+       JMS I [SYS
+       BUFFER          /INTO BUFFER
+       USRBLK
+       TAD I [BUFFER+USRNPT    /GET POINTER TO NAME TABLE
+       TAD [BUFFER-400 /ADD IN OFFSET FOR RELOCATION
+       DCA T1AD        /ASSUME BOTH TABLES OCCUR IN THE SECOND
+       TAD I [BUFFER+USRHPT    /BLOCK OF THE USR
+       TAD [BUFFER-400
+       DCA T2AD        /GET POINTER TO DHIT
+       TAD [400        /READ BLOCKS 2 AND 3 OF USR
+       JMS I [SYS      /INTO BUFFER,BINARY
+       BUFFER
+       USRBLK+1
+       TAD [-17
+       JMS I [MOVE     /MOVE IN PERMANENT DEVICE NAME TABLE
+       CDF 0
+       SNAME
+       CDF 0
+T1AD,  HLT
+/      TAD SAMSYS      /WAS SYS SPECIFIED?
+/      SZA CLA
+/      JMP CHKD2       /YES
+/      TAD I T2AD      /NO, USE CURRENT SYS INFO
+/      DCA I (SHND
+/CHKD2,        TAD DSKG1
+/      SZA CLA         /WAS DSK SPECIFIED?
+/      JMP MVSHND      /YES
+/      TAD I T2AD      /MAKE SAME AS SYS
+/      DCA I (SHND+1
+MVSHND,        TAD [-17        /NOW PUT IN SLOT WORDS (DHIT)
+       JMS I [MOVE
+       CDF 0
+       SHND
+       CDF 0
+TMP2,
+T2AD,  HLT
+       TAD [4400       /RE-WRITE USR
+       JMS I [SYS
+L5400, BUFFER
+       USRBLK+1
+       JMP I [BOOT5
+       IFNZRO BUFFER-5400 <ERRRR,XX>
+\fBOOTD,        TAD DRECT       /WANT NEW DIRECTORY?
+SNACLA,        SNA CLA
+       JMP BOOTE
+       TAD L5400       /YEP. WRITE ONE
+       JMS I [SYS
+       DPROPR
+       1
+BOOTE, TAD NEWCOR
+       CLL RAL
+       RTL
+       TAD SAVHID      /V3D SET NEW H.O. DATE WORD
+       DCA I [7777     /SET UP NEW CORE LIMIT
+       TAD SYSLOC      /MOVE IN FRESH COPY OF SYS HANDLER
+       TAD [7
+       DCA SYSL2
+       TAD [7607-7743-1
+       JMS I [MOVE
+       CDF 10
+SYSL2, HLT
+       CDF 0
+       7607
+       TAD [-200       /PUT SYS HANDLER INTO REC 0 BUFF. ???
+       JMS I [MOVE
+       CDF 0
+       7600
+       CDF 0
+       PG7600+200      /RESIDENT F0 CODE
+       JMS I (WRITCC   /WRITE CCB AND DATA BREAK FILLERS
+       TAD [200
+       TAD SYSLOC      /MOVE IN COPY OF 27600 AGAIN
+       DCA SYSL3
+       TAD [-200
+       JMS I [MOVE
+       CDF 10
+SYSL3, HLT
+       CDF 10
+       BLOK66+200
+       JMP I (BOOTF
+
+DRECT, -1              /1 MEANS WRITE A ZERO DIRECTORY
+                       /0 MEANS DON'T TOUCH DIRECTORY
+                       /-1 MEANS ASK GUY FOR OPTION
+\f/SEE IF NEW SYSTEM HAS SAME DCB AS CURRENT SYSTEM
+/THIS MAY WELL CAUSE EXTRA I/O WHEN GOING FROM RF08=K TO RF08=M
+
+BOOT3, CDF 10
+       TAD I (DATEWD
+       DCA SAVDAT      /SAVE TODAY'S DATE FOR FUTURE REFERENCE
+       TAD I (DCBTBL   /GET DCB OF CURRENT SYSTEM
+       CDF 0
+       AND [7770
+       DCA TMP2
+       JMS I (PATCH    /V3D
+       TAD SAVLOC      /DON'T COPY IF DID 'BUILD'
+       SNA CLA         /WAS THE 'BU' COMMAND USED?
+       TAD [-10        /NO, USE 'SZA CLA'
+       TAD SNACLA      /YES, USE 'SNA CLA'
+       DCA I (BOOTQ
+       JMS SETUPSYS
+       TAD SYSDCB
+       CIA
+       TAD TMP2
+       JMP I (BOOTQ
+
+/NOTE: THIS PROCEDURE DOESN'T COPY BOOTSTRAP IF NEW DEV=OLD DEV.
+/      THEREFORE YOU CAN'T CHANGE BOOTSTRAPS
+/      CHECK ON AFFECT FOR TD8E/ROM INTERACTION
+\fSETUPSYS,0
+       DCA SAVLOC
+       TAD SAVLOC
+       DCA I (SAVLC
+       JMS I (LOCSYS
+       JMS I [GETPG    /GET PAGE OF SYS HANDLER
+       DCA SYSLOC      /PAGE OF START OF NEW SYSTEM HANDLER
+       JMS I (GETDCB
+       DCA SYSDCB
+       JMS I (GETLEN
+       GET
+       TWOPAG
+       DCA I (SYSSIZ
+       TAD I (SYSSIZ
+       SMA CLA         /IS IT 1- OR 2-PAGES?
+       JMP ONEPG       /GUESS WHAT THIS MEANS [HINT LOOK AT LABEL]
+       STA
+       TAD I (AMTCOR
+       SNA CLA
+       JMP I (NOTNUF   /WE CAN'T RUN IN 8 K
+ONEPG, TAD [-400
+       JMS I [MOVE
+       CDF 10
+SYSLOC,        HLT             /MOVE SYSTEM HANDLER
+       CDF 10
+SAVLOC,        0               /TO 10000-10377
+       JMP I SETUPSYS
+       PAGE
+\f/ASSUMES NEW PROPOSED SYSTEM HANDLER IS IN 10000-10377
+
+/CAN'T DESTROY OS/8, IE. CAN'T USE PG 0 TEMPS
+
+SYSWP, 0               /ROUTINE TO MOVE SYS HANDLER AROUND
+       ISZ SWAPER      /DIDDLE SWAP INDICATOR
+       CLA CMA         /-1 MEANS NEW HANDLER IS IN
+       DCA SWAPER
+       STA
+       TAD AMTCOR
+       SNA CLA         /DO WE HAVE 8K?
+       JMP SWAPLW      /YES, DON'T SWAP WITH FIELD 2
+       TAD L7600       /NO, CAN'T HURT TO SWAP FIELD 2
+       DCA OUT
+       TAD SAVLC
+       TAD P200
+       DCA IN
+       TAD (4-200
+       DCA STEMP       /SWAP ENTIRE PAGE (EXCEPT LAST 4 LOCATIONS)
+SWAP3, CDF 10          /SWAP 27600 & 2ND PAGE OF HANDLER
+       TAD I IN
+       DCA SYSQ
+       CDF 20
+       TAD I OUT
+       CDF 10
+       DCA I IN
+       TAD SYSQ
+       CDF 20
+       DCA I OUT
+       ISZ IN
+L7400, 7400            /NOP
+       ISZ OUT
+L7600, 7600
+       ISZ STEMP
+       JMP SWAP3
+SWAPLW,        CDF 0
+       TAD (7607
+       DCA OUT         /7607 ALWAYS TARGET DESTINATION
+       TAD SAVLC
+       TAD (7
+       DCA IN
+       TAD (7607-7743-1/ONLY 7607-7743 GETS MOVED
+       DCA STEMP
+SWAP2, CDF 10
+       TAD I IN
+       DCA SYSQ        /TEMP STORE
+       CDF 0
+       TAD I OUT
+       CDF 10
+       DCA I IN
+       TAD SYSQ
+       CDF 0
+       DCA I OUT
+       ISZ IN
+       ISZ OUT
+       ISZ STEMP
+       JMP SWAP2
+       DCA I (SOFSET   /V3C
+       JMP I SYSWP
+
+AMTCOR,        1               /HIGHEST CORE BANK
+SAVLC, 0               /MUST BE ABOVE 3577
+\fCHTMP,
+IN,    0               /POINTS TO HANDLER AREA AT ONE NAMED SYS
+OUT,   0               /POINTS TO 7607 HANDLER
+SWAPER,        0               /-1 MEANS NEW HANDLER IN
+\f/MUST BE ABOVE OS/8,  NO PAGE 0 LITERALS
+
+STEMP,
+ICHAR, 0
+       JMS I (CTCTST
+       ISZ JMPGET      /POINT TO CORRECT CHAR
+       ISZ CHCNT       /NEED WE READ?
+JMPX,  JMP JMPGET      /NOT YET
+       TAD REOF        /YES. DID LAST YIELD EOF?
+       SZA CLA
+       JMP I (BADINP   /SOMETHING IS WRONG.
+RDIN,  JMS I DVICE
+P200,  0200            /READ INTO FIELD 0
+BINBUF,        BINARY
+RECNO, 0
+       JMP RERROR      /READ ERROR
+RECNO2,        ISZ RECNO       /POINT TO NEXT RECORD
+       TAD (-601
+       DCA CHCNT       /NEW CHARACTER COUNT
+       TAD BINBUF
+       DCA CHPTR
+       TAD JMPX
+       DCA JMPGET      /RESET JUMP SWITCH
+       JMP ICHAR+1
+SYSQ,
+JMPGET,        JMP .           /IF WE GET CAUGHT HERE, WE KNOW IT
+       JMP CHAR1       /ASSEMBLE FIRST CHAR
+       JMP CHAR2       /SECOND CHAR
+       TAD JMPX        /THIRD CHAR HERE
+       DCA JMPGET      /RESET SWITCH
+       TAD I CHPTR
+       AND L7400
+       CLL RTR
+       RTR
+       TAD CHTMP       /ADD IN THE LAST TEMP STORE
+       RTR
+       RTR
+       ISZ CHPTR       /TO NEXT CHAR
+       JMP GCHCOM
+\fCHAR2,        TAD I CHPTR
+       AND L7400
+       DCA CHTMP       /SAVE FOR THIRD CHAR
+       ISZ CHPTR
+CHAR1, TAD I CHPTR
+GCHCOM,        AND (377
+       ISZ ICHAR       /PASS UP ERROR RET
+       JMP I ICHAR
+RERROR,        SPA CLA         /FATAL, OR EOF?
+       JMP IOERR       /FATAL
+       ISZ REOF        /END OF FILE
+       JMP RECNO2      /BACK TO MAINSTREAM
+IOERR, JMS I (PRWD
+       TEXT    \?I/O\
+       JMP I ICHAR
+REOF,  0
+CHCNT, 0
+CHPTR, 0
+DVICE, 0
+       PAGE
+\f/BLOCK 0 OF DEVICE CONTAINS INITIAL IMAGE
+/OF 17600 FOLLOWED BY 07600
+
+/17600-17646   CD AREA INITIALLY CONTAINS BOOTSTRAP
+/17647-17665   RESIDENCY TABLE
+/17666         DATE
+/17667-17677   PART OF OS/8 KBM
+/17700-17740   PART OF OS/8 USR
+/17741-17757   USER DEVICE NAME TABLE/ODT
+/17760-17776   CONTROL WORD TABLE (DCB)
+/17777         UNUSED
+
+/07600-07606   PART OF OS/8 CODE
+/07607-07743   SYSTEM HANDLER
+/07744-07745   STARTING ADDRESS
+/07746         JOB STATUS WORD (JSW)
+/07747         MUST BE 0 (SOFSET)
+/07750-07755   DATA BREAK LOCATIONS RESERVED FOR HARDWARE
+/07756-07775   KBM AND ODT
+/07776         MUST BE 0 (SBLOCK)
+/07777         SOFTWARE CORE SIZE, BATCH FLAGS
+
+/IF SYSTEM HANDLER IS TWO PAGES LONG, THEN WE HAVE INSTEAD:
+
+/BLOCK 66 (LOWER) CONTAINS 17600 IMAGE
+/BLOCK 66 (UPPER) CONTAINS 27600 IMAGE (MUST END WITH 4 ZERO'S)
+/BLOCK 0  (LOWER) CONTAINS BOOTSTRAP
+/BLOCK 0  (UPPER) CONTAINS 07600 IMAGE
+\fDSCADV,       0               /ADVANCE TO NEXT DESCRIPTOR
+                       /RETURN 2 MEANS NO MORE
+                       /RETURN 1 MEANS NOW AT BOOTSTRAP BLOCK
+                       /RETURN 3 OTHERWISE
+       TAD DSCPTR
+       TAD [HDRSIZ
+       DCA DSCPTR
+       JMS I (SKPCRD   /SKIP A POSSIBLE GROUP COUNT
+       TAD I DSCPTR
+       CLL
+       TAD [200
+       SZL CLA
+       JMP I DSCADV    /TAKE RETURN1 UPON REACHING BOOTSTRAP RECORD
+       ISZ DSCADV
+       TAD I DSCPTR
+       SZA CLA
+       ISZ DSCADV      /TAKE RETURN 2 IF ADVANCED TO END
+       JMP I DSCADV
+
+/RETURN 1 MEANS NO MORE DESCRIPTORS
+BOTADV,        0
+       TAD I DSCPTR
+       CIA
+       IAC             /COUNT IS ONE MORE
+       TAD DSCPTR
+       DCA DSCPTR      /POINT TO BEGIN OF NEXT DESCRIPTOR
+       JMS I (SKPCRD
+       TAD I DSCPTR
+       CLL
+       TAD [200
+       SZL CLA
+       JMP BOTADV+1    /WIERD CASE OF CONSECUTIVE BOOTSTRAPS
+       TAD I DSCPTR
+       SZA CLA
+       ISZ BOTADV      /TAKE RETURN1 IF ADVANCED TO END
+       JMP I BOTADV
+
+/WIERD CASES CAN OCCUR IF GUY DELETES ALL ENTRY POINTS IN A GROUP SEPARATELY
+
+/DESCRIPTOR ENTRIES:
+
+/FIRST WORD:
+/      0               MEANS END OF TABLE
+/      -1 TO -20       MEANS GROUP COUNT (NOT NECESSARILY ACCURATE)
+/      -21 TO -400 APPROX MEANS BOOTSTRAP RECORD COUNT
+/      OTHER           MEANS DESCRIPTOR
+\fSYSCPY,       0               /COPY OS/8 SYSTEM
+       STA
+       TAD I (AMTCOR
+       SZA CLA
+       TAD [10         /GT 8K
+       DCA CORBIT
+       TAD CORBIT
+       SZA CLA
+       JMP COP2
+       JMS I [SYSWP    /SWAP IN NEW SYS HANDLER
+       TAD (7410
+       JMS I [SYS      /SAVE PART OF BUILD TO MAKE A BIG BUFFER
+       400             /SAVE 400-
+       27              /SAVE IN BLOCK 27
+       JMS I [SYSWP    /GET BACK ORIGINAL HANDLER
+COP2,  TAD [4210
+       JMS COPY        /COPY BLOCK 0
+       0
+       TAD (5610
+       JMS COPY        /COPY 7-15
+       7
+       TAD [4210
+       JMS COPY        /COPY 26
+       26
+       TAD (7410
+       JMS COPY        /COPY 51-66
+       51
+       TAD [4210
+       JMS COPY        /COPY 67
+       67
+       TAD CORBIT
+       SZA CLA
+       JMP COP3
+       JMS I [SYSWP    /GET BACK NEW HANDLER FOR A MOMENT
+       TAD (3410       /RESTORE CORE WE SAVED
+       JMS I [SYS
+       400
+       27
+       JMS I [SYSWP    /RESTORE ORIGINAL SYS HANDLER
+COP3,  JMP I SYSCPY
+\fCOPY, 0
+       TAD CORBIT
+       DCA TMP1
+       TAD I COPY
+       DCA COPREC      /ARG 1 CONTAINS FIRST BLOCK TO COPY
+       TAD COPREC
+       DCA CPREC2      /MAKE TWO COPIES
+       STL RAR         /CONVERT 'WRITE' TO READ
+       TAD TMP1
+       JMS I [SYS      /READ FROM ORIGINAL DEVICE
+       400
+COPREC,        HLT
+       JMS I [SYSWP
+       TAD TMP1
+       JMS I [SYS      /WRITE ON NEW DEVICE
+       400
+CPREC2,        HLT
+       JMS I [SYSWP    /LEAVE WITH ORIGINAL SYSTEM HANDLER STILL IN SYSTEM
+       JMP I COPY      /FALL THROUGH RECORD NUMBER
+\fCORBIT,
+GETLEN,        0
+       GET             /GET LENGTH OF DEVICE
+       PLATNUM
+       JMS I [ROTL     /GET NUMBER OF PLATTERS
+       AND [7
+       SNA
+       IAC             /0 MEANS 1
+       CIA
+       DCA COUNT
+       GET
+       DEVSIZ
+       DCA TMP1
+SIZLUP,        TAD TMP1
+       SNA
+       STA             /4096 BECOMES 4095
+       ISZ COUNT
+       JMP SIZLUP
+       CIA
+       TAD [70         /LEAVE ROOM FOR OS/8
+       DCA DLENGTH
+       JMP I GETLEN
+
+DPROPR,        -1              /INITIAL EMPTY DIRECTORY
+       MFREE
+       0
+       0
+       -1
+       0               /1 EMPTY FILE
+DLENGT,        0
+       PAGE
+\f/WANT TO COPY
+
+/SYS   0
+/KBM   7-12
+/USR   13-15
+/ENTER 26
+/CD    51-53
+/SAVE,DATE 54-55
+/ERR   56
+/CHAIN 57
+/ODT   60-63
+/CCL   64,65,67
+/SYS   66
+
+/EXTRA (DON'T WANT TO COPY):
+
+/HANDLERS      16-25
+/SCRATCH       27-50
+
+/NEW ALGORITHM:
+
+/SET FIELD 2 IF 12K OR MORE AND SKIP *'ED ITEMS
+
+/1.    MOVE NEW SYS HANDLER TO 0,200
+/2.*   SAVE 34 PAGES STARTING AT 10400 IN BLOCK 27 OF NEW DEVICE
+/3.    COPY BLOCKS 7-15
+/4.    COPY BLOCK 26
+/5.    COPY BLOCKS 51-66
+/6.    COPY BLOCK 67
+/7.*   RESTORE 34 PAGES
+\f/THE FOLLOWING ROUTINES AND VARIABLES MUST BE ABOVE THE LOCATIONS
+/IN WHICH OS/8 AND CD LOAD INTO, BECAUSE THEY ARE CALLED BY LDABS.
+/FURTHERMORE, NONE OF THESE ROUTINES MAY USE PAGE 0 LITERALS
+/OR MAY USE ANY PAGE 0 TEMPORARIES, EXCEPT THAT SOME MAY USE
+/PAGE ZERO TEMPORARIES IF THE STORE INTO THEM FIRST
+/(EXCEPT THOSE COMMENTED OTHERWISE, WHICH MUST PRESERVE
+/THE NEW PAGE 0 AT ALL COSTS, UNTIL IT IS WRITTEN OUT
+
+/LDABS
+/ICHAR
+/BADINP
+/OVER
+/ASSEMB
+/CTCTST
+/PRWD
+/CTRLC
+/OVROUT
+/ROTL
+/PRINTE
+/TTYOUT
+/ROTR
+/PWORD
+/ECHOFL
+/LINEUP
+/CRLF
+/PRNT
+/RUBFLG
+/MOVE
+/SYSWP
+/AMTCOR
+\f      SYDCB=7760      /LOCATION OF SYS,DSK DCB WORDS
+
+BOOT5, JMS I (RECZRO
+BOOT6, TAD [-17
+       JMS I [MOVE     /PUT RESIDENT FIELD 1 TABLES INTO
+       CDF 0
+       SDCB            /FIXED SPOTS
+       CDF 10
+       BLOK66+160
+       TAD [-17
+       JMS I [MOVE
+       CDF 0
+       SRES
+       CDF 10
+       BLOK66+47       /COULD SET USER DEVICE NAMES HERE IF DESIRED
+BOOT7, JMS I (LOCSYS
+/      TAD SAMSYS
+/      SZA CLA         /SAME SYSTEM?
+/      JMP BOOT8       /YES
+BLOOK, ADVDSC          /SEARCH FOR BOOTSTRAP
+       JMP FNDBOT      /FOUND BOOTSTRAP RECORD AMONGST DESCRIPTORS
+       HLT             /IT WASN'T THERE!
+       JMP BLOOK       /KEEP LOOKING
+
+FNDBOT,        TAD DSCPTR
+       IAC             /POINT TO BOOTSTRAP
+       DCA FROMBO
+       TAD I DSCPTR    /LENGTH OF BOOTSTRAP
+/CHECK THAT'S IT'S LE 47 LOCS IF 1-PAGE SYSTEM
+       JMS I [MOVE
+       CDF 0
+FROMBO,        HLT
+       CDF 0
+       PG7600
+       TAD [-47        /MOVE FIRST 47 LOCS INTO CD AREA IN 17600 IMAGE
+       JMS I [MOVE
+       CDF 0
+       PG7600
+       CDF 10
+       BLOK66
+BOOT8, TAD (-16
+       DCA COUNT
+       TAD (SBUFF
+       DCA XR1
+       TAD (SHND
+       DCA XR2
+DVLOOP,        TAD I XR1
+       SNA
+       JMP NOHN
+       DCA DVBUF       /LOCATION OF HANDLER
+       TAD I XR2
+       JMS I [ROTL
+       AND [17
+       SNA
+       JMP CN          /NO BLOCK SLOT
+       TAD L15         /CONVERT TO ACTUAL BLOCK #
+       DCA DVREC
+       TAD [4210
+       JMS I [SYS
+DVBUF, HLT
+DVREC, HLT
+CN,    ISZ COUNT
+       JMP DVLOOP
+       JMP I (BOOTD
+NOHN,  ISZ XR2
+       JMP CN
+
+SYSSIZ,        0               /MINUS MEANS 2-PAGE SYS HANDLER
+\fCTRLC,        KCC             /CLEAR ^C FLAG
+       TAD I (SWAPER   /DO WE HAVE TO SWITCH?
+       SZA CLA
+       JMS I (SYSWP    /YES. INSERT OLD HANDLER
+       JMP I (7600
+
+KORE,  JMS I [GETNUM
+L15,   15              /NOTHING MEANS 0
+       TAD SIZE
+       AND [7770
+       SZA CLA
+       JMP I [BADARG   /MUST BE BETWEEN 0 AND 7
+       JMS I (RELCOR   /FIND REAL AMOUNT OF CORE
+       CMA
+       TAD SIZE
+       SMA CLA
+       JMP I (NOTNUF   /MUST BE .LE. REAL AMT OF CORE
+       TAD CHAR
+       SZA CLA
+       JMP I [SYNTAX
+       TAD SIZE
+       DCA NEWCOR
+       JMP I [CONFIG
+\f/     IF NEW SYS IS 1-PAGE,   PG7600/L_BLOK66/L
+/      0_PG7600
+/      66_BLOK66
+
+BOOTF, TAD SYSSIZ
+       SMA CLA         /IS NEW SYS TWO PAGES?
+       TAD [-200       /NO
+       JMS I [MOVE     /YES, NULL MOVE
+       CDF 10
+       BLOK66
+       CDF 0
+       PG7600
+       TAD [4200
+       JMS I [SYS
+       PG7600
+       0
+       TAD [4210
+       JMS I [SYS
+       BLOK66
+       66
+BOOTG, NOP
+/      JMS I (RECZRO   /SIMULATE BOOTSTRAP
+       TAD [-131       /MOVE UP FIELD 1 CODE
+       JMS I [MOVE
+       CDF 10
+       BLOK66+47
+       CDF 10
+       7600+47
+       TAD SAVDAT
+       CDF 10
+       DCA I (DATEWD
+       CDF 0
+       JMS I [PRWD
+       TEXT /SYS BUILT/
+       JMP I [7600
+       PAGE
+\f/MOVE MOVES CORE AROUND       (CALLABLE FROM ANY FIELD)
+
+/      TAD (-# OF LOCS TO MOVE
+/      JMS MOVE
+/      CDF FROM FIELD
+/      FROM BUFFER LOCATION START
+/      CDF 'TO' FILED
+/      TO BUFFER
+
+/MUSTN'T DESTROY OS/8 LOCS, NO PAGE 0 TEMPS!
+
+MOVE,  0
+       DCA MVCT
+       RDF
+       TAD (CIF CDF
+       DCA MOVRET
+       TAD I MOVE      /GET CDF FROM-FLD
+       DCA MVCDF2
+       ISZ MOVE        /POINT TO FROM-BUF
+       TAD I MOVE      /GET LOC TO MOVE
+       DCA MVTM1
+       ISZ MOVE        /POINT TO TO-CDF
+       TAD I MOVE
+       DCA MVDF        /GET CDF TO FIELD OF DESTINATION
+       ISZ MOVE        /POINT TO TARGET AREA
+       TAD I MOVE
+       DCA MVTM2
+       ISZ MOVE        /POINT TO RETURN
+       TAD MVCT
+       SNA CLA
+       JMP MOVRET      /NOTHING TO MOVE
+MVCDF2,        CDF 0           /GETS ALTERED TO PICK UP F1
+       TAD I MVTM1
+MVDF,  HLT
+       DCA I MVTM2
+       ISZ MVTM1       /BUMP POINTERS TO AREAS
+       ISZ MVTM2
+MV20,  20
+       ISZ MVCT
+       JMP MVCDF2
+MOVRET,        HLT             /RETURN TO CALLING FIELD
+       JMP I MOVE
+
+CTCTST,        0
+       TAD MV7600      /ALLOW FOR PARITY
+       KRS
+       TAD (-7603
+       SNA CLA
+       KSF
+       JMP I CTCTST
+       JMP I (CTRLC
+\fMVCT,
+IOPEN, 0               /PREPARE TO READ INPUT
+       CLA CMA
+       DCA I (CHCNT
+       TAD I (JMPX     /RESTORE SWITCH
+       DCA I (JMPGET
+       TAD I (FILPTR   /RESULTS OF LOOKUP
+       DCA I (RECNO
+       DCA I (REOF
+       TAD (CDF 0
+       DCA I (XFIELD   /SETUP LDABS FOR FIELD 0
+       JMP I IOPEN
+\fBOOT4,        TAD I (DRECT
+       SMA CLA
+       JMP I (BOOTC    /HE'S SPECIFIED ABOUT DIRECTORY ZERO
+       JMS I [PRWD     /YES, NO NEED TO COPY SYSTEM
+       TEXT    /WRITE ZERO DIRECT?/
+       TAD [-10        /DON'T WANT TO DESTROY PRECIOUS TABLES
+       JMS I [GTEXT    /GET REPLY
+       JMP BOOT4
+       JMS I [GNAME
+       TAD NAME1
+       AND [7700
+       TAD (-3100
+       SNA CLA
+       CLA IAC         /Y
+       DCA I (DRECT    /NO; COULD HAVE SAVED LOCATION BUT I FEEL SAFER THIS WAY
+       JMP I (BOOTC
+
+MVTM1,
+ROTL,  0
+       CLL RTL
+       RTL
+       RTL
+       JMP I ROTL
+
+MVTM2,
+ROTR,  0
+       CLL RTR
+       RTR
+       RTR
+       JMP I ROTR
+\fTTYOUT,       0               /YOU GUESSED IT
+       DCA TM
+       TAD ECHOFL
+       SZA CLA         /ARE WE ECHOING?
+       JMP I TTYOUT    /NO
+       TAD TM          /YES
+       TLS
+       TSF
+       JMP .-1
+MV7600,        7600            /CLA
+       JMS I (CTCTST   /TEST FOR ^C.
+       JMP I TTYOUT
+
+TM,
+SKPCRD,        0
+       TAD I DSCPTR
+       CLL
+       TAD MV20                /A GROUP COUNT MUST BE IN THE RANGE -1 TO -20
+       SNL CLA
+       JMP I SKPCRD
+       ISZ DSCPTR      /IT'S A DARN GROUP COUNT, GO PAST IT
+       JMP SKPCRD+1    /WIERD CASE OF CONSECUTIVE GROUP COUNTS
+
+ECHOFL,        0               /1 MEANS NOT ECHOING, SAW ^O
+\fPATCH,        0
+       TAD I [7777     /V3D
+       AND L600
+       DCA SAVHID      /SAVE HIGH ORDER DATE BITS
+       JMP I PATCH
+       PAGE
+\fPRNAME,       0               /ROUTINE TO PRINT NAME1-NAME4
+       TAD (NAME1
+       DCA TEMP
+       CLL STA RTL     /-3
+       DCA COUNT
+PRNM2, TAD I TEMP
+       JMS PRINTE      /TYPE OUT CHARS
+       ISZ TEMP
+       ISZ COUNT       /EXHAUSTED ALL?
+       JMP PRNM2
+       TAD I TEMP
+       SNA CLA
+       JMP I PRNAME    /NO . IF NO EXTENSION
+       TAD (".         /PRINT '.'
+       JMS I (TTYOUT
+       TAD I TEMP
+       JMS PRINTE
+       JMP I PRNAME
+
+PRINTE,        0
+       DCA CHTMP2
+       TAD CHTMP2      /EXTRACT LEFT HAND SIDE
+       JMS I (ROTR
+       JMS PWORD
+       TAD CHTMP2
+       JMS PWORD
+       JMP I PRINTE
+\fPWORD,        0
+       AND (77
+       SNA             /IF NULL, GET OUT
+       JMP NULL
+       DCA PRTM
+       TAD (200
+       KRS
+       TAD (-217       /^O
+       SNA CLA         /STOP ECHOING?
+       KSF             /MAYBE
+       SKP             /NO
+       JMP CTO         /YES
+       TAD PRTM
+       TAD (240
+       AND (77
+PRSPAC,        TAD (240
+       JMS I (TTYOUT
+       JMP I PWORD
+NULL,  TAD LINEUP
+       SNA CLA         /PRINT SPACE?
+       JMP I PRINTE    /NO
+       JMP PRSPAC      /YES
+
+PRWD,  0
+       CLA
+PRWD2, TAD I PRWD
+       JMS PRINTE
+       TAD I PRWD
+       ISZ PRWD
+       AND (77
+       SZA CLA
+       JMP PRWD2
+       JMP I PRWD      /LEAVE IF LAST WORD ENDED WITH 00
+
+CHTMP2,        0
+
+CTO,   KCC
+       TAD ("^
+       JMS I (TTYOUT
+       TAD ("O
+       JMS I (TTYOUT
+       JMS CRLF
+       CLA IAC
+       DCA I (ECHOFL
+       JMP I PWORD
+
+LINEUP,        0               /NON-ZERO MEANS PRINT NULLS AS SPACES
+\fOVER, JMS ASSEMB      /EXTENSION OF LDABS.
+       CIA
+       TAD I LCKSUM    /CHECKSUM OK?
+       SZA CLA
+       JMP BADINP      /SOORY ABOUT THAT
+       CLA IAC
+       JMP OVROUT      /SKIP ERROR EXIT
+BADINP,        JMS PRWD
+       TEXT /?BAD INPUT/
+       JMS CRLF
+OVROUT,        TAD I (LDABS
+       DCA OTEMP
+       JMP I OTEMP
+OTEMP,
+ASSEMB,        0               /ASSEMBLE TWO 6 BIT WORDS
+       TAD I LWD1
+       JMS I PROTL     /INTO A SINGLE 12 BIT WORD
+       TAD I LWD2
+       JMP I ASSEMB
+
+LCKSUM,        CKSUM
+LWD1,  WD1
+LWD2,  WD2
+PROTL, ROTL
+PRTM,  0
+\fCRLF, 0
+       TAD (215
+       DCA NAME1
+       JMS PRNT
+       TAD (212
+       JMS I (TTYOUT
+       JMP I CRLF
+
+PRNT,  0               /CHARACTER PRINT ROUTINE
+       TAD ("\         /IF NOT RUBOUT, AND IF RUBOUT WAS
+       ISZ RUBFLG      /LAST, ECHO \.
+       SKP CLA
+       JMS I (TTYOUT
+       TAD NAME1
+       JMS I (TTYOUT
+       JMP I PRNT
+RUBFLG,        0               /RUBOUT FLAG
+       PAGE
+\f/LDABS DOES A REAL LIVE ABSLOAD IF AC=0
+/IF AC=-2 THEN IT IS LOADING A HANDLER, THIS IS DONE AS FOLLOWS:
+/SEARCH FOR *0
+/THEN LOAD CONSEC WORDS INTO DESCRIPTOR TABLE
+/AT NEXT ORIGIN, LOAD WORDS INTO HANDLER AREA (ALLOW ORIGINS)
+
+/CAN'T USE PAGE 0 LITERALS IN CASE LOADING OS/8
+
+LDABS, 0
+       DCA LODTST      /-2 IF HANDLER, 0 IF OS8
+LDABS2,        TAD JMPNXT
+       DCA TSTO0
+       DCA CKSUM       /CLEAR CHECKSUM
+       JMS I (ICHAR    /GET A BUFFER CHAR
+       JMP I LDABS     /NO INPUT FOUND
+       SNA
+       JMP .-3         /IGNORE BLANKS
+       TAD (-200
+       SZA CLA         /IS IT LEADER?
+       JMP I (BADINP   /WASN'T 200..PROBABLY NOT BINARY
+LEADER,        JMS I (ICHAR
+       JMP I LDABS     /STRANGE....ALL LEADER!!!
+       SNA
+       JMP LDABS2      /START OVER.BLANKS AFTER LEADER
+       TAD (-200       /IS IT STILL LEADER?
+       SNA
+       JMP LEADER      /YES
+NEWWD, SMA             /IS IT < 200?
+       JMP FIELDW      /NO.TEST FOR FIELD SEETING
+       TAD (200        /RESTORE CHARACTER
+       DCA WD1
+       JMS I (ICHAR
+       JMP I (BADINP   /EOF BETWEEN WORDS. HOW NICE!
+       DCA WD2
+       JMS I (ICHAR
+       JMP I (BADINP
+       TAD (-200       /200 FINISHES US UP
+       SNA
+       JMP I (OVER
+       DCA WD
+       JMS I (ASSEMB   /ASSEMBLE LAST WORD READ
+       SZL             /IS IT AN ORIGIN?
+       JMP ORGTST      /YES
+XFIELD,        HLT             /GETS CDF N
+       DCA I ORIGIN    /STORE THIS WORD
+CDF0,  CDF 0
+       ISZ ORIGIN      /SHOULD NEVER SKIP, BUT...
+LD7,   7
+       TAD ORIGIN
+       TAD (200        /GIVE ERROR IF ORIGIN ADVANCES TO 7600
+       SNA CLA
+       JMP I (NOROOM
+NEXT,  TAD WD1
+       TAD WD2         /MAKE UP CHECKSUM
+       TAD CKSUM
+       DCA CKSUM
+       TAD WD
+       JMP NEWWD
+\fORGTST,       DCA ORGX        /TEST FOR ORIGIN
+       TAD LODTST      /GET POINTER TO PROPER ORIGIN
+       SZA CLA
+       JMP HND
+       TAD ORGX        /OS/8 - USE REAL ORIGIN
+ORI,   DCA ORIGIN      /BUFFER AREA
+       TAD LODTST      /HANDLER LOAD?
+       SNA CLA
+       JMP NEXT        /NOPE
+       TAD ORGX        /DON'T START LOAD UNTIL *0 IS FOUND
+       SZA CLA
+TSTO0, JMP NEXT
+       DCA .-1         /FOUND *0..DO THE LOAD
+       ISZ LODTST      /YES. BUMP LODTST TO LOAD HANDLER NEXT
+       JMP NEXT
+       TAD XFIELD
+       TAD (-CDF 0
+       SNA CLA
+       JMS FIRST       /FIRST TIME THROUGH
+/DO THIS BETTER; ALSO MAKE SURE HANDLER DOESN(T HAVE A FILED PSEUDO
+       TAD (CDF 10
+       DCA XFIELD      /AT THIS POINT, WE START
+       CLA CMA         /LOADING THE HANDLER INTO THE
+       DCA LODTST      /AREA SPECIFIED BY HNDORG+1
+/CHECK 'ORIGIN' TO SEE IF HEADER WAS RIGHT SIZE
+/ALSO ELSEWHERE, CAN CHECK ORIGIN WHEN BUMPING TO SEE
+/IF WE HIT ANY MAGIC LOCATIONS
+       TAD ORGX        /SEE IF LEGAL RE ORIGIN
+       JMS I (ORGLIM
+       DCA ORIGIN      /ACTUAL FIELD 1 ORIGIN
+/      TAD SNACLA      /LOADING FIELD 1..TEST ORIGINS
+/      DCA JMPRE
+JMPNXT,        JMP NEXT
+FIELDW,        TAD (-100       /LESS THAN 300 FAILS
+       SPA
+       JMP I (BADINP
+       DCA WD1
+       TAD WD1
+       AND LD7
+       SZA CLA
+       JMP I (BADINP   /DISECT WORD TO CATCH GARBAGE
+       TAD LODTST      /IF LOADING HANDLER, IGNORE FIELD
+       SZA CLA
+       JMP FIELD2
+       TAD WD1
+       AND (70         /EXTRACT FIELD SETTING
+       TAD CDF0
+       DCA XFIELD
+FIELD2,        JMS I (ICHAR
+       JMP I (BADINP
+       TAD (7600
+       SZA
+       JMP NEWWD
+       JMP I (OVER
+\fORGX, 0
+ORIGIN,        0
+WD1,   0
+WD2,   0
+WD,    0
+CKSUM, 0
+LODTST,        0
+
+/0:    LOADING OS/8
+/-2:   LOADING HEADER OF HANDLER
+/-1:   LOADING HANDLER
+
+HND,   TAD ORIGIN
+       DCA KLUD
+       TAD TABLMT
+       JMP ORI         /HANDLER - USE HANDLER SPACE
+
+KLUD,  0
+
+FIRST, 0
+       TAD KLUD
+       DCA NEWLIM
+       JMP I FIRST
+
+NEWLIM,        0               /NEW END OF DESCRIPTORS
+RETSW, 0               /0 MEANS RAN FROM OS/8, 1 MEANS RAN STANDALONE
+       PAGE
+\f      LNLNGT=103
+BEGLIN,        ZBLOCK LNLNGT
+
+       SBLOCK=7776     /??
+/CTCFAK,       .+1             /^C MUST NOT RETURN TO ANY SYSTEM.
+/      JMP I CTCFAK    /CTCFAK MARKS OUR PLACE DURING
+/                      /SYSGEN, AND ^C WILL RETURN TO THAT PLACE.
+/*** THIS STUFF GOES AWAY ON A BOOT
+
+BUILD, CDF 10
+       TAD I [7200     /HAS SPECIAL CODE BEEN OVERLAID BY HANDLERS?
+       CDF 0
+       TAD [-1234
+       SZA CLA
+       JMP I (NOROOM   /YES, TOO BAD
+/      TAD (5601
+/      DCA I [7600
+/      TAD (CTCFAK+1
+/      DCA I (7601
+       TAD [6600       /SAVE OLD SYSTEM HANDLER IN 16600
+       JMS I (SETUPSYS
+/      JMS CTCFAK
+RDOS8, JMS I [PRWD
+       TEXT    \LOAD OS/8: \
+       JMS RD
+       JMP RDOS8
+       CIF CDF 10
+       JMS I (WROS8
+       JMS I (SYSWP
+/      JMS CTCFAK
+RDCD,  JMS I [CRLF
+       JMS I [PRWD
+       TEXT    /LOAD CD: /
+       DCA DVER
+       JMS RD
+       JMP RDCD
+       CIF CDF 10
+       JMS I (WRCD
+       TAD I (RETSW
+       SNA CLA         /NOT IF FROM SCRATCH
+       JMS I (SYSWP    /GET OLD HANDLER IF ANY BACK IN
+       JMP I [CONFIG
+\fRD,   0
+       TAD [-40
+       JMS I [GTEXT
+       JMP I RD
+       JMS I (SETUP
+DVER,  JMP I (NODEV
+       JMS I (SYSWP    /PUT IN NEW HANDLER
+       CIF CDF 10
+       JMS I (SAVE
+       JMS I (SYSWP
+       JMS I (LDABS    /PAST HERE PAGE 0 IS GONE
+       JMP I RD
+       JMS I (SYSWP
+       ISZ RD
+       JMP I RD
+       PAGE
+\f      *6400
+
+DSCTAB,        ZBLOCK 1200
+\f/RELIC:
+
+       *7600
+       0               /ONLY LOADED FROM PAPER TAPE.
+
+       *7777
+       0               /SET SOFTWARE CORE SIZE TO 'UNKNOWN'
+       FIELD 1
+       *0
+       0               /FORCE ABSLDR TO LOAD THIS PAGE
+       *400
+/      ZBLOCK 5400
+       0
+\f      *6600
+
+       RELOC BINARY
+
+BINPUN,        CDF 10
+       CLA
+       TAD (-400
+       CIF 0
+       JMS I (MOVE
+       CDF 10
+       6600
+       CDF 0
+       BINARY          /MOVE ONESELF DOWN
+       CIF CDF 0
+       JMP I (LDR      /EXECUTE IN FIELD 0
+LDR,   JMS LEDER       /PUNCH 72 FRAMES OF 200
+       DCA CHECK       /0 CHECKSUM
+       TAD (102
+       JMS CKSUMM
+       JMS PNCH
+STARTB,        JMS I (CRLF
+       TAD ("*
+       JMS I (TTYOUT
+       TAD (-100
+       JMS I (GTEXT
+       JMP STARTB
+       JMS I (GETNUM
+       JMP I (OVERB
+       TAD SIZE
+       AND (7770
+       SZA CLA
+       JMP STARTB
+       TAD SIZE
+       CLL RTL
+       RAL
+       DCA FLD
+       JMS I (GETNUM   /GET LOWER LIMIT
+       JMP STARTB
+       TAD SIZE
+       DCA LIM1
+       JMS I (GETNUM   /GET UPPER LIMIT
+       JMP STARTB
+       TAD SIZE
+       DCA LIM2
+       TAD LIM2
+       CMA
+       TAD LIM1
+       DCA COUNT2
+       TAD FLD
+       TAD (300
+       JMS PNCH
+       TAD FLD
+       TAD (CDF 0
+       DCA BUFLD
+       TAD LIM1
+       JMS I (ROTR
+       AND (77
+       TAD (100
+       JMS CKSUMM
+       TAD LIM1
+       AND (77
+       JMS CKSUMM
+BUFLD, HLT
+       TAD I LIM1
+       JMS I (ROTR
+       AND (77
+       JMS CKSUMM
+       TAD I LIM1
+       AND (77
+       JMS CKSUMM
+       ISZ LIM1
+       ISZ COUNT2
+       JMP BUFLD
+       CIF CDF 0
+       JMP STARTB
+\fLEDER,        0               /PUNCH LEADER/TRAILER
+       TAD (-200
+       DCA COUNT2
+       TAD (200
+       JMS PNCH
+       ISZ COUNT2
+       JMP .-3
+       JMP I LEDER
+
+PNCH,  0
+       PLS
+       PSF
+       JMP .-1
+       CLA
+       JMP I PNCH
+
+FLD,   0
+LIM1,  0
+LIM2,  0
+COUNT2,        0
+CHECK, 0
+
+CKSUMM,        0
+       DCA CK1
+       TAD CK1
+       TAD CHECK
+       DCA CHECK
+       TAD CK1
+       JMS PNCH
+       JMP I CKSUMM
+
+CK1,   0
+       PAGE
+\fOVERB,        TAD (300
+       JMS I (PNCH     /FIELD 0
+       TAD (176
+       JMS I (CKSUMM
+       JMS I (CKSUMM   /*7600
+       TAD (74
+       JMS I (CKSUMM
+       STL CLA RTL
+       JMS I (CKSUMM   /HLT
+       TAD (177
+       JMS I (CKSUMM
+       TAD (77
+       JMS I (CKSUMM   /*7777
+       JMS I (CKSUMM
+       JMS I (CKSUMM   /0000
+       TAD (102
+       JMS I (CKSUMM
+       JMS I (CKSUMM   /*200
+       TAD I (CHECK
+       JMS I (ROTR
+       AND (77
+       JMS I (PNCH
+       TAD I (CHECK
+       AND (77
+       JMS I (PNCH
+       JMS I (LEDER
+       HLT
+       JMP .-1         /ALL DONE
+       PAGE
+       RELOC
+\f      *7200
+
+       DIRLOC=1400     /FROM OS/8 ASSEMBLY
+
+       READ=JMS I (7607
+       WRITE=READ
+       MFREE=70
+       ERR=JMS I (WRERR
+
+       1234            /MAGIC NUMBER WHICH IF NOT HERE, MEANS HANDLERS OVERLAID
+
+WROS8, 0
+       CIF 0
+       TAD Z7600
+       JMS I (MOVE     /SAVE CURRENT 7600
+       CDF 0
+       7600
+       CDF 0
+       7000            /IN 07000
+       TAD (-7         /MOVE 6600 TO 7600
+       CIF 0
+       JMS I (MOVE
+       CDF 0
+       6600
+       CDF 0
+       7600
+       TAD (-34        /FINISH MOVING FIELD 0
+       CIF 0
+       JMS I (MOVE
+       CDF 0
+       6744
+       CDF 0
+       7744
+       CDF 0
+       TAD (5          /V3C SUBTRACT OFF LENGTH OF ABSLDR
+       TAD I (DLENGTH  /FILL IN INITIAL LENGTH
+       CDF 10
+       DCA I (DIRLOC+14        /OS8 HAS INITIAL DIRECTORY
+\f      CIF 0;WRITE;4200;7400;0;ERR     /INITIAL REC.0
+       CIF 0;WRITE;4200;7400;66;ERR    /ALSO WRITE RECORD 66
+       CIF 0;WRITE;4210;DIRLOC;1;ERR   /INITIAL DIRECTORY
+       CIF 0;WRITE;5000;0;7;ERR        /KBM
+       CIF 0;WRITE;4610;0;13;ERR       /USR
+       CIF 0;WRITE;4111;3400;26;ERR    /ENTER OVERLAY
+       CIF 0;WRITE;4701;2000;54;ERR    /SAVE, DATE, MON ERROR, CHAIN OVERLAYS
+       CIF 0;WRITE;4101;LDRCTL;70;ERR  /ABSLDR CORE CONTROL BLOCK
+       CIF 0;WRITE;5010;2000;71;ERR    /ABSLDR
+       CDF 0
+       TAD I (RETSW
+       CDF 10
+       SNA CLA         /SCRATCH BUILD?
+       JMP I (RES76    /NO
+       TAD Z7600       /YES    /MOVE 17600 UP THERE
+       CIF 0
+       JMS I (MOVE
+       CDF 0
+       7400
+       CDF 10
+Z7600, 7600
+       JMS I (RESTORE
+       CIF CDF 0
+       JMP I WROS8
+
+/RELATIONSHIP BEWTWEEN OS/8 CORE IMAGE AND BLOCKS ON SYSTEM DEVICE:
+
+/ITEM          CORE LOC        BLOCKS
+
+/KBM           0000-1777       7-12
+/OVERLAYS      2000-3577       54-57
+/INIT DIR      DIRLOC-         1
+/ABSLDR CCB    LDRCTL-         70
+/INIT BLOCK 0  7400-7777       0
+/USR           10000-11377     13-15
+/ABSLDR                12000-13777     71-74
+/ENTER         13400-13577     26
+/SYS   06600-06606     PART OF 07600
+/SYS   06744-06777     "
+\fWRCD, 0
+       CIF 0;WRITE;4600;0;51;ERR       /CD
+       CIF 0;WRITE;5011;0;60;ERR       /ODT
+       JMS I (RESTORE
+       JMS I (CASIT
+       CIF CDF 0
+       JMP I WRCD
+       PAGE
+\f      READ=JMS I (7607
+       ERR=JMS WRERR
+
+/SPECIAL CODE TO CHAIN TO ABSLDR, TO READ IN MCPIP
+
+       JMS I (7700
+       10              /LOCK USR IN CORE
+       TAD R7600       /ZERO CD AREA
+       DCA CDPTR
+       TAD (-47
+       DCA CDKNT
+       DCA I CDPTR
+       ISZ CDPTR
+       ISZ CDKNT
+       JMP .-3
+       STL CLA RAR     /ALTMODE
+       DCA I (7642
+       JMS I (200
+       12              /INQUIRE
+       4503    /ENCODE CSA0
+CDN,   0
+       0
+       HLT
+       TAD CDN         /TAKE DEVICE NUMBER
+       DCA I (7617     /STORE DEVICE NUMBER OF CASSETTE
+       ISZ I (7620     /V3C FORCE BLOCK 1
+       CLA IAC
+       CDF 0           /V3D
+       DCA I (7746     /SET JSW SO CHAIN DOESN'T DO USROUT
+       CDF 10
+       JMS I (200      /CHAIN TO ABSLDR
+       6
+       70
+\fRESTORE,0
+       CIF 0;READ;3701;0;BLDSAV;ERR
+       CIF 0;READ;3510;0;BLDSAV+20;ERR /RESTORE BUILD
+       JMP I RESTORE
+\f      WRITE=JMS I (7607
+       ERR=JMS WRERR
+
+SAVE,  0
+       CDF 0
+       DCA I (SOFSET
+       DCA I (SBLOCK
+       DCA I (DRECT    /HAVE TO KEEP DIRECTORY LATER
+       CDF 10
+       CIF 0;WRITE;7701;0;BLDSAV;ERR
+       CIF 0;WRITE;7510;0;BLDSAV+20;ERR
+       JMS CASIT
+       CIF CDF 0
+       JMP I SAVE
+
+RES76, TAD I (Z7600
+       CIF 0
+       JMS I (MOVE
+       CDF 0
+       7000            /RESTORE OLD PAGE 7600
+       CDF 0
+       7600
+       JMP I (Z7600
+\fWRERR,        0               /WRITE ERROR
+       HLT CLA         /HIT CONTINUE TO RETRY
+       TAD WRERR
+       TAD (-6
+       DCA WRERR       /POINT BACK TO CIF OF CALL
+       JMP I WRERR     /RETRY
+
+/RELATIONSHIP BETWEEN CD CORE IMAGE AND BLOCKS ON SYSTEM DEVICE:
+
+/ITEM          CORE LOC        BLOCKS
+/CD            00000-01377     51-63
+/ODT           10000-11777     60-63
+
+CSA,   0               /CASSETTE HANDLER ENTRY PT
+CDPTR, 0
+
+CDKNT,
+CASIT, 0
+       CDF 0
+       TAD I (RECNO
+       SNA
+       CLA IAC         /IF BLOCK 0, CHANGE TO 1
+       DCA I (RECNO
+       TAD I PRETSW
+       SNA CLA         /BUILDING FROM SCRATCH?
+       JMP I CASIT     /NO
+       TAD I (BLDCB    /YES, GET DCB OF LOAD HANDLER
+       AND L770
+       TAD M270        /CASSETTE DEVICE CODE=27
+       SZA CLA
+       JMP I CASIT     /NOT A CASSETTE
+       TAD I (DVICE
+       DCA CSA         /GET HANDLER ENTRY POINT
+       CDF 10
+       CIF 0
+       JMS I CSA
+       3               /SKIP TO NEXT FILE
+L770,  770
+M270,  -270
+R7600, 7600            /IGNORE ERRORS
+       CIF 0
+       JMS I CSA
+       100             /DUMMY READ A PAGE
+       BINARY          /TO SKIP HEADER
+PRETSW,        RETSW
+       SKP CLA         /WANT AN ERROR
+       HLT             /A GOOD READ IS BAD!
+       JMP I CASIT
+\f      FIELD 0
+       *200
+       $
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape4/DTFRMT.PA b/sw/os8/v3d/sources/system/dectapes/dectape4/DTFRMT.PA
new file mode 100644 (file)
index 0000000..e919c8e
--- /dev/null
@@ -0,0 +1,1863 @@
+/TC08 DECTAPE FORMATTER, V4
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/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 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.
+/
+/
+/
+/
+/
+/
+\f/COPYRIGHT 1970 DIGITAL EQUIPMENT CORP.
+/MAYNARD, MASS.
+/REVISED APRIL 1970
+
+/   TOG-8      TO MARK AND CHECK PDP-8 DECTAPE
+/THIS PROGRAM WRITES TIMING AND MARK TRACKS ON
+/DECTAPE MOUNTED ON THE TCO1-TU55 TAPE CONTROL UNIT.
+
+
+
+
+
+       X1=10
+       X2=11
+
+/SYMBOL TABLE AUGMENTATION
+
+       DTRA=6761
+       DTCA=6762
+       DTXA=6764
+       DTSF=6771
+       DTRB=6772
+       DTLB=6774
+       DTCX=6766
+
+/SET 0 FOR THE LOGIN FEATURE
+
+       *0
+       0
+       JMP I .+1
+       CONC    /CONTROL "C" AND LOGIN
+
+/WORKING LOCATIONS
+
+       *20
+
+W1,    0000
+W2,    0000
+W3,    0000
+W4,    0000
+W5,    0000
+W6,    0000
+BLOCKS,        0000
+BLOCKA,        0000
+DTA,   0000
+ERX,   0000
+PHASE, 0000
+TOTAL, 0000
+VAR1,  0000
+VAR2,  0000
+\f/CONSTANTS
+
+C1,    0001
+C2,    0002
+C3,    0003
+C4,    0004
+C0017, 0017
+C0070, 0070
+C0077, 0077
+C0007, 0007
+C0030, 0030
+C0400, 0400
+C0700, 0700
+C203,  0203
+C201,  0201
+C210,  0210
+C260,  0260
+C261,  0261
+C267,  0267
+C270,  0270
+C271,  0271
+C277,  0277
+C1000, 1000
+C1620, 1620
+C7000, 7000
+C7700, 7700
+C7714, 7714
+C7761, 7761
+C7772, 7772
+C7775, 7775
+CRCOD, 0215
+LETK,  0313
+LFCOD, 0212
+M2,    -2
+M3,    -3
+M4,    -4
+M6,    -6
+M7,    -7
+M14,   -14
+M144,  -144
+M300,  -300
+SPCOD, 0240
+\f/INTERPAGE LINKS
+
+ADW2,  W2-1
+ADW3,  W3-1
+BADD,  BUFFER-1
+BFR,   BUFFER
+CA,    7755
+COMPAR,        COMPRE
+FCON,  0000
+IT,    INIT1
+FORMA, FORM-1
+FORMB, FORM
+QU1,   Q1
+QU2,   Q2
+QU3,   Q3
+QU4,   Q4
+MESS,  MES
+STX,   START
+TURN,  TRN
+TYOCT, TYCT
+TYPE,  MESAGE
+TYPIN, TYPN
+WAIT,  STALL
+WC,    7754
+DBUFPT,        0       /POINTER TO CURRENT POSITION IN DTA LIST
+
+
+\f
+
+
+/TYPE THE CHARACTER IN THE AC ON THE KEYBOARD PRINTER
+
+RSEND, 0000
+       TLS             /LOAD AND PRINT, CLEAR FLAG
+       TSF             /WAIT FOR CONFIRMATION
+       JMP   .-1       /ENDLESSLY
+       TCF             /CLEAR THE FLAG ANYWAY
+       JMP I RSEND
+
+
+/PRINT A "?" ON THE KEYBOARD TYPER
+
+QU,    .+1
+       IOF             /KILL LOG AND CONTROL C FCTN
+       CLA   CLL       /C(AC)+C(L)=0
+       TAD   C277      /"?"
+       JMS   RSEND     /TYPE THE CHARACTER
+       JMP I .+1       /RESTART
+       INIT
+
+/DECTAPE CONTROL WORDS
+
+DT0030,        0030
+DT0060,        0060
+DT0070,        0070
+DT0100,        0100
+DT0130,        0130
+DT0140,        0140
+DT0200,        0200
+DT0210,        0210
+DT0360,        0360
+DT0510,        0510
+DT0600,        0600
+DT0610,        0610
+
+/SOME SPECIAL LINKS
+
+ADBA,  2475
+ADWA,  2476
+ADWAB, 2477
+
+/CONSTANTS FOR FORMULA TRANSLATION SECTION
+
+BINCON,        .+1
+       0001
+       0012
+       0144
+       1750
+\f      *200    /PAGE 1
+/TYPE CANNED MESSAGES.....
+/THANKS TO DIGITAL 8-18-U
+
+MESAGE,        0
+       IOF             /KILL LOG AND CONTROL FUNCTION
+       CLA   CMA       /SET C(AC)=-1
+       TAD   MESAGE    /ADD LOCATION
+       DCA   10        /AUTO INDEX REGISTER
+       TAD I 10        /FETCH FIRST WORD
+       DCA   MSRGHT    /SAVE IT
+       TAD   MSRGHT
+       RTR
+       RTR             /ROTATE 6 BITS TO THE RIGHT
+       RTR
+       JMS   TYPECH    /TYPE IT
+       TAD   MSRGHT    /GET DATA AGAIN
+       JMS   TYPECH    /TYPE RIGHT HALF
+       JMP   MESAGE+5  /CONTINUE
+MSRGHT,        0               /TEMPORARY STORAGE
+TYPECH,        0               /TYPE CHARACTER IN C(AC)6-11
+       AND   C0077
+       SNA             /IS IT END OF MESSAGE?
+       JMP I 10        /YES: EXIT
+       TAD   M40       /SUBTRACT 40
+       SMA             /<40?
+       JMP   .+3       /NO
+       TAD   C340      /YES: ADD 300
+       JMP   MTP       /TO CODES <40
+       TAD   M3        /SUBTRACT 3
+       SZA             /IS IT ZERO?
+       JMP   .+3       /NO
+       TAD   C212      /YES: CODE 43 IS
+       JMP   MTP       /LINE-FEED (212)
+       TAD   M2        /SUBTRACT 2
+       SZA             /IS IT ZERO?
+       JMP   .+3       /NO
+       TAD   C215      /YES: CODE 45 IS
+       JMP   MTP       /CARRIAGE RETURN (215)
+       TAD   C245      /ADD 200 TO OTHERS >40
+MTP,   TLS             /TRANSMIT CHARACTER
+       TSF             /WAIT FOR THE FLAG
+       JMP   .-1       /NOT SET YET
+       CLA             /SET: CLEAR C(AC)
+       JMP I TYPECH    /RETURN
+
+/CONSTANTS
+
+M40,   -40
+C340,  340
+C212,  212
+C215,  215
+C245,  245
+\f/ROUTINE WAITS UNTILL A COMPLETE MESSAGE HAS BEEN ENTERED
+/SIGNIFIED BY A CR.
+
+TYPN,  0
+       IOF             /KILL THE LOG AND CONTROL C FUNCTION
+       KCC             /CLEAR AC, KEYBOARD FLAG
+       TAD   BADD      /GET BUFFER ADDRESS
+       DCA   W1        /STORE FOR THE CHARACTER STRING
+
+/READ AND RESPOND WITH THE CHARACTER
+
+NTYRTN,        ISZ   W1        /NORMAL RETURN. INCREMENT BUFFER
+       KSF             /WAIT FOR KEYBOARD
+       JMP   .-1       /FLAG TO RAISE
+       KRB             /GOT FLAG, RESET IT, GET CHARACTER
+       JMS   RSEND     /SEND CHARACTER BACK
+       AND     (177    /TAKE CARE OF PARITY
+       TAD     (200
+       DCA I W1        /LOAD CHARACTER INTO BUFFER AREA
+       TAD I   W1      /CHECK FOR CTRL C
+       CIA
+       TAD     C203
+       SZA     CLA
+       JMP     CHKSP   /NO- CHECK FOR SPACE
+       6007            /CTRL C -CLEAR ALL FLAGS
+       NOP             /FOR OLD MACHINES
+       CLA             /JUST IN CASE
+       DTLB            /CLEAR STATUS REGISTER B
+       JMP I   (7605
+
+/IF CHARACTER IS A SPACE, IGNORE IT
+
+CHKSP, TAD I W1        /CHARACTER INTO THE AC
+       CIA             /SUBTRACT FROM SPACE CODE (240)
+       TAD   SPCOD     /COMPLETE COMPARISON
+       SNA   CLA       /WAS IT A SPACE?
+       JMP   NTYRTN+1  /YES: DO NOT INCREMENT BUFFER
+
+/IF CHARACTER IS A CR, EXIT FROM ROUTINE
+
+       TAD I W1        /CHARACTER TO AC
+       CIA             /SET AC TO SUBTRACT CR (215)
+       TAD   CRCOD     /COMPLETE COMPARISON
+       SZA   CLA       /WAS IT CR?
+       JMP   NTYRTN    /NO: INCREMENT BUFFER + WAIT
+
+/CARRIAGE RETURN FOUND, EXIT FROM ROUTINE
+
+       TAD   LFCOD     /GIVE KEYBOARD LINE FEED
+       JMS   RSEND     /EXECUTE LINE FEED
+       CLA   CLL       /EXIT WITH C(ACC) + AND C(L)=0
+       ION             /RESET LOG AND CONTROL C FUNCTION
+       JMP I TYPN      /RETURN TO CALL
+\f/COMPARE A STRING OF CHARACTERS IN "BUFFER"
+/TO A CHARACTER STRING AFTER A JMS IN ASCII
+
+COMPRE,        0
+       CLA   CMA       /C(AC)=7777
+       TAD   COMPRE    /SUBTRACT 1 FOR INDEX REG 1
+       DCA   10        /AUTO INDEX 1 SET TO CHA STRING
+       TAD   BADD      /AUTO INDEX 2 SET TO BUFFER-1
+       DCA   11        /LOAD X2
+
+/COMPARE CHARACTERS TILL ONE DOESN'T COMPARE OR TILL
+/A 0 IS FOUND IN X1. IF OK, RETURN TO TWO PLUS THE
+/ZERO, IF BAD ONE PLUS
+
+       TAD I X1        /CHARACTER FROM PROGRAM
+       CIA             /TO SUBTRACT FROM
+       TAD I X2        /CHARACTER IN BUFFER
+       SZA   CLA       /COMPARE?
+       JMP   CERR      /NO:RESYNC FOR NON COMPARE EXIT
+       TAD I X1        /YES: CHECK FOR GOOD EXIT
+       SZA             /IF 0, EXIT GOOD
+       JMP   .-6       /NO: TEST NEXT CHAACTER
+       ISZ   X1        /+1 TO X1(TOTAL 2 FROM THE 0)
+       JMP I X1        /+1 TO X1, EXIT
+
+/ERROR FOUND. RESYNC AND EXIT NO COMPARE
+
+CERR,  TAD I X1        /CHARACTER FROM PROGRAM
+       SZA   CLA       /IS THIS EXIT KEY? (0000)
+       JMP   .-2       /NO: GET NEXT
+       JMP I X1        /YES: EXIT, NOT COMPARE
+\f\f     *400
+/VARIOUS ERROR MESSAGES
+/"NOT DECIMAL"
+
+Q1,    JMS I TYPE
+       1617  /NO
+       2440  /T
+       0405  /DE
+       0311  /CI
+       1501  /MA
+       1400  /L
+       JMP   QUX
+
+/"TO MANY WORDS"
+
+Q2,    JMS I TYPE
+       2417  /TO
+       1740    /O 
+       1501    /MA
+       1631    /NY
+       4027    / W
+       1722    /OR
+       0423    /DS
+       0000    /00
+       JMP   QUX
+
+/"TO MANY BLOCKS"
+
+Q3,    JMS I TYPE
+       2417  /TO
+       1740    /O 
+       1501    /MA
+       1631    /NY
+       4002    / B
+       1417    /LO
+       0313    /CK
+       2300    /S0
+       JMP   QUX
+
+/"NOT DIVISIBLE BY 3"
+Q4,    JMS I TYPE
+       1617  /NO
+       2440  /T
+       0411  /DI
+       2611  /VI
+       2311  /SI
+       0214  /BL
+       0540  /E
+       0231  /BY
+       4063  / 3
+       0000  /00
+QUX,   JMS I TYPE
+       4345  /CR+LF
+       0000  /END
+       JMP I .+1
+       INIT
+\f/THE CODING BELOW CREATES THE BLOCK NUMBER
+/CONVERSION PRIOR TO THE TAPE WRITE.
+
+MES,   0
+       DCA   W4        /BLOCK NUMBER GIVEN IN AC
+       TAD   W4        /RESTORE TO AC AGAIN
+       CMA             /COMPLEMENTED
+       RTL
+       RAL             /LEFT 3
+       DCA   W5        /TEMP SAVE
+       TAD   W5        /TO AC AGAIN
+       AND   C7000     /ISOLATE HIGH CHA
+       DCA   V2        /FORWARD BLOCK NUMBER
+       TAD   W5        /SHIFTED VALUE
+       AND   C0070     /ISOLATE 6,7,8
+       DCA   V1        /FORWARD BLOCK NUMBER
+       TAD   W4        /ORIGIONAL SET
+       CMA             /UPSIDE DOWN
+       RTR
+       RAR             /RIGHT 3
+       DCA   W5        /TEMP SAVE
+       TAD   W5        /TO AC AGAIN
+       AND   C0700     /ISOLATE 3,4,5
+       TAD   V2        /COMBINE FORWARD BLOCK NUMBER
+       TAD     C0077
+       DCA   V2        /1/2 COMPLETE
+       TAD   W5        /SHIFTED VALUE
+       AND   C0007     /ISOLATE 9, 10,11
+       TAD   V1        /COMBINE WITH BN
+       DCA   V1        /FORWARD BLOCK NUMBER COMPLETE
+
+/CONVERT REVERSE BLOCK NUMBER
+
+       CMA             /-1 TO GIVEN BLOCK #
+       TAD   W4        /ORIGIONAL BLOCK #
+       DCA   W5        /TEMP SAVE
+       TAD   W5        /TO AC AGAIN
+       RTR
+       RTR             /6 RIGHT
+       RTR
+       AND   C0077     /ISOLATE LOW
+       DCA   V3        /HIGH REVERSE
+       TAD   W5        /COMPLEMENT ORIGIONAL -1
+       RTL
+       RTL             /6 LEFT
+       RTL
+       AND   C7700     /ISOLATE HIGH
+       DCA   V4        /REVERSE COMPLETED
+       JMP I MES
+\f/FORM USED TO WRITE 12 DATA WORDS FOR BLOCK NUMBERING
+
+FORM,  0000
+       0000
+       0000
+       0000
+V1,    0000
+V2,    0000
+       7777
+       7700
+       0000
+V3,    0000
+V4,    0000
+       0000
+\f//THIS ROUTINE ALLOWS KEYBOARD INTERRUPTION
+/FOR LOGGING ON THE KEYBOARD, OR FOR A MAJOR
+/CLEAR IN THE PROGRAM. BY HITTING "CONTROL C"
+/A SYSTEM RESTART WILL OCCUR.
+
+CONC,  TSF             /IS THE PRINTER FLAG ON?
+       JMP   .+5       /NO, CHECK READER
+       TCF             /YES: RESET IT
+       KSF             /IS THE READER FLAG ON?
+       JMP     RTNS    /NO: RETURN TO SEQUENCE
+       JMP     .+3
+       KSF
+       HLT
+
+/OK. CHECK FOR EITHER LOG OR CONTROL C.
+
+       DCA   MES       /SAVE C(AC)
+       RAL             /SAVE THE LINK
+       DCA   RSYC+6    /FOR LOGGING
+       KRB             /GET CHARACTER FROM KEYBOARD
+       TLS             /RETURN CHARACTER
+       CIA             /TO SEE IF
+       TAD   C203      /"CONTROL C"
+       SNA   CLA       /IS IT?
+       JMP   RSYC      /YES: RESYNC THE PROGRAM
+       TAD   RSYC+6    /RESTORE THE LINK
+       RAR             /FOR EXIT.
+       TAD   MES       /THE AC TOO
+RTNS,  ION             /INTERRUPT ON 
+       JMP I 0         /RETURN
+\f
+*600
+/RESYNC THE SYSTEM TO START
+
+RSYC,  TSF             /WAIT FOR FLAG
+       JMP   .-1       /ON LAST SENDOFF
+       JMS I TYPE
+       2205  /RE
+       2331  /SY
+       1603  /NC
+       0000  /END
+       TAD   DTA       /TO KILL EXISTING TAPE MOTION
+       DTCX            /NOW
+       JMP I STX       /RETURN TO START
+\f/WAIT FOR THE DECTAPE FLAG TO RISE
+
+STALL, 0
+       CLA
+       DTRB            /READ TCU "B" REGISTER
+       SPA             /ERROR?
+       JMP   ERROR     /YES, DECIDE WHAT TO DO
+       RAR             /DECTAPE FLAG TO LINK
+       SNL   CLA       /FLAG?
+       JMP   .-5       /NO: CONTINUE WATCH
+RERR,  DTXA            /RESET THE DECTAPE FLAG
+       DCA   ERX       /CLEAR THE END TAPE FLAG
+       JMP I STALL     /GOT FLAG, EXIT
+
+/DRIVE TAPE INTO THE END ZONE, AND TURN IT 
+/AROUND.
+/IF C(AC)=0400, TAPE INTO REVERSE END ZONE
+/IF C(AC)=0000, TAPE INTO FORWARD END ZONE
+
+TRN,   0
+       ISZ   ERX       /END ZONE IS LEGAL
+       DCA   W4        /SAVE DIRECTION
+       TAD   DT0200    /MOVE FUNCTION,GO
+       TAD   W4        /DIRECTION TO MOVE
+       TAD   DTA       /DRIVE TO MOVE
+       DTCX            /CLEAR AND RESET "A"
+       JMS I WAIT      /FOR END ZONE FLAG
+       TAD   DT0610    /SEARCH, GO
+       TAD   W4        /DIRECTION TO SEARCH
+       AND   C0777     /DELETE OVERFLOW BIT
+       TAD   DTA       /SET THE DECTAPE
+       DTCX            /RESET STATUS "A"
+       DCA   ERX       /END ZONE NOT LEGAL NOW
+       JMP I TRN       /RETURN TO SEQUENCE
+C0777, 0777
+
+\f/AN ERROR FLAG HAS BEEN SET. IN SOME CASES
+/END ZONE IS LEGAL, OTHERWISE, A RESTART ATTEMPT
+/MAY BE INITIATED.
+
+/DETERMINE WHICH FLAG SET THE DECTAPE FLAG
+
+ERROR, DCA   W5        /SAVE "B" REGISTER
+       TAD   DTA       /GOING TO KILL
+       DTCX            /TAPE MOTION
+       TAD   W5        /RESTORE "B" REGISTER
+       RTL             /POSITION BITS 1+2
+       SPA             /END OF TAPE FLAG?
+       JMP   ZEOT      /YES: GO TO ROUTINE
+       SZL             /MARK TRACK ERROR?
+       JMP   ZMKTK     /YES: GO TO ROUTINE
+       RTL             /POSITION BITS 2+3
+       SPA             /PARITY ERROR?
+       JMP   ZPAR      /YES: GO TO PARITY ERROR ROUTINE
+       SZL   CLA       /SELECT ERROR?
+       JMP   ZSEL      /YES: GO TO ROUTINE
+       JMP   ZTIM      /MUST BE TIMING ERROR
+
+/END OF TAPE FLAG FOUND, SEE IF IT'S LEGAL
+
+ZEOT,  CLA   CLL       /CLEAR REMAINS
+       TAD   ERX       /SWITCH
+       SZA   CLA       /ERROR?
+       JMP   RERR      /OK, IT'S LEGAL
+
+/NOT LEGAL END ZONE FLAG
+
+       JMS I TYPE
+       0516   /EN
+       0440   /D 
+       2401   /TA
+       2005   /PE
+       4000   / 0
+       JMP   ZCOM
+
+/MARK TRACK ERROR
+
+ZMKTK, JMS I TYPE
+       1501   /MA
+       2213   /RK
+       4024   / T
+       2201   /RA
+       0313   /CK
+       4000   / 0
+       JMP   ZCOM
+\f/PARITY ERROR
+
+ZPAR,  JMS I TYPE
+       2001   /PA
+       2211   /RI
+       2431   /TY
+       4000   / 0
+       JMP   ZCOM
+
+/SELECT ERROR
+
+ZSEL,  JMS I TYPE
+       2305   /SE
+       1405   /LE
+       0324   /CT
+       4000   / 0
+       JMP   ZCOM
+
+/TIMING ERROR
+
+ZTIM,  JMS I TYPE
+       2411   /TI
+       1511   /MI
+       1607   /NG
+       4000   / 0
+
+/TYPE "ERROR PHASE X"
+
+ZCOM,  TAD   PHASE     /WHAT PHASE OF OPERATION
+       TAD   PFORM     /WAS THE MACHINE IN
+       DCA   TFORM     /WHEN ERROR OCCURED
+       JMS I TYPE
+       0522   /ER
+       2217   /RO
+       2240   /R 
+       2010   /PH
+       0123   /AS
+       0540   /E
+TFORM, 4060   / X
+       4345   /CR+LF
+       0000   /END
+       JMS I TYPIN
+
+/HE CAN RESTART IF HE TYPES "RETRY"
+
+       JMS I COMPAR
+       0322  /R
+       0305  /E
+       0324  /T
+       0322  /R
+       0331  /Y
+       0000  /0
+       JMP I IT        /GUESS HE DOESN'T WISH TO TRY AGAIN
+\f/ATTEMPT RESTART. NOTE, "ATTEMPT"
+
+       TAD   PHASE     /RESTART ACCORDING TO 
+       TAD   ZFORM     /WHICH PHASE WAS HE IN
+       DCA   .+3
+       JMP I .+2
+ZFORM, .+2
+       0000
+       JMP I .+5       /PHASE 0
+       JMP I .+5       /PHASE 1
+       JMP I .+5       /PHASE 2
+       JMP I .+5       /PHASE 3
+       JMP I .+5       /PHASE 4
+       START
+       PSER
+       DOBLK
+       DBN
+       NOP
+PFORM, 4060
+\f
+
+
+/HERE STARTS THIS PROGRAM. IT WILL ASK THE
+/OPERATOR FOR  DRIVE NUMBERS, THEN ASK HIM FOR
+/A DIRECTION ON WHAT TO DO WITH THE DRIVES.
+
+/THE SEQUENCE FOR MARKING A TAPE WOULD APPEAR AS:
+
+
+/DTA? (3 OR 1 2 3 OR 2 4 7)
+/DIRECT? (MARK 1215)
+/2277 WORDS, 0256 BLOCKS.OK? YES OR NO
+/(YES)
+
+
+/THAT DATA IN PARENTHESIS IS TYPED BY THE OPERATOR
+/(HE DOESN'T TYPE THE PARENTHESIS)
+/IF HE HAD ANSWERED NO, "DIRECT?" WOULD BE TYPED OUT.
+/IF THE DRIVE WAS WRONG, HE WOULD TYPE RESTART.
+/IF HE HAD TYPED "MARK" IN RESPONSE TO "DIRECT?" THE
+/TAPE WOULD BE MARKED WITH THE STANDARD PDP-8 CONFIGURATION.
+/IF HE HAD TYPED "MARK 384" THE TAPE WOULD
+/BE MARKED WITH THE STANDARD PDP-10 CONFIGURATION
+/NOTE: THE WORD AND BLOCK NUMBERS ARE TYPED IN OCTAL
+/IF A MISTAKE OCCURS ON THE OPERATORS PART (WITH REFERANCE
+/TO BLOCK + WORD SIZE) HE WILL BE TOLD ABOUT IT
+
+
+
+
+
+\f      *1000
+
+/MAKE A CALL FOR THE DECTAPE NUMBERS TO BE
+/WORKED.
+
+
+START0,        JMS I   TYPE    /PRINT TITLE
+       4543
+       4300
+       JMS I   TYPE
+       TEXT    /DTFRMT V4A/
+
+
+START, JMS I TYPE      /SET UP TYPER
+       4543  /CR+LF
+       4300  /LF+END
+TYQU,  JMS I TYPE      /"DTA?"
+       0424  /DT
+       0177  /A?
+       4000  / END
+
+/WAIT FOR A REPLY
+
+       JMS I TYPIN     /GET NUMBERS
+       TAD     BADD    /INITIALIZE POINTER (BFR)
+       IAC             /(BADD=BUFFER-1, SO BUMP THE AC)
+       DCA     BFR     /TO START OF INPUT BUFFER
+       DCA     DCTR    /INITIALIZE DTA COUNTER TO 0
+       DCA     CRFLAG  /CLEAR FLAG SO CR NOT ACCEPTIBLE
+CRCHK, TAD     CRCOD   /GET CODE FOR CAR. RETN
+       CIA             /NEGATE IT
+       TAD I   BFR     /SEE IF NEXT CHAR. IN
+       SNA             /BUFFER IS CAR. RETN.
+       JMP     OKCR    /YES: SEE IF C.R. LEGAL HERE
+       DCA     CRFLAG  /NO: SO C.R. IS LEGAL NOW
+VALCHK,        TAD     C261    /SEE IF # IS LESS THAN
+       CIA             /ASCII 1 (261)
+       TAD I BFR       /SUBTRACT BUFFER DATA
+       SPA   CLA       /IS IT LESS THAN ASII 0?
+       JMP   TYQU      /YES: TELL OUTSIDE WORLD
+       TAD   C270      /NO: SEE IF GREATER THAN
+       CMA             /ASC II 8 (270)
+       TAD I BFR       /SUBTRACT BUFFER DATA
+       SMA   CLA       /GREATER THAN ASCII 7?
+       JMP   TYQU      /YES: TELL OUTSIDE WORLD
+       TAD I BFR       /NO: ACCEPT BUFFER 
+       RTR
+       RTR             /4 BITS RIGHT
+       AND   C7000     /ISOLATE DTA
+       JMS     REPEAT  /GO CHECK FOR REPEATED DTA AND STORE #
+       ISZ     BFR     /INCREMENT INPUT BUF. PTR.
+       JMP     CRCHK   /GO LOOK AT NEXT CHAR.
+
+/THIS SECTION CHECKS TO SEE IF THERE HAS BEEN ANY
+/VALID INPUT ONCE A CARRIAGE RETURN IS SEEN
+OKCR,  CLA             /CLEAR AC
+       TAD     CRFLAG  /LOAD CR FLAG; 0 MEANS NO GOOD
+       SNA     CLA
+       JMP     START   /0: NO VALID INPUT; RESTART
+       TAD     DCTR    /NOT 0: SO HAVE VALID INPUT
+       TAD     DBUFAD  /CALCULATE END OF DTA LIST +1
+       DCA     DBUFPT  /STORE IT IN BUFFER POINTER, THEN
+       CMA             /COMPLEMENT THE AC AND
+       DCA I   DBUFPT  /TERMINATE DTA LIST WITH 7777
+INIT1, CLA             /CLEAR AC IF COME THRU LOC IT
+       TAD     DBUFAD  /AND RESET LIST POINTER
+       DCA     DBUFPT  /TO START OF LIST
+       JMS I   GETDTA  /GO GET A DTA NUMBER
+
+/INFORM THE OPERATOR THAT THE PROGRAM IS SET TO START
+/TYPE "DIRECT" AND WAIT FOR THE REPLY
+
+INIT,  JMS I TYPE      /MESSAGE OUT
+       0411  /DI
+       2205  /RE
+       0324  /CT
+       7740  /?
+       0000  /END
+       JMS I TYPIN     /WAIT FOR A REPLY
+       JMS I COMPAR    /DID HE TYPE "MARK"?
+       0315  /M
+       0301  /A
+       0322  /R
+       0313  /K
+       0000  /END
+       JMP   .+3
+       JMP I .+1
+       MARK            /TO MARK A TAPE
+\f/SEE IF HE TYPED "RDR" (READ AND TYPE FIRST 12
+/BLOCK NUMBERS IN REVERSE).
+
+       JMS I COMPAR
+       0322  /R
+       0304  /D
+       0322  /R
+       0000  /0
+       JMP   .+3
+       JMP I .+1
+       RDR             /TYPE BLOCKS 
+
+/SEE IF HE TYPED "RDF" (READ AND TYPE FIRST 12
+/BLOCK NUMBERS FORWARD).
+
+       JMS I COMPAR
+       0322  /R
+       0304  /D
+       0306  /F
+       0000  /0
+       JMP   .+3
+       JMP I .+1
+       RDFA            /TYPE BLOCKS
+
+/SEE IF HE TYPED "SAME" (MEANING MARK A TAPE
+/USING THE SAME CONSTANTS AS BEFORE).
+
+       JMS I COMPAR
+       0323  /S
+       0301  /A
+       0315  /M
+       0305  /E
+       0000  /0
+       JMP   .+3
+       JMP I .+1
+       RSTSM           /TO MARK AS BEFORE
+
+/SEE IF HE TYPED "RESTART"
+
+       JMS I COMPAR
+       0322  /R
+       0305  /E
+       0323  /S
+       0324  /T
+       0301  /A
+       0322  /R
+       0324  /T
+       0000  /0
+       JMS   QU        /MUST BE NONSENSE
+       JMP     START   /START ALL OVER
+GETDTA,        NUDTA           /POINTER TO ROUTINE TO SWITCH UNITS
+CRFLAG,        0               /=0, CR NO GOOD; NOT 0, CR IS OK
+\f/
+\f      *1200
+/MARK WAS TYPED IN, IF W1-1 IS NOT A "K",ASSUME THAT
+/A NUMBER WAS TYPED IN, AND VERIFY THIS. IF W1-1 IS
+/A "K", ASSUME STANDARD FORMAT.(W1=LAST ENTRY INTO THE BUFFER)
+
+MARK,  TAD   BINCON    /ADDRESS OF FIRST BINARY
+       DCA   W5        /CONSTANT FOR DEC TO BIN
+       DCA   TOTAL     /WILL BE BINARY EQUIVILANT
+
+/SAVE C(X1) FOR DECREMENT THROUGH BUFFER
+
+DNC,   CLA   CMA       /DECREMENT BUFFER ADDRESS
+       TAD   W1        /ADDRESS BY 1
+       DCA   W1        /W1=SWEEP ADDRESS
+
+/LOOK FOR END OF PROCESSING BY LOOKING FOR A "K" IN BUFFER
+
+       TAD   LETK      /LETTER ASCII "K"
+       CIA             /SUBTRACT FROM CHARACTER
+       TAD I W1        /IN BUFFER
+       SNA   CLA       /EQUAL?
+       JMP   DIV3      /YES: SEE IF DIVISIBLE BY 3
+
+/VERIFY THIS CHARACTER AS BEING OF DECIMAL ORIGIN
+
+       TAD   C260      /ASCII FOR 0
+       CIA             /TO SEE IF CHARACTER
+       TAD I W1        /IS LESS THAN 260
+       SPA   CLA       /IS IT?
+       JMP I QU1       /YES: NOT DECIMAL CHARACTER
+       TAD   C271      /ASCII FOR 9
+       CMA             /TO SEE IF GREATER THAN
+       TAD I W1        /9
+       SMA   CLA       /IS IT?
+       JMP I QU1       /NOT A DECIMAL CHARACTER
+\f/CHARACTER IS DECIMAL. NOW CONVERT IT TO BINARY
+/REMEMBER POSITION OF CHARACTER IN BUFFER MAY BE
+/10,100,1000.
+
+       TAD I W1        /ISOLATE THE NUMBER
+       AND   C0017     /FOR PROPER CONVERSION
+       SNA             /IF 0, NO BINARY CONVERSION NEEDED
+       JMP   IBS       /YES: 0: INCREMENT BINARY CONVERSION
+
+/NOT 0, SET UP CONVERSION LOOP
+
+       CLL   CIA       /NUMBER OF ADDITIONS
+       DCA   W4        /TO NEGATIVE FOR ISZ
+       TAD I W5        /BINARY POSITION TO C(ACC)
+       TAD   TOTAL     /ADD TO PRESENT TOTAL
+       SZL             /CHECK ON TO MANY WORDS
+       JMP I QU2       /TO MANY WORDS CALLED FOR
+       DCA   TOTAL     /KEEP RUNNING SUM
+       ISZ   W4        /LAST ADDITION?
+       JMP   .-6       /NO: ADD AGAIN
+
+/FINAL ADDITION FOR THIS POSITION COMPLETED
+
+IBS,   ISZ   W5        /NEXT POSITION
+       JMP   DNC       /DO NEXT CHARACTER
+
+/LAST CHARACTER COMPLETED. SEE IF DIVISIBLE BY 3
+/IF NOT A NORMAL INPUT
+
+DIV3,  TAD   TOTAL     /GET TOTAL WORDS
+       SNA             /IF TOTAL 0, NORMAL INPUT
+       TAD   C201      /129 OCT. THIS TEST REDUNDANT
+       TAD   C0017     /ADD CONSTANT 15 TO TOTAL
+       DCA   TOTAL     /FOR FUTURE CONSIDERATIONS
+       DCA   VAR1      /# OF WORDS/3 FOR MARK TRACK WRITING
+       TAD   TOTAL     /RESTORE IN THE ACC
+       CLL             /TO DIVIDE BY 3, LINK KEEPS OVERFLOW
+       TAD   M3        /SUBTRACT 3
+       ISZ   VAR1      /ON EACH DIVISION, KEEP RUNNING SUM
+       SZA             /IF AC = 0,NO REMAINDER
+       SNL             /WHEN LINC GOES TO 0, DIVISION ENDED
+       SKP             /NOW SEE IF IT DIVIDED EVENLY
+       JMP   .-6       /SUBTRACT 3 MORE
+       SZA   CLA       /IF 0,OK. OTHERWISE ERROR
+       JMP I QU4       /NOT DIVISIBLE BY 3
+
+/CORRECT "VAR1" ( THE NUMBER OF WORDS/3) FOR THE +15
+/ADDED JUST ABOVE AND AN INHERANT +2 DUE TO MARK TRACK
+/CONFIGURATION TO BE WRITTEN.
+
+       TAD   M7        /SUBTRACT 7 FROM PHONY SETUP
+       TAD   VAR1      /GIVING THE NUMBER OF TIMES
+       CIA             /TO BE USED LATER IN A ISZ
+       DCA   VAR1      /DATA MARK WILL BE WRITTEN
+\f
+/COMPUTE A VALUE FOR TOTAL NUMBER OF BLOCKS
+/RECORD SIZE + 15 INTO 636160 OCT.
+
+       TAD   C7714     /EXTENDED 64 VALUE. SETS AC#2
+       DCA   W1        /SET FOR 640000
+       JMS I FORM10    /PATCH TO CHECK FOR STD.10 FORMAT
+       TAD   C1620     /VERNIER ADJUSTMENT FOR FORMULA
+       CLL             /ACC#2 CARRY FUNCTION
+       TAD   TOTAL     /WORD COUNT
+       ISZ   BLOCKS    /+1 TO BLOCK COUNT
+       SKP
+       JMP I QU3       /TO MANY BLOCKS CALLED FOR
+       SNL             /CARRY INTO ACC#2?
+       JMP   .-5       /NO: CONTINUE COUNT
+       ISZ   W1        /YES: FULLY DIVIDED?
+       JMP   .-10      /NO: CONTINUE PROCESS
+       CLA   CLL       /C(ACC)+ C(L)=0
+F10RTN,        TAD   BLOCKS    /FOR MARK TRACK (COME HERE FR F10PAT IF 10 FRMT)
+       CMA             /WRITING
+       DCA   VAR2      /SEE MARK WRITE
+
+/VALUES FOR BLOCK AND RECORD SIZE HAVE BEEN
+/COMPUTED. TELL OUTSIDE WORLD AND GET THE OK.
+
+       TAD   TOTAL     /SUBTRACT 15 FROM TOTAL
+       TAD   C7761     /WORDS FOOLING OPERATOR
+       DCA   TOTAL     /CORRECTED FOR TAPE WRITING
+       TAD   TOTAL     /FOR OCTAL TYPEOUT
+       JMS I TYOCT     /TYPE OCTAL WORDS
+       JMS I TYPE      /TYPE MESSAGE
+       4027  / W
+       1722  /OR
+       0423  /DS
+       5400  /, END
+       TAD   BLOCKS    /TYPE OUT BLOCK #S
+       IAC             /TO FOOL THE OPERATOR
+       JMS I TYOCT     /IN OCTAL
+       JMS I TYPE      /TYPE MESSAGES
+       4002  / B
+       1417  /LO
+       0313  /CK
+       2356  /S.
+       1713  /OK
+       7733  /?(
+       3105  /YE
+       2340  /S
+       1722  /OR
+       4016  / N
+       1735  /O)
+       4543  /CR+LF
+       0000  /END
+       JMS I TYPIN     /WAIT FOR REPLY
+\f/SEE IF A YES OR NO ANSWER WAS GIVEN
+
+       JMS I COMPAR
+       0331   /Y
+       0305   /E
+       0323   /S
+       0000   /END
+       JMP I IT
+
+/SEE IF THE DRIVE IS OK
+
+RSTSM, TAD   DT0060    /GIVE WRTM, NO GO
+       TAD   DTA       /AND DTA #
+       DTCX            /ORDER EXECUTE
+       DCA   W1        /STALL FUNCTION
+CDTRD, DTRB            /READ STATUS "B"
+       SMA   CLA       /ERROR?
+       JMP   CIZ       /NO: TIME OUT STALL
+       JMS I TYPE      /YES: INCORRECT SETUP
+       2305  /SE
+       2425  /TU
+       2077  /P
+       0000  /END
+       JMP I .+1
+       START
+
+/STALL FOR A WHILE FOR THE INTERRUPT
+
+CIZ,   ISZ   W1        /ONE ROUND'S WORTH
+       JMP   CDTRD     /OF ISZ
+       JMP I .+1
+       STMK            /OK, GO DO THE MARK TRACK
+FORM10,        F10PAT
+
+\f      *1400
+/SET THE TAPE INTO MOTION. ALL VARIABLES ARE
+/SET. FROM THIS POINT ON, CONTROL IS EXECUTED
+/VIA THE WCO INTERRUPT
+
+/CLEAR OUT STATUS "A" AND RELOAD IT WITH CONTINUOUS
+/WRITE TIMING AND MARK TRACK COMMAND
+
+STMK,  TAD   DT0360    /FWD, CONT, T+M,GO,INT
+       TAD   DTA       /ADD IN THE DTA
+       DTCX            /CLEAR FLAGS START MOTION
+       DCA   PHASE     /FOR ERROR ROUTINE
+       TAD   VAR2      /TO MAKE A RESTART FOR THE "SAME"
+       DCA   W6        /OPTION  POSSIBLE
+
+/WRITE END ZONE. WRITE ABOUT 10' OF THIS
+/CONFIGURATION.        4044
+/              0440   ON TAPE AS
+/              4404   (5555) OCTAL.
+
+       DCA   W1        /CLEAR COUNTER, 7777= ABOUT 10'
+CEZ,   TAD   REZ       /LOAD ADDRESS OF DATA
+       DCA I CA        /TO BE WRITTEN INTO THE CA
+       TAD   M3        /LOAD # WORDS TO BE WRITTEN INTO
+       DCA I WC        /WC LOCATION
+
+/WAIT FOR INTERRUPT, TEST FOR END OF
+/END ZONE WRITING.
+
+       JMS I WAIT      /FOR INTERRUPT
+       ISZ   W1        /END OF FOOTAGE?
+       JMP   CEZ       /NOT END FOOTAGE, CONTINUE 
+                       /OK, WRITE INTERBLOCK SYNC
+
+/WRITE INTERBLOCK SYNC. SINCE THIS CONFIGURATION
+/ACT AS A NOP TO THE TCU, AT THE BEGINING OF
+/TAPE, MORE LENGTH OF THIS IS NEEDED FOR TURN AROUND
+/TIME TO GUARANTEE BLOCK 0000 TO THE LIBRARY SYSTEM
+/THEREFORE AT THE BEGINING OF TAPE ONLY, WRITE SEVERAL
+/INTERBLOCK ZONES
+
+       TAD   M144      /NUMBER OF TIMES TO
+       DCA   W1        /WRITE INTERBLOCK SYNC
+       JMS   INBLSY    /WRITE 1 INTERBLOCK SYNC
+       ISZ   W1        /CONFIGURATION, TEST END
+       JMP   .-2       /NOT TOTAL FOOTAGE. WRITE AGAIN
+       JMP   WDZ       /COMPLETED, GO ON
+\f/AT NORMAL RETURN, WRITE ONLY ONE INTERBLOCK SYNC 
+/CONFIGURATION. APPEARS AS     0404
+/                              0404   ON TAPE AS
+/                              0404   2525 OCTAL
+
+INBLSY,        0
+       TAD   IBZ       /COUNTER AND WORD
+       DCA I CA        /COUNT WITH KEYS
+       TAD   M3        /FOR CONTROL
+       DCA I WC        
+       TAD   VAR1      /RESET THE WORDS
+       DCA   W5        /PER BLOCK COUNTER
+
+/WAIT FOR INTERRUPT, RETURN TO SEQUENCE
+
+       JMS I WAIT      /FOR INTERRUPT
+       JMP I INBLSY
+
+
+/WRITE FORWARD BLOCK MARK AND REVERSE GUARD
+/THREE WORDS   0404
+/              4004   ON TAPE AS
+/              4040   2632 OCTAL
+
+WDZ,   TAD   FBM       /ADDRESS OF PATTERN
+       DCA I CA        /TO CURRENT ADDRESS
+       TAD   M3        /NUMBER OF WORDS
+       DCA I WC        /TO WORD COUNTER
+       JMS I WAIT      /DROP THROUGH AFTER WRITE
+
+
+/WRITE LOCK MARK, REVERSE CKSUM, REVERSE FINAL,REV PREFINAL
+/SIX WORDS     1. 0040   4. 0040
+/              2. 0000   5. 0000   ON TAPE OCTAL
+/              3. 4000   6. 4000   10101010
+
+       TAD   WLMRF     /ADDRESS OF PATTERN
+       DCA I CA        /TO CURRENT ADDRESS
+       TAD   M6        /NUMBER OF WORDS
+       DCA I WC        /TO WORD COUNTER
+       JMS I WAIT      /DROP THROUGH AFTER WRITE
+
+
+/   WRITE THE DATA TRACK. SINCE THE LENGTH OF EACH
+/RECORD IS A VARIABLE, "VAR1" KEEPS TRACK OF THE
+/NUMBER OF TIMES THIS CONFIGURATION WILL BE WRITTEN
+/"VAR1" WAS DECIDED FROM ABOVE IN THE FORMULA
+/TRANSLATION SECTION
+/THREE WORDS   4440
+/              0044   ON TAPE AS
+/              4000   7070 OCTAL
+DTRK,  TAD   DZ        /LOAD ADDRESS OF THE DATA
+       DCA I CA        /CONFIGURATION INTO CA
+       TAD   M3        /LOAD # WORDS
+       DCA I WC        /INTO WORD COUNT
+\f/WRITE ONE SET TEST "VAR1" FOR LAST SET
+
+       JMS I WAIT      /ONE CONFIGURATION
+       ISZ   W5        /LAST?
+       JMP   DTRK      /NOW WRITE DATA MARK TRACK AGAIN
+
+/   MARK TRACK CODE FOR DATA IS COMPLETE. NOW WRITE
+/PREFINAL, FINAL, CHECKSUM AND REVERSE CHECKSUM.
+/SIX WORDS     1 4440   4 4440
+/              2 4444   5 4444   ON TAPE AS
+/              3 4044   6 4044   73737373 OCTAL
+
+       TAD   FEZ       /LOAD ADDRESS OF
+       DCA I CA        /DATA CONFIGURATION INTO CA
+       TAD   M6        /LOAD # WORDS
+       DCA I WC        /INTO WORD COUNT
+       JMS I WAIT      /TILL COMPLETED WRITE
+
+
+
+/WRITE GUARD, REVERSE BLOCK
+/THREE WORDS   4040
+/              0440   ON TAPE AS
+/              0404   5145 OCTAL
+
+       TAD   GRZ       /DATA ADDRESS TO
+       DCA I CA        /THE CA
+       TAD   M3        /NUMBER OF WORDS
+       DCA I WC        /TO WORD COUNT
+       JMS I WAIT      /TILL COMPLETE
+
+
+
+/THIS COMPLETE SET OF DATA TRANSFERES
+/COMPLETES ONE BLOCK ON TAPE. SINCE THE 
+/NUMBER OF BLOCKS IS VARIABLE, "VAR2" IS
+/USED TO RECYCLE. "VAR2" WAS SET UP ABOVE IN
+/THE FORMULA TRANSLATION SECTION
+
+       JMS   INBLSY    /WRITE INTERBLOCK SYNC
+       ISZ   W6        /TOTAL NUMBER OF BLOCKS
+       JMP   WDZ       /WRITTEN? NO:
+
+
+\f/ALL DATA BLOCKS HAVE BEEN WRITTEN.
+/NOW PROVIDE A BUFFER ZONE OF INTERBLOCK SYNC AT THE END
+/OF TAPE AS AT THE START OF TAPE
+
+       TAD   M144      /ABOUT TWO BLOCKS(STANDARD) WORTH
+       DCA   W1        /ABOUT 100 TIMES
+       JMS   INBLSY    /WRITE ONE PATTERN
+       ISZ   W1        /AT END YET?
+       JMP   .-2       /NO CONTINUE WRITING INTERBLOCK SYNC
+
+/COMPLETED BLOCK WRITING
+/WRITE ANOTHER 10' OF END ZONE (FORWARD)
+/BEFORE LOADING BLOCK NUMBERS.
+/THREE WORDS   0400
+/              4004   ON TAPE AS
+/              0040   2222 OCTAL
+
+       DCA   W1        /ISZ=10 FEET
+WEZF,  TAD   EZM       /LOAD ADDRESS OF DATA
+       DCA I CA        /INTO CA
+       TAD   M3        /NUMBER OF WORDS
+       DCA I WC        /WORD COUNT
+
+/WRITE 1 SET, CHECK END OF 10'.
+
+       JMS I WAIT      /TILL COMPLETE
+       ISZ   W1        /END OF FOOTAGE?
+       JMP   WEZF      /NO, CONTINUE WITH END ZONE
+       JMP I .+1       /GO AND START BLOCK NUMBER 
+       MWTM            /SEQUENCING
+\f/THESE ARE THE DATA CONFIGURATIONS FOR THE MARK TRACK
+
+
+/REVERSE END ZONE
+
+REZ,   .
+       4044    /ON TAPE AS 5555 (OCT)
+       0440
+       4404
+
+/INTERBLOCK SYNC
+
+IBZ,   .
+       0404    /ON TAPE AS 2525 (OCT)
+       0404
+       0404
+
+/FORWARD BLOCK MARK AND REVERSE GUARD
+
+FBM,   .
+       0404    /ON TAPE AS 2632 (OCT)
+       4004
+       4040
+
+/LOCK MARK, REVERSE CHECKSUM, REVERSE FINAL
+/AND REVERSE PREFINAL
+
+WLMRF, .
+       0040    /ON TAPE AS 10101010 (OCT)
+       0000
+       4000
+       0040
+       0000
+       4000
+
+/DATA MARK
+
+DZ,    .
+       4440    /ON TAPE AS 7070 (OCT)
+       0044
+       4000
+
+/PREFINAL, FINAL, FWD CHECKSUM, AND REVERSE LOCK
+
+FEZ,   .
+       4440    /ON TAPE AS 73737373 (OCT)
+       4444
+       4044
+       4440
+       4444
+       4044
+\f/FORWARD GUARD AND REVERSE BLOCK NUMBER
+
+GRZ,   .
+       4040    /ON TAPE AS 5145 (OCT)
+       0440
+       0404
+
+/FORWARD END ZONE
+
+EZM,   .
+       0400    /ON TAPE AS 2222 (OCT)
+       4004
+       0040
+/SUBROUTINE TO SEE IF USER TYPED MARK 384
+/TO SPECIFY STANDARD PDP-10 FORMAT
+F10PAT,        0
+       DCA     BLOCKS  /CLEAR LOC. BLOCKS IN CASE NOT 10-FORMAT
+       TAD     TOTAL   /AND GET NUMBER TYPED BY USER
+       TAD     M617    /WAS IT 384?
+       SZA     CLA
+       JMP I   F10PAT  /NO-RETURN
+       DCA     W1      /YES-CLEAR W1 FOR WAIT LOOP
+       TAD     C1101   /AND ADJUST BLOCK TOTAL FOR
+       DCA     BLOCKS  /1102(OCTAL) BLOCKS.
+       JMP I   .+1
+F10BAK,        F10RTN
+M617,  -617
+C1101, 1101
+\f
+       *1600
+/THE MARK TRACK HAS BEEN WRITTEN, AND TAPE IS
+/MOVING FORWARD IN THE FORWARD END ZONE. STOP
+/THE TAPE AND SEE IF THERE ARE ANY TAPES LEFT TO
+/MARK--IF SO GO DO THEM, ELSE TELL OPERATOR TO THROW THE
+/"NORMAL/WRTM/RDTM" SWITCH TO "NORMAL"
+/HE WILL THEN CONTINUE AFTER THIS ACTION
+
+/KILL WRITE, STOP TAPE
+
+MWTM,  TAD   DT0070    /STOP TAPE WITH SELECT ERROR
+       TAD   DTA       /LOAD DTA INTO ORDER
+       DTCX            /EXECUTE THE ABOVE
+       JMS     NUDTA   /ANY MORE DTAS TO MARK?
+       JMP I   DOMARK  /YES: GO MARK THEM
+
+/MESSAGE TO OPERATOR
+
+       JMS I TYPE      /NO: BACK TO FIRST DTA AND CONTINUE
+       2305  /SE
+       2440  /T
+       2327  /SW
+       1124  /IT
+       0310  /CH
+       4024  / T
+       1740  /O 
+       1617  /NO
+       2215  /RM
+       0114  /AL
+       0000  /END
+       JMS I TYPIN     /WAIT FOR CR
+
+/REVERSE TAPE FOR A FEW SECONDS TO GUARANTEE
+/BLOCK MARK SECT WILL BE UNDER THE HEAD
+
+PSER,  TAD   DT0600    /REVERSE, MOVE, GO
+       TAD   DTA       /ADD DTA TO ORDER
+       DTCX            /CLEAR TCU,GET MOVING IN REVERSE
+
+/STALL A FEW SECONDS
+
+       TAD   M300      /AROUND 2 SECONDS
+       DCA   W2        /MAJOR STALL
+MSTALL,        ISZ   W1        /MINOR STALL
+       JMP   .-1       /LOOP MINOR
+       DTSF
+       SKP
+       JMP     PSER
+       ISZ   W2        /MAJOR STALL
+       JMP   MSTALL    /LOOP MAJOR
+\f/TAPE OUT ON MARK TRACK NOW, TURN AND GET IT
+/MOVING FORWARD. AT THIS POINT, THE LAST REVERSE
+/BLOCK NUMBER WILL BE WRITTEN UNTILL END ZONE IS
+/REACHED. THEREFORE, WHEN THE BOUNCE OUT OF THE END
+/ZONE TAKES PLACE, THE SYSTEM WILL BE ABLE TO SYNC ON
+/THE REVERSE BLOCK NUMBER TO WRITE THE REST OF
+/THE BLOCK NUMBERS AND KNOWN GOOD DATA IN REVERSE.
+/THIS PROCESS WILL ELIMINATE A NEEDLESS REWIND AND
+/KEEP THE ENTIRE PROCESS TO TWO COMPLETE PASSES
+
+/WRITE LAST REVERSE BLOCK NUMBER  GOING FORWARD
+
+       TAD     RZ
+       DCA I   CA
+       TAD   DT0210    /FORWARD, SEARCH, GO
+       TAD   DTA       /ADD IN THE DTA
+       DTCX            /CLEAR STATUS "A" AND RELOAD IT
+       TAD   C1        /PHASE 1 ERROR
+       DCA   PHASE     /FOR ERROR ROUTINE
+
+/WAIT HERE FOR DECTAPE FLAG. CHECK ALSO FOR ERRORS
+/SET BLOCK NUMBER (REVERSE) INTO FORM
+
+       TAD   BLOCKS    /INTO AC WITH LAST BLOCK NUMBER
+       JMS I MESS      /CONVERT BLOCK NUMBER FOR TAPE
+
+/INTERRUPTED? ERROR?
+
+       DTRB            /READ STATUS "B"
+       RAR             /DECTAPE FLAG TO LINK
+       SNL   CLA       /FLAG SET?
+       JMP   .-3       /NO: CONTINUE WAIT
+
+/BLOCK FOUND. SWITCH TO READ DATA WITH WC ONE LESS THAN
+/NUMBER OF WORDS TO BE READ. READ TILL WC=0
+
+       TAD   DT0130    /TO SET STATUS "A" INTO
+RCYBR, DTXA            /THE READ DATA MODE
+       CLA   CMA       /SUBTRACT 1 FROM TOTAL
+       TAD   TOTAL     /GIVING TOTAL-1 (HO HO)
+       CMA             /INVERT FOR ISZ
+       DCA I WC        /SET WC
+       TAD   C4        /NOP
+       DCA I CA        /JIMMIED TO DO NOTHING
+       DTRB            /READ "B" REGISTER
+       AND   C1000     /ISOLATE END ZONE BIT
+       SZA   CLA       /END ZONE?
+       JMP I GDBLK     /YES: GO AND WRITE THE BLOCK NUMBERS
+       TAD I WC        /WAIT TILL WORD COUNT ZERO
+       SZA   CLA       /EQUAL TO ZERO?
+       JMP   .-10      /NO: LOOP AGAIN
+\f/END OF BLOCK FOUND. WRITE JUNK AND REVERSE BLOCK NUMBER
+
+       TAD   M14       /12 WORDS TO BE WRITTEN
+       DCA I WC        /TO WORD COUNT REG.
+       TAD   FORMB     /FORM TO CA
+       DCA I CA        /OF NUMBERING FORM
+       TAD   DT0070    /SWITCH TO WRITE ALL
+       DTXA            /MODE.
+
+/LOOK FOR THE DECTAPE FLAG INDICATING ANOTHER RECYCLE
+
+       DTRB            /NO: GET "B" AGAIN
+       RAR             /FLAG TO LINK
+       SNL   CLA       /FLAG SET?
+       JMP   .-3       /NO: BE PATIENT. HAST NOT.
+       TAD   DT0070    /TO SWITCH TO READ DATA
+       JMP   RCYBR
+GDBLK, DOBLK
+DOMARK,        STMK    /POINTER TO START OF MARK ROUTINE
+
+/SUBROUTINE TO GET NEXT DTA UNIT # FROM INPUT LIST OR
+/RECYCLE TO FIRST UNIT IF ALL HAVE BEEN PROCESSED UP TO
+/THIS POINT--CALL SEQUENCE
+/      JMS NUDTA       /CALL THE ROUTINE
+/      (RETN1)         /RETURNS HERE IF MORE DTAS TO PROCESS
+/      (RETN2)         /RETURNS HERE IF END OF LIST
+/END OF LIST MEANS RESET TO FIRST AND RETURN TO (RETN2)
+/RETURN IS  WITH DTA SET TO NEW VALUE AND AC=0
+
+NUDTA, 0
+       TAD I   LSTPT   /GET CURRENT VALUE OF DTA LIST PTR
+       DCA     TBUFPT  /STORE IT AS TEM. BUF. PTR.
+       TAD I   TBUFPT  /GET A DTA # FROM THE LIST
+       AND     C0007   /ISOLATE LOW ORDER DIGIT
+       SZA     CLA     /IS IT 7777?
+       JMP     LSTEND  /YES: END OF LIST
+       TAD I   TBUFPT  /NO: GET IT BACK
+       DCA     DTA     /AND STORE AS NEW DTA #
+       ISZ I   LSTPT   /INCREMENT LIST POINTER
+       JMP I   NUDTA   /RETURN
+/COMES HERE AT END OF LIST TO RESET PTRS AND RETN TO CALL+2
+LSTEND,        ISZ     NUDTA   /INCREMENT RETURN POINTER
+       TAD I   STRTPT  /GET ADR. OF START OF LIST
+       DCA I   LSTPT   /STORE TO RE-INITIALIZE LIST PTR.
+       JMP     NUDTA+1 /GO GET FIRST DTA # AND RETURN
+
+STRTPT,        DBUFAD  /POINTER TO START OF DTA LIST
+TBUFPT,        0       /TEM. STORAGE FOR BUF. PTR.
+LSTPT, DBUFPT  /POINTER TO CURRENT VALUE OF DTA LIST PTR
+DTABUF,        0       /START OF DTA # LIST - MAX. 9 WORDS
+RZ,    .+1
+       0
+/SUBROUTINE TO CHECK FOR REPEATED DTA NUMBERS
+/DTA # TO COMPARE TO LIST IS IN AC ON ENTRY--THIS
+/ROUTINE STORES THE DTA # IF IT IS NEW AND IGNORES IT
+/IF IT IS NOT-CALL BY JMS REPEAT WITH DTA # IN AC
+REPEAT,        0
+       DCA     DNUM    /TEM STORAGE FOR NEW DTA #
+       TAD     DBUFAD  /INITIALIZE POINTER (DBUFPT)
+       DCA     DBUFPT  /TO START OF DTA LIST
+       TAD     DCTR    /LOAD NUM. OF DTAS STORED
+       CMA             /COMPLEMENT IT
+       DCA     COMCTR  /STORE IN COMPARE COUNTER
+COMCHK,        ISZ     COMCTR  /DONE WITH ALL COMPARES?
+       JMP     DOCOMP  /NO: GO DO COMPARE
+       TAD     DNUM    /YES: STORE NEW DTA#
+       DCA I   DBUFPT  /AT END OF LIST
+       ISZ     DCTR    /INCR. # OF DTAS STORED
+       JMP I   REPEAT  /RETURN
+
+/THIS SECTION DOES THE ACTUAL COMPARISON BETWEEN
+/THE DTA# PASSED TO THE ROUTINE AND A NUMBER ON THE LIST
+
+DOCOMP,        TAD I   DBUFPT  /GET NEXT DTA NUMBER FROM LIST
+       CIA             /NEGATE IT
+       TAD     DNUM    /ADD IN DTA NUMBER PASSED
+       SNA     CLA     /ARE THEY THE SAME?
+       JMP I   REPEAT  /YES: RETURN
+       ISZ     DBUFPT  /NO: INCREMENT LIST POINTER
+       JMP     COMCHK  /SEE IF DONE ALL COMPARES
+/
+/
+COMCTR,        0       /COUNTER FOR # OF LIST COMPARISONS TO BE DONE
+DCTR,  0       /COUNTER FOR # OF DTAS IN LIST
+DBUFAD,        DTABUF  /START OF DTA NUM. LIST
+DNUM,  0       /TEM STORAGE FOR DTA #
+/
+\f      *2000
+/GO INTO SEARCH IN REVERSE MODE LOOKING FOR
+/THE LAST BLOCK NUMBER. WHEN FOUND, SYNC THE SYSTEM
+/AND WRITE ALL DATA AND BLOCK NUMBERS
+
+DOBLK, JMS I TURN      /INTO REVERSE AND SEARCH MODE
+       TAD   BLOCKS    /TO SET UP
+       DCA   BLOCKA    /FOR BLOCK DECREMENTING
+       TAD   C2        /PHASE 2 ERROR
+       DCA   PHASE     /FOR ERROR ROUTINE
+
+/LOOK FOR INTERRUPT INDICATING BLOCK NUMBER
+
+       JMS I WAIT      /FOR DECTAPE FLAG
+
+/SWITCH TO WRITE ALL. SYSTEM NOW IN SYNC
+
+       TAD   DT0140    /SWITCH TO WRITE ALL
+       DTXA            /EXECUTE ORDER
+NEXTBN,        TAD   ADF3      /ADDRESS OF FIRST 3 WORDS INCLUDING
+       DCA I CA        /THE FORWARD CHECKSUM TO BE WRITTEN
+       TAD   M3        /NUMBER OF WORDS TO BE WRITTEN
+       DCA I WC        /TO WORD COUNT
+       JMS   CEZN      /CHECK FOR END ZONE
+       TAD I WC        /CHECK FOR WC=0
+       SZA   CLA       /=0?
+       JMP   .-3       /NOPE: TRY AGAIN
+       DTXA            /YUP: CLEAR THE FLAG
+
+/WRITE DATA TRACK. REMEMBER CORRECT DATA IS BEING WRITTEN
+
+       TAD   TOTAL     /ONE FROM TOTAL NUMBER
+       CIA             /OF WORDS FOR COUNTING
+       DCA I WC        /DATA WORDS WRITTEN
+       TAD   AD7777    /ADDRESS OF SEVENS
+       DCA I CA        /DATA TO BE WRITTEN
+
+/MONITOR WORD COUNT FOR A ZERO READING
+/SOME OF THIS TIME IS USED TO SET THE NEXT
+/BLOCK NUMBER INTO THE FORM.
+
+       TAD   BLOCKA    /CURRENT BLOCK NUMBER
+       JMS I MESS      /CONVERT INTO FORM
+       CLA   CMA       /TO DECREMENT
+       TAD   BLOCKA    /THE BLOCK COUNT
+       DCA   BLOCKA    /DOWN TO ZERO
+       JMP   CEZB      /BYPASS FOLLOWING ROUTINE
+
+/CHECK FOR END ZONE
+CEZN,  0
+       DTRB            /READ STATUS "B"
+       AND   C1000     /ISOLATE END ZONE
+       SNA   CLA       /HAVE IT?
+       JMP I CEZN      /NOT EZ, RETURN
+       JMP I GDBN      /COMPLETED
+\f/CHECK HERE ALSO TO SEE IF END ZONE, INDICATING
+/THAT THE LAST BLOCK HAS BEEN WRITTEN
+
+CEZB,  JMS   CEZN      /END ZONE?
+
+/LOOK FOR WORD COUNT AS BEING EQUAL TO ZERO
+
+       TAD I WC        /WC TO C(AC)
+       SNA   CLA       /END OF DATA WRITE?
+       JMP   WBN       /YES: GO TO WRITE BLOCK NUMBER
+       TAD   AD7777    /RESET CURRENT ADDRESS COUNT
+       DCA I CA        /DON'T LET THE CA ADVANCE TO
+       JMP   CEZB      /MUCH
+
+/DATA HAS BEEN WRITTEN. NOW WRITE REVERSE
+/BLOCK NUMBER, FORWARD BLOCK NUMBER, AND REVERSE
+/CHECKSUM. (12 WORDS)
+
+WBN,   DTXA            /CLEAR OUT DECTAPE FLAG
+       TAD   M14       /WILL WRITE 12 WORDS
+       DCA I WC        /FOR THIS BIT
+       TAD   FORMA     /FROM A FORM CONTAINING
+       DCA I CA        /BLOCK NUMBERS
+
+/WAIT FOR END
+
+       JMS   CEZN      /END ZONE?
+       TAD I WC        /NO: SEE IF DONE THE WRITE
+       SZA   CLA       /DONE YET ?
+       JMP   .-3       /NO: PATIENCE IS A VIRTUE????
+       DTXA            /RESET THE CURRENT FLAG
+       JMP   NEXTBN    /YES: GO RECYCLE COMPLETLY
+GDBN,  DBN
+
+/ FIRST 3 WORDS TO BE WRITTEN
+
+ADF3,  .
+       0000
+       0000
+       0077
+
+/DATA TO BE WRITTEN ON TAPE (REVERSE)
+
+AD7777,        .
+       7777
+       7777
+       7777
+       7777
+/CHECK IF ALL DTAS ARE DONE BEFORE RESTARTING
+
+SETDTA,        JMS I   GDTA    /ALL DTAS DONE?
+       JMP I   CONTNU  /NO: BACK TO WRITE BLOCK #S ON NEXT
+       JMP I   IT      /YES: GO ASK "DIRECT?"
+GDTA,  NUDTA   /POINTER TO SUBR FOR GETTING NEXT UNIT #
+CONTNU,        PSER    /POINTER TO START OF BLOCK # WRITE ROUTINE
+\f
+
+/TYPE ONE FOUR CHARACTER OCTAL WORD GIVEN TO THE 
+/ROUTINE VIA C(ACC). C(ACC)=0 ON EXIT
+
+TYCT,  0
+       DCA   TW1       /STORE WORD GIVEN
+       TAD   TW1       /TO C(ACC) AGAIN
+       RTR
+       RTR             /6 BITS GIGHT
+       RTR
+       DCA   TYCT1+2   /SAVE ROTATED VALUE, 1ST TWO
+       TAD   TYCT1+2   /TO C(ACC) AGAIN
+       AND   C0007     /ISOLATE SECOND CHARACTER
+       TAD   C6060     /CONVERT TO ASCII
+       DCA   TYCT1+1   /STORE AS FIRST PARTIAL 2
+       TAD   TYCT1+2   /ROTATED VALUE STORED ABOVE
+       RTL
+       RAL             /3 BITS LEFT
+       AND   C0700     /ISOLATE FIRST CHARACTER
+       TAD   TYCT1+1   /CONVERT 1ST TO ASCII
+       DCA   TYCT1+1   /1ST AND 2ND CHARACTERS READY
+       TAD   TW1       /ORIGIONAL WORD
+       AND   C0007     /ISOLATE 4TH CHARACTER
+       TAD   C6060     /CONVERT 4 TH TO ASCII
+       DCA   TYCT1+2   /STORE 4TH FOR A MOMENT
+       TAD   TW1       /ORIGIONAL WORD
+       RTL
+       RAL             /POSITION IT 3RD CHARACTER
+       AND   C0700     /ISOLATE 3RD CHARACTER
+       TAD   TYCT1+2   /CONVERT TO ASCII
+       DCA   TYCT1+2   /CONVERSION COMPLETE
+TYCT1, JMS I TYPE      /TYPE THE FOUR CHARACTERS
+       0               /FIRST 2
+       0               /SECOND 2
+       0               /KILL KEY
+       JMP I TYCT      /EXIT FROM ROUTINE
+
+/SOME CONSTANTS FOR THE ROUTINE
+
+TW1,   0000
+C6060, 6060
+\f      *2200
+/VERIFY THE TAPE AS BEING WRITTEN CORRECTLY
+/WITH DATA AND BLOCK NUMBERS. THE INFORMATION WRITTEN
+/WAS WRITTEN IN SUCH A WAY AS TO BE CORRECT 
+/UPON READING IT BACK
+
+
+/TURN TAPE AND HAVE IT GOING FORWARD
+
+DBN,   TAD   ISZV      /RESET INCREMENT
+       DCA   VISZ      /BLOCK NUMBERS FORWARD
+       DCA   FCON      /WILL BE ZEROS FORWARD
+       DCA   W1        /FIRST BLOCK NUMBER FORWARD
+       TAD   C0400     /TURN TO GO FORWARD
+DBNAUX,        JMS I TURN      
+       TAD   C3        /ERROR IN PHASE 3
+       DCA   PHASE     /FOR ERROR ROUTINE
+
+/SET SOME OF THE CONTROL REGS
+
+DAB,   DCA I WC        /WORD COUNT DON'T CARE
+       TAD   ADBA      /SOME WHERE UP ABOVE
+       DCA I CA        /TO GET BLOCK NUMBERS
+
+/WAIT FOR INTERRUPT
+
+       JMS I WAIT      /INTERRUPT
+       TAD   W1        /FIRST OR NEXT BLOCK NUMBER
+       CIA             /TO COMPARE
+       TAD I ADBA      /GET THE BLOCK NUMBER
+       SZA   CLA       /COMPARE OK?
+       JMP   BLKERZ    /BLOCK ERROR FOUND
+
+/BLOCK COMPARES, NOW CHECK DATA
+
+       TAD   DT0030    /TO SWITCH INTO READ
+       DTXA            /DATA MODE
+       DCA I WC        /DON'T CARE ABOUT THE WC
+CTST,  TAD   ADWA      /FOR COMPARING
+       DCA I CA        /FROM TAPE
+
+/EVERY TIME THE WORD COUNT MOVES
+/A DATA TRANSFERE HAS BEEN COMPLETED.
+/MAKE SURE THAT THE INFORMATION IS OK
+
+       TAD I WC        /GET WORD COUNT
+       SNA   CLA       /STILL AT ZERO?
+       JMP   CEFR      /YES: SEE IF AT END
+       TAD   FCON      /NO: SEE IF DATA
+       CIA             /IS SAME AS WRITTEN
+       TAD I ADWAB     /RECEIVED DATA
+       SZA   CLA       /SAME?
+       JMP DTAR        /DATA ERROR FOUND
+       DCA I WC        /YES: RESET WORD COUNT
+\f/CHECK FOR DECTAPE FLAG INDICATING END OF
+/BLOCK OR ERROR
+
+CEFR,  DTRB            /READ "B" REGISTER
+       SPA             /ERROR?
+       JMP   PARIR     /PARITY ERROR, I GUESS
+
+/NO ERROR, END OF BLOCK?
+
+       RAR             /FLAG TO THE LINK
+       SNL   CLA       /END?
+       JMP   CTST      /NO: CONTINUE CHECKING
+       TAD   DT0030    /CLEAR DECTAPE FLAG
+       DTXA            /AND RETURN TO SEARCH
+
+/END OF BLOCK. SEE IF END OF TAPE
+
+       TAD   W1        /BLOCK NUMBER JUST TESTED
+VISZ,  ISZ   W1        /+1 OR -1 TO BLOCK COUNT
+       SKP
+       HLT             /ABSOLUTE PANIC
+       CIA             /TO BE COMPARED WITH
+       TAD   BLOCKS    /TOTAL BLOCKS
+       SZA   CLA       /LAST?
+       JMP   DAB       /NO, DO ANOTHER BLOCK
+
+
+/HERE PUT IN THE REVERSE CHECK
+
+DDSF,  DTSF            /WAIT FOR ANY FLAG TO APPEAR
+       JMP   .-1       /NOT YET
+       CLA   CLL       /RID  AC OF GARBAGE
+       DTRB            /READ THE "B" REGISTER
+       AND   C1000     /BETTER BE END ZONE
+       SNA   CLA       /IS IT?
+       JMP   LNE       /LAST INTERRUPT NOT END ZONE
+       DTCX            /YUP: A OK
+\f/BLOCK NUMBERS AND DATA HAVE  BEEN CHECKED FORWARD
+/AND ARE OK. USING THE ABOVE ROUTINE FOR CHECKING
+/RESET A FEW THINGS AND CHECK IN REVERSE
+
+/WAS COMPLETION FOUND FORWARD? IF SO GO CHECK
+/IN REVERSE; IF NOT GO SEE IF ALL TAPES HAVE BEEN CHECKED.
+
+
+       TAD   FCON      /IF 0'S, IT WAS FWD
+       SZA   CLA       /FWD?
+       JMP I   FINCHK  /N0: REVERSE-SEE IF ALL DTAS DONE
+
+/RESET THE ABOVE ROUTINE TO READ IN REVERSE
+
+       CMA             /DATA WILL BE AS WRITTEN
+       DCA   FCON      /I.E., 7777'S
+       TAD   SJMP      /INSTEAD OF INCREMENTING
+       DCA   VISZ      /WE WILL DECREMENT BLOCK NUMBERS
+       TAD   BLOCKS    /STARTING WITH THE HIGHEST
+       DCA   W1        /AND WILL WORK TO ZERO
+       JMP   DBNAUX    /ALL SET, TRAVEL ONWARD
+
+/RETURN HERE AFTER EACH BLOCK FOR CHECKING WHEN LAST BLOCK
+/HAS BEN PROCESSED????????????
+
+SJMP,  JMP   .+1
+       SNA             /IF AC = 0, WE ARE DONE
+       JMP   DDSF      /AND NEXT FLAG SHOULD BE END ZONE
+       CIA             /OTHERWISE, SUBTRACT ONE FROM
+       CMA             /BLOCKS GIVING BLOCKS-1......?
+       DCA   W1        /NOT DONE
+       JMP   DAB       /GO DO ANOTHER BLOCK
+
+ISZV,  ISZ   W1        /VARIABLE TAG
+FINCHK,        SETDTA
+\f/BLOCK ERROR FOUND
+
+BLKERZ,        TAD   DTA       /TO RESET TAPE 
+       DTCX            /MOTION
+       TAD I ADBA      /GET BAD BLOCK NUMBER
+       JMS I TYOCT     /AND TYPE IT OUT
+       JMS   TYSB      /TYPE "SHOULD BE"
+       TAD   W1        /GOOD BLOCK NUMBER
+       JMS I TYOCT     /TYPE IT OUT
+       JMS I TYPE
+       4002  / B
+       1413  /LK
+       4005  / E
+       2243  /R CR
+       4500  /LF+END
+DBERZ, JMP I .+1
+       ZCOM
+
+/COMMON ROUTINE
+
+TYSB,  0
+       JMS I TYPE
+       4023  / S
+       1017  /HO
+       2514  /UL
+       0440  /D 
+       0205  /BE
+       4000  / 0
+       JMP I TYSB
+
+/DATA ERROR
+
+DTAR,  TAD   DTA       /TO STOP TAPE
+       DTCX            /MOTION
+       TAD I ADWA      /GET THE BAD WORD
+       JMS I TYOCT
+       JMS TYSB        /TYPE "SHOULD BE"
+       TAD   FCON      /GOOD WORD
+       JMS I TYOCT     /TYPE IT OUT
+       JMS I TYPE
+       4004  /D
+       0124  /AT
+       0140  /A
+       0522  /ER
+       4543  /CR+LF
+       0000  /END
+       JMP   DBERZ
+\f/PARITY ERROR FOUND
+
+PARIR, JMP I .+1
+       ERROR           /MAIN ERROR ROUTINE
+
+/LAST INTERRUPT WAS NOT END ZONE
+
+LNE,   JMS I TYPE
+       1401  /LA
+       2324  /ST
+       4011  / I
+       1624  /NT
+       4016  / N
+       1724  /OT
+       4005  / E
+       1724  /OT
+       4345  /LF+CR
+       0000  /END
+       JMP   DBERZ
+\f      *2400
+/ TYPE OUT THE DTA UNIT NUMBER AND THE FIRST 12 BLOCK
+/NUMBERS IN EITHER DIRECTION. IF RDR, IN REVERSE
+/IF RDF, TYPE THEM OUT GOING IN THE FORWARD
+/DIRECTION FROM THE BEGINING OF TAPE
+
+RDFA,  TAD     C0400   /DIRECTION FOR TURNING
+       DCA     SAVEIT  /STORE DIRECTION FOR NEXT DTA UNIT
+       TAD     SAVEIT  /GET DIRECTION FOR TURNING
+       JMS I TURN      /AROUND
+       TAD   M14       /READ 12 BLOCK
+       DCA   W3        /COUNTER
+       TAD   BADD      /ADDRESS OF BUFFER
+       DCA   X2        /TO AUTO INDEX 2
+       TAD   ADW3      /ADDRESS OF W2
+       DCA I CA        /FOR DATA XFER
+       JMS I WAIT      /FOR BLOCK INTERRUPT
+       TAD   W2        /BLOCK NUMBER
+       DCA I X2        /STORE BLOCK NUMBER
+       ISZ   W3        /TOTAL = 12?
+       JMP   .-4       /NO: GRAB NEXT
+       TAD   DTA       /KILL TAPE MOTION
+       DTCX            /HERE
+
+/TYPE OUT BLOCK NUMBERS AND DTA UNIT #
+
+       JMS I   TYPE    /TYPE "DTA"
+       0424    /DT
+       0140    /A
+       0000    /END
+       TAD     DTA     /GET UNIT #
+       JMS I   TYOCT   /AND TYPE IT OUT
+       JMS I   TYPE
+       4345    /CR&LF
+       0000    /END
+       TAD   M14       /WILL TYPE ALL
+       DCA   W1        /TWELVE WORDS
+       TAD   BADD      /ADDRESS OF BLOCK
+       DCA   X2        /NUMBERS TO INDEX 2
+       TAD I X2        /FIRST OR NEXT BLOCK
+       JMS I TYOCT     /TYPE IT OUT
+       JMS I TYPE      /CR AND LINE FEED
+       4345  /CR+LF
+       0000
+       ISZ     W1      /COMPLETE?
+       JMP   .-6       /NO
+       JMS I   NEWDTA  /YES: ANY MORE DTAS?
+       JMP     RDFA+2  /YES: GO GET BLOCK #S
+       JMP I   IT      /NO: GO ASK FOR "DIRECT?"
+RDR,   JMP   RDFA+1    /OTHER DIRECTION
+
+SAVEIT,        0       /TEM. STORAGE FOR DIRECTION
+NEWDTA,        NUDTA   /POINTER TO SUBR. TO GET A NEW DTA UNIT #
+\f
+/INPUT BUFFER FOR THE TELETYPE.
+/NOTE ,,,,,,,THIS MUST BE AT THE END OF THE PROGRAM
+
+BUFFER,        0000
+
+$
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape4/KL8E.PA b/sw/os8/v3d/sources/system/dectapes/dectape4/KL8E.PA
new file mode 100644 (file)
index 0000000..e1bddea
--- /dev/null
@@ -0,0 +1,796 @@
+/17 SUPER TTY HANDLER FOR OS/8
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+
+/S.W.,S.R.,H.J.,R.L.,S.R.
+
+       *0
+
+       -1
+       DEVICE KL8E;DEVICE TTY;0;TTY&177+4000;ZBLOCK 2
+
+/TWO-PAGE TELETYPE HANDLER FOR OS/8 V3.
+/ON INPUT, RECOGNIZES ^Z, ^C, ^U, RUBOUT
+/^Z    MEANS END OF INPUT, INSERT ^Z IN BUFFER,
+/      PAD WITH ZEROES, AND ECHO "^Z"
+/^C    MEANS ABORT JOB, RETURN TO OS/8 VIA LOC 7600 TO SAVE CORE AND PRINT "^C"
+/^U    MEANS DELETE THE LAST LINE, ALLOW OPERATOR TO RETYPE
+/      (LINE STARTS AT BEGIN OF BUFFER AND IS TERMINATED BY A CR)
+/      A CR GETS ENTERED INTO BUFFER, CAUSES A LF TO ALSO ECHO
+/      AND GET ENTERED INTO BUFFER, BUFFER IS THEN PADDED WITH NULLS.
+/      CONVERTS LC TO UC
+
+/ON OUTPUT RECOGNIZES ^C, ^O, ^S, ^Q FROM KEYBOARD
+/^C    CAUSES JOB TO ABORT, RETURN TO OS/8 VIA LOCATION 7600
+/      TO SAVE CORE AND PRINT "^C"
+/^O    CAUSES ECHOING BY THE HANDLER TO CEASE
+/      TYPING ANY OTHER CHARACTER RESUMES ECHOING.
+/^S    CAUSES THE HANDLER TO STOP SENDING TO TERMINAL
+/^Q    RESUMES HANDLER SENDING
+/      ^S AND ^Q ARE IGNORED  IN OTHER CASES
+
+/WHENEVER PRINTING CHARACTERS (EITHER ON OUTPUT OR WHEN ECHOING),
+/      IGNORES NULLS
+/      FLAGS LC WITH AN APOSTROPHE
+/      HANDLES TABS CORRECTLY (SEVERAL WAYS)
+/      PRINTS ESCAPE AS $
+/      DELAYS 16 MS AFTER LINEFEEDS
+/      PRINTS CONTROL CHARACTERS AS "^K"
+
+/DOES AUTOMATIC CR/LF AT END OF LINE WIDTH.
+
+/MAINTENANCE RELEASE CHANGES:
+
+/1.    ADDED KCC FOR NON-CONSOLE TELETYPES
+
+/V3D CHANGES: (VERSION E)
+
+/1.    ADDED DELAY OPTION FOR VT78
+/2.    ADDED SCOPE RUBOUTS
+/3.    CHANGED VT78 DEFAULTS
+/4.    REARRANGED CODE FOR SET TTY ESC AND ARROW
+\f      INDVC=03
+       OUTDVC=04
+
+       KSF=10^INDVC+6001
+       KCC=10^INDVC+6002
+       KRS=10^INDVC+6004
+       KRB=KCC KRS
+       TSF=10^OUTDVC+6001
+       TCF=10^OUTDVC+6002
+       TPC=10^OUTDVC+6004
+       TLS=TCF TPC
+
+       TTYVERSION="E&77
+\f/BUILD YOUR OWN TELETYPE HANDLER:
+
+/THIS SOURCE HAS MUMBLE LOCATIONS LEFT.
+
+/THE FOLLOWING CONDITIONALS ALLOW YOU TO INCLUDE OPTIONAL FEATURES.
+/YOU MAY INCLUDE AS MANY OR AS FEW AS YOU DESIRE PROVIDED THERE
+/IS ROOM LEFT.
+
+/CONDITIONAL   LOCATIONS       LOCATIONS       INCLUDED
+/VARIABLE      PAGE 1          PAGE 2          FEATURES
+
+/ DELAY                 0               7              DELAY AFTER GIVEN CHAR
+/ CTRL          0               3              PRINT CONTROL CHARS AS ^K
+/ RUB           0               0              PRINT CHAR RUBBED OUT ON RUBOUTS
+/ SIMTAB        0              10              SIMULATE TABS AS SPACES
+/ SLOTAB        0               6              PUT OUT 2 RUBOUTS AFTER A TAB
+/ ESC           0              10              PRINT ESCAPE AS $
+/ FLAGLC        0              12              FLAG LOWER CASE CHARS ON OUTPUT
+/ CNVLC                 0               7              CONVERT LOWER CASE ON INPUT TO UPPER CASE
+/ ALTMOD        0              11              CONVERT ALTMODES (175,176) TO ESCAPE (33)
+/ PAUS          0              20              PAUSE BETWEEN PAGES
+/ FREE LOCS:    2              33
+
+       VT78=1          /SET TO 0 TO ALLOW OTHER PARAMETERS
+                       /SET TO 1 TO FORCE OTHER PARAMETERS TO VT78 COMPATIBLE
+
+       DELAY=0         /SET NON-ZERO TO ALLOW DELAY AFTER ANY CHAR (12=CR)
+                       /TYPICALLY AFTER LF FOR HIGH SPEED VT05
+                       /SET VALUE OF DELAY = 7-BIT CHAR TO DELAY AFTER
+
+       CTRL=1          /SET TO 1 TO ECHO CONTROL CHARS AS ^K
+                       /SET TO 0 TO ACCEPT CONTROL CHARACTERS AND PUT
+                       /IN BUFFER, BUT NOT ECHO THEM (EXCEPT THE USUAL)
+       RUB=1           /SET TO 0 TO ECHO EACH RUBOUT BY TYPING A BACK SLASH
+                       /SET TO 1 TO ECHO CHARS RUBBED OUT UPON RUB-OUT
+                       /SET TO 4000 TO PERFORM SCOPE TYPE RUBOUTS
+       SIMTAB=1        /SET TO 1 TO SIMULATE TABS AS THE CORRECT NUMBER OF SPACES
+                       /SET TO 0 TO TYPE TABS AS TABS
+       SLOTAB=0        /SET TO 1 TO TYPE 2 RUBOUTS AFTER A TAB
+                       /ONLY IS APPLICABLE IF SIMTAB=0
+       ALTMOD=0        /SET TO 1 TO CONVERT 175,176 TO 33
+                       /(UPPER CASE TERMINALS ONLY)
+       ESC=1           /SET TO 1 TO ECHO ESCAPE AS $
+                       /SET TO 0 TO ECHO ESCAPE AS A CONTROL CHAR (^[)
+       FLAGLC=1        /SET TO 1 TO FLAG LOWER CASE CHARS ON OUTPUT
+                       /THIS IS FOR PEOPLE NOT PRIVELIDGED ENOUGH TO
+                       /OWN A LOWER CASE TERMINAL
+                       /SET TO 0 TO PRINT LOWER CASE CHARS AS IS
+       CNVLC=0         /SET TO 1 TO CONVERT LOWER CASE CHARS ON INPUT TO UPPER CASE
+                       /SET TO 0 TO ACCEPT INPUTTED LOWER CASE CHARS AS IS
+                       /THIS IS FOR PEOPLE WHO ARE HANDICAPPED BY A LOWER CASE
+                       /TERMINAL AND ONLY WANT UPPER CASE
+       PAUS=200        /NON-0 PAUSES BETWEEN SCOPE PAGES
+       HEIGHT=30       /NUMBER OF LINES PER SCREEN
+
+/SOME OF THE ABOVE OPTIONS SHOULD ACTUALLY BE IMPLEMENTED
+/IN SUCH A MANNER THAT THE USER CAN CHANGE THEM VIA AN ALTER
+/RATHER THAN HAVE TO REASSEMBLE.
+
+       IFNZRO VT78 <
+       DELAY=0
+       CTRL=1
+       RUB=4000
+       SIMTAB=0
+       SLOTAB=0
+       ALTMOD=0
+       ESC=1
+       FLAGLC=0
+       CNVLC=0
+       IFNZRO INDVC-3 <CTRL=0>
+       >
+\f/CROSS PAGE LINKAGE:
+
+/THIS CODE MUST BE ABLE TO LOAD INTO ANY TWO PAGES OF CORE
+/THE ENTRY POINT IS AT THE NEXT LOCATION TO THE END OF THE FIRST PAGE
+/AT THE END OF THE FIRST PAGE WE JMS TO PLINK,
+/THIS LEAVES THE ADDRESS OF THE FIRST LOCATION OF THE NEXT PAGE
+/IN LOCATION 'PLINK' .  THIS JUST HAPPENS TO BE THE ADDRESS
+/OF BOTH TTYPCH AND TTYGCH.
+
+/TTYPCH AND TTYGCH SHARE THE SAME ENTRY POINT.
+/IF IT IS CALLED WITH A 0 AC, IT IS A CALL TO TTYGCH,
+/IF IT IS CALLED WITH A NON-ZERO AC, IT IS A CALL TO TTYPCH.
+
+/RETURN 1 MEANS GOT RUBOUT
+/TTYGCH TAKES RETURN 2 IF IT GOT A ^Z.
+/OTHERWISE IT TAKES RETURN 3 WITH CHARACTER GOTTEN IN AC.
+
+/TTYPCH TAKES RETURN 1 IF IT WANTS THE HANDLER TO GO AWAY,
+/I.E IF IT SAW A ^Z.
+/AC IS NORMALLY NON-ZERO UPON RETURN
+/AC IS POSITIVE MEANS DO A CRLF
+
+/WHEN ECHOING WE WANT TO CALL TTYPRT
+/BUT OTHERWISE WE WANT TO CALL TTYPCH (WHICH DOES ADDITIONAL
+/STUFF LIKE CHECK ^O, ^Q, ETC.
+/WE TELL BY WHETHER OR NOT TTYGCH HAD BEEN PREVIOUSLY CALLED.
+\f      *200
+
+PLINK, 0               /GETS ADDRESS OF TTYPCH AND TTYGCH (START OF NEXT PAGE)
+       STL CLA RAR     /4000
+       TAD I TTY       /RETRIEVE FUNCTION WORD, BUT PUT R/W BIT IN LINK
+       AND L3700       /EXTRACT NUMBER OF DOUBLE-WORDS TO TRANSFER
+       CMA             /GET COUNT+1
+       DCA BUFSIZ      /STORE AWAY
+       RDF             /FIND OUT THE USER'S DATA FIELD
+       TAD CIFCDF      /FORM OUR EXIT CIF CDF
+       DCA TTYXIT      /STORE AWAY FOR EXIT ROUTINE
+       TAD TTY70       /GET FUNCTION WORD
+L776,  AND I TTY       /ISOLATE FIELD OF BUFFER
+       TAD TTYCDF      /FORM CDF TO FIELD OF BUFFER
+       DCA TTCDBF      /STORE WHERE IT WILL BE USEFUL
+                       /AT SAME TIME, INITIALIZE TTYEOF
+       ISZ TTY         /POINT TO BUFFER ADDRESS
+       TAD I TTY       /AND GET IT
+       DCA BUFSTRT     /AND SAVE IT
+       ISZ TTY         /POINT TO BLOCK #
+TTY376,        ISZ TTY         /POINT TO ERROR RETURN
+SHIFT,                 /OUTPUT SHIFT REGISTER
+TTYEOF,                        /0 IF SAW CR OR ^Z AND WISH TO PAD BUFFER WITH 0'S
+TTCDBF,        HLT             /CDF BUFFER FIELD
+       JMP TTYKLG
+TTYLP, SNL CLA         /LINK=1 MEANS OUTPUT
+       JMP TTYGET      /INPUT IS FROM TTY:
+\f/LINK MUST BE SET FIRST TIME THROUGH HERE.
+/IT ACTS AS A GUARD BIT IN THE SHIFT REGISTER
+ROTL,  RTL
+       RTL
+       SPA             /DO WE HAVE 8 BITS SHIFTED IN?
+       JMP TELP
+       DCA SHIFT       /SAVE SHIFT REGISTER
+       TAD I BUFSTRT
+       SZA
+       JMS PUNCH       /PRINT A CHARACTER
+       TAD I BUFSTRT
+       ISZ BUFSTRT     /BUMP INPUT POINTER
+TT7400,        7400            /PROTECT ISZ
+       AND TT7400
+       CLL RAL
+       TAD SHIFT       /SHIFT HIGH ORDER 4 BITS INTO
+       JMP ROTL        /SHIFT REGISTER
+TELP,  JMS PUNCH       /PRINT 3RD CHARACTER OF DOUBLE-WORD
+       STL             /***KLUDGE
+TTYKLG,        ISZ BUFSIZ      /DONE?
+       JMP TTYLP       /NOT YET
+TTYX,  TAD TTYEOF      /IF INPUT AND WE WERE PADDING WITH 0'S
+       SZA CLA         /TAKE SOFT ERROR EXIT
+TTYRTN,        ISZ TTY         /POINT TO NORMAL RETURN
+                       /CAN'T GET ERROR OR END-OF-FILE ON OUTPUT
+TTYXIT,        HLT             /RETURN TO USER'S FIELD
+       JMP I TTY       /RETURN TO USER
+TTYCA, 0
+TTYWC, 0
+BUFSIZ,        0
+BUFSTRT,0
+TTY70, 70
+
+PUNCH, 0               /NEVER CALL TTYPCH WITH ZERO AC
+       JMS I PLINK     /CALL TTYPCH
+       JMP TTYRTN      /GO AWAY, WE SAW A ^Z
+L7700, SMA CLA         /DID WE REACH END OF TTY LINE?
+       JMS CRLF        /YES, PERFORM CR/LF
+       JMP I PUNCH     /RETURN
+
+TMP,
+CRLF,  0
+       TAD L215
+       JMS I PLINK     /CALL TTYPCH TO PRINT CR
+L215,  215             /CAN'T RETURN HERE
+       CLA             /****
+       TAD L212
+       JMS I PLINK     /CALL TTYPCH TO PRINT LF
+L212,  212             /CAN'T RETURN HERE
+       CLA             /****
+       JMP I CRLF      /RETURN
+\fCTRLU,        JMS CRLF        /PERFORM A CR/LF
+TTYGET,        TAD BUFSTRT
+       DCA TTYCA       /POINT TO START OF BUFFER
+       TAD BUFSIZ
+       CLL RAL         /CONVERT DOUBLE-WORDS TO WORDS
+DCAWC, DCA TTYWC       /SET SIZE OF BUFFER
+TSTEND,        TAD TTYEOF
+       SNA CLA
+       JMP ZERO
+       JMS I PLINK     /CALL TTYGCH TO GET A CHARACTER
+       JMP RUBOUT      /RETURN 1 MEANS SAW RUBOUT
+ZERO,  DCA I TTYCA     /RETURN 2 MEANS GOT CHARACTER
+                       /STORE AWAY TEMPORARILY
+                       /USING USER'S BUFFER AS A TEMP LOCATION
+       TAD I TTYCA     /GET BACK CHARACTER
+       IFNZRO .-320 <_ERROR>
+       SZA
+       JMS PUNCH       /ECHO IT
+       TAD I TTYCA     /GET IT AGAIN
+       TAD M32         /-^Z
+       SNA
+       JMP CTRLZ
+       TAD L5          /^Z-^U
+       SNA             /IS IT ^U?
+       JMP CTRLU       /YES
+       TAD L7
+GRUDGE,        DCA TMP
+       ISZ TTYCA       /NO
+L7,    7
+       ISZ TTYWC       /IS BUFFER FULL?
+TT10,  SKP
+       JMP TTYX
+       ISZ TMP         /WAS LAST CHAR A CR?
+       JMP TSTEND      /NO
+       DCA TTYEOF      /YES, SET "PAD WITH 0'S" FLAG
+       ISZ TTY         /POINT TO NORMAL RETURN
+                       /CR IS NOT AN ERROR OR END-OF-FILE
+       TAD L212        /IF LAST CHAR INPUT WAS CR, NOW PRETEND LF WAS INPUT
+       JMP ZERO        /REJOIN PROCESSING
+
+CTRLZ, DCA TTYEOF
+       JMS CRLF
+       JMP GRUDGE
+
+M32,   -32
+L5,    5
+L3700, 3700
+CIFCDF,        CIF CDF 0
+TTYCDF,        CDF 0
+
+/TTYEOF IS ZERO MEANS PAD BUFFER WITH ZEROES
+\f/DON'T DO YET:
+/RUBOUT,       AND TTYWC       /177 IN AC
+/      SNA CLA
+/      JMP CTRLU
+
+RUBOUT,        KCC             /TTYGCH DOESN'T CLEAR RO FROM BUFFER
+       TAD TTYCA
+       CIA
+       TAD BUFSTRT
+       SNA CLA         /ARE WE AT BEGIN OF BUFFER?
+       JMP CTRLU       /YES
+       STA
+       TAD TTYCA
+       DCA TTYCA
+       IFZERO RUB <
+LSLASH,        "\
+       TAD LSLASH              /PRINT A BACK SLASH FOR EACH RUBBED OUT CHAR
+       >
+       IFNZRO RUB&4000+RUB <TAD I TTYCA>       /PRINT CHAR JUST DELETED
+       IFNZRO RUB&4000 <TAD TT10>      /BACKSPACE-SPACE-BACKSPACE
+       JMS PUNCH
+       STA
+       TAD TTYWC
+       JMP DCAWC       /BUMP BACK WC AND GET ANOTHER CHAR
+
+       ZBLOCK 376-.
+TTY,   TTYVERSION      /ENTRY POINT TO HANDLER
+       JMS PLINK       /SET UP CROSS PAGE LINKAGE
+       IFNZRO TTY-376 <ENTERR,QQQQ>
+       PAGE
+\f/INTERLUDE:
+
+/USA STANDARD CODE FOR INFORMATION INTERCHANGE:
+
+/      000     001     010     011     100     101     110     111
+/
+/ 0000 NUL     DLE     SP      0       @       P       '       'P
+/
+/ 0001 SOH     DC1     !       1       A       Q       'A      'Q
+/
+/ 0010 STX     DC2     "       2       B       R       'B      'R
+/
+/ 0011 ETX     DC3     #       3       C       S       'C      'S
+/
+/ 0100 EOT     DC4     $       4       D       T       'D      'T
+/
+/ 0101 ENQ     NAK     %       5       E       U       'E      'U
+/
+/ 0110 ACK     SYN     &       6       F       V       'F      'V
+/
+/ 0111 BEL     ETB     '       7       G       W       'G      'W
+/
+/ 1000 BS      CAN     (       8       H       X       'H      'X
+/
+/ 1001 HT      EM      )       9       I       Y       'I      'Y
+/
+/ 1010 LF      SUB     *       :       J       Z       'J      'Z
+/
+/ 1011 VT      ESC     +       ;       K       [       'K      '[
+/
+/ 1100 FF      FS      ,       <       L       \       'L      '\
+/
+/ 1101 CR      GS      -       =       M       ]       'M      ']
+/
+/ 1110 SO      RS      .       >       N       ^       'N      '^
+/
+/ 1111 SI      US      /       ?       O       _       'O      '_
+/
+\f/TTYGCH:      GETS A CHAR FROM KBD
+/      IF GOT ^Z, IT SETS TTYEOF FLAG
+/      LEAVES IT IN AC IN 7-BIT
+
+/TTYPRT:       PRINTS CHAR IN AC ON TTY
+/      IGNORES NULLS
+/      PRINTS ^X ON CONTROL CHARS (EXCEPT CR, LF, FF, VT, TAB)
+/      PRINTS 'X ON LOWER CASE
+
+/HANDLES TABS CORRECTLY
+/      AND AUTOMATICALLY PRINTS CR/LF AT EOL
+/      PRINTS ESCAPE AS $
+
+/TTYTLS:       USED TO ACTUALLY PRINT CHAR
+/              IT HANDLES TABS AUTOMATICALLY
+/              AND CR/LF'S AT END OF LINE
+
+/TTYPCH:       IT USES TTYPRT TO PRINT CHAR BUT ALSO RESPONDS TO
+/              ^C, ^O, ^S, ^Q.
+/              IF ^Z IS BEING PRINTED, IT THEN STOPS FURTHER PRINTING
+\f/MUST BE AT TOP OF PAGE
+TTYPCH,                        /ENTRY POINT TO TTY PUNCH ROUTINE
+                       /OR TTY PRINT ROUTINE
+TTYGCH,        0               /ENTRY POINT TO TTY GET CHAR ROUTINE
+       SNA
+       JMS TGCH        /ZERO AC-MEANT CALL TO TTYGCH
+PCH,   AND (177        /FORCE TO 7-BIT
+       DCA TCHAR
+       TAD TGCH
+M140,  SZA CLA         /ARE WE ECHOING?
+       JMP ECHO        /YES, IGNORE ^S AND STUFF
+K5,    5               /MUST BE AT REL 10
+       TAD TCHAR
+       TAD (-32
+       IFZERO PAUS <
+       SNA CLA
+       JMP I TTYPCH
+       >
+       IFNZRO PAUS <
+       SNA
+       JMP I TTYPCH
+       TAD L15         /32-15
+       SNA CLA         /LOOK FOR CR
+       ISZ LINCNT      /AT END OF PAGE?
+       JMP NOPAUS      /NOT AT CR, OR AT CR BUT NOT AT END OF PAGE
+L15,   15              /MUST BE HERE FOR SET
+       TAD PAUSN
+       DCA TTYTLS      /SET COUNT FOR OUTER LOOP
+       ISZ LINCNT
+       JMP .-1
+       ISZ TTYTLS
+       JMP .-3
+       TAD LINSYZ
+       DCA LINCNT
+       >
+NOPAUS,        JMS TTYTST
+       TAD (203-217    /NO
+       SNA             /^O?
+       DCA TCHAR       /YES, SET TO NULL SO IT WILL BE IGNORED
+       TAD (217-223    /NO
+       SZA CLA         /^S?
+       JMP ECHO        /NO, IGNORE CHAR
+TTCTLQ,        JMS TTYTST
+       TAD (203-221    /NO, NOTHING ELSE MATTERS UNTIL ^Q
+       SZA CLA         /^Q?
+       JMP TTCTLQ      /NO, SUSPEND OUTPUTTING
+TTY32, KCC             /YES, REMOVE ^Q FROM BUFFER
+/HAD NO ROOM FOR:
+/      TAD LINSYZ
+/      DCA LINCNT
+ECHO,  DCA TGCH
+       ISZ TTYPCH
+       IFNZRO ESC <
+       TAD TCHAR
+       TAD (-33
+       SZA CLA
+       JMP .+3
+       TAD L44
+       DCA TCHAR
+L44,   44
+       >
+       TAD TCHAR
+       SNA
+       JMP TTYCTO      /IGNORE NULLS
+       IFNZRO RUB&4000 <
+       TAD (-10
+       SNA
+       JMP RUBO
+       TAD (10-16
+       >
+       IFZERO RUB&4000 <
+       TAD (-16
+       >
+TTY100,        CLL
+TTY10, TAD K5
+TTY240,        SZA             /TAB?
+       JMP NOTAB
+       IFNZRO SIMTAB <
+TTYTAB,        TAD TTY240
+       JMS TTYTLS
+TTY7,  7               /HERE FOR NO SPECIAL REASON
+       TAD TABCTR
+       AND TTY7
+       SZA CLA
+       JMP TTYTAB
+       JMP TTYCTO
+       >
+       IFNZRO SLOTAB <
+       TAD TCHAR
+       JMS TTYTLS
+       TAD (177
+       JMS TTYTLS
+       TAD (177
+       JMP PRIN+1
+       >
+       IFZERO SIMTAB+SLOTAB <JMP PRIN>
+
+/BUG: IF HARDWARE TABS, DON'T COUNT COLUMNS CORRECTLY
+
+       IFNZRO RUB&4000 <
+RUBO,  TAD TTY10       /OUTPUT BACKSPACE-RUBOUT-BACKSPACE
+       JMS TTYTLS
+       TAD TTY240
+       JMS TTYTLS
+       TAD (-4
+       TAD TABCTR
+       JMP PREPRN
+       >
+\fNOTAB,        SZL CLA
+       JMP SPCHR       /DON'T UPARROW CHARS LF,CR,TAB,VT,FF
+       IFNZRO FLAGLC <
+       TAD TCHAR
+       AND TTY140
+       TAD M140
+       SZA CLA         /IS IT LC?
+       JMP NOLC        /NO
+TTYQUO,        "'
+       TAD TTYQUO      /YES
+       JMS TTYTLS      /PRINT QUOTE
+       TAD M40
+       JMP PRIN        /PRINT UPPER CASE OF CHAR
+       >
+NOLC,  TAD TCHAR       /NO, GET BACK CHAR
+       AND TTY140      /HIGH ORDER BITS IRRELEVANT
+       IFNZRO CTRL <
+M40,   SMA SZA CLA     /CAN'T BE NEGATIVE
+       JMP PRIN        /NOT A CONTROL CHARACTER
+       TAD TTYUPA      /ECHO 201-237 AS ^X (EXCEPT 211-215)
+       JMS TTYTLS
+       TAD TTY100      /ADD X100 TO ^K TO GET K
+       >
+       IFZERO CTRL <
+       SNA CLA         /IS CHAR A CONTROL CHAR?
+       JMP TTYCTO      /YES, DON'T ECHO CONTROL CHARACTERS EXCEPT FOR 211-215
+       >
+PRIN,  TAD TCHAR
+       JMS TTYTLS
+TTYCTO,        TAD TABCTR      /RETURN TABCNT IN AC
+       JMP I TTYPCH
+
+       IFZERO CTRL <
+M40,   -40
+       >
+
+TTY140,
+SPCHR, STA CLL
+       TAD LINSIZ
+PREPRN,        DCA TABCTR      /THESE CHARS RESET COLUMN COUNTER
+       JMP PRIN
+\fTGCH, 0               /NON-ZERO MEANS TTYGCH WAS CALLED
+       KSF
+       JMP .-1         /WAIT FOR CHAR TO BE TYPED
+       JMS TTYTST
+/WILD: (DON'T PUT IN)  SZA CLA /FALL THRU AND RETURN R.O.
+/      ISZ TTYGCH
+       TAD (203-377
+       SNA CLA         /TAKE RETURN 1 ON RUB OUT
+       JMP I TTYGCH    /"CLUMSY" - R.L. (9/18/73)
+       ISZ TTYGCH
+       KRB             /GET CHARACTER
+TTYAND,        AND (177        /MUST RETURN CHAR IN 7-BIT
+       IFNZRO CNVLC <
+       DCA TCHAR
+       TAD TCHAR
+       AND TTY140
+       TAD M140
+       SNA CLA         /IS IT LC?
+       TAD M40         /YES
+       TAD TCHAR       /NO
+       >
+       IFNZRO ALTMOD <
+       TAD (-175       /IS IT 175 OR 176?
+       SMA
+       JMP CONV        /YES, CONVERT ALTMODE TO ESCAPE
+       TAD (175        /NO, RESTORE CHAR
+       >
+       JMP I TTYGCH    /TAKE RETURN 3
+
+/SHOULDN'T TABCTR BE INITIALIZED TO C(LINSIZ) UPON ENTRY?
+
+TABCTR,        -110
+
+TTYTLS,        0
+       TLS
+       IFNZRO DELAY <
+       TAD (-DELAY
+       SZA CLA
+       STA
+       >
+TTYTSF,        TSF
+       JMP .-1
+       IFNZRO DELAY <
+       IAC
+       SZA             /19.66 MS IS G.T. 1/60 SEC
+       JMP TTYTSF
+       >
+       ISZ TABCTR
+TTYUPA,        "^
+TT7600,        7600
+       JMP I TTYTLS
+LINSIZ,        -110
+
+       IFNZRO PAUS <
+LINSYZ,        -HEIGHT
+LINCNT,        -HEIGHT
+PAUSN, -PAUS
+       >
+
+       IFNZRO ALTMOD <
+               IFNZRO KCC-6032 <
+CONV,          CLA
+               TAD (33
+               JMP I TTYGCH
+               >
+       IFZERO KCC-6032 <
+CONV,          CLA IAC
+               TAD TTY32       /DEVICE DEPENDENT
+               JMP TTYAND
+               >
+       >
+\fTCHAR,        0
+
+/TTYTST:       READS KEYBOARD STATICALLY AND RESPONDS TO ^C
+/              OTHERWISE RETURNS CHAR (8-BIT) MINUS 203 IN AC.
+/              IF FLAG IS NOT UP, IT RETURNS A 1.
+
+TTYTST,        0
+       TAD TT7600      /OR CHAR IN
+       KRS
+       TAD (-7603      /-7603=175
+       KSF
+       CLA IAC         /STUFF IN BUFFER IS UNRELIABLE IF FLAG ISN'T UP
+       SZA
+       JMP I TTYTST
+       IFNZRO INDVC-3 <KCC>
+       CIF CDF 0       /BRANCH TO OS/8 MONITOR AT 07600
+       JMP I TT7600    /IT WILL PRINT "^C" FOR CHAR IN BUFFER
+       PAGE
+\f/     DYNAMICALLY MODIFYING THE KL8E HANDLER
+
+/      *** I M P O R T A N T ***
+
+/      THIS HANDLER CAN BE DYNAMICALLY CHANGED VIA SET COMMANDS.
+/      CONSEQUENTLY, IT IS EXTREMELY IMPORTANT THAT PEOPLE
+/      WHO MODIFY THIS SOURCE DO NOT AFFECT THE ALGORITHMS
+/      NECESSARY TO PERFORM SUCH MODIFICATIONS.
+
+/      THIS ALGORITHM IS EXPLAINED BELOW.
+
+/      SET TTY WIDTH=N
+
+/      SEARCH LOCATIONS 200-377 FOR A 7600.  CALL ITS ADDRESS X.
+/      LET Y BE THE INSTRUCTION AT LOCATION X+1.
+/      FORM THE (RELATIVE) ADDRESS T=Y&177+200-1.
+/      THEN LOCATIONS T AND X+2 CONTAIN MINUS THE TTY WIDTH.
+/      THE WIDTH MUST BE A MULTIPLE OF 10 AND MUST NOT BE 200.
+/      (BECAUSE -200 IS THE MAGIC 7600)
+
+/      SET TTY CODE XX
+
+/      SEARCH ENTIRE HANDLER FOR INSTRUCTIONS OF THE FORM 6XXY
+/      WHERE XX IS NOT 20 OR 21,
+/      AND FURTHERMORE DON'T INCLUDE A 6031 IF 2 LOCATIONS
+/      FOLLOWING IS A 7650
+/      AND DON'T INCLUDE A 6034 IF 4 LOCATIONS FOLLOWING IS A 7650.
+
+
+/      SET TTY [NO] ECHO
+
+/      THE WORD INVOLVED IS AT (RELATIVE) LOCATION 120.
+/      SET TO 7440 TO ECHO.
+/      SET TO 7610 TO SUPPRESS ECHOING.
+
+
+/      SET TTY LC
+
+/      SEARCH LOCATIONS 200-377 FOR A 377.  CALL ITS ADDRESS X.
+/      LOOK AT LOCATION X+5.
+/      IF THIS LOCATION IS NOT A 7650, THEN LC TO UC CONVERSION
+/      WAS NOT ENABLED AT ASSEMBLY TIME.
+/      IF THE FEATURE IS ENABLED, CHANGE LOCATION X+5 TO A 7610
+/      TO PREVENT THE CONVERSION.  TO ALLOW CONVERSION, SET
+/      LOCATION X+5 BACK TO 7650.
+
+/      SET TTY PAGE
+
+/      SEARCH LOCATIONS 215-300 FOR A 7450. CALL ITS ADDRESS X.
+/      SET X+3 TO 7640 TO ENABLE ^S, ^Q.
+/      SET X+3 TO 7200 TO DISABLE ^S, ^Q.
+\f/     SET TTY TAB
+
+/      SEARCH LOCATIONS 200-300 FOR A 7.
+/      IF NOT FOUND, SIMULATED TABS WAS NOT ENABLED AT ASSEMBLY TIME.
+/      IF FOUND, CALL ITS ADDRESS X.
+/      TO PATCH OUT SIMULATED TABS:
+/              MOVE C(X-12) TO LOCATION X-2
+/              CHANGE LOCATION X+3 TO A 7610
+/      TO RESTORE SIMULATED TABS:
+/              SET LOCATION X-2 TO X-4&77+1200
+/              CHANGE LOCATION X+3 TO A 7640
+
+/      SET TTY FILL
+
+/      THE LITERAL 177 MUST REMAIN AT THE END OF PAGE 2
+/      SEARCH LOCATIONS 200-300 FOR A 1377.
+/      IF NOT FOUND, THEN FILL CHARACTERS WERE NOT ENABLED AT ASSEMBLY
+/      TIME.  IF FOUND, CALL ITS ADDRESS X.
+/      TO PATCH OUT FILL CHARACTERS, MOVE C(X+3) TO LOCATION X-1.
+/      TO RESTORE FILL CHARACTERS, MOVE C(X+1) TO LOCATION X-1.
+
+/      SET TTY FLAGLC
+
+/      SEARCH LOCATIONS 200-377 FOR A 247.
+/      IF NOT FOUND, LOWER CASE FLAGGING WAS NOT ENABLED AT ASSEMBLY TIME.
+/      IF FOUND, CALL ITS ADDRESS X.
+/      TO DISABLE FLAGGING, SET LOCATION X-2 TO A 7200.
+/      TO RE-ENABLE FLAGGING, SET LOCATION X-2 TO A 7640.
+
+/      SET TTY PAUSE [N]
+
+/      SEARCH LOCATIONS 200-300 FOR A 15.
+/      IF NOT FOUND, PAUSING WAS NOT ENABLED AT ASSEMBLY TIME.
+/      IF FOUND, CALL ITS ADDRESS X.
+/      TO DISABLE PAUSING AFTER A FULL SCREEN,
+/      SET LOCATION X-3 TO A 7610.
+/      TO RE-ENABLE PAUSING, SET LOCATION X-3 TO A 7650.
+/      TO SET PAUSE DURATION, SEARCH LOCATIONS 300-377 FOR A 7600,
+/      CALLING ITS ADDRESS X.  THEN (MINUS THE) PAUSE DURATION IS AT
+/      LOCATION X+5.
+
+/      SET TTY HEIGHT
+
+/      THIS IS ONLY APPLICABLE IF SET TTY PAUSE HAS BEEN ASSEMBLED IN
+/      (A 15 CAN BE FOUND ON SECOND PAGE).
+/      NEGATIVE OF HEIGHT MUST BE SET IN BOTH LOCATIONS X+3 AND X+4
+/      WHERE X IS THE ADDRESS OF A 7600 AS IN ABOVE.
+\f/     SET TTY ESCAPE
+
+/      SEARCH LOCATIONS 200-377 FOR A 44.
+/      IF NOT FOUND, THEN $ WAS NOT ASSEMBLED INTO TTY HANDLER.
+/      IF FOUND, CALL ITS ADDRESS X.
+/      TO DISABLE PRINTING ESCAPE AS $, SET LOCATION X-4 TO A 'CLA'.
+/      TO CAUSE ESCAPE TO PRINT AS AN ESCAPE, SET LOCATION X-4 TO SZA CLA.
+
+/      SET TTY ARROW
+
+/      SEARCH LOCATIONS 200-377 FOR 7740.
+
+/      IF NOT FOUND, USING OLD HANDLER.
+/      CALL ITS ADDRESS X.
+/      IF LOCATION X+1 IS MORE THAN 7000,
+/      THEN UPARROW MODE WAS NOT ASSEMBLED INTO KL8E.
+/      OTHERWISE, TO ALLOW ARROWS, SET LOCATION X+3 TO THE
+/      CONTENTS OF LOCATION X+6.
+/      TO CAUSE CONTROL CHARACTERS TO ECHO AS IS, SET
+/      LOCATION X+3 TO 'SKP CLA'.
+/      NOTE THAT THIS IS A DIFFERENT OPTION THAN ASSEMBLING CTRL=0.
+\f      IFDEF TEST <
+       *600
+
+/TEST ROUTINE FOR KL8E HANDLER
+
+GO,    JMS I (TTY      /CALL HANDLER
+       0600            /READ SIX PAGES
+       1000            /BUFFER AT 01000
+       0001            /BLOCK 1
+       HLT             /ERROR RETURN
+       JMS I (TTY      /CALL HANDLER AGAIN
+       4600            /OUTPUT SIX PAGES
+       1000
+       0001
+       HLT
+       CLA
+       JMP GO
+       >
+       $
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape4/LQP.PA b/sw/os8/v3d/sources/system/dectapes/dectape4/LQP.PA
new file mode 100644 (file)
index 0000000..e81ac88
--- /dev/null
@@ -0,0 +1,279 @@
+/ LQP HANDLER FOR OS/8
+/
+/
+/ 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 HEREIN 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 ASSUMES NO RESPONSIBILITY FOR THE USE
+/ OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED
+/ BY DIGITAL.
+/
+/ COPYRIGHT (C) 1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+
+PDMP=6502
+PDMC=6503
+PDPC=6504
+PDRS=6505
+PDWS=6506
+PDRE=6507
+LPVERSION="A&77        /VERSION A (MH)
+
+*0             /ORIGIN FOR BUILD INFO
+
+-1             /ONE ENTRY POINT
+DEVICE LQP     /GROUP NAME
+DEVICE LPT     /DEVICE NAME
+1040           /DEVICE TYPE
+LQP&177+4000   /ENTRY POINT + TWO-PAGE FLAG
+0              /REQUIRED ZEROES
+0
+
+PAGE
+
+LQPORG=.
+LQPCSV,        0
+LQPBUF,        0
+LQPDWC,        0
+LQPDCY,        0
+
+LQP,   LPVERSION       /ENTRY POINT (MH)
+       CLA STL RTL                     /RAISE RIBBON
+       PDWS
+
+       PDRE                    /INIT PRINTER
+       DCA .-1                 /---FIRST TIME ONLY---
+
+       JMS LQPDCZ              /INIT SECOND PAGE LINK
+
+       RDF     /GET RETURN CIF
+       TAD (CIF CDF)
+       DCA LQPRDF
+
+       TAD I LQP       /GET FUNCTION WORD
+       AND (70)
+       TAD (CDF)
+       DCA LQPBDF      /SET BUFFER CDF
+
+       TAD I LQP
+       AND (3700)
+       CMA
+       DCA LQPDWC      /SET DOUBLE-WORD COUNT +1
+
+       ISZ LQP
+       TAD I LQP
+       DCA LQPBUF      /SET BUFFER PTR
+
+       ISZ LQP
+       TAD I LQP
+LQPBDF,        0               /CDF TO BUFFER
+       SZA CLA
+       JMP LQPGO
+       TAD (15);JMS LQPDOC     /NEW PAGE ON BLOCK 0
+       TAD (14);JMS LQPDOC
+LQPGO, ISZ LQPDWC
+       JMP LQPGO1              /LOOP IF MORE TO DO
+LQPCZ,
+       TAD (13);JMS LQPDOC     /CLEAR SPACE ACCUMULATORS
+LQPRDF,        0                       /THEN RETURN TO CALLER
+       ISZ LQP
+       ISZ LQP
+       JMP I LQP
+
+LQPGO1,
+       TAD I LQPBUF    /GET NEXT WORD
+       AND (7400)
+       CLL RTR
+       DCA LQPCSV      /SAVE PART OF THIRD CHAR
+
+       TAD I LQPBUF
+       JMS LQPDOC      /OUTPUT FIRST CHAR
+
+       ISZ LQPBUF
+       TAD I LQPBUF
+       JMS LQPDOC      /OUTPUT SECOND CHAR
+
+       TAD I LQPBUF
+       AND (7400)      /PUT THIRD CHAR TOGETHER
+       BSW
+       TAD LQPCSV
+       CLL RTR
+       JMS LQPDOC      /OUTPUT THIRD CHAR
+
+       ISZ LQPBUF
+       JMP LQPGO       /LOOP FOR DONE TEST
+
+LQPDCZ,        0
+       TAD LQPDCZ
+       AND (7600)
+       TAD (LQPDCX-LQPORG)
+       DCA LQPDCY
+       JMP I LQPDCZ
+
+LQPDOC,        0
+       JMS I LQPDCY
+       JMP LQPCZ
+
+       KRS                     /CHECK FOR CONTROL C AT CONSOLE
+       AND (177)
+       TAD (-3)
+       SZA CLA                 /SKIP IF SO
+       JMP I LQPDOC
+
+       CIF CDF 0               /RETURN TO OS8
+       JMP I (7600)
+
+PAGE
+\fLQPTCH,       24      /2*NUMBER OF INCRS PER CHAR
+LQLINE,        20      /2*NUMBER OF INCRS PER LINE
+LQPAGE,        -102    /-NUMBER OF LINES PER PAGE
+
+LQPDCX,        0               /OUTPUT ONE CHAR
+       AND (177)
+       TAD (-40)               /TEST FOR SPECIAL OR BLANK
+       SPA
+       JMP LQPSPC              /JUMP IF SPECIAL
+       SNA
+       JMP LQPIDX              /JUMP IF BLANK
+
+       TAD (40)
+LQPDC1,        DCA LQPCTM              /SAVE CHAR CODE
+
+LQPWLP,        PDRS                    /LOOP TIL DEVICE READY
+       BSW
+       SMA CLA
+       JMP .+5                 /JUMP IF NO CHECK FLAG
+       PDRE                    /ELSE RESET DEVICE
+       DCA LQPX                /AND HORIZONTAL POSITIONS
+       DCA LQPDX
+       ISZ LQPDY               /ADVANCE A LINE, FOR CLARITY
+
+       PDRS
+       STL
+       TAD (400)
+       SZL CLA
+       JMP LQPWLP              /LOOP IF NOT READY
+
+       TAD LQPDY               /DO Y MOTION, IF NEEDED
+       SNA
+       JMP LQPNDY              /JUMP IF NONE
+       CIA
+       DCA LQPMTM              /SAVE -NUMBER LINES TO DO
+
+       TAD LQLINE              /SUM TOTAL INCRS TO DO
+       ISZ LQPMTM
+       JMP .-2
+
+       PDMP            /MOVE PAPER
+
+       TAD LQPY                /COMPUTE NEW POSITION
+       TAD LQPDY
+       TAD LQPAGE              /ON PAGE, PLEASE!!
+       SMA
+       JMP .-2
+       CIA
+       TAD LQPAGE
+       CIA
+       DCA LQPY
+       DCA LQPDY
+
+LQPNDY,        TAD LQPDX               /DO X MOTION, IF NEEDED
+       SNA
+       JMP LQPNDX              /JUMP IF NONE
+
+       STL
+       SMA
+       CLL CIA                 /ADJUST FOR -X MOTION
+       DCA LQPMTM
+
+       TAD LQPTCH              /SUM TOTAL INCRS TO DO
+       ISZ LQPMTM
+       JMP .-2
+
+       RAR             /GET DIRECTION INDICATOR BACK
+       PDMC            /MOVE CARRIAGE
+
+       TAD LQPX                /COMPUTE NEW POSITION
+       TAD LQPDX
+       DCA LQPX
+       DCA LQPDX
+
+LQPNDX,        TAD LQPCTM              /RETRIEVE SAVED CHAR
+       SNA
+       JMP LQPDCR              /JUMP IF NONE
+       CLL RAL         /ADJUST FOR OFFSET
+       PDPC                    /PRINT CHAR
+
+LQPIDX,        ISZ LQPDX               /BUMP SPACE COUNTER
+       JMP LQPDCR              /RETURN TO CALLER
+       JMP LQPDCR              /...IN CASE ISZ SKIPPED...
+
+LQPSPC,                        /SPECIAL CHARACTER CHECKING
+       TAD (40-32)     /CONTROL Z?
+       SNA
+       JMP I LQPDCX            /TAKE EOF RETURN IF SO
+
+       TAD (32-15)             /CARRIAGE RETURN?
+       SNA
+       JMP LQPCR               /JUMP IF SO
+
+       IAC                     /FORM FEED?
+       SNA
+       JMP LQPFF               /JUMP IF SO
+
+       IAC                     /VERTICAL TAB?
+       SNA
+       JMP LQPDC1              /CLEAR ACCUMULATORS, IF SO
+
+       IAC                     /LINE FEED?
+       SNA
+       JMP LQPLF               /BUMP LINE COUNTER IF SO
+
+       IAC                     /TAB?
+       SNA CLA
+       JMP LQPDCR              /RETURN IF NOT RECOGNIZED
+
+LQPTB, TAD LQPX                /DO TAB
+       TAD LQPDX
+       TAD (10)
+       AND (7770)
+       CIA
+
+LQPCR, TAD LQPX
+       CIA
+       DCA LQPDX               /SAVE CR OR TAB MOTION
+
+LQPDCR,        ISZ LQPDCX              /BUMP TO OK RETURN
+       JMP I LQPDCX                    /AND TAKE IT
+
+LQPLF, ISZ LQPDY               /BUMP LINE COUNTER
+       TAD LQPY                /CHECK FOR NEXT PAGE
+       TAD LQPDY
+       TAD LQPAGE
+       SMA CLA
+       JMP LQPDC1              /JUMP IF SO
+
+       JMP LQPDCR              /ELSE, JUST RETURN
+
+LQPFF, TAD LQPY                /DO FORM FEED
+       TAD LQPAGE
+       CIA
+       DCA LQPDY
+       JMP LQPDC1              /DO PAGE EJECT NOW
+
+LQPX,  0
+LQPDX, 0
+LQPY,  0
+LQPDY, 0
+LQPMTM,        0
+LQPCTM,        0
+
+PAGE
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape4/PIP.PA b/sw/os8/v3d/sources/system/dectapes/dectape4/PIP.PA
new file mode 100644 (file)
index 0000000..a98d6cc
--- /dev/null
@@ -0,0 +1,2234 @@
+/3 PIP FOR OS/8 MONITOR
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT  (C)  1970,1971,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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/     4-MAY-1977      FILE: PIP.PA    OS/8 VERSION 12A
+/RL/EF/ET.AL./S.R./E.S.
+
+
+
+/ABSTRACT----
+/PIP (PERIPHERAL INTERCHANGE PROGRAM) IS A GENERAL FILE
+/MANIPULATION PROGRAM FOR THE OS/8 PROGRAMMING SYSTEM.
+/PIP ACCOMPLISHES DATA TRANSFERS BETWEEN ANY DEVICES IN THE OS/8
+/CONFIGURATION.
+
+
+/VERSION 3 MODS:
+
+/FIXED PROBLEM WITH ONE-PAGE WRITE
+/IN /S OR /Z, =OPTION IS TAKEN MODULO 100 (OCTAL)
+/      WITH 100, 200, ETC. MEANING USE 0 ADDITIONAL WDS.
+/DATES STILL DON'T LINE UP
+/'0 FREE BLOCKS'
+/ALLOW FILLING UP DEVICE TO VERY LAST BLOCK
+/ALLOW 7-BIT ^C
+/ALTMODE ON CD LINE RETURNS TO MONITOR WHEN DONE
+/NO HALT ON /L IF NO TTY HANDLER (ACTS AS NOP)
+/ /V PRINTS VERSION NUMBER FIRST TIME CALLED
+/ /O AFFIRMS /Y ON ZERO SYS OR ARE YOU SURE
+/=NNNN ON /I OPTION SPECIFIES LENGTH TO CLOSE FILE
+
+
+/MAINTENANCE RELEASE CHANGES:
+
+/1.    FIXED LENGTH OF ALL VARIETIES OF RF08
+/2.    ADDED RX01 TO INTERNAL LENGTH TABLES
+/3.    CHANGED VERSION NUMBER TO V10
+/4.    ADDED CHECK FOR 7-BIT CTRL/Z TO ASCII HANDLER
+
+/E.S.  DISABLED /E,/F,/L
+/E.S.  FIXED /Y OPTION PER SPR
+
+\f/DETAILS OF PIP:
+
+/PIP RUNS WITH THE USR (USER SERVICE ROUTINES) ALWAYS IN CORE.
+/THIS ELIMINATES SWAPPING THE MONITOR. IF ANY CHANGES ARE MADE
+/TO PIP, CARE SHOULD BE TAKEN IN USING PAGE ZERO LOCATIONS, AS
+/THEY MUST NOT DESTROY ANY MONITOR LOCATIONS.
+
+/CORE USED:
+/FIELD 0
+
+/00000-02777-  OUTPUT BUFFER
+/03000-06377-  INPUT BUFFER
+/06400-06577-  USED FOR /Y COMMAND ONLY
+/06600-07177-  INPUT HANDLER
+/07200-07577-  OUTPUT HANDLER
+
+/FIELD 1
+
+/10000-11777-  OS/8 I/O MONITOR
+/12000-16577-  EXECUTABLE CODE
+/16600-17177-  HOLDS NEW DIRECTORY SEGMENT FOR /S OPTION
+/17200-17577-  HOLDS OLD DIRECTORY SEGMENT IN /S OPTION
+
+
+/MAJOR PIECES OF CODE AND THEIR FUNCTION (BRIEFLY).
+/THIS IS A LIST OF ROUTINES AS THEY APPEAR PHYSICALLY, AND
+/NOT AS THEY ARE LOGICALLY CONNECTED.
+
+/ICHAR-                GENERAL CHARACTER INPUT ROUTINE. ASSIGNS NEW
+/              DEVICE HANDLERS AS NEEDED.
+
+/OOPEN-                ENTERS A FILE ON A SPECIFIED DEVICE.
+
+/OUTDMP-       WRITES OUTPUT BUFFER TO OUTPUT DEVICE.
+
+/OCLOSE-       CLOSES FILE CREATED BY OOPEN
+
+/OCHAR-                CHARACTER OUTPUT ROUTINE. WRITES CHARACTERS
+/              TO OUTPUT BUFFER, CALLING OUTDMP WHEN FULL.
+
+/OTYPE-        USES DEVICE NUMBER IN OUTPUT AREA OF CD TO
+/              INSPECT THE DEVICE CONTROL BLOCK WORD. THIS
+/              GIVES A CODE FOR THE TYPE OF DEVICE.
+
+/SLASHG-       HANDLES I/O ERRORS. IF /G IS SET, HARD I/O
+/              ERRORS ARE IGNORED. IF /S AND /G ARE ON, A
+/              SPECIAL RETURN IS TAKEN.
+
+/IMAGE-                IMAGE MODE PROCESSOR FOR PIP.
+
+/SQTRA-                MAIN SUBROUTINE OF IMAGE MODE, AND /S OPTION.
+
+/PIP, PIP+1-   MAIN ENTRANCES TO PIP. THE CODE ON THIS PAGE
+/              INSPECTS CD OPTION WORDS AND BRANCHES TO PROPER
+/              ROUTINES.
+
+/ASCII-                THE DEFAULT TRANSFER MODE IN PIP IS ASCII.
+
+/DELETE-       DELETES FILES ON OUTPUT SIDE OF CD LIST.
+
+/DZERO-                ZEROES DIRECTORY OF FIRST OUTPUT DEVICE.
+
+/PIPERR-       ERROR ROUTINR FOR PIP.
+
+/DIRPRE-       DIRECTORY PRINTING ROUTINE.
+
+/BINARY-       BINARY MODE PROCESSOR. HANDLES ABSOLUTE AND
+/              RELOCATABLE BINARY FILES.
+
+/ERPRNT-       ERROR PRINTOUT.
+
+/SQUISH-       FILE COMPRESSION PROCESSOR. ELIMINATES 'HOLES'
+/              IN DIRECTORY OF INPUT DEVICE.
+
+/SYSCOP-       SYSTEM COPY PROCESSOR. ALLOWS TRANSFER OF THE
+/              OS/8 SYSTEM AREA.
+\f/OPTIONS AVAILABLE IN PIP:
+
+/A-    ASCII TRANSFER; DEFAULT MODE
+/B-    BINARY MODE TANSFER
+/C-    DELETE TRAILING BLANKS. (ASCII MODE)
+/D-    DELETE FIRST OUTPUT FILE BEFORE PROCEEDING
+/E-    LIST INPUT DIRECTORY INCLUDING EMPTY FILES
+/F-    LIST INPUT DIRECTORY; ONLY FILE NAMES
+/G-    IGNORE ERRORS WHILE TRANSFERING
+/I-    IMAGE MODE TRANSFER
+/L-    LIST INPUT DIRECTORY; EXCLUDE EMPTY FILES
+/O-    OK TO PERFORM A SQUISH OR ZERO WITHOUT ASKING
+/S-    COMPRESS INPUT DEVICE ONTO OUTPUT DEVICE. ELIMINATES
+/      'HOLES' ON INPUT DEVICE.
+/T-    PROVIDE SIMPLE TTY FORMATTING. (ASCII ONLY)
+/Y-    COPY OS/8 SYSTEM AREA
+/Z-    ZERO OUTPUT DEVICE DIRECTORY BEFORE PROCEEDING
+/=N-   LEAVE N WORDS EXTRA PER DIRECTORY ENTR. VALID
+/      ONLY WITH /S OR /Z.
+/=N-   WITH /I OPTION CLOSES OUTPUT FILE WITH THIS LENGTH
+/V     PRINTS VERSION # (FIRST TIME ONLY)
+
+/COMMENTS ON THE PROGRAM:
+
+       /SINCE PIP RUNS WITH USR IN CORE, NO PAGE ZERO LITERALS
+       /CAN BE USED. THE LOCATIONS CURRENTLY USED IN
+       /FIELD 1 ON PAGE ZERO ARE:
+
+       OUTXR=10
+       INXR=11
+       TEMP1=12
+       IHNDLR=24       /HOLDS INPUT HANDLER ADDRESS
+       OHNDLR=25       /OUTPUT HANDLER ADDRESS
+       SQFLAG=26       /'SQUISH INDICATOR
+       OUWAST=27       /# WASTE WORDS ON OUTPUT
+       OUTBLK=30
+       OUDLEN=31
+       SAME=32
+       INBLK=33
+       RECCNT=34
+
+/CONSTANTS USED BY THE DIRECTORY PRINTOUT ROUTINE (OVERLAPPING) ARE:
+
+       FLENGT=24
+       BLOKNO=25
+       DTYPE=27
+       DCOUNT=30
+       DLINK=31
+       WASTE=32
+       DDATE=33
+       ECOUNT=35
+\f      /PIP FOR OS/8 MONITOR
+       /EQUIVALENCES FOR GENERAL CHARACTER I/O ROUTINES
+
+       OUBUF=0 /MUST BE LOWER THAN INBUF
+       OUCTL=5400      /OUTPUT BUFFER OF 3000 WORDS
+       OUDEVH=7200     /PROVIDE ROOM FOR TWO-PAGE HANDLERS
+       INBUF=3000
+       INCTL=1600      /INPUT BUFFER OF 3400 WORDS
+       INRECS=7
+       INDEVH=6600
+
+                       /PAGE 6400 IS FREE, EXCEPT DURING /Y COMMAND
+
+       /EQUIVALENCES NECESSARY TO INTERFACE WITH MONITOR
+       DCB=7760
+       MPARAM=7643     /CD PARAMETER AREA
+       OLDDIR=7                /POINTER TO MONITOR VARIABLE "OLDT9"
+       MTEMP=27        /MONITOR SCRATCH AREA ON "SYS" - ***VOLATILE***
+       PTP=20  /INTERNAL TYPE CODE FOR PAPER TAPE PUNCH
+       XR=10
+       TEMP=20
+       CHAR=21
+       INFPTR=22
+       INEOF=23
+
+       ABUF=6601       /LINE BUFFER - 150 CHARACTERS LONG
+       SQBUF1=6600     /DIRECTORY BUFFER FOR "SQUISH" OPTION
+       SQBUF2=7200     /""
+
+       FIELD 1
+
+/TO ENABLE /E,/F,/L SET
+/OS78=0
+
+/TO DISABLE /E,/F,/L
+IFNDEF OS78 <OS78=1>
+
+\f      /GENERAL CHARACTER I/O ROUTINES FOR BLEEP
+       /CALLED AS FOLLOWS:
+
+       /JMS I (IOPEN           INITIALIZES THE INPUT ROUTINE
+
+       /JMS I (ICHAR           READS A CHARACTER
+       /ERROR RETURN           /AC>0 IF END OF FILE, AC<0 IF READ ERROR
+
+       /JMS I (OOPEN           INITIALIZES THE OUTPUT ROUTINE
+       /ERROR RETURN           AC>0 IF NO OUTPUT DEVICE/FILE, AC<0 IF ERROR
+
+       /JMS I (OCHAR           OUTPUTS A CHARACTER
+       /ERROR RETURN           OUTPUT ERROR OR TOO MUCH OUTPUT
+
+       /JMS I (OCLOSE          CLOSES THE OUTPUT FILE
+       /ERROR RETURN           FILE TOO LARGE TO BE CLOSED OR OUTPUT ERROR
+
+       /JMS I (OTYPE           RETURNS DCB WORD OF OUTPUT DEVICE IN AC
+
+
+
+       /PARAMETERS NEEDED:
+
+       /INBUF=         ADDRESS OF INPUT BUFFER
+       /INCTL=         INPUT BUFFER CONTROL WORD
+       /OUBUF=         ADDRESS OF OUTPUT BUFFER
+       /OUCTL=         OUTPUT BUFFER CONTROL WORD (MUST BE NEGATIVE)
+       /INRECS=        [INCTL/256]
+       /INDEVH=        ADDRESS OF PAGE FOR INPUT HANDLER
+       /OUDEVH=        ADDRESS OF PAGE FOR OUTPUT HANDLER
+
+       /ASSUMES I/O MONITOR IS RESIDENT IN CORE.
+       /CAN BE CALLED FROM ANY FIELD WITH BUFFERS IN ANY FIELD.
+\f      INFLD=INCTL&70  /GET FIELD OF INPUT BUFFER
+       OUFLD=OUCTL&70  /DITTO OUTPUT BUFFER
+
+       *2000
+
+IN7400,        7400
+IOPEN, 0
+       CLA CMA
+       DCA INCHCT      /SET INCHCT TO FORCE A READ
+       ISZ INEOF       /SET END-OF-FILE FLAG TO FORCE A NEW FILE
+       TAD (7617
+       DCA INFPTR      /RESET FILE POINTER
+       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 EOFERR      /NO FILE TO OPEN
+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
+                       /NOT END-OF-FILE IF INPUT DEVICE
+                       /IS NON-FILE STRUCTURED!
+       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
+       JMS I (SLASHG   /A HANDLER ERROR - SHOULD WE IGNORE?
+       INERRX-.        /ADDRESS IF NOT
+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
+INERR, CLA CLL CML RAR /BADDIE - GIVE ERROR RETURN WITH NEGATIVE AC
+EOFERR,        JMP INRTRN
+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
+       TAD (-232
+INCTZF,        SNA             /IS THE CHARACTER A ^Z?
+       JMP GETNEW      /YES - GET A NEW FILE
+       TAD (232        /RESTORE THE CHARACTER
+       ISZ ICHAR       /BUMP RETURN TO NORMAL RETURN
+INRTRN,        0               /RESTORE CALLING FIELDS
+       JMP I ICHAR     /AND RETURN
+                       /IOPEN IS UNNECESSARY.
+\fINNEWF,       -1              /ROUTINE TO OPEN NEW INPUT FILE
+       INCHCT=INNEWF
+       CDF 10
+       TAD (INDEVH+1
+       DCA INHNDL      /INITIALIZE HANDLER ADDRESS
+       TAD I INFPTR    /GET NEXT CD INPUT FILE ENTRY
+       SNA             /ANY MORE?
+       JMP I INNEWF    /NO - OUT OF INPUT
+       JMS I IN200
+       1               /ASSIGN, FETCH HANDLER
+INHNDL,        0
+       HLT             /HUH?
+       TAD I INFPTR
+       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 INFPTR
+       TAD I INFPTR
+       DCA INREC       /STORE STARTING RECORD NUMBER OF FILE
+       ISZ INFPTR
+       DCA INEOF       /ZERO END-OF-FILE FLAG
+       ISZ INNEWF
+       JMP I INNEWF
+       INCTR=IOPEN
+       PAGE
+\fOOPEN,        0               /OPEN OUTPUT FILE
+OU7600,        7600
+/      RDF
+/      TAD OUCDIF
+/      DCA OORETN
+       TAD OU7601
+       DCA OUBLK
+       TAD (OUDEVH+1
+       DCA OUHNDL
+       CDF 10
+       TAD I OU7600    /GET DEVICE NUMBER WORD OF OUTPUT FILE ENTRY
+       AND (17         /STRIP OFF ANY LENGTH INFO
+       SNA             /IS THERE AN OUTPUT DEVICE?
+       JMP ONOFIL      /NO - INHIBIT OUTPUT
+       JMS I (200
+       1               /ASSIGN, FETCH HANDLER
+OUHNDL,        0               /OUTPUT DEVICE HANDLER ENTRY
+       HLT             /HUH?
+OUENTR,        TAD I OU7600
+       JMS I (200
+       3               /ENTER OUTPUT FILE
+OUBLK, 7601            /REPLACED WITH STARTING BLOCK
+OUELEN,        0               /REPLACED WITH LENGTH OF HOLE
+       JMP OEFAIL      /FAILED - MAYBE WE ASKED TOO MUCH
+       DCA OUCCNT
+       DCA I (OUTINH   /ZERO OUTPUT INHIBIT FLAG
+       JMS I (OUSETP
+       ISZ OOPEN
+OORETN,        CDF CIF 10      /RESTORE CALLING FIELDS
+       JMP I OOPEN
+OEFAIL,        TAD I OU7600
+       AND (7760       /GET REQUESTED LENGTH
+       SNA CLA         /WAS IT AN INDEFINITE REQUEST
+       JMP ONTERR      /YES - CANNOT ENTER THE FILE
+       TAD I OU7600
+       AND (17         /MAKE THE REQUESTED LENGTH ZERO
+       DCA I OU7600
+       JMP OUENTR      /TRY, TRY AGAIN
+ONTERR,        CLA CLL CML RAR
+       JMP OORETN      /TAKE THE ERROR RETURN WITH AC<0
+ONOFIL,        ISZ I (OUTINH
+       JMP OORETN      /TAKE THE ERROR RETURN WITH AC=0
+\fOUTDMP,       0
+       DCA OUCTLW      /STORE THE CONTROL WORD
+       CDF 10
+       TAD I (OUTINH
+       SZA CLA
+       JMP OUNOWR
+       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 OUTDMP    /YES - SIGNAL OUTPUT ERROR
+OUCDIF,        CDF CIF 0
+       CDF 10
+       JMS I OUHNDL
+OUCTLW,        0
+       OUBUF
+OUREC, 0
+       JMS I (SLASHG
+       .+2-.
+OUNOWR,        ISZ OUTDMP      /BUMP OUTDMP TO NORMAL RETURN
+       JMP I OUTDMP
+\fOCLOSE,       0
+       CDF 10
+       TAD I (OUTINH
+       SZA CLA         /IS OUTPUT INHIBITED?
+       JMP OCISZ       /YES - CLOSE IS A NOP
+       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
+       JMP OCRET
+       JMS I (OCHAR
+       JMP OCRET
+FILLLP,        JMS I (OCHAR
+       JMP OCRET
+       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
+       JMP OCRET       /AN ERROR OCCURRED WHILE DUMPING THE BUFFER
+NODUMP,        TAD I OU7600    /GET THE DEVICE NUMBER
+       JMS I (200
+       4               /CLOSE THE OUTPUT FILE
+OU7601,        7601            /POINTER TO THE OUTPUT FILE NAME
+OUCCNT,        0
+       SKP             /ERROR WHILE CLOSING THE FILE - BAD!
+OCISZ, ISZ OCLOSE
+OCRET, CDF CIF 10      /RESTORE CALLING FIELDS
+       JMP I OCLOSE
+       PAGE
+\fOUSETP,       0               /ROUTINE TO INITIALIZE CHARACTER POINTERS
+       TAD (OUCTL&3700 /GET SIZE OF BUFFER IN DOUBLEWORDS
+       CIA             /PAL10 IS DEFINITELY NOT NICE
+       DCA OUDWCT
+/      TAD (OUBUF
+       IFNZRO OUBUF <ERROR!>   /V3
+       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
+       TAD OUTINH
+       SZA CLA         /IS THERE AN OUTPUT FILE?
+       JMP OUCOMN      /NO - EXIT
+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
+       JMP OUCRET      /OUTPUT ERROR - GIVE ERROR RETURN
+       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,        ISZ OCHAR
+OUCRET,        HLT             /RESTORE CALLING FIELDS
+       JMP I OCHAR
+OUTEMP,        0
+OUPOLD,        0
+OUPTR, 0
+OUJMPE,        JMP OUJMP
+OUDWCT,        0
+OUTINH,        0
+\fOTYPE,        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
+       TAD (200        /V3
+       KRS
+       TAD (-203
+       SNA CLA         /IS THE TELETYPE BUFFER A ^C
+       KSF             /WITH THE TELETYPE FLAG ON?
+       JMP I CTCTST    /NO
+LEAVE, CDF CIF 0       /YES - GO TO MONITOR
+       JMP I (7600     /THROUGH THE "SAVE CORE" RETURN
+
+SLASHG,        0
+       DCA CTCTST
+       TAD SQFLAG
+       SZA CLA         /ARE WE SQUISHING?
+       JMP I (SQIOER   /YES
+       TAD CTCTST
+       SPA CLA         /ONLY IGNORE HARD ERRORS
+       TAD I (MPARAM
+       AND (40
+       SZA CLA         / "G" SWITCH
+SLGRET,        JMP I SLASHG    /IGNORED!
+       TAD I SLASHG
+       TAD SLASHG
+       DCA SLASHG      /SET UP NON-IGNORE ADDRESS
+       TAD CTCTST
+       JMP I SLASHG    /RETURN WITH AC RESTORED
+
+\f
+       IFZERO OS78 <
+DIR,   DCA DTYPE       /SAVE TYPE OF REQUEST
+       TAD I (7600
+       SZA CLA         /IS THERE AN OUTPUT FILE?
+       JMP I (DIRPRE   /YES
+       DCA TTYDEV+1
+       JMS I (200
+       12              /ASSIGN WITHOUT FETCH
+TTYDEV,        5524            /COMPRESSED CODE FOR "TTY"
+       0
+       0
+       JMP I (PIP      /V3 WHAT - NO TELETYPE!
+       TAD TTYDEV+1
+       DCA I (7600
+       JMP I (DIRPRE
+       >
+
+       IFNZRO OS78 <
+DIR,   JMS I   (PIPERR /TYPE OUT MESSAGE
+       14
+DIRMSG,        TEXT    "USE DIRECT"
+       >
+
+       PAGE
+\f      /PIP PROPER BEGINS HERE
+       /**********************
+
+       /IMAGE MODE PROCESSOR FOR PIP
+
+IMAGE, JMS I (FIXLEN
+       JMS I (OUTOPN
+       JMS IMTRA
+IMCLOS,        TAD I (OUTINH
+       SZA CLA         /WAS THERE AN OUTPUT FILE?
+       JMP I (PIPCLR   /NO - DON'T CLOSE IT
+       JMS I (OUK      /GET THE LENGTH OF THE OUTPUT FILE
+       DCA IMCCNT
+       TAD I IM7600
+       JMS I (200
+       4               /CLOSE
+       7601            /FILE NAME
+IMCCNT,        0
+       JMP I (AOUERR
+       JMP I (PIPCLR
+
+ENDFUJ,        0               /PART OF DIRECTORY PRINTING ROUTINE
+       JMS I (PRNUM
+       TAD (-6
+       JMS I (PRWD     /PRINT SIX WORDS
+       0006            / F
+       2205            /RE
+       0500            /E 
+       0214            /BL
+       1703            /OC
+       1323            /KS
+       JMS I (PCRLF
+       JMS I (PCRLF    /LEAVE A SPACE BETWEEN DIRECTORIES
+       ISZ INEOF       /SIMULATE "END OF FILE" FOR INPUT ROUTINE
+       CLA CMA
+       DCA I (INCHCT   /AS WELL AS "END OF BUFFER"
+       JMP I ENDFUJ
+\fIMHNDL,                       /V3
+SQTRA, 0
+       TAD SQTRA
+       DCA IMTRA       /FAKE A CALL TO "IMTRA"
+       TAD RECCNT      /SETTING UP THE ARGS TO DO THE SQUISHING FOR US
+       DCA I (INCTR
+       TAD IHNDLR
+       DCA IMHNDL
+       TAD INBLK
+       DCA IMREC
+       TAD OUTBLK
+       DCA I (OUCCNT
+       DCA INEOF
+       JMP IMRCLP
+
+IMTRA, 0
+       JMS I (IOPEN    /INITIALIZE INPUT ROUTINE
+AGAIN, TAD INEOF       /IOPEN ALWAYS SETS INEOF
+       SNA CLA         /KEEP READING?
+       JMP IMRCLP      /YES
+                       /NO, OPEN NEXT FILE
+IMFILP,        JMS I (INNEWF   /SET UP PARAMS FOR NEXT FILE
+       JMP I IMTRA     /NO NEXT FILE
+       TAD I (INHNDL
+       DCA IMHNDL      /GET DEVICE HANDLER ENTRY
+       TAD I (INREC
+       DCA IMREC       /AND STARTING BLOCK NUMBER
+IMRCLP,        TAD I (INCTR
+       CLL
+       TAD (15
+       SNL             /IF LINK IS ON, THERE ARE LESS THAN 16 BLOCKS LEFT
+       DCA I (INCTR
+       SZL
+       ISZ INEOF
+       CLL CML CMA RTR
+       RTR
+       RTR
+       TAD (3201       /FORM A FULL OR PARTIAL READ CONTROL WORD
+       DCA IMCTLW
+       JMS I (CTCTST   /CHECK FOR ^C
+       CIF 0
+       JMS I IMHNDL
+IMCTLW,        0
+       OUBUF
+IMREC, 0
+       JMS I (SLASHG
+       IMERRX-.
+       TAD IMREC
+       TAD (15
+       DCA IMREC       /UPDATE BLOCK NUMBER
+       CLA CLL CML RAR
+       TAD IMCTLW
+IMOUT, JMS I (OUTDMP   /WRITE OUT WHAT WE JUST READ IN
+       JMP I (AOUERR   /WRITE ERROR - BAD!
+       JMP AGAIN       /V3
+\fIMERRX,       ISZ INEOF       /SIGNAL EOF OR WORSE
+       SPA CLA         /WHICH ONE IS IT?
+       JMP IM7600
+       TAD (6377       /MARCH DOWN THROUGH CORE
+IMEFLP,        DCA CHAR        /LOOKING FOR THE FIRST NON-ZERO WORD
+       CDF 0
+       TAD I CHAR
+       SZA CLA
+       JMP IMNZRO
+       CLA CMA CLL
+       TAD CHAR
+       SZL             /IF WE GO THROUGH THE BUFFER WITHOUT A NON-ZERO WORD
+       JMP IMEFLP
+IM7600,        7600
+       JMS I (PIPERR   /SOMETHING IS WRONG (HANDLER SHOULD HAVE INSERTED
+       4               /A ^Z AT LEAST)
+IMNZRO,        CDF 10
+       TAD CHAR
+       CLL CML RAR
+       AND IM7600
+       TAD (200        /GET THE LENGTH OF THE USEFUL PART OF THE BUFFER
+       JMP IMOUT       /AS AN OUTPUT CONTROL WORD AND GO OUTPUT IT
+       PAGE
+\f/** PIP STARTS HERE (OR HERE+1 IF CHAINED TO) **
+
+PIPSA, JMP PIPCD       /NORMAL ENTRY/RE-ENTRY - CALL CD
+       JMP NOPCD       /ENTRY FROM CHAIN COMMAND - ASSUME CD AREA SET UP
+       /PART OF ASCII PROCESSOR - CLEAN UP AT END OF LINE AND END OF FILE
+
+LFEED, TAD CHAR
+       DCA I XR        /PUT THE LINE FEED IN THE LINE BUFFER
+EOL,   DCA I XR        /MARK THE END OF USEFUL INFO
+       JMS I (CTCTST
+       TAD (ABUF-1
+       DCA XR          /RESET BUFFER POINTER
+EOLLP, TAD I XR        /GET A CHARACTER FROM THE LINE BUFFER
+PIPSNA,        SNA             /ZERO MEANS NO MORE CHARS
+       JMP EOFTST
+       JMS I (OCHAR    /OUTPUT THE CHARACTER
+       JMP I (AOUERR
+       JMP EOLLP
+EOFTST,        TAD AEOFFG
+       SNA CLA         /END OF INPUT ENCOUNTERED?
+       JMP I (ASCIGO   /NO - GET NEXT LINE
+ACLOSE,        JMS I (OCLOSE   /YES - CLOSE THE OUTPUT FILE
+       JMP I (AOUERR   /ERROR ON CLOSE
+PIP,   TAD I (MPARAM-1 /V3
+       SMA CLA         /ALTMODE TERMINATE LAST COMMAND STRING?
+       JMP PIPCD       /NO
+       CDF CIF 0       /YES
+       JMP I (7605     /EXIT TO OS/8 WITHOUT SAVING CORE
+PIPCD, JMS I (200      /OF COURSE THE MONITOR IS IN CORE!
+       5               /COMMAND DECODE
+       0               /NO ASSUMED EXTENSIONS ON INPUT
+L20,                   /V3
+NOPCD, JMS I (ONCE     /REPLACED BY '20' BY ONCE-ONLY CODE
+       JMS I (SRSTOR   /CLEAR /S OR /Y;READ MONITOR
+       DCA SQFLAG      /CLEAR /S INDICATOR
+       TAD PIPSNA
+       DCA I (INCTZF   /RESET INPUT SWITCH TO DETECT "^Z"'S
+       TAD I (MPARAM+1
+       AND (40         /"S" SWITCH
+       SZA CLA
+       JMP I (SQUISH   /IT WAS ON - COMPRESS THE INDICATED DEVICES
+       TAD I (MPARAM+2
+       RTL
+       SZL CLA         /"Z" SWITCH IN THE LINK
+       JMS I (DZERO    /ZERO DIRECTORY BEFORE PROCEEDING
+       TAD I (MPARAM
+       AND (400        /"D" SWITCH
+       SZA CLA
+       JMS I (DELETE   /DELETE OUTPUT FILE
+       TAD I (MPARAM+2 /IS /Y ON?
+       SPA CLA
+       JMP I (SYSCOP   /YEP..TRANSFER SYSTEM HEAD
+       TAD I (MPARAM
+       AND (301        /"E","F" AND "L" SWITCHES
+       SZA             /ANY ONE OF THEM ON?
+       JMP I (DIR      /YES - LIST A DIRECTORY
+       TAD I (MPARAM
+       RTL
+       AND (40         /"I" SWITCH ROTATED TWO LEFT
+       SZA CLA
+       JMP I (IMAGE    /IMAGE MODE TRANSFER
+       TAD I (7617     /MUST PRESERVE THE LINK
+       SNA CLA         /V3 IMAGE MODE ALLOWS NO INPUT FILE
+       JMP PIP         /TERMINATE HERE IF NO INPUT SIDE
+       SZL CLA         /"B" SWITCH IN LINK
+       JMP I (BINARY   /BINARY MODE TRANSFER
+
+       /DEFAULT MODE OF TRANSFER IS ASCII
+
+ASCII, TAD I (MPARAM+1
+       AND L20
+       DCA COPTSW
+       TAD COPTSW
+       JMS I (ASCI2    /TEST FOR OUTPUT DEVICE
+       JMS I (OUTOPN
+       JMS I (IOPEN    /OPEN THE INPUT FILES
+       DCA AEOFFG      /ZERO THE END-OF-FILE FLAG
+       JMS I (LEADER
+       JMP I (ASCIGO
+
+       /ENTRY ON END OF INPUT
+ASCEOF,        SPA CLA         /WAS IT END OF INPUT OR AN INPUT ERROR?
+PER4,  JMS I (PIPERR
+       4
+       ISZ AEOFFG      /SET END-OF-INPUT FLAG
+       JMP EOL         /PROCESS LAST LINE (IF ANY)
+AEOFFG,        0
+\f      /SUBROUTINE TO OUTPUT RUBOUTS AFTER FORM CONTROL CHARACTERS
+RUBOUT,        0               /UNLESS OUTPUT IS TO A DIRECTORY DEVICE
+       DCA TEMP        /STORE COUNT
+       JMS I (OTYPE    /GET TYPE OF OUTPUT DEVICE
+       SPA CLA
+       JMP I RUBOUT    /DIRECTORY DEVICE - DON'T BOTHER
+RBTLP, TAD CHAR
+       TAD (-214
+       SNA CLA         /IS THE FORM CONTROL CHAR A FORM-FEED?
+       IAC             /YES - OUTPUT BLANK TAPE INSTEAD
+       TAD (377
+       DCA I XR        /PUT IN BUFFER
+       ISZ TEMP
+       JMP RBTLP               /LOOP FOR THE REQUISITE COUNT
+       JMP I RUBOUT
+COPTSW,        0
+
+DEND,  SPA CLA
+       JMP PER4
+       JMP ACLOSE
+       PAGE
+\f      *3200
+       /ASCII PROCESSOR CONTINUED
+
+ASCIGO,        TAD (ABUF-2
+       DCA XR
+       DCA I XR        /PROTECT AGAINST NULL LINE WITH "T" OPTION
+       DCA COLCT       /ZERO COLUMN COUNTER FOR TAB CONVERSION
+ACHLP, JMS I (ICHAR    /GET A CHARACTER
+       JMP I (ASCEOF   /END OF INPUT OR WORSE
+       AND (177        /MASK OUT PARITY BIT
+       SZA             /IGNORE BLANK TAPE AND LEADER/TRAILER
+       TAD (-177
+       SNA
+       JMP ACHLP       /DITTO RUBOUTS
+       TAD (177-32     /V3C
+       SNA
+       JMP I (ASCPTCH  /7-BIT ^Z CHECK
+       TAD (232        /FORCE COLUMN 8 ON
+       DCA CHAR
+       TAD CHAR
+       TAD (-216
+       CLL
+       TAD ASCI5
+       SNL             /IS THE CHARACTER A FORM CONTROL CHARACTER?
+       JMP CINSRT      /NO
+       TAD ASCJMP      /YES - GO TO APPROPRIATE ROUTINE
+       DCA .+1
+       HLT
+ASCJMP,        JMP I .+1
+       TAB
+       LFEED
+       VTAB
+       FFEED
+       CARRET
+CINSRT,        7600            /GRP 2 CLA
+       TAD CHAR
+ADCAXR,        DCA I XR        /STORE THE CHARACTER IN THE LINE BUFFER
+       ISZ COLCT       /ALWAYS BUMP THE COLUMN POINTER
+TESTXR,        TAD XR
+       TAD (-ABUF-226
+       SPA CLA         /HAS THE BUFFER OVERFLOWED?
+       JMP ACHLP       /NO - GET NEXT CHARACTER
+       JMS I (PIPERR
+       1
+\fTAB,  TAD I (COPTSW
+       SNA CLA         /DO WE WANT TO CONVERT?
+       JMP TABRBT      /NO
+TABLP, TAD (240
+       DCA I XR        /OUTPUT A SPACE
+       ISZ COLCT
+       TAD COLCT
+       AND (7
+       SZA CLA         /IS THE COLUMN COUNTER A MULTIPLE OF 8?
+       JMP TABLP       /NOT YET
+       JMP TESTXR      /YES - CHECK BUFFER OVERFLOW
+TABRBT,        TAD CHAR
+       DCA I XR
+       CLA CMA
+       JMS I (RUBOUT   /TWO RUBOUTS FOLLOW A TAB
+       JMP TESTXR      /CHECK FOR BUFFER OVERFLOW
+VTAB,  TAD I (COPTSW
+       SZA CLA         /SHOULD WE CONVERT?
+       JMP VTLF        /YES
+       TAD CHAR
+       DCA I XR
+       TAD (-4
+       JMS I (RUBOUT   /FOUR RUBOUTS AFTER A VERTICAL TAB
+       JMP I (EOL
+FFLF,  TAD (-4         /NINE LINE FEED SIMULATE A FORM FEED
+VTLF,  TAD (-5         /FIVE LINE FEEDS SIMULATE A VERTICAL TAB
+       DCA TEMP
+       TAD (212
+       DCA I XR
+       ISZ TEMP
+       JMP .-3
+       JMP I (EOL      /FORM FEED AND VERTICAL TAB ARE LINE ENDERS
+\fFFEED,        TAD I (COPTSW
+       SZA CLA         /SHOULD WE CONVERT?
+       JMP FFLF        /YES
+       TAD CHAR
+       DCA I XR
+       TAD (-11        /NINE RUBOUTS AFTER A FORM FEED
+       JMS I (RUBOUT
+       JMP I (EOL
+CARRET,        TAD I (MPARAM
+       RTL
+       SMA CLA         /"C" SWITCH MEANS DELETE TRAILING BLANKS FROM CARDS
+       JMP NOTOPT      /IT WASN'T ON
+TOPT,  TAD XR
+       DCA TEMP
+       TAD I TEMP
+       TAD (-240
+       SZA CLA         /WAS THE LAST CHAR ON THE LINE A SPACE?
+       JMP NOTOPT      /NO
+       CLA CMA
+       TAD XR          /YES - BACK UP THE LINE POINTER
+       DCA XR
+       JMP TOPT
+NOTOPT,        TAD CHAR
+       DCA I XR        /STORE THE CARRIAGE RETURN IN THE BUFFER
+       JMP TESTXR      /CARRIAGE RETURN IS NOT A LINE TERMINATOR
+COLCT, 0
+
+OUTOPN,        0
+       JMS I (OOPEN
+       SMA CLA
+       JMP I OUTOPN
+       JMS I (PIPERR
+ASCI5, 5
+       PAGE
+\f      /SUBROUTINES CALLED BY THE REST OF PIP
+
+K770,  770             /** DON'T MOVE THIS CONSTANT
+DELETE,        0
+       TAD P7600
+       DCA DPFILE
+       CLA CLL CMA RTL
+       DCA CHAR        /MAXIMUM OF THREE OUTPUT FILES
+DELOOP,        TAD (7201
+       DCA DLHNDL
+       TAD I DPFILE
+       SNA             /DOES THIS FILE EXIST?
+       JMP I DELETE    /THAT'S ALL
+       JMS I C200
+       1               /ASSIGN HANDLER FOR THE DELETION
+DLHNDL,        0
+       HLT
+       TAD I DPFILE    /RELOAD DEVICE NUMBER FOR DELETE
+       ISZ DPFILE      /BUMP DPFILE TO POINT TO THE FILE NAME
+       JMS I C200      /DEVICE NUMBER IN AC
+DP4,   4               /CLOSE - USED AS DELETE IN THIS CASE
+DPFILE,        0               /POINTER TO FILE NAME
+       0               /ZERO LENGTH FOR DELETE
+       JMS I (PIPERR   /FILE WASN'T THERE TO BE DELETED
+       3
+       TAD DPFILE
+       TAD DP4
+       DCA DPFILE
+       ISZ CHAR
+       JMP DELOOP      /DELETE AS MANY FILES AS HE LISTED(UP TO 3)
+       JMP I DELETE
+\fDZERO,        0               /SUBROUTINE TO ZERO THE DIRECTORY OF THE
+                       /FIRST OUTPUT DEVICE
+       JMS I (OTYPE
+       CLL RTL
+       SZL             /IS DEVICE READ-ONLY?
+       JMP OZERR       /YES - ERROR
+       RTR
+       AND K770        /MASK OUT DEVICE TYPE
+       CLL RTR
+       RAR
+       TAD (DEVLEN     /USE IT TO INDEX A TABLE OF DEVICE LENGTHS
+       DCA PIPERR
+       TAD I PIPERR
+       SNA
+       JMP I DZERO     /DEVICE LENGTH ZERO MEANS NON-DIRECTORY DEVICE
+       DCA PIPERR      /STORE LENGTH
+       TAD (OUDEVH+1
+       DCA OZHNDL
+       TAD I P7600
+       JMS I C200
+       1               /ASSIGN DEVICE, FETCH HANDLER
+OZHNDL,        0
+       HLT
+       TAD I (MPARAM+2 /IF /Y ON, DO SYSTEM ZERO
+       SPA CLA
+       JMP ZRO70
+       TAD OZHNDL      /BUT IF NOT, CHECK FOR SYSTEM ZERO
+       TAD (-7607
+       SZA CLA
+       JMP ZRO70+1     /NOT SYSTEM FILES BEGIN AT 7
+       JMS I (CONFRM   /ASK IF HE'S SURE
+       SYSZRO          /V3
+ZRO70, TAD (61
+       TAD (7
+       DCA I (DFORG
+       DCA I (SQFLAG   /AND CLEAR OUT SQUISHES
+       TAD PIPERR
+       TAD I (DFORG
+       DCA I (DLENGT
+       JMS I (GETEQ
+       DCA I (DWASTE   /DEFINE # OF WASTE WORDS
+       DCA I (MPARAM+3 /KILL = OPTION FOR FUTURE /I TRANSFERS
+       CIF 0
+       JMS I OZHNDL
+       5410            /V3 OUTPUT 6 BLOCKS FROM FIELD 1
+       DIRECT
+       1               /ALL DIRECTORIES ARE IN RECORD 1
+OZERR, JMS I (PIPERR   /ERROR WHILE ZEROING DIRECTORY
+       2
+       DCA OLDDIR      /ZERO DIRECTORY POINTER TO FORCE A NEW READ
+       JMP I DZERO
+\fPIPERR,       0
+P7600, 7600            /V3 CLA
+       JMS I (SRSTOR   /RESET 07600!
+       CDF 10          /JUST IN CASE
+       TAD I PIPERR    /GET ARG
+       TAD (ERRTBL
+       DCA TEMP
+       TAD I TEMP
+       JMS I (ERPRNT
+       JMP I (PIP      /RESTART PIP
+
+LEADER,        0
+       JMS I (OTYPE
+C200,  AND K770        /GET THE TYPE OF THE OUTPUT DEVICE
+       TAD (-PTP       /IS IT A PAPER TAPE PUNCH?
+       SZA CLA
+       JMP I LEADER    /NO
+       TAD P7600
+       DCA TEMP
+       JMS I (OCHAR    /PUT OUT SOME LEADER
+       JMP I (AOUERR
+       ISZ TEMP
+       JMP .-3
+       JMP I LEADER
+       PAGE
+\f      /TABLE OF DEVICE LENGTHS FOR /Z OPTION
+
+DEVLEN,        0;0;0;0;0;1520  /RK08 (1520= - DECIMAL 3248)
+       6001;4001;2001;0001     /RF08 IN VARIOUS SIZES
+                       /(CHEATS A BLOCK ON LARGEST TO KEEP IT NON-ZERO)
+       7601;7401;7201;7001     /DF32 IN VARIOUS SIZES
+                               /(CHEATS A BLOCK TO AVOID HARDWARE TROUBLE)
+       6437;6437               /DECTAPE AND LINCTAPE
+       ZBLOCK 1        /20 MAGTAPE
+       6437            /21 TD8E
+       0
+       1520            / 1/2 OF AN RK8E IS 23
+       0               /24
+       7022            /25 RX01 FLOPPY DISK
+       ZBLOCK 52       /ALL THE REST
+
+
+FIXLEN,        0               /ROUTINE TO ESTIMATE OUTPUT FILE LENGTH
+       TAD I (7600
+       AND (7760
+       SZA CLA         /DID THE USER PROVIDE AN ESTIMATE?
+       JMP I FIXLEN    /YES - USE IT
+       DCA CHAR
+       TAD (7617
+       DCA TEMP
+FIXLP, TAD I TEMP      /GET NEXT INPUT FILE
+       SNA
+       JMP FIXOVR      /NO MORE INPUT FILES
+       AND (7760
+       CIA CLL         /GET LENGTH AS A POSITIVE NUMBER
+                       /(LENGTH OF ZERO TURNS LINK ON)
+       TAD CHAR
+       DCA CHAR        /UPDATE CUMULATIVE LENGTH
+       SZL CLA         /DID CUMULATIVE LENGTH OVERFLOW 256 BLOCKS?
+       JMP I FIXLEN    /YES - CAN'T ESTIMATE IT
+       ISZ TEMP
+       ISZ TEMP
+       JMP FIXLP
+FIXOVR,        TAD CHAR
+       TAD I (7600
+       DCA I (7600     /STICK LENGTH IN OUTPUT FILE DESCRIPTOR
+       JMP I FIXLEN
+\fNOYES,        TEXT    /NO/
+       TEXT    /YES/
+
+CONFRM,        0
+       TAD I (MPARAM+1
+       RTL             /'O' BIT TO SIGN
+       SPA CLA
+       JMP GOTCON      /V3 'O' MEANS OK, ASSUME 'YES'
+       TAD I CONFRM    /V3
+       JMS I (ERPRNT
+       KSF
+       JMP .-1
+       JMS I (CTCTST
+       KRB             /LOOK AT HIS REPLY
+       AND (177        /IGNORE PARITY TTY
+       TAD (-"Y!7600   /V3
+       SNA CLA         /IS IT YES?
+       ISZ SQFLAG      /SET SQFLAG TO 1 (NEEDED 1 LATER)
+       TAD SQFLAG      /USE SQFLAG AS INDEX FOR MESSAGE
+       CLL RAL
+       TAD (NOYES
+       JMS I (ERPRNT
+       TAD SQFLAG
+       SNA CLA
+       JMP I (PIP
+CNFMXT,        ISZ CONFRM
+       JMP I CONFRM
+
+GOTCON,        ISZ SQFLAG      /SET SQFLAG
+       JMP CNFMXT      /AND TAKE SKIP EXIT
+       PAGE
+\f      /DIRECTORY PRINTER FOR PIP
+       MDATE=7666
+
+DIRPRE,        JMS I (OUTOPN   /OPEN THE OUTPUT FILE
+       TAD (ABUF
+       DCA CHAR        /ABUF WILL BE A TEMPORARY ARRAY OF STARTING FILES
+       TAD (7617
+       DCA TEMP
+       TAD I (7617
+       SNA
+       JMS I (DSKNUM
+       DCA I (7617     /DEFAULT DIRECTORY IS DSK:
+DFUJLP,        TAD I TEMP
+       SNA             /ARE WE THROUGH WITH THE INPUT DEVICES?
+       JMP GETDIR      /YES
+       AND (17
+       DCA I TEMP      /ONLY THE DEVICE NUMBER IS IMPORTANT
+       TAD I TEMP
+       TAD (DCB-1
+       DCA PRWD
+       CLA CLL CML RTL
+       TAD TEMP
+       DCA INFPTR      /THIS SERVES NO FUNCTION EXCEPT IMPROVING ERROR MESSAGES
+       TAD I PRWD
+       SMA CLA         /IS THE DEVICE A DIRECTORY DEVICE?
+       JMS I (PIPERR   /NO
+       6
+       ISZ TEMP
+       TAD I TEMP
+       DCA I CHAR      /SAVE THE STARTING BLOCK NUMBER
+       CLA IAC
+       DCA I TEMP      /READ FROM THE DIRECTORY
+       ISZ TEMP
+       ISZ CHAR
+       JMP DFUJLP
+GETDIR,        TAD (ABUF
+       DCA CHAR
+       JMS PCRLF
+       TAD I (MDATE
+       JMS I (PDATE
+       JMS PCRLF
+       JMS I (IOPEN    /RESET POINTERS - WERE GONNA FAKE OUT THOSE "GENERAL"
+                       /ROUTINES
+       JMP I (NXTDIR
+\fPRWD, 0               /ROUTINE TO PRINT SIXBIT TEXT
+       SNA             /IS COUNT ZERO?
+       CMA             /MAKE IT ONE
+       DCA PRCT        /STORE COUNT
+PRWDLP,        TAD I PRWD
+PR212, RTR
+       RTR
+       RTR
+       JMS PR6BIT
+       TAD I PRWD
+       JMS PR6BIT
+       ISZ PRWD
+       ISZ PRCT
+       JMP PRWDLP
+       JMP I PRWD
+PRCT,  0
+PR6BIT,        0
+       AND (77
+       SZA
+       TAD (240        /V3
+       AND (77         /V3
+       TAD (240        /V3
+       JMS I (OCHAR
+       JMP I (AOUERR
+       JMP I PR6BIT
+\fPRNUM,        0
+       DCA PRWD
+       DCA TEMP
+       TAD (PWRTEN
+       DCA PCRLF
+PRNMLP,        DCA PR6BIT
+       TAD I PCRLF
+       SNA
+       JMP PRLAST      /V3
+       CLL
+       TAD PRWD
+       SNL
+       JMP .+4
+       DCA PRWD
+       ISZ PR6BIT
+       JMP PRNMLP+1
+       CLA
+       TAD PR6BIT
+       TAD TEMP
+       SNA
+PBLJMP,        JMP PRBLNK      /INCREMENTED BY PDATE TO KILL LEADING BLANKS
+       TAD (260
+       JMS PR6BIT
+       CLA CLL CML RAR
+       DCA TEMP
+       ISZ PCRLF
+       JMP PRNMLP
+PRBLNK,        JMS PR6BIT
+       JMP .-3
+PRLAST,        TAD PRWD        /V3
+       TAD (260        /V3
+       JMS PR6BIT      /V3
+       JMP I PRNUM     /V3
+\fPCRLF,        0
+       TAD (215
+       JMS I (OCHAR
+       JMP I (AOUERR
+       TAD PR212
+       JMS I (OCHAR
+       JMP I (AOUERR
+       JMP I PCRLF
+
+PWRTEN,        -1750;-144;-12;0        /V3
+       PAGE
+\f      /MAIN DIRECTORY PRINTING LOOP
+
+NXTDIR,        JMS I (ICHAR    /FAKE, FAKE
+       JMP I (DEND
+       CLA             /WE DON'T WANT THE CHARACTER
+       DCA ECOUNT
+       TAD (INBUF-1    /WE WANT THE BUFFER!
+NEWSEG,        DCA XR
+       CDF 0
+       TAD I XR
+       DCA DCOUNT      /NUMBER OF ENTRIES
+       TAD DCOUNT
+       CLL
+       TAD (100
+       SNL CLA
+       JMS I (PIPERR
+       11
+       TAD I XR
+       DCA BLOKNO      /FIRST BLOCK OF FILE STORAGE
+       TAD I XR
+       DCA DLINK       /LINK TO NEXT SEGMENT
+       ISZ XR          /BUMP XR PAST FLAG WORD
+       TAD I XR
+       DCA WASTE
+NAMELP,        CDF 0
+       TAD I XR
+       SNA             /WHAT TYPE OF ENTRY IS IT?
+       JMP DEMPTY      /A FREE FILE
+       DCA NAME1       /A PERMENANT OR TENTATIVE FILE
+       TAD I XR
+       DCA NAME2
+       TAD I XR
+       DCA NAME3
+       TAD I XR
+       DCA NAME4
+       TAD I XR
+       DCA DDATE
+       TAD WASTE       /COMPENSATE FOR THE DATE INCREMENT
+       CMA             /AND THE WASTE WORDS
+       TAD XR
+       DCA XR
+       TAD I XR
+       SNA             /IS IT A TENTATIVE FILE?
+       JMP ADDLEN+1    /YES - TENTATIVE FILES ARE ALWAYS IGNORED
+       CIA
+       DCA FLENGT      /NO - STORE THE LENGTH
+       CDF 10
+       TAD I CHAR      /GET THE STARTING FILE FOR THIS LISTING
+       CIA CLL
+       TAD BLOKNO
+       SNL CLA         /ARE WE THERE YET?
+       JMP ADDLEN      /NO - KEEP GOING
+       CLA CLL CMA RTL
+       JMS I (PRWD     /PRINT THREE WORDS
+NAME1, 0
+NAME2, 0
+NAME3, 0
+       TAD NAME4
+       SNA CLA         /IS THERE AN EXTENSION?
+       TAD (-16        /NO - PRINT A BLANK
+       TAD (56         /YES - PRINT A PERIOD
+       JMS I (PR6BIT
+       JMS I (PRWD
+NAME4, 0               /ZERO PRINTS AS TWO MORE BLANKS
+PRLNGT,        TAD DTYPE
+       AND (100
+       SZA CLA         /WAS THE LISTING SWITCH /F?
+       JMP PRTCRL      /YES - DON'T PRINT LENGTH
+       TAD FLENGT
+       JMS I (PRNUM
+       TAD WASTE
+       SZA CLA
+       TAD DDATE
+       JMS I (PDATE    /PRINT THE CREATION DATE OF THE FILE
+PRTCRL,        JMS I (PCRLF
+ADDLEN,        TAD FLENGT
+       TAD BLOKNO
+       DCA BLOKNO      /UPDATE BLOCK NUMBER
+       ISZ DCOUNT
+       JMP NAMELP      /LOOP UNTIL ALL FILES ARE PROCESSED
+       TAD DLINK
+       SNA CLA         /MULTI-SEGMENT DIRECTORY?
+       JMP ENDDIR      /NO - FINISH UP
+       TAD XR
+       AND (7400
+       TAD (377        /BUMP XR TO NEXT BLOCK
+       JMP NEWSEG      /PROCESS NEXT LINK
+\fDEMPTY,       TAD I XR
+       CIA
+       DCA FLENGT      /STORE LENGTH OF FREE ENTRY
+       CDF 10
+       TAD FLENGT
+       TAD ECOUNT
+       DCA ECOUNT      /BUMP COUNT OF FREE BLOCKS
+       TAD DTYPE
+       AND (200
+       SNA CLA         /IS THE /E SWITCH ON?
+       JMP ADDLEN      /NO - DON'T LIST FREE FILES
+       TAD (-4
+       JMS I (PRWD
+       TEXT    /<EMPTY>/
+       JMS I (PR6BIT
+       TAD FLENGT
+       JMS I (PRNUM
+       JMP PRTCRL
+ENDDIR,        ISZ CHAR        /BUMP TEMP ARRAY TO NEXT ENTRY
+       TAD ECOUNT
+       JMS I (ENDFUJ
+       JMP NXTDIR
+       PAGE
+\f/BINARY MODE PROCESSOR FOR PIP
+
+BIN360,        360
+BINARY,        JMS I (FIXLEN
+       JMS I (OUTOPN
+       JMS I (IOPEN
+       JMS I (LEADER   /PUT OUT BLANK TAPE IF HS PUNCH OUTPUT
+       JMS LTCODE
+NEWTAP,        JMS I (ICHAR
+       JMP BEOF                /END OF FILE ON INPUT
+       SNA
+       JMP NEWTAP      /BLANK TAPE - KEEP GOING
+       TAD BN7600
+       SZA CLA
+       JMP NEWTAP
+       JMS I (ICHAR
+       JMP BEOF
+       TAD BN7600
+       SNA
+       JMP .-4
+       TAD BIN200
+       DCA CHAR
+       TAD CHAR
+BIN200,        AND BIN360
+       TAD (-240       /CHECK TYPE OF TAPE
+       SNA             /IS IT RELOCATABLE?
+       JMP RELBIN      /YES
+       TAD (-40        /IF A FIELD SETTING, IT'S ABSOLUTE
+       AND (7700
+       SNA
+       JMP ABSLUT
+       TAD BIN200      /CHECK FOR ORIGIN ALSO
+       SZA CLA
+       JMP NEWTAP      /NOTHING..NEXT FRAME
+ABSLUT,        CLA CMA
+       JMS LTCODE
+ABSBIN,        JMS RCOPY1      /COPY THIS FRAME AND READ NEXT
+       TAD BN7600
+BNM140,        SZA CLA         /IS IT TRAILER?
+       JMP ABSBIN      /NO - KEEP GOING
+BEOT,  CLA CMA         /END OF TAPE
+       JMS LTCODE      /PUT OUT SHORT LEADER/TRAILER
+       JMP NEWTAP      /GET NEXT TAPE
+\fLTCODE,       0               /SUBROUTINE TO PUNCH 200 CODE
+       SMA             /SHORT LEADER/TRAILER?
+       JMS I (OTYPE
+       SPA CLA         /DIRECTORY DEVICE?
+       TAD (70 /YES
+       TAD (-100
+       DCA TEMP
+LTLOOP,        TAD BIN200
+       JMS I (OCHAR    /OUTPUT 64 OR 8 FRAMES OF L/T CODE
+       JMP I (AOUERR
+       ISZ TEMP
+       JMP LTLOOP
+       JMP I LTCODE
+
+RELBIN,        TAD (SKP
+       DCA I (INCTZF   /DISABLE CONTROL-Z CHECKING ON INPUT
+       CLA CMA
+       JMS LTCODE      /PUT OUT SHORT LEADER/TRAILER
+RELLP, TAD CHAR
+       RTR
+       RTR
+       AND (17
+       TAD (RELTBL
+       DCA TEMP
+       TAD I TEMP      /GET DATA WORD FOR THIS FRAME
+       SMA SZA         /POSITIVE MEANS SPECIAL OR ERROR
+       JMP RELERR
+RELSNA,        SNA
+       JMP RELEND      /ZERO MEANS CHECKSUM FRAME
+       DCA TEMP        /NEGATIVE MEANS COUNT OF NUMBER OF SLAVE FRAMES
+       JMS RCOPY1
+BN7600,        7600
+       ISZ TEMP
+       JMP .-3 /COPY THIS FRAME AND ALL SLAVE FRAMES
+       JMP RELLP       /GET NEXT CONTROL FRAME
+RELEND,        JMS RCOPY1      /COPY THE FIRST FRAME OF THE CHECKSUM
+       JMS I (OCHAR
+       JMP I (AOUERR   /OUTPUT THE SECOND FRAME
+       JMP BEOT        /END TAPE - START NEXT ONE
+BEOF,  JMS LTCODE
+       JMS I (OCLOSE
+       JMP I (AOUERR
+       JMP I (PIP
+\fRCOPY1,       0               /ROUTINE TO ADVANCE "CHAR" TO NEXT INPUT CHARACTER
+       TAD CHAR
+       JMS I (OCHAR
+       JMP I (AOUERR
+       JMS I (ICHAR
+       JMP INEFER
+       DCA CHAR
+       TAD CHAR
+       JMP I RCOPY1
+INEFER,        SMA CLA         /DETECT FATALITIES
+       JMS I (PIPERR
+       7
+       JMS I (PIPERR           /A REAL BAD READ
+       4
+
+RELERR,        CLL RAR
+       SZA CLA         /CODE OF 1 MEANS SPECIAL
+       JMS I (PIPERR   /ILLEGAL RELOCATABLE INPUT
+       10
+       JMS RCOPY1
+       CLL CML CMA RTL /MULTIPLY NAME COUNT BY -6 (APPROXIMATELY)
+       TAD CHAR
+       CLL CML RAL     /(ACTUALLY THIS PRODUCES -6X-1 WHICH IS WHAT WE WANT)
+       JMP RELSNA
+       PAGE
+\fERPRNT,       0               /ERROR MESSAGE PRINTOUT ROUTINE
+       DCA TEMP
+ERLP,  TAD I TEMP
+       RTR
+       RTR
+       RTR
+       JMS ERPCH       /PRINT HIGH-ORDER CHARACTER
+       TAD I TEMP
+       JMS ERPCH       /PRINT LOW-ORDER CHARACTER
+       ISZ TEMP
+       JMP ERLP
+
+ERPCH, 0
+       AND (77
+       SNA
+       JMP ERCRLF      /0 CHARACTER TERMINATES
+       JMS CHPRNT
+       JMP I ERPCH
+FILENR,        TAD ("#
+       JMS I (TTYOUT
+       TAD INFPTR      /GET PTR TO CURRENT INPUT FILE
+       TAD (321        /MAGIC NUMBER
+       CLL RAR
+       JMP FILENR-2
+
+CHPRNT,        0
+       TAD (-37        /IS IT A _?
+       SNA
+       JMP FILENR      /YES..PRINT FILE NUMBER
+       IAC
+       SNA             /MAYBE ^?
+       JMP I (SQFILE   /YEP..PRINT FILE NAME
+       SPA
+       TAD (100
+       TAD (236
+       JMS I (TTYOUT
+       JMP I CHPRNT
+
+ERCRLF,        TAD (215
+       JMS I (TTYOUT
+       TAD (212
+       JMS I (TTYOUT
+       JMP I ERPRNT
+\fPDATE,        0               /PRINTS THE DATE
+       SNA
+       JMP I PDATE     /NO DATE TO PRINT
+       DCA ERPRNT
+       ISZ I (PBLJMP
+       JMS I (PR6BIT
+       TAD ERPRNT
+       CLL RTL
+       RTL
+       RAL
+       AND (17
+       JMS I (PRNUM
+       TAD (57
+       JMS I (PR6BIT
+       TAD ERPRNT
+       RTR
+       RAR
+       AND (37
+       JMS I (PRNUM
+       TAD (57
+       JMS I (PR6BIT
+       TAD ERPRNT
+       AND (7
+       TAD (106
+       JMS I (PRNUM
+       CLA CMA
+       TAD I (PBLJMP
+       DCA I (PBLJMP   /RESET PRNUM TO PRINT LEADING SPACES
+       JMP I PDATE
+
+DSKNUM,        0
+       DCA DSKNAM+1
+       JMS I (200
+       12
+DSKNAM,        5723
+       0
+       0
+       HLT
+       TAD DSKNAM+1
+       JMP I DSKNUM
+\fRELTBL,       -2;-2;2;-10;-2;-2;-2;2;0;2;-2;2;2;2;2;1
+
+ERRTBL,        ERR0
+       ERR1
+       ERR2
+       ERR3
+       ERR4
+       ERR5
+       ERR6
+       ERR7
+       ERR8
+       ERR9
+       ERR10
+       ERR11
+       IFNZRO OS78 <DIRMSG>
+
+       PAGE
+\f/ERROR MESSAGE TEXT GOES HERE
+
+
+ERR0,  TEXT    /NO ROOM FOR OUTPUT FILE/
+ERR1,  TEXT    /LINE TOO LONG IN FILE_/
+ERR3,  TEXT    /ERROR DELETING FILE/
+ERR4,  TEXT    /INPUT ERROR, FILE_/
+ERR5,  TEXT    /CAN'T OPEN OUTPUT FILE/
+ERR6,  TEXT    /DEVICE_ NOT A DIRECTORY DEVICE/
+ERR7,  TEXT    /PREMATURE END OF FILE, FILE_/
+ERR8,  TEXT    /ILLEGAL BINARY INPUT, FILE_/
+ERR9,  TEXT    /BAD DIRECTORY ON DEVICE_/
+ERR10, TEXT    /DIRECTORY ERROR/
+
+
+TTYOUT,        0
+       TLS
+       TSF
+       JMP .-1
+       CLA
+       JMP I TTYOUT
+       PAGE
+\f/SQUISH PROCESSOR
+
+SQUISH,        JMS I (CONFRM
+       SURE            /V3
+SQUISX,        DCA I (OUELEN   /INITIALIZE PARAMS TO FAKE OUT "IMTRA"
+       DCA I (OUBLK
+       DCA I (7621     /ZERO SECOND FILE FOR "INNEWF"
+       DCA I (CTCFLG
+       JMS I (IOPEN
+       JMS I (INNEWF
+       JMP I (PIP      /NO INPUT
+       TAD (OUDEVH+1
+       DCA SOHND
+       TAD I SQ7600
+       SNA
+       JMP I (PIP      /NO OUTPUTEE, NO SQUISHEE
+       JMS I (200
+       1
+SOHND, 0
+       HLT
+       JMS INTEST
+       JMS I (OTYPE
+       CLL RTR
+       RAR
+       AND (77
+       TAD (DEVLEN
+       DCA TEMP
+       TAD I TEMP      /GET ENTRY FROM DEVICE LENGTH TABLE
+       DCA OUDLEN      /SAVE OUTPUT DEVICE LENGTH
+       JMS GETEQ
+       DCA OUWAST
+       TAD SOHND
+       DCA OHNDLR
+       TAD OHNDLR
+       DCA I (OUHNDL
+       TAD I (INHNDL
+       DCA IHNDLR
+       JMS SETCTC
+       JMS I (CTCFLG
+       CIF 0
+       JMS I IHNDLR
+       1400
+       0
+       1
+       JMP I (SQIDER+1
+       CIF 0
+       JMS I (7607
+       5400
+       0
+       MTEMP           /MOVE THE INPUT DIRECTORY TO SYS:
+       JMP I (SQIDER+1
+       CLA IAC
+       DCA I (SQBUF2+2
+       DCA I (CTCFLG
+       TAD SOHND       /SETUP DIRECTORY START
+       JMS I (SQDTST
+       JMS I (SETSAM   /IF IHNDLR=OHNDLR, SAME=1
+       CLA CMA
+       DCA I (SQBUF2
+       DCA I (OUTSEG
+       JMP I (NEWOUT
+
+GETEQ, 0               /V3
+       TAD I (MPARAM+3
+       SNA
+       IAC
+       AND (77         /CONVERT 0 TO 1 AND 100 TO 0
+       CIA
+       JMP I GETEQ
+
+INTEST,        0               /TEST IF INPUT IS DIRECTORY
+       TAD I (7617
+       AND (17
+       TAD (DCB-1
+       DCA TEMP
+       TAD I TEMP
+       SMA CLA
+       JMS I (PIPERR
+       6
+       JMP I INTEST
+
+SETCTC,        0               /MODIFY 07600 TO RETURN TO SQCTLC
+       TAD CDIF10
+       CDF 0
+       DCA I SQ7600
+       TAD (5602       /JMP I .+1
+       DCA I (7601
+       TAD (SQCTLC
+       DCA I (7602
+CDIF10,        CIF CDF 10
+       JMP I SETCTC
+\fOUK,  0               /V3 ON IMAGE MODE TRANSFER
+                       /CLOSE OUT FILE WITH = OPTION
+                       /IF NOT TOO SMALL
+       TAD I (OUCCNT
+       CLL CIA
+       TAD I (MPARAM+3
+       SNL             /IS = OPTION LARGER?
+SQ7600,        7600            /RETURN OUCCNT IF IT'S LARGER
+       TAD I (OUCCNT   /RETURN LOW ORDER = OPTION IF IT'S LARGER
+       JMP I OUK
+       PAGE
+\fNEWIN,        TAD (MTEMP-1
+       DCA INSEG
+       JMS I (CTCFLG
+       CIF 0
+       JMS I (7607
+       0210
+S7200, SQBUF2
+INSEG, 0
+       JMP I (SQIDER
+       DCA I (CTCFLG
+       TAD I (SQBUF2+1
+       DCA INBLK
+       TAD (SQBUF2+4
+       DCA INXR
+SGETIN,        TAD I INXR
+       SNA
+       JMP SEMPTY
+       DCA I OUTXR
+       TAD OUTXR
+       DCA OUSAVE
+       JMS I (CYWAST   /COPY WASTE WORDS
+       TAD I INXR
+       DCA RECCNT
+       TAD RECCNT
+       SNA
+       JMP SNULL
+       CMA CLL         /V3
+       TAD OUTBLK
+       TAD OUDLEN
+       SZL CLA
+       JMP SNULER
+       TAD RECCNT
+       DCA I OUTXR
+       CLA CMA
+       TAD I (SQBUF1
+       DCA I (SQBUF1
+       TAD INBLK
+       CIA
+       TAD OUTBLK
+       SNA CLA
+       TAD SAME
+       SNA CLA
+MOVFIL,        JMS I (SQTRA    /MOVE THE FILE DOWN
+       TAD RECCNT
+       CIA
+       TAD OUTBLK
+       DCA OUTBLK
+       TAD RECCNT
+DMTX,  CIA
+       TAD INBLK
+       DCA INBLK
+       TAD OUTXR
+       CIA
+       TAD OUWAST
+       TAD OUWAST
+       TAD (SQBUF1+365
+       SMA CLA         /DO WE HAVE ROOM FOR TWO MORE ENTRIES?
+       JMP NEXTIN
+
+       /DIRECTORY SEGMENT OVERFLOW ON OUTPUT...
+
+       ISZ I (OUTSEG
+       TAD I (OUTSEG
+       IAC
+       DCA I (SQBUF1+2 /STORE LINK TO NEXT SEGMENT
+       TAD I (SQBUF1+2
+       TAD (-7
+       SMA CLA
+       JMP I (SQIDER-1 /TOO MANY SEGMENTS
+       JMS I (OUTDIR   /OUTPUT THIS SEGMENT
+NEWOUT,        TAD (SQBUF1-1
+       DCA OUTXR       /INITIALIZE XR FOR NEXT OUTPUT SEGMENT
+       DCA I (OUTINH   /ZAP ANY OLD OUTPUT INHIBIT FLAG
+       DCA I OUTXR
+       TAD OUTBLK
+       DCA I OUTXR
+       DCA I OUTXR
+       DCA I OUTXR
+       TAD OUWAST
+       DCA I OUTXR
+NEXTIN,        ISZ I S7200
+       JMP SGETIN
+       TAD I (SQBUF2+2
+       SNA             /ANY MORE INPUT SEGMENTS?
+       JMP I (SQOVER
+       JMP NEWIN
+SNULER,        TAD (NOROOM
+       JMS I (ERPRNT
+SNULL, CLA CMA
+       TAD OUSAVE
+       DCA OUTXR
+       JMP DMTX-1
+SEMPTY,        TAD I INXR
+       JMP DMTX
+OUSAVE,        0
+\fSURE, TEXT    /ARE YOU SURE?/
+
+SETSAM,        0
+       TAD IHNDLR
+       CIA
+       TAD OHNDLR
+       SNA CLA
+       IAC
+       DCA SAME
+       JMP I SETSAM
+       PAGE
+\fSQOVER,       DCA I OUTXR
+       TAD OUDLEN
+       TAD OUTBLK
+       SNA
+       JMP CKZERO
+       DCA I OUTXR
+       CLA CMA
+       TAD I (SQBUF1
+       DCA I (SQBUF1
+CKZERO,        TAD I (SQBUF1
+       SZA CLA
+       JMP ZEROK
+       CLA CLL CML RAR
+       JMS OUTDIR      /READ IN LAST DIRECTORY
+       DCA I (SQBUF1+2 /ZERO OUT LINK WORD
+       SKP
+ZEROK, ISZ OUTSEG
+       JMS OUTDIR
+ZEROKS,        JMS SRSTOR
+       JMP I (PIP
+
+       DCA I (SQBUF1+2
+SQIDER,        JMS OUTDIR
+       JMS SRSTOR
+       JMS I (PIPERR
+       12
+OUTDIR,        0
+       TAD (4210
+       DCA .+4
+       JMS CTCFLG
+       CIF 0
+       JMS I OHNDLR
+       0
+       SQBUF1
+OUTSEG,        0
+       JMP SQIDER+1
+       DCA CTCFLG
+       JMP I OUTDIR
+
+SQIOER,        TAD (IOMSG
+       JMS I (ERPRNT
+       JMP I (SLGRET
+\fSQCTLC,       KCC             /JUMPED TO BY CODE AT 07600
+       JMS I (TSTSAM   /TEST IF OPERATION IS TO ITSELF 
+       TAD (CTCMSG
+       JMS I (ERPRNT
+       TAD CTCFLG
+       SZA CLA
+       JMP I CTCFLG
+       TAD I (MPARAM+1 /IS IT /S?
+       AND (40
+       SNA CLA
+       JMP I (SYSCPY   /NO../Y
+       JMP I (MOVFIL
+
+SRSTOR,        0
+       JMS I (7700     /MAKE SURE MONITOR IS IN CORE
+       10
+       DCA .-2         /AND WIPE THE CALL AWAY
+       TAD (4207
+       CDF 0
+       DCA I (7600
+       TAD (5000
+       DCA I (7601
+       DCA I (7602
+       CDF 10
+       JMP I SRSTOR
+
+CTCFLG,        0
+       JMP I CTCFLG
+\fCTCMSG,       TEXT    /SORRY - NO INTERRUPTIONS/
+IOMSG, TEXT    /I-O ERROR IN ^ - CONTINUING/
+NOROOM,        TEXT    /NO ROOM IN ^ - CONTINUING/
+       PAGE
+\fK7760,        7760
+SYSCOP,        TAD K7622               /SET INFPTR IN CASE OF /Y ERROR
+       DCA INFPTR      /WILL FILE #1
+       JMS I (SETCTC   /KLUDGE UP 07600
+SYSCPY,        TAD (INDEVH+1
+       DCA YIHAND      /SET TO ASSIGN INPUT HANDLER
+       TAD (OUDEVH+1
+       DCA YOHAND
+       TAD (2000
+       DCA K2000       /THIS MAY GET CLOBBERED READING IN DIRECT.
+       TAD (10
+       DCA OFSET
+       TAD I K7617
+       SNA CLA         /IS THERE AN INPUT DEVICE?
+       ISZ I K7617     /MAKE INPUT =SYS
+       JMS I (INTEST   /SEE IF OPERATIONS ARE TO SAME DEVICE
+       TAD I K7617
+       JMS I K200      /ASSIGN HANDLER
+       1
+YIHAND,        0
+K7622, 7622    /THINLY DISGUISED HALT
+       TAD I K7617
+K200,  AND K7760       /CHECK INPUT FILE LENGTH
+       SNA             /IF BLANK,INPUT SYSTEM HEAD
+       JMP     YSOUT
+       TAD (-6340      /CHECK FOR PROPER LENGTH
+       SZA CLA
+       JMP PER13       /ERROR..NOT SYSTEM HEAD
+       TAD I (7601     /IS THERE OUTPUT DEVICE?
+       SZA CLA         /IF YES..WE CAN DO IMAGE XFER
+       JMP I (IMGTST
+       TAD I (7620
+YOUSYS,        DCA YINREC      /PICK UP STARTING RECORD
+       CIF 0
+       JMS I YIHAND    /READ IN FIRST INPUT RECORDS
+K2000, 2000            /(0-15 IF SYSTEM HEAD,0-7 IF FILE)
+       OUBUF
+YINREC,        0
+       JMP I (PER4     /INPUT ERROR
+       TAD I (7620     /IF INPUT FROM A FILE, OPEN
+       SZA CLA         /A HOLE FOR OUTPUT DIRECTORY
+       JMS I (MOVE     /DO A CORE MOVE
+       JMS I (TSTHED   /TEST FOR VALID SYSTEM HEAD
+       TAD YINREC
+       TAD OFSET       /BUMP TO NEXT RECORD
+       DCA NXTRD
+       TAD I (7600     /IF NO OUTPUT, FORGET IT
+       SNA
+       JMP PIPCLR      /RESET AND GO TO PIP
+       JMS I K200
+       1
+YOHAND,        0
+       HLT             /V3
+       JMS I (FAKE
+       JMS I (SETSAM
+\f      JMS I (TSTIO    /TEST OUTPUT. SEE IF DIRECT. DEV.
+       CIF 0
+       JMS I YOHAND    /READ OUTPUT DIRECTORY INTO PLACE
+       1400
+       400
+       1
+       JMP I (PER4
+       CDF 0
+       TAD I (401      /NOW TEST FOR VALID OUTPUT DEVICE
+       CDF 10
+       TAD (-10        /IF LESS THAN 10, DON'T XFER
+       SPA CLA
+       JMS I (PIPERR
+       11
+       TAD (-4
+       DCA YINREC      /XFER COUNTER
+
+       JMP     YDUMP
+YLOOP, CIF 0
+       JMS I YIHAND    /READ NEXT
+K3400, 3400            /16 BLOCKS
+       OUBUF
+NXTRD, 0
+       JMP I (PER4
+       TAD NXTRD
+       TAD (16
+       DCA NXTRD
+YDUMP, TAD (7400
+       JMS I (OUTDMP   /WRITE BUFFER
+       JMP I (AOUERR
+       ISZ YINREC      /DONE YET?
+       JMP YLOOP       /NOT YET..LOOP
+PIPCLR,        JMS I (SRSTOR   /CLEAR OUT 07600
+       JMP I (PIP
+\fYSOUT,        TAD I   (7601   /HERE IF INPUT FROM SYSTEM HEAD
+       SZA CLA         /IS THERE AN OUTPUT FILE?
+       JMP I   (YTSOUT /YES, SET UP FOR IMAGE MODE
+YNOOUT,        TAD K3400       /SET TO READ IN DIRECTORY
+       DCA K2000       /PLUS FIRST 7 RECORDS
+       TAD (16         /AND RESTART READ AT RECORD 16
+       DCA OFSET
+       JMP YOUSYS
+OFSET, 0
+
+PER13, JMS I (PIPERR
+       13
+K7617, 7617            /V3
+       PAGE
+\fDIRECT,       -1
+DFORG, 0               /FILE STORAGE
+       0
+       0
+DWASTE,        0               /#WASTE WORDS
+       0
+DLENGT,        0
+
+MOVE,  0
+       TAD (4400       /MOVES CORE TO OPEN DIRECTORY HOLE
+       DCA TEMP
+       TAD (3777
+       DCA MWAST
+       TAD (6777
+MOVE1, DCA TSTSAM
+       CDF 0
+       TAD I MWAST
+       DCA I TSTSAM
+       CMA
+       TAD     MWAST
+       DCA     MWAST
+       CMA
+       TAD     TSTSAM
+       ISZ TEMP
+       JMP MOVE1
+       CLA
+       CDF 10
+       JMP I MOVE
+
+ERR11, TEXT    /BAD SYSTEM HEAD/
+
+YTSOUT,        TAD I (7617     /O.K. SETUP CD AREA FOR IMAGE XFER
+       TAD (7760       /FROM SYSTEM AREA OF INPUT DEVICE
+       DCA I (7617
+       TAD I (7617
+       AND (17
+       TAD (6360
+       DCA I (7621
+       TAD K7
+       DCA I (7622
+IMGTST,        DCA SAME        /ALLOW ^C IF TO OUTPUT FILE
+       TAD I (YIHAND   /TEST FOT VALID SYSTEM
+       DCA IHNDLR
+       CIF 0
+       JMS I IHNDLR
+       0200
+       3400
+K7,    7
+       JMP I (PER4
+       JMS I (TSTHED
+       JMP I (IMAGE
+\fTSTSAM,       0
+       TAD SAME        /IF /Y IS TO SAME DEVICE AS INPUT (SYS)
+       SNA CLA         /^C GIVES MESSAGE AND RETRIES OPERATION
+       JMP I (ZEROKS
+       JMP I TSTSAM
+
+ERR2,  TEXT    /OUTPUT ERROR/
+
+SQFILE,        DCA MWAST
+       TAD I (OUSAVE
+       DCA TSTSAM      /IF ERROR DURING /S
+       DCA DWASTE
+       CLA CLL CMA RTL
+       DCA MOVE        /-3 FOR FILE NAME
+SQFIL3,        TAD I TSTSAM    /FIRST 2 CHARS. IN NAME
+       CLL RTR
+       RTR
+       RTR
+SQFIL5,        AND (77
+       SZA             /IF ZERO, DON'T BOTHER
+       JMS I (CHPRNT
+       ISZ DWASTE      /RIGHT HALF OR NEW WORD?
+       JMP SQFIL4      /RIGHT HALF
+       ISZ TSTSAM
+       ISZ MOVE        /EXHAUSTED ALL?
+       JMP SQFIL3      /NOPE
+       TAD MWAST       /DONE WITH IT YET?
+       SZA CLA
+       JMP I (FILENR-1 /YES
+       TAD I TSTSAM    /IS THERE AN EXTENSION?
+       SNA CLA
+       JMP I (FILENR-1 /NO..CONTINUE ORIGINAL MSG
+       TAD (256
+       JMS I (TTYOUT
+       ISZ MWAST       /SIGNAL END
+       CLA CMA
+       JMP SQFIL3-1
+SQFIL4,        CLA CMA
+       DCA DWASTE
+       TAD I TSTSAM    /GET RIGHT HALF
+       JMP SQFIL5
+\fMWAST,        0
+       DCA TEMP
+       TAD I INXR
+       DCA I OUTXR     /ROUTINE TO COPY WASTE WORDS
+       ISZ TEMP
+       JMP .-3
+       JMP I MWAST
+       PAGE
+\fFAKE, 0
+       TAD I (YIHAND
+       DCA IHNDLR
+       TAD I (YOHAND
+       DCA OHNDLR
+       DCA I (OUCCNT
+       DCA I (OUBLK
+       DCA I (OUELEN
+       TAD I (YOHAND
+       DCA I (OUHNDL
+       JMP I FAKE
+
+CYWAST,        0               /ROUTINE TO COPY WASTE WORDS
+       CLA CLL CMA RTL /THREE MORE FOR FILE NAME
+       JMS I (MWAST    /COPY THEM
+       TAD I (SQBUF2+4 /NOW ADJUST I/O WASTE WORDS
+       CIA
+       TAD OUWAST      /DIFF. BETWEEN OUT AND IN WORDS
+       SMA             /IF <0, MORE OUT THAN IN
+       JMP CGEWST      /POS. MORE IN THAN OUT (OR SAME)
+       DCA TEMP1
+       TAD I (SQBUF2+4
+       SZA
+       JMS I (MWAST    /COPY ALL INPUT WORDS
+       DCA I OUTXR     /AND 0 ALL EXTRA OUTPUT WORDS
+       ISZ TEMP1
+       JMP .-2
+       JMP I CYWAST
+CGEWST,        DCA TEMP1
+       TAD OUWAST      /XFER ONLY ENOUGH OUTPUT WDS.
+       SZA
+       JMS I (MWAST
+       TAD INXR
+       TAD TEMP1       /POINT INPUT TO NEXT FILE
+       DCA INXR
+       JMP I CYWAST
+
+TSTHED,        0               /TESTS FOR KEYBOARD MONITOR
+       CDF 0
+       TAD I (3401
+       CDF 10
+       TAD (-7200
+       SZA CLA
+       JMP I (PER13    /IF NOT CLA, NOT VALID
+       JMP I TSTHED
+\fTSTIO,        0               /SEE IF OUTPUT IS DIRECTORY DEVICE
+       JMS I (OTYPE    /GET DCB WORD FOR OUTPUT
+       SMA CLA         /IF NOT NEG., NOT DIRECT DEVICE
+       JMS I (PIPERR
+       5
+       TAD OHNDLR      /IF OUTPUT=SYS, SET NO INTERRUPT
+       TAD (171
+       SNA CLA
+       ISZ SAME
+       JMP I TSTIO
+
+ASCI2, 0               /SEE IF VALID ASCII OUTPUT
+       DCA TSTIO
+       TAD I (7600
+       SNA CLA
+       JMP I (PIP      /NO..BACK TO PIP
+       TAD TSTIO       /SEE IF /C IS ON
+       SNA CLA
+       JMS I (FIXLEN   /NO..TRY TO ESTIMATE OUTPUT
+       JMP I ASCI2
+
+SQDTST,        0               /ROUTINE TO CHECK /S DIRECTORIES
+       DCA NOHND       /PRESERVE POSSIBLE SYS ON OUTPUT
+       TAD (7          /DEFAULT TO BLOCK 7
+       DCA OUTBLK      /INITIAL GUESS
+       CDF 10          /NOW TRY TO READ DIRECTORY OF OUTPUT
+       JMS I (OTYPE    /IF NON-FILE, DON'T READ IT
+       SMA CLA
+       JMP P1A
+       CIF 0           /COULD BE NON-FILE, HOWEVER.
+       JMS I NOHND
+       0210
+       1400
+P1,    1
+       JMP I (SQIDER+1 /ERROR IN READ
+P1A,   DCA OLDDIR      /WIPES ANY DIRECT. SEGMENT
+       TAD I (1401
+       TAD (-70        /IS OUTPUT A SYS DEVICE?
+       SNA CLA
+       JMP SYSDIR      /YES.
+       TAD NOHND       /IS OUTPUT THE SYSTEM DEVICE?
+       TAD (171
+       SZA CLA
+       JMP .+3
+SYSDIR,        TAD (70
+       DCA OUTBLK
+       JMP I SQDTST
+
+NOHND=FAKE
+
+SYSZRO,        TEXT /ZERO SYS?/
+\fAOUERR,       SMA CLA         /WAS IT A DEVICE ERROR OR ARE WE OUT OF SPACE?
+       JMP BOUERR      /OUT OF SPACE
+PER2,  JMS I (PIPERR
+       2
+BOUERR,        JMS I (PIPERR
+       0
+
+ASCPTCH,TAD (ACHLP+1   /V3C FAKE OUT ICHAR
+       DCA I (ICHAR    /SIMULATE CALL TO ICHAR FROM 'ACHLP'
+       JMP I (GETNEW   /V3C SIMULATE OCCURRENCE OF 8-BIT ^Z IN ICHAR
+       PAGE
+\f/THIS IS ONCE-ONLY CODE
+
+ONCE,  0
+       STA
+       TAD ONCE
+       DCA ONCENF
+       TAD (20
+       DCA I ONCENF    /RESTORE L20, DON'T ALLOW REENTRY
+       TAD I (MPARAM+1
+       AND (7
+       SNA CLA         /IS /V SET?
+       JMP I ONCE      /NO, RETURN
+       TAD (VER        /YES
+       JMS I (ERPRNT   /PRINT VERSION NUMBER
+       JMP I ONCE      /RETURN
+
+VER,   TEXT    \OS/8 PIP V11A\
+ONCENF,        0
+       PAGE
+       $
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape4/README b/sw/os8/v3d/sources/system/dectapes/dectape4/README
new file mode 100644 (file)
index 0000000..90c1383
--- /dev/null
@@ -0,0 +1,16 @@
+This area contains the files contained on system release DECtape #4.
+
+Directory of OS/8 V3D DECtape 4 labeled:  AL-4694C-SA     2/15/78
+                                         OS/8 V3D SRC DT  4 OF 7
+                                         (replaces DEC-S8-OSYSB-B-UA4)
+
+
+DTFRMT.PA 111 01-AUG-77    LQP   .PA  14 01-AUG-77
+TDFRMT.PA 101 01-AUG-77    RX78B .PA  21 01-AUG-77
+KL8E  .PA  52 01-AUG-77    PIP   .PA 126 01-AUG-77
+BUILD .PA 187 01-AUG-77    RXCOPY.PA  52 01-AUG-77
+RX01NS.PA  21 01-AUG-77    
+
+   9 files in  685 blocks -   45 free blocks
+
+
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape4/RX01NS.PA b/sw/os8/v3d/sources/system/dectapes/dectape4/RX01NS.PA
new file mode 100644 (file)
index 0000000..5871006
--- /dev/null
@@ -0,0 +1,275 @@
+/FLOPPY DISK (RX01,RX71) NON-SYSTEM HANDLER FOR OS/8
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT  (C)  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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/FLOPPY DISK (RX01,RX71) NON-SYSTEM HANDLER FOR OS/8
+
+/DEFINITIONS OF RX8/E IOT'S
+
+RXVER= "E&77
+
+DEVCOD=        750     /DEVICECODE
+
+LCD=   6001+DEVCOD     /LOAD COMMAND REGISTER
+XDR=   6002+DEVCOD     /TRANSFER DATA REGISTER
+STR=   6003+DEVCOD     /SKIP ON TRANSFER REQUEST FLAG, CLEAR FLAG
+SER=   6004+DEVCOD     /SKIP ON ERROR FLAG, CLEAR FLAG
+SDN=   6005+DEVCOD     /SKIP ON DONE FLAG, CLEAR FLAG
+INTR=  6006+DEVCOD     /INTERRUPT ENABLE/DISABLE
+INIT=  6007+DEVCOD     /INITIALIZE CONTROLLER AND RECALIBRATE DRIVES
+
+
+/NOTES ON THIS HANDLER:
+
+/THIS HANDLER READS AND WRITES THE DISK IN "12-BIT" MODE, IN WHICH
+/ONLY 6 BITS OF EVERY 8-BIT BYTE ARE USED. AN RX01 CARTRIDGE
+/CONTAINS 494 OS/8 BLOCKS UNDER THIS METHOD
+
+/TO MAXIMIZE SPEED ON THE DEVICE, THE HANDLER READS AND WRITES DATA
+/ON A TRACK WITH A TWO-WAY INTERLEAVE - I.E. RECORDS 1-26 ON A TRACK
+/ARE WRITTEN IN THE SEQUENCE:
+/  1,3,5,7,9,11,13,15,17,19,21,23,25,2,4,6,8,10,12,14,16,18,20,22,24,26
+
+/IN THIS WAY THE HANDLER CAN TRANSFER DATA AT A 5KHZ WORD RATE
+
+/MODIFIED TO ALLOW ADDRESS CALCULATION DURING SECTOR BUFFER
+/LOAD-UNLOAD.
+\f      *0              /ORIGIN FOR BUILD
+
+       -2              /TWO ENTRY POINTS
+       DEVICE  RX01    /"RX01" IS THE GROUP NAME
+       DEVICE  RXA0    /"RXA0" IS THE ENTRY POINT NAME
+       4250            /DCB WORD - DEVICE TYPE 25, DIRECTORY DEVICE
+       RXA0&177        /ENTRY POINT OFFSET
+       0               /THIS WORD ALWAYS SEEMS TO BE 0
+       0               /UNUSED FOR NONSYSTEM DEVICE
+
+       DEVICE  RX01    /"RX01" IS THE GROUP NAME
+       DEVICE  RXA1    /"RXA1" IS THE ENTRY POINT NAME
+       4250            /DCB WORD - DEVICE TYPE 25, DIRECTORY DEVICE
+       RXA1&177        /ENTRY POINT OFFSET
+       0               /THIS WORD ALWAYS SEEMS TO BE 0
+       0               /UNUSED FOR NONSYSTEM DEVICE
+\f      *200            /HANDLER CODE
+
+BUF,   0               /USER BUFFER POINTER
+REC,   0               /RX01 RECORD NUMBER BEFORE INTERLEAVING
+BC,    0               /BLOCK COUNT OF TRANSFER
+FN,    0               /FUNCTION, 0=WRITE, 2=READ
+TRANS, 0               /TRANSFER COMMAND
+
+FLPWC=.                        /100 COUNTER FOR SILO OK IN LDCMD ENTRY
+LDCMD, 0               /WAIT FOR DONE FLAG AND LOAD CMD REG
+       DCA     TRANS   /SAVE THE NEW COMMAND REG VALUE
+DONELP,        TAD     S7600   /SEE IF THE KEYBOARD BUFFER
+       KRS             /CONTAINS A CONTROL/C CHARACTER
+       TAD     (-7603  /(WITH OR WITHOUT PARITY)
+       CLL             /KEEP LINK CLEAAR
+       SNA CLA
+       KSF             /WITH THE FLAG UP.
+       JMP     NOTCTC  /IF NOT, CONTINUE
+SCDIF0,        CDF CIF 0       /IF SO, RETURN TO OS/8
+       JMP I   S7600
+
+NOTCTC,        SDN             /WAIT FOR THE DONE FLAG TO COME UP
+       JMP     DONELP  /BEFORE YOU LOAD THE COMMAND REGISTER
+       TAD     TRANS   /NOW GET THE NEW COMMAND REGISTER CONTENTS
+       LCD             /AND LOAD IT.
+       SER             /SKIP IF I/O ERROR
+       JMP I   LDCMD   /AND RETURN
+       CLA CLL CML RAR /SET AC TO 4000
+       JMP     SRET    /TAKE ERROR RETURN
+
+
+RXA0,  RXVER           /ENTRY POINT FOR UNIT 0
+       CLA             /BE PROTECTIVE
+       JMP     RXCOMN  /GO TO COMMON CODE
+S70,   70              /** MUST BE AT 33 ON THIS PAGE**
+
+       IFNZRO  S70&177-33      <.ERROR>
+
+MQ,                    /DIVIDE TEMPORARY
+RXA1,  RXVER           /ENTRY POINT FOR UNIT 1
+       CLA             /CAREFUL, CAREFUL!
+       TAD     RXA1
+       DCA     RXA0    /PUT CALLING ADDR IN KNOWN PLACE
+       TAD     DIVLP   /GET "20"
+RXCOMN,        TAD     DIVRAL  /SET AC TO 20*UNIT+4
+       DCA     UNIT    /SAVE UNIT NUMBER
+       RDF
+       TAD     SCDIF0  /REMEMBER CALLING FIELD FOR RETURN
+       DCA     SRET
+\f
+/  OVERALL COMMENTS:
+/
+/  LINK REMAINS 0 THROUGH THE MAIN PROCESSING LOOP
+/  EXCEPT AS MANIPULATED BY DIVSUB
+/
+/  OVERALL LOOP CONTROL THROUGH BC IS MILDLY ODD.
+/  BC STARTS WITH MINUS COUNT OF THE # OF WORDS TO BE TRANSFERRED.
+/  BC IS INCREMENTED 77 TIMES AT THE SILO CODE, AND 1 TIME AFTER
+/  THE I/O OPERATION. 
+/  A READ OPERATION STARTS AND FINISHES AT THE MIDDLE OF THE LOOP.
+/  A WRITE OEPRATION STARTS AT THE TOP, AND FINISHES AT BOTTOM.
+/  THUS, A 1 BLOCK READ INCREMENTS 1, 77, 1, 77 AND EXITS FROM MIDDLE.
+/  AND, A 1 BLOCK WRITE INCREMENTS 77, 1, 77, 1 AND EXITS FROM BOTTOM.
+/
+/  DIVISION IS CARRIED OUT IN PARALLEL WITH I/O OPERATION BECAUSE OF
+/  TIMING CONSIDERATIONS OF THE VT78.
+/
+/  THERE IS NO ERROR RETRY, NOT PARTICULARLY CRITICAL FOR A FLOPPY.
+
+       CLL CML CLA RAR /SET LINK=0, AC=4000
+       TAD I   SYS     /TO PUT READ-WRITE BIT TO LINK
+S33,   AND     S70     /KEEP BITS FOR CDF
+       TAD     SCDF0   /ADDING IN CDF LITERAL
+       DCA     BUFCDF  /CDF INSTRUCTION TO USER'S BUFFER
+       CML RTL         /FUNCTION CODE, 0=WRITE, 2=READ
+       DCA     FN
+       TAD I   SYS     /MAKE CONTROL COUNT
+       RAL     
+       AND     S7600   /MAKE CONTROL COUNT FOR TOTAL
+       CIA             /NUMBER OF WORDS
+       DCA     BC
+       ISZ     SYS
+       TAD I   SYS     /FETCH BUFFER ADDRESS
+       DCA     BUF
+       ISZ     SYS
+       TAD I   SYS     /OS8 BLOCK #
+       CLL RTL         /TIMES 4 TO BE FLOPPY SECTOR #
+       DCA     REC
+       ISZ     SYS     /ERROR EXIT FROM I/O CALL
+       JMS     DIVSUB  /COMPUTE TRACK/SECTOR FOR FIRST I/O
+       TAD     FN      /READ OR WRITE START DIFFERENTLY
+       SZA CLA         /SKIP ON WRITE
+       JMP     STREAD  /GO TO READ
+/
+/  WRITE FALLS THRU.......
+/
+\f/
+/
+/ TOP OF MAIN PROCESSING LOOP
+/
+SETSLO,        TAD     FN      /SET SILO TO LOAD-UNLOAD DEPENDING
+       JMS     LDCMD
+       TAD     S7700   /SILO CONTROL COUNT 100 OCTAL
+       DCA     FLPWC
+BUFCDF,        HLT             /CDF TO USER'S BUFFER PLACED HERE
+TRLOOP,        TAD I   BUF     /FETCH A WORD IN CASE WRITE
+       STR             /WAIT
+       JMP     .-1
+       XDR             /AC TO SILO; OR; SILO TO AC
+       DCA I   BUF     /PLACE A WORD IN CASE READ; WRITE REPLACES SAME.
+       ISZ     BUF     /MOVE TO NEXT BUFFER LOCATION (MAY SKIP)
+S77,   77              /LITERAL 77, EXECUTES AS A NOP
+       ISZ     FLPWC   /DONE WITH 100 OCTAL SILO OPERATION
+       JMP     TRLOOP  /NO
+       TAD     BC      /INCREMENT BC BY 77 HERE, 1 LATER
+       TAD     S77     /CHECKING FOR A READ EXIT
+MAGIC, SNA             /IF BC HAS GONE TO ZERO, NO-OP FOR LDCMD
+       JMP     OKEX    /READ EXIT.
+       DCA     BC      /REPLACING BC FOR WRITE EXIT CHECK AT LOOP END
+/
+/  MIDDLE OF MAIN PROCESSING LOOP
+/
+STREAD,        TAD     FN      /READ STARTS HERE
+       TAD     UNIT    /SET UP DO DO READ OR WRITE I/O
+       JMS     LDCMD
+       TAD     MQ      /LOAD PRECOMPUTED SECTOR INFO
+       STR
+       JMP     .-1     /IN CASE NOT READY
+       XDR
+S7700, 7700            /CLEAR AC, CAN'T SKIP (XDR LEAVES AC ALONE)
+       TAD     QUO     /TRACK
+       STR             /ILLEGAL 7700 ENTRY WILL HANG; THE FUNCTION
+       JMP     .-1     /IS NOT SET UP (LDCMD)
+       XDR
+S7600, 7600
+       ISZ     REC     /MOVE TO NEXT FLOPPY SECTOR
+       JMS     DIVSUB  /COMPUTE NEXT TRACK AND SECTOR DURING THIS I/O
+       TAD     MAGIC   /WAIT FOR I/O TO COMPLETE
+       JMS     LDCMD
+       ISZ     BC      /CHECK FOR WRITE EXIT
+       JMP     SETSLO  /NO, BACK TO TOP
+OKEX,  ISZ     SYS     /BUMP TO REGULAR EXIT
+SRET,  HLT             /CDF CIF FOR USER'S CALLING FIELD
+       JMP I   SYS     /GONE
+/
+UNIT,  0               /UNIT
+SYS=RXA0
+/
+\f/
+/
+/  LITERALS
+/
+SM15,  -15
+SCDF0, CDF 0
+/
+/  DIVSUB
+/
+/  MUST ENTER WITH LINK AND AC 0
+/  COMPUTES TRACK IN 'QUO', SECTOR IN 'MQ', FROM # IN 'REC'
+/
+/  REPEATED SUBTRACTS OF 13 DECIMAL LEAVE THE HIGH N-1 BITS OF
+/  QUOTIENT IN QUO, THE LOW BIT OF QUOTIENT IN LINK, AND THE
+/  REMAINDER IN AC. THE INTERLEAVE IS ACCOMPLISHED BY SHIFTING
+/  LOW QUOTINET BIT INTO LOW REMAINDER BIT.
+/
+DIVSUB,        0
+       DCA     QUO     /INIT QUOTIENT FOR DIVIDE
+       TAD     REC     /RECORD # MASSAGED IN AC
+DIVLP, SNL             /LINK USAGE REVERSED FROM RICHIE'S CODE
+       ISZ     QUO     /ISZ EVERY OTHER TIME, <=DIVIDE BY 26
+       TAD     SM15    /THE -13 DECIMAL
+       SMA             /SKIP ON DONE
+       JMP     DIVLP   /MORE
+DIVRAL,        RAL             /LINK USAGE REVERSED; INTERLEAVE!!
+       TAD     S33     /ADD 233 (200 IRREL) MAKING SECTOR
+       DCA     MQ
+       JMP I   DIVSUB  /LEAVING LINK AND AC 0
+QUO,   0               /DIVIDE TEMP
+/
+
+       $
+
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape4/RX78B.PA b/sw/os8/v3d/sources/system/dectapes/dectape4/RX78B.PA
new file mode 100644 (file)
index 0000000..c841dbf
--- /dev/null
@@ -0,0 +1,287 @@
+/RX78B
+/FLOPPY DISK (RX01,RX71) NON-SYSTEM HANDLER FOR OS/8
+/FOR RXA2 AND RXA3
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT  (C)  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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/FLOPPY DISK (RX01,RX71) NON-SYSTEM HANDLER FOR OS/8
+
+/DEFINITIONS OF RX8/E IOT'S
+
+RXVER= "F&77
+
+DEVCOD=        750     /DEVICECODE
+
+LCD=   6001+DEVCOD     /LOAD COMMAND REGISTER
+XDR=   6002+DEVCOD     /TRANSFER DATA REGISTER
+STR=   6003+DEVCOD     /SKIP ON TRANSFER REQUEST FLAG, CLEAR FLAG
+SER=   6004+DEVCOD     /SKIP ON ERROR FLAG, CLEAR FLAG
+SDN=   6005+DEVCOD     /SKIP ON DONE FLAG, CLEAR FLAG
+INTR=  6006+DEVCOD     /INTERRUPT ENABLE/DISABLE
+INIT=  6007+DEVCOD     /INITIALIZE CONTROLLER AND RECALIBRATE DRIVES
+
+
+/NOTES ON THIS HANDLER:
+
+/THIS HANDLER READS AND WRITES THE DISK IN "12-BIT" MODE, IN WHICH
+/ONLY 6 BITS OF EVERY 8-BIT BYTE ARE USED. AN RX01 CARTRIDGE
+/CONTAINS 494 OS/8 BLOCKS UNDER THIS METHOD
+
+/TO MAXIMIZE SPEED ON THE DEVICE, THE HANDLER READS AND WRITES DATA
+/ON A TRACK WITH A TWO-WAY INTERLEAVE - I.E. RECORDS 1-26 ON A TRACK
+/ARE WRITTEN IN THE SEQUENCE:
+/  1,3,5,7,9,11,13,15,17,19,21,23,25,2,4,6,8,10,12,14,16,18,20,22,24,26
+
+/IN THIS WAY THE HANDLER CAN TRANSFER DATA AT A 5KHZ WORD RATE
+
+/MODIFIED TO ALLOW ADDRESS CALCULATION DURING SECTOR BUFFER
+/LOAD-UNLOAD.
+\f      *0              /ORIGIN FOR BUILD
+
+       -2              /TWO ENTRY POINTS
+       DEVICE  RX01    /"RX01" IS THE GROUP NAME
+       DEVICE  RXA2    /"RXA2" IS THE ENTRY POINT NAME
+       4250            /DCB WORD - DEVICE TYPE 25, DIRECTORY DEVICE
+       RXA2&177        /ENTRY POINT OFFSET
+       0               /THIS WORD ALWAYS SEEMS TO BE 0
+       0               /UNUSED FOR NONSYSTEM DEVICE
+
+       DEVICE  RX01    /"RX01" IS THE GROUP NAME
+       DEVICE  RXA3    /"RXA3" IS THE ENTRY POINT NAME
+       4250            /DCB WORD - DEVICE TYPE 25, DIRECTORY DEVICE
+       RXA3&177        /ENTRY POINT OFFSET
+       0               /THIS WORD ALWAYS SEEMS TO BE 0
+       0               /UNUSED FOR NONSYSTEM DEVICE
+\f      *200            /HANDLER CODE
+
+BUF,   0               /USER BUFFER POINTER
+REC,   0               /RX01 RECORD NUMBER BEFORE INTERLEAVING
+BC,    0               /BLOCK COUNT OF TRANSFER
+FN,    0               /FUNCTION, 0=WRITE, 2=READ
+
+FLPWC=.                        /100 COUNTER FOR SILO OK IN LDCMD ENTRY
+LDCMD, 0               /WAIT FOR DONE FLAG AND LOAD CMD REG
+       DCA     TRANS   /SAVE THE NEW COMMAND REG VALUE
+       SDN             /WAIT FOR THE DONE FLAG TO COME UP
+       JMP     .-1     /BEFORE YOU LOAD THE COMMAND REGISTER
+DONELP,        TAD     S7600   /SEE IF THE KEYBOARD BUFFER
+       KRS             /CONTAINS A CONTROL/C CHARACTER
+       TAD     (-7603  /(WITH OR WITHOUT PARITY)
+       CLL             /KEEP LINK CLEAAR
+       SNA CLA
+       KSF             /WITH THE FLAG UP.
+       JMP     NOTCTC  /IF NOT, CONTINUE
+       JMS     SELECT  /YES, SELECT "A" DRIVES
+SCDIF0,        CDF CIF 0       / RETURN TO OS/8
+       JMP I   S7600
+
+NOTCTC,        TAD     TRANS   /NOW GET THE NEW COMMAND REGISTER CONTENTS
+       LCD             /AND LOAD IT.
+       SER             /SKIP IF I/O ERROR
+       JMP I   LDCMD   /AND RETURN
+       JMS     SELECT  /SELECT "A" DRIVES
+       CLA CLL CML RAR /SET AC TO 4000
+       JMP     SRET    /TAKE ERROR RETURN
+
+
+RXA2,  RXVER           /ENTRY POINT FOR UNIT 2
+       CLA             /BE PROTECTIVE
+S70,   70              /** MUST BE AT 33 ON THIS PAGE**
+       JMP     RXCOMN  /GO TO COMMON CODE
+
+       IFNZRO  S70&177-33      <.ERROR>
+
+MQ,                    /DIVIDE TEMPORARY
+RXA3,  RXVER           /ENTRY POINT FOR UNIT 3
+       CLA             /CAREFUL, CAREFUL!
+       TAD     RXA3
+       DCA     RXA2    /PUT CALLING ADDR IN KNOWN PLACE
+       TAD     DIVLP   /GET "20"
+RXCOMN,        TAD     DIVRAL  /SET AC TO 20*UNIT+4
+       DCA     UNIT    /SAVE UNIT NUMBER
+       RDF
+       TAD     SCDIF0  /REMEMBER CALLING FIELD FOR RETURN
+       DCA     SRET
+       IAC
+       JMS     SELECT  /SELECT "B" DRIVES
+\f
+/  OVERALL COMMENTS:
+/
+/  LINK REMAINS 0 THROUGH THE MAIN PROCESSING LOOP
+/  EXCEPT AS MANIPULATED BY DIVSUB
+/
+/  OVERALL LOOP CONTROL THROUGH BC IS MILDLY ODD.
+/  BC STARTS WITH MINUS COUNT OF THE # OF WORDS TO BE TRANSFERRED.
+/  BC IS INCREMENTED 77 TIMES AT THE SILO CODE, AND 1 TIME AFTER
+/  THE I/O OPERATION. 
+/  A READ OPERATION STARTS AND FINISHES AT THE MIDDLE OF THE LOOP.
+/  A WRITE OEPRATION STARTS AT THE TOP, AND FINISHES AT BOTTOM.
+/  THUS, A 1 BLOCK READ INCREMENTS 1, 77, 1, 77 AND EXITS FROM MIDDLE.
+/  AND, A 1 BLOCK WRITE INCREMENTS 77, 1, 77, 1 AND EXITS FROM BOTTOM.
+/
+/  DIVISION IS CARRIED OUT IN PARALLEL WITH I/O OPERATION BECAUSE OF
+/  TIMING CONSIDERATIONS OF THE VT78.
+/
+/  THERE IS NO ERROR RETRY, NOT PARTICULARLY CRITICAL FOR A FLOPPY.
+
+       CLL CML CLA RAR /SET LINK=0, AC=4000
+       TAD I   SYS     /TO PUT READ-WRITE BIT TO LINK
+S33,   AND     S70     /KEEP BITS FOR CDF
+       TAD     SCDF0   /ADDING IN CDF LITERAL
+       DCA     BUFCDF  /CDF INSTRUCTION TO USER'S BUFFER
+       CML RTL         /FUNCTION CODE, 0=WRITE, 2=READ
+       DCA     FN
+       TAD I   SYS     /MAKE CONTROL COUNT
+       RAL     
+       AND     S7600   /MAKE CONTROL COUNT FOR TOTAL
+       CIA             /NUMBER OF WORDS
+       DCA     BC
+       ISZ     SYS
+       TAD I   SYS     /FETCH BUFFER ADDRESS
+       DCA     BUF
+       ISZ     SYS
+       TAD I   SYS     /OS8 BLOCK #
+       CLL RTL         /TIMES 4 TO BE FLOPPY SECTOR #
+       DCA     REC
+       ISZ     SYS     /ERROR EXIT FROM I/O CALL
+       JMS     DIVSUB  /COMPUTE TRACK/SECTOR FOR FIRST I/O
+       TAD     FN      /READ OR WRITE START DIFFERENTLY
+       SZA CLA         /SKIP ON WRITE
+       JMP     STREAD  /GO TO READ
+/
+/  WRITE FALLS THRU.......
+/
+\f/
+/
+/ TOP OF MAIN PROCESSING LOOP
+/
+SETSLO,        TAD     FN      /SET SILO TO LOAD-UNLOAD DEPENDING
+       JMS     LDCMD
+       TAD     S7700   /SILO CONTROL COUNT 100 OCTAL
+       DCA     FLPWC
+BUFCDF,        HLT             /CDF TO USER'S BUFFER PLACED HERE
+TRLOOP,        TAD I   BUF     /FETCH A WORD IN CASE WRITE
+       STR             /WAIT
+       JMP     .-1
+       XDR             /AC TO SILO; OR; SILO TO AC
+       DCA I   BUF     /PLACE A WORD IN CASE READ; WRITE REPLACES SAME.
+       ISZ     BUF     /MOVE TO NEXT BUFFER LOCATION (MAY SKIP)
+S77,   77              /LITERAL 77, EXECUTES AS A NOP
+       ISZ     FLPWC   /DONE WITH 100 OCTAL SILO OPERATION
+       JMP     TRLOOP  /NO
+       TAD     BC      /INCREMENT BC BY 77 HERE, 1 LATER
+       TAD     S77     /CHECKING FOR A READ EXIT
+MAGIC, SNA             /IF BC HAS GONE TO ZERO, NO-OP FOR LDCMD
+       JMP     OKEX    /READ EXIT.
+       DCA     BC      /REPLACING BC FOR WRITE EXIT CHECK AT LOOP END
+/
+/  MIDDLE OF MAIN PROCESSING LOOP
+/
+STREAD,        TAD     FN      /READ STARTS HERE
+       TAD     UNIT    /SET UP DO DO READ OR WRITE I/O
+       JMS     LDCMD
+       TAD     MQ      /LOAD PRECOMPUTED SECTOR INFO
+       STR
+       JMP     .-1     /IN CASE NOT READY
+       XDR
+S7700, 7700            /CLEAR AC, CAN'T SKIP (XDR LEAVES AC ALONE)
+       TAD     QUO     /TRACK
+       STR
+       JMP     .-1
+       XDR
+S7600, 7600
+       ISZ     REC     /MOVE TO NEXT FLOPPY SECTOR
+       JMS     DIVSUB  /COMPUTE NEXT TRACK AND SECTOR DURING THIS I/O
+       TAD     MAGIC   /WAIT FOR I/O TO COMPLETE
+       JMS     LDCMD
+       ISZ     BC      /CHECK FOR WRITE EXIT
+       JMP     SETSLO  /NO, BACK TO TOP
+OKEX,  ISZ     SYS     /BUMP TO REGULAR EXIT
+       JMS     SELECT  /SELECT "A" DRIVES
+SRET,  HLT             /CDF CIF FOR USER'S CALLING FIELD
+       JMP I   SYS     /GONE
+/
+UNIT,  0               /UNIT
+SYS=RXA2
+/
+\f/
+/
+/  LITERALS
+/
+SM15,  -15
+SCDF0, CDF 0
+/
+/  DIVSUB
+/
+/  MUST ENTER WITH LINK AND AC 0
+/  COMPUTES TRACK IN 'QUO', SECTOR IN 'MQ', FROM # IN 'REC'
+/
+/  REPEATED SUBTRACTS OF 13 DECIMAL LEAVE THE HIGH N-1 BITS OF
+/  QUOTIENT IN QUO, THE LOW BIT OF QUOTIENT IN LINK, AND THE
+/  REMAINDER IN AC. THE INTERLEAVE IS ACCOMPLISHED BY SHIFTING
+/  LOW QUOTINET BIT INTO LOW REMAINDER BIT.
+/
+DIVSUB,        0
+       DCA     QUO     /INIT QUOTIENT FOR DIVIDE
+       TAD     REC     /RECORD # MASSAGED IN AC
+DIVLP, SNL             /LINK USAGE REVERSED FROM RICHIE'S CODE
+       ISZ     QUO     /ISZ EVERY OTHER TIME, <=DIVIDE BY 26
+       TAD     SM15    /THE -13 DECIMAL
+       SMA             /SKIP ON DONE
+       JMP     DIVLP   /MORE
+DIVRAL,        RAL             /LINK USAGE REVERSED; INTERLEAVE!!
+       TAD     S33     /ADD 233 (200 IRREL) MAKING SECTOR
+       DCA     MQ
+       JMP I   DIVSUB  /LEAVING LINK AND AC 0
+QUO,   0               /DIVIDE TEMP
+/
+SELECT=.-1             /ENTRY POINT FOR DRIVES SELECT
+       6750            /SELECT APPROPRIATE DRIVES
+       TAD     MAGIC
+       LCD             /INITIALIZE THEM
+       JMP I   SELECT  /DONE
+/
+TRANS=DIVSUB           /TRANSFER COMMAND
+/
+       $
+
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape4/RXCOPY.PA b/sw/os8/v3d/sources/system/dectapes/dectape4/RXCOPY.PA
new file mode 100644 (file)
index 0000000..0186db7
--- /dev/null
@@ -0,0 +1,940 @@
+/ RXCOPY FOR OS/8 V3D AND OS/78 V1A
+/
+/ THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
+/ SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLUSION
+/ OF THE ABOVE SOPYRIGHT NOTICE.  THIS SOFTWARE, OR ANY THEREOF,
+/ MAY NOT BE 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
+/ EQUIPMENT CORPORATION.
+/
+/ DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
+/ SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
+/
+\f
+/
+/ VERSION V4A  M.H.    MAY 20, 1977
+/              S.R.    MAY 20, 1977
+/
+/ START ADDRESS 16000;  JSW 7403
+/
+/ THIS PROGRAM PERFORMS COPY, READ, AND COMPARE OPERATIONS ON
+/ RX FLOPPY DISKS ON A TRACK BY TRACK BASIS.  THE COMMAND FORMAT
+/ IS:   DEV:<DEV:/OPTION   WHERE OPTIONS ARE P, N, M, R, OR V.
+/P     PAUSE BEFORE AND AFTER ACCESSING DISK
+/M     MATCH WITH NO IMPLIED COPY
+/N     COPY WITH NO IMPLIED MATCH
+/R     READ OUTPUT DEVICE WITH NO IMPLIED MATCH OR COPY
+/V     PRINT VERSION NUMBER
+/C     (NOT DOCUMENTED) COPY
+/ IF NO OPTIONS ARE EXPLICITYLY DECLARED, COPY AND MATCH ARE ASSUMED.
+/ IF THE R OPTION IS THE ONLY DISK ACCESSING OPTION SELECTED, THE
+/ FOLLOWING FORMATS WORK: DEV:/R  DEV:</R   <DEV:/R.
+/ 
+\f
+MAGIC=7623             /LOCATION IN RX SYSTEM HANDLER WITH A 7004 IF
+                       /UNIT 0 OR A 7024 IF UNIT 1.  THIS IS ONLY
+                       /ACCESSED IF THE USER USES SYS: IN THE COMMAND
+                       /STRING AND SYS: IS KNOWN TO BE AN RX!!
+OPT1=7643              /1ST COMMAND DECODER OPTION WORD
+OPT2=7644              /2ND COMMAND DECODER OPTION WORD
+BUFF=2000              /INPUT BUFFER FOR TTY MSGS
+DEVTYP=25              /DEVICE CODE FOR FLOPPY DISKS
+BSIZE=6400             /BUFFER SIZE IN OCTAL WORDS
+BSTART=20              /BUFFER START
+BHALF=BSIZE%2          /HALF OF BSIZE
+USR=200                        /ENTRY POINT OF USR
+NOMAT=2000             /NO MATCH OPTION MASK
+COPY=1000              /COPY OPTION MASK
+MMATCH=3777            /CMA OF MATCH OPTION MASK
+MCOPY=6777             /CMA OF COPY OPTION MASK
+MATCH=4000             /MATCH OPTION MASK
+READ=0100              /READ OPTION MASK
+VERSION=0004           /VERSION OPTION MASK
+PAUS=0400              /PAUSE OPTION MASK
+\f
+/      RXCOPY  READ-WRITE SUBROUTINE
+/
+       *6420
+/
+/  READ-WRITE SUBROUTINE TO HANDLE FLOPPY DISK IN 8-BIT MODE
+/  ROUTINE LIVES IN FIELD 0 TO BE CALLED FROM FIELD 10
+/
+/  CALLING SEQUENCE
+/
+/      CIF 0           /ASSUMED CDF 10, CALLED FROM FIELD 10
+/      TAD     TRACK   /TRACK # INTO AC
+/      JMS I   (RW
+/      BITS            /4000 IF FIELD 10 BUFFER, 2 IF READ, 20 IF UNIT 1
+/      OK RETURN       /CDF AND CIF TO 10
+/      ERROR           /SECTOR # IN AC
+/
+/  READS OR WRITES A TRACK AT A TIME. TWO BUFFERS LIVE IN 20-6417
+/  EACH OF FIELD 0 AND 10
+/
+/ USES AUTO-INCREMENT REGISTER 10 OF FIELD 0
+X10=10
+/
+/  AN ALTERNATE ENTRY OF CONTIN (JMP NOT JMS) CAUSES THE
+/  SUBROUTINE TO CONTINUE WORKING ON THE SAME TRACK ON WHICH THE
+/  ERROR OCCURRED.
+/
+/  THREE RETRIES ARE DONE ON A SECTOR BEFORE AN ERROR IS DECLARED.
+/
+SDN=6755
+LCD=6751
+STR=6753
+XDR=6752
+SER=6754
+FLINIT=6757
+/
+/
+/  USE PART OF PAGE AT 6400 TO SPREAD OUT WRITE LOOP
+/  FOR A LITTLE EXTRA SAFETY ON MAKING INTERLEAVE TIMING
+/
+WRIT1, TAD     (-10    /8 TIMES THRU 16 BYTE > 128
+       DCA     WRTCNT
+ST4,   TAD I   X10     /FETCH A BYTE
+       STR             /SKIP IF READY TO TRANSFER
+       JMP     .-1     /NO (SHOULDN'T HIT THIS ON VT78)
+       XDR             /MOVE BYTE TO SILO
+       CLA             /CLEAR THE MUMBLE AC
+       TAD I   X10
+       STR
+       JMP     .-1
+       XDR
+       CLA
+       TAD I   X10
+       STR
+       JMP     .-1
+       XDR
+       CLA
+       TAD I   X10
+       STR
+       JMP     .-1
+       XDR
+       CLA
+       TAD I   X10
+       STR
+       JMP     .-1
+       XDR
+       CLA
+       TAD I   X10
+       STR
+       JMP     .-1
+       XDR
+       CLA
+       TAD I   X10
+       STR
+       JMP     .-1
+       XDR
+       CLA
+       TAD I   X10
+       STR
+       JMP     .-1
+       XDR
+       CLA
+       TAD I   X10
+       STR
+       JMP     .-1
+       XDR
+       CLA
+       TAD I   X10
+       STR
+       JMP     .-1
+       XDR
+       CLA
+       TAD I   X10
+       STR
+       JMP     .-1
+       XDR
+       CLA
+       TAD I   X10
+       STR
+       JMP     .-1
+       XDR
+       CLA
+       TAD I   X10
+       STR
+       JMP     .-1
+       XDR
+       CLA
+       TAD I   X10
+       STR
+       JMP     .-1
+       XDR
+       CLA
+       TAD I   X10
+       STR
+       JMP     .-1
+       XDR
+       CLA
+       TAD I   X10
+       STR
+       JMP     .-1
+       XDR
+       CLA
+       ISZ     WRTCNT  /THRU WITH SILO?
+       JMP     ST4     /NO
+       JMP     WRIT2   /REST OF LOOP ON OTHER PAGE
+/
+WRTCNT,        0               /CONTROL COUNT FOR FILL SILO LOOP
+/
+       PAGE
+/
+\f/
+/  READ-WRITE ENTRY POINT
+/
+/
+RW,    0
+       DCA     TRCKNO  /ARRIVES WITH TRACK # IN AC
+       TAD I   RW      /DATA FIELD 10, FETCH CONTROL BITS
+       TAD     L7100   /FLOPPY CONTROLLER IGNORES TOP 4 BITS; 100
+/                      /BIT IS 8 BIT MODE; CONTROL FOR UNIT, R/W, IN PLACE
+       DCA     FN      /BUFFER BIT (COMPLEMENTED) ALSO STORED IN FN
+       TAD     (17     /SET UP AUTO-INCR REG.
+       DCA     X10
+       TAD     (-32    /26 DECIMAL SECTORS PER TRACK
+       DCA     SECTOR
+       ISZ     RW      /POINT TO OK EXIT
+       TAD     FN      /IF FIELD ZERO BUFFER, NEED TO CDF
+       SPA             /SKIP ON FIELD 10 BUFFER, ALREADY SET!
+       CDF 0
+       RTR             /READ/WRITE BIT TO LINK
+       SZL CLA         /SKIP IF WRITE
+       JMP     READLP  /GO TO READ
+/
+/  WRITE LOOP
+/
+WRITLP,        CLL CLA CMA RTL /LITERAL -3 FOR RETRY COUNT
+       DCA     RETRY
+WRTRY, TAD     FN      /RETRY ERROR HERE THREE TIMES
+       JMS     LDCMD
+       JMP     WRIT1   /OTHER PAGE TO MOVE DATA TO SILO
+WRIT2, JMS     DOIO    /RETURN FROM OTHER PAGE TO ACCESS I/O
+       ISZ     SECTOR
+       JMP     WRITLP
+XT1,   CDF CIF 10
+       JMP I   RW
+/
+/  READ LOOP
+/
+READLP,        CLL CLA CMA RTL /LITERAL -3 FOR RETRY COUNT
+       DCA     RETRY
+RDTRY, JMS     DOIO    /COME HERE TO RETRY I/O
+       TAD     FN
+       JMS     LDCMD
+       TAD     (-40    /32 PASSES THRU 4 BYTES MOVED
+       DCA     FLEA
+ST5,   STR
+       JMP     .-1
+       XDR
+       DCA I   X10
+       STR
+       JMP     .-1
+       XDR
+       DCA I   X10
+       STR
+       JMP     .-1
+       XDR
+       DCA I   X10
+       STR
+       JMP     .-1
+       XDR
+       DCA I   X10
+       ISZ     FLEA
+       JMP     ST5
+       ISZ     SECTOR
+       JMP     READLP
+       JMP     XT1
+/
+/  DO READ OR WRITE I/O FUNCTION
+/
+DOIO,  0
+       TAD     FN      /SILO FUNCTION, CONVERTED TO READ-WRITE
+       TAD     L7004   /BY LITERAL 4 (TOP FOUR BITS IRREL)
+       JMS     LDCMD
+       JMS     GETSEC  /FETCH SECTOR TO AC
+       STR
+       JMP     .-1
+       XDR
+       CLA
+       TAD     TRCKNO
+       STR
+       JMP     .-1
+       XDR
+       CLA
+       TAD     L7530   /UNIT 1, 8-BIT NO-OP (TOP 4 BITS IGNORED)
+       JMS     LDCMD
+       JMP I   DOIO
+/
+/  LOAD COMMAND REGISTER
+/
+FLEA=.
+LDCMD, 0
+       SDN             /SKIP ON DONE
+       JMP     .-1
+       LCD             /LOAD COMMAND
+       SER             /SKIP ON ERROR
+       JMP I   LDCMD
+       ISZ     RETRY   /TRIED THREE TIMES YET
+       JMP     KEEPON  /NO, KEEP ON TRYING
+       JMS     GETSEC  /RETURN SECTOR IN AC
+       ISZ     RW      /ON ERROR, RETURN ONE FURTHER DOWN
+       JMP     XT1     /EXIT TO CALLER WITH SECTOR # IN AC
+/
+/  ENTRY TO CONTINUE AFTER ERROR
+/
+CONTIN,        STA             /BACK UP EXIT TO GOOD EXIT
+       TAD     RW
+       DCA     RW
+       TAD     FN      /SET DATA FIELD TO 0 IF NECESSARY
+       SPA CLA         /ALREADY CDF TO 10, SKIP IF OK
+       CDF 0           /NO, SO SET TO 0
+       JMP I   LDCMD   /PRETEND OPERATION OK, SO RETURN THRU LDCMD!
+/
+KEEPON,        FLINIT          /DO A RECAL TO SHAKE IT UP
+       TAD     FN      /RETRYING READ OR WRITE
+       RTR             /R/W BIT TO LINK
+       SZL CLA         /SKIP ON WRITE
+       JMP     RDTRY   /RETRY A READ
+       TAD     (-200   /BACK UP AUTO INCR TO REFILL SILO FOR WRITE
+       TAD     X10     /SINCE THE FLINIT CLEARED SILO
+       DCA     X10
+       JMP     WRTRY   /SO GO RETRY WRITE
+/
+/  CONVERT COUNT TO SECTOR
+/
+GETSEC,        0
+       TAD     SECTOR  /CONVERT -32 TO -1 TO INTERLEAVED SECTOR
+       TAD     (15
+L7100, CLL             /100 BIT SETS 8-BIT MODE, AS LITERAL
+L7530, SPA SZL         /SZL JUST TO MAKE CORRECT LITERAL, NO-OP WAIT
+       TAD     (15
+       CML RAL
+       IAC
+       JMP I   GETSEC
+L7004, 7004
+/
+/
+/
+TRCKNO,        0               /TRACK NUMBER, INVARIANT THRU CALL
+SECTOR,        0               /COUNTS -32 UP TO 0; 26 DECIMAL SECTORS PER TRACK
+FN,    0               /FUNCTION BITS: ALWAYS 100 FOR 8BIT MODE
+/                      /20 IF UNIT 1
+/                      /2 IF READ OPERATION (2 IS SILO FETCH; 0 SILO FILL)
+/                      /MINUS WORD IF BUFFER IN FIELD 0, PLUS IF FIELD 10
+/                      /CONTROLLER IGNORES TOP 4 BITS OF WORD
+RETRY, 0               /RETRY COUNTER -3 TO 0
+\f      FIELD   1
+       *6000
+/
+/ ***** BEGIN ONCE ONLY CODE *****
+/
+/
+/ ENTER HERE AND GET USER INPUTS
+/
+START, CLA!SKP                 /NORMAL ENTRY (MUST CALL DECODER)
+CHAIN, JMP     NODEC           /CHAIN ENTRY
+       JMS I   (USR            /CALL IT
+       5
+       5200                    /DEFAULT INPUT EXT.(SPECIAL MODE)
+       0                       /PRESERVE TENTATIVE FILES
+/
+/ LOAD CONSOLE TTY HANDLER
+/
+NODEC, JMS I   (USR            /LOAD THE KL8E HANDLER
+       1
+       DEVICE  TTY
+TTYEP, 7201
+       JMP     ERRUSR          /PRINT USER ERROR
+       TAD     TTYEP           /MOVE ENTRY POINT FROM THIS PAGE
+       DCA     TTYENT
+/
+/ LOAD OUTPUT DEVICE IF SPECIFIED
+/
+       JMS     CTRLC           /CHECK FOR CONTROL C TYPE-IN
+       TAD I   (7600           /GET OUTPUT DEV
+       AND     (17
+       DCA     OUTDEV
+       TAD I   (7605           /GET INPUT DEVICE
+       AND     (17
+       DCA     INDEV
+       TAD     OUTDEV          /IF NO OUTPUT DEVICE
+       SZA                     /IS NAMED MOVE INPUT
+       JMP     LOC10           /TO OUTPUT DEVICE
+       TAD     INDEV           /MOVE IT!
+       DCA     OUTDEV
+       DCA     INDEV           /ZERO INPUT DEVICE
+/
+/ VALIDATE OUTPUT DEVICES AND FILES
+/
+LOC10, JMS     CTRLC           /CHECK FOR CONTROL C
+       TAD     (7601           /MAKE SURE THAT THERE ARE NO OUTPUT FILES
+       DCA     TMP1            /OR OTHER OUTPUT DEVICES
+       TAD     (-4
+       DCA     TMP2
+LOC1,  TAD I   TMP1            /GET DECODER ENTRY 
+       SZA!CLA                 /IS IT ZERO?
+       JMP     ERR2            /NO -- ERROR
+       ISZ     TMP1            /INCREMENT POINTER
+       ISZ     TMP2            /YES -- DONE WITH OUTPUT ENTRIES?
+       JMP     LOC1            /NO -- PROCEED
+                               /YES --
+/
+       JMS     CTRLC           /CHECK FOR CONTROL C
+       TAD I   (7605           /WAS THERE ANY INPUT SPECIFICATION?
+       SNA
+       JMP     LOC3A           /NO
+       TAD     (7606           /YES -- MAKE SURE THAT THERE ARE NO INPUT FILES
+       DCA     TMP1            /OR OTHER INPUT DEVICES
+       TAD     (-5
+       DCA     TMP2
+LOC2,  TAD I   TMP1            /GET DECODER ENTRY
+       SZA!CLA                 /IS IT ZERO?
+       JMP     ERR2            /NO -- ERROR
+       ISZ     TMP1            /INCREMENT POINTER
+       ISZ     TMP2            /YES -- DONE WITH INPUT ENTRIES?
+       JMP     LOC2            /NO -- PROCEED
+                               /YES --
+/
+LOC3A, JMS I   (USR            /LOAD RXA0 AND RXA1 SO UNIT NUMBERS CAN
+       1                       /BE FOUND.
+       DEVICE  RXA0
+RX0EP, 200
+       NOP
+       JMS I   (USR
+       1
+       DEVICE  RXA1
+RX1EP, 200
+       NOP
+       JMP     LOC3            /GO TO NEXT PAGE
+/
+OUTDEV,        0                       /OUTPUT DEVICE NUMBER
+INDEV, 0                       /INPUT DEVICE NUMBER
+TMP1,  0                       /TEMP STORE
+TMP2,  0                       /TEMP STORE
+/
+ERR2,  TAD     (MSG2           /ILLEGAL SPECIFICATION
+PERR,  JMS     TYPE            /PRINT ERROR MESSAGE
+       JMP     EXIT            /LEAVE
+/
+ERRUSR,        JMS I   (USR            /PRINT USER ERROR
+       7
+       2
+       JMP     EXIT
+/
+/ SUBROUTINE UNIT -- FIND OUT WHAT THE UNIT NUMBER IS
+/                      ON ENTRY AC HAS DEVICE NUMBER
+/                      ON EXIT AC HAS 0 IFF UNIT 0 OR 0020 IFF UNIT 1
+/
+UNIT,  0
+       DCA     TMP1            /SAVE DEVICE NUMBER
+       CLA!CMA
+       TAD     TMP1            /IS DEVICE SYS:?(I.E. IS DEV NUM=1?)
+       SZA!CLA
+       JMP     UNITNS          /NO
+UNITSY,        CDF     0               /YES -- FIND OUT WHICH UNIT IS SYS:
+       TAD I   (MAGIC          /GUT HOOK RX SYSTEM HANDLER********
+       CDF     10
+       AND     (0020           /IF AC IS 0 ITS UNIT 0
+       JMP I   UNIT
+UNITNS,        TAD     TMP1            /GET INFO ON DEVICE NUMBER
+       JMS I   (USR
+       12
+UNITIN,        0
+       JMP     ERR3            /SAY DEVICE IS NOT RX IF ERROR HERE
+       TAD     UNITIN          /IS DEV SYS: IN DISGUISE?
+       RAL
+       SZL!CLA
+       JMP     UNITSY          /YES -- GO DIG OUT THE UNIT NUM.
+       TAD     UNITIN          /NO -- DOES EP MATCH RXA0'S
+       CMA!IAC
+       TAD     RX0EP
+       SNA!CLA
+       JMP I   UNIT            /YES
+       TAD     UNITIN          /NO -- CHECK RXA1
+       CMA!IAC
+       TAD     RX1EP
+       SZA!CLA
+       JMP     ERR3            /NO -- ERROR
+       TAD     (20             /YES
+       JMP I   UNIT
+\f
+/
+       PAGE
+/
+\f
+/
+/ CHECK THAT REQ'D DEVICES WERE SPECIFIED FOR OPTIONS SELECTED
+/
+LOC3,  JMS     OUTD            /CHECK THAT OUTPUT DEVICE  WAS GIVEN
+       TAD I   (OPT2           /IF COPY OR MATCH, CHECK FOR INPUT DEV
+       AND     (NOMAT!MATCH
+       SZA!CLA
+       JMS     IND
+       TAD I   (OPT2           /IF NOT READ OPTION, CHECK FOR INPUT DEV
+       AND     (READ
+       SNA!CLA
+       JMS     IND
+/
+/ PRINT VERSION IF SELECTED
+/
+VERS,  JMS     CTRLC           /CHECK FOR CONTROL C
+       TAD I   (OPT2           /SHOULD VERSION NUMBER BE PRINTED?
+       AND     (VERSION
+       SNA!CLA
+       JMP     TRANS           /NO -- GO CHECK THAT DEVS ARE RXS
+       TAD     (VERBUF         /YES -- PRINT MESSAGE
+       JMS     TYPE
+/
+/ PREPARE FOR DATA TRANSFER
+/
+TRANS, TAD I   (OPT2           /SET C SWITCH IF COPY REQ'D
+       AND     (MATCH!READ
+       SNA!CLA
+       JMP     TRANSB
+       TAD I   (OPT2
+       AND     (NOMAT
+       SNA!CLA
+       JMP     TRANSA          /DON'T SET C SWITCH
+TRANSB,        TAD I   (OPT1           /SET IT
+       AND     (MCOPY
+       TAD     (COPY
+       DCA I   (OPT1
+TRANSA,        TAD I   (OPT2           /SET M SWITCH IF MATCH REQ'D
+       AND     (NOMAT!READ
+       SZA!CLA
+       JMP     TRANS1
+       TAD I   (OPT2
+       AND     (MMATCH
+       TAD     (MATCH
+       DCA I   (OPT2
+TRANS1,        TAD     OUTDEV          /NO -- CHECK THAT OUTPUT DEV IS RX
+       TAD     (7757           /PREPARE TO GET DEV TYPE FROM TABLE
+       DCA     TMP3
+       TAD I   TMP3
+       AND     (0770
+       RTR!CLL
+       RAR
+       TAD     (-DEVTYP        /WAS DEVICE AN RX?
+       SZA!CLA                 /DOES IT MATCH?
+       JMP     ERR3            /NO -- OUTDEV IS NOT AN RX!!
+       TAD     OUTDEV          /SETUP UNIT NUMBERS
+       JMS     UNIT            /FOR OUPUT DEVICE
+       DCA     WO1
+       TAD     WO1
+       TAD     (4002
+       DCA     RO1
+/
+OUTOK, TAD I   (OPT1           /IF MATCH OR COPY GET INFO ON INDEV
+       AND     (COPY
+       SZA!CLA
+       JMP     OUTOK1
+       TAD I   (OPT2
+       AND     (MATCH
+       SNA!CLA                 /WAS MATCH OR COPY SELECTED?
+       JMP     DORDY           /NO -- OK
+OUTOK1,        TAD     INDEV           /MAKE SURE INPUT DEVICE IS AN RX
+       TAD     (7757           /PREPARE TO ACCESS TABLE
+       DCA     TMP3
+       TAD I   TMP3
+       AND     (0770
+       RTR!CLL
+       RAR
+       TAD     (-DEVTYP
+       SZA!CLA                 /DOES IT MATCH?
+       JMP     ERR3            /NO -- ERROR
+       TAD     INDEV           /SETUP UNIT NUMBERS
+       JMS     UNIT            /FOR INPUT DEVICE
+       TAD     (2
+       DCA     RI1
+DORDY, JMS     QUEST           /PAUSE IF SPECIFIED
+       MSG12
+       JMP     DO              /PROCESS DISKS
+\f
+/
+/ SUBROUTINE IND -- RETURN IF INPUT DEVICE NUMBER IS NON-ZERO
+/
+IND,   0
+       TAD     INDEV           /IF INPUT DEV WAS SPEC'D RETURN
+       SNA!CLA                 /IF NOT DECLARE ERROR
+       JMP     ERR5
+       JMP I   IND
+/
+/ SUBROUTINE OUTD -- RETURN IF OUTPUT DEVICE NUMBER IS NON-ZERO
+/
+OUTD,  0
+       CLA
+       TAD     OUTDEV          /IF OUTPUT DEV WAS SPEC'D RETURN
+       SNA!CLA                 /IF NOT DECLARE ERROR
+       JMP     ERR6
+       JMP I   OUTD
+/
+TMP3,  0                       /TEMP STORE
+TMP4,  0                       /TEMP STORE
+/
+ERR3,  TAD     (MSG3
+       JMP     PERR
+ERR5,  TAD     (MSG5
+       JMP     PERR
+ERR6,  TAD     (MSG6
+       JMP     PERR
+\f
+/
+       PAGE
+/
+\f
+DO,    JMS I   (USR            /UNLOCK USR FROM CORE
+       11
+       TAD     (-115           /INIT COUNTER TO -77 DECIMAL
+       DCA     CNT
+       DCA     TRACK           /INIT TRACK NUMBER TO 0
+       JMP     DO1
+/
+/ ****** END OF ONCE ONLY CODE ******
+/
+       *6420
+/
+/ WAS COPY SELECTED?
+/
+DO1,   TAD I   (OPT1           /SHOULD WE COPY?
+       AND     (COPY
+       SNA!CLA
+       JMP     DO2             /NO
+       JMS     RI              /YES -- READ INPUT DEVICE INTO FIELD 0
+       JMS     WO              /WRITE OUTPUT DEVICE FROM FIELD 0
+/
+/ WAS READ SELECTED?
+/
+DO2,   TAD I   (OPT2           /SHOULD WE READ?
+       AND     (READ
+       SNA!CLA
+       JMP     DO3             /NO -- CHECK MATCH
+       IAC                     /YES -- READ OUTPUT DEVICE INTO FIELD 1
+       JMS     RO
+/
+/ WAS MATCH SELECTED?
+/
+DO3,   TAD I   (OPT2           /SHOULD WE MATCH?
+       AND     (MATCH
+       SNA!CLA
+       JMP     DO5             /NO
+       TAD I   (OPT1           /YES -- WAS THERE A COPY?
+       AND     (COPY
+       SNA!CLA
+       JMS     RI              /NO -- READ INPUT DEVICE INTO FILED 0
+       TAD I   (OPT2           /YES -- WAS THERE A READ?
+       AND     (READ
+       SZA!CLA
+       JMP     DO4             /YES
+       IAC                     /NO -- READ OUTDEV TO FIELD 1
+       JMS     RO
+/
+/ COMPARE BUFFERS
+/
+DO4,   TAD     (BSTART
+       DCA     PTR             /INIT BUFFER POINTER
+       TAD     (-BSIZE         /SETUP WD IN BUFFER COUNTER
+       DCA     WDCNT
+DO4A,  TAD I   PTR             /GET A WD FROM FIELD 1
+       DCA     TMP5            /SAVE
+       CDF     0               /GET A WD FROM FIELD 0
+       TAD I   PTR
+       CDF     10
+       CMA!IAC                 /NEGATE
+       TAD     TMP5            /DID WDS MATCH?
+       SZA!CLA                 /SKIP IF SO
+       JMS     ERR7            /NO -- ERROR (BUT NOT FATAL)
+       ISZ     PTR             /YES -- INCREMENT POINTER
+       ISZ     WDCNT           /DONE WITH BUFFER?
+       JMP     DO4A            /NO -- PROCEED
+                               /YES --
+/
+/ TEST FOR END OF DISK
+/
+DO5,   ISZ     TRACK           /INCREMENT TRACK
+       ISZ     CNT             /DONE?
+       JMP     DO1             /NO
+       JMP     EXITOK          /YES
+TMP5,  0                       /TEMP STORE
+CNT,   0                       /ISZ COUNTER OF TRACKS
+TRACK, 0                       /TRACK NUMBER
+PTR,   0                       /WORD IN BUFFER POINTER
+WDCNT, 0                       /BUFFER WORD COUNTER
+/
+/ SUBROUTINE QUEST -- PRINT MSG AND ASK QUESTION
+/                      ASK IT ONLY IF /P WAS SPECIFIED
+/                      JMS+1 HAS MSG TO ASK
+/                      RETURN ONLY WHEN ANSWER IS YES
+/
+QUEST, 0
+       TAD I   (OPT2           /WAS /P SPECIFIED?
+       AND     (PAUS
+       SNA!CLA
+       JMP     Q2              /NO -- RETURN
+Q1,    TAD I   QUEST           /YES -- GET MESG ADDR
+       JMS     TYPE            /PRINT IT
+       TAD     (BUFF           /SELECT INPUT BUFFER
+       JMS     RDANS           /READ ANSWER
+       TAD I   (BUFF           /WAS IT "Y"?
+       AND     (77
+       TAD     (-31
+       SZA!CLA
+       JMP     Q1              /NO -- ASK AGAIN
+Q2,    ISZ     QUEST           /YES -- RETURN AT JMS+2
+       JMP I   QUEST
+/
+/ SUBROUTINE CTRLC -- CHECK FOR CONTROL C
+/
+CTRLC, 0
+       KRS
+       AND     (177
+       TAD     (-3
+       SNA!CLA
+       KSF
+       JMP I   CTRLC
+       JMP     EXIT
+/
+/ EXIT PROGRAM
+/
+EXITOK,        JMS     QUEST
+       MSG11
+EXIT,  CIF!CDF 0
+       JMP I   (7605
+\f
+/
+       PAGE
+/
+\f
+/
+/ SUBROUTINE RI -- READ FROM INPUT DEVICE
+/
+RI,    0                       /READ FROM INPUT DEVICE
+       JMS     CTRLC           /CHECK FOR CONTROL C
+       TAD     TRACK           /GET TRACK NUMBER INTO AC
+       CIF     0               /PREPARE TO ENTRY DRIVER
+       JMS I   (RW             /CALL DRIVER
+RI1,   0                       /FUNCTION WORD
+       JMP I   RI              /EXIT -- SUCCESSFUL
+       JMS     ERR8            /ERROR
+       JMS     CTRLC           /CHECK FOR CONTROL C
+       CIF     0
+       JMP I   (CONTIN         /PROCEED
+/
+/ SUBROUTINE RO -- READ FROM OUTPUT DEVICE
+/
+RO,    0                       /READ FROM OUTDEV
+       JMS     CTRLC           /CHECK FOR CONTROL C
+       TAD     TRACK
+       CIF     0
+       JMS I   (RW
+RO1,   0
+       JMP I   RO
+       JMS     ERR9
+       JMS     CTRLC
+       CIF     0
+       JMP I   (CONTIN
+\f
+/
+/ SUBROUTINE WO -- WRITE OUTPUT DEVICE
+/
+WO,    0                       /WRITE TO OUTPUT DEVICE
+       JMS     CTRLC
+       TAD     TRACK
+       CIF     0
+       JMS I   (RW
+WO1,   0
+       JMP I   WO
+       JMS     ERR10
+       JMS     CTRLC
+       CIF     0
+       JMP I   (CONTIN
+\f/
+/ MISC ERROR ROUTINES
+/
+ERR7,  0
+       TAD     (-BSTART        /SUBTRACK BUFFER START
+       TAD     PTR             /FROM WORD IN BUFFER POINTER
+       TAD     (-BHALF         /THEN SUBTRACT 1/2 OF BUFFER SIZE
+       SPA                     /SKIP IF PTR IN 2ND HALF
+       JMP     ERR7A           /PTR IN 1ST HALF
+       AND     (7600           /DIVIDE BY 64 DECIMAL AND ADD 2
+       CLL!RTR
+       RTR
+       RTR
+       IAC
+       JMP     ERR7W
+ERR7A, TAD     (BHALF          /MAKE POSITIVE
+       AND     (7600           /DIVIDE BY 64 AND ADD 1
+       CLL!RTR
+       RTR
+       RTR
+ERR7W, IAC
+       DCA     ERRTMP          /SAVE SECTOR NUMBER
+       TAD     TRACK           /WAS THERE ANOTHER MISMATCH ON THIS SECTOR?
+       TAD     ERR7TR
+       SZA!CLA
+       JMP     ERR7P           /NO
+       TAD     ERRTMP          /MAYBE
+       TAD     ERR7SC
+       SNA!CLA
+       JMP I   ERR7            /YES
+ERR7P, TAD     (MSG7
+       JMS     TYPE
+       TAD     ERRTMP
+       JMS     ADPRNT
+       TAD     TRACK           /SAVE TRACK AND SECTOR
+       CMA!IAC                 /AS 2'S COMP FOR FUTURE COMPARISION
+       DCA     ERR7TR
+       TAD     ERRTMP
+       CMA!IAC
+       DCA     ERR7SC
+       JMP I   ERR7
+ERR7TR,        400
+ERR7SC,        400
+ERR8,  0
+       DCA     ERRTMP
+       TAD     (MSG8
+       JMS     TYPE
+       TAD     ERRTMP
+       JMS     ADPRNT
+       JMP I   ERR8
+ERR9,  0
+       DCA     ERRTMP
+       TAD     (MSG9
+       JMS     TYPE
+       TAD     ERRTMP
+       JMS     ADPRNT
+       JMP I   ERR9
+ERR10, 0
+       DCA     ERRTMP
+       TAD     (MSG10
+       JMS     TYPE
+       TAD     ERRTMP
+       JMS     ADPRNT
+       JMP I   ERR10
+/
+ERRTMP,        0
+/
+\f
+/
+/ SUBROUTINE TYPE -- PRINT MESSAGE
+/                      ON ENTRY AC HAS MESSAGE ADDRESS
+/
+TYPE,  0
+       DCA     TYPAD           /SAVE ADDR
+       CIF     0
+       JMS I   TTYENT
+       4110
+TYPAD, 0
+       0
+       NOP
+       JMP I   TYPE
+/
+/ SUBROUTINE RDANS -- READ ANSWER FROM TTY
+/                      ON ENTRY AC HAS BUFFER ADDR
+/
+RDANS, 0
+       DCA     RDAD            /SAVE ADDR
+       CIF     0
+       JMS I   TTYENT
+       0110
+RDAD,  0
+       0
+       NOP
+       JMP I   RDANS
+/
+TTYENT,        0                       /ENTRY POINT TO TTY HANDLER
+/
+\f
+/
+       PAGE
+/
+\f/
+/ SUBROUTINE APRNT -- PRINT TRACK AND SECTOR
+/                      ENTER WITH SECTOR IN AC
+/
+ADPRNT,        0
+       JMS     SETIN
+       MSG13B-1
+       TAD I   TRACKN
+       JMS     SETIN
+       MSG13A-1
+       TAD     MSG
+       JMS I   TYPEIT
+       JMP I   ADPRNT
+TYPEIT,        TYPE
+TRACKN,        TRACK
+MSG,   MSG13
+\f
+/
+/ SUBROUTINE SETIN -- ENTER NUMBER INTO A MESSAGE
+/
+/      ON ENTRY AC HAS NUMBER AND JMS+1 HAS POINTER TO MESSAGE
+/      HOLE MINUS 1. (2 DECIMAL DIGIT NUMBERS ARE ASSUMED)
+/
+SETIN, 0
+       DCA     SETIN1          /SAVE NUMBER
+       DCA     SETCNT          /ZERO 10'S COUNTER
+       TAD I   SETIN           /GET MSG ADDR
+       DCA     10              /ENTER INTO AUTOINC POINTER
+       ISZ     SETIN           /BUMP RETURN ADDR
+SETINB,        TAD     SETIN1          /GET NUMBER
+       TAD     M12             /SUBTRACT 10 DECIMAL
+       SMA                     /DONE DIVIDING?
+       JMP     SETINA          /NO
+       CLA                     /YES
+       TAD     SETCNT          /GET 10'S
+       TAD     P260            /MAKE IT ASCII
+       DCA I   10              /STORE IN MESSAGE
+       TAD     SETIN1          /GET REMAINDER
+       TAD     P260            /MAKE IT ASCII
+       DCA I   10              /STORE IN MESSAGE
+       JMP I   SETIN
+SETINA,        DCA     SETIN1          /SAVE RESULT
+       ISZ     SETCNT          /INCREMENT 10'S COUNT
+       JMP     SETINB          /CONTINUE
+/
+SETIN1,        0                       /NUMBER STORAGE
+SETCNT,        0                       /10'S COUNTER
+M12,   -12                     /MINUS 10 DECIMAL
+P7,    7                       /LITERAL
+P260,  260                     /LITERAL
+\f
+/ 
+/ ERROR MESSAGES
+/
+VERBUF,        "R; "X; "C; "O; "P; "Y; 240; "V; "4; "A; 240; 215; 212; 232
+MSG2,  "I; "L; "L; "E; "G; "A; "L; 240; "S; "P; "E; "C; "I; "F; "I
+       "C; "A; "T; "I; "O; "N; 215; 212; 232
+MSG3,  "D; "E; "V; "I; "C; "E; 240; "I; "S; 240; "N; "O; "T; 240
+       "R; "X; 215; 212; 232
+MSG5,  "N; "O; 240; "I; "N; "P; "U; "T; 240; "D; "E; "V; "I; "C;
+       "E; 215; 212; 232
+MSG6,  "N; "O; 240; "O; "U; "T; "P; "U; "T; 240
+       "D; "E; "V; "I; "C; "E; 215; 212; 232
+MSG7,  "C; "O; "M; "P; "A; "R; "E; 240
+       "E; "R; "R; "O; "R; 232
+MSG8,  "I; "N; "P; "U; "T; 240; "D; "E; "V; "I; "C; "E; 240
+       "R; "E; "A; "D; 240; "E; "R; "R; "O; "R; 232
+MSG9,  "O; "U; "T; "P; "U; "T; 240; "D; "E; "V; "I; "C; "E; 240
+       "R; "E; "A; "D; 240; "E; "R; "R; "O; "R; 232
+MSG10, "O; "U; "T; "P; "U; "T; 240; "D; "E; "V; "I; "C; "E; 240
+       "W; "R; "I; "T; "E; 240; "E; "R; "R; "O; "R; 232
+MSG11, "I; "S; 240; "M; "O; "N; "I; "T; "O; "R; 240
+       "R; "E; "M; "O; "U; "N; "T; "E; "D
+       "?; 232
+MSG12, "R; "E; "A; "D; "Y; "?; 232
+MSG13, 240; "T; "R; "A; "C; "K; 240
+MSG13A,        0
+       0
+       ",; "S; "E; "C; "T; "O; "R; 240
+MSG13B,        0
+       0
+       215; 212; 232
+$
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape4/TDFRMT.PA b/sw/os8/v3d/sources/system/dectapes/dectape4/TDFRMT.PA
new file mode 100644 (file)
index 0000000..07b9d1b
--- /dev/null
@@ -0,0 +1,2041 @@
+/TD8E FORMATTER V4
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1971, 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.
+/
+/
+/
+/
+/
+/
+\f
+
+/TD8E DECTAPE FORMATTER COPYRIGHT 1971
+/DIGITAL EQUIPMENT CORP.
+/MAYNARD , MASS
+
+
+
+
+
+       X1=10
+       X2=11
+
+/SYMBOL TABLE AUGMENTATION
+
+       SDSS=6771
+       SDST=6772
+       SDSQ=6773
+       SDLC=6774
+       SDLD=6775
+       SDRC=6776
+       SDRD=6777
+
+
+       *0
+       0
+       JMP     1       /HLT PROGRAM GOT INTERRUPTED SOMEHOW
+       2               
+       3
+       0
+       0
+
+/WORKING LOCATIONS
+
+       *20
+
+W1,    0000
+W2,    0000
+W3,    0000
+W4,    0000
+W5,    0000
+W6,    0000
+BLOCKS,        0000
+DTA,   0000
+PHASE, 0000
+TOTAL, 0000
+VAR1,  0000
+VAR2,  0000
+/CONSTANTS
+
+C0017, 0017
+C0070, 0070
+C0077, 0077
+C0007, 0007
+C0700, 0700
+C203,  0203
+C201,  0201
+C260,  0260
+C261,  0261
+C270,  0270
+C271,  0271
+C277,  0277
+C1620, 1620
+C7000, 7000
+C7700, 7700
+C7714, 7714
+C7761, 7761
+CRCOD, 0215
+LETK,  0313
+LFCOD, 0212
+M2,    -2
+M3,    -3
+M6,    -6
+M7,    -7
+M14,   -14
+M144,  -144
+SPCOD, 0240
+
+BADD,  BUFFER-1
+BFR,   BUFFER
+COMPAR,        COMPRE
+IT,    INIT1
+QU1,   Q1
+QU2,   Q2
+QU3,   Q3
+QU4,   Q4
+MESS,  MES
+STX,   START
+TYOCT, TYCT
+TYPE,  MESAGE
+TYPIN, TYPN
+WAIT,  STALL
+WC,    0
+MTR,   0
+SLRDRC,        SRDRC
+DATRD, 0
+M55,   -55
+M25,   -25
+M26,   -26
+M32,   -32
+M10,   -10
+M70,   -70
+M73,   -73
+M51,   -51
+M45,   -45
+M22,   -22
+M143,  -143
+M52,   -52
+M31,   -31
+M306,  -306
+CNT,   0
+M4,    -4
+M307,  -307
+SSDSQT,        SDSQT
+SA3LNS,        A3LNS
+SCEXPC,        CEXPC
+MSK77, 0077
+NUD,   NUDTA
+BLK,   0
+REVBLK,        0
+BCXOR, SBCXOR
+CHKSUM,        0
+SBWORD,        0
+
+
+
+/TYPE THE CHARACTER IN THE AC ON THE KEYBOARD PRINTER
+
+RSEND, 0000
+       TLS             /LOAD AND PRINT, CLEAR FLAG
+       TSF             /WAIT FOR CONFIRMATION
+       JMP   .-1       /ENDLESSLY
+       TCF             /CLEAR THE FLAG ANYWAY
+       JMP I RSEND
+
+
+/PRINT A "?" ON THE KEYBOARD TYPER
+
+QU,    .+1
+       IOF
+       CLA   CLL       /C(AC)+C(L)=0
+       TAD   C277      /"?"
+       JMS   RSEND     /TYPE THE CHARACTER
+       JMP I .+1       /RESTART
+       INIT
+
+/DECTAPE CONTROL WORDS
+
+DT1400,        1400
+DT0400,        0400
+DT2000,        2000
+DT3000,        3000
+DT1000,        1000
+
+BINCO, BINCON
+SELTIM,        ZTIM
+MARKER,        ZMKTK
+BLKERR,        ZBLK
+DATERR,        ZDATA
+CHKERR,        ZPAR
+DOMARK,        STMK
+DBUFPT,        0       /POINTER TO CURRENT POSITION IN DTA LIST
+
+
+
+*200   /PAGE 1
+/TYPE CANNED MESSAGES.....
+/THANKS TO DIGITAL 8-18-U
+       JMP  I  .+1
+       PATCH
+
+MESAGE,        0
+       IOF
+       CLA   CMA       /SET C(AC)=-1
+       TAD   MESAGE    /ADD LOCATION
+       DCA   10        /AUTO INDEX REGISTER
+       TAD I 10        /FETCH FIRST WORD
+       DCA   MSRGHT    /SAVE IT
+       TAD   MSRGHT
+       RTR
+       RTR             /ROTATE 6 BITS TO THE RIGHT
+       RTR
+       JMS   TYPECH    /TYPE IT
+       TAD   MSRGHT    /GET DATA AGAIN
+       JMS   TYPECH    /TYPE RIGHT HALF
+       JMP   MESAGE+5  /CONTINUE
+MSRGHT,        0               /TEMPORARY STORAGE
+TYPECH,        0               /TYPE CHARACTER IN C(AC)6-11
+       AND   C0077
+       SNA             /IS IT END OF MESSAGE?
+       JMP I 10        /YES: EXIT
+       TAD   M40       /SUBTRACT 40
+       SMA             /<40?
+       JMP   .+3       /NO
+       TAD   C340      /YES: ADD 300
+       JMP   MTP       /TO CODES <40
+       TAD   M3        /SUBTRACT 3
+       SZA             /IS IT ZERO?
+       JMP   .+3       /NO
+       TAD   C212      /YES: CODE 43 IS
+       JMP   MTP       /LINE-FEED (212)
+       TAD   M2        /SUBTRACT 2
+       SZA             /IS IT ZERO?
+       JMP   .+3       /NO
+       TAD   C215      /YES: CODE 45 IS
+       JMP   MTP       /CARRIAGE RETURN (215)
+       TAD   C245      /ADD 200 TO OTHERS >40
+MTP,   TLS             /TRANSMIT CHARACTER
+       TSF             /WAIT FOR THE FLAG
+       JMP   .-1       /NOT SET YET
+       CLA             /SET: CLEAR C(AC)
+       JMP I TYPECH    /RETURN
+
+/CONSTANTS
+
+M40,   -40
+C340,  340
+C212,  212
+C215,  215
+C245,  245
+/ROUTINE WAITS UNTILL A COMPLETE MESSAGE HAS BEEN ENTERED
+/SIGNIFIED BY A CR.
+
+TYPN,  0
+       IOF
+       KCC             /CLEAR AC, KEYBOARD FLAG
+       TAD   BADD      /GET BUFFER ADDRESS
+       DCA   W1        /STORE FOR THE CHARACTER STRING
+
+/READ AND RESPOND WITH THE CHARACTER
+
+NTYRTN,        ISZ   W1        /NORMAL RETURN. INCREMENT BUFFER
+       KSF             /WAIT FOR KEYBOARD
+       JMP   .-1       /FLAG TO RAISE
+       KRB             /GOT FLAG, RESET IT, GET CHARACTER
+       JMS   RSEND     /SEND CHARACTER BACK
+       AND     (177    /TAKE CARE OF PARITY
+       TAD     (200
+       DCA I W1        /LOAD CHARACTER INTO BUFFER AREA
+       TAD I   W1      /CHECK FOR CTRL C
+       CIA
+       TAD     C203
+       SZA     CLA
+       JMP     CHKSP   /NO- CHECK FOR SPACE
+       6007            /CAF- CLEAR ALL FLAGS
+       NOP             /JUST IN CASE
+       CLA
+       JMP     7605
+
+/IF CHARACTER IS A SPACE, IGNORE IT
+
+CHKSP, TAD I W1        /CHARACTER INTO THE AC
+       CIA             /SUBTRACT FROM SPACE CODE (240)
+       TAD   SPCOD     /COMPLETE COMPARISON
+       SNA   CLA       /WAS IT A SPACE?
+       JMP   NTYRTN+1  /YES: DO NOT INCREMENT BUFFER
+
+/IF CHARACTER IS A CR, EXIT FROM ROUTINE
+
+       TAD I W1        /CHARACTER TO AC
+       CIA             /SET AC TO SUBTRACT CR (215)
+       TAD   CRCOD     /COMPLETE COMPARISON
+       SZA   CLA       /WAS IT CR?
+       JMP   NTYRTN    /NO: INCREMENT BUFFER + WAIT
+
+/CARRIAGE RETURN FOUND, EXIT FROM ROUTINE
+
+       TAD   LFCOD     /GIVE KEYBOARD LINE FEED
+       JMS   RSEND     /EXECUTE LINE FEED
+       CLA   CLL       /EXIT WITH C(ACC) + AND C(L)=0
+       IOF             
+       JMP I TYPN      /RETURN TO CALL
+\f
+/COMPARE A STRING OF CHARACTERS IN "BUFFER"
+/TO A CHARACTER STRING AFTER A JMS IN ASCII
+
+COMPRE,        0
+       CLA   CMA       /C(AC)=7777
+       TAD   COMPRE    /SUBTRACT 1 FOR INDEX REG 1
+       DCA   10        /AUTO INDEX 1 SET TO CHA STRING
+       TAD   BADD      /AUTO INDEX 2 SET TO BUFFER-1
+       DCA   11        /LOAD X2
+
+/COMPARE CHARACTERS TILL ONE DOESN'T COMPARE OR TILL
+/A 0 IS FOUND IN X1. IF OK, RETURN TO TWO PLUS THE
+/ZERO, IF BAD ONE PLUS
+
+       TAD I X1        /CHARACTER FROM PROGRAM
+       CIA             /TO SUBTRACT FROM
+       TAD I X2        /CHARACTER IN BUFFER
+       SZA   CLA       /COMPARE?
+       JMP   CERR      /NO:RESYNC FOR NON COMPARE EXIT
+       TAD I X1        /YES: CHECK FOR GOOD EXIT
+       SZA             /IF 0, EXIT GOOD
+       JMP   .-6       /NO: TEST NEXT CHAACTER
+       ISZ   X1        /+1 TO X1(TOTAL 2 FROM THE 0)
+       JMP I X1        /+1 TO X1, EXIT
+
+/ERROR FOUND. RESYNC AND EXIT NO COMPARE
+
+CERR,  TAD I X1        /CHARACTER FROM PROGRAM
+       SZA   CLA       /IS THIS EXIT KEY? (0000)
+       JMP   .-2       /NO: GET NEXT
+       JMP I X1        /YES: EXIT, NOT COMPARE
+\f
+*400
+/VARIOUS ERROR MESSAGES
+/"NOT DECIMAL"
+
+Q1,    JMS I TYPE
+       1617  /NO
+       2440  /T
+       0405  /DE
+       0311  /CI
+       1501  /MA
+       1400  /L
+       JMP   QUX
+
+/"TO MANY WORDS"
+
+Q2,    JMS I TYPE
+       2417  /TO
+       1740    /O 
+       1501    /MA
+       1631    /NY
+       4027    / W
+       1722    /OR
+       0423    /DS
+       0000    /00
+       JMP   QUX
+
+/"TO MANY BLOCKS"
+
+Q3,    JMS I TYPE
+       2417  /TO
+       1740    /O 
+       1501    /MA
+       1631    /NY
+       4002    / B
+       1417    /LO
+       0313    /CK
+       2300    /S0
+       JMP   QUX
+
+/"NOT DIVISIBLE BY 3"
+Q4,    JMS I TYPE
+       1617  /NO
+       2440  /T
+       0411  /DI
+       2611  /VI
+       2311  /SI
+       0214  /BL
+       0540  /E
+       0231  /BY
+       4063  / 3
+       0000  /00
+QUX,   JMS I TYPE
+       4345  /CR+LF
+       0000  /END
+       JMP I .+1
+       INIT
+/THE CODING BELOW CREATES THE BLOCK NUMBER
+/CONVERSION PRIOR TO THE TAPE WRITE.
+
+MES,   0
+       DCA     W4      /SAVE WORD
+       CLL
+       TAD     W4
+       CMA     RTR
+       RTR
+       AND     C7000
+       DCA     V1
+       TAD     W4
+       CMA     RTL
+       RAL
+       AND     C0700
+       DCA     V2
+       TAD     W4
+       CMA     RTR
+       RAR
+       AND     C0070
+       DCA     V3
+       TAD     W4
+       CMA     RTL
+       RTL
+       AND     C0007
+       TAD     V1
+       TAD     V2
+       TAD     V3
+       JMP  I  MES
+
+V1,    0000
+V2,    0000
+       7777
+       7700
+       0000
+V3,    0000
+       0000
+
+PATCH, CLA
+       TAD     .+4
+       DCA     1
+       JMP  I  .+1
+       START
+       HLT
+/TYPE ONE FOUR CHARACTER OCTAL WORD GIVEN TO THE 
+/ROUTINE VIA C(ACC). C(ACC)=0 ON EXIT
+
+TYCT,  0
+       DCA   TW1       /STORE WORD GIVEN
+       TAD   TW1       /TO C(ACC) AGAIN
+       RTR
+       RTR             /6 BITS RIGHT
+       RTR
+       DCA   TYCT1+2   /SAVE ROTATED VALUE, 1ST TWO
+       TAD   TYCT1+2   /TO C(ACC) AGAIN
+       AND   C0007     /ISOLATE SECOND CHARACTER
+       TAD   C6060     /CONVERT TO ASCII
+       DCA   TYCT1+1   /STORE AS FIRST PARTIAL 2
+       TAD   TYCT1+2   /ROTATED VALUE STORED ABOVE
+       RTL
+       RAL             /3 BITS LEFT
+       AND   C0700     /ISOLATE FIRST CHARACTER
+       TAD   TYCT1+1   /CONVERT 1ST TO ASCII
+       DCA   TYCT1+1   /1ST AND 2ND CHARACTERS READY
+       TAD   TW1       /ORIGIONAL WORD
+       AND   C0007     /ISOLATE 4TH CHARACTER
+       TAD   C6060     /CONVERT 4 TH TO ASCII
+       DCA   TYCT1+2   /STORE 4TH FOR A MOMENT
+       TAD   TW1       /ORIGIONAL WORD
+       RTL
+       RAL             /POSITION IT 3RD CHARACTER
+       AND   C0700     /ISOLATE 3RD CHARACTER
+       TAD   TYCT1+2   /CONVERT TO ASCII
+       DCA   TYCT1+2   /CONVERSION COMPLETE
+TYCT1, JMS I TYPE      /TYPE THE FOUR CHARACTERS
+       0               /FIRST 2
+       0               /SECOND 2
+       0               /KILL KEY
+       JMP I TYCT      /EXIT FROM ROUTINE
+
+/SOME CONSTANTS FOR THE ROUTINE
+
+TW1,   0000
+C6060, 6060
+\f
+*600
+
+STALL, 0
+       CLA
+       TAD I 12        /WORD TO BE WRITTEN
+       SDSQ            /WAIT FOR QUADLINE FLAG
+       JMP .-1
+       SDLD            /LOAD DATA REGISTERS
+       SDST            /CHECK FOR TIMING ERROR
+       SKP
+       JMS  I  SELTIM          /TIMING ERROR
+       CLA
+       JMP I STALL     /GO GET NEXT WORD
+
+
+
+/WAIT TILL WORD COUNT REGISTER GOES TO ZERO
+
+/BLOCK NUMBER ERROR
+ZBLK,  0
+       CLA
+       TAD     DTA
+       SDLC            /STOP MOVEMENT OF TAPE
+       JMS  I  TYPE
+       2003            /PC
+       4000            /END
+       CLA     CMA
+       TAD     ZBLK
+       JMS  I  TYOCT
+       JMS  I  TYPE
+       4040            /DOUBLE SPACE
+       0214            /BL
+       1703            /OC
+       1340            /K
+       1625            /NU
+       1502            /MB
+       0522            /ER
+       4000            /END
+       JMP     ZCOM
+
+       /DATA ERRORS
+ZDATA, 0
+       CLA
+       TAD     DTA
+       SDLC            /STOP THE TAPE
+       JMS  I  TYPE
+       2003
+       4000
+       CLA     CMA
+       TAD     ZDATA
+       JMS  I  TYOCT
+       JMS  I  TYPE
+       4040
+       0401            /DA
+       2401            /TA
+       4000            /END
+       JMP     ZCOM
+
+/MARK TRACK ERROR
+
+ZMKTK, 0
+       CLA
+       TAD     DTA
+       SDLC            /STOP THE TAPE
+       JMS  I  TYPE
+       2003            /PC
+       4000            /END
+       CLA     CMA
+       TAD     ZMKTK
+       JMS  I  TYOCT
+       JMS I TYPE
+       4040
+       1501   /MA
+       2213   /RK
+       4024   / T
+       2201   /RA
+       0313   /CK
+       4000   / 0
+       JMP   ZCOM
+/PARITY ERROR
+
+ZPAR,  0
+       CLA
+       TAD     DTA
+       SDLC            /STOP THE TAPE
+       JMS  I  TYPE
+       2003            /PC
+       4000            /END
+       CLA     CMA
+       TAD     ZPAR
+       JMS  I  TYOCT
+       JMS I TYPE
+       4040
+       0310            /CH
+       0503            /EC
+       1323            /KS
+       2515            /UM
+       4000            /0
+       JMP   ZCOM
+
+
+/TIMING ERROR
+
+ZTIM,  0
+       CLA
+       TAD     DTA
+       SDLC            /STOP THE TAPE
+       JMS  I  TYPE
+       2003
+       4000
+       CLA     CMA
+       TAD     ZTIM
+       JMS  I  TYOCT
+       JMS  I  TYPE
+       4040
+       2411   /TI
+       1511   /MI
+       1607   /NG
+       4000   / 0
+
+/TYPE "ERROR PHASE X"
+
+ZCOM,  TAD   PHASE     /WHAT PHASE OF OPERATION
+       TAD   PFORM     /WAS THE MACHINE IN
+       DCA   TFORM     /WHEN ERROR OCCURED
+       JMS I TYPE
+       0522   /ER
+       2217   /RO
+       2240   /R 
+       2010   /PH
+       0123   /AS
+       0540   /E
+TFORM, 4060   / X
+       4543   /CR+LF
+       0000   /END
+       JMP  I  .+1
+       RETRY
+PFORM, 4060
+
+
+\f
+/HERE STARTS THIS PROGRAM. IT WILL ASK THE
+/OPERATOR FOR  DRIVE NUMBERS, THEN ASK HIM FOR
+/A DIRECTION ON WHAT TO DO WITH THE DRIVES.
+
+/THE SEQUENCE FOR MARKING A TAPE WOULD APPEAR AS:
+
+
+/UNIT? (0 OR 1 OR 0 1)
+/FORMAT? (MARK 1215)
+/2277 WORDS, 0256 BLOCKS.OK? YES OR NO
+/(YES)
+
+
+/THAT DATA IN PARENTHESIS IS TYPED BY THE OPERATOR
+/(HE DOESN'T TYPE THE PARENTHESIS)
+/IF HE HAD ANSWERED NO, "FORMAT?" WOULD BE TYPED OUT.
+/IF THE DRIVE WAS WRONG, HE WOULD TYPE RESTART.
+/IF HE HAD TYPED "MARK" IN RESPONSE TO "FORMAT?" THE
+/TAPE WOULD BE MARKED WITH THE STANDARD PDP-8 CONFIGURATION.
+/IF HE HAD TYPED "MARK 384" THE TAPE WOULD
+/BE MARKED WITH THE STANDARD PDP-10 CONFIGURATION
+/NOTE: THE WORD AND BLOCK NUMBERS ARE TYPED IN OCTAL
+/IF A MISTAKE OCCURS ON THE OPERATORS PART (WITH REFERANCE
+/TO BLOCK + WORD SIZE) HE WILL BE TOLD ABOUT IT
+
+
+
+
+
+*1000
+
+/MAKE A CALL FOR THE DECTAPE NUMBERS TO BE
+/WORKED.
+
+STAR0, JMS I   TYPE    /TYPE VERSION NUMBER
+       4543            /CR+LF
+       4300            /LF+0
+       JMS I   TYPE
+       TEXT    /TDFMT V4A/
+START, JMS I TYPE      /SET UP TYPER
+       4543  /CR+LF
+       4300  /LF+END
+
+TYQU,  JMS I TYPE      /"UNIT?"
+       2516    /UN
+       1124    /IT
+       7740    /?
+       0000    /END
+
+/WAIT FOR A REPLY
+
+       JMS I TYPIN     /GET NUMBERS
+       TAD     BADD    /INITIALIZE POINTER (BFR)
+       IAC             /(BADD=BUFFER-1, SO BUMP THE AC)
+       DCA     BFR     /TO START OF INPUT BUFFER
+       DCA     DCTR    /INITIALIZE DTA COUNTER TO 0
+       DCA     CRFLAG  /CLEAR FLAG SO CR NOT ACCEPTIBLE
+CRCHK, TAD     CRCOD   /GET CODE FOR CAR. RETN
+       CIA             /NEGATE IT
+       TAD I   BFR     /SEE IF NEXT CHAR. IN
+       SNA             /BUFFER IS CAR. RETN.
+       JMP     OKCR    /YES: SEE IF C.R. LEGAL HERE
+       DCA     CRFLAG  /NO: SO C.R. IS LEGAL NOW
+VALCHK,        TAD     C260    /SEE IF # IS LESS THAN
+       CIA             /ASCII 0 (260)
+       TAD I BFR       /SUBTRACT BUFFER DATA
+       SPA   CLA       /IS IT LESS THAN ASII 0?
+       JMP   TYQU      /YES: TELL OUTSIDE WORLD
+       TAD   C261      /NO: SEE IF GREATER THAN
+       CMA             /ASC II 1 (261)
+       TAD I BFR       /SUBTRACT BUFFER DATA
+       SMA   CLA       /GREATER THAN ASCII 7?
+       JMP   TYQU      /YES: TELL OUTSIDE WORLD
+       TAD I BFR       /NO: ACCEPT BUFFER 
+       RTR
+       AND   C7000     /ISOLATE DTA
+       JMS     REPEAT  /GO CHECK FOR REPEATED DTA AND STORE #
+       ISZ     BFR     /INCREMENT INPUT BUF. PTR.
+       JMP     CRCHK   /GO LOOK AT NEXT CHAR.
+
+/THIS SECTION CHECKS TO SEE IF THERE HAS BEEN ANY
+/VALID INPUT ONCE A CARRIAGE RETURN IS SEEN
+OKCR,  CLA             /CLEAR AC
+       TAD     CRFLAG  /LOAD CR FLAG; 0 MEANS NO GOOD
+       SNA     CLA
+       JMP     START   /0: NO VALID INPUT; RESTART
+       TAD     DCTR    /NOT 0: SO HAVE VALID INPUT
+       TAD     DBUFAD  /CALCULATE END OF DTA LIST +1
+       DCA     DBUFPT  /STORE IT IN BUFFER POINTER, THEN
+       CMA             /COMPLEMENT THE AC AND
+       DCA I   DBUFPT  /TERMINATE DTA LIST WITH 7777
+INIT1, CLA             /CLEAR AC IF COME THRU LOC IT
+       TAD     DBUFAD  /AND RESET LIST POINTER
+       DCA     DBUFPT  /TO START OF LIST
+       JMS I   GETDTA  /GO GET A DTA NUMBER
+
+/INFORM THE OPERATOR THAT THE PROGRAM IS SET TO START
+/TYPE "FORMAT" AND WAIT FOR THE REPLY
+
+INIT,  JMS I TYPE      /MESSAGE OUT
+       0617            /FO
+       2215            /RM
+       0124            /AT
+       7740  /?
+       0000  /END
+       JMS I TYPIN     /WAIT FOR A REPLY
+       JMS I COMPAR    /DID HE TYPE "MARK"?
+       0315  /M
+       0301  /A
+       0322  /R
+       0313  /K
+       0000  /END
+       JMP   .+3
+       JMP I .+1
+       MARK            /TO MARK A TAPE
+/SEE IF HE TYPED "RDR" (READ AND TYPE FIRST 12
+/BLOCK NUMBERS IN REVERSE).
+
+       JMS I COMPAR
+       0322  /R
+       0304  /D
+       0322  /R
+       0000  /0
+       JMP   .+3
+       JMP I .+1
+       RDR             /TYPE BLOCKS 
+
+/SEE IF HE TYPED "RDF" (READ AND TYPE FIRST 12
+/BLOCK NUMBERS FORWARD).
+
+       JMS I COMPAR
+       0322  /R
+       0304  /D
+       0306  /F
+       0000  /0
+       JMP   .+3
+       JMP I .+1
+       RDFA            /TYPE BLOCKS
+
+/SEE IF HE TYPED "SAME" (MEANING MARK A TAPE
+/USING THE SAME CONSTANTS AS BEFORE).
+
+       JMS I COMPAR
+       0323  /S
+       0301  /A
+       0315  /M
+       0305  /E
+       0000  /0
+       JMP   .+3
+       JMP I .+1
+       SWCHK           /TO MARK AS BEFORE
+
+/SEE IF HE TYPED "RESTART"
+
+       JMS I COMPAR
+       0322  /R
+       0305  /E
+       0323  /S
+       0324  /T
+       0301  /A
+       0322  /R
+       0324  /T
+       0000  /0
+       JMS   QU        /MUST BE NONSENSE
+       JMP     START   /START ALL OVER
+GETDTA,        NUDTA           /POINTER TO ROUTINE TO SWITCH UNITS
+CRFLAG,        0               /=0, CR NO GOOD; NOT 0, CR IS OK
+\f\f
+       *1200
+/MARK WAS TYPED IN, IF W1-1 IS NOT A "K",ASSUME THAT
+/A NUMBER WAS TYPED IN, AND VERIFY THIS. IF W1-1 IS
+/A "K", ASSUME STANDARD FORMAT.(W1=LAST ENTRY INTO THE BUFFER)
+
+MARK,  TAD  I   BINCO  /ADDRESS OF FIRST BINARY
+       DCA   W5        /CONSTANT FOR DEC TO BIN
+       DCA   TOTAL     /WILL BE BINARY EQUIVILANT
+
+/SAVE C(X1) FOR DECREMENT THROUGH BUFFER
+
+DNC,   CLA   CMA       /DECREMENT BUFFER ADDRESS
+       TAD   W1        /ADDRESS BY 1
+       DCA   W1        /W1=SWEEP ADDRESS
+
+/LOOK FOR END OF PROCESSING BY LOOKING FOR A "K" IN BUFFER
+
+       TAD   LETK      /LETTER ASCII "K"
+       CIA             /SUBTRACT FROM CHARACTER
+       TAD I W1        /IN BUFFER
+       SNA   CLA       /EQUAL?
+       JMP   DIV3      /YES: SEE IF DIVISIBLE BY 3
+
+/VERIFY THIS CHARACTER AS BEING OF DECIMAL ORIGIN
+
+       TAD   C260      /ASCII FOR 0
+       CIA             /TO SEE IF CHARACTER
+       TAD I W1        /IS LESS THAN 260
+       SPA   CLA       /IS IT?
+       JMP I QU1       /YES: NOT DECIMAL CHARACTER
+       TAD   C271      /ASCII FOR 9
+       CMA             /TO SEE IF GREATER THAN
+       TAD I W1        /9
+       SMA   CLA       /IS IT?
+       JMP I QU1       /NOT A DECIMAL CHARACTER
+/CHARACTER IS DECIMAL. NOW CONVERT IT TO BINARY
+/REMEMBER POSITION OF CHARACTER IN BUFFER MAY BE
+/10,100,1000.
+
+       TAD I W1        /ISOLATE THE NUMBER
+       AND   C0017     /FOR PROPER CONVERSION
+       SNA             /IF 0, NO BINARY CONVERSION NEEDED
+       JMP   IBS       /YES: 0: INCREMENT BINARY CONVERSION
+
+/NOT 0, SET UP CONVERSION LOOP
+
+       CLL   CIA       /NUMBER OF ADDITIONS
+       DCA   W4        /TO NEGATIVE FOR ISZ
+       TAD I W5        /BINARY POSITION TO C(ACC)
+       TAD   TOTAL     /ADD TO PRESENT TOTAL
+       SZL             /CHECK ON TO MANY WORDS
+       JMP I QU2       /TO MANY WORDS CALLED FOR
+       DCA   TOTAL     /KEEP RUNNING SUM
+       ISZ   W4        /LAST ADDITION?
+       JMP   .-6       /NO: ADD AGAIN
+
+/FINAL ADDITION FOR THIS POSITION COMPLETED
+
+IBS,   ISZ   W5        /NEXT POSITION
+       JMP   DNC       /DO NEXT CHARACTER
+
+/LAST CHARACTER COMPLETED. SEE IF DIVISIBLE BY 3
+/IF NOT A NORMAL INPUT
+
+DIV3,  TAD   TOTAL     /GET TOTAL WORDS
+       SNA             /IF TOTAL 0, NORMAL INPUT
+       TAD   C201      /129 OCT. THIS TEST REDUNDANT
+       TAD   C0017     /ADD CONSTANT 15 TO TOTAL
+       DCA   TOTAL     /FOR FUTURE CONSIDERATIONS
+       DCA   VAR1      /# OF WORDS/3 FOR MARK TRACK WRITING
+       TAD   TOTAL     /RESTORE IN THE ACC
+       CLL             /TO DIVIDE BY 3, LINK KEEPS OVERFLOW
+       TAD   M3        /SUBTRACT 3
+       ISZ   VAR1      /ON EACH DIVISION, KEEP RUNNING SUM
+       SZA             /IF AC = 0,NO REMAINDER
+       SNL             /WHEN LINC GOES TO 0, DIVISION ENDED
+       SKP             /NOW SEE IF IT DIVIDED EVENLY
+       JMP   .-6       /SUBTRACT 3 MORE
+       SZA   CLA       /IF 0,OK. OTHERWISE ERROR
+       JMP I QU4       /NOT DIVISIBLE BY 3
+
+/CORRECT "VAR1" ( THE NUMBER OF WORDS/3) FOR THE +15
+/ADDED JUST ABOVE AND AN INHERANT +2 DUE TO MARK TRACK
+/CONFIGURATION TO BE WRITTEN.
+
+       TAD   M7        /SUBTRACT 7 FROM PHONY SETUP
+       TAD   VAR1      /GIVING THE NUMBER OF TIMES
+       CIA             /TO BE USED LATER IN A ISZ
+       DCA   VAR1      /DATA MARK WILL BE WRITTEN
+/COMPUTE A VALUE FOR TOTAL NUMBER OF BLOCKS
+/RECORD SIZE + 15 INTO 636160 OCT.
+
+       TAD   C7714     /EXTENDED 64 VALUE. SETS AC#2
+       DCA   W1        /SET FOR 640000
+       JMS I FORM10    /PATCH TO CHECK FOR STD.10 FORMAT
+       TAD   C1620     /VERNIER ADJUSTMENT FOR FORMULA
+       CLL             /ACC#2 CARRY FUNCTION
+       TAD   TOTAL     /WORD COUNT
+       ISZ   BLOCKS    /+1 TO BLOCK COUNT
+       SKP
+       JMP I QU3       /TO MANY BLOCKS CALLED FOR
+       SNL             /CARRY INTO ACC#2?
+       JMP   .-5       /NO: CONTINUE COUNT
+       ISZ   W1        /YES: FULLY DIVIDED?
+       JMP   .-10      /NO: CONTINUE PROCESS
+       CLA   CLL       /C(ACC)+ C(L)=0
+F10RTN,        TAD   BLOCKS    /FOR MARK TRACK (COME HERE FR F10PAT IF 10 FRMT)
+       CMA             /WRITING
+       DCA   VAR2      /SEE MARK WRITE
+
+/VALUES FOR BLOCK AND RECORD SIZE HAVE BEEN
+/COMPUTED. TELL OUTSIDE WORLD AND GET THE OK.
+
+       TAD   TOTAL     /SUBTRACT 15 FROM TOTAL
+       TAD   C7761     /WORDS FOOLING OPERATOR
+       DCA   TOTAL     /CORRECTED FOR TAPE WRITING
+       TAD   TOTAL     /FOR OCTAL TYPEOUT
+       JMS I TYOCT     /TYPE OCTAL WORDS
+       JMS I TYPE      /TYPE MESSAGE
+       4027  / W
+       1722  /OR
+       0423  /DS
+       5400  /, END
+       TAD   BLOCKS    /TYPE OUT BLOCK #S
+       IAC             /TO FOOL THE OPERATOR
+       JMS I TYOCT     /IN OCTAL
+       JMS I TYPE      /TYPE MESSAGES
+       4002  / B
+       1417  /LO
+       0313  /CK
+       2356  /S.
+       1713  /OK
+       7733  /?(
+       3105  /YE
+       2340  /S
+       1722  /OR
+       4016  / N
+       1735  /O)
+       4543  /CR+LF
+       0000  /END
+       JMS I TYPIN     /WAIT FOR REPLY
+/SEE IF A YES OR NO ANSWER WAS GIVEN
+
+       JMS I COMPAR
+       0331   /Y
+       0305   /E
+       0323   /S
+       0000   /END
+       JMP I IT
+
+       JMP  I  .+1
+       SWCHK
+FORM10,        F10PAT
+
+
+\f
+*1400
+/SET THE TAPE INTO MOTION. ALL VARIABLES ARE SET.
+
+/WRITE TIMING AND MARK TRACK
+
+STMK,  CLA
+       DCA     PHASE
+       TAD   DT1400    /FWD, WRITE, GO
+       TAD   DTA       /GET UNIT NUMBER
+       SDLC            /LOAD COMMAND REGISTER
+       TAD   VAR2      /TO MAKE A RESTART FOR THE SAME
+       DCA   W6        /OPTION POSSIBLE
+
+/WRITE ABOUT 10 FEET OF END ZONE
+       DCA   W1
+CEZ,   TAD   REZ       /ADDRESS OF DATA
+       JMS   SETUP
+       ISZ   W1
+       JMP   CEZ       /NOT END FOOTAGE
+       TAD   M144      /OK WRITE INTERBLOCK SYNC
+       DCA   W1
+       JMS   INBLSY
+       ISZ   W1
+       JMP   .-2
+       JMP   WDZ
+
+       /WRITE INTERBLOCK SYNC
+INBLSY,        0
+       TAD   VAR1      /RESET THE WORDS
+       DCA   W5
+       TAD   IBZ       /ADDRESS OF DATA
+       JMS   SETUP     /GO OUT AND WRITE 1
+       JMP I INBLSY    /GO DO AGAIN
+
+       /WRITE FORWARD BLOCKMARK AND REVERSE GUARD
+WDZ,   TAD   FBM       /ADDRESS OF PATTERN
+       JMS   SETUP
+
+       /WRITE LOCKMARK, REVERSE CHECKSUM, REV FINAL, REV PREFINAL
+LRCFP, TAD   WLMRF
+       JMS   SETUP1
+
+       /WRITE THE DATA TRACK
+DTRK,  TAD   DZ        /ADDRESS OF PATTERN
+       JMS   SETUP
+       ISZ   W5
+       JMP   DTRK      /NOW WRITE DATA MARK TRACK AGAIN
+       /WRITE PREFINAL, FINAL, CHECKSUM, AND REVERSE LOCK
+PFCRC, TAD   FEZ       /ADDRESS OF DATA
+       JMS   SETUP1
+
+       /WRITE GUARD REVERSE BLOCK
+GRB,   TAD   GRZ
+       JMS   SETUP
+
+       /THIS COMPLETES 1 BLOCK, GO BACK AND WRITE THE REST
+       JMS   INBLSY    /WRITE INTERBLOCK SYNC
+       ISZ   W6        /TOTAL NUMBER OF BLOCKS
+       JMP   WDZ       /WRITTEN? NO:
+
+       /ALL DATA BLOCKS WRITTEN NOW WRITE BUFFER ZONE OF INTERBLOCK SYNC
+       TAD   M143      /198 EXPAND CODES AT END OF BLOCKS
+       DCA   W1
+       JMS   INBLSY
+       ISZ   W1
+       JMP   .-2
+
+       /FINISHED BLOCK WRITTING, WRITE ANOTHER 10(1) OF END ZONES
+       DCA   W1
+WEZF,  TAD   EZM
+       JMS   SETUP
+       ISZ   W1
+       JMP   WEZF
+       SDST
+       SKP     CLA
+       JMS  I  SELTIM          /TIMING ERROR
+       TAD     C1
+       DCA     PHASE
+       JMP I .+1
+       MWTM
+
+SETUP, 0
+       DCA   12        /WORD TO BE WRITTEN ON MARK TRACK
+       TAD   M3
+       DCA   WC
+       JMS I WAIT
+       ISZ   WC
+       JMP   .-2
+       JMP I SETUP
+
+SETUP1,        0
+       DCA   12
+       TAD   M6
+       DCA   WC
+       JMS I WAIT
+       ISZ   WC
+       JMP   .-2
+       JMP I SETUP1
+/THESE ARE THE DATA CONFIGURATIONS FOR THE MARK TRACK
+
+
+/REVERSE END ZONE
+
+REZ,   .
+       4044    /ON TAPE AS 5555 (OCT)
+       0440
+       4404
+
+/INTERBLOCK SYNC
+
+IBZ,   .
+       0404    /ON TAPE AS 2525 (OCT)
+       0404
+       0404
+
+/FORWARD BLOCK MARK AND REVERSE GUARD
+
+FBM,   .
+       0404    /ON TAPE AS 2632 (OCT)
+       4004
+       4040
+
+/LOCK MARK, REVERSE CHECKSUM, REVERSE FINAL
+/AND REVERSE PREFINAL
+
+WLMRF, .
+       0040    /ON TAPE AS 10101010 (OCT)
+       0000
+       4000
+       0040
+       0000
+       4000
+
+/DATA MARK
+
+DZ,    .
+       4440    /ON TAPE AS 7070 (OCT)
+       0044
+       4000
+
+/PREFINAL, FINAL, FWD CHECKSUM, AND REVERSE LOCK
+
+FEZ,   .
+       4440    /ON TAPE AS 73737373 (OCT)
+       4444
+       4044
+       4440
+       4444
+       4044
+/FORWARD GUARD AND REVERSE BLOCK NUMBER
+
+GRZ,   .
+       4040    /ON TAPE AS 5145 (OCT)
+       0440
+       0404
+
+/FORWARD END ZONE
+
+EZM,   .
+       0400    /ON TAPE AS 2222 (OCT)
+       4004
+       0040
+/SUBROUTINE TO SEE IF USER TYPED MARK 384
+/TO SPECIFY STANDARD PDP-10 FORMAT
+F10PAT,        0
+       DCA     BLOCKS  /CLEAR LOC. BLOCKS IN CASE NOT 10-FORMAT
+       TAD     TOTAL   /AND GET NUMBER TYPED BY USER
+       TAD     M617    /WAS IT 384?
+       SZA     CLA
+       JMP I   F10PAT  /NO-RETURN
+       DCA     W1      /YES-CLEAR W1 FOR WAIT LOOP
+       TAD     C1101   /AND ADJUST BLOCK TOTAL FOR
+       DCA     BLOCKS  /1102(OCTAL) BLOCKS.
+       JMP I   .+1
+F10BAK,        F10RTN
+M617,  -617
+C1101, 1101
+C1,    0001
+\f
+       *1600
+/THE MARK TRACK HAS BEEN WRITTEN, AND TAPE IS
+/MOVING FORWARD IN THE FORWARD END ZONE. STOP
+/THE TAPE AND SEE IF THERE ARE ANY TAPES LEFT TO
+/MARK--IF SO GO DO THEM, ELSE TELL OPERATOR TO THROW THE
+/"OFF/WTM" SWITCH TO "OFF"
+/HE WILL THEN CONTINUE AFTER THIS ACTION
+
+
+       /KILL WRITE,STOP TAPE
+
+MWTM,  CLA
+       TAD     DTA     /UNIT
+       SDLC
+       JMS     NUDTA
+       JMP  I  DOMARK
+
+       /MESSAGE TO THE OPERATOR
+OFF,   JMS I   TYPE
+       2305            /SE
+       2440            /T
+       2327            /SW
+       1124            /IT
+       0310            /CH
+       4024            /T
+       1740            /O
+       1706            /OF
+       0600            /F
+       JMS  I  TYPIN   /WAIT FOR CR
+       JMP  I  .+1
+       SWOFF           /CHECK TO MAKE SURE THAT SWITCH IS OFF
+       /REVERSE TAPE AND READ MARK TRACK
+PSER,  TAD     DT3000  /REVERSE GO
+       TAD     DTA             /UNIT
+       SDLC            /LOAD COMMAND REGISTER
+       DCA     W1      /STALL ROUTINE TO GET UP TO SPEED
+       SDSQ
+       JMP     .-1
+       SDRC
+       ISZ     W1
+       JMP     .-4
+       SDSQ            /SKIP ON QUAD LINE IF SET AFTER WAIT ROUTINE
+       SKP
+       JMP     .+3     /FLAG WAS SET
+       SDSS            /READ IN A LINE OF TAPE
+       JMP     .-1
+       SDRC            /READ THE COMMAND REGISTER
+       SDST            /CHECK FOR A TIMING ERROR
+       SKP
+       JMS  I  SELTIM          /TIMING ERROR
+       AND     MSK77   /CHECK TO SEE IF TAPE IS STILL IN END ZONE
+       TAD     M55
+       SZA     CLA
+       JMP     .-11    /NOT A 55 YET
+       JMS  I  SSDSQT  /YES,READ IN SOME MORE
+       TAD     M55     /IS IT END ZONE
+       SNA     CLA
+       JMP     .-3     /STILL IN END ZONE
+       TAD     MTR     /GET THE MARK TRACK
+       TAD     M25     /IS IT EXPAND CODE
+       SZA     CLA
+       JMS  I  SCEXPC  /NOT YET,CHECK FOR A 52,AND ADVANCE 3 LINES
+       CLA             /YES IT IS EXPAND CODE
+       TAD     M306    /SET UP FOR 198 EXPAND CODES
+       DCA     CNT
+       JMS  I  SSDSQT  /THE TAPE SHOULD BE IN SYNC NOW
+       TAD     M25     /READ THE REST OF EXPAND CODE
+       SZA     CLA
+       JMS  I  MARKER  /MARK TRACK ERROR
+       ISZ     CNT     /INCREMENT COUNTER
+       JMP     .-5
+       TAD     VAR2    /NUMBER OF BLOCKS
+       DCA     W6
+RSTBLK,        JMS  I  SSDSQT  /START OF A STANDARD BLOCK
+       TAD     M25     /FIRST EXPAND CODE AT BEGINNING
+       SZA     CLA     /OF BLOCK
+       JMS  I  MARKER  /MARK TRACK ERROR
+       JMS  I  SSDSQT  /READ MARK BLOCK NUMBER
+       TAD     M26
+       SZA     CLA
+       JMS  I  MARKER  /MARK TRACK ERROR
+       JMS  I  SSDSQT  /READ MARK GUARD
+       TAD     M32
+       SZA     CLA
+       JMS  I  MARKER  /MARK TRACK ERROR
+       TAD     M4
+       DCA     CNT
+       JMS  I  SSDSQT  /READ L,CK,F,PF
+       TAD     M10
+       SZA     CLA
+       JMS  I  MARKER  /MARK TRACK ERROR
+       ISZ     CNT
+       JMP     .-5
+       CLA     CLL
+       TAD     VAR1
+       RAL
+       DCA     W5      /NUMBER OF DATA MARKS
+       JMS  I  SSDSQT  /READ DATA MARKS
+       TAD     M70
+       SZA     CLA
+       JMS  I  MARKER          /MARK TRACK ERROR
+       ISZ     W5      /COUNT FOR NUMBER OF BLOCKS
+       JMP     .-5
+       TAD     M4
+       DCA     CNT
+       JMS  I  SSDSQT  /READ PF,F,CK,L
+       TAD     M73
+       SZA     CLA
+       JMS  I  MARKER  /MARK TRACK ERROR
+       ISZ     CNT
+       JMP     .-5
+       JMS  I  SSDSQT  /READ REVERSE GUARD
+       TAD     M51
+       SZA     CLA
+       JMS  I  MARKER
+
+       JMS  I  SSDSQT  /READ BLOCK NUMBER
+       TAD     M45
+       SZA     CLA
+       JMS  I  MARKER  /MARK TRACK ERROR
+       JMS  I  SSDSQT  /READ EXPAND CODE
+       TAD     M25
+       SZA     CLA
+       JMS  I  MARKER  /END OF ONE BLOCK,MARK TRACK ERROR
+
+       ISZ     W6      /FINISHED ALL BLOCKS
+       JMP     RSTBLK  /NO:DO OTHER BLOCKS
+       TAD     M307    /SET UP FOR INTERBLOCK SYNC AT END OF TAPE
+       DCA     CNT
+       JMS  I  SSDSQT  /CHECK FOR 199 EXPAND CODES
+       TAD     M25
+       SZA     CLA
+       JMS  I  MARKER  /MARK TRACK ERROR
+       ISZ     CNT
+       JMP     .-5
+       JMS  I  SSDSQT
+       TAD     M22
+       SZA     CLA
+       JMS  I  MARKER
+       TAD     DTA
+       SDLC
+       JMP  I  .+1
+WDBLKN,        DBLKN   /GO OUT TO WRITE DATA AND BLOCK NUMBERS FORWARD
+
+
+\f
+*2000
+DBLKN, TAD     C2
+       DCA     PHASE
+       TAD     VAR2    /NUMBER OF BLOCKS
+
+       DCA     W6
+       DCA     BLK     /INITIAL BLOCK IS 0
+       TAD     BLK
+       JMS  I  MESS    /COMPUTE THE COMP OBVERSE OF REV BLK
+       DCA     REVBLK
+       SDLD
+       TAD     DT1400  /FORWARD,WRITE,GO
+       TAD     DTA     /UNIT
+       SDLC            /LOAD THE COMMAND REGISTER
+       SDRC            /CHECK TO MAKE SURE WRITE IS SET
+       RTL
+       RAL
+       SMA     CLA
+       JMS     WLO     /WRITE FAILED TO SET
+       TAD     M6
+       DCA     CNT
+       SDSQ            /ROUTINE TO GET UP TO SPEED
+       JMP     .-1
+       SDLD
+       ISZ     CNT
+       JMP     .-4
+       SDLD
+       SDST
+       SKP
+       JMS  I  SELTIM          /TIMING ERROR
+LINE,  SDSS            /WRITE ALL ZEROES TO THE FIRST BLOCK
+       JMP     .-1
+       SDLD            /LOAD THE DATA BUFFER 
+       SDRC
+       SDST
+       SKP
+       JMS  I  SELTIM          /TIMING ERROR
+       AND     MSK77
+       DCA     MTR
+       TAD     MTR
+       TAD     M26
+       SZA     CLA
+       JMP     LINE
+       SDLD
+       SDST
+       SKP
+       JMS  I  SELTIM          /TIMING ERROR
+       JMP     WDOBLK  /GO AND WRITE REVERSE GUARD
+WDBLK, CLA CLL         /BEGINNING OF BLOCK,WRITE DATA AND BLOCK NUMBER
+       JMS     W4L     /WRITE EIGHT LINES
+       JMS     W4L     /END OF EXPAND CODE,BEGINNING OF BLK NUMBER
+       TAD     BLK     /GET FORWARD BLOCK NUMBER
+       JMS     W4L     /WRITE IT
+       CLA
+       JMS     W4L     /WRITE FIRST WORD OF REV GUARD
+WDOBLK,        CLA
+       JMS     W4L     /SECOND WORD OF REVERSE GUARD
+       JMS     W4L
+       JMS     W4L     /FIRST WORD OF REVERSE CHECKSUM
+WDATA, TAD     TOTAL   /NUMBER OF DATA WORDS TO BE WRITTEN
+       CIA
+       DCA     W5      /SET UP COUNTER
+       JMS     W4L
+       ISZ     W5      /INCREMENT COUNTER
+       JMP     .-2
+       CLA     CLL
+       TAD     MSK77   /COME BACK TO WRITE LAST WORD AND CHECKSUM
+       JMS     W4L
+       CLA
+       JMS     W4L     /FINISH CHECKSUM
+       JMS     W4L     /FIRST WORD OF REVERSE LOCK
+       JMS     W4L     /LAST WORD OF RL. AND HALF OF GUARD
+       JMS     W4L     /REST OF GUARD
+       TAD     REVBLK  /GET REVERSE BLOCK NUMBER
+       JMS     W4L
+       CLA     CMA
+       JMS     W4L     /END OF BLOCK NUMBER AND HALF OF EXPAND CODE
+       JMS     W4L     /END OF EXPAND CODE
+       ISZ     BLK
+       CLA
+       TAD     BLK
+       JMS  I  MESS    /COMPUTE NEW BLK NUMBER
+       DCA     REVBLK
+       SDST
+       SKP
+       JMS  I  SELTIM          /TIMING ERROR
+       ISZ     W6      /IS IT DONE WRITING BLK AND DATA
+       JMP     WDBLK   /NO
+       SDSQ
+       JMP     .-1
+       SDRD
+       CLA
+       TAD     DT1000  /SEARCH FOR END ZONE
+       TAD     DTA     /GET UNIT
+       SDLC            /LOAD THE COMMAND REG
+       SDSS
+       JMP     .-1
+       SDRC
+       AND     MSK77
+       TAD     M22
+       SZA     CLA
+       JMP     .-6
+       JMP  I  .+1
+       DBLOCK
+
+W4L,   0
+       SDSQ
+       JMP     .-1     /SKIP ON QUAD LINE FLAG
+       SDLD            /LOAD THE DATA BUFFER
+       SDST            /CHECK FOR A TIMING ERROR
+       SKP
+       JMS  I  SELTIM          /TIMING ERROR
+       JMP  I  W4L
+
+C2,    0002
+
+WLO,   0
+       TAD     DTA     /STOP THE TAPE
+       SDLC            /LOAD THE COMMAND REGISTER
+       JMS  I  TYPE
+       2003            /PC
+       4000            /END
+       CLA     CMA
+       TAD     WLO
+       JMS  I  TYOCT
+       JMS  I  TYPE
+       4040
+       2722            /WR
+       1124            /IT
+       0540            /E
+       0000            /END
+       JMP  I  .+1
+       ZCOM
+
+
+
+\f
+*2200
+BLCSD, TAD     C4
+       DCA     PHASE
+       CLA     CLL
+       TAD     VAR2
+       DCA     W6      /SET UP FOR THE NUMBER OF BLOCKS
+       DCA     BLK     /SET BLK TO 0
+       TAD     DT1000  /FORWARD READ
+       TAD     DTA     /UNIT
+       SDLC            /LOAD THE COMMAND REG
+       TAD     BLK
+       JMS  I  MESS    /CALCULATE THE COMPLEMENT OBVERSE
+       DCA     REVBLK
+       SDST
+       SKP
+       JMS  I  SELTIM          /TIMING ERROR
+       TAD     M6      /WAIT TO GET UP TO SPEED
+       DCA     CNT     /SET UP COUNTER
+       SDSQ            /SKIP ON A QUAD LINE FLAG
+       JMP     .-1
+       SDRD            /READ THE DATA BUFFER TO CLEAR FLAG
+       ISZ     CNT
+       JMP     .-4
+       CLA
+BLCSDA,        DCA     CHKSUM
+       JMS  I  SLRDRC  /READ A SINGLE LINE AT A TIME
+       TAD     M26
+       SZA     CLA     /IS IT BLOCK MARK
+       JMP     SRDRC+4 /NO,GO BACK
+       SDST
+       SKP
+       JMS  I  SELTIM          /TIMING ERROR
+       TAD     DATRD
+       CIA
+       TAD     BLK
+       SZA     CLA
+       JMS  I  BLKERR  /BLK NUMBER ERROR
+       JMS  I  SSDSQT  /READ GUARD
+       JMS  I  SSDSQT  /READ REVERSE LOCK
+       JMS  I  SSDSQT  /READ CHECKSUM
+       SDRD            /READ THE DATA BUFFER
+       SDST
+       SKP
+       JMS  I  SELTIM          /TIMING ERROR
+       AND     MSK77
+       JMS  I  BCXOR   /GO OUT TO CHECKSUM ROUTINE
+RDATA, TAD     TOTAL   /NUMBER OF WORDS PER BLOCK
+       CIA
+       DCA     W5      /SET UP COUNTER
+       SDSQ
+       JMP     .-1
+       SDRD            /READ THE DATA BUFFER
+       SDST
+       SKP
+       JMS  I  SELTIM          /TIMING ERROR
+       DCA     DATRD
+       TAD     DATRD   /SAVE THE DATA WORD
+       SZA     CLA
+       JMS  I  DATERR  /DATA ERROR
+       TAD     DATRD
+       JMS  I  BCXOR
+       SDST            /CHECK FOR A TIMING ERROR
+       SKP
+       JMS  I  SELTIM          /TIMING ERROR
+       ISZ     W5
+       JMP     RDATA+3
+       SDSQ            /READ REVERSE CHECKSUM
+       JMP     .-1
+       SDRD            /READ IT IN
+       SDST
+       SKP
+       JMS  I  SELTIM          /TIMING ERROR
+       AND     C7700
+       JMS  I  BCXOR   /CHECK CHECK SUM
+       TAD     CHKSUM
+       AND     MSK77
+       IAC
+       TAD     C7700
+       SZA     CLA
+       JMS  I  CHKERR  /CHECKSUM ERROR
+       SDST
+       SKP
+       JMS  I  SELTIM          /TIMING ERROR
+       JMS  I  SLRDRC  /ADVANCE A SINGLE LINE FLAG
+       TAD     M31     /LOOK FOR REV BLK NUMBER
+       SZA     CLA
+       JMP     SRDRC+4
+       SDST
+       SKP
+       JMS  I  SELTIM          /TIMING ERROR
+       TAD     DATRD
+       CIA
+       TAD     REVBLK  /COMPARE BLOCK READ WITH ONE COMPUTED
+       SZA     CLA
+       JMS  I  BLKERR  /BLOCK NUMBER ERROR
+       SDSQ    
+       JMP     .-1
+       SDRD
+       SDST
+       SKP
+       JMS  I  SELTIM          /TIMING ERROR
+       CLA     CLL
+       ISZ     BLK
+       TAD     BLK
+       JMS  I  MESS
+       DCA     REVBLK
+       SDST
+       SKP
+       JMS  I SELTIM           /TIMING ERROR
+       ISZ     W6
+       JMP     BLCSDA
+       TAD     DT1000
+       TAD     DTA
+       SDLC
+       SDSS
+       JMP     .-1
+       SDRC
+       AND     MSK77
+       TAD     M22
+       SZA     CLA
+       JMP     .-6
+       JMP  I  .+1
+       RDBLKS
+
+C4,    0004
+
+\f
+*2400
+DBLOCK,        TAD     C3
+       DCA     PHASE
+       CLA     CLL
+       DCA     DISBLK
+       TAD     DT3000  /REVERSE,GO
+       TAD     DTA             /UNIT
+       SDLC            /LOAD THE COMMAND REGISTER
+       CLA     CLL
+DISLUP,        SDSS
+       JMP     .-1
+       CLA     CLL
+       SDRD
+       DCA     DISDAT  /SAVE THE DATA BUFFER
+       SDRC
+       AND     MSK77   /MASK OUT THE MARK TRACK
+       TAD     M26     /CHECK FOR BLOCK NUMBER
+       SZA
+       JMP     DISEND  /NOT BLK MARK,CHECK FOR END ZONE
+       TAD     DISDAT  /DISPLAY THE NUMBER IN THE AC
+       ISZ     DISBLK
+       JMP     .-1
+       JMP     DISLUP  /GO SEARCH FOR THE NEXT BLOCK
+DISEND,        TAD     FOUR    /IS IT END ZONE
+       SZA     CLA
+       JMP     DISLUP  /NO,GO GET NEXT LINE
+       TAD     DTA     /STOP GET READY TO READ
+       SDLC            /LOAD THE COMMAND REGISTER
+       JMP  I  .+1
+       BLCSD
+DISBLK,        0
+DISDAT,        0
+FOUR,  4
+C3,    0003
+C5,    0005
+
+RDBLKS,        TAD     C5
+       DCA     PHASE
+       TAD     VAR2
+       DCA     W5      /SET UP FOR NUMBER OF BLOCKS
+       IAC
+       TAD     VAR2
+       DCA     W6      /SET UP TO CHECK BLK REVERSE
+       TAD     DT3000  /READ REVERSE GO
+       TAD     DTA     /UNIT
+       SDLC            /LOAD THE COMMAND REGISTER
+       TAD     M6
+       DCA     CNT
+       SDSS
+       JMP     .-1
+       SDRC
+       CLA
+       ISZ     CNT
+       JMP     .-5
+RDBLK, SDSS
+       JMP     .-1
+       SDRD            /READ THE DATA BUFFER AND STORE IT AWAY
+       DCA     CNT
+       SDRC
+       AND     MSK77
+       TAD     M26
+       SZA     CLA     /IS IT BLOCK NUMBER
+       JMP     RDBLK
+       TAD     CNT
+       TAD     W6
+       SZA     CLA
+       JMS  I  BLKERR  /BLOCK NUMBER ERROR
+       IAC
+       TAD     W6      /INCREMENT A NUMBER FOR COMPARE COUNTER
+       DCA     W6
+       ISZ     W5      /INCREMENT BLK COUNTER
+       JMP     RDBLK
+       SDSS
+       JMP     .-1
+       SDRC
+       AND     MSK77
+       TAD     M22
+       SZA     CLA
+       JMP     .-6
+       TAD     DTA
+       SDLC            /LOAD THE COMMAND REGISTER WITH UNIT STOP
+       IAC
+       DCA     PHASE
+       JMS     NUDTA
+       JMP     PSER
+       JMP  I  .+1
+       INIT            /END GO BACK TO DIRECT
+/
+/
+/SUBROUTINE TO CHECK FOR REPEATED DTA NUMBERS
+/DTA # TO COMPARE TO LIST IS IN AC ON ENTRY--THIS
+/ROUTINE STORES THE DTA # IF IT IS NEW AND IGNORES IT
+/IF IT IS NOT-CALL BY JMS REPEAT WITH DTA # IN AC
+REPEAT,        0
+       DCA     DNUM    /TEM STORAGE FOR NEW DTA #
+       TAD     DBUFAD  /INITIALIZE POINTER (DBUFPT)
+       DCA     DBUFPT  /TO START OF DTA LIST
+       TAD     DCTR    /LOAD NUM. OF DTAS STORED
+       CMA             /COMPLEMENT IT
+       DCA     COMCTR  /STORE IN COMPARE COUNTER
+COMCHK,        ISZ     COMCTR  /DONE WITH ALL COMPARES?
+       JMP     DOCOMP  /NO: GO DO COMPARE
+       TAD     DNUM    /YES: STORE NEW DTA#
+       DCA I   DBUFPT  /AT END OF LIST
+       ISZ     DCTR    /INCR. # OF DTAS STORED
+       JMP I   REPEAT  /RETURN
+
+COMCTR,        0       /COUNTER FOR # OF LIST COMPARISONS TO BE DONE
+DCTR,  0       /COUNTER FOR # OF DTAS IN LIST
+DBUFAD,        DTABUF  /START OF DTA NUM. LIST
+DNUM,  0       /TEM STORAGE FOR DTA #
+/
+/
+/THIS SECTION DOES THE ACTUAL COMPARISON BETWEEN
+/THE DTA# PASSED TO THE ROUTINE AND A NUMBER ON THE LIST
+
+DOCOMP,        TAD I   DBUFPT  /GET NXT DTA NUMBER PASSED
+       CIA             /NEGATE IT
+       TAD     DNUM    /ADD IN DTA NUMBER PASSED
+       SNA CLA /ARE THEY THE SAME
+       JMP I   REPEAT  /YES: RETURN
+       ISZ     DBUFPT  /NO: INCREMENT LIST POINTER
+       JMP     COMCHK  /SEE IF DONE ALL COMPARES
+/
+/
+
+\f
+*2600
+
+RDFA,  CLA     CLL
+       TAD     DT3000  /REVERSE READ GO
+       TAD     DTA     /GET UNIT
+       SDLC            /LOAD THE COMMAND REGISTER
+       SDSS            /SKIP ON A SINGLE LINE FLAG
+       JMP     .-1
+       SDRC            /READ THE COMMAND REGISTER
+       AND     MSK77
+       TAD     M22     /IS IT END ZONE
+       SZA     CLA     /YES
+       JMP     .-6     /NO GO BACK AND LOOK AGAIN
+       TAD     DT1000  /FORWARD READ GO
+       TAD     DTA     /UNIT
+       SDLC            /LOAD THE COMMAND REGISTER
+       TAD     M6
+       DCA     CNT
+       SDSS
+       JMP     .-1
+       SDRC
+       CLA
+       ISZ     CNT
+       JMP     .-5
+RDFA1, TAD     M26
+       DCA     W3      /SET UP COUNTER TO READ 22 BLOCKS
+       TAD     BADD    /SET UP BUFFER ADDRESS
+       DCA     X2
+       SDSS            /GO SINGLE LINE FLAGS
+       JMP     .-1
+       SDRD            /READ THE DATA BUFFER
+       DCA     CNT
+       SDRC            /READ THE COMMAND REGISTER
+       AND     MSK77
+       TAD     M26     /SEARCH FOR BLOCK NUMBER
+       SZA     CLA
+       JMP     RDFA1+4 /NOT BLOCK NUMBER YET GO BACK AGAIN
+       TAD     CNT     /OK BLK NUMBER STORE IT AWAY
+       DCA  I  X2
+       ISZ     W3      /INCREMENT COUNTER
+       JMP     RDFA1+4 /NOT 22 BLOCKS YET
+       TAD     DTA
+       SDLC            /STOP THE DTA
+
+/TYPE OUT BLOCK NUMBERS AND DTA UNIT#
+
+       JMS  I  TYPE
+       0424            /DT
+       0140            /A
+       0000            /END
+       TAD     DTA     /GET UNIT NUMBER
+       RTL
+       JMS  I  TYOCT   /AND TYPE IT OUT
+       JMS  I  TYPE
+       4345            /CR&LF
+       0000            /END
+       TAD     M26     /WILL TYPE ALL
+       DCA     W1      /22 WORDS
+       TAD     BADD    /ADDRESS OF BLOCK
+       DCA     X2      /NUMBERS TO INDEX
+       TAD  I  X2      /FIRST OR NEXT BLOCK
+       JMS  I  TYOCT   /TYPE IT OUT
+       JMS  I  TYPE    /CR&LF
+       4345            /CR&LF
+       0000            /END
+       ISZ     W1      /COMPLETE
+       JMP     .-6
+       JMP  I  IT      /GO ASK FOR FORMAT
+
+RDR,   CLA     CLL
+       TAD     DT1000  /FORWARD READ GO
+       TAD     DTA     /UNIT
+       SDLC            /LOAD THE COMMAND REGISTER
+       SDSS            /SKIP ON A SINGLE LINE FLAG
+       JMP     .-1
+       SDRC            /READ THE COMMAND REGISTER
+       AND     MSK77
+       TAD     M22     /CHECK FOR END ZONE
+       SZA     CLA
+       JMP     .-6     /NOT YET GO BACK
+       TAD     DT3000  /REVERSE READ GO
+       TAD     DTA     /UNIT
+       SDLC            /LOAD THE COMMAND REGISTER
+       TAD     M6
+       DCA     CNT
+       SDSS
+       JMP     .-1
+       SDRC
+       CLA
+       ISZ     CNT
+       JMP     .-5
+       JMP     RDFA1   /STORE NUMBERS IN REVERSE
+
+RETRY, JMS  I  TYPIN
+       JMS  I  COMPAR
+       0322            /R
+       0305            /E
+       0324            /T
+       0322            /R
+       0331            /Y
+       0000            /END
+       JMP  I  IT      /GUESS HE DOESN'T WANT TO TRY AGAIN
+       CLA
+       TAD     DT1000  /FORWARD READ GO
+       TAD     DTA     /UNIT
+       SDLC            /LOAD THE COMMAND REGISTER
+       TAD     M6
+       DCA     CNT     /WAIT 6 LINES
+       SDSS
+       JMP     .-1
+       SDRC            /READ THE COMMAND REGISTER
+       ISZ     CNT
+       JMP     .-4
+       SDSS
+       JMP     .-1
+       SDRC
+       AND     MSK77
+       TAD     M22
+       SZA     CLA
+       JMP     .-6
+       TAD     DT3000
+       TAD     DTA
+       SDLC
+       CLA     IAC
+       DCA     PHASE
+       JMP  I  .+1
+       PSER+11
+
+
+\f
+*3000
+
+
+SDSQT, 0
+       SDSQ            /ADVANCE SIX LINES
+       JMP     .-1     /SKIP ON QUAD LINE FLAG
+       SDRC            /READ COMMAND REGISTER
+       SDST
+       SKP
+       JMS  I  SELTIM          /TIMING ERROR
+       SDSS
+       JMP     .-1     /SKIP ON SINGLE LINE FLAG
+       SDRC
+       SDST
+       SKP
+       JMS  I  SELTIM          /TIMING ERROR
+       SDSS
+       JMP     .-1
+       SDRC            /READ THE COMMAND REGISTER
+       SDST
+       SKP
+       JMS  I  SELTIM          /TIMING ERROR
+       AND     MSK77   /SAVE THE MARK TRACK LAST 6 BITS
+       DCA     MTR
+       TAD     MTR
+       JMP  I  SDSQT
+
+A3LNS, 0               /ADVANCE THREE LINES
+       SDSS
+       JMP     .-1     /SKIP ON SINGLE LINE FLAG
+       SDRC
+       SDST
+       SKP
+       JMS  I  SELTIM          /TIMING ERROR
+       SDSS
+       JMP     .-1
+       SDRC
+       SDST
+       SKP
+       JMS  I  SELTIM          /TIMING ERROR
+       SDSS
+       JMP     .-1
+       SDRC
+       SDST
+       SKP
+       JMS  I  SELTIM          /TIMING ERROR
+       AND     MSK77
+       DCA     MTR
+       TAD     MTR
+       JMP  I  A3LNS
+
+CEXPC, 0
+       TAD     MTR
+       TAD     M52
+       SZA     CLA
+       JMS  I  MARKER  /MARK TRACK ERROR
+       JMS     A3LNS   /READ THREE MORE LINES
+       TAD     M25     /IS IT 25 NOW
+       SZA     CLA
+       JMS  I  MARKER  /NO ,MARK TRACK ERROR
+       JMP  I  CEXPC   /YES:IT IS EXPAND CODE NUMBER 1
+
+       /SIXBIT COMPLEMENT XOR SUBROUTINE
+       /SUBROUTINE IS ENTERED WITH DATA WORD TO BE XORED IN AC
+       /TWO SIX-BIT COMPLEMENT XORS WILL TAKE PLACE TO LOC CHKSUM
+       /WITH THE RESULT IN CHKSUM
+
+SBCXOR,        0
+       CMA             /COMPLEMENT WORD
+       DCA     SBWORD  /AND SAV
+       TAD     SBWORD
+       AND     CHKSUM
+       CIA
+       CLL     RAL
+       TAD     SBWORD
+       TAD     CHKSUM
+       DCA     CHKSUM
+       TAD     SBWORD
+       RTR CLL;RTR;RTR
+       DCA     SBWORD
+       TAD     SBWORD
+       AND     CHKSUM
+       CIA
+       CLL     RAL
+       TAD     SBWORD
+       TAD     CHKSUM
+       AND     MSK77
+       DCA     CHKSUM
+       JMP  I  SBCXOR
+
+SRDRC, 0
+       SDSQ
+       SKP
+       JMP     .+3
+       SDSS
+       JMP     .-1
+       SDRD
+       DCA     DATRD
+       SDRC
+       AND     MSK77
+       JMP  I  SRDRC
+
+NUDTA, 0
+       TAD  I  LSTPT   /GET CURRENT VALUE OF DATA LIST PTR
+       DCA     TBUFPT  /STORE IT AS TEM,BUF,PTR
+       TAD  I  TBUFPT  /GET A DTA # FROM THE LIST
+       AND     C0007
+       SZA     CLA     /IS IT A 7777
+       JMP     LSTEND  /YES END OF LIST
+       TAD  I  TBUFPT  /NO;GET IT BACK
+       DCA     DTA
+       ISZ  I  LSTPT   /INCREMENT LIST POINTER
+       JMP  I  NUDTA   /RETURN
+/COME HERE AT END OF LIST TO RESET POINTERS AND RETURN TO CALL+2
+LSTEND,        ISZ     NUDTA   /INCREMENT RETURN POINTER
+       TAD  I  STRTPT  /GET ADR OF START OF LIST
+       DCA  I  LSTPT
+       JMP     NUDTA+1 /GO GET FIRST DTA# AND RETURN
+STRTPT,        DBUFAD  /POINTER TO START OF DATA LIST
+TBUFPT,        0               /TEM STORAGE FOR BOT PTR
+LSTPT, DBUFPT          /POINTER TO CURRENT VALUE OF DTA LIST PTR
+
+/CONSTANTS FOR FORMULA TRANSLATION SECTION
+BINCON,        .+1
+       0001
+       0012
+       0144
+       1750
+DTABUF,        0
+
+
+
+
+\f
+*3200
+       /CHECK SWITCH TO SEE IF SET TO WTM POSITION
+SWCHK, JMS  I  TYPE            /TYPE OUT MESSAGE
+       2305                    /SE
+       2440                    /T
+       2327                    /SW
+       1124                    /IT
+       0310                    /CH
+       4024                    /T
+       1740                    /O
+       2724                    /WT
+       1500                    /M
+       JMS  I  TYPIN           /WAIT FOR CR
+       CLA
+       DCA     CNTERL
+       SDLD                    /CLEAR SINGLE AND QUAD FLAGS
+       SDSS
+       SKP
+       JMP     .+4
+       ISZ     CNTERL
+       JMP     .-4
+       JMP     SWCHER          /ERROR,TYPE ERROR MESSAGE AND GO TO SWCHK
+       /SEE IF THE DRIVE IS OK
+RSTSM, SDLC            /LOAD CR TO CLEAR TIMEING ERROR
+       SDLD                    /LOAD DATA BUFFER TO CLEAR S Q FLAGS
+       TAD     DT0400          /SET WRITE
+       TAD     DTA             /GET UNIT
+       DCA     SAV             /STORE IT AWAY
+       TAD     SAV
+       SDSS
+       JMP     .-1
+       SDLC
+       TAD     SAV
+       SDLC                    /LOAD THE TRANSPORT
+       SDRC                    /READ THE COMMAND REGISTER AND CHECK IT
+       RTL
+       RAL
+       SMA                     /CHECK WRITE TO BE SET
+       JMP     ERCHK           /WRITE IS NOT SET
+       RAL                     /CHECK WLO
+       SPA
+       JMP     ERCHK           /WLO 
+       RAL                     /CHECK SELECT AND TIMING ERROR
+       SPA     CLA
+       JMP     ERCHK           /SELECT OR TIMING ERROR
+       JMS     NUDTA           /CHECK OTHER DRIVE IF ANY
+       JMP     RSTSM-11        /CHECK OTHER DRIVE
+       JMP  I  .+1
+       STMK
+CNTERL,        0
+SAV,   0
+
+ERCHK, JMS  I  TYPE            /INCORRECT SETUP
+       2305                    /SE
+       2425                    /TU
+       2077                    /P
+       0000                    /END
+       JMP  I  .+1
+       START
+
+SWCHER,        JMS  I  TYPE
+       2327                    /SW
+       1124                    /IT
+       0310                    /CH
+       4016                    /N
+       1724                    /OT
+       4023                    /S
+       0524                    /ET
+       4024                    /T
+       1740                    /O
+       2724                    /WT
+       1540                    /M
+       1722                    /OR
+       4023                    /S
+       1116                    /IN
+       0714                    /GL
+       0540                    /E
+       1411                    /LI
+       1605                    /NE
+       4006                    /F
+       1401                    /LA
+       0740                    /G
+       0601                    /FA
+       1114                    /IL
+       0504                    /ED
+       4024                    /T
+       1740                    /O
+       2305                    /SE
+       2440                    /T
+       4543                    /CR LF
+       0000                    /END
+       JMP     SWCHK
+
+SWOFF, CLA
+       DCA     CNTERL
+       SDLD                    /CLEAR ANY FLAGS THAT ARE SET
+       SDSS
+       SKP
+       JMP     OFF             /FLAG SHOULDN'T BE SET
+       ISZ     CNTERL
+       JMP     .-4
+       CLA
+       JMP  I  .+1
+       PSER
+
+
+*3400
+/INPUT BUFFER FOR TELETYPE THIS MUST BE AT THE END OF PROGRAM
+
+BUFFER,        0
+
+$
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape5/CCL.PA b/sw/os8/v3d/sources/system/dectapes/dectape5/CCL.PA
new file mode 100644 (file)
index 0000000..2a4c392
--- /dev/null
@@ -0,0 +1,3584 @@
+/56    CCL  FOR  OS/8 V3D
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT  (C)  1974,1975,1976,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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f      MOFILE=7600
+       MIFILE=7617
+       MPARAM=7643
+
+       XR2=15
+       XR=16
+       TXR=17
+       AMFLAG=17
+       T=20
+       TT=21
+       DEF=22
+       NAME1=23
+       NAME2=24
+       NAME3=25
+       NAME4=26
+       NMBASE=27
+       DEV1=30
+       DEV2=31
+       DELIM=32
+       DEFALT=33       /POINTS TO DEFAULT EXTENSION LIST
+       LXR=34
+       CLXR=35
+       PTR=36
+       DATWD=7666
+       BATERR=7000     /JMP HERE TO ABORT BATCH
+       BATOUT=7400     /JMS HERE TO PRINT ON BATCH LOG
+       BATSPL=7200     /JMS HERE TO PERFORM SPOOLING WITH DEFAULT EXT IN AC
+       OS78BIT=7771
+
+       BEGLN=1000
+
+/CCL STARTING ADDRESS: 12000
+/STARTING ADDRESS:     12001
+/CHAIN STARTING ADDRESS:12002
+
+/      JOB STATUS WORD = 2003
+
+/**************************************************
+/
+/              SAVING CCL
+/
+/              .LOAD CCL
+/              .SAVE SYS CCL;12001=2103
+/              .R CCL
+/
+/**************************************************
+
+       CCLSW=435
+       DEASADR=427
+       PRQMRK=1357
+       GETCCL=1362
+       OV=1375
+       MSOVL2=55
+
+       CCLBLK=67       /BLOCK ON SYS: USED BY CCL
+       CCLTAB="G       /MUST BE UPDATED IF TABLES CHANGE
+       CCLNUM="1
+       CCLVER="F       /CCL VERSION #
+
+/*** NOTE: VERSION E OF CCL WAS FOR IN-HOUSE USE ONLY.
+/USE OF SEMICOLONS WITH CCL VERSION I OR LATER
+/REQUIRES BATCH VERSION 7 OR LATER.
+/USE OF BASIC COMMAND REQUIRES V3D BASIC OR LATER
+
+       HNDLR=4400
+       BFR=5000
+
+/MEMORY ALLOCATION:
+
+/0 4400-4777   INPUT HANDLER FOR CD
+/              ALSO, SEMICOLON BUFFER
+/0 5000-5177   PRE-EXTENSION @ BUFFER
+/0 5200-5577   @ BUFFER
+/0 1000-1777   /COMMAND LINE [EACH @ FILE RESTRICTED TO 1 BLOCK]
+/0 2000-2777   /LINE BUFFER EXTENSION
+\f/     CHANGES SINCE FIELD RELEASE VERSION:
+
+/1.    RECURSIVE 'U' BUG FIXED
+/2.    INTERNAL STRUCTURE OF CCL KEYWORD TABLE CHANGED
+/3.    BUG RE REWRITING BLOCK CONTAINING PTR TO CORRECT FORTRAN FIXED
+/4.    .SV PARTS OF FILENAMES REMOVED FROM TABLE TO SAVE SPACE
+/5.    COMPARE PASSES ALTMODE
+/6.    TTY BECAME DEFAULT FOR COMPAR, DIRECT, AND MAP
+/7.    BUG RE PASSING DEFAULT * FIXED
+/8.    .LS FORM OF .CREF COMMAND REMOVED
+/9.    BUG CONCERNING PROCESSOR SWITCHES FIXED
+/10.   CCL SWITCH ALLOWED AFTER =N OPTION
+/11.   BUG RE 'BAD SWITCH OPTION' MESSAGE FIXED
+/12.   EXTRA SPACES NOW ALLOWED BEFORE CCL ARGUMENT
+/13.   'DOES NOT EXIST' MESSAGE NOW SPELLED CORRECTLY
+/14.   'BAD CCL SWITCH' MESSAGE ADDED
+/15.   CCL EDIT # CHANGED TO CCL VERSION #
+/16.   .EX CHAINS TO BCOMP NOT BASIC FOR .BA FILES
+/17.   MUNG PTR: NOW WORKS
+/18.   FIXED BUG RE MUNG <CR>
+/19.   FIXED BUG RE CD FOR FILE > 2047 BLKS
+/20.   FIXED BUG RE MAKE PTR:
+
+/VERSION B FIXES:
+
+/21.   ALLOWED 'EDIT' TO COPY FILE EXTENSION
+/22.   FIXED BUG RE .CCL ON WRITE-LOCKED DEVICE
+/23.   FIXED DATE PROBLEM
+/24.   ALLOWED FF AND VT IN AN INDIRECT FILE TO BE IGNORED
+
+/VERSION C FIXES:
+
+/25.   FIXED BUG RE SPACES AND SLASHES IN MUNG TEXT ARGUMENT
+/26.   ALLOWED EDIT COMMAND TO USE SAME OUT DEVICE
+/       AS IN DEVICE (IF NONE SPECIFIED)
+/27.   ADDED MORE SYNTAX CHECKING TO ZERO COMMAND
+
+/VERSION D CHANGES:
+
+/28.   ALLOWED EDIT A<B COMMAND TO REMEMBER ONLY UP TO '<' .
+
+/VERSION E CHANGES: (IN-HOUSE ONLY VERSION)
+
+/29.   WARNING MSG IF SQUISH SYS: UNDER BATCH
+/30.   ADDED SOME NOTES ON HOW TO ALLOW = AS WELL AS <
+/31.   ADDED HOOKS FOR ; TO BE READY FOR V4
+/32.   FIX BUG RE CMD STARTING WITH SPACES
+
+/CHANGES FOR MAINTENANCE RELEASE (OS/8 V3C):
+
+/33.   FIXED BUG ABOUT @ NOT FOLLOWED BY FILESPEC
+/34.   INCORPORATED ALL PREVIOUS EDITS
+/35.   ALLOWED ' TO TERMINATE AN INDIRECT REQUEST (AND BE IGNORED)
+/36.   FIXED BUG ABOUT EDIT DEV1:_DEV2:FOO LOSING DEV1:
+/37.   CORRECTED SPELLING OF SUPERSEDING
+/38.   ADDED .LD EXTENSION TO EXECUTE TABLES [USES FRTS]
+
+/VERSION G CHANGES:
+
+/39.   FIXED BUG WITH HELP COMMAND
+/40.   FIXED BUG CONCERNING EDIT DEV:_FILE
+
+/VERSION H CHANGES:
+
+/41.   ADDED MAC AND LINK COMMANDS
+/42.   ADDED MACREL AND LINKER INTO COMPILE/LOAD/EXECUTE COMMANDS
+/43.   ALLOWED UX COMMANDS TO CONTAIN KBM COMMANDS
+/44.   ALLOWED PASSING A KBM COMMAND TO CCL ON CHAINING
+/45.   ALLOWED @ AT BEGINNING OF LINE
+/46.   MOVED MOST OF 'DETCOR' TO FIELD 0
+/47.   WAIT ROUTINE  NOW GIVES UP IF TTY FLAG ISN'T UP WITHIN 0.1 SEC
+/48.   ALLOWED EXEC .BI TO USE BATCH
+/49.   TENTATIVELY ADDED SEMICOLON STUFF
+/50.   PUT BACK WARNING MESSAGE IF TRY TO SQUISH UNDER BATCH
+
+/VERSION I CHANGES:
+
+/51.   FIRMED UP SEMICOLON STUFF
+
+/VERSION J CHANGES:
+
+/52.   DEFAULT DEVICE FOR COMPIL, PAL, ETC. IS NOW LOGICAL DSK: NOT SYS:
+/53.   -L, -S, AND -P SWITCHES NOW SET OUTPUT NAME TO CURRENT INPUT NAME
+
+/VERSION K CHANGES:
+
+/54.   DATE NOW HANDLES DATE/78 ALGORITHM
+/55.   TOOK OUT 'TCF' WHICH WAS CAUSING BATCH TO HANG
+
+/VERSION 1A CHANGES:
+
+/56.   FIXED BUG RE NULL INDIRECT CMD FILE
+/57.   FIXED BUG TO NOW ALLOW DATE WITH ARGS IN INIT.CM
+/58.   PRINT "OS78" FOR VERSION NAME IF APPLICABLE
+/59.   ADDED -N AND -D AND REWROTE LOGIC A BIT
+/60.   HELP COMMAND NOW USES HELP.SV
+/61.   SET COMMAND NOW USES SET.SV
+/62.   'CORE' BECOMES 'MEMORY' IN 3 MSGS AND 1 CMD
+/63.   ADDED BASIC COMMAND (CHAINS TO BASIC.SV WITH Q SWITCH)
+/64.   ALLOWED FOR TERMINATE COMMAND (OS78 REPLACES BACKSPACE)
+/65.   ADDED DUPLICATE COMMAND (USES RXCOPY)
+
+/V1B CHANGES:
+
+/66.   MODIFIED FORMAT OF MAIN TABLE
+/67.   GIVE ERROR MESSAGE IF NO FILENAME IS GIVEN WITH INDIRECT
+/      FILE (EVEN IF NON-FS)
+/68.   PRINT KBM VERSION #
+/69.   ADDED TERMINATE COMMAND
+
+/V1F CHANGE:
+
+/70.   DUPL CALLS RXCOPY IN SPECIAL MODE
+\f/     FORMAT OF CCL TABLE
+
+/ENTRY PURPOSE
+
+/      TABLE WIDTH=7 (BUT VARIES)
+
+/0     FLAG WORD
+
+       /BIT    MEANING IF ON
+
+       /0      PERFORM CD (IF 0, OMIT ENTRIES 1-6)
+       /1      DON'T PERMIT SPOOLING
+       /2      ALLOW .LS, .NB, .MP SWITCHES
+       /3      ADD _ TO END OF COMMAND STRING
+       /4      SET OUTPUT EXTENSION = INPUT EXTENSION (IF BIT 2 ON)
+       /6-8    SPECIFIES AUTOMATIC INPUT REMEMBERING (REM LINE MINUS 1)
+       /       0 MEANS NONE.  7 RESERVED FOR SPECIAL USE.
+       /10     CAUSE -L, ETC. TO GO TO 2ND OUTPUT FILE & COPIES NAME
+       /11     WANT DEFAULT ALTMODE (COMPL IF AMFLAG=1)
+
+/1     PTR TO DEFAULT EXTENSION LIST FOR INPUT FILES.
+/      IF PTS TO 0, NONE.   IF PTS TO 5200, USE SPECIAL MODE.
+
+/2-4   DEFAULT SWITCHES TO BE OR'ED INTO THOSE
+/      EXPLICITLY GIVEN.
+
+/5     ADDRESS OF SUBROUTINE TO BE CALLED
+/      AFTER C.D. HAS BEEN DONE.  0 IF NONE.
+
+/6     PTR TO FILENAME OF PROGRAM
+/      TO BE CHAINED TO.  0 IF NONE.
+
+/      FIELD 0
+
+/1000-1777     LINE BUFFER
+/2000-2777     LINE BUFFER EXTENSION
+/4000-4377     REM-LINES
+/4400-4777     HANDLER
+/5000-5577     BUFFER
+/6000-7577     MORE CCL (7 PAGES)
+
+       REST=6000
+\f      FIELD 1
+
+       *2000
+
+       FAKBM=404       /PLACE TO FAKE OUT KBM
+
+START, JMP .+3         /START FROM MONITOR
+       JMP (CCLBLC     /START FROM .RUN COMMAND
+                       /THIS LITERAL IS AT END OF PAGE
+       JMP MONCHN      /START WHEN CHAINED TO
+       CLA
+       CDF 0           /READ IN REST OF CCL
+       TAD I (CCLBLC   /GET BLOCK OF START
+       CDF 10
+       TAD CCLREM
+       DCA CCLREM      /GET BLOCK OF REST
+       CIF 0
+       JMS I (7607
+       700             /READ 7 MORE PAGES
+       REST
+CCLREM,        1+14+1          /SKIP CCB AND *400 STUFF
+       JMP ERR2
+       JMS TWAIT
+       CDF 0
+       TAD I LVNO
+       CDF 10
+       TAD (-CCLTAB    /DO VERSION #'S AGREE?
+       SZA CLA
+       JMP BADVNO
+PREGO, JMS I (AT
+       STA
+       DCA I (REMD     /ALLOW RECURSIVE U'S
+       CDF 0
+       TAD I KENTRY    /GET ENTRY #
+KCIDF, CIF CDF 10
+       TAD (PTBL       /GET ADDRESS OF PTR TO START OF ENTRY
+       DCA PTR
+       TAD I PTR       /GET PTR TO START OF ENTRY
+       DCA PTR
+       JMP I (GOO
+MONCHN,
+KCIF,  CIF 0
+       JMS I (7607     /READ IN KBM
+       1000            /4 BLOCKS
+       0               /0-1777
+       7               /BLOCK 7 ON SYS:
+       HLT             /NO WAY TO RECOVER (EVEN 7605 DOES THIS)
+       TAD (-44
+       JMS I (MOVE     /ASSUME COMMAND LINE IS IN
+       CDF 10          /17600-17643
+       7600
+       CDF 0
+       1000            /MOVE TO OS/8 LINE BUFFER
+       CIF CDF 0
+YAT,   JMP I KFAKBM    /@ DESTROYS THIS CODE (MUST BE ONE BEFORE 'REGO')
+       TAD I (ASSIGN   /'YAT' IS JMS'ED TO
+       SNA CLA         /BY INITIAL @ COMMAND
+       JMP I (LEAVE    /DO NOTHING IF NO @ GOT EXPANDED (NULL LINE)
+REGO,  CIF 0
+       JMS I (7607
+       200             /READ ONE BLOCK
+       400             /400-777
+       10              /RESTORE PART OF KBM WHICH WAS DESTROYED BY OVERLAY
+       HLT
+       JMP I (FAKE
+
+/REGO, TAD KCIDF
+/      CDF 0
+/      DCA I (RETCIF   /ALLOW 'FINDIT' TO RETURN TO FIELD 1
+/      CIF CDF 0
+/      STA
+/      DCA I (HALF
+/      DCA I (ENTRY
+/      TAD (KEYWRD
+/      DCA I (KPTR
+/      JMS I (FINDIT   /LOOK UP KEYWORD
+/      SMA CLA
+/      JMP PREGO       /FOUND IT
+/CMDERR,       JMS I (PRMESG   /NOT A LEGAL KEYWORD
+/      ERRCMD
+\fERR2, CIF CDF 0
+       JMP I (NOCCL
+
+BADVNO,        JMS I (PRINT
+       BADVMS
+       JMS I (VERTN
+       JMP I (LEAVE    /GO AWAY
+\f/TEST END OF TABLE
+
+USRSUB,        0
+       TAD I (REMD
+       SMA CLA
+       JMP REGO        /REMEMBERED A NEW LINE
+       TAD I (FLAG     /WANT TO
+       AND (70
+       CLL RTR
+       RAR
+       TAD (-1         /IN THIS REM-LINE
+       DCA UREM
+       JMS I (FOREVER  /NO DATE
+       JMS I (REMEM
+UREM,  0
+       JMP I USRSUB
+\fTWAIT,        0
+       DCA WFL
+       JMS BATCH
+       JMP TW          /BATCH NOT RUNNING
+       CLA             /WE'RE RUNNING UNDER BATCH
+       JMP I TWAIT
+TW,    TSF
+       SKP             /WAIT FOR THINGS TO QUIET DOWN
+       JMP I TWAIT
+LVNO,  AND I 0         /WASTE SOME TIME
+KFAKBM,        AND I 4
+KENTRY,        600
+       ISZ WFL
+       JMP TW
+       JMP I TWAIT     /CAN'T WAIT TOO LONG
+WFL,   0
+
+/SKIP IF BATCH IS RUNNING AND PUT CIF BATCH FIELD IN AC
+
+BATCH, 0
+       CDF 0
+       TAD I (7777
+       CDF 10
+       DCA BWORD
+       TAD BWORD
+       RTL
+       SNL CLA         /IS BATCH RUNNING?
+       JMP I BATCH     /NO
+       TAD BWORD       /YES
+       AND (70         /ISOLATE FIELD OF BATCH
+       TAD KCIF        /FORM CIF TO THE HIGHEST FIELD
+       ISZ BATCH       /AND TAKE SKIP RETURN WITH IT IN AC
+       JMP I BATCH
+\fBWORD,        0
+       PAGE
+\f/WE FALL INTO THIS FROM LITERAL ON PREVIOUS PAGE
+MONFIX,        JMS I (RDMON
+       CDF 0
+       TAD I ZERO
+       TAD (-7607
+       SNA CLA
+       JMP I PCCER3    /ALWAYS WRITE OUT CCL BLOCK
+       CDF 10
+       CIF 0
+       JMS I L7607
+       4200            /WRITE 1 RECORD FROM FIELD 0
+       400             /LOCATIONS 400-777
+       CCLBLK          /INTO THE SYSTEM'S CCL BLOCK
+       JMP I (IOERR
+       CDF 0
+       TAD I (2000+CCLSW
+       TAD (-PRQMRK
+       SNA
+       JMP MONOK
+       TAD (PRQMRK-GETCCL
+       SZA CLA
+       JMP I PCCER3
+/      CIF CDF 0
+/      JMP I L7605
+MONOK, TAD (GETCCL
+       DCA I (2000+CCLSW
+       STA
+       DCA I (2000+DEASADR     /DELETE DEASSIGN
+       JMS WRMON
+       JMS I (LOOK
+       YFORT           /LOOK FOR FORT.SV
+       TAD (YF4-YFORT  /NOT FOUND, USE F4
+       TAD (YFORT      /FOUND USE IT
+       DCA I (FORTE
+       TAD I (FORTE
+       TAD (-YFORT
+       SZA CLA
+       TAD (YLOAD-YLOADER      /F4
+       TAD (YLOADER
+       DCA I (LOADE
+       JMP I (WRITFT   /UNKLUTZ
+\fL200,
+WRMON, 200
+       CDF 10
+       CIF 0
+       JMS I L7607
+       4200
+L2400, 2400
+       10
+       JMP I (IOERR
+       JMP I WRMON
+\fMONRES,       0
+       JMS I (RDMON
+       CDF 0
+       TAD (PRQMRK
+       DCA I (2000+CCLSW
+       TAD (-405
+       DCA I (2000+DEASADR
+       JMS WRMON
+       JMP I MONRES
+
+L7605,
+SETLPT,        7605            /COULD BE ONCE ONLY
+       TAD KLPTDEV
+       JMS SETDEV
+       JMP I SETLPT
+
+L7607, 7607
+
+M7607,
+SETTTY,        -7607
+       TAD KTTYDEV
+       JMS SETDEV
+       JMP I SETTTY
+
+PCCER3,
+SETPTP,        CCER3
+       TAD (PTPDEV
+       JMS SETDEV
+       JMP I SETPTP
+
+ZERO,                  /STAYS 0 FOR A WHILE
+SETDEV,        0               /V1A ARG NOW IN AC
+       DCA DEVPTR
+       CLL STA RAL     /-2
+       JMS I (MOVE
+       CDF 0
+DEVPTR,        LOC78
+       CDF 10
+       DVNM1
+       JMS I (SETOUT
+       JMP I SETDEV
+
+P4,    SETDEV
+KLPTDEV,LPTDEV
+
+P5,    SETDEV
+KTTYDEV,TTYDEV
+\fFAKE, CIF CDF 0
+       TAD (MSOVL2
+       DCA I (OV       /RESTORE LOC SO DATE CMD W ARGS WILL WORK
+       JMP I (FAKBM
+
+PTCH,  CDF 0
+       DCA I (VLOC
+       TAD I (OS78BIT
+       AND (200        /       78
+       SZA CLA         /       OR
+       TAD (1000       /       /8
+       TAD (5770
+       DCA I DEVPTR
+       CDF 10
+       JMS I (PRMESG
+       VMES
+       PAGE
+\f      COLWRD          /NEEDED BY SET
+GO,    JMS I (SCAN     /ADVANCE SCAN UNTIL AFTER SPACES
+GO2,   TAD I PTR       /GET FLAG
+       DCA FLAG        /SAVE IT
+       TAD DELIM
+       SNA CLA         /IS TYPED LINE EMPTY AFTER KEYWORD?
+       TAD FLAG        /AND IS SPECIAL REMEMBERING BITS ON?
+       CLL RTR
+       RAR             /AND HAS GOD WILLED US TO REMEMBER?
+       AND (7          /AND ARE THE ZODIAK SIGNS FAVORABLE?
+       SNA
+       JMP NORM        /NO
+       TAD REMD        /YES, GET REM-LINE (SUBTRACT 1)
+       DCA REMD
+       CDF 0
+       TAD I (BEGLN
+       CDF 10
+       DCA NMPTR
+       JMS I (RECALL   /RECALL LINE
+REMD,  -1              /-1 MEANS DIDN'T RETRIEVE A REMEMBER LINE
+       DCA DEPN        /SAVE DEPENDENT INFO
+       TAD NMPTR
+       SZA CLA         /EG COMMAND?
+       JMP NORM        /NO
+       ISZ DELIM       /YES
+       TAD DEPN
+       DCA PTR         /RESET PTR FROM CMD DEPENDENT WORD
+       JMP GO2
+\fNORM, TAD FLAG
+L7700, SMA CLA
+       JMP CHAINN      /SKIP ENTRIES IF NO CD
+       ISZ PTR         /POINT TO DEFAULT INPUT EXTENSION
+       TAD I PTR       /GET DEFAULT INPUT EXTENSION PTR
+       DCA DEFALT      /SAVE IT
+       TAD (7641
+       DCA XR
+       TAD FLAG
+       JMS I (GAMFLG
+       DCA I XR        /STORE AWAY IN C.D. OPTION TABLE
+       DCA I XR        /V3D ZERO OPTION WORDS
+       DCA I XR
+       DCA I XR
+       DCA I XR        /ZERO L.O. =
+STOLUP,        ISZ PTR
+       TAD I PTR
+       SNA
+       JMP STODON
+       DCA NTEMP
+       ISZ PTR
+       TAD I PTR       /GET VALUE
+       DCA I NTEMP     /STORE IN SPECIFIED LOCATION
+       JMP STOLUP
+STODON,        TAD FLAG
+       AND (400
+       SZA CLA
+       JMS I (INSARR   /INSERT BACK ARROW IF FLAG BIT SET
+       JMS I (CD       /PERFORM COMMAND DECODE IF FLAG BIT
+                       /0 SET
+CHAI,  TAD FLAG
+       RAL
+       SMA CLA         /IS SPOOLING PROHIBITED?
+       JMS I (SPOOLIT  /NO
+CHAINN,        ISZ PTR         /POINT TO AFTER CD SUBR
+       TAD I PTR       /GET SUBR ADDRESS
+       JMS I (JMSUB
+       TAD I (DEFILE
+       SZA             /IS THERE A FILENAME SET TO CHAIN TO?
+       JMP ZOW         /YES
+       ISZ PTR         /NO, POINT TO FILENAME
+       TAD I PTR
+       SNA
+       JMP I (LEAVE    /NO FILE TO CHAIN TO
+ZOW,   DCA NMPTR
+       JMS LOOK        /LOOKUP FILE
+NMPTR, 0
+       JMP I (CCER1    /NOT FOUND
+CHAIN, JMS I (200      /CHAIN TO IT
+       6               /CHAIN
+DEPN,                  /REM LINE DEPENDENT INFO
+BLK,   0
+/      -----
+\f/LOOK, LOOKS UP FILE ON DEVICE .  POINTER IS IN ARG1
+/      ARG2 IS ERROR RETURN IF NOT FOUND
+/DEVICE NUMBER IS IN AC.  IF 0, USE SYS:
+
+LOOK,  0
+       SNA
+       IAC
+       DCA DEV
+       TAD I LOOK      /GET PTR TO FILE NAME IN FIELD 0
+       DCA HISFIL
+       TAD HISFIL
+       AND L7700
+       SNA CLA
+       JMP FLD1        /PTR LT 100 MEANS IN FIELD 1
+       TAD (-3
+       JMS I (MOVE     /MOVE IT UP
+       CDF 0
+HISFIL,        0
+       CDF 10
+PFILDMY,FILDMY
+       TAD PFILDMY
+SETN,  DCA NAMPTR      /STORE AWAY PTR TO FILENAME
+       ISZ LOOK        /POINT TO ERROR RETURN
+       TAD DEV         /GET DEVICE NUMBER
+       JMS I (200
+       2               /LOOKUP
+NTEMP,
+NAMPTR,        0
+       0
+       JMP I LOOK      /TAKE ERROR RETURN IF NOT FOUND
+       TAD NAMPTR      /STORE STARTING BLOCK # IN 'BLK'
+       DCA BLK
+       ISZ LOOK        /POINT TO NORMAL RETURN
+       JMP I LOOK      /RETURN
+\fFLAG, 0
+DEV,   0
+
+FLD1,  TAD HISFIL
+       JMP SETN
+       PAGE
+\fXEXE, 5033;   EXTEXE; 7643;40;0;      EXSUB;  YPAL8   /EXECUTE MUST BE FIRST FOR TECO EG
+XBAC,  0;                              TRMSUB; YCAMP   /BACKSPACE (OR TERMINATE)
+                                                       /MUST BE 2ND FOR OS78
+XBAS,  0;                              BASUB;  YBASIC  /BASIC
+XDUPL, 4001;   STAR;   0;              0;      YRXCOP  /DUPLIC
+XBOO,  0;                              0;      YBOOT   /BOOT
+XCCL,  0;                              MONRES; 0       /CCL
+XCOMPA,        4001;   EXTNUL; 0;              SETTTY; YSRCCOM /COMPARE
+XCOMPI,        5033;   EXTCOM; 0;              EXSUB;  YPAL8   /COM
+XCOP,  4001;   STAR;   7643;1;0;       MOVRT;  YFOTP   /COPY
+XCOR,  0;                              DETCOR; 0       /MEMORY
+XCREA, 4400;   EXTNUL; 0;              CRSUB;  YEDIT   /CREATE
+XCREF, 4002;   EXTCF;  7643;1000;0;    0;      YPAL8   /CREF
+XDAT,  0;                              DATE;   0       /DATE
+XDEL,  4001;   STAR;   7643;401;0;     KILRT;  YFOTP   /DELETE
+XDEA,  0;                              DEASSIG;0       /DEASSIGN
+XDIR,  4001;   STAR;   7646;COLWRD,0;0;SETTTY; YDIRECT /DIRECT
+XEDI,  5220;   EXTNUL; 0;              EDSUB;  YEDIT   /EDIT
+XEOF,  0;                              0;      YCAMP   /EOF
+XHEL,  4001;   STAR;   7644;20;0;      SETTTY; YHELP   /HELP
+XLINK, 5033;   EXTLI;  0;              EXSUB;  YLINK   /LINK
+XMAC,  5033;   EXTMA;  0;              EXSUB;  YMACREL /MAC
+XLIS,  4001;   STAR;   7644;10;0;      SETLPT; YFOTP   /LIST
+XLOA,  5031;   EXTLO;  0;              EXSUB;  YABSLDR /LOAD
+XMAK,  0;                              MAKSUB; YTECO   /MAKE
+XMAP,  4001;   EXTBN;  0;              SETTTY; YBITMAP /MAP
+XMUN,  0;                              MNGSUB; YTECO   /MUNG
+XPAL,  5033;   EXTPA;  0;              EXSUB;  YPAL8   /PAL
+XPRI,  4000;   STAR;   0;              SETLPT; YLPTSPL /PRINT
+XPUN,  4001;   EXTNUL; 0;              SETPTP; YPIP    /PUNCH
+XREN,  4001;   STAR;   7643;1;7644;100;0;RENRT;YFOTP   /RENAME
+XRES,  4001;   EXTSY;  0;              SETTTY; YRESORC /RESOURCES
+XREW,  0;                              0;      YCAMP   /REWIND
+XSET,  0;                              0;      YSET    /SET
+XSKI,  0;                              0;      YCAMP   /SKIP
+XSQU,  4001;   EXTNUL; 7644;40;0;      SQSUB;  YPIP    /SQUISH
+XSUB,  4000;   EXTBI;  0;              0;      YBATCH  /SUBMIT
+XTEC,  10;                             TECSUB; YTECO   /TECO
+XTYP,  4001;   STAR;   7644;10;0;      SETTTY; YFOTP   /TYPE
+XUNL,  0;                              0;      YCAMP   /UNLOAD
+XUA,   40;                             USRSUB; 0       /UA
+XUB,   50;                             USRSUB; 0       /UB
+XUC,   60;                             USRSUB; 0       /UC
+XVER,  0;                              VERTN;  0       /VERSION
+XZER,  4401;   EXTNUL; 7645;2000;0;    ZERSUB; YPIP    /ZERO
+XAT,   0;                              YAT;    0       /@
+       ZBLOCK 13
+
+GAMFLG,        0
+       CDF 0
+       TAD I PAMFLAG   /COMBINE ALTMODE BITS
+       CDF 10
+       RAR             /IN POSITION 11
+       CLA RAR         /PUT NEW ALTMODE BIT ALONE IN BIT 0
+       JMP I GAMFLG
+PAMFLAG,AMFLAG
+\fTRMSUB,       0
+       CDF 0
+       TAD I POS78
+       CDF 10
+       AND R200
+       SNA CLA
+       JMP I TRMSUB    /BACKSPACE, NOT TERMINATE
+       6073
+       6002
+       CLA             /JUST IN CASE WE'RE NOT ON A VT-78
+       JMS I PPRM
+       BADEV
+POS78, OS78BIT
+R200,  200
+PPRM,  PRMESG
+\fPTBL, XEXE
+       XBAC
+       XBAS
+       XDUPL
+       XBOO
+       XCCL
+       XCOMPA
+       XCOMPI
+       XCOP
+       XCOR
+       XCREA
+       XCREF
+       XDAT
+       XDEL
+       XDEA
+       XDIR
+       XEDI
+       XEOF
+       XHEL
+       XLINK
+       XMAC
+       XLIS
+       XLOA
+       XMAK
+       XMAP
+       XMUN
+       XPAL
+       XPRI
+       XPUN
+       XREN
+       XRES
+       XREW
+       XSET
+       XSKI
+       XSQU
+       XSUB
+       XTEC
+       XTYP
+       XUNL
+       XUA
+       XUB
+       XUC
+       XVER
+       XZER
+       XAT
+       ZBLOCK 4
+\fSTAR, 5200;   0
+       0;      0
+
+
+EXTSY, 2331;   0
+       0;      0
+EXTBI, 0211;   0
+       0;      0
+EXTCF, 2001;   COMPA
+/EXTLS,        1423;   COMLS
+       0;      COMPA
+EXTMA, 1501;   COMMA
+       0;      COMMA
+EXTPA, 2001;   COMPA
+       0;      COMPA
+EXTBN, 0216;   0
+       0;      COMBN
+/EXTHL,        1014;   0
+/      0;      0
+EXTNUL,        0;      0
+EXTLO, 0216;   COMBN   /BN
+       2214;   COMRL   /RL
+EXTLI, 2202;   COMRB   /RB
+       0;      0
+EXTCM, 0315;   0
+       0;      0
+\fEXTEXE,       2001;   COMPA   /PA
+       0624;   COMFT   /FT
+       0201;   COMBA   /BA
+       1501;   COMMA   /MA
+       0216;   COMBN   /BN
+       2214;   COMRL   /RL
+       2201;   COMRA   /RA
+       2302;   COMSB   /SB
+       2202;   COMRB   /RB
+       1404;   COMLD   /LD V3C
+       0211;   COMBI   /BI
+       0;      0
+       ZBLOCK 4
+EXTCOM,        2001;   COMPA   /PA
+       0624;   COMFT   /FT
+       1501;   COMMA   /MA
+       0201;   COMBA   /BA
+       2201;   COMRA   /RA
+       2302;   COMSB   /SB
+       0;      0
+       ZBLOCK 4
+       IFZERO .&7600-3200 <PAGE>
+\fCOMBN,        0
+       JMS USUAL
+       0216
+       YABSLDR
+       JMP I COMBN
+
+COMRL, 0
+       JMS USUAL
+       2214
+LOADE, YLOAD           /MAY BECOME YLOADER
+       JMP I COMRL
+
+COMPA, 0
+       JMS USUAL
+       2001
+       YPAL8
+       JMP I COMPA
+
+COMFT, 0
+       JMS USUAL
+       0624
+FORTE, YF4             /COULD BE CHANGED TO YFORT BY .R CCL
+       JMP I COMFT
+
+COMBA, 0
+       JMS USUAL
+       0201
+       YBCOMP
+       JMP I COMBA
+
+COMRA, 0
+       JMS USUAL
+       2201
+       YRALF
+       JMP I COMRA
+\fCOMSB,        0
+       JMS USUAL
+       2302
+       YSABR
+       JMP I COMSB
+
+COMRB, 0
+       JMS USUAL
+       2202
+       YLINK
+       JMP I COMRB
+
+COMMA, 0
+       JMS USUAL
+       1501
+       YMACREL
+       JMP I COMMA
+
+COMBI, 0
+       JMS USUAL
+       0211
+       YBATCH
+       JMP I COMBI
+
+COMLD, 0
+       JMS USUAL
+       1404
+       YFRTS
+       JMP I COMLD
+\fDEFILE,       0               /PTR TO FILENAME TO CHAIN TO
+
+/COMLS,        0
+/      TAD I (EXTLS
+/      DCA SETEXT
+/      TAD (YCREF
+/      DCA DEFILE
+/      ISZ I (DONB     /CREF FOO.LS MAKES NO BINARY
+/      JMP I COMLS
+
+RDMON, 0
+       CDF 10
+       CIF 0
+       CLA
+       JMS I (7607
+       0400            /READ 2 RECORD
+       2000            /LOCATION 2000 FIELD 0
+       7               /BLOCK 7,10
+       JMP I (IOERR
+       JMP I RDMON
+
+USUAL, 0
+       TAD I USUAL
+       DCA SETEXT
+       ISZ USUAL
+       TAD I USUAL
+       DCA DEFILE
+       ISZ USUAL
+       JMP I USUAL
+\fUNKN, 0
+       TAD SETEXT
+       SZA
+       TAD T           /NEG OF SWITCH REQUEST
+       SZA CLA
+       JMP I (CCERA    /CAN'T HAVE 2ND DEFAULT EXTENSION
+       TAD T
+       CIA
+       DCA SETEXT      /SET DEFAULT EXTENSION
+       TAD DEFALT      /SEE IF IT'S IN COMMAND'S SEARCH LIST
+       DCA DEF
+       TAD SETEXT
+       JMS I (EXTLUK
+       SNA CLA         /DID WE FIND IT?
+       JMP I (CDER4    /NO
+       ISZ DEF         /YES
+/      TAD I (JMSUB    /ALLOW RECURSIVE CALL
+/      DCA HOLD
+       TAD I DEF
+       JMS I (JMSUB    /CALL ITS SUBR
+/      TAD HOLD
+/V1A RECURSIVE CALL NO LONGER THREATENS
+/      DCA I (JMSUB
+       JMP I UNKN
+
+SETEXT,        0               /EXT WHICH HAS BEEN SET BY A CCL SWITCH
+
+SEMERR,        TAD (SEMSG-1
+       DCA UNKN
+       TAD I UNKN
+       DCA .+2
+       JMS I (PRMESG
+       SEMSG1
+\fWRITFT,       JMS I (LOOK
+       YCCL
+       JMP I (IOERR    /CCL.SV NOT FOUND
+       TAD I (BLK
+       TAD (4          /*3400 IS 4TH BLOCK OF CCL NOT COUNTING CCB
+       DCA FBLK
+       CDF 10
+       CIF 0
+       JMS I (7607
+       4210            /WRITE 1 RECORD FROM FIELD 1
+       3400            /LOCS 3400-3777
+FBLK,  0
+       JMP I (IOERR
+       CIF CDF 0
+       JMP I (7605
+       PAGE
+\fCD,   0
+       JMS I (200
+       13              /RESET ALL HANDLERS
+       JMS I (CDINIT
+BEGGRP,        TAD OUTSW
+       SNA CLA
+       TAD I (BEGDIF   /DIFF BETWEEN INPUT & OUTPUT AREAS
+       TAD (MOFILE-1
+       DCA CLXR
+       JMS I (GETSPC
+       JMS I (ASSIGN
+       TAD OUTSW
+       SNA CLA
+       TAD I (LIMDIF   /DIFF BETWWEN END OF OUTPUT & INPUT AREAS
+       TAD I (OUTLIM   /END OF OUTPUT AREA
+       TAD CLXR
+       SMA CLA
+       JMP I (CDER1
+       JMS I (CCLSWT
+       TAD OUTSW
+       SNA CLA
+LKUPSW,        JMP INFILE      /ZEROED IF IN "SPECIAL DECODE" MODE
+       TAD I (DVICE
+       JMS PCLXR
+       TAD NAME1
+       JMS PCLXR
+       TAD NAME2
+       JMS PCLXR
+       TAD NAME3
+       JMS PCLXR
+       TAD NAME4
+       JMP LSTPUT
+INFILE,        JMS I (LOOKUP
+       JMS PCLXR       /STORE LENGTH AND DEV NUMBER
+       TAD I (LNAME    /GET BLOCK
+LSTPUT,        JMS PCLXR
+       TAD OUTSW
+       SNA CLA
+       TAD I (FLAG
+       CLL RTL
+       SPA CLA         /FEATURE ENABLED?
+       TAD LKUPSW
+       SNA CLA
+       JMP DLOOK       /IN SPECIAL MODE OR ON OUTPUT SIDE
+       TAD DONB
+       SZA CLA
+       JMP NBS
+       TAD (7600       /V1A NOW TAKES ARG IN AC
+       JMS I (NMOVE    /MOVE NAME TO OUTPUT FILE NAMES
+       JMP DLOOK
+\fNBS,  DCA DONB        /ZERO 1ST OUTPUT FILE
+       TAD (7577
+       DCA XR2
+       DCA I XR2
+       DCA I XR2
+       DCA I XR2
+       DCA I XR2
+       DCA I XR2
+DLOOK, STA
+       DCA I (DVFLAG
+       TAD DELIM
+       SNA
+       JMP I CD
+       TAD (-"[
+       SNA
+       JMP I (OLENGT
+       TAD ("[-",
+       SNA
+       JMP I (FILLP    /**** JUMPING INTO ROUTINE (IS THIS A BUG?)
+       TAD (",-"<
+       SNA
+       JMP BKAROW
+       TAD ("<-"=
+       SZA CLA
+       JMP I (CDER2    /BAD CHAR
+/ THIS STUFF WOULD ALLOW = AS WELL AS < AND _
+/*** HAVE TO FIX 'BKA' ROUTINE
+/      JMS I (GLXR
+/      JMS I (DECODE
+/      STL
+/      STA             /LINK=0 MEANS LETTER
+/      TAD LXR         /NOW LINK=1 MEANS LETTER
+/      DCA LXR
+/      SZL
+/      JMP BKAROW
+       DCA I (NUMFUJ
+       JMS I (NUMBER
+       DCA I (MPARAM+3
+       CLA CLL CML RAR
+       AND I (MPARAM-1 /PRESERVE  ALTMODE
+       TAD I (HIORD
+       DCA I (MPARAM-1
+       JMS I (CCLSWT
+       JMP DLOOK
+BKAROW,        ISZ OUTSW
+       JMP I (CDER2    /TWO BACK-ARROWS
+       TAD LXR         /GET PTR TO ARROW
+       DCA I (ARLOC    /SAVE IT ('EDIT' MIGHT NEED IT)
+       JMP BEGGRP
+
+PCLXR, 0
+       ISZ CLXR
+       DCA I CLXR
+       JMP I PCLXR
+\fDONB, 0               /ENTRY PT USED AS FLAG
+       JMP I DONB
+
+OUTSW, -1              /-1 MEANS ON OUTPUT SIDE, 0 ON INPUT SIDE
+
+P6,    SETDEV
+       TVDEV
+       PAGE
+\fNUMBER,       0
+       SZA CLA
+       TAD (NUM&177+1200-SKP
+       TAD (SKP
+       DCA NUMADD/SET NUMADD TO EITHER "SKP" OR "TAD NUM"
+       DCA HIORD
+NUMLP, DCA NUM
+       JMS I (GCH
+       ISZ NUMKNT
+       SKP
+       JMP EONUM2
+       CMA
+       TAD NUMFUJ
+       TAD ("8         /TEST INPUT CHARACTER FOR RANGE
+       CLL CMA         /0-7 IF NUMFUJ=0
+       TAD (10         /0-9 IF NUMFUJ=2
+       TAD NUMFUJ
+       SNL
+       JMP EONUM
+       DCA T
+       CLA CLL CMA RTL
+       DCA DELIM
+       TAD NUM
+ROTLP, CLL RAL
+       DCA NUMX
+       TAD HIORD
+       RAL
+NUMSKP,        SPA             /MODIFIED BY #
+       JMP I (CDER5
+       DCA HIORD
+       TAD NUMX
+       ISZ DELIM
+       JMP ROTLP
+NUMADD,        TAD NUM         /SKP IF OCTAL
+       TAD NUM
+       TAD T
+       JMP NUMLP
+EONUM, TAD ("0
+EONUM2,        DCA DELIM
+       TAD NUMKNT
+       SPA CLA
+       JMP I (CDER5    /FEWER THAN CORRECT NUMBER OF DIGITS
+       TAD NUM
+       JMP I NUMBER
+
+NUM,   0
+NUMFUJ,        0
+NUMKNT,        0               /SET TO -N-1 TO FORCE N DIGITS
+HIORD, 0
+\fASSIGN,       0
+       TAD CLXR
+       AND I (DVFLAG
+       TAD I (OUTLIM
+       SMA SZA CLA     /CHECK FOR OUTPUT OR FIRST INPUT
+       JMP ASNORM      /IF DEVICE WAS SPECIFIC,
+                       /OR IF WE ARE ON THE INPUT SIDE,
+                       /PROCEED NORMALLY
+       TAD NAME1
+       SNA CLA
+       JMP ASGNST
+       TAD DFLTNM+1
+       DCA DEV2
+       TAD DFLTNM
+       DCA DEV1
+ASNORM,        TAD DEV1
+       DCA AS+1
+       TAD DEV2
+       DCA AS+2
+       TAD I (OUTSW
+       SNA CLA         /DON'T LOAD HANDLER
+                       /IF WE ARE ON OUTPUT SIDE OF "_"
+       TAD NAME1
+SPKLG1,        SNA CLA         /OR THERE IS NO FILE NAME TO LOOK UP
+       TAD GETHND      /GETHND=11 NORMALLY,
+                       /0 IF IN "SPECIAL DECODE" MODE
+       IAC
+       DCA AS
+       TAD (HNDLR+1    /ALLOW TWO PAGE HANDLERS
+       DCA ASADR
+       CIF 10
+       JMS I (200
+NUMX,
+AS,    0
+       0
+       0
+ASADR, HNDLR+1
+       JMP I (CDER0
+       TAD AS+2
+ASGNST,        DCA I (DVICE
+       JMP I ASSIGN
+\fDFLTNM,       DEVICE DSK
+GETHND,        11              /1+11=12 (1=FETCH, 12=INQUIRE)
+
+LOVE,  0
+       TAD NAME1
+       TAD (-1417
+       SZA CLA
+       JMP I LOVE
+       TAD NAME2
+       TAD (-2605
+       SZA CLA
+       JMP I LOVE
+       TAD NAME3
+       TAD NAME4
+       SZA CLA
+       JMP I LOVE
+       JMS I (PRINT
+       LOVMES
+       JMP I LOVE
+
+FILDMY,        FILENAME DUMMY.SV
+
+SEMSG, SEMSG1
+       SEMSG2
+       SEMSG3
+       SEMSG4
+       PAGE
+\f/GETS A NAME FROM FIELD ZERO BUFFER VIA LXR
+/RETURNS WITH DELIMETER IN AC
+/GIVES ERROR MESSAGE IF NAME IS BAD
+
+TN,                    /DON'T CALL CCLSWT FROM GNAME UNLESS THIS IS MOVED
+GNAME, 0
+       DCA NAME1
+       DCA NAME2
+       DCA NAME3
+       DCA NAME4
+       TAD (NAME1
+       DCA NMBASE
+       CLA CMA
+       DCA PERDSW
+       DCA NAMECT
+       JMS I (GCH
+       TAD (-"#
+       SNA
+       JMP NUMCON
+       TAD ("#
+       SKP
+GTNMLP,        JMS I (GCH
+       DCA DELIM
+       TAD DELIM
+       TAD (-"?
+       SZA
+       TAD ("?-"*
+       SNA
+STARSW,        JMP I (CDER6    /"JMP STARNM"
+                       /IF "SPECIAL DECODE" MODE
+       TAD ("*-".
+       SNA CLA
+       JMP PERIOD
+       TAD DELIM
+       JMS I (DECODE
+       JMP LV
+STARNM,        CLA             /THIS CODE HANDLES *'S AND ?'S CORRECTLY
+       TAD DELIM
+       AND (77
+       DCA DELIM
+       TAD NAMECT
+       TAD (-6
+       SMA CLA
+       JMP GTNMLP
+       TAD NAMECT
+       CLL RAR
+       TAD NMBASE
+       DCA TT
+       TAD DELIM
+       SNL
+       JMS I (ROTL
+       TAD I TT
+       DCA I TT
+       ISZ NAMECT
+       JMP GTNMLP
+PERIOD,        TAD NAME1
+       SZA CLA
+       ISZ PERDSW
+       JMP I (CDER7    /NULL NAME OR DOUBLE EXTENSION
+       ISZ NMBASE
+       TAD (4
+       DCA NAMECT
+       JMP GTNMLP
+\fCCLSWT,       0
+       TAD DELIM
+       TAD (-"-
+       SZA CLA
+       JMP I CCLSWT
+       TAD I (OUTSW
+       SZA CLA
+       JMP I (CDER4    /CCL EXT ON OUTPUT FILE
+       TAD (SWTCHS
+       DCA DEF
+       JMS GETL
+       JMP I (CDER44   /NON-ALPHANUMERIC CCL SWITCH
+       JMS I (ROTL
+       DCA TN
+       JMS GETL
+       JMP XLK2        /ONE CHAR CCL SWITCH
+       TAD TN
+       DCA TN
+       JMS GETL
+XLK2,  SKP CLA         /2 CHAR CCL SWITCH
+       JMP I (CDER44   /3 CHAR CCL-SWITCH
+       TAD TN
+       JMS I (EXTLUK
+       CLA
+       ISZ DEF
+       TAD I DEF
+       DCA GETL        /GET PTR TO ARGUMENT PAIR
+       TAD I GETL      /GET SUBROUTINE
+       DCA PERDSW
+       ISZ GETL
+       TAD I GETL      /GET ARGUMENT
+       JMS I PERDSW    /CALL SUBR, ARG IN AC
+       JMP CCLSWT+1
+\fGETL, 0
+       JMS I (GCH
+       DCA DELIM
+       TAD DELIM
+       JMS I (DECODE
+       JMP I GETL      /NON-ALPHANUM IN CCL SWITCH
+       CLA
+       TAD DELIM
+       AND (77
+       ISZ GETL
+       JMP I GETL
+
+NUMCON,        JMS I (NUMC
+LV,    CLA
+       TAD DELIM
+       JMP I GNAME
+
+PERDSW,        0
+NAMECT,        0
+       PAGE
+\fLOOKUP,       0
+       DCA LNAME
+       TAD NAME1
+       SNA CLA
+       JMP LKUPST
+       TAD I (PERDSW
+       TAD NAME4
+       SNA CLA
+       CLA IAC         /FORCE NAMERM NON-0 IF . AND NO EXT
+       TAD NAME4
+       DCA NAMERM      /REMEMBER TYPED EXTENSION
+       TAD DEFALT
+       DCA DEF
+       TAD I (SETEXT
+       SNA             /HAS AN EXTENSION BEEN SET?
+       TAD NAMERM      /NO
+       SNA             /DOES FILE HAVE EXTENSION?
+       JMP EXT2        /NO EXTENSION TYPED OR SET, DO SUCCESSIVE LOOK-UPS
+       JMS EXTLUK      /LOOK FOR EXTENSION
+       SNA CLA         /DID WE FIND IT?
+       JMP EXT3        /NO, FORCE NULL EXTENSION TO MATCH
+EXT2,  TAD I DEF
+       IAC
+       SNA CLA
+       JMP NEXTEXT     /IGNORE -1'S
+       TAD NAMERM
+       SZA CLA
+       JMP EXT3
+       TAD I DEF
+       DCA NAME4       /SET NEW EXTENSION
+EXT3,  TAD (NAME1
+       DCA LNAME
+       TAD I (AS+2
+       JMS I (200
+       2
+LNAME, 0               /NAME1
+LENGTH,        0
+       JMP LFAILD
+       ISZ DEF         /POINT TO FOLLOW-UP SUBROUTINE
+       TAD I DEF
+       JMS JMSUB       /CALL IT
+       TAD LENGTH
+       CLL
+       TAD (400
+       SNL
+CLACON,        7600            /CLA
+       CLL RTL
+       RTL
+       AND (7760
+LKUPST,        TAD DVICE
+       JMP I LOOKUP
+\fLFAILD,       TAD NAMERM
+       SNA CLA         /WAS THERE AN EXPLICIT EXTENSION?
+       TAD I DEF       /NO - WAS THERE A DEFAULT EXTENSION?
+       SNA CLA
+       JMP I (CDER3    /NO DEFALT EXTENSION OR YES EXPLICIT EXTENSION
+NEXTEXT,ISZ DEF                /NO EXPLICIT EXT AND YES DEFAULT EXT
+       ISZ DEF         /POINT TO NEXT POSSIBLE DEFAULT EXTENSION
+       JMP EXT2        /AND TRY FOR IT
+
+NAMERM,        0
+DVICE, 0
+
+EXTLUK,        0
+       CIA
+       DCA T
+XLUK,  TAD I DEF
+       SNA             /AT NULL?
+       JMP I EXTLUK    /YES
+       TAD T           /NO
+       SNA CLA         /MATCH?
+       JMP MAT         /YES
+       ISZ DEF         /NO
+       ISZ DEF         /POINT TO NEXT ENTRY
+       JMP XLUK        /TRY AGAIN
+MAT,   TAD I DEF       /RETURN WITH IT IN AC
+       JMP I EXTLUK
+
+TS,
+ZERSUB,        0
+       TAD I (7601
+       SNA CLA         /WAS FILENAME SPECIFIED ON ZERO CMD?
+       TAD I CLACON    /OR WAS NO OUT DEVICE SPECIFIED?
+       SNA CLA
+       JMP I (CDER2    /YES... ERROR
+       JMP I ZERSUB    /NO, OKAY.
+\fIOERR,        JMS I (PRMESG
+       SYSER
+
+EXSUB, 0
+       TAD BASPTR      /PUSH PTR BACK TO BEGIN OF ENTRIES
+       JMS I (REMEM    /REMEMBER THIS IN DEPENDENT WORD
+       2
+       JMP I EXSUB
+
+JMSUB, 0
+       SNA
+       JMP I JMSUB
+       DCA TS
+       JMS I TS
+       JMP I JMSUB
+\fSPOOLIT,0
+       JMS I (BATCH    /IS BATCH RUNNING?
+       JMP I SPOOLIT   /NO
+       DCA CB          /YES
+       TAD I DEFALT
+       TAD (-5200
+       SNA CLA
+       TAD I DEFALT    /LEAVE 5200 IN AC IF SPECIAL MODE
+CB,    HLT             /CIF TO FIELD OF BATCH
+       JMS I (BATSPL   /ALLOW BATCH TO SPOOL STUFF
+       JMP I SPOOLIT
+
+GOO,   TAD PTR
+BASPTR,        DCA BASPTR
+       JMP I (GO
+       PAGE
+\fSLSHCH,       0
+       DCA DELIM
+       TAD (MPARAM-1
+       DCA T
+       TAD DELIM
+       JMS DECODE
+       JMP CDER8
+       SZL
+       TAD (32
+       CMA STL         /THE FOLLOWING TURNS
+                       /ON THE CORRECT OPTION BIT
+       DCA TT
+SLSHLP,        SZL
+       ISZ T
+       RAR
+       SNL
+       ISZ TT
+       JMP SLSHLP
+       DCA TT
+       TAD TT
+       CMA
+       AND I T
+       TAD TT
+       DCA I T
+       JMP I SLSHCH
+
+/THIS ROUTINE DETERMINES IF THE CHARACTER IN THE AC IS A LETTER OR DIGIT
+/IF LETTER, RETURNS TO RET+1 WITH LETTER-"A IN AC AND LINK=0
+/IF DIGIT, RETURNS TO RET+1 WITH DIGIT-"0 IN AC AND LINK=1
+/IF NEITHER, RETURNS TO RET WITH CHAR-"A IN AC.
+DECODE,        0
+       TAD (-"9-1      /MIGHT BE CALLED WITH ANY DF
+       CLL
+       TAD ("9+1-"0
+       SZL
+       JMP DCDYES
+       TAD ("0-"Z-1
+       CLL CML
+       TAD ("Z-"A+1
+       SNL
+DCDYES,        ISZ DECODE
+       JMP I DECODE
+
+CDER8, CLA
+       JMS I (PRMESG
+       BADOPT
+\fZEROCD,       0
+       TAD (-42        /AC MAY BE NON-0
+       DCA T
+       TAD (MOFILE-1
+       DCA XR
+       DCA I XR        /ZERO THE COMMAND DECODER OUTPUT AREA
+       ISZ T
+       JMP .-2
+       JMP I ZEROCD
+
+GCH,   0
+       JMS GLXR
+       TAD (-240
+       SNA
+       JMP GCH+1
+       TAD (240-"/
+       SNA
+       JMP SLASH
+       TAD ("/-"(
+       SNA
+       JMP OPENP
+       TAD ("(
+       JMP I GCH
+SLASH, JMS GLXR
+       JMS SLSHCH
+/*** CAN'T PUT /A:VAL HERE BECAUSE GCH AINT RECURSIVE
+       JMP GCH+1
+OPENP, JMS GLXR
+       TAD (-")
+       SNA
+       JMP GCH+1
+       TAD (")
+       JMS SLSHCH
+       JMP OPENP
+
+GLXR,  0
+       CDF 0
+       ISZ LXR
+       TAD I LXR
+       CDF 10
+       JMP I GLXR
+\fOLENGT,       TAD I (OUTSW
+       AND NAME1       /[N] IS ONLY LEGAL
+                       /ON THE OUTPUT SIDE OF THE "_"
+       SNA CLA         /AND ONLY AFTER A FILE NAME
+       JMP I (CDER2
+       TAD (-4
+       TAD CLXR
+       DCA NMBASE
+       CLA CLL CML RTL
+       DCA I (NUMFUJ   /SET "NUMBER" TO ACCEPT
+                       /DIGITS 8 AND 9
+       STA             /ALLOW DECIMAL
+       JMS I (NUMBER
+       CLL RTL
+       RTL
+       AND (7760
+       TAD I NMBASE
+       DCA I NMBASE
+       CDF 0
+       TAD DELIM
+       TAD (-"]        /IS THERE A CLOSING BRACKET?
+       SNA             /IF NOT,
+                       /"DLOOK" ROUTINE WILL DETECT IT
+       JMS GCH
+       DCA DELIM
+       JMP I (DLOOK
+\fBASUB,        0
+       TAD (200        /SET /Q SWITCH
+       DCA I (MPARAM+1
+       JMP I BASUB
+       PAGE
+\fPRMESG,       0
+       CLA
+       TAD I PRMESG
+       DCA .+2
+       JMS PRINT
+       HLT
+LEAVE, JMS I (TWAIT
+/V3D   TCF
+       CIF CDF 0
+       TAD FATALFLG
+       SNA CLA
+       JMP I (7605
+FATALFLG,0             /CIF CDF BATCH FIELD IF WANT TO ABORT
+       JMP I (BATERR
+
+PRWD,  0
+       DCA T
+       TAD T
+TTY212,        RTR
+       RTR
+       RTR
+       JMS PCHAR
+       TAD T
+       JMS PCHAR
+       JMP I PRWD
+
+PCHAR, 0
+       AND (77
+       SNA
+       JMP I PCHAR     /IGNORE NULLS
+       TAD (240
+       AND (77
+       TAD (240        /CAN'T USE 'TTY240'
+       JMS TYPE
+       JMP I PCHAR
+
+PRNAME,        0
+       TAD NAME1
+       JMS PRWD
+       TAD NAME2
+       JMS PRWD
+       TAD NAME3
+       JMS PRWD
+       TAD NAME4
+       SNA CLA
+       JMP I PRNAME
+       TAD (256
+       JMS PCHAR
+       TAD NAME4
+       JMS PRWD
+       JMP I PRNAME
+\fTYPE, 0
+       DCA TE2
+       JMS I (BATCH
+       JMP TTYOUT
+       DCA CIFB
+CIFB,  HLT             /REPLACED BY CIF BATCH FIELD
+       TAD TE2
+       JMS I (BATOUT
+       TAD TE2
+       TAD (-"#
+TTY240,        SZA CLA
+       JMP I TYPE
+       TAD CIFB
+       IAC             /CONVERT CIF TO CIF CDF
+       DCA FATALFLG
+       JMP I TYPE
+
+TTYOUT,        TAD TE2
+       TAD (-"#        /DON'T TYPE #'S
+       SNA CLA
+       JMP I TYPE
+       TAD T7600
+       KRS
+       TAD (-7603
+       SNA
+       JMP LEAVE
+       TAD (203-217
+       SNA CLA
+       JMP I TYPE
+       TAD TE2
+TJUMP, JMP .+3
+       TSF
+       JMP .-1
+       TLS
+T7600, 7600
+       TAD (7000
+       DCA TJUMP
+       JMP I TYPE
+\fPRINT,        0
+       DCA CRLF        /AC NON-0 MEANS DON'T CRLF
+       TAD I PRINT
+       ISZ PRINT
+       DCA TE
+PRINTP,        CDF 0
+       TAD I TE
+       CDF 10
+       JMS PRWD
+       CDF 0
+       TAD I TE
+       CDF 10
+       ISZ TE
+       AND (77
+       SZA CLA
+       JMP PRINTP
+       TAD CRLF
+       SNA CLA
+       JMS CRLF
+       JMP I PRINT
+TE,    0
+TE2,   0
+\fCRLF, 0
+       TAD (215
+       JMS TYPE
+       TAD TTY212
+       JMS TYPE
+       JMP I CRLF
+
+CDER2, JMS PRMESG
+       BADSYN
+
+P1,    NMOVE
+       7605
+       PAGE
+\fCCERB,        JMS I (PRMESG
+       BADSW
+CDER1, JMS I (PRMESG
+       TOOMAN
+CDER5, JMS I (PRMESG
+       BADNUM
+CCER1, TAD I (NAMPTR
+       DCA NMX
+       TAD (-4
+       JMS I (MOVE
+       CDF 10
+NMX,   0
+       CDF 10
+       NAME1
+CDER3, TAD (4300
+       JMS I (PRWD     /#
+       JMS I (PRNAME
+       JMS I (PRMESG
+       NF
+
+CCER2, TAD I (DVNM1
+       DCA DEV1
+       TAD I (DVNM2
+       DCA DEV2
+CDER0, TAD DEV1
+       SNA CLA
+       JMP I (CDER2    /B DOES NOT EXIST
+       TAD (4300       /#
+       JMS I (PRWD
+       TAD DEV1
+       JMS I (PRWD
+       TAD DEV2
+       JMS I (PRWD
+       JMS I (PRMESG
+       DNE
+\fKILRT,        0
+       JMS I (PRINT
+       KILMES
+       JMP I KILRT
+
+RENRT, 0
+       JMS I (PRINT
+       RENMES
+       JMP I RENRT
+
+MOVRT, 0
+       JMS I (PRINT
+       MOVMES
+       JMP I MOVRT
+
+SWTCHS,        1423;   P1      /LS
+       1602;   P2      /NB
+       1520;   P3      /MP
+       1400;   P4      /L
+       2400;   P5      /T
+       2300;   P6      /S
+       2000;   P7      /P
+       0400;   P8      /D
+       1600;   P9      /N
+       0000;   P10     /UNKNOWN
+       ZBLOCK 2        /PATCH ROOM FOR USER
+
+P2,    DONB
+       0
+
+P3,    NMOVE
+       7612
+
+P7,    SETDEV
+       PTPDEV
+
+P9,    SETDEV
+       NULDEV
+
+P10,   UNKN
+       0
+\fSCAN, 0
+       TAD (BEGLN
+       DCA T
+       CDF 0
+       JMS BLSCAN      /IGNORE INITIAL SPACES
+       JMP CHK
+NOBLUP,        CLA
+       ISZ T
+       TAD I T
+CHK,   SNA
+       JMP ENDOFB
+       JMS I (DECODE
+       SKP CLA
+       JMP NOBLUP
+       JMS BLSCAN
+ENDOFB,        DCA DELIM
+       STA
+       TAD T
+       CDF 10
+       DCA I (LBEGIN
+       JMP I SCAN
+
+BLSCAN,        0
+       TAD I T
+       TAD (-240
+       SZA
+       JMP BL2
+       ISZ T
+       JMP BLSCAN+1
+BL2,   TAD (240
+       JMP I BLSCAN    /LEAVE CHAR IN AC
+       PAGE
+\f      ALTMODE=233
+
+SETPA, 0
+       JMS I (SETX
+       "P;"A           /KEEP HERE TO MAKE EASY TO PATCH
+       JMP I SETPA
+
+MAKSUB,        0
+       TAD DELIM
+       SNA CLA
+       JMP CMDERR      /DON'T ALLOW MAKE <CR>
+       JMS SETLXR
+       JMS I (GETSPC
+       JMS I (LOVE
+       JMS TECPUT
+       "E;"W;0
+       JMS TECMOV
+       JMS SETPA
+       JMS TECPUT
+       ALTMODE;0
+       JMS I (CHKSUP
+       JMS I (REMEM
+       0
+       JMP I MAKSUB
+
+SETLXR,        0
+       TAD I (LBEGIN
+       DCA LXR
+       TAD (MOFILE-1
+       DCA I (TYR
+       TAD (-5         /ZERO OPTION TABLE TOO
+       JMS I (ZEROCD
+       TAD LXR
+       DCA SAVLXR
+       JMP I SETLXR
+
+/PUT FOLLOWING CHARS INTO TECO BUFFER VIA TXR
+
+TECPUT,        0
+/      TAD NAME1
+/      SNA CLA
+/      JMP I (CDER2
+       TAD I TECPUT
+       ISZ TECPUT
+       SNA
+       JMP I TECPUT
+       JMS I (TPUT
+       JMP TECPUT+1
+\f/MOVE CHARS FROM FIELD 0 LINE BUFFER
+/FROM SAVLXR+1 TO LXR-1 INCLUSIVE
+/INTO TECO LINE BUFFER AT 17600
+
+TECMOV,        0
+       TAD SAVLXR
+       DCA XR2
+       TAD SAVLXR
+       CMA
+       TAD LXR
+       SNA CLA
+       JMP I (CDER2    /NO FILE SPEC
+TECL,  CDF 0
+       TAD I XR2
+       CDF 10
+       JMS I (TPUT
+       TAD XR2
+       CMA
+       TAD LXR
+       SNA CLA
+       JMP I TECMOV
+       JMP TECL
+\fTECSUB,       0
+       JMS SETLXR
+       JMS I (GETSPC
+       TAD DELIM
+       SNA
+       JMP TECNORM
+       TAD (-"<        /ALLOW "_" AS WELL AS "<"
+       SNA
+       JMP EXTEN
+       TAD ("<-"_
+       SZA CLA
+       JMP I (CDER2
+EXTEN, CDF 0
+       DCA I LXR       /CHANGE < TO 0
+       CDF 10
+       JMS TECPUT
+       "E;"W;0
+       JMS TECMOV
+       JMS SETPA
+       TAD LXR
+       DCA SAVLXR
+       JMS I (CHKSUP
+       JMS I (GETSPC
+       JMS TECPUT
+       ALTMODE;"E;"R;0
+       JMS TECMOV
+       JMS SETPA
+       JMS TECPUT
+       ALTMODE;"Y;0
+       JMP TECLV
+\fTECNORM,JMS TECPUT
+       "E;"B;0
+       JMS TECMOV
+       JMS SETPA
+       JMS TECPUT
+       ALTMODE;"Y;0
+TECLV, JMS I (REMEM
+       0
+       JMP I TECSUB
+SAVLXR,        0
+
+CMDERR,        JMS I (PRMESG   /NOT A LEGAL KEYWORD
+       ERRCMD
+       PAGE
+\fTPUT, 0
+       AND (177        /TECO LIKES 7-BIT
+       ISZ TYR
+       DCA I TYR
+       TAD TYR
+       TAD (-7646      /CHECK FOR OVERFLOW OF CD AREA
+       SZA CLA
+       JMP I TPUT
+CDER9, JMS I (PRMESG
+       TOOLNG
+
+MNGSUB,        0
+       JMS I (SETLXR
+       JMS I (GETSPC
+       JMS I (TECPUT
+       "E;"R;0
+       JMS I (TECMOV
+       JMS SETX
+       "T;"E
+EXTOK, JMS I (TECPUT
+       ALTMODE;"Y;"H;"X;"Y;"H;"K;"I;0
+       TAD DELIM
+       SNA
+       JMP IFIN
+       TAD (-",
+       SZA CLA
+       JMP I (CDER2
+G,     STL CLA RAR     /PREVENT 'GCH' FROM HANDLING SPACE AND /
+       JMS I (GCH
+       AND (177        /GET RID OF HIGH ORDER BIT
+       SNA
+       JMP IFIN
+       JMS TPUT
+       JMP G
+IFIN,  JMS I (TECPUT
+       ALTMODE;"M;"Y;0         /MACRO GETS CALLED WITH POINTER PAST CHARS
+       JMP I MNGSUB
+TYR,   0
+\f/SET DEFAULT EXTENSION
+
+SETX,  0
+       TAD I SETX
+       DCA C1
+       ISZ SETX
+       TAD I SETX
+       DCA C2          /FALL THRU 2ND EXT
+       TAD NAME4
+       SNA CLA
+       TAD NAME1
+       SNA CLA
+       JMP I SETX
+       TAD I TYR       /GET LAST CHAR (NO EXT)
+       TAD (-56        /WAS IT A DOT?
+       SNA CLA
+       JMP I SETX      /YES
+       JMS I (TECPUT   /NO, USE DEFAULT EXTENSION
+       ".
+C1,    0
+C2,    0
+       0
+       TAD C1
+       AND (77
+       JMS I (ROTL
+       DCA C1
+       TAD C2
+       AND (77
+       TAD C1
+       DCA NAME4
+       JMP I SETX
+
+CCERA, JMS I (PRMESG
+       CONTRA
+\fCRSUB,        0
+       TAD I (7617
+       SNA CLA         /BETTER BE NO INPUT
+       TAD I (7600     /ANYTHING THERE?
+       SNA CLA
+       JMP I (CDER2    /NO OUTPUT OR YES INPUT
+       JMS EDSUB       /REMOVE BACK-ARROW AND REMEMBER CREATE LINE
+       JMP I CRSUB
+
+EDSUB, 0
+       CDF 0
+       DCA I ARLOC     /REPLACE ARROW BY NULL
+       CDF 10
+       JMS I (REMEM    /REMEMBER NEW COMMAND LINE
+       1
+       JMP I EDSUB
+
+ARLOC, .               /LOCATION OF BACK-ARROW IN COMMAND LINE
+                       /'.' IS HARMLESS PTR IN CASE NO ARROW
+
+CCER3, CDF 10
+       JMS I (PRMESG
+       BADMON
+
+CDER4, CLA
+       JMS I (PRMESG
+       BADSW
+CDER44,        CLA
+       JMS I (PRMESG
+       BADSW2
+CDER7, JMS I (PRMESG
+       BADX
+CDER6, JMS I (PRMESG
+       BADSTR
+       PAGE
+\fINSARR,       0
+       TAD (BEGLN
+       DCA XR
+       CDF 0
+       TAD I XR
+       SZA CLA
+       JMP .-2
+       STA
+       TAD XR
+       DCA XR
+       TAD ("<
+       DCA I XR
+       DCA I XR
+       CDF 10
+       STA
+       TAD XR
+       DCA I (ARLOC    /REMEMBER WHERE WE INSERTED A "_"
+       JMP I INSARR
+
+BKA,   0
+       TAD I (LBEGIN
+       DCA CLXR
+GG,    CDF 0
+       ISZ CLXR
+       TAD I CLXR
+       CDF 10
+       SNA
+       JMP NOBKAR
+       TAD (-"<
+       SNA
+       JMP I BKA
+       TAD ("<-"_
+       SZA CLA
+       JMP GG
+       TAD ("<
+       CDF 0
+       DCA I CLXR
+       CDF 10
+       JMP I BKA
+NOBKAR,        ISZ BKA
+       JMP I BKA
+\fAT,   0
+       CIF CDF 0
+       JMS I (SEMI
+ATMORE,        TAD (BEGLN-1
+       DCA LXR
+ATLOOP,        JMS I (GLXR
+       SNA
+       JMP I AT
+       TAD (-300
+       SZA CLA
+       JMP ATLOOP
+       TAD LXR
+       DCA I (SAVL
+       JMS I (FUDG
+       JMS I (GETSPC
+       JMS I (ASSIGN
+       DCA I (SETEXT
+       TAD (EXTCM
+       DCA DEFALT
+       JMS I (LOOKUP
+       SZA CLA         /V3C
+       TAD I (ASADR
+       SNA
+       JMP I (ATERR    /IF NO FILESPEC AFTER @, ERROR
+       DCA T
+       TAD I (LNAME    /GET BLOCK NUMBER
+       DCA BLN
+       CIF 0
+       JMS I T
+       200             /READ 2 PAGES
+NWB,   BFR+200         /INTO BUFFER
+COUNT,
+BLN,   0               /FROM THIS BLOCK
+       JMP I (ATERR    / I/O ERROR
+       TAD (-200
+       DCA COUNT
+       TAD (BFR-1
+       DCA XR
+       TAD NWB
+       DCA T
+       CDF 0
+ALP,   TAD I T
+       JMS I (P
+       CLL RTR
+       RTR
+       DCA BKA
+       ISZ T
+       TAD I T
+       JMS I (P
+       CLL RTL
+       RTL
+       RAL
+       TAD BKA
+       JMS I (P
+       CLA
+       ISZ T
+       ISZ COUNT
+       JMP ALP
+       JMP I (ATOVER
+
+/ATFIN,        TAD LXR
+/      TAD (-BEGLN
+/      SZA CLA
+/      JMP I AT        /LEAVE
+/      JMP I (LEAVE    /LEAVE BECAUSE LINE NOW EMPTY
+       PAGE
+\fP,    0
+       AND (177
+       SNA
+       JMP CTZ         /END AT 0 OR ^Z
+       TAD (-32
+       SNA
+       JMP CTZ
+       TAD (32-16      /IGNORE CR,LF,FF,VT
+       CLL
+       TAD (16-12
+       SZL
+       JMP POGO
+       TAD (212        /FORCE 8-BIT
+       DCA I XR
+POGO,  CLA
+       TAD I T
+       AND (7400
+       JMP I P
+\fCTZ,  CDF 10
+       TAD LXR
+       DCA ATEND
+       STA
+       TAD LXR
+       DCA LXR         /INCASE @ GOES TO EOL
+       JMS I (GLXR     /SEARCH FOR EOL
+       SZA CLA
+       JMP .-2
+       TAD LXR
+       CMA
+       TAD ATEND
+       DCA ENDLEN
+       TAD XR
+       CMA
+       TAD (BFR        /GET LENGTH OF INSERTED STUFF
+       DCA NEWLEN
+       CDF 0
+       TAD I ATEND     /GET NEXT CHAR AFTER FILESPEC
+       CDF 10          /V3C
+       TAD (-"'
+       SZA CLA         /IS IT AN APOSTROPHE?
+       JMP .+3         /NO
+       ISZ ENDLEN      /YES
+       ISZ ATEND       /MAKE IT GO AWAY
+       TAD ENDLEN
+       JMS I (MOVE     /MOVE REST OF LINE UP
+       CDF 0
+ATEND, 0               /FIRST CHAR POSITION AFTER @ SPEC
+       CDF 0
+       BEGLN+1000
+       TAD NEWLEN      /IF 0, 'MOVE' WILL IGNORE IT
+       JMS I (MOVE     /MOVE IN NEW STUFF
+       CDF 0
+       BFR
+       CDF 0
+SAVL,  0               /POINTS TO @
+       TAD NEWLEN
+       CIA
+       TAD SAVL
+       DCA NEWEND
+       CLL
+       TAD NEWEND
+       TAD (-BEGLN-1000
+       SZL CLA
+       JMP ATOVER
+       TAD ENDLEN
+       JMS I (MOVE     /MOVE BACK END
+       CDF 0
+       BEGLN+1000
+       CDF 0
+NEWEND,        0               /FIRST POSITION AFTER NEW STUFF
+       JMP I (ATMORE   /LOOK FOR MORE
+\fATOVER,       JMS I (PRMESG
+       OVFLOW
+GETMP,
+ENDLEN,        0               /- NO. OF CHARS AT END INCLUDING 0
+
+NUMC,  0
+       TAD (SKP
+       DCA I (NUMSKP
+       TAD (-11
+       DCA I (NUMKNT
+       JMS I (NUMBER
+       DCA NAME2
+       TAD I (HIORD
+       DCA NAME1
+       STA
+       TAD LXR
+       DCA LXR
+       TAD (-11
+       DCA I (NUMKNT
+       JMS I (NUMBER
+       DCA NAME4
+       TAD I (HIORD
+       DCA NAME3
+       TAD (SPA
+       DCA I (NUMSKP
+       JMP I NUMC
+\fNEWLEN,                       /- NO. OF CHARS BEING INSERTED
+GETYR, 0
+       AND (7
+       DCA GETMP
+       CDF 0
+       TAD I (7777
+       CDF 10
+       CLL RTR
+       RTR
+       AND (30
+       TAD GETMP
+       JMP I GETYR
+       PAGE
+\f/     TAD (-# OF LOCS TO MOVE
+/      JMS MOVE
+/      FROM CDF
+/      FROM LOC
+/      TO CDF
+/      TO LOC
+
+MOVE,  0
+       DCA T
+       TAD I MOVE      /GET FROM CDF
+       DCA FRCDF
+       ISZ MOVE
+       STA
+       TAD I MOVE      /GET FROM LOC-1
+       DCA XR
+       ISZ MOVE
+       TAD I MOVE      /GET TO CDF
+       DCA TOCDF
+       ISZ MOVE
+       STA
+       TAD I MOVE      /GET TO LOC-1
+       DCA XR2
+       ISZ MOVE        /POINT TO RETURN
+       TAD T
+       SNA CLA
+       JMP I MOVE      /V1A IGNORE 0 MOVE
+FRCDF, HLT
+       TAD I XR
+TMP1,
+TOCDF, HLT
+       DCA I XR2
+       ISZ T
+       JMP FRCDF
+       CDF 10
+       JMP I MOVE
+\fDETCOR,       0
+       CIF 0
+       JMP I (CORE
+       JMP I DETCOR
+
+BADCOR,        JMS I (PRINT
+       NOCORE
+GOEQ,  CIF CDF 0
+       JMP I (COREQ
+
+ABSCOR,        JMS I (PRINT
+       CORMES
+       JMP I DETCOR
+
+WRSCOR,        JMS I (PRINT
+       BATCOR
+       JMP GOEQ
+
+SCRM,  JMS I (PRINT
+       SCRMES
+       JMP I DETCOR
+\fSQSUB,        0
+       TAD I K7600
+       SZA CLA
+       JMP I SQSUB
+       TAD I (7617
+       DCA I K7600
+       JMS I (BATCH    /IS BATCH RUNNING?
+       JMP I SQSUB     /NO
+K7600, 7600            /YES (CLEAR AC)
+       TAD I K7600
+       TAD (7647-1     /POINT INTO DEVICE HANDLER RESIDENCY TABLE
+       DCA TMP1
+       TAD I TMP1      /GET HANDLER STARTING ADDRESS
+       TAD (-7607
+       SZA CLA         /IS SQUISHED DEVICE SYS:?
+       JMP I SQSUB     /NO
+       JMS I (PRINT
+       SQWARN          /YES, WARN USER
+       JMP I SQSUB
+\fSETOUT,       0
+       TAD I (FLAG
+       RTR
+       SZL CLA
+       TAD (5
+       TAD K7600
+       DCA OLOC
+       TAD I OLOC
+       SZA CLA
+       JMP I SETOUT    /HE'S SPECIFIED SOMETHING
+       JMS I (200
+       12              /INQUIRE
+DVNM1, 0
+DVNM2, 0
+       0
+       JMP I (CCER2    /NO SUCH DEVICE
+       TAD DVNM2
+       DCA I OLOC
+       TAD OLOC
+       AND (5
+       SNA CLA         /USING 2ND OUT DEV?
+       JMP I SETOUT    /NO
+       ISZ OLOC        /YES
+       TAD (-4
+       JMS MOVE
+       CDF 10
+       NAME1
+       CDF 10
+OLOC,  7600            /INITIALLY 7600 OR 7605
+       JMP I SETOUT
+\fENGOA,        TAD (-5
+       JMS I (ZEROCD
+       CDF 0
+       TAD I (BLKNO
+       CDF 10
+       DCA I (7620
+       CLA IAC
+       DCA I (7617     /'CCBTCH' IS ON SYS:
+       TAD (20         /   /T OPTION
+       DCA I (7644
+       TAD (20         /  ALSO /H (HUSH) OPTION
+       DCA I (7643
+       TAD (YBATCH
+       JMP I (ZOW      /CHAIN TO BATCH
+       PAGE
+\fDATE, 0
+       TAD I (DATWD
+       SNA
+       JMP NODATE
+       DCA DATEM
+       TAD DATEM
+       CLL RTL
+       RTL
+       RAL
+       AND (17
+       DCA TM1
+       TAD TM1
+       TAD (MONLST-1
+       DCA TM2
+       CDF 0
+       TAD I TM2
+       CDF 10
+       DCA MONP
+       TAD DATEM
+       JMS I (GETYR    /V3D DATE/78 ALGORITHM
+       DCA TM2
+       TAD TM2
+       TAD (106        /70.
+       CIF CDF 0
+       JMS I (OTODY
+       DCA YEAR
+       TAD DATEM
+       CLL RTR
+       RAR
+       AND (37
+       DCA DATEM
+       TAD DATEM
+       CIF CDF 0
+       JMS I (OTODY
+       DCA DAY
+       CDF 0
+       STL CLA RTL     /2
+       TAD TM2
+       CLL RTR
+       SNL SMA
+       JMP LEAP
+       ISZ I (JAN
+       ISZ I (FEB
+LEAP,  AND (37
+       TAD TM2
+       TAD (3
+       TAD DATEM
+       DCA DATEM
+       TAD TM1
+       TAD (JAN-1
+       DCA TM1
+       TAD I TM1
+       CDF 10
+       TAD DATEM
+DIV7,  CLL
+       TAD (-7
+       SZL
+       JMP DIV7
+       TAD (7
+       TAD (WEEKLST
+       DCA TM2
+       CDF 0
+       TAD I TM2
+       CDF 10
+       DCA WKP
+       STA             /DON'T CRLF
+       JMS I (PRINT
+WKP,   0
+       STA
+       JMS I (PRINT
+       DAYDAY
+       STA
+       JMS I (PRINT
+MONP,  0
+       STL CLA RAR
+       JMS I (PRWD     /SPACE
+       TAD DAY
+       JMS I (PRWD
+       STA
+       JMS I (PRINT
+       COM19
+       TAD YEAR
+       JMS I (PRWD
+       JMS I (CRLF
+       JMS I (LOOK     /LOOKUP SYS:DATE.SV
+       YDATE
+       JMP I DATE      /DO NOTHING IF IT'S NOT THERE
+       JMP I (CHAIN    /CHAIN TO IT, IF IT'S THERE
+\fNODATE,       JMS I (PRMESG
+       NONE
+DT,    0
+TM2,   0
+DATEM, 0
+DAY,   0
+YEAR,  0
+\fSETDSK,       0
+       TAD DSKDEV
+       SZA
+       JMP I SETDSK
+       JMS I (200
+       12              /INQUIRE
+       5723            /PACKED ENCODING FOR 'DSK:'
+DSKDEV,        0               /SET TO DEVICE NUMBER
+       0
+TM1,   HLT             /NO 'DSK' !
+       TAD DSKDEV
+       JMP I SETDSK
+       PAGE
+\f/CCL REMEMBERS UP TO 8 COMMAND LINES (EACH UP TO 55 DECIMAL
+/SIXBIT CHARACTERS LONG) IN BLOCK 65 ON THE SYSTEM DEVICE.
+/THIS BLOCK WHEN READ INTO 04000-04377 HAS THE FOLLOWING FORMAT:
+
+/4000-4037     REM-LINE 0
+/4040-4177     REM-LINE 1
+/4100-4137     REM-LINE 2
+/4140-4177     REM-LINE 3
+/4200-4237     REM-LINE 4
+/4240-4277     REM-LINE 5
+/4300-4337     REM-LINE 6
+/4340-4377     REM-LINE 7
+
+/EACH REM-LINE HAS THE FOLLOWING FORMAT:
+
+/WORD 0:       IN-USE FLAG, MUST BE '1234' TO INDICATE LINE WAS REMEMBERED HERE
+/WORD 1:       DATE LINE WAS REMEMBERED
+/WORD 2:       COMMAND DEPENDENT INFORMATION
+/WORD 3:       RESERVED FOR FUTURE EXPANSION
+/WORDS 4-37    COMMAND LINE NOT INCLUDING KEYWORD OR FOLLOWING SPACES
+/              PACKED IN 6-BIT AND TERMINATED BY A 6-BIT 0.
+
+/ROUTINES:
+
+/      TAD (DEP
+/      JMS REMEM
+/      N
+
+/REMEMBERS CURRENT LINE IN REM-LINE N.  AC IS LINE DEPENDENT INFORMATION.
+/IF LINE IS TOO BIG, THIS PRINTS A WARNING MESSAGE AND RETURNS AS IF OK.
+
+/      JMS RECALL
+/      N
+
+/RECALLS REM-LINE N INTO BUFFER
+/IF NOTHING THERE, PRINTS A BAD SYNTAX MESSAGE AND RETURNS TO OS/8.
+/UPON RETURN, LINE-DEPENDENT INFO IS IN AC.
+/IF DATES DON'T MATCH, IT'S NOT THERE UNLESS DATE = -1
+
+/0     USED BY TECO, MAKE COMMANDS
+/1     USED BY EDIT, CREATE COMMANDS
+/2     USED BY COMPILE, EXECUTE COMMANDS & PAL.
+/      DEPENDENT WORD IS PTR TO FIRST ENTRY IN MAIN TABLE
+
+/3     USED BY 'UA' COMMAND
+/4     USED BY UB
+/5     USED BY UC
+
+/      JMS FOREVER
+
+/CAUSES NEXT CALL TO REMEM TO INSERT -1 AS DATE
+\f      REMSPACE=4000
+       REMBLOCK=65
+
+REMEM, 0
+       DCA DEP
+       TAD I (REMD
+       SMA CLA
+       JMP I REMEM     /DON'T REMEMBER IF JUST RECALLED
+       JMS I (RDREM
+       JMP I (MEMBIG
+       TAD I REMEM
+       ISZ REMEM
+       CLL RTL
+       RTL
+       RAL             /MULTIPLY BY 40
+       TAD (REMSPACE
+       DCA LPTR
+       TAD (1234
+       CDF 0
+       DCA I LPTR
+       CDF 10
+       ISZ LPTR
+FORVR, TAD I (DATWD    /REPLACED BY CMA IF WANT NO DATE
+       JMS LPUT        /STORE DATE
+       TAD DEP
+       JMS LPUT        /STORE DEPENDENT INFO
+       JMS LPUT        /RESERVED
+       JMS I (SCAN     /GO PAST KEYWORD AND BLANKS
+       TAD I (LBEGIN
+       DCA XR
+RELUP, JMS I (GETF
+       JMP LZER
+       JMS I (ROTL
+       DCA TML
+       JMS I (GETF
+       JMP RZER
+       TAD TML
+       JMS LPUT
+       JMP RELUP
+RZER,  TAD TML
+LZER,  JMS LPUT
+       JMS I (WRREM
+       JMP I (MEMBIG
+REMGO, JMP I REMEM
+\fDEP,  0
+LPTR,  0               /PTS TO REM-LINE
+TML,   0               /TEMP
+
+/PUT INTO REM-LINE
+
+LPUT,  0
+       DCA TML
+       TAD LPTR
+       AND (37
+       SNA CLA
+       JMP I (MEMBIG
+       TAD TML
+       CDF 0
+       DCA I LPTR
+       CDF 10
+       ISZ LPTR
+       JMP I LPUT
+
+FOREVER,0
+       TAD LCMA
+       DCA FORVR
+       JMP I FOREVER   /NON-ZERO MEANS SET DATE TO -1
+\fRECALL,       0
+       JMS I (RDREM
+       JMP I (REMERR
+       TAD I RECALL
+       ISZ RECALL
+       JMS I (ROTL
+       RAR
+       TAD (REMSPACE
+       DCA LPTR
+       JMS LGET
+       TAD (-1234
+       SZA CLA
+       JMP I (REMER2
+       JMS LGET
+       SNA
+       JMP I (REMER2
+LCMA,  CMA
+       SNA
+       JMP FOREV
+       IAC
+       TAD I (DATWD    /SAME DAY?
+       SZA CLA
+       JMP I (REMER2
+FOREV, JMS LGET
+       DCA DEP
+       JMS LGET        /IGNORE RESERVED WORD
+       CLA
+       TAD (BEGLN-1
+       DCA XR
+       TAD (BEGLN-1
+       DCA I (LBEGIN
+RECLUP,        JMS LGET
+       DCA TML
+       TAD TML
+       JMS I (ROTL
+       RAL
+       JMS I (PUTF
+       JMP RECLV
+       TAD TML
+       JMS I (PUTF
+       JMP RECLV
+       JMP RECLUP
+
+RECLV, TAD DEP
+       JMP I RECALL
+\fLGET, 0
+       CDF 0
+       TAD I LPTR
+       CDF 10
+       ISZ LPTR
+       JMP I LGET
+       PAGE
+\fPUTF, 0
+       AND (77
+       SNA
+       JMP PUTZ
+       ISZ PUTF
+       TAD (240
+       AND (77
+       TAD (240
+PUTZ,  CDF 0
+       DCA I XR
+       CDF 10
+       JMP I PUTF
+
+CHKSUP,        0
+       JMS FUDG
+       JMS I (ASSIGN
+       TAD NAME1
+       SNA CLA
+       JMP I CHKSUP    /CAN'T SUP IF NO FILENAME
+       TAD I (DVICE
+       JMS I (LOOK     /LOOK UP FILE
+       NAME1
+       JMP I CHKSUP    /NOT FOUND (GOOD)
+       JMS I (PRINT
+       SUP
+       JMP I CHKSUP
+
+REMERR,        JMS I (PRMESG
+       REMBAD
+REMER2,        JMS I (PRMESG
+       BADREM
+\fMEMBIG,       CLA
+       JMS I (PRINT
+       MEMWARN
+       JMP I (REMGO
+
+RDREM, 0
+       CIF 0
+       JMS I (7607
+       200             /READ 2 PAGES INTO FIELD 0
+       4000            /LOCATION 4000
+       REMBLOCK
+       SKP CLA
+       ISZ RDREM
+       JMP I RDREM
+
+WRREM, 0
+       CIF 0
+       JMS I (7607
+       4200            /WRITE 2 PAGES FROM FIELD 0
+       4000            /LOCATION 4000
+       REMBLOCK
+       SKP CLA
+       ISZ WRREM
+       JMP I WRREM
+
+FUDG,  0
+       DCA I (OUTSW    /LOAD HANDLER
+       TAD I (OUTLIM
+       CIA
+       DCA CLXR
+       JMP I FUDG
+\fK8,   0
+       TAD (1716
+       JMS I (PRWD
+       TAD (1431
+       JMS I (PRWD
+       CIF CDF 0
+       JMP I K8
+
+ROTL,  0
+       CLL RTL
+       RTL
+       RTL
+       JMP I ROTL
+
+/GET FROM INPUT LINE VIA XR
+
+GETF,  0
+       CDF 0
+       TAD I XR
+       CDF 10
+       SZA
+       ISZ GETF
+       AND (77
+       JMP I GETF
+\f/THIS GETS A DEV:NAME.EXT SPECIFICATION (USING LXR)
+/PUTTING RESULT IN DEV1,DEV2, NAME1-4.
+/IT GIVES A FATAL ERRORR MESSAGE IF BAD.
+GETSPC,        0
+       STA
+       DCA DVFLAG
+       DCA DEV1
+FILLP1,        DCA DEV2
+FILLP, JMS I (GNAME
+       TAD (-":        /AC CONTAINED DELIM
+       SNA CLA
+       JMP DEVNAM
+       DCA I (NUMC
+       JMP I GETSPC
+DEVNAM,        CLA IAC
+       TAD I (PERDSW
+       TAD I (NUMC
+       SZA CLA
+       JMP CDERA       /. OR # IN DEVICE NAME
+       TAD NAME1
+       DCA DEV1
+       ISZ DVFLAG
+       JMP CDERA       /CATCHES A:B:
+       TAD NAME2
+       JMP FILLP1
+
+DVFLAG,        0
+\fCDERA,        JMS I (PRMESG
+       BADEV
+
+ATERR, CDF 10
+       CLA
+       JMS I (PRMESG
+       ATIO
+       PAGE
+\fCDINIT,       0
+       TAD I DEFALT
+       TAD (-5200
+       SZA CLA         /IS THIS A REQUEST FOR A
+                       /"SPECIAL DECODE"?
+       JMP CDCONT      /NO
+       TAD ALTLIM
+       DCA OUTLIM      /YES, SET UP THE PROPER LOCATIONS
+       TAD ALTDF1
+       DCA LIMDIF      /TO GET 1 OUTPUT AND 5 INPUT FILES
+       TAD ALTDF2
+       DCA BEGDIF      /ALL OF WHICH ARE
+                       /5-WORD <DEVICE,NAME> ENTRIES
+       DCA I PLKUPS
+       TAD STARJM
+       DCA I PSTARS    /AND ALLOW *
+                       /AS A FILE OR EXTENSION NAME
+       TAD CCLA        /STOPS FETCHES IN SPECIAL MODE
+       DCA I PSPKG1    /NO HANDLER FETCHES NECESSARY EITHER
+                       /SINCE NO LOOKUPS
+CDCONT,        JMS I (BKA
+       STA
+       DCA I (OUTSW
+       JMS I (ZEROCD
+       TAD LBEGIN
+       DCA LXR
+       JMP I CDINIT
+/CONSTANTS NECESSARY TO SUPPORT "SPECIAL DECODE" MODE
+ALTLIM,        1-MOFILE-5
+ALTDF1,        MOFILE+5-MPARAM+5
+ALTDF2,        5
+PLKUPS,        LKUPSW
+PSTARS,        STARSW
+PSPKG1,        SPKLG1
+
+BEGDIF,        MIFILE-MOFILE
+LIMDIF,        MIFILE-MPARAM+2
+OUTLIM,        1-MIFILE
+LBEGIN,        0               /PTS TO 1 CHAR BEFORE COMMAND KEYWORD ARGUMENT
+\fNMOVE,        0
+       DCA PT1         /V1A ARG IN AC
+       TAD I (FLAG
+       RTL
+       SMA CLA         /FEATURE ENABLED?
+       JMP I (CCERB    /NO
+       TAD I (OUTSW
+       SZA CLA
+       JMP I (CCERB    /ON OUTPUT SIDE
+       TAD I CCLA      /V3C
+       SNA CLA         /DON'T CHANGE OUT DEV IF SPECIFIED
+       TAD I (FLAG     /LOOK AT 'COPY EXT' BIT
+       AND (200
+       SNA CLA
+       JMP NMXXX               /IT WASN'T SET
+       TAD I (7617     /GET FIRST INPUT DEVICE
+       AND (17         /ISOLATE DEVICE BITS
+       DCA I CCLA      /FORCE THIS TO BE FIRST OUTPUT DEVICE
+NMXXX, TAD I PT1
+       SNA
+       JMS I (SETDSK   /CHANGE TO 'IAC' TO ALWAYS USE SYS:
+       DCA I PT1       /SET DEVICE TO SYS IF NONE
+       ISZ PT1
+       TAD I PT1       /WAS THERE A SPECIFICATION THERE?
+       SZA CLA
+       JMP I NMOVE     /YES, DO NOTHING
+       TAD I (FLAG
+       AND (200        /GET 'COPY EXTENSION' BIT
+L7740, SMA SZA CLA     /'SMA' IS UNNECESSARY
+       STA             /COPY 4 WORDS IF BIT 4 WAS ON
+       TAD (-3         /OTHERWISE ONLY COPY 3 WORDS
+       JMS I (MOVE
+       CDF 10
+       NAME1
+       CDF 10
+TEM,
+PT1,   0
+       JMP I NMOVE
+
+P8,    SETDEV
+       DMPDEV
+\fVERTN,        0
+       JMS I (RDMON    /READ MONITOR
+       CDF 0
+       TAD I (2031     /GET PATCH LEVEL
+       SNA
+       TAD ("!
+       AND (77
+       DCA TEM
+       TAD I (2000     /GET VERSION #
+       CDF 10
+       SPA
+CCLA,  7600            /"0" MEANS OLD
+       TAD (60
+       JMS I (ROTL
+       TAD TEM
+       JMP I (PTCH
+\f/ALLOW DEASSIGN FOO ?
+
+DEASSIGN,0
+       TAD L7740
+       DCA XR
+       TAD (-17
+       DCA T
+       DCA I XR
+       ISZ T
+       JMP .-2
+       CDF 0
+       TAD I (7746
+       AND (6777
+       TAD (1000
+       DCA I (7746
+       CDF 10
+       JMP I DEASSIGN
+\fSTARJM,       RELOC STARNM    /DUMP LITERALS AT LAST POSSIBLE MOMENT
+       JMP STARNM
+       RELOC
+       PAGE
+       ZBLOCK 7600-.
+\f/CCL.SV (THE IMPORTANT PART) MUST BE A SINGLE CORE-LOAD
+/CONTIGUOUS LOAD, BECAUSE OF THE WAY THE MONITOR LOADS IT.
+/FORTUNATELY, FIELD 0 STUFF OCCURS AFTER FIELD 1 STUFF IN THE
+/OS/8 CORE-IMAGE FORMAT.
+/FOR VERSION OF THE MONITOR BEFORE LEVEL A,
+/THE TOTAL LENGTH OF CCL.SV MUST BE LESS THAN14 BLOCKS
+/OR IT READS OVER 7600.
+/BUT NOW CCL COMES IN AND READS THE REMAINDER OF ITSELF
+/INTO FIELD 0.  400-777 IS IGNORED BY SKIPPING A BLOCK,
+/THEN THER REST OF CCL (7 PAGES) IS READ IN.
+
+       FIELD 0
+
+       *400
+
+/IT LOADS OVER THE SAVE, DATE OVERLAY
+/AND STARTS AT LOCATION 600
+
+/KEYWORD TABLE IN 400-
+
+/CONSISTS OF COMMANDS 2 CHARS PER LOCATION
+/IN 5-BIT ASCII (ONLY LETTERS ARE LEGAL)
+/SEPARATED FROM EACH OTHER BY 6-BIT 00'S.
+/EACH ENTRY STARTS ON A WORD BOUNDARY, BUT IF YOU
+/NEED THE ROOM, THEY NEED NOT WITH A SIMPLE FIX
+/BIT 40 ON MEANS THAT THE CHARACTER ISN'T REQUIRED
+/BUT IF THE USER DOES TYPE A LETTER, IT MUST MATCH.
+\fVNO,  CCLTAB
+KEYWRD,
+0530   /EX ECUT
+4543
+6564
+0002   /BA CKSP OR TER MIN
+0143
+5363
+6000
+0201   /BAS IC
+2351
+4300
+0425   /DU PLICATE
+6054
+5143
+4164
+4500
+0217   /BO OT
+5764
+0003   /CCL
+0314
+0003   /COMPA R
+1715
+2001
+6200
+0317   /COM PIL
+1560
+5154
+0003   /COP Y
+1720
+7100
+1505   /MEM ORY
+1557
+6271
+0003   /CREA TE
+2205
+0164
+4500
+0322   /CREF
+0506
+0004   /DA TE
+0164
+4500
+0405   /DEL ETE
+1445
+6445
+0004   /DE A
+0541
+0004   /DIR ECT
+1122
+4543
+6400
+0504   /ED IT
+5164
+0005   /EO F
+1746
+0010   /HE LP
+0554
+6000
+1411   /LIN K
+1653
+0015   /MAC R
+0103
+6200
+1411   /LI ST
+6364
+0014   /LO AD
+1741
+4400
+1501   /MAK E
+1345
+0015   /MAP
+0120
+0015   /MUNG
+2516
+0700
+2001   /PAL
+1400
+2022   /PRI NT
+1156
+6400
+2025   /PU NCH
+5643
+5000
+2205   /REN AME
+1641
+5545
+0022   /RES
+0523
+0022   /REW IND
+0527
+5156
+4400
+2305   /SET
+2400
+2313   /SK IP
+5160
+0023   /SQ UISH
+2165
+5163
+5000
+2325   /SU BMIT
+4255
+5164
+0024   /TE CO
+0543
+5700
+2431   /TY PE
+6045
+0025   /UN LOAD
+1654
+5741
+4400
+2501   /UA
+0025   /UB
+0200
+2503   /UC
+0026   /VE R
+0562
+0032   /ZERO
+0522
+1700
+4000   /@
+       ZBLOCK 600-.
+\f      IFDEF XYZMCR <
+
+THIS IS THE TECO MACRO WHICH WAS USED TO CREATE THE ABOVE TABLE:
+
+
+HKGYJ2S\ 1\eR0,.KHXAHKMA
+\ 1TYPE COMMANDS, SPACE SEPARATES MANDATORY PART FROM
+OPTIONAL PART, CR TERMINATES COMMANDS, ^Z TERMINATES ALL.
+**  NO EDITING **
+\ 1HKHXYHXN0UO0UB0UN
+!CHLP!^TUL\eQL-32"EOBLANK\e'QL-13"EOCR\e'QL-26"EOEND\e'
+!CHLP0!QL&63+QBUT\e QT/8UX\eQX+48I\eQT-(8*QX)+48I\e
+QL"NZJ.UZGNQLI\eQZJXNK%N\e'
+%O&1"NOCHLP\e' QN-3"LZUH'I
+\eOCHLP\e
+!BLANK! 32UBZJ.UZGNQLI\eQZJXNK%N\eOCHLP\e
+!CR! \ 1
+\ 1QHJ   /\eGNZJXN0UN0UB0ULOCHLP0\e
+!END!I00
+\e
+
+
+       >
+\f      *600
+
+       JSBITS=7746
+       SYSTEM=22
+       PRMES=330
+       ERRET=33        /THESE ARE LOCATIONS FROM OS/8 MONITOR
+
+/RUNS IN FIELD 0 ONLY.
+
+ENTRY, 0               /INITIALLY 0 MEANS 'EX' COMMAND
+LINPTR,        JMP ENTREE      /OS/8 JUMPS HERE (ACTUALLY TO 600)
+TEMM,
+TEKLDG,        ISZ CCLNHR      /TECO 'EG' JUMPS HERE
+       DCA I (BEGLN    /ZERO COMMAND LINE
+       JMP TEGO        /FIRST WE DISABLE CALLS TO MONITOR
+ENTREE,        TAD (7605
+       DCA ERRET
+       TAD SYSTEM
+       DCA MYSYS
+       JMS FINDIT      
+       SPA CLA         /WAS IT A LEGAL COMMAND?
+       JMP I (PRQMRK   /NO
+TEGO,  TAD (6003       /YES
+       DCA I (JSBITS
+       CIF 10
+       JMS I MYSYS     /CALL USR AND LOCK IN CORE
+       10
+       CLA IAC
+       CIF 10
+       JMS I (200
+       2
+CCLBLC,        CCLSV
+CCLEN, 0
+CCLNHR,        JMP NOCCL       /ISZ'ED IF KBM NOT IN MEMORY
+       CLA IAC
+       TAD CCLBLC
+       DCA CCLRDB
+       JMS I (7607
+CCLCCW,        2711            /READ 27 PAGES OF CCL.SV
+CCLSTR,        2000
+MYSYS,
+CCLRDB,        7700            /INITIALLY POINTS TO USR
+       JMP NOCCL
+       CIF CDF 10
+       JMP I CCLSTR
+\fCCLSV,        FILENAME CCL.SV
+
+NOCCL, CLA SKP
+       JMP I (7605     /GO BACK TO MON IF CCL NOT FOUND ON TECO EG COMMAND
+       JMS I (PRMES    /PRINT ERROR MESSAGE OTHERWISE
+       TEXT    /NO CCL!/
+       0
+\f/FINDS IF INPUT LINE STARTS WITH A COMMAND
+/LEAVES ENTRY # IN AC, -1 IF NOT FOUND
+/ENTRIES START AT ENTRY 0.
+/CALLABLE FROM ANY FIELD
+
+FINDIT,        0
+MORE,  TAD (BEGLN-1
+       DCA LINPTR
+       ISZ LINPTR
+       TAD I LINPTR
+       TAD (-240
+       SNA CLA
+       JMP .-4
+       JMS GETKAR
+       JMP ENDOFT      /NO MATCH
+       JMP INTO
+FNLUP, TAD I LINPTR
+       TAD (-301
+       STL
+       TAD (-32
+       SNL CLA
+       JMP NOLET       /NOT A LETTER
+       JMS GETKAR
+       JMP MATCH
+INTO,  CIA
+       TAD I LINPTR
+       AND (37         /5-BIT ASCII
+       ISZ LINPTR
+       SNA CLA         /DO THEY MATCH?
+       JMP FNLUP       /YES
+NOMT,  JMS GETKAR
+       SKP
+       JMP .-2         /SCAN TO NEXT ENTRY
+       ISZ ENTRY
+       JMP MORE
+
+NOLET, JMS GETKAR
+       JMP MATCH
+       CLA
+       ISZ SIGNIF
+       JMP NOMT
+MATCH, TAD ENTRY
+       SKP
+ENDOFT,        STA
+RETCIF,        CDF 0           /RETURN TO CALLING FIELD (MAY BE OVERLAID)
+       JMP I FINDIT
+KPTR,  KEYWRD
+\fHALF, -1              /0 MEANS LEFT HALF
+SIGNIF,        0               /1 MEANS 40 BIT ON WHICH MEANS CHAR IS SIGNIF ONLY IF PRESENT
+
+/GETKAR GETS NEXT 5-BIT CHAR, LEAVES IT IN AC
+/SETS SIGNIF TO -1 IF 40 BIT WAS PRESENT
+/TAKES RETURN 1 IF CHAR IS 0
+/TAKES RETURN 2 OTHERWISE
+
+GETKAR,        0
+       ISZ HALF
+       JMP RTHALF
+       TAD I KPTR
+       RTR
+       RTR
+       RTR
+       JMP INSIDE
+RTHALF,        STA
+       DCA HALF
+       TAD I KPTR
+       ISZ KPTR
+INSIDE,        AND (77
+       DCA TEMM
+       TAD TEMM
+       AND X40
+X40,   SZA CLA
+       STA
+       DCA SIGNIF
+       TAD TEMM
+       SZA
+       ISZ GETKAR
+       AND (37
+       JMP I GETKAR
+       PAGE
+\f      *REST
+CORLOC,        CORX
+CORV,  1400
+CORSIZ,        1
+
+CORE,  CDF 0
+       TAD CORSIZ
+       CLL RTL
+       RAL
+       AND COR70
+       TAD COREX
+       DCA .+1
+COR1,  CDF
+       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
+       TAD COR1
+       DCA I CORLOC
+       ISZ CORSIZ
+       JMP CORE
+COREX, CDF 0
+       TAD CORSIZ
+       CLL RTL
+       TAD (-10
+       JMP I (DETC2    /GO TO NEXT PAGE
+\fMONLST,       MON1
+       MON2
+       MON3
+       MON4
+       MON5
+       MON6
+       MON7
+       MON8
+       MON9
+       MON10
+       MON11
+       MON12
+\fMON1, TEXT    /JANUARY/
+MON2,  TEXT    /FEBRUARY/
+MON3,  TEXT    /MARCH/
+MON4,  TEXT    /APRIL/
+MON5,  TEXT    /MAY/
+MON6,  TEXT    /JUNE/
+MON7,  TEXT    /JULY/
+MON8,  TEXT    /AUGUST/
+MON9,  TEXT    /SEPTEMBER/
+MON10, TEXT    /OCTOBER/
+MON11, TEXT    /NOVEMBER/
+MON12, TEXT    /DECEMBER/
+\fCOM19,        TEXT    /, 19/
+
+WEEKLST,DAY1
+       DAY2
+       DAY3
+       DAY4
+       DAY5
+       DAY6
+       DAY7
+
+DAY1,  TEXT    /SATUR/
+DAY2,  TEXT    /SUN/
+DAY3,  TEXT    /MON/
+DAY4,  TEXT    /TUES/
+DAY5,  TEXT    /WEDNES/
+DAY6,  TEXT    /THURS/
+DAY7,  TEXT    /FRI/
+BADMON,        TEXT    /#BAD MONITOR/
+       PAGE
+\fHISIZ,        0               /HIGHEST MEMORY BANK
+NEWCOR,        0               /PROPOSED NEW MEMORY BANK
+
+DETC2, SNA
+       JMS KEIGHT
+       TAD (-30
+       SNA
+       JMS K32
+       TAD (40
+       JMS OTOD
+       DCA I (CORMES
+       CDF 10
+       TAD I (LBEGIN
+       DCA XRL
+       CDF 0
+       STA
+       TAD I (CORSIZ
+       DCA HISIZ
+       ISZ XRL
+       TAD I XRL       /GET NEXT CHAR
+       SNA
+       JMP COREQ       /NOT SETTING CORE SIZE
+       TAD (-260
+       DCA NEWCOR
+       TAD NEWCOR
+       AND (7770
+       SZA CLA
+       JMP DETER       /TRIED TO SET CORE SIZE GT 7
+       TAD NEWCOR
+       CIA
+       TAD HISIZ
+       SPA CLA
+       JMP BADKOR      /TRIED TO SET SOFTWARE CORE SIZE GT REAL CORE SIZE
+       TAD I (7777
+       RTL             /BATCH BIT TO LINK
+       SZL CLA
+       JMP WRSKOR      /CAN'T CHANGE CORE SIZE UNDER BATCH
+       TAD NEWCOR
+       CLL RTL
+       RAL
+       DCA NEWCOR
+       TAD I (7777
+       AND (7707
+       TAD NEWCOR
+       DCA I (7777
+COREQ, TAD I (7777
+       AND (70
+       SNA
+       JMP ABSKOR
+       TAD (10
+       CLL RAR
+       JMS OTOD
+       DCA I (SCRMES
+       TAD I (SCRMES
+       CIA
+       TAD I (CORMES
+ABSKOR,        CIF CDF 10
+       SNA CLA
+       JMP I (ABSCOR   /DON'T PRINT SOFT IF = REAL
+       JMP I (SCRM
+
+BADKOR,        CIF CDF 10
+       JMP I (BADCOR
+WRSKOR,        CIF CDF 10
+       JMP I (WRSCOR
+
+DETER, CIF CDF 10
+       JMP I (CMDERR
+
+KEIGHT,        0
+       CIF CDF 10
+       JMS I (K8
+       JMP I KEIGHT
+
+XRL,   0
+\fOTOD, 0
+       DCA TTX
+       DCA TX
+       TAD TTX
+       TAD (-12
+       ISZ TX
+       SMA
+       JMP .-3
+       TAD (72
+       DCA CORETM
+       STA
+       TAD TX
+       SNA
+       TAD (40-60
+       TAD (60
+       CLL RTL
+       RTL
+       RTL
+       TAD CORETM
+       JMP I OTOD
+
+TX,    0
+TTX,   0
+CORETM,
+K32,   0
+       TAD (4100
+       DCA I (CORMES+5
+       JMP I K32
+\fOTODY,        0
+       JMS OTOD
+       CIF CDF 10
+       JMP I OTODY
+       PAGE
+\fERRCMD,       TEXT    /#ERROR IN COMMAND/
+BADVMS,        TEXT    /#CCL 3X OVERLAY AND MONITOR INCOMPATIBLE/
+       AAAA=.
+       *BADVMS+3
+       CCLTAB&77^100+40
+       *AAAA
+\fLOVMES,       TEXT    /NOT WAR?/
+KILMES,        TEXT    /FILES DELETED:/
+RENMES,        TEXT    /FILES RENAMED:/
+MOVMES,        TEXT    /FILES COPIED:/
+SCRMES,        TEXT    \00K/\
+       *.-1
+CORMES,        TEXT    /00K MEMORY/
+DAYDAY,        TEXT    /DAY /
+\fNOCORE,       TEXT    /# NOT ENOUGH MEMORY/
+BATCOR,        TEXT    /#CANNOT CHANGE MEMORY LIMIT WHILE RUNNING BATCH/
+JAN,   0
+FEB,   3
+       4;0;2;5;0;3;6;1;4;6
+\fSUP,  TEXT    /%SUPERSEDING/
+MEMWARN,TEXT   /%CAN'T REMEMBER/
+SQWARN,        TEXT    /%BATCH SQUISHING SYS:!/
+SYSER, TEXT    \#I/O ERROR ON SYS:\
+BADSYN,        TEXT    /#ILLEGAL SYNTAX/
+TOOMAN,        TEXT    /#TOO MANY FILES/
+NF,    TEXT    / NOT FOUND/
+DNE,   TEXT    / DOES NOT EXIST/
+SEMSG1,        TEXT    /? ENTER ERROR/
+SEMSG2,        TEXT    \?I/O ERROR\
+SEMSG3,        TEXT    /?DEVICE FULL/
+SEMSG4,        TEXT    /?CLOSE ERROR/
+\fATIO, TEXT    /#BAD FILENAME OR ERROR READING INDIRECT FILE/
+OVFLOW,        TEXT    /#COMMAND LINE OVERFLOW/
+BADNUM,        TEXT    /#BAD NUMBER/
+BADSTR,        TEXT    /#ILLEGAL * OR ?/
+\fBADX, TEXT    /#BAD EXTENSION/
+BADOPT,        TEXT    /#BAD SWITCH OPTION/
+TOOLNG,        TEXT    /#COMMAND TOO LONG/
+REMBAD,        TEXT    \#I/O ERROR TRYING TO RECALL\
+\fBADSW,        TEXT    /#SWITCH NOT ALLOWED HERE/
+BADSW2,        TEXT    /#BAD CCL SWITCH/
+NONE,  TEXT    /NONE/
+BADREM,        TEXT    /#BAD RECOLLECTION/
+BADEV, TEXT    /#BAD DEVICE/
+CONTRA,        TEXT    /#CONTRADICTORY SWITCHES/
+\fVMES, TEXT    \OS/8 - KBM V3A - CCL V1A\
+       LOC78=VMES+1
+       VLOC=VMES+6
+       *.-2
+       CV=CCLVER&77
+       CCLNUM&77^100+CV
+       *.+1
+\fYEDIT,        FILENAME EDIT.SV
+       *.-1
+YBOOT, FILENAME BOOT.SV
+       *.-1
+YFORT, FILENAME FORT.SV
+       *.-1
+YF4,   FILENAME F4.SV
+       *.-1
+YBITMAP,FILENAME BITMAP.SV
+       *.-1
+YSRCCOM,FILENAME SRCCOM.SV
+       *.-1
+YBCOMP,        FILENAME BCOMP.SV
+       *.-1
+YPAL8, FILENAME PAL8.SV
+       *.-1
+YFOTP, FILENAME FOTP.SV
+       *.-1
+/YCREF,        FILENAME CREF.SV
+/      *.-1
+YDIRECT,FILENAME DIRECT.SV
+       *.-1
+\fYPIP, FILENAME PIP.SV
+       *.-1
+YABSLDR,FILENAME ABSLDR.SV
+       *.-1
+YLOADER,FILENAME LOADER.SV
+       *.-1
+YLOAD, FILENAME LOAD.SV
+       *.-1
+YTECO, FILENAME TECO.SV
+       *.-1
+YLPTSPL,FILENAME LPTSPL.SV
+       *.-1
+YCAMP, FILENAME CAMP.SV
+       *.-1
+YSET,  FILENAME SET.SV
+       *.-1
+YBASIC,        FILENAME BASIC.SV
+       *.-1
+YRXCOP,        FILENAME RXCOPY.SV
+       *.-1
+YRESORC,FILENAME RESORC.SV
+       *.-1
+YBATCH,        FILENAME BATCH.SV
+       *.-1
+YRALF, FILENAME RALF.SV
+       *.-1
+YSABR, FILENAME SABR.SV
+       *.-1
+YFRTS, FILENAME FRTS.SV
+       *.-1
+YDATE, FILENAME DATE.SV
+       *.-1
+YCCL,  FILENAME CCL.SV
+       *.-1
+YHELP, FILENAME HELP.SV
+       *.-1
+YMACREL,FILENAME MACREL.SV
+       *.-1
+YLINK, FILENAME LINK.SV
+       *.-1
+\fBATHED,       "$;"J;"O;"B;215;212;".;0
+BATAIL,        ".;"R;240;"F;"O;"T;"P;215;212
+       "*;"S;"Y;"S;":;"C;"C;"B;"T;"C;"H;".;"T;"M;"/;"D;"$;215;212
+       "$;"E;"N;"D;215;212;32;0
+TEMNAM,        FILENAME CCBTCH.TM
+\fLPTDEV,       DEVICE LPT
+TVDEV, DEVICE TV
+TTYDEV,        DEVICE TTY
+PTPDEV,        DEVICE PTP
+DMPDEV,        DEVICE DUMP
+NULDEV,        DEVICE NULL
+\f      BATBUF=4400     /LOCATION OF ONE BLOCK BATCH TEMP BUFFER
+       USR=200
+       GLINE=1200      /LOCATION FROM KBM
+       CTRLCK=1241     /LOC FROM KBM, PTS TO PLACE TO BRANCH ON ^C
+BATPTR,        BATBUF-1
+LCHAR, 0
+
+SEMGO, CIF CDF 10
+       JMP I SEMI
+
+SEMI,  0
+       TAD (BEGLN-1
+       DCA XR
+SEMLUP,        TAD I XR
+       SNA
+       JMP SEMGO       /NO SEMICOLONS
+       TAD (-";
+       SZA CLA
+       JMP SEMLUP
+       CIF 10
+       CLA IAC         /SYS
+       JMS I (USR
+       3               /ENTER
+BLKNO, TEMNAM
+BLKLEN,        0               /NEG OF LENGTH
+       JMP SEMER1      /ENTER ERROR
+       TAD BLKNO
+       DCA BATBLK
+       TAD (BEGLN-1
+       DCA XR
+       TAD (7600
+       DCA I (CTRLCK   /FORCE ^C TO GLINE TO GO TO 7600
+       JMS BATLST
+       BATHED
+S2,    TAD I XR
+       SNA
+       JMP LINEND
+       DCA LCHAR       /SAVE CHAR
+       TAD LCHAR
+       TAD (-";
+       SNA CLA
+       JMP GOTSEM
+       TAD LCHAR
+S3,    JMS BATPUT
+       JMP S2
+\fLINEND,       TAD LCHAR
+       TAD (-";        /LOOK AT LAST CHAR
+       SZA CLA         /WAS IT SEMICOLON?
+       JMP BATEND      /NO, END OF TEMP BATCH STREAM
+       JMS I (GLINE    /YES, READ NEW LINE FROM KEYBOARD
+/**** WHAT IF WE'RE RUNNING UNDER BATCH ****
+       TAD (BEGLN-1
+       DCA XR
+       JMP S2
+
+GOTSEM,        JMS KRLF
+       TAD (".
+       JMP S3
+
+KRLF,  0
+       TAD (215
+       JMS BATPUT
+       TAD (212
+       JMS BATPUT
+       JMP I KRLF
+
+BATPUT,        0
+       ISZ BATPTR
+       DCA I BATPTR
+       TAD BATPTR
+       TAD (-BATBUF-377
+       SNA CLA
+       JMS BATWRIT     /WRITE OUT BUFFER IF FULL
+       JMP I BATPUT
+\fBATWRIT,0
+       JMS I (7607
+       4200            /WRITE 1 BLOCK
+       BATBUF
+BATBLK,        0
+       JMP SEMER2      /  I/O ERROR
+       ISZ BATBLK      /POINT TO NEXT BLOCK
+       ISZ BATLEN      /BUMP LENGTH
+       ISZ BLKLEN
+       SKP
+       JMP SEMER3      /DEVICE FULL
+       TAD (BATBUF-1
+       DCA BATPTR
+       JMP I BATWRIT
+
+BATEND,        JMS KRLF
+       JMS BATLST
+       BATAIL
+       JMS BATWRIT
+       CIF 10
+       CLA IAC         /SYS
+       JMS I (USR
+       4               /CLOSE
+       TEMNAM
+BATLEN,        0               /LENGTH OF TEMPORARY FILE
+       JMP SEMER4      /CLOSE ERROR
+       CIF CDF 10
+       JMP I (ENGOA
+\fBATLST,       0
+       TAD I BATLST
+       DCA BTPT
+       ISZ BATLST
+BTLP,  TAD I BTPT
+       SNA
+       JMP I BATLST
+       JMS BATPUT
+       ISZ BTPT
+       JMP BTLP
+
+BTPT,  0
+
+SEMER4,        IAC     /CLOSE ERROR
+SEMER3,        IAC     /DEVICE FULL
+SEMER2,        IAC     / I/O ERROR
+SEMER1,        IAC     /ENTER ERROR
+       CIF CDF 10
+       JMP I (SEMERR
+       PAGE
+\f      FIELD 1
+       *2001
+       $
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape5/DTCOPY.PA b/sw/os8/v3d/sources/system/dectapes/dectape5/DTCOPY.PA
new file mode 100644 (file)
index 0000000..1ce92af
--- /dev/null
@@ -0,0 +1,874 @@
+/DECTAPE COPY, V10
+
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 1966, 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.
+/
+/
+/
+/
+/
+/
+\f/DECTAPE COPY
+/VERSION .B07
+/
+/
+/COPYRIGHT 1968        DIGITAL EQUIPMENT CORPORATION
+/      MAYNARD, MASS.  OCTOBER,1968
+
+       
+\f      
+/ THIS PROGRAM COPIES A DECTAPE FROM ONE 
+/ SPECIFIED UNIT TO ANOTHER. ALL DECTAPE
+/ ROUTINES ARE INTERNALLY GENERATED SO THAT
+/ IT MAY BE RUN WITHOUT THE MONITOR SYSTEM.
+/
+/ STARTING ADDRESS IS 200
+/ 
+       DTRA=6761
+       DTCA=6762
+       DTXA=6764
+       DTSF=6771
+       DTRB=6772
+       DTLB=6774
+
+       WC=7754
+       CA=7755
+/ THESE AREAS ARE USED BY DATA BREAK
+BUFIOT=1547    /INPUT OUTPUT BUFFER
+BUFCHK=4563    /RE-READ BUFFER
+/ 
+*20
+/ PAGE ZERO WORKING STORAGE
+BADTRY,        -3      /COUNT OF READ ERRORS
+CURBLK,        0       /CURRENT BLOCK NUMBER
+TRASH1,        0       /WORKING STORAGE
+TRASH2,        0       /WORKING STORAGE
+TRASH3,        0       /WORKING STORAGE
+BLKCNT,        0       /NUMBEROF BLOCKS TO READ
+               /OR MINUS THAT NUMBER
+SORBLK,        0       /STORAGE FOR CURBLK
+WORDS, 0       /NUMBER OF WORDS PER BLOCK
+INUNIT,        0       /INPUT UNIT IN LH OCT CHAR
+OUTUNI,        0       /OUTPUT UNIT IN LH OCT CHAR
+RESTOR,        0       /NUMBER OF WORDS TO COPY 
+RESAVE,        0       /NEGATIVE OF BLKCNT
+SMICAR,        0       /CHARACTER STORAGE
+SMISUM,        0       /RUNNING SUM
+SPELIN,        0       /POINTER
+SEAZIK,        0       /INPUT AREA
+SEAZOK,        0       /TEMP STORAGE
+DECTWC,        0       /FLAG TO DETERMINE IF VALIDATION WILL OCCUR
+DECTCA,        0       /CURRENT ADDRESS STORE
+FIRST, 0       /STARTING BLOCK NUMBER
+LAST,  0       /LAST BLOCK NUMBER
+LENGTH,        0       /NUMBER OF WORDS TO COPY
+PARITY,        0               /PARITY ERROR FLAG (COUNT)
+MSKIN, 0               /NEGATIVE OF INUNIT
+PARDEL,        PSTACK          /POINTER TO PARITY TABLE
+/
+/ PAGE ZERO SUBROUTINES
+DIREC, 0
+       CLA
+       DTRA            /FIND DIRECTION
+       AND [400
+       SZA CLA         /BRANCH BACK
+       ISZ DIREC       /REVERSE DIRECTION EXIT
+       JMP I DIREC     /FORWARD DIRECTION EXIT
+/
+/
+BACKUP,        0               /SUBROUTINE REWINDS TAPE
+       CLA
+       DTRA
+       AND (670        /CLEAR DIRECTION AND MOVEMENT
+       DTXA
+       TAD (600        /GO IN REVERSE
+       DTXA
+       DTSF
+       JMP .-1         /WAIT UNTILL DONE
+       JMS I [ERROR    /BUSYWORK FOR ERRORS
+       JMP I BACKUP    /EXIT ON ENDZONE ERROR
+       JMP BACKUP+1
+\f      
+*200
+BEGIN, CLA CLL /INITIALIZE
+       DTLB
+       TLS     /TELETYPE OUTPUT
+       JMS I [SPEAK
+       MESS0
+       JMS I [SPEAK
+       MESS1   /INPUT UNIT NUMBER
+       JMS GETNUM      /CHECK INPUT UNIT NUMBER
+       DCA INUNIT
+       TAD INUNIT
+       CIA             /SET UP INPUT UNIT MASK
+       DCA MSKIN
+       JMS I [SPEAK
+       MESS2   /OUTPUT UNIT NUMBER
+       JMS GETNUM
+       TAD MSKIN       /MAKE SURE UNITS ARE DIFFERENT
+       SNA
+       JMP BEGIN       /INPUT ERROR
+       TAD INUNIT
+       DCA OUTUNI
+       JMS I [SPEAK    /GET FIRST BLOCK NUMBER
+       MESSA
+       JMS I [SMIGIT
+       NOP     
+       DCA CURBLK
+       TAD CURBLK
+       CIA     /STORE BEGINNING MARKER
+       DCA FIRST
+       JMS I [SPEAK    /GET LAST BLOCK NUMBER
+       MESSB
+       JMS I [SMIGIT
+       CLA CMA /KLUDGE IF NO INPUT
+       DCA LAST
+       TAD FIRST
+       CLL
+       SZA
+       TAD LAST        /MAKE SURE VALID
+       SZA SNL CLA
+       JMP BEGIN
+       DTLB
+       TAD INUNIT              /INIT INPUT UNIT
+       JMS I [FIXTAP
+       DCA WORDS               /SET UP BLOCK LENGTH
+       TAD OUTUNI              /INIT OUTPUT UNIT
+       JMS I [FIXTAP
+       CIA                     /MAKE SURE BLOCK LENGTH
+       TAD WORDS               /SAME ON INPUT AND OUTPUT
+       SZA CLA
+       JMP BADLEN              /BLOCK LENGTH ERROR
+       JMS I [SPEAK            /TYPE OUT BLOCK LENGTH
+       MESS3
+       TAD WORDS
+       JMS I [TYPNUM
+       JMS I [SPEAK            /SEND <RETURN><LINE FEED>
+       MESS0+11
+       TAD WORDS
+       CIA     /COMPUTE NUMBER OF BLOCKS
+       DCA LENGTH      /TO READ AND WRITE
+       DCA BLKCNT      /CLEAR BLOCK COUNTER
+       TAD [3014       /LOAD BUFFER SIZE
+       TAD LENGTH
+       SPA
+       JMP BADLEN      /TOO MANY WORDS PER BLOCK
+       ISZ BLKCNT      /TALLY
+       TAD LENGTH
+       SMA
+       JMP .-3 /CONTINUE COUNTING
+       TAD WORDS       /GET NUMBER OF
+       TAD [-3014      /WORDS TO READ
+       CIA     /AND TO WRITE
+       DCA RESTOR      /PRESERVE IN RESTOR
+       TAD RESTOR
+       DCA LENGTH
+       TAD BLKCNT      /SAVE NEGATIVE OF BLKCNT
+       CIA
+       DCA RESAVE
+       JMS I [SPEAK
+       MESSC
+       JMS I [SMIGIT
+       NOP
+       DCA DECTWC      /SET UP VERIFY FLAG
+/
+/ MAIN LOOP FOR COPY
+LETS,  TAD CURBLK      /CHECK FOR PARTIAL BLOCK TO COPY
+       TAD BLKCNT
+       CLL CMA IAC
+       TAD LAST
+       SZL
+       JMP LETT        /COPY FULL LENGTH
+       DCA LENGTH      /ADJUST WORDS TO COPY
+       TAD RESTOR
+       CIA
+       TAD WORDS
+       ISZ LENGTH
+       JMP .-2 /COMPUTE PROPER LENGTH
+       CIA
+       TAD WORDS
+       DCA LENGTH
+       TAD [REVERS     /KLUDGE COPY EXIT
+       DCA I [COPY
+       JMP I [COPY+1   /PERFORM THIS COPY
+LETT,  JMS I [COPY     /COPY THIS BLOCKS
+       TAD BLKCNT
+       TAD BLKCNT      /ADVANCE CURRENT BLOCK
+       TAD CURBLK
+       DCA CURBLK
+       JMS DIREC
+       JMP LETU        /FORWARD EXCEEDED CHECK
+LETR,  TAD CURBLK      /REVERSE CHECK
+       TAD FIRST
+       CMA
+       SZA CLA         /CHECK FOR MINUS 1
+       JMP LETT        /CONTINUE COPY
+       JMP I [DONE     /FINISHED JOB
+LETU,  TAD CURBLK
+       CLL CMA IAC
+       TAD LAST
+       SZL CLA /CHECK FOR END OF TAPE
+       JMP LETS
+       JMP I [REVERV
+
+
+
+
+/ THIS SUBROUTINE GETS INPUT
+/ AND OUTPUT UNIT NUMBERS FROM
+/ THE TELETYPE AND VALIDATES THEM.
+/
+GETNUM, 0
+       JMS I [SMIGIT
+       NOP
+       AND [7
+       CLL RTR         /MOVE TO LH THREE BITS
+       RTR
+       JMP I GETNUM
+/
+/
+       
+BADLEN,        JMS I [SPEAK            /BLOCK LENGTH ERROR
+       MESS3A
+       JMP BEGIN
+/
+/
+/
+PAGE
+\f      
+/
+/ THIS TURN AROUND IS ENTERRED 
+/ WHEN THE LAST COPY MOVED INTO
+/      THE FINAL DATA AREA
+REVERV, TAD LAST
+       DCA CURBLK      /START OF COPY BACK
+       JMS REVALT      /CHANGE INUNIT AND OUTUNI
+       TAD INUNIT
+       DTCA DTXA
+       JMS I [RESET    /REPOSITION TAPE
+       TAD OUTUNI
+       DTCA DTXA
+       JMS I [RESET    /REPOSITION TAPE
+REBACK, TAD CURBLK
+       CMA     /COMPUTE NEW COPY LENGTH
+       TAD SORBLK
+       TAD BLKCNT
+       SNA
+       JMP REVERS      /KLUDGE IF NOTHING TO DO
+       DCA SORBLK      /MINUS # OF BLOCKS
+       TAD SORBLK
+       DCA BLKCNT      /SAVE THIS NUMBER
+       TAD WORDS
+       ISZ SORBLK
+       JMP .-2
+       DCA LENGTH      /LENGTH FOR COPY
+       JMS I [COPY     /PERFORM IT
+       TAD CURBLK
+       TAD BLKCNT
+       TAD RESAVE      /ADVANCE CURBLK
+       DCA CURBLK
+       TAD RESAVE
+       DCA BLKCNT
+       TAD RESTOR
+       DCA LENGTH
+       JMP I [LETR     /CONTINUE COPY
+/
+/
+/ THIS TURN AROUND IS ENTERRED
+/ WHEN THE LAST SEARCH FOR
+/ CURRENT BLOCK CAUSED AN END
+/ OF TAPE ERROR
+/
+REVERT, JMS DIREC
+       SKP
+       JMP I [DONE     /FINISHED IF DIRECTION REVERSE
+       TAD SORBLK
+       DCA CURBLK      /RESTORE CURBLK
+       TAD OUTUNI      /RESET LOCATION OF 
+       DTCA DTXA       /OUTPUT DECTAPE AND
+       JMS I [RESET    /FIND LAST BLOCK
+       TAD [4000       /BY LOOKING FOR IMAGINARY
+       JMS I [SEARCH   /BLOCK NUMBER (KLUDGING SEARCH)
+       NOP
+       JMP .-3 /TRY AGAIN ON ERRORS
+       TAD SEAZIK      /MUST BE LAST BLOCK NUMBER
+       DCA CURBLK
+       JMS REVALT      /CHANGE INUNIT AND OUTUNI
+       JMP REBACK
+/
+/
+/ THIS TURN AROUND IS ENTERRED WHEN THE
+/ END BLOCK FOR COPY WAS REACHED BY A
+/ PARTIAL BUFFER COPY.
+/
+REVERS, CLA CMA        /ADJUST CURBLK POINTER
+       TAD SORBLK
+       DCA CURBLK
+       TAD RESAVE
+       DCA BLKCNT      /MAKE BLKCNT NEGATIVE
+       TAD RESTOR
+       DCA LENGTH      /RESTORE COPY LENGTH
+       JMS REVALT      /CHANGE INUNIT AND OUTUNI
+       JMP I [LETR
+/
+REVALT, 0
+       TAD OUTUNI
+       TAD [400
+       DCA OUTUNI      /REVERSE DIRECTION
+       TAD INUNIT
+       TAD [400
+       DCA INUNIT      /REVERSE DIRECTION
+       JMP I REVALT
+/
+\f      
+/THIS SUBROUTINE PERFORMS THE OPERATION
+/OF COPYING N BLOCKS AND VALIDATING
+/THE OUTPUT.
+/WHEN END OF TAPE IS REACHED THE ROUTINE
+/BRANCHES TO "REVERS", OR TO REVERT 
+/AS APPROPRIATE.
+/
+COPY,  0
+       KSF     /CHECK FOR <^C>
+       JMP .+5
+       KRB
+       TAD [-203
+       SNA
+       JMP I [7600
+       CLA
+       TAD INUNIT      /LOAD STAT REG A
+       DTCA DTXA
+       TAD [-3
+       DCA BADTRY      /RESTORE ERROR COUNTER
+       JMS I [DECTAP
+COPO,  BUFIOT  /INPUT AREA
+       30      /READ CODE
+       NOP     /NORMAL RETURN
+       TAD PARITY              /CHECK PARITY FLAG
+       SZA
+       JMP I [ERRPAR           /FIX MESSAGE FOR PARITY ERRORS
+COPZ,  TAD OUTUNI      /(IGNORE END ZONE)
+       DTCA DTXA       /OUTPUT UNIT & DIRECTION
+COPYB, JMS I [DECTAP   /WRITE OUTPUT TAPE
+       BUFIOT  /OUTPUT BUFFER
+       50      /WRITE CODE
+       JMP COPCPR      /NORMAL RETURN
+       TAD [REVERS     /END ZONE RETURN
+       DCA COPY        /FIX UP EXIT
+COPCPR, TAD CURBLK
+       DCA SORBLK      /STORE CURRENT BLOCK NUMBER
+       TAD DECTWC
+       SZA CLA
+       JMP I COPY      /NO VERIFICATION
+       JMS I [RESET    /RETURN TO FRONT END
+       JMS I [DECTAP   /READ DATA
+COPR,  BUFCHK  /INPUT AREA
+       30      /READ CODE
+       JMP .+2 /NORMAL RETURN BRANCH
+       TAD I [WC       /END ZONE RETURN
+       TAD LENGTH
+       CIA
+       DCA TRASH3      /COUNTER
+       TAD COPO        
+       DCA 17  /FORWARDS POINTER
+       TAD COPR        /REREAD BUFFER
+       DCA 16  /SET UP POINTER
+COPCML, TAD I 16
+       CIA
+       TAD I 17
+       SZA
+       JMP COPERR      /MISMATCH ON READ
+       ISZ TRASH3      /ANY MORE WORDS
+       JMP COPCML      /LOOP
+       JMP I COPY      /MADE IT! EXIT
+COPERR, ISZ BADTRY     /HOW MANY ATTEMPTS
+       JMP COPERS      /TRY AGAIN
+       JMS I [SPEAK
+       MESS5   /RE-READ ERRORS
+       JMS I [TUNIT    /TYPE UNIT NUMBER AND WAIT
+       TAD [-3
+       DCA BADTRY      /RESTORE ERROR COUNTER
+COPERS, CLA
+       JMS I [RESET
+       JMP COPYB       /WRITE OUT BLOCK AGAIN
+/
+PAGE
+\f      
+/ THIS SUBROUTINE MOVES THE DECTAPE
+/ BACK IN PREPARATION FOR ANOTHER
+/ READ OR WRITE.
+/
+RESET, 0
+       CLA CLL /CLEAR AC AND LINK
+       TAD [400        /CHANGE DIRECTION
+       DTXA
+       JMS DIREC       /FIND DIRECTION
+       TAD [6  /FORWARD MAKE +3
+       TAD [-3 /REVERSE MAKE -3
+       TAD CURBLK
+       SPA     /MAKE SURE VALUE IS PLUS
+       JMP RESEV
+       JMS I [SEARCH   /FIND THIS BLOCK
+       SKP CLA /FOUND IT
+       JMP RESET+4
+REEXT, DTRA
+       AND [200        /CLEAR STOP-GO FLAG
+       TAD [400        /AND REVERSE DIRECTION
+       DTXA
+       JMP I RESET
+RESEV, JMS BACKUP      /REWIND THIS TAPE
+       JMP REEXT
+/
+/
+/ THIS BRANCH IS TKEN WHEN
+/ ALL COPYING IS COMPLETED
+DONE,  JMS I [SPEAK
+       MESS4
+       JMS I [SMIGIT
+       JMP I [BEGIN
+
+       JMP I [BEGIN
+\f      
+/THIS SUBROUTINE READS NUMBERS,
+/NOT EXCEEDING 4098, FROM A TELETYPE
+/AND RETURNS THE OCTAL VALUE OF INPUT.
+/THE FOLLOWING SPECIAL CHARACTERS
+/ARE USD...<RETURN> MARKS END OF INPUT, CAUSES A <CR><LF>
+/IF THE <RETURN> IS THE FIRST CHARACTER THEN
+/DIRECT RETURN IS TAKEN, ELSE RETURN IS TO ENTRY+2
+/      <^C> CAUSES A BRANCH TO 7600
+/
+SMIGIT, 0
+       KCC             /INITIALIZE TTY INPUT
+       DCA SMISUM              /CLEAR TEMP STORAGE
+       JMS TTYIN               /GET CHAR
+       AND     [177
+       TAD     [200
+       TAD [-215               /CHECK FOR <RETURN>
+       SNA
+       JMP SMIXIT              /EXIT ON FIRST <RETURN>
+       ISZ SMIGIT              /ADVANCE EXIT POINTER
+SMIGOP,        TAD [12                 /CHECK FOR ^C
+       SNA
+       JMP I [7600             /BRANCH TO MONITOR
+       TAD [-65                /CHECK FOR DIGITS
+       CLL
+       TAD [10
+       SNL
+       JMP SMILOP              /INVALID CHARACTER
+       DCA SMICAR              /TEMP STOR
+       TAD SMISUM              /GET CHARACTER STRING
+       CLL RAL
+       CLL RAL
+       CLL RAL                 /ROTATE TO LH POSITION
+       TAD SMICAR              /APPEND CURRENT DIGIT
+       DCA SMISUM
+       TAD SMICAR
+       TAD [260                /MAKE ASCII
+       JMS TYPE        /ECHO CHARACTER
+SMILOP,        JMS TTYIN               /GET NEXT CHARACTER
+       TAD [-215               /CHECK FOR <RETURN>
+       SZA
+       JMP SMIGOP              /CONTINUE LOOP
+SMIXIT,        JMS I [SPEAK            /SEND A <RETURN><LINE FEED>
+       MESS0+11
+       TAD SMISUM              /GET INPUT STRING
+       JMP I SMIGIT            /EXIT
+
+
+/THIS SUBROUTINE READS A CHARACTER FROM THE TTY
+TTYIN, 0
+       KSF                     /WAIT UNTIL READY
+       JMP .-1
+       KRB                     /READ TTY BUFFER
+       JMP I TTYIN
+\f
+/THIS SUBROUTINE TYPES OUT A
+/DIGIT STRING FROM THE AC
+/AS FOUR OCTAL CHARACTERS
+TYPNUM,        0
+       DCA SMICAR              /PRESERVE STRING VALUE
+       TAD [-4
+       DCA SMISUM      /INITIALIZE COUNTER
+TYPXL, TAD SMICAR
+       RTL
+       RAL                     /GET NEXT PRINT DIGIT
+       DCA SMICAR              /RETURN TO STRING
+       TAD [3
+       AND SMICAR
+       RAL                     /ENTER CURRENT DIGIT
+       TAD [260                /MAKE ASCII
+       JMS TYPE                /TYPE DIGIT
+       ISZ SMISUM              /COUNT DIGITS
+       JMP TYPXL               /COUNTINUE LOOP
+       JMP I TYPNUM            /EXIT
+
+\f      
+/THIS SUBROUTINE TYPES OUT A
+/MESSAGE IN "TEXT" FORMAT TWO
+/ASCII CHARACTERS PER WORD.
+/SPECIAL CHARACTERS ARE NOT
+/PERMITTED.    A CARRIGE RETURN
+/AND LINE FEED PRECEED THE
+/MESSAGE.
+/      JMS I [SPEAK <BRANCH TO SUBROUTINE>
+/      MESSAGE <POINTER TO MESSAGE BUFFER>
+/A ZERO WORD MARKS THE
+/END OF THE MESSAGE.
+/
+SPEAK, 0
+       CLA CLL
+       TAD [215
+       JMS I [TYPE     /CARRIGE RETURN
+       TAD I SPEAK     /GET ADDRESS OF OUTPUT
+       DCA SPELIN
+       ISZ SPEAK
+       TAD [212        
+       JMS I [TYPE     /LINE FEED
+SPEELH, TAD I SPELIN   /GET NEXT WORD
+       SNA     /CHECK FOR ZERO
+       JMP I SPEAK     /EXIT IF ZERO
+       AND [7700       /GET LH CHARACTER
+       CLL RTR /MOVE TO
+       RTR     /RIGHT HAND
+       RTR     /SIX BITS
+       JMS SPEOUT      /TRANSLATE AND OUTPUT
+       TAD I SPELIN
+       ISZ SPELIN      /ADVANCE POINTER
+       AND [77 /GET RH CHARACTER
+       JMS SPEOUT      /TRANSLATE AND OUTPUT
+       JMP SPEELH
+SPEOUT, 0
+       TAD [-40        /CHECK FORMAT
+       SMA
+       TAD [-100       /KLUDGE DIGITS FORMAT<200+XX>
+       TAD [340        /ALPHA FORMAT <300+XX>
+       JMS I [TYPE     /OUTPUT IT
+       JMP I SPEOUT    /RETURN
+
+/
+/THIS SUBROUTINE TYPES OUT
+/THE ASCII CHARACTER IN THE AC.
+/
+TYPE,  0
+       TSF     /WAIT UNTIL READY
+       JMP .-1
+       TLS     /TYPE CHARACTER
+       CLA
+       JMP I TYPE
+/
+/THIS SUBROUTINE TYPES OUT THE 
+/CURRENT UNIT NUMBER
+TUNIT, 0
+       CLA
+       DTRA
+       AND [7000       /GET CURRENT UNIT NUMBER
+       CLL RTL         /MOVE OVER
+       RTL
+       TAD [260        /MAKE ASCII CODE
+       JMS I [TYPE     /TYPE IT
+       JMS I [SMIGIT   /WAIT
+       JMP I TUNIT     /EXIT
+       JMP I TUNIT
+/
+/
+PAGE
+\f      
+/THIS SUBROUTINE SEARCHES DECTAPE
+/IN A FORWARD OR REVERSE DIRECTION.
+/STATUS REGISTER A SHOULD CONTAIN
+/UNIT SELECT NUMBER (0-2), FORWARD
+/OR REVERSE, AND A5=1.
+/THE BLOCK NUMBER FOR WHICH THE PROGRAM IS
+/SEARCHING MUST BE IN THE AC.
+/ON ERROR RETURN THE COMAND
+/FOLLOWING THE "JMS" IS SKIPPED,
+/AN END OF TAPE ERROR WILL CAUSE
+/THREE MOVES INTO ENDZONE AND TWO COMMANDS FOLLOWING
+/THE "JMS" ARE SKIPPED
+SEARCH, 0
+       CIA     /FORM TWO'S COMPLEMENT
+       DCA SEAZOK      /STORE - BLOCK NUMBER
+       DCA SEAZIK      /CLEAR INPUT WORD
+       DTRA
+       AND [274
+       DTXA    /CLEAR OUT A REGISTER
+       TAD [210        /START DEVICE
+       DTXA
+       JMS DIREC       /DETERMINE DIRECTION
+       TAD [NOP-CIA    /FORWARD...FIX TO "NOP"
+       TAD [CIA        /REVERSE...FIX TO "CIA"
+       DCA SEATIX      /FIX UP COMMAND
+       TAD [SEAZIK     /BLOCK NUMBER INPUT
+       DCA I [CA       /PUT IN CURRENT ADDRESS
+       CLA CMA /NUMBER OF BLOCKS=1
+       JMS SEARUN      /FIND FIRST BLOCK MARK
+       TAD [100                /SET CONTINUOUS MODE FLAG
+       DTXA
+       TAD SEAZIK      /BLOCK NUMBER HERE
+       TAD SEAZOK      /MINUS BLOCK NUMBER THERE
+SEATIX, NOP    /IFSEARCHING IN REVERSE DIRECTION
+*.-1
+       CIA     /IF SEARCHING IN FORWARD DIRECTION
+       SPA     /SKIP IF DONE
+       JMS SEARUN      /FIND "N" BLOCK MARKS
+       DTRA
+       AND [100                /CLEAR CONTINUOUS MODE FLAG
+       DTXA
+       JMP I SEARCH    /NORMAL EXIT
+SEARUN, 0
+       DCA I [WC       /NUMBER OF BLOCKS TO READ
+       DTXA
+       DTSF    /CHECK FOR DONE
+       JMP .-1
+       DTRB    /READ STATUS REGISTER B
+       SMA CLA
+       JMP I SEARUN    /DT FLAG...NORMAL EXIT
+       JMS I [ERROR    /HANDLE ALL ERRORS
+       ISZ SEARCH      /END OF TAPE ERROR
+       ISZ SEARCH      /ALL OTHER ERRORS
+       JMP SEARUN-4    /EXIT
+
+\f      
+/THIS SUBROUTINE READS OR WRITES
+/<N> WORDS, IN CONTROL MODE, ON
+/A BLOCK(S) ASSUMING THAT
+/THE DECTAPE IS PROPERLY
+/POSITIONED. IN LINE CODE:
+/      JMS I [DECTAP
+/      <BUFFER> ADDRESS TO READ INTO (OR WRITE FROM) -1
+/      <3> IF READ, <5> IF WRITE
+/<<NORMAL RETURN>>
+/<<END OF TAPE ERROR>>
+/AN END OF TAPE ERROR WHILE SEARCHING
+/CAUSES A BRANCH TO "REVERT".
+/STATUS REGISTER A SHOULD CONTAIN:
+/AO-2 UNIT NUMBER
+/A3 FORWARD=0, REVERSE=1
+/A4 UNIMPORTANT, SHOULD BE ZERO
+/A5    1
+/A6-8,89 UNIMPORTANT
+/BLOCK NUMBER IN PAGE ZERO "CURBLK"
+/NUMBER OF WORDS TO READ OR
+/WRITE IS IN PAGE ZERO "LENGTH"
+/
+DECTAP, 0
+       TAD I DECTAP    /GET INPUT BUFFER
+       DCA DECTCA      /STORE
+       ISZ DECTAP
+DECAGN, TAD CURBLK     /SEARCH FOR BLOCK
+       JMS I [SEARCH
+       JMP DECRUN      /FOUND IT
+       JMP DECAGN
+       JMP I [REVERT   /END ZONE ERROR
+DECRUN, TAD SEAZIK
+       TAD SEAZOK      /CHECK TO SEE IF FOUND BLOCK
+       SZA
+       JMP DECEXT-3
+       TAD LENGTH      /SET UP WORD COUNT
+       CIA
+       DCA I [WC
+       TAD DECTCA      /AND INPUT OUTPUT BUFFER
+       DCA I [CA
+       TAD I DECTAP    /GET READ OR WRITE
+DECLOP, DTXA   /START GOING
+       DTSF
+       JMP .-1
+       DTRB    /GET FLAGS
+       SMA
+       JMP DECEXI
+       JMS I [ERROR
+       JMP DECEXT-1    /ENDZONE ERROR
+       JMS I [RESET    /RESTORE POINTERS
+       JMP DECAGN
+       ISZ DECTAP      /END OF TAPE EXIT
+DECEXT, ISZ DECTAP
+       CLA
+       JMP I DECTAP    /FINISHED
+DECEXI, CLA
+       TAD I [WC       /HAVE WE FINISHED?
+       SZA CLA
+       JMP DECLOP      /NO-:CONTINUE READ-WRITE
+       DTRA    /YES--CLEAR STATUS
+       AND [274
+       DTXA
+       JMP DECEXT
+\f      
+/THIS SUBROUTINE CHECKS THE CONTENTS
+/OF STATUS REGISTER B.
+/      <BRANCH> JMS I [ERROR
+/      <+1 END OF TAPE ERROR>
+/      <+2 ALL OTHER ERRORS>
+/IN ADDITION: 1--A SELECT ERROR WILL
+/CAUSE A TYPEOUT AND HALT. 2--A PARITY
+/ERROR ON OUTPUT TAPE CAUSES A
+/BRANCH TO "COPERS"; ON INPUT TAPE
+/"PARITY ERROR" IS TYPED OUT. 3--GO FLIP-FLOP
+/AND STATUS REGISTER A6-8 WILL BE CLEARED.
+/
+ERROR, 0
+       CLA CLL
+       DTRB                    /GET ERROR FLAGS
+       AND [200                /PARITY ERROR FLAG
+       SNA CLA
+       JMP ERNOT               /HANDLE OTHER ERRORS
+       DTXA                    /CLEAR FLAGS, CONTINUE READ MODE
+       DTRA                    /GET UNIT NUMBER
+       AND [7000
+       TAD MSKIN               /CHECK FOR INPUT UNIT
+       SZA
+       JMP I [COPERR           /ERROR ON OUTPUT UNIT
+       TAD I [WC               /PUT WORD COUNT IN PUSH
+       CIA
+       DCA I PARDEL            /DOWN STACK
+       ISZ PARDEL              /ADVANCE POINTER
+       ISZ PARITY              /SET FLAG
+       JMP I [DECEXI           /RETURN TO READ
+ERNOT, DTRA    /GET STATUS REGISTER A
+       AND [274
+       TAD [2  /DO NOT DISTURB ERROR FLAGS
+       DTXA    /CLEAR A4 AND A6-8
+       DTRB    /GET ERROR FLAGS
+       RTL
+       SMA     /SKIP IF END OF TAPE ERROR
+       JMP ERROTH
+       CLA
+       TAD [-3         /LOAD -3
+       DCA ERRSOR      /STORE IN COUNT
+       TAD [200        /GO FLIP-FLOP
+       DTXA    /SET
+       DTSF
+       JMP .-1
+       ISZ ERRSOR      /HAVE WE DONE THREE TIMES
+       JMP .-5
+       JMP I ERROR     /EXIT
+ERRSOR, 0
+ERROTH, ISZ ERROR      /CHANGE ERROR BRANCH
+       SZL
+       CLA CLL         /MARK TRACK ERROR
+       RTL
+       SNL CLA
+       JMP I ERROR             /TIMING ERROR BRANCH
+       JMS I [SPEAK    /SELECT ERROR MESSAGE
+       ERRSEL
+ERRUNT, JMS I [TUNIT
+       JMP I ERROR
+/
+PAGE
+\f      
+/ VARIOUS MESSAGES
+MESS0, TEXT %DECTAPE COPY V10A %
+MESSA, TEXT %FIRST BLOCK TO COPY (OCTAL) %
+MESSB, TEXT %FINAL BLOCK TO COPY (OCTAL) %
+ERRSEL, TEXT %SELECT ERROR ON UNIT #%
+PMESS, TEXT %PARITY ERROR ON BLOCK %
+MESSC, TEXT %VERIFY OUTPUT? (0=YES, 1=NO): %
+MESS1, TEXT %FROM UNIT %
+MESS2, TEXT %TO UNIT %
+MESS3, TEXT %PDP-8 WORDS PER BLOCK %
+MESS4, TEXT %DONE%
+MESS5, TEXT %WRITE ERRORS ON UNIT #%
+MESS3A,        TEXT %BLOCK LENGTH ERROR%
+/
+/
+PAGE
+/
+/
+\f
+/THIS ROUTINE TYPES OUT PARITY ERROR MESSAGES
+/AND RESTORES POINTERS TO THE PUSH DOWN STACK.
+ERRPAR,        CIA
+       DCA PARITY              /SET UP STACK COUNTER
+       CLA CMA
+       TAD PARDEL              /MOVE POINTER BACK
+       DCA PARDEL
+       JMS I [SPEAK            /TYPE OUT MESSAGE
+       PMESS
+       TAD CURBLK
+EPLOOP,        DCA EPJK
+       TAD I PARDEL            /CHECK FOR CORRECT BLOCK NUMBER
+       TAD WORDS               /ADVANCE BLOCK WORDS COUNT
+       DCA I PARDEL
+       TAD I PARDEL
+       CIA             /REACHED ORIGINAL VALUE?
+       TAD LENGTH
+       SNA CLA
+       JMP EPTYP               /TYPE BLOCK AT ERROR
+       JMS DIREC
+       CLL CMA RAL             /ADD ONE IF FORWARD
+       CMA                     /SUBTRACT ONE IF NEGATIVE
+       TAD EPJK                /NEXT BLOCK NUMBER
+       JMP EPLOOP              /CONTINUE LOOP
+EPTYP, TAD EPJK
+       JMS I [TYPNUM           /TYPE BLOCK NUMBER
+       ISZ PARITY              /ADVANCE COUNTER
+       JMP ERRPAR+2            /CONTINUE LOOP
+       JMP I EPPEXT            /RETURN TO COPY
+EPPEXT,        COPZ                    /REENTRY TO COPY
+EPJK,  0                       /WORKING STORAGE
+\f
+/THIS SUBROUTINE READS A RANDOM
+/BLOCK ON DECTAPE TO DETERMINE THE BLOCK LENGTH
+FIXTAP,        0
+       TAD [610                /FIX A REG. WORD
+       DTCA DTXA               /LOAD A STAT. REG.
+       CLA CMA
+       DCA I [WC               /SEARCH FOR 1 BLOCK
+       TAD [BUFIOT             /FIX CURRENT ADDRESS
+       DCA I [CA               /TO READ INTO BUFFER
+       DTSF                    /WAIT AROUND
+       JMP .-1
+       DTRB
+       SPA CLA
+       JMP FIXERR              /HANDLE ERROR CONDITIONS
+       TAD [30                 /CHANGE TO READ MODE
+       DTXA
+       DTSF                    /WAIT TILL READ DONE
+       JMP .-1
+       TAD [200                /STOP TAPE
+       DTXA
+       TAD I [WC               /GET BLOCK LENGTH
+       JMP I FIXTAP            /EXIT
+FIXERR,        JMS I [ERROR
+       TAD [400                /END OF TAPE...REVERSE DIRECTION
+       TAD [210                /START TAPE MOVING
+       DTXA                    /AND CLEAR FLAGS
+       JMP FIXTAP+3            /TRY AGAIN
+\f
+/PARITY ERROR WORD COUNT STACK
+PSTACK,        0
+
+
+/
+
+/END OF PROGRAM
+$
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape5/HELP.PA b/sw/os8/v3d/sources/system/dectapes/dectape5/HELP.PA
new file mode 100644 (file)
index 0000000..f874982
--- /dev/null
@@ -0,0 +1,709 @@
+/ OS/8 HELP PROGRAM
+/
+/ 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 HEREIN 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 ASSUMES NO RESPONSIBILITY FOR THE USE
+/ OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED
+/ BY DIGITAL.
+/
+/ COPYRIGHT (C) 1977 BY DIGITAL EQUIPMENT CORPORATION
+/
+\f
+/
+/ VERSION #1   B. M.           1/1/77
+/ VERSION #2A  M. H.           4/22/77
+/ (CHANGE TAG VERS WHEN CHANGING VERSION NUMBERS)
+/
+/ THIS PROGRAM CAN BE CALLED DIRECTLY OR CHAINED TO BY CCL TO
+/ PRINT INFORMATION ON RANDOM SUBJECTS THE USER ASKS ABOUT.
+/
+/ START ADDRESS:200    JSW:3401
+/ CORE LIMITS:200-7377
+/
+/ THIS PROGRAM REQUIRES AN INPUT FILE TO RUN. FOR OS/8 THE FILE
+/ SHOULD BE NAMED "HELP8.HL" FOR OS/78 THE NAME SHOULD BE "HELP78.HL".
+/
+/ THE FORMAT OF THE FILE IS:
+/      <SP><CR><LF>
+/      &COMMAND NAME
+/      &ADDITIONAL COMMAND NAMES(IF ANY)
+/      TEXT OF HELP INFO
+/      &NEXT COMMAND NAME
+/      TEXT OF NEXT HELP INFO
+/      ETC.
+/
+/ NOTE: TOO SPEED UP PROCESSING A HASHING ALGORITHM IS USED
+/ WHICH REQUIRES THAT WHEN MULTIPLE COMMANDS REFERENCE A 
+/ SINGLE SUBFILE, THE SUBFILE MUST APPEAR IN THE HELP FILE
+/ ALPHABETICALLY ACCORDING TO THE 1ST COMMAND STRING LETTER
+/ CLOSEST TO Z.
+/ THAT IS, SUBFILES MUST BE ARRANGED ALPHABETICALLY ACCORDING TO
+/ THE HIGHEST LETTERED 1ST CHARACTER OF THE COMMAND.
+/
+\f
+USR=   200     /ADDRESS OF USR
+OS78=  7771    /ADDRESS OF WD WITH OS/78 FLAG BIT(4)   (MH)
+FETCH= 1       /FETCH A HANDLER
+LOOKUP=        2       /LOOKUP A FILE NAME
+ENTER= 3       /ENTER A FILE
+CLOSE= 4       /CLOSE A FILE
+DECODE= 5      /CALL THE COMMAND DECODER
+HASH=  3       /HASH CODE SUBTRACTION FACTOR(MH)
+
+*10
+NAMPTR,        0       /POINTER TO CMD DECODER INPUT NAMES
+XR1,   0       /RANDOM INDEX REGISTER
+XR2,   0       /ANOTHER RANDOM INDEX REGISTER
+
+*30
+COUNT, 0       /RANDOM WORD COUNT FOR ANYTHING
+CHAR,  0       /TEMPORARY PLACE TO PUT A CHARACTER
+WILD,  0       /IF NONZERO, NAME HAS '*' OR '?' IN IT
+WASHLP,        0       /NONZERO IF HELP WAS FOUND ON THIS WORD
+NAME,  ZBLOCK 6 /NAME HELP WAS REQUESTED ON
+TXTNAM,        ZBLOCK 10 /CURRENT SCRIPT FILE NAME BEING LOOKED AT
+NAMCNT,        0       /NUMBER OF NAMES IN THE COMMAND DECODER AREA
+BLKCNT,        0       /NUMBER OF AVAILABLE BLOCKS ON OUTPUT
+OUTADR,        0       /ADDRESS OF OUTPUT HANDLER
+LINCNT,        0       /COUNT OF NUMBER OF NAMES ON '*' OR 'HELP' LINE
+LINMAX,        -5      /MAXIMUN NUMBER OF NAMES/LINE ON '*' OR 'HELP' LINE
+FILNAM,        ZBLOCK  4 /OUTPUT FILE NAME
+WDCTR, 0       /WORD COUNTER IN INPUT BLOCK
+CHTEM, 0       /TEMPORARY SPOT FOR CHARACTER IN 2/3 UNPACK
+DEVHND,        0       /OUTPUT DEVICE HANDLER ADDRESS
+CHPTR, 0       /BUFFER POINTER FOR READING CHARACTERS
+TEMP,  0       /TEMP STORE
+\f
+/ MAIN LOOP OF PROGRAM
+STADR=200
+*STADR
+START, SKP CLA         /NORMAL ENTRY POINT
+       JMP     START1  /CHAINED ENTRY (CMD DECODE DONE BY CCL)
+       CIF 10          /SEE WHAT TO DO
+       JMS I   (USR
+       DECODE
+       5200
+       0
+START1,        JMS I   (INIT   /DO ALL INITIALIZATION AND SETUP
+MAINLP,        JMS I   (NXTNAM /GET NEXT NAME FROM COMMAND DECODER AREA
+       JMP I   (EXIT   /NO NAMES LEFT
+       JMS I   (RESET  /RESET THE INPUT FILE POINTERS TO THE BEGINNING
+       TAD     NAME    /CHECK FOR '*' OR 'HELP" NAME INDICATING LIST OF HELPS
+       TAD     (-"*
+       SNA!CLA
+       JMP     HELPLS  /NAME BEGAN WITH '*'
+       TAD     NAME    /NOT '*' LOOK FOR HELP (MH)
+       TAD     (-"H
+       SZA!CLA
+       JMP     MAIN1   /NO 'HELP'
+       TAD     NAME+1
+       TAD     (-"E
+       SZA!CLA
+       JMP     MAIN1
+       TAD     NAME+2
+       TAD     (-"L
+       SZA!CLA
+       JMP     MAIN1
+       TAD     NAME+3
+       TAD     (-"P
+       SNA!CLA
+       JMP     HELPLS  /WAS 'HELP" GO PRINT LIST (MH)
+       TAD     NAME    /IS 1ST CHAR A "?"?(MH)
+       TAD     (-"?    /(MH)
+       SNA!CLA         /(MH)
+       JMP     MAIN1   /YES -- DON'T TRY TO HASH FILE (MH)
+       TAD     NAME    /NO -- HASH START BLK OF FILE BY (MH)
+       AND     (77     /MAKING 1ST CHAR OF NAME SIXBIT (MH)
+       DCA     TEMP    /MULTIPLY BY 1.5 (MH)
+       TAD     NAME    /THEN SUBTRACT "HASH"(3) (MH)
+       AND     (77     /(MH)
+       CLL!RAR         /(MH)
+       TAD     TEMP    /(MH)
+       TAD     (-HASH  /(MH)
+       SPA             /(MH)
+       CLA             /IF RESULT IF MINUS, SET TO ZERO (MH)
+       TAD I   (BLK    /ADD REAL START BLK OF FILE (MH)
+       DCA I   (BLK    /REPLACE NEW BLOCK(MH)
+MAIN1, JMS I   (FINDNM /GET A NAME FROM THE SCRIPT FILE
+       JMP     NOHELP  /HIT THE END OF THE FILE INSTEAD OF NAME
+       JMS I   (COMPAR /COMPARE THIS NAME WITH THE ONE HE HAD
+       JMP     MAIN1   /NOT A MATCH, TRY NEXT ONE
+       JMS I   (PRINT  /PRINT THE HELP INFORMATION FOR THAT NAME
+       TAD     WILD    /IF A WILD CARD TYPE NAME (I.E. '?') THEN
+       SZA CLA         /  THEN KEEP SEARCHING PAST 1ST MATCH SINCE THERE
+       JMP     MAIN1   /  MAY BE MORE.
+       JMP     MAINLP  /NOT A WILD CARD, GET NEXT CMD DECODER NAME
+
+/ HIT THE END OF THE SCRIPT FILE
+/ IF DOING A WILD CARD NAME, SOME HJELP MAY HAVE ALREADY BEEN PRINTED.  IF
+/ NOT, PRINT AN ERROR MESSAGE ON THE TELETYPE (OR WHATEVER)
+NOHELP,        TAD     WASHLP  /SEE IF HELP WAS ADMINISTERED
+       SZA CLA
+       JMP     MAINLP  /YES IT WAS, TRY NEXT NAME ON LIST
+       JMS I   (TYPE   /TYPE THE ERROR MESSAGE ON THE TTY
+       SORRY-1
+       DCA     TXTNAM  /PUT ON ZERO TERMINATER
+       JMS I   (TYPE
+       NAME-1          /TYPE WHAT HELP MISSED
+       JMS I   (TYPE
+       CRLF-1          /TYPE CARR RETURN, LINE FEED
+       JMP     MAINLP  /NOW CONTINUE ON WITH IT
+  
+  
+/ IF A '*' OR 'HELP' WAS TYPED AS HELP NAME, THEN PRINT A LISTING
+/ OF ALL THE INFO IN THE HELP FILE FOR THE USER TO PICK FROM.
+HELPLS,        JMS I   [OUTSTR /PRINT THE HEADING MESSAGE
+       AVAIL-1
+       TAD     LINMAX  /MAX NO. NAMES PER LINE
+       DCA     LINCNT  /INITIAL COUNT OF NAMES PER LINE
+HELP1, JMS I   (FINDNM /GET NEXT NAME
+       JMP     HELP2   /AT END OF FILE
+       JMS I   (NAMLST /PRINT THE NAME
+       JMP     HELP1
+HELP2, TAD     LINCNT  /CHECK IF LAST CHAR WAS CRLF
+       SNA!CLA
+       JMP     MAINLP  /IT WAS, DON'T DO ANOTHER
+       JMS I   [OUTSTR
+       CRLF-1
+       JMP     MAINLP
+\f      PAGE
+/ CLOSE ALL FILES AND RETURN TO MONITOR
+/
+EXIT,  TAD     (32     /WRITE AN AND OF FILE TO THE OUTPUT
+       JMS I   [PCH
+       TAD     (-600   /CLOSE FILE BY WRITING 600(8) NULLS
+       DCA     COUNT
+       JMS I   [PCH    /WRITE IT
+       ISZ     COUNT
+       JMP     .-2
+       TAD I   [BLKSRT /COMPUTE ACTUAL FILE LENGTH FOR CLOSE
+       CIA
+       TAD I   [OUTBLK /CURRENT BLOCK NUMBER
+       IAC
+       DCA     OLEN
+       CIF CDF 10
+       TAD I   [7600
+       CDF 0
+       JMS I   (USR    /CLOSE THE FILE
+       CLOSE
+       FILNAM
+OLEN,  0               /THE LENGTH
+       NOP             /ERROR ON CLOSE... CAN'T HAPPEN(MH)
+       JMP I   (7605   /RETURN TO OS/8
+\f
+/ SEARCH FOR A <LF>& IN THE FILE
+/ THIS IS THE START OF SOME HELP INFO FOR A SUBJECT WHICH IS NAMED AFTER
+/ THE &.  COPY THE NAME INTO 'TXTNAM' SO COMPARES CAN BE DONE LATER.
+/ SKIP IF THE END OF FILE ISN'T FOUND ON THE WAY.
+FINDNM,        0
+       DCA     TXTNAM  /CLEAR THE NAME OUT
+       DCA     TXTNAM+1
+       DCA     TXTNAM+2
+       DCA     TXTNAM+3
+       DCA     TXTNAM+4
+       DCA     TXTNAM+5
+       DCA     TXTNAM+6
+FIND1, JMS I   [GCH    /LOOK FOR A <LF>& IN THE FILE
+       TAD     (-232   /CHECK FOR END OF FILE
+       SNA 
+       JMP I   FINDNM  /RETURN IF FOUND
+       TAD     (232-212        /CHECK FOR LINE FEED
+       SZA CLA
+       JMP     FIND1   /NOT IT
+FIND5, JMS I   [GCH    /TRY FOR THE & NOW
+       TAD     (-"&
+       SNA CLA
+       JMP     FIND2   /FOUND A LF,&
+       TAD     ("&-232 /MAKE SURE THIS ISNT THE END OF FILE
+       SNA CLA
+       JMP I   FINDNM  /END OF FILE FOUND, RETURN
+       JMP     FIND1   /KEEP LOOKING FOR NAME
+FIND2, TAD     (TXTNAM-1 /MOVE THE NAME INTO 'TXTNAM'
+       DCA     XR1
+       TAD     (-7     /MAX OF 7 CHARACTERS
+       DCA     COUNT
+FIND3, JMS I   [GCH    /GET A NAME CHARACTER
+       TAD     (-215   /CHECK IF THE END OF LINE <CR>
+       SNA CLA
+       JMP     FIND4   /END OF LINE, THATS IT
+       TAD     CHAR
+       DCA I   XR1     /SAVE CHARACTER IN TXTNAM
+       ISZ     COUNT
+       JMP     FIND3   /IF MORE CHARACTERS LEFT
+FIND4, ISZ     FINDNM  /BUMP RETURN ADDRESS FOR FOUND RETURN
+       JMP I   FINDNM
+       PAGE
+\f
+/ COMPARE TWO STRINGS, ONE IN NAME AND ONE IN TXTNAM.  CHECK FOR WILD
+/ CARD STUFF LATER WHEN THIS PART IS WORKING.
+/ SKIP IF NAMES ARE EQUAL
+COMPAR,        0
+       TAD     [NAME-1 /SET UP REGISTERS FOR COMPARE
+       DCA     XR1
+       TAD     (TXTNAM-1
+       DCA     XR2
+       TAD     (-6
+       DCA     COUNT
+COMP1, TAD I   XR1     /GET A CHARACTER AND COMPARE WITH ONE FROM
+       DCA     CHAR
+       TAD     CHAR
+       TAD     (-"?    /WILDCARD
+       SZA CLA
+       JMP     COMP3   /NO WILDCARD
+       ISZ     XR2
+       ISZ     WILD
+       JMP     COMP2
+COMP3, TAD     CHAR
+       CIA             /   THE OTHER STRING
+       TAD I   XR2
+       SZA CLA
+       JMP I   COMPAR  /NO MATCH, NORMAL RETURN
+COMP2, ISZ     COUNT
+       JMP     COMP1
+       ISZ     COMPAR  /EQUAL RETURN IS RETRN ADDR+1
+       JMP I   COMPAR
+\f
+/ GET THE NEXT NAME FROM THE COMMAND DECODER AREA
+/ STOP ON EITHER A ZERO OR THE NAME GOING TO ZERO
+NXTNAM,        0
+       ISZ     NAMCNT  /COUNT NAMES, ONLY 5 IN THE AREA
+       SKP
+       JMP I   NXTNAM  /RETURN, NO MORE NAMES
+       CLA CLL CMA RTL /NUMBER OF WORDS OF NAME(-3)
+       DCA     COUNT
+       TAD     [NAME-1
+       DCA     XR1
+       CDF 10
+       TAD I   NAMPTR  /GET 1ST CHARACTER OF NAME
+       CDF 0
+       SNA
+       JMP     NXTN3   /MAYBE OUT OF NAMES(MH)
+NXTN1, DCA     CHAR    /SAVE THE WORD
+       TAD     CHAR
+       RTR
+       RTR
+       RTR             /ISOLATE HIGH 6 BITS
+       JMS     SIXTO8
+       DCA I   XR1     /PUT IN NAME BUFFER
+       TAD     CHAR    /NOW DO OTHER HALF
+       JMS     SIXTO8
+       DCA I   XR1     /2ND CHARACTER OF WORD
+       ISZ     COUNT
+       SKP
+       JMP     NXTN2   /NO MORE CHARACTERS IN NAME
+       CDF 10
+       TAD I   NAMPTR  /LOOP IS STRANGE (SHOULD USE DEVICE WORD FOR CHECK)
+       CDF 0
+       JMP     NXTN1
+NXTN2, ISZ     NAMPTR  /BUMP POINTER TO NEXT NAME IN AREA
+       ISZ     NAMPTR
+       ISZ     NXTNAM  /BUMP RETURN ADDRESS FOR FOUND NAME
+       JMP I   NXTNAM
+NXTN3, TAD     NAMCNT  /CHECK FOR "HELP<CR>" OR "TTY:<<CR>"(MH)
+       TAD     (4      /IF 1ST TRY AT A NAME THEN NULL COMMAND WAS INPUT(MH)
+       SZA!CLA
+       JMP I   NXTNAM  /WASN'T NULL -- RETURN, END OF NAMES
+       DCA     NAME    /WAS NULL -- CLEAR OUT NAME BUFFER
+       DCA     NAME+1
+       DCA     NAME+2
+       DCA     NAME+3
+       DCA     NAME+4
+       DCA     NAME+5
+       JMP     NXTN2   /PREPARE TO RETURN(MH)
+
+SIXTO8,        0               /CONVERT 6BIT TO 8BIT
+       AND     (77
+       SNA             /SNA IF NOT A NULL
+       JMP I   SIXTO8  /ELSE RETURN 8BIT NULL
+       TAD     (240
+       AND     (77
+       TAD     (240
+       JMP I   SIXTO8
+\f
+/ PRINT ALL THE STUFF BETWEEN LINES OF THE OUTPUT DEVICE
+/ THIS CONTINUES UNTIL A <LF>& IS SEEN OR AND OF FILE IS READ
+PRINT, 0
+       ISZ     WASHLP  /SET FLAG SAYING HE WAS HELPED
+PRINT3,        JMS I   [GCH    /FIND 1ST LF WITHOUT FOLLOWING &, THEN PRINT(MH)
+       TAD     (-212   /WAS CHAR LF?(MH)
+       SZA!CLA         /(MH)
+       JMP     PRINT3  /NO -- READ NEXT CHAR(MH)
+       JMS I   [GCH    /YES -- LOOK FOR &(MH)
+       TAD     (-"&    /(MH)
+       SNA!CLA         /(MH)
+       JMP     PRINT3  /IT WAS & SO CONTINUE(MH)
+       JMS I   (OUTSTR /IT WASN'T & SO BEGIN PRINTING(MH)
+       CRLF-1
+       TAD     CHAR    /(MH)
+       SKP             /(MH)
+PRINT1,        JMS I   [GCH    /GET A CHARACTER
+       JMS I   [PCH    /PRINT THE CHARACTER
+       TAD     CHAR    /CHECK FOR <LF>
+       TAD     (-212
+       SZA CLA
+       JMP     PRINT1
+       JMS I   [GCH    /TRY FOR EITHER & OR END OF FILE OR FF
+       TAD     (-"&    /CHECK FOR A &
+       SNA
+       JMP I   PRINT   /STOP ON <LF> & FOUND
+       TAD     (+32    /CHECK FOR <FF>  ("&-"<FF>  (MH)
+       SNA             /(MH)
+       JMP I   PRINT   /(MH)
+       TAD     (-16    /-<EOT>+<FF> (MH)
+       SNA
+       JMP I   PRINT   /RETURN IF END OF FILE
+       TAD     (232-"@
+       SNA CLA
+       JMP     PRINT1  /SKIP "@" IF 1ST CHAR ON LINE
+       TAD     CHAR    /GET THE CHARACTER BACK TO PRINT
+       JMS I   [PCH    /PRINT IT
+       JMP     PRINT1
+       PAGE
+\f/ TYPE A MESSAGE ON THE TELETYPE
+/ THE MESSAGE IS ONE CHARACTER PER WORD, TERMINATED WITH A ZERO
+TYPE,  0
+       TAD I   TYPE    /GET THE MESSAGE ADDRESS
+       ISZ     TYPE    /BUMP RETURN ADDRESS
+       DCA     XR1
+TYPE1, TAD I   XR1     /GET A CHARACTER
+       SNA
+       JMP I   TYPE    /END OF THE MESSAGE
+       TLS             /PRINT THE CHARACTER
+TYPE2, TSF
+       JMP     TYPE2
+       CLA
+       JMP     TYPE1   /LOOP
+  
+  
+/PRINT THE NEXT NAME ON THE OUTPUT DEVICE AND CHECK TO SEE IF
+/ A CRLF IS NEEDED. EACH NAME IS TERMINATED WITH A TAB CHAR
+NAMLST,        0
+       TAD     TXTNAM  /CHECK FOR NULL NAME (MH)
+       SZA!CLA         /(MH)
+       JMP     NAMLS1  /NOT NULL NAME (MH)
+       JMS     OUTSTR  /WAS NULL -- PRINT "<NONE>" (MH)
+       NULNAM-1        /(MH)
+       JMP     NAMLS2  /PROCEED (MH)
+NAMLS1,        JMS     OUTSTR  /PRINT THE NAME ON THE DEVICE
+       TXTNAM-1
+NAMLS2,        JMS     OUTSTR  /PRINT A TAB AFTER NAME
+       TAB-1
+       ISZ     LINCNT  /BUMP NUMBER PRINTED SO FAR
+       JMP I   NAMLST  /NO YET, JUST RETURN
+       TAD     LINMAX  /RESET TO MAX NUMBER OF NAMES PER LINE
+       DCA     LINCNT
+       JMS     OUTSTR  /TYPE CRLF
+       CRLF-1
+       JMP I   NAMLST  /NOW RETURN
+
+
+/ PRINT A STRING ON THE OUTPUT DEVICE BY STUFFING THE CHARACTERS
+/ IN THE OUTPUT FILE.  THE ADDRESS-1 IS FOLLOWING THE JMS
+OUTSTR,        0
+       TAD I   OUTSTR  /GET THE ADDRESS
+       ISZ     OUTSTR
+       DCA     XR1     /POINTER TO NAME
+OUTS1, TAD I   XR1     /GET A CHARACTER
+       SNA
+       JMP I   OUTSTR  /RETURN IF DONE
+       JMS I   [PCH    /PRINT THE CHARACTER
+       JMP     OUTS1
+
+       PAGE
+\f/ GET A CHARACTER FROM THE INPUT FILE
+GCH,   0
+       TAD     CHAR    /RETURN A EOF IF THE LAST WAS EOF
+       TAD     (-232
+       SZA CLA
+       JMP I   GIVCH   /NOT EOF, GET NEXT CHARACTER
+       TAD     (232    /GET END OF FILE
+       JMP I   GCH
+
+GIVCH, INITBF          /INITIALLY SET UP BUFFERS
+       AND     (377    /MASK THE CHARACTER
+       DCA     CHAR    /SAVE CHARACTER
+       TAD     CHAR
+       JMP I   GCH     /RETURN
+
+INITBF,        TAD     (-2000  /SET WORD COUNT FOR BLOCK(MH)
+       DCA     WDCTR
+       TAD     BUFAD
+       DCA     CHPTR   /CHARACTER POINTER FOR BUFFER
+       TAD I   (BLKBGN /FIND OUT IF DATA TRANSFER WILL(MH)
+       CMA!IAC         /PASS END OF FILE, IF SO REDUCE(MH)
+       TAD I   (FSIZE  /SIZE OF TRANSFER.(MH)
+       DCA     TEMP    /SAVE -ST. BLK.-FILE SIZE(MH)
+       TAD     RDFCT   /GET TRANSFER LENGTH IN BLKS(MH)
+       CLL!RTL         /(MH)
+       RTL             /(MH)
+       RTL             /(MH)
+       TAD     BLK     /ADD CURRENT BLK(MH)
+       TAD     TEMP    /SUBTRACT (ST. BLK OF FILE + SIZE)(MH)
+       SPA!SNA         /(MH)
+       JMP     INITOK  /PROCEED -- DON"T CHG. TRANSFER LEN(MH)
+       CLL!RTR         /CHANGE TRANSFER LENGTH SO IT WON'T(MH)
+       RTR             /PASS END OF FILE(MH)
+       RTR             /(MH)
+       CMA!IAC         /(MH)
+       TAD     RDFCT   /(MH)
+       DCA     RDFCT   /ENTER THIS INTO FUNCTION WD.(MH)
+INITOK,        JMS I   DEVHND  /CALL THE HANDLER TO READ A BLOCK
+RDFCT, 2000            /8 BLOCKS(MH)
+BUFAD, BUFFER
+BLK,   0               /BLOCK NUMBER
+       JMP     RDERR   /ERROR RETURN(MH)
+NXTCH, TAD I   CHPTR
+       JMS     GIVCH
+       TAD     (7400
+       AND I   CHPTR   /GET THE HIGH ORDER PART
+       DCA     CHTEM
+       ISZ     CHPTR
+       TAD I   CHPTR
+       JMS     GIVCH
+       TAD I   CHPTR
+       AND     (7400
+       CLL RTR
+       RTR
+       TAD     CHTEM   /GET OTHER HALF
+       RTR
+       RTR
+       JMS     GIVCH   /GIVE THIRD CHARACTER OF GROUP
+       ISZ     CHPTR
+       ISZ     WDCTR   /BUMP WORD COUNTER
+       JMP     NXTCH   /LOOP
+       TAD     RDFCT   /INCREMENT BLOCK NUMBER(MH)
+       CLL!RTL         /(MH)
+       RTL             /(MH)
+       RTL             /(MH)
+       TAD     BLK     /(MH)
+       DCA     BLK     /ENTER INTO FUNCTION WD(MH)
+       JMP     INITBF  /READ IT IN
+
+       PAGE
+\f/ ROUTINE TO INITIALIZE ALL OF THIS STUFF
+/ POINTERS GET SET AND THE FILES OPENED.
+INIT,  0
+       TAD     (OUTHSP+1
+       DCA     OUTHND
+       TAD     (OUTHSP+1       /HANDLER ADDRESS
+       DCA     OUTHN1
+       CDF 10
+       TAD I   [7600   /GET OUTPUT DEVICE
+       SNA
+       JMP     TTYDFL
+       CIF 10
+       CDF 0
+       JMS I   (USR    /FETCH THE HANDLER
+       FETCH
+OUTHN1,        OUTHSP+1
+       JMP     FETERR  /ERROR RETURN(MH)
+       TAD     OUTHN1  /GET HANDLER ADDRESS
+       JMP     COMMON  /COMMON CODE FOR BOTH FETCHES
+
+/ DEFAULT TO THE TTY WHEN NO OUTPUT DEVICE IS SPECIFIED
+TTYDFL,        TAD     TTYNM   /SET UP THE DEVICE NAME
+       DCA     TTY
+       TAD     TTYNM+1
+       DCA     TTY+1
+       CIF 10          /FETCH THE OUTPUT HANDLERS
+       CDF 0
+       JMS I   (USR
+       FETCH
+TTY,   DEVICE  TTY     /DEFAULT TO THE TTY
+OUTHND,        OUTHSP+1                /PLACE TO PUT THE HANDLER
+       JMP     NOTTY   /IF TELETYPE HANDLER DOESNT EXIST
+       TAD     TTY+1   /SET UP DEVICE NUMBER FOR COMMON CODE
+       CDF 10
+       DCA I   [7600
+       CDF 0
+       TAD     OUTHND  /GET HANDLER ENTRY POINT
+COMMON,        DCA     OUTADR
+       TAD     (OUTBUF
+       DCA I   (OCPTR
+       TAD     (-200   /OUTPUT BUFFER COUNT
+       DCA I   (OUWDCT
+       TAD     (7600
+       DCA     XR1     /COPY NAME FROM FIELD 1 CMD DEC AREA
+       CDF 10
+       TAD I   XR1
+       SNA
+       TAD     (1014   /HL.LS IS DEFAULT NAME IF NONE THERE
+       DCA     FILNAM
+       TAD I   XR1
+       DCA     FILNAM+1
+       TAD I   XR1
+       DCA     FILNAM+2
+       TAD I   XR1     /COPY EXTENSION
+       SNA
+       TAD     (1423   /USE .LS AS DEFAULT EXTENSION
+       DCA     FILNAM+3
+       CDF 0
+       TAD     (FILNAM /INITIALIZE THE ENTER
+       DCA     BLKSRT
+       CDF CIF 10
+       TAD I   (7600
+       CDF 0
+       JMS I   (USR    /DO ENTER WITH DEVICE NO IN AC
+       ENTER
+BLKSRT,        0               /STARTING BLOCK
+FILLNG,        0               /LENGTH OF FILE
+       JMP     NOROOM  /DEVICE FULL
+       TAD     BLKSRT
+       DCA I   [OUTBLK /INITIAL OUTPUT BLOCK
+       TAD     FILLNG
+       DCA     BLKCNT  /NEGATIVE FILE LENGTH IN BLOCKS
+\f
+       TAD     (7605   /SET NXTNAM POINTER TO THE NEXT NAME
+       DCA     NAMPTR
+       TAD     (-5
+       DCA     NAMCNT  /NUMBER OF CHARACTERS IN NAME
+       CIF 10
+       JMS I   (USR    /FETCH THE SYSTEM DEVICE HANDLER
+       FETCH           /  TO GET THE DEVICE NUMBER TO LOOKUP HELP FILE
+DEVNAM,        DEVICE  SYS     /(MH)
+DEVH,  0               /HANDLER ADDRESS FOR READING
+       JMP     FETERR  /FETCH ERROR(MH)
+       TAD     DEVNAM+1 /GET THE SYS DEVICE NUMBER
+       CIF 10          /LOOKUP HELP FILE WITH IT
+       JMS I   (USR
+       LOOKUP
+BLKBGN,        HELP8           /STARTING BLOCK OF THE FILE(MH) 
+FSIZE, 0               /-NUMBER OF BLOCKS(MH)
+       JMP     NOSCRP  /THE SCRIPT FILE (HELP FILE) ISNT THERE
+       TAD     DEVH
+       DCA     DEVHND  /COPY TO PG 0 FOR ADDRESSABILITY
+       JMP I   INIT    /THATS IT
+
+NOSCRP,        JMS I   (TYPE   /TYPE MESSAGE SAYING HELP FILE NOT THERE
+       NOSC-1
+       JMP I   (7605   /RETURN TO NONITOR
+NOTTY, JMS I   (TYPE
+       TTYMIS-1
+       JMP I   (7605
+TTYNM, DEVICE  TTY
+NOROOM,        JMS I   [TYPE   /DEVICE FILL
+       DEVFUL-1
+       JMP I   (7605   /RETURN TO MONITOR
+       PAGE
+\f
+/ RESET THE INPUT FILE TO THE FIRST BLOCK AND RESET ALL THE CHARACTER
+/ UNPACKING STUFF TO THE 1ST CHARACTER OF THE FILE
+RESET, 0
+       TAD I   (BUFFER /RESET BUFFER POINTER TO START
+       DCA     CHPTR
+       DCA     WASHLP  /SET NOT YET HELPED
+       DCA     CHAR    /SET TO STOP EOF STUFF
+       TAD     (-2000  /RESET WORD COUNT FOR 8 BLOCKS(MH)
+       DCA     WDCTR
+       TAD I   (BLKBGN /RESET STARTING BLOCK OF FILE
+       DCA I   (BLK
+       TAD     (2000   /RESET TRANSFER LEN FOR 8 BLOCKS(MH)
+       DCA I   (RDFCT  /(MH)
+       TAD     (INITBF /SET UP TO REREAD BLOCK 0 OF FILE
+       DCA I   (GIVCH
+       JMP I   RESET
+\f
+/ PUT A CHARACTER OUT TO THE OUTPUT DEVICE
+/ THIS IS A COOROUTINE TYPE GUY JUST LIKE THE INPUT HANDLER
+
+PCH,   0
+       JMP I   RPOS    /DISPATCH
+
+RPOS1, DCA I   OCPTR   /PUT 1ST CHARACTER IN BUFFER
+       JMS     RPOS
+
+RPOS2, DCA     HOLD    /SAVE THE 2ND CHARACTER
+       JMS     RPOS
+
+RPOS3, RTL             /PACK THE CHARACTERS
+       RTL
+       DCA     HOLD2
+       TAD     HOLD2
+       AND     (7400
+       TAD I   OCPTR
+       DCA I   OCPTR   /PART WAY DONE
+       ISZ     OCPTR
+       TAD     HOLD2
+       RTL
+       RTL
+       AND     (7400   /NOW THE 2ND WORD
+       TAD     HOLD
+       DCA I   OCPTR
+       ISZ     OCPTR   /BUMP POINTER AGAIN
+       ISZ     OUWDCT
+       SKP
+       JMS     DUMP    /IF AT THE END OF THE BUFFER
+RPOS4, JMS     RPOS
+       JMP     RPOS1
+RPOS,  RPOS1           /INITIALLY SET TO THE 1ST CHARACTER
+       JMP I   PCH     /RETURN TO THE USER
+
+OUWDCT,        0       /OUTPUT BUFFER WORD COUNTER
+OCPTR, 0       /OUTPUT CHARACTER BUFFER POINTER
+HOLD,  0       /TEMPORARY PLACE TO PUT A CHARACACTER
+HOLD2, 0       /SAME AS ABOVE
+\f
+/ DUMP THE OUTPUT BUFFER TO THE OUTPUT FILE
+
+DUMP,  0
+       ISZ     BLKCNT  /SEE IF ANY ROOM LEFT TO DUMP TO
+       SKP
+       JMP     DUMPER  /IF OUT OF ROOM
+       JMS I   OUTADR  /CALL THE HANDLER
+       4200
+OUTBFA,        OUTBUF          /OUTPUT BUFFER ADDRESS
+OUTBLK,        0               /OUTPUT BUFFER BLOCK NUMBER
+       JMP     WRERR   /WRITE ERROR(MH)
+       TAD     OUTBFA  /RESET INPUT POINTER
+       DCA     OCPTR
+       TAD     (-200   /RESET THE WORD COUNT
+       DCA     OUWDCT
+       ISZ     OUTBLK  /BUMP OUTPUT BLOCK NUMBER
+       JMP I   DUMP    /RETURN
+DUMPER,        JMS I   (TYPE   /TYPE ERROR MESSAGE
+       DEVFUL-1        /FILE FULL ERROR
+       JMP I   (7605
+WRERR, JMS I   (TYPE           /WRITE ERROR (MH)
+       MWRERR-1        /(MH)
+       JMP I   (7605   /(MH)
+FETERR,        JMS I   (TYPE   /FETCH ERROR (MH)
+       MFEERR-1        /(MH)
+       JMP I   (7605   /(MH)
+RDERR, JMS I   (TYPE   /(READ ERROR (MH)
+       MRDERR-1        /(MH)
+       JMP I   (7605   /(MH)
+MWRERR,        "W; "R; "I; "T; "E; 240; "E; "R; "R; 215; 212; 0
+MFEERR,        "F; "E; "T; "C; "H; 240; "E; "R; "R; 215; 212; 0
+MRDERR,        "R; "E; "A; "D; 240; "E; "R; "R; 215; 212; 0
+       PAGE
+\f
+TTYMIS,        "N;"O;" ;"T;"T;"Y;" ;"H;"A;"N;"D;215;212;0
+NOSC,  "N;"O;" ;"H;"E;"L;"P; 240; "F; "I; "L; "E; 215;212;0
+NULNAM,        242; "N; "O; "N; "E; 242; 0
+AVAIL, "       ; "H; "E; "L; "P; ".; "S; "V; 215; 212
+       240; 215; 212
+       "C; "A; "L; "L; "I; "N; "G; 240; "C; "O; "M; "M; "A; "N; "D; "S; ":
+       215; 212; ".; "H; "E; "L; "P; 240; "P; "A; "R; "A; "M; "E; "T; "E; "R
+       215; 212
+       240; 215; 212
+       "P; "A; "R; "A; "M; "E; "T; "E; "R; "S; ":; 215; 212; 0
+CRLF,  215;212;0
+TAB,   211;0
+SORRY, 215;212;"N;"O;240;"H;"E;"L;"P;240;"-;240;0
+DEVFUL,        "D;"E;"V;"I;"C;"E;240;"F;"U;"L;"L;215;212;0
+HELP8, FILENAME HELP.HL
+VERS,  0201            /VERSION 2A    (MH)
+       PAGE
+OUTHSP,        ZBLOCK  400     /OUTPUT HANDLER SPACE
+OUTBUF,        ZBLOCK  400     /OUTPUT BUFFER FOR LISTING
+BUFFER=.               /INPUT BUFFER FOR HELP FILE, 8 BLKS OR 4000 WDS (MH)
+$
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape5/README b/sw/os8/v3d/sources/system/dectapes/dectape5/README
new file mode 100644 (file)
index 0000000..0d42728
--- /dev/null
@@ -0,0 +1,14 @@
+This area contains the files contained on system release DECtape #5.
+
+Directory of OS/8 V3D DECtape 5 labeled:  AL-4695C-SA     2/27/78
+                                         OS/8 V3D SRC DT  5 OF 7
+                                         (replaces DEC-S8-OSYSB-B-UA5)
+
+
+DTCOPY.PA  50 30-OCT-75    SET   .PA  91 05-JUL-77
+HELP  .PA  50 23-MAY-77    CCL   .PA 159 25-MAY-77
+RKLFMT.PA 129 28-APR-77    
+
+   5 files in  479 blocks -  251 free blocks
+
+
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape5/RKLFMT.PA b/sw/os8/v3d/sources/system/dectapes/dectape5/RKLFMT.PA
new file mode 100644 (file)
index 0000000..64bba85
--- /dev/null
@@ -0,0 +1,2012 @@
+/RK8E/RK8L DISK FORMATTER
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT  (C)  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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/RK8E/RK8L DISK FORMATTER PROGRAM: MD-08-DHRKD-D
+/MAINDEC-08-DHRKD-D-D
+/
+/MODIFIED FOR OS8V3D BY ED STEINBERGER
+/
+DLSC=6740                      /LOAD SECTOR COUNTER
+DSKP=6741                      /SKIP ON TRANSFER DONE OR ERROR
+DCLR=6742                      /CLEAR DISK CONTROL LOGIC
+DLAG=6743                      /LOAD ADDRESS AND GO
+DLCA=6744                      /LOAD CURRENT ADDRESS
+DRST=6745                      /READ STATUS REGISTER
+DLDC=6746                      /LOAD COMMAND REGISTER
+DMAN=6747                      /LOAD MAINTENANCE
+/
+LDSC=JMS I     XXLDSC
+IOTCHN=JMS I   XCHANG
+LODTRK=JMS I   XWRTRK
+REDDSK=JMS I   XRDTRK
+RECAL=JMS I    XRESTR
+RECEIV=JMS I   XWAIT
+KILBUF=JMS I   XKLBUF
+ERROR=JMS I    XERRO
+RDSTAT=JMS I   XRDST
+LDADD=JMS I    XLDAD
+DSKSKP=JMS I   XSDKP
+LDCMD=JMS I    XLDCM
+LDCUR=JMS I    XLDCA
+CLRALL=JMS I   XCLDR
+PRNTER=JMS I   XPRN
+OCTEL=JMS I    XFROCT
+TWOCT=JMS I    XTOCT
+TYPE=JMS I     XPRINT
+CRLF=JMS I     XCRLF
+APT8A=JMS I    XAPT8
+TIME=JMS I     XTIME
+TICK=JMS I     XTICK
+KAERRO=JMS I   XAERRO
+/
+*0
+/
+       304                     /REV D
+       5001
+       0002
+       0003
+/
+*10
+/
+AUTO10,        0
+/
+AUTO11,        0
+/
+*20
+/
+       0000                    /PSEUDO SWITCH REGISTER
+       0                       /CONTROL WORD 1 - USE PSUEDO SWITCHES **ES**
+       400                     /CONTROL WORD 2 - SET CONSOLE PACKAGE ACTIVE **ES**
+       0000                    /RESERVED
+XAPT8, APT8
+XTIME, KTIME
+XAERRO,        AERRO
+XTICK, KTICK
+XCHANG,        CHANG
+XWRTRK,        WRTTRK
+XRDTRK,        REDTRK
+XRESTR,        RESTOR
+XWAIT, WAIT
+XKLBUF,        KLBUF
+XPRINT,        PRINT
+XERRO, ERRO
+XRDST, RDST
+XSDKP, SDKP
+XLDCM, LDCM
+XLDCA, LDCA
+XLDAD, LDAD
+XCLDR, CLDR
+XXLDSC,        XLDSC
+XPRN,  PRN
+XFROCT,        FROCT
+XTOCT, TOCT
+XCRLF, UPONE
+XLOTRK,        LOTRK
+XHITRK,        HITRK
+BGNBUF,        WRKBUF
+AMOUNT,        0
+SWITCH,        0
+K0003, 0003
+K4,    4
+K0007, 0007
+K0040, 0040
+M313,  -313
+K0277, 0277
+K0200, 0200
+K0260, 0260
+K4000, 4000
+K7735, 7735
+K7760, 7760
+K0400, 400
+K0037, 0037
+KCDF,  CDF
+M4,    -4
+M10,   -10
+DRIVNO,        0
+CHAR,  0
+LOWAD, 0
+HIGHAD,        0
+TRKCNT,        0
+DSKCNT,        0
+SBCNT1,        0
+STCNT1,        0
+STCNT2,        0
+STCNT3,        0
+TCNTR1,        0
+TCNTR2,        0
+TCNTR3,        0
+TCNTR4,        0
+TCNTR5,        0
+/
+GDREG2,        0
+EXBIT, 0
+CMREG, 0
+STREG, 0
+DAREG, 0
+CAREG, 0
+ADREG, 0
+DTREG, 0
+BGNTST,        FRMDSK
+HOMEMA,        0
+DATCNT,        0
+CLKCNT,        -2
+/
+XMOVE, MOVE
+LOC8ED,        0
+XEND,  ENDTST
+SOFT,  0
+ADPOT1,        DSK0A
+DSK0A, 0
+DSK1A, 0
+DSK2A, 0
+DSK3A, 0
+DSK4A, 0
+DSK5A, 0
+DSK6A, 0
+DSK7A, 0
+ADPOT2,        DSK0B
+DSK0B, 0
+DSK1B, 0
+DSK2B, 0
+DSK3B, 0
+DSK4B, 0
+DSK5B, 0
+DSK6B, 0
+DSK7B, 0
+PCOUNT,        0                               /USED ONLY IF ON APT
+/
+*200
+/
+BGN,   RIF
+       DCA     HOMEMA
+       TAD     HOMEMA
+       TAD     KCDF                    /MAKE HOMEDF
+       DCA     .+1
+       HLT                             /MAKE DF=IF
+/NOW TEST FOR APT SYSTEM
+/IF ON APT TERMINAL MESSAGES ARE SKIP
+/TO AVOID TIMING PROBLEMS WITH THE SYSTEM
+       APT8A                           /TEST FOR APT SYSTEM
+       JMS     XC8PSW                  /GET SR=.
+       *.-1                    /**ES**
+       NOP                     /**ES**
+       IOTCHN                          /CHANGE DEVICE TO SWR3-8
+       CRLF
+       CRLF
+       PRNTER                          /PRINT "RK8E/RK8L DISK FORMATTER PROGRAM"
+       MES1                            /MESSAGE 1 POINTER
+       CRLF
+       PRNTER                          /PRINT "FOR ALL QUESTIONS"
+       MES2                            /MESSAGE POINTER 2
+ALLAGN,        TAD     M10
+       DCA     STCNT1                  /COUNTER FOR AMOUNT OF DISKS
+       DCA     LOC8ED
+       DCA     STCNT2
+SAMAGN,        CRLF
+       PRNTER                  /PRINT "FORMAT DISK ? "
+       MES3                            /MESSAGE POINTER 3
+       TAD     STCNT2
+       TAD     K0260
+       TYPE                            /TYPE DISK NUMBER
+QUES1, TAD     K0277
+       TYPE                            /TYPE ?
+       TAD     ADPOT1
+       TAD     STCNT2
+       DCA     STCNT3
+       RECEIV                          /WAIT FOR CHARACTER
+       JMP     NOTDSK                  /NO NOT THIS DISK
+       JMP     QUES1                   /NEITHER YES OR NO
+WASDSK,        ISZ     LOC8ED
+       CLA CLL CMA
+NOTDSK,        DCA I   STCNT3                  /YES, WAS CLEAR DISK POINTER
+       ISZ     STCNT2                  /UPDATE POINTER
+       ISZ     STCNT1                  /COUNT DISKS
+       JMP     SAMAGN                  /ASK ABOUT NEXT
+/
+DONE,  CRLF
+       PRNTER                          /PRINT "ARE YOU SURE ?"
+       MES4                            /MESSAGE POINTER 4
+       RECEIV                          /WAIT FOR CHARACTER
+       JMP     ALLAGN                  /NO, START ALL OVER
+       JMP     DONE                    /NEITHER TYPE ?
+       TAD     LOC8ED
+       CIA
+       SNA                             /ANY DISKS
+       JMP     BGN                     /NO, OPERATOR ERROR
+       DCA     LOC8ED                  /YES, AMOUNT LOCATED
+/
+/FIRST RECALIBRATE AND FORMAT IN WRITE ALL MODE
+/ALL DISK DRIVES SELECTED BY OPERATOR,. MAKE THE FIRST
+/TWO WORDS OF EVERY DISK SECTOR EQUAL TO THE 
+/ABSOLUTE DISK ADDRESS.
+/
+FRMDSK,        JMS I   XMOVE                   /MOVE DISK POINTERS
+       TAD     LOC8ED
+       DCA     AMOUNT
+       TAD     AMOUNT
+       DCA     DSKCNT                  /COUNTER FOR AMOUNT OF DISKS
+       DCA     TCNTR4
+       TAD     ADPOT2
+       DCA     TCNTR5                  /A FEW COUNTERS
+       TAD I   TCNTR5
+       SZA CLA                         /FORMAT THIS DISK
+       JMP     FORMAT                  /YES, GO
+NEXFRM,        ISZ     TCNTR5                  /NO, TRY NEXT
+       ISZ     TCNTR4
+       JMP     .-5
+       HLT                             /WHAT HAPPENED????
+/
+FORMAT,        TAD     TCNTR4
+       AND     K0003                   /MASK OUT
+       CLL RAL                         /MAKE DISK NUMBER
+       DCA     DRIVNO
+       TAD     TCNTR4
+       AND     K4
+       SZA CLA
+       TAD     K0200
+       DCA     EXBIT                   /SET EXTENDED DRIVE BIT
+       RECAL                           /RECALIBRATE THIS DRIVE
+       JMP     RENEX1                  /RECALIBRATE NEXT EXISTING
+       DCA     LOWAD                   /SETUP ADDRESS POINTER
+       DCA     HIGHAD                  /SETUP ADDRESS POINTER
+       TAD     M313
+       DCA     TRKCNT                  /COUNTER FOR AMOUNT OF TRACKS
+/
+/
+WRTDSK,        TICK                            /TIMING FOR APT IF NEEDED.
+       -4                              /OTHERWISE BOTH ARE SKIPPED
+       LODTRK                          /FORMAT A TRACK
+       JMP     RENEX1                  /TO NEXT DISK
+       CLA CLL
+       TAD     LOWAD
+       TAD     K0040
+       DCA     LOWAD                   /UPDATE TO NEXT TRACK
+       SZL CLA                         /SET EXTENDED BIT
+       ISZ     HIGHAD                  /YES
+       ISZ     TRKCNT                  /UPDATE TRACK COUNTER
+       JMP     WRTDSK                  /DO NEXT TRACK
+RENEX1,        ISZ     DSKCNT                  /UPDATE DISK COUNTER
+\f      JMP     NEXFRM                  /DO NEXT DISK
+/
+/ROUTINE TO CHECK ADDRESSING INFORMATION ON THE DISK.
+\f/THE FIRST TWO WORDS OF EVERY SECTOR SHOULD EQUAL
+/THE ABSOLUTE DISK ADDRESS. ALL OTHER DATA IS
+/NOT CHECKED.
+/
+CHKDSK,        TAD     AMOUNT
+       DCA     DSKCNT                  /AMOUNT OF DISKS
+       DCA     TCNTR4
+       TAD     ADPOT2
+       DCA     TCNTR5
+       TAD I   TCNTR5                  /SOFTWARE INFORMATION
+       SZA CLA                         /CHECK THIS DISK
+       JMP     CHKDAT                  /CHECK THIS ONE
+NEXCHK,        ISZ     TCNTR5                  /UPDATE FOR NEXT DISK
+       ISZ     TCNTR4
+       JMP     .-5
+       HLT                             /WHAT HAPPENED?????
+/
+CHKDAT,        TAD     TCNTR4
+       AND     K0003                   /MASK OUT
+       CLL RAL                         /MAKE DRIVE NUMBER
+       DCA     DRIVNO
+       TAD     TCNTR4
+       AND     K4
+       SZA CLA
+       TAD     K0200
+       DCA     EXBIT                   /SET EXTENDED DRIVE BIT
+       RECAL                           /RECALIBRATE
+       JMP     RENEX2                  /TRY NEXT DRIVE
+       DCA     LOWAD
+       DCA     HIGHAD                  /SETUP STARTING DISK ADDRESS
+       TAD     M313
+       DCA     TRKCNT                  /AMOUNT OF TRACKS TO DO
+       JMP     CHECK
+/
+PAGE
+/
+CHECK, TICK                            /TIMING FOR APT IF NEEDED.
+       -4                              /SKIPPED IF NOT REQUIRED.
+       REDDSK                          /READ AND CHECK ONE CYLINDER
+       JMP     RENEX2                  /TO NEXT DISK
+       CLA CLL
+       TAD     LOWAD
+       TAD     K0040
+       DCA     LOWAD                   /UPDATE TO NEXT CYLINDER
+       SZL CLA                         /TIME TO SET EXTENDED BIT
+       ISZ     HIGHAD                  /YES, SET IT
+       ISZ     TRKCNT                  /UPDATE CYLINDER COUNTER
+       JMP     CHECK                   /CHECK NEXT ONE
+RENEX2,        ISZ     DSKCNT                  /UPDATE DISK COUNTER
+       JMP     NEXCHK                  /CHECK NEXT
+/
+/
+       TAD     22
+       AND     K4000                   /TEST FOR APT
+       SNA CLA                         /ARE WE?
+       JMP     ENDTST                  /NO. NORMAL RUN
+       ISZ     PCOUNT                  /INCREMENT PASS COUNT
+       JMP     FRMDSK                  /LOOP PROGRAM
+ENDTST,        CRLF
+       PRNTER                          /PRINT "PASS COMPLETE"
+       TEXEND
+       CRLF
+       PRNTER                          /PRINT "TRY SAME SEQUENCE"
+       MES5
+       RECEIV                          /WAIT FOR INPUT FROM OPERATOR
+       JMP     ALLAGN                  /NO, ASK AGAIN
+       JMP     .-5
+       JMP     FRMDSK                  /TRY SAME SEQUENCE
+/
+/
+/SUBROUTINE FOR "ERRORS," SCOPE LOOPS, AND
+/ERROR TYPEOUTS.
+/
+ERRO,   0
+       CLA CLL IAC
+       TAD     ERRO                    /GET PC STORED
+       DCA     RETRN1                  /STORE FOR RETURN
+       KAERRO                          /NOTIFY APT OF ERROR IS NEED BE
+        CRLF
+       CRLF
+        TAD I   ERRO                    /GET TEXT POINTER
+        AND     K0007                   /MASK 9-11
+       TAD     HEDTAD                  /MAKE ERROR HEADER TAD
+       DCA     .+1
+       HLT                             /MODIFIED HEADER TAD
+        DCA     .+2
+        PRNTER                          /MODIFIED HEADER POINTER
+        HLT
+        CRLF
+        PRNTER                          /PRINT PC:
+        TEXPC
+        TAD     ERRO                    /GET PC POINTER
+        OCTEL                           /PRINT PC STORED
+        TAD I   ERRO                    /GET TEXT POINTER
+        CLL RAL
+        SNL
+        JMP     NTGD                    /NOT GD: REGISTER
+        DCA     ERRO
+        PRNTER                          /PRINT GD:
+        TEXGD
+        TAD     GDREG2
+        OCTEL                           /PRINT FOUR OCTAL
+        SKP CLA
+NTGD,  DCA     ERRO
+       PRNTER
+       TEXEX
+       TAD     EXBIT
+       SZA CLA
+       IAC
+       OCTEL
+        TAD     XTEXT
+        DCA     PCNTR2
+        TAD     XREG
+        DCA     AUTO10
+        TAD     K7771
+        DCA     PCNTR1                  /COUNTER FOR    # OF HEADS
+       CLA CLL CMA RAL
+       DCA     PCNTR3
+STRAUT, TAD     ERRO                    /GET TEXT POINTER
+        SMA
+        JMP     NOTEX                   /NOT THIS ONE
+        CLL RAL
+        DCA     ERRO
+       TAD     PCNTR2                  /GET TEXT MESSAGE POINTER
+       ISZ     PCNTR2
+       ISZ     PCNTR2
+        DCA     .+2                     /STORE FOR PRNTER
+        PRNTER                          /PRINT XX:
+        HLT                             /MODIFIED TEXT POINTER
+        TAD I   AUTO10
+        OCTEL                           /PRINT FOUR OCTAL
+       ISZ     PCNTR3
+       SKP CLA
+       CRLF
+AGAIN, ISZ     PCNTR1
+        JMP     STRAUT                  /CHECK FOR NEXT XX:
+       JMP I   RETRN1                  /RETURN TO QUESTION
+NOTEX,  CLL RAL
+        DCA     ERRO
+       ISZ     PCNTR2
+       ISZ     PCNTR2
+        ISZ     AUTO10
+       JMP     AGAIN
+/
+RETRN1,        0
+XTEXT, TEXCM
+XREG,  EXBIT
+PCNTR1, 0
+PCNTR2,        0
+PCNTR3,        0
+HEDTAD,        TAD     HEDLST
+HEDLST,        ERTX1
+       ERTX2
+       ERTX3
+       ERTX4
+K7771, 7771
+/
+PAGE
+/
+/ROUTINE TO FORMAT CYLINDER
+/MAKE FIRST TWO WORDS OF EVERY SECTOR
+/EQUAL TO DISK ADDRESS.
+/
+WRTTRK,        0
+       CLA CLL CML RAR
+       DCA     GDREG2                  /SETUP COMPARE REGISTER
+       KILBUF                          /CLEAR BUFFER
+       TAD     K7735                   /AMOUNT OF SECTORS TO DO
+       DCA     TCNTR1                  /SETUP COUNTER
+       DCA     TCNTR2                  /STARTING WITH 0
+       TAD     K7760                   /STOPPER
+       DCA     TCNTR3                  /SECTOR COUNTER POINTER STOP
+LODR1, TAD     TCNTR2
+       AND     K0037                   /MASK SECTOR BITS
+       TAD     LOWAD                   /ADD IN CYLINDER
+       DCA I   XLOTRK                  /SETUP TRACK WORD IN BUFFER
+       TAD     EXBIT                   /ADD IN EXTENDED BIT
+       TAD     HIGHAD
+       TAD     DRIVNO                  /ADD IN DRIVE NUMBER
+       DCA I   XHITRK                  /SETUP TRACK WORD IN BUFFER
+       TAD I   XHITRK
+       AND     K7577
+       TAD     HOMEMA                  /CURRENT FIELD
+       TAD     K5000                   /FUNCTION WRITE ALL
+       LDCMD                           /LOAD COMMAND
+       TAD     EXBIT
+       LDSC                            /LOAD EXTENDED DRIVE BIT
+       CLA                             /CLEAR EXTENDED DRIVE BIT
+       TAD     BGNBUF
+       LDCUR                           /LOAD CURRENT ADDRESS
+       TAD I   XLOTRK
+       LDADD                           /LOAD TRACK AND GO
+       DSKSKP                          /SKIP ON FLAG
+       JMP     .-1                     /WAIT FOR FLAG
+       RDSTAT                          /READ STATUS
+       TAD     K4000
+       SZA CLA                         /WAS STATUS 0?
+       JMP     LODER                   /ERROR, STATUS ON WRITE ALL
+       ISZ     TCNTR2
+       ISZ     TCNTR3                  /COUNT FIRST REVOLUTION
+       SKP CLA                         /STILL IN FIRST REV.
+       DCA     TCNTR2                  /SETUP FOR SECTOR "1"
+       ISZ     TCNTR2
+       ISZ     TCNTR1                  /UPDATE SECTOR COUNTER
+\f      JMP     LODR1                   /TRY NEXT SECTOR
+       ISZ     WRTTRK
+       JMP I   WRTTRK                  /THIS CYLINDER DONE
+LODER, ERROR                           /ERROR, STATUS
+       3602                            /TEXT POINTER
+/
+       RECAL                           /CLEAR CONTROL AND DRIVE
+       JMP I   WRTTRK                  /TO NEXT DISK
+       CRLF
+       PRNTER                          /PRINT "TRY SAME AGAIN"
+       ERMES1
+       RECEIV                          /WAIT FOR YES OR NO
+       JMP     LODER-2                 /WAS A NO TRY SAME CYLINDER
+       JMP     .-5                     /WAS NEITHER ASK AGAIN
+       JMP     WRTTRK+1                /YES, TRY NEXT
+K5000, 5000
+K7577, 7577
+/
+/
+/SUBROUTINE TO READ STATUS REGISTER
+/
+RDST,   0
+IOT5,  DRST                            /READ STATUS IOT
+        SKP
+ERHLT5,        JMS     XC8ERR                  /SKIP TRAP ERROR.
+        DCA     STREG                   /SAVE RESULTS
+        TAD     STREG
+        JMP I   RDST                    /EXIT
+/
+/SUBROUTINE TO LOAD CURRENT ADDRESS REGISTER
+/
+LDCA,   0
+        DCA     ADREG                   /SAVE IN ADDRESS
+       TAD     ADREG
+       DCA     CAREG                   /SETUP INITIAL CURRENT ADDRESS
+        TAD     ADREG
+IOT4, DLCA                            /LOAD CURRENT ADDRESS IOT
+        JMP I   LDCA                    /EXIT
+ERHLT4,        JMS     XC8ERR                  /SKIP TRAP ERROR.
+       JMP     .-1
+/
+/
+/SUBROUTINE TO LOAD TRACK ADDRESS REGISTER
+/
+LDAD,   0
+       DCA     DAREG                   /SAVE OUTBOUND DATA
+       TAD     DAREG
+IOT3,  DLAG                            /LOAD DISK ADDRESS REGISTER
+        JMP I   LDAD                    /EXIT
+ERHLT3,        JMS     XC8ERR                  /SKIP TRAP ERROR.
+       JMP     .-1
+/
+/
+/SUBROUTINE TO LOAD COMMAND REGISTER
+/
+LDCM,   0
+       DCA     CMREG                   /SAVE OUTBOUND DATA
+       DCA     INMODE
+       JMS     XC8CKP                  /CHECK FOR CONTROL CHARACTERS.
+       CLA
+       CLA
+       TAD     CMREG
+IOT6,  DLDC                            /LOAD COMMAND REGISTER
+        JMP I   LDCM                    /EXIT
+ERHLT6,        JMS     XC8ERR                  /SKIP TRAP ERROR.
+       JMP     .-1
+/
+/
+/SUBROUTINE ISSUE "DLSC"
+XLDSC, 0
+IOT0,  DLSC
+       JMP I   XLDSC
+ERHLT0,        JMS     XC8ERR
+       JMP     .-1
+
+/SUBROUTINE TO ISSUE "DSKP" DISK SKIP IOT
+/
+SDKP,   0
+IOT1,  DSKP                            /DISK SKIP IOT
+        SKP                             /DID NOT SKIP
+        ISZ     SDKP
+        JMP I   SDKP                    /EXIT
+/
+/SUBROUTINE TO ISSUE "DCLR" CLEAR IOT
+/
+CLDR,   0
+IOT2,  DCLR                            /DCLR "CLEAR IOT"
+        JMP I   CLDR                    /EXIT
+ERHLT2,        JMS     XC8ERR                  /SKIP TRAP ERROR.
+       JMP     .-1
+/
+/ROUTINE TO ZERO WORK BUFFER
+/
+KLBUF, 0
+       CLA CLL CMA
+       TAD     BGNBUF                  /START OF BUFFER -1
+       DCA     AUTO10                  /SETUP AUTO INDEX
+       TAD     K7400
+       DCA     DATCNT                  /SETUP COUNTER
+       DCA I   AUTO10                  /CLEAR BUFFER
+       ISZ     DATCNT                  /UPDATE COUNTER
+       JMP     .-2                     /NOT ALL CLEARED YET
+       JMP I   KLBUF                   /BUFFER CLEARED
+K7400, 7400
+/
+PAGE
+/
+/
+/ROUTINE TO READ AND CHECK A CYLINDER
+/
+REDTRK,        0
+       TAD     K7735
+       DCA     TCNTR1                  /AMOUNT OF SECTORS TO DO
+       DCA     TCNTR2                  /STARTING WITH 0
+       TAD     K7760
+       DCA     TCNTR3
+       KILBUF                          /CLEAR BUFFER
+CHKR1, CLA CLL CMA
+       DCA     SOFT                    /SETUP SOFT ERROR FLAG
+       TAD     BGNBUF
+       LDCUR                           /LOAD CURRENT ADDRESS
+       TAD     HIGHAD                  /EXTENDED CYLINDER BIT
+       TAD     DRIVNO                  /CURRENT DRIVE
+       TAD     HOMEMA                  /CURRENT FIELD
+       LDCMD                           /LOAD COMMAND
+       TAD     EXBIT                   /LOAD EXTENDED DRIVE BIT
+       LDSC
+       CLA                             /CLEAR EXTENDED DRIVE BIT
+       TAD     TCNTR2
+       AND     K0037                   /MASK SECTOR BITS OFF
+       TAD     LOWAD                   /ADD IN OTHER DISK ADDRESS
+       LDADD                           /LOAD AND GO
+       DSKSKP                          /DISK SKIP IOT
+       JMP     .-1                     /WAIT FOR FLAG
+       RDSTAT                          /READ STATUS
+       TAD     K4000                   /ADD IN FUDGE FACTOR
+       SNA CLA                         /SKIP IF ERROR
+       JMP     STAOK                   /STATUS O.K.
+       TAD     STREG                   /GET STATUS READ
+       AND     K0010
+       SNA CLA                         /WAS IT A CRC
+       JMP     STAER                   /NO, JUST A HARD ERROR
+       DCA     SOFT                    /CLEAR SOFT ERROR FLAG
+STAOK, TAD     CMREG                   /GET LAST COMMAND
+       AND     K0007
+       TAD     EXBIT                   /ADD EXTENDED DRIVE BIT
+       CIA
+       TAD I   XHITRK                  /GET WORD READ FROM DISK
+       SNA CLA                         /SKIP IF ERROR
+       JMP     FRSTOK                  /FIRST WORD O.K.
+       TAD I   XHITRK                  /GET WORD
+       DCA     DTREG                   /SETUP ERROR PRINTER
+       TAD     CMREG
+       AND     K0007
+       DCA     GDREG2                  /SETUP GOOD FOR PRINTER
+       JMP     DATER                   /NO, DATA ERROR
+FRSTOK,        TAD I   XLOTRK                  /GET WORD READ
+       CIA
+       TAD     DAREG                   /COMPARE TO GOOD
+       SNA CLA                         /SKIP IF ERROR
+       JMP     DATOK                   /WORD O.K.
+       ISZ     ADREG                   /SETUP ERROR PRINTER
+       TAD     DAREG
+       DCA     GDREG2                  /SETUP GOOD WORD FOR PRINTER
+       TAD I   XLOTRK                  /GET WORD READ
+       DCA     DTREG                   /SETUP FOR PRINTER
+       JMP     DATER                   /DATA ERROR
+DATOK, TAD     SOFT                    /GET SOFT ERROR FLAG
+       SNA CLA                         /WAS IT CLEAR
+       JMP     STAER                   /YES, STATUS ERROR
+       TAD     TCNTR2
+       TAD     K0003                   /ADVANCE 3 SECTORS
+       DCA     TCNTR2
+       ISZ     TCNTR3
+       JMP     CHKR1                   /MORE TO FORMAT
+       ISZ     REDTRK
+       JMP I   REDTRK                  /EXIT, O.K.
+DATER, TAD     K7741
+       DCA     TCHKT                   /SETUP TEXT POINTER
+       JMP     CHKER                   /ERROR
+STAER, TAD     K3600
+       DCA     TCHKT                   /SETUP TEXT POINTER
+       CLA CLL CML RAR
+       DCA     GDREG2                  /SETUP GOOD STATUS PRINTER
+CHKER, ERROR                           /ERROR, READ DATA
+TCHKT, 0                               /MODIFIED TEXT POINTER
+       RECAL                           /CLEAR CONTROL AND DRIVE
+       JMP I   REDTRK                  /TO NEXT DISK
+       CRLF
+       PRNTER                          /PRINT "TRY SAME AGAIN"
+       ERMES3
+       RECEIV
+       JMP     DATER-2                 /CHECK NEXT 
+       JMP     .-5                     /RE-PRINT
+       JMP     REDTRK+1                /TRY SAME AGAIN
+/
+/THIS ROUTINE WILL TEST FOR APT AND NOP CONSOLE
+/PACKAGE IF NEED BE
+/
+APT8,  0
+       TAD     22
+       SMA CLA
+       JMP I   APT8
+       TAD     22
+       AND     K7377                   /ON APT. NOP CONSOLE PACKAGE
+\f      DCA     22
+       TAD     22
+       AND     K0007                   /ISOLATE DRIVE NUMBER OR
+                                       /NUMBER OF DRIVES TO BE DONE
+       DCA     STCNT1
+       TAD     22
+       AND     K0100
+       SNA CLA                         /SINGLE DRIVE TESTING
+       JMP     MULDSK                  /NO.SEVERAL TO DO
+       TAD     ADPOT1                  /GET DISK POINTER
+       TAD     STCNT1                  /ESTABLISH DRIVE TO DO
+       DCA     STCNT1
+       CLL CLA CMA                     /-1
+       DCA I   STCNT1
+       CLL CLA CMA                     /ONE DISK TO DO
+       DCA     LOC8ED
+       JMP I   BGNTST
+MULDSK,        TAD     STCNT1                  /DRIVE TO BE DONE
+       CMA
+       DCA     STCNT1
+       TAD     ADPOT1                  /GET DISK POINTER
+       TAD     STCNT2                  /ESTABLISH DRIVE TO BE DONE
+       DCA     STCNT3
+       ISZ     LOC8ED
+       CLL CLA CMA
+       DCA I   STCNT3                  /DO THIS DRIVE
+       ISZ     STCNT2  
+       ISZ     STCNT1
+       JMP     MULDSK+3                /MORE TO DO
+       TAD     LOC8ED
+       CIA
+       DCA     LOC8ED          /NUMBER TO BE DONE
+       JMP I   BGNTST
+K7377, 7377
+PAGE
+/
+/SUBROUTINE TO PRINT TWO OCTAL
+/
+TOCT,   0
+        DCA     SBCNT1                  /SAVE AC
+        TAD     SBCNT1
+        RAR
+        RTR
+        AND     K0007
+        TAD     K0260
+        TYPE                            /PRINT FIRST BYTE
+        TAD     SBCNT1
+        AND     K0007
+        TAD     K0260
+        TYPE                            /PRINT SECOND BIT
+        JMP I   TOCT                    /EXIT
+/
+/
+/
+/ROUTINE TO DO CRLF
+/
+UPONE,  0
+        CLA CLL
+        TAD     K0215
+        TYPE
+        TAD     K0212
+        TYPE
+       TYPE                            /TYPE ONE NULL
+        JMP I   UPONE
+/
+K0215, 0215
+K0212, 0212
+/
+/ROUTINE TO PRINT FOUR OCTAL
+/
+FROCT,  0
+        RTL
+        RTL
+        DCA     UPONE
+        TAD     M4
+        DCA     TOCT
+        TAD     UPONE
+        AND     K0007
+        TAD     K0260
+        TYPE
+        TAD     UPONE
+        RTL
+        RAL
+        DCA     UPONE
+        ISZ     TOCT
+        JMP     .-11
+       TAD     K0240
+       TYPE
+        JMP I   FROCT
+/
+/SUBROUTINE TO PRINT TEXT
+/
+PRN,    0
+        CLA CLL
+        TAD I   PRN                     /GET POINTER
+        ISZ     PRN
+        DCA     FROCT
+        TAD I   FROCT
+        AND     K7700
+        SNA
+        JMP     EXIT
+        SMA
+        CML
+        IAC
+        RTR
+        RTR
+        RTR
+        TYPE
+        TAD I   FROCT
+        AND     K0077
+        SNA
+        JMP     EXIT
+        TAD     K3740
+        SMA
+        TAD     K4100
+        TAD     K0240
+       TYPE
+        ISZ     FROCT
+        CLA CLL
+        JMP     PRN+5
+EXIT,   CLA CLL
+        JMP I   PRN
+
+/
+K4100, 4100
+K3740, 3740
+/
+/ROUTINE TO TYPE
+/
+PRINT,  0
+        TLS
+        TSF
+       JMP     .-1
+        TCF
+        CLA
+        JMP I   PRINT
+K0240, 0240
+K7700, 7700
+K0077, 0077
+K0010, 10
+K7741, 7741
+K3600, 3600
+/ROUTINE TO WAIT FOR KEY FROM OPERATOR
+/
+WAIT,  0
+       CLA CLL
+       KCC
+       KSF
+       JMP     .-1
+       KRB
+       TLS
+       TSF
+       JMP     .-1
+       AND     K0177
+       TAD     K0200
+       DCA     CHAR
+       TAD     CHAR
+       DCA     C8CHAR
+       ISZ     INMODE
+       JMS     XC8CNT          /CHECK FOR CONTROL CHARACTERS.
+       CLA
+       CLA
+       DCA     INMODE
+       KCC
+       TCF
+       TAD     CHAR
+       CIA
+       TAD     K0316
+       SNA CLA                         /WAS IT A NO
+       JMP I   WAIT                    /YES
+       ISZ     WAIT                    /UPDATE RETURN POINTER
+       TAD     CHAR
+       CIA
+       TAD     K0331
+       SNA CLA                         /WAS IT A YES
+       ISZ     WAIT                    /WAS A YES
+       JMP I   WAIT                    /WAS NEITHER
+K0177, 0177
+K0316, 0316
+K0331, 0331
+/
+PAGE
+/
+/
+/ROUTINE TO RECALIBRATE SELECTED DRIVE
+/
+RESTOR,        0
+       CLA CLL IAC                     /ENABLE CLEAR CONTROL
+       CLRALL                          /CLEAR CONTROL
+       TAD     DRIVNO                  /CURRENT DRIVE
+       TAD     HOMEMA                  /CURRENT FIELD
+       LDCMD                           /LOAD COMMAND
+       TAD     EXBIT
+       LDSC                            /LOAD EXTENDED DRIVE BIT
+       CLA CLL CML RAR                 /MAYBE EXPECTED STATUS
+       DCA     GDREG2                  /SETUP COMPARE REGISTER
+       CLA CLL CML RTL                 /ENABLE RECALIBRATE BIT
+       CLRALL                          /"RECALIBRATE"
+       DSKSKP                          /DISK SKIP IOT
+       JMP     .-1                     /WAIT FOR FIRST DONE FLAG
+       RDSTAT                          /READ STATUS
+       TAD     K2000
+       SNA                             /WAS IT BUSY AND DONE
+       JMP     RESTA                   /YES, THEN ITS O.K.
+       TAD     K2000                   /NO, THEN IT MUST BE JUST DONE
+       SZA CLA                         /WAS IT JUST DONE
+       JMP     RESTER                  /NO, ERROR
+RESTA, CLRALL                          /CLEAR STATUS
+       TAD     K0200                   /ENABLE SET SECOND DONE FLAG
+       TAD     CMREG                   /ORIGINAL COMMAND
+       LDCMD                           /LOAD COMMAND
+       DSKSKP                          /DISK SKIP IOT
+       JMP     .-1                     /WAIT FOR SECOND DONE
+       RDSTAT                          /READ STATUS
+       TAD     K4000
+       SZA CLA                         /WAS IT ONLY DONE FLAG
+       JMP     RESTER                  /NO, ERROR STATUS
+       CLA CLL IAC                     /ENABLE CLEAR CONTROL
+       CLRALL                          /CLEAR CONTROL
+       ISZ     RESTOR                  /UPDATE FOR GOOD RECALIBRATE
+       JMP I   RESTOR                  /RETURN
+RESTER,        ERROR                           /ERROR, STATUS
+       3603                            /TEXT POINTER
+/
+       CRLF
+       PRNTER                          /PRINT "TRY RECALIBRATE"
+       ERMES2
+       RECEIV                          /WAIT FOR INPUT
+       JMP     .+3                     /TRY NEXT EXISTING DISK
+       JMP     .-5
+       JMP     RESTOR+1                /TRY AGAIN
+       CLA CLL IAC
+       TAD     AMOUNT                  /GET AMOUNT ON SYSTEM
+       SNA                             /WAS THERE ONLY 1 LEFT
+       JMP I   XEND                    /LAST DISK
+       DCA     AMOUNT                  /MORE TO GO BUT CLEAR THIS ONE
+       DCA I   TCNTR5                  /CLEAR DISK POINTER
+       JMP I   RESTOR                  /TRY NEXT ONE
+/
+/
+/ROUTINE TO CHANGE DEVICE CODES
+/
+CHANG, 0
+       JMS     XC8SW                   /GET SWITCH REGISTER BITS.
+       RAR
+       SNL CLA                         /CHANGE DEVICE CODES?
+       JMP I   CHANG                   /NO.
+       JMS     XC8SW                   /GET SWITCHES.
+       AND     A0770
+       DCA     CSAVE1                  /SAVE DESIRED
+       TAD     CCNTR1
+       DCA     CSAVE2
+\f      TAD     CHNPOT
+       DCA     RESTOR
+CHANGR,        TAD I   RESTOR                  /GET ADDRESS POINTER
+       DCA     KWAIT
+       TAD I   KWAIT                   /GET OLD CODE
+       AND     A7007                   /MASK
+       TAD     CSAVE1                  /ADD IN DESIRED
+       DCA I   KWAIT                   /STORE DESIRED DEVICE CODE
+       ISZ     RESTOR                  /UPDATE POINTER
+       ISZ     CSAVE2                  /UPDATE CHANGE COUNTER
+       JMP     CHANGR
+       JMP I   CHANG                   /EXIT TO PROGRAM.
+/
+KWAIT, 0
+A7007, 7007
+A0770, 0770
+CSAVE1,        0
+CSAVE2,        0
+CCNTR1,        7771
+CHNPOT,        CHNPOT+1
+       IOT0
+       IOT1
+       IOT2
+       IOT3
+       IOT4
+       IOT5
+       IOT6
+K2000, 2000
+/
+/THIS ROUTINE WILL GENERATE TIMING IF NEEDED BY THE APT SYSTEM
+/
+KTICK, 0
+       CLL CLA
+       TAD     22                      /GET HARDWARE CONFIGURATION
+       AND     K4000
+       SNA CLA                         /ON APT?
+       JMP     EXTICK                  /NO
+       TAD I   KTICK                   /GET TIMING VALUE
+       DCA     COUNT                   /ESATABLISH TIME
+       ISZ     CLKCNT
+       JMP     EXTICK                  /RETURN
+       TAD     COUNT                   /GET VALUE OF COUNTER
+       DCA     CLKCNT                  /STORE IT
+       ISZ     CNT                     /TIMING NEED BE DONE?
+       JMP     EXTICK
+       TIME
+       TAD     KCNT                    /TIMING VALUE
+       DCA     CNT                     /INIT SECOND COUNTER
+EXTICK,        ISZ     KTICK                   /MOVE BEYOND TIMING VALUE
+       JMP I   KTICK
+
+COUNT, 0
+CNT,   -2
+KCNT,  -2
+K0100, 0100
+/
+/
+/ROUTINE TO NOTIFY APT OF USE IF REQUIRED
+/
+KTIME, 0
+       IOF                     /DISABLE INTERUPTS
+       RDF                     /GET PRESENT DATA FIELD
+       TAD KCDF
+       DCA .+1                 /ESTABLISHES CURRENT DATA FIELD
+       HLT
+       CIF 70                          /FIELD 7. LOCATION OF UV PROM
+       JMS I K6500
+       CLL CLA
+       JMP I KTIME
+/
+K6500, 6500
+/
+PAGE
+/
+/
+/THIS ROUTINE WILL NOTIFY APT OF AN ERROR AND SEND PC TO
+/APT SYSTEM. ALL ERRORS WILL RESULT IN PROGRAM HLT AND A TIME OUT ON
+/APT. APT WILL TAKE OVER FROM THERE.
+
+/
+AERRO, 0
+       IOF                     /DISABLE INTERUPTS
+       CLA
+       TAD     22              /CHECK FOR APT SYSTEM
+       SMA CLA
+       JMP I   AERRO           /RETURN NOT ON APT
+       TAD I   KERRO           /GET PC
+       DCA SAVPC
+       RDF                     /GET CURRENT DATA FIELD
+       TAD KCDF
+       DCA .+2
+       TAD SAVPC
+       HLT                     /REPLACED WILL CURRENT DATA FIELD
+       CIF 70                  /CHANGE IF FOR APT RETURN TO FIELD 7
+       JMP I K6520             /NOTIFIES APT OF ERROR
+       HLT
+/
+K6520, 6520
+KERRO, ERRO
+SAVPC, 0
+/
+/
+/ROUTINE TO MOVE DISK POINTERS
+/
+MOVE,  0
+       TAD     ADPT1
+       DCA     AUTO10
+
+       TAD     ADPT2
+       DCA     AUTO11
+       TAD     M10
+       DCA     MCNTR1
+       TAD I   AUTO10                  /FROM HERE
+       DCA I   AUTO11                  /TO THERE
+       ISZ     MCNTR1                  /4 POINTERS
+       JMP     .-3
+       JMP I   MOVE
+/
+ADPT1, DSK0A-1
+ADPT2, DSK0B-1
+MCNTR1,        0
+/
+/
+TEXPC,  TEXT    "PC:"
+TEXGD,  TEXT    "GD:"
+TEXEX, TEXT    "EX:"
+TEXCM, TEXT    "CM:"
+TEXST, TEXT    "ST:"
+TEXDA,  TEXT    "DA:"
+TEXCA, TEXT    "CA:"
+TEXAD,  TEXT    "AD:"
+TEXDT,  TEXT    "DT:"
+/
+ERTX1, TEXT    "READ STATUS ERROR"
+ERTX2, TEXT    "DISK DATA ERROR"
+ERTX3, TEXT    "WRITE STATUS ERROR"
+ERTX4, TEXT    "RECALIBRATE STATUS ERROR"
+/
+ERMES1,        TEXT "TRY TO FORMAT SAME CYLINDER AGAIN?"
+ERMES2,        TEXT "TRY TO RECALIBRATE SAME DISK AGAIN?"
+ERMES3,        TEXT "TRY TO CHECK SAME CYLINDER AGAIN?"
+/
+TEXEND,        TEXT    "RK8E/RK8L DISK FORMATTER PASS COMPLETE"
+MES1,  TEXT "RK8E/RK8L DISK FORMATTER PROGRAM"
+MES2,  TEXT "FOR ALL QUESTIONS, ANSWER Y FOR YES OR N FOR NO."
+MES3,  TEXT "FORMAT DISK "
+MES4,  TEXT "ARE YOU SURE?"
+MES5,  TEXT "FORMAT SAME DISK(S) AGAIN?"
+/
+PAGE
+/
+WRKBUF=.
+/
+HITRK=.
+LOTRK=.+1
+/
+ENDBUF=.+377
+/
+
+
+/CONSOL SRC -V2-R0- CONSOLE PACKAGE
+
+
+/LAS= CALL C8CKSW OR JMS XC8SW
+/THIS WILL READ THE SWITCH REGISTER FROM THE PLACE SPECIFIED
+/BY LOCATION 20 BIT 0.
+
+
+/THE PROGRAN SHOULD CHECK FOR A CONTROL CHARACTER FRON THE TERMINAL
+/EVERY FIVE(5) SECONDS OR SOONER.
+
+/LOCATIONS THAT NEED TO BE SET UP FOR USING THE CONSOLE PACKAGE.
+
+/CNTVAL IN XC8PASS    THIS LOCATION DETERMINDS THE NUMBER OF
+/PROGRAM COMPLETIONS THAT ARE NEEDED BEFORE THE PASS MESSAGE IS TYPED
+/THE VALUE SHOULD PUT THE PASS MESSAGE OUT IN THE RANGE OF 1 TO 5 MINUTES.
+/THIS SHOULD BE A POSITIVE NUNBER.
+
+/C8STRT   THIS IS FOUND IN CNTRL ROUTINE CONTROL R PART
+/IT IS THE RETURN WHEN CONTROL R IS ENTERED (RESTART PROGRAM)
+/THE RETURN JUMPS TO XDOSW WHICH CONTAINS C8STRT SO PUT THE LABEL C8STRT
+/WHERE YOU WANT TO RESTART THE PROGRAM.
+
+
+/SETUP1 IN XC8ERR    THIS IS THE MASK BIT FOR HALT ON ERROR
+/PLACE THE CORRECT BIT IN THIS LOCATION FOR HALTING ON ERRORS.
+
+/SETUP2 IN XC8PASS   THIS IS THE MASK FOR HALT A END OF PASS.
+
+/THE CALL TABLE IS A CONDITIONAL ASSEMBLY.
+/TO ASSEMBLE THE CALL REMOVE THE / BEFORE CONSOL=0.
+/IN COMBINING THE CONSOL PACKAGE TO A DIAGNOSTIC.
+/THE CALL TABLE IS TO BE AT THE BEGINNING OF A PROGRAM.
+
+
+/CONSOL=0
+       PSKF=   6661
+       PCLF=   6662
+       PSKE=   6663
+       PSTB=   6664
+       PSIE=   6665
+       GTF=    6004
+       ACL=    7701
+       CAF=    6007
+       MQL=    7421
+       MQA=    7501
+/
+*3000
+/
+/*********************************************************************
+/C8PASS
+/THIS IS CALLED AT THE END OF EACH PROGRAM COMPLETION
+/THE VALUE OF** CNTVAL** WILL BE DETERMINED BY THE TIME IT TAKES
+/THE PROGRAM TO COMPLETE THIS MANY C8PASS TO BE IN THE 1 TO 4 MINUTE
+/RANGE
+/      C8PASS=JMS   XC8PAS
+/EX. OF CALL           C8PASS
+       /               HLT             /HALT IF NON CONSOL PACKAGE
+/              JMP     START1          /CONTINUE RUNNING THIS PROGRAM
+
+
+/RETURN TO LOCATION CALL PLUS ONE WITH THE AC=0 IF NON CONSOL PACKAGE AND HLT
+/IF CONTINUE TO RUN THEN RETURN TO CALL PLUS2 AC=0 
+/THE LOCATION SETUP2 IS THE MASK BIT FOR THE HALT AT END OF PASS
+/CHECK THAT IT IS CORRECT FOR THE CURRENT PROGRAM
+
+/CALLS USED BY XC8PAS ARE  CHKCLA-XC8CRLF-XC8OCTA-XC8SW-XC8PNT-XC8INQ-
+
+
+XC8PAS,        0
+       CLA
+\f      JMS     CHKCLA          /IS WORD 22 BIT 3 ACTIVE CONSOLE?
+       JMP     DOPACK          /IS CLASSIC
+       JMS     C8GET           /GET THE REGISTERS.
+       JMS     XC8SW           /DEACTIVE CONSOL CHECK SR SETTING
+       AND     (400            /FOR HALT ON END OF C8PASS
+       SZA CLA                 /1= HALT 0 CONTINUE
+       JMP I   XC8PAS          /GO TO HALT
+       JMP     C8BY1           /CONTINUE ON RUNNING PROGRAM
+DOPACK,        JMS     CKCOUT          /CLASS CHECK C8PASS COUNT
+       JMP     C8BY1           /C8PASS COUNT NOT DONE REDO PROGRAM
+       ISZ     PASCNT          /C8PASS COUNT DONE SET C8PASS COUNT
+       JMS     XC8CRLF
+       JMS     XC8PNT          /C8PRNT BUFFER
+       MESPAS                  /
+       TAD     PASCNT          /GET NUMBER
+       JMS     XC8OCTA         /CONVERT IT TO ASCII
+       JMS     XC8CRLF         /DO A CARRIAGE RETURN
+       JMS     C8GET           /GET THE REGISTERS.
+       JMS     XC8SW           /CHECK A HALT AT END OF C8PASS
+SETUP2,        AND     (400            /MASK BIT
+       SZA CLA                 /HALT =1 NO SKIP CONTINUE =0
+       JMS     XC8INQ          /STOP PROGRAM EXECUTION-LOOK FOR INPUT
+C8BY1, ISZ     XC8PAS          /BUMP RETURN
+       JMP I   XC8PAS
+CKCOUT,        0
+       TAD     DOSET           /CHECK IF SET UP NEEDED
+       SZA CLA                 /0=SET UP C8PASS COUNT VALUE
+                               /1=C8PASS COUNT VALUE OK
+       JMP     NOSET           /C8PASS COUNT VALUE ON
+       TAD     CNTVAL          /GET COUNT VALUE FOR THIS PROG
+       CMA                     /SET TO NEGATIVE
+       DCA     DOCNT           /STORE IN HERE
+       ISZ     DOSET           /INDICATE VALUE SET UP
+NOSET, ISZ     DOCNT           /COUNT THE NUMBER OF PASSES
+       JMP     C8BY1           /EXIT FOR ANOTHER PASS
+       DCA     DOSET           /SET TO C8PRNT C8PASS
+       ISZ     CKCOUT          /BUMP RETURN FOR
+       JMP I   CKCOUT          /C8PASS C8TYPE OUT
+DOCNT, 0
+PASCNT,        0                       /
+DOSET, 0
+CNTVAL,        0
+MESPAS,        TEXT    "DHRKDD  PASS "
+
+
+
+/*********************************************************************
+
+/C8CKSW
+
+/THIS ROUTINE CAN BE USED INPLACE OF A READ THE SWITCHES LAS.
+/ROUTINE THAT WILL CHECK WHERE TO READ THE
+/C8 SWITCHES FROM IE. FROM PANEL OR PSEUDO SWITCH REGISTER
+/THE SELECTION IS DETERMINED BY THE STATE OF BIT 0 IN LOCATION 21.
+
+       /C8CKSW=        JMS XC8SW
+       /EX.    JMS     XC8SW           /READ THE C8SWIT REGISTER
+                                       /RETURN WITH THE CONTENTS OF SWITCH REGISTER
+
+/RETURN TO NEXT LOCATION FOLLOWING CALL WITH THE AC= TO VALUE OF C8SWIT SETTING
+
+/CALLS USED ARE-XC8CKPA-
+
+
+
+XC8SW, 0
+       JMS     XC8CKPA         /GO CHECK THE IF ANY CONTRL
+       NOP
+       TAD     21              /GET WD FOR INDICATOR
+       SPA CLA                 /CHECK IF FROM PANEL 4000
+       7614                    /DO LAS AND SKIP GET FROM PANEL WITH LAS
+       TAD     20              /PSEUDO SWITCH
+       JMP I   XC8SW           /EXIT WITH STATUS BIT IN AC.
+
+
+/*********************************************************************
+
+/C8TTYI
+/THIS ROUTINE WILL LOOK FOR A INPUT FROM THE TERMINAL
+/AND REMOVE ANY PARITY BITS, THEN MAKE IT 8 BIT ASCI.
+/      C8TTYI= JMS XC8TTY
+/EX.   JMS     XC8TTYI         /READ CHAR FROM THE CONSOL DEVICE
+       /                       /RETURN TO CALL PLUS ONE AC CONTAINS THE CHAR
+
+
+/CALLS USED -NONE- BUT C8CHAR IS OFF PAGE AND IN ROUTINE CALLED XC8ECHO
+
+/
+/
+XC8TTY,        0
+       KSF                     /LOOK FOR KEYBOARD FLAG
+       JMP     .-1
+       KRB                     /GET CHAR
+       AND     (177            /MASK FOR 7 BITS
+       TAD     (200            /ADD THE EIGTH BIT
+       DCA     C8CHAR          /STORE IT
+       TAD     C8CHAR
+       JMP I   XC8TTY          /EXIT
+
+
+
+/*********************************************************************
+
+/C8PRNT
+
+/THIS ROUTINE WILL TYPE THE CONTENTS OF THE C8 PRINT BUFFER. THE LOCATION
+/OF THE BUFFER WILL BE IN THE ADDRS FOLLOWING THE CALL.   PRINTING OF THE BUFFER
+/WILL STOP WHEN A 00 CHAR IS DETECTED. CHARACTERS ARE PACKED 2 PER WORD.
+
+/      C8PRNT= JMS XC8PNT
+
+
+/EX.   JMS     XC8PNT                  /C8PRNT THE CONTENTS OF THE FOLLOWING BUFFER
+/      MESS77                          /LOCATION OF C8PRNT BUFFER
+
+/C8PRNT WILL USE THE LOCATION FOLLOWING THE CALL AS THE POINTER FOR THE
+/C8PRNT ROUTINE.RETURN TO CALL PLUS TWO WITH AC= 0
+
+/CALLS USED ARE-XC8TYPE-XC8PNT
+
+
+
+XC8PNT,        0
+       CLA CLL
+       TAD I   XC8PNT          /GET C8PRNT BUFFERS STARTING LOCATION
+       DCA     PTSTOR          /STORE IN PTSTOR
+       ISZ     XC8PNT          /BUMP RETURN
+C8DO1, TAD I   PTSTOR          /GET DATA WORD
+       AND     (7700           /MASK FOR LEFT BYTE
+       SNA                     /CHECK IF 00 TERMINATE
+       JMP I   XC8PNT          /EXIT
+       SMA                     /IS AC MINUS
+       CML                     /MAKE CHAR A 300 AFTER ROTATE
+       IAC                     /MAKE CHAR A 200 AFTER ROTATE
+       RTR
+       RTR
+       RTR                     /PUT CHAR IN BITS 4-11 MAKE IT 8 BIT ASCII
+       JMS     XC8TYPE         /C8PRNT IT ON CONSOLE
+       TAD I   PTSTOR          /GET DATA WORD
+       AND     (0077           /MASK FOR RIGHT BYTE
+       SNA                     /CHECK IF 00 TERMINATOR
+       JMP I   XC8PNT          //EXIT
+       TAD     (3740           /ADD FUDGE FACTOR TO DETERMINE IF 200
+       SMA                     /OR 300 IS TO BE ADD TO CHAR
+       TAD     (100            /ADD 100
+       TAD     (240            /ADD 200
+       JMS     XC8TYPE         /C8TYPE ONLY BITS 4-11
+       ISZ     PTSTOR          /BUMP POINTER FOR NEXT WORD
+       JMP     C8DO1           /DO AGAIN
+PTSTOR,        0                       /STOR FOR C8PRNT BUFFER
+/**************************************************************************
+
+
+/C8PAUS
+/THIS ROUTINE WILL CHECK IF THE CONSOL PACKAGE IS ACTIVE,IF ACTIVE
+/IT WILL RETURN TO CALL PLUS ONE AC= 0. AND DO THAT INSTRUCTION.
+/IF THE CONSOL PACKAGE IS NOT ACTIVE THE CALL WILL BE REPLACED
+/WITH A 7402 HALT AND THEN RETURN TO THE HALT.
+
+/      C8PAUS= JMS XC8PAU
+/
+/
+/EX.           JMS     XC8PAUS         /CHECK IF ON ACTIVE CONSOL IF NOT HALT HERE
+/              ANYTHING                /RETURN HERE IF ON ACTIVE CONSOL
+/
+/
+
+/CALLS USED ARE -CHKCLA-
+
+
+
+XC8PAU,        0
+       CLA CLL
+       JMS     CHKCLA          /CHECK LOC 22 BIT 3 CONSOLE BIT
+       JMP     C8DO3           /GO DO CONSOL PART RETURN CALL +1
+       CMA                     /DEACTIVE CONSOLE PACKAGE PUT HLT IN CALL
+       TAD     XC8PAU          /GET CORRECT RETURN ADDRS
+       DCA     XC8PAU          /SET UP RETURN
+       TAD     (7402           /GET CODE FOR HLT
+       DCA I   XC8PAU          /PUT HALT IN CALL LOCATION
+C8DO3, JMP I   XC8PAU          /GO TO HALT OR RETURN TO NEXT LOCATION
+
+
+PAGE
+/*********************************************************************
+\f
+
+/C8CNTR
+/THIS ROUTINE WILL CHECK FOR THE PRESENCE OF CONTROL CHARACTERS
+/IT WILL CHECK FOR THE FOLLOWING CHAR C-R-Q-L-S
+/      C8CNTR= JMS XC8CNT
+
+/EX.   JMS     XC8CNTR                 /CHECK FOR CONTROL CHARACTER
+/      JMP     ANYTHING                /LOC FOLLOWING CALL IS FOR CONTINUING THE PROGRAM
+/      JMP     ANYTHING                /LOC. IS FOR RETURN IF INMODE SET AND NOT CNTRL CHAR
+/
+
+/RETURN IS TO CALL PLUS ONE IF CONTINUE
+/RETURN IS TO CALL PLUS TWO IF INMODE SET AND NOT CONTROL CHAR
+/RETURN IS TO CALL PLUS TWO IF INMODE IS NOT SET AND NO
+/CONTROL CHAR ..THIS WILL PRINT THE CHARACTER AND A ? 
+/CLEAR THE AC AND RETURN CALL+2.
+
+/CALLS USED ARE-CHKCLA-XC8TYPE-XC8CRLF-C8GET-UPAROW-XC8TYI-XC8PSW-
+/
+/
+/
+XC8CNT,        0
+       DCA     ACSAVE          /SAVE THE AC
+       JMS     CHKCLA          /CHECK LOC.22 BIT3 FOR CONSOLE BIT
+       JMP     .+3             /ON ACTIVE CONSOLE
+       TAD     ACSAVE          /DEACTIVE CONSOLEGET AC FOR RETURN
+       JMP I   XC8CNT          /EXIT NOT ON ACTIVE CONSOLE
+       GTF
+       DCA     FLSAVE
+       MQA
+       DCA     MQSAVE          /SAVE THE MQ
+       DCA     INDEXA          /SET DISPLACEMENT INTO TABLE B 
+       TAD     XTABLA          /GET ADDRS OF TABLE A
+       DCA     GETDAT          /CONTAINS POINTER TO CONTROL CHAR
+REDOA, TAD I   GETDAT          /GET CONTROL CHAR FROM TABLE
+       SNA                     /CHECK FOR A 0 END OF TABLE
+       JMP     DONEA           /END OF TABLE NO CONTROL CHAR
+       TAD     C8CHAR          /COMPARE CHAR TO CONTROL CHAR
+       SNA CLA                 /0 IF MATCH
+       JMP     GOITA           /MATCH
+       ISZ     INDEXA          /NO MATCH NOT END OF TABLE REDO
+       ISZ     GETDAT          /BUMP INDEX FOR EXIT WHEN CONTROL FOUND
+       JMP     REDOA           /BUMP GETDAT FOR COMPARE OF NEXT CNTRL CHAR.
+DONEA, TAD     INMODE          /CHECK IF PROGRAM EXPECTS CHAR
+       SZA CLA                 /1=CHAR EXPECTED  0= NO CHAR EXPECTED
+       JMP     EXITA           /CHAR EXPECTED
+       TAD     C8CHAR          /GET CHAR - NOT CONTROL + NOT EXPECTED
+       JMS     XC8TYPE         /C8PRNT CHAR
+       TAD     (277            /GET CODE FOR "?"
+       JMS     XC8TYPE
+       JMS     XC8CRLF
+       ISZ     XC8CNT          /BUMP RETURN
+       JMP I   XC8CNT          /EXIT CALL+2
+EXITA, ISZ     XC8CNT          /BUMP RETURN FOR MAIN PROGRAM CHECK OF CHAR
+       TAD     C8CHAR          /PUT CHAR IN AC.
+       JMP I   XC8CNT          /EXIT
+GOITA, TAD     C8CHAR          /GET THE CONTENTS OF CHAR
+       TAD     (100            /ADD 100 TO FORM A GOOD ASCII CHARACTER
+       DCA     C8CHAR          /RESTORE COFFECT CHAR
+       TAD     XTABLB          /GET START OF TABLE B
+       TAD     INDEXA          /GET NOW FAR INTO TABLE
+       DCA     GOTOA           /STORE IT
+       TAD I   GOTOA           /GET THE ROUTINE STARTTING ADDRESS
+       DCA     GOTOA           /STORE IT IN HERE
+       JMP I   GOTOA           /GOTO CONTROL CHAR ROUTINE
+GOTOA, 0000                    /ADD OF CNTRL ROUTINE TO EXECUTE
+INDEXA,        0000                    /DISPLACEMENT INTO CNTRL TABLE
+GETDAT,        0000                    /LOCATION OF ADDRS OF CONTROL CHAR.
+XTABLA,        TABLA                   /ADDRS OF TABLEA
+XTABLB,        TABLB                   /ADDRS OF TABLEB
+TABLA, 7575                    /CNTRL C BACK TO MONITOR 203
+       7564                    /CNTRL L SWITCH ERROR PRINTTING DEVICE 214
+       7557                    /CNTRL Q START DISPLAYING CHAR. AGAIN 221
+       7556                    /CNTRL R BACK TO BEGINNING OF PROGRAM 222
+       7555                    /CNTRL S STOP SENDING CHAR TO DISPLAY WAIT FOR CNTRL Q 223
+       7573                    /CNTRL E CONTINUE WITH PROGRAM 205
+       7574                    /CONTROL D CHANGE SWITCH REGISTER ON FLY
+       0000
+
+TABLB, CNTRLC
+       CNTRLL
+       CNTRLQ
+       CNTRLR
+       CNTRLS
+       CNTRLE
+       CNTRLD
+/
+/CONTROL Q
+/START SENDING CHAR. TO THE DISPLAY
+/THIS WILL RETURN CONTROL TO CALL THAT WAS SET BY
+/THE CALL FOR CONTROL S.
+/
+CNTRLQ,        DCA     INMODE          /SET SOFT FLAG FOR UNEXPECTED CHAR
+       TAD     C8SETS          /CHECK IF CONTROL S TYPED IN
+       SZA CLA
+       JMP     BYRETR          /CONTROL S TYPED IN 
+       JMS     C8GET           /NO CONTROL S TYPED PREVIOUSLY
+       JMP I   XC8CNTR         /LEAVE VIA CNTR ENTRY ADDRESS
+BYRETR,        DCA     C8SETS          /CLEAR THE SOFT FLAG
+       JMS     C8GET           /RESTORE REGISTERS
+       JMP I   C8RETR          /EXIT TO ADDRESS SET BY CONTROL S
+/
+/
+/CONTROL R
+/GO TO THE QUESTION C8SWIT
+CNTRLR,        DCA     TTYLPT          /CLEAR THE TYPE FLAG SET TO TTY
+       DCA     C8SETS          /CLEAR SOFT FLAG FOR CNTRL S
+       DCA     INMODE
+       JMS     UPAROW          /PRINT THE ^ AND C8CHAR
+C8BY4, DCA     C8SWST          /CLEAR FLAG FOR CNTRL D OR R
+       JMP I   XDOSW           /GO TO ADDRS OF C8SWIT
+XDOSW, BGN                     /DOSW IS LABEL FOR C8SWIT QUESTION
+/
+/
+/CONTROL S
+/STOP SENDING CHAR. TO DISPLAY UNTIL A ^Q IS RECEIVED
+/
+/
+CNTRLS,        TAD     C8SETS          /IF1 DO NOT STORE IN C8RETR
+       SZA CLA
+       JMP     C8DO7           /DONT SET UP C8RETR
+       IAC                     /MAKE RETURN CALL PLUS 2
+       TAD     XC8CNT          /GET RETURN FOR THIS CALL
+       DCA     C8RETR          /STORE IT HERE FOR USE BE CNTROL Q
+C8DO7, ISZ     C8SETS          /SET FLAG TO SAVE CALL
+       JMS     XC8TTYI                 /LOOK FOR THE INPUT
+       JMS     C8GET           /GET REGISTERS 
+       JMS     XC8CNTR                 /CHECK FOR THE CONTROL CHAR
+       CLA
+       JMP     CNTRLS          /IF NOT A CNTRL Q R C REASK
+C8SETS,        0
+C8RETR,        0
+/
+/SWITCH OUTPUT FROM ONE OUTPUT DEVICE TO ANOTHER - THE TWO OUTPUTS ARE THE
+/CONSOLE AND THE PRINTER WITH DEVICE CDOE 66.
+/
+/
+CNTRLL,        TAD     TTYLPT          /GET PRESENT C8SWIT INDICATOR
+       CMA                     /COMPLEMENT IT
+       DCA     TTYLPT          /STOR NEW C8SWIT
+       JMS     UPAROW          /C8PRNT ^ AND CHAR ON NEW DEVICE
+       JMS     C8GET           /RESTORE THE REGISTERS
+       JMP I   XC8CNT          /EXIT
+/
+/CONTROL E
+/CONTINUE RUNNING FROM A INQUIRE OR ERROR
+/
+/
+CNTRLE,        JMS     UPAROW          /PRINT THE CONTROL CHAR
+       JMS     C8GET           /GET THE REGISTERS
+       JMP I   XC8CNT          /RETURN TO CALL PLUS ONE
+/
+
+/CONTROL C
+/RETURN TO MONITOR CONTROL C
+CNTRLC,        DCA     TTYLPT          /CLEAR THE LPT FLAG TO PRINT ON DISPLAY
+       JMS     UPAROW          /C8PRNT A^ AND LETTER IN CHAR
+       CDF CIF                 /GO TO 0 FLD
+       CAF                     /CLEAR THE WORLD
+       JMP I   (7600           /GO TO DIAGNOSTIC MONITOR
+/*********************************************************************
+/
+/
+/
+PAGE
+
+/
+       /CONTROL D
+       /CHANGE THE SWITCH REGISTER ANYTIME CNTRL D AND RETURN TO
+       /THE PROGRAM RUNNING.
+
+
+CNTRLD,        JMS     UPAROW
+\f      TAD     C8SETD          /CHECK IF THE RETURN ADDRS IS SAFE
+       SZA CLA
+       JMP     C8DO11          /DO NOT CHANGE THE RETURN ADDRS
+       TAD     XC8CNT          /GET THE RETURN ADDRS AND SAVE IT
+       DCA     C8RETD          /SAVE THE RETURN HERE
+       ISZ     C8SETD          /INDICATE RETURN SAVED DONT DISTROY
+C8DO11,        JMS     XC8PSW                  /GO CHANGE THE SWITCH REGISTER
+       DCA     C8SETD          /CLEAR THE FLAG
+       JMS     C8GET           /RESTORE THE AC MQ LINK ETC
+       JMP I   C8RETD          /RETURN TO THE PROGRAM
+/
+C8SETD,        0
+C8RETD,        0
+
+
+
+/THIS WILL TYPE A UP ARROW AND THE CHAR IN C8CHAR.
+
+UPAROW,        0                       /C8PRNT THE "^" AND THE CHAR C8TYPED IN
+       TAD     (336            /CODE FOR ^
+       JMS     XC8TYPE
+       TAD     C8CHAR          /C8TYPE THE CHAR
+       JMS     XC8TYPE
+       JMS     XC8CRLF
+       JMP I   UPAROW          /EXIT
+
+
+
+/***********************************************************************
+
+C8GET, 0
+       CLA
+       TAD     MQSAVE
+       MQL                     /RESTORE MQ
+       TAD     FLSAVE
+       RAL                     /RESTORE THE LINK
+       CLA
+       TAD     ACSAVE          /RESTORE THE AC
+       JMP I   C8GET           /GET THE REGISTERS
+
+
+
+/********************************************************************
+
+/C8INQU
+/C8INQU ROUTINE WILL PRINT A WAITING
+/AND THE PROGRAM IS EXPECTING A CONTROL CHAR INPUT
+/IF CONTINUE FROM CONTROL CHAR RETURN IS CALL PLUS ONE
+/IF NO CONTROL CHAR ENTERED THEN WAITING IS REPRINTED
+/AND PROGRAM WAITS FOR A CONTROL CHAR AGAIN.
+
+/      C8INQU =        JMS XC8INQ
+
+/EX.   JMS     XC8INQ                  /C8 WILL PRINT A WAITINGAND WAIT FOR INPUT
+/      DO ANYTHING                     /RETURN IS CALL PLUS ONE AC =0 CONTINUE
+
+/CALLS USED ARE -CHKCLA-XC8PNT-XC8TYI-C8GET-XC8CNTR-
+
+
+XC8INQ,        0
+       CLA CLL
+       JMS     CHKCLA          /CHECK LOC 22 BIT 3 CONSOLE BIT
+       SKP                     /ACTIVE CONSOLE PACKAGE
+       JMP I   XC8INQ          /NOT CONSOLE LEAVE
+       JMS     XC8PNT
+       WATMES                  /INQUIR WAITTING
+       JMS     XC8TTYI         /GET CHARACTER
+       JMS     C8GET
+       JMS     XC8CNTR         /CHECK IF CONTROL CHARACTER
+       JMP I   XC8INQ          /EXIT AND CONTINUE
+       JMP     XC8INQ+1        /REASK
+WATMES,        TEXT    "WAITING "
+
+
+/*********************************************************************
+
+/C8SWIT
+
+/ROUTINE WILL CHECK IF CONSOL IS ACTIVE IF IT IS ACTIVE DISPLAY 
+/SW QUESTION . IN NOT ACTIVE IT WILL NOT PRINT THE SW QUESTION BUT
+/RETURN TO CALL PLUS ONE AC=0.
+/C8SWIT WILL SET UP THE PSEUDO SWITCH
+/REGISTER WITH THE NEW DATA ENTERED
+/
+/      C8SWIT =        JMS XC8PSW
+
+/EX.           JMS     XC8PSW          /SET UP PSEUDO C8SWIT REGISTER IF
+                                       /ON THE CONSOL PACKAGE. RETURN IS CALL PLUS ONE AC = 0
+
+/CALLS USED ARE -CHKCLA-XC8PSW-XC8PNT-XC8OCTA-XC8TYPE-
+
+
+XC8PSW,        0
+       JMS     CHKCLA          /CHECK LOC 22 BIT 3 CONSOLE BIT
+       SKP                     /ACTIVE CONSOLE
+       JMP I   XC8PSW          /DEACTIVE CONSOLE PACKAGE
+                               /RETURN WITHOUT ASKING PSEUDO SWITCH
+       TAD     C8SWST          /IS THE SOFT FLAG SET FOR SWITCH?
+       SZA CLA                 /SKIP IF ONE ENTRY AT ATIME OK
+       JMP     C8BY4           /SECOND ENTRY WITH OUT A EXIT GO TO SW QUESTION
+       ISZ     C8SWST          /FIRST ENTRY SET FLAG
+C8RDPS,        JMS     XC8PNT          /C8PRNT SR=
+       MESA
+       TAD     20              /GET CONTENTS OF SW
+       JMS     XC8OCTA         /CONVERT IT TO ASCII
+       TAD     (40             /GET SPACE
+       JMS     XC8TYPE
+       ISZ     INMODE          /SET FLAG FOR CHAR EXECTED
+       JMS     XC8ECHO         /LOOK FOR INPUT
+       JMS     TSTCHA          /NOT CONTROL TEST IT IS LEGAL
+       TAD     C8CHAR          /STORE NEW CHAR IN SW REG
+       DCA     20
+
+       TAD     (-3             /GET A MINUS 3
+       DCA     TMPCNT          /STORE IN TEMP COUNT
+GETCH1,        JMS     XC8ECHO         /GET NEXT CHAR
+       JMS     TSTCHA          /CHECK IF CR + GOOD CHAR
+       TAD     20              /GET C8SWIT REGISTER
+       RTL CLL                 /ROTATE IT LEFT 3 PLACES
+       RAL
+       TAD     C8CHAR          /GET CHAR + ADD IT TO PREVIOUS CONTENTS
+       DCA     20              /SAVE NEW CONTENTS
+       ISZ     TMPCNT          /BUMP COUNT
+       JMP     GETCH1          /JMP BACK + GET NEXT CHAR
+       JMP     ENDIT           /END 4 CHAR C8TYPED IN
+TSTCHA,        0
+       CIA                     /CMPL CHAR IN AC
+       TAD     (215            /TEST IF IT IS A CARRIAGE RETURN
+       SNA CLA                 /SKIP IN NOT CR.
+       JMP     ENDIT           /WAS CARRIAGE RETURN
+       TAD     C8CHAR          /NOT CR. GET CHAR
+       TAD     (-260           /CHECK IF IT IS IN RANGE
+       SPA CLA                 /IF NOT POSITIVE C8ERR CHAR SMALLER THEN 260
+       JMP     ERR1            /C8ERR - CHAR TOO SMALL
+       TAD     C8CHAR          /GET CHAR
+       TAD     (-270           /GET A -270 + CHECK IF IT IS LARGER THEN 7
+       SMA CLA                 /SKIP IF LESS THEN 7
+       JMP     ERR1            /C8ERR ON CHAR NOT IN RANGE
+       TAD     C8CHAR          /GET CHAR
+       AND     (7              /MASK FOR RIGHT BYTE
+       DCA     C8CHAR          /STORE IN CHAR
+                               /GET CHAR IN AC
+       JMP I   TSTCHA          /EXIT
+ERR1,  TAD     (277            /C8PRNT
+       JMS     XC8TYPE         /?
+       JMS     XC8CRLF         /
+       JMP     C8RDPS          /EXIT + ASK AGAIN
+ENDIT, JMS     XC8CRLF         /DO A CR LF
+       DCA     C8SWST          /CLEAR THE PSW ENTRY FLAG
+       JMP I   XC8PSW          /EXIT ROUTINE
+C8SWST,        0
+
+TMPCNT,        0
+MESA,  TEXT    "SR= "
+
+
+PAGE
+
+/C8OCTA
+
+/OCTAL TO ASCII CONVERSION
+/THIS ROUTINE WILL TAKE THE OCTAL NUMBER IN THE AC AND CONVERT IT TO ASCII
+/THE RESULT WILL BE PRINTED ON THE CONSOL TERMINAL
+/      C8OCTA= JMS XC8OCT
+/
+/EX.   JMS     XC8OCTA         /AC CONTAINS NUMBER TO BE CHANGE
+/      RETURN IS TO CALL PLUS ONE AC=0
+/
+/CALLS USED ARE -XC8TYPE-
+
+
+XC8OCT,        0
+       CLL RTL
+       RTL                     /POSITION THE FIRST CHAR FOR PRINTING
+       DCA     C8TMP1          /SAVE CORRECT POSITIONED WORD HERE
+       TAD     (-4
+       DCA     C8CKP           /STORE COUNTER IN HERE
+C8DO4, TAD     C8TMP1          /GET FIRST NUMBER
+       AND     (0007           /MASK
+       TAD     (260            /ADD THE PRINT CONSTANT
+       JMS     XC8TYPE         /TYPE THE NUMBER
+       TAD     C8TMP1          /
+       RTL
+       RAL                     /PUT NEXT NUMBER IN POSITION
+       DCA     C8TMP1          /STORE IT
+       ISZ     C8CKP           /DONE YET WITH FOUR NUMBERS
+       JMP     C8DO4           /NOT YET DO MORE
+       JMP I   XC8OCT          /DONE WITH FOUR 
+       C8TMP1, 0
+       C8CKP,  0
+
+
+/*********************************************************************
+
+/C8CRLF
+/C8TYPE CR AND LF WITH FILLERS FOLLOWING EACH LF AND CR
+\f/
+/      C8CRLF= JMS XC8CRL
+/
+/EX.   JMS     XC8CRLF         /C8PRNT A CR AND LF WITH FILL
+/                              /RETURN TO CALL PLUS ONE AC =0
+/CALLS USED ARE -XC8TYPE-
+
+
+XC8CRLF,0
+       CLA CLL
+       TAD     (215            /GET CODE FOR CR
+       JMS     XC8TYPE
+       TAD     FILLER
+       CMA
+       DCA     FILCNT          /STORE FILLER IN HERE
+       TAD     (212            /GET CODE FOR LF
+C8DO2, JMS     XC8TYPE
+       ISZ     FILCNT          /CHECK ON FILLER CHAR
+       JMP     C8DO2           /TYPE A NON PRINTING CHAR
+       JMP I   XC8CRL          /EXIT
+FILLER,        0004                    /FILLER SET FOR 4 CHAR
+FILCNT,        0                       /COUNTER FOR FILL
+
+
+
+//*************************************************************
+/C8CKPA
+/THIS ROUTINE WILL CHECK IF A CHARACTER WAS ENTERED FROM THE
+/TERMINAL. IFTHE FLAG IS SET AND THE CONSOLE PACKAGE IS
+/ACTIVE A CHECK IS MADE TO DETERMIND IF IT IS A CONTROL CHAR.
+/IF IT WAS A CONTROL CHAR THEN ITS CONTROL FUNCTION IS PERFORMED.
+/IF NOT A CONTROL CHARACTER OR A CONTROL E-D-L-O- IT WILL DO
+/THE CONTROL FUNCTION AND RETURN TO CALL PLUS 2.
+/A NON CONTROL CHARACTER WILL BE PRINTEDAND A "?" IT WILL RETURN TO
+/CALL PLUS 2.
+/IF NO FLAG IS SET OR THE CONSOL IS NOT ACTIVE THE RETURN IS TO
+/CALL PLUS 1.
+
+
+/      C8CKPA= JMS     XC8CKP
+
+
+/EX.   JMS     XC8CKPA                 /CALL TO CHECK IF CONTROL CHAR SET
+/      ANYTHING(SKIP)          /RETURN IF NOT FLAG OR NOT CONSOLE ACTIVE
+/      ANYTHING(JMP EXIT SKIP CHAIN)   /RETURN IF NOT CONTROL OR CONTINUE CONTROL
+
+
+/CALLS USED ARE -XC8TTYI-XC8CNTR-C8GET-
+
+
+XC8CKP,        0
+       DCA     ACSAVE          /SAVE THE AC
+       GTF                     /SAVE THE FLAGS
+       DCA     FLSAVE          /SAVE THE FLAGS
+       MQA                     /PUT MQ IN AC
+       DCA     MQSAVE          /SACE THE MQ
+       KSF                     /CHECK THE KEYBOARD FLAG
+       JMP     C8BY3           /EXIT TO CALL PLUS 1
+       JMS     CHKCLA          /CHECK LOC 22 BIT 3 CONSOLE BIT
+       SKP                     /ACTIVE CONSOLE PACKAGE
+       JMP     C8BY3           /EXIT TO CALL PLUS 1
+       JMS     XC8TTYI         /GET THE CHAR
+       JMS     C8GET           /GET THE FLAGS
+       JMS     XC8CNTR         /CHECK IF CONTROL  CHAR.
+       NOP                     /RETURN IF A CONTINUE CHAR.
+       ISZ     XC8CKP          /BUMP RETURN FOR CALL PLUS 2
+C8BY3, JMS     C8GET           /GET REGISTERS
+       JMP I   XC8CKP          /SAY GOOD BY
+
+//*********************************************************************
+
+/C8ECHO
+/THIS ROUTINE WILL LOOK FOR A CHAR FROM THE KEYBOARD.  STORE IT IN LOCATION CHAR
+/CHECK IF IT WAS A CONTROL CHARACTER - SET INMODE - PRINT CHARACTER
+
+/      C8ECHO =        JMS XC8ECH
+/EX.   JMS     XC8ECHO         /LOOK FOR CONSOL CHAR C8PRNT IT
+                               /RETURN CALL PLUS ONE AC = CHAR C8TYPED IN
+
+/CALLS USED ARE -XC8TTYI-XC8CNTR-C8GET-XC8ECH-XC8TTYPE
+
+/
+XC8ECH,        0
+       JMS     XC8TTYI         /WAIT FOR CHAR FROM KEYBOARD
+       JMS     C8GET           /RESTORE THE REGISTERS
+       ISZ     INMODE          /SET INMODE IDENTIFING THIS AS A EXPECTED CHAR
+       JMS     XC8CNTR         /GO CHECK IF IT IS A CONTROL CHAR
+       JMP I   XC8ECH          /WAS A CONTROL CHAR - CONTINUE RUNNING
+       JMS     XC8TYPE         /NOT A CONTROL CHAR C8PRNT IT
+       DCA     INMODE          /CLEAR FLAG THAT CHAR EXPECTED
+       TAD     C8CHAR          /GET CHAR IN AC
+       JMP I   XC8ECH          /EXIT
+C8CHAR,        0
+INMODE,        0
+
+/*********************************************************************
+
+/C8TYPE
+/THIS ROUTINE WILL C8PRNT ON THE CONSOLE OR THE LPT WITH DEVICE CODE 66.
+/
+/      C8TYPE= JMS XC8TYP
+
+/EX.   JMS     XC8TYPE         /C8PRNT THE CHAR IN THE AC.
+       /                       /RETURN CALL PLUS ONE AC =0000
+                               /DO NOT CLEAR THE LINK IN THIS ROUTINE NEEDED BYC8OCT
+
+/CALLS USED ARE -C8HANG-XC8CNTR-XC8PNT-XC8CRLF-XC8INQU-
+
+
+XC8TYP,        0
+       DCA     PNTBUF          /STORE CHAR
+       TAD     TTYLPT          /CHECK O=TTY 7777=LPT
+       SZA CLA
+       JMP     XDOLPT          /DO OUT PUT ON LPT
+       TAD     PNTBUF
+       TLS
+       TSF
+       JMP     .-1
+       TCF
+       JMP     C8BY5
+XDOLPT,        TAD     PNTBUF          /GET CHAR
+       PSTB    PCLF            /C8PRNT IT
+       JMS     C8HANG          /CHECK KEYBOARD IF HUNG
+       PCLF                    /CLEAR THE FLAG
+C8BY5, 7600                    /CLEAR THE AC
+       JMP I   XC8TYP          /EXIT
+PNTBUF,        0
+TTYLPT,        0
+
+
+C8HANG,        0
+       CLA             /
+       TAD     C8BY5           /GET CONSTANT 7600
+       DCA     PNTBUF          /PNTBUF IS NOW A COUNTER 
+       PSKF                    /SKIP ON PRINTER DONE
+       SKP                     /NOT DONE YET
+       JMP I   C8HANG          /SAW FLAG DONE 
+       ISZ     C8CONT          /FIRST COUNTER FAST ONE
+       JMP     .-4             /CHECK IF FLAG SET YET
+       ISZ     PNTBUF          /MADE 4096 COUNTS ON FAST COUNTER
+       JMP     .-3             /KEEP IT UP FOR 5 SEC 
+       TAD     XC8CNTR         /GET THE RETURN ADDRESS IN CONTROL
+       DCA     C8HANG          /SAVE IT IN HANG
+       DCA     TTYLPT          /ALLOW PRINTING ON TTY
+       JMS     XC8PNT
+       MESHANG                 /LPT ERROR
+       JMS     XC8CRLF
+       JMS     XC8INQU         /PRINT WAITING 
+       JMP I   C8HANG          /CONTINUE TO SAVE ADDRESS
+C8CONT,        0                       /COUNTER FOR TIMER
+MESHANG,TEXT   "LPT ERROR"
+
+PAGE
+/*********************************************************************
+/*******************************************************************
+
+/THIS ROUTINE WILL CHECK LOCATION 22 THE HARD WARE CONFIG WORD.
+/TO SEE IF THE CONSOLE BIT 3 )400) IS SET IF SET THEN RETURN
+/TO CALL PLUS TWO FO A ACTIVE CONSOLR PACKAGE AC=0
+/IF NOT SET THEN TO CALL PLUS ONE FOR A DEACTIVE CONSOLE PACKAGE.
+
+
+CHKCLA,        0
+       CLA
+       TAD     22              /GET THE COTENTA OF LOCATION 22
+       AND     (400            /MASK FOR BIT 3 (400
+       SNA CLA                 /
+       ISZ     CHKCLA          /ACTIVE CONSOLE PACKAGE RETURN
+                               /CALL PLUS ONE (1) FOR ACTIVE
+       JMP I   CHKCLA          /DEACTIVE CONSOLE PACKAGE RETURN
+                               /CALL PLUS TWO (2)
+
+/C8ERR
+/THIS ROUTINE WILL DETERMINE WHAT TO DO WHEN A C8ERR IS ENCOUNTERED
+/WILL CHECK IF CLASSIC SYSTEM, WILL CHECK C8SWIT REGISTERS.
+/      C8ERR=  JMS XC8ERR
+/EX.   JMS     XC8ERR          /GO TO C8ERR CALL IF NOT CONSOL 
+/                              /RETURN IS CALL PLUS ONE AC =0000
+
+/CALLS USED ARE -CHKCLA-XC8CRLF-XC8SW-XC8INQU-XC8PNT-XC8OCTA-
+
+
+XC8ERR,        0
+       IOF
+       DCA     ACSAVE          /SAVE AC
+       GTF
+       DCA     FLSAVE          /SAVE THE FLAGS
+\f        MQA
+        DCA     MQSAVE          /SAVE THE MQ
+        CLA CLL CMA             /SUBTRACT A 1 FOR TRUE LOCATION
+        TAD     XC8ERR          /GET RETTURN LOCATION
+        DCA     PCSAVE          /SAVE ADD OF C8ERR CALL
+        JMS     CHKCLA          /CHECK LOC.22 BIT 3 CONSOL BIT
+        SKP                     /ACTIVE CONSOLE PACKAGE
+        JMP     NTCLAS          /NOT CLASSIC SYSTEM
+        JMS     C8GET           /GET THE REGISTERS.
+        JMS     XC8SW           /CHECK SWITCH REG FOR BIT THAT INDICATES
+                                /NO ERROR MESSAGE
+SETUP1, AND     (0000           /MASK FOR BIT FOR NO ERROR PRINTING
+                                /IF THIS ERROR MESSAGE IS TO ALWAYS
+                                /BE PRINTED LEAVE AND VALUE AT 0000
+        SZA CLA                 /SKIP IF BIT IS 0 PRINT ERROR MESSAGE
+        JMP     C8DO10          /DO NOT PRINT
+        JMS     XC8CRLF
+        JMS     XC8PNT
+        ERRMES                  /PRINT THE ERROR MESSAGE
+        JMS     XC8PNT
+        MESPC                   /PRINT THE PC STSTEMENT
+        TAD     PCSAVE
+        JMS     XC8OCTA         /CONVERT 4 DIGIT PC TO ASCII
+        JMS     XC8PNT
+        MESAC                   /PRINT THE AC MESS
+        TAD     ACSAVE
+        JMS     XC8OCTA
+        JMS     XC8PNT
+        MESMQ                   /PRINT MQ
+        TAD     MQSAVE
+        JMS     XC8OCTA
+        JMS     XC8PNT
+        MESFL                   /PRINT FL
+        TAD     FLSAVE
+        JMS     XC8OCTA
+        JMS     XC8CRLF
+C8DO10, JMS     C8GET           /GET THE REGISTERS.
+        JMS     XC8SW           /CHECK SWITCH REGISTER
+        SKP CLA                 /SKIP IF BIT 0 SET
+        JMP     C8BY2           /LEAVE
+        JMS     XC8INQ          /GO TO THE INQUIRE ROUTINE
+        JMP     C8BY2           /LEAVE
+NTCLAS, JMS     C8GET           /GET THE REGISTERS.
+        JMS     XC8SW           /CHECK PSEUDO SWITCH REGISTER
+                                /CHECK THE C8SWIT REGISTER
+        SKP CLA                 /SKIP IF HALT
+        JMP I   XC8ERR          /NO HALT CONTINUE
+        TAD     (7402           /CODE FOR HLT
+        DCA I   PCSAVE          /PUT IT IN CALL LOC.
+        JMS     C8GET
+        JMP I   PCSAVE          /EXIT  TO CALL AND HALT
+C8BY2,  JMS     C8GET           /GET THE REGISTERS
+        JMP I   XC8ERR
+ERRMES, TEXT    "DHRKDD  FAILED "
+MESPC,  TEXT    "  PC:"
+MESAC,  TEXT    "  AC:"
+MESMQ,  TEXT    "  MQ:"
+MESFL,  TEXT    "  FL:"
+PCSAVE, 7777
+ACSAVE, 7777
+MQSAVE, 7777
+FLSAVE, 7777
+
+        $$$
+/#8
+/#8
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape5/SET.PA b/sw/os8/v3d/sources/system/dectapes/dectape5/SET.PA
new file mode 100644 (file)
index 0000000..1fdbf44
--- /dev/null
@@ -0,0 +1,2279 @@
+/8 OS8 SET (PAL8/MACREL VERSION)
+
+/
+/S.R.
+/
+/
+/      S E T
+/
+/
+/
+/
+/
+/
+/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.
+/
+/
+/      COPYRIGHT (C) 1977 BY DIGITAL EQUIPMENT CORPORATION.
+/
+/
+/
+/
+\f/     EDIT HISTORY:
+
+/      19-MAR-77       S.R.    REMOVED FROM CAMP V4
+/      19-MAR-77       S.R.    FIXED BUG WITH SET MTA FILES
+/      19-MAR-77       S.R.    FIXED BUG WITH SET CDR
+/      19-MAR-77       S.R.    FIXED BUG WITH = OPTION
+/      19-MAR-77       S.R.    CONVERTED TO MACREL CODE
+/      01-APR-77       S.R.    TTY PAUSE
+/      01-APR-77       S.R.    TTY HEIGHT
+/      01-APR-77       S.R.    TTY SCOPE
+/      17-APR-77       S.R.    REWROTE TTY PAGE
+/      17-APR-77       S.R.    DEV: DVCODE
+/      17-APR-77       S.R.    FINISHED TTY SCOPE
+/      27-APR-77       S.R.    TTY COL
+/      27-APR-77       S.R.    SYS OPTIONS (INIT, OS8, OS78)
+/      03-MAY-77       S.R.    LA8A, LA78
+/      03-MAY-77       S.R.    INIT OS78 FIXES TERMINATE
+/      03-MAY-77       S.R.    BASIC FIXES
+/      29-JUN-77       S.R.    TTY ARROW       (NOT FOR PS/8)
+/      29-JUN-77       S.R.    TTY ESC         (NOT FOR PS/8)
+/      29-JUN-77       S.R.    DEV BLK LOC     (NOT FOR PS/8)
+
+/      MUST SKIP LOCS 1000-1777
+
+       LINBUF=1000
+
+       AUXBUF=6600
+
+       IFDEF EDF <MACREL=1>
+       IFNDEF EDF <MACREL=0>
+
+       IFNZRO MACREL < .XSECT XSET
+       >
+       IFZERO MACREL < *10 >
+
+XR1,   0
+XR2,   0
+XR3,   0
+
+       IFNZRO MACREL < .ZSECT ZSET
+       >
+       IFZERO MACREL < *20 >
+TEMP,  0
+T,     0
+T2,    0
+LINPTR,        0
+T3,    0
+FLAG,  0
+SPKNT, 0
+DEVTYP,        0               /DEVICE TYPE (BITS 6-11)
+ENTRY, 0               /HANDLER ENTRY POINT
+NUM,   0
+TYP,   0               /0 MEANS 'F', 1 MEANS 'R'
+T4,    0
+DEVNUM,        0
+DCW,   0               /DEVICE CONTROL WORD
+DCWPTR,        0
+USR,   200             /POINTS TO USR ENTRY POINT
+ESCBIT,        0               /1 MEANS USER TYPED ALTMODE
+CNT,   0
+CTOFLG,        0               /-1 MEANS SAW ^O
+PTR,   0
+DHIT,  0               /DEVICE HANDLER INFO TABLE - 1
+DHI,   0               /DEVICE HANDLER INFO
+DBLK,  0               /DEVICE HANDLER BLOCK
+VNOPTR,        0               /PTS TO VERSION # IN HANDLER
+VNO,   0               /CURRENT HANDLER VERSION NUMBER
+SAVPTR,        0
+NO,    0               /1 MEANS 'NO'
+FLG,   1               /1 MEANS SAW NO DIGITS
+RR,    0
+NUCODE,        0
+SCOP,  0               /NON-0 IF TTY IS SCOPE
+NUM2,  0
+
+/0000-0777     /SET
+/1000-1377     /OS/8 LINE BUFFER
+/1400-1777     /PS/8 LINE BUFFER
+/2000-6577     /SET
+/6600-7177     /AUXILIARY I/O BUFFER
+/7000-7177     /I/O BUFFER FOR TECO CCB
+/7200-7577     /OS/8 HANDLER
+/7600-7777     /OS/8
+
+       SCPBIT=7726     /BIT 4
+\f      IFNZRO MACREL < .ASECT ASET
+       >
+       *200
+
+START, SKP
+       JMP CHN
+       TAD ("#
+       JMS I [TYPE
+       JMS BIT
+       JMS I [READ     /READ A LINE INTO OS/8 LINE BUFFER
+CHN,   TAD [LINBUF     /CHAIN ENTRY ADDRESS
+       DCA LINPTR      /INITIALIZE POINTER TO LINE BUFFER
+       JMS BIT
+       STA
+       JMS I [SPACE    /IGNORE LEADING SPACES
+       JMS GETTWO      /GET TWO CHARS
+       DCA TEMP
+       JMS I [SCAN     /SCAN PAST EXTRA LETTERS OR DIGITS
+       TAD TEMP
+       JMS I [BRANCH   /GO TO APPROPRIATE ROUTINE
+       -2305;SET       /SE
+       -2605;VERSION   /VE
+       -1005;HELP      /HE
+       0
+       SNA CLA
+       JMP I [GOAWAY
+       JMP I [SYNTAX   /NONE OF THESE
+
+BIT,   0
+       CDF 10
+       TAD I (SCPBIT
+       CDF 0
+       AND [200
+       DCA SCOP        /NOTE WHETHER TTY IS SCOPE      V3D
+       JMP I BIT
+\f/     GETTWO
+
+/GET TWO LETTERS OR DIGITS FROM INPUT LINE, PACK IN SIXBIT
+/ADVANCE PAST THEM. SUBSTITUTE NULL IF NOT FOUND.
+
+GETTWO,        0
+       JMS GETSIX
+       CLL RTL
+       RTL
+       RTL
+       DCA T2
+       JMS GETSIX
+       TAD T2          /COMBINE
+       JMP I GETTWO
+
+GETSIX,        0               /GET A SIXBIT LETTER OR DIGIT (OR NULL)
+       JMS ALPHA       /IS IT ALPHANUMERIC?
+       JMP NOTALPH     /NO
+       AND [77         /YES
+       JMP I GETSIX    /TRUNCATE TO SIXBIT
+NOTALPH,CLA
+       JMS BACKC
+       JMP I GETSIX    /RETURN NULL
+
+GETC,  0               /GET A CHARACTER, ADVANCE POINTER
+       TAD I LINPTR
+       AND [177        /ALWAYS RETURN 8-BIT
+       SZA
+       TAD [200        /WITH HIGH ORDER BIT ON
+       ISZ LINPTR      /ADVANCE SCAN
+       JMP I GETC      /RETURN
+
+BACKC, 0               /MOVE SCAN POINTER BACK ONE
+       STA
+       TAD LINPTR
+       DCA LINPTR
+       JMP I BACKC     /RETURN
+\f/RETURN 1     NOT OF TYPE DESIRED
+/RETURN 2      DESIRED TYPE
+/IN BOTH CASES, CHAR IS LEFT IN AC
+
+ALPHA, 0               /LOOK FOR ALPHANUMERIC
+       JMS I [GETC
+       JMS LETTER      /IS IT A LETTER?
+       JMP TRYDIG      /NO, TRY DIGIT
+       JMP GOTAL       /YES
+TRYDIG,        JMS DIGIT       /IS IT A DIGIT?
+       JMP I ALPHA     /NO, AINT LETTER OR DIGIT
+GOTAL, ISZ ALPHA       /YES, EITHER LETTER OR DIGIT
+       JMP I ALPHA     /RETURN WITH IT IN AC
+
+LETTER,        0               /LOOK FOR LETTER
+       TAD (-"A
+       CLL
+       TAD ("A-"Z-1
+       SNL
+       ISZ LETTER
+       TAD ("Z+1       /RESTORE CHAR
+       JMP I LETTER
+
+DIGIT, 0               /LOOK FOR DIGIT
+       TAD (-"0
+       CLL
+       TAD ("0-"9-1    /(DECIMAL)
+       SNL
+       ISZ DIGIT
+       TAD ("9+1       /RESTORE DIGIT TO CHARACTER FORM
+       JMP I DIGIT     /AND RETURN WITH IT IN AC
+\fHELP, JMS I [PRINT
+       TEXT    /SET DEV: [NO] ATTRIB [N]/
+       JMS I [PRINT
+       TEXT    /VERSION/
+       JMS I [PRINT
+       TEXT    /HELP/
+       JMP I [START
+       PAGE
+\fSYNTAX,       CLA
+       JMS PRINT
+       TEXT    /? SYNTAX ERROR/
+GOAWAY,        TAD ESCBIT
+       SZA CLA
+       JMP I [7605     /LINE ENDED WITH ESCAPE
+       TAD I [READ     /WAS 'READ' EVER CALLED?
+       SZA CLA
+       JMP I [START    /YES, GET A NEW LINE
+       JMP I [7605     /NO, WE MUST'VE BEEN CHAINED TO, RECALL KBM
+
+PRINT, 0
+       TAD I PRINT
+       RTR
+       RTR
+       RTR
+       JMS PRIN
+       TAD I PRINT
+       JMS PRIN
+       ISZ PRINT
+       JMP PRINT+1
+LV,    JMS I [CRLF
+       ISZ PRINT
+       JMP I PRINT
+
+PRIN,  0
+       AND [77
+       SNA
+       JMP LV
+       TAD [240
+       AND [77
+       TAD [240
+       DCA T3
+       TAD [200
+       KRS
+       TAD (-203
+       SNA
+       JMP CTRLC
+       TAD (203-217    /^O
+       SNA CLA
+       JMS CTRLO
+       TAD T3
+       JMS I [TYPE
+       JMP I PRIN
+\fCTRLC,        TAD ["^
+       JMS I [TYPE
+       TAD ("C
+       JMS I [TYPE     /ECHO "^C"
+       JMS I [DELAYY
+       JMP I [7600     /THEN GO AWAY
+CTRLO, 0
+       KCC             /CLEAR OUT ^O
+       TAD ["^
+       JMS I [TYPE
+       TAD ("O
+       JMS I [TYPE
+       JMS I [CRLF
+       STA
+       DCA CTOFLG      /STOP ECHOING
+       JMP I CTRLO
+
+VERSION,JMS PRINT
+       TEXT    \OS/8 SET V1B\
+       JMP I [START
+NUMBIG,        JMS PRINT
+       TEXT    /? NUMBER TOO BIG/
+       JMP I [GOAWAY
+\fNONEX,        JMS PRINT
+       TEXT    /? CAN'T - DEVICE DOESN'T EXIST/
+       JMP I [GOAWAY
+
+SYSERR,        JMS PRINT
+       TEXT    \? I/O ERROR ON SYS:\
+       JMP I [GOAWAY
+       PAGE
+\fSYSOS8,       0
+       TAD NO          /REVERSE MEANING OF 'NO'
+       SNA CLA
+       IAC
+       DCA NO
+       JMS SYS78
+       JMP I SYSOS8
+
+SYS78, 0
+       TAD [7771
+       JMS I [SET200
+       JMS I [7607
+       200
+       AUXBUF
+       0
+       JMP I [SYSERR
+       TAD (AUXBUF+371
+       JMS I [SET200
+       JMS I [7607
+       4200
+       AUXBUF
+       0
+       JMP I [SYSERR
+       JMS I [7607     /THERE'S A 2ND COPY
+       200             /IN BLOCK 11 LOCATION 56
+       AUXBUF
+       11
+       JMP I [SYSERR
+       TAD (AUXBUF+56
+       JMS I [SET200
+       JMS I [7607
+       4200
+       AUXBUF
+       11
+       JMP I [SYSERR
+       JMS I (FIXCCL
+       JMP I SYS78
+\fSYSINI,       0
+       JMS I [GETC
+       SNA CLA
+       JMP DEFINI      /ASSUME @INIT
+       TAD NO
+       SZA CLA
+       JMP I [SYNTAX   /SET SYS NO INIT CMD
+       JMS I [BACKC
+       TAD LINPTR
+       DCA SAVLP
+       TAD (-6         /ALLOW A MAXIMUM OF 5 CHARS
+       DCA SAVKN
+SAVLUP,        JMS I [GETC
+       SNA CLA
+       JMP DEFDO
+       ISZ SAVKN
+       JMP SAVLUP
+       JMS I [PRINT
+       TEXT    /? INITIAL COMMAND TOO BIG/
+       JMP I [GOAWAY
+
+SAVKN, 0
+SAVLP, 0
+
+DEFINI,        TAD (INIMSG
+       DCA SAVLP
+DEFDO, JMS I [7607
+       200
+       AUXBUF
+       0
+       JMP I [SYSERR
+       TAD NO
+       SZA CLA
+       TAD (400-1077
+       TAD (1077
+       DCA I (AUXBUF+77
+       JMS I [7607
+       4200
+       AUXBUF
+       0
+       JMP I [SYSERR
+       TAD NO
+       SZA CLA
+       JMP I SYSINI
+       JMS I [7607
+       200
+       AUXBUF
+       11
+       JMP I [SYSERR
+       STA
+       TAD SAVLP
+       DCA XR2
+       TAD (AUXBUF-1
+       DCA XR3
+       TAD (-5
+       DCA SAVKN
+MOVL,  TAD I XR2
+       DCA I XR3
+       ISZ SAVKN
+       JMP MOVL
+       JMS I [7607
+       4200
+       AUXBUF
+       11
+       JMP I [SYSERR
+       JMP I SYSINI
+
+INIMSG,        "@;"I;"N;"I;"T;0
+       PAGE
+\f      *1400
+
+/THIS WON'T ALWAYS WORK UNDER PS/8:
+
+TTGGO, JMP I TTGAG
+TTGAG, 0
+       JMS I [TTST1
+       JMS I [PRINT
+TEXT /A FUNNY THING HAPPENED TO ME ON THE WAY TO THE COMPUTER ROOM./
+       JMS I [PRINT
+TEXT /A PANHANDLER CAME UP TO ME AND SAID,/
+       JMS I [PRINT
+TEXT /"CAN YOU SPARE ME $25,000 FOR A CUP OF COFFEE?"/
+       JMS I [PRINT
+TEXT /"WHY SO MUCH?", I ASKED IN AMAZEMENT./
+       JMS I [PRINT
+TEXT /"THINGS HAVE BECOME SO AUTOMATED", HE REPLIED,/
+       JMS I [PRINT
+TEXT /"THAT THE ONLY WAY I CAN ORDER IT/
+       JMS I [PRINT
+TEXT /IS WITH A COMPUTER ORDER FORM"./
+       JMP I (TTGGO
+\fTTESC,        0               /V3D
+       JMS I (OLDTST
+       JMS I [SRCH
+       200;200;44
+       JMP I [REASEM
+       TAD (-4
+       DCA TEMP        /SEE SOURCE OF KL8E
+       TAD NO
+       SZA CLA
+       TAD (7640-CLA   /YES
+       TAD (CLA        /NO
+       DCA I TEMP
+       JMP I TTESC
+
+TTAROW,        0               /V3D
+       JMS I (OLDTST
+       JMS I [SRCH
+       200;200;7740
+       JMP I [REASEM
+       IAC
+       DCA TEMP
+       TAD I TEMP
+       RAL
+KSPA,  SPA CLA
+       JMP I [REASEM
+       ISZ TEMP
+       ISZ TEMP
+       TAD TEMP
+       TAD (3
+       DCA TEMP2
+       TAD NO
+       SNA CLA
+       JMP YESARO      /YES
+       TAD KSPA        /NO
+NOAROW,        DCA I TEMP
+       JMP I TTAROW
+YESARO,        TAD I TEMP2
+       JMP NOAROW
+\fGENBLK,       0               /V3D
+       JMS I (GENCMN
+       TAD NUM2
+       DCA BLOK        /GET BLOCK NUMBER
+       TAD (LOC
+       JMS I [KEYSRCH
+       JMP I [SYNTAX
+       JMS I (GENCMN   /GET LOCATION
+       TAD [-400
+       CLL
+       TAD NUM2
+       SZL CLA
+       JMP I [NUMBIG
+       TAD NUM2
+       TAD PAUXBUF
+       DCA NUM2
+       JMS I ENTRY     /READ BLOCK
+       200
+PAUXBUF,AUXBUF
+BLOK,  0
+       JMP I [SYSERR
+       TAD TEMP
+       SNA CLA
+       JMS I (ODT
+       JMS I [ONUM
+       DCA NUM
+       CLA IAC
+       DCA DEVNUM      /FAKE OUT - PREVENTS RE-WRITING USED HANDLER
+       TAD FLG
+       SZA CLA
+       JMP I GENBLK
+       JMS I [GETC
+       SZA CLA
+       JMP I [SYNTAX
+       TAD NUM
+       DCA I NUM2      /SET NEW VALUE
+       TAD BLOK
+       DCA BLOK2
+       JMS I ENTRY
+       4200
+       AUXBUF
+TEMP2,
+BLOK2, 0
+       JMP I [SYSERR
+       JMP I GENBLK
+       PAGE
+\f      *2000
+
+/ORIGIN PAST OS/8 LINE BUFFER AT 1000.
+/SKIP PAST PS/8 LINE BUFFER (AT 1400) JUST IN CASE
+/PS/8 USERS WISH TO PATCH THIS PROGRAM
+
+/SCAN PAST EXTRA LETTERS OR DIGITS
+
+SCAN,  0
+       JMS I [ALPHA
+       JMP NOPE
+       CLA
+       JMP SCAN+1
+NOPE,  CLA
+       JMS I [BACKC
+       JMP I SCAN
+
+/SCAN PAST SPACES; GIVE ERROR IF NO SPACES FOUND UNLESS AC=-1
+
+SPACE, 0
+       DCA FLAG        /SET AC=-1 TO PREVENT ERROR ON NO SPACES FOUND
+       DCA SPKNT       /INITIALIZE SPACE COUNTER
+       SKP             /JUMP INTO LOOP
+GOTSP, ISZ SPKNT
+       JMS I [GETC     /GET NEXT CHAR
+       TAD [-240
+       SNA CLA         /IS IT A SPACE?
+       JMP GOTSP       /YES, COUNT IT
+       JMS I [BACKC    /NO, PUT IT BACK
+       ISZ FLAG        /CHECK FLAG
+       SKP             /USER DIDN'T SPECIFY FLAG
+       JMP I SPACE     /-0 MEANT DON'T CHECK IF FOUND SPACE
+       TAD SPKNT       /HOW MANY SPACES DID WE FIND?
+       SZA CLA
+       JMP I SPACE     /SOME.  OK
+       JMP I [SYNTAX   /NONE.  TSK. TSK.
+\fBRANCH,       0
+       DCA T
+BR2,   TAD I BRANCH
+       ISZ BRANCH
+       SNA
+       JMP NOTFND
+       TAD T
+       SNA CLA
+       JMP FOUND
+       ISZ BRANCH
+       JMP BR2
+
+FOUND, TAD I BRANCH
+       DCA T
+       JMP I T         /FOUND ITEM IN COLUMN 1, JUMP TO ADDRESS IN COL 2
+
+NOTFND,        TAD T
+       JMP I BRANCH    /IF NOT FOUND IN COL 1, RETURN WITH AC INTACT
+
+BADKBM,        CDF 0
+       JMS I [PRINT
+       TEXT    /? OLD VERSION OF KBM/
+       JMP I [GOAWAY
+\f      LLS=6666
+       DBTD=6574
+       LSF=6661
+       DBST=6570
+
+LP78,  0
+       TAD (CMA-NOP
+       JMS LP8A
+       JMP I LP78
+
+LP8A,  0
+       TAD (NOP        /AC MAY BE NON-0
+       DCA LPKOD
+       JMS I (LPTST1
+       TAD VNO
+       TAD (-2
+       SNA CLA
+       JMP I (OLDERR
+       JMS I [SRCH
+       0;200;7700
+       JMP I (OLDERR
+       TAD (3
+       DCA TEMP
+       TAD I TEMP
+       AND [7000
+       TAD [-7000
+       SZA CLA         /NOP OR CMA
+       JMP I (OLDERR
+       TAD LPKOD
+       DCA I TEMP
+       ISZ TEMP
+       TAD I TEMP
+       AND [7000
+       TAD (-6000
+       SZA CLA
+       JMP I (OLDERR
+       TAD LPKOD
+       AND [70
+       SZA CLA
+       TAD (DBTD-LLS
+       TAD (LLS
+       DCA I TEMP
+       ISZ TEMP
+       TAD LPKOD
+       DCA I TEMP
+       JMS I [SRCH
+       100;100;6203
+       JMP I (OLDERR
+       TAD (2
+       DCA TEMP
+       TAD LPKOD
+       AND [70
+       SZA CLA
+       TAD (DBST-LSF
+       TAD (LSF
+       DCA I TEMP
+       JMP I LP8A
+
+LPKOD, 0
+       PAGE
+\f/READ A LINE INTO OS/8 LINE BUFFER
+
+READ,  0
+       DCA CTOFLG      /ALLOW ECHOING
+RD1,   TAD [LINBUF
+       DCA LINPTR
+       DCA ESCBIT
+GT,    JMS I [GET
+LOOK,  JMS I [BRANCH
+       -377;RUBOUT
+       -217;GT         /^O
+       -203;CTRLC      /^C
+       -212;LF         /LINE FEED
+       -215;CR         /CARRIAGE RETURN
+       -375;ESCAPE     /ALTMODE
+       -376;ESCAPE     /ALTMODE (2ND FLAVOR)
+       -233;ESCAPE     /ESCAPE
+       -225;CTRLU      /^U
+       -200;GT         /IGNORE NULLS
+       -223;GT         /IGNORE ^S
+       0
+       DCA TEMP        /NONE OF THESE
+       TAD LINPTR
+       TAD (-LINBUF-377
+       SNA CLA         /AT END OF LINE BUFFER?
+       JMP GT          /YES, DON'T ACCEPT CHAR
+       TAD TEMP        /NO, RETRIEVE CHAR
+       JMS I [TYPE     /ECHO IT
+       TAD TEMP        /INSERT IN BUFFER
+       DCA I LINPTR
+       ISZ LINPTR      /BUMP POINTER
+       JMP GT          /NEXT
+
+CTRLU, TAD ["^
+       JMS I [TYPE
+       TAD ("U
+       JMS I [TYPE     /ECHO "^U" <CR><LF>
+       JMS I [CRLF
+RDA,   TAD ("#
+       JMS I [TYPE
+       JMP RD1
+\f      BS=10
+
+RUBOUT,        TAD LINPTR
+       TAD [-LINBUF
+       SNA
+       JMP BOL         /AT BEGIN OF LINE
+       TAD [LINBUF-1
+       DCA LINPTR      /MOVE POINTER BACK ONE
+       TAD SCOP
+       SZA CLA
+       TAD (BS-"\
+       TAD ["\
+       JMS I [TYPE     /ECHO "\"
+RUB3,  TAD SCOP
+       SNA CLA
+       JMP .+3
+       TAD [40
+       SKP
+       TAD I LINPTR
+       JMS I [TYPE     /ECHO RUBBED-OUT CHARACTER
+       TAD SCOP
+       SNA CLA
+       JMP GT2
+       TAD [BS
+       JMS I [TYPE
+GT2,   JMS I [GET
+       JMS I [BRANCH
+       -377;RUB2
+       -216;GT2        /IGNORE ^O
+       -203;CTRLC      /^C
+       0
+       DCA TEMP        /A NEW CHAR
+       TAD SCOP
+       SZA CLA
+       JMP .+3
+       TAD ["\
+       JMS I [TYPE     /ENCLOSE RUBBED-OUT CHARS IN \'S
+       TAD TEMP
+       JMP LOOK
+
+RUB2,  TAD LINPTR
+       TAD [-LINBUF
+       SNA
+       JMP BOL2
+       TAD [LINBUF-1
+       DCA LINPTR
+       JMP RUB3
+\fBOL2, TAD SCOP
+       SZA CLA
+       JMP BOL
+       TAD ["\
+       JMS I [TYPE
+BOL,   JMS I [CRLF
+       JMP RDA
+
+ESCAPE,        TAD ["$         /ECHO ESCAPE AS DOLLAR SIGN
+       JMS I [TYPE
+       ISZ ESCBIT      /NOTE ESCAPE
+CR,    DCA I LINPTR    /INSERT 0 AT END
+       JMS I [CRLF
+       JMP I READ      /RETURN, WE GOT LINE
+\fLF,   DCA I LINPTR    /TEMPORARILY INSERT A 0 SENTINEL
+       TAD [LINBUF-1
+       DCA XR1
+       JMS I [CRLF
+       TAD ["#
+       JMS I [TYPE
+LFLP,  TAD I XR1
+       SNA
+       JMP I [GT       /FINISHED, GET SOME MORE CHARS
+       JMS I [TYPE     /ECHO CURRENT CHARS
+       JMP LFLP
+       PAGE
+\f/GET A DECIMAL NUMBER, RETURN IT IN AC
+
+NUMBER,        0
+       DCA NUM
+       CLA IAC
+       DCA FLG
+       JMS I [BACKC
+NM1,   JMS I [GETC
+       JMS I [DIGIT
+       JMP EON
+       TAD (-"0        /CONVERT TO DIGIT
+       DCA T4
+       DCA FLG         /NOTE PASSAGE OF A DIGIT
+       TAD NUM
+       AND [7000
+       SZA CLA
+       JMP I [NUMBIG
+       TAD NUM
+       CLL RTL
+       TAD NUM
+       CLL RAL
+       TAD T4
+       SZL
+       JMP I [NUMBIG
+       DCA NUM
+       JMP NM1
+
+EON,   CLA
+       JMS I [BACKC
+       TAD FLG
+       SZA
+       DCA NUM         /IF NO DIGITS, RETURN A 1
+       TAD NUM
+       JMP I NUMBER
+\f/     GETDEV
+
+/PARSES OFF A DEVICE NAME (1-4 CHARS)
+/DETERMINES IF IT EXISTS
+/LOADS HANDLER INTO 7200-7577 IF NOT ALREADY IN CORE
+/SETS ENTRY POINT ADDRESS AT 'ENTRY'
+/SETS DEVICE NUMBER AT 'DEVNUM'
+/SETS DEVICE CONTROL WORD AT 'DCW'
+/SETS 'DEVTYP'
+
+GETDEV,        0
+       JMS I [GETTWO
+       DCA WD1
+       JMS I [GETTWO
+       DCA WD2
+       TAD WD1
+       TAD WD2
+       DCA WD1         /COMBINE TWO WORDS INTO 1 (IN WD1)
+       TAD WD2
+       SNA CLA
+       JMP INQ
+       TAD WD1         /OS/8 KLUDGE FOR UNIQUENESS
+       CLL RAL
+       STL RAR         /FORCE BIT 0 ON IF 2ND WORD WAS NON-ZERO
+       DCA WD1
+INQ,   DCA WD2
+       CIF 10
+       JMS I USR
+       12              /INQUIRE
+WD1,   0               /DEVICE NAME
+WD2,   0               /GETS DEVICE NUMBER
+WD3,   0               /GETS ENTRY POINT
+       JMP I [NONEX    /DEVICE DOESN'T EXIST
+       TAD WD3
+       SZA             /IS HANDLER ALREADY IN CORE?
+       JMP INCORE      /YES
+       TAD WD1
+       DCA DW1
+       TAD (7201       /ALLOW TWO PAGE HANDLER IN 7200
+       DCA DW3
+       DCA DW2
+       CIF 10
+       JMS I USR
+       1               /FETCH
+DW1,   0               /DEVICE NAME
+DW2,   0               /GETS DEVICE NUMBER
+DW3,   0               /GETS ENTRY POINT
+       JMP I [NONEX    /DOESN'T EXIST
+       TAD DW2
+       DCA DEVNUM
+       TAD DW3
+       DCA ENTRY
+       JMP GETYP
+\fINCORE,       DCA ENTRY
+       TAD WD2
+       DCA DEVNUM
+GETYP, TAD DEVNUM
+       TAD (7757
+       DCA DCWPTR      /POINT INTO DEVICE CONTROL WGRD TABLE
+       CDF 10
+       TAD I DCWPTR    /GET DCW
+       DCA DCW
+       TAD DCW
+       RTR
+       RAR
+       AND [77
+       DCA DEVTYP
+       STA
+       TAD I (37       /GET ADDRESS OF DHIT
+       DCA DHIT
+       TAD DHIT
+       TAD DEVNUM
+       DCA DHI
+       TAD I DHI
+       CDF 0
+       DCA DHI
+       TAD DHI
+       RTL
+       RTL
+       RTL
+       AND (17
+       SZA
+       TAD (15
+       DCA DBLK
+       JMP I GETDEV
+
+DELAYY,        0
+       TAD (-10
+       DCA OUTER
+       ISZ ZER
+       JMP .-1
+       ISZ OUTER
+       JMP .-3
+       JMP I DELAYY
+ZER,   0
+OUTER, -10
+       PAGE
+\fOLDTST,       0               /V3D
+       JMS I (ASRTST
+       TAD VNO
+       JMS I [BRANCH
+       -1;OLDERR
+       -2;OLDERR
+       -3;OLDERR
+       -4;OLDERR
+       -5;TSTOK
+       ZBLOCK 4
+       0
+       JMP I [NEWERR
+TSTOK, JMP I OLDTST
+\fTTPAUS,       0
+       JMS OLDTST
+       JMS I [SRCH
+       200;100;15
+       JMP I [REASEM
+       TAD (-3
+       DCA TEMP        /SEE SOURCE OF KL8E FOR EXPLANATION
+       TAD NO
+       SNA CLA
+       TAD (7650-7610  /YES
+       TAD (7610       /NO
+       DCA I TEMP
+       DCA NUM
+       JMS I [GETC
+       SNA CLA
+       JMP NOPA        /NO PAUSE VALUE
+       TAD NO
+       SZA CLA
+       JMP I [SYNTAX   /SET TTY NO PAUSE N
+       JMS I [NUMBER
+       SNA
+       JMP BADPAUS
+       DCA NUM
+       TAD NUM         /SCALE CORRECTLY
+       CLL RAL
+       TAD NUM
+       CLL RTL
+       DCA NUM
+       TAD FLG
+       SZA CLA
+       JMP BADPAUS     /NO DIGITS
+       TAD NUM
+       AND [6000
+       SZA CLA
+       JMP BADPAUS
+       JMS I [SRCH
+       300;77;7600
+       JMP I [REASEM
+       TAD (5
+       DCA TEMP
+       TAD NUM
+       CIA
+       DCA I TEMP
+NOPA,  JMS I (BASLUK
+       JMP I TTPAUS
+       TAD NUM
+       CIA
+       DCA I (AUXBUF+1
+       JMS I (BASWRI
+       JMP I TTPAUS
+\fBADPAUS,JMS I [PRINT
+       TEXT    /? BAD VALUE FOR PAUSE DURATION/
+       JMP I [GOAWAY
+\fONUM, 0
+       DCA NUM
+       CLA IAC
+       DCA FLG
+ONM1,  JMS I [GETC
+       TAD (-"0-10     /CONVERT TO DIGIT
+       CLL
+       TAD [10
+       SNL
+       JMP OEON
+       DCA T4
+       DCA FLG
+       TAD NUM
+       AND [7000
+       SZA CLA
+       JMP I [NUMBIG
+       TAD NUM
+       CLL RTL
+       RAL
+       TAD T4
+       DCA NUM
+       JMP ONM1
+OEON,  CLA
+       JMS I [BACKC
+       TAD NUM
+       JMP I ONUM
+       PAGE
+\fTTCOL,        0
+       TAD NO
+       SZA CLA
+       JMP I [SYNTAX   /SET TTY NO COL
+       JMS I [GETC
+       SNA CLA
+       JMP BADCOL      /NO COL SPECIFIED
+       JMS I [NUMBER
+       SNA
+       JMP BADCOL
+       DCA NUM
+       TAD FLG
+       SZA CLA
+       JMP I [SYNTAX
+       TAD NUM
+       AND [7770
+       SZA CLA
+       JMP BADCOL
+       TAD (CCLNAM     /READ IN CCL.SV
+       JMS I [LOOKUP
+       JMP CCLNF       /CCL NOT FOUND
+       TAD (2          /WANT 2ND BLOCK IN CCL
+       DCA ARG2        /CCL LOCATIONS 12400-12777
+       JMS I (7607
+       200             /READ IN 2 PAGES
+       AUXBUF
+ARG2,  0
+       JMP I [SYSERR
+       TAD ARG2
+       DCA ARG3
+       TAD I (AUXBUF   /GET PTR TO DIRECT COL WORD
+       SPA
+       JMP OLDCCL
+       TAD (AUXBUF-2400        /RELOCATE
+       DCA ARG2
+       TAD NUM
+       DCA I ARG2
+       JMS I (7607
+       4200
+       AUXBUF
+ARG3,  0
+       JMP I [SYSERR
+       JMP I TTCOL
+\fBADCOL,       JMS I [PRINT
+       TEXT    /? BAD COLUMN COUNT/
+       JMP I [GOAWAY
+
+OLDCCL,        CLA
+       JMS I [PRINT
+       TEXT    /? WRONG VERSION OF CCL/
+       JMP I [GOAWAY
+\fTYPE, 0
+       DCA TYPEM
+       JMS I [DELAYY
+       DCA .-1         /DELAY FIRST TIME THRU TO LET THINGS QUIET DOWN
+       TAD CTOFLG
+       SZA CLA
+       JMP I TYPE      /NO ECHOING
+       TAD TYPEM
+       TLS
+       TSF
+       JMP .-1
+       CLA
+       JMP I TYPE
+
+TYPEM, 0
+
+CCLNAM,        FILENAME CCL.SV
+
+CCLNF, JMS I [PRINT
+       TEXT    /? CCL.SV NOT FOUND/
+       JMP I [GOAWAY
+\f      CCLBLK=67
+
+FIXCCL,        0
+       JMS I [7607
+       200
+       AUXBUF
+       CCLBLK
+       JMP I [SYSERR
+       TAD I (AUXBUF
+       TAD (-"G
+       SPA CLA
+       JMP I (OLDCCL
+       TAD (CCLTBL
+       JMS I (FIXUP
+       JMS I [7607
+       4200
+       AUXBUF
+       CCLBLK
+       JMP I [SYSERR
+       JMP I FIXCCL
+       PAGE
+\fESC,  "E;"S;"C;4000+"A;4000+"P;4000+"E;0
+
+TTHGHT,        0
+       JMS I (OLDTST
+       JMS I [GETC
+       SNA CLA
+       JMP I (BADHIT   /NO HEIGHT
+       TAD NO
+       SZA CLA
+       JMP I [SYNTAX   /SET TTY NO HEIGHT
+       JMS I [NUMBER
+       SNA
+       JMP I (BADHIT
+       DCA NUM
+       TAD FLG
+       SZA CLA
+       JMP I (BADHIT   /NO DIGITS
+       JMS I [SRCH
+       300;77;7600
+       JMP I [REASEM
+       TAD (3
+       DCA TEMP
+       TAD NUM
+       CIA
+       DCA I TEMP
+       TAD I TEMP
+       ISZ TEMP
+       DCA I TEMP
+       JMS I (BASLUK
+       JMP I TTHGHT
+       TAD NUM
+       CIA
+       DCA I (AUXBUF
+       JMS I (BASWRI
+       JMP I TTHGHT
+\f/     LOC             YES     NO
+KBMTBL,        AUXBUF+313;     0210;   1070
+       AUXBUF+314;     1313;   2020
+       AUXBUF+316;     1324;   7240
+       AUXBUF+317;     4423;   3020
+       AUXBUF+322;     1313;   1440
+       AUXBUF+224;     7555;   7403
+       AUXBUF+225;     1207;   1302
+       AUXBUF+226;     7557;   7402
+       AUXBUF+227;     1207;   1302
+       0
+
+CDTBL, AUXBUF+135;     0210;   1102
+       AUXBUF+136;     1335;   2024
+       AUXBUF+140;     1346;   7240
+       AUXBUF+141;     4466;   3024
+       AUXBUF+144;     1335;   1420
+       AUXBUF+33;      7555;   7403
+       AUXBUF+34;      5207;   5321
+       AUXBUF+35;      7557;   7402
+       AUXBUF+36;      5207;   5321
+       0
+
+CCLTBL,        AUXBUF+4;       0024;   0002
+       AUXBUF+5;       0522;   0143
+       AUXBUF+6;       5551;   5363
+       AUXBUF+7;       5600;   6000
+       0
+
+AROW,  "A;"R;"R;"O;"W;0
+       PAGE
+\f/     SCOPE BIT ON DISK:
+/      BLOCK 0         REL 126 BIT 4
+
+/      SCOPE BIT IN MEMORY:
+/      LOC 17726       BIT 4
+
+TTSCOP,        0
+/THE FOLLOWING CODE WOULD BE ADDED IF WE WANT TO
+/ALLOW CHANGING KL8E SCOPE PATTERNS
+/      JMS I (ASRTST
+/      TAD VNO
+/      JMS I [BRANCH
+/      -1;OLDERR
+/      -2;OLDERR
+/      -3;OLDERR
+/      -4;OLDERR
+/      -5;TTSCOK
+/      ZBLOCK 2
+/      0
+/      JMP I [NEWERR
+TTSCOK,        JMS I (7607
+       200
+       AUXBUF          /READ 2 PAGES INTO AUXILIARY BUFFER
+       11
+       JMP I [SYSERR
+       TAD (KBMTBL
+       JMS FIXUP
+       JMS I (7607
+       4200
+       AUXBUF
+       11
+       JMP I [SYSERR
+       JMS I (7607
+       200
+       AUXBUF          /READ BLOCK 53 (CD)
+       53
+       JMP I [SYSERR
+       TAD (CDTBL
+       JMS FIXUP
+       JMS I (7607
+       4200
+       AUXBUF
+       53
+       JMP I [SYSERR
+       TAD NO          /SET SCOPE BIT
+       SNA CLA
+       IAC
+       DCA SCOP
+       CDF 10
+       TAD (SCPBIT
+       JMS SET200
+       CDF 0
+       JMS I (7607
+       200
+       AUXBUF
+       0
+       JMP I [SYSERR
+       TAD (AUXBUF+126
+       JMS SET200
+       JMS I (7607
+       4200
+       AUXBUF
+       0
+       JMP I [SYSERR
+/      JMS I [SRCH
+/      366;11;7770
+/      JMP I [REASEM
+/      CLA
+/      JMS I [SRCH
+/      0;200;"\
+/      JMP I [OLDERR
+/      IAC
+/      DCA TEMP
+/      TAD NO
+/      SNA CLA
+/      TAD (1336-1367
+/      TAD (1367
+/      DCA I TEMP
+       JMP I TTSCOP
+\fSET200,       0               /DF IS SPECIALLY SET
+       DCA HLTPTR
+       TAD I HLTPTR
+       AND (7577
+       DCA TEMP
+       TAD TEMP
+       TAD (-HLT
+       SZA CLA
+       JMP I (BADKBM
+       TAD NO
+       SNA CLA
+       TAD [200
+       TAD TEMP
+       DCA I HLTPTR
+       JMP I SET200
+HLTPTR,        0
+
+FIXUP, 0
+       DCA FIXPTR
+FIXLUP,        TAD I FIXPTR
+       SNA
+       JMP I FIXUP
+       DCA FIXLOC
+       ISZ FIXPTR
+       TAD NO
+       SZA CLA
+       ISZ FIXPTR
+       TAD I FIXPTR
+       DCA I FIXLOC
+       TAD NO
+       SNA CLA
+       ISZ FIXPTR
+       ISZ FIXPTR
+       JMP FIXLUP
+
+FIXPTR,        0
+FIXLOC,        0
+\fBASNAM,       FILENAME BASIC.SV
+
+BASLUK,        0
+       TAD (BASNAM
+       JMS I (LOOKUP
+       JMP I BASLUK
+       ISZ BASLUK
+       TAD (7
+       DCA BASBLK
+       JMS I [7607
+       200
+       AUXBUF
+BASBLK,        0
+       JMP I [SYSERR
+       TAD BASBLK
+       DCA BASB2
+       TAD I (AUXBUF+2
+       SNA CLA
+       JMP I BASLUK
+       JMP I (OLDBAS
+
+BASWRI,        0
+       JMS I [7607
+       4200
+       AUXBUF
+BASB2, 0
+       JMP I [SYSERR
+       JMP I BASWRI
+       PAGE
+\fTTCODE,       0
+       TAD NO
+       SZA CLA
+       JMP I [SYNTAX
+       JMS I [ONUM
+       SNA
+       JMP I [SYNTAX
+       DCA NUCODE
+       TAD NUCODE
+       AND [7700
+       SZA CLA
+       JMP I [NUMBIG
+       JMS I [TTST1
+       TAD (7200
+       DCA RR
+       JMS GETIOT
+       JMP I [OLDERR
+       CIA
+       DCA T2
+TTLP,  JMS GETIOT
+       JMP I [OLDERR
+       CIA
+       DCA T3
+       TAD T3
+       CIA
+       TAD T2
+       SNA
+       JMP TTLP
+       SMA CLA
+       JMP .+3
+       TAD T3
+       DCA T2          /T2 CONTAINS NEG OF SMALLER IOT
+       TAD (7200
+       DCA RR
+TTLP2, JMS GETIOT
+       JMP I TTCODE
+       TAD T2
+       SZA CLA
+       CLA IAC
+       TAD NUCODE
+       CLL RTL
+       RAL
+       DCA T3
+       TAD I RR
+       AND (7007
+       TAD T3
+       DCA I RR
+       JMP TTLP2
+\fGETIOT,       0
+       ISZ RR
+       TAD RR
+       TAD (-7600
+       SNA CLA
+       JMP I GETIOT
+       TAD I RR
+       AND [7000
+       TAD [-6000
+       SZA CLA
+       JMP GETIOT+1
+       TAD I RR
+       RTR
+       RAR
+       AND [77
+       TAD (-20
+       CLL RAR
+       SNA
+       JMP GETIOT+1
+       RAL
+       TAD (20
+       ISZ GETIOT
+       JMP I GETIOT
+\fNOTIMPL,JMS I [PRINT
+       TEXT    /% OPERATION NOT YET IMPLEMENTED/
+       JMP I [GOAWAY
+\fSET,  JMS I [SPACE
+       DCA VNO         /V3C
+       JMS I [GETDEV
+       JMS I [GETC
+       JMS I [BRANCH
+       -":;COLN
+       -" ;COLN
+       -"-;HYPH
+       0
+       JMP I [SYNTAX   /NO : OR BLANK AFTER NAME
+
+BADHIT,        JMS I [PRINT
+       TEXT    /? BAD HEIGHT SPECIFIED/
+       JMP I [GOAWAY
+
+TTALT, 0
+       JMS I [TTST1
+       JMP I [NOTIMPL
+       JMP I TTALT
+       PAGE
+\fCOLN, STA
+       JMS I [SPACE    /IGNORE OPTIONAL SPACES
+       JMS I [GETC
+       SNA
+       JMP I [SYNTAX
+       TAD (-"-
+       SNA CLA
+       JMP HYPH
+       JMS I [BACKC
+       STA
+       TAD DEVNUM
+       SNA CLA
+       JMP SYSDV
+COLN2, DCA NAM1
+       DCA NAM2
+       TAD (MAIN-1     /LOOK FOR DEVICE TYPE IN MAIN TABLE
+MNLUP, DCA XR1
+       TAD I XR1
+       SMA SZA
+       JMP NOTYP       /NOT FOUND
+       TAD DEVTYP
+       SNA CLA
+       JMP FNDTYP
+       TAD XR1
+       TAD (3          /POINT TO NEXT ENTRY
+       JMP MNLUP
+\fFNDTYP,       TAD I XR1       /GET GENERIC NAME
+       DCA NAM1
+       TAD I XR1
+       DCA NAM2
+       DCA AUXFLG
+       TAD I XR1       /GET PTR TO DEVICE TABLE
+INTO,  DCA PTR
+       DCA NO
+       TAD LINPTR
+       DCA SAVPTR      /SAVE SCAN POINTER
+       JMS I [GETTWO
+       TAD (-1617
+       SNA CLA         /ARE NEXT TWO CHARS 'NO'?
+       JMS SAWNO       /YES
+       TAD SAVPTR      /NO
+       DCA LINPTR      /RESTORE PTR
+SCNLUP,        TAD I PTR
+       SNA             /GET NEXT KEYWORD POINTER
+       JMP NOKEY
+       ISZ PTR         /POINT TO PTR TO ROUTINE
+       JMS I [KEYSRCH
+       JMP NOF         /NOT FOUND
+       TAD I PTR       /FOUND
+       DCA PTR         /GET PTR TO ROUTINE
+       STA
+       TAD DEVNUM
+       SZA CLA
+       JMS I (HREAD    /READ HANDLER
+       JMS I PTR       /CALL ROUTINE
+       STA
+       TAD DEVNUM
+       SZA CLA
+       JMS I (HWRITE   /REWRITE HANDLER
+       JMP I [GOAWAY
+
+SYSDV, ISZ AUXFLG
+       TAD (SYSAUX
+       JMP INTO        /V3D ALLOW SET SYS:
+\fHYPH, JMS I [ALPHA
+       JMP I [BADV
+       DCA VNO
+       TAD VNO
+       SNA
+       JMP I [BADV
+       AND [17
+       DCA VNO
+       JMS I [SPACE    /IGNORE SPACE
+       JMP COLN2
+\fNOKEY,        TAD AUXFLG
+       SNA CLA
+       JMP NOO
+       JMS I [PRINT
+       TEXT    \? UNKNOWN ATTRIBUTE FOR DEVICE  \
+       *.-1
+NAM1,  0
+NAM2,  0
+       0
+       JMP I [GOAWAY
+
+SAWNO, 0
+       ISZ NO
+       STA
+       JMS I [SPACE
+       TAD LINPTR
+       DCA SAVPTR
+       JMP I SAWNO
+
+NOTYP, CLA
+       ISZ AUXFLG
+       TAD (AUX        /SEARCH AUXILIARY TABLE
+       JMP INTO
+\fNOF,  ISZ PTR
+       TAD SAVPTR
+       DCA LINPTR
+       JMP SCNLUP
+
+AUXFLG,        0
+
+NOO,   ISZ AUXFLG
+       TAD (AUX
+       DCA PTR
+       JMP SCNLUP
+       PAGE
+\fHREAD,        0
+       TAD DBLK
+       SNA
+       JMP RESERR
+       DCA BLOCK
+       JMS I [7607
+       200             /READ 2 PAGES
+L7200, 7200            /INTO 7200-7577
+BLOCK, 0               /FROM THIS BLOCK ON SYSTEM DEVICE
+       JMP I [SYSERR
+       TAD DHI
+       AND [177        /GET RELATIVE ENTRY PT
+       TAD L7200
+       DCA ENTRY
+       TAD VNO
+       SZA CLA         /V3C
+       JMP I HREAD     /VNO ALREADY SET BY - COMMAND
+       TAD ENTRY
+VLOOP, DCA VNOPTR
+       TAD I VNOPTR
+       CLL
+       TAD [-33
+       SZL CLA
+       JMP BACKV
+       TAD I VNOPTR
+       SNA
+       JMP OLDERR
+       DCA VNO
+       JMP I HREAD
+BACKV, STA
+       TAD VNOPTR
+       JMP VLOOP
+
+RESERR,        JMS I [PRINT
+       TEXT    /? CAN'T - DEVICE IS RESIDENT/
+       JMP I [GOAWAY
+\fOLDERR,       CLA
+       JMS I [PRINT
+       TEXT    /? CAN'T - OBSOLETE HANDLER/
+       JMP I [GOAWAY
+
+HWRITE,        0
+       TAD BLOCK
+       DCA BLKTWO
+       JMS I [7607
+       4200
+       7200
+BLKTWO,        0
+       JMP I [SYSERR
+       JMP I HWRITE
+\fNEWERR,       CLA
+       JMS I [PRINT
+       TEXT    /? CAN'T - UNKNOWN VERSION OF THIS HANDLER/
+       JMP I [GOAWAY
+\fMAIN, -0;     DEVICE TTY;     TTYTBL
+       -1;     DEVICE PTR;     PTRTBL
+       -2;     DEVICE PTP;     PTPTBL
+       -3;     DEVICE CDR;     CDRTBL
+       -4;     DEVICE LPT;     LPTTBL
+       -20;    DEVICE MTA;     MTATBL
+       1
+       ZBLOCK 20
+/TABLE ENDS WITH A POSITIVE NON-ZERO NUMBER
+\fLPTTBL,       WIDTH;LPWDTH
+       LC;LPLC
+       LV8E;LPLV
+       LA8A;   LP8A
+       LA78;   LP78
+       ZBLOCK 4
+       0
+
+MTATBL,        PARITY;MTAPAR
+       DENSITY;MTADEN
+       FILES;MTAFIL
+       ZBLOCK 4
+       0
+\fAUX,  LOC;GENLOC
+       FILES;GENFIL
+       READO;GENREA
+       VERS;GENVER
+       DVCO;GENDVC     /V3D
+       BLK;GENBLK      /V3D
+       ZBLOCK 6
+       0
+\fWIDTH,        "W;"I;"D;"T;"H;0
+LC,    "L;"C;0
+LV8E,  "L;"V;4000+"8;4000+"E;0
+CODE,  "C;"O;"D;"E;0
+ALT,   "A;"L;"T;4000+"M;4000+"O;4000+"D;4000+"E;0
+ECHO,  "E;"C;"H;"O;0
+PAYGE, "P;"A;"G;"E;0
+TAB,   "T;"A;"B;0
+LOC,   "L;"O;"C;4000+"A;4000+"T;4000+"I;4000+"O;4000+"N;0
+FILES, "F;"I;"L;"E;4000+"S;0
+READO, "R;"E;"A;"D;4000+"O;4000+"N;4000+"L;4000+"Y;0
+VERS,  "V;"E;"R;4000+"S;4000+"I;4000+"O;4000+"N;0
+PARITY,        "P;"A;"R;4000+"I;4000+"T;4000+"Y;0
+DENSITY,"D;"E;"N;4000+"S;4000+"I;4000+"T;4000+"Y;0
+FILL,  "F;"I;"L;"L;0
+FLAGG, "F;"L;"A;"G;0
+CTRL,  "C;"T;"R;"L;0
+EVEN,  "E;4000+"V;4000+"E;4000+"N;0
+ODD,   "O;4000+"D;4000+"D;0
+DELAY, "D;"E;"L;"A;"Y;0
+GAG,   "G;"A;"G;0
+PAUS,  "P;"A;"U;"S;"E;0
+HGHT,  "H;"E;"I;"G;"H;"T;0
+SCOPP, "S;"C;"O;"P;"E;0
+SYSAUX,        INIT;   SYSINI
+       OS8;    SYSOS8
+       OS78;   SYS78
+       ZBLOCK 10
+       0
+DVCO,  "D;"V;"C;4000+"O;4000+"D;4000+"E;0
+COL,   "C;"O;"L;4000+"U;4000+"M;4000+"N;0
+LA8A,  "L;"A;"8;"A;0
+LA78,  "L;"A;"7;"8;0
+INIT,  "I;"N;"I;"T;0
+OS8,   "O;"S;"8;0
+OS78,  "O;"S;"7;"8;0
+       PAGE
+\fLPWDTH,       0
+       JMS I (GETWID
+       JMS LPTST1
+       TAD NUM
+       CMA
+       DCA I (7200
+       JMP I LPWDTH
+
+LPTST1,        0
+       TAD I (7201
+       SPA CLA
+       JMP L645
+       TAD VNO
+       JMS I [BRANCH
+       -1;OLDERR
+       -2;LPTOK
+       -3;LPTOK
+       ZBLOCK 4
+       0
+       JMP I [NEWERR
+LPTOK, JMP I LPTST1
+
+L645,  JMS I [PRINT
+       TEXT    /? CAN'T AFFECT ANNALEX LPT/
+       JMP I [GOAWAY
+\fASRTST,       0
+       TAD DHI
+       SPA CLA
+       JMP I ASRTST
+       JMS I [PRINT
+       TEXT    /? CAN'T - NOT KL8E HANDLER/
+       JMP I [GOAWAY
+\fGENVER,       0
+       TAD NO
+       SZA CLA
+       JMP I [SYNTAX
+       JMS I [ALPHA
+       JMP BADV
+       DCA NUM
+       TAD NUM
+       AND (40
+       SZA CLA
+       JMP BADV
+       TAD NUM
+       AND (37
+       DCA I VNOPTR
+       JMP I GENVER
+
+GENREA,        0
+       CDF 10
+       TAD I DCWPTR
+       CLL RTL
+       CLL RAL
+       TAD NO
+       RAR
+       CML RAR
+       RAR
+       DCA I DCWPTR
+       CDF 0
+       JMP I GENREA
+
+GENFIL,        0
+       CDF 10
+       TAD I DCWPTR
+       CLL RAL
+       CLL RAL         /ZERO LINK
+       TAD NO
+       RAR
+       CML RAR
+       DCA I DCWPTR
+       CDF 0
+       JMP I GENFIL
+\fBADV, CLA
+       JMS I [PRINT
+       TEXT    /? BAD VERSION LETTER/
+       JMP I [GOAWAY
+
+CRLF,  0
+       TAD [215
+       JMS I (TYPE
+       TAD [212
+       JMS I (TYPE
+       JMP I CRLF
+       PAGE
+\fLPLV, 0
+       JMS I (LPTST1
+       TAD NO
+       CLL RTL
+       RTL
+       TAD (4
+       DCA I (7201
+       JMP I LPLV
+
+LPLC,  0
+       JMS I (LPTST1
+       TAD NO
+       CLL RTL
+       RTL
+       RAL
+       CIA
+       DCA I (7202
+       JMP I LPLC
+
+TTECHO,        0
+       JMS I [TTST1
+       TAD NO
+       SZA CLA
+       TAD (SKP CLA-SZA
+       TAD (SZA
+       DCA I (7200+120
+       JMP I TTECHO
+\fTTPAGE,       0
+       JMS I (OLDTST
+       JMS I [SRCH     /V3D NEW ROUTINE
+       215;100;7450
+       JMP I [REASEM
+       TAD (3          /POINT TO 'SZA CLA'
+       DCA TEMP
+       TAD NO
+       SNA CLA
+       TAD (SZA CLA-CLA        /YES
+       TAD (CLA                /NO
+       DCA I TEMP
+       JMP I TTPAGE
+\fTTTAB,        0
+       JMS I [TTST1
+       JMS I [GETC
+       SNA
+       JMP TTEO
+       TAD (-"/
+       SNA CLA
+       JMS I [GETC
+       TAD (-"N
+       SZA CLA
+       JMP I [SYNTAX
+       JMP NOTEC
+TTEO,  TAD NO
+       SNA CLA
+       TAD (5000
+       TAD L200
+       JMS I (TECO
+NOTEC, JMS I [SRCH
+L200,  200;100;7
+       JMP I [REASEM
+       DCA TEMP
+       STA CLL RAL     /-2
+       TAD TEMP
+       DCA T2
+       TAD TEMP
+       TAD (3
+       DCA T3
+       TAD NO
+       SNA CLA
+       JMP SETAB
+       TAD TEMP
+       TAD (-4
+       DCA T4
+       TAD T4
+       AND (77
+       TAD (1200       /TAD TTY240
+       DCA I T2
+       TAD (SZA CLA
+       DCA I T3
+       JMP I TTTAB
+\fSETAB,        TAD TEMP
+       TAD (-12
+       DCA T4
+       TAD I T4
+       DCA I T2
+       TAD (SKP CLA
+       DCA I T3
+       JMP I TTTAB
+
+BADWID,        JMS I [PRINT
+       TEXT    /? ILLEGAL WIDTH/
+       JMP I [GOAWAY
+
+BLK,   "B;"L;"O;"C;"K;0
+       PAGE
+\fTTFILL,       0
+       JMS I [TTST1
+       JMS I [SRCH
+       200;100;1377
+       JMP I [REASEM
+       TAD (-1
+       DCA TEMP
+       TAD NO
+       CLL RAL
+       TAD (2
+       TAD TEMP
+       DCA T2
+       TAD I T2
+       DCA I TEMP
+       JMP I TTFILL
+
+REASEM,        JMS I [PRINT
+       TEXT    /? CAN'T - MUST REASSEMBLE KL8E SOURCE/
+       JMP I [GOAWAY
+
+TTDELAY,0
+       JMS I [TTST1
+       JMP I [NOTIMPL
+       JMP I TTDELAY
+\f/ENTER WITH PTR TO POSSIBLE KEYWORD IN AC
+
+KEYSRCH,0
+       DCA KPTR
+KL,    TAD I KPTR
+       ISZ KPTR
+       SNA
+       JMP GOTKEY
+       CIA
+       DCA TEMP
+       JMS I [ALPHA    /IS IT ALPHANUMERIC?
+       JMP EOK         /NO
+       TAD TEMP        /COMPARE
+       CLL RAL         /LOW ORDER 11 BITS
+       SNA CLA
+       JMP KL          /MATCHED, KEEP LOOKING
+       JMP I KEYSRCH   /DIDN'T MATCH
+EOK,   JMS I [BACKC
+       TAD TEMP
+       CIA             /INPUT STREAM RAN OUT OR HIT SPACE
+       SPA CLA
+       JMP GOTKEY      /SPACE OR EOL MATCH FLAGGED CHARACTER
+       JMP I KEYSRCH
+
+KPTR,  0
+
+GOTKEY,        JMS I [SCAN
+       STA             /SKIP EXTRA STUFF
+       JMS I [SPACE
+       ISZ KEYSRCH     /TAKE GOOD RETURN 2
+       JMP I KEYSRCH
+
+PTRTBL,        ZBLOCK 4
+       0
+
+PTPTBL,        ZBLOCK 4
+       0
+\fTTYTBL,       WIDTH;TTWIDTH
+       CODE;TTCODE
+       ALT;TTALT
+       ECHO;TTECHO
+       LC;TTLC
+       PAYGE;TTPAGE
+       TAB;TTTAB
+       FILL;TTFILL
+       FLAGG;TTFLAG
+       CTRL;TTCTRL
+       GAG;TTGAG
+       DELAY;TTDELAY
+       PAUS;TTPAUS     /V3D
+       HGHT;TTHGHT     /V3D
+       SCOPP;TTSCOP    /V3D
+       COL;TTCOL       /V3D
+       ESC;TTESC       /V3D
+       AROW;TTAROW     /V3D
+       ZBLOCK 10
+       0
+       PAGE
+\fTTFLAG,       0
+       JMS TTST1
+       JMS I [SRCH
+       200;200;247
+       JMP I [REASEM
+       TAD (-2
+       DCA TEMP
+       TAD NO
+       SNA CLA
+       TAD (SZA CLA-CLA
+       TAD (CLA
+       DCA I TEMP
+       JMP I TTFLAG
+
+TTLC,  0
+       JMS TTST1
+       JMS I [SRCH
+       200;200;377
+       JMP I [REASEM
+       TAD (5
+       DCA TEMP
+       TAD I TEMP
+       CLL
+       TAD [200
+       SNL CLA
+       JMP I [REASEM
+       TAD NO
+       SNA CLA
+       TAD [40         /SNA CLA
+       TAD (7610       /SKP CLA
+       DCA I TEMP
+       JMP I TTLC
+
+TTCTRL,        0
+       JMS TTST1
+       JMP I [NOTIMPL
+       JMP I TTCTRL
+\fTTWIDTH,0
+       JMS GETWID
+       JMS TTST1
+       TAD NUM
+       AND [7
+       SZA CLA
+       JMP I [BADWID
+       TAD NUM
+       TAD [-200
+       SNA CLA
+       JMP I [BADWID
+       JMS I [SRCH
+       200;200;7600
+       JMP I [REASEM
+       IAC
+       DCA TEMP
+       TAD I TEMP
+       AND [177
+       TAD (177+7200
+       DCA T2
+       TAD TEMP
+       IAC
+       DCA T3
+       TAD NUM
+       CIA
+       DCA I T3
+       TAD I T3
+       DCA I T2
+       JMP I TTWIDTH
+\fGETWID,       0
+       TAD NO
+       SZA CLA
+       JMP I [SYNTAX
+       JMS OPTEQ
+       JMS I [NUMBER
+       SNA
+       JMP I (BADWID
+       DCA NUM
+       TAD FLG
+       SZA CLA
+       JMP I [SYNTAX   /NO DIGITS
+       TAD NUM
+       AND [7400
+       SZA CLA
+       JMP I [NUMBIG
+       JMP I GETWID
+
+TTST1, 0
+       JMS I (ASRTST
+       TAD VNO
+       JMS I [BRANCH
+       -1;OLDERR
+       -2;OLDERR
+       -3;TTOK
+       -4;TTOK         /V3C
+       -5;TTOK         /V3D
+       ZBLOCK 4
+       0
+       JMP I [NEWERR
+TTOK,  JMP I TTST1
+\fOPTEQ,        0
+       JMS I [GETC
+       TAD (-"=
+       SZA CLA
+       JMP I OPTEQ
+       STA             /V3D
+       JMS I [SPACE
+       JMP I OPTEQ
+       PAGE
+\fOPRIN,        0
+       DCA N3
+       TAD (-4
+       DCA OKNT
+OPLP,  TAD N3
+       JMS DGP
+       TAD N3
+       RTL
+       RAL
+       DCA N3
+       ISZ OKNT
+       JMP OPLP
+       JMP I OPRIN
+
+DGP,   0
+       RTL
+       RTL
+       AND [7
+       TAD [60
+       JMS I [TYPE
+       JMP I DGP
+
+OKNT,  0
+N3,    0
+GTEM,  0
+\fSRCH, 0
+       TAD I SRCH
+       ISZ SRCH
+       TAD (7200-1
+       DCA XR1
+       TAD I SRCH
+       ISZ SRCH
+       CIA
+       DCA CNT
+       TAD I SRCH
+       CIA
+       DCA TEMP
+       ISZ SRCH
+SRLUP, TAD I XR1
+       TAD TEMP
+       SNA CLA
+       JMP SRFND
+       ISZ CNT
+       JMP SRLUP
+       JMP I SRCH
+SRFND, ISZ SRCH
+       TAD XR1
+       JMP I SRCH
+\fGENCMN,       0
+       TAD NO
+       SZA CLA
+       JMP I [SYNTAX
+       JMS I [ONUM
+       DCA NUM2
+       TAD FLG
+       SZA CLA
+       JMP I [SYNTAX
+       JMS I [GETC
+       DCA TEMP
+       TAD TEMP
+       SNA
+       JMP I GENCMN
+       TAD (-"=
+       SZA
+       TAD ("=-",
+       SZA CLA
+       JMP I [SYNTAX
+       JMP I GENCMN
+\fGENLOC,       0
+       JMS GENCMN
+       TAD DHI
+       SPA CLA
+       TAD [-200
+       TAD [-200
+       CLL
+       TAD NUM2
+       SZL CLA
+       JMP I [NUMBIG
+       TAD NUM2
+       TAD (7200       /BASE OF HANDLER
+       DCA NUM2
+       TAD TEMP
+       SNA CLA
+       JMS ODT
+GETNEW,        JMS I [ONUM
+       DCA NUM
+       TAD FLG
+       SZA CLA
+       JMP I GENLOC
+       JMS I [GETC
+       SZA CLA
+       JMP I [SYNTAX
+       TAD NUM
+       DCA I NUM2
+       JMP I GENLOC
+\fODT,  0
+       TAD I NUM2
+       JMS OPRIN
+       TAD ("/
+       JMS I [TYPE
+       TAD I [READ
+       DCA GTEM        /SAVE CHAIN STATUS
+       JMS I [READ
+       TAD [LINBUF
+       DCA LINPTR
+       TAD GTEM
+       DCA I [READ
+       JMP I ODT
+
+OLDBAS,        JMS I [PRINT
+       TEXT    /? OLD BASIC/
+       JMP I [GOAWAY
+       PAGE
+\fMTAPAR,       0
+       TAD NO
+       SZA CLA
+       JMP I [SYNTAX
+       JMS MTST1
+       TAD LINPTR
+       DCA SAVPTR
+       TAD (EVEN
+       JMS I [KEYSRCH
+       SKP
+       JMP SETE
+       TAD SAVPTR
+       DCA LINPTR
+       TAD (ODD
+       JMS I [KEYSRCH
+       JMP I [SYNTAX
+       TAD (400
+SETE,  TAD (2
+       DCA I (7200
+       JMP I MTAPAR
+
+MTST1, 0
+       TAD VNO
+       JMS I [BRANCH
+       -1;OLDERR
+       -2;OLDERR
+       -3;OLDERR
+       -4;MTOK
+       -5;MTOK
+       -6;MTOK
+       ZBLOCK 4
+       0
+       JMP I [NEWERR
+MTOK,  JMP I MTST1
+
+MTADEN,        0
+       JMS MTST1
+       TAD NO
+       SZA CLA
+       JMP I [SYNTAX
+       JMP I [NOTIMP
+       JMP I MTADEN
+\fMTAFIL,       0
+       JMS MTST1
+       TAD NO
+       CIA             /V3D
+       IAC             /V3D
+       DCA I (7201
+       JMP I MTAFIL
+
+BADCOD,        JMS I [PRINT
+       TEXT    /? UNKNOWN CARD CODE/
+       JMP I [GOAWAY
+
+/SUPPOSED TO WORK ON ALL VERSIONS
+
+CDCODE,        0
+       TAD NO
+       SZA CLA
+       JMP I [SYNTAX
+       JMS I (OPTEQ
+       JMS I [NUMBER
+       TAD (-32        /026
+       SNA
+       JMP C026
+       TAD (32-35      /029
+       SZA CLA
+       JMP BADCOD
+       JMS CHANGE
+       LIST1;LIST2
+       JMP I CDCODE
+C026,  JMS CHANGE
+       LIST1;LIST3
+       JMP I CDCODE
+\fCHANGE,       0
+       TAD I CHANGE
+       DCA P1
+       ISZ CHANGE
+       TAD I CHANGE
+       DCA P2
+       ISZ CHANGE
+CHLUP, TAD I P1
+       SNA
+       JMP I CHANGE
+       TAD (7200       /BASE OF HANDLER
+       DCA P3
+       TAD I P2
+       DCA I P3
+       ISZ P1
+       ISZ P2
+       JMP CHLUP
+
+P1,    0
+P2,    0
+P3,    0
+\fGET,  0
+       KSF
+       JMP .-1
+       KRB
+       AND [177
+       TAD [200        /FORCE TO 8-BIT
+       JMP I GET
+       PAGE
+\f/FIXED FOR V3D:
+LIST1, 104;105;106
+       114;115;116
+       124;125;126;127
+       134;135;136
+       0
+
+LIST2, 3203;4007;3502
+       7514;0577;3637
+       0104;1211;3374;0641
+       7316;3410;1376
+
+LIST3, 7735;4076;0774
+       3314;1002;0305
+       3204;1273;3606;1341
+       3716;1175;3401
+\fTECNAM,       FILENAME TECO.SV
+
+TECO,  0
+       DCA SA
+       TAD (TECNAM
+       JMS LOOKUP
+       JMP I TECO      /NOT THERE
+       DCA BLKN
+       JMS I (7607
+       100             /READ 1 PAGE FROM TECO
+       7000            /BUFFER
+BLKN,  0
+       JMP I [SYSERR
+       TAD BLKN
+       DCA BLKN2
+       TAD SA
+       DCA I (7002     /REL LOC 2 IS S.A.
+       JMS I (7607
+       4100
+       7000
+BLKN2, 0
+       JMP I [SYSERR
+       JMP I TECO
+
+SA,    0
+\fLOOKUP,       0
+       DCA ARG1        /PTR TO FILENAME IN AC
+       CLA IAC         /LOOKUP ON SYS
+       CIF 10
+       JMS I USR
+       2
+ARG1,  0               /STARTING BLOCK
+       0
+       JMP I LOOKUP    /NOT FOUND
+       TAD ARG1
+       ISZ LOOKUP
+       JMP I LOOKUP    /RETURN 2 WITH BLOCK # IN AC
+\fGENDVC,       0
+       TAD NO
+       SZA CLA
+       JMP I [SYNTAX
+       JMS I [ONUM
+       SNA
+       JMP I [SYNTAX
+       DCA NUCODE
+       TAD NUCODE
+       AND [7700
+       SZA CLA
+       JMP I (NUMBIG
+       TAD NUCODE
+       TAD (-30
+       SPA CLA
+       JMP I [NUMBIG
+       TAD NUCODE
+       CLL RTL
+       RAL
+       DCA NUCODE
+       TAD (7200
+       DCA RR
+DVLUP, JMS I (GETIOT
+       JMP I GENDVC
+       TAD (-30
+       SPA CLA
+       JMP DVLUP
+       TAD I RR
+       AND (7007
+       TAD NUCODE
+       DCA I RR
+       JMP DVLUP
+\fCDRTBL,       CODE;CDCODE
+       ZBLOCK 4
+       0
+       PAGE
+
+/7000-7177 BUFFER FOR TECO CCB
+/7200-7577 BUFFER FOR HANDLER
+\f      FIELD 0
+       *200
+       $
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape6/BOOT.PA b/sw/os8/v3d/sources/system/dectapes/dectape6/BOOT.PA
new file mode 100644 (file)
index 0000000..5ab0aac
--- /dev/null
@@ -0,0 +1,751 @@
+/16    BOOT    -       OS/8 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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f      /SR
+
+/FIXES MADE FOR MAINTENANCE RELEASE:
+
+/1.    ADDED RX01 (FLOPPY BOOTSTRAP)
+/2.    LEFT PATCH SPACE IN NAME TABLE
+
+       PTR=14
+       OLDLOC=15
+       NEWLOC=16
+       CDOIO=27
+       SCAN=17
+
+       *1
+       HLT
+       JMP I (7600
+       *100
+
+INNER, 0
+OUTR,  -20
+CODE,  0
+LENGTH,        0
+\f      *200
+
+START, CLA             /ALLOW BEING CHAINED TO
+       TAD I (7600
+       SPA CLA
+       JMP OS8IN
+       ISZ INNER
+       JMP .-1
+       ISZ OUTR
+       JMP .-3
+       JMS I (TESTRK
+COSIN, TAD I (7776
+COMN,  CIA
+       DCA CODE
+       TAD (TABLE-1
+       DCA PTR
+LOOP,  TAD I PTR
+       SNA
+       JMP OS8
+       TAD CODE
+       SZA CLA
+       JMP NXT
+       IOF
+       STA
+       TAD I PTR
+       DCA OLDLOC
+       STA
+       TAD I PTR
+       DCA NEWLOC
+       TAD I PTR
+       CIA
+       DCA LENGTH
+       TAD I OLDLOC
+       DCA I NEWLOC
+       ISZ LENGTH
+       JMP .-3
+       TAD I PTR
+       DCA TEMP
+       TAD HLTSWT
+       SNA CLA
+       HLT
+       CLL
+       JMP I TEMP
+HLTSWT,        1
+
+NXT,   TAD PTR
+       TAD (4
+       DCA PTR
+       JMP LOOP
+\fOS8,  TAD ("N
+       JMS I (PUT
+       TAD ("O
+       JMS I (PUT
+       CLA IAC
+       DCA HLTSWT
+RETRY, JMS I (CRLF
+       TAD ("/
+       JMS I (PUT
+       JMS I (GET
+       SKP
+       JMP RETRY
+       CLL RTL
+       RTL
+       RTL
+       DCA TEMP
+       JMS I (GET
+       SKP
+       JMP RETRY
+       TAD TEMP
+       DCA TEMP
+       JMS I (GET
+       JMP .-1
+       CLA
+       JMS I (CRLF
+       TAD TEMP
+       JMP COMN
+\fOS8IN,        TAD I (7600
+       TAD (-4207
+       SZA CLA
+       JMP RETRY
+       TAD I (1000
+       TAD (777
+       SNA CLA
+       TAD (600
+       TAD (1000-1
+       DCA SCAN
+SKAN,  TAD I SCAN
+       SNA
+       JMP RETRY
+       AND (177
+       TAD (-"/!7600
+       SZA CLA
+       JMP SKAN
+       TAD I SCAN
+       AND (77
+       CLL RTL
+       RTL
+       RTL
+       DCA TEMP
+       TAD I SCAN
+       AND (77
+       TAD TEMP
+       DCA TEMP
+       TAD I SCAN
+       AND (177
+       TAD (-".!7600
+       DCA HLTSWT
+       TAD TEMP
+       JMP COMN
+
+TEMP,  0
+       PAGE
+\fTABLE,        2403    /TC
+       DECTAP
+       7554
+       25
+       7554
+
+       2213    /RK
+RKADR, RK8
+       21
+       11
+       21
+
+       2404    /TD
+       TD8E
+       7277
+       34
+       7277
+
+       1424    /LT
+       LINCTP
+       4400
+       7
+       4400
+
+       2206    /RF
+       RF08
+       7746
+       7
+       7746
+
+       2024    /PT
+       BINLDR
+       7626
+       152
+       7700
+
+       3205    /ZE
+       ZERO
+       4
+       6
+       4
+
+       2431    /TY
+       TYPSET
+       7730
+       42
+       7730
+
+       0414    /DL
+       DIAL
+       4012
+       6
+       4012
+
+       0301    /CA
+       CAS
+       4000
+       40
+       4000
+
+       0415    /DM
+       DSKMON
+       171
+       16
+       174
+
+       2605    /VE
+       VERS
+       VERS
+       1
+       VERS
+
+       0424    /DT
+       TAPE
+       TAPE
+       1
+       TAPE
+
+       0413    /DK
+       DISK
+       DISK
+       1
+       DISK
+
+       2205    /RE
+       RK8E
+       21
+       11
+       21
+
+       2523    /US
+       1
+       1
+       1
+       RETRY
+
+       2230    /RX
+       RX01
+       RX8E
+       36
+       RXSTRT
+
+       ZBLOCK 4^5      /PATCH SPACE
+
+       0
+
+/FORMAT:
+
+/SIXBIT OF 2-CHARACTER NAME
+/ADDRESS OF BOOTSTRAP CODE IN BOOT
+/ADDRESS WHERE BOOTSTRAP CODE IS TO BE MOVED TO
+/LENGTH OF BOOTSTRAP IN WORDS
+/STARTING ADDRESS OF BOOTSTRAP
+\fDECTAP,       7600
+       6774
+       1374
+       6766
+       6771
+       5360
+       7240
+       1354
+       3773
+       1354
+       3772
+       1375
+       6766
+       5376
+       7754
+       7755
+       0600
+       0220
+       6771
+       5376
+\fRK8,  6732
+       6751
+       6745
+       5023
+       6742
+       6753
+       6755
+       6733
+       5031
+
+RK8E,  7000
+       7000
+       7000
+       7000
+       7201
+       6742
+       6742
+       6743
+       5031
+\fTD8E, 6007
+       1312
+       4312
+       4312
+       6773
+       5303
+       6777
+       3726
+       2326
+       5303
+       5732
+       2000
+       1300
+       6774
+       6771
+       5315
+       6776
+       0331
+       1327
+       7640
+       5315
+       2321
+       5712
+       7354
+       7756
+       7747
+       0077
+       7400
+\fLINCTP,       6141
+       1020
+       0020
+       0004
+       0700
+       0000
+       6020
+\fRF08, 6643
+       6615
+       7600
+       6603
+       6622
+       5352
+       5752
+\f/     1000 IS OS/8 LINE BUUFFER
+/      1600 IS PS/8 LINE BUFFERE
+
+       *2000
+
+BINLDR,        0000
+       3212
+       4260
+       1300
+       7750
+       5237
+       2212
+       7040
+       5227
+       1212
+       7640
+       5230
+       1214
+       0274
+       1341
+       7510
+       2226
+       7750
+       5626
+       1214
+       0256
+       1257
+       3213
+       5230
+       0070
+       6201
+       0000
+       0000
+       6031
+       5262
+       6036
+       3214
+       1214
+       5660
+       6011
+       5270
+       6016
+       5265
+       0300
+       4343
+       7041
+       1215
+       7402
+       6032
+       6014
+       6214
+       1257
+       3213
+       7604
+       7700
+       1353
+       1352
+       3261
+       4226
+       5313
+       3215
+       1213
+       3336
+       1214
+       3376
+       4260
+       3355
+       4226
+       5275
+       4343
+       7420
+       5336
+       3216
+       1376
+       1355
+       1215
+       5315
+       0000
+       3616
+       2216
+       7600
+       5332
+       0000
+       1376
+       7106
+       7006
+       7006
+       1355
+       5743
+       5262
+       0006
+       0000
+       0000
+       6014
+       6011
+       5357
+       6016
+       7106
+       7006
+       7510
+       5374
+       7006
+       6011
+       5367
+       6016
+       7420
+       3776
+       3376
+       5357
+       0000
+       5301
+\fZERO, 1005
+       3410
+       5004
+       5404
+       0011
+       2010
+\fDIAL, 6141
+       1020
+       0020
+       0004
+       0701
+       7300
+\f/     7300
+/      6002
+/      6042
+/      6022
+/      6012
+/      6032
+/      6601
+/      6764
+/      1221
+/      3010
+/      1622
+/      2222
+/      7450
+/      5620
+/      3410
+/      5212
+/      7730
+/      7727
+/      0223
+TYPSET,        6774
+       1347
+       4341
+       7240
+       1353
+       3355
+       1352
+       4341
+       5753
+       7777
+       6766
+       3354
+       6771
+       5344
+       5741
+       4600
+       7777
+       7777
+       4220
+       7400
+       7777
+       7777
+       7777
+       6014
+       6011
+       5360
+       7106
+       6012
+       7420
+       5357
+       5756
+       4356
+       3373
+       4356
+\fPTCLEV,       "A
+L3,    "4
+LV,    "V
+VERS,  TAD LV
+       JMS I (PUT
+       TAD L3
+       JMS I (PUT
+       TAD PTCLEV
+       JMS I (PUT
+       JMP I PRETRY
+PRETRY,        RETRY
+\fDSKMON,       7577
+       7750
+       7751
+       1171
+       3572
+       1172
+       3573
+       6643
+       6615
+       6603
+       6602
+       5203
+       5606
+       7600
+\fCAS,  1237
+       1206
+       6704
+       6706
+       6703
+       5204
+       7264
+       6702
+       7610
+       3211
+       3636
+       1205
+       6704
+       6706
+       6701
+       5216
+       7002
+       7430
+       1636
+       7022
+       3636
+       7420
+       2236
+       2235
+       5215
+       7346
+       7002
+       3235
+       5201
+       7737
+       3557
+       7730
+\f      LCD=6751
+       SDN=6755
+       SER=6754
+       STR=6753
+       XDR=6752
+
+RX01,  RELOC 24
+
+RX8E,  STL RTL
+       TAD     UNIT    /GET A READ COMMAND ON THE PROPER
+       LCD             /UNIT AND LOAD IT INTO THE COMMAND REGISTER
+       CLA IAC
+       JMS     LOAD    /READ SECTOR ONE
+       JMS     LOAD    /OF TRACK ONE.
+       CLL RAL         /SET AC = 2 AS FLAG SAYING WE READ TRACK 1
+
+RXSTRT,                        /** BOOTSTRAP START ADDR **
+HANGGG,        SDN             /DO A FIGURE-8 SKIP -
+       JMP     LOAD+1  /ONLY THE DONE FLAG WILL COME UP
+       SER             /ANY ERRORS?
+       SNA             /OR IS THIS THE INITIAL DUMMY WAIT?
+       SKP CLA         /IF EITHER ONE, TRY OTHER DRIVE
+       JMP     GOODRD  /IF ALL IS WELL, GO READ THE SECTOR BUFFER
+       TAD     UNIT    /COME HERE ON READ ERRORS -
+       CIA             /FLIP THE UNIT NUMBER
+       TAD     X6030   /IN "UNIT"
+       DCA     UNIT
+       JMP     RX8E
+GOODRD,        LCD             /LOAD THE EMPTY SECTOR BUFFER COMMAND ( A CONVENIENT 2)
+LP,    JMS     LOAD    /GET A WORD FROM THE SECTOR BUFFER
+       DCA     2       /SECONDARY BOOT LOADS INTO LOCATIONS 2-51
+       ISZ     .-1     /BUMP STORE ADDRESS
+       JMP     LP
+
+LOAD,  0
+       STR             /DO A FIGURE-8 LOOP WAITING FOR THE TRANSFER
+       JMP     HANGGG  /OR DONE FLAGS TO COME UP.
+       XDR             /TRANSFER FLAG CAME UP - TRANSFER A WORD
+       JMP I   LOAD
+
+UNIT,  7024            /7004 = DRIVE 0,   7024 = DRIVE 1
+X6030, 6030            /CONSTANT NEEDED TO FLIP UNIT - 7004+7024.
+
+       RELOC
+       PAGE
+\fL2213,        2213
+       DIML=6615
+DISK,  CLA IAC
+       DIML
+       SNA CLA
+       JMP GOTRF
+       TAD (70
+       6732
+       SNA CLA
+       JMP GOTRK8
+       CLA IAC
+       6744
+       SZA CLA
+       JMP I PRETR
+       STA             /RE
+GOTRF, TAD L2206       /RF
+       JMP I PCOMN
+L2206, 2206
+GOTRK8,        TAD L2213       /RK
+       JMP I PCOMN
+PRETR, RETRY
+\fTAPE, 6141            /LINC
+       17              /COMPL AC
+       2               /PDP
+       IAC
+       SNA CLA
+       JMP GOTLTA
+       TAD (70
+       6774
+       CLA
+       6772
+       NOP
+       TAD M70
+       SNA CLA
+       JMP GOTTC
+       STL CLA RAR
+       6774
+       CLA
+       6776
+       SMA CLA
+       JMP I PRETR
+GOTTD, CLA IAC
+GOTTC, TAD L2403       /TC
+       JMP I PCOMN
+GOTLTA,        TAD L1424       /LT
+       JMP I PCOMN
+L1424, 1424
+L2403, 2403
+PCOMN, COMN
+M70,   -70
+/      0000
+\fCRLF, 0
+       TAD L215
+       JMS PUT
+       TAD L212
+       JMS PUT
+       JMP I CRLF
+
+L215,  215
+L212,  212
+
+PUT,   0
+       TLS
+       TSF
+       JMP .-1
+       CLA
+       JMP I PUT
+
+GET,   0
+       KSF
+       JMP .-1
+       KRB
+       AND (177
+       TLS
+       TSF
+       JMP .-1
+       TAD (-003
+       SNA
+       JMP I (7605
+       TAD (003-177
+       SNA
+       JMP I (RETRY
+       TAD (177-015
+       SNA
+       ISZ GET
+       TAD (015
+       AND (77
+       JMP I GET
+
+TESTRK,        0
+       TAD (70
+       6732
+       SNA CLA
+       JMP I TESTRK
+RK05,  TAD (RK8E
+       DCA I (RKADR
+       JMP I TESTRK
+
+       FIELD 0
+       *200
+       $
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape6/CAMP.PA b/sw/os8/v3d/sources/system/dectapes/dectape6/CAMP.PA
new file mode 100644 (file)
index 0000000..836d2ce
--- /dev/null
@@ -0,0 +1,2080 @@
+/11 OS8 CAMP
+
+/
+/S.R.
+/
+/
+/CASSETTE & MAGTAPE POSITIONER         (CAMP)
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE VITHOUT NOTICE
+/AND SHOULD NOT BE CONTRUED 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.
+/
+/
+/      COPYRIGHT (C) 1973,1975,1977 BY DIGITAL EQUIPMENT CORPORATION.
+/
+/
+/
+/
+\f
+/      MUST SKIP LOCS 1000-1377
+
+       LINBUF=1000
+
+       XR1=11
+       XR2=12
+       XR3=13
+
+       *20
+
+TEMP,  0
+T,     0
+T2,    0
+LINPTR,        0
+T3,    0
+FLAG,  0
+SPKNT, 0
+DEVTYP,        0               /DEVICE TYPE (BITS 6-11)
+ENTRY, 0               /HANDLER ENTRY POINT
+NUM,   0
+TYP,   0               /0 MEANS 'F', 1 MEANS 'R'
+T4,    0
+DEVNUM,        0
+DCW,   0               /DEVICE CONTROL WORD
+DCWPTR,        0
+USR,   200             /POINTS TO USR ENTRY POINT
+ESCBIT,        0               /1 MEANS USER TYPED ALTMODE
+CNT,   0
+CTOFLG,        0               /-1 MEANS SAW ^O
+COUNT, 0
+PTR,   0
+DHIT,  0               /DEVICE HANDLER INFO TABLE - 1
+DHI,   0               /DEVICE HANDLER INFO
+DBLK,  0               /DEVICE HANDLER BLOCK
+VNOPTR,        0               /PTS TO VERSION # IN HANDLER
+VNO,   0               /CURRENT HANDLER VERSION NUMBER
+SAVPTR,        0
+NO,    0               /1 MEANS 'NO'
+FLG,   1               /1 MEANS SAW NO DIGITS
+P,     0
+RR,    0
+NUCODE,        0
+
+/      MAGTAPE SPECIAL CODES
+
+       REWKOD=1
+       SKFKOD=3        /SKIP FORWARD FILE
+       UNLKOD=4
+       EOFKOD=5
+       SKPKOD=2        /FORWARD RECORD
+       BAKKOD=SKPKOD+4000
+       BKFKOD=SKFKOD+4000
+
+       DTLA=6766
+
+/0000-0777     /CAMP
+/1000-1377     /OS/8 LINE BUFFER
+/1400-1777     /PS/8 LINE BUFFER
+/2000-         /CAMP
+/7000-7177     /I/O BUFFER
+/7200-7577     /OS/8 HANDLER
+/7600-7777     /OS/8
+
+       DLDC=6746
+       DLAG=6743
+       PAGE
+\f      *200
+
+START, SKP
+       JMP CHN
+       TAD ("#
+       JMS I [TYPE
+       JMS I [READ     /READ A LINE INTO OS/8 LINE BUFFER
+CHN,   TAD [LINBUF     /CHAIN ENTRY ADDRESS
+       DCA LINPTR      /INITIALIZE POINTER TO LINE BUFFER
+       STA
+       JMS I [SPACE    /IGNORE LEADING SPACES
+       JMS GETTWO      /GET TWO CHARS
+       DCA TEMP
+       JMS I [SCAN     /SCAN PAST EXTRA LETTERS OR DIGITS
+       TAD TEMP
+       JMS I [BRANCH   /GO TO APPROPRIATE ROUTINE
+       -2313;SKIP      /SK
+       -0517;EOF       /EO
+       -0201;BACK      /BA
+       -2205;REWIND    /RE
+       -2516;UNLOAD    /UN
+       -2605;VERSION   /VE
+       -1005;HELP      /HE
+       -2664;V4        /V4
+       -2305;SYNTAX    /SE
+       SETLOC=.-1
+       0
+       SNA CLA
+       JMP I [GOAWAY
+       JMP I [SYNTAX   /NONE OF THESE
+
+/V1 FEATURES:
+/FIXES SINCE FIELD TEST RELEASE:
+
+/1.    ADDED CASSETTE SUPPORT
+/2.    FIXED BUG RE IMMEDIATE ALTMOD
+/3.    CHANGED SPECIAL CODES TO AGREE WITH NEW MAGTAPE HANDLER
+/4.    IGNORE NULLS ON INPUT
+/5.    ALLOW UNLOADING AN RK8E
+
+/CHANGES MADE TO V3:
+
+/1.    SET COMMAND IMPLEMENTED
+
+/MAINTENANCE RELEASE CHANGES:
+
+/1.    TOOK OUT 'SET' SINCE WE DON'T WANT TO SUPPORT IT 
+/      UNTIL OS/8 V4
+/2.    FIXED BUG RE AT EOF AND BOF MESSAGES
+/3.    CHANGED CAMP TO USE NEW TM8E HANDLER
+/      NOTE: CAMP WILL NOT WORK PROPERLY WITH
+/      TM8E HANDLERS PRIOR TO VERSION F
+/4.    PROPERLY FIND EOT EVEN IF WE'RE JUST
+/      BEFORE A FILE MARK.
+/5.    GIVE AT BOT OR EOT MESSAGE IF SEE REFLECTIVE SPOT
+/6.    CHANGED VERSION NUMBER TO V4
+/7.    ENSURE THAT USER CAN'T PASS OVER EOD
+
+/V3D CHANGES:
+
+/1.    FIXED BUG WITH UNLOADING RKS
+\f/     GETTWO
+
+/GET TWO LETTERS OR DIGITS FROM INPUT LINE, PACK IN SIXBIT
+/ADVANCE PAST THEM. SUBSTITUTE NULL IF NOT FOUND.
+
+GETTWO,        0
+       JMS GETSIX
+       CLL RTL
+       RTL
+       RTL
+       DCA T2
+       JMS GETSIX
+       TAD T2          /COMBINE
+       JMP I GETTWO
+
+GETSIX,        0               /GET A SIXBIT LETTER OR DIGIT (OR NULL)
+       JMS ALPHA       /IS IT ALPHANUMERIC?
+       JMP NOTALPH     /NO
+       AND [77         /YES
+       JMP I GETSIX    /TRUNCATE TO SIXBIT
+NOTALPH,CLA
+       JMS BACKC
+       JMP I GETSIX    /RETURN NULL
+
+GETC,  0               /GET A CHARACTER, ADVANCE POINTER
+       TAD I LINPTR
+       AND [177        /ALWAYS RETURN 8-BIT
+       SZA
+       TAD [200        /WITH HIGH ORDER BIT ON
+       ISZ LINPTR      /ADVANCE SCAN
+       JMP I GETC      /RETURN
+
+BACKC, 0               /MOVE SCAN POINTER BACK ONE
+       STA
+       TAD LINPTR
+       DCA LINPTR
+       JMP I BACKC     /RETURN
+\f/RETURN 1     NOT OF TYPE DESIRED
+/RETURN 2      DESIRED TYPE
+/IN BOTH CASES, CHAR IS LEFT IN AC
+
+ALPHA, 0               /LOOK FOR ALPHANUMERIC
+       JMS I [GETC
+       JMS LETTER      /IS IT A LETTER?
+       JMP TRYDIG      /NO, TRY DIGIT
+       JMP GOTAL       /YES
+TRYDIG,        JMS DIGIT       /IS IT A DIGIT?
+       JMP I ALPHA     /NO, AINT LETTER OR DIGIT
+GOTAL, ISZ ALPHA       /YES, EITHER LETTER OR DIGIT
+       JMP I ALPHA     /RETURN WITH IT IN AC
+
+LETTER,        0               /LOOK FOR LETTER
+       TAD (-"A
+       CLL
+       TAD ("A-"Z-1
+       SNL
+       ISZ LETTER
+       TAD ("Z+1       /RESTORE CHAR
+       JMP I LETTER
+
+DIGIT, 0               /LOOK FOR DIGIT
+       TAD (-"0
+       CLL
+       TAD ("0-"9-1    /(DECIMAL)
+       SNL
+       ISZ DIGIT
+       TAD ("9+1       /RESTORE DIGIT TO CHARACTER FORM
+       JMP I DIGIT     /AND RETURN WITH IT IN AC
+       PAGE
+\fSYNTAX,       CLA
+       JMS PRINT
+       TEXT    /? SYNTAX ERROR/
+GOAWAY,        TAD ESCBIT
+       SZA CLA
+       JMP I [7605     /LINE ENDED WITH ESCAPE
+       TAD I [READ     /WAS 'READ' EVER CALLED?
+       SZA CLA
+       JMP I [START    /YES, GET A NEW LINE
+       JMP I [7605     /NO, WE MUST'VE BEEN CHAINED TO, RECALL KBM
+
+PRINT, 0
+       TAD I PRINT
+       RTR
+       RTR
+       RTR
+       JMS PRIN
+       TAD I PRINT
+       JMS PRIN
+       ISZ PRINT
+       JMP PRINT+1
+LV,    JMS I [CRLF
+       ISZ PRINT
+       JMP I PRINT
+
+PRIN,  0
+       AND [77
+       SNA
+       JMP LV
+       TAD [240
+       AND [77
+       TAD [240
+       DCA T3
+       TAD [200
+       KRS
+       TAD (-203
+       SNA
+       JMP CTRLC
+       TAD (203-217    /^O
+       SNA CLA
+       JMS CTRLO
+       TAD T3
+       JMS I [TYPE
+       JMP I PRIN
+\fCTRLC,        TAD ["^
+       JMS I [TYPE
+       TAD ("C
+       JMS I [TYPE     /ECHO "^C"
+       JMS I [DELAYY
+       JMP I [7600     /THEN GO AWAY
+CTRLO, 0
+       KCC             /CLEAR OUT ^O
+       TAD ["^
+       JMS I [TYPE
+       TAD ("O
+       JMS I [TYPE
+       JMS I [CRLF
+       STA
+       DCA CTOFLG      /STOP ECHOING
+       JMP I CTRLO
+
+VERSION,JMS PRINT
+       TEXT    \OS/8 CAMP V5A\
+       JMP I [START
+NUMBIG,        JMS PRINT
+       TEXT    /? NUMBER TOO BIG/
+       JMP I [GOAWAY
+\fNONEX,        JMS PRINT
+       TEXT    /? CAN'T - DEVICE DOESN'T EXIST/
+       JMP I [GOAWAY
+
+SYSERR,        JMS PRINT
+       TEXT    \? I/O ERROR ON SYS:\
+       JMP I [GOAWAY
+       PAGE
+\fHELP, JMS I [PRINT
+       TEXT    /BACKSPACE DEV: N FILES/
+       JMS I [PRINT
+       TEXT    /BACKSPACE DEV: N RECORDS/
+       JMS I [PRINT
+       TEXT    /EOF DEV:/
+H2,    JMP H1  /       JMS I [PRINT
+       TEXT    /SET DEV: [NO] ATTRIB [N]/
+H1,    JMS I [PRINT
+       TEXT    /SKIP DEV: N FILES/
+       JMS I [PRINT
+       TEXT    /SKIP DEV: N RECORDS/
+       JMS I [PRINT
+       TEXT    /SKIP DEV: EOD/
+\f      JMS I [PRINT
+       TEXT    /REWIND DEV:/
+       JMS I [PRINT
+       TEXT    /UNLOAD DEV:/
+       JMS I [PRINT
+       TEXT    /VERSION/
+       JMS I [PRINT
+       TEXT    /HELP/
+       JMP I [START
+\fBADEV,        CLA
+       JMS I [PRINT
+       TEXT    /? CAN'T FOR THIS DEVICE/
+       JMP I [GOAWAY
+
+V4,    TAD (SET
+       DCA I (SETLOC
+       TAD H1
+       DCA H2
+       JMP I [START
+       PAGE
+\f      *2000
+
+/ORIGIN PAST OS/8 LINE BUFFER AT 1000.
+/SKIP PAST PS/8 LINE BUFFER (AT 1400) JUST IN CASE
+/PS/8 USERS WISH TO PATCH THIS PROGRAM
+
+/SCAN PAST EXTRA LETTERS OR DIGITS
+
+SCAN,  0
+       JMS I [ALPHA
+       JMP NOPE
+       CLA
+       JMP SCAN+1
+NOPE,  CLA
+       JMS I [BACKC
+       JMP I SCAN
+
+/SCAN PAST SPACES; GIVE ERROR IF NO SPACES FOUND UNLESS AC=-1
+
+SPACE, 0
+       DCA FLAG        /SET AC=-1 TO PREVENT ERROR ON NO SPACES FOUND
+       DCA SPKNT       /INITIALIZE SPACE COUNTER
+       SKP             /JUMP INTO LOOP
+GOTSP, ISZ SPKNT
+       JMS I [GETC     /GET NEXT CHAR
+       TAD (-240
+       SNA CLA         /IS IT A SPACE?
+       JMP GOTSP       /YES, COUNT IT
+       JMS I [BACKC    /NO, PUT IT BACK
+       ISZ FLAG        /CHECK FLAG
+       SKP             /USER DIDN'T SPECIFY FLAG
+       JMP I SPACE     /-0 MEANT DON'T CHECK IF FOUND SPACE
+       TAD SPKNT       /HOW MANY SPACES DID WE FIND?
+       SZA CLA
+       JMP I SPACE     /SOME.  OK
+       JMP I [SYNTAX   /NONE.  TSK. TSK.
+\fBRANCH,       0
+       DCA T
+BR2,   TAD I BRANCH
+       ISZ BRANCH
+       SNA
+       JMP NOTFND
+       TAD T
+       SNA CLA
+       JMP FOUND
+       ISZ BRANCH
+       JMP BR2
+
+FOUND, TAD I BRANCH
+       DCA T
+       JMP I T         /FOUND ITEM IN COLUMN 1, JUMP TO ADDRESS IN COL 2
+
+NOTFND,        TAD T
+       JMP I BRANCH    /IF NOT FOUND IN COL 1, RETURN WITH AC INTACT
+CHECKR,        0
+       TAD DCW
+       RAL
+       SMA CLA
+       JMP I CHECKR
+RONLY, JMS I [PRINT
+       TEXT    /? CAN'T - DEVICE IS READ-ONLY/
+       JMP I [GOAWAY
+\fCHECKW,       0
+       TAD DCW
+       RTL
+       SMA CLA
+       JMP I CHECKW
+WONLY, JMS I [PRINT
+       TEXT    /? CAN'T - DEVICE IS WRITE-ONLY/
+       JMP I [GOAWAY
+\fONUM, 0
+       DCA NUM
+       CLA IAC
+       DCA FLG
+ONM1,  JMS I [GETC
+       TAD (-"0-10     /CONVERT TO DIGIT
+       CLL
+       TAD (10
+       SNL
+       JMP OEON
+       DCA T4
+       DCA FLG
+       TAD NUM
+       AND [7000
+       SZA CLA
+       JMP I [NUMBIG
+       TAD NUM
+       CLL RTL
+       RAL
+       TAD T4
+       DCA NUM
+       JMP ONM1
+OEON,  CLA
+       JMS I [BACKC
+       TAD NUM
+       JMP I ONUM
+       PAGE
+\f/READ A LINE INTO OS/8 LINE BUFFER
+
+READ,  0
+       DCA CTOFLG      /ALLOW ECHOING
+RD1,   TAD [LINBUF
+       DCA LINPTR
+       DCA ESCBIT
+GT,    JMS GET
+LOOK,  JMS I [BRANCH
+       -377;RUBOUT
+       -217;GT         /^O
+       -203;CTRLC      /^C
+       -212;LF         /LINE FEED
+       -215;CR         /CARRIAGE RETURN
+       -375;ESCAPE     /ALTMODE
+       -376;ESCAPE     /ALTMODE (2ND FLAVOR)
+       -233;ESCAPE     /ESCAPE
+       -225;CTRLU      /^U
+       -200;GT         /IGNORE NULLS
+       0
+       DCA TEMP        /NONE OF THESE
+       TAD LINPTR
+       TAD (-LINBUF-377
+       SNA CLA         /AT END OF LINE BUFFER?
+       JMP GT          /YES, DON'T ACCEPT CHAR
+       TAD TEMP        /NO, RETRIEVE CHAR
+       JMS TYPE        /ECHO IT
+       TAD TEMP        /INSERT IN BUFFER
+       DCA I LINPTR
+       ISZ LINPTR      /BUMP POINTER
+       JMP GT          /NEXT
+
+CTRLU, TAD ["^
+       JMS TYPE
+       TAD ("U
+       JMS TYPE        /ECHO "^U" <CR><LF>
+       JMS I [CRLF
+       JMP RD1
+\fRUBOUT,       TAD LINPTR
+       TAD [-LINBUF
+       SNA
+       JMP BOL         /AT BEGIN OF LINE
+       TAD [LINBUF-1
+       DCA LINPTR      /MOVE POINTER BACK ONE
+       TAD ["\
+       JMS TYPE        /ECHO "\"
+RUB3,  TAD I LINPTR
+       JMS TYPE        /ECHO RUBBED-OUT CHARACTER
+GT2,   JMS GET
+       JMS I [BRANCH
+       -377;RUB2
+       -216;GT2        /IGNORE ^O
+       -203;CTRLC      /^C
+       0
+       DCA TEMP        /A NEW CHAR
+       TAD ["\
+       JMS TYPE        /ENCLOSE RUBBED-OUT CHARS IN \'S
+       TAD TEMP
+       JMP LOOK
+
+RUB2,  TAD LINPTR
+       TAD [-LINBUF
+       SNA
+       JMP BOL2
+       TAD [LINBUF-1
+       DCA LINPTR
+       JMP RUB3
+
+BOL2,  TAD ["\
+       JMS TYPE
+BOL,   JMS I [CRLF
+       JMP RD1
+
+ESCAPE,        TAD ("$         /ECHO ESCAPE AS DOLLAR SIGN
+       JMS TYPE
+       ISZ ESCBIT      /NOTE ESCAPE
+CR,    DCA I LINPTR    /INSERT 0 AT END
+       JMS I [CRLF
+       JMP I READ      /RETURN, WE GOT LINE
+\fGET,  0
+       KSF
+       JMP .-1
+       KRB
+       AND [177
+       TAD [200        /FORCE TO 8-BIT
+       JMP I GET
+
+TYPE,  0
+       DCA TYPEM
+       JMS I [DELAYY
+       DCA .-1         /DELAY FIRST TIME THRU TO LET THINGS QUIET DOWN
+       TAD CTOFLG
+       SZA CLA
+       JMP I TYPE      /NO ECHOING
+       TAD TYPEM
+       TLS
+       TSF
+       JMP .-1
+       CLA
+       JMP I TYPE
+
+TYPEM, 0
+
+LF,    DCA I LINPTR    /TEMPORARILY INSERT A 0 SENTINEL
+       TAD [LINBUF-1
+       DCA XR1
+       JMS I [CRLF
+       TAD ["#
+       JMS I [TYPE
+LFLP,  TAD I XR1
+       SNA
+       JMP I [GT       /FINHSHED, GET SOME MORE CHARS
+       JMS I [TYPE     /ECHO CURRENT CHARS
+       JMP LFLP
+       PAGE
+\fEOF,  JMS I [SPACE    /SPAN OVER SPACES
+       JMS I [GETDEV   /GET DEVICE
+       JMS I [CHECKR
+       TAD DEVTYP
+       JMS I [BRANCH
+       -20;MAGEOF
+       -27;CASEOF
+       ZBLOCK 2
+       0
+       JMP I [BADEV
+
+SKIP,  JMS I [SPACE
+       JMS I [GETDEV
+       JMS I [CHECKW
+       JMS GETNUM
+       TAD DEVTYP
+       JMS I [BRANCH
+       -20;MAGSKP
+       -27;CASSKP
+       0
+       JMP I [BADEV
+
+REWIND,        JMS I [SPACE
+       JMS I [GETDEV
+       JMS I [CHECKW
+       TAD DEVTYP
+       JMS I [BRANCH
+       -20;MAGREW
+       -27;CASREW
+       -16;TCREW
+/      -17;LTREW
+       ZBLOCK 4        /PATCH SPACE
+       0
+       TAD DCW
+       SMA CLA
+       JMP I [BADEV    /NOT FILE STRUCTURED
+       CLA IAC         /READ BLOCK 0 TO REWIND
+       DCA I [BLK
+       TAD (100
+       JMS I [GO
+       JMP I [GOAWAY
+\fUNLOAD,       JMS I [SPACE
+       JMS I [GETDEV
+       JMS I [CHECKW
+       TAD DEVTYP
+       JMS I [BRANCH
+       -20;MAGUNL
+/      -27;CASUNL
+       -16;TCUNL
+       -21;TDUNL
+/      -17;LTUNL
+       -23;RKEUNL
+       ZBLOCK 2
+       0
+       JMP I [BADEV
+
+BACK,  JMS I [SPACE
+       JMS I [GETDEV
+       JMS I [CHECKW
+       JMS GETNUM
+       TAD TYP
+       SPA CLA
+       JMP I [SYNTAX   /CAN'T BACKSPACE TO EOD
+       TAD DEVTYP
+       JMS I [BRANCH
+       -20;MAGBAK
+       -27;CASBAK
+       0
+       JMP I [BADEV
+\fGETNUM,       0               /PARSE OFF :NNNN [F ! R]  OR EOD
+       CLA IAC
+       DCA NUM
+       DCA TYP
+       JMS I [GETC
+       SNA
+       JMP I GETNUM    /EOL
+       TAD (-":
+       SZA CLA
+       JMP I [SYNTAX
+       STA
+       JMS I [SPACE    /OPTIONAL SPACES
+       TAD I LINPTR
+       SNA
+       JMP I GETNUM    /EOL
+       TAD (-"E
+       SNA CLA
+       JMP EO
+       JMS I [NUMBER
+       DCA NUM
+       STA
+       JMS I [SPACE    /MORE OPTIONAL SPACES
+       DCA TYP
+       JMS I [GETC
+       SNA
+       JMP I GETNUM    /NO F OR R.  F ASSUMED
+       TAD (-"F
+       SNA
+       JMP R           /0 MEANS 'F'
+       TAD ("F-"R
+       SZA CLA
+       JMP I [SYNTAX
+       CLA IAC         /1 MEANS 'R'
+R,     DCA TYP
+       JMP I GETNUM
+EO,    STA             /-1 MEANS 'E'
+       JMP R
+       PAGE
+\f/GET A DECIMAL NUMBER, RETURN IT IN AC
+
+NUMBER,        0
+       DCA NUM
+       CLA IAC
+       DCA FLG
+NM1,   JMS I [GETC
+       JMS I [DIGIT
+       JMP EON
+       TAD (-"0        /CONVERT TO DIGIT
+       DCA T4
+       DCA FLG         /NOTE PASSAGE OF A DIGIT
+       TAD NUM
+       AND [7000
+       SZA CLA
+       JMP I [NUMBIG
+       TAD NUM
+       CLL RTL
+       TAD NUM
+       CLL RAL
+       TAD T4
+       SZL
+       JMP I [NUMBIG
+       DCA NUM
+       JMP NM1
+
+EON,   CLA
+       JMS I [BACKC
+       TAD FLG
+       SZA
+       DCA NUM         /IF NO DIGITS, RETURN A 1
+       TAD NUM
+       JMP I NUMBER
+\f/     GETDEV
+
+/PARSES OFF A DEVICE NAME (1-4 CHARS)
+/DETERMINES IF IT EXISTS
+/LOADS HANDLER INTO 7200-7577 IF NOT ALREADY IN CORE
+/SETS ENTRY POINT ADDRESS AT 'ENTRY'
+/SETS DEVICE NUMBER AT 'DEVNUM'
+/SETS DEVICE CONTROL WORD AT 'DCW'
+/SETS 'DEVTYP'
+
+GETDEV,        0
+       JMS I [GETTWO
+       DCA WD1
+       JMS I [GETTWO
+       DCA WD2
+       TAD WD1
+       TAD WD2
+       DCA WD1         /COMBINE TWO WORDS INTO 1 (IN WD1)
+       TAD WD2
+       SNA CLA
+       JMP INQ
+       TAD WD1         /OS/8 KLUDGE FOR UNIQUENESS
+       CLL RAL
+       STL RAR         /FORCE BIT 0 ON IF 2ND WORD WAS NON-ZERO
+       DCA WD1
+INQ,   DCA WD2
+       CIF 10
+       JMS I USR
+       12              /INQUIRE
+WD1,   0               /DEVICE NAME
+WD2,   0               /GETS DEVICE NUMBER
+WD3,   0               /GETS ENTRY POINT
+       JMP I [NONEX    /DEVICE DOESN'T EXIST
+       TAD WD3
+       SZA             /IS HANDLER ALREADY IN CORE?
+       JMP INCORE      /YES
+       TAD WD1
+       DCA DW1
+       TAD (7201       /ALLOW TWO PAGE HANDLER IN 7200
+       DCA DW3
+       DCA DW2
+       CIF 10
+       JMS I USR
+       1               /FETCH
+DW1,   0               /DEVICE NAME
+DW2,   0               /GETS DEVICE NUMBER
+DW3,   0               /GETS ENTRY POINT
+       JMP I [NONEX    /DOESN'T EXIST
+       TAD DW2
+       DCA DEVNUM
+       TAD DW3
+       DCA ENTRY
+       JMP GETYP
+\fINCORE,       DCA ENTRY
+       TAD WD2
+       DCA DEVNUM
+GETYP, TAD DEVNUM
+       TAD (7757
+       DCA DCWPTR      /POILT INTO DEVICE CONTROL WGRD TABLE
+       CDF 10
+       TAD I DCWPTR    /GET DCW
+       DCA DCW
+       TAD DCW
+       RTR
+       RAR
+       AND [77
+       DCA DEVTYP
+       STA
+       TAD I (37       /GET ADDRESS OF DHIT
+       DCA DHIT
+       TAD DHIT
+       TAD DEVNUM
+       DCA DHI
+       TAD I DHI
+       CDF 0
+       DCA DHI
+       TAD DHI
+       RTL
+       RTL
+       RTL
+       AND (17
+       SZA
+       TAD (15
+       DCA DBLK
+       JMP I GETDEV
+
+DELAYY,        0
+       TAD (-10
+       DCA OUTER
+       ISZ ZER
+       JMP .-1
+       ISZ OUTER
+       JMP .-3
+       JMP I DELAYY
+ZER,   0
+OUTER, -10
+       PAGE
+\fLOADPT,       TAD I (FUNCT
+       TAD (-REWKOD
+       SNA CLA
+       JMP I [GOAWAY   /LOAD POINT ON A REWIND IS NOT AN ERROR
+READBT,        JMS I [PRINT
+       TEXT    /? CAN'T - AT BOT OR EOT/
+       JMP I [GOAWAY
+\fREADEOF,JMS I [PRINT
+       TEXT    /% CAN'T - AT EOF/
+       JMP I [GOAWAY
+
+READBOF,JMS I [PRINT
+       TEXT    /% CAN'T - AT BOF/
+       JMP I [GOAWAY
+
+\fCASSKP,       DCA I (DIR
+       TAD TYP
+       SNA CLA
+       JMP CSKPF
+       JMP I (NOTIMPL
+
+CGO,   0
+       DCA CFUNCT
+       JMS I ENTRY
+CFUNCT,        0
+CBUFR, 7000
+CBLK,  -1
+       SKP
+       JMP I CGO
+       DCA TEMP
+       TAD TEMP
+       SMA CLA
+       JMP I (END      /SOFT ERROR
+       JMS I [PRINT
+       TEXT    \? CAN'T - I/O ERROR\
+       JMP I [GOAWAY
+
+CASEOF,        JMS CGO
+       JMP I [GOAWAY
+
+CASREW,        TAD (REWKOD
+       JMS CGO
+       JMP I [GOAWAY
+\fCSKPF,        TAD NUM
+       SNA
+       IAC
+       CIA
+       DCA COUNT
+       TAD (SKFKOD
+       JMS CGO
+       ISZ COUNT
+       JMP .-3
+       JMP I [GOAWAY
+
+CASBAK,        CLA IAC
+       DCA I (DIR
+       TAD TYP
+       SZA CLA
+       JMP CBAKBLK
+       TAD NUM
+       CMA
+       DCA COUNT
+       TAD (BKFKOD
+       JMS CGO
+       ISZ COUNT
+       JMP .-3
+       JMP I [GOAWAY
+
+CBAKBLK,TAD NUM
+       SNA
+       IAC
+       CIA
+       DCA COUNT
+       TAD (BAKKOD
+       JMS CGO
+       ISZ COUNT
+       JMP .-3
+       JMP I [GOAWAY
+       PAGE
+\fTCREW,        JMS TCR
+       JMP I [GOAWAY
+
+TCUNL, JMS TCR
+       TAD ENTRY
+       IAC
+       RTR
+       RTR
+       AND [7000
+       DTLA            /SELECT ANOTHER UNIT
+       JMP I [GOAWAY
+
+TCR,   0
+       TAD ENTRY
+       TAD (-7607
+       SZA CLA         /SYSTEM TC08 DECTAPE MUST BE UNIT 0
+       TAD ENTRY
+       RTR
+       RTR
+       AND [7000       /ISOLATE UNIT # IN BITS 0-2
+       TAD (600        /GO REVERSE
+       DTLA
+       JMP I TCR
+\fTDUNL,        TAD (-7607
+       SZA CLA
+       TAD ENTRY
+       DCA TEMP
+       TAD TEMP
+       RTR
+       RAR
+       CLA RAR
+       DCA UNIT
+       TAD TEMP
+       AND [3
+       CIA
+       TAD [77         /GET DEV CODE
+       CLL RTL
+       RAL
+       TAD (6004       /BUILD 'SDLC'
+       DCA BSDLC
+       TAD UNIT
+       TAD (3000       /GO, REVERSE
+BSDLC, HLT
+       CLA
+       JMP I [GOAWAY
+UNIT,  0
+\fTTCODE,       0
+       TAD NO
+       SZA CLA
+       JMP I [SYNTAX
+       JMS I [ONUM
+       SNA
+       JMP I [SYNTAX
+       DCA NUCODE
+       TAD NUCODE
+       AND [7700
+       SZA CLA
+       JMP I [NUMBIG
+       JMS I [TTST1
+       TAD (7200
+       DCA RR
+       JMS GETIOT
+       JMP I [OLDERR
+       CIA
+       DCA T2
+TTLP,  JMS GETIOT
+       JMP I [OLDERR
+       CIA
+       DCA T3
+       TAD T3
+       CIA
+       TAD T2
+       SNA
+       JMP TTLP
+       SMA CLA
+       JMP .+3
+       TAD T3
+       DCA T2          /T2 CONTAINS NEG OF SMALLER IOT
+       TAD (7200
+       DCA RR
+TTLP2, JMS GETIOT
+       JMP I TTCODE
+       TAD T2
+       SZA CLA
+       CLA IAC
+       TAD NUCODE
+       CLL RTL
+       RAL
+       DCA T3
+       TAD I RR
+       AND (7007
+       TAD T3
+       DCA I RR
+       JMP TTLP2
+\fGETIOT,       0
+       ISZ RR
+       TAD RR
+       TAD (-7600
+       SNA CLA
+       JMP I GETIOT
+       TAD I RR
+       AND [7000
+       TAD [-6000
+       SZA CLA
+       JMP GETIOT+1
+       TAD I RR
+       RTR
+       RAR
+       AND [77
+       TAD (-20
+       CLL RAR
+       SNA
+       JMP GETIOT+1
+       RAL
+       TAD (20
+       ISZ GETIOT
+       JMP I GETIOT
+       PAGE
+\fMAGSKP,       DCA DIR
+       TAD TYP
+       SNA
+       JMP SKPF
+       SPA CLA
+       JMP SKPEOD
+       TAD NUM
+       SNA
+       CLA IAC
+       CIA
+       DCA WC
+       TAD (SKPKOD
+       JMS GO
+       JMP I [GOAWAY
+
+MAGEOF,        TAD (EOFKOD
+       JMS GO
+       JMP I [GOAWAY
+
+SKPF,  TAD NUM
+       SNA
+       JMP SKP0
+       CIA
+       DCA WC
+       JMS I (FUDGE    /DON'T LET GUY TRICK US INTO GOING PAST EOD
+       TAD (SKFKOD
+       JMS GO
+       JMP I [GOAWAY
+
+SKPEOD,        JMS I (FUDGE    /DON'T LET GUY TRICK US INTO GOING PAST EOD
+       JMS I ENTRY
+       SKFKOD
+       0
+       0               /SKIP 4096 FILES
+       SMA
+       SKP CLA
+       JMP CHKBOT
+       JMP I [GOAWAY
+
+MAGBAK,        CLA IAC
+       DCA DIR
+       TAD TYP
+       SNA CLA
+       JMP BAKF
+       TAD NUM
+       SNA
+       CLA IAC
+       CIA
+       DCA WC
+       TAD (BAKKOD
+       JMS GO
+       JMP I [GOAWAY
+\fBAKF, TAD NUM
+       CMA
+       DCA WC2
+       JMS I ENTRY
+       BKFKOD
+       0
+WC2,   -1              /
+       SMA
+       SKP CLA
+       JMP CHKBOT
+       TAD (SKPKOD     /SKIP 1 RECORD FORWARD
+       JMP SKY
+
+CHKBOT,        DCA TEMP
+       TAD TEMP
+       AND (1000
+       SNA CLA
+       JMP IOE
+       JMP I (READBT
+\fMAGUNL,       TAD (UNLKOD
+       JMS GO
+       JMP I [GOAWAY
+
+MAGREW,        TAD (REWKOD
+       JMS GO
+       JMP I [GOAWAY
+
+GO,    0
+       DCA FUNCT
+       JMS I ENTRY
+FUNCT, 0
+BUFR,  7000
+WC,
+BLK,   -1
+       SKP             /I/O ERROR
+       JMP I GO
+       DCA TEMP
+       TAD TEMP
+       SMA CLA
+       JMP END         /SOFT ERROR
+       TAD TEMP
+       AND (1000
+       SZA CLA
+       JMP I [LOADPT
+IOE,   TAD TEMP
+       JMP I [IOERR
+
+DIR,   0               /0- FORWARD ;  1- BACKWARDS
+
+END,   TAD TYP
+       SNA CLA
+       JMP I (EODERR   /V3C NEW HANDLER CALL
+       TAD DIR         /SAW FILE MARK
+       SNA CLA         /V3C
+       JMP I [READEOF  /AT END OF FILE
+       JMP I [READBOF  /AT BEGIN OF FILE
+\fSKP0, JMS I ENTRY
+       SKFKOD
+       0               /IRRELEVANT
+       -1              /ADVANCE 1 FILE
+       SMA
+       SKP CLA
+       JMP I [IOERR    /HARD ERROR
+       TAD (BAKKOD
+SKY,   DCA SKX         /V3C
+       JMS I ENTRY
+SKX,   BAKKOD
+       0               /IRREL
+       -1              /BACK OVER FILE MARK
+       SMA
+       SKP CLA
+       JMP I [IOERR
+       JMP I [GOAWAY
+       PAGE
+\fIOERR,        AND (3777
+       CLL RAL
+       DCA TEMP
+       JMS I [PRINT
+       TEXT    \? CAN'T - I/O ERROR\
+       TAD (-13        /11 BITS TO LOOK AT
+       DCA CNT
+       TAD (JLIST
+       DCA JM
+IOLUP, TAD TEMP
+       RAL
+       DCA TEMP
+       SZL
+       JMP I JM
+IOCONT,        ISZ JM
+       ISZ CNT
+       JMP IOLUP
+       JMP I [GOAWAY
+
+JM,    0
+
+JLIST, JMP BIT1
+       JMP BIT2
+       JMP BIT3
+       JMP BIT4
+       JMP BIT5
+       JMP BIT6
+       JMP BIT7
+       JMP BIT8
+       JMP I (BIT9
+       JMP I (BIT10
+       JMP I (BIT11
+\fBIT1, JMS I [PRINT
+       TEXT    /(REWINDING)/
+       JMP IOCONT
+BIT2,  JMS I [PRINT
+       TEXT    /(BOT)/
+       JMP IOCONT
+BIT3,  JMS I [PRINT
+       TEXT    /(SELECT ERROR)/
+       JMP IOCONT
+BIT4,  JMS I [PRINT
+       TEXT    /(PARITY ERROR)/
+       JMP IOCONT
+BIT5,  JMS I [PRINT
+       TEXT    /(EOF)/
+       JMP IOCONT
+\fBIT6, JMS I [PRINT
+       TEXT    /(RECORD LENGTH INCORRECT)/
+       JMP IOCONT
+BIT7,  JMS I [PRINT
+       TEXT    /(TIMING ERROR)/
+       JMP IOCONT
+BIT8,  JMS I [PRINT
+       TEXT    /(EOT)/
+       JMP IOCONT
+\fRKEUNL,       CLL
+       TAD ENTRY
+       TAD (200
+       SNL CLA
+       TAD ENTRY
+       AND (6          /ISOLATE UNIT
+       TAD (2000       /WRITE PROTECT DISK
+       DLDC            /LOAD COMMAND REGISTER
+       DLAG
+       JMP I [GOAWAY
+       PAGE
+\fBIT9, JMS I [PRINT
+       TEXT    /(WRITE LOCK-OUT)/
+       JMP I (IOCONT
+BIT10, JMS I [PRINT
+       TEXT    /(READ COMPARE ERROR)/
+       JMP I (IOCONT
+BIT11, JMS I [PRINT
+       TEXT    /(ILLEGAL FUNCTION)/
+       JMP I (IOCONT
+\fNOTIMPL,JMS I [PRINT
+       TEXT    /% OPERATION NOT YET IMPLEMENTED/
+       JMP I [GOAWAY
+EODERR,        JMS I [PRINT
+       TEXT    /? CAN'T - AT EOD/
+       JMP I [GOAWAY
+\f/THIS ROUTINE PREVENTS US FROM GOING PAST EOD WHEN
+/SKIPPING FORWARD FILES.
+/IT DOES THIS BY THE FOLLOWING ALGORITHM:
+/FIRST WE BACKSPACE A RECORD.
+/IF WE SAW DATA, THEN OK, WE RETURN TO THE USER;
+/THIS WILL NOT AFFECT HIS SKIP FILE COUNT.
+/IF WE SAW A FILE MARK, THEN WE SKIP FORWARD
+/BACK OVER THAT FILE, IGNORING THE FILE MARK ERROR.
+/IF WE SAW BOT, THEN, OK NO ERROR.
+
+FUDGE, 0
+       JMS I ENTRY     /V3C ALL NEW
+       BAKKOD
+TM,    0
+       -1
+       SKP
+       JMP I FUDGE
+       SPA
+       JMS BER
+       SZA CLA
+       JMS FRWD
+       JMP I FUDGE
+
+/IF ERROR WAS BOT, OK
+
+BER,   0
+       DCA TM
+       TAD TM
+       AND (1000
+       SZA CLA
+       JMP I BER       /BOT OK, NO FRWD
+       TAD TM
+       JMP I [IOERR
+
+FRWD,  0
+       JMS I ENTRY
+       SKPKOD
+       0
+       -1
+       SMA
+       SKP CLA
+       JMP I [IOERR
+       JMP I FRWD
+       PAGE
+\fSET,  JMS I [SPACE
+       DCA VNO         /V3C
+       JMS I [GETDEV
+       JMS I [GETC
+       JMS I [BRANCH
+       -":;COLN
+       -" ;COLN
+       -"-;HYPH
+       0
+       JMP I [SYNTAX   /NO : OR BLANK AFTER NAME
+COLN,  STA
+       JMS I [SPACE    /IGNORE OPTIONAL SPACES
+       JMS I [GETC
+       SNA
+       JMP I [SYNTAX
+       TAD (-"-
+       SNA CLA
+       JMP HYPH
+       JMS I [BACKC
+COLN2, DCA NAM1
+       DCA NAM2
+       TAD (MAIN-1     /LOOK FOR DEVICE TYPE IN MAIN TABLE
+MNLUP, DCA XR1
+       TAD I XR1
+       SMA SZA
+       JMP NOTYP       /NOT FOUND
+       TAD DEVTYP
+       SNA CLA
+       JMP FNDTYP
+       TAD XR1
+       TAD (3          /POINT TO NEXT ENTRY
+       JMP MNLUP
+FNDTYP,        TAD I XR1       /GET GENERIC NAME
+       DCA NAM1
+       TAD I XR1
+       DCA NAM2
+       DCA AUXFLG
+       TAD I XR1       /GET PTR TO DEVICE TABLE
+INTO,  DCA PTR
+       DCA NO
+       TAD LINPTR
+       DCA SAVPTR      /SAVE SCAN POINTER
+       JMS I [GETTWO
+       TAD (-1617
+       SNA CLA         /ARE NEXT TWO CHARS 'NO'?
+       JMS SAWNO       /YES
+       TAD SAVPTR      /NO
+       DCA LINPTR      /RESTORE PTR
+SCNLUP,        TAD I PTR
+       SNA             /GET NEXT KEYWORD POINTER
+       JMP NOKEY
+       ISZ PTR         /POINT TO PTR TO ROUTINE
+       JMS I [KEYSRCH
+       JMP NOF         /NOT FOUND
+       TAD I PTR       /FOUND
+       DCA PTR         /GET PTR TO ROUTINE
+       JMS I (HREAD    /READ HANDLER
+       JMS I PTR       /CALL ROUTINE
+       JMS I (HWRITE   /REWRITE HANDLER
+       JMP I [GOAWAY
+\fHYPH, JMS I [ALPHA
+       JMP I [BADV
+       DCA VNO
+       TAD VNO
+       SNA
+       JMP I [BADV
+       AND [17
+       DCA VNO
+       JMS I [SPACE    /IGNORE SPACE
+       JMP COLN2
+\fNOKEY,        TAD AUXFLG
+       SNA CLA
+       JMP NOO
+       JMS I [PRINT
+       TEXT    \? UNKNOWN ATTRIBUTE FOR DEVICE  \
+       *.-1
+NAM1,  0
+NAM2,  0
+       0
+       JMP I [GOAWAY
+
+SAWNO, 0
+       ISZ NO
+       STA
+       JMS I [SPACE
+       TAD LINPTR
+       DCA SAVPTR
+       JMP I SAWNO
+
+NOTYP, CLA
+       ISZ AUXFLG
+       TAD (AUX        /SEARCH AUXILIARY TABLE
+       JMP INTO
+\fNOF,  ISZ PTR
+       TAD SAVPTR
+       DCA LINPTR
+       JMP SCNLUP
+
+AUXFLG,        0
+
+NOO,   ISZ AUXFLG
+       TAD (AUX
+       DCA PTR
+       JMP SCNLUP
+       PAGE
+\fHREAD,        0
+       TAD DBLK
+       SNA
+       JMP RESERR
+       DCA BLOCK
+       JMS I (7607
+       200             /READ 2 PAGES
+L7200, 7200            /INTO 7200-7577
+BLOCK, 0               /FROM THIS BLOCK ON SYSTEM DEVICE
+       JMP I [SYSERR
+       TAD DHI
+       AND (177        /GET RELATIVE ENTRY PT
+       TAD L7200
+       DCA ENTRY
+       TAD VNO
+       SZA CLA         /V3C
+       JMP I HREAD     /VNO ALREADY SET BY - COMMAND
+       TAD ENTRY
+VLOOP, DCA VNOPTR
+       TAD I VNOPTR
+       CLL
+       TAD (-33
+       SZL CLA
+       JMP BACKV
+       TAD I VNOPTR
+       SNA
+       JMP OLDERR
+       DCA VNO
+       JMP I HREAD
+BACKV, STA
+       TAD VNOPTR
+       JMP VLOOP
+
+RESERR,        JMS I [PRINT
+       TEXT    /? CAN'T - DEVICE IS RESIDENT/
+       JMP I [GOAWAY
+\fOLDERR,       CLA
+       JMS I [PRINT
+       TEXT    /? CAN'T - OBSOLETE HANDLER/
+       JMP I [GOAWAY
+
+HWRITE,        0
+       TAD BLOCK
+       DCA BLKTWO
+       JMS I (7607
+       4200
+       7200
+BLKTWO,        0
+       JMP I [SYSERR
+       JMP I HWRITE
+\fNEWERR,       CLA
+       JMS I [PRINT
+       TEXT    /? CAN'T - UNKNOWN VERSION OF THIS HANDLER/
+       JMP I [GOAWAY
+       PAGE
+\fMAIN, -0;     DEVICE TTY;     TTYTBL
+       -1;     DEVICE PTR;     PTRTBL
+       -2;     DEVICE PTP;     PTPTBL
+       -3;     DEVICE CDR;     CDRTBL
+       -4;     DEVICE LPT;     LPTTBL
+       -20;    DEVICE MTA;     MTATBL
+       1
+       ZBLOCK 20
+/TABLE ENDS WITH A POSITIVE NON-ZERO NUMBER
+\fCDRTBL,       CODE;CDCODE
+       ZBLOCK 4
+       0
+
+LPTTBL,        WIDTH;LPWDTH
+       LC;LPLC
+       LV8E;LPLV
+       ZBLOCK 4
+       0
+
+MTATBL,        PARITY;MTAPAR
+       DENSITY;MTADEN
+       FILES;MTAFIL
+       ZBLOCK 4
+       0
+\fTTYTBL,       WIDTH;TTWIDTH
+       CODE;TTCODE
+       ALT;TTALT
+       ECHO;TTECHO
+       LC;TTLC
+       PAYGE;TTPAGE
+       TAB;TTTAB
+       FILL;TTFILL
+       FLAGG;TTFLAG
+       CTRL;TTCTRL
+       GAG;TTGAG
+       DELAY;TTDELAY
+       ZBLOCK 10
+       0
+
+AUX,   LOC;GENLOC
+       FILES;GENFIL
+       READO;GENREA
+       VERS;GENVER
+       ZBLOCK 10
+       0
+       PAGE
+\fWIDTH,        "W;"I;"D;"T;"H;0
+LC,    "L;"C;0
+LV8E,  "L;"V;4000+"8;4000+"E;0
+CODE,  "C;"O;"D;"E;0
+ALT,   "A;"L;"T;4000+"M;4000+"O;4000+"D;4000+"E;0
+ECHO,  "E;"C;"H;"O;0
+PAYGE, "P;"A;"G;"E;0
+TAB,   "T;"A;"B;0
+LOC,   "L;"O;"C;4000+"A;4000+"T;4000+"I;4000+"O;4000+"N;0
+FILES, "F;"I;"L;"E;4000+"S;0
+READO, "R;"E;"A;"D;4000+"O;4000+"N;4000+"L;4000+"Y;0
+VERS,  "V;"E;"R;4000+"S;4000+"I;4000+"O;4000+"N;0
+PARITY,        "P;"A;"R;4000+"I;4000+"T;4000+"Y;0
+DENSITY,"D;"E;"N;4000+"S;4000+"I;4000+"T;4000+"Y;0
+FILL,  "F;"I;"L;"L;0
+FLAGG, "F;"L;"A;"G;0
+CTRL,  "C;"T;"R;"L;0
+EVEN,  "E;4000+"V;4000+"E;4000+"N;0
+ODD,   "O;4000+"D;4000+"D;0
+DELAY, "D;"E;"L;"A;"Y;0
+GAG,   "G;"A;"G;0
+       PAGE
+\fLPWDTH,       0
+       JMS I (GETWID
+       JMS LPTST1
+       TAD NUM
+       CMA
+       DCA I (7200
+       JMP I LPWDTH
+
+LPTST1,        0
+       TAD I (7201
+       SPA CLA
+       JMP L645
+       TAD VNO
+       JMS I [BRANCH
+       -1;OLDERR
+       -2;LPTOK
+       ZBLOCK 4
+       0
+       JMP I [NEWERR
+LPTOK, JMP I LPTST1
+
+L645,  JMS I [PRINT
+       TEXT    /? CAN'T AFFECT ANNALEX LPT/
+       JMP I [GOAWAY
+\fASRTST,       0
+       TAD DHI
+       SPA CLA
+       JMP I ASRTST
+       JMS I [PRINT
+       TEXT    /? CAN'T - NOT KL8E HANDLER/
+       JMP I [GOAWAY
+\fGENVER,       0
+       TAD NO
+       SZA CLA
+       JMP I [SYNTAX
+       JMS I [ALPHA
+       JMP BADV
+       DCA NUM
+       TAD NUM
+       AND (40
+       SZA CLA
+       JMP BADV
+       TAD NUM
+       AND (37
+       DCA I VNOPTR
+       JMP I GENVER
+
+GENREA,        0
+       CDF 10
+       TAD I DCWPTR
+       CLL RTL
+       CLL RAL
+       TAD NO
+       RAR
+       CML RAR
+       RAR
+       DCA I DCWPTR
+       CDF 0
+       JMP I GENREA
+
+GENFIL,        0
+       CDF 10
+       TAD I DCWPTR
+       CLL RAL
+       CLL RAL         /ZERO LINK
+       TAD NO
+       RAR
+       CML RAR
+       DCA I DCWPTR
+       CDF 0
+       JMP I GENFIL
+\fBADV, CLA
+       JMS I [PRINT
+       TEXT    /? BAD VERSION LETTER/
+       JMP I [GOAWAY
+
+CRLF,  0
+       TAD [215
+       JMS I (TYPE
+       TAD [212
+       JMS I (TYPE
+       JMP I CRLF
+       PAGE
+\fLPLV, 0
+       JMS I (LPTST1
+       TAD NO
+       CLL RTL
+       RTL
+       TAD (4
+       DCA I (7201
+       JMP I LPLV
+
+LPLC,  0
+       JMS I (LPTST1
+       TAD NO
+       CLL RTL
+       RTL
+       RAL
+       CIA
+       DCA I (7202
+       JMP I LPLC
+
+TTALT, 0
+       JMS I [TTST1
+       JMP I [NOTIMPL
+       JMP I TTALT
+
+TTECHO,        0
+       JMS I [TTST1
+       TAD NO
+       SZA CLA
+       TAD (SKP CLA-SZA
+       TAD (SZA
+       DCA I (7200+120
+       JMP I TTECHO
+
+TTPAGE,        0
+       JMS I (ASRTST
+       TAD VNO
+       JMS I [BRANCH
+       -1;OLDERR
+       -2;OLDERR
+       -3;OLDERR
+       -4;PAGOK
+       ZBLOCK 2
+       0
+       JMP I [NEWERR
+\fPAGOK,        TAD I (7200+216
+       TAD (-SNA
+       SZA CLA
+       JMP I [REASEM
+       TAD NO
+       SNA CLA
+       TAD (SZA CLA-CLA
+       TAD (CLA
+       DCA I (7200+216
+       JMP I TTPAGE
+\fTTTAB,        0
+       JMS I [TTST1
+       JMS I [GETC
+       SNA
+       JMP TTEO
+       TAD (-"/
+       SNA CLA
+       JMS I [GETC
+       TAD (-"N
+       SZA CLA
+       JMP I [SYNTAX
+       JMP NOTEC
+TTEO,  TAD NO
+       SNA CLA
+       TAD (5000
+       TAD L200
+       JMS I (TECO
+NOTEC, JMS I [SRCH
+L200,  200;100;7
+       JMP I [REASEM
+       DCA TEMP
+       STA CLL RAL     /-2
+       TAD TEMP
+       DCA T2
+       TAD TEMP
+       TAD (3
+       DCA T3
+       TAD NO
+       SNA CLA
+       JMP SETAB
+       TAD TEMP
+       TAD (-4
+       DCA T4
+       TAD T4
+       AND (77
+       TAD (1200       /TAD TTY240
+       DCA I T2
+       TAD (SZA CLA
+       DCA I T3
+       JMP I TTTAB
+SETAB, TAD TEMP
+       TAD (-12
+       DCA T4
+       TAD I T4
+       DCA I T2
+       TAD (SKP CLA
+       DCA I T3
+       JMP I TTTAB
+       PAGE
+\fTTFILL,       0
+       JMS I [TTST1
+       JMS I [SRCH
+       200;100;1377
+       JMP I [REASEM
+       TAD (-1
+       DCA TEMP
+       TAD NO
+       CLL RAL
+       TAD (2
+       TAD TEMP
+       DCA T2
+       TAD I T2
+       DCA I TEMP
+       JMP I TTFILL
+
+REASEM,        JMS I [PRINT
+       TEXT    /? CAN'T - MUST REASSEMBLE KL8E SOURCE/
+       JMP I [GOAWAY
+
+TTDELAY,0
+       JMS I [TTST1
+       JMP I [NOTIMPL
+       JMP I TTDELAY
+\f/ENTER WITH PTR TO POSSIBLE KEYWORD IN AC
+
+KEYSRCH,0
+       DCA KPTR
+KL,    TAD I KPTR
+       ISZ KPTR
+       SNA
+       JMP GOTKEY
+       CIA
+       DCA TEMP
+       JMS I [ALPHA    /IS IT ALPHANUMERIC?
+       JMP EOK         /NO
+       TAD TEMP        /COMPARE
+       CLL RAL         /LOW ORDER 11 BITS
+       SNA CLA
+       JMP KL          /MATCHED, KEEP LOOKING
+       JMP I KEYSRCH   /DIDN'T MATCH
+EOK,   JMS I [BACKC
+       TAD TEMP
+       CIA             /INPUT STREAM RAN OUT OR HIT SPACE
+       SPA CLA
+       JMP GOTKEY      /SPACE OR EOL MATCH FLAGGED CHARACTER
+       JMP I KEYSRCH
+
+KPTR,  0
+
+GOTKEY,        JMS I [SCAN
+       STA             /SKIP EXTRA STUFF
+       JMS I [SPACE
+       ISZ KEYSRCH     /TAKE GOOD RETURN 2
+       JMP I KEYSRCH
+
+PTRTBL,        ZBLOCK 4
+       0
+
+PTPTBL,        ZBLOCK 4
+       0
+       PAGE
+\fTTGAG,        0
+       JMS TTST1
+       JMP I [NOTIMPL
+       JMP I TTGAG
+
+TTFLAG,        0
+       JMS TTST1
+       JMS I [SRCH
+       200;200;247
+       JMP I [REASEM
+       TAD (-2
+       DCA TEMP
+       TAD NO
+       SNA CLA
+       TAD (SZA CLA-CLA
+       TAD (CLA
+       DCA I TEMP
+       JMP I TTFLAG
+
+TTLC,  0
+       JMS TTST1
+       JMS I [SRCH
+       200;200;377
+       JMP I [REASEM
+       TAD (5
+       DCA TEMP
+       TAD I TEMP
+       CLL
+       TAD [200
+       SNL CLA
+       JMP I [REASEM
+       TAD NO
+       SNA CLA
+       TAD [40         /SNA CLA
+       TAD (7610       /SKP CLA
+       DCA I TEMP
+       JMP I TTLC
+
+TTCTRL,        0
+       JMS TTST1
+       JMP I [NOTIMPL
+       JMP I TTCTRL
+\fTTWIDTH,0
+       JMS GETWID
+       JMS TTST1
+       TAD NUM
+       AND [7
+       SZA CLA
+       JMP I [BADWID
+       TAD NUM
+       TAD [-200
+       SNA CLA
+       JMP I [BADWID
+       JMS I [SRCH
+       200;200;7600
+       JMP I [REASEM
+       IAC
+       DCA TEMP
+       TAD I TEMP
+       AND [177
+       TAD (177+7200
+       DCA T2
+       TAD TEMP
+       IAC
+       DCA T3
+       TAD NUM
+       CIA
+       DCA I T3
+       TAD I T3
+       DCA I T2
+       JMP I TTWIDTH
+\fGETWID,       0
+       TAD NO
+       SZA CLA
+       JMP I [SYNTAX
+       JMS OPTEQ
+       JMS I [NUMBER
+       SNA
+       JMP I (BADWID
+       DCA NUM
+       TAD FLG
+       SZA CLA
+       JMP I [SYNTAX   /NO DIGITS
+       TAD NUM
+       AND [7400
+       SZA CLA
+       JMP I [NUMBIG
+       JMP I GETWID
+
+TTST1, 0
+       JMS I (ASRTST
+       TAD VNO
+       JMS I [BRANCH
+       -1;OLDERR
+       -2;OLDERR
+       -3;TTOK
+       -4;TTOK         /V3C
+       ZBLOCK 4
+       0
+       JMP I [NEWERR
+TTOK,  JMP I TTST1
+\fOPTEQ,        0
+       JMS I [GETC
+       TAD (-"=
+       SZA CLA
+       JMP NOE
+       JMS I [SPACE
+       JMP I OPTEQ
+NOE,   JMS I [BACKC
+       JMP I OPTEQ
+       PAGE
+\fBADWID,       JMS I [PRINT
+       TEXT    /? ILLEGAL WIDTH/
+       JMP I [GOAWAY
+
+OPRIN, 0
+       DCA N3
+       TAD (-4
+       DCA OKNT
+OPLP,  TAD N3
+       JMS DGP
+       TAD N3
+       RTL
+       RAL
+       DCA N3
+       ISZ OKNT
+       JMP OPLP
+       JMP I OPRIN
+
+DGP,   0
+       RTL
+       RTL
+       AND [7
+       TAD [60
+       JMS I [TYPE
+       JMP I DGP
+
+OKNT,  0
+N3,    0
+NUM2,  0
+GTEM,  0
+\fSRCH, 0
+       TAD I SRCH
+       ISZ SRCH
+       TAD (7200-1
+       DCA XR1
+       TAD I SRCH
+       ISZ SRCH
+       CIA
+       DCA CNT
+       TAD I SRCH
+       CIA
+       DCA TEMP
+       ISZ SRCH
+SRLUP, TAD I XR1
+       TAD TEMP
+       SNA CLA
+       JMP SRFND
+       ISZ CNT
+       JMP SRLUP
+       JMP I SRCH
+SRFND, ISZ SRCH
+       TAD XR1
+       JMP I SRCH
+\fGENLOC,       0
+       TAD NO
+       SZA CLA
+       JMP I [SYNTAX
+       JMS I [ONUM
+       DCA NUM2
+       TAD FLG
+       SZA CLA
+       JMP I [SYNTAX
+       JMS I [GETC
+       DCA TEMP
+       TAD TEMP
+       SNA
+       JMP ENOL
+       TAD (-"=
+       SZA CLA
+       JMP I [SYNTAX
+ENOL,  TAD DHI
+       SPA CLA
+       TAD (-200
+       TAD (-200
+       CLL
+       TAD NUM2
+       SZL CLA
+       JMP I [NUMBIG
+       TAD NUM2
+       TAD (7200       /BASE OF HANDLER
+       DCA NUM2
+       TAD TEMP
+       SNA CLA
+       JMP ODT
+GETNEW,        JMS I [ONUM
+       DCA NUM
+       TAD FLG
+       SZA CLA
+       JMP I GENLOC
+       JMS I [GETC
+       SZA CLA
+       JMP I [SYNTAX
+       TAD NUM
+       DCA I NUM2
+       JMP I GENLOC
+\fODT,  TAD I NUM2
+       JMS OPRIN
+       TAD ("/
+       JMS I [TYPE
+       TAD I [READ
+       DCA GTEM        /SAVE CHAIN STATUS
+       JMS I [READ
+       TAD [LINBUF
+       DCA LINPTR
+       TAD GTEM
+       DCA I [READ
+       JMP GETNEW
+       PAGE
+\fMTAPAR,       0
+       TAD NO
+       SZA CLA
+       JMP I [SYNTAX
+       JMS MTST1
+       TAD LINPTR
+       DCA SAVPTR
+       TAD (EVEN
+       JMS I [KEYSRCH
+       SKP
+       JMP SETE
+       TAD SAVPTR
+       DCA LINPTR
+       TAD (ODD
+       JMS I [KEYSRCH
+       JMP I [SYNTAX
+       TAD (400
+SETE,  TAD (2
+       DCA I (7200
+       JMP I MTAPAR
+
+MTST1, 0
+       TAD VNO
+       JMS I [BRANCH
+       -1;OLDERR
+       -2;OLDERR
+       -3;OLDERR
+       -4;MTOK
+       -5;MTOK
+       -6;MTOK
+       ZBLOCK 4
+       0
+       JMP I [NEWERR
+MTOK,  JMP I MTST1
+
+MTADEN,        0
+       JMS MTST1
+       TAD NO
+       SZA CLA
+       JMP I [SYNTAX
+       JMP I [NOTIMP
+       JMP I MTADEN
+\fMTAFIL,       0
+       JMS MTST1
+       TAD NO
+       DCA I (7201
+       JMP I MTAFIL
+
+BADCOD,        JMS I [PRINT
+       TEXT    /? UNKNOWN CARD CODE/
+       JMP I [GOAWAY
+
+/SUPPOSED TO WORK ON ALL VERSIONS
+
+CDCODE,        0
+       TAD NO
+       SZA CLA
+       JMP I [SYNTAX
+       JMS I (OPTEQ
+       JMS I [NUMBER
+       TAD (-32        /026
+       SNA
+       JMP C026
+       TAD (32-35      /029
+       SZA CLA
+       JMP BADCOD
+       JMS CHANGE
+       LIST1;LIST2
+       JMP I CDCODE
+C026,  JMS CHANGE
+       LIST1;LIST3
+       JMP I CDCODE
+\fCHANGE,       0
+       TAD I CHANGE
+       DCA P1
+       ISZ CHANGE
+       TAD I CHANGE
+       DCA P2
+       ISZ CHANGE
+CHLUP, TAD I P1
+       SNA
+       JMP I CHANGE
+       TAD (7200       /BASE OF HANDLER
+       DCA P3
+       TAD I P2
+       DCA I P3
+       ISZ P1
+       ISZ P2
+       JMP CHLUP
+
+P1,    0
+P2,    0
+P3,    0
+       PAGE
+\fLIST1,        304;305;306
+       314;315;316
+       324;325;326;327
+       334;335;336
+       0
+
+LIST2, 3203;4007;3502
+       7514;0577;3637
+       0104;1211;3374;0641
+       7316;3410;1376
+
+LIST3, 7735;4076;0774
+       3314;1002;0305
+       3204;1273;3606;1341
+       3716;1175;3401
+\fTECNAM,       FILENAME TECO.SV
+
+TECO,  0
+       DCA SA
+       TAD (TECNAM
+       DCA ARG1
+       CLA IAC         /LOOKUP ON SYS
+       CIF 10
+       JMS I USR
+       2
+ARG1,  TECNAM          /STARTING BLOCK
+       0
+       JMP I TECO      /NOT FOUND
+       TAD ARG1
+       DCA BLKN
+       JMS I (7607
+       100             /READ 1 PAGE FROM TECO
+       7000            /BUFFER
+BLKN,  0
+       JMP I [SYSERR
+       TAD BLKN
+       DCA BLKN2
+       TAD SA
+       DCA I (7002     /REL LOC 2 IS S.A.
+       JMS I (7607
+       4100
+       7000
+BLKN2, 0
+       JMP I [SYSERR
+       JMP I TECO
+
+SA,    0
+       PAGE
+
+/7000-7177 BUFFER FOR TECO CCB
+/7200-7577 BUFFER FOR HANDLER
+\f      FIELD 0
+       *200
+       $
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape6/DIRECT.PA b/sw/os8/v3d/sources/system/dectapes/dectape6/DIRECT.PA
new file mode 100644 (file)
index 0000000..2711c63
--- /dev/null
@@ -0,0 +1,1148 @@
+/DIRECT V3D FOR OS/78 V1A AND OS/8 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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/JANUARY 17, 1974                     H.J.
+/
+/5-AUGUST-1975 MAINT. RELEASE CHANGES          S.R.
+/1.    UPDATED COPYRIGHT DATE
+/2.    CHANGED VERSION NUMBER TO V4
+/3.    INCORPORATED PATCH (SEQ #2) OF FEB 1975 DSN
+/      (FIXES BUG RE: DEFAULTING TO TTY: AND DSK:)
+/
+/ 5-APR-77     MH      OS/78 FIXES     (V5A)
+/ 18-MAY-77    MH      SPR 2286        (V6A)
+/
+/DIRECTORY LISTING PROGRAM
+/
+/ START ADDRESS 14600;  JSW 6403
+/
+
+       PTR=20
+       CNT=21
+       INFPTR=22
+       OUHAND=23
+       INHAND=24
+       EPTR=26
+       INSCNT=27
+       TEMP=30
+       OKFLAG=31
+       IFCNT=32
+       OSWTCH=33
+       INFWDS=34
+       BDPTR=35
+       GPTR1=36
+
+
+       XR=10
+       XR1=11
+       XR2=12
+
+
+       AC2=CLA CLL CML RTL
+       AC4000=CLA CLL CML RAR
+       ACM2=CLA CLL CMA RAL
+       ACM3=CLA CLL CMA RTL
+
+
+       ALTOPT=7642
+       OPT1=7643
+       OPT2=7644
+       EQLS=7646       /EQUALS OPTION
+       DATE=7666
+       BIPCCL=7777     /CONTAINS DATE EXTENSION IN BITS 3 AND 4 (MH)
+       BUF=5200        /THE FILE OUTPUT BUFFER
+                       /5 BLOCKS LONG, TO 7577
+
+\f
+       FIELD 1
+       *2000
+       SKP CLA         /NORMAL ENTRY
+       JMP MSTRT       /CHAIN ENTRY
+CDCALL,        JMS I (200      /SEE WHAT THE PERSON WANTS
+       5
+STAR,  5200            /IN SPECIAL MODE
+
+MSTRT, TAD I (OPT2     /GET OPTION /W
+       RTR
+       SNL CLA         /SKIP FOR VESION NUMBER
+       JMP EQUALT
+       JMS I (ERROR    /PRINT VERSION NUMBER
+       VERNO+40
+       TAD (215
+       JMS I (TYPE
+
+/SET UP FOR MULTIPLE ENTRIES ON A LINE
+
+EQUALT,        TAD I (EQLS     /EQUALS OPTION WORD
+       SPA             /MUST BE POSITIVE
+       CLA CLL CML RTR /SET AC LARGE POSITIVE
+       TAD (-10        /CHECK LEGALITY OF OPTION
+       SMA SZA CLA     /SKIP IF GOOD
+       JMP BADEQ
+
+/SUBSTITUTE .DI IF NULL EXTENSION
+
+       TAD I (7604     /GET EXTENSION
+       SNA             /SKIP IF GIVEN
+       TAD (0411       /.DI
+       DCA I (7604     /PUT EXTENSION BACK
+/ GET THE DATE INCREMENT BITS
+       CDF     0       /GET GET WORD FORM FIELD 0(MH)
+       TAD I   (BIPCCL /THE BITS WITH DATE EXT. ARE 3 AND 4 (MH)
+       CDF     10      /BACK TO FIELD 1 (MH)
+       RTR             /SHIFT THOSE BITS SO THEY CREATE A 0,10,20, OR 30(MH)
+       RTR             /AFTER MASKING (MH)
+       AND     (0030   /MASK (MH)
+       DCA     DATINC  /SAVE THE DATE EXTENSION (MH)
+
+/ CHECK FOR ? IN OUTPUT SPECIFICATION
+       TAD (-10
+       DCA CNT         /CNT HAVING -10 PUTS US AT FIRST CHAR
+S1C,   TAD (7605
+       JMS I (GTSXBT   /GET A CHAR
+       TAD (-"?!7700   /CHECK FOR ?
+       SNA
+       JMP QINO
+       TAD ("?-"*
+       SNA CLA
+       JMP AINO
+       ISZ CNT
+       JMP S1C
+
+
+/ CHECK FOR EMBEDDED * IN ANY SPECIFICATION
+       TAD (7605
+S4L,   DCA PTR
+       TAD (-10
+       DCA CNT
+ACK,   TAD PTR
+       JMS I (GTSXBT
+       TAD (-"*!7700
+       SZA CLA
+       JMP CNTUP
+       AC2
+       TAD CNT
+       SZA
+       TAD (6
+       SNA CLA
+       ISZ CNT
+       TAD PTR
+       JMS I (GTSXBT
+       SZA CLA
+       JMP AINO
+CNTUP, ISZ CNT
+       JMP ACK
+       TAD I PTR
+       SNA CLA
+       JMP I (NULLCK
+       TAD (5
+       TAD PTR
+       JMP S4L
+
+/THIS IS THE END OF OPERATION CODE
+/IT CLOSES THE FILE AND HANDLES RETURNS
+
+ENDCHK,        ISZ I (ECHO
+       TAD (232
+OLOOP, JMS I (OUTCHR
+       TAD I (OUWDCT   /GET -WORDS LEFT IN BUFFER
+       AND (177        /CHECK AGAINST NEW BUFFER #
+       SNA             /SPR 2286, CHECK CAREFULLY (MH)
+       TAD     RPOS    /TO SEE IF ANY TRAILING (MH)
+       CIA             /OR DANGLING CHARS (MH)
+       TAD     (RPOS-1 /ARE LEFT OVER (MH)
+       SZA!CLA         /(MH)
+       JMP OLOOP       /KEEP GOING TO DUMP ONE
+       TAD I (OUWDCT
+       TAD (1200       /DONT DUMP IF AT END
+       SZA CLA
+       JMS DUMP        /DUMP BUFFER
+       TAD I (7600
+       JMS I (200
+       4
+       7601
+CLEN,  0
+       JMP CLOERR
+       JMP     ABORT   /CODE MOVED TO ANOTHER PAGE (MH)
+
+       PAGE
+\f
+NULLCK,        TAD (7201
+       DCA AO2
+       TAD (7201
+       DCA AO1
+       TAD I (7600
+       SNA
+       JMP TTYHND
+       JMS I (200
+       1
+AO1,   7201
+       HLT
+       TAD AO1
+       JMP CMN
+TTYHND,        TAD (2424
+       DCA TTY1
+       TAD (3100
+       DCA TTY2
+       JMS I (200
+       1
+TTY1,  0
+TTY2,  0
+AO2,   7201
+       JMP I (IDBLVT
+       TAD TTY2
+       DCA I (7600
+       TAD AO2
+CMN,   DCA OUHAND
+       TAD (7601
+       DCA BLCK
+       TAD I (7600
+       JMS I (200
+       3
+BLCK,  7601
+LENGTH,        0
+       JMP I (NOROOM
+       TAD BLCK
+       DCA I (BLCKN
+       TAD (BUF
+       DCA I (OCPTR
+       TAD (RPOS-1     /SPR 2286 (MH)
+       DCA I (RPOS
+       TAD (-1200      /NUMBER OF WORDS IN BUFFER
+       DCA I (OUWDCT
+       DCA I (CLEN
+       TAD I (7605
+       SNA
+       JMP FINDSK      /V3C    IF NO DEVICE SPECIFIED, LOOKUP 'DSK'
+SETDEV,        DCA I (7605
+       TAD (7605
+DOMOIN,        DCA INFPTR
+       TAD (6601
+       DCA AI1
+       TAD I INFPTR
+       SNA
+       JMP I (ENDCHK
+       JMS I (200
+       1
+AI1,   6601
+       HLT
+       TAD AI1
+       DCA INHAND
+       TAD (OUTCHR
+       DCA OSWTCH
+       JMS I (CRLF
+       TAD I (DATE
+       DCA I   (DATNOW /SAVE CURRENT DATE (MH)
+       TAD I   (DATE   /GET DATE BACK INTO AC (MH)
+       JMS I (PDATE
+       JMS I (CRLF
+       JMS I (CRLF
+       DCA I (ECOUNT
+       CMA
+       TAD I (EQLS
+       SMA             /SET UP NEGATIVE COUNT
+       CMA
+       DCA I (ALNCNT   /SAVE FOR LATER
+       TAD I (ALNCNT   /SAVE FOR LATER
+       DCA I (LNCNT    /SAVE FOR LATER
+       JMP I (PG1
+
+AINO,  JMS I (ERROR
+       ILLA+40
+       JMP EOLIN
+QINO,  JMS I (ERROR
+       ILLQ+40
+EOLIN, TAD (215        /COME HERE TO ABORT DIRECTORY
+       JMS I (TYPE     /AND PRINT CRLF
+       JMP I (ABORT    /ABORT OPERATION AND  GOTO ENDUP
+
+FINDSK,        DCA XX          /V3C
+       JMS I (200      /CALL USR
+       12              /TO DO AN INQUIRE
+       5723            /TO LOCATE 'DSK'
+XX,    0
+       0
+       JMP I (IDBLVT   /NO 'DSK' IMPOSSIBLE (SO SAY NO 'TTY')
+       TAD XX          /RETURN DEVICE NUMBER OF DSK
+       JMP SETDEV
+       PAGE
+\f      DIRCTY=0        /LOCATION OF INPUT DIRECTORY
+
+PG1,   TAD I INFPTR
+       TAD (7757
+       DCA TEMP
+       TAD I TEMP
+       SMA CLA
+       JMP NFIN
+       CIF 0
+       JMS I INHAND
+       1400
+       DIRCTY
+       1
+       JMP INDERR
+       CDF 0           /CODE TO CHECK FOR
+       TAD I (DIRCTY   /LEGALITY OF DIRECTORY
+       CMA CLL
+       TAD I (DIRCTY+2
+       CDF 10
+       SNL
+       TAD (7700
+       SZL CLA
+       JMP BIDIR       /DIRECTORY IS BAD
+
+/ COUNT NUMBER OF INPUTS FROM SAME DEVICE
+       TAD INFPTR
+       SKP
+GETCNT,        TAD PTR
+       IAC
+       DCA PTR
+       TAD I PTR
+       SZA CLA
+       JMP NOSUB
+       TAD (5200
+       DCA I PTR
+       TAD (3
+       TAD PTR
+       DCA TEMP
+       TAD (5200
+       DCA I TEMP
+NOSUB, TAD PTR
+       TAD (4
+       DCA PTR
+       ISZ CNT
+       TAD I (OPT2
+       AND (10
+       SZA CLA
+       JMP NOPTIM
+       TAD I PTR
+       CIA
+       TAD I INFPTR
+       SNA CLA
+       JMP GETCNT
+NOPTIM,        TAD CNT
+       CIA
+       DCA INSCNT
+       TAD PTR
+       DCA I (MOIN
+       DCA BDPTR
+       JMP I (NBLOCK
+
+BIDIR, JMS I (ERROR
+       BADDIR+40
+       JMP I (EOLIN
+NFIN,  JMS I (ERROR
+       NFLEIN+40
+       JMP I (EOLIN
+INDERR,        JMS I (ERROR
+       BADIRD+40
+       JMP I (EOLIN
+
+/THIS IS THE ERROR MESSAGE PRINTER
+
+ERROR, 0
+       ISZ I (ECHO
+       CLA CLL
+       TAD (TYPE
+       DCA OSWTCH
+       TAD (-100
+       DCA CNT
+PLOOP, TAD I ERROR
+       JMS I (GTSXBT
+       DCA DFLAG
+       TAD DFLAG
+       JMS I (CONVTP
+       ISZ CNT
+       TAD DFLAG
+       SZA CLA
+       JMP PLOOP
+       ISZ ERROR
+       JMP I ERROR
+
+DFLAG, 0
+ABORT, TAD I   (ALTOPT /MOVED (MH)
+       SMA CLA
+       JMP I   (CDCALL
+       CIF CDF 0
+       JMP I   (7605
+BADEQ, JMS I   (ERROR
+       BIGEQ+40
+       JMP I   (EOLIN
+
+       PAGE
+\f
+/THIS IS THE SUPERQUASIFACETED DIRECTORY PATTERN MATCHING ROUTINE
+
+/THE INPUT DIRECTORY IS SEARCHED HERE, IF A MATCH
+/IS FOUND USING THE INPUT GROUPING
+/GOT1 GETS CONTROL WITH -BLOCKS IN THE AC
+
+NBLOCK,        TAD BDPTR       /POINTER TO START OF DIR BLOCK
+       DCA XR
+       CDF 0
+       TAD I XR        /GET BLOCK NUMBER FIRST FILE
+       DCA BLOCK
+       TAD I XR        /NEXT SEGMENT NUMBER
+       DCA LFLAG       /IF IT 0 WE AT END
+       ISZ XR          /SKIP TENTATIVE FILE WORD
+       TAD I XR        /GET -NUMBER OF INFO WORDS
+       CIA             /MAKE POSITVE
+       DCA INFWDS
+       TAD XR          /POINT TO FIRST
+       IAC             /ENTRY
+       DCA EPTR
+
+BLOOP, TAD I EPTR      /GET FILENAME WORD
+       CDF 10
+       SNA CLA         /SKIP IF FILE HERE
+       JMP EMPTY       /NO... ITS REALLY AN EMPTY
+       TAD INSCNT      /SET NUMBER OF INPUT TO LOOK
+       DCA NCNT        /AT ALL AT ONCE
+       DCA MATFLG      /CLEAR MATCH FLAG
+       TAD INFPTR      /ADDRESS OF FIRST INPUT
+       SKP
+MN1,   TAD GPTR2       /ADDRESS OF CURRENT INPUT
+       TAD (5          /GTSXBT SUBR REQUIRES US TO
+       DCA GPTR2       /POINT TO END OF FIELD
+       TAD EPTR        /POINT DIRECTORY POINTER TO
+       TAD (4          /END OF ENTRY FOR SAME REASON
+       DCA GPTR1
+       TAD GPTR1       /SET EPNEXT TO POINT TO
+       TAD INFWDS      /MINUS NUMBER OF BLOCKS IN
+       DCA EPNEXT      /FILE WORD
+       TAD (-10        /NUMBER OF CHARS TO LOOK AT
+WILDNM,        DCA CNT
+\f
+MLP,   TAD GPTR2       /OK - GET A CHARACTER FROM
+       JMS I (GTSXBT   /STRING
+       TAD (-"*!7700   /IS IT AN *
+       SNA             /SKIP IF NOT *
+       JMP WILDA       /YEP... ITS A WILD CARD
+       TAD ("*-"?      /IS IT A ?
+       SNA             /SKIP IF NOT
+       JMP WILD        /YES... FORCE MATCH ON THIS CHAR
+       TAD ("?&77      /RESTORE VALUE
+       CIA             /NEGATE
+       DCA CHAR        /AND SAVE
+       TAD GPTR1       /NOW GET CHAR FROM DIRECTORY
+       CDF 0
+       JMS I (GTSXBT
+       CDF 10
+       TAD CHAR        /DO CHARS MATCH
+       SZA CLA         /SKIP IF THEY DO
+       JMP NM1         /NO MATCH ON THIS INPUT
+WILD,  ISZ CNT         /BUMP COUNT OF CHARS & POINTER
+       JMP MLP         /COMPARE ALL 8
+MEXT,  ISZ MATFLG      /A MATCH!!!!!!!
+NM1,   CLA             /WILD CARD COMES HERE WITH ICHY AC
+       ISZ NCNT        /HAVE WE CHECKED GROUP OF INPUTS
+       JMP MN1         /NO CHECK WHOLE GROUP
+       TAD MATFLG      /HAVE THERE BEEN ANY MATCHES
+       SZA CLA         /SKIP IF NOT
+       TAD (4          /WILL INVERT /V SWITCH
+       TAD I (OPT2     /ADD SWITCH
+       AND (4          /ISOLATE IT
+       CDF 0
+/SKIPS IF INPUT DIRECTORY ENTRY IS NOT CANDIDATE
+/THAT IS - IF A MATCH WAS NOT FOUND BETWEEN ANY
+/OF THE INPUTS AND /V WAS NOT SPECIFIED   OR
+/A MATCH WAS FOUND AND /V WAS SPECIFIED
+
+/THIS ALLOWS /V TO MEAN EVERYTHING BUT...
+
+       SZA CLA
+       TAD I EPNEXT    /GET -NUMBER OF BLOCKS
+       CDF 10
+       SZA             /SKIPS IF TENTATIVE OR NOT CANDIDATE
+       JMP I (GOT1     /PROCESS FILE
+NENT,  TAD EPNEXT      /POINT EPTR TO BLOCK
+       DCA EPTR        /COUNT OF FILE
+       JMP NEMPTY
+EMPTY, ISZ EPTR        /ON EMPTY MAKE EPTR POINT TO BLOCK COUNT
+       JMS I (HEMPTY   /HANDLE EMPTY SLOTS
+NEMPTY,        CDF 0
+       TAD I EPTR      /GET BLOCK COUNT
+       CIA             /MAKE POSITIVE
+       TAD BLOCK
+       DCA BLOCK       /KEEP SUM
+       ISZ EPTR        /POINT TO NEXT ENTRY
+       ISZ I BDPTR     /POINTS TO -NUMBER OF ENTRIES
+       JMP BLOOP       /NOT DONE WITH SEGMENT
+       CDF 10
+       TAD (400        /BUMP TO NEXT SEGMENT
+       TAD BDPTR
+       DCA BDPTR
+       TAD LFLAG       /DID WE PROCESS LAST SEGMENT
+       SZA CLA         /SKIP IF WE DID
+       JMP NBLOCK      /PROCESS NEW SEGNENT
+       JMP I (SAYNON
+\f
+/HANDLE WILD CARDS
+
+WILDA, TAD CNT         /GET CURRENT CHAR POSITION
+       TAD (6          /ADD SIZE OF FILENAME
+       SPA             /SKIP IF IN EXTENSION FIELD
+       JMP WILDNM      /THIS BUMPS TO EXTENSION
+       JMP MEXT        /THIS MEANS IT HAS TO BE A MATCH
+
+
+CHAR,  0
+EPNEXT,        0
+GPTR2, 0
+LFLAG, 0
+NCNT,  0
+BLOCK, 0
+MATFLG,        0
+
+
+       PAGE
+\fGOT1, DCA IFCNT       /-# OF BLOCKS IN AC
+       JMS I (DATCHK   /VERIFY /C AND /O SWITCHES
+       TAD (OUTCHR
+       DCA OSWTCH
+       TAD I (OPT2
+       SPA CLA
+       JMP I (NENT
+       JMS I (ADDINF   /SEE IF ADDITIONAL INFO WORDS
+       TAD I (OPT2
+       AND (100        /IS /R USED
+       SNA CLA
+       JMP NOR
+       TAD INFPTR      /FILL IN *.* FOR FILENAME
+       IAC
+       DCA TEMP
+       TAD (5200       /*
+       DCA I TEMP
+       ISZ TEMP
+       ISZ TEMP
+       ISZ TEMP        /POINT TO EXTENSION
+       TAD (5200       /.*
+       DCA I TEMP      /SUBSTITUTE IT
+NOR,   TAD GPTR1
+       CDF
+       JMS I (PNMSUB
+       TAD I (OPT1
+       RTL
+       SNL CLA
+       JMP SKPBLK
+       JMS I (CONVTP
+       TAD I (BLOCK
+       JMS BSPACE      /(MH) PATCH FOR /B/E
+SKPBLK,        TAD I (OPT1
+       AND (100
+       SZA CLA
+       JMP NODATE
+       TAD IFCNT
+       CIA
+       JMS I (PRNUM
+       TAD INFWDS
+       SNA CLA
+       JMP NODATE
+       CDF
+       TAD I GPTR1
+       CDF 10
+       JMS I (PDATE
+NODATE,        ISZ LNCNT       /IS LINE FILLED?
+       JMP MOROLN      /NO
+       JMS CRLF
+       TAD ALNCNT      /RESET COUNT
+       DCA LNCNT
+       JMP I (NENT
+MOROLN,        TAD (5          /OUTPUT 5 BLANKS
+       JMS I (BLANK
+       JMP I (NENT
+
+/BLANKS ROUTINE
+BLANK, 0
+       CIA
+       DCA BLTMP
+       JMS I (CONVTP
+       ISZ BLTMP
+       JMP .-2
+       JMP I BLANK
+BLTMP, 0
+
+
+ALNCNT,        0
+LNCNT, 0
+
+OUTCHR,        0
+       JMP I RPOS
+RPOS1, DCA I OCPTR
+       JMS RPOS
+RPOS2, DCA HOLD
+       JMS RPOS
+RPOS3, RTL
+       RTL
+       DCA HOLD2
+       TAD HOLD2
+       AND (7400
+       TAD I OCPTR
+       DCA I OCPTR
+       ISZ OCPTR
+       TAD HOLD2
+       RTL
+       RTL
+       AND (7400
+       TAD HOLD
+       DCA I OCPTR
+       ISZ OCPTR
+       ISZ OUWDCT
+       SKP
+       JMS DUMP
+       JMS RPOS
+       JMP RPOS1
+RPOS,  RPOS1
+       JMP I OUTCHR
+
+OUWDCT,        0
+OCPTR, 0
+HOLD,  0
+HOLD2, 0
+BSPACE,        0       /(MH) PATCH FOR /B/E
+       JMS I   (OPRNT
+       CLA!IAC
+       JMS I   (BLANK
+       JMP I   BSPACE
+
+       PAGE
+\f
+GTSXBT,        HLT
+       CLL RAL
+       TAD CNT
+       CML RAR
+       DCA TEMP
+       TAD I TEMP
+       SNL
+       JMS ROTR6
+       AND (77
+       JMP I GTSXBT
+
+
+ROTR6, 0
+       RTR
+       RTR
+       RTR
+       JMP I ROTR6
+
+CONVTP,        HLT
+       SZA
+       TAD (240
+       AND (77
+       TAD (240
+       JMS I OSWTCH
+       JMP I CONVTP
+
+TYPE,  HLT
+       DCA HOLD1
+       TAD (217
+       JMS I (CTYPE
+       SKP
+       DCA ECHO
+       TAD ECHO
+       SNA CLA
+       JMP I TYPE
+       JMS I (CINTER
+       SKP
+       JMP I (ABORT
+       TAD HOLD1
+       JMS TTY
+       JMP I TYPE
+
+HOLD1, 0
+
+TTY,   0
+       TLS
+       TSF
+       JMP .-1
+       TAD (-215
+       SZA CLA
+       JMP I TTY
+       TAD (12
+       JMP TTY+1
+
+ECHO,  1
+
+OPRNT, 0
+       DCA GTSXBT
+       TAD (-4
+       DCA CNT
+OPLP,  TAD GTSXBT
+       RTL CLL
+       RAL
+       DCA GTSXBT
+       TAD GTSXBT
+       RAL
+       AND (7
+       TAD (260
+       JMS I (CONVTP
+       ISZ CNT
+       JMP OPLP
+       JMP I OPRNT
+
+
+/ROUTINE TO MAKE SURE USER SPECIFIED
+//C AND /O SWITCHES CAUSE CORRECT MATCH WITH DATE
+
+DATCHK,        0
+       TAD I (OPT1     /CHECK /C
+       JMS MDATE
+       NOP             /RETURN HERE WITH AC=0 IF NO /C
+       SZA CLA         /RETURN HERE WITH AC=0 IF DATES MATCH
+       JMP I (NENT     /DATES DONT MATCH AND /C GIVEN
+       TAD I (OPT2     /CHECK /V
+       JMS MDATE
+       CMA CLA         /SET AC=-1 IF NO /V
+       SNA CLA         /RETURN HERE AC=0 IF DATES SAME
+       JMP I (NENT     /DATES SAME WITH /V-IGNORE FILE
+       JMP I DATCHK    /CONTINUE
+
+MDATE, 0               //O AND /V ARE AC2
+       RTL             /IS IT OPTION ON?
+       SMA CLA         /SKIP IF IT IS
+       JMP I MDATE     /NO- RETURN WITH 0 AC
+       ISZ MDATE       /SKIP RETURN
+       CDF 0
+       TAD I GPTR1     /GET DATE WORD
+       CIA
+       CDF 10
+       TAD I (DATE     /COMPARE WITH MONITORS, 0 IF =
+       JMP I MDATE
+
+       PAGE
+\f
+PRNUM, 0
+       DCA NUM
+       TAD (PWRTEN
+       DCA PTR
+PRNTLP,        ISZ MPNTCNT
+       SKP
+       AC4000
+       DCA PNTFLG
+       DCA DIG
+DIVLPY,        TAD I PTR
+       SNA
+       JMP I PRNUM
+       CLL
+       TAD NUM
+       SNL
+       JMP PRTDIG
+       DCA NUM
+       ISZ DIG
+       JMP DIVLPY
+PRTDIG,        CLA
+       TAD DIG
+       TAD PNTFLG
+       SNA
+STPBLK,        JMP PRBLNK
+       TAD (260
+       JMS I (CONVTP
+       CLA CLL CML RAR
+NXTPWR,        ISZ PTR
+       JMP PRNTLP
+PRBLNK,        JMS I (CONVTP
+       JMP NXTPWR
+
+NUM,   0
+PNTFLG,        0
+DIG,   0
+MPNTCNT,0
+
+PWRTEN,        -1750;-144;-12;-1;0
+
+PDATE, 0
+       SNA
+       JMP FDATE
+       DCA DATEY
+       TAD     DATNOW  /WAS A DATE ENTERED AT BOOT TIME?(MH)
+       SNA             /SKIP IF SO(MH)
+       JMP     FDATE   /NO -- DON'T PRINT DATE IF NOT ENTERED(MH)
+       AND     (7      /YES -- SAVE YR NEGATED(MH)
+       CMA!IAC         /(MH)
+       DCA     DATTMP  /SAVE THIS RESULT TEMP(MH)
+       ISZ I (STPBLK
+       JMS I (CONVTP
+       ACM3
+       DCA I (MPNTCNT
+       TAD DATEY
+       RTR
+       RAR
+       AND (37
+       JMS I (PRNUM
+       TAD ("-
+       JMS I (CONVTP
+       TAD DATEY
+       CLL RTL
+       RTL
+       RAL
+       AND (17
+       DCA PRNUM
+       TAD PRNUM
+       TAD PRNUM
+       TAD PRNUM
+       TAD (DATTAB-4
+       DCA XR
+       ACM3
+       DCA CNT
+       TAD I XR
+       JMS I OSWTCH
+       ISZ CNT
+       JMP .-3
+       TAD ("-
+       JMS I OSWTCH
+       TAD DATEY
+       AND (7
+       TAD     DATTMP  /ADD -ENTERED YR(MH)
+       CLL             /CLEAR LINK FOR FLAG USE(MH)
+       SZA!SMA!CLA     /SKIP AND CLEAR IF ENTERED YR BIGGER,SAME(MH)
+       CML             /SET LINK IF DIR YR BIGGER THAN ENETERED YR (MH)
+       TAD     DATEY   /GET DATE BACK(MH)
+       AND     (7      /GET THE YR(MH)
+       SZL             /SKIP IF ENTERED YR WAS BIG OR SAME(MH)
+       TAD     (-10    /SUBTRACT 10 OCTAL IF DIR YR WAS BIGGER(MH)
+       TAD     DATINC  /ADD DATE INCREMENT(MH)
+       TAD (106
+       JMS I (PRNUM
+       CLA CMA
+       TAD I (STPBLK
+       DCA I (STPBLK
+       JMP I PDATE
+FDATE, TAD I (LNCNT    /SEE IF AT END OF LINE?
+       IAC             /AC=0 NOW IF YES
+       SNA CLA         /OUT PUT SPACES TO FILL DATE SLOT
+       JMP I PDATE     /NO NEED FOR SPACES IF AT END OF LINE
+       TAD (12         /10 SPACES IS WHATS NEEDED
+       JMS I (BLANK
+       JMP I PDATE     /LEAVE
+
+DATEY, 0
+DATNOW,        0       /CURRENT DATE IF ONE WAS ENTERED(MH)
+DATINC,        0       /DATE ENXTENSION TO 1970 (0,10,20, OR 30) (MH)
+DATTMP,        0       /TEMP STORE (MH)
+
+       PAGE
+\f
+CTYPE, 0
+       DCA T2
+       TAD (200
+       KRS
+       CIA
+       TAD T2
+       SNA CLA
+       KSF
+       JMP I CTYPE
+       KCC
+       TAD ("^
+       JMS I (TTY
+       TAD T2
+       TAD (100
+       JMS I (TTY
+       TAD (215
+       JMS I (TTY
+       ISZ CTYPE
+       JMP I CTYPE
+
+T2,    0
+
+CINTER,        0
+       TAD (203
+       JMS CTYPE
+       JMP UPPCK
+       JMP SPURGE
+UPPCK, TAD (220
+       JMS CTYPE
+       JMP I CINTER
+       SKP
+SPURGE,        CMA
+       DCA I (ALTOPT
+       ISZ CINTER
+       JMP I CINTER
+
+HEMPTY,        0
+       CDF 0
+       TAD I EPTR
+       CDF 10
+       CIA
+       TAD ECOUNT
+       DCA ECOUNT
+       TAD I (OPT1
+       AND (200
+       SZA CLA
+       JMP LISTEM
+       TAD I (OPT2
+       SMA CLA
+       JMP I HEMPTY
+LISTEM,        TAD I (OPT1
+       AND (10         /IS /I GIVEN
+       SNA CLA         /IF YES PAD BY ADDIDTIONAL INFO WORDS
+       JMP EMSG
+       CLA CMA
+       TAD INFWDS      /NUMBER OF SPACES=5*(INFWDS-1)
+       DCA DFLAG
+       TAD DFLAG
+       RTL CLL
+       TAD DFLAG
+       SZA             /DONT OUTPUT 4096 BLANKS
+       JMS I (BLANK
+EMSG,  TAD (EMPTYM-1
+       DCA XR1
+       TAD (-11
+       DCA CNT
+EOLP,  TAD I XR1
+       JMS I (OUTCHR
+       ISZ CNT
+       JMP EOLP
+       TAD I (OPT1
+       RTL
+       SNL CLA
+       JMP SKIPES
+       JMS I (CONVTP
+       TAD I (BLOCK
+       JMS I   (BSPACE /(MH) PATCH FOR /B/E
+SKIPES,        CDF 0
+       TAD I EPTR
+       CDF 10
+       CIA
+       JMS I (PRNUM
+       ISZ I (LNCNT    /AT END OF LINE
+       JMP WORK        /NO. HAVE TO DO BLANK PADDING
+       JMS I (CRLF
+       TAD I (ALNCNT   /RESET COUNT
+       DCA I (LNCNT
+       JMP I HEMPTY
+WORK,  TAD (5          /FORCES 5 BLANKS
+       JMS I (BLANK
+       TAD I (OPT1
+       AND (100        /CHECK FOR /F
+       SZA CLA         /ADD 10 SPACES TO COVER DATE
+       JMP I HEMPTY
+       TAD (12
+       JMS I (BLANK
+       JMP I HEMPTY
+
+ECOUNT,        0
+
+       PAGE
+\f
+PNMSUB,        0
+       DCA NMEPLC
+       RDF
+       TAD (CDF
+       DCA FLDFUD
+       TAD (-10
+       DCA CNT
+PNLOOP,        TAD NMEPLC
+FLDFUD,        HLT
+       JMS I (GTSXBT
+       CDF 10
+       JMS I (CONVTP
+       TAD (3
+       TAD CNT
+       SZA CLA
+       JMP .+3
+       TAD (".
+       JMS I OSWTCH
+       ISZ CNT
+       JMP PNLOOP
+       JMP I PNMSUB
+
+NMEPLC,        0
+
+WRTERR,        JMS I (ERROR
+       OUERR+40
+       JMP I (EOLIN
+CLOERR,        JMS I (ERROR
+       CLERR+40
+       JMP I (EOLIN
+NOROOM,        JMS I (ERROR
+       SPRBLM+40
+       JMP I (EOLIN
+IDBLVT,        JMS I (ERROR
+       NOTTY+40
+       JMP I (EOLIN
+
+SAYNON,        TAD (OUTCHR
+       DCA OSWTCH
+       JMS I (CRLF
+       JMS I (CRLF
+       TAD (-4         /FORCE PRINTING OF ONLY 1 DIGIT
+       DCA I (MPNTCNT  /FOR 0 FREE BLOCKS
+       TAD I (ECOUNT
+       JMS I (PRNUM
+       JMS I (CONVTP
+       TAD (FRBLM-1
+       DCA XR1
+       TAD (-13
+       DCA CNT
+FRBLP, TAD I XR1
+       JMS I (OUTCHR
+       ISZ CNT
+       JMP FRBLP
+       JMS I (CRLF
+       TAD (14         /FORM FEED
+       JMS I (OUTCHR
+       TAD MOIN
+       JMP I (DOMOIN
+
+MOIN,  0
+
+CRLF,  0
+       TAD (215
+       JMS OUTCHR
+       TAD (212
+       JMS OUTCHR
+       JMP I CRLF
+
+/ROUTINE TO DUMP ADDITIONAL INFO WORDS IF WANTED
+
+ADDINF,        0
+       TAD I (OPT1
+       AND (10         /CHECK /I SWITCH
+       SNA CLA
+       JMP I ADDINF
+       CLA CMA
+       TAD INFWDS      /GET NUMBER
+       SPA SNA         /MUST BE 2 OR MORE TO PRINT
+       JMP CLARET      /RETURN
+       CIA
+       DCA CNTX
+       TAD GPTR1
+       IAC             /BUMP TO FIRST ONE
+       DCA PGPTR1
+ADDLP, CDF 0
+       TAD I PGPTR1    /GET WORD
+       CDF 10
+       JMS I (OPRNT    /PRINT IT IN OCTAL
+       JMS I (CONVTP   /OUTPUT A BLANK
+       ISZ PGPTR1      /BUMP
+       ISZ CNTX        /COUNT NUMBER
+       JMP ADDLP
+CLARET,        CLA             /RETRN
+       JMP I ADDINF
+
+PGPTR1,        0
+CNTX,  0
+
+       PAGE
+\f
+VERNO, TEXT /DIRECT V6A /
+BADIRD,        TEXT /ERROR READING INPUT DIRECTORY/
+SPRBLM,        TEXT /NO ROOM FOR OUTPUT FILE/
+OUERR, TEXT /ERROR WRITING FILE/
+CLERR, TEXT /ERROR CLOSING FILE/
+NFLEIN,        TEXT /DEVICE DOES NOT HAVE DIRECTORY/
+BIGEQ, TEXT /EQUALS OPTION BAD/
+ILLQ,  TEXT /ILLEGAL ?/
+ILLA,  TEXT /ILLEGAL */
+BADDIR,        TEXT /BAD INPUT DIRECTORY/
+NOTTY, TEXT /THERE IS NO HOPE-THERE IS NO TTY HANDLER IN YOUR SYSTEM/
+EMPTYM,        "<;"E;"M;"P;"T;"Y;">;240;240
+FRBLM, "F;"R;"E;"E;240;"B;"L;"O;"C;"K;"S
+
+       "B;"A;"D        /PROTECTION AGAINST BAD DATE
+DATTAB, "J;"A;"N
+       "F;"E;"B
+       "M;"A;"R
+       "A;"P;"R
+       "M;"A;"Y
+       "J;"U;"N
+       "J;"U;"L
+       "A;"U;"G
+       "S;"E;"P
+       "O;"C;"T
+       "N;"O;"V
+       "D;"E;"C
+       "B;"A;"D        /PROTECTION AGAINST BAD DATE
+       "B;"A;"D        /PROTECTION AGAINST BAD DATE
+       "B;"A;"D        /PROTECTION AGAINST BAD DATE
+
+DUMP,  0
+       TAD I (LENGTH   /GET LENGTH AVAILABLE
+       SNA             /IF ZERO ITS NON FILE STRUCTURE
+       JMP NOMATR      /IF ZERO DOESNT MATTER
+       CLL
+       TAD I (CLEN     /ADD CURRENT SIZE
+       TAD (5          /ADD # OF BLOCKS
+       SZL CLA         /WE ARE OK IF SKIPS
+       JMP I (NOROOM
+       TAD I (CLEN     /UPDATE CLOSING LENGTH
+       TAD (5          /BY NUMBER OF BLOCKS
+       DCA I (CLEN     /SAVE FOR CLOSE
+NOMATR,        TAD OUWDCT
+       TAD (5210
+       DCA CTLWD
+       CIF 0
+       JMS I OUHAND
+CTLWD, 5210
+BUFAD, BUF
+BLCKN, 0
+       JMP WRTERR
+       TAD (5
+       TAD BLCKN       /UPDATE BLOCK # BY 5
+       DCA BLCKN
+       TAD (-1200
+       DCA OUWDCT
+       TAD BUFAD
+       DCA OCPTR
+       JMP I DUMP
+/
+\f
+       *4600
+
+       JMS INIT
+       JMS INIT
+       JMP I (2000
+       JMP I (2001
+INIT,  0
+       ISZ INIT
+       CLA CLL
+       TAD (2000
+       CDF 0
+       DCA I (7745
+       TAD (6403
+       DCA I (7746
+       CDF 10
+       JMP I INIT
+       $
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape6/MCPIP.PA b/sw/os8/v3d/sources/system/dectapes/dectape6/MCPIP.PA
new file mode 100644 (file)
index 0000000..283216c
--- /dev/null
@@ -0,0 +1,2344 @@
+/7     OS/8 MCPIP                              MAGTAPE AND CASSETTE PIP
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f
+/      S.R.
+
+/      REVISED FEB. 11, 1974
+/      SECOND REVISION: 7-AUG-75
+
+
+/1.    INSTALLED PATCH SEQ #1 , SEPT. 1974 DSN
+/      (NOW TRANSFERS LAST 2 BYTES CORRECTLY IN IMAGE MODE)
+/2.    BUMPED VERSION NUMBER TO V5
+/3.    FIXED /L BUG IF DEVICE NOT MAGTAPE OR CASSETTE
+
+       KCLR=6700       /CLEAR ALL
+                       /CLEAR STATUS A AND B REGISTERS.
+       KSDR=6701       /SKIP ON DATA FLAG
+       KSEN=6702       /SKIP ON ERROR
+       KSBF=6703       /SKIP ON READY FLAG
+       KLSA=6704       /LOAD STATUS A FROM AC 4-11
+                       /CLEAR AC, THEN
+                       /LOAD 8 BIT COMPLEMENT OF STATUS A
+                       /BACK INTO AC
+       KSAF=6705       /SKIP ON ANY FLAG OR ERROR
+       KGOA=6706       /ASSERT THE CONTENTS OF STATUS A,
+                       /TRANSFER DATA IF READ OR WRITE
+       KRSB=6707       /READ STATUS B INTO AC 4-11
+
+
+       FIXMRI CALL=4400
+       FIXMRI EXIT=5400
+       FIXMRI INCR=2000
+
+/CORE ALLOCATION
+
+/00000-01777   COMMAND DECODER
+/02000-02377   OUTPUT HANDLER
+/02400-02777   INPUT HANDLER
+/03000-03777   CASSETTE OUTPUT BUFFER
+/04000-04777   CASSETTE INPUT BUFFER
+/05000-05577   STAND ALONE CASSETTE HANDLER
+/05600-07577   LOOKUP, ENTER, CLOSE
+/07600-07777   OS/8
+
+/10000-11777   USR
+/12000-14577   PIPC
+/14600-17577   OS/8 INPUT/OUTPUT BUFFER
+/17600-17777   OS/8
+\f/USR HAS THE FOLLOWING FREE LOCATIONS:
+/0-6
+/10-17 (BUT GET DESTROYED)
+/20-37
+
+       TEMP=20
+       TEMP1=21
+       TEMP2=22
+       TEMP3=23
+
+/      STARTING ADDRESS = 12000
+/      JOB STATUS WORD = 6003
+
+       INHAND=2400
+       OUTHAND=2000
+       COBUF=3000
+       CIBUF=4000
+
+       PIPVERSION=6
+       PATCHLEV=77&"A
+       SPCODE=6
+       CLCODE=0
+       REWCOD=1
+       FICODE=3
+       EOCODE=5
+       RECCOD=2
+\f/V3 CHANGES:
+
+/1.    SHRUNK 0S/8 BUFFER TO 3000 WORDS
+/2.    ADDED VERSION NUMBER (/V)
+/3.    MADE INDEPENDENT OF MAGIC LOCATIONS IN CASSETTE HANDLER
+/4.    ADDED MAGTAPE SUPPORT OF CASSETTE FILE STRUCTURE
+/5.    ALTMODE MEANS RETURN TO KBM
+/6.    ^C DOESN'T CLOSE CASSETTES UNLESS WE ALREADY WROTE ON IT
+/7.    FIXED BUG THAT CSA2 THRU CSA7 DIDN'T WORK
+/8.    CR ALONE TO CD GIVES NO ERROR MESSAGE
+/9.    ADDED ^O AND ^C SUPPORT TO MESSAGE PRINTOUT
+/10.   GIVE ERRORS ON ILLEGAL * OR ? IN NAME
+/11.   USES TTY: AS DEFAULT OUTPUT DEVICE ON /L
+
+/PROPOSED:
+/8.    ALLOW *.* FOR CASSETTE INPUT
+/9.    SUPPORT OF UNLABELED MAGTAPE STANDARD
+/10.   /7 OR /9 SPECIFIES CHANNEL
+
+/FIXES SINCE FIELD TEST :
+
+/1.    ^C ALWAYS BRINGS YOU BACK TO KBM
+/2.    FIXED BUG RE CHECK FOR FILE FULL
+/3.    MADE COMPATIBLE WITH NEW TM8E HANDLER
+/4.    TIME-OUT ON CASSETTE READ
+/5.    BE NICE-GUY IF OS/8 LOOKUP FAILURE
+\f/THIS ROUTINE LEAVES WITH INTERRUPTS OFF AND DEVICE SELECTED
+/AND READY.
+/THE NEW UNIT NUMBER (0-7) IS IN THE AC.
+/THE UNIT  NUMBER IS IN BITS 8-11 OF THE AC.
+/RETURN 1 IS MADE IF THE UNIT IS NOT READY.
+/CINUSE IS SET TO 1.
+/THE HANDLER MUST NOT ALREADY BE IN USE.
+/THE DATA FIELD IS INTERROGATED
+/AND A RETURN CIF CDF IS BUILT
+/AND STORED IN LOCATION RETCIF
+
+\f      *5000
+
+FIXDVC,        0
+       DCA DVC
+       RDF
+       TAD (CIF CDF
+       CDF 0
+       DCA TMP
+       TAD I FIXDVC
+       DCA ERRET
+       ISZ FIXDVC
+       TAD TMP
+       DCA I ERRET
+       TAD DVC
+       SNA
+       JMP CHECKR
+       RAR             /MOVE UNIT TO LINK; DEVICE TO AC
+       AND (3          /MASK OFF DEVICE CODE
+       DCA DVC         /SAVE DEVICE CODE
+       SZL
+       TAD (100
+       DCA I (ABUNIT   /SET UNIT IN BIT 5
+       TAD DVC
+       CLL RTL
+       RAL             /UGLY
+       DCA DVC         /MOVE TO BITS 6-8
+       TAD (IOTBL
+       DCA IOTPTR
+IOTLOOP,TAD I IOTPTR
+       SNA             /END OF TABLE?
+       JMP CHECKR      /YES
+       DCA TMP
+       TAD I TMP
+       AND (7707       /MASK OUT OLD DVC
+       TAD DVC         /INSERT NEW ONE
+       DCA I TMP       /REPLACE
+       ISZ IOTPTR      /POINT TO NEXT ONE
+       JMP IOTLOOP
+
+TMP,   0
+DVC,   0               /DEVICE CODE
+IOTPTR,        0
+\fCHECKR,       JMS I (CLEAR
+       TAD (200
+       JMS I (LOADA    /SELECT DRIVE
+       JMS I (CHECKB
+       AND (7735       /IGNORE EOT/BOT FLAG
+                       /AND WLO
+       TAD (-1
+       SZA CLA
+       JMP I ERRET     /NOT READY
+       ISZ I (CINUSE
+       JMP I FIXDVC
+
+ERRET, 0               /ERROR RETURN LOCATION
+\fFIDDLE,       0
+       CIF 10
+       JMS I (FID2     /NEED ROOM
+       TAD (CIBUF+11
+       DCA 10
+       TAD FAST
+       SZA CLA
+       JMP DIREOL
+       TAD (40
+       DCA I 10
+       TAD I (CIBUF+20
+       DCA I 10
+       TAD I (CIBUF+20
+       AND (177
+       SZA
+       TAD (-40
+       SZA CLA
+       TAD ("/-40
+       TAD (40
+       DCA SLSH
+       TAD I (CIBUF+21
+       DCA I 10
+       TAD SLSH
+       DCA I 10
+       INCR 10
+       INCR 10
+       TAD SLSH
+       DCA I 10
+       TAD I (CIBUF+22
+       DCA I 10
+       TAD I (CIBUF+23
+       DCA I 10
+DIREOL,        TAD (15
+       DCA I 10
+       TAD (12
+       DCA I 10
+       TAD (32
+       DCA I 10
+FIDLV, EXIT FIDDLE
+
+/0 1 2 3 4 5 6 7 10 11 12 13 14 15 16 17 20 21 22 23 24 25
+/F I L E N A M E S                  D  D  M  M  Y  Y
+/F I L E N A . M E S       M  M  /  D  D  /  Y  Y CR LF ^Z
+
+FAST,  0               /0 MEANS F NOT SPECIFIED
+\fSLSH, "/
+
+IOTBL, IOT0
+       IOT1
+       IOT4
+       IOT5
+       IOT6
+       IOT6C
+       IOT7
+       0
+       PAGE
+\fUTIL, 0
+       DCA TEMPU
+       DCA REWSW       /ZERO REWIND SWITCH
+       TAD I UTIL
+       TAD (-10
+       SNA
+       ISZ REWSW
+       ISZ UTIL
+       TAD (210
+       DCA TEMPFN
+       TAD TEMPU
+       JMS I (FIXDVC   /FIX DEVICE CODE
+       UTEND           /UNIT NOT READY
+       TAD (UT
+       DCA CRET        /SET RETURN ADDRESS
+       STA
+       DCA I (RW       /NOTE FACT THAT OP AINT READ
+       TAD TEMPFN
+       JMS I (LOADA
+       JMS GO          /INITIATE UTIL
+       JMP CRET+1
+       ISZ UTIL
+UTEND, HLT
+       JMP I UTIL
+UT,    JMS CHECKB      /LOOK AT STATUS B
+       AND (50         /CHECK FOR CL, EMPTY, OR WLO
+                       /GIVE NO ERROR ON WLO ************
+                       /BAD FOR WRGAP
+       SNA
+       JMP OK          /NO ERRORS
+       TAD (-40
+       SZA CLA
+       JMP NOTOK       /ERROR NOT CL
+       TAD REWSW
+       SNA CLA         /CL OK IF DID REWIND
+NOTOK, STA
+OK,    JMS CLEAR
+       TAD CINUSE
+       SMA CLA
+       JMP UTEND-1
+       TAD BSTATE      /ERROR
+       JMP UTEND
+
+TEMPU, 0
+TEMPFN,        0
+REWSW, 0               /1 MEANS OPERATION IS REWIND
+\fCHECKB,       0
+IOT7,  KRSB            /READ STATUS B INTO AC 4-11
+       DCA BSTATE      /SAVE STATUS B
+       TAD BSTATE
+       JMP I CHECKB
+
+CLEAR, 0
+       DCA CINUSE      /LEAVE STATUS CONDITION IN AC; -1 MEANS  ERROR
+IOT0,  KCLR            /CLEAR STATUS A AND B
+       JMP I CLEAR
+
+GO,    0
+IOT6,  KGOA            /ASSERT CONTENTS OF STATUS A
+       CLA
+       JMP I GO
+
+CHK,   0
+       JMS I (CHECKB
+       AND (374
+IOT1,  KSDR
+       SKP             /DATA FLAG NOT UP -
+       JMP I CHK
+       TAD (-20
+       SNA CLA         /IS IT END OF FILE?
+       JMP I (ERRR     /YES, ERROR - BUT DON'T RETRY
+       TAD BSTATE
+       JMP I CHK
+
+CINUSE,        0               /1 MEANS HANDLER IN USE
+BSTATE,        0               /STATUS OF REGISTER B ON ERROR
+\fDTEM, 0
+
+DOPTION,JMS I (CONVRT
+       7601
+       DCA DTEM
+       TAD I (OUNIT
+       JMS I (LOOKUP
+       JMP I (XER4
+       JMP MBNF        /NOT FOUND
+       INCR DTEM
+       JMS I (DELET
+       JMP I (XER77    /OUTPUT ERROR
+MBNF,  TAD DTEM
+       SNA CLA         /ANYTHING DELETED?
+       JMP I (XER24    /NO
+       JMS UTIL
+       REWIND
+       CLA
+       CIF CDF 10      /YES
+       JMP I (DECODE
+\fCRET, 0
+       CDF 0
+       TAD (-200       /COUNT OF HOW LONG TO WAIT
+       DCA I (OUTER
+IOL,   JMS I (CTRLC
+       JMS I (TIMEOUT
+IOT5,  KSAF
+       JMP IOL
+       EXIT CRET
+       PAGE
+\fHANDLER,0
+       DCA TUN
+       TAD I HANDLER   /GET FUNCTION CONTROL WORD
+       AND L70         /ISOLATE FIELD OF BUFFER
+       TAD LCDF
+       DCA WCDF
+       TAD I HANDLER   /RETRIEVE FUNCTION CONTROL WORD
+       RAL             /READ/WRITE BIT TO LINK
+       CLA RAL
+       DCA RW          /RW=1 IF WRITE
+       ISZ HANDLER     /POINT TO BUFFER ADDRESS
+       TAD I HANDLER   /GET BUFFER ADDRESS
+       DCA BUFFER      /SAVE IT
+       ISZ HANDLER     /POINT TO ERROR RETURN
+       TAD TUN
+       JMS I (FIXDVC
+       LV              /NOT READY
+       TAD WCDF
+       DCA BFIELD
+       TAD WCDF
+       DCA BFLD
+       STA CLL RTL     /TAD (-3
+       DCA ERKNT
+       JMS     SETUP   /SET UP READ OR WRITE
+       JMP I (CRET+1
+       ISZ HANDLER     /POINT TO GOOD RETURN
+LV,    HLT
+       JMP I HANDLER
+RW,    0               /1 IF WRITE (-1 IF UTIL)
+ERKNT, -3
+\fSETUP,        0
+       TAD RW
+       TAD (WRITEX
+       DCA I (CRET     /SET RETURN ADDRESS
+       TAD BUFFER
+       DCA BPTR
+       TAD BSIZE
+       CMA             /WANT TO READ ONE MORE
+       TAD RW
+       DCA BKNT
+       TAD RW
+       DCA OUTSW
+       TAD RW
+       CLL RTL
+       RTL             /WRITE FN CODE=20
+       TAD (200        /SELECT AND INTERRUPT ENABLE
+       JMS I (LOADA
+WCDF,  HLT
+       TAD RW
+       SZA CLA
+       TAD I BPTR
+LCDF,  CDF 0
+       JMS I (GO
+       JMP I   SETUP
+
+\fREADX,        JMS I (CHK
+       AND L374
+       SZA
+       JMP ERRX
+IOT6C, KGOA            /GET CHAR JUST READ
+       DCA BYTE
+       ISZ BKNT
+       SKP
+       JMP RWCRC
+BMODE, TAD BYTE
+TUN,
+BFLD,  HLT
+       DCA I BPTR
+       ISZ BPTR
+L374,  374
+       JMP I (CRET+1   /CRET ALREADY SET UP
+
+BSIZE, 200
+OUTSW, 0               /1 MEANS WE BEGAN TO WRITE
+\fRWCRC,        TAD (260        /ENABLE, ENABLE INTER, READ CRC
+       JMS I (LOADA
+       JMS I (GO
+       JMS I (CRET
+       JMS I (CHK
+CRCMN, JMS I (GO
+       JMS I (CRET
+       JMS I (CHECKB
+       AND (7775       /IGNORE WLO
+       TAD (-1
+ERRX,  SNA CLA         /ERRORS?
+       JMP     ERRR+1  /NO - CLEAN BILL OF HEALTH
+       ISZ     ERKNT   /TRY 3 TIMES
+       JMP I   (ERRCOV /RETRY
+ERRR,  STA             /ERROR WHILE READING CRC
+       JMS I (CLEAR
+       TAD I (CINUSE
+       SMA CLA
+       JMP LV-1
+       TAD I (BSTATE
+       JMP LV
+\fWRITEX,       JMP READX
+       JMS I (CHK
+       SZA
+       JMP ERRX
+       ISZ BKNT
+       SKP
+       JMP WCRC
+BFIELD,        HLT
+       ISZ BPTR
+L70,   70
+       TAD I BPTR
+       JMS I (GO
+       JMP I (CRET+1
+
+
+WCRC,  TAD (260
+       JMS I (LOADA
+       JMP CRCMN
+BKNT,  0               /NUMBER OF CHARS EXPECTED
+BPTR,  0               /NEXT LOCATION IN BUFFER TO STORE INTO
+BYTE,  0               /TEMPORARILY HOLDS BYTE FOUND
+BUFFER,        0
+       PAGE
+\f/ LOOKUP, ETC.
+
+       F1=10
+       READ=0
+       WRITE=4000
+
+       REWIND=10
+       BACKFIL=30
+       WRGAP=40
+       BACKBLOCK=50
+       SKPFIL=70
+
+       HSIZE=40
+       OBUFFER=4600    /LOCATION OF OS/8 I/O BUFFER
+       BINBUF=OBUFFER
+       OBUFLEN=3000
+       HOBUFLEN=OBUFLEN%2
+       MAXBLK=OBUFLEN%400
+
+FILNUM,        0
+/      ENTER
+
+/      TAD UNIT
+/      JMS I (ENTER
+/      <ERROR RETURN>
+/      <NORMAL RETURN>
+
+/      ENTER FILENAME AS SPECIFIED IN SINCH
+/      USER MUST SET SINCH BUT ONLY FIRST 25 (OCTAL) LOCATIONS.
+
+ENTER, 0
+       JMS I (LOOKUP
+       JMP ERET        /ERROR WHILE READING
+       JMP NTF
+       JMS I (DELET
+       JMP ERET        /ERROR WHILE DELETING
+NTF,   JMS BACK
+       JMP ERET        /ERROR BACKING UP
+       JMS I QH1       /WRITE NEW HEADER
+       WRITE
+       SINCH
+       JMP ERET        /CASSETTE NOT READY
+       TAD I (RECSIZ
+       DCA I (BSIZE
+       INCR ENTER
+ERET,  EXIT ENTER
+
+RDOR,  0
+       AND (374        /CASSETTE ONLY
+       TAD (-200
+       SZA CLA         /WAS ERROR JUST CRC?
+       EXIT BACK       /NO
+       EXIT RDOR       /YES, OK CONTINUE
+\fBACK, 0
+BK4,   JMS I QU1
+BK2,   BACKFIL         /GO BACK TO FILE GAP
+       EXIT BACK
+BK3,   JMS I QU1
+       BACKBLOCK       /BACK TO LAST RECORD
+       JMP BKERR
+       TAD I (RECSIZ
+       DCA I (BSIZE
+       JMS I QH1       /READ LAST RECORD OF PREV FILE
+       READ+F1         /DON'T STORE IN BUFFER
+       BINBUF
+       JMS RDOR        /^*******
+                       /ERROR READING LAST BLOCK
+NEWGAP,        JMS I QU1
+       WRGAP           /WRITE A NEW GAP
+       EXIT BACK
+BK9,   TAD (HSIZE
+       DCA I (BSIZE
+       INCR BACK
+       EXIT BACK
+
+BKERR, AND (3775       /CASSETTES ONLY
+       TAD (-41
+       SZA CLA         /WAS ERROR CLEAR LEADER?
+       EXIT BACK
+       JMP NEWGAP
+
+BK1,   JMP BK9
+
+/FOR MAGTAPES:
+
+/BK2_BACKBLOCK
+/BK3_BK1
+\fCLOSE,        0
+       JMS I QU1
+       WRGAP
+       JMP CLRET       /ERROR WHILE WRITING GAP
+       TAD (HSIZE
+       DCA I (BSIZE
+       JMS I QH1
+       WRITE           /WRITE SENTINEL
+       ZER
+       JMP CLRET
+       JMS I QU1
+       REWIND
+       JMP CLRET
+       INCR CLOSE      /SKIP ERROR RETURN
+CLRET, EXIT CLOSE
+\fCRED, 0
+       TAD I (INRECSZ
+       DCA I (BSIZE
+       TAD I (IUNIT
+       JMS I QH1
+       READ
+       CIBUF
+       JMP INER
+       TAD (CIBUF
+       DCA I (CIPTR
+       TAD I (INRECSZ
+       CIA
+       DCA I (CIKNT
+/      CLA IAC
+/      DCA DATAFLG
+       EXIT CRED
+INER,  AND EOFBIT
+       SZA CLA         /REAL ERROR?
+       JMP I (XER4     /YES
+/      TAD DATAFLG
+/      SNA CLA         /READ ANY DATA?
+/      JMP INTO        /NO REWIND
+/      DCA DATAFLG     /YES, COULD CLOSE OUTPUT AND OPEN NEXT INPUT
+INTO,  CLA
+       TAD I (IUNIT
+       JMS I QU1
+       REWIND
+       CLA
+       TAD I (BIPTR
+       CIF CDF 10      /NO, MERELY END-OF-FILE
+       TAD (-OBUFFER+377
+       CLL RTL
+       RTL
+       RAL
+       AND (17
+       DCA I (INTEN    /NUMBER OF BLOCKS GOT
+       JMP I (XFIN
+
+LOADA, 0
+       TAD ABUNIT
+IOT4,  KLSA
+       CLA
+       JMP I LOADA
+
+EOFBIT,        254             /CHANGED TO 3673 FOR MAGTAPE
+/DATAFLG,0             /1 MEANS READ DATA
+\fQU1,  UTIL
+QH1,   HANDLER
+ABUNIT,        0
+       PAGE
+\f
+/      LOOKUP
+
+/      TAD UNIT
+/      JMS I (LOOKUP
+/      I/O ERROR RETURN
+/      <NOT FOUND RETURN>
+/      <FOUND RETURN>
+/      ALWAYS LOOKS FOR THING SPECIFIED IN SINCH
+
+LOOKUP,        0
+       DCA P1
+       CDF 10
+       TAD I (7644
+       CDF 0
+       AND (10         /IS /U SPECIFIED?
+       SZA CLA
+       JMP GOODRT      /YES, DO NOTHING
+       TAD P1
+       JMS I QU2
+       REWIND
+       JMP ERRIT
+       TAD (HSIZE      /SET LENGTH OF RECORD HEADER
+       DCA I (BSIZE
+       DCA I (FILNUM
+FL1,   JMP FL2         /ZERO THIS LOCATION FOR MAGTAPES
+FLOOP, JMS I QU2
+       SKPFIL
+       JMP ERRIT
+FL2,   INCR I (FILNUM
+       JMS I QH2
+       READ
+       INCH
+       JMP ERRIT
+       TAD (INCH
+       DCA P1
+       TAD I P1
+       SNA CLA         /SENTINEL FILE?
+       JMP NFNDRET     /YES, NOT FOUND
+       TAD (SINCH      /NO, IS THIS THE ONE WANTED?
+       DCA P2
+       TAD (-10
+       DCA SCNT
+\fSLOOP,        TAD I P1
+       CIA
+       TAD I P2
+       AND (177        /ONLY LAST 7 BITS NEED MATCH
+       SZA CLA
+       JMP FLOOP       /FILE KEY NOT ONE DESIRED
+       INCR P1
+       INCR P2
+       ISZ SCNT
+       JMP SLOOP
+GOODRT,        INCR LOOKUP     /SKIP NOT FOUND RETURN
+NFNDRET,INCR LOOKUP    /SKIP ERROR RETURN
+ERRIT, CLA
+       TAD I (RECSIZ
+       DCA I (BSIZE    /BE NICE TO USER
+LRET,  EXIT LOOKUP     /BYE-BYE
+
+ERRT,  AND EOTBIT      /REAL ERROR?
+       SZA CLA
+       JMP ERRIT       /YES
+       JMP NFNDRET     /NO, MERELY END-OF CASSETTE
+
+/END OF CASSETTD IS SIGNALLED BY
+
+/A     SENTINEL FILE
+/B     DOUBLE FILE GAP
+/C     EOT
+
+EOTBIT,        314             /CHANGE TO 3663 FOR MAGTAPE
+\fP1,   0
+P2,    0
+SCNT,  0
+DELET, 0
+       JMS I (BACK
+       EXIT DELET
+       JMS I QH2       /WRITE EMPTY HEADER
+       WRITE+10
+       EMPTINCH
+       EXIT DELET      /ERROR WHILE DELETING
+       CLL STA RAL     /-2
+       TAD LOOKUP
+       DCA LOOKUP
+       JMP FLOOP       /JUMP INTO LOOKUP TO CONTINUE
+ZER,   0
+
+QH2,   HANDLER
+QU2,   UTIL
+FL3,   JMP FL2
+\fERRCOV,       JMS I (CLEAR
+       JMS I (CTRLC
+       TAD     (250
+       JMS I   (LOADA
+       JMS I   (GO     /BACKSPACE BLOCK
+       JMS I   (CRET   /WAIT
+       JMS I   (CHECKB
+       AND     (374    /KILL WRITE-LOCK BIT
+       SZA CLA
+       JMP I   (ERRR
+       JMS I   (SETUP  /RE-SET UP OPERATION
+       JMP I   (CRET+1 /GO AWAY
+\fTIMEOUT,0
+       ISZ INNER
+       JMP I TIMEOUT
+       ISZ OUTER
+       JMP I TIMEOUT
+       TAD I (RW       / I/O HAS TAKEN A LOT OF TIME
+       SZA CLA         /IS IT A READ OP?
+       JMP I TIMEOUT   /NO, RETURN
+       JMP I (ERRR     /YES, ERROR
+
+INNER, 0
+OUTER, -200
+       PAGE
+\f/SEND CONTENTS OF OS/8 BUFFER TO CASSETTE
+/VIA CASSETTE OUTPUT BUFFER
+
+CWRITE,        0
+       TAD (OBUFFER
+       DCA BUPTR       /PT TO BEGIN OF BUFFER
+       CDF 10
+       TAD I (INTEN    /GET NO. OF BLOCKS READ
+       SNA
+       JMP CWLV
+       CDF 0
+       CLL RTR
+       RTR
+       RAR             /CONVERT TO WORDS
+       IAC
+       AND (7776       /ROUND UP TO EVEN NO.
+       CLL RAR         /DIVIDE BY TWO
+       CIA             /USE AS COUNT OF DOUBLE-WORDS
+       DCA BUKNT       /2000 TWO-WORD ENTRIES
+CWLOOP,        CDF 10
+       TAD I BUPTR
+       JMS CWR         /SENT TO CASSETTE OUTPUT BUFFER
+       CDF 10
+       TAD I BUPTR
+       AND (7400
+       DCA TEMP1
+       INCR BUPTR      /PT TO 2ND HALF
+       TAD I BUPTR
+       JMS CWR
+       CDF 10
+       TAD I BUPTR
+       AND (7400
+       CLL RTR
+       RTR
+       TAD TEMP1
+       RTR
+       RTR
+       JMS CWR
+       INCR BUPTR      /PT TO NEXT DOUBLE-WORD
+       ISZ BUKNT       /AT END OF BUFFER?
+       JMP CWLOOP      /NO
+CWLV,  CIF CDF 10
+       EXIT CWRITE     /YES, RETURN
+BUPTR, 0               /PTS INTO OBUUFER
+BUKNT, 0
+\f/INSERT CHAR IN CASSETTE OUTPUT BUFFER
+/AND OUTPUT BUFFER IF BUFFER FULL
+
+CWR,   0
+       AND (377
+       CDF 0
+       DCA CWTMP
+       TAD LDRFLG
+       SZA CLA
+       JMS I (LDRTST
+       CDF 10
+       TAD I (7643
+       RTL             /PUT /B OPTION IN LINK
+       CDF 0
+       SNL CLA
+       JMP GOK
+       TAD CWTMP
+       TAD M200
+       SNA CLA
+       JMP I (PREFIN
+GOK,   TAD CWTMP2
+       JMS CWR2
+       TAD CWTMP1
+       DCA CWTMP2
+       TAD CWTMP
+       DCA CWTMP1
+CWREX, EXIT CWR
+
+CWR2,  0
+       SPA
+       JMP CWRIGN      /IGNORE -1
+       CDF 0
+       DCA I COPTR     /INSERT CHAR IN COBUF
+       INCR COPTR
+       ISZ COKNT       /COBUF FULL?
+       EXIT CWR2       /NO, SO RETURN
+       JMS CWRI
+M200,
+CWRIGN,        7600            /CLA
+       EXIT CWR2
+\fCWRI, 0
+       TAD COKNT
+       TAD RECSIZ
+       SNA CLA
+       EXIT CWRI       /DO NOTHING IF BUFFER EMPTY
+       TAD RECSIZ
+       DCA I (BSIZE
+       TAD I (OUNIT
+       JMS I QH3       /YES, WRITE OUT BUFFER
+       WRITE           /WRITE FROM FIELD 0
+PCOBUF,        COBUF           /LOCATION COBUF
+       JMP XER7        /OUTPUT ERROR
+       TAD PCOBUF
+       DCA COPTR       /BUFFER IS NOW EMPTY
+       TAD RECSIZ
+       CIA
+       DCA COKNT
+       EXIT CWRI
+
+RECSIZ,        0               /RECORD SIZE ON OUTPUT
+COPTR, COBUF           /PTS TO NEXT FREE LOCATION IN COBUF
+COKNT, -1000           /NUMBER OF EMPTY SLOTS LEFT IN COBUF
+
+XER7,  CIF CDF 10
+       AND (40
+       SZA CLA         /CLEAR LEADER?
+       JMP I (ER5      /YES, DEVICE FULL
+       JMP I (ER7      /OUTPUT ERROR
+XER4,  CIF CDF 10
+       JMP I (ER4
+XER8,  CIF CDF 10
+       JMP I (ER8
+
+LDRFLG,        0               /NON-ZERO IF IGNORING LEADER
+CWTMP1,        -1
+CWTMP2,        -1
+CWTMP, 0
+QH3,   HANDLER
+       PAGE
+\fPREFIN,       TAD (200
+       JMS I (CWR2     /WRITE OUT TRAILER
+       JMP CFIN2       /BUT NO CHECKSUM
+CFIN,  TAD I (CWTMP2   /V3C
+       JMS I (CWR2
+       TAD I (CWTMP1   /V3C
+       JMS I (CWR2
+CFIN2, JMS I (CWRI
+       TAD I (OUNIT
+XCLOSE,        JMS I (CLOSE
+       JMP I (XER8
+XLV,   CIF CDF 10
+       JMP I (DECODE
+\fCTRTEM,
+CREAD, 0
+       TAD (OBUFFER
+       DCA BIPTR
+       TAD (-OBUFLEN
+       DCA BIKNT
+ZRLUP, CDF 10
+       DCA I BIPTR     /ZERO BUFFER
+       CLA IAC
+       AND I (7643
+       SZA CLA
+       TAD (DCRE-CRE   /GOT L OPTION
+       TAD (CRE
+       CDF 0
+       DCA XCRE        /PT TO INPUT SUBR
+       INCR BIPTR
+       ISZ BIKNT
+       JMP ZRLUP
+       TAD (OBUFFER
+       DCA BIPTR
+       TAD (-HOBUFLEN
+       DCA BIKNT       /# OF DOUBLE-WORDS
+CRLOOP,        JMS I XCRE
+       CDF 10
+       DCA I BIPTR
+       JMS I XCRE
+       DCA TEMP2
+       JMS I XCRE
+       DCA TEMP3
+       CDF 10
+       TAD TEMP3
+       RTL
+       RTL
+       AND (7400
+       TAD I BIPTR
+       DCA I BIPTR
+       INCR BIPTR
+       TAD TEMP3
+       RTR
+       RTR
+       RAR
+       AND (7400
+       TAD TEMP2
+       DCA I BIPTR
+       INCR BIPTR
+       ISZ BIKNT
+       JMP CRLOOP      /REITERATE
+       CIF CDF 10
+       TAD (MAXBLK
+       DCA I (INTEN    /READ 10 BLOCKS
+       EXIT CREAD      /ALL DONE
+\fBIPTR,        0               /PTS INTO OBUFFER
+BIKNT, 0
+XCRE,  CRE
+
+CTRLC, 0
+       KSF
+       EXIT CTRLC
+       TAD (7600
+       KRS
+       TAD (-7603
+       SZA CLA
+       EXIT CTRLC
+       JMS I (CLEAR
+       TAD I (OUNIT
+       SPA CLA
+       JMP I (7600
+       TAD I (OUNIT
+       DCA CTRTEM
+       STA
+       DCA I (OUNIT
+       TAD CTRTEM
+       JMS I (CLOSE
+       JMP I (XER8
+       JMP I (7600
+\fLOPTION,TAD I (IUNIT
+       JMS I QU3
+       REWIND
+       JMP I (INER
+       CLA IAC
+       DCA I (CIBUF
+LM1,   JMP LM2         /ZERO FOR MAGTAPE
+       JMS I QU3
+       SKPFIL
+       JMP I (INER
+LM2,   CIF CDF 10
+       JMP I (CHLOOP
+LM3,   JMP LM2
+QU3,   UTIL
+       PAGE
+\fCIKNT,        -1              /ONE'S COMPLEMENT OF # OF BYTES LEFT IN CIBUF
+CIPTR, CIBUF           /PTS TO NEXT BYTE IN CIBUF TO BE READ
+
+CRE,   0
+       CDF 0
+       TAD FTFLG       /FIRST TIME THROUGH?
+       SZA CLA
+       JMP FT          /YES
+       TAD TLRFLG
+       SNA CLA
+       JMP EPI         /TRAILER
+       ISZ CIKNT
+       SKP
+       JMS I (CRED
+       TAD I CIPTR
+       JMS CHKSUM
+       JMS CHKTLR
+       TAD I CIPTR
+       INCR CIPTR
+/      AND (377
+       EXIT CRE
+
+
+/READ DIRECTORY
+DCRE,  0
+       CDF 0
+       ISZ CIKNT
+       SKP
+       JMS DCRED
+       TAD I CIPTR
+       TAD (-32
+       SNA
+       JMP DCRE+1      /ALLOW '32' TO SHORTEN BUFFER
+       TAD (32
+       SNA
+       TAD (232
+       INCR CIPTR
+       EXIT DCRE
+\fFT,   DCA FTFLG
+       TAD (200        /SEND LEADER
+       EXIT CRE
+
+CHKSUM,        0
+       DCA CHTEM
+       TAD CHTEM
+       AND (200
+       SNA CLA
+       TAD CHTEM
+       TAD CHECKSUM
+       DCA CHECKSUM
+       EXIT CHKSUM
+CHTEM, 0
+CHECKSUM,0
+FTFLG, 1               /1 IF FIRST TIME HERE
+CHKPTR,        CHKTBL
+TLRFLG,        0
+
+CHKTBL,        0               /CHECKSUM LEFT PART
+       0               /CHECKSUM RIGHT PART
+       200             /TRAILER
+       32              /CTRL/Z
+       -1              /TABLE END
+
+CHKTLR,        0
+       CDF 10
+       TAD I (7643
+       CDF 0
+       RTL             /B SWITCH TO LINK
+       SNL CLA
+       EXIT CHKTLR
+       TAD I CIPTR
+       TAD (-200
+       SZA CLA
+       EXIT CHKTLR
+       DCA TLRFLG
+       TAD (CHKTBL
+       DCA CHKPTR
+       TAD CHECKSUM
+       RTR
+       RTR
+       RTR
+       AND (77
+       DCA CHKTBL
+       TAD CHECKSUM
+       AND (77
+       DCA CHKTBL+1
+EPI,   TAD I CHKPTR
+       SPA
+       JMP I (INTO
+       INCR CHKPTR
+       EXIT CRE
+\fDCRED,        0
+       TAD (40
+       DCA I (BSIZE
+       TAD I PCIBUF
+       SNA CLA
+       JMP I (INTO
+       TAD I (IUNIT
+       JMS I QH4
+       READ
+PCIBUF,        CIBUF
+       JMP I (INER
+       TAD PCIBUF
+       DCA CIPTR
+       TAD I CIPTR
+       SZA CLA
+       TAD (-23
+       TAD (-2
+       DCA CIKNT
+       JMS I (FIDDLE
+       TAD I CIPTR
+       SNA CLA
+       EXIT DCRED
+       JMS I QU4
+       SKPFIL
+       JMP I (INER
+       EXIT DCRED
+
+QH4,   HANDLER
+QU4,   UTIL
+/THIS WAS VERY UNOPTIMAL ADDING IN MAGTAPE SUPPORT
+/AFTER THE PROGRAM WAS ALL DONE AND BURIED.
+/IT COULD HAVE BEEN DONE IN A MUCH BETTER METHOD
+/IF IT WAS DESIGNED IN BEFORE THE PROGRAM WAS WRITTEN.
+       PAGE
+\f/FIRST ARG: PTS TO OS/8 FILENAME IN FIELD 1
+
+CONVRT,        0
+       STA
+       TAD I CONVRT
+       DCA ONPTR
+       INCR CONVRT
+       TAD (SINCH
+       DCA CNPTR
+       TAD (-4
+       DCA CKNT
+CONLUP,        CDF 10
+       INCR ONPTR
+       TAD I ONPTR
+       CDF 0
+       RTR
+       RTR
+       RTR
+       JMS CNV
+       DCA I CNPTR
+       INCR CNPTR
+       CDF 10
+       TAD I ONPTR
+       CDF 0
+       JMS CNV
+       DCA I CNPTR
+       INCR CNPTR
+       ISZ CKNT
+       JMP CONLUP
+       TAD (40
+       DCA I CNPTR
+       CDF 10
+       TAD I (7643
+       CDF 0
+       RTL
+       SNL CLA
+       EXIT CONVRT     / NOT /B
+       CDF 10
+       TAD I (7643
+       RAL
+       CLA
+       TAD I ONPTR
+       CDF 0
+       SZA CLA
+       EXIT CONVRT     /EXTENSION SPECIFIED
+       SZL
+       EXIT CONVRT     /   /A
+       CLL STA RAL
+       TAD CNPTR
+       DCA CNPTR
+       TAD ("B         /SET EXTENSION TO .BIN
+       DCA I CNPTR
+       INCR CNPTR
+       TAD ("I
+       DCA I CNPTR
+       INCR CNPTR
+       TAD ("N
+       DCA I CNPTR
+       EXIT CONVRT
+\fCNV,  0
+       AND (77
+       SZA             /CHANGE 0 TO BLANK
+       TAD (40
+       AND (77
+       TAD (40
+       EXIT CNV
+
+ONPTR, 0
+CNPTR, 0
+CKNT,  0
+
+LOOK4ME,JMS CONVRT
+       7606
+       TAD IUNIT
+       JMS I (LOOKUP
+       JMP I (XER4
+       JMP XER24
+       TAD I (INCH+12  /GET H.O. INPUT RECORD SIZE
+       CLL RTR
+       RTR
+       RAR
+       TAD I (INCH+13
+       DCA INRECSZ
+       TAD INRECSZ
+       SNA
+       JMP XER40       /RECORD SIZE 0
+       CLL
+       TAD (-1001
+       SZL CLA
+       JMP XER10
+       CIF CDF 10
+       JMP I (CHLOOP
+
+XER24, CIF CDF 10
+       JMP I (ER24
+XER25, CIF CDF 10
+       JMP I (ER3
+\fOUNIT,        0
+IUNIT, 0
+/IN CASE OF CASSETTES, CONTAINS UNIT (AS CHAR)
+/IN CASE OF MAGTAPE, CONTAINS HANDLER ENTRY ADDRESS
+/OUNIT IS -1 DURING A ^C CLOSE
+/-1 MEANS DON'T CLOSE ON ERROR
+INRECSZ,200    /RECORD SIZE ON INPUT
+XER40, CIF CDF 10
+       JMP I (ER40
+XER10, CIF CDF 10
+       JMP I (ER10
+F1CTRLC,0
+       JMS I (CTRLC
+       CIF CDF 10
+       EXIT F1CTRLC
+       PAGE
+\fSINCH,        ZBLOCK 16
+       40;40;40;40;40;40
+       ZBLOCK 14
+INCH,  ZBLOCK 40
+
+LDRTST,        0
+       TAD I (CWTMP
+       TAD (-200
+       SNA CLA         /LEADER?
+       JMP I (CWREX    /YES, EXIT CWR
+       DCA I (LDRFLG   /NO
+       EXIT LDRTST
+\fENTERO,       TAD (COBUF
+       DCA I (COPTR
+       JMS I (CONVRT
+       7601
+       JMS I (MAKDAT
+       TAD I (RECSIZ
+       CLL RTL
+       RTL
+       RAL
+       AND (17
+       DCA I (SINCH+12
+       TAD I (RECSIZ
+       AND (377
+       DCA I (SINCH+13
+       CDF 10
+       TAD I (FILTYP
+       CDF 0
+       DCA I (SINCH+11
+       DCA I (SINCH+14
+       DCA I (SINCH+15
+       CDF 10
+       TAD I (VRSNO
+       CDF 0
+       DCA I (SINCH+24
+       TAD I (OUNIT
+       JMS I (ENTER
+       JMP I (XER25
+       CIF CDF 10
+       DCA I (OSWITCH
+       JMP I (CONT1
+       PAGE
+\fZOPTION,TAD I (OUNIT
+       JMS I QU5
+       REWIND
+       JMP XER77       /OUTPUT ERROR
+       CDF 10
+       TAD I (7601
+       CDF 0
+       SNA CLA
+       JMP NOFILE
+       JMS I (CONVRT
+       7601
+       JMS I (LOOKUP
+       JMP I (XER4
+       JMP I (XER24
+       JMS I QU5
+       SKPFIL
+       JMP I (XER24
+       TAD (40
+       DCA I (BSIZE
+       JMS I QH5
+       READ
+       INCH
+       JMP XER77
+CLO3,  JMS I (BACK
+       JMP XER77
+       JMS I QH5
+       WRITE
+       ZER
+       JMP XER77
+NOFILE,        JMP I (XCLOSE
+\fMAKDAT,       0
+       CDF 10
+       TAD I (DATE
+       CDF 0
+       SNA
+       JMP SETOBL
+       DCA SKNT
+       TAD (SINCH+16
+       DCA SPTR
+       TAD SKNT
+       RTR
+       RAR
+       AND (37
+       JMS TWO         /INSERT DAY
+       TAD SKNT
+       RTL
+       RTL
+       RAL
+       AND (17
+       JMS TWO         /INSERT MONTH
+       TAD SKNT
+       AND (7
+       TAD (106
+       JMS TWO         /INSERT YEAR
+       EXIT MAKDAT
+
+SETOBL,        TAD (-6         /SET DATE TO BLANKS
+       DCA SKNT
+       TAD (SINCH+16
+       DCA SPTR
+SELOOP,        TAD (40
+       DCA I SPTR
+       INCR SPTR
+       ISZ SKNT
+       JMP SELOOP
+       EXIT MAKDAT
+
+SPTR,  0
+SKNT,  0
+TEM2,  0
+TENS,  0
+\fTWO,  0
+       DCA TEM2
+       TAD (60
+       DCA TENS
+       TAD TEM2
+TWOLUP,        TAD (-12
+       SPA
+       JMP NEG
+       INCR TENS
+       JMP TWOLUP
+NEG,   TAD (72
+       DCA TEM2
+       TAD TENS
+       DCA I SPTR
+       INCR SPTR
+       TAD TEM2
+       DCA I SPTR
+       INCR SPTR
+       EXIT TWO
+
+XER77, CIF CDF 10
+       JMP I (ER7      /OUTPUT ERROR
+
+QU5,   UTIL
+QH5,   HANDLER
+\fMHANDLER,0            /AC CONTAINS HANDLER ENTRY ADDRESS
+       CIF 10
+       JMP I (MHAN     /KLUDGEY LINK TO FIELD 1
+
+MUTIL, 0               /AC CONTAINS ETC.
+       CIF 10
+       JMP I (MUT
+       PAGE
+\f      FIELD 1
+
+       XR=10
+
+       *2000
+
+START, JMP DEC2        /NORMAL STARTING ADDRESS
+CHAIN, JMP NODEC       /CHAIN STARTING ADDRESS
+DECODE,        STL CLA RAR
+       AND I (7642
+       SZA CLA
+       JMP KBM         /RETURN TO KBM ON $
+/      WOULD BE NICE HERE TO TELL CD/BATCH NOT TO SPOOL
+DEC2,  CALL (200
+       5               /COMMAND DECODE
+       5200            /USING SPECIAL MODE
+NODEC, TAD (OUTHAND+1
+       DCA ENTR        /RESET PTR TO HANDLER LOCATION
+       STA
+       DCA I (OSWITCH
+       JMS I (CHKSW    /CHECK FOR SWITCH OPTIONS
+       CDF 0
+       DCA I (OUTSW
+       STA
+       DCA I (OUNIT
+       CDF 10
+       TAD I (7666
+       DCA I (DATE
+FET,   TAD I (7600     /GET DEVICE NUMBER OF OUTPUT FILE
+       SNA             /WAS ONE SPECIFIED?
+       JMP NOF         /NO - NO OUTPUT FILE
+       CALL (200
+       1               /FETCH HANDLER
+ENTR,  OUTHAND+1       /INTO PAGES 2400 AND 2600
+                       /REPLACED BY HANDLER STARTING ADDRESS
+       JMP I (ER6              /OUTPUT DEVICE DOESN'T EXIST
+       TAD I (7644
+       AND (1000
+       SZA CLA
+       JMP I (FOXOUT   /O SPECIFIED
+       STL CLA RTR
+       AND I (7645
+       TAD I (7601
+       SNA CLA
+       JMP NOCAS       /NO OUTPUT NAME
+       TAD (7600
+       JMS I (CHKNAM
+       JMP I (STARER   /*.*
+       TAD I (7600
+       JMS I (TCAS     /CASSETTE?
+       JMP I (FIXOUT   /YES
+       JMP I (FXMOUT   /MAGTAPE
+NOCAS, TAD (7601       /NO
+       DCA OBLK        /GET PTR TO OUTPUT FILE NAME
+       TAD ENTR
+       DCA I (OENTRY   /STORE AWAY OUTPUT HANDLER ENTRY PT
+       TAD (OWRITE
+       DCA PWRITE
+       TAD (FINIO
+       DCA I (XFINIO
+       TAD I (7643
+       RTL
+       SNL CLA
+       JMP NOB
+       TAD I (7604     /GET EXT
+       SZA CLA
+       JMP NOB
+       TAD (216        /SET TO .BN
+       DCA I (7604
+NOB,   TAD I (7600     /GET DEVICE NUMBER AGAIN
+       CALL (200
+       3               /OPEN OUTPUT FILE
+OBLK,  7601            /PTS TO OUTPUT FILE NAME
+                       /REPLACED BY STARTING BLOCK NUMBER
+LEN,   0               /REPLACED BY NEGATIVE OF LENGTH OF OUT AREA
+       JMP I (ER3      /FILE OPEN ERROR
+       DCA I (REALEN   /ZERO REAL LENGTH
+       TAD OBLK
+       DCA I (OBLOCK   /SET STARTING BLOCK NUMBER
+CONT1, JMS I (GETIN
+/      INITIALIZE INPUT STUFF
+CHLOOP,        CIF CDF 0
+       JMS I (F1CTRLC
+       CALL PREAD
+       CIF CDF 0
+       JMS I (F1CTRLC
+       CALL PWRITE
+       JMP CHLOOP
+\fPREAD,        OREAD
+PWRITE,        OWRITE
+NOF,   STL CLA RTR
+       AND I (7645
+       SNA CLA
+       JMP I (ER1
+       JMP I (FOXOUT   /Z IMPLIES O
+
+KBM,   CIF CDF 0
+       JMP I (7605
+       PAGE
+\fUDIG, 0
+
+GETSWDIG,0
+       DCA UDIG
+       TAD I (7645
+       AND (1774
+       SNA
+       EXIT GETSWDIG   /NO UNIT
+       INCR GETSWDIG
+       RTL
+       RAL
+LUDIG, SZL
+       JMP GOTUD
+       INCR UDIG
+       RAL
+       JMP LUDIG
+G7600,
+GOTUD, 7600
+       TAD UDIG
+       TAD (60
+       EXIT GETSWDIG
+\fFOXOUT,       JMS GETSWDIG
+       JMP I (ER1      /NO OUTPUT UNIT
+       JMP GOTOU
+FIXOUT,        TAD I (ENTR
+       JMS I (GETDVC
+GOTOU, CDF 0
+       DCA I (OUNIT
+       CDF 10
+       JMS I (SETCAS
+YAHAOU,        TAD I (7643
+       AND (400
+       SZA CLA
+       JMP DOPT
+       STL CLA RTR
+       AND I (7645
+       SZA CLA
+       JMP ZOPT
+       TAD I G7600
+       RTR
+       RTR
+       AND (377        /ISOLATE FILE TYPE
+       DCA FILTYP      /SAVE IT
+       JMS I (GETLEN
+       TAD (CW
+       DCA I (PWRITE
+       TAD (CFINIO
+       DCA I (XFINIO
+       TAD I (7643
+       RTL             /B TO LINK
+       SZL CLA
+       CLA IAC
+       CIF CDF 0
+       DCA I (LDRFLG
+       STA
+       DCA I (CWTMP1
+       STA
+       DCA I (CWTMP2
+       DCA I (CHECKSUM
+       JMP I (ENTERO
+/      RETURN TO CONT1
+
+FXMOUT,        TAD I (ENTR
+       CDF 0
+       DCA I (OUNIT
+       CDF 10
+       JMS I (SETMAG
+       TAD I (ENTR     /GET LOCATION OF MAGTAPE HANDLER
+       JMS SETDEN
+       JMP YAHAOU
+\fSETDEN,       0
+       AND G7600
+       DCA MTA
+       TAD I (7644
+       AND (10
+       SZA CLA         /IS /U SPECIFIED?
+       IAC             /YES, USE DENSITY 3
+       TAD (2          /NO, USE DENSITY 2
+       DCA DEN
+       CDF 0
+       TAD PARITY
+       CLL RAR         /LINK ON IF PARITY SPECIFIED
+       SZL
+       TAD PAR
+       SNL
+       TAD I MTA       /GET RELATIVE LOC 0
+       AND (400        /ISOLATE PARITY
+       TAD DEN         /FORCE CORE DUMP MODE
+       DCA I MTA       /STORE BACK DENSITY AND PARITY
+       CDF 10
+       JMP I SETDEN
+\fFILTYP,       0
+BINTYP,        0               /SET BINARY TYPE - DON'T TOUCH LINK
+       IAC
+       IAC
+       DCA FILTYP
+       EXIT BINTYP
+
+DOPT,  CIF CDF 0
+       JMP I (DOPTION
+
+ZOPT,  CIF CDF 0
+       JMP I (ZOPTION
+
+MTA,   0               /FIRST LOC OF MAGTAPE HANDLER
+PARITY,        0               /0 MENAS NOT SPECIFIED, 1 MEANS SPECIFIED PARITY
+PAR,   0               /0 OR 400 SPECIFYING PARITY
+DEN,   2               /DENSITY
+       PAGE
+\fFID2, 0
+       TAD I (CIBUF
+       AND (177                /DF=0
+       TAD (-52
+       SNA CLA
+       JMS EMPTY
+       TAD I (CIBUF+10
+       DCA I (CIBUF+11
+       TAD I (CIBUF+7
+       DCA I (CIBUF+10
+       TAD I (CIBUF+6
+       DCA I (CIBUF+7
+       TAD (".
+       DCA I (CIBUF+6
+       CIF 0
+       JMP I FID2
+
+EMPTY, 0
+       TAD I (FAST
+       SNA CLA
+       JMP I EMPTY
+       STA
+       DCA I (CIKNT
+       TAD (32
+       DCA I (CIBUF
+       CIF 0
+       JMP I (FIDLV
+\fGETLEN,       0
+       CLL STA RAR     /3777
+       AND I (7642     /GET H.O. OPTION
+       DCA VRSNO
+       TAD I (7646     /GET = OPTION (L.O. 12 BITS)
+       CLL
+       TAD (-1001
+       SZL CLA         /LESS THAN 1001?
+       JMP I (ER10     /NO, ERROR
+       TAD I (7646     /YES
+       SNA
+       TAD (200        /200 IS DEFAULT RECORD SIZE
+       CDF 0
+       DCA I (RECSIZ
+       TAD I (RECSIZ
+       CIA
+       DCA I (COKNT
+       CDF 10
+       EXIT GETLEN
+
+FINIO, JMS I (OWRITE
+       TAD I (7600     /GET OUTPUT DEVICE NUMBER
+       CALL (200
+       4               /CLOSE
+       7601            /PTR TO FILE NAME
+REALEN,        0               /LENGTH OF NEW OUTPUT FILE
+       JMP ER8         /CLOSE ERROR
+       JMP I (DECODE
+ER8,   JMS I (PRINT
+       TEXT    /?CLOSE ERROR/
+ER5,   JMS I (PRINT
+       TEXT    /?OUTPUT DEVICE FULL/
+\fER30, JMS I (PRINT
+       TEXT    /?OUT=IN/
+VRSNO, 0
+
+ER6,   JMS I (PRINT
+       TEXT    /?FETCH ERROR/
+ER24,  STA
+       DCA I (SPSWTCH  /RETURN FROM PRINT
+       JMS I (PRINT
+       TEXT    /?FILE NOT FOUND/
+       ISZ I (FUDSW    /FIXUP CASSETTE
+       JMP I (CLO
+       PAGE
+\fOREAD,        0
+       TAD (MAXBLK
+       DCA INTEN       /TRY TO READ 10 BLOCKS
+       TAD (MAXBLK^200+10
+       DCA READSZ
+       TAD I (7605
+       AND (17
+       TAD (7757
+       DCA TEMP        /GET DCB ADDR
+       TAD I TEMP      /GET DCB
+       AND (1000
+       SZA CLA
+       JMP ER4         /INPUT DEVICE IS WRITE-ONLY
+       TAD I TEMP
+       SMA CLA
+       JMP YES         /NOT FILE-STRUCTURED
+       TAD I (INLEN
+       TAD (MAXBLK
+       SMA SZA CLA     /CAN I READ IN 10 BLOCKS?
+       JMS SHORT       /NO
+YES,   CIF 0           /YES
+       JMS I IENTRY    /CALL INPUT HANDLER
+READSZ,        2010            /READ 20 PAGES INTO FIELD 1
+       OBUFFER         /LOCATION 4000
+IBLOCK,        0               /INPUT BLOCK NUMBER
+       JMP QER4        /INPUT ERROR
+       TAD IBLOCK
+       TAD INTEN
+       DCA IBLOCK      /UPDATE BLOCK NUMBER
+       TAD I (INLEN
+       TAD INTEN
+       DCA I (INLEN    /UPDATE LENGTH LEFT
+       TAD INTEN
+       TAD (-MAXBLK
+       SZA CLA
+       JMP XFIN
+       EXIT OREAD      /RETURN
+INTEN, 10              /NUMBER OF BLOCKS JUST READ
+XFINIO,        FINIO
+
+SHORT, 0
+       TAD I (INLEN    /HOW MANY BLOCKS LEFT?
+       CIA             /MAKE POSITIVE
+       DCA INTEN       /THAT'S AS MUCH AS WE CAN READ
+       TAD INTEN
+       SNA
+XFIN,  JMP I XFINIO    /NO MORE
+       CLL RTR
+       RTR
+       RTR             /CONVERT TO PAGES IN BITS 1-5
+       TAD (10         /ADD IN FIELD 1 BIT
+       DCA READSZ
+       EXIT SHORT      /RETURN
+\fIENTRY,       0               /PTS TO INPUT HANDLER ENTRY POINT
+QER4,  SMA CLA
+       JMP SFIN        /NON-FATAL END-OF FILE
+ER4,   JMS I (PRINT
+       TEXT    /?INPUT ERROR/
+ER26,  JMS I (PRINT
+       TEXT /?TOO MANY FILES/
+SFIN,  TAD (7600
+       DCA TPTR
+SLUP,  STA
+       TAD TPTR
+       DCA TPTR
+       TAD I TPTR
+       SNA CLA
+       JMP SLUP
+       TAD TPTR
+       TAD (-OBUFFER+1
+       SNA
+       JMP ALLZ
+       TAD (377        /CHANGED FROM PIPC'S 376
+       CLL RTL
+       RTL
+       RAL
+       AND (17
+       DCA INTEN
+       JMP XFIN
+ALLZ,  CLA IAC
+       JMP .-3
+TPTR,  0
+\fER3,  JMS I (PRINT
+       TEXT    /?ENTER ERROR/
+       PAGE
+\fGETIN,        0               /OPEN INPUT FILE
+       DCA DATE
+       TAD I (7605     /ANY MORE FILES SPECIFIED?
+       SNA CLA
+       JMP NOIN        /NO
+       TAD I (7612
+       SZA CLA
+       JMP I (ER26     /2ND INPUT FILE IS BAD
+       TAD (7605
+       JMS I (CHKNAM
+       JMP I (STARER   /*.*
+       TAD (7606
+       DCA IN          /SET PTR TO FILE NAME
+       TAD (INHAND+1
+       DCA IN3
+       TAD I (7605     /GET DEVICE NUMBER
+       CALL (200
+       1               /FETCH NEW DEVICE HANDLER
+IN3,   INHAND+1        /INTO PAGES 3200 AND 3400
+                       /REPLACED BY ENTRY PT TO INPUT HANDLER
+       JMP I (ER6      /FETCH ERROR
+       TAD I (7643
+       AND (10
+       SZA CLA
+       JMP I (FOXIN    /I SPECIFIED
+       CLA IAC         /V3C
+       AND I (7643     /LOOK AT /L OPTION
+       TAD I (7606
+       SNA CLA
+       JMP NOCAS2
+/IF NO NAME IS GIVEN AND /L IS NOT SPECIFIED, THEN USE
+/MAGTAPE OR CASSETTE HANDLER AS IS, I.E. AS
+/A NON-FILE-STRUCTURED OS/8 DRIVER.
+       TAD I (7605
+       JMS I (TCAS     /CASSETTE?
+       JMP I (FIXIN    /YES
+       JMP I (FIXMIN   /MAGTAPE
+NOCAS2,        CLA IAC
+       AND I (7643
+       SZA CLA
+       JMP ER11        /V3C  /L SPECIFIED WHEN DEVICE WAS NOT MAGTAPE OR CASSETTE
+       TAD (OREAD
+       DCA I (PREAD
+       TAD IN3         /GET NEW HANDLER ENTRY PT
+       DCA I (IENTRY   /STORE AWAY
+       TAD I (7605     /GET DEVICE NUMBER AGAIN
+       CALL (200
+       2               /PERFORM A LOOKUP
+IN,    0               /PTR TO FILE NAME
+                       /REPLACED BY INPUT BLOCK NUMBER
+IN2,   0               /REPLACED BY NEGATIVE OF INPUT FILE LENGTH
+       JMP LKERR       /LOOKUP ERROR
+       TAD IN          /GET NEW INPUT BLOCK
+       DCA I (IBLOCK   /STORE AWAY
+       TAD IN2         /GET NEW INPUT FILE LENGTH
+       DCA INLEN
+       TAD I (1404     /GET # OF ADDITIONAL WORDS
+       SNA
+       JMP NONE
+       TAD 17
+       DCA POINTER
+       TAD I POINTER   /GET FILE CREATION DATE
+       SNA
+       JMP NONE
+SETDAT,        DCA DATE
+       EXIT GETIN
+NONE,  TAD I (7666     /USE TODAY'S DATE
+       JMP SETDAT
+LKERR, CLA
+       TAD I (7611
+       SZA CLA
+       JMP I (ER24     /FILE NOT FOUND
+       TAD I (7643     /TRY .BN
+       RTL
+       SNL CLA
+       JMP I (ER24     / NOT /B
+       TAD (216
+       DCA I (7611
+       JMP GETIN+1
+
+INLEN, 0
+DATE,  0               /OS8 DATE OF INPUT FILE
+POINTER,0
+
+NOIN,  CLA IAC
+       AND I (7643
+       SNA CLA
+       JMP I (ER21
+       JMP I (FOXIN    / /L SPECIFIED
+\fER11, JMS I (PRINT    /V3C
+       TEXT    /?L OPTION OUT OF CONTEXT/
+       PAGE
+\f/ENTER WITH INTEN BLOCKS TO WRITE
+OWRITE,        0
+       TAD I (INTEN    /HOW MUCH IS THERE TO WRITE?
+       SNA
+       EXIT OWRITE     /NOTHING
+       DCA OUTEN       /SAVE NUMBER OF BLOCKS TO WRITE
+       TAD I (7600
+       AND (17
+       TAD (7757
+       DCA TEMP
+       STL CLA RTR
+       AND I TEMP
+       SZA CLA
+       JMP I (ER7      /OUTPUT DEVICE IS READ-ONLY
+       TAD OUTEN
+       CLL RTR
+       RTR
+       RTR             /CONVERT TO PAGES
+       TAD (4010       /FIELD 1 (WRITE DIRECTLY FROM INPUT BUFFER)
+       DCA WRSIZ
+       TAD I (LEN
+       SNA CLA
+       JMP NFS         /NON-FILE STRUCTURED
+       TAD I (REALEN
+       TAD OUTEN
+       STL
+       TAD I (LEN
+       SNL SZA CLA
+       JMP I (ER5
+NFS,   CIF 0
+       JMS I OENTRY    /CALL OUTPUT HANDLER
+WRSIZ, 6010            /WRITE 20 PAGES FROM FIELD 1
+       OBUFFER         /LOCATION 4000
+OBLOCK,        0               /OUTPUT BLOCK NUMBER
+       JMP I (ER7      /OUTPUT ERROR
+       TAD OBLOCK
+       TAD OUTEN
+       DCA OBLOCK      /UPDATE OUTPUT BLOCK NUMBER
+       TAD I (REALEN
+       TAD OUTEN
+       DCA I (REALEN   /UPDATE LENGTH WROTE
+       EXIT OWRITE
+
+OENTRY,        0
+OUTEN, 0
+\fFOXIN,        JMS I (GETSWDIG
+       JMP I (ER21
+       JMP GOTIU
+FIXIN, TAD I (IN3      /GET INPUT HANDLER ADDRESS
+       JMS I (GETDVC
+GOTIU, CDF 0
+       DCA I (IUNIT
+       CDF 10
+       JMS I (SETCAS
+YAHAIN,        CDF 0
+       TAD I (OUNIT
+       CIA
+       TAD I (IUNIT
+       SNA CLA
+       JMP I (ER30
+       STA
+       DCA I (CIKNT
+       DCA I (CHECKSUM
+       CLA IAC
+       DCA I (TLRFLG
+       CDF 10
+       TAD (CR
+       DCA I (PREAD
+       TAD I (7643
+       RTL
+       CLA RAL
+       CDF 0
+       DCA I (FTFLG
+       CDF 10
+       JMS I (GETLEN
+       TAD I (7643
+       AND (100        / F OPTION?
+       CDF 0
+       DCA I (FAST
+       CDF 10
+       CLA IAC
+       AND I (7643
+       CIF CDF 0
+       SZA CLA
+       JMP I (LOPTION
+       JMP I (LOOK4ME
+/RETURN TO CHLOOP
+\fFIXMIN,       TAD I (IN3
+       CDF 0
+       DCA I (IUNIT
+       CDF 10
+       JMS I (SETMAG
+       TAD I (IN3
+       JMS I (SETDEN
+       JMP YAHAIN
+       PAGE
+\fPRINT,        0
+       CLA
+       CDF 10
+       DCA CTOFLG      /ALLOW ECHOING
+       JMS CRLF
+PRLUP, TAD I PRINT
+       RTR
+       RTR
+       RTR
+       JMS PRIN
+       TAD I PRINT
+       JMS PRIN
+       INCR PRINT
+       JMP PRLUP
+
+PRIN,  0
+       AND (77
+       SNA
+       JMP PRFIN
+       TAD (240
+       AND (77
+       TAD (240
+       DCA TM
+       KSF
+       JMP NOBOTH
+       TAD (200
+       KRS
+       TAD (-203
+       SNA
+       JMP KBM2
+       TAD (203-217
+       SZA CLA
+       JMP NOBOTH
+       TAD ("^
+       JMS TYPE
+       TAD ("O
+       JMS TYPE
+       JMS CRLF
+       ISZ CTOFLG
+NOBOTH,        TAD TM
+       JMS TYPE
+       EXIT PRIN
+PRFIN, JMS CRLF
+       DCA FUDSW
+       TAD I (SPSWTCH
+       SNA CLA
+       JMP CLO
+       DCA I (SPSWTCH  /SWITCH NON-ZERO MEANS RETURN
+       INCR PRINT      /POINT TO RETURN
+       JMP I PRINT
+\f/DO A CLOSE IF OUTPUT CASSETTE OPEN
+CLO,   CDF 0
+       TAD I (OUNIT
+       CDF 10
+       SPA CLA
+       JMP I (DECODE
+       TAD OSWITCH
+       SZA CLA
+       JMP I (DECODE
+       CDF 0
+       TAD I (OUTSW
+       CDF 10
+       SNA CLA         /DID WE WRITE ON OUTPUT CASSETTE?
+       JMP I (DECODE   /NO
+       CIF CDF 0
+       TAD I (OUNIT
+       DCA TEMP
+       STA
+       DCA I (OUNIT
+       TAD FUDSW
+       SZA CLA
+       JMP I (CLO3
+       TAD TEMP
+       JMP I (XCLOSE
+OSWITCH,-1             /0 MEANS OUTPUT CASSETTE OPEN
+
+KBM2,  CIF CDF 0
+       JMP I L7600     /RETURN TO OS/8
+
+FUDSW, 0               /1 MEANS GOT OS/8 LOOKUP FAILURE
+\fTYPE, 0
+       DCA TM
+       TAD CTOFLG
+       SZA CLA
+       EXIT TYPE       /NOT ECHOING
+       TAD TM
+       TLS
+       TSF
+       JMP .-1
+L7600, 7600
+       EXIT TYPE
+
+CRLF,  0
+       TAD (215
+       JMS TYPE
+       TAD (212
+       JMS TYPE
+       EXIT CRLF
+
+CTOFLG,        0               /1 MEANS DON'T ECHO
+TM,    0
+
+ER7,   JMS PRINT
+       TEXT    /?OUTPUT ERROR/
+
+CFINIO,        CIF CDF 0
+       JMS I (CWRITE
+       CIF CDF 0
+       JMP I (CFIN     /FINISH OUTPUT AND WRITE SENTINEL
+/RETURN TO DECODE
+       PAGE
+\fER10, JMS I (PRINT
+       TEXT    /?RECORD SIZE TOO BIG/
+/ENTRY POINT REL 1: UNIT 1
+/ENTRY POINT REL 7: UNIT 0
+
+GETDVC,        0
+       IAC
+       DCA TEMP
+       STL CLA RTL     /2
+       AND TEMP
+       RAR
+       DCA UNIT        /DETERMINE IF UNIT 0 OR 1
+       TAD TEMP
+       AND (7600
+       DCA TEMP
+       CDF 0
+LOOKIO,        ISZ TEMP
+       TAD I TEMP      /SEARCH HANDLER FOR ANY IOT
+       AND (7700
+       TAD (-6700
+       SZA CLA
+       JMP LOOKIO
+       TAD I TEMP      /GET CASSETETE IOT
+       CDF 10
+       AND (30         /V3 BUG FIX FROM V2
+       CLL RTR
+       TAD UNIT
+       TAD (60
+       EXIT GETDVC     /LEAVE IT IN AC
+
+UNIT,  0
+\fCHKNAM,       0               /DON'T ALLOW *'S OR ?'S
+       DCA XR          /IN OUTPUT OR INPUT NAME
+       TAD I XR
+       TAD (-5200
+       SNA
+       JMP STARNM      /ENTIRE NAME IS *
+       TAD (5200
+       JMS CHKSTR
+       TAD I XR
+       JMS CHKSTR
+       TAD I XR
+       JMS CHKSTR
+       TAD I XR
+       JMS CHKSTR
+       ISZ CHKNAM
+       JMP I CHKNAM    /NAME GOOD, RETURN 2
+
+CHKSTR,        0
+       DCA TEM
+       TAD TEM
+       CLL RTR
+       RTR
+       RTR
+       JMS CHC
+       TAD TEM
+       JMS CHC
+       JMP I CHKSTR
+\fCHC,  0
+       AND (77
+       TAD (-52
+       SNA
+       JMP STARER      /* IN NAME
+       TAD (52-77
+       SZA CLA
+       JMP I CHC       /OKAY
+STARER,        JMS I (PRINT
+       TEXT    /?ILLEGAL * OR ?/
+
+STARNM,        ISZ XR
+       ISZ XR
+       TAD I XR
+       TAD (-5200
+       SZA CLA
+       JMP STARER      /NOT *.*
+       JMP I CHKNAM    /TAKE SPECIAL RETURN ON *.*
+
+TEM,   0
+\fCHKSW,        0               /CHECK SWITCHES
+       TAD I (7644
+       AND (4          /CHECK FOR /V
+       SZA CLA
+       JMS I (VERSN    /PRINT MCPIP VERSION #
+       TAD I (7644
+       AND (400        /CHECK FOR /P
+                       /NOTE /P = 400 SAME AS ODD PARITY CODE
+       SZA
+       JMP ODDPAR
+       TAD I (7643
+       AND (200        /CHECK FOR /E
+       SZA CLA
+       JMP EVPAR
+GOTP,  NOP
+       JMP I CHKSW
+
+ODDPAR,                        /400 IN AC
+EVPAR, DCA I (PAR
+       CLA IAC
+       DCA I (PARITY
+       JMP GOTP
+       PAGE
+\fSPSWTCH,0             /NON-ZERO MEANS RETURN FROM PRINT
+
+/RET 1: CASSETTE
+/RET 2: MAGTAPE
+/RET 3: NEITHER
+
+TCAS,  0
+       AND (17         /ISOLATE
+       TAD (7757       /ADD IN BASE OF DCB TABLE
+       DCA TEMP        /TO GET DCB ADDRESS
+       TAD I TEMP      /GET DCB
+       AND (770        /ISOLATE UNIT TYPE
+       TAD (-270       /CASSETTE HANDLER TYPE IS 27
+       SNA
+       JMP ITSCAS
+       TAD (270-200
+       SZA CLA
+       INCR TCAS       /NOTHING SPECIAL
+       INCR TCAS       /MAGTAPE
+ITSCAS,        EXIT TCAS
+\fVERSN,        0
+       STA
+       DCA SPSWTCH     /RETURN FROM PRINT
+       JMS I (PRINT
+       TEXT    \OS/8 MCPIP V\
+       *.-1
+       PIPVERSION+60^100+PATCHLEV
+       0
+       JMP I VERSN
+
+ER1,   TAD I (7605
+       SNA CLA
+       JMP I (DECODE   /NO OUT AND NO IN
+       CLA IAC
+       AND I (7643     /WAS /L SPECIFIED?
+       SZA CLA
+       JMP SETTY       /YES
+       JMS I (PRINT
+       TEXT    /?NO OUTPUT FILE/
+ER40,  JMS I (PRINT
+       TEXT    /?CANNOT HANDLE VARIABLE-LENGTH RECORDS/
+\fSETTY,        TAD (3100
+       DCA Y
+       JMS I (200
+       12              /INQUIRE
+TT,    2424
+Y,     3100            /DEVICE TTY
+       0
+       JMP ER99
+       TAD Y           /GET DEVICE NO. OF TTY:
+       DCA I (7600
+       JMP I (FET
+
+ER99,  JMS I (PRINT
+       TEXT    /?TTY DOES NOT EXIST/
+ER21,  JMS I (PRINT
+       TEXT    /?NO INPUT FILE/
+\fCW,   0
+       CIF CDF 0
+       JMS I (CWRITE
+       EXIT CW
+
+CR,    0
+       CIF CDF 0
+       JMS I (CREAD
+       EXIT CR
+       PAGE
+\fSETCAS,       0
+       TAD (UTIL
+       JMS SETU
+       TAD (HANDLER
+       JMS SETH
+       CDF 0
+       TAD (BACKFIL
+       DCA I (BK2
+       TAD I (BK4
+       DCA I (BK3
+       TAD (254
+       DCA I (EOFBIT
+       TAD I (FL3
+       DCA I (FL1
+       TAD (314
+       DCA I (EOTBIT
+       TAD I (LM3
+       DCA I (LM1
+       CDF 10
+       JMP I SETCAS
+
+SETMAG,        0
+       TAD (MUTIL
+       JMS SETU
+       TAD (MHANDLER
+       JMS SETH
+       CDF 0
+       TAD (BACKBLOCK
+       DCA I (BK2
+       TAD I (BK1
+       DCA I (BK3
+       TAD (3673
+       DCA I (EOFBIT
+       DCA I (FL1
+       TAD (3663
+       DCA I (EOTBIT
+       DCA I (LM1
+       CDF 10
+       JMP I SETMAG
+\fSETU, 0
+       DCA SETH
+       CDF 0
+       TAD SETH
+       DCA I (QU1
+       TAD SETH
+       DCA I (QU2
+       TAD SETH
+       DCA I (QU3
+       TAD SETH
+       DCA I (QU4
+       TAD SETH
+       DCA I (QU5
+       CDF 10
+       JMP I SETU
+\fSETH, 0
+       DCA SETU
+       CDF 0
+       TAD SETU
+       DCA  I (QH1
+       TAD SETU
+       DCA I (QH2
+       TAD SETU
+       DCA I (QH3
+       TAD SETU
+       DCA I (QH4
+       TAD SETU
+       DCA I (QH5
+       CDF 10
+       JMP I SETH
+       PAGE
+\fMH,   0
+
+MHAN,  SZA
+       DCA MENTRY
+       TAD I (MHANDLER
+       DCA MH          /PICK UP ARGS VIA MH
+       TAD I MH        /GET FN WORD
+       TAD (SPCODE     /ADD SPECIAL CODE
+       DCA MARG1
+       ISZ MH
+       TAD I MH        /GET CORE LOC
+       DCA MARG2
+       ISZ MH          /PT TO ERROR RETURN
+       TAD I (BSIZE    /GET BLOCKSIZE
+       CIA
+       DCA MARG3       /STORE NEG
+       CDF 10
+       CIF 0
+       JMS I MENTRY    /CALL MAGTAPE HANDLER
+MARG1, HLT
+MARG2, HLT
+MARG3, HLT
+       SKP             /TAKE ERROR RETURN
+       ISZ MH          /NORMAL RETURN
+       CIF CDF 0
+       JMP I MH        /GO BACK TO FIELD 0
+
+MENTRY,        0
+\fMU,   0
+
+MUT,   SZA
+       DCA MENTRY      /DF=0
+       TAD I (MUTIL    /PICK UP ARGS
+       DCA MU          /VIA 'MU'
+       TAD I MU        /GET UTILITY FUNCTION
+       ISZ MU
+       CDF 10
+       TAD (-REWIND
+       SNA
+       JMP REWT
+       TAD (REWIND-BACKFIL
+       SNA
+       JMP BAKFT
+       TAD (BACKFIL-WRGAP
+       SNA
+       JMP WRGT
+       TAD (WRGAP-BACKBLOCK
+       SNA
+       JMP BAKBT
+       TAD (BACKBLOCK-SKPFIL
+       SZA CLA
+       HLT             /IMPOSSIBLE
+SKPFT, STL CLA RAR     /4000=WRITE
+BAKFT, TAD (WRITE+FICODE-REWCOD
+REWT,  TAD (REWCOD-EOCODE
+WRGT,  TAD (EOCODE-RECCOD-WRITE
+BAKBT, TAD (RECCOD+WRITE
+       DCA MRG1
+       CIF 0
+       JMS I MENTRY
+MRG1,  HLT
+MCA,   HLT             /IRRELEVANT
+MWC,   -1
+       SKP             /ERROR RETURN
+       ISZ MU
+       CIF CDF 0
+       JMP I MU        /RETURN
+\fEMPTINCH,52;105;115;120;124;131;40;40;40;14
+       0;0;0;0;40;40;40;40;40;40
+       ZBLOCK 14
+       PAGE
+\f      *2000
+       $
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape6/PAL8.PA b/sw/os8/v3d/sources/system/dectapes/dectape6/PAL8.PA
new file mode 100644 (file)
index 0000000..b2a49cd
--- /dev/null
@@ -0,0 +1,5373 @@
+/2 PAL8 ASSEMBLER FOR OS/8 MONITOR     VERSION 10
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT  (C) 1970,1971,1972,1973,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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/1-OCT-75                             MB/MB/SM/MB/RL/JR/SR
+
+DECIMAL
+
+VERSION=       10
+SUBVERSION=    "A
+
+OCTAL
+
+/PAL8 IS AN 8K THREE PASS ASSEMBLER DESIGNED 
+/TO BE COMPATIBLE WITH THE OS/8 SYSTEM.
+
+/PASS 1 READS THE INPUT (SOURCE) FILE AND CONSTRUCTS
+/THE SYMBOL TABLE.
+
+/PASS 2 GENERATES THE BINARY (OBJECT) FILE, WHICH
+/MAY BE LOADED WITH THE ABSOLUTE (BINARY) LOADER.
+
+/PASS 3 GENERATES THE OCTAL SYMBOLIC ASSEMBLY
+/LISTING.
+
+/PAL8 IS COMPATIBLE IN MOST RESPECTS WITH PAL III, MACRO-8
+/4K PAL-D, AND 8K PAL-D, AS WELL AS THE CROSS-ASSEMBLER PAL10.
+
+       IFNDEF HASH<HASH=1>     /DEFINE FOR HASH SYMBOL TABLE
+/SET HASH=0 TO GET OLD PAL8 WAY OF HANDLING SYMBOL TABLE
+
+/MAINTENANCE RELEASE CHANGES:
+
+/1.    INCLUDED JIM ROTH'S HASH TABLE MODIFICATIONS
+/2.    ALLOWED /B TO WORK PROPERLY [SEQ #2 PATCH FROM AUG '74 DSN]
+/3.    PUT CREFLS.TM ON SYS: NOT DSK: [PATCH SEQ #3, SEP '74 DSN]
+/4.    FIXED 7TH LEVEL CHECKSUM BIT [PATCH SEQ #7, MARCH '75 DSN]
+/5.    ALLOWED PAL8 TO RESTART BEFORE CD EXECUTED [DSN APR '75, SEQ #8]
+/6.    FIXED /F SO IT WORKS [PATCH SEQ #9, DSN APRIL 1975]
+/7.    FIXED /W SO IT DOESN'T REMEMBER TOP OF PAGE [DSN OCT '75]
+/8.    FIXED BUG RE MULTIPLE NON-RES INPUT HANDLERS
+/9.    CHANGED VERSION # TO V10, EDIT 1, 1975 COPYRIGHT
+/10.   ADDED DOCUMENTATION ON LOCATION OF HANDLERS AND BUFFERS
+/11.   CORE ALLOCATION:
+/      WITHOUT /K, ALL CORE BUT 10000-11777 USED FOR SYMBOLS
+/      WITH /K, USES ALL CORE (AND SWAPS USR BETWEEN PASSES)
+/      UNDER BATCH, N5000-N7777 IS RESERVED FOR BATCH RESIDENT AS WELL
+/12.   /7 WITH HASH FEATURES PRINTS 7 COLUMN SYMBOL TABLE
+/13.   14-DEC-75 JR: FIXED TYPO IN /W CODE IN LITERAL DUMP ROUTINE
+
+/JR    14-APR-77 ADDED STANDARD DATE FORMAT TO HEADING
+\f/COMMAND DECODER RULES:
+
+/*BINARY(.BN),LISTING(.LS),CREF(.LS)<SOURCE(.PA),.../OPTIONS
+
+/OPTIONS:
+/B     BYTE SHIFT      - ! IS 6 BIT SHIFT (!=^100+)
+/C     CREF AFTER      - "CREFLS.TM" CREATED IF NO CREF
+/D     DDT TYPE SYMBOL - ONLY IF LISTING
+/E     'LG' ERROR      - LINKS ARE ERRORS
+/F     NO TEXT FILL    - NO EXTRA 0 FILL IN 'TEXT'
+/G     LOAD+GO AFTER   - SAME AS /L, BUT /G PASSED TO ABSLDR
+/H     NO PAGING       - ONLY IF LISTING
+/J     JUST WHAT LOADS - INHIBITS LISTING OF UNASSEMBLED CODE
+/K     CHECK FOR MORE THAN 8K OF CORE (DEFAULT IS 8K)
+/L     LOAD AFTER      - "PAL8BN.TM" CREATED IF NO BINARY
+/N     NO LISTING      - ONLY IF LISTING
+/O     NO 200 ORG      - NO AUTOMATIC 200 ORIGIN AFTER 'FIELD'
+/S     NO SYMBOL TABLE - ONLY IF LISTING
+/T     CR-LF NOT FF    - ONLY IF LISTING
+/W     WIPE LITERALS   - INHIBITS REMEMBERING OF LITERAL BOUNDS
+
+/PERMANENT PATCH LOCATIONS FOR THE ABOVE SWITCHES ARE SYMBOLS
+/OF THE FORM Z(SW)(PATCH) - E.G. ZT7640 IS THE LOC TO PATCH TO 7640
+/TO REVERSE THE POLARITY OF THE "T" SWITCH.
+
+/PSEUDO-OPS:
+/DECIMAL       RADIX TO BASE 10
+/DEVICE                2 WORD DEVICE CODE
+/DTORG         TYPESETTING TAPE ORIGIN
+/EJECT         SKIPS TO A NEW PAGE, AND IF ANY TEXT FOLLOWS,
+/              THAT TEXT BECOMES THE NEW HEADER LINE
+/ENPUNCH       ENABLE PUNCHING
+/EXPUNGE       REMOVE ALL SYMBOLS
+/FIELD         SET FIELD
+/FILENAME      4 WORD FILE CODE
+/FIXMRI                DEFINE MEMORY REFERENCE INSTRUCTION
+/FIXTAB                MAKE ALL SYMBOLS PERMANENT
+/IFDEF         CONDITIONAL ON DEFINITION
+/IFNDEF                CONDITIONAL ON UNDEFINED
+/IFNZRO                CONDITIONAL ON NON-ZERO
+/IFZERO                CONDITIONAL ON ZERO
+/NOPUNCH       DISABLE PUNCHING
+/OCTAL         RADIX TO BASE 8
+/PAGE          RE-ORIGIN TO BEGINNING OF NEXT PAGE OR PAGE N
+/PAUSE         ALTERNATE END-OF-FILE
+/RELOC         ASSEMBLE FOLLOWING CODE AS IF LOC = ARG OF RELOC
+/TEXT          6 BIT TEXT
+/XLIST         LISTING INHIBIT UNLESS THE XLIST IS
+/              FOLLOWED BY AN EXPRESSION. THEN IF THE EXPRESSION
+/              IS 0 START LISTING, OR NON-0 THEN INHIBIT LISTING
+/ZBLOCK                RESERVE BLOCK OF ZEROS
+\f/SYMBOL LAYOUT:
+
+/      WORD 1  BIT 0=1 PERMANENT SYMBOL
+/              BIT 1=1 "I" OR "Z"
+/              BITS 3-11       CHARS 1 AND 2
+/
+/      WORD 2  BIT 0=1 MEMORY REFERENCE INSTRUCTION
+/              BITS 2-11       CHARS 3 AND 4
+/
+/      WORD 3  BIT 0=1 PSEUDO-OP
+/              BITS 2-11       CHARS 5 AND 6
+/
+/      WORD 4  BITS 0-11       OCTAL VALUE
+/CHARS ARE STORED AS:
+/      A TO Z ARE 01 TO 32
+/      0 TO 9 ARE 33 TO 44
+/
+/      CHAR1^45+CHAR2
+
+/OPERATORS:
+/+             TWO'S COMPLEMENT ADD
+/-             TWO'S COMPLEMENT SUBTRACT
+/&             BOOLEAN AND
+/!             BOOLEAN INCLUSIVE 'OR' OR BYTE SHIFT
+/  (SPACE)     DELIMITER OR INCLUSIVE OR
+/^             MULTIPLY (REPEATED ADDITION)
+/%             DIVIDE (REPEATED SUBTRACTION)
+\f/DEFINITIONS
+
+ASWAP= 40              /WATCH THIS SWAP AREA!!
+MDATE= 7666            /MONITOR DATE
+BIPCCL=        7777            /DATE EXTENSION AND BATCH IN PROG FLG IN FIELD 0
+MPARAM=        7643            /COMMAND DECODER OPTION LIST
+DCB=   7760            /DEVICE CONTROL BLOCK
+JSBITS=        7746            /JOB STATUS WORD
+BATOUT=        7400            /BATCH LOG OUTPUT ROUTINE IN BATCH RESIDENT
+LNPRPG=        70              /56 LINES PER PAGE
+HEDLEN=        50              /40 CHARACTERS IN PAGE TITLE
+                       /(MUST BE A MULTIPLE OF 8)
+
+AC7776=        STA CLL RAL
+AC7775=        STA CLL RTL
+AC4000=        STL CLA RAR
+AC3777=        STA CLL RAR
+AC2000=        STL CLA RTR
+AC0002=        STL CLA RTL
+
+
+/TABLE OF ERROR MESSAGE DEFINITIONS
+
+
+IZ= "I-240^100+"Z-240  /ILLEGAL PAGE ZERO REFERENCE
+CF= "C-240^100+"F-240  /CREF.SV NOT FOUND
+US= "U-240^100+"S-240  /UNDEFINED SYMBOL
+IP= "I-240^100+"P-240  /ILLEGAL PSEUDO-OP USAGE
+SE= "S-240^100+"E-240  /SYMBOL TABLE EXCEEDED
+ZE= "Z-240^100+"E-240  /PAGE ZERO EXCEEDED
+PE= "P-240^100+"E-240  /CURRENT PAGE EXCEEDED
+IC= "I-240^100+"C-240  /ILLEGAL CHARACTER
+ID= "I-240^100+"D-240  /ILLEGAL DEFINITION
+BE= "B-240^100+"E-240  /PUSH-DOWN OVERFLOW
+DE= "D-240^100+"E-240  /DEVICE ERROR
+DF= "D-240^100+"F-240  /DEVICE FULL
+LD= "L-240^100+"D-240  /ABSLDR.SV NOT FOUND
+IE= "I-240^100+"E-240  /ILLEGAL EQUATE
+PH= "P-240^100+"H-240  /PHASE ERROR
+II= "I-240^100+"I-240  /ILLEGAL INDIRECT
+RD= "R-240^100+"D-240  /REDEFINITION
+UO= "U-240^100+"O-240  /UNDEFINED ORIGIN
+LG= "L-240^100+"G-240  /LINK GENERATED
+
+
+
+/ABBREVIATIONS
+/CR/LF CARRIAGE RETURN/LINE FEED (215,212)
+/F/F   FORM FEED (214)
+\f/PAGE ZERO
+
+*0
+FORMF6,        0               /USED IN DECIMAL PRINT ROUTINE
+ERROR5,        0               /USED BY PACKED ASCII PRINT ROUTINE
+PTR,   0               /V3C USED BY
+KNTR,  0               /INPUT ROUTINE
+
+/AUTOINDEX REGISTERS
+/PRESET FOR ONCE ONLY CODE
+
+*10
+PDLXR, PDLST           /PUSH-DOWN AUTO INDEX REGISTER
+TAGXR, SWAP1-1         /TAG AUTO INDEX REGISTER
+XREG1, DSWIT1-1        /GENERAL AUTO INDEX REGISTER
+XREG2, DSWIT2-1        /GENERAL AUTO INDEX REGISTER
+
+/NOT USED AS AUTO INDEX REGISTERS
+/EXCEPT DURING ONCE ONLY CODE
+
+LAST1, DATE-1          /LAST DEFINED SYMBOL
+LAST2, SWAP2-1
+LAST3, IFZERO  HASH    <SYMPRT+4-1>
+       IFNZRO  HASH    <SYMNWP-1>
+LAST4, IFZERO  HASH    <SYMPR9-2-1>
+       IFNZRO  HASH    <SYMDDT-1>
+
+*20
+TAG1,  0               /TAG STORAGE
+TAG2,  0
+TAG3,  0
+
+LITPTR,        200             /LITERAL POINTER
+
+RADIX, 0               /7777 IF DECIMAL MODE
+PUNCHX,        0               /NON-ZERO IF NO PUNCHING
+XLISTX,        0               /NON-ZERO IF NO LISTING
+/*NOTE* PUNCHX AND XLISTX MUST BE TOGETHER
+/AND IN THIS ORDER
+
+LOC,   200             /CURRENT LOCATION
+OFFSET,        0               /LOCATION COUNTER OFFSET FROM "LOC"
+OFSBUF,        0               /LOCATION COUNTER OFFSET BUFFER
+STARSW,        0               /-1 IF NEXT ORIGIN SHOULD BE INHIBITED
+
+OP,    0               /LAST OPERATOR CODE (0-6)
+VALUE, 0               /EXPRESSION VALUE
+VALUE2,        0               /EXPRESSION OPERAND
+
+TXTSWT,        0               /SPACE SWITCH
+TXTPTR,        LINBUF+120      /TEXT POINTER
+CHAR,  0               /CURRENT CHARACTER
+
+THISPG,        0               /OVERFLOW PAGE
+EDITPG,        0               /EDITOR PAGE
+\fTEMP, 0               /TEMPORARY REGISTERS
+TEMP1, 0
+TEMP2, 0
+TEMP3, 0
+
+OCHAR, OUTPUT          /OUTPUT ROUTINE
+OERROR,        OTYPEO          /PASS 1=OTYPEO; 2=OTYPEO; 3=LISOUT
+PASS,  -2              /-1 IF PASS 1, 0 IF PASS 2, 1 IF PASS 3
+IOMON, 200             /USER SERVICE ROUTINES
+CONDSW,        0               /NUMBER OF NESTED CONDITIONALS
+EXPIND,        0               /0 IF MRI OK HERE
+                       /NOT 0 IF MRI NOT OK HERE
+CHKSUM,        0               /BINARY CHECK SUM
+IZIND, 0               /"I" AND "Z" INDICATOR
+                       /IF I, LEFT 6 BITS ARE NON-ZERO
+                       /IF Z, RIGHT 6 BITS ARE NON-ZERO
+THISTG,        0               /ASSIGNED NUMBER OF CURRENT TAG
+HIGHTG,        SYME-SYMS%4-1   /ASSIGNED NUMBER OF LAST TAG
+LINCNT,        0               /LINE COUNT
+ALPHAI,        0               /UNDEFINED TAG INDICATOR
+                       /-1 IF UNDEFINED
+GETCI, 0               /NOT=0 IF ONLY CARRIAGE RETURN ENDS LINE
+                       /OTHERWISE /,;, OR CARRIAGE RETURN ENDS
+LSTCNT,        0               /TAB COUNTER
+UNDFSW,        0               /UNDEFINED SWITCH
+INCTL, 601             /CONTROL WORD - FOR OS/8 I/O
+LINKSW,        0               /OFF-PAGE LINK SWITCH
+                       /0 IF NO LINK GENERATED, 0700 IF LINK
+LININD,        0               /BACK-UP FOR LINKSW
+PERROR,        PERRO1          /DUMMY ERROR ROUTINE TO SUPPRESS CERTAIN
+                       /MESSAGES DURING PASS 1
+FLDIND,        "0              /CURRENT FIELD IN ASCII DIGIT FORM
+BINSRT,        0               /BINARY OR LISTING STARTING
+ERCNT, 0               /ERROR COUNTER
+LINK,  0               /LINK COUNTER
+       IFNZRO HASH<
+TAGMAX,        0               /SET TO PRIME # EQ TO MAX # SYMS
+       >
+       PAGE
+\f/STARTING ADDRESS OF PAL8 (0200)
+/CHAINING ADDRESS (0201)
+
+NAME1, JMP I NAME3     /NAME1-NAME3 USED LATER
+NAME2, JMP I GETTA2    /TO STORE TAGS AS THEY ARE BUILT
+NAME3, BEGIN           /V3C
+GETTA2,        NOCD            /BUILDING SWITCH AND OVERFLOW PROTECT
+
+
+/HANDLERS FOR NOPUNCH AND ENPUNCH PSEUDO-OPS
+
+NOPUNX,        CLA IAC         /NON-ZERO FOR NO PUNCHING
+ENPUNX,        DCA PUNCHX      /ZERO FOR PUNCHING
+       JMP I [LOOKEX   /--EXIT TO MAIN--
+
+
+/HANDLERS FOR DECIMAL AND OCTAL PSEUDO-OPS
+
+DECIMX,        STA             /7777 FOR DECIMAL RADIX
+OCTALX,        DCA RADIX       /ZERO FOR OCTAL RADIX
+       JMP I [LOOKEX   /--EXIT TO MAIN--
+\f/GET A TAG ROUTINE
+/PICKS UP A TAG AND SEARCHES FOR IT
+/"THISTG" HAS NUMBER OF TAG
+/"VALUE2" HAS VALUE
+/AC=7777 ON RETURN IF TAG NOT FOUND, 0 IF FOUND
+
+GETTAG,        0
+       DCA NAME1       /CLEAR BUILD AREA
+       DCA NAME2
+       DCA NAME3
+       TAD [NAME1
+       DCA GETTA4      /SET POINTER FOR BUILDING
+       DCA GETTA2      /ZERO SWITCH
+GETTG1,        TAD CHAR        /GET THE CHARACTER
+       AND [77         /MAKE IT 01-32 OR 60-71
+       TAD (-32        /WAS IT A TO Z?
+       SMA SZA
+       TAD (-25        /NO - MAKE 60-71 INTO 33-44
+       TAD (32         /YES - IT IS NOW 01-32 OR 33-44
+       ISZ GETTA2      /LEFT SIDE?
+       JMP GETTA3      /YES
+       TAD I GETTA4    /NO - RIGHT SIDE
+       DCA I GETTA4    /BUILD THE WORD
+       ISZ GETTA4      /BUMP TO NEXT WORD
+GETTA1,        JMS I [GETC     /GET NEXT CHARACTER
+       JMS I [TSTALN   /IS IT ALPHANUMERIC?
+       JMP GETTG1      /YES - KEEP BUILDING
+       IFZERO HASH<
+       TAD HIGHTG      /NO - GET NUMBER OF HIGHEST TAG
+       CLL RAR         /DIVIDE BY 2
+       DCA TEMP2       /SAVE DIFFERENCE
+       DCA THISTG      /START AT TAG ZERO
+       CLL CML         /LINK MUST BE ON INITIALLY
+       DCA TEMP1
+
+
+/GETTA4 IS POINTER TO NAME1-NAME3
+/FOR DEPOSITING TAG AS IT IS BUILT
+
+/TEMP2 IS # OF TAGS TO SKIP BETWEEN CHECKS FOR MATCH
+/DURING BINARY SEARCHING
+\fGETTG2,       SZL             /IS THISTG HIGHER THAN TAG?
+       JMP GETTG3      /NO-LOWER
+GETTG4,        DCA TEMP1       /CLEAR LAST TIME SWITCH
+       SNL
+       ISZ TEMP1       /SET LAST TIME SWITCH TO 1
+       TAD TEMP2       /GET # OF TAGS TO SKIP
+       SNL
+       CIA
+       TAD THISTG      /INCREASE OR DECREASE TAG NUMBER
+       DCA THISTG
+       TAD TEMP2       /GET NUMBER
+       CLL RAR         /DIVIDE BY 2
+       SNA             /IS RESULT 0?
+       ISZ TEMP1       /YES-BUMP LAST TIME SWITCH
+       SNA
+       IAC             /IF RESULT WAS 1, MAKE IT 2
+       DCA TEMP2       /SAVE IT FOR NEXT TIME
+       JMS I [FINDTG   /GET THE TAG
+       TAD [1777       /MASK
+       AND TAG1        /GET WORD 1
+       CLL CIA
+       TAD NAME1       /DOES IT MATCH?
+       SZA CLA
+       JMP GETTG2      /NO - TRY NEXT TAG
+       AC3777
+       AND TAG2        /YES - GET WORD 2
+       CLL CIA
+       TAD NAME2       /DOES IT MATCH?
+       SZA CLA
+       JMP GETTG2      /NO - TRY NEXT TAG
+       AC3777
+       AND TAG3        /YES - DOES IT MATCH?
+       CLL CIA
+       TAD NAME3
+       SZA CLA
+       JMP GETTG2      /NO - TRY NEXT TAG
+       JMP I GETTAG    /YES--RETURN--
+\fGETTG3,       AC7776
+       TAD TEMP1       /LAST TIME SWITCH = 2?
+       SZA CLA
+       JMP GETTG4      /NO-KEEP TRYING
+       ISZ THISTG      /YES-QUIT SEARCHING
+       DCA VALUE2
+       DCA TAG1
+       DCA TAG2
+       DCA TAG3        /TAG NOT FOUND
+       STA             /AC=7777 MEANS NOT FOUND
+       JMP I GETTAG    /--RETURN--
+       >
+\f      IFNZRO HASH<
+       PRIME=TAGMAX
+
+GETTGH,/JMS I  [TLYREF /HACK ONLY
+       TAD NAME1       /HASH OUR NAME
+       CLL RTL
+       TAD     NAME2
+       RTL
+       TAD     NAME3
+       RTL
+       TAD     NAME1
+       JMS     PROBE   /NOW PROBE THE TABLE
+       TAD     NAME1   /RE HASH THE NAME FOR A STEPSIZE
+       CLL RAL
+       RTL
+       TAD     NAME2
+       CLL             /CALC MODULO PRIME INLINE
+       TAD     MPRIME
+       SZL
+       JMP     .-3
+       TAD     PRIME
+       SNA
+       IAC             /STEPSIZE MUST BE NON ZERO!
+       DCA     CRPDEL
+PRBLUP,        CLL
+       TAD     THISTG  /BUMP THE POINTER RANDOMLY
+       TAD     CRPDEL
+       SZL             /PROTECT AGAINST WRAP AROUND
+       TAD     MPRIME  /PROBABLY UNOPTIMAL SOLUTION
+       JMS     PROBE
+       JMP     PRBLUP
+
+PROBE, 0
+       CLL
+       TAD     MPRIME
+       SZL
+       JMP     .-3
+       TAD     PRIME
+       DCA     THISTG  /THISTG MODULO PRIME
+/      JMS I   [TLYPRB /HACK ONLY
+       JMS I   [FINDTG /GO GET IT
+       TAD     [1777   /MASK THE TYPE BITS OUT
+       AND     TAG1    /IS THERE ONE?
+       SNA
+       JMP     NOTFND  /NO EXIT POINTING AT IT
+       CIA             /YES, DO A COMPARE
+       TAD     NAME1
+       SZA CLA
+       JMP I   PROBE
+       AC3777
+       AND     TAG2
+       CIA
+       TAD     NAME2
+       SZA CLA
+       JMP I   PROBE
+       AC3777
+       AND     TAG3
+       CIA
+       TAD     NAME3
+       SZA CLA
+       JMP I   PROBE   /FOUND EXIT WITH AC CLEAR
+       JMP I   GETTAG
+NOTFND,        STA             /NOT FOUND EXIT WITH AC SET
+       JMP I   GETTAG
+
+CRPDEL,        0
+MPRIME,        0               /INITIALIZED BY ONCE ONLY CODE FOR MACHINE AT HAND
+       >
+
+
+GETTA3,        DCA GETTA2      /SAVE CHAR
+       TAD GETTA2
+       CLL RTL         /*4
+       RAL             /*10
+       TAD GETTA2      /*11
+       RTL             /*44
+       TAD GETTA2      /*45
+       DCA I GETTA4    /SET LEFT SIDE
+       TAD GETTA4
+       TAD (-GETTA2
+       SZA CLA         /IS THIS AN OVERFLOW (>6) CHAR?
+       STA             /NO - SET SWITCH TO RIGHT HALF
+       DCA GETTA2      /YES - LEAVE SWITCH AT LEFT HALF
+       JMP GETTA1
+
+GETTA4,        NAME1
+\f/IGNORE SPACES ROUTINE
+
+SPNOR, 0
+       TAD CHAR        /GET THE CHARACTER
+       TAD [-240       /IS IT A SPACE?
+       SZA CLA
+       JMP I SPNOR     /NO --RETURN--
+       JMS I [GETC     /YES - GET NEXT CHARACTER
+       JMP SPNOR+1     /LOOP
+
+
+/HANDLER FOR PAUSE PSEUDO-OP
+/END-OF-TAPE OR END-OF-FILE
+
+PAUSEX,        AC4000
+       DCA CHAR        /SET END-OF-LINE CHARACTER
+       TAD [LINBUF+120 /REINITIALIZE TEXT POINTER
+       DCA TXTPTR
+       CLA CMA
+       DCA I (INCHCT   /INDICATE EMPTY BUFFER
+       ISZ I (INEOF    /SET END-OF-FILE
+       JMP I [LOOKEX   /--EXIT TO MAIN--
+       PAGE
+\f/OUTPUT 2 CHARACTER ERROR CODE
+
+ERROR1,        0
+       DCA ERROR5
+       TAD ERROR5
+       JMS I [RTL6
+       RAL
+       AND [77
+       TAD [240        /CONVERT SIXBIT TO ASCII
+       JMS I OERROR    /OUTPUT FIRST CHAR
+       TAD ERROR5
+       AND [77
+       TAD [240
+       JMS I OERROR    /OUTPUT SECOND CHAR
+       JMP I ERROR1    /--RETURN--
+
+/HANDLER FOR FIELD PSEUDO-OP
+
+FIELDX,        JMS I [SPNOR    /IGNORE SPACES
+       JMS I [DUMPS    /DUMP CURRENT PAGE LITERALS
+       JMS I [DUMPZ    /DUMP PAGE ZERO LITERALS
+       JMS I [EXP      /GET EXPRESSION
+       TAD VALUE       /TRIM TO RIGHT 3 BITS
+       AND [7
+       DCA FLDIND      /STORE FOR LISTING
+       TAD PASS        /IS THIS PASS 2?
+       SZA CLA
+       JMP FIELDY      /NO - PREPARE TO EXIT
+       TAD FLDIND      /YES - GET FIELD NUMBER
+       CLL RTL
+       RAL             /AND CHANNELS 7 AND 8
+       TAD [7700
+       JMS I OCHAR     /OUTPUT FIELD SETTING
+FIELDY,        JMS I [CLEAN    /CLEAN UP THINGS
+       TAD [200        /RESET ORIGIN TO 200
+       JMP STAR1
+
+/CHANGE LAST 2 LOCATIONS TO:
+/      CLA
+/      JMP STAR1+1
+/FOR INDAC GROUP TO OMIT RE-ORIGIN
+\f/HANDLER FOR PAGE PSEUDO-OP
+
+PAGEX, JMS I [DUMPS    /DUMP SAME PAGE LITERALS
+       JMS I (XLISTZ   /ANY EXPRESSION?
+       JMP PAGEY       /NO
+       JMS I [EXP      /YES - GET EXPRESSION
+       TAD VALUE
+       JMS I [RTL6
+       RAL             /GET PAGE NUMBER
+       JMP STAR3-1
+
+PAGEY, TAD LOC         /NO ARGUMENT - FIND NEXT PAGE
+       TAD [177
+       AND [7600
+STAR3, DCA VALUE
+       TAD VALUE       /GET START OF PAGE
+STAR1, JMS I [PUNORG   /PUNCH ORIGIN
+       JMS I [FINDSP
+       TAD [LITBUF     /RESET POINTERS
+       DCA TEMP
+       TAD I TEMP
+       DCA LITPTR      /INITIALIZE LITERAL POINTER FOR NEW PAGE
+       DCA LAST1
+       JMP I [PUNVAL   /SEE ABOUT DUMPING SOURCE CODE
+
+/HANDLER FOR FIXMRI PSEUDO-OP
+
+FIXMRX,        JMS I [SPNOR    /IGNORE SPACES
+       JMS I [TSTALP   /IS CHARACTER ALPHABETIC?
+       JMP FIXMR1      /YES-CONTINUE
+       JMS I [ICMESG   /NO - GENERATE IC MESSAGE, GET NEXT CHAR
+       JMP FIXMRX+1    /KEEP LOOKING FOR ALPHABETIC CH. OR END OF LINE
+FIXMR1,        JMS I [GETTAG   /PICK UP TAG
+       DCA ALPHAI      /STORE UNDEFINED SWITCH
+       SKP
+FIXMR2,        JMS I [ICMESG
+       JMS I [SPNOR    /IGNORE SPACES
+       TAD CHAR        /WAS CHARACTER = ?
+       TAD (-"=
+       SZA CLA
+       JMP FIXMR2      /NO - PRINT IC MESSAGE AND KEEP LOOKING
+                       /FALL INTO EQUALS PROCESSOR
+\f/HANDLER FOR =
+
+       AC4000          /FALL INTO HERE FROM FIXMRI
+EQUAL, JMS I [PUSHA    /PUSH FIXMRI FLAG
+       JMS I [GETC     /GET NEXT CHARACTER
+       TAD I (NAME1    /STORE THE SYMBOL NAME
+       JMS I [PUSHA    /ON THE PUSH DOWN LIST
+       TAD I (NAME2
+       JMS I [PUSHA
+       TAD I (NAME3
+       JMS I [PUSHA
+       TAD THISTG      /AND ITS PRESENT (OR FUTURE)
+       JMS I [PUSHA    /POSITION IN THE SYMTAB
+       TAD ALPHAI
+       JMS I [PUSHA    /STORE UNDEFINED INDICATOR
+       JMS I [SPNOR    /IGNORE SPACES
+       JMS I [EXP      /GET EXPRESSION TO RIGHT OF =
+       TAD I PDLXR
+       DCA ALPHAI      /RESTORE UNDEFINED INDICATOR
+       TAD I PDLXR
+       DCA THISTG      /RESTORE SYMBOL TABLE POSITION
+       TAD I PDLXR     /RESTORE TAG NAME
+       DCA I (NAME3
+       TAD I PDLXR
+       DCA I (NAME2
+       TAD I PDLXR
+       DCA I (NAME1
+       ISZ UNDFSW      /WAS ANY PART OF DEFINITION UNDEFINED?
+       JMP EQUAL3      /NO
+       JMS I PERROR    /YES - GENERATE IE ERROR MESSAGE
+       IE
+       ISZ PDLXR       /CLEAR EXTRA WORD FROM PDL
+       JMP I [PUNVAL   /FORGET ABOUT DEFINING TAG
+\f/MORE = PROCESSING
+
+EQUAL3,        ISZ ALPHAI      /WAS TAG DEFINED BEFORE?
+       JMP .+3         /YES - CHECK FOR ILLEGAL REDEFINITION
+       JMS I [INSRTG   /NO - INSERT TAG INTO SYMBOL TABLE
+       JMP EQUAL2      /AND BYPASS ILLEGAL REDEF CHECK
+       JMS I [FINDTG   /PUT TAG IN TAG1-TAGE AND VALUE2
+       TAD VALUE
+       CIA
+       TAD VALUE2
+       SZA CLA         /WERE DEFINITIONS THE SAME?
+       TAD TAG1        /NO - IS IT A PERMANENT SYMBOL?
+       SMA CLA
+       JMP EQUAL2      /NO - OK TO REDEFINE
+       JMS I [ERROR    /YES - GENERATE RD ERROR MESSAGE FIRST
+       RD
+EQUAL2,        TAD VALUE       /DEFINE OR REDEFINE
+       DCA VALUE2
+       AC3777
+       AND TAG2        /CLEAR OLD FIXMRI BIT
+       TAD I PDLXR     /INSERT NEW ONE
+       DCA TAG2
+       JMS I [PUTTAG   /STORE TAG
+       JMP I [PUNVAL   /SEE ABOUT DUMPING SOURCE CODE
+       PAGE
+\f/ROTATE AC 6 LEFT
+
+RTL6,  0
+       CLL RTL
+       RTL
+       RTL
+       JMP I RTL6      /--RETURN--
+
+
+/GET NEXT CHARACTER ROUTINE
+/READS FROM THE INPUT FILES AND PASSES THE MODIFIED CHARACTERS
+/TO THE PROGRAM
+/IT ALSO PRINTS THE LATEST LINE IF IT HAS NOT BEEN PRINTED
+
+GETC,  0
+       ISZ TXTPTR      /POINT TO NEXT CHARACTER
+GETC7, TAD I TXTPTR    /GET NEXT CHARACTER
+       SZA             /IS IT 0?
+       JMP GETC8       /NO - MORE ARE IN THIS LINE
+       TAD PASS        /IS THIS PASS 3?
+       SPA SNA CLA
+       JMP GETC1       /NO
+       TAD [LINBUF     /YES
+       DCA TXTPTR      /RESET POINTER TO BEGINNING
+       TAD I TXTPTR    /GET 1ST CHARACTER
+       SNA             /IS IT 0?
+       JMP GETC1       /YES - LINE HAS BEEN PRINTED
+       TAD [-215       /IS IT 215?
+       SNA CLA
+       JMP GETC2       /YES - DO NOT PRINT THE SPACES
+       TAD [211        /NO-OUTPUT 2 TABS
+       JMS I OERROR
+       TAD [211
+       JMS I OERROR
+GETC2, JMS LINPRT      /NOW PRINT THE LINE
+GETC1, TAD (-121
+       DCA TXTSWT
+       TAD (LINBUF-1
+       DCA TXTPTR      /RESET POINTER
+       ISZ TXTPTR
+GETC6, JMS I (INPUT    /GET NEXT CHARACTER
+       JMP GETC4       /215
+       DCA I TXTPTR    /STORE THE CHARACTER
+       ISZ TXTSWT      /TOO MANY?
+       JMP GETC6-1     /NO
+       CLA CMA         /YES
+       DCA TXTSWT
+       JMP GETC6
+\fGETC4,        DCA I TXTPTR    /SET END
+       ISZ TXTPTR
+       DCA I TXTPTR    /SET END OF LINE
+       TAD [LINBUF
+       DCA TXTPTR      /RESET POINTER
+       CLA CMA
+       DCA TXTSWT      /RESET SWITCH
+       JMP GETC7       /GET THAT CHARACTER
+
+GETC8, TAD [-215       /IS IT A CARRIAGE RETURN?
+       SNA
+       JMP GETC12      /YES-END OF LINE
+       TAD GETCI       /NO-
+       TAD (215-"/     /IS IT A /?
+       SNA             /YES-
+       JMP GETC13      /"/" IS END
+       TAD ("/-";      /IS IT A ;?
+       SNA             /YES-
+       JMP GETC12      /";" IS END
+       TAD (";-211     /IS IT A TAB?
+       SZA
+       TAD (211-240    /OR A SPACE?
+       SZA CLA
+       JMP GETC9       /NO-NOT ANYTHING SPECIAL
+       ISZ TXTSWT      /YES-2ND OCCURANCE?
+       JMP GETC+1      /YES - IGNORE
+       TAD [240
+       DCA CHAR        /NO - GIVE A SPACE
+       JMP I GETC      /--RETURN--
+
+GETC16,        ISZ CONDSW      /DECREMENT CONDITIONAL COUNTER
+       JMP GETC15
+GETC17,        TAD [LINBUF+120
+       DCA TXTPTR
+GETC12,        AC4000
+GETC9, TAD I TXTPTR
+       DCA CHAR        /STORE CHARACTER
+       CLA CMA
+       DCA TXTSWT      /SET THE SWITCH
+       JMP I GETC      /--RETURN--
+\fGETC13,       TAD CONDSW      /CURRENTLY IN CONDITIONALS?
+       SNA
+       JMP GETC17      /NO
+       DCA CONDSW      /STORE UPDATED CONDITIONAL LEVEL
+GETC15,        ISZ TXTPTR      /YES-SCAN LINE FOR < AND >
+       TAD I TXTPTR
+       TAD [-215       /IS CHARACTER A CARRIAGE RETURN?
+       SNA
+       JMP GETC17      /YES
+       TAD (215-">     /NO IS IT A >?
+       SNA
+       JMP GETC16      /YES
+       TAD (">-"<      /NO-IS IT <?
+       SNA CLA
+       STA             /YES - INCREMENT CONDITIONAL COUNTER
+       JMP GETC13      /NO - KEEP LOOKING
+
+
+/CHAR IS NEGATIVE IF LOGICAL END OF LINE:
+/      CARRIAGE RETURN
+/      /
+/      ;
+
+/CHAR MAY BE ZERO IF PHYSICAL END OF LINE:
+/      CARRIAGE RETURN
+\f/PRINT A LINE OF SOURCE CODE
+
+LINPRT,        0
+       TAD (LINBUF-1
+       DCA XREG1       /SET POINTER TO LINE
+LINPR1,        TAD I XREG1     /GET CHARACTER
+       SNA             /IS IT END OF LINE?
+       JMP I LINPRT    /YES - END LINE
+       JMS I OERROR    /NO - OUTPUT CHARACTER
+       DCA I [LINBUF   /CLEAR OUT 1ST CHAR IN LINE AS "PRINTED" FLAG
+       JMP LINPR1
+
+/HANDLE PHASE ERROR
+/AND ALL ERROR EXITS TO MONITOR
+
+SYMOFL,        CLA
+       TAD (SE         /SYMBOL TABLE EXCEEDED MESSAGE
+MONERR,        DCA MONER1      /ERROR IS SERIOUS ENOUGH TO
+PHASE, TAD (OTYPEO     / CAUSE IMMEDIATE RETURN TO
+       DCA OERROR      / MONITOR
+       JMS I [ERROR
+MONER1,        PH              /STORE ERROR TYPE HERE
+       JMP I [7600     /***EXIT TO MONITOR***
+
+
+/FIND CURRENT PAGE NUMBER
+/EXIT WITH NUMBER IN AC
+
+FINDSP,        0
+       TAD LOC
+       AND [7600
+       JMS I [RTL6
+       JMP I FINDSP    /--RETURN--
+       PAGE
+\f/**********************************************************
+/THIS AREA IS SWAPPED OUT DURING PASS 1 AND 2
+/** NO LITERALS IN THIS PAGE, AS THERE IS A PAGE OVERLAYING IT **
+
+SWAP1=.
+
+/PASS 3 LISTING OUTPUT
+
+LISOUT,        0
+       DCA LISOU2
+       TAD XLISTX      /IS THIS COVERED BY XLIST?
+       SZA CLA
+       JMP I LISOUT    /YES--RETURN--
+       ISZ LISCNT      /NO-WAS PREVIOUS CHARACTER A 215?
+       JMP LISOU1      /NO
+       ISZ LINCNT      /WAS IT END OF PAGE?
+       JMP LISOU1      /NO
+       ISZ THISPG      /YES-START OVERFLOW PAGE
+BEGIAB,        JMS CRLF        /OUTPUT CARRIAGE RETURN/LINE FEED
+HSWIT1,        JMS I [FORMFD   /0 IF /H SWITCH OPTION TO SUPRESS PAGING
+       ISZ LINCNT
+LISOU1,        TAD LISOU2      /IS CHARACTER A CARRIAGE RETURN?
+       TAD [-215
+       SNA
+       JMP LISOU3      /YES - OUTPUT CR/LF
+       TAD [215        /NO - RESTORE CHARACTER
+       JMS I OCHAR     /OUTPUT CHARACTER
+       JMP I LISOUT    /--RETURN--
+
+LISOU3,        CLA CMA
+       DCA LISCNT      /REMEMBER THE 215 FOR NEXT TIME
+       JMS CRLF        /OUTPUT CARRIAGE RETURN/LINE FEED
+       JMP I LISOUT    /--RETURN--
+
+LISCNT,        -1
+LISOU2,        0
+\f/FORM FEED OUTPUT ROUTINES
+
+FORMFD,        0
+       TAD LINCNT      /GET LINE COUNTER
+       TAD FORMLN
+       SNA CLA         /ARE WE AT TOP OF PAGE?
+       JMP I FORMFD    /YES - NO NEED FOR FORM FEED
+       TAD XLISTX      /IS THIS COVERED BY XLIST?
+       SZA CLA
+       JMP I FORMFD    /YES--RETURN--
+HSWITC,        JMP FORMF1      /0 IF /T OR TTY:; JMP FORMF3 IF /H
+                       /OUTPUT IF TTY:OR /T OPTION
+       TAD LINCNT
+       TAD [-4
+       DCA LINCNT
+       JMS CRLF        /OUTPUT CARRIAGE RETURN/LINE FEED
+       ISZ LINCNT
+       JMP CRLF1       /OUTPUT LINE FEED
+                       /CRLF1 WILL RETURN TO
+                       /JMP-1 UNTIL LINCNT HAS
+                       /BEEN BUMPED SUFFICIENTLY
+       TAD FORMM6
+       DCA LINCNT
+       TAD MINUS       /OUTPUT ------
+       JMS I OCHAR
+       ISZ LINCNT      /* NEXT 3 LOCS CHANGED IF NO /T OR TTY:
+FORMF1,        JMP .-3         /* STA
+       TAD [-4         /* DCA LINCNT   /GENERATE ONE FORM FEED
+       DCA LINCNT      /* STA          /TURN CR INTO FF
+       JMS CRLF        /OUTPUT CR/LF OR FF/LF
+       ISZ LINCNT
+       JMP CRLF1       /OUTPUT LINE FEED
+       TAD FORMLN
+       CIA
+       DCA LINCNT
+FORM22,        TAD [HEADER-1   /OUTPUT HEADER
+       DCA XREG2
+       DCA LSTCNT
+FORM30,        TAD I XREG2     /GET NEXT CHARACTER OF HEADING
+       SNA             /IS IT LAST + 1
+       JMP FORM20      /YES
+       JMS I OCHAR     /NO-OUTPUT IT
+       TAD LSTCNT
+       TAD [-HEDLEN    /DONE "HEDLEN" CHARACTERS YET?
+       SZA CLA
+       JMP FORM30      /NO-CONTINUE
+       TAD FORMHD      /YES-START SYSTEM HEADER
+       JMP FORM22      /WHICH STARTS AT HEADER+HEDLEN
+
+FORMLN,        LNPRPG
+FORMHD,        HEDLEN
+MINUS, "-
+\f/TTY: OR /T OUTPUTS FORM FEED AS
+/CARRIAGE RETURN, MULTIPLE LINE FEEDS TO END OF PAGE
+/------
+/CARRIAGE RETURN, 5 LINE FEEDS
+/HEADER
+/NO OPTIONS TREATS F/F AS
+/F/F, LF, CR/LF
+/HEADER
+
+/ /H OPTION TREATS F/F AS 2 CR/LF
+
+/USER HEADER IS "HEDLEN" CHARACTERS WIDE
+/ASSEMBLER HEADER ENDS WITH 0
+
+
+/OUTPUT PAGE NUMBERS
+
+FORM20,        TAD EDITPG      /OUTPUT EDITOR PAGE NUMBER
+       JMS FORMF4
+       TAD THISPG      /IS THERE PAGE OVERFLOW?
+       SNA CLA
+FORM21,        JMP FORMF3      /NO
+       TAD MINUS       /YES
+       JMS I OCHAR     /OUTPUT -
+       TAD THISPG      /OUTPUT NUMBER OF OVERFLOW PAGE
+       JMS FORMF4
+                       /OUTPUT IF /H OPTION
+FORMF3,        JMS CRLF        /OUTPUT 2 CR/LF
+       JMS CRLF
+       JMP I FORMFD    /--RETURN--
+\f/DECIMAL PRINT ROUTINE
+
+FORMF4,        0
+       DCA FORMF6      /SAVE NUMBER
+       TAD FORM8F
+       DCA CRLF        /POINT TO DIVISION LIST
+FORM12,        DCA FORMF7      /START WITH 0
+       JMP .+3
+FORMF5,        DCA FORMF6
+       ISZ FORMF7      /ADD 1 TO DIGIT
+       TAD I CRLF      /SUBTRACT 1000, 100, OR 10
+       SNA
+       JMP FORM11      /0 IS END OF TABLE - NO MORE DIGITS
+       TAD FORMF6
+       SMA             /OVERFLOW
+       JMP FORMF5      /NO-KEEP SUBTRACTING
+       CLA             /YES-DIGIT DONE
+       ISZ CRLF        /BUMP LIST POINTER
+       TAD FORMF7      /WAS DIGIT A 0?
+       SNA
+       JMP FORM12      /YES
+       TAD ["0         /NO-MAKE IT ASCII
+       JMS I OCHAR     /OUTPUT DIGIT
+       AC4000
+       JMP FORM12      /4000 IN AC FORCES SIGNIFICANCE
+
+FORM11,        TAD FORMF6      /GET LAST DIGIT (UNITS PLACE)
+       TAD ["0
+       JMS I OCHAR     /OUTPUT DIGIT
+       JMP I FORMF4    /--RETURN--
+
+FORMM6,        -6
+FORM8F,        FORMF8
+\f/OUTPUT CARRIAGE RETURN/LINE FEED
+/ENTER WITH AC=-1 TO GENERATE F/F LF
+
+HEDCL2,
+CRLF,  0
+       TAD [215
+       JMS I OCHAR
+CRLF1, TAD [212        /RE-ENTRY FOR MULTIPLE LINE FEEDS
+       JMS I OCHAR
+       JMP I CRLF      /--RETURN--
+
+/CLEAR PAGE HEADING BUFFER
+
+FORMF7,
+HEDCLR,        0
+       TAD [-HEDLEN    /SET HEADING BUFFER
+       DCA HEDCL2      /TO TABS
+       TAD [HEADER-1
+       DCA XREG2
+       TAD [211
+       DCA I XREG2
+       ISZ HEDCL2
+       JMP .-3
+       JMP I HEDCLR    /--RETURN--
+       PAGE
+\f/SYMBOL TABLE OUTPUT (COLUMNAR)
+                       /*CODE TO GENERATE DDT COMPATIBLE*
+                       /**SYMBOL TABLE--SUBSTITUTED WITH*
+                       /**ONCE ONLY CODE IF NEEDED*******
+       IFZERO  HASH<
+
+SYMPRT,        0
+       ISZ EDITPG                      /NEW PAGE
+       DCA THISPG
+       JMS I [FORMFD
+       TAD SMIN67      /DCA I SYMPR6-1
+       DCA SYMPR7      /JMS SYMPR9+6
+SYMPR8,        DCA SYMPR2      /TAD [377       //RUBOUT
+       CLA CMA         /JMS I OERROR
+       DCA THISTG      /CLA CMA
+       TAD SYMPR2      /DCA THISTG
+       CMA             /TAD [215       //CARRIAGE RETURN
+       DCA SYMPR3      /JMS I OERROR
+SYMPR5,        ISZ SYMPR3      /JMS SYMPPP
+       JMP SYMPR4      /JMP SYMPR9-1
+       TAD [-4         /JMP SYMPR6+2
+       DCA SYMPR3      /HSWIT1
+SYMPR6,        JMS SYMPPP      /204            //EOT
+       JMP SYMPRB
+SYMPR1,        TAD [1777
+       AND TAG1                        /OUTPUT TAG
+       JMS I SDIV45
+       TAD TAG2
+       JMS I SDIV45
+       TAD TAG3
+       JMS I SDIV45
+       TAD [240
+       JMS I OERROR                    /OUTPUT SPACE
+       TAD VALUE2
+       JMS OCTPRT                      /OUTPUT OCTAL VALUE
+       ISZ SYMPR3      /JMP SYMPR5-2
+       JMP SYMPR0      /TAD SYMPR6
+SYMPR9,        TAD [215        /JMS I OERROR   /CARRIAGE RETURN
+       JMS I OERROR    /TAD [377       //RUBOUT
+SYMPRB,        ISZ SYMPR7      /JMS I OERROR
+       JMP SYMPRA      /JMS SYMPR9+6
+HSWIT2,        JMS I [FORMFD   /DCA LINCNT     /0 IF NOT /H
+       TAD SMIN67      /JMP I SYMPRT   //--RETURN--
+       DCA SYMPR7      /0
+       TAD SYMOFS      /TAD [-200
+SYMPRA,        IAC             /DCA SYMPR2
+       TAD SYMPR2      /TAD [200       //LEADER-TRAILER
+       JMP SYMPR8      /JMS I OERROR
+
+SYMPR4,        JMS SYMPPP      /ISZ SYMPR2
+       JMP I SYMPRT    /JMP SYMPR4-2   /--RETURN--
+       JMP SYMPR5      /JMP I SYMPR9+6
+
+SDIV45,        DIV45
+SMIN67,        1-LNPRPG
+\fSYMPR0,       TAD SMIN67
+       DCA SYMPPB
+       JMS SYMPPP      /SKIP 67(8) SYMBOLS
+       JMP SYMPR9
+       ISZ SYMPPB
+       JMP .-3
+       JMS I [ERROR1
+       JMS I [ERROR1
+       JMS I [ERROR1
+       JMP SYMPR1      /GO PRINT THE 67TH(8) SYMBOL
+
+SYMPR2=        LINKSW
+SYMPR3=        UNDFSW
+SYMPR7=        ALPHAI
+SYMPPB=        CHKSUM
+
+SYMPPP,        0
+       ISZ THISTG
+SYMOFS,        245
+       TAD THISTG
+       CLL CIA
+       TAD HIGHTG
+       SNL CLA
+       JMP I SYMPPP    /--RETURN--
+       JMS I [FINDTG
+       AC4000
+       AND TAG1
+       TAD TAG3
+       SPA SZL CLA
+       JMP SYMPPP+1
+       ISZ SYMPPP
+       JMP I SYMPPP    /--RETURN--
+/SYMNCL,       -4      /DEFAULT IN LIU OF =N OPTION
+/SYMOFS,       245     /OFFSET TO FIRST SYM ON NEXT PAGE
+
+       >
+\f      IFNZRO  HASH<
+
+SYMPRT,        0
+       ISZ     EDITPG
+       DCA     THISPG
+       JMS I   [FORMFD /OUTPUT A HEADING
+       JMS I   SYMHND  /NOW READ THE SYMBOL TABLE SORT OVERLAY
+       0200            /2 PAGES
+SYMSRT,        OUDEVH+400      /TO HERE
+       ASWAP+1         /FROM HERE
+       JMP I   SYMERR  /UGH
+       JMS I   SYMSRT  /SORT THEM AND SET LINK
+SYMNWP,        DCA     SYMTAG  /POINT TO SYMBOL
+       SZL             /LINK OFF IF ANY SYMBOLS TO LIST
+       JMP I   SYMPRT  /NONE --RETURN--
+       TAD     SMIN67  /SET LINE/PAGE COUNT
+       DCA     SYMLCT
+SYMPAG,        TAD     HIGHTG
+       CLL CIA
+       TAD     SYMTAG
+       SZL CLA
+       JMP I   SYMPRT  /NO MORE IF AT HIGHTAG NOW
+       TAD     SYMTAG
+       DCA     THISTG  /PREPARE TO PRINT LEFTMOST SYMBOL
+       TAD     SYMNCL  /4 PER LINE (DEFAULT)
+       DCA     SYMCCT  /TO COLLUMS/LINE CNTR
+       JMP     SYMGO
+SYMLIN,        JMS I   [ERROR1
+       JMS I   [ERROR1
+       JMS I   [ERROR1
+       TAD     HIGHTG
+       CLL CIA
+       TAD     THISTG
+       SZL CLA
+       JMP     SYMNXL  /SKIP TO NEXT LINE IF OFF TABLE
+\fSYMGO,        JMS I   [FINDTG /OK, GET IT
+       TAD     TAG1
+       JMS I   SDIV45
+       TAD     TAG2
+       JMS I   SDIV45
+       TAD     TAG3
+       JMS I   SDIV45
+       TAD     [240
+       JMS I   OERROR
+       TAD     VALUE2  /PRINT VALUE NOW
+       JMS     OCTPRT
+SYMDDT,        TAD     SMIN67
+       CLL CIA
+       TAD     THISTG
+       DCA     THISTG
+       SZL
+       JMP     SYMNXL  /SKIP IF WRAP AROUND
+       ISZ     SYMCCT  /ELSE DO NEXT COLUMN
+       JMP     SYMLIN
+SYMNXL,        TAD     [215
+       JMS I   OERROR  /CR/LF
+       ISZ     SYMTAG  /POINT TO NEXT SYMBOL
+       ISZ     SYMLCT
+       JMP     SYMPAG
+HSWIT2,        JMS I   [FORMFD
+       TAD     SYMTAG
+       CLL
+       TAD     SYMOFS  /OFFSET TO NEXT SYMBOL
+       JMP     SYMNWP  /DO THE NEXT PAGE
+
+SDIV45,        DIV45
+SMIN67,        -67
+SYMERR,        SYSERR
+SYMHND,        7607
+SYMOFS,        245             /DEFAULT
+SYMNCL,        -4
+       SYMTAG= LINKSW
+       SYMLCT= UNDFSW
+       SYMCCT= ALPHAI
+       ZBLOCK  4       /WASTE SOME SPACE
+       >
+
+
+/END OF AREA WHICH MAY BE SWAPPED OUT
+/DURING PASSES 1 AND 2
+/**********************************************************************
+
+       ENDOVL= .
+\f/OCTAL PRINT ROUTINE
+/ENTER WITH # TO BE OUTPUT IN AC
+/** DO NOT USE TEMPS BELOW THIS LOC!
+
+OCTPRT,        0
+       DCA OCTPR1
+       TAD [-4
+       DCA OCTPR3
+OCTPR2,        TAD OCTPR1      /GET EACH DIGIT SEPARATELY
+       CLL RTL
+       RAL
+       DCA OCTPR1
+       TAD OCTPR1
+       RAL
+       AND [7
+       TAD ["0         /MAKE IT INTO AN ASCII CHARACTER
+       JMS I OERROR    /OUTPUT IT
+       ISZ OCTPR3
+       JMP OCTPR2
+       JMP I OCTPRT    /--RETURN--
+
+OCTPR1,        0
+OCTPR3,        0
+\f/OUTPUT ONE REGISTER
+
+PUNONE,        0
+       TAD PASS        /WHICH PASS IS THIS?
+       SNA
+       JMP PUNON2      /PASS 2--OUTPUT BINARY
+       SPA CLA
+       JMP PUNON3      /PASS 1--EXIT
+       TAD FLDIND      /GET FIELD NUMBER
+       TAD ["0         /CONVERT TO ASCII
+       JMS I OERROR    /PRINT IT
+       TAD LOC         /GET LOW ORDER 4 DIGITS (LOC CTR)
+       JMS OCTPRT      /PRINT IT TOO
+       TAD OFFSET      /IF THIS CODE IS IN A RELOC SECTION,
+       SZA CLA         /
+       TAD (1200       /FLAG THE LOCATION COUNTER WITH A *
+DTORG1,        JMS I [ERROR1   /OUTPUT 2 SPACES
+       TAD VALUE
+       JMS OCTPRT      /OUTPUT CONTENTS
+       TAD I [LINBUF   /IS THERE SOURCE CODE TO DUMP?
+       SNA CLA
+       JMP PUNON1      /NO-OUTPUT CARRIAGE RETURN
+       TAD LINKSW      /YES-DUMP LINK SWITCH (' ) OR (  )
+       JMS I [ERROR1
+       JMS I [LINPRT   /DUMP SOURCE CODE
+       JMP PUNON3      /AND EXIT
+
+PUNON1,        TAD LINKSW      /NO LINE - OUTPUT LINK SWITCH ANYWAY
+       SZA             /IF THERE IS ONE
+       JMS I [ERROR1
+       TAD [215        /OUTPUT CARRIAGE RETURN
+       JMS I OERROR
+PUNON3,        DCA LINKSW      /CLEAR LINK SWITCH
+       JMP I PUNONE    /--RETURN--
+
+/PASS 2-OUTPUT ONE REGISTER
+
+PUNON2,        TAD VALUE       /GET CONTENTS
+       CLL
+       JMS I [PUNOUT   /OUTPUT AS 2 FRAMES
+       JMP PUNON3      /AND EXIT
+       PAGE
+\f/**CURRENT PAGE LITERALS ON THIS PAGE WILL BE LOST**
+/***WHEN OVERLAYED BY PUSHDOWN LIST**
+
+/ARRANGE TO OUTPUT ONE REGISTER
+
+PUNBIN,        0
+       DCA VALUE
+       JMS I [FINDSP   /FIND CURRENT PAGE NUMBER
+       TAD [LITBUF
+       DCA TEMP2       /POINT TO NUMBER OR LITERALS
+       TAD LOC
+       AND [177
+       DCA TEMP
+       TAD I TEMP2     /IS PAGE FULL?
+       CIA
+       TAD TEMP
+       ISZ TEMP
+       SPA CLA
+       JMP ONEOK       /NO-OK TO ADD ONE MORE REGISTER
+       TAD TEMP        /YES-
+       DCA I TEMP2
+       JMS I [FINDSP   /FIND CURRENT PAGE NUMBER
+       JMS I PPEZE     /GENERATE PE OR ZE ERROR
+ONEOK, JMS I [FINDSP   /FIND CURRENT PAGE NUMBER
+       TAD [TPINST
+       DCA TEMP2
+       TAD TEMP        /IS THIS ADDRESS HIGHER THAN PREVIOUS
+       CIA             /HIGH INSTRUCTION PAGE?
+       TAD I TEMP2
+       SMA CLA
+       JMP PUNMOD      /NO
+       TAD TEMP        /YES-THIS IS NEW HIGH INSTRUCTION
+       DCA I TEMP2
+
+PUNMOD,        JMS I [PUNONE   /OUTPUT THIS REGISTER
+       ISZ LOC         /GET NEXT LOCATION
+       TAD LOC         /IF THE "ISZ" SKIPS IT IS O.K. (A 0)
+       AND [177        /IS THIS FIRST INSTRUCTION ON NEXT PAGE?
+       SZA CLA
+       JMP I PUNBIN    /NO--RETURN--
+       JMS I [FINDSP   /YES-FIND CURRENT PAGE NUMBER
+       TAD [LITBUF     /RESET POINTERS
+       DCA TEMP2
+       TAD I TEMP2
+       DCA LITPTR
+       JMP I PUNBIN    /--RETURN--
+
+PPEZE, PEZE
+\fHEADER,       "S;"Y;"M;"B;"O;"L;"S
+       211;211;211;211;211     /FOR /N HEADER
+
+/************************************************************
+/CODE OVERLAYED ON PASS 3
+/BY USER HEADER BUFFER
+
+/CONTINUATION OF EXPUNGE HANDLER
+/ENTER ON PASS 1 ONLY
+
+EXPUNW,        IFZERO  HASH<
+       DCA TEMP1
+       DCA EXPUN2      /CLEAR NEW HIGH TAG COUNTER
+       TAD HIGHTG
+       CMA
+       DCA TEMP3       /SAVE NUMBER OF SYM TBL ENTRIES
+EXPUNY,        TAD TEMP1
+       DCA THISTG
+       JMS I [FINDTG   /GET A SYMBOL
+       TAD TAG1        /ONLY SAVE THE SYMBOL IF
+       RTL
+       CLA             /IT WAS A PSEUDO-OP, OR
+       TAD TAG3        /THE SYMBOLS I OR Z
+       SNL SMA CLA
+       JMP EXPUA4      /NO-FORGET TAG
+       TAD EXPUN2      /YES-RETURN TAG TO SYMBOL TABLE
+       DCA THISTG
+       JMS I [PUTTAG
+       ISZ EXPUN2
+EXPUA4,        ISZ TEMP1
+       ISZ TEMP3       /DONE YET?
+       JMP EXPUNY      /NO- TRY NEXT TAG
+       CLA CMA         /YES
+       TAD EXPUN2      /RESET HIGH TAG
+       DCA HIGHTG
+       JMP I [LOOKEX   /--EXIT TO MAIN--
+
+EXPUN2,        0
+       >
+\f      IFNZRO  HASH<
+       /HASH TABLE EXPUNGE - DEPENDS ON PSEUDO OPS
+       /BEING HASHED FIRST. SCANS WHOLE TABLE (SLOW AS HELL!)
+
+       DCA     THISTG  /POINT TO FIRST ENTRY
+       TAD     TAGMAX  /SET THE COUNT
+       CIA
+       DCA     TEMP1
+EXPUNL,        JMS I   [FINDTG /GO GET ONE
+       TAD     TAG1    
+       RTL
+       CLA
+       TAD     TAG3
+       SPA SZL CLA     /PSEUDO OP?
+       JMP     EXPUNS  /YES, SKIP DELETION
+       DCA     TAG1    /NO, WIPE IT
+       DCA     TAG2
+       DCA     TAG3
+       JMS I   [PUTTAG /AND PUT IT BACK
+       STA
+       TAD     HIGHTG
+       DCA     HIGHTG  /DECREMENT SYMBOL COUNT
+EXPUNS,        ISZ     THISTG  /POINT TO NEXT ENTRY
+       ISZ     TEMP1   /TALLY COUNT
+       JMP     EXPUNL  /GET ANOTHER
+       JMP I   [LOOKEX /DONE --RETURN--
+       >
+
+/***************************************************************
+\f/ASSEMBLER HEADER BUFFER
+
+       ZBLOCK  HEADER+HEDLEN-.
+
+       " ;" ;"P;"A;"L;"8;"-
+       "V;"1;VERSION-12+"0;SUBVERSION
+       " 
+DATE,  "N;"O;" ;"D;"A;"T;"E;"  /GETS SET TO DD-MMM-YY IF DATE PRESENT
+       " ;" ;"P;"A;"G;"E;" ;0
+\f/PUSHDOWN LIST
+/OCCUPIES NEXT 43(8) LOCATIONS
+PDLND=.
+
+
+
+/*********************************************************
+/ONCE ONLY CODE FOR /D OPTION
+/PUT INTO SYMLST FOR DDT COMPATIBLE SYMBOL TABLE
+/OVERLAYED DURING ASSEMBLY BY PUSHDOWN LIST
+
+DSWIT1,        IFZERO  HASH<
+       RELOC SYMPRT+4
+
+       DCA I SYMPRF
+       JMS SYMPRC
+       TAD [377
+       JMS I OERROR
+       CLA CMA
+       DCA THISTG
+SYMPRE,        TAD [215
+       JMS I OERROR
+       JMS SYMPPP
+       JMP SYMPRD
+       JMP SYMPR1
+SYMPRF,        HSWIT1
+SYM204,        204
+       RELOC
+
+       >
+       IFNZRO  HASH<
+       RELOC   SYMNWP
+       DCA     THISTG
+       DCA I   SYMHSW
+       JMS     DDTLDR
+       TAD     [377
+       JMS I   OERROR
+SYMLUP,        TAD     [215
+       JMS I   OERROR
+       TAD     HIGHTG  
+       CLL CIA
+       TAD     THISTG
+       SZL CLA
+       JMP     SYMXIT
+       JMP     SYMGO
+SYMHSW,        HSWIT1
+       RELOC
+       >
+DSWITA=        .
+
+/**********************************************************
+       PAGE
+\f/*************************************************************
+
+/PAL8 TABLES - LOAD OVER INITIALIZATION CODE
+
+PDLST= PDLND+42        /PUSHDOWN LIST 43(8) LOCS LONG
+
+
+LINBUF=        PDLST+1         /LINE BUFFER OCCUPIES 122(8) LOCATIONS
+
+LITBUF=        LINBUF+122      /LITERAL TABLE IS 40(8) LOCATIONS (ONE PER PAGE)
+                       /  SHOWING LOWEST PAGE ADDRESS USED FOR LITERALS
+
+TPINST=        LITBUF+40       /TOP INSTRUCTION TABLE IS 40(8) LOCTIONS
+                       /  SHOWING HIGHEST PAGE ADDRESS USED FOR INSTRUCTIONS
+
+LITBF2=        TPINST+40-17    /LITERAL BUFFER 2 CONTAINS UP TO 160(8)
+                       /PAGE 0 LITERALS, SUBSCRIPTS 20-177
+
+LITBF1=        LITBF2+200-100  /LITERAL BUFFER 1 CONTAINS UP TO 100(8)
+                       /CURRENT PAGE LITERALS, SUBSCRIPTS 100-177
+
+/*************************************************************
+\f/ONCE ONLY CODE FOR ASSEMBLER START UP
+/OVERLAYED BY BUFFERS
+
+/HANDLES SWITCH OPTIONS
+
+BEGIN, CIF 10
+       JMS I IOMON     /CALL USER SERVICE ROUTINES
+       5               /*COMMAND DECODER*
+       2001            /DEFAULT INPUT EXTENSION IS .PA
+NOCD,  CDF 10          /RETURN
+       TAD I (7604     /IS THERE A BINARY FILE EXTENSION?
+       SNA
+       TAD (216        /NO - DEFAULT EXTENSION IS .BN
+       DCA I (7604     /YES 
+       TAD I (7611     /IS THERE A LISTING FILE EXTENSION?
+       SNA
+       TAD (1423       /NO - DEFAULT EXTENSION IS .LS
+       DCA I (7611
+       TAD I (MPARAM+1 /WAS THE /T OPTION SELECTED?
+       CDF
+       AND (20
+ZT7640,        SNA CLA
+       JMP BEGINA      /NO
+BEGIAA,        DCA I (HSWITC   /YES - GENERATE CR/LF IN PLACE OF F/F
+       JMP BEGIN2
+
+BEGINA,        TAD [7605       /WAS TTY THE PASS 3 DEVICE?
+       JMS I (OTYPE
+       AND (770
+       SNA CLA
+       JMP BEGIAA      /YES - GENERATE CR/LF IN PLACE OF F/F
+       DCA I (BEGIAB   /NOT /T OR TTY:
+
+BEGIN2,        CDF 10
+       TAD I (MPARAM+1 /WAS THE /S OPTION SELECTED?
+       CDF
+       AND (40
+       SZA CLA
+       DCA I (SSWITC   /YES -OMIT SYMBOL TABLE
+       CDF 10
+       AC2000
+       AND I (MPARAM+1
+       CDF
+       SNA CLA         /WAS THE /N OPTION SELECTED?
+       JMP BEGIN4      /NO
+       TAD BEGSKP      /SET SWITCH
+       DCA I (NSWITC   /YES -SYMBOL TABLE BUT NO LISTING
+\fBEGIN4,       CDF 10
+       TAD I (MPARAM   /WAS THE /H OPTION SELECTED?
+       CDF
+       AND (20
+ZH7640,        SNA CLA
+       JMP BEGINB      /NO
+BEGHSW,        TAD I (FORM21   /YES -SUPPRESS LISTING PAGE FORMAT
+       DCA I (HSWITC
+       DCA I (HSWIT1
+BEGSKP,        CLA SKP
+BEGINB,        DCA I (HSWIT2
+       CDF 10
+       TAD I (MPARAM   /WAS THE /D OPTION SELECTED?
+       CDF
+       AND [400
+ZD7640,        SNA CLA
+       JMP BEGIN1      /NO
+       TAD I XREG1     /YES -DDT COMPATIBLE SYMBOL TABLE
+       DCA I LAST3     /SUBSTITUTE ALTERNATE CODE
+       ISZ DSWIT3      /INTO SYMBOL TABLE OUTPUT ROUTINE
+       JMP .-3
+       TAD I XREG2
+       DCA I LAST4
+       ISZ DSWIT4
+       JMP .-3
+
+BEGIN1,        TAD I (JSBITS   /RESET JOB STATUS WORD TO
+       AND (6777       /INDICATE PAL8 NOT RESTARTABLE
+       TAD (1000
+       DCA I (JSBITS
+       CIF CDF 10
+       JMS I   (FMTDAT /CALL ROUTINE IN FIELD 1 TO SETUP DATE
+       JMP I   (BEGINZ /CONTINUE ON
+\f
+DSWIT3,        DSWIT1-DSWITA
+DSWIT4,        DSWIT2-DSWITB
+       PAGE
+\f/ONCE ONLY CODE CONTINUED
+/ASSEMBLER INITIALIZATION PROCEDURES
+
+
+BEGINZ,        TAD [7600       /WHAT DEVICE FOR BINARY OUTPUT?
+       JMS I (OTYPE
+       SMA CLA
+       TAD (-70        /STAND-ALONE
+       TAD (-10        /DIRECTORY
+       DCA I (SWAPR2+LEADER    /SET AMOUNT OF LEADER TRAILER
+       DCA LAST1       /NO DEFINED TAG
+BEGIN5,        IFZERO  HASH<
+       CDF
+       TAD I BLK1      /MOVE SYMBOL TABLE TO FIELD 1
+       CDF 10
+       DCA I BLK2
+       ISZ BLK1
+       ISZ BLK2
+       ISZ BLK3
+       JMP BEGIN5
+       >
+       CDF
+       DCA I [LINBUF+120       /SET BUFFER POINTERS
+       DCA I (LINBUF+121
+       TAD [7600       /IS PTP BINARY OUTPUT DEVICE?
+       JMS I (OTYPE
+       DCA BLK1
+       TAD BLK1
+       AND (770
+       TAD (-20
+       SNA CLA
+       DCA I (PTPSW    /YES - SET PTP SWITCH
+       TAD BLK1        /NO - IS IT A DIRECTORY DEVICE?
+       SPA CLA
+       JMP .+3         /NO
+       TAD (TAD [77    /YES - SET DIRECTORY SWITCH
+       DCA I (DIRSW
+       TAD [7605       /IS PTP GETTING LISTING OUTPUT?
+       JMS I (OTYPE
+       AND (770
+       TAD (-20
+       SNA CLA
+       DCA I (SWAPR2+PTPSW1    /YES - SET PASS 3 PTP SWITCH
+       TAD [7605       /NO - IS DIRECTORY DEVICE GETTING
+       JMS I (OTYPE    /LISTING OUTPUT?
+       SPA CLA
+       JMP .+3         /NO
+       TAD (TAD [77    /YES - SET PASS 3 DIRECTORY SWITCH
+       DCA I (SWAPR2+DIRSW1
+       JMP I (BEGINF
+\fMONLST,       TEXT    /JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC/
+       *.-1
+
+/CONTINUED CHECK OF COMMAND DECODER OPTIONS
+
+BEGINH,        CDF 10
+       TAD I (MPARAM   /WAS THE /G OR /L OPTION CHOSEN?
+       CDF
+       AND (41
+       SNA CLA
+       JMP I (BEGISW   /NO
+       CDF 10          /YES
+       TAD I [7600
+       SZA CLA         /WAS THERE A BINARY OUTPUT FILE?
+       JMP YESBIN      /YES
+BINLOP,        TAD PALBIN      /NO - CREATE FILE PAL8BN.TM
+       DCA I PALBIX    /ON SYSTEM DEVICE
+       ISZ BINLOP
+       ISZ PALBIX
+       ISZ BINCNT
+       JMP BINLOP
+       CDF
+       TAD (-10        /SET AMOUNT OF LEADER TRAILER
+       DCA I (SWAPR2+LEADER
+\f/SET UP FOR LOAD OR LOAD AND GO
+
+YESBIN,        CDF
+       CIF 10
+       CLA IAC
+       JMS I IOMON     /CALL USER SERVICE ROUTINES
+       2               /* LOOKUP PERMANENT FILE *
+LOAD,  PLOAD           /FILENAME ABSLDR.SV
+BINCNT,        -5              /FILE LENGTH
+       JMP NOLOAD      /ABSLDR.SV NOT FOUND
+       TAD LOAD        /NORMAL RETURN
+       DCA I (CHAIN    /SET STARTING BLOCK NUMBER
+       DCA I (LSWITC   /FOR CHAIN CALL
+       JMP I (BEGISW
+
+NOLOAD,        JMS I [ERROR    /GENERATE LD ERROR MESSAGE
+       LD
+       JMP I (BEGISW   /ASSEMBLE BUT DO NOT CHAIN TO LOADER
+
+BLK1,  SYMS
+BLK2,  7600+SYMS-SYME
+BLK3,  SYMS-SYME
+
+PALBIX,        7600
+PALBIN,        1
+       FILENAME PAL8BN.TM
+       PAGE
+\fCCC,  TAD I CC231     /FINAL PIECE OF STARTUP ONCE-ONLY CODE
+       SNA
+       TAD CC23
+       DCA I CC231     /"HSWITC"=JMP FORMF1 IF WAS 0
+BEGISW,        CDF 10
+       TAD I CCJWD
+       CDF 0
+       AND CCJBIT
+ZJ7640,        SNA CLA         /WAS /J OPTION SPECIFIED?
+       DCA I CCJLOC    /NO - PRINT UNASSEMBLED CONDITIONAL CODE
+       CDF 10
+       TAD I CCWWD
+       CDF 0
+       AND CCWBIT
+ZW7640,        SNA CLA         /WAS /W OPTION SPECIFIED?
+       JMP D4          /V3C
+D5,    TAD I CC231
+       CIA
+       TAD CC23
+       SZA CLA         /ARE WE OUTPUTTING FF'S IN LISTING?
+       JMP BEGIS3      /NO
+       TAD CC24        /YES - SUBSTITUTE SOME CODE
+       DCA I CC25
+       TAD CC26
+       DCA I CC27
+       TAD CC24
+       DCA I CC28
+BEGIS3,        JMS I OVLL7     /CALL SYSTEM DEVICE
+       4200            /WRITE 2 PAGES
+       SWAP1           /FORM SWAP1
+       ASWAP           /INTO TEMP AREA
+       JMP I OVLL8     /ERROR?!
+       TAD I LAST2     /MOVE PASS 1&2 ONLY CODE
+       DCA I TAGXR     /OVER PASS3 SWAPPED OUT CODE
+       ISZ CC29
+       JMP     .-3
+       IFNZRO  HASH<
+       JMS I   CCHSH   /FINALLY HASH OUT THE TABLE
+       >
+
+       JMP I   .+1
+       START2-1        /OK - NOW GO DO SOME ASSEMBLING!
+D4,    DCA I CCWLOC    /NO - DON'T WIPE LITERALS AS YOU DUMP THEM
+       DCA I (D3
+       JMP D5          /V3C
+\fOVLL7,        7607
+OVLL8, SYSER3
+
+CC231, HSWITC
+CC23,  FORMF1&177+5200
+CC24,  STA
+CC25,  FORMF1
+CC26,  DCA LINCNT
+CC27,  FORMF1+1
+CC28,  FORMF1+2
+CC29,  SWAPB2-SWAPE2
+
+       IFNZRO  HASH<
+CCHSH, HSHSMS
+       >
+CCJWD, MPARAM
+CCJBIT,        4
+CCJLOC,        IFTST4
+CCWWD, MPARAM+1
+CCWBIT,        2
+CCWLOC,        LITHAK
+PLOAD, FILENAME ABSLDR.SV
+
+CKBAT, TAD I CC7777    /GET BATCH FLAG WORD
+       CLL RTL
+       SNL CLA         /BATCH RUNNING?
+       JMP I CCOPTM    /NO, GO WITH LINK OFF
+       TAD I CC7777
+       AND CC0070      /GET BATCH FIELD
+       TAD CCCIF0      /FORM CIF TO BATCH FIELD
+       DCA OTYPB1      /MODIFY TTY OUTPUT ROUTINE TO GO TO BATCH
+       TAD CCJMSB      /LOG INSTEAD
+       DCA OTYPB2
+       TAD OTYPTD
+       DCA OTYPB3
+       JMP I CCOPTM    /RETURN TO CORE DETERMINER, LINK SET
+
+CC7777,        7777
+CCOPTM,        OPTIM4
+CC0070,        70
+CCCIF0,        CIF 0
+CCJMSB,        JMS I [BATOUT
+\f/THIS CODE SITS AFTER THE END OF THE LITERAL TABLE
+
+       IFNZRO  .-LITBF1-200&4000 <*LITBF1+200>
+
+OTYPEO,        0               /TYPE A CHARACTER, CHECKING FOR ^O AND ^C
+       DCA OTYPEC      /SAVE CHAR
+       JMS CTCCHK      /CHECK FOR ^C - RETURN CHAR-203 IN AC
+       TAD (-14
+       SNA CLA         /^O?
+       JMP I OTYPEO    /YES
+OTYPTD,        TAD OTYPEC
+OTYPB1,        TLS
+OTYPB2,        TSF
+OTYPB3,        JMP     .-1     /WAIT FOR TTY
+       TAD     [-215
+OTYPCR,        SZA CLA         /SET TO CLA DURING "ERRORS DETECTED" STUFF
+       JMP I   OTYPEO
+       TAD [212        /IF CHAR WAS CR, TYPE LF
+       JMP OTYPEO+1
+OTYPEC,        0
+
+CTCCHK,        0               /CHECK FOR ^C
+       TAD [200
+       KRS             /OR IN KEYBOARD CHAR
+       TAD (-203
+       SNA
+       KSF             /3B BUT WAS CHAR REALLY THERE?
+       JMP I CTCCHK    /NO ^C - RETURN
+       JMP I [7600     /RETURN TO OS/8
+
+TTLMSG,        "E-240^100+"R-240       /ERRORS DETECTED:
+       "R-240^100+"O-240
+       "R-240^100+"S-240
+       "D-240
+       "E-240^100+"T-240
+       "E-240^100+"C-240
+       "T-240^100+"E-240
+       "D-240^100+":-240
+       0
+
+       "L-240^100+"I-240       /LINKS GENERATED:
+       "N-240^100+"K-240
+       "S-240^100
+       "G-240^100+"E-240
+       "N-240^100+"E-240
+       "R-240^100+"A-240
+       "T-240^100+"E-240
+       "D-240^100+":-240
+       0
+       PAGE
+\f/OUTPUT A CHARACTER TO OUTPUT DEVICE
+/CALLED BY JMS I OCHAR
+/WITH CHARACTER IN 8-BIT ASCII IN AC
+
+OUTPT1,        PUNCHX          /PASS 2=PUNCHX; 3=XLISTX
+
+OUTPUT,        0
+       AND [377        /MASK OUT LEFT 4 BITS
+       DCA OUTPT2      /STORE
+       TAD I OUTPT1    /IS THIS PASS 3 AND
+       SNA
+       TAD OUTINH      /IS THIS COVERED BY XLIST?
+       SZA CLA
+       JMP I OUTPUT    /YES--RETURN--
+       TAD OUTPT2      /NO - GET CHARACTER
+       AND [200
+       SNA CLA
+       TAD OUTPT2      /IF LESS THAN 200, THEN
+       TAD CHKSUM      /ADD IT TO CHECKSUM
+       DCA CHKSUM
+       TAD OUTPT2      /GET CHARACTER
+       TAD (-211       /IS IT A TAB?
+       SNA CLA
+       JMP OUTPT3      /YES - OUTPUT SPACES
+       JMS OUTPUX      /NO - OUTPUT CHARACTER
+       TAD OUTPT2      /IS IT LINE FEED?
+       TAD (-212
+       SZA CLA
+       JMP I OUTPUT    /NO--RETURN--
+       TAD [7773       /YES - RESET LSTCNT
+       DCA LSTCNT
+       JMP I OUTPUT    /--RETURN--
+
+\f/OUTPUT SPACES INSTEAD OF TAB
+
+OUTPT3,        TAD [240
+       DCA OUTPT2
+       JMS OUTPUX      /OUTPUT SPACE
+       TAD LSTCNT      /TAB STOPS ARE EVERY 8 SPACES
+       AND [7
+       SZA CLA
+       JMP .-4
+       JMP I OUTPUT    /--RETURN--
+
+/OUTPUT THE CHARACTER
+/PACKS CHARACTERS IN STANDARD OS/8 FORMAT
+
+OUTPUX,        0
+       ISZ OUJMP       /BUMP 3-WAY SWITCH
+OUJMP, HLT             /WILL BE CHANGED - SHOULD NEVER HALT
+       JMP OCHAR1      /CHARACTER #1
+       JMP OCHAR2      /CHARACTER #2
+OCHAR3,        TAD OUTPT2      /CHARACTER #3
+       CLL RTL
+       RTL
+       AND [7400
+       TAD I OUPOLD    /ADD 4 BITS TO WORD 1
+       DCA I OUPOLD
+       TAD OUTPT2
+       CLL RTR
+       RTR
+       RAR
+       AND [7400
+       TAD I OUPTR     /ADD 4 BITS TO WORD 2
+       DCA I OUPTR
+       TAD OUJMPE
+       DCA OUJMP       /RESET SWITCH
+       ISZ OUPTR
+       ISZ OUDWCT      /BUFFER FULL?
+       JMP OUCHLV      /NO
+       TAD [200        /YES
+       JMS I (OUTDMP   /DUMP BUFFER
+       JMS OUSETP      /RESET POINTERS
+       JMP OUCHLV
+
+\fOCHAR2,       TAD OUPTR       /SAVE POINTER
+       DCA OUPOLD
+       ISZ OUPTR
+OCHAR1,        TAD OUTPT2
+       DCA I OUPTR     /SET 8 BIT WORD
+OUCHLV,        TAD OUTPT2
+       TAD [40
+       AND [100        /CHECK FOR PRINTABLE CHAR
+       SZA CLA         /IF IT IS,
+       ISZ LSTCNT      /BUMP TAB COUNT
+OUTINH,        0               /ALWAYS 0 OR 1!
+       JMP I OUTPUX    /--RETURN--
+
+OUPOLD,        0
+OUPTR, 0
+OUJMPE,        JMP OUJMP
+OUDWCT,        0
+OUTPT2,        0
+
+OUSETP,        0
+       TAD [7600       /SET OUTPUT WORD COUNT
+       DCA OUDWCT      /TO 200
+       TAD (OUBUF
+       DCA OUPTR       /RESET POINTER
+       TAD OUJMPE
+       DCA OUJMP       /RESET SWITCH
+       CLL             /MUST CLEAR LINK!!
+       JMP I OUSETP    /--RETURN--
+\f/HANDLER FOR DEVICE PSEUDO-OP
+
+DEVICX,        JMS I [SPNOR    /IGNORE TRAILING SPACES
+       TAD [-5
+       JMP DEVIC1      /PACK 4 CHARACTERS
+
+
+/HANDLER FOR FILENAME PSEUDO-OP
+
+FILENX,        JMS I [SPNOR    /IGNORE TRAILING SPACES
+       TAD (-7
+       JMS FILE1       /PACK 6 CHARACTERS
+       TAD CHAR
+       TAD [-".        /WAS CHARACTER . ?
+       SNA CLA
+       JMS I [GETC     /YES-SKIP TO EXTENSION
+       AC7775
+DEVIC1,        JMS FILE1       /PACK 2 CHARACTERS
+       JMP I [LOOKEX   /--EXIT TO MAIN--
+
+/PACK CHARACTERS
+/NEGATIVE OF # OF CHARACTERS TO BE PACKED IN AC ON ENTRY
+
+FILE1, 0
+       DCA FILE6       /SAVE # OF CHARACTERS TO PACK
+       DCA I (TEXT6    /RESET PACK SWITCH
+FILE4, JMS I [TSTALN   /IS CHARACTER IN CHAR ALPHANUMERIC?
+       SKP
+       JMP FILE5       /NO-DONE PACKING
+       ISZ FILE6       /YES-TOO MANY CHARACTERS?
+       JMP FILE3       /NO-O.K.
+       CLA CMA /YES
+       DCA FILE6       /RESET # OF CHARACTERS AND IGNORE
+       JMP FILE2
+
+FILE3, TAD CHAR
+       JMS I (TEXT2    /PACK A CHARACTER
+FILE2, JMS I [GETC     /GET A CHARACTER
+       JMP FILE4       /TEST IT
+
+       JMS I (TEXT2    /PACK A ZERO CHAR
+FILE5, ISZ FILE6       /ARE WE DONE?
+       JMP .-2         /NO - PAD WITH ZEROES
+       JMP I FILE1     /YES--RETURN--
+FILE6, 0
+       PAGE
+\f/HANDLER FOR TEXT PSEUDO-OP
+/SPACES ARE IGNORED TO DELIMITER
+/DELIMITER IS FIRST PRINTING CHARACTER
+/OTHER THAN SPACE
+/NON-PRINTING CHARACTERS ARE ILLEGAL
+/A PRINTING CHARACTER HAS EITHER BIT 5
+/OR BIT 6 SET, BUT NOT BOTH
+
+TEXT8, JMS I [GETC     /GET NEXT CHARACTER
+TEXTX, CLL CLA CML RAR /AC=4000
+       DCA GETCI       /; AND / ARE NOT END OF LINE
+       JMS TEXT1A      /CHECK FOR PRINTING CHARACTER
+       JMP TEXT8       /NON PRINTING - IGNORE
+       TAD [-240       /IGNORE SPACES UNTIL DELIMITER
+       SNA             /HAS BEEN FOUND
+       JMP TEXT8
+       TAD [240        /RESTORE CHARACTER
+       CIA
+       DCA VALUE2      /STORE NEGATIVE DELIMITER
+       DCA TEXT6       /SET PACKING SWITCH
+TEXT3, JMS I [GETC     /GET NEXT CHARACTER
+       JMS TEXT1A      /IS IT A PRINTING CHARACTER?
+       JMP TEXT9       /NO - IC
+       TAD VALUE2      /YES - IS IT DELIMITER?
+       SNA CLA
+       JMP TEXT4       /YES - TERMINATE
+       TAD CHAR        /NO - PACK AND OUTPUT
+       JMS TEXT2       /PACK IT
+       JMP TEXT3
+
+TEXT4, DCA GETCI       /RESET GETCI TO CALL ; AND / END OF LINE
+       JMS I [GETC     /SKIP DELIMITER
+TEXT4X,        JMS TEXT2       /OUTPUT 0 TO FILE
+       JMS TEXT2
+/CHANGE TEXT4X TO:
+/      NOP
+/FOR NO EXTRA WORD OF ZEROS
+       DCA GETCI       /RESET GETCI IN CASE WE HIT CR
+       JMP I [LOOKEX   /--EXIT TO MAIN--
+\fTEXT9,        JMS I [ERROR    /GENERATE IC ERROR MESSAGE
+       IC
+       JMP TEXT3
+
+/SKIP ON PRINTING CHARACTER
+
+TEXT1A,        0
+       TAD CHAR
+       SPA SNA CLA     /IS CHARACTER -
+       JMP TEXT4X      /YES
+       TAD CHAR
+       TAD [40
+       AND [100
+       SZA CLA         /IS THE CHAR PRINTING?
+       ISZ TEXT1A      /YES - INCREMENT RETURN
+       TAD CHAR        /WITH CHARACTER IN AC
+       JMP I TEXT1A    /--RETURN--
+
+/OUTPUT 2 TEXT CHARACTERS (ONE REGISTER)
+/ENTER WITH CHARACTERS IN AC
+
+TEXT2, 0
+       AND [77         /GET RIGHT 6 BITS
+       ISZ TEXT6       /WHICH HALF OF WORD?
+       JMP TEXT5       /LEFT
+       TAD TEXT7       /RIGHT--ADD IN LEFT HALF
+       JMS I [PUNBIN   /OUTPUT IT
+       JMP I TEXT2     /--RETURN--
+
+TEXT5, JMS I [RTL6     /GET LEFT HALF OF WORD
+       DCA TEXT7       /SAVE IT
+       CLA CMA         /SET SWITCH FOR RIGHT HALF
+       DCA TEXT6
+       JMP I TEXT2     /--RETURN--
+
+TEXT6, 0
+TEXT7, 0
+\f/HANDLER FOR EXPUNGE PSEUDO-OP
+
+EXPUNX,        TAD PASS        /IS THIS PASS 1
+       SMA CLA
+       JMP I [LOOKEX   /NO--EXIT TO MAIN--
+       JMP I (EXPUNW   /YES-CONTINUE AT EXPUNW
+
+
+
+/CLOSE OUTPUT FILE
+
+OCLOSE,        0
+       TAD I (OUTINH   /OUTPUT INHIBITED?
+       SZA CLA
+       JMP I OCLOSE    /YES--RETURN--
+PTPSW, TAD [232        /NO-0 IF PTP: - OUTPUT ^Z
+       JMS I OCHAR
+       JMS I OCHAR     /AND ZEROS
+FILLLP,        JMS I OCHAR
+DIRSW, TAD [177        /TAD [77 IF NOT DIRECTORY
+       AND I (OUDWCT   /FILL OUT BUFFER OR HALF BUFFER
+       SZA CLA         /WITH ZEROS
+       JMP FILLLP
+       TAD I (OUDWCT   /IS THERE OUTPUT TO BE DUMPED?
+       TAD [200
+       SZA
+       JMS OUTDMP      /YES - DUMP IT
+       TAD OUFILE      /GET DEVICE NUMBER IN AC
+       CIF 10
+       JMS I IOMON     /CALL USER SERVICE ROUTINES
+       4               /*CLOSE OUTPUT FILE*
+OUCNAM,        0               /POINTER TO FILENAME TO BE DELETED
+OUCCNT,        0               /LENGTH OF NEW PERMANENT FILE
+       JMP SYSER3      /DE**FATAL ERROR**
+       JMP I OCLOSE    /--RETURN--
+
+OUFILE,        ZBLOCK 5
+\f/OUTPUT DUMP
+/AC CONTAINS CONTROL WORD FOR DUMP
+
+OUTDMP,        0
+       TAD [4000       /BE SURE CONTROL WORD IS
+       DCA OUCTLW      /A WRITE OPERATION
+       TAD OUBLK       /GET STARTING BLOCK NUMBER
+       TAD OUCCNT      /ADD IN COUNT
+       DCA OUREC       /SET THIS BLOCK NUMBER
+       TAD OUCTLW
+       TAD [100        /ROUND HALF-BLOCK, IF ANY
+       CLL RTL
+       RTL
+       RTL
+       AND [17         /GET THIS COUNT
+       TAD OUCCNT
+       DCA OUCCNT      /ADD TO TOTAL COUNT
+       TAD OUCCNT      /IS OUTPUT DEVICE FULL?
+       CLL CML
+       TAD OUELEN      /CHECK AGAINST MAXIMUM LENGTH
+       SNL SZA CLA
+       JMP SYSER2      /DF**FATAL ERROR**
+       JMS I OUHNDL    /CALL OUTPUT DEVICE HANDLER
+OUCTLW,        0               /CONTROL WORD
+       OUBUF           /BEGINNING OF OUTPUT BUFFER
+OUREC, 0               /STARTING BLOCK NUMBER
+SYSER3,        CLA SKP         /ERROR RETURN
+       JMP I OUTDMP    /--RETURN--
+SYSERR,        TAD (DE         /DE **FATAL ERROR**
+       JMP I [MONERR
+
+OUHNDL,        0
+OUBLK, 0
+OUELEN,        0
+
+SYSER2,        TAD (DF         /GENERATE DF ERROR MESSAGE
+       JMP I [MONERR   /**FATAL ERROR**
+       PAGE
+\f/MAINLINE CODE
+
+LOOKE2,        0               /WAS THIS END OF LINE
+       TAD CHAR        / OR END OF CONDITIONAL?
+       TAD [-">
+       SNA
+       JMP CONEND      /END OF CONDITIONAL
+       TAD (">
+       SMA CLA
+       JMP I LOOKE2    /NOT END OF LINE--RETURN--
+LOOKE1,        JMS I [GETC     /GET A CHARACTER
+MAIN,  JMS I (CTCCHK   /CHECK FOR ^C
+       CLA             /** CTCCHK RETURNS AC NON-ZERO!
+       JMS I [SPNOR    /IGNORE SPACES
+       TAD CHAR
+       TAD (-"$        /WAS IT $ ?
+       SNA             /YES--
+       JMP I (ENDPAS   /NO-END THIS PASS
+       TAD ("$-"*
+       SNA CLA         /WAS IT * ?
+       JMP STAR        /YES-HANDLE *
+       JMS I [TSTALP   /NO-WAS IT ALPHABETIC?
+       JMP ALPHA       /YES
+       JMS LOOKE2      /NO
+TOEXP, JMS I [EXP      /GET REST OF EXPRESSION
+       TAD LININD
+       DCA LINKSW      /STORE LINK SWITCH
+       TAD VALUE
+       JMS I [PUNBIN   /OUTPUT THE REGISTER
+LOOKEX,        JMS I [SPNOR    /IGNORE TRAILING SPACES
+       JMS LOOKE2      /IS LINE ENDED?
+ILCHAR,        JMS I [ERROR    /NO-GENERATE IC ERROR MESSAGE
+       IC
+       JMP CONEN1
+
+CONEND,        TAD CONDSW      /ARE WE INTO CONDITIONALS?
+       SNA
+       JMP ILCHAR      /NO - > IS ILLEGAL
+       IAC             /ONE LESS CONDITIONAL
+       DCA CONDSW
+CONEN1,        JMS I [GETC     /GET NEXT CHARACTER
+       JMP LOOKEX      /AND TRY FOR END AGAIN
+\f/HANDLER FOR *
+
+STAR,  JMS I [GETC     /GET NEXT CHARACTER AFTER *
+       JMS I [SPNOR    /IGNORE SPACES
+       JMS I [EXP      /GET REST OF EXPRESSION
+STAR0, DCA STARSW      /ENTER HERE FROM RELOC WITH AC = -1
+       ISZ UNDFSW      /WAS ANYTHING UNDEFINED?
+       JMP .+3         
+       JMS I [ERROR    /YES-GENERATE UO ERROR MESSAGE
+       UO
+       TAD VALUE       /NO
+       DCA OP
+       TAD LOC         /IS THIS THE SAME PAGE AS
+       AND [7600       /THE PREVIOUS CODE?
+       CIA
+       TAD OP
+       AND [7600
+       SNA CLA
+       JMP STAR2       /YES-PUNCH ORIGIN
+       JMS I [DUMPS    /NO-DUMP LITERALS
+       TAD OFSBUF      /SET OFFSET TO NEW VALUE
+       DCA OFFSET      /AFTER LITERALS ARE DUMPED.
+       TAD OP          /PUNCH NEW ORIGIN, SET "VALUE"
+       JMP I (STAR3    /FOR LISTING, AND SET UP IN NEW PAGE
+
+STAR2, TAD OFSBUF      /SET OFFSET TO NEW VALUE
+       DCA OFFSET      /
+       TAD OP
+       JMS I [PUNORG   /PUNCH ORIGIN
+       DCA LAST1       /CLEAR LAST DEFINED SYMBOL
+       JMP I [PUNVAL
+
+ALPHA, JMS I [GETTAG   /PICK UP TAG-IS IT IN TABLE?
+       DCA ALPHAI      /STORE UNDEFINED TAG SWITCH
+       TAD TAG3        /IS IT A PSEUDO-OP?
+       SPA CLA
+       JMP I VALUE2    /YES-GO TO ITS HANDLER
+       TAD CHAR        /NO
+       TAD (-",        /WAS IT TERMINATED BY , ?
+       SNA
+       JMP COMMA       /YES-DEFINE THE SYMBOL
+       TAD (",-"=      /NO-WAS IT TERMINATED BY = ?
+       SNA CLA
+       JMP I (EQUAL    /YES-EQUATE THE SYMBOL
+       AC4000          /NO
+       JMP TOEXP       /TREAT AS AN EXPRESSION
+\f/HANDLER FOR ,
+
+COMMA, JMS I [GETC     /GET NEXT CHARACTER
+       ISZ ALPHAI      /WAS TAG DEFINED PREVIOUSLY?
+       JMP COMMA2      /YES
+       TAD LOC         /NO-STORE CURRENT ADDRESS FOR DEFINITION
+       DCA VALUE2
+       JMS I [INSRTG   /PUT TAG IN SYMBOL TABLE
+COMMA1,        TAD TAG1        /STORE FOR ERROR MESSAGE OUTPUT
+       DCA LAST1
+       TAD TAG2
+       DCA LAST2
+       TAD TAG3
+       DCA LAST3
+       TAD VALUE2
+       DCA LAST4
+       JMP MAIN        /--EXIT TO MAIN--
+
+COMMA2,        TAD LOC         /DO NEW AND OLD DEFINITIONS AGREE?
+       CIA
+       TAD VALUE2
+       SNA CLA
+       JMP COMMA1      /YES-ALLOW REDEFINITION
+       JMS I [ERROR    /NO-GENERATE ID ERROR MESSAGE
+       ID
+       JMP MAIN        /--EXIT TO MAIN--
+\fOPTABL,       OP0             /+
+       OP1             /-
+       OP6             /%
+       OP2             /&
+       OP5             /(SPACE)
+OPEXPL,        OP5             /! - CHANGED TO OP3 IF /B ON
+       OP4             /^
+       PAGE
+\f/EXPRESSION PROCESSOR
+/POSSIBLE RECURSIVE ENTRY
+/ENTER WITH CHARACTER IN CHAR
+
+EXP,   0
+       DCA EXPIND      /SET INDICATOR (NOT 0 IF NO MRI FOUND)
+       DCA LININD      /CLEAR LINK GENERATED SWITCH (' )
+       DCA VALUE       /START WITH "VALUE" = 0
+       DCA UNDFSW      /CLEAR UNDIFINED SWITCH
+       TAD EXP
+       JMS I [PUSHA    /SAVE RETURN ADDRESS
+       DCA OP          /OP=0; ADD
+       TAD EXPIND
+       SPA CLA
+       JMP I (EXPINT
+       TAD CHAR        /IS CHARACTER A + ?
+       TAD [-"+
+       CLL RTR         /PUT THE 2 BIT IN THE LINK
+       SZA CLA         /WAS CHAR 53(+) OR 55(-)?
+       JMP EXP1A       /NO
+       RAL             /YES - OP IS 0 OR 1, DEPENDING
+EXP1,  DCA OP
+       JMS I [GETC     /GET NEXT CHARACTER
+       ISZ EXPIND      /MRI NO LONGER LEGAL ON THIS LINE
+EXP1A, TAD CHAR        /IS CHARACTER A . ?
+       TAD [-".
+       SNA
+       JMP PERIOD      /YES-GO TO . HANDLER
+       TAD (".-""      /NO-IS IT " ?
+       SNA
+       JMP QUOTE       /YES-GO TO " HANDLER
+       TAD (""-"[      /NO-IS IT [ ?
+       CLL
+       SZA
+       TAD ("[-"(      /OR (?
+       SNA CLA
+       JMP I (LIT      /YES - LITERAL - LINK HOLDS WHICH KIND
+       JMS I [TSTALP   /NO-IS IT ALPHABETIC?
+       JMP I (ALPHA1   /YES-HANDLE SYMBOL
+       JMS I [TSTNUM   /NO-IS IT NUMERIC?
+       JMP NUMBER      /YES-HANDLE NUMBER
+
+EXP2,  JMS ENDCHK      /NO-CHECK FOR END
+       JMP EXP1A       /NOGO - TRY AGAIN
+       TAD OP
+       TAD [-4         /IS OP SPACE (4)
+       SNA CLA
+       JMP I (EXPXIT   /YES-EXIT
+       JMS I [ERROR
+       IC              /GIVE IC MESSAGE ON ILLEGAL OPERATOR
+       JMP I (EXPINT   /EXIT ANYWAY
+\f/END OF EXPRESSION CHECK
+/SKIP IF OK
+
+ENDCHK,        0
+       TAD CHAR
+       TAD (-"]        /IS CHARACTER A ] ?
+       SZA             /YES-SKIP A EXIT
+       TAD ("]-")      /IS CHARACTER A ) ?
+       SZA             /YES-SKIP A EXIT
+       TAD (")-">      /IS CHARACTER A > ?
+       SZA             /YES-SKIP AND EXIT
+       TAD (">-"<      /IS CHARACTER A < ?
+       SNA
+       JMP ENDCH1      /YES-SKIP AND EXIT
+       TAD ("<
+       SPA CLA         /IS IT END-OF-LINE?
+       JMP ENDCH1      /YES-SKIP AND EXIT
+       JMS I [ICMESG   /NO - GENERATE IC MESSAGE AND GET NEXT CHAR
+       JMP I ENDCHK    /--RETURN--
+
+ENDCH1,        ISZ ENDCHK      /INCREMENT RETURN ADDRESS
+       JMP I ENDCHK    /--RETURN--
+
+NUMBER,        DCA TEMP
+NUMBE2,        TAD RADIX       /IS THE CURRENT RADIX OCTAL?
+       SNA CLA
+       TAD CHAR        /YES-IS THE DIGIT GREATER THAN 7?
+       TAD (-"8
+       SMA CLA
+       JMP NUMBE3      /YES-ILLEGAL CHARACTER
+       TAD TEMP        /NO-ADD IT TO THE PREVIOUS
+       CLL RAL         /ACCUMULATED VALUE
+       CLL RAL
+       DCA TEMP2
+       TAD RADIX       /IS RADIX OCTAL?
+       AND TEMP        /NO
+       TAD TEMP2       /YES
+       CLL RAL
+       TAD CHAR
+       TAD (-"0
+       DCA TEMP
+       JMS I [GETC     /GET NEXT CHARACTER
+NUMBE4,        JMS I [TSTNUM   /IS IT NUMERIC?
+       JMP NUMBE2      /YES-CONTINUE ACCUMULATING NUMBER
+       TAD TEMP        /NO-STORE NUMBER
+NUMBE1,        DCA VALUE2
+NUMBE5,        TAD OP          /GO COMBINE IT VIA LAST OPERATION
+       TAD (OPTABL
+       DCA TEMP        /FIND THE OPERATOR HANDLER
+       TAD I TEMP
+       DCA TEMP
+       JMP I TEMP      /GO TO THE HANDLER
+\f/8 OR 9 FOUND DURING OCTAL RADIX
+
+NUMBE3,        JMS I [ICMESG   /GENERATE IC ERROR MESSAGE AND
+       JMP NUMBE4      /IGNORE CHARACTER
+
+
+/HANDLER FOR .
+
+PERIOD,        JMS I [GETC     /GET NEXT CHARACTER
+       TAD LOC         /MAKE CURRENT LOCATION
+       JMP NUMBE1      /INTO VALUE OF NUMBER
+
+/HANDLER FOR "
+
+QUOTE, ISZ TXTPTR
+       TAD I TXTPTR    /GET CHARACTER FROM TEXT BUFFER
+       TAD [-215       /WAS IT CARRIAGE RETURN?
+       SNA CLA
+       JMP QUOTE1      /YES-IT IS IC-IGNORE "
+       TAD I TXTPTR    /NO-PUT ASCII CODE INTO
+       DCA VALUE2      /VALUE WORD
+       JMS I [GETC     /GET NEXT CHARACTER
+       JMP NUMBE5      /RETURN TO EXPRESSION PROCESSOR
+
+/CARRIAGE RETURN FOUND IN SINGLE CHARACTER TEXT
+
+QUOTE1,        JMS I [ERROR    /GENERATE IC ERROR MESSAGE
+       IC
+       CLA CMA
+       DCA CHAR
+       JMP I (EXPXIT
+       PAGE
+\f/COME HERE IF FIRST THING IN EXPRESSION IS ALPHA CHARACTER
+
+ALPHA1,        JMS I [GETTAG   /PICK UP TAG
+       DCA ALPHAI      /STORE UNDEFINED INDICATOR
+ALPHA3,        TAD TAG3        /IS IT A PSEUDO-OP?
+       SMA CLA
+       JMP .+3
+       JMS I [ERROR    /YES-GENERATE IP ERROR MESSAGE
+       IP
+       ISZ ALPHAI      /NO-WAS IT UNDEFINED?
+       JMP ALPHA0
+       ISZ UNDFSW      /YES-SET UNDEFINED SWITCH
+       TAD PASS        /IS THIS PASS 1?
+       SPA CLA
+       JMP ALPHA0      /YES-SUPPRESS ERROR MAESSAGE
+       JMS I [ERROR    /NO-GENERATE US ERROR MESSAGE
+       US
+ALPHA0,        TAD TAG2        /NO-WAS IT A MEMORY REFERENCE INSTRUCTION?
+       SPA CLA
+       TAD CHAR        /YES-GET TERMINATING CHARACTER
+       TAD [-240       /WAS IT SPACE?
+       SZA CLA
+       JMP I (NUMBE5   /NOT MEMREF FOLLOWED BY SPACE
+       JMS I [SPNOR    /YES-IGNORE SPACES
+       TAD CHAR
+       SPA CLA
+       JMP I (NUMBE5
+       TAD EXPIND      /IS MEMORY REFERENCE INSTRUCTION OK?
+       SZA CLA
+       JMP I (NUMBE5   /NO-
+       DCA IZIND       /YES-CLEAR I AND Z INDICATOR
+       TAD VALUE2      /STORE MRI ON PUSHDOWN LIST
+       JMS I [PUSHA
+\fALPHA6,       TAD IZIND
+       JMS I [PUSHA    /PUSH THE I AND Z INDICATOR
+       JMS I [TSTALP   /WAS TERMINATING CHARACTER ALPHABETIC?
+       SKP
+       JMP ALPHA4      /NO-
+       JMS I [GETTAG   /YES-PICK UP TAG
+       DCA ALPHAI      /STORE UNDEFINED INDICATOR
+       AC2000
+       AND TAG1        /WAS IT AN I OR Z?
+       SNA CLA
+       JMP ALPHA5      /NO
+       TAD VALUE2      /YES-WAS IT I?
+       SNA
+       IAC             /NO - SET LOW ORDER
+       TAD I   PDLXR   /GET OLD IZIND FROM PDL
+       DCA IZIND       /SET NEW IZIND
+       JMS I [SPNOR    /IGNORE SPACES
+       JMP ALPHA6
+
+EXPINT,        TAD EXPIND
+       TAD [4000
+       DCA EXPIND
+       JMP ALPHA3
+
+ALPHA5,        AC4000
+ALPHA4,        IAC
+       JMS I [EXP      /GET REST OF EXPRESSION
+       TAD I PDLXR     /RETRIEVE MRI
+       DCA IZIND
+       TAD I PDLXR
+       DCA VALUE2
+                       /FALL INTO NEXT PAGE
+\f/COMBINE ADDRESS WITH MEMORY REFERENCE INSTRUCTION
+
+       TAD VALUE       /GET ADDRESS
+       AND [7600
+       SNA             /IS IT PAGE 0?
+       JMP FIX4        /YES
+       CIA             /NO-IS IT ON CURRENT PAGE?
+       TAD LOC
+       AND [7600
+       SNA CLA
+       JMP FIX2        /YES
+       TAD VALUE       /NO-SET UP LINK
+       JMS I (FINDS
+       DCA VALUE
+       TAD FIXMD0      /SET ' IN LISTING
+       DCA LININD
+       ISZ LINK        /BUMP NUMBER OF LINKS GENERATED
+FIXMD0,        0700            /PROTECTION FOR ISZ
+LGERR, SKP             /JMS I PERROR IF /E SPECIFIED
+       LG
+       JMS ADDIND      /SET INDIRECT BIT IN INSTRUCTION
+FIX2,  TAD [200        /SET CURRENT PAGE BIT
+       TAD VALUE2
+       DCA VALUE2
+       TAD IZIND
+       AND [77         /WAS Z SPECIFIED?
+       SNA CLA
+       JMP FIX4        /NO
+       JMS I [ERROR    /YES - ILLEGAL REFERENCE
+       IZ              /TO PAGE 0
+FIX4,  TAD IZIND       /WAS THERE AN I?
+       AND [7700
+       SZA CLA
+       JMS ADDIND      /YES - ADD INDIRECT BIT TO INSTRUCTION
+       TAD VALUE       /GET ADDRESS
+       AND [177
+       TAD VALUE2      /GET OP CODE
+       DCA VALUE       /STORE
+POPJ,  TAD I PDLXR
+       DCA TEMP        /POP A WORD OFF THE STACK
+       JMP I TEMP      /JUMP THROUGH IT.
+\fADDIND,       0               /ROUTINE TO ADD INDIRECT BIT TO AN INSTR
+       TAD VALUE2
+       CMA
+       AND [400
+       SZA             /WAS THERE ONE ALREADY?
+       JMP .+3 /NO
+       JMS I [ERROR    /YES - ILLEGAL INDIRECT
+       II
+       TAD VALUE2
+       DCA VALUE2
+       JMP I ADDIND
+
+/      ALLOWS MULTIPLE NON-RESIDENT INPUT HANDLERS TO NOT BOMB
+
+PTCH,  0               /RUNS IN DF 10
+       TAD (7647       /POINT TO DEVICE
+       DCA PTR         /HANDLER RESIDENCY TABLE
+       TAD [-17        /IT HAS 15 ENTRIES
+       DCA KNTR        /V3C
+KLOOP, TAD I PTR       /GET HANDLER ENTRY POINT
+       AND [7600       /LOOK AT PAGE IT'S ON
+       TAD [-INDEVH    /IS IT ON THE PAGE WE PUT BUFFER OVER?
+       SNA CLA         /WELL?
+       DCA I PTR       /YES IT IS, WIPE IT FROM RESIDENCY
+       ISZ PTR         /LOOK AT NEXT ENTRY
+       ISZ KNTR        /ANY MORE ENTRIES?
+       JMP KLOOP       /YES, MIGHT HAVE TO WIPE SEVERAL GUYS
+       TAD [200        /INCREASE INPUT BUFFER SIZE
+       JMP I PTCH      /V3C
+       PAGE
+\f/COMBINE CURRENT VALUE WITH PREVIOUS VALUE
+/ACCORDING TO LAST OPERATOR
+
+OP0,   TAD VALUE2      /HANDLER FOR +
+       TAD VALUE       /** OP0+1 AND OP0+2 JUMPED TO **
+       DCA VALUE
+EXP3,  TAD CHAR        /GET LAST OPERATOR
+       TAD [-"+        /WAS IT A + OR - ?
+       CLL RTR
+       SNA
+       JMP PLSMIN      /YES - LINK=0 FOR +, 1 FOR -
+       RTL
+       TAD ("+-"%
+       CLL RAR
+       SNA             /IS THE CHAR % OR &?
+       JMP DIVAND      /YES - LINK=0 FOR %, 1 FOR &
+       RAL
+       TAD ("%-240
+       CLL RAR
+       SNA             /IS THE CHAR SPACE OR !?
+       JMP BLKEXP      /YES - LINK=0 FOR SPACE, 1 FOR !
+       RAL
+       TAD (240-"^
+       SNA CLA         /IS THE CHAR ^?
+       JMP MUL         /YES - LINK IRRELEVANT
+       JMS I (ENDCHK   /NO-SEE IF END OF LINE FOUND
+       JMP EXP3        /NO-TRY AGAIN
+EXPXIT,        TAD UNDFSW      /EXIT FROM EXP
+       SNA CLA         /RESTORE EXIT POINT
+       JMP I (POPJ     /--EXIT VIA POPJ--
+       CLA CMA
+       DCA UNDFSW      /SET UNDEFINED SWITCH
+       DCA VALUE       /RESULT IS 0
+       JMP I (POPJ     /--EXIT VIA POPJ--
+\fMUL,  CLL IAC         /LINK DOESN'T COUNT FOR ^
+BLKEXP,        IAC             /** BLANK ASSUMED TO BE 4 ELSEWHERE **
+DIVAND,        IAC
+PLSMIN,        RAL
+       JMP I (EXP1     /GET REST OF EXPRESSION
+
+/HANDLER FOR &
+
+OP2,   TAD VALUE
+       AND VALUE2
+       JMP OP0+2
+
+
+/HANDLER FOR ^
+/MULTIPLY BY REPEATED ADDITION
+
+OP4,   TAD VALUE
+       CIA
+       DCA TEMP
+       TAD VALUE2
+       ISZ TEMP
+       JMP .-2
+       JMP OP0+2
+
+OP1,   TAD VALUE2      /- OPERATOR
+       CIA
+       JMP I (OP0+1    /JUMP INTO ADD OPERATOR
+
+/OPTIONAL HANDLER FOR ! AS 6 BIT LEFT SHIFT AND THEN OR:
+
+OP3,   TAD VALUE
+       JMS I [RTL6
+       AND [7700       /ISOLATE 6 BITS AND FALL INTO "OR"
+       DCA VALUE       /V3C
+
+/HANDLER FOR ! AND SPACE AS INCLUSIVE OR
+
+OP5,   TAD VALUE
+       CMA
+       AND VALUE2
+       JMP I (OP0+1
+\f/CHARACTER INPUT CHECK
+/ENTER WITH CHARACTER IN AC
+
+LSTCH9,        SZA             /IGNORE NULL (0)
+       TAD (-177
+       SZA             /IGNORE RUBOUT (377)
+       TAD (177-13
+       SZA             /IGNORE VERTICAL TAB (213)
+       IAC
+       SNA
+       JMP I (INPUT+1  /IGNORE LINE FEED (212)
+       TAD [12-32      /WAS IT ^Z (END-OF-FILE=232)?
+       SNA
+       JMP I (ENDCHR   /YES - GET NEXT FILE
+       TAD (32-15      /NO - WAS IT CARRIAGE RETURN?
+       SNA
+       JMP LSTCHR      /YES - LAST CHARACTER OF LINE
+       IAC             /NO
+       SNA             /WAS IT FORM FEED (214)?
+       JMP FORCHR      /YES - HANDLER FORM FEED
+       ISZ I (INPUT
+       TAD (14+200
+       DCA LSTCH5      /STORE CHARACTER
+       TAD PASS        /IS THIS PASS 3?
+       SPA SNA CLA
+       JMP LSTCH4      /NO -
+       ISZ LSTCH6      /YES - FILLING HEADER AREA?
+       JMP LSTCH3      /YES
+       CLA CMA         /NO - RESET SWITCH
+       DCA LSTCH6
+LSTCH4,        TAD I (INPUT
+       DCA TEMP
+       TAD LSTCH5      /GET CHARACTER IN AC
+       JMP I TEMP      /-EXIT FROM INPUT-
+
+LSTCH3,        ISZ LSTCH7      /FILLING HEADER
+       TAD LSTCH5      /STORE CHARACTER IN HEADER AREA
+       DCA I LSTCH7
+       JMP LSTCH4
+
+LSTCH5,        0
+LSTCH6,        -HEDLEN
+LSTCH7,        HEADER-1
+\fLSTCHR,       TAD FORMSW      /CARRIAGE RETURN WAS FOUND
+       SNA CLA         /HAS THERE BEEN A FORM FEED?
+       JMP LSTCH1      /NO -
+       DCA FORMSW      /YES - CLEAR FORM FEED SWITCH
+       ISZ EDITPG      /GO TO NEXT EDITOR PAGE
+       DCA THISPG      /CLEAR OVERFLOW PAGE
+       TAD PASS        /IS THIS PASS 3?
+       SMA SZA CLA
+       JMS I [FORMFD   /YES - GENERATE FORM FEED
+LSTCH1,        TAD [215        /NO - CARRIAGE RETURN IS CHARACTER
+       DCA LSTCH5
+       JMP LSTCH4-2    /EXIT
+
+FORCHR,        ISZ FORMSW      /SET FORM FEED SWITCH
+       JMP I (INPUT+1  /GET ANOTHER CHARACTER
+
+FORMSW,        1
+       PAGE
+\f/ERROR MESSAGE OUTPUT
+
+DUMPS1,
+ERROR, 0
+       CLA
+       ISZ ERCNT       /COUNT THE ERRORS
+ERPLUS,        "+              /PROTECTION
+       TAD I ERROR     /GET ERROR MESSAGE
+       ISZ ERROR       /INCREMENT RETURN ADDRESS
+       JMS I [ERROR1   /OUTPUT 2 CHARACTER ERROR MESSAGE
+       TAD (JMP I [7600 /PUT EXIT TO MONITOR
+CSWIT1,        DCA I (LSWITC   /IN SWITCH - "CLA" IF /C
+       TAD PASS        /IS THIS PASS 3?
+       SMA SZA CLA
+       JMP ERROR4      /YES - CARRIAGE RETURN/LINE FEED
+       JMS I [ERROR1   /NO - OUTPUT 2 SPACES
+       TAD [1777       /IS THERE A TAG SAVED?
+       AND LAST1
+       SNA
+       JMP ERROR3      /NO
+       JMS I (DIV45    /YES - OUTPUT FIRST 2 CHARACTERS
+       TAD LAST2       /OUTPUT SECOND 2 CHARACTERS
+       JMS I (DIV45
+       TAD LAST3
+       JMS I (DIV45    /OUTPUT THIRD 2 CHARACTERS
+       TAD LAST4       /IS ERROR LOCATION SAME AS LAST TAG?
+       CIA
+       TAD LOC
+       SNA CLA
+       JMP ERROR4      /YES - CARRIAGE RETURN
+       TAD ERPLUS
+       JMS I OERROR
+       TAD LAST4
+       CIA
+ERROR3,        TAD LOC         /OUTPUT 4 DIGIT ADDRESS OR INCREMENT
+       JMS I (OCTPRT
+ERROR4,        TAD [215        /OUTPUT CARRIAGE RETURN/LINE FEED
+       JMS I OERROR
+       JMP I ERROR     /--RETURN--
+\f/RESET LITERAL TABLES AND POINTERS
+
+DUMPS5,
+CLEAN, 0
+       TAD (LITBUF-1
+       DCA XREG1       /SET LITERAL TABLE POINTER
+       TAD (TPINST-1
+       DCA XREG2       /SET TOP INST. TABLE POINTER
+       TAD (-40
+       DCA TEMP
+       TAD [200
+       DCA I XREG1     /SET LITERAL TABLE ENTRIES TO 200
+       DCA I XREG2     /SET TOP INST. TABLE ENTRIES TO 0
+       ISZ TEMP
+       JMP .-4
+       DCA LAST1       /CLEAR LAST DEFINED TAG
+       JMP I CLEAN     /--RETURN--
+
+/DUMP CURRENT PAGE LITERALS
+
+DUMPS, 0
+       JMS I [FINDSP
+       SNA             /IF THIS IS PAGE 0,
+       JMP I DUMPS     /--RETURN--
+       TAD [LITBUF
+       DCA DUMPS1
+       TAD LITPTR
+       CIA CLL
+       TAD I DUMPS1
+       DCA DUMPS2      /STORE NUMBER OF LITERALS ON THIS PAGE
+       SZL             /ARE THERE ANY?
+       JMP D2          /V3C
+       DCA STARSW      /FORCE ORIGIN PUNCH IF RELOC JUST INVOKED
+       TAD LOC
+       AND [7600
+       TAD I DUMPS1
+       JMS I [PUNORG   /OUTPUT ORIGIN
+       TAD I DUMPS1
+       TAD [LITBF1
+DUMPS3,        DCA DUMPS5
+       TAD I [LINBUF   /SAVE LINBUF
+       JMS I [PUSHA
+       DCA I [LINBUF
+DUMPS6,        TAD I DUMPS5
+       DCA VALUE
+JMSPUN,        JMS I [PUNONE   /OUTPUT ONE REGISTER
+       ISZ LOC
+       ISZ DUMPS5
+LITHAK,        ISZ I DUMPS1    /DESTROY RECORD OF CURRENT PAGE LITERALS -
+                       /ZEROED IF NO /W OPTION SPECIFIED
+       ISZ DUMPS2
+       JMP DUMPS6
+       TAD I PDLXR
+       DCA I [LINBUF   /RESTORE LINBUF
+D2,    TAD DUMPS1      /WIPE REMEMBRANCE OF TOP OF PAGE (JR)
+       TAD (40         /V3C
+       DCA DUMPS5
+D3,    DCA I DUMPS5
+       JMP I DUMPS     /--RETURN--
+\f/HANDLER FOR ZBLOCK PSEUDO-OP
+/RESERVES AS MANY WORDS OF ZERO
+/AS VALUE OF EXPRESSION
+
+ZBLOCX,        JMS I [SPNOR    /IGNORE SPACES
+       JMS I [EXP      /GET THE EXPRESSION
+       TAD VALUE
+       CMA             /PROTECT AGAINST ZERO CASE
+       DCA TEMP3       /STORE NEGATIVE AS COUNTER
+       JMP ZBLOCZ      /JUMP INTO LOOP
+ZBLOCY,        JMS I [PUNBIN   /OUTPUT ONE WORD OF ZERO
+       TAD PASS        /IS THIS PASS 3?
+       SMA SZA CLA
+       DCA I (PUNMOD   /YES - PREVENT OUTPUT
+ZBLOCZ,        ISZ TEMP3       /NO - DONE YET?
+       JMP ZBLOCY      /NO - CONTINUE
+       TAD JMSPUN      /YES - RESTORE PUNMOD
+       DCA I (PUNMOD
+       JMP I [LOOKEX   /--EXIT TO MAIN--
+
+/DUMP PAGE 0 LITERALS
+
+DUMPS2,
+DUMPZ, 0
+       TAD DUMPZ       /RESET EXIT FROM DUMPS
+       DCA DUMPS
+       TAD [200
+       CIA CLL
+       TAD I [LITBUF   /STORE THE NUMBER OF LITERALS ON PAGE 0
+       DCA DUMPS2
+       SZL             /ARE THERE ANY?
+       JMP I DUMPS     /NO - ** DUMPZ IS DESTROYED **
+       TAD I [LITBUF
+       JMS I [PUNORG   /OUTPUT ORIGIN
+       TAD I [LITBUF   /SET VALUES FOR DUMPS
+       TAD (LITBF2
+       JMP DUMPS3
+       PAGE
+\f/ENTER A TAG INTO SYMBOL TABLE
+
+       IFZERO  HASH<
+INSRTG,        0
+       TAD VALUE2      /SAVE VALUE 2
+       JMS I [PUSHA
+       ISZ HIGHTG      /COUNT IN THIS TAG
+       TAD TAGMAX
+       CLL CIA         /GET LIMIT OF SYMBOL STORAGE
+       TAD HIGHTG      /IS THERE ROOM FOR ONE MORE?
+       SZL
+       JMP I (SYMOFL   /NO - SE**FATAL ERROR**
+       TAD TAGMAX      /YES - IS USR IN CORE?
+       TAD (-1340
+       SZL CLA
+       JMP GETTG5      /YES
+       TAD [7700       /NO - RESET ADDRESS TO
+       DCA IOMON       /USR NON-RESIDENT
+       AC7776
+       AND I (JSBITS   /RESET JOB STATUS WORD TO
+       DCA I (JSBITS   /SAVE CORE WHEN USR CALLED
+GETTG5,        TAD THISTG      /SEARCH SYMBOL TABLE
+       DCA TEMP2
+       TAD HIGHTG
+       IAC
+       DCA THISTG
+GETTG8,        AC7776
+       TAD THISTG
+       DCA THISTG
+       JMS I [FINDTG   /GET NEXT TAG FROM SYMBOL TABLE
+       ISZ THISTG
+       TAD THISTG
+       CIA
+       TAD TEMP2       /DOES NEW TAG GO WHERE PREVIOUS TAG WAS?
+       SNA CLA
+       JMP GETTG9      /YES-PUT IT THERE AND EXIT
+       JMS I [PUTTAG   /NO-REPLACE RETRIEVED TAG WHERE PREVIOUS TAG WAS
+       JMP GETTG8
+
+/THE ABOVE CODE WILL BE OPTIMIZED AT INITIALIZATION
+/IF THE ASSEMBLER IS TO BE RESTRICTED TO 8K OF CORE
+
+GETTG9,        TAD I (NAME1    /GET CURRENT TAG
+       DCA TAG1        /PUT IT IN TAG1-TAG3
+       TAD I (NAME2
+       DCA TAG2
+       TAD I (NAME3
+       DCA TAG3
+       TAD I PDLXR     /RESTORE VALUE 2
+       DCA VALUE2
+       JMS I [PUTTAG   /PUT TAG1 - TAG3 INTO SYMBOL TABLE
+       JMP I INSRTG    /--RETURN--
+
+TAGMAX,        1740            /12K=3740, ...
+       >
+
+/      IFNZRO  HASH<   /***HACK ONLY***
+/TLYREF,       0               /TALLY REFS TO SYMBOL TABLE
+/      ISZ     NREFL
+/      JMP I   TLYREF
+/      ISZ     NREFH
+/      JMP I   TLYREF
+/      JMP I   TLYREF
+/TLYPRB,       0               /TALLY PROBES INTO TABLE
+/      JMS I   [FINDTG /FUDGE, OUT OF ROOM
+/      ISZ     NPROBL
+/      JMP I   TLYPRB
+/      ISZ     NPROBH
+/      JMP I   TLYPRB
+/      JMP I   TLYPRB
+/NREFH,        0
+/NREFL,        0
+/NPROBH,       0
+/NPROBL,       0
+/      >               /***HACK ONLY***
+\f      IFNZRO  HASH<
+
+       /INSERT A TAG INTO THE HASH TABLE
+
+INSRTG,        0
+       ISZ     HIGHTG  /BUMP SYM NUM (SKIPS ON 0)
+       TAD     HIGHTG
+       STL CMA
+       TAD     TAGMAX
+       SNA SZL CLA     /STILL ROOM FOR AT LEAST 2 MORE?
+       JMP I   (SYMOFL /NO SE** FATAL ERROR**
+       TAD I   (NAME1
+       DCA     TAG1
+       TAD I   (NAME2
+       DCA     TAG2
+       TAD I   (NAME3
+       DCA     TAG3
+       JMS I   [PUTTAG /NOW ACTUALLY INSERT IT
+       JMP I   INSRTG
+       >
+\f/OUTPUT 2 CHARACTER WORD
+/FROM SYMBOL TABLE FORMAT
+/DIVIDE BY 45(8)
+
+DIV45, 0
+       RAL
+       CLL RAR         /CLEAR SIGN BIT
+DIV45A,        ISZ DIV45C
+       TAD (-45
+       SMA
+       JMP DIV45A
+       TAD (45
+       JMS DIV45E
+       DCA DIV45B
+       STA
+       TAD DIV45C
+       JMS DIV45E
+       JMS I [RTL6
+       TAD DIV45B
+       JMS I [ERROR1   /OUTPUT 2 CHARACTERS
+       DCA DIV45C      /CLEAR DIV45C FOR NEXT GO-ROUND
+       JMP I DIV45     /--RETURN--
+
+DIV45B,        0
+DIV45C,        0               /** MUST BE 0 WHEN DIV45 IS ENTERED **
+
+DIV45E,        0
+       SNA
+       JMP I DIV45E
+       TAD (-33
+       SMA
+       TAD (20-40-33
+       TAD (33+40
+       JMP I DIV45E    /--RETURN--
+\f/HANDLER FOR FIXTAB PSEUDO-OP
+
+FIXTBX,        TAD PASS        /IS THIS PASS 1?
+       SMA CLA
+       JMP I [LOOKEX   /NO--EXIT TO MAIN--
+       JMP I (FIXTAY   /YES--DO FIXTAB
+
+/SET FIELD
+
+SETFLD,        0
+       CLA CLL         /SETFLD CALLED WITH AC RANDOM
+       DCA SETFL1      /INITIALIZE FIELD
+       IFNZRO  HASH<
+       TAD     USROFS  /FUDGE FOR KEEPING USR AROUND
+       >
+       TAD THISTG
+SETFLP,        ISZ SETFL1
+       CML
+       TAD (-1740      /PUT 1740 SYMBOLS IN EACH FIELD
+       SNL             /IS THE DIVIDE THROUGH?
+       JMP SETFLP      /NO - CONTINUE
+       IFZERO  HASH<
+       CLL CMA RTL     /AC CONTAINED REM-1740; THIS MAKES IT INTO
+       TAD (-1         /7573-4*REM WHICH IS THE ADDRESS WE WANT
+       >
+       IFNZRO  HASH<
+       CLL RTL         /AC GETS 0201 TO 7775
+       TAD     (-202   /AC GETS 7777 TO 7573 FOR TAGXR
+       >
+       DCA TAGXR       /TO STICK INTO AN AUTO-XR
+       TAD SETFL1
+       CLL RTL
+       RAL
+       TAD SETFL2
+       DCA SETFL1
+SETFL1,        HLT
+       JMP I SETFLD    /--RETURN--
+       IFNZRO  HASH<
+USROFS,        0               /GETS 400 IF KEEPING USR
+       >
+\f/FIND TAG
+/GET TAG FROM SYMBOL TABLE
+/PUT IT INTO TAG1-TAG3
+/WITH ITS VALUE IN VALUE2
+
+FINDTG,        0
+       TAD THISTG
+       JMS SETFLD
+       TAD I TAGXR
+       DCA TAG1
+       TAD I TAGXR
+       DCA TAG2
+       TAD I TAGXR
+       DCA TAG3
+       TAD I TAGXR
+       DCA VALUE2
+SETFL2,        CDF
+       JMP I FINDTG    /--RETURN--
+
+/OPTIMIZATION MAY CHANGE SETFLD TO
+/REMOVE CLA ON ENTRY
+       PAGE
+\f/BEGINNING OF PASS CODE
+
+       JMS I (IOPEN    /SET INPUT ROUTINE TO OPEN FILE
+START2,        ISZ PASS        /SET UP COUNTERS AND POINTERS
+       DCA XLISTX      /CLEAR XLIST SWITCH
+       DCA FLDIND      /SET FIELD TO 0
+       DCA CONDSW
+       DCA EDITPG
+       DCA LINK
+       DCA RADIX
+       DCA ERCNT
+       DCA GETCI
+       DCA PUNCHX
+       DCA I [LINBUF
+       TAD (PDLST
+       DCA PDLXR
+       JMS I [CLEAN
+       TAD [200
+       DCA LITPTR
+       TAD [200
+       JMS I [PUNORG
+       JMP I (LOOKE1   /--EXIT TO MAIN--
+
+/HANDLER FOR $
+
+ENDPAS,        JMS I [DUMPS    /DUMP CURRENT PAGE LITERALS
+       DCA OFSBUF      /CLEAR OFFSET FOR NEXT PASS
+       TAD PASS        /WHAT PASS IS ENDING?
+       SNA
+       JMP I (ENDPA2   /PASS 2
+       SPA CLA
+       JMP I (START1   /PASS 1
+       TAD I [LINBUF   /PASS 3
+       SNA CLA         /ANYTHING TO PRINT?
+       JMP ENDPA1-1    /NO
+       TAD [211        /YES - TAB OVER TWICE
+       JMS I OERROR
+       TAD [211
+       JMS I OERROR
+       JMS I [LINPRT   /PRINT LINE
+       JMS I [DUMPZ    /DUMP PAGE 0 LITERALS
+ENDPA1,        DCA XLISTX
+/OUTPUT SYMBOL TABLE
+SSWITC,        JMS I (SYMPRT   /(0 IF /S)
+       TAD I (FORM21
+       DCA I (FORM22
+       JMS I [FORMFD   /OUTPUT FORM FEED
+ERMSGS,        TAD ERCNT
+       JMS OUTTTL      /PRINT "ERRORS DETECTED: N"
+       TAD LINK
+       JMS OUTTTL      /PRINT "LINKS GENERATED: N"
+FINLFF,        JMS I [FORMFD   /PRINT FINAL FF (ZEROED IF NO PASS 3)
+       JMS I (OCLOSE   /AND CLOSE THE OUTPUT FILE
+\f/CREF AND LOAD-AND-GO OPTIONS
+/****FINAL EXIT TO MONITOR****
+LSWITC,        JMP I [7605     /0 IF /L OR /G OR /C
+       TAD (7616
+       DCA XREG1
+       CDF 10
+CSWITC,        TAD I [7600     /"TAD I [7605" IF /C
+       AND [17
+       DCA I XREG1     /SET BINARY DEVICE
+       TAD BINSRT
+
+/EXIT FROM PAL8 BY CHAINING
+/TO NEXT PROGRAM
+/SHOULD BE ABSLDR OR CREF
+
+       DCA I XREG1     /SET STARTING BLOCK
+       DCA I XREG1     /SET 0 TERMINATOR
+       CDF
+       TAD I (JSBITS   /SET BIT 11 OF JOB STATUS WORD
+       RAR             /SO 10000-11777 IS NOT SAVED
+       CLL CML RAL
+       DCA I (JSBITS
+       CIF 10
+       JMS I IOMON     /CALL USER SERVICE ROUTINES
+       6               /*CHAIN TO NEXT PROGRAM*
+CHAIN, 0               /STARTING BLOCK OF NEXT PROGRAM
+
+OUTTTL,        0
+       DCA LAST1       /SAVE NUMBER TO BE PRINTED
+OUTTLL,        TAD I TTLPTR    /GET A WORD OF MESSAGE
+       ISZ TTLPTR
+       SNA             /END?
+       JMP PRTTTL      /YES
+       JMS I [ERROR1   /NO - PRINT IT
+       JMP OUTTLL      /AND LOOP
+PRTTTL,        TAD [240        /PRINT A SPACE
+       JMS I OCHAR
+       TAD LAST1
+       JMS I (FORMF4   /PRINT NUMBER IN DECIMAL
+       JMS I (CRLF     /PRINT CR AND 2 LF'S (1 IF PASS 3)
+       JMP I OUTTTL    /AND RETURN
+
+TTLPTR,        TTLMSG
+\f/COME HERE TO LOAD THE PASS 3 OVERLAY AT THE END OF PASS 2
+
+LOADOV,        JMS I (7607     /CALL SYSTEM DEVICE HANDLER
+       0200            /SWAP IN CODE UNIQUE TO PASS 3
+       SWAP1           /BUFFER ADDRESS
+       ASWAP           /STARTING BLOCK NUMBER
+       JMP I (SYSER3   /DE**FATAL ERROR**
+NSWITC,        JMP START2      /(0 IF NO LIST FILE, SKP IF /N) START PASS3
+       JMP ERMSG1
+       JMP ENDPA1
+
+ERMSG1,        TAD (OTYPEO     /COME HERE IF NO PASS 3 OUTPUT FILE
+       DCA OCHAR
+       TAD (OTYPEO
+       DCA OERROR
+       TAD [7600
+       DCA I (OTYPCR   /INHIBIT AUTO-LF ON CARRIAGE RETURN
+       DCA FINLFF      /KILL LAST FORM FEED
+       JMP ERMSGS
+
+/ADD BITS TO PUNCH ORIGIN
+
+PUNORG,        0
+       DCA LOC
+       TAD PASS        /IS THIS PASS 2?
+       SZA CLA
+       JMP I PUNORG    /NO--RETURN--
+       TAD LOC         /YES - OUTPUT ORIGIN SETTING
+       TAD OFFSET      /"LOC" MAY BE FICTITIOUS - MAKE IT REAL
+       CLL CML
+       ISZ STARSW      /INHIBIT PUNCHING ORIGIN IF NECESSARY
+       JMS I [PUNOUT
+       CLA
+       DCA STARSW      /RESET SWITCH
+       JMP I PUNORG    /--RETURN--
+       PAGE
+\f\f/EVALUATE LITERAL
+
+LIT,   STA RAL         /-2 IF PAGE 0 LITERAL, -1 IF CUR PAGE
+       DCA FINDS1      /SAVE FLAG
+       JMS I [GETC     /GET NEXT CHARACTER
+       JMS I [SPNOR    /IGNORE SPACES
+       TAD EXPIND      /STORE IMPORTANT VALUES PRIOR TO
+       JMS I [PUSHA    /ENTRANCE INTO EXP
+       TAD OP
+       JMS I [PUSHA
+       TAD VALUE
+       JMS I [PUSHA
+       TAD FINDS1
+       JMS I [PUSHA
+       JMS I [EXP      /GET EXPRESSION
+       TAD VALUE       /FIND LITERAL IN TABLE
+       ISZ I PDLXR     /PAGE 0?
+       JMP .+3
+       JMS FINDS       /NO
+       SKP
+       JMS FIND0       /YES
+       DCA VALUE2      /STORE ADDRESS
+       TAD I PDLXR
+       DCA VALUE
+       TAD I PDLXR     /RESTORE SAVED VALUES
+       DCA OP
+       TAD I PDLXR
+       DCA EXPIND
+       TAD CHAR        /IGNORE ) OR ]
+       TAD (-")
+       SZA
+       TAD (")-"]
+       SNA CLA
+       JMS I [GETC     /GET NEXT CHARACTER
+       JMP I (NUMBE5   /RETURN TO EXPRESSION PROCESSOR
+
+
+PEZE,  0               /SUBR TO ISSUE PE OR ZE MESSAGE
+       SNA CLA         /WHICH ONE?
+       JMP .+4 /PAGE 0
+       JMS I PERROR
+       PE
+       JMP I PEZE
+       JMS I PERROR
+       ZE
+       JMP I PEZE
+\f/FIND LITERAL ON CURRENT PAGE
+
+FINDS, 0
+       DCA FINDS1
+       TAD LOC
+       AND [7600
+       SNA             /IS THIS PAGE 0?
+       JMP FIND01      /YES
+       DCA FINDS2      /NO - SAVE PAGE NUMBER
+       TAD [LITBF1
+       DCA FIND0
+       TAD [7700       /ALLOW 100(8) CURRENT PAGE LITERALS
+       DCA FORMF6
+       TAD LITPTR      /GET PG ADDR OF 1ST LITERAL IN BUFFER
+FIND02,        DCA FINDS3
+       TAD FINDS2
+       JMS I [RTL6
+       TAD [LITBUF
+       DCA TEMP
+       TAD FIND0       /COMPUTE ACTUAL CORE ADDRESS OF LITERAL
+       TAD I TEMP
+       DCA TEMP2
+       TAD FINDS3      /COMPUTE THE NUMBER OF ENTRIES
+       CIA
+       TAD I TEMP      /IN THE LITERAL BUFFER
+       SNA
+       JMP FINDS6      /NONE
+       DCA FINDS3
+FINDS4,        TAD I TEMP2     /GET LITERAL FROM TABLE
+       CIA
+       TAD FINDS1      /AND CURRENT LITERAL
+       SNA CLA         /DO THEY MATCH?
+       JMP FINDS5      /YES
+       ISZ TEMP2       /NO - BUMP COUNTERS
+       ISZ FINDS3
+       JMP FINDS4      /TRY AGAIN
+FINDS6,        TAD FINDS2
+       JMS I [RTL6
+       TAD [TPINST
+       DCA FINDS3
+       TAD I TEMP      /DOES THIS OVERFLOW PAGE?
+       CIA
+       TAD I FINDS3
+       SPA CLA
+       JMP FINDS7      /NO
+
+\fFIND03,       TAD FINDS2      /PAGE FULL - WHICH PAGE?
+       JMS PEZE        /GENERATE PE OR ZE MESSAGE
+       CLA CMA
+       JMP FINDS9
+FINDS7,        CLA CMA
+       TAD I TEMP      /IS PAGE FULL?
+       AND FORMF6
+       SNA CLA
+       JMP FIND03      /YES - OUTPUT ERROR MESSAGE
+       CLA CMA
+       TAD I TEMP      /NO
+       DCA I TEMP
+FINDS9,        TAD I TEMP
+       TAD FIND0
+       DCA TEMP2
+       TAD FINDS1
+       DCA I TEMP2
+FINDS5,        TAD FIND0       /GET ADDRESS OF LITERAL
+       CIA
+       TAD TEMP2
+       TAD FINDS2
+       JMP I FINDS     /--RETURN--
+
+
+/FIND LITERAL ON PAGE 0
+
+FIND0, 0
+       DCA FINDS1
+       TAD FIND0       /RESET EXIT FROM FINDS
+       DCA FINDS
+FIND01,        DCA FINDS2      /SET POINTERS
+       TAD (LITBF2
+       DCA FIND0
+       TAD [7760       /ALLOW 160(8) PAGE 0 LITERALS
+       DCA FORMF6
+       TAD [200
+       JMP FIND02
+
+FINDS1,        0
+FINDS2,        0
+FINDS3,        0
+       PAGE
+\f/HANDLER FOR IFZERO PSEUDO-OP
+
+IF0,   TAD (10         /IFTST1, SNA CLA
+
+/HANDLER FOR IFNZERO PSEUDO-OP
+
+IFN0,  TAD IFSZA       /IFTST1, SZA CLA
+       DCA IFTST1
+       JMS I [SPNOR    /IGNORE SPACES
+       JMS I [EXP      /GET EXPRESSION
+IFTST3,        TAD CHAR        /GET LAST CHARACTER
+       TAD (-"<
+       SNA CLA         /IS IT <?
+       JMP IFTST2      /YES
+       JMS ICMESG      /PRINT IC MESSAGE AND GET NEXT CHAR
+IFTST9,        JMS I [SPNOR    /IGNORE SPACES
+       JMP IFTST3      /TRY AGAIN
+
+IFTST2,        JMS I [GETC     /GET NEXT CHARACTER
+       TAD CONDSW
+       CIA
+       DCA CONDTM      /SET NUMBER OF NESTED CONDITIONALS
+       CLA CMA         /DECREMENT NUMBER OF NESTED CONDITIONALS
+       TAD CONDSW
+       DCA CONDSW
+       TAD VALUE
+IFTST1,        HLT             /SZA CLA OR SNA CLA
+       JMP I (MAIN     /--EXIT TO MAIN--
+IFTST5,        TAD CONDSW      /DONE WITH ALL CONDITIONALS IN NEST?
+       TAD CONDTM
+       SMA CLA
+       JMP I (MAIN     /YES --EXIT TO MAIN--
+       TAD CHAR
+       TAD (-"<        /NO - GET NEXT CHARACTER
+       SNA             /IS IT <?
+       JMP IFTST6      /YES - HANDLE NEXT CONDITIONAL
+       TAD ("<-">      /NO - IS IT >?
+IFSZA, SZA CLA
+       JMP IFTST4      /NO - FINISH THIS CONDITIONAL
+       AC7776
+IFTST6,        CMA
+       TAD CONDSW
+       DCA CONDSW
+IFTST4,        DCA I [LINBUF   /INHIBIT LISTING OF UNASSEMBLED CODE -
+                       /ZEROED IF /J OPTION NOT SPECIFIED
+       JMS I [GETC     /GET NEXT CHARACTER
+       JMP IFTST5
+\f/HANDLER FOR IFDEF PSEUDO-OP
+
+IFD,   TAD (10         /IFTST1, SNA CLA
+
+/HANDLER FOR IFNDEF PSEUDO-OP
+
+IFND,  TAD IFSZA       /IFTST1, SZA CLA
+       DCA IFTST1
+IFTST7,        JMS I [SPNOR    /IGNORE SPACES
+       JMS I [TSTALP   /IS NEXT CHARACTER ALPHABETIC
+       JMP IFTST8      /YES
+       JMS ICMESG      /PRINT IC MESSAGE AND GET NEXT CHAR
+       JMP IFTST7      /KEEP TRYING
+
+IFTST8,        JMS I [GETTAG   /PICK UP TAG
+       DCA VALUE       /STORE UNDEFINED INDICATOR
+       TAD TAG3        /WAS IT A PSEUDO-OP?
+       SMA CLA
+       JMP IFTST9      /NO
+       JMS I [ERROR    /YES - GENERATE IP ERROR MESSAGE
+       IP
+       JMP IFTST9
+
+ICMESG,        0
+       JMS I   [ERROR
+       IC              /IC COMES OUT ON ALL PASSES
+       TAD CHAR
+       SPA CLA
+       JMP I [LOOKEX   /END OF LINE - GO AWAY
+       JMS I [GETC     /GET NEXT CHAR
+       JMP I ICMESG
+\fCONDTM,
+
+/PUT TAG IN SYMBOL TABLE
+
+PUTTAG,        0
+       TAD THISTG
+       JMS I (SETFLD   /SET FIELD
+       TAD TAG1
+       DCA I TAGXR
+       TAD TAG2
+       DCA I TAGXR
+       TAD TAG3
+       DCA I TAGXR
+       TAD VALUE2
+       DCA I TAGXR
+       CDF
+       JMP I PUTTAG    /--RETURN--
+
+
+/PUSHDOWN ROUTINE
+/PUT NEW ENTRY ON PUSHDOWN STACK
+
+PUSHA, 0
+       DCA TEMP
+       CLA CMA
+       TAD PDLXR
+       DCA PDLXR
+       TAD PDLXR
+       TAD (-PDLND
+       SPA CLA         /IS LIST TOO FULL?
+       JMP PUSHA1      /BE**FATAL ERROR**
+       TAD TEMP        /NO - MAKE ENTRY
+       DCA I PDLXR
+       CLA CMA
+       TAD PDLXR
+       DCA PDLXR
+       JMP I PUSHA     /--RETURN--
+
+PUSHA1,        TAD (BE
+       JMP I [MONERR   /PUSHDOWN OVERFLOW IS FATAL ERROR
+\f/TEST NUMERIC ROUTINE
+/CALL WITH CHARACTER TO TEST IN "CHAR"
+/SKIPS IF THE CHARACTER IS NOT NUMERIC
+
+TSTNUM,        0
+       TAD CHAR        /GET THE CHARACTER
+       TAD (-"9-1
+       CLL
+       TAD ("9-"0+1
+       SNL CLA         /CHECK FOR RANGE 0-9
+       ISZ TSTNUM      /OUT OF RANGE
+       JMP I TSTNUM    /--RETURN--
+
+/TEST ALPHANUMERIC ROUTINE
+/CALL WITH CHARACTER IN "CHAR"
+/SKIPS IF CHARACTER IS NOT ALPHANUMERIC
+
+TSTALN,        0
+       JMS I [TSTNUM   /IS IT NUMERIC
+       JMP I TSTALN    /YES--RETURN--
+       JMS I [TSTALP   /IS IT ALPHABETIC
+       JMP I TSTALN    /YES--RETURN--
+       ISZ TSTALN      /NEITHER
+       JMP I TSTALN    /--RETURN--
+
+/TEST ALPHABETIC ROUTINE
+/CALL WITH CHARACTER IN "CHAR"
+/SKIPS IF NOT ALPHABETIC
+
+TSTALP,        0
+       TAD CHAR
+       TAD (-"Z-1
+       CLL
+       TAD ("Z-"A+1
+       SNL CLA         /CHECK FOR RANGE A-Z
+       ISZ TSTALP      /OUT OF RANGE
+       JMP I TSTALP    /--RETURN--
+       PAGE
+\f/INPUT ROUTINE
+/UNPACKS CHARACTERS FROM BUFFER
+
+INPUT, 0
+       ISZ INCHCT      /ARE THERE CHARACTERS LEFT IN BUFFER? 
+       JMP I CHARLV    /YES - FETCH ONE
+       TAD INEOF       /NO - WAS OLD FILE ENDED?
+       SZA CLA
+       JMP ENDCHR      /YES - START NEW FILE
+INGBUF,        TAD INCTLA      /NO
+       AND [7600
+       JMS I [RTL6
+       TAD INCTR
+       SNL
+       DCA INCTR
+       SZL
+       ISZ INEOF
+       CLL CML CMA RTR /SET CONTROL WORD
+       RTR
+       RTR
+       TAD INCTLA
+       DCA INCTLW
+       JMS I INHNDL    /CALL INPUT DEVICE HANDLER
+INCTLW,        0               /CONTROL WORD
+INBUFP,        INBUF           /INPUT BUFFER ADDRESS
+INREC, 0               /STARTING BLOCK NUMBER
+       JMP INERRX      /ERROR RETURN
+INBREC,        TAD INCTLA      /NORMAL RETURN
+       AND [7600
+       JMS I [RTL6
+       TAD INREC
+       DCA INREC       /RESET STARTING BLOCK NUMBER
+       TAD INCTLW
+       AND [7600
+       CLL RAL
+       TAD INCTLW
+       AND [7600
+       CIA
+       DCA INCHCT      /SET CHARACTER COUNT
+       TAD INBUFP
+       DCA INPTR       /SET BUFFER POINTER
+\f/CHARACTERS ARE FOUND IN BUFFER
+/IN STANDARD OS/8 PACKING
+/WORD 1: AAA A11 111 111
+/WORD 2: BBB B22 222 222
+/WHICH REPRESENTS 3 CHARACTERS
+/CHARACTER 1: 11 111 111
+/CHARACTER 2: 22 222 222
+/CHARACTER 3: AA AAB BBB
+
+
+ICHAR1,        TAD I INPTR     /PICK UP CHARACTER WORD 1
+       JMS CHARLV      /CHECK RIGHT 8 BITS
+ICHAR2,        TAD I INPTR     /PICK UP WORD 1
+       ISZ INPTR       /(INCREMENT POINTER TO WORD 2)
+       AND [7400       /WITH WORD 1 IN AC
+       DCA INCTLW      /RETRIEVE LEFT 4 BITS AND SAVE
+       TAD I INPTR     /PICK UP WORD 2
+       JMS CHARLV      /CHECK RIGHT 8 BITS
+ICHAR3,        TAD I INPTR     /PICK UP WORD 2
+       ISZ INPTR       /(POINT TO NEXT WORD 1)
+       AND [7400       /WITH WORD 2 IN AC
+       CLL RTR         /RETRIEVE LEFT 4 BITS
+       RTR
+       TAD INCTLW      /PUT BOTH SETS OF 4 BITS TOGETHER
+       RTR
+       RTR
+       JMS CHARLV      /CHECK CHARACTER
+       JMP ICHAR1      /TRY NEXT SET OF 2 WORDS
+
+INERRX,        ISZ INEOF
+       SMA CLA         /EOF OR FATAL ERROR?
+       JMP INBREC      /EOF - UNPACK THIS BUFFER
+       JMP I (SYSERR   /FATAL - GENERATE DE ERROR MESSAGE
+
+INCHCT,        -1
+INEOF, 1
+INPTR, 0
+INCTR, 0
+INCTLA,        0
+INFPTR,        7617
+\f/START NEW FILE
+
+ENDCHR,        ISZ I (FORMSW   /^Z OR EOF SIMULATES FORM FEED
+       TAD PASS        /IS THIS PASS 3?
+       SPA SNA CLA
+       JMP NXTFLE      /NO
+       JMS I (HEDCLR   /YES - CLEAR HEADING BUFFER
+       TAD [-HEDLEN
+       DCA I (LSTCH6
+       TAD [HEADER-1
+       DCA I (LSTCH7
+       DCA LSTCNT
+NXTFLE,        TAD (INDEVH+1   /SET ADDRESS OF DEVICE HANDLER
+       DCA INHNDL
+       CDF 10
+       TAD I INFPTR
+       CDF
+       SNA
+       JMP FAKDLR      /END OF FILE - FAKE A $
+       CIF 10
+       JMS I IOMON     /CALL USER SERVICE ROUTINES
+       1               /*FETCH HANDLER*
+INHNDL,        0               /LOADING ADDRESS OF HANDLER
+       HLT             /ERROR RETURN
+       CDF 10          /V3C
+       TAD INHNDL      /NORMAL RETURN - HANDLER IN CORE
+       AND [7600
+       TAD [-INDEVH    /SEE IF INPUT HANDLER IS IN 7200
+       SZA CLA
+       JMS I (PTCH     /IT IS - INCREASE SIZE OF BUFFER
+                       /AND REMOVE FROM RESIDENCY ANY HANDLERS THERE
+       TAD INCTL
+       DCA INCTLA      /DF=10
+       TAD I INFPTR
+       AND [7760
+       SZA
+       TAD [17
+       CLL CML RTR
+       RTR
+       DCA INCTR
+       ISZ INFPTR
+       TAD I INFPTR
+       DCA INREC       /RESET STARTING BLOCK NUMBER
+       ISZ INFPTR
+       DCA INEOF
+       CDF
+       JMP INGBUF
+\fFAKDLR,       TAD (244
+       JMS CHARLV      /CALL THE COROUTINE
+       TAD [215        /WITH $ AND CR
+       JMS CHARLV      /TO END THE ASSEMBLY.
+       JMP I (PHASE    /** DIDN'T WORK - MUST BE IN CONDITIONAL - FATAL
+
+CHARLV,        0               /CHARACTER IN AC
+       AND [177        /AND OFF LEFT 5 BITS
+       JMP I (LSTCH9   /RETURN TO LSTCH9
+       PAGE
+\f/HANDLER FOR DTORG PSEUDO-OP (TYPESETTING)
+/PUNCHES 4 DIGIT BLOCK NUMBER IN 2 FRAMES
+/FIRST FRAME HAS CHANNELS 7 AND 8 PUNCHED
+/ADDED TO CHECKSUM
+
+DTORGX,        JMS I [SPNOR    /IGNORE SPACES
+       JMS I [EXP      /GET EXPRESSION
+       TAD PASS        /IS THIS PASS 2?
+       SNA
+       JMP DTORG2      /YES
+PUNVA1,        SPA SNA CLA     /NO - IS THIS PASS 3?
+       JMP I [LOOKEX   /NO--EXIT TO MAIN--
+       TAD LININD      /GET LINK SWITCH FROM "EXP"
+       DCA LINKSW      /YES
+       TAD [LOOKEX     /FIX PUNONE TO EXIT TO MAIN
+       DCA I (PUNONE
+       TAD [211        /OUTPUT TAB
+       JMS I OERROR
+       JMP I (DTORG1
+
+DTORG2,        TAD VALUE       /PASS 2 - GET BLOCK NUMBER
+       JMS I [RTL6
+       RAL
+       AND [77
+       TAD (300        /PICK UP CHANNELS 7 AND 8
+       DCA TEMP
+       TAD TEMP
+       TAD CHKSUM      /ADD VALUE TO CHECKSUM
+       DCA CHKSUM
+       TAD TEMP
+       JMS I OCHAR     /OUTPUT BLOCK NUMBER - FIRST FRAME
+       TAD VALUE
+       AND [77
+       JMS I OCHAR     /OUTPUT SECOND FRAME
+       JMP I [LOOKEX   /--EXIT TO MAIN--
+
+/HANDLER FOR %
+/DIVIDE BY REPEATED SUBTRACTION
+
+OP6,   DCA TEMP
+       TAD VALUE2
+       CIA
+       DCA VALUE2
+       TAD VALUE
+OP6A,  CLL
+       TAD VALUE2      /SUBTRACT DIVISOR FROM DIVIDEND
+       SNL             /DONE YET?
+       JMP OP6B        /YES - EXIT
+       ISZ TEMP        /NO - COUNT ONE MORE SUBTRACTION
+       JMP OP6A        /SUBTRACT AGAIN
+OP6B,  CLA
+       TAD TEMP        /RESULT IS # OF SUBTRACTIONS
+       JMP I (OP0+2
+\f/HANDLER FOR XLIST PSEUDO-OP
+
+XLISTY,        JMS XLISTZ      /ANY EXPRESSION?
+       JMP XLIST1      /NO
+       JMS I [EXP      /GET EXPRESSION
+       TAD VALUE       /USE THE VALUE
+XLIST2,        DCA XLISTX      /SET SWITCH
+       DCA I [LINBUF   /XLIST NEVER LISTS!
+       JMP I [LOOKEX   /--EXIT TO MAIN--
+
+XLIST1,        TAD XLISTX
+       SNA CLA
+       IAC             /FLIP IT
+       JMP XLIST2
+
+RELOCY,        JMS XLISTZ      /RELOCATE PSEUDO-OP - EXPRESSION?
+       JMP RELOC1      /NO
+       JMS I [EXP      /GET IT
+       TAD VALUE
+       CIA             /COMPUTE OFFSET OF REL LOC CTR
+       TAD LOC         /FROM FAKE LOC CTR
+       TAD OFFSET      /OFFSET IS CUMULATIVE!
+RELOC2,        DCA OFSBUF      /SET NEW OFFSET - THIS TAKES EFFECT AFTER
+       STA             /THE LITERALS (IF ANY) ARE DUMPED.
+       JMP I (STAR0    /FAKE ORIGIN TO NEW LOC,
+                       /ACTUALLY A NO-OP BECAUSE OF OFFSET
+RELOC1,        TAD OFFSET      /SET OFSBUF=0, LOC=LOC+OFFSET -
+       TAD LOC         /THIS CANCELS ALL RELOCATION STUFF.
+       DCA VALUE
+       DCA UNDFSW      /JUST IN CASE - "STAR0" CHECKS THIS
+       JMP RELOC2      /STILL MUST OUTPUT *. TO GET IN SYNCH
+\f/HANDLER FOR EJECT PSEUDO-OP
+
+EJECTX,        ISZ THISPG
+       TAD PASS        /IS THIS PASS 3?
+       SMA SZA CLA
+       JMP EJECT2      /YES
+EJECT1,        TAD CHAR        /NO - LOOK FOR NEXT NEGATIVE CHARACTER
+       SPA CLA
+       JMP I [LOOKEX   /--EXIT TO MAIN--
+       JMS I [GETC     /GET NEXT CHARACTER
+       JMP EJECT1
+
+EJECT2,        JMS XLISTZ      /PASS 3 - IS THERE AN EXPRESSION?
+       JMP EJECT3      /NO - EXIT
+       JMS I (HEDCLR   /YES - CLEAR HEADING BUFFER
+       TAD [-HEDLEN
+       DCA EJECT7      /SET UP FOR 40 NEW CHARACTERS
+       TAD [HEADER-1
+       DCA XREG1       /SET HEADER BUFFER POINTER
+       JMP EJECT4
+
+EJECT6,        ISZ EJECT7      /FILLED 40 CHARACTERS YET?
+       JMP EJECT4      /NO - KEEP FILLING
+       CLA CMA         /YES - SKIP CHARACTERS TO
+       DCA EJECT7      /END OF LINE
+       JMP EJECT5
+
+EJECT4,        TAD CHAR        /FILL HEADING BUFFER
+       DCA I XREG1
+EJECT5,        CLA CMA
+       DCA TXTSWT
+       JMS I [GETC     /GET NEXT CHARACTER
+       TAD CHAR        /END OF LINE?
+       SMA CLA
+       JMP EJECT6      /NO - KEEP FILLING
+EJECT3,        JMS I [FORMFD   /GENERATE FORM FEED
+       JMP I [LOOKEX   /--EXIT TO MAIN--
+\fPUNVAL,       TAD PASS        /IS THIS PASS 3?
+       JMP PUNVA1      /IF SO, LIST STUFF
+
+
+/SEE IF EXPRESSION FOLLOWS XLIST
+/SKIP ON EXPRESSION
+
+EJECT7,
+XLISTZ,        0
+       JMS I [SPNOR    /IGNORE TRAILING SPACES
+       TAD CHAR
+       TAD [-">        /IS THERE AN EXPRESSION?
+       SNA CLA
+       JMP I XLISTZ    /NO--RETURN--
+       TAD CHAR
+       SMA CLA
+       ISZ XLISTZ      /YES - INCREMENT RETURN ADDRESS
+       JMP I XLISTZ    /--RETURN--
+
+
+/DUMMY ERROR ROUTINE
+/TO SUPPRESS CERTAIN ERROR MESSAGES
+/ON PASS 1
+
+PERRO1,        0
+       ISZ PERRO1      /SKIP ERROR MESSAGE POINTER
+       JMP I PERRO1    /--RETURN--
+
+
+/CONSTANTS FOR DECIMAL PRINT
+
+       DECIMAL
+FORMF8,        -1000
+       -100
+       -10
+       0
+       OCTAL
+       PAGE
+\f/*********************************************************************
+
+INBUF=.                        /INPUT BUFFER 
+
+OUBUF=.                        /OUTPUT BUFFER
+
+OUDEVH=.+400           /OUTPUT DEVICE HANDLER
+
+INDEVH=7200            /INPUT DEVICE HANDLER
+
+/**********************************************************************
+
+/      EXPLANATION OF PAL8'S BUFFER ALLOCATION ALGORITHM
+
+/PASS1:
+
+/      THE INPUT BUFFER STARTS AT 5600 AND ENDS AT 7200
+/      THE INPUT HANDLER GOES IN 7200-7600.
+/      THERE IS NO OUTPUT HANDLER.
+/      HOWEVER, IF THE CURRENT INPUT HANDLER DOES NOT
+/      LOAD INTO 7200, THEN THE BUFFER SIZE IS INCREASED
+/      SO THAT THE INPUT BUFFER IS 5600-7600
+
+/PASS2 AND PASS3:
+
+/      THE OUTPUT BUFFER IS ALWAYS 1 BLOCK LONG, LOCATED
+/      AT 5600-6200.
+/      THE OUTPUT HANDLER RESIDES IN 6200-6600.
+/      THE INPUT HANDLER RESIDES IN 7200-7600.
+/      THE INPUT BUFFER NORMALLY RESIDES IN 6600-7200
+/      BUT MAY GROW OVER EITHER THE INPUT HANDLER AREA OR
+/      THE OUTPUT HANDLER AREA, IF EITHER OR BOTH OF THESE
+/      DON'T EXIST.
+
+/WHENEVER A BUFFER GROWS OVER A HANDLER AREA, THE MONITOR
+/HANDLER RESIDENCY TABLE IS SEARCHED TO SEE IF THERE
+/WERE ANY HANDLERS THERE.  IF ANY HANDLERS WERE THERE IN THE PAST,
+/THEY ARE NOW MARKED AS BEING NON-RESIDENT.
+\f/MORE ONCE ONLY CODE
+
+OTYPE, 0
+       DCA TEMP
+       CDF 10
+       TAD I TEMP
+       AND [17         /GET DEVICE NUMBER
+       TAD (DCB-1
+       DCA TEMP
+       TAD I TEMP      /GET DCB ENTRY
+       CDF
+       JMP I OTYPE     /--RETURN--
+
+/CHECK TO SEE HOW MUCH CORE EXISTS
+/AND STORE SYMBOL TABLE ACCORDINGLY
+
+       IFZERO  HASH<
+BEGINF,        CDF 10          /WAS THE /K OPTION SELECTED TO
+       TAD I (MPARAM   /CHECK FOR MORE THAN 8K?
+       CDF 0
+       RTR
+ZK7630,        SNL CLA         /YES
+       JMP I (CKBAT    /NO - CHECK FOR BATCH, USE 8K ONLY
+       CDF 50
+       JMS FLD2        /WHAT IS HIGHEST FIELD?
+       JMP FLD1-1      /5
+       CDF 40
+       JMS FLD2
+       JMP FLD1        /4
+       CDF 30
+       JMS FLD2
+       JMP FLD1+1      /3
+       CDF 20
+       JMS FLD2
+       JMP FLD1+2      /2
+       JMP OPTIM4      /1
+\f      TAD [177        /IF FIELD 5, ALLOW 4095 SYMBOLS
+FLD1,  TAD (1740       /OTHERWISE ALLOW 1740*(NR OF FIELDS)
+       TAD (1740
+       TAD (1740
+OPTIM0,        TAD (1740
+       DCA I (TAGMAX   /SET HIGHEST ADDRESS FOR TAGS
+       JMP I (BEGING
+
+OPTIM4,        TAD I OPTIM1    /OPTIMIZE SEARCH PATTERN
+       ISZ OPTIM1      /BY SUBSTITUTING CODE IN SEARCH
+       DCA I OPTIM2    /ROUTINE
+       ISZ OPTIM2
+       ISZ OPTIM3
+       JMP OPTIM4
+OPTIM8,        TAD I OPTIM5
+       ISZ OPTIM5
+       DCA I OPTIM6
+       ISZ OPTIM6
+       ISZ OPTIM7
+       JMP OPTIM8
+       JMP OPTIM0
+       >
+
+       IFNZRO  HASH<
+       /SIZE CHECK OUR MACHINE
+
+BEGINF,        CDF     10
+       TAD I   (MPARAM
+       CDF
+       RTR             /K TO LINK
+ZK7630,        SNL CLA         /ALTER FOR COMPLEMENT OF K
+       TAD     [400    /TAD TO KEEP USR
+       DCA I   (USROFS
+       CDF     50
+       JMS     FLD2
+       ISZ     HIFLD
+       CDF     40
+       JMS     FLD2
+       ISZ     HIFLD
+       CDF     30
+       JMS     FLD2
+       ISZ     HIFLD
+       CDF     20
+       JMS     FLD2
+       ISZ     HIFLD
+       TAD I   (7777   /CHECK SOFT CORE SIZE
+       AND     (70
+       SNA
+       JMP     CKSEV   /NOT THERE
+       CLL RTR
+       RAR
+       DCA     HIFLD   /THERE, SET HIFLD WITH IT
+       TAD     HIFLD   /TAKE MIN(HIFLD,5)
+       TAD     (7772
+       SMA CLA         /SMA TO USE HIFLD
+       TAD     (5      /ELSE USE 5
+       SZA
+       DCA     HIFLD   /STORE 5 IF NECESSARY
+CKSEV, CDF     10
+       TAD I   (MPARAM+2       /LOOK AT /7
+       CDF
+       AND     (4
+       SNA CLA         /SNA IF THERE
+       JMP I   (CKBAT  /ELSE CHECK FOR BATCH
+       TAD     (-7     /SET TO PRINT 7 COLUMNS OF STAB
+       DCA I   (SYMNCL
+       TAD     (67^6   /SET OFFSET TO FIRST SYMBOL ON NEXT PAGE
+       DCA I   (SYMOFS
+       JMP I   (CKBAT  /OK, CHECK FOR BATCH NOW
+OPTIM4,        SNL             /SNL IF BATCH RUNNING
+       JMP I   (BEGING /ELSE TAKE DEFAULT TABLE SIZE
+       TAD     (BPRIME/SET ALTERNATE TABLE SIZE
+       DCA I   (PRIMES /INTO THE ONCE ONLY CODE
+       JMP I   (BEGING /NOW HIFLD=# OF HIGHEST USABLE FIELD
+HIFLD, 1               /8K MINIMUM
+       >
+
+/SKIP IF CURRENT DATA FIELD DOES NOT EXIST
+FLD2,  0
+       TAD (FLD3
+       DCA I (FLD4
+FLD3,  CLA
+       TAD I (FLD4
+       NOP
+       CDF
+       TAD (-FLD3
+       SZA CLA
+       JMP FLD5
+       TAD IOMON
+       TAD [-200
+       SNA CLA         /IS FIELD THERE?
+       JMP I FLD2      /YES--RETURN--
+       TAD [200
+       DCA IOMON
+FLD5,  ISZ FLD2        /NO-INCREMENT RETURN ADDRESS
+       JMP I FLD2      /--RETURN--
+
+FLD4,  IOMON
+\f/OVERLAY CODE FOR OPTIMAL SYMBOL TABLE SEARCH
+/IN 8K
+       IFZERO  HASH<
+
+OPTIM1,        OPTIMA
+OPTIM2,        SETFLD+1
+OPTIM3,        -7
+
+OPTIM5,        OPTIMB
+OPTIM6,        GETTG5
+OPTIM7,        -21
+
+OPTIMA,        RELOC SETFLD+1
+
+       CLL CMA RTL
+       TAD STM202
+       DCA TAGXR
+       CDF 10
+       JMP I SETFLD
+STM202,        -202
+SETFL4,        4
+       RELOC
+
+OPTIMB,        RELOC GETTG5
+
+       TAD HIGHTG
+       JMS SETFLD
+       TAD TAGXR
+       DCA XREG1
+       TAD XREG1
+       TAD SETFL4
+       DCA XREG2
+       TAD THISTG
+       JMS SETFLD
+OPTIML,        TAD I XREG2
+       DCA I XREG1
+       TAD XREG1
+       CIA
+       TAD TAGXR
+       SZA CLA
+       JMP OPTIML
+       CDF
+       RELOC
+       >
+\f/OVERLAY CODE FOR DDT SYMBOL TABLE PRINT
+
+DSWIT2,        IFZERO  HASH<
+       RELOC SYMPR9-2
+       JMP SYMPRE
+SYMPRD,        TAD SYM204
+       JMS I OERROR
+       TAD [377
+       JMS I OERROR
+       JMS SYMPRC
+       DCA LINCNT
+       JMP I SYMPRT
+SYMPRC,        0
+       TAD [-200
+       DCA SYMPR2
+       TAD [200
+       JMS I OERROR
+       ISZ SYMPR2
+       JMP .-3
+       JMP I SYMPRC
+       RELOC
+       >
+       IFNZRO  HASH<
+       RELOC   SYMDDT
+       ISZ     THISTG
+       JMP     SYMLUP
+SYMXIT,        TAD     SYM204
+       JMS I   OERROR
+       TAD     [377
+       JMS I   OERROR
+       JMS     DDTLDR
+       DCA     LINCNT
+       JMP I   SYMPRT
+DDTLDR,        0
+       TAD     [7600
+       DCA     SYMCCT
+       TAD     [200
+       JMS I   OERROR
+       ISZ     SYMCCT
+       JMP     .-3
+       JMP I   DDTLDR
+SYM204,        204
+       RELOC
+       >
+DSWITB=        .
+       PAGE
+\fBEGING,       CIF 10
+       JMS I IOMON     /CALL THE USR
+       12              /TO FIND OUT DSK:
+BEGINJ,        TEXT /DSK/
+       7201            /DUMMY
+       HLT             /NEVER!
+/V3C   TAD BEGINJ+1    /GET DEVICE NUMBER OF DSK:
+/V3C   DCA CC7         /AND SET IT
+       TAD BEGINJ+1
+       DCA I BEGINL    /AND SET IT INTO "PALBIN"
+       CDF 10
+       TAD I CC1       /GET PARAMETER WORD 1
+       CDF
+       CLL RTL         /OPTION /B INTO LINK
+       AND [400        /IS IT /F?
+ZF7650,        SZA CLA
+       DCA I CCX1      /YES: /F => NO 0 FILL
+ZB7430,        SNL             /IS IT /B?
+       JMP .+3
+       TAD CCX2
+       DCA I CCX3      /YES: /B => ! IS SHIFT
+       CDF 10
+       TAD I CC1       /GET WORD 1 AGAIN
+       CDF
+       AND [200        /IS IT /E?
+ZE7640,        SNA CLA
+       JMP .+3
+       TAD CCX8
+       DCA I CCX4      /YES: /E => SET 'LG' ERROR
+       CDF 10
+       TAD I CCX5      /GET WORD 2 THIS TIME
+       CDF
+       RTL
+ZO7710,        SMA CLA         /IS IT /O?
+       JMP .+3
+       DCA I CCX6      /YES: /O => NO 200 ORG
+       ISZ I CCX7
+       CDF 10
+       TAD I CC1       /GET WORD 1 AGAIN
+       AND CC2         /IS IT /C?
+       SNA CLA
+       JMP I CC3       /NO: TRY FOR /L OR /G
+       TAD I CC4       /CREF FILE SPECIFIED?
+       SZA CLA
+       JMP CC5         /YES
+CC6,   TAD CC7         /NO: GIVE "CREFLS.TM"
+       DCA I CC4
+       ISZ CC6
+       ISZ CC4
+       ISZ CC8
+       JMP CC6
+\fCC5,  CDF
+       CIF 10
+       CLA IAC
+       JMS I IOMON     /LOOKUP "CREF.SV"
+       2
+CC13,  CC9             /POINT TO NAME - BACK WITH START
+CC8,   -5              /LENGTH GOES HERE
+       JMP CC16        /NOT FOUND!
+       TAD CC30
+       JMS I CC31      /CHECK TYPE FILE
+       SMA CLA
+       JMP CC16        /NOT DIRECTORY IS ERROR
+       TAD CC12
+       DCA I CC121     /CSWITC=TAD I [7605
+       TAD CC11
+       DCA I CC111     /CSWIT1=CLA
+       TAD CC10
+       DCA I CC101     /CSWIT2=DCA BINSRT
+       DCA I CC171     /CMOVE=0
+       TAD CC13
+       DCA I CC131     /CHAIN="CREF.SV"
+       DCA I CC141     /LSWITC=0
+       TAD CC30
+       DCA I CC301     /NOPA22=7612
+       DCA I CC20      /"BEGIAB"=0
+       TAD CC21
+       DCA I CC211     /"DIRSW1"=TAD [177
+       TAD CC22
+       DCA I CC221     /"PTPSW1"=TAD [232
+       JMP I .+1
+       CCC             /KEEP GOING (SIGH)
+
+CC16,  JMS I [ERROR
+       CF              /OPTION /C ERROR
+       JMP I CC3       /TRY FOR /L OR /G
+\fCC171,        SWAPR2+CMOVE
+CC141, LSWITC
+CC131, CHAIN
+CC121, CSWITC
+CC12,  TAD I [7605
+CC111, CSWIT1
+CC11,  CLA
+CC101, SWAPR2+CSWIT2
+CC10,  DCA BINSRT
+CC301, SWAPR2+NOPA22
+CC30,  7612
+CC31,  OTYPE
+CC1,   MPARAM
+CC2,   1000
+CC3,   BEGINH
+CC4,   7612
+
+CCX1,  TEXT4X          /V3C
+CCX2,  OP3
+CCX3,  OPEXPL
+CCX4,  LGERR
+CCX5,  MPARAM+1
+CCX6,  FIELDY+1
+CCX7,  FIELDY+2
+CCX8,  JMS I PERROR
+
+CC7,   1
+       FILENAME CREFLS.TM
+CC9,   FILENAME CREF.SV
+
+CC20,  BEGIAB
+CC21,  TAD [177
+CC211, SWAPR2+DIRSW1
+CC22,  TAD [232
+CC221, SWAPR2+PTPSW1
+
+BEGINL,        PALBIN
+       PAGE
+\f/***********************************************************************
+/SYMBOL TABLE
+/MOVED BY ASSEMBLER TO FIELD 1
+/MUST REMAIN IN ALPHABETICAL ORDER
+/***********************************************************************
+
+SYMS,  5777                    /TERMINATOR
+       3777                    /IMPOSSIBLE (LIMITING) SYMBOL
+       5777
+       0000
+       IFNZRO  HASH<           /PSEUDO OPS MUST GO FIRST FOR EXPUNGE
+       "I-300^45+4000+2000     /I
+       0
+       0
+       0400
+
+       "P-300^45+"A-300+4000   /PAUSE
+       "U-300^45+"S-300
+       "E-300^45+4000
+       PAUSEX
+
+       "P-300^45+"A-300+4000   /PAGE
+       "G-300^45+"E-300
+       4000
+       PAGEX
+
+       "T-300^45+"E-300+4000   /TEXT
+       "X-300^45+"T-300
+       4000
+       TEXTX
+
+       "R-300^45+"E-300+4000   /RELOC
+       "L-300^45+"O-300
+       "C-300^45+4000
+       RELOCY
+
+       "O-300^45+"C-300+4000   /OCTAL
+       "T-300^45+"A-300
+       "L-300^45+4000
+       OCTALX
+
+       "N-300^45+"O-300+4000   /NOPUNCH
+       "P-300^45+"U-300
+       "N-300^45+"C-300+4000
+       NOPUNX
+
+
+       "I-300^45+"F-300+4000   /IFZERO
+       "Z-300^45+"E-300
+       "R-300^45+"O-300+4000
+       IF0
+\f      "I-300^45+"F-300+4000   /IFNZRO
+       "N-300^45+"Z-300
+       "R-300^45+"O-300+4000
+       IFN0
+
+       "I-300^45+"F-300+4000   /IFNDEF
+       "N-300^45+"D-300
+       "E-300^45+"F-300+4000
+       IFND
+
+       "I-300^45+"F-300+4000   /IFDEF
+       "D-300^45+"E-300
+       "F-300^45+4000
+       IFD
+
+       "F-300^45+"I-300+4000   /FIXTAB
+       "X-300^45+"T-300
+       "A-300^45+"B-300+4000
+       FIXTBX
+
+       "F-300^45+"I-300+4000   /FIXMRI
+       "X-300^45+"M-300
+       "R-300^45+"I-300+4000
+       FIXMRX
+
+       "F-300^45+"I-300+4000   /FILENAME
+       "L-300^45+"E-300
+       "N-300^45+"A-300+4000
+       FILENX
+
+       "F-300^45+"I-300+4000   /FIELD
+       "E-300^45+"L-300
+       "D-300^45+4000
+       FIELDX
+
+       "E-300^45+"X-300+4000   /EXPUNGE
+       "P-300^45+"U-300
+       "N-300^45+"G-300+4000
+       EXPUNX
+
+       "E-300^45+"N-300+4000   /ENPUNCH
+       "P-300^45+"U-300
+       "N-300^45+"C-300+4000
+       ENPUNX
+
+       "E-300^45+"J-300+4000   /EJECT
+       "E-300^45+"C-300
+       "T-300^45+4000
+       EJECTX
+\f      "D-300^45+"T-300+4000   /DTORG
+       "O-300^45+"R-300
+       "G-300^45+4000
+       DTORGX
+
+       "D-300^45+"E-300+4000   /DEVICE
+       "V-300^45+"I-300
+       "C-300^45+"E-300+4000
+       DEVICX
+
+       "D-300^45+"E-300+4000   /DECIMAL
+       "C-300^45+"I-300
+       "M-300^45+"A-300+4000
+       DECIMX
+       >
+       "Z-300^45+"B-300+4000   /ZBLOCK
+       "L-300^45+"O-300
+       "C-300^45+"K-300+4000
+       ZBLOCX
+
+       "Z-300^45+4000+2000     /Z
+       0
+       0
+       0000
+
+       "X-300^45+"L-300+4000   /XLIST
+       "I-300^45+"S-300
+       "T-300^45+4000
+       XLISTY
+
+       "T-300^45+"S-300+4000   /TSK
+       "K-300^45
+       0
+       6045
+
+       "T-300^45+"S-300+4000   /TSF
+       "F-300^45
+       0
+       TSF
+
+       "T-300^45+"P-300+4000   /TPC
+       "C-300^45
+       0
+       TPC
+
+       "T-300^45+"L-300+4000   /TLS
+       "S-300^45
+       0
+       TLS
+
+       "T-300^45+"F-300+4000   /TFL
+       "L-300^45
+       0
+       6040
+\f      IFZERO  HASH<
+       "T-300^45+"E-300+4000   /TEXT
+       "X-300^45+"T-300
+       4000
+       TEXTX
+       >
+       "T-300^45+"C-300+4000   /TCF
+       "F-300^45
+       0
+       TCF
+
+       "T-300^45+"A-300+4000   /TAD
+       "D-300^45+4000
+       0
+       TAD 0
+
+       "S-300^45+"Z-300+4000   /SZL
+       "L-300^45
+       0
+       SZL
+
+       "S-300^45+"Z-300+4000   /SZA
+       "A-300^45
+       0
+       SZA
+
+       "S-300^45+"W-300+4000   /SWP
+       "P-300^45
+       0
+       7521
+
+       "S-300^45+"T-300+4000   /STL
+       "L-300^45
+       0
+       STL
+
+       "S-300^45+"T-300+4000   /STA
+       "A-300^45
+       0
+       STA
+
+       "S-300^45+"R-300+4000   /SRQ
+       "Q-300^45
+       0
+       6003
+
+       "S-300^45+"P-300+4000   /SPA
+       "A-300^45
+       0
+       SPA
+\f      "S-300^45+"N-300+4000   /SNL
+       "L-300^45
+       0
+       SNL
+
+       "S-300^45+"N-300+4000   /SNA
+       "A-300^45
+       0
+       SNA
+
+       "S-300^45+"M-300+4000   /SMA
+       "A-300^45
+       0
+       SMA
+
+       "S-300^45+"K-300+4000   /SKP
+       "P-300^45
+       0
+       SKP
+
+       "S-300^45+"K-300+4000   /SKON
+       "O-300^45+"N-300
+       0
+       6000
+
+       "S-300^45+"G-300+4000   /SGT
+       "T-300^45
+       0
+       6006
+
+       "R-300^45+"T-300+4000   /RTR
+       "R-300^45
+       0
+       RTR
+
+       "R-300^45+"T-300+4000   /RTL
+       "L-300^45
+       0
+       RTL
+
+       "R-300^45+"T-300+4000   /RTF
+       "F-300^45
+       0
+       6005
+
+       "R-300^45+"S-300+4000   /RSF
+       "F-300^45
+       0
+       RSF
+\f      "R-300^45+"R-300+4000   /RRB
+       "B-300^45
+       0
+       RRB
+
+       "R-300^45+"P-300+4000   /RPE
+       "E-300^45
+       0
+       6010
+
+       "R-300^45+"M-300+4000   /RMF
+       "F-300^45
+       0
+       RMF
+
+       "R-300^45+"I-300+4000   /RIF
+       "F-300^45
+       0
+       RIF
+
+       "R-300^45+"I-300+4000   /RIB
+       "B-300^45
+       0
+       RIB
+
+       "R-300^45+"F-300+4000   /RFC
+       "C-300^45
+       0
+       RFC
+       IFZERO  HASH<
+       "R-300^45+"E-300+4000   /RELOC
+       "L-300^45+"O-300
+       "C-300^45+4000
+       RELOCY
+       >
+       "R-300^45+"D-300+4000   /RDF
+       "F-300^45
+       0
+       RDF
+
+       "R-300^45+"A-300+4000   /RAR
+       "R-300^45
+       0
+       RAR
+
+       "R-300^45+"A-300+4000   /RAL
+       "L-300^45
+       0
+       RAL
+\f      "P-300^45+"S-300+4000   /PSF
+       "F-300^45
+       0
+       PSF
+
+       "P-300^45+"P-300+4000   /PPC
+       "C-300^45
+       0
+       PPC
+
+       "P-300^45+"L-300+4000   /PLS
+       "S-300^45
+       0
+       PLS
+
+       "P-300^45+"C-300+4000   /PCF
+       "F-300^45
+       0
+       PCF
+
+       "P-300^45+"C-300+4000   /PCE
+       "E-300^45
+       0
+       6020
+       IFZERO  HASH<
+       "P-300^45+"A-300+4000   /PAUSE
+       "U-300^45+"S-300
+       "E-300^45+4000
+       PAUSEX
+
+       "P-300^45+"A-300+4000   /PAGE
+       "G-300^45+"E-300
+       4000
+       PAGEX
+       >
+       "O-300^45+"S-300+4000   /OSR
+       "R-300^45
+       0
+       OSR
+
+       "O-300^45+"P-300+4000   /OPR
+       "R-300^45
+       0
+       OPR
+       IFZERO  HASH<
+       "O-300^45+"C-300+4000   /OCTAL
+       "T-300^45+"A-300
+       "L-300^45+4000
+       OCTALX
+       >
+\f      IFZERO  HASH<
+       "N-300^45+"O-300+4000   /NOPUNCH
+       "P-300^45+"U-300
+       "N-300^45+"C-300+4000
+       NOPUNX
+       >
+       "N-300^45+"O-300+4000   /NOP
+       "P-300^45
+       0
+       NOP
+
+       "M-300^45+"Q-300+4000   /MQL
+       "L-300^45
+       0
+       7421
+
+       "M-300^45+"Q-300+4000   /MQA
+       "A-300^45
+       0
+       7501
+
+       "L-300^45+"A-300+4000   /LAS
+       "S-300^45
+       0
+       LAS
+
+       "K-300^45+"S-300+4000   /KSF
+       "F-300^45
+       0
+       KSF
+
+       "K-300^45+"R-300+4000   /KRS
+       "S-300^45
+       0
+       KRS
+
+       "K-300^45+"R-300+4000   /KRB
+       "B-300^45
+       0
+       KRB
+
+       "K-300^45+"I-300+4000   /KIE
+       "E-300^45
+       0
+       6035
+
+       "K-300^45+"C-300+4000   /KCF
+       "F-300^45
+       0
+       6030
+\f      "K-300^45+"C-300+4000   /KCC
+       "C-300^45
+       0
+       KCC
+
+       "J-300^45+"M-300+4000   /JMS
+       "S-300^45+4000
+       0
+       JMS 0
+
+       "J-300^45+"M-300+4000   /JMP
+       "P-300^45+4000
+       0
+       JMP 0
+
+       "I-300^45+"S-300+4000   /ISZ
+       "Z-300^45+4000
+       0
+       ISZ 0
+
+       "I-300^45+"O-300+4000   /IOT
+       "T-300^45
+       0
+       IOT
+
+       "I-300^45+"O-300+4000   /ION
+       "N-300^45
+       0
+       ION
+
+       "I-300^45+"O-300+4000   /IOF
+       "F-300^45
+       0
+       IOF
+       IFZERO  HASH<
+       "I-300^45+"F-300+4000   /IFZERO
+       "Z-300^45+"E-300
+       "R-300^45+"O-300+4000
+       IF0
+
+       "I-300^45+"F-300+4000   /IFNZRO
+       "N-300^45+"Z-300
+       "R-300^45+"O-300+4000
+       IFN0
+
+       "I-300^45+"F-300+4000   /IFNDEF
+       "N-300^45+"D-300
+       "E-300^45+"F-300+4000
+       IFND
+       >
+\f      IFZERO  HASH<
+       "I-300^45+"F-300+4000   /IFDEF
+       "D-300^45+"E-300
+       "F-300^45+4000
+       IFD
+       >
+       "I-300^45+"A-300+4000   /IAC
+       "C-300^45
+       0
+       IAC
+       IFZERO  HASH<
+       "I-300^45+4000+2000     /I
+       0
+       0
+       0400
+       >
+       "H-300^45+"L-300+4000   /HLT
+       "T-300^45
+       0
+       HLT
+
+       "G-300^45+"T-300+4000   /GTF
+       "F-300^45
+       0
+       6004
+
+       "G-300^45+"L-300+4000   /GLK
+       "K-300^45
+       0
+       GLK
+       IFZERO  HASH<
+       "F-300^45+"I-300+4000   /FIXTAB
+       "X-300^45+"T-300
+       "A-300^45+"B-300+4000
+       FIXTBX
+
+       "F-300^45+"I-300+4000   /FIXMRI
+       "X-300^45+"M-300
+       "R-300^45+"I-300+4000
+       FIXMRX
+
+       "F-300^45+"I-300+4000   /FILENAME
+       "L-300^45+"E-300
+       "N-300^45+"A-300+4000
+       FILENX
+
+       "F-300^45+"I-300+4000   /FIELD
+       "E-300^45+"L-300
+       "D-300^45+4000
+       FIELDX
+       >
+\f      IFZERO  HASH<
+       "E-300^45+"X-300+4000   /EXPUNGE
+       "P-300^45+"U-300
+       "N-300^45+"G-300+4000
+       EXPUNX
+
+       "E-300^45+"N-300+4000   /ENPUNCH
+       "P-300^45+"U-300
+       "N-300^45+"C-300+4000
+       ENPUNX
+
+       "E-300^45+"J-300+4000   /EJECT
+       "E-300^45+"C-300
+       "T-300^45+4000
+       EJECTX
+
+       "D-300^45+"T-300+4000   /DTORG
+       "O-300^45+"R-300
+       "G-300^45+4000
+       DTORGX
+
+       "D-300^45+"E-300+4000   /DEVICE
+       "V-300^45+"I-300
+       "C-300^45+"E-300+4000
+       DEVICX
+
+       "D-300^45+"E-300+4000   /DECIMAL
+       "C-300^45+"I-300
+       "M-300^45+"A-300+4000
+       DECIMX
+       >
+       "D-300^45+"C-300+4000   /DCA
+       "A-300^45+4000
+       0
+       DCA 0
+
+       "C-300^45+"M-300+4000   /CML
+       "L-300^45
+       0
+       CML
+
+       "C-300^45+"M-300+4000   /CMA
+       "A-300^45
+       0
+       CMA
+
+       "C-300^45+"L-300+4000   /CLL
+       "L-300^45
+       0
+       CLL
+\f      "C-300^45+"L-300+4000   /CLA
+       "A-300^45
+       0
+       CLA
+
+       "C-300^45+"I-300+4000   /CIF
+       "F-300^45
+       0
+       CIF
+
+       "C-300^45+"I-300+4000   /CIA
+       "A-300^45
+       0
+       CIA
+
+       "C-300^45+"D-300+4000   /CDF
+       "F-300^45
+       0
+       CDF
+
+       "C-300^45+"A-300+4000   /CAF
+       "F-300^45
+       0
+       6007
+
+       "B-300^45+"S-300+4000   /BSW
+       "W-300^45
+       0
+       7002
+
+       "A-300^45+"N-300+4000   /AND
+       "D-300^45+4000
+       0
+       AND 0
+
+       4001                    /TERMINATOR
+       0000                    /IMPOSSIBLE (LIMITING) SYMBOL
+       4000
+       0000
+
+SYME=.
+
+/**********************************************************************
+/TOP OF SYMBOL TABLE
+/**********************************************************************
+\fSWAP2=.
+
+/**********************************************************************
+/CODE UNIQUE TO PASSES 1 AND 2
+/SWAPPED IN FOR PASSES 1 AND 2
+/OVERLAYED DURING PASS 3       *** NO LITERALS ***
+
+       RELOC 1000              /ASSEMBLED INTO 1000-1247
+
+       SWAPB2= .
+       SWAPR2= SWAP2-SWAPB2    /RELOCATION FACTOR FOR THIS CODE
+
+OOPEN, 0
+       TAD OPEN01      /OPEN BINARY AND LISTING FILES
+       DCA XOUHND      /SET ADDRESS OF DEVICE HANDLER
+       TAD OPEN02
+       DCA XOUBLK
+       TAD [-5
+       DCA XOUELE      /SET NEW OUTPUT FILE LENGTH
+       CDF 10
+       TAD I OUFPTR
+       CDF
+       DCA I XOUBLK
+       ISZ XOUBLK
+       ISZ OUFPTR
+       ISZ XOUELE      /INCREMENT OUTPUT FILE LENGTH
+       JMP .-7
+       TAD OPEN02
+       IAC
+       DCA XOUBLK      /SET POINTER TO NEW FILENAME
+       TAD XOUBLK
+       DCA I OPEN04
+       CIF 10
+       JMS I IOMON     /CALL USER SERVICE ROUTINES
+       13              /*RESET SYSTEM TABLES*
+       DCA I OPEN05    /DELETE UNCLOSED FILES AND
+       TAD I OPEN02    /DELETE HANDLERS
+       AND [17         /GET NEW DEVICE HANDLER #
+       SNA             /OUTPUT INHIBIT?
+       JMP ONOFIL      /YES
+       CIF 10          /NO
+       JMS I IOMON     /CALL USER SERVICE ROUTINE
+       1               /*FETCH DEVICE HANDLER*
+XOUHND,        0               /LOADING ADDRESS
+       HLT             /HANDLER NOT AVAILABLE
+OUENTR,        TAD I OPEN02    /NORMAL RETURN - GET OUTPUT
+       CIF 10          /DEVICE NUMBER AND FILE LENGTH
+\f      JMS I IOMON     /CALL NEW SERVICE ROUTINES
+       3               /*ENTER OUTUT FILE
+XOUBLK,        0               /POINTER TO FILENAME
+XOUELE,        0               /FILE LENGTH
+       JMP OEFAIL      /ERROR RETURN
+       DCA I OPEN06    /NORMAL RETURN
+       JMS I OPEN07
+       TAD XOUHND
+       TAD [200        /LINK IS CLEAR!!
+       SNL CLA
+       TAD [400
+       TAD OUFDEV
+       DCA I OUFINP
+       TAD I OUFINP
+       CLL RAR
+       CIA
+       TAD OU3501
+       DCA INCTL
+       ISZ OOPEN
+       TAD XOUHND
+       DCA I OPEN09
+       TAD XOUBLK
+       DCA I OPEN10
+       TAD XOUELE
+       DCA I OPEN11
+       JMP I OOPEN     /--RETURN--
+
+OEFAIL,        TAD I OPEN02
+       AND [7760
+       SNA CLA
+       JMP I OPEN12    /DE**FATAL ERROR**
+       TAD I OPEN02
+       AND [17
+       DCA I OPEN02
+       JMP OUENTR
+
+ONOFIL,        ISZ I OPEN05    /SET OUTPUT INHIBIT SWITCH
+       JMP I OOPEN     /--RETURN--
+
+OUFPTR,        7600
+
+OPEN01,        OUDEVH+1
+OPEN02,        OUFILE
+OPEN04,        OUCNAM
+OPEN05,        OUTINH
+OPEN06,        OUCCNT
+OPEN07,        OUSETP
+OPEN09,        OUHNDL
+OPEN10,        OUBLK
+OPEN11,        OUELEN
+OPEN12,        SYSERR
+OU3501,        3501
+OUFDEV,        OUDEVH
+OUFINP,        INBUFP
+\f/CONTINUATION OF FIXTAB HANDLER
+
+FIXTAY,        IFZERO  HASH<
+       TAD HIGHTG      /SET POINTERS TO TABLE
+       CMA
+       >
+       IFNZRO  HASH<
+       TAD     TAGMAX
+       CIA
+       >
+       DCA TEMP3
+       DCA THISTG
+FIXTAX,        JMS I [FINDTG   /GET A TAG
+       AC3777
+       AND TAG1
+       IFNZRO  HASH<
+       SZA
+       >
+       TAD [4000       /SET BIT 0 OF FIRST WORD TO 1
+       DCA TAG1        /RETURN IT TO TABLE
+       JMS I [PUTTAG
+       ISZ THISTG
+       ISZ TEMP3       /DONE WITH TABLE YET?
+       JMP FIXTAX      /NO
+       JMP I [LOOKEX   /YES--EXIT TO MAIN--
+
+/OUTPUT ONE REGISTER - BINARY
+/ENTER WITH CONTENTS IN AC
+
+PUNOUT,        0
+       DCA PUNOU1
+       TAD PUNOU1
+       RTR
+       RTR
+       RTR
+       AND [177
+       JMS I OCHAR     /OUTPUT FIRST FRAME
+       TAD PUNOU1
+       AND [77
+       JMS I OCHAR     /OUTPUT SECOND FRAME
+       JMP I PUNOUT    /--RETURN--
+
+PUNOU1,
+IOPEN, 0               /SET UP INPUT ROUTINE
+       CLA CMA         /TO OPEN FILE
+       DCA I IOPEN1
+       ISZ I IOPEN2
+       TAD IOPEN3
+       DCA I IOPEN4
+       ISZ I IOPEN5
+       TAD [LINBUF+120
+       DCA TXTPTR
+       JMP I IOPEN     /--RETURN--
+
+IOPEN1,        INCHCT
+IOPEN2,        INEOF
+IOPEN3,        7617
+IOPEN4,        INFPTR
+IOPEN5,        FORMSW
+       PAGE
+\f/START PASS 2 *** NO LITERALS HERE EITHER ***
+
+START1,        TAD [ERROR
+       DCA PERROR      /RESET PREUDO-ERROR ROUTINE
+       JMS I ST1OPN    /OPEN PASS 2 OUTPUT FILE
+       JMP NOPA21      /NO PASS 2 IF PASS 3
+NOPA23,        TAD I ST1OBL
+       DCA BINSRT
+       DCA PUNCHX      /CLEAR PUNCH INHIBIT
+       JMS START3
+       JMP I .+1
+       START2-1
+
+NOPA21,        CDF 10
+       TAD I NOPA22    /IS THERE A PASS 3?
+       CDF
+       SNA CLA
+       JMP NOPA23      /NO - DO PASS 2
+       ISZ PASS        /SKIP PASS 2
+       NOP
+       JMP NOPAS2      /CONTINUE TO PASS 3
+
+NOPA22,        7605
+
+START3,        0               /GENERATE LEADER/TRAILER
+       TAD LEADER
+       DCA TXTPTR
+       TAD [200
+       JMS I OCHAR
+       ISZ TXTPTR
+       JMP .-3
+       JMP I START3    /--RETURN--
+
+LEADER,        -10
+\f/END PASS 2
+
+ENDPA2,        JMS I [DUMPZ    /DUMP PAGE 0 LITERALS
+       DCA PUNCHX
+       CLL             /V3C
+       TAD CHKSUM      /OUTPUT CHECKSUM
+       JMS I [PUNOUT   /PUNCH THE CHECKSUM
+       JMS START3      /GENERATE LEADER/TRAILER
+       JMS I EN2CLS    /CLOSE PASS 2 OUTPUT FILE
+NOPAS2,        TAD EN2LSO
+       DCA OERROR      /SET NEW OUTPUT TO BE LISTING
+       ISZ I EN2OU1
+CMOVE, JMP CMOVA       /ZEROED IF /C
+       CDF 10          /MOVE CODE FOR /C OPTION
+CMOVB, TAD I CMOV1
+       DCA I CMOV2     /MOVE OUTPUT FILE STORAGE
+       ISZ CMOV1
+       ISZ CMOV2
+       ISZ CMOV3
+       JMP CMOVB       /LOOP
+CMOVA, CDF
+       JMS I ST1OPN    /OPEN 3RD PASS FILE
+       DCA I CMOV4     /NO 3RD PASS
+       TAD I ST1OBL    /GET FILE START
+CSWIT2,        CLA             /"DCA BINSRT" IF /C
+       TAD PTPSW1
+       DCA I EN2PTP    /RESET PAPERTAPE SWITCH
+       TAD DIRSW1
+       DCA I EN2DIR    /RESET DIRECTORY SWITCH
+       JMS I PIOPEN
+       JMP I .+1
+       LOADOV          /OVERLAY THIS AREA WITH PASS3 CODE
+
+PIOPEN,        IOPEN
+DIRSW1,        TAD [177
+PTPSW1,        TAD [232
+
+CMOV1, 7605
+CMOV2, 7600
+CMOV3, -12
+CMOV4, NSWITC
+EN2CLS,        OCLOSE
+EN2LSO,        LISOUT
+EN2OU1,        OUTPT1
+EN2PTP,        PTPSW
+EN2DIR,        DIRSW
+ST1OPN,        OOPEN
+ST1OBL,        OUBLK
+SWAPE2,        RELOC
+       IFNZRO  ENDOVL-SWAPE2&4000 <OVLERR,__ERROR__>
+       PAGE
+\f      IFNZRO  HASH<
+
+       /ONCE ONLY CODE TO HASH OUT THE PERMANENT SYMBOLS
+
+HSHSMS,        0
+       JMS I   (7607   /WRITE THE SYMBOL TABLE SORT OVERLAY
+       4210            /2 PAGES FROM FIELD 1
+       OUDEVH+400      /FROM HERE
+       ASWAP+1         /TO HERE
+       JMP I   (SYSERR/WONDERFUL.
+       TAD I   (USROFS
+       SZA CLA         /SZA IF KICKING OUT USR
+       TAD     (12     /ELSE FUDGE POINTER
+       TAD I   (HIFLD  /FIRST SET HASH TABLE SIZE
+       TAD     PRIMES  /ACCORDING TO CORE SIZE
+       DCA     PRIME
+       TAD I   PRIME
+       DCA     PRIME
+       TAD     PRIME
+       CIA
+       DCA I   (MPRIME
+       TAD I   (USROFS
+       SZA CLA
+       JMP     KPUSR   /JMP IF KEEPING USR
+       CDF     10      /SERVE NOTICE WE'RE OCCUPYING FIELD 1
+       AC7776
+       AND I   (JSBITS
+       DCA I   (JSBITS
+       TAD     [7700
+       DCA     IOMON   /AND POINT AT PROPER MONITOR E.P.
+KPUSR, CDF
+       TAD I   (MPRIME /HOW MANY SLOTS TO WIPE
+       DCA     LAST3   /TO COUNTER
+       TAD I   (USROFS
+       CLL RTL
+       TAD     (7777   /FUDGE THE INITIAL AUTO XR
+       JMP     CLRGO   /INTO THE LOOP NOW
+CLRLUP,        TAD     LAST1
+       TAD     (-7577
+       SZA CLA         /SZA IF NEED TO DO NEXT FIELD
+       JMP     CLCDF0+1/ELSE CLEAR ANOTHER
+       TAD     (10
+       TAD     CLCDF0
+       DCA     CLCDF0  /CDF INSTR GETS BUMPED
+       STA
+CLRGO, DCA     LAST1   /XRGETS SET
+CLCDF0,        CDF     10      /INITIALLY CDF 10
+       DCA I   LAST1
+       DCA I   LAST1
+       DCA I   LAST1
+       DCA I   LAST1
+       ISZ     LAST3   /SKP IF NO MORE
+       JMP     CLRLUP  /ELSE DO ANOTHER
+       CDF             /THE TABLE IS CLEAN
+       TAD     (HSHRTN
+       DCA I   [GETTAG
+       STA
+       DCA     HIGHTG  /HIGHTG=CURRENT SYMBOL INDEX
+       TAD     (SYMS+3 /USE THESE AUTO XR'S NOW
+       DCA     LAST1
+       TAD     LAST1
+       DCA     LAST2
+HSHLP, TAD I   LAST1
+       AND     [1777   /FIRST, STRIP THE TYPE BITS
+       DCA I   (NAME1
+       AC3777
+       AND I   LAST1
+       DCA I   (NAME2
+       AC3777
+       AND I   LAST1
+       DCA I   (NAME3
+       ISZ     LAST1   /SKIP THE VALUE
+       JMP I   (GETTGH /GO FIND IT'S PLACE
+HSHRTN,        CLA CLL
+       TAD I   LAST2
+       DCA I   (NAME1
+       TAD I   LAST2
+       DCA I   (NAME2
+       TAD I   LAST2
+       DCA I   (NAME3
+       TAD I   LAST2
+       DCA     VALUE2
+       JMS I   (INSRTG /AND STORE IT
+       TAD     LAST1
+       TAD     (1-SYME+4
+       SZA CLA
+       JMP     HSHLP   /LOOP IF MORE TO GO
+       JMP I   HSHSMS  /--RETURN--
+
+PRIMES,        .
+       1737    /1 FIELD
+       3673    /2 FIELDS
+       5633    /3 FIELDS
+       7577    /4 FIELDS
+       7775    /5 FIELDS (THE LAST MOSTELY WASTE)
+       BPRIMES=.-1     /ALTERNATE TABLE SIZE FOR BATCH COMPATABILITY
+       1737    /1 FIELD (MEANS NO BATCH)
+       3133    /2 FIELDS
+       5075    /3 FIELDS
+       7035    /4 FIELDS
+       7775    /5 FIELDS (SOME OF WASTE FOR BATCH)
+
+       1335    /STILL ANOTHER ALTERNATE SET IF KEEPING USR
+       3273
+       5237
+       7175
+       7775
+
+       0
+       2535
+       4465
+       6437
+       7775
+
+       PAGE
+       >
+\f/**************************************************************
+/PAGE 0 LITERALS
+/**************************************************************
+       IFNZRO  HASH<
+
+       /SYMBOL TABLE SORT OVERLAY
+       /ONLY SWAPPED IF TABLE WILL BE LISTED
+
+       /FIRST, SOME EQUATES
+
+       PPUTTAG=        [PUTTAG
+       PFINDTG=        [FINDTG
+       O1777=          [1777
+       O7774=          [7774
+
+       SXR=    XREG1
+       TXR=    XREG2
+       SXR2=   LAST1
+       TXR2=   LAST2
+       UXR=    LAST3
+       DXR=    LAST4
+
+       BEG=    LOC
+       END=    OFFSET
+       LO=     OFSBUF
+       HI=     STARSW
+       MED=    OP
+
+       FIELD 1         /SET THE FIELD NOW
+\f      *OUDEVH+400     /IT GOES HERE
+
+SORTAB,        0               /FIRST LOC IN PAGE
+       TAD     TAGMAX
+       CIA
+       DCA     TEMP    /TEMP=#CELLS TO SCAN
+
+       /DEFLATE TABLE PRIOR TO SORTING AND LISTING IT
+       /OUT WITH EMPTIES AND PERMANENTS
+
+       DCA     HIGHTG  /TARGET POINTER
+       DCA     TEMP2   /SOURCE POINTER
+DEFLP, TAD     TEMP2
+       DCA     THISTG
+       JMS I   PFINDTG /GET THE NEXT STAB CELL
+       TAD     TAG1
+       CLL RAL
+       SNA SZL CLA     /AND THERE BUT NOT FIXED?
+       JMP     DEFNUL  /NO, DON'T STORE IT
+       TAD     O1777   /YES,DISCARD THE TYPE BITS NOW
+       AND     TAG1
+       DCA     TAG1
+       AC3777
+       AND     TAG2
+       DCA     TAG2
+       AC3777
+       AND     TAG3
+       DCA     TAG3
+       TAD     HIGHTG
+       DCA     THISTG
+       JMS I   PPUTTAG
+       ISZ     HIGHTG
+DEFNUL,        ISZ     TEMP2
+       ISZ     TEMP    /TRY AGAIN
+       JMP     DEFLP
+       JMS I   (SORT   /NOW SORT THEM
+       JMP I   SORTAB  /EXIT TO PRTSTAB
+\f      /MOVE A SYMBOL THRU THE TABLE
+
+SMOV,  0
+       TAD     SXR2    /GET SOURCE DF+XREG
+       JMS     GETFLD
+       DCA     SMVCD1
+       TAD     TXR
+       DCA     SXR
+       TAD     TXR2
+       JMS     GETFLD
+       DCA     SMVCD2
+       TAD     O7774
+       DCA     SSWT
+SMVCD1,        0
+       TAD I   SXR
+SMVCD2,        0
+       DCA I   TXR
+       ISZ     SSWT
+       JMP     SMVCD1
+SMVCD0,        CDF
+       JMP I   SMOV
+
+       /AUXILLIARY FIELD+XREG SETTER
+
+GETFLD,        0
+       CLL
+       TAD I   (USROFS /IF KEEPING USR
+       DCA     TXR     /AC=SYM NUM
+       DCA     SMVCD2
+       TAD     TXR
+       ISZ     SMVCD2
+       CML
+       TAD     (-1740
+       SNL
+       JMP     .-4
+       CLL RTL
+       TAD     (-202   /SETS AS IN SETFLD...
+       DCA     TXR     /TENTATIVELY SET TXR
+       TAD     SMVCD2
+       CLL RTL
+       RAL
+       TAD     SMVCD0
+       JMP I   GETFLD  /EXIT WITH AC SET TO CDF INSTR
+\f      /ROUTINE TO EXCHANGE SYMBOLS LO AND HI
+
+SSWT,  0
+       TAD     HI
+       JMS     GETFLD
+       DCA     SWCDF1
+       TAD     SWCDF1
+       DCA     SWCDF3
+       TAD     TXR
+       DCA     SXR
+       TAD     SXR
+       DCA     SXR2    /SXR'S FOR HIGH SYMBOL
+       TAD     LO
+       JMS     GETFLD
+       DCA     SWCDF2
+       TAD     TXR
+       DCA     TXR2    /TXR'S FOR LOW SYMBOL
+       TAD     O7774
+       DCA     SMOV    /COUNTER
+
+SWCDF1,        0
+       TAD I   SXR     /GET HI SYM WORD
+       DCA     GETFLD  /HOLD IT
+SWCDF2,        0
+       TAD I   TXR     /GET LO
+       DCA     SCOM    /HOLD IT
+       TAD     GETFLD
+       DCA I   TXR2    /STORE  HI IN LOW
+SWCDF3,        0
+       TAD     SCOM    /NOW STORE LO
+       DCA I   SXR2    /IN HI
+       ISZ     SMOV
+       JMP     SWCDF1+1
+       CDF
+       JMP I   SSWT
+\f      /COMPARE SYMBOLS + SET LINK THEREBY
+
+SCOM,  0
+       DCA     THISTG  /AC=TAG #
+       JMS I   (SETFLD
+       TAD I   TAGXR
+       CLL CIA
+       TAD     TAG1
+       SZA CLA
+       JMP     SCOMRT
+       TAD I   TAGXR
+       CLL CIA
+       TAD     TAG2
+       SZA CLA
+       JMP     SCOMRT
+       TAD I   TAGXR
+       CLL CIA
+       TAD     TAG3
+       SNA CLA
+       HLT     /NEVER
+SCOMRT,        CDF
+       JMP I   SCOM
+
+       PAGE
+
+
+
+
+
+
+
+
+\f      /SORT ROUTINE HERE
+
+SORT,  0
+       DCA     BEG     /INITIALIZE PARTITION BOUNDS
+       STA STL
+       TAD     HIGHTG
+       DCA     END     /ARE THERE ANY SYMBOLS?
+       SZL
+       JMP I   SORT    /NO EXIT WITH LINK SET
+       TAD     (LITBF1-1+26    /OK, SET STACK NOW
+       DCA     DXR
+       TAD     DXR
+       DCA     UXR
+
+SLOOP, STA
+       TAD     LEVEL
+       DCA     LEVEL
+SLOOP2,        TAD     BEG
+       STL CIA
+       TAD     END
+       SNA SZL
+       JMP     OKCOOL  /END.LOS.BEG
+       CLL RAR
+       TAD     BEG
+       DCA     MED     /MED=BEG+(END-BEG)/2
+       TAD     MED
+       DCA     THISTG
+       JMS I   PFINDTG /T=A(MED)
+       TAD     BEG
+       DCA     LO      /LO=BEG
+       TAD     END
+       DCA     HI      /HI=END
+       TAD     MED
+       CIA
+       TAD     BEG
+       SNA CLA
+       JMP     JUSTWO  /BEG.EQ.MED
+\f      TAD     LO
+       DCA     SXR2
+       TAD     MED
+       DCA     TXR2
+       JMS I   (SMOV   /A(MED)=A(LO)
+BEGLP, ISZ     LO
+       TAD     LO
+       CLL CIA
+       TAD     HI
+       SNL CLA
+       JMP     DONE    /HI.LOS.LO
+       TAD     LO
+       JMS I   (SCOM   /T.GT.A(LO) TO LINK
+       SZL CLA
+       JMP     BEGLP   /T.GT.A(LO)
+       JMP     ENDGO   /T.LT.A(LO)
+ENDLP, TAD     LO
+       CLL CIA
+       TAD     HI
+       SNL CLA
+       JMP     DONE    /IF HI.LO.LO
+ENDGO, TAD     HI
+       JMS I   (SCOM
+       SZL CLA
+       JMP     SWITCH
+       STA
+       TAD     HI
+       DCA     HI
+       JMP     ENDLP
+SWITCH,        JMS I   (SSWT
+       STA
+       TAD     HI
+       DCA     HI
+       JMP     BEGLP
+\fDONE, TAD     HI
+       DCA     SXR2
+       TAD     BEG
+       DCA     TXR2
+       JMS I   (SMOV   /A(BEG)=A(HI)
+       TAD     HI
+       DCA     THISTG
+       JMS I   PPUTTAG /A(HI)=T
+       AC7776
+       TAD     UXR
+       DCA     UXR
+       TAD     UXR
+       DCA     DXR
+       TAD     HI
+       CLL CIA
+       TAD     MED
+       SZL CLA
+       JMP     HIBIGR  /DEFER HIGH FOR LATER
+       TAD     BEG
+       DCA I   DXR     /DEFER LO FOR LATER
+       STA
+       TAD     HI
+       DCA I   DXR
+       TAD     HI
+       IAC
+       DCA     BEG
+       JMP     SLOOP
+HIBIGR,        TAD     HI
+       IAC
+       DCA I   DXR
+       TAD     END
+       DCA I   DXR
+       STA
+       TAD     LEVEL   /CLUMSY
+       DCA     LEVEL
+       CLL STA
+       TAD     HI
+       DCA     END
+       SNL             /PROTECT AGAINST WRAP AROUND
+       JMP     OKCOOL
+       JMP     SLOOP2
+
+JUSTWO,        TAD     HI
+       JMS I   (SCOM
+       SZL CLA
+       JMS I   (SSWT   /SWITCH IF T.GT.A(HI)
+OKCOOL,        CLA CLL         /NOW CONSIDER PREV PARTITIONS
+       TAD I   UXR
+       DCA     BEG
+       TAD I UXR
+       DCA     END
+       ISZ     LEVEL
+       JMP     SLOOP2  /REITERATE
+       JMP I   SORT    /DONE, RETURN WITH A CLEAR LINK
+LEVEL, 0
+       PAGE
+       >
+\f      /ROUTINE TO STORE THE DATE OF THE FORM DD-MMM-YY
+       /IN THE HEADING
+
+       IFZERO  HASH    <
+       FIELD   1
+       *OUDEVH+400
+       >
+
+FMTDAT,        0
+       TAD I   (MDATE  /PICK UP THE DATE WORD OF THE FORM MMM MDD DDD YYY
+       CDF             /RUN WITH DF = 0
+       SNA
+       JMP     NODATE  /EXIT IF NO DATE
+       DCA     DATWD   /ELSE STORE DATE WORD
+       TAD     ("0-1
+       DCA I   DATPTR  /SET FIRST DIGIT OF DAY
+       TAD     DATWD   /NOW GET DAY BITS
+       CLL RTR
+       RAR
+       AND     (37
+       JMS     DIV10   /DO DAY DIGITS NOW
+       TAD     ("-
+       DCA I   DATPTR  /STORE DASH
+       ISZ     DATPTR
+       TAD     DATWD   /NOW GET MONTH BITS
+       TAD     (7400   /REDUCE TO ORIGIN 0
+       AND     (7400
+       CLL RTL
+       RTL
+       RAL
+       DCA     DIV10
+       TAD     DIV10
+       CLL RAR         /GENERATE 1.5*MONTH INDEX
+       TAD     DIV10
+       TAD     (MONLST /INDEX MONTH LIST (SIXBIT)
+       DCA     MONPTR
+       TAD     (-3
+       DCA     DIV10   /SET 3 TIMES THRU LOOP
+       SZL
+       JMP     MONGO   /IF EVEN START AT RIGHT HALF
+MONLP, TAD I   MONPTR
+       CLL RTR
+       RTR
+       RTR
+       JMS     MONPUT  /PUT LEFT CHAR
+MONGO, TAD I   MONPTR
+       JMS     MONPUT  /PUT RIGHT CHAR
+       ISZ     MONPTR
+       JMP     MONLP   /LOOP FOR MORE
+MONPUT,        0
+       TAD     (40
+       AND     (77
+       TAD     (40     /CONVERT TO 7BIT
+       DCA I   DATPTR
+       ISZ     DATPTR
+       ISZ     DIV10
+       JMP I   MONPUT  /RETURN TO UNPACK LOOP
+       TAD     ("-
+       DCA I   DATPTR  /PUT ANOTHER DASH
+       ISZ     DATPTR
+       TAD     ("6
+       DCA I   DATPTR  /SETUP YEAR TENS DIGIT FOR DIVIDE
+       TAD I   (BIPCCL
+       AND     (600    /GET YEAR EXTENSION FROM 600 BITS
+       CLL RTR
+       RTR
+       DCA     DIV10
+       TAD     DATWD   /NOW GET YEAR
+       AND     (7      /ISOLATE IT
+       TAD     DIV10   /ADD EXTENSION
+       JMS     DIV10   /UNPACK IT
+NODATE,        CIF CDF         /NOW RETURN
+       JMP I   FMTDAT
+
+DIV10, 0
+       ISZ I   DATPTR
+       TAD     (-12
+       SMA
+       JMP     .-3     /REDUCE MON 10.
+       TAD     (12+"0
+       ISZ     DATPTR
+       DCA I   DATPTR  /STORE LOW DIGIT
+       ISZ     DATPTR
+       JMP I   DIV10   /--RETURN--
+
+DATPTR,        DATE
+DATWD, 0
+MONPTR,        0
+
+       PAGE
+
+       $$$$$
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape6/README b/sw/os8/v3d/sources/system/dectapes/dectape6/README
new file mode 100644 (file)
index 0000000..3e3cd76
--- /dev/null
@@ -0,0 +1,14 @@
+This area contains the files contained on system release DECtape #6.
+
+Directory of OS/8 V3D DECtape 6 labeled:  AL-4696C-SA     2/15/78
+                                         OS/8 V3D SRC DT  6 OF 7
+                                         (replaces DEC-S8-OSYSB-B-UA6)
+
+
+PAL8  .PA 291 01-AUG-77    RESORC.PA  72 01-AUG-77
+BOOT  .PA  21 01-AUG-77    CAMP  .PA  83 01-AUG-77
+MCPIP .PA 102 01-AUG-77    DIRECT.PA  51 01-AUG-77
+
+   6 files in  620 blocks -  110 free blocks
+
+
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape6/RESORC.PA b/sw/os8/v3d/sources/system/dectapes/dectape6/RESORC.PA
new file mode 100644 (file)
index 0000000..3844464
--- /dev/null
@@ -0,0 +1,1798 @@
+/14 OS/8 RESOURCES PROGRAM
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f
+
+/      S.R.
+
+/SAVE INFO:
+
+/      .R ABSLDR
+/      *RESORC$
+/      .SAVE SYS RESORC;12000=6003
+
+/CORE MAP:
+
+/0000-1777     C.D.
+/2000-2377     DEVICE NAME AND LENGTH TABLE
+/2400-2777     OUTPUT BUFFER (DOESN'T OVERLAP BETA REGISTER)
+/3000-3377     INPUT HANDLER
+/3400-3777     OUTPUT HANDLER
+/4000-7377     INPUT DIRECTORY
+/4000-7577     INPUT HANDLERS (LOSE 2ND HALF OF LAST ONE)
+
+/FIELD 1
+
+/10000-11777   USR
+/11400-11777   INPUT KBM
+/12000-15577   PROGRAM
+/15600-16177   INPUT BLOCK 0
+/16200-17577   INPUT USR
+
+       INPBL0=5600
+       INPKBM=1400
+       INPUSR=6200
+       INPHND=4000
+
+       FAST=20
+       DIG=21
+       EXTEN=22
+
+       DEVNUM=23       /DEVICE NUMBER OF HANDLER
+       CNT=24
+       PDNT=25         /PTS TO DEVICE NAME TABLE
+       TEMP=26
+       PUDNT=27        /PTS TO USER DEVICE NAME TABLE
+       PDHIT=30        /PTS TO DEVICE HANDLER INFO TABLE
+       PDCWT=31        /PTS TO DEVICE CONTROL WORD TABLE
+       PTYP=32
+       LFT=33
+       RT=LFT+1
+       DVNO=35
+       BLOC=36
+       PDHRT=37        /POINTS TO DEVICE HANDLER RESIDENCY TABLE
+       UN=6
+       X0=10
+       XR1=11
+
+       RESVERSION="A
+
+/FIXES SINCE FIELD TEST RELEASE:
+
+/1.    'INPUT ERROR' MESSAGE NO LONGER GARBLED
+/2.    '%NON SYSTEM DEVICE' NEVER PRINTS HANDLERS
+
+/FIXES FOR MAINTENANCE RELEASE (V3C):
+
+/3.    INCORPORATED  PATCH SEQ NO 1 ALLOWS DISTINGUISHING BETWEEN
+/      HIGH AND LOW SPEED PTR'S AND ADDITIONAL CASSETTES
+/      [DSN FEB 1975]
+
+/4.    FIXED LENGTHS OF DF32'S AND RF08'S [SUPERSEDES PATCH SEQ #2
+/      DSN APR 1975]
+
+/5.    CHANGED VERSION NUMBER TO V3, UPDATED COPYRIGHT
+/6.    ADDED DUMP, LST, AND RX-- TO INTERNAL NAME TABLES
+
+/7.    ADDED DETAILS ABOUT DUMP AND FLOPPIES TO TABLES
+
+/V3D CHANGES:
+
+/8.    ADDED NAMES SLU AND LQP TO TABLES
+/9.    CAN DISTINGUISH LQP KIND OF LPTR
+/10.   FIXED BUG ABOUT DUMPING BUFFER FULL OF NULLS
+/11.   REMOVED LITTLE-USED 'OUT', 'DEV' FROM NAME TABLES
+\f      FIELD 1
+
+       *2000
+
+START, SKP
+       JMP NOCD        /CHAIN ENTRY POINT
+/      JMS I (7700     /WE ASSUME THE USR IS IN CORE
+/      10              /DON'T HAVE TO LOCK USR IN CORE IF JSW SET RIGHT
+CD,    JMS I (200
+       5               /COMMAND DECODE
+       2331            /DEFAULT INPUT EXTENSION = 'SY'
+NOCD,  DCA CTRLO
+       JMS OPENO       /OPEN OUTPUT FILE
+       DCA FILENO
+       TAD (7617
+       DCA INPTR       /POINT TO FIRST INPUT FILE
+       TAD I (7644
+       AND (4          / V OPTION?
+       SZA CLA
+       JMS TYPEV       /OUTPUT VERSION #
+       JMS SETSW
+       DCA FLAG
+       TAD I (7617
+       SNA CLA
+       JMS SPCASE      /NO FIRST ARG MEANS USE SYS: IN SPECIAL SENSE
+       JMP INL2
+INLOOP,        TAD I INPTR     /GET INPUT FILE # AND LENGTH
+       SNA CLA
+       JMP FINI        /NO MORE INPUT
+       JMS PRDASH
+INL2,  TAD I INPTR
+       AND (17
+       DCA DVNO        /GET 4-BIT DEVICE #
+       ISZ FILENO
+       TAD I INPTR
+       AND (7760       /GET NEGATIVE OF FILE LENGTH
+       DCA FILEN
+       ISZ INPTR
+       TAD I INPTR     /GET STARTING BLOCK OF FILE
+       DCA SBLOCK
+       ISZ INPTR
+       TAD DVNO
+       JMS GETDCW
+       SMA CLA
+       JMP NOFLST      /DEVICE IS NOT FILE STRUCTURED
+       JMS OPENI       /GET INPUT HANDLER
+       JMS DIRECT      /ASCERTAIN DIRECTORY INFO
+       JMS HNDLRS      /ASCERTAIN HANDLERS
+       TAD EXTEN
+       SZA CLA
+       JMS CNTSLT
+       JMS MONVER      /ASCERTAIN MONITOR VERSION #
+NEXT,  JMS CRLF
+       DCA FLAG
+       JMP INLOOP
+\fNOFLST,       JMS PRINT
+       TEXT    /%DEV IS NOT FILE STRUCTURED/
+       JMP NEXT
+
+FINI,  JMS CLOSEO      /CLOSE OUTPUT FILE
+FINIS, TAD I (7642
+       SMA CLA
+       JMP CD          /COMMAND LINE ENDED WITH CR
+       CIF CDF 0       /COMMAND LINE ENDED WITH ALTMODE
+       JMP I (7605     /GO BACK TO MONITOR
+
+/CURRENT PIP /Y FILES ARE 50 (DEC) = 62 (OCTAL) BLOCKS LONG
+
+GETDCW,        0
+       AND (17
+       TAD (7757       /GET PTR INTO DEVICE CONTROL WORD TABLE
+       DCA DCW
+       TAD I DCW       /GET D.C.W.
+       DCA DCW         /SAVE (WHY?)
+       TAD DCW
+       JMP I GETDCW
+
+SETSW, 0
+       DCA FAST
+       DCA EXTEN
+       CLA IAC
+       AND I (7643
+       SNA CLA
+       JMP NOTF
+       ISZ FAST
+       JMP I SETSW
+NOTF,  TAD I (7643
+       AND (200
+       SNA CLA
+       JMP I SETSW
+       ISZ EXTEN
+       ISZ FAST
+       JMP I SETSW
+
+/FAST GT 0 IF /L OR /E SWITCH SET
+/EXTEN=1 IF /E SWITCH SET AND /L NOT SET
+\fINPTR,        0               /POINTS TO INPUT FILE LIST
+FILEN, 0               /INPUT FILE LENGTH (NEG IN BITS 0-7)
+DCW,   0               /INPUT DEVICE CONTROL WORD
+FILENO,        0               /INPUT FILE NUMBER IN INPUT LIST
+SBLOCK,        0               /STARTING BLOCK # OF INPUT FILE
+FLAG,  0               /NON-ZERO MEANS SPECIAL CASE OF NO FIRST ARG
+
+SPCASE,        0
+       ISZ FLAG        /NOTE SPECIAL CASE
+       CLA IAC
+       DCA I (7617     /FORCE FIRST INPUT TO BE SYS:
+       JMP I SPCASE
+       PAGE
+\fPRINT,        0
+       TAD I PRINT
+       DCA PRT
+       ISZ PRINT
+       TAD PRT
+       JMS RTR6
+       JMS PR
+       JMP I PRINT
+       TAD PRT
+       JMS PR
+       JMP I PRINT
+       JMP PRINT+1
+PRT,   0
+RTR6,  0
+TTY212,        RTR
+       RTR
+       RTR
+       JMP I RTR6
+
+PR,    0
+       AND (77
+       SNA
+       JMP I PR
+       TAD (240
+       AND (77
+       TAD (240
+       JMS PUTO
+       ISZ PR
+       JMP I PR
+
+TPRINT,        0               /PRINT TO TELETYPE
+       CLA
+       TAD I TPRINT
+       DCA PRT
+       ISZ TPRINT
+       TAD PRT
+       JMS RTR6
+       JMS TPUT
+       TAD PRT
+       JMS TPUT
+       JMP TPRINT+1
+
+TPUT,  0
+       AND (77
+       SNA
+       JMP PUTCR
+       TAD (240
+       AND (77
+       TAD (240
+       JMS TYPE
+       JMP I TPUT
+
+PUTCR, JMS TCRLF
+       JMP I TPRINT
+\fTYPE, 0
+       DCA TYTEM
+       TAD CTRLO
+       SZA CLA
+       JMP I TYPE      /DON'T TYPE IF CONTROL/O FLAG SET
+       KSF
+       SKP
+       JMS LOOKC
+       TAD TYTEM
+       JMS TYPE2
+       JMP I TYPE
+
+TYTEM, 0
+CTRLO, 0               /NON-ZERO MEANS CTRLO/O WAS STRUCK
+
+TYPE2, 0
+       TLS
+       TSF
+       JMP .-1
+       CLA
+       JMP I TYPE2
+
+LOOKC, 0
+       KRB
+       AND (177
+       TAD (-17
+       SNA             /IS IT ^O?
+       JMP CTROLO      /YES
+       TAD (17-3       /NO
+       SZA CLA         /IS IT ^C?
+       JMP I LOOKC     /NO
+       CIF CDF 0       /YES
+       JMP I (7605
+CTROLO,        TAD ("^
+       JMS TYPE2
+       TAD ("O
+       JMS TYPE2
+       ISZ CTRLO
+       TAD (215
+       JMS TYPE2
+       TAD TTY212
+       JMS TYPE2
+       JMP I TYPE
+\fTYPEV,        0
+       JMS PRINT
+       TEXT    /RESORC V4 /
+       *.-2
+       RESVERSION&77+6300
+       *.+1
+       JMS CRLF
+       JMP I TYPEV
+
+CRLF,  0
+       TAD (215
+       JMS PUTO
+       TAD TTY212
+       JMS PUTO
+       JMP I CRLF
+
+TCRLF, 0
+       TAD (215
+       JMS TYPE
+       TAD (212
+       JMS TYPE
+       JMP I TCRLF
+
+DLST,  -1750   /1000
+       -144    /100
+       -12     /10
+       -1      /1
+       0       /END
+       PAGE
+\fCLOSEO,       0               /CLOSE OUTPUT FILE
+       TAD (232        /PUT ^Z IN BUFFER
+       JMS PUTO
+       TAD (-577       /V3D
+       DCA KNT         /SEND 577 NULLS TO OUTPUT BUFFER
+       JMS PUTO        /THIS GUARANTEES TO PURGE IT
+       ISZ KNT
+       JMP .-2
+       TAD I (7600
+       JMS I (200
+       4               /CLOSE
+L7601, 7601            /POINTER TO OUTPUT FILE NAME
+OUTLEN,        0               /LENGTH OF OUTPUT FILE
+       HLT             /SYSTEM ERROR, CANNOT OCCUR
+       JMP I CLOSEO
+OPENO, 0
+       JMS OINIT
+       DCA OUTLEN
+       TAD (3401
+       DCA OENTRY
+       TAD I (7600
+       SNA CLA
+       JMP DEFALT
+       TAD I (7600
+       JMS GETDCW
+       RAL
+       SPA CLA
+       JMP NOWR        /READ ONLY
+       TAD I (7600
+       JMS I (200
+       1               /FETCH DEVICE HANDLER (POSSIBLY 2-PAGE)
+OENTRY,        3401            /INTO PAGE 3400
+       HLT             /SYSTEM ERROR CANNOT OCCUR
+O2,    TAD L7601
+       DCA SBLKO
+       TAD I L7601
+       SNA
+       TAD (2205       /RE
+       DCA I L7601     /DEFAULT OUTPUT NAME IS RE
+       DCA OLEN
+       TAD I (7604
+       SNA
+       TAD (1423       /LS
+       DCA I (7604     / .LS IS DEFAULT OUTPUT EXTENSION
+       TAD I (7600
+       JMS I (200
+       3               /ENTER OUTPUT FILE
+SBLKO, 7601            /POINTS TO OUTPUT FILE NAME
+OLEN,  0               /COMPLEMENT OF ACTUAL OUTPUT FILE LENGTH
+       JMP DEVFUL      /OUTPUT DEVICE FULL
+       TAD SBLKO
+       DCA OBLOCK
+       TAD OLEN
+       SZA
+       TAD (-1
+       DCA OLEN
+       JMP I OPENO
+
+KNT,   0
+\fDEFALT,       TAD (3100       /SET TTY: AS DEFAULT OUTPUT DEVICE
+       DCA DVN
+       TAD (3401
+       DCA OENT
+       JMS I (200
+       1               /FETCH HANDLER BY NAME
+       2424            /TT
+DVN,   3100            /DEVICE TTY:
+OENT,  3401            /INTO 3400
+       JMP NOTTY       /NO TTY: ON SYS:
+       TAD OENT
+       DCA OENTRY
+       TAD DVN
+       DCA I (7600
+       JMP O2
+
+OUTERR,        JMS TPRINT
+       TEXT    /?OUTPUT ERROR/
+       JMS CRLF
+       JMP FINIS
+\fTRY09,        0
+       TAD (60
+       CIA
+       TAD NAM
+       DCA DIG
+       TAD DIG
+       CLL
+       TAD (-10        /TRY DIGITS 0-7
+       SZL CLA
+       JMP I TRY09
+       TAD DIG
+       TAD (60
+       TAD RT
+       DCA RT
+       JMP GOTIT
+
+PUTSP, 0
+       TAD (40
+       JMS PUTO
+       JMP I PUTSP
+       PAGE
+\fPUTO, 0
+       AND (377
+       CDF 0
+       JMP I PUTJMP
+PUTJMP,        X1
+X1,    DCA I PUTPT1
+       TAD (X2
+       DCA PUTJMP
+PUTLV, CDF 10
+       JMP I PUTO      /RETURN
+
+X2,    DCA I PUTPT2
+       TAD (X3
+       DCA PUTJMP
+       JMP PUTLV
+
+X3,    DCA TMP
+       TAD TMP
+       CLL RTL
+       RTL
+       AND (7400
+       TAD I PUTPT1
+       DCA I PUTPT1
+       TAD TMP
+       CLL RTR
+       RTR
+       RAR
+       AND (7400
+       TAD I PUTPT2
+       DCA I PUTPT2
+       ISZ PUTPT1
+       ISZ PUTPT1
+       ISZ PUTPT2
+       ISZ PUTPT2
+       TAD (X1
+       DCA PUTJMP
+       ISZ PUTKNT
+       JMP PUTLV
+       CDF 10          /BUFFER FILLED
+       ISZ OLEN
+       SKP
+       JMP DEVFUL      /CAN'T WRITE ANYMORE
+       CIF 0
+       TAD OENTRY
+       DCA OENTR       /GET ON SAME PAGE
+       JMS I OENTR
+       4200            /WRITE 1 BLOCK
+       2400            /FIELD 0, LOC 2400
+OBLOCK,        0               /OUTPUT BLOCK #
+       JMP OUTERR
+       ISZ OUTLEN
+       ISZ OBLOCK      /POINT TO NEXT BLOCK
+       JMS OINIT
+       JMP I PUTO      /RETURN
+\fPUTPT1,       0
+PUTPT2,        0
+PUTKNT,        0
+
+ZLQP,  IAC     /23
+PLAT4, IAC     /22
+PLAT3, IAC     /21
+PLAT2, IAC     /20
+PLAT1, IAC     /17
+ZXTRA, IAC     /16
+ZKL8E, IAC     /15
+ZRK8E, IAC     /14
+ZRK8,  IAC     /13
+ZASR,  IAC     /12
+ZTA8,  IAC     /11
+ZTD8,  IAC     /10
+ZL645, IAC     /7
+ZLPSV, IAC     /6
+ZLV8E, IAC     /5
+Z026,  IAC     /4
+Z029,  IAC     /3
+ZLSPT, IAC     /2
+ZPT8E, IAC     /1
+NOKIND,        CLL RAL
+/PRINTS NAME FROM TABLE, ENTER WITH ENTRY # IN AC
+PRNAM, TAD (TABASE
+       JMS PUTNAM
+       JMS UNIT
+       JMP KINDRET
+\fTMP,
+GETD77,        0
+       TAD (7707
+       DCA MASK
+       TAD (-6704      /V3C
+       JMS SRCH
+       RTR
+       RAR
+       AND (7
+       JMP I GETD77
+
+QTTY,  TAD I PDHIT
+       SMA CLA         /1 OR 2 PAGE?
+       JMP ZASR        /1 PAGE
+       JMP ZKL8E       /2 PAGE
+
+QRK8E, TAD I PDHIT
+       AND (7
+       CLL RAR
+       DCA UN
+       JMP ZRK8E
+
+OENTR,
+TSTUN, 0
+       TAD I PDHIT
+       AND (7
+       DCA UN
+       JMP I TSTUN
+
+
+QRK8,  JMS TSTUN
+       JMP ZRK8
+       PAGE
+\fNAME, 0
+       DCA NAM
+       TAD FAST
+       SZA CLA
+       JMP TRY1
+       STA
+       TAD DEVNUM
+       SNA CLA
+       JMP TRY1
+       TAD (",
+       JMS PUTO
+TRY1,  TAD (LIST1
+       DCA NM1
+LP1,   TAD I NM1
+       SNA
+       JMP TRY2
+       DCA LFT
+       ISZ NM1         /TRY A-B
+       TAD (-2         /CHANGE TO -4 TO TRY A-D
+       DCA TEMP
+       DCA RT
+LP1X,  TAD RT
+       TAD (100
+       DCA RT
+       JMS COMB
+       JMS TRY09
+       ISZ TEMP
+       JMP LP1X
+       JMP LP1
+
+NAM,   0               /SPECIFIED NAME
+NM1,   0
+
+TRY2,  TAD (LIST2
+       DCA NM1
+LP2,   TAD I NM1
+       SNA
+       JMP TRY3
+       DCA LFT
+       ISZ NM1
+       TAD I NM1
+       ISZ NM1
+       DCA RT
+       JMS COMB
+       DCA TEMP
+       TAD TEMP
+       CIA
+       TAD NAM
+       SNA CLA
+       JMP GOTIT
+       TAD TEMP
+       JMS TRY09
+       JMP LP2
+\f/TRY0 SHOULD BE SPECIAL CASE TESTS
+
+TRY3,  TAD NAM
+       JMS RTR6
+       AND (37
+       SNA
+       JMP TRY4
+       JMS SETIFA
+       CLL RAR
+       JMS RTR6
+       DCA LFT
+       TAD NAM
+       AND (77
+       JMS SETIFA
+       TAD LFT
+       DCA LFT
+       DCA RT
+       JMP GOTIT
+
+SETIFA,        0
+       SNA
+       JMP I SETIFA
+       TAD (-33
+       SPA
+       JMP LETR
+       TAD (33-60
+       CLL
+       TAD (-12
+       SZL
+       JMP NODI
+       TAD (12+60-33
+LETR,  TAD (33
+       JMP I SETIFA
+NODI,  CLA
+TRY4,  TAD NAM
+       JMS NNAME
+NAMLV, JMP I NAME
+\fCMFLG,        0
+
+/COMB, 0
+/      TAD RT
+/      SZA CLA
+/      STA
+/      DCA CMFLG
+/      TAD LFT
+/      TAD RT
+/      ISZ CMFLG
+/      JMP I COMB
+/      CLL RAL
+/      STL RAR
+/      JMP I COMB      /TURN ON BIT 0 OF 1 WORD NAME
+
+LIST1, TEXT    /DTMTLTTDCSRKRFRX/
+/      ZBLOCK 1                /PATCH SPACE
+
+PRDASH,        0
+       JMS PRINT
+       TEXT    /------/
+       JMS CRLF
+       JMS CRLF
+       JMP I PRDASH
+\fRTL6, 0
+       RTL
+       RTL
+       RTL
+       JMP I RTL6
+       PAGE
+\fDEVFUL,       JMS TPRINT
+       TEXT    /?OUTPUT DEV FULL/
+       JMP FINIS
+
+NOWR,  JMS TPRINT
+       TEXT    /?OUTPUT DEV IS READ-ONLY/
+       JMP FINIS
+NOTTY, JMS TPRINT
+       TEXT    /?TTY DOES NOT EXIST/
+       JMP FINIS
+\fOINIT,        0
+       TAD (-200
+       DCA PUTKNT
+       TAD (2400
+       DCA PUTPT1
+       TAD (2401
+       DCA PUTPT2
+       TAD (X1
+       DCA PUTJMP
+       JMP I OINIT
+\fREADI,        0
+       TAD I READI
+       DCA ARG1
+       ISZ READI
+       TAD I READI
+       DCA ARG2
+       ISZ READI
+       TAD I READI
+       DCA ARG3
+       ISZ READI
+       CIF 0
+       JMS I IENTRY
+ARG1,  0
+ARG2,  0
+ARG3,  0
+       JMP INERR
+       JMP I READI     /REURN
+
+INERR, JMS TPRINT
+       TEXT    /?INPUT ERROR/
+       JMP FINIS
+
+OPENI, 0               /FECTH INPUT HANDLER
+       TAD (3001       /INTO PAGES 3000, 3200
+       DCA IENTRY
+       TAD DVNO
+       JMS I (200
+       1               /FETCH HANDLER
+IENTRY,        3001
+       HLT             /SYSTEM ERROR, CAN'T OCCUR
+       JMP I OPENI
+\fPRFREE,       0
+       JMS PRINT
+       TEXT    /FREE DEVICE SLOTS: /
+       TAD FREEDV
+       JMS XPRINT
+       JMS PRINT
+       TEXT    /,  FREE BLOCK SLOTS: /
+       TAD SLKNT
+       JMS XPRINT
+       JMP I PRFREE
+       PAGE
+\fDIRECT,       0
+       TAD SBLOCK
+       SZA CLA
+       JMP I DIRECT    /NO DIRECTORY INFO FOR FILES
+       JMS READI
+       1400            /READ 6 BLOCKS
+       4000            /INTO 04000
+       1               /FROM BLOCK 1
+       JMS DVALID      /CHECK IF VALID DIRECTORY
+       TAD FAST
+       SNA CLA
+       JMP I DIRECT    /NO DIRECT IN FAST MODE
+       JMS CRLF
+       DCA USED
+       DCA UNUSED
+       DCA NFILES
+       DCA NMTS
+       DCA NSEGS
+       STL CLA RAR     /4000
+DIRLUP,        DCA DIRPTR
+       ISZ NSEGS
+       JMS GETDIR
+       DCA NENTRY      /- NO. OF ENTRIES IN SEGMENT
+       JMS GETDIR
+       DCA STBLK       /STARTING BLOCK # OF FIRST FILE IN SEGMENT
+       JMS GETDIR
+       DCA LINK        /LINK TO NEXT SEGMENT
+       JMS GETDIR
+       CLA             /IGNORE FLAG WORD TO TENTATIVE FILE
+       JMS GETDIR
+       DCA AIW         /# OF ADDITIONAL INFO WORDS
+       TAD NENTRY
+       DCA DKNT
+SEGLUP,        JMS GETDIR
+       SNA CLA
+       JMP EMPTY       /AN EMPTY ENTRY
+       TAD AIW
+       CIA
+       TAD (3
+       TAD DIRPTR
+       DCA DIRPTR      /POINT TO FILE LENGTH
+       JMS GETDIR      /GET NEG OF NUMBER OF BLOCKS IN FILE
+       SNA
+       JMP NEXTF       /A TENTATIVE FILE, IGNORE
+       CIA
+       TAD USED
+       DCA USED
+       ISZ NFILES
+       JMP NEXTF
+EMPTY, JMS GETDIR
+       CIA
+       TAD UNUSED
+       DCA UNUSED
+       ISZ NMTS
+NEXTF, ISZ DKNT        /ANY MORE ENTRIES IN THIS SEGMENT?
+       JMP SEGLUP      /YES
+       TAD LINK
+       SNA CLA
+       JMP GOTINFO
+       TAD NSEGS
+       CMA
+       TAD LINK        /ASSUME LINKS ARE IN ORDER
+       SZA CLA
+       JMP BADDIR
+       STA             /GO TO NEXT SEGMENT
+       TAD DIRPTR
+       AND (7400
+       TAD (400
+       JMP DIRLUP
+\fDKNT, 0
+USED,  0               /NO. OF BLOCKS USED
+UNUSED,        0               /# OF UNUSED BLOCKS ON DEVICE
+NFILES,        0               /# OF FILES
+NMTS,  0               /# OF EMPTIES
+NSEGS, 0               /# OF DIRECTORY SEGMENTS USED
+GOTINFO,JMS PRINFO
+LVDIR, JMS CRLF
+       JMS CRLF
+       JMP I DIRECT
+
+NENTRY,        0               /- # OF ENTRIES IN SEGMENT
+STBLK, 0               /STARTING BLOCK # OF FIRST FILE IN SEGMENT
+LINK,  0               /LINK TO NEXT SEGMENT
+AIW,   0               /# OF ADDITIOANAL INFORMATION WORDS
+
+GETDIR,        0
+       CDF 0
+       TAD I DIRPTR
+       CDF 10
+       ISZ DIRPTR
+       JMP I GETDIR
+
+DIRPTR,        0
+\fXPRINT,       0
+       SNA
+       JMP NONEPR
+       JMS OPRINT
+       JMP I XPRINT
+
+NONEPR,        JMS PRINT
+       TEXT    /NONE/
+       JMP I XPRINT
+
+SLOTAB,        ZBLOCK 10       /KEEPS TRACK OF USED SLOTS
+
+GETTYP,        0
+       CDF 0
+       TAD I PTYP
+       CDF 10
+       JMP I GETTYP
+
+QTC08,
+QLINC, JMS TSTUN
+       JMP NOKIND
+       PAGE
+\fPRINFO,       0
+       TAD EXTEN
+       SNA CLA
+       JMP NOFLS       /JUST # OF FREE BLOCKS UNLESS /E
+       TAD NFILES
+       SNA
+       JMP NOFLS
+       STL
+       JMS DPRINT
+       JMS PRINT
+       TEXT    / FILES IN /
+       TAD USED
+       STL
+       JMS DPRINT
+       JMS PRINT
+       TEXT    / BLOCKS/
+       STA
+       TAD NSEGS
+       SNA CLA
+       JMP ONESEG
+       JMS PRINT
+       TEXT    / USING /
+       TAD NSEGS
+       STL
+       JMS DPRINT
+       JMS PRINT
+       TEXT    / SEGMENTS/
+ONESEG,        JMS CRLF
+NOFLS, TAD UNUSED
+       STL
+       JMS DPRINT
+       JMS PRINT
+       TEXT    / FREE BLOCKS/
+       TAD EXTEN
+       SNA CLA
+       JMP I PRINFO
+       TAD NMTS
+       CLL RAR
+       SNA CLA
+       JMP MT1
+       JMS PRINT
+       TEXT    / (/
+       TAD NMTS
+       STL
+       JMS DPRINT
+       JMS PRINT
+       TEXT    / EMPTIES)/
+MT1,   CLA IAC
+       TAD AIW
+       SZA CLA
+       JMS PRAIW
+       JMP I PRINFO
+
+PRAIW, 0
+       JMS CRLF
+       TAD AIW
+       CIA
+       STL
+       JMS DPRINT
+       JMS PRINT
+       TEXT    / EXTRA INFO WDS/
+       JMP I PRAIW
+\f/HNDGET GETS VALUE IN HANDLER FROM REL LOC IN AC
+
+HNDGET,        0
+       TAD BLOC
+       DCA TEMP
+       CDF 0
+       TAD I TEMP
+       CDF 10
+       JMP I HNDGET
+
+PUTNAM,        0
+       DCA PUTNMT
+       TAD I PUTNMT
+       JMS PUTPAK
+       ISZ PUTNMT
+       TAD I PUTNMT
+       JMS PUTPAK
+       JMP I PUTNAM
+PUTNMT,        0
+/THIS PRINTS A 4 CHAR NAME, ARG IN AC.
+
+COMB,  0               /TEMP
+       TAD LFT
+       TAD RT
+       SMA
+       TAD (4000
+       JMP I COMB
+       PAGE
+\fKIND, 0
+       JMS PUTSP
+       TAD BLOC
+       SNA CLA
+       JMP NOKIND
+       JMS GETTYP
+       SNA
+       JMP NOKIND
+       DCA TEMP
+       JMP I TEMP      /BRANCH TO APPROPRIATE SUBROUTINE
+KINDRET,JMP I KIND
+
+/KIND SUBROUTINES
+/ENTER WITH BLOC POINTING TO HANDLER BLOCK IN CORE
+
+/SRCH SEARCHES THE HANDLER FOR THE NEGATIVE
+/OF THE NON-ZERO VALUE IN THE AC.
+/MASKED BY MASK.
+/IF FOUND, RETURN IS MADE WITH VALUE(WITHOUT MASK) IN AC
+/IF NOT FOUND, AC IS 0 UPON RETURN
+
+SRCH,  0
+       DCA LOOK4
+       STA
+       TAD BLOC
+       DCA XR1
+       TAD (-230       /V3C MUST SEARCH 2 PAGES; TROUBLE IF TA8E IS IN LAST SLOT
+       DCA SRCHCNT
+SRCHLP,        CDF 0
+       TAD I XR1
+       CDF 10
+       DCA TEMP
+       TAD TEMP
+       AND MASK
+       TAD LOOK4
+       SNA CLA
+       JMP SRCHGOT
+       ISZ SRCHCNT
+       JMP SRCHLP
+       JMP I SRCH
+
+SRCHGOT,TAD TEMP
+       JMP I SRCH
+
+SRCHCNT,-400
+LOOK4, 0
+/      **** NOTE:  ALL HANDLERS SHOULD BE PADDED OUT TO FILL PAGE
+/              WITH ZEROES
+/BUILD SHOULD WRITE ZEROES IN 2ND PAGE OF ONE PAGE HANDLER
+\f/SPECIAL PURPOSE ROUTINES
+
+QPTP,
+QPTR,  STA
+       DCA MASK
+       TAD (-6021
+       JMS SRCH
+       SZA CLA
+       JMP ZPT8E
+       JMP ZLSPT
+
+/FOR TYPE PTR
+/      IF HANDLER CONTAINS A 6021 IT IS A PT8E
+/      OTHERWISE IT IS A LSPT
+
+QCR8E, TAD (104
+       JMS HNDGET
+       TAD (-3203
+       SNA
+       JMP Z029
+       TAD (3203-7735
+       SNA CLA
+       JMP Z026
+       JMP NOKIND
+
+/FOR TYPE CR8E
+/      IF REL LOC 104 IS A 3203 IT IN 029 KIND
+/      IF REL LOC 104 IS A 7735 IT IS  AN 026 KIND
+/      OTHERWISE IT IS AN UNKNOWN KIND
+
+QLPTR, STA
+       DCA MASK
+       TAD (-6652      /SEARCH FOR A 6652
+       JMS SRCH
+       SZA CLA
+       JMP ZL645       /FOUND IT
+       CLA IAC         /LOOK AT REL LOC 1
+       JMS HNDGET
+       TAD (-4
+       SNA
+       JMP ZLV8E
+       TAD (4-14
+       SNA CLA
+       JMP ZLPSV
+       JMP NOKIND
+
+/IF HANDLER CONTAINS A 6652 IT'S AN L645
+/OTHERWISE, DEPENDS ON REL LOC 1
+/      IF REL LOC 1 IS A 14, IT'S A LPSV
+/      IF REL LOC 1 IS A 4, IT'S A LV8E
+/      OTHERWISE IT'S UNKNOWN (POSSIBLY OLD LP08 OR LS8E KIND)
+
+MASK,  0
+\fQTD8E,        JMS GETD77
+       CIA
+       TAD (10
+       DCA TEMP
+       TAD KTD8+1
+       AND (7700
+       TAD TEMP
+       DCA KTD8+1
+       TAD I PDHIT
+       RTR
+       RAR
+       STA
+       TAD TEMP
+       CML RAL         /TIMES 2 + LINK
+       DCA UN
+       JMP ZTD8
+
+/FIGURE OUT KIND OF TD8E BY DEVICE CODE FOUND IN 67N1 INSTRUCTION
+/      N       TYPE
+/      7       TD8A
+/      6       TD8B
+/..
+/      1       TD8G
+/      0       TD8H
+
+QTA8E, JMS GETD77
+       IAC
+       DCA TEMP
+       TAD KTA8+1
+       AND (7700
+       TAD TEMP
+       DCA KTA8+1
+       STA
+       TAD I PDHIT
+       AND (177
+       SNA CLA
+       CLA IAC
+       DCA UN
+       STA
+       TAD TEMP
+       CLL RAL
+       TAD UN
+       DCA UN
+       JMP ZTA8
+\f/FIGURE OUT KIND OF TA8E BY DEVICE CODE FOUND IN 67N1 INSTRUCTION
+
+/      N       KIND
+/      0       TA8A
+/      1       TA8B
+/...
+/      6       TA8G
+/      7       TA8H
+       PAGE
+\f/DECIMAL PRINT
+/LINK OFF MEANS PRINT LEADING SPACES
+/LINK ON MEANS DON'T PRINT LEADING SPACES OR ZEROS
+
+DPRINT,        0
+       DCA DTM
+       RAR
+       DCA LNK
+       DCA ZFLG
+       TAD (DLST
+       DCA PLST
+DPL2,  DCA DYG
+DPLUP, TAD I PLST
+       SNA
+       JMP I DPRINT
+       CLL
+       TAD DTM
+       SNL
+       JMP NEGG
+       ISZ DYG
+       DCA DTM
+       JMP DPLUP
+
+NEGG,  CLA
+       TAD DYG
+       TAD ZFLG
+       SNA
+       JMP PRBLNK
+       TAD (60
+       JMS PUTO
+       STL CLA RAR     /4000
+       DCA ZFLG
+ISZZ,  ISZ PLST
+       JMP DPL2
+
+PRBLNK,        TAD LNK
+       CLL RAL
+       TAD L40
+       SNL
+       JMS PUTO
+       CLA
+       JMP ISZZ
+DYG,   0
+PLST,  0
+ZFLG,  0               /4000 MEANS PASSED LEADING ZEROES
+\f/PRINTS A 2-DIGIT OCTAL NUMBER WITH LEADING 0'S
+
+OPRINT,        0
+       DCA OTEM
+       TAD OTEM
+       RTR
+       RAR
+       JMS OPRI
+       TAD OTEM
+       JMS OPRI
+       JMP I OPRINT
+
+OPRI,  0
+       AND (7
+       TAD (260
+       JMS PUTO
+       JMP I OPRI
+
+PRINT4,        0
+       DCA DTM
+       TAD DTM
+       JMS RTR6
+       JMS OPRINT
+       TAD DTM
+       JMS OPRINT
+       JMP I PRINT4
+
+DTM,   0
+
+PUTPAK,        0
+       DCA DTM
+       TAD DTM
+       JMS RTR6
+       JMS PR
+       JMS BLNKIT
+       TAD DTM
+       JMS PR
+       JMS BLNKIT
+       JMP I PUTPAK
+
+BLNKIT,        0
+       TAD FAST
+       SZA CLA
+       TAD L40
+       JMS PR
+L40,   40              /CAN'T HURT TO CALL PR WITH A 0
+       JMP I BLNKIT
+\fLNK,
+VERSN, 0
+       JMS PUTSP
+       TAD BLOC
+       SNA CLA
+       JMP SYSV        /TEMP (ENTRY PT IS IN FIELD 1 7600
+       TAD I PDHIT
+       AND (177
+       TAD BLOC
+GOVR,  DCA DTM
+       JMS GETV
+       CLL IAC
+       TAD (-34
+       SZL CLA
+       JMP NOOOP
+       JMS GETV
+PUTVR, SZA
+       TAD L40
+       TAD L40
+       JMS PUTO
+       JMP I VERSN
+
+OTEM,
+GETV,  0
+       CDF 0
+       TAD I DTM
+       CDF 10
+       JMP I GETV
+
+NOOOP, STA
+       TAD DTM         /SCAN BACKWARDS FOR HANDLER VERSION # (LT 33)
+       JMP GOVR
+
+SYSV,  TAD I PDHRT
+       AND (177
+       TAD (INPBL0+200
+       DCA DTM
+       TAD I DTM
+       CLL
+       TAD (-34
+       SNL CLA
+       TAD I DTM       /PRINT BAD VERSION # AS SPACE
+       JMP PUTVR
+       PAGE
+\fMONVER,       0
+       TAD FAST
+       SNA CLA
+       JMP I MONVER
+       TAD I (1400
+       TAD (-7607
+       SNA
+       JMP NOTV3
+       TAD (7607+60
+       DCA TEMPX
+       TAD I (1400+31
+       DCA TMPTWO
+OS8,   TAD ("O
+       JMS PUTO
+MONV2, JMS PRINT
+       TEXT    \S/8 V\
+       TAD TEMPX
+       JMS PUTO
+       TAD TMPTWO
+       JMS PUTO
+       JMS CRLF
+       JMP I MONVER
+
+TMPTWO,        0
+TEMPX, 0
+
+NOTV3, TAD (40
+       DCA TMPTWO
+/CHECK FOR PS/8 AND COS
+       JMP OS8
+\fLIST2,        DEVICE LPT
+       DEVICE TTY
+       DEVICE PTR
+       DEVICE PTP
+       DEVICE CDR
+       DEVICE SYS
+       DEVICE DSK
+       DEVICE CDP
+/      DEVICE DEV
+/      DEVICE OUT
+/      DEVICE INP
+       DEVICE BAT
+       DEVICE NULL     /SHOULD BE IN NEXT TABLE
+       DEVICE LST      /V3C
+       DEVICE DUMP
+       DEVICE SLU
+       DEVICE LQP
+       ZBLOCK 10       /PATCH SPACE
+       0
+
+/LIST3,        DEVICE NULL
+/      DEVICE TEST
+/      DEVICE LIST
+/      DEVICE DUMP     /V3C
+/      ZBLOCK 2        /PATCH SPACE
+/      0
+
+/INTERESTING NOTE: 'BAT', 'FOO2' AND 'RKC6' ALL HASH OUT TO 6601
+/** WANT TO CHANGE AIW PRINTER TO SAY 'NO' ADDITIONAL INFO WORDS
+/IF THERE ARE NONE.
+\f/DTN
+/DKN
+GOTIT, TAD FAST
+       SZA CLA
+       JMS PUTSP
+       TAD (LFT
+       JMS PUTNAM
+       TAD FAST
+       SZA CLA
+       JMS PUTSP
+       JMP NAMLV
+\fTABASE,       4040;4040       /0
+       DEVICE PT8E     /1
+       DEVICE KS33     /2
+       DEVICE 029      /3
+       DEVICE 026      /4
+       DEVICE LV8E     /5
+       DEVICE LPSV     /6
+       DEVICE L645     /7
+KTD8,  DEVICE TD8      /10
+KTA8,  DEVICE TA8      /11
+       DEVICE AS33     /12
+       DEVICE RK01     /13
+       DEVICE RK05     /14
+       DEVICE KL8E     /15
+       DEVICE XTRA     /16
+       TEXT   / =1/    /17
+       TEXT   / =2/    /20
+       TEXT   / =3/    /21
+       TEXT   / =4/    /22
+       DEVICE LQP      /23
+       PAGE
+\f/FORMAT OF SYSTEM HEAD FILE
+
+/REL BLK       CONTENTS        ABS BLK ON DEV
+
+/0     BOOTSTRAP & PAGE 0'S    0
+/1-4   KEYBOARD MONITOR        7-12
+/5-7   USR                     13-15
+/10-17 DEVICE HANDLERS         16-25
+/20    ENTER                   26
+/21-42 SCRATCH BLOCKS          27-50
+/43-45 COMMAND DECODER         51-53
+/46-47 SAVE,DATE               54-55
+/50    ERROR OVERLAY           56
+/51    CHAIN OVERLAY           57
+/52-55 ODT                     60-63
+/56    RESERVED FOR EXPN       64
+/57    CCL SCRATCH             65
+/60    12K TD8E HANDLER        66
+/61    CCL OVERLAY             67
+\f/DIR DID NOT GET IN CORE ON /F?
+
+DEV,   DCA BLCK0
+       TAD (66
+       DCA BLCK66
+       TAD (7
+       DCA KBM
+       TAD (13
+       DCA USRBLK
+       CDF 0
+       TAD I (4001     /GET STARTING BLOCK # OF FILES
+       CDF 10
+       TAD (-7
+       SNA CLA
+       JMP NONSYS      /FILES START AT BLOCK 7 OF DEVICE
+       TAD (16
+/CHECK TO SEE THAT DEVICE HAS SYSTEM ON IT
+       JMP RD
+
+NONSYS,        JMS PRINT
+       TEXT    /%NON SYSTEM DEVICE/
+       JMP NEXT
+
+BADFIL,        JMS PRINT
+       TEXT    /%NOT A SYSTEM HEAD/
+       JMP NEXT
+
+BADMON,        JMS PRINT
+       TEXT    /%BAD MONITOR/
+       JMP NEXT
+\fDVALID,       0
+       STL CLA RAR     /4000
+       DCA DIRPTR
+       JMS GETDIR
+       CLL
+       TAD (200
+       SNL CLA
+       JMP BADDIR
+       JMS GETDIR
+       SNA
+       JMP BADDIR
+       TAD (-400       /REMEMBER COS
+       SMA CLA
+       JMP BADDIR
+       JMS GETDIR
+       CLA             /LINKS THOROUGHLY CHECKED ELSEWHERE
+       JMS GETDIR
+       SNA
+       JMP OKDIR
+       TAD (-1400
+       CLL
+       TAD (-1000
+       SZL CLA
+       JMP BADDIR
+OKDIR, JMS GETDIR
+       SPA SNA CLA
+       JMP I DVALID
+BADDIR,        JMS PRINT
+       TEXT    \?BAD DIRECTORY\
+       JMP LVDIR
+\fUNIT, 0
+       JMS PUTSP
+       TAD BLOC
+       SNA CLA
+       JMP TSTSUN
+       TAD UN
+       SPA
+       TAD (40+1-60
+ZOUN,  TAD (60
+       JMS PUTO
+       JMP I UNIT
+
+TSTSUN,        TAD I PDHRT
+       TAD (-7607
+       SZA CLA
+       CLA IAC         /ASSUME CORESIDENT HANDLERS ARE UNIT 1
+       JMP ZOUN        /ELSE, NO UNIT
+       PAGE
+\fHNDLRS,       0
+       TAD SBLOCK
+       SNA             /IS IT A FILE?
+       JMP DEV         /NO
+       DCA BLCK0       /YES
+       TAD BLCK0
+       TAD (60
+       DCA BLCK66
+       TAD FILEN
+       TAD (-6340
+       SZA CLA
+       JMP BADFIL      /FILE DOESN'T HAVE LENGTH 50 (DECIMAL)
+       TAD BLCK0
+       IAC
+       DCA KBM
+       TAD BLCK0
+       TAD (5
+       DCA USRBLK
+       TAD BLCK0
+       TAD (10
+RD,    DCA HNDBLK
+       JMS READI       /READ IN BLOCK 0
+       210             /2 PAGES
+       INPBL0
+FREEDV,                /# OF FREE DEVICE NUMBERS
+BLCK0, 0
+       TAD I (INPBL0+212       /** DEPENDS ON TD8E HANDLER
+       TAD (-3
+       SZA CLA         /IS IT 12K TD8E?
+       JMP NOTD8E      /NO
+       JMS READI       /YES
+       110             /1 PAGE
+       INPBL0
+BLCK66,        66
+NOTD8E,        TAD I (INPBL0+200
+       TAD (-4207
+       SZA CLA
+       JMP BADMON      /BAD MONITOR ON DEVICE
+       DCA 7           /DELETE CURRENT USR DIRECTORY SEGMENT
+                       /SINCE KBM READS OVER IT
+       JMS READI       /READ IN KEYBOARD MONITOR
+       211             /ONLY FIRST 2 PAGES
+       INPKBM
+KBM,   7
+       JMS READI       /READ IN USR
+       611             /6 PAGES
+       INPUSR
+USRBLK,        13
+       JMS READI       /READ IN ALL HANDLERS (EXCEPT 2ND PAGE OF LAST ONE)
+       1700            /17 PAGES
+       INPHND
+HNDBLK,        16
+       TAD (-17
+       DCA CNT
+       DCA FREEDV
+       JMS ZEROSL
+       DCA DEVNUM
+       JMS SETPTS
+       JMS HEADING
+LOOP,  ISZ DEVNUM      /PT TO NEXT HANDLER
+       TAD I PDNT      /LOOK AT DEVICE NAME
+       SNA CLA
+       JMP NOXXT
+       TAD EXTEN
+       SNA CLA
+       JMP NONUM
+       TAD DEVNUM
+       JMS OPRINT
+NONUM, TAD I PDNT
+       JMS NAME        /PRINT NAME
+       TAD FAST
+       SNA CLA
+       JMP NEXXT
+       JMS TIPE        /PRINT TYPE
+       TAD EXTEN
+       SNA CLA
+       JMP PUSER
+       JMS MODE        /PRINT MODE
+       JMS SIZE        /PRINT SIZE
+       JMS BLOCK       /PRINT BLOCK # OF LOC OF HANDLER
+       STA
+       DCA UN
+       JMS KIND        /PRINT KIND
+       JMS VERSN       /PRINT HANDLER VERSION #
+       JMS ENTRY
+PUSER, TAD I PUDNT
+       SNA CLA
+       JMP EOL
+       TAD I PUDNT
+       JMS NAME        /PRINT USER NAME
+EOL,   JMS CRLF
+NEXXT, ISZ PDNT
+       ISZ PUDNT
+       ISZ PDHIT
+       ISZ PDCWT
+       ISZ PDHRT
+       ISZ CNT
+       JMP LOOP
+       JMS CRLF
+       JMP I HNDLRS
+
+NOXXT, ISZ FREEDV
+       JMP NEXXT
+\f      PAGE
+\fHEADING,0
+       TAD FAST
+       SNA CLA
+       JMP I HEADING
+       TAD EXTEN
+       SNA CLA
+       JMP REGLR
+       JMS PRINT
+       TEXT    /#  NAME TYPE MODE SIZ BLK KIND U V ENT USER/
+       JMP HDLV
+REGLR, JMS PRINT
+       TEXT    / NAME TYPE USER/
+HDLV,  JMS CRLF
+       JMP I HEADING
+\fSETPTS,       0
+       TAD I (INPUSR+36
+       TAD (INPUSR
+       DCA PDNT
+       TAD FLAG
+       SZA CLA
+       TAD (7741-141-INPBL0
+       TAD (INPBL0+141
+       DCA PUDNT
+/CHANGE FOR FLAG?
+       TAD I (INPUSR+37
+       TAD (INPUSR
+       DCA PDHIT
+/FLAG?
+       TAD (INPBL0+160
+       DCA PDCWT
+       TAD (INPBL0+47
+       DCA PDHRT       /DEVICE HANDLER RESIDENCY TABLE
+       JMP I SETPTS
+\fCODE, 0               /DEVICE CODE
+
+NNAME, 0
+       DCA TIPE
+       TAD ("(
+       JMS PUTO
+       TAD TIPE
+       JMS PRINT4
+       TAD (")
+       JMS PUTO
+       JMP I NNAME
+
+TIPE,  0
+       TAD I PDCWT
+       RTR
+       RAR
+       AND (77
+       DCA CODE
+       TAD CODE
+       CLL RTL
+       TAD (TYPTBL
+       DCA PTYP
+       JMS GETTYP
+       ISZ PTYP
+       SNA
+       JMP UNKN
+       JMS PUTPAK
+       JMS GETTYP
+       JMS PUTPAK
+       ISZ PTYP        /POINT TO SIZE
+       JMP I TIPE
+UNKN,  JMS PUTSP
+       TAD CODE
+       JMS OPRINT
+       JMS PUTSP
+       ISZ PTYP
+       JMP I TIPE
+\fSIZE, 0
+       JMS GETTYP
+       CIA
+       CLL
+       JMS DPRINT
+       JMS PUTSP
+       ISZ PTYP        /POINT TO KIND SUBROUTINE
+       JMP I SIZE
+
+QLPTRX,        TAD I PDHIT
+       SMA CLA         /1 OR 2 PAGE?
+       JMP QLPTR       /1 PG
+       JMP ZLQP        /2 PG
+       PAGE
+\fMODE, 0
+       JMS PUTSP
+       TAD (-4
+       DCA MKNT
+       TAD I PDCWT
+       RTL
+       RAL
+       JMS MSET
+       "R
+       TAD I PDCWT
+       RTL
+       JMS MSET
+       "W
+       TAD I PDCWT
+       RAL
+       CML
+       JMS MSET
+       "F
+       JMS PUTSP
+       ISZ MKNT
+       JMP .-3
+       JMP I MODE
+
+MSET,  0
+       CLA
+       TAD I MSET
+       DCA MCHAR
+       ISZ MSET
+       SZL
+       JMP I MSET
+       ISZ MKNT
+       TAD MCHAR
+       JMS PUTO
+       JMP I MSET
+
+MKNT,  0
+\fET,
+BLOCK, 0
+       TAD I PDHIT
+       JMS RTL6
+       AND (17
+       SNA
+       JMP SYS
+       DCA SLTM
+       STA
+       TAD SLTM
+       CLL RTR
+       RTR
+       RAR
+       TAD (INPHND
+       DCA BLOC
+       TAD SLTM
+       TAD (15
+       JMS OPRINT
+       TAD I PDHIT
+       SMA CLA
+       TAD (40-"+
+       TAD ("+
+       JMS PUTO        /"+" MEANS 2 PAGE HANDLER
+       TAD SLTM
+       TAD (SLOTAB-1
+       DCA SLTM
+       ISZ I SLTM
+       JMP I BLOCK
+SYS,   JMS PRINT
+       TEXT    /SYS/
+       DCA BLOC        /0 MEANS RESIDENT WITH SYS:
+       JMP I BLOCK
+
+MCHAR,
+ENTRY, 0
+       JMS PUTSP
+       TAD BLOC
+       SNA CLA
+       JMP SYSENT
+       TAD I PDHIT
+EN2,   DCA ET
+       TAD ET
+       JMS RTR6
+       AND (1
+       SZA
+       TAD (20
+       TAD (40
+       JMS PUTO
+       TAD ET
+       JMS OPRINT
+       JMP I ENTRY
+
+SYSENT,        TAD I PDHRT
+       JMP EN2
+\fSLTM, 0
+
+SLKNT,
+ZEROSL,        0
+       TAD (-10
+       DCA SLTM
+       TAD (SLOTAB-1
+       DCA X0
+       DCA I X0
+       ISZ SLTM
+       JMP .-2
+       JMP I ZEROSL
+
+CNTSLT,        0
+       TAD (-10
+       DCA SLTM
+       DCA SLKNT
+       TAD (SLOTAB-1
+       DCA X0
+CNSLP, TAD I X0
+       SNA CLA
+       ISZ SLKNT
+       ISZ SLTM
+       JMP CNSLP
+       JMS PRFREE
+       JMS CRLF
+       JMP I CNTSLT
+       PAGE
+\f      FIELD 0
+
+       *2000
+
+/      DEVICE LENGTH TABLE
+
+/FORMAT OF THIS TABLE:
+
+/1,2   DEVICE GENERALIZED NAME (CORR TO TYPE)
+/3     NEG OF LENGTH
+/4     ADDRESS OF SUBR IN FIELD 1 FOR SPECIALIZATION
+
+TYPTBL,        DEVICE TTY ;0000;QTTY   /0
+       DEVICE PTR ;0000;QPTR   /1
+       DEVICE PTP ;0000;QPTP   /2
+       DEVICE CR8E;0000;QCR8E  /3
+       DEVICE LPTR;0000;QLPTRX /4      V3D
+       DEVICE RK8  ;1520;QRK8  /5
+       DEVICE RF08;6001;PLAT1  /6      V3C
+       DEVICE RF08;4002;PLAT2  /7
+       DEVICE RF08;2003;PLAT3  /10
+       DEVICE RF08;0004;PLAT4  /11     RF'S NOW ONLY HAVE LOGICALLY 1777 BLOCKS
+       DEVICE DF32;7601;PLAT1  /12
+       DEVICE DF32;7402;PLAT2  /13     V3C
+       DEVICE DF32;7203;PLAT3  /14
+       DEVICE DF32;7004;PLAT4  /15     DF'S HAVE 177 BLOCKS
+       DEVICE TC08;6437;QTC08  /16
+       DEVICE LINC;6437;QLINC  /17
+       DEVICE TM8E;0000;0      /20
+       DEVICE TD8E;6437;QTD8E  /21
+       DEVICE BAT ;0000;0      /22
+       DEVICE RK8E;1520;QRK8E  /23
+       DEVICE NULL;0000;0      /24
+       DEVICE RX8E;7022;0      /25
+       ZBLOCK 4                /26
+       DEVICE TA8E;0000;QTA8E  /27
+       DEVICE VR12;0000;0      /30
+       ZBLOCK 4                /31
+       ZBLOCK 4                /32
+       ZBLOCK 4                /33
+       ZBLOCK 4                /34
+       ZBLOCK 4                /35
+       DEVICE DUMP;0000;0      /36
+       ZBLOCK 4                /37
+       ZBLOCK TYPTBL+400-.
+       PAGE
+\f      FIELD 1
+       *2000
+       $
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape7/EDIT.PA b/sw/os8/v3d/sources/system/dectapes/dectape7/EDIT.PA
new file mode 100644 (file)
index 0000000..ace4711
--- /dev/null
@@ -0,0 +1,2868 @@
+/5 OS/8 SYMBOLIC EDITOR, V12
+/
+/
+/
+/
+/
+/
+/
+//
+/
+/
+/
+/
+/COPYRIGHT (C) 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.
+/
+/
+/
+/
+/
+/
+\f/5 JULY 1972          EF
+
+/COPYRIGHT 1971,1972 DIGITAL EQUIPMENT CORPORATION
+/      MAYNARD, MASSACHUSSETTS 01754
+
+/THE SYMBOLIC EDITOR IS A LINE-ORIENTED
+/TEXT EDITOR WITH CHARACTER AND STRING
+/SEARCH CAPABILITIES.  IT IS DESIGNED
+/TO BE COMPATIBLE WITH THE OS/8 SYSTEM.
+
+/THE DESIGN OF THE EDITOR IS SIMILAR
+/TO THAT OF THE PAPER TAPE SYMBOLIC
+/EDITOR AND THE DISK MONITOR SYSTEM
+/EDITOR.
+
+
+/      OS/8 V3 CHANGES         S.R.
+
+/1.    ?5 ERROR REMOVED
+/2.    ALLOW CHAINING TO EDIT
+/3.    ADDED VERSION # COMMAND (#)
+/4.    COMBINED ^C ROUTINES, TAKING OUT BRANCH THRU 17667
+/5.    ALLOWED PARITY CHARACTERS EVERYWHERE
+/
+/
+/ FIX FOR V10 J.K.     1975
+/
+/ THE CLOSE ERROR MESAGE 2? WAS BEING
+/ GIVEN INSTEAD OF FILE FULL MESSAGE
+/ WHEN THE INPUT FILE FIT INTO THE EDIT BUFFER
+/ BUT WAS TOO LARGE FOR THE AVAILIBLE SPACE ON THE
+/ OUTPUT DEVICE.
+
+/      V11 CHANGES 25-MAY-77 DAVID SPECTOR
+
+/1.    ESCAPE KEY NO LONGER ECHOED
+/2.    SCOPE MODE SUPPORTED
+/3.    ONCE-ONLY CODE MOVED TO INPUT HANDLER
+/      AREA IN ORDER TO FREE LOCS 3000-3177
+
+/      V12 CHANGES 27-JUN-77 EDWARD P. STEINBERGER
+/
+/ALLOWED ESCAPE(233) TO BE AN INPUT CHARACTER IN TEXT MODE.
+/ECHOS AS "$" ON TERMINAL OR LINEPRINTER (IF V), OUTPUT
+/TO FILE AS ESCAPE
+
+\f/THE LOADING AND SAVING PROCEDURE FROM PAPER TAPE IS:
+/      .R ABSLDR
+/      *PTR:/9$^
+/      .SAVE SYS EDIT
+/
+
+/THE STARTING ADDRESS IS 00200.
+
+/COMMAND DECODER RULES:
+/*OUTPUT FILE<UP TO 9 INPUT FILES/OPTIONS
+
+/OPTIONS:
+/A     RETURN CONTROL TO EDITOR AFTER FILE CLOSE
+/      (CALLS COMMAND DECODER FOR NEW FILES)
+/      (DEFAULT IS RETURN TO MONITOR)
+/B     CONVERT 2 OR MORE SPACES TO TAB ON INPUT
+/D     DELETE OLD COPY OF OUTPUT FILE BEFORE
+/      STORING NEW FILE
+
+/ERROR CODES:
+/  0   FAILURE IN INPUT DEVICE HANDLER
+/  1   FAILURE IN OUTPUT DEVICE HANDER
+/  2   COULD NOT CLOSE FILE
+/  3   COULD NOT OPEN FILE
+/  4   DEVICE HANDLER COULD NOT BE LOADED
+
+       VERSION=12
+       PATCH="A        /PATCH LEVEL A
+\f/COMMANDS:
+
+/A     APPEND TEXT TO BUFFER
+/I     INSERT TEXT INTO BUFFER
+/C     CHANGE TEXT IN BUFFER
+/L     LIST TEXT IN BUFFER
+/D     DELETE TEXT IN BUFFER
+/K     KILL BUFFER
+/M     MOVE TEXT WITHIN BUFFER
+/G     GET AND LIST TAGGED LINE IN BUFFER
+/B     LIST # OF CORE LOCATIONS LEFT IN BUFFER
+/S     CHARACTER SEARCH
+/J     INTER-BUFFER STRING SEARCH
+/F     AFTER J, SEARCH FOR NEXT OCCURRANCE
+/      OF SAME STRING
+/$     INTRA-BUFFER STRING SEARCH
+/R     READ TEXT INTO BUFFER FROM INPUT DEVICE
+/N     WRITE BUFFER, KILL, AND READ NEXT PAGE
+/Y     INPUT TEXT PAGE, NO OUTPUT
+/P     WRITE TEXT BUFFER TO OUTPUT DEVICE
+/T     PUNCH TRAILER TAPE
+/E     OUTPUT BUFFER, TRANSFER REST OF
+/      INPUT FILE TO OUTPUT FILE
+/      CLOSE OUTPUT FILE
+/Q     IMMEDIATE END OF FILE
+/V     PRINT ON LP08
+/#     TYPE VERSION NUMBER
+\f
+/ABBREVIATIONS
+
+/.LT.  LESS THAN
+/.LE.  LESS THAN OR EQUAL TO
+/.GT.  GREATER THAN
+/.GE.  GREATER THAN OR EQUAL TO
+/ R    RIGHT
+/ L    LEFT
+
+/SPECIAL COMMENTS
+
+/SINCE THE EDITOR IS CODED ACROSS PAGE BOUNDARIES, IT IS
+/NECESSARY TO BE AWARE OF THE EFFECTS OF THE INSERTION
+/OR DELETION OF CODE.  FOR THIS REASON, THE LIMITS
+/OF PERMISSABLE PAGE BOUNDARY WANDERING
+/ARE INDICATED WITH THE FOLLOWING CONSTRUCTION:
+
+/-----------------------------------------------------------------------
+/SOMEWHERE BETWEEN LINES, THE PAGE BOUNDARY MUST OCCUR
+/-----------------------------------------------------------------------
+\f
+*1
+
+/MISCELLANEOUS POINTER AND CONSTANTS
+
+BUFEND,        6100            /WARNING FOR END OF BUFFER
+P7700, 7700            /MONITOR CALL LOCATION
+
+M77,   -77
+       NOP             /RESERVED FOR ODT
+       NOP             /    "
+       NOP             /    "
+
+C77,   77
+M40,   -40
+C100,  100
+C277,  277             /QUESTION MARK
+
+/AUTO-INDEX REGISTERS
+
+AXOUT, 0               /OUTPUT INDEX
+AXCOMB,        0               /COMBINE POINTER
+AXTEM, 0               /TEMPORARY INDEX
+AXIN,  0               /STORAGE INDEX
+
+/CONSTANTS
+
+M4,    -4              /LETTER COUNT
+P177,  177
+MCR,   -215
+M240,  -240
+P40,   40
+C200,  200             /(START & RESTART)
+\f
+
+/LISTS
+
+/TAG SEARCH LIST-
+LIST7=.
+
+C240,  240             /SPACE
+       257             /COMMENT DELIMITER (/)
+
+/OUTPUT LIST
+LIST4=.
+
+ESC,   233             /ESC-V12
+CTAB,  211             /TAB
+C215,  215             /CARRIAGE RETURN
+       212             /LINE FEED
+       214             /FORM FEED
+       377             /RUBOUT
+       216             /CONTROL N (^N)
+M27,   -27             /LIST DELIMITER
+
+/SPECIAL CHARACTER LIST FOR
+/INPUT IN TEXT MODE
+LIST5=.                        /USED AT AONE
+       240             /SPACE
+LIST6=.                        /USED AT SFOUND
+       225             / ^U
+C214,  214             /FORM FEED
+BELL,  207             / ^G (BELL)
+C212,  212             /LINE FEED
+CRO,   377             /RUBOUT
+
+LIST3=.
+       215             /LIST BRANCHER
+       000             /(SEARCH CHARACTER)
+RST3I, RESET3          /RESET AND SAVE BUFFER
+MCHIN1,        -CHIN-1         /LIST DELIMITER
+\f
+
+/CONSTANTS AND POINTERS
+
+CCR=C215               /CARRIAGE RETURN
+CLF=C212               /LINE FEED
+MTABS, -10             /TAB COUNTER
+DELT,  DELP
+CHI1,  CHIN
+IGNORE,        CHIN+1
+END,   200
+KEYBD, I33
+CCON,  JMP I AXCOMB
+       COM1-1
+UTR1,  UTRA
+FIN1,  FIND
+LIS1,  LIST
+LIS,   LISTER
+NINE,  12
+NUMB,  -272
+OUT1,  OUT
+OUTL1=.
+LOW,   OUTL
+CZ,    NOP             /CONTENTS OF START
+ONUM,  GTOP
+SORTJ, SORTB
+PACK1, PACBUF
+
+SXS1,  TAD CHAR        /CONTENTS OF L3
+SXS2,  SLOOK&177+5200  /JMP SLOOK
+L3I,   L3              /PATCH POINTER
+L2I,   L2              /CONTINUE SEARCH - LETTERS
+ENDLNI,        ENDLN
+SPCNO, MOR+4           /PACK
+SPCGO, MOR+1           /SORT
+\f
+
+/CHAR IS ALWAYS SET BY OUT, SOMETIMES BY SORTB;
+/IT IS ALWAYS USED BY PACK AND SORTB.
+CHAR,  0
+MOV1=.
+COUNTP,        0               /NUMBER OF PAGES
+CNT=.                  /PRINT COUNTER
+XCT,   0               /UNPACK SWITCH
+XCTIN, 0               /PACK SWITCH
+ECHOSW,        1               /NON-ZERO TO PRINT
+SAVE,  0
+TABIND,        0               /TABS OR SPACES SWITCH
+TEMP,  0               /V3
+THIS,  0               /LINE POINTER.
+OUTDEV,        OUTL            /POINTER TO OUTPUT SUBROUTINE
+GRBAGE,        GARBAG          /GARBAGE COLLECTOR
+MARK,  0               /OBJECT LINE IN G.C.
+XSAV,  0               /HOLD INPUT POINTER.
+BUFR,  200
+CFRS,  FRST
+KILL1, KILL+3
+CHKARG,        CHKARX
+ERSW,  ERROR           /ERROR ROUTINE
+L1I,   L1
+
+EKILLL,        0               /E CMD SWITCH  1 IF E NOT ALLOWED
+
+/I-O RELATED POINTERS AND WORDS
+
+P232,  232             /V3
+BUFRDI,        BUFRD           /OR CHIN...IN DEVICE POINTER
+BUFWTI,        BUFWT           /WRITE OUTPUT TO DEVICE
+CLFLI, FLCLOS          /SET TO CLOSE FILE
+P37,   37              /V3
+JMPCH, PUNCH&177+5200  /DESTROYED BY YANK
+\f
+/ERROR ROUTINE POINTERS
+
+SERR0I,        SERR0
+SERR1I,        SERR1
+SERR2I,        SERR2
+SERR4I,        SERR4
+
+GTEM=.         /NEXT 6-BITS OF UNPACK
+DTEM=.         /NEXT POINTER IN DELETE CHAIN
+
+
+/ERROR ROUTINE
+/REJECTS ILLEGAL COMMAND
+/AND TYPES ?
+
+ERROR=JMS .
+       0
+ELIM,  7600            /GRP2-CLA
+       TAD C277
+       JMS I OUTL1     /PRINT "?"
+CZONE, TAD CZ          /RESET PATCHES
+       DCA I TE1
+JMPTE1,        JMP I TE1       /*RETURN TO COMMAND MODE*
+
+
+UPAROI,        UPAROW          /GENERATE ^ CHARACTER
+MONITOR, MONIT         /MONITOR EXIT ROUTINE
+STRIND,        0
+STRFIN,        SFIND1
+TE1,   START
+
+/VARIABLES
+THSN,  0               /CURRENT LINE NUMBER
+LSTN,  0               /LAST LINE NUMBER
+TCNT,  0               /TAB COUNT
+ADD,   0
+ARG0,  0
+ARG1,  0240
+ARG2,  -1
+
+POTYPE,        OTYPE
+COMM5, COM5
+K7600, 7600
+TEMPO, 0
+K1210, 1210
+X203,  -203
+K1320, 1320
+
+FRST,  0               /FIRST LINE ADDRESS
+MOV2=TEMPO
+LSTCHK,        0       /DIGIT ACCEPTED FLAG
+\f      *177
+       INIT            /INITIALIZATION CODE
+                       /EITHER 3000 OR VALUE OF RESET
+
+
+       *200
+       STA             /V3 NORMAL START OR RESTART ADDR
+       DCA TEMP        /V3 CHAIN START ADDR
+       JMP I 177       /START AT 3000 OR RESET
+/HANDLER FOR ^U (IF IN COMMAND MODE)
+START, NOP             /V3 MAY BE MODIFIED
+       TAD LOW         /ENTER COMMAND MODE
+       DCA OUTDEV      /INITIALIZE KEYBOARD
+       DCA TABIND      /CLEAR TAB INDICATOR
+       ISZ ECHOSW      /SET UP FOR ECHO
+       DCA LIST3+1
+       TAD SXS1
+       DCA I L3I
+       TAD ERSW        /RESET ERROR SWITCH AT L1
+       DCA I L1I
+       TAD CZONE
+       DCA I COMM5
+       DCA LSTCHK      /CLEAR DIGIT ACCEPTED
+       TAD CCR         /OUTPUT CARRIAGE RETURN
+       JMS I OUT1
+/HANDLER FOR CARRIAGE RETURN (COMMAND MODE)
+       TAD SIGN        /OUTPUT #
+       JMS I OUT1
+GTOP,  DCA ARG0        /CLEAR ARGUMENTS
+       DCA ARG2
+/HANDLER FOR SPACE OR +
+GEXP,  TAD NONE
+/HANDLER FOR -
+GMIN,  TAD CMPT
+       DCA G2          /SET SIGN TO + OR -
+DBCV2, DCA TEMP
+CMCHK, JMS I CHI1      /INPUT ONE CHARACTER
+       TAD NUMB
+       CLL
+       TAD NINE
+       SZL             /WAS IT A DIGIT?
+       JMP COUNT       /YES - CONTINUE ACCEPTING NUMBERS
+\f
+
+GLOM,  CLA             /NO
+       TAD TEMP        /GET ACCUMULATED NUMBER
+G2,    HLT             /(NOP) OR (CIA) TO HANDLE SIGN
+       TAD ARG2
+       DCA ARG2        /STORE NEW ARGUMENT
+       JMS SORTB       /WAS LAST CHARACTER SPECIAL?
+       LIST1-1         /YES - COMPARE TO LIST
+       OPS1-LIST1      /AND BRANCH TO HANDLER
+       TAD CHAR        /NO - SAVE COMMAND CHARACTER
+       DCA SAVE
+       JMS I CHI1      /INPUT ONE CHARACTER
+       JMS SORTB       /IS IT CARRIAGE RETURN, ^C, OR ^U?
+       LIST1A-1        /YES - EXIT TO HANDLER
+       OPS1A-LIST1A
+       ERROR           /NO - TRY AGAIN
+\f
+/CHECK LEGALITY OF ARGUMENTS
+/ARG0 CONTAINS FIRST ARGUMENT
+/ARG2 CONTAINS SECOND ARGUMENT
+
+RETRN, TAD ARG0        
+       SNA             /IS ARG0=0?
+       TAD ARG2        /YES - ARG0=ARG2
+       DCA ARG0        /NO
+       TAD ARG2
+       CMA
+       TAD ARG0
+       SMA             /IS ARG0 .LE. ARG2?
+       ERROR           /NO
+       DCA ARG1        /YES - ARG1=ARG0-ARG2-1
+       TAD ARG0
+       SPA CLA         /IS ARG0 .GE. 0?
+       ERROR           /NO
+       TAD SAVE        /YES - GET COMMAND CHARACTER
+       JMS SORTB       /IS IT A LEGAL COMMAND?
+       LIST2-1         /YES - MATCH TO LIST
+       OPS2-LIST2      /AND BRANCH TO ITS HANDLER
+       ERROR           /NO - TRY AGAIN 
+
+
+/COMMAND IDENTIFICATION LIST
+LIST2=.                /COMMAND LETTERS
+       305             /E
+       301             /A
+       311             /I
+       303             /C
+       313             /K
+       304             /D
+       314             /L
+       316             /N
+       320             /P
+       322             /R
+       312             /J
+       306             /F
+       324             /T
+       315             /M
+       307             /G
+       323             /S
+       331             /Y
+       321             /Q
+       302             /B
+       326             /V
+SIGN,  "#              /V3 VERSION #
+NONE,  -41             /"NOP-CIA"
+\f
+/SORT AND BRANCH ROUTINE
+/LOOKS FOR MATCH BETWEEN CHAR
+/AND ELEMENTS OF TABLE 1 SPECIFIED
+/CALLING SEQUENCE:
+/      JMS I (SORTB
+/      TABLE1-1
+/      TABLE2-TABLE1
+/      RETURN IF NO MATCH
+/DISPATCHES TO CORRESPONDING ADDRESS IN TABLE 2
+
+SORTB, 0
+       SZA             /IS CHARACTER STORED YET? 
+       DCA CHAR        /NO - STORE IT
+       TAD I SORTB     /YES
+       ISZ SORTB
+       DCA AXTEM       /STORE TABLE 1 ADDRESS
+       TAD I AXTEM     /GET TABLE ENTRY
+       SPA             /DONE YET?
+       JMP SEX         /YES - EXIT
+CMPT,  CIA             /NO
+       TAD CHAR        /GET CHARACTER
+       SZA CLA         /DO THEY MATCH?
+       JMP .-6         /NO - KEEP TRYING
+       TAD AXTEM       /YES - THEY MATCH
+       TAD I SORTB     /GET DISPATCH TABLE ADDRESS
+       DCA SORTB
+       TAD I SORTB
+       DCA SORTB       /SET RETURN ADDRESS 
+       JMP I SORTB     /--RETURN--VIA DISPATCH TABLE
+SEX,   ISZ SORTB       /MATCH NOT FOUND
+       CLA
+       JMP I SORTB     /--
+
+
+/DECIMAL ADDITION ROUTINE
+/FOR NUMERIC ARGUMENTS OF COMMANDS
+/ENTER WITH INPUT DIGIT IN SORTB
+/EXIT WITH ACCUMULATED NUMBER IN AC
+COUNT, DCA SORTB
+       ISZ LSTCHK      /GOT A DIGIT NOW
+       TAD TEMP
+       RTL CLL
+       TAD TEMP
+       RAL
+       TAD SORTB
+       JMP DBCV2       /RETURN TO MAIN SEQUENCE
+\f/-----------------------------------------------------------------
+
+/DISPATCH LIST FOR COMMAND HANDLERS
+OPS2,  ENDFIL          /E 
+       APP             /A
+       XNS             /I
+       CNGE            /C
+       KILL            /K
+       DELE            /D
+       LIST            /L
+       COMBO           /N
+       PUNCH           /P 
+       TELE            /R
+       JERK            /J
+       BARROW          /F
+       PUNCT           /T
+       MOVEM           /M
+       GETTAG          /G
+       XCRET           /S
+       YANK            /Y
+       Q               /Q
+       CORSPC          /B
+       VIEW            /V
+       VERSN           /#
+\f/END OF INPUT TEXT LINE ROUTINE
+
+EOL,   JMS I ENDLNI    /RESET LINK CELLS
+       ISZ LSTN        /INCREMENT LINE POINTERS
+       ISZ THSN
+       TAD BUFEND
+       CLL CIA
+       TAD AXIN
+       SNL CLA         /IS THE BUFFER FULL?
+/------------------------------------------------------------
+       JMP MOR         /NO - KEEP FILLING
+       TAD BELL        /YES - RING WARNING BELL
+       JMS I OUTL1
+       JMP I TE1       /*RETURN TO COMMAND MODE*
+
+
+/CONTINUATION OF HANDLERS FOR A, C, AND I COMMANDS
+APP1,  TAD LSTN        /APPEND
+       DCA ARG0        /RESET ARG0 TO END OF TEXT
+       JMP INS
+CNGE1, JMS I DELT      /CHANGE - DELETE LINES AND
+XNS1,  TAD ARG0        /INSERT
+       SNA CLA         /ANY ARGUMENTS?
+INS,   ISZ ARG0        /NO - INSERT AT BEGINNING OF TEXT
+       TAD ARG0
+       JMS I FIN1      /FIND THE POINTER
+       DCA THIS
+       ISZ TABIND      /SET TAB INDICATOR
+       CDF 10
+       TAD I THIS      /GET LINK TO BUFFER
+       CDF 0
+       DCA XSAV
+       CMA
+       TAD ARG0
+       DCA THSN        /SET LINE POINTER
+AONE,  TAD BUFR        /BEGIN LINE
+       DCA AXIN
+       DCA XCTIN
+MOR,   JMS I BUFRDI    /GET A CHARACTER
+       JMS I   SORTJ   /IS IT SPECIAL? (SEE LIST)
+       LIST5-1
+       INLIST-LIST5    /YES - GO TO ITS HANDLER
+       JMS PACBUF      /NO - PACK IT
+       JMP MOR         /FETCH ANOTHER
+\f
+/CHARACTER PACKING ROUTINE
+/CONVERTS CHARACTER IN CHAR TO INTERNAL CODE
+/AND CALLS PCK1 TO PACK IT INTO BUFFER
+/ENTER AND EXIT WITH AC CLEAR
+
+PACBUF,        0
+       CLL
+       TAD AXIN        /DON'T ADD CHARACTERS
+       TAD K1210       /IF AXIN ABOVE 6570
+       SZL CLA         /IS THERE ROOM FOR THIS ONE?
+       ERROR           /NO
+       TAD CHAR        /YES
+       TAD M240
+       SPA             /IS IT 200-237?
+       JMP ESCA        /YES - ATTACH 77
+       TAD M77
+       SMA SZA         /IS IT 337 OR LESS?
+       JMP ESCA        /NO - ATTACH 77
+       TAD P40         /YES - IS IT 277?
+       SNA CLA
+       JMP ESCA        /YES - ATTACH 77
+TR1,   TAD CHAR        /240-337 EXCEPT 277
+       AND C77         /MASK OUT LEFT 6 BITS
+       JMS PCK1        /PACK IT
+       JMP I PACBUF    /--RETURN--
+ESCA,  CLA             /200-237, 277,340-377
+       TAD C77         /PACK A 77
+       JMS PCK1
+       JMP TR1         /PACK THE CHARACTER
+\f
+/PACK CHARACTERS INTO TEXT BUFFER
+/ENTER WITH 6-BIT CODE IN AC
+
+PCK1,  0
+       ISZ XCTIN       /LEFT HALF OR RIGHT HALF?
+       JMP ROT         /LEFT HALF
+       DCA UTRA        /RIGHT HALF - STORE CHARACTER
+       TAD UTRA        /GET CHARACTER
+       TAD ADD         /GET PREVIOUS CHARACTER
+       CDF 10
+       DCA I AXIN      /STORE IN FIELD 1 BUFFER
+       CDF 0
+       DCA ADD
+       JMP I PCK1      /--RETURN--
+ROT,   CLL RTL         /LEFT HALF
+       RTL
+       RTL             /ROTATE 6 LEFT
+       DCA ADD         /RETAIN UNTIL NEXT CHARACTER
+       CMA             /IS READY
+       DCA XCTIN       /RESET L OR R SWITCH
+       JMP I PCK1      /--RETURN--
+
+       UTEST=PACBUF    /TEMPORARY
+\f
+/CHARACTER UNPACKING ROUTINE
+/CONVERTS ONE CHARACTER FROM
+/BUFFER FORMAT TO 8-BIT ASCII
+/EXIT WITH CHARACTER IN AC
+
+UTRA,  0
+       CLA CMA         /INITIALIZE TO -1
+       DCA UTEST
+EXTR,  ISZ XCT         /LEFT HALF OR RIGHT HALF?
+       JMP GET3        /RIGHT HALF
+       CDF 10          /LEFT HALF
+       TAD I AXOUT     /GET BUFFER WORD
+       CDF 0
+       DCA GTEM
+       TAD GTEM
+       RTR             /ROTATE 6 RIGHT
+       RTR
+       RTR
+       JMP GET4        /SKIP TO GETA
+GET3,  CLA CMA         /RESET L - R SWITCH
+       DCA XCT
+       TAD GTEM
+GET4,  AND C77         /MASK OUT LEFT 6 BITS
+       TAD M77
+       CLL
+       SNA             /WAS IT 77?
+       ISZ UTEST       /YES - WAS IT LEFT HALF?
+       JMP GET5        /NO - CONTINUE
+       JMP EXTR        /YES - GET OTHER HALF
+GET5,  TAD P37
+       ISZ UTEST       /RESTORE THE CHARACTER
+       CML
+       SNL
+       TAD C100
+       TAD C240
+       TAD X203        /IS IT A ^C?
+       SNA
+       JMP UTRA+1      /YES - IGNORE IT
+       TAD M27         /NO - IS IT A ^Z?
+       SNA
+       JMP UTRA+1      /YES - IGNORE IT
+       TAD P232        /NO - RESTORE CHARACTER
+       JMP I UTRA      /--RETURN--
+\f
+/-------------------------------------------------------------
+/INPUT LIST FOR SPECIAL CHARACTERS IN TEXT MODE
+INLIST=.
+       SPACES          /SPCS
+       CTRLU           /^U
+       FULL            /FORM
+       FULL            /BELL
+       RUB4+1          /LINE FEED
+       RUB1            /RUBOUT
+       EOL             /CARRIAGE RETURN
+
+/HANDLER FOR FORM FEED OR ^G
+FULL,  TAD IGNORE      /
+       TAD MCHIN1      /
+       SNA CLA         /IN APPEND MODE?
+       JMP I TE1       /YES*RETURN TO COMMAND MODE*
+       TAD LSTN        /NO - IS BUFFER EMPTY?
+       SNA CLA         /
+/--------------------------------------------------------------
+       JMP I MORI      /YES - IGNORE FORM FEED
+       JMP I TE1       /NO*RETURN TO COMMAND MODE*
+
+MORI,  MOR
+
+
+/SET UP TO READ FROM INPUT DEVICE
+/USED BY C AND R COMMANDS
+/CALLED WITH SEQUENCE
+/      JMS I PSETUP
+/      INPUT ROUTINE
+/      CONTINUATION OF HANDLER
+/EXITS TO CONTINUATION OF HANDLER
+
+SETUP, 0
+       TAD I SETUP     /GET READ AREA FROM ARGS
+       DCA BUFRDI
+       TAD I SETUP     /LOCATION FOR IGNORED CHARACTERS
+       IAC CLL         /V12
+       DCA IGNORE
+       ISZ SETUP       /SETUP PROPER RETURN POINT
+       TAD I SETUP
+       DCA SETUP
+       TAD BUFR
+       TAD K1320
+       SZL CLA         /IS BUFFER FULL?
+       ERROR           /YES - DON'T READ
+       JMP I SETUP     /--RETURN--
+       0               /*** A FREE LOCATION!!!***
+
+\f
+/SUPERVISOR FOR DELETION OF TEXT LINES
+
+DELP,  0
+       JMS I CHKARG    /CHECK ARGUMENT VALIDITY
+       TAD ARG0
+       DCA THSN        /SET CURRENT LINE #
+       TAD ARG1        /SAVE # DELETED
+       DCA LISTER
+       TAD ARG0        /GET POINTER TO LINE
+       JMS I FIN1      /TO BE DELETED
+       DCA THIS        /STORE IT
+DELP1, CDF 10
+       TAD I THIS
+       DCA MARK        /CORE ADDRESS OF OBJECT LINE
+       TAD I MARK
+       DCA I THIS      /CHAIN NEW POINTERS TO DELETE LINE
+       TAD MARK
+       CDF 0
+       JMS I GRBAGE    /PHYSICALLY DELETE THE LINE
+       ISZ ARG1        /ALL SPECIFIED LINES DELETED?
+       JMP DELP1       /NO - CONTINUE
+       TAD LSTN        /IF 1,/D..MAKE CURRENT=0
+       SNA CLA
+       DCA THSN
+       TAD LISTER      /BUMP TOTAL DOWN
+       TAD LSTN
+       DCA LSTN
+       JMP I DELP      /YES--RETURN--
+
+
+/HANDLER FOR <
+EXLAS, CLA CLL CMA RAL /PRINT LAST LINE - AC=7776=-2
+/HANDLER FOR > OR LINE FEED
+EXNEX, TAD THSN        /PRINT NEXT LINE
+       IAC
+       SNA             /IS IT AN EXISTING LINE?
+       ERROR           /NO
+       DCA ARG0        /YES SAVE EFFECTIVE ARGUMENTS
+       CMA
+       DCA ARG1
+/HANDLER FOR L COMMAND
+LIST,  TAD LOW         /SET KEYBOARD AS OUTPUT
+       DCA OUTDEV
+       ISZ TABIND      /SET TAB INDICATOR
+       JMS LISTER      /OUTPUT LINE(S)
+       JMP I TE1       /*RETURN TO COMMAND MODE*
+\f
+/LISTING OUTPUT ROUTINE
+/OUTPUTS LINES INDICATED BY ARG0,ARG1
+
+LISTER,        0
+       TAD ARG0
+       SZA CLA         /ANY ARGUMENTS?
+       JMP L0          /YES - SET THEM UP
+       TAD LSTCHK      /ALLOW 0L?
+       SZA CLA
+       ERROR           /NOPE
+       TAD LSTN        /NO - SET TO LIST BUFFER
+       CIA
+       DCA ARG1
+       ISZ ARG0        /SET TO LINE 1
+L0,    TAD ARG0
+       CIA
+       TAD LSTN
+       SPA CLA         /ARGUMENTS IN RIGHT RANGE?
+L1,    ERROR           /NO -( OR JMP I TE1)
+       TAD ARG0
+       JMS I FIN1      /GET POINTERS
+       DCA THIS        /SAVE POINTER
+       CMA
+       CDF 10
+       TAD I THIS      /GET START
+       DCA AXOUT
+       TAD I AXOUT     /SAVE POINTER FOR SEARCH
+       DCA XSAV
+       TAD AXOUT       /SAVE OBJECT LINE FOR GARBAGE COLLECT
+       DCA MARK
+       CDF 0
+       CMA
+       DCA XCT
+       TAD ARG0        /SET POINTER
+       DCA THSN
+       ISZ ARG0        /SET FOR NEXT LINE
+/(HANDLER FOR FORM FEED DURING CHARACTER SEARCH)
+L2,    JMS I UTR1      /UNPACK A  CHARACTER
+       JMS I OUT1      /PRINT A CHARACTER
+       JMS I CPTSTI    /WAS IT ^O OR ^C FROM KEYBOARD?
+       JMP L3          /NO - CONTINUE
+       TAD C317        /YES - ^O
+       JMS I UPAROI    /GENERATE ^O
+       JMP I TE1       /*RETURN TO COMMAND MODE*
+L3,    TAD CHAR        /OR (JMP SLOOK)
+       TAD MCR
+       SZA CLA         /WAS IT END OF LINE?
+       JMP L2          /NO - KEEP UNPACKING
+       ISZ ARG1        /YES - DONE YET?
+       JMP L0          /NO - GET NEXT LINE
+       JMP I LISTER    /YES --RETURN--
+
+CPTSTI,        CTRLP           /TEST FOR ^O AND ^C
+C317,  317
+\f
+/------------------------------------------------------------
+/SEARCH ROUTINES
+
+
+/HANDLER FOR CARRIAGE RETURN
+SRETN, JMS I ENDLNI    /TERMINATE THIS LINE
+       TAD MARK        /AND NOW GARBAGE COLLECT
+       JMS I GRBAGE
+       ISZ ARG1        /DONE YET?
+       JMP I LIS1      /NO - GET NEXT LINE
+       JMP I TE1       /YES*RETURN TO COMMAND MODE*
+
+SLOOK, JMS I SORTJ     /SEARCH DONE?
+       LIST3-1         /(CARRIAGE RETURN OR SEARCH CHARACTER)
+       LISTGO-LIST3    /YES - GO TO ITS HANDLER
+       JMS I PACK1     /NO-PACK SEARCHED CHARACTERS
+       JMP I L2I       /CONTINUE SEARCH
+
+       IFNZRO SLOOK&1000 <PGERR,XXX>
+
+/HANDLER FOR ^G DURING CHARACTER SEARCH
+/CHANGE SEARCH CHARACTER
+SCONT, JMS I KEYBD     /FETCH NEW SEARCH CHARACTER
+       DCA LIST3+1     /STORE IT IN LIST
+       JMP I L2I       /CONTINUE SEARCH
+
+/HANDLER FOR LINE FEED DURING SEARCH
+SLINE, TAD CCR
+       DCA CHAR
+       JMS I ENDLNI
+       ISZ ARG0        /MOVE POINT
+       ISZ THSN        /BUMP CURRENT LINE COUNT
+       ISZ LSTN        /ADD A LINE.
+/HANDLER FOR _ DURING SEARCH
+SBAR,  TAD CCR         /CTRL-U
+       JMS I OUT1      /OUTPUT CARRIAGE RETURN
+       TAD BUFR        /RESTART PACK BUFFER
+       DCA AXIN
+       DCA XCTIN
+/-------------------------------------------------------------------
+SFOUND,        JMS I CHI1      /GET A CHARACTER
+       JMS I SORTJ     /SPECIAL SEARCH COMMAND?
+       LIST6-1
+       SRNLST-LIST6    /YES - GO TO HANDLER
+/HANDLER FOR SEARCH CHARACTER FOUND
+SGOT,  JMS I PACK1     /NO-PACK INSERTS
+       JMP SFOUND      /CONTINUE INPUT
+
+
+\f
+/TELETYPE CHARACTER FETCH ROUTINE
+/ENTER WITH AC CLEAR
+/EXIT WITH CHARACTER IN CHAR AND AC
+/FORCE CHANNEL 8
+/BLANK TAPE & LEADER TRAILER IGNORED
+
+CHIN,  0
+       DCA CHAR        /CLEAR CHARACTER
+       JMS I KEYBD
+       AND P177        /MASK PARITY
+       SNA             /IGNORE BLANK AND L/T
+       JMP CHIN+1
+       TAD C200        /RESTORE CHARACTER
+       JMS I OUT1      /ECHO INPUT
+       TAD CHAR
+       JMP I CHIN      /--RETURN--
+
+
+/SEARCH TEXT BUFFER FOR LINE
+/WHOSE NUMBER IS ONE LESS THAN
+/THE CONTENTS OF THE AC
+/EXIT WITH ADDRESS OF LINK CELL IN AC
+
+FIND,  0               /LOCATE LINE BUFFER
+       CIA
+       SMA             /IS LINE NUMBER TOO SMALL?
+       ERROR           /YES
+       DCA TEMP        /NO - STORE NEGATIVE OF LINE #
+       TAD TEMP
+       IAC
+       TAD LSTN
+       SPA CLA         /IS LINE NUMBER TOO LARGE?
+       ERROR           /YES
+       TAD CFRS        /NO
+       JMP FIND1
+FIND2, CDF 10
+       TAD I SAVE      /CHAIN THROUGH LIST
+       CDF 0
+       SZA             /FAILSAFE
+FIND1, DCA SAVE
+       ISZ TEMP        /DONE YET?
+       JMP FIND2       /NO - KEEP CHAINING
+       TAD SAVE        /YES - GET LINE NUMBER
+       JMP I FIND      /--RETURN--
+
+
+CON,   6030    /CONVERSION CONSTANTS
+       7634
+       7766
+       7777
+\f
+BOX=COUNTP
+VAL=ARG0
+
+/HANDLER FOR : OR =
+/PRINTS REQUESTED LINE NUMBER
+/WHICH IS FOUND IN ARG2 ON ENTRY
+
+PRNT,  TAD ARG2
+       DCA VAL         /SET NUMBER TO BE PRINTED
+       TAD M4
+       DCA CNT         /SET CHARACTER COUNT
+       TAD ADDR
+       DCA XYZ+2
+FLOOZ, DCA BOX
+       CLL
+       TAD VAL         /IF VAL IS TOO LARGE, IT LOOKS
+       SMA CLA         /LIKE A NEG NO. THE LINK
+       TAD K50         /DETERMINES THE END POINT IN THAT CASE
+       TAD K7430       /7430=SZL; 7500=SMA
+       DCA XYZ+3
+       JMP .+4
+       ISZ BOX
+       CLL
+XYZ,   DCA VAL
+       TAD VAL
+       NOP             /TAD CON +() SOME DISPLACEMENT
+       SMA             /OR, IF VAL TOO BIG,SZL
+       JMP XYZ-2       /KEEP ADDING THE SAME CONSTANT
+       CLA
+       TAD BOX         /BOX HAS THE NUMBER COUNT
+       TAD C260        /MAKE ASCII DIGIT
+       JMS I OUTL1     /OUTPUT THE DIGIT
+       ISZ XYZ+2       /ADD IN NEXT CONVERSION CONSTANT LATER
+       ISZ CNT         /DONE ALL FOUR?
+       JMP FLOOZ       /NO - KEEP CONVERTING
+       JMP I TE1       /YES*RETURN TO COMMAND MODE*
+
+C260,  260
+ADDR,  TAD CON
+K50,   50
+K7430, 7430
+\f
+/CHARACTER OUTPUT ROUTINE
+
+OUT,   0
+       DCA CHAR
+/ESC PATCH 25-MAY-77 DS
+/      TAD ECHOSW
+/      SNA CLA         /ECHO SUPPRESSED?
+       JMS I .+1       /DS
+       ESCPA           /DS
+       JMP I OUT       /YES--RETURN--
+       JMS I SORTJ     /NO - IS IT A FORMAT CHARACTER?
+       LIST4-1         /YES - EXIT TO ITS HANDLER
+       OUTLIS-LIST4
+       ISZ TCNT        /NO - COUNT ONE LETTER
+       TAD CHAR
+OUTX,  JMS I OUTDEV    /OUTPUT THE CHARACTER
+       JMP I OUT       /--RETURN--
+
+
+/CARRIAGE RETURN HANDLER
+
+OUTCRL,        TAD CCR
+       JMS I OUTDEV    /OUTPUT CARRIAGE RETURN
+       DCA TCNT        /CLEAR TAB COUNTER
+       TAD CLF         /OUTPUT LINE FEED
+       JMP OUTX
+
+
+/TAB HANDLER - TAB/RUBOUT
+
+OUTRT, TAD CTAB
+       JMS I OUTDEV    /OUTPUT TAB
+       CIF 10
+       JMS I POTYPE    /TEST TYPE OF OUTPUT
+       SPA CLA         /IS IT DIRECTORY DEVICE?
+       JMP I OUT       /YES--RETURN--
+       TAD CRO         /NO - OUTPUT RUBOUT
+       JMP OUTX
+
+
+/TAB HANDLER - SPACES
+
+OUTTAB,        TAD TABIND
+       SNA CLA         /OUTPUT TAB/RUBOUT INSTEAD?
+       JMP OUTRT       /YES - GO TO OTHER TAB HANDLER
+       TAD TCNT        /NO -
+       TAD MTABS       /REDUCE SPACE COUNT TO 8 OR LESS
+       SMA
+       JMP .-2
+       DCA TCNT
+       TAD C240        /OUTPUT SPACES
+       JMS I OUTDEV
+       ISZ TCNT        /DONE YET?
+       JMP .-3         /NO - CONTINUE
+       JMP I OUT       /YES--RETURN--
+
+\f
+/-----------------------------------------------------------------------
+/I-O SUBROUTINES
+
+
+/HANDLER FOR S COMMAND
+
+XCRET, JMS I KEYBD     /GET THE SEARCH CHARACTER
+       DCA LIST3+1     /SAVE IT IN LIST
+       TAD SXS2
+       DCA I L3I       /MAKE LISTER JUMP TO SLOOK
+       TAD BUFR
+       DCA AXIN        /BUILD NEW TEXT IMAGE HERE
+       DCA XCTIN
+       TAD CHI1        /READ POINT IS CHIN
+       IAC
+       DCA IGNORE
+       JMP I LIS1
+
+/LIST OF SPECIAL CHARACTERS FOR G COMMAND
+TAGLIST=.
+       GTAG2   /SPACE
+       GTAG2   //
+       GTAG2   /ESC
+       GTAG2   /TAB
+       GTAG2   /CARRIAGE RETURN
+
+/-----------------------------------------------------------------------
+
+
+/LOW SPEED OUTPUT ROUTINE
+/ENTER WITH CHARACTER IN AC
+
+OUTL,  0
+       TLS
+       TSF
+       JMP .-1
+       CLA
+       JMP I OUTL      /--RETURN--
+
+/LOW SPEED INPUT ROUTINE
+/CHECKS FOR ^C
+/EXIT WITH CHARACTER IN AC
+
+I33,   0
+       KSF
+       JMP .-1
+       JMS CTCK
+       KRB
+       AND P177
+       TAD C200
+       JMP I I33       /NO--RETURN--
+\f
+/SET UP APPEND, CHANGE, INSERT TO WORK
+/EACH READS KEYBOARD, NOT DEVICE
+
+CNGEL, CNGE1-XNS1
+XNSL,  XNS1-APP1
+
+/HANDLER FOR C COMMAND
+CNGE,  TAD CNGEL
+
+/HANDLER FOR I COMMAND
+XNS,   TAD XNSL
+
+/HANDLER FOR A COMMAND
+APP,   TAD APPL
+       DCA DEST        /RETURN POINT
+       ISZ ECHOSW
+       JMS I PSETUP
+       CHIN            /KEYBOARD INPUT
+DEST,  APP1
+
+
+/SPECIAL OUTPUT LIST
+OUTLIS=.
+       ESCOUT  /233 - ESC - V12
+       OUTTAB  /211 - TAB
+       OUTCRL  /215 - CARRIAGE RETURN
+       OUTX+1  /212 - LINE FEED
+       OUTX+1  /214 - FORM FEED
+       OUTX+1  /377 - RUBOUT
+       CTRLN   /216 - CNTRL N
+
+\f/CHECK TTY FOR ^C OR ^O INPUT
+/EXIT TO MONITOR ON ^C
+/SKIP ON ^O
+
+CTRLP, 0
+       KSF
+       JMP I CTRLP     /--RETURN--
+       JMS CTCK
+       TAD M14         /NO - IS IT ^O?
+       SZA CLA
+       JMP I CTRLP     /NO--RETURN--
+       ISZ CTRLP       /YES
+       KCC
+       JMP I CTRLP     /--RETURN--
+
+M14,   -14
+CTCK,  0
+       TAD C200
+       KRS
+       TAD X203
+       SNA
+       JMP I MONITOR
+       JMP I CTCK
+
+
+
+/HANDLER FOR P COMMAND
+
+PUNCH, ISZ ECHOSW
+       TAD BUFWTI      /SETUP TO WRITE INTO OUTPUT BUFFER
+       DCA OUTDEV
+PUNC,  JMS I LIS       /WRITE THE EDITOR BUFFER
+       TAD C214        /OUTPUT FORM FEED
+       JMS I OUTDEV
+/HANDLER FOR T COMMAND
+PUNCT, CDF 10
+       TAD I K7600
+       CDF 0
+       SNA CLA         /IS THERE AN OUTPUT DEVICE?
+       JMP I TE1       /NO*RETURN TO COMMAND MODE*
+       TAD BUFWTI      /YES - SET UP TO WRITE INTO
+       DCA OUTDEV      /OUTPUT BUFFER
+       TAD M40
+       DCA CTRLP       /SET TRAILER COUNTER
+       CIF 10
+       JMS I POTYPE    /
+       SMA CLA         /DIRECTORY DEVICE FOR OUTPUT?
+       JMS I OUTDEV    /NO - OUTPUT LEADER TRAILER
+       ISZ CTRLP       /DONE YET?
+       JMP .-5         /NO - CONTINUE
+       TSF             /YES - RESET FLAG
+       JMP .-1
+       JMP I TE1       /*RETURN TO COMMAND MODE*
+\f/HANDLER FOR R COMMAND
+
+TELE=.
+TELEN, TSF
+       JMP .-1
+       DCA ECHOSW      /INHIBIT ECHO
+       JMS I PSETUP    /SETUP TO READ FROM
+       BUFRD           /INPUT DEVICE
+APPL,  APP1            /APPEND TEXT TO BUFFER
+
+/HANDLER FOR Y COMMAND
+
+YANK,  TAD COM1        /YANK KILLS 'P' PART OF N
+       JMP COMBOA
+
+/HANDLER FOR N COMMAND
+
+COMBO, TAD JMPCH       /YANK WIPES COM1-1
+COMBOA,        DCA I CCON+1
+       TAD ARG0
+       SNA             /ANY ARGUMENTS
+       IAC             /NO - ASSUME 1
+       CIA
+       DCA COUNTP      /SET NUMBER OF PAGES TO YANK
+       TAD CCON        /(JMP I AXCOMB)
+       DCA I TE1       /SET TE1 TO ALLOW LOOPING
+COMB,  TAD CCON+1      /THROUGH PUNCH, KILL, READ
+       DCA AXCOMB      /CYCLE
+       DCA ARG0        /CLEAR ARGUMENTS
+       DCA ARG2
+       DCA LSTCHK      /DON'T INHIBIT LISTER!
+       DCA TABIND      /CLEAR IN CASE OF MULTIPLE N
+       JMP PUNC        /OUTPUT BUFFER
+COM1,  JMP I KILL1     /KILL BUFFER
+       JMP TELEN       /READ NEW BUFFER FULL
+       ISZ COUNTP      /DONE YET?
+       JMP COMB        /NO - CONTINUE
+       CLA CLL CML RAL /YES-AC=1 - RESET CURRENT LINE NUMBER
+       DCA THSN        /.=1 ON RETURN
+COM5,  TAD CZ          /RESTORE TE1
+       DCA I TE1
+       JMP I TE1       /*RETURN TO COMMAND MODE*
+/IT IS VITAL TO KEEP DUMB1 AND COM5 ON THE SAME PAGE
+DUMB1, JERK1
+PSETUP,        SETUP           /V3
+\f
+/-----------------------------------------------------------------------
+
+LIST1=.
+       212             /LINE FEED
+       240             /SPACE
+       253             /PLUS (+)
+       254             /COMMA (,)
+       255             /MINUS (-)
+       256             /PERIOD (.)
+       257             /SLASH (/)
+       274             /<
+       275             /=
+       276             />
+       000             /(DUMMY ENTRY)
+       375             /ALTMODE ASR-33
+       376             /ALTMODE ASR-35
+       233             /ESCAPE KEY
+       242             /DOUBLE QUOTE (")
+       244             /DOLLAR SIGN ($)
+       377             /RUBOUT
+       272             /COLON (:)
+LIST1A,        215             /CARRIAGE RETURN
+       225             /^U
+       203             /^C
+
+
+/HANDLER FOR G COMMAND
+
+GETTAG,        ISZ THSN
+       TAD ARG0
+       SNA             /ANY ARGUMENTS
+       TAD THSN        /NO - BEGIN WITH NEXT LINE (.+1)
+       DCA ARG0        /YES - SET ARGUMENTS
+       SKP
+GTAG2, ISZ ARG0
+       IAC
+       TAD ARG0
+       JMS I FIN1      /GET NEXT LINE
+       DCA AXOUT
+       CMA
+       DCA XCT
+       JMS I UTR1      /UNPACK FIRST CHARACTER
+       JMS I SORTJ     /DOES IT BEGIN A TAG?
+       LIST7-1         /NO - TAGLIST EXITS
+       TAGLIST-LIST7   /TO GTAG2
+       JMP I LIS1      /YES - PRINT LINE
+\f
+MP1=ARG1
+MP2=ARG0
+MP3=ARG2
+
+/HANDLER FOR M COMMAND
+/ENTER WITH FIRST LINE TO MOVE IN MOV1
+/LAST LINE TO MOVE IN MOV2
+/MOV2 .GT. MOV1
+/DESTINATION LINE IN ARG2
+
+
+MOVEM, TAD MOV1
+       CIA             /ARG2 MAY NOT BE BETWEEN
+       TAD ARG2        /MOV1 AND MOV2
+       SPA CLA         /IS MOV1 .GT. ARG2?
+/-----------------------------------------------------------------------
+       JMP .+6         /YES - O.K.
+       TAD MOV2
+       CMA
+       TAD ARG2
+       SPA SNA CLA     /IS MOV2 .LT. ARG2?
+       ERROR           /NO-FAULTY LOGIC IN COMMAND
+       TAD MOV1        /YES
+       JMS I FIN1
+       DCA MP1         /STORE FIRST LINE POINTER
+       IAC
+       TAD MOV2
+       JMS I FIN1
+       DCA MP2         /STORE LAST LINE POINTER
+       TAD ARG2
+       JMS I FIN1
+       DCA MP3         /STORE DESTINATION LINE POINTER
+       CDF 10          /ALL FOUND
+       TAD I MP1       /SWAP POINTERS-
+       DCA TEMP        /RESET THE LINK COORDS
+       TAD I MP2
+       DCA I MP1
+       TAD I MP3
+       DCA I MP2
+       TAD TEMP
+       DCA I MP3
+       CDF 0
+       JMP I TE1       /*RETURN TO COMMAND MODE*
+
+SRNLST=.
+       SBAR            /BACK ARROW (_)
+       L2              /FORM FEED
+       SCONT           /BELL
+       SLINE           /LINE FEED
+       RUB1            /RUB OUT
+
+LISTGO=.
+       SRETN           /CARRIAGE RETURN
+       SGOT            /SEARCH CHARACTER FOUND
+\f
+/HANDLER FOR RUBOUT IN TEXT OR SEARCH
+RUB1,  TAD AXIN
+       CIA
+       TAD BUFR
+       TAD XCTIN
+       SZA CLA         /IS THERE ANYTHING ON THIS LINE?
+       TAD ECHOSW      /OR ECHO INHIBITED?
+       SNA CLA
+       JMP I IGNORE    /YES-IGNORE RUBOUT
+/SCOPE PATCH 25-MAY-77 DS
+/      TAD SPLAT       /NO-
+/      JMS I OUT1      /OUTPUT BACKSLASH
+       JMS I .+1       /DS
+       RUBPA           /DS
+/DELETE CHAR FROM BUFFER
+       TAD AXIN        /GET LAST WORD OF INPUT
+       DCA MOV1
+       CDF 10
+       DCA I BUFR      /PREVENTS INFINITE RUBOUTS
+       TAD I MOV1
+       ISZ XCTIN       /WHICH HALF OF WORD?
+       JMP RUB2
+       AND C77
+       TAD M77
+       SZA CLA         /TEST EXTENSION
+       JMP RUB4
+RUB3,  CMA
+       DCA XCTIN
+       CMA
+       TAD AXIN
+       DCA AXIN
+       TAD I MOV1
+       AND P7700
+RUB4,  DCA ADD
+       CDF 0
+       JMP I IGNORE    /CHIN+1
+RUB2,  AND P7700
+       TAD C100
+       SZA CLA
+       JMP RUB3
+       DCA I MOV1
+       JMP RUB3+1
+\f
+/HANDLER FOR SPACE IN TEXT MODE
+SPACES,        TAD ECHOSW
+       CLA             /OR SZA CLA IF B OPTION
+       JMP I SPCNO     /PACK IT - (MOR+4)
+       CMA             /SET COUNTER 
+SP2,   DCA CNT
+       JMS I BUFRDI    /GET LAST CHARACTER
+       TAD M240
+       SNA CLA         /WAS IT SPACE?
+       JMP SP2         /YES-IGNORE EXTRA SPACES
+/-----------------------------------------------------------------------
+       TAD CHAR        /NO
+       DCA SAVE        /SAVE NON-SPACE
+       ISZ CNT         /WAS THERE MORE THAN 1 SPACE?
+       TAD M27         /YES- STORE TAB
+       TAD C240        /NO-STORE SPACES
+       DCA CHAR
+       JMS I PACK1
+       TAD SAVE
+       JMP I SPCGO     /SORT - (MOR+1)
+
+/HANDLER FOR $ (PART OF M COMMAND)
+
+MOVE,  TAD ARG0        /ARG2 .GE. ARG0
+       CIA
+       TAD ARG2
+       SPA CLA         /ARE LINES TO BE MOVED LEGITIMATE
+       ERROR           /NO
+       TAD ARG0        /YES-
+       DCA MOV1        /SET POINTER TO FIRST LINE
+       TAD ARG2
+       DCA MOV2        /SET POINTER TO LAST LINE
+       JMP I ONUM      /CONTINUE COMMAND INPUT
+\f
+OPS1,  EXNEX           /LINE FEED
+       GEXP            /SPACE
+       GEXP            /PLUS
+       FIRS            /COMMA
+       GMIN            /MINUS
+       PERI            /POINT(.)
+       SLAS            /SLASH
+       EXLAS           /BACKUP(<)
+       PRNT            /=
+       EXNEX           /ALT(>)
+       DBCV2           /DUMMY
+       AMODE           /ALTMODE ASR-33
+       AMODE           /ALTMODE ASR-35
+       AMODE           /ESCAPE KEY
+       DBLQUO          /"
+       MOVE            /DOLLAR SIGN
+       ELIM            /COMMAND RUBOUT
+       PRNT            /:
+       GTOP-2          /CARRIAGE RETURN
+       START           /^U
+       MONIT           /^C (MONITOR RESTART)
+OPS1A, RETRN           /RETURN
+/-----------------------------------------------------------------------
+OLDTE1,        START           /^U
+       MONIT           /^C
+\f
+/HANDLER FOR E COMMAND
+
+ENDFIL,        TAD EKILLL      /IS E COMMAND ALLOWED?
+       SZA CLA
+       ERROR           /NO-NO INPUT SPECIFIED
+       CLA CMA         /YES-RESET ARGUMENTS
+       DCA ARG0
+       TAD JMPTE1      /SKIP LISTER IF EMPTY BUFFER
+       DCA I L1I
+       TAD FLCLSI      /CLOSE FILE SETUP
+       DCA ELIM        /CLOSES FILE ON READ FAILURE
+       JMP I COMBOP
+
+COMBOP,        COMBO
+FLCLSI,        JMP I CLFLI
+AONEI, AONE
+
+/HANDLER FOR ^U IN TEXT MODE
+CTRLU, JMS CTRLU1      /GENERATE A ^U
+       JMP I AONEI     /AND CONTINUE
+
+/PRINT ^U
+CTRLU1,        0
+       TAD C325
+       JMS I UPAROI    /PRINT ^U
+       TAD CCR         /AND A CR/LF
+       JMS I OUT1
+       JMP I CTRLU1    /--RETURN--
+C325,  325
+
+/CHECK VALIDITY OF ARGUMENTS
+/FOR D COMMAND
+CHKARX,        0 
+       TAD ARG0
+       CIA
+       IAC
+       TAD ARG1
+       TAD LSTN
+       SPA CLA         /DO LINES EXIST?
+       ERROR           /NO
+       JMP I CHKARX    /YES--RETURN--
+\f
+/HANDLER FOR .
+PERI,  TAD THSN
+       SKP
+/HANDLER FOR /
+SLAS,  TAD LSTN
+       DCA TEMP        /SAVE LINE NUMBER
+       DCA CHAR
+       ISZ LSTCHK      /GOT EITHE . OR / IN ARGS
+       JMP I .+1       /FETCH REST OF ARGUMENT
+       GLOM
+
+/END OF A NEW TEXT LINE
+/PACK CARRIAGE RETURN INTO BUFFER
+/SET LINK CELLS AROUND NEW LINE
+/ENTER WITH:
+/      CHAR CONTAINS CARRIAGE RETURN
+/      THIS CONTAINS ADDRESS OF LINK
+/      CELL OF PRECEDING TEXT LINE
+/      XSAV CONTAINS ADDRESS OF LINK
+/      CELL OF FOLLOWING TEXT LINE
+/      BUFR CONTAINS ADDRESS OF LINK
+/      CELL OF NEW TEXT LINE
+
+ENDLN, 0
+       JMS I PACK1     /PACK CARRIAGE RETURN
+       CDF 10
+       TAD ADD
+       SZA
+       DCA I AXIN
+       TAD BUFR        /RESET LINK CELL
+       DCA I THIS      /OF PREVIOUS LINE
+       TAD XSAV
+       DCA I BUFR      /RESET LINK CELL OF NEW LINE
+       TAD BUFR
+       DCA THIS        /RESET POINTER TO LINK CELL
+       ISZ AXIN
+       TAD AXIN
+       DCA BUFR        /RESET FOR NEXT LINE
+       DCA XCTIN       /CR CHARACTER SWITCH
+       CDF 0
+       JMP I ENDLN     /--RETURN--
+
+\f
+/HANDLER FOR ^C
+/AND OTHER EXITS TO MONITOR
+
+MONIT, JMS FXSTWD      /SET JOB STATUS TO SAVE CORE
+       TSF             /MAKE SURE TTY FLAG IS SET
+       JMP .-1
+       JMP I K7600     /****EXIT TO MONITOR****
+
+/CLEAR BIT 11 OF JOB STATUS WORD
+
+FXSTWD,        0
+       CIF 10
+       JMS I JSWSET    /IF NONZERO TEXT,SAVE BUFFER
+       JMP I FXSTWD    /--RETURN--
+SPCP1A,        SPACES+1
+BUFRD1,        BUFRD+1
+
+/RESET POINTERS AND SAVE BUFFERS
+
+RESET3,        JMS FXSTWD
+CIFTEN,        CIF 10          /CLEAR BIT 11 OF JSW
+       JMS I P7700     /CALL USER SERVICE ROUTINES
+       10              /*LOCK USR IN CORE*
+       TAD CIFTEN      /RESET POINTERS
+       DCA I BUFRD1
+       DCA EKILLL
+       TAD OLDTE1
+       DCA TE1
+       TAD CZ
+       DCA I TE1
+       TAD K7600
+       DCA ELIM
+       TAD K7600
+       DCA I SPCP1A
+       TAD LOW
+       DCA OUTDEV
+       ISZ ECHOSW
+       TAD JMPCH
+       DCA I CCON+1
+       ISZ FXSTWD      /WASTE TIME FOR TTY FLAG
+       JMP .-3
+       CIF CDF 10
+       JMP I .+1       /GO CALL COMMAND DECODER
+       START1
+JSWSET,        INSET
+
+\f
+/-----------------------------------------------------------------------
+/-----------------------------------------------------------------------
+
+/READ,WRITE,AND RELATED ROUTINES
+
+       OURECS=4        /SIZE OF OUTPUT BUFFER
+
+*2000
+
+/HANDLER FOR Q COMMAND
+
+Q,     JMS I FXSWDI    /CLEAR BIT 11 OF JSW
+       CDF 10
+       TAD I K7600
+       CDF 0
+       SNA CLA         /WAS AN OUTPUT DEVICE SPECIFIED?
+       ERROR           /NO-
+FLCLOS,        TAD LSTN
+       SNA CLA         /IS BUFFER EMPTY?
+       JMP FLCLS1      /YES-CLOSE FILE
+       TAD FLCLI       /NO-
+       DCA TE1         /SET UP RETURN FROM P COMMAND
+       JMP I .+1
+       PUNCH           /WRITE CURRENT BUFFER
+
+/CLOSE FILE ON E OR Q COMMAND
+
+FLCLS1,        JMS I   PTCH1   /GO TO PATCH TO HANDLE FILE FULL
+       CLA CMA         /TELL SYSTEM I/O MONITOR IS IN CORE
+       CDF 10
+       DCA I P7700
+       CDF 0
+       JMP I K7600     /****EXIT TO MONITOR***
+/
+PTCH1, PATCH1
+\f
+
+/INPUT ROUTINE FROM DEVICE
+/VIA INPUT DEVICE HANDLER
+BUFRD, 0
+       CIF 10
+       JMS I ICHARI    /FETCH A CHARACTER
+       JMP ERRD        /ERROR IN READING FROM BUFFER
+       DCA CHAR        /INTERFACE LOCATION
+       TAD CHAR
+       AND P177
+       SNA             /IS IT L/T?
+       JMP BUFRD+1     /YES-GET NEXT CHARACTER
+       TAD C200        /NO RESTORE CHARACTER
+       JMP I BUFRD     /--RETURN--
+
+ERRD,  SPA CLA         /FATAL OR EOF?
+       JMP I SERR0I    /FATAL-OUTPUT ERROR MESSAGE
+       TAD ERSW        /DISABLE FURTHER READS
+       DCA BUFRD+1
+       TAD I COMM5     /IF THIS IS NEGATIVE, DO ONE
+       SMA CLA         /MORE SEARCH (POSSIBLY) IN THE CASE
+       JMP BUFRD+1     /THAT NO FINAL FORM FEED EXISTS
+       CLA IAC         /SET CURRENT LINE TO 1 AND SEARCH
+       DCA THSN        /ONCE MORE
+       JMP I .+1
+       SFIND2
+
+ICHARI,        ICHAR           /CHARACTER ROUTINES
+FLCLI, FLCLS1
+
+\f
+/OUTPUT ROUTINE TO DEVICE
+/VIA OUTPUT DEVICE HANDLER
+
+BUFWT, 0
+       CIF 10
+       JMS I OCHARI    /OUTPUT A CHARACTER
+       JMP ERWT        /OUTPUT FAILED
+BUFRTN,        TAD BUFWTI      /RESET OUTPUT DEVICE HANDLER POINTER
+       DCA OUTDEV
+       JMP I BUFWT     /--RETURN--
+
+ERWT,  SPA CLA         /FATAL, OR NO MORE ROOM?
+       JMP I SERR1I    /FATAL-OUTPUT ERROR MESSAGE
+       JMS I FXSWDI    /FIX JOB STATUS WORD-NO MORE ROOM
+       TAD I TE1       /STORE POINTERS
+       DCA PTE1
+       TAD ELIM
+       DCA PELIM
+       TAD TE1
+       DCA PPTE1
+       CDF 10
+       ISZ I PANICI    /SET PANIC DUMP
+       TAD MORECS      /PREPARE TO CLOSE PRESENT OUT FILE
+       TAD I OCNTI     /THIS GIVES OPTIMUM CLOSE LENGTH
+       SPA
+       JMP     PATCH2
+       DCA I OCNTI
+       TAD I OREC      /WRITE A ^Z
+       DCA CLSREC      /DIRECTLY TO THE DEVICE
+       TAD I OHNDL     /HANDLER ENTRY POINT
+       DCA TEMPO
+       CDF 0
+       JMS I TEMPO     /CALL OUTPUT DEVICE HANDLER
+       4110            /THE BUFFER IS A PAGE OF THE EDITOR
+       7000            /WITH A 232 IN THE FIRST LOCATION
+CLSREC,        0               /RECORD NUMBER HERE
+       JMP I SERR1I    /**WRITE FAILURE** 1*
+       CDF CIF 10
+       JMS I OCLSI     /CLOSE THE FILE IN PANIC MODE
+       JMP I SERR2I    /**FILE CLOSE FAILED**2*
+       CIF 10
+       JMS I C200      /CALL USER SERVICE ROUTINES
+       11              /*DISMISS USR FROM CORE*
+PATCH2,        CLA
+       CDF 0
+       TAD POINT       /PRINT OUT"FULL" AND RETURN
+       DCA AXIN
+       TAD I AXIN      /FETCH CHARACTER
+       SNA             /DONE YET?
+       JMP I RST3I     /YES-RESET & CALL COMMAND DECODER
+       JMS I OUTL1     /NO - OUTPUT CHARACTER
+       JMP .-4         /GET NEXT CHARACTER
+\f
+FXSWDI,        FXSTWD
+OCNTI, OUCCNT
+PANICI,        PANIC
+OCHARI,        OCHAR
+MORECS,        -OURECS+1       /THIS ALLOWS US TO 'MANUALLY' WRITE
+                       /A FORM FEED AND A ^Z.
+
+POINT, FULLST-1
+OREC,  OUREC
+OHNDL, OUHNDL
+
+/RESET POINTERS STORED PREVIOUSLY
+BUFRET,        TAD PPTE1
+       DCA TE1
+       TAD PTE1
+       DCA I TE1
+       TAD PELIM
+       DCA ELIM
+       JMP BUFRTN
+
+PPTE1, 0
+PELIM, 0
+PTE1,  0
+OCLSI, OCLOSE          /V3 FILE CLOSE ROUTINE
+
+/-----------------------------------------------------------------------
+
+/ERROR MESSAGE-  FULL -
+FULLST,        306             /F
+       325             /U
+       314             /L
+       314             /L
+       215             /CARRIAGE RETURN
+       212             /LINE FEED
+       0               /DELIMITER
+\f
+SRCBUF,        ZBLOCK 24       /SEARCH BUFFER
+
+
+/SPECIAL CHARACTER LIST FOR STRING SEARCH
+SLST=.
+       247             /"
+       242             /'
+       377             /RUBOUT
+       203             /^C
+       225             /^U
+/-----------------------------------------------------------------------
+NEXBUF,        DUMB1&177+5600  /JMP I DUMB1    
+
+/DISPATCH LIST FOR STRING SEARCH
+
+OSLST, QUO1            /"
+       QUO2            /'
+       FORGET          /RUBOUT
+       MONIT           /^C
+       RLEAS           /^U IN STRING SEARCH
+\f
+
+/GENERATE ^ FOLLOWED BY THE CHARACTER
+/WHICH IS IN AC ON ENTRY
+
+UPAROW,        0
+       DCA TEMPO       /SAVE CHARACTER
+       TSF
+       JMP .-1
+       TAD C336
+       JMS I OUTL1     /PRINT ^
+       TAD TEMPO
+       JMS I OUTL1     /PRINT CHARACTER
+       JMP I UPAROW    /--RETURN--
+C336,  336
+
+
+/HANDLER FOR ^U DURING STRING SEARCH
+RLEAS, JMS I (CTRLU1
+       JMP I (START    /^U GETS US BACK TO #
+
+/HANDLER FOR ALTMODE
+
+AMODE, DCA STRIND      /NEED SETUP
+       JMS I STRFIN    /SEARCH FOR STRING
+       ERROR
+       TAD THSN        /RESULT IS LINE NUMBER
+       JMP I .+1       /LINK TO COMMAND STRUCTURE
+       GTOP+1
+
+
+/HANDLER FOR J COMMAND
+
+JERK,  DCA STRIND      /SETUP FOR SEARCH
+JERK1, JMS I STRFIN    /SEARCH FOR STRING
+       JMP GMOR        /GET NEXT BUFFER
+       TSF
+       JMP .-1         /JUST TO BE SURE
+       TAD CZ          /RESTORE MONITOR EXIT
+       DCA I TE1
+       JMP I TE1       /*POSSIBLE RETURN TO COMMAND MODE*
+\f
+/GET NEXT BUFFER FOR S SEARCH
+
+GMOR,  TAD I CNTRI
+       SNA CLA         /IS BUFFER EMPTY?
+       ERROR           /NO
+       ISZ STRIND      /YES-BYPASS SETUP
+       TAD NEXBUF
+       DCA I COMM5     /SET UP READ OF ONE BUFFER
+       IAC
+       DCA ARG0
+       TAD EKILLL
+       SZA CLA         /IS THERE AN OUTPUT DEVICE?
+       JMP I .+2       /NO
+       JMP I .+2       /YES
+       YANK            /NO OUTPUT
+       COMBO           /THERE IS OUTPUT
+
+
+/HANDLER FOR F COMMAND
+
+BARROW,        ISZ STRIND      /CONTINUES LOOKING FOR EXISTING STRING
+       ISZ THSN        /INCREMENT FOR NEXT LINE
+       JMP JERK1
+CNTRI, CNTR
+
+/HANDLER FOR "
+
+DBLQUO,        ISZ THSN        /USES STRING NOW IN BUFFER
+       ISZ STRIND      /NO SETUP REQUIRED
+       JMP AMODE+1
+
+/HANDLER FOR B COMMAND
+
+CORSPC,        CLL
+       TAD BUFR
+       TAD K1320
+       SZL CLA         /IS ANY CORE LEFT?
+       JMP ZROCOR      /NO
+       TAD BUFR        /YES-SET UP NUMBER OF LOCATIONS
+       CIA             /IN ARG2
+       TAD BUFEND
+       TAD K360
+ZROCOR,        DCA ARG2
+       JMP I .+1
+       PRNT
+K360,  360
+\f
+/HANDLER FOR K COMMAND
+
+KILL,  TAD ARG0        /IN CASE HE TYPED N,MK
+       SZA CLA         /INSTEAD OF N,ML. SAVE HIM!!
+       ERROR
+       TAD END         /RESET BUFFER POINTERS
+       DCA BUFR        /TO REFLECT EMPTY BUFFER
+       DCA LSTN
+       DCA THSN
+       CDF 10          /ZERO FIELD 1 POINTER
+       DCA I CFRS
+       CDF 0
+       JMP I TE1       /*RETURN TO COMMAND MODE*
+
+/ROUTINE TO REASSIGN INPUT HANDLER
+/AFTER A PANIC DUMP AND RESTART
+
+PIASGN,        CDF CIF 10
+       TAD I PINEOF
+       SZA CLA         /IS THERE A HANDLER TO RESTORE?
+       JMP I PIRETN    /NO - BACK TO FIELD 1
+       TAD I IHPAGE    /YES -
+       DCA PIHND       /GET HANDLER PAGE
+       TAD I IDVNO
+       CDF 0           /I/O MONITOR IS IN CORE AT THIS POINT
+       JMS I C200      /CALL USER SERVICE ROUTINES
+       1               /*FETCH HANDLER*
+PIHND, 0
+       JMP I SERR4I    /**DEVICE HANDLER ERROR**+**
+       TAD PIHND
+       CDF CIF 10
+       DCA I PIHNDL    /PUT NEW HANDLER ADDRESS BACK
+       JMP I PIRETN    /AND RETURN
+
+PIRETN,        PANOPN          /GO OPEN OUTPUT FILES
+PIHNDL,        INHNDL
+IHPAGE,        I1              /I1 CONTAINS "INDEVH+1"
+IDVNO, INDEV
+PINEOF,        INEOF
+
+/HANDLER FOR # COMMAND
+
+VERSN, TAD ("V         /V3
+       JMS I OUTL1     /V3 PRINT V
+       TAD (VERSION&70%10+260  /V3
+       JMS I OUTL1     /V3 PRINT VERSION #
+       TAD     (VERSION&7+260
+       JMS I   OUTL1   /V3C PRINT 2ND NUMBER OF VERSION #
+       TAD (PATCH      /V3
+       JMS I OUTL1     /V3 PRINT PATCH LEVEL
+       JMP I TE1       /V3 RESTART
+\f*2400
+/-----------------------------------------------------------------------
+/-----------------------------------------------------------------------
+/STRING SEARCH ROUTINE
+/CALLED BY $(ALTMODE) AND J COMMAND HANDLERS
+
+SFIND1,        0
+       ISZ ECHOSW
+       TAD STRIND      /IS SETUP NECESSARY
+       SZA CLA
+       JMP SFIND2      /NO.
+       TAD MSCNT
+       DCA BUFCNT      /SET COUNTER
+       TAD SBUF
+       DCA AXIN        /BEGIN SEARCH BUFFER
+       TAD ATSIGN
+       JMS I OUTL1     /OUTPUT $
+       ISZ TABIND
+RLOOP, JMS I CHI1      /FETCH CHARACTER FROM TTY
+       JMS I SORTJ     /IS IT SPECIAL FOR SEARCH STRING?
+       SLST-1          /YES-HANDLE IT
+       OSLST-SLST
+       ISZ BUFCNT      /NO-SEARCH BUFFER FULL?
+       JMP STORE       /NO-STORE THIS CHARACTER
+       CLA CMA
+       DCA BUFCNT      /YES-DON'T ALLOW ANY MORE
+       JMP RLOOP-1     /BUT KEEP ECHOING HIS
+STORE, TAD CHAR        /STORE CHARACTER IN SEARCH BUFFER
+       DCA I AXIN
+       JMP RLOOP
+
+/HANDLER FOR "
+QUO2,  TAD THSN        /START AT .+1
+/HANDLER FOR '
+QUO1,  IAC             /START AT .=1
+       DCA THSN
+       TAD AXIN
+       CIA             /MAKE UP COUNT OF NO. CHARS NOW IN
+       TAD SBUF        /SEARCH BUFFER
+       DCA CNTR
+       DCA I AXIN      /END STRING WITH A 0
+SFIND2,        TAD CNTR
+       SNA CLA         /IS BUFFER EMPTY?
+       JMP ER1         /YES-PREPARE TO EXIT
+       JMS NUCHAR      /NO GET FIRST STRING CHARACTER
+       TAD THSN
+       JMS I FIN1      /GET APPROPRIATE POINTER
+       DCA THIS        /THE TRICK IS TO GET THE NEXT
+       DCA CHFND
+       CDF 10          /POINTER SO THAT WE NEVER HAVE TO GO
+       TAD I THIS      /BACK TO THE FIND ROUTINE
+\f
+COMBAK,        DCA TMP2
+       TAD I TMP2
+       DCA NEXTPT
+       CDF 0
+       TAD THSN
+       CIA
+       TAD LSTN
+       SPA CLA         /LAST LINE?
+       JMP ER1         /YES-FINISHED WITH BUFFER
+       TAD TMP2        /NO
+       DCA AXOUT       /SET TO UNPACK CHARACTERS
+       CMA
+       DCA XCT
+UPK1,  JMS I UTR1      /UNPACK A CHARACTER
+       DCA TMP2
+       TAD TMP2
+       TAD MCR
+       SZA CLA         /END OF LINE?
+       JMP NOCR        /NO
+       ISZ THSN        /YES-INCREMENT LINE COUNTER
+       JMS NUCHAR      /FORGET PREVIOUS MATCHES ON NEW LINE
+       DCA CHFND
+       CDF 10
+       TAD NEXTPT      /AND GET NEXT LINE
+       JMP COMBAK
+
+NOCR,  TAD TMP2        /CHARACTER OTHER THAN CARRIAGE RETURN
+       TAD TMP1        /GET A CHARACTER FROM SEARCH BUFFER
+       SZA CLA         /DO THEY MATCH
+       JMP UPK         /NO
+       ISZ CHFND       /YES-BUMP A RANDOM POINTER
+       CLA CMA
+       DCA FMATCH      /SIGNIFY FIRST MATCH
+       JMS NUCHA       /GET NEXT SEARCH CHARACTERR
+       JMP UPK1        /AND ANOTHER BUFFER CHARACTER
+
+UPK,   ISZ FMATCH      /WAS THIS FIRST MATCH?
+       JMP NOTSO       /NO-NO PROBLEM
+       TAD XCT         /YES-DON'T LET THE POINTERS BE
+       SPA CLA         /BE CHANGED
+       JMP WREK
+       CMA
+       TAD AXOUT
+       DCA AXOUT
+       CMA
+WREK,  DCA XCT
+NOTSO, JMS NUCHAR      /GET FIRST CHARACTER OF SEARCH STRING
+       DCA CHFND
+       JMP UPK1        /TRY AGAIN
+\f
+STFIN, TAD CHFND       /END OF STRING-DO COUNTS MATCH?
+       TAD CNTR
+       SNA CLA
+       JMP GOOD        /YES-SEARCH SUCCESSFUL
+ER1,   TAD LSTN        /IF BUFFER EMPTY, SET .=0
+       SZA CLA
+       IAC
+       DCA THSN
+       SKP             /CAUSE ERROR RETURN (?)
+GOOD,  ISZ SFIND1      /INCREMENT RETURN
+       JMP I SFIND1    /--RETURN--
+
+/GET NEXT SEARCH CHARACTER
+NUCHA, 0
+       TAD .-1         /SET TO RETURN FROM NUCHAR
+       DCA NUCHAR
+       JMP NEXX
+
+/GET FIRST CHARACTER OF SEARCH STRING
+NUCHAR,        0
+       TAD SBUF
+       DCA AXIN
+NEXX,  TAD I AXIN
+       SNA             /END OF STRING?
+       JMP STFIN       /YES
+       CIA             /NO - NEGATE SEARCH CHARACTER
+       DCA TMP1        /AND STORE IT
+       JMP I NUCHAR    /--RETURN--
+
+ENDA=SRCBUF-1
+ATSIGN,        244
+TMP1,  0
+TMP2,  0
+CNTR,  0
+FMATCH,        0
+BUFCNT,        0
+NEXTPT,        0
+CHFND, 1               /MUST BE NONZERO INITIALLY
+SBUF,  ENDA
+MSCNT, -24
+
+/HANDLER FOR RUBOUT IN SEARCH STRING
+
+FORGET,        TAD CCR
+       JMS I OUT1      /OUTPUT CARRIAGE RETURN
+       JMP SFIND1+1
+
+\f
+       *2600
+/-----------------------------------------------------------------------
+/-----------------------------------------------------------------------
+       THISX=COUNTP
+       THISX2=DTEM
+       RELCNT=LPT
+
+
+/GARBAGE COLLECTION ROUTINE
+/ENTER WITH NUMBER OF LINE TO BE DELETED
+/IN AC
+
+GARBAG,        0
+       DCA LINPTR      /SAVE OBJECT LINE ADDRESS
+       TAD LINPTR
+       DCA AXCOMB      /SCAN LINE LOOKING FOR 7715 OR 1500 (CR)
+       IAC             /CNT HOLDS
+       DCA CNT         /TOTAL # LOCS IN THIS LINE
+       CDF 10
+COLECT,        ISZ CNT
+       TAD I AXCOMB    /GET A WORD
+       TAD K63
+       SNA             /IS IT 7715?
+       JMP FINONE      /YES-END OF LINE
+       TAD K6215       
+       SZA CLA         /NO-IS IT 1500?
+       JMP COLECT      /NO-TRY NEXT WORD
+FINONE,        TAD CNT         /YES MINUS CNT GIVES AMOUNT
+       CIA             /TO REDUCE CERTAIN POINTERS
+       DCA RELCNT
+       CDF 0
+       IAC             /GO THROUGH LIST OF POINTERS
+       JMS I FIN1      /& OFFSET POINTERS WHICH WILL BE MOVED
+       CDF 10          /MOVED ALONG WITH TEXT
+GBG2,  DCA THISX       /SAVE POINTER
+       TAD I THISX     /GET ADDRESS OF THIS LINE
+       SNA             /DONE WITH STRING?
+       JMP GBGEND      /YES
+       JMS CGEPTR      /DECREASE POINTER IF NECESSARY
+       DCA I THISX     /STORE NEW POINTER
+       TAD THISX2
+       JMP GBG2        /DO NEXT LINE
+\f
+GBGEND,        CDF 0           /ALL POINTERS ARE REDUCED. NOW,
+       CLL CML
+       TAD BUFR        /PHYSICALLY MOVE CORE TO
+       CIA             /CORRESPOND WITH POINTERS
+       TAD AXCOMB      /AXCOMB POINTS TO FIRST LOC. TO GO
+       SMA SNL         /POINTERS O.K.?
+       ERROR           /NO
+       DCA XCT         /YES-SET UP OTHER POINTERS
+       CDF 10
+       CMA
+       TAD LINPTR
+       DCA AXOUT
+       TAD I AXCOMB    /MOVE TEXT
+       DCA I AXOUT
+       ISZ XCT         /ALL TEXT MOVED?
+       JMP .-3         /NO-CONTINUE MOVING
+       CDF 0           /YES
+       TAD AXOUT
+       DCA BUFR        /RESET TOP OF BUFFER
+       TAD BUFR        /REDUCE AXIN FOR CHARACTER SEARCH
+       DCA AXIN
+       TAD THIS        /NOW DECREASE THIS IF IT IS NECESSARY
+       JMS CGEPTR
+       DCA THIS
+       JMP I GARBAG    /--RETURN--
+
+LINPTR,        0
+K63,   63
+
+CGEPTR,        0               /THIS ROUTINE DETERMINES IF THE 
+       DCA THISX2      /OF THE AC MUST BE DECREASED BY RELCNT.
+       CLL             /IF THISX2 IS GREATER THAN LINPTR
+       TAD THISX2      /DECREASE THISX2 BY RELCNT.
+       CIA
+       TAD LINPTR      /THIS EFFECTIVELY DECREASE ALL POINTERS
+       SNL CLA         /WHICH HAVE TO BE RELOCATED
+       TAD RELCNT
+       TAD THISX2
+       JMP I CGEPTR
+
+/HANDLER FOR V COMMAND
+
+VIEW,  TAD (LPT        /SET UP LISTER TO EXIT TO LPT
+       DCA OUTDEV
+       ISZ TABIND
+       JMS I LIS       /LIST BUFFER
+       TAD C214        /AND OUTPUT A FORM FEED
+       JMS I OUTDEV
+       JMP I TE1       /*RETURN TO COMMAND MODE*
+
+
+/LINE PRINTER OUTPUT ROUTINE
+/ENTER WITH CHARACTER IN AC
+/EXIT WITH AC CLEAR
+
+LPT,   0
+       6666            /LLS
+       6661            /LSF
+       JMP .-1
+       CLA
+       JMP I LPT       /--RETURN--
+\f/HANDLER FOR ,
+
+FIRS,  TAD ARG2
+       JMP I ONUM
+
+K6215, 6215
+
+
+/THE FOLLOWING GIVES ERROR MESSAGES FOR I/O RELATED ERRORS
+/EACH IS A FATAL ERROR AND WILL ALWAYS EXIT THROUGH
+/7600, SAVING THE TEXT BUFFER.
+/N IS THE ERROR IDENTIFICATION CODE
+/N=0=> FAILED IN READING DEVICE
+/N=1=> FATAL WRITE ERROR
+/N=2=> FILE CLOSE ERROR
+/N=3=> FILE OPEN ERROR
+/N=4=> DEVICE HANDLER ERROR
+
+SERR4, IAC
+SERR3, IAC
+SERR2, IAC
+SERR1, IAC
+SERR0, DCA TEMPO
+       TLS
+       TSF
+       JMP .-1
+       TAD C215
+       JMS I OUTL1     /OUTPUT CARRIAGE RETURN
+       TAD CLF
+       JMS I OUTL1     /OUTPUT LINE FEED
+       TAD C277
+       JMS I OUTL1     /OUTPUT?
+       TAD TEMPO
+       TAD P260
+       JMS I OUTL1     /SEND ERROR CODE
+       TAD C303
+       JMS I UPAROI    /SEND ^C
+       JMP I MONITO    /****EXIT TO MONITOR****
+
+P260,  260
+C303,  303
+
+DELE,  JMS I DELT      /DELETE THE LINES
+       TSF
+       JMP .-1
+       JMP I TE1
+
+CTRLN, TAD C316
+       JMS I UPAROI    /ECHO ^N
+       JMP I .+1
+       OUTX+1
+C316,  316
+/
+PATCH1,        0
+       CIF 10
+       JMS I   OCLSE   /CLOSE FILE
+       SKP
+       JMP I   PATCH1  /FILE CLOSED OK -RETURN
+       SPA CLA
+       JMP     SERR2   /**FILE CLOSE FAILED**2*
+       JMP I   NOROOM  /RAN OUT OF SPACE WHILE CLOSING
+/
+NOROOM,        ERWT+2
+OCLSE, OCLOSE
+\f/***********************************************************************
+
+/THE CODE AT 3000 IS ONCE ONLY CODE. IT TAKES THE FIELD 1
+/PART OF THE CODE WHICH IS INITIALLY IN FIELD 0 AND MOVES
+/IT UP TO THE PROPER LOCATIONS IN FIELD 1.
+       *3000
+/-----------------------------------------------------------------------
+/-----------------------------------------------------------------------
+
+INIT,  TAD (3177       /COLD LOAD STARTS AT 3200
+       DCA AXIN
+       TAD (6577       /CODE SHOULD BE IN 6600 OF FIELD 1
+       DCA AXOUT
+       TAD (7000       /MOVE 1000 LOCATIONS UP
+       DCA COUNTA
+LOOP,  CDF 0
+       TAD I AXIN      /MOVE CODE
+       CDF 10
+       DCA I AXOUT
+       ISZ COUNTA      /DONE YET?
+       JMP LOOP        /NO
+       DCA AXIN        /YES-RESET COUNTERS
+       DCA AXOUT
+       CDF 0           /PUT A NOP INTO LOC. 203
+       TAD (NOP
+       DCA I (START
+       TAD RST3I       /CHANGE START ADDRESS TO SAVE BUFFER
+       DCA 177
+       CIF CDF 10
+       JMP I K6600     /STARTING ADDRESS IS 16600
+K6600, 6600            /FIELD 1 STARTING ADDRESS
+
+COUNTA,        0
+
+/ERR5, CDF 0           /SET NOT RESTARTABLE BIT IF CHAIN
+/      TAD I (1000
+/      TAD I (7746
+/      DCA I (7746
+/      JMP I (SERR5    /AND GIVE ?5^C
+\f/MISCELLANEOUS PATCHES (NOT ONCE-ONLY!)
+
+/ESCAPE PATCH 25-MAY-77 DS
+
+ESCPA, 0
+       ISZ ESCPA       /SKIP OVER PATCH ADDR
+       TAD ECHOSW      /IS ECHO SUPPRESSED?
+       SNA CLA
+       JMP I ESCPA     /YES, RETURN
+       TAD CHAR        /NO, TEST FOR ESC
+       TAD (-233)
+       SNA CLA                 /V12
+       JMP     .+3             /V12
+       ISZ ESCPA       /PRINT UNLESS IT IS ESC
+       JMP I ESCPA
+       TAD I   CHI1            /V12 - TAD CHIN
+       TAD     (-CMCHK-1
+       SZA CLA                 /COMMAND MODE?
+       ISZ     ESCPA           /NO, OUTPUT IT
+       JMP I   ESCPA           /YES, DON'T OUTPUT IT NOW
+                               /V12
+
+/SCOPE PATCH 25-MAY-77 DS
+
+RUBPA, 0
+       ISZ RUBPA       /SKIP OVER PATCH ADDR
+       CDF 10          /LOOK AT "SCOPE" BIT IN
+       TAD I (7726)    /RESIDENT MONITOR
+       CDF 00
+       AND (200)
+       SZA CLA
+       JMP RP1
+       TAD SPLAT       /NO SCOPE, PRINT BACKSLASH
+RP2,   JMS I OUT1      /PRINT
+       JMP I RUBPA     /DONE, DELETE THE CHAR
+RP1,   TAD (210)       /SCOPE, PRINT BACK SPACE
+       JMS I OUT1
+       TAD (240)       /THEN A SPACE
+       JMS I OUT1
+       TAD (210)       /THEN ANOTHER BACK SPACE
+       JMP RP2
+SPLAT, 334             /ACKNOWLEDGE RUBOUT
+
+\f/ROUTINE TO HANDLE ESCAPE OUTPUT
+/V12 - 27-JUN-77 ES
+
+ESCOUT,        TAD     OUTDEV
+       TAD     (-OUTL
+       SZA
+       TAD     (OUTL-LPT
+       SZA CLA                 /OUTPUT TO TERMINAL OR LINEPRINTER?
+       TAD     (233-"$         /NO, OUTPUT ESC
+       TAD     ("$             /YES, OUTPUT "$"
+       JMP     OUTX            /DO IT
+
+/MORE STUFF MAY BE INSERTED HERE
+
+/LITERALS
+       PAGE
+\f      *3200
+/********************************************************************
+/CODE MOVED TO 16600-16762
+
+NOPUNC
+*6600
+ENPUNC
+
+
+/OURECS=4
+/SETUP FOR USING GENERAL INPUT, OUTPUT ROUTINES
+       INBUF=4200      /INPUT BUFFER AT 04200
+       INCTL=0600      /INPUT CONTROL - 6 PAGES
+       INRECS=3        /3 RECORDS INTO FIELD 0
+       INDEVH=3200     /INPUT HANDLER AT 03200
+
+       OUBUF=5600      /OUTPUT BUFFER AT 05600
+       OUCTL=5000      /OUTPUT CONTROL - 8 PAGES
+       OUDEVH=3600     /OUTPUT HANDLER AT 03600
+
+       MPARAM=7643     /OPTION SWITCHES
+
+
+       JMS I L7700     /CALL USER SERVICE ROUTINES
+       10              /*LOCK USR IN CORE*
+       CDF 0           /V3
+       ISZ I PTEMP     /V3 WERE WE CHAINED TO?
+       JMP CHN         /V3 YES
+       CDF 10          /V3 NO
+START1,        JMS I L200      /CALL USER SERVICE ROUTINES
+       5               /*COMMAND DECODER*
+       0
+CHN,   CDF 10
+       TAD K7620       /RESET OUTDMP
+       DCA I THOLE
+       TAD I P7600A    /OUTPUT LIST
+       AND C17
+SZCL,  SZA CLA         /IS THERE AN OUTPUT DEVICE?
+       JMP NXTOP       /YES
+       CDF 0           /NO-DISALLOW E COMMAND
+       ISZ I EKILSW
+       CDF 10
+NXTOP, TAD I PARAM
+       RAL             /B BIT TO BIT 0
+       DCA DVHAND      /SAVE PARAM. SWITCH
+       TAD DVHAND
+       SMA CLA         /WAS /B OPTION SPECIFIED?
+       JMP NEWOP       /NO
+P7600A,        7600            /YES-
+       TAD SZCL        /SET UP TO CONVERT SPACES TO TABS
+       CDF 0
+       DCA I SPCP1
+       CDF 10
+\fNEWOP,        TAD DVHAND
+       RTL
+       SMA CLA         /WAS /D OPTION SPECIFIED?
+       JMP FILOP       /NO
+       TAD I OHANDL    /YES-HANDLER BROUGHT IN FOR D OPTION
+       DCA DVHAND
+       TAD I P7600A    /DEVICE NUMBER
+       JMS I L200      /CALL USER SERVICE ROUTINES
+       1               /*ASSIGN*
+DVHAND,        0
+       JMP ISERR4      /**DEVICE HANDLER ERROR**4**
+       TAD I P7600A    /GET DEVICE NUMBER
+       JMS I L200      /CALL USER SERVICE ROUTINES
+       4               /*CLOSE*
+       7601
+       0
+JLSTN, LSTN            /PAGE ZERO. 'AND' SOME ADDRESS
+FILOP, TAD PANIC       /PANIC CASE?
+       SNA
+       JMS I IOPENI    /SET BUFFER POINTERS OR RESTORE HANDLER
+       SZA CLA         /YES-
+       JMP GINDVH      /RESTORE INPUT DEVICE HANDLER IN PANIC MODE
+PANOPN,        JMS I OOPENI    /OPEN OUTPUT FILES
+       SMA CLA         /ERROR RETURN
+       SKP             /NORMAL RETURN
+       JMP ISERR3      /**FILE OPEN ERROR**3**
+       TAD PANIC       /PANIC CASE?
+       SNA CLA
+       JMP NOPAN       /NO
+       TAD I P7600A    /YES IF NO OUTPUT,DON'T ALLOW HIM
+       SNA CLA         /TO DESTROY HIS TEXT
+       JMP START1
+       TAD K5000       /SET TO WRITE BUFFER
+       JMS I ODMP      /DUMP IT
+       JMP ISERR1      /**FATAL WRITE ERROR**1**
+       CLA IAC
+\fNOPAN,        DCA DVHAND
+       DCA PANIC       /CLEAR PANIC SWITCH
+       JMS I L200      /CALL USER SERVICE ROUTINES
+       11              /*DISMISS USR FROM CORE*
+       JMS I OUSTPI    /RE-INITIALIZE OUTPUT POINTERS
+       CLA IAC
+       JMS I SETJSI
+       CDF 0           /IF LSTN#0, CLEAR FRST
+       TAD I JLSTN     /BUT IN FIELD 1
+       SNA CLA
+       DCA FRST
+       CIF CDF 0
+       TAD DVHAND
+       SNA CLA         /PANIC MODE?
+       JMP I STRTUP    /NO-START THE EDITOR
+       TLS
+       JMP I .+1       /YES - RESUME OUTPUT
+       BUFRET
+
+GINDVH,        CDF CIF 0
+       JMP I .+1
+       PIASGN
+
+ISERR3,        JMS I L200      /CALL USER SERVICE ROUTINES
+       11              /*DISMISS USR FROM CORE*
+       CIF CDF 0
+       JMP I ASERR3    /**FILE OPEN ERROR**3**
+
+ISERR4,        JMS I L200      /CALL USER SERVICE ROUTINES
+       11              /*DISMISS USR FROM CORE*
+       CIF CDF 0
+       JMP I ASERR4    /**DEVICE HANDLER ERROR**4**
+
+ISERR1,        JMS I L200      /CALL USER SERVICE ROUTINES
+       11              /*DISMISS USR FROM CORE*
+
+       CIF CDF 0
+       JMP I ASERR1    /**FATAL WRITE ERROR**1**
+\fSETJSI,       SETJSB
+L200,  200
+STRTUP,        START
+PANIC, 0
+SPCP1, SPACES+1
+IOPENI,        IOPEN
+OOPENI,        OOPEN
+EKILSW,        EKILLL
+ODMP,  OUTDMP
+OHANDL,        O1
+C17,   17
+PARAM, MPARAM
+L7700, 7700
+ASERR1,        SERR1
+ASERR3,        SERR3
+ASERR4,        SERR4
+K5000, 5000    /OUTPUT BUFF CONTROL WORD
+OUSTPI,        OUSETP
+THOLE, TSTHOL
+K7620, 7620
+PTEMP, TEMP
+
+/***********************************************************************
+\f      *3400
+/***********************************************************************
+/CODE MOVED TO 17000-17173
+
+NOPUNC
+*7000
+ENPUNC
+
+       232             /THIS PAGE IS ^Z BUFFER
+/SET UP ROUTINE FOR OUTPUT
+/INITIALIZES CHARACTERS POINTERS
+OUSETP,        0
+       TAD I PANICJ    /IS IT PANIC DUMP TIME?
+       SZA CLA         /IF YES, DONT RESET POINTERS
+       JMP I OUSETP    /--RETURN--
+       TAD C1          /GET SIZE OF BUFFER IN DOUBLEWORDS
+       CIA             /NEGATE IT
+       DCA OUDWCT
+       TAD C2
+       DCA OUPTR       /INITIALIZE WORD POINTER
+       TAD OUJMPE
+       DCA OUJMP       /INITIALIZE THREE-WAY CHARACTER SWITCH
+       JMP I OUSETP    /--RETURN--
+
+/OUTPUT A CHARACTER
+/ENTER WITH CHARACTER IN 8-BIT ASCII
+/IN AC
+OCHAR, 0
+       AND C377        /MASK OUT EXTRA BITS
+       DCA OUTEMP
+       KRS
+       TAD M203
+       SNA CLA
+       KSF
+       JMP .+3
+       CIF CDF 0
+       JMP I C7600
+       RDF             /NO-
+       TAD CDIF0
+       DCA OUCRET
+       TAD OUTINH      /IS OUTPUT INHIBITED?
+       SZA CLA
+       JMP PSTOP       /NO
+       CDF OUFLD       /YES-SET DATA FIELD TO BUFFER'S FIELD
+       ISZ OUJMP       /BUMP THE CHARACTER SWITCH
+OUJMP, HLT             /3 WAY CHARACTER SWITCH
+       JMP OCHAR1
+       JMP OCHAR2
+OCHAR3,        TAD OUTEMP
+       CLL RTL
+       RTL
+       AND K7400
+       TAD I OUPOLD
+       DCA I OUPOLD    /UPDATE FIRST WORD OF TWO WITH HIGH
+                       /ORDER 4 BITS OF 3RD CHAR
+\f      TAD OUTEMP
+       CLL RTR
+       RTR
+       RAR
+       AND K7400
+       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 OUCT        /LOAD CONTROL WORD FOR A FULL WRITE
+       JMS I DMPO      /DUMP THE BUFFER
+       JMP OUCRET      /OUTPUT ERROR - GIVE ERROR RETURN
+       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,        ISZ OCHAR
+OUCRET,        HLT             /RESTORE CALLING FIELDS
+       JMP I OCHAR     /--RETURN--
+
+OUTEMP,        0
+OUPOLD,        0
+OUPTR, 0
+OUJMPE,        JMP OUJMP
+OUDWCT,        0
+OUTINH,        0
+\f/FETCH OUTPUT DEVICE CONTROL WORD
+
+OTYPE, 0
+       RDF
+       TAD CDIF0
+       DCA OTRTN
+       CDF 10
+       TAD I C7600     /FETCH OUTPUT DEVICE NUMBER
+       AND P17
+       TAD DCBM1       /+DCB-1
+       DCA OUTEMP      /FETCH DEVICE CONTROL WORD
+       TAD I OUTEMP
+OTRTN, HLT             /RESTORE CALLING FIELDS
+       JMP I OTYPE     /--RETURN--
+PSTOP, CIF 0           /PRINTS ? WHEN NO OUTPUT DEV
+       ERROR
+
+INSET, 0
+       DCA OTYPE       /SAVE AC
+       RDF
+       TAD CDIF0
+       DCA INSTRT      /SET RETURN FIELDS
+       CDF 0
+       TAD I PLASTN
+       CDF 10
+       SNA CLA         /IS THERE ANYTHING IN BUFFER?
+       IAC             /NO-NO NEED TO SAVE USR AREA
+       JMS SETJSB      /YES-
+       TAD OTYPE       /RESTORE AC
+INSTRT,        CIF CDF 0       /RESTORE CALLING FIELDS
+       JMP I INSET     /--RETURN--
+\f/SET JOB STATUS BIT 11 TO SAVE OR NOT SAVE
+/ENTER WITH AC=0 OR 1, DEPENDING ON BUFFER
+
+SETJSB,        0
+       DCA JSBTM       /SAVE AC
+       CDF 0
+       CLA CLL CMA RAL
+       AND I PJSBTS    /CLEAR BIT 11 OF JSW
+       TAD JSBTM       /SET ACCORDING TO AC
+       DCA I PJSBTS
+       CDF 10
+       JMP I SETJSB    /--RETURN--
+
+JSBTM, 0
+PJSBTS,        7746
+PLASTN,        LSTN
+
+DCB=7760
+C1,    OUCTL&3700
+C2,    OUBUF
+C377,  377
+M203,  -203
+CDIF0, CDF CIF 0
+K7400, 7400
+OUCT,  OUCTL
+C7600, 7600
+P17,   17
+DCBM1, DCB-1
+DMPO,  OUTDMP
+PANICJ,        PANIC
+/***********************************************************************
+\f      *3600
+/***********************************************************************
+/CODE MOVED TO 17200-17376
+NOPUNC
+*7200
+ENPUNC
+/OPEN OUTPUT FILE
+
+O17,   17
+OOPEN, 0
+OU7600,        7600
+       TAD OU7601
+       DCA OUBLK
+       TAD O1
+       DCA OUHNDL      /SET OUTPUT HANDLER ENTRY
+       CDF 10
+       TAD I OU7600    /GET DEVICE NUMBER WORD OF OUTPUT FILE ENTRY
+       SNA             /IS THERE AN OUTPUT DEVICE?
+       JMP ONOFIL      /NO - INHIBIT OUTPUT
+       JMS I O200      /CALL USER SERVICE ROUTINES
+       1               /*ASSIGN,FETCH HANDLER*
+OUHNDL,        2600            /OUTPUT DEVICE HANDLER ENTRY
+       JMP I SERR4A    /**DEVICE HANDLER ERROR**4**
+OUENTR,        TAD I OU7600
+       JMS I O200      /CALL USER SERVICE ROUTINES
+       3               /*ENTER OUTPUT FILE*
+OUBLK, 7601            /REPLACED WITH STARTING BLOCK
+OUELEN,        0               /REPLACED WITH LENGTH OF HOLE
+       JMP OEFAIL      /FAILED - MAYBE WE ASKED TOO MUCH
+       DCA OUCCNT
+       DCA I O2        /ZERO OUTPUT INHIBIT FLAG
+       TAD OUBLK
+       DCA OUREC       /INITIALIZE OUTPUT RECORD NUMBER
+       JMS I O3
+       ISZ OOPEN
+OORETN,        JMP I OOPEN
+OEFAIL,        TAD I OU7600
+       AND O7760       /GET REQUESTED LENGTH
+       SNA CLA         /WAS IT AN INDEFINITE REQUEST
+       JMP ONTERR      /YES - CANNOT ENTER THE FILE
+       TAD I OU7600
+O200,  AND O17         /MAKE THE REQUESTED LENGTH ZERO
+       DCA I OU7600
+       JMP OUENTR      /TRY, TRY AGAIN
+ONTERR,        CLA CLL CML RAR /AC=2
+       JMP OORETN      /TAKE THE ERROR RETURN WITH AC<0
+ONOFIL,        ISZ I O2
+       JMP OORETN      /TAKE THE ERROR RETURN WITH AC=0
+\fOUTDMP,       0
+       DCA OUCTLW      /STORE THE CONTROL WORD
+       JMS OUNREC      /COMPUTE NO. OF RECORDS
+       TAD OUCCNT
+       DCA OUCCNT
+       TAD OUCCNT
+       CLL CML
+       TAD OUELEN
+TSTHOL,        SNL CLA         /IF ZERO OR POSITIVE,GIVE ERROR
+       JMP OUERR
+       CDF CIF 0
+       CDF 10
+       JMS I OUHNDL    /CALL OUTPUT DEVICE HANDLER
+OUCTLW,        0               /CONTROL WORD
+       OUBUF           /BUFFER ADDRESS
+OUREC, 0               /RECORD NUMBER
+       JMP OUERR       /THERE ARE NO SOFT OUTPUT HANDLER ERRORS
+       JMS OUNREC
+       TAD OUREC
+       DCA OUREC       /UPDATE OUTPUT RECORD NUMBER
+       ISZ OUTDMP      /BUMP OUTDMP TO NORMAL RETURN
+OUERR, JMP I OUTDMP    /--RETURN--
+\f
+/CLOSE OUTPUT FILE
+OCLOSE,        0
+       TAD K7660       /SET UP SNL SZA CLA FOR CLOSE
+       DCA TSTHOL
+       CDF 10
+       TAD I PANICC
+       SZA CLA
+       JMP NODUMP
+       TAD I O2
+       SZA CLA         /IS OUTPUT INHIBITED?
+       JMP OCISZ       /YES - CLOSE IS A NOP
+       TAD O232        /OUTPUT A ^Z
+       JMS I O4
+       JMP OCRET       /AND SOME 0'S
+       JMS I O4
+       JMP OCRET
+FILLLP,        JMS I O4
+       JMP OCRET
+       JMS I O5        /GET TYPE OF OUTPUT DEVICE
+       SPA CLA
+       TAD O100        /IF ITS A DIRECTORY DEVICE FORCE A RECORD
+       TAD O77         /BOUNDARY-OTHERWISE HALF RECORD
+       AND I O6
+       SZA CLA         /UP TO THE BOUNDARY YET?
+       JMP FILLLP      /NO - FILL WITH ZEROS
+       TAD I O6        /GET DOUBLEWORD COUNT LEFT
+       TAD O7
+       SNA             /A FULL WRITE LEFT?
+       JMP NODUMP      /YES - DON'T DO IT - ^Z IS ALREADY OUT
+       TAD O8          /PUT IN FIELD BITS AND WRITE BIT
+       JMS OUTDMP
+       JMP OCRET       /ERROR OCCURRED WHILE DUMPING THE BUFFER
+NODUMP,        JMS I O7700     /CALL USER SERVICE ROUTINES
+       10              /*LOCK USR IN CORE*
+       TAD I OU7600    /DEVICE NUMBER
+       JMS I O200      /CALL USER SERVICE ROUTINES
+       4               /*CLOSE OUTPUT FILE*
+OU7601,        7601            /POINTER TO THE OUTPUT FILE NAME
+OUCCNT,        0
+       SKP             /ERROR WHILE CLOSING THE FILE
+OCISZ, ISZ OCLOSE
+OCRET, CIF CDF 0       /RESTORE CALLING FIELDS
+       JMP I OCLOSE    /--RETURN--
+PANICC,        PANIC
+\f/CONVERT OUTPUT CONTROL WORD
+/TO NUMBER OF RECORDS
+OUNREC,        0
+       TAD OUCTLW
+       CLL RTL
+       RTL
+       RTL
+       AND O17
+       JMP I OUNREC    /--RETURN--
+
+K7660, SNL SZA CLA
+O1,    OUDEVH+1
+O7700, 7700
+O2,    OUTINH
+O3,    OUSETP
+O7760, 7760
+O232,  232
+O4,    OCHAR
+O5,    OTYPE
+O100,  100
+O77,   77
+O6,    OUDWCT
+O7,    OUCTL&3700
+O8,    4000+OUFLD
+SERR4A,        ISERR4
+
+/***********************************************************************
+\f      INFLD=INCTL&70          /FIELD OF INPUT BUFFER
+       OUFLD=OUCTL&70          /FIELD OF OUTPUT BUFFER
+/***********************************************************************
+/CODE MOVED TO 17400 -17574
+
+*4000
+NOPUNC
+*7400
+ENPUNC
+
+/PREPARE TO OPEN NEW INPUT FILE
+
+IN7400,        7400
+IOPEN, 0
+       CLA CMA
+       DCA INCHCT      /SET INCHCT TO FORCE A READ
+       ISZ INEOF       /SET END-OF-FILE FLAG TO FORCE A NEW FILE
+       TAD I7617
+       DCA INFPTR      /RESET FILE POINTER
+       JMP I IOPEN     /--RETURN--
+INPTR, 0
+INDEV, 0
+
+/INPUT A CHARACTER
+
+ICHAR, 0
+IN7600,        7600
+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
+INNEWF,        CDF 10
+       TAD I1
+       DCA INHNDL      /INITIALIZE HANDLER ADDRESS
+       TAD I INFPTR    /GET NEXT CD INPUT FILE ENTRY
+       DCA INDEV       /SAVE IT FOR PANIC
+       TAD INDEV
+       SNA             /ANY MORE?
+       JMP EOFERR      /NO - OUT OF INPUT
+       JMS I PINSET    /YES-SAVE BUFFER IF NECESSARY
+       JMS I I7700     /CALL USER SERVICE ROUTINE
+       1               /*ASSIGN, FETCH HANDLER*
+INHNDL,        0
+       JMP I SERR4B    /**DEVICE HANDLER ERROR**+**
+       TAD I INFPTR
+       AND I7760       /GET LENGTH PART OF WORD
+       SZA             /LENGTH OF 0 MEANS LENGTH >=256
+\f      TAD I17         /ADD HIGH ORDER BITS
+       CLL CML RTR
+       RTR
+       DCA INCTR       /STORE LENGTH OF FILE
+       ISZ INFPTR
+       TAD I INFPTR
+       DCA INREC       /STORE STARTING RECORD NUMBER OF FILE
+       ISZ INFPTR
+       DCA INEOF       /ZERO END-OF-FILE FLAG
+INGBUF,        TAD INCTR
+       CLL
+       TAD I2
+       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 I3
+       DCA INCTLW
+       CDF CIF 0
+       CDF 10
+       JMS I INHNDL    /CALL INPUT DEVICE HANDLER
+INCTLW,        0               /CONTROL WORD
+INBUFP,        INBUF           /INPUT BUFFER
+INREC, 0               /NUMBER OF RECORDS
+       JMP INERRX      /SOME KIND OF HANDLER ERROR
+INBREC,        TAD INREC
+       TAD I2
+       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 ERROR
+       SMA CLA         /WHICH TYPE WAS IT?
+       JMP INBREC      /END OF FILE - RESUME PROCESSING
+INERR, CLA CLL CML RAR /BAD - GIVE ERROR RETURN WITH NEGATIVE AC
+EOFERR,        JMP INRTRN
+\fINJMP,        HLT             /3 WAY CHARACTER SWITCH
+       JMP ICHAR1
+       JMP ICHAR2
+ICHAR3,        TAD INJMPP
+       DCA INJMP
+       TAD I INPTR
+       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 I377
+       TAD IM232
+       SNA             /IS THE CHARACTER A ^Z?
+       JMP INNEWF      /YES - GET A NEW FILE
+       TAD I232        /RESTORE THE CHARACTER
+       ISZ ICHAR       /BUMP RETURN TO NORMAL RETURN
+INRTRN,        CDF CIF 0       /RESTORE CALLING FIELDS
+       JMP I ICHAR     /--RETURN--
+
+INCHCT,        -1
+INFPTR,        7617
+INEOF, 1
+
+       INCTR=IOPEN
+PINSET,        INSET
+I7617, 7617
+I1,    INDEVH+1
+I7760, 7760
+I17,   17
+I2,    INRECS
+I3,    INCTL+1
+I377,  377
+IM232, -232
+I232,  232
+I7700, 7700
+SERR4B,        ISERR4
+
+$
+/***********************************************************************
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape7/FOTP.PA b/sw/os8/v3d/sources/system/dectapes/dectape7/FOTP.PA
new file mode 100644 (file)
index 0000000..28abecb
--- /dev/null
@@ -0,0 +1,1638 @@
+/3.1 OS/8 V3 FOTP              5-AUGUST-1975   (NOT HALLOWEEN)
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/WITH FAILSAFE CHANGES        NOV 17, 1973    R.L.
+
+
+/  FOTP (FILE ORIENTED TRANSFER PROGRAM)   H.J.
+
+
+/CORE MAP
+
+/FROM TOP OF CORE
+
+/      FIELD 2 GETS CONDITIONALLY USED AS BUFFER
+
+/      FIELD 1
+/              7777-7600       MONITOR
+/              7577-4600       INCORE OUTPUT DIRECTORY
+/              4577-2000       FOTP CODE
+/              1777-0          RESIDENT USR
+/
+/      FIELD 0
+/              7777-7600       MONITOR
+/              7577-7200       ERROR MESSAGES
+/              7177-0          WORK AREA AS:
+/
+/              AT TOP- OUTPUT HANDLER IF NEEDED
+/                      1 OR 2 PAGES
+
+/                      INPUT HANDLER IF NEEDED
+/                      1 OR 2 PAGES
+
+/                      INPUT DEVICES DIRECTORY
+/                      (ONLY USED PORTION)
+
+/                      THE TRANSFER BUFFER IN 8K
+/                      IS WHAT EVER REMAINS.
+
+/FIXES FOR MAINTENANCE RELEASE: (S.R. 5-AUG-75)
+
+/1.    CHANGED COPYRIGHT DATE
+/2.    INCORPORATED SEQ #1 PATCH (DSN MARCH 1975)
+/      PERMITS FOTP TO RECOVER FROM A MONITOR ERROR 6
+/      BY UNFAKING THE SYSTEM HANDLER
+/3.    UPDATED FOTP VERSION NUMBER TO V8
+/4.    ADDED SPACE FOR A PATCH LEVEL
+/5.    ALLOWED /T SWITCH TO WORK IN CONJUNCTION WITH /R
+/6.    PERMITS RENAMING A FILE TO IT'S OWN NAME
+/7.    IF NO OUTPUT DEVICE IS SPECIFIED WITH /R,
+/      ASSUME OUT DEV=INPUT DEVICE.
+
+/8.    FIXED BUG RE ADDITIONAL INFO WORDS
+\f/PAGE 0 LOCATIONS OS/8 USR WON'T MANGLE
+
+       PTR=20
+       CNT=21
+       INFPTR=22
+       OUHAND=23
+       INHAND=24
+       FPAGE=25
+       EPTR=26
+       INSCNT=27
+       TEMP=30
+       OKFLAG=31
+       IFCNT=32
+       BUFSIZ=33
+       INFWDS=34
+       BDPTR=35
+       GPTR1=36
+       INEOF=37
+
+/AUTO INDEX REGISTERS USR WILL ALLOW ME TO USE TEMPORARILY
+
+       XR=10
+       XR1=11
+       XR2=12
+
+
+/VARIOUS CONSTANTS THAT CAN BE GENERATED
+
+       AC2=CLA CLL CML RTL
+       AC4000=CLA CLL CML RAR
+       ACM2=CLA CLL CMA RAL
+       ACM3=CLA CLL CMA RTL
+
+/      LOCATIONS REFERENCED IN OS/8
+
+       ALTOPT=7642
+       OPT1=7643
+       OPT2=7644
+       DATE=7666
+       DIRKEY=7        /"DIRECTORY SEGMENT IN CORE" KEY
+
+/SYMBOLIC FOTP LOCATIONS:
+
+OUBUFR=        4600            /OUTPUT BUFFER - IN FIELD 1
+INBUFR=        0               /INPUT BUFFER - IN FIELD 0
+LSTFPG=        7000            /FIRST LOC OF LAST FREE PAGE IN FIELD 0
+FAKHND=        200             /LOCATION OF OS/8 FAKEOUT HANDLER
+VERSION=       11      /VERSION NUMBER
+SUBVER=                01      /SUB VERSION (PATCH LEVEL)
+                       /LOCATED AT "VERLOC" AS 60+VERSION^100+SUBVER
+\f/STARTS AT 4600 IN FIELD 1 (ONCE ONLY CODE)
+
+/SAVE INFO:
+
+/      .LOAD FOTP(89P)
+/      .SAVE SYS FOTP;14600
+
+       FIELD 1
+       *2000
+
+CDCALL,        JMS I (200      /SEE WHAT THE PERSON WANTS
+FIVE,  5
+STAR,  5200            /IN SPECIAL MODE
+
+BYPSCD,        JMS I (INTERC   /CATCH CALLS TO 7600
+
+       TAD I (7600     /SAVE USER OUTPUT DEVICE
+       DCA I (USEROD   /-FOR LATER
+
+
+/ CHECK FOR ? IN OUTPUT SPECIFICATION
+       TAD (-10        /8CHARACTERS TO LOOK AT
+       DCA CNT         /CNT HAVING -10 PUTS US AT FIRST CHAR
+S1C,   TAD (7605
+       JMS I (GTSXBT   /GET A CHAR
+       TAD (-"?!7700   /CHECK FOR ?
+       SNA CLA
+       JMP QINO        /? IN OUTPUT NOT ALLOWED
+       ISZ CNT
+       JMP S1C
+
+/ CHECK FOR EMBEDDED * IN ANY SPECIFICATION
+
+       TAD (7605
+S4L,   DCA PTR
+       TAD (-10
+       DCA CNT
+ACK,   TAD PTR
+       JMS I (GTSXBT
+       TAD (-"*!7700   /CHECK TO SEE IF CHARACTER *
+       SZA CLA         /SKIP IF IT IS
+       JMP CNTUP       /GO LOOK AT NEXT
+       AC2
+       TAD CNT         /ARE WE AT EXTENSION
+       SZA             /SKIP IF YES
+       TAD (6          /ARE WE AT START OF FILENAME?
+       SNA CLA         /SKIP IF NOT
+       ISZ CNT         /BUMP COUNT ONLY IF OK
+       TAD PTR         /LOOK AT NEXT CHAR
+       JMS I (GTSXBT
+       SZA CLA         /SKIP IF ITS NULL - OK
+       JMP AINO        /ERROR
+CNTUP, ISZ CNT         /BUMP TO NEXT CHAR
+       JMP ACK         /CONTINUE CHECKING
+       TAD I PTR       /ANY MORE INPUT
+       SNA CLA         /SKIP IF THERE IS
+       JMP NULLCK
+       TAD FIVE        /BUMP TO NEXT ENTRY
+       TAD PTR
+       JMP S4L
+\f/ CHECK FOR NULL OUTPUT SPECIFICATION AND MAKE *.*
+
+NULLCK,        TAD I (7601     /WAS OUTPUT FILENAME GIVEN?
+       SZA CLA         /SKIP IF NONE
+       JMP DIDEML
+       TAD STAR        /PUT AN ASTERISK IN
+       DCA I (7601     /FILENAME
+       TAD STAR
+       DCA I (7604     /AND EXTENSION
+
+/THIS CODE SETS A DEFAULT OUTPUT DEVICE ON DELETE
+
+DIDEML,        TAD I (7600     /IS AN OUTPUT DEVICE SPECIFIED?
+       SZA             /SKIP IF NOT
+       JMP ODSPEC      /NOTE DEVICE NUMBER IN AC
+       TAD I (OPT1     /CHECK FOR /D
+       AND (400
+       SZA CLA         /SKIP IF NOT /D
+       JMP MOV         /OUTPUT=INPUT
+       TAD I (OPT2     /V3C
+       AND (100        /CHECK FOR /R
+       SZA CLA         /V3C
+MOV,   TAD I (7605     /WE'LL SUBSTITUTE FIRST INPUT DEVICE FOR USER
+ODSPEC,        AND (17         /CLEAR USER SPECIFIED LENGTH
+       DCA I (7600     /WE KNOW BETTER
+
+/THE FOLLOWING BRINGS IN THE OUTPUT DEVICE HANDLER,
+/READS THE DIRECTORY INTO CORE AND VERIFIES IT.
+
+       TAD (LSTFPG     /SET THE FREE SPACE POINTER
+       DCA FPAGE       /TO THE LAST FREE PAGE IN FIELD 0
+       TAD I (7600     /IS THERE AN OUTPUT DEVICE?
+       SZA             /IF NO OUTPUT, DON'T FETCH HANDLER
+       JMS I (ASSIGN   /GET THE HANDLER AND ALLOCATE ITS SPACE
+       DCA OUHAND      /AC RETURNS HANDLER ENTRY POINT
+       JMS I (ODIRIN   /READ IN THE OUTPUT DIRECTORY
+       TAD (7605       /INGIALIZE INPUT POINTER
+
+/THIS IS THE BEGINING OF THE INPUT FILE LOOP
+
+DOMOIN,        DCA INFPTR      /POINTER TO CURRENT INPUT
+       TAD I INFPTR    /WHEN 0 NO MORE INPUT
+       SNA             /SKIP IF MORE TO DO
+       JMP I (ENDCHK   /DO END PROCESSING
+       JMS I (ASSIGN   /ASSIGN AND ALLOCATE SPACE FOR INPUT HANDLER
+       DCA INHAND      /AND SAVE ITS ENTRY ADDRESS
+
+/THE FOLLOWING 2 INSTRUCTIONS HELP AVOID ALL KINDS OF
+/PROBLEMS WITH THE MONITOR.  IF A HANDLER GETS LOADED, THE
+/MONITOR MAKES IT RESIDENT FOR OTHER PEOPLE AND DOESN'T DELETE
+/ITS RESIDENT STATUS IF A REQUEST IS MADE FOR A NEW HANDLER
+/TO BE LOADED OVER IT IF THE NEW HANDLER IS ALREADY RESIDENT
+
+       TAD FPAGE       /SAVE FREE SPACE POINTER HERE
+       DCA SFUDG
+       JMP I (PG1      /LINK TO NEXT SECTION
+
+SFUDG, 0
+\fONDERR,       JMS I (ERROR
+       ODRERR+40       /ERROR READING OUT DIR
+AINO,  JMS I (ERROR
+       ILLA+40         /ILLEGAL *
+QINO,  JMS I (ERROR
+       ILLQ+40         /ILLEGAL ?
+
+       PAGE
+\f/CHECK FOR NON FILE STRUCTURED INPUT
+/WE CAN'T HANDLE IT
+
+PG1,   TAD I INFPTR
+       TAD (7757
+       DCA TEMP
+       TAD I TEMP      /IS FILE STRUCTURED BIT ON
+       SMA CLA         /SKIP IF IT IS
+       JMP NFIN        /ERROR
+       CIF 0
+       JMS I INHAND    /READ INPUT DEVICES DIRECTORY
+       1400
+IDBUF, INBUFR
+       1
+       JMP INDERR      /ERROR
+       CDF 0
+       TAD I IDBUF     /MAKE SURE THAT THE
+       CMA CLL         /DIRECTORY OF
+       TAD I (INBUFR+2 /THE DEVICE IS
+       CDF 10          /GOOD
+       SNL
+       TAD (7700       /(SEE COMMENT ON TEST IN ROUTINE "ODIRIN")
+       SZL CLA         /SKIP IF ITS GOOD
+       JMP BIDIR       /ERROR
+
+/FIND LAST BLOCK OF DIRECTORY
+
+       AC2             /LINK TO NEXT SGMENT NUMBER
+FNDLST,        DCA PTR         /SAVE IT
+       CDF 0
+       TAD I PTR       /IS THERE ANOTHER SEGMENT?
+       SNA CLA         /SKIP IF YES
+       JMP ATIT        /NO...WE ARE POINTING TO LAST
+       TAD PTR         /BUMP TO NEXT SEGMENT
+       TAD (400
+       JMP FNDLST      /LOOK AGAIN
+ATIT,  ACM3            /AC=7775
+       AND PTR         /AND OUT 2'S BIT
+       TAD (400        /TOTAL SIZE OF IN CORE DIRECTRY
+       CIA             /NEGATE FOR ISZ
+       DCA CNT
+       TAD FPAGE       /WE ARE GOING TO PACK DIRECTORY
+       TAD (200        /RIGHT UP TO INPUT HANDLER SO
+       TAD CNT         /WE GET MAX SIZE TRANSFER BUFFER
+       DCA FPAGE       /ADJUSTED FREE CORE POINTER
+       CMA
+       TAD FPAGE
+       DCA XR1         /SET UP PLACE TO MOVE TO
+       CMA
+       DCA XR2         /ALWAYS COMES FROM 0
+       TAD I XR2       /MOVE
+       DCA I XR1       /IT
+       ISZ CNT
+       JMP .-3
+\f/SET SAME DEVICE FLAG FLAG 4000 IF /D
+
+       CDF 10
+       TAD I (OPT1
+       AND (400
+       RTL CLL         /PUT /D BIT INTO AC 0
+       RAL
+       DCA SDFLG
+
+
+/ COUNT NUMBER OF INPUTS FROM SAME DEVICE
+/ALSO MAKE NULL INPUT FILENAMES *.*
+/BUT ONLY IF NOT /D
+
+       TAD INFPTR      /OK LETS GO THROUGH
+       DCA PTR         /THE INPUT SPECIFICATIONS
+GETCNT,        ISZ PTR         /POINT TO FILENAME WORD
+       TAD (3          /SET TEMP TO POINT TO EXTENSION
+       TAD PTR
+       DCA TEMP
+       TAD SDFLG       /ARE WE DOING /D
+K7450, SNA             /SKIP IF YES - AC NON 0
+       TAD I PTR       /NO /D - LOOK AT FILENAME
+       SZA CLA         /ITS NULL PUT IN *.*
+       JMP NOSUB       /DONT CHANGE IT
+       TAD (5200       /MAKE IT *
+       DCA I PTR
+       TAD (5200       /.*
+       DCA I TEMP
+NOSUB, CLA IAC         /TEMP+1 POINTS TO NEW INPUT
+       TAD TEMP
+       DCA PTR
+/NOTE CNT WAS SET BY ISZ'ING TO ZERO
+       ISZ CNT         /KEEP COUNT OF DEVICES IN GROUP
+       TAD I (OPT2     /CHECK FOR /U (UGLY SWITCH)
+       AND (10
+       SZA CLA         /SKIP IN NO /U
+       JMP NOPTIM      /WERE FORCED TO DO ONE AT A TIME
+       TAD I PTR       /COMPARE DEVICE NUMBERS
+       CIA             /IN A GROUPING
+       TAD I INFPTR
+       SNA CLA         /SKIP IF NEW GROUP
+       JMP GETCNT      /WE'LL DO ALL THE SAME AT ONCE
+NOPTIM,        TAD CNT
+       CIA             /NEGATE COUNT
+       DCA INSCNT      /AS NUMBER OF INPUTS TO DO AT ONCE
+       TAD PTR         /SAVE WHERE TO CONTINUE FOR REST
+       DCA I (MOIN
+\f/THE FOLLOWING CHECKS TO SEE IF A OPERATION
+/IS BEING DONE FROM A DEVICE TO ITSELF
+
+       TAD I (7600     /GET DEVICE NUMBER
+       TAD (7646       /HANDLER ENTRY POINT TABLE
+       DCA TEMP
+       TAD I INFPTR    /GET INPUT ENTRY POINT
+       TAD (7646
+       DCA PTR
+       TAD I PTR       /CHECK INPUT ENTRY POINT AGAINST
+       CIA
+       TAD I TEMP      /OUTPUT ENRTY POINT
+       SNA CLA         /SKIP IF THEY ARE DIFFERENT
+       ISZ SDFLG       /SET SAME DEVICE FLAG, AC11
+       TAD FPAGE       /SET POINTER TO
+       DCA BDPTR       /START OF DIRECTORY
+       DCA TYPFND      /CLEAR FOUND FILE FLAG
+       JMP I (NBLOCK   /LINK TO SOME MORE
+
+TYPFND,        0
+SDFLG, 0               /NEGATIVE MEANS /D, ODD MEANS OUTPUT DEV=INPUT DEV
+
+NFIN,  JMS I (ERROR
+       NFLEIN+40       /NON FILE STRUCTED INPUT
+INDERR,        JMS I (ERROR
+       BADIRD+40       /ERROR READING INPUT DIR
+BIDIR, JMS I (ERROR
+       BIDIRM+40       /NOT A GOOD DIRECTORY
+
+       PAGE
+\f/THIS IS THE SUPERQUASIFACETED DIRECTORY PATTERN MATCHING ROUTINE
+
+/THE INPUT DIRECTORY IS SEARCHED HERE, IF A MATCH
+/IS FOUND USING THE INPUT GROUPING
+/GOT1 GETS CONTROL WITH -BLOCKS IN THE AC
+
+NBLOCK,        STA
+       TAD BDPTR       /POINTER TO START OF DIR BLOCK
+       DCA XR
+       CDF 0
+       TAD I XR        /GET COUNT OF NUMBER OF ENTRIES
+       DCA ENTCNT      /SAVE LOCALLY TO AVOID HERB'S BUG
+       TAD I XR        /GET BLOCK NUMBER FIRST FILE
+       DCA BLOCK
+       TAD I XR        /NEXT SEGMENT NUMBER
+       DCA LFLAG       /IF IT 0 WE AT END
+       ISZ XR          /SKIP TENTATIVE FILE WORD
+       TAD I XR        /GET -NUMBER OF INFO WORDS
+       CIA             /MAKE POSITVE
+       DCA INFWDS
+       TAD XR          /POINT TO FIRST
+       IAC             /ENTRY
+       DCA EPTR
+
+BLOOP, TAD I EPTR      /GET FILENAME WORD
+       CDF 10
+       SNA CLA         /SKIP IF FILE HERE
+       JMP EMPTY       /NO... ITS REALLY AN EMPTY
+       TAD INSCNT      /SET NUMBER OF INPUT TO LOOK
+       DCA NCNT        /AT ALL AT ONCE
+       DCA MATFLG      /CLEAR MATCH FLAG
+       TAD INFPTR      /ADDRESS OF FIRST INPUT
+       SKP
+MN1,   TAD GPTR2       /ADDRESS OF CURRENT INPUT
+       TAD (5          /GTSXBT SUBR REQUIRES US TO
+       DCA GPTR2       /POINT TO END OF FIELD
+       TAD EPTR        /POINT DIRECTORY POINTER TO
+       TAD (4          /END OF ENTRY FOR SAME REASON
+       DCA GPTR1
+       TAD GPTR1       /SET EPNEXT TO POINT TO
+       TAD INFWDS      /MINUS NUMBER OF BLOCKS IN
+       DCA EPNEXT      /FILE WORD
+       TAD (-10        /NUMBER OF CHARS TO LOOK AT
+WILDNM,        DCA CNT
+\fMLP,  TAD GPTR2       /OK - GET A CHARACTER FROM
+       JMS I (GTSXBT   /STRING
+       TAD (-"*!7700   /IS IT AN *
+       SNA             /SKIP IF NOT *
+       JMP WILDA       /YEP... ITS A WILD CARD
+       TAD ("*-"?      /IS IT A ?
+       SNA             /SKIP IF NOT
+       JMP WILD        /YES... FORCE MATCH ON THIS CHAR
+       TAD ("?&77      /RESTORE VALUE
+       CIA             /NEGATE
+       DCA CHAR        /AND SAVE
+       TAD GPTR1       /NOW GET CHAR FROM DIRECTORY
+       CDF 0
+       JMS I (GTSXBT
+       CDF 10
+       TAD CHAR        /DO CHARS MATCH
+       SZA CLA         /SKIP IF THEY DO
+       JMP NM1         /NO MATCH ON THIS INPUT
+WILD,  ISZ CNT         /BUMP COUNT OF CHARS & POINTER
+       JMP MLP         /COMPARE ALL 8
+MEXT,  ISZ MATFLG      /A MATCH!!!!!!!
+NM1,   CLA             /WILD CARD COMES HERE WITH ICHY AC
+       ISZ NCNT        /HAVE WE CHECKED GROUP OF INPUTS
+       JMP MN1         /NO CHECK WHOLE GROUP
+       TAD MATFLG      /HAVE THERE BEEN ANY MATCHES
+       SZA CLA         /SKIP IF NOT
+       TAD (4          /WILL INVERT /V SWITCH
+       TAD I (OPT2     /ADD SWITCH
+       AND (4          /ISOLATE IT
+       CDF 0
+/SKIPS IF INPUT DIRECTORY ENTRY IS NOT CANDIDATE
+/THAT IS - IF A MATCH WAS NOT FOUND BETWEEN ANY
+/OF THE INPUTS AND /V WAS NOT SPECIFIED   OR
+/A MATCH WAS FOUND AND /V WAS SPECIFIED
+
+/THIS ALLOWS /V TO MEAN EVERYTHING BUT...
+
+       SZA CLA
+       TAD I EPNEXT    /GET -NUMBER OF BLOCKS
+       CDF 10
+       SZA             /SKIPS IF TENTATIVE OR NOT CANDIDATE
+       JMP I (GOT1     /PROCESS FILE
+NENT,  TAD EPNEXT      /POINT EPTR TO BLOCK
+       DCA EPTR        /COUNT OF FILE
+       SKP
+EMPTY, ISZ EPTR        /ON EMPTY MAKE EPTR POINT TO BLOCK COUNT
+       CDF 0
+       TAD I EPTR      /GET BLOCK COUNT
+       CIA             /MAKE POSITIVE
+       TAD BLOCK
+       DCA BLOCK       /KEEP SUM
+       ISZ EPTR        /POINT TO NEXT ENTRY
+       ISZ ENTCNT      /BUMP THE NUMBER OF ENTRIES
+       JMP BLOOP       /NOT DONE WITH SEGMENT
+       CDF 10
+       TAD (400        /BUMP TO NEXT SEGMENT
+       TAD BDPTR
+       DCA BDPTR
+       TAD LFLAG       /DID WE PROCESS LAST SEGMENT
+       SZA CLA         /SKIP IF WE DID
+       JMP NBLOCK      /PROCESS NEW SEGNENT
+       TAD I (SFUDG    /RESET FREE CORE POINTER
+       DCA FPAGE       /TO PRESERVE INPUT HANDLER IF PRESENT
+       JMP I (SAYNON
+
+/HANDLE WILD CARDS
+
+WILDA, TAD CNT         /GET CURRENT CHAR POSITION
+       TAD (6          /ADD SIZE OF FILENAME
+       SPA             /SKIP IF IN EXTENSION FIELD
+       JMP WILDNM      /THIS BUMPS TO EXTENSION
+       JMP MEXT        /THIS MEANS IT HAS TO BE A MATCH
+
+
+CHAR,  0
+EPNEXT,        0
+GPTR2, 0
+LFLAG, 0
+NCNT,  0
+BLOCK, 0
+MATFLG,        0
+ENTCNT,        0
+
+
+       PAGE
+\fGOT1, DCA IFCNT       /-# OF BLOCKS IN AC
+       JMS I (DATCHK   /VERIFY IF /C OR /O ALSO MATCH
+       ISZ I (TYPFND   /COMES BACK IF THEY DO - 
+                       /TURN OFF NO FILES MSG FOR THIS INPUT GROUP
+       TAD I (OPT2     /CHECK FOR /T
+       AND (20
+       SNA CLA         /SKIP IF /T
+       TAD INFWDS      /SEE IF DATE PRESENT
+       CDF 0
+       SZA CLA         /SKIP IF NO DATE OR /T
+       TAD I GPTR1
+       CDF 10
+       SZA             /SKIP IF NO DATE OR /T
+       DCA I (DATE     /GIVE MONITOR FILES DATE
+       TAD (-4         /MAKE 2 COPIES
+       DCA CNT         /OF THE INPUT
+       CMA             /FILE NAME IN
+       TAD EPTR        /FIELD 1 TO
+       DCA XR          /WORK WITH THEM
+       TAD (SPOT-1     /MAKE THEM AT SPOT
+       DCA XR1         /AND SPOT1
+       TAD (SPOT1      /SPOT1 WILL ALWAYS
+       DCA PTR         /CONTAIN THE ORIGINAL
+MOVENT,        CDF 0           /AND SPOT WILL
+       TAD I XR        /CONTAIN THE
+       CDF 10          /UPDATED VERSION AS
+       DCA I PTR       /REFLECTED FROM
+       TAD I PTR       /THE OUTPUT SPECIFICATION
+       ISZ PTR         /-
+       DCA I XR1       /-
+       ISZ CNT         /-
+       JMP MOVENT      /-
+       TAD I (7601     /GET OUTPUT FILENAME
+       TAD (-5200      /WAS IT *
+       SNA CLA         /SKIP IF NOT
+       JMP TSTEXT      /YES... LEAVE FILENAME ALONE
+       TAD I (7601     /REPLACE INPUT NAME
+       DCA I (SPOT     /WITH GIVEN
+       TAD I (7602     /OUTPUT
+       DCA I (SPOT+1   /SPECIFICATION
+       TAD I (7603
+       DCA I (SPOT+2   /-
+TSTEXT,        TAD I (7604     /SEE IF EXTENSION
+       TAD (-5200      /WAS *
+       SNA CLA         /SKIP IF IT WASNT
+       JMP .+3         /LEAVE INPUT DEFAULT ALONE
+       TAD I (7604     /REPLCE EXTENSION
+       DCA I (SPOT+3   /WITH GIVEN EXTENSION
+       DCA TRFLG       /CLEAR THE TRANSFER FLAG
+       TAD I (OPT2     /IS /R ON?
+       AND (100
+       TAD I (SDFLG    /OR /D OR INPUT DEV=OUTPUT DEV?
+       SNA             /SKIP IF ANY
+       JMP SETGD       /WE ARE DEFINITELY OK
+       SMA CLA         /IF /D THEN CHECK OUTPUT
+       TAD (SPOT1-SPOT /OTHERWISE INPUT
+       JMS I (LOOKUP
+       JMP NSETGD      /NO OUTPUT FILE GIVEN
+       SNA             /AC=BLOCK NO OF FILE OR 0 IF NONE
+       JMP I (NENT     /NO FILE - DO NOTHING
+       DCA TEMP        /SAVE - WE MIGHT NEED IT
+       TAD I (SDFLG    /IF OPERATION IS TRANSFER THEN
+                       /TRFLG IS SET IF FILE HAS NOT
+                       /MOVED; IF /D TRFLG MUST NOT BE
+                       /SET ; WE DONT CARE ABOUT
+                       /RENAME - ITS IRRELEVANT.
+       SMA CLA         /SKIP IF /D- WILL CAUSE TRFLG=0
+       TAD TEMP        /GET THE BLOCK FILE IS NOW AT
+       CIA             /CHECK AGAINST ORIGINAL
+       TAD I (BLOCK    /LOCATION
+       SNA CLA         /SKIP IF IT MOVED - NOTE THAT
+                       /IF THIS SKIPS THE USER IS DOING
+                       /A PLAY WITH DEATH OPERATION
+SETGD, ISZ TRFLG       /ENABLE TRANSFERING OF THE FILE
+NSETGD,        TAD I (SDFLG    /SET UP TO PROMPT OR LIST
+       SPA CLA         /SKIP IF NOT /D
+       TAD (SPOT-SPOT1 /USE OUTPUT NAME
+       TAD (SPOT1+4    /USE INPUT NAME
+       JMS I (PRINTE   /SEE IF HE WANTS TO BE PROMPTED
+FLSRSM,        TAD I (OPT2
+       RTL             /PUT /N INTO LINK
+       AND (400        /ISOLATE /R OPTION
+       SZA CLA         /SKIP IF NOT /R
+       JMP I (RENAME   /GO TO RENAME CODE
+       TAD I (SDFLG    /CHECK FOR NO /D AND SAME DEV
+       SPA SNA CLA     /SKIP IF NO /D AND SANE DEV
+       TAD I (7600     /IS THERE AN OUTPUT?
+       SNA SZL         /SKIP IF NO /N AND OUTPUT DEV
+                       /DIDNT SKIP IF NO /D AND SAME DEVICE
+       JMP NODEL       /DONT DELETE
+       JMS I (FAKUSR   /FAKE USR HANDLER CALLS
+       JMS I (200      /CALL USR
+       4               /CLOSE
+       SPOT            /OUTPUT FILE NAME
+       0
+       CLA SKP         /O.K. TO GET CLOSE ERROR NOW
+       ISZ I (WRTDIR   /SIGNAL CHANGE MADE TO DIRECTRY
+       JMS I (UNFAK    /FIXUP HANDLER ADDRESS AGAIN
+NODEL, CLA
+       TAD TRFLG       /SET AC NOT 0 IF TRANSFER GO AHEAD
+       JMP I (NPG      /LINK TO SOME MORE
+
+TRFLG, 0
+
+
+       PAGE
+\f/THIS PAGE OF CODE PERFORMS FILE MOVES FROM
+/INPUT TO OUTPUT
+
+NPG,   SNA CLA         /SKIP IF WE CAN DO TRANSFER
+       JMP NFUNCT      /GO PROCESS NEXT ENTRY
+
+/THE FOLLOWING SMALL STRANGE PIECE OF CODE
+/DYNAMICALLY ALLOCATES THE BUFFER ACCORDING
+/TO THE FREE SPACE IN FIELD 0 (INCLUDING
+/DIRECTORY SHRINKING) OR ALLOCATES 15 BLOCKS
+/IN FIELD 2 IF ITS AVAILABLE.
+
+F2C1,  TAD (7400       /BECOMES  TAD EPTR  IF ONLY 8K
+       AND (7400       /CALCULATE FREE SPACE
+       RAL CLL         /SIZE
+       RTL             /AND SAVE
+       RTL             /IT
+       DCA BUFSIZ
+       TAD IFCNT       /SET THE OUTPUT 
+       CIA             /FILE COUNT
+       DCA OFCNT       /AS POSITIVE NIMBER OF BLOCKS
+       TAD OFCNT       /SET THE NUMBER
+       AND (7400       /OF BLOCKS
+       SNA CLA         /UP FOR ENTER
+       TAD OFCNT       /IF IT IS LESS
+       RTL CLL         /THAN 256 OR
+       RTL             /SET IT TO 0
+       DCA TEMP        /FOR FILES GREATER THAN 256
+       TAD (SPOT       /SET THE ADDRESS OF THE
+       DCA SBLKN       /OUTPUT NAME
+       TAD I (7600     /IS THERE AN OUTPUT FILE?
+       SNA             /SKIP IF THERE IS
+       JMP NFUNCT      /DO NO TRANSFER
+       TAD (7757       /INDEX INTO TENTATIVE FILE
+       DCA MSIZE       /TABLE IN ORDER TO
+       TAD I MSIZE     /CLEAR OUT ANY
+       AND (7770       /TENTATIVE WE DONT WANT
+       DCA I MSIZE     /THIS COMES IF AN I/O ERROR HIT
+       TAD I (7600     /DO THE ENTER
+       JMS I (FAKUSR   /MAKE USR USE IN CORE HANDLER
+       TAD TEMP        /ADD IN BLOCK COUNT
+       JMS I (200
+       3               /ENTER
+SBLKN, SPOT
+MSIZE, 0
+       JMP I (NOROOM   /ENTER FAILED
+       TAD I (SVDATE   /RESTORE REAL DATE TO MONITOR
+       DCA I (DATE
+       JMS I (UNFAK    /REMOVE OUR FAKE HANDLER
+       JMS I (ADDINF   /COPY ADDITIONAL INFO WORDS
+       TAD IFCNT       /SEE IF ENTER SIZE
+       STL CIA         /GIVEN BACK IS
+       TAD MSIZE       /ENOUGH - HANDLES >255 AND
+       SNL SZA CLA     /NON FILE STRUCTURED
+       JMP I (NOROOM   /LENGTHS. NOT ENOUGH
+       DCA INEOF       /CLEAR INPUT END OF FILE
+       TAD SBLKN       /SET THE OUTPUT BLOCK NUMBER
+       DCA OBLCKN
+       TAD I (BLOCK    /SET THE INPUT BLOCK NUMBER
+       DCA BLOCKN
+
+\f/THE FOLLOWING PIECE OF CODE IS A TRICKY PIECE
+/THAT CALCULATES THE NUMBER OF BLOCKS TO READ
+
+MOVEIT,        TAD IFCNT       /GET THE NUMBER OF BLOCKS
+       CLL             /ITS NEGATIVE
+       TAD BUFSIZ      /ADD ON BUFFER SIZE
+       SNL             /SKIP IF MORE ROOM AVAILABLE THAN NEEDED
+       DCA IFCNT       /OTHERWISE RESAVE NEW COUNT
+       SZL             /SKIP IF NOT AT END OF FILE
+       ISZ INEOF       /SET END OF FILE INDICATOR
+       CIA             /MAKES -BUFSIZ+COUNT
+       TAD BUFSIZ      /MAKES COUNT OF NUMBER OF BLOCK
+       RTR CLL         /BUILD THE
+       RTR             /INPUT CONTROL
+       RTR             /WORD
+F2C2,  TAD (20         /BECOMES NOP IF ONLY 8K
+       DCA INCTLW      /SET INPUT CONTROL WORD
+       JMS I (CINTER   /CHECK FOR ^C
+       SKP             /SKIP IF NOT
+       JMP I (CTCDE    /ABORT OPERATION
+       CIF 0
+       JMS I INHAND    /READ INPUT HUNK
+INCTLW,        0
+       0
+BLOCKN,        0
+       JMP I (RDERR    /WELL- SCRATCH THAT FILE
+       TAD BLOCKN      /UPDATE BLOCK COUNT
+       TAD BUFSIZ
+       DCA BLOCKN
+       AC4000          /SET THE OUTPUT
+       TAD INCTLW      /CONTROL WORD
+       DCA OUCTLW
+       JMS I (CINTER   /CHECK FOR ^C
+       SKP             /SKIP IF NOT
+       JMP I (CTCDE    /ABORT OPERATION
+       ISZ I (MUSTWT   /SIGNAL REAL OUTPUT DONE
+       CIF 0
+       JMS I OUHAND    /WRITE A HUNK OF FILE
+OUCTLW,        0
+       0
+OBLCKN,        0
+       JMP I (WRTERR   /WHAT A CRUMBY OUTPUT DEVICE
+       TAD OBLCKN      /UPDATE THE
+       TAD BUFSIZ      /OUTPUT FILE
+       DCA OBLCKN      /BLOCK NUMBER
+       TAD INEOF       /SEE IF THATS ALL FOLKS
+       SNA CLA         /SKIP IF WE TRANSFERED FILE
+       JMP MOVEIT      /DO SOME MORE
+       TAD I (7600     /OK - LETS MAKE IT PERMANENT
+       JMS I (FAKUSR   /TELL USR TO USE INCORE HANDLER
+       JMS I (200
+       4               /CLOSE
+       SPOT
+OFCNT, 0
+       JMP I (CLOERR   /THIS IS IMPOSSIBLE (I HOPE)
+       JMS I (UNFAK    /ENABLE SYSTEM USE OF REAL HANDLER
+       ISZ I (WRTDIR   /SET WE CHANGED DIRECTORY FLAG
+NFUNCT,        JMP I (NENT     /I KNOW ITS INEFFICIENT TO JUMP HERE
+                       /BUT- IT'S CLEAN...
+       PAGE
+\f/HERE COMES GOBBS AND GOBBS OF GOODY LITTLE ROUTINES
+
+/FIRST WE HAVE A NICE LITTLE ROUTINE WHICH WILL DO
+/HANDY LITTLE THINGS LIKE FETCH A HANDLER
+/AND IN ADDITION ALLOCATE THE SPACE FOR IT.
+/JUST IMAGINE THIS CAN BE YOURS FOR THE LOW LOW PRICE
+/OF 23 INSTRUCTIONS
+
+ASSIGN,        0
+       DCA TEMP        /SAVE DEVICE NUMBER
+       TAD TEMP
+       JMS I (200
+       12              /INQUIRE ABOUT HANDLER
+HADDR1,        0
+       JMP I (CLOERR   /CANT HAPPEN (I HOPE)
+       TAD HADDR1      /DID WE GET BACK ADDRESS
+       SZA             /SKIP IF NOT- NON-RESIDENT
+       JMP I ASSIGN    /YES... RETURN ITS ENTRY POINT
+       SKP
+TWOPAG,        IAC             /TURN ON 2-PAGE BIT
+       TAD FPAGE       /GET FREE SPACE POINTER
+       DCA HADDR2      /SET FOR FETCH
+       TAD FPAGE       /TAKE AWAY
+       TAD (-200       /PAGE FROM
+       DCA FPAGE       /FREE SPACE
+       TAD TEMP        /GET DEVICE NUMBER
+       JMS I (200
+       1               /FETCH
+HADDR2,        0
+       JMP TWOPAG      /FAILED- MUST BE 2-PAGER
+       TAD HADDR2      /RETURN ENTRY POINT ADDRESS
+       JMP I ASSIGN
+\f/THIS UTILITY ROUTINE RETURNS A SIS BIT
+/CHARACTER FROM ANY FIELD (SET ON ENTRY)
+/FROM ADDRESS IN AC-COUNT(IN HALF WORDS)
+
+GTSXBT,        HLT
+       CLL RAL         /DOUBLE POINTER ADDRESS
+       TAD CNT         /ADD NEGATIVE DISPLACEMENT
+       CML RAR         /GET WORD ADDRESS AGAIN
+       DCA TEMP        /SAVE IT
+       TAD I TEMP      /GET WORD
+       SNL             /SKIP IF WE WANT RIGHT HALF
+       JMS ROTR6       /MAKE LEFT HALF RIGHT HALF
+       AND (77         /GET LOW SIX BITS
+       JMP I GTSXBT
+
+
+ROTR6, 0
+       RTR
+       RTR
+       RTR
+       JMP I ROTR6
+
+/THIS TAKES A SIX BIT CHAR IN AC AND CONVERTS
+/IT TO ASCII TO TYPE IT
+
+CONVTP,        HLT
+       SZA             /CONVERT 0 TO BLANKS
+       TAD (240
+       AND (77
+       TAD (240
+       JMS I (TYPE     /TYPE IT
+       JMP I CONVTP
+\f/TYPE TAKES A CHARACTER IN THE AC AND CALLS
+/TTY TO TYPE IT IF ^O IS NOT IN AFFECT
+/ALSO CHECKS FOR ^C AND ^P
+
+TYPE,  HLT
+       DCA READKB      /SAVE CHARACTER
+       JMS I (CINTER   /SEE IF ^C
+       SKP             /NO
+       JMP I (CTCDE    /ABORT OPERATION IF ^C OR ^P
+       TAD (217        /^O
+       JMS I (CTYPE    /SEE IF TYPED
+       SKP             /SKIP IF NOT
+       DCA ECHO        /CLEAR ECHO SWITCH
+       TAD ECHO        /IS ECHO IN EFFECT
+       SNA CLA         /SKIP IF YES
+       JMP I TYPE      /IGNORE CHARACTER IF ^O
+       TAD READKB      /TYPE CHAR
+       JMS TTY
+       JMP I TYPE
+
+TTY,   0
+       DCA TCHAR       /SAVE CHAR
+       TAD TCHAR       /GET CHAR BACK
+                       /** NEXT 4 LOCATIONS REPLACED IF BATCH ACTIVE BY:
+TTYOUT,        TLS             /** SKP
+       TSF             /** 7400        /ADDRESS OF BATCH OUTPUT ROUTINE
+       JMP .-1         /** CIF TOPFIELD
+       CLA             /** JMS I .-2
+       TAD TCHAR       /GET CHAR AGAIN
+       TAD (-215       /IF WE JUST TYPED A C.R. TYPE
+       SZA CLA         /A L.F.
+       JMP I TTY
+       TAD (12
+       JMP TTY+1
+TCHAR, 0
+
+/GET A CHARACTER FROM KEYBOARD AND
+/CHECK FOR ^C AND ^P
+
+READKB,        HLT
+       KSF
+       JMP .-1
+       JMS I (CINTER   /IS IT ^C
+       SKP             /SKIP IF NOT
+       JMP I (CTCDE    /YES
+       KRB             /READ IT
+       AND (177        /AND GET RID OF
+       TAD (200        /PARITY
+       JMP I READKB
+\f/ROUTINE TO MAKE SURE USER SPECIFIED
+//C AND /O SWITCHES CAUSE CORRECT MATCH WITH DATE
+
+DATCHK,        0
+       TAD I (OPT1     /CHECK /C
+       JMS MDATE
+       NOP             /RETURN HERE WITH AC=0 IF NO /C
+       SZA CLA         /RETURN HERE WITH AC=0 IF DATES MATCH
+       JMP I (NENT     /DATES DONT MATCH AND /C GIVEN
+       TAD I (OPT2     /CHECK /V
+       JMS MDATE
+       CMA CLA         /SET AC=-1 IF NO /V
+       SNA CLA         /RETURN HERE AC=0 IF DATES SAME
+       JMP I (NENT     /DATES SAME WITH /V-IGNORE FILE
+       JMP I DATCHK    /CONTINUE
+
+MDATE, 0               //O AND /V ARE AC2
+       RTL             /IS IT OPTION ON?
+       SMA CLA         /SKIP IF IT IS
+       JMP I MDATE     /NO- RETURN WITH 0 AC
+       ISZ MDATE       /SKIP RETURN
+       CDF 0
+       TAD I GPTR1     /GET DATE WORD
+       CIA
+       CDF 10
+       TAD I (SVDATE   /COMPARE WITH MONITORS, 0 IF =
+       JMP I MDATE
+
+ECHO,  1
+
+
+       PAGE
+\f/THIS IS THE CORE DEVICE HANDLER
+/THE USR IS MADE TO COME HERE BY A CALL TO FAKUSR.
+/THIS HANDLER SWAPS THE DESIRED BLOCK INTO
+/THE USR AREA AND WRITES THE BLOCK BACK INTO THE
+/INCORE DIRECTORY.
+
+/THE CODE SET UP IN FIELD 0 TO CALL THE HANDLER IS:
+/      *FAKHND
+/      0               /ENTRY POINT
+/      TAD FAKHND      /GET RETURN ADDRESS
+/      CIF CDF 10
+/      JMP I .+1       /PLOP UP TO BODY OF HANDLER IN FIELD 1
+/      FAKBDY
+
+
+FAKBDY,        DCA RETLOC      /SAVE ARGUMENT ADDRESS
+       TAD I RETLOC    /GET CONTROL WORD
+       RAL             /R/W BIT INTO LINK
+       CLA RAL         /R/W BIT INTO AC11
+       TAD DCAXR1      /IF WRITE MAKE DCA XR2 ELSE XR1
+       DCA DCASPT      /SAVE WHERE WE NEED IT
+       ISZ RETLOC      /BUMP TO LOCATION (ALWAYS 1400 FROM USR)
+       ISZ RETLOC      /BUMP TO BLOCK NUMBER
+       TAD I RETLOC    /GET IT
+       ISZ RETLOC      /BUMP TO ERROR RETURN
+       ISZ RETLOC      /NOW TO GOOD RETURN (WE WONT FAIL)
+       CLL RTR         /MULTIPLY BY 400(8)
+       RTR
+       RAR
+       TAD (4177       /ADD ON TO BEGINING OF DIRECTRY
+DCAXR1,        DCA XR1         /SAVE IN BOTH XR1
+       TAD XR1
+       DCA XR2         /AND XR2
+       TAD (1377       /NOW SAVE USR BLOCK AREA
+DCASPT,        HLT             /IN EITHER XR1 OR XR2 (R OR W)
+       TAD (-400       /SET WORD TRANSFER COUNT 
+       DCA CNT
+       TAD I XR2       /GET A WORD
+       DCA I XR1       /PUT A WORD
+       ISZ CNT
+       JMP .-3
+       JMP I RETLOC    /GO BACK TO USR
+\f/THIS ROUTINE DOES THE SETUP OF THE INCORE
+/DIRECTORY HANDLER AND CHANGES THE REAL
+/HANDLERS ENTRY POINT IN THE MONITOR SO THAT
+/THE USR WILL CALL IT.
+
+FAKUSR,        0
+       DCA UNFAK       /SAVE DEVICE NUMBER
+       TAD UNFAK       /INDEX INTO MONITORS RESIDENCY
+       TAD (7646       /TABLE
+       DCA TABAD
+       TAD WRTDIR      /SEE IF DEVICE HAS DIRECTORY
+       SPA CLA         /SKIP IF IT DOES
+       JMP NOSUBST     /!!!DONT CHANGE IF NON-FILE DEV
+       TAD (FAKHND     /PUT OUR HANDLERS ADDRESS IN
+       DCA I TABAD     /MONITORS TABLE
+NOSUBST,CDF 0
+       TAD (1200       /PUT IN HANDLER INTERFACE CODE
+       DCA I (FAKHND+1 /INTO FIELD 0 AS GIVEN ABOVE
+       TAD (CIF CDF 10
+       DCA I (FAKHND+2
+       TAD (5604
+       DCA I (FAKHND+3
+       TAD (FAKBDY
+       DCA I (FAKHND+4
+       CDF 10
+       TAD UNFAK       /RETURN WITH DEVICE NUMBER IN AC
+       JMP I FAKUSR
+
+UNFAK, 0
+       CLA             /V3C
+       TAD OUHAND      /RESET MONITORS TABLE TO
+       DCA I TABAD     /POINT TO REAL HANDLER
+       DCA TABAD       /V3C
+       JMP I UNFAK
+
+TABAD, 0
+RETLOC,        0
+\f/ENTER HERE IF A BRANCH TO 7600 OR 7605 OCCURS
+
+FIXDIR,        JMS UNFAK       /JUST IN CASE
+       JMS I (CINTER   /CHECK FOR ^C
+       NOP
+       AC4000          /EITHER WAY GO BACK TO
+       DCA I (ALTOPT   /MONITOR BUT AFTER WE HANDLE DIRECTORY
+CTCDE, TAD MUSTWT      /IS MUST WRITE SET?
+       SNA CLA         /SKIP IF /Q OR MUST WRITE
+       TAD WRTDIR      /CHECK TO SEE IF WE HAVE TO
+       SPA SNA CLA     /WRITE THE DIRECTORY
+       JMP ENDCHK      /CONTINUE
+       DCA WRTDIR      /KEEP OLD DIRECTORY
+       JMS I (ERROR    /TELL HIM
+       DSVED+40
+
+ENDCHK,        ISZ I (ECHO     /TURN ON ECHO
+       JMS DIROUT      /WRITE OUT THE OUTPUT DIRECTORY
+       JMS I (RESTORE  /RESTORE 7600 IN FIELD 0
+       TAD I (OPT2     /GET OPTION /W
+       RTR
+       SNL CLA         /SKIP FOR VESION NUMBER
+       JMP NOVER
+       DCA I (OPT2     /STOPS RECUSION WITH ^P
+       JMS I (ERROR    /PRINT VERSION NUMBER
+       VERNO+40
+       TAD (215
+       JMS I (TYPE
+NOVER, TAD I (ALTOPT   /GO BACK TO MONITOR?
+       SMA CLA         /SKIP IF YES
+       JMP I (CDCALL   /CALL THE CD AGAIN
+       CIF CDF 0       /RETURN TO MONITOR
+       JMP I (7605
+
+
+MUSTWT,        0
+SVDATE,        0
+WRTDIR,        0
+\fDIROUT,       0               /ROUTINE TO WRITE THE OUTPUT DIRECTORY
+       TAD WRTDIR      /AC>0 IF WE HAVE TO WRITE IT
+       SPA SNA CLA     /SKIP TO WRITE DIRECTORY
+       JMP I DIROUT
+       CIF 0
+       JMS I OUHAND    /WRITE DIRECTORY BACK ONTO DEVICE
+       5410
+       4600
+       1
+       JMP I (ODERR    /IS HE IN TROUBLE...
+       DCA WRTDIR      /CLEAR WRITE DIRECTORY FLAG
+       JMP I DIROUT    /RETURN
+       PAGE
+\f/ROUTINE WHICH ECHOES ^(CHAR) AND SKIP RETURNS IF
+/ONE WE WANTED
+
+CTYPE, 0
+       DCA T2          /SAVE CHARACTER
+       TAD (200        /GT RID OF PARITY
+       KRS             /SEE WHATS IN BUFFER
+       CIA
+       TAD T2          /COMPARE AGAINST DESIRED ONE
+       SNA CLA         /SKIP IF NOT ONE
+       KSF             /IS FLAG UP?
+       JMP I CTYPE     /NO... JUST RETURN
+       KCC             /CLEAR CHARACTER
+       TAD ("^         /OUTPUT ^
+       JMS I (TTY
+       TAD T2
+       TAD (100        /CHAR
+       JMS I (TTY
+       TAD (215
+       JMS I (TTY
+       ISZ CTYPE       /SKIP RETURN
+       JMP I CTYPE
+
+T2,    0
+
+/ROUTINE USED TO DETERMINE IF ^C OR ^P TYPED
+
+CINTER,        0
+       TAD (203        /CHECK FOR ^C
+       JMS CTYPE
+       JMP UPPCK       /NO  CHECK FOR ^P
+       JMP SPURGE      /YES SET ALTMODE BIT
+UPPCK, TAD (220
+       JMS CTYPE
+       JMP I CINTER    /NOT EITHER ^P OR ^C
+       SKP             /IF ^P CLEAR ALTMODE BIT
+SPURGE,        CMA             /SET BIT
+       DCA I (ALTOPT
+       ISZ CINTER      /SKIP RETURN
+       JMP I CINTER
+\f/THIS ROUTINE MODIFIES THE THE MONITOR RETURN
+/LOCATIONS TO COME BACK TO FOTP AND SAVES WHAT
+/WAS THERE SO RESTORE CAN RESTORE THEM
+
+INTERC,        0
+       TAD I (DATE
+       DCA I (SVDATE   /SAVE MONITOR DATE
+       CDF 0
+       TAD I (7600     /SAVE 7600,7601,7602,7605
+       DCA SCODE       /AND REPLACE WITH
+       TAD (CIF CDF 10 /CIF CDF 10
+       DCA I (7600     /JMP I .+1
+       TAD I (7601     /FIXDIR
+       DCA SCODE+1     /7605 GETS JMP 7600
+       TAD (5602       /THIS ENABLES FOTP TO WRITE
+       DCA I (7601     /OUT DIRECTORY AN MANUAL ABORT
+       TAD I (7602     /OR IF HANDLER PICKS UP ^C
+       DCA SCODE+2     /AND TRIES TO GO TO MONITOR
+       TAD (FIXDIR
+       DCA I (7602
+       TAD I (7605
+       DCA SCODE+3
+       TAD (5200
+       DCA I (7605
+       CDF 10
+       JMP I INTERC
+
+/THIS ROUTINE SIMPLY RESTORES THE MONITOR
+/LOCATIONS TO THEIR ORIGINAL VALUE
+
+RESTORE,0
+       TAD I (SVDATE   /RESTORE DATE
+       DCA I (DATE
+       CDF 0
+       TAD SCODE
+       DCA I (7600     /RESTORE LOCATIONS
+       TAD SCODE+1
+       DCA I (7601
+       TAD SCODE+2
+       DCA I (7602
+       TAD SCODE+3
+       DCA I (7605
+       CDF 10
+       JMP I RESTORE
+
+SCODE, 0;0;0;0
+\f/THIS IS THE MAGIC MESSAGE PRINTER
+/IT IS ACTUALLY USED MORE THAN JUST FOR ERROR MESSAGES
+/IF THE MESSAGE ENDS WITH A % THEN THE OPERATION
+/IS ABORTED OTHERWISE CONTROL IS RETURNED
+/TO THE CALLER AND NO CRLF IS GIVEN
+/ALL MESSAGES COMMING THROUGH HERE ARE ECHOED
+
+ERROR, 0
+       CLA CLL         /JUNK MIGHT BE IN AC
+       TAD I (ECHO     /SAVE ECHO STATUS SO WE CAN
+       DCA I (ECTMP    /RESTORE IT AFTER MESSAGE
+       ISZ I (ECHO     /TURN ON ECHO
+       TAD (-100       /USED SO WE CAN USE GTSXBT TO
+       DCA CNT         /UNPACK THE MESSAGES
+PLOOP, TAD I ERROR     /CONTAINS ADDRESS OF MESSAGE
+       CDF 0           /IN FIELD 0
+       JMS I (GTSXBT   /GET CHARACTER
+       CDF 10
+       TAD (-45        /IS IT %
+       SNA             /SKIP IF NOT
+       JMP CRLF        /WE HIT EOM AND CALLER NO WANT CONTROL
+       TAD ("%&77      /RESTORE CHARACTER
+       DCA DFLAG       /SAVE IT FOR LATER
+       TAD DFLAG       /PRINT IT, 0 PRINTS AS BLANK
+       JMS I (CONVTP
+       ISZ CNT         /BUMP TO NEXT CHAR IN MESSAGE
+       TAD DFLAG       /ARE WE AT END
+       SZA CLA         /SKIP IF WE ARE
+       JMP PLOOP       /DO ANOTHER CHARACTER
+       ISZ ERROR       /SKIP ADDRESS OF MESSAGE
+       JMP I ERROR     /RETURN
+CRLF,  TAD (215        /PRINT CR
+       JMS I (TYPE     /LF
+       JMP I (ENDCHK   /FINISH PROCESSING
+
+DFLAG, 0
+       PAGE
+\f/THIS ROUTINE PRINTS A FILENAME.EXTENSION
+
+PNMSUB,        0
+       DCA NMEPLC      /SAVE ADDRESS OF NAME
+       TAD (-10        /SET CHAR COUNT
+       DCA CNT
+PNLOOP,        TAD NMEPLC      /GET THE SIXBIT CHAR
+       JMS I (GTSXBT
+       SZA             /SKIP IF NULL CHAR
+       JMS I (CONVTP   /PRINT CHAR
+       TAD (3          /SEE IF AT START OF
+       TAD CNT         /EXTENSION
+       SZA CLA         /SKIP IF SO
+       JMP .+3
+       TAD (".         /PRINT THE DOT
+       JMS I (TYPE
+       ISZ CNT
+       JMP PNLOOP      /KEEP GOING
+       JMP I PNMSUB
+
+NMEPLC,        0
+ECTMP, 0
+
+RDERR, JMS I (ERROR
+       INERR+40        /ERROR READING FILE
+DYSTF1,        TAD (SPOT1+4    /PRINT INPUT FILE NAME
+DYSTUF,        JMS I (PNMSUB
+       TAD (215
+       JMS I (TYPE
+       TAD ECTMP       /RESTORE ECHO FLAG AS
+       DCA I (ECHO     /SAVED ON ENTRY TO ERROR
+       JMP I (NENT     /GO TO NEXT FILE
+WRTERR,        JMS I (ERROR
+       OUERR+40        /ERROR WRITING FILE
+POUTNM,        TAD (SPOT+4     /PRINT OUTPUT FILE NAME
+       JMP DYSTUF
+NORUMX,        JMS I (ERROR    /NOT ENOUGH ROOM FOR
+       SPRBLM+40       /FILE ON OUTPUT DEVICE
+       JMP DYSTF1
+\f/ROUTINE WHICH PRINTS NO FILES MSG IF NECESSARY
+/IT WONT PRINT MESSAGE IF ANY FILE IN A SO CALLED
+/INPUT GROUP MATCHES(A BUG?)
+
+SAYNON,        TAD I (TYPFND   /GET INPUT MATCH FLAG
+       SZA CLA         /SKIP IF NOTHING MATCHED
+       JMP GOBCK       /DONT DO MESSAGE
+TLP,   JMS I (ERROR    /PRINT MESSAGE
+       NOFILE+40
+       TAD INFPTR      /POINT TO END OF INPUT ENTRY
+       TAD (5          /TO MAKE GTSXBT WORK CORRECTLY
+       DCA INFPTR
+       TAD INFPTR      /PRINT THE FILE NAME
+       JMS I (PNMSUB
+       TAD (OTAB-2     /NOW PRINT /V,/C,/O IF
+       DCA XR2         /ANY OF THEM SPECIFIED
+NOPT1, ISZ XR2         /FIX POINTER WHEN SWITCH NOT ON
+NOPT,  TAD I XR2       /GET ADDRESS OF OPTION
+       SNA             /SKIP IF NOT AT END
+       JMP CRIT        /WE ARE AT END
+       DCA TEMP
+       TAD I TEMP      /GET OPTION WORD
+       AND I XR2       /AND WITH OPTION BIT
+       SNA CLA         /SKIP IF OPTION GIVEN
+       JMP NOPT1       /DO ANOTHER
+       TAD ("/         /PRINT /
+       JMS I (TYPE
+       TAD I XR2       /OPTION
+       JMS I (TYPE
+       JMP NOPT        /DO ANOTHER
+CRIT,  TAD (215        /END WITH A CRLF
+       JMS I (TYPE
+       TAD ECTMP       /RESTORE ECHO FLAG THAT ERROR
+       DCA I (ECHO     /SAVED
+       ISZ INSCNT      /PRINT MESSAGE FOR ALL FILES
+       JMP TLP         /IN GROUP
+GOBCK, TAD I (USEROD   /GET USER SPECIFIED DEVICE
+       SNA CLA         /SKIP IF HE GAVE ONE
+       TAD I (SDFLG    /IF HE DIDNT WE CANT HANDLE /D
+       SPA CLA         /SKIP IF NO /D
+       TAD I MOIN      /YEP. /D BETTER NOT BE ANY MORE INPUT
+       SZA CLA         /THERE WASN'T - O.K.
+       JMP DELERR      /WARN HIM OF THE SHORTCOMING
+       TAD MOIN        /GET SAVED INPUT POINTER
+       JMP I (DOMOIN   /AND DO SOME MORE INPUTS
+
+DELERR,        JMS I (ERROR
+       CNTDEL+40       /MULTIPLE DEVICE DELETE
+       TAD (215
+       JMS I (TYPE
+       JMS I (ERROR
+       CNTDE2+40
+
+USEROD,        0
+MOIN,  0
+\f/TABLE OF SWITCHES FOR "NO FILES" MESSAGE
+
+OTAB,  OPT2
+       4
+       "V
+       OPT1
+       1000
+       "C
+       OPT2
+       1000
+       "O
+       0
+
+       PAGE
+\f/THIS ROUTINE HANDLES THE /L AND /Q OPTIONS
+/IF EITHER IS ON IT PRINTS THE NAME
+/THEN IF ITS /Q IT PRINTS A ? AND WAITS FOR
+/A RESPONSE. IF Y IT RETURNS, ANYTHING ELSE
+/AND IT GOES TO PROCESS THE NEXT DIRECTORY ENTRY
+
+PRINTE,        0
+       DCA I (NMEPLC   /SAVE ADDRESS OF NAME
+       TAD I (OPT1     /CHECK /L
+       RAR
+       SZL CLA         /SKIP IF NO /L
+       JMP PIT         /PRINT NAME
+       TAD I (OPT2     /CHECK /Q
+       AND (200
+       SNA CLA         /SKIP IF /Q
+       JMP I PRINTE    /RETURN
+       ISZ I (ECHO     /IF /Q FORCE ECHO ON
+PIT,   TAD I (NMEPLC   /NOW PRINT FILENAME
+       JMS I (PNMSUB
+       DCA OKFLAG      /CLEAR OKFLAG
+       TAD I (OPT2     /WAS IT /Q?
+       AND (200
+       SNA CLA         /SKIP IF /Q
+       JMP FUNCT2      /JUST PRINT CRLF
+       TAD ("?         /PRINT ?
+       JMS I (TYPE
+       CMA             /SET OKFLAG NO GOOD
+       DCA OKFLAG
+       JMS I (READKB   /GET A CHAR
+       TAD (-"Y        /IS IT Y?
+       SNA CLA         /SKIP ON NO
+       ISZ OKFLAG      /IT WAS Y, SET OK AND SKIP
+       TAD ("N-"Y      /GET N
+       TAD ("Y         /GET Y
+       JMS I (TYPE     /ECHO IT
+FUNCT2,        TAD (215        /PRINT CRLF
+       JMS I (TYPE
+       TAD OKFLAG      /OKFLG=0 MEANS YES
+       SZA CLA         /SKIP IF TO PROCESS FILE
+       JMP I (NFUNCT   /SKIP THIS FILE
+       JMP I PRINTE    /RETURN
+
+ODERR, CLA
+       DCA I (WRTDIR   /FIX RECURSION
+       JMS I (ERROR
+       ODIERR+40       /ERROR WRITING DIRECTORY
+BODIR, JMS I (ERROR
+       BODORM+40       /BAD OUTPUT DIRECTORY
+CLOERR,        JMS I (ERROR
+       SERR+40         /SYSTEM ERROR
+       HLT             /DONT LET HIM CONTINUE
+       JMP .-1         /IT CAN ONLY GET WORSE
+
+SPOT,  ZBLOCK 4        /ROOM FOR OUTPUT FILE NAME
+SPOT1, ZBLOCK 4        /ROOM FOR INPUT FILE NAME
+\f/CODE TO HANDLE OUT OF ROOM CONDITION ON OUTPUT DEVICE
+
+NOROOM,        JMS I (UNFAK    /RESTORE THE REAL OUTPUT HANDLER
+       TAD I (OPT1
+       AND (100        /CHECK FOR THE /F OPTION SPECIFIED
+       SNA CLA
+       JMP I (NORUMX   /NO - GIVE AN ERROR MESSAGE
+       JMS I (DIROUT   /FAILSAFING - WRITE OUT THE OUTPUT DIRECTORY
+       JMS I (ERROR    /PRINT THE MESSAGE
+       FLSFMS+40       /"MOUNT NEXT OUTPUT VOLUME"
+       JMS I (READKB   /GET AN ANSWER
+       CLA             /ANY CHAR EXCEPT ^C OR ^P IS YES
+       TAD (215
+       JMS I (TYPE     /PRINT CRLF
+       JMS ODIRIN      /READ IN THE NEW OUTPUT DIRECTORY
+       JMP I (FLSRSM   /RECOMPUTE THE PENDING TRANSFER.
+
+ODIRIN,        0               /SUBROUTINE TO READ IN THE OUTPUT DIRECTORY
+       TAD I (7600     /GET OUTPUT DEVICE NUMBER
+       SNA             /IS IT PRESENT?
+       JMP NOUTFL      /NO - DON'T READ OUTPUT DIRECTORY
+       TAD (7757       /ADD ADDRESS OF MONITOR TABLE
+       DCA TEMP        /TO INDEX INTO IT
+       TAD I TEMP      /FILE STRUCTURED BIT IS 0
+       SMA CLA         /SKIP IF DIRECTORY DEVICE
+       JMP NOUTFL      /WE DONT WANT TO READ OR WRITE DIRECTORY
+       CIF 0
+       JMS I OUHAND    /READ DIRECTORY
+       1410
+ODBUF, OUBUFR
+       1
+       JMP I (ONDERR   /ERROR
+       TAD I ODBUF
+       CMA CLL         /CHECK FOR LEGAL OUTPUT DIRECTORY - FIRST
+       TAD I (OUBUFR+2 /WORD OF AN OS/8 DIRECTORY IS .LT. 50
+       SNL             /AND THE THIRD WORD MUST BE .LT. 7,
+       TAD (7700       /SO WE CAN CHECK FOR THE SUM OF THOSE
+       SZL CLA         /WORDS BEING .LT. 64
+       JMP I (BODIR    /ERROR - CANT BE DIRECTORY
+       SKP
+NOUTFL,        AC4000          /WRTDIR MINUS MEANS DONT WRITE
+       DCA I (WRTDIR   /DIRECTORY
+       DCA I (MUSTWT   /CLEAR THE MUST WRITE FLAG
+       DCA DIRKEY      /CLEAR THE OS/8 DIRECTORY KEY
+       JMP I ODIRIN    /RETURN
+       PAGE
+\f/SUBROUTINE TO DO LOOKUPS ON OUTPUT DEVICE
+/DOES IMMEDIATE RETURN IF NO OUTPUT DEVICE
+/OTHERWISE RETURNS WITH BLOCK OF FILE IN AC   OR
+/0 IN AC MEANING NOT FOUND OR NON-FILE STRUCTURED DEVICE
+LOOKUP,        0
+       TAD (SPOT       /ADDRESS OF FILE NAME
+       DCA PLACE
+       TAD I (7600     /GET OUTPUT DEVICE
+       SNA             /SKIP IF PRESENT
+       JMP I LOOKUP    /NO OUTPUT DEVICE
+       JMS I (FAKUSR   /FAKE OUT THE USR
+       JMS I (200
+       2               /LOOKUP
+PLACE, SPOT
+       0
+       DCA PLACE       /NOT FOUND, 0 PLACE
+       JMS I (UNFAK    /RESTORE RESIDENT HANDLER
+       ISZ LOOKUP      /SKIP RETURN
+       TAD PLACE       /WITH BLOCK IN AC
+       JMP I LOOKUP
+\f/HERE IS WHAT WE HAVE ALL BEEN WAITING FOR
+
+    //////////////////////////////////////
+   /                                   /
+  /            RENAME                 /
+ /                                   /
+//////////////////////////////////////
+
+RENAME,        JMS LOOKUP
+       JMP I (CLOERR   /SUPER SYSTEM DISASTER
+       DCA OBLOCK      /V3C SAVE BLOCK OF NEW NAME (IF ANY)
+       TAD (SPOT1-SPOT /LOOKUP INPUT FILE
+       JMS LOOKUP
+       JMP I (CLOERR   /SUPER SYSTEM DISASTER
+       CIA             /LOOKUP INPUT NAME ON OUTPUT DEVICE
+       TAD OBLOCK      /IS IT SAME SPOT AS NEW NAME ON OUTPUT DEVICE?
+       SZA CLA         /V3C
+       JMS EXERR       /NO, MAYBE ALREADY EXISTS
+       TAD I (1404     /GET ADDRESS OF FILE
+       TAD 17          /FROM MONITOR BY THE
+       TAD (-4         /DOCUMENTED METHOD
+       DCA TEMP
+       TAD (SPOT-1     /GET NEW OUTPUT NAME
+       DCA XR1
+       TAD (-4         /SET UP COUNT OF WORDS TO MOVE
+       DCA CNT
+RNAM,  TAD I XR1       /MOVE THEM
+       DCA I TEMP
+       ISZ TEMP
+       ISZ CNT
+       JMP RNAM        /CONTINUE TILL DONE
+       TAD I (1404     /V3C
+       SNA CLA         /BUT IS THERE ROOM FOR DATE?
+       JMP NONUDA      /NO, NO ADDITIONAL INFO WORDS
+       TAD I (DATE     /YES, MOVE DATE
+       DCA I TEMP      /INTO NEW FILENAME ENTRY
+NONUDA,        JMS WRKEY       /V3C
+       ISZ I (WRTDIR   /INDICATE DIRECTORY CHANGED
+       JMP I (NFUNCT   /DO NEXT FILE
+
+WRKEY, 0               /V9
+       TAD DIRKEY      /GET "SEGMENT IN CORE" KEY
+       AND (7          /ISOLATE SEGMENT NUMBER
+       DCA SEGNO       /NUMBER FOR WRITE
+       CIF 0
+       JMS I 51        /CALL HANDLER USR USED TO DO
+       4210            /LOOKUP, THIS POINTS TO FOTPS
+       1400            /INCORE DIRECTORY HANDLER
+SEGNO, 0               /REWRITE UPDATED DIRECTORY BLOCK
+       JMP I (CLOERR   /SYSTEM ERROR
+       JMP I WRKEY
+\fEXERR,        0               /BLOCK NUMBERS DIFFERENT
+       TAD OBLOCK      /LOOK AT BLOCK NUMBER OF EXISTING FILE
+       SNA CLA         /DID IT REALLY EXIST?
+       JMP I EXERR     /NO, OK TO RENAME TO THIS NAME
+       JMS I (ERROR    /YES, TRYING TO RENAME TO EXISTING NAME
+       RENERR+40       /FILE ALREADY EXISTS
+       JMP I (POUTNM
+
+OBLOCK,        0               /TEMPORARY, HOLDS BLOCK NUMBER OF ALREADY
+                       /EXISTING FILE WITH SAME NAME AS PROPOSED NEW NAME
+                       /ON OUT PUT DEVICE (OR 0 IF NONE)
+\f/THIS ROUTINE TRANSFERS THE ADDITIONAL
+/INFORMATION WORDS OF THE INPUT FILE WHEN COPYING
+/IT IF THERE ARE ANY
+
+ADDINF,        0
+       CLA IAC         /AC=1
+       TAD I (1404     /GET NUMBER OF WORDS FROM OUTPUT DIRECTORY
+       SMA             /SKIP IF 2 OR MORE
+       JMP NOTRAN      /WE DONT TOUCH IT
+       DCA LOOKUP      /SAVE NEGATIVE NUMBER TO MOVE
+       TAD LOOKUP      /ADD NUMBER TO LOC 17
+       TAD 17          /TO FIND ADDR(SECOND)
+       DCA PPTR1       /USE 17
+       TAD INFWDS      /GET NUMBER OF AIW IN INPUT
+       CIA             /NEGATE
+       IAC             /ADD 1
+       SMA             /SKIP IF MORE THAN 1 AIW
+       JMP ZEROUT      /ZERO OUTPUT AIW
+       DCA TEMP        /SAVE COUNT
+MOVEM, ISZ GPTR1       /BUMP PTR (1ST TIME PAST DATE)
+       CDF 0
+       TAD I GPTR1     /GET WORD
+ZLOOP, CDF 10
+       DCA I PPTR1     /PUT IT INTO OUTPUT DIRECTORY
+       ISZ PPTR1
+       ISZ LOOKUP      /HAS OUTPUT COUNT OVERFLOWED?
+       JMP MORE        /MORE OUTPUT TO DO
+       JMS WRKEY       /V9
+NOTRAN,        CLA             /EXIT
+       JMP I ADDINF    /WERE DONE
+MORE,  ISZ TEMP        /BUMP INPUT COUNT
+       JMP MOVEM       /IT HASNT OVERFLOWED
+ZEROUT,        CLA CMA         /NO MORE INPUT WORDS-
+       DCA TEMP        /SO FIX UP TO ZERO REST OF OUTPUT WORDS
+       JMP ZLOOP       /DO ALL THE OUTPUTS
+
+PPTR1, 0
+       PAGE
+\f/** THIS IS THE STARTING ADDRESS OF FOTP!!!
+
+FOTP,  JMS INIT        /REGULAR ENTRY POINT
+       JMS INIT        /CHAIN ENTRY POINT
+       JMP I (CDCALL   /CALL COMMAND DECODER
+       JMP I (BYPSCD   /DONT CALL COMMAND DECODER
+INIT,  0
+       ISZ INIT        /DO SKIP RETURN
+       CLA CLL
+       CDF 0
+       TAD I (7777     /GET BATCH CONTROL WORD
+       AND (70
+       TAD FCIF0       /FORM CIF TO BATCH FIELD
+       DCA BATCIF
+       TAD I (7777
+       CDF 10
+       RTL
+       SNL CLA         /BATCH RUNNING?
+       JMP NOBTCH      /NO
+BMOVLP,        TAD BATOUT
+       DCA I TTOUTP    /MOVE IN SUBSTITUTE TTY OUTPUT CODE
+       ISZ BMOVLP
+       ISZ TTOUTP
+       ISZ TTCNT4
+       JMP .-5
+       STA
+NOBTCH,        DCA CORFUJ      / =0 IF NO BATCH, -1 IF BATCH
+MOVMSG,        TAD I ONCE      /MOVE MSGS TO LOWER FIELD
+       CDF 0
+       DCA I ONLY
+       CDF 10
+       TAD I M1
+       CDF 0           /MOVE CORE DETERMINER
+       DCA I M1        /INTO FIELD 0 ALSO
+       CDF 10
+       ISZ M1
+       ISZ ONCE
+       ISZ ONLY
+       ISZ CODE
+       JMP MOVMSG
+       TAD (2000       /SET RESTART LOCATION
+       CDF 0
+       DCA I (7745
+       TAD (6403       /SET JSW
+       DCA I (7746
+       CDF 10
+FCIF0, CIF 0
+       JMS I (CORE
+       TAD CORFUJ      /COMPUTE AMOUNT OF CORE EXCLUDING BATCH FIELD
+       TAD (-1
+       SZA CLA         /SKIP IF WE HAVE ONLY 8K (OR 12K AND BATCH)
+       JMP I INIT
+       TAD (TAD EPTR   /PATCH LOCATIONS IN FOTP
+       DCA I (F2C1     /TO WORK WITH ONLY 8K
+       TAD (NOP
+       DCA I (F2C2
+       JMP I INIT      /START
+
+M1,    .&7600
+ONCE,  MSGS
+ONLY,  LSTFPG+200
+CODE,  7400
+
+CORFUJ,        0
+TTCNT4,        -4
+TTOUTP,        TTYOUT
+BATOUT,        SKP             /OUTPUT TO BATCH LOG
+       7400
+BATCIF,        HLT
+       TTYOUT+1&177+4600       /JMS I .-2
+\f/SUBR TO DETERMINE MACHINE SIZE - RETURNS NUMBER OF
+/BANKS IN AC.
+/MUST RUN IN FIELD 0.
+
+CORE,  0
+       TAD     C6203
+       RDF
+       DCA     CORRTN
+       CDF 0
+       TAD I (7777
+       AND (70
+       SNA             /DOES LOCATION 7777 SPECIFY CORE SIZE?
+       JMP CORELP      /NO
+       CLL RTR         /YES - BELIEVE IT.
+       RAR
+       JMP CORRTN
+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
+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
+       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     COR706  /RESTORE CONTENS DESTROYED
+       DCA I   CORLOC
+       ISZ     TRYFLD /TRY NXT HIGHER FLD
+       JMP     CORELP
+       STA
+       TAD     TRYFLD
+CORRTN,        0
+       JMP I   CORE
+CORLOC,        COR70+2         /ADR TO TST IN EACH FLD
+       1400            /7000+7400+1400=0
+TRYFLD,        1               /CURRENT FLD TO TST
+C6203, 6203
+
+       PAGE
+\f/FOTP'S ERROR MESSAGES
+/THESE RESIDE IN FIELD 0 LOCATIONS 7200-7577
+
+MSGS,
+
+       NOPUNCH
+       *LSTFPG+200
+       ENPUNCH
+
+ILLQ,  TEXT /ILLEGAL ?%/
+ILLA,  TEXT /ILLEGAL *%/
+SERR,  TEXT /SYSTEM ERROR/
+RENERR,        TEXT /ALREADY EXISTS-/
+VERNO, 0617;2420;4026  /FOTP V
+VERLOC,        VERSION+60^100+SUBVER   /ONE-DIGIT VERSION NUMBER AND 1 CHAR PATCH LEVEL
+       0
+BADIRD,        TEXT /ERROR READING INPUT DIRECTORY%/
+ODRERR,        TEXT /ERROR READING OUTPUT DIRECTORY%/
+ODIERR,        TEXT /ERROR WRITING OUTPUT DIRECTORY%/
+SPRBLM,        TEXT /NO ROOM, SKIPPING-/
+INERR, TEXT /ERROR ON INPUT DEVICE-SKIPPING-/
+OUERR, TEXT /ERROR ON OUTPUT DEVICE-SKIPPING-/
+NFLEIN,        TEXT /USE PIP FOR NON-FILE STRUCTURED INPUT%/
+NOFILE,        TEXT /NO FILES OF THE FORM:/
+BIDIRM,        TEXT /BAD INPUT DIRECTORY%/
+BODORM,        TEXT /BAD OUTPUT DIRECTORY%/
+CNTDEL,        TEXT /DELETES PERFORMED ONLY ON INPUT DEVICE GROUP 1/
+CNTDE2,        TEXT /CAN'T HANDLE MULTIPLE DEVICE DELETES%/
+DSVED, TEXT /ORIGINAL DIRECTORY PRESERVED%/
+FLSFMS,        TEXT /MOUNT NEXT OUTPUT VOLUME:/
+
+       FIELD 1         /SELF-STARTING BINARY LOADER STUFF FOR ABSLDR
+       *FOTP
+       $
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape7/HELP78.HL b/sw/os8/v3d/sources/system/dectapes/dectape7/HELP78.HL
new file mode 100644 (file)
index 0000000..8e026f6
--- /dev/null
@@ -0,0 +1,416 @@
+&
+                           OS/78 V1
+                        COMMAND SUMMARY
+ASSIGN ASSIGN NAME TO DEVICE           LOAD    LOAD FILE
+BASIC  ENTER BASIC SYSTEM              MAP     PRINT BITMAP
+COMPARE        COMPARE SOURCE FILES            MEMORY  RESTRICT MEMORY USAGE
+COMPILE        COMPILE FILE                    ODT     RUN OCTAL DEBUGGER
+COPY   COPY FILE                       PAL     ASSEMBLE FILE
+CREATE OPEN EDIT FILE                  R       RUN PROGRAM FROM SYS
+CREF   ASSEMBLE AND CREF               RENAME  RENAME FILE
+DATE   SPECIFY DATE                    RUN     RUN PROGRAM
+DEAS   DEASSIGN LOGICAL DEVICES        SAVE    SAVE MEMORY IMAGE
+DELETE DELETE FILE                     SET     ALTER DEVICE
+DIRECT PRINT DIRECTORY                 SQUISH  SQUISH DEVICE
+DUPLIC COPIES DISKETTES                START   START PROGRAM
+EDIT   EDIT FILE                       SUBMIT  START BATCH
+EXECUTE        COMPILE AND RUN                 TERMIN  ENTER TERMINAL MODE
+GET    GET MEMORY IMAGE                TYPE    TYPE FILE
+HELP   LIST HELP INFORMATION           U[A-C]  STORE COMMAND
+LIST   LIST FILE                       ZERO    ZERO DEVICE
+\f
+&ABSLDR
+       ABSLDR.SV
+@CALLING COMMANDS:
+.LOAD DEV:BINFILE.BN,...
+.LOAD BINFILE.BN,...   /FROM DSK
+
+@SWITCHES:
+/8     PROG DOESN'T USE BELOW 02000
+/9     PROG DOESN'T USE BELOW 12000
+/G     GO
+/I     MEMORY IMAGE FILE
+/R     RESET
+/S     MULTIPLE BINARIES/FILE
+/N     FORCE LOADING TO FIELD N (N IS AN OCTAL DIGIT)
+=FNNNN SET STARTING ADDRESS
+\f
+&BASIC
+       BASIC.SV
+@CALLING COMMANDS:
+.BASIC
+@INTERNAL COMMANDS:
+BYE    EXIT FROM BASIC
+LIST   LIST CURRENT PROGRAM'S STATEMENTS
+NAME   RENAME CURRENT PROGRAM
+NEW    PREPARE FOR A NEW PROGRAM
+OLD    RETRIEVE AN OLD PROGRAM
+RUN    RUN CURRENT PROGRAM
+SAVE   SAVE CURRENT PROGRAM
+SCRATCH        DELETE CURRENT PROGRAM
+.HELP BCOMP    PRINTS BASIC COMPILER ERROR MESSAGES
+.HELP BRTS     PRINTS BASIC RUN-TIME ERROR MESSAGES
+\f
+&BCOMP
+       BCOMP.SV        (ERRORS)
+@ERRORS:
+CH     ERROR IN CHAIN STATEMENT        NM      MISSING LINE NUMBER
+DE     ERROR IN DEF STATEMENT          OF      OUTPUT FILE ERROR
+DI     ERROR IN DIM STATEMENT          PD      PUSHDOWN STACK OVERFLOW
+FN     ERROR IN FILE NUMBER OR NAME    QS      STRING LITERAL TOO LONG
+FP     INCORRECT FOR STATEMENT         SS      BAD SUBSCRIPT OR FUNCTION ARG
+FR     ERROR IN FUNCTION ARGS          ST      SYMBOL TABLE OVERFLOW
+IF     ERROR IN IF STATEMENT           SY      SYSTEM INCOMPLETE
+IO     I/O ERROR                       TB      PROGRAM TOO BIG
+LS     MISSING EQUALS SIGN IN LET      TD      TOO MUCH DATA IN PROGRAM
+LT     STATEMENT TOO LONG              TS      TOO MANY CHARS IN STRING
+MD     MULTIPLY DEFINED LINE NUMBER    UD      ERROR IN UDEF STATEMENT
+ME     MISSING END STATEMENT           UF      FOR STATEMENT WITHOUT NEXT
+MO     OPERAND EXPECTED, NOT FOUND     US      UNDEFINED STATEMENT NUMBER
+MP     PARENTHESIS ERROR               UU      USE STATEMENT ERROR
+MT     OPERAND OF MIXED TYPE           XC      CHARS AFTER END OF LINE
+NF     NEXT STATEMENT WITHOUT FOR
+\f
+&BRTS
+       BRTS.SV         (ERRORS)
+@ERRORS:
+BO     NO MORE BUFFERS AVAILABLE       GS      TOO MANY NESTED GOSUBS
+CI     IN CHAIN,DEVICE NOT FOUND       IA      ILLEGAL ARG IN UDEF
+CL     IN CHAIN,FILE NOT FOUND         IF      ILLEGAL DEV:FILENAME
+CX     CHAIN ERROR                     IN      INQUIRE FAILURE
+DA     READING PAST END OF DATA        IO      TTY INPUT BUFFER OVERFLOW
+DE     DEVICE DRIVER ERROR             LM      TAKING LOG OF NEGATIVE NUMBER
+DO     NO MORE ROOM FOR DRIVERS        OE      DRIVER ERROR WHILE OVERLAYING
+DV     ATTEMPT TO DIVIDE BY ZERO       OV      NUMERIC OR INPUT OVERFLOW
+EF     LOGICAL END OF FILE             PA      ILLEGAL ARG IN POS
+EM     NEGATIVE NUMBER TO REAL POWER   RE      READING PAST END OF FILE
+EN     ENTER ERROR                     SC      CONCATENATED STRING TOO LONG
+FB     USING FILE ALREADY IN USE       SL      STRING TOO LONG OR UNDEFINED
+FC     CLOSE ERROR                     SR      READING STRING FROM NUMERIC FILE
+FE     FETCH ERROR                     ST      STRING TRUNCATION ON INPUT
+FI     CLOSING OR USING UNOPENED FILE  SU      SUBSCRIPT OUT OF RANGE
+FM     FIXING NEGATIVE NUMBER          SW      WRITING STRING INTO NUMERIC FILE
+FN     ILLEGAL FILE NUMBER             VR      READING VARIABLE LENGTH FILE
+FO     FIXING NUMBER > 4095            WE      WRITING PAST END OF FILE
+GR     RETURN WITHOUT GOSUB
+\f
+&COMPAR
+       SRCCOM.SV
+@CALLING COMMANDS:
+.COMPAR DEV:OUTFILE.PA<DEV:INFILE1.PA,DEV:INFILE2.PA
+.COMPAR OUTFILE.PA<INFILE1.PA,INFILE2.PA               /FILES ON DSK
+@SWITCHES:
+/B     COMPARE BLANK LINES
+/C     DON'T COMPARE (SLASHED) COMMENTS
+/S     DON'T COMPARE TABS AND SPACES
+/T     CONVERT TABS TO SPACES ON OUTPUT
+/X     DON'T COMPARE OR PRINT COMMENTS
+@ERRORS:
+?0     INSUFFICIENT MEMORY
+?1     INPUT ERROR FILE 1 (OR LESS THAN 2 INPUT FILES)
+?2     INPUT ERROR FILE 2
+?3     OUTPUT FILE TOO LARGE
+?4     OUTPUT ERROR
+?5     CAN'T OPEN OUTPUT FILE
+\f
+&CREF
+       CREF.SV
+
+@CALLING COMMANDS:
+.CREF DEV:BINFILE.BN,DEV:LISTFILE.LS,DEV:TEMPFILE.TM<DEV:INFILE.PA
+.CREF DEV:INFILE.PA    /LISTING TO LINE PRINTER ONLY
+.CREF INFILE.PA                /LISTING TO LINE PRINTER, INPUT FILE ON DSK
+
+@SWITCHES:
+/E     DON'T DELETE CREFLS.TM
+/M     MAMMOTH (TWICE AS MANY SYMBOLS, TWICE AS SLOW)
+/P     NO PASS 1 LISTING
+/U     NO LISTING OR SYMBOL TABLE
+/X     NO LITERALS
+\f
+&DIRECT
+       DIRECT.SV
+
+@CALLING COMMANDS
+.DIR DEV:FILETYPE                              /* IS WILD NAME OR EXTENSION
+.DIR FILETYPE                                  /? IS WILD CHARACTER
+
+@SWITCHES:
+/B     INCLUDE STARTING BLOCK NUMBERS (OCTAL)
+/C     LIST ONLY FILES WITH CURRENT DATE
+/E     INCLUDE EMPTIES
+/F     FAST MODE
+/M     LIST EMPTIES ONLY
+/O     LIST ONLY FILES WITH OTHER THAN TODAY'S DATE
+/R     LIST REMAINDER OF FILES AFTER FIRST ONE (BUT USE /C,/O)
+/U     TREAT EACH INPUT SPECIFICATION SEPARATELY
+/V     LIST FILES NOT OF FORM SPECIFIED
+/W     GIVE VERSION NUMBER
+=N     USE N COLUMNS
+\f
+&DUPLIC
+       RXCOPY.SV
+@CALLING COMMANDS:
+.DUPLIC OUTDEV:<INDEV:
+@SWITCHES:
+/M     MATCH WITH NO IMPLIED COPY
+/N     COPY WITH NO IMPLIED MATCH
+/P     PAUSE BEFORE AND AFTER ACCESSING DISK
+/R     READ OUTPUT DEVICE WITH NO IMPLIED COPY OR MATCH
+/V     PRINT VERSION NUMBER
+\f
+&EDIT
+&CREATE
+       EDIT.SV
+
+@CALLING COMMANDS:                     INTERNAL COMMANDS:
+.EDIT DEV:OUTFILE.PA<DEV:INFILE.PA     A       APPEND TEXT
+.CREATE OUTFILE.PA                     B       LIST # LOCATIONS LEFT
+\r                                      C       CHANGE TEXT
+@SWITCHES:                             D       DELETE TEXT
+/A     RETURN TO EDITOR ON CLOSE       E       TRANSFER REST OF DATA,CLOSE
+/B     CONVERT SPACES TO TAB           F       AFTER J,RESUME SEARCH
+/D     PREDELETE                       G       GET AND LIST TAGGED LINE
+                                       I       INSERT TEXT 
+@ERRORS:                                       J       INTER-BUFFER SEARCH
+?0     INPUT ERROR                     K       KILL BUFFER
+?1     OUTPUT ERROR                    L       LIST TEXT
+?2     CLOSE ERROR                     M       MOVE TEXT
+?3     OPEN ERROR                      N       WRITE TEXT,READ NEXT PAGE
+?4     COULDN'T LOAD HANDLER           P       WRITE BUFFER TO OUTPUT
+                                       Q       IMMEDIATE END OF FILE
+                                       R       READ FROM INPUT DEVICE
+                                       S       CHARACTER SEARCH
+                                       V       LIST ON LINE PRINTER
+                                       Y       INPUT PAGE,NO OUTPUT
+\f
+&FORTRAN
+&F4
+       F4.SV
+
+@CALLING COMMANDS:
+.COMPILE DEV:RALFFILE.RL,DEV:LISTFILE.LS,DEV:MAPFILE.MP<DEV:INFILE.FT
+.COMPILE INFILE.FT             /FROM DSK
+  
+@SWITCHES:
+/N     SUPPRESS INTERNAL STATEMENT NUMBERS
+/Q     OPTIMIZE
+.HELP F4ERR    PRINTS FORTRAN ERROR MESSAGES
+\f
+&F4ERR
+                                       MK      MISSPELLED KEYWORD
+AA     TOO MANY ARGS ARE ARRAYS        ML      MULTIPLY DEFINED LINE NUMBERS
+AS     BAD ASSIGN STATEMENT            MM      MISMATCHED PARENTHESIS
+BD     BAD DIMENSIONS                  MO      EXPECTED OPERAND MISSING
+BS     BAD STATEMENT IN BLOCK DATA     MT      MIXED VARIABLE TYPES
+CL     BAD COMPLEX LITERAL             OF      ERROR WRITING OUTPUT FILE
+CO     SYNTAX ERROR IN COMMON          OP      ILLEGAL OPERATOR
+DA     BAD SYNTAX IN DATA STATEMENT    OT      WRONG OPERAND TYPE
+DE     ILLEGAL STATEMENT AT END OF DO  PD      COMPILER STACK OVERFLOW
+DF     BAD DEFINE FILE STATEMENT       PH      BAD PROGRAM HEADER LINE
+DH     HOLLERITH FIELD ERROR           QL      NESTING ERROR IN EQUIVALENCE
+DL     WRONG DATA/VARIABLE LIST LENGTH QS      SYNTAX ERROR IN EQUIVALENCE
+DN     DO-END MISSING                  RD      REDEFINING VARIABLE DIMENSIONS
+DO     SYNTAX ERROR IN DO              RT      REDEFINING VARIABLE TYPE
+DP     BAD DO LOOP PARAMETER           RW      SYNTAX ERROR IN READ/WRITE
+EX     SYNTAX ERROR IN EXTERNAL        SF      BAD ARITHMETIC FUNCTION
+GT     SYNTAX ERROR IN GOTO            SN      ILLEGAL NAME IN CALL
+GV     VARIABLE NOT INTEGER OR REAL    SS      SUBSCRIPT EXPRESSION ERROR
+HO     HOLLERITH FIELD ERROR           ST      SYMBOL TABLE FULL
+IE     ERROR READING INPUT FILE        SY      SYSTEM ERROR
+IF     IMPROPER STATEMENT              TD      BAD SYNTAX IN TYPE DECLARATION
+LI     BAD ARG TO LOGICAL IF           US      UNDEFINED STATEMENT NUMBER
+LT     INPUT LINE TOO LONG             VE      VERSION ERROR
+\f
+&LOAD
+       LOAD.SV
+
+@CALLING COMMANDS:
+.LOAD DEV:OUTFILE.LD<DEV:INFILE1.RL,...
+@SWITCHES:
+/C     MORE INPUT TO LOAD
+/G     CHAIN TO RUN-TIME SYSTEM
+/L     ACCEPT LIBRARY FILE
+/S     SYMBOL MAP
+\f
+&MAP
+       BITMAP.SV
+@CALLING COMMANDS:
+.MAP MAPFILE.MP<INFILE.BN,...
+@SWITCHES:
+/N     FORCES MAPPING OF ALL FILES TO FIELD N (0-7)
+/R     RESET INTERNAL MAP
+/S     ALLOW MULTIPLE BINARIES PER FILE
+/T     INVERT TTY-STYLE OUTPUT SWITCH
+\f
+&ODT
+       ODT
+  
+@CALLING COMMANDS:
+.ODT
+  
+@INTERNAL COMMANDS:
+NNNNN/ OPEN LOC                        N+      OPEN CURRENT LOC+N
+/      REOPEN LAST OPENED LOC          N-      OPEN CURRENT LOC-N
+NN     DEPOSIT NN IN OPEN LOC          NNG     GO
+<CR>   CLOSE PREVIOUSLY OPENED LOC     NNB     ESTABLISH BREAKPOINT
+<LF>   CLOSE LOC, OPEN NEXT LOC        B       REMOVE BREAKPOINT
+^      CLOSE,OPEN LOC ADDRESSED        A       OPEN AC
+_      CLOSE,OPEN LOC POINTED TO       L       OPEN LINK
+M      OPEN SEARCH MASK                C       CONTINUE FROM BREAKPOINT
+ <LF>  OPEN LOWER SEARCH LIMIT         NNC     CONTINUE NN TIMES
+ <LF>  OPEN UPPER SEARCH LIMIT         D       OPEN DATA FIELD
+NNW    SEARCH FOR NN IN LIMITS         F       OPEN FIELD FOR ^,_, W
+^O     SUPRESS PRINTING
+\f
+&PAL
+       PAL8.SV
+
+@CALLING COMMANDS:
+.PAL DEV:BINFILE.BN,DEV:LISTFILE.LS,DEV:TEMPFILE.TM<DEV:INFILE.PA/C
+.PAL INFILE.PA
+
+@SWITCHES:
+/B     TREAT ! AS BYTE SHIFT                   /K      USE EXTRA MEMORY
+/C     CHAIN TO CREF                           /L      LOAD
+/E     ENABLE ERROR MSG ON LINK GENERATED      /N      NO LISTING
+/F     DISABLE 0-FILL IN TEXT                  /O      DISABLE ORIGIN 200
+/G     GO                                      /S      NO SYMBOL TABLE
+/H     NON-PAGINATED OUTPUT                    /T      NO FORM FEEDS
+/J     DON'T LIST LINES CONDITIONALIZED OUT    /W      DON'T REMEMBER LITERALS
+.HELP PALERR   PRINTS PAL8 ERROR MESSAGES
+\f
+&PALERR
+       PAL8.SV         (ERRORS)
+
+@ERRORS:
+BE     TABLES OVERLAPPED
+CF     CREF.SV NO ON SYS:
+DE     DEVICE ERROR
+DF     DEVICE FULL
+IC     ILLEGAL CHARACTER
+ID     ILLEGAL REDEFINITION
+IE     ILLEGAL EQUALS
+II     ILLEGAL INDIRECT
+IP     ILLEGAL PSEUDO-OP
+IZ     ILLEGAL PAGE ZERO REF
+LD     SYS:ABSLDR.SV NOT FOUND
+LG     LINK GENERATED
+PE     PAGE EXCEEDED
+PH     END OF SOURCE CONDITIONALIZED OUT
+RD     REDEFINITION
+SE     SYMBOL TABLE EXCEEDED
+UO     UNDEFINED ORIGIN
+US     UNDEFINED SYMBOL
+ZE     PAGE 0 EXCEEDED
+\f
+&SET
+       SET.SV
+@CALLING COMMANDS:
+.SET DEV PARAMETER(S)
+.SET DEV NO PARAMETER(S)
+@PARAMETERS:
+READONLY       DECLARE DEVICE TO BE READ ONLY
+WIDTH N                SET WIDTH OF LINE PRINTER OR TTY
+LC             DECLARE LINE PRINTER OR TTY TO HAVE LOWER CASE
+ECHO           RESTORE TTY CHARACTER ECHOING
+PAGE           RESTORE TTY ^S AND ^Q FACILITIES
+SCOPE          ERASE CHARACTER ON TTY RUBOUTS
+ESC            DISPLAY ESC(ASCII 033) WITHOUT CONVERTING IT TO $ SIGN
+ARROW          DISPLAY CONTROL CHARACTERS WITH UP ARROW (E.G. ^C, ^S)
+HEIGHT [M]     SET TTY SCREEN HEIGHT
+PAUSE [N]      SET TTY PAUSE TIME
+COL N          SET DIRECT TO USE N COLUMNS (.SET TTY COL 2)
+INIT XXXXX     CAUSE SYS TO EXECUTE XXXXX ON BOOTSTRAPPING
+\f
+&SUBMIT
+       BATCH.SV
+@CALLING COMMANDS:
+.SUBMIT SPOOLDEV:<INPUTDEV:FILE.BI
+@SWITCHES:
+/E     DON'T ABORT ON MONITOR, CD AND CCL ERRORS
+/Q     NO BATCH LOG
+/H     HUSH
+/T     OUTPUT TO TTY
+/U     UNATTENDED
+\f
+&LIST
+&COPY
+&RENAME
+&DELETE
+&TYPE
+       FOTP.SV
+@CALLING COMMANDS:
+.COPY DEV:OUTFILE.EX<DEV:INFILE.EX     /* IS WILD NAME OR EXTENSION
+.REN DEV:NEWFILE.EX<DEV:OLDFILE.EX     /? IS WILD CHARACTER
+.DEL DEV:FILE.EX
+.LIST DEV:FILE.EX                      /= .COPY LPT:<DEV:FILE.EX
+.TYPE DEV:FILE.EX                      /= .COPY TTY:<DEV:FILE.EX
+@SWITCHES:
+/C     MATCH ONLY FILES WITH CURRENT DATE
+/F     REQUEST NEW DEVICE IF OUT OF ROOM
+/L     TYPE LOG OF INPUT FILENAME MATCHES
+/N     NO PRE-DELETE
+/O     MATCH ONLY FILES WITH OTHER THAN TODAY'S DATE
+/Q     QUERY USER ABOUT FILE BEFORE OPERATION
+/T     USE TODAY'S DATE
+/U     TREAT EACH INPUT SPECIFICATION SEPARATELY
+/V     MATCH FILES NOT OF FORM SPECIFIED
+/W     PRINT VERSION #
+\f
+&ASSIGN
+&DATE
+&DEASSIGN
+&GET
+&MEMORY
+&R
+&RUN
+&SAVE
+&START
+&SQUISH
+&TERMIN
+&UA
+&ZERO
+       KEYBOARD AND OTHER COMMANDS
+@CALLING COMMANDS:
+.ASSIGN DEV NAME               /ASSIGN NAME TO DEVICE
+.DAY DD-MON-YY                 /ENTER DATE INTO SYSTEM
+.DEASSIGN                      /DEASSIGN LOGICAL DEVICE NAMES
+.GET DEV FILE.EX               /LOAD MEMORY IMAGE
+.MEMORY N                      /SPECIFIES HIGHEST FIELD AVAILABLE
+.R FILE                                /EXECUTE FILE.SV FROM SYS
+.RUN DEV FILE.EX               /EXECUTE FILE.EX FROM THE DEVICE
+.SAVE DEV FILE.EX              /SAVE MEMORY IMAGE
+.SQUISH DEV:                   /COMPRESS FILE STORAGE ON DEVICE
+.START FNNNN                   /START EXECUTION
+.TERMIN                                /ENTER TERMINAL MODE
+.UA COMMAND                    /SAVE COMMAND(.UA<CR> EXECUTES IT)
+.ZERO DEV:                     /ZERO DEVICE'S DIRECTORY
+\f\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape7/HELP8.HL b/sw/os8/v3d/sources/system/dectapes/dectape7/HELP8.HL
new file mode 100644 (file)
index 0000000..5e8ebc2
--- /dev/null
@@ -0,0 +1,900 @@
+
+&ABSLDR
+       ABSLDR.SV
+@CALLING COMMANDS:
+.LOAD DEV:BINFILE.BN,...
+.LOAD BINFILE.BN,...   /FROM DSK
+
+@SWITCHES:
+/8     PROG DOESN'T USE BELOW 02000
+/9     PROG DOESN'T USE BELOW 12000
+/G     GO
+/I     CORE IMAGE FILE
+/P     PROG DOESN'T DESTROY EXTENDED BATCH RESIDENT
+/R     RESET
+/S     MULTIPLE BINARIES/FILE
+/N     FORCE LOADING TO FIELD N (N IS AN OCTAL DIGIT)
+=FNNNN SET STARTING ADDRESS
+\f
+&BASIC
+       BASIC.SV
+
+@CALLING COMMANDS:
+.BASIC
+.R BASIC
+@INTERNAL COMMANDS:
+BYE    EXIT FROM BASIC
+LIST   LIST CURRENT PROGRAM'S STATEMENTS
+NAME   RENAME CURRENT PROGRAM
+NEW    PREPARE FOR A NEW PROGRAM
+OLD    RETRIEVE AN OLD PROGRAM
+RUN    RUN CURRENT PROGRAM
+SAVE   SAVE CURRENT PROGRAM
+SCRATCH        DELETE CURRENT PROGRAM
+.HELP BCOMP    PRINTS BASIC COMPILER ERROR MESSAGES
+.HELP BRTS     PRINTS BASIC RUN-TIME ERROR MESSAGES
+\f
+&BCOMP
+       BCOMP.SV        (ERRORS)
+@ERRORS:
+CH     ERROR IN CHAIN STATEMENT
+DE     ERROR IN DEF STATEMENT
+DI     ERROR IN DIM STATEMENT
+FN     ERROR IN FILE NUMBER OR FILE NAME
+FP     INCORRECT FOR  STATEMENT
+FR     ERROR IN FUNCTION ARGS
+IF     ERROR IN IF STATEMENT
+IO     I/O ERROR
+LS     MISSING EQUALS SIGN IN LET
+LT     STATEMENT TOO LONG
+MD     MULTIPLY DEFINED LINE NUMBER
+ME     MISSING END STATEMENT
+MO     OPERAND EXPECTED AND NOT FOUND
+MP     PARENTHESIS ERROR
+MT     OPERAND OF MIXED TYPE
+NF     NEXT STATEMENT WITHOUT FOR
+NM     MISSING LINE NUMBER
+OF     OUTPUT FILE ERROR
+PD     PUSHDOWN STACK OVERFLOW
+QS     STRING LITERAL TOO LONG
+SS     SUBSCRIPT OR FUNCTION ARG ERROR
+ST     SYMBOL TABLE OVERFLOW
+SY     SYSTEM INCOMPLETE
+TB     PROGRAM TOO BIG
+TD     TOO MUCH DATA IN PROGRAM
+TS     TOO MANY CHARS IN STRING LITERALS
+UD     ERROR IN UDEF STATEMENT
+UF     FOR STATEMENT WITHOUT NEXT
+US     UNDEFINED STATEMENT NUMBER
+UU     USE STATEMENT ERROR
+XC     EXTRA CHARS AFTER LOGICAL END OF LINE
+  
+\f
+&BRTS
+       BRTS.SV         (ERRORS)
+@ERRORS:
+BO     NO MORE FILE BUFFERS AVAILABLE
+CI     INQUIRE FAILURE IN CHAIN. DEVICE NOT FOUND
+CL     LOOKUP FAILURE IN CHAIN. FILENAME NOT FOUND.
+CX     CHAIN ERROR
+DA     ATTEMPT TO READ PAST END OF DATA LIST
+DE     DEVICE DRIVER ERROR
+DO     NO MORE ROOM FOR DRIVERS
+DV     ATTEMPT TO DIVIDE BY 0
+EF     LOGICAL END OF FILE
+EM     ATTEMPT TO RAISE A NEGATIVE NUMBER TO A REAL POWER
+EN     ENTER ERROR
+FB     ATTEMPT TO USE A FILE ALREADY IN USE
+FC     CLOSE ERROR
+FE     FETCH ERROR
+FI     ATTEMPT TO CLOSE OR USE AN UNOPENED FILE
+FM     ATTEMPT TO FIX NEGATIVE NUMBER
+FN     ILLEGAL FILE NUMBER
+FO     ATTEMPT TO FIX NUMBER GREATER THAN 4095
+GR     RETURN WITHOUT A GOSUB
+GS     TOO MANY NESTED GOSUBS
+IA     ILLEGAL ARGUMENT IN UDEF FUNCTION CALL
+IF     ILLEGAL DEV:FILENAME SPECIFICATION
+IN     INQUIRE FAILURE
+IO     TTY INPUT BUFFER OVERFLOW
+LM     ATTEMPT TO TAKE LOG OF A NEGATIVE NUMBER
+OE     DRIVER ERROR WHILE OVERLAYING
+OV     NUMERIC OR INPUT OVERFLOW
+PA     ILLEGAL ARGUMENT IN POS FUNCTION
+RE     ATTEMPT TO READ PAST END OF FILE
+SC     STRING TOO LONG AFTER CONCATENATING
+SL     STRING TOO LONG OR UNDEFINED
+SR     ATTEMPT TO READ STRING FROM NUMERIC FILE
+ST     STRING TRUNCATION ON INPUT
+SU     SUBSCRIPT OUT OF DIM STATEMENT RANGE
+SW     ATTEMPT TO WRITE STRING INTO NUMERIC FILE
+VR     ATTEMPT TO READ VARIABLE LENGTH FILE
+WE     ATTEMPT TO WRITE PAST END OF FILE
+\f
+&BOOT
+       BOOT.SV
+@CALLING COMMANDS:
+.BOOT/DV
+
+@SWITCHES:
+/CA    TA8E CASSETTE   CAPS-8
+/DK    ANY DISK
+/DL    LINCTAPE        DIAL
+/DM    ANY DISK        DISK MONITOR
+/DT    ANY TAPE
+/LT    LINCTAPE
+/PT    PT8E (LOADS BINLDR)
+/RE    RK8E DISK
+/RF    RF08,DF32 DISKS
+/RK    RK8 DISK
+/RX    RX8E FLOPPY DISK
+/TD    TD8E DECTAPE
+/TY    TYPESET (UNIT 4)
+/VE    VERSION #
+/TC    TC08 DECTAPE    ALL SYSTEMS
+/ZE    ZEROES CORE (FIELD 0)
+
+DEVICES ARE UNIT 0 IF NOT SPECIFIED
+
+DV.    HALT AFTER LOADING BOOTSTRAP
+\f
+&BUILD
+       BUILD.SV
+
+@INTERNAL COMMANDS:
+$ALTER GRP,LOC
+$ALTER GRP,LOC=VALUE
+$BOOT
+$BUILD
+$CTL ACTNAM
+$CTL ACTNAM=VALUE
+$CORE N
+$DCB ACTNAM
+$DCB ACTNAM=VALUE
+$DELETE ACTNAM,...
+$DSK ACTNAM
+$DSK GRP:NAME
+$EXAMINE GRP,LOC
+$INSERT GRP
+$INSERT GRP:NAME,...
+$LOAD DEV:FILENM.BN
+$LOAD ACTNAM
+$NAME ACTNAM=NEWNAM
+$PRINT
+$QLIST
+$REPLACE ACTNAM,...=GRP:NEWNAM,,,
+$SIZE ACTNAM
+$SIZE ACTNAM=VALUE
+$SYS GRP
+$SYS GRP:NAME,...
+$UNLOAD GRP
+$UNLOAD GRP:NAME,...
+
+@ERRORS:
+?BAD ARG       NO DEVICE NAME IN LOAD COMMAND
+?BAD INPUT     INPUT NOT A VALID BINARY FILE
+?BAD LOAD      BINARY HANDLER NOT IN CORRECT FORMAT
+?BAD ORIGIN    ORIGIN IN BINARY FILE NOT IN RANGE 200-577
+?CORE          NOT ENOUGH MEMORY AVAILABLE
+?DSK           DSK IS NOT FILE STRUCTURED
+?HANDLERS      MORE THAN 15 HANDLERS ARE ACTIVE
+I/O ERROR      ERROR DURING LOAD
+?NAME          MISSING NAME
+NO ROOM                TOO MANY DEVICE HANDLERS LOADED
+NAME NOT FOUND DEVICE OR FILE NAME NOT FOUND
+?PLAT          TOO MANY PLATTERS SPECIFIED FOR DEVICE
+?SYNTAX                BAD SYNTAX
+?SYS           HANDLER IS NOT A SYSTEM HANDLER OR TWO SYSTEM HANDLERS
+               ARE ACTIVE OR HANDLER CORESIDENT WITH NON-ACTIVE SYS
+SYS ERROR      I/O ERROR OCCURED WITH SYSTEM HANDLER.  PRESS CONTINUE
+               TO RETRY
+SYS NOT FOUND  NO ACTIVE HANDLER BY NAME OF SYS DURING BOOTSTRAP
+\f
+&
+&CCL
+OS/8 MONITOR COMMANDS
+
+CMD    PROG    EXPL
+
+ASSIGN KBM     ASSIGNS LOGICAL NAME
+BACKSP CAMP    BACKSPACES DEV
+BASIC  BASIC   ENTERS BASIC SYSTEM
+BOOT   BOOT    BOOTSTRAPS TO DEV
+CCL    CCL     DISABLES CCL
+COMPARE        SRCCOM  COMPARES FILES
+COMPILE        PAL8    COMPILES PROG
+       F4/FORT
+       BASIC
+       RALF
+       SABR
+COPY   FOTP    COPIES FILES
+CREATE EDIT    OPENS FILE FOR EDITING
+CREF   PAL8    ASSEMBLES AND CHAINS TO CREF
+       CREF    CREF'S LISTING
+DATE   KBM/CCL SPECIFIES DATE
+DEAS   CCL     DEASSIGNS LOGICAL DEVICES
+DELETE FOTP    DELETES FILES
+DIRECT DIRECT  PRINTS DIRECTORIES
+DUPLIC RXCOPY  COPIES RX DISKS
+EDIT   EDIT    EDITS FILE
+EOF    CAMP    WRITES END-OF-FILE
+EXECUTE        PAL8    COMPILES AND EXECUTES
+       F4/FORT
+       BASIC
+       RALF
+       SABR
+       ABSLDR  LOADS AND EXECUTES
+       LOAD(ER)
+GET    KBM     GETS CORE-IMAGE
+HELP   HELP    LIST'S HELP FILE
+LIST   FOTP    LISTS FILES
+LOAD   ABSLDR  LOADS FILES
+       LOAD(ER)
+MAKE   TECO    MAKES NEW FILE FOR EDITING
+MAP    BITMAP  PRINTS BITMAP
+MEMORY CCL     SPECIFIES MACHINE CORE SIZE
+MUNG   TECO    MUNGS FILE WITH TECO MACRO
+ODT    KBM     RUNS OCTAL DEBUGGER
+PAL    PAL8    RUNS PAL8
+PRINT  LPTSPL  RUNS 'LPTSPL' IF PRESENT
+PUNCH  FOTP    PUNCHES DATA
+R      KBM     RUNS PROGRAM FROM SYS:
+RENAME FOTP    RENAMES FILES
+RESORC RESORC  PRINTS RESOURCES OF SYSTEMS
+REWIND CAMP    REWINDS DEV
+RUN    KBM     RUNS PROGRAM
+SAVE   KBM     SAVES CORE IMAGE
+SET    SET     ALTERS PARAMETERS
+SKIP   CAMP    SKIPS RECORDS
+SQUISH PIP     SQUISHES DEV
+START  KBM     STARTS PROG
+SUBMIT BATCH   STARTS BATCH JOB
+TECO   TECO    EDITS FILE
+TYPE   FOTP    TYPES FILES
+UA     CCL     REMEMBERS COMMAND
+UB     CCL
+UC     CCL
+UNLOAD CAMP    UNLOADS DEV
+VERSION        CCL     TYPES VERSION #
+ZERO   PIP     ZEROES DEV
+
+
+
+
+@SWITCHES:
+-L     OUTPUT TO LPT:
+-S     OUTPUT TO TV:
+-T     OUTPUT TO TTY:
+-P     OUTPUT TO PTP:
+-D     OUTPUT TO DUMP:
+-N     OUTPUT TO NULL:
+-LS    PRODUCE LISTING
+-NB    NO BINARY YET
+-MP    PRODUCE MAP
+-EXT   SET DEFAULT EXTENSION
+
+@FEATURES:
+/X     PASS SWITCH OPTION X TO PROGRAM
+(XYZ)  PASS SWITCH OPTIONS TO PROGRAM
+[N]    MAX OUTPUT SIZE
+=NNN   PASS OCTAL NUMBER TO PROGRAM
+#NNN   TAKE INTERNAL OCTAL FORM OF FILENAME
+ @FILE REPLACE IN CMD LINE BY FILE'S CONTENTS
+$      COMPLEMENT DEFAULT ALTMODE SWITCH
+\f
+&CREF
+       CREF.SV
+
+@CALLING COMMANDS:
+.CREF DEV:BINFILE.BN,DEV:LISTFILE.LS,DEV:TEMPFILE.TM<DEV:INFILE.PA
+.CREF DEV:INFILE.PA    /LISTING TO LINE PRINTER ONLY
+.CREF INFILE.PA                /LISTING TO LINE PRINTER, INPUT FILE ON DSK
+
+@SWITCHES:
+/E     DON'T DELETE CREFLS.TM
+/M     MAMMOTH (TWICE AS MANY SYMBOLS, TWICE AS SLOW)
+/P     NO PASS 1 LISTING
+/Q     SABR
+/R     RALF
+/U     NO LISTING OR SYMBOL TABLE
+/X     NO LITERALS
+\f
+&DIRECT
+       DIRECT.SV
+
+@CALLING COMMANDS
+.DIR DEV:LISTFILE.DI<DEV:FILETYPE              /* IS WILD NAME OR EXTENSION
+.DIR FILETYPE                                  /? IS WILD CHARACTER
+
+@SWITCHES:
+/B     INCLUDE STARTING BLOCK NUMBERS (OCTAL)
+/C     LIST ONLY FILES WITH CURRENT DATE
+/E     INCLUDE EMPTIES
+/F     FAST MODE
+/I     PRINT ADDITIONAL INFO WORDS
+/L     USUAL MODE
+/M     LIST EMPTIES ONLY
+/O     LIST ONLY FILES WITH OTHER THAN TODAY'S DATE
+/R     LIST REMAINDER OF FILES AFTER FIRST ONE (BUT USE /C,/O)
+/U     TREAT EACH INPUT SPECIFICATION SEPARATELY
+/V     LIST FILES NOT OF FORM SPECIFIED
+/W     GIVE VERSION NUMBER
+=N     USE N COLUMNS
+\f
+&EDIT
+&CREATE
+       EDIT.SV
+
+@CALLING COMMANDS:
+.EDIT DEV:OUTFILE.PA<DEV:INFILE.PA
+.CREATE OUTFILE.PA
+
+@SWITCHES:
+/A     RETURN TO EDITOR ON CLOSE
+/B     CONVERT 2 OR MORE SPACES TO TAB
+/D     PREDELETE
+  
+@ERRORS:
+?0     INPUT ERROR
+?1     OUTPUT ERROR
+?2     CLOSE ERROR
+?3     OPEN ERROR
+?4     COULDN'T LOAD DEVICE HANDLER
+
+@INTERNAL COMMANDS:
+A      APPEND TEXT
+B      LIST # OF CORE LOCATIONS LEFT
+C      CHANGE TEXT
+D      DELETE TEXT
+E      OUTPUT BUFFER, TRANSFER REST OF DATA, AND CLOSE
+F      AFTER J, SEARCH FOR NEXT OCCURRRENCE OF SAME STRING
+G      GET AND LIST TAGGED LINE
+I      INSERT
+J      INTER-BUFFER STRING SEARCH
+K      KILL BUFFER
+L      LIST TEXT
+M      MOVE TEXT
+N      WRITE BUFFER, KILL AND READ NEXT PAGE
+P      WRITE TEXT BUFFER TO OUTPUT
+Q      IMMEDIATE END OF FILE
+R      READ TEXT FROM INPUT DEVICE
+S      CHARACTER SEARCH
+T      PUNCH TRAILER TAPE
+V      PRINT ON LP08
+Y      INPUT TEXT PAGE, NO OUTPUT
+#      PRINT VERSION NO.
+
+\f
+&EPIC
+       EPIC.SV
+
+@SWITCHES:
+/0$            PAPER TAPE I/O TO/FROM OS/8 FILES
+       /E      DON'T PUNCH EOT
+       /H      SET HIGH BIT=N
+       /L      LOW SPEED
+       /P      PUNCH PATCH
+       /Z      REL BLOCK=0
+       =N      REL BLOCK TO PATCH
+  NO OUT FILE IS READ
+
+FILE</1$       EDIT 'FILE'
+       C       CURRENT STATUS
+       E       EXIT TO CD
+       O,N     OPEN BLOCK N
+       R,N     READ BLOCK N
+       S,N,M   SEARCH FOR N WITH MASK M
+       W       WRITE
+
+FILE1<FILE2/2$ COMPARE FILE1 AND FILE2
+       /A      ABORT
+       /B      BAD BLOCKS ONLY
+\f
+&FORT
+       FORT.SV
+
+@CALLING COMMANDS:
+.COMPILE DEV:BINFILE.BN,DEV:LISTFILE.LS,DEV:MAPFILE.MP<DEV:INFILE.FT
+.EXE INFILE.FT
+
+@SWITCHES:
+/G     GO
+/K     KEEP FORTRN.TM
+/L     LOAD
+
+@ERRORS:
+
+ALOG   ATTEMPT TO COMPUTE LOG OF NEGATIVE NUMBER
+IOER   INPUT/OUTPUT ERROR
+CHER   CHAIN ERROR
+FMT1   INVALID FORMAT STATEMENT
+FMT2   ILLEGAL CHARACTER IN I FORMAT
+FMT3   ILLEGAL CHARACTER IN E OR F FORMAT
+DIVZ   ATTEMPT TO DIVIDE BY 0
+EXP    ARGUMENT TO EXP TOO LARGE
+OVFL   FLOATING POINT OVERFLOW
+FLPW   ATTEMPT TO RAISE NEGATIVE NUMBER TO REAL POWER
+SQRT   ATTEMPT TO TAKE SQUARE ROOT OF NEGATIVE NUMBER
+FIX    ATTEMPT TO FIX NUMBER GREATER THAN 2047
+\f
+&FRTS
+       FRTS.SV
+
+@SWITCHES:
+/C     CARRIAGE CONTROL SWITCH
+/E     IGNROE ERRORS
+/H     HALT BEFORE STARTING
+/P     PUNCH TO PAPER TAPE
+\f
+&F4
+&FORTRAN
+       F4.SV
+
+@CALLING COMMANDS:
+.COMPILE DEV:RALFFILE.RL,DEV:LISTFILE.LS,DEV:MAPFILE.MP<DEV:INFILE.FT
+.COMPILE INFILE.FT             /FROM DSK
+  
+@SWITCHES:
+/A     RETURN TO KBM AFTER COMPILATION
+/F     PRODUCE RALF LISTING
+/N     SUPPRESS INTERNAL STATEMENT NUMBERS
+/Q     OPTIMIZE
+.HELP F4ERR    PRINTS FORTRAN IV COMPILER ERROR MESSAGES
+\f
+&F4ERR
+       F4.SV           (ERRORS)
+
+@ERRORS:
+AA     MORE THAN 6 SUBROUTINE ARGUMENTS ARE ARRAYS
+AS     BAD ASSIGN STATEMENT
+BD     BAD DIMENSIONS
+BS     ILLEGAL STATEMENT IN BLOCK DATA SUBPROGRAM
+CL     BAD COMPLEX LITERAL
+CO     SYNTAX ERROR IN COMMON STATEMENT
+DA     BAD SYNTAX IN DATA STATEMENT
+DE     ILLEGAL STATEMENT AT END OF DO
+DF     BAD DEFINE FILE STATEMENT
+DH     HOLLERITH FIELD ERROR IN DATA STATEMENT
+DL     DATA LIST AND VARIABLE LIST ARE NOT SAME LENGTH
+DN     DO-END MISSING OR INCORRECTLY USED
+DO     SYNTAX ERROR IN DO OR IMPLIED DO
+DP     DO LOOP PARAMETER NOT INTEGER OR REAL
+EX     SYNTAX ERROR IN EXTERNAL STATEMENT
+GT     SYNTAX ERROR IN GOTO STATEMENT
+GV     ASSIGNED OR COMPUTED GOTO VARIABLE NOT INTEGER OR REAL
+HO     HOLLERITH FIELD ERROR
+IE     ERROR READING INPUT FILE
+IF     IMPROPER STATEMENT USED WITH LOGICAL IF
+LI     ARGUMENT TO LOGICAL IF IS NOT LOGICAL
+LT     INPUT LINE TOO LONG (TOO MANY CONTINUATIONS)
+MK     MISSPELLED KEYWORD
+ML     MULTIPLY DEFINED LINE NUMBER
+MM     MISMATCHED PARENTHESES
+MO     EXPECTED OPERAND IS MISSING
+MT     MIXED VARIABLE TYPES
+OF     ERROR WRITING OUTPUT FILE
+OP     ILLEGAL OPERATOR
+OT     OPERAND TYPE WRONG FOR GIVEN OPERATOR
+PD     COMPILER STACK OVERFLOW, STATEMENT TOO BIG OR TOO MANY NESTED LOOPS
+PH     BAD PROGRAM HEADER LINE
+QL     NESTING ERROR IN EQUIVALENCE STATEMENT
+QS     SYNTAX ERROR IN EQUIVALENCE STATEMENT
+RD     ATTEMPT TO REDEFINE THE DIMENSIONS OF A VARIABLE
+RT     ATTEMPT TO REDEFINE THE TYPE OF A VARIABLE
+RW     SYNTAX ERROR IN READ/WRITE STATEMENT
+SF     BAD ARITHMETIC STATEMENT FUNCTION
+SN     ILLEGAL SUBROUTINE NAME IN CALL
+SS     ERROR IN SUBSCRIPT EXPRESSION
+ST     COMPILER SYMBOL TABLE FULL
+SY     SYSTEM ERROR; PASS MISSING OR NO ROOM FOR OUTPUT
+TD     BAD SYNTAX IN TYPE DECLARATION STATEMENT
+US     UNDEFINED STATEMENT NUMBER
+VE     VERSION ERROR
+\f
+&LIBRA
+       LIBRA.SV
+
+@SWITCHES:
+/C     CONTINUE INPUT SPECIFICATIONS
+/I     INSERTION DECISION
+/R     REPLACE MODULE
+/Z     REPLACE LIBRARY
+=N     EXTRA BLOCKS
+\f
+&LOAD
+       LOAD.SV
+
+@CALLING COMMANDS:
+.LOAD DEV:OUTFILE.LD<DEV:INFILE1.RL,...
+@SWITCHES:
+/C     MORE INPUT TO LOAD
+/G     CHAIN TO RUN-TIME SYSTEM
+/L     ACCEPT LIBRARY FILE
+/O     MORE OVERLAYS
+/S     SYMBOL MAP
+/U     IGNORE RULES GOVERNING SUBROUTINE CALLS BETWEEN OVERLAYS
+\f
+&LOADER
+       LOADER.SV
+
+@CALLING COMMANDS:
+.LOAD MAPFILE.MP<INFILE.RL,...
+
+@SWITCHES:
+/G     GO
+/H     2 PAGE HANDLERS
+/I     OS/8 FILE INPUT
+/L     1ST INPUT FILE IS LIBRARY FILE
+/M     PRODUCE MAP
+/O     OS/8 FILE OUTPUT
+/P     OUTPUT COUNT OF FREE PAGES
+/R     RESTART
+/U     OUTPUT UNDEFINED SYMBOLS
+/N     LOAD IN FIELD N (0-7) OR HIGHER
+=N     SET STARTING ADDRESS
+\f
+&MAP
+&BITMAP
+       BITMAP.SV
+@CALLING COMMANDS:
+.MAP MAPFILE.MP<INFILE.BN,...
+@SWITCHES:
+/N     FORCES MAPPING OF ALL FILES TO FIELD N (0-7)
+/R     RESET INTERNAL MAP
+/S     ALLOW MULTIPLE BINARIES PER FILE
+/T     INVERT TTY-STYLE OUTPUT SWITCH
+\f
+&ODT
+       ODT
+  
+@CALLING COMMANDS:
+.ODT
+  
+@INTERNAL COMMANDS:
+NNNNN/ OPEN LOC
+/      REOPEN LAST OPENED LOC
+NN<CR> DEPOSIT NN IN OPEN LOC, CLOSE LOC
+NN<LF> DEPOSIT NN IN OPEN LOC, CLOSE LOC, OPEN AND DISPLAY NEXT LOC
+NN;... DEPOSIT NN IN OPEN LOC, CLOSE AND OPEN NEXT LOC
+<CR>   CLOSE PREVIOUSLY OPENED LOC
+<LF>   CLOSE LOC, OPEN NEXT LOC
+N+     OPEN CUR LOC+N
+N-     OPEN CUR LOC-N
+^      CLOSE LOC, OPEN LOC ADDRESSED BY CONTENTS
+_      CLOSE LOC, OPEN POINTED TO BY CONTENTS
+NNG    GO
+NNB    ESTABLISH BREAKPOINT
+B      REMOVE BREAKPOINT
+A      OPEN AC
+L      OPEN LINK
+C      CONTINUE FROM BREAKPOINT
+NNC    CONTINUE, ITERATE NN TIMES
+M      OPEN SEARCH MASK
+ <LF>  OPEN LOWER SEARCH LIMIT
+ <LF>  OPEN UPPER SEARCH LIMIT
+NNW    SEARCH CORE FOR NN MASKED BETWEEN LIMITS
+D      OPEN DATA FIELD (0010=FIELD 1)
+F      OPEN FIELD FOR ^, _, W  (0010=FIELD 1)
+^O     SUPRESS PRINTING
+\f
+&PAL8
+&PAL
+       PAL8.SV
+
+@CALLING COMMANDS:
+.PAL DEV:BINFILE.BN,DEV:LISTFILE.LS,DEV:TEMPFILE.TM<DEV:INFILE.PA/C
+.PAL DEV:BINFILE.BN,DEV:LISTFILE.LS<DEV:INFILE.PA
+.PAL INFILE.PA                                         /FROM DSK
+.HELP PALERR   PRINTS PAL8 ERROR MESSAGES
+
+@SWITCHES:
+/B     TREAT ! AS BYTE SHIFT
+/C     CHAIN TO CREF
+/D     DDT-COMPATIBLE SYMBOL TABLE
+/E     ENABLE ERROR MSG ON LINK GENERATED
+/F     DISABLE 0-FILL IN TEXT
+/G     GO
+/H     NON-PAGINATED OUTPUT
+/J     DON'T LIST LINES CONDITIONALIZED OUT
+/K     USE EXTRA CORE
+/L     LOAD
+/N     NO LISTING
+/O     DISABLE ORIGIN 200 AFTER FIELD
+/S     NO SYMBOL TABLE
+/T     NO FORM FEEDS
+/W     DON'T REMEMBER LITERALS
+\f
+&PALERR
+       PAL8.SV         (ERRORS)
+
+@ERRORS:
+BE     TABLES OVERLAPPED
+CF     CREF.SV NO ON SYS:
+DE     DEVICE ERROR
+DF     DEVICE FULL
+IC     ILLEGAL CHARACTER
+ID     ILLEGAL REDEFINITION
+IE     ILLEGAL EQUALS
+II     ILLEGAL INDIRECT
+IP     ILLEGAL PSEUDO-OP
+IZ     ILLEGAL PAGE ZERO REF
+LD     SYS:ABSLDR.SV NOT FOUND
+LG     LINK GENERATED
+PE     PAGE EXCEEDED
+PH     END OF SOURCE CONDITIONALIZED OUT
+RD     REDEFINITION
+SE     SYMBOL TABLE EXCEEDED
+UO     UNDEFINED ORIGIN
+US     UNDEFINED SYMBOL
+ZE     PAGE 0 EXCEEDED
+\f
+&PIP
+       PIP.SV
+
+@SWITCHES:
+/A     ASCII MODE
+/B     BINARY MODE
+/C     ELIM TRAILING BLANKS
+/D     DELETE OUTPUT FILE BEFORE TRANSFER
+/G     IGNORE ERRORS
+/I     IMAGE MODE
+/O     OKAY TO COMPRESS OR ZERO
+/S     SQUISH
+/T     CONVERT TABS TO SPACES, ETC.
+/V     VERSION #
+/Y     COPY SYSTEM HEAD
+/Z     ZERO OUTPUT DIRECTORY BEFORE TRANSFER
+=N     # OF ADDITIONAL INFO WORDS (/Z OR /S)
+=N     SIZE TO CLOSE OUTPUT FILE (/I)
+\f
+&PIP10
+       PIP10.SV
+
+@SWITCHES:
+/B     BINARY MODE
+/D     DELETE OLD OUTPUT FILE BEFORE TRANSFER
+/F     FAST PDP-10 DIRECTORY
+/I     IMAGE MODE
+/L     LIST PDP-10 DIRECTORY
+/P     PRESERVE LINE NUMBERS
+/Z     ZERO PDP-10 DIRECTORY BEFORE TRANSFER
+\f
+&DUPLIC
+&RXCOPY
+       RXCOPY.SV
+@CALLING COMMANDS:
+.DUPLIC OUTDEV:<INDEV:
+@SWITCHES:
+/M     MATCH WITH NO IMPLIED COPY
+/N     COPY WITH NO IMPLIED MATCH
+/P     PAUSE BEFORE AND AFTER ACCESSING DISKS
+/R     READ OUTPUT DEVICE WITH NO IMPLIED COPY OR MATCH
+/V     PRINT VERSION NUMBER
+\f
+&SABR
+       SABR.SV
+
+@CALLING COMMANDS:
+.COMPILE BINFILE.RL,LISTFILE.LS,MAPFILE.MP<INFILE.SB
+.EXE DEV:BINFILE.RL,DEV:LISTFILE.LS,DEV:MAPFILE.MP<DEV:INFILE.SB
+
+@SWITCHES:
+/F     INPUT IS FROM FORT
+/G     CHAIN TO LOADER AND GO
+/L     CHAIN TO LOADER
+/N     NO LISTING
+/S     NO SYMBOL TABLE
+
+@ERRORS:
+A      WRONG NO. OFARG'S
+C      BAD CHAR
+D      I/O ERROR
+E      NO END STMNT
+I      ILLEGAL SYNTAX
+L      SYS:LOADER.SV NOT FOUND
+M      MULTIPLY DEFINED SYMBOL
+S      SYMBOL OVERFLOW
+U      UNDEFINED SYMBOL
+\f
+&SET
+       SET.SV
+@CALLING COMMANDS:
+.SET DEV PARAMETER(S)
+.SET DEV NO PARAMETER(S)
+@PARAMETERS:
+READONLY       DECLARE DEVICE TO BE READ ONLY
+FILES          DECLARE DEVICE TO BE FILE STRUCTURED
+DVC            CHANGE DEVICE CODES
+VERSION X      CHANGE VERSION
+LOCATION N[=M] EXAMINE OR CHANGE LOCATIONS
+LV8E           DECLARE LINE PRINTER TO BE AN LV8E
+LA8A           DECLARE LINE PRINTER TO BE LA180 ON DKC8-AA
+LA78           SAME AS .SET LPT NO LA8A
+WIDTH N                SET WIDTH OF LINE PRINTER OR TTY
+LC             DECLARE LINE PRINTER OR TTY TO HAVE LOWER CASE
+ECHO           RESTORE TTY CHARACTER ECHOING
+PAGE           RESTORE TTY ^S AND ^Q FACILITIES
+TAB            IN TTY PRINT TABS (DON'T SIMULATE WITH SPACES)
+FILL           IN TTY APPEND FILL CHARACTERS AFTER TABS
+FLAG           IN TTY FLAG LOWER CASE CHARACTERS
+SCOPE          ERASE CHARACTER ON TTY RUBOUTS
+ESC            PRINT ESC(ASCII 033) WITHOUT CONVERTING IT TO $ SIGN
+ARROW          PRINT CONTROL CHARACTERS WITH UP ARROW (E.G. ^C, ^S)
+HEIGHT [M]     SET TTY SCREEN HEIGHT
+PAUSE [N]      SET TTY PAUSE TIME
+COL N          SET DIRECT TO USE N COLUMNS (.SET TTY COL 2)
+CODE N         CHANGE TTY IOTS OR CARD READER CODES
+PARITY EVEN/ODD        SET MAGTAPE PARITY
+OS8            DECLARE SYS TO BE OS/8
+OS78           DECLARE SYS TO BE OS/8
+INIT XXXXX     CAUSE SYS TO EXECUTE XXXXX ON BOOTSTAPPING
+\f
+&SRCCOM
+&COMPAR
+       SRCCOM.SV
+
+@CALLING COMMANDS:
+.COMPAR DEV:OUTFILE.PA<DEV:INFILE1.PA,DEV:INFILE2.PA
+.COMPAR OUTFILE.PA<INFILE1.PA,INFILE2.PA               /FILES ON DSK
+
+@SWITCHES:
+/B     COMPARE BLANK LINES
+/C     DON'T COMPARE (SLASHED) COMMENTS
+/S     DON'T COMPARE TABS AND SPACES
+/T     CONVERT TABS TO SPACES ON OUTPUT
+/X     DON'T COMPARE OR PRINT COMMENTS
+
+@ERRORS:
+?0     INSUFFICIENT CORE
+?1     INPUT ERROR FILE 1 (OR LESS THAN 2 INPUT FILES)
+?2     INPUT ERROR FILE 2
+?3     OUTPUT FILE TOO LARGE
+?4     OUTPUT ERROR
+?5     CAN'T OPEN OUTPUT FILE
+\f
+&BATCH
+&SUBMIT
+       BATCH.SV
+@CALLING COMMANDS:
+.SUBMIT SPOOLDEV:<INPUTDEV:FILE.BI
+@SWITCHES:
+/C     CARDS
+/E     DON'T ABORT ON MONITOR, CD AND CCL ERRORS
+/P     PTR
+/Q     NO BATCH LOG
+/H     HUSH
+/T     OUTPUT TO TTY
+/U     UNATTENDED
+/6     USE 026 CARD CODES
+\f
+&TECO
+&MAKE
+&MUNG
+       TECO.SV
+
+@CALLING COMMANDS:
+.TECO DEV:OUTFILE.PA<DEV:INFILE.PA
+.TECO FILE.PA                                  /ON DSK
+.MAKE DEV:OUTFILE.PA
+.MAKE OUTFILE.PA                               /ON DSK
+.MUNG DEV:INFILE.PA,TECO MACRO ARGUMENT TEXT
+@ERRORS:
+?ILL   ILLEGAL COMMAND
+?UTC   UNTERMINATED COMMAND
+?IQN   ILLEGAL Q-REGISTER NAME
+?PDO   INTERNAL PUSH DOWN OVERFLOW (RECURSION)
+?MEM   MEMORY OVERFLOW
+?STL   SEARCH STRING TOO LONG
+?ARG   ARGUMENT ERROR
+?IFN   ILLEGAL FILE NAME
+?SNI   SEMICOLON NOT IN ITERATION
+?BNI   CLOSE BRACKET NOT IN ITERATION
+?POP   POINTER OFF PAGE
+?QMO   Q-REGISTER OVERFLOW
+?UTM   UNTERMINATED MACRO
+?OUT   OUTPUT ERROR
+?INP   INPUT ERROR
+?FER   FILE ERROR
+?FUL   OUTPUT COMMAND WOULD HAVE OVERFLOWED
+?NAY   NEGATIVE ARGUMENT TO Y
+?IEC   ILLEGAL E CHARACTER
+?IQC   ILLEGAL " CHARACTER
+?NAE   NO ARGUMENT BEFORE =
+?NAU   NO ARGUMENT BEFORE U
+?NAQ   NO ARGUMENT BEFORE "
+?SRH   FAILING SEARCH
+?NAP   NEGATIVE OR 0 ARGUMENT TO P
+?NAC   NEGATIVE ARGUMENT TO ,
+?NIC   NEGATIVE OR 0 ITERATION COUNT
+?NAS   NEGATIVE OR 0 COUNT TO SEARCH
+?WLO   CAN'T WRITE OUT ERROR MESSAGE OVERLAY
+?NFO   NO FILE FOR OUTPUT
+\f
+&FOTP
+&LIST
+&COPY
+&RENAME
+&TYPE
+&DELETE
+       FOTP.SV
+@CALLING COMMANDS:
+.COPY DEV:OUTFILE.EX<DEV:INFILE.EX     /* IS WILD NAME OR EXTENSION
+.REN DEV:NEWFILE.EX<DEV:OLDFILE.EX     /? IS WILD CHARACTER
+.DEL DEV:FILE.EX
+.LIST DEV:FILE.EX                      /= .COPY LPT:<DEV:FILE.EX
+.TYPE DEV:FILE.EX                      /= .COPY TTY:<DEV:FILE.EX
+@SWITCHES:
+/C     MATCH ONLY FILES WITH CURRENT DATE
+/D     DON'T TRANSFER (I.E. AT MOST ONLY DELETE)
+/F     REQUEST NEW DEVICE IF OUT OF ROOM
+/L     TYPE LOG OF INPUT FILENAME MATCHES (*)
+/N     NO PRE-DELETE
+/O     MATCH ONLY FILES WITH OTHER THAN TODAY'S DATE
+/Q     QUERY USER ABOUT FILE BEFORE OPERATION (*)
+/R     RENAME
+/T     USE TODAY'S DATE
+/U     TREAT EACH INPUT SPECIFICATION SEPARATELY
+/V     MATCH FILES NOT OF FORM SPECIFIED
+/W     PRINT VERSION #
+NOTES:
+(*)    /D CAUSES LOG OF OUTPUT FILES (IF /L ALSO)
+IF INDEV: EQUALS OUTDEV:, THEN /N IS FORCED.
+IF NO INPUT FILE, *.* IS FORCED EXCEPT FOR /D
+IF OUTPUT DEVICE SPECIFIED, BUT NO FILE, *.* IS ASSUMED.
+^P     ABORT OPERATION, FIX OUTPUT DIRECTORY
+^C     FIX OUTPT DIRECTORY, RETURN TO OS/8
+^O     SUPPRESS TYPEOUT
+\f
+&ASSIGN
+&DATE
+&DEASSIGN
+&GET
+&MEMORY
+&R
+&RUN
+&SAVE
+&START
+&SQUISH
+&UA
+&ZERO
+       KEYBOARD MONITOR AN OTHER COMMANDS
+@CALLING COMMANDS:
+.ASSIGN DEV NAME               /ASSIGN NAME TO DEVICE
+.DAY DD-MON-YY                 /ENTER DATE INTO SYSTEM
+.DEASSIGN                      /DEASSIGN LOGICAL DEVICE NAMES
+.GET DEV FILE.EX               /LOAD CORE IMAGE
+.MEMORY N                      /SPECIFY HIGHEST MEMORY FIELD AVAILABLE
+.R FILE                                /EXECUTE FILE.SV FROM SYS
+.RUN DEV FILE.EX               /EXECUTE FILE.EX FROM THE DEVICE
+.SAVE DEV FILE.EX              /SAVE CORE IMAGE
+.SQUISH DEV:                   /COMPRESS FILE STORAGE ON DEVICE
+.START FNNNN                   /START EXECUTION
+.UA COMMAND                    /SAVE COMMAND(.UA<CR> EXECUTES IT)
+.ZERO DEV:                     /ZERO DEVICE'S DIRECTORY
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape7/OS8.PA b/sw/os8/v3d/sources/system/dectapes/dectape7/OS8.PA
new file mode 100644 (file)
index 0000000..ac836d2
--- /dev/null
@@ -0,0 +1,3749 @@
+/12 OS8 MONITOR SYSTEM         OS8 VERS. 3D
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT  (C)  1970,1971,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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/13-APRIL-1977                RL/EF/HJ/SR
+
+
+       /THIS VERSION OF OS/8 IS THE BATCH OPERATING SYSTEM
+       /AS WELL AS THE STANDARD KEYBOARD SYSTEM. THIS SYSTEM
+       /IS EXTERNALLY COMPATIBLE WITH ALL PREVIOUS OS/8-PS/8
+       /USER PROGRAMS. HOWEVER, INTERNALLY THE SYSTEMS ARE
+       /QUITE DIFFERENT. THE MARCH 1972 OS/8 WILL NOT RUN BATCH.
+       /THIS VERSION IS COMPATIBLE WITH CCL.
+
+/      SYMBOLIC REFERENCES TO VARIOUS OVERLAYS:
+
+       MEOVLY=26               /DIRECTORY OVERFLOW OVERLAY FOR "ENTER"
+       MCDREC=51               /COMMAND DECODER
+       MSOVLY=54               /"SAVE W. ARGS" OVERLAY
+       MSOVL2=55               /SECOND PART OF SAVE W. ARGS
+       MERRTN=56               /MONITOR ERROR ROUTINE
+       MRUNRC=57               /"CHAIN" OVERLAY
+       ODTREC=60               /SYSTEM ODT
+       MFREE=70                /BEGINNING OF FILE STORAGE
+       CCB=7400
+       CSOVLY=400
+       RSOVL1=1400
+       RSOVL2=2000
+
+       VERSNO=3
+       PATCHLEV="Q
+
+/V3 CHANGES:
+
+/1.    CCL SUPPORT
+/2.    FIXED KILLER CLOSE BUG
+/3.    ADDED VERSION NUMBER
+/4.    ^U, RO TO BOL, AND LF ALL PRINT '.' AGAIN
+/5.    CALL TO USR WITH CODE OF 0 GIVES ERROR
+/6.    MONITOR ERROR MESSAGES NOW GIVE EXPLANATION
+/7.    ENTER NOW MOVES 7 FILES TO MAKE ROOM INSTEAD OF HALF SEGMENT
+/8.    DIRECTORY VERIFICATION HAS IMPROVED
+
+/V3 FIXES TO ABSLDR:
+
+/1.    ALLOWED PARITY ^C
+/2.    PUT IN SELF-STARTING STUFF
+/3.    FIXED CCB BUG FOR 17600
+
+/FIXES TO FIELD RELEASE
+
+/1.    ABSLDR CHECKS PAGE 0 LITERALS
+/2.    FIXED BUG RE MONITOR ERROR MESSAGES
+/3.    ADDITIONAL INFO FIX
+/4.    BATCH FIX
+
+/FIXES FOR MAINTENANCE RELEASE:
+
+/1.    CHANGED VERSION NUMBER OF MONITOR TO V3M
+/2.    INCORPORATED PATCH RE LOC 13121 AFTER MONITOR ERROR
+/      [SEQ #1, DSN APRIL 1975]
+/3.    ALLOW CHAIN TO WORK ON FULL FIELD SAVES
+/      [SEQ #2, DSN  JUNE 1975]
+/4.    ALLOW ABSLDR/I TO WORK ON FULL FIELD CORE IMAGES
+/      [SEQ #1, DSN OCTOBER 1975]
+/5.    ADDED INTERNAL VERSION NUMBER TO ABSLDR AT LOCATION 2200
+/      MAINT. RELEASE VERSION # IS V4
+/6.    SET INITIAL ABSLDR DATE TO 1-NOVEMBER-1975
+
+/V3D AND OS/78 CHANGES:
+
+/1.    ACCEPT DEC STANDARD DATE FORMAT FOR INPUT (DD-MMM-YY)
+/2.    CHANGED VERSION NUMBER TO V3Q
+/3.    ADDED DATE/78 CHANGES
+/4.    FIXED BUG ABOUT WAITING FOR TTY FLAG & BATCH
+/5.    ADDED STUFF FOR LINKER [USES SOFSET]
+/6.    CHANGED ABSLDR DATE TO 1-JUNE-77
+/7.    DISALLOW RUN OF PROGRAM WITH BIT 4 OF JSW ON [OS/78 ONLY]
+/8.    ASSIGNED RESIDENT BITS FOR SCOPE AND OS/78
+/9.    ALLOW @ IN KBM COMMAND
+/10.   COULD RUN INIT.CM ON SYSTEM START-UP
+/11.   CHANGED BAD CORE IMAGE MSG TO CORE IMAGE ERR
+/12.   CHANGED ABSLDR/I SO THAT IT SETS UP JSW AND SA
+\f      /KEYBOARD MONITOR FOR OS/8 SYSTEM - UNCOMMENTED AT PRESENT
+
+       FIELD 0
+       MTHREE=CLA CLL CMA RTL
+       *200
+PRINT, JMP I PRNAME    /MUST BE AT 200 FOR BATCH
+       JMP .+3         /****GETS CIF CDF N FOR BATCH*****
+       TSF             /****GETS JMP I .+1******
+       JMP .-1         /*GETS BOSPRT*****
+       TLS
+       CLA
+       TAD [7000
+       DCA PRINT+1
+       JMP I PRINT
+GETNAM,        0
+       DCA NM1
+       DCA NM2
+       DCA NM3
+       DCA NM4
+       TAD [NM1
+       DCA PN
+       CLA CMA
+       DCA PRDSW
+GTNMX, DCA NMCT
+       TAD I LXR
+       TAD [-240
+       SNA
+       JMP .-3
+       TAD [240
+       SKP
+GTNMLP,        TAD I LXR
+       DCA TMP
+       TAD TMP
+       TAD [-256
+       SNA
+       JMP PERIOD
+       TAD [-2
+       CLL
+       TAD [-12
+       SNL CLA
+       JMP NINSRT
+       TAD [-301
+       TAD TMP
+       CLL CML
+       TAD [-32
+       SNL CLA
+       JMP EONAME
+NINSRT,        TAD NMCT
+       TAD [-6
+       SMA CLA
+       JMP GTNMLP
+       TAD NMCT
+       CLL RAR
+       TAD PN
+       DCA TEMP1
+       TAD TMP
+       AND [77
+       SZL
+       JMP .+4
+       RTL
+       RTL
+       RTL
+       TAD I TEMP1
+       DCA I TEMP1
+       ISZ NMCT
+       JMP GTNMLP
+PERIOD,        ISZ PRDSW
+       JMP EONAME
+       ISZ PN
+       TAD [4
+       JMP GTNMX
+EONAME,        TAD NMCT
+       SZA CLA
+       ISZ GETNAM
+       JMP I GETNAM
+\fPRNAME,       4000
+       TAD NM1
+       JMS PRWD
+       TAD NM2
+       JMS PRWD
+       TAD NM3
+       JMS PRWD
+       TAD NM4
+       SNA CLA
+       JMP I PRNAME
+       TAD [256
+       JMS PCHAR
+       TAD NM4
+       JMS PRWD
+       JMP I PRNAME
+PRINLP,        JMS PRWD
+       ISZ PRMESG
+       SKP
+       IFNZRO .-330 <CCLTRB,ERRR>
+PRMESG,        0
+       CLA
+       TAD I PRMESG
+       SZA
+       JMP PRINLP
+       TSF
+       JMP .-1
+       JMP I ERRET
+PRWD,  0
+       DCA TMP
+       TAD TMP
+       RTR
+       RTR
+       RTR
+       JMS PCHAR
+       TAD TMP
+       JMS PCHAR
+       JMP I PRWD
+PCHAR, 0
+       AND [77
+       SNA
+       JMP I PCHAR
+       TAD [240
+       AND [77
+       TAD [240
+       JMS I PCH
+       JMP I PCHAR
+\fPRINTQ,       JMS PRMESG
+       TEXT /?/
+       0
+
+       *367
+KSV2A, SAVE2A
+SAVE2, TAD I LXR
+       SNA             /ARE THERE ARGUMENTS?
+       JMP I KSV2A     /NO..USE CCB
+       JMS I [SHNDLR   /READ IN ARGUMENT OVERLAY
+       0201
+       CSOVLY
+       MSOVLY
+       JMP KMONER      /NORMAL RETURN IS TO 400
+\f      *400
+KMNTRY,        JMP I HANDAD    /V3
+       0               /FREE LOCATION !
+PCRLF, JMS I [CRLF
+       IFNZRO .-403 <BTCHER,XXXX>
+
+KEYMON,        JMS I GLINE
+       TAD [BEGLN-1    /ADDRESS REFERENCED BY INIT
+       DCA LXR
+       JMS I GNAME
+/V3D   JMP I [PRINTQ
+       XXX=[PRINTQ     /NEED LITERAL IN SAME PLACE
+       NOP             /V3D ALLOW @ IN NAME
+       JMS I [SRCH
+       -123;   ASSIGN
+       -2301;  SAVE
+       -2225;  RUN
+       -705;   GET
+       -2200;  R
+       -2324;  START
+       -1704;  ODT
+       -0405;  DEAS
+       IFNZRO .-431 <SEECCL,ZZZ>
+       -0401;  DATE
+       0
+       JMP I .+1
+CCLSW, PRQMRK          /MODIFIED FOR CCL TO 'GETCCL'
+       IFNZRO CCLSW-435 <SEECCL,ZZ>
+
+ASSIGN,        TAD [12
+       JMS GDEVNO
+       TAD [UDNAME-1
+       DCA TM1
+       JMS I GNAME
+       JMP ASGN2+1     /NO USER DEV. DO A DEASSIGN 
+       TAD NM2         /SEE IF WE HASH IT
+       SNA
+       JMP ASGN2       /DON'T HASH..ONLY 1 OR 2 CHARS
+       TAD NM1
+       RAL             /LINK BECOMES 4000 IF NECESSARY
+       CLA CML RAR
+       TAD NM2
+ASGN2, TAD NM1
+       JMP I [ASDONE
+\fR,    DCA I [GETSW
+       TAD P6203
+       JMS I [RESET
+       ISZ RUNSW
+       TAD [SHNDLR
+       DCA HANDAD
+       CLA IAC
+       JMP RGETPG
+GDEVNO,        0
+       DCA ASNM1-1
+       JMS I [MINCOR
+       JMS I GNAME
+       JMP I [KMER4
+       TAD NM1
+       DCA ASNM1
+       TAD NM2
+       DCA ASNM1+1
+       TAD HNDLAD
+       DCA HANDAD
+       CIF 10
+       JMS I SYSTEM
+       1
+ASNM1, 0;0
+HANDAD,        KMINIT          /V3
+       JMP I [KMER1
+       TAD ASNM1+1
+       JMP I GDEVNO
+\fGET,  TAD [SKP
+RUN,   DCA I [GETSW
+       TAD P6203
+       JMS I [RESET
+       DCA RUNSW
+       CLA IAC
+       JMS GDEVNO
+RGETPG,        JMS RSCOMN
+       JMS I [MINCOR
+       TAD SENTER
+       CIF 10
+       JMS I SYSTEM
+       2
+PGNAME,        NM1
+       MOVBUF          /USED AS POINTER TO FIELD 1 SR
+       JMP I [KMER2
+       JMP I [RLOADR
+RSCOMN,        0
+       DCA SENTER
+       TAD HANDAD
+       DCA DEVHND
+       JMS I GNAME
+       JMP I [KMER4
+       TAD NM4
+       SNA
+       TAD [2326
+       DCA NM4
+       JMP I RSCOMN
+SAVE,  TAD [SAVE12     /CHANGE ERROR RETURN ADDRESS AS WE WILL DESTROY CORE
+       DCA ERRET
+       TAD I [JSBITS
+       JMS I [RESET
+       CIF 10          /MOVE THE LINE BUFFER TO 1600 DURING
+       JMS I PGNAME+1  /A SAVE, AS HANDLER WIPES IT OUT
+       TAD LXR         /LET'S MOVE THE REGISTER AROUND
+       TAD [SVLNBF-BEGLN
+       DCA LXR
+       TAD [1001
+       DCA HNDLAD
+       CLA IAC
+       JMS GDEVNO
+       JMS RSCOMN
+       JMP I [SAVE2
+HNDLAD,                        /REPLACED WITH 1001 BY SAVE
+
+WRCTLB,        7001            /WRITE OVERLAY AND CCB
+       JMS I [SHNDLR
+       4600
+       6200
+       MTEMP+6
+       JMP KMONER
+       JMP I WRCTLB
+\f      *573            /LOADS SYSTEM ODT OVER THE MONITOR
+ODT,   JMS I PGTOUT
+       JMS I [SHNDLR
+       1001
+       0
+       ODTREC
+       /LOCATION 600 IN ODT IS A HLT (ERROR RETURN)
+\f      *600
+START, DCA TEMP1
+       DCA TEMP2
+       TAD I LXR       /V3
+       SZA             /V3
+       JMP I [STRTX    /V3
+       TAD I [JFIELD
+       DCA I [MSTCDF
+       TAD I [JSBITS
+       AND [1000
+       SZA CLA
+       JMP I [KMER3
+       TAD I [JSBITS
+       JMS I [RESET    /RESET ONLY IF NO START ADR SPECIFIED
+       TAD I [JSTART
+STCOMN,        DCA I [MSTADR
+       TSF
+       JMP .-1         /WAIT FOR PRINTER TO FINISH
+       JMS I PGTOUT
+       TAD I [JSBITS
+       SPA CLA
+       JMP I [MSTCDF
+       TAD [SHNDLR
+       DCA I [MREAD-1
+       TAD [1000
+       DCA I [MREAD+1
+       DCA I [MREAD+2
+       TAD [MTEMP+4
+       DCA I [MREAD+3
+       TAD FUDJMP
+       DCA I [MSWITC
+       JMP I [MREAD
+\fMINCOR,       0
+       CIF 10
+       JMS I SYSTEM
+       10
+       CDF 10
+       DCA I [OLDT9    /ZERO OUT "DIRECTORY IN CORE" KEY
+       CDF 0
+       TAD [200
+       DCA SYSTEM
+       JMP I MINCOR
+RLOADR,
+RUN1,  TAD I [PGNAME
+       DCA FILE
+       JMS I DEVHND
+       0101
+       CCB
+FILE,  0               /READ IN THE HEADER BLOCK
+       JMP KMONER      /ERROR WHILE READING HEADER BLOCK
+       TAD I [CCB
+       JMS I [CCBTST   /TEST FOR VALID CORE CONTROL
+       TAD I [CCB+3    /V3D
+       RAL             /V3D
+       JMS I KRCHK     /V3D CAN'T RUN SYSTEM CUSP UNDER OS78
+       TAD I [CCB+1
+       DCA I [MSTCDF
+       TAD I [CCB+2
+       DCA I [MSTADR   /MOVE THE STARTING ADDRESS INTO UPPER CORE
+       TAD I [CCB+1
+       DCA I [JFIELD
+       TAD I [CCB+2
+       DCA I [JSTART
+       TAD I [CCB+3    /SET UP THE JOB INFORMATION AREA
+       JMS I [RESET    /AND CLEAR INFORMATION ABOUT "RUN" HANDLER
+       TAD FUDJMP
+       DCA I [MSWITC           /SET MSWITC TO INHIBIT LOADING 7400
+GETSW, SKP                     /SKP FOR GET, NOP FOR RUN
+       JMP RUN2
+       TAD P6203
+       DCA I [MSTCDF
+       TAD [7600
+       DCA I [MSTADR           /IF A GET, SET STARTING ADDRESS TO RETURN
+                               /TO MONITOR
+\fRUN2, TAD I [CCB
+       CLL CMA RAL     /POINT TO LAST DOUBLEWORD IN CCB
+       TAD [CCB+4
+       DCA TM1         /TM1 POINTS TO SEG. ADDRESS
+       TAD I TM1       /STORE ADDRES TO READ POSSIBLE OVERLAY
+       DCA I [MREAD+2
+       ISZ TM1         /POINT TO SEGMENT CONTROL WORD
+       TAD DEVHND      /IF THE HANDLER IS IN 7600, OR
+       TAD [200        /IF THE SEGMENT DOES NOT LOAD OVER
+       CLA RAL         /7000, NO OVERLAY IS NEEDED. ALSO IF
+       TAD I TM1       /THE SEGMENT IS IN FIELDS 1-7.
+       AND [77
+RUN5A, SZA CLA
+       JMP I [RUN6     /NO PROBLEMS.. READ STUFF IN
+       TAD I [MREAD+2  /SEE IF WE OVERLAY 7000
+       CLL CML RAR
+       TAD I TM1       /ADD IN CONTROL WORD
+       TAD [300
+       SPA             /IF NEGATIVE, 7000 IS NOT OVERLAYED
+       JMP RUN5A
+       TAD [7600       /GETS 0, 100, 200, OR 300
+       SMA             /IF  POSITIVE READ 3 PAGE OVERLAY
+       ISZ I [PGNAME+1 /POINT TO NEXT TO LAST RECORD
+       TAD [300
+       DCA RDCNT
+       TAD I [PGNAME+1
+       CMA             /GET RECORD TO READ OVERLAY FROM
+       TAD FILE
+       DCA R7000
+       JMS I DEVHND    /READ OVERLAY FROM THE FILE INTO PAGES
+RDCNT, 0       /BEFORE CCB
+       6200            /THEN WRITE THE WHOLE MESS OUT
+R7000, 0
+       JMP I [RERR
+       JMS I [WRCTLB   /WRITE OUT THE OVERLAY+CCB
+       DCA .-1         /BUT ONLY ONCE!!
+       ISZ RUNSW
+       DCA I [MSWITC   /ENABLE READ OF OVERLAY
+       TAD RDCNT       /SEE IF THIS SEG IS EXHAUSTED
+       CIA
+       TAD I TM1
+       SPA SNA
+       ISZ I [CCB      /ARE WE DONE ALL SEGMENTS?
+       SKP             /NOT YET. LOOP UNTIL DONE
+       JMP I [MSWITC
+RUN5,  DCA I TM1       /SAVE ALTERED CONTROL WORD
+       JMP RUN2
+\f/ASDONE,      CDF 10
+/      DCA I TM1       /THIS COULD BE OPTIMIZED
+/      CDF 0
+/      JMP I [KEYMON
+
+KMER1, JMS I [PRNAME   /DEVICE NOT AVAILABLE
+       JMS I [PRMESG
+       TEXT    / NOT AVAILABLE/
+\f      *1000
+/MUST BE AT 1000 FOR BATCH
+BEGLN, 0       /LINE BUFFER    COULD BECOME "@
+       "I
+       "N
+       "I
+       "T
+KMINIT,        CDF 10          /INITIALIZATION - DESTROYED BY LINE BUFFER
+       ISZ I [7700     /LOC 17700=7777 IF I/O MONITOR IS KNOWN
+       JMP .+3         /TO BE IN CORE, SO SET UP
+       TAD [200        /THE INITIAL POINTER FOR CALLS TO THE MONITOR
+       DCA SYSTEM      /ACCORDINGLY
+       CDF 0
+       TAD I LXR
+       DCA I X1
+       ISZ TEMP2
+       JMP .-3
+       CDF 10
+       TAD MVFROM
+       DCA I PDBUF
+       ISZ .-2
+       ISZ PDBUF
+       ISZ MVCNT
+       JMP .-5
+       CDF 0
+       TAD I PDBUF+1   /SEE IF BATCH IS SET
+       RAL             /IF YES, GO TO PAGE 0 TO CONTINUE
+       SMA CLA         /IF IT ISN'T, CONTINUE NORMALLY
+       JMP INTGO       /NORMAL KEYBOARD SYSTEM
+       DCA I RTWTPT    /DON'T WAIT ON TTY FLAG IF BATCH IS RUNNING
+       TAD I [JSBITS   /IS BOS IN PLACE?
+       AND DCBF
+       SNA CLA
+       JMP BATCH       /NO. GO READ IT IN.
+       JMP BCHGO       /YES. START IT UP.
+INTGO, TAD [200
+       KRS
+       TAD M203
+       SNA CLA         /IS THERE A ^C IN THE READER BUFFER
+       KSF             /WITH THE FLAG ON?
+       JMP I ERRET     /NO - PRINT CRLF AND PERIOD
+       JMP CLR         /V3D
+/CCLADR,       GETCCL  /V3D DIDN'T SEEM TO BE USED
+RTWTPT,        RUNTWT
+DCBF,  400
+/START
+PMSRST,        SHNDLR&177+4200 /JMS SHNDLR
+       0300
+       7000
+       MTEMP+6
+       HLT             /CONTAINS SECOND COPY OF OS/78 BIT
+       CDF CIF 0
+       TCF
+/END
+MVCNT, MOVBUF-MVT3-1
+PDBUF, MOVBUF
+\fMVFROM,       NOPUNCH
+       *7626
+       ENPUNCH
+MOVBUF,        7777    /USED IN BATCH SETUP
+       TAD I MVT1      /MOVE THE LINE BUFFER FROM 1000
+       DCA I MVT2      /TO 1655
+       ISZ MVT1
+       ISZ MVT2
+       ISZ MVT3
+       JMP .-5
+       CIF CDF 0
+       JMP I MOVBUF
+
+MVT1,  BEGLN
+MVT2,  SVLNBF
+MVT3,  -112
+
+
+       *1077           /V3D
+INIT,  CDF 10          /V3D (INITIALIZATION)
+       TAD DCBF
+       DCA I ROT       /RESTORE LOC 7677 TO '400'
+       CDF 0
+       DCA KMINIT      /END LINE WITH 0
+       TLS
+       JMP I CRLF      /FAKE OUT KBM AS IF USER TYPED @INIT
+
+
+CLR,   KCC
+       JMP I .+1
+       CTRLC
+\f      *1112
+       ENPUNCH
+
+DIGTLP,        TAD I LXR
+STRTX, TAD (-270
+       CLL
+       TAD [10
+       DCA TMP1        /V3
+       SNL
+       JMP EONUM
+/V3    ISZ DIGFLG
+       JMS ROT
+       JMS ROT
+       JMS ROT
+       TAD TEMP2
+       TAD TMP1
+       DCA TEMP2
+       JMP DIGTLP
+EONUM, TAD TEMP1
+       AND [7
+       CLL RTL
+       RAL
+       TAD KM6203
+       DCA I [MSTCDF
+       TAD TEMP2
+       JMP I .+1
+       STCOMN
+
+ROT,   7677            /V3D NEEDED FOR INIT
+       TAD TEMP2
+       CLL RAL
+       DCA TEMP2
+       TAD TEMP1
+       RAL
+       DCA TEMP1
+       JMP I ROT
+\fDEAS, TAD [UDNAME-1
+       DCA X1
+       TAD [-17
+       DCA TM1
+       CDF 10
+       DCA I X1
+       ISZ TM1
+       JMP .-2
+KM6203,        CDF CIF 0
+       JMP I [KEYMON
+
+ASDONE,        CDF 10          /V3
+       DCA I TM1       /V3
+       JMP KM6203      /V3
+
+
+CRLF,  KEYMON+1        /V3D NEEDED FOR INIT
+       TAD [215
+       DCA NM1
+       JMS I (PRNT
+       TAD [212
+       JMS I PCH
+       JMP I CRLF
+
+M203,  -203
+       PAGE
+\f/NOTE: XR=AMFLAG !
+
+       *1200
+       /TELETYPE INPUT ROUTINE
+XGLINE,        KEYMON+1                /MUST BE AT 1200 FOR BATCH & CCL
+       TAD [".
+       JMS I PCH
+       DCA RBFLAG
+       TAD [BEGLN-1
+CHLM1, DCA LXR
+       DCA AMFLAG      /ZERO ALTMODE FLAG
+CHLOOP,        KSF
+       JMP CHLOOP
+       TAD [200
+       KRS
+       DCA NM1
+       KCC
+       JMS SRCH
+       -225;CTRLU
+       -215;CARRET
+       -377;RUBOUT
+       -375;ALTMOD     /THIS AREA GETS MODIFIED BY SET
+       -376;ALTMOD
+       -233;ALTMOD
+       -212;LFEED
+       -200;CHLOOP
+       -217;CHLOOP     /IGNORE ^O
+       -203;CTRLC      /MUST BE JUST BEFORE 0
+                       /MUST BE HERE FOR CCL
+       0
+       JMS PRNT
+CINSRT,        TAD NM1
+       DCA I LXR
+       TAD LXR
+       TAD [-BEGLN-110
+       SPA CLA
+       JMP CHLOOP
+CARRET,        JMS I [CRLF
+       TAD LXR
+       TAD [1-BEGLN
+       SNA CLA
+       JMP XGLINE+1
+       DCA I LXR
+       DCA I LXR
+       JMP I XGLINE
+\f/THIS PAGE GETS MODIFIED BY SET COMMANDS (FOR REAL SCOPE RUBOUTS)
+/**** BEWARE! ***
+
+PRNT,  0
+       ISZ RBFLAG
+       JMP .+3
+       TAD ["\
+       JMS I PCH
+       DCA RBFLAG
+       TAD NM1
+       JMS I PCH
+       JMP I PRNT
+CTRLC,
+CTRLU, TAD ["^
+       JMS I PCH
+       TAD NM1
+       TAD [100
+CLRLIN,        JMS I PCH
+RBSPCL,        JMS I [CRLF
+       JMP XGLINE+1
+
+ALTMOD,        TAD ["$
+       DCA NM1
+       JMS PRNT
+       ISZ AMFLAG      /NOTE ALTMODE
+       JMP CARRET+1
+RUBOUT,        TAD LXR
+       TAD [1-BEGLN
+       SNA CLA
+       JMP RBSPCL
+       TAD ["\         /MUST BE HERE
+       ISZ RBFLAG
+       JMS I PCH
+       CLA CMA
+       DCA RBFLAG
+       TAD LXR
+       DCA TEMP1
+       TAD I TEMP1
+       JMS I PCH
+LBCKUP,        CLA CMA
+       TAD LXR
+       JMP CHLM1
+\fSRCH, 0
+       TAD I SRCH
+       ISZ SRCH
+       SNA
+       JMP I SRCH
+       TAD NM1
+       SNA CLA
+       JMP SFND
+       ISZ SRCH
+       JMP SRCH+1
+SFND,  TAD I SRCH
+       DCA TEMP1
+       JMP I TEMP1
+LFEED, JMS I [CRLF
+       DCA I LXR
+       TAD [".
+       JMS I PCH
+       TAD [BEGLN-1
+       DCA XR
+       TAD I XR
+       SNA
+       JMP LBCKUP
+       JMS I PCH
+       JMP .-4
+
+PRQMRK,        JMS I [PRNAME
+       JMP I [PRINTQ
+       IFNZRO PRQMRK-1357 <SEECCL,ZZXX>
+       ZBLOCK 1        /A FREE LOCATION!
+
+       IFNZRO .-1362 <FIXCCL,ERRRR>
+
+GETCCL,        TAD [6003
+       JMS I [RESET
+       TAD [67         /CCL OVERLAY BLOCK IS BLOCK 67 ***
+       DCA OV
+       JMP DATE2
+DATE,  TAD TMP
+       SNA CLA
+       JMP I [CCLSW-1  /USED TO BE JMP GETCCL
+DATE2, JMS I [SHNDLR   /READ IN DATE OVERLAY
+       0201
+       0400
+OV,    MSOVL2
+       JMP KMONER
+       JMP I [600
+       PAGE
+\f      *1400
+SAVE2A,        JMS I [SHNDLR
+       0201
+       400
+       MTEMP+10
+       JMP KMONER
+SAVE3, TAD [603
+       DCA XR
+       TAD I [600
+       DCA TM1
+       TAD TM1
+       JMS I [CCBTST   /CHECK TM1 FOR VALID CCB
+SAVE3A,        ISZ XR
+       TAD I XR        /GET THE I/O CONTROL WORD OF THIS SEGMENT
+       JMS I PROTAT    /EXTRACT THE LENGTH FROM IT
+       TAD CLENGT
+       DCA CLENGT      /UPDATE THE LENGTH OF THE FILE
+       ISZ TM1
+       JMP SAVE3A              /LOOP FOR ALL SEGMENTS OF THE FILE
+       TAD CLENGT      /USE THIS LENGTH WHEN ENTERING THE FILE
+       CLL RTL
+       RTL
+       TAD SENTER
+       CIF 10
+       JMS I SYSTEM
+       3               /ENTER
+SFILE, NM1
+       0               /LENGHT UNIMPORTANT
+       JMP SAVERR
+       TAD SENTER
+       CIF 10
+       JMS I SYSTEM
+       4               /CLOSE
+       NM1             /NAME FOR "CLOSE"
+CLENGT,        1               /CLOSING LENGTH
+       JMP SAVERR
+       TAD [603
+       DCA XR
+       JMS I PGTOUT    /KICK THE I/O MONITOR OUT IF NECESSARY
+       TAD I [JSBITS
+       RAL
+       CMA             /IF JOB LOADS INTO LOCS 0-1777,
+       SNL SMA CLA     /BUT NOT INTO LOCS 10000-11777,
+       JMS LOADF0      /LOAD 0-1777 INTO 10000-11777 NOW
+       TAD SFILE
+       DCA SWFILE
+       JMS SWRITE      /WRITE OUT CONTROL BLOCK
+SAVE4, TAD I XR
+       DCA SADR
+       CLA CLL CML RAR
+       TAD I XR
+       DCA SCTL
+\fSAVE5,  TAD SADR
+        RAL
+        SZL SPA CLA     /DOES THIS SEGMENT START BELOW 2000?
+        JMP SAVE8       /NO - NOTHING TO WORRY ABOUT
+        TAD SCTL
+        AND [70
+        SZA CLA         /FIELD 0?
+        JMP SAVE8       /NO - SAVE AS IS
+SAVE6,  JMS LOADF0      /LOAD THE FIELD 0 SAVE AREA OVER THE I/O MONITOR
+SAVE7,  CLA CMA
+        TAD SCTL
+        CLL RAL
+        TAD SADR
+        RAL
+        SZL SPA CLA     /CHECK WHETHER UPPER LIMIT IS ABOVE 2000
+        JMP SAVE7A      /IT IS - MUST MAKE 2 WRITES
+        TAD SCTL        /TOTALLY CONTAINED IN 0-1777
+        TAD [10                /CHANGE FIELD 0 TO FIELD 1 AND CONTINUE
+        JMP SAVE8A
+SAVE7A, TAD SCTL        /WRITE IN 2 PARTS -
+        DCA TM1
+        TAD SADR
+        CIA         /FIRST PART FROM FIELD 1, EVERYTHING BELOW 2000
+        TAD [2020
+        CLL CML RAR
+        DCA SCTL
+        JMS SWRITE
+        CLA CLL CML RTR
+        DCA SADR
+        TAD SCTL        /SECOND PART FROM FIELD 0, EVERYTHING ABOVE 2000
+        AND [3700
+        CIA
+        TAD TM1
+       SMA             /FULL FIELD SAVE IN F0 MAKES THIS +
+       TAD [4000       /COMPENSATE FOR THAT CASE
+SAVE8A, DCA SCTL
+SAVE8,  JMS SWRITE
+        ISZ I [600
+        JMP SAVE4
+SAVE12, JMS I [SHNDLR
+        0610
+        0
+        MONTOR          /FORCE THE I/O MONITOR BACK INTO CORE
+        JMP KMONER      /(OY VEH!)
+        CLA CMA
+        CDF 10
+        DCA I [7700     /TELL THE KEYBOARD MONITOR THAT ITS IN CORE
+        JMP I [7605     /*** DEPENDS ON 7605 BEING A CDF CIF 10 ***
+
+\fLOADF0,       0
+       ISZ F0OVLY      /HAS THE FIELD 0 OVERLAY BEEN LOADED BEFORE?
+       JMP I LOADF0    /EVIDENTLY
+       JMS I [SHNDLR
+       1010
+F0OVLY,        -1              /WILL BE 0 IF WE EXECUTE THIS CODE, OF COURSE
+       MTEMP+4
+       JMP KMONER
+       JMP I LOADF0
+
+SWRITE,        0
+       JMS I DEVHND
+SCTL,  4101
+SADR,  600
+SWFILE,        0
+       JMP SAVERR
+       TAD SCTL
+       JMS I PROTAT
+       TAD SWFILE
+       DCA SWFILE      /BUMP RECORD NUMBER
+       JMP I SWRITE
+SAVERR,        JMS I [PRMESG
+       TEXT    /SAVE ERROR/
+PROTAT,        ROTAT
+\f      *1600
+KMER4, JMS I [PRMESG
+       TEXT    /TOO FEW ARGS/
+CCBTST,        0       /EXAMINE COUNT WORD OF CCB FOR VALIDITY
+                       /ASCII AND BINARY FILES USUALLY FAIL THIS TEST
+       CMA
+       AND [7740
+       SNA CLA
+       JMP I CCBTST    /IT WAS VALID
+CIERR, TAD [7605
+       DCA ERRET       /RELOAD MONITOR ON THIS ERROR
+       JMS I [PRMESG   /IT WASN'T - TELL THE USER
+       TEXT    /CORE IMAGE ERR/
+GETOUT,        0               /SUBROUTINE TO KICK MONITOR OUT IF NECESSARY
+       TAD I [JSBITS
+       RAR
+       CLA
+       TAD SYSTEM
+       SZL SPA CLA     /IS THE SYSTEM IN CORE AND SHOULD IT BE?
+       JMP I GETOUT
+       CIF 10          /YES AND NO - KICK IT OUT
+       JMS I SYSTEM
+       11              /BYE BYE
+       TAD [7700
+       DCA SYSTEM
+       JMP I GETOUT
+\fSVLNBF,
+KMER2, JMS I [PRNAME
+       JMS I [PRMESG
+       TEXT    / NOT FOUND/
+/
+/NEXT 112 LOCATIONS DESTROYED BY THE LINE BUFFER DURING A SAVE
+/
+
+RESET, 0
+       DCA I [JSBITS   /MARK AREAS FOR I/O OPTOMIZATION
+       JMS I [MINCOR
+       CIF 10
+       JMS I SYSTEM
+       13              /RESET DEVICE HANDLERS AND OUTPUT FILES
+/V3D   CDF 0           /THIS INSTRUCTION SEEMS UNNECESSARY
+       JMP I RESET
+
+RCHK,  0
+       AND I RADR      /V3D
+       AND [200        /CAN'T ALLOW BOTH OS78 BIT AND SYSTEM CUSP BIT
+       SNA CLA
+       JMP I RCHK
+       JMP CIERR       /V3D CAN'T FALL INTO KMER3
+                       /BECAUSE HAVE TO RELOAD KBM TO RESET 'PGNAME'
+KMER3, JMS I [PRMESG
+       TEXT    /NO!!/
+
+RUN6,  TAD I TM1       /STORE CONTROL WORD FOR LAST SEG.
+       DCA I [MREAD+1
+       TAD RUNSW       /IS THIS R OR RUN?
+       SNA CLA
+       JMS I [WRCTLB   /RUN
+       TAD I RFILE     /V3D FOR LINKER
+       DCA I RCTL      /V3D SAVE BLOCK NUMBER IN 'SOFSET'
+       TAD I RFILE
+RUN7,  IAC
+       DCA RUNFIL              /STORE STARTING BLOCK NUMBER
+       TAD DEVHND
+       DCA I [MREAD-1
+       TAD DEVHND
+       DCA RUNHND              /STORE DEVICE HANDLER ENTRY IN THIS PAGE
+       TAD I ADR1
+       DCA I ADR2
+       ISZ ADCNT
+       JMP .-3
+       JMP I .+1               /AND GO TO IT
+       RUN8&177+7400
+
+RFILE, FILE
+ADCNT, RUN8&177+7600
+\fRUN8, ISZ I R7400     /IS THIS THE LAST PARAMETER PAIR?
+       JMP RUN9        /NO - KEEP LOADING
+       TAD RUNFIL
+       DCA I RMRD3     /MOVE THE RECORD NUMBER INTO THE FINAL READ
+       TSF
+RUNTWT,        JMP .-1         /WAIT FOR THE TELETYPE TO DIE DOWN (RF08 IS FAST!)
+       JMP I .+1
+       MREAD           /READ THE LAST SEGMENT AND START UP
+RUN9,  TAD I RUNADR
+       DCA RADR        /SET UP THE LOADING ADDRESS OF THE CURRENT SEGMENT
+       ISZ RUNADR
+       TAD I RUNADR
+       DCA RCTL        /AND THE READ CONTROL WORD
+       JMS I RUNHND
+RCTL,  SOFSET          /V3D THESE ARE STORED INTO ONLY AFTER MOVING
+RADR,  OS78            /V3D
+RUNFIL,        0
+       JMP RERR                /INPUT ERROR READING THE PROGRAM
+       TAD RCTL
+       JMS ROTAT               /GET THE BLOCK LENGTH OF THIS SEGMENT
+       TAD RUNFIL
+       DCA RUNFIL              /UPDATE THE BLOCK NUMBER FROM IT
+       ISZ RUNADR
+       JMP RUN8                /BACK FOR ANOTHER ONE
+
+RERR,  CIF 10
+       JMS I RU7700
+       7
+       0       /TOTALLY MEANINGLESS
+RUNADR,        CCB+4
+R7400, 7400
+RMRD3, MREAD+3
+RU7700,        7700
+RUNHND,        0
+       IFNZRO ROTAT-SVLNBF-112&4000 <ERROR>
+       *1765   /MUST BE AT TOP OF PAGE
+ROTAT, 0
+       CLL RTR
+       RTR
+       RTR
+       AND RU37
+       SNA
+       TAD RU37
+       IAC
+       CLL RAR
+       JMP I ROTAT
+RU37,  37
+\f      /OVERLAY TO KEYBOARD MONITOR FOR "SAVE" WITH ARGUMENTS
+       *2000           /GOES INTO 400
+SAVE1A,        TAD (1603
+       DCA X1
+       DCA TM1
+       CDF 10
+       DCA I [OLDT9
+S6203, CIF CDF 0
+       TAD (SGETOUT-RSOVL2     /POINTER TO NEW GETOUT
+
+       DCA PGTOUT              /LIKEWISE "GETOUT"
+       JMS I [SHNDLR
+       0210
+       1400
+       MTEMP+10                /READ IN CONTROL BLOCK
+       JMP KMONER
+       JMS LXRBAK              /RESET LXR TO LOOK AT FIRST CHAR
+       JMS LXRBAK
+       DCA DASHFG
+SNUMLP,        JMS SGTNUM
+       JMP SDLOOK      /NO NUMBER - GET DELIMETER
+       TAD I LXR
+       TAD (-"-
+       SNA CLA
+       JMP SVDASH
+       JMS LXRBAK
+       TAD DASHFG
+       SNA CLA         /WAS THERE A LOWER LIMIT?
+       JMS DASHSB      /NO - SET LOWER LIMIT TO UPPER LIMIT
+       TAD TEMP1
+       CIA CLL CML
+       TAD OLD1
+       SZA CLA /ARE THE FIELDS THE SAME?
+       JMP KMER5       /NO - ERROR
+       TAD TEMP2
+       AND [7600
+       TAD [200
+       DCA TEMP2
+       TAD TEMP2
+       CIA
+       TAD OLD2
+       SZL CLA         /IS UPPER LIMIT > LOWER LIMIT?
+       JMP KMER5       /NO - ERROR
+       CDF 10
+       TAD OLD1
+       DCA I X1
+       TAD OLD2
+       DCA I X1
+       TAD TEMP2
+       DCA I X1        /CREATE A TRIPLET(FIELD, LOW LIMIT, HIGH LIMIT)
+                       /IN THE TABLE IN FIELD 1
+       ISZ TM1         /BUMP ENTRY COUNT
+\fSDLOOK,       CDF 0
+       TAD I LXR
+       SNA
+       JMP I (SVEND-RSOVL1
+       TAD (-",
+       SNA
+       JMP SNUMLP-1
+       TAD (",-";
+       SNA
+       JMP SSTADR
+       TAD (";-"=
+       SNA CLA
+       JMP I (SSBITS-RSOVL1
+KMER5, JMS I [PRMESG
+       TEXT    /BAD ARGS/
+LXRBAK,        0
+       CLA CMA
+       TAD LXR
+       DCA LXR
+       JMP I LXRBAK
+SVDASH,        TAD DASHFG
+       SZA CLA
+       JMP KMER5
+       ISZ DASHFG
+       JMS DASHSB
+       JMP SNUMLP
+SSTADR,        JMS SGTNUM
+       JMP KMER5       /NULL STARTING ADR - ERROR
+       TAD TEMP1
+       AND [7
+       CLL RTL
+       RAL
+       TAD S6203
+       CDF 10
+       DCA I (1601     /STORE AWAY STARTING FIELD
+       TAD TEMP2
+       DCA I (1602     /AND STARTING ADDRESS
+       JMP SDLOOK
+DASHSB,        0
+       TAD TEMP1
+       AND [7
+       DCA OLD1
+       TAD TEMP2
+       AND [7600
+       DCA OLD2
+       JMP I DASHSB
+DASHFG,        0
+OLD1,  0
+OLD2,  0
+
+\fSGTNUM,       0       /GET A NUMBER ROUTINE
+       DCA DIGFLG      /CLEAR DIGIT COLLECTED FLAG
+       DCA TEMP1
+       DCA TEMP2
+       JMS I (STARTX-RSOVL1
+       JMP .+4
+       TAD (20
+       SNA CLA
+       JMP .-4
+       JMS LXRBAK      /SHOVE INDEX BACK
+       TAD DIGFLG      /IS DIGIT PRESENT?
+       SZA CLA
+       ISZ SGTNUM
+       JMP I SGTNUM
+       PAGE
+\f      *2200   /LOADS INTO 600
+SSBITS,        JMS I (SGTNUM-RSOVL1
+       JMP I (KMER5-RSOVL1
+       TAD TEMP2
+       CDF 10
+       DCA I (1603
+       JMP I (SDLOOK-RSOVL1
+SVEND, JMS I [SHNDLR
+       0101
+       0400
+       MSOVL2          /READ IN SECOND PART OF OVERLAY
+       JMP KMONER
+       TAD TM1
+       SNA
+       JMP I (MOVECB-RSOVL2
+       CIA
+       CDF 10
+       DCA I (1600
+               /NOW SORT THE ENTRIES IN THE SEGMENT TABLE ON 
+               /DECREASING FIELD AND INCREASING ADDRESS
+               /WITHIN THE FIELD.
+       TAD (1603
+       DCA P1
+       CLA IAC
+       TAD I (1600
+       SNA
+       JMP I (SORTED-RSOVL2    /RIDICULOUS TO SORT ONE ITEM
+       DCA TEMP1
+OUTRLP,        TAD (3
+       TAD P1
+       DCA P2
+       TAD TEMP1
+       DCA TEMP2
+INERLP,        TAD P1
+       DCA LXR
+       TAD P2
+       DCA X1
+       TAD I LXR
+       CIA CLL
+       TAD I X1
+       SNA CLA
+       JMP TIE         /FIELDS ARE EQUAL - SORT ON ADDRESS IN FIELD
+       SZL
+       JMP SWITCH      /WRONG ORDER - SWITCH 'EM
+TIENTY,        TAD P2
+       TAD (3
+       DCA P2          /INDEX TO NEXT ENTRY
+SWNTRY,        ISZ TEMP2
+       JMP INERLP
+       TAD P1
+       TAD (3
+       DCA P1          /ELEMENT IS IN PLACE - GO TO NEXT POSITION
+       ISZ TEMP1
+       JMP OUTRLP
+       JMP I (SORTED-RSOVL2    /SORT COMPLETE - CHECK FOR CONSISTENCY
+\fTIE,  TAD I LXR
+       CIA CLL
+       TAD I X1
+       SZL CLA         /TEST FOR ADRESSES IN ASCENDING ORDER
+       JMP TIENTY      /YES - DONT HAVE TO SWAP
+SWITCH,        JMS SWSUBR
+       JMS SWSUBR
+       JMS SWSUBR
+       CLA CLL CMA RTL
+       TAD P1
+       DCA P1          /RESET FIRST POINTER
+       JMP SWNTRY      /AND DONT BUMP 2D POINTER, AS WE HAVE JUST BUMPED IT
+SWSUBR,        0
+       ISZ P1
+       ISZ P2
+       TAD I P1
+       DCA TM1
+       TAD I P2
+       DCA I P1
+       TAD TM1
+       DCA I P2
+       JMP I SWSUBR
+P1,    0
+P2,    0
+
+\fSTARTX,       0
+       TAD I LXR       /ANYTHING LEFT?
+       SNA
+       JMP I STARTX    /NO.. TAKE EMPTY RETURN
+       SKP
+ADGTLP,        TAD I LXR
+       TAD (-270
+       CLL             /SEE IF THIS IS A DIGIT
+       TAD [10
+       SNL
+       JMP AONUM       /NO.. GET OUT
+       DCA TMP1
+       ISZ DIGFLG
+       JMS ROT2
+       JMS ROT2
+       JMS ROT2
+       TAD TEMP2
+       TAD TMP1
+       DCA TEMP2
+       JMP ADGTLP      /KEEP LOOKING
+AONUM, ISZ STARTX
+       JMP I STARTX
+
+ROT2,  0
+       TAD TEMP2
+       CLL RAL         /WE NEED THIS BECAUSE THE HANDLER
+       DCA TEMP2       /WIPED THE FIRST COPY (MAYBE!!!)
+       TAD TEMP1
+       RAL
+       DCA TEMP1
+       JMP I ROT2
+       PAGE
+\f      *2400           /LOADS INTO 400 ON TOP OF SAVE1A
+SORTED,        TAD I (1600
+       IAC
+       SNA             /IS THERE ONLY ONE ITEM IN THE LIST?
+       JMP MERGED      /YES - DON'T COMPRESS FURTHER
+       DCA TEMP1
+       TAD (1603
+       DCA X1
+       TAD (1606
+       DCA LXR
+               /NOW CHECK THE SORTED FILE FOR CONSISTENCY
+               /OVERLAPPING SEGMENTS ARE ERRORS,
+               /ABUTTING SEGMENTS ARE TO BE CONDENSED IN
+               /THE INTERESTS OF SPEED
+MRGLP, TAD I LXR
+       CIA
+       TAD I X1
+       SZA CLA
+       JMP NOCMPR      /DIFFERENT FIELDS - INCOMPARABLE
+       ISZ X1
+       TAD I X1
+       CIA
+       CLL
+       TAD I LXR
+       SNA CLA
+       JMP BUTTNG      /UPPER LIMIT(2)=LOWER LIMIT(1) - ABUTTING SEGMENTS
+       SZL CLA
+       JMP NXTONE      /UPPER LIM(2)<LOWER LIM(1) - NORMAL CASE
+       CDF 0           /UPPER LIM(2) > LOWER LIM(1) - ERROR
+       JMS I [PRMESG
+       TEXT    /BAD ARGS/
+BUTTNG,        CLA CMA
+       TAD X1
+       DCA X1
+       TAD I LXR
+       DCA I X1        /SET UPPER LIM(2) = UPPER LIM(1)
+       TAD X1
+       TAD (-1777
+       SZA CLA
+       JMP .-5         /AND COMPRESS OUT THE LOWER ENTRY
+       ISZ I (1600     /DECREMENT THE ENTRY COUNT (CAN'T OVERFLOW)
+       JMP SORTED      /START OVER FROM BEGINNING
+
+NOCMPR,        ISZ X1
+       ISZ X1
+       ISZ LXR
+NXTONE,        ISZ LXR
+       ISZ TEMP1
+       JMP MRGLP       /NOW ALL THAT REMAINS IS TO TRANSFORM OUR TRIPLETS
+                       /INTO THE FORMAT WHICH THE RUN LOADER EXPECTS; I.E.
+               /DEVICE-HANDLER ARGUMENTS
+\fMERGED,       TAD (1603
+       DCA LXR
+       TAD (1603
+       DCA X1
+       TAD I (1603
+       AND (1777
+       TAD (6000
+       DCA I (1603     /INITIALIZE STATUS BITS TO NO OVERLOADS
+       TAD I (1600
+       DCA TEMP1
+MERGLP,        TAD I LXR
+       DCA TEMP2
+       TAD I LXR
+       AND (7400
+       DCA TMP1
+       TAD TMP1
+       DCA I X1        /STORE ADDRESS
+       TAD TMP1
+       CIA
+       TAD I LXR       /FORM UPPER LIM - LOWER LIM
+       CLL RTR
+       RTR
+       TAD TEMP2       /ADD IN FIELD
+       RAL
+       RTL             /ROTATE WHOLE MESS INTO PLACE
+       DCA I X1
+       TAD TMP1
+       CLL RAL
+       SZL SPA CLA     /IS THE LOWER LIMIT < 2000?
+       JMP NXTSEG      /NO
+       TAD TEMP2
+       RAR
+       SZA CLA         /YES- IS THE FIELD 0 OR 1?
+       JMP NXTSEG      /NO
+       SNL
+       IAC
+       CMA CML RTR
+       AND I (1603     /AND OUT THE PROPER OVERLOAD BIT
+       DCA I (1603
+NXTSEG,        ISZ TEMP1
+       JMP MERGLP
+MOVECB,        TAD (1577
+       DCA LXR
+       TAD (577
+       DCA X1
+       TAD [7600
+       DCA TEMP1
+CBMOVE,        CDF 10          /FINAL CODE TO MOVE NEW CONTROL BLOCK
+       TAD I LXR       /INTO PAGE 600 OF FIELD 0
+       CDF 0
+       DCA I X1
+       ISZ TEMP1
+       JMP CBMOVE
+       JMP I (SAVE3            /EXIT TO SAVE PROCESSOR 
+
+\fSGETOUT,0             /REPLACES "GETOUT" WHICH WE'VE STORED OVER
+       TAD I [JSBITS
+       RAL             /ONLY PERFORMS THOSE FUNCTIONS THAT "SAVE" NEEDS
+       SPA CLA
+       JMP I SGETOUT
+       CIF 10
+       JMS I SYSTEM
+       11
+DECIMB,        JMP I SGETOUT   /DECIMB ONLY CALLED BY NEXT PAGE
+                       /PART OF NEXT PAGE'S ROUTINE:
+       TAD NM2         /ALL NEW FOR V3D
+       TAD NM4         /ONLY ALLOW 2 CHARS FOR MM
+       SNA CLA
+       ISZ DECIMB
+       TAD NM1
+       RTR
+       RTR
+       JMP I DECIMB
+       PAGE
+\f      *2600           /DATE PROCESSOR - LOADS IN 400, RUNS IN 600
+DATEXX,        JMS DECIM
+NUM2,  DCA NUM2
+       TAD NUM2
+       TAD M40
+       SMA CLA
+       JMP BADNUM      /DAY > 31
+       JMS I GNAME
+L30,   30              /NOTHING FOUND WILL GIVE ERROR LATER
+/      DCA NUM1        /NUM1 IS INITIALLY 0
+NEWLUP,        ISZ MONPTR
+       ISZ NUM1
+       TAD I MONPTR
+       ISZ MONPTR
+       SMA
+       JMP BADNUM      /SYMBOLIC MONTH NOT FOUND
+       TAD NM1
+       SNA CLA         /SKIP IF FIRST 2 LETTERS DON'T MATCH
+       TAD NM2
+       TAD I MONPTR
+       SZA CLA
+       JMP NEWLUP      /SECOND 2 LETTERS DON'T MATCH
+/*** TEST DELIMETER HERE
+       TAD NUM1
+       CLL RTL
+       RTL
+       RAL
+       TAD NUM2
+       RTL
+       RAL
+       DCA NUM2
+       DCA DDELIM      /MAKE END-OF-LINE THE DELIMITER
+       JMS DECIM
+       TAD (-106       /SCALE DOWN TO RANGE 1970-1999
+       SPA
+       JMP BADNUM      /DIDN'T MAKE THE RANGE
+       DCA NUM1
+       TAD NUM1
+       AND L30         /ISOLATE EXTENSION DATE BITS
+       CLL RTL
+       RTL
+       DCA TM1
+       TAD I (BIPCCL
+       AND L7177       /STORE THEM INTO BITS RESERVED FOR THIS PURPOSE
+       TAD TM1
+TSLUP, DCA I (BIPCCL
+       TAD NUM1
+       AND [7
+       TAD NUM2        /COMBINE WITH MONTH AND DAY
+       CDF 10
+       DCA I (MDATE    /STORE IN SYSTEM DATE CELL
+       TSF             /7605 SETS THE DF
+       JMS L7177       /TIME OUT A BIT
+       JMP I [7605     /IN CASE RUNNING UNDER BATCH
+L7177, 7177            /JMS IS LONGER THAN JMP
+       ISZ DDELIM      /DDELIM IS 0 AT END
+       JMS TSLUP       /WAIT FOR TELETYPE TO DIE DOWN (RF08)
+       JMP I [7605     /RETURN TO MONITOR
+\fDDELIM,       -"-
+
+/WOULD LIKE TO BRANCH TO CCLSW-1 IF DATE ENDED WITH ALTMODE
+
+CNV,   0
+       AND [77
+       SNA
+       JMP NUL
+       TAD (-60
+       SPA
+       JMP BADNUM
+       JMP I CNV
+NUL,   TAD TM1
+       JMP GODE
+
+DECIM, 0
+       JMS I GNAME
+M40,   -40             /NOTHING THERE (LOGIC WILL CAUSE ERROR LATER)
+       TAD TMP
+       TAD DDELIM      /COMPARE AGAINST DESIRED DELIMETER
+       SNA CLA         /DASH OR NULL
+       JMS I (DECIMB-2400+400
+       JMP BADNUM      /DELIMETER BAD
+       RTR
+       JMS CNV
+       DCA TM1
+       TAD TM1
+       CLL RTL
+       TAD TM1
+       RAL
+       DCA TEMP2
+       TAD NM1
+       JMS CNV
+       TAD TEMP2
+GODE,  SZA
+       JMP I DECIM
+BADNUM,        CLA             /CRAP IN AC
+       TAD [7605
+       DCA ERRET
+       JMS I [PRMESG
+       TEXT    /BAD DATE/
+NUM1,  0               /MONTH NUMBER (MUST BE 0 INITIALLY)
+\fMONS, -1201   /JAN
+       -1600
+       -0605   /FEB
+       -0200
+       -1501   /MAR
+       -2200
+       -0120   /APR
+       -2200
+       -1501   /MAY
+       -3100
+       -1225   /JUN
+       -1600
+       -1225   /JUL
+       -1400
+       -0125   /AUG
+       -0700
+       -2305   /SEP
+       -2000
+       -1703   /OCT
+       -2400
+       -1617   /NOV
+       -2600
+       -0405   /DEC
+       -0300
+MONPTR,        MONS-2600+600-1 /RELOCATES TO PAGE 600
+                       /MUST BE POSITIVE
+
+       PAGE
+\f      *3000   /MONITOR ERROR PROCESSOR - LOADS INTO 11400
+DLYLPX,        AND I 0
+D7600, 7600
+       TAD MERRNO
+       CLL RAL
+       ISZ I (ZERO-1400
+       ISZ I (ZERO-1400        /V3C
+       ISZ I (ZERO-1400
+       JMP DLYLPX      /WAIT FOR TELEPRINTER (WITHOUT CDF'S)
+       SNA
+       JMP USRERR
+       CLL RAL
+       RTL
+       RTL
+       TAD (6040
+       DCA I (MERTYP-1400
+MERCMN,        TAD (MERRXR-1400
+       JMS EPRINT
+       TAD I (FPUTX
+       RTR
+       RAR
+       AND (7
+       TAD (60
+       JMS MERPCH
+       CLA CLL CMA RAL
+       TAD I (MONITO
+       RAL
+       DCA T1
+       TAD (-4
+       DCA T2
+MEROLP,        TAD T1
+       RTL
+       RAL
+       DCA T1
+       TAD T1
+       AND (7
+       TAD (60
+       JMS MERPCH
+       ISZ T2
+       JMP MEROLP
+       TAD MERRNO
+       CLL RAL
+       SNA
+       JMP NOEXPL      /NO EXPLANATION FOR USER ERRORS
+       CLL RAR
+       TAD (EXPLTBL-1401       /PRINT EXPLANATION
+       DCA T1          /GET ADDRESS INTO MESSAGE TABLE
+       TAD (240
+       JMS MERPCH
+       TAD ("(
+       JMS MERPCH
+       TAD I T1        /GET ADDRESS OF MESSAGE
+       JMS EPRINT
+       TAD (")
+       JMS MERPCH
+       TAD MERRNO
+NOEXPL,        TAD (3773
+       SPA CLA
+       CLA CMA
+       DCA I (7700
+       DCA OLDT9
+       CLA CLL CML RAR
+       DCA MERRNO
+       CDF 0
+       TAD I (JSBITS
+       AND (6777
+       TAD (1000
+       DCA I (JSBITS   /SET THE CURRENT JOB UNSTARTABLE
+       CDF CIF 0
+       JMP I D7600
+USRERR,        CLA CLL
+       JMS I (FGET
+       TAD (4060
+       DCA I (UERTYP-1400
+       TAD (UERRXR-MERRXR
+       JMP MERCMN
+MERPCH,        0
+       TLS
+       TSF
+       JMP .-1
+       CLA
+       JMP I MERPCH
+ZERO,  0
+\fEPRINT,       0
+       DCA T2
+EPRLUP,        TAD I T2
+       RTR
+       RTR
+       RTR
+       JMS EPR
+       TAD I T2
+       JMS EPR
+       ISZ T2
+       JMP EPRLUP
+
+EPR,   0
+       AND (77
+       SNA
+       JMP I EPRINT
+       TAD (240
+       AND (77
+       TAD (240
+       JMS MERPCH
+       JMP I EPR
+       PAGE
+\f      *3200           /LOADS INTO 1600
+
+MERRXR,        TEXT    \MONITOR ERROR 0 AT \
+       MERTYP=MERRXR+7
+
+UERRXR,        TEXT    \USER ERROR 0 AT \
+       UERTYP=UERRXR+5
+
+EXPLTBL,MON1-1400
+       MON2-1400
+       MON3-1400
+       MON4-1400
+       MON5-1400
+       MON6-1400
+       MON7-1400
+
+MON1,  TEXT    \CLOSE ERROR\
+MON2,  TEXT    \DIRECTORY I/O ERROR\
+\fMON3, TEXT    \DEVICE HANDLER NOT IN CORE\
+MON4,  TEXT    \ILLEGAL USR CALL\
+MON5,  TEXT    \I/O ERROR ON SYS:\
+MON6,  TEXT    \DIRECTORY OVERFLOW\
+MON7,  TEXT    \RESERVED\
+\f              /EXECUTION TIME LOADER FOR MONITOR "CHAIN" COMMAND
+       *3400   /EXECUTES IN FIELD 0 IN PAGE 7400
+MCHNX, DCA MCHREC              /STORE STARTING RECORD #
+       TAD MCHREC
+       DCA I (SOFSET   /V3D SAVE STARTING ADDRESS
+       CIF 10
+       JMS I (200
+       13              /RESET ALL DEVICE ASSIGNMENTS
+       0               /BUT DON'T CLEAR OUTPUT FILES
+       CIF 10
+       JMS I (200
+       11              /KICK MONITOR OUT AND RESTORE CORE IF NECESSARY
+       JMS MCHRD       /PARAMETERS PRESET TO READ CONTROL BLOCK INT0 7200
+       TAD I (7200     /TEST FOR SAVE FILE!
+       CMA             /TEST FOR VALID CCB
+       AND (7740
+       SZA CLA
+       JMP CHERR
+       TAD I (7201
+       DCA I (MSTCDF   /TRANSFER INFORMATION FROM CONTROL BLOCK
+       CLA IAC
+       TAD I (7202
+       DCA I (MSTADR   /TO PAGE 7600
+       TAD I (7203
+       TAD (1000
+       DCA I (JSBITS
+       TAD (7204
+       DCA MCHT1
+       TAD MCHFJM
+       DCA I (MSWITC
+       TAD (TCF
+       DCA I (MSTCDF+1
+MCHN1, ISZ I (7200
+       JMP MCHN2
+       TAD I MCHT1
+       DCA I (MREAD+2
+       ISZ MCHT1
+       TAD I MCHT1
+       DCA I (MREAD+1
+       TAD MCHREC
+       DCA I (MREAD+3
+       TAD (SHNDLR
+       DCA I (MREAD-1
+       JMP I (MREAD
+MCHN2, TAD I MCHT1
+       DCA MCHADR      /SET UP COMMAND TO READ NEXT SEGMENT
+       ISZ MCHT1
+       TAD I MCHT1
+       DCA MCHCTL
+       JMS MCHRD       /READ IT
+       ISZ MCHT1
+       JMP MCHN1       /LOOP ON NUMBER OF SEGMENTS
+\fMCHRD,        0
+       JMS I (SHNDLR
+MCHCTL,        0101            /1 RECORD INTO FIELD 0 STARTING FORWARDS
+MCHADR,        7200
+MCHREC,        0
+       JMP CHERR       /CHAIN ERROR
+       TAD MCHCTL
+MCHBMP,        CLL RTR
+       RTR
+       RTR
+       AND (37
+       SNA             /V3C
+       TAD (40         /0 MEANS FULL 4K READ
+       IAC
+       CLL RAR
+       TAD MCHREC
+       DCA MCHREC
+       JMP I MCHRD
+MCHT1, 0
+MCHFJM,        MSTCDF&177+5200 /"JMP MSTCDF"
+
+CHERR, ISZ CHERR1
+       JMP CHERR       /LET TTY DIE DOWN
+       ISZ CHERR2
+       JMP CHERR
+CHTADC,        TAD CHARS
+       SNA
+       JMP I (7600     /DONE..BACK TO MONITOR
+       TLS
+       TSF
+       JMP .-1
+       CLA
+       ISZ CHTADC      /NEXT LETTER
+       JMP CHTADC
+\fCHERR1,       0
+CHERR2,        -6
+CHARS, "C;"H;"A;"I;"N;" ;"E;"R;"R;215;212;0
+       PAGE
+\f      *4000   /SYSTEM GENERATOR - WRITES STUFF OUT USING SHNDLR
+       WRITE=JMS I SYSHND
+       JMS SYSSWP      /SWAP SYSTEM DEVICE HANDLER INTO 7600
+
+       WRITE;  4200;   7400;   0;      JMP BERR        /BOOTSTRAP
+       TAD RBFLAG
+       SZA CLA
+       JMP .+6
+       WRITE;  4210;   DCOUNT; 01;     JMP BERR        /DIRECTORY
+       WRITE;  5001;   0000;   07;     JMP BERR        /KEYBOARD MONITOR
+       WRITE;  4610;   0000;   MONTOR; JMP BERR        /USR
+       WRITE;  4111;   3400;   MEOVLY; JMP BERR        /"ENTER" OVERLAY
+       WRITE;  4701;   2000;   MSOVLY; JMP BERR        /SAVE OVERLAY,
+                                       /ERROR ROUTINE AND "CHAIN"
+       TAD RBFLAG
+       SZA CLA
+       JMP .+13
+       WRITE;  4101;   LDRCTL; MFREE;  JMP BERR        /ABSLDR CONTROL BLOCK
+       WRITE;  5010;   2000;MFREE+1;   JMP BERR        /ABSLDR
+       JMS I (4200     /OUTPUT THE DEVICE HANDLERS
+       JMP BERR
+       JMS SYSSWP      /SWAP BACK PAGE 7600
+       CLA CMA
+       HLT
+       CLA
+       JMP I .+1
+BERR,  7600
+       JMS SYSSWP
+       HLT
+       JMP .-1
+W6600, 6600
+W7600, 7600
+SYSSWP,        0
+       TAD W6600
+       DCA SYTM1
+       TAD W7600
+       DCA SYTM2
+SWAPLP,        TAD I SYTM1
+       DCA TMSY
+       TAD I SYTM2
+       DCA I SYTM1
+       TAD TMSY
+       DCA I SYTM2
+       ISZ SYTM1
+       ISZ SYTM2
+       JMP SWAPLP
+       JMP I SYSSWP
+
+       /CONTROL BLOCK FOR ABSOLUTE LOADER
+LDRCTL,        7777    /ONE CONTIGUOUS LOAD
+       6213    /STARTING ADDRESS IN FIELD 1
+       2000    /STARTING LOCATION=12000
+       6003    /DOES NOT LOAD OVER EITHER MONITOR AREA
+               /ALSO DOES NOT USE THESE AREAS AT COMMAND TIME - TRUE
+               /ONLY FOR FIRST CALL TO COMMAND DECODER
+       2000    /FIRST(AND ONLY) SEGMENT STARTS AT 2000
+       1010    /IN FIELD 1 AND IS 10 PAGES LONG
+
+       IFNZRO LDRCTL-4113 <BLDER,XQX>
+
+SYTM1, 0
+SYTM2, 0
+TMSY,  0
+SYSHND,        7607
+       PAGE
+\f      *7400
+       NOPUNCH
+       *7600
+       ENPUNCH
+       /UPPER PAGE OF FIELD 1 - CHOCK FULL OF GOODIES
+       /LIKE THOUSANDS OF TABLES AND THE MONITOR CALL LOCATION
+
+MOFILE,        ZBLOCK 17       /OUTPUT FILE TABLE - 7600-7616 (3 ENTRIES MAX)
+                       /5 WORDS PER ENTRY - DEVICE # AND FILE NAME
+MIFILE,        ZBLOCK 24       /INPUT FILE TABLE - 7617-7642 (10 ENTRIES MAX)
+                       /2 WORDS PER ENTRY - DEVICE # AND RECORD #
+
+                       /LAST WORD IN TABLE CONTAINS TERMINATION INDICATOR
+                       /(0 FOR CR, 1 FOR ALTMODE) AND HIGH ORDER
+                       /PART OF NUMERICAL ARGUMENT
+
+MPARAM,        ZBLOCK 4        /PARAMETER TABLE - 7643-7646
+                       /FIRST 3 WORDS - MASK OF SWITCHES(A-Z,0-9).
+                       /FOURTH WORD - CONTAINS THE LOW ORDER BITS OF
+                       /THE NUMERICAL ARGUMENT
+
+
+
+                       /TABLE OF DEVICE HANDLERS PRESENTLY IN CORE
+DVHNDL,        7607;7607;0;0;0;0;0
+       0;0;0;0;0;0;0;0
+MDATE, 0               /HOLDS THE CURRENT DATE- 4 BIT MONTH,
+                       /5 BIT DAY, 3 BIT YEAR FROM 1970
+MGET,  CIF 0
+       JMS SHNDLR      /INST FIELD IS 0
+       1000            /READ 4 RECORDS INTO FIELD 0
+       0               /LOCATIONS 0-1777
+       7               /KEYBOARD MONITOR FOLLOWS DIRECTORY
+PJSBTS,        JSBITS          /SERVES AS A HALT (WATCH IT!)
+SCDCIF,        CDF CIF 0
+       JMP I .+1
+       KMNTRY          /V3D GETS CHANGED TO INIT
+\fMCALL1,       0
+       DCA MARG1       /SAVE AC AS IT MAY CONTAIN AN ARGUMENT
+       RDF     /GET CALLING FIELD
+       TAD SCDCIF
+       DCA SMCIF
+       CDF 0
+       TAD I PJSBTS
+       RAR
+       CDF 10
+       SZL CLA         /DOES JOB USE LOCS 10000-11777?
+       JMP MONRD       /NO - DONT SAVE THEM
+       CIF 0
+       JMS SHNDLR
+       5010
+       0
+       MTEMP
+       HLT
+MONRD, CIF 0
+       JMS SHNDLR
+       610
+       0
+       MONTOR
+SCOPE, HLT             /BIT 4 IS A 1 IF CONSOLE IS A SCOPE
+       JMP MSTART      /START THE MONITOR UP IN PAGE 0
+MRETRN,        CIF 0
+       JMS SHNDLR
+       1010    /READ 10 RECS INTO FIELD 1
+       0
+       MTEMP   /TEMP REGION ON SYS
+       HLT     /SYS HAS PROBLEMS
+SMCIF, 0
+       JMP I MCALL1
+\fMARG1,        0
+                       /TABLE OF USER DEVICE NAMES
+                       /ALSO USED BY SYSTEM ODT
+
+UDNAME,        0;0;0;0;0;0;0;0;0;0;0;0;0;0;0
+\fDCB,  ZBLOCK 17               /DEVICE CONTROL BLOCK - SET IN "CONFIG"
+
+
+
+
+
+
+
+
+
+       /********************************************************
+       /       MAP OF SYSTEM DEVICE AS OF 2/21/73
+       /********************************************************
+       /            *   256 WORD RECORDS   *
+       /********************************************************
+
+       /       RECORDS    CONTENTS
+       /       -------    --------
+
+       /        0      MONITOR BOOTSTRAP
+       /        1- 6   SYSTEM DIRECTORIES
+       /        7-12   KEYBOARD MONITOR
+       /       13-15   I/O MONITOR(CALLABLE MONITOR)
+       /       16-25   DEVICE HANDLER RECORDS
+       /       26      MONITOR "ENTER" OVERLAY
+       /       27-50   MONITOR SCRATCH AREA FOR SAVING CORE
+       /       51-53   COMMAND DECODER
+       /       54-55   "SAVE WITH ARGUMENTS" AND "DATE" OVERLAYS
+       /       56      MONITOR ERROR ROUTINE
+       /       57      "CHAIN" PROCESSOR
+       /       60-63   SYSTEM ODT
+       /       64      RESERVED FOR EXPANSION
+       /65     CCL REMINISCENSES
+       /       66      USED BY TWO-PAGE SYS HANDLER
+       /       67      USED BY CCL (CCL OVERLAY)
+       /       70-END  FILE STORAGE
+\f      SHNDLR=7607     /ENTRY POINT TO SYSTEMS HANDLER
+
+       *6600
+       NOPUNCH
+       *7600
+       ENPUNCH
+
+       /SYSTEM HANDLER AND FIELD 0 UPPER PAGE
+       /INCLUDES BOOTSTRAP AND PART OF MONITOR CALL ROUTINE
+       DVHORG=16       /DEVICE HANDLER RECORDS
+       MTEMP=27
+       MONTOR=13
+       JMS SHNDLR
+       5000            /SAVE MONITOR CORE - WRITE 5 RECORDS FROM FIELD 0
+       0               /(LOCATIONS 0-1777)
+       MTEMP+4
+       7602            /TROUBLE WITH SYSTEM DEVICE
+       CDF CIF 10
+       JMP MGET        /NOW GO READ IN THE KEYBOARD MONITOR
+\f      *6744   /INFORMATION ABOUT CURRENT JOB
+       NOPUNCH
+       *7744
+       ENPUNCH
+JFIELD,        6203    /A CDF CIF N INSTRUCTION TO START THE JOB
+JSTART,        7600    /THE STARTING ADDRESS
+JSBITS,        1000    /VARIOUS STATUS BITS - USED FOR OPTIMIZATION
+               /BIT 4000 - JOB DID NOT LOAD INTO 00000-01777
+               /BIT 2000 - JOB DID NOT LOAD INTO 10000-11777
+               /BIT 1000       - JOB IS NOT RESTARTABLE
+               /BIT 400 - DOESN'T DESTROY BATCH MONITOR
+               /BIT 2    - JOB DOES NOT USE LOCS 00000-01777
+               /BIT 1    - JOB DOES NOT USE LOCS 10000-11777
+SOFSET,        0       /FOR FUTURE(AND MAYBE PRESENT) USE
+
+       /DATA BREAK FILLERS FOR SYSTEM BOOTSTRAP
+       7750
+       7751
+       7752
+       7753
+       7754
+       7755
+               /MONITOR PATCH TO HELP BLEEP LOADER
+       0       /ADDRESS OF HANDLER FOR DEVICE USED
+MREAD, JMS I .-1
+       0
+       0
+       0
+       HLT
+MSWITC,        JMP .+6 /ZEROED IF PG 7000 (HANDLER) MUST BE READ OVER
+       JMS SHNDLR
+       0300
+       7000            /THIS AREA MODIFIED BY ODT
+       MTEMP+6
+OS78,  HLT             /BIT 4 IS A 1 IF OS/78 IS RUNNING
+MSTCDF,        CDF CIF 0
+       TCF             /EXIT WITH A CLEAR CONSCIENCE(ALSO A CLEAR FLAG)
+       JMP I .+1
+MSTADR,        0
+SBLOCK,        0
+BIPCCL,        0       /MORE STATUS BITS.
+               /BIT 1: 1=> BATCH IS IN PROGRESS
+               /BITS 6-8: FIELD OF BATCH MONITOR
+               /HIGHEST CORE FIELD USED BY OS/8
+               /OR 0 TO MEAN OS/8 MAY USE ALL OF CORE
+\f      *0
+       VERSNO          /OS/8 VERSION 3
+KMONER,        CLA
+       TAD [7605
+       DCA ERRET
+       JMS I [PRMESG
+       TEXT    /SYSTEM ERR/
+
+/THE FOLLOWING REGISTERS ARE SET TO VITAL INITIAL VALUES. TO ALTER
+/THESE VALUES IS TO BRING DISASTER DOWN UPON YOUR HEAD!
+
+LXR,   PMSRST-1
+X1,    MSWITC  /THESE TWO ARE USED AT INITIALIZATION.
+ADR1,  RUN8-1
+ADR2,  RUN8&177+7377   /USED DURING R, AND RUN COMMANDS
+XR,
+AMFLAG,        0               /1 MEANS SAW ALTMODE
+                       /MUST NOT MOVE FOR CCL AND BATCH
+
+       *20
+RBFLAG,        0               /MUST BE AT LOCATION 20
+TEMP2, -7
+SYSTEM,        7700
+PCH,   PRINT
+GLINE, XGLINE
+GNAME, GETNAM
+DEVHND,        7607
+FUDJMP,        MSTCDF&177+5200
+P6203, 6203
+TMP,   PATCHLEV        /MONITOR PATCH LEVEL MUST BE AT LOC 31 FOR CCL
+PGTOUT,        GETOUT
+ERRET, PCRLF           /MUST BE AT 33 FOR CCL
+
+/THE FOLLOWING LOCS. ARE TEMPORARIES. HOWEVER, THERE IS NOW
+/VITAL ONCE ONLY CODE TO HELP THE BATCH PROCESSOR. THIS CODE IS
+/READ IN EVERY TIME THE KEYBOARD MONITOR IS RE-READ.
+
+NM1,   203             /THIS MUST BE  A 203!
+BATCH,                 /ENTRY TO READ NEW BATCH MONITOR
+NM2,   JMS I [7607     /THE BATCH INITIALIZER ALTERS  SOME VALUES
+NM3,   610             /IN THIS LIST...THIS ONE**********
+NM4,   0               /THIS ONE*****GETS ADDRESS OF BOS.
+TEMP1, 13              /******GETS RECORD OF BOS*****
+TM1,   SKP CLA         /ERROR. DON'T RUN BATCH
+TMP1,  JMP BCHGO
+NMCT,  DCA I KM1       /CLEAR BATCH FLAG.
+PN,    JMP KMONER
+PRDSW,
+KM1,   7777
+BCHGO,
+RUNSW, CIF CDF 0
+DIGFLG,        JMP I .+1
+SENTER,        KMINIT  /GETS ENTRY POINT (BOS)
+KRCHK, RCHK
+\f      FIELD 1
+\f      /FIELD 1
+       /OS/8 MONITOR - MONITOR ROUTINES
+       /THIS MONITOR IS CALLED INTO CORE BY A JMS 7700 IN FIELD 1
+       /IT REPLACES CORE FROM 200-1777
+       /AND INTERPRETS THE WORDS AFTER THE JMS AS A MONITOR FUNCTION
+       /MONITOR FUNCTIONS ARE ASSIGN,LOOKUP,ENTER,ETC.
+       MAXCMD=13
+       *200
+MONITO,        0       /MONITOR SUBROUTINE
+       DCA MACARG      /STORE AC ARG
+       DCA USERFG      /SET FLAG TO INDICATE WE WERE CALLED DIRECTLY
+       RDF     /GET CALLING FIELD
+       TAD [CDF CIF 0
+       DCA FGETX
+MRENTR,        TAD FGETX
+       DCA FPUTX       /FOR LOADING AND STORING CALLING SEQUENCE
+       JMS FGET        /GET FIRST ARGUMENT[AND SET DATA FIELD 1)
+       ISZ MONITO
+       CLL
+       TAD [-MAXCMD-1
+       SZL
+       JMP MERROR
+       TAD JMPMAX
+       DCA .+1         /BRANCH TO APPROPRIATE ROUTINE WITH LINK ON
+FGET,  0               /MUST PRESERVE LINK
+       TAD MONITO
+       JMS FGETW
+       JMP I FGET
+/MONITOR COMMAND DISPATCH TABLE MUST BE JAMMED BEFORE 'FPUT'
+       MERROR
+       MASSIGN
+       MLOOKUP
+       MENTER
+       MCLOSE
+       MCD
+       MCHAIN
+       MERR
+       MESCAP
+       MESCPR
+       MASGN
+MRSETP,        MRESET
+FPUT,  0               /MUST FOLLOW LAST ADDRESS IN JUMP TABLE
+FPUTX, 0
+       DCA I MONITO
+       CDF CIF 10
+JMPMAX,        JMP I FPUT
+MEOERR,        ISZ MERRNO
+MIOERR,        ISZ MERRNO
+MERROR,        ISZ MERRNO
+       ISZ MERRNO
+       ISZ MERRNO
+       ISZ MERRNO
+MERR,  CLA
+       CIF 0
+       JMS I [SHNDLR
+       0210
+       1400
+       MERRTN
+       HLT
+       JMP I .-3
+\fMCD,  CLA CLL CML RAR
+       JMS CDSWAP      /SWAP OUT CORE IF NECESSARY
+       JMS FGET
+       DCA T1
+       CIF 0
+       JMS I [SHNDLR
+       0601
+       0
+       MCDREC
+       JMP  MIOERR
+       TAD FPUTX
+       CDF CIF 0
+       JMS I [200
+       DCA FPUTX
+       TAD FPUTX
+       DCA FGETX
+       JMS CDSWAP      /RESTORE THE SWAPPED CORE IF NECESSARY
+       STL             /LINK MUST BE ON AT MRESET
+       JMP I MRSETP    /AFTER CD, RESET DEVICE AREA
+MCHAIN,        JMS FGET
+       DCA T1          /BUFFER THE ARGUMENT
+       CIF 0
+       JMS I [SHNDLR
+       0101
+       7400
+       MRUNRC
+       JMP MIOERR
+       TAD T1          /LOAD THE BUFFERED ARGUMENT
+       CDF CIF 0
+       JMP I .-5
+MLNOTF,        CLA
+       ISZ MONITO
+MNEXT, TAD USERFG
+MESCAP,        CLL RAR
+       TAD MONITO
+       DCA I [7700
+       TAD FPUTX
+       DCA I [SMCIF
+       CLA IAC CML
+       CDF 0
+       AND I [JSBITS
+       CDF 10
+       RAR
+       SZL SPA CLA     /RESTORE CORE IF USERFG=1 AND JSW[11]=0
+       JMP I [SMCIF
+       JMP I [MRETRN
+MESCPR,        CLL CML
+       JMP MESCAP+1
+FGETW, 0
+       DCA FPUT
+FGETX, HLT
+       TAD I FPUT
+       CDF CIF 10
+       JMP I FGETW
+\fCDSWAP,       0
+       TAD ME1000      /FORM READ OR WRITE OPERATION
+       DCA MCDCTL
+       CDF 0
+       TAD I [JSBITS
+       CDF 10
+       RTR
+       SZL CLA /IS IT NECESSARY TO SAVE CORE?
+       JMP I CDSWAP    /NO
+       CIF 0
+       JMS I [SHNDLR
+MCDCTL,        0
+       0
+       MTEMP+4
+       JMP MIOERR
+       JMP I CDSWAP
+
+EOVFLO,        CIF 0
+       JMS I [SHNDLR
+       0111
+ME1000,        1000            /ENTER OVERLAY LOADS OVER ENTER (NATCH)
+       MEOVLY
+       JMP MIOERR
+       JMP I ME1000
+\f      *400
+       /ASSIGN PROCESSOR - TRANSLATE DEVICE NAME INTO DEVICE NUMBER
+       /(IF NECESSARY),GET DEVICE HANDLER INTO CORE(IF NECESSARY)
+       /AND ADJUST TABLES(IF NECESSARY).  IS THIS REALLY NECESSARY?
+MASGN, CLA IAC
+MASSIGN,       DCA ASFLAG
+       TAD MACARG
+       SZA             /IS DEVICE NUMERIC OR SYMBOLIC?
+       JMP DFOUND      /NUMERIC
+       JMS I [FGET     /GET HIGH ORDER 2 CHARS OF NAME
+       ISZ I [MONITO
+       SNA
+       JMP I [MRTRN+1          /FIRST WORD OF NAME MUST BE NON-ZERO
+       DCA NAME
+       JMS I [FGET
+       SNA             /IS NAME >2 CHARACTERS LONG?
+       JMP NOHASH      /NO - DON'T HASH
+       TAD NAME
+       RAL
+       CLL CML RAR     /FORCE SIGN BIT OF HASH NAME ON
+       DCA NAME
+NOHASH,        TAD [UDNAME-1   /SEARCH USER NAME TABLE FIRST
+DSRCH, DCA XR
+       TAD [-17
+       DCA T2
+DSRCLP,        TAD I XR
+       CIA
+       TAD NAME
+       SNA CLA
+       JMP DSFND
+       ISZ T2
+       JMP DSRCLP
+       TAD XR
+       SMA CLA         /WHICH TABLE DID WE JUST SEARCH?
+       JMP I [MRTRN+1  /SYSTEM TABLE - ERROR
+       TAD [SDNAME-1
+       JMP DSRCH       /GO SEARCH SYSTEM TABLE
+DSFND, TAD T2
+       TAD [20
+       JMS I [FPUT     /PUT NUMBER INTO CALLING SEQUENCE
+       JMS I [FGET     /GET IT BACK IN AC, BUMPING POINTER
+       ISZ I [MONITO
+DFOUND,        JMS I [MCKDEV   /DETERMINE ITS VALIDITY (NON-ZERONESS)
+                       /AND FORM POINTERS
+       SNA             /IS THE DEVICE HANDLER IN CORE?
+       TAD I T2
+       SNA             /DOES A HANDLER EXIST FOR THE DEVICE?
+       JMP I [MLNOTF   /NO - SAME AS THE DEVICE NOT EXISTING
+       CMA RAL         /GET THE COMPLEMENT OF THE HIGH ORDER BIT INTO THE LINK
+       SNL CLA         /TWO PAGE HANDLER?(IF HANDLER IS IN CORE,
+                       /THIS TEST IS RANDOM BUT WE DON'T CARE)
+       TAD [100        /YES - FORCE A TWO-PAGE READ
+       TAD [100
+       DCA DVHCTL
+       TAD T1
+       DCA T7          /SAVE T1 AS WE WILL DESTROY IT LATER
+       TAD I T1
+       TAD ASFLAG
+       SZA CLA         /DOES HE ACTUALLY WANT US TO LOAD THE SILLY THING?
+       JMP AFINIS      /NO - HE MUST HAVE TASTE.
+       JMS I [FGET             /FETCH PAGE IN WHICH HANDLER IS TO BE LOADED
+       RAR             /GET THE LINK, WHICH HAS BEEN UNTOUCHED SINCE WE
+                       /PUT THE "TWO PAGE HANDLER" FLAG INTO IT
+       SNL SMA         /IF THIS HANDLER IS TWO-PAGE, IS HE ALLOWING IT TO BE?
+       JMP I [MLNOTF   /NO - GIVE AN ERROR RETURN
+       RAL             /YES - ROTATE BACK
+       AND [7600               /MAKE IT LEGAL
+       DCA DVHLOC
+       JMS GETREC
+       DCA DVHREC
+       CIF 0
+       JMS I [SHNDLR
+DVHCTL,        0               /READ ONE OR TWO PAGES INTO FIELD 0
+DVHLOC,        0
+DVHREC,        0
+       JMP I [MIOERR   /SYSTEM DEVICE ERROR
+               /NOW GO THROUGH THE TABLE OF AVAILABE HANDLERS
+       TAD [-17        /AND MARK OFF THOSE WHICH ARE NOW IN CORE
+       DCA T4
+DVHCLP,        TAD T4
+       JMS I [MCKDEV   /LOW ORDER BITS OF T4 GO THROUGH 1-17
+       CMA
+       TAD DVHLOC
+       CLL CML RAR
+       TAD DVHCTL      /IF A HANDLER ENTRY POINT IS WITHIN 200 WORDS OF THE
+       SMA CLA         /LOADING ADDRESS (400 FOR A TWO-PAGE HANDLER)
+       DCA I T1        /MARK IT AS WIPED
+       JMS GETREC
+       CIA
+       TAD DVHREC
+       SZA CLA
+       JMP NOTINC
+       TAD I T2
+       AND [177
+       TAD DVHLOC
+       DCA I T1
+NOTINC,        ISZ T4
+       JMP DVHCLP
+AFINIS,        TAD I T7
+       JMP I [MRTRN    /STORE HANDLER ADDRESS AND EXIT
+\fGETREC,       0
+       TAD I T2        /GET RECORD OF DEVICE HANDLER
+       CLL RTL
+       RTL
+       RTL             /EXTRACT THE RECORD NUMBER
+       AND [17
+       TAD [DVHORG-1   /ADD THE BASE OF DEVICE HANDLER STORAGE
+       JMP I GETREC
+
+MCKDEV,        0               /MUST PRESERVE LINK
+       AND [17
+       SNA
+       JMP I [MERROR   /DEVICE 0 IS ILLEGAL
+       DCA NAME
+       TAD NAME
+       TAD [SDVHND-1   /FORM POINTER INTO HANDLER IMAGE TABLE
+       DCA T2
+       TAD NAME
+       TAD [DVHNDL-1
+       DCA T1
+       TAD NAME
+       TAD [DCB-1
+       DCA T8          /FORM POINTER TO DCB ENTRY FOR DEVICE
+       TAD I T1
+       JMP I MCKDEV
+
+       IFNZRO .-564    <REASSEMBLE CONFIG>
+SDNAME,        ZBLOCK 17               /SYSTEM DNAME TABLE - SET UP BY "CONFIG"
+\f      IFZERO .+200&1000       <*600>
+       /LOOKUP PROCESSOR - GETS THE STARTING BLOCK OF AN INPUT FILE
+       /ON A SPECIFIED DEVICE.SKIPS IF FILE WAS FOUND OR DEVICE
+       /IS NOT FILE ORIENTED
+MLOOKUP,CLL            /SET RDCAT MODE TO INPUT
+       JMS MRDCAT
+       JMP ERETRN      /NON-FILE STRUCTURED DEVICE
+       JMS MDSRCH      /SEARCH THE DIRECTORY FOR THE FILE
+       JMP MRTRN+1     /NOT FOUND - TAKE ERROR RETURN
+LRETRN,        TAD T5
+       CIA
+       TAD I [DORG     /CONVERT T5 TO A RECORD NUMBER
+ERETRN,        JMS I [FPUT
+       ISZ I [MONITO
+       TAD T6
+       CIA             /STORE FILE LENGTH AS A NEGATIVE NUMBER
+MRTRN, JMS I [FPUT     /THIS CODE IS JUMPED TO BY SEVERAL ROUTINES
+MRTRN2,        ISZ I [MONITO
+       JMP I [MLNOTF
+
+MRDCAT,        0
+       SZA
+       JMP MRDREN      /NOT THE FIRST SEGMENT - DON'T SET UP POINTERS
+       DCA T5          /ZERO STARTING BLOCK NUMBER
+       DCA T6          /ZERO FILE LENGTH
+       TAD MACARG      /GET DEVICE NUMBER FROM AC
+       JMS I [MCKDEV   /CHECK LEGALITY AND FORM POINTERS
+       SNA
+       JMP I [MERROR+1 /DEVICE HANDLER IS NOT IN CORE - ERROR
+       DCA T9          /ADDRESS OF DEVICE HANDLER
+       JMS I [FGET
+       DCA T4          /STORE THE POINTER TO THE FILE NAME IN T4
+       SNL
+       CML RAR
+       RTR             /FORM A MASK OF 2000 OR 1000 DEPENDING ON LINK
+       AND I T8
+       SZA CLA         /TEST FOR READ-ONLY(L=1) OR WRITE-ONLY(L=0)
+       JMP MRTRN+1     /FAILED THE TEST - ERROR RETURN
+       TAD I T8
+       SMA CLA
+       JMP I MRDCAT    /DEVICE IS NOT FILE-ORIENTED
+       ISZ MRDCAT
+       CLA IAC
+MRDREN,        DCA MCATRC      /STORE SEGMENT NUMBER
+       TAD T9          /USE LOW ORDER BITS
+       AND [177        /OF DEVICE HANDLER ENTRY POINT
+       CLL RTL         /AND THE REQUESTED SEGMENT NUMBER
+       RAL             /TO FORM A "UNIQUE" KEY
+       TAD MCATRC      /FOR THIS SEGMENT OF THIS DIRECTORY
+               /(THE UNIQUENESS DEPENDS ON EACH HANDLER HAVING A DIFFERENT
+               /STARTING OFFSET IN ITS PAGE)
+       CIA
+       TAD OLDT9       /COMPARE KEY AGAINST KEY OF CURRENT SEGMENT
+       SNA             /ARE THEY THE SAME?
+       JMP INLRDY      /YES - DON'T READ SEGMENT, ITS IN CORE
+       CIA
+       TAD OLDT9
+       DCA OLDT9       /STORE THE KEY OF THE NEW IN-CORE SEGMENT
+       CLA CLL CML RAR /CHANGE WRITE TO READ
+       JMS MWRCAT
+INLRDY,        TAD I [DCOUNT
+       CML CMA RAL
+       SZL SPA
+       JMP JMPME2
+       CMA CML RAR     /NEW V3 DIRECTORY VERIFYER
+       DCA NFILES      /FIRST WORD IN CATALOG = -# OF FILES IN CATALOG
+       TAD [DPROPR-1
+       DCA XR          /SET XR TO POINT TO FIRST FILE ENTRY
+       JMP I MRDCAT    /RETURN TO BUMPED ADDRESS
+MDSRCH,        0
+FSRCLP,        TAD I XR
+       SNA CLA /EMPTY SPACES HAVE A ONE WORD ZERO DIRECTORY ENTRY
+       JMP SKPMTF      /SO SKIP THE 4 WORD COMPARE ON THEM
+       CLA CMA
+       TAD XR
+       DCA XR
+       TAD [-4
+       DCA T6
+       TAD T4
+       DCA T7
+SRCWDL,        TAD T7
+       JMS I [FGETW
+       CIA
+       TAD I XR
+       SZA CLA /COMPARE ENTRY AGAINST ARGUMENT(8 CHARACTERS)
+       JMP NXTFIL
+       ISZ T7
+       ISZ T6
+       JMP SRCWDL
+       JMS BUMPXR      /SKIP GARBAGE WORDS
+       TAD I XR
+       SNA
+       JMP SKPMTF+1    /UNCLOSED OUTPUT FILES DONT COUNT
+       CIA
+       DCA T6  /STORE FILE LENGTH
+       ISZ MDSRCH
+       JMP I MDSRCH
+NXTFIL,        TAD T6
+       IAC
+       JMS BUMPXR      /SKIP REST OF NAME AND GARBAGE WORDS
+SKPMTF,        TAD I XR        /GET LENGTH OF THIS ENTRY
+       TAD T5
+       DCA T5  /ADD TO BLOCK STARTING ADDRESS
+       ISZ NFILES
+       JMP FSRCLP
+       DCA T5          /RE-INITIALIZE BLOCK NUMBER FOR NEXT SEGMENT
+       TAD I [DLINK    /DIRECTORY EXHAUSTED - ANY MORE?
+       SZA
+       JMP MRDREN
+       JMP I MDSRCH
+
+BUMPXR,        0               /ROUTINE TO SKIP (DWASTE+AC) WORDS
+
+       TAD I [DWASTE
+       CIA             /DWASTE IS NEGATIVE AND SO IS AC
+       TAD XR
+       DCA XR
+       JMP I BUMPXR
+
+MWRCAT,        0
+       TAD [4210
+       DCA CATCTL
+       CIF 0
+       JMS I T9
+CATCTL,        4210    /WRITE 2 RECORDS FROM FIELD 1
+       1400
+MCATRC,        1
+JMPME2,        JMP I [MERROR+2 /CANNOT REWRITE CATALOG
+       JMP I MWRCAT
+
+       IFNZRO .-772    <REASSEMBLE CONFIG>     /USED TO BE 766
+SDVHND,        ZBLOCK 17       /DEVICE HANDLER INFORMATION TABLE - SET BY CONFIG
+\f      IFZERO 1000&. <*1000>
+       /ENTER PROCESSOR FOR MONITOR
+       /FIND A HOLE IN THE DIRECTORY LARGE ENOUGH TO ACCOMODATE THE FILE
+       /AND STICK IT IN. MAKE A NOTE THAT WE DID SO FOR THE
+       /"CLOSE" PROCESSOR.
+MENTER,        DCA EPASS       /SET UP FOR PASS 1
+       JMS I [MRDCAT   /READ CATALOG AND SET UP NFILES AND XR
+       JMP I [ERETRN   /NON-FILE-STRUCTURED DEVICE
+       JMS I [CONSOL
+       DCA T2          /INTIIALIZE STARTING BLOCK NUMBER COUNTER
+       TAD [DPROPR-1
+       DCA XR          /RESTORE XR (CONSOLIDATOR DESTROYED IT)
+       TAD MACARG
+       CLL RTR
+       RTR
+       AND [377        /GET REQUESTED LENGTH FROM AC BITS 0-7
+       CIA
+       DCA T3  /T3=REQUESTED LENGTH.  IF T3=0, MEANS RETURN
+               /LARGEST EMPTY SPACE ON TAPE. IF T3<>0, MEANS RETURN
+               /SMALLEST BLOCK OF LENGTH =>T3.
+       TAD I T8        /GET FCB ENTRY
+       AND [7
+       SZA CLA         /ANY ACTIVE TENTATIVE FILES ON THIS DEVICE?
+       JMP I [MRTRN+1  /YES - TAKE ERROR RETURN
+MELOOP,        TAD I XR
+       SNA CLA
+       JMP MEMPTY      /EMPTY SPACE - LOOK AT LENGTH
+       MTHREE          /OCCUPIED - IGNORE
+       JMS I [BUMPXR
+       TAD I XR
+MELEND,        TAD T2
+       DCA T2  /UPDATE T2 TO STARTING BLOCK # OF NEXT ENTRY
+       ISZ NFILES
+       JMP MELOOP      /GO TO NEXT ENTRY
+
+       /DIRECTORY BLOCK EXHAUSTED
+       TAD EPASS
+       SZA CLA         /WHAT PASS ARE WE IN?
+       JMP EFINUP      /SECOND PASS - THIS IS FOR KEEPS
+       TAD I [DLINK    /FIRST PASS
+       SZA             /ANY MORE SEGMENTS?
+       JMP I [MRDREN   /YES - CONTINUE
+
+
+               /DONE - SEE IF OUR BEST IS GOOD ENOUGH.
+       TAD T4
+       JMS I [FGETW
+       SZA CLA         /CHECK THAT FIRST WORD OF NAME IS NON-ZERO
+       TAD T6
+       SNA CLA         /AND THAT WE FOUND WHAT WE WANTED
+       JMP I [MRTRN2   /OTHERWISE GIVE ERROR RETURN
+       TAD ASFLAG      /GET NUMBER OF BEST SEGMENT
+       ISZ EPASS       /AND RESTART THE ALGORITHM IN PASS 2
+       JMP I [MRDREN   /(TAKES LESS SPACE THAN SAVING XR AND NAME)
+
+       /EVERYTHING IS SET UP - PERFORM THE ACTUAL ENTRY OPERATION
+
+EFINUP,        TAD XR
+       DCA T1
+       TAD [-4
+       JMS I [BUMPXR
+       TAD I [DWASTE
+       CIA
+       TAD XR          /CATALOG MUST HAVE ROOM FOR ONE MORE FILE
+       TAD [-1772      /AFTER THIS FILE IS ENTERED
+       SMA CLA         /WILL NEW ADDITION OVERFLOW CATALOG?
+       JMP I [EOVFLO   /YUP - CALL OVERLAY TO EXTEND DIRECTORY
+MELP2, TAD I T1        /MOVE REST OF CATALOG UP
+       DCA I XR        /TO CREATE SPACE FOR NEW ENTRY
+       CLA CMA
+       TAD T1
+       DCA T1
+       CLA CMA CLL RAL
+       TAD XR
+       DCA XR
+       TAD T1
+       CIA CLL CML
+       TAD NAME
+       SZA CLA         /HAVE WE PUSHED UP EVERYTHING?
+       JMP MELP2       /NO, KEEP PUSHING
+       TAD [-4
+       DCA T1          /NOW MOVE THE USERS FILE NAME
+       TAD NAME
+       DCA XR
+       TAD T4
+       JMS I [FGETW    /[IN THE USERS FIELD, OF COURSE)
+       DCA I XR
+       ISZ T4
+       ISZ T1  /INTO THE EMPTY SPACE JUST CREATED
+       JMP .-5
+       TAD I [MDATE    /PUT DATE OF CREATION INTO FILE NAME
+       DCA I XR        /THIS WILL BE DESTROYED IF DWASTE=0
+       IAC             /ADJUST XR BUMP BECAUSE OF DATE STORE
+       JMS I [BUMPXR
+       DCA I XR        /GIVE THE NEWLY ENTERED FILE A LENGTH OF 0
+       TAD XR  /PUT A POINTER TO THE LENGTH WORD OF THE
+       DCA I [DFLAG    /NEW ENTRY INTO THE DIRECTORY HEADER
+       CLA CMA
+       TAD I [DCOUNT
+       DCA I [DCOUNT   /INCREASE THE FILE COUNT BY 1
+       TAD I T8
+       TAD ASFLAG
+       DCA I T8        /SIGNAL AN OPEN OUTPUT FILE ON THIS DEVICE
+       JMS I [MWRCAT   /WRITE THE ALTERED CATALOG BACK OUT
+       JMP I [LRETRN   /STORE ARGS BACK JUST LIKE "LOOKUP"
+\fMEMPTY,       TAD I XR
+       CIA CLL
+       DCA T1  /SAVE LENGTH OF CURRENT ENTRY
+       TAD T3
+       TAD T6
+       CLA             /LINK NOW EQUALS BEST LENGTH>=DESIRED LENGTH
+       TAD T3
+       SNA
+       CML             /IF DESIRED LENGTH=0 WE ALWAYS WANT MAXIMUM
+       TAD T1
+       CLA CML         /LINK IS NOW ON IF DESIRED LENGTH IS NOT IN BETWEEN
+                       /BEST LENGTH AND CURRENT LENGTH
+       TAD T1
+       CIA
+       TAD T6
+       SZL SNA CLA     /TAKE EITHER MIN OR MAX OF BEST AND CURRENT LENGTHS,
+                       /DEPENDING ON WHETHER LINK IS ON OR OFF
+       JMP MNOCHG      /MIN(MAX)=BEST - NOTHING TO DO
+       TAD T1
+       DCA T6          /MAKE CURRENT ENTRY NEW "BEST"
+       CLA CLL CMA RAL
+       TAD XR
+       DCA NAME        /REMEMBER CATALOG LOCATION
+       TAD I [MCATRC
+       DCA ASFLAG      /ALSO DIRECTORY SEGMENT NUMBER
+       TAD T2
+       DCA T5          /AND STARTING BLOCK NUMBER
+MNOCHG,        TAD T1
+       CIA
+       JMP MELEND      /GO UPDATE THE BLOCK NUMBER
+\f      /CLOSE PROCESSOR - CLOSES  AN OUTPUT FILE WHICH WAS OPENED
+       /BY THE "ENTER" CALL -- ARGUMENTS ARE THE DEVICE NUMBER AND THE
+       /CLOSING LENGTH OF THE FILE.  PERFORMS A DIRECTORY CLEANUP AFTER
+       /CLOSING THE FILE.  IF AN ENTRY ALREADY EXISTS WITH THE NEW FILE'S
+       /NAME IT IS DELETED. (CLOSE MAY BE USED AS A "DELETE" COMMAND
+       /ONLY IF NO OUTPUT FILE WAS ENTERED).  AN ERROR RETURN IS 
+       /GIVEN IF THE CLOSING LENGTH IS TOO BIG OR IF THERE WAS NEITHER
+       /AN ACTIVE TENTATIVE FILE OR AN OLD FILE TO DELETE.
+
+MCLOSE,        JMS I [MRDCAT   /GET THE CATALOG
+       JMP CRETRN      /NON-FILE STRUCTURED DEVICE - RETURN NORMALLY
+       CLA IAC         /GET THE NEXT WORD IN THE CALLING SEQUENCE
+       JMS I [FGET
+       DCA T1          /GET CLOSING LENGTH AND STORE IT AWAY
+       JMS I [MDSRCH   /SEARCH FOR THE OLD COPY
+       JMP NODLET              /NO OLD COPY
+       MTHREE
+       TAD I [DWASTE
+       JMS SQUISH      /SQUISH OUT 3+#WASTE WORDS OF THE OLD COPY
+       DCA I XR2       /AND MAKE THE OTHER TWO INTO AN EMPTY
+       TAD T6          /FILE ENTRY WITH THE SAME LENGTH
+       CIA
+       DCA I XR2       /AS THE OLD COPY
+       TAD I T8
+       AND [7
+       SNA             /IS THERE AN OPEN OUTPUT FILE ON THIS DEVICE
+       JMP EOCLOS      /NO - FINISH UP AND GET OUT
+       CIA             /GET THE SEGMENT NUMBER WE WANT
+       TAD I [MCATRC
+       SNA CLA
+       JMP .+3
+       JMS CONSOL
+       JMS I [MWRCAT   /NO - WRITE OUT THE ONE WE SQUISHED
+       TAD I [DFLAG    /GET LOCATION OF TENTATIVE FILE
+       CIA CLL
+       TAD XR2
+       SZL CLA         /IS THE ENTRY TO BE CLOSED ABOVE THE ONE 
+       JMP .+3         /WE JUST DELETED?
+       MTHREE          /YES - MOVE THE POINTER DOWN
+       TAD I [DWASTE   /TO COMPENSATE FOR THE SQUISHING
+       TAD I [DFLAG    /THE POINTER WILL NOW POINT
+       DCA I [DFLAG    /TO THE LENGTH WORD.
+               /(THIS WAS WASTED WORK UNLESS THE CORRECT SEGMENT IS IN CORE)
+
+NODLET,        TAD I T8
+       AND [7
+       SNA             /IS THERE AN OPEN OUTPUT FILE ON THIS DEVICE?
+       JMP I [MRTRN+1  /WHAT DID HE CALL US FOR? - ERROR
+       JMS I [MRDCAT   /YES - READ IN THE CORRECT SEGMENT
+       TAD I [DFLAG
+       DCA T4          /T4 POINTS TO THE LENGTH OF THE TENTATIVE ENTRY
+       TAD T1
+       CIA             /IF T1=0, NEW ENTRY WILL BE DELETED AUTOMATICALLY
+       DCA I T4        /DURING CONSOLIDATION
+       ISZ T4
+       ISZ T4
+       CLL CML
+       TAD T1
+       TAD I T4        /SUBTRACT CLOSING LENGTH FROM FREE BLOCK ADJACENT TO ENTRY
+       SNL SZA
+       JMP I [MERROR+3 /THIS CREEP HAS GONE AND DESTROYED HIS TAPE
+       DCA I T4
+EOCLOS,        JMS CONSOL      /CONSOLIDATE THE DIRECTORY
+       TAD [7770
+       AND I T8
+       DCA I T8
+       SKP
+CRETRN,        TAD [7600       /DO A WRITE OF 0 PAGES. (MAGTAPE)
+       JMS I [MWRCAT
+       ISZ I [MONITO
+       JMP I [MRTRN2
+\f      /CONSOLIDATOR - CHECKS FOR ENTRIES OF LENGTH 0 AND DELETES THEM.
+       /ALSO CHECKS FOR ADJACENT FREE AREAS AND COMBINES THEM.
+CONSOL,        0
+       TAD [DPROPR-1
+       DCA XR
+       TAD I [DCOUNT
+       DCA T7          /T7 = FILE COUNT
+CONLP, TAD I XR
+       SNA CLA         /EMPTY FILE?
+       JMP CONMTF      /YES - GO CHECK FOR NULL AND 2 IN A ROW
+       MTHREE
+       JMS I [BUMPXR   /GET PAST THE GARBAGE WORDS
+       TAD I XR        /GET COUNT
+       SZA CLA         /WOULD THIS HAPPEN TO BE A NULL FILE?
+       JMP CONLPT      /NAH, GO TO NEXT ONE
+       TAD [-5         /YEAH, REMOVE IT ENTIRELY
+       TAD I [DWASTE   /INCLUDING THE WASTE WORDS
+SQCOMN,        JMS SQUISH
+       ISZ I [DCOUNT   /BUMP DOWN FILE COUNT IN DIRECTORY
+       ISZ NFILES      /AS WELL AS THE TEMPORARY ONE IN PAGE 0
+       NOP             /V3 RL INSISTS
+       JMP CONSOL+1    /REPEAT ENTIRE CONSOLIDATION - THIS DELETION MAY
+                       /HAVE BROUGHT TWO FREE ENTRIES TOGEHER
+/      THE ABOVE NOP FIXES THE KILLER CLOSE BUG
+CONLPT,        ISZ T7
+       JMP CONLP       /MORE FILES - KEEP PLUGGING
+       JMP I CONSOL    /RETURN FROM CONSOLIDATOR
+CONMTF,        TAD I XR        /IS THIS FREE ENTRY NULL?
+       SNA
+       JMP SQTRIV      /YES - SQUASHITLIKEABUG
+       DCA T2          /NO - SAVE LENGTH
+       TAD XR
+       DCA SQUISH              /SAVE POSITION OF LENGTH WORD
+       ISZ T7          /WAS IT THE LAST FILE?
+       SKP             /NO, THEN THERE IS ONE AFTER IT(GOOD THINKING!)
+       JMP I CONSOL    /YES - RETURN FROM CONSOLIDATOR
+       TAD I XR
+       SZA CLA         /TWO EMPTIES IN A ROW?
+       JMP CONLP+3     /NO - SLIP BACK INTO LOOP
+       TAD I XR
+       TAD T2          /YES - COMBINE LENGTHS
+       DCA I SQUISH    /STORE BACK IN FIRST LENGTH WORD AND SQUISH SECOND ENTRY
+SQTRIV,        CLA CMA CLL RAL
+       JMP SQCOMN      /SQUISH OUT 2 WORDS
+\fMRESET,       TAD [-17
+       DCA T3
+MRSETL,        TAD T3
+       JMS I [MCKDEV
+/LINK MUST BE ON AT THIS POINT
+       TAD [200
+       SZL CLA         /ZERO ALL DEVICE HANDLER SLOTS THAT AREN'T RESIDENT
+       DCA I T1
+       JMS I [FGET
+       SZA CLA
+       TAD [7
+       CMA STL
+       AND I T8
+       DCA I T8        /DELETE THE "FILE CURRENTLY OPEN" FLAG IF ASKED
+       ISZ T3
+       JMP MRSETL
+       JMP I [MNEXT
+
+/SUBR TO COLLAPSE DIRECTORY AFTER A  POINT
+SQUISH,        0
+       TAD XR
+       DCA XR1
+       CLA CLL CMA RAL
+       TAD XR1
+       DCA XR2         /SET UP XR2 FOR CHANGING SQUISHED ENTRY
+SQLOOP,        TAD I XR
+       DCA I XR1       /MOVE DOWN ONE WORD
+       TAD XR
+       TAD [-1777
+       SZA CLA /AT END YET?
+       JMP SQLOOP      /NO, KEEP GOING
+       JMP I SQUISH
+\f      *1400
+       /INITIAL DIRECTORY FOR MONITOR
+       /DEFINES OS/8 ABSOLUTE LOADER (ABSLDR.SV)
+
+DCOUNT,        -2      /TWO ENTRIES
+DORG,  MFREE   /FILE STORAGE STARTS AT BLOCK "MFREE"
+DLINK, 0       /THIS IS THE ONLY DIRECTORY RECORD
+DFLAG, 0       /THERE ARE NO OPEN OUTPUT FILES ON THIS DEVICE
+DWASTE,        -1      /# OF WASTED WORDS PER ENTRY
+DPROPR,        0102    /AB
+       2314    /SL
+       0422    /DR
+       2326    /.SV
+       3017    /V3D ENCODING FOR 1-JUN-77
+       -5      /FIVE BLOCKS LONG( 1 BLOCK = 256 WORDS)
+       0       /EMPTY SPACE
+       -1      /OVERLAYED BY DEVICE DEPENDENT PART WITH LENGTH
+
+       IFNZRO .-1415 <CNFER,QQQ>
+\f      *3400   /"ENTER" OVERLAY TO USR - RUNS IN 11000
+       JMP .+3
+MSEGLM,        -7      /# DIRECT. SEGS
+NEWLEN,        -10
+MEOVLP,        TAD I [DLINK
+       SNA CLA
+       JMP MELAST      /LAST SEGMENT - MUST CREATE A NEW ONE
+       ISZ I [DCOUNT   /BUMP ENTRY COUNT DOWN
+       JMS I [MWRCAT   /WRITE OUT THIS SEGMENT
+       JMS MSKIPF      /FIND END OF SHORTENED DIRECTORY
+       DCA MEFCNT      /PREPARE TO TRANSFER LAST ENTRY
+       TAD (MEOVLS-1
+       DCA XR1         /INTO NEXT DIRECTORY SEGMENT
+       TAD I XR
+       DCA I XR1
+       ISZ MEFCNT      /THROUGH A BUFFER AT LOC 11200
+       TAD XR
+       CIA
+       TAD T1          /T1 WAS SET UP BY "ENTER"
+       SZA CLA
+       JMP .-7
+       TAD I T1        /GET LENGTH OF MOVED ENTRY
+       DCA MEOCNT
+       TAD I [DLINK
+       JMS I [MRDCAT   /READ NEXT SEGMENT
+       JMS I [CONSOL   /MAKE SURE IT IS AT ITS SMALLEST
+       TAD I [DORG
+       TAD MEOCNT
+       DCA I [DORG     /BUMP FILE ORIGIN DOWN
+       JMS MSKIPF      /FIND LAST LOC IN NEW SEGMENT
+MELP3, TAD XR
+       DCA METMP1
+       TAD XR
+       TAD MEFCNT
+       DCA METMP2      /PREPARE TO PUSH ALL ENTRIES UP
+       TAD I METMP1
+       DCA I METMP2    /DO THE PUSHING
+       STA
+       TAD XR
+       DCA XR
+       TAD XR
+       TAD (-DWASTE
+       SZA CLA         /ARE WE THROUGH?
+       JMP MELP3       /NO
+       TAD (MEOVLS-1
+       DCA XR          /PREPARE TO MOVE THE SAVED ENTRY INTO THE
+       CLA CMA         /NEW SEGMENT
+       TAD I [DCOUNT
+       DCA I [DCOUNT   /INCREASE ENTRY COUNT OF NEW SEGMENT
+       TAD MEFCNT
+       CIA
+MECOMN,        DCA MEFCNT      /STORE NUMBER OF WORDS TO MOVE
+       TAD [DWASTE
+       DCA XR1
+       TAD I XR
+       DCA I XR1
+       ISZ MEFCNT
+       JMP .-3         /MOVE THE ENTRY IN
+       JMS MSKIPF
+       TAD XR
+       DCA T1          /T1=LAST LOC IN SEGMENT
+       TAD I [DWASTE
+       CIA
+       TAD XR
+       TAD [-1772
+       SMA CLA         /HAVE WE MADE THIS SEGMENT TOO BIG?
+       JMP MEOVLP      /YES - LOOP UNTIL WE GET IT RIGHT
+       JMS I [MWRCAT   /WRITE OUT NEW SEGMENT
+       JMP MEOXIT      /READ IN ENTER AND CONTINUE
+\fMWRONG,       IAC
+MELAST,        TAD NEWLEN
+       DCA METMP1      /LENGTH OF NEW SEGMENT
+       TAD METMP1
+       CIA
+       TAD I [DCOUNT
+       SMA             /WERE THERE "NEWLEN+1"
+       JMP MWRONG      /NO - SET OUR SIGHTS LOWER
+       DCA I [DCOUNT   /ADJUST LENGTH OF OLD SEGMENT
+       JMS MSKIPF      /FIND BOUNDARY LOC BETWEEN SEGMENTS
+       TAD I [MCATRC
+       IAC
+       DCA I [DLINK    /LINK THE OLD LAST SEGMENT TO 
+       TAD I [DLINK    /THE NEWLY CREATED ONE
+       TAD MSEGLM
+       SMA CLA
+       JMP I (MEOERR   /PROVIDED THAT THERE IS ROOM FOR ANOTHER
+       JMS I [MWRCAT   /WRITE OUT THE NEXT-TO-LAST SEGMENT
+       ISZ I [MCATRC   /BUMP RECORD NUMBER FOR NEXT WRITE
+       ISZ OLDT9       /LIKEWISE BUMP DIRECTORY KEY
+       TAD METMP1
+       DCA I [DCOUNT
+       TAD MEOCNT
+       CIA
+       TAD I [DORG
+       DCA I [DORG     /SET UP PARAMETERS OF THE NEW SEGMENT
+       DCA I [DLINK    /MARK IT AS THE NEW LAST SEGMENT
+       TAD XR
+       TAD [-1777      /SET UP COUNT OF WORDS TO SLIDE DOWN
+       JMP MECOMN      /USE COMMON CODE TO SLIDE WORDS AND EXIT
+
+MSKIPF,        0               /SUBR TO FIND LAST LOC USED IN A SEGMENT
+                       /ALSO FINDS NUMBER OF BLOCKS USED BY SEGMENT
+       TAD I [DCOUNT
+       DCA MNOFIL
+       TAD [DWASTE
+       DCA XR
+       DCA MEOCNT      /INITIALIZE POINTER(XR) AND COUNT(MEOCNT)
+MSKPLP,        TAD I XR
+       SNA CLA
+       JMP MEOMTY
+       MTHREE
+       TAD I [DWASTE   /BUMP POINTER TO LENGTH WORD OF FILE ENTRY
+       CIA
+       TAD XR
+       DCA XR
+MEOMTY,        TAD I XR
+       TAD MEOCNT
+       DCA MEOCNT
+       ISZ MNOFIL
+       JMP MSKPLP
+       JMP I MSKIPF
+\fMEOCNT,       0
+MEFCNT,        0
+METMP1,        0
+METMP2,        0
+MNOFIL,        0
+       MEOVLS=1200     /DESTROYS PART OF "CLOSE" OP FOR BUFFER
+       PAGE
+\f      EJECT ABSLDR
+       /ABSOLUTE LOADER FOR OS/8 - VERSION 4A
+       *2000
+       CTLBLK=3400
+       BUFFER=CTLBLK
+       XFIELD=20
+       ORIGIN=21
+       B1=22
+       B2=23
+       B3=24
+       C1=25
+       C2=26
+       C3=27
+       WD=30
+       WD1=31
+       WD2=32
+       FILPTR=33
+       PG7400=34
+       LSTFLD=35
+       LOADXR=11
+ABSLDR,        JMS I (CTINIT
+       JMS I (CTINIT
+       JMP CALLCD
+       JMP NOCD
+NEXTCD,        JMS I (NEXFIL
+CALLCD,        JMS I [200
+       5       /COMMAND DECODE
+       0216    /ASSUMED EXTENSION IS .BN
+NOCD,  TAD [6001
+       CDF 0
+       DCA I [JSBITS   /SET JSBITS TO SAVE CD AREA NEXT TIME
+       CDF 10
+       TAD I [MPARAM+1
+       AND [100
+       SZA CLA         /IS /R SWITCH ON?
+       JMS I (CTINIT   /YES - RE-INITIALIZE LOADER TABLES
+LD7400,        7400
+       TAD (MIFILE
+       DCA FILPTR
+       JMS I (SETADR   /GET THE STARTING ADDRESS IF IT APPEARS ON THE LINE
+NEWFIL,        TAD (7001
+       DCA HANDLR
+       TAD I FILPTR
+       AND [7760
+       SZA             /LENGTH OF 256 BLOCKS IMPLIES AT LEAST 256
+       TAD [17
+       CLL CML RTR
+       RTR
+       DCA RCDCNT
+       TAD I FILPTR
+       ISZ FILPTR
+       SNA
+       JMP NEXTCD      /FILE POINTER = 0 MEANS NO MORE INPUT FILES
+       JMS I [200
+       1               /ASSIGN
+HANDLR,        7001            /LOAD INTO 7000 IF NOT ALREADY LOADED
+       JMP I (IOERR
+       TAD I FILPTR
+       DCA RECNO
+       ISZ FILPTR
+       CLA CMA
+       DCA CHCNT
+       DCA REOF
+       TAD I [MPARAM   /TEST FOR /I
+       AND (10
+       SNA CLA
+       JMP I (LOADER   /I IS NOT ON
+       ISZ OFLG        /IS /I ALLOWED?
+       JMP I (OERR     /NO!
+       JMP I (SLASHO
+\fGETCH,        0               /GET-NEXT-INPUT-CHARACTER ROUTINE
+       TAD [200
+       KRS
+       TAD (-203
+       SNA CLA
+       KSF
+       SKP
+       JMP I (MGET
+       ISZ JMPGET
+       ISZ CHCNT
+JMPX,  JMP JMPGET
+       TAD REOF
+       SZA CLA
+       JMP I GETCH     /EOF REACHED BEFORE LOGICAL END - ERROR
+       CIF 0
+       JMS I HANDLR
+       0210            /READ 2 RECORDS INTO FIELD 1
+PBUFFR,        BUFFER
+RECNO, 0
+       JMP RERROR
+       ISZ RECNO
+       ISZ RCDCNT
+       SKP
+       ISZ REOF
+       TAD (-601
+       DCA CHCNT
+       TAD PBUFFR
+       DCA CHPTR
+       TAD JMPX
+       DCA JMPGET
+       JMP GETCH+1
+\fJMPGET,       JMP .
+       JMP CHAR1
+       JMP CHAR2
+CHAR3, TAD JMPX
+       DCA JMPGET
+       TAD I CHPTR
+       AND LD7400
+       CLL RTR
+       RTR
+       TAD CHTMP
+       RTR
+       RTR
+       ISZ CHPTR
+       JMP GCHCOM
+CHAR2, TAD I CHPTR
+       AND LD7400
+       DCA CHTMP
+       ISZ CHPTR
+CHAR1, TAD I CHPTR
+GCHCOM,        AND (377
+       ISZ GETCH
+       JMP I GETCH
+RERROR,        SPA CLA
+       JMP I (IOERR    /AN ACTUAL READ ERROR - AMAZING!
+       ISZ REOF
+       JMP RECNO+2
+REOF,  0
+CHCNT, 0
+CHPTR, 0
+CHTMP, 0
+RCDCNT,        0
+OFLG,  -1              /SWITCH FOR /O OPTION
+       PAGE
+\f      *2200
+PUTWD, 6402            /ABSLDR VERSION NUMBER
+       CMA
+       AND I B2        /AND OUT THE PAGE SLOT IN THE PAGE TABLE
+       DCA I B2
+       TAD ORIGIN
+       DCA ORGX
+       TAD XFIELD
+       CLL RTR
+       RTR
+       SZA CLA         /TEST FOR FIELDS 0 OR 1
+       JMP PUTIT       /NEITHER - STORE AS IS
+       SNL
+       JMP FLD0
+       TAD ORIGIN
+       SPA CLA
+       JMP FLD1
+       CLA CLL CML RTR
+       TAD ORIGIN
+       SMA CLA
+       JMP .+3
+       ISZ I (OVLYFG   /SET FLAG THAT LOADER IS BEING OVERLAYED
+       TAD (2400       /LOADER OVERLAYS GO IN MTEMP+11 - MTEMP+14
+LCOMPR,        TAD ORIGIN
+       RTL
+       RTL
+       RAL
+       AND [17
+       TAD (MTEMP
+RLCOMN,        DCA PGTMP
+       TAD BUFREC
+       CIA
+       TAD PGTMP
+       SNA CLA
+       JMP DONTWR
+       JMS WRBUF
+WRIBUF,         CLA            /MODIFIED..IF NOT /O GETS SZA CLA
+       JMP DONTWR
+       CIF 0
+       JMS I [SHNDLR
+       0210
+       1400    /USE CATALOG SPACE
+PGTMP, 0
+       JMP I (LIOERR
+DONTWR,        DCA OLDT9       /MARK THE CATALOG DESTROYED
+       TAD PGTMP
+       DCA BUFREC
+       TAD ORIGIN
+       AND [377
+       TAD PTRBFR
+       DCA ORGX
+       JMP PUTIT2
+\fFLD1, CLL
+       TAD ORIGIN      /IGNORE LOCATIONS ABOVE 17600
+       TAD [200
+       SZL CLA
+       JMP I PUTWD
+PUTIT, TAD XFIELD
+       TAD [7770       /CONSTRUCT CDF N FOR PROPER FIELD
+PUTIT2,        TAD CDF10
+       DCA .+1
+M7,    -7
+       TAD C3
+       DCA I ORGX
+CDF10, CDF 10
+       JMP I PUTWD
+FLD0,  TAD ORIGIN      /CHECK FOR STUFF IN PAGE 7000
+       TAD (1000
+       SNL CLA         /IF NON ZERO,OVERLAY
+       JMP PUTIT
+       TAD [7400       /FORM RECORD NO. FOR OVERLAY
+       ISZ PG7400      /SET OVERLAY FLAG
+       JMP LCOMPR      /FORM RECORD NO.
+WRBUF, CALONC
+       TAD BUFREC
+       SNA
+       JMP I WRBUF
+       CIF 0
+       JMS I [SHNDLR
+       4210
+PTRBFR,        1400
+BUFREC,        0
+       JMP I (LIOERR
+       DCA BUFREC
+       /BAD I/O ON SYSTEM DEVICE
+       JMP I WRBUF
+\fORGX,
+NEXFIL,        ERTRN
+       JMS WRBUF       /WRITE WHATEVER
+       TAD I [MPARAM-1
+       SPA CLA
+       JMP I (BUILD
+       TAD I (MPARAM
+       AND (40
+       SZA CLA
+       JMP I (BUILD
+       JMP I NEXFIL
+
+CORTAB,        ZBLOCK 30       /ONCE-ONLY CODE INSERTED HERE KATER
+       ZBLOCK 2        /EXTRA NEEDED BY ONCE-ONLY CODE
+                       /NOT USED BY CORE TABLE
+       PAGE
+\f      *2400
+ITSOVR,        JMS ASSEMB
+       CIA
+       TAD LCKSUM
+SZAIN, SZA CLA
+       JMP I (BADCKS
+       TAD I [MPARAM+1
+       AND L40
+       SNA CLA
+       JMP I (NEWFIL
+LOADER,        DCA LCKSUM
+       DCA I (OFLG     /CANCEL FURTHER /I'S
+       TAD SZAIN
+       DCA I (WRIBUF
+       JMS GETFLD
+       DCA XFIELD
+       TAD [200
+       DCA ORIGIN
+       JMS I (GETCH
+       JMP I (NEWFIL
+       SNA
+       JMP .-3
+       TAD [-200
+       SZA CLA
+       JMP LOADER+1
+LEADER,        JMS I (GETCH
+       JMP I (NEWFIL
+       SNA
+       JMP LOADER+1
+       TAD [-200
+       SNA
+       JMP LEADER
+NEWWD, SMA
+       JMP FIELDW
+       TAD [200
+       DCA WD1
+       JMS I (GETCH
+       JMP I (BADINP
+       DCA WD2
+       JMS I (GETCH
+       JMP I (BADINP
+       TAD [-200
+       SNA
+       JMP ITSOVR
+       DCA WD
+       JMS ASSEMB
+       SNL
+       JMP DATAWD
+       DCA ORIGIN
+       DCA I (LOADWD   /ZERO 'DATA LOADED' FLAG V3
+       JMP GETNXT
+\fDATAWD,       JMS I (LOADWD
+       ISZ ORIGIN
+L40,   40
+GETNXT,        TAD WD1
+       TAD WD2
+       TAD LCKSUM
+       DCA LCKSUM
+       TAD WD
+       JMP NEWWD
+\fASSEMB,       0
+       TAD WD1
+       CLL RTL
+       RTL
+       RTL
+       TAD WD2
+       JMP I ASSEMB
+FIELDW,        TAD (-32
+       SNA
+       JMP CTLZ
+       TAD (-46
+       SPA
+       JMP NOTXP
+       DCA WD1
+       TAD WD1
+       AND [7          /V3C
+       SZA CLA
+       JMP NOTXP
+       TAD WD1
+       AND (70
+       DCA XFIELD
+       JMS I (GETCH
+       JMP I (BADINP
+       TAD [-200
+       SZA
+       JMP NEWWD
+NOTXP, CLA
+       TAD LCKSUM
+       SNA CLA
+       JMP LOADER
+       JMP I (BADINP
+LCKSUM,        0
+CTLZ,  TAD LCKSUM
+       SZA CLA
+       JMP I (BADINP
+       JMP I (NEWFIL
+\fGETFLD,       0
+       DCA C1
+       TAD I (MPARAM+2
+       AND (1774
+       SNA
+       JMP I GETFLD
+       RTL
+       RAL
+       ISZ C1
+       SNL
+       JMP .-3
+       CLA CMA
+       TAD C1
+       CLL RTL
+       RAL
+       JMP I GETFLD
+       PAGE
+\f      *2600
+BUILD, TAD (CORTAB+25
+       DCA B1
+       TAD I (CORTAB+3
+       CLL CMA
+       AND [7760
+       SNA CLA
+       CML
+       TAD I (CORTAB
+       CMA
+       AND [7760
+       SNA CLA
+       IAC
+       RTR
+       DCA I (CTLBLK+3
+       TAD (CTLBLK+3
+       DCA LOADXR
+       TAD [-10
+       DCA C1
+       TAD [70
+       DCA FIELDB
+       DCA I (CTLBLK
+FLDLP, TAD FIELDB
+       TAD [-20
+       SMA CLA         /IGNORE 07600 AND 17600 IN CCB  /V3
+       CMA             /IN THE CORE MAP
+       TAD [-37
+       DCA C2
+       DCA LOWERA
+MTLOOP,        JMS I (SHFT
+       SNL CLA
+       JMP INUSE
+       TAD LOWERA
+MTRSME,        TAD [200
+       DCA LOWERA
+       ISZ C2
+       JMP MTLOOP
+       JMP FLDOVR
+INUSE, TAD LOWERA
+       TAD [200
+       DCA UPPERA
+       ISZ C2
+       SKP
+       JMP ENDRGN-2
+       JMS I (SHFT
+       SZL CLA
+       JMP ENDRGN
+       TAD UPPERA
+       JMP INUSE+1
+       CLA CMA
+       DCA C2
+ENDRGN,        TAD LOWERA
+       AND [7400
+       DCA I LOADXR
+       ISZ I (CTLBLK
+       TAD LOWERA
+       AND [7400
+       CIA
+       TAD UPPERA
+       CLL RAR
+       TAD FIELDB
+       DCA I LOADXR
+       TAD UPPERA
+       JMP MTRSME
+\fFLDOVR,       TAD FIELDB
+       TAD [-10
+       DCA FIELDB
+       CLA CLL CMA RTL
+       TAD B1
+       DCA B1
+       ISZ C1
+       JMP FLDLP
+       TAD I (CTLBLK
+       SNA
+       JMP I (NULERR
+       CIA
+       DCA I (CTLBLK
+       TAD I [MPARAM+1 /CLOBBER BATCH?
+       AND [400
+       TAD I (MPARAM+2 /AH ED, BUG IF YOU SPEC /P/1 TO LOADER
+       AND (403
+       TAD I (CTLBLK+3
+       DCA I (CTLBLK+3
+       TAD LSTFLD
+       AND [7
+       CLL RTL
+       RAL
+       TAD [CDF CIF 0
+       DCA I (CTLBLK+1
+       SKP
+ORG200,        TAD [200
+       TAD LSTADR
+       SZA             /V3
+       JMP NOORG       /V3 ALLOW EXPLICIT START ADDR TO OVERRIDE DEFAULT
+       TAD I (LOADWD   /V3 NO EXPLICIT START ADDR
+       CLA             /REPLACE BY 'SZA CLA' TO ALLOW SELF-STARTING STUFF
+/*     SZA CLA         /V3 IS IT SELF STARTING BIN FORMAT?
+       JMP ORG200      /V3 NO
+       TAD XFIELD      /V3 YES
+       TAD [CIF CDF 0  /V3
+       DCA I (CTLBLK+1 /V3
+       TAD I (ORIGIN   /V3
+NOORG, DCA I (CTLBLK+2
+       JMP I (LGTOUT   /WRITE CONTROL BLOCK AND EXIT
+FIELDB,        0
+\fUPPERA,
+SETADR,        0
+       TAD I (MPARAM+3
+       SNA             /IS THERE A STARTING ADDRESS SPECIFIED?
+       JMP I SETADR    /NO
+       DCA LSTADR
+       TAD I [MPARAM-1
+       DCA LSTFLD
+       JMP I SETADR
+
+LOWERA,        0
+LSTADR,        0
+       PAGE
+\f      *3000
+ZOFILE,        MOFILE
+ZOUCNT,        -47
+LGTOUT,        TAD PG7400
+       SNA CLA
+       JMP .+7
+       CIF 0
+       JMS I [SHNDLR
+       0300
+       7000
+       MTEMP+15
+       JMP I (LIOERR
+       CIF 0
+       JMS I [SHNDLR
+       4210
+       CTLBLK-200
+       MTEMP+10
+       JMP I (LIOERR
+       TAD I (CTLBLK+2
+       DCA CTL2                /MOVE THINGS INTO THIS PAGE 
+       TAD I (CTLBLK+3
+       DCA CTL3        /SO WE CAN REFERENCE THEM WITH DF=0
+       TAD I [MPARAM
+       AND (40
+       SNA CLA
+       JMP LNOGO
+       TAD CTL3
+       RAL
+       SPA CLA         /ARE WE OVERLAYING THE I/O MONITOR?
+       JMP LKICKM              /NO
+       CDF 0
+       DCA I [JSBITS   /YES - SET JSBITS TO FORCE A READ
+       CDF 10
+       JMS I [200
+       13              /RESET I/O DEVICES AND FILES
+LKICKM,        JMS I [200
+       11              /KICK MONITOR OUT
+       /********************************************
+       /NO PAGE ZERO REFERENCES AFTER THIS POINT 
+       /PAGE ZERO MAY CONTAIN USER CODE
+       /********************************************
+       DCA I ZOFILE            /ZERO OUT COMMAND DECODER AREA
+       ISZ ZOFILE
+       ISZ ZOUCNT
+       JMP .-3
+       TAD I (CTLBLK+1
+       CDF 0
+       DCA I (MSTCDF
+       TAD CTL2
+       DCA I (MSTADR   /SET UP STARTING ADDRESS IN FIELD 0
+       JMP LMOVRD
+\fLNOGO,        TAD CTL3        /ABOVE COMMENT DOESN'T APPLY TO NEXT 9 LINES
+       SPA CLA         /ARE WE OVERLAYING THE KEYBOARD MONITOR?
+       TAD (5          /NO - RETURN TO NON-SAVING ENTRY
+       TAD [7600
+       CDF 0
+       DCA I (MSTADR
+       TAD ZCDIF0
+       DCA I (MSTCDF
+       CLA CMA
+LMOVRD,        CDF 10
+       DCA I (7700     /SET 7700 TO -1 IF NO GO
+       TAD I (CTLBLK+1
+       CDF 0
+       DCA I (JFIELD   /SET UP PARAMETERS IN FIELD 0
+       TAD CTL2
+       DCA I (JSTART
+       TAD CTL3
+       DCA I (JSBITS
+LMOVLP,        TAD COMBO
+       DCA I COMBPT
+       ISZ LMOVLP
+       ISZ COMBPT
+       ISZ COMBCT
+       JMP LMOVLP      /MOVE THE READ OF THE LOADER OVERLAY INTO FIELD 0
+ZCDIF0,        CDF CIF 0
+       TAD OVLYFG
+       SZA CLA
+       JMP I (MREAD    /LOADER OVERLAYED - GO READ OVERLAY
+       JMP I (MSTCDF   /LOADER NOT OVERLAYED - WHY READ?
+COMBPT,        MREAD-1
+COMBCT,        -7
+COMBO, 7607
+       MREAD-1&177+4600        /JMS I .-1
+       1010
+       2000
+       MTEMP+11        /LOCATION OF SCRATCH BLOCKS FOR LOADER OVERLAY
+       HLT
+       MSTCDF&177+5200 /JMP MSTCDF
+CTL2,  0
+CTL3,  0
+OVLYFG,        0
+\fLOADWD,       0
+       DCA C3
+       TAD XFIELD
+       CLL RAR
+       TAD XFIELD
+       RTR
+       TAD (CORTAB-1
+       DCA B2
+       TAD ORIGIN
+       AND [7600
+       CLL RTL
+       RTL
+       RTL
+       ISZ B2
+       TAD (-14
+       SMA
+       JMP .-3
+       DCA CTL2
+       CLL CML
+       RAL
+       ISZ CTL2
+       JMP .-2
+       JMS I (PUTWD
+       JMP I LOADWD
+       PAGE
+\f      *3200
+ERPCH, 0
+       AND (77 /GET LOW ORDER 6 BITS
+       SZA
+       JMP NZCHAR
+       JMS ERR
+FILMSG,        TEXT    /, FILE 0/
+NZCHAR,        TAD (240
+       AND (77
+       TAD (240        /CONVERT TO ASCII
+       JMS LDRPCH      /PRINT
+       JMP I ERPCH     /AND RETURN
+LDRPCH,        0
+       TLS
+       TSF
+       JMP .-1
+       CLA
+       JMP I LDRPCH
+SHFT,  0
+       CLA CLL CMA RTL
+       DCA C3
+       CLA CLL CML RTL
+       TAD B1
+SHFTLP,        DCA B3
+       TAD I B3
+       RAL
+       DCA I B3
+       CLA CMA CML
+       TAD B3
+       ISZ C3
+       JMP SHFTLP
+       JMP I SHFT              /NOTE: SHFT LEAVES AC NON-ZERO
+\fERR,  ONCE            /CAN'T USE PAGE 0 LITERALS
+       CLA
+       CDF 10
+       TAD I (FILPTR   /ZERO CHAR GETS REPLACED BY "FILE #"
+       TAD (322        /MAGIC NUMBER
+       CLL CML RAR     /AC NOW CONTAINS " #"
+       DCA FILMSG+3
+ERRLUP,        TAD I ERR
+       SNA
+       JMP EOMESG      /MESSAGE MUST BE EVEN NUMBER OF CHARS LONG
+       RTR
+       RTR
+       RTR
+       JMS ERPCH
+       TAD I ERR
+       JMS ERPCH
+       ISZ ERR
+       JMP ERRLUP
+EOMESG,        TAD (215        /TERMINATE MESSAGE WITH CR-LF
+       JMS LDRPCH
+       TAD (212
+       JMS LDRPCH
+ERTRN, JMP I (ABSLDR   /RETURN TO LOADER STARTING ADDRESS
+IOERR, JMS ERR
+       TEXT    %I/O ERROR%
+BADINP,        JMS ERR
+       TEXT    /BAD INPUT/
+BADCKS,        JMS ERR
+       TEXT    / BAD CHECKSUM/
+NULERR,        JMS CTINIT
+       NOP
+       JMS ERR
+       TEXT    /NO INPUT/
+\fLIOERR,       JMS ERR
+       TEXT    /SYSTEM I-O ERROR/
+OERR,  JMS ERR
+       TEXT %NO /I!%
+
+CTINIT,        0
+CALONC,        JMS I ERR       /CALL ONCE-ONLY CODE
+       TAD (-30
+       DCA C1
+       TAD (CORTAB-1
+       DCA LOADXR
+       CLA CMA
+       DCA I LOADXR
+       ISZ C1
+       JMP .-3
+       DCA LSTFLD
+       DCA I (LSTADR   /V3 SET INITIAL STARTING ADDRESS TO 0
+       DCA I (OVLYFG
+       DCA PG7400
+       ISZ CTINIT
+       JMP I CTINIT
+       PAGE
+\f
+*CTLBLK+200
+
+/CODE FOR OVERLAY OPTION IS HERE.IF /I IS NOT
+/USED IMMEDIATELY, THIS CODE WILL PROBABLY BE DESTROYED,
+/AS IT IS USED FOR A BUFFER
+
+SLASHO,        CLA CMA
+       DCA I (OFLG     /RE ENABLE /I
+       TAD I (HANDLR
+       DCA GLONK       /ENTRY POINT TO HANDLER
+       TAD I (RECNO
+       DCA CCBLOK
+       CIF 0
+       JMS I GLONK     /READ IN CORE CONTROL BLOCK
+       0110
+CCBPTR,        CTLBLK
+CCBLOK,        0
+       JMP I (OERR     /DATA FAILURE
+       TAD I CCBPTR    /NO. SEGMENTS
+       CMA             /TEST FOR BAD CORE IMAGE
+       AND L7740
+       SZA CLA
+       JMP I (BADINP   /NOT CORE IMAGE
+       TAD I CCBPTR
+       DCA SEGCNT
+       TAD I SGSTAD    /THIS CODE IS NEW FOR V3D
+/      AND [70         /GET FIELD
+       CLL RTR
+       RAR
+       DCA I (LSTFLD
+       ISZ SGSTAD
+       TAD I SGSTAD
+       DCA I (LSTADR
+       ISZ SGSTAD
+       TAD I SGSTAD    /GET JSW FROM SAVE FILE
+       AND [400
+       DCA TEMP        /PRESERVE /P
+       TAD I [MPARAM+1
+       AND (7377
+       TAD TEMP
+       DCA I [MPARAM+1
+       TAD I SGSTAD
+       AND (3          /PRESERVE LAST 2 BITS
+       DCA TEMP
+       TAD I (MPARAM+2
+       AND [7774
+       TAD TEMP
+       DCA I (MPARAM+2
+       ISZ SGSTAD
+NEWSEG,        TAD I SGSTAD    /SEGMENT START ADDRESS
+       DCA ORIGIN
+       TAD I SGFDLT    /FIELD AND LENGTH
+       AND L77
+       DCA XFIELD
+       TAD I SGFDLT
+       AND [7700
+       SNA             /V3C
+       STL CLA RAR     /AC4000
+       DCA SEGLTH
+       TAD SEGLTH
+TWOPG, TAD [7600
+       SMA CLA         /NO.. IS TWO PAGE SEGMENT LEFT?
+       TAD [7600       /YES..-400 TO WORD COUNT
+       TAD [7600       /NO.. -200 TO WORD COUNT
+       DCA WDCT
+       TAD SEGLTH
+       TAD [7600       /BUMP DOWN LENGTH LEFT
+       DCA SEGLTH
+
+       ISZ CCBLOK      /POINT TO NEXT DATA RECORD
+       TAD CCBLOK
+       DCA DATRC
+       DCA OLDT9       /MARK DIRECTORY DESTROYED
+       CIF 0
+       JMS I GLONK     /READ THE DATA RECORD IN
+       0210
+       1400    /INTO 11400
+TEMP,
+DATRC, 0
+       JMP I (IOERR    /DATA FAILURE
+       CLA CMA
+       TAD ORIGIN
+       AND [177
+       TAD (1200       /SET UP INPUT POINTER
+       CHARPT=10
+       DCA CHARPT
+LOOPI, TAD I CHARPT
+       JMS I (LOADWD   /MOST OF THE WORK
+       ISZ ORIGIN
+L7400, 7400            /NOP
+       ISZ WDCT        /FINISHED THIS BLOCK?
+       JMP LOOPI
+       JMS I (WRBUF    /YES.. WRITE THE STUFF OUT
+       DCA I (BUFREC   /SO THAT WRBUF DOESN'T SCREW US UP
+       TAD SEGLTH      /V3C (REARRANGED)
+       SMA SZA         /ALL PAGES DONE?
+       JMP TWOPG       /NO, NEXT! (IF DONE, FALL INTO 'GTSEG')
+       ISZ SEGCNT      /YES, ANY MORE SEGMENTS
+       SKP
+       JMP RENEW       /RESET CCB POINTER FOR NEXT /I
+       CLA CLL CML RTL
+       TAD SGSTAD
+       DCA SGSTAD
+       CLA CLL CML RTL
+       TAD SGFDLT
+       DCA SGFDLT      /POINT TO NEXT CCB ENTRIES
+       JMP NEWSEG
+
+GLONK, 0               /HANDLER ENTRY POINT HERE
+WDCT,  0
+SEGCNT,        0
+SEGLTH,        0
+CTLBLK=3400
+
+SGFDLT,        CTLBLK+5        /FIELD AND LENGTH WORD
+SGSTAD,        CTLBLK+1        /SEGMENT START ADDRESS
+
+L7740,
+RENEW, 7740            /USED TO CLEAR AC
+L77,   77              /MIGHT OR MIGHT NOT SKIP
+       TAD (CTLBLK+1
+       DCA SGSTAD
+       TAD (CTLBLK+5
+       DCA SGFDLT
+       JMP I (NEWFIL
+       PAGE
+\f      *CORTAB         /ONCE-ONLY CODE
+
+ONCE,  0               /ONCE-ONLY CODE TO CHECK FOR CORRECT MONITOR
+       DCA I WRBUF     /DON'T CALL AGAIN
+       TAD [400
+       TAD K7400
+       SZA CLA
+       JMP OLDMON
+       TAD [7
+       TAD M7
+       SNA CLA
+       JMP I ONCE      /THEY AGREE
+OLDMON,        TAD KERR
+       DCA I NEXFIL
+       JMS I PERR      /THEY DON'T
+       TEXT    /INCOMPATIBLE/  /MUST BE AN EVEN # OF CHARS LONG
+       CIF CDF 0
+       JMP I K7605
+K7400, 7400
+PERR,  ERR
+K7605, 7605
+KERR,  ERR&177+5600
+\f      /PAGE 0 - TEMPORARIES AND LITERALS.
+               /LOCATIONS 0-3 ARE RESERVED FOR POINTERS TO KEY LOCATIONS
+               /IN THE MONITOR (SO THE CUSPS CAN GET AT THESE LOCATIONS)
+
+               /LOCATIONS 4-6 ARE RESERVED FOR SYSTEM ODT FIELD 1 BREAKPOINTS
+
+       *7
+OLDT9, 0               /POINTER TO DEVICE HANDLER OF DIRECTORY IN CORE
+
+       *15
+XR1,   0
+XR2,   0
+XR,    0
+       *20             /ENTRY TO MONITOR FROM A CALL TO 17700 -
+                       /CAN BE DESTROYED AFTER IT IS EXECUTED
+MSTART,        TAD I T1
+       DCA MACARG
+       TAD I [7700
+       DCA I [MONITO
+       TAD I [SMCIF
+       DCA I T2        /FAKE A CALL TO "MONITO"
+       TAD I [MONITO
+       RAL
+       SNL SMA CLA
+       TAD I [SMCIF
+       TAD T3
+       SNA CLA         /CHECK FOR A CALL FROM 10000-11777
+       JMP I [MERROR   /YES - GIVE ERROR IMMEDIATELY
+       JMP I T4        /NO - SLIDE INTO MONITOR CODE
+
+       *36             /POINTERS TO INTERNAL MONITOR LOCATIONS FOR "BUILD"
+       SDNAME          /SYSTEM DEVICE NAME TABLE
+       SDVHND          /DEVICE HANDLER ENTRY TABLE
+\f      *40             /LOCATIONS 20-37 RESERVED FOR CUSP SCRATCH SPACE
+USERFG,        1       /MUST BE IN 40 - SEE CD LISTING
+T1,    MARG1   /MUST BE AT 41
+T2,    FGETX
+T3,    -6213
+T4,    MRENTR
+T5,    0
+T6,    0
+T7,    0
+T8,    0
+T9,    0
+NAME,  0
+NFILES,        0
+ASFLAG,        0
+MACARG,        0
+EPASS, 0
+MERRNO,        4000
+MEOXIT,        CIF 0           /RETURN FROM ENTER OVERLAY
+       JMS I [SHNDLR
+       0210
+       1000
+       MONTOR+2        /RESTORE LOCS 1000-1377 OF USR
+       HLT             /HELP!
+       JMP I .+1
+       MENTER          /RESTART ENTER OPERATION COMPLETELY
+\f      $
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape7/PIP10.PA b/sw/os8/v3d/sources/system/dectapes/dectape7/PIP10.PA
new file mode 100644 (file)
index 0000000..a85dc26
--- /dev/null
@@ -0,0 +1,3615 @@
+/2 OS8 PIP10 - PDP-10 CONVERSION PROGRAM V3A
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/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.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f      DTRB=6772
+       DTLB=6774
+       DTXA=6764
+       DTCA=6762
+       DTRA=6761
+       DTSF=6771
+
+
+/WRITTEN BY MARK BRAMHALL 1970
+/MODIFIED FOR TD8E BY R. LARY 1973
+/DATE 75 PATCH ADDED BY S.R. AFTER 1/5/75
+/
+/PIP10 IS A PIP FOR OS8 THAT HANDLES PDP-10 DECTAPES
+/
+/COMMAND DECODER RULES:
+/
+/*OUTPUT_INPUT,INPUT,...
+/
+/OUTPUT IS:
+/      DEV:FILE.EXT[NN]
+/      DEFAULT DEVICE IS DSK:
+/      [NN] IGNORED IF PDP-10 OUTPUT
+/      IF /L OR /F DEFAULT OUTPUT IS TTY:
+/
+/INPUT IS:
+/      DEV:FILE.EXT
+/      DEFAULT DEVICE IS DSK:
+/      FOLLOWING DEFAULT DEVICES ARE THE PRECEEDING DEVICE
+/      UP TO NINE (9) INPUT FILES
+/
+/OPTIONS ARE:
+/      /L IS LIST DIRECTORY (ONLY VALID IF PDP-10 INPUT)
+/      /F IS SHORT FORM DIRECTORY (ONLY PDP-10 INPUT)
+/      /Z IS ZERO DIRECTORY BEFORE TRANSFER (ONLY IF PDP-10 OUTPUT)
+/      /D IS DELETE OLD OUTPUT FILE BEFORE TRANSFER
+/      /B IS BINARY MODE TRANSFER (I.E. 8 BITS PER 36 BITS)
+/      /I IS IMAGE MODE TRANSFER (I.E. 3 12 BITS PER 36 BITS)
+/      /P IS PRESERVE LINE NUMBERS (DEFAULT IS TO DELETE THEM)
+
+
+/      MAINTENACE RELEASE FIXES:
+
+/1.    DATE 75 STUFF
+/2.    TD8E RELIABILITY IMPROVEMENTS
+/3.    ANSI DATE OUTPUT FORMAT
+/4.    INCORPORATED PATCH BY DAVID HEMBLEN [UNITED AIRCRAFT
+/      RESEARCH LABORATORIES] TO ALLOW WRITING PDP-6
+/      DECTAPES ON A TD8E.
+\f/COMMAND DECODER SETS UP:
+/
+/AT "MOUTPU" THE LIST--
+/      LLL LLL LLD DDD         OR              UUU 100 000 000
+/      NAME (TRIMMED)                          NAME (EXCESS 40)
+/      NAME                                    NAME
+/      NAME                                    NAME
+/      EXTENSION                               EXTENSION
+/      0                                       EXTENSION
+/
+/      OS8 FILE                OR              PDP-10 FILE
+/
+/WHERE L IS LENGTH (8 BITS), D IS DEVICE (4 BITS), U IS UNIT (3 BITS)
+/
+/AT "MINPUT" THE LIST--
+/      LLL LLL LLD DDD         OR              UUU 100 000 000
+/      START BLOCK                             ANY BLOCK
+/
+/      OS8 FILE                OR              PDP-10 FILE
+/
+/THE LIST ENDS WITH A ZERO (0) WORD
+/
+/AT "MPARAM" THE BLOCK--
+/      ABC DEF GHI JKL
+/      MNO PQR STU VWX
+/      YZ0 123 456 789
+/
+/WHICH ARE THE OPTION CHARACTERS
+/
+/THE = CONSTRUCTION IS NOT IMPLEMENTED
+\f/DEFINITIONS
+
+VERSION=       3       /VERSION NUMBER
+SUBVER=        01              /PATCH LEVEL
+                       /LOCATED AT "VERLOC" AS 60+VERSION^100+SUBVER
+
+DIRECT=7000            /PDP-10 DIRECTORY BUFFER (FIELD 1)
+IBUF10=3000            /PDP-10 INPUT BUFFER (FIELD 1)
+INBUF=3000             /OS8 INPUT BUFFER (FIELD 1)
+OBUF10=5000            /PDP-10 OUTPUT BUFFER (FIELD 1)
+OUBUF=5000             /OS8 OUTPUT BUFFER (FIELD 1)
+
+OUDEVH=7200            /OUTPUT DEVICE (FIELD 0)
+INDEVH=6600            /INPUT DEVICE (FIELD 0)
+
+INCTL=1010             /INPUT CONTROL
+OUCTL=5010             /OUTPUT CONTROL
+INRECS=4               /INPUT RECORDS
+
+MDATE=7666             /MONITOR'S DATE (FIELD 1)
+
+MINPUT=7617            /INPUT LIST (FIELD 1)
+MOUTPU=7600            /OUTPUT LIST (FIELD 1)
+MPARAM=7643            /PARAMETER LIST (FIELD 1)
+JSBITS=7746            /0S8 JOB STATUS BITS
+
+DCB=7760               /DEVICE CONTROL BLOCK (FIELD 1)
+PTP=20                 /DCB VALUE OF THE PAPER TAPE PUNCH
+\f/PAGE ZERO AND POINTERS
+
+*10
+
+INDEX0,        0               /AUTO-INDEX REGISTERS
+INDEX1,        0
+INDEX2,        0
+INDEX3,        0
+INDEX4,        0
+INDEX5,        0
+INDEX6,        0
+IXR,   0               /INPUT LIST INDEX REGISTER
+
+*20
+
+UNIT10,        0               /CURRENT PDP-10 UNIT (U400)
+
+POINT, 0               /GENERAL POINTER
+
+CNTR,  0               /GENERAL COUNTER
+
+TEMP1, 0               /TEMPORARIES
+TEMP2, 0
+TEMP3, 0
+TEMP4, 0
+TEMP5, 0
+TEMP6, 0
+
+CHARNI,        0               /CHARACTER INPUT NUMBER
+CHARNO,        0               /CHARACTER OUTPUT NUMBER
+
+OUNIT, 0               /OUTPUT UNIT
+IUNIT, 0               /INPUT UNIT
+
+IBLOCK,        0               /INPUT BLOCK
+OBLOCK,        0               /OUTPUT BLOCK
+
+INPUT, 0               /INPUT ROUTINE POINTER
+OUTPUT,        0               /OUTPUT ROUTINE POINTER
+
+IPOINT,        0               /INPUT POINTER
+OPOINT,        0               /OUTPUT POINTER
+
+SAVELN,        0               /OPTION /P SWITCH
+
+MODE,  0               /OPTION /I AND /B SWITCH
+
+WORDS, 0               /WORDS LEFT COUNTER
+
+DATE,  0               /TODAY'S DATE
+
+FREEP, 0               /POINT TO FREE SPOT
+
+PRINT0,        0               /PRINT ROUTINE TEMPORARIES
+PRINT1,        0
+PRINT2,        0
+PRINT3,        0
+PRINTC,        0               /240 FOR LEADING SPACES
+
+RBFLAG,        0               /RUBOUT FLAG
+
+CDDEVF,        0               /DEFAULT DEVICE NAME
+       0
+
+CDNAME,        0               /FILE NAME
+       0
+       0
+CDEXT, 0               /FILE EXTENSION
+       0
+       0               /FILLER WORD
+
+PERSW, 0               /PERIOD SWITCH
+
+DEVSW, 0               /DEVICE SWITCH
+
+CDDEV, 0               /DEVICE
+       0
+
+INSEG, 0               /PDP-10 UNIT WITH DIRECTORY IN CORE
+
+PDP10D,        ZBLOCK 10       /LIST OF KNOWN PDP-10 UNITS
+
+CDCNT, 0               /INPUT LIST COUNTER
+
+CDI04, 0               /POINTER SAVE
+
+XDSK,  TEXT /DSK/      /DEFAULT DEVICE DSK:
+
+OCHARY,        0               /TEMPORARY
+DVTYPE,        0               /DEVICE TYPE HOLDER
+TDUNIT,        0               /0 OR 4000
+TAPFUN,        0               /DECTAPE FUNCTION
+DATE75,        0               /1 MEANS HAD H.O. BIT ON
+XDATE, 0               /POINTS TO EXTRA DATE BIT
+HIDATE,        0               /HIGH-ORDER BIT OF TODAY'S DATE
+
+/      KLUDGE FOR DATE-75 BUG:
+/      ONLY CONSIDER 1 MORE BIT OF PRECISION
+/      INSTEAD OF ALL 3 EXTRA BITS
+/      SINCE OS/8 DATE WILL RUN OUT BEFORE
+/      THAT FAILS
+       PAGE
+\f      JMP I (PIP10    /NORMAL ENTRY
+       JMS     ERROR   /PIP10 CANNOT BE CHAINED TO
+       ERMES0-1
+
+/ERROR ROUTINES
+
+IOERR, JMS ERROR       /I/O ERROR
+       ERMES1-1
+
+NOROOM,        JMS ERROR       /NO ROOM IN TAPE OR DIRECTORY
+       ERMES2-1
+
+NOOFIL,        JMS ERROR       /NO SUCH DEVICE
+       ERMES3-1
+
+FNOTFD,        JMS     ERROR           /FILE NOT FOUND
+       ERMES9-1
+NOT10F,        JMS ERROR       /NOT A PDP-10 FILE
+       ERMES4-1
+
+ERDELF,        JMS ERROR       /ERROR DELETING A FILE
+       ERMES5-1
+
+NOTPSF,        JMS ERROR       /NOT A OS8 FILE
+       ERMES6-1
+
+NOOOFL,        JMS ERROR       /ERROR OPENING THE OUTPUT FILE
+       ERMES7-1
+
+SYNTAX,        JMS ERROR       /SYNTAX ERROR
+       ERMES8-1
+
+ERROR, 0               /ERROR ROUTINE
+       CLA
+       CDF
+       TAD I ERROR
+       DCA INDEX0      /POINT TO MESSAG-1
+       TAD (ERROR3
+       DCA OUTPUT      /SET TTY: OUTPUT
+       JMS ERROR4      /PRINT THE STRING
+       JMP I (PIPCD    /AND BACK TO NORMAL
+
+ERROR4,        0               /PRINT THE STRING POINTED BY INDEX0
+       TAD I INDEX0
+       DCA TEMP1       /SAVE WORD
+       TAD TEMP1
+       RTR
+       RTR
+       RTR
+       JMS ERROR2      /BREAK IT DOWN
+       TAD TEMP1
+       JMS ERROR2
+       JMP ERROR4+1    /LOOP
+
+ERROR2,        0
+       AND [77         /USE 6 BITS
+       SNA
+       JMP I ERROR4    /END
+       DCA TEMP2
+       TAD TEMP2
+       AND (40
+       SNA CLA
+       TAD (100
+       TAD [200        /MAKE A CHAR
+       TAD TEMP2
+       TAD (-337       /_ IS SPECIAL
+       SNA
+       TAD (215-337
+       TAD (337
+       JMS ERROR7      /PUT IT
+       JMP I ERROR2
+
+ERROR7,        0
+       DCA TEMP2
+       TAD TEMP2
+       JMS I OUTPUT
+       TAD TEMP2
+       TAD (-215
+       SZA CLA
+       JMP I ERROR7
+       TAD (212
+       JMP ERROR7+1
+
+ERROR3,        0
+       TLS
+       TSF
+       JMP .-1
+       CLA
+       JMP I ERROR3
+\f/PRINT ROUTINE
+
+PRINT, 0
+       DCA PRINT0
+PRINT7,        DCA PRINTC      /SET SWITCH
+       TAD (PRINTL
+       DCA PRINT1
+       CLL CLA CMA RTL
+       DCA PRINT3
+PRINT4,        DCA PRINT2
+       JMP .+3
+
+       DCA PRINT0
+       ISZ PRINT2
+       TAD PRINT0
+       TAD I PRINT1
+       SMA
+       JMP .-5
+       CLA
+       ISZ PRINT1
+       TAD PRINT2
+       SZA
+       JMP PRINT5      /IT IS NON-ZERO
+       TAD PRINTC
+       SZA
+       JMS I OUTPUT    /PRINT LEADING SPACE IF DESIRED
+       JMP PRINT6
+
+PRINT5,        TAD ("0
+       JMS I OUTPUT
+       CLL CLA CML RAR
+PRINT6,        ISZ PRINT3
+       JMP PRINT4
+       TAD PRINT0
+       TAD ("0
+       JMS I OUTPUT
+       JMP I PRINT
+       PAGE
+\f/PDP-10 DECTAPE SERVICE ROUTINE
+/
+/CALL:
+/      JMS READT       /READ PDP-10 DECTAPE
+/      BUFFER          /BUFFER ADDRESS - FIELD 1
+/      BLOCK           /BLOCK NUMBER
+/
+/      JMS WRITET      /WRITE PDP-10 DECTAPE
+/      BUFFER          /BUFFER ADDRESS - FIELD 1
+/      BLOCK           /BLOCK NUMBER
+/
+/THE UNIT IS IN "UNIT10"
+
+TCON2, 2               /MUST BE AT BEGINNING OF PAGE!
+
+WRITET,        0               /WRITE PDP-10 DECTAPE
+       CDF             /BE SURE OF FIELD 0
+       TAD     WRITET
+       STL
+       JMS I   (TDIOCK /CHECK FOR TD IO
+       TAD I WRITET    /GET BUFFER ADDRESS
+       DCA TBUF        /AND SAVE IT
+       JMS RWTEST      /TEST DIRECTION
+WRITE2,        JMS I (FLIP     /REVERSE - FLIP BUFFER NOW
+       TAD (50
+WRITE1,        DCA TAPFUN      /SET FUNCTION (30=READ, 50=WRITE)
+       DTLB            /SEARCH INTO FIELD 0
+       TAD (TBLK
+       DCA I TCA       /TAPE BLOCK INTO "TBLK"
+TERR,  RTL             /ERROR BIT IS 0 INITIALLY
+       RAL             /SHIFT END ZONE BIT INTO LINK
+       CML CLA         /CLEAR REST OF THE JUNK
+       TAD [200        /'GO' BIT
+TSTART,        SNL             /SKIP IF NO REVERSE DIRECTION
+       TAD [400        /'REVERSE' BIT
+       DTXA            /START DRIVE GOING
+TLOOP, JMS I   (DTWAIT
+
+TOUT,  SPA             /ERROR?
+       JMP TERR        /YES - CHECK IT
+       DTRA            /CHECK DIRECTION
+       RTL
+       RTL             /DIRECTION BIT INTO LINK
+TMOD1, SZL CLA         /'SNL CLA' IF REVERSE MODE
+TMOD4, TAD TCON2       /'CLL CLA CMA RAL' IF REVERSE MODE
+       TAD TBLK        /GET BLOCK FOUND
+       CMA
+       TAD I WRITET    /GET BLOCK DESIRED
+       CMA
+       SZA CLA         /SKIP IF FOUND THE BLOCK
+       JMP TSTART      /NOT FOUND - GO AGAIN
+TMOD2, SZL CLA         /'SNL CLA' IF REVERSE MODE
+       JMP TSTART+1    /FOUND BUT WRONG DIRECTION - REVERSE IT
+       CLA CMA
+       TAD TBUF        /GET BUFFER ADDRESS-1
+       DCA I TCA       /SET ADDRESS
+       TAD (10
+       DTLB            /SET FIELD 1 BUFFER
+       TAD TAPFUN
+       DTXA            /SET READ OR WRITE
+       TAD TM600
+       DCA I TWC       /SET WORD COUNT OF 600 OCTAL WORDS
+       DTSF            /FLAG?
+       JMP .-1         /NO - WAIT
+       DTRB            /CHECK FOR ERRORS
+       SPA CLA
+       JMP I (IOERR    /ERROR!!
+       TAD [200
+       DTXA            /STOP THE DRIVE
+TMOD3, JMS I (FLIP     /POSSIBLE FLIP AFTER READ
+       ISZ WRITET
+       JMP I WRITET    /EXIT
+
+TCA,   7755            /DECTAPE CURRENT ADDRESS
+TWC,   7754            /DECTAPE WORD COUNT
+TBLK,  0               /SET TO BLOCK FOUND IN SEARCH
+TBUF,  0               /HOLDS BUFFER ADDRESS
+
+/READ ENTRY POINT
+
+READT, 0               /PDP-10 DECTAPE READ
+       CDF             /INSURE FIELD 0
+       TAD     READT
+       CLL
+       JMS I   (TDIOCK /CHECK FOR TD IO
+       TAD I READT     /GET BUFFER ADDRESS
+       DCA TBUF        /AND SAVE IT
+       TAD READT
+       DCA WRITET      /MOVE RETURN ADDRESS
+       JMS RWTEST      /CHECK DIRECTION
+       NOP             /NO INITIAL FLIP IF REVERSE
+       TAD (30         /READ FUNCTION
+       JMP WRITE1      /GO DO REST OF THE ROUTINE
+\fRWTEST,       0               /CHECK DIRECTION TO READ/WRITE AND SEARCH
+       ISZ WRITET
+       JMS I   (GOLDBK /GET OLD BLOCK NUMBER (NEGATIVE)
+       TAD I WRITET    /GET DESIRED BLOCK
+       DCA TBLK        /SAVE FOR FUTURE USE
+       SZL CLA
+       TAD (10         /FORWARD - SZL CLA
+       TAD TMOD6       /REVERSE - SNL CLA
+       DCA TMOD1       /SET UP FOR DIRECTION
+       TAD TMOD1
+       DCA TMOD2
+       SNL CLA
+       TAD WRITE2      /REVERSE - FLIP BUFFER AFTER
+       DCA TMOD3       /FORWARD - NO BUFFER FLIP
+TMOD6, SNL CLA
+       TAD (7344-1200  /REVERSE - CLL CLA CMA RAL
+       TAD TMOD5       /FORWARD - TAD TCON2
+       DCA TMOD4       /X0002 OR 17776
+       SZL CLA
+       ISZ RWTEST      /FORWARD - 2ND EXIT
+       IAC
+       SNL
+       CIA             /REVERSE DIRECTION
+       TAD I WRITET
+       SPA
+TM600, CLA             /NO LOWER THAN 0
+       DCA I TAPFUN    /SET NEW LAST SERVICED BLOCK
+       TAD TBLK        /REMEMBER SAVING THIS?
+       CLL
+       SMA SZA         /<0 AND 0 SKIP AND HAVE LINK=0
+       CLL CML CIA     />0 BECOMES <0 AND HAS LINK=1
+TMOD5, TAD TCON2
+       CLA RTR         /LINK HAS SEARCH DIRECTION
+       RTR
+       TAD (10         /ADD 'SEARCH' BIT
+       DTCA DTXA       /LOAD SEARCH AND DIRECTION
+       TAD UNIT10      /GET UNIT
+       DTXA            /ADD UNIT (ALSO FLIPS DIRECTION)
+       JMP I RWTEST    /EXIT
+       PAGE
+\f/"OLDTBL" IS LIST OF LAST SERVICED BLOCKS
+
+OLDTBL,        0;0;0;0;0;0;0;0
+/FLIP THE BUFFER ROUTINE
+
+FLIP,  0               /FLIP A 600 WORD BUFFER (FIELD 1)
+       TAD I (TBUF     /BUFFER START
+       DCA FLIP1       /SET START
+       TAD (577
+       TAD I (TBUF
+       DCA FLIP2       /SET END (END=START+577)
+       TAD (-300
+       DCA FLIP3       /SET COUNT (600/2=300)
+       CDF 10          /BUFFER IS IN FIELD 1
+FLIP6, TAD I FLIP1     /GET START
+       JMS FLIP4       /FLIP IT
+       DCA FLIP5       /SAVE TEMPORARILY
+       TAD I FLIP2     /GET END
+       JMS FLIP4       /FLIP IT
+       DCA I FLIP1     /PUT END INTO START
+       TAD FLIP5
+       DCA I FLIP2     /PUT START INTO END
+       ISZ FLIP1       /BUMP POINTERS
+       CLA CMA
+       TAD FLIP2
+       DCA FLIP2
+       ISZ FLIP3       /DONE?
+       JMP FLIP6       /NO - LOOP
+       CDF             /BACK TO FIELD 0
+       JMP I FLIP      /EXIT
+
+FLIP1, 0               /START POINTER
+FLIP2, 0               /END POINTER
+FLIP3, 0               /COUNTER
+FLIP5, 0               /TEMPORARY
+FLIP7, 0               /FLIPPING TEMPORARIES
+FLIP8, 0               /"        "
+
+FLIP4, 0               /FLIP A CELL
+       DCA FLIP7       /SAVE IT
+       TAD FLIP7
+       RTL
+       RTL
+       AND (7          /GET ...1
+       DCA FLIP8       /ACCUMULATE RESULT
+       TAD FLIP7
+       RTR
+       RAR
+       AND (70         /GET ..2.
+       TAD FLIP8
+       DCA FLIP8       /BUILD RESULT
+       TAD FLIP7
+       AND (70
+       CLL RTL
+       RAL             /GET .3..
+       TAD FLIP8
+       DCA FLIP8       /BUILD RESULT
+       TAD FLIP7
+       AND (7
+       CLL RTR
+       RTR             /GET 4...
+       TAD FLIP8
+       CMA             /GET NOT 4321
+       JMP I FLIP4     /EXIT
+\f/TD8E I/O ROUTINE - CALLS STANDARD ROUTINE
+
+TDIOCK,        0
+       DCA     TDRET   /SAVE RETURN ADDR
+       RAR
+       DCA     TDFUN   /SAVE READ/WRITE
+       JMS I   (GET10D /GET TYPE OF DECTAPE
+       TAD     (-2
+       SZA CLA
+       JMP I   TDIOCK  /TC08 - CONTINUE
+       TAD I   TDRET
+       DCA     TDBUF   /SAVE BUF ADDR
+       ISZ     TDRET
+       JMS     GOLDBK  /GET OLD BLOCK #
+       TAD I   TDRET
+       CLA RAL         /GET DIRECTION
+       TAD     (110    /ONE BLOCK, FIELD 1
+       TAD     TDFUN
+       DCA     TDFUN   /SAVE FINAL FUNCTION WORD
+       JMS I   (TDUSET /SET UP HANDLER
+       TAD     TDUNIT
+       SPA CLA
+       TAD     (DTA1-DTA0
+       TAD     (DTA0
+       DCA     TDIOCK  /SET UP HANDLER ENTRY PTR
+       TAD I   TDRET
+       DCA I   TAPFUN
+       TAD I   TAPFUN
+       DCA     TDBLK
+       JMS I   TDIOCK
+TDFUN, 0
+TDBUF, 0
+TDBLK, 0
+       JMP I   (IOERR
+       ISZ     TDRET
+       JMP I   TDRET
+TDRET, 0
+
+GOLDBK,        0
+       TAD UNIT10      /GET THE UNIT WE NEED
+       CLL RTL
+       RTL             /SHIFT INTO BITS 9-11
+       TAD (OLDTBL
+       DCA TAPFUN      /POINT TO THIS UNIT'S POSITION
+       TAD I TAPFUN    /GET LAST SERVICED BLOCK
+       CLL CIA
+       JMP I   GOLDBK
+       PAGE
+\f/GET A LINE ROUTINE
+
+GLINE, 0               /GET A LINE
+       TAD ["*
+       JMS I [ERROR3   /ANNOUNCE US WITH A *
+       DCA RBFLAG      /RESET RUBOUT FLAG
+       TAD [LINBUF-1
+       DCA IXR         /POINT TO THE BUFFER
+CHLOOP,        KSF
+       JMP CHLOOP      /WAIT FOR TTY:
+       TAD [200
+       KRS             /READ TTY:
+       DCA TEMP1
+       KCC
+       TAD [SPADR-1
+       DCA INDEX0      /SET LIST SEARCH
+       TAD I INDEX0
+       SNA
+       JMP .+6         /END OF LIST
+       TAD TEMP1
+       SNA CLA
+       JMP I INDEX0    /FOUND SO JUMP
+       ISZ INDEX0
+       JMP .-7         /LOOP
+
+       JMS PRNT        /PRINT IT
+CINSRT,        TAD TEMP1
+       DCA I IXR       /STORE THE CHARACTER
+       TAD IXR
+       TAD (-LINBUF-100
+       SZA CLA
+       JMP CHLOOP      /GET ANOTHER CHARACTER
+       JMS CRCR
+       JMP I (SYNTAX   /ERROR
+
+CARRET,        JMS CRCR
+CLFINI,        DCA I IXR       /SET END
+       DCA I IXR
+       JMP I GLINE     /EXIT
+
+SPADR, -225;JMP CTRLU
+       -215;JMP CARRET
+       -377;JMP RUBOUT
+       -375;JMP ALTMOD
+       -376;JMP ALTMOD
+       -233;JMP ALTMOD
+       -200;JMP CHLOOP
+       -217;JMP CHLOOP
+       -337;JMP BAKARR
+       -212;JMP LFEED
+       -203;JMP CTRLC
+       0
+
+BAKARR,        JMS PRNT        /"_"
+       TAD ["<
+       JMP CINSRT+1    /USE "<" INSTEAD
+
+CTRLC,
+CTRLU, TAD ["^
+       JMS I [ERROR3   /CONTROL CHARACTERS
+       TAD TEMP1
+       TAD [100
+CLRLIN,        JMS I [ERROR3
+       JMS CRCR
+       TAD I INDEX0
+       SZA CLA
+       JMP GLINE+1     /NOT "^C"
+       TSF
+       JMP .-1
+       JMP I (7605     /TO MONITOR
+
+CRCR,  0
+       TAD [215
+       DCA TEMP1
+       JMS PRNT
+       TAD [212
+       JMS I [ERROR3   /PRINT CR-LF
+       JMP I CRCR
+
+ALTMOD,        TAD ["$
+       DCA TEMP1       /ALTMODE IS "$"
+       JMS PRNT
+       JMP CLFINI      /ENDS THE LINE
+
+RUBOUT,        TAD IXR
+       TAD (1-LINBUF
+       SNA CLA
+       JMP RBSPCL      /SPECIAL TREATMENT
+       TAD ("\
+       ISZ RBFLAG
+       JMS I [ERROR3   /PRINT \
+       CLA CMA
+       DCA RBFLAG      /SET FLAG
+       TAD IXR
+       DCA TEMP2
+       TAD I TEMP2
+       JMS I [ERROR3   /PRINT RUBED CHAR
+LBCKUP,        CLA CMA
+       TAD IXR
+       JMP CHLOOP-1    /GO GET ANOTHER
+
+RBSPCL,        ISZ RBFLAG
+       JMP CLRLIN+1    /NOT INTO RUBOUTS
+       TAD ("\
+       JMP CLRLIN
+
+PRNT,  0
+       ISZ RBFLAG
+       JMP .+3
+       TAD ("\
+       JMS I [ERROR3   /END OF RUBOUTS
+       DCA RBFLAG
+       TAD TEMP1
+       JMS I [ERROR3   /PRINT CHAR
+       JMP I PRNT
+
+LFEED, JMS CRCR
+       DCA I IXR       /SET END
+       TAD [LINBUF-1
+       DCA IXR
+       TAD ["*
+       JMS I [ERROR3
+       TAD I IXR       /PRINT THE LINE
+       SNA
+       JMP LBCKUP
+       JMP .-4
+       PAGE
+\f/FIND A SLOT ROUTINE
+/SLOT NUMBERS BETWEEN 0 AND 1101
+/RETURN WITH A 5 BIT NUMBER (1 TO 26 OCTAL)
+/
+/CALL:
+/      JMS FINDSL      /FIND A SLOT
+/      SLOT#           /SLOT NUMBER
+/      (AC)            /VALUE OF SLOT RETURNED
+/
+/SLOT NUMBER OF 0 RETURNS 7777
+
+FINDSL,        0               /FIND A SLOT
+       CLA CMA
+       TAD I FINDSL    /GET SLOT NUMBER-1
+       ISZ FINDSL
+       SPA             /WAS IT 0?
+       JMP FINDSA      /YES
+       JMS DIV7        /NO - DIVIDE BY 7
+       TAD (JMP I FINDS0+7
+       DCA DIV1        /USE REMAINDER FOR JUMPING
+       CDF 10          /BUFFER IS IN FIELD 1
+DIV1,  HLT             /TEMPORARY AND JUMP CELL
+
+FINDSA,        CLA CMA
+       JMP I FINDSL    /EXIT WITH 7777 FOR SLOT NUMBER 0
+
+FINDS0,        FINDS1          /JUMP TABLE
+       FINDS2
+       FINDS3
+       FINDS4
+       FINDS5
+       FINDS6
+       FINDS7
+
+/DIVIDE BY 7 ROUTINE
+
+DIV7,  0               /DIVIDE BY 7
+       DCA DIV1        /SAVE IT
+       TAD (DIRECT
+       DCA POINT       /POINT TO DIRECTORY
+       TAD DIV1
+DIV3,  TAD (-7         /SUBTRACT 7'S
+       SPA
+       JMP I DIV7      /EXIT WITH REMAINDER
+       ISZ POINT       /BUMP POINTER BY 3
+       ISZ POINT
+       ISZ POINT
+       JMP DIV3        /AND LOOP
+
+/FIND SLOT ROUTINE #1
+/USE WORD 1 BITS 0-4
+
+FINDS1,        TAD I POINT     /GET CELL
+       RTL
+       RTL
+       RTL             /GET FIRST 5 BITS
+FINDS8,        AND [37         /ONLY 5 BITS
+       CDF             /BACK TO FIELD 0
+       JMP I FINDSL    /AND EXIT WITH VALUE IN AC
+
+/FIND SLOT ROUTINE #2
+/USE WORD 1 BITS 5-9
+
+FINDS2,        TAD I POINT
+       RTR             /USE BITS 5-9
+       JMP FINDS8
+
+/FIND SLOT ROUTINE #3
+/USE WORD 1 BITS 10-11 AND WORD 2 BITS 0-2
+
+FINDS3,        TAD I POINT
+       AND [3          /USE BITS 10-11 OF 1ST WORD
+       CLL RTL
+       RAL             /SHIFT TO BITS 7-8
+       DCA DIV1        /SAVE IT
+       ISZ POINT       /NEXT WORD
+       TAD I POINT
+       CLL RTL
+FINDS9,        RTL             /GET INTO BITS 8-11
+       AND [17         /GET ONLY BITS 8-11
+       TAD DIV1        /ADD OTHER BITS
+       JMP FINDS8
+
+/FIND SLOT ROUTINE #4
+/USE WORD 2 BITS 3-7
+
+FINDS4,        ISZ POINT       /USE 2ND WORD
+       TAD I POINT
+       RTR             /USE BITS 3-7
+       JMP FINDS2+1
+
+/FIND SLOT ROUTINE #5
+/USE WORD 2 BITS 8-11 AND WORD 3 BIT 0
+
+FINDS5,        ISZ POINT       /USE 2ND WORD
+       TAD I POINT
+       AND [17
+       CLL RAL         /GET BITS 7-10
+       DCA DIV1        /AND SAVE THEM
+       ISZ POINT       /NEXT WORD
+       CLL CLA CML RAR
+       AND I POINT     /GET BIT 0
+       JMP FINDS9
+
+/FIND SLOT ROUTINE #6
+/USE WORD 2 BITS 1-5
+
+FINDS6,        ISZ POINT
+       ISZ POINT       /USE 3RD WORD
+       TAD I POINT
+       RAL
+       JMP FINDS1+1
+
+/FIND SLOT ROUTINE #7
+/USE WORD 3 BITS 6-10
+
+FINDS7,        ISZ POINT
+       ISZ POINT       /USE 3RD WORD
+       TAD I POINT
+       RAR             /GET RID OF LAST BIT
+       JMP FINDS8
+\f/DELETE A PDP-10 ENTRY
+/
+/CALL:
+/      (AC)            /POINT TO NAME-1 (FIELD 1)
+/      JMS DELETE      /DELETE A PDP-10 ENTRY
+/      -NO-            /NOT FOUND
+/      -OK-            /ENTRY DELETED
+
+DELETE,        0               /DELETE A PDP-10 ENTRY
+       JMS I   (FIND   /TRY TO FIND IT FIRST
+       JMP I DELETE    /NOT FOUND
+       ISZ DELETE      /FOUND - 2ND EXIT
+       DCA DELET1      /SAVE SLOT NUMBER
+       CLA IAC
+       DCA DELET2      /START AT SLOT 1
+       TAD (-1101
+       DCA DELET3      /DO 1101 SLOTS
+       JMS FINDSL      /FIND A SLOT
+DELET2,        0               /SLOT NUMBER
+       CIA
+       TAD DELET1      /IS IT ONE OF OURS?
+       SZA CLA
+       JMP DELET4      /NO
+       TAD DELET2      /YES
+       DCA .+2         /SET SLOT NUMBER AGAIN
+       JMS I (FILLSL   /FILL WITH A 0
+       0
+       0               /FILL WITH A 0
+DELET4,        ISZ DELET2      /NEXT SLOT
+       ISZ DELET3      /MORE?
+       JMP DELET2-1    /YES - LOOP
+       CDF 10          /DIRECTORY IS IN FIELD 1
+       DCA I INDEX0    /REMEMBER "FIND" SETTING THIS UP?
+       DCA I INDEX0    /REMOVE THE FILE NAME
+       DCA I INDEX0
+       TAD INDEX0
+       TAD [77
+       DCA INDEX0      /POINT TO EXTENSION
+       DCA I INDEX0
+       DCA I INDEX0    /REMOVE EXTENSION
+       DCA I INDEX0
+       CDF
+       JMP I DELETE    /EXIT
+
+DELET1,        0               /HOLDS FOUND SLOT NUMBER
+DELET3,        0               /COUNTER
+       PAGE
+\f/FILL A SLOT ROUTINE
+/
+/CALL:
+/      JMS FILLSL      /FILL A SLOT
+/      SLOT#           /SLOT NUMBER
+/      VALUE           /VALUE TO FILL SLOT WITH
+/
+/SLOT NUMBER 0 IS ILLEGAL!
+
+FILLSL,        0               /FILL A SLOT ROUTINE
+       CLA CMA
+       TAD I FILLSL    /GET SLOT NUMBER-1
+       ISZ FILLSL
+       JMS I (DIV7     /DIVIDE BY 7
+       TAD (JMP I FILLS0+7
+       DCA FILLS9      /USE REMAINDER FOR JUMPING
+       TAD I FILLSL    /GET VALUE
+       ISZ FILLSL
+       AND [37         /5 BIT VALUE ONLY
+       CDF 10          /DIRECTORY IS IN FIELD 1
+FILLS9,        HLT             /TEMPORARY AND JUMP CELL
+
+/JUMP TABLE
+
+FILLS0,        FILLS1
+       FILLS2
+       FILLS3
+       FILLS4
+       FILLS5
+       FILLS6
+       FILLS7
+
+FILLSA,        0               /TEMPORARY
+
+/FILL SLOT ROUTINE #1
+/BITS 0-4 OF WORD 1
+
+FILLS1,        CLL RTR
+       RTR             /VALUE INTO BITS 0-4
+       RTR
+       DCA FILLS9      /SAVE VALUE
+       TAD I POINT
+       AND [177        /AND OFF BITS 0-4
+FILLS8,        TAD FILLS9      /ADD IN VALUE
+       DCA I POINT     /SET NEW WORD
+       CDF             /BACK TO FIELD 0
+       JMP I FILLSL    /EXIT
+
+/FILL SLOT ROUTINE #2
+/BITS 5-9 OF WORD 1
+
+FILLS2,        CLL RTL         /VALUE INTO BITS 5-9
+       DCA FILLS9      /SAVE VALUE
+       TAD I POINT
+       AND (7603       /AND OFF BITS 5-9
+       JMP FILLS8
+
+/FILL SLOT ROUTINE #3
+/BITS 10-11 OF WORD 1 AND BITS 0-2 OF WORD 2
+
+FILLS3,        DCA FILLS9      /SAVE VALUE
+       TAD FILLS9
+       CLL RAR
+       CLL RAR         /GET BITS 10-11
+       CLL RAR
+       DCA FILLSA      /SAVE
+       TAD I POINT
+       AND (7774       /AND OFF BITS 10-11
+       TAD FILLSA      /ADD IN BITS 10-11
+       DCA I POINT     /SET NEW WORD
+       ISZ POINT       /GOTO WORD 2
+       TAD FILLS9
+       AND [7          /GET BITS 0-2
+       CLL RTR
+       RTR             /SHIFT THEM
+       DCA FILLS9      /SAVE VALUE
+       TAD I POINT
+       AND (777        /AND OFF BITS 0-2
+       JMP FILLS8
+
+/FILL SLOT ROUTINE #4
+/BITS 3-7 OF WORD 2
+
+FILLS4,        CLL RTL
+       RTL             /SHIFT INTO POSITION
+       DCA FILLS9      /AND SAVE
+       ISZ POINT       /USE WORD 2
+       TAD I POINT
+       AND (7017       /AND OFF BITS 3-7
+       JMP FILLS8
+
+/FILL SLOT ROUTINE #5
+/BITS 8-11 OF WORD 2 AND BIT 0 OF WORD 3
+
+FILLS5,        DCA FILLS9
+       TAD FILLS9      /GET VALUE
+       CLL RAR         /GET BITS 8-11
+       DCA FILLSA      /AND SAVE
+       ISZ POINT       /USE WORD 2 FIRST
+       TAD I POINT
+       AND [7760       /AND OFF BITS 8-11
+       TAD FILLSA      /ADD IN THOSE BITS
+       DCA I POINT     /SET NEW WORD 2
+       ISZ POINT       /NOW WORD 3
+       CLA IAC
+       AND FILLS9      /GET BIT 0
+       CLL RTR         /AND SHIFT INTO POSITION
+       DCA FILLS9      /AND SAVE IT
+       CLL CLA CMA RAR
+       AND I POINT     /AND OFF BIT 0
+       JMP FILLS8
+
+/FILL SLOT ROUTINE #6
+/BITS 1-5 OF WORD 3
+
+FILLS6,        CLL RTL
+       RTL             /SHIFT INTO POSITION
+       RTL
+       DCA FILLS9      /AND SAVE
+       ISZ POINT
+       ISZ POINT       /USE WORD 3
+       TAD I POINT
+       AND (4077       /AND OFF BITS 1-5
+       JMP FILLS8
+
+/FILL SLOT ROUTINE #7
+/BITS 6-10 OF WORD 3
+/BIT 11 OF WORD 3 A 0
+
+FILLS7,        CLL RAL         /SHIFT INTO POSITION
+       DCA FILLS9      /AND SAVE
+       ISZ POINT
+       ISZ POINT       /USE WORD 3
+       TAD I POINT
+       AND [7700       /AND OFF BITS 6-11
+       JMP FILLS8
+\fFIX75,        0               /DF 10
+       CDF             /SET H.O. DATE WORD OF FILE
+       TAD I (SLOTNO   /ENTRY NO. OF FILE
+       CLL RAL         /*3
+       TAD I (SLOTNO   /SINCE 1 -10 WORD= 3 -8 WORDS
+       TAD (DIRECT-1   /POINT TO HIGH ORDER BIT OF DATE
+       DCA FIXPTR      /V3C
+       CDF 10
+       STA CLL RAL     /OTHER STUFF IS VERY IMPORTANT
+       AND I FIXPTR    /SO KEEP IT
+       TAD HIDATE      /OR IN THIS BIT
+       DCA I FIXPTR    /AND WRITE IT BACK
+       JMP I FIX75
+
+FIXPTR,        0               /POINTS TO WORD CONTAINING H.O. DATE
+       PAGE
+\f/GET NEXT SLOT ROUTINE
+/GOES BY 5'S EITHER FORWARD OR BACKWARD
+/
+/CALL:
+/      (AC)            /CURRENT BLOCK NUMBER
+/      JMS NEXTSL      /GET NEXT SLOT
+/      (AC)            /NEXT BLOCK NUMBER
+/
+/GOES TO "NOROOM" IF DIRECTORY FULL
+
+NEXTSL,        0               /GET NEXT SLOT
+       TAD NEXTDI      /ADD IN DIRECTION FACTOR
+       SPA
+       JMP NEXTS2      /<0 MEANS REVERSE DIRECTION
+       TAD [-1102
+       SMA
+       JMP NEXTS2      />1101 MEANS REVERSE DIRECTION
+       TAD (1102
+       DCA NEXTS1      /SET NEW BLOCK NUMBER
+       JMS I (FINDSL   /IS THIS SLOT FREE?
+NEXTS1,        0               /BLOCK NUMBER
+       SZA CLA
+       JMP NEXTS3      /NO - NOT FREE
+       TAD NEXTS1      /FREE
+       DCA NEXTS7+1    /SET BLOCK AGAIN
+NEXTS7,        JMS I (FILLSL   /FILL THIS SLOT THEN
+       0               /SLOT TO FILL
+SLOTNO,        0               /VALUE TO FILL WITH
+       TAD NEXTDI
+       SMA CLA         /MAKE SURE DIRECTION IS -4 OR 4
+       TAD (10
+       TAD (-4
+       DCA NEXTDI
+       TAD NEXTS7+1    /GET NEW BLOCK
+       JMP I NEXTSL    /EXIT
+
+NEXTS2,        CLA             /REVERSE DIRECTION
+       TAD NEXTDI
+       SMA CLA         /SET 0 OR 1101
+       TAD (1101
+       DCA NEXTS1      /INTO BLOCK NUMBER
+       TAD NEXTDI
+       CIA             /REVERSE DIRECTION
+       JMP NEXTS3+1    /GO PRETEND WE FOUND A FULL SLOT
+
+NEXTS3,        TAD NEXTDI
+       SMA CLA         /MAKE DIRECTION -1 OR 1
+       CLL CLA CMA RAL
+       CMA
+       DCA NEXTDI      /DIRECTION IS -1 OR 1
+       TAD [-1102
+       DCA NEXTS4      /CHECK 1102 BLOCKS
+       TAD NEXTS1
+       DCA NEXTS5      /SET START BLOCK
+       JMS I (FINDSL   /CHECK A SLOT
+NEXTS5,        0               /SLOT TO CHECK
+       SNA CLA
+       JMP NEXTS6      /FOUND A FREE SLOT
+       ISZ     NEXTS4  /TRY MORE?
+       SKP             /YES
+       JMP I   (NOROOM /NO - OUT OF ROOM
+       TAD NEXTS5
+       TAD NEXTDI      /ADD DIRECTION TO SLOT
+       SPA
+       JMP NEXTS2      /<0 IS TOO FAR
+       TAD [-1102
+       SMA
+       JMP NEXTS2      />1101 IS TOO FAR
+       TAD (1102
+       DCA NEXTS5      /SET NEW BLOCK
+       JMP     NEXTS5-1        /KEEP GOING
+
+NEXTS6,        TAD NEXTS5      /GET FREE BLOCK
+       JMP NEXTS7-1    /AND SET IT
+
+NEXTS4,        0               /COUNTER
+
+NEXTDI,        0               /DIRECTION (5, -5, 1, -1)
+
+/MORE PDP-10 OUTPUT
+
+/OUTPUT CHARACTER #3 - BITS 9-11 WORD 2 AND BITS 0-3 WORD 3
+
+OCHAR3,        TAD OCHARY
+       CLL RTR
+       RTR
+       AND [7
+       TAD I OPOINT
+       DCA I OPOINT
+       ISZ OPOINT
+       TAD OCHARY
+       AND [17
+       CLL RTR
+       RTR
+       RAR
+       JMP I (OCHARD
+\fMONTBL,       "J;"A;"N
+       "F;"E;"B
+       "M;"A;"R
+       "A;"P;"R
+       "M;"A;"Y
+       "J;"U;"N
+       "J;"U;"L
+       "A;"U;"G
+       "S;"E;"P
+       "O;"C;"T
+       "N;"O;"V
+       "D;"E;"C
+       PAGE
+\f/PDP-10 CHARACTER OUTPUT ROUTINE
+/
+/CALL:
+/      (AC)            /CHARACTER
+/      JMS OCHR10      /OUTPUT TO PDP-10
+/      -RETURN-        /O.K. RETURN
+
+OCHR10,        0               /OUTPUT TO PDP-10
+       DCA OCHARY      /SAVE CHAR
+       TAD MODE        /IMAGE MODE?
+       SZA
+       JMP OC10A1      /YES /I OR /B
+       TAD OCHARY      /NO - USE 7 BITS
+       AND [177
+OC10A2,        DCA OCHARY
+OC10A3,        TAD CHARNO      /GET CHAR NUMBER
+       TAD (JMP I OCHARX
+       DCA OCHARZ      /USE TO SET UP JUMP
+       CDF 10          /BUFFER IS IN FIELD 1
+OCHARZ,        0               /JUMP TO THE ROUTINE
+
+OC10A1,        SMA CLA         /BINARY?
+       JMP OC10A3      /NO
+       TAD OCHARY      /YES
+       AND [377
+       JMP OC10A2
+
+OCHARX,        OCHAR0
+       OCHAR1
+       OCHAR2
+       OCHAR3
+       OCHAR4
+
+/OUTPUT CHARACTER #0 - BITS 0-6 WORD 1
+
+OCHAR0,        TAD I [OBUF10+2
+       AND [177        /GET COUNT
+       TAD (-177
+       SZA CLA
+       JMP OCHARA      /STILL ROOM IN BUFFER
+       CDF             /NO ROOM IN BUFFER
+       TAD OBLOCK
+       JMS I (NEXTSL   /GET THE NEXT BLOCK NUMBER
+       DCA OCHARZ      /AND SAVE IT
+       CDF 10          /BACK TO FIELD 1
+       TAD OCHARZ
+       AND [7700
+       CLL RTR
+       RTR
+       RTR             /GET LINK POINTER
+       DCA I [OBUF10
+       TAD OCHARZ
+       AND [77
+       CLL RTL
+       RTL
+       RTL
+       TAD I [OBUF10+1
+       DCA I [OBUF10+1 /AND SET POINTER
+       TAD OUNIT
+       DCA UNIT10      /SET OUR UNIT
+       TAD OBLOCK
+       DCA .+3         /AND OUR BLOCK
+       JMS I (WRITET   /WRITE PDP-10 DECTAPE
+       OBUF10
+       0               /BLOCK NUMBER IS SET
+       CDF 10          /BACK TO FIELD 1
+       DCA I [OBUF10
+       TAD I [OBUF10+1
+       AND [77
+       DCA I [OBUF10+1 /CLEAR POINTER
+       TAD OCHARZ
+       DCA OBLOCK      /SET NEW BLOCK
+       TAD I [OBUF10+2
+       AND [7400
+       DCA I [OBUF10+2 /ZERO COUNT
+       TAD (OBUF10+3
+       DCA OPOINT      /RESET POINTER
+OCHARA,        ISZ I [OBUF10+2 /BUMP COUNT
+       TAD MODE        /IMAGE MODE?
+       SNA
+       JMP OCHARB      /NO
+       SMA CLA         /BINARY?
+       JMP OC10A4      /NO
+       DCA I OPOINT    /YES
+       ISZ OPOINT
+       DCA I OPOINT
+       ISZ OPOINT
+       TAD OCHARY
+       DCA I OPOINT    /SET 8 BITS
+       ISZ OPOINT
+OCHARC,        CDF             /BACK TO FIELD 0
+       JMP I OCHR10    /EXIT
+
+OC10A5,        ISZ OPOINT
+OC10A4,        TAD OCHARY
+       JMP OCHARD
+
+OCHARB,        TAD OCHARY
+       CLL RTL
+       RTL
+       RAL             /USE BITS 0-6
+OCHARD,        DCA I OPOINT    /SET IT
+       ISZ CHARNO      /BUMP CHARACTER NUMBER
+       JMP OCHARC
+
+/OUTPUT CHARACTER #1 - BITS 7-11 WORD 1 AND BITS 0-1 WORD 2
+
+OCHAR1,        TAD MODE
+       SZA CLA
+       JMP OC10A5
+       TAD OCHARY
+       CLL RAR         /GET BITS 7-11
+       CLL RAR
+       TAD I OPOINT
+       DCA I OPOINT    /SET WORD 1
+       ISZ OPOINT      /NOW WORD 2
+       TAD OCHARY
+       AND [3
+       CLL RTR
+       RAR             /GET BITS 0-1
+       JMP OCHARD
+
+/OUTPUT CHARACTER #2 - BITS 2-8 WORD 2
+
+OCHAR2,        TAD MODE
+       SZA CLA
+       JMP OC10A6
+       TAD OCHARY
+       CLL RTL
+       RAL             /GET BITS 2-8
+       TAD I OPOINT
+       JMP OCHARD
+
+/OUTPUT CHARACTER #4 - BITS 4-10 WORD 3
+/BIT 11 WORD 3 IS 0
+
+OCHAR4,        TAD OCHARY
+       CLL RAL         /BITS 4-10
+       TAD I OPOINT
+OC10A7,        DCA I OPOINT    /SET WORD 3
+       ISZ OPOINT
+       DCA CHARNO      /RESET CHARACTER NUMBER
+       JMP OCHARC
+
+OC10A6,        ISZ OPOINT
+       TAD OCHARY
+       JMP OC10A7
+       PAGE
+\f/PDP-10 CHARACTER INPUT
+/
+/CALL:
+/      JMS ICHR10      /PDP-10 INPUT
+/      -EOF-           /END OF FILE RETURN
+/      (AC)            /NORMAL RETURN - CHARACTER IN AC
+
+ICHR10,        0               /PCP-10 INPUT ROUTINE
+       TAD CHARNI
+       TAD (JMP I ICHARX
+       DCA ICHARY      /USE CHARACTER NUMBER TO FORM JUMP
+       CDF 10          /BUFFER IS IN FIELD 1
+ICHARY,        0               /TEMPORARY AND JUMP CELL
+
+ICHARX,        ICHAR0
+       ICHAR1
+       ICHAR2
+       ICHAR3
+       ICHAR4
+
+/INPUT CHARACTER #0 - BITS 0-6 WORD 1
+
+ICHAR0,        TAD WORDS       /GET NUMBER OF WORD LEFT
+       SZA CLA
+       JMP ICHARA      /STILL MORE WORDS LEFT
+       TAD IBLOCK      /GET NEXT BLOCK
+       SNA
+       JMP ICHARC+1    /NONE - EOF
+       DCA .+5         /SET NEXT BLOCK
+       TAD IUNIT
+       DCA UNIT10      /SET OUR UNIT
+       JMS I (READT    /READ PDP-10 DECTAPE
+       IBUF10
+       0               /OUR BLOCK IS SET
+       CDF 10          /BACK TO FIELD 1
+       TAD I [IBUF10+2
+       AND [177
+       DCA WORDS       /SET NUMBER OF WORDS
+       TAD I [IBUF10+1
+       RTR
+       RTR
+       RTR
+       AND [77
+       DCA IBLOCK      /SET NEXT BLOCK
+       TAD I [IBUF10
+       AND [77
+       CLL RTL
+       RTL
+       RTL
+       TAD IBLOCK
+       DCA IBLOCK      /SET NEXT BLOCK
+       TAD (IBUF10+3
+       DCA IPOINT      /RESET POINTER
+       JMP ICHAR0
+
+ICHARA,        CLA CMA
+       TAD WORDS
+       DCA WORDS       /COUNT DOWM ON NUMBER OF WORDS
+       TAD MODE        /IMAGE MODE?
+       SNA
+       JMP ICHARB      /NO
+       SMA CLA
+       JMP IC10A1
+       ISZ IPOINT      /YES
+       ISZ IPOINT
+       TAD I IPOINT    /GET WORD 3
+       ISZ IPOINT
+       AND [377        /USE 8 BITS
+ICHARC,        ISZ ICHR10      /2ND EXIT
+       CDF             /BACK TO FIELD 0
+       JMP I ICHR10    /EXIT
+
+ICHARB,        TAD SAVELN      /PRESERVE OPTION?
+       SZA CLA
+       JMP ICHARF      /YES
+       CLL CLA CML RTL /NO
+       TAD IPOINT
+       DCA ICHARY      /POINT TO WORD 3
+       TAD I ICHARY
+       CLL RAR
+       SNL CLA
+       JMP ICHARF      /WORD O.K.
+       ISZ IPOINT
+       ISZ IPOINT      /IGNORE THIS WORD
+       ISZ IPOINT
+       JMP ICHAR0
+
+ICHARF,        TAD I IPOINT
+       RTR
+       RTR             /GET BITS 0-6
+       RAR
+ICHARD,        ISZ CHARNI      /BUMP COUNTER
+       AND [177        /USE 7 BITS
+       TAD [200        /ADD BIT 8
+       JMP ICHARC
+
+/INPUT CHARACTER #1 - BITS 7-11 WORD 1 AND BITS 0-1 WORD 2
+
+ICHAR1,        TAD MODE
+       SZA CLA
+       JMP IC10A1
+       TAD I IPOINT
+       AND [37
+       CLL RTL         /GET BITS 7-11
+       DCA ICHARY
+       ISZ IPOINT      /USE WORD 2 NOW
+       TAD I IPOINT
+       CLL RTL
+       RAL
+       AND [3          /GET BITS 0-1
+ICHARE,        TAD ICHARY      /ADD IN OTHER BITS
+       JMP ICHARD
+
+/INPUT CHARACTER #2 - BITS 2-8 WORD 2
+
+ICHAR2,        TAD MODE
+       SZA CLA
+       JMP IC10A3
+       TAD I IPOINT
+       RAR
+       RTR             /GET BITS 2-8
+       JMP ICHARD
+
+/INPUT CHARACTER #3 - BITS 9-11 WORD 2 AND BITS 0-3 WORD 3
+
+ICHAR3,        TAD I IPOINT
+       AND [7
+       CLL RTL
+       RTL             /GET BITS 9-11
+       DCA ICHARY
+       ISZ IPOINT      /USE WORD 3 NOW
+       TAD I IPOINT
+       RTL
+       RTL
+       RAL
+       AND [17         /GET BITS 0-3
+       JMP ICHARE
+
+/INPUT CHARACTER #4 - BITS 4-10 WORD 3
+
+ICHAR4,        DCA CHARNI      /RESET CHARACTER COUNT
+       TAD I IPOINT
+       ISZ IPOINT
+       RAR
+       JMP ICHARD+1
+
+IC10A3,        DCA CHARNI
+       SKP
+IC10A1,        ISZ CHARNI
+       TAD I IPOINT
+       ISZ IPOINT
+       JMP ICHARC
+       PAGE
+\f/CLOSE A PDP-10 FILE
+/
+/CALL:
+/      JMS CLOS10      /CLOSE A PDP-10 FILE
+/      -RETURN-
+
+CLOS10,        0               /CLOSE A PDP-10 FILE
+       TAD MODE        /IMAGE MODE?
+       SPA CLA
+       JMP CLOS1A      /YES - NO FILL NEEDED
+       TAD CHARNO
+       SNA CLA
+       JMP CLOS1A      /CHARACTER NUMBER IS 0 - FILL DONE
+       JMS I (OCHR10   /0 FILL
+       JMP .-4         /LOOP
+
+CLOS1A,        TAD OUNIT
+       DCA UNIT10      /SET OUR UNIT
+       TAD OBLOCK
+       DCA .+3         /SET THE BLOCK
+       JMS I (WRITET   /WRITE PDP-10 DECTAPE
+       OBUF10
+       0               /BLOCK IS SET
+       TAD (MOUTPU
+       JMS I (DELETE   /DELETE THE OLD FILE
+       NOP             /O.K. IF IT IS NOT THERE
+       TAD FREEP
+       DCA INDEX0      /POINT TO THE FREE SPOT
+       TAD [MOUTPU
+       DCA INDEX1      /POINT TO THE FILE NAME
+       CDF 10          /TO FIELD 1
+       TAD I INDEX1
+       DCA I INDEX0
+       TAD I INDEX1    /SET THE NAME
+       DCA I INDEX0
+       TAD I INDEX1
+       DCA I INDEX0
+       TAD INDEX0
+       TAD [77
+       DCA INDEX0      /POINT TO THE EXTENSION
+       TAD I INDEX1
+       DCA I INDEX0    /SET THE EXTENSION
+       TAD I INDEX1
+       DCA I INDEX0
+       TAD DATE
+       DCA I INDEX0    /SET THE DATE
+       JMS I (FIX75    /V3C SET HIGH ORDER BIT TOO
+       JMS I (WRITET   /WRITE PDP-10 DECTAPE
+       DIRECT          /DIRECTORY
+       144             /BLOCK 100 BASE 10
+       JMP I CLOS10    /EXIT
+\f/OPEN A PDP-10 FILE FOR OUTPUT
+/
+/CALL:
+/      JMS OOPN10      /OPEN A PDP-10 FILE
+/      -RETURN-
+
+OOPN10,        0               /OPEN A PDP-10 FILE
+       TAD (ZFREE-1
+       JMS I (FIND     /FIND A FREE SPOT
+       JMP I (NOROOM   /NO ROOM LEFT
+       DCA I (SLOTNO   /SET THIS SLOT
+       TAD INDEX0
+       DCA FREEP       /SAVE POINTER TO FREE SPOT
+       CLA CMA
+       DCA I (NEXTDI   /SET DIRECTION = -1
+       TAD (144
+       JMS I (NEXTSL   /FIND FIRST OPEN SLOT
+       DCA OBLOCK      /AND SET IT
+       CDF 10
+       TAD I [MOUTPU
+       DCA OUNIT       /SET UNIT
+       TAD OBLOCK
+       AND [17
+       CLL RTR
+       RTR
+       RAR
+       DCA I [OBUF10+2 /SET FIRST BLOCK POINTER
+       TAD OBLOCK
+       CLL RTR
+       RTR
+       AND [77
+       DCA I [OBUF10+1 /SET FIRST BLOCK POINTER
+       DCA I [OBUF10   /ZERO LINK POINTER
+       DCA CHARNO      /RESET CHARACTER NUMBER
+       TAD (OBUF10+3
+       DCA OPOINT      /RESET POINTER
+       CDF
+       JMP I OOPN10    /EXIT
+\f/OPEN PDP-10 INPUT FILE
+/
+/CALL:
+/      (AC)            /POINT TO FILE NAME-1
+/      JMS IOPN10      /OPEN PDP-10 INPUT FILE
+/      -NO-            /NOT THERE
+/      (AC)            /ANY BLOCK OF THE FILE
+
+IOPN10,        0               /OPEN PDP-10 INPUT FILE
+       JMS I (FIND     /FIND THE FILE
+       JMP I IOPN10    /NOT THERE
+       DCA IOPN1B      /SAVE SLOT NUMBER
+       TAD (143
+       DCA IOPN1A
+       TAD (CLA CMA
+       DCA IOPN1D
+IOPN1F,        JMS I (FINDSL   /FIND A SLOT
+IOPN1A,        0               /SLOT TO FIND
+       CIA
+       TAD IOPN1B      /IS IT US?
+       SNA CLA
+       JMP IOPN1C      /YES
+IOPN1D,        CLA CMA
+       TAD IOPN1A      /BUMP BLOCK NUMBER
+       SPA
+       JMP IOPN1E      /TOO FAR
+       TAD [-1102
+       SMA
+       JMP I IOPN10    /TOO FAR - EXIT
+       TAD (1102
+       DCA IOPN1A      /SET NEW BLOCK
+       JMP IOPN1F      /RETRY
+
+IOPN1B,        0               /SLOT THAT WE WANT
+
+IOPN1E,        CLA
+       TAD (CLA IAC
+       JMP IOPN1F-1    /CHANGE DIRECTION AND RETRY
+
+IOPN1C,        TAD IOPN1A
+       CDF
+       ISZ IOPN10
+       JMP I IOPN10    /EXIT
+       PAGE
+\f/CONVERT OS8 DATE TO PDP-10 DATE
+
+CVDATE,        0
+       SNA
+       JMP I CVDATE    /0 CONVERTS TO 0
+       DCA TEMP1
+       TAD TEMP1       /V3C
+       RTR
+       RAR
+       AND [37
+       TAD (-1         /GET DAY
+       DCA DATE4       /V3C
+       TAD TEMP1
+       AND [7          /GET OS8 YEAR (-1970)
+DECIMAL
+       TAD (1970-1964
+OCTAL
+       DCA DATE1       /SAVE YEAR
+       TAD DATE1
+       CLL RAL         /*2
+       TAD DATE1       /*2+1=*3
+       CLL RTL         /*3*4=*12
+       DCA DATE1       /DATE1=DATE1*12
+       TAD TEMP1
+       RTL
+       RTL
+       RAL
+       AND [17         /GET MONTH
+       TAD (-1
+       TAD DATE1       /ADD IN MONTH
+       DCA DATE1
+       TAD DATE1
+       CLL RAL         /*2
+       TAD DATE1       /*2+1=*3
+       DCA TEMP2
+       TAD TEMP2
+       CLL RTL         /*3*4=*12
+       TAD TEMP2       /*12+*3=*15
+       CLL RAL         /*15*2=*30
+       TAD DATE1       /*30+1=*31
+       TAD DATE4       /V3C ADD IN DAY
+       DCA DATE1       /DATE1=DATE1+MONTH-1 * 31
+       RAL             /V3C LINK NOW HAS HIGH ORDER DATE BIT
+       DCA HIDATE      /ONLY WITHIN RANGE OF OS/8
+       TAD DATE1       /RETURN LOW ORDER 12 BITS OF DATE
+       JMP I CVDATE
+
+DATE1, 0
+DATE4, 0
+
+/TYPE A PDP-10 DATE
+\fDATE10,       0
+       SZL             /LINK HAD HIGH ORDER BIT
+       TAD (4          /IF ON, WANT ADDITIONAL 11 YEARS, 4 DAYS
+       DCA DATE1       /SAVE VALUE
+       RAL             /V3C
+       DCA DATE75      /SAVE FACT THAT NEED 'NUTHER 11 YEARS
+       TAD (100        /V3C BASE IS (19)64
+       DCA DATE2       /WILL BE YEAR
+DATE11,        TAD DATE1
+       SMA CLA
+       JMP DATE12      /MUST BE POSITIVE
+       ISZ DATE2       /BUMP YEAR
+       TAD DATE1
+       TAD (-564       /-372 DECIMAL (DAYS PER YEAR)
+       DCA DATE1
+       JMP DATE11
+
+DATE12,        DCA DATE3       /WILL BE MONTH
+       TAD DATE1       /DIVIDE BY 31
+       TAD (-37
+       SPA
+       JMP .+4
+       ISZ DATE3       /BUMP MONTH
+       DCA DATE1
+       JMP .-6
+
+       CLA
+       ISZ DATE1       /+1 IS DAY
+       TAD DATE3       /DIVIDE BY 12
+       TAD (-14
+       SPA
+       JMP .+4
+       ISZ DATE2       /BUMP YEAR
+       DCA DATE3
+       JMP .-6
+
+       CLA
+       TAD DATE1
+       TAD (-12
+       SMA CLA
+       JMP DATE9
+       TAD ("0
+       JMS I OUTPUT    /PRINT LEADING 0 IF NECESSARY
+DATE9, TAD DATE1
+       JMS I (PRINT    /PRINT DAY
+       TAD ("-
+       JMS I OUTPUT
+       TAD DATE3
+       TAD DATE3
+       TAD DATE3       /V3C MULTIPLY BY 3
+       TAD (MONTBL     /ADD IN BASE OF MONTH NAMES
+       DCA MONPTR      /POINT TO PROPER MONTH NAME
+       TAD I MONPTR    /GET CHAR 1
+       JMS I OUTPUT    /PRINT IT
+       ISZ MONPTR      /POINT TO NEXT CHAR
+       TAD I MONPTR    /GET CHAR 2
+       JMS I OUTPUT    /PRINT IT
+       ISZ MONPTR      /V3C
+       TAD I MONPTR
+       JMS I OUTPUT
+       TAD ("-
+       JMS I OUTPUT
+       TAD DATE75      /V3C
+       SZA CLA
+       TAD (13         /ADD 11 YEARS IF H.O. BIT ON
+       TAD DATE2
+       JMS I (PRINT    /PRINT YEAR
+       JMP I DATE10
+
+DATE2, 0               /YEAR
+DATE3, 0               /MONTH
+MONPTR,        0               /V3C POINTS TO MONTH NAME
+       PAGE
+\fDECIMAL
+PRINTL,        -1000
+       -100
+       -10
+OCTAL
+
+PRINTZ,        0               /PRINT WITH LEADING SPACES
+       DCA PRINT0
+       TAD PRINTZ
+       DCA I (PRINT
+       TAD (240
+       JMP I (PRINT7
+
+/ZERO A DIRECTORY (PDP-10)
+
+ZERO10,        0               /ZERO THE PDP-10 DIRECTORY
+       TAD I [MOUTPU
+       AND [17
+       SZA CLA
+       JMP I (NOT10F   /NOT A PDP-10
+       TAD I [MOUTPU
+       DCA UNIT10      /SET UNIT
+       TAD (DIRECT-1
+       DCA INDEX0      /POINT TO DIRECTORY
+       TAD (-600
+       DCA CNTR        /COUNT OF 600
+       DCA I INDEX0    /ZERO THE DIRECTORY
+       ISZ CNTR
+       JMP .-2         /LOOP
+       TAD (7570
+       DCA I (DIRECT   /SAVE BLOCKS 1 AND 2
+       TAD (170
+       DCA I (DIRECT+52        /SAVE BLOCK 144
+       TAD (777
+       DCA I (DIRECT+367       /SAVE BLOCKS 1102 ON UP
+       CLA CMA
+       DCA I (DIRECT+370
+       JMS I (WRITET   /WRITE PDP-10 DECTAPE
+       DIRECT          /DIRECTORY
+       144             /DIRECTORY BLOCK
+       CDF 10
+       JMP I ZERO10    /EXIT
+\f/DELETE A PDP-10 FILE
+
+DELE10,        0               /DELETE A PDP-10 FILE
+       TAD I [MOUTPU
+       AND [17
+       SZA
+       JMP DELOS8      /DELETE A OS8 FILE
+       TAD I [MOUTPU
+       DCA UNIT10      /SET UNIT
+       TAD [MOUTPU
+       CDF
+       JMS I (DELETE   /DELETE THE PDP-10 FILE
+       JMP I (ERDELF   /NOT THERE
+       JMS I (WRITET   /WRITE PDP-10 DECTAPE
+       DIRECT
+       144             /DIRECTORY BLOCK
+       JMP I DELE10    /EXIT
+
+DELOS8,        CIF CDF 10
+       JMS I (DELPS1   /DELETE A OS8 FILE
+       JMP I DELE10
+       JMP I (ERDELF   /ERROR DELETING THE FILE
+\fPAGE
+
+/GET THE NEXT INPUT FILE
+
+NEXIFL,        0               /GET THE NEXT INPUT FILE
+       DCA CHARNI      /RESET STUFF
+       DCA WORDS
+       CDF 10
+       CLA CMA
+       DCA I (INCHCT
+       DCA I (INEOF
+       TAD (INDEVH+1
+       DCA INDEVX
+       TAD I IXR       /GET NEXT
+       SNA
+       JMP NEXIF2      /E.O.F
+       DCA IUNIT
+       TAD I IXR
+       DCA IBLOCK      /SET START BLOCK
+       CDF
+       TAD IUNIT
+       AND [17
+       SNA
+       JMP NEXIF1      /PDP-10 FILE
+       CIF 10
+       JMS I [200
+       1
+INDEVX,        0
+       JMP I (NOOFIL
+       CDF 10
+       TAD INDEVX
+       DCA I (INHNDL
+       TAD IBLOCK
+       DCA I (INREC
+       TAD IUNIT
+       AND [7760
+       SZA
+       TAD [17
+       CLL CML RTR
+       RTR
+       DCA I (INCTR
+       TAD (ICHRPS
+       JMP NEXIF3
+
+NEXIF1,        TAD IUNIT
+       DCA UNIT10
+       TAD IBLOCK
+       DCA .+3
+       JMS I (READT
+       IBUF10
+       0               /READ ANY BLOCK
+       CDF 10
+       TAD I [IBUF10+2
+       RTL
+       RTL
+       RAL
+       AND [17
+       DCA IBLOCK
+       TAD I [IBUF10+1
+       AND [77
+       CLL RTL
+       RTL
+       TAD IBLOCK
+       DCA IBLOCK      /SET START BLOCK
+       TAD (ICHR10
+NEXIF3,        DCA INPUT       /SET ROUTINE POINTER
+       ISZ NEXIFL
+NEXIF2,        CDF
+       JMP I NEXIFL    /EXIT
+
+ICHRPS,        0
+       CIF CDF 10
+       JMS I (ICHARP
+       SKP
+       ISZ ICHRPS
+       JMP I ICHRPS
+
+OCHRPS,        0
+       CIF 10
+       JMS I (OCHARP
+       JMP I (IOERR
+       JMP I OCHRPS
+       PAGE
+\fPIP10,        CDF 10          /STARTS HERE - JUMPED TO FROM 200
+       DCA HIDATE      /V3C
+       TAD I (MDATE    /GET TODAY'S DATE
+       CDF
+       JMS I (CVDATE   /CONVERT IT
+       DCA DATE        /AND STORE IT
+       TAD     (3401   /UNRESTARTABLE, DOESN'T DESTROY BATCH OR USR AREA
+       DCA I   (JSBITS
+PIPCD, CDF
+       JMS I (CD       /COMMAND DECODE
+       CDF 10
+       TAD I (MPARAM
+       AND (2010
+       CLL RAL
+       DCA MODE        /SET /I SWITCH
+       TAD I (MPARAM+1
+       AND (400
+       DCA SAVELN      /SET /P SWITCH
+       TAD I (MPARAM
+       AND (101
+       SZA CLA
+       JMP I (LIST10   /EITHER /F OR /L
+       TAD I [MOUTPU
+       SZA CLA
+       JMP PIP001      /IS AN OUTPUT FILE
+       TAD I (MINPUT
+       SNA CLA
+       JMP PIPCD       /NO OUTPUT OR INPUT FILES
+       JMP I (NOOOFL   /INPUT, BUT NO OUTPUT
+
+PIP001,        CLL CLA CML RTR
+       AND I (MPARAM+2
+       SZA CLA
+       JMS I (ZERO10   /IT IS /Z OPTION
+       TAD (OUDEVH+1
+       DCA OUDEVX
+       TAD I [MOUTPU
+       AND [17
+       SZA
+       JMP PIPB        /OUTPUT IS OS8
+       TAD I [MOUTPU
+       DCA UNIT10      /SET UNIT
+       JMS I (READT
+       DIRECT          /GET DIRECTORY INTO CORE
+       144
+PIPA,  CDF 10
+       TAD OUDEVX
+       DCA I (OUHNDL
+       TAD I (MPARAM
+       AND (400
+       SZA CLA
+       JMS I (DELE10   /DELETE A PDP-10 FILE FIRST
+       CDF 10
+       TAD (MINPUT-1
+       DCA IXR
+       TAD I IXR
+       SNA CLA
+       JMP PIPCD       /NO INPUT
+       TAD (MINPUT-1
+       DCA IXR         /SET INPUT LIST
+       TAD I [MOUTPU
+       AND [17
+       CDF
+       SZA CLA
+       JMP PIPC        /OUTPUT IS OS8
+       JMS I (OOPN10   /OPEN PDP-10 OUTPUT
+       TAD (OCHR10
+PIPD,  DCA OUTPUT      /SET OUTPUT ROUTINE
+PIPE,  SZA CLA         /IS IT ERROR OR EOF
+       JMP I (IOERR    /ERROR
+       JMS I (NEXIFL   /GET NEXT FILE
+       JMP PIPF        /FINAL EOF
+       JMS I INPUT     /GET INPUT
+       JMP PIPE        /EOF OR ERROR
+       JMS I OUTPUT    /OUTPUT
+       JMP .-3         /LOOP
+
+PIPC,  CIF CDF 10
+       JMS I (OOPNPS   /OPEN OS8 OUTPUT
+       JMP I (NOOOFL
+       TAD (OCHRPS
+       JMP PIPD
+
+PIPB,  CDF 0
+       CIF 10
+       JMS I [200
+       1               /GET OS8 OUTPUT HANDLER
+OUDEVX,        0
+       JMP I (NOOFIL
+       JMP PIPA
+
+PIPF,  CDF 10
+       TAD I [MOUTPU   /NOW CLOSE THE OUTPUT FILE
+       AND [17
+       CDF
+       SZA CLA
+       JMP PIPG
+       JMS I (CLOS10
+       JMP PIPCD
+
+PIPG,  CIF CDF 10
+       JMS I (OCLOSE
+       JMP I (IOERR
+       JMP PIPCD
+       PAGE
+\fLIST10,       TAD (OUDEVH+1
+       DCA OUDEVY
+       TAD (OUDEVH+1
+       DCA OUDEVZ
+       TAD (3100       /RESET THINGS
+       DCA LISTDV+1
+       TAD I [MOUTPU
+       SZA
+       JMP LIST11      /OUTPUT FILE EXISTS
+       CDF 0
+       CIF 10
+       JMS I [200
+       1
+LISTDV,        TEXT /TTY/      /LOOKUP THE TTY:
+OUDEVY,        0
+       JMP I (NOOOFL
+       CDF 10
+       TAD LISTDV+1
+       DCA I [MOUTPU   /SET TTY: DEVICE NUMBER
+       TAD I [MOUTPU
+LIST11,        AND [17
+       SNA
+       JMP I (NOTPSF   /NOT A OS8 FILE
+       CDF 0
+       CIF 10
+       JMS I [200
+       1               /LOOKUP DEVICE
+OUDEVZ,        0
+       JMP I (NOOFIL
+LIST12,        CDF CIF 10
+       TAD OUDEVZ
+       DCA I (OUHNDL
+       JMS I (OOPNPS   /OPEN OUTPUT FILE
+       JMP I (NOOOFL
+       TAD (OCHRPS
+       DCA OUTPUT      /SET OUTPUT ROUTINE
+       CDF 10
+       TAD I (MINPUT
+       DCA UNIT10
+       CDF
+       TAD UNIT10
+       SNA
+       JMP I (PIPCD    /NO INPUT
+       AND [17
+       SZA CLA
+       JMP I (NOT10F
+       JMS I (READT    /READ THE DIRECTORY
+       DIRECT
+       144
+       TAD (LISTL-1
+       DCA INDEX0
+       TAD (-40
+       DCA CNTR
+       DCA I INDEX0    /CLEAR THE COUNTS
+       ISZ CNTR
+       JMP .-2
+       TAD (-1101
+       DCA LIST13
+       CLA IAC
+       DCA LIST14
+       JMS I (FINDSL   /FIND ALL SLOTS
+LIST14,        0
+       TAD (LISTL
+       DCA LIST15
+       ISZ I LIST15    /COUNT THE NUMBER IN EACH SLOT
+       ISZ LIST14
+       ISZ LIST13
+       JMP LIST14-1
+       JMS I   (CRLF
+       TAD I (LISTL
+       JMS I (PRINTZ   /PRINT FREE BLOCKS
+       TAD (LISTM1-1
+       DCA INDEX0
+       JMS I (ERROR4   /"FREE BLOCKS"
+       JMS I   (CRLF
+       TAD (-26
+       DCA LIST13
+       TAD (DIRECT+370
+       DCA INDEX6
+       TAD (DIRECT+2   /HIGH ORDER BIT (4096'S) OCCURS AT END OF EACH
+       DCA XDATE       /PDP-10 WORD AT BEGIN OF DIRECTORY
+                       /THIS IS END OF EVERY 3RD PDP-8 WORD
+LIST17,        CDF 10          /MAIN LOOP
+       TAD I INDEX6
+       SNA
+       JMP I (LIST16   /DO NOT PRINT THIS BLANK ENTRY
+       JMS I (LIST18
+       TAD I INDEX6
+       JMS I (LIST18
+       TAD I INDEX6
+       JMS I (LIST18
+       CDF
+       TAD (".
+       JMS I OUTPUT
+       JMP I (LIST22
+
+LIST13,        0
+LIST15,        0
+       PAGE
+\fLIST22,       CDF 10
+       TAD INDEX6
+       TAD [77
+       DCA INDEX5
+       TAD I INDEX5    /GET EXTENSION
+       JMS LIST18
+       TAD I INDEX5
+       AND [7700
+       JMS LIST18
+       CLA IAC
+       AND I (MPARAM
+       SNA CLA
+       JMP LIST19      /NO EXTRA IF NOT /L
+       JMS LIST18
+       CDF
+       TAD I (LIST13
+       TAD (LISTL+27
+       DCA LIST23
+       TAD I LIST23    /GET NUMBER OF BLOCKS
+       JMS I (PRINTZ
+       JMS LIST18
+       TAD I XDATE     /V3C
+       RAR             /HIGH ORDER BIT OF DATE TO LINK
+       CLA
+       TAD I INDEX5
+       CDF
+       JMS I (DATE10
+LIST19,        CDF
+       JMS CRLF
+LIST20,        CDF
+       TAD XDATE       /V3C
+       TAD (3          /POINT TO NEXT DATE H.O. BIT
+       DCA XDATE
+       ISZ I (LIST13
+       JMP I (LIST17   /LOOP
+       JMS CRLF
+       JMP I (PIPG     /CLOSE THE FILE
+
+LIST16,        ISZ INDEX6
+       ISZ INDEX6
+       JMP LIST20
+
+CRLF,  0
+       TAD [215
+       JMS I OUTPUT
+       TAD [212
+       JMS I OUTPUT
+       JMP I CRLF
+
+LIST23,        0
+
+LIST18,        0
+       CDF
+       DCA TEMP1
+       TAD TEMP1
+       RTR
+       RTR
+       RTR
+       JMS LIST21
+       TAD TEMP1
+       JMS LIST21
+       CDF 10
+       JMP I LIST18
+
+LIST21,        0
+       AND [77
+       TAD [240
+       JMS I OUTPUT
+       JMP I LIST21
+\f/FIND A PDP-10 ENTRY IN DIRECTORY
+/
+/CALL:
+/      (AC)            /POINT TO NAME-1 (FIELD 1)
+/      JMS FIND        /FIND A PDP-10 ENTRY
+/      -NO-            /NOT FOUND
+/      (AC)            /SLOT NUMBER IF FOUND
+
+FIND,  0               /FIND A PDP-10 FILE
+       DCA FIND4       /SAVE POINTER
+       TAD (DIRECT+370
+       DCA INDEX0      /POINT TO DIRECTORY START
+       TAD (-26
+       DCA CNTR        /22 DECIMAL FILES
+       CDF 10          /DIRECTORY IS IN FIELD 1
+FIND2, TAD FIND4               /GET POINTER
+       DCA INDEX2      /POINT TO NAME,EXT
+       TAD I INDEX0
+       CIA
+       TAD I INDEX2    /CHECK WORD 1
+       SZA CLA
+       JMP FIND1       /NO
+       TAD I INDEX0
+       CIA
+       TAD I INDEX2    /CHECK WORD 2
+       SZA CLA
+       JMP FIND1+1     /NO
+       TAD I INDEX0
+       CIA
+       TAD I INDEX2    /CHECK WORD 3
+       SZA CLA
+       JMP FIND1+2     /NO
+       TAD INDEX0
+       TAD [77
+       DCA INDEX1      /POINT TO EXTENSIONS
+       TAD I INDEX1
+       CIA
+       TAD I INDEX2    /CHECK WORD 4
+       SZA CLA
+       JMP FIND1+2     /NO
+       TAD I INDEX1
+       AND [7700
+       CIA
+       TAD I INDEX2    /CHECK WORD 5
+       SZA CLA
+       JMP FIND1+2     /NO
+       CLL CLA CMA RTL
+       TAD INDEX0
+       DCA INDEX0      /POINT TO ENTRY AGAIN
+       TAD CNTR
+       TAD (27
+       ISZ FIND        /WE FOUND IT - 2ND EXIT
+FIND3, CDF             /BACK TO FIELD 0
+       JMP I FIND      /EXIT
+
+FIND1, ISZ INDEX0      /EXTRA POINTER BUMPS
+       ISZ INDEX0
+       ISZ CNTR        /MORE FILES?
+       JMP FIND2       /YES - LOOP
+       JMP FIND3       /NO - NOT FOUND
+
+FIND4, 0               /POINTER TO NAME-1
+       PAGE
+\fLINBUF=.
+LISTL, ZBLOCK 105
+
+LISTM1,        TEXT / FREE BLOCKS   PIP10  V/
+VERLOC,        *.-1
+       60+VERSION^100+SUBVER
+       3700
+
+ERMES0,        TEXT    /_PIP10 CANNOT BE CHAINED TO_/
+ERMES1,        TEXT #_I/O ERROR_#
+
+ERMES2,        TEXT /_DEVICE FULL_/
+
+ERMES3,        TEXT /_NO SUCH DEVICE_/
+
+ERMES4,        TEXT /_NOT PDP-10 FILE_/
+
+ERMES5,        TEXT /_ERROR DELETING FILE_/
+
+ERMES6,        TEXT /_NOT OS8 FILE_/
+
+ERMES7,        TEXT /_OUTPUT FILE OPEN ERROR_/
+
+ERMES8,        TEXT /_SYNTAX ERROR_/
+ERMES9,        TEXT    /_FILE NOT FOUND_/
+\f/ROUTINE TO SET TD8E UNIT INFORMATION FROM UNIT10
+
+TDUSET,        0
+       TAD     UNIT10
+       CLL RTL
+       RAL
+       AND     (7
+       TAD     (DVCTBL
+       DCA     DVCPTR
+       RAR
+       DCA     TDUNIT  /SAVE EVEN/ODD BIT
+       TAD     (TDUTBL
+       DCA     TDUPTR
+TDULP, TAD I   TDUPTR
+       SNA
+       JMP I   TDUSET
+       DCA     TDUT
+       TAD I   TDUT
+       AND     (7
+       TAD I   DVCPTR
+       DCA I   TDUT
+       ISZ     TDUPTR
+       JMP     TDULP
+TDUPTR,        0
+TDUT,  0
+DVCPTR,        0
+DVCTBL,        6770;6760;6750;6740
+
+TDUTBL,        DIO01
+       DIO02
+       DIO03
+       DIO04
+       DIO05
+       DIO06
+       DIO07
+       DIO08
+       DIO09
+       DIO10
+       DIO11
+       DIO12
+       DIO13
+       DIO14
+       DIO15
+       DIO16
+       DIO17
+       DIO18
+       DIO19
+       DIO20
+       DIO21
+       DIO22
+       IOTX1
+       IOTX2
+       IOTX3
+       IOTX4
+       IOTX5
+       IOTX6
+       IOTX7
+       IOTX8
+       0
+       PAGE
+\f/GET A CHARACTER
+
+GCH,   0
+       TAD I IXR       /GET A CHAR
+       TAD (-240
+       SNA
+       JMP GCH+1       /IGNORE SPACES
+       TAD (240-"/
+       SNA
+       JMP SLASH
+       TAD ("/-"(
+       SNA
+       JMP OPENP
+       TAD ("(
+       JMP I GCH       /EXIT
+
+SLASH, TAD I IXR
+       JMS SLSHCH      /GET OPTION
+       JMP GCH+1
+
+OPENP, TAD I IXR
+       TAD (-")
+       SNA
+       JMP GCH+1       /END
+       TAD (")
+       JMS SLSHCH      /GET OPTION
+       JMP OPENP
+
+SLSHCH,        0
+       SNA
+       JMP I (SYNTAX   /ERROR
+       DCA TEMP6
+       TAD (MPARAM-1
+       DCA TEMP5       /POINT TO PARAMETERS
+       JMS DECODE
+       JMP I (SYNTAX
+       SZL
+       TAD (32         /ADD
+       TAD (-14
+       ISZ TEMP5
+       SMA
+       JMP .-3         /FIND DIVIDED BY 12
+       DCA TEMP4
+       CLL CML
+       RAL
+       ISZ TEMP4
+       JMP .-2         /SHIFT A BIT
+       DCA TEMP4       /SAVE IT
+       CDF 10
+       TAD TEMP4
+       CMA
+       AND I TEMP5
+       TAD TEMP4       /OR IN THAT BIT
+       DCA I TEMP5
+       CDF
+       JMP I SLSHCH
+
+DECODE,        0
+       TAD TEMP6
+       TAD (-"9-1
+       CLL
+       TAD ("9+1-"0
+       SZL
+       JMP DECOD1
+       TAD ("0-"Z-1
+       CLL CML
+       TAD ("Z-"A+1
+       SNL
+DECOD1,        ISZ DECODE
+       JMP I DECODE
+
+EXA40, 0
+       TAD (CDNAME
+       DCA TEMP5
+       TAD (-5
+       DCA TEMP4
+EXA401,        CLL CLA CML RAR
+       TAD I TEMP5
+       AND [7700
+       CLL RAL
+       SZA
+       RAR
+       DCA TEMP3
+       TAD I TEMP5
+       TAD (40
+       AND [77
+       TAD (-40
+       SZA
+       TAD (40
+       TAD TEMP3
+       DCA I TEMP5
+       ISZ TEMP5
+       ISZ TEMP4
+       JMP EXA401
+       JMP I EXA40
+       PAGE
+\f/GET A NAME ROUTINE
+
+GNAME, 0
+       DCA CDDEV       /CLEAR AREA
+       DCA CDDEV+1
+       CLA CMA
+       DCA DEVSW       /ALLOW DEVICES
+GNAME1,        DCA CDNAME      /CLEAR NAME,EXTENSION
+       DCA CDNAME+1
+       DCA CDNAME+2
+       DCA CDEXT
+       DCA CDEXT+1
+       CLA CMA
+       DCA PERSW       /ALLOW EXTENSIONS
+       TAD (CDNAME
+       DCA POINT       /SET POINTER
+       DCA CNTR        /SET SWITCH
+GNAME2,        JMS I (GCH      /GET A CHAR
+       DCA TEMP6
+       TAD TEMP6
+       SNA
+       JMP GNAME6      /END
+       TAD (-":
+       SNA
+       JMP GNAME5      /: IS DEVICE
+       TAD (":-".
+       SNA
+       JMP GNAME4      /. IS EXTENSION
+       TAD (".
+       DCA TEMP6       /SAVE THE CHAR
+       JMS I (DECODE
+       JMP GNAME6-1    /NOT 0-9 OR A-Z IS END
+       CLA
+       TAD TEMP6
+       AND [77         /GET TRIMMED ASCII
+       ISZ CNTR
+       JMP GNAME3      /LEFT HALF
+       TAD I POINT
+       DCA I POINT     /SET RIGHT HALF
+       ISZ POINT
+       JMP GNAME2      /LOOP
+
+GNAME3,        CLL RTL
+       RTL
+       RTL
+       DCA I POINT     /SET LEFT HALF
+       CLA CMA
+       DCA CNTR
+       TAD POINT
+       TAD (-CDEXT-2
+       SZA CLA
+       JMP GNAME2      /LOOP
+       JMP GNAME2-1    /LOOP - IGNORE
+
+GNAME4,        TAD CDNAME
+       SZA CLA
+       ISZ PERSW
+       JMP I (SYNTAX   /ERROR
+       DCA CDEXT
+       DCA CDEXT+1     /CLEAR EXTENSION
+       TAD (CDEXT
+       JMP GNAME2-2    /GET EXTENSION
+
+GNAME5,        ISZ DEVSW
+       JMP I (SYNTAX   /ERROR
+       ISZ PERSW
+       JMP I (SYNTAX   /ERROR
+       TAD CDNAME
+       SNA
+       JMP I (SYNTAX   /ERROR
+       DCA CDDEV
+       TAD CDNAME+1
+       DCA CDDEV+1     /SET DEVICE
+       JMP GNAME1      /NOW GET THE NAME
+
+       CLA
+GNAME6,        DCA CDEXT+2
+       TAD CDEXT+1
+       AND [7700
+       DCA CDEXT+1
+       ISZ PERSW
+       JMP I GNAME     /EXIT
+       DCA CDEXT
+       DCA CDEXT+1     /CLEAR EXTENSION
+       JMP I GNAME     /EXIT
+       PAGE
+\fCD,   0
+       TAD [MOUTPU-1
+       DCA INDEX0
+       TAD (-47
+       DCA CNTR
+       CDF 10
+       DCA I INDEX0    /CLEAR AREAS
+       ISZ CNTR
+       JMP .-2
+       CDF
+       CIF 10
+       JMS I [200
+       13              /RESET TABLES
+       0
+       DCA INSEG       /NO DIRECTORY IN CORE
+       DCA PDP10D      /NO KNOWN PDP-10 DRIVES
+       DCA PDP10D+1
+       DCA PDP10D+2
+       DCA PDP10D+3
+       DCA PDP10D+4
+       DCA PDP10D+5
+       DCA PDP10D+6
+       DCA PDP10D+7
+       DCA CDCNT       /ZERO INPUT COUNT
+       JMS I (GLINE    /GET A LINE
+       TAD [LINBUF-1
+       DCA IXR
+       TAD I IXR
+       SNA
+       JMP NOBAKB      /NO "<" IS LINE
+       TAD (-"<
+       SZA CLA
+       JMP .-5
+       TAD [LINBUF-1
+       DCA IXR
+       TAD XDSK
+       DCA CDDEVF      /SET "DSK" AS DEFAULT
+       TAD XDSK+1
+       DCA CDDEVF+1
+       JMS I (GNAME    /GET THE NAME
+       TAD TEMP6
+       TAD (-"[
+       SZA CLA
+       JMP CDX03       /NO SIZE SPECIFIED
+CDX01, JMS I (GCH
+       TAD (-"]
+       SNA
+       JMP CDX02       /END OF SIZE
+       TAD ("]-"0
+       SPA
+       JMP I (SYNTAX   /ERROR
+       DCA TEMP1
+       TAD CDEXT+2
+       CLL RTL
+       TAD CDEXT+2
+       RAL
+       TAD TEMP1
+       DCA CDEXT+2     /ADD IN NUMBER
+       TAD TEMP1
+       TAD (-11
+       SMA SZA CLA
+       JMP I (SYNTAX   /ERROR
+       JMP CDX01
+
+CDX02, JMS I (GCH
+       SKP
+CDX03, TAD TEMP6
+       TAD (-"<
+       SZA CLA
+       JMP I (SYNTAX   /ERROR
+       JMS I (CDOUTX   /SET OUTPUT STUFF
+NOBAKA,        TAD (MINPUT-1
+       DCA INDEX6
+       TAD XDSK
+       DCA CDDEVF      /SET DEFAULT
+       TAD XDSK+1
+       DCA CDDEVF+1
+       TAD IXR
+       DCA CDI04       /SAVE POINTER
+       JMS I (GCH
+       SNA CLA
+       JMP I CD        /NO INPUT FILES
+       TAD CDI04
+       DCA IXR         /RESET POINTER
+CDI01, JMS I (GNAME    /GET A FILE
+       ISZ DEVSW
+       JMP CDI02       /DEVICE SPECIFIED
+       TAD CDDEVF
+       DCA CDDEV
+       TAD CDDEVF+1
+       DCA CDDEV+1     /SET DEFAULT DEVICE
+CDI02, TAD CDDEV
+       DCA CDDEVF
+       TAD CDDEV+1
+       DCA CDDEVF+1    /SET NEW DEFAULT
+       ISZ CDCNT       /COUNT INPUT FILES
+       TAD CDCNT
+       TAD (-12
+       SMA CLA
+       JMP I (SYNTAX   /TOO MANY FILES
+       JMS I (CDINX    /SET INPUT STUFF
+       TAD TEMP6
+       SNA
+       JMP I CD        /MAIN EXIT
+       TAD (-",
+       SNA CLA
+       JMP CDI01
+       JMP I (SYNTAX   /ERROR
+
+NOBAKB,        TAD [LINBUF-1
+       DCA IXR
+       JMP NOBAKA
+       PAGE
+\fCDOUTX,       0               /SET OUTPUT STUFF
+       ISZ DEVSW
+       JMP CDOUT9      /DEVICE SPECIFIED
+       TAD CDNAME
+       SNA CLA
+       JMP I CDOUTX    /NO NAME AND NO DEVICE IS NOTHING
+       TAD CDDEVF
+       DCA CDDEV
+       TAD CDDEVF+1
+       DCA CDDEV+1     /SET DEFAULT DEVICE
+CDOUT9,        TAD (OUDEVH+1
+       DCA CDOUT2      /SET OUTPUT HANDLER ADDRESS
+       TAD [MOUTPU-1
+       DCA INDEX6
+       TAD CDDEV
+       DCA CDOUT1
+       TAD CDDEV+1
+       DCA CDOUT1+1    /SET DEVICE
+       CIF 10
+       JMS I [200
+       12              /FIND HANDLER
+CDOUT1,        0
+       0
+CDOUT2,        0
+       JMP I (NOOFIL
+       TAD CDOUT1+1
+       JMS I   (GTDVTP /GET DEVICE TYPE AND COMPARE WITH TC08 AND TD8E
+       SZA CLA
+       JMP CDOUT3      /NOT DECTAPE
+       TAD (OUDEVH+1
+       DCA CDOUT5
+       TAD CDOUT1+1
+       CIF 10
+       JMS I [200
+       1               /GET HANDLER
+CDOUT5,        0
+       JMP I (NOOFIL
+       TAD CDOUT5
+       JMS     SETUNT  /SET UP PHYSICAL UNIT FROM HANDLER ENTRY POINT
+       JMS I (ROCK     /CHECK THE TAPE
+       JMP CDOUT3      /NOT PDP-10 DECTAPE
+       JMS I (EXA40    /EXCESS 40 CONVERSION
+       TAD UNIT10
+       JMP CDOUT4      /SET PARAMETERS
+
+CDOUT3,        DCA CDEXT+1
+       TAD CDEXT+2     /GET LENGTH
+       TAD (-400
+       SPA CLA
+       TAD CDEXT+2     /O.K. - USE LENGTH
+       CLL RTL
+       RTL
+       AND [7760       /8 BIT LENGTH
+       TAD CDOUT1+1    /ADD IN DEVICE NUMBER
+CDOUT4,        CDF 10
+       DCA I INDEX6    /SET DEVICE
+       TAD CDNAME
+       DCA I INDEX6    /SET NAME
+       TAD CDNAME+1
+       DCA I INDEX6
+       TAD CDNAME+2
+       DCA I INDEX6
+       TAD CDEXT
+       DCA I INDEX6
+       TAD CDEXT+1
+       DCA I INDEX6
+       CDF
+       JMP I CDOUTX    /EXIT
+
+SETUNT,        0
+       STL
+       TAD     (-7607
+       SZA             /IF IT IS 7607,
+       TAD     (7      /ITS UNIT 0
+       AND     (7
+       CLL CML RTR
+       RTR
+       DCA     UNIT10
+       TAD     DVTYPE
+       AND     (10
+       SNA CLA
+       JMP I   SETUNT  /TC08 - FINISHED
+       CLL
+       TAD     UNIT10
+       AND     (7000   /TD8E ENTRY POINTS ARE STRANGE -
+       TAD     UNIT10  /MUST ROTATE UNIT NUMBER LEFT 1
+       SZL
+       TAD     (1000
+       DCA     UNIT10
+       JMS I   (TDUSET /SET UP TD8E OPCODES
+       JMP I   SETUNT
+       PAGE
+\fCDINX,        0               /SET INPUT STUFF
+       TAD (OUDEVH+1
+       DCA CDIN1
+       TAD CDDEV
+       DCA CDIN2       /SET DEVICE
+       TAD CDDEV+1
+       DCA CDIN2+1
+       CIF 10
+       JMS I [200
+       1               /GET HANDLER
+CDIN2, 0
+       0
+CDIN1, 0
+       JMP I (NOOFIL
+       TAD CDIN2+1
+       JMS     GTDVTP  /COMPARE DCB ENTRY WITH TC08 OR TD8E
+       SZA CLA
+       JMP CDIN3       /NOT DECTAPE
+       TAD CDIN1
+       JMS I   (SETUNT /SET UP UNIT NUMBER
+       JMS I (ROCK     /CHECK THE TAPE
+       JMP CDIN3       /NOT PDP-10 DECTAPE
+       JMS I (EXA40    /DO EXCESS 40
+       TAD INSEG
+       CIA
+       TAD UNIT10      /IS DIRECTORY IN CORE?
+       SNA CLA
+       JMP CDIN8       /YES - NO READ
+       TAD CDNAME
+       SNA CLA
+       JMP CDIN7       /NO NAME - NO READ
+       JMS I (READT
+       DIRECT          /READ DIRECTORY
+       144
+       TAD UNIT10
+       DCA INSEG       /SET DIRECTORY IN CORE
+CDIN8, TAD (-5
+       DCA CNTR
+       TAD (CDNAME-1
+       DCA INDEX0
+       TAD (CDINXX-1
+       DCA INDEX1
+       TAD I INDEX0
+       CDF 10
+       DCA I INDEX1
+       CDF
+       ISZ CNTR
+       JMP .-5
+       TAD (CDINXX-1
+       JMS I (IOPN10   /OPEN THE PDP-10 FILE
+       JMP I (FNOTFD
+CDIN7, DCA CDIN4
+       TAD UNIT10
+       JMP CDIN6
+
+CDIN3, TAD (CDNAME
+       DCA CDIN4
+       TAD CDNAME
+       SNA CLA
+       JMP CDIN9       /NO LOOKUP IF NO NAME
+       TAD CDIN2+1
+       CIF 10
+       JMS I [200
+       2
+CDIN4, CDNAME          /LOOKUP
+CDIN5, 0
+       JMP I (FNOTFD
+       TAD CDIN5
+       TAD (400
+       SPA
+       CLA
+       CLL RTL
+       RTL
+       AND [7760       /GET LENGTH
+       TAD CDIN2+1     /ADD DEVICE
+CDIN6, CDF 10
+       DCA I INDEX6
+       TAD CDIN4
+       DCA I INDEX6    /SET BLOCK STARTING
+       CDF
+       JMP I CDINX
+
+CDIN9, DCA CDIN4
+       JMP CDIN6-1
+
+GTDVTP,        0
+       TAD (DCB-1
+       DCA TEMP1
+       CDF 10
+       TAD I TEMP1     /GET DCB ENTRY
+       CDF
+       DCA     DVTYPE
+       TAD     DVTYPE
+       AND     (770
+       TAD     (-210
+       SZA
+       TAD     (30
+       JMP I   GTDVTP
+       PAGE
+\fROCK, 0
+       JMS     GET10D  /GET ENTRY IN TAPE TYPE TABLE
+       SNA
+       JMP ROCK4       /UNKNOWN - ROCK IT
+       SMA CLA
+       ISZ ROCK
+       JMP I ROCK      /EXIT
+
+GET10D,        0
+       TAD UNIT10
+       CLL RTL
+       RTL
+       TAD (PDP10D
+       DCA TEMP5       /POINT TO KNOWN TABLE
+       TAD I TEMP5
+       JMP I   GET10D
+
+ROCK4, CLA CMA
+       DCA I TEMP5
+       TAD     DVTYPE
+       AND     (10
+       SZA CLA         /WHAT KIND OF TAPE?
+       JMP     TDCHK   /TD8E
+       TAD (OBUF10-1
+       DCA I (7755
+       TAD (10
+       DTLB
+ROCK1, RTL
+       RAL
+       SZL CLA
+       TAD (-400
+       TAD UNIT10
+       TAD (210
+       DTCA DTXA
+ROCK2, JMS     DTWAIT
+
+ROCK3, SPA
+       JMP ROCK1
+       CLA
+       TAD (OBUF10-1
+       DCA I (7755
+       TAD (-600
+       DCA I (7754
+       TAD (30
+       DTXA
+       DTSF DTRB
+       JMP .-1
+       SPA CLA
+       JMP ROCK4       /RETRY
+       TAD [200
+       DTXA            /STOP DRIVE
+       TAD I (7754
+       SZA CLA
+       JMP I ROCK      /OS8 UNIT
+       CLA IAC
+SET10, DCA I TEMP5
+       ISZ ROCK
+       JMP I ROCK      /PDP-10 UNIT
+
+DTWAIT,        0               /WAIT FOR DECTAPE FLAG
+       DTSF DTRB
+       SKP CLA
+       JMP I   DTWAIT
+       KSF
+       JMP DTWAIT+1
+       TAD [200
+       KRS
+       TAD (-203
+       SZA CLA
+       JMP DTWAIT+1
+       TAD     [200
+       DTXA    /STOP THE TAPE
+       JMP I [7600
+
+TDCHK, CLA STL RTR
+       TAD     TDUNIT
+IOTX1, SDLC
+       CLA
+IOTX2, SDRC
+       AND     (100    /CHECK FOR TAPE NOT READY
+       SZA CLA
+       JMP     TDCHK   /WAIT FOR TAPE TO COME UP
+       TAD     TDUNIT
+       TAD     (1000
+IOTX3, SDLC
+       JMS     SKIP4
+       JMS     SKIP4
+IOTX4, SDSS
+       JMP     .-1
+IOTX5, SDRC
+       AND     [77
+       TAD     (-26
+       SZA CLA         /WAIT FOR GUARD
+       JMP     IOTX4
+       DCA     TDT
+TDCLP, JMS     SKIP4
+       ISZ     TDT
+       AND     [77
+       TAD     (-51    /SEARCH FOR SOME CRAP NEAR END OF RECORD
+       SZA CLA
+       JMP     TDCLP
+       TAD I   (UNIT
+IOTX6, SDLC            /STOP TAPE
+       CLA
+       TAD     TDT
+       TAD     (-611   /9 WORDS FOR GOOD LUCK
+       SZA CLA
+       JMP I   ROCK
+       STL RTL         /SET TABLE ENTRY TO 2 FOR TD8E TAPE
+       JMP     SET10
+
+SKIP4, 0
+IOTX7, SDSQ
+       JMP     .-1
+IOTX8, SDRC
+       JMP I   SKIP4
+TDT,   0
+       PAGE
+       FIELD 0         /DUMP PG 0 LITERALS HERE
+\f/TD8E DECTAPE ROUTINE
+/VERSION 01
+
+/JULY 2 1971           GB/RL/EF
+
+/COPYRIGHT 1971                DIGITAL EQUIPMENT CORP.
+/                      MAYNARD, MASS.
+
+/ABSTRACT--
+/      THE ROUTINE DESCRIBED AND LISTED HERE IS A GENERAL
+/DATA HANDLER FOR THE TD8E DECTAPE SYSTEM. THE ROUTINE
+/CONTAINS SEARCH, READ, AND WRITE FUNCTIONS IN A FORMAT
+/WHICH IS COMPATIBLE WITH PS/8 DEVICE HANDLER CALLING
+/SEQUENCES.
+\f
+/THIS ROUTINE CAN BE RE-EDITED AND ASSEMBLED TO PRODUCE
+/VARIATIONS ON THE BASIC TD8E SYSTEM. ASSEMBLY PARAMETERS
+/CONTROL:
+/A) WHAT DRIVES (UNITS 0-7) WILL BE USED
+/B) THE ORIGIN OF THE TWO PAGE ROUTINE
+/C) WHAT MEMORY FIELD THE ROUTINE WILL RUN IN
+/D) THE SIZE OF THE DECTAPE BLOCK TO BE READ/WRITTEN
+
+/FOLLOWING ARE THE PARAMETERS SET UP FOR THE STANDARD
+/DEC VERSION OF THIS ROUTINE:
+
+       DRIVE=10        /UNITS 0 AND 1 SELECTED
+       ORIGIN=6200     /ENTRIES AT 6200 AND 6204
+       AFIELD=0        /INITIAL FIELD SETTING
+       MFIELD=00       /AFIELD*10=MFIELD
+       WDSBLK=600      /384 WORDS PER BLOCK
+
+/THE USE OF THE PARAMETERS IS AS FOLLOWS:
+
+/ DRIVE: DRIVE DETERMINES WHICH UNITS WILL BE SELECTED
+/      DRIVE=10 IMPLIES UNITS 0 &1
+/      DRIVE=20 IMPLIES UNITS 2&3
+/      DRIVE=30 IMPLIES UNITS 4&5
+/      DRIVE=40 IMPLIES UNITS 6&7
+
+/ORIGIN: ALTERING ORIGIN CAUSES ASSEMBLY IN A DIFFERENT
+/      MEMORY LOCATION. WHEN CHANGING ORIGIN KEEP IN MIND
+/THAT THIS IS A TWO PAGE ROUTINE.
+
+/AFIELD: AFIELD DETERMINES THE INITIAL FIELD SETTING FOR THE
+/      LOADER. PERMISSIBLE VALUES FOR AFIELD ARE 0 TO 7.
+
+/MFIELD: MFIELD IS USED IN A CIF CDF MFIELD INSTRUCTION.
+/      THE VALUE INSERTED FOR MFIELD SHOULD BE 10(8) TIMES
+/      THE VALUE FOR AFIELD. THE PERMISSIBLE VALUES ARE 00-70.
+
+/WDSBLK: WDSBLK GOVERNS HOW MANY WORDS THE ROUTINE THINKS ARE 
+/      IN A DECTAPE BLOCK. THE STANDARD VALUE IS 201(8) OR
+/      128 DECIMAL. NOTE THAT THE FUNCTION WORD BIT 10 CAN
+/      BE USED TO SUBTRACT ONE FROM WDSBLK. THE VALUE USED
+/      FOR WDSBLK SHOULD BE THE NUMBER OF WORDS THE TAPE WAS
+/      FORMATTED TO CONTAIN.
+
+/IF WE WANT A HANDLER FOR UNITS 2&3 TO RESIDE IN
+/FIELD 2 AT LOCATION 3000 AND READ/WRITE 256(10) WORDS
+/PER BLOCK, THE PARAMETERS WOULD BE:
+/      DRIVE=20
+/      ORIGIN=3000
+/      AFIELD=2
+/      MFIELD=20
+/      WDSBLK=400
+\f
+/THE CALL TO THE SUBROUTINE FOLLOWS BASICALLY THE
+/CALLING SEQUENCE FOR PS/8 DEVICE HANDLERS.
+/THE CALLING SEQUENCE IS:
+
+/      CDF CURRENT
+/      CIF MFIELD      /MFIELD=FIELD ASSEMBLED IN
+/      JMS ENTRY       /ENTRY=ORIGIN (EVEN NUMBERED DRIVE
+                       /AND ORIGIN+4 FOR ODD NUMBERED DRIVE.
+/      ARG1
+/      ARG2
+/      ARG3
+/      ERROR RETURN
+/      NORMAL RETURN
+
+/THE ARGUMENTS ARE:
+
+/ARG1: FUNCTION WORD   BIT0: 0=READ, 1=WRITE
+/                      BITS 1-5: # BLOCKS IN OPERATION
+/                      BITS 6-8: FIELD OF BUFFER AREA
+/                      BIT 9: UNUSED
+/                      BIT 10: # OF WORDS/BLOCK.
+/                      0= WDSBLK, 1=WDSBLK-1
+/                      BIT 11: 1=START FORWARD, 0=REVERSE
+
+/ARG2: BUFFER ADDRESS FOR OPERATION
+/ARG3: STARTING BLOCK FOR OPERATION
+
+/ERRORS: THE HANDLER DETECTS TWO TYPES OF ERRORS:
+/A) FATAL ERRORS- PARITY ERROR, TIMING ERROR,
+/              TOO GREAT A BLOCK NUMBER
+/      FATAL ERRORS TAKE ERROR RETURN WITH THE
+/      AC=4000.
+/B) NON-FATAL- SELECT ERROR.
+/      IF NO PROPER UNIT IS SELECTED, THE ERROR
+/      RETURN IS TAKEN WITH CLEAR AC.
+/FATAL ERRORS TRY THREE TIMES BEFORE TAKING ERROR RETURN.
+/THE NORMAL RETURN IS TAKEN AFTER ALL INDICATED
+/BLOCKS HAVE BEEN TRANSFERRED. THE AC IS CLEAR.
+\f
+/THE TD8E IOT'S ARE:
+       SDSS=7001-DRIVE /SKIP ON SINGLE LINE FLAG
+       SDST=7002-DRIVE /SKIP ON TIMING ERROR
+       SDSQ=7003-DRIVE /SKIP ON QUAD LINE FLAG
+       SDLC=7004-DRIVE /LOAD COMMAND REGISTER
+       SDLD=7005-DRIVE /LOAD DATA REGISTER
+       SDRC=7006-DRIVE /READ COMMAND REGISTER
+       SDRD=7007-DRIVE /READ DATA REGISTER
+
+/THE IOT'S IN GENERAL ARE 677X,676X,675X,AND 674X.
+/THE OTHERS CONTROL UNITS 2-7.
+
+       BLOCK=DTA1
+
+       FIELD AFIELD
+       *ORIGIN
+DTA0,  0               /ENTRY POINT FROM UNIT 0
+       CLA CLL         /0 TO LINK
+       JMP DTA1X
+C1000, 1000
+DTA1,  0               /UNIT 2 ENTRY
+       CLA CLL CML     /1 TO LINK
+       TAD DTA1
+       DCA DTA0        /PICK UP ARGS AT DTA0
+DTA1X, RAR
+       DCA UNIT        /LINK TO UNIT POSITION
+       RDF
+       TAD C6203       /GET DATA FIELD AND SETUP RETURN
+       DCA LEAVE
+       TAD I DTA0      /GET FUNCTION WORD
+DIO01, SDLD            /PUT FUNCTION INTO DATA REGISTER
+       CLL RTR         /AC STILL HAS FUNCTION. PUT # WORDS PER
+                       /BLOCK INTO LINK
+       SZL CLA         /KNOCK ONE OFF WDSBLK?
+       IAC             /YES
+       TAD MWORDS
+       DCA WCOUNT      /STORE MASTER WORD COUNT
+       ISZ DTA0        /TO BUFFER
+       TAD I DTA0
+       DCA BUFF
+       ISZ DTA0        /TO BLOCK NUMBER
+       TAD I DTA0
+       DCA BLOCK
+       ISZ DTA0        /POINT TO ERROR EXIT
+       CIF CDF MFIELD  /TO ROUTINES DATA FIELD
+DIO02, SDRD            /GET FUNCTION INTO AC
+       CLL RAL
+       AND CM200       /GET # PAGES TO XFER
+       DCA PGCT
+DIO03, SDRD
+C374,  AND C70         /GET FIELD FOR XFER
+       TAD C6203       /FORM CDF N
+       DCA XFIELD      /IF=0 AND DF=N AT XFER.
+       CLA CLL CMA RTL
+       DCA TRYCNT      /3 ERROR TRIES
+       TAD UNIT        /TEST FOR SELECT ERROR
+DIO04, SDLC
+DIO05, SDRC
+       AND C100
+       SZA CLA
+       JMP FATAL-1
+\f
+DIO06, SDRD            /PUT FUNCT INTO XFUNCT IN SECOND PG.
+       DCA I CXFUN
+       TAD WCOUNT
+       DCA I CXWCT
+DIO07, SDRD            /GET MOTION BIT TO LINK
+       CLL RAR
+       JMP GO          /AND START THE MOTION.
+DIO08,
+RWCOM, SDST            /ANY CHECKSUM ERRORS?
+       SZA CLA         /OR CHECKSUM ERRORS?
+       JMP TRY3        /PLEASE NOTE THAT THE LINK IS ALWAYS
+                       /SET AT RWCOM. GETCHK SETS IT.
+       TAD PGCT        /NO ERROR..FINISHED XFER?
+       TAD CM200
+       SNA
+       JMP EXIT        /ALL DONE. GET OUT
+       DCA PGCT        /NEW PAGE COUNT
+       ISZ BLOCK       /NEXT BLOCK TO XFER
+       TAD WCOUNT      /FORM NEXT BUFFER ADDRESS
+       CIA
+       TAD BUFF
+       DCA BUFF
+       CLL CML         /FORCES MOTION FORWARD
+GO,    CLA CML RTR     /LINK BECOMES MOTION BIT
+       TAD C1000
+       TAD UNIT        /PUT IN 'GO' AND UNIT #
+DIO09, SDLC            /LOOK FOR BLOCK NO.
+
+       JMS I CRDQUD    /WAIT AT LEAST 6 LINES TO LOOK
+       JMS I CRDQUD
+CM200, 7600            /COULD HAVE SAVED A LOC. HERE
+DIO10,
+SRCH,  SDSS
+       JMP .-1         /WAIT FOR SINGLE LINE FLAG
+DIO11, SDRC
+       CLL RTL         /DIRECTION TO LINK. INFO BITS 
+                       /ARE SHIFTED.
+       AND C374        /ISOLATE MARK TRACK BITS
+       TAD M110        /IS IT END ZONE?
+       SNA             /THE LINK STAYS SAME THRU THIS
+       JMP ENDZ
+       TAD M20         /CHECK FOR BLOCK MARK
+       SZA CLA
+       JMP SRCH
+DIO12, SDRD            /GET THE BLOCK NUMBER
+       SZL             /IF WE ARE IN REVERSE, LOOK FOR 3
+                       /BLOCKS BEFORE TARGET BLOCK. THIS
+                       /ALLOWS TURNAROUND AND UP TO SPEED.
+       TAD C3          /REVERSE
+       CMA
+       TAD BLOCK
+       CMA             /IS IT RIGHT BLOCK?
+       SNA
+       JMP FOUND       /YES..HOORAY!
+M110,  SZL SNA CLA     /NO, BUT ARE WE HEADED FOR IT?
+                       /ABOVE SNA IS SUPERFLUOUS.
+       JMP SRCH        /YES
+DIO13,
+ENDZ,  SDRC            /WE ARE IN THE END ZONE
+       CLL RTL         /DIRECTION TO LINK
+/V3C   SZL CLA         /ARE WE IN REVERSE?
+       JMP GO          /YES..TURN US AROUND
+/IF WE ARE IN THE END ZONE GOING FORWARD, IT IS AN ERROR
+TRY3,  CLA CLL         /V3C
+       ISZ TRYCNT
+       JMP GO          /TRY 3 TIMES
+       JMP FATAL               /LINK OFF MEANS AC=4000 ON RETURN
+EXIT,  ISZ DTA0
+       CLL CML         /AC=0 ON NORMAL RETURN
+FATAL, TAD UNIT
+DIO14, SDLC            /STOP THE UNIT
+       CLA CML RAR
+LEAVE, HLT
+       JMP I DTA0
+
+\f
+C6203, 6203
+CRDQUD,        RDQUAD
+WCOUNT,        0
+BUFF,  0
+MWORDS,        -WDSBLK
+UNIT,  0
+CXFUN, XFUNCT
+M20,   -20
+PGCT,  0
+CXWCT, XWCT
+C100,  100
+TRYCNT,        -3
+
+
+       *ORIGIN+170
+FOUND, SZL CLA         /RIGHT BLOCK. HOW ABOUT DIRECTION?
+       JMP GO          /WRONG..TURN AROUND
+       TAD UNIT        /PUT UNIT INTO LINK
+       CLL RAL         /AC IS NOW 0
+C70,   70              /********DON'T MOVE THIS!!!!******
+C3,    3
+       TAD BUFF        /GET BUFFER ADDRESS
+XFIELD,        HLT             /INTO NEXT PAGE
+
+       *ORIGIN+200
+
+       CIF MFIELD
+       DCA XBUFF       /SAVE ADDRESS
+       RAR             /NOW GET UNIT #
+       DCA XUNIT
+       SDRC            /V3C
+       SDLC            /V3C
+       TAD XWCT
+       DCA DWORDS      /WORD COUNTER
+DIO15,
+REVGRD,        SDSS
+       JMP .-1         /LOOK FOR REVERSE GUARD
+DIO16, SDRC
+       AND K77
+       TAD CM32        /IS IT REVERSE GUARD?
+       SZA CLA
+       JMP REVGRD      /NO.KEEP LOOKING
+       TAD XFUNCT      /GET FUNCTION  READ OR WRITE
+K7700, SMA CLA
+       JMP READ        /NEG. IS WRITE
+DIO17,
+WRITE, SDRC
+       AND C300        /CHECK FOR WRITE LOCK AND SELECT ERROR
+       CLL CML         /LOCK OUT AND SELECT ARE AC 0 ERRORS
+       SZA CLA
+       JMP I CFATAL    /FATAL ERROR. LINK MUST BE ON
+/      JMS RDQUAD      /NO ONE EVER USES THIS WORD!
+/      CLA
+       STA             /V3C HACK FOR PDP-6
+       JMS WRQUAD      /V3C 7777 FOR REV CHECKSUM AND SKIP OVER LOCK
+       TAD C1400
+       TAD XUNIT       /INITIATE WRITE MODE
+DIO18, SDLC
+       CLA CMA
+       JMS WRQUAD      /PUT 77 IN REVERSE CHECKSUM
+       CLA CMA
+       DCA CHKSUM
+WRLP,  TAD I XBUFF     /GLORY BE! THE ACTUAL WRITE!
+       JMS WRQUAD
+       ISZ XBUFF       /BUMP CORE POINTER
+K77,   77              /ABOVE MAY SKIP
+       ISZ DWORDS      /DONE THIS BLOCK?
+       JMP WRLP        /NOT YET..LOOP A WHILE
+       TAD XFUNCT      /IS THE OPERATION FOR WDSBLK PER BLOCK?
+       CLL RTR         /IF NO, WRITE A 0 WORD
+       SZL CLA
+
+       JMS WRQUAD      /WRITE A WORD OF 0
+       JMS GETCHK      /DO THE CHECK SUM
+       JMS WRQUAD      /WRITE FORWARD CHECKSUM
+       JMS WRQUAD      /ALLOW CHECKSUM TO BE WRITTEN
+       JMS WRQUAD      /V3C WRITE REST OF CHECKSUM [PDP-6]
+       JMP I CRWCOM
+
+
+READ,  JMS RDQUAD
+       JMS RDQUAD
+       JMS RDQUAD      /SKIP CONTROL WORDS
+       AND K77
+       TAD K7700       /TACK 7700 ONTO CHECKSUM.
+       DCA CHKSUM      /CHECKSUM ONLY LOW 6 BITS ANYWAY
+RDLP,  JMS RDQUAD
+       JMS EQUFUN      /COMPUT CHECKSUM AS WE GO
+       DCA I XBUFF     /IT GETS CONDENSED LATER
+       ISZ XBUFF
+C300,  300             /PROTECTION
+       ISZ DWORDS      /DONE THIS OP?
+       JMP RDLP        /NO SUCH LUCK
+       TAD XFUNCT      /IF OP WAS FOR WDSBLK-1, READ AND
+       CLL RTR         /CHECKSUM THE LAST TAPE WORD
+       SNL CLA
+       JMP RDLP2
+       JMS RDQUAD      /NOT NEEDED FOR WDSBLK/BLOCK
+       JMS EQUFUN      /CHECKSUM IT
+RDLP2, JMS RDQUAD      /READ CHECKSUM
+       AND K7700
+       JMS EQUFUN
+       JMS GETCHK      /GET SIX BIT CHECKSUM
+       JMP I CRWCOM
+
+WRQUAD,        0               /WRITE OUT A 12 BIT WORD
+       JMS EQUFUN      /ADD THIS TO CHECKSUM
+DIO19, SDSQ            /SKIP ON QUADLINE FLAG
+       JMP .-1
+DIO20, SDLD            /LOAD DATA  ONTO BUS
+       CLA             /SDLD DOESN'T CLEAR AC
+       JMP I WRQUAD
+
+RDQUAD,        0               /READ A 12 BIT WORD
+DIO21, SDSQ
+       JMP .-1
+DIO22, SDRD            /READ DATA
+       JMP I RDQUAD
+
+\f
+EQUFUN,        0               /COMPUTE EQUIVALENCE CHECKSUM
+       CMA
+       DCA EQUTMP      /ACTUALLY CHECKSUMS ON DECTAPE ARE
+       TAD EQUTMP      /EQUIVALENCE OF ALL WORDS IN A RECORD
+       AND CHKSUM      /SIX BITS AT A TIME. BUT SINCE EQUIVALENCE
+       CIA             /IS ASSOCIATIVE, WE CAN DO IT 12
+       CLL RAL         /BITS AT A TIME AND CONDENSE LATER.
+       TAD EQUTMP      /THIS ROUTINE USES THESE IDENTITIES:
+       TAD CHKSUM      /A+B=(A.XOR.B)+2*(A.AND.B)
+       DCA CHKSUM      /A.EQU.B=.NOT.(A.XOR.B)=A.XOR.(.NOT.B)
+       TAD EQUTMP      /A.EQU.B=(A+(.NOT.B))-2*(A.AND.(.NOT.B))
+       CMA
+       JMP I EQUFUN
+
+GETCHK,        0               /FORM 6 BIT CHECKSUM
+       CLA
+       TAD CHKSUM      
+       CMA
+       CLL RTL
+       RTL
+       RTL
+       JMS EQUFUN
+       CLA CLL CML     /FORCES LINK ON AT RWCOM
+       TAD CHKSUM
+       AND K7700
+       JMP I GETCHK
+
+CFATAL,        FATAL
+CRWCOM,        RWCOM
+XFUNCT,        0
+CM32,  -32
+C1400, 1400
+CHKSUM,        0
+DWORDS,        0
+XBUFF, 0
+XWCT,  0
+EQUTMP,        0
+XUNIT, 0
+       PAGE
+\fFIELD 1
+
+*2000
+
+ZFREE, ZBLOCK 5
+
+INCTR, 0
+INHNDL,        0
+INPTR, 0
+
+DELPS1,        0
+       JMS I (200
+       4
+       MOUTPU+1
+       0
+       ISZ DELPS1
+       CIF CDF 0
+       JMP I DELPS1
+
+ICHARP,        0
+       ISZ INJMP
+       ISZ INCHCT
+INJMPP,        JMP INJMP
+       TAD INEOF
+       SZA CLA
+       JMP INEXIT
+INGBUF,        TAD INCTR
+       CLL
+       TAD (INRECS
+       SNL
+       DCA INCTR
+       SZL
+       ISZ INEOF
+       CLL CML CMA RTR
+       RTR
+       RTR
+       TAD (INCTL+1
+       DCA INCTLW
+       CIF 0
+       JMS I INHNDL
+INCTLW,        0
+INBUFP,        INBUF
+INREC, 0
+       JMP INERRX
+INBREC,        TAD INREC
+       TAD (INRECS
+       DCA INREC
+       TAD INCTLW
+       AND (7600
+       CLL RAL
+       TAD INCTLW
+       AND (7600
+       CMA
+       DCA INCHCT
+       TAD INJMPP
+       DCA INJMP
+       TAD INBUFP
+       DCA INPTR
+       JMP ICHARP+1
+
+INERRX,        ISZ INEOF
+       SMA CLA
+       JMP INBREC
+INERR, CLL CLA CML RAR
+       JMP INEXIT
+
+INJMP, HLT
+       JMP INCHR1
+       JMP INCHR2
+INCHR3,        TAD INJMPP
+       DCA INJMP
+       TAD I INPTR
+       AND (7400
+       CLL RTR
+       RTR
+       TAD INCTLW
+       RTR
+       RTR
+       ISZ INPTR
+       JMP INCOMN
+
+INCHR2,        CDF 0
+       TAD I (MODE
+       CDF 10
+       SMA SZA CLA
+       JMP IC8A1
+       TAD I INPTR
+       AND (7400
+       DCA INCTLW
+       ISZ INPTR
+IC8A2, TAD I INPTR
+INCOMN,        AND (377
+       TAD (-232
+       SNA
+       JMP INEXIT
+       TAD (232
+       ISZ ICHARP
+INEXIT,        CIF CDF 0
+       JMP I ICHARP
+
+INEOF, 1
+INCHCT,        -1
+
+INCHR1,        CDF 0
+       TAD I (MODE
+       CDF 10
+       SPA SNA CLA
+       JMP IC8A2
+IC8A3, TAD I INPTR
+       ISZ INPTR
+       JMP INEXIT-1
+
+IC8A1, TAD INJMPP
+       DCA INJMP
+       ISZ INCHCT
+       JMP IC8A3
+       PAGE
+\fOOPNPS,       0
+       TAD (MOUTPU+1
+       DCA OUBLK
+       TAD I (MOUTPU
+       JMS I (200
+       3
+OUBLK, 0
+OUELEN,        0
+       JMP OUEFAL
+       DCA OUCCNT
+       JMS I (OUSETP
+       ISZ OOPNPS
+OUEEXT,        CIF CDF 0
+       JMP I OOPNPS
+
+OUEFAL,        TAD I (MOUTPU
+       AND (7760
+       SNA CLA
+       JMP OUEEXT
+       TAD I (MOUTPU
+       AND (17
+       DCA I (MOUTPU
+       JMP OOPNPS+1
+
+OUHNDL,        0
+
+OUTDMP,        0
+       DCA OUCTLW
+       TAD OUCCNT
+       SNA
+       ISZ OUCTLW
+       TAD OUBLK
+       DCA OUREC
+       TAD OUCTLW
+       CLL RTL
+       RTL
+       RTL
+       AND (17
+       TAD OUCCNT
+       DCA OUCCNT
+       TAD OUCCNT
+       CLL CML
+       TAD OUELEN
+       SNL SZA CLA
+       JMP I OUTDMP
+       CIF 0
+       JMS I OUHNDL
+OUCTLW,        0
+       OUBUF
+OUREC, 0
+       JMP I OUTDMP
+       ISZ OUTDMP
+       JMP I OUTDMP
+
+OCLOSE,        0
+       CDF 0
+       TAD I (MODE
+       CDF 10
+       SMA SZA CLA
+       JMP OULLLP+2
+       JMS I (OTYPE
+       AND (770
+       TAD (-PTP
+       SZA CLA
+       TAD (232
+       JMS I (OCHARP
+       JMP OURET
+       JMS I (OCHARP
+       JMP OURET
+OULLLP,        JMS I (OCHARP
+       JMP OURET
+       JMS I (OTYPE
+       SPA CLA
+       TAD (100
+       TAD (77
+       AND I (OUDWCT
+       SZA CLA
+       JMP OULLLP
+       TAD I (OUDWCT
+       TAD (OUCTL&3700
+       SNA
+       JMP OUDUMP
+       TAD (4010
+       JMS OUTDMP
+       JMP OURET
+OUDUMP,        TAD I (MOUTPU
+       JMS I (200
+       4
+       MOUTPU+1
+OUCCNT,        0
+       SKP
+       ISZ OCLOSE
+OURET, CIF CDF 0
+       JMP I OCLOSE
+       PAGE
+\fOUTEMP,       0
+
+OUJMP, HLT
+       JMP OCHR1
+       JMP OCHR2
+OCHR3, TAD OUTEMP
+       CLL RTL
+       RTL
+       AND (7400
+       TAD I OUPOLD
+       DCA I OUPOLD
+       TAD OUTEMP
+       CLL RTR
+       RTR
+       RAR
+       AND (7400
+       TAD I OUPTR
+OC8A1, DCA I OUPTR
+       TAD OUJMPP
+       DCA OUJMP
+       ISZ OUPTR
+       ISZ OUDWCT
+       JMP OUCOMN
+       TAD (OUCTL
+       JMS I (OUTDMP
+       JMP OUCRET
+       JMS OUSETP
+       JMP OUCOMN
+
+OUSETP,        0
+       TAD (OUCTL&3700
+       CIA
+       DCA OUDWCT
+       TAD (OUBUF
+       DCA OUPTR
+       TAD OUJMPP
+       DCA OUJMP
+       JMP I OUSETP
+
+OCHARP,        0
+       DCA OUTEMP
+       RDF
+       TAD (CIF CDF 0
+       DCA OUCRET
+       CDF 0
+       TAD I (MODE
+       SMA SZA CLA
+       JMP .+4
+       TAD OUTEMP
+       AND (377
+       DCA OUTEMP
+       CDF 10
+       ISZ OUJMP
+OUJMPP,        JMP OUJMP
+
+OCHR2, CDF 0
+       TAD I (MODE
+       CDF 10
+       SMA SZA CLA
+       JMP OC8A2
+       TAD OUPTR
+       DCA OUPOLD
+       ISZ OUPTR
+OCHR1, TAD OUTEMP
+       DCA I OUPTR
+OUCOMN,        ISZ OCHARP
+OUCRET,        CIF CDF 0
+       JMP I OCHARP
+
+OUPOLD,        0
+OUPTR, 0
+OUDWCT,        0
+
+OTYPE, 0
+       TAD I (MOUTPU
+       AND (17
+       TAD (DCB-1
+       DCA OUSETP
+       TAD I OUSETP
+       JMP I OTYPE
+
+CDINXX,        ZBLOCK 5
+
+OC8A2, ISZ OUPTR
+       TAD OUTEMP
+       JMP OC8A1
+       PAGE
+\f$-$-$
+\f
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape7/README b/sw/os8/v3d/sources/system/dectapes/dectape7/README
new file mode 100644 (file)
index 0000000..c13bf7a
--- /dev/null
@@ -0,0 +1,14 @@
+This area contains the files contained on system release DECtape #7.
+
+Directory of OS/8 V3D DECtape 7 labeled:  AL-4697C-SA     2/15/78
+                                         OS/8 V3D SRC DT  7 OF 7
+                                         (replaces DEC-S8-OSYSB-B-UA7)
+
+
+OS8   .PA 199 01-AUG-77    PIP10 .PA 172 01-AUG-77
+EDIT  .PA 160 01-AUG-77    HELP8 .HL  55 01-AUG-77
+FOTP  .PA 108 01-AUG-77    HELP78.HL  31 01-AUG-77
+
+   6 files in  725 blocks -    5 free blocks
+
+
diff --git a/sw/plot_standalone/PLOT.FT b/sw/plot_standalone/PLOT.FT
new file mode 100644 (file)
index 0000000..6a24683
Binary files /dev/null and b/sw/plot_standalone/PLOT.FT differ
diff --git a/sw/plot_standalone/PLOT2.FT b/sw/plot_standalone/PLOT2.FT
new file mode 100644 (file)
index 0000000..a5b7470
Binary files /dev/null and b/sw/plot_standalone/PLOT2.FT differ
diff --git a/sw/plot_standalone/PLOT3.FT b/sw/plot_standalone/PLOT3.FT
new file mode 100644 (file)
index 0000000..cf5665c
Binary files /dev/null and b/sw/plot_standalone/PLOT3.FT differ
diff --git a/sw/plot_standalone/PLOT4.FT b/sw/plot_standalone/PLOT4.FT
new file mode 100644 (file)
index 0000000..630786f
Binary files /dev/null and b/sw/plot_standalone/PLOT4.FT differ
diff --git a/sw/tools/BINSTA.PA b/sw/tools/BINSTA.PA
new file mode 100644 (file)
index 0000000..3dde8b9
--- /dev/null
@@ -0,0 +1,168 @@
+/ BIN LOADER, RUNNABLE FROM OS/8
+
+       DEV=400         /DEVICE 40 FOR BOOT
+
+       AUTO1=10
+       AUTO2=11
+
+*30    
+       6743            / RK05 BOOTSTRAP - FOR CONVENIENCE
+       JMP     .
+       
+*200   
+       CLA     CLL     
+       TAD     PTR1
+       DCA     AUTO1
+       TAD     PTR2
+       DCA     AUTO2
+       TAD     CTRP
+       DCA     CTR
+LOOP,
+       TAD I   AUTO1
+       DCA I   AUTO2
+       ISZ     CTR
+       JMP     LOOP
+
+       CAF             / THAT'S NEW!
+       JMP I   LOADER
+
+                       
+LOADER, 7777           / STARTING ADDRESS
+CTRP,  -200            / LOADER SIZE
+CTR,   0               / COUNTER
+PTR1,  3777            / LOADER SOURCE ADDR -1
+PTR2,  7577            / LOADER TARGET ADDR -1
+LFIELD,        0               / LOADER TARGET FIELD
+
+*4000          /THIS WILL GO TO THE LAST PAGE! 
+       0
+       0
+       0
+       0
+       0
+       0
+       0
+       0
+       0
+       0
+       0
+       0
+       0
+       0
+       0
+       1212
+       7402
+       7402
+       7402
+       7402
+       7402
+       7402
+       0000
+       3212
+       4260
+       1300
+       7750
+       5237
+       2212
+       7040
+       5227
+       1212
+       7640
+       5230
+       1214
+       0274
+       1341
+       7510
+       2226
+       7750
+       5626
+       1214
+       0256
+       1257
+       3213
+       5230
+       0070
+       6201
+       0000
+       0000
+       6001 DEV
+       5262
+       6006 DEV
+       3214
+       1214
+       5660
+       6011
+       5270
+       6016
+       5265
+       0300
+       4343
+       7041
+       1215
+       7402
+       6002 DEV
+       6014
+       6214
+       1257
+       3213
+
+/      7604    / LOAD SR 
+       CLA CMA 
+       7700
+       1353
+       1352
+       3261
+       4226
+       5313
+       3215
+       1213
+       3336
+       1214
+       3376
+       4260
+       3355
+       4226
+       5275
+       4343
+       7420
+       5336
+       3216
+       1376
+       1355
+       1215
+       5315
+       6201
+       3616
+       2216
+       7600
+       5332
+       0000
+       1376
+       7106
+       7006
+       7006
+       1355
+       5743
+       5262
+       0006
+       0000
+       0000
+       0000
+       0000
+       0000
+       0000
+       0000
+       0000
+       0000
+       0000
+       0000
+       0000
+       0000
+       0000
+       0000
+       0000
+       0000
+       0000
+       0000
+       5301
+$
\ No newline at end of file
diff --git a/sw/tools/BLDR.PA b/sw/tools/BLDR.PA
new file mode 100644 (file)
index 0000000..d089872
--- /dev/null
@@ -0,0 +1,152 @@
+/ BIN LOADER
+
+       DEV=400         /DEVICE 40 FOR BOOT
+       DFIELD=00       /LOADER'S TARGET FIELD
+
+*0
+       JMP     100
+       *100
+       CAF
+       CLA CLL
+       CDF     0
+       TAD     I1
+       DCA I   A1
+       TAD     I2
+       DCA I   A2
+       CIF     0
+       JMP     30
+I1,    6743
+I2,    JMP     31
+A1,    30
+A2,    31
+
+       *30
+       JMP     0
+
+*200
+       JMP I   START
+START, 7600
+
+       *7600
+       
+       CDF     DFIELD
+       JMP     7777
+
+       *7617   
+       
+       1212
+       7402
+       7402
+       7402
+       7402
+       7402
+       7402
+       0000
+       3212
+       4260
+       1300
+       7750
+       5237
+       2212
+       7040
+       5227
+       1212
+       7640
+       5230
+       1214
+       0274
+       1341
+       7510
+       2226
+       7750
+       5626
+       1214
+       0256
+       1257
+       3213
+       5230
+       0070
+       6201
+       0000
+       0000
+       6001 DEV
+       5262
+       6006 DEV
+       3214
+       1214
+       5660
+       6011
+       5270
+       6016
+       5265
+       0300
+       4343
+       7041
+       1215
+       7402
+       6002 DEV
+       6014
+       6214
+       1257
+       3213
+
+/      7604    / LOAD SR 
+       CLA CMA 
+       7700
+       1353
+       1352
+       3261
+       4226
+       5313
+       3215
+       1213
+       3336
+       1214
+       3376
+       4260
+       3355
+       4226
+       5275
+       4343
+       7420
+       5336
+       3216
+       1376
+       1355
+       1215
+       5315
+       6201
+       3616
+       2216
+       7600
+       5332
+       0000
+       1376
+       7106
+       7006
+       7006
+       1355
+       5743
+       5262
+       0006
+       0000
+       0000
+       0000
+       0000
+       0000
+       0000
+       0000
+       0000
+       0000
+       0000
+       0000
+       0000
+       0000
+       0000
+       0000
+       0000
+       0000
+       0000
+       0000
+       5301
+$
diff --git a/sw/tools/KERMIT.PA b/sw/tools/KERMIT.PA
new file mode 100644 (file)
index 0000000..d71cabb
--- /dev/null
@@ -0,0 +1,6721 @@
+/ MODIFIED SILENT VERSION, HACHTI 2008
+/      KERMIT FOR DEC 12-BIT MACHINES
+
+/      LAST EDIT:      06-SEP-1990     11:00:00        CJL
+
+       XLIST   OFF
+       IFNDEF  OFF     <OFF=   1>      /TURN LISTING OFF
+       IFNDEF  ON      <ON=    0>      /TURN LISTING ON
+       XLIST   ON;     IFZERO  1       <
+
+
+
+
+
+
+
+
+***     **** *********** *********    ***      *** *** *********** *****   ****
+***    ****  *********** **********   ****    **** *** *********** *****  ******
+***   ****    ***        ***    ****  ****    **** ***     ***       *** ***  ***
+***  ****     ***        ***     ***  *****  ***** ***     ***       *** **   ****
+*** ****      ***        ***     ***  *****  ***** ***     ***       *** **    ***
+*******       ***        ***    ****  ************ ***     ***       ***       **
+******       **********  **********   *** **** *** ***     *** ***** ***      **
+*******              **********  *********    *** **** *** ***     *** ***** ***     **
+*** ****      ***        *** ****     ***  **  *** ***     ***       ***    **
+***  ****     ***        ***  ****    ***  **  *** ***     ***       ***   **
+***   ****    ***        ***   ****   ***      *** ***     ***       ***  **
+***    ****   *********** ***   ****  ***      *** ***     ***       *** *********
+***     **** *********** ***     **** ***      *** ***     ***       *** *********
+                                       >       XLIST   ON
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+/      COPYRIGHT (C) 1989, 1990 BY THE TRUSTEES OF COLUMBIA UNIVERSITY IN THE CITY OF
+/      NEW YORK.
+
+
+
+/      PERMISSION IS  GRANTED  TO  ANY  INDIVIDUAL OR INSTITUTION TO COPY OR USE THIS
+/      DOCUMENT AND THE  PROGRAM(S) DESCRIBED IN IT, EXCEPT FOR EXPLICITLY COMMERCIAL
+/      PURPOSES.
+\f/     EDIT HISTORY.                                                   /014 CJL
+
+/      052     06-SEP-1990     BUG FIX.                        CHARLES LASNER (CJL)
+
+/              SENDING A FILE WHICH  EXACTLY  FILLS  THE LAST DATA PACKET AT THE
+/              END OF THE FILE WILL  CAUSE  THE  PACKET  TO  BE SENT TWICE.  THE
+/              ROUTINE DIDN'T CHECK FOR AN EMPTY OUTPUT BUFFER AT EOF.
+
+/      051     29-AUG-1990     BUG FIX.                        CJL
+
+/              PDP-8/A NOT IDENTIFIED CORRECTLY  IN  CPUID ROUTINE.  THE UPDATED
+/              PC IS WHAT IS LOADED  INTO  THE  AC  WHEN 7016 IS EXECUTED ON THE
+/              KK-8/A CPU.  THE ROUTINE WAS  CHECKING FOR THE NON-UPDATED VALUE.
+/              ALSO  NEW  DOCUMENTATION FOR PRE-CLEARING MEMORY FOR  BENEFIT  OF
+/              ENCODED BINARY FILES.
+\f/     050     06-SEP-1989     DECMATE I SUPPORT, ETC.         CJL
+
+/              THIS EDIT IMPLEMENTS DECMATE  I  SUPPORT USING THE DP278-A OR -B.
+/              A NEW CONDITIONAL 'PORT' SELECTS  WHICH  PORT  IS TO BE USED.  IF
+/              KERMIT-12 IS RUN ON DECMATE I  (WHILE  NOT  CONFIGURED FOR SERIAL
+/              PRINTER  PORT  COMMUNICATIONS;    SEE  EDIT  048.)   THEN  REMOTE
+/              COMMUNICATIONS TAKES PLACE ON THE PORT SELECTED AT  ASSEMBLY TIME
+/              ('PORT=0' OR 'PORT=1').    ADDED  BAUD  RATE PARAMETER 'BRATE' TO
+/              SELECT REMOTE COMMUNICATIONS BAUD  RATE  FROM THE STANDARD TABLE;
+/              DEFAULTS TO 1200 BAUD ('BRATE=7').
+/      049     30-AUG-1989     REMOTE FLOW CONTROL, ETC.       CJL
+
+/              THIS  EDIT  IMPLEMENTS FLOW CONTROL SUPPORT (IF FLOW  CONTROL  IS
+/              ENABLED) FOR THE REMOTE LINE WHILE SENDING PACKETS TO  THE REMOTE
+/              KERMIT REGARDLESS  OF  STATE.    PREVIOUSLY,  FLOW  CONTROL  ONLY
+/              APPLIED TO CONNECT  MODE.  LOCAL FLOW CONTROL (TOWARDS THE REMOTE
+/              KERMIT) IS UNNECESSARY AS  LOCAL  BUFFERS  FOR  REMOTE  INPUT ARE
+/              ALWAYS AVAILABLE.  CERTAIN ROUTINE  CHANGES  MADE  FOR BENEFIT OF
+/              DECMATE I SUPPORT IN A SUBSEQUENT EDIT.
+
+/      048     24-AUG-1989     DECMATE II, ETC. SUPPORT.       CJL
+
+/              ONCE-ONLY CODE ADDED  TO  IMPLEMENT DECMATE II, ETC.  REMOTE LINE
+/              SUPPORT  ON  SERIAL  COMMUNICATIONS   PORT.    SELECTED  PORT  IS
+/              INDICATED ON OPENING BANNER IF OPERATING ON DECMATE.
+
+/      THIS EDIT PROVIDES BASIC SUPPORT  OF  THE DECMATE II COMMUNICATIONS PORT AS AN
+/      AUTOMATIC FEATURE OF THE STANDARD RELEASE  OF  K12MIT.  AUTOMATIC DETECTION OF
+/      DECMATE II, ETC.  HARDWARE IS PERFORMED  UNLESS  THE  PDP-8-TYPE  REMOTE  LINE
+/      SUPPORT IS ASSEMBLED FOR THE SERIAL PRINTER AS  THE  REMOTE  LINE ('SPRINT' IS
+/      SET OR EQUIVALENT).
+
+/      THIS  EDIT INCORPORATES ALL OF THE  INFORMATION  TAKEN  FROM  VARIOUS  SOURCES
+/      REGARDING DECMATE PORT INITIALIZATION, ETC.  EVERY  ATTEMPT  HAS  BEEN MADE TO
+/      COMPLETELY  SET ALL APPROPRIATE REGISTERS, ETC.  FOR  DECMATE  II,  III,  III+
+/      OPERATION.  NO SUPPORT EXISTS FOR THE DECMATE III  BUILT-IN  MODEM  OPTION, AS
+/      EXPLICIT  DOCUMENTATION  IS NOT AVAILABLE (SOME OF THE INITIALIZATION CODE  IS
+/      APPARENTLY USED TO DISABLE THE MODEM).  THESE ROUTINES ARE ONLY  KNOWN TO WORK
+/      ON  THE DECMATE II, AS THE III (ESPECIALLY WITH OPTIONAL MODEM) AND  THE  III+
+/      HAVEN'T BEEN  AVAILABLE  TO  THE  AUTHOR FOR TESTING.  THE INITIALIZATION CODE
+/      WILL BE UPDATED  LATER  TO  INCLUDE  PANEL  REQUESTS,  ETC.    TO  CORRECT ANY
+/      PROBLEMS, ETC.  DECMATE-SPECIFIC  FEATURES  (SUCH  AS  SETUP COMMANDS) WILL BE
+/      ADDED LATER AND ENABLED FROM THESE ROUTINES.
+
+/      THIS EDIT INCORPORATES  NON-INTERRUPT  ROUTINES  WHICH HAVE BEEN TESTED AT THE
+/      MAXIMUM COMMUNICATIONS SPEED OF  THE  DECMATE  II  (19200  BAUD).    THEY WILL
+/      SUFFICE FOR ALL KERMIT IMPROVEMENTS  SHORT  OF  SLIDING  WINDOWS AT WHICH TIME
+/      INTERRUPT-DRIVEN I/O WILL BE REQUIRED.   (INTERRUPT-DRIVEN  I/O  IS ILLEGAL ON
+/      CERTAIN OS/8 SYSTEMS WHERE INTERRUPTS ARE HARMFUL  TO THE SYSTEM OR NON-SYSTEM
+/      HANDLERS.) 
+\f/     047     21-AUG-1989     CODE CLEANUP.                   CJL
+
+/              STREAM-LINED CONNECT MODE ROUTINES FOR MINIMUM USE OF IOTS.  THIS
+/              IS  IN  PREPARATION  FOR  EVENTUAL DECMATE II OPERATION,  AND  TO
+/              MINIMIZE  K12PCH  PATCH  FILE SIZE.  CERTAIN NON-CONNECT ROUTINES
+/              MOVED TO FACILIATE CONNECT ROUTINE REORGANIZATION. 
+
+/      046     15-AUG-1989     CODE CLEANUP.                   CJL
+
+/              ADDED NEW (NON-CONNECT) MODE COMMUNICATIONS ROUTINES FOR EVENTUAL
+/              DECMATE USE.  ELIMINATION OF 'IREM' AND 'IREMW' ROUTINES IN FAVOR
+/              OF 'COMIN'.   ELIMINATION  OF 'OREM' IN FAVOR OF 'COMOUT'.  ADDED
+/              STATUS UPDATE ROUTINE ('UPSTATUS')  FOR EVENTUAL DECMATE II, ETC.
+/              USAGE.  ELIMINATED PDP-8, DECMATE  I,  DECMATE  II  CONDITIONALS.
+/              REORGANIZED  SERIAL  LINE  CONDITIONALS  AND ADDED  NEW  'SPRINT'
+/              PARAMETER FOR SERIAL PRINTER  PORT  USAGE AS COMMUNICATIONS PORT.
+/              ADDED ONCE-ONLY CODE ADDED TO  AUTOMATICALLY  RECOGNIZE DECMATE I
+/              AND II OPERATION UNLESS ASSEMBLED FOR  REMOTE  COMMUNICATIONS  ON
+/              SERIAL  PRINTER  PORT  ('SPRINT'  SET).   UPDATED  K12PCH.PAL  TO
+/              CORRESPOND   TO  NEW  DEFINITIONS.    DEFINED  EVENTUALLY  NEEDED
+/              COMMUNICATIONS PORT  INSTRUCTIONS FOR DECMATE II;  ACTUAL DECMATE
+/              II OPERATION WILL  BE  DEFINED  IN A SUBSEQUENT EDIT.  DOCUMENTED
+/              NEW LOADING AND SAVING  INSTRUCTIONS  FOR  K12MIT  TO  ALLOW  FOR
+/              ONCE-ONLY CODE IN 10000-11777 WITHOUT  SWAPPING  THE CODE OUT FOR
+/              THE USR.  THIS ELIMINATES OVERHEAD  WHEN  LOADING  K12MIT, BUT IS
+/              DIFFERENT  FROM  THE FORMER INSTRUCTIONS WHICH ASSUMED  NO  OTHER
+/              USAGE OF 10000-11777 OTHER THAN THE (LOCKED-IN) USR.
+
+/      THIS EDIT  PROVIDES THE FRAMEWORK FOR AUTOMATIC DETECTION OF PROGRAM EXECUTION
+/      OF K12MIT ON  ANY  MEMBER  OF  THE  DECMATE  FAMILY  (I, II, III, III+).  WHEN
+/      6120-TYPE CPU DETECTION OCCURS,  THE  DECMATE I OR II-TYPE COMMUNICATIONS PORT
+/      INITIALIZE CODE IS AUTOMATICALLY SELECTED  AS  NECESSARY UNLESS THE PDP-8-TYPE
+/      ROUTINES ARE ASSEMBLED (WITH 'SPRINT' SET  OR  EQUIVALENT USER SETTINGS, ETC.)
+/      FOR THE VT-78-TYPE PRINTER PORT (32/33), IN  WHICH  CASE THE COMMUNICATIONS IS
+/      DONE VIA THE PRINTER PORT ON THE DECMATE (WHICH IS ALMOST PDP-8 COMPATIBLE AND
+/      IS ACCOMODATED AS SUCH).
+
+/      SUBSEQUENT EDITS SHOULD PROVIDE FOR A DECMATE I PARAMETER TO CONTROL  THE PORT
+/      SELECTION,  AS  THERE  ARE  AT  LEAST  TWO VARIANT OPTIONS BOARDS (DP-278A AND
+/      DP-278B) EACH CONSISTING OF TWO PORTS.
+\f/     045     12-AUG-1989     BUG FIX.                        CJL
+
+/              FINISH,  GET,  AND  RECEIVE  COMMANDS   FAIL  TO  ABORT  PROPERLY
+/              (ESPECIALLY AFTER THE SEND COMMAND HAS BEEN USED), AS THE CURRENT
+/              OPERATING MODE ('KMODE') IS NEVER PROPERLY SET,  OR  IS SET AFTER
+/              SEVERAL PACKETS HAVE BEEN SENT.  EACH COMMAND  NOW  SETS  ITS OWN
+/              OPERATING MODE BEFORE INITIATING ANY PACKETS.
+
+/      044     11-AUG-1989     CODE CLEANUP.                   CJL
+
+/              CHANGED  'CCMSG'  TO  'ABMSG'  WITH  CLEARER  MESSAGE.    CHANGED
+/              'CCFLAG'  TO  'ABFLAG' FOR CONSISTENCY.  CHANGED ABORT  CHARACTER
+/              FROM <^C> TO CHOICE OF <^X> OR <^Z> FOR  CONSISTENCY.  ELIMINATED
+/              'ITTY'  AND  'ITTYW'  ROUTINES  BY  USING  'CTLCTST'  AND 'INPUT'
+/              ROUTINES ALREADY  AVAILABLE  A/O EDIT 043.  ELIMINATED 'TCHAR' IN
+/              FAVOR OF 'INCHAR' AVAILABLE A/O EDIT 043.
+
+/      043     07-AUG-1989     CODE CLEANUP, ETC.              CJL
+
+/              REWRITE OF  CONSOLE SUPPORT ROUTINES INCLUDING FORCED-ECHO OUTPUT
+/              AND COLUMN COUNT FOR <HT> SIMULATION IN PREPARATION FOR IMPENDING
+/              USER-INTERFACE  REWRITE.     'SCRIBE',  'LININP',  AND  'ESCPRNT'
+/              ROUTINES NOW CALL  "P7ECHO" ROUTINE TO ENSURE PRINTING OF CRUCIAL
+/              MESSAGES.
+
+/      042     13-JUN-1989     CODE CLEANUP.                   CJL
+
+/              FIXED VARIOUS NAK-RELATED BUGS AND SEND-INIT PROBLEMS AS IN  K278
+/              (SOME  OF  THE K278 STUFF IS DEFICIENT!).  CALCULATION OF  PROPER
+/              SEQUENCE  NUMBER  FOR NAK CORRECTED OVER FORMER (K08MIT AND K278)
+/              VERSIONS.  ADDED ERROR MESSAGE FOR FULL-DISK PROBLEM.
+
+/      041     12-MAY-1989     BUG FIX.                        CJL
+
+/              VARIOUS  VERSIONS  (DECMATE)  WON'T  FUNCTION REMOTELY WHILE KL-8
+/              VERSIONS WORK  FINE.    ADDED  REMOTE LINE READ IOT TO INITIALIZE
+/              REMOTE  LINE  AT   STARTUP  TIME  FOR  VERSIONS  REQUIRING  THIS.
+/              CORRESPONDING CHANGES IN PATCH FILE MADE FOR REMOTE LINE READ IOT
+/              IN TWO PLACES.
+\f/     040     07-MAR-1989     COSMETIC CLEANUP.               CJL
+
+/              CLEANUP OF EDIT HISTORY AND OTHER COMMENTS.
+
+/      039     21-MAY-1988     CODE CLEANUP.                   CJL
+
+/              ADDED VARIABLE 'INIECHO' TO  ALLOW  DEFAULT CONNECT-MODE STATE TO
+/              BE HALF-DUPLEX ("SET LOCAL-ECHO ON").    MODIFIED  INPUT  SERVICE
+/              ERROR ADDRESSES TO SIMPLIFY ERROR TABLES.
+
+/      038     19-MAY-1988     CODE CLEANUP.                   CJL
+
+/              ELIMINATED  TRAILER FILES DURING ASSEMBLY BY  CREATING  VARIABLES
+/              'GENMSG' AND 'UMSG.' THIS ALLOWS THE HEADER  FILE  (PARAM.PA)  TO
+/              CONTAIN THE LOCAL MESSAGE TEXT WITHOUT SUBSEQUENT OVERLAY  (WHICH
+/              WAS WHY THERE FORMERLY WAS A TRAILER FILE CAPABILITY).    OVERLAY
+/              BY  K12PCH.BN  WILL  DEFAULT TO CREATION OF A DUMMY USER  MESSAGE
+/              (WITHIN K12PCH) ENCOURAGING LOCAL  CUSTOMIZATION.  K12MIT.BN WILL
+/              CONTAIN A NULL MESSAGE BY DEFAULT UNLESS CUSTOMIZED IN PARAM.PA.
+
+/      037     21-JAN-1988     BUG FIX.                        CJL
+
+/              RESET OS/8 DEVICE CONTROL WORD  TABLE TO DELETE TENTATIVE FILE IN
+/              CASE OF PRIOR INPUT SERVICE ERROR.
+
+/      036     20-JAN-1988     BUG FIX.                        CJL
+
+/              RESET 'OFFLG' WHEN DOING INPUT SERVICE IN CASE PRIOR ERRORS LEAVE
+/              THE FLAG SET.
+
+/      035     14-JAN-1988     USR RESIDENT CODING.            CJL
+
+/              CALLS TO USR NOW USE 10200 INSTEAD  OF  17700.   NO SWAP OVERHEAD
+/              WHEN OPENING OR CLOSING FILES.
+
+/      034     13-JAN-1988     CODE CLEANUP.                   CJL
+
+/              ALL  EIGHT-BIT  ORIENTED  CONSOLE  CODE ELIMINATED;  NOW  IGNORES
+/              PARITY (JUST SEVEN BITS).
+
+/      033     12-JAN-1988     CODE CLEANUP.                   CJL
+
+/              'TTYOUT' AND 'OTTY' ROUTINES ELIMINATED;  NOW USES 'P7CH' FOR ALL
+/              CONSOLE OUTPUT (EXCEPT FOR CONNECT MODE).
+
+/      032     12-JAN-1988     CODE CLEANUP.                   CJL
+
+/              VARIOUS  ROUTINES REWRITTEN TO ELIMINATE DEPENDENCIES ON CPU TYPE
+/              BEYOND THE CLASSIC PDP-8.
+\f/     031     11-JAN-1988     CODE CLEANUP.                   CJL
+
+/              ELIMINATED 'RTDISP'  AND  CHANGED CALLING CONVENTION FOR DISPATCH
+/              ROUTINE.  ALL  CALLERS  NOW  LOCAL  OR VIA LOCAL POINTERS.  ADDED
+/              SEVERAL  CONDITIONAL  PARAMETERS  AND    LABELS  FOR  BENEFIT  OF
+/              K12PCH.PAL.
+
+/      030     05-JAN-1988     CODE CLEANUP.                   CJL
+
+/              CHANGED LOWER/UPPER CASE CONDITIONAL ASSEMBLY PARAMETERS AND MORE
+/              EFFICIENT CODE.
+
+/      029     21-DEC-1987     CODE CLEANUP.                   CJL
+
+/              CHANGED CALLING CONVENTIONS FOR 'SCRIBE' AND SIMILAR ROUTINES AND
+/              REWROTE 'COMMAND' ROUTINE.
+
+/      028     15-DEC-1987     CODE CLEANUP.                   CJL
+
+/              COMPLETE REWRITE OF FILE LOOKUP ROUTINE.   'LUKUP' NOW USES FIELD
+/              ONE  BUFFER  AND  ITS OWN AUTO-INDEX REGISTER CONSERVING  PROGRAM
+/              SPACE.
+
+/      027     05-DEC-1987     CODE CLEANUP.                   CJL
+
+/              CHANGED  DISPATCH  ('DISPA0') ROUTINE TO USE 'SRCHTABLE' ROUTINE.
+/              ALL CALLS  MADE COMPATIBLE.  ELIMINATED 'SCANC' CODE.  ELIMINATED
+/              CODE WITHIN 'DPARS'  ROUTINE.    'LUKUP' ROUTINE NOW DOES ITS OWN
+/              DISK I/O.  ELIMINATED 'BLKIN' ROUTINE.
+
+/      026     27-NOV-1987     NEW CONNECT MODE CODE.          CJL
+
+/              TOTAL  REWRITE  OF ALL CONNECT MODE CONSOLE AND REMOTE INPUT  AND
+/              OUTPUT  TERMINAL  ROUTINES.  CONNECT IS NOW FULLY BUFFERED IN ALL
+/              DIRECTIONS.   IF  FLOW  CONTROL  IS  OBEYED, ANY BAUD RATE CAN BE
+/              ACCOMODATED BOTH LOCALLY  AND  REMOTE  (UP  TO  9600 BAUD TESTED,
+/              SHOULD WORK TO AT  LEAST  19200 BAUD BY INSPECTION).  TESTED WITH
+/              FAST VT-100 EMULATOR CONSOLE TO  PROVE  ESCAPE  SEQUENCES ARE NOT
+/              DROPPED WHEN LOCAL TERMINAL IS FASTER  THAN REMOTE LINE.  LIMITED
+/              USE OF SUBROUTINES TO IMPROVE HIGH BAUD  RATE  OPERATION.   ADDED
+/              TABLE-DRIVEN ERROR EXITROUTINE FOR SEND ROUTINES.
+
+/      THIS EDIT PROVIDES  FULLY  BUFFERED  INPUT/OUTPUT  ROUTINES FOR BOTH LOCAL AND
+/      REMOTE PORTS.  NO  INTERRUPTS  ARE  USED  FOR  MAXIMUM COMPATIBILITY WITH OS/8
+/      DEVICES (SOME OF WHICH ARE  INTOLERANT OF INTERRUPTS, SUCH AS TD-8/E).  REMOTE
+/      FLOW CONTROL (IF ENABLED) WILL SIGNAL BUFFER FILLING VIA <DC3> WHEN THE BUFFER
+/      IS 3/4 FULL.  WHEN THE BUFFER  REACHES 1/4 FULL, THE REMOTE WILL BE SENT <DC1>
+/      TO ALLOW FURTHER OUTPUT.  REMOTE FLOW CONTROL IS SUPPORTED IN BOTH DIRECTIONS;
+/      LOCAL FLOW CONTROL IS FROM THE KEYBOARD ONLY.
+
+/      WHILE THE CONSOLE OUTPUT IS PAUSED BY <DC3>, THE  BUFFER WILL FILL WITH OUTPUT
+/      CHARACTERS.  WHEN THE USER RELEASES THE CONSOLE WITH <DC1>,  THE  BUFFER  WILL
+/      RAPIDLY  EMPTY  (ASSUMING THE CONSOLE IS FASTER THAN THE REMOTE LINE).    THIS
+/      ALLOWS THE USER TO PAUSE THE CONSOLE WITHOUT BACKING UP THE REMOTE  LINE UP TO
+/      THE LIMITS OF BOTH LOCAL OUTPUT AND REMOTE INPUT BUFFERS.
+\f/     025     24-NOV-1987     NEW FEATURES AND CODE CLEANUP.  CJL
+
+/              PROPER  INTERRUPT  SETUP  FOR  <^C> AND <^P>, ECHO  STATE.    ALL
+/              MESSAGES  IN  NEW  FORMAT,  (SOME NEW ONES HAVE BETTER  CONTENT).
+/              ELIMINATED  'PRI6B' AND 'REM6B' ROUTINES.  NEW AND IMPROVED INPUT
+/              SERVICE ERROR  CODE  MOVED  TO  PROPER  PAGE.    REWROTE  CONNECT
+/              ROUTINES TO ALLOW  NON-INTERRUPT BUFFERED I/O LATER.  CREATED NEW
+/              VARIABLE 'ESCHAR' AND PARAMETER  'ESCAPE'  TO  SET DEFAULT ESCAPE
+/              CHARACTER.  ESCAPE CHARACTER CAN BE CHANGED IN MEMORY AND WILL BE
+/              USED  CORRECTLY  BY ALL ROUTINES.   ADDED  'ESCPRNT'  ROUTINE  TO
+/              HANDLE  ALL  CASES  (INCLUDING NON-CONTROL CHARACTERS).   DEFAULT
+/              ESCAPE  PARAMETER  VALUE  COMPATIBLE  WITH K08V2, BUT IS  A  USER
+/              PARAMETER,  CONFIGURED  AS  OTHER PARAMETERS DEFINED IN EDIT 017.
+/              CREATED  ESCAPE FUNCTION TABLE FOR EXPANSION LATER.  NOW SUPPORTS
+/              ESCAPE C(LOSE)  IN  UPPER  OR LOWER CASE, ESCAPE ESCAPE (SEND ONE
+/              ESCAPE CHARACTER).   ALL  BAD  ESCAPE  COMMANDS  WILL ISSUE <BEL>
+/              CHARACTER TO WARN USER  THAT COMMAND IS ILLEGAL AND OTHERWISE WAS
+/              IGNORED.  CREATED NEW VARIABLE  'ECHOFLAG' TO ALLOW LOCAL ECHO IN
+/              CONNECT MODE.
+
+/      024     19-NOV-1987     NEW FEATURES.                   CJL
+
+/              NEW  STARTUP MESSAGES AND HELP METHOD  VIA  COMMAND.    CPU  TYPE
+/              IDENTIFICATION TO ALLOW FUTURE VERSIONS TO CHECK  FOR  QUIRKS AND
+/              MODEL DEPENDENCIES.  THE DEFAULT PROMPT REFLECTS THE  ACTUAL  CPU
+/              TYPE (THUS "KERMIT-12>" ON PDP-12).  VERSION, REVISION, AND  DATE
+/              NOW EQUATED SYMBOLS.
+
+/      023     18-NOV-1987     NEW CONSOLE I/O PACKAGE.        CJL
+
+/              NEW  CONSOLE  I/O  ROUTINES  WITH  DC1/DC3  SUPPORT  FOR  CONSOLE
+/              TERMINAL MESSAGES NOT ASSOCIATED WITH ANY REMOTE ACTIVITY (NOT TO
+/              BE USED DURING CONNECT MODE).  USES FIELD ONE FOR MESSAGE TEXT TO
+/              ALLOW FOR MORE PROGRAM  SPACE.    THE  MESSAGES  ARE NOW GIVEN IN
+/              UPPER/LOWER SIXBIT FORMAT.  SUPPORT  FOR <^P> RESTART AND <^O> TO
+/              FLIP  ECHO.  UPPER-CASE CAN BE  FORCED  BY  CHANGING  A  VARIABLE
+/              ('UPONLY').
+
+/      022     17-NOV-1987     BUG FIX.                        CJL
+
+/              EXTRA-LONG INIT PACKETS CORRUPTING PROGRAM;  NOW  CHECKS  FOR AND
+/              IGNORES EXTRA CAPABILITIES BEYOND 'CAPAS' BYTE.
+\f/     021     17-NOV-1987     CODE CLEANUP.                   CJL
+
+/              REWROTE  TENTATIVE OUTPUT FILE LENGTH CODE FOR MORE  CONSISTENCY.
+/              RENAMED "FINISH" COMMAND CORRECTLY (FORMERLY "BYE").
+
+/      FORMER  CODE  REGARDING  THE  TENTATIVE  FILE  MAXIMUM  LENGTH WAS  ACCEPTABLY
+/      ORGANIZED  FOR  ORIGINAL  PS/8, OS/8 CONVENTIONS.  WITH THE EVOLUTION  OF  THE
+/      OPERATING  SYSTEM  INTO  OS/78  (VERSIONS  1-4) AND OS/278 (VERSIONS 1-2), THE
+/      ENTER OPERATION HAS BEEN CHANGED WITH DANGEROUS CONSEQUENCES.
+
+/      THE  ORIGINAL DEFINITION OF THE LENGTH RETURNED BY ENTER IS THE ACTUAL  LENGTH
+/      OF  THE LARGEST EMPTY (IN TWO'S COMPLEMENT FORM).  IF RECORD 7777 IS  PART  OF
+/      THE  ACTUAL  LARGEST  EMPTY (FULL SIZE DEVICE AND THE LARGEST EMPTY IS LAST ON
+/      THE  DEVICE),  THEN  THE  LENGTH RETURNED IS ONE LESS (THIS IS A LONG STANDING
+/      BUG).  SINCE THERE IS NO STRAIGHT-FORWARD WAY TO DETERMINE THIS, THE LENGTH IS
+/      ASSUMED TO BE CORRECT.
+
+/      TESTS WITH THE  DECUS  VERSION  OF  OS/278 (DM-101) REVEAL A DANGEROUS CHANGE:
+/      THE LENGTH RETURNED IS TWO LARGER THAN ACTUALLY EXISTS!
+
+/      TO COUNTERACT THIS, EDIT  010  INSERTED  A  DECREMENT  OF  TWO INTO THE LENGTH
+/      BEFORE PASSING IT BACK TO  THE  KERMIT FILE WRITING ROUTINE.  THE FILE WRITING
+/      ROUTINE THEN ADDS ONE TO THE LENGTH TO CREATE A "DANGER COUNT", I.E., IN TWO'S
+/      COMPLEMENT  NOTATION,  THIS IS THE AMOUNT THAT  WILL  INDICATE  FILE  OVERFLOW
+/      SHOULD IT REACH ZERO.
+
+/      THIS HAS NOW BEEN REORGANIZED TO ALLOW THE  ENTER  ROUTINE  TO  SET THE DANGER
+/      COUNT  DIRECTLY.  OS/8 USERS MUST ALLOW FOR THE  EXTRA  ROOM  (WHICH  MUST  BE
+/      PRESENT  BUT  WILL NOT BE USED), SINCE NO CHECK FOR  SYSTEM  VERSION  WILL  BE
+/      PERFORMED.
+
+/      020     16-NOV-1987     NEW ROUTINES AND CODE CLEANUP.  CJL
+
+/              REWROTE  ENTIRE  OUTPUT  FILE    PACK   ROUTINE.    NOW  SUPPORTS
+/              ASCII/BINARY  INTERNAL FILE MODE FOR  LATER  USE.    USES  OUTPUT
+/              BUFFER IN FIELD ONE (SAME DEFINITIONS  AS  INPUT BUFFER) TO ALLOW
+/              MORE PROGRAM SPACE.  END OF FILE  CONVENTION  IN  ASCII  MODE NOW
+/              INCLUDES  ENSURING  <^Z>  CHARACTER  PACKED  INTO FILE (OR  NOT).
+/              REWROTE  ENTIRE  OUTPUT  FILE  CLOSE  ROUTINE  TO  IMPLEMENT <^Z>
+/              SCHEME.  ELIMINATED SEPARATE OUTPUT FILE INITIALIZE ROUTINE;  USE
+/              SPECIAL ROUTINE CALL INSTEAD.  FIXED PACKET WRITE BUG.
+
+/      019     15-NOV-1987     NEW ROUTINES AND CODE CLEANUP.  CJL
+
+/              FIXED UNPACK <^Z> BUG.  REWROTE ENTIRE INPUT FILE UNPACK ROUTINE.
+/              NOW SUPPORTS ASCII/BINARY INTERNAL FILE MODE FOR LATER USE.  USES
+/              INPUT BUFFER IN FIELD ONE TO ALLOW  MORE  PROGRAM  SPACE.  BUFFER
+/              FIELD DEFINED VIA SYMBOLS TO ALLOW CHANGES IN THE FUTURE.  END OF
+/              FILE CONVENTION IN ASCII MODE NOW INCLUDES SENDING <^Z> CHARACTER
+/              OR  NOT.  ELIMINATED SEPARATE INPUT FILE INITIALIZE ROUTINE;  USE
+/              SPECIAL ROUTINE CALL INSTEAD.
+
+/      018     09-NOV-1987     BUG FIX AND CODE CLEANUP.       CJL
+
+/              FIXED RECEIVE BUG; NOW ALLOW DEV: ON RECEIVE.
+\f/     017     05-NOV-1987     NEW FEATURES.                   CJL
+
+/              CONDITIONAL ASSEMBLY  PARAMETERS  ADDED  FOR MACHINE TYPE (PDP-8,
+/              DECMATE I, DECMATE  II/III/III+),  REMOTE LINE AND LOCAL TERMINAL
+/              INTERFACE DEFINITIONS.
+
+/      016     05-NOV-1987     CODE CLEANUP.                   CJL
+
+/              OPTIMIZATION OF CODE, LITERALS, CONSTANTS.
+
+/      015     04-NOV-1987     BUG FIX.                        CJL
+
+/              INPUT SERVICE ROUTINE ERROR  DOES JMP INSTEAD OF JMS WHEN CALLING
+/              COMMON ERROR HANDLER.
+
+/      014     02-NOV-1987     SOURCE FILE CLEANUP.            CJL
+
+/              SOURCE FILE COSMETICALLY CLEANED UP  AND  RENAMED  TO  K12MIT.PAL
+/              WHICH CONFORMS WITH CUCCA NAMING CONVENTION.    NO  ACTUAL BINARY
+/              CODE CHANGES BEYOND K08V2.  THIS EDIT  HISTORY  ADDED.    ENTRIES
+/              PRIOR TO 014 TRANSCRIBED BY CJL.
+
+/      SINCE THE PDP-12 (AND OTHER 12-BIT DEC MACHINES)  IS  THE INTENDED ENVIRONMENT
+/      FOR THIS PROGRAM, IT IS NOW KNOWN AS KERMIT-12.
+
+/      ASSEMBLING  THE  SOURCE FILE PRODUCES BINARY IDENTICAL TO K08V2.PA  CONFIRMING
+/      THAT SOURCE CLEANUP DOESN'T DAMAGE THE CODING (K08V2 IS NOW OBSOLETE).
+
+/      013     01-OCT-1987     CHANGE TO VERSION 2.0.          R. SCHLERF (RICH)
+
+/              CHANGED  'RKIOT'/'RTIOT'    TO   43/44  REMOTE  LINE  IOT  (LOCAL
+/              PREFERENCE).  CHANGED  'ESCAPE'  CHARACTER  TO  ^]  ('CONX1') FOR
+/              GENERIC CONFORMITY.  ADDED  VERSION/COMMAND BANNER AT STARTUP FOR
+/              MINI-HELP.    INCORPORATED  K278  CHANGES  003-006,  009-010  (NO
+/              INTERRUPTS).  DELETED 'ERRMSG.' NOW USES  'STXERR'  AT 'CLOOP9'+2
+/              FOR PROGRAM SPACE.  TO CONFORM TO  GENERIC KERMIT, "BACK ON PDP8"
+/              MESSAGE  DELETED AND REPLACED WITH BEEP <^G>.   MESSAGE  "SENDING
+/              FILE  XXXXXX.XX  CREATED  ON  DD-MM-YY"  REDUCED TO "SENDING FILE
+/              XXXXXX.XX"  TO CONFORM TO GENERIC KERMIT.  PARITY BIT IS  IGNORED
+/              ON BOTH REMOTE AND TTY LINES.  OUTPUT PARITY IS SET TO SPACE.
+
+/      PROGRAM RENAMED TO K08V2.PA AND MADE AVAILABLE TO CUCCA BY:
+
+/      RICHARD SCHLERF (RICH)
+/      AMERICAN CYANAMID COMPANY
+/      MEDICAL RESEARCH DIVISION
+/      LEDERLE LABORATORIES
+/      BUILDING 190 ROOM 115H
+/      PEARL RIVER, NEW YORK  10965
+/      (914) 732-2186 (09:00 TO 16:00)
+
+/      SINCE  PRIMARY APPLICATION OF K08V2 IS FOR PDP-8 USAGE, THE MODIFICATIONS  NOT
+/      SPECIFIC TO DECMATE II/III FROM K278 WERE MOVED TO THE K08MIT VERSION.  FUTURE
+/      VERSIONS WILL  INCORPORATE  THE  DECMATE  FEATURES AND THUS OBSOLETE ALL OTHER
+/      VERSIONS AT THAT TIME.
+\f/     012     04-JUN-1986     PROGRAM FIX.                    SEPP STADELMANN (SSTA)
+
+/              RE-INITIALIZE VIA 'V30ST' AS ROM SETUP CLEARS COMPOSETABLE, ETC.
+
+/      04-JUN-1986 VERSION RELEASED  TO  CUCCA  BY  MARTYN HEMMINGS (DEC GERMANY) AND
+/      SEPP STADELMANN (DEC SWITZERLAND) OF:
+
+/      DIGITAL EQUIPMENT CORPORATION (DEC)
+/      146 MAIN STREET
+/      MAYNARD, MASS  01754
+/      (617) 897-5111
+
+/      CUCCA RENAMED FILES (KERMIT.PA AND KERCOM.PA) TO K278.PA AND K278COM.PA (WHICH
+/      DOESN'T REALLY CONFORM TO THE NAMING CONVENTION).
+
+/      CUCCA VERSION OF K278.PA FOUND TO BE DEFECTIVE.  FILE REPAIRED BY:
+
+/      CHARLES LASNER (CJL)
+/      CLA SYSTEMS
+/      72-55 METROPOLITAN AVENUE
+/      MIDDLE VILLAGE, NEW YORK  11379-2107
+/      (718) 894-6499
+
+/      REPAIRED FILE (K278.PA) NOW AVAILABLE AT CUCCA.
+
+/      PROGRAM IS NOW  THE DECMATE II/III (III-PLUS) KERMIT ONLY.  HOOKS WERE LEFT IN
+/      FOR PDP-8 VERSION, BUT  NOT  IMPLEMENTED.    K278  DOES  WORK  WITH ADDITIONAL
+/      IMPLEMENTATIONS OF KERMIT, BUT RECEIVE  COMMAND DOES NOT WORK.  PROGRAM YIELDS
+/      RECOVERABLE SYSTEM ERROR/HALT WHEN EXITING TO  FLOPPY-BASED DECMATE II SYSTEM.
+/      CONNECT MODE IS VT200 8-BIT WHICH CONFUSES EVEN/ODD PARITY SYSTEMS.  K278 DOES
+/      NOT SUPPORT SETUP KEY OF DECMATE, BUT IMPLEMENTS SETUP COMMAND.
+
+/      011     04-JUN-1986     NEW FEATURES.                   SSTA
+
+/              'PRQ3' CODE CONDITIONALS.  ROM SETUP COMMAND IMPLEMENTED FOR DMII/III.
+/              AUTOMATIC UPPERCASE SELECT ON RETURN FROM CONNECT.
+
+/      010     13-MAR-1986     BUG FIX.                        MARTYN HEMMINGS (MART)
+
+/              FULL DISK HANDLED WELL.
+
+/      009     13-MAR-1986     BUG FIX.                        MART
+
+/              CLEAN UP BREAK AND GET.
+\f/     008     12-MAR-1986     BUG FIX.                        MART
+
+/              CLEAR  INPUT  CHARACTERS  FROM  COMMUNICATIONS PORT WHEN IN  IDLE
+/              LOOP.
+
+/      007     11-MAR-1986     NEW FEATURES AND BUG FIX.       MARTYN HEMMINGS AND
+/                                                              SSEP STADELMANN
+/                                                              (MART+SSTA)
+
+/              INTERRUPT DRIVEN AND BUG FIX.
+
+/      006     10-MAR-1986     NEW FEATURE.                    MART+SSTA
+
+/              DEVICE PARSE ON GET.
+
+/      005     10-MAR-1986     BUG FIX.                        MART+SSTA
+
+/              NO DATE IN FILE WITH <^Z> INTACT.
+
+/      004     10-MAR-1986     NEW FEATURES AND BUG FIX.       MART+SSTA
+
+/              MAXIMUM  RECEIVE  BUFFER  FIXUP  ('RTERMI'),  15  SECOND TIME-OUT
+/              DURING CONNECT.
+
+/      003     10-MAR-1986     BUG FIX.                        SSTA
+
+/              TWO PAGE HANDLER FIX.
+
+/      K08MIT.PAL  COPIED  TO  DEC  ENGINEERING NETWORK (NODE LSMVAX::) ULTIMATELY TO
+/      EUROPE (NODE VIRGIN::) WHERE PROGRAM BECAME KERMIT.PAL AND KERCOM.PAL.
+
+/      KERMIT.PAL  AND KERCOM.PAL ARE TWO SOURCE FILES ASSEMBLED TOGETHER TO  PRODUCE
+/      THE RUNNING KERMIT-8.  *THEY ARE FOR THE DECMATE II/III/III-PLUS ONLY.*
+
+/      002     18-JUL-1985     ORIGINAL RELEASE.               RANDY HIPPE
+
+/      18-JUL-1985 VERSION RELEASED TO CUCCA BY JERRY SANDS AND RANDY HIPPE OF:
+
+/      BUREAU OF ENGRAVING, INC.
+/      3311 BROADWAY N.E.
+/      MINNEAPOLIS, MN  55413
+/      (612) 623-0900 X218
+
+/      CUCCA  RENAMED  FILE  (KER8.PAL)  TO  K08MIT.PAL  WHICH  CONFORMS  TO   NAMING
+/      CONVENTION OF KERMIT FILES.
+
+/      K08MIT SUPPORTS CONNECT, BYE (REALLY FIN), EXIT, SEND, GET, RECEIVE ONLY.
+
+/      PROGRAM PRONE  TO  GETTING  "CONFUSED" AND OUTPUTS FILE DATE ATTRIBUTE BOTH AS
+/      'CAPAS' BYTE FEATURE  AND  ASCII  TEXT INSERTED INTO CONTENTS OF FILE AHEAD OF
+/      FILE DATA.  COMMAND PROCESSOR ACCEPTS UPPER-CASE COMPLETE COMMANDS ONLY.  <^C>
+/      ABORT FEATURE TAKES VERY LONG TIME TO ACT (IF AT ALL!).  MANY KERMITS WILL NOT
+/      WORK WITH K08MIT;  HOWEVER, K08MIT WAS TESTED SUCCESSFULLY WITH KERMIT-20.
+
+/      001     30-JUL-1984     FIRST VERSION (KER8.PAL).       JERRY SANDS
+\f/     HARDWARE HINTS AND KINKS.
+
+
+/      KERMIT-12 REQUIRES THE FOLLOWING STANDARD OS/8 FAMILY CONFIGURATION:
+
+/      PDP-8 FAMILY MEMBER WITH AT LEAST 8K MEMORY.
+
+/      OS/8 SYSTEM DEVICE (WITH OS/8 FAMILY OPERATING SYSTEM RESIDENT).
+
+/      KL8-COMPATIBLE CONSOLE INTERFACE.
+
+/      7/8-BIT ASCII EXTERNAL CONSOLE TERMINAL DEVICE (TTY:).
+
+/      KL8-COMPATIBLE REMOTE INTERFACE TO OTHER KERMIT.
+
+/      NOTE:  ASSEMBLY  PARAMETERS  OF  KERMIT-12  ALLOW FOR LOCAL KERMIT CONTROLLING
+/      TERMINALS TO BE OTHER  THAN  THE  PRIMARY  OS/8  CONSOLE  DEVICE.   THE ACTUAL
+/      HARDWARE MUST STILL CONFORM TO  THE  SAME REQUIREMENTS (THE DEVICE CODES WOULD
+/      THEN BE USER-SPECIFIED AND DIFFER FROM  THE  STANDARD  03/04)  AS THE STANDARD
+/      CONSOLE INTERFACE AND TERMINAL.
+
+/      SPECIAL DECMATE CONSIDERATIONS:
+
+/      DECMATE  USAGE IS USUALLY OBTAINED BY  ASSEMBLING  FOR  THE  STANDARD  CONSOLE
+/      DEVICE  (03/04),  AS  THE  BUILT-IN  FIRMWARE/SLUSHWARE  OF  THE  DECMATES  IS
+/      SUFFICIENTLY COMPATIBLE WITH THE PDP-8 HARDWARE FOR KERMIT-12'S  REQUIREMENTS.
+/      (THE ONLY OTHER ACCEPTABLE CONSOLE DEVICE ON THE DECMATE IS THE PRINTER PORT.)
+
+/      DECMATE  REMOTE  COMMUNICATIONS  PORTS  ARE    *RADICALLY*    DIFFERENT   FROM
+/      KL8-COMPATIBLE PORTS.  THESE ARE HANDLED AUTOMATICALLY BY ONCE-ONLY CODE WHICH
+/      DETECTS  THE  USAGE  OF  KERMIT-12  ON  THE    SPECIFIC  DECMATE  SYSTEM,  AND
+/      SELF-CONFIGURATION AS APPROPRIATE.  THERE IS ONE EXCEPTION  TO THIS, NAMELY IF
+/      THE COMMUNICATIONS PORT CODE IS ASSEMBLED FOR THE PRINTER  PORT  (32/33), THEN
+/      THE PRINTER PORT, *NOT* THE COMMUNICATIONS PORT WILL BE USED.    THE  STANDARD
+/      ASSEMBLY  OF  KERMIT-12 IS FOR A PDP-8 WITH DEVICE 40/41 COMMUNICATIONS  PORT.
+/      THIS DESIGNATED VERSION WILL SELF-CONFIGURE WHEN EXECUTED ON A DECMATE.
+\f/     CONFIGURATION RESTRICTIONS:
+
+/      WHEN  INTERRUPTS  ARE SUPPORTED AGAIN, DEVICES SUCH AS THE TD-8/E WON'T  WORK.
+/      THE  NON-INTERRUPT  VERSION  SHOULD WORK TO 19200 BAUD ON THE PDP-8/E CPU,  SO
+/      THIS  SHOULD NOT BE A PROBLEM.  INTERRUPT-DRIVEN VERSIONS OF KERMIT-12 MUST BE
+/      RUN ONLY  ON  SYSTEMS  WHERE  *ALL*  INTENDED  DEVICES CAN HAVE THEIR HANDLERS
+/      INTERRUPTED BY THE CONSOLE AND REMOTE LINE INTERRUPT HANDLERS.  WHEN IN DOUBT,
+/      THE NON-INTERRUPT VERSION MUST BE USED (CURRENTLY THE ONLY VERSION).
+
+/      IF FLOW CONTROL IS  DISABLED  (DUE  TO  XON/XOFF  BEING  UNAVAILABLE) THEN THE
+/      CONSOLE BAUD RATE MUST MEET  OR  EXCEED  THE  REMOTE LINE RATE.  THE USER MUST
+/      TAKE MINIMAL CARE NOT TO OVERLOAD  THE  INTERNAL BUFFERS OF KERMIT-12, AS THIS
+/      WILL YIELD THE ERROR MESSAGE:  KEYBOARD INPUT ERROR!
+
+/      THIS IS NOT LIKELY TO OCCUR UNLESS  ONE  "PLAYS"  WITH  A  KEYBOARD  WHICH CAN
+/      GENERATE NUMEROUS ESCAPE SEQUENCES AS THE BUFFERS ARE  QUITE  ADEQUATE FOR ALL
+/      REASONABLE TERMINAL APPLICATIONS.  SIMILARLY, IF THE REMOTE LINE DOES NOT OBEY
+/      XON/XOFF  PROTOCOL  (WHILE  KERMIT-12  HAS  IT  ENABLED), THEN INTERNAL BUFFER
+/      OVERFLOW WILL YIELD THE ERROR MESSAGE:  REMOTE LINE INPUT ERROR!
+
+/      THESE ERRORS ARE EXTREMELY UNLIKELY AND CAN ONLY BE CREATED BY  MISUSE OF FLOW
+/      CONTROL (THE ONLY EXCEPTION TO THIS IS THE ATTEMPT TO USE KERMIT-12  WITH  THE
+/      CONSOLE  BAUD  RATE  SLOWER  THAN  THE REMOTE LINE BAUD RATE WITH FLOW CONTROL
+/      DISABLED).  IF FLOW CONTROL IS ENABLED AND OBEYED THEN THE BUFFERING OF REMOTE
+/      LINE INPUT  WILL  OCCUR  WHILE SHORT PAUSES OCCUR ON THE CONSOLE (ASSUMING THE
+/      USER FREEZES/UNFREEZES THE  DISPLAY OFTEN AND THE CONSOLE DISPLAY BAUD RATE IS
+/      FASTER THAN THE REMOTE LINE BAUD RATE) WITH PRACTICALLY NO REMOTE LINE DELAY.
+
+/      FLOW CONTROL IS NOT  YET  SUPPORTED  DURING KERMIT TRANSFERS.  SINCE KERMIT-12
+/      DOES  NOT SUPPORT SLIDING WINDOWS,  KERMIT-12  WILL  NEVER  GENERATE  OUTGOING
+/      XON/XOFF SEQUENCES.  FUTURE REVISIONS WILL  SUPPORT INCOMING XON/XOFF FROM THE
+/      REMOTE KERMIT.  XON/XOFF PROTOCOL DURING CONNECT  MODE IS COMPLETELY AVAILABLE
+/      AT THE USER'S OPTION.
+
+/      CONSOLE TERMINALS ARE REQUIRED TO SUPPORT "GLASS TTY:"  FEATURES,  I.E.    THE
+/      PRINTING ASCII CHARACTER SET (LOWER-CASE DESIRABLE) AND THE CONTROL CHARACTERS
+/      <CR>, <LF>, AND <BEL> (THE LAST FOR VARIOUS AUDIBLE REPORTS  ONLY).  TERMINALS
+/      LACKING LOWER-CASE  SUPPORT  SHOULD "FOLD" LOWER-CASE CHARACTERS TO UPPER-CASE
+/      AUTOMATICALLY.  TERMINALS  SUCH  AS  THE VT05 CAN HAVE THE KEYBOARD LOWER-CASE
+/      ENABLED, AS KERMIT-12 SUPPORTS  OPTIONAL  OUTPUT FOLDING.  THE UPPER-CASE ONLY
+/      OPTION SHOULD BE ENABLED FOR  TERMINALS WHICH IGNORE LOWER-CASE INPUT FROM THE
+/      HOST,  AS KERMIT-12 GENERATES NUMEROUS LOWER-CASE  MESSAGE  CHARACTERS  (WHICH
+/      BECOME UPPER-CASE IF THIS OPTION IS SET).   THE <BS> CHARACTER IS REQUIRED FOR
+/      VISUAL  RUBOUT  (<BS>  <SPACE>  <BS>)  ONLY.   FUTURE  VERSIONS  WILL  SUPPORT
+/      HARD-COPY BACKSPACE TO REMOVE THIS REQUIREMENT.  ALL TERMINAL  FEATURES  (SUCH
+/      AS ACTUAL VT-100 FUNCTIONALITY) ARE FREELY PASSED TO THE HOST  DURING  CONNECT
+/      MODE;  THE ONLY CHARACTER ACTUALLY RESERVED IS THE ESCAPE CHARACTER WHICH WILL
+/      BE  TREATED  AS  A SEVEN-BIT CHARACTER ONLY.  IF THE USER PRESSES  THE  ESCAPE
+/      CHARACTER TWICE,  THEN  THE  SEVEN-BIT REPRESENTATION OF THE CHARACTER IS SENT
+/      ONCE;  THERE  IS  NO  WAY  TO SEND THE ESCAPE CHARACTER WITH THE HIGH-BIT SET.
+/      SINCE THE ESCAPE CHARACTER  ITSELF  CAN  BE SET TO ALMOST ANY SEVEN-BIT VALUE,
+/      THIS SHOULD NOT BE A SERIOUS LIMITATION.  TERMINALS THAT DON'T "BEEP" WHEN THE
+/      <BEL> CHARACTER IS SENT SHOULD NOT  OUTPUT  A  PRINTABLE RENDITION OF THE <^G>
+/      CHARACTER, AS THIS WOULD DISRUPT THE TERMINAL OUTPUT AND INTERNAL COLUMN COUNT
+/      DURING VARIOUS MESSAGE SEQUENCES, ETC.
+\f/     KL-8/E INTERFACES SHOULD BE SETUP WITH THE FOLLOWING STANDARD SETTINGS:
+
+/      1 STOP BIT ABOVE 110 BAUD WITH 8 BITS DATA.
+
+/      FUNCTIONAL  BAUD RATES INCLUDE 110, 150, 300, 600,  1200,  2400,  4800,  9600,
+/      19200, 38400 AND 76800.  2400 BAUD REQUIRES A  REVISION  "B"  OR  BETTER M8650
+/      MODULE  (IF  ONE  USES  DEC'S  DOCUMENTATION  OF AVAILABLE SPLIT-LUG OPTIONS).
+/      ACTUAL  BAUD  RATES  UP TO APPROXIMATELY 100 KBAUD SHOULD WORK WHEN  KERMIT-12
+/      BECOMES  INTERRUPT-DRIVEN.    RATES  OTHER THAN 110 BAUD REQUIRE A 19.6608 MHZ
+/      BAUD-RATE OSCILLATOR.
+
+/      THE BAUD  RATES STATED ABOVE ARE ACTUALLY AVAILABLE ON THE KL-8/E, BUT REQUIRE
+/      A SINGLE SOLDER  JUMPER  TO  IMPLEMENT  THE  PROPER BAUD RATE ABOVE 2400 BAUD.
+/      CHANGING BAUD-RATE GENERATOR CRYSTALS  WILL  PRODUCE OTHER RATES AS NECESSARY.
+/      (SEND INQUIRIES  TO CLA SYSTEMS FOR INFORMATION REGARDING KL-8/E MODIFICATIONS
+/      INCLUDING UPGRADED BAUD-RATE  OSCILLATORS,  ETC.) KERMIT-12 HAS BEEN TESTED TO
+/      9600 BAUD AND SHOULD WORK TO 19200 BAUD (AS OF THE CURRENT VERSION).
+
+
+/      KL8-J/A INTERFACES SHOULD BE SETUP WITH THE FOLLOWING STANDARD SETTINGS:
+
+/      1 STOP BIT ABOVE 110 BAUD WITH 8 BITS DATA NO PARITY.
+
+/      FUTURE  VERSIONS  OF KERMIT-12 WILL SUPPORT VARIOUS SOFTWARE-GENERATED  PARITY
+/      OPTIONS.  THE FRAMING AND OVERRUN ERRORS CAN BE ENABLED AND WILL EVENTUALLY BE
+/      SUPPORTED (BUT THE PARITY GENERATOR SHOULD BE DISABLED TO PREVENT  INTERACTION
+/      WITH THE SOFTWARE USE OF PARITY GENERATION/DETECTION).
+
+/      ALL BAUD RATES ARE SUPPORTABLE:
+
+/      110, 150, 300, 600, 1200, 2400, 4800, 9600, 19200.
+
+/      19200 BAUD IS ACHIEVED BY CUTTING JUMPER "W2" AND ADDING JUMPER  "W5" AND THEN
+/      SETTING THE BOARD FOR WHAT IS NORMALLY 9600 BAUD.  A WESTERN DIGITAL TR-1602-B
+/      OR  EQUIVALENT  UART  IS  REQUIRED TO SUPPORT 19200 BAUD;  MOST OF THE  RECENT
+/      PRODUCTION  DEC M8655 BOARDS USE THE SMC COMM 2017 UART WHICH MEETS OR EXCEEDS
+/      THIS REQUIREMENT.   EARLY  M8655 BOARDS USE GI UARTS IN CERAMIC PACKAGES WHICH
+/      *CANNOT* BE USED AT 19200 BAUD (MANY ARE FLAKY AT 9600 BAUD!).
+
+/      RECEIVE BAUD RATE SHOULD  BE IDENTICAL TO TRANSMIT BAUD RATE.  (DO NOT SET THE
+/      RECEIVE=150 BAUD SWITCH!)
+\f/     OTHER INTERFACES:
+
+/      DKC-8/A (8/A OPTION BOARD #1)  INTERFACES  SHOULD  BE SETUP AS PER THE KL8-J/A
+/      SPECIFICATIONS INCLUDING THE REQUIREMENTS OF THE UART.  SOME DEC DOCUMENTATION
+/      INDICATED A PROHIBITION ON THE USE OF  19200 BAUD, BUT THIS IS OBVIATED BY THE
+/      USE OF THE SAME UARTS AS IN THE KL8-J/A.
+
+/      EARLIER DEVICES SUCH AS PT08, DP-12, KL-8/F OR DC02 (CHANNEL ZERO ONLY) SHOULD
+/      WORK CORRECTLY AS FACTORY WIRED (MOST OF THESE DEVICES  DO NOT SUPPORT OPTIONS
+/      KERMIT-12  WOULD  REQUIRE  TO  BE  DISABLED  ANYWAY.    THESE  INCLUDE  PARITY
+/      GENERATION,  FRAMING  ERROR  DETECTION,  ETC.).  TO UTILIZE THESE DEVICES, THE
+/      ASSEMBLY PARAMETERS  FOR  USER DEVICES AND THEIR RESPECTIVE DEVICE CODE VALUES
+/      SHOULD BE GIVEN  DURING  ASSEMBLY  (SEE ASSEMBLY INSTRUCTIONS).  PROPER DEVICE
+/      CODE VALUES MUST BE  OBTAINED  FOR  THE  SELECTED INTERFACE, AS THERE ARE MANY
+/      ACTUAL POSSIBILITIES.  (DP-12 DEVICES  ARE  GENERALLY DEVICE 40/41;  PT08/DC02
+/      INTERFACES ARE GENERALLY DEVICE 11/12, ETC.)
+\f/     ASSEMBLY INSTRUCTIONS.
+
+/      KERMIT-12 CAN BE ASSEMBLED BY EITHER OF TWO METHODS:
+
+
+/      P?S/8 METHOD:
+
+/      ASSUMING THE EXTENDED-LENGTH FILE KERM12 IS  THE  SOURCE  FILE,  THE FOLLOWING
+/      COMMAND WILL PRODUCE A FULLY ORNAMENTED LISTING:
+
+/      .PAL KB1,KB2,KB3,KB4<KERM12(ACEJLMNPQSX8)
+
+/      OPTION SWITCH BREAKDOWN:
+
+/      /A      ALL SYMBOLS IN SYMBOL PRINTOUT.
+
+/      /C      OPTIMIZE  CORE  DURING ASSEMBLY FOR MORE SYMBOLS,  LESS  BUFFERS.
+/              THIS OPTION SHOULD BE DELETED IF MORE THAN  8K  IS  AVAILABLE FOR
+/              ASSEMBLY.
+
+/      /E      FORGET LITERAL BOUNDARIES WHEN LEAVING THE CURRENT PAGE.
+
+/      /J      *DO NOT* TERMINATE TEXT STRINGS WITH EXTRA ZERO WORD.
+
+/      /L      PERFORM SECOND-PASS LISTING.
+
+/      /M      CHAIN TO MAP FOR BITMAP OUTPUT AT END OF ASSEMBLY.
+
+/      /N      ENABLE NEATNESS ADORNMENTS TO LISTING OUTPUT.
+
+/      /P      ENABLE PRINTER-ORIENTED (WIDE MODE) LISTING OUTPUT.
+
+/      /Q      ENABLE LITERALS ONLY, GENERATED LINKS ARE ERRORS.
+
+/      /S      ENABLE SYMBOL TABLE PRINTOUT.
+
+/      /X      ENABLE CROSS-REFERENCE OUTPUT AT END OF ASSEMBLY.
+
+/      /8      ENABLE FULL SYMBOL TABLE INCLUDING LINC MODE CROSS ASSEMBLY.
+
+/      THE NUMBER OF BINARY FILES REQUIRED (KB1, KB2, KB3, ETC.) IS  TO BE DETERMINED
+/      AT ASSEMBLY TIME, AS KERMIT-12 WILL TEND TO GROW LARGER AS FEATURES ARE ADDED.
+
+/      P?S/8 PAL IS THE PREFERRED METHOD  OF ASSEMBLING K12MIT DURING DEVELOPMENT DUE
+/      TO SUPERIOR ERROR DIAGNOSTICS AND OVERALL SPEED.   K12MIT COULD GROW TO A SIZE
+/      BEYOND THE CAPABILITIES OF OS/8 CREF.  THIS  LIMITATION  CANNOT  APPLY  TO THE
+/      P?S/8 DEVELOPMENT ENVIRONMENT.
+
+/      P?S/8 PAL CAN PRODUCE A LISTING OF K12MIT, BUT THE BINARY FILES CREATED BY THE
+/      ASSEMBLY  MUST BE TRANSFERRED TO AN OS/8 ENVIRONMENT FOR USE, SINCE K12MIT (AS
+/      SPECIFICALLY WRITTEN) IS FOR THE OS/8 FAMILY OF SYSTEMS ONLY.
+
+/      NOTE:  P?S/8 IS *NOT* A DEC PRODUCT;  IT IS SOLD COMMERCIALLY AND IS AVAILABLE
+/      FREE  OF  CHARGE (EXCEPT FOR MEDIA HANDLING CHARGES, ETC.) *ONLY* TO QUALIFIED
+/      INSTITUTIONS.  CONTACT CJL FOR ADDITIONAL INFORMATION ON ACQUIRING P?S/8.
+\f/     OS/8 FAMILY OF SYSTEMS METHOD:
+
+/      K12MIT.PA CAN BE ASSEMBLED WITH PAL8 VERSION B0 WHICH IS AVAILABLE FROM  DECUS
+/      AS PART OF THE OS/278 RELEASE.  PAL8 VERSION B0 WILL RUN ON  ANY  OS/8  FAMILY
+/      SYSTEM,  AS  IT  HAS  NO  HARDWARE  DEPENDENCIES  BEYOND  THE  ORIGINAL  PDP-8
+/      REQUIREMENT (NO BSW OR IAC ROTATE OR CAF OR R3L INSTRUCTIONS AS WAS INTENDED).
+/      THIS ALSO APPLIES TO CREF  VERSION B0 WHICH IS REQUIRED WHEN A CROSS-REFERENCE
+/      IS REQUESTED.  PAL8 VERSION B0  AND  CREF  VERSION B0 ARE AVAILABLE AS PART OF
+/      THE KERMIT-12 DISTRIBUTION AS K12PL8.ENC AND K12CRF.ENC RESPECTIVELY.  SEE THE
+/      DOCUMENTATION OF K12DEC FOR INFORMATION ON PRODUCING PAL8.SV  AND CREF.SV FROM
+/      THESE ENCODED FILES.
+
+/      ASSUMING CCL IS ENABLED, THE FOLLOWING COMMAND WILL PRODUCE A BINARY AND FULLY
+/      ORNAMENTED LISTING:
+
+/      .PAL DEV:K12MIT.BN,DEV:K12MIT.LS,DEV:KSCR.TM<DEV:PARAM.PA,DEV:K12MIT.PA(CEFMW)
+
+/      DEV:  IS THE APPLICABLE DEVICE WHERE THE FILES RESIDE.    STANDARD  EXTENSIONS
+/      ARE  ASSUMED  (.BN  FOR  BINARY, .LS FOR LISTING, .PA FOR PAL  SOURCE).    THE
+/      KSCR.TM  TEMPORARY  OUTPUT FILE SPECIFICATION IS OPTIONAL, BUT IS DEFAULTED TO
+/      SYS:CREFLS.TM IF  NOT  EXPLICITLY GIVEN.  MANY SYSTEM DEVICES ARE TOO SMALL TO
+/      SUPPORT THIS TEMPORARY  FILE,  THUS  THE  FILE  MAY  BE  DIRECTED  TO  ANOTHER
+/      AVAILABLE DEVICE WITH SUFFICIENT SPACE.
+
+/      THE PARAM.PA FILE IS OPTIONAL AND USED TO PASS SHORT USER PARAMETERS, ETC.  TO
+/      THE ASSEMBLY.
+
+/      OPTION SWITCH BREAKDOWN:
+
+/      /C      CHAIN TO CREF.SV TO PRODUCE A CROSS-REFERENCED LISTING FILE.
+
+/      /E      GENERATED LINKS ARE ERRORS.
+
+/      /F      *DO NOT* TERMINATE TEXT STRINGS WITH EXTRA ZERO WORD.
+
+/      /M      USE MAMMOTH SYMBOL TABLE OPTION FOR CREF.
+
+/      /W      FORGET LITERAL BOUNDARIES WHEN LEAVING THE CURRENT PAGE.
+
+/      LOADING INSTRUCTIONS:
+
+/      .LOAD DEV:K12CLR,K12MIT.BN      THIS LOADS THE BINARY CLEAR AND KERMIT
+/      .SAVE DEV K12MIT.SV=1           THIS SAVES THE CORE IMAGE
+
+/      THE  JOB STATUS WORD (=1) INDICATED THAT K12MIT.SV LOADS INTO 10000-11777, BUT
+/      SHOULD NOT BE SAVED/RESTORED  WHEN  THE  USR  IS  LOADED  OVER  THIS  AREA  OR
+/      DISMISSED (THE USR IS ACTUALLY  NEVER  DISMISSED  IN NORMAL K12MIT OPERATION).
+/      OTHER BITS MAY BE SET AT  THE  USER'S  OPTION,  BUT  ARE UNNECESSARY;  THE BIT
+/      INDICATED SERVES ONLY TO REDUCE SYSTEM OVERHEAD  REGARDING  THE DISPOSITION OF
+/      10000-11777.  THE  BINARY  FILE  K12CLR.BN  (CREATED  BY ASSEMBLING K12CLR.PA)
+/      LOADS ZEROES INTO ALL  OF  MEMORY  TO  CREATE A "CLEAN" CORE IMAGE FILE, WHICH
+/      MAKES THE ENCODED BINARY FILE SMALLER DUE TO REPEAT COMPRESSION.
+\f/     PASSING SHORT PARAMETER FILES.
+
+/      WHEN INSERTING A SHORT USER MODIFICATION FILE IN THE INPUT STREAM  (PARAM.PAL)
+/      THE FOLLOWING SHOULD BE NOTED:
+
+/      ALWAYS  PUT  THE  SHORT  PARAMETER  FILE  (CONTAINING EQUATED SYMBOLS SUCH  AS
+/      USER=1, ETC.) IN FRONT OF K12MIT.PAL.
+
+/      IF TTY:  IS USED FOR DIRECT TYPE-IN OF THESE  PARAMETERS, THE INFORMATION NEED
+/      ONLY BE TYPED ENDING WITH <^Z> DURING PASS 1.  SUBSEQUENT  PASSES  REQUIRE THE
+/      ENDING <^Z> ONLY.  IF THIS METHOD IS USED, A LISTING WITHOUT  THE  USER  INPUT
+/      WHICH  DID THE CUSTOMIZING OF KERMIT-12 CAN BE CREATED.  NOTE:  IF  BINARY  IS
+/      GENERATED BY THE CONTENTS OF THE PARAMETER FILE (SUCH AS USE OF THE LOCAL TEXT
+/      MESSAGE,  ETC.),  THE  INFORMATION MUST BE TYPED IN DURING PASS 2.  THE PASS 3
+/      LISTING MAY  CONTAIN  THE INFORMATION IF SO DESIRED, REQUIRING A REPETITION OF
+/      THE INPUT.   PASS  1  INPUT  OF  THE INFORMATION IS EFFECTIVELY IGNORED, AS NO
+/      DEFINITIONS ARE CREATED ('LCLMSG' IS DEFINED ELSEWHERE, ETC.).
+
+/      EXPERIENCED PDP-8 USERS NEW TO PAL8 VERSION B0 TAKE SPECIAL NOTICE:
+
+/      DUE TO HARDWARE LIMITATIONS OF THE DECMATES, THE KEYBOARD FLAG WILL BE CLEARED
+/      DURING PDP-8 PAL8 B0 OPERATION.  THE KL8E TTY:  HANDLER WILL NO LONGER BE ABLE
+/      TO BUFFER <^Z> DURING THE ASSEMBLY;  YOU MUST  WAIT UNTIL THE HANDLER ACCESSES
+/      THE KEYBOARD ON EACH PASS *THEN* PRESS <^Z> TO CONTINUE THE ASSEMBLY.
+
+
+/      CREATING A CUSTOM MESSAGE FROM THE PARAMETER FILE.
+
+/      IF  SO  DESIRED,  A CUSTOM LOCAL HEADER MESSAGE MAY BE ADDED BY INSERTING  THE
+/      FOLLOWING INTO THE PARAMETER FILE:
+
+/      BUFFLD= 10              /THESE PROBABLY
+/      FILBUFF=2000            /WON'T CHANGE!
+
+/      GENMSG= 0               /DON'T GENERATE STANDARD (NULL) MESSAGE
+/      UMSG=   0               /DON'T GENERATE STANDARD (DUMMY) USER MESSAGE
+
+/      FIELD   BUFFLD%10       /FIELD FOR TEXT MESSAGE
+
+/      *FILBUFFER              /LOCAL MESSAGE LOADS THERE
+
+/LCLMSG,TEXT   "%^I^NSERT ^L^OCAL ^M^ESSAGE ^H^ERE!%"
+
+/      ZBLOCK  LCLMSG+40-.     /ZERO REST OF MESSAGE AREA
+
+/      TEXT IS IN  UPPER/LOWER-CASE  SIXBIT  WITH  '^'  MEANING SHIFT CASE (INITIALLY
+/      LOWER-CASE) AND '%' MEANING <CR>, <LF>.
+\f/     OTHER METHODS:
+
+/      KERMIT-12  *CANNOT*  BE ASSEMBLED  BY  PAL10  (LAST  KNOWN  VERSION  OF  PDP-8
+/      CROSS-ASSEMBLER FOR TOPS10 (142)) BECAUSE IT LACKS CERTAIN FEATURES:
+
+/      DOES NOT SUPPORT 'RELOC' PSEUDO-OP.
+
+/      DOES NOT SUPPORT PAGE ZERO  REDEFINE  (CAUSES  "Z" ERROR ON SOURCE FILES WHICH
+/      DON'T HAVE ERRORS WHEN ASSEMBLED BY EITHER P?S/8 PAL OR OS/8 PAL8).
+
+/      INCORRECTLY HANDLES 'ZBLOCK' PSEUDO-OP (LEADS TO  "Q"  ERROR  ON  SOURCE FILES
+/      WHICH DON'T HAVE ERRORS WHEN ASSEMBLED BY EITHER P?S/8 PAL OR OS/8 PAL8).
+
+/      DOES NOT SUPPORT LITERAL "FORGETTING" (P?S/8 PAL OPTION /E OR OS/8 PAL8 OPTION
+/      /W) WHICH IS REQUIRED FOR DEFINING OVERLAY AREAS, ETC.
+
+/      DOES NOT SUPPORT TEXT WITHOUT ZERO WORD FILL (P?S/8 PAL OPTION /J OR OS/8 PAL8
+/      OPTION /F FULFILLS THIS REQUIREMENT) WHICH IS REQUIRED FOR TEXT MESSAGES.
+
+
+/      P?S/8 PAL IS AN IMPROPER SUPERSET OF PAL10.  PAL10 SUPPORTS MACRO-8 MODE AS AN
+/      OPTION AND AUTOMATIC FIELD DUMP BITMAPS;  ALL OTHER KNOWN PAL10 FEATURES EXIST
+/      IN  P?S/8  PAL  INCLUDING  THE  SUPPORT  OF  THE  AUTOMATIC FIELD DUMP  BITMAP
+/      PSEUDO-OPS ('ENBITS' AND 'NOBITS').
+
+/      OS/8  PAL8 (VERSION B0) IS A SUBSET OF P?S/8 PAL WHICH HAS  SEVERAL  SYNTACTIC
+/      QUIRKS (WHICH  ARE AVOIDABLE, BUT NONETHELESS ARE INCOMPATIBLE WITH BOTH P?S/8
+/      PAL  AND  PAL10    IN  CERTAIN  MINOR  WAYS);    REGARDLESS,  PAL8  LACKS  THE
+/      COMPATIBILITY PROBLEMS OF PAL10.
+
+/      MAINTAINING SOURCE COMPATIBILITY.
+
+/      KERMIT-12 SOURCE FILE CONVENTIONS DEMAND THE USE OF THE COMMON SUBSET OF P?S/8
+/      PAL AND OS/8 PAL8 (VERSION  B0).    CERTAIN  FORMS  OF  STATEMENTS  SHOULD  BE
+/      AVOIDED:
+
+/      TAD                     /NOT LEGAL IN PAL8
+/      0+TAD                   /NOT LEGAL IN PAL10, AND POSSIBLY WRONG IN PAL8
+/      TAD     (3)+1           /GENERATES SAME AS "TAD (3+1)" IN PAL8
+/      -A!-B                   /UNARY OPERATOR HANDLED WRONG IN PAL8
+/      I+N                     /NOT LEGAL IN PAL8
+/      N+I                     /NOT LEGAL IN PAL8
+/      I I                     /NOT LEGAL IN PAL8
+
+/      THIS  REQUIREMENT IS EASILY MET BY  KERMIT-12  AS  MOST  OF  THESE  CASES  ARE
+/      ESOTERIC QUIRKS AND NOT NEEDED FOR THIS ASSEMBLY.
+
+/      THE RESTRICTIONS OF PAL10 (EVEN THOUGH IT  HAS  OTHER DESIRABLE FEATURES, MOST
+/      OF WHICH IT SHARES WITH P?S/8 PAL) ARE  TOO SEVERE TO ALLOW USABLE ASSEMBLY OF
+/      THIS  PROGRAM.    BETTER  CROSS-ASSEMBLERS  MAY  EXIST  ELSEWHERE  WHICH   ARE
+/      SOURCE-COMPATIBLE WITH KERMIT-12.
+\f/     USE OF P?S/8 LANGUAGE EXTENSIONS.
+
+/      P?S/8 OFFERS SEVERAL USEFUL FEATURES OVER PAL8 (AND PAL10) WHICH MAY BE USEFUL
+/      FOR  ASSEMBLY  DEVELOPMENT OF KERMIT-12.  THESE INCLUDE LANGUAGE ELEMENTS SUCH
+/      AS "TAD (3)+1" HANDLED CORRECTLY, OR PSEUDO-OPS SUCH AS "PAUSE EXPR" WHERE THE
+/      VALUE OF 'EXPR'  WILL  BE  DISPLAYED ON THE SYSTEM CONSOLE DURING THE ASSEMBLY
+/      WHEN THAT POINT IN  THE  ASSEMBLY  IS  REACHED.   TO ACCESS THESE FEATURES AND
+/      STILL  PROVIDE COMPATIBILITY WITH PAL8  (VERSION  B0),  THE  FOLLOWING  CODING
+/      TECHNIQUE IS SUGGESTED:
+
+
+/      IFNDEF  PQS     <PQS=0> /WILL BE 0 ON PAL8, PAL10
+
+
+/      IFZERO  PQS     <       /DO PAL8, ETC. STUFF HERE
+
+/      FOO=    (TABLE)         /DEFINE POINTER TO ADDRESS OF TABLE
+
+/      TAD     FOO-1           /GET (POINTER TO ADDRESS OF TABLE)-1
+/      DCA     XR1             /SETUP AUTO-INDEX REGISTER
+
+/      WISH WE HAD PAUSE AND ERROR PSEUDO-OPS IN PAL8.
+
+/                      >       /END OF PAL8, ETC. VARIANT
+
+
+/      IFNZRO  PQS     <       /DO P?S/8 PAL STUFF HERE
+
+/      TAD     (TABLE)-1       /GET (POINTER TO ADDRESS OF TABLE)-1
+/      DCA     XR1             /SETUP AUTO-INDEX REGISTER
+
+/      IFNDEF  PASS    <PASS=0>/DEFINE PASS VARIABLE
+
+/      PASS=   PASS+1          /BUMP EVERY ASSEMBLER PASS
+
+/      PAUSE   PASS            /DISPLAY PASS NUMBER
+
+/      IFNZRO  .&4000  <
+
+/      ERROR   1234            /DISPLAY ERROR MESSAGE IF THERE ARE PROBLEMS
+
+/                      >
+
+/                      >       /END OF P?S/8 PAL VARIANT
+
+
+/      THIS ALLOWS TEMPORARY DEVELOPMENT FEATURES OR  PERMANENT ELEMENTS WHICH MAY BE
+/      MORE ELEGANTLY EXPRESSED IN P?S/8 PAL VARIANT  CODING, WHILE THE PAL8 (VERSION
+/      B0) VERSION CAN STILL BE USED (VIA DIRECT  OCTAL,  MULTIPLE EQUATE STATEMENTS,
+/      CONDITIONAL FLUSH AS IN THE ABOVE EXAMPLE, ETC.   AS  NECESSARY)  FOR STANDARD
+/      ASSEMBLY OF KERMIT-12.
+\f/     ASSEMBLY PARAMETERS.
+
+/      SEVERAL  PARAMETERS  MUST  BE  CHANGED  WITHIN  K12MIT.PA  (OR  PASSED TO  THE
+/      ASSEMBLER VIA A SHORT FILE INSERTED INTO THE ASSEMBLY STREAM BEFORE  THE  MAIN
+/      FILE):
+
+/      SETTING  KEY= [RECEIVE IOT CODE FOR  CONSOLE  KEYBOARD]  DEFINES  THE  CONSOLE
+/      KEYBOARD IOT CODE (DEFAULT IS 03).
+
+/      SETTING  TTY=  [TRANSMIT  IOT CODE FOR CONSOLE  OUTPUT]  CHANGES  THE  CONSOLE
+/      PRINTER IOT CODE (DEFAULT IS 04).
+
+/      THE FOLLOWING DEFINITIONS ARE  ESSENTIALLY  FOR  KL8-TYPE DEVICES ONLY, AS THE
+/      CODE DEMANDS KL8 HARDWARE COMPATIBILITY.    MODELS  OTHER  THAN PDP-8 (SUCH AS
+/      DECMATE) GENERALLY EITHER PLACE RESTRICTIONS ON  AVAILABLE  INTERFACES  (OTHER
+/      SOFTWARE DESIGNATES A SERIAL INTERFACE AS A  LOGICAL  PRINTER  PORT;  DECMATES
+/      SUPPORT A FIRMWARE "PRINT SCREEN" KEY WHICH ENFORCES  THIS.),  OR  DON'T ALLOW
+/      USABLE PLUG-IN OPTIONS.
+
+/      IGNORING BUILT-IN DECMATE SUPPORT, THE FOLLOWING PARAMETERS ARE ACTIVE:
+
+/      SETTING DEV30=  1       CREATES DEVICE 30/31 REMOTE LINE IOTS.
+
+/      SETTING DEV40=  1       CREATES DEVICE 40/41 REMOTE LINE IOTS.
+
+/      SETTING LEDERLE=1       CREATES DEVICE 43/44  REMOTE  LINE  IOTS (AND A CUSTOM
+/                              HEADER).
+
+/      SETTING ORIGNAL=1       CREATES  DEVICE  33/34  REMOTE   LINE  IOTS  (ORIGINAL
+/                              SETTINGS).
+
+/      SETTING SPRINT= 1       CREATES DEVICE 32/33 REMOTE LINE  IOTS (SERIAL PRINTER
+/                              PORT).
+
+/      SETTING USER=   1       CREATES DEVICE XX/XY REMOTE LINE IOTS.
+
+/      IF NONE OF THESE ARE SET, THEN DEV40=1 APPLIES BY DEFAULT.
+
+
+
+/      SETTING USER=   1       REQUIRES THE USER TO DEFINE TWO ADDITIONAL VALUES:
+
+/              XX=     [RECEIVE IOT DEVICE CODE] (DEFAULT IS 40).
+
+/              XY=     [TRANSMIT IOT DEVICE CODE] (DEFAULT IS 41).
+\f/     SETTING SPRINT= 1       INHIBITS THE BUILT-IN CHECK FOR DECMATE  OPERATION AND
+/                              USES    THE    SERIAL  PRINTER  PORT  FOUND  ON    ALL
+/                              WPS-8-CONFIGURED    PDP-8/E,  PDP-8/A  CONFIGURATIONS,
+/                              VT-78,  AND  ALL DECMATES (VT-278,  DECMATE  II,  III,
+/                              III+) FOR REMOTE COMMUNICATIONS.
+
+/      THE  USE OF THE SERIAL PRINTER PORT FOR REMOTE COMMUNICATIONS PURPOSES MAY  BE
+/      PROBLEMATIC DUE TO CONSIDERATIONS SUCH AS THE RS-232 CONNECTION TO THE PRINTER
+/      IS A  MODEM  (DCE), RATHER THAN A TERMINAL (DTE) (DECMATE II, ETC.  REQUIRES A
+/      GENDER CHANGER.), OR  THE SOFTWARE DESIGNATION OF THE PORT AS BEING ALLEDGEDLY
+/      *ONLY* FOR A PRINTER,  SUCH AS WHEN CERTAIN SYSTEMS SUPPORT THE "PRINT SCREEN"
+/      KEY AS A SCREEN DUMP  TO  THE  SERIAL PRINTER PORT, ETC.  THESE ISSUES ARE NOT
+/      RELEVANT TO KERMIT-12 OPERATION, AS THE "PRINT SCREEN" KEY IS NOT SUPPORTED BY
+/      KERMIT-12 IN THIS CONFIGURATION AS SUCH (FUTURE  VERSIONS  COULD  REDEFINE THE
+/      "PRINT SCREEN" KEY TO SUCH FUNCTIONS AS DUMP SCREEN TO A FILE, ETC.).
+
+/      SETTING BRATE= NN       SETS THE DEFAULT BAUD RATE (FOR  SYSTEMS  THAT SUPPORT
+/                              THIS  FEATURE)  FROM  A  TABLE  OF  VALUES  (0-15)  AS
+/                              FOLLOWS:
+
+/                              NN              BAUD RATE
+
+/                              00              50
+/                              01              75
+/                              02              110
+/                              03              134.5
+/                              04              150
+/                              05              300
+/                              06              600
+/                              07              1200
+/                              08              1800
+/                              09              2000
+/                              10              2400
+/                              11              3600
+/                              12              4800
+/                              13              7200
+/                              14              9600
+/                              15              19200
+
+/      SETTING ESCAPE= NNNN    SETS THE DEFAULT ESCAPE CHARACTER TO NNNN.
+
+/      SETTING FLOW=   1       ENABLES FLOW-CONTROL BY DEFAULT.
+/      SETTING FLOW=   0       DISABLES FLOW-CONTROL BY DEFAULT.
+
+/      SETTING FMODE=  0177    SETS THE DEFAULT FILE MODE TO ASCII.
+/      SETTING FMODE=  4377    SETS THE DEFAULT FILE MODE TO BINARY.
+\f/     SETTING GENMSG= 0       CAUSES  NO  BINARY TO BE GENERATED WHERE  'LCLMSG'  IS
+/                              DEFINED.  THIS ALLOWS THE PARAMETER FILE (PARAM.PA) OR
+/                              SUBSEQUENT  OVERLAY  BY  K12PCH.BN TO DEFINE THE LOCAL
+/                              HEADER MESSAGE.    THIS  PARAMETER  SHOULD  NOT BE SET
+/                              UNLESS ONE OF  THESE  METHODS IS USED, ELSE THE HEADER
+/                              MESSAGE  WILL BE UNDEFINED.    (NOTE:    IF  K12PCH.BN
+/                              GENERATES  A HEADER MESSAGE, THEN  THIS  PARAMETER  IS
+/                              UNIMPORTANT,  AS  K12PCH.BN  OVERLAYS  THE  BINARY  OF
+/                              K12MIT.)
+/      SETTING GENMSG= 1       CAUSES A HEADER MESSAGE TO BE GENERATED.  THE CONTENTS
+/                              OF  THE  MESSAGE  ARE CREATED BY SETTING LEDERLE=1  OR
+/                              UMSG=1.   IF EITHER IS ZERO, A DEFAULT (NULL)  MESSAGE
+/                              WILL BE GENERATED.
+
+/      SETTING ICLOSE= 1       ENSURES  A  <^Z>  AT  <EOF>  OF  ASCII  INPUT FILES BY
+/                              DEFAULT.
+/      SETTING ICLOSE= 0       CLOSES ASCII INPUT FILES AS RECEIVED BY DEFAULT.
+
+/      SETTING INIECHO=0       CAUSES A  FULL-DUPLEX CONNECT MODE STATE WITH NO LOCAL
+/                              CHARACTER ECHOING BY DEFAULT.
+/      SETTING INIECHO=1       CAUSES A HALF-DUPLEX  CONNECT  MODE  STATE  WITH LOCAL
+/                              ECHO OF ALL CONSOLE CHARACTERS BY DEFAULT.
+
+/      SETTING LOWER=  0       ALLOWS LOWER-CASE CONSOLE OUTPUT BY DEFAULT.
+/      SETTING LOWER=  -40     FOLDS  LOWER-CASE  CONSOLE  OUTPUT  TO  UPPER-CASE  BY
+/                              DEFAULT.
+
+/      SETTING OCLOSE= 0       PREVENTS DEFAULT SENDING OF <^Z>  AT  <EOF>  OF  ASCII
+/                              FILES.
+/      SETTING OCLOSE= 1       CAUSES  <^Z> TO BE SENT AT <EOF>  OF  ASCII  FILES  BY
+/                              DEFAULT.
+
+/      SETTING PORT=   0       CAUSES THE DP-278 PORT 0 TO BE USED  IF  KERMIT-12  IS
+/                              RUN ON A DECMATE 1 (ASSUMING SPRINT=0).
+/      SETTING PORT=   1       CAUSES  THE DP-278 PORT 1 TO BE USED IF  KERMIT-12  IS
+/                              RUN ON A DECMATE 1 (ASSUMING SPRINT=0).
+
+/      SETTING RETCNT= NNNN    SETS THE PACKET RETRY COUNT TO NNNN BY DEFAULT.
+/      SETTING UMSG=   0       PREVENTS THE  LOCAL  USER  HEADER  MESSAGE  FROM BEING
+/                              GENERATED.
+/      SETTING UMSG=   1       CAUSES THE LOCAL  USER HEADER MESSAGE TO BE GENERATED.
+/                              THE PARAMETER GENMSG=1 IS  REQUIRED  TO  BE  SET.  THE
+/                              SOURCE MUST BE MODIFIED LOCALLY  TO CHANGE THE MESSAGE
+/                              TEXT FROM "INSERT LOCAL USER MESSAGE  HERE!,"  AS THIS
+/                              IS THE DEFAULT CONTENTS.
+\f/     KERMIT-12 FOR THE FAMILY OF 12-BIT DEC MACHINES.
+
+/      BRIEF USAGE DESCRIPTION.
+
+/      KERMIT-12 IS AN IMPLEMENTATION OF THE KERMIT PROTOCOL FOR THE FAMILY OF 12-BIT
+/      DEC (AND COMPATIBLE) MACHINES GENERALLY KNOWN AS PDP-8 OR DECMATE.
+
+/      AS OF THE CURRENT IMPLEMENTATION, THE FOLLOWING COMMANDS ARE EFFECTIVE:
+
+/      1.      CONNECT (TO REMOTE SYSTEM AS TERMINAL).
+
+/      2.      SEND FILESPEC (TO REMOTE RECEIVER OR SERVER).
+
+/      3.      RECEIVE FILESPEC (FROM REMOTE SENDER).
+
+/      4.      GET FILESPEC (FROM REMOTE SERVER).
+
+/      5.      FINISH (SERVING).
+
+/      6.      SETUP (ON DECMATE II/III/III-PLUS ONLY). **** NOT IMPLEMENTED ****
+
+/      7.      EXIT (TO OPERATING SYSTEM).
+
+/      8.      HELP (DISPLAYS HELP MESSAGE).
+
+/      FILESPEC  MAY  BE  ANY LOCAL (OS/8) FILE-STRUCTURED DEVICE:FILENAME.EXTENSION,
+/      WHERE THE  FILENAME  AND  EXTENSION WILL BE TRUNCATED TO 6 ALPHANUMERICS AND 2
+/      ALPHANUMERICS RESPECTIVELY, AS  NECESSARY (THIS IS REFERRED TO AS 6.2 FILENAME
+/      FORMAT).  THE DEVICE:    FIELD  IS  OPTIONAL;   ALL COMMANDS USING THE DEVICE:
+/      FIELD FOR LOCAL DEVICE SPECIFICATION  WILL  USE  THIS  DEVICE AS THE SOURCE OR
+/      DESTINATION AS NECESSARY FOR THE LOCAL  FILES.    IF  THE  DEVICE:    FIELD IS
+/      OMITTED, THE DEFAULT DEVICE DSK:  WILL BE USED.  THE ACTUAL DEVICE USED MAY BE
+/      SELECTED BEFORE INVOKING KERMIT-12 BY USING THE OS/8 ASSIGN COMMAND:
+
+/      .ASSIGN DEV DSK
+
+/      WHERE DEV IS ANY AVAILABLE FILE-STRUCTURED DEVICE.
+
+/      KERMIT-12 USES AN UNUSUAL SCHEME FOR ITS PROMPT:    THE  ACTUAL DEFAULT PROMPT
+/      TEXT  IS  PARTIALLY  TAKEN  FROM  THE  ACTUAL MACHINE KERMIT-12  IS  CURRENTLY
+/      EXECUTING  ON.    FOR  EXAMPLE, IF KERMIT-12 HAS DETERMINED THE  CPU  TYPE  AS
+/      PDP-8/E, THE PROMPT WILL BE:
+
+/      KERMIT-8/E>
+
+/      THIS  ALLOWS KERMIT-12 USERS (WITH DIFFERENT CPU-TYPE MACHINES) TO DISTINGUISH
+/      MESSAGES ORIGINATING  FROM  THE  RESPECTIVE  SYSTEMS.    FUTURE  VERSIONS WILL
+/      SUPPORT USER PROMPT STRINGS TO ALLOW MORE DISTINCTIVE SYSTEM MESSAGES.
+
+/      THE HELP OR CONNECT COMMANDS MAY BE USED TO DETERMINE THE CURRENT CONNECT MODE
+/      ESCAPE CHARACTER.
+\f/     COMMAND RESTRICTIONS.
+
+/      THE  SEND  COMMAND  ALLOWS   DEVICE:FILENAME.EXTENSION  (6.2)  WITH  WILD-CARD
+/      SUBSTITUTION.  A * MAY  BE  GIVEN  FOR  AN  ENTIRE  FIELD  (EITHER FILENAME OR
+/      EXTENSION OR BOTH) ONLY.  A  ?    WILL  MATCH  ANY SINGLE CHARACTER WHICH MUST
+/      EXIST IN THE ACTUAL FILENAME OR EXTENSION,  UNLESS  RIGHT-MOST  IN  THE FIELD.
+/      ALL  MATCHING FILES WILL BE SENT.  NO  OUTBOUND  FILENAME  (AS-NAME)  FACILITY
+/      EXISTS AT THIS TIME.
+
+/      THE  RECEIVE  COMMAND  ALLOWS  OPTIONAL  DEVICE:   ONLY.   *THE  FILENAME  AND
+/      EXTENSION  ARE  NOT  ALLOWED*.  NAMES OF RECEIVED FILES WILL  BE  MODIFIED  IF
+/      NECESSARY  TO  CONFORM  TO  THE  6.2  FORMAT.   *IMPLEMENTATION RESTRICTION* :
+/      CERTAIN REMOTE  FILENAMES  CONTAINING  NON-ALPHANUMERIC  CHARACTERS  MAY CAUSE
+/      KERMIT-12 TO HASTILY ABORT THE TRANSMISSION AND RETURN TO COMMAND LEVEL.
+
+/      THE GET COMMAND  ALLOWS  OPTIONAL  DEVICE:    TO  DETERMINE DESTINATION OF THE
+/      INCOMING FILES.  THE  OUTBOUND  FILESPEC  MUST  CONFORM  TO  LOCAL CONVENTIONS
+/      (FILENAME AND EXTENSION ARE NOT  LIMITED  TO  6.2  FORMAT;  THE DEVICE:  FIELD
+/      WILL NOT BE SENT TO THE  REMOTE  KERMIT  UNLESS  IT  IS  ILLEGAL  WITHIN  OS/8
+/      SPECIFICATIONS, SUCH AS TOO MANY DEVICE LETTERS.    IN  THIS CASE, THE DEFAULT
+/      DEVICE DSK:  APPLIES, AND THE ENTIRE "DEVICE"  FIELD  IS  SENT  ALONG WITH ANY
+/      FILENAME  AND EXTENSION).  CERTAIN REMOTE SYSTEMS ARE INCOMPATIBLE  WITH  THIS
+/      IMPLEMENTATION,  AS  IMBEDDED  SPACES  OR  NON-ALPHANUMERIC CHARACTERS ARE NOT
+/      ALLOWED, EVEN  THOUGH  THEY  MAY  BE REQUIRED ON THE REMOTE SYSTEM.  WILD-CARD
+/      CHARACTERS ARE ALLOWED, BUT ONLY AS SPECIFIED IN THE SEND COMMAND ABOVE.
+
+/      <^X>  OR  <^Z>  CAN BE USED TO ABORT KERMIT TRANSMISSIONS (EVENTUALLY) BUT  IS
+/      NORMALLY  A  SLOW  PROCESS,  SINCE  THE CHECKING IS DONE BY A SOFTWARE TIMEOUT
+/      SCHEME.   AT  THE  PRESENT  TIME,  THERE  IS  NO DISTINCTION BETWEEN THESE THO
+/      CHARACTERS, SO IT  IS NOT POSSIBLE TO ABORT A SINGLE FILE; THE ENTIRE BATCH OF
+/      FILES INVOLVED IN THE TRANSFER IS ABORTED.
+
+/      DECMATE II/III/III-PLUS CONSIDERATIONS:
+
+/      FUNCTION KEYS SEND <ESC>  SEQUENCES SPECIFIED BY SLUSHWARE/FIRMWARE.  ALL SOFT
+/      FUNCTION KEYS ARE THEREFORE INEFFECTIVE  (EXCEPT  FOR HOLD SCREEN WHICH ALWAYS
+/      WORKS).
+
+/      CONNECT MODE RUNS IN 8-BIT MODE.
+
+/      THE COMPOSE KEY IS ENABLED FOR USE WITH A LOADED COMPOSE TABLE.
+
+/      ANY VALID DECMATE II/III/III-PLUS CHARACTER SET  IS  ALLOWED  WHILE IN CONNECT
+/      MODE  (MCS  TCS  LINE,  ETC.).    ALL   <ESC>  SEQUENCES  ARE  PASSED  TO  THE
+/      SLUSHWARE/FIRMWARE UNMODIFIED.
+
+/      KEYBOARD UPPER-CASE LOCK WILL ALWAYS BE AUTOMATICALLY APPLIED UPON RETURN FROM
+/      CONNECT MODE.
+\f/     DEFINITIONS.                                                    /017 CJL
+
+       *200                                    /FOR DEFINITIONS        /047 CJL
+
+/      REMOTE LINE PARAMETERS; SET ONLY ONE AS NECESSARY.              /046 CJL
+
+       IFNDEF  DEV30   <DEV30= 0>              /USE DEVICE 30/31 VALUES
+       IFNDEF  DEV40   <DEV40= 0>              /USE DEVICE 40/41 VALUES
+       IFNDEF  LEDERLE <LEDERLE=0>             /USE LEDERLE LABS VALUES
+       IFNDEF  ORIGNAL <ORIGNAL=0>             /USE ORIGINAL VALUES
+       IFNDEF  SPRINT  <SPRINT=0>              /USE DEVICE 32/33 VALUES
+       IFNDEF  USER    <USER=  0>              /USE USER-DEFINED VALUES
+
+       REMOTE= DEV30+DEV40+LEDERLE+ORIGNAL     /SET REMOTE LINE IOT CODE
+       REMOTE= REMOTE+SPRINT+USER              /SET REMOTE LINE IOT CODE
+
+       IFZERO  REMOTE  <DEV40= 1>              /DEFAULT TO DEVICE 40/41 VERSION
+
+/      DEV30 PARAMETERS.
+
+       IFNZRO  DEV30                   <
+
+       IFNDEF  REC     <REC=   30>             /DEVICE 30 INPUT
+       IFNDEF  SEN     <SEN=   31>             /DEVICE 31 OUTPUT
+
+                                       >
+
+/      DEV40 PARAMETERS (DEFAULT).
+
+       IFNZRO  DEV40                   <
+
+       IFNDEF  REC     <REC=   40>             /DEVICE 40 INPUT
+       IFNDEF  SEN     <SEN=   41>             /DEVICE 41 OUTPUT
+
+                                       >
+
+/      LEDERLE PARAMETERS.                                             /038 CJL
+
+       IFNZRO  LEDERLE                 <
+
+       IFNDEF  REC     <REC=   43>             /DEVICE 43 INPUT
+       IFNDEF  SEN     <SEN=   44>             /DEVICE 44 OUTPUT
+       IFNDEF  GENMSG  <GENMSG=1>              /GENERATE LOCAL HEADER MESSAGE
+       IFNDEF  UMSG    <UMSG=  0>              /DON'T GENERATE USER MESSAGE
+
+                                       >
+
+/      ORIGNAL PARAMETERS.
+
+       IFNZRO  ORIGNAL                 <
+
+       IFNDEF  REC     <REC=   33>             /DEVICE 33 INPUT
+       IFNDEF  SEN     <SEN=   34>             /DEVICE 34 OUTPUT
+
+                                       >
+\f/     SPRINT PARAMETERS.                                              /046 CJL
+
+       IFNZRO  SPRINT                  <
+
+       IFNDEF  REC     <REC=   32>             /DEVICE 32 INPUT
+       IFNDEF  SEN     <SEN=   33>             /DEVICE 33 OUTPUT
+
+                                       >
+
+/      USER PARAMETERS.
+
+       IFNZRO  USER                    <
+
+       IFNDEF  XX      <XX=    40>             /DEFAULT TO DEVICE 40
+       IFNDEF  XY      <XY=    41>             /DEFAULT TO DEVICE 41
+       IFNDEF  REC     <REC=   XX>             /DEVICE XX INPUT
+       IFNDEF  SEN     <SEN=   XY>             /DEVICE XY OUTPUT
+       IFNDEF  GENMSG  <GENMSG=1>              /GENERATE LOCAL HEADER MESSAGE
+       IFNDEF  UMSG    <UMSG=  1>              /GENERATE USER MESSAGE
+
+                                       >
+
+/      REMOTE LINE IOT DEFINITIONS.
+
+/      RECEIVE DEFINITIONS.
+
+       RKRBIOT=REC^10+6006                     /READ REMOTE, CLEAR FLAG
+       RKSFIOT=REC^10+6001                     /SKIP ON REMOTE INPUT FLAG
+
+/      TRANSMIT DEFINITIONS.
+
+       RSBIOT= SEN^10+6003                     /SET BAUD RATE FROM AC[8-11]
+       RTLSIOT=SEN^10+6006                     /TRANSMIT CHARACTER, CLEAR FLAG
+       RTSFIOT=SEN^10+6001                     /SKIP ON TRANSMIT FLAG
+
+/      CONSOLE TTY: DEFINITIONS.                                       /017 CJL
+
+/      KEYBOARD DEFINITIONS.                                           /017 CJL
+
+       IFNDEF  KEY     <KEY=   03>     /KEYBOARD DEVICE CODE
+
+       KCCIOT= KEY^10+6002             /CLEAR CONSOLE KEYBOARD FLAG, AC
+       KRBIOT= KEY^10+6006             /READ CONSOLE KEYBOARD BUFFER, CLEAR FLAG
+       KRSIOT= KEY^10+6004             /READ CONSOLE KEYBOARD BUFFER STATIC
+       KSFIOT= KEY^10+6001             /SKIP ON CONSOLE KEYBOARD FLAG
+
+/      TELEPRINTER DEFINITIONS.                                        /017 CJL
+
+       IFNDEF  TTY     <TTY=   04>     /TELEPRINTER DEVICE CODE
+
+       TLSIOT= TTY^10+6006             /PRINT CHARACTER, CLEAR FLAG
+       TSFIOT= TTY^10+6001             /SKIP ON TELEPRINTER FLAG
+\f/     DEFAULT ESCAPE CHARACTER DEFINITION.                            /025 CJL
+
+       IFNDEF  ESCAPE  <ESCAPE="]&37>  /DEFAULT IS CONTROL-]
+
+/      DEFAULT LOWER-CASE ENABLE DEFINITION.                           /030 CJL
+
+       IFNDEF  LOWER   <LOWER= 0/-40>  /LOWER-CASE IS ALLOWED AS IS
+                                       /CHANGE TO -40 IF LOWER-CASE
+                                       /SHOULD BE FOLDED TO UPPER-CASE
+
+/      DEFAULT RETRY COUNT DEFINITION.                                 /031 CJL
+
+       IFNDEF  RETCNT  <RETCNT=5>      /DEFAULT IS FIVE RETRIES
+
+/      DEFAULT FILE MODE DEFINITION.                                   /031 CJL
+
+       IFNDEF  FMODE   <FMODE= 4377>   /DEFAULT IS ASCII FILE MODE
+                                       /4377 IS BINARY FILE MODE
+
+/      DEFAULT FLOW-CONTROL MODE DEFINITION.                           /031 CJL
+
+       IFNDEF  FLOW    <FLOW=  1>      /DEFAULT IS FLOW-CONTROL ENABLED
+
+/      DEFAULT ASCII INPUT FILE <^Z> DISPOSITION.                      /031 CJL
+
+       IFNDEF  ICLOSE  <ICLOSE=1>      /ENSURE <^Z> AT ASCII <EOF>
+
+/      DEFAULT ASCII OUTPUT FILE <^Z> DISPOSITION.                     /031 CJL
+
+       IFNDEF  OCLOSE  <OCLOSE=0>      /<^Z> NOT SENT AT ASCII <EOF>
+
+/      DEFAULT LOCAL MESSAGE GENERATION DEFINITIONS.                   /038 CJL
+
+       IFNDEF  GENMSG  <GENMSG=1>      /DEFAULT IS TO GENERATE A MESSAGE
+       IFNDEF  UMSG    <UMSG=  0>      /DEFAULT IS NO DUMMY USER MESSAGE
+       IFNDEF  LEDERLE <LEDERLE=0>     /DEFAULT IS NO LEDERLE MESSAGE
+
+/      THE NULL MESSAGE WILL BE GENERATED BY DEFAULT.
+
+/      ECHO DEFINITION.                                                /039 CJL
+
+       IFNDEF  INIECHO <INIECHO=0>     /DEFAULT IS NO LOCAL ECHO
+
+/      DEFAULT DECMATE I PORT DEFINITION.                              /050 CJL
+
+       IFNDEF  PORT    <PORT=  0>      /DEFAULT IS PORT ZERO 
+
+/      DEFAULT BAUD RATE DEFINITION.                                   /050 CJL
+
+       IFNDEF  BRATE   <BRATE= 7>      /DEFAULT IS 1200 BAUD
+\f/     STATE DEFINITIONS.
+
+       STDAT=  "D&137                  /DATA
+       STACK=  "Y&137                  /ACK
+       STNAK=  "N&137                  /NAK
+       STSIN=  "S&137                  /SEND-INIT
+       STBRK=  "B&137                  /BREAK LINK
+       STFIL=  "F&137                  /FILENAME HEADER
+       STEOF=  "Z&137                  /END OF FILE OR REPLY
+       STERR=  "E&137                  /ERROR PACKET
+       STATT=  "A&137                  /FILE ATTRIBUTES
+       STRIN=  "R&137                  /RECEIVE-INIT
+       STEOT=  "B&137                  /BREAK TRANSMISSION
+       STGEN=  "G&137                  /KERMIT GENERIC COMMAND
+
+/      DEFAULT INIT PARAMETERS.
+
+       DEFCK=  "1&177                  /DEFAULT 1 CHARACTER CHECKSUM   /014 CJL
+       DEFEOL= 15+40                   /CR IS DEFAULT <EOL>
+       DEFQCTL= "#&177                 /"#" IS DEFAULT QCTL
+
+/      BUFFER DEFINITIONS.                                             /014 CJL
+
+       DECIMAL                         /MAKE IT EASIER                 /014 CJL
+
+       DEFMAXL=94                      /DEFAULT MAXIMUM PACKET SIZE
+
+       LINSIZ= 32                      /KEYBOARD LINE BUFFER SIZE
+
+       OCTAL                           /BACK TO NORMAL                 /014 CJL
+
+       BUFSIZE=200                     /128 CHARACTER RING BUFFERS     /026 CJL
+                                       /FOR NO-INTERRUPT CONNECT MODE
+\f/     CONTROL CHARACTER DEFINITIONS.                                  /023 CJL
+
+       CNTRLA= "A&37                   /<^A> DEFAULT MARK CHARACTER    /023 CJL
+       CNTRLB= "B&37                   /<^B>                           /046 CJL
+       CNTRLC= "C&37                   /<^C> PROGRAM EXIT CHARACTER    /023 CJL
+       CNTRLD= "D&37                   /<^D>                           /046 CJL
+       CNTRLE= "E&37                   /<^E>                           /046 CJL
+       CNTRLF= "F&37                   /<^F>                           /046 CJL
+       CNTRLG= "G&37                   /<^G> BELL CHARACTER            /023 CJL
+       CNTRLH= "H&37                   /<^H> BACKSPACE CHARACTER       /023 CJL
+       CNTRLI= "I&37                   /<^I> HORIZONTAL TAB CHARACTER  /043 CJL
+       CNTRLJ= "J&37                   /<^J> LINEFEED CHARACTER        /023 CJL
+       CNTRLK= "K&37                   /<^K> VERTICAL TAB CHARACTER    /046 CJL
+       CNTRLL= "L&37                   /<^L> FORM FEED CHARACTER       /046 CJL
+       CNTRLM= "M&37                   /<^M> CARRIAGE RETURN CHARACTER /023 CJL
+       CNTRLN= "N&37                   /<^N>                           /046 CJL
+       CNTRLO= "O&37                   /<^O> ECHO FLIP CHARACTER       /023 CJL
+       CNTRLP= "P&37                   /<^P> PROGRAM RESTART CHARACTER /023 CJL
+       CNTRLQ= "Q&37                   /<^Q> OUTPUT RESUME CHARACTER   /023 CJL
+       CNTRLR= "R&37                   /<^R>                           /046 CJL
+       CNTRLS= "S&37                   /<^S> OUTPUT WAIT CHARACTER     /023 CJL
+       CNTRLT= "T&37                   /<^T>                           /046 CJL
+       CNTRLU= "U&37                   /<^U>                           /046 CJL
+       CNTRLV= "V&37                   /<^V>                           /046 CJL
+       CNTRLW= "W&37                   /<^W>                           /046 CJL
+       CNTRLX= "X&37                   /<^X> FILE ABORT CHARACTER      /044 CJL
+       CNTRLY= "Y&37                   /<^Y>                           /046 CJL
+       CNTRLZ= "Z&37                   /<^Z> ABORT AND <EOF> CHARACTER /044 CJL
+       DELETE= 177                     /<DEL> DELETE OR <RO> CHARACTER /034 CJL
+       LOWERC= "C&177+40               /LOWER-CASE C (CLOSE CHARACTER) /025 CJL
+       UPPERC= "C&177                  /UPPER-CASE C (CLOSE CHARACTER) /025 CJL
+
+/      I/O AND FIELD DEFINITIONS.                                      /019 CJL
+
+       BUFFLD= 10                      /I/O BUFFER FIELD               /019 CJL
+       DIRFLD= 10                      /DIRECTORY LOOKUP BUFFER FIELD  /028 CJL
+       DMIFLD= 10                      /DECMATE ONCE-ONLY CODE FIELD   /046 CJL
+       MSGFLD= 10                      /TEXT MESSAGE FIELD             /023 CJL
+       PAGCNT= 2                       /I/O BUFFER SIZE IN PAGES       /019 CJL
+       PRGFLD= 00                      /PROGRAM FIELD                  /019 CJL
+       USRFLD= 10                      /USR FIELD                      /020 CJL
+
+/      OS/8 MONITOR DEFINITIONS.                                       /014 CJL
+
+       SBOOT=  7600                    /MONITOR EXIT LOCATION IS 07600 /014 CJL
+       USR=    7700                    /NON-LOCKED USR ENTRY POINT     /035 CJL
+\f/     USER SERVICE ROUTINE AND HANDLER DEFINITIONS.                   /020 CJL
+
+       CLOSE=  4                       /CLOSE TENTATIVE OUTPUT FILE    /020 CJL
+       ENTER=  3                       /ENTER TENTATIVE OUTPUT FILE    /020 CJL
+       FETCH=  1                       /FETCH HANDLER                  /020 CJL
+       INQUIRE=12                      /INQUIRE ABOUT HANDLER          /020 CJL
+       LOOKUP= 2                       /LOOKUP FILE                    /020 CJL
+       RESET=  13                      /RESET DEVICE CONTROL WORD TABLE/037 CJL
+       USRIN=  10                      /LOCK USR IN CORE               /020 CJL
+       WRITE=  4000                    /I/O CALL WRITE BIT             /020 CJL
+
+/      INSTRUCTION DEFINITIONS.
+
+       CLCL=   6136                    /CLEAR CLOCK FLAG (8/A, ETC.)   /046 CJL
+       CLSK=   6131                    /SKIP ON, CLEAR CLOCK FLAG      /046 CJL
+       CLSK8A= 6137                    /SKIP ON CLOCK FLAG (8/A, ETC.) /046 CJL
+       COM=    0017                    /COMPLEMENT AC
+       DCAC=   DCA     .               /CURRENT PAGE DCA INSTRUCTION   /047 CJL
+       IAAC=   6171                    /"A" REGISTER TO AC
+       IACA=   6167                    /AC TO "A" REGISTER
+       ISZC=   ISZ     .               /CURRENT PAGE ISZ INSTRUCTION   /050 CJL
+       JMPC=   JMP     .               /CURRENT PAGE JMP INSTRUCTION   /047 CJL
+       JMPIC=  JMP I   .               /CURRENT PAGE JMP I INSTRUCTION /047 CJL
+       JMSC=   JMS     .               /CURRENT PAGE JMS INSTRUCTION   /047 CJL
+       JMSIC=  JMS I   .               /CURRENT PAGE JMS I INSTRUCTION /047 CJL
+       LINC=   6141                    /GOTO LINC MODE
+       PDP=    0002                    /GOTO PDP-8 MODE
+       PRQ3=   6236                    /TYPE THREE PANEL REQUEST       /046 CJL
+       TADC=   TAD     .               /CURRENT PAGE TAD INSTRUCTION   /047 CJL
+       R3L=    7014                    /ROTATE AC (NOT LINK) LEFT 3    /046 CJL
+
+/      NUMERIC LOAD DEFINITIONS.                                       /014 CJL
+
+       NL0000= CLA                     /LOAD AC WITH 0000              /046 CJL
+       NL0001= CLA IAC                 /LOAD AC WITH 0001              /014 CJL
+       NL0002= CLA CLL CML RTL         /LOAD AC WITH 0002              /014 CJL
+       NL0003= CLA STL IAC RAL         /LOAD AC WITH 0003 (8/I ON UP)  /046 CJL
+       NL0004= CLA CLL IAC RTL         /LOAD AC WITH 0004 (8/I ON UP)  /046 CJL
+       NL0006= CLA STL IAC RTL         /LOAD AC WITH 0006 (8/I ON UP)  /046 CJL
+       NL0010= CLA IAC RAL RAR         /LOAD AC WITH 0010 (6120)       /024 CJL
+       NL0100= CLA IAC BSW             /LOAD AC WITH 0100 (8/E ON UP)  /024 CJL
+       NL3776= CLA CLL CMA RAR RAL     /LOAD AC WITH 3776 (8/I OR 8/L) /024 CJL
+       NL3777= CLA CLL CMA RAR         /LOAD AC WITH 3777              /046 CJL
+       NL4000= CLA CLL CML RAR         /LOAD AC WITH 4000              /014 CJL
+       NL5777= CLA CLL CMA RTR         /LOAD AC WITH 5777              /046 CJL
+       NL6000= CLA STL IAC RTR         /LOAD AC WITH 6000 (8/I ON UP)  /046 CJL
+       NL7775= CLA CLL CMA RTL         /LOAD AC WITH 7775              /014 CJL
+       NL7776= CLA CLL CMA RAL         /LOAD AC WITH 7776              /014 CJL
+       NL7777= CLA CMA                 /LOAD AC WITH 7777              /014 CJL
+\f/     DECMATE I COMMUNICATIONS PORT DEFINITIONS.                      /050 CJL
+
+       IPORT0= 30              /COMMUNICATIONS PORT 0 INPUT DEVICE CODE
+
+       RKFL0=  IPORT0^10+6000  /SET COMMUNICATIONS PORT 0 INPUT FLAG
+       RKSF0=  IPORT0^10+6001  /SKIP ON, CLEAR COMMUNICATIONS PORT 0 INPUT FLAG
+       RKCC0=  IPORT0^10+6002  /CLEAR AC
+       RKIE0=  IPORT0^10+6005  /PORT 0 INPUT INTERRUPT ENABLE PER AC[11]
+       RKRB0=  IPORT0^10+6006  /READ COMMUNICATIONS PORT 0 INTO AC
+
+       OPORT0= 31              /COMMUNICATIONS PORT 0 OUTPUT DEVICE CODE
+
+       RTFL0=  OPORT0^10+6000  /SET COMMUNICATIONS PORT 0 OUTPUT FLAG
+       RTSF0=  OPORT0^10+6001  /SKIP ON, CLEAR COMMUNICATIONS PORT 0 OUTPUT FLAG
+       RTCF0=  OPORT0^10+6002  /NOP
+       RTIE0=  OPORT0^10+6005  /PORT 0 OUTPUT INTERRUPT ENABLE PER AC[11]
+       RTLS0=  OPORT0^10+6006  /WRITE COMMUNICATIONS PORT 0 FROM AC
+
+       IPORT1= 34              /COMMUNICATIONS PORT 1 INPUT DEVICE CODE
+
+       RKFL1=  IPORT1^10+6000  /SET COMMUNICATIONS PORT 1 INPUT FLAG
+       RKSF1=  IPORT1^10+6001  /SKIP ON, CLEAR COMMUNICATIONS PORT 1 INPUT FLAG
+       RKCC1=  IPORT1^10+6002  /CLEAR AC
+       RKIE1=  IPORT1^10+6005  /PORT 1 INPUT INTERRUPT ENABLE PER AC[11]
+       RKRB1=  IPORT1^10+6006  /READ COMMUNICATIONS PORT 1 INTO AC
+
+       OPORT1= 35              /COMMUNICATIONS PORT 1 OUTPUT DEVICE CODE
+
+       RTFL1=  OPORT1^10+6000  /SET COMMUNICATIONS PORT 1 OUTPUT FLAG
+       RTSF1=  OPORT1^10+6001  /SKIP ON, CLEAR COMMUNICATIONS PORT 1 OUTPUT FLAG
+       RTCF1=  OPORT1^10+6002  /NOP
+       RTIE1=  OPORT1^10+6005  /PORT 1 OUTPUT INTERRUPT ENABLE PER AC[11]
+       RTLS1=  OPORT1^10+6006  /WRITE COMMUNICATIONS PORT 1 FROM AC
+
+       PCON=   36              /PORT STATUS AND CONTROL DEVICE CODE
+
+       SMFL=   PCON^10+6000    /SET MODEM CHANGE FLAG
+       MFSK=   PCON^10+6001    /SKIP ON, CLEAR MODEM CHANGE FLAG
+       WCON0=  PCON^10+6002    /WRITE COMMUNICATIONS PORT 0 CONTROL REGISTER
+       PSR=    PCON^10+6003    /READ PORT STATUS REGISTER
+       PMR=    PCON^10+6004    /READ PORT MODEM REGISTER
+       MFIE=   PCON^10+6005    /LOAD MODEM CHANGE INTERRUPT ENABLE PER AC[11]
+       WCON1=  PCON^10+6006    /WRITE COMMUNICATIONS PORT 1 CONTROL REGISTER
+       RACD=   PCON^10+6007    /RESET ACTIVE COMMUNICATIONS PORT PER AC[0]
+\f/     DECMATE II, ETC. COMMUNICATIONS PORT DEFINITIONS.               /046 CJL
+
+       PORTIN= 30              /COMMUNICATIONS PORT INPUT DEVICE CODE
+
+       IFL=    PORTIN^10+6000  /SET COMMUNICATIONS PORT INPUT/OUTPUT FLAG
+       ISF=    PORTIN^10+6001  /SKIP ON, CLEAR COMMUNICATIONS PORT INPUT/OUTPUT FLAG
+       ICF=    PORTIN^10+6002  /NOP (CLEAR THE AC?)
+       INOP1=  PORTIN^10+6003  /(NOP?)
+       IRS=    PORTIN^10+6004  /READ COMMUNICATIONS PORT RECEIVE BUFFER
+       IIE=    PORTIN^10+6005  /COMMUNICATIONS PORT I/O INTERRUPT ENABLE PER AC[11]
+       IRB=    PORTIN^10+6006  /READ COMMUNICATIONS PORT RECEIVE BUFFER
+       INOP2=  PORTIN^10+6007  /(NOP?)
+
+       PORTOUT=31              /COMMUNICATIONS PORT OUTPUT DEVICE CODE
+
+       DUMBFL= PORTOUT^10+6000 /SET COMMUNICATIONS PORT DUMMY FLAG
+       DUMBSF= PORTOUT^10+6001 /SKIP ON, CLEAR COMMUNICATIONS PORT DUMMY FLAG
+       DUMBCF= PORTOUT^10+6002 /NOP (CLEAR THE AC?)
+       ONOP1=  PORTOUT^10+6003 /(NOP?)
+       OPC=    PORTOUT^10+6004 /LOAD COMMUNICATIONS PORT TRANSMIT BUFFER
+       DUMBIE= PORTOUT^10+6005 /COMMUNICATIONS PORT DUMMY INTERRUPT ENABLE PER AC[11]
+       OLS=    PORTOUT^10+6006 /LOAD COMMUNICATIONS PORT TRANSMIT BUFFER
+       ONOP2=  PORTOUT^10+6007 /(NOP?)
+
+       PORTCON=36              /COMMUNICATIONS PORT CONTROL DEVICE CODE
+
+       MFL=    PORTCON^10+6000 /SET MODEM CHANGE FLAG
+       MSF=    PORTCON^10+6001 /SKIP ON, CLEAR MODEM CHANGE FLAG
+       MLC=    PORTCON^10+6002 /LOAD MODEM CONTROL REGISTER
+       MSB=    PORTCON^10+6003 /LOAD BAUD RATE REGISTER
+       MRS=    PORTCON^10+6004 /READ MODEM STATUS REGISTER
+       MIE=    PORTCON^10+6005 /MODEM CHANGE INTERRUPT ENABLE PER AC[11]
+       MPSCC=  PORTCON^10+6006 /ACCESS MULTIPROTOCOL SERIAL COMMUNICATIONS CONTROLLER
+       MPRESET=PORTCON^10+6007 /RESET MULTIPROTOCOL SERIAL COMMUNICATIONS CONTROLLER
+\f/     MISCELLANEOUS DEFINITIONS.                                      /014 CJL
+
+/      STATIC DATE CALCULATIONS.                                       /024 CJL
+
+/      THESE EQUATIONS CAUSE PRINTABLE  TEXT OF THE DATE PARTICULARS, WHICH ARE GIVEN
+/      IN OS/8 INTERNAL FORMAT.  PROGRAM MAINTAINENCE REQUIRES THE UPDATE OF VERSION,
+/      REVISION, REVDATE, AND REVDGRP.  REVDATE  AND  REVDGRP SHOULD BE OBTAINED FROM
+/      THE SYSTEM WHEN RELEASING A NEW VERSION  AFTER  FIRST  CORRECTLY  INVOKING THE
+/      SYSTEM DATE COMMAND.
+
+/      VERSION=[ANY NUMBER IN THE RANGE 00-143 (DECIMAL 00-99)]
+
+/      REVISIO=[ANY SIX-BIT ALPHA (A-Z); DO NOT FORGET &77]
+
+/      REVDATE=[THE CONTENTS OF 17666 (DATE WORD)]
+
+/      REVDGRP=[THE CONTENTS OF 07777 (ONLY BITS[3-4] ARE USED)]
+
+
+
+       IFNDEF  REVDATE <REVDATE=4464>  /REVISION DATE (LOCATION 17666)
+
+       IFNDEF  REVDGRP <REVDGRP=0400>  /REVISION 8 YEAR DATE GROUP (LOCATION 07777)
+
+       IFNDEF  REVISIO <REVISIO="G&77> /REVISION OF KERMIT-12
+
+       IFNDEF  VERSION <VERSION=12>    /VERSION OF KERMIT-12
+
+
+       DAY=    REVDATE&370%10          /REVISION DAY
+
+       DGROUP= REVDGRP&600%20          /REVISION DATE GROUP (WHICH 8 YEARS)
+
+       MONTH=  REVDATE&7400%400        /REVISION MONTH
+
+       YEAR=   REVDATE&7+DGROUP+106    /REVISION YEAR (SINCE 1900)
+\f      FIELD   PRGFLD%10       /STARTING FIELD                         /038 CJL
+
+       *0                      /START AT THE BEGINNING                 /014 CJL
+
+INTPC, .-.                     /PC FROM INTERRUPT (IF ANY)             /014 CJL
+       JMP I   INTPC           /RETURN WITH INTERRUPTS OFF             /014 CJL
+
+ABFLAG,        .-.                     /FILE ABORT FLAG                        /044 CJL
+TABLEJU,.-.                    /MATCHING VALUE FOR SRCHTABLE ROUTINE   /025 CJL
+
+       IFNZRO  .-4     <ERROR  .>                                      /014 CJL
+ODT,   ZBLOCK  7-.             /RESERVED FOR OS/8 ODT                  /014 CJL
+RATE,  BRATE                   /BAUD RATE                              /050 CJL
+
+       *10                     /GET TO AUTO-INDEX AREA                 /014 CJL
+
+XR0,   .-.                     /AUTO-INDEX ZERO                        /014 CJL
+XR1,   .-.                     /AUTO-INDEX ONE                         /014 CJL
+DIRXR, PORT                    /DIRECTORY LOOKUP DEDICATED AUTO-INDEX  /028 CJL
+                               /INITIALIZED FOR DECMATE I ONCE-ONLY    /050 CJL
+
+/      THE REMAINING LOCATIONS THROUGH  000017  MUST  BE USED DIRECTLY ONLY, SO AS TO
+/      NOT CAUSE INADVERTANT AUTO-INDEXING.
+
+/      COLUMN COUNTER FOR CONSOLE ROUTINES (NEVER USED INDIRECTLY).    /043 CJL
+
+COLUMN,        .-.                     /CONSOLE OUTPUT COLUMN COUNTER          /043 CJL
+
+/      CONSOLE TERMINAL ECHO SWITCH (NEVER USED INDIRECTLY).           /020 CJL
+
+ECHOSW,        0                       /0=ECHO, 4000=DON'T ECHO                /020 CJL
+
+/      LATEST (NON-CONNECT MODE) CHARACTER (NEVER USED INDIRECTLY).    /043 CJL
+
+INCHAR,        .-.                     /LATEST INPUT CHARACTER FROM CONSOLE    /043 CJL
+
+/      CURRENT KERMIT MODE (NEVER USED INDIRECTLY).                    /025 CJL
+
+KMODE, .-.                     /CURRENT MODE OF KERMIT                 /025 CJL
+
+/      KERMIT MODE FLAG VALUES.                                        /014 CJL
+
+/      MLINE=  1               /KERMIT IS ON-LINE
+       MSEND=  2               /KERMIT IS IN SEND MODE
+       MREC=   3               /KERMIT IS IN RECEIVE MODE
+
+/      LATEST CHARACTER SENT TO OUTPUT FILE (NEVER USED INDIRECTLY).   /020 CJL
+
+LATEST,        .-.                     /LATEST CHARACTER SENT TO OUTPUT FILE   /020 CJL
+\f      *20                     /GET PAST AUTO-INDEX AREA
+
+INFLAG,        .-.                     /DECMATE INPUT AVAILABLE FLAG           /046 CJL
+OUTFLAG,.-.                    /DECMATE OUTPUT AVAILABLE FLAG          /046 CJL
+TEMP,  0
+RCHAR, 0                       /REMOTE LINE CURRENT INPUT CHAR
+SCAN1, 0                       /
+SCAN2, 0                       /
+KEYDSP,        0                       /DISPATCH ADDRESS FOR KEYWORD MATCH
+BININP,        0                       /BINARY REGISTER FOR DECIMAL INPUT
+PTABLE,        0                       /
+LPTR,  0                       /HOLDS LINE POINTER
+STATE, 0                       /CURRENT STATE
+RETRY, -RETCNT                 /PACKET ERROR RETRY COUNTER             /031 CJL
+RTRYC, 0                       /USE THIS FOR ACTUAL COUNTER
+
+/      CURRENT PACKET I/O DATA.                                        /014 CJL
+
+PAKPTR,        0                       /POINTER TO OUTPUT PACKET POINTER
+PAKCKS,        0                       /HOLDS CURRENT OUTPUT PACKET CHECKSUM TOTAL
+CURSEQ,        0                       /CURRENT SEQ NUMBER
+QFLAG, 0                       /NON-ZERO WHEN NO CONTROL QUOTING
+
+/      RECEIVE "INIT" REGISTERS.                                       /014 CJL
+
+RMAXL, DEFMAXL+40              /MAX LENGTH FOR DATA PACKET (DEFAULT)
+RTIME, 0                       /TIME-OUT VALUE
+RNPAD, 0                       /NUMBER OF PADDING CHARS
+RPADC, 0                       /CHAR USED FOR PADDING
+REOL,  DEFEOL                  /TERMINATOR CHAR USED FOR END OF PACKET
+RQCTL, DEFQCTL                 /CONTROL CHAR PREFIX CHAR
+RQBIN, 0                       /PARITY CHAR PREFIX CHAR (CHARS GT 177)
+RCHKT, DEFCK                   /CHECKSUM TYPE  (DEFAULT TYPE 1)
+RREPT, 0                       /PREFIX CHAR FOR REPEATED CHARS
+RCAPAS,        0                       /EXTRA CAPABILITY BIT MASK
+
+/      ZBLOCK  4               /RESERVED FOR EXTRA CAPABILITIES        /022 CJL
+
+       INITEND=.               /END OF INIT REGISTERS                  /022 CJL
+
+HNDADR,        0                       /FILE DEVICE HANDLER ADDRESS
+FORCEP,        0                       /FLAG FOR FORCED OUTPUT OF PACKET WHEN THERE IS
+                               /  NO DATA (JUST SOH, LEN, SEQ, AND CHECKSUM)
+PRSERR,        0                       /HOLDS PARSE POSITION FOR REPORTING ERRORS
+PACK6P,        0                       /POINTER TO STORAGE OF 6 BIT CHARS
+PACK6F,        0                       /FLAG FOR WHICH BYTE TO STORE
+GET6P, 0                       /POINTER USED IN THE GET6 ROUTINE
+GET6F, 0                       /FLAG USED IN THE GET6 ROUTINE
+MOVE4, 0                       /COUNTER FOR "MOVE"
+INIFLG,        0                       /INIT DONE FLAG
+MQ,    .-.                     /"MQ" TEMPORARY REGISTER                /032 CJL
+\f/     FILE NAME PARSE REGISTERS.                                      /014 CJL
+
+FNPTR, 0                       /POINTER TO WHERE TO PUT A PARSED FILE NAME
+WILDF, 0                       /WILD CARD IN FILE NAME FLAG
+
+/      FILE INFORMATION.                                               /014 CJL
+
+FSBLK, 0                       /FILE START BLOCK
+FLEN,  0                       /FILE LENGTH
+DEVNUM,        0                       /PARSED DEVICE NUMBER HERE
+OFFLG, 0                       /OUTPUT FILE OPEN FLAG
+ODNAME,        0                       /POINTER TO USER SPECIFIED DEVICE FOR OUTPUT
+ODNUMB,        0                       /OUTPUT DEVICE NUMBER
+
+/      PARITY VARIABLES.                                               /014 CJL
+
+/MARK, 0200                    /SET BIT [8] FOR COMMAND INPUTS         /A013
+/PARITY,0                      /PARITY MASK (0=SPACE, 200=MARK)        /AM013
+
+/      INTERNAL FILE MODE FLAG.                                        /019 CJL
+
+FILMODE,FMODE                  /ASCII=0177, BINARY=4377                /019 CJL
+
+/      UPPER-CASE ONLY FLAG.                                           /023 CJL
+
+UPONLY,        LOWER                   /0=UPPER/LOWER CASE, -40=UPPER-CASE ONLY/030 CJL
+
+/      <^C> DISPATCH ADDRESS.                                          /023 CJL
+
+UCADDRE,SBOOT                  /<^C> ADDRESS SHOULD BE SET AS NECESSARY/023 CJL
+
+/      <^P> DISPATCH ADDRESS.                                          /023 CJL
+
+UPADDRE,CHKCLR                 /<^P> ADDRESS SHOULD BE SET AS NECESSARY/023 CJL
+
+/      ESCAPE CHARACTER FOR CONNECT MODE.                              /025 CJL
+
+ESCHAR,        ESCAPE                  /ESCAPE CHARACTER FOR CONNECT MODE      /025 CJL
+
+/      FLOW CONTROL FLAG.                                              /026 CJL
+
+FLOWFLA,-FLOW                  /0=NO FLOW CONTROL, 7777=FLOW CONTROL   /049 CJL
+                               /VIA <^S>/<^Q>
+
+/      KEYBOARD INPUT ERROR FLAG.                                      /026 CJL
+
+KEYERRO,.-.                    /0=NO ERROR, NON-ZERO=BAD CHARACTER     /026 CJL
+                               /OR BUFFER OVERRUN
+\f/     REMOTE LINE INPUT ERROR FLAG.                                   /026 CJL
+
+RINERRO,.-.                    /0=NO ERROR, NON-ZERO=BAD CHARACTER     /026 CJL
+                               /OR BUFFER OVERRUN
+
+/      REMOTE LINE OUTPUT FLOW CONTROL WAIT FLAG.                      /026 CJL
+
+REMWAIT,.-.                    /0=DON'T WAIT, 4000=WAIT FOR <^Q>       /026 CJL
+
+/      REMOTE INPUT WAIT FLAG.                                         /026 CJL
+
+/      FLAG STATES:
+
+/      VALUE                   ACTION
+
+/      0000                    BUFFER IS LESS THAN  3/4  FULL.   INPUT FREELY ALLOWED
+/                              WITHOUT FLOW CONTROL RESTRICTIONS.   IF BUFFER BECOMES
+/                              3/4 FULL AND FLOW CONTROL IS  IN  EFFECT  THEN  CHANGE
+/                              STATE TO 0001.
+
+/      0001                    BUFFER IS NOW 3/4 FULL.  OUTPUT  <^S>  TO  REMOTE  AND
+/                              THEN CHANGE STATE TO 4000.
+
+/      4000                    WAITING FOR BUFFER TO EMPTY TO LESS THAN 1/4 FULL.  IF
+/                              FLOW  CONTROL  IS BEING OBEYED, THEN BUFFER SHOULD NOW
+/                              BE EMPTYING.
+
+/      7777                    BUFFER  IS  NOW  LESS  THAN 1/4 FULL.  OUTPUT <^Q>  TO
+/                              REMOTE AND THEN CHANGE STATE TO 0000.
+
+RINWAIT,.-.                    /REMOTE INPUT WAIT FLAG                 /026 CJL
+
+/      REMOTE LINE OUTPUT BUFFER POINTERS.                             /026 CJL
+
+REMINSE,.-.                    /REMOTE OUTPUT INSERTION POINTER        /026 CJL
+REMREMO,.-.                    /REMOTE OUTPUT REMOVAL POINTER          /026 CJL
+\f/     POINTER FOR THE PACKET INPUT AND OUTPUT ROUTINES
+
+       SPACK=  JMS I   .       /SEND A PACKET TO REMOTE
+               SPACK0          /PUT IN A POINTER
+
+       FPACK=  JMS I   .       /FORMAT PACKET
+               FPACK0          /PUT IN THE POINTER
+
+       RPACK=  JMS I   .       /RECEIVE A PACKET FROM REMOTE
+               ILINK           /PUT IN A POINTER
+
+/      POINTERS FOR OUTPUT ROUTINES
+
+       PRI8B=  JMS I   .       /PRINT 8 BIT STRING ON TTY
+               PRI8B0          /PUT IN THE POINTER
+
+       REM8B=  JMS I   .       /SEND 8 BIT STRING DOWN REMOTE LINE
+               REM8B0          /PUT IN THE POINTER
+
+/      MISC.
+
+       PACK6=  JMS I   .       /DEFINE CALL TO ROUTINE
+               PACK60          /POINTER TO ROUTINE
+
+       GET6=   JMS I   .       /DEFINE THE INSTRUCTION
+               GET60           /PUT IN THE POINTER
+
+       MOVE=   JMS I   .       /DEFINE CALL TO MOVE ROUTINE
+               MOVE0           /POINTER
+
+       CLEAR=  JMS I   .       /DEFINE CALL FOR "CLEAR" ROUTINE
+               CLEAR0          /POINTER
+\f      PAGE                    /START ON NEW PAGE                      /A014 CJL
+
+/      KERMIT-12 PROGRAM STARTS HERE.                                  /A014 CJL
+
+CLOOP, JMP I   (INITIALIZE)    /**** INITIALIZED **** CLA CLL          /024 CJL
+       JMS I   [CRESET]        /RESET CONSOLE ROUTINE STUFF
+       DCA     ABFLAG          /CLEAR ABORT FLAG                       /044 CJL
+       DCA     REMWAIT         /CLEAR REMOTE FLOW CONTROL WAIT         /049 CJL
+CLDMZAP,JMS    DMINIT          /INITIALIZE DECMATE PORT                /048 CJL
+
+/      THE  PREVIOUS  INSTRUCTION  IS  FOR  DECMATE  OPERATION  ONLY.    THE  DEFAULT
+/      INSTRUCTION IS FOR KL8 INTERFACES ONLY.
+
+       *CLDMZAP                /OVERLAY DECMATE CODE                   /048 CJL
+
+CLDMZAP,NOP                    /DON'T INITIALIZE DECMATE PORT          /048 CJL
+       TAD     RATE            /GET BAUD RATE
+SETBAUD,MSB                    /SET REMOTE BAUD RATE                   /050 CJL
+
+/      THE PREVIOUS INSTRUCTION IS FOR DECMATE II OPERATION ONLY.      /050 CJL
+
+       *SETBAUD                /OVERLAY DECMATE II CODE                /050 CJL
+
+SETBAUD,NOP                    /NOT APPLICABLE ON DECMATE I            /050 CJL
+
+/      THE  PREVIOUS  INSTRUCTION  IS  FOR DECMATE I OPERATION  ONLY.    THE  DEFAULT
+/      INSTRUCTION IS FOR KL8 INTERFACES ONLY.
+
+       *SETBAUD                /OVERLAY DECMATE I CODE                 /050 CJL
+
+SETBAUD,RSBIOT                 /SET REMOTE BAUD RATE                   /050 CJL
+       JMS I   [SCRIBE]        /DO A                                   /025 CJL
+       CRLF                    /<CR>, <LF>                             /025 CJL
+       JMS I   [SCRIBE]        /GIVE THEM THE                          /025 CJL
+/      PRMTMSG                 /PROMPT MESSAGE                         /025 CJL
+       PRMT2
+       JMS I   (LININP)        /GET INPUT LINE FROM USER
+       TAD     (CMDTBL)        /GET ADDRESS OF PARSE TABLE             /M014 CJL
+       DCA     PTABLE          /STORE FOR PARSER
+       TAD     (LINBUF)        /GET INPUT LINE BUFFER ADDRESS          /M014 CJL
+
+CLOOP1,        JMS I   (KEYPRS)        /PARSE OFF A KEYWORD
+       JMP     CLOOP9          /NO MATCH ON KEYWORD
+       JMP     CLOOP           /END OF LINE DETECTED
+       DCA     LPTR            /STORE POINTER TO NEXT POS ON LINE
+       JMS I   KEYDSP          /DISPATCH TO SERVICE
+       JMP     CLOOP7          /ERROR RETURN FROM SERVICE DISPATCH
+       TAD     LPTR            /RE-GET COMMAND LINE POINTER
+       JMP     CLOOP1          /CONTINUE LINE PARSE
+
+CLOOP7,        SNA                     /SKIP IF A RETURNING MESSAGE PASSED     /029 CJL
+       JMP     CLOOP           /JUST GO BACK TO COMMAND LOOP           /029 CJL
+       DCA     RETARG          /STORE IN-LINE                          /029 CJL
+       JMS I   [SCRIBE]        /CALL MESSAGE PRINT ROUTINE
+RETARG,        .-.                     /WILL BE PASSED MESSAGE ADDRESS
+       JMP     CLOOP           /KEEP GOING
+\fCLOOP9,       JMS I   [SCRIBE]        /COMPLAIN OF                            /025 CJL
+       CMERMSG                 /BAD COMMAND                            /025 CJL
+       JMP     CLOOP           /GO AGAIN
+
+/      ROUTINE TO FORMAT A PACKET OF DATA
+/      CALL:   FPACK
+/              DATA ADDRESS (DATA MUST ALREADY BE CONTROL/QUOTED AND MUST
+/                            NOT BE LONGER THAN THE LARGEST PACKET)
+/              PACKET TYPE
+
+FPACK0,        0
+       CLA CLL                 /INSURE CLEAR AC
+       TAD I   FPACK0          /GET THE DATA ADDRESS
+       DCA     FP1             /STORE IN SOURCE POINTER
+       ISZ     FPACK0          /BUMP ARGUMENT POINTER
+       TAD I   FPACK0          /NOW GET TYPE
+       DCA I   (RSTYP)         /STORE
+       ISZ     FPACK0          /BUMP ARGUMENT POINTER
+       TAD     (RSDTA          /GET ADDRESS OF DATA BUFFER
+       DCA     FP2             /STORE IN DESTINATION POINTER
+
+       TAD     (40+3           /SET FOR LENGTH COUNTER
+       DCA I   (RSLEN)         /STORE IN PACKET
+       DCA     FP3             /INIT CHECKSUM
+       TAD     CURSEQ          /GET CURRENT SEQ NUMBER
+       AND     [77]            /MODULO 64                              /014/016 CJL
+       TAD     [40]            /TAKE CHAR(SEQUENCE NUMBER)             /014/016 CJL
+       DCA I   (RSSEQ)         /PUT INTO PACKET
+FPACK2,        TAD I   FP1             /GET A CHAR FROM SOURCE
+       SPA                     /SKIP IF NOT END
+       JMP     FPACK3          /END
+       TAD     FP3             /COMBINE WITH CHECKSUM
+       DCA     FP3             /AND RETURN
+       TAD I   FP1             /GET CHAR BACK AGAIN
+       DCA I   FP2             /NOW PUT INTO DESTINATION
+       ISZ I   (RSLEN)         /BUMP THE LENGTH
+       ISZ     FP1             /BUMP THE SOURCE POINTER
+       ISZ     FP2             /BUMP THE DESTINATION POINTER
+       JMP     FPACK2          /LOOP
+\fFPACK3,       CLA CLL                 /CLEAR THE AC
+       TAD     FP3             /GET CALCULATED CHECKSUM
+       TAD I   (RSLEN)         /INCLUDE THE LENGTH
+       TAD I   (RSSEQ)         /AND THE SEQUENCE
+       TAD I   (RSTYP)         /AND THE TYPE
+       JMS I   [CKSUM]         /GET IT CORRECT
+       DCA I   FP2             /STORE WITH PACKET
+       ISZ     FP2             /BUMP PACKET POINTER
+       TAD     REOL            /GET ANY END OF LINE TO INCLUDE
+       TAD     [-40]           /MAKE IT A REAL CHARACTER               /014/016 CJL
+       SNA                     /SKIP IF EOL CHAR REQUIRED
+       JMP     FPACK4          /NO EOL CHAR
+       DCA I   FP2             /STORE EOL CHAR WITH PACKET
+       ISZ     FP2             /BUMP POINTER
+FPACK4,        NL7777                  /SET -1                                 /032 CJL
+       DCA I   FP2             /PACKET NOW COMPLETE
+       TAD     RETRY           /SET UP RE-TRY COUNTER
+       DCA     RTRYC
+       ISZ     CURSEQ          /BUMP SEQUENCE NUMBER FOR NEXT TIME
+       NOP                     /PROTECT ISZ
+       JMP I   FPACK0          /RETURN
+
+FP1,   0                       /POINTER TO SOURCE DATA
+FP2,   0                       /POINTER TO PACKET BUFFER
+FP3,   0                       /RUNNING CHECKSUM
+
+/      DECMATE INITIALIZE ROUTINE.                             /048 CJL
+
+DMINIT,        .-.                     /DECMATE PORT INITIALIZE ROUTINE/048 CJL
+DMI01, TAD     DM234/(234)     /GET SCD ENABLE VALUE           /050 CJL
+DMI02, WCON0                   /WRITE CONTROL REGISTER 0 (1)   /050 CJL
+DMI03, NL0000                  /INDICATE PORT 0 (1)            /050 CJL
+DMI04, RACD                    /RESET THE ACTIVE PORT          /050 CJL
+DMI05, ISZ     DMWASTE         /WASTE                          /050 CJL
+DMI06, JMP     DMI05           /SOME TIME                      /050 CJL
+DMI07, ISZ     DMWASTE         /WASTE                          /050 CJL
+DMI08, JMP     DMI07           /SOME TIME                      /050 CJL
+DMI09, RTFL0                   /SET PORT 0 (1) OUTPUT FLAG     /050 CJL
+DMI10, TAD     DM2516/(2516)   /SETUP FOR 8 BITS, NO PARITY    /050 CJL
+DMI11, JMS     DMSEND          /SEND TO MODE REGISTER 1        /050 CJL
+DMI12, TAD     RATE            /GET BAUD RATE                  /050 CJL
+DMI13, TAD     DM2460/(2460)   /ADD ON CLOCK ENABLE VALUES     /050 CJL
+DMI14, JMS     DMSEND          /SEND TO MODE REGISTER 2        /050 CJL
+DMI15, TAD     DM3425/(3425)   /GET ENABLE AND RESET VALUE     /050 CJL
+DMI16, JMS     DMSEND          /SEND TO COMMAND REGISTER       /050 CJL
+DMI17, RKRB0                   /DO A DUMMY READ ON PORT 0 (1)  /050 CJL
+\f/     THE  PREVIOUS  INSTRUCTIONS  ARE  FOR  DECMATE  I OPERATION ONLY.  THE DEFAULT
+/      INSTRUCTIONS ARE FOR DECMATE II, ETC.  INTERFACES ONLY.
+
+       *DMI01                  /OVERLAY DECMATE I CODE         /050 CJL
+
+DMI01, ISZ     DMWASTE         /WASTE                          /048 CJL
+DMI02, JMP     DMI01           /SOME TIME                      /048 CJL
+DMI03, ISZ     DMWASTE         /WASTE                          /048 CJL
+DMI04, JMP     DMI03           /SOME TIME                      /048 CJL
+DMI05, ISF                     /SKIP ON AND CLEAR PORT FLAG    /048 CJL
+DM50,  50/NOP                  /JUST IN CASE                   /048 CJL
+DMI07, IRB                     /READ THE PORT BUFFER           /048 CJL
+DMI08, CLA                     /CLEAN UP                       /048 CJL
+DMI09, TAD     DM50/(50)       /GET OUTPUT INTERRUPT VALUE     /048 CJL
+DMI10, MPSCC                   /CLEAR OUTPUT INTERRUPT         /048 CJL
+DMI11, TAD     (60-50)         /GET ERROR RESET VALUE          /048 CJL
+DMI12, MPSCC                   /CLEAR OVERRUN ERRORS           /048 CJL
+DMI13, TAD     (70-60)         /SET END OF INTERRUPT VALUE     /048 CJL
+DMI14, MPSCC                   /CLEAR THE INTERRUPT            /048 CJL
+DMI15, DCA     OUTFLAG         /INDICATE OUTPUT IS AVAILABLE   /048 CJL
+DMI16, DCA     INFLAG          /CLEAR INPUT AVAILABLE FLAG     /048 CJL
+DMI17, JMP I   DMINIT          /RETURN                         /048 CJL
+
+/      DECMATE I INITIALIZE CODE CONTINUES HERE.               /050 CJL
+
+DMISET,        RTFL0                   /SET PORT 0 (1) OUTPUT FLAG     /050 CJL
+       CLA                     /CLEAN UP                       /050 CJL
+       JMP I   DMINIT          /RETURN                         /050 CJL
+
+DMSEND,        .-.                     /DECMATE I SEND ROUTINE         /050 CJL
+DMISKP,        RTSF0                   /SKIP ON PORT 0 (1) OUTPUT FLAG /050 CJL
+       JMP     DMISKP          /WAIT FOR IT                    /050 CJL
+DMIOUT,        RTLS0                   /SEND TO PORT 0 (1) REGISTER    /050 CJL
+       CLA                     /CLEAN UP                       /050 CJL
+       JMP I   DMSEND          /RETURN                         /050 CJL
+
+DMWASTE,.-.                    /TIMER TEMPORARY                /050 CJL
+DM234, 234                     /CONSTANT 0234                  /050 CJL
+DM2460,        2460                    /CONSTANT 2460                  /050 CJL
+DM2516,        2516                    /CONSTANT 2516                  /050 CJL
+DM3425,        3425                    /CONSTANT 3425                  /050 CJL
+
+       PAGE
+\f/     ROUTINE TO SEND THE FORMATTED PACKET                    /027 CJL
+/      ARGUMENTS:  CALL+1 NON-ZERO = AWAIT RESPONSE
+/                             ZERO = DO NOT AWAIT RESPONSE
+/                  CALL + 2 DISPATCH TABLE-2                   /027 CJL
+
+SPACK0,        0
+       REM8B;  RSBUF           /SEND PACKET JUST COMPLETED
+       TAD I   SPACK0          /DO WE GET A RESPONSE?
+       ISZ     SPACK0          /BUMP POINTER PAST ARGUMENT
+       SNA CLA                 /SKIP IF YES
+       JMP I   SPACK0          /ALL DONE HERE
+       RPACK                   /GET PACKET BACK FROM REMOTE
+       TAD I   SPACK0          /DID WE WANT A DISPATCH?
+       ISZ     SPACK0          /BUMP PAST ARGUMENT
+       SNA                     /SKIP IF YES
+       JMP I   SPACK0          /EXIT IF NO
+       DCA     SPACARG         /STORE IN-LINE                          /031 CJL
+       JMS     DISPATCH        /CALL DISPATCH ROUTINE                  /031 CJL
+SPACARG,.-.                    /WILL BE DISPATCH TABLE-2               /031 CJL
+       JMP I   SPACK0          /NOT FOUND, GOTTA RETURN
+
+/      CONSOLE RESET ROUTINE.                                          /024 CJL
+
+CRESET,        .-.                     /CONSOLE RESET ROUTINE
+       CLA CLL                 /CLEAN UP
+       DCA     ECHOSW          /ENABLE OUTPUT ECHO
+       TAD     (UPCPRT)        /ALLOW THEM TO
+       DCA     UCADDRESS       /RESTART VIA <^C>
+       TAD     [CLOOP]         /ALLOW THEM TO
+       DCA     UPADDRESS       /RESTART VIA <^P>
+       JMP I   CRESET          /RETURN
+
+/      ALTERNATE CONSOLE RESET ROUTINE.                                /025 CJL
+
+CREST2,        .-.                     /ALTERNATE CONSOLE RESET ROUTINE
+       JMS     CRESET          /CLEAR AC AND ENABLE OUTPUT ECHO
+       TAD     (KCCZAP)        /RENDER <^C>
+       DCA     UCADDRESS       /TOTALLY HARMLESS
+       TAD     (CHKCLR)        /MAKE <^P> PRINT "^P"
+       DCA     UPADDRESS       /AND THEN GO AWAY
+       JMP I   CREST2          /RETURN
+\f/     ROUTINE TO CLEAR WORDS OF MEMORY
+/      ENTER WITH:     AC = MINUS NUMBER OF WORDS TO CLEAR
+/                      MQ = ADDRESS OF WHERE TO START THE CLEAR
+
+CLEAR0,        0
+       DCA     CLEAR5          /STORE COUNT OF WORDS
+       TAD     MQ              /GET ADDRESS TO CLEAR                   /032 CJL
+       DCA     CLEAR6          /STORE IN POINTER
+       DCA I   CLEAR6          /ZERO A WORD
+       ISZ     CLEAR6          /BUMP POINTER
+       ISZ     CLEAR5          /BUMP COUNTER
+       JMP     .-3             /LOOP
+       JMP I   CLEAR0          /DONE
+
+CLEAR5,        0                       /TEMP FOR "CLEAR" ROUTINE
+CLEAR6,        0                       /TEMP FOR "CLEAR" ROUTINE
+
+/      ROUTINE TO DISPATCH TO ROUTINE BASED ON VALUE OF "RRTYP".       /027 CJL
+
+/      CALLING SEQUENCE:
+
+/      CLA                     /AC MUST BE CLEAR
+/      JMS     DISPATCH        /CALL ROUTINE
+/      ADDRESS-2               /DISPATCH TABLE ADDRESS-2
+/      NO MATCH RETURN         /RETURNS HERE WITH CLEAR AC IF NO MATCH
+
+/      CALL  WILL DISPATCH TO THE CORRESPONDING ROUTINE ON A MATCH IN  THE  SPECIFIED
+/      TABLE (WHICH ENDS WITH ZERO) WITH A CLEAR AC.
+
+DISPATC,.-.                    /MATCH "RRTYP" AND DISPATCH ROUTINE
+       CLA                     /JUST IN CASE                           /031 CJL
+       TAD I   DISPATCH        /GET PASSED ARGUMENT
+       ISZ     DISPATCH        /BUMP PAST THE ARGUMENT
+       DCA     DISPA2          /SAVE PASSED ARGUMENT IN-LINE
+       TAD I   (RRTYP)         /GET VALUE OF "RRTYP"
+       CIA                     /INVERT FOR TESTING
+       JMS I   [SRCHTABLE]     /CALL TABLE SEARCH ROUTINE
+DISPA2,        .-.                     /WILL BE TABLE ADDRESS-2
+       SNA CLA                 /SKIP IF MATCH FOUND
+       JMP I   DISPATCH        /RETURN ON NO MATCH
+       JMP I   TABLEJUMP       /DISPATCH TO MATCHING ADDRESS
+\f/     ROUTINE TO PUT CHARS INTO A BUFFER TO GET READY TO FORMAT A PACKET.
+/      ENTER WITH CHAR IN THE AC; IF THE CHAR NEEDS CONTROL QUOTING, IT WILL BE ADDED
+/      EXIT + 2 IF EVERYTHING IS OK
+/      EXIT + 1 IF BUFFER IS FULL
+
+OPBUF, 0                       /PUT CHARACTERS INTO BUFFER FOR PACKET ROUTINE
+       JMS I   (OPRE)          /CHECK FOR PREFIX
+       JMP     OPBUF1          /NO PREFIX
+       DCA     OP1             /SAVE CONVERTED CHAR
+       TAD     RQCTL           /GET QUOTE CHAR TO USE
+       DCA I   OP2             /PUT RETURNED PREFIX INTO BUFFER
+       ISZ     OP2             /BUMP POINTER
+       TAD     OP1             /GET BACK CONVERTED CHAR
+OPBUF1,        DCA I   OP2             /PUT INTO BUFFER
+       ISZ     OP2             /BUMP POINTER
+       NL7777                  /SET -1                                 /032 CJL
+       DCA I   OP2             /ALWAYS TERMINATE BUFFER
+       TAD     RMAXL           /GET MAX BUFFER LENGTH
+       TAD     (-40+HOLDBF-4   /
+       CIA
+       TAD     OP2             /COMPARE WITH WHAT WE HAVE
+       SPA CLA                 /SKIP IF NO ROOM
+       JMP     OPBUF2          /HAVE ROOM
+       JMS     INIOPB          /RESET BUFFER
+       JMP I   OPBUF           /TAKE RETURN + 1
+
+OPBUF2,        ISZ     OPBUF           /BUMP RETURN FOR BUFFER NOT FULL
+       JMP I   OPBUF           /DONE
+
+OP1,   0                       /TEMP LOCATION
+OP2,   HOLDBF                  /POINTER FOR HOLD BUFFER
+
+/      ROUTINE TO RE-SET THE HOLD BUFFER.
+
+INIOPB,        0
+       TAD     (HOLDBF         /RE-SET BUFFER POINTER
+       DCA     OP2
+       JMP I   INIOPB
+
+/      ROUTINE TO CALCULATE A 1 BYTE CHECKSUM.
+
+CKSUM, 0
+       DCA     CKSUM1          /STORE TEMP
+       TAD     CKSUM1          /GET BACK
+       RTR;RTR;RTR             /GET TWO HIGHEST INTO TWO LOWEST        /032 CJL
+       AND     (3              /KEEP ONLY BITS 0-1
+       TAD     CKSUM1          /GET ORIGINAL
+       AND     [77]            /KEEP ONLY BITS 0-5                     /016 CJL
+       TAD     [40]            /MAKE A CHAR(CHECKSUM)
+       JMP I   CKSUM           /DONE, RETURN IN AC
+
+CKSUM1,        0                       /TEMP FOR "CKSUM"
+\f      PAGE
+\f/     ROUTINE TO INPUT CHARS FROM REMOTE UNTIL A "SOH" CHAR IS FOUND.
+
+GETSOH,        0
+       JMS     COMIN           /GET A CHARACTER FROM THE REMOTE LINE   /046 CJL
+       JMP I   GETSOH          /TIME-OUT
+       AND     [177]           /IGNORE PARITY BIT                      /034 CJL
+       TAD     (-CNTRLA)       /COMPARE WITH "SOH"                     /034 CJL
+       SZA CLA                 /SKIP IF SAME
+       JMP     GETSOH+1        /LOOP TILL WE GET ONE
+       ISZ     GETSOH          /BUMP FOR GOOD RETURN
+       JMP I   GETSOH          /GOT ONE, DONE
+
+
+/      ROUTINE TO GET A CHAR FROM THE REMOTE LINE AND UPDATE CHECKSUM.
+
+GETIR, 0
+       JMS     COMIN           /GET A CHARACTER FROM THE REMOTE LINE   /046 CJL
+       JMP I   GETIR           /TIME-OUT RETURN
+       DCA     GETIR1          /STORE TEMP
+       TAD     GETIR1          /GET CHAR BACK
+       TAD I   (ILINK9)        /ADD CHECKSUM
+       DCA I   (ILINK9)        /RETURN UPDATED CHECKSUM
+       TAD     GETIR1          /RE-GET CURRENT INPUT CHAR
+       TAD     [-15]           /CHECK FOR A RETURN
+       SNA CLA                 /SKIP IF NOT A RETURN
+       JMP I   GETIR           /WAS A RETURN, TAKE EXIT + 1
+       TAD     GETIR1          /RE-GET CHAR FOR RETURN
+       ISZ     GETIR           /BUMP FOR GOOD RETURN
+       JMP I   GETIR           /AND RETURN IN THE AC
+
+GETIR1,        0                       /TEMP LOCAL TO "GETIR"
+\f/     REMOTE COMMUNICATIONS ROUTINES FOR NON-CONNECT USAGE.           /046 CJL
+
+/      REMOTE INPUT ROUTINE.                                           /046 CJL
+
+COMIN, .-.                     /REMOTE INPUT ROUTINE                   /046 CJL
+       CLA                     /CLEAN UP                               /046 CJL
+       TAD     [-15]           /SETUP THE                              /049 CJL
+       DCA     TIMEOUT         /TIME-OUT FACTOR                        /046 CJL
+INLUP, TAD     INFLAG          /IS INPUT AVAILABLE?                    /046 CJL
+
+/      THE ABOVE INSTRUCTION IS FOR DECMATE  II USE ONLY.  THE DEFAULT INSTRUCTION IS
+/      FOR KL8 INTERFACES.
+
+       *INLUP                  /OVERLAY DECMATE II CODE                /049 CJL
+
+INLUP, SKP                     /WE'RE NOT A DECMATE II                 /049 CJL
+       SNA CLA                 /SKIP IF INPUT AVAILABLE (ON DECMATE II)/049 CJL
+INSKIP,        JMP     NOTYET          /JUMP IF NOT                            /049 CJL
+INLUP1,        DCA     INFLAG          /CLEAR INPUT AVAILABILITY FLAG          /049 CJL
+INREAD,        IRB                     /GET THE CHARACTER                      /049 CJL
+
+/      THE ABOVE INSTRUCTIONS ARE FOR DECMATE II  USE ONLY.  THE DEFAULT INSTRUCTIONS
+/      ARE FOR KL8 INTERFACES.
+
+       *INSKIP                 /OVERLAY DECMATE II CODE                /049 CJL
+
+INSKIP,        RKSFIOT                 /INPUT FLAG UP?                         /049 CJL
+INLUP1,        JMP     NOTYET          /NO, CHECK FOR ABORT, ETC.              /049 CJL
+INREAD,        RKRBIOT                 /YES, READ IN THE CHARACTER             /049 CJL
+       AND     [177]           /JUST SEVEN-BIT                         /046 CJL
+       DCA     RCHAR           /SAVE THE CHARACTER                     /046 CJL
+       TAD     RCHAR           /GET IT BACK                            /046 CJL
+       ISZ     COMIN           /BUMP TO GOOD RETURN                    /046 CJL
+       JMP I   COMIN           /RETURN                                 /046 CJL
+
+/      COMES HERE IF INPUT NOT AVAILABLE.
+
+NOTYET,        JMS I   (CTLCTST)       /CHECK FOR <^C>, ETC.                   /044 CJL
+       TAD     [-CNTRLZ]       /COMPARE POSSIBLE CHARACTER TO <^Z>     /044 CJL
+       SZA                     /SKIP IF IT ALREADY MATCHES             /044 CJL
+       TAD     [-CNTRLX+CNTRLZ]/ELSE COMPARE TO <^X>                   /044 CJL
+       SNA CLA                 /SKIP IF NEITHER ABORT CHARACTER        /049 CJL
+       ISZ     ABFLAG          /SET ABORT FLAG                         /049 CJL
+       SKP                     /SKIP IF NOT TOO MANY TIMES             /049 CJL
+       JMP     .-2             /ENSURE FLAG SETTING                    /049 CJL
+\fINSTATU,JMS   UPSTATUS        /UPDATE THE PORT STATUS                 /049 CJL
+
+/      THE ABOVE INSTRUCTION IS FOR DECMATE  II USE ONLY.  THE DEFAULT INSTRUCTION IS
+/      FOR KL8 INTERFACES.
+
+       *INSTATUS               /OVERLAY DECMATE II CODE                /049 CJL
+
+INSTATU,NOP                    /WE'RE NOT A DECMATE II                 /049 CJL
+       ISZ     WASTIME         /WASTE SOME TIME                        /046 CJL
+       JMP     INLUP           /KEEP TRYING                            /046 CJL
+       ISZ     TIMEOUT         /WAITING TOO LONG?                      /046 CJL
+       JMP     INLUP           /NO, KEEP TRYING                        /046 CJL
+       JMP I   COMIN           /YES, TAKE ERROR RETURN                 /046 CJL
+
+/      FLOW-CONTROL STATUS ROUTINE.                                    /049 CJL
+
+GETFLOW,.-.                    /GET FLOW-CONTROL STATUS
+GETFL1,        JMS     UPSTATUS        /UPDATE THE CURRENT STATUS
+
+/      THE ABOVE INSTRUCTION IS FOR DECMATE II USE ONLY.   THE DEFAULT INSTRUCTION IS
+/      FOR KL8 INTERFACES.
+
+       *GETFL1                 /OVERLAY DECMATE II CODE
+
+GETFL1,        NOP                     /WE'RE NOT A DECMATE II
+       JMS I   (RINGET)        /GET REMOTE CHARACTER (IF ANY)
+       CLA                     /THROW IT AWAY
+       TAD     REMWAIT         /GET REMOTE FLOW STATUS
+       JMP I   GETFLOW         /RETURN
+
+/      REMOTE OUTPUT ROUTINE.                                          /046 CJL
+
+COMOUT,        .-.                     /REMOTE OUTPUT ROUTINE                  /046 CJL
+       DCA     OUTEMP          /SAVE PASSED VALUE                      /046 CJL
+CMRESET,TAD    [-15]           /SETUP THE                              /049 CJL
+       DCA     OTIME           /TIME-OUT COUNTER                       /049 CJL
+COMWAIT,JMS    GETFLOW         /GET REMOTE WAIT STATUS                 /049 CJL
+
+/      THE ABOVE INSTRUCTION IS FOR DECMATE USE ONLY.  THE DEFAULT INSTRUCTION IS FOR
+/      KL8 INTERFACES.
+
+       *COMWAIT                /OVERLAY DECMATE CODE                   /049 CJL
+
+COMWAIT,NL7777                 /SETUP FOR FLOW CONTROL FLAG LOAD       /049 CJL
+       AND     FLOWFLAG        /SHOULD WE WAIT FOR REMOTE FLOW CONTROL?/049 CJL
+       SNA CLA                 /SKIP IF SO                             /049 CJL
+       JMP     NOWAIT          /JUMP IF NOT                            /049 CJL
+\fFLOWAIT,JMS   GETFLOW         /GET REMOTE WAIT STATUS                 /049 CJL
+       SZA CLA                 /SKIP IF NOT WAITING                    /049 CJL
+       JMP     FLOWAIT         /JUMP IF STILL WAITING                  /049 CJL
+NOWAIT,        TAD     OUTFLAG         /CHECK IF OUTPUT IS AVAILABLE           /049 CJL
+CMOUT1,        SNA CLA                 /SKIP IF SO                             /049 CJL
+CMOUT2,        JMP     OWAIT           /JUMP IF NOT                            /049 CJL
+DM1AND,        DCA     OUTFLAG         /CLEAR OUTPUT AVAILABILITY FLAG         /049 CJL
+CMOUT3,        TAD     OUTEMP          /GET THE PASSED VALUE                   /049 CJL
+CMOUT4,        OLS                     /OUTPUT IT                              /049 CJL
+
+/      THE ABOVE INSTRUCTIONS ARE FOR DECMATE II  USE ONLY.  THE DEFAULT INSTRUCTIONS
+/      ARE FOR KL8 INTERFACES.
+
+       *NOWAIT                 /OVERLAY DECMATE II CODE                /049 CJL
+
+NOWAIT,        RTSFIOT                 /OUTPUT FLAG UP?                        /049 CJL
+CMOUT1,        JMP     OWAIT           /NO, WAIT FOR IT THERE                  /049 CJL
+
+/      THE ABOVE INSTRUCTION IS FOR DECMATE I USE  ONLY.   THE DEFAULT INSTRUCTION IS
+/      FOR KL8 INTERFACES.
+
+       *CMOUT1                 /OVERLAY DECMATE I CODE                 /049 CJL
+
+CMOUT1,        JMP     COMWAIT         /NO, WAIT FOR IT                        /049 CJL
+CMOUT2,        TAD     OUTEMP          /YES, GET PASSED VALUE                  /049 CJL
+DM1AND,        AND     [377]           /ENSURE EIGHT BITS (FOR DECMATE I)      /049 CJL
+
+/      THE ABOVE INSTRUCTION IS FOR DECMATE I USE ONLY.    THE DEFAULT INSTRUCTION IS
+/      FOR KL8 INTERFACES.
+
+       *DM1AND                 /OVERLAY DECMATE I CODE                 /049 CJL
+
+DM1AND,        SKP                     /WE'RE NOT A DECMATE I                  /049 CJL
+CMOUT3,        TAD     [400]           /FORCE OUTPUT WRITE FOR DECMATE I       /049 CJL
+CMOUT4,        RTLSIOT                 /OUTPUT THE CHARACTER                   /049 CJL
+       CLA                     /CLEAN UP                               /049 CJL
+       JMP I   COMOUT          /RETURN                                 /049 CJL
+
+/      COMES HERE IF OUTPUT NOT READY.                                 /049 CJL
+
+OWAIT, ISZ     OWASTE          /WASTE SOME TIME                        /049 CJL
+       JMP     COMWAIT         /KEEP TRYING                            /049 CJL
+       ISZ     OTIME           /WAITING TOO LONG?                      /049 CJL
+       JMP     COMWAIT         /NO, KEEP TRYING                        /049 CJL
+       JMS I   (DMINIT)        /YES, RESET EVERYTHING                  /049 CJL
+       JMP     CMRESET         /TRY, TRY AGAIN                         /049 CJL
+\f/     DECMATE II, ETC. STATUS UPDATE ROUTINE.                         /046 CJL
+
+UPSTATU,.-.                    /UPDATE THE STATUS ROUTINE              /046 CJL
+       ISF                     /COMMUNICATIONS PORT FLAG UP?           /046 CJL
+       JMP I   UPSTATUS        /NO, RETURN                             /046 CJL
+       NL4000                  /SETUP READ OF REGISTER ZERO            /046 CJL
+       MPSCC                   /TELL THE MPSCC CHIP                    /046 CJL
+       CLA                     /CLEAN UP                               /046 CJL
+       MPSCC                   /READ REGISTER ZERO NOW                 /046 CJL
+       AND     (5)             /JUST INPUT AND OUTPUT BITS             /046 CJL
+       CLL RAR                 /MOVE INPUT TO LINK                     /046 CJL
+       SNA CLA                 /SKIP IF OUTPUT INTERRUPT               /046 CJL
+       JMP     INCHK           /JUMP IF NOT                            /046 CJL
+       TAD     (050)           /GET OUTPUT CLEAR VALUE                 /046 CJL
+       MPSCC                   /CLEAR THE OUTPUT INTERRUPT             /046 CJL
+       DCA     OUTFLAG         /INDICATE OUTPUT AVAILABLE NOW          /046 CJL
+INCHK, CLA RAL                 /GET RECEIVE STATUS                     /046 CJL
+       SZA                     /SKIP IF INPUT NOT AVAILABLE RIGHT NOW  /046 CJL
+       DCA     INFLAG          /INDICATE NEW INPUT STATUS              /046 CJL
+       CLA                     /CLEAN UP EITHER WAY                    /046 CJL
+       TAD     (070)           /GET END OF INTERRUPT VALUE             /046 CJL
+       MPSCC                   /CLEAR THE INTERRUPT                    /046 CJL
+       CLA                     /CLEAN UP                               /046 CJL
+       JMP I   UPSTATUS        /RETURN                                 /046 CJL
+
+       AND377= AND     [377]   /INSTRUCTION CONSTANT                   /049 CJL
+       OUTEMP= COMIN           /OUTPUT ROUTINE TEMPORARY               /049 CJL
+       TIMEOUT=GETFLOW         /TIME-OUT TEMPORARY                     /049 CJL
+       WASTIME=COMOUT          /TIME-OUT TEMPORARY                     /049 CJL
+
+OTIME, .-.                     /TIME-OUT TEMPORARY                     /049 CJL
+OWASTE,        .-.                     /TIME-OUT TEMPORARY                     /049 CJL
+
+       PAGE
+
+/      HOLD BUFFER FOR CHAR OUTPUT
+
+       DECIMAL
+
+HOLDBF,        ZBLOCK  92
+
+       OCTAL
+\f/     ROUTINE TO CHECK FOR CONTROL PREFIX.
+/      ENTER WITH CHAR TO CHECK IN THE AC.
+/      EXIT + 1 WITH CHAR IN THE AC IF NO PREFIX QUOTING.
+/      EXIT + 2 WITH PROPER CHAR IN THE AC AND QUOTING IS REQUIRED.
+
+OPRE,  0                       /CHECK FOR CONTROL PREFIX ROUTINE
+       DCA     PRETEMP         /SAVE THE CHARACTER                     /032 CJL
+       TAD     QFLAG           /CHECK FOR IN CTRL QUOTE MODE
+       SZA CLA                 /SKIP IF YES
+       JMP     OPRE1           /NO QUOTE PREFIX
+       TAD     PRETEMP         /GET THE CHARACTER                      /032 CJL
+       AND     [7740]          /QUICK CHECK FOR <40                    /014/016 CJL
+       SNA CLA                 /SKIP IF NOT CONTROL
+       JMP     OPRE2           /PREFIX QUOTE
+       TAD     PRETEMP         /GET THE CHARACTER                      /032 CJL
+       TAD     (-177           /CHECK FOR "DELETE"
+       SNA CLA                 /SKIP IF NOT
+       JMP     OPRE2           /PREFIX QUOTE
+       TAD     PRETEMP         /GET THE CHARACTER                      /032 CJL
+       CIA                     /NEGATE FOR COMPARE
+       TAD     RQCTL           /SEE IF SAME AS QUOTE CHAR
+       SZA CLA                 /SKIP IF PREFIX QUOTE
+       JMP     OPRE1           /NO PREFIX QUOTE
+       TAD     RQCTL           /PREFIX WITH PREFIX
+       JMP     OPRE3           /PREFIX WITH THE PREFIX
+
+OPRE1, TAD     PRETEMP         /GET THE CHARACTER                      /032 CJL
+       JMP I   OPRE            /DONE
+
+OPRE2, TAD     PRETEMP         /GET THE CHARACTER                      /032 CJL
+       TAD     [100]           /MAKE IT PRINTABLE                      /016 CJL
+       AND     [177]           /IN CASE IT WAS 177                     /014/016 CJL
+
+OPRE3, ISZ     OPRE            /BUMP FOR PREFIX RETURN
+       JMP I   OPRE            /DONE
+
+PRETEMP,.-.                    /PREFIX TEMPORARY                       /032 CJL
+
+       PAGE                                                            /014 CJL
+\f/     ROUTINE TO SCAN A TEXT LINE FOR KEYWORD DELIMITERS.
+
+/      THIS  ROUTINE EXPECTS THE AC TO POINT TO A TEXT LINE TO  SCAN  AND  FINDS  THE
+/      FIRST NON-SPACE, NON-END OF LINE CHAR IN THE LINE AND SETS "SCAN1" TO POINT TO
+/      IT.  NEXT WE FIND THE LAST CHAR IN THE LINE THAT IS A  NON-SPACE,  NON-END  OF
+/      LINE  AND  STORE  A  POINTER  TO  IT  IN "SCAN2".  KEYWORDS ARE DELIMITED BY A
+/      BEGINNING OF  LINE  OR SPACE AT THE BEGINNING AND AN END OF LINE OR A SPACE AT
+/      THE END.
+
+/      ENTER:  AC = POINTER TO COMMAND LINE
+
+/      EXIT: (SUCCESS) SCAN1 = POINTER TO FIRST CHAR OF KEYWORD.
+/                      SCAN2 = POINTER TO LAST CHAR OF KEYWORD.
+/                      RETURN = RETURN + 2 (NO WORDS LEFT IN LINE).
+
+/      EXIT: (FAIL)    RETURN = RETURN + 1.
+
+SCNEL, 0                       /SCAN ROUTINE
+       JMS I   [NOSP]          /FIND FIRST NON-SPACE
+       JMP I   SCNEL           /END OF LINE RETURN
+       DCA     SCAN1           /RETURN SCAN LINE POINTER
+       TAD     SCAN1           /RE-GET SCAN LINE POINTER
+       JMS I   [SP]            /FIND FIRST SPACE OR EOL
+       NOP                     /RETURN HERE ON EOL
+       TAD     (-1             /BACK UP TO PREVIOUS CHAR
+       DCA     SCAN2           /SET END ELEMENT POINTER
+       ISZ     SCNEL           /TAKE SUCCESS RETURN
+       JMP I   SCNEL           /DONE
+
+
+/      ROUTINE TO SCAN THRU A TEXT LINE LOOKING FOR THE NEXT SPACE.
+/      ENTER ROUTINE WITH THE LINE POINTER IN THE AC.
+
+/      EXIT:   RETURN + 2 WITH AC = POINTER TO SPACE.
+/              RETURN + 1 WITH AC = POINTER TO END OF LINE.
+
+SP,    0                       /CHECK FOR A <SPACE> ROUTINE
+       DCA     SCANTP          /USE A TEMP POINTER
+       SKP                     /SKIP INTO LOOP BELOW
+SP1,   ISZ     SCANTP          /BUMP LINE POINTER
+       TAD I   SCANTP          /GET A CHAR
+       SPA                     /SKIP IF NOT END OF LINE
+       JMP     SP3             /GOT AN END OF LINE
+       TAD     [-" !200]       /COMPARE WITH <SP>                      /034 CJL
+       SZA CLA                 /SKIP IF IS A SPACE
+       JMP     SP1             /LOOP TILL SPACE OR EOL
+       ISZ     SP              /BUMP RETURN FOR SPACE FOUND
+
+SP3,   CLA CLL                 /INSURE A CLEAR AC
+       TAD     SCANTP          /GET POINTER VALUE
+       JMP I   SP              /RETURN IN AC
+\f/     ROUTINE TO SCAN THRU A TEXT LINE FOR THE FIRST NON-SPACE.
+/      ENTER ROUTINE WITH POINTER TO THE LINE IN THE AC.
+
+/      EXIT:   RETURN + 2 WITH AC = POINTER TO NON-SPACE.
+/              RETURN + 1 WITH AC = POINTER TO END OF LINE.
+
+NOSP,  0                       /FIND A NON-<SPACE> ROUTINE
+       DCA     SCANTP          /USE A TEMP POINTER
+       SKP                     /SKIP INTO LOOP BELOW
+NOSP1, ISZ     SCANTP          /BUMP THE LINE POINTER
+       TAD I   SCANTP          /GET A CHAR FROM THE LINE
+       SPA                     /SKIP IF NOT EOL
+       JMP     NOSP3           /EXIT IF EOL
+       TAD     [-" !200]       /COMPARE WITH <SP>                      /034 CJL
+       SNA CLA                 /SKIP IF NOT SPACE
+       JMP     NOSP1           /LOOP TILL SPACE OR EOL
+       ISZ     NOSP            /BUMP RETURN FOR SPACE FOUND
+NOSP3, CLA CLL                 /INSURE CLEAR AC
+       TAD     SCANTP          /GET POINTER
+       JMP I   NOSP            /RETURN IN AC
+
+
+
+/      ROUTINE TO FIND AN END CHAR IN A STRING.
+/      ENTER ROUTINE WITH POINTER TO THE STRING IN THE AC.
+/      EXIT WITH THE POINTER TO THE FIRST MINUS CHAR IN THE AC.
+
+FNDEND,        0                       /FIND END CHAR ROUTINE
+       DCA     SCANTP          /PUT POINTER IN SCANTP
+FEND1, TAD I   SCANTP          /GET A CHAR FROM THE STRING
+       SPA CLA                 /SKIP IF NOT END
+       JMP     FEND2           /EXIT IF END OF STRING
+       ISZ     SCANTP          /BUMP THE POINTER
+       JMP     FEND1           /LOOP TILL NON-END OF STRING
+
+FEND2, TAD     SCANTP          /GET POINTER TO NON-END OF STRING
+       JMP I   FNDEND          /EXIT WITH POINTER IN AC
+
+SCANTP,        0                       /USED IN THE SCAN ROUTINES "SP", "NOSP", "FNDNUL"
+\f/     ROUTINE TO LOOKUP THE KEY WORD POINTED TO BY THE AC IN THE      /014 CJL
+/      TABLE POINTED TO BY PTABLE.
+
+/      RETURN + 1 IF NO MATCH IS FOUND WITH AC = ENTRY VALUE.
+/      RETURN + 2 IF NO KEYWORD IS FOUND (EOL DETECTED).
+/      RETURN + 3 IF MATCH IS FOUND WITH THE NEXT PARSE POSITION IN THE LINE IN
+/      THE AC AND THE DISPATCH ADDRESS FROM THE TABLE IN "KEYDSP".
+
+KEYPRS,        .-.                     /KEYWORD PARSE ROUTINE
+       DCA     LOOK3           /SAVE IN CASE OF FAIL
+       TAD     LOOK3           /RE-GET
+/      AND     (137)           /MAKE CHARACTER UPPER-CASE, NO PARITY   /MD013
+       JMS     SCNEL           /TRY TO SCAN OFF A KEYWORD
+       JMP     KP45            /END OF LINE ENCOUNTERED
+       TAD     PTABLE          /GET ADDRESS OF TABLE
+       DCA     LOOK2           /STORE IN LOCAL POINTER
+
+KP10,  TAD     SCAN1           /GET ADDRESS OF SCAN ELEMENT
+       DCA     LOOK1           /INTO LOCAL POINTER
+
+KP20,  TAD I   LOOK1           /GET A CHARACTER FROM THE SCAN ELEMENT
+       CIA                     /NEGATE FOR COMPARE
+       TAD I   LOOK2           /GET A CHAR FROM THE TABLE ELEMENT
+       SZA CLA                 /SKIP IF MATCH
+       JMP     KP90            /NO MATCH, SET TO LOOK AT NEXT TABLE ENTRY
+       TAD     LOOK1           /CHECK IF ALL ENTERED CHARS MATCH
+       CIA                     /NEGATE TO COMPARE
+       TAD     SCAN2           /HAVE WE MATCHED TO THE TERMINATOR?
+       SNA CLA                 /SKIP IF NO
+       JMP     KP40            /YES, GOT ENOUGH TO MATCH
+       ISZ     LOOK1           /MORE TO MATCH, BUMP SCAN ELEMENT POINTER
+       ISZ     LOOK2           /BUMP TABLE ELEMENT POINTER
+       JMP     KP20            /CONTINUE MATCH LOOP
+
+KP40,  TAD     LOOK2           /GET CURRENT TABLE POINTER
+       JMS     FNDEND          /FIND A NULL MARK
+       IAC                     /BUMP BY 1
+       DCA     LOOK1           /STORE IN A POINTER
+       TAD I   LOOK1           /GET DISPATCH ADDRESS
+       DCA     KEYDSP          /PUT INTO DISPATCH ADDRESS
+       ISZ     KEYPRS          /BUMP RETURN
+       ISZ     KEYPRS          /BUMP AGAIN
+       CLA CLL IAC             /AC = 1
+       TAD     SCAN2           /GET POINTER TO END OF CURRENT KEY
+       JMP I   KEYPRS          /RETURN
+
+/      END OF LINE ENCOUNTERED ON PARSE.
+
+KP45,  ISZ     KEYPRS          /BUMP RETURN ONCE FOR EOL
+
+/      NO MATCHES IN THE TABLE HERE.
+
+KP50,  TAD     LOOK3           /GET ORIGINAL AC
+       JMP I   KEYPRS          /RETURN
+\f/     FAILURE ON CURRENT TABLE ENTRY, SET FOR NEXT ENTRY (IF  THERE IS ONE)  AND TRY
+/      AGAIN.
+
+KP90,  TAD     LOOK2           /GET TABLE POINTER
+       JMS     FNDEND          /FIND NEXT TABLE ENTRY
+       IAC;IAC                 /NEXT ENTRY IS 2 PAST THE NULL
+       DCA     LOOK2           /RE-SET LOCAL TABLE POINTER
+       TAD I   LOOK2           /CHECK END OF TABLE
+       SNA CLA                 /SKIP IF NOT END OF THE TABLE
+       JMP     KP50            /TAKE NOT FOUND EXIT
+       JMP     KP10            /TRY MATCH ON THIS ENTRY
+
+LOOK1, .-.                     /TEMPORARY FOR KEYPRS                   /014 CJL
+LOOK2, .-.                     /TEMPORARY FOR KEYPRS                   /014 CJL
+LOOK3, .-.                     /TEMPORARY FOR KEYPRS                   /014 CJL
+
+/      ROUTINE TO MOVE WORDS OF MEMORY.                                /014 CJL
+
+/      CALLING SEQUENCE:
+
+/      TAD     (DESTINATION)   /GET DESTINATION ADDRESS
+/      DCA     MQ              /INTO MQ                                /032 CJL
+/      TAD     (-COUNT)        /GET -NUMBER OF WORDS TO MOVE
+/      DCA     MOVE4           /SETUP MOVE COUNTER
+/      TAD     (SOURCE)        /GET SOURCE ADDRESS
+/      JMS I   (MOVE0)         /CALL MOVE ROUTINE
+/      RETURN                  /RETURNS HERE
+
+MOVE0, .-.                     /MOVE ROUTINE                           /014 CJL
+       DCA     MOVE5           /STORE SOURCE ADDRESS IN LOCAL POINTER
+       TAD     MQ              /GET DESTINATION ADDRESS                /032 CJL
+       DCA     MOVE6           /STORE IN LOCAL POINTER
+MOVE1, TAD I   MOVE5           /GET A WORD FROM THE SOURCE
+       DCA I   MOVE6           /MOVE TO DESTINATION
+       ISZ     MOVE5           /BUMP SOURCE POINTER
+       ISZ     MOVE6           /BUMP DESTINATION COUNTER
+       ISZ     MOVE4           /BUMP COUNTER
+       JMP     MOVE1           /LOOP
+       JMP I   MOVE0           /DONE
+
+MOVE5, .-.                     /SOURCE POINTER FOR "MOVE"
+MOVE6, .-.                     /DESTINATION POINTER FOR "MOVE"
+
+       PAGE                                                            /014 CJL
+\f/     ROUTINE TO PARSE OFF A DEVICE NAME FROM THE COMMAND LINE.       /O14 CJL
+
+/      CALLING SEQUENCE:
+
+/      TAD     (POINTER)       /AC CONTAINS POINTER TO COMMAND LINE
+/      JMS I   [DPARS]         /CALL ROUTINE
+/      ERROR RETURN            /AC UNCHANGED
+/      GOOD RETURN             /AC NOW POINTS TO REST OF LINE
+
+/      DEVNUM= DEVICE NUMBER TO USE.
+/      ":" IS THE FIFTH CHARACTER IF NOT USING DEFAULT DEVICE.
+
+DPARS, .-.                     /DEVICE PARSE ROUTINE                   /014 CJL
+       DCA     DPAR10          /SAVE INITIAL POINTER TO LINE
+       TAD     DPAR10          /GET POINTER
+       JMS I   [NOSP]          /GET PAST ANY LEADING SPACES
+       JMP     DFDEV           /GOT END OF LINE, USE DEFAULT DEVICE
+       DCA     DPAR11          /SAVE POINTER TO LINE
+       DCA     DEVNAME         /INITIALIZE THE DEVICE NAME             /014 CJL
+       DCA     DEVNAME+1       /FOR "INQUIRE" FUNCTION                 /014 CJL
+       TAD     (DEVNAM)        /GET ADDRESS OF WHERE TO PUT DEVICE NAME/014 CJL
+       DCA     PACK6P          /STORE IN PACK6 POINTER
+       DCA     PACK6F          /INITIALIZE PACK6 FLAG FOR LOW BYTE     /014 CJL
+       TAD     (-4)            /SET UP A COUNTER                       /014 CJL
+       DCA     DPAR13          /FOR NO MORE THAN 4 CHARS
+DPAR1, TAD I   DPAR11          /GET A CHAR FROM THE LINE
+       SNA                     /SKIP IF NOT <EOL>                      /014 CJL
+       JMP     DFDEV           /GOT AN <EOL>, USE DEFAULT DEVICE       /014 CJL
+       TAD     (-":!200)       /CHECK FOR ":"                          /034 CJL
+       SNA CLA                 /SKIP IF NOT END OF DEVICE NAME
+       JMP     DPAR2           /DEVICE NAME SET UP
+       TAD I   DPAR11          /RE-GET CHAR
+       ISZ     DPAR11          /BUMP LINE POINTER
+       PACK6                   /PACK SIX-BIT                           /014 CJL
+       ISZ     DPAR13          /BUMP CHARACTER COUNTER                 /014 CJL
+       JMP     DPAR1           /CAN CONTINUE
+       TAD I   DPAR11          /GET CHARACTER AFTER THE FOURTH         /014 CJL
+       TAD     (-":!200)       /CHECK FOR ":"                          /034 CJL
+       SZA CLA                 /SKIP IF YES, ALL IS OK
+       JMP     DFDEV           /USE THE DEFAULT DEVICE
+DPAR2, ISZ     DPAR11          /BUMP POINTER PAST ":"
+       TAD     (DEVNAM)        /GET PARSED DEVICE NAME ADDRESS         /014 CJL
+       JMP     DPAR4           /DO AN OS/8 "INQUIRE"
+
+DFDEV, CLA CLL                 /CLEAN UP                               /019 CJL
+       TAD     DPAR10          /GET ORIGINAL AC FOR
+       DCA     DPAR11          /RETURN POINTER
+DPAR4, JMS     DVNUM           /GET DEVICE NUMBER
+       JMP     DPAR8           /DEVICE NAME ERROR
+       DCA     DEVNUM          /RETURN FOR CALLING PROGRAM
+       TAD     DPAR11          /GET CURRENT POINTER
+       ISZ     DPARS           /BUMP RETURN
+       JMP I   DPARS           /RETURN                                 /014 CJL
+\fDPAR8,        CLA CLL                 /INSURE CLEAR AC
+       TAD     DPAR10          /GET ORIGINAL AC
+       JMP I   DPARS           /TAKE ERROR EXIT
+
+DPAR10,        .-.                     /TEMPORARY FOR DPARS                    /014 CJL
+DPAR11,        .-.                     /TEMPORARY FOR DPARS                    /014 CJL
+DPAR13,        .-.                     /TEMPORARY FOR DPARS                    /014 CJL
+DEFDEV,        DEVICE  DSK             /DEFAULT DEVICE
+DEVNAM,        FILENAM ZZZZZZ.ZZ       /DEFAULT FILENAME                       /014 CJL
+
+/      ROUTINE TO RETURN A DEVICE NUMBER FOR A DEVICE NAME.            /014 CJL
+
+/      CALLING SEQUENCE:
+
+/      TAD     (ADDRESS)       /AC=ADDRESS OF DEVICE NAME
+/                              /*OR* 0000 IF "DSK:" IS TO BE USED
+/      ERROR RETURN            /INVALID DEVICE
+/      GOOD RETURN             /AC=DEVICE NUMBER
+
+DVNUM, .-.                     /DEVICE NUMBER ROUTINE                  /014 CJL
+       SNA                     /SKIP IF DEVICE NAME SPECIFIED
+       TAD     (DEFDEV)        /ELSE USE DEFAULT                       /014 CJL
+       DCA     DVNUM9          /SAVE IN LOCAL POINTER
+       TAD I   DVNUM9          /GET FIRST TWO CHARACTERS OF NAME       /014 CJL
+       DCA     DVNUM5          /PUT INTO CALL
+       ISZ     DVNUM9          /BUMP POINTER
+       TAD I   DVNUM9          /GET LAST TWO CHARACTERS OF NAME        /014 CJL
+       DCA     DVNUM5+1        /PUT INTO CALL
+       CIF     USRFLD          /GOTO USR FIELD                         /020 CJL
+       JMS I   [USRENTRY]      /CALL USER SERVICE ROUTINE              /035 CJL
+       INQUIRE                 /INQUIRE ABOUT HANDLER                  /020 CJL
+DVNUM5,        .-.                     /FIRST TWO BYTES OF DEVICE NAME         /014 CJL
+       .-.                     /LAST TWO BYTES OF DEVICE NAME          /014 CJL
+       0                       /ENTRY POINT OF HANDLER RETURNED HERE
+       JMP I   DVNUM           /ERROR, TAKE ERROR EXIT
+       TAD     DVNUM5+1        /DEVICE NUMBER
+       ISZ     DVNUM           /BUMP RETURN FOR NO ERROR
+       JMP I   DVNUM           /RETURN
+
+DVNUM9,        .-.                     /LOCAL FOR "DVNUM"                      /014 CJL
+\f/     DEVICE HANDLER FETCH ROUTINE.                                   /020 CJL
+
+/      CALLING SEQUENCE:
+
+/      TAD     (HANDLERNUMBER) /AC CONTAINS DEVICE HANDLER NUMBER
+/      JMS I   [HFETCH]        /CALL ROUTINE
+/      ERROR RETURN            /COULDN'T LOAD HANDLER
+/      GOOD RETURN             /HANDLER LOADED
+
+/      IF THE HANDLER WAS LOADED, THEN HNDADR CONTAINS THE HANDLER ENTRY POINT.
+
+HFETCH,        .-.                     /HANDLER FETCH ROUTINE
+       DCA     HANDNUMBER      /STORE HANDLER NUMBER
+       TAD     (HNDLR+1)       /GET OUR BUFFER+(TWO PAGE ALLOWED)
+       DCA     HADR            /STORE IN-LINE
+       TAD     HANDNUMBER      /GET HANDLER NUMBER AGAIN
+       CIF     USRFLD          /GOTO USR FIELD
+       JMS I   [USRENTRY]      /CALL USER SERVICE ROUTINE              /035 CJL
+       FETCH                   /FETCH HANDLER
+HADR,  .-.                     /WILL BE OUR SUGGESTED ADDRESS+TWO PAGES ALLOWED
+       SKP                     /COULDN'T DO IT
+       ISZ     HFETCH          /BUMP TO GOOD RETURN
+       CLA CLL                 /CLEAN UP
+       TAD     HADR            /GET ACTUAL HANDLER ADDRESS
+       DCA     HNDADR          /STASH THE POINTER
+       JMP I   HFETCH          /RETURN EITHER WAY
+
+HANDNUM,.-.                    /HANDLER NUMBER TEMPORARY
+
+\f/     ROUTINE TO HANDLE THE "FINISH" COMMAND.                         /021 CJL
+
+FINSRV,        0
+       JMS I   [CREST2]        /SETUP CONSOLE OUTPUT ROUTINES          /025 CJL
+       TAD     (MSEND)         /GET SEND MODE VALUE                    /045 CJL
+       DCA     KMODE           /SETUP PROPER MODE                      /045 CJL
+       FPACK                   /FORMAT A PACKET
+       SRVFIN                  /PACKET DATA ADDRESS
+       STGEN                   /PACKET TYPE
+
+FIN2,  SPACK                   /SEND PACKET
+       1                       /AWAIT RESPONSE
+       FIN20-2                 /DISPATCH LIST FOR RESPONSE             /027 CJL
+
+/      NAK OR UNDEFINED RESPONSE HERE
+
+FIN5,  ISZ     RTRYC           /BUMP RE-TRY COUNTER
+       JMP     FIN2            /GET RESPONSE AND TRY AGAIN
+       TAD     (NOFINISH)      /FAILED, RETURN MESSAGE                 /025 CJL
+       JMP I   FINSRV
+
+/      ACK HERE
+
+FIN10, ISZ     FINSRV          /BUMP FOR NON-ERROR EXIT
+       JMP I   FINSRV          /DONE
+
+FIN20, STACK;  FIN10           /ACK
+       STNAK;  FIN5            /NAK
+       0
+
+SRVFIN,        "F&137                  /SERVER KERMIT COMMAND TO SHUT DOWN
+       -1                      /END OF DATA
+
+       PAGE
+\f/     ROUTINE TO PARSE OFF A FILE NAME.
+/      FILE NAME TO BE PARSED MUST BE LETTERS OR DIGITS AND BE NO MORE THAN
+/      SIX CHARS FOR THE NAME AND TWO CHARS FOR THE EXTENSION.
+
+/      ENTER WITH:     AC =    POINTER TO FILE NAME TO PARSE.
+/                      FNPTR = POINTER TO WHERE TO PUT THE PARSED FILE NAME.
+
+/      NON-ERROR EXIT: AC =    POINTER TO REMAINDER OF COMMAND LINE.
+/                              RETURN THE CALL + 2.
+
+/      ERROR EXIT:     AC =    ORIGINAL POINTER.
+/                              RETURN THE CALL + 1.
+
+PFNAM, 0
+       DCA     PFN10           /SAVE POINTER TO FILE NAME STRING
+       TAD     FNPTR           /GET POINTER TO FILE NAME BLOCK
+       DCA     MQ              /SET FOR "CLEAR" ROUTINE                /032 CJL
+       TAD     (-4             /FOUR WORDS TO CLEAR OUT
+       CLEAR                   /INIT THE FILE NAME BLOCK
+       TAD     PFN10           /GET THE STRING POINTER
+       JMS I   [NOSP]          /GET PAST ANY LEADING SPACES
+       JMP     PFNAM9          /GOT EOL, NO FILE NAME
+       DCA     PFN11           /SAVE POINTER
+       TAD     FNPTR           /GET FILE NAME BLOCK POINTER
+       DCA     PACK6P          /SET UP THE "PACK6" POINTER
+       DCA     PACK6F          /INIT THE "PACK6" FLAG
+       TAD     (-6             /MAX OF 6 CHARS FOR FILE NAME
+       DCA     PFN15           /PUT INTO COUNTER
+       DCA     WILDF           /INIT THE WILD CARD FLAG
+       JMS     NAM             /MOVE AND PACK FILE NAME
+       TAD I   PFN11           /GET THE TERM CHAR
+       SPA                     /SKIP IF NOT EOL
+       JMP     PFNAM7          /EOL MEANS END OF FILE NAME
+       TAD     (-".!200)       /COMPARE TO "."                         /034 CJL
+       SNA                     /SKIP IF NO
+       JMP     PFNAM3          /GO HANDLE EXTENSION
+       TAD     (-" +".)        /COMPARE TO <SP>                        /034 CJL
+       SZA CLA                 /SKIP IF WAS A SPACE
+       JMP     PFNAM9          /NOT A SPACE, GOT AN ERROR
+       JMP     PFNAM7          /IS A SPACE, END OF FILE NAME
+\fPFNAM3,       ISZ     PFN11           /BUMP PAST THE "."
+       TAD     FNPTR           /GET FILE NAME BLOCK POINTER
+       TAD     (3)             /POINT TO EXTENSION                     /032 CJL
+       DCA     PACK6P          /SET "PACK6" POINTER
+       DCA     PACK6F          /INIT "PACK6" FLAG
+       NL7776                  /SET -2                                 /032 CJL
+       DCA     PFN15           /COUNTER FOR 2 EXT CHARS
+       JMS     NAM             /NOW DO THE EXTENSION
+       TAD I   PFN11           /GET THE TERM CHAR
+       SPA                     /SKIP IF NOT EOL
+       JMP     PFNAM7          /GOT COMPLETE FILE NAME HERE
+       TAD     [-" !200]       /COMPARE TO <SP>                        /034 CJL
+       SZA CLA                 /SKIP IF IT WAS
+       JMP     PFNAM9          /GOT A FILE NAME ERROR
+PFNAM7,        ISZ     PFNAM           /BUMP RETURN FOR GOOD FILE NAME
+       CLA CLL                 /INSURE CLEAR AC
+       TAD     PFN11           /GET CURRENT STRING POINTER
+       JMP I   PFNAM           /AND RETURN
+
+PFNAM9,        CLA CLL                 /INSURE CLEAR AC
+       TAD     PFN10           /GET ORIGINAL STRING POINTER
+       JMP I   PFNAM           /TAKE ERROR RETURN
+
+PFN10, 0                       /TEMP FOR PFNAM ROUTINE
+PFN11, 0                       /TEMP FOR PFNAM ROUTINE
+PFN15, 0                       /TEMP FOR PFNAM ROUTINE
+\f/     LOCAL ROUTINE TO "PFNAM" TO MOVE IN THE FILE NAME OR FILE EXTENSION.
+/      ENTER WITH "PFN11" POINTING TO WHERE TO GET THE NAME OR EXTENSION.
+/      AND "PFN15" EQUAL TO THE MAX NUMBER OF CHARS (6 FOR NAME, 2 FOR EXT).
+/      THIS ROUTINE CHECKS FOR WILD CARD CHARS "*" AND "?" AND PUTS THE
+/      "?" CHAR IN FOR ANY CHARS IN THE NAME THAT ARE WILD.  ALSO IF ANY
+/      WILD CARD CHARS ARE FOUND THE FLAG "WILDC" IS SET SO BEFORE PARSING
+/      ANY FILE NAME THE "WILDC" FLAG SHOULD BE INITIALIZED.
+
+NAM,   0
+NAM0,  TAD I   PFN11           /GET A CHAR FROM THE STRING
+       JMS I   (ALPNUM)        /MUST BE ALPHA OR NUMBER
+       SKP                     /NOT A ALPHA NUMERIC
+       JMP     NAM3            /IS ALPHA NUMERIC
+       TAD     (-"?!200)       /COMPARE TO "?"                         /034 CJL
+       SNA                     /SKIP IF NO
+       JMP     NAM2            /YES, JUST PUT IT IN
+       TAD     (-"*+"?)        /COMPARE TO "*"                         /034 CJL
+       SZA CLA                 /SKIP IF YES
+       JMP I   NAM             /TAKE THE FILE NAME ERROR EXIT
+       ISZ     WILDF           /SET FLAG FOR WILD CARD FOUND
+NAM1,  TAD     ["?&77]         /GET WILD CARD CHARACTER                /034 CJL
+       PACK6                   /PUT IN NAME BLOCK
+       ISZ     PFN15           /BUMP CHAR COUNTER
+       JMP     NAM1            /LOOP TILL ALL FILLED
+       ISZ     PFN11           /BUMP THE STRING POINTER
+       JMP     NAM9            /EXIT WITH "PFN11" POINTING TO NEXT CHAR
+NAM2,  ISZ     WILDF           /SET FLAG FOR WILD CARD FOUND
+       TAD     ["?&77]         /GET WILD CARD CHARACTER                /034 CJL
+NAM3,  PACK6                   /PUT THE CHAR INTO THE FILE NAME BLOCK
+       ISZ     PFN11           /BUMP THE STRING POINTER
+       ISZ     PFN15           /BUMP THE CHAR COUNTER
+       JMP     NAM0            /LOOP
+
+NAM4,  TAD I   PFN11           /NOW GET TO A TERMINATOR CHAR
+       JMS I   (ALPNUM)        /BY FINDING FIRST NON-ALPHNUMERIC
+       JMP     NAM9            /NOW WE CAN QUIT
+       CLA CLL                 /IGNORE EXCESS CHARS
+       ISZ     PFN11           /BUMP THE STRING POINTER
+       JMP     NAM4            /LOOP
+
+NAM9,  CLA CLL                 /LEAVE WITH A CLEAR AC
+       JMP I   NAM             /RETURN
+\f/     ROUTINE TO SEND A PACKET.
+/      ENTER WITH ADDRESS OF PACKET DATA IN CALL + 1.
+/      AND TYPE OF PACKET IN CALL + 2.
+/      EXIT CALL + 4 IF ACK RETURNED.
+/      EXIT CALL + 3 IF NAK OR OTHER PACKET TYPE RETURNED.
+
+SNDP,  0
+       TAD I   SNDP            /GET DATA ADDRESS
+       DCA     SNDP1           /STORE IN CALL
+       ISZ     SNDP            /BUMP POINTER
+       TAD I   SNDP            /GET PACKET TYPE
+       DCA     SNDP2           /STORE IN CALL
+       ISZ     SNDP            /BUMP
+
+       FPACK                   /FORMAT A PACKET
+SNDP1, 0                       /DATA ADDRESS GOES HERE
+SNDP2, 0                       /PACKET TYPE GOES HERE
+
+SNDP3, SPACK                   /SEND A DATA PACKET
+       1                       /GET RESPONSE
+       SNDP9-2                 /RESPONSE DISPATCH TABLE ADDRESS        /027 CJL
+
+/      HERE ON NOT "NAK" OR "ACK" RESPONSE.
+
+       SKP
+
+/      HERE ON "ACK".
+
+SNDP5, ISZ     SNDP            /BUMP RETURN
+
+       ISZ     SNDP            /BUMP RETURN
+       JMP I   SNDP            /EXIT
+
+/      HERE ON NAK.
+
+SNDP4, ISZ     RTRYC           /BUMP THE RE-TRY COUNTER
+       JMP     SNDP3           /RE-TRY
+       JMP I   SNDP            /TAKE RETURN + 3
+
+SNDP9, STACK;  SNDP5           /ACK
+       STACK;  SNDP4           /NAK
+       0
+
+       PAGE                                                            /014 CJL
+\f      IFZERO  1       <
+
+/      ROUTINE TO PARSE OFF A DECIMAL NUMBER.
+/      ENTER ROUTINE WITH A POINTER TO THE PARSE LINE IN THE AC.
+/      EXIT:   RETURN + 1 FOR NO NUMBER.
+/              RETURN + 2 FOR INVALID NUMBER.
+/              RETURN + 3 FOR VALID NUMBER.
+
+/      IN ALL CASES ON RETURN THE AC WILL CONTAIN A POINTER TO THE NEXT CHAR TO PARSE
+/      IN THE LINE.  ANY NUMBER  PARSED  WILL BE CONVERTED TO BINARY AND PUT INTO THE
+/      REGISTER "BININP".
+
+DECPRS,        0
+       JMS I   [NOSP]          /GET PAST ANY LEADING SPACES
+       JMP I   DECPRS          /GOT AN END OF LINE, AC POINTS TO IT
+       DCA     DP10            /SAVE POINTER TO LINE
+       TAD     DP10            /RE-GET POINTER TO LINE
+       DCA     DP11            /STORE IN OUR LINE POINTER
+       DCA     BININP          /INIT BINARY REGISTER
+       DCA     DP13            /INIT PARSED NUMBER FLAG
+       SKP                     /SKIP INTO LOOP BELOW
+DP1,   ISZ     DP11            /BUMP THE LINE POINTER
+       TAD I   DP11            /GET A CHAR FROM THE LINE
+       JMS     DECCK           /CHECK FOR PROPER ASCII DECIMAL
+       JMP     DP5             /NOT PROPER ASCII DECIMAL
+       ISZ     DP13            /FLAG NUMBER INPUT
+       TAD     (-"0            /MAKE BINARY
+       DCA     DP12            /AND STORE
+       TAD     BININP          /GET PREVIOUS INPUT
+       JMS     MUL10           /AND MULTIPLY TIMES 10
+       SZL                     /SKIP IF NO OVERFLOW ENCOUNTERED
+       JMP     DP6             /GOT AN OVERFLOW ERROR
+       TAD     DP12            /COMBINE WITH CURRENT INPUT
+       SZL                     /SKIP IF NO OVERFLOW ERROR
+       JMP     DP6             /GOT AN OVERFLOW ERROR
+       DCA     BININP          /RETURN ACCUMULATED SUM
+       JMP     DP1             /LOOP
+
+DP5,   CLA CLL                 /AC MAY NOT BE CLEAR
+       TAD     DP13            /ANY NUMBERS INPUT YET?
+       SNA CLA                 /SKIP IF YES
+       JMP     DP6             /TAKE THE NO NUMBER INPUT RETURN
+       ISZ     DECPRS          /BUMP THE RETURN
+       ISZ     DECPRS          /TWICE FOR GOOD NUMBER INPUT RETURN
+       TAD     DP11            /GET POINTER TO LINE
+       JMP I   DECPRS          /AND RETURN
+
+DP6,   CLA CLL                 /AC MAY NOT BE CLEAR
+       TAD     DP10            /GET ORIGINAL LINE POINTER
+       ISZ     DECPRS          /BUMP THE RETURN
+       JMP I   DECPRS          /TAKE THE INVALID NUMBER RETURN
+
+                       >
+\f      IFZERO  1       <
+
+DP10,  0                       /TEMP FOR DECPRS
+DP11,  0                       /TEMP FOR DECPRS
+DP12,  0                       /TEMP FOR DECPRS
+DP13,  0                       /TEMP FOR DECPRS
+
+/      ROUTINE TO MULTIPLY THE VALUE OF THE AC TIMES 10.
+/      VALUE IN THE AC IS ASSUMED BINARY.
+
+/      THE NUMBER IS RETURNED IN THE AC.  IF THE LINK IS SET THE MULTIPLY
+/      OVERFLOWED 12 BITS.
+
+MUL10, 0
+       DCA     MULTMP          /SAVE THE NUMBER
+       TAD     MULTMP          /GET THE NUMBER BACK
+       CLL RTL                 /MULTIPLY TIMES 4
+       TAD     MULTMP          /TIMES 5
+       SNL                     /SKIP IF ALREADY OVERFLOWED             /025 CJL
+       RAL                     /TIMES 10
+       JMP I   MUL10           /RETURN NUMBER IN AC
+                               /THE LINK HAS ANY OVERFLOW
+
+MULTMP,        0                       /TEMP STORAGE FOR MUL10 ROUTINE
+
+
+
+/      ROUTINE TO CHECK FOR A VALID ASCII DECIMAL VALUE.
+
+/      ENTER WITH ASCII CHAR IN THE AC.
+/      EXIT RETURN + 1 IF NON-VALID ASCII DECIMAL WITH CHAR IN AC.
+/      EXIT RETURN + 2 IF VALID ASCII DECIMAL WITH CHAR IN AC.
+
+DECCK, 0
+       DCA     DECCK5          /STORE THE CHAR TO CHECK
+       TAD     DECCK5          /GET THE CHAR
+       TAD     (-"0            /CHECK FOR LESS THAN 0
+       SPA                     /SKIP IF NOT LESS THAN 0
+       JMP     DECCK1          /NON-ASCII DECIMAL
+       TAD     ("0-"9-1        /CHECK GREATER THAN 9
+       SMA CLA                 /SKIP IF LE 9
+       JMP     DECCK1          /INVALID ASCII DECIMAL
+       ISZ     DECCK           /BUMP RETURN FOR VALID ASCII DECIMAL
+DECCK1,        TAD     DECCK5          /RE-GET ORIGINAL CHAR IN AC
+       JMP I   DECCK           /RETURN
+
+
+DECCK5,        0                       /TEMP FOR "DECCK" ROUTINE
+
+                       >
+\f/     ROUTINE TO INPUT A COMMAND LINE FROM THE KEYBOARD.              /013/014 CJL
+
+LININP,        0
+       TAD     (LINBUF         /GET ADDRESS OF LINE BUFFER
+       DCA     LIN50           /STORE IN A POINTER
+LIN1,  JMS I   (INPUT)         /GET A CHARACTER FROM THE KEYBOARD      /044 CJL
+       TAD     (-CNTRLM)       /COMPARE TO <CR>                        /034 CJL
+       SNA                     /SKIP IF NOT A RETURN
+       JMP     LIN2            /LINE IS INPUT
+       TAD     (-DELETE+CNTRLM)/COMPARE TO <DEL>                       /034 CJL
+       SNA CLA                 /SKIP IF NOT A DELETE
+       JMP     LIN5            /OFF TO HANDLE A DELETE
+       TAD     LIN50           /GET VALUE OF LINE POINTER
+       TAD     (-LINBUF-LINSIZ /COMPARE WITH END OF LINE BUFFER
+       SMA CLA                 /SKIP IF ROOM IN LINE BUFFER
+       JMP     LIN10           /BEEP FOR FULL BUFFER
+       TAD     INCHAR          /GET THE KEYBOARD CHARACTER AGAIN       /044 CJL
+       TAD     (-140)          /COMPARE TO LOWER-CASE LIMIT            /034 CJL
+       SMA                     /SKIP IF BELOW LIMIT                    /034 CJL
+       TAD     [-40]           /ELSE MAKE IT UPPER-CASE                /034 CJL
+       TAD     (140)           /RESTORE THE CHARACTER                  /034 CJL
+       DCA I   LIN50           /STORE IN THE LINE BUFFER
+       ISZ     LIN50           /BUMP THE LINE BUFFER POINTER
+       NL7777                  /SET -1                                 /032 CJL
+       DCA I   LIN50           /TERMINATE THE LINE
+       TAD     INCHAR          /GET THE LATEST KEYBOARD CHARACTER BACK /044 CJL
+       JMS I   [P7ECHO]        /PRINT IT                               /043 CJL
+       JMP     LIN1            /LOOP TILL A RETURN TYPED
+
+LIN2,  NL7777                  /SET -1                                 /032 CJL
+       DCA I   LIN50           /INSURE STRING TERMINATED
+       JMS I   [SCRIBE]        /DO A                                   /025 CJL
+       CRLF                    /<CR>, <LF>                             /025 CJL
+       JMP I   LININP          /DONE
+
+/      HANDLE A DELETE TYPED IN
+
+LIN5,  TAD     LIN50           /FIND OUT FIRST IF...
+       TAD     (-LINBUF        /WE ARE AT THE BEGINNING OF THE LINE
+       SNA CLA                 /SKIP IF NO
+       JMP     LIN1            /JUST IGNORE THE DELETE
+       NL7777                  /SET -1                                 /032 CJL
+       TAD     LIN50           /GET THE LINE POINTER
+       DCA     LIN50           /RETURN BACKED UP
+       DCA I   LIN50           /ZERO THE CHAR
+       TAD     (CNTRLH)        /GET A <BS>                             /025 CJL
+       JMS I   [P7ECHO]        /PRINT IT                               /043 CJL
+       TAD     [" &177]        /GET A <SPACE>                          /025 CJL
+       JMS I   [P7ECHO]        /PRINT IT                               /043 CJL
+       TAD     (CNTRLH)        /GET A <BS>                             /025 CJL
+       JMS I   [P7ECHO]        /PRINT IT                               /043 CJL
+       JMP     LIN1            /BACK TO INPUT
+\f/     HANDLE FULL LINE BUFFER HERE
+
+LIN10, CLA CLL                 /ENSURE CLEAR AC
+       TAD     [CNTRLG]        /GET A <BEL> CHARACTER                  /025 CJL
+       JMS I   [P7ECHO]        /PRINT IT                               /043 CJL
+       JMP     LIN1            /WAIT FOR EITHER RETURN OF DELETE KEY
+
+LIN50, 0                       /TEMP POINTER FOR "LININP" ROUTINE
+\f/     ROUTINE TO PACK TWO SIX-BIT CHARACTERS INTO A WORD.             /032 CJL
+
+/      CALLING SEQUENCE:
+
+/      [PACK6PTR => CHARACTER PACKING AREA].
+/      [PACK6FLAG=0 IF PACKING INTO HIGH-ORDER BYTE.
+/      PACK6FLAG=4000 IF PACKING INTO LOW-ORDER BYTE].
+
+/      TAD     CHAR            /AC CONTAINS CHARACTER TO BE PACKED
+/      PACK6                   /CALL VIA PAGE ZERO POINTER
+
+/      RETURNS WITH AC CLEAR AND PACK6PTR AND PACK6FLAG UPDATED FOR NEXT PACKING.
+
+PACK60,        .-.                     /PACK SIX-BIT ROUTINE
+       AND     [77]            /JUST SIX-BIT
+       DCA     PACK6TEMP       /SAVE FOR NOW
+       NL4000                  /SET INVERSION BIT
+       TAD     PACK6FLAG       /REVERSE THE FLAG
+       DCA     PACK6FLAG       /STORE BACK
+       SZL                     /WAS IT CLEAR?
+       JMP     PACKIT          /NO, GO DO LOW-ORDER
+       TAD     PACK6TEMP       /GET THE CHARACTER
+       RTL;RTL;RTL             /MOVE UP
+       DCA I   PACK6PTR        /STORE IT
+       JMP I   PACK60          /RETURN
+
+PACKIT,        TAD I   PACK6PTR        /GET PREVIOUS HIGH-ORDER HALFWORD
+       TAD     PACK6TEMP       /ADD ON LATEST
+       DCA I   PACK6PTR        /STORE BOTH
+       ISZ     PACK6PTR        /BUMP FOR NEXT TIME
+       JMP I   PACK60          /RETURN
+
+PACK6TE,.-.                    /PACK6 TEMPORARY
+\f/     ROUTINE TO COMPARE TWO FILE NAMES FOR EQUALITY.
+/      THE ROUTINE WILL CHECK EACH OF THE 8 FILE NAME CHARS AND IF A
+/      CHAR IN THE FIRST FILE NAME (THE ONE WE ARE LOOKING FOR) CONTAINS
+/      A "?" IT WILL MATCH ON THE SECOND FILE NAME CHAR.
+/      ENTER WITH "FCMP1" POINTING TO THE FILE NAME TO FIND, AND "FCMP2"
+/      POINTING TO THE FILE NAME TO TRY AND MATCH.  EXIT + 1 IF NO MATCH
+/      AND EXIT + 2 IF MATCH.  (IF NON-ZERO AC ON ENTRY, THE AC IS ASSUMED
+/      TO HAVE THE VALUE FOR "FCMP2".)
+
+FMATCH,        0
+       SZA                     /SKIP IF NO ARGUMENT IN AC
+       DCA     FCMP2           /THIS ARGUMENT CAME IN THE AC
+       TAD     FCMP1           /GET ADDRESS OF FIRST FILE NAME BLOCK
+       DCA     GET6P           /STORE IN A POINTER
+       DCA     GET6F           /INIT FLAG FOR "GET6" ROUTINE
+       TAD     FCMP2           /GET ADDRESS OF SECOND FILE NAME BLOCK
+       DCA     FMATP           /STORE IN A LOCAL POINTER
+       DCA     FMATF           /INIT LOCAL FLAG
+       TAD     (-10            /8 CHARS TO DO
+       DCA     FMATC           /STORE IN LOCAL COUNTER
+
+FMAT1, NL4000                  /SET 4000                               /032 CJL
+       TAD     FMATF           /GET FLAG
+       DCA     FMATF           /RETURN FLAG, LINK CONTAINS STATUS
+       TAD I   FMATP           /GET A WORD FROM THE SECOND NAME
+       SZL                     /SKIP IF HIGH-ORDER WANTED NOW          /032 CJL
+       JMP     FSWIT           /JUMP IF LOW-ORDER WANTED NOW           /032 CJL
+       RTR;RTR;RTR             /MOVE DOWN HIGH-ORDER                   /032 CJL
+       SKP                     /DON'T BUMP YET                         /032 CJL
+FSWIT, ISZ     FMATP           /BUMP THE POINTER                       /032 CJL
+       AND     [77]            /KEEP ONLY BOTTOM 6 BITS                /016 CJL
+       DCA     FMATT           /STORE IN A TEMP
+       GET6                    /NOW GET A CHAR FROM FIRST NAME
+       TAD     (-77            /CHECK IF WILD
+       SNA                     /SKIP IF NO
+       JMP     FMAT2           /NO MATCH CHECK ON A WILD CARD
+       TAD     [77]            /RESTORE THE CHARACTER                  /014/016 CJL
+       CIA                     /NEGATE FOR COMPARE
+       TAD     FMATT           /COMPARE WITH SECOND FILE NAME
+       SZA CLA                 /SKIP IF IS A MATCH
+       JMP I   FMATCH          /THIS IS NOT A MATCH
+
+FMAT2, ISZ     FMATC           /BUMP COUNTER
+       JMP     FMAT1           /LOOP, MORE TO CHECK
+       ISZ     FMATCH          /BUMP RETURN FOR MATCH
+       JMP I   FMATCH          /GOT A MATCH
+
+FMATP, 0                       /POINTER FOR "FMATCH"
+FMATC, 0                       /COUNTER FOR "FMATCH"
+FMATF, 0                       /FLAG FOR "FMATCH"
+FMATT, 0                       /TEMP FOR "FMATCH"
+FCMP1, 0                       /POINTER FOR FIRST FILE NAME BLOCK
+FCMP2, 0                       /POINTER FOR SECOND FILE NAME BLOCK
+\f      PAGE                                                            /014 CJL
+\f/     REMOTE LINK INPUT ROUTINE.
+/      CALL = RPACK.
+
+ILINK, 0
+       TAD     RETRY           /SET UP A RE-TRY COUNT
+       DCA     ILINK6          /RE-TRY COUNT FOR INPUT ERRORS
+
+ILINK0,        JMS I   (GETSOH)        /FIRST GET THE "SOH" BYTE
+       JMP     ILINK2          /RETURN HERE ON TIME-OUT
+       DCA     ILINK9          /INIT CHECKSUM REGISTER
+       TAD     [RRLEN]         /GET REMOTE RECEIVE BUFFER ADDRESS
+       DCA     ILINK8          /STORE IN LOCAL POINTER
+       JMS I   (GETIR)         /GET A CHAR
+       JMP     ILINK2          /GOT A RETURN OR TIME-OUT
+       DCA I   ILINK8          /STORE LENGTH IN BUFFER
+       TAD I   ILINK8          /GET LENGTH CHAR BACK
+       TAD     (-40-1          /CHAR FUNCTION - LENGTH BYTE
+       CIA                     /NEGATE FOR COUNTER
+       DCA     ILINK7          /STORE IN LOCAL COUNTER
+
+ILINK1,        ISZ     ILINK8          /BUMP POINTER
+       JMS I   (GETIR)         /GET NEXT CHAR
+       JMP     ILINK2          /GOT A RETURN
+       DCA I   ILINK8          /STORE IN BUFFER
+       ISZ     ILINK7          /BUMP COUNTER
+       JMP     ILINK1          /LOOP
+
+       ISZ     ILINK8
+       NL7777                  /SET -1                                 /032 CJL
+       DCA I   ILINK8
+       TAD     ILINK9          /GET CALCULATED CHECKSUM
+       JMS I   [CKSUM]         /CALCULATE 1 BYTE CHECKSUM
+       CIA                     /NEGATE FOR COMPARE
+       DCA     ILINK7          /STORE TEMP
+       JMS I   (GETIR)         /NOW GET CHECKSUM
+       JMP     ILINK2          /GOT A RETURN
+       TAD     ILINK7          /COMPARE WITH CALCULATED CHECKSUM
+       SNA CLA                 /SKIP IF NOT SAME
+       JMP     ILINK4          /ARE SAME
+
+ILINK2,        CLA CLL                 /INSURE CLEAR AC
+       ISZ     ILINK6          /BUMP RE-TRY COUNTER
+       JMP     ILINK3          /CAN RE-TRY
+       TAD     (RPERMSG)       /GET MESSAGE FOR FATAL PACKET ERROR     /025 CJL
+       JMP I   [CLOOP7]        /AND ABORT THE MESS
+
+ILINK3,        TAD     ABFLAG          /GET ABORT FLAG                         /044 CJL
+       SZA CLA                 /SKIP IF NO
+       JMP I   (ABORT)         /ABORT THIS
+       JMS I   (SNDNAK)        /SEND BACK A "NAK"
+       JMP     ILINK0          /AND TRY AGAIN
+\fILINK4,       TAD     ABFLAG          /GET ABORT FLAG                         /044 CJL
+       SNA CLA                 /SKIP IF YES
+       JMP I   ILINK           /NOPE, RETURN
+       JMP I   (ABORT)
+
+ILINK6,        0                       /LOCAL TO "ILINK"
+ILINK7,        0                       /LOCAL TO "ILINK"
+ILINK8,        0                       /LOCAL TO "ILINK"
+ILINK9,        0                       /LOCAL TO "ILINK"
+
+/      HELP COMMAND ROUTINE.                                           /024 CJL
+
+HELPSRV,.-.                    /HELP ROUTINE
+       JMS I   [CRESET]        /RESET CONSOLE ROUTINE STUFF
+       JMS I   [SCRIBE]        /GIVE THEM THE
+       HELPMSG                 /HELP MESSAGE
+       TAD     ESCHAR          /GET THE ESCAPE CHARACTER
+       JMS I   [ESCPRNT]       /PRINT IT
+       JMS I   [SCRIBE]        /DO A
+       CRLF                    /<CR>, <LF>
+       ISZ     HELPSRV         /BUMP PAST ERROR RETURN
+       JMP I   HELPSRV         /RETURN
+
+/      ROUTINE TO PRINT THE DATA IN THE RECEIVED PACKET.
+
+PRIPAK,        0
+       PRI8B;  RRDTA           /PRINT THE DATA
+       JMS I   [SCRIBE]        /DO A                                   /025 CJL
+       CRLF                    /<CR>, <LF>                             /025 CJL
+       JMP I   PRIPAK          /DONE
+
+       PAGE                                                            /014 CJL
+\f/     ROUTINE TO SERVICE A SEND REQUEST.
+
+SNDSRV,        0
+       JMS I   [CREST2]        /SETUP CONSOLE OUTPUT ROUTINES          /025 CJL
+       TAD     (MSEND)         /FIRST SET MODE TO SEND
+       DCA     KMODE           /PUT INTO MODE FLAG
+       TAD     LPTR            /GET CURRENT LINE POINTER
+       DCA     PRSERR          /SAVE LINE POSITION
+       TAD     PRSERR          /GET LINE POSITION
+       JMS I   [DPARS]         /TRY TO PARSE OFF A DEVICE NAME
+       JMS     SNDERROR        /RETURN A DEVICE NAME ERROR             /026 CJL
+SER1,  DCA     PRSERR          /SAVE LINE POINTER                      /026 CJL
+       TAD     (FNBLK          /GET FILE NAME BLOCK ADDRESS
+       DCA     FNPTR           /STORE IN POINTER
+       TAD     PRSERR          /GET STRING POINTER
+       JMS I   [PFNAM]         /PARSE OFF THE FILE NAME
+       JMS     SNDERROR        /FILE NAME PARSE ERROR                  /026 CJL
+SER2,  DCA     PRSERR          /SAVE THE STRING POINTER                /026 CJL
+       TAD     PRSERR          /GET THE STRING POINTER
+       JMS I   [NOSP]          /FIND THE END OF STRING
+       SKP                     /GOT END OF STRING HERE
+       JMS     SNDERROR        /SYNTAX ERROR                           /026 CJL
+SER3,  DCA     PRSERR          /RETURN POINTER                         /026 CJL
+       TAD     DEVNUM          /GET THE DEVICE NUMBER PARSED
+       JMS I   [HFETCH]        /FETCH A HANDLER FOR THIS
+       JMS     SNDERROR        /HANDLER FETCH ERROR                    /026 CJL
+SER4,  DCA     FILFND          /INIT FILE FOUND FLAG
+       DCA     INIFLG          /CLEAR THE INIT DONE FLAG
+       NL0001                  /INITIALIZE DIRECTORY                   /028 CJL
+       DCA     SLFLAG          /LOOKUP FLAG                            /028 CJL
+SNDSV1,        TAD     (FNBLK          /GET FILE NAME BLOCK ADDRESS
+       DCA I   (FCMP1)         /SET FOR FILE TO FINE
+       TAD     SLFLAG          /GET DIRECTORY FLAG                     /028 CJL
+       JMS I   (LUKUP)         /FIND A MATCH FOR THIS FILE
+       JMS     SNDERROR        /DIRECTORY I/O ERROR                    /026 CJL
+SER5,  JMP     S00             /FILE NOT FOUND                         /026 CJL
+       ISZ     FILFND          /BUMP FILE FOUND COUNT
+       DCA     SLFLAG          /DON'T INITIALIZE LOOKUP AGAIN
+       JMS I   (SNDPRO)        /PROCESS THIS FILE FOR SEND
+       JMS     SNDERROR        /ERROR IN FILE SEND PROCESS             /026 CJL
+SER6,  TAD     WILDF           /WAS WILD CARD FILE SPEC?               /026 CJL
+       SZA CLA                 /SKIP IF NO
+       JMP     SNDSV1          /GOT WILD CARD, TRY FOR NEXT
+S00,   TAD     FILFND          /CHECK FOR ANY FILES FOUND
+       SNA CLA                 /SKIP IF YES
+       JMS     SNDERROR        /RETURN FILE NOT FOUND ERROR            /026 CJL
+SER7,  JMS     BRKXMT          /BREAK THE SEND                         /026 CJL
+       TAD     PRSERR          /GET CURRENT CURSOR POSITION
+       DCA     LPTR            /UPDATE
+       ISZ     SNDSRV          /BUMP RETURN
+       JMP I   SNDSRV          /AND DONE
+\f/     SEND ERRORS COME HERE.                                          /026 CJL
+
+SNDERRO,.-.                    /SEND ERROR ROUTINE
+       CLA                     /CLEAN UP
+       TAD     SNDERROR        /GET CALLER
+       JMS I   [SRCHTABLE]     /GO MATCH IT
+       SNERTABLE-1-1           /IN ERROR TABLE
+       JMP I   SNDSRV          /TAKE ERROR EXIT WITH MESSAGE ADDRESS IN AC
+
+/      SEND ERROR MESSAGE DISPATCH TABLE.                              /026 CJL
+
+SNERTAB,-SER1; DNERMSG         /DEVICE NAME ERROR
+       -SER2;  FNERMSG         /FILE NAME ERROR
+       -SER3;  FSERMSG         /FILE NAME SYNTAX ERROR
+       -SER4;  SHFEMSG         /HANDLER FETCH ERROR
+       -SER5;  SDERMSG         /DIRECTORY I/O ERROR
+       -SER6;  SNDEMSG         /SEND ERROR
+       -SER7;  NOTFND          /LOOKUP
+       0                       /THIS ENDS THE LIST
+
+FILFND,        0                       /HOLDS COUNT OF # OF FILES FOUND
+SLFLAG,        .-.                     /LOOKUP INITIALIZE FLAG                 /028 CJL
+FNBLK, 0
+       0
+       0
+       0
+\f/     ROUTINE TO RE-SET THE SEND.
+
+BRKXMT,        .-.
+       CLA CLL                 /INSURE CLEAR AC
+       DCA     INIFLG          /CLEAR THE INIT SEND FLAG
+       FPACK                   /FORMAT A PACKET
+       NODATA                  /NO DATA FOR THIS PACKET
+       STEOT                   /"EOT" PACKET TYPE
+       SPACK                   /SEND THE PACKET
+       1                       /READ RESPONSE                          /042 CJL
+       0                       /DO NOT DISPATCH                        /042 CJL
+       JMP I   BRKXMT          /DONE
+
+/      ROUTINE TO SEND OUT A NAK WITHOUT DISTURBING THE NORMAL PACKET BUFFER.
+
+SNDNAK,        0
+       NL7777                  /-1                                     /042 CJL
+       TAD     CURSEQ          /ADD ON CURRENT SEQUENCE NUMBER         /042 CJL
+       AND     [77]            /MODULO 64                              /042 CJL
+       TAD     [40]            /TAKE CHAR(SEQUENCE NUMBER)             /042 CJL
+       DCA     NAKPAK+2        /PUT IN NAK PACKET BUFFER
+       TAD     NAKPAK+1        /GET LENGTH
+       TAD     NAKPAK+2        /GET SEQ
+       TAD     NAKPAK+3        /GET TYPE
+       JMS I   [CKSUM]         /CALCULATE CHECKSUM
+       DCA     NAKPAK+4        /PUT IN CHECKSUM
+       TAD     REOL            /GET ANY EOL REQUIRED
+       TAD     [-40]           /UN-CHAR IT                             /014/016 CJL
+       SNA                     /SKIP IF USING
+       NL7777                  /NO EOL, PUT IN -1 INSTEAD              /032 CJL
+       DCA     NAKPAK+5        /PUT EOL IN
+       REM8B;  NAKPAK          /SEND NAK TO REMOTE
+       JMP I   SNDNAK          /DONE
+
+
+NAKPAK,        CNTRLA                  /MARK                                   /042 CJL
+       " &77+3                 /LENGTH OF NAK PACKET                   /042 CJL
+       .-.                     /SEQUENCE NUMBER GOES HERE              /042 CJL
+       STNAK                   /DATA TYPE
+       .-.                     /CHECKSUM                               /042 CJL
+       .-.                     /<EOL> IF USED                          /042 CJL
+       -1                      /TERMINATE
+
+/      FILENAME BUFFER.                                                /014 CJL
+
+NAMBUFF,ZBLOCK 12              /FILENAME.EXTENSION (WITH TERMINATOR) GOES HERE
+\f      PAGE                                                            /014 CJL
+\f/     ROUTINE TO SERVICE A "GET" COMMAND.
+
+GETSRV,        0
+       JMS I   [CREST2]        /SETUP CONSOLE OUTPUT ROUTINES          /025 CJL
+       TAD     (MREC)          /GET OUR MODE VALUE                     /045 CJL
+       DCA     KMODE           /SETUP NOW                              /045 CJL
+       TAD     LPTR            /GET CURRENT LINE POINTER
+       DCA     PRSERR          /SAVE
+       TAD     PRSERR          /RE-GET IT
+       JMS I   [DPARS]         /PARSE OFF THE DEVICE NAME              /006/014 CJL
+       JMP     GSRV50          /ERROR IN DEVICE NAME                   /006
+       JMS I   [NOSP]          /FIND BEGINNING OF A FILE NAME
+       JMP     GSRV22          /GOT <EOL>, NO FILE NAME                /006/014 CJL
+       DCA     GSRV90          /STORE BEGINNING ADDRESS
+       TAD     GSRV90          /NOW WE LOOK FOR
+       JMS I   [SP]            /THE END OF THE LINE
+       SKP                     /GOT THE END OF THE LINE HERE
+       JMP     .-2             /NOT END YET, CONTINUE
+       DCA     PRSERR          /STORE POINTER TO EOL
+       NL7777                  /SET -1                                 /032 CJL
+       DCA I   PRSERR          /TERMINATE FILE NAME WITH -1
+       DCA     CURSEQ          /RE-SET THE SEQUENCE
+       TAD     GSRV90          /GET ADDRESS OF FILE NAME
+
+GSRV10,        FPACK                   /FORMAT THE PACKET
+GSRV90,        0                       /DATA ADDRESS HERE
+       STRIN                   /RECIEVE INIT PACKET
+
+GSRV12,        SPACK                   /SEND THE PACKET
+       1                       /GET RESPONSE
+       GSRV80-2                /DISPATCH TABLE                         /027 CJL
+
+/      SERVICE A NAK OR UNDEFINED.
+
+GSRV15,        ISZ     RTRYC           /BUMP THE RE-TRY COUNTER
+       JMP     GSRV12          /TRY AGAIN
+       JMP I   GETSRV          /GIVE UP
+
+/      SERVICE A SEND/INIT FROM THE REMOTE.
+
+GSRV20,        JMS I   (INPSRV)        /HANDLE JUST LIKE A RECEIVE
+       JMP     GSRV21          /ERROR RETURN FROM "INPSRV"
+       ISZ     GETSRV          /BUMP RETURN FOR NO ERROR
+       TAD     PRSERR          /UPDATE THE CURRENT LINE POINTER
+       DCA     LPTR
+GSRV21,        JMP I   GETSRV
+
+GSRV22,        CLA CLL                 /MAKE SURE WE ARE CLEAR                 /009/014 CJL
+       TAD     [NOTFND]        /GET ERROR MESSAGE ADDRESS              /025 CJL
+       JMP I   GETSRV          /TAKE ERROR RETURN                      /009/014 CJL
+
+/      GOT AN ERROR PACKET, DISPLAY ERROR AND ABORT.
+
+GSRV40,        JMS I   [PRIPAK]        /PRINT OUT THE ERROR PACKET
+       JMP I   GETSRV          /TAKE THE ERROR EXIT
+\f/     GOT DEVICE ERROR.                                               /006/014 CJL
+
+GSRV50,        CLA CLL                 /ENSURE CLEAR AC                        /006/014 CJL
+       TAD     (DNERMSG)       /GET ERROR MESSAGE ADDRESS              /025 CJL
+       JMP I   GETSRV          /TAKE ERROR RETURN                      /006/014 CJL
+
+/      DISPATCH TABLE.
+
+GSRV80,        STERR;  GSRV40          /ERROR PACKET RETURNED
+       STSIN;  GSRV20          /SEND INIT PACKET RETURNED
+       STNAK;  GSRV15          /NAK PACKET RETURNED
+       0                       /TERMINATE TABLE
+\f/     ROUTINE TO SERVICE A "RECEIVE" COMMAND.
+
+RECSRV,        0
+       JMS I   [CREST2]        /SETUP CONSOLE OUTPUT ROUTINES          /025 CJL
+       TAD     (MREC)          /GET OUR MODE VALUE                     /045 CJL
+       DCA     KMODE           /SETUP NOW                              /045 CJL
+       TAD     LPTR            /GET CURRENT LINE POINTER
+       DCA     PRSERR          /SAVE IT
+       TAD     PRSERR          /GET IT BACK
+       JMS I   [DPARS]         /PARSE OFF DEVICE NAME                  /018 CJL
+       JMP     RECS30          /ERROR IN DEVICE NAME                   /018 CJL
+       JMS I   [NOSP]          /CHECK IF BEGINNING OF FILE NAME        /014 CJL
+       SKP                     /GOT <EOL> HERE                         /018 CJL
+       JMP     RECS60          /SOMETHING ELSE ON LINE, ERROR          /014 CJL
+       DCA     PRSERR          /SAVE CURRENT LINE POINTER              /018 CJL
+       RPACK                   /GET SEND/INIT PACKET FROM REMOTE
+       JMS I   (DISPATCH)      /DISPATCH BASED ON RRTYP                /031 CJL
+       RECS80-2                /TABLE ADDRESS                          /027/031 CJL
+       JMP     RECS60          /DON'T KNOW WHAT IT IS
+
+/      GOT A SEND INIT PACKET.
+
+RECS10,        JMS I   (INPSRV)        /OFF TO HANDLE INPUT
+       JMP     RECS60          /ERROR RETURN
+
+/      TAKE THE NON-ERROR RETURN.
+
+RECS20,        ISZ     RECSRV          /BUMP FOR NON-ERROR RETURN
+       TAD     PRSERR          /GET CURRENT CURSOR POSITION            /018 CJL
+       DCA     LPTR            /UPDATE IT                              /018 CJL
+       JMP I   RECSRV
+
+/      GOT ERROR IN DEVICE NAME.                                       /018 CJL
+
+RECS30,        CLA CLL                 /CLEAN UP                               /018 CJL
+       TAD     (DNERMSG)       /GET ERROR MESSAGE ADDRESS              /025 CJL
+       JMP I   RECSRV          /TAKE ERROR RETURN                      /018 CJL
+
+/      TAKE THE ERROR RETURN.
+
+RECS60,        CLA
+       JMP I   RECSRV          /TAKE ERROR EXIT
+
+/      DISPATCH TABLE.
+
+RECS80,        STSIN;  RECS10          /SEND INIT PACKET DISPATCH
+       STEOT;  RECS60          /END OF CONNECTION
+       STBRK;  RECS20          /BREAK TRANSMISSION
+       0
+
+RECS90,        0                       /TEMP FOR "RECSRV"
+\f/     KEYBOARD LINE BUFFER.                                           /014 CJL
+
+LINBUF,        ZBLOCK  LINSIZE         /LINE BUFFER
+
+       PAGE                                                            /014 CJL
+\f/     ROUTINE TO SERVICE INPUT OF A FILE.
+
+INPSRV,        0
+       JMS I   (SETINI)        /SET UP INIT REGISTERS
+       DCA     OFFLG           /INITIALIZE OUTPUT FILE FLAG            /036 CJL
+       CIF     USRFLD          /GOTO USR FIELD                         /037 CJL
+       JMS I   [USRENTRY]      /CALL USER SERVICE ROUTINE              /037 CJL
+       RESET                   /RESET TABLES                           /037 CJL
+       DCA     CURSEQ          /RE-SET THE SEQUENCE NUMBER
+
+       FPACK                   /FORMAT A PACKET
+       INIDAT                  /PACKET DATA ADDRESS
+       STACK                   /"ACK" PACKET TYPE
+
+
+INPS01,        SPACK                   /SEND A PACKET
+       1                       /AWAIT RESPONSE
+       INPS91-2                /DISPATCH TABLE ADDRESS                 /027 CJL
+
+/      NAK OR UNDEFINED RESPONSE HERE.
+
+INPS02,        ISZ     RTRYC           /GOT A NAK, CHECK RE-TRY COUNT
+       JMP     INPS01          /RE-TRY THE INIT
+       JMS     INPERROR        /GIVE UP                                /025 CJL
+
+       IER02=  .               /ERROR TABLE ADDRESS                    /039 CJL
+
+INPS03,        FPACK                   /FORMAT A PACKET
+       NODATA                  /NO DATA
+       STACK                   /"ACK" PACKET TYPE
+
+INPS05,        SPACK                   /SEND A PACKET
+       1                       /AWAIT RESPONSE
+       INPS90-2                /DISPATCH TABLE ADDRESS                 /027 CJL
+       JMS     INPERROR        /UNDEFINED RESPONSE                     /025 CJL
+
+       IER05=  .               /ERROR TABLE ADDRESS                    /039 CJL
+
+/      GOT A DATA PACKET, WRITE TO OUTPUT FILE.
+
+INPS10,        TAD     OFFLG           /CHECK THE OUTPUT FILE FLAG
+       SNA CLA                 /SKIP IF OUTPUT FILE OPEN
+       JMS     INPERROR        /ABORT AND EXIT                         /025 CJL
+IER10, JMS I   (WRIPAK)        /WRITE THE PACKET TO THE FILE           /039 CJL
+       JMS     INPERROR        /ERROR WRITING PACKET                   /025 CJL
+IER11, JMP     INPS03          /LOOP                                   /039 CJL
+\f/     GOT A FILE HEADER PACKET, OPEN FILE.
+
+INPS20,        TAD     OFFLG           /CHECK IF OUTPUT FILE OPEN
+       SZA CLA                 /SKIP IF NO
+       JMS     INPERROR        /ABORT IF FILE ALREADY OPEN             /025 CJL
+IER20, TAD I   [RRLEN]         /GET CURRENT PACKET LENGTH              /039 CJL
+       TAD     (-40-3          /CALCULATE LENGTH OF DATA
+       SPA                     /SKIP IF DATA IN THE PACKET
+       JMS     INPERROR        /ELSE AN ERROR                          /025 CJL
+IER21, TAD     (RRDTA)         /CALCULATE LAST BYTE IN DATA            /039 CJL
+       DCA     INPS81          /STORE IN POINTER
+       NL7777                  /SET -1                                 /032 CJL
+       DCA I   INPS81          /TERMINATE NAME WITH A MINUS WORD
+       TAD     (FNBLK          /GET ADDRESS OF FILE NAME BLOCK
+       DCA     FNPTR           /SAVE FOR NAME PARSE
+       TAD     (RRDTA          /GET ADDRESS OF DATA IN PACKET
+       JMS I   [PFNAM]         /PARSE OFF THE FILE NAME
+       JMS     INPERROR        /ERROR IN FILE NAME                     /025 CJL
+
+/      GET TARGET DEVICE.
+
+IER23, CLA CLL                 /CLEAR AC FROM FILE NAME PARSE          /039 CJL
+       TAD     DEVNUM          /GET DEVICE NUMBER PARSED               /006
+       DCA     ODNUMB          /SAVE OUTPUT DEVICE NUMBER
+       TAD     ODNUMB          /GET NUMBER BACK
+       JMS I   [HFETCH]        /FETCH HANDLER FOR THIS DEVICE
+       JMS     INPERROR        /HANDLER FETCH ERROR                    /025 CJL
+IER24, TAD     (FNBLK)         /GET ADDRESS OF FILE NAME BLOCK         /039 CJL
+       DCA     INPS22          /PUT IN CALL
+       TAD     ODNUMB          /GET DEVICE NUMBER
+       CIF     USRFLD          /GOTO USR FIELD                         /020 CJL
+       JMS I   [USRENTRY]      /CALL USER SERVICE ROUTINE              /035 CJL
+       ENTER                   /ENTER TENTATIVE FILE                   /020 CJL
+INPS22,        0                       /
+       0                       /
+       JMS     INPERROR        /NO DIRECTORY ROOM                      /025 CJL
+IER22, TAD     INPS22          /GET NEW FILE START BLOCK               /039 CJL
+       DCA     FSBLK           /SAVE
+       TAD     INPS22+1        /GET INDICATED MAXIMUM FILE SIZE        /021 CJL
+       IAC                     /GIVE ONE MORE THAN 2 LESS              /021 CJL
+       DCA     FLEN            /SAVE AS DANGER COUNT                   /021 CJL
+       ISZ     OFFLG           /SET FLAG FOR OUTPUT FILE OPEN
+       NL7777                  /INDICATE INITIALIZATION                /020 CJL
+       JMS I   [PUTBYTE]       /INITIALIZE OUTPUT FILE ROUTINE         /020 CJL
+       HLT                     /THIS CAN'T HAPPEN!                     /020 CJL
+       TAD     FNPTR           /GET POINTER TO 6 BIT FILE NAME
+       JMS I   [FILN8]         /MAKE 8 BIT FORMATTED STRING
+       JMS I   [SCRIBE]        /TELL THEM
+       FRECMSG                 /WE ARE RECEIVING
+       PRI8B;  NAMBUF          /WHICH FILE WE ARE RECEIVING
+       JMS I   [SCRIBE]        /DO A
+       CRLF                    /<CR>, <LF>
+       JMP     INPS03          /LOOP
+\f/     GOT AN END OF FILE PACKET.
+
+INPS30,        TAD     OFFLG           /ANY OUTPUT FILE OPEN?
+       SNA CLA                 /SKIP IF YES
+       JMS     INPERROR        /ERROR                                  /025 CJL
+IER30, JMS I   [FILCLOSE]      /CLOSE THE FILE                         /020/039 CJL
+       JMS     INPERROR        /ERROR CLOSING THE FILE                 /025 CJL
+IER31,/        DCA     OFFLG           /RE-SET FILE OPEN FLAG                  /D009/039 CJL
+       JMP     INPS03          /CONTINUE
+
+/      GOT AN END OF TRANSMISSION PACKET.
+
+INPS40,        TAD     OFFLG           /WAS A FILE OPEN?
+       SZA CLA                 /SKIP IF NO
+       JMS I   [FILCLOSE]      /CLOSE ANY OPEN FILE                    /020 CJL
+       NOP                     /ERROR CLOSING THE FILE **** FIX THIS ****
+       FPACK                   /FORMAT A PACKET
+       NODATA                  /NO DATA IN PACKET
+       STACK                   /"ACK" PACKET TYPE
+
+       SPACK                   /SEND THE PACKET
+       0                       /NO RESPONSE
+       ISZ     INPSRV          /BUMP RETURN FOR NO ERROR
+       JMP I   INPSRV          /TAKE NON-ERROR EXIT
+
+/      GOT AN ERROR PACKET.
+
+INPS50,        JMS I   [PRIPAK]        /PRINT THE PACKET DATA
+       JMP I   INPSRV          /AND TAKE THE ERROR EXIT                /009/014 CJL
+
+/      INPUT ERRORS COME HERE.                                         /025 CJL
+
+INPERRO,.-.                    /INPUT ERROR ROUTINE                    /025 CJL
+       FPACK                   /FORMAT A PACKET                        /025 CJL
+       NODATA                  /NO DATA                                /025 CJL
+       STBRK                   /"BREAK LINK" PACKET TYPE               /025 CJL
+       SPACK                   /SEND THE PACKET                        /025 CJL
+       0                       /NO RESPONSE                            /025 CJL
+       TAD     INPERROR        /GET CALLER                             /025 CJL
+       JMS I   [SRCHTABLE]     /TRY TO FIND A MATCH                    /025 CJL
+       INERTABLE-1-1           /IN ERROR TABLE                         /025 CJL
+       SNA                     /SKIP IF FOUND PARTICULAR MESSAGE       /025 CJL
+       TAD     (RERRMSG)       /ELSE USE GENERAL MESSAGE               /025 CJL
+       JMP I   INPSRV          /TAKE ERROR RETURN                      /025 CJL
+
+/      TEMPS FOR "INPSRV".
+
+INPS80,        0
+INPS81,        0
+\f      PAGE                                                            /014 CJL
+\f/     DISPATCH TABLES FOR "INPSRV".
+
+INPS90,        STDAT;  INPS10          /HANDLE DATA PACKETS
+       STEOF;  INPS30          /HANDLE EOF PACKET
+       STEOT;  INPS40          /HANDLE END OF TRANSMISSION PACKET
+       STFIL;  INPS20          /HANDLE FILE NAME PACKET
+       STERR;  INPS50          /HANDLE ERROR PACKET
+       0                       /TERMINATE TABLE
+
+INPS91,        STNAK;  INPS02          /HANDLE A NAK PACKET
+       STFIL;  INPS20          /HANDLE FILE NAME PACKET
+       STERR;  INPS50          /HANDLE ERROR PACKET
+       0                       /TERMINATE TABLE
+
+/      INPUT ERROR MESSAGE DISPATCH TABLE.                             /025/039 CJL
+
+INERTAB,-IER05;        UPERMSG         /UNDEFINED PACKET ERROR                 /025 CJL
+       -IER11; DSFLMSG         /DISK OVERFLOW ERROR                    /042 CJL
+       -IER22; RIDEMSG         /DIRECTORY FULL ERROR                   /025 CJL
+       -IER23; RFLNMSG         /RECEIVED FILE NAME ERROR               /025 CJL
+       -IER24; RHFEMSG         /HANDLER FETCH ERROR                    /025 CJL
+       -IER31; FCLEMSG         /FILE CLOSE ERROR                       /025 CJL
+       0                       /THIS ENDS THE LIST                     /025 CJL
+\f/     ROUTINE TO CHECK FOR AN ALPHABETIC OR NUMERIC CHAR.
+/      ENTER WITH THE CHAR IN THE AC.
+/      EXIT + 2 IF ALPHABETIC OR NUMERIC WITH CHAR IN THE AC.
+/      EXIT + 1 IF NON-ALPHABETIC OR NUMERIC WITH CHAR IN THE AC.
+
+ALPNUM,        0
+       JMS     ALPHA           /CHECK FOR ALPHA FIRST
+       SKP                     /NON-ALPHA RETURN, MUST CHECK NUMERIC
+       JMP     ALPNM1          /IS ALPHA, TAKE RETURN + 2
+       JMS     NUMRC           /CHECK IF NUMERIC
+       SKP                     /NOT NUMERIC
+ALPNM1,        ISZ     ALPNUM          /BUMP RETURN FOR ALPHA-NUMERIC
+       JMP I   ALPNUM          /DONE
+
+
+/      ROUTINE TO CHECK FOR AN ALPHABETIC CHARACTER.
+/      ROUTINE ASSUMES UPPER CASE.
+/      ENTER ROUTINE WITH CHAR IN THE AC.
+/      EXIT + 2 IF THE CHAR IS ALPHABETIC WITH THE CHAR IN THE AC.
+/      EXIT + 1 IF THE CHAR IS NOT ALPHABETIC WITH THE CHAR IN THE AC.
+
+ALPHA, 0
+       DCA     ALPHA1          /STORE THE CHAR FOR RETURN
+       TAD     ALPHA1          /GET THE CHAR
+       TAD     (-"Z!200-1)     /ADD ON UPPER LIMIT                     /034 CJL
+       CLL                     /INIT LINK FOR A FLAG
+       TAD     ("Z-"A+1
+       SZL                     /SKIP IF NOT A LETTER
+       ISZ     ALPHA           /IS A LETTER, BUMP RETURN
+       CLA CLL                 /CLEAR AC
+       TAD     ALPHA1          /RESTORE CHAR IN THE AC
+       JMP I   ALPHA           /TAKE PROPER RETURN
+
+ALPHA1,        0                       /TEMP FOR ALPHA ROUTINE
+
+/      ROUTINE TO CHECK FOR A NUMERIC CHARACTER.
+/      ENTER WITH THE CHAR TO CHECK IN THE AC.
+/      EXIT + 2 IF NUMERIC WITH THE CHAR IN THE AC.
+/      EXIT + 1 IF NON-NUMERIC WITH THE CHAR IN THE AC.
+
+NUMRC, 0
+       DCA     NUMRC1          /SAVE THE CHAR FOR RETURN
+       TAD     NUMRC1          /GET THE CHAR BACK
+       TAD     (-"9!200-1)     /ADD ON UPPER LIMIT                     /034 CJL
+       CLL                     /INIT LINK FOR A FLAG
+       TAD     ["9-"0+1]                                               /016 CJL
+       SZL                     /SKIP IF NOT A DIGIT
+       ISZ     NUMRC           /BUMP RETURN FOR NUMERIC
+       CLA CLL                 /CLEAR AC
+       TAD     NUMRC1          /RESTORE CHAR IN THE AC
+       JMP I   NUMRC           /DONE
+
+NUMRC1,        0                       /TEMP FOR NUMRC CHECK ROUTINE
+\f/     ROUTINE TO WRITE THE CURRENT INPUT PACKET TO THE OUTPUT FILE.
+/      ENTER:  NOTHING.
+/      EXIT:   + 2 = WRITE SUCCESSFUL.
+/              + 1 = WRITE NOT SUCCESSFUL.
+
+WRIPAK,        0
+       TAD I   [RRLEN]         /GET LENGTH OF PACKET
+       TAD     (RRDTA-40-3     /CALCULATE END OF BUFFER
+       DCA     W90             /PUT INTO POINTER
+       DCA I   W90             /ZERO AFTER END OF BUFFER
+       TAD     (RRDTA          /GET ADDRESS OF DATA
+       DCA     W90             /PUT INTO POINTER
+
+W10,   TAD I   W90             /GET A CHAR FROM PACKET
+       SNA                     /SKIP IF NOT END
+       JMP     W60             /END, EXIT
+       CIA                     /NEGATE FOR COMPARE
+       TAD     RQCTL           /COMPARE WITH CURRENT QUOTE CHAR
+       SNA CLA                 /SKIP IF NOT QUOTE CHAR
+       JMP     W20             /IS QUOTE, HANDLE SPECIAL
+       TAD     W92             /WAS LAST CHAR A QUOTE?
+       SZA CLA                 /SKIP IF NO
+       TAD     (-100           /IT WAS, FIX UP THIS CHAR
+       JMP     W25             /HANDLE REST BELOW
+
+W20,   TAD     W92             /CURRENT CHAR A QUOTE, CHECK PREVIOUS
+       SNA CLA                 /SKIP IF YES
+       JMP     W30             /JUST THIS CHAR IS QUOTE, SET FLAG
+
+W25,   TAD I   W90             /GET CHAR FROM BUFFER
+       JMS I   [PUTBYTE]       /OUTPUT TO FILE                         /020 CJL
+       JMP I   WRIPAK          /ERROR IN OUTPUT                        /M020 CJL
+       JMP     W35             /FINISH BELOW
+
+W30,   NL0001 CLL              /GOTA SET FLAG FOR QUOTE CHARACTER      /032 CJL
+
+W35,   DCA     W92             /SET UP QUOTE FLAG
+       ISZ     W90             /BUMP POINTER
+       JMP     W10             /LOOP
+
+W60,   ISZ     WRIPAK          /BUMP RETURN FOR OK
+       JMP I   WRIPAK          /DONE
+
+W90,   0                       /POINTER FOR "WRIPAK"
+W92,   0                       /TEMP FOR "WRIPAK"
+\f/     TABLE SEARCH ROUTINE.                                           /025 CJL
+
+/      CALLING SEQUENCE:
+
+/      TAD     VALUE                   /AC CONTAINS VALUE TO MATCH
+/      JMS I   [SRCHTABLE]             /CALL ROUTINE
+/      TABLE-2                         /ADDRESS(TABLE)-2
+/      RETURN                          /ALWAYS RETURNS HERE
+
+/      IF AC=0 THEN NO MATCH OCCURRED.
+
+/      IF AC IS NON-ZERO, THEN AC CONTAINS CORRESPONDING VALUE TO MATCH WHICH IS ALSO
+/      STORED IN TABLEJUMP.
+
+/      TABLE FORMAT.
+
+/      -VALUE; CORRESPONDING VALUE     /TABLE PAIR
+/      "";     ""                      /ADDITIONAL PAIRS AS NECESSARY
+/      0                               /ZERO TERMINATES THE TABLE
+
+SRCHTAB,.-.                            /TABLE SEARCH ROUTINE
+       DCA     TABLEJUMP               /SAVE PASSED VALUE TO MATCH
+       TAD I   SRCHTABLE               /GET PASSED POINTER ARGUMENT
+       DCA     XR0                     /STASH THE POINTER
+       ISZ     SRCHTABLE               /BUMP PAST ARGUMENT
+SRCHLUP,ISZ    XR0                     /BUMP TO NEXT PAIR
+       TAD I   XR0                     /GET A TABLE VALUE
+       SNA                             /END OF TABLE?
+       JMP I   SRCHTABLE               /YES, RETURN WITH CLEAR AC
+       TAD     TABLEJUMP               /COMPARE TO DESIRED
+       SZA CLA                         /SKIP IF IT MATCHES
+       JMP     SRCHLUP                 /JUMP IF NOT
+       TAD I   XR0                     /GET CORRESPONDING VALUE
+       DCA     TABLEJUMP               /STASH IT
+       TAD     TABLEJUMP               /GET IT BACK
+       JMP I   SRCHTABLE               /RETURN WITH CORRESPONDING VAUE IN AC
+
+       PAGE                                                            /014 CJL
+\f      IFZERO  1       <
+
+/      OS8 DIRECTORY FILE DATA SETUP.
+/      ENTER WITH THE DIRECTORY DATE WORD IN THE AC.
+/      EXIT WITH THE DATE IN THE BUFFER "DATBUF".
+
+FILD8, 0
+       DCA     FILD89          /SAVE THE DATE WORD
+       TAD     FILD89          /GET DATA WORD
+       AND     (7              /KEEP ONLY YEAR BITS
+       TAD     (116            /ADD 78 YEARS
+       MQL                     /PUT INTO MQ REGISTER
+       TAD     (DATEYR         /GET POINTER TO YEAR
+       JMS     DECCON          /CONVERT TO ASCII DATE
+       TAD     FILD89          /GET DATE WORD BACK
+       CLL RTR                 /SHIFT DAY DOWN
+       RAR
+       AND     (37             /KEEP ONLY DAY BITS
+       MQL                     /PUT IN MQ REGISTER
+       TAD     (DATEDA         /GET POINTER TO DAY
+       JMS     DECCON          /CONVERT TO ASCII DAY
+       TAD     FILD89          /GET DATE WORD BACK
+       BSW                     /GET MONTH
+       CLL RTR                 /DOWN
+       AND     (17             /KEEP ONLY MONTH BITS
+       MQL                     /INTO MQ REGISTER
+       TAD     (DATEMO         /GET ADDRESS OF WHERE TO PUT MONTH
+       JMS     DECCON          /CONVERT
+       JMP I   FILD8           /ALL DONE
+
+FILD89,        0                       /TEMP FOR "FILD8"
+
+
+/      ROUTINE  TO CONVERT A BINARY VALUE INTO A  TWO  DIGIT  ASCII  DECIMAL  NUMBER.
+/      ENTER WITH WHERE TO STORE THE CONVERTED NUMBER IN THE AC AND THE NUMBER IN THE
+/      MQ REGISTER.
+
+DECCON,        0
+       DCA     DECC20          /STORE THE POINTER
+       TAD     ("0&177-1       /GET AN ASCII ZERO
+       DCA I   DECC20          /START OUT WITH A ZERO
+       MQA                     /GET THE BINARY VALUE
+DECC01,        ISZ I   DECC20          /BUMP
+       TAD     (-12            /SUB 10
+       SMA                     /SKIP IF NO MORE DIVISION
+       JMP     DECC01          /ELSE KEEP GOING
+       TAD     (12+"0&177      /CONVERT REMAINDER TO ASCII
+       ISZ     DECC20          /BUMP POINTER
+       DCA I   DECC20          /STORE
+/      JMS     FMTDAT          /FORMAT FOR PRINTING                    /D013
+       JMP I   DECCON          /DONE
+
+                       >
+\f      IFZERO  1       <
+
+DECC20,        0                       /LOCAL POINTER TO DECCON
+
+/      ROUTINE TO SET UP THE DATE IN A MM-DD-YY FORMAT  TO  PUT IN FRONT OF A FILE TO
+/      PASS THE FILES DATE (TEMPORY AND NOT PART OF THE KERMIT PROTOCOL).
+
+FMTDAT,        0
+       TAD     DATEMO          /GET FIRST CHAR OF DATE
+       DCA     FDATE           /MOVE IT
+       TAD     DATEMO+1
+       DCA     FDATE+1
+       TAD     DATEDA
+       DCA     FDATE+3
+       TAD     DATEDA+1
+       DCA     FDATE+4
+       TAD     DATEYR
+       DCA     FDATE+6
+       TAD     DATEYR+1
+       DCA     FDATE+7
+       JMP I   FMTDAT          /QUICK AND DIRTY
+
+DATBUF,        "#&177                  /FILE CREATION DATE ATTRIBUTE
+       6+40                    /LENGTH OF DATE (CHAR(X))
+DATEYR,        0                       /ASCII YEAR GOES HERE
+       0
+DATEMO,        0                       /ASCII MONTH GOES HERE
+       0
+DATEDA,        0                       /ASCII DAY GOES HERE
+       0
+       -1                      /TERMINATE
+
+/      FORMATTED DATE GOES HERE.
+
+SETDAT,"ANGLEBRACKET&177       /COMMENT SIGN
+
+FDATE, 0
+       0
+       "-&177
+       0
+       0
+       "-&177
+       0
+       0
+       12
+       15
+       -1
+
+                       >
+\f/     DIRECTORY LOOKUP ROUTINE.                                       /028 CJL
+
+/      CALLING SEQUENCE:
+
+/      NL0001                          /IF INITIALIZING THE DIRECTORY
+
+/      OR
+
+/      CLA                             /CLEAR AC IF SUBSEQUENT CALL
+
+/      JMS I   (LUKUP)                 /CALL ROUTINE
+/      I/O ERROR                       /DIRECTORY I/O ERROR RETURN WITH AC DIRTY
+/      NOT FOUND                       /FILE NOT FOUND RETURN
+/      FOUND                           /LATEST FILE MATCHES REQUEST
+
+/      SETS FLEN TO -(FILE LENGTH) IN RECORDS.
+
+/      SETS FSBLK TO STARTING RECORD OF FILE.
+
+/      MODIFIES DIRECTORY SEGMENT SLIGHTLY (NOT TO BE WRITTEN BACK).
+
+/      DEPENDS ON DIRXR BEING UNTOUCHED BY OTHER ROUTINES.
+
+LUKUP, .-.                             /DIRECTORY LOOKUP ROUTINE
+       SNA                             /INITIALIZING DIRECTORY?
+       JMP     NXTFILE                 /NO, JUST GET ANOTHER FILE IF POSSIBLE
+NEXTSEG,DCA    DIRRECORD               /STORE LATEST DIRECTORY SEGMENT RECORD
+       JMS I   HNDADR                  /CALL I/O HANDLER
+       PAGCNT^100+DIRFLD               /READ IN A DIRECTORY SEGMENT
+       DIRBUFFER                       /DIRECTORY I/O BUFFER
+DIRRECO,.-.                            /WILL BE LATEST SEGMENT NUMBER
+       JMP I   LUKUP                   /I/O ERROR, TAKE DIRTY IMMEDIATE RETURN
+       CDF     DIRFLD                  /GOTO DIRECTORY FIELD
+       TAD I   (FRSTRECORD)            /GET FIRST RECORD OF FIRST ENTRY
+       DCA     FSBLK                   /STASH IT
+       TAD     (ENTSTRT-1)             /POINT TO
+       DCA     DIRXR                   /ENTRIES
+LOOKLUP,TAD I  DIRXR                   /GET FIRST WORD OF ENTRY
+       SNA                             /SKIP IF NOT EMPTY
+       JMP     EMPENTRY                /JUMP IF EMPTY ENTRY
+       DCA     FNAME                   /STORE FIRST FILENAME WORD
+       TAD I   DIRXR                   /GET NEXT
+       DCA     FNAME+1                 /STORE SECOND FILENAME WORD
+       TAD I   DIRXR                   /GET NEXT
+       DCA     FNAME+2                 /STORE THIRD FILENAME WORD
+       TAD I   DIRXR                   /GET NEXT
+       DCA     FNAME+3                 /STORE EXTENSION WORD
+       NL7777                          /BACKUP
+       TAD I   (AIWNUMBER)             /GET ADDITIONAL INFORMATION WORD COUNT
+       DCA     AIWCNT                  /STASH THE COUNTER
+DCADATW,DCA    DATWORD                 /CLEAR THE DATE WORD
+       TAD     DCADATW/(DCA    DATWORD)/GET STORING INSTRUCTION
+       DCA     AIWSTORE                /STORE IN-LINE
+       JMP     AIWTEST                 /START LOOP THERE
+\fAIWLUP,       TAD I   DIRXR           /GET A WORD FROM ENTRY
+AIWSTOR,DCA    DATWORD+.-.     /STORE IN PROPER WORD
+       ISZ     AIWSTORE        /BUMP TO NEXT INSTRUCTION
+AIWTEST,ISZ    AIWCNT          /DONE ALL ADDITIONAL INFORMATION WORDS?
+       JMP     AIWLUP          /NO, KEEP GOING
+       TAD I   DIRXR           /GET THE FILE LENGTH
+       SNA                     /SKIP IF VALID
+       JMP     TENTRY          /JUMP IF ONLY TENTATIVE FILE (NO LENGTH)
+       DCA     FILENGTH        /STORE FILE LENGTH
+       CDF     PRGFLD          /BACK TO OUR FIELD
+/      JMS I   (FILTER)        /CHECK IF WE LIKE THIS ONE
+       TAD     (FNAME)         /POINT TO LATEST FILENAME
+       JMS I   (FMATCH)        /CHECK FOR A MATCH
+       JMP     NXTFILE         /FORGET THIS ONE, IT DIDN'T MATCH
+       TAD     FILENGTH        /GET FILE LENGTH
+       DCA     FLEN            /GIVE TO CALLER TO DESTROY
+       TAD     (FNAME)         /POINT TO FILENAME
+       JMS I   [FILN8]         /PUT IN CHARACTER FORM IN BUFFER
+       ISZ     LUKUP           /BUMP TO FILE MATCH RETURN
+       JMP     FLEXIT          /EXIT THERE
+
+/      COMES HERE FROM SUBSEQUENT CALL OR MATCH FAILURE.
+
+NXTFILE,CDF    DIRFLD          /GOTO BUFFER FIELD
+       TAD     FILENGTH        /GET LATEST FILE LENGTH
+       SKP                     /DON'T DO EMPTY LENGTH
+
+/      COMES HERE TO BYPASS AN EMPTY ENTRY.
+
+EMPENTR,TAD I  DIRXR           /GET LENGTH OF EMPTY
+       CIA                     /WANT POSITIVE FORM
+       TAD     FSBLK           /UPDATE TO NEXT FILE RECORD
+       DCA     FSBLK           /STORE UPDATED VALUE
+TENTRY,        ISZ I   (FILECNT)       /DONE WITH THIS SEGMENT?
+       JMP     LOOKLUP         /NO, KEEP GOING
+       TAD I   (DIRLINK)       /GET LINK TO NEXT SEGMENT
+       CDF     PRGFLD          /BACK TO OUR FIELD
+       SZA                     /END OF DIRECTORY?
+       JMP     NEXTSEGMENT     /NO, GO DO NEXT SEGMENT
+FLEXIT,        ISZ     LUKUP           /BUMP PAST I/O ERROR EXIT
+       JMP I   LUKUP           /RETURN FOR FILE NOT FOUND
+
+AIWCNT,        .-.                     /ADDITIONAL INFORMATION WORD COUNTER
+DATWORD,.-.                    /DATE WORD STORED HERE (0000 IF NONE)
+       ZBLOCK  7               /ROOM FOR MORE ADDITIONAL INFORMATION WORDS
+FILENGT,.-.                    /LATEST FILE LENGTH
+FNAME, ZBLOCK  4               /FILENAME AND EXTENSION STORED HERE
+
+       PAGE
+\f/     OS/8 FILE UNPACK ROUTINE.                                       /019 CJL
+
+/      THIS ROUTINE UNPACKS BYTES FROM THE INPUT FILE ACCORDING TO THE  CURRENT VALUE
+/      OF FILMODE:
+
+/      FILMODE CONTAINS 0177 (ASCII MODE).  ALL BYTES ARE TREATED AS SEVEN-BIT  ASCII
+/      CHARACTERS BY STRIPPING THE HIGH-ORDER BIT.  END OF FILE IS THE <^Z> CHARACTER
+/      WHICH  WILL  BE  SENT  OR  NOT  ACCORDING  TO  THE  CONTENTS OF OCTLZFLAG.  IF
+/      OCTLZFLAG CONTAINS  NON-ZERO,  THEN <^Z> WILL BE SENT AT <EOF>;  THE NEXT CALL
+/      WILL YIELD THE  <EOF>  RETURN.   IF OCTLZFLAG CONTAINS ZERO, THEN DETECTION OF
+/      <^Z> YIELDS THE <EOF> RETURN IMMEDIATELY.
+
+/      FILMODE CONTAINS 4377 (BINARY  MODE).    ALL  BYTES  ARE  TREATED AS EIGHT-BIT
+/      CHARACTERS AND WILL BE SENT  WITHOUT <^Z> CHECK.  THE NEXT CALL AFTER THE LAST
+/      BYTE OF THE LAST RECORD HAS BEEN SENT YIELDS THE <EOF> RETURN.
+
+/      CALLING CONSIDERATIONS:
+
+/      OCTLZFLAG MUST BE SETUP ACCORDINGLY IF IN ASCII MODE.
+
+/      FILMODE MUST BE SETUP ACCORDINGLY.
+
+/      FLEN MUST CONTAIN -(FILE LENGTH IN  RECORDS) WHEN INITIALIZING THE INPUT FILE.
+/      IT WILL BE MODIFIED BY CALLING THIS ROUTINE.
+
+/      FSBLK MUST CONTAIN THE THE STARTING RECORD WHEN INITIALIZING THE INPUT FILE.
+
+/      HNDADR MUST ALREADY BE SETUP TO CALL THE INPUT HANDLER.
+
+/      CALLING SEQUENCE:
+
+/      CLA                             /OR NL7777 IF INITIALIZING THE INPUT FILE
+/      JMS I   (GETBYTE)               /CALL ROUTINE
+/      I/O ERROR RETURN                /FATAL INPUT ERROR OCCURRED; AC CONTAINS JUNK
+/      END OF FILE                     /<EOF> OCCURRED
+/      GOOD RETURN                     /AC CONTAINS LATEST SEVEN/EIGHT-BIT CHARACTER
+
+GETBYTE,.-.                            /GET A BYTE ROUTINE
+       SNA CLA                         /INITIALIZING?
+       JMP I   PUTC                    /NO, GO GET NEXT BYTE
+       TAD     FSBLK                   /GET STARTING RECORD OF INPUT FILE
+       DCA     GETRECORD               /STORE IN-LINE
+GETNEWR,JMS I  HNDADR                  /CALL I/O HANDLER
+       PAGCNT^100+BUFFLD               /READ SOME PAGES INTO BUFFER FIELD
+GETCORE,FILBUFFER                      /BUFFER ADDRESS
+GETRECO,.-.                            /WILL BE LATEST RECORD NUMBER
+       JMP I   GETBYTE                 /INPUT ERROR!
+       TAD     GETCORE/(FILBUFFER)     /SETUP THE
+       DCA     BUFPTR                  /BUFFER POINTER
+\fGETLOOP,DCA   THIRD                   /CLEAR THIRD BYTE NOW
+       JMS     PUTONE                  /OBTAIN AND SEND BACK FIRST BYTE
+       JMS     PUTONE                  /OBTAIN AND SEND BACK SECOND BYTE
+       TAD     THIRD                   /GET THIRD BYTE
+       JMS     PUTC                    /SEND IT BACK
+       TAD     BUFPTR                  /GET THE POINTER
+       TAD     (-PAGCNT^200-FILBUFFER) /COMPARE TO LIMIT
+       SZA CLA                         /SKIP IF AT END
+       JMP     GETLOOP                 /KEEP GOING
+       ISZ     GETRECORD               /BUMP TO NEXT RECORD
+       ISZ     FLEN                    /DONE ALL RECORDS? (BINARY MODE ONLY)
+       JMP     GETNEWRECORD            /NO, GO DO ANOTHER ONE
+
+/      BINARY <EOF> REACHED HERE.
+
+       JMP     GETEOF                  /TAKE SKIP RETURN TO MAIN CALLER
+
+PUTONE,        .-.                             /SEND BACK A BYTE ROUTINE
+       CDF     BUFFLD                  /GOTO BUFFER FIELD
+       TAD I   BUFPTR                  /GET LATEST WORD
+       AND     [7400]                  /JUST THIRD-BYTE NYBBLE
+       CLL RAL                         /MOVE UP
+       TAD     THIRD                   /GET OLD NYBBLE (IF ANY)
+       RTL;RTL                         /MOVE UP NYBBLE BITS
+       DCA     THIRD                   /SAVE FOR NEXT TIME
+       TAD I   BUFPTR                  /GET LATEST WORD AGAIN
+       JMS     PUTC                    /SEND BACK CURRENT BYTE
+       ISZ     BUFPTR                  /BUMP TO NEXT WORD
+       JMP I   PUTONE                  /RETURN
+
+PUTC,  .-.                             /SEND BACK LATEST BYTE ROUTINE
+       CDF     PRGFLD                  /BACK TO OUR FIELD
+       RAL                             /MOVE UP
+       STL RAR                         /MOVE DOWN WITH BIT[0] SET
+       AND     FILMODE                 /KEEP ONLY GOOD BITS
+       TAD     [-CNTRLZ]               /COMPARE TO <^Z>
+       SNA                             /SKIP IF NOT ASCII MODE <EOF>
+       JMP     GETEND                  /JUMP IF ASCII MODE <EOF>
+GETUPZ,        TAD     [CNTRLZ]                /RESTORE THE CHARACTER
+       AND     [377]                   /ENSURE EIGHT-BIT (MIGHT ALREADY BE SEVEN-BIT)
+       ISZ     GETBYTE                 /BUMP PAST <EOF> RETURN
+GETEOF,        ISZ     GETBYTE                 /BUMP PAST I/O ERROR RETURN
+       JMP I   GETBYTE                 /RETURN TO MAIN CALLER
+
+/      GOT <Z> IN ASCII MODE.
+
+GETEND,        TAD     OCTLZFLAG               /GET <^Z> DISPOSITION FLAG
+       SNA CLA                         /SKIP IF SET
+       JMP     GETEOF                  /JUST RETURN <EOF> CONDITION
+       TAD     (GETEOF)                /POINT TO <EOF>
+       DCA     PUTC                    /FOR NEXT TIME
+       JMP     GETUPZ                  /GIVE THEM BACK <^Z> THIS TIME
+\f/     OS/8 FILE PACK ROUTINE.                                         /020 CJL
+
+/      THIS ROUTINE PACKS BYTES INTO THE OUTPUT  FILE  ACCORDING TO THE CURRENT VALUE
+/      OF FILMODE:
+
+/      FILMODE CONTAINS 0177 (ASCII MODE).  ALL BYTES  ARE TREATED AS SEVEN-BIT ASCII
+/      CHARACTERS BY STRIPPING THE HIGH-ORDER BIT.
+
+/      FILMODE  CONTAINS  4377  (BINARY MODE).  ALL BYTES ARE  TREATED  AS  EIGHT-BIT
+/      CHARACTERS AND WILL BE WRITTEN AS IS.
+
+/      CALLING CONSIDERATIONS:
+
+/      FILMODE MUST BE SETUP ACCORDINGLY.
+
+/      FLEN  MUST  CONTAIN  -(MAXIMUM  FILE LENGTH IN RECORDS) WHEN INITIALIZING  THE
+/      TENTATIVE OUTPUT FILE.  IT WILL BE MODIFIED BY CALLING THIS ROUTINE.
+
+/      FSBLK  MUST CONTAIN THE STARTING RECORD WHEN INITIALIZING THE TENTATIVE OUTPUT
+/      FILE.
+
+/      HNDADR MUST ALREADY BE SETUP TO CALL THE OUTPUT HANDLER.
+
+/      CALLING SEQUENCE:
+
+/      NL7777                          /ANY NEGATIVE VALUE
+/      JMS I   [PUTBYTE]               /CALL ROUTINE TO INITIALIZE
+/      IMPOSSIBLE                      /CAN'T RETURN HERE
+/      GOOD RETURN                     /ALWAYS RETURNS HERE
+
+/      OR
+
+/      TAD     (CHAR&377)              /ANY EIGHT-BIT (OR LESS) VALUE
+/      JMS I   [PUTBYTE]               /CALL ROUTINE TO PACK A CHARACTER
+/      ERROR RETURN                    /I/O ERROR WHILE WRITING A BUFFER
+/      GOOD RETURN                     /CHARACTER PACKED WITH NO ERRORS
+
+/      ALL RETURNS CLEAR THE AC.
+
+PUTBYTE,.-.                            /OUTPUT A BYTE ROUTINE
+       SPA                             /ARE WE INITIALIZING?
+       JMP     PUTINITIALIZE           /YES
+       AND     FILMODE                 /REDUCE TO SEVEN-BIT/EIGHT-BIT
+       DCA     LATEST                  /SAVE LATEST CHARACTER
+       CDF     BUFFLD                  /GOTO BUFFER FIELD
+       TAD     LATEST                  /GET LATEST CHARACTER
+       JMP I   PUTNEXT                 /GO WHERE YOU SHOULD GO
+
+PUTNEXT,.-.                            /EXIT ROUTINE
+       ISZ     PUTBYTE                 /BUMP TO GOOD RETURN
+PUTERRO,CLA CLL                                /CLEAN UP
+       CDF     PRGFLD                  /BACK TO OUR FIELD
+       JMP I   PUTBYTE                 /RETURN TO MAIN CALLER
+\fPUTINIT,CLA                           /CLEAN UP
+       TAD     FSBLK                   /GET STARTING RECORD OF TENTATIVE FILE
+       DCA     PUTRECORD               /STORE IN-LINE
+       DCA I   (FLENGTH)               /CLEAR ACTUAL FILE LENGTH
+PUTNEWR,TAD    PUTCORE/(FILEBUFFER)    /SETUP THE
+       DCA     BUFPTR                  /BUFFER POINTER
+PUTLOOP,JMS    PUTNEXT                 /GET A CHARACTER
+       DCA I   BUFPTR                  /STORE IT
+       TAD     BUFPTR                  /GET POINTER VALUE
+       DCA     TEMPTR                  /SAVE FOR LATER
+       ISZ     BUFPTR                  /BUMP TO NEXT
+       JMS     PUTNEXT                 /GET A CHARACTER
+       DCA I   BUFPTR                  /STORE IT
+       JMS     PUTNEXT                 /GET A CHARACTER
+       RTL;RTL                         /MOVE UP
+       AND     [7400]                  /ISOLATE HIGH NYBBLE
+       TAD I   TEMPTR                  /ADD ON FIRST BYTE
+       DCA I   TEMPTR                  /STORE COMPOSITE
+       TAD     LATEST                  /GET LATEST CHARACTER
+       RTR;RTR;RAR                     /MOVE UP AND
+       AND     [7400]                  /ISOLATE LOW NYBBLE
+       TAD I   BUFPTR                  /ADD ON SECOND BYTE
+       DCA I   BUFPTR                  /STORE COMPOSITE
+       ISZ     BUFPTR                  /BUMP TO NEXT
+       TAD     BUFPTR                  /GET LATEST POINTER VALUE
+       TAD     (-PAGCNT^200-FILBUFFER) /COMPARE TO LIMIT
+       SZA CLA                         /SKIP IF AT END
+       JMP     PUTLOOP                 /KEEP GOING
+       CDF     PRGFLD                  /BACK TO OUR FIELD
+       ISZ     FLEN                    /TOO MANY RECORDS?
+       SKP                             /SKIP IF NOT
+       JMP I   PUTBYTE                 /TAKE ERROR RETURN
+       JMS I   HNDADR                  /CALL I/O HANDLER
+       PAGCNT^100+BUFFLD+WRITE         /WRITE SOME PAGES FROM BUFFER FIELD
+PUTCORE,FILBUFFER                      /BUFFER ADDRESS
+PUTRECO,.-.                            /WILL BE LATEST RECORD NUMBER
+       JMP     PUTERROR                /OUTPUT ERROR!
+       ISZ I   (FLENGTH)               /BUMP ACTUAL LENGTH
+       ISZ     PUTRECORD               /BUMP TO NEXT RECORD
+       JMP     PUTNEWRECORD            /KEEP GOING
+
+BUFPTR,        .-.                             /INPUT/OUTPUT BUFFER POINTER
+
+/      ASCII FILE MODE <^Z> OUTPUT DISPOSITION FLAG.
+
+OCTLZFL,OCLOSE                         /ZERO=DON'T SEND <^Z> AT <EOF>,
+                                       /NON-ZERO=SEND <^Z> AT <EOF>
+
+       THIRD=  PUTNEXT                 /THIRD BYTE TEMPORARY
+
+       TEMPTR= PUTONE                  /TEMPORARY BUFFER POINTER
+\f      PAGE
+\f/     OUTPUT FILE CLOSE ROUTINE                                       /020 CJL
+
+/      THIS  ROUTINE  CLOSES  THE OPEN OUTPUT FILE ACCORDING TO THE CURRENT VALUE  OF
+/      FILMODE:
+
+/      FILMODE  CONTAINS  0177  (ASCII  MODE).  ALL BYTES PRIOR TO CLOSE ARE STRIPPED
+/      SEVEN-BIT CHARACTERS.    IF  THE  LAST  CHARACTER SENT TO PUTBYTE (CONTENTS OF
+/      LATEST) IS A  <^Z>,  THEN  JUST  CLOSE THE FILE.  IF NOT, THEN IF ICTLZFLAG IS
+/      NON-ZERO, INSERT A <^Z>  CHARACTER INTO THE FILE AS <EOF> INDICATOR, ELSE JUST
+/      CLOSE THE FILE.
+
+/      FILMODE CONTAINS 4377 (BINARY MODE).    ALL BYTES PRIOR TO CLOSE ARE EIGHT-BIT
+/      CHARACTERS.  IF NECESSARY, <NUL> CHARACTERS WILL BE APPENDED TO THE END OF THE
+/      LAST BLOCK OF THE FILE TO FILL IT.  THE FILE IS CLOSED OTHERWISE UNMODIFIED.
+
+/      CALLING CONSIDERATIONS.
+
+/      OFFLG MUST BE SET (OUTPUT FILE IS OPEN).
+
+/      FLENGTH MUST CONTAIN THE ACTUAL FILE LENGTH.
+
+/      LATEST MUST CONTAIN THE LAST BYTE SENT  TO  THE OUTPUT FILE VIA PUTBYTE (ASCII
+/      MODE ONLY).
+
+/      ICTLZFLAG MUST BE SETUP ACCORDINGLY.
+
+/      FILMODE MUST BE SETUP ACCORDINGLY.
+
+/      CALLING SEQUENCE:
+
+/      CLA CLL                 /CLEAR AC
+/      JMS I   (FILCLOSE)      /CALL ROUTINE
+/      ERROR RETURN            /ERROR WHILE CLOSING FILE
+/      GOOD RETURN             /FILE CLOSED PROPERLY
+
+/      ON RETURN, OFFLG WILL BE CLEAR; THE AC WILL BE CLEAR ALSO.
+
+FILCLOS,.-.                    /OUTPUT FILE CLOSE ROUTINE
+       TAD     FILMODE         /GET CURRENT FILE MODE
+       SPA CLA                 /SKIP IF ASCII
+       JMP     CLOSIT          /JUMP IF BINARY
+       TAD     LATEST          /GET LATEST CHARACTER
+       TAD     [-CNTRLZ]       /COMPARE TO <^Z>
+       SZA CLA                 /SKIP IF <^Z> ALREADY IN FILE
+       TAD     ICTLZFLAG       /GET <^Z> DISPOSITION FLAG
+       SNA CLA                 /SKIP IF SET
+       JMP     CLOSIT          /JUMP IF NOT
+       TAD     [CNTRLZ]        /GET A <^Z>
+\fCLOSLUP,JMS I [PUTBYTE]       /OUTPUT A BYTE
+       JMP     CLOSERROR       /ERROR WHILE WRITING
+CLOSIT,        TAD I   (BUFPTR)        /GET THE BUFFER POINTER
+       TAD     (-FILBUFFER)    /COMPARE TO RESET VALUE
+       SZA CLA                 /SKIP IF IT MATCHES
+       JMP     CLOSLUP         /ELSE KEEP GOING
+       TAD     ODNUMBER        /GET OUTPUT DEVICE NUMBER
+       CIF     USRFLD          /GOTO USR FIELD
+       JMS I   [USRENTRY]      /CALL USER SERVICE ROUTINE              /035 CJL
+       CLOSE                   /CLOSE FILE
+       FNBLK                   /=> FILENAME
+FLENGTH,.-.                    /ACTUAL FILE LENGTH
+CLOSERR,SKP CLA                        /ERROR WHILE CLOSING THE FILE
+       ISZ     FILCLOSE        /BUMP RETURN IF NO ERRORS
+       DCA     OFFLG           /CLEAR OUTPUT FILE OPEN FLAG
+       JMP I   FILCLOSE        /RETURN TO CALLER
+
+/      ASCII FILE MODE <^Z> INPUT DISPOSITION FLAG.
+
+ICTLZFL,ICLOSE                 /ZERO=DON'T ENSURE <^Z> IN FILE, NON-ZERO=PACK <^Z>
+                               /IF LAST CHARACTER WASN'T <^Z>
+\f/     SEND PROCESSING
+
+SNDPRO,        0
+       TAD     INIFLG          /CHECK IF SEND/INIT HAS BEEN DONE
+       SZA CLA                 /SKIP IF NO
+       JMP     SNDP10          /RIGHT INTO FILE TRANSFER
+       TAD     (DEFCK          /SET UP DEFAULT CHECKSUM
+       DCA     RCHKT
+       TAD     (DEFEOL         /GET DEFAULT EOL
+       DCA     REOL            /AND SET IT
+       TAD     (DEFQCTL        /GET DEFAULT QUOTE CONTROL CHAR
+       DCA     RQCTL           /AND SET IT UP
+       TAD     (DEFMAXL+40     /GET DEFAULT MAX BUFFER SIZE
+       DCA     RMAXL           /SET IT UP
+       DCA     CURSEQ          /RE-SET SEQUENCE NUMBER
+       JMS I   (SNDI00)        /HANDLE "SEND-INIT"
+       JMP I   SNDPRO          /TAKE ERROR RETURN                      /014 CJL
+
+/      SEND FILE HEADER DISPATCH ROUTINE
+
+SNDP10,        FPACK                   /FORMAT A PACKET
+       NAMBUF                  /ADDRESS OF FILE HEADER FOR DATA
+       STFIL                   /"FIL" PACKET TYPE
+
+SNDP11,        SPACK                   /SEND A PACKET
+       1                       /AWAIT RESPONSE
+       SNDP96-2                /DISPATCH TABLE ADDRESS                 /026 CJL
+
+/      GOT A NAK OR UNDEFINED HERE
+
+SNDP12,        ISZ     RTRYC           /BUMP THE COUNTER
+       JMP     SNDP11          /TRY AGAIN
+       JMP I   SNDPRO          /TAKE ERROR RETURN                      /014 CJL
+
+/      FILE CREATION DATE HANDLING
+
+SNDP15,        IFZERO  1       <
+
+       TAD     RCAPAS          /CHECK IF REMOTE SUPPORTS FILE
+       AND     (10             /  ATTRIBUTES
+       SNA CLA                 /SKIP IF YES
+       JMP     SNDP20          /SKIP IF NO
+       FPACK                   /FORMAT PACKET
+       DATBUF                  /DATE DATA
+       STATT                   /"ATT" PACKET TYPE
+
+SNDP16,        SPACK                   /SEND THE PACKET
+       1                       /AWAIT RESPONSE
+       SNDP98-2                /DISPATCH TABLE ADDRESS                 /027 CJL
+       JMP I   SNDPRO          /TAKE ERROR RETURN                      /014 CJL
+
+                       >
+\f/     GOT ACK HERE
+
+SNDP20,        JMS I   [SCRIBE]        /TELL THEM                              /025 CJL
+       FSENMSG                 /WE ARE SENDING                         /025 CJL
+       PRI8B;  NAMBUF          /TELL THEM THE NAME OF THE FILE
+       JMS I   [SCRIBE]        /DO A                                   /025 CJL
+       CRLF                    /<CR>, <LF>                             /025 CJL
+       JMS     SLOOP
+       SKP                     /ERROR RETURN
+       ISZ     SNDPRO          /BUMP FOR NON-ERROR EXIT
+       JMP I   SNDPRO
+\f/     DATA SEND LOOP.
+/      ROUTINE TO GET CHARS FROM THE INPUT BUFFER AND SEND THEM TO REMOTE
+/      VIA PACKET TRANSFERS.  RETURN + 1 IF ERROR, + 2 IF DONE.
+
+SLOOP, 0
+       JMS I   (INIOPB)        /INIT OUTPUT PACKET HOLD BUFFER
+       NL7777                  /INITIALIZE INPUT FILE ROUTINE          /019 CJL
+SLOP01,        JMS I   (GETBYTE)       /GET A FILE CHARACTER                   /019 CJL
+       JMP I   SLOOP           /FATAL I/O ERROR                        /026 CJL
+       JMP     SLOP15          /HERE ON EOF
+       JMS I   (OPBUF)         /PUT INTO PACKET BUFFER
+       SKP                     /RETURN HERE ON BUFFER FULL
+       JMP     SLOP01          /RETURN HERE IF STILL ROOM
+
+/      PACKET IS FULL HERE, WE MUST SEND IT.
+
+       FPACK                   /FORMAT A PACKET
+       HOLDBF                  /DATA ADDRESS
+       STDAT                   /"DAT" PACKET TYPE
+
+SLOP05,        SPACK                   /SEND PACKET
+       1                       /AWAIT RESPONSE
+       SLOP90-2                /RESPONSE TABLE ADDRESS                 /027 CJL
+
+/      HERE ON NAK OR FALL THRU ON UNDEFINED RESPONSE ABOVE.
+
+SLOP10,        ISZ     RTRYC           /BUMP THE RE-TRY COUNTER
+       JMP     SLOP05          /TRY AGAIN
+       JMP I   SLOOP           /TAKE ERROR RETURN                      /026 CJL
+
+/      HERE ON END OF FILE  --  SEND THEM WHAT WE HAVE.
+
+SLOP15,        TAD I   (OP2)           /GET THE POINTER                        /052 CJL
+       TAD     (-HOLDBF)       /COMPARE TO EMPTY VALUE                 /052 CJL
+       SNA CLA                 /SKIP IF NOT EMPTY                      /052 CJL
+       JMP     SLOP35          /JUMP IF EMPTY                          /052 CJL
+       FPACK                   /FORMAT A PACKET
+       HOLDBF                  /ADDRESS OF DATA
+       STDAT                   /"DAT" PACKET TYPE
+
+SLOP20,        SPACK                   /SEND A PACKET
+       1                       /AWAIT RESPONSE
+       SLOP92-2                /DISPATCH TABLE ADDRESS                 /027 CJL
+
+/      NAK FOR LAST PACKET.            
+
+SLOP25,        ISZ     RTRYC           /BUMP RE-TRY COUNTER
+       JMP     SLOP20          /TRY AGAIN
+       JMP I   SLOOP           /TAKE ERROR RETURN                      /026 CJL
+\f/     ACK FOR FINAL PACKET, SEND AN EOF PACKET.
+
+SLOP35,        JMS I   [SNDP]          /SEND A PACKET
+       NODATA                  /NO DATA
+       STEOF                   /MAKE IT AN EOF PACKET
+       JMP I   SLOOP           /NAK, TAKE ERROR RETURN
+       JMP I   SLOOP           /OTHER THAN ACK, NAK; TAKE ERROR RETURN /026 CJL
+       ISZ     SLOOP           /EOF ACCEPTED, BUMP FOR GOOD RETURN
+       JMP I   SLOOP           /TAKE GOOD RETURN
+
+       PAGE
+\fSLOP90,       STACK;  SLOP01          /ACK, CONTINUE
+       STNAK;  SLOP10          /NAK, HANDLE
+       0
+
+SLOP92,        STACK;  SLOP35          /ACK, CONTINUE
+       STNAK;  SLOP25          /NAK, HANDLE
+       0
+
+/      COMMAND DISPATCH TABLE FOR SEND SERVICE.
+
+SNDP96,        STACK;  SNDP15          /FILE HEADER ACKNOWLEDGED
+       STNAK;  SNDP12          /NAK RETURNED, RE-TRY
+       0                       /END OF TABLE
+
+SNDP98,        STACK;  SNDP20          /DATE ATTRIBUTE ACKNOWLEDGED
+       0                       /END OF TABLE
+\f/     ROUTINE TO HANDLE A "SEND-INIT" COMMAND.
+/      RETURN + 1 IF ERROR.
+/      RETURN + 2 IF SUCCESSFUL.
+
+SNDI00,        0
+       FPACK                   /FORMAT A PACKET
+       INIDAT                  /ADDRESS OF DATA FOR PACKET
+       STSIN                   /"SIN" PACKET TYPE
+
+SNDI02,        SPACK                   /SEND A PACKET
+       1                       /AWAIT RESPONSE
+       SNDI80-2                /RESPONSE TABLE TYPE                    /027 CJL
+
+/      HERE ON NAK OR UNDEFINED.
+
+SNDI05,        ISZ     RTRYC           /BUMP RE-TRY COUNTER
+       JMP     SNDI02          /TRY AGAIN
+       JMP I   SNDI00          /TAKE ERROR EXIT
+
+/      HERE ON ACK.
+
+SNDI10,        JMS     SETINI          /SET UP THE INIT REGISTERS
+       NL0001 CLL              /NOW FLAG THE SEND/INIT DONE            /032 CJL
+       DCA     INIFLG          /BY MAKING THIS NON-ZERO
+       ISZ     SNDI00          /BUMP FOR NON-ERROR RETURN
+       JMP I   SNDI00          /BACK TO MAIN SEND PROCESSING
+
+SNDI80,        STACK;  SNDI10          /GOT AN ACK
+       STNAK;  SNDI05          /NAK
+       0                       /END OF TABLE
+
+
+/      ROUTINE TO MOVE THE SEND/INIT OR RECEIVE/INIT PACKET INTO THE INIT REGISTERS.
+
+SETINI,        0
+       TAD     (RMAXL          /GET ADDRESS OF RECEIVE INIT REGISTERS
+       DCA     MQ              /SETUP FOR CLEAR ROUTINE                /032 CJL
+       TAD     (RMAXL-INITEND) /GET -(NUMBER OF REGISTERS)             /022 CJL
+       CLEAR                   /CLEAR OUT A CHUNK OF MEMORY            /M013
+/      TAD     (RMAXL          /GET ADDRESS OF RECEIVE INIT REGISTERS
+/      DCA     MQ              /SETUP FOR MOVE ROUTINE                 /032 CJL
+       TAD I   [RRLEN]         /GET LENGTH OF PACKET JUST INPUT
+       TAD     (-40-4          /COUNT OF DATA RECEIVED
+       TAD     (RMAXL-INITEND) /COMPARE TO MAXIMUM ALLOWED             /022 CJL
+       SMA SZA                 /SKIP IF NOT TOO MANY                   /022 CJL
+       CLA                     /ELSE USE ALLOWED MAXIMUM               /022 CJL
+       TAD     (INITEND-RMAXL) /RESTORE VALUE                          /022 CJL
+       CIA                     /MAKE IT NEGATIVE
+       DCA     MOVE4           /SAVE FOR "MOVE" ROUTINE
+       TAD     (RRDTA          /ADDRESS OF DATA IN PACKET
+       MOVE                    /MOVE THE INIT REGISTERS
+       JMP I   SETINI          /DONE
+\f      IFZERO  1       <                                               /D013
+
+/      ROUTINE TO SEND THE DATE IN A DATA PACKET.
+/      RETURN + 1 IF ERROR, + 2 IF SUCCESSFUL.
+
+DATOUT,        0
+       JMS     INIOPB          /INSURE PACKET HOLD BUFFER INITIALIZED
+       TAD     (SETDAT         /GET ADDRESS OF DATE
+       DCA     DATOU9          /PUT INTO POINTER
+
+DATOU1,        TAD I   DATOU9          /GET A CHAR
+       ISZ     DATOU9          /BUMP POINTER
+       SPA                     /SKIP IF NOT ENT
+       JMP     DATOU2          /DONE
+       JMS     OPBUF           /PUT INTO HOLD BUFFER
+       SKP                     /HOLD FULL, SEND IT
+       JMP     DATOU1          /LOOP
+
+DATOU2,        CLA CLL                 /INSURE CLEAR AC
+       FPACK                   /FORMAT A PACKET
+       HOLDBF                  /DATA ADDRESS
+       STDAT                   /DATA PACKET
+
+DATOU3,        SPACK                   /SEND THE PACKET
+       1                       /GET RESPONSE
+       DATOU7-2                /DISPATCH TABLE ADDRESS                 /027 CJL
+
+/      HERE ON NAK OR UNDEFINED RESPONSE.
+
+DATOU4,        ISZ     RTRYC           /BUMP RE-TRY COUNTER
+       JMP     DATOU3          /TRY AGAIN
+       JMP I   DATOUT          /ABORT
+
+/      HERE ON ACK.
+
+DATOU5,        ISZ     DATOUT          /BUMP FOR GOOD RETURN
+       JMP I   DATOUT          /EXIT
+
+DATOU7,        STACK;  DATOU5          /ACK
+       STNAK;  DATOU4          /NAK
+       0
+
+DATOU9,        0                       /TEMP POINTER FOR DATOUT
+
+                       >                                               /D013
+\f/     HANDLE AN ABORT REQUEST.
+
+ABORT, CLA CLL                 /INSURE CLEAR AC
+       DCA     ABFLAG          /CLEAR ABORT FLAG NOW                   /044 CJL
+       TAD     KMODE           /GET CURRENT MODE
+       TAD     (-MSEND         /IS IT A SEND?
+       SZA                     /SKIP IF YES
+       JMP     ABORT2          /NOT SEND
+
+       JMS I   [SNDP]          /SEND OUT A PACKET
+       ABORT9                  /WHICH HAS A "D" IN THE DATA
+       STEOF                   /AND IS AN EOF PACKET
+       NOP                     /WE GOT NAK BACK HERE
+       NOP                     /WE GOT NEITHER NAK OR ACK HERE
+       JMS I   (BRKXMT)        /BREAK THE SEND
+       JMP     ABORT3          /FINISH THE ABORT
+
+ABORT2,        TAD     (MSEND-MREC     /CHECK IF IN RECEIVE MODE
+       SZA CLA                 /SKIP IF YES
+       JMP     ABORT3          /JUST BACK TO COMMAND LOOP
+       JMS I   [SNDP]          /SEND A PACKET BACK FOR AN ABORT
+
+       IFZERO  1       <                                               /D009
+
+       ABORT8                  /WHICH HAS AN "X" IN THE DATA
+       STACK                   /MAKE IT AN ACK PACKET
+       NOP                     /NAK HERE
+       NOP                     /NOT NAK OR ACK HERE
+
+                       >                                               /D009
+
+       NODATA                  /NO DATA                                /A009
+       STBRK                   /BREAK TRANSMISSION                     /A009
+       NOP                     /NAK HERE                               /A009
+       CLA                     /NOT ACK OR NAK HERE                    /A009
+       TAD     OFFLG           /GET FILE OPEN FLAG                     /A009
+       SZA CLA                 /IS IT OPEN YET?                        /A009
+       JMS I   [FILCLOSE]      /CLOSE THE OUTPUT FILE                  /020 CJL
+       CLA                     /ERROR DURING CLOSE **** FIX THIS ****
+ABORT3,        TAD     (ABMSG)         /GET MESSAGE ADDRESS                    /044 CJL
+       JMP I   [CLOOP7]        /DISPLAY THE ABORT
+
+ABORT9,        "D&137                  /DATA PACKET FOR SEND ABORT
+       -1
+
+       PAGE                                                            /014 CJL
+\f/     ROUTINE TO PRINT 8 BIT CHARS ON THE  TTY.  ENTER ROUTINE WITH THE ADDRESS OF
+/      THE TEXT IN THE AC OR IF AC IS  ZERO  THE  ADDRESS  IS  IN THE CALL + 1.  TEXT
+/      TERMINATES ON A MINUS WORD.
+
+PRI8B0,        0
+       SZA                     /SKIP IF ADDRESS NOT IN AC
+       JMP     PRI8B1          /ADDRESS IS IN THE AC
+       TAD I   PRI8B0          /GET ADDRESS FROM CALL + 1
+       ISZ     PRI8B0          /BUMP RETURN POINTER
+PRI8B1,        DCA     MQ              /SAVE ADDRESS OF STRING                 /032 CJL
+       TAD     [P7ECHO]        /GET CONSOLE OUTPUT ROUTINE ADDRESS     /043 CJL
+       JMS     EIGHTB          /AND SEND IT
+       JMP I   PRI8B0          /ALL DONE
+
+/      ROUTINE TO SEND 8 BIT CHARS DOWN THE REMOTE LINE.    ENTER  ROUTINE  WITH  THE
+/      ADDRESS OF THE TEXT IN THE AC OR IF AC IS ZERO THE ADDRESS IS IN THE CALL + 1.
+/      TEXT TERMINATES ON A MINUS WORD.
+
+REM8B0,        0
+       SZA                     /SKIP IF ADDRESS NOT IN AC
+       JMP     REM8B1          /ADDRESS IN AC
+       TAD I   REM8B0          /GET ADDRESS FROM CALL + 1
+       ISZ     REM8B0          /BUMP RETURN
+
+REM8B1,        DCA     MQ              /SAVE ADDRESS OF STRING                 /032 CJL
+       TAD     (COMOUT)        /GET ADDRESS OF REMOTE OUTPUT ROUTINE   /046 CJL
+       JMS     EIGHTB          /AND SEND THE STRING
+       JMP I   REM8B0          /DONE
+
+
+/      ROUTINE TO SEND 8 BIT DATA.  ENTER WITH ADDRESS OF DATA  IN  THE  MQ  AND  THE
+/      ADDRESS  OF  THE ROUTINE TO TAKE EACH BYTE IN THE AC.  TEXT  TERMINATES  ON  A
+/      MINUS WORD.
+
+EIGHTB,        0
+       DCA     EIGHT5          /STORE POINTER TO ROUTINE
+       TAD     MQ              /GET STRING POINTER                     /032 CJL
+       DCA     EIGHT6          /STORE IN LOCAL POINTER
+
+EIGHT1,        TAD I   EIGHT6          /GET A CHAR
+       ISZ     EIGHT6          /BUMP THE POINTER
+       SPA                     /SKIP IF NOT EOL
+       JMP     EIGHT2          /GOT EOL
+       JMS I   EIGHT5          /CALL OUTPUT ROUTINE
+       CLA CLL                 /INSURE CLEAR AC
+       JMP     EIGHT1          /LOOP
+
+EIGHT2,        CLA CLL                 /CLEAR THE AC
+       JMP I   EIGHTB          /DONE
+
+EIGHT5,        0                       /POINTER TO ROUTINE TO DO OUTPUT
+EIGHT6,        0                       /POINTER TO TEXT TO OUTPUT
+\f/     ROUTINE TO UNPACK 6-BT  CHARS FROM MEMORY.  BEFORE  CALLING INIT "GET6P" AS  A
+/      POINTER  TO THE STRING LOCATION AND "GET6F" SHOULD BE ZEROED TO START WITH THE
+/      TOP BYTE OF THE FIRST MEMORY LOCATION.
+
+GET60, 0
+       NL4000                  /SET 4000                               /032 CJL
+       TAD     GET6F           /GET THE FLAG
+       DCA     GET6F           /RETURN THE FLAG
+       TAD I   GET6P           /GET TWO BYTES
+       SZL                     /HIGH-ORDER WANTED?                     /032 CJL
+       JMP     GETSWT          /JUMP IF NOT                            /032 CJL
+       RTR;RTR;RTR             /MOVE DOWN HIGH-ORDER HALF              /032 CJL
+       SKP                     /DON'T BUMP POINTER YET                 /032 CJL
+GETSWT,        ISZ     GET6P           /BUMP TO NEXT WORD                      /032 CJL
+       AND     [77]            /STRIP UNUSED BITS                      /016 CJL
+       JMP I   GET60           /DONE
+
+
+/      LOCAL ROUTINE  TO  "FILN8"  TO  MAKE  THE 6 BIT CHAR IN THE AC INTO 8 BITS AND
+/      STORE IN A STRING.
+
+MOV8,  .-.                     /6-BIT CHARACTER => 7-BIT CHARACTER     /028 CJL
+       SNA                     /SKIP IF SOMETHING PASSED               /028 CJL
+       TAD     [" &77]         /ELSE SUPPLY A <SPACE>                  /025 CJL
+       TAD     [" &77]         /INVERT THE CHARACTER                   /028 CJL
+       AND     [77]            /JUST SIX-BITS                          /014/016 CJL
+       TAD     [" &77]         /MAKE IT SEVEN-BIT ASCII                /028 CJL
+       DCA I   MOV8P           /STORE IN THE STRING                    /028 CJL
+       ISZ     MOV8P           /BUMP POINTER FOR NEXT TIME             /028 CJL
+       JMP I   MOV8            /RETURN                                 /028 CJL
+
+MOV8P, 0                       /POINTER FOR "MOV8" ROUTINE
+\f/     ROUTINE TO PULL A FILE  NAME  IN 6 BIT POINTED TO  BY THE AC  AND PLACE IN THE
+/      FILE NAME BUFFER IN  8  BIT  ADDING  IN  THE  "."  TO  SEPARATE  FILE NAME AND
+/      EXTENSION.  A MINUS WORD WILL FOLLOW THE NAME.
+
+FILN8, 0
+       DCA     GET6P           /SET POINTER FOR "GET6"
+       DCA     GET6F           /SET FLAG FOR "GET6"
+       TAD     (NAMBUF         /GET ADDRESS OF THE NAME BUFFER
+       DCA     MOV8P           /SET IN A POINTER
+       TAD     (-6             /6 NAME CHARS TO DO
+       DCA     FILN8C          /SAVE IN COUNTER
+       GET6                    /PULL A CHAR
+       SZA                     /SKIP IF A SPACE
+       JMS     MOV8            /PUT INTO THE BUFFER
+       ISZ     FILN8C          /BUMP COUNTER
+       JMP     .-4             /LOOP TILL ALL 6 DONE
+       TAD     (".&177)        /GET A "."                              /034 CJL
+       JMS     MOV8            /PUT WITH FILE NAME
+       NL7776                  /SET -2                                 /032 CJL
+       DCA     FILN8C          /2 EXTENSION CHARS
+       GET6                    /GET NEXT CHAR
+       SZA                     /SKIP IF A SPACE
+       JMS     MOV8            /PUT WITH NAME
+       ISZ     FILN8C          /BUMP COUNTER
+       JMP     .-4             /LOOP
+       NL7777                  /SET -1                                 /032 CJL
+       DCA I   MOV8P           /TERMINATE THE STRING
+       JMP I   FILN8           /AND RETURN
+
+FILN8C,        0                       /COUNTER FOR "FILN8"
+
+       PAGE
+\f/     CONSOLE I/O ROUTINES, ETC.                                      /023 CJL
+
+/      CONSOLE MESSAGE PRINT ROUTINE.
+
+/      CALLING SEQUENCE:
+
+/      JMS I   [SCRIBE]        /CALL MESSAGE PRINT ROUTINE
+/      MESSAGEADDRESS          /MESSAGE ADDRESS PASSED IN-LINE
+
+/      AC CAN BE DIRTY ON CALL.
+
+/      RETURNS WITH CLEAR AC.
+
+/      MESSAGE FORMAT:
+
+/      ALL UPPER-CASE CHARACTERS ARE ALLOWED  TO  EXIST IN THE MESSAGE EXCEPT '%' AND
+/      '^' WHICH ARE RESERVED.  A  ZERO  HALF-WORD TERMINATES THE MESSAGE STRING.  IF
+/      '%' IS DETECTED, A <CR> AND <LF>  WILL  BE  OUTPUT.    IF '^' IS DETECTED, THE
+/      PREVAILING CASE WILL BE REVERSED.  INITIAL CASE IS LOWER-CASE.  IF 'UPONLY' IS
+/      SET  TO  7740,  ALL  CASE CHANGES ARE IGNORED AND  THE  OUTPUT  IS  FORCED  TO
+/      UPPER-CASE  ONLY.    THE MESSAGE ADDRESS MUST BE IN FIELD  ONE  AND  MUST  NOT
+/      OVERLAP  AREAS  RESERVED FOR OTHER PURPOSES (OS/8 RESIDENT AT 17600-17777, USR
+/      LOCATIONS 10000-11777, ETC.).
+
+
+SCRIBE,        .-.                     /CONSOLE MESSAGE PRINT ROUTINE
+       CLA                     /CLEAN UP                               /029 CJL
+       TAD     [P7ECHO]        /POINT TO                               /043 CJL
+RSCRENT,DCA    MSGOUT          /CONSOLE PRINT ROUTINE
+       TAD I   SCRIBE          /GET IN-LINE POINTER ARGUMENT
+       DCA     SCRPTR          /STASH THE POINTER
+       ISZ     SCRIBE          /BUMP PAST ARGUMENT
+       TAD     UPONLY          /GET UPPER-ONLY VALUE                   /030 CJL
+       TAD     [140]           /ADD ON LOWER-CASE VALUE                /030 CJL
+       DCA     SCRCASE         /STORE INITIAL CASE VALUE
+SCRLUP,        CDF     MSGFLD          /GOTO MESSAGE FIELD
+       TAD I   SCRPTR          /GET LEFT HALF-WORD
+       RTR;RTR;RTR             /MOVE OVER
+       JMS     SCRPRNT         /PRINT IT
+       CDF     MSGFLD          /GOTO MESSAGE FIELD
+       TAD I   SCRPTR          /GET RIGHT HALF-WORD
+       JMS     SCRPRNT         /PRINT IT
+       ISZ     SCRPTR          /BUMP TO NEXT PAIR
+       JMP     SCRLUP          /KEEP GOING
+\fSCRPRNT,.-.                   /CHARACTER PRINT ROUTINE
+       CDF     PRGFLD          /BACK TO OUR FIELD
+       AND     [77]            /JUST SIX BITS
+       SNA                     /END OF MESSAGE?
+       JMP I   SCRIBE          /YES, RETURN TO ORIGINAL CALLER
+       DCA     SCRCHAR         /NO, SAVE FOR NOW
+       TAD     SCRCHAR         /GET IT BACK
+       TAD     (-"%!200)       /IS IT "%"?
+       SNA                     /SKIP IF NOT
+       JMP     SCRCRLF         /JUMP IF IT MATCHES
+       TAD     [-"^+100+"%]    /IS IT "^"
+       SNA CLA                 /SKIP IF NOT
+       JMP     SCRFLIP         /JUMP IF IT MATCHES
+       TAD     SCRCHAR         /GET THE CHARACTER
+       AND     [40]            /DOES CASE MATTER?
+       SNA CLA                 /SKIP IF NOT
+       TAD     SCRCASE         /ELSE GET PREVAILING CASE
+       TAD     SCRCHAR         /GET THE CHARACTER
+SCRPRLF,JMS I  MSGOUT          /PRINT THE CHARACTER
+       JMP I   SCRPRNT         /RETURN
+
+SCRCRLF,TAD    [CNTRLM]        /GET A <CR>
+       JMS I   MSGOUT          /PRINT IT
+       TAD     [CNTRLJ]        /GET A <LF>
+       JMP     SCRPRLF         /CONTINUE THERE
+
+SCRFLIP,TAD    UPONLY          /GET UPPER-ONLY FLAG
+       SZA CLA                 /SKIP IF OFF
+       JMP I   SCRPRNT         /RETURN IF ON
+       TAD     SCRCASE         /GET CURRENT CASE
+       CIA                     /INVERT IT
+       TAD     (140+100)       /ADD SUM OF POSSIBLE VALUES
+       DCA     SCRCASE         /STORE NEW INVERTED CASE
+       JMP I   SCRPRNT         /RETURN
+
+/      REMOTE LINE MESSAGE PRINT ROUTINE.
+
+/      CALLING SEQUENCE:
+
+/      JMS I   [RSCRIBE]       /CALL MESSAGE PRINT ROUTINE
+/      MESSAGEADDRESS          /MESSAGE ADDRESS PASSED IN-LINE
+
+/      AC CAN BE DIRTY ON CALL.
+
+/      RETURNS WITH CLEAR AC.
+
+/      MESSAGE FORMAT AND RESTRICTIONS ARE IDENTICAL TO SCRIBE ROUTINE.
+
+RSCRIBE,.-.                    /REMOTE LINE MESSAGE PRINT ROUTINE
+       CLA                     /CLEAN UP                               /029 CJL
+       TAD     RSCRIBE         /GET OUR CALLER
+       DCA     SCRIBE          /MAKE IT THEIRS
+       TAD     (COMOUT)        /POINT TO REMOTE OUTPUT ROUTINE
+       JMP     RSCRENTRY       /CONTINUE THERE
+\f/     ESCAPE CHARACTER PRINT ROUTINE.
+
+/      CALLING SEQUENCE:
+
+/      TAD     ESCHAR          /OR OTHER CHARACTER TO PRINT
+/      JMS I   [ESCPRNT]       /CALL ROUTINE
+/      RETURNS WITH CLEAR AC HERE
+
+/      CAUSES CHARACTER TO PRINT LITERALLY IF CHARACTER>37.
+/      CAUSES MESSAGE "CONTROL-" FOLLOWED BY CHARACTER+100 IF CHARACTER<40.
+
+ESCPRNT,.-.                    /ESCAPE CHARACTER PRINT ROUTINE
+       DCA     ESCTEMP         /SAVE PASSED VALUE
+       TAD     ESCTEMP         /GET IT BACK
+       TAD     [-40]           /COMPARE TO CONTROL LIMIT
+       SMA CLA                 /SKIP IF LESS THAN LIMIT
+       JMP     ESPRINT         /JUMP IF NOT
+       JMS I   [SCRIBE]        /GIVE THEM THE
+       CONTMSG                 /CONTROL MESSAGE
+       TAD     [100]           /MAKE IT UPPER-CASE, NOT CONTROL
+ESPRINT,TAD    ESCTEMP         /GET ORIGINAL VALUE
+       JMS I   [P7ECHO]        /PRINT IT                               /043 CJL
+       JMP I   ESCPRNT         /RETURN
+
+       MSGOUT= RSCRIBE         /OUTPUT ROUTINE POINTER
+
+ESCTEMP,.-.                    /TEMPORARY FOR ESCPRNT ROUTINE
+SCRCASE,.-.                    /CURRENT MESSAGE CASE
+SCRCHAR,.-.                    /LATEST MESSAGE CHARACTER
+SCRPTR,        .-.                     /MESSAGE POINTER
+
+       PAGE
+\f/     ROUTINE TO HANDLE THE "CONNECT" COMMAND.                        /025 CJL
+
+CONSRV,        .-.                     /CONNECT SERVICE ROUTINE
+       JMS I   [CREST2]        /SETUP CONSOLE OUTPUT ROUTINES          /025 CJL
+       JMS I   [SCRIBE]        /GIVE THE
+       CONNMSG                 /OPENING MESSAGE
+       TAD     ESCHAR          /GET THE CURRENT <ESCAPE> CHARACTER
+       JMS I   [ESCPRNT]       /PRINT IT
+       JMS I   [SCRIBE]        /GIVE THEM THE
+       CON2MSG                 /BRIDGING MESSAGE
+       JMS I   [SCRIBE]        /PRINT OUT THE
+       CPUMSG                  /ACTUAL CPU TYPE
+       JMS I   [SCRIBE]        /GIVE THEM THE
+       CON3MSG                 /CLOSING MESSAGE
+CORESET,DCA    ESCFLAG         /CLEAR <ESCAPE> SEEN FLAG
+       TAD     ESCHAR          /GET THE <ESCAPE> CHARACTER
+       DCA     ESCH            /STORE IN SEARCH LIST
+       JMS I   (CONRESET)      /RESET CONSOLE ROUTINES
+       JMS I   (REMRESET)      /RESET REMOTE LINE ROUTINES
+CONNLUP,TAD    KEYERROR        /GET KEYBOARD ERROR FLAG
+       SNA                     /SKIP IF KEYBOARD ERROR
+       TAD     RINERROR        /ELSE GET REMOTE ERROR FLAG
+       SZA CLA                 /SKIP IF NEITHER KEYBOARD NOR REMOTE LINE ERRORS
+       JMP     KERROR          /JUMP IF KEYBOARD ERROR
+       JMS I   (CONTEST)       /TEST IF CONSOLE CAN TAKE OUTPUT
+       JMP     TESTKEYBOARD    /JUMP IF NOT
+       JMS I   (REMINPUT)      /TEST IF ANY REMOTE INPUT
+       SKP                     /SKIP IF NONE
+       JMS I   (CONOUT)        /OUTPUT TO CONSOLE
+TESTKEY,TAD    ECHOFLAG        /GET LOCAL ECHO FLAG
+       TAD     ESCFLAG         /ADD ON <ESCAPE> SEEN FLAG
+       SNA CLA                 /SKIP IF LOCAL ECHO POSSIBLY NEEDED
+       JMP     NOLOCALECHO     /JUMP IF NOT
+       JMS I   (CONTEST)       /TEST IF CONSOLE CAN TAKE OUTPUT
+       JMP     BUFCHECK        /JUMP IF NOT
+NOLOCAL,JMS I  (REMTEST)       /TEST IF REMOTE CAN TAKE OUTPUT
+       JMP     BUFCHECK        /JUMP IF NOT
+       JMS I   (KEYINPUT)      /TEST IF ANY KEYBOARD INPUT
+       JMP     BUFCHECK        /JUMP IF NOT
+       DCA     KEYLATEST       /SAVE FOR LATER
+       TAD     KEYLATEST       /GET IT BACK
+       AND     [177]           /WANT SEVEN-BIT VERSION FOR TESTS
+       CIA                     /INVERT IT
+       DCA     TESTCHAR        /SAVE FOR LATER
+       TAD     ESCFLAG         /<ESCAPE> SEEN LAST TIME?
+       SNA CLA                 /SKIP IF SO
+       JMP     NOESCAPE        /JUMP IF NOT
+       TAD     TESTCHAR        /GET TEST VAUE
+       JMS I   [SRCHTABLE]     /SEARCH FOR IT
+       ESCLIST-1-1             /SEARCH TABLE POINTER
+       SNA CLA                 /SKIP IF FOUND
+       JMP     ESCOMPLAIN      /JUMP IF NOT
+       JMP I   TABLEJUMP       /GO WHERE YOU'RE SUPPOSED TO
+\f/     COMES HERE IF PREVIOUS WAS NOT THE <ESCAPE> CHARACTER.
+
+NOESCAP,TAD    TESTCHAR        /GET THE LATEST CHARACTER
+       TAD     ESCHAR          /COMPARE TO <ESCAPE> CHARACTER
+       SZA CLA                 /SKIP IF IT MATCHES
+       JMP     OUTCHAR         /JUMP IF NOT
+       NL7777                  /SET THE
+/      DCA     ESCFLAG         /<ESCAPE> SEEN FLAG
+/      JMP     BUFCHECK        /CONTINUE THERE
+       JMP     NOESENTRY       /CONTINUE THERE
+
+/      COMES HERE IF BOTH PREVIOUS AND LATEST ARE THE <ESCAPE> CHARACTER.
+
+ESCTYPE,DCA    ESCFLAG         /CLEAR THE <ESCAPE> SEEN FLAG AND OUTPUT
+
+/      COMES HERE IF PREVIOUS AND LATEST CHARACTER ARE NOT THE <ESCAPE> CHARACTER.
+
+OUTCHAR,TAD    ECHOFLAG        /GET LOCAL ECHO FLAG
+       SNA CLA                 /SKIP IF SET
+       JMP     NOECHO          /JUMP IF NOT
+       TAD     KEYLATEST       /GET LATEST CHARACTER
+       JMS I   (CONOUT)        /OUTPUT TO CONSOLE
+NOECHO,        TAD     KEYLATEST       /GET LATEST CHARACTER
+       JMS I   (REMOUT)        /OUTPUT TO REMOTE
+       JMP     BUFCHECK        /CONTINUE THERE
+
+/      COMES HERE IF PREVIOUS WAS THE <ESCAPE> CHARACTER AND THE LATEST IS NOT
+/      A VALID <ESCAPE> COMMAND CHARACTER.
+
+ESCOMPL,TAD    [CNTRLG]        /GET A <BEL>
+       JMS I   (CONOUT)        /OUTPUT TO CONSOLE
+NOESENT,DCA    ESCFLAG         /CLEAR <ESCAPE> SEEN FLAG
+BUFCHEC,JMS I  PUPSTATUS       /UPDATE THE PORT STATUS                 /047 CJL
+
+/      THE ABOVE INSTRUCTION IS FOR DECMATE USE ONLY.  THE DEFAULT INSTRUCTION IS FOR
+/      KL8 INTERFACES.
+
+       *BUFCHECK               /OVERLAY DECMATE CODE                   /047 CJL
+
+BUFCHEC,NOP                    /DON'T CHECK PORT STATUS                /047 CJL
+
+       JMS I   (RINUPDATE)     /CHECK FOR MORE REMOTE INPUT
+       JMS I   (KEYUPDATE)     /CHECK FOR MORE KEYBOARD INPUT
+       JMS I   (REMUPDATE)     /CHECK FOR MORE REMOTE OUTPUT
+       JMS I   (CONUPDATE)     /CHECK FOR MORE CONSOLE OUTPUT
+       JMP     CONNLUP         /GO BACK FOR MORE
+
+/      COMES HERE ON <ESCAPE> C(LOSE).
+
+ESCLOSE,ISZ    CONSRV          /BUMP TO GOOD RETURN
+       JMP I   CONSRV          /RETURN
+\fKERRLUP,JMS I PUPSTATUS       /UPDATE THE PORT STATUS                 /047 CJL
+
+/      THE ABOVE INSTRUCTION IS FOR DECMATE USE ONLY.  THE DEFAULT INSTRUCTION IS FOR
+/      KL8 INTERFACES.
+
+       *KERRLUP                /OVERLAY DECMATE CODE                   /047 CJL
+
+KERRLUP,NOP                    /DON'T CHECK PORT STATUS                /047 CJL
+
+       JMS I   (RINUPDATE)     /CHECK FOR MORE REMOTE INPUT
+       JMS I   (KEYUPDATE)     /CHECK FOR MORE KEYBOARD INPUT
+       JMS I   (REMUPDATE)     /CHECK FOR MORE REMOTE OUTPUT
+       JMS I   (CONUPDATE)     /CHECK FOR MORE CONSOLE OUTPUT
+
+/      COMES HERE ON KEYBOARD INPUT ERROR.
+
+KERROR,        JMS I   (CONTEST)       /CONSOLE READY FOR OUTPUT?
+       JMP     KERRLUP         /NO, GO WAIT AWHILE
+       TAD I   (CONINSERT)     /GET CONSOLE INSERTION POINTER
+       CIA                     /INVERT FOR TEST
+       TAD I   (CONREMOVE)     /COMPARE TO CONSOLE REMOVAL POINTER
+       SZA CLA                 /SKIP IF CONSOLE OUTPUT BUFFER EMPTY
+       JMP     KERRLUP         /GO WAIT FOR AWHILE
+       TAD     KEYERROR        /KEYBOARD INPUT ERROR?
+       SNA CLA                 /SKIP IF SO
+       JMP     RIERTST         /JUMP IF NOT
+       JMS I   [SCRIBE]        /TELL THEM
+       KERRMSG                 /WE HAD A KEYBOARD ERROR
+RIERTST,TAD    RINERROR        /REMOTE INPUT ERROR?
+       SNA CLA                 /SKIP IF SO
+       JMP     CORESET         /JUMP IF NOT
+       JMS I   [SCRIBE]        /TELL THEM
+       RIERMSG                 /WE HAD A REMOTE LINE ERROR
+       JMP     CORESET         /RESTART
+
+/      <ESCAPE> CHARACTER SEARCH LIST.
+
+ESCLIST,UPPERC;        ESCLOSE         /<ESCAPE> C(LOSE)
+       LOWERC; ESCLOSE         /<ESCAPE> C(LOSE) (LOWER-CASE)
+ESCH,  .-.;    ESCTYPE         /<ESCAPE> <ESCAPE>
+       0                       /THIS ENDS THE LIST
+
+/      LOCAL ECHO FLAG FOR CONNECT MODE.
+
+ECHOFLA,INIECHO                        /0=DON'T ECHO, NON-ZERO=ECHO            /039 CJL
+ESCFLAG,.-.                    /<ESCAPE> CHARACTER SEEN FLAG
+KEYLATE,.-.                    /LATEST KEYBOARD CHARACTER
+PUPSTAT,UPSTATUS               /POINTER TO DECMATE STATUS UPDATE       /047 CJL
+TESTCHA,.-.                    /LATEST KEYBOARD TEST CHARACTER
+\f      PAGE
+\f/     CONNECT-MODE SUPPORT ROUTINES.                                  /047 CJL
+
+/      CONSOLE KEYBOARD ROUTINES.                                      /047 CJL
+
+/      KEYBOARD INPUT ROUTINE.                                         /026 CJL
+
+/      CALLING SEQUENCE:
+
+/      JMS I   (KEYINPUT)      /CALL ROUTINE
+/      NO INPUT                /RETURN IF NO INPUT
+/      INPUT                   /RETURN IF INPUT AVAILABLE
+
+/      THE AC WILL BE CLEAR IF THE IMMEDIATE RETURN IS TAKEN FOR NO INPUT.
+
+/      THE AC WILL CONTAIN THE LATEST CHARACTER IF THE SKIP RETURN IS TAKEN.
+
+KEYINPU,.-.                    /KEYBOARD INPUT ROUTINE
+       TAD     KEYINSERT       /GET INSERTION POINTER
+       CIA                     /INVERT FOR TEST
+       TAD     KEYREMOVE       /COMPARE TO REMOVAL POINTER
+       SNA CLA                 /SKIP IF BUFFER NOT EMPTY
+       JMP     KEYCHECK        /JUMP IF BUFFER EMPTY
+       TAD     KEYREMOVE       /GET REMOVAL POINTER
+       DCA     KEYTEMP         /SAVE FOR LATER
+       NL0001                  /SET INCREMENT
+       TAD     KEYREMOVE       /UPDATE REMOVAL POINTER
+       AND     [BUFSIZE-1]     /JUST BUFFER BITS
+       TAD     [KEYBUFFER]     /MAKE IT ABSOLUTE
+       DCA     KEYREMOVE       /STORE UPDATED POINTER
+       CDF     BUFFLD          /GOTO BUFFER FIELD
+       TAD I   KEYTEMP         /GET THE LATEST CHARACTER
+       CDF     PRGFLD          /BACK TO OUR FIELD
+       SKP                     /DON'T GET ANOTHER CHARACTER            /047 CJL
+
+/      COMES HERE IF BUFFER IS EMPTY.
+
+KEYCHEC,JMS    KEYGET          /TRY TO GET A CHARACTER NOW             /047 CJL
+       ISZ     KEYINPUT        /GOT ONE, SO TAKE SKIP RETURN           /047 CJL
+       JMP I   KEYINPUT        /RETURN EITHER WAY
+\f/     KEYBOARD BUFFER UPDATE ROUTINE.                                 /026 CJL
+
+/      CALLING SEQUENCE:
+
+/      JMS I   (KEYUPDATE)     /CALL ROUTINE
+
+/      RETURNS  WITH  CLEAR  AC.    ANY  KEYBOARD  INPUT  WHICH JUST OCCURRED WILL BE
+/      BUFFERED;  CALLS TO KEYINPUT WILL RETRIEVE THE CHARACTERS.
+
+KEYUPDA,.-.                    /KEYBOARD BUFFER UPDATE ROUTINE
+       JMS     KEYGET          /TRY TO GET A CHARACTER NOW             /047 CJL
+       SKP                     /GOT ONE, DON'T LEAVE YET               /047 CJL
+       JMP I   KEYUPDATE       /CHARACTER NOT AVAILABLE NOW, RETURN    /047 CJL
+       CDF     BUFFLD          /GOTO BUFFER FIELD
+       DCA I   KEYINSERT       /STORE IN THE BUFFER
+       CDF     PRGFLD          /BACK TO OUR FIELD
+       NL0001                  /SET INCREMENT
+       TAD     KEYINSERT       /UPDATE POINTER
+       AND     [BUFSIZE-1]     /JUST BUFFER BITS
+       TAD     [KEYBUFFER]     /MAKE IT ABSOLUTE
+       DCA     KEYINSERT       /STORE BACK UPDATED POINTER
+       TAD     KEYINSERT       /GET INSERTION POINTER
+       CIA                     /INVERT FOR TEST
+       TAD     KEYREMOVE       /COMPARE TO REMOVAL POINTER
+       SNA CLA                 /SKIP IF NOT EQUAL
+KSERROR,ISZ    KEYERROR        /INDICATE KEYBOARD ERROR
+       JMP I   KEYUPDATE       /RETURN
+       JMP     KSERROR         /MAKE SURE ERROR IS INDICATED
+\f/     KEYBOARD GET A CHARACTER ROUTINE.                               /047 CJL
+
+/      CALLING SEQUENCE:
+
+/      JMS     KEYGET          /CALL ROUTINE
+/      CHARACTER AVAILABLE     /RETURNS HERE WITH LATEST CHARACTER
+/      NO CHARACTER AVAILABLE  /RETURNS HERE IF NO CHARACTER OR HANDLED FLOW-CONTROL
+
+/      NORMAL RETURN HAS LATEST CHARACTER IN AC.
+
+/      SKIP RETURN HAS CLEAR AC.
+
+/      IF FLOWFLAG=0, FLOW CHARACTERS ARE UNPROCESSED AND CAUSE NORMAL RETURN.
+
+KEYGET,        .-.                     /KEYBOARD GET A CHARACTER ROUTINE
+KGTEST,        KSFIOT                  /FLAG UP?
+       JMP     KEYGNONE        /NO, TAKE SKIP RETURN
+KGREAD,        KRBIOT                  /YES, READ THE CHARACTER
+       SPA                     /SKIP IF NO UART ERRORS
+       ISZ     KEYERROR        /INDICATE KEYBOARD ERROR
+       SKP                     /SKIP IF NOT TOO MANY ERRORS
+       JMP     .-2             /ENSURE KEYBOARD ERROR IS INDICATED
+       AND     [377]           /JUST EIGHT-BIT
+       DCA     KEYTEMP         /SAVE FOR NOW
+       TAD     FLOWFLAG        /GET FLOW CONTROL FLAG
+       SNA CLA                 /SKIP IF SET
+       JMP     KEYGEXIT        /JUMP IF NOT
+       TAD     KEYTEMP         /GET THE CHARACTER
+       AND     [177]           /JUST SEVEN-BIT
+       TAD     [-CNTRLS]       /COMPARE TO <^S>
+       SNA                     /SKIP IF OTHER
+       JMP     KWATSET         /JUMP IF IT MATCHES
+       TAD     [-CNTRLQ+CNTRLS]/COMPARE TO <^S>
+       SNA CLA                 /SKIP IF OTHER
+       JMP     KWATCLEAR       /JUMP IF IT MATCHES
+KEYGEXI,TAD    KEYTEMP         /GET THE CHARACTER
+       JMP I   KEYGET          /TAKE IMMEDIATE RETURN
+
+/      COMES HERE ON <^S> TO SET OUTPUT WAIT.
+
+KWATSET,NL4000                 /SET WAIT VALUE
+
+/      COMES HERE ON <^Q> TO CLEAR OUTPUT WAIT.
+
+KWATCLE,DCA    CONWAIT         /STORE NEW STATE
+KEYGNON,ISZ    KEYGET          /BUMP RETURN ADDRESS
+       JMP I   KEYGET          /TAKE SKIP RETURN
+\f/     CONSOLE TERMINAL ROUTINES.
+
+/      CONSOLE OUTPUT ROUTINE.
+
+/      CALLING SEQUENCE:
+
+/      TAD     CHAR            /CHARACTER TO OUTPUT IN AC
+/      JMS I   (CONOUT)        /CALL ROUTINE
+/      RETURN                  /RETURNS HERE WITH CLEAR AC
+
+CONOUT,        .-.                     /CONSOLE OUTPUT ROUTINE
+       DCA     CONTEMP         /SAVE PASSED VALUE
+       TAD     CONINSERT       /GET INSERTION POINTER
+       CIA                     /INVERT FOR TEST
+       TAD     CONREMOVE       /COMPARE TO REMOVAL POINTER
+       TAD     CONWAIT         /ADD ON WAIT STATUS
+       SZA CLA                 /SKIP IF BUFFER EMPTY AND NOT WAITING   /047 CJL
+       JMP     CSTUFF          /JUMP IF CHARACTER MUST BE BUFFERED
+       TAD     CONTEMP         /GET PASSED VALUE                       /047 CJL
+       JMS I   (CONPUT)        /TRY TO OUTPUT THE CHARACTER NOW                        /047 CJL
+       JMP     CSTUFF          /COULDN'T OUTPUT IT, SO BUFFER IT       /047 CJL
+       JMP I   CONOUT          /RETURN
+
+CSTUFF,        TAD     CONTEMP         /GET THE CHARACTER
+       CDF     BUFFLD          /GOTO BUFFER FIELD
+       DCA I   CONINSERT       /STORE THE CHARACTER
+       CDF     PRGFLD          /BACK TO OUR FIELD
+       NL0001                  /SET INCREMENT
+       TAD     CONINSERT       /UPDATE POINTER
+       AND     [BUFSIZE-1]     /JUST BUFFER BITS
+       TAD     [CONBUFFER]     /MAKE IT ABSOLUTE
+       DCA     CONINSERT       /STORE BACK UPDATED POINTER
+       JMP I   CONOUT          /RETURN
+
+/      CONSOLE OUTPUT TEST ROUTINE.
+
+/      CALLING SEQUENCE:
+
+/      JMS I   (CONTEST)       /CALL ROUTINE
+/      NOT READY               /RETURN IF OUTPUT NOT READY FOR NEXT CHARACTER
+/      READY                   /OUTPUT CAN ACCEPT ANOTHER CHARACTER NOW
+
+CONTEST,.-.                    /CONSOLE OUTPUT TEST ROUTINE
+       NL0001                  /SET BUFFER INCREMENT
+       TAD     CONINSERT       /GET UPDATED INSERTION POINTER
+       CIA                     /INVERT FOR TEST
+       TAD     CONREMOVE       /COMPARE TO REMOVAL POINTER
+       AND     [BUFSIZE-1]     /JUST BUFFER BITS
+       SZA CLA                 /SKIP IF BUFFER IS FULL
+       ISZ     CONTEST         /BUMP RETURN IF NOT
+       JMP I   CONTEST         /RETURN EITHER WAY
+\f/     CONSOLE OUTPUT BUFFER UPDATE ROUTINE.
+
+/      CALLING SEQUENCE:
+
+/      JMS I   (CONUPDATE)     /CALL ROUTINE
+/      RETURN                  /RETURN WITH CLEAR AC
+
+/      THE CONSOLE OUTPUT BUFFERING ROUTINES WILL  UPDATE  POINTERS,  ETC.    IF  ANY
+/      STATUS HAS CHANGED SINCE THE LAST CALL.
+
+CONUPDA,.-.                    /CONSOLE OUTPUT UPDATE ROUTINE
+       TAD     CONWAIT         /FLOW CONTROL WAIT SET?
+       SZA CLA                 /SKIP IF NOT
+       JMP I   CONUPDATE       /JUST RETURN IF SO
+       TAD     CONINSERT       /GET INSERTION POINTER
+       CIA                     /INVERT FOR TEST
+       TAD     CONREMOVE       /COMPARE TO REMOVAL POINTER
+       SNA CLA                 /SKIP IF BUFFER CONTAINS SOMETHING      /047 CJL
+       JMP I   CONUPDATE       /RETURN IF BUFFER EMPTY                 /047 CJL
+       CDF     BUFFLD          /GOTO BUFFER FIELD
+       TAD I   CONREMOVE       /GET A CHARACTER FROM THE BUFFER
+       CDF     PRGFLD          /BACK TO OUR FIELD
+       JMS I   (CONPUT)        /TRY TO OUTPUT THE CHARACTER NOW        /047 CJL
+       JMP I   CONUPDATE       /COULDN'T DO IT, SO JUST RETURN         /047 CJL
+       NL0001                  /SET BUFFER INCREMENT
+       TAD     CONREMOVE       /UPDATE REMOVAL POINTER
+       AND     [BUFSIZE-1]     /JUST BUFFER BITS
+       TAD     [CONBUFFER]     /MAKE IT ABSOLUTE
+       DCA     CONREMOVE       /STORE UPDATED POINTER
+       JMP I   CONUPDATE       /RETURN
+
+CONINSE,.-.                    /CONSOLE OUTPUT INSERTION POINTER
+CONREMO,.-.                    /CONSOLE OUTPUT REMOVAL POINTER
+
+/      CONSOLE FLOW CONTROL WAIT FLAG.
+
+CONWAIT,.-.                    /0=DON'T WAIT, 4000=WAIT FOR <^Q>
+KEYINSE,.-.                    /KEYBOARD BUFFER INSERTION POINTER
+KEYREMO,.-.                    /KEYBOARD BUFFER REMOVAL POINTER
+
+       CONTEMP=CONUPDATE       /CONSOLE OUTPUT TEMPORARY
+
+       KEYTEMP=CONUPDATE       /KEYBOARD INPUT TEMPORARY
+
+       PAGE
+\f/     REMOTE LINE ROUTINES.
+
+/      REMOTE LINE INPUT ROUTINE.                                      /026 CJL
+
+/      CALLING SEQUENCE:
+
+/      JMS I   (REMINPUT)      /CALL ROUTINE
+/      NO INPUT                /RETURN IF NO INPUT
+/      INPUT                   /RETURN IF INPUT AVAILABLE
+
+/      THE AC WILL BE CLEAR IF THE IMMEDIATE RETURN IS TAKEN FOR NO INPUT.
+
+/      THE AC WILL CONTAIN THE LATEST CHARACTER IF THE SKIP RETURN IS TAKEN.
+
+REMINPU,.-.                    /REMOTE LINE INPUT ROUTINE
+       TAD     RININSERT       /GET INSERTION POINTER
+       CIA                     /INVERT FOR TEST
+       TAD     RINREMOVE       /COMPARE TO REMOVAL POINTER
+       SNA CLA                 /SKIP IF BUFFER NOT EMPTY
+       JMP     RINCHECK        /JUMP IF BUFFER EMPTY
+       TAD     RINREMOVE       /GET REMOVAL POINTER
+       DCA     RINTEMP         /SAVE FOR LATER
+       NL0001                  /SET INCREMENT
+       TAD     RINREMOVE       /UPDATE REMOVAL POINTER
+       AND     [BUFSIZE-1]     /JUST BUFFER BITS
+       TAD     (RINBUFFER)     /MAKE IT ABSOLUTE
+       DCA     RINREMOVE       /STORE UPDATED POINTER
+       CDF     BUFFLD          /GOTO BUFFER FIELD
+       TAD I   RINTEMP         /GET THE LATEST CHARACTER
+       CDF     PRGFLD          /BACK TO OUR FIELD
+       DCA     RINTEMP         /SAVE FOR LATER
+       TAD     FLOWFLAG        /GET FLOW CONTROL FLAG
+       SNA CLA                 /SKIP IF SET
+       JMP     REMINEXIT       /JUMP IF NOT
+       NL4000                  /SET WAITING VALUE
+       TAD     RINWAIT         /ARE WE WAITING TO EMPTY?
+       SZA CLA                 /SKIP IF SO
+       JMP     REMINEXIT       /JUMP IF NOT
+       TAD     RININSERT       /GET INSERTION POINTER
+       CIA                     /INVERT FOR TEST
+       TAD     RINREMOVE       /COMPARE TO REMOVAL POINTER
+       AND     [BUFSIZE^3%4]   /JUST 3/4 BITS
+       SZA CLA                 /SKIP IF BUFFER NOW 1/4 FULL (OR LESS)
+       JMP     REMINEXIT       /JUMP IF NOT
+       NL7777                  /SET BUFFER EMPTYING VALUE
+       DCA     RINWAIT         /STORE FOR OUTPUT ROUTINE
+REMINEX,TAD    RINTEMP         /GET THE CHARACTER
+       SKP                     /DON'T GET ANOTHER ONE                  /047 CJL
+
+/      COMES HERE IF REMOTE LINE INPUT BUFFER IS EMPTY.
+
+RINCHEC,JMS    RINGET          /TRY TO GET A CHARACTER NOW             /047 CJL
+       ISZ     REMINPUT        /GOT ONE, SO TAKE SKIP RETURN           /047 CJL
+       JMP I   REMINPUT        /RETURN EITHER WAY
+\f/     REMOTE LINE INPUT BUFFER UPDATE ROUTINE.                        /026 CJL
+
+/      CALLING SEQUENCE:
+
+/      JMS I   (RINUPDATE)     /CALL ROUTINE
+
+/      RETURNS WITH CLEAR AC.  ANY REMOTE LINE  INPUT  WHICH  JUST  OCCURRED  WILL BE
+/      BUFFERED;  CALLS TO REMINPUT WILL RETRIEVE THE CHARACTERS.
+
+RINUPDA,.-.                    /REMOTE LINE INPUT BUFFER UPDATE ROUTINE
+       JMS     RINGET          /TRY TO GET A CHARACTER NOW             /047 CJL
+       SKP                     /GOT ONE, DON'T LEAVE YET               /047 CJL
+       JMP I   RINUPDATE       /CHARACTER NOT AVAILABLE NOW, RETURN    /047 CJL
+       CDF     BUFFLD          /GOTO BUFFER FIELD
+       DCA I   RININSERT       /STORE IN THE BUFFER
+       CDF     PRGFLD          /BACK TO OUR FIELD
+       NL0001                  /SET INCREMENT
+       TAD     RININSERT       /UPDATE POINTER
+       AND     [BUFSIZE-1]     /JUST BUFFER BITS
+       TAD     (RINBUFFER)     /MAKE IT ABSOLUTE
+       DCA     RININSERT       /STORE BACK UPDATED POINTER
+       TAD     RININSERT       /GET INSERTION POINTER
+       CIA                     /INVERT FOR TEST
+       TAD     RINREMOVE       /COMPARE TO REMOVAL POINTER
+       SNA                     /SKIP IF BUFFER NOT FULL
+       ISZ     RINERROR        /INDICATE REMOTE LINE INPUT ERROR
+       SKP                     /SKIP IF NO OVERFLOW
+       JMP     .-2             /ENSURE ERROR IS SET
+       TAD     [BUFSIZE^3%4]   /SUBTRACT 1/4 BUFFER'S WORTH
+       AND     [BUFSIZE^3%4]   /JUST 3/4 BUFFER BITS
+       SNA CLA                 /SKIP IF NOT 3/4 FULL
+       TAD     FLOWFLAG        /ELSE CHECK IF FLOW CONTROL IS ENABLED
+       SNA CLA                 /SKIP IF 3/4 FULL AND FLOW CONTROL IS ENABLED
+       JMP I   RINUPDATE       /JUST RETURN
+       TAD     RINWAIT         /GET INPUT WAIT FLAG
+       SNA CLA                 /SKIP IF ALREADY SET
+       ISZ     RINWAIT         /SET TO <^S> STATE
+       JMP I   RINUPDATE       /RETURN
+\f/     REMOTE LINE GET A CHARACTER ROUTINE.                            /047 CJL
+
+/      CALLING SEQUENCE:
+
+/      JMS I   (RINGET)        /CALL ROUTINE
+/      CHARACTER AVAILABLE     /RETURNS HERE WITH LATEST CHARACTER
+/      NO CHARACTER AVAILABLE  /RETURNS HERE IF NO CHARACTER OR HANDLED FLOW-CONTROL
+
+/      NORMAL RETURN HAS LATEST CHARACTER IN AC.
+
+/      SKIP RETURN HAS CLEAR AC.
+
+/      IF FLOWFLAG=0, FLOW CHARACTERS ARE UNPROCESSED AND CAUSE NORMAL RETURN.
+
+RINGET,        .-.                     /REMOTE LINE GET A CHARACTER ROUTINE
+RINTEST,TAD    INFLAG          /IS INPUT AVAILABLE?
+RINGT0,        SNA CLA                 /SKIP IF SO
+RINREAD,JMP    RINGNONE        /JUMP IF NOT
+RINGT1,        DCA     INFLAG          /CLEAR AVAILABILITY FLAG
+RINGT2,        IRB                     /READ IN THE CHARACTER
+
+/      THE ABOVE INSTRUCTIONS ARE FOR DECMATE II USE ONLY.  THE  DEFAULT INSTRUCTIONS
+/      ARE FOR KL8 INTERFACES.
+
+       *RINTEST                /OVERLAY DECMATE II CODE
+
+RINTEST,RKSFIOT                        /FLAG UP?
+RINGT0,        JMP     RINGNONE        /NO, TAKE SKIP RETURN
+RINREAD,RKRBIOT                        /YES, READ THE CHARACTER
+RINGT1,        SKP                     /NO ERRORS ON DECMATE I
+
+/      THE ABOVE INSTRUCTION IS FOR DECMATE I USE ONLY.    THE DEFAULT INSTRUCTION IS
+/      FOR KL8 INTERFACES.
+
+       *RINGT1                 /OVERLAY DECMATE I CODE
+
+RINGT1,        SPA                     /SKIP IF NO UART ERRORS
+RING2, ISZ     RINERROR        /INDICATE REMOTE LINE INPUT ERROR
+       SKP                     /SKIP IF NOT TOO MANY ERRORS
+       JMP     .-2             /ENSURE REMOTE LINE INPUT ERROR IS INDICATED
+       AND     [377]           /JUST EIGHT-BIT
+       DCA     RINTEMP         /SAVE FOR NOW
+       TAD     FLOWFLAG        /GET FLOW CONTROL FLAG
+       SNA CLA                 /SKIP IF SET
+       JMP     RINGEXIT        /JUMP IF NOT
+       TAD     RINTEMP         /GET THE CHARACTER
+       AND     [177]           /JUST SEVEN-BIT
+       TAD     [-CNTRLS]       /COMPARE TO <^S>
+       SNA                     /SKIP IF OTHER
+       JMP     RWATSET         /JUMP IF IT MATCHES
+       TAD     [-CNTRLQ+CNTRLS]/COMPARE TO <^S>
+       SNA CLA                 /SKIP IF OTHER
+       JMP     RWATCLEAR       /JUMP IF IT MATCHES
+RINGEXI,TAD    RINTEMP         /GET THE CHARACTER
+       JMP I   RINGET          /TAKE IMMEDIATE RETURN
+\f/     COMES HERE ON <^S> TO SET OUTPUT WAIT.
+
+RWATSET,NL4000                 /SET WAIT VALUE
+
+/      COMES HERE ON <^Q> TO CLEAR OUTPUT WAIT.
+
+RWATCLE,DCA    REMWAIT         /STORE NEW STATE
+RINGNON,ISZ    RINGET          /BUMP RETURN ADDRESS
+       JMP I   RINGET          /TAKE SKIP RETURN
+
+/      REMOTE LINE RESET ROUTINE.                                      /026 CJL
+
+/      CALLING SEQUENCE:
+
+/      JMS I   (REMRESET)      /CALL ROUTINE
+/      RETURN                  /RETURN WITH CLEAR AC
+
+/      RETURNS WITH CLEAR AC AND ALL REMOTE LINE VARIABLES RESET.
+
+REMRESE,.-.                    /REMOTE LINE RESET ROUTINE
+       TAD     [REMBUFFER]     /SETUP THE REMOTE LINE
+       DCA     REMINSERT       /OUTPUT INSERTION POINTER
+       TAD     [REMBUFFER]     /SETUP THE REMOTE LINE
+       DCA     REMREMOVE       /OUTPUT REMOVAL POINTER
+       TAD     (RINBUFFER)     /SETUP THE REMOTE LINE
+       DCA     RININSERT       /INPUT INSERTION POINTER
+       TAD     (RINBUFFER)     /SETUP THE REMOTE LINE
+       DCA     RINREMOVE       /INPUT REMOVAL POINTER
+       DCA     REMWAIT         /CLEAR REMOTE OUTPUT WAIT
+       DCA     RINWAIT         /CLEAR REMOTE INPUT WAIT
+       DCA     RINERROR        /CLEAR REMOTE INPUT ERROR
+       JMP I   REMRESET        /RETURN
+
+RININSE,.-.                    /REMOTE INPUT INSERTION POINTER
+RINREMO,.-.                    /REMOTE INPUT REMOVAL POINTER
+RINTEMP,.-.                    /REMOTE INPUT TEMPORARY                 /047 CJL
+
+       PAGE
+\f/     REMOTE LINE OUTPUT ROUTINE.
+
+/      CALLING SEQUENCE:
+
+/      TAD     CHAR            /CHARACTER TO OUTPUT IN AC
+/      JMS I   (REMOUT)        /CALL ROUTINE
+/      RETURN                  /RETURNS HERE WITH CLEAR AC
+
+REMOUT,        .-.                     /REMOTE LINE OUTPUT ROUTINE
+       DCA     REMTEMP         /SAVE PASSED VALUE
+       TAD     REMINSERT       /GET INSERTION POINTER
+       CIA                     /INVERT FOR TEST
+       TAD     REMREMOVE       /COMPARE TO REMOVAL POINTER
+       TAD     REMWAIT         /ADD ON WAIT STATUS
+       SZA CLA                 /SKIP IF BUFFER EMPTY AND NOT WAITING   /047 CJL
+       JMP     RSTUFF          /JUMP IF CHARACTER MUST BE BUFFERED
+       TAD     REMTEMP         /GET PASSED VALUE                       /047 CJL
+       JMS I   (REMPUT)        /TRY TO OUTPUT THE CHARACTER NOW        /047 CJL
+       JMP     RSTUFF          /COULDN'T OUTPUT IT, SO BUFFER IT       /047 CJL
+       JMP I   REMOUT          /RETURN
+
+RSTUFF,        TAD     REMTEMP         /GET THE CHARACTER
+       CDF     BUFFLD          /GOTO BUFFER FIELD
+       DCA I   REMINSERT       /STORE IN BUFFER
+       CDF     PRGFLD          /BACK TO OUR FIELD
+       NL0001                  /SET BUFFER INCREMENT
+       TAD     REMINSERT       /BUMP INSERTION POINTER
+       AND     [BUFSIZE-1]     /JUST BUFFER BITS
+       TAD     [REMBUFFER]     /MAKE IT ABSOLUTE
+       DCA     REMINSERT       /STORE UPDATED POINTER
+       JMP I   REMOUT          /RETURN
+
+/      REMOTE LINE OUTPUT TEST ROUTINE.
+
+/      CALLING SEQUENCE:
+
+/      JMS I   (REMTEST)       /CALL ROUTINE
+/      NOT READY               /RETURN IF OUTPUT NOT READY FOR NEXT CHARACTER
+/      READY                   /OUTPUT CAN ACCEPT ANOTHER CHARACTER NOW
+
+/      AC WILL BE CLEARED AFTER THE CALL.
+
+REMTEST,.-.                    /REMOTE LINE OUTPUT TEST ROUTINE
+       NL0001                  /SET BUFFER INCREMENT
+       TAD     REMINSERT       /GET INSERTION POINTER
+       CIA                     /INVERT FOR TEST
+       TAD     REMREMOVE       /COMPARE TO REMOVAL POINTER
+       AND     [BUFSIZE-1]     /JUST BUFFER BITS
+       SZA CLA                 /SKIP IF BUFFER IS FULL
+       ISZ     REMTEST         /BUMP RETURN IF BUFFER IS NOT FULL
+       JMP I   REMTEST         /RETURN EITHER WAY
+\f/     REMOTE LINE OUTPUT BUFFER UPDATE ROUTINE.
+
+/      CALLING SEQUENCE:
+
+/      JMS I   (REMUPDATE)     /CALL ROUTINE
+/      RETURN                  /RETURN WITH CLEAR AC
+
+/      THE REMOTE LINE OUTPUT  BUFFERING  ROUTINES WILL UPDATE POINTERS, ETC.  IF ANY
+/      STATUS HAS CHANGED SINCE THE LAST CALL.
+
+REMUPDA,.-.                    /REMOTE LINE OUTPUT UPDATE ROUTINE
+       TAD     RINWAIT         /GET INPUT WAIT FLAG
+       CLL RAL                 /MAIN STATE BIT TO LINK
+       SNA CLA                 /SKIP IF OUTPUT FLOW CHARACTER NEEDED   /047 CJL
+       JMP     REMCHECK        /JUMP IF CHARACTER NOT NEEDED NOW       /047 CJL
+       TAD     (CNTRLQ)        /ASSUME RELEASE CHARACTER NEEDED        /047 CJL
+       SNL                     /SKIP IF SO                             /047 CJL
+       TAD     [CNTRLS-CNTRLQ] /ELSE CHANGE IT TO HOLD CHARACTER       /047 CJL
+       JMS I   (REMPUT)        /TRY TO OUTPUT IT NOW                   /047 CJL
+       JMP     REMCHECK        /COULDN'T DO IT, FORGET IT FOR NOW      /047 CJL
+       CML RAR                 /SET NEW STATE VALUE                    /047 CJL
+       DCA     RINWAIT         /STORE IT
+REMCHEC,TAD    REMWAIT         /GET OUTPUT WAIT FLAG
+       SZA CLA                 /SKIP IF NOT WAITING
+       JMP I   REMUPDATE       /JUST RETURN IF WAITING
+       TAD     REMINSERT       /GET OUTPUT INSERTION POINTER
+       CIA                     /INVERT FOR TEST
+       TAD     REMREMOVE       /COMPARE TO OUTPUT REMOVAL POINTER
+       SNA CLA                 /SKIP IF BUFFER CONTAINS SOMETHING      /047 CJL
+       JMP I   REMUPDATE       /RETURN IF BUFFER EMPTY                 /047 CJL
+       CDF     BUFFLD          /GOTO BUFFER FIELD
+       TAD I   REMREMOVE       /GET A CHARACTER FROM THE BUFFER
+       CDF     PRGFLD          /BACK TO OUR FIELD
+       JMS I   (REMPUT)        /TRY TO OUTPUT THE CHARACTER NOW        /047 CJL
+       JMP I   REMUPDATE       /COULDN'T DO IT, SO JUST RETURN         /047 CJL
+       NL0001                  /SET BUFFER INCREMENT
+       TAD     REMREMOVE       /BUMP REMOVAL POINTER
+       AND     [BUFSIZE-1]     /JUST BUFFER BITS
+       TAD     [REMBUFFER]     /MAKE IT ABSOLUTE
+       DCA     REMREMOVE       /STORE UPDATED POINTER
+       JMP I   REMUPDATE       /RETURN
+
+       REMTEMP=REMUPDATE       /REMOTE OUTPUT TEMPORARY
+\f/     LOW-LEVEL CONSOLE OUTPUT ROUTINE.                               /047 CJL
+
+/      CALLING SEQUENCE:
+
+/      [CHARACTER TO OUTPUT IN THE AC]
+
+/      JMS I   (CONPUT)        /CALL ROUTINE
+/      NO OUTPUT               /RETURNS HERE IF OUTPUT UNAVAILABLE
+/      OUTPUT                  /RETURNS HERE IF CHARACTER WAS OUTPUT
+
+CONPUT,        .-.                     /CONSOLE OUTPUT ROUTINE
+CONTSF,        TSFIOT                  /FLAG UP?
+       JMP     CONCLEAR        /NO, FORGET IT
+CONTLS,        TLSIOT                  /YES, OUTPUT THE CHARACTER NOW
+       ISZ     CONPUT          /TAKE SKIP RETURN
+CONCLEA,CLA                    /CLEAN UP
+       JMP I   CONPUT          /RETURN EITHER WAY
+
+/      CONSOLE RESET ROUTINE.                                          /026 CJL
+
+/      CALLING SEQUENCE:
+
+/      JMS I   (CONRESET)      /CALL ROUTINE
+/      RETURN                  /RETURN WITH CLEAR AC
+
+/      RETURNS WITH CLEAR AC AND ALL CONSOLE VARIABLES RESET.
+
+CONRESE,.-.                    /CONSOLE RESET ROUTINE
+       TAD     [CONBUFFER]     /SETUP THE
+       DCA I   (CONINSERT)     /CONSOLE OUTPUT INSERTION POINTER
+       TAD     [CONBUFFER]     /SETUP THE
+       DCA I   (CONREMOVE)     /CONSOLE OUTPUT REMOVAL POINTER
+       TAD     [KEYBUFFER]     /SETUP THE
+       DCA I   (KEYINSERT)     /KEYBOARD INSERTION POINTER
+       TAD     [KEYBUFFER]     /SETUP THE
+       DCA I   (KEYREMOVE)     /KEYBOARD REMOVAL POINTER
+       DCA I   (CONWAIT)       /CLEAR OUTPUT WAIT
+       DCA     KEYERROR        /CLEAR KEYBOARD ERROR
+       JMP I   CONRESET        /RETURN
+\f/     LOW-LEVEL REMOTE LINE OUTPUT ROUTINE.                           /047 CJL
+
+/      CALLING SEQUENCE:
+
+/      [CHARACTER TO OUTPUT IN THE AC]
+
+/      JMS I   (REMPUT)        /CALL ROUTINE
+/      NO OUTPUT               /RETURNS HERE IF OUTPUT UNAVAILABLE
+/      OUTPUT                  /RETURNS HERE IF CHARACTER WAS OUTPUT
+
+REMPUT,        .-.                     /REMOTE LINE OUTPUT ROUTINE
+DM1AN2,        AND     [377]           /ENSURE EIGHT BIT                       /049 CJL
+
+/      THE  ABOVE INSTRUCTION IS FOR DECMATE I USE ONLY.  THE DEFAULT INSTRUCTION  IS
+/      FOR KL8 INTERFACES.
+
+       *DM1AN2                 /OVERLAY DECMATE II CODE                /049 CJL
+
+DM1AN2,        SKP                     /WE'RE NOT A DECMATE I                  /049 CJL
+       TAD     [400]           /SET WRITE BIT                          /049 CJL
+REMTSF,        DCA     RMPTEMP         /SAVE PASSED VALUE
+RMPUT0,        TAD     OUTFLAG         /CHECK IF OUTPUT IS AVAILABLE
+REMTLS,        SNA CLA                 /SKIP IF SO
+RMPUT1,        JMP I   REMPUT          /RETURN IF NOT
+REMCLEA,TAD    RMPTEMP         /GET THE PASSED VALUE
+RMPUT2,        OLS                     /OUTPUT THE CHARACTER NOW
+
+/      THE ABOVE INSTRUCTIONS ARE FOR DECMATE II USE ONLY.  THE DEFAULT  INSTRUCTIONS
+/      ARE FOR KL8 INTERFACES.
+
+       *REMTSF                 /OVERLAY DECMATE II CODE
+
+REMTSF,        RTSFIOT                 /FLAG UP?
+RMPUT0,        JMP     REMCLEAR        /NO, FORGET IT
+REMTLS,        RTLSIOT                 /YES, OUTPUT THE CHARACTER NOW
+RMPUT1,        ISZ     REMPUT          /TAKE SKIP RETURN
+REMCLEA,CLA                    /CLEAN UP
+RMPUT2,        JMP I   REMPUT          /RETURN EITHER WAY
+
+       CLA                     /CLEAN UP
+       DCA     OUTFLAG         /INDICATE OUTPUT IS UNAVAILABLE
+       ISZ     REMPUT          /TAKE SKIP RETURN
+       JMP I   REMPUT          /RETURN TO CALLER
+
+       RMPTEMP=CONRESET        /REMOTE OUTPUT TEMPORARY
+
+       PAGE
+\f/     SEVEN-BIT COMMAND TABLES.                                       /034 CJL
+
+       CMDTBL= .               /COMMAND TABLE HERE
+
+       "C&177; "O&177; "N&177  /\
+       "N&177; "E&177; "C&177  / >CONNECT COMMAND
+       "T&177; -1              //
+       CONSRV                  /CONNECT ROUTINE ADDRESS
+
+       "F&177; "I&177; "N&177  /\
+       "I&177; "S&177; "H&177  / >FINISH COMMAND
+       -1                      //
+       FINSRV                  /FINISH ROUTINE ADDRESS
+
+       "E&177; "X&177; "I&177  /EXIT
+       "T&177; -1              /COMMAND
+       EXITKERMIT              /EXIT ROUTINE ADDRESS
+
+       "S&177; "E&177; "N&177  /SEND
+       "D&177; -1              /COMMAND
+       SNDSRV                  /SEND ROUTINE ADDRESS
+
+       "G&177; "E&177; "T&177  /GET
+       -1                      /COMMAND
+       GETSRV                  /GET ROUTINE ADDRESS
+
+       "R&177; "E&177; "C&177  /\
+       "E&177; "I&177; "V&177  / >RECEIVE COMMAND
+       "E&177; -1              //
+       RECSRV                  /RECEIVE ROUTINE ADDRESS
+\f      "H&177; "E&177; "L&177  /HELP
+       "P&177; -1              /COMMAND
+       HELPSRV                 /HELP ROUTINE ADDRESS
+
+       -1                      /THIS ENDS THE TABLE                    /034 CJL
+
+/      REMOTE PACKET INPUT BUFFER.                                     /014 CJL
+
+RRBUF, 0                       /MARK
+RRLEN, 0                       /PACKET LENGTH
+RRSEQ, 0                       /PACKET SEQ
+RRTYP, 0                       /PACKET TYPE
+
+       DECIMAL
+
+RRDTA, ZBLOCK  91              /DATA GOES HERE
+
+       OCTAL
+
+RTERMI,        0                       /ADD LOCATION WHERE TERMINATOR IS STORED/A004
+                               /ON RECEIVE IF BUFFER IS MAXIMUM LENGTH /A004
+
+/      REMOTE PACKET OUTPUT BUFFER
+
+RSBUF, CNTRLA                  /PACKET BUFFER (BEGINS WITH "SOH")      /034 CJL
+RSLEN, 0                       /PACKET LENGTH GOES HERE
+RSSEQ, 0                       /PACKET SEQUENCE GOES HERE
+RSTYP, 0                       /PACKET TYPE GOES HERE
+
+       DECIMAL
+
+RSDTA, ZBLOCK  91              /DATA GOES HERE
+
+       0                       /CHECKSUM HERE ON MAX PACKET
+       0                       /EOL (IF USED HERE ON MAX PACKET)
+       0                       /INTERNAL TERMINATOR HERE ON MAX PACKET
+
+       OCTAL
+\f/     SEND-INIT PACKET DEFINITION
+
+INIDAT,        DECIMAL
+
+       94+32                   /94 CHARS MAX
+
+       OCTAL
+
+       "/&177                  /15 SECOND TIME-OUT                     /M013/014 CJL
+       " &177                  /NO PADDING
+       0+100&177               /NO PADDING CHAR
+       " &177+15               /CR FOR EOL
+       "#&177                  /QUOTE CHAR
+       "N&137                  /NO 8TH BIT QUOTING
+       "1&177                  /CHECK TYPE 1
+       " &177                  /NO REPEAT CHAR
+       " &177+0                /NO EXTRA CAPABILITY
+NODATA,        -1                      /END OF DATA (USE THIS FOR SENDING NO-DATA)
+\f      PAGE                    /GET TO NEXT PAGE                       /028 CJL
+
+/      NO-INTERRUPT CONSOLE INPUT/OUTPUT SUPPORT ROUTINES.             /023 CJL
+
+/      MODIFIED FOR FORCED-ECHO AND COLUMN-COUNTING.                   /043 CJL
+
+/      CONSOLE INPUT ROUTINE.  RETURNS  LATEST  CHARACTER  WITHOUT  ECHOING.   MAY BE
+/      CALLED WITH DIRTY AC.  RETURNS LATEST SEVEN-BIT CHARACTER TYPED WHILE FIELDING
+/      POTENTIAL <^S>/<^Q> PROTOCOL.
+
+INPUT, .-.                     /CONSOLE INPUT ROUTINE
+INPWAIT,JMS    CHKUP           /TRY TO GET A CHARACTER
+       TAD     INCHAR          /GET THE CHARACTER
+       SNA                     /SKIP IF ANYTHING CAME IN
+       JMP     INPWAIT         /WAIT FOR ANYTHING
+       JMP I   INPUT           /RETURN WITH LATEST CHARACTER
+
+/      CONSOLE  OUTPUT  ROUTINE.    OUTPUTS  CHARACTER  IN  AC  (INCLUDING  <HT>  VIA
+/      SIMULATION).  RETURNS WITH CLEAR AC.  SUBJECT TO CONSOLE ECHO STATUS (ECHOSW).
+
+P7CH,  .-.                     /CONSOLE OUTPUT ROUTINE
+       TAD     (-CNTRLI)       /COMPARE TO <HT>
+       SNA                     /SKIP IF OTHER
+       JMP     DOTAB           /JUMP IF <HT>
+       TAD     L11/(CNTRLI)    /RESTORE THE CHARACTER
+       JMS     P7CHAR          /PRINT IT (UPDATING COLUMN COUNT)
+       JMP I   P7CH            /RETURN
+
+DOTAB, TAD     [" &177]        /GET A <SPACE>
+       JMS     P7CHAR          /OUTPUT IT
+       TAD     COLUMN          /GET CURRENT COLUMN COUNT
+       AND     [7]             /JUST TAB BITS
+       SZA CLA                 /SKIP IF NOW AT NEW TAB STOP
+       JMP     DOTAB           /ELSE KEEP GOING
+       JMP I   P7CH            /RETURN
+
+/      FORCED-ECHO  CONSOLE  OUTPUT ROUTINE.  SAME AS P7CH BUT CLEARS  ECHOSW  BEFORE
+/      OUTPUT OF THE CHARACTER.
+
+P7ECHO,        .-.                     /CONSOLE OUTPUT WITH FORCED-ECHO ROUTINE
+       DCA     P7TEMP          /SAVE PASSED VALUE
+       DCA     ECHOSW          /CLEAR ECHO STATUS
+       TAD     P7TEMP          /RESTORE THE CHARACTER
+       JMS     P7CH            /CALL MAIN ROUTINE
+       JMP I   P7ECHO          /RETURN
+\fCHKUP,        .-.                             /CHECK FOR <^C>, ETC. ROUTINE
+       JMS     CTLCTST                 /CALL LOW-LEVEL INPUT CHECK ROUTINE
+       SNA                             /SKIP IF ANYTHING CAME BACK
+       JMP     CHKCLR                  /ELSE FORGET IT
+       TAD     (-CNTRLP)               /COMPARE TO <^P>
+       SNA                             /SKIP IF OTHER
+       JMP     DOUP                    /GO HANDLE <^P> THERE
+       IAC     /TAD    (-CNTRLO+CNTRLP)/COMPARE TO <^O>
+       SNA                             /SKIP IF OTHER
+       JMP     DOUO                    /GO HANDLER <^O> THERE
+       TAD     (-CNTRLS+CNTRLO)        /COMPARE TO <^S>
+       SZA CLA                         /SKIP IF IT MATCHES
+       JMP I   CHKUP                   /RETURN ON UNIMPORTANT CHARACTERS
+UQWAIT,        JMS     CTLCTST                 /CALL LOW-LEVEL INPUT CHECK ROUTINE
+       TAD     (-CNTRLQ)               /COMPARE TO <^Q>
+       SZA CLA                         /SKIP IF IT MATCHES
+       JMP     UQWAIT                  /ELSE WAIT FOR <^Q> FOREVER
+CHKCLR,        DCA     INCHAR                  /OBLITERATE INPUT CHARACTER
+       JMP I   CHKUP                   /RETURN
+
+/      COMES HERE TO HANDLE <^P>.
+
+DOUP,  TAD     ("P&177)                /GET A "P"
+       JMS     UPRINT                  /PRINT "^P"
+       JMP I   UPADDRESS               /GO WHERE YOU SHOULD
+
+/      COMES HERE TO HANDLE <^O>.
+
+DOUO,  TAD     ("O&177)                /GET AN "O"
+       JMS     UPRINT                  /PRINT "^O"
+       NL4000                          /SET REVERSING BIT
+       TAD     ECHOSW                  /REVERSE THE ECHO STATE
+       DCA     ECHOSW                  /STORE BACK
+       JMP     CHKCLR                  /OBLITERATE <^O> AND RETURN
+
+CTLCTST,.-.                            /LOW-LEVEL <^C> TEST ROUTINE
+       CLA                             /CLEAN UP
+KSFLOC,        KSFIOT                          /FLAG UP?
+       JMP I   CTLCTST                 /NO, JUST RETURN
+KRSZAP,        KRSIOT                          /**** 6120 **** KRBIOT
+       AND     [177]                   /JUST SEVEN-BIT
+       DCA     INCHAR                  /SAVE THE CHARACTER
+       NL7775                          /SET -<^C> VALUE
+       TAD     INCHAR                  /COMPARE TO CHARACTER
+       SNA CLA                         /SKIP IF OTHER THAN <^C>
+       JMP I   UCADDRESS               /JUMP IF <^C>
+KCCZAP,        KCCIOT                          /**** 6120 **** 0000
+       TAD     INCHAR                  /GET THE CHARACTER
+       JMP I   CTLCTST                 /RETURN
+\fP7CHAR,       .-.                     /LOWER-LEVEL CONSOLE PRINT ROUTINE
+       DCA     P7TEMP          /SAVE PASSED VALUE
+P7AGN, JMS     CHKUP           /CHECK FOR <^C>, ETC.
+       TAD     ECHOSW          /GET CURRENT ECHO STATUS
+       SPA CLA                 /SKIP IF ECHO ON
+       JMP     P7OFF           /JUMP IF ECHO OFF
+       TAD     P7TEMP          /GET THE PASSED VALUE BACK
+       JMS     P7OUT           /TRY TO OUTPUT IT
+       JMP     P7AGN           /COULDN'T OUTPUT, GO WAIT THERE
+P7OFF, JMS     CHKUP           /CHECK FOR <^C>, ETC.
+       TAD     P7TEMP          /GET THE CHARACTER BACK
+       AND     [140]           /JUST QUADRANT BITS
+       SZA CLA                 /SKIP IF CONTROL CHARACTER
+       ISZ     COLUMN          /BUMP COLUMN IF PRINTING CHARACTER
+L11,   CNTRLI/NOP              /JUST IN CASE
+       TAD     P7TEMP          /GET THE CHARACTER AGAIN
+       TAD     (-CNTRLM)       /COMPARE TO <CR>
+       SNA                     /SKIP IF NOT <CR>
+       DCA     COLUMN          /CLEAR COLUMN COUNT ON <CR>
+       TAD     (-CNTRLH+CNTRLM)/COMPARE TO <BS>
+       SNA CLA                 /SKIP IF OTHER
+       NL7777                  /SET BACKUP VALUE
+       TAD     COLUMN          /UPDATE COLUMN COUNT
+       DCA     COLUMN          /STORE BACK
+       JMP I   P7CHAR          /RETURN
+
+P7OUT, .-.                     /LOW-LEVEL CONSOLE OUTPUT ROUTINE
+P7TSF, TSFIOT                  /FLAG UP?
+       JMP I   P7OUT           /NO, TAKE IMMEDIATE RETURN WITH AC INTACT
+P7TLS, TLSIOT                  /YES, OUTPUT IT
+       CLA                     /CLEAN UP
+       ISZ     P7OUT           /BUMP RETURN ADDRESS
+       JMP I   P7OUT           /TAKE SKIP RETURN TO CALLER
+
+/      COMES HERE TO HANDLE <^C> IF SO ENABLED.
+
+UPCPRT,        TAD     ("C&177)        /GET A "C"
+       JMS     UPRINT          /PRINT "^C"
+KCCZP2,        KCCIOT                  /**** 6120 **** 0000
+       JMP I   [CLOOP]         /RESTART
+
+UPRINT,        .-.                     /"^"<CHARACTER> PRINTING ROUTINE
+       DCA     P7TEMP          /SAVE PASSED VALUE
+       TAD     ("^&177)        /GET AN "^"
+       JMS     P7OUT           /OUTPUT IT
+       JMP     .-1             /WAIT FOR IT
+       TAD     P7TEMP          /GET PASSED VALUE
+       JMS     P7OUT           /OUTPUT IT
+       JMP     .-1             /WAIT FOR IT
+       JMP I   UPRINT          /RETURN
+
+P7TEMP,        .-.                     /OUTPUT ROUTINE TEMPORARY
+\f      PAGE
+
+/      HANDLER I/O BUFFER DEFINITIONS.                                 /014 CJL
+
+       HNDLR=  .               /BUFFER FOR DISK I/O HANDLER            /014 CJL
+
+       *PAGCNT^200+HNDLR       /RESET ORIGIN PAST HANDLER BUFFER       /014 CJL
+
+       IFNZRO  SBOOT-.&4000    <ERROR  .>                              /028 CJL
+
+       *SBOOT-2                /JUST BEFORE EXIT ADDRESS               /025 CJL
+EXITKER=.              /WHERE TO EXIT TO                       /025 CJL
+       0
+       CAF /PHPH
+\f/     ONCE-ONLY INITIALIZATION CODE.                                  /024 CJL
+
+       *HNDLR                  /OVER AVAILABLE SPACE
+
+INITIAL,CLA CLL                        /CLEAN UP
+COUTINI,TLSIOT                 /RAISE CONSOLE OUTPUT FLAG              /046 CJL
+       TAD     INITIA/(CLA CLL)/GET REPLACEMENT INSTRUCTION
+       DCA I   [CLOOP]         /DON'T COME BACK TO US
+       JMS I   (MACHINE)       /IDENTIFY CPU TYPE
+       DCA     CPUTEMP         /SAVE IT
+       TAD     CPUTEMP         /GET CPU TYPE
+       TAD     (-13)           /COMPARE TO DEADLY 6120 VALUE
+       SNA CLA                 /SKIP IF OTHER
+       JMP     INI6120         /JUMP IF IT MATCHES
+ROUTINI,RTLSIOT                        /INITIALIZE REMOTE OUTPUT               /046 CJL
+RININIT,RKRBIOT                        /INITIALIZE REMOTE INPUT                /046 CJL
+       CLA                     /CLEAN UP
+INITPRT,
+/PHPHPH
+/      JMS I   [SCRIBE]        /GIVE THEM THE
+/      INITMSG                 /OPENING MESSAGE
+/      JMS I   [SCRIBE]        /GIVE THEM THE
+/      DAYMSG                  /DAY MESSAGE
+/      JMS I   [SCRIBE]        /GIVE THEM THE
+/      MONMSG                  /MONTH MESSAGE
+/      JMS I   [SCRIBE]        /GIVE THEM THE
+/      YEARMSG                 /YEAR MESSAGE
+/      JMS I   [SCRIBE]        /GIVE THEM THE
+/      CPUTMSG                 /CPU ID MESSAGE
+       TAD     CPUTEMP         /*1
+       CLL RTL                 /*4
+       TAD     CPUTEMP         /*5
+       TAD     (CPULIST)       /POINT TO PROPER MESSAGE
+       DCA     TST6120         /STORE IN-LINE
+/      JMS I   [SCRIBE]        /TELL THEM THEIR
+       SKP     /PHPH
+TST6120,0                      /ACTUAL CPU ID
+/      JMS I   [SCRIBE]        /GIVE THEM THE
+/      CLOSMSG                 /CLOSING MESSAGE
+DMPRZAP,JMP    .+3             /**** DECMATE USAGE DETECTED **** 0000
+       JMS I   [SCRIBE]        /GIVE THEM THE
+SPZAP, DMPOMSG                 /DECMATE PORT MESSAGE
+       JMS I   [SCRIBE]        /GIVE THEM THE
+       CRLF                    /END OF LINE
+       JMS I   [SCRIBE]        /GIVE THEM THE
+       LCLMSG                  /LOCAL PREFERENCE MESSAGE
+/      JMS I   [SCRIBE]        /TELL THEM THEY CAN
+/      THLPMSG                 /ASK FOR HELP
+       TAD     CPUTEMP         /GET CPU TYPE
+       CLL RTL                 /*4
+       TAD     (CPUPRMPT-1)    /POINT TO PROPER ENTRY
+       DCA     XR0             /STASH THE POINTER
+       TAD     (-4)            /GET MOVE COUNT
+       JMS     MESMOVE         /MOVE THE PROPER PROMPT TEXT
+       PROMID-1                /TO THERE
+\f      TAD     CPUTEMP         /*1
+       CLL RTL                 /*4
+       TAD     CPUTEMP         /*5
+       TAD     (CPUIDLST-1)    /POINT TO PROPER ENTRY
+       DCA     XR0             /STASH THE POINTER
+       TAD     (-5)            /GET MOVE COUNT
+       JMS     MESMOVE         /MOVE THE PROPER CPU ID TEXT
+       CPUMSG-1                /TO THERE
+       CIF     USRFLD          /GOTO USR FIELD                         /035 CJL
+       JMS I   (USR)           /CALL USER SERVICE ROUTINE              /035 CJL
+       USRIN                   /LOCK USR IN                            /035 CJL
+
+/      DO FURTHER INITIALIZATION HERE.
+
+       JMP I   [CLOOP]         /GO BACK TO KERMIT PROPER
+
+/      COMES HERE TO INITIALIZE 6120-BASED MACHINES.                   /046 CJL
+
+INI6120,DCA I  (KCCZAP)        /ELIMINATE KCCIOT
+       DCA I   (KCCZP2)        /ELIMINATE KCCIOT
+       ISZ I   (KRSZAP)        /TURN KRSIOT
+       ISZ I   (KRSZAP)        /INTO KRBIOT
+       TAD     ROUTINITIALIZE  /GET OUTPUT INITIALIZE INSTRUCTION      /046 CJL
+       TAD     (-6336)         /COMPARE TO POSSIBLE VALUE              /046 CJL
+       SZA CLA                 /SKIP IF IT MATCHES SERIAL PRINTER VALUE/046 CJL
+       JMP     TRYDM1          /JUMP IF NOT CONFIGURED FOR SERIAL PORT /046 CJL
+       TAD     RININITIALIZE   /GET INPUT INITIALIZE INSTRUCTION       /046 CJL
+       TAD     (-6326)         /COMPARE TO POSSIBLE VALUE              /046 CJL
+       SNA CLA                 /SKIP IF NOT CONFIGURED FOR SERIAL PORT /046 CJL
+       JMP     DMSER           /JUMP IF SERIAL PORT CONFIGURATION      /046 CJL
+TRYDM1,        CLSK                    /SKIP ON, CLEAR CLOCK FLAG IF DECMATE II/046 CJL
+       NOP                     /JUST IN CASE                           /046 CJL
+       CLCL                    /CLEAR VT278 CLOCK FLAG                 /046 CJL
+       NOP                     /JUST IN CASE                           /046 CJL
+       ISZ     TST6120         /WASTE                                  /046 CJL
+       JMP     .-1             /SOME TIME                              /046 CJL
+       CLSK8A                  /VT278 CLOCK FLAG UP?                   /046 CJL
+       JMP     TRYDM2          /NO, TRY DECMATE II, ETC.               /046 CJL
+       DCA     DMPRZAP         /MAKE IT PRINT OUR MESSAGE              /050 CJL
+       CIF CDF DMIFLD          /GOTO DECMATE ONCE-ONLY CODE FIELD      /046 CJL
+       JMP I   (DM1INIT)       /CONTINUE THERE                         /046 CJL
+
+TRYDM2,        CLSK                    /CLOCK FLAG UP?                         /046 CJL
+       JMP     ROUTINITIALIZE  /NO, MUST BE SOMEBODY ELSE!             /046 CJL
+       DCA     DMPRZAP         /MAKE IT PRINT OUR MESSAGE              /048 CJL
+       CIF CDF DMIFLD          /GOTO DECMATE ONCE-ONLY FIELD           /046 CJL
+       JMP I   (DM2INIT)       /CONTINUE THERE                         /046 CJL
+
+/      COMES HERE IF SERIAL PORT CONFIGURATION ON DECMATE.
+
+DMSER, DCA     DMPRZAP         /MAKE IT PRINT OUR MESSAGE              /048 CJL
+       TAD     (DMPPMSG)       /GET OUR MESSAGE ADDRESS                /048 CJL
+       DCA     SPZAP           /STORE IN-LINE                          /048 CJL
+       JMP     ROUTINITIALIZE  /CONTINUE THERE
+\fMESMOVE,.-.                   /MESSAGE MOVE ROUTINE
+       DCA     MMOVCNT         /SAVE PASSED COUNT
+       TAD I   MESMOVE         /GET THE PASSED ARGUMENT
+       DCA     XR1             /SET IT UP
+       ISZ     MESMOVE         /BUMP PAST ARGUMENT
+       CDF     MSGFLD          /GOTO BUFFER FIELD
+MESMVLP,TAD I  XR0             /GET A WORD
+       DCA I   XR1             /PUT A WORD
+       ISZ     MMOVCNT         /DONE YET?
+       JMP     MESMVLP         /NO, GO BACK
+       CDF     PRGFLD          /BACK TO OUR FIELD
+       JMP I   MESMOVE         /YES, RETURN
+
+CPUTEMP,.-.                    /TEMPORARY FOR MACHINE TYPE
+MMOVCNT,.-.                    /TEMPORARY FOR MOVE COUNT
+
+       PAGE
+\f/     CPU IDENTIFYING ROUTINE.                                        /024 CJL
+
+/      RETURNS VALUE IN AC ACCORDING TO THE FOLLOWING RULE:
+
+/      AC      CPU TYPE
+
+/      0       UNKNOWN (DCC112, MP-12?)
+/      1       PDP-5 (THE INCOMPATIBLE ONE!)
+/      2       PDP-8 (THE REAL ONE!)
+/      3       PDP-8/S (THE SLOW ONE!)
+/      4       LINC-8 (THE STRANGE ONE!)
+/      5       PDP-8/I (THE ORANGE ONE!)
+/      6       PDP-8/L (THE STRIPPED-DOWN ONE!)
+/      7       PDP-12 (THE GREEN ONE! (BLUE?))
+/      10      PDP-8/E (THE FAST ONE!)
+/      11      PDP-8/A (THE WIDE ONE!)
+/      12      6100 (THE MICRO ONE!)
+/      13      6120 (THE HARRIS ONE!)
+
+MACHINE,.-.                    /MACHINE IDENTIFYING ROUTINE
+       CLA CLL                 /THIS WORKS ON EVERYBODY!
+       TAD     0               /GET PDP-5 PC
+       DCA     MACHTEMP        /SAVE IT
+       TAD     (IMA5-1)        /GET PDP-5 NEW PC
+       DCA     0               /STORE IT
+
+/      IF WE GET HERE, WE'RE NOT A PDP-5.
+
+       TAD     MACHTEMP        /GET OLD LOCATION ZERO
+       DCA     0               /RESTORE IT
+       NL3776                  /PDP-8/I, L WEIRDNESS
+       TAD     (-3776)         /COMPARE TO POSSIBLE VALUE
+       SNA CLA                 /SKIP IF NOT THOSE TWO
+       JMP     IMA8IL          /JUMP IF ONE OF THEM
+
+/      IF WE GET HERE, WE'RE NOT A PDP-8/I OR PDP-8/L.
+
+       NL7776                  /SETUP -2
+       TAD     (-7776)         /COMPARE TO EXPECTED VALUE
+       SZA CLA                 /SKIP IF OK
+       JMP     IMA8S           /JUMP IF RETARDED BROTHER
+
+/      IF WE GET HERE, WE'RE NOT A PDP-8/S.
+
+       NL0100                  /SETUP 0100
+       TAD     (-100)          /COMPARE TO EXPECTED VALUE
+       SNA CLA                 /SKIP IF STRAIGHT PDP-8
+       JMP     IMAOMNIBUS      /JUMP IF NEWER CPU
+\f/     IF WE GET HERE, WE ARE A PDP-8, BUT ARE WE A LINC-8?
+
+       NL7777                          /SETUP LINC TEST VALUE
+       IACA                            /LOAD LINC "A" REGISTER
+       CLA                             /CLEAN UP
+       IAAC                            /GET IT BACK
+       IAC                             /ADD ONE
+       SNA CLA                         /SKIP IF NO LINC HARDWARE
+       JMP     IMAL8                   /JUMP IF LINC-8
+
+/      SINCE WE DON'T CARE ABOUT PERIPHERALS, WE ARE A PDP-8.
+
+       JMP     IMA8                    /GO TELL THEM WE ARE A PDP-8
+
+/      COMES HERE IF PDP-8/I OR PDP-8/L.
+
+IMA8IL,        NL7777                          /SETUP TEST VALUE
+       CLA!401                         /DO PDP-8/I GROUP THREE EAE CLA
+       SZA CLA                         /SKIP IF PDP-8/I
+       JMP     IMA8L                   /JUMP IF NOT
+
+/      IF WE GET HERE, WE ARE A PDP-8/I, BUT ARE WE A PDP-12?
+
+       LINC                            /GOTO LINC MODE
+       COM                             /COMPLEMENT AC IF PDP-12, ELSE A HARMLESS AND
+       PDP                             /GOTO PDP8 MODE IF PDP-12, ELSE HARMLESS AND
+       IAC                             /ADD ONE FOR TEST
+       SNA CLA                         /SKIP IF JUST PDP-8/I
+       JMP     IMA12                   /JUMP IF ACTUALLY A LINC-8/I
+
+/      SINCE WE DON'T CARE ABOUT PERIPHERALS, WE ARE JUST A PDP-8/I.
+
+       JMP     IMA8I                   /TELL THEM WE ARE A PDP-8/I
+
+IMAOMNI,RTL RTR                                /DO STRANGE OMNIBUS INSTRUCTION
+PC8A,  SNA                             /SKIP IF NOT A MICRO CHIP
+       JMP     IMA61                   /JUMP IF ONE OF THOSE THINGS
+       TAD     (.&7600+16^7777)        /CHECK FOR PDP-8/E VALUE
+       SNA                             /SKIP IF NOT HIM
+       JMP     IMA8E                   /JUMP IF IT IS A PDP-8/E (/F OR /M OR 8A-6XX)
+       TAD     (.&7600+16-PC8A)        /COMPARE TO PDP-8/A VALUE       /051 CJL
+       SNA CLA                         /SKIP IF SOMEBODY ELSE
+       JMP     IMA8A                   /JUMP IF IT MATCHES
+
+/      IF WE GET HERE, SOME STRANGE PROCESSOR IS RUNNING US.
+
+       JMP     IMAUNKNOWN              /YOU FIGURE IT OUT!
+\f/     IF WE GET HERE, WE ARE A 6100 OR 6120.
+
+IMA61, NL0010                  /DO 6120 SPECIAL INSTRUCTION
+       TAD     (-10)           /COMPARE TO EXPECTED VALUE
+       SNA CLA                 /SKIP IF OTHER
+       JMP     IMA6120         /JUMP IF IT MATCHES
+
+/      WE APPARENTLY ARE ON A 6100, SO TELL THEM SO.
+
+       JMP     IMA6100         /TELL THEM WE ARE A 6100 MACHINE (VT-78, ETC.)
+
+/      RETURN GAUNTLET.
+
+IMA6120,IAC                    /SET 6120 VALUE
+IMA6100,IAC                    /SET 6100 VALUE
+IMA8A, IAC                     /SET PDP-8/A VALUE
+IMA8E, IAC                     /SET PDP-8/E VALUE
+IMA12, IAC                     /SET PDP-12 VALUE
+IMA8L, IAC                     /SET PDP-8/L VALUE
+IMA8I, IAC                     /SET PDP-8/I VALUE
+IMAL8, IAC                     /SET LINC-8 VALUE
+IMA8S, IAC                     /SET PDP-8/S VALUE
+IMA8,  IAC                     /SET PDP-8 VALUE
+IMA5,  IAC                     /SET PDP-5 VALUE
+IMAUNKN,JMP I  MACHINE         /RETURN
+
+MACHTEM,.-.                    /TEMPORARY FOR LOCATION ZERO
+
+       PAGE
+\f      FIELD   PRGFLD%10       /DUMP THE LITERALS NOW
+\f/     LAYOUT OF FIELD ONE (PERMANENT CONTENTS).                       /046 CJL
+
+       NOPUNCH                         /FOOL THE ASSEMBLER             /046 CJL
+
+       FIELD   USRFLD%10               /USR FIELD                      /046 CJL
+
+       *0                              /WHERE IT LOADS                 /046 CJL
+
+USRLOAD,ZBLOCK 200-.                   /GET TO ENTRY POINT             /046 CJL
+
+       USRENTR=.                       /LOCKED-IN USR ENTRY POINT      /046 CJL
+
+USRENTR,ZBLOCK 2000-.                  /USR OWNS REST OF THIS AREA     /046 CJL
+
+       FILBUFF=.                       /FILE I/O DONE HERE             /046 CJL
+
+       FIELD   BUFFLD%10               /FILE I/O BUFFER FIELD          /046 CJL
+
+       *FILBUFFER                      /RESET ORIGIN                   /046 CJL
+
+FILBUFF,ZBLOCK PAGCNT^200              /THIS IS THE FILE I/O BUFFER    /046 CJL
+
+       DIRBUFF=.                       /DIRECTORY LOOKUP I/O DONE HERE /028 CJL
+
+       FIELD   DIRFLD%10               /DIRECTORY LOOKUP BUFFER FIELD  /028 CJL
+
+       *DIRBUFFER                      /RESET ORIGIN                   /028 CJL
+
+FILECNT,.-.                            /-(NUMBER OF ENTRIES IN THIS SEGMENT)
+FRSTREC,.-.                            /FIRST RECORD OF FIRST ENTRY IN THIS SEGMENT
+DIRLINK,.-.                            /LINK TO NEXT SEGMENT; 0 IF LAST ACTIVE ONE
+       .-.                             /TENTATIVE ENTRY POINTER STORED HERE
+AIWNUMB,.-.                            /-(NUMBER OF ADDITIONAL INFORMATION WORDS)
+
+       ENTSTRT=.                       /FILE ENTRIES START HERE        /046 CJL
+
+       ZBLOCK  PAGCNT^200+DIRBUFFER-.  /DIRECTORY ENTRIES HERE         /046 CJL
+
+/      CONNECT MODE I/O BUFFERS.                                       /026 CJL
+
+KEYBUFF,ZBLOCK BUFSIZE                 /KEYBOARD BUFFER                /026 CJL
+CONBUFF,ZBLOCK BUFSIZE                 /CONSOLE OUTPUT BUFFER          /026 CJL
+RINBUFF,ZBLOCK BUFSIZE                 /REMOTE INPUT BUFFER            /026 CJL
+REMBUFF,ZBLOCK BUFSIZE                 /REMOTE OUTPUT BUFFER           /026 CJL
+
+       FLD1ADR=.                       /SPACE AVAILABLE FOR TEXT, ETC. /046 CJL
+
+       ENPUNCH                         /UN-FOOL THE ASSEMBLER          /046 CJL
+\f/     DECMATE ONCE-ONLY CODE.                                         /046 CJL
+
+       FIELD   DMIFLD%10               /DECMATE ONCE-ONLY CODE FIELD   /046 CJL
+
+       *USRLOAD                        /OVER USR ROUTINE               /046 CJL
+
+/      PAGE ZERO FOR ONCE-ONLY CODE.                                   /046 CJL
+
+       *10                             /GET TO AUTO-INDEX AREA         /048 CJL
+
+XR0,   .-.                             /AUTO-INDEX ZERO                /048 CJL
+
+       *USRENTRY                       /OVER USR ENTRY POINT           /046 CJL
+
+/      DECMATE I ONCE-ONLY CODE.                                       /046 CJL
+
+DM1INIT,JMS I  (DM1PORT)               /INITIALIZE THE REMOTE PORTS    /050 CJL
+       TAD     (DM1LIST-1)             /POINT TO REPLACEMENT LIST      /050 CJL
+       JMS     REPLACE                 /ZAP IN ALL OF OUR PATCHES      /050 CJL
+       CDF     PRGFLD                  /GOTO MAIN FIELD                /050 CJL
+       TAD I   (DIRXR)                 /GET PORT SELECTION             /050 CJL
+       SNA CLA                         /SKIP IF PORT 1 REQUIRED        /050 CJL
+       JMP     USEP0                   /JUMP IF PORT 0 REQUIRED        /050 CJL
+       TAD     (DM1SEC-1)              /POINT TO REPLACEMENT LIST      /050 CJL
+       JMS     REPLACE                 /ZAP IN SECONDARY PATCHES       /050 CJL
+USEP0, CIF CDF PRGFLD                  /BACK TO REST OF INITIALIZATION /046 CJL
+       JMP I   (INITPRT)               /CONTINUE THERE                 /046 CJL
+
+/      DECMATE II, ETC. ONCE-ONLY CODE.                                /046 CJL
+
+DM2INIT,JMS I  (DMIPORT)               /INITIALIZE THE REMOTE PORT     /048 CJL
+       TAD     (DM2LIST-1)             /POINT TO REPLACEMENT LIST      /048 CJL
+       JMS     REPLACE                 /ZAP IN ALL OF OUR PATCHES      /048 CJL
+       CIF CDF PRGFLD                  /BACK TO REST OF INITIALIZATION /046 CJL
+       JMP I   (INITPRT)               /CONTINUE THERE                 /046 CJL
+
+REPLACE,.-.                            /REPLACEMENT ROUTINE            /048 CJL
+       DCA     XR0                     /SAVE PASSED LIST POINTER       /048 CJL
+REPLUP,        CDF     DMIFLD                  /BACK TO OUR FIELD              /048 CJL
+       TAD I   XR0                     /GET AN ADDRESS                 /048 CJL
+       SNA                             /SKIP IF NOT AT END OF LIST     /048 CJL
+       JMP I   REPLACE                 /RETURN IF END OF LIST          /048 CJL
+       DCA     REPADR                  /STASH THE ADDRESS              /048 CJL
+       TAD I   XR0                     /GET THE REPLACEMENT VALUE      /048 CJL
+       CDF     PRGFLD                  /GOTO ZAPPING FIELD             /048 CJL
+       DCA I   REPADR                  /ZAP IT IN                      /048 CJL
+       JMP     REPLUP                  /KEEP GOING                     /048 CJL
+
+REPADR,        .-.                             /REPLACEMENT ADDRESS TEMPORARY  /048 CJL
+\f/     DECMATE I PORT INITIALIZE ROUTINE                               /050 CJL
+
+DM1PORT,.-.                            /DECMATE I PORT INITIALIZE ROUTINE
+       TAD     (234)                   /GET PORT 0 SCD ENABLE VALUE
+       WCON0                           /WRITE PORT 0 CONTROL REGISTER
+       NL0000                          /INDICATE PORT 0
+       JMS     PRTINIT                 /INITIALIZE PORT 0
+
+/      CHANGE ALL IOTS TO PORT 1 VALUES.
+
+IOCLUP,        ISZ     PSETF1                  /BUMP SET FLAG INSTRUCTION
+       ISZ     PDUMRD                  /BUMP DUMMY READ INSTRUCTION
+       ISZ     PSETF2                  /BUMP SET FLAG INSTRUCTION
+       ISZ     PSKIP                   /BUMP SKIP ON FLAG INSTRUCTION
+       ISZ     PLOAD                   /BUMP LOAD INSTRUCTION
+       ISZ     IOTCNT                  /DONE YET?
+       JMP     IOCLUP                  /NO, KEEP GOING
+
+       TAD     (234)                   /GET PORT 1 SCD ENABLE VALUE
+       WCON1                           /WRITE PORT 1 CONTROL REGISTER
+       NL4000                          /INDICATE PORT 1
+       JMS     PRTINIT                 /INITIALIZE PORT 1
+       JMP I   DM1PORT                 /RETURN
+
+PRTINIT,.-.                            /LOW-LEVEL PORT INTIALIZE ROUTINE
+       RACD                            /RESET DESIRED PORT
+       ISZ     PWASTE                  /WASTE
+       JMP     .-1                     /SOME TIME
+       CLA                             /CLEAN UP
+PSETF1,        RTFL0                           /SET THE FLAG NOW
+       TAD     (2516)                  /SETUP FOR 8 BITS, NO PARITY, ETC.
+       JMS     PSEND                   /SEND TO MODE REGISTER 1
+       CDF     PRGFLD                  /GOTO MAIN FIELD
+       TAD I   (RATE)                  /GET BAUD RATE NOW
+       CDF     DMIFLD                  /BACK TO OUR FIELD
+       TAD     (2460)                  /ADD ON CLOCK ENABLES, ETC.
+       JMS     PSEND                   /SEND TO MODE REGISTER 2
+       TAD     (3425)                  /GET ENABLE AND RESET VALUE
+       JMS     PSEND                   /SEND TO COMMAND REGISTER
+PDUMRD,        RKRB0                           /DO A DUMMY READ NOW
+PSETF2,        RTFL0                           /SET THE FLAG NOW
+       CLA                             /CLEAN UP
+       JMP I   PRTINIT                 /RETURN
+
+PSEND, .-.                             /PORT WRITE ROUTINE
+PSKIP, RTSF0                           /FLAG UP?
+       JMP     PSKIP                   /NO, WAIT FOR IT
+PLOAD, RTLS0                           /YES, LOAD THE VALUE
+       CLA                             /CLEAN UP
+       JMP I   PSEND                   /RETURN
+
+IOTCNT,        RKFL0-RKFL1                     /INTER-DEVICE IOT COUNT
+PWASTE,        0                               /TIMER TEMPORARY
+\f      PAGE
+\f/     DECMATE II, ETC. PORT INITIALIZE ROUTINE.                       /048 CJL
+
+/      THIS ROUTINE IS MOSTLY  "DARK  GREY MAGIC" WHICH IS PRIMARILY DERIVED FROM THE
+/      "OFFICIAL" INFORMATION TAKEN FROM THE ONLY KNOWN DOCUMENTATION, THE DECMATE II
+/      PROGRAMMER'S REFERENCE MANUAL:  EK-DECM2-RM-001.  VARIOUS EMPLOYEES OF DIGITAL
+/      EQUIPMENT CORPORATION (A MULTI-NATIONAL COMPANY) HAVE ADDITIONALLY CONTRIBUTED
+/      TO THIS EFFORT BY PROVIDING PORTIONS OF THE  "SACRED SLUSHWARE NOTES" ON A NOT
+/      NECESSARILY  WILLING  BASIS  THROUGH  THEIR RELEASED WORKS, SUCH AS,  BUT  NOT
+/      LIMITED TO, THE SOURCES OF THE PARTICULAR VERSION OF KERMIT-8  KNOWN  AS K278.
+/      IT  IS  ASSUMED THAT THESE PEOPLE HAVE ACCESS TO BETTER DOCUMENTATION  OF  THE
+/      HARDWARE, AND  ESPECIALLY  DOCUMENTATION  OF  THE  THREE  DIFFERENT  MODELS OF
+/      DECMATE (II, III, III+) THAT THESE ISSUES APPLY TO.
+
+/      SINCE IT IS NOT KNOWN WHETHER THE K278, ETC.  CODE IS SPECIFIC AND PRECISE, OR
+/      MERELY SLOPPY, VARIOUS "QUIRKY" CODING TECHNIQUES HAVE BEEN LEFT "AS IS", WITH
+/      COMMENTS   REGARDING  POTENTIAL  VARIANCE  WITH  DOCUMENTATION  NOTED    WHERE
+/      NECESSARY.  THE ORDER OF ACCESS TO THE  REGISTERS HAS BEEN LEFT INTACT IN CASE
+/      OF POTENTIAL INTERACTION.  SEVERAL CHANGES HAVE BEEN MADE  BEYOND THIS WORK AS
+/      A  RESULT  OF  TRIAL-AND-ERROR, AND ALSO HAND DIS-ASSEMBLY OF SEVERAL  DECMATE
+/      DISKETTES' CONTENTS.
+
+/      IT IS HOPED THAT FUTURE "NEGOTIATIONS" WITH DEC ALLOW FOR PROPER DISCLOSURE OF
+/      THESE ISSUES TO AVOID POTENTIAL SOFTWARE FAILURES  EVIDENT  IN  THESE ROUTINES
+/      DUE TO LACK OF PROPER DOCUMENTATION.
+
+DMIPORT,.-.                    /COMMUNICATIONS PORT INITIALIZE ROUTINE
+
+/      ACCORDING TO THE DECMATE II MANUAL, THE FOLLOWING INSTRUCTION IS UNDEFINED.
+
+       MPRESET                 /RESET MULTIPROTOCOL COMMUNICATIONS CONTROLLER CHIP
+
+/      THE DECMATE III HAS  AN  INTERNAL  MODEM  OPTION WHICH IS NOT AVAILABLE IN THE
+/      DECMATE II.  THE INTERFACE  TO THIS DEVICE IS APPARENTLY SHARED WITH THE MPSCC
+/      MODEM INTERFACE WE NORMALLY USE, SO THE REGISTER ACCESS MUST BE MORE CAREFULLY
+/      DEFINED.  THE APPARENT DIFFERENTIATION IS THE CURRENT VALUE OF THE DATA FIELD,
+/      NAMELY EITHER FIELD 0 OR 1.  IT  IS  NOT  KNOWN WHETHER THE THREE-BIT VALUE OF
+/      THE DATA FIELD IS SIGNIFICENT (PRESUMABLY FOR FUTURE EXPANSION), OR MERELY THE
+/      DATA  FIELD'S  LOW-ORDER  BIT  IS  USED, AS ALL KNOWN EXAMPLES  OF  ALLEDGEDLY
+/      FUNCTIONAL CODE USE APPROPRIATE CDF 00 AND CDF 10 ONLY.   APPARENTLY THE MODEM
+/      INTERFACE IS REFERRED TO AS "A" AND THE MPSCC INTERFACE IS REFERRED TO AS "B".
+
+       TAD     (030)           /GET RESET VALUE
+       CDF     00              /TALKING TO REGISTER 0A
+       MPSCC                   /RESET COMMUNICATIONS CHIP
+       CDF     10              /TALKING TO REGISTER 0B
+       MPSCC                   /RESET COMMUNICATIONS CHIP
+\f/     ACCORDING  TO  THE  DECMATE II MANUAL, CONTROL  REGISTER  2 "HAS  NO  RELEVANT
+/      BITS...  IF IT IS EVER WRITTEN, IT MUST BE WRITTEN WITH ALL ZEROS." APPARENTLY
+/      THE  MODEM  INTERFACE  DEMANDS  A  NON-ZERO  VALUE  BE  WRITTEN  TO REGISTER 2
+/      (PRESUMABLY TO  DISABLE  IT).  TO SATISFY THE ABOVE REQUIREMENT (WHATEVER THIS
+/      IMPLIES!), REGISTER 2(B)  IS  WRITTEN  WITH ALL ZEROS *LAST* IN CASE THIS IS A
+/      DECMATE II WHERE THE DATA FIELD CONSIDERATIONS ARE MEANINGLESS.
+
+       CDF     00              /TALKING TO REGISTER 0A
+       NL0002                  /WANT REGISTER 2A
+       MPSCC                   /SELECT IT
+       TAD     (020-2)         /GET RESET VALUE
+       MPSCC                   /LOAD IT
+       CDF     10              /TALKING TO REGISTER 0B
+       NL0002                  /WANT REGISTER 2B
+       MPSCC                   /SELECT IT
+       NL0000                  /GET RESET VALUE (000)
+       MPSCC                   /LOAD IT
+
+/      THE K278 CODE DOES NOT HAVE SETUP CODE FOR REGISTER 4B, PRESUMABLY BECAUSE THE
+/      CODE PERFORMS A PANEL  REQUEST  (PRQ3) WHICH SETS UP THE EQUIVALENT VALUES FOR
+/      ASYNCHRONOUS OPERATION WITH ONE STOP  BIT  AND  NO PARITY.  IT IS NOT KNOWN IF
+/      THE DECMATE III EVEN *HAS* A  REGISTER  4B, BUT PRESUMABLY IT IS AVAILABLE FOR
+/      LOADING THE RIGHT VALUES COMPATIBLE WITH THE DECMATE II, OR ATTEMPTING TO LOAD
+/      IT IS INNOCUOUS. 
+
+       CDF     00              /TALKING TO REGISTER 0A
+       NL0004                  /WANT REGISTER 4A
+       MPSCC                   /SELECT IT
+       TAD     (104-4)         /SETUP FOR ASYNCHRONOUS, ONE STOP BIT, NO PARITY
+       MPSCC                   /LOAD IT
+       CDF     10              /TALKING TO REGISTER 0B
+       NL0004                  /WANT REGISTER 4B
+       MPSCC                   /SELECT IT
+       TAD     (104-4)         /SETUP FOR ASYNCHRONOUS, ONE STOP BIT, NO PARITY
+       MPSCC                   /LOAD IT
+\f/     THE  DOCUMENTED VALUES  (FOR DECMATE II) REGARDING CONTROL REGISTER 1 INDICATE
+/      THE PROPER VALUE OF 022, WHERE BIT[9] IS DEFINED AS A ZERO.   THE VALUE OF 026
+/      IS  TAKEN  FROM  K278  WHERE  PRESUMABLY  THE  EXTRA BIT IS NECESSARY FOR SOME
+/      DECMATE III OBSCURITY.
+
+/      THE FOLLOWING CODE IS  REDUNDANT  FOR  LOADING  REGISTER  0A  BEFORE AND AFTER
+/      LOADING REGISTER 0B.  THIS  IS  EITHER A MISTAKE OR OBSCURELY NECESSARY (TAKEN
+/      FROM K278).
+
+       CDF     00              /TALKING TO REGISTER 0A
+       NL0001                  /WANT REGISTER 1A
+       MPSCC                   /SELECT IT
+       TAD     (026-1)         /GET SETUP VALUE
+       MPSCC                   /LOAD IT
+       CDF     10              /TALKING TO REGISTER 0B
+       NL0001                  /WANT REGISTER 1B
+       MPSCC                   /SELECT IT
+       TAD     (026-1)         /GET SETUP VALUE
+       MPSCC                   /LOAD IT
+       CDF     00              /TALKING TO REGISTER 0A
+       NL0001                  /WANT REGISTER 1A
+       MPSCC                   /SELECT IT
+       TAD     (026-1)         /GET SETUP VALUE
+       MPSCC                   /LOAD IT
+
+/      THE DECMATE III INTERNAL MODEM IS PROBABLY ASYNCHRONOUS 8 BIT  ONLY.  ASSUMING
+/      THE RECEIVE SIDE OF THE INTERNAL MODEM IS ALWAYS "ENABLED", REGISTER  3A WOULD
+/      BE  UNNECESSARY.  THE K278 CODE DOES NOT ADDRESS REGISTER 3 AS  AN  A/B  PAIR,
+/      PRESUMABLY  BECAUSE  REGISTER  3 IS NOT DECODED AND IS EFFECTIVELY REGISTER 3B
+/      REGARDLESS OF  THE  DATA FIELD.  THIS IS EITHER TRUE, OR THE K278 CODING FAILS
+/      TO PROPERLY INITIALIZE THE DECMATE III MPSCC PORT.
+
+       NL0003                  /WANT REGISTER 3
+       MPSCC                   /SELECT IT
+       TAD     (301-3)         /SETUP FOR 8 BITS AND ENABLE RECIVER
+       MPSCC                   /LOAD IT
+
+/      A SIMILAR  SITUATION  EXISTS  FOR  THE  TRANSMITTER  SIDE  OF  THE DECMATE III
+/      INTERNAL MODEM.  REGISTER 5 IS UTILIZED ACCORDINGLY.
+
+       TAD     (5-301)         /WANT REGISTER 5
+       MPSCC                   /SELECT IT
+       TAD     (150-5)         /GET TRANSMITTER ENABLE, 8 BITS VALUE
+       MPSCC                   /LOAD IT
+
+/      THE DECMATE II REFERENCE  MANUAL  INDICATES  THE  PROPER SETTING FOR THE MODEM
+/      CONTROL REGISTER AS EITHER 030  OR  130  DEPENDING ON WHETHER BIT[5] INDICATES
+/      INTERNAL OR EXTERNAL TIMING (WHERE ONE  OF  THESE  IS ILLEGAL FOR ASYNCHRONOUS
+/      OPERATION!).  THE SETTING OF BITS [10]  AND  [11]  WOULD  INDICATE ENABLING OF
+/      BOTH  LOCAL  AND  REMOTE LOOPBACKS, YET WE SET  ONLY  THESE  BITS  (ALA  K278)
+/      ALLEDGEDLY FOR THE PURPOSE OF SETTING RTS AND DTR  (WHICH  ARE  DOCUMENTED  AS
+/      BEING BITS[7] AND [8] RESPECTIVELY).
+
+       NL0003                  /SET VALUE
+       MLC                     /LOAD IT
+\f      CLA                     /CLEAN UP
+
+/      THE BAUD RATE SHOULD BE SET HERE IF DESIRED.
+
+/      TAD     BAUD            /GET BAUD RATE
+/      MSB                     /LOAD IT
+       CLA                     /CLEAN UP
+       JMP I   DMIPORT         /RETURN
+\f/     DECMATE II, ETC. REPLACEMENT LIST.                              /048 CJL
+
+DM2LIST,CLDMZAP                                /        *CLDMZAP
+
+               DMINIT&177+JMSC         /CLDMZAP,JMS     DMINIT
+
+       SETBAUD                         /        *SETBAUD               /050 CJL
+
+               MSB                     /SETBAUD,MSB                    /050 CJL
+
+       INLUP                           /        *INLUP
+
+               TAD     INFLAG          /INLUP,  TAD     INFLAG
+
+       INSKIP                          /        *INSKIP
+
+               NOTYET&177+JMPC         /INSKIP, JMP     NOTYET
+       INLUP1; DCA     INFLAG          /INLUP1, DCA     INFLAG
+       INREAD; IRB                     /INREAD, IRB
+
+       INSTATUS                        /        *INSTATUS
+
+               UPSTATUS&177+JMSC       /INSTATU,JMS     UPSTATUS
+
+       GETFL1                          /        *GETFL1
+
+               UPSTATUS&177+JMSC       /GETFL1, JMS     UPSTATUS
+
+       COMWAIT                         /        *COMWAIT
+
+               GETFLOW&177+JMSC        /COMWAIT,JMS     GETFLOW
+
+       NOWAIT                          /        *NOWAIT
+
+               TAD     OUTFLAG         /NOWAIT, TAD     OUTFLAG
+       CMOUT1; SNA CLA                 /CMOUT1, SNA CLA
+       CMOUT2; OWAIT&177+JMPC          /CMOUT2, JMP     OWAIT
+       DM1AND; DCA     OUTFLAG         /DM1AND, DCA     OUTFLAG
+       CMOUT3; OUTEMP&177+TADC         /CMOUT3, TAD     OUTEMP
+       CMOUT4; OLS                     /CMOUT4, OLS
+
+       BUFCHECK                        /        *BUFCHECK
+
+               PUPSTATUS&177+JMSIC     /BUFCHEC,JMS I   PUPSTATUS
+
+       KERRLUP                         /        *KERRLUP
+
+               PUPSTATUS&177+JMSIC     /KERRLUP,JMS I   PUPSTATUS
+\f      RINTEST                         /        *RINTEST
+
+               TAD     INFLAG          /RINTEST,TAD     INFLAG
+       RINGT0; SNA CLA                 /RINGT0, SNA CLA
+       RINREAD;RINGNONE&177+JMPC       /RINREAD,JMP     RINGNONE
+       RINGT1; DCA     INFLAG          /RINGT1, DCA     INFLAG
+       RINGT2; IRB                     /RINGT2, IRB
+
+       REMTSF                          /        *REMTSF
+
+               RMPTEMP&177+DCAC        /REMTSF, DCA     RMPTEMP
+       RMPUT0; TAD     OUTFLAG         /RMPUT0, TAD     OUTFLAG
+       REMTLS; SNA CLA                 /REMTLS, SNA CLA
+       RMPUT1; REMPUT&177+JMPIC        /RMPUT1, JMP I   REMPUT
+       REMCLEA;RMPTEMP&177+TADC        /REMCLEA,TAD     RMPTEMP
+       RMPUT2; OLS                     /RMPUT2, OLS
+
+       0                               /THIS ENDS THE LIST
+
+       PAGE
+\f/     DECMATE I REPLACEMENT LIST.                                     /050 CJL
+
+DM1LIST,CLDMZAP                                /        *CLDMZAP
+
+               DMINIT&177+JMSC         /CLDMZAP,JMS     DMINIT
+
+       SETBAUD                         /        *SETBAUD
+
+               NOP                     /SETBAUD,NOP
+
+       DMI01                           /        *DMI01
+
+               DM234&177+TADC          /DMI01,  TAD     DM234/(234)
+       DMI02;  WCON0                   /DMI02,  WCON0
+       DMI03;  NL0000                  /DMI03,  NL0000
+       DMI04;  RACD                    /DMI04,  RACD
+       DMI05;  DMWASTE&177+ISZC        /DMI05,  ISZ     DMWASTE
+       DMI06;  DMI05&177+JMPC          /DMI06,  JMP     DMI05
+       DMI07;  DMWASTE&177+ISZC        /DMI07,  ISZ     DMWASTE
+       DMI08;  DMI07&177+JMPC          /DMI08,  JMP     DMI07
+       DMI09;  RTFL0                   /DMI09,  RTFL0
+       DMI10;  DM2516&177+TADC         /DMI10,  TAD     DM2516/(2516)
+       DMI11;  DMSEND&177+JMSC         /DMI11,  JMS     DMSEND
+       DMI12;  TAD     RATE            /DMI12,  TAD     RATE
+       DMI13;  DM2460&177+TADC         /DMI13,  TAD     DM2460/(2460)
+       DMI14;  DMSEND&177+JMSC         /DMI14,  JMS     DMSEND
+       DMI15;  DM3425&177+TADC         /DMI15,  TAD     DM3425/(3425)
+       DMI16;  DMSEND&177+JMSC         /DMI16,  JMS     DMSEND
+       DMI17;  RKRB0                   /DMI17,  RKRB0
+
+       DMISET                          /        *DMISET
+
+               RTFL0                   /DMISET, RTFL0
+
+       DMISKP                          /        *DMISKP
+
+               RTSF0                   /DMISKP, RTSF0
+\f      DMIOUT                          /        *DMIOUT
+
+               RTLS0                   /DMIOUT, RTLS0
+
+       INSKIP                          /        *INSKIP
+
+               RKSF0                   /INSKIP, RKSF0
+
+       INREAD                          /        *INREAD
+
+               RKRB0                   /INREAD, RKRB0
+
+       COMWAIT                         /        *COMWAIT
+
+               GETFLOW&177+JMSC        /COMWAIT,JMS     GETFLOW
+
+       NOWAIT                          /        *NOWAIT
+
+               RTSF0                   /NOWAIT, RTSF0
+       CMOUT1; OWAIT&177+JMPC          /CMOUT1, JMP     OWAIT
+
+       DM1AND                          /        *DM1AND
+
+               AND377                  /DM1AND, AND     [377]
+
+       CMOUT4                          /        *CMOUT4
+
+               RTLS0                   /CMOUT4, RTLS0
+
+       RINTEST                         /        *RINTEST
+
+               RKSF0                   /RINTEST,RKSF0
+
+       RINREAD                         /        *RINREAD
+
+               RKRB0                   /RINREAD,RKRB0
+       RINGT1; SKP                     /RINGT1, SKP
+
+       DM1AN2                          /        *DM1AN2
+
+               AND377                  /DM1AN2, AND     [377]
+
+       REMTSF                          /        *REMTSF
+
+               RTSF0                   /REMTSF, RTSF0
+
+       REMTLS                          /        *REMTLS
+
+               RTLS0                   /REMTLS, RTLS0
+
+       0                               /THIS ENDS THE LIST
+\f/     DECMATE I SECONDARY REPLACEMENT LIST                            /050 CJL
+
+DM1SEC,        DMI02                           /        *DMI02
+
+               WCON1                   /DMI02,  WCON1
+       DMI03;  NL4000                  /DMI03,  NL4000
+
+       DMI09                           /        *DMI09
+
+               RTFL1                   /DMI09,  RTFL1
+
+       DMI17                           /        *DMI17
+
+               RKRB1                   /DMI17,  RKRB1
+
+       DMISET                          /        *DMISET
+
+               RTFL1                   /DMISET, RTFL1
+
+       DMISKP                          /        *DMISKP
+
+               RTSF1                   /DMISKP, RTSF1
+
+       DMIOUT                          /        *DMIOUT
+
+               RTLS1                   /DMIOUT, RTLS1
+
+       INSKIP                          /        *INSKIP
+
+               RKSF1                   /INSKIP, RKSF1
+
+       INREAD                          /        *INREAD
+
+               RKRB1                   /INREAD, RKRB1
+
+       NOWAIT                          /        *NOWAIT
+
+               RTSF1                   /NOWAIT, RTSF1
+
+       CMOUT4                          /        *CMOUT4
+
+               RTLS1                   /CMOUT4, RTLS1
+
+       RINTEST                         /        *RINTEST
+
+               RKSF1                   /RINTEST,RKSF1
+
+       RINREAD                         /       *RINREAD
+
+               RKRB1                   /RINREAD,RKRB1
+
+       REMTSF                          /        *REMTSF
+
+               RTSF1                   /REMTSF, RTSF1
+\f      REMTLS                          /        *REMTLS
+
+               RTLS1                   /REMTLS, RTLS1
+
+       0                               /THIS ENDS THE LIST
+\f/     ONCE-ONLY TEXT MESSAGES.                                        /024 CJL
+
+       FIELD   BUFFLD%10               /FILE I/O BUFFER FIELD
+
+       *FILBUFFER                      /OVER FILE I/O BUFFER
+
+/      LOCAL PREFERENCE MESSAGE.                                       /024 CJL
+
+/      USE SOMETHING APPROPRIATE HERE TO CUSTOMIZE KERMIT-12 TO YOUR MACHINE.
+
+/      THIS LOCATION SHOULD BE MAINTAINED SINCE IT IS DOCUMENTED TO BE HERE.
+
+       XLIST   OFF
+       IFZERO  GENMSG                  <
+       XLIST   ON
+LCLMSG,        *LCLMSG+40                      /EMPTY HOLE FOR USER MESSAGE    /039 CJL
+
+       XLIST   OFF                     >
+       IFNZRO  GENMSG                  <
+       IFNZRO  LEDERLE         <
+       XLIST   ON
+LCLMSG,        TEXT    "%^T^HANKS TO: ^B^ILL ^S^MITH AND ^D^INGER ^M^ILLER%"
+
+       XLIST   OFF             >
+       IFNZRO  UMSG            <
+       XLIST   ON
+LCLMSG,        TEXT    "%^I^NSERT LOCAL USER MESSAGE HERE!%^"
+
+       XLIST   OFF             >
+       IFZERO  LEDERLE!UMSG    <
+       XLIST   ON
+LCLMSG,        TEXT    "^^^^^^^^^^^^^^^^^^^^^^"/DEFAULT IS NO MESSAGE
+
+       XLIST   OFF             >
+       IFNZRO  LCLMSG+40-.     <
+       XLIST   ON
+       ZBLOCK  LCLMSG+40-.             /LEAVE PATCHING SPACE
+
+       XLIST   OFF             >
+                                       >
+       XLIST   ON
+CLOSMSG,TEXT   "^]^"                   /CPU TYPE CLOSING MESSAGE
+\f/     CPU IDENTIFICATION LIST; ALL MUST BE 5 WORDS LONG (EXCEPT LAST)./024 CJL
+
+CPULIST,TEXT   "^U^NKNOWN"             /00=UNKNOWN
+       TEXT    "^PDP^-5^^"             /01=PDP-5
+       TEXT    "^PDP^-8^^"             /02=PDP-8
+       TEXT    "^PDP^-8/S"             /03=PDP-8/S
+       TEXT    "^LINC^-8^"             /04=LINC-8
+       TEXT    "^PDP^-8/I"             /05=PDP-8/I
+       TEXT    "^PDP^-8/L"             /06=PDP-8/L
+       TEXT    "^PDP^-12^"             /07=PDP-12
+       TEXT    "^PDP^-8/E"             /10=PDP-8/E
+       TEXT    "^PDP^-8/A"             /11=PDP-8/A
+\f      TEXT    "6100^^^^^"                     /12=6100
+       TEXT    "6120^"                         /13=6120; LAST CAN BE SHORT!
+CPUTMSG,TEXT   "%^[C^PU TYPE IS: "             /CPU TYPE MESSAGE
+DAYMSG,        DAY%12^66+DAY+6060                      /DAY MESSAGE
+       TEXT    " "
+DMPOMSG,TEXT   " ^[U^SING ^C^OMMUNICATIONS"    /DECMATE PORT MESSAGE
+       TEXT    " ^P^ORT^]"
+DMPPMSG,TEXT   " ^[U^SING ^P^RINTER ^P^ORT^]^" /DECMATE SERIAL PORT MESSAGE
+\fINITMSG,TEXT  "%^PS/8 PS/12 OS/8 OS/12 "      /INITIAL MESSAGE
+       TEXT    "OS/78 OS/278  K^ERMIT-12  ^V"
+INMSG2,        VERSION%12^66+VERSION+6060              /VERSION DIGITS
+INMSG3,        "^^100+REVISION                         /REVISION
+       TEXT    "   "                           /END OF MESSAGE
+       XLIST   OFF
+       IFZERO  MONTH-1         <
+       XLIST   ON
+MONMSG,        TEXT    "^J^ANUARY ^"                   /MONTH MESSAGE
+       XLIST   OFF             >
+       IFZERO  MONTH-2         <
+       XLIST   ON
+MONMSG,        TEXT    "^F^EBRUARY "                   /MONTH MESSAGE
+       XLIST   OFF             >
+       IFZERO  MONTH-3         <
+       XLIST   ON
+MONMSG,        TEXT    "^M^ARCH ^"                     /MONTH MESSAGE
+       XLIST   OFF             >
+       IFZERO  MONTH-4         <
+       XLIST   ON
+MONMSG,        TEXT    "^A^PRIL ^"                     /MONTH MESSAGE
+       XLIST   OFF             >
+       IFZERO  MONTH-5         <
+       XLIST   ON
+MONMSG,        TEXT    "^M^AY ^"                       /MONTH MESSAGE
+       XLIST   OFF             >
+       IFZERO  MONTH-6         <
+       XLIST   ON
+MONMSG,        TEXT    "^J^UNE "                       /MONTH MESSAGE
+       XLIST   OFF             >
+       IFZERO  MONTH-7         <
+       XLIST   ON
+MONMSG,        TEXT    "^J^ULY "                       /MONTH MESSAGE
+       XLIST   OFF             >
+       IFZERO  MONTH-10        <
+       XLIST   ON
+MONMSG,        TEXT    "^A^UGUST "                     /MONTH MESSAGE
+       XLIST   OFF             >
+       IFZERO  MONTH-11        <
+       XLIST   ON
+MONMSG,        TEXT    "^S^EPTEMBER ^"                 /MONTH MESSAGE
+       XLIST   OFF             >
+       IFZERO  MONTH-12        <
+       XLIST   ON
+MONMSG,        TEXT    "^O^CTOBER ^"                   /MONTH MESSAGE
+       XLIST   OFF             >
+       IFZERO  MONTH-13        <
+       XLIST   ON
+MONMSG,        TEXT    "^N^OVEMBER "                   /MONTH MESSAGE
+       XLIST   OFF             >
+       IFZERO  MONTH-14        <
+       XLIST   ON
+MONMSG,        TEXT    "^D^ECEMBER "                   /MONTH MESSAGE
+       XLIST   OFF             >
+       IFNZRO  MONMSG+7-.      <
+       XLIST   ON
+
+       ZBLOCK  MONMSG+7-.                      /EMPTY SPACE FOR ALIGNMENT
+
+       XLIST   OFF             >
+       XLIST   ON
+\fTHLPMSG,TEXT  "%^T^YPE ^HELP<CR>^ FOR HELP%^" /TYPE HELP MESSAGE
+YEARMSG,TEXT   "19"                            /YEAR MESSAGE
+       YEAR%12^66+YEAR+6060                    /YEAR DIGITS
+       TEXT    "^"                             /END OF MESSAGE
+\f/     CPU-SPECIFIC PROMPT LIST.                                       /024 CJL
+
+CPUPRMP,TEXT   "??^>^^^"       /UNKNOWN
+       TEXT    "5^>^^^^"       /PDP-5
+       TEXT    "8^>^^^^"       /PDP-8
+       TEXT    "8^/S>^^"       /PDP-8/S
+       TEXT    "LINC-8>"       /LINC-8
+       TEXT    "8^/I>^^"       /PDP-8/I
+       TEXT    "8^/L>^^"       /PDP-8/L
+       TEXT    "12^>^^^"       /PDP-12
+       TEXT    "8^/E>^^"       /PDP-8/E
+       TEXT    "8^/A>^^"       /PDP-8/A
+       TEXT    "78^>^^^"       /6100
+       TEXT    "278^>^^"       /6120
+\f/     CPU-SPECIFIC IDENTIFICATION LIST.                               /025 CJL
+
+CPUIDLS,TEXT   "^U^NKNOWN"     /UNKNOWN
+       TEXT    "^PDP^-5^^"     /PDP-5
+       TEXT    "^PDP^-8^^"     /PDP-8
+       TEXT    "^PDP^-8/S"     /PDP-8/S
+       TEXT    "^LINC^-8^"     /LINC-8
+       TEXT    "^PDP^-8/I"     /PDP-8/I
+       TEXT    "^PDP^-8/L"     /PDP-8/L
+       TEXT    "^PDP^-12^"     /PDP-12
+       TEXT    "^PDP^-8/E"     /PDP-8/E
+       TEXT    "^PDP^-8/A"     /PDP-8/A
+\f      TEXT    "^VT^-78^^"     /VT-78
+       TEXT    "^DEC^MATE"     /6120
+\f      FIELD   MSGFLD%10                       /MESSAGE FIELD
+
+       *FLD1ADR                                /PERMANENT LOAD ADDRESS /046 CJL
+                                               /TEXT MESSAGES LOAD HERE/046 CJL
+
+ABMSG, TEXT    "%^F^ILE ^A^BORT%^"             /FILE ABORT MESSAGE
+CMERMSG,TEXT   "?^I^NVALID COMMAND^"           /COMMAND ERROR MESSAGE
+CONNMSG,TEXT   "%(^C^ONNECTING TO HOST, TYPE " /FIRST CONNECT MESSAGE
+CONTMSG,TEXT   "^C^ONTROL-^"                   /CONTROL CHARACTER MESSAGE
+\fCON2MSG,TEXT  " ^C^ TO RETURN TO ^"           /BRIDGING CONNECT MESSAGE
+CON3MSG,TEXT   ")%^"                           /FINAL CONNECT MESSAGE
+CPUMSG,        ZBLOCK  5                               /CPU ID MESSAGE GOES HERE
+/CRLF, TEXT    "%"                             /<CR>, <LF> MESSAGE
+DNERMSG,TEXT   "?^E^RROR IN DEVICE NAME"       /DEVICE NAME ERROR MESSAGE
+DSFLMSG,TEXT   "?^D^ISK FULL!"                 /DISK OUT OF ROOM ERROR MESSAGE
+FCLEMSG,TEXT   "?^E^RROR CLOSING FILE"         /FILE CLOSE ERROR MESSAGE
+\fFNERMSG,      TEXT    "?^E^RROR IN FILE NAME" /FILE NAME ERROR MESSAGE
+FRECMSG,TEXT   "^R^EC: ^"                      /RECEIVING FILE MESSAGE
+FSENMSG,TEXT   "^S^END: ^"             /SENDING FILE MESSAGE
+FSERMSG,TEXT   "?^F^ILE NAME SYNTAX ERROR"     /FILE NAME ERROR MESSAGE
+\fHELPMSG,TEXT  "%^S^UPPORTED COMMANDS ARE:%%"  /HELP MESSAGE
+       TEXT    "^CONNECT^ (TO REMOTE SYSTEM) %"
+       TEXT    "^SEND DEV:FILNAM.EX^ %"
+\f      TEXT    "^RECEIVE DEV:^ (FILENAME AND EXTENSION ^NOT^ ALLOWED)%"
+       TEXT    "^GET DEV:FILNAM.EX^%"
+       TEXT    "^FINISH^ (SERVER)%"
+\f      TEXT    "^EXIT^ (TO OPERATING SYSTEM) %"
+       TEXT    "^HELP^ (THIS MESSAGE)%"
+       TEXT    "%^E^SCAPE CHARACTER: "
+KERRMSG,TEXT   "%^K^EYBOARD INPUT ERROR!%"     /KEYBOARD ERROR MESSAGE
+
+       CRLF=   .-1                             /<CR>, <LF> MESSAGE
+\fNOFINIS,TEXT  "?^U^NABLE TO TELL HOST THAT "  /FINISH ERROR MESSAGE
+       TEXT    "SESSION IS FINISHED"
+NOTFND,        TEXT    "?^U^NABLE TO LOCATE FILE^"     /FILE NOT FOUND MESSAGE
+PRMTMSG,TEXT   "^K^ERMIT-^"                    /STATIC PORTION OF PROMPT MESSAGE
+PROMID,        ZBLOCK  23                              /MODIFIED PORTION OF PROMPT MESSAGE
+PRMT2, TEXT    "^K12>"                         /PHPH
+RERRMSG,TEXT   "?^R^ECEIVE FAILURE^"           /GENERAL RECEIVE FAILURE MESSAGE
+\fRFLNMSG,TEXT  "?^E^RROR IN RECEIVED FILE NAME"/RECEIVED NAME ERROR MESSAGE
+       TEXT    "^"
+RHFEMSG,TEXT   "^U^NABLE TO RECEIVE - HANDLER" /HANDLER FETCH ERROR MESSAGE
+       TEXT    " ERROR^"
+\fRIDEMSG,TEXT  "?^U^NABLE TO RECEIVE -"        /DIRECTORY FULL ERROR MESSAGE
+       TEXT    " INSUFFICIENT DIRECTORY SPACE"
+RIERMSG,TEXT   "%^R^EMOTE LINE INPUT ERROR!%^" /REMOTE LINE ERROR MESSAGE
+\fRPERMSG,TEXT  "?^U^NABLE TO RECEIVE LATEST "  /LATEST PACKET ERROR MESSAGE
+       TEXT    "PACKET^"
+SDERMSG,TEXT   "?^U^NABLE TO SEND - DIRECTORY "/DIRECTORY INPUT ERROR MESSAGE
+       TEXT    "ERROR"
+SHFEMSG,TEXT   "?^U^NABLE TO SEND - HANDLER "  /HANDLER FETCH ERROR MESSAGE
+       TEXT    "ERROR"
+\fSNDEMSG,TEXT  "?^U^NABLE TO SEND"             /GENERAL SEND ERROR MESSAGE
+UPERMSG,TEXT   "?^U^NABLE TO RECEIVE - DATA "  /RECEIVED DATA ERROR MESSAGE
+       TEXT    "ERROR"
+
+       $                                       /THAT'S ALL FOLK!