.TITLE	DBKRD
	.IDENT	/VS01.0/
;
;+	DBKRD/WR - DISK BLOCK READ/WRITE
;
;	REFER ALSO TO DBKRD.FTN AND DBKCF.MAC
;	AND - X1LU.FTN,X1DR.MAC,X1EF.FTN FOR RECORD ORIENTED ROUTINES.
;
;
;	CALL DBKWR (LUN, NR, IBUF, NWR)
;	CALL DBKRD (LUN, NR, IBUF, NWR, NWA)
;
;	LUN	= I*2 LOGICAL UNIT NUMBER OF FILE TO R/W
;	NR	= I*2 VIRTUAL BLOCK NUMBER IN FILE TO BEGIN TRANSFER
;			NOTE THAT NR IS UPDATED ON EXIT FROM DBKRD/WR
;			ON EXIT FROM DBKRD NR = NR + (NWR-1)/256 + 1
;			WHERE 256 IS THE NUMBER OF I*2 WORDS PER DISK BLOCK.
;	IBUF	= INPUT/OUTPUT AREA, CAN BE INTEGER OR REAL, BUT NOT BYTE
;			I.E. MUST BE ON EVEN BYTE BOUNDARY.
;	NWR	= I*2 NUMBER OF I*2 WORDS TO READ/WRITE, BEGINNING AT NR
;			ABOVE. 1 DISK BLOCK = 256 I*2 WORDS.
;	NWA	= RETURNED ONLY FROM DBKRD. I*2 NUMBER OF I*2 WORDS
;			ACTUALLY READ. THIS IS USEFUL FOR CHECKING END-OF
;			FILE CONDITIONS. IF THE END OF FILE IS REACHED NWA
;			WILL BE LESS THAN NWR OR 0 IF A BLOCK IS REQUESTED
;			THAT IS BEYOND THE END-OF-FILE.
;	
;	**NOTES**
;			THERE ARE NO ERROR RETURNS. IF AN ERROR OCCURS
;		DURING THE OPERATION THE PROGRAM WILL TERMINATE VIA
;		THE TRAP INSTRUCTION - CAUSING F4P TO LOG THE MESSAGE.
;
;			THE COMPATIBLE CLOSE ROUTINE TO DBKRD/WR IS
;		DBKCF. => CALL DBKCF (LUN) =<
;
;			DBKRD/WR ARE IN DB2:[350,2]ARAP.OLB ALONG WITH
;		DBKOF (OPEN), DBKCF AND THEIR RELATED SUPPORT ROUTINES.
;
;
;			FOR THOSE DOING OVERLAYS, THE FOLLOWING IS WHAT IS
;		NECESSARY TO BE EXTRACTED FROM THE LIBRARY.
;
;		FOR THE OPEN OVERLAY......
;
;	OP1:	.FCTR	[350,2]ARAP/LB:DBKOF:DBKOF1 - OP2
;	OP2:	.FCTR	[350,2]ARAP/LB:CSIFP:FPARS:FPARS1:FPARS2 - OP3
;	OP3:	.FCTR	[350,2]ARAP/LB:FFNAM:FFVERN:FPCFS:MONTRY
;
;		FOR THE ROOT SEGMENT......
;
;	DISK1:	.FCTR	[350,2]ARAP/LB:DBKRD:FPUICT
;
;		FOR THE CLOSE OVERLAY
;
;	CLOSE1:	.FCTR	[350,2]ARAP/LB:DBKCF
;
;		FOR UNOVERLAYED TASKS....
;
;	LINK YOURSSTUFF -
;	[350,2]ARAP/LIB
;
;-
	.NLIST	ME
	.MCALL	READ$, WRITE$, WAIT$
;
	.GLOBL	$OTSV, $FCHNL
;
FDBOF	=	14
FILPTR	=	30
;
;
RWFLG:	.WORD
DBKRDN:	.RAD50	/DBKRD /
;
.MACRO	ERROR	OTSERR
	TRAP	128.+OTSERR
.ENDM	ERROR
;
;
DBKRD::
	CLR	RWFLG			; SET FOR READ$
	CLR	@12(R5)			; INIT WORDS READ
	BR	COMMON
;
DBKWR::
	MOV	#1,RWFLG
;
COMMON:
	CALL	$SAVAL			; SAVE ALL REGS
	MOV	#DBKRDN,R0		; TRACE-BACK NAME
	MOV	(R0)+,R4
	MOV	(R0)+,-(SP)
	JSR	R4,NAM$			; PUT ON TRACE-BACK STACK
;
;	GET THE FFDB ADDRESS - SET FILPTR FOR ERROR REPORTING
;
	MOV	@2(R5),R2		; LUN #
	MOV	@#$OTSV,R3		; OTS IMPURE AREA POINTER
	CALL	$FCHNL			; SEE F4P OTS MANUAL
	BCC	10$
;
;	NO FILE OPEN ON THIS LUN OR INVALID LUN - REPORT IT
;
	ERROR	32.			; INVALID LUN
;
10$:
	MOV	R0,FILPTR(R3)		; POINT TO FFDB IN CASE OF ERROR
	ADD	#FDBOF,R0		; POINT TO FDB (NOT FFDB)
;
;	FILL IN THE VIRTUAL BLOCK TO BEGIN TRANSFER FROM/TO
;
	MOV	@4(R5),F.BKVB+2(R0)
	BGT	20$			; VBLK <=32766 .AND. >0
