PDP-10.its/src/sysen2/mactap.f72

RELOCATABLE
TITLE MACTAPE

.LIBRARY UWR",URED",.UWR",.URED",FILEST"

LIPDL=20	;LENGTH OF PI PDL IF USED

A=TAPAC"
B=A+1
C=A+2
D=A+3

ACSIZ=4

SYSEOF==3	;IF "THIRD BIT" OF FILE IS 1
OSYSEF==141	;IF "THIRD BIT" OF FILE IS 0

DEFINE COND A,B
.LIFS A
B
.ELDC
LOC $.
TERMIN

DEFINE ELSE A,B,C
COND A,[B]
COND -A,[C]
TERMIN

DEFINE AVAIL A
.LIFS .!A
.!A":
.ELDC
A:
TERMIN

DEFINE ELSER A,B,C
ELSE A,[C][B]
TERMIN

UWAIT":	SKIPL LSTP
	JRST .-1
UWAIT1:	CLEARM APRBRK
	SKIPN APRBRK
	JRST .-1
	SKIPL COAST
	JRST .-1
	POPJ P",

ELSER APRBRK",[.ZZSW"=0
.ZZLV=JRST 12,@.
.ZZ=.
LOC 40+2*CLKCHN"
	JSR APRBRK
LOC .ZZ
][	.ZZSW=1
.ZZLV"=JRST 2,@.
]
APRBRK":	0
.LIFE .ZZSW
CONSO 1000
ELSE ILMEM",[JRST ILMEM"][JRST 4,.]
CONO 1440+CLKCHN"
.ELDC
LOC $.
	SKIPL SDLY
	SKIPL COAST
APRET1:	.ZZLV

ELSER .IPDL",[	PUSH P,APRSV1
][	EXCH P,PDLP
	PUSHJ P,APRSV
	EXCH P,PDLP
	.ZZLV
]
APRSV:	CLEARM RLOADF
	PUSH P,A
	PUSH P,B
	MOVE B,[(RDATAS)WDATAS]
	SKIPL WRITE
	MOVSS B
	PUSHJ P,UTRLD
	MOVSS B
	PUSHJ P,UTRLD
	SOSN URUNTM
	JRST APRBK5
APRET:	POP P,B
	POP P,A
APRSV1:	POPJ P,APRET1




TAPE:	0
UTP1:	0		
	SOS .-1
	AOSGE TAPCNT
	JRST 12,@TAPE
UTP3:	CONO PI,1000+TPCHNA"
	SKIPN WRITE
	CONO DC,TPCHN"
	JRST 12,@TAPE

PIPOS:	MOVEM A,TAP1
	MOVEM B,TAP2
	CONSZ UTS,16
	JRST UTAPE5
UTAPE:	MOVEI A,20	
	DATAI DC,B
	ELSER .TCHG",HRRZS B,[
	HRRZM B,BLKS
	HLRZS B
	SKIPE TAPID
	CAMN B,TAPID
	JRST UTBLK3
	MOVE B,BLKS
]
AVAIL UTBLK,	SUBI B,.
	JUMPE B,PIPOS2
UTAPE1:	SKIPL FORW
	SOSA B
	AOS B
	MOVEM B,UTENB
	ADDI B,3
	JUMPL B,.+3
	CAIG B,6
	JRST UTAPE4
	AOSE FORW	;FORW_-1 MEANS TAPE FORWARD
	TRO A,2000
	CAILE B,2
	TRCA A,12000
	SETOM FORW
UTAPE3:	CONO UTC,320200+UTCCHN(A)
UTAPE5:	CONO DC,4010+TPCHN
	JRST TAP3

TAPINS:	BLKO DC,	;BLKO DC,ADR-1
TAPCNT:	0	;(,-200)ADR-1
TAP1:	0
TAP2:	0

UTAPE2:	TRO A,3000
UTAPE4:	SKIPL FORW
	TRO A,10000
	JRST UTAPE3


COND .TCHG,[
BLKS:	0
UTBLK3:	JSR .TCHG"
	JRST UTAPE1
]
PIPOS2:	SKIPE UTENB
	JRST UTAPE2
	MOVE B,TAPINS
	SKIPGE WRITE
	TROA A,400
	TLZ B,(BLKO-BLKI)
	SKIPL FORW
	TROA A,10000
	JRST TAPFOR
	ADD B,[DATAI-BLKI 200]
	MOVEM B,UTP1
	HLRES TAPCNT
