HP 3000 Manuals HP 3000 Manuals
Examples: CM to NM and Return
Now consider an example of the mixed-mode switching process in the CM-->
NM direction. The HPCIDELETEVAR intrinsic removes an entry from the
session-local variable table. This intrinsic is not directly callable
from Compatibility Mode. However, you can call it from CM code by means
of a CM--> NM Switch stub.
The syntax of the HPCIDELETEVAR intrinsic is as follows:
CA I32
HPCIDELETEVAR(varname, status);
The varname parameter is a required character array. It passes the name
of the variable to be deleted. The name can be up to 255 characters in
length and must be a valid MPE XL variable name.
The status parameter is an optional 32-bit signed integer passed by
reference. It returns a number indicating the status of the procedure.
The default is nil.
For more information on HPCIDELETEVAR, refer to the appropriate entry in
the MPE XL Intrinsics Reference Manual (32650-90028).
Figure 4.4 illustrates the purpose of the CMDeleteVar Switch stub.
![[]](../../pic3k/M000070/F04033c50.gif)
Figure 4.4. HPSWTONMNAME Example, CMDeleteVar
The Switch stub sets up the parameters required by the appropriate Switch
intrinsic. In this instance, that is the HPSWTONMNAME intrinsic. Here,
again, is a sample call to HPSWTONMNAME:
return_status := HPSWTONMNAME (procname, proclen, libname,
liblen, nparms, arglist, argdesc,
functype);
The parameters that the CMDeleteVar Switch stub must set up before it can
call the HPSWTONMNAME intrinsic convey to Switch the following
information:
* Name of the NM routine
* Length of the procedure name
* NM library to search for the target procedure
* Length of the library name
* Number of parameters of the NM routine
* Parameter list
* Parameter description list
* Type of the functional return value (if any)
Example 4-1 contains the complete Switch to NM stub.
Example 4-1. CMDeleteVar Stub
{ XAMPL41 -- Switch to NM by name }
$standard_level 'HP3000'$
{$subprogram$} {uncomment this to make an RBM for your SL}
$uslinit$
PROGRAM XAMPL41(input, output);
{Type Declarations}
TYPE
shortint = -32768..32767;
shr_ary32 = packed array [1..32] of shortint;
xlstatus = record
case integer of
0 : (all : integer);
1 : (info : shortint;
subsys : shortint);
end;
pac16 = packed array [1..16] of char;
pac255 = packed array [1..255] of char;
{Global variable declarations}
VAR
{Parameters passed to HPCIDELETEVAR via Switch}
status : xlstatus; {status must be 4-byte aligned}
{waddress must return an even number}
VarName : pac255;
{Intrinsic procedure declarations}
FUNCTION HPSWTONMNAME : integer; intrinsic;
FUNCTION HPSWTONMPLABEL : integer; intrinsic;
FUNCTION HPLOADNMPROC : integer; intrinsic;
Example 4-1. CMDeleteVar Stub, continued
{Stub procedure declaration}
PROCEDURE CMDeleteVar(VAR CIVarName : pac255;
VAR NMStatus : xlstatus);
VAR
{Switch intrinsic parameters}
arglist : shr_ary32; {parameter list}
argdesc : shr_ary32; {parameter description list}
fct_typ : shortint; {functional return type, if any}
lib_name : pac16; {NM library to search for target}
lib_len : shortint; {length of NM library name}
nparms : shortint; {number of target parameters}
proc_name : pac16; {name of NM routine}
proc_len : shortint; {length of target's name}
{Parameter assigned functional return}
rtn_st : integer;
BEGIN {stub procedure CMDeleteVar}
{Initializations}
proc_name := 'HPCIDELETEVAR ';
proc_len := 13;
lib_name := 'NL.PUB.SYS ';
lib_len := 10;
nparms := 3; {nparms governs how many types are}
{searched for in argdesc; }
{2 parms plus extensible_gateway }
{HPCIDELETEVAR is declared }
{$OPTION 'EXTENSIBLE_GATEWAY$ }
arglist[1] := 0; {extensible gateway mask is 32 bits}
arglist[2] := 0; {of anything, all 0 bits works ok! }
arglist[3] := baddress(CIVarName);
{reference parameter passed by address; }
{take byte address of variable name buffer}
arglist[4] := waddress(NMStatus);
{reference parameter passed by address;}
{take word address of local status}
Example 4-1. CMDeleteVar Stub, continued
argdesc[1] := 03; {32-bit word value for gateway mask}
argdesc[2] := 05; {byte pointer for arglist[3]}
argdesc[3] := 06; {word pointer for arglist[4]}
fct_typ := 00; {This is an NM procedure, not a }
{function. If it was an NM function, the }
{return value would come back in }
{arglist[1..n] where n is the length of }
{the value in 16-bit words. }
{Switch intrinsic call}
rtn_st := HPSWTONMNAME (proc_name,
proc_len,
lib_name,
lib_len,
nparms,
arglist,
argdesc,
fct_typ);
{Since Status was passed by reference, if the }
{Switch succeeded, HPCIDELETEVAR will have set it.}
{Otherwise, the Switch failed, so return the }
{status from the Switch. This works because }
{.subsys is unique. }
if (rtn_st <> 0) then
NMStatus.all := rtn_st;
END; {Stub procedure CMDeleteVar}
BEGIN {outer block}
writeln('Use the command "SETVAR DELETE_ME 0" before');
writeln('running this.');
writeln(' ');
VarName := 'DELETE_ME';
status.all := 0;
CMDeleteVar(VarName, status);
writeln('Status for subsystem ', status.subsys:3);
writeln(' is ', status.info:3);
END. {outer block}
{end Example 4-1}
NOTE For a complete analysis of CM--> NM Switch stub code, refer to
Chapter 5.
Figure 4.5 illustrates how your CMDeleteVar Switch stub accesses the
HPCIDELETEVAR intrinsic in NL.PUB.SYS.
![[]](../../pic3k/M000070/F04043c50.gif)
Figure 4.5. CM--> NM Switch Summary 2
Example 4-2 illustrates a CM--> NM Switch, using a COBOL II/V stub
procedure in Compatibility Mode to access an HP Pascal/XL target
procedure in Native Mode. Both the stub and the target are included in
Example 4-2.
Example 4-2. CM--> NM Switch, COBOL
{ XAMPL42 -- example Switch to NM using COBOL stub}
$CONTROL USLINIT
IDENTIFICATION DIVISION.
PROGRAM-ID. XAMPL42.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 SWITCH-STATUS PIC S9(9) COMP VALUE ZERO.
01 SWITCH-STATUS-X REDEFINES SWITCH-STATUS.
05 SWITCH-INFO PIC S9(4) COMP.
05 SWITCH-SUBSYS PIC S9(4) COMP.
01 DISP-INFO PIC ZZZ9.
01 DISP-SUBSYS PIC ZZZ9.
01 DISP-ANSWER PIC ZZZ9.
01 PROCNAME PIC X(16) VALUE SPACES.
01 ADD-TO-PARM PIC S9(9) COMP.
01 PROCNAME-LEN PIC S9(4) COMP.
01 LIBNAME PIC X(80) VALUE SPACES.
01 LIBNAME-LEN PIC S9(4) COMP.
01 ARGLIST.
O5 LIST-ELEMENT OCCURS 32 TIMES PIC S9(4) COMP.
01 ARGDESC.
O5 DESC-ELEMENT OCCURS 32 TIMES PIC S9(4) COMP.
01 NPARMS PIC S9(4) COMP.
PROCEDURE DIVISION.
BEGIN.
DISPLAY "Begin execution of CM main PROG".
*
* SET THE "REFERENCE" PARAMETER TO HAVE A VALUE OF 1
*
MOVE 1 TO ADD-TO-PARM.
Example 4-2. CM--> NM Switch, COBOL, continued
*
* ESTABLISH PROCNAME, LIBNAME, AND ASSOCIATED LENGTHS.
*
MOVE "testadd" TO PROCNAME.
MOVE 7 TO PROCNAME-LEN.
MOVE "NL" TO LIBNAME.
MOVE 2 TO LIBNAME-LEN.
MOVE 2 TO NPARMS.
*
* BUILD THE ARGUMENT LIST ARRAY:
* 1) 0 RESERVES SPACE FOR THE RETURN VALUE
* 2) 99 RESERVES SPACE FOR THE FIRST PARAMETER (BY VALUE),
* CALL .LOC. INTRINSIC TO GET ADDRESS OF THE
* BY-REFERENCE PARAMETER
*
MOVE 0 TO LIST-ELEMENT( 1 ).
MOVE 99 TO LIST-ELEMENT( 2 ).
CALL INTRINSIC ".LOC." USING ADD-TO-PARM
GIVING LIST-ELEMENT( 3 ).
*
* BUILD THE ARGUMENT DESCRIPTOR ARRAY
*
MOVE 2 TO DESC-ELEMENT( 1 ).
MOVE 6 TO DESC-ELEMENT( 2 ).
*
* MAKE THE SWITCH CALL
*
CALL "HPSWTONMNAME" USING @PROCNAME, \PROCNAME-LEN\,
@LIBNAME, \LIBNAME-LEN\,
\NPARMS\,
ARGLIST, ARGDESC,
\2\
GIVING SWITCH-STATUS.
*
* TEST STATUS
*
IF SWITCH-STATUS IS NOT ZERO
MOVE SWITCH-INFO TO DISP-INFO
MOVE SWITCH-SUBSYS TO DISP-SUBSYS
DISPLAY "Status info = ", DISP-INFO
DISPLAY "Status subsys = ", DISP-SUBSYS
ELSE
DISPLAY "HPSWTONMNAME completed successfully".
Example 4-2. CM--> NM Switch, COBOL, continued
*
* SHOW THE RETURN VALUE (WHICH SHOULD BE 100)
*
MOVE LIST-ELEMENT( 1 ) TO DISP-ANSWER.
DISPLAY "Return value = ", DISP-ANSWER.
STOP RUN.
*
* END COBOL II/V PROGRAM IN COMPATIBILITY MODE
*
{ Target Pascal/XL procedure in Native Mode }
$subprogram$
program dummy_outer_block(input, output);
TYPE
A8_INTEGER = $ALIGNMENT 1$ INTEGER;
FUNCTION TESTADD(
byvalueparm : SHORTINT;
VAR byrefparm : A8_INTEGER
) : SHORTINT;
BEGIN {function testadd }
TESTADD := byvalueparm + byrefparm;
END; {function testadd }
BEGIN {dummy_outer_block }
END. {dummy_outer_block }
{end Example 4-2 }