hp.com home products and services support and drivers solutions how to buy
cd-rom home
 End of Jump to page title
HP OpenVMS systems
documentation
Jump to content
HP OpenVMS Programming Concepts Manual

HP OpenVMS Programming Concepts Manual
Previous Contents Index

Example 28-2 shows the code for performing the same functions as Example 28-1 but in an Alpha system's environment.

Example 28-2 Mapping a Data File to the Common Block on an Alpha System 

!INCOME.OPT 
 
PSECT_ATTR = INC_DATA, SOLITARY, SHR, WRT

INCOME.FOR 

! Declare variables to hold statistics 
REAL PERSONS_HOUSE (2048), 
2    ADULTS_HOUSE (2048), 
2    INCOME_HOUSE (2048) 
INTEGER TOTAL_HOUSES, STATUS 
! Declare section information 
! Data area 
COMMON /INC_DATA/ PERSONS_HOUSE, 
2                 ADULTS_HOUSE, 
2                 INCOME_HOUSE, 
2                 TOTAL_HOUSES 
! Addresses 
INTEGER ADDR(2), 
2       RET_ADDR(2) 
! Section length 
INTEGER SEC_LEN 
! Channel 
INTEGER*2 CHAN, 
2         GARBAGE 
COMMON /CHANNEL/ CHAN, 
2                GARBAGE 
! Mask values 
INTEGER MASK 
INCLUDE '($SECDEF)' 
! User-open routines 
INTEGER UFO_OPEN, 
2       UFO_CREATE 
EXTERNAL UFO_OPEN, 
2        UFO_CREATE 
! Declare logical unit number 
INTEGER STATS_LUN 
! Declare status variables and values 
INTEGER STATUS, 
2       IOSTAT, 
2       IO_OK 
PARAMETER (IO_OK = 0) 
INCLUDE '($FORDEF)' 
EXTERNAL INCOME_BADMAP 
! Declare logical for INQUIRE statement 
LOGICAL EXIST 
! Declare subprograms invoked as functions 
INTEGER LIB$GET_LUN, 
2       SYS$CRMPSC, 
2       SYS$DELTVA, 
2       SYS$DASSGN 
! Get logical unit number for STATS.SAV 
STATUS = LIB$GET_LUN (STATS_LUN) 
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) 
INQUIRE (FILE = 'STATS.SAV', 
2        EXIST = EXIST) 
IF (EXIST) THEN 
  OPEN (UNIT=STATS_LUN, 
2       FILE='STATS.SAV', 
2       STATUS='OLD', 
2       USEROPEN = UFO_OPEN) 
  MASK = SEC$M_WRT 
ELSE 
  ! If STATS.SAV does not exist, create new database 
  MASK = SEC$M_WRT .OR. SEC$M_DZRO 
  SEC_LEN = 
!  (address of last - address of first + size of last + 511)/512 
2  ( (%LOC(TOTAL_HOUSES) - %LOC(PERSONS_HOUSE(1)) + 4 + 511)/512 ) 
  OPEN (UNIT=STATS_LUN, 
2       FILE='STATS.SAV', 
2       STATUS='NEW', 
2       INITIALSIZE = SEC_LEN, 
2       USEROPEN = UFO_CREATE) 
END IF 
! Free logical unit number and map section 
CLOSE (STATS_LUN) 
! ******** 
! MAP DATA 
! ******** 
STATUS = LIB$GETSYI(SYI$_PAGE_SIZE, PAGE_MAX,,,,) 
IF (.NOT. STATUS) CALL LIB$STOP (%VAL (STATUS)) 
! Specify first and last address of section 
ADDR(1) = %LOC(PERSONS_HOUSE(1)) 
! Section will always be smaller than page_max bytes 
ADDR(2) = ADDR(1) + PAGE_MAX -1 
! Map the section 
STATUS = SYS$CRMPSC (ADDR, 
2                    RET_ADDR, 
2                    , 
2                    %VAL(MASK), 
2                    ,,, 
2                    %VAL(CHAN), 
2                    ,,,) 
IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS)) 
! Check for correct mapping 
IF (ADDR(1) .NE. RET_ADDR (1)) 
 
