.TITLE	RMSOPE
	.IDENT	/01.01/
	.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: RMSOPE			   R
;T									   T
;!	GLOBAL SYMBOLS REFERENCED IN THIS MODULE: $RQCB, $RLCB, $ZECB	   !
;T									   T
;E									   E
;X									   X
;T									   T
;R									   R
;O	INPUTS: CALL RMSOPE (LUN,FILSPC,IFAC,ISHR,ISTAT)		   O
;N		CALLG RMSOPE <#LUN,#FILSPC,#IFAC,#ISHR,#ISTAT>		   N
;!	OUTPUTS: ISTAT							   !
;!									   !
;H	HOUSEKEEPING: FIX A BAD 'FOR' LOOP  APG 1-DEC-79		   H
;O									   O
;R									   R
;S	NOTES:								   S
;H									   H
;A									   A
;M									   M
;BRIDGEPORT-TEXTRON BRIDGEPORT-TEXTRON BRIDGEPORT-TEXTRON BRIDGEPORT-TEXTRON
	;
	;
	;
	.MCALL	$OPEN,$INITIF
	.MCALL	FABOF$,FAB$BT,XABOF$,XAB$BT
	.MCALL	SMACIT
	;
	;
	;
	FABOF$	RMS$L			;DEFINE FAB OFFSETS LOCALLY
	FAB$BT	DFIN$L			;DEFINE FAB BIT PATTERNS LOCALLY
	XABOF$	RMS$L			;DEFINE XAB OFFSETS LOCALLY
	XAB$BT	DFIN$L			;DEFINE XAB BIT PATTERNS LOCALLY
	SMACIT				;DEFINE SUPERMAC
	;
	;
	;
	;DEFINE FORTRAN COMPATIBLE PARAMETER BLOCK
	;
	;
	;
	LUN=2
	FILSPC=4
	IFAC=6
	ISHR=10
	ISTAT=12
	NULARG=-1
	;
	;
	;
	PROCEDURE	RMSOPE,GLOBAL
	;
	;
	;
	IFB (R5) NE #5			;FIVE ARGUMENTS???
	  TRAP				;IF NOT, QUIT HERE
	END
	IF ISTAT(R5) EQ #NULARG		;STATUS BLOCK SPECIFIED?
	  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) NE #0		;FILE ALREADY OPEN???
	  LET @ISTAT(R5) := #XX$OPN	;SAY ALREADY OPEN
	  $RETURN			;RETURN TO CALLER
	END
	IF FILSPC(R5) EQ #NULARG	;NULL ARGUMENT?
	  LET @ISTAT(R5) := #XX$NOP	;SAY NO OPERATION POSSIBLE
	  $RETURN			;RETURN TO CALLER
	END
	PUSH R2				;SAVE LUN INDEX
	;
	;
	;
	$CALL $RQCB <#$$$RMS,#FB$BLN>	;ALLOCATE A FAB
	ON.ERROR			;ALLOCATION ERROR -
	  LET @ISTAT(R5) := #XX$ALL	;SAY ALLLOCATION ERROR
	  POP TOP			;RESTORE STACK
	  $RETURN			;RETURN TO CALLER
	END
	PUSH R0				;SAVE FAB POINTER
	$CALL $ZECB <R0,#FB$BLN>	;ZERO FAB BLOCK
	LET O$BID(R0) :B= #FB$BID	;SET FAB IDENTIFIER
	LET O$BLN(R0) :B= #FB$BLN	;SET SIZE OF FAB
	IF IFAC(R5) EQ #NULARG		;DEFAULT FILE ACCESS REQUESTED?
	  LET O$FAC(R0) :B= #FB$GET	;IF SO, SET READ ONLY
	ELSE
	  IF @IFAC(R5) HI #3		;CASE SELECTOR IN RANGE?
	    $CALL $RLCB <#$$$RMS,#FB$BLN,(SP)+>	;IF NOT, RELEASE THE FAB
	    LET @ISTAT(R5) := #XX$FAC		;SAY UNRECOGNIZED FILE ACCESS
	    POP TOP				;RESTORE STACK
	    $RETURN				;RETURN TO CALLER
	  ELSE
	    CASE @IFAC(R5)
	      READONLY			;GET AND FIND ACCESS
	      EXTEND			;GET, FIND, AND PUT ACCESS
	      MODIFY			;GET, FIND, AND UPDATE ACCESS
	      WRITE			;GET, FIND, PUT, UPDATE, AND DELETE
	    END
	  END
	END
	IF ISHR(R5) NE #NULARG		;SHARED ACCESS OPTION SPECIFIED?
	  IF @ISHR(R5) EQ #1		;SHARED ACCESS REQUESTED?
	    LET O$SHR(R0) :B= #FB$WRI	;SET SHARED ACCESS
	  END
	END
	LET O$DNA(R0) := #DEFALT	;SET ADDR OF DEFALT NAME STRING
	LET O$DNS(R0) :B= #DEFSIZ	;AND ITS SIZE
	LET O$LCH(R0) :B= @LUN(R5)	;SET LUN
	;
	;
	;
	$CALL $RQCB <#$$$RMS,#SP$BLN>	;ALLOCATE A SPECIFICATION BLOCK
	ON.ERROR			;ALLOCATION ERROR -
	  $CALL $RLCB <#$$$RMS,#FB$BLN,(SP)+>	;RELEASE THE FAB
	  LET @ISTAT(R5) := #XX$ALL	;SAY ALLOCATION ERROR
	  POP TOP			;RESTORE STACK
	  $RETURN			;RETURN TO CALLER
	END
	$CALL $ZECB <R0,#SP$BLN>	;ZERO THE SPECIFICATION BLOCK
	PUSH R0				;SAVE THE SPEC BLOCK PTR
	LET R2 := FILSPC(R5)		;PICK UP SPEC STRING POINTER
	LET R1 := #0			;INITIALIZE CHARACTER COUNTER
	REPEAT				;LOOP TO COPY FILESPEC
	  LET (R0)+ :B= (R2)+		;TRANSFER FILESPEC TO SPEC BLOCK
	  LET R1 := R1 + #01		;COUNT CHARACTER
	  IF R1 GE #SP$BLN THEN LEAVE LOOP ;ESCAPE IF CHARACTER COUNT EXHAUSTED
	UNTILB (R2) EQ #0		;DONE ON NULL BYTE IN STRING
	LET R0 := 2(SP)			;RESTORE FAB ADDRESS
	LET O$FNA(R0) := (SP)		;INSERT SPEC BLOCK ADDRESS IN FAB
	LET O$FNS(R0) :B= R1		;  "     "     "     SIZE   "  "
	;
	;
	;
	$CALL $RQCB <#$$$RMS,#XB$SML>	;ALLOCATE A SUMMARY XAB
	ON.ERROR			;ALLOCATION ERROR -
	  $CALL $RLCB <#$$$RMS,#SP$BLN,(SP)+>	;RELEASE THE SPEC BLOCK
	  $CALL $RLCB <#$$$RMS,#FB$BLN,(SP)+>	;RELEASE THE FAB
	  LET @ISTAT(R5) := #XX$ALL	;SAY ALLOCATION ERROR
	  POP TOP			;RESTORE STACK
	  $RETURN			;RETURN TO CALLER
	END
	$CALL $ZECB <R0,#XB$SML>	;ZERO THE SUMMARY XAB
	LET O$COD(R0) :B= #XB$SUM	;SET XAB IDENTIFIER
	LET R2 := 2(SP)			;RESTORE FAB ADDRESS
	LET O$XAB(R2) := R0		;INSERT XAB ADDRESS IN FAB
	;
	;
	;
	$INITIF				;CONDITIONALLY INITIALIZE RMS
	$OPEN	R2			;OPEN THE FILE
	;
	;
	;
	LET O$FNA(R2) := #0		;ZERO THE SPEC BLK PTR FOR CLEANLINESS
	$CALL $RLCB <#$$$RMS,#SP$BLN,(SP)+>	;RELEASE THE SPEC BLOCK
	LET R0 := (SP)			;RESTORE THE FAB ADDRESS
	LET R2 := O$XAB(R0)		;RESTORE SUMMARY XAB POINTER
	LET O$CTX(R0) :B= O$NOK(R2)	;INSERT # KEYS IN CONTEXT AREA
	LET O$XAB(R0) := #0		;ZERO THE POINTER FOR CLEANLINESS
	$CALL $RLCB <#$$$RMS,#XB$SML,R2>	;RELEASE THE SUMMARY XAB
	POP R2,R0			;RESTORE FAB POINTER AND LUN INDEX
	IF O$STS(R2) NE #SU$SUC		;OPEN SUCCESSFUL?
	  LET @ISTAT(R5) := O$STS(R2)	;SET FAILURE CODE
	  $CALL $RLCB <#$$$RMS,#FB$BLN,R2>	;RELEASE THE FAB
	  $RETURN			;RETURN TO CALLER
	END
	LET $$$FAB(R0) := R2		;INSERT FAB ADDRESS INTO TABLE
	LET @ISTAT(R5) := #SU$SUC	;SET SUCCESS
	$RETURN				;RETURN TO CALLER
	;
	;
	;
	;CASED ROUTINES
	;
	;
	;
	ENTRYPOINT WRITE
	  LET O$FAC(R0) :B= O$FAC(R0) SET.BY #<FB$DEL!FB$UPD>
	ENTRYPOINT EXTEND
	  LET O$FAC(R0) :B= O$FAC(R0) SET.BY #FB$PUT
	ENTRYPOINT READONLY
	  LET O$FAC(R0) :B= O$FAC(R0) SET.BY #FB$GET
	$RETURN
	ENTRYPOINT MODIFY
	  LET O$FAC(R0) :B= O$FAC(R0) SET.BY #<FB$GET!FB$UPD>
	$RETURN
	;
	;
	;
	;///////////////////////////////////////////////////////////////////////
	.END