HP3000-L Archives

May 1998, Week 2

HP3000-L@RAVEN.UTC.EDU

Options: Use Monospaced Font
Show Text Part by Default
Show All Mail Headers

Message: [<< First] [< Prev] [Next >] [Last >>]
Topic: [<< First] [< Prev] [Next >] [Last >>]
Author: [<< First] [< Prev] [Next >] [Last >>]

Print Reply
Subject:
From:
John Zoltak <[log in to unmask]>
Reply To:
John Zoltak <[log in to unmask]>
Date:
Wed, 13 May 1998 13:06:44 -0400
Content-Type:
text/plain
Parts/Attachments:
text/plain (261 lines)
Perhaps the LINKAGE section parameters are not aligned properly in the
non-working case. Try copying them to 77 or 01 level or SYNC type items
local to the subprogram. Try the program then.

John Zoltak
North American Mfg Co

> -----Original Message-----
> From: Ernest Hill [SMTP:[log in to unmask]]
> Sent: Wednesday, May 13, 1998 12:16 PM
> To:   [log in to unmask]
> Subject:      [HP3000-L] Help! Switch Stub for HPDATECONVERT
>
> Listers,
> I have been working on this problem for days and it is driving me
> crazy! I
> would really appreciate it if one of you experts could give me some
> help.
> We are currently 5.5 powerpatch 3. We have not yet received powerpatch
> 4
> here in Saudi Arabia. I downloaded the new date intrinsics off HP's
> web
> site so we could use them. The problem is we are still running COBOL
> in
> compatibility mode, so I needed to write a switch stub to call the
> routines. I wrote a switch stub to call HPDATECONVERT. When I started
> calling the routine is when the fun started. The first iteration of my
> test
> program worked fine (see below). But when I added an ACCEPT statement
> to
> the program I got the following error:
> RUN NEWTESTX;LIB=G
> Enter Date (YYMMDD):
> 980101
>
> **** INTERNAL TRAP
> Data Memory Protection Trap
> [VSM] Invalid Address Alignment
> ABORT: NEWTESTX.HILL.AUTODEV
> NM USER  328.0012e398 HPDATECONVERT+$6c
> NM SYS   a.00e8ad94 arg_regs+$28
>    CM SYS  % 230.350    HPSWTONMPLABEL+%4       SUSER1
>    CM GRP  % 240.320
>    CM PROG %   0.55
> Program terminated in an error state. (CIERR 976)
> If I take out the ACCEPT or make the picture of the variable INPUTDATE
> X(30) instead of X(32) the program works fine. If I leave INPUTDATE
> X(30)
> and remove the ACCEPT the program aborts with the same error. I can
> also
> get the program to work with INPUTDATE as X(32) if I add another
> ACCEPT
> statement in addition to this first. The additional ACCEPT must accept
> a
> different variable than the first. Any help would be greatly
> appreciated.
> See below for the switch stub routine as well as the two versions of
> the
> calling program.
> ------------------------------Switch Stub
> Subroutine-----------------------------
> 001000$CONTROL BOUNDS
> 001100$CONTROL SYNC32
> 001200$CONTROL DYNAMIC
> 001300 IDENTIFICATION DIVISION.
> 001400 PROGRAM-ID. SUTLBXZ.
> 001500 DATE-WRITTEN. WED, MAY 13, 1998,  7:43 AM.
> 001600 ENVIRONMENT DIVISION.
> 001700 CONFIGURATION SECTION.
> 001800 SOURCE-COMPUTER. HP3000.
> 001900 OBJECT-COMPUTER. HP3000.
> 002000 SPECIAL-NAMES.
> 002100     CONDITION-CODE IS CC
> 002200     .
> 002300 DATA DIVISION.
> 002400
> 002500 WORKING-STORAGE SECTION.
> 002600
> 002700 01 WS-STATUS.
> 002800    05  STATUS-1      PIC S9(4) COMP SYNC.
> 002900    05  STATUS-2      PIC S9(4) COMP SYNC.
> 003000 01 INPUTDATE         PIC X(8) SYNC.
> 003100 01 OUTPUTDATE        PIC X(8) SYNC.
> 003200 01 NAME-DATE                          PIC X(29)
> 003300    VALUE "NAME-DATE = SUTLBXZ A00980513".
> 003400 01 ROUTINE-NAME                       PIC X(16)
> 003500    VALUE SPACES.
> 003600 01 PLABEL-NBR                         PIC S9(9) COMP
> 003700    VALUE 0.
> 003800 01 PROC-LEN                           PIC S9(4) COMP
> 003900    VALUE 0.
> 004000 01 XL-NAME                            PIC X(16).
> 004100 01 XL-LEN                             PIC S9(4) COMP
> 004200    VALUE 0.
> 004300 01 PARM-NBR                           PIC S9(4) COMP
> 004400    VALUE 0.
> 004500 01 ARGLIST                            PIC X(64).
> 004600 01 FILLER REDEFINES ARGLIST.
> 004700    05 FILLER                          OCCURS 32 TIMES.
> 004800       10 LIST-ELEMENT                 PIC S9(4) COMP.
> 004900 01 ARGDESC                            PIC X(64).
> 005000 01 FILLER REDEFINES ARGDESC.
> 005100    05 FILLER                          OCCURS 32 TIMES.
> 005200       10 DESC-ELEMENT                 PIC S9(4) COMP.
> 005300 01 PLABEL-STAT                        PIC S9(9) COMP
> 005400    VALUE 0.
> 005500 01 FILLER REDEFINES PLABEL-STAT.
> 005600    05 PLABEL-STAT-1                   PIC S9(4) COMP.
> 005700    05 PLABEL-STAT-2                   PIC S9(4) COMP.
> 005800 01 INPUTCODE                          PIC S9(9) COMP
> 005900    VALUE 25.
> 006000 01 OUTPUTCODE                         PIC S9(9) COMP
> 006100    VALUE 38.
> 006200 01 CUTOFF                             PIC S9(9) COMP
> 006300    VALUE 40.
> 006400
> 006500 LINKAGE SECTION.
> 006600 01 INPUT-CODE                         PIC S9(9)  COMP.
> 006700 01 INPUT-DATE                         PIC X(6).
> 006800 01 OUTPUT-CODE                        PIC S9(9)  COMP.
> 006900 01 OUTPUT-DATE                        PIC X(8).
> 007000 01 DT-STATUS                          PIC S9(9)  COMP.
> 007100 01 CUT-OFF                            PIC S9(9)  COMP.
> 007200 PROCEDURE DIVISION USING INPUT-CODE INPUT-DATE OUTPUT-CODE
> 007300
> 007400   OUTPUT-DATE DT-STATUS CUT-OFF.
> 007500
> 007600 MAIN-LINE-SECTION SECTION.
> 007700
> 007800 MAIN-LINE.
> 007900
> 008000     PERFORM 1000-LOADNMPROC.
> 008100     PERFORM 2000-GETLOC.
> 008200     PERFORM 3000-SWTONMPLABEL.
> 008300     GOBACK.
> 008400
> 008500 1000-LOADNMPROC.
> 008600
> 008700     MOVE "HPDATECONVERT"          TO ROUTINE-NAME.
> 008800     MOVE 13                       TO PROC-LEN.
> 008900     MOVE "DATEXL.PUB.SYS"         TO XL-NAME.
> 009000     MOVE 14                       TO XL-LEN.
> 009100     CALL INTRINSIC "HPLOADNMPROC" USING ROUTINE-NAME PROC-LEN
> 009200       XL-NAME XL-LEN GIVING PLABEL-NBR.
> 009300
> 009400 2000-GETLOC.
> 009500
> 009600     MOVE 0                        TO LIST-ELEMENT(1).
> 009700     MOVE 6                        TO LIST-ELEMENT(2).
> 009800     MOVE 3                        TO DESC-ELEMENT(1).
> 009900     MOVE 0                        TO LIST-ELEMENT(3).
> 010000     MOVE INPUT-CODE               TO LIST-ELEMENT(4).
> 010100     MOVE 3                        TO DESC-ELEMENT(2).
> 010200     MOVE INPUT-DATE               TO INPUTDATE.
> 010300     CALL INTRINSIC ".LOC." USING INPUTDATE GIVING
> LIST-ELEMENT(5
> 010400       ).
> 010500     MOVE 6                        TO DESC-ELEMENT(3).
> 010600     MOVE 0                        TO LIST-ELEMENT(6).
> 010700     MOVE OUTPUT-CODE              TO LIST-ELEMENT(7).
> 010800     MOVE 3                        TO DESC-ELEMENT(4).
> 010900     CALL INTRINSIC ".LOC." USING OUTPUTDATE GIVING
> LIST-ELEMENT(
> 011000       8).
> 011100     MOVE 6                        TO DESC-ELEMENT(5).
> 011200     CALL INTRINSIC ".LOC." USING WS-STATUS GIVING
> LIST-ELEMENT(9
> 011300       ).
> 011400     MOVE 6                        TO DESC-ELEMENT(6).
> 011500     MOVE 0                        TO LIST-ELEMENT(10).
> 011600     MOVE CUT-OFF                  TO LIST-ELEMENT(11).
> 011700     MOVE 3                        TO DESC-ELEMENT(7).
> 011800     MOVE 7                        TO PARM-NBR.
> 011900
> 012000 3000-SWTONMPLABEL.
> 012100
> 012200     CALL "DEBUG".
> 012300     CALL INTRINSIC "HPSWTONMPLABEL" USING PLABEL-NBR \PARM-NBR\
> 012400       ARGLIST ARGDESC \0\ GIVING PLABEL-STAT.
> 012500     DISPLAY "Convert Date in YYYYMMDD => " OUTPUTDATE.
> 012600     DISPLAY "STATUS-1:" STATUS-1.
> 012700     DISPLAY "STATUS-2:" STATUS-2.
> 012800     MOVE WS-STATUS                TO DT-STATUS.
> 012900     MOVE OUTPUTDATE               TO OUTPUT-DATE.
> 013000
> 013100 Z999-ENTRY.
> 013200
> 013300   ENTRY "UTLBXZ-A00-980513".
> -------------------------Working Version of Calling Program
> -------------------------------------
> 001000$CONTROL BOUNDS
> 001100$CONTROL MAP,VERBS
> 001200 IDENTIFICATION DIVISION.
> 001300 PROGRAM-ID. NEWTEST.
> 001400 DATE-WRITTEN. WED, MAY 13, 1998, 12:02 PM.
> 001500 ENVIRONMENT DIVISION.
> 001600 DATA DIVISION.
> 001700
> 001800 WORKING-STORAGE SECTION.
> 001900
> 002000 01 INPUTCODE                          PIC S9(9) COMP
> 002100    VALUE 25.
> 002200 01 INPUTDATE                          PIC X(32)
> 002300    VALUE "980101".
> 002400 01 OUTPUTCODE                         PIC S9(9) COMP
> 002500    VALUE 38.
> 002600 01 OUTPUTDATE                         PIC X(32)
> 002700    VALUE SPACES.
> 002800 01 WS-STATUS                          PIC S9(9) COMP
> 002900    VALUE 0.
> 003000 01 CUT-OFF                            PIC S9(9) COMP
> 003100    VALUE 40.
> 003200
> 003300 PROCEDURE DIVISION.
> 003400
> 003500 MAIN-LINE-SECTION SECTION.
> 003600
> 003700 MAIN-LINE.
> 003800
> 003900     DISPLAY "Enter Date (YYMMDD):".
> 004000     CALL "SUTLBXZ" USING INPUTCODE INPUTDATE OUTPUTCODE
> 004100       OUTPUTDATE WS-STATUS CUT-OFF.
> 004200     STOP RUN.
> ----------------------------------Non Working Version of Calling
> Program
> ----------------------------
> 001000$CONTROL BOUNDS
> 001100$CONTROL MAP,VERBS
> 001200 IDENTIFICATION DIVISION.
> 001300 PROGRAM-ID. NEWTEST.
> 001400 DATE-WRITTEN. WED, MAY 13, 1998, 11:36 AM.
> 001500 ENVIRONMENT DIVISION.
> 001600 DATA DIVISION.
> 001700
> 001800 WORKING-STORAGE SECTION.
> 001900
> 002000 01 INPUTCODE                          PIC S9(9) COMP
> 002100    VALUE 25.
> 002200 01 INPUTDATE                          PIC X(32)
> 002300    VALUE "980101".
> 002400 01 OUTPUTCODE                         PIC S9(9) COMP
> 002500    VALUE 38.
> 002600 01 OUTPUTDATE                         PIC X(32)
> 002700    VALUE SPACES.
> 002800 01 WS-STATUS                          PIC S9(9) COMP
> 002900    VALUE 0.
> 003000 01 CUT-OFF                            PIC S9(9) COMP
> 003100    VALUE 40.
> 003200
> 003300 PROCEDURE DIVISION.
> 003400
> 003500 MAIN-LINE-SECTION SECTION.
> 003600
> 003700 MAIN-LINE.
> 003800
> 003900     DISPLAY "Enter Date (YYMMDD):" INPUTDATE NO ADVANCING.
> 004000     ACCEPT INPUTDATE.
> 004100     CALL "SUTLBXZ" USING INPUTCODE INPUTDATE OUTPUTCODE
> 004200       OUTPUTDATE WS-STATUS CUT-OFF.
> 004300     STOP RUN.

ATOM RSS1 RSS2