.TITLE	DFX
	.SBTTL	INTRO PAGE
;	OPERATING INSTRUCTIONS, DFX
;
;	DFX IS AN RSX-11D PROGRAM TO PATCH THE SYSTEM DISK
;	BY ABSOLUTE (LOGICAL) BLOCK NUMBER.
;	IT USES LUN 2 FOR DISK READ AND LUN 4 FOR DISK WRITE
;	THE TASK MUST EITHER BE BUILT PRIVILEGED, OR THE SYSTEM DISK
;	MOUNTED DCF OR FOREIGN TO PERMIT THIS. CONSOLE INPUT WILL BE
;	VIA GET MCR COMMAND LINE.
;
;TASK BUILD THIS WITH SYSLIB, SINCE ITS CONVERSION ROUTINES WILL
;BE USED FOR CONVERSION BETWEEN ASCII AND RAD50 AND OCTAL AND BINARY.
;??
;	NOTE THAT IT IS NOT POSSIBLE TO PATCH A SINGLE BYTE--
;	ONE MUST PATCH AN ENTIRE WORD AT A TIME.
;
	.MCALL	EXIT$S,CSI$,FSRSZ$,QIO$S,QIOW$S,FDAT$A,FDBDF$
	.MCALL	DIR$,QIOW$,FDOP$A,PRINT$
	.MCALL	NMBLK$,FINIT$,OPEN$W,PUT$,CLOSE$
FSRSZ$	3	;UP TO 3 FILES OPEN AT ONCE
	.MCALL	RCML$	;RESET COMMAND LINE FACILITY
; 
;ASSIGN DISK DESIRED TO LUN 2 (INPUT) AND LUN 4 (OUTPUT)
;	LUN 1=TI: FOR GCML
;	LUN 3=TI FOR OUTPUT (INITIALLY)
;	LUN 6=LISTING DEVICE (SY INITIALLY)
;	LUN 5 =TI FOR ERROR MESSAGES
;TASK BUILD (NON-PRIVILEGED VERSION):
;
;DFX/-FP=DSKFIX
;/
;TASK=...DFX
;;TASK NAME SET FOR CALLING IT "DFX" FROM MCR
;LIBR=SYSRES:RO
;ASG=TI:1:3:5	;LUN 5 FOR ERROR MESSAGES
;ASG=TI:6
;;1 FOR COMMANDS, 3 FOR OUTPUT	6 FOR LISTINGS 
;ASG=SY:2	;USE LUN 2 FOR DISK READ
;ASG=XX:4	;USE LUN 4 FOR DISK WRITE BACK
;UNITS=6
;STACK=200
;PRI=45
;//
;
;
;FOR PRIVILEGED TASK BUILD (NOT NEEDING SY: MOUNTED DCF)
;JUST ADD /PR SWITCH TO OUTPUT NAME.

