rlb@rtpark.rtp.ge.COM (Bob Boyd,8*565-3627 30-Jun-1987 0949) (06/30/87)
;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