TITLE DTLOTS - MAKES LOTS OF COPIES OF A DTA
SUBTTL V004 - 11 MAY 69 - R CLEMENTS
VDTL==4
LOC 137
EXP VDTL
RELOC

A=1
B=2
C=3
I=4
U=5
IO=6
W=7
WC=10
S=11
CH=12
N1=13
N2=14
N3=15
N4=16
P=17

DSK=17
LPT=16
CIN=11
COUT=0

RDMSTR=0
CKMSTR=1
DIRECT=2
WRCOPY=3
CKCOPY=4

OPDEF STRING [TTCALL 3,0]
OPDEF TYO [TTCALL 1,0]

EXTERNAL JOBSYM,JOBDDT,JOBREN,JOBSA,JOBREL
JOBJDA=75
INTERN DTLOTS

DTLOTS:	MOVE	P,PDP
	SETZM	MSTRIN
	MOVEI	A,REENT
	MOVEM	A,JOBREN
	HRRZ	A,JOBREL
	SKIPE	JOBDDT
	HRRZ	A,JOBSYM
	SUBI	A,<5*203>+20
	CAIG	A,PRGEND+1040
	JRST	MORCOR
	HRLM	A,JOBSA
	MOVEM	A,SAVFF
	CALLI	0
	PUSHJ	P,TTINIT
	HRRZ	A,SAVFF
	SUBI	A,PRGEND
	LSH	A,-7
	MOVEM	A,BLOCKS
	MOVSI	A,(SIXBIT /IN/)
	CALLI	A,4
	TLNN	A,100
	JRST	NODEV
	MOVEI	U,CIN
	MOVEI	IO,RDMSTR
	PUSHJ	P,DO
	MOVEI	A,^D25
	CALLI	A,31
	MOVEI	IO,CKMSTR
	PUSHJ	P,DO
REENT:	CALLI	0
	MOVE	P,PDP
	SKIPN	MSTRIN
	JRST	DTLOTS
	MOVEI	U,LPT
	MOVEI	IO,DIRECT
	PUSHJ	P,DO
	SETZM	OUTTAB
	MOVE	A,[XWD OUTTAB,OUTTAB+1]
	BLT	A,OUTTAB+10
	MOVE	A,[SIXBIT /OUT0/]
	SETZB	B,I
OUDVLP:	MOVE	C,A
	CALLI	C,4
	TLNN	C,100
	JRST .+3
	MOVEM	A,OUTTAB(B)
	ADDI	B,1
	ADDI	A,10000
	TRNN	A,100000
	JRST	OUDVLP
	JUMPE	B,NODEV
MAINLP:	CAIL	I,10
	JRST	WRAPUP
	SKIPE	N1,OUTTAB(I)
	CALLI	N1,4
	TLNN	N1,100
	JRST	TAG3
	MOVEI	U,COUT(I)
	MOVEI	IO,WRCOPY
	PUSHJ	P,DO
TAG3:	SETZM	SECOND
	SKIPE	N1,OUTTAB+1(I)
	CALLI	N1,4
	TLNN	N1,100
	JRST	TAG1
	SETOM	SECOND
	MOVEI	U,COUT+1(I)
	MOVEI	IO,WRCOPY
	PUSHJ	P,DO
TAG1:	SKIPN	OUTTAB(I)
	JRST	TAG4
	MOVEI	U,COUT(I)
	MOVEI	IO,CKCOPY
	PUSHJ	P,DO
	SKIPN	SECOND
	JRST	TAG2
TAG4:	SKIPN	OUTTAB+1(I)
	JRST	TAG2
	MOVEI	U,COUT+1(I)
	MOVEI	IO,CKCOPY
	PUSHJ	P,DO
TAG2:	ADDI	I,2
	JRST	MAINLP
DO:	CALLI	0
	STRING	@MSG1TB(IO)
	DPB	U,[POINT 4,OPTAB2(IO),12]
	PUSHJ	P,@IOTAB(IO)
	MOVE	A,OPTAB2(IO)
	SKIPE	JOBDDT
	TRZ	A,10
	XCT	A
	PUSHJ	P,IOUNIT
	RELEAS	0,0
	POPJ	P,0
READIN:	PUSHJ	P,OPNDMP
	PUSHJ	P,TTYDEV
	MOVEI	N1,17
	PUSHJ	P,OPNDS1
	LOOKUP	DSK,N1
	JRST	RDI1
	CLOSE	DSK,0
	SETZB	N1,N2
	SETZB	N3,N4
	RENAME	DSK,N1
	JFCL
