I have subprogram I inherited that is trapping calls to CATOPEN, CATREAD and
CATCLOSE, doing some things and then calling CATOPEN, CATREAD or CATCLOSE
using an HPGETPROCPLABEL followed by FCALL. The call to CATREAD seems to be
failing, i.e. it always returns -1 as the message length. I got some info
from HP regarding a previous problem with FCALL. This gave me an example of
how to use FCALL with READX. I changed my call to match the example, ( as
best I could ), but it still returns -1 as the message length. I have
written a little driver program to test the subroutine. When the driver is
run without the subroutine everything works as expected.
The following is the code for the subroutine:
$CODE_OFFSETS ON,TABLES ON$
$STANDARD_LEVEL 'EXT_MODCAL'$
$ASSUME 'NOTHING' $
$RANGE OFF$
$SUBPROGRAM$
MODULE CATLG;
EXPORT
$TITLE 'CATLG declarations : CATLGDCL' , PAGE$
CONST
c_filespec_len = 100;
c_filespec_delimiter = '.';
c_dummy_len = 1000;
c_index_file = 'CATLOGX';
c_log_file = 'CATLOG.DATA.CTB0000 ';
c_which_catalog_len = 7;
c_which_catalog = 'CTXLMSG';
TYPE
t_which_catalog = PACKED ARRAY [1..c_which_catalog_len] OF CHAR;
TYPE
t_version = STRING [23];
t_filespec = PACKED ARRAY [1..c_filespec_len] OF CHAR;
t_status = ARRAY [1..2] OF SHORTINT;
t_msg_buffer = PACKED ARRAY [1..c_dummy_len] OF CHAR;
t_parameter = PACKED ARRAY [1..c_dummy_len] OF CHAR;
CONST
cce = 2;
$TITLE 'Trace procedures declarations' , PAGE$
CONST
c_line_len = 128;
TYPE
t_line = STRING [c_line_len];
t_CATREAD =
FUNCTION (catindex : INTEGER;
setnum, msgnum : SHORTINT;
anyvar error : localanyptr;
anyvar buff : localanyptr;
buffsize : SHORTINT;
anyvar parm1, parm2, parm3, parm4, parm5 : localanyptr;
msgdest : SHORTINT) : SHORTINT
OPTION
DEFAULT_PARMS (buff := NIL,
buffsize := 72,
parm1 := NIL, parm2 := NIL, parm3 := NIL, parm4 := NIL,
parm5 := NIL,
msgdest := -1)
uncheckable_anyvar;
$UPPERCASE ON$
FUNCTION CATREAD (catindex : INTEGER;
setnum, msgnum : SHORTINT;
anyvar error : localanyptr;
anyvar buff : localanyptr;
buffsize : SHORTINT;
anyvar parm1, parm2, parm3, parm4, parm5 : localanyptr;
msgdest : SHORTINT) : SHORTINT
OPTION
DEFAULT_PARMS (buff := NIL,
buffsize := 72,
parm1 := NIL, parm2 := NIL, parm3 := NIL, parm4 := NIL,
parm5 := NIL,
msgdest := 0)
uncheckable_anyvar;
$UPPERCASE OFF$
FUNCTION VERSION_CATLG: t_version;
IMPLEMENT
VAR
glob_ctxlmsg_opened: BOOLEAN;
FUNCTION VERSION_CATLG : t_version;
BEGIN
$VERSION 'CATLG C0000J_X210/05/99'$
VERSION_CATLG := 'CATLG C0000J_X210/05/99';
END;
PROCEDURE HPGETPROCPLABEL ; INTRINSIC ;
$TITLE 'CATREAD' , PAGE$
FUNCTION CATREAD (catindex : INTEGER;
setnum, msgnum : SHORTINT;
anyvar error : localanyptr;
anyvar buff : localanyptr;
buffsize : SHORTINT;
anyvar parm1, parm2, parm3, parm4, parm5 : localanyptr;
msgdest : SHORTINT) : SHORTINT
OPTION
DEFAULT_PARMS (buff := NIL,
buffsize := 72,
parm1 := NIL, parm2 := NIL, parm3 := NIL, parm4 := NIL,
parm5 := NIL,
msgdest := -1)
uncheckable_anyvar;
TYPE
t_name = PACKED ARRAY[1..37] of char ;
VAR
f_lib : t_name ;
plabel : t_CATREAD ;
procname : t_name ;
status : INTEGER ;
msglen : INTEGER ;
$TITLE 'Main line of CATREAD' , PAGE$
BEGIN {CATREAD}
f_lib := '%XL.PUB.SYS% ';
procname := '%CATREAD% ';
HPGETPROCPLABEL( procname
,plabel
,status
,f_lib
);
{ Call now the procedure }
msglen := 0 ;
msglen :=
FCALL ( plabel ,
catindex,setnum,msgnum,error,
buff,buffsize,parm1,parm2,parm3,parm4,parm5,
msgdest);
CATREAD := msglen;
END {CATREAD};
$TITLE 'DUMMY OUTER BLOCK' , PAGE$
END.
The following is a driver to test the subroutine.
$standard_level 'ext_modcal'$
$CODE_OFFSETS ON,TABLES ON$
Program test(input,output);
CONST
c_f_name_len = 32;
c_procinfo_len = 680;
TYPE
single_integer = shortint ;
t_procinfo_buffer = STRING[c_procinfo_len];
VAR
cat_name : STRING [c_f_name_len];
error_array : PACKED ARRAY[1..2] OF single_integer;
parm1 : PACKED ARRAY[1..2] OF single_integer;
parm2 : PACKED ARRAY[1..2] OF single_integer;
parm3 : PACKED ARRAY[1..2] OF single_integer;
parm4 : PACKED ARRAY[1..2] OF single_integer;
parm5 : PACKED ARRAY[1..2] OF single_integer;
msgdest : single_integer;
trprocinfo : INTEGER;
procinfo_buffer : t_procinfo_buffer;
proc_nbr : single_integer;
set_num : single_integer;
msg_len : single_integer;
FUNCTION CATOPEN: INTEGER; INTRINSIC;
FUNCTION CATREAD: SHORTINT; INTRINSIC;
PROCEDURE CATCLOSE; INTRINSIC;
BEGIN
parm1[1] := 0;
parm2[1] := 0;
parm3[1] := 0;
parm4[1] := 0;
parm5[1] := 0;
msgdest := 0;
cat_name := 'CTXLINFO.DATA.CTB0004';
trprocinfo := CATOPEN(cat_name, error_array );
IF error_array[1] <> 0
THEN
BEGIN
WRITELN ( 'CATOPEN error on file ', cat_name, '. Error nbr : ',
error_array[1]:1);
END
ELSE
BEGIN
WRITELN ('Catalog opened');
proc_nbr := 162;
set_num :=( proc_nbr DIV 10 ) + 1;
procinfo_buffer :='This is a test';
msg_len := CATREAD (trprocinfo, set_num, proc_nbr,
error_array, procinfo_buffer , c_procinfo_len
,parm1, parm2, parm3, parm4, parm5, msgdest);
IF error_array[1] <> 0
THEN
BEGIN
WRITELN('Cannot read procedure description. ',
'Procedure number: ', proc_nbr:5 );
WRITELN('CATREAD error number: ', error_array[1]:1);
END
ELSE
WRITELN('Catalog Read, Entry Len:', msg_len);
setstrlen(procinfo_buffer,msg_len );
WRITELN( procinfo_buffer:msg_len );
END;
CATCLOSE (trprocinfo, error_array );
END.
Regards,
Ernest Hill
eXegeSys, Inc.
144 S. 500 E.
SLC, UT 84109
(801) 799-0917
[log in to unmask]
|
