TITLE	GOOF	A DECTAPE CATASTROPHY RECOVERY ROUTINE
	SUBTTL		BY: BUREN W. HOFFMAN

	GOOFVR==2

;****** CHANNELS
	DTIN==0		;DECTAPE INPUT
	DTOT==1		;OUTPUT FOR COMPLETE FILES
	DFOT==2		;OUTPUT FOR FRAGMENT FILES
	LPT==3		;OUTPUT FOR DECTAPE BLOCK MAP

;****** ACCUMULATORS
	FLAG=0
	A=1
	B=2
	C=3
	D=4
	AC1=5
	AC2=6
	AC3=7
	CHR=10
	W=11
	X=12
	Y=13
	Z=14
	BLN=15
	PNT=16
	COUNT=17

;****** FLAGS
	PRINT==1		;FLAG FOR SECOND PASS THRU PRINT ROUTINE
	FRAGNO==2		;NO FRAGMENT FILES TO BE WRITTEN
	LISTNO==4		;NO BLOCK MAP LISTING TO BE WRITTEN
	NEWDIR==10		;WRITE NEW DIR. INSTEAD OF COMPLETE FILES.


	EXTERN	JOBFF

	REENTR==124
	JOBVER==137

	LOC	REENTR
	EXP	RESTRT
	RELOC
	LOC	JOBVER
	EXP	GOOFVR
	RELOC
	PAGE
DVINI:	Z
	MOVE	AC1,DVLIST	;NAME OF LIST DEVICE
	CALLI	AC1,4		;GET THE DEVICE CHARS.
	TLNN	AC1,1		;CAN IT OUTPUT ?
	TLOA	FLAG,LISTNO	;NO, NO MAP
	CAIA			;YES
	JRST	DVIN-1		;GO CHECK NEXT DEVICE

	INIT	LPT,1		;ASCII MODE TO LISTING DEVICE
DVLIST:	SIXBIT	/LIST/
	XWD	LBUF,0
	JRST	.-6		;SET NOLIST FLAG
	MOVEI	AC1,LPBUF	;OUTPUT BUFFER
	MOVEM	AC1,JOBFF
	OUTBUF	LPT,1		;ESTABLISH BUFFER

	INIT	DTIN,117	;NON-STD. DUMP MODE
DVIN:	SIXBIT	/GOOFIN/
	Z
	JRST	LOGMSG		;THIS IS A NO-NO

	MOVE	AC1,DVOUT
	CALLI	AC1,4		;GET DEVICE CHARACTERISTICS
	JUMPE	AC1,DVANO	;DEFINED DEVICE ?
DEVCMP:	INIT	DTOT,14		;YES, TRY BINARY OUTPUT
DVOUT:	SIXBIT	/GOOFA/
	XWD	OBUF,0
	CAIA
	JRST	.+3		;OK
DVANO:	TLO	FLAG,NEWDIR	;TURN ON NEWDIR FLAG
	JRST	.+4

	MOVEI	AC1,NDIR
	MOVEM	AC1,JOBFF
	OUTBUF	DTOT,2		;ESTAB. TWO OUTPUT BUFFERS

DEVFRG:	INIT	DFOT,14		;DEVICE FOR FRAGMENT OUTPUT
DVOUTF:	SIXBIT	/GOOFX/
	XWD	FBUF,0
	TLO	FLAG,FRAGNO	;NO FRAGMENT FILES TO BE WRITTEN
	JRST	@DVINI		;RETURN
	PAGE
;************ GOOF STARTS HERE
GOOF:	CALLI	0		;RESET ALL I/O
	TTCALL	3,MSGLGA	;TYPE INSTRUCTIONS
	MOVEI	AC1,202017	;INITIALIZE EXTENSION COUNTER
	MOVEM	AC1,EXTNSN	;AND SAVE


;************ RE-ENTER HERE FROM REENTR
STRRT1:	JSR	TIMIN		;SET UP START TIMES
	TTCALL	3,MSGLOG	;TYPE OTHER INSTR.
	MOVEI	FLAG,0		;START WITH VIRGIN FLAG
	JSR	DVINI		;INIT ALL THE DEVICES
	MOVE	AC1,[XWD LNKWRD,LNKWRD+1]
	SETOM	LNKWRD		;INITIALIZE LNKWRD ARRAY TO ALL ONES
	BLT	AC1,LNKWRD+1101
	MOVE	AC1,[XWD FILEN,FILEN+1]
	SETZM	FILEN		;INITIALIZE FILEN ARRAY TO ALL ZEROES
	BLT	AC1,FILEN+77
	JRST	STRRT		;NOW START TO WORK