TAP4:	CONO UTC,360300+UTCCHN(A)
	SKIPGE WRITE
	CONO DC,3410+TPCHN
TAP3:	MOVE A,TAP1
	MOVE B,TAP2
	JRST 12,@TAPEî

TAPFOR:	HRRI B,TAPCNT
	MOVEM B,40+TPCHN*2
	MOVEI B,UTP3
	HRRM B,UTP1
	JRST TAP4

UTERR2:	CONSO PI,TPCHNA
	AOSE LOSSCT
	JRST UTER2A
COND BADBLK",[	HRRZ A,UTBLK
	SKIPE WRITE
	TLO A,400000
	MOVEM A,BADBLK"
]
	JRST GOBBLE

UTER2A:	CONSZ UTS,2
	AOSE FORW
	SETOM FORW
	HRRZ A,UTAPE
	SKIPL FORW
	TRO A,10000
	CONO UTC,323200+UTCCHN(A)
	PUSHJ P,TSTAR1
POPRET:	POP P,A
ELSE UTCBRK",[JRST 2,@UTCBRK][
	JRST 12,@UTCBRK

.ZZ=.
LOC 40+2*UTCCHN"
	JSR UTCBRK"
LOC .ZZ
]



UTCBRK":	0
	PUSH P,A
	CONSZ UTC,4000	;TIME ENABLE
	CONSO UTS,20	;TIME DELAY FLAG
	JRST JDBRK
	SETOM LSTP
	CLEARM SDLY
JDBRK1:	CONO UTC,0
	JRST POPRET
JDBRK:	CONSZ UTC,7
	CONSO UTS,17
	JRST POPRET
	CONSO UTC,700
	JRST JDBRK2
	CONSO PI,TPCHNA
	CONSZ UTS,16
	JRST UTERR2
GOBBLE:	MOVEI A,200
UTCNTR:	ADDM A,A
	MOVEI A,24.
	MOVEM A,URUNTM
	CONI UTC,A
	TRZ A,700
	CONO UTC,(A)
	COND .IPDL,[EXCH P,PDLP
]	PUSHJ P,APRSV
	COND .IPDL",[EXCH P,PDLP
]
	SKIPL RLOADF
	SETOM COAST
	JRST POPRET



TSTART:	ELSE MAXERR",[MOVNI A,MAXERR"][MOVNI A,10.]
	MOVEM A,LOSSCT
TSTAR1:	CLEARM COAST
	MOVSI A,-200
	MOVEM A,UTENB
	HRR A,TAPINS
	MOVEM A,TAPCNT
	MOVE A,40+TPCHN*2+1
	MOVEM A,40+TPCHN*2
	MOVE A,[JRST PIPOS]
	MOVEM A,UTP1
	CONO DC,4010+TPCHN
	CONO PI,2200+TPCHNA
	POPJ P,

JDBRK2:	SETOM SDLY
	CONO UTC,5000+UTCCHN
	SETOM URUNTM
	JRST POPRET

RCHECK:	SKIPL EOF
	JRST RED
	SKIPN RCNTR
	ELSE QUITFF,JRST POPJA,[POPJ P,]

.URED":
RED:	SKIPN RCNTR
	JRST RCHECK
	SOS RCNTR
	AOS A,RPNTR
RED2:	CAIL A,RBEGB+200
	JRST REDRST
RED4:	MOVE A,(A)
	JRST POPJ1

REDRST:	MOVEI A,201
	ADDM A,RED2
	AOS A,RPNTR
	CAIGE A,RBEGB+NURBUF"*201
	JRST RED4
	MOVEI A,RBEGB+200
	HRRM A,RED2
	MOVEI A,RBEGB
	HRRM A,RPNTR
	JRST RED4

	SKIPGE WRFUL
	ELSE QUITFF,JRST POPJA,[POPJ P,]

.UWR":
WR:	SKIPN WCNTR
	JRST .-3
	PUSH P,A
	SOS WCNTR
	AOS A,WPNTR
	CAIL A,WBEGB+NUWBUF"*200
	JRST WRST
WR2:	POP P,(A)
	JRST RED4

WRST:	MOVEI A,WBEGB
	HRRM A,WPNTR
	JRST WR2

	RBEGB-1	;PI INPUT POINTER
	RBEGB-1
EOF:	-1
	CAILE A,NURBUF"*200-200