2  CALL LIB$SIGNAL (%VAL (%LOC(INCOME_BADMAP))) 
   .
   .
   .
                     ! Reference data using the 
                     ! data structures listed 
                     ! in the common block 
   .
   .
   .
! Close and update STATS.SAV 
STATUS = SYS$DELTVA (RET_ADDR,,) 
IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS)) 
STATUS = SYS$DASSGN (%VAL(CHAN)) 
IF (.NOT. STATUS) CALL LIB$SIGNAL(%VAL(STATUS)) 
 
END

28.4.1.2 Using the User-Open Routine

When you open a file for mapping in Fortran, for example, you must specify a user-open routine ( Section 28.6 discusses user-open routines) to perform the following operations:

  1. Set the user-file open bit (FAB$V_UFO) in the file access block (FAB) options mask.
  2. Open the file using SYS$OPEN for an existing file or SYS$CREATE for a new file. (Do not invoke SYS$CONNECT if you have set the user-file open bit.)
  3. Return the channel number to the program unit that started the OPEN operation. The channel number is in the additional status longword of the FAB (FAB$L_STV) and must be returned in a common block.
  4. Return the status of the open operation (SYS$OPEN or SYS$CREATE) as the value of the user-open routine.

After setting the user-file open bit in the FAB options mask, you cannot use language I/O statements to access data in that file. Therefore, you should free the logical unit number associated with the file. The file is still open. You access the file with the channel number.

Example 28-3 shows a user-open routine invoked by the sample program in Section 28.4.1.1 if the file STATS.SAV exists. (If STATS.SAV does not exist, the user-open routine must invoke SYS$CREATE rather than SYS$OPEN.)

Example 28-3 Using a User-Open Routine 

!UFO_OPEN.FOR 
 
INTEGER FUNCTION UFO_OPEN (FAB, 
2                          RAB, 
2                          LUN) 
 
! Include Open VMS RMS definitions 
INCLUDE '($FABDEF)' 
INCLUDE '($RABDEF)' 
! Declare dummy arguments 
RECORD /FABDEF/ FAB 
RECORD /RABDEF/ RAB 
INTEGER LUN 
! Declare channel 
INTEGER*4 CHAN 
COMMON /CHANNEL/ CHAN 
! Declare status variable 
INTEGER STATUS 
! Declare system procedures 
INTEGER SYS$OPEN 
! Set useropen bit in the FAB options longword 
FAB.FAB$L_FOP = FAB.FAB$L_FOP .OR. FAB$M_UFO 
! Open file 
STATUS = SYS$OPEN (FAB) 
! Read channel from FAB status word 
CHAN = FAB.FAB$L_STV 
 
! Return status of open operation 
UFO_OPEN = STATUS 
 
END

28.4.1.3 Initializing a Mapped Database

The first time you map a file you must perform the following operations in addition to those listed at the beginning of Section 28.4.1:

  1. Specify the size of the file---SYS$CRMPSC maps data based on the size of the file. Therefore, when creating a file that is to be mapped, you must specify in your program a file large enough to contain all of the expected data. Figure the size of your database as follows:
  2. Initialize the file when you map it---The blocks allocated to a file might not be initialized and therefore contain random data. When you first map the file, you should initialize the mapped area to zeros by setting the SEC$V_DZRO bit in the mask argument of SYS$CRMPSC.

The user-open routine for creating a file is the same as the user-open routine for opening a file except that SYS$OPEN is replaced by SYS$CREATE.

28.4.1.4 Saving a Mapped File

To close a data file that was opened for user I/O, you must deassign the I/O channel assigned to that file. Before you can deassign a channel assigned to a mapped file, you must delete the virtual memory associated with the file (the memory used by the common block). When you delete the virtual memory used by a mapped file, any changes made while the file was mapped are written back to the disk file. Use the Delete Virtual Address Space (SYS$DELTVA) system service to delete the virtual memory used by a mapped file. Use the Deassign I/O Channel (SYS$DASSGN) system service to deassign the I/O channel assigned to a file.