.SBTTL	DIRECTIONS
;
;	...DFX IS AN RSX PROGRAM TO DO ABSOLUTE DISK PATCHES ON
;	ANY DISK. CALLING SEQUENCE IS VIA A 
;
;	MCR>DFX
;
; IN RESPONSE TO ENTER DISK BLOCK # TYPE BLOCK NUMBER IN OCTAL
; OR "E" TO EXIT TO RSX. THE BLOCK WILL BE READ IN AND CAN BE
; DISPLAYED BY THE "L" COMMAND. DISPLAY IS ON LUN 6
;
; NOTE THAT LUN 2 IS USED FOR DISK READS AND LUN 4 FOR DISK WRITES,
; AS A PROTECTIVE MEASURE LUN 4 IS ASSIGNED TO PSEUDO DEVICE XX:
; AND MUST BE RE-ASSIGNED BY THE USER BEFORE RUNNING ...DFX
;
; ALSO NOT THAT LUN 6 IS USED FOR FULL BLOCK LISTINGS. IT IS INITIALLY
; SET TO TI: BUT CAN BE RE-ASSIGNED TO A DISK, AND WILL BE IN THE USERS
; UIC AS "DFX.DAT"
;
; IN RESPONSE TO "DFX>" PROMPT, TYPE
; 
; L TO LIST REFERENCED BLOCK
; W TO WRITE THE CURRENTLY REFERENCED BLOCK BACK ONTO DISK
; N TO READ THE NEXT BLOCK
; R TO REREAD THE CURRENT BLOCK (WIPING OUT ALL CHANGES IN THE CURRENT
; 	BUFFER)
; B TO READ THE PREVIOUS BLOCK
; F FOR FULL-WORD ADDRESSES	(DEFAULTS TO BYTE ADDRESSES)
; H FOR HALF-WORD (BYTE) ADDRESSES IN BLOCK
; T TO TYPE OUT THE BLOCK AS ASCII TEXT
; S TO SET/CLEAR FLAG FOR SPOOLING OUTPUT FILE TO LP
;	IF LUN 6 IS A DISK, THE FILE WILL BE SPOOLED ON EXIT OR WHEN
;	THE SPOOLING FLAG IS CLEARED BY THE OPERATOR
; E TO EXIT TO THE MONITOR
; K TO CALCULATE CHECKSUM OF FIRST 255. WORDS OF BLOCK (FILE HEADERS ETC)
; 
;		THERE ARE 4 M(ODIFY) TYPE COMMANDS, WHERE 
;		M=THE BYTE OFFSET OF THE BUFFER WORD TO BE LISTED/MODIFIED
; M/000000	CHANGE BUFFER WORD TO THE OCTAL VALUE 000000
; M,LLL		CHANGE BUFFER WORD TO RAD50 VALUE OF "LLL"
; M;AA		CHANGE BUFFER WORD TO ASCII VALUE OF "AA"
; M:		DISPLAY BUFFER WORD IN OCTAL, RAD50 AND ASCII
;	NOTE THAT FOR M COMMANDS, M MUST BE EVEN, 0 <= M < 1000
;
; 
; D,N TO CHANGE DEFAULT BLOCK NUMBER FOR READ AND WRITE TO N
;	WITHOUT CHANGING THE CONTENTS OF THE BUFFER IN CORE. THIS SHOULD
;	PERMIT MOVING DATA FROM ONE BLOCK TO ANOTHER.
; A,N TO READ AND LIST BLOCK N (N ABSENT IMPLIES NEXT BLOCK
; C,N TO READ AND LIST ALL BLOCKS UP TO AND INCLUDING BLOCK N.
; 	(N ABSENT IMPLIES TO END OF DISK.)
; P,N CHANGES THE HIGH-ORDER BLOCK NUMBER FROM THE DISK.
;	NO I/O WILL BE DONE, BUT THE BLOCK NUMBER WILL BE COPIED
;	FROM THE HIGH-ORDER AND LOW-ORDER BLOCKS TO RELATIVE
;	WORDS 400 AND 401 (BYTES 1000 AND 1002) JUST PAST THE I/O BUFFER
;	WHERE THE SINGLE-WORD EXAMINING COMMANDS CAN SEE THEM.

.SBTTL	DATA AREAS
	.IDENT	/V6A.GE/;7/27/76 G. EVERHART
VERS="06
CR=15
LF=12
HASH='#
DWDC=256.
MAXBLK=48300.
STR:	.ASCII	$/,;:CADPWLNERBXS$
	.ASCII	/T/	;TYPE BUFFER
	.ASCII	/FH/	;FULL OR HALFWORD ADDRESSES IN NUMBERING
	.ASCII	/K/	;CALCULATE CHECKSUM
;		;D,NNNNNN WILL RESET BLOCK NUMBER BUT NOT
			;ALTER DATA IN CORE. THIS WILL PERMIT MOVING
			;BLOCKS TO OTHER PARTS OF THE DISK.
			;P WILL SET THE HIGH-ORDER BLOCK NUMBER 
;			;WHEN A P,NNNNNN COMMAND IS GIVEN.

	.EVEN
BYTFLG:	.WORD	2	;DEFAULT TO BYTE ADDRESSING MODE
LPFLG:	.WORD	0	;FLAG FOR SPOOL TO LP
CONT:	0
MODIF:	0
NOPRT:	0
	0
;
DLB:	.BYTE	3,11.	;QIOW$
DFCT:	.WORD	IO.RLB		;INITIALLY A READ
	.WORD	2	;LUN 2
	.BYTE	3,100	;FLAG 3, PRI 100
	.WORD	DT.STT	;STATUS RETURN (2-WORD BLK)
	.WORD	0	;NO AST
	.WORD	INBUF	;DATA AREA ADDRESS
	.WORD	DWDC+DWDC	;SIZE IN BYTES
	.WORD	0	;NEEDED FOR RSX SOMEHOW
	.WORD	0	;HIGH ORDER BLK #--NOT USED HERE
DBLKN:	.WORD	01000	;BLK # (LOW ORDER ACTUALLY.)
DT.STT:	.BLKW	2	;STATUS RETURN AREA
;
;CHANGED TO USE FCS WRITES SO CAN GO TO LP OR FILE
;FOR OUTPUT ON LUN 3
;TI DPB SAVED IN CASE
TILB:	.BYTE	3,.$ARG
	.WORD	IO.WLB
	.WORD	3	;LUN 3, WRITE
	.WORD	9.	;EFN 9
	.WORD	TT.STT	;STATUS BLK
	.WORD	0	;NO AST
TIBUF:	.WORD	0	;BUFFER ADDRESS
TIWC:	.WORD	0	;LENGTH IN BYTES
	.WORD	40	;CARRIAGE CONTROL
.$ARG=9.	;SIZE OF DPB
	.MCALL	FCSBT$
FCSBT$;FCS BIT NAMES
FDB:	FDBDF$		;FDB FOR LISTINGS
	FDAT$A	R.VAR,FD.CR
	FDOP$A	6,,NAME
;
NAME:	NMBLK$	DFX,DAT	;FILE DFX.DAT IF TO DISK LISTING
;
;
	.WORD	5015	;CRLF FOR THE T COMMAND
INBUF:	.=.+DWDC+DWDC
HBCPY:	.WORD	0	;HIGH/ORDER BLOCK #
LBCPY:	.WORD	0	;LOW/ORDER BLOCK #

	0
	0
CSI$
CSBLK:	.BLKB	C.SIZE
	.EVEN
TT.STT:
	.MCALL	GCMLB$,GCML$
TI.STT:	.BLKW	2
CMD:	GCMLB$	2,DFX,,1	;LUN 1 COMMAND BLK FOR INPUT CONTROL
	.MCALL	GCMLD$
GCMLD$
GETNUM:	.ASCII	<15><12>/DFX V06--WHAT IS INITIAL OCTAL BLK NO? >/
GETNUL=.-GETNUM
.EVEN

KBLH:	80.,0,0
	.=.+80.
CMOBUF:	.WORD	0,4,0
CORADR:	.WORD	0	;CORE ADDR DUMP MODE DUMMY BUFHDR

.PAGE
.SBTTL	INIT CODE
DKPEEK:
	FINIT$	;INIT FCS REGION
	GCML$	#CMD,#GETNUM,#GETNUL	;ASK HIM FOR BLK NUMBER
	BCC	SETMOR
SCRAM:	JMP	END		;GO TO END CODE
SETMOR:
	MOV	#DWDC,R0
	MOV	R0,DWCL2+2	;STASH IN LITERALS
	ASL	R0	;GET BYTE COUNT
	MOV	R0,DATSIZ	;PREPARE TYPEOUT SIZE
	MOV	#CONT,R0
	CLR	(R0)+
	CLR	(R0)+
	CLR	(R0)+

	MOV	CMD+G.CMLD+2,R0	;STRING ADDR
	MOV	CMD+G.CMLD,R1
	CMP	R1,#1		;MUST HAVE AT LEAST 1 CHARACTER
	BLT	SCRAM	;ONLY CONTINUE IF HE REPLIES!
	JSR	PC,$COTB	;CONVERT OCTAL BLK #
	MOV	R1,DBLKN	;PUT BLK # IN QIOW$ DPB
	MOV	SP,(PC)+	;SAVE SP POSITION
SPSAVE:	.WORD	0
READ:	JSR R5,BREAD
	TST	DT.STT		;CHECK ERRORS
	BMI	SCRAM		;JUST EXIT IF ANY OCCUR
	CLR MODIF
	BR	PAST		;LIST ONLY WHEN TOLD TO.
LIST:	MOV #KBLH+6,R1	;DES
	MOV (PC)+,(R1)+
	.BYTE 'B,'L
	MOV (PC)+,(R1)+
	.BYTE 'K,' ;

	MOV	R1,-(SP)
	MOV	R0,-(SP)
	MOV	R2,-(SP)	;SAVE REGS USED BY SYSRES
	MOV	R1,R0	;OUTPUT ADDRESS
	MOV	DBLKN,R1	;BLK #
	MOV	#1,R2	;LEAVE LEADING 0'S IN
	JSR	PC,$CBOMG	;CONVERT TO ASCII OCTAL
	MOV	(SP)+,R2
	MOV	(SP)+,R0
	MOV	(SP)+,R1	;RESTORE REGS
	TST	HBCPY		;2 WORD BLOCK # ?
	BEQ	111$		;NO
	MOV	R0,-(SP)	;SAVE REG
	MOV	HBCPY,R0	;GET NUMBER
	ASL	R0		;MUL BY 2
	BISB	R0,(R1)		;CHANGE MOST SIG DIGIT SO HAVE FULL 6 DIG BL #
	MOV	(SP)+,R0	;RESTORE
111$:
;*******+++++++
	ADD #8.,R1
	JSR R5,WRIFCS	;WRITE BLOCK #
	MOV #INBUF,R0	;SRC
DWCL2:	MOV #DWDC,R2	;LIMIT
NEXT:	MOV #KBLH+20,R1	;DES
	MOV	R3,-(SP)
	MOV	R0,R3	;GET ADDRESS
	SUB	#INBUF,R3
	TST	BYTFLG	;ARE WE ADDRESSING IN WORDS OR BYTES?
	BNE	11$		;BYTES; R3 IS OK NOW
;	ASR	R3		;WORDS  PATCH BY FB
				;SO LOOKS LIKE DUMP, ETC
11$:
	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	R2,-(SP)	;CONVERT OCTAL TO ASCII
	MOV	#KBLH+10,R0	;OUTPUT ADR
	MOV	R3,R1	;NUMBER
	MOV	#1,R2	;LEAVE IN 0'S
	JSR	PC,$CBOMG	;GET OCTAL
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0	;PUT REGS BACK
	CLR	KBLH+10		;REMOVE 1ST 2 ZEROES
	MOV	#": ,KBLH+16	;PUT IN COLON TOO.
	MOV	(SP)+,R3	;RESTORE R3
	MOV #4000,R4
NA:	ASL R4
	BLE NW
	JSR R5,CONENT
	DEC R2
	BGT NA
NW:	JSR R5,WRIFCS
	TST R2
	BGT NEXT
NZ:	TST CONT
	BLE PAST
	CMP DBLKN,CONT
	BGE PAST-4
	INC DBLKN
	JMP READ
	CLR CONT
PAST:
	MOV	DBLKN,LBCPY	;SAVE BLOCK #
	MOV	DBLKN-2,HBCPY	;FOR USER TO EXAMINE
	MOV	SPSAVE,SP	;KEEP RESETTING STACK SO WE STAY OK
	JSR R5,KBREAD
	MOV #STR,R1	;STRING POINTER
	CLR	-(SP)	;RESERVE CELL FOR ADDR OF NEXT BYTE
	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	R2,-(SP)	;GET CODE ADDR FROM TYPE-IN
	JSR	PC,$COTB	;R0 ALREADY POINTS AT ASCII
	CMPB	R2,#60	;CHECK THAT WE GOT A NUMBER
	BLT	20$	;NOT #
	CMPB	R2,#67
	BGT	20$	;NOT OCTAL, ANYHOW
	BR	30$
20$:	DEC	R0	;BACK "LAST CHAR" UP AGAIN
30$:
	MOV	R0,6(SP)	;SAVE ADDR OF NEXT BYTE OF TEXT
	MOV	R1,R3		;GET RELATIVE WORD IN R3
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	TST	BYTFLG	;USING BYTE ADDRESSES?
	BNE	10$
	ASL R3
10$:	BIC	#1,R3	;ENSURE R3 IS EVEN
	MOV (SP),R2
	CMPB (R2),(R1)+
	BEQ POCT
	CMPB (R2),(R1)+
	BEQ PRAD
	CMPB (R2),(R1)+
	BEQ PASC
	CMPB	(R2),(R1)+	;NNN:  TO LIST WORD NNN
	BEQ	PDSPL		;NNN=WORD INDEX,OCTAL START AT 0
	CMPB (R2),(R1)+
	BNE	444$		;CHANGED SINCE BRANCH FAILED
	JMP	PNEXT
444$:	CMPB (R2),(R1)+
	BEQ PADVV
	CMPB	(R2),(R1)+	;D,N TO CHANGE BLK # AND LEAVE DATA?
	BEQ	PCNTTV		;YUP. GO DO IT.
	CMPB	(R2),(R1)+	;P,NNNNNN TO SET H/O BLK NUMBER?
	BEQ	PLSTV
	;NOTE THAT ALL REQUESTS NEEDING INFORMATION LATER
	;IN THE STRING MUST BE ABOVE THIS POINT.
	TST (SP)+
	CMPB (R2),(R1)+
	BEQ PWRI
	CMPB (R2),(R1)+
	BEQ LISTV
	CMPB (R2),(R1)+
	BEQ PNXT
	CMPB (R2),(R1)+
	BEQ ENDV
	CMPB (R2),(R1)+
	BEQ READV
	CMPB (R2),(R1)+
	BEQ PBAKV
	CMPB (R2),(R1)+
	BEQ PLNKV
	CMPB	(R2),(R1)+	;CHANGE SPOOLFLAG ?
	BEQ	SPOOL
	CMPB	(R2),(R1)+	;TYPE?
	BEQ	TYPTFV		;YES, GO TO IT
	CMPB	(R2),(R1)+	;FULLWORD ADDR NUMBERS?
	BEQ	FULSTV		;YES
	CMPB	(R2),(R1)+	;BYTE ADDR NUMBERS?
	BEQ	HALFTV
	CMPB	(R2),(R1)+	;CALC CHECKSUM ?
	BEQ	CKSTV
	JMP	PAST
PCNTTV:	JMP	PRCNT	;HANDLE BLK # CHANGE
PLSTV:	JMP	PLUSV	;SERVICE P,N REQ
LISTV:	JMP	LIST
PADVV:	JMP	PADV
ENDV:	JMP	END
READV:	JMP	READ
PBAKV:	JMP	PBAK
PLNKV:	JMP	PLNK	;TRANSFER VECTORS
TYPTFV:	JMP	TYPBLK
FULSTV:	JMP	FULLAD
HALFTV:	JMP	HALFAD
PDSPL:	JMP	PDSPLY
SPOOL:	JMP	SPFLAG
CKSTV:	JMP	CKSUM
POCT:	INC (SP)	;OVER DELIMITER
	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	6(SP),R0	;ADDR OF OCTAL ASCII
	JSR	PC,$COTB
	MOV	R1,6(SP)	;PUT CONVERTED # ON STACK
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0	;RESTORE REGS LIKE GOOD GUY.
PPUT:	MOV (SP)+,INBUF(R3)	;MODIFY BUFFER
	INC MODIF
	JMP	PAST

PRAD:	INC (SP)
	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	R2,-(SP)	;SAVE REGS USED
	MOV	6(SP),R0	;ASCII ADDR
	MOV	#2,R1		;PERIOD IS LEGAL RAD50
	JSR	PC,$CAT5	;CONVERT IT
	MOV	R1,6(SP)	;PUT ON STACK
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0

	BR PPUT

PASC:	INC (SP)
	MOV (SP)+,R4
	MOVB (R4)+,INBUF(R3)
	MOVB (R4),INBUF+1(R3)
	BR PPUT+4
PNXT:	INC DBLKN
	JMP READ

PWRI:	JSR R5,BWRIT
	JMP	PAST
.PAGE
;*********************DISK READ/WRITE SUBS
BREAD:
	MOV	#IO.RLB,DFCT	;SET READ FUNCTION
BGO:;	CMP DBLKN,#MAXBLK
;	BHIS	BERR
	MOV	#DLB,-(SP)	;NOW DO THE QIO
	EMT	377
	MOV	#2,DFCT+2	;RESET LUN TO 2 AFTER POSSIBLE WRITE
	TSTB	DT.STT	;CHECK RTN STATUS CODE
	BMI	BERR	;NEGATIVE IS AN ERROR
  	CLR (SP)
	RTS R5
BERR:	MOV #1,(SP)	; R5 WILL CONTAIN ERROR CODE
	MOV	R0,-(SP) 	;SAVE REGS
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOVB	DT.STT,R1	;GET ERROR CODE
	MOV	#MESP,R0	;POINT TO ASCII BUFFER
	MOV	#"  ,(R0)+	;BLANK OUT PREV CODE
	MOV	#"  ,(R0)+
	MOV	#"  ,(R0)+
	MOV	#MESP,R0	;AND RESET POINTER
	CLR	R2		;SUPRESS LEADING 0'S
	JSR	PC,$CBDSG	;CONVERT ERROR TO ASCII
	DIR$	#MSGQIO		;WRITE MESSAGE
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RTS R5
BWRIT:	MOV	#IO.WLB,DFCT	;SET WRITE
	MOV	#4,DFCT+2	;SET LUN 4 FOR WRITE
;	TST MODIF		;ALWAYS WRITE BACK EVEN IF BLOCK NOT CHANGED
;	BEQ BERR-4
	BR BGO
PWRIB:	JMP READ
;ADDED DPB AND MESSAGE FOR ERRORS
;
MSGQIO:	QIOW$	IO.WVB,5,1,,,,<MES,MESL,40>
MES:	.ASCII	?DISK READ/WRITE ERROR --- RETURNED STATUS = ?
	.EVEN
MESP:	.ASCII	/        /
	MESL=.-MES
	.EVEN
.PAGE
PNEXT:	MOV #77777,CONT
	INC (SP)
	CMPB @(SP),#CR
	BEQ PNXT+6
;O2BIN
	INC (SP)
	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	R2,-(SP)	;NOW GET BLK #
	MOV	6(SP),R0	;FROM ASCII
	JSR	PC,$COTB
	CMPB	R2,#60
	BLT	20$
	CMPB	R2,#67	;CHECK # FOUND
	BGT	20$
	BR	30$
20$:	DEC	R0
30$:
	MOV	R1,CONT		;SAVE RESULT
	MOV	R0,6(SP)	;ALSO NEXT BYTE
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	JMP READ
PADV:	INC (SP)
	CMPB @(SP),#CR
;	BEQ PNXT		;OUT OF BRANCH RANGE
	BNE	555$
	JMP	PNXT
555$:	INC (SP)
	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	R2,-(SP)
	MOV	6(SP),R0	;GET ADVANCE BLOCK NUMBER
	JSR	PC,$COTB
	CMPB	R2,#60
	BLT	20$
	CMPB	R2,#67	;CHECK # FOUND
	BGT	20$
	BR	30$
20$:	DEC	R0
30$:
	MOV	R1,DBLKN	;SAVE BLK # IN DPB
	MOV	R0,6(SP)	;AND NEXT BYTE ADDR
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	JMP READ
PBAK:	DEC DBLKN
	BGE PBAK-4
	CLR DBLKN
	BR PBAK-4
PLNK:	MOV INBUF,DBLKN
	BR PBAK-4
END:	TST	FDB;F.BDB	;IS FILE OPEN ?
	BEQ	END1		;NO
	TST	LPFLG		;SPOOL TO LP
	BEQ	ENDA		;NO
	PRINT$	#FDB		;SPOOL LISTING
	BR	ENDA		;SPOOL CLOSES THE FILE
ENDA:	CLOSE$	#FDB		;CLOSE OPEN LISTING FILE
END1:	EXIT$S		;AND QUIT

PDSPLY:
	MOV	#INBUF,R0	;DATA TO DISPLAY
	ADD	R3,R0		;ADDR TO DISPLAY
	TST	(SP)+		;FORGET WHERE THIS CAME FROM
	MOV	#5015,KBLH+6	;PUT CRLF IN FIRST
	MOV	#KBLH+10,R1	;PUT DATA IN KBLH AREA
	INC	R1
	JSR	R5,CONENT	;CONVERT TO DISPLAY FORMAT (1 WD)
	JSR	R5,WRITE	;TYPE IT
	JMP	PAST		;GET NEXT COMMAND.

WRITE:	SUB #KBLH+6,R1
	MOV R1,KBLH+4
	MOV #KBLH+4,-(SP)
	JSR R5,TTYM
	JSR R5,CLEAR
	RTS R5

;SUB TO WRITE USING FCS
WRIFCS:	SUB #KBLH+6,R1
	MOV R1,KBLH+4
	MOV #KBLH+4,-(SP)
	JSR R5,TTYFCS
	JSR R5,CLEAR
	RTS	R5
;
;
CLEAR:	MOV #KBLH+6,R4
	MOV KBLH,-(SP)
	ADD R4,(SP)
CL:	MOVB #' ,(R4)+
	CMP R4,(SP)
	BLT CL
	TST (SP)+
	RTS R5


SPFLAG:	TST	LPFLG	;IS FLAG SET
	BNE	222$	;IF SET ---  BRANCH
	INC	LPFLG	;IF CLEAR THEN SET IT
	JMP	PAST	;AND RETURN
222$:	CLR	LPFLG	;IF SET, THEN CLEAR IT
	MOV	R0,-(SP)
	PRINT$	#FDB	;AND PRINT IT
	MOV	(SP)+,R0	;RESTORE REG
	JMP	PAST	;AND RETURN
;
.PAGE
TTYFCS:
	;CHANGED TO DO FCS WRITES
		;CALL PUTS A BUFFER ADDRESS ON STACK AND JSR R5'S
	MOV	R0,-(SP)	;SAVE A WORK REG
	MOV	4(SP),R0	;BUFFER ADDR
	MOV	(R0)+,TIWC	;SAVE BUFFER SIZE
	MOV	R0,TIBUF	;SAVE ADDRESS
	TST	FDB+F.BDB	;IS FILE OPENED
	BNE	12$		;YES
	MOV	R1,-(SP)	;SAVE R1
	MOV	R0,-(SP)	;AND R0
	MOV	#NAME,R1
	MOV	#FDB,R0
	JSR	PC,.GTDID	;FILL DEFAULD ID IN NAME BLOCK
	MOV	(SP)+,R0
	MOV	(SP)+,R1	;RESTORE REGS
	OPEN$W	#FDB,#6,,,TIBUF,TIWC
12$:	PUT$	#FDB,TIBUF,TIWC	;WRITE LINE
	MOV	(SP)+,R0	;RESTORE R0
	MOV	(SP)+,(SP)	;PUSH UP RETURN R5
	RTS	R5		;THAT'S IT.
	RTS R5
;
;SUB TO DO NORMAL TTY IO
TTYM:
		;CALL PUTS A BUFFER ADDRESS ON STACK AND JSR R5'S
	MOV	R0,-(SP)	;SAVE A WORK REG
	MOV	4(SP),R0	;BUFFER ADDR
	MOV	(R0)+,TIWC	;SAVE BUFFER SIZE
	MOV	R0,TIBUF	;SAVE ADDRESS
	MOV	#TILB,-(SP)	;PUT DPB ADDRESS ON STACK
	EMT	377		;DO QIO
	MOV	(SP)+,R0	;RESTORE R0
	MOV	(SP)+,(SP)	;PUSH UP RETURN R5
	RTS	R5		;THAT'S IT.
.PAGE
;	VARIOUS SUBROUTINES
;CONENT CONVERTS A WORD TO OCTAL, RAD50, AND ASCII

CONENT:;	MOV (R0),-(SP)
	MOV	R0,-(SP)
	MOV	R1,-(SP)	;SAVE REGS
	MOV	R2,-(SP)
	MOV	@R0,R1		;NUMBER TO CONVERT
	MOV	2(SP),R0	;ADDR TO PUT IN
	MOV	#2,R2	;FLAG
	JSR	PC,$CBOMG	;TO OCTAL FIRST!
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0

	ADD #8.,R1
	
	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	R2,-(SP)	;NOW RAD-UNPACK
	MOV	@R0,R1		;GET NUMBER
	MOV	2(SP),R0	;AND BUFFER ADDR
	JSR	PC,$C5TA	;CONVERT
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0	;RESTORE REGISTERS USED
	ADD #4,R1
	MOVB (R0)+,(R1)
	JSR R5,TSTASC
	MOVB (R0)+,(R1)
	JSR R5,TSTASC
	ADD #2,R1
	RTS R5

TSTASC:	CMPB (R1),#40
	BLT SB
	CMPB (R1),#176
	BLE CON
SB:	MOVB #40,(R1)
CON:	INC R1
	RTS R5
KBREAD:
	GCML$	#CMD	;GET A COMMAND OR TWO
	BCC	1$
	EXIT$S
1$:				;BLANK OUT ANY PREVIOUS LONGER LINE
	MOV	CMD+G.CMLD+2,R0	;ADDRESS OF INPUT LINE
	ADD	CMD+G.CMLD,R0	;ADD LENGTH IN BYTES OF INPUT LINE
	MOV	#C.SIZE,R1	;GET SIZE OF COMMAND BUFFER
	SUB	CMD+G.CMLD,R1	;SUB SIZE OF LINE
	11$:	CLRB(R0)+	;CLEAR A BYTE
	SOB	R1,11$
	MOV	CMD+G.CMLD+2,R0	;ADDRESS OF INPUT LINE
	MOV	CMD+G.CMLD,R1	;LENGTH IN BYTES OF INPUT LINE
;	MOV #KBLH+6,R0
;	MOV KBLH+4,R1
	RTS R5	;R0=CORE ADDR,R1=BYTE COUNT
.PAGE
				;VARIOUS COMMANDS
;
CKSUM:				;CALCULATE CHECKSUM
	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	R2,-(SP)	;SAVE CAUSE WHO KNOWS WHAT REG'S ARE USED
	MOV	#INBUF,R2	;GET START OF BLOCK BUFFER
	CLR	R0		;CLEAR ADDER
	MOV	#255.,R1	;WORD COUNT TO R1
11$:	ADD	(R2)+,R0	;CALC CHECKSUM
	SOB	R1,11$
	MOV	R0,CHKSUM	;SAVE CHECKSUM
	MOV	#CHKSUM,R0	;AND POINT R0 TO IT
	MOV	#5015,KBLH+6	;PUT IN CR-LF
	MOV	#KBLH+10,R1	;POINT AFTER THEM
	JSR	R5,CONENT	;CONVERT ONE WORD TO OCT, RAD50,ASC
	MOV	#KBLH+16,R1	;BACK UP POINTER OVER RAD50 ASCII VALUES
	MOV	#5015,(R1)+	;PUT IN FINAL CR-LF
	JSR	R5,WRITE	;WRITE THE CHECKSUM
	MOV	(SP)+,R2	;RESTORE REGS
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	JMP	PAST
;
CHKSUM:	.WORD	0		;SAVE CHECKSUM HERE
;
FULLAD:	CLR	BYTFLG
	JMP	PAST
HALFAD:	MOV	#2,BYTFLG;SET BYTE OFFSETS
	JMP	PAST
TYPBLK:	;TYPE THE BLOCK IN ASCII!!
	BR	X10$	;SKIP BUFFER HEADERS, ETC. DUMP IN ASCII
VTHDR:	.WORD	1,0,1,13	;VERTICAL TAB TO FLUSH TYPEOUT
DATHDR:	.WORD	2*DWDC	;BUFFER SIZE
	.WORD	6	;UNFORMATTED ASCII DUMP
DATSIZ:	.WORD	512.	;# CHARS TO WRITE
	.WORD	INBUF	;DATA IN "INBUF"
X10$:
	MOV	#<<2*DWDC>+2>,TIWC	;WRITE 514 BYTES
	MOV	#INBUF-2,TIBUF	;FROM INBUF
	MOV	#TILB,-(SP)	;NOW QIOW$ IT OUT
	EMT	377		;(AUTOMATICALLY AWAITS DONE)
;VERY LIKELY ONE CAN GENERATE ERRORS THIS WAY; IGNORE THEM.
	JMP	PAST
PLUSV:		;SET HIGH-ORDER BLOCK NUMBER. DO NO I/O
	INC	@SP	;PASS +
	CMPB	@(SP),#CR	;CHECK THAT A COMMA IS THERE
	BNE	PLUSV1	;NO. TEST FOR ALT
PLUS2:	JMP	PAST	;NO COMMA, NO ACTION KIDDO!
PLUSV1:	CMPB	@(SP),#33	;ALT?
	BEQ	PLUS2	;YUP. SAME STORY.
	INC	@SP	;WELL, HE MIGHT BE RIGHT. LET IT BY.
			;PASS THE COMMA NOW AND GET BINARY NUMBER.
	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	R2,-(SP)	;SAVE OUR REGS AS USUAL
	MOV	6(SP),R0	;ASCII NUMBER
	JSR	PC,$COTB	;CONVERT IT
	MOV	R1,DBLKN-2	;SET H/O BLK #
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0	;PUT BACK REGS USED
	BR	PLUS2		;GO ON BACK FOR MORE.
PRCNT:	INC	@SP	;PASS COMMA
	CMPB	@(SP),#CR	;IS THERE A COMMA, EVEN?
	BNE	PRCNT1
PRCNTX:	EXIT$S		;SCRAM--HE'S DANGEROUS!
PRCNT1:	CMPB	@(SP),#33	;ALTMODE EITHER?
	BEQ	PRCNTX	;YEAH, GET OUT FAST
;REQUEST IS NOT OBVIOUSLY WRONG--DO IT.
	INC	@SP	;PASS COMMA NOW. (PASSED THE % EARLIER)
	MOV	R0,-(SP)
	MOV	R1,-(SP)
	MOV	R2,-(SP)	;SAVE REGS
	INC	MODIF	;SET BLOCK CHANGED
	MOV	6(SP),R0	;GET ASCII ADDRESS
	JSR	PC,$COTB	;CONVERT OCTAL
	MOV	R1,DBLKN	;RESET BLK NUMBER
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	JMP	PAST	;GO ON
	.WORD	0,0
MSGTWO:	AXST-.-2
	.ASCII $DISK READ/WRITE ERROR (PROBABLY NON-EXISTANT BLOCK NUMBER)$
	.BYTE CR,LF
	.EVEN
AXST=.
	.WORD	0,0
AST:	2
	.BYTE	52,13	;*
	.END DKPEEK