;************THE MESSAGES MSGLGA AND MSGLOG XLISTED BELOW
	XLIST
MSGLOG:	ASCIZ	/
TYPE A CARRIAGE RETURN WHEN READY TO START,
OR AN M<CR> IF READING BLOCKS MANUALLY.
*/
MSGLGA:	ASCIZ	/
	ASSUMED LOGICAL ASSIGNMENTS --

	INPUT DEVICE	= GOOFIN
	OUTPUT DEVICE	= GOOFA	(FOR COMPLETE FILES)
	OUTPUT DEVICE	= GOOFX	(FOR FRAGMENT FILES)
	LISTING DEVICE	= LIST

	NOTE:
		1) IF GOOFX UNDEFINED, NO FRAGMENT FILES WRITTEN.
		2) IF LIST UNDEFINED, NO DECTAPE BLOCK MAP WRITTEN.
		3) FOR MANUAL CHAINING, ONLY GOOFIN AND GOOFA USED.
		4) IF GOOFA UNDEFINED, A NEW DIR. WRITTEN ON GOOFIN.
		5) IF ADDITIONAL OUTPUT DEVICES (EG. DECTAPES) ARE
		   NEEDED TO WRITE THE OUTPUT FILES, THE PROGRAM WILL
		   REQUEST THEM AS NEEDED.  IF ALREADY ASSIGNED,
		   THE PROGRAM WILL PROCEED.
		   THE EXTRA OUTPUT DEVICES CAN BE DEFINED BEFORE
		   RUNTIME.
		   FOR OUTPUT OF COMPLETE FILES, THE ADDITIONAL
		   DEVICES ARE GOOFB,GOOFC,GOOFD,...
		   FOR FRAGMENT FILES, GOOFY,GOOFZ
/

	LIST

	PAGE

;************ START TALKING TO USER HERE
STRRT:	TTCALL	4,CHR		;GET INPUT FROM TTY
	CAIN	CHR,15		; <CR> ?
	JRST	GOGO		;YES, GO READ THE DECTAPE
	CAIN	CHR,"M"		; (M) ?
	JRST	MANUAL		;YES, GO DO MANUAL INPUT
	TTCALL	3,[ASCIZ /?/]	;SOME ERROR ?
	TTCALL	11,0		;FLUSH INPUT BUFFER
	JRST	STRRT		;AND ASK AGAIN

GOGO:	MOVE	BLN,[XWD -1077,3]	;IGNORE BLOCKS 0,1,& 2
USETAG:	HRRZ	AC1,BLN		;THIS BLOCK NEXT
	CAIN	AC1,144		;IS IT THE DIRECTORY BLOCK ?
	JRST	NONOFD		;YES, IGNORE IT
	MOVEI	COUNT,10	;UP TO EIGHT READ TRIES
	USETI	DTIN,(BLN)	;SET TO READ BLOCK
	INPUT	DTIN,INIOWD	;INPUT THE BLOCK
	STATZ	DTIN,740000	;OK ?
	JSP	A,HELPME	;NO, GET HELP
	CAIA			;YES
	JRST	NONOFD		;CAN'T READ IT
	LDB	AC1,[POINT 10,DTAB,27]	;ORIGIN BLOCK
	CAIG	AC1,1101	;DON'T USE IF >1101
	SKIPN	AC1		;OR ZERO
	JRST	NONOFD
	MOVEM	AC1,LNKWRD(BLN)	;SAVE THE ORIGIN INFO.
	MOVE	AC3,DTAB	;GET THE LINKAGE INFO
	HLLM	AC3,LNKWRD(BLN)	;AND SAVE
	MOVE	AC2,[XWD -200,FILEN]	;NOW SCAN FILEN

RSCN:	SKIPN	(AC2)		;END OF SCAN ?
	JRST	NOFND		;YES, ENTER THE NEW ORIGIN
	CAMN	AC1,(AC2)	;THIS ORIGIN ALREADY ENTERED ?
	JRST	NONOFD		;YES

NOTEQ:	AOBJN	AC2,RSCN	;IS FILEN ARRAY FULL ?
	JRST	TOOMCH		;YES

NOFND:	MOVEM	AC1,(AC2)	;SAVE THE INFO IN FILEN

NONOFD:	AOBJN	BLN,USETAG	;MORE BLOCKS TO READ ?
	TLZ	FLAG,PRINT	;NO, SET THE PRINT FLAG
	PAGE
