This appendix contains examples that involve accessing OpenVMS system services from Compaq Fortran programs. The individual examples address the following operations:

• Calling RMS Procedures ( Section E.1)
• Using an AST Routine ( Section E.2)
• Accessing Devices Using Synchronous I/O ( Section E.3)
• Communicating with Other Processes ( Section E.4)
• Sharing Data ( Section E.5)
• Gathering and Displaying Data at Terminals ( Section E.6)
• Creating, Accessing, and Ordering Files ( Section E.7)
• Measuring and Improving Performance ( Section E.8)
• Accessing Help Libraries ( Section E.9)
• Creating and Managing Other Processes ( Section E.10)

Each example includes the free-form source program (with comments), a sample use of the program, and explanatory notes.

Refer to the Compaq Fortran Web site for more examples.

E.1 Calling RMS Procedures

When you explicitly call an RMS system service, the order of the arguments in the call must correspond with the order shown in the OpenVMS Record Management Services Reference Manual. You must use commas to reserve a place in the call for every argument. If you omit an argument, the procedure uses a default value of zero.

When calling an RMS routine from Compaq Fortran, the procedure name format is SYS$procedure_name. The following example shows a call to the RMS procedure SYS$SETDDIR. This RMS procedure sets the default directory for a process.

Source Program:

! File: SETDDIR.F90 ! ! This program calls the RMS procedure $SETDDIR to change ! the default directory for the process. IMPLICIT INTEGER (A - Z) CHARACTER(LEN=17) DIR /'[EX.PROG.FOR]'/ (1) STAT = SYS$SETDDIR (DIR,,) (2) IF (.NOT. STAT) TYPE *, 'ERROR' END PROGRAM

Sample Use:

$ DIRECTORY (3) Directory WORK$:[EX.PROG.FOR.CALL] BASSUM.BAS;1 BASSUM.OBJ;1 COBSUM.COM;1 DOCOMMAND.F90;2 GETMSG.EXE;1 GETMSG.F90;4 GETMSG.LIS;2 GETMSG.OBJ;1 SETDDIR.F90;3 SETDDIR.LIS;1 Total of 10 files. $ FORTRAN SETDDIR $ LINK SETDDIR $ RUN SETDDIR $ DIRECTORY (4) Directory WORK$:[EX.PROG.FOR] CALL.DIR;1 COMU.DIR;1 DEVC.DIR;1 FIL.DIR;1 HAND.DIR;1 INTR.DIR;1 LNKR.DIR;1 MNAG.DIR;1 RMS.DIR;1 SHAR.DIR;1 SYNC.DIR;1 TERM.DIR;1 Total of 12 files.

1. The default directory name is initialized into a CHARACTER variable.
2. The call to $SETDDIR contains one argument, the directory name, which is passed by descriptor, the default argument passing mechanism for CHARACTERs. The omitted arguments are optional, but commas are necessary to reserve places in the argument list.
3. The DIRECTORY command executed before the SETDDIR program is run shows that the following directory is the default:

   WORK$:[EX.V4PROG.FOR.CALL]

   
   This directory contains the file SETDDIR.F90.

4. Another DIRECTORY command after the SETDDIR program is run shows that the default directory has changed. The following directory is the new default directory:

   WORK$:[EX.PROG.FOR]

For More Information:

On calling RMS system services, see Chapter 11.

E.2 Using an AST Routine

The following example demonstrates how to request and declare an AST procedure. It consists of the following:

• The main program CTRLC defines a common block AST_COM that contains the logical variable CTRLC_FLAG and integer channel number, calls the ENABLE_AST routine to set up Ctrl/C trapping, and contains a DO loop that allows Ctrl/C interruption.
• A subroutine named ENABLE_AST that enables Ctrl/C trapping using the SYS$QIOW system service. It is called by the main program and the AST_ROUTINE subroutine.
• A subroutine named AST_ROUTINE that gets called when a Ctrl/C is pressed. It resets the logical variable CTRLC_FLAG and calls the ENABLE_AST subroutine to allow repetitive Ctrl/C use.

