;;;MODIFICATION HISTORY
;;;
;;; 15 NOV 75  OBTAINED FROM DEC (KLDCP REV 7)
;;; 15 NOV 75  CONVERTED TO PALX FORMAT
;;; 30 JUL 76  ADDED ADDITIONAL MICRO TAPE COMMANDS
;;;
.MACRO .EVEN		;AVOID PALX/PCNVRT BYTE LOSSAGE
.IIF NZ .&1, .BYTE 0
.ENDM

;;; Documentation on microtape format.
;;;
;;; It's a subset of DOS-11's format.
;;;
;;; Block 0 bootstrap program
;;; Blocks 30-60 TCMON (micro tape load program)
;;;	[same function as MACDMP but a little bit bigger]
;;; Other blocks < 100 reserved
;;; 100 Root block
;;;	mfd blk no, mfd wds per entry, first bit map blk, last bit map blk
;;; 101	Master File Directory
;;;	link, uic, blk, ufd wds per entry
;;;	The only UFD that exists is [1,1]
;;; 102	User File Directory [1,1]
;;;	link, 28. entries: fn1a, fn1b, ext, date, 0, first, length, last, 0
;;; 103	Second block of ufd
;;; 104	Bit Map
;;;	link, sequence number, length in words, first bit map blk no, 
;;;	bits which are 1 is used, 0 if free.
;;; Blocks 105-1100 for files.
;;; Each file block contains a link word, which is the first word (as read).
;;; Link word is zero if EOF, positive if next block read and written forward,
;;; negative if next block read and written backwards.

.SBTTL	DIAGNOSTIC CONSOLE UTILITY PROGRAM CONTROL

	.=PRGSRT

;STARTING ADDRESSES AND CONTROL

$ILOAD:	JMP UTILITY		;IF STARTED HERE RETURN TO CONSOLE
		;AFTER IDENTIFING SELF

;UTILITY IDENTIFICATION PARAMETERS

PID:	.RAD50 /KLDCPU/		;PROGRAM IDENTIFICATION
PDVER:	DECVER 			;DEC VERSION NUMBER
PMVER:	MCNVER 			;MCN VERSION NUMBER

	0
	0

;UTILITY SUB-PROGRAM STARTING ADDRESSES

PTABLE:	RXCOPY 			;FLOPPY COPY
	DTCOPY 			;DECTAPE COPY
	WFILE 			;WRITE FILE FROM DECTAPE/FLOPPY TO RP04
	TAPT 			;TRANSFER FILE FROM APT10 TO RP04
	DSKDIR 			;RP04 DISK DIRECTORY
	REMOTE 			;REMOTE TELETYPE COMMUNICATIONS
	WUTAPE			;TRANSFER FILE FROM RP04 TO MICRO TAPE
	UINIT			;INITIALIZE MICRO TAPE
	UFDELE			;DELETE FILE ON MICRO TAPE
	USALV			;CHECK MICRO TAPE

;UTILITY PROGRAM IDENTIFICATION

UTILITY:PFORCE

	PMSG <\DECSYSTEM10 DIAGNOSTIC CONSOLE UTILITY\VERSION >

	MOV #MCNVER,R0
	PNTOCS

	PNTCI
	'.

	MOV #DECVER,R0
	PNTOCS

	PMSG <, MIT VERSION >
	MOV #%FNAM2,R0
	PNTDEC

	PCRLF

	JMP CONSOL		;RETURN TO CONSOLE

.SBTTL	FILE TRANSFER FROM APT10 TO RP04

;COMMAND - TA FILE.EXT
;MUST HAVE PREVIOUSLY SELECTED RP04

TAPT:	NAMEXT 			;SETUP NAME & EXT
	RPFILE 			;LOOKUP FILE ON RP04
	BCS 21$

12$:	MOV #DVBUF,CDADR	;INIT BUFFER POINTER

	SETFLG
	  DEVLC 		;INIT LINE COUNT

	COMENQ 			;REQUEST APT10 SERVICE

	MOV #$INBUF,R0
	MOV #" P,(R0)		;CHANGE COMMAND TO "P"
	INC  R0
	COMCMD 			;TRANSMIT TO ACT10
	BCS 21$			;FILE NOT FOUND

11$:	INC DEVLC		;COUNT LINE
	MOV DEVLC,SWR		;DISPLAY

	MOV #CINBF,R1		;TRANSFER TO DATA BUFFER
	MOV CDADR,R0
1$:	CMP #DVBUF+<256.*2>,R0	;FULL ?
	BEQ 2$			;YES

	MOVB (R1)+,(R0)
	CMPB #LF,(R0)+		;IF LF, END OF LINE
	BNE 1$

	MOV R0,CDADR
	COMACK 			;ACK ACT10
	BCC 11$
	BR 20$

2$:	PUSH <R0,R1>
	MOV #256.,BUFSIZ	;WRITE DATA BLOCK TO RP04
	MOV #FILDSB,R0
	RPWRFL
	BCC 3$
	RPERROR 		;WRITE ERROR

3$:	POP <R1,R0>
	MOV #DVBUF,R0		;REINIT POINTER
	MOV R0,CDADR
	BR 1$

20$:	COMCLR
	JMP $TARP2		;WRITE LAST BLOCK & EOF

21$:	JMP $NONXF

$TARP2:	MOV CDADR,R0
1$:	CLRB (R0)+
	CMP #DVBUF+<256.*2>,R0
	BNE 1$

2$:	MOV CDADR,R0		;COMPUTE WORD COUNT
	SUB #DVBUF,R0
	INC R0
	BIC #1,R0
	SR R0,1
	MOV R0,BUFSIZ		;SET AS BUFFER SIZE
	COM RPEOF		;WRITE END-OF-FILE

	MOV #FILDSB,R0
	RPWRFL 			;WRITE LAST FILE DATA BLOCK
	BCS $TADVR		;ERROR

	JMP $CONSL		;WHEW !, ALL DONE

$TADVR:	RPERROR

.SBTTL	WRITE FILE FROM DECTAPE/FLOPPY TO RP04

;COMMAND - WF FILE.EXT
;MUST HAVE PREVIOUSLY SELECTED DECTAPE OR FLOPPY THEN RP04

WFILE:	NAMEXT 			;SETUP NAME.EXT
	RPFILE 			;LOOK UP FILE ON RP04
	BCS 10$

	TST FLOPPY
	BEQ 20$
	RXFILE 			;LOOKUP FILE ON FLOPPY
	BR 21$
20$:	DTAFILE 		;LOOKUP FILE ON DECTAPE
21$:	BCS 10$

	MOV #DTBUF1,R4		;USE THIS FOR DISK BUFFER
	MOV R4,BUFADR
	MOV #DVBUF+2,R5		;DECTAPE/FLOPPY BUFFER
	TST FLOPPY
	BEQ 30$
	RXRDFL 			;READ FIRST BLOCK FROM FLOPPY
	BR 31$
30$:	DTRDFL 			;READ FIRST BLOCK FROM DECTAPE
31$:	 BCS 11$		;EOF, SHOULDN'T HAPPEN

1$:	CMP #DTBUF1+<256.*2>,R4
	BEQ 2$			;DISK BUFFER FILLED

	CMP #DVBUF+<256.*2>,R5
	BEQ 3$			;DECTAPE BUFFER EMPTY

	MOV (R5)+,(R4)+		;MOVE DTA DATA TO DISK
	BR 1$