RDDONA:	TLNE	FLAG,LISTNO	;WRITE A LISTING ?
	JRST	RDDN0		;NO
	MOVSI	W,-200		;200 ENTRIES IN FILEN
	SETZM	ORCNT#		;INITIALIZE REFERENCE COUNTER
	SKIPN	A,FILEN(W)	;END OF FILEN ARRAY ?
	JRST	RDDONE		;YES
	MOVSI	BLN,-1102	;1102 ENTRIES MAX IN LNKWRD
	HRRZ	B,LNKWRD(BLN)	;PICK UP ORIGIN REFERENCE
	CAMN	A,B		;IS IT EQUAL TO THIS ONE ?
	AOS	ORCNT		;YES, INCREMENT COUNTER
	AOBJN	BLN,.-3		;THRU THE LNKWRD ARRAY ?
	HRLZ	A,ORCNT		;YES, STORE THE REFERENCE COUNT
	HLLM	A,FILEN(W)	;IN THE FILEN ARRAY
	AOBJN	W,RDDONA+3	;THRU WITH FILEN ARRAY ?

RDDONE:	TLNE	FLAG,LISTNO	;YES, WRITE LIST FILE ?
	JRST	RDDN0		;NO
	MOVE	A,[SIXBIT /GOOF/]
	MOVSI	B,(SIXBIT /DTA/)
	SETZB	C,D

	ENTER	LPT,A		;ENTER THE FILE
	JRST	RDDN0		;? ERROR
	JRST	REGPRT		;FIRST PASS LISTING
RDDUN:	MOVEI	CHR,14		;NEW PAGE
	JSR	PUTCHR
	MOVE	AC1,[POINT 7,MSG3]	;SECOND PASS HDG.
	JRST	RDDN2		;GO DO IT


REGPRT:	MOVE	AC1,[POINT 7,MSG1]	;THIS HDG FOR FIRST PASS
	JSR	PTSTRG		;WRITE IT
	MOVSI	AC1,-200	;200 ENTRIES MAX IN FILEN
	HRRI	AC1,FILEN	;ADDR OF FILEN
	MOVEI	BLN,0		;SET UP A BLOCK COUNTER

REGPR1:	SKIPN	(AC1)		;END OF FILEN ARRAY ?
	JRST	REGPR2		;YES
	JSR	LPRNT		;PRINT TEXT ASSOC. WITH (AC1)
	MOVEI	A,MXREF
	HRLI	A,440700
	ILDB	CHR,A		;GET A BYTE
	JUMPE	CHR,.+3		;NULL BYTE ?
	JSR	PUTCHR		;NO, WRITE IT
	JRST	.-3		;GET NEXT BYTE
	MOVEI	D,^D12		;12 XREF'S PER LINE
	MOVEI	CHR,11		;HORIZ. TAB
	JSR	PUTCHR		;TWO TIMES
	JSR	PUTCHR

	HRRZ	A,(AC1)		;ORIGIN BLOCK
	MOVSI	B,-1102		;1102 LNKWRD ENTRIES
NXXRF:	HRRZ	C,LNKWRD(B)	;ORIGIN REF. FOR THIS LNKWRD
	CAME	C,A		;ARE THEY EQUAL ?
	JRST	NDXRF		;NO, TRY NEXT LNKWRD
	MOVE	PNT,[POINT 3,B,17]	;YES, SO PRINT
	SOJGE	D,NXHWD		;12 WORDS PRINTED ?
	MOVEI	CHR,15		;YES, END OF LINE
	JSR	PUTCHR
	MOVEI	CHR,12		;LINE FEED
	JSR	PUTCHR
	MOVEI	CHR,11		;HORIZ. TAB
	JSR	PUTCHR		;TWO TIMES
	JSR	PUTCHR
	MOVEI	D,^D11		;RE-INITIALIZE REF. COUNT
NXHWD:	JSR	HWD		;PRINT THE REFERENCE
	MOVEI	CHR,11		;HORIZ. TAB
	JSR	PUTCHR		;PRINT IT

NDXRF:	AOBJN	B,NXXRF		;MORE ENTRIES IN LNKWRD ?
	MOVEI	CHR,15		;NO, CARRIAGE RETURN
	JSR	PUTCHR
	MOVEI	CHR,12		;LINE FEED
	JSR	PUTCHR		;TWICE
	JSR	PUTCHR
	AOBJN	AC1,REGPR1	;MORE FILEN ENTRIES ?

