.TITLE FVLDDO
;FVLDST, FVLDGT REPLACEMENT ROUTINES.
; COPYRIGHT(C) 1983 Glenn and Mary EVERHART
;
	.GLOBL	FVLDST,FVLDGT
BRRCL=2000.
RRW=80.
RCL=200.
; COPY FROM VKLUGPRM.FTN THE ABOVE PARAMETERS
; ASSUME DECIMAL.
	.PSECT	BITS,RW,D,OVR,GBL
BITS:	.BLKB	8.
	.PSECT	FVLDM,RW,D,OVR,GBL
FV1:	.BLKB	BRRCL
FV2:	.BLKB	BRRCL
FV4:	.BLKB	BRRCL
	.PSECT	$CODE1
; READ BITMAPS
FVLDGT:
; CALL: CALL FVLDGT(ID1,ID2,LDAT)
	MOV	@4(R5),R1	;GET ID2
	BNE	100$
; TRICK ENTRY IF ID2 IS 0, THEN ID1 PRESUMED TO BE ID. QUERY
; BITMAPS HERE THEN.
	CLRB	@6(R5)		;ZERO THE RESULT FIRST
	MOV	@2(R5),R0	;GET ID1 = DISPLACEMENT
	DEC	R0		;DECREMENT TO ACCOUNT FOR FORTRAN OFFSET
	MOV	R0,R2		; COPY
	ASH	#-3,R0
	BIC	#160000,R0	; SHIFT OFF THE BYTE OFFSET & MASK
	BIC	#^C7,R2		;ENSURE R2 POINTS TO RIGHT PLACE
	MOVB	BITS(R2),R4	; GET THE BIT MASK IN A REG FOR SPEED
	CLR	R1
	BISB	FV1(R0),R1
	BISB	FV2(R0),R1	; OR IN ALL 3 BITS
	BISB	FV4(R0),R1
; NOW TEST DESIRED BIT.
	BIT	R4,R1		;SO NON-0 IF ANY SELECTED BITS WERE SET
	BEQ	90$
	MOVB	#1,@6(R5)	; IF ANY WERE SET, RETURN A 1
90$:
	RTS	PC		;RETURN
100$:
;GET FVLD IN GENERAL NOW.
	DEC	R1		;ADJUST FOR FORTRAN DIMENSIONS STARTING AT 1
	MUL	#RRW,R1		;MULTIPLY TO GET (ID2-1)*RRW (NOTE ODD REG)
	ADD	@2(R5),R1	; ADD ID1 TO GET INDEX
	DEC	R1		; AND ADJUST FOR FORTRAN 1-BASED INDEX
	CLR	R0		; R0 HAS RESULT
	MOV	R1,R2		;NEED 2 COPIES OF OFFSET
	ASH	#-3,R1		; SHIFT RIGHT 3 BITS
	BIC	#160000,R1	;LOSE HIGH BITS
	BIC	#^C7,R2		; GET BIT NUMBER IN BYTE
	MOVB	BITS(R2),R4	; GET BITMASK TO REGISTER FOR SPEED
	BITB	R4,FV1(R1)
	BEQ	1$
	MOV	#1,R0
1$:	BITB	R4,FV2(R1)
	BEQ	2$
	BIS	#2,R0		;SET UP RESULT BITS 1 AT A TIME
2$:	BITB	R4,FV4(R1)
	BEQ	3$
	NEG	R0
;NEGATE NUMBER IF FV4 (SIGN) BIT IS SET
3$:	MOVB	R0,@6(R5)	;RETURN RESULT
	RTS	PC
;NOTE ABOVE WILL ALLOW 0 RETURN IF SIGN BIT SET AND OTHERS CLEAR.
;
; SET BITMAPS  FROM LDAT
; CALL FVLDST(ID1,ID2,LDAT)
FVLDST:
	MOV	@4(R5),R1	;GET ID2
	DEC	R1		;ADJUST FOR FORTRAN DIMENSIONS STARTING AT 1
	MUL	#RRW,R1		;MULTIPLY TO GET (ID2-1)*RRW (NOTE ODD REG)
	ADD	@2(R5),R1	; ADD ID1 TO GET INDEX
	DEC	R1		; AND ADJUST FOR FORTRAN 1-BASED INDEX
	CLR	R0		; R0 HAS RESULT
	MOV	R1,R2		;NEED 2 COPIES OF OFFSET
	ASH	#-3,R1		; SHIFT RIGHT 3 BITS
	BIC	#160000,R1	;LOSE HIGH BITS
	BIC	#^C7,R2
	MOVB	BITS(R2),R4	; GET BITMASK
	BICB	R4,FV1(R1)
	BICB	R4,FV2(R1)	; CLEAR ALL BITS FIRST
	BICB	R4,FV4(R1)
	MOVB	@6(R5),R3	; GET BYTE BEING INPUT
	BPL	3$		; IF 0 OR +, SKIP - BIT SETTING
	BISB	R4,FV4(R1)	; RECORD NEGATIVE VALUE
	NEG	R3		; AND NEGATE THE NUMBER FOR LATER TESTS
3$:
	BIT	#1,R3		; IS 1 BIT SET?
	BEQ	1$		; IF NO, SKIP SET OF FV1
	BISB	R4,FV1(R1)
1$:	BIT	#2,R3		; IS 2 BIT SET?
	BEQ	2$		; IF NO, SKIP AGAIN
	BISB	R4,FV2(R1)	; IF YES, RECORD THE FACT.
2$:
	RTS	PC
; NOTE A CALL WITH -4 WILL SET FV4 MAP AND NEITHER OF THE OTHERS. THE
; MAP CONDITION SO SET IS USED BY XVBLST/XVBLGT FOR FLAGGING BYTES
; THAT HAVE NOT BEEN INITED BUT HAVE BEEN EXAMINED.
	.END