HP OpenVMS Systems Documentation |
HP Fortran for OpenVMS
|
Previous | Contents | Index |
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.
! 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 |
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.
! 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 |
$ FORTRAN RELATIVE $ LINK RELATIVE $ RUN RELATIVE Record number: 7 08001FLANJE119PL1920 Record number: 1 07672ALBEHA210SE2100 Record number: 30 Nonexistent record. Record number: Ctrl/Z $ |
This example demonstrates how to adjust the size of the process working set from a 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 |
$ 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 $ |
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.
F.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.
! 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 |
$ 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 $ |
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.
! 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 |
$ FORTRAN GETJPI,GETJPISUB $ LINK GETJPI $ LINK GETJPISUB $ RUN GETJPI PID of subprocess OSCAR is 2120028A OSCAR is waking creator. GETJPI has been awakened. |
Index | Contents |