REGPR2:	MOVE	AC1,[POINT 7,MSG2]	;NO, NEXT OUTPUT NOW
RDDN2:	JSR	PTSTRG
	MOVSI	AC1,-1102	;1102 ENTRIES IN LNKWRD
	HRRI	AC1,LNKWRD	;ADDR OF LNKWRD
	MOVEI	BLN,0		;BLOCK COUNTER
	JSR	LPRNT		;PRINT THE BLOCK NO. AND POINTERS
	AOBJN	AC1,.-1		;MORE TO PRINT ?
NOMAP2:	TLNE	FLAG,PRINT	;NO, FIRST PRINT PASS ?
	JRST	FINIS2		;NO, REALLY DONE.
	PAGE
RDDN0:	MOVSI	W,-200		;200 ENTRIES MAX. IN FILEN
	TLNE	FLAG,NEWDIR	;WRITING NEW DIRECTORY ?
	JSR	DIRINI		;YES, INITIALIZE
RDDN1:	SKIPN	FILEN(W)	;END OF FILEN ARRAY ?
	JRST	RDFRAG		;YES, GO WRITE FRAGS.
	HRRZ	X,FILEN(W)	;FIRST BLOCK OF FILE
	MOVE	Y,X

RDDAG:	HRRZ	AC1,LNKWRD(Y)	;ORIGIN
	HLRZ	Y,LNKWRD(Y)	;NEXT BLOCK
	ANDI	Y,1777		;LOW ORDER 10 BITS ONLY
	CAMN	AC1,X		;SAME ORIGIN ?
	JRST	.+3		;YES
	AOBJN	W,RDDN1		;NO, GET NEXT ORIGIN
	JRST	RDFRAG		;DONE SO READ FRAGMENTS
	SKIPE	Y		;END OF FILE ?
	JRST	RDDAG		;NO, SEARCH ON FURTHER

GOODUN:	MOVSI	A,(SIXBIT /DTC/)	;SET THE FILENAME
	JSR	EXTADJ		;AND GET THE NEXT EXTENSION
	TLNE	FLAG,NEWDIR	;WRITING NEW DIRECTORY ?
	JRST	DTENTR		;YES, GO MAKE ENTRY
GOODNX:	SETZB	C,D		;NO, GO AHEAD AND ENTER FILE
	ENTER	DTOT,A
	JRST	DIRFUL		;NEED NEXT TAPE
	SETOM	FILEN(W)	;FLAG AS USED

GOODN1:	MOVEI	COUNT,10	;UP TO 10 RE-TRIES TO READ
	USETI	DTIN,(X)	;SETUP FOR THIS BLOCK
	INPUT	DTIN,INIOWD	;READ THE BLOCK
	STATZ	DTIN,740000	;OK ?
	JSP	A,HELPME	;NO, GET HELP
	CAIA			;YES
	JRST	GOODEF		;CAN'T READ IT, SO EOF
	HLRZ	Y,LNKWRD(X)	;NEXT BLOCK NUMBER
	ANDI	Y,1777		;LOW ORDER 10 BITS ONLY
	SETOM	LNKWRD(X)	;FLAG AS USED
	MOVE	X,Y
	MOVE	AC2,[XWD -177,DTAB+1]
	MOVE	CHR,(AC2)	;PICK UP A WORD FROM BLOCK
	JSR	PUT		;AND WRITE ON OUTPUT DEVICE
	AOBJN	AC2,.-2		;MORE WORDS ?
	SKIPE	X		;EOF ?
	JRST	GOODN1		;NO, READ MORE
GOODEF:	CLOSE	DTOT,0		;YES, CLOSE THE FILE
	AOBJN	W,RDDN1		;MORE ENTRIES IN FILEN ?
	PAGE
RDFRAG:	TLNE	FLAG,NEWDIR	;NO, WRITING NEW DIRECTORY ?
	JSR	DIROUT		;YES, FINISH IT
	TLNE	FLAG,FRAGNO	;WRITE FRAG FILES ?
	JRST	FINISH		;NO
	MOVEI	W,NDIR
	MOVEM	W,JOBFF
	OUTBUF	DFOT,2		;ESTABLISH TWO OUTPUT BUFFERS
	MOVSI	W,-200		;200 MAX. ENTRIES IN FILEN
RDFRG1:	SKIPN	FILEN(W)	;MORE ENTRIES ?
	JRST	FINISH		;NO
	SKIPG	FILEN(W)	;ALREADY USED ?
	JRST	RDFRG3		;YES
	HRRZ	X,FILEN(W)	;GET ORIGIN BLOCK
	MOVE	AC3,X		;ORIGIN
	HRRZ	AC2,LNKWRD(X)	;GET CORRES. ORIGIN FROM LNKWRD
	CAME	AC2,X		;ARE THEY SAME ?
	JRST	RDFRG3		;NO

	MOVSI	A,(SIXBIT /DTF/)	;SET THE FILENAME
	JSR	EXTADJ		;AND GET THE NEXT EXTENSION
