 |
» |
|
|
|
 |
Copyright (c) Digital Equipment Corporation 1993. All rights reserved
PRODUCT: VAX PL/I V3.5
OP/SYS: OpenVMS VAX Versions 5.0, 5.0-1, 5.0-2, 5.1, 5.1-B,
5.1-1, 5.2, 5.2-1, 5.3, 5.3-1,
5.3-2, 5.4, 5.4-1, 5.4-2, 5.4-3,
5.5, 5.5-1, 5.5-2, 6.0
SOURCE: Digital Customer Support Center
OVERVIEW:
This article demonstrates how to use the full callable interface to
VAX TPU from PL/I.
*** CAUTION ***
This sample program has been tested using PL/I V3.5 on OpenVMS
VAX V6.0. However, we cannot guarantee its effectiveness because of
the possibility of error in transmitting or implementing it. It is
meant to be used as a template for writing your own program, and it
may require modification for use on your system.
PROGRAM NOTES:
Since PL/I has it's own condition handlers and does not allow use of
LIB$ESTABLISH, PL/I must set up handlers to trap certain conditions
and pass others on to TPU's handler.
PROGRAM:
/*
** This program is a test of callable TPU. It is basically the Fortran
** program example from the callable TPU manual (example 14-3) translated
** into PL/I.
*/
TEST_TPU: procedure options(MAIN);
%INCLUDE $STSDEF;
/* Include entry definitions for TPU calls */
%INCLUDE TPU$CLEANUP;
%INCLUDE TPU$CONTROL;
%INCLUDE TPU$EXECUTE_INIFILE;
%INCLUDE TPU$INITIALIZE;
/* Declare external status values since there is no include file */
DCL (TPU$_SUCCESS, TPU$_QUITTING, TPU$_EXITING, TPU$_FILEOUT)
FIXED BIN(31) GLOBALREF VALUE;
DCL TPU$M_DELETE_CONTEXT BIT(32) GLOBALREF VALUE;
/*
** TPU$_$ZAP_ALL_REFS is a TPU internal signal, no global
** symbol is available
*/
%REPLACE TPU$_$ZAP_ALL_REFS by 66236737;
DCL CLEANUP_FLAG BIT(32) ALIGNED;
/*
** Ignore TPU$_FILEOUT and TPU$_$ZAP_ALL_REFS
*/
on VAXCONDITION(TPU$_FILEOUT), VAXCONDITION(TPU$_$ZAP_ALL_REFS)
/* continue */
;
/* Set up handler to catch QUIT or EXIT */
on VAXCONDITION(TPU$_EXITING), VAXCONDITION(TPU$_QUITTING) begin;
put skip(3);
if oncode() = TPU$_EXITING then put list ('Exiting from TPU...');
else put list ('Quitting from TPU...');
/*
** Now we do a GOTO out of this handler because if we exit normally,
** control will be passed back to TPU. Doing this non-local GOTO will
** clean up the stack also.
*/
goto outofit;
end;
/*
** Initialize TPU. Pass our TPU_STARTUP as the callback routine.
** This routine will specify initialization options such as
** journaling, output file name, etc.
*/
STS$VALUE = TPU$INITIALIZE(TPU_STARTUP);
IF STS$VALUE ^= TPU$_SUCCESS THEN
SIGNAL VAXCONDITION (STS$VALUE);
/*
** Execute initialization file, if there is one. Default
** is TPU$COMMAND.TPU.
*/
STS$VALUE = TPU$EXECUTE_INIFILE();
IF STS$VALUE ^= TPU$_SUCCESS THEN
SIGNAL VAXCONDITION (STS$VALUE);
STS$VALUE = 0;
/* Transfer control to TPU */
STS$VALUE = TPU$CONTROL();
/* Here is a target for the GOTO in the exit handler for TPU */
OUTOFIT:
/*
** We are now back from TPU. Since we had to exit
** by using the GOTO, sts$value should still be zero
** but we will check it anyway.
*/
IF (STS$VALUE ^= 0 ) &
(STS$VALUE ^= TPU$_SUCCESS)
THEN
SIGNAL VAXCONDITION(STS$VALUE);
/* Cleanup */
CLEANUP_FLAG = TPU$M_DELETE_CONTEXT;
STS$VALUE = TPU$CLEANUP(CLEANUP_FLAG);
IF STS$VALUE ^= TPU$_SUCCESS THEN
SIGNAL VAXCONDITION (STS$VALUE);
/* Revert to default condition handling */
REVERT ANYCONDITION;
END TEST_TPU;
/*
*****************************************************************
** This routine will be called by TPU when our main program calls
** TPU$INITIALIZE.
*****************************************************************
*/
TPU_STARTUP: PROCEDURE RETURNS(POINTER);
%INCLUDE TPU$FILEIO;
DCL OPTION_MASK FIXED BIN (31) INIT(0) STATIC;
/*
** The CHAR parameters that we are passing to TPU must
** be STATIC and must not be VARYING.
*/
/* Set up section name. This can be a logical name. */
DCL SECTION_NAME CHAR(11)
INIT('TPU$SECTION') STATIC;
/* Set up output file name. This can be a logical name. */
DCL OUTPUT_FILE CHAR(12)
INIT('CALL_TPU.OUT') STATIC;
/* Set up journal file name. This can be a logical name. */
DCL JOURNAL_FILE CHAR(16)
INIT('CALL_TPU.JOURNAL') STATIC;
DCL (TPU$K_OPTIONS, TPU$K_SECTIONFILE, TPU$K_FILEIO,
TPU$K_OUTPUTFILE, TPU$K_JOURNALFILE)
FIXED BIN(31) VALUE GLOBALREF;
DCL (TPU$M_READ, TPU$M_SECTION, TPU$M_DISPLAY, TPU$M_OUTPUT,
TPU$M_JOURNAL)
FIXED BIN(31) VALUE GLOBALREF;
/* Set up itemlist for callback */
DCL 1 CALLBACK(6) STATIC,
2 BUFLEN FIXED BIN(15),
2 ITMCOD FIXED BIN(15),
2 BUFADR POINTER,
2 RETLENADR POINTER;
/*
** Set up pointer to TPU's file I/O routine since
** we are not going to use a user-written I/O routine
*/
DCL BPV ENTRY (ANY VALUE) STATIC;
BPV = TPU$FILEIO;
/*
** Set up option mask to tell TPU we will be passing a section file,
** an output file, and a journal file, and to use display mode
*/
OPTION_MASK = TPU$M_SECTION + TPU$M_DISPLAY + TPU$M_OUTPUT +
TPU$M_JOURNAL;
/* Build callback itemlist */
CALLBACK(1).ITMCOD = TPU$K_OPTIONS;
CALLBACK(1).BUFADR = ADDR(OPTION_MASK);
CALLBACK(1).BUFLEN = 4;
CALLBACK(1).RETLENADR = NULL();
CALLBACK(2).ITMCOD = TPU$K_SECTIONFILE;
CALLBACK(2).BUFADR = ADDR(SECTION_NAME);
CALLBACK(2).BUFLEN = SIZE(SECTION_NAME);
CALLBACK(2).RETLENADR = NULL();
CALLBACK(3).ITMCOD = TPU$K_FILEIO;
CALLBACK(3).BUFADR = ADDR(BPV);
CALLBACK(3).BUFLEN = 4;
CALLBACK(3).RETLENADR = NULL();
CALLBACK(4).ITMCOD = TPU$K_OUTPUTFILE;
CALLBACK(4).BUFADR = ADDR(OUTPUT_FILE);
CALLBACK(4).BUFLEN = SIZE(OUTPUT_FILE);
CALLBACK(4).RETLENADR = NULL();
CALLBACK(5).ITMCOD = TPU$K_JOURNALFILE;
CALLBACK(5).BUFADR = ADDR(JOURNAL_FILE);
CALLBACK(5).BUFLEN = SIZE(JOURNAL_FILE);
CALLBACK(5).RETLENADR = NULL();
CALLBACK(6).ITMCOD = 0;
CALLBACK(6).BUFADR = NULL();
CALLBACK(6).BUFLEN = 0;
CALLBACK(6).RETLENADR = NULL();
/* Return the address of our callback itemlist to TPU */
RETURN (ADDR(CALLBACK));
END TPU_STARTUP;
REFERENCES:
"VMS Programming Volume 3, System Routines, VAXTPU", June 1990,
(AA-LA66B-TE), page(s) TPU-17
"PL/I User's Manual for VAX VMS", May 1992, (AA-H951D-TE), page(s) 10-7
|
|
|
buy online or call 1.800.AT.COMPAQ
|
|