;
;	INVALID BLOCK NUMBER - NEGATIVE OR ZERO
;
	MOVB	#-46.,F.ERR(R0)		; ILLEGAL RECORD # - TOO LARGE
	ERROR	25.
;
20$:
	CLR	F.BKVB(R0)		; CLEAR HIGH ORDER WORD OF VBN
;
;	GET # OF BYTES TO TRANSFER
;
	MOV	@10(R5),R1
	BLT	30$			; CAN'T BE NEGATIVE
	ASL	R1			; WORDS TO BYTES
	BGE	40$			; CHECK SIGN BIT AGAIN
30$:
	MOVB	#-40.,F.ERR(R0)		; ILLEGAL RECORD SIZE
	ERROR	44.			; RECORD TOO BIG ERROR
;
40$:
	MOV	R1,F.BKDS(R0)		; PUT NBYTES IN FDB
	BEQ	400$			; DO NOTHING
;
;	GET NEW EOF BLOCK AND BYTE - ALSO UPDATE VBN POINTER IN ARG LIST
;
	MOV	R1,R4			; SAVE FOR FFBY
	ASH	#-9.,R1			; CONVERT FROM BYTES TO BLOCKS
	ADD	@4(R5),R1		; PLUS STARTING VBN OF XFR
	MOV	R1,R2			; SAVE FOR EFBK
	BIC	#177000,R4		; ODD BYTES IN BLOCK FOR FFBY
	BEQ	50$
	INC	R1			; ROUND UP FOR ODD BYTES
50$:	MOV	R1,@4(R5)		; UPDATED VBN
;
;	CALCULATE CORRECT EOF BLOCK AND FIRST-FREE-BYTE WITHIN IT
;	NOTE THAT WRITE$ (.WRITE) UPDATES F.EFBK BUT ROUNDS UP TO THE
;	NEXT BLOCK IF A PARTIAL BLOCK IS WRITTEN. THIS IS UNACCEPTABLE.
;	THEREFORE WE FIGURE F.EFBK AND F.FFBY OUT FOR OURSELVES BEFORE
;	DOING THE WRITE.
;
	CMP	F.EFBK+2(R0),R2		; CURRENT EOF BLOCK, NEW GREATER ?
	BLT	80$			; YEP! R2 & R4 ARE THE EOF POINTERS
	BEQ	60$			; SAME BLOCK, CHECK FFBY.
	MOV	F.EFBK+2(R0),R2		; PRESERVE THE OLD ONE
	BR	70$			; AND OLD FFBY
60$:	CMP	F.FFBY(R0),R4		; GET CURRENT FFBY, NEW GREATER ?
	BLT	80$			; YEP, R4 IS IT
70$:	MOV	F.FFBY(R0),R4		; NO, PRESERVE THE OLD ONE
80$:
	MOV	6(R5),F.BKDS+2(R0)	; BUFFER ADDRESS
;
;	READ/WRITE
;
	TST	RWFLG
	BNE	110$			; WRITE
;
	READ$	R0
	BR	120$
;
110$:	WRITE$	R0
;
;	CHECK STATUS
;
120$:
	TSTB	F.ERR(R0)		; ERROR FROM READ/WRITE ?
	BMI	122$			; YES
	WAIT$	R0			; WAIT FOR I/O TO COMPLETE
;
;	CHECK FINAL ERROR CODES
;
	TST	RWFLG
	BNE	210$			; FOR WRITE$
;
;	CHECK READ RETURN CODES AND RETURN #WORDS READ
;
122$:
	CMPB	#IS.SUC,F.ERR(R0)	; SUCCESS
	BEQ	130$			; YES
	TSTB	F.ERR+1(R0)		; NO - DIRECTIVE ERROR ?
	BLT	125$			; YES, REPORT IT
	CMPB	#IE.EOF,F.ERR(R0)	; MIGHT BE EOF - IF SO IGNORE
	BEQ	400$			; YES - IT'S AN EOF
;
;	ERROR DURING READ
;
125$:	ERROR	39.
;
;	TRANSFER OK - RETURN #WORDS READ
;
130$:
	MOV	@10(R5),@12(R5)		; INIT NWA TO NWR
	SUB	F.EFBK+2(R0),R2		; SUBTRACT OLD EOF BLOCK
	BLT	400$			; NOT PAST EOF FOR SURE
	ASH	#9.,R2			; CONVERT TO BYTES FROM BLOCKS
	ADD	R4,R2			; PLUS NEWLY CALCULATED FFBY
	SUB	F.FFBY(R0),R2		; MINUS OLD FFBY
	ASR	R2			; CONVERT TO WORDS
	SUB	R2,@12(R5)		; SUBTRACT FROM WORDS REQUESTED
	BR	400$			; DONE
;
;
;	CHECK WRITE STATUS CODE
;
210$:
	CMPB	#IS.SUC,F.ERR(R0)	; SUCCESS ?
	BEQ	250$			; YES
;
;	ERROR DURING WRITE - REPORT IT
;
	ERROR	38.
;
250$:
	TST	F.EFBK(R0)		; MSW OF EOF BLOCK NON-ZERO ?
	BNE	400$			; YES! DON'T UPDATE EOF
;					; EOF BLOCK > 32767 ALREADY
	MOV	R2,F.EFBK+2(R0)		; UPDATE EOF BLOCK
	MOV	R4,F.FFBY(R0)		; UPDATE  FFBY
;
;	RESTORE THE F4P FILE POINTER - FILPTR(R3) IN IMPURE AREA
;
400$:
	CLR	FILPTR(R3)
	RETURN
	.END