|
HP OpenVMS Systems Documentation |
|
HP COBOL
|
| 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 |