AVAIL RDATAS,	(,RBEGB-2)RBEGB+<NURBUF-1>*201-1;(LOWEST BUFFER)HIGHEST BUFFER
RPNTR:	0	;POINTER
RCNTR:	NURBUF*200
AVAIL RBYTS,	0	;LH<FILE DIRECTION,LOOK FILE,TAPENO,PUT FILE>
RBYTP:	0	;^^^ RH<BLOCK NUMBER>


	WBEGB-1	;PI OUTPUT POINTER
	WBEGB-1
WRFUL:	-1
	CAILE A,NUWBUF"*200-200
AVAIL WDATAS,	(,WBEGB-1)WBEGB+<NUWBUF-1>*200-1
WPNTR:	0
WCNTR:	NUWBUF*200
AVAIL WBYTS,	(35)0
WBYTP:	(500)MOVTAB-1+27+27
UTRLD:	MOVE A,2(B)
	SKIPL -2(B)
	XCT -1(B)
	POPJ P,
	POP P,(P)
	LDB A,[(270400+B)3]
	LSH A,3
	CAME A,LSTP
	SKIPGE LSTP
	JRST LOAD
APRBK5:	SETOM SDLY
	CONO UTC,5000+UTCCHN
	JRST APRET


ITAB:	AOS D,3(B)
	ILDB A,4(B)
	POPJ P,

ITAB1:	SOS D,3(B)
BYTDEC:	MOVSI A,50000
	ADD A,4(B)
	SKIPGE A
	SUB A,[(430000)1]
	MOVEM A,4(B)
	LDB A,A
	POPJ P,



LOAD:	SETOM WRITE
	MOVEM D,UAC+D
	MOVE D,[(A)UAC+A]
	BLT D,UAC+D-1
	LDB A,[(270400+B)3]	;GET TAPE NO
	PUSH P,FPNTR+2
	PUSHJ P,FILESL
RLOAD:	MOVEI A,ITAB1
	SKIPL C,3(B)
	MOVEI A,ITAB
	HRRM A,LUP1
	ROT C,11
	TRZ C,777740

COND -BLKSPC",[
BLKSPC"=6
]
	MOVEI A,BLKSPC"	;SPACING BETWEEN BLKS
	MOVEM A,TEM1
	TRNN C,37
	JRST LUP1
	CLEARM WRITE
	CLEARM TEM1
LUP1:	PUSHJ P,ITAB
	TRNE D,-1
	CAIN A,37
	JRST OUTT
	CAIE A,(C)
	SOSA TEM1
	SOSLE TEM1
	JRST LUP1

;START UP TAPE ROUTINE
	ROT C,11
	DPB C,4(B)	;SMASH AWAY PUT FILE
	MOVE A,3(B)
	HRRM A,UTBLK
	MOVEI A,2(B)
	HRRM A,UTCNTR
COND .TCHG,[	MOVE A,FPNTR
	HRRZ A,177(A)
	CAIN A,-1
	MOVEI A,0
	MOVEM A,TAPID
]
	ROT C,-2
	ANDI C,70
	HRRM C,UTAPE
	CAME C,LSTP
	PUSHJ P,LOADST
OUT4:	SETOM RLOADF
	MOVE A,-4(B)
	HRRM A,TAPINS
	MOVE D,(B)
	ADDI A,200
	CAILE A,(D)
	HLRZ A,D
	SKIPN WRITE
	AOS A
	MOVEM A,-4(B)
	CONI UTC,C
	TRZE C,700
	JRST .+3
	IORI C,200
	CONO UTC,(C)
	PUSHJ P,TSTART
OUT3:	POP P,A
	PUSHJ P,FILESL
	MOVS D,[(A)UAC+A]
	BLT D,D
	JRST APRET

LOADST:	MOVEM C,LSTP
	SETOM FORW
	SKIPL 3(B)
	AOSA FORW
	SUBI C,10000
	CONO UTC,333200+UTCCHN(C)
	POPJ P,
OUTT:	SKIPN A,WRITE
	JRST LDRED
	PUSHJ P,FILER
	SKIPGE WRFUL
	JRST OUT3
OUT2:	MOVE B,UAC+B
	MOVSI A,400000
	XORM A,3(B)
	JRST RLOAD

LDRED:	HRRZ B,C
	PUSHJ P,LOOK
	JRST LDRD2	;NO FILE EXTENSION
	DPB C,[(220500)RBYTS]
	DPB C,[(330500)RBYTS]
	JRST OUT2

LDRD2:	SETOM EOF
	JRST OUT3

