.MCALL	.MODULE
.MODULE	LINK,VERSION=45,COMMENT=<COMMON CODE FOR SAV FILE I/O> IDENT=NO,LIB=YES,MODNAME=LNKLB1

; Copyright (c) 1998 by Mentec, Inc., Nashua, NH.
; All rights reserved
;
; This software is furnished under a license for use only on a
; single computer system and  may  be  copied  only  with  the
; inclusion of the above copyright notice.  This software,  or
; any other copies thereof, may not be provided  or  otherwise
; made available to any other person except for  use  on  such
; system and to one who agrees to these license  terms.  Title
; to  and  ownership of the software shall at all times remain
; in Mentec, Inc.
;
; The information in this document is subject to change without
; notice and should not be construed as a commitment by Digital
; Equipment Corporation, or Mentec, Inc.
;
; Digital and Mentec  assume  no  responsibility for the use or
; reliability of its software on equipment which is not supplied
; by Digital  or Mentec,  and listed  in the  Software  Product
; Description.
.SBTTL	I/O ROUTINES FOR SAVE FILE
.ENABL	GBL

; DBB

.IIF NDF EIS$	EIS$=	0	;SAY NO EIS AVAILABLE

; EDIT HISTORY
.SBTTL	MISCELLANEOUS MACRO DEFINITIONS

.MCALL	.READW,.WRITW

.MACRO	ERROR$	ERNB,SEV,ETYP,R
	.IF NB R
	.IIF DIF <R>,<R0> 	MOV 	R,R0
	.IFF
	.IIF IDN <ETYP>,<E$FIL>	CLR	R0
	.ENDC
	JSR	R5,ERROOT
	.BYTE	ERNB,	SEV*100!ETYP
.ENDM

.IF Z EIS$
.MACRO	SOB	R,L
	DEC	R
	BNE	L
.ENDM
.ENDC

	.PSECT	CODE

.SBTTL	GETBUF:	GET AN OUTPUT BUFFER FOR SAVE FILE

;+
; DO SAVE FILE BLOCK CACHEING VIA A 3 WORD TABLE FOR EACH CACHED BLOCK OF
;	REL BLK #
;	LEAST RECENTLY USED COUNT
;	BUFFER ADDR
;
; INPUT:R0 = REL BLK # OF SAV FILE - ALWAYS ABSOLUTE BLOCK NUMBER IN FILE
;	NUMBUF = NUMBER OF BLOCKS TO CACHE
;	BITMAP = ADR OF MASTER SAV FILE BIT TABLE OF BLOCKS WRITTEN
;		 CONTAINS BITBAD FOR BLK 0, IBITBD FOR I-SPACE CCB (/J ONLY)
;	CACHER = ADR OF CACHE CONTROL BLOCKS (3 WDS FOR EACH BLK)
;	LRUNUM = TIME STAMP FOR BUFFERS
;
; OUTPUT:R1 = BUFFER ADDRESS
;	CLOBBERS R0
;-

GETBUF::INC	LRUNUM		;BUMP LEAST RECENTLY USED COUNT
	MOV	R2,-(SP)	;SAVE USED REG
	MOV	R3,-(SP)
	MOV	R0,-(SP)	;SAVE REL BLK NUM
	CALL	BUFMAT		;IS BLK IN MEMORY
	BCC	20$		;C=0 IF YES
	CALL	BITST		;IS THIS 1ST ACCESS ?
	BNE	10$		;NO IF NE (NO EMPTY IN MEMORY IF NE)
	CALL	NWBF		;GET A NEW BUFR
	BR	20$

10$:	CALL	GETLRU		;NEED TO GET BACK USED BLOCK
	MOV	@SP,OBLK	;BLOCK TO READ
	CALL	READ0		;GET IT IN MEMORY
20$:	MOV	(SP)+,(R1)+	;SET REL BLOCK # IN CACHE TBL
	MOV	LRUNUM,(R1)+	;SET LRU COUNT IN CACHE TBL
	MOV	@R1,R1		;BUFFER ADR TO RETURN
	MOV	(SP)+,R3
	MOV	(SP)+,R2
	RETURN
.SBTTL	NWBF:	GET A NEW BUFFER FROM CACHE CTRL BLK LIST

;+
;	CLOBBERS R0,R1,R2,R3
;-

.ENABL	LSB
NWBF:	MOV	#-1,R0		;SETUP TO SEE IF EMPTY IN MEM
	CALL	BUFMAT		;GET EMPTY ?
	BCC	10$		;C=0 IF EMPTY AVAILABLE
	CALL	GETLRU		;GET LRU BLOCK
				;FILL BUFFER WITH /Z SWITCH VALUE
10$:	MOV	4(R1),R2	;BUFFER ADDR FROM CACHE CTRL BLK
ZSWFIL::MOV	#256.,R3	;WORD COUNT FOR BLK SIZE
20$:	MOV	ZSWVAL,(R2)+	;INIT BUFR
	SOB	R3,20$
	RETURN
.DSABL	LSB
.SBTTL	BUFMAT:	GET NUMBER OF AVAILABLE CACHING BLOCKS

;+
; INPUT:	R0 = REL BLOCK #
;
;OUTPUT:C = 0 IF REL BLOCK # CURRENTLY IN MEMORY
;	C = 1 IF NOT
;	CLOBBERS R2,R3
;-

