Compaq Fortran
User Manual for
OpenVMS Alpha Systems
Previous Contents Index

E.7 Creating, Accessing, and Ordering Files

In the following example, each record in a relative file is assigned to a specific cell in that file. On sequential write operations, the records are written to consecutive empty cells. Random write operations place the records into cell numbers as provided by the REC=n parameter.

Source Program: 


!   File: RELATIVE.F90 
! 
!   This program demonstrates how to access a relative file 
!   randomly. It also performs some I/O status checks. 
 
    IMPLICIT          INTEGER (KIND=4) (A - Z) 
    STRUCTURE /EMPLOYEE_STRUC/ 
      CHARACTER(LEN=5)       ID_NUM 
      CHARACTER(LEN=6)       NAME 
      CHARACTER(LEN=3)       DEPT 
      CHARACTER(LEN=2)       SKILL 
      CHARACTER(LEN=4)       SALARY 
    END STRUCTURE 
    RECORD /EMPLOYEE_STRUC/ EMPLOYEE_REC 
    INTEGER (KIND=4) REC_LEN 
    INCLUDE   '($FORIOSDEF)'                         (1)
 
    OPEN (UNIT=1, FILE='REL', STATUS='OLD', ORGANIZATION='RELATIVE',  & (2)
         ACCESS='DIRECT', FORM='UNFORMATTED',RECORDTYPE='VARIABLE') 
 
!  Get records by record number until e-o-f 
!  Prompt for record number 
 
100 TYPE 10 
 10 FORMAT ('$Record number: ') 
    READ (*,*, END=999) REC_NUM                      (3)
 
!   Read record by record number 
 
    READ (1,REC=REC_NUM,IOSTAT=STATUS) EMPLOYEE_REC 
 
!   Check I/O status 
 
    IF (STATUS .EQ. 0) THEN 
       WRITE (6) EMPLOYEE_REC                        (4)
    ELSE IF (STATUS .EQ. FOR$IOS_ATTACCNON) THEN 
       TYPE *,  'Nonexistent record.' 
    ELSE IF (STATUS .EQ. FOR$IOS_RECNUMOUT) THEN 
       TYPE *, 'Record number out of range.' 
    ELSE 
       CALL ERRSNS (, RMS_STS, RMS_STV,,)            (5)
       CALL LIB$SIGNAL (%VAL(RMS_STS), %VAL(RMS_STV)) 
    ENDIF 
 
!   Loop 
 
    GOTO 100 
999 END

Sample Use: 


$ FORTRAN RELATIVE
$ LINK RELATIVE
$ RUN RELATIVE
Record number: 7
08001FLANJE119PL1920
Record number: 1
07672ALBEHA210SE2100
Record number: 30
Nonexistent record.
Record number: Ctrl/Z
$

  1. The INCLUDE statement defines all Fortran I/O status codes.
  2. The OPEN statement defines the file and record processing characteristics. Although the file organization is specified as relative, RMS would in fact obtain the file organization from an existing file. If the file's organization were not relative, the file OPEN statement would fail.
    The file is being opened for unformatted I/O because the data records will be read into a Compaq Fortran record (EMPLOYEE_REC), and Compaq Fortran does not allow records to be used in formatted I/O.
  3. The READ statement reads the record specified in REC_NUM, rather than the next consecutive record. The status code for the record operation is returned in the variable STATUS.
  4. These statements test the record operation status obtained in comment 3. Note, the status codes returned by RMS and Compaq Fortran are not numerically or functionally similar.
  5. RMS status codes actually require two parameters. These values can be obtained using the ERRSNS subroutine.

E.8 Measuring and Improving Performance

This example demonstrates how to adjust the size of the process working set from a program.

Source Program: 


!   File: ADJUST.F90 
! 
!   This program demonstrates how a program can control 
!   its working set size using the $ADJWSL system service. 
 
    IMPLICIT      INTEGER (A-Z) 
    INCLUDE       '($SYSSRVNAM)' 
    INTEGER (KIND=4)    ADJUST_AMT      /0/ 
    INTEGER (KIND=4)    NEW_LIMIT       /0/ 
 
    CALL LIB$INIT_TIMER 
 
    DO ADJUST_AMT= -50,70,10 
 