SETUPR:	MOVE A,-3(B)
	MOVEM A,1(B)
	MOVEM A,-4(B)
	MOVSI A,400000
	ANDCAM A,3(B)
	HLLZS 3(B)
	MOVE A,FPNTR+1
	MOVEM A,4(B)
	POPJ P,

AVAIL LOOK,	MOVSI C,-23.
	SKIPA D,FPNTR
	ADDI D,2
	CAME A,(D)
	CAMN A,[SIXBIT /*/]
	JRST .+2
	AOBJN C,LOOK+2
	JUMPGE C,LOOK1
	CAME B,1(D)
	CAMN B,[SIXBIT /*/]
	JRST .+2
	AOBJN C,LOOK+2
LOOK1:	TLZN C,-1
	POPJ P,	;NOT FOUND
	AOS C
POPJ1A:	ELSE QUITFF",[
	AOS (P)
	POPJ P,
][	JRST POPJ1]



OPNRD":	PUSHJ P,SAVAC
	SETOM EOF
	PUSHJ P,UWAIT
	PUSHJ P,LOOK
	JRST ERR2
	MOVE B,FPNTR+2
	LSH B,5
	HRLZM B,RBYTS
	DPB C,[(220500)RBYTS]
	DPB C,[(330500)RBYTS]
	ADD C,FPNTR
	MOVE C,133(C)
	MOVEI B,SYSEOF
	TRNN C,1
	MOVEI B,OSYSEF
	MOVEM B,CEOF
	MOVEM B,CEOFA
	CLEARM RCNTR
	MOVEI B,RDATAS
	PUSHJ P,SETUPR
	MOVE A,[70700,,CEOF]
	MOVEM A,UREDP
	MOVEI A,RBEGB+200
	HRRM A,RED2
	HRLZ A,CEOF
	LSH A,11.
	MOVEI B,NURBUF
	HLLZM A,RBEGB+200(A)
	ADDI A,201
	SOJG B,.-2
	CLEARM EOF
	JRST RESTOR

SAVAC0:	SOS -1(P)
SAVAC:	MOVEM D,ACBLK+D
	MOVE D,[(A)ACBLK+A]
	BLT D,ACBLK+D-1
	COND QUITFF,SETOM INSIDE
	POPJ P,

ERR2:	CLEARM ACBLK+A
ERR1:	SOS (P)
RESTOR:	COND QUITFF,CLEARM INSIDE
	MOVS D,[(A)ACBLK+A]
	BLT D,D
POPJ1:	AOS (P)
COND QUITFF",[
POPJA:	SKIPN INSIDE
	SKIPE QUITFF"]
CPOPJ:	POPJ P,
	COND QUITFF",[
	JSR QUITFF
	POPJ P,]

COND .FILEB",[
.BC2:	100,,55(A)
.BC1:	100,,104(A)
.FILEB":
]

FILE":	PUSHJ P,SAVAC
	LDB A,[(270400)WBYTS]
	PUSH P,FPNTR+2
	PUSHJ P,FILESL
	MOVE A,ACBLK+A
	PUSH P,B
	PUSH P,A
	PUSHJ P,DELE

FILE1:	MOVEI A,SYSEOF
	MOVEI B,4
	PUSHJ P,UWR
	JFCL
	SOJG B,.-2
	MOVE A,[SYSEOF_11.,,1]
FILE1B:	LDB B,[700,,WCNTR]
	JUMPE B,FILE3
	PUSHJ P,WR
	JRST FILE7
	JRST FILE1B
FILE3:	MOVEI B,NUWBUF*200
	CAME B,WCNTR
	JRST .-1

FILE4:	PUSHJ P,FILER
	CLEARM A
	MOVEI B,105
	PUSHJ P,LOOK
	JRST ERR2	;HOPEFULLY IMPOSSIBLE
	POP P,(D)
	POP P,1(D)
	PUSHJ P,FILE6
	PUSHJ P,CLSTP
FILE5:	POP P,A
	PUSHJ P,FILESL
	JRST RESTOR

FILE7:	SOS -3(P)
	JRST FILE4
OPNWR":	PUSHJ P,SAVAC
	CLEARB A,B
	PUSHJ P,LOOK
	JRST ERR2
	MOVEI B,105
	PUSHJ P,DELE
	MOVEI C,0
	PUSHJ P,WINIT1
	PUSHJ P,FILE6
	JRST RESTOR


FILE6:	MOVEI A,200*NUWBUF
	MOVEM A,WCNTR
	MOVEI B,WDATAS
	PUSHJ P,SETUPR
	MOVE A,[(10700)WRASM-1]
	MOVEM A,UWRP
	MOVEI A,5
	MOVEM A,WRASM+1
	MOVE A,FPNTR+2
	DPB A,[(270400)WBYTS]
	MOVEI A,105
	MOVEM A,LSTFIL
	CLEARM WRASM
	CLEARM WRFUL
	POPJ P,

FILER:	CLEARB A,B
	PUSHJ P,LOOK
	JRST TPFUL
	MOVE A,C
	EXCH A,LSTFIL
	MOVEM A,1(D)
	MOVE A,FPNTR
	ADD A,C
	ELSE .FILEB",[
	MOVE B,ACBLK+C
	DPB B,.BC1
	LSH B,-1
	DPB B,.BC2
][
	MOVEI B,1
	ANDCAM B,55(A)
	ANDCAM B,104(A)
]

	MOVEI B,1
	IORM B,133(A)	;SET NEW TYPE EOF BIT
WINIT1:	MOVE B,FPNTR+1
	ILDB A,B
	CAIN A,35
	DPB C,B
	CAIE A,37
	JRST .-4
	POPJ P,

TPFUL:	SETOM WRFUL
	POPJ P,
UCLSTP":	PUSHJ P,SAVAC0
	PUSH P,CRESTOR

CLSTP:	MOVE A,FPNTR+2
	MOVNI B,1
OPNTP1:	MOVEI C,100
AVAIL .WSB,	LSH A,3
	PUSHJ P,UWAIT1
	MOVEM B,WRITE
	CAMN A,LSTP
	JRST .+3
	PUSHJ P,UWAIT
	SETOM FORW
	HRRM A,UTAPE
	MOVEM A,LSTP
	HRR B,FPNTR
	SOS B
	HRRM B,TAPINS
	MOVEI B,TEM1
	HRRM B,UTCNTR
	HRRM C,UTBLK
	SKIPL FORW
	TRO A,10000
	COND .TCHG,[SKIPN WRITE
	CLEARM TAPID
]
	CONO UTC,322200+UTCCHN(A)
	PUSHJ P,TSTART
	MOVEI A,120000.
	MOVSI B,-200
	SKIPL WRITE
OPNTP3:	SKIPGE COAST
	POPJ P,
	CAMN B,UTENB
	SOJGE A,OPNTP3
	JUMPGE A,OPNTP3
	SETOM SDLY
	CONO UTC,5000+UTCCHN
	SETOM COAST
	MOVE A,FPNTR+2
	PUSHJ P,FILESL
	CLEARM DIRTAB(C)
	MOVNI A,2
	POPJ P,


TAPKIL":	PUSHJ P,SAVAC0
	PUSH P,FPNTR+2
	ANDI A,7
	PUSHJ P,FILESL
	JUMPL C,.+2
	CLEARM DIRTAB(C)
	POP P,A
	PUSHJ P,FILESL
CRESTOR:	JRST RESTOR
FILEST":	JRST RBEGB	;OR ANDI A,7
	PUSHJ P,SAVAC
	PUSHJ P,FILESL
	JUMPGE C,RESTOR
	CLEARB A,B
	PUSHJ P,FILESL
	JUMPL C,ERR2
	MOVE A,ACBLK+A
	MOVEM A,DIRTAB(C)
	MOVEM A,FPNTR+2
	PUSHJ P,OPNTP1
	JUMPL A,ERR4
	MOVE C,FPNTR
	LDB C,[370500+C,,177]
	CAIN C,37
	JRST RESTOR
ERR3:	MOVNI A,1
ERR4:	MOVEM A,ACBLK+A
	JRST ERR1

DELE:	PUSHJ P,LOOK
	POPJ P,
DELE2:	CLEARM 1(D)
	CLEARB D,(D)
	MOVE B,FPNTR+1
	ILDB A,B
	CAMN A,C
	DPB D,B
	CAIE A,37
	JRST .-4
	CLEARM A
	MOVE B,C
	JRST DELE

FILESL:	MOVSI C,-NDIR
	CAME A,DIRTAB(C)
	AOBJN C,.-1
	TLON C,-1
	POPJ P,
	HRRZS D,C
	IMULI D,200
	ADDI D,MOVTAB
	MOVEM D,FPNTR
	ADDI D,23.*2-1
	HRRM D,FPNTR+1
	MOVEM A,FPNTR+2
	POPJ P,

UDELE":	PUSHJ P,SAVAC0
	PUSHJ P,DELE
	JRST RESTOR
URED1:	SKIPN RCNTR
	JRST UREDE
URED":	ILDB A,UREDP
	CAME A,CEOF
	JRST POPJ1
UREDT":	HRRZ A,UREDP
	CAIN A,CEOF
	JRST URED2
	SUBI A,201
	CAME A,RPNTR
	JRST UREDE
	ADDI A,202
	CAIL A,RENDB
	MOVEI A,RBEGB
	HRLI A,440700
	MOVEM A,UREDP
	SOS A
	HRRM A,RPNTR
	MOVNI A,200
	ADDM A,RCNTR

URED3:	SKIPGE EOF
	JRST URED1
	SKIPN RCNTR
	JRST .-3
	JRST URED

UREDE:	MOVE A,[70700,,CEOFA]
	MOVEM A,UREDP
	MOVEI A,14
	ELSE QUITFF,JRST POPJA,[POPJ P,]

URED2:	MOVE A,[440700,,RBEGB]
	MOVEM A,UREDP
	JRST URED3

UWR":	IDPB A,UWRP
	SOSLE WRASM+1
	JRST POPJ1
	MOVEM A,ACBLK+A
	MOVEI A,5
	MOVEM A,WRASM+1
	MOVE A,[(10700)WRASM-1]
	MOVEM A,UWRP
	MOVE A,WRASM
	PUSHJ P,WR
	ELSE QUITFF",[JRST POPJA][POPJ P,]
	CLEARM WRASM
	MOVE A,ACBLK+A
	JRST POPJ1

COND UINIT",[
UINIT":	CONSZ UTC,20000
	JRST .-1
	SETOM LSTP
	SETOM COAST
	CLEARM WCNTR
	CLEARM SDLY
	HLLOS RCNTR
	ELSE QUITFF",[JRST POPJA][POPJ P,]
]


COND .IPDL,[
PDL:	BLOCK LIPDL
PDLP:	-LIPDL,,PDL
]

COND .TCHG,[
TAPID:	0
]
RLOADF:	0

COND QUITFF",[
INSIDE:	0]
AVAIL COAST,	-1
AVAIL LSTP,	-1
FORW:	0
WRITE:	0
UTENB:	0
URUNTM:	0
TEM1:	0
LSTFIL:	0
SDLY:	0
LOSSCT:	0
WRASM:	0
	5
UREDP":	70700,,CEOF
UWRP:	(10700)WRASM-1
UFPNTR":
FPNTR:	MOVTAB	;POINTER TO BASE OF CURRENT MOVTAB
	(500)MOVTAB+23.*2-1	;POINTER TO BASE OF BLOCK AREA
	2

CONSTANTS
CEOF:	SYSEOF
CEOFA:	SYSEOF

ACBLK=.-A
	BLOCK ACSIZ
UAC=.-A
	BLOCK ACSIZ

RBEGB:
	PUSH P,A	;THIS CODE IS A COMPLETE CROCK AND GOES AWAY
	PUSH P,B	;AFTER FILEST IS CALLED THE FIRST TIME
	MOVE A,LOSS1
	MOVEM A,FILEST
	PUSH P,C
	MOVEI A,NDIR
	MOVEI B,0
LOSS4:	HRLI B,-56
	CLEARM MOVTAB(B)
	AOBJN B,.-1
	MOVE C,LOSS3
	MOVEM C,MOVTAB(B)
	HRLI B,-10
	CLEARM MOVTAB+1(B)
	AOBJN B,.-1
	MOVSI C,660000
	MOVEM C,MOVTAB+1(B)
	HRLI B,-107
	CLEARM MOVTAB+2(B)
	AOBJN B,.-1
	SETOM MOVTAB+2(B)
	ADDI B,3
	SOJG A,LOSS4
	POP P,C
	POP P,B
	POP P,A
	JRST FILEST
LOSS1:	ANDI A,7
LOSS3:	757367573674

LOC 40+TPCHN"*2
	JSR TAPE
	JSR TAPE

LOC RBEGB+NURBUF*201
RENDB:

WBEGB:
	LOC WBEGB+NUWBUF*200
DIRTAB:
	LOC DIRTAB+NDIR"
MOVTAB:
	LOC MOVTAB+NDIR*200

END