From:	CSBVAX::MRGATE!@KL.SRI.Com:rtpark.RTP.GE.COM!rlb@ge-rtp@SMTP  2-JUL-1987 23:40
To:	EVERHART
Subj:	File XAB for Protection and Owner

Received: from seismo.CSS.GOV by KL.SRI.COM with TCP; Thu 2 Jul 87 03:17:21-PDT
Received: from mcnc.mcnc.org by seismo.CSS.GOV (5.54/1.14) 
	id AA21392; Wed, 1 Jul 87 22:44:48 EDT
Received: by mcnc.mcnc.org (5.54/MCNC/1-2-87)
	id AA00868; Wed, 1 Jul 87 22:42:25 EDT
Received: by ge-rtp.GE.COM (4.12/UUCP-Project/rel-1.0/ge-rtp.GE.COM/1.4)
	id AA19919; Tue, 30 Jun 87 10:06:37 edt
Date: Tue, 30 Jun 87 10:06:37 edt
Message-Id: <8706301406.AA19919@ge-rtp.GE.COM> 
From: rlb@rtpark.rtp.ge.com (Bob Boyd,8*565-3627  30-Jun-1987 0949)
To: info_vax@mcnc.org, rlb@mcnc.org
Subject: File XAB for Protection and Owner

;The following code is a useropen routine that was written many moons 
;ago (1983-84) for use as a USEROPEN routine for a FORTRAN OPEN statement.
;This code could probably be easily re-done in FORTRAN or any of the
;other languages that support structures well enough to do this.
;-----------------------------------------------------------------
;	USEROPEN PROCEDURE SET_PROT_OWN
;
; arguments:
;  address of FAB -- file access block
;  address of RAB -- record access block
;
	$FABDEF
	$XABDEF
	.PSECT	$CODE PIC,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG
	.ENTRY	SET_PROT_OWN, ^M<>
	MOVL	4(AP), R0		; put the address of FAB into r0
	MOVL	FAB$L_XAB(R0), R1	; get the address of first XAB
;
XAB_LOOP:
	CMPB	XAB$B_COD(R1), #XAB$C_PRO ; see if it is a protection xab
	BEQL	FIX_PROT		; if it is we'll update it
	TSTL	XAB$L_NXT(R1)		; if not -- see if nxt is 0
	BEQL	ADD_PROT		; if nxt=0 then prot_xab must be added
	MOVL	XAB$L_NXT(R1), R1	; get next xab
	BRB	XAB_LOOP		; loop 
;
FIX_PROT:
	MOVW	XAB$W_PRO+PROT_XAB, XAB$W_PRO(R1)	; fixup the prot xab
	BRB	RET_PT			; we're done
;
ADD_PROT:
	MOVAL	PROT_XAB, XAB$L_NXT(R1)	; add a prot xab to the chain
;
RET_PT:
	movl	own_uic, xab$l_uic(r1)	; set the owner to use
	$CREATE	FAB=@4(AP)
	BLBC	R0, 10$
	$CONNECT	RAB=@8(AP)
;
10$:	RET
;
	.save_psect
;
; storage for an xab for protection and owner stuff
;
	.PSECT	$LOCAL	PIC,CON,REL,LCL,NOSHR,NOEXE,RD,WRT,LONG
;
	PROT_XAB:	$XABPRO	PRO=<RWED,RWED,RWED,RWED>
;
; this is a common for stuffing the desired uic into the file open
;  integer*4 own_uic
;  common /own_uic/ own_uic
	.PSECT	own_uic	PIC,CON,REL,LCL,NOSHR,NOEXE,RD,WRT,LONG
	own_uic:	.long 0
;
	.restore_psect
	.END
;-----------------------------------------------------------------
 Bob Boyd                     Usenet:    rlb@rtpark.rtp.ge.com
 GE Microelectronics Ctr.     Voice:     (919)549-3627
 POB 13049, MS 7T3-01         GE DIALCOMM:  8*565-3627
 RTP, NC 27709-3049           GE DECnet: RTPARK::RLB