RDI1:	CLOSE	DSK,0
	MOVSI	N1,(SIXBIT /IMG/)
	MOVSI	N2,(SIXBIT /TMP/)
	SETZB	N3,N4
	ENTER	DSK,N1
	JRST	ENTFAL
RDIL:	PUSHJ	P,DTARD
	POPJ	P,0
	JRST	RDI2
	OUTPUT	DSK,DTLIST
	STATZ	DSK,760000
	JRST	DSKERR
	MOVEI	WC,0
	JRST	RDIL
RDI2:	CLOSE	DSK,0
	SETOM	MSTRIN
	POPJ	P,0

LKFAL:
ENTFAL:	STRING [ASCIZ /CAN'T ACCESS DSK SCRATCH FILE
/]
	CALLI	12

OPNDSK:	MOVEI	N1,14
OPNDS1:	MOVSI	N2,(SIXBIT /DSK/)
	MOVE	N3,[XWD DSKO,DSKI]
	OPEN	DSK,N1
	JRST	NOTAVL
	MOVSI	N1,(SIXBIT /IMG/)
	MOVSI	N2,(SIXBIT /TMP/)
	SETZB	N3,N4
	POPJ	P,0
CHECKO:
CHECKI:
	PUSHJ	P,OPNDMP
	PUSHJ	P,TTYDEV
	PUSHJ	P,OPNDSK
	LOOKUP	DSK,N1
	JRST	LKFAL
CKILP:	PUSHJ	P,DTARD
	JRST	CKIERR
	JRST	CKIOK
	MOVE	N4,W
	SOSLE	DSKI+2
	JRST	DSKRD1
	INPUT	DSK,0
	STATZ	DSK,740000
	JRST	DSKERR
	STATZ	DSK,20000
	JRST	CKIERR
DSKRD1:	ILDB	W,DSKI+1
	CAMN	W,N4
	JRST	CKILP
CKIERR:	STRING	[ASCIZ /
******VERIFICATION ERROR****** /]
	PUSHJ	P,TTYDEV
	CAIN	U,CIN
	CALLI	12
	POPJ	P,0

CKIOK:	STRING [ASCIZ /OK
/]
	POPJ	P,0
WRITEO:	PUSHJ	P,OPNDMP
	PUSHJ	P,TTYDEV
	MOVEI	N1,17
	PUSHJ	P,OPNDS1
	LOOKUP	DSK,N1
	JRST	LKFAL
	INPUT	DSK,DIRIOW
WRTLP:	STATZ	DSK,740000
	JRST	DSKERR
	PUSHJ	P,DTAWRB
	POPJ	P,0
	INPUT	DSK,DTLIST
	JRST	WRTLP
DIROUT:	INIT	LPT,0
	SIXBIT	/LPT/
	XWD	LPTB,0
	JRST	NOLPT
	MOVEI	N1,17
	PUSHJ	P,OPNDS1
	LOOKUP	DSK,N1
	JRST	LKFAL
	USETI	DSK,145
	INPUT	DSK,DIRIOW
	SETZM	FBLKS
	MOVNI	C,1103
	MOVE	A,[XWD 440500,PRGEND]
DFL:	ILDB	B,A
	CAIN	B,0
	AOS	FBLKS
	CAIE	B,37
	AOJL	C,DFL
	SETOM	SECOND
DIRL3:	MOVNI	C,4
DIRL5:	MOVE	A,FBLKS
	PUSHJ	P,DECP2
	MOVEI	A,[ASCIZ /. FREE BLOCKS LEFT/]
	PUSHJ	P,LPSTR
	MOVEI	CH,11
	PUSHJ	P,LPTYO
	PUSHJ	P,LPTYO
	AOJL	C,DIRL5
	PUSHJ	P,LPCRLF
	MOVE	WC,[XWD -26,PRGEND+123]
DIRL2:	MOVNI	C,4
DIRL1:	MOVE	S,0(WC)
	JUMPE	S,DIRL4
	PUSHJ	P,LP6
	MOVEI	CH,"."
	PUSHJ	P,LPTYO
	HLLZ	S,26(WC)
	PUSHJ	P,LP6
	MOVEI	CH,11
	PUSHJ	P,LPTYO
	PUSHJ	P,DATER
	MOVEI	CH,11
	PUSHJ	P,LPTYO
	AOJL	C,DIRL1
	PUSHJ	P,LPCRLF
