.TITLE GBLSECUFO Global Section UFO (User FIle Open) .IDENT 'V03.04' ;++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 ; .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 .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=<UFO,CBT> ; 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 ;+ GBL_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) ; ; 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. ; ;- ;+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 ) ; ; 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. ; ; 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. ; ; 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<R2> ; MOVZWL #SS$_INSFARG,R0 ;Assume bad argument count CMPB (AP),#num.args ;Check argument count BLSS 90$ ;Too few so exit. ; MOVAB GBLFAB,R2 ;Get pointer to file access block. ; MOVL filenam(AP),R1 ;Get file name string descriptor addr MOVB DSC$W_LENGTH(R1),FAB$B_FNS(R2) ;Store string length in FAB MOVL DSC$A_POINTER(R1),FAB$L_FNA(R2) ;And file name ; MOVL blkcnt(AP),R1 ;Get address of block count argument BEQL 10$ ;If none, then just OPEN the file MOVL (R1),FAB$L_ALQ(R2) ;Set number of blocks to allocate BEQL 10$ ;If zero, then just OPEN the file ; BBSS #FAB$V_CIF,FAB$L_FOP(R2),5$ ;Set Create-If option bit 5$: $CREATE FAB=(R2) ;Open file, create if necessary BRB 20$ ;Jump to common exit code ; 10$: BBCC #FAB$V_CIF,FAB$L_FOP(R2),15$ ;Make sure Create-if option clear 15$: $OPEN FAB=(R2) ;Open file, fails if no such file ; 20$: MOVL FAB$L_STV(R2),@chan(AP) ;Store channel number or STV value ; 90$: RET ;Return with error code in R0 .END