2$:	MOV #FILDSB,R0
	RPWRFL 			;WRITE DATA BLOCK TO RP04
	 BCS 12$		;ERROR

	MOV #DTBUF1,R4
	BR 1$

3$:	TST FLOPPY
	BEQ 40$
	RXRDFL 			;READ FLOPPY BLOCK
	BR 41$
40$:	DTRDFL 			;READ DECTAPE BLOCK
41$:	BCS 4$			;EOF

	MOV #DVBUF+2,R5
	BR 1$

4$:	MOV R4,R3
5$:	CLR (R3)+		;CLEAR REMAINDER OF BUFFER
	CMP #DTBUF1+<256.*2>,R3
	BNE 5$

	SUB #DTBUF1,R4		;COMPUTE WORD COUNT
	SR R4,1
	MOV R4,BUFSIZ		;SET AS BUFFER SIZE
	COM RPEOF		;WRITE RP04 END OF FILE

	MOV #FILDSB,R0
	RPWRFL 			;WRITE EOF
	 BCS 12$
	JMP $CONSL

10$:	JMP $NONXF

11$:	PMSG <?PREMATURE EOF>
	JMP $CNTLC

12$:	RPERROR 		;RP04 ERROR

$NONXF:	PMSG <NON-EX FILE>
	JMP $CNTLC

.SBTTL	WRITE FILE FROM RP04 TO MICRO TAPE

;COMMAND - WU FILE.EXT
;MUST HAVE PREVIOUSLY SELECTED DECTAPE THEN RP04

WUTAPE:	NAMEXT		;SETUP NAME.EXT
	DTAFILE		;FILE ALREADY EXIST?
	BCS 4$
	PMSG <? FILE ALREADY EXISTS ON MICRO TAPE.>
	JMP $CNTLC

4$:	RPFILE		;LOOKUP FILE ON RP04
	BCC WUTAP7
	JMP $NONXF

WUTAP8:	PMSG <? TAPE FULL>
	JMP $CNTLC

WUTAP7:	JSR PC,UGETBM	;GET BIT MAP INTO DTBUF2
	BR WUTAP0

UGETBM:	MOV #104,DTBLK	;GET BIT MAP OFF OF MICRO TAPE
	MOV #DTBUF2,CASAV
	MOV #-256.,WCSAV
	DTREAD
	 BCS 2$		;LOSE
	MOV #DTBUF2,R0
	CMP (R0)+,#0	;VERIFY THAT IT LOOKS LIKE A BIT MAP
	BNE 2$
	CMP (R0)+,#1
	BNE 2$
	CMP (R0)+,#44
	BNE 2$
	CMP (R0)+,#104
	BEQ 3$
2$:	PMSG <BIT MAP SCREWED UP.>
	JMP $CNTLC

3$:	RTS PC

UTBREV:	.BYTE 0,4,2,6,1,5,3,7		;BIT REVERSAL
UTBMSK:	.BYTE 1,2,4,10,20,40,100,200	;BIT MASK

;POS OR NEG BLOCK NUMBER IN R2 CONVERTED TO BIT PNTR IN R2, R3
UTBMP:	CLR R3		;SHIFT 3 BITS FROM R2 TO R3
	TST R2
	BPL 1$
	NEG R2
1$:
.REPT 3
	ASR R2
	ROL R3
.ENDR
	MOVB UTBREV(R3),R3 ;NOW R2 HAS BYTE #, R3 HAS BIT #
	RTS PC

WUTAP0:	CLR R1		;EMPTY DISK BUFFER
	CLR DTBLK	;TAPE FILE NOT STARTED YET
	MOV #6,LBC	;MAX NUMBER OF TURNS AROUND
;DROPS THROUGH
;DROPS IN
;HERE TO REFRESH MICRO TAPE BUFFER
WUTAP1:	MOV DTBLK,LTMP	;PREVIOUS BLOCK
	ADD #6,LTMP	;INC IF FORWARDS, DEC IF BACKWARDS
29$:	MOV LTMP,R2
	BMI 2$		;BRANCH IF RUNNING BACKWARDS
	CMP R2,#1100
	BLOS 3$
1$:	NEG LTMP	;TURN AROUND
	DEC LBC
	BMI WUTAP8	;TOO MANY TURNS AROUND, TAPE FULL
	BR 29$

2$:	CMP R2,#-105
	BLO 1$
3$:	MOV R2,LTMP	;SAVE BLOCK NO
	JSR PC,UTBMP
	BITB UTBMSK(R3),DTBUF2+10(R2)
	BEQ 20$		;FOUND A BLOCK
	INC LTMP	;TRY NEXT BLOCK IN SPECD DIRECTION
	BR 29$

20$:	BISB UTBMSK(R3),DTBUF2+10(R2) ;CLAIM BLOCK
	MOV LTMP,R2		;REGENERATE BLOCK NUMBER
	MOV R2,DVBUF		;LINK PREVIOUS BLOCK TO THIS ONE
	TST DTBLK
	BEQ 21$
	DTWTFL			;WRITE OUT THIS BUFFER
	BCS WUTAP9
	BR 22$

21$:	MOV R2,DTSTRT		;REMEMBER FIRST BLOCK
	CLR DTLNGTH		;AND NUMBER OF BLOCKS
22$:	MOV R2,DTBLK		;SET UP NEW BUFFER
	INC DTLNGTH
	MOV #DVBUF+2,R5
	MOV R5,R2
	MOV #255.,R3
23$:	CLR (R2)+
	DEC R3
	BGT 23$
	BR WUTAP3

;HERE TO REFRESH DISK BUFFER
WUTAP2:	MOV #FILDSB,R0
	MOV #DTBUF1,R4		;DISK BUFFER
	MOV R4,BUFADR
	RPRDFL
	BCC 2$
	CMP #1,R0
	BEQ WUTAP4		;EOF
	RPERROR			;GIVE ERROR MESSAGE

2$:	MOV 2(R0),R1		;BYTE COUNT
	ASR R1			;WORD COUNT

;HERE TO TRANSFER
WUTAP3:	TST R1
	BEQ WUTAP2		;DISK BUFFER EMPTY
	CMP R5,#DVBUF+<256.*2>
	BHIS WUTAP1		;MICRO TAPE BUFFER FULL
	MOV (R4)+,(R5)+	
	DEC R1
	BR WUTAP3

;HERE ON EOF
WUTAP4:	CLR DVBUF		;LAST BLOCK LINKS TO 0
	DTWTFL			;WRITE IT OUT
	BCS WUTAP9
	MOV DTBLK,LTMP		;SAVE LAST BLOCK NUMBER
	MOV #104,DTBLK		;UPDATE BIT MAP
	MOV #DTBUF2,CASAV
	MOV #-256.,WCSAV
	DTWRT
	BCS WUTAP9
	DTINIT			;SEARCH DIRECTORY
10$:	DTRDFL
	BCS 25$			;DIR FULL
	MOV (R0),R0
	MOV #28.,R1
11$:	TST (R0)		;FREE FILE ENTRY?
	BEQ 12$
	ADD #2*9,R0		;NO, ADVANCE TO NEXT
	DEC R1
	BGT 11$
	BR 10$