For More Information:

On AST routines, see the OpenVMS System Services Reference Manual.

Source Programs:

! Sample program to show enabling of an AST in Fortran ! ! The program uses a Ctrl/C AST to interrupt a work loop in the ! main program. ! PROGRAM CTRLC IMPLICIT NONE LOGICAL CTRLC_FLAG ! Set to TRUE when Ctrl/C is pressed INTEGER (KIND=2) CHANNEL ! Channel for terminal COMMON /AST_COM/ CTRLC_FLAG,CHANNEL VOLATILE CTRLC_FLAG ! Required because variable (1) ! can change at any time INTEGER ITERATIONS,I ! Do first-time initialization CHANNEL = 0 CTRLC_FLAG = .FALSE. CALL ENABLE_AST ! Read iteration count 100 WRITE (*,'($,A)') ' Enter iteration count (0 to exit): ' READ (*,*) ITERATIONS DO I=1,ITERATIONS IF (CTRLC_FLAG) GOTO 200 ! Was Ctrl/C pressed? WRITE (*,*) 'Count is ',I CALL LIB$WAIT (2.0) ! Pause 2 seconds END DO IF (ITERATIONS .EQ. 0) GOTO 999 GOTO 100 ! Loop back 200 WRITE (*,*) 'Ctrl/C pressed' CTRLC_FLAG = .FALSE. GOTO 100 999 END PROGRAM CTRLC ! Subroutine ENABLE_AST SUBROUTINE ENABLE_AST (2) IMPLICIT NONE INCLUDE '($SYSSRVNAM)' ! System services INCLUDE '($IODEF)' ! $QIO function codes LOGICAL CTRLC_FLAG VOLATILE CTRLC_FLAG (1) INTEGER (KIND=2) CHANNEL COMMON /AST_COM/ CTRLC_FLAG,CHANNEL EXTERNAL AST_ROUTINE INTEGER ASSIGN_STATUS, QIO_STATUS, IOSB(2) ! Assign channel if not already assigned IF (CHANNEL .EQ. 0) THEN ASSIGN_STATUS = SYS$ASSIGN ('TT:', CHANNEL,,,) IF (.NOT. ASSIGN_STATUS) CALL LIB$SIGNAL(%VAL(ASSIGN_STATUS)) END IF ! Enable AST so that AST_ROUTINE is called when Ctrl/C is pressed. QIO_STATUS = SYS$QIOW (, & (3) %VAL(CHANNEL), & %VAL(IO$_SETMODE .OR. IO$M_CTRLCAST), & IOSB,,, & AST_ROUTINE,,,,,) IF (.NOT. QIO_STATUS) CALL LIB$SIGNAL(%VAL(QIO_STATUS)) RETURN END SUBROUTINE ENABLE_AST ! Subroutine AST_ROUTINE SUBROUTINE AST_ROUTINE (4) IMPLICIT NONE LOGICAL CTRLC_FLAG VOLATILE CTRLC_FLAG (1) INTEGER (KIND=2) CHANNEL COMMON /AST_COM/ CTRLC_FLAG,CHANNEL ! Indicate that a CTRL/C has been pressed CTRLC_FLAG = .TRUE. ! Reenable the AST. This must be done by calling ENABLE_AST rather than ! doing it here as we would need a recursive reference to AST_ROUTINE, ! which is disallowed unless /RECURSIVE is used. CALL ENABLE_AST (5) RETURN END SUBROUTINE AST_ROUTINE

Sample Use:

$ RUN CTRLC Enter iteration count (0 to exit): 9 Count is 1 Count is 2 Count is 3 Ctrl/C (5) Cancel Ctrl/C pressed Enter iteration count (0 to exit): 0 $

