.TITLE GBLSECUFO Global Section UFO (User FIle Open) .IDENT 'V04.02' ;++GBLSECUFO.MAR ; ; Facility: ; Fermilab Accelerator Control System - ACNET ; ; Abstract: ; This routine is used to open (or create) a file to be used as a ; global section. The file is opened with the RMS UFO (User File ; Open) option. This routine is meant to be called from FORTRAN ; or some other high-level language. ; ; Environment: ; User Mode at initialization time. ; The module is stored in FERMILIB.OLB ; ;-- ;**************************************************************************** ;* * ;* COPYRIGHT (c) 1980 * ;* BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. * ;* * ;* THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED * ;* ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE * ;* INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER * ;* COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY * ;* OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY * ;* TRANSFERRED. * ;* * ;* THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE * ;* AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT * ;* CORPORATION. * ;* * ;* DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS * ;* SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. * ;* * ;**************************************************************************** ; ; Modification History: ; ; Author: Distributed with VAX/VMS in [SYSHLP.EXAMPLES] ; ; V03-00 23-Nov-81 FJN Modified DEC version to allow $OPEN instead of ; $CREATE. ; V03-01 25-Nov-81 FJN return longword STV in channel ; V03-02 04-Jan-82 FJN Corrected errors ; V03.03 14-Jul-82 FJN Placed into FERMILIB.OLB ; V03.04 15-Apr-83 FJN Corrections to help text ; V04.00 03-Jun-83 FJN Expand to handle any type of string descriptor, ; add default name and FAB address arguments. ; V04.01 06-Jun-83 FJN Fix problem to restore OPEN of existing files ; V04.02 06-Aug-84 FJN Change HELP header to drop from help text as ; this routine is replaced by LIB_SECTION_UFO ; .PAGE .SUBTITLE Declarations ; ; Library Macros: ; .NOCROSS $DSCDEF ;Argument Descriptor offsets .DISABLE TRACEBACK $SSDEF ;System completion codes .ENABLE TRACEBACK,DEBUG .CROSS ; ; Equated Symbols: ; num.args = 3 ;Required number of arguments in call ;Argument list offsets: blkcnt = 4 ; to address of block count filenam = 8 ; to file name string descriptor addr. chan = 12 ; to address to return channel number dftnam = 16 ; to default name string descr. addr. usrfab = 20 ; to caller-provided FAB address .PAGE .SUBTITLE Impure data storage for FAB/RAB ; ; Read/write (inpure) local data program section ; .PSECT _LIB_DATA,PIC,USR,CON,REL,LCL,NOSHR,NOEXE,WRT,RD ; ; RMS FAB for a $CREATE or a $OPEN ; GBLFAB: $FAB FAC=PUT,- ; Allow "output" operations FOP= ; User file open & contiguous best-try ; ; Program section for code ; .PSECT _LIB_CODE,PIC,USR,CON,REL,LCL,SHR,EXE,NOWRT,RD .SHOW BINARY .PAGE .SUBTITLE GBL_SECTION_UFO ;+0GBL_SECTION_UFO ; Perform User File Open on a global section file in preparation for a ; call to the CRMPSC system service. The routine can be used to create ; a new file or open an existing section file. ; ; status.wlc.v = GBL_SECTION_UFO( [blkcnt.rl.r], filnam.rt.dx, ; chan.ww.r [,dftnam.rt.dx] ; [,usrfab.mr.r] ) ; ; status completion status longword. Passed by value. ; ; blkcnt longword containing the number of blocks in the file to be ; created. If zero (or the argument is defaulted) then an ; attempt will be made to open an existing file. Passed by ; reference. ; ; filnam filename string. Passed by descriptor. ; ; chan longword in which the channel number on which the file has ; been opened is returned. If the operation fails, then the ; RMS STV value is returned in the longword. Passed by ; reference. ; ; dftnam default filename string. Passed by descriptor. ; ; usrfab caller-provided FAB for the file open. Passed by reference. ; If this argument is defaulted, then an internal static FAB ; is used to open the file. If the caller provides a FAB, this ; routine provides the needed initializations. ;- ;+0GBL_SECTION_UFO ; ; Functional Description: ; This routine opens a file to be used a global section (the returned ; channel number is later used in a $CRMPSC system service call). An ; RMS $OPEN or $CREATE is performed with User File Open (UFO) set in ; the file options (FOP). The calling routine specifies the file name ; and a number of blocks. If the block count is zero (or the argument ; is defaulted), then an attempt to just $OPEN the file will be made ; and the operation will fail if the file does not exist. If the block ; count is non-zero, then $CREATE will be used and the file will be ; created if it does not exist. The routine returns the channel number ; on which the file was openned. ; ; Calling Sequence: ; status = GBL_SECTION_UFO( [blkcnt], file-name, chan [,dft-name] ; [,users-fab] ) ; ; Input Parameters: ; blkcnt - address of a longword containing the number of blocks in the ; file to be created. If zero (or defaulted) then an attempt ; will be made to open an existing file. ; file-name - filename string descriptor address. ; dft-name - default filename string descriptor address. ; users-fab - FAB allocated by user ; ; Implicit Inputs: ; NONE ; ; Output Parameters: ; chan - address of a longword in which the channel on which the file is ; open is returned. Or returns the RMS STV value on a failure. ; users-fab - fields modified as needed. ; ; Implicit Outputs: ; NONE ; ; Condition Codes: ; SS$_INSFARG - too few arguments ; other RMS condition codes. ; ; Side Effects: ; The file is opened on the returned channel number. ; ;- .ENTRY GBL_SECTION_UFO,^M ; CMPB (AP),#num.args ;Check argument count BGEQU 1$ ;If enough, continue on MOVZWL #SS$_INSFARG,R0 ;Too few, bad argument count status RET ; 1$: MOVAB GBLFAB,R3 ;Init pointer to file access block. CMPB (AP),#usrfab/4 ;Check for user's FAB argument BLSSU 10$ ;If none, use static FAB MOVL usrfab(AP),R0 ;Get address of user's FAB BEQL 10$ ;If defaulted, use static FAB MOVL R0,R3 ;Using caller-provided FAB MOVB #FAB$C_BID,FAB$B_BID(R3) ;Init with FAB block id and size MOVB #FAB$C_BLN,FAB$B_BLN(R3) MOVB #FAB$M_PUT,FAB$B_FAC(R3) ;Set to PUT access mode MOVL #,- ;User file open and contiguous FAB$L_FOP(R3) ; 10$: MOVL filenam(AP),R0 ;Get file name string descriptor addr JSB G^LIB$ANALYZE_SDESC_R2 ;Analyze the string descriptor MOVB R1,FAB$B_FNS(R3) ;Store string length in FAB MOVL R2,FAB$L_FNA(R3) ;And file name ; CMPB (AP),#dftnam/4 ;Check for default file spec. arg. BLSSU 20$ ;If none, open/create the file MOVL dftnam(AP),R0 ;Get default name string descr. addr. BEQL 20$ ;If defaulted, open/create the file JSB G^LIB$ANALYZE_SDESC_R2 ;Analyze the string descriptor MOVB R1,FAB$B_DNS(R3) ;Store default string length in FAB MOVL R2,FAB$L_DNA(R3) ;And default file spec. ; 20$: MOVL blkcnt(AP),R1 ;Get address of block count argument BEQL 50$ ;If none, then just OPEN the file MOVL (R1),FAB$L_ALQ(R3) ;Set number of blocks to allocate BEQL 50$ ;If zero, then just OPEN the file ; BBSS #FAB$V_CIF,- ;Set Create-If option bit FAB$L_FOP(R3),30$ 30$: $CREATE FAB=(R3) ;Open file, create if necessary BRB 80$ ;Jump to common exit code ; 50$: BBCC #FAB$V_CIF,- ;Make sure Create-if option clear FAB$L_FOP(R3),51$ 51$: $OPEN FAB=(R3) ;Open file, fails if no such file ; 80$: MOVL FAB$L_STV(R3),@chan(AP) ;Store channel number or STV value ; 90$: RET ;Return with error code in R0 .END