HP 3000 Manuals HP 3000 Manuals
Appendix C HPDInterrupt Routines
Below are two routines that you may find useful when attempting to write
application programs to integrate in HP Desk using the Application
Umbrella. Note that these are not supported by Hewlett-Packard.
{ ***************************************************************** }
{ }
{ General routines that perform initialization of the XDS, and }
{ a second routine that performs the interrupt function. }
{ }
{ The routines have all their parameters passed by reference. This }
{ is so that they could be called from Cobol and Fortran without }
{ causing too many problems. }
{ }
{ }
{ }
{ Error returns are for the range }
{ 0..1999 HP Desk application data passing defined errors }
{ }
{ 10000 Failed to identify my father process }
{ (Probably program not PREPed with PH cap) }
{ 10001 Father is NOT HP Desk }
{ 10002 XDS did not exist }
{ 11000 DMOVIN failed }
{ 11001 DMOVOUT failed }
{ 11002 PUTJCW failed }
{ 11003 FINDJCW failed }
{ }
{ External declarations for other programs to call: }
{ }
{ PASCAL:
procedure HPDInterruptInit ( Var export_info : EXPORT_INFO_TYPE;
Var dseg_id : SHORTINT;
Var error_code : SHORTINT);
EXTERNAL;
procedure HPDInterruptMode ( Var mode : SHORTINT;
Var export_info: EXPORT_INFO_TYPE;
Var dseg_id : SHORTINT;
Var error_code : SHORTINT);
EXTERNAL;
}
{ ***************************************************************** }
$standard_level 'HP3000'$
$subprogram$
$segment 'UTILITIES'$
$tables on$
$code_offsets on$
$check_actual_parm 0$
$check_formal_parm 0$
program utilities;
$include 'exportdf.maillib.hpoffice'$
{ include standard definitions }
procedure HPDInterruptInit ( Var export_info : EXPORT_INFO_TYPE;
Var dseg_id : SHORTINT;
Var error_code : SHORTINT);
{ ********************************************************************** }
{ }
{ This routine is used to ensure that we are running as a son process }
{ of HP Desk, and then initialize access to the XDS. The XDS is }
{ read in so that the username and capability fields can be used }
{ immediately. }
{ }
{ Parameters: }
{ }
{ DSEG_ID The dseg id returned by this routine is }
{ used to access the information XDS }
{ passed between HP Desk and the application. }
{ EXPORT_INFO The application's data area which holds it's }
{ copy of the information XDS. }
{ ERROR_CODE Returns the status of the interrupt request. }
{ }
{ ********************************************************************** }
Label
999;
Var
length : SHORTINT;
father_pin : SHORTINT;
error1,
error2 : SHORTINT;
itemnum1 : SHORTINT;
program_name : packed array [1..28] of CHAR;
procedure procinfo; intrinsic;
procedure getdseg; intrinsic;
procedure freedseg; intrinsic;
procedure dmovin; intrinsic;
function father : SHORTINT; intrinsic;
begin
error_code := 0;
export_info.whole := export_info_init; { clear out the XDS area }
dseg_id := 0;
father_pin := FATHER; { Obtain the pin number of our }
{ father process so that we can }
{ find out exactly who it is }
itemnum1 := 10; { we want the program name }
procinfo ( error1, error2, father_pin, itemnum1, program_name);
if error1 <> 0 then
begin
error_code := 10000;
GOTO 999;
end;
if program_name <> 'HPMAIL.HPMAIL.SYS' then
begin { it should be HPMAIL, if not then }
{ we return the fact that we are }
{ not under HP Desk }
error_code := 10001;
GOTO 999;
end;
{ ** Now, obtain a reference to the XDS that Desk uses to pass information }
{ to and from applications. Getdseg should return a status that the XDS }
{ already exists (created by HP Desk on start up). If the XDS does not }
{ exist then we are not under a version of HP Desk that supports data }
{ passing. In this case we tidy up the XDS by freeing it and report back}
length := len_export_info;
getdseg(dseg_id, length, export_info_dseg_id);
if ccode <> 0 then
begin
if ccode = 2 then
begin
freedseg(dseg_id, export_info_dseg_id);
error_code := 10002;
end
else
error_code := 10003;
dseg_id := 0;
GOTO 999;
end;
{ ** Read in the current content of the XDS as this should already hold }
{ the user name and capabilities fields. }
dmovin( dseg_id, 0, len_export_info, export_info);
if ccode <> 2 then
error_code := 11000;
999:
end;
procedure HPDInterruptMode ( Var mode : SHORTINT;
Var export_info: EXPORT_INFO_TYPE;
Var dseg_id : SHORTINT;
Var error_code : SHORTINT);
{ ********************************************************************** }
{ }
{ This routine is used to perform the interrupt service request to }
{ HP Desk. It will return any error from Desk, or other MPE intrinsic. }
{ }
{ Parameters: }
{ }
{ MODE The interrupt mode requested. }
{ EXPORT_INFO The application's data area which holds it's }
{ copy of the information XDS. }
{ DSEG_ID The dseg id returned by the initialization }
{ routine, used to access the information XDS }
{ passed between HP Desk and the application. }
{ ERROR_CODE Returns the status of the interrupt request. }
{ }
{ }
{ ********************************************************************** }
Var
jcwname : STRING[20];
jcwerror : SHORTINT;
initjcw : SHORTINT;
procedure dmovout; intrinsic;
procedure dmovin; intrinsic;
procedure activate; intrinsic;
procedure putjcw; intrinsic;
procedure findjcw; intrinsic;
begin
{ ** Ensure that the XDS has the current information we have set up **}
error_code := 0;
dmovout(dseg_id, 0, len_export_info, export_info);
if ccode <> 2 then
error_code := 11001
else
begin
{ Initialize the error jcw }
jcwname := 'HPDESKERR ';
initjcw := 0;
putjcw(jcwname, initjcw, jcwerror);
if jcwerror <> 0 then
error_code := 11002
else
begin
{ Now set the jcw to indicate which}
{ interrupt mode we wish to use }
jcwname := 'HPDESKPROCCONTROL ';
putjcw(jcwname, mode, jcwerror);
if jcwerror <> 0 then
error_code := 11002
else
begin
activate(0, 1); { interrupt to HP Desk, wait while }
{ it performs the work }
jcwname := 'HPDESKERR ';
{ Now check the status returned }
{ to HP Desk, as given in the jcw }
findjcw(jcwname, error_code, jcwerror);
if jcwerror <> 0 then
error_code := 11003
else
if error_code = 0 then
begin
{ If all is OK then read back the }
{ current state of the XDS data }
dmovin(dseg_id, 0, len_export_info, export_info);
if ccode <> 2 then
error_code := 11000;
end;
end;
end;
end;
end;
begin
{ Dummy outer block }
end.