1. The CTRLC_FLAG logical variable is declared volatile in the routines that reference it because its value could change at any point during program execution (other than an assignment statement or subroutine argument).
2. By providing two subroutines, you allow the Ctrl/C AST routine to be executed repeatedly, rather than just once. The ENABLE_AST subroutine is called by the main program and the AST_ROUTINE subroutine. It enables Ctrl/C trapping using the SYS$QIOW system service and sets the CTRLC_FLAGS logical variable. For a subroutine to call itself, it must be recursive.
3. The call to the SYS$QIOW system service enables Ctrl/C AST use by specifying that the subroutine AST_ROUTINE be called when Ctrl/C is pressed.
4. When the AST is delivered, the AST_ROUTINE receives control, resets the CTRLC_FLAG logical variable, and returns control back to where Ctrl/C was pressed (main program), which eventually displays "Ctrl/C pressed".
   The arguments to AST_ROUTINE are platform dependent.
5. The example shows the program executing within the DO loop in the main program (with a two second delay between DO loop executions). When the user types Ctrl/C, control is transferred briefly to the AST_ROUTINE subroutine and it then returns back to the main program. Within the DO loop, the main program tests the value of logical variable CTRLC_FLAG and, if set to .TRUE., transfers control to label 200 which displays "Ctrl/C pressed".

For More Information:

On the VOLATILE statement, see the Compaq Fortran Language Reference Manual.

E.3 Accessing Devices Using Synchronous I/O

The following example performs output to a terminal via the SYS$QIOW system service.

Source Program:

! File: QIOW.F90 ! ! This program demonstrates the use of the $QIOW system service to ! perform synchronous I/O to a terminal. IMPLICIT INTEGER (KIND=4) (A - Z) INCLUDE '($SYSSRVNAM)' INCLUDE '($IODEF)' CHARACTER(LEN=24) TEXT_STRING /'This is from a SYS$QIOW.'/ (1) CHARACTER(LEN=11) TERMINAL /'SYS$COMMAND'/ INTEGER KIND=2) TERM_CHAN STRUCTURE /TT_WRITE_IOSB/ INTEGER (KIND=2) STATUS INTEGER (KIND=2) BYTES_WRITTEN INTEGER (KIND=4) %FILL END STRUCTURE RECORD /TT_WRITE_IOSB/ IOSB ! Assign the channel number STAT = SYS$ASSIGN (TERMINAL, TERM_CHAN,,) IF (.NOT. STAT) CALL LIB$STOP (%VAL(STAT)) (2) ! Initialize STATUS to zero (0) STATUS = 0 ! Output the message twice DO I=1,2 STAT = SYS$QIOW (%VAL(1),%VAL(TERM_CHAN), & (3) %VAL(IO$_WRITEVBLK),IOSB,,, & %REF(TEXT_STRING), & %VAL(LEN(TEXT_STRING)),, & %VAL(32),,) IF (.NOT. STAT) CALL LIB$STOP (%VAL(STATUS)) IF (.NOT. IOSB.STATUS) CALL LIB$STOP (%VAL(IOSB.STATUS)) ENDDO END PROGRAM

Sample Use:

$ FORTRAN QIOW $ LINK QIOW $ RUN QIOW This is from a SYS$QIOW. This is from a SYS$QIOW.

1. If SYS$QIO and a SYS$WAITFR are used instead of SYS$QIOW, you must use a VOLATILE declaration for any program variables and arrays that can be changed while the operation is pending.
2. TERM_CHAN receives the channel number from the SYS$ASSIGN system service.
   The process permanent logical name SYS$COMMAND is assigned to your terminal when you log in. The SYS$ASSIGN system service translates the logical name to the actual device name.