!   Modify working set limit 
 
      RESULT = SYS$ADJWSL( %VAL(ADJUST_AMT), NEW_LIMIT)    (1)
      IF (.NOT. RESULT) CALL LIB$STOP(%VAL(RESULT)) 
 
      TYPE 50, ADJUST_AMT, NEW_LIMIT 
 50   FORMAT(' Modify working set by', I4, '   New working set size =', I5) 
    END DO 
    CALL LIB$SHOW_TIMER 
    END PROGRAM

Sample Use: 


$ SET WORKING_SET/NOADJUST                                (2)
$ SHOW WORKING_SET
  Working Set      /Limit=2000  /Quota=4000  /Extent=98304
  Adjustment disabled   Authorized Quota=4000  Authorized Extent=98304
 
  Working Set (8Kb pages) /Limit=125  /Quota=250  /Extent=6144
                           Authorized Quota=250  Authorized Extent=6144
$ FORTRAN ADJUST
$ LINK ADJUST
$ RUN ADJUST
Modify working set by -50    New working set size = 1936   (3)
Modify working set by -40    New working set size = 1888
Modify working set by -30    New working set size = 1856
Modify working set by -20    New working set size = 1824     
Modify working set by -10    New working set size = 1808
Modify working set by   0    New working set size = 1808
Modify working set by  10    New working set size = 1824
Modify working set by  20    New working set size = 1856
Modify working set by  30    New working set size = 1888
Modify working set by  40    New working set size = 1936
Modify working set by  50    New working set size = 2000
Modify working set by  60    New working set size = 2064     
Modify working set by  70    New working set size = 2144
ELAPSED:  0 00:00:00.01  CPU: 0:00:00.01  BUFIO: 13  DIRIO: 0  FAULTS: 24
$

  1. The call to SYS$ADJWSL call uses a function invocation.
  2. The DCL SHOW WORKING_SET command displays the current working set limit and the maximum quota.
  3. The SYS$ADJWSL is used to increase or decrease the number of pages in the process working set.

The program cannot decrease the working set limit beneath the minimum established by the operating system, nor can the process working set be expanded beyond the authorized quota.

E.9 Accessing Help Libraries

The following example demonstrates how to obtain text from a help library. After the initial help request has been satisfied, the user is prompted and can request additional information.

Source Program: 


!   File: HELPOUT.F90 
! 
!   This program satisfies an initial help request and enters interactive 
!   HELP mode.  The library used is SYS$HELP:HELPLIB.HLB. 
 
    IMPLICIT  INTEGER (KIND=4) (A - Z) 
    CHARACTER(LEN=32)   KEY 
    EXTERNAL       LIB$PUT_OUTPUT,LIB$GET_INPUT          (1)
 
!   Request a HELP key 
 
    WRITE (6,200) 
200 FORMAT(1X,'What Topic would you like HELP with? ',$) 
    READ (5,100) KEY 
100 FORMAT (A32) 
 
!   Locate and print the help text 
 
    STATUS = LBR$OUTPUT_HELP(LIB$PUT_OUTPUT,,KEY,   &    (2)
                             'HELPLIB',,LIB$GET_INPUT) 
    IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS)) 
    END PROGRAM

Sample Use: 


$ FORTRAN HELPOUT
$ LINK HELPOUT
$ RUN HELPOUT
What topic would you like HELP with? TYPE
 
TYPE 
    Displays the contents of a file or a group of files on the 
    current output device. 
 
    Format: 
 
        TYPE file-spec[,...] 
 
    Additional information available: 
 
    Parameters  Qualifiers 
    /BACKUP    /BEFORE    /BY_OWNER  /CONFIRM   /CONTINUOUS           /CREATED 
    /EXACT     /EXCLUDE   /EXPIRED   /HEADER    /HIGHLIGHT /MODIFIED  /OUTPUT 
    /PAGE      /SEARCH    /SINCE     /TAIL      /WRAP 
    Examples 
 
TYPE Subtopic? /HIGHLIGHT
 
