.TITLE FVLDDO
;FVLDST, FVLDGT REPLACEMENT ROUTINES.
; COPYRIGHT(C) 1983 G EVERHART
;
	.GLOBL	FVLDST,FVLDGT
; edit these to match your vklugprm.ftn file definitions
BRRCL=2258
RRW=60
RCL=301
; COPY FROM VKLUGPRM.FTN THE ABOVE PARAMETERS
; ASSUME DECIMAL.
	.PSECT	BITS PIC,OVR,REL,GBL,SHR,RD,WRT,NOEXE,LONG
BITS:	.BLKB	8
	.PSECT	FVLDM PIC,OVR,REL,GBL,SHR,RD,WRT,NOEXE,LONG
FV1:	.BLKB	BRRCL
FV2:	.BLKB	BRRCL
FV4:	.BLKB	BRRCL
	.PSECT	$CODE1
FVLDGT:	.WORD	^M<R0,R1,R2,R3,R4>
	CVTWL	@8(AP),R0	;CALL IS FVLDGT(ID1,ID2,LDAT)
	BNEQ	100$
; TRICK ENTRY IF ID2 IS 0, THEN ID1 PRESUMED TO BE ID. QUERY
; BITMAPS HERE THEN.
	CLRB	@12(AP)	;ZERO IMPLIES NOTHING THERE
	MOVZWL	@4(AP),R0	;GET ID VALUE
	DECL	R0		;AND ZERO BASE IT
	MOVL	R0,R2	;COPY INDEX
	ASHL	#-3,R0,R0	;R0 BECOMES BYTE NO, R2 IS BIT IN BYTE
	BICL	#^XFFFFE000,R0	;LOSE ANY HIGH BITS
	BICL	#^XFFFFFFF8,R2	;IN BOTH INDICES
	MOVZBL	L^BITS(R2),R4	;GET BIT MASK IN A REG NOW FOR SPEED
	CLRL	R1
	BISL	L^FV1(R0),R1	;SET BITS
	BISL	L^FV2(R0),R1
	BISL	L^FV4(R0),R1	;SO IF ANY OF BITS IS SET WE HAVE NONZERO
	MCOML	R4,R4		;GET A MASK TO SELECT OUR BIT
	BICL	R4,R1
	BEQL	90$		;IF RESULT IS 0 LEAVE 0 REPLY
	MOVB	#1,@12(AP)	;ELSE RETURN A 1
90$:
	RET
100$:
	DECL	R0
	MULL2	#RRW,R0	;FORM ID=(ID2-1)*RRW+ID1 TO GET INDEX INTO MAPS
	CVTWL	@4(AP),R4
	ADDL2	R4,R0	;ADDS IN ID1
	DECL	R0		;MAKE THINGS START AT 0 FOR MACRO
	CLRL	R1	;R1 GETS RESULT
	MOVL	R0,R2	;COPY INDEX
	ASHL	#-3,R0,R0	;R0 BECOMES BYTE NO, R2 IS BIT IN BYTE
	BICL	#^XFFFFE000,R0	;LOSE ANY HIGH BITS
	BICL	#^XFFFFFFF8,R2	;IN BOTH INDICES
	MOVZBL	L^BITS(R2),R4	;GET BIT MASK IN A REG NOW FOR SPEED
	BITB	R4,L^FV1(R0)
	BEQL	1$
	MOVL	#1,R1	;1 IN RESULT IF THAT BIT SET IN MASK
1$:	BITB	R4,L^FV2(R0)	;TEST NEXT MASK
	BEQL	2$
	BISL2	#2,R1		;SET RESULT BIT IF SEEN
2$:	BITB	R4,L^FV4(R0)	;CHECK "SIGN" BIT NOW IN MAP
	BEQL	3$
	MNEGL	R1,R1		;NEGATE RESULT IF SEEN
3$:	MOVB	R1,@12(AP)	;STORE BYTE IN RESULT CELL
	RET
;NOTE ABOVE WILL ALLOW 0 RETURN IF SIGN BIT SET AND OTHERS CLEAR.
FVLDST:	.WORD	^M<R0,R1,R2,R3,R4>
	CVTWL	@8(AP),R0	;CALL IS FVLDGT(ID1,ID2,LDAT)
	DECL	R0
	MULL2	#RRW,R0	;FORM ID=(ID2-1)*RRW+ID1 TO GET INDEX INTO MAPS
	CVTWL	@4(AP),R4
	ADDL2	R4,R0	;ADDS IN ID1
	DECL	R0		;MAKE THINGS START AT 0 FOR MACRO
	CLRL	R1	;R1 GETS RESULT
	MOVL	R0,R2	;COPY INDEX
	ASHL	#-3,R0,R0	;R0 BECOMES BYTE NO, R2 IS BIT IN BYTE
	BICL	#^XFFFFE000,R0	;LOSE ANY HIGH BITS
	BICL	#^XFFFFFFF8,R2	;IN BOTH INDICES
	MOVZBL	L^BITS(R2),R4	;GET BIT MASK IN A REG NOW FOR SPEED
	BICB2	R4,L^FV1(R0)	;INITIALLY CLEAR ALL BITS, WILL SET NEXT
	BICB2	R4,L^FV2(R0)
	BICB2	R4,L^FV4(R0)
	CVTBL	@12(AP),R3	;GET INPUT BYTE TO "SAVE"
	BGTR	1$		;IF +, DON'T SET SIGN BIT
	BISB2	R4,L^FV4(R0)	;IF -, SET SIGN BIT
	MNEGL	R3,R3		; AND TAKE ABS VALUE
1$:	BITB	#1,R3		;SEE IF 1 BIT SET
	BEQL	2$
	BISB2	R4,L^FV1(R0)
2$:	BITB	#2,R3		;TEST 2 BIT
	BEQL	3$
	BISB2	R4,L^FV2(R0)
3$:	RET
; 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