.TITLE	RMSKEY
	.IDENT	/01.01/						;JAN18APG
	.PSECT	RMSFTN
	;
	;
	;
;BRIDGEPORT-TEXTRON BRIDGEPORT-TEXTRON BRIDGEPORT-TEXTRON BRIDGEPORT-TEXTRON
;B									   B
;R	PURPOSE: A FORTRAN COMPATIBLE RMS INTERFACE			   R
;I									   I
;D									   D
;G	AUTHOR: ARTHUR P. GAUGHAN, JR.					   G
;E									   E
;P	DATE: 5/31/78							   P
;O									   O
;R	GLOBAL SYMBOLS DEFINED IN THIS MODULE: RMSKEY			   R
;T									   T
;!	GLOBAL SYMBOLS REFERENCED IN THIS MODULE:			   !
;T									   T
;E									   E
;X									   X
;T									   T
;R									   R
;O	INPUTS: CALL RMSKEY (LUN,KEYNUM,KEYBUF,KEYSIZ,IROP,ISTAT)	   O
;N		CALLG RMSKEY <#LUN,#KEYNUM,#KEYBUF,#KEYSIZ,#IROP,#ISTAT>   N
;!	OUTPUTS: ISTAT							   !
;!									   !
;H	HOUSEKEEPING:							   H
;O									   O
;R									   R
;S	NOTES: ADD APPROX MATCH FACILITY APG JAN 18-19 1979		   S
;H									   H
;A									   A
;M									   M
;BRIDGEPORT-TEXTRON BRIDGEPORT-TEXTRON BRIDGEPORT-TEXTRON BRIDGEPORT-TEXTRON
	;
	;
	;
	.MCALL	FABOF$,FAB$BT,RABOF$,RAB$BT
	.MCALL	SMACIT
	;
	;
	;
	FABOF$	RMS$L			;DEFINE OFFSETS LOCALLY
	FAB$BT	DFIN$L			;DEFINE FAB BIT PATTERNS LOCALLY
	RABOF$	RMS$L			;DEFINE OFFSETS LOCALLY
	RAB$BT	DFIN$L			;DEFINE RAB BIT PATTERNS LOCALLY
	SMACIT				;DEFINE SUPERMAC
	;
	;
	;
	;DEFINE FORTRAN COMPATIBLE PARAMETER BLOCK
	;
	;
	;
	LUN=2
	KEYNUM=4
	KEYBUF=6
	KEYSIZ=10
	IROP=12							;JAN18APG
	ISTAT=14						;JAN18APG
	NULARG=-1
	;
	;
	;
	PROCEDURE	RMSKEY,GLOBAL
	;
	;
	;
	IFB (R5) NE #6			;SIX ARGUMENTS???	;JAN18APG
	  TRAP				;IF NOT, QUIT HERE
	END
	IF ISTAT(R5) EQ #NULARG		;NO STATUS BLOCK?
	  EMT				;IF NOT QUIT HERE
	END
	;
	;
	;
	IF LUN(R5) EQ #NULARG		;LUN SPECIFIED?
	  LET @ISTAT(R5) := #XX$LUN	;SAY LUN NOT SPECIFIED
	  $RETURN			;RETURN TO CALLER
	END
	LET R2 := @LUN(R5)		;PICK UP LUN
	LET R2 := R2 L.SHIFT 1		;CONVERT TO WORD INDEX
	IF $$$FAB(R2) EQ #0		;FILE ALREADY OPEN???
	  LET @ISTAT(R5) := #XX$OPN	;SAY FILE NOT OPEN
	  $RETURN			;RETURN TO CALLER
	END
	IF $$$RAB(R2) EQ #0		;RECORD STREAM ALREADY CONNECTED?
	  LET @ISTAT(R5) := #XX$STM	;SAY STREAM NOT CONNECTED
	  $RETURN			;RETURN TO CALLER
	END
	IF KEYBUF(R5) EQ #NULARG OR KEYSIZ(R5) EQ #NULARG;NULL BUFFER ARG(S)?
	  LET @ISTAT(R5) := #XX$NOP	;SAY NO OPERATION POSSIBLE
	  $RETURN			;RETURN TO CALLER
	END
	IF KEYNUM(R5) NE #NULARG	;KEY OF REFERENCE SPECIFIED?
	  LET R0 := $$$FAB(R2)		;YES, SET FAB ADDRESS
	  IFB @KEYNUM(R5) HIS O$CTX(R0)	;LEGAL KEY NUMBER?
	    LET @ISTAT(R5) := #XX$KEY	;NOPE, SAY ILLEGAL KEY NUMBER
	    $RETURN			;RETURN TO CALLER
	  END
	END
	IF IROP(R5) NE #NULARG		;RECORD OPTS SPECIFIED?	;JAN18APG
	  IF @IROP(R5) HI #2		;YUP, OPTION IN RANGE?	;JAN18APG
	    LET @ISTAT(R5) := #XX$ROP	;NOPE, SAY BAD OPTION	;JAN18APG
	    $RETURN			;RETURN TO CALLER	;JAN18APG
	  END							;JAN18APG
	END							;JAN18APG
	;
	;
	;
	LET R0 := $$$RAB(R2)		;PICK UP RAB ADDRESS
	IF KEYNUM(R5) NE #NULARG	;KEY OF REFERENCE SPECIFIED?
	  LET O$KRF(R0) :B= @KEYNUM(R5)	;YES, SET KEY OF REFERENCE
	END
	LET O$KBF(R0) := KEYBUF(R5)	;SET KEY BUFFER ADDRESS
	LET O$KSZ(R0) :B= @KEYSIZ(R5)	;SET KEY SIZE
	IF IROP(R5) NE #NULARG		;RECORD OPTS SPECIFIED?	;JAN19APG
	  LET O$ROP(R0) := O$ROP(R0) OFF.BY #<RB$KGT!RB$KGE>	;JAN19APG
					;CLEAN OUT DIRTY BITS	;JAN19APG
	  CASE @IROP(R5)		;SELECT NEW BITS	;JAN19APG
	    EXACT			;EXACT MATCH		;JAN19APG
	    .GT.			;APPROX., .GT.		;JAN19APG
	    .GE.			;APPROX., .GE.		;JAN19APG
	  END							;JAN19APG
	END							;JAN19APG
	LET @ISTAT(R5) := #SU$SUC	;SET SUCCESS
	$RETURN				;RETURN TO CALLER
	;
	;
	;
	;CASED ROUTINES						;JAN19APG
	;							;JAN19APG
	;							;JAN19APG
	;							;JAN19APG
	ENTRYPOINT	.GE.,LOCAL				;JAN19APG
	LET O$ROP(R0) := O$ROP(R0) SET.BY #RB$KGE ;SET .GE.	;JAN19APG
	$RETURN				;RETURN TO CALLER	;JAN19APG
	ENTRYPOINT	.GT.,LOCAL				;JAN19APG
	LET O$ROP(R0) := O$ROP(R0) SET.BY #RB$KGT ;SET .GT.	;JAN19APG
	ENTRYPOINT	EXACT,LOCAL				;JAN19APG
	$RETURN				;RETURN TO CALLER	;JAN19APG
	;							;JAN19APG
	;							;JAN19APG
	;							;JAN19APG
	;///////////////////////////////////////////////////////////////////////
	.END