12$:	ASCR50			;MAKE NAME AND EXT RAD50
	  NAMBF
	  DIRST0
	MOV DIRST0,(R0)+	;SET UP DIR ENTRY
	MOV DIRST1,(R0)+
	MOV DIRST2,(R0)+	;EXT
	CLR (R0)+		;DATE
	CLR (R0)+		;SPARE
	MOV DTSTRT,(R0)+	;START BLOCK
	MOV DTLNGTH,(R0)+	;LENGTH
	MOV LTMP,(R0)+		;END BLOCK
	CLR (R0)+		;SPARE
	DTWTFL			;WRITE UFD BLOCK BACK OUT
	BCS WUTAP9
	JMP $CONSL		;COMMAND EXIT

25$:	PMSG <? DIR FULL>
	JMP $CNTLC

WUTAP9:	PMSG <SCREW>
	JMP $CNTLC

.SBTTL	INITIALIZE MICRO TAPE

;COMMAND - UI

UINIT:	PMSG <ARE YOU SURE YOU WANT TO RE-INITIALIZE MICRO TAPE ON UNIT 0?_>
	TTILIN
	TTIYES
	BCS 69$
	BMI 69$
	PMSG <WOULD YOU LIKE TO FORMAT IT FIRST?_>
	TTILIN
	TTIYES
	BPL 1$
	TTITRM
	JMP UINIT0

69$:	JMP $CNTLC

1$:	PMSG <TURN ON WRITE T&M AND WRITE ALL SWITCHES, HIT RETURN._>
	TTILIN	
	CLR R1			;NO EXTRA BITS
	MOV #13,TCCM		;WRTM GO
	MOV #101101,R0		;55 REVERSE END ZONE
	MOV #4096.,R4
	JSR PC,UMARK1
	MOV #010101,R0		;25 INTERBLOCK SYNC
	MOV #200.,R4
	JSR PC,UMARK1
	MOV #578.,R3		;NUMBER OF BLOCKS TO MAKE
2$:	MOV #UMARKB,R2		;MAKE A BLOCK
3$:	MOV (R2)+,R0		;MARK CODE
	BEQ 4$
	MOV (R2)+,R4		;REPEAT COUNT
	JSR PC,UMARK1
	BR 3$

4$:	DEC R3
	BNE 2$
	MOV #010101,R0		;25 INTERBLOCK SYNC
	MOV #200.,R4
	JSR PC,UMARK1
	MOV #010010,R0		;22 FORWARD END ZONE
	MOV #4096.,R4
	JSR PC,UMARK1
	TSTB TCCM		;WAIT FOR READY
	BPL .-4
	CLR TCCM		;STOP TAPE
;DROPS THROUGH
;DROPS IN
;RUN BACKWARDS AND PUT IN BLOCK NUMBERS
	PMSG <REMOUNT TAPE IF OFF REEL, HIT RETURN._>
	TTILIN
	MOV #DTBUF1,R1		;MAKE TABLE OF COMPLEMENT OBVERSE BLOCK NUMBERS
	MOV #1101,R0		;AS SEEN GOING DOWN TAPE IN REVERSE DIRECTION
UMARK2:	MOV #6,R2		;SIX 3-BIT HUNKS PER WORD
	MOV R0,R3
	CLR R5			;BUILD RESULT IN R5
1$:	CLR R4			;GET NEXT 3 BITS INTO R4
	CLC
	ROR R3
	ROL R4
	ROR R3
	ROL R4
	ROR R3
	ROL R4
	ASL R5
	ASL R5
	ASL R5
	MOVB UMARKX(R4),R4
	BIS R4,R5		;BRING IN COMPLEMENTED OBVERSIFIED BITS
	DEC R2
	BNE 1$
	MOV R5,(R1)+		;STASH RESULTS
	DEC R0
	BPL UMARK2

	MOV #3,R0		;KLUDGE AROUND RIDICULOUSLY WITH LAST BLOCK
	MOV #4002,TCCM		;SEARCH REVERSE	;DON'T BLAME ME, DEC WROTE IT.
UMARK3:	INCB TCCM		;GO
1$:	BIT #TCERR+TCRDY,TCCM
	BEQ 1$
	BMI UMRKR2
	DEC R0			;BACK UP 3 BLOCKS FROM END ZONE
	BNE UMARK3
	MOV #076677,R0		;COMPLEMENT OBVERSE OF 1011 (LAST BLK NO)
	MOV #17,TCCM		;WRITE ALL FORWARD
	TSTB TCCM		;WAIT FOR READY
	BPL .-4
UMRK3A:	BISB #3,TCST		;EXTRA DATA BITS FOR 0 REVERSE
	MOV R0,TCDT		;WRITE LAST BLOCK # FROM HERE TO ENDZONE
	JSR PC,UMRKEZ		;GET TO END ZONE
	BPL UMRK3A		;NOT THERE YET

	MOV #DTBUF1,R3		;-> TABLE OF REVERSE BLOCK NUMBERS
	MOV #UMRK3T,R5		;-> EXTRA BITS TABLE
	MOV #1101,R2		;FORWARD BLOCK NUMBER
	MOV #4017,TCCM		;WRITEALL REVERSE
UMRK3B:	DEC R2			;DECREMENT BLOCK NUMBER
	CMP R2,#-2
	BEQ UMARK4		;ALL BLOCKS DONE
	MOV #-1,R0
	MOV #260.,R4		;WRITE 260. MINUS ONES TO FILL BLOCK
	MOV #3,R1		;18-BIT MINUS ONE (= ZERO IN FWD DIRECTION)
	JSR PC,UMARK1
	MOVB (R5)+,R1		;WRITE 18-BIT FORWARD BLOCK NUMBER OF THAT BLOCK
	MOV (R3)+,R0		;WHICH COMES FROM COMPLEMENT OBVERSE TABLES
	MOV #1,R4
	JSR PC,UMARK1
	CMP R5,#UMRK3T+10	;WRAP AROUND EXTRA BITS TABLE
	BNE 2$
	 MOV #UMRK3T,R5
2$:	MOV #3,R1		;WRITE TWO MORE MINUS ONES
	MOV #-1,R0
	MOV #2,R4
	JSR PC,UMARK1
	CLR R1			;WRITE THE REVERSE BLOCK NUMBER
	MOV R2,R0		; OF PRECEDING BLOCK
	MOV #1,R4
	JSR PC,UMARK1
	MOV #3,R1		;WRITE TWO MORE MINUS ONES
	MOV #-1,R0
	MOV #2,R4
	JSR PC,UMARK1
	BR UMRK3B		;DO MORE BLOCKS

;READ IN FORWARD DIRECTION AND CHECK
UMARK4:	BIT #TCERR+TCRDY,TCCM	;WAIT FOR WRITE ALL TO FINISH
	BEQ UMARK4
UMRKR2:	BMI UMRKR1		;SHOULDN'T BE TO ENDZONE YET OR ANYTHING
	MOVB #3,TCCM		;NOW REWIND INTO THE ENDZONE
1$:	JSR PC,UMRKEZ
	BPL 1$
	CLR TCCM		;STOP TAPE
	CLR R5			;START WITH BLOCK ZERO