RDFRGX:	SETZB	C,D
	ENTER	DFOT,A		;ENTER THE NEW FILE
	JRST	FRGFUL		;NEED NEXT TAPE
RDFRG2:	MOVEI	COUNT,10
	USETI	DTIN,(X)	;SET UP TO INPUT THIS BLOCK
	INPUT	DTIN,INIOWD	;INPUT THE BLOCK
	STATZ	DTIN,740000	;OK ?
	JSP	A,HELPME	;NO
	CAIA
	JRST	FRAGEF		;CAN'T READ SO EOF
	HRRZ	Y,LNKWRD(X)	;ORIGIN OF THIS NEXT BLOCK
	MOVE	CHR,X
	HLRZ	X,LNKWRD(X)	;NEXT BLOCK
	ANDI	X,1777		;LOW ORDER 10 BITS ONLY
	SETOM	LNKWRD(CHR)	;FLAG AS USED
	MOVE	AC2,[XWD -177,DTAB+1]
	MOVE	CHR,(AC2)	;GET AN INPUT WORD
	JSR	PUTF		;WRITE THE WORD
	AOBJN	AC2,.-2		;MORE WORDS FOR THIS BLOCK ?
	CAMN	Y,AC3		;NO, NEXT BLOCK SAME ORIGIN ?
	JRST	RDFRG2		;YES, GET IT
FRAGEF:	CLOSE	DFOT,0		;EOF FOR THIS FRAGMENT
RDFRG3:	AOBJN	W,RDFRG1	;MORE FILEN ENTRIES ?
	PAGE
FINISH:	TLO	FLAG,PRINT	;TURN ON PASS2 PRINT FLAG
	TLNN	FLAG,LISTNO	;MAKE AN OUTPUT LISTING ?
	JRST	RDDUN		;YES, GO DO IT
FINIS2:	RELEAS	DTIN,0
	RELEAS	DTOT,0
	RELEAS	DFOT,0
	RELEAS	LPT,0
	CALLI	A,22		;GET TIME NOW
	SUB	A,RELTIM#	;ELAPSED TIME
	JSR	TIMPRT		;PRINT THE TIME
	ASCIZ	/ELAPSED REAL TIME  /
	MOVE	A,[XWD -1,4]	;GET RUNNING TIME (CPU)
	CALLI	A,41
	HALT
	SUB	A,CPUTIM#	;ELAPSED CPU TIME
	JSR	TIMPRT		;PRINT THE TIME
	ASCIZ	/ELAPSED CPU TIME   /
	CALLI	12		;EXIT


DTENTR:	MOVEM	A,DTAB+^D83(D)	;ENTER THE FILENAME
	HRR	B,DIRDAT#	;GET THE DATE
	MOVEM	B,DTAB+^D105(D)	;ENTER EXT AND DATE
	SETOM	FILEN(W)	;FLAG AS USED
	ADDI	D,1		;INCREMENT FILE COUNT

DTNTRD:	HRRZ	B,X		;BLOCK NUMBER
	IDIVI	B,7		;SEVEN SLOTS PER WORD
	DPB	D,POINTR(C)	;DEPOSIT THE FILE NUMBER IN SLOT
	HLRZ	Y,LNKWRD(X)	;NEXT BLOCK
	SETOM	LNKWRD(X)	;FLAG AS USED
	MOVE	X,Y
	ANDI	X,1777		;LOW ORDER 10 BITS ONLY
	SKIPE	X		;EOF ?
	JRST	DTNTRD		;NO
	AOBJN	W,RDDN1		;YES, MORE FILES ?
	JRST	RDFRAG		;NO, CHECK ON FRAGMENTS

DIROUT:	Z
	MOVEI	COUNT,10
	USETO	DTIN,144	;SETUP TO OUTPUT THE NEW DIR.
	OUTPUT	DTIN,INIOWD	;OUTPUT THE DIRECTORY
	STATZ	DTIN,740000	;OK ?
	JSP	A,HELPME	;NO, GET HELP
	JRST	@DIROUT		;DONE, RETURN
	HALT			;ERROR

DIRINI:	Z
	MOVE	AC1,[XWD DTAB,DTAB+1]
	SETZM	DTAB
	BLT	AC1,DTAB+177	;ZERO OUT DTAB
	MOVEI	AC1,36
	DPB	AC1,[POINT 5,DTAB+^D21,4]	;LABEL DIR. SLOT
	CALLI	AC1,14		;GET TODAY'S DATE
	MOVEM	AC1,DIRDAT	;AND SAVE FOR LATER
	MOVEI	D,0		;INITIALIZE FILE COUNT
	JRST	@DIRINI		;RETURN