TYPE 
 
  /HIGHLIGHT 
 
          /HIGHLIGHT[=keyword] 
          /NOHIGHLIGHT (default) 
 
    Use with the /PAGE=SAVE and /SEARCH qualifiers to specify the 
    type of highlighting you want when a search string is found. When 
    a string is found, the entire line is highlighted. You can use 
    the following keywords: BOLD, BLINK, REVERSE, and UNDERLINE. BOLD 
    is the default highlighting. 
 
TYPE Subtopic?  Ctrl/Z
$

  1. To pass the address of LIB$PUT_OUTPUT and LIB$GET_INPUT, they must be declared as EXTERNAL. You can supply your own routines for handling input and output.
  2. The address of an output routine is a required argument. When requesting prompting mode, the default mode, an input routine must be specified.

E.10 Creating and Managing Other Processes

The following example demonstrates how a created process can use the SYS$GETJPIW system service to obtain the PID of its creator process. It also shows how to set up an item list to translate a logical name recursively.

Source Program: 


!   File: GETJPI.F90 
!   This program demonstrates process creation and control. 
!   It creates a subprocess then hibernates until the subprocess wakes it. 
 
    IMPLICIT       INTEGER (KIND=4) (A - Z) 
    INCLUDE        '($SSDEF)' 
    INCLUDE        '($LNMDEF)' 
    INCLUDE        '($SYSSRVNAM)' 
    CHARACTER(LEN=255)    TERMINAL       /'SYS$OUTPUT'/ 
    CHARACTER(LEN=9)      FILE_NAME      /'GETJPISUB'/ 
    CHARACTER(LEN=5)      SUB_NAME       /'OSCAR'/ 
    INTEGER (KIND=4)      PROCESS_ID     /0/ 
    CHARACTER(LEN=17)     TABNAM         /'LNM$PROCESS_TABLE'/ 
    CHARACTER(LEN=255)    RET_STRING 
    CHARACTER(LEN=2)      ESC_NULL 
    INTEGER (KIND=4)      RET_ATTRIB 
    INTEGER (KIND=4)      RET_LENGTH      /10/ 
    STRUCTURE /ITMLST3_3ITEMS/ 
      STRUCTURE    ITEM(3) 
        INTEGER (KIND=2)    BUFFER_LENGTH 
        INTEGER (KIND=2)    CODE 
        INTEGER (KIND=4)    BUFFER_ADDRESS 
        INTEGER (KIND=4)    RETLEN_ADDRESS 
      END STRUCTURE 
      INTEGER (KIND=4)      END_OF_LIST 
    END STRUCTURE 
    RECORD /ITMLST3_3ITEMS/  TRNLST 
 
!   Translate SYS$OUTPUT 
!   Set up TRNLST, the item list for $TRNLNM 
 
    TRNLST.ITEM(1).CODE = LNM$_STRING 
    TRNLST.ITEM(1).BUFFER_LENGTH = 255 
    TRNLST.ITEM(1).BUFFER_ADDRESS = %LOC(RET_STRING) 
    TRNLST.ITEM(1).RETLEN_ADDRESS = 0 
 
    TRNLST.ITEM(2).CODE = LNM$_ATTRIBUTES 
    TRNLST.ITEM(2).BUFFER_LENGTH = 4 
    TRNLST.ITEM(2).BUFFER_ADDRESS = %LOC(RET_ATTRIB) 
    TRNLST.ITEM(2).RETLEN_ADDRESS = 0 
 
    TRNLST.ITEM(3).CODE = LNM$_LENGTH 
    TRNLST.ITEM(3).BUFFER_LENGTH = 4 
    TRNLST.ITEM(3).BUFFER_ADDRESS = %LOC(RET_LENGTH) 
    TRNLST.ITEM(3).RETLEN_ADDRESS = 0 
 
    TRNLST.END_OF_LIST = 0 
 
!   Translate SYS$OUTPUT 
 
100 STATUS = SYS$TRNLNM (,TABNAM,TERMINAL(1:RET_LENGTH),,TRNLST) 
    IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS)) 
    IF (IAND(LNM$M_TERMINAL, RET_ATTRIB).EQ. 0) THEN 
        TERMINAL = RET_STRING(1:RET_LENGTH) 
        GO TO 100 
    ENDIF 
 