DIRL4:	AOBJN	WC,DIRL2
REPEAT 3,<	PUSHJ	P,LPCRLF>
	AOSG	SECOND
	JRST	DIRL3
	CLOSE	LPT,0
	CLOSE	DSK,0
	JRST	TTCRLF

NOLPT:	STRING [ASCIZ / - LPT NOT AVAILABLE
/]
	POPJ	P,0
DATER:	MOVE	N1,26(WC)
	ANDI	N1,7777
	IDIVI	N1,^D31
	MOVEI	A,1(N2)
	PUSHJ	P,DECP2
	IDIVI	N1,^D12
	MOVE	S,MONTAB(N2)
	PUSHJ	P,LP65
	MOVEI	A,100(N1)

DECP2:	MOVEI	CH,"0"
	CAIGE	A,12
	PUSHJ	P,LPTYO
DECP:	IDIVI	A,12
	HRLM	B,0(P)
	SKIPE	A
	PUSHJ	P,DECP
	HLRZ	A,0(P)
	MOVEI	CH,"0"(A)
	JRST	LPTYO

MONTAB:
	SIXBIT / -JAN-/
	SIXBIT / -FEB-/
	SIXBIT / -MAR-/
	SIXBIT / -APR-/
	SIXBIT / -MAY-/
	SIXBIT / -JUN-/
	SIXBIT / -JUL-/
	SIXBIT / -AUG-/
	SIXBIT / -SEP-/
	SIXBIT / -OCT-/
	SIXBIT / -NOV-/
	SIXBIT / -DEC-/
LP65:	SKIPA	N4,[XWD 360600,S]
LP6:	MOVE	N4,[XWD 440600,S]
LP6L:	ILDB	CH,N4
	ADDI	CH,40
	PUSHJ	P,LPTYO
	TLNE	N4,770000
	JRST	LP6L
	POPJ	P,0

LPCRLF:	MOVEI	CH,15
	PUSHJ	P,LPTYO
	MOVEI	CH,12
LPTYO:	SOSG	LPTB+2
	OUTPUT	LPT,0
	IDPB	CH,LPTB+1
	POPJ	P,0

LPSTR:	HRLI	A,440700
LPSTR1:	ILDB	CH,A
	JUMPE	CH,CPOPJ
	PUSHJ	P,LPTYO
	JRST	LPSTR1
WRAPUP:	STRING [ASCIZ /
TYPE START TO READ A NEW MASTER
/]
	STRING [ASCIZ /REENTER TO MAKE MORE COPIES
/]
	CALLI	12

TAPERR:	SETZM	OUTTAB(U)
	STRING [ASCIZ / - IO ERROR ON/]
TTYDEV:	STRING	[ASCIZ / /]
	MOVE	S,OUTTAB(U)
	PUSHJ	P,TYOSIX
	HRRZ	S,JOBJDA(U)
	JUMPE	S,TTCRLF
	STRING	[ASCIZ /= /]
	CALLI	S,33
	PUSHJ	P,TYOSIX
TTINIT:
TTCRLF:	STRING	[ASCIZ /
/]
	POPJ	P,0

TYOSIX:	MOVEI	CH,0
	ROTC	S,6
	ADDI	CH,40
	TYO	CH
	CAIE	CH,40
	JRST	TYOSIX
	POPJ	P,0
OPNDMP:	MOVEI	WC,0
	SETZM	DTBLK
	MOVEI	N1,14
	MOVE	N2,OUTTAB(U)
	MOVE	N3,[XWD DTO,DTI]
	PUSHJ	P,IOUNIT
	OPEN	0,N1
	JRST	NODTA
	MOVEI	A,1
	CALLI	A,31
	POPJ	P,0

NOTAVL:	MOVE	S,N2
	PUSHJ	P,TTCRLF
	PUSHJ	P,TYOSIX
	STRING	[ASCIZ /NOT AVAILABLE
?
/]
	CALLI	12
IOUNIT:	DPB	U,[POINT 4,@0(P),12]
	POPJ	P,0

NODTA:	STRING	[ASCIZ / - CANT FIND DEVICE/]
	JRST	TTYDEV
NODEV:	STRING	[ASCIZ /ASSIGN DTA'S "IN" AND SOME OF "OUT0"-"OUT7"
/]
	CALLI	12
MORCOR:	HRRZ	A,JOBREL
	ADDI	A,4000
	CALLI	A,11
	SKIPA
	JRST	DTLOTS
	STRING	[ASCIZ /NOT ENOUGH CORE/]
	CALLI	12

MSG1TB:	EXP [ASCIZ /READING/]
	EXP [ASCIZ /CHECKING/]
	EXP [ASCIZ /DIRECTORIES/]
	EXP [ASCIZ /WRITING/]
	EXP [ASCIZ /CHECKING/]

OPTAB2:	MTAPE 0,1
	MTAPE 0,1
	CAI
	MTAPE 0,1
	MTAPE 0,11
DTARD:	JUMPL	WC,DTARD1
	MOVE	A,DTBLK
	CAIL	A,1102
	JRST	CPOPJ1
	JUMPE	A,DTARD0
	PUSHJ	P,IOUNIT
	USETI	0,(A)
	ADD	A,BLOCKS
	CAIL	A,1102
	MOVEI	A,1102
	SUB	A,DTBLK
	ADDM	A,DTBLK
	MOVN	WC,A
	ASH	WC,^D25
	HRRI	WC,PRGEND-1
	MOVEM	WC,DTLIST
	SETZM	DTLIST+1
	PUSHJ	P,IOUNIT
	INPUT	0,DTLIST
	PUSHJ	P,IOUNIT
	STATZ	0,740000
	JRST	TAPERR
DTARD1:	MOVE	W,1(WC)
	AOBJN	WC,.+1
	AOS	0(P)
CPOPJ1:	AOS	0(P)
CPOPJ:	POPJ	P,0

DTARD0:	PUSHJ	P,IOUNIT
	SETSTS	0,174
	PUSHJ	P,IOUNIT
	USETI	0,0
	PUSHJ	P,IOUNIT
	INBUF	0,1
	PUSHJ	P,IOUNIT
	INPUT	0,0
	PUSHJ	P,IOUNIT
	STATZ	0,760000
	JRST	TAPERR
	PUSHJ	P,IOUNIT
	SETSTS	0,117
	MOVSI	WC,-200
	HRR	WC,DTI+1
	HRRI	WC,-1(WC)
	MOVEM	WC,DTLIST
	AOS	DTBLK
	JRST	DTARD1
DTAWRB:	SKIPN	DTBLK
	JRST	DTAWR0
	MOVE	A,DTBLK
	PUSHJ	P,IOUNIT
	USETO	0,(A)
	PUSHJ	P,IOUNIT
	OUTPUT	0,DTLIST
DTAWR2:	PUSHJ	P,IOUNIT
	STATZ	0,760000
	JRST	TAPERR
	PUSHJ	P,IOUNIT
	SETSTS	0,117
	MOVE	A,WBLKS
	ADDB	A,DTBLK
	MOVEI	B,1102
	SUB	B,A
	JUMPE	B,CPOPJ
	CAMLE	B,BLOCKS
	MOVE	B,BLOCKS
	MOVEM	B,WBLKS
	MOVN	WC,B
	ASH	WC,^D25
	HRRI	WC,PRGEND-1
	MOVEM	WC,DTLIST
	JRST	CPOPJ1

DTAWR0:	PUSHJ	P,IOUNIT
	SETSTS	0,174
	PUSHJ	P,IOUNIT
	OUTBUF	0,1
	PUSHJ	P,IOUNIT
	USETO	0,0
	PUSHJ	P,IOUNIT
	OUTPUT	0,0
	SOS	DTO+1
	MOVEI	A,1
	MOVEM	A,WBLKS
	MOVE	WC,DIRIOW
	MOVE	W,1(WC)
	IDPB	W,DTO+1
	AOBJN	WC,.-2
	SETZM	DTO+2
	PUSHJ	P,IOUNIT
	OUTPUT	0,0
	JRST	DTAWR2
DSKERR:	STRING [ASCIZ / - IO ERROR ON DISK?!/]
	CALLI 12
IOTAB:	JRST	READIN
	JRST	CHECKI
	JRST	DIROUT
	JRST	WRITEO
	JRST	CHECKO

OUTTAB:	BLOCK 11
	SIXBIT /IN/

FBLKS:	0
SAVFF:	0
MSTRIN:	0
SECOND:	0
DTLIST:	EXP 0,0

PDP:	XWD	-17,.
	BLOCK	20

BLOCKS:	0
DTBLK:	0
WBLKS:	0
DIRIOW:	IOWD	200,PRGEND
	0
DSKO:	BLOCK	3
DSKI:	BLOCK	3
LPTB:	BLOCK	3
DTI:	BLOCK	3
DTO:	BLOCK	3

	XLIST	;LITERALS
	LIT
	LIST	;LITERALS

PRGEND:	END	DTLOTS