The program segment shown in Example 28-4 closes a mapped file, automatically writing any modifications back to the disk. To ensure that the proper locations are deleted, pass SYS$DELTVA the addresses returned to your program by SYS$CRMPSC rather than the addresses you passed to SYS$CRMPSC. If you want to save modifications made to the mapped section without closing the file, use the Update Section File on Disk (SYS$UPDSEC) system service. To ensure that the proper locations are updated, pass SYS$UPDSEC the addresses returned to your program by SYS$CRMPSC rather than the addresses you passed to SYS$CRMPSC. Typically, you want to wait until the update operation completes before continuing program execution. Therefore, use the efn argument of SYS$UPDSEC to specify an event flag to be set when the update is complete, and wait for the system service to complete before continuing. For a complete description of the SYS$DELTVA, SYS$DASSGN, and SYS$UPDSEC system services, see the HP OpenVMS System Services Reference Manual.

Example 28-4 Closing a Mapped File 

! Section address 
INTEGER*4 ADDR(2), 
2         RET_ADDR(2) 
! Event flag 
INTEGER*4 FLAG 
! Status block 
STRUCTURE /IO_BLOCK/ 
  INTEGER*2 IOSTAT, 
2           HARDWARE 
  INTEGER*4 BAD_PAGE 
END STRUCTURE 
RECORD /IO_BLOCK/ IOSTATUS 
   .
   .
   .
! Get an event flag 
STATUS = LIB$GET_EF (FLAG) 
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS)) 
! Update the section 
STATUS = SYS$UPDSEC (RET_ADDR, 
2                    ,,, 
2                    %VAL(FLAG) 
2                    , 
2                    IOSTATUS,,) 
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS)) 
! Wait for section to be updated 
STATUS = SYS$SYNCH (%VAL(FLAG), 
2                   IOSTATUS) 
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL(STATUS)) 
   .
   .
   .

28.5 Opening and Updating a Sequential File

This section provides an example, written in HP Fortran, of how to open and update a sequential file on a VAX system. A sequential file consists of records arranged one after the other in the order in which they are written to the file. Records can only be added to the end of the file. Typically, sequential files are accessed sequentially.

Creating a Sequential File

To create a sequential file, use the OPEN statement and specify the following keywords and keyword values:

The file structure keyword ORGANIZATION also accepts the value 'INDEXED' or 'RELATIVE'.

Example 28-5 creates a sequential file of fixed-length records.

Example 28-5 Creating a Sequential File of Fixed-Length Records 

   .
   .
   .
INTEGER STATUS, 
2       LUN, 
2       LIB$GET_INPUT, 
2       LIB$GET_LUN, 
2       STR$UPCASE 
INTEGER*2     FN_SIZE, 
2             REC_SIZE 
CHARACTER*256 FILENAME 
CHARACTER*80  RECORD 
! Get file name 
STATUS = LIB$GET_INPUT (FILENAME, 
2                       'File name: ', 
2                       FN_SIZE) 
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) 
! Get free unit number 
STATUS = LIB$GET_LUN (LUN) 
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) 
! Open the file 
OPEN (UNIT = LUN, 
2     FILE = FILENAME (1:FN_SIZE), 
2     ORGANIZATION = 'SEQUENTIAL', 
2     ACCESS = 'SEQUENTIAL', 
2     RECORDTYPE = 'FIXED', 
2     FORM = 'UNFORMATTED', 
2     RECL = 20, 
2     STATUS = 'NEW') 
! Get the record input 
STATUS = LIB$GET_INPUT (RECORD, 
2                       'Input: ', 
2                       REC_SIZE) 
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) 
DO WHILE (REC_SIZE .NE. 0) 
 
  ! Convert to uppercase 
  STATUS = STR$UPCASE (RECORD,RECORD) 
  IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) 
 
  WRITE  (UNIT=LUN) RECORD(1:REC_SIZE) 
  ! Get more record input 
  STATUS = LIB$GET_INPUT (RECORD, 
2                         'Input: ', 
2                         REC_SIZE) 
  IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) 
 
END DO 
 
END

Updating a Sequential File

To update a sequential file, read each record from the file, update it, and write it to a new sequential file. Updated records cannot be written back as replacement records for the same sequential file from which they were read.

Example 28-6 updates a sequential file, giving the user the option of modifying a record before writing it to the new file. The same file name is used for both files; because the new update file was opened after the old file, the new file has a higher version number.

Example 28-6 Updating a Sequential File 

   .
   .
   .