POINTR:
	POINT	5,DTAB(B),4
	POINT	5,DTAB(B),9
	POINT	5,DTAB(B),14
	POINT	5,DTAB(B),19
	POINT	5,DTAB(B),24
	POINT	5,DTAB(B),29
	POINT	5,DTAB(B),34

TIMPRT:	Z
	MOVE	AC1,TIMPRT	;ADDRESS OF MESSAGE
	HRLI	AC1,440700	;BUILT BYTE POINTER TO MSG
	ILDB	CHR,AC1		;GET A BYTE OF MSG
	JUMPE	CHR,.+3		;TERMINATE ON NULL CHARACTER
	TTCALL	1,CHR		;WRITE THE CHARACTER
	JRST	.-3		;GET NEXT BYTE
	ADDI	AC1,1		;INCREMENT FOR RETURN ADDRESS
	HRRM	AC1,TIMPRT
	IDIVI	A,^D3600*^D60	;HOURS IN A
	IDIVI	B,^D3600	;MINUTES IN B
	IDIVI	C,^D60		;SECONDS IN C
	MOVE	AC1,A
	JSR	DECPRT		;PRINT HOURS
	TTCALL	3,[ASCIZ /:/]
	MOVE	AC1,B
	JSR	DECPRT		;PRINT MINUTES
	TTCALL	3,[ASCIZ /:/]
	MOVE	AC1,C
	JSR	DECPRT		;PRINT SECONDS
	TTCALL	3,[ASCIZ /./]
	IMULI	D,^D10
	IDIVI	D,6
	JSR	DECPRT		;PRINT SEC/100
	TTCALL	3,[ASCIZ /
/]
	JRST	@TIMPRT		;RETURN

PTSTRG:	Z
	ILDB	CHR,AC1		;GET A BYTE
	JUMPE	CHR,@PTSTRG	;TERMINATE ON NULL CHAR.
	JSR	PUTCHR		;WRITE THE BYTE
	JRST	.-3		;GO GET NEXT BYTE

DECPRT:	Z
	IDIVI	AC1,^D10
	MOVEI	CHR,60(AC1)
	TTCALL	1,CHR		;TYPE TENS
	MOVEI	CHR,60(AC2)
	TTCALL	1,CHR		;TYPE UNITS
	JRST	@DECPRT

TIMIN:	Z
	CALLI	AC1,22		;GET TIME OF DAY IN JIFFIES
	MOVEM	AC1,RELTIM	;AND SAVE
	MOVE	AC1,[XWD -1,4]
	CALLI	AC1,41		;GET CPU RUN TIME IN JIFFIES
	HALT
	MOVEM	AC1,CPUTIM	;AND SAVE
	JRST	@TIMIN		;AND RETURN

LPRNT:	Z
	TLNN	FLAG,PRINT	;SECOND PASS ?
	JRST	LPRNTA		;NO
	SKIPL	(AC1)		;USED BLOCK ?
	JRST	LPRNTA		;NO, WRITE IT
	ADDI	BLN,1		;INCREMENT BLOCK COUNT
	JRST	@LPRNT		;RETURN

LPRNTA:	MOVE	PNT,[POINT 3,BLN,23]
	ILDB	CHR,PNT		;PICK UP AN OCTAL DIGIT
	ADDI	CHR,60		;CONVERT TO ASCII
	JSR	PUTCHR		;AND WRITE IT
	TLNE	PNT,770000	;END OF WORD ?
	JRST	.-4		;NO, DO MORE
	ADDI	BLN,1		;INCREMENT BLOCK COUNT
	MOVEI	CHR,40		;BLANK
	JSR	PUTCHR
	JSR	PUTCHR
	MOVE	PNT,[POINT 3,(AC1)]	;POINTER TO LNKWRD ENTRY
	JSR	HWD		;WRITE THE HALFWORD
	MOVEI	CHR,40		;BLANK
	JSR	PUTCHR
	JSR	HWD		;WRITE THE SECOND HALFWORD
	MOVEI	CHR,15		;CARRIAGE RETURN
	JSR	PUTCHR
	MOVEI	CHR,12		;LINE FEED
	JSR	PUTCHR
	JRST	@LPRNT		;RETURN

HELPME:	SOJGE	COUNT,-4(A)	;REREAD COUNT LEFT ?
	JRST	1(A)		;NO

