HP OpenVMS Systems Documentation

Content starts here

HP COBOL
User Manual


Previous Contents Index

For more information about condition handling, including LIB$ESTABLISH and LIB$REVERT, refer to the OpenVMS RTL Library (LIB$) Manual. <>

13.6 Examples (OpenVMS)

This section provides examples that demonstrate how to call system routines from COBOL programs.

Example 13-2 shows a procedure call and gives a sample run of the program RUNTIME. It calls MTH$RANDOM, a random number generator from the Run-Time Library, and generates 10 random numbers. To obtain different random sequences on separate runs, change the value of data item SEED for each run.

Example 13-2 Random Number Generator (OpenVMS)

IDENTIFICATION DIVISION.
PROGRAM-ID. RUNTIME.

*****************************************************
*  This program calls MTH$RANDOM, a random number   *
*  generator from the Run-Time Library.             *
*****************************************************
DATA DIVISION.
WORKING-STORAGE SECTION.
01 SEED   PIC 9(5) COMP VALUE 967.
01 A-NUM  COMP-1.
01 C-NUM  PIC Z(5).
PROCEDURE DIVISION.
GET-RANDOM-NO.
    PERFORM 10 TIMES
       CALL "MTH$RANDOM" USING SEED GIVING A-NUM
       MULTIPLY A-NUM BY 100 GIVING C-NUM
       DISPLAY "Random Number is  " C-NUM
    END-PERFORM.

Example 13-3 shows a program fragment that calls the SYS$SETDDIR system service.

Example 13-3 Using the SYS$SETDDIR System Service (OpenVMS)

01 DIRECTORY  PIC X(24) VALUE  "[MYACCOUNT.SUBDIRECTORY]".
01 STAT PIC S9(9) COMP.
        .
        .
        .
    CALL "SYS$SETDDIR" USING BY DESCRIPTOR DIRECTORY
                             OMITTED
                             OMITTED
                             GIVING STAT.

Example 13-4 calls the System Service routine $ASCTIM.

Example 13-4 Using$ASCTIM (OpenVMS)

IDENTIFICATION DIVISION.
PROGRAM-ID.   CALLTIME.
****************************************************
*  This program calls the system service routine   *
*  $ASCTIM which converts binary time to an ASCII  *
*  string representation.                          *
****************************************************
DATA DIVISION.
WORKING-STORAGE SECTION.
01  TIMLEN              PIC 9999  COMP VALUE 0.
01  D-TIMLEN            PIC 9999  VALUE 0.
01  TIMBUF              PIC X(24) VALUE SPACES.
01  RETURN-VALUE        PIC S9(9) COMP VALUE 999999999.
PROCEDURE DIVISION.
000-GET-TIME.
      DISPLAY "CALL SYS$ASCTIM".
      CALL "SYS$ASCTIM" USING BY REFERENCE TIMLEN
                              BY DESCRIPTOR TIMBUF
                              OMITTED
                              GIVING RETURN-VALUE.
      IF RETURN-VALUE IS SUCCESS
      THEN
             DISPLAY "DATE/TIME " TIMBUF
             MOVE TIMLEN TO D-TIMLEN
             DISPLAY "LENGTH OF RETURNED = " D-TIMLEN
      ELSE
             DISPLAY "ERROR".
      STOP RUN.

Example 13-5 shows output from a sample run of the CALLTIME program.

Example 13-5 Sample Run of CALLTIME (OpenVMS)

CALL SYS$ASCTIM
DATE/TIME 11-AUG-2000 09:34:33.45
LENGTH OF RETURNED = 0023

The following example shows how to call the procedure that enables and disables detection of floating-point underflow (LIB$FLT_UNDER) from a COBOL program. The format of the LIB$FLT_UNDER procedure is explained in the OpenVMS RTL Library (LIB$) Manual.


WORKING-STORAGE SECTION.
01   NEW-SET         PIC S9(9) USAGE IS COMP.
01   OLD-SET         PIC S9(9) USAGE IS COMP.
           .
           .
           .
PROCEDURE DIVISION.
           .
           .
           .
P0.
     MOVE 1 TO NEW-SET.
     CALL "LIB$FLT_UNDER" USING NEW-SET GIVING OLD-SET.

The following example shows how to call the procedure that finds the first clear bit in a given bit field (LIB$FFC). This procedure returns a COMP longword condition value, represented in the example as RETURN-STATUS.


WORKING-STORAGE SECTION.
01   START-POS       PIC S9(9) USAGE IS COMP VALUE 0.
01   SIZ             PIC S9(9) USAGE IS COMP VALUE 32.
01   BITS            PIC S9(9) USAGE IS COMP VALUE 0.
01   POS             PIC S9(9) USAGE IS COMP VALUE 0.
01   RETURN-STATUS   PIC S9(9) USAGE IS COMP.
           .
           .
           .
PROCEDURE DIVISION.
           .
           .
           .
        CALL "LIB$FFC" USING START-POS,
                             SIZ,
                             BITS,
                             POS
                       GIVING RETURN-STATUS.

        IF RETURN-STATUS IS FAILURE
           THEN GO TO error-proc.

Example 13-6 uses LIB$SET_SYMBOL to set a value for a DCL symbol and shows the use of LIB$K_* symbols for arguments and LIB$_* symbols for return status values.

Example 13-6 Using LIB$K_* and LIB$_* Symbols (OpenVMS)

identification division.
program-id. SETSYM.
environment division.

data division.
working-storage section.
01 LOCAL-SYM  pic S9(9) comp value external LIB$K_CLI_LOCAL_SYM.
01 GLOBAL-SYM pic S9(9) comp value external LIB$K_CLI_GLOBAL_SYM.
01 COND-VAL   pic S9(9) comp.
88 COND-NORMAL               value external SS$_NORMAL.
88 COND-AMBSYMDEF            value external LIB$_AMBSYMDEF.
procedure division.
1.      call "LIB$SET_SYMBOL" using
                by descriptor "XSET*SYM"
                by descriptor "Test1A"
                by reference  LOCAL-SYM
                giving        COND-VAL.
        if      COND-AMBSYMDEF display "Ambiguous"
        else if COND-NORMAL    display "OK"
        else                   display "Not OK".
2.      call "LIB$SET_SYMBOL" using
                by descriptor "XSETS"
                by descriptor "Test1B"
                by reference  LOCAL-SYM
                giving        COND-VAL.
        if      COND-AMBSYMDEF display "Ambiguous"
        else if COND-NORMAL    display "OK"
        else                   display "Not OK".
3.      call "LIB$SET_SYMBOL" using
                by descriptor "XSETS"
                by descriptor "Test1C"
                by reference  GLOBAL-SYM
                giving        COND-VAL.
        if      COND-AMBSYMDEF display "Ambiguous"
        else if COND-NORMAL    display "OK"
        else                   display "Not OK".

9.      stop run.

This uses the following macro, libdef.mar :


.TITLE libdef
$HLPDEF GLOBAL  ; case sensitive!
.END

The program is compiled, linked, and run, as follows:


$ cobol setsym
$ macro libdef
$ link  setsym,libdef
$ run   setsym
OK
Ambiguous
OK
$ show symbol xset*
  XSETS == "Test1C"
  XSET*SYM = "Test1A"


Previous Next Contents Index