3. SYS$QIO and SYS$QIOW accept the CHAN argument by immediate value, unlike SYS$ASSIGN, which requires that it be passed by reference. Note the use of %VAL in the call to SYS$QIOW but not in the previous call to SYS$ASSIGN.
   The function IO$_WRITEVBLK requires values for parameters P1, P2, and P4.
   • P1 is the starting address of the buffer containing the message. So, TEXT_STRING is passed by reference.
   • P2 is the number of bytes to be written to the terminal. A 24 is passed, since it is the length of the message string.
   • P4 is the carriage control specifier; a 32 indicates single space carriage control.
   
   A SYS$QIOW is issued, ensuring that the output operation will be completed before the program terminates.

The following example shows how to create a global pagefile section and how two processes can use it to access the same data. One process executes the program PAGEFIL1, which must first be installed. When run, PAGEFIL1 creates and writes to a global pagefile section. PAGEFIL1 then waits for a second process to update the section. The second process executes PAGEFIL2, which maps and updates the pagefile section.

Because PAGEFIL2 maps to the temporary global pagefile section created in PAGEFIL1, PAGEFIL1 must be run first. The two processes coordinate their activity through common event flags.

Source Program: PAGEFIL1.F90

! File: PAGEFIL1.F90 ! ! This program creates and maps a global page frame section. ! Data in the section is accessed through an array. IMPLICIT INTEGER (KIND=4) (A-Z) INCLUDE '($SECDEF)' INCLUDE '($SYSSRVNAM)' INCLUDE '($SYIDEF)' DIMENSION MY_ADR(2),OUT_ADR(2) COMMON /MYCOM/ IARRAY(50) (1) CHARACTER(LEN=4) NAME/'GSEC'/ VOLATILE /MYCOM/ (2) ! Associate with common cluster MYCLUS STATUS = SYS$ASCEFC (%VAL(64),'MYCLUS',,) (3) ! To calculate the ending address of the page boundary, call ! LIB$GETSYIW to get the processor-specific page size, PAGE_MAX STATUS = LIB$GETSYI(SYI$_PAGE_SIZE,PAGE_MAX,,,,) IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS)) MY_ADR(1) = %LOC(IARRAY(1)) (1) MY_ADR(2) = MY_ADR(1) + PAGE_MAX -1 ! Flags for call to SYS$CRMPSC SEC_FLAGS = SEC$M_PAGFIL.OR.SEC$M_GBL.OR.SEC$M_WRT.OR.SEC$M_DZRO ! Create and map the temporary global section STATUS = SYS$CRMPSC(MY_ADR,OUT_ADR,,%VAL(SEC_FLAGS), & (4) NAME,,,,%VAL(1),,,) IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS)) ! Manipulate the data in the global section (5) DO 10 I = 1,50 IARRAY(I) = I END DO STATUS = SYS$SETEF(%VAL(72)) IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS)) TYPE *,'Waiting for PAGEFIL2 to update section' STATUS = SYS$WAITFR(%VAL(73)) ! Print the array modified by PAGEFIL2 in the global section TYPE *, 'Modified data in the global section:' WRITE (6,100) (IARRAY(I), I=1,50) 100 FORMAT(10I5) END PROGRAM

Source Program: PAGEFIL2.F90