PUT:	Z	;PUT,PUTF, AND PUTCHR ARE BUFFERED OUTPUT ROUTINES.
	SOSG	OBUF+2
	JRST	.+3
	IDPB	CHR,OBUF+1
	JRST	@PUT
	OUT	DTOT,0
	JRST	.-3
	HALT

PUTF:	Z
	SOSG	FBUF+2
	JRST	.+3
	IDPB	CHR,FBUF+1
	JRST	@PUTF
	OUT	DFOT,0
	JRST	.-3
	HALT

PUTCHR:	Z
	SOSG	LBUF+2
	JRST	.+3
	IDPB	CHR,LBUF+1
	JRST	@PUTCHR
	OUT	LPT,0
	JRST	.-3
	HALT

HWD:	Z
	MOVEI	AC3,6		;6 DIGITS PER HALF-WORD
	ILDB	CHR,PNT		;GET A DIGIT
	ADDI	CHR,60		;CONVERT TO ASCII
	JSR	PUTCHR		;WRITE THE CHARACTER
	SOJG	AC3,.-3		;MORE DIGITS ?
	JRST	@HWD		;NO, RETURN
	PAGE
;************ HERE FOR MANUAL CHAINING OF FILES
MANUAL:	MOVSI	A,(SIXBIT /DTM/)	;SET THE FILENAME
	JSR	EXTADJ		;AND GET NEXT EXTENSION
	SETZB	C,D
	ENTER	DTOT,A		;ENTER THE NEW FILE
	JRST	TAPFUL		;ERROR

MANENT:	TTCALL	11,0		;FLUSH TTY INPUT BUFFER
	TTCALL	3,[ASCIZ /BLOCK NO. ? /]

MANREN:	SETZB	AC1,AC2		;INITIALIZE AC1 & AC2

MANBLK:	TTCALL	4,AC2		;GET A CHARACTER
	CAIE	AC2,15		;CARRIAGE RETURN ?
	CAIN	AC2,175		;NO, ALTMODE ?
	JRST	MANEBK		;COMPLETE BLOCK NUMBER, PROCESS IT
	CAIN	AC2,","		;COMMA ?
	JRST	MANEBK		;YES, PROCESS IT
	SUBI	AC2,60		;CONVERT TO BINARY
	SKIPL	AC2		;IS IT A LEGAL OCTAL NUMBER
	CAILE	AC2,7
	JRST	MANERR		;ILLEGAL NUMBER
	ROT	AC2,-3		;GET THE DIGIT INTO HIGH END OF AC2
	LSHC	AC1,3		;SHIFT INTO AC1
	JRST	MANBLK		;GO GET NEXT DIGIT

MANEBK:	CAILE	AC1,1101	;IS NUMBER >1101 ?
	JRST	MANERR		;YES
	SKIPN	AC1		;IS IT >0 ?
	JRST	MANEOF		;NO, EOF
	MOVEI	COUNT,10
	USETI	DTIN,(AC1)	;SET UP TO INPUT THE BLOCK
	INPUT	DTIN,INIOWD	;GET THE BLOCK
	STATZ	DTIN,740000	;OK ?
	JSP	A,HELPME	;NO, GET HELP
	CAIA
	JRST	MRDERR		;CAN'T READ IT
	MOVE	AC1,[XWD -177,DTAB+1]
	MOVE	CHR,(AC1)	;PICK UP A WORD
	JSR	PUT		;AND WRITE IT
	AOBJN	AC1,.-2		;MORE TO XFER
	CAIN	AC2,","		;NO, COMMA DELIMETER ?
	JRST	MANREN		;YES, GET NEXT NUMBER
	JRST	MANENT		;NO, ASK FOR ANOTHER BLOCK NO.

MANEOF:	CLOSE	DTOT,0		;CLOSE THE OUTPUT FILE
	TTCALL	11,0		;FLUSH THE INPUT BUFFER
	TTCALL	3,[ASCIZ /ANOTHER FILE ? (Y OR <C.R.>)  /]
	TTCALL	4,CHR		;GET ANSWER
	CAIN	CHR,"Y"		;IS IT YES ?
	JRST	MANUAL		;YES, GO DO IT
	CALLI	12		;NO, EXIT

MRDERR:	TTCALL	3,[ASCIZ /? READ ERROR
/]
	CAIA
MANERR:	TTCALL	3,[ASCIZ /?
/]
	TTCALL	3,[ASCIZ /ERROR OCCURRED BEFORE
/]
	TTCALL	4,CHR
	CAIE	CHR,15
	CAIN	CHR,175
	JRST	.+3
	TTCALL	1,CHR
	JRST	.-5
	TTCALL	3,[ASCIZ /
/]
	JRST	MANENT

TAPFUL:	TTCALL	3,[ASCIZ /
OUTPUT DEVICE ENTER FAILURE
** PROBABLY FULL DIRECTORY **
/]
	CALLI	12

NOMAP:	TTCALL	3,[ASCIZ /CAN'T INIT LOGICAL DEVICE LIST
SO NO BLOCK MAPS PRODUCED.
/]
	TLO	FLAG,LISTNO
	JRST	NOMAP2

TOOMCH:	TTCALL	3,[ASCIZ /
TOO MANY FRAGMENTS
/]
	CALLI	12

LOGMSG:	TTCALL	3,[ASCIZ /
? ? ASSIGN THE LOGICAL DEVICES AND RESTART ? ?
/]
	CALLI	12

EXTADJ:	Z
	AOS	B,EXTNSN	;INCREMENT THE EXTENSION COUNTER
	TRZN	B,10		;DIGIT OVERFLOW ?
	JRST	EXTA1		;NO
	ADDI	B,100		;YES, EFFECT THE CARRY
	TRZN	B,1000		;DIGIT OVERFLOW ?
	JRST	EXTA1		;NO
	ADDI	B,10000		;YES, MAKE THIS CARRY
EXTA1:	MOVEM	B,EXTNSN	;SAVE THE UPDATED COUNTER
	HRLZS	B		;PUT EXT IN LEFT HALF
	JRST	@EXTADJ		;AND RETURN
EXTNSN:	Z

DIRFUL:	MOVEI	AC2,100		;TO INCREMENT LAST LETTER OF DEV NAME
	ADDB	AC2,DVOUT	;DO IT
	MOVEI	CHR,DVOUT
	HRRZ	AC1,DEVCMP	;DATA MODE
	MOVE	AC3,DEVCMP+2	;RING-HEADER
	OPEN	DTOT,AC1	;RE-INIT THE DEVICE & CHANNEL
	JSR	NEWDEV		;NEED ANOTHER OUTPUT DEVICE
	MOVEI	AC1,NDIR
	MOVEM	AC1,JOBFF
	OUTBUF	DTOT,2
	JRST	GOODNX

FRGFUL:	MOVEI	AC2,100		;TO INCREMENT DEVICE NAME
	ADDB	AC2,DVOUTF
	MOVEI	CHR,DVOUTF
	HRRZ	AC1,DEVFRG
	MOVE	AC3,DEVFRG+2
	OPEN	DFOT,AC1
	JSR	NEWDEV		;NEED NEXT DEVICE
	MOVEI	AC1,NDIR
	MOVEM	AC1,JOBFF
	OUTBUF	DFOT,2
	JRST	RDFRGX

NEWDEV:	Z
	TTCALL	3,[ASCIZ /
NEED NEW OUTPUT DEVICE WITH LOGICAL NAME OF /]
	HRLI	CHR,440600
	ILDB	AC1,CHR
	JUMPE	AC1,.+4
	ADDI	AC1,40
	TTCALL	1,AC1
	JRST	.-4
	TTCALL	3,[ASCIZ /
ASSIGN THE DEVICE, AND THEN TYPE CONTINUE
/]
	CALLI	1,12		;EXIT
	MOVE	AC1,NEWDEV
	SUBI	AC1,5
	JRST	(AC1)

;************ THE FOLLOWING MESSAGES XLISTED HERE
;			MXREF
;			MSG1
;			MSG2
;			MSG3
;
	XLIST
MXREF:	ASCIZ	/*******************
/

MSG1:	ASCIZ	/
FILE ORIGINS

FILE   REF  ORIGIN		[& CROSS REFERENCE]
....................
/
MSG2:	ASCIZ	/


BLOCK POINTER CONTENTS

BLOK   NEXT,ORIGIN
..................
/
MSG3:	ASCIZ	/
UNUSED BLOCKS

BLOK   NEXT,ORIGIN
..................
/
	LIST

	PAGE
INIOWD:	IOWD	200,DTAB
	Z
DTAB:	BLOCK	200
FILEN:	BLOCK	200
NDIR:	BLOCK	203
NFDIR:	BLOCK	203
LNKWRD:	BLOCK	1102
OBUF:	BLOCK	3
FBUF:	BLOCK	3
LBUF:	BLOCK	3
LPBUF:	BLOCK	203

	XLIST
	LIT
	LIST

RESTRT:	CALLI	0
	JRST	STRRT1

THEEND:	END	GOOF