UMRK4A:	MOVB #3,TCCM		;SEARCH FORWARD
1$:	BIT #TCERR+TCRDY,TCCM	;WAIT FOR ERROR OR READY
	BEQ 1$
	BMI UMRKR1
	MOV TCDT,R0		;GET BLOCK NUMBER
	CMP R5,R0		;IS BLOCK NUMBER CORRECT
	BEQ UMRK4B		;YES
	CLR TCCM		;NO, STOP TAPE
	PNTOCT
	PCOMMA
	MOV R5,R0
	PNTOCT
	PMSG < BLOCK NUMBER FAILS TO MATCH.>
	JMP $CNTLC

UMRK4B:	MOVB #7,TCCM		;READ ALL
	MOV #257.,R4		;READ REVERSE CHECKSUM AND DATA
1$:	BIT #TCERR+TCRDY,TCCM
	BEQ 1$
	BMI UMRKR1
	TST TCDT		;SHOULD BE ZERO
	BEQ 2$
	CLR TCCM		;STOP TAPE
	PMSG <BLOCK _>
	MOV R5,R0
	PNTOCT
	PCOMMA
	MOV TCDT,R0
	PNTOCT
	PMSG < ARE BITS THAT SHOULD BE ZERO.>
	JMP $CNTLC

2$:	DEC R4
	BNE 1$			;MORE IN BLOCK
	INC R5			;NEXT BLOCK
	CMP R5,#1102
	BLO UMRK4A		;DO NEXT BLOCK

	MOVB #3,TCCM		;FIND FORWARD ENDZONE
	JSR PC,UMRKEZ
	BMI UMARK5
	PMSG <BLOCKS AFTER 1101.>
	JMP $CNTLC

;ZERO THE TAPE IN REVERSE TO GET GOOD CHECKSUMS, ALSO TO REWIND IT.
UMARK5:	MOV #1101,R5		;FIRST REVERSE BLOCK
	MOV #4000,TCCM		;SET TAPE TO REVERSE
	MOV #DTBUF1,R0		;CLEAR BLOCK BUFFER
1$:	CLR (R0)+
	CMP R0,#DTBUF1+1000
	BLO 1$
UMRK5A:	MOVB #3,TCCM		;SEARCH REVERSE
1$:	BIT #TCERR+TCRDY,TCCM	;WAIT FOR ERROR OR READY
	BEQ 1$
UMRKR1:	BMI UMRKER
	MOV TCDT,R0		;GET REVERSE BLOCK NUMBER
	CMP R5,R0		;IS BLOCK NUMBER CORRECT
	BEQ UMRK5B		;YES
	CLR TCCM		;NO, STOP TAPE
	PNTOCT
	PCOMMA
	MOV R5,R0
	PNTOCT
	PMSG < REVERSE BLOCK NUMBER FAILS TO MATCH.>
	JMP $CNTLC

UMRK5B:	MOV #-400,TCWC		;WRITE 1 BLOCK
	MOV #DTBUF1,TCBA	;OF ZEROS
	MOVB #15,TCCM		;WRITE DATA
1$:	BIT #TCERR+TCRDY,TCCM	;WAIT FOR ERROR OR READY
	BEQ 1$
	BMI UMRKER
	DEC R5			;PREV BLOCK
	BPL UMRK5A		;MORE BLOCKS ON TAPE
	CLR TCCM
	PMSG <TURN OFF WRITE ALL AND T&M SWITCHES, HIT RETURN._>
	TTILIN
	JMP UINIT0		;DO NORMAL UINIT

UMRK3T:	.BYTE 3,3,0,0,1,1,2,2	;IT'S MAGIC.

UMARKX:	.BYTE 7,3,5,1,6,2,4,0	;MORE MAGIC.

;TABLE OF MARK TRACK CODES AND REPEAT FACTORS TO MAKE A BLOCK
UMARKB:	.WORD 010101,1	;25 INTERBLOCK SYNC
	.WORD 010110,1	;26 FORWARD BLOCK MARK
	.WORD 011010,1	;32 REVERSE GUARD
	.WORD 001000,4	;10 REVERSE LOCK, PARITY, FINAL, PREFINAL
	.WORD 111000,374 ;70 DATA
	.WORD 111011,4	;73 FORWARD PREFINAL, FINAL, PARITY, LOCK
	.WORD 101001,1	;51 FORWARD GUARD
	.WORD 100101,1	;45 REVERSE BLOCK MARK
	.WORD 010101,1	;25 INTERBLOCK SYNC
	.WORD 0		;TERMINATE

;MICRO TAPE SPECIAL WRITE ROUTINE
;WRITE C(R0), C(R4) TIMES, WITH EXTRA BITS FROM C(R1).
UMARK1:	BIT #TCERR+TCRDY,TCCM
	BEQ UMARK1
	BMI UMRKER
	MOVB R1,TCST
	MOV R0,TCDT
	DEC R4
	BNE UMARK1
	RTS PC

;WAIT FOR READY OR ENDZONE, RETURNS WITN 'N' BIT SET IF ENDZONE
UMRKEZ:	BIT #TCERR+TCRDY,TCCM
	BEQ UMRKEZ
	BMI 10$
5$:	RTS PC			;READY

10$:	TST TCST		;ERROR, SEE IF ENDZONE
	BMI 5$			;YES
				;NO, DROP INTO ERROR ROUTINE
;ERROR WHILE MARKING UTAPE
UMRKER:	MOV TCST,R0
	CLR TCCM		;STOP TAPE
	PNTOCT
	PMSG < MICRO TAPE ERROR STATUS.  YOU LOSE.>
	JMP $CNTLC

UINIT0:	CLR DTUNIT		;ALWAYS DOES UNIT 0
	MOV #DTBUF1,R0
	MOV #256.*5,R1
1$:	CLR (R0)+
	DEC R1
	BGT 1$

	MOV #DTBUF1,R0	;100 ROOT BLOCK
	MOV #101,(R0)+	;MFD BLK NUM
	MOV #4,(R0)+	;MFD WORDS PER ENTRY
	MOV #104,(R0)	;FIRST BIT MAP BLOCK NUM
	MOV (R0)+,(R0)+	;LAST BIT MAP BLOCK NUM

	MOV #DTBUF1+1000,R0 ;101 MFD
	CLR (R0)+	;ONE BLOCK LONG
	MOV #401,(R0)+	;[1,1]
	MOV #102,(R0)+	;UFD BLK NUM
	MOV #11,(R0)+	;UFD WDS PER ENTRY

	MOV #DTBUF1+2000,R0 ;102 UFD BLK 1
	MOV #103,(R0)	;LINK TO NEXT (103 + UFD BLK 2)

	MOV #DTBUF1+4000,R0 ;104 BIT MAP
	CLR (R0)+	;ONE BLOCK LONG
	MOV #1,(R0)+	;FIRST MAP BLK
	MOV #44,(R0)+	;THIS LONG
	MOV #104,(R0)+	;CHECK
	MOV #10,R1	;MARK OFF BLOCKS 0-77 FOR BOOTSTRAPS ETC.
3$:	MOVB #-1,(R0)+
	DEC R1
	BNE 3$
	MOV #37,(R0)	;MARK OFF BLOCKS 100-104 FOR DIRECTORIES
	ADD #100,R0	;ADVANCE BM PNTR TO BLOCK 1100
	MOV #400-110-4,R1