!   Check if process permanent file 
 
    ESC_NULL(1:2) = char('1B'x)//char('00'x) 
    IF (RET_STRING(1:2) .EQ. ESC_NULL) THEN 
         RET_STRING = RET_STRING(5:RET_LENGTH) 
         RET_LENGTH = RET_LENGTH - 4 
    ENDIF 
 
!   Create the subprocess 
 
    STATUS = SYS$CREPRC (PROCESS_ID, FILE_NAME,,   &       (1)
                         RET_STRING(1:RET_LENGTH),,,, & 
                         SUB_NAME,%VAL(4),,,) 
    IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS)) 
    TYPE 10, PROCESS_ID 
10  FORMAT (' PID of subprocess OSCAR is ', Z) 
 
!   Wait for wakeup by subprocess 
 
    STATUS = SYS$HIBER ()                                  (2)
    IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS)) 
 
    TYPE *, 'GETJPI has been awakened.' 
    END PROGRAM 
 
!   File: GETJPISUB.F90 
!   This separately compiled program is run in the subprocess OSCAR 
!   which is created by GETJPI.  It  obtains its creator's PID and then 
!   wakes it. 
 
    IMPLICIT       INTEGER (KIND=4) (A - Z)                (3)
    INCLUDE        '($JPIDEF)' 
    INCLUDE        '($SYSSRVNAM)' 
    STRUCTURE /GETJPI_IOSB/ 
      INTEGER(KIND=4)  STATUS 
      INTEGER(KIND=4)  %FILL 
    END STRUCTURE 
    RECORD /GETJPI_IOSB/  IOSB 
    STRUCTURE /ITMLST3_1ITEM/ 
      STRUCTURE    ITEM 
        INTEGER (KIND=2)    BUFFER_LENGTH 
        INTEGER (KIND=2)    CODE 
        INTEGER (KIND=4)    BUFFER_ADDRESS 
        INTEGER (KIND=4)    RETLEN_ADDRESS 
      END STRUCTURE 
      INTEGER (KIND=4)      END_OF_LIST 
    END STRUCTURE 
    RECORD /ITMLST3_1ITEM/  JPI_LIST 
 
!   Set up buffer address for GETJPI 
 
    JPI_LIST.ITEM.CODE = JPI$_OWNER                        (4)
    JPI_LIST.ITEM.BUFFER_LENGTH = 4 
    JPI_LIST.ITEM.BUFFER_ADDRESS = %LOC(OWNER_PID) 
    JPI_LIST.ITEM.RETLEN_ADDRESS = 0 
 
!   Get PID of creator 
 
    STATUS = SYS$GETJPIW (%VAL(1),,, JPI_LIST,IOSB,,)      (5)
    IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS)) 
    IF (.NOT. IOSB.STATUS) CALL LIB$STOP (%VAL(IOSB.STATUS)) 
 
!   Wake creator 
 
    TYPE *, 'OSCAR is waking creator.' 
    STATUS = SYS$WAKE (OWNER_PID,) 
    IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS)) 
 
    END PROGRAM

Sample Use: 


$ FORTRAN GETJPI,GETJPISUB
$ LINK GETJPI
$ LINK GETJPISUB
$ RUN GETJPI
PID of subprocess OSCAR is 2120028A
OSCAR is waking creator.
GETJPI has been awakened.

  1. The subprocess is created using SYS$CREPRC.
  2. The process hibernates.
  3. The INCLUDE statement defines the value of all JPI$ codes including JPI$_OWNER. JPI$_OWNER is the item code which requests the PID of the owner process. If there is no owner process (that is, if the process about which information is requested is a detached process), the system service $GETJPIW returns a PID of zero.
  4. Because of the item code JPI$_OWNER in the item list, $GETJPIW returns the PID of the owner of the process about which information is requested. If the item code were JPI$_PID, $GETJPIW would return the PID of the process about which information is requested.
    Because the default value of 0 is used for arguments PIDADR and PRCNAM, the process about which information is requested is the requesting process, namely, OSCAR.
  5. The item list for SYS$GETJPIW consists of a single item descriptor followed by a zero longword.

Index Contents