INTEGER STATUS, 
2       LUN1, 
2       LUN2, 
2       IOSTAT 
INTEGER*2  FN_SIZE 
CHARACTER*256 FILENAME 
CHARACTER*80 RECORD 
CHARACTER*80 NEW_RECORD 
INCLUDE '($FORDEF)' 
INTEGER*4 LIB$GET_INPUT, 
2         LIB$GET_LUN, 
2         STR$UPCASE 
! Get file name 
STATUS = LIB$GET_INPUT (FILENAME, 
2                       'File name: ', 
2                       FN_SIZE) 
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) 
! Get free unit number 
STATUS = LIB$GET_LUN (LUN1) 
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) 
! Open the old file 
OPEN (UNIT=LUN1, 
2     FILE=FILENAME (1:FN_SIZE), 
2     ORGANIZATION='SEQUENTIAL', 
2     ACCESS='SEQUENTIAL', 
2     RECORDTYPE='FIXED', 
2     FORM='UNFORMATTED', 
2     RECL=20, 
2     STATUS='OLD') 
! Get free unit number 
STATUS = LIB$GET_LUN (LUN2) 
IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) 
! Open the new file 
OPEN (UNIT=LUN2, 
2     FILE=FILENAME (1:FN_SIZE), 
2     ORGANIZATION='SEQUENTIAL', 
2     ACCESS='SEQUENTIAL', 
2     RECORDTYPE='FIXED', 
2     FORM='UNFORMATTED', 
2     RECL=20, 
2     STATUS='NEW') 
! Read a record from the old file 
READ (UNIT=LUN1, 
2     IOSTAT=IOSTAT) RECORD 
IF (IOSTAT .NE. IOSTAT_OK) THEN 
  CALL ERRSNS (,,,,STATUS) 
  IF (STATUS .NE. FOR$_ENDDURREA) THEN 
    CALL LIB$SIGNAL (%VAL(STATUS)) 
  END IF 
END IF 
 
DO WHILE (STATUS .NE. FOR$_ENDDURREA) 
 
  TYPE *, RECORD 
 
  ! Get record update 
  STATUS = LIB$GET_INPUT (NEW_RECORD, 
2                         'Update: ') 
  IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) 
  ! Convert to uppercase 
  STATUS = STR$UPCASE (NEW_RECORD, 
2                      NEW_RECORD) 
  IF (.NOT. STATUS) CALL LIB$SIGNAL (%VAL (STATUS)) 
 
  ! Write unchanged record or updated record 
  IF (NEW_RECORD .EQ. ' ' ) THEN 
    WRITE (UNIT=LUN2) RECORD 
  ELSE 
    WRITE (UNIT=LUN2) NEW_RECORD 
  END IF 
 
  ! Read the next record 
  READ (UNIT=LUN1, 
2       IOSTAT=IOSTAT) RECORD 
  IF (IOSTAT .NE. IOSTAT_OK) THEN 
    CALL ERRSNS (,,,,STATUS) 
    IF (STATUS .NE. FOR$_ENDDURREA) THEN 
      CALL LIB$SIGNAL (%VAL(STATUS)) 
    END IF 
  END IF 
END DO 
 
END

28.6 User-Open Routines

A user-open routine in Fortran, for example, gives you direct access to the file access block (FAB) and record access block (RAB) (the OpenVMS RMS structures that define file characteristics). Use a user-open routine to specify file characteristics that are otherwise unavailable from your programming language.

When you specify a user-open routine, you open the file rather than allow the program to open the file for you. Before passing the FAB and RAB to your user-open routine, any default file characteristics and characteristics that can be specified by keywords in the programming language are set. Your user-open routine should not set or modify such file characteristics because the language might not be aware that you have set the characteristics and might not perform as expected.

28.6.1 Opening a File

Section 28.4.1.2 provides guidelines on opening a file with a user-open routine. This section provides an example of a Fortran user-open routine.

28.6.1.1 Specifying USEROPEN

To open a file with a user-open routine, include the USEROPEN specifier in the Fortran OPEN statement. The value of the USEROPEN specifier is the name of the routine (not a character string containing the name). Declare the user-open routine as an INTEGER*4 function. Because the user-open routine name is specified as an argument, it must be declared in an EXTERNAL statement.

The following statement instructs Fortran to open SECTION.DAT using the routine UFO_OPEN: 