! File: PAGEFIL2.F90 ! ! This program maps and modifies a global section after PAGEFIL1 ! creates the section. Programs PAGEFIL1 and PAGEFIL2 synchronize ! the processing of the global section through the use of common ! event flags. IMPLICIT INTEGER (KIND=4) (A - Z) INCLUDE '($SECDEF)' INCLUDE '($SYSSRVNAM)' INCLUDE '($SYIDEF)' DIMENSION MY_ADR(2) (1) COMMON /MYCOM/ IARRAY(50) VOLATILE /MYCOM/ (2) ! Call LIB$GETSYIW to get page size, PAGE_MAX STATUS = LIB$GETSYI(SYI$_PAGE_SIZE,PAGE_MAX,,,,) IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS)) MY_ADR(1) = %LOC(IARRAY(1)) (1) MY_ADR(2) = MY_ADR(1) + PAGE_MAX -1 ! Associate with common cluster MYCLUS and wait for ! event flag to be set STATUS = SYS$ASCEFC(%VAL(64),'MYCLUS',,) (3) IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS)) STATUS = SYS$WAITFR (%VAL(72)) IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS)) ! Set flag to allow section to be written FLAGS = SEC$M_WRT ! Map the global section STATUS = SYS$MGBLSC(MY_ADR,,,%VAL(FLAGS),'GSEC',,) (6) IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS)) ! Print out the data in the global section and (7) ! multiply each value by two TYPE *, 'Original data in the global section:' WRITE (6,100) (IARRAY(I), I=1,50) 100 FORMAT (10I5) DO I=1,50 (8) IARRAY(I) = IARRAY(I) * 2 END DO ! Set an event flag to allow PAGEFIL1 to continue execution STATUS = SYS$SETEF(%VAL(73)) IF (.NOT. STATUS) CALL LIB$STOP (%VAL(STATUS)) END PROGRAM

The options file PAGEFIL.OPT contains the following line of source text:

PSECT_ATTR=MYCOM,PAGE,SHR,WRT,SOLITARY (1) COLLECT=SHARED_CLUS,MYCOM (9)

Sample Use:

$ FORTRAN /ALIGN=NATURAL PAGEFIL1 $ FORTRAN/ALIGN=NATURAL PAGEFIL2 $ LINK PAGEFIL1,PAGEFIL/OPTIONS (1) $ LINK PAGEFIL2,PAGEFIL/OPTIONS (1) $ RUN PAGEFIL1 !***Process 1*** Waiting for PAGEFIL2 to update section (10) Modified data in the global section: 2 4 6 8 10 12 14 16 18 20 22 24 26 28 30 32 34 36 38 40 42 44 46 48 50 52 54 56 58 60 62 64 66 68 70 72 74 76 78 80 82 84 86 88 90 92 94 96 98 100 $ $ RUN PAGEFIL2 !***Process 2*** Original data in the global section: (10) 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 $

1. PAGEFIL1 and PAGEFIL2 are linked with the same options file, which specifies that the COMMON block program section is shareable, can be written to, and starts on a page boundary. The first argument to the SYS$CRMPSC (and SYS$MGBLSC) system service is a two-element array MYADR which specifies the starting and ending address.
2. If any variables or arrays are used or modified, you should declare them as volatile in the other routines that reference them.
3. Associate to a common event flag cluster to coordinate activity. The processes must be in the same UIC group.
4. The $CRMPSC system service creates and maps a global pagefile section.
   The starting and ending process virtual addresses of the section are placed in MY_ADR. The SEC$M_PAGFIL flag requests a temporary pagefile section. The flag SEC$M_GBL requests a global section. The flag SEC$M_WRT indicates that the pages should be writable as well as readable. The SEC$M_DZRO flag requests pages filled with zeros.
5. Data is written to the pagefile section by PAGEFIL1.
6. PAGEFIL2 maps the existing section as writable by specifying the SEC$M_WRT flag.
7. PAGEFIL2 reads from the pagefile section.
8. PAGEFIL2 modifies the data in the pagefile section.
9. The COLLECT option instructs the linker to create a cluster named SHARED_CLUS and to put the PSECT MYCOM into that cluster. This prevents the problem of inadvertently mapping another PSECT in a page containing all or part of MYCOM. Clusters are always positioned on page boundaries.
10. After PAGEFIL1 is run, creates the global section, writes out the data, and then displays:

    Waiting for PAGEFIL2 to update section

    
    A separate terminal is used to run PAGEFIL2, which displays the original data written by PAGEFIL1 and then modifies that data and exits. Once modified, PAGEFIL1 displays the data modified by PAGEFIL2 and exits.

For More Information:

On the VOLATILE statement, see the Compaq Fortran Language Reference Manual.

E.5 Sharing Data

The program called SHAREDFIL is used to update records in a relative file. The SHARE qualifier is specified on the OPEN statement to invoke the RMS file sharing facility. In this example, the same program is used to access the file from two processes:

Source Program:

! File: SHAREDFIL.F90 ! ! This program can be run from two or more processes to demonstrate the ! use of an RMS shared file to share data. The program requires the ! relative file named REL.DAT. IMPLICIT INTEGER (KIND=4) (A - Z) CHARACTER(LEN=20) RECORD INCLUDE '($FORIOSDEF)' (1) OPEN (UNIT=1, FILE='REL', STATUS='OLD', SHARED, & (2) ORGANIZATION='RELATIVE', ACCESS='DIRECT', FORM='FORMATTED') (3) ! Request record to be examined 100 TYPE 10 10 FORMAT ('$Record number (Ctrl/Z to quit): ') READ (*,*, END=999) REC_NUM ! Get record from file READ (1,20, REC=REC_NUM, IOSTAT=STATUS), REC_LEN, RECORD 20 FORMAT (Q, A) ! Check I/O status IF (STATUS .EQ. 0) THEN TYPE *, RECORD(1:REC_LEN) (5) ELSE IF (STATUS .EQ. FOR$IOS_ATTACCNON) THEN TYPE *, 'Nonexistent record.' GOTO 100 ELSE IF (STATUS .EQ. FOR$IOS_RECNUMOUT) THEN TYPE *, 'Record number out of range.' GOTO 100 ELSE IF (STATUS .EQ. FOR$IOS_SPERECLOC) THEN TYPE *, 'Record locked by someone else.' (4) GOTO 100 ELSE CALL ERRSNS (, RMS_STS, RMS_STV,,) CALL LIB$SIGNAL (%VAL(RMS_STS), %VAL(RMS_STV)) ENDIF ! Request updated record TYPE 30 30 FORMAT ('$New Value or CR: ') READ (*,20) REC_LEN, RECORD IF (REC_LEN .NE. 0) THEN WRITE (1,40, REC=REC_NUM, IOSTAT=STATUS) RECORD(1:REC_LEN) 40 FORMAT (A) IF (STATUS .NE. 0) THEN CALL ERRSNS (, RMS_STS, RMS_STV,,) CALL LIB$SIGNAL(%VAL(RMS_STS),%VAL(RMS_STV)) ENDIF ENDIF ! Loop GOTO 100 999 END PROGRAM

Sample Use:

$ FORTRAN SHAREDFIL $ LINK SHAREDFIL $ RUN SHAREDFIL Record number (Ctrl/Z to quit): 2 MSPIGGY New Value or CR: FOZZIE Record number (Ctrl/Z to quit): 1 KERMIT New Value or CR: Record number (Ctrl/Z to quit): Ctrl/Z $ $ RUN SHAREDFIL Record number (Ctrl/Z to quit): 2 (4) Record locked by someone else. Record number (Ctrl/Z to quit): 2 Record locked by someone else. Record number (Ctrl/Z to quit): 2 FOZZIE New Value or CR: MSPIGGY Record number (Ctrl/Z to quit): Ctrl/Z (5) $

1. The library module FORIOSDEF must be included to define the symbolic status codes returned by Compaq Fortran I/O statements.
2. This program requires a relative file named REL.DAT.
3. The SHARED qualifier is used on the OPEN statement to indicate that the file can be shared. Because manual locking was not specified, RMS automatically controls access to the file. Only read and update operations are allowed in this example. No new records can be written to the file.
4. The second process is not allowed to access record #2 while the first process is accessing it.
5. Once the first process has finished with record #2, the second process can update it.

The following example calls SMG routines to format screen output.

No sample run is included for this example because the program requires a video terminal in order to execute properly.

Source Program:

! File: SMGOUTPUT.F90 ! ! This program calls Run-Time Library Screen Management routines ! to format screen output. IMPLICIT INTEGER (KIND=4) (A-Z) INCLUDE '($SMGDEF)' (1) ! Establish terminal screen as pasteboard STATUS = SMG$CREATE_PASTEBOARD (NEW_PID,,,) (2) IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS)) ! Establish a virtual display region STATUS = SMG$CREATE_VIRTUAL_DISPLAY (15,30,DISPLAY_ID,,,) (3) IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS)) ! Paste the virtual display to the screen, starting at ! row 2, column 15 STATUS = SMG$PASTE_VIRTUAL_DISPLAY(DISPLAY_ID,NEW_PID,2,15) (4) IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS)) ! Put a border around the display area STATUS = SMG$LABEL_BORDER(DISPLAY_ID,'This is the Border',,,,,) (5) IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS)) ! Write text lines to the screen STATUS = SMG$PUT_LINE (DISPLAY_ID,' ',,,,,) IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS)) STATUS = SMG$PUT_LINE (DISPLAY_ID,'Howdy, pardner',2,,,,) (6) IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS)) STATUS = SMG$PUT_LINE (DISPLAY_ID,'Double spaced lines...',2,,,,) (6) IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS)) STATUS = SMG$PUT_LINE (DISPLAY_ID,'This line is blinking',2, & (7) SMG$M_BLINK,0,,) IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS)) STATUS = SMG$PUT_LINE (DISPLAY_ID,'This line is reverse video',2, & (7) SMG$M_REVERSE,0,,) IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS)) DO I = 1, 5 (8) STATUS = SMG$PUT_LINE (DISPLAY_ID,'Single spaced lines...',,,,,) IF (.NOT. STATUS) CALL LIB$STOP(%VAL(STATUS)) ENDDO END PROGRAM

1. The INCLUDE statement incorporates the $SMGDEF library module from FORSYSDEF.TLB into the source program. This library module contains symbol definitions used by the screen management routines.
2. The call to SMG$CREATE_PASTEBOARD creates a pasteboard upon which output will be written. The pasteboard ID is returned in the variable NEW_PID.
   No value is specified for the output device parameter, so the output device defaults to SYS$OUTPUT. Also, no values are specified for the PB_ROWS or PB_COLS parameters, so the pasteboard is created with the default number of rows and columns. The defaults are the number of rows and the number of columns on the physical screen of the terminal to which SYS$OUTPUT is assigned.
3. The created virtual display is 15 lines long and 30 columns wide. The virtual display initially contains blanks.
4. The virtual display is pasted to the pasteboard, with its upper left corner positioned at row 2, column 15 of the pasteboard. Pasting the virtual display to the pasteboard causes all data written to the virtual display to appear on the pasteboard's output device, which is SYS$OUTPUT---the terminal screen.
   At this point, nothing appears on the screen because the virtual display contains only blanks. However, because the virtual display is pasted to the pasteboard, the program statements described below cause text to be written to the screen.
5. A labeled border is written to the virtual display.
6. Using a call to the RTL routine SMG$PUT_LINE, the text line ("Howdy, pardner" is written to the virtual display.
   To specify double spacing, a call to SMG$PUT_LINE displays "Double spaced lines..." by specifying the line-adv (third) argument to SMG$PUT_LINE as 2.
7. Two subsequent calls to SMG$PUT_LINE specify the SMG$M_BLINK and SMG$M_REVERSE parameters (rendition-set argument) display the double-spaced lines "This line is blinking" as blinking and "This line is reverse video" in reverse video. The parameter mask constants like SMG$M_BLINK are defined in the $SMGDEF library module in FORSYSDEF.TLB.
8. The program displays single-spaced text by omitting a value for the line-adv argument (third argument) to SMG$PUT_LINE. The DO loop displays the line "Single spaced lines..." five times.

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.

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.

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.