2$:	MOV #-1,(R0)+	;MARK OFF REST OF BIT MAP
	DEC R1
	BGT 2$

	MOV #100,DTBLK	;WRITE IT ALL OUT
	MOV #DTBUF1,CASAV
	MOV #-5*256.,WCSAV
	DTWRT
	MOV #"TC,NAMBF		;GET BOOTSTRAP PROG FROM DISK
	MOV #"MO,NAMBF+2
	MOV #"N ,NAMBF+4
	MOV #"AB,EXTBF
	MOV #"S ,EXTBF+2
	RPFILE
	 BCS 69$
	MOV #DTBUF1,BUFADR	;GET FIRST 8 BLOCKS
	MOV #8*256.,BUFSIZ
	MOV #FILDSB,R0
	RPRDFL
	 BCS 69$
	CLR DTBLK		;WRITE READIN BLOCK
	MOV #DTBUF1,CASAV
	MOV #-256.,WCSAV
	DTWRT
	MOV #30,DTBLK		;WRITE TCMON
	MOV #DTBUF1,CASAV
	MOV #-8*256.,WCSAV
	DTWRT
.REPT 2				;WRITE REST OF TCMON
	MOV #FILDSB,R0
	RPRDFL
	 BCS 69$
	ADD #10,DTBLK
	DTWRT
.ENDR
	JMP $CONSL

69$:	PMSG <? CANNOT FIND TCMON.ABS ON DISK, BOOTSTRAP NOT WRITTEN.>
	JMP $CNTLC

.SBTTL	DELETE FILE FROM MICRO TAPE

;COMMAND- UD NAME.EXT

UFDELE:	NAMEXT			;GET FILE NAME
	DTINIT 			;DECTAPE INITIALIZATION FOR UFD
UFDEL0:	DTRDFL			;READ UFD DIRECTORY BLOCK
	BCS UFDEL9		;EOF, CAN'T FIND FILE
	MOV (R0),R0		;PUT FIRST BUFFER ADR IN R0
	MOV #28.,R1		;28 ENTRIES IN DIRECTORY
UFDEL1:	MOV R0,LTMP		;SAVE POINTER TO DIR ENTRY
	MOV (R0)+,DIRST0	;STORE RAD50 NAME
	MOV (R0)+,DIRST1
	MOV (R0)+,DTEXT		;STORE RAD50 EXT
	CMP (R0)+,(R0)+		;SKIP 2 WORDS
	MOV (R0)+,DTSTRT	;SAVE STARTING BLOCK #
	MOV (R0)+,DTLNGTH	;SAVE LENGTH
	CMP (R0)+,(R0)+		;MOVE TO NEXT ENTRY
	PUSH <R0,R1>
	R50UPK 			;UNPACK NAME
	 DIRST0,DIRST2
	BCS UFDEL3
	R50UPK
	 DIRST1,DIRST3+1
	BCS UFDEL3
	R50UPK 			;UNPACK EXTENSION
	 DTEXT,DTEXTS
	BCS UFDEL3		;ERROR RETURN

	MOV #NAMBF,R3		;LOAD ADDRESS OF INPUT DATA
	MOV #DIRST2,R4		;LOAD ADDRESS OF TABLE
	MOV #6,R0		;SET COUNT
3$:	CMPB (R3)+,(R4)+	;CHECK NAME DATA
	BNE UFDEL3		;BR IF NOT SAME
	DEC R0			;DONE 6 TIMES ?
	BNE 3$			;BR IF NOT
	MOV #EXTBF,R3		;LOAD ADDRESS OF EXT INPUT
	MOV #DTEXTS,R4		;LOAD ADDRESS OF EXT STOR
	MOV #3,R0		;SET COUNT 3 CHARS
6$:	CMPB (R3)+,(R4)+	;CHECK EXT DATA
	BNE UFDEL3		;BR IF NOT SAME
	DEC R0			;DONE 3 TIMES ?
	BNE 6$			;BR IF NOT
	POP <R1,R0>
	MOV LTMP,R0		;GOT IT, CLEAR IT OUT
	MOV #9,R1
7$:	CLR (R0)+
	DEC R1
	BGT 7$
	DTWTFL			;WRITE UFD BACK OUT
	BCC UFDEL2		;DTSTRT & DTLNGTH SET UP, GO DELETE
UFDEL9:	PMSG <LOSE.>
	JMP $CNTLC

UFDEL3:	POP <R1,R0>
	DEC R1			;BEEN THROUGH 28 ENTRIES ?
	BNE UFDEL1		;NOT YET
	BR UFDEL0		;TRY NEXT UFD BLOCK

UFDEL2:	JSR PC,UGETBM		;GET THE BIT MAP INTO DTBUF2
	MOV DTSTRT,DVBUF	;GROVEL OVER THE FILE
1$:	MOV DVBUF,R2		;RETURN THIS BLOCK
	BEQ UFDEL4		;EOF
	JSR PC,UTBMP		;GET BIT MAP POINTER
	BITB UTBMSK(R3),DTBUF2+10(R2)
	BNE 2$
	PMSG <% BIT ALREADY ZERO>
2$:	BICB UTBMSK(R3),DTBUF2+10(R2)
	DEC DTLNGTH
	DTRDFL			;GET NEXT BLOCK
	BCS UFDEL9
	BR 1$

UFDEL4:	TST DTLNGTH
	BEQ 1$
	PMSG <% FILE NOT RIGHT LENGTH>
1$:	MOV #104,DTBLK		;WRITE OUT BIT MAP
	MOV #DTBUF2,CASAV
	MOV #-256.,WCSAV
	DTWRT
	BCS UFDEL9
	JMP $CONSL

.SBTTL	FLAP MICRO TAPE

;COMMAND - FLAP

UFLAP:	TTICHR
	CMP R0,#'A
	BNE UFDEL9
	TTICHR
	CMP R0,#'P
	BNE UFDEL9
	TTITRM
	BCS UFDEL9

	MOV DTUNIT,R0
	SWAB R0
	BIS #4003,R0		;REVERSE SEARCH
	MOV R0,TCCM
1$:	BIT #TCERR+TCRDY,TCCM
	BEQ 1$
	BMI UFDEL9
	TST TCDT		;BLOCK 0?
	BGT 1$
	BIC #377,R0
	SUB #400,R0		;SOME OTHER TRANSPORT
	BIS #11,R0
	MOV R0,TCCM		;DESELECT SO WON'T SEE END ZONE
	MOV #20.,R0		;WAIT 5 SECONDS TO UNLOAD REEL
2$:	CLR R1
3$:	DEC R1
	BNE 3$
	DEC R0
	BNE 2$
	MOV DTUNIT,R0
	SWAB R0
	BIS #3,R0
	MOV R0,TCCM		;GIVE FORWARD COMMAND TO STOP SPINNING
	CLR R1
4$:	DEC R1
	BNE 4$
	CLR TCCM
	JMP $CONSL

.SBTTL	MICRO TAPE SALVAGER

USALV:	PMSG <CHECKING FILE STRUCTURE ON MICRO TAPE UNIT 0.\>
	PRINTT
	MOV #4003,TCCM		;REWIND UNIT 0
1$:	JSR PC,UMRKEZ
	BPL 1$
	CLR R1			;BLOCK NO
	MOV #DTBUF1,R2		;GET ALL THE LINK WORDS INTO DTBUF1
	MOV #DTBUF3,R3		;AND REVERSE LINK WORDS INTO DTBUF3