! Logical unit number 
INTEGER LUN 
 
! Declare user-open routine 
INTEGER UFO_OPEN 
EXTERNAL UFO_OPEN 
   .
   .
   .
OPEN (UNIT = LUN, 
2     FILE = 'SECTION.DAT', 
2     STATUS = 'OLD', 
2     USEROPEN = UFO_OPEN) 
   .
   .
   .

Note that Fortran can use the $RAB64DEF style of RABs. Code that uses USEROPEN should expected this types of structure. RTL internally uses NAM$C_MAXRSS as a length limit, and file names must reside in a low memory address.

28.6.1.2 Writing the User-Open Routine

Write a user-open routine as an INTEGER function that accepts three dummy arguments:

A user-open routine must perform at least the following operations. In addition, before opening the file, a user-open routine usually adjusts one or more fields in the FAB or the RAB or in both.

The following user-open routine opens an existing file. The file to be opened is specified in the OPEN statement of the invoking program unit.

UFO_OPEN.FOR 


INTEGER FUNCTION UFO_OPEN (FAB, 
2                          RAB, 
2                          LUN) 
 
! Include Open VMS RMS definitions 
INCLUDE '($FABDEF)' 
INCLUDE '($RABDEF)' 
! Declare dummy arguments 
RECORD /FABDEF/ FAB 
RECORD /RABDEF/ RAB 
INTEGER LUN 
! Declare status variable 
INTEGER STATUS 
! Declare system routines 
INTEGER SYS$CREATE, 
2       SYS$OPEN, 
2       SYS$CONNECT 
! Optional FAB and/or RAB modifications 
   .
   .
   .
! Open file 
STATUS = SYS$OPEN (FAB) 
IF (STATUS) 
2  STATUS = SYS$CONNECT (RAB) 
 
! Return status of $OPEN or $CONNECT 
UFO_OPEN = STATUS 
 
END

28.6.1.3 Setting FAB and RAB Fields

Each field in the FAB and RAB is identified by a symbolic name, such as FAB$L_FOP. Where separate bits in a field represent different attributes, each bit offset is identified by a similar symbolic name, such as FAB$V_CTG. The first three letters identify the structure containing the field. The letter following the dollar sign indicates either the length of the field (B for byte, W for word, or L for longword) or that the name is a bit offset (V for bit) rather than a field. The letters following the underscore identify the attribute associated with the field or bit. The symbol FAB$L_FOP identifies the FAB options field, which is a longword in length; the symbol FAB$V_CTG identifies the contiguity bit within the options field.

The STRUCTURE definitions for the FAB and RAB are in the $FABDEF and $RABDEF modules of the library SYS$LIBRARY:FORSYSDEF.TLB. To use these definitions, do the following:

  1. Include the modules in your program unit.
  2. Declare RECORD variables for the FAB and the RAB.
  3. Reference the various fields of the FAB and RAB using the symbolic name of the field.

The following user-open routine specifies that the blocks allocated for the file must be contiguous. To specify contiguity, you clear the best-try-contiguous bit (FAB$V_CBT) of the FAB$L_FOP field and set the contiguous bit (FAB$V_CTG) of the same field.

UFO_CONTIG.FOR 


INTEGER FUNCTION UFO_CONTIG (FAB, 
2                            RAB, 
2                            LUN) 
 
! Include Open VMS RMS definitions 
INCLUDE '($FABDEF)' 
INCLUDE '($RABDEF)' 
! Declare dummy arguments 
RECORD /FABDEF/ FAB 
RECORD /RABDEF/ RAB 
INTEGER LUN 
! Declare status variable 
INTEGER STATUS 
! Declare system procedures 
INTEGER SYS$CREATE, 
2       SYS$CONNECT 
! Clear contiguous-best-try bit and 
! set contiguous bit in FAB options 
FAB.FAB$L_FOP = IBCLR (FAB.FAB$L_FOP, FAB$V_CBT) 
FAB.FAB$L_FOP = IBSET (FAB.FAB$L_FOP, FAB$V_CTG) 
! Open file 
STATUS = SYS$CREATE (FAB) 
IF (STATUS) STATUS = SYS$CONNECT (RAB) 
 
! Return status of open or connect 
UFO_CONTIG = STATUS 
 
END

Previous Next Contents Index