BUFMAT:	MOV	NUMBUF,R2	;GET NUMBER OF AVAILABLE CACHING BLOCKS
	MOV	CACHER,R1	;ADDR OF CACHE CONTROL BLOCKS
10$:	CMP	@R1,R0		;IS DESIRED BLOCK IN THIS CACHE BLOCK
	BEQ	20$		;YES IF EQ & C = 0
	ADD	#6,R1		;BUMP TO NEXT CACHE CTRL BLK
	SOB	R2,10$		;LOOP FOR ALL CACHED BLOCKS
	SEC			;C = 1 FOR REL BLK # NOT IN MEMORY
20$:	RETURN

.SBTTL	BITST:	TEST AND SET BITS IN SAV FILE MASTER BIT MPA

;+
; TESTS AND SETS ACCESS BIT IN SAV FILE MASTER BITMAP
; INPUT:	R0 = REL BLK # - ALWAYS ABSOLUTE BLOCK NUMBER IN FILE
;			IFLG NONZERO MEANS SUBTRACT DBASE (/J ONLY)
;
; OUTPUT:Z = 0 (NE) IF BLOCK ALREADY WRITTEN
;	Z = 1 (EQ) IF BLOCK NOT WRITTEN INTO
;	CLOBBERS R2 & R3
;-

BITST::	MOV	R0,-(SP)	;SAVE R0
	BIT	#SW.J,SWIT1	;ARE WE DOING I-D SPACE?
	BEQ	10$		;BRANCH IF NOT
	TST	IFLG		;ARE WE WRITING THE I-SPACE BITMAP?
	BEQ	10$		;BRANCH IF NOT
	SUB	DBASE,R0	;SUBTRACT OUT I-SPACE BIAS
10$:	MOV	R0,R3		;MAKE COPIES OF REL BLK #
	MOV	R0,R2
	MOV	(SP)+,R0	;RESTORE R0
	BIC	#^C7,R2		;CALC BIT IN BYTE
	BIC	R2,R3
	ASR	R3		;CALC BYTE # OFFSET IN BITMAP
	ASR	R3
	ASR	R3
	ADD	BITMAP,R3	;ADD IN START OF BITMAP TABLE
	MOVB	@R3,-(SP)	;GET OLD BYTE
	BISB	BITTBL(R2),@R3	;SET PROPER BIT
	BITB	BITTBL(R2),(SP)+ ;TEST IF BIT WAS SET - DON'T DISTURB CC'S!
RTN:	RETURN

.PSECT	DPURE,D

BITTBL:	.BYTE	200,100,40,20,10,4,2,1

.PSECT	CODE
.SBTTL	GETLRU:	GET LEAST RECENTLY USED BLOCK FROM CACHED LIST

GETLRU:	MOV	NUMBUF,R2	;GET NUMBER OF CACHE BLOCKS
	MOV	CACHER,R0	;CONTROL BLOCK ADDR
	TST	(R0)+		;R0 -> LRU FIELD IN CTRL BLK
10$:	MOV	R0,R1		;NEW LRU PTR
20$:	ADD	#6,R0		;R0 -> NEXT LRU CTRL BLK
	DEC	R2		;LOOP TILL END OF LIST
	BEQ	WRTLRU		;BR IF DONE (IT RETURNS), R1->LRU CTRL BLK
	CMP	@R0,@R1		;IS NEW LRU < OLD LRU ?
	BHIS	20$		;BR IF NEWER
	BR	10$		;BR WITH NEW CANDIDATE

.ENABL	LSB

.SBTTL	WRIT0: & READ0: WRITE & READ ON CHANNEL 0
;+
;	CLOBBERS R0
;-

READ0:	TST	ODBLK		;OUTPUT FILE REQUESTED?
	BEQ	RTN		;NO IF 0
	TSTB	NOBOUT		; YEH, BUT IS OUTPUT TO NL: ?
	BNE	RTN		; THEN REALLY NOT ANY OUTPUT
	.READW	#OAREA,#0	;DO A READ ON CHANNEL 0
	BR	10$

.SBTTL	WRTLRU: WRITE LEAST RECENTLY USED BLOCK

;+
; INPUT: R1 -> CACHE CONTROL BLOCK LRU ENTRY
;
; OUTPUT:R1 -> CACHE CTRL BLK REL BLK #
;-

WRTLRU::MOV	-(R1),OBLK	;OUTPUT BLK #
	MOV	4(R1),OBUF	;OUTPUT BUFR ADR
WRIT0::	TST	ODBLK		;OUTPUT FILE REQUESTED?
	BEQ	RTN		;NO IF 0
	TSTB	NOBOUT		; YEH, BUT IS OUTPUT TO NL: ?
	BNE	RTN		; THEN REALLY NOT ANY OUTPUT
	.WRITW	#OAREA,#0	;DO A WRITE ON CHANNEL 0
10$:	BCC	RTN		;NO ERROR SO RETURN
	TSTB	@#ERRBYT	;READ OR WRITE BEYOND EOF?
	BEQ	20$		;YES
	ERROR$	ERR6,E$F,E$PRT	;SAV FILE I/O ERROR

20$:	ERROR$	ERR44,E$F,E$PRT	;STORING TEXT OUTSIDE OF PROGRAM BOUNDS

.DSABL	LSB

	.END