USLV0A:	MOV #3,TCCM		;SEARCH FOR BLOCK IN R1
3$:	BIT #TCERR+TCRDY,TCCM
	BEQ 3$
	BMI USLVER
	CMP TCDT,R1
	BEQ USLV0B
	CLR TCCM
	MOV R1,R0
	PNTOCT
	PCOMMA
	MOV TCDT,R0
	PNTOCT
	PMSG < BLOCK NUMBERS FAIL TO MATCH.>
	JMP $CNTLC

USLVER:	PMSG <MACHINE LOSSAGE.>
	JMP $CNTLC

USLV0B:	MOV #-256.,TCWC		;READ ONE BLOCK
	MOV #DTBUF2,TCBA	;INTO DTBUF2
	MOV #5,TCCM
5$:	BIT #TCERR+TCRDY,TCCM
	BEQ 5$
	BMI USLVER
	MOV DTBUF2,(R2)+	;SAVE FORWARD LINK WORD
	MOV DTBUF2+776,(R3)+	;SAVE REVERSE LINK WORD
	INC R1
	CMP R1,#1101
	BLOS USLV0A
	CLR TCCM		;STOP TAPE
USALV0:	JSR PC,UGETBM		;GET BIT MAP INTO DTBUF2
	MOV #DTBUF2+10,R0	;VERIFY THAT BLOCKS 0-104 ARE RESERVED.
	MOV #10,R1
101$:	CMP (R0)+,#-1
	BNE 102$
	DEC R1
	BNE 101$
	MOVB (R0),R0
	BIS #177740,R0
	CMP R0,#-1
	BEQ 103$
102$:	PMSG <BLOCKS 0-104 NOT RESERVED IN BIT MAP.\>
	PRINTT
103$:	MOV #DTBUF2,R0		;SET UP EMPTY BIT MAP AT DTBUF2+1000
104$:	MOV (R0)+,776(R0)
	CMP R0,#DTBUF2+1000
	BLO 104$
	MOV #37,DTBUF2+1020
	MOV #DTBUF2+1022,R0
105$:	CLR (R0)+
	CMP R0,#DTBUF2+1100
	BLO 105$
;DROPS THROUGH
;DROPS IN
	DTINIT			;START READING THE UFD
USALV1:	DTRDFL			;GET BLOCK OF UFD
	 BCS USLV9J		;END OF UFD
	MOV (R0),R0		;GET BUFFER ADDR
	MOV #28.,R1		;28 ENTRIES PER UFD
USALV2:	MOV R0,LTMP		;REMEMBER FILE NAME BLOCK ADDR
	TST (R0)		;FILE NAME PRESENT?
	BEQ USALV8		;NO, ADVANCE TO NEXT ENTRY
	MOV 12(R0),R4		;INITIAL BLOCK
	MOV 14(R0),DTLNGTH	;NUMBER OF BLOCKS
USALV3:	MOV R4,R2
	CMP R2,#1101
	BHI USALVE		;BLOCK NUMBER BAD
	CMP R2,#104
	BHI USLV2A
	PMSG <BLOCK IN RESERVED AREA #_>
	BR USLVE0

USLV2A:	PUSH R2
	MOV R2,LBC		;SAVE PLUS OR MINUS BLOCK
	BPL 1$
	NEG (SP)
1$:	JSR PC,UTBMP		;GET BIT MAP PNTR IN R2, R3
	BITB UTBMSK(R3),DTBUF2+10(R2)
	BNE USLV2B
	PMSG <BIT MAP NOT SET FOR BLOCK #_>
	MOV (SP),R0
	PNTOCT
	JSR PC,USLVE2
USLV2B:	BITB UTBMSK(R3),DTBUF2+1010(R2)
	BNE USALVY
	BISB UTBMSK(R3),DTBUF2+1010(R2)
USLV2C:	POP R2
	ASL R2
	MOV DTBUF1(R2),R4	;LINK TO NEXT
	ASR R2
	DEC DTLNGTH		;DECREMENT BLOCK COUNT
	TST R4			;BLOCK LINKED TO
	BEQ USALV4		;END
	BR USALV3	

USALVY:	PMSG <Y FILE, BLOCK #_>
	BR USLVE0

USALVE:	PMSG <LINK TO NON-EX BLOCK #_>
USLVE0:	MOV R2,R0
	BPL 1$
	NEG R0
1$:	PNTOCT
USLVE1:	MOV #USALV8,-(SP)	;SKIP TO NEXT FILE
USLVE2:	PMSG <, FILE _>
	MOV LTMP,R0
	MOV (R0)+,DIRST0
	MOV (R0)+,DIRST1
	MOV (R0)+,DIRST2
	MOVB #40,DIRST3
	MOV #'\,NAMBF	;DIRST4+2
	R50UPK
	 DIRST2,DIRST3+1
	R50UPK
	 DIRST1,DIRST1+1
	R50UPK
	 DIRST0,DIRST0
	MOV #DIRST0,R0
	PNTAL
	PRINTT
	MOV LTMP,R0
	RTS PC			;USUALLY TO USALV8

USLV9J:	BR USALV9

;HERE AT END OF ONE FILE
USALV4:	TST DTLNGTH
	BEQ 1$
	MOV DTLNGTH,R0
	PNTDEC
	PMSG < EXTRA BLOCKS_>
	JSR PC,USLVE2
1$:	CMP LBC,16(R0)
	BEQ USALV8
	MOV 16(R0),R0
	PNTOCT
	PMSG < CORRECT, _>
	MOV R2,R0
	PNTOCT
	PMSG < ACTUAL ENDING BLOCK NUMBER_>
	BR USLVE1

USALV8:	ADD #9*2,R0		;ADVANCE TO NEXT
	DEC R1
	BGT USALV2
	JMP USALV1

;SCANNED ALL OF UFD, CHECK BIT MAP
USALV9:	CLR R4			;BLOCK NUMBER
USLV9A:	CMP R4,#104
	BLOS USLV9D		;IN RESERVED AREA
	MOV R4,R2
	JSR PC,UTBMP
	BITB UTBMSK(R3),DTBUF2+1010(R2)
	BNE USLV9D		;BLOCK USED
	BITB UTBMSK(R3),DTBUF2+10(R2)
	BEQ USLV9D
	PMSG <BIT MAP NOT CLEAR FOR FREE BLOCK #_>
	MOV R4,R0
	PNTOCT
	PCRLF
	PRINTT
USLV9D:	INC R4
	CMP R4,#1101
	BLOS USLV9A
	PMSG <WRITE OUT BIT MAP? (TYPE RETURN IF OK, ^C IF NOT) _>
	TTILIN
	MOV #104,DTBLK
	MOV #DTBUF2+1000,CASAV
	MOV #-256.,WCSAV
	DTWRT
	JMP $CONSL

.SBTTL	DECTAPE COPY ROUTINE

;COMMAND - COPY
;COPY AND VERIFIES MASTER TAPE ON UNIT 0
;WITH NEW TAPE ON UNIT 1.

DTBUF1=24000			;DON'T CLOBBER DDT (ABOUT 45000-100000)
DTBUF2=DTBUF1+4000
DTBUF3=DTBUF2+4000

DTCOPY:	$PMSG
	  $DTCOPY		;PRINT MESSAGE

1$:	TTALTM 			;WAIT FOR ALTMODE
	 BCC 10$
	CMPB #003,R0
	BNE 1$
	JMP $CNTLC

;FORWARD COPY, COPY 4 BLOCKS, SKIP 4

10$:	PMSG <$\>
	CLR DTBLK		;START WITH BLOCK 0
	MOV #72.,R5		;DO 72 TIMES
	MOV #-1024.,WCSAV	;4 BLOCKS = 1024 WORDS
	MOV #DTBUF1,CASAV	;SETUP BUFFER ADDRESS

2$:	JSR PC,DTRDWT		;READ & WRITE

	ADD #8.,DTBLK		;SKIP 4 BLOCKS
	DEC R5			;DONE 72 TIMES
	BNE 2$			;NOT YET

	MOV #-512.,WCSAV	;DO LAST TWO BLOCKS
	JSR PC,DTRDWT

;REVERSE COPY, SKIPPED BLOCKS READ & WRITTEN IN REVERSE

	MOV #-575.,DTBLK	;START WITH BLOCK 575
	MOV #72.,R5		;DO 72 TIMES
	MOV #-1024.,WCSAV	;4 BLOCKS

3$:	JSR PC,DTRDWT		;READ & WRITE

	ADD #8.,DTBLK		;BACKWARDS SKIP 4 BLOCKS
	DEC R5			;DONE YET ?
	BNE 3$
;DROPS THROUGH
;DROPS IN
;FORWARD VERIFY

	CLR DTBLK
	MOV #72.,R5
	MOV #-1024.,WCSAV

4$:	JSR PC,DTRDCMP		;READ & COMPARE

	ADD #8.,DTBLK
	DEC R5
	BNE 4$

	MOV #-512.,WCSAV
	JSR PC,DTRDCMP		;DO LAST 2 BLOCKS

;REVERSE VERIFY

	MOV #-575.,DTBLK
	MOV #72.,R5
	MOV #-1024.,WCSAV

5$:	JSR PC,DTRDCMP		;READ & COMPARE

	ADD #8.,DTBLK
	DEC R5
	BNE 5$

	PMSG <\COPY COMPLETE>
	JMP $CNTLC

$DTCOPY: .ASCII '\MOUNT MASTER DECTAPE ON UNIT 0.'
	.ASCII '\MOUNT NEW DECTAPE ON UNIT 1.'
	.ASCIZ '\TYPE ALTMODE - _'
	.EVEN


DTRDWT:	CLR DTUNIT		;UNIT 0
	DTREAD 			;READ
	 BCS BAD0
	MOVB #1,DTUNIT+1	;UNIT 1
	DTWRT 			;WRITE
	 BCS BAD1
	RTS PC

DTRDCMP:CLR DTUNIT		;UNIT 0
	MOV #DTBUF1,CASAV
	DTREAD 			;READ
	 BCS BAD0
	MOVB #1,DTUNIT+1	;UNIT 1
	MOV #DTBUF2,CASAV
	DTREAD 			;READ
	 BCS BAD1

	MOV #DTBUF1,R0
	MOV #DTBUF2,R1
	MOV WCSAV,R2

1$:	CMP (R0)+,(R1)+		;COMPARE UNIT 0 WITH UNIT 1
	BNE 2$			;ERROR
	INC R2
	BNE 1$
	RTS PC

2$:	PMSG <\VERIFY ERROR>
DTCOPX:	JMP $CNTLC

BAD0:	PMSG <\BAD MASTER>
	BR DTCOPX

BAD1:	PMSG <\BAD UNIT 1>
	BR DTCOPX

.SBTTL	FLOPPY COPY ROUTINE

;COMMAND - COPY
;COPY AND VERIFIES MASTER FLOPPY ON UNIT 0
;WITH NEW FLOPPY ON UNIT 1.

RXBUF1=30000
RXBUF2=RXBUF1+4000

RXCOPY:	$PMSG
	  $RXCOPY		;PRINT MESSAGE

1$:	TTALTM 			;WAIT FOR ALTMODE
	 BCC 10$
	CMPB #003,R0
	BNE 1$
	JMP $CNTLC

;COPY ONE BLOCK AT A TIME

10$:	PMSG <$\>
	CLR RXBLK		;START WITH BLOCK 0
	MOV #494.,R5		;NUMBER OF READ/WRITES

2$:	CLR RXUNIT		;READ FROM UNIT 0
	MOV #256.,WCSAV		;1 BLOCK = 256 WORDS
	MOV #RXBUF1,CASAV	;SETUP BUFFER ADDRESS

	RXREAD 			;READ FLOPPY
	BCS BAD0

	MOV #RXU1,RXUNIT	;WRITE TO UNIT 1
	MOV #256.,WCSAV
	MOV #RXBUF1,CASAV

	RXWRT 			;WRITE FLOPPY
	BCS BAD1

	INC RXBLK		;INCREMENT BLOCK NUMBER
	DEC R5
	BNE 2$
;DROPS THROUGH
;DROPS IN
;VERIFY 1 BLOCK AT A TIME

	PMSG <STARTING VERIFICATION\>
	CLR RXBLK
	MOV #494.,R5
3$:	CLR RXUNIT
	MOV #256.,WCSAV
	MOV #RXBUF1,CASAV

	RXREAD 			;READ MASTER
	BCS BAD0

	MOV #RXU1,RXUNIT
	MOV #256.,WCSAV
	MOV #RXBUF2,CASAV

	RXREAD 			;READ NEW COPY
	BCS BAD1

	MOV #RXBUF1,R0
	MOV #RXBUF2,R1
	MOV #256.,R2

4$:	CMP (R0)+,(R1)+		;CHECK MASTER AND NEW COPY
	BNE 5$			;DATA ERROR
	DEC R2
	BNE 4$

	INC RXBLK
	DEC R5
	BNE 3$
	PMSG <\COPY COMPLETED>
	JMP $CNTLC

5$:	PMSG <\VERIFY ERROR>
	JMP $CNTLC

$RXCOPY: .ASCII '\MOUNT MASTER FLOPPY ON UNIT 0.'
	.ASCII '\MOUNT NEW FLOPPY ON UNIT 1.'
	.ASCIZ '\TYPE ALTMODE - _'
	.EVEN

.SBTTL	RP04 DIRECTORY ROUTINE

;COMMAND - RP0,DI

DSKDIR:	MOV #FILDSB,R5		;SETUP FILE DESCRIPTOR POINTER
	MOV #RPFDCY,R4		;SETUP DIRECTORY START
	MOV (R4)+,4*2(R5)
	MOV (R4)+,5*2(R5)
	MOV (R4),R0		;CHANGE DIR BLOCK COUNT
	SHIFTL 			;TO WORD COUNT
	  8.
	MOV R0,9.*2(R5)
	CLR 8.*2(R5)

	MOV R5,R4
	ADD #FDESIZ*2,R4
	CLR (R4)+		;CLEAR CURRENT POSITION
	CLR (R4)

	PCRLF
	$PMSG
	  $$RPHDR
	PTAB
	PTAB
	$PMSG
	  $$RPHDR
	PCRLF
	PCRLF
	CLR R1
1$:	MOV R5,R0
	RPRDFL 			;READ DIRECTORY DATA BLOCK
	 BCS 3$

	MOV (R0)+,R4		;DATA BUFFER POSITION
	MOV (R0),R3		;BYTE COUNT

2$:	MOV 0*2(R4),DIRST0	;PICKUP RAD50 "FILE.EXT"
	MOV 1*2(R4),DIRST1
	MOV 2*2(R4),DTEXT
	TST DIRST0		;DON'T PRINT IF BLANK
	BEQ 6$
	CMP #-1,DIRST0
	BEQ 6$
	CMP #-2,DIRST0
	BEQ 6$

	R50UPK 			;CONVERT TO ASCII
	 DIRST0,DIRST2
	  BCS 5$
	R50UPK
	 DIRST1,DIRST3+1
	  BCS 5$
	R50UPK
	 DTEXT,DTEXTS
	  BCS 5$
;DROPS THROUGH
;DROPS IN
	CLR NAMBF
	CLR DTEXT
	CMP #020040,DIRST2	;DON'T PRINT IF SPACES
	BEQ 6$
	$PMSG 			;PRINT "FILE"
	  DIRST2
	PSPACE
	$PMSG 			;PRINT "EXT"
	  DTEXTS
	PTAB
	MOV 6*2(R4),R2
	SWAB R2
	BISB <7*2>+1(R4),R2
	TSTB 7*2(R4)
	BEQ 10$
	INC R2
10$:	MOV R2,R0
	PNTDEC 			;PRINT ALLOCATED BLOCKS
	PTAB
	MOV 8.*2(R4),R2
	SWAB R2
	BISB <9.*2>+1(R4),R2
	TSTB 9.*2(R4)
	BEQ 11$
	INC R2
11$:	MOV R2,R0
	PNTDEC 			;PRINT BLOCKS WRITTEN
	INC R1
	BIT #1,R1
	BEQ 12$
	PTAB
	PTAB
	BR 6$
12$:	PCRLF
6$:	ADD #FDESIZ*2,R4	;FINISHED THIS DIR BLOCK ?
	SUB #FDESIZ*2,R3
	BHI 2$			;NO
	BR 1$			;YES, GO READ NEXT
3$:	CMP #1,R0		;EOF ?
	BNE 4$
	PCRLF
	JMP $CONSL		;YES
4$:	RPERROR 		;NO, ERROR
5$:	MOV #-25,R0		;RAD50 CONVERSION ERROR
	BR 4$

	.BLKW 1			;IN CASE PCNVRT'ING W/O 11STNKING!
$$RPHDR:.ASCIZ \FILE   EXT	ALLOCB	WRTB\
.EVEN

.SBTTL	REMOTE TELETYPE COMMUNICATIONS ROUTINE

TOUTBF==30000 			;OUTPUT BUFFER ADDRESS
TOUTBL==TOUTBF+100.		;OUTPUT BUFFER LIMIT
TINBF==TOUTBL+2			;INPUT BUFFER ADDRESS
TINBL==CONSOL-4			;INPUT BUFFER LIMIT

;CONTROL A RETURNS TO COMMAND LEVEL
;CONTROL L CONTROLS LINE PRINTER

REMOTE:	PNORML
	CLR CONSOL-2		;CLEAR OVERLAY IN-USE INDICATOR
	MOV #TOUTBF,R5		;SETUP TTY TO COMM POINTERS
	MOV R5,R4
	MOV #TINBF,R3		;SETUP COMM TO TTY POINTERS
	MOV R3,R2

TTLP:	TSTB @$TKS		;ANY TTY TYPE-IN ?
	BPL TTLP1		;NO
	MOVB @$TKB,R0		;YES, GET TYPED CHAR
	BIC #200,R0
	CMPB #CNTRLA,R0		;IS IT A CONTROL A ?
	BEQ TTCMD		;YES, RETURN TO COMMAND LEVEL
	CMPB #CNTRLL,R0		;IS IT CONTROL L ?
	BEQ TTLPT		;YES
	MOVB R0,(R5)+		;PUT CHAR IN BUFFER
	CMP #TOUTBL,R5		;REACHED LIMIT ?
	BNE TTLP1		;NO
	MOV #TOUTBF,R5		;YES, RESET INSERTION POINTER

TTLP1:	CMP R4,R5		;INSERTION & SEND POINTERS EQUAL ?
	BEQ TTLP2		;YES, NOTHING TO SEND
	TSTB @$CMTPS		;CAN WE SEND ?
	BPL TTLP2		;NO, NOT THROUGH WITH PREVIOUS CHAR
	MOVB (R4)+,@$CMTPB	;YES, SEND CHAR OUT
	CMP #TOUTBL,R4		;REACHED LIMIT ?
	BNE TTLP2		;NO
	MOV #TOUTBF,R4		;YES, RESET SEND POINTER

TTLP2:	TSTB @$CMTKS		;ANY COMM INPUT ?
	BPL TTLP3		;NO
	MOVB @$CMTKB,(R3)	;YES, STORE CHAR
	BICB #200,(R3)+
	CMP #TINBL,R3		;REACHED LIMIT ?
	BNE TTLP3		;NO
	MOV #TINBF,R3		;YES, RESET COMM INPUT POINTER
;DROPS THROUGH
;DROPS IN
TTLP3:	CMP R2,R3		;COMM INPUT & PRINT POINTERS EQUAL ?
	BEQ TTLP		;YES, NOTHING TO PRINT
	TST LPTFLG		;PRINT ON LPT ?
	BMI 3$			;YES
1$:	TSTB @$TPS		;CAN WE PRINT ?
	BMI TTLP		;NO, NOT YET
	MOVB (R2)+,@$TPB	;YES, PRINT CHAR

2$:	CMP #TINBL,R2		;REACHED LIMIT ?
	BNE TTLP		;NO
	MOV #TINBF,R2		;YES, RESET PRINT POINTER
	BR TTLP

3$:	TSTB LPTFLG		;CONTROL L'ED TO ALLOW LPT ?
	BEQ 1$			;NO
	TST LPTYPE
	BNE 10$
	TSTB @$LPS		;LPT READY ?
	BPL TTLP		;NO
	CMPB (R2),#RUBOUT	;DUMP RUBOUTS
	BEQ 4$
	MOVB (R2)+,@$LPB	;SEND CHAR TO LPT
	BR 2$

4$:	INC R2			;RUBOUT, BYPASS IT
	BR 2$

10$:	MOV LPTYPE,R1		;LP20
	BIT #LPERR!LPPZRO!LPUCHR,(R1) ;ANY ERROR ?
	BNE TTLPT		;YES, TURN OFF LPT
	TSTB (R1)		;LP20 DONE ?
	BPL TTLP
	CMPB (R2),#RUBOUT	;DUMP RUBOUTS
	BEQ 4$
	MOVB (R2)+,$TNCHR	;PUT CHAR IN OUTPUT LOCATION
	MOV #$TNCHR,LPBSAD(R1)
	MOV #-1,LPBCTR(R1)
	MOV #LPGO,(R1)		;PRINT ONE CHARACTER ON LP20
	BR 2$
TTLPT:	COMB LPTFLG		;CONTROL L, COMPLEMENT
	BR TTLP			;ALLOW LPT FLAG

TTCMD:	JMP CONSOL		;RETURN TO COMMAND LEVEL