Subject: | |
From: | |
Reply To: | |
Date: | Wed, 13 May 1998 13:06:44 -0400 |
Content-Type: | text/plain |
Parts/Attachments: |
|
|
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.
|
|
|