TITLE SYSTEM TAPE GENERATOR

MACLOD=37726

A=1
D=2
B=3
C=4
P=5
DEFINE LOSS Q
FOO=Q
TERMIN
DEFINE REDEF B
DEFINE INFO Y,Z
Y [B!!Z]
TERMIN
TERMIN
DEFINE HACK A
REDEF
IRPC X,,[A]
INFO REDEF,[X]
IFE ASCII /X/-ASCII /
/,[
INFO LOSS
<HRLI 17,+(FOO)>-1
<HRRI 17,FOO>-1
SETAM 17,..-1
..=..+1
REDEF
]TERMIN
TERMIN


BEG:	CONO 635550
TRY:	CONO UTC,203410
	CONSZ UTS,2000
	JRST .-1
	CONSZ UTS,4
	JRST TRY
	CONO UTC,221410
	CONO DC,3410
	MOVEI B,2700.
	MOVE A,[707707707707]
END1:	BLAT
	SOJG B,END1
	MOVEI C,1102
BLK:	MOVE A,[(70707)70770]
	BLAT
	MOVE A,[(77070)7000]
	BLAT
	HRLI A,7000
	BLAT
	HRRI A,-1000
	BLAT
	MOVEI B,175
	HRLI A,-1000
	BLAT
	SOJG B,.-1
	HRRI A,-701
	BLAT
	HRLI A,-701
	BLAT
	HRRI A,707007
	BLAT
	MOVE A,[(700707)70707]
	BLAT
	SOJG C,BLK
	MOVE A,[70070070070]
	MOVEI B,2700.
END2:	BLAT
	SOJG B,END2

TRY2:	CONO UTC,202510
	CONSZ UTS,2000
	JRST .-1
	CONSZ UTS,4
	JRST TRY2
	CONO UTC,233510
	CONO DC,3410
	MOVEI B,1101
	MOVEI C,1
LUP:	MOVEI A,0
	CAIN C,1
	MOVE A,B
	CAIN C,2
	JRST FWDHAK
	CAIN C,203
	JRST REVHAK
	CAIN C,3
	MOVEI A,77
	CAIN C,204
	JRST COMP
WR:	BLAT
	SOJG C,LUP
	MOVEI C,204
	SOJGE B,LUP
	CONSZ UTS,40
	JRST .-1
TRY3:	CONO UTC,223210
	CONO DC,4010
	CONSO DC,1000
	JRST .-1
	DATAI DC,A
	CAIE A,75
	JRST OOF
	CONO UTC,220710
	CONO DC,3410
	MOVSI B,-200
	MOVE A,LOADER(B)
	BLAT
	AOBJN B,.-2
	MOVSI B,-400
	MOVE A,37400(B)
	BLAT
	AOBJN B,.-2
	MOVSI B,-56
	DZM
	MOVE A,[757367573674]
	BLAT
	MOVSI B,-7
	DZM
	MOVEI A,173674
	BLAT
	MOVSI A,660000
	BLAT
	MOVSI B,-107
	DZM
	MOVNI A,1
	BLAT
	CONSZ UTS,40
	JRST .-1

	CONO UTC,3000
	CONSZ UTS,2000
	JRST .-1
	JRST TRY
OOF:	CONO UTC,220210
	JRST TRY3+1
WIPE:	MOVEI A,0
	BLAT
	AOBJN B,.-1
	JRST (C)
DZM=JSP C,WIPE
LOADER:	SETM 17,42-1
	SETAM 17,37176-1
	..=42
	HACK [JRST 10,37177
]
	..=37177
	HACK [	MOVE 17,..-1
	MOVEM 17,42
	MOVSI 17,-400
	CONO UTC,220310
	CONSO DC,1000
	JRST ..-1
	DATAI DC,37400(17)
	AOBJN 17,..-3
	MOVEI 1
	MOVNI 12,1
	JRST MACLOD
]
	CONO PI,14300-1
FWDHAK:	MOVE A,[CONO UTC,233107]
	CAIN B,75
	HRLOI A,(TRN)-1
	CAIGE B,75
	HRRI A,220107
	JRST WR
REVHAK:	MOVE A,[CONO UTC,230107]
	CAIGE B,73
	HRRI A,223107
	JRST WR
WA:	CONSZ UTS,6
	JRST DING
	CONSO DC,1000
	JRST WA
	DATAO DC,A
	JRST (P)
DING:	DATAO TTY,BELL
	CONO UTC,1000
	JRST 4,BEG
BLAT=JSP P,WA
COMP:	MOVE D,B
	ROT D,-3
	REPEAT 3,[ROTC A,3
	ROT D,-6
]	ROTC A,27.
BELL:	SETCAI A,7
	JRST WR
	END BEG