I am continuing is my attempt to write CM switch stubs for the new date
intrinsics since Gopi informed me HP has no plans for CM versions of them.
HPDATECONVERT, HPDATEDIFF, HPDATEOFFSET and HPCALENDAR are working fine,
but I can't seem to get HPDATEFORMAT to work. No matter what I pass for the
input date I get -2 returned in the first word on the status. Since we
still don't have power patch 4 I have no idea what the error means. The odd
thing that happens is if I change the calls in the COBOL program to call
intrinsic and recompile it in nm everything works except HPDATEFORMAT on
the value returned by HPCALENDAR. Below is the output from the cm version
of the program calling my switch stubs and the nm version calling the
intrinsics. I have also include the source for the COBOL calling program
and the PASCAL source for the switch stubs. Any help would be greatly
appreciated.
Ernest Hill
BDM International
Unit 61323, Box 134R
APO, AE 09803-1323
Phone: 966-1-248-1040 xt. 242
Fax: 966-1-478-5622
p.s. This is my first attempt at pascal so it is very possible I am making
a mistake obvious to someone with more experience in the language
CM RESULTS
-------------------------------------
RUN NEWTESTX;LIB=G
Enter Date to convert (YYMMDD):980101
Converted Date:19980101
HPDATEFORMAT FAILED
WS-STATUS1: 318D
WS-STATUS2: 416C
Enter Next Date (YYMMDD): 990101
Difference: 000000365
Start Date: 980101
Offset: 00000001{
New Date: 980111
ENTER THE DATE TO VALIDATE: 980101
INVALID DATE:980101
WS-STATUS1: 000K
WS-STATUS2: 052I
HPCALENDAR WORD 1: 000{
HPCALENDAR WORD 2: 522}
Conversion of date from HPCALENDAR: 19980520
NM RESULTS
--------------------------------------------
%RUN NEWTESTO;XL="DATEXL.PUB.SYS"
Enter Date to convert (YYMMDD):980101
Converted Date:19980101
FORMATED DATE: 01/01/98
Enter Next Date (YYMMDD): 990101
Difference: 000000365
Start Date: 980101
Offset: +000000010
New Date: 980111
ENTER THE DATE TO VALIDATE: 980101
VALID DATE: 980101
HPCALENDAR WORD 1: +0000
HPCALENDAR WORD 2: -5220
Conversion of date from HPCALENDAR:
COBOL Driver Source
-----------------------------------
$CONTROL BOUNDS
$CONTROL MAP,VERBS
IDENTIFICATION DIVISION.
PROGRAM-ID. NEWTEST.
DATE-WRITTEN. WED, MAY 20, 1998, 10:07 AM.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 INPUTCODE PIC S9(9) COMP
VALUE 25.
01 INPUTDATE PIC X(32)
VALUE "980101".
01 OUTPUTCODE PIC S9(9) COMP
VALUE 38.
01 OUTPUTDATE PIC X(32)
VALUE SPACES.
01 WS-STATUS PIC S9(9) COMP
VALUE 0.
01 FILLER REDEFINES WS-STATUS.
05 WS-STATUS1 PIC S9(4) COMP.
05 WS-STATUS2 PIC S9(4) COMP.
01 FILLER REDEFINES WS-STATUS.
05 WS-STATUSX PIC X(4).
01 CUT-OFF PIC S9(9) COMP
VALUE 40.
01 NEXTDATE PIC X(8).
01 DATE1 PIC S9(9) COMP.
01 FILLER REDEFINES DATE1.
05 DATE1-A PIC S9(4) COMP.
05 DATE1-B PIC S9(4) COMP.
01 DATE2 PIC S9(9) COMP.
01 FILLER REDEFINES DATE2.
05 DATE2-A PIC S9(4) COMP.
05 DATE2-B PIC S9(4) COMP.
01 DIFF-IN-DAYS PIC S9(9) COMP.
01 DISP-DIFF PIC -9(9).
01 OFFSET PIC S9(9) COMP.
01 FORMATSPEC PIC X(30).
01 FILLER REDEFINES FORMATSPEC.
05 FORMAT-SPEC PIC X(8).
05 NULL-TERM PIC S9(4) COMP.
05 FILLER PIC X(20).
01 FMTDATE PIC X(30).
01 FMTDATELEN PIC S9(8) COMP
VALUE 8.
PROCEDURE DIVISION.
MAIN-LINE-SECTION SECTION.
MAIN-LINE.
DISPLAY "Enter Date to convert (YYMMDD):" NO ADVANCING.
ACCEPT INPUTDATE.
MOVE "OUTDATE " TO OUTPUTDATE.
CALL "HPDATECONVERT" USING \INPUTCODE\ INPUTDATE
\OUTPUTCODE\ OUTPUTDATE WS-STATUSX \CUT-OFF\.
IF WS-STATUS NOT = 0
DISPLAY "HPDATECONVERT FAILED"
DISPLAY "WS-STATUS1: " WS-STATUS1
DISPLAY "WS-STATUS2: " WS-STATUS2
ELSE
DISPLAY "Converted Date:" OUTPUTDATE
.
MOVE "MM/DD/YY" TO FORMAT-SPEC.
MOVE 0 TO NULL-TERM.
CALL "HPDATEFORMAT" USING \INPUTCODE\ INPUTDATE @FORMATSPEC
@FMTDATE FMTDATELEN WS-STATUSX \CUT-OFF\.
IF WS-STATUS NOT = 0
DISPLAY "HPDATEFORMAT FAILED"
DISPLAY "WS-STATUS1: " WS-STATUS1
DISPLAY "WS-STATUS2: " WS-STATUS2
ELSE
DISPLAY "FORMATED DATE: " FMTDATE
.
DISPLAY "Enter Next Date (YYMMDD): " NO ADVANCING.
ACCEPT NEXTDATE.
MOVE 25 TO INPUTCODE.
MOVE 2000 TO DATE1-A.
MOVE 1 TO DATE1-B.
MOVE 1999 TO DATE2-A.
MOVE 360 TO DATE2-B.
CALL "HPDATEDIFF" USING \INPUTCODE\ INPUTDATE NEXTDATE
DIFF-IN-DAYS WS-STATUSX \CUT-OFF\.
IF WS-STATUS NOT = 0
DISPLAY "HPDATEDIFF FAILED"
DISPLAY "WS-STATUS1: " WS-STATUS1
DISPLAY "WS-STATUS2: " WS-STATUS2
ELSE
MOVE DIFF-IN-DAYS TO DISP-DIFF
DISPLAY "Difference: " DISP-DIFF
.
MOVE 10 TO OFFSET.
MOVE 50 TO CUT-OFF.
MOVE SPACES TO OUTPUTDATE.
CALL "HPDATEOFFSET" USING \INPUTCODE\ INPUTDATE \OFFSET\
OUTPUTDATE WS-STATUSX \CUT-OFF\.
IF WS-STATUS NOT = 0
DISPLAY "HPDATEOFFSET FAILED"
DISPLAY "WS-STATUS1: " WS-STATUS1
DISPLAY "WS-STATUS2: " WS-STATUS2
ELSE
DISPLAY "Start Date: " INPUTDATE
DISPLAY "Offset: " OFFSET
DISPLAY "New Date: " OUTPUTDATE
.
MOVE 25 TO INPUTCODE.
DISPLAY "ENTER THE DATE TO VALIDATE: " NO ADVANCING.
ACCEPT INPUTDATE.
CALL "HPDATEVALIDATE" USING \INPUTCODE\ INPUTDATE \CUT-OFF\
GIVING WS-STATUS.
IF WS-STATUS NOT = 0
DISPLAY "INVALID DATE:" INPUTDATE
DISPLAY "WS-STATUS1: " WS-STATUS1
DISPLAY "WS-STATUS2: " WS-STATUS2
ELSE
DISPLAY "VALID DATE: " INPUTDATE
.
CALL "HPCALENDAR" GIVING WS-STATUS.
DISPLAY "HPCALENDAR WORD 1: " WS-STATUS1.
DISPLAY "HPCALENDAR WORD 2: " WS-STATUS2.
MOVE 4 TO INPUTCODE.
MOVE SPACES TO OUTPUTDATE.
CALL "HPDATECONVERT" USING \INPUTCODE\ WS-STATUSX
\OUTPUTCODE\ OUTPUTDATE WS-STATUSX \CUT-OFF\.
IF WS-STATUS NOT = 0
DISPLAY "HPDATECONVERT FAILED"
DISPLAY "WS-STATUS1: " WS-STATUS1
DISPLAY "WS-STATUS2: " WS-STATUS2
ELSE
DISPLAY "Conversion of date from HPCALENDAR: " OUTPUTDATE
.
STOP RUN.
PASCAL SOURCE OF SWITCH STUBS
--------------------------------------------------
$standard_level 'hp3000'$
$subprogram$
$uslinit$
program m(input,output);
type
shortint = -32768..32767;
shr_ary32 = packed array [1..32] of shortint;
shr_ary4 = packed array [1..4] 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;
var
status : xlstatus;
function HPSWTONMNAME : integer; intrinsic;
function HPSWTONMPLABEL : integer; intrinsic;
function HPLOADNMPROC : integer; intrinsic;
procedure DEBUG; intrinsic;
procedure QUIT; intrinsic;
Procedure hpdateconvert (
input_code : integer;
var input_date : integer;
output_code : integer;
var output_date : integer;
var dt_status : shr_ary4;
cut_off : integer );
var
arglist : shr_ary32;
argdesc : shr_ary32;
fct_typ : shortint;
lib_name : pac16;
lib_len : shortint;
nparms : shortint;
ws_status : packed array [1..4] of shortint;
proc_name : pac16;
proc_len : shortint;
rtn_st : integer;
begin
proc_name := 'HPDATECONVERT ';
proc_len := 13;
lib_name := 'DATEXL.PUB.SYS ';
lib_len := 14;
nparms := 7;
arglist[1] := 0;
arglist[2] := 6;
argdesc[1] := 3;
arglist[3] := 0;
arglist[4] := input_code;
argdesc[2] := 3;
arglist[5] := waddress(input_date);
argdesc[3] := 6;
arglist[6] := 0;
arglist[7] := output_code;
argdesc[4] := 3;
arglist[8] := waddress(output_date);
argdesc[5] := 6;
arglist[9] := waddress(ws_status);
if (arglist[9] Mod 2 > 0) then
arglist[9] := arglist[9] + 1;
argdesc[6] := 6;
arglist[10] := 0;
arglist[11] := cut_off;
argdesc[7] := 3;
fct_typ := 00;
rtn_st := HPSWTONMNAME (proc_name,
proc_len,
lib_name,
lib_len,
nparms,
arglist,
argdesc,
fct_typ);
if rtn_st <> 0 then QUIT (1);
if (waddress(ws_status) Mod 2 = 0) then
begin
dt_status[1] := ws_status [1];
dt_status[2] := ws_status [2];
end
else
begin
dt_status[1] := ws_status[2];
dt_status[2] := ws_status[3];
end;
end;
Procedure hpdateformat (
date_code : integer;
var input_date : integer;
var formatspec : pac16;
var fmtdate : pac16;
var fmtdatelen : integer;
var dt_status : shr_ary4;
cut_off : integer );
var
arglist : shr_ary32;
argdesc : shr_ary32;
fct_typ : shortint;
lib_name : pac16;
lib_len : shortint;
nparms : shortint;
ws_status : packed array [1..4] of shortint;
proc_name : pac16;
proc_len : shortint;
rtn_st : integer;
begin
proc_name := 'HPDATEFORMAT ';
proc_len := 12;
lib_name := 'DATEXL.PUB.SYS ';
lib_len := 14;
nparms := 8;
arglist[1] := 0;
arglist[2] := 7;
argdesc[1] := 3;
arglist[3] := 0;
arglist[4] := date_code;
argdesc[2] := 3;
arglist[5] := waddress(input_date);
argdesc[3] := 6;
arglist[6] := baddress(formatspec);
argdesc[4] := 5;
arglist[7] := baddress(fmtdate);
argdesc[5] := 5;
arglist[8] := waddress(fmtdatelen);
argdesc[6] := 6;
arglist[9] := waddress(ws_status);
if (arglist[9] Mod 2 > 0) then
arglist[9] := arglist[9] + 1;
argdesc[7] := 6;
arglist[10] := 0;
arglist[11] := cut_off;
argdesc[7] := 3;
fct_typ := 00;
rtn_st := HPSWTONMNAME (proc_name,
proc_len,
lib_name,
lib_len,
nparms,
arglist,
argdesc,
fct_typ);
if (waddress(ws_status) Mod 2 = 0) then
begin
dt_status[1] := ws_status [1];
dt_status[2] := ws_status [2];
end
else
begin
dt_status[1] := ws_status[2];
dt_status[2] := ws_status[3];
end;
end;
Procedure hpdatediff (
date_code : integer;
var first_date : integer;
var second_date : integer;
var diff_in_days : integer;
var dt_status : shr_ary4;
cut_off : integer );
var
arglist : shr_ary32;
argdesc : shr_ary32;
fct_typ : shortint;
lib_name : pac16;
lib_len : shortint;
nparms : shortint;
ws_status : packed array [1..4] of shortint;
proc_name : pac16;
proc_len : shortint;
rtn_st : integer;
begin
proc_name := 'HPDATEDIFF ';
proc_len := 10;
lib_name := 'DATEXL.PUB.SYS ';
lib_len := 14;
nparms := 7;
arglist[1] := 0;
arglist[2] := 6;
argdesc[1] := 3;
arglist[3] := 0;
arglist[4] := date_code;
argdesc[2] := 3;
arglist[5] := waddress(first_date);
argdesc[3] := 6;
arglist[6] := waddress(second_date);
argdesc[4] := 6;
arglist[7] := waddress(diff_in_days);
argdesc[5] := 6;
arglist[8] := waddress(ws_status);
if (arglist[8] Mod 2 > 0) then
arglist[8] := arglist[8] + 1;
argdesc[6] := 6;
arglist[9] := 0;
arglist[10] := cut_off;
argdesc[7] := 3;
fct_typ := 00;
rtn_st := HPSWTONMNAME (proc_name,
proc_len,
lib_name,
lib_len,
nparms,
arglist,
argdesc,
fct_typ);
if (waddress(ws_status) Mod 2 = 0) then
begin
dt_status[1] := ws_status [1];
dt_status[2] := ws_status [2];
end
else
begin
dt_status[1] := ws_status[2];
dt_status[2] := ws_status[3];
end;
end;
Procedure hpdateoffset (
date_code : integer;
var input_date : integer;
offset : integer;
var output_date : integer;
var dt_status : shr_ary4;
cut_off : integer );
var
arglist : shr_ary32;
argdesc : shr_ary32;
fct_typ : shortint;
lib_name : pac16;
lib_len : shortint;
nparms : shortint;
ws_status : packed array [1..4] of shortint;
proc_name : pac16;
proc_len : shortint;
rtn_st : integer;
begin
proc_name := 'HPDATEOFFSET ';
proc_len := 12;
lib_name := 'DATEXL.PUB.SYS ';
lib_len := 14;
nparms := 7;
arglist[1] := 0;
arglist[2] := 6;
argdesc[1] := 3;
arglist[3] := 0;
arglist[4] := date_code;
argdesc[2] := 3;
arglist[5] := waddress(input_date);
argdesc[3] := 6;
arglist[6] := 0;
arglist[7] := offset;
argdesc[4] := 3;
arglist[8] := waddress(output_date);
argdesc[5] := 6;
arglist[9] := waddress(ws_status);
if (arglist[9] Mod 2 > 0) then
arglist[9] := arglist[9] + 1;
argdesc[6] := 6;
arglist[10] := 0;
arglist[11] := cut_off;
argdesc[7] := 3;
fct_typ := 00;
rtn_st := HPSWTONMNAME (proc_name,
proc_len,
lib_name,
lib_len,
nparms,
arglist,
argdesc,
fct_typ);
if (waddress(ws_status) Mod 2 = 0) then
begin
dt_status[1] := ws_status [1];
dt_status[2] := ws_status [2];
end
else
begin
dt_status[1] := ws_status[2];
dt_status[2] := ws_status[3];
end;
end;
Function hpdatevalidate (
date_code : integer;
var input_date : integer;
cut_off : integer )
: xlstatus;
var
arglist : shr_ary32;
argdesc : shr_ary32;
fct_typ : shortint;
lib_name : pac16;
lib_len : shortint;
nparms : shortint;
ws_status : packed array [1..4] of shortint;
proc_name : pac16;
proc_len : shortint;
rtn_st : integer;
begin
proc_name := 'HPDATEVALIDATE ';
proc_len := 14;
lib_name := 'DATEXL.PUB.SYS ';
lib_len := 14;
nparms := 5;
arglist[1] := 0;
arglist[2] := 0;
argdesc[1] := 3;
arglist[3] := 0;
arglist[4] := 3;
argdesc[2] := 3;
arglist[5] := 0;
arglist[6] := date_code;
argdesc[3] := 3;
arglist[7] := waddress(input_date);
argdesc[4] := 6;
arglist[8] := 0;
arglist[9] := cut_off;
argdesc[5] := 3;
fct_typ := 03;
rtn_st := HPSWTONMNAME (proc_name,
proc_len,
lib_name,
lib_len,
nparms,
arglist,
argdesc,
fct_typ);
if (rtn_st <> 0) then
hpdatevalidate.all := rtn_st
else
begin
hpdatevalidate.info := arglist[1];
hpdatevalidate.subsys := arglist[2];
end;
end;
Function hpcalendar
: xlstatus;
var
arglist : shr_ary32;
argdesc : shr_ary32;
fct_typ : shortint;
lib_name : pac16;
lib_len : shortint;
nparms : shortint;
ws_status : packed array [1..4] of shortint;
proc_name : pac16;
proc_len : shortint;
rtn_st : integer;
begin
proc_name := 'HPCALENDAR ';
proc_len := 10;
lib_name := 'DATEXL.PUB.SYS ';
lib_len := 14;
nparms := 1;
arglist[1] := 0;
arglist[2] := 0;
argdesc[1] := 3;
fct_typ := 03;
rtn_st := HPSWTONMNAME (proc_name,
proc_len,
lib_name,
lib_len,
nparms,
arglist,
argdesc,
fct_typ);
if (rtn_st <> 0) then
hpcalendar.all := rtn_st
else
begin
hpcalendar.info := arglist[1];
hpcalendar.subsys := arglist[2];
end;
end;
begin
end.
|
