MVSFORUMS.com Forum Index MVSFORUMS.com
A Community of and for MVS Professionals
 
 FAQFAQ   SearchSearch   Quick Manuals   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Get dataset name from DD name

 
Post new topic   Reply to topic   printer-friendly view    MVSFORUMS.com Forum Index -> Application Programming
View previous topic :: View next topic  
Author Message
misi01
Advanced


Joined: 02 Dec 2002
Posts: 616
Topics: 171
Location: Stockholm, Sweden

PostPosted: Tue Sep 22, 2015 1:42 am    Post subject: Get dataset name from DD name Reply with quote

This is related to the topic (BPXWDYN) I appended a few minutes ago. The BPX topic is because of the problem I'm having with the following.

I found this code on the internet:

Code:
IDENTIFICATION DIVISION.                                   
PROGRAM-ID. FILENAME.                                     
INSTALLATION.                                             
AUTHOR. XYZ.                                       
DATE-WRITTEN. 03/19/2010.                                 
                                                           
ENVIRONMENT DIVISION.                                     
INPUT-OUTPUT SECTION.                                     
                                                           
DATA DIVISION.                                             
FILE SECTION.                                             
                                                           
WORKING-STORAGE SECTION.                                   
01  WS-TCB-ADDRESS-POINTER.                               
    05  WS-TCB-ADDR-POINTER             USAGE IS POINTER.
01  WS-TIOT-SEG-POINT.                                     
    05  WS-TIOT-SEG-POINTER             USAGE IS POINTER.
    05  WS-TIOT-SEG-PNT REDEFINES WS-TIOT-SEG-POINTER     
                                        PIC S9(9) COMP.   
01  WS-POINT.                                             
    05  WS-POINTER                      USAGE IS POINTER.
    05  WS-PTR REDEFINES WS-POINTER                       
                                        PIC S9(9) COMP.   
    05  WS-POINT-RED REDEFINES WS-PTR.                     
        07  FILLER                      PIC X.             
        07  WS-LOW-3                    PIC X(3).         
01  WS-JFCB-POINT.                                         
    05  WS-JFCB-POINTER                 USAGE IS POINTER.
    05  WS-JFCB-PTR REDEFINES WS-JFCB-POINTER             
                                        PIC S9(9) COMP.   
    05  WS-JFCB-POINT-RED REDEFINES  WS-JFCB-PTR.         
        07  FILLER                      PIC X.             
        07  WS-JFCB-LOW-3               PIC X(3).         
01  WS-SWA-POINT.                                         
    05  WS-SWA-POINTER                  USAGE IS POINTER.
    05  WS-SWA-PTR REDEFINES WS-SWA-POINTER               
                                        PIC S9(9) COMP.   
    05  WS-SWA-POINT-RED REDEFINES WS-SWA-PTR.           
        07  FILLER                      PIC X.           
        07  WS-SWA-LOW-3                PIC X(3).       
01  WS-LEN                              PIC S9(4) COMP.
01  WS-LENGTH REDEFINES WS-LEN          PIC X(02).       
01  WS-WORK                             PIC S9(9) COMP.
01  WS-RIGHT-HEX-DIGIT                  PIC S9(4) COMP.
01  WS-QMAT-POINT.                                       
    05  WS-QMAT-POINTER                 USAGE IS POINTER.
    05  WS-QMAT-PTR REDEFINES WS-QMAT-POINTER           
                           PIC S9(9) COMP.               
LINKAGE SECTION.                                         
01  TCB-POINTER                      USAGE IS POINTER.   
01  TCB.                                                 
    05  FILLER             PIC X(08).                   
    05  DEB-ADDR                     USAGE IS POINTER.   
    05  TIOT-POINTER                 USAGE IS POINTER.   
    05  FILLER             PIC X(164).                   
    05  JSCB-POINTER                 USAGE IS POINTER.   
    05  FILLER             PIC X(128).                   
    05  STCB-POINTER                 USAGE IS POINTER.   
01  TIOT.                                               
    05  JOB-NAME           PIC X(08).                   
    05  JOB-PROC           PIC X(08).                   
    05  JOB-STEP           PIC X(08).                   
01  TIOT-SEG.                                           
    05  TIO-LEN            PIC X.                       
    05  FILLER             PIC X(03).                   
    05  DD-NAME            PIC X(08).                   
    05  SWA-V-ADDR         PIC X(03).                   
    05  FILLER             PIC X(02).                   
    05  UCB-ADDR           PIC X(03).                   
01  JFCB.                                               
    05  DS-NAME            PIC X(44).                   
    05  FILLER             PIC X(74).                   
    05  VOL-SER            PIC X(06).                   
01  JSCB.                                               
    05  FILLER             PIC X(244).                     
    05  QMPL-POINTER       USAGE IS POINTER.               
01  QMPL.                                                   
    05  FILLER             PIC X(24).                       
    05  QMAT-POINTER       USAGE IS POINTER.               
01  QMAT.                                                   
    05  FILLER             PIC X(12).                       
    05  QMAT-NEXT-POINTER  USAGE IS POINTER.               
01  SWA.                                                   
    05  JFCB-ADDR          USAGE IS POINTER.               
PROCEDURE DIVISION.                                         
    MOVE X'0000021C' TO WS-TCB-ADDRESS-POINTER.             
    SET ADDRESS OF TCB-POINTER TO WS-TCB-ADDR-POINTER.     
    SET ADDRESS OF TCB TO TCB-POINTER.                     
    SET ADDRESS OF TIOT TO TIOT-POINTER.                   
    SET WS-TIOT-SEG-POINTER TO TIOT-POINTER.               
    ADD 24 TO WS-TIOT-SEG-PNT.                             
    SET ADDRESS OF TIOT-SEG TO WS-TIOT-SEG-POINTER.         
    PERFORM UNTIL TIO-LEN = LOW-VALUES                     
      MOVE ALL LOW-VALUES TO WS-POINT                       
      MOVE ALL LOW-VALUES TO WS-JFCB-POINT                 
      MOVE ALL LOW-VALUES TO WS-SWA-POINT                   
      MOVE SWA-V-ADDR TO WS-SWA-LOW-3                       
      PERFORM SWAREQ                                       
      SET ADDRESS OF JFCB TO  WS-POINTER                   
      DISPLAY 'DDNAME=' DD-NAME                             
      DISPLAY 'DSNAME=' DS-NAME                             
      DISPLAY 'VOL=SER=' VOL-SER                           
      DISPLAY '********************************************'
      MOVE ZERO TO WS-LEN                                   
      MOVE TIO-LEN TO WS-LENGTH(2:1)                       
      ADD WS-LEN TO WS-TIOT-SEG-PNT                         
      SET ADDRESS OF TIOT-SEG TO WS-TIOT-SEG-POINTER       
    END-PERFORM.                                           
    GOBACK.                                                 
SWAREQ.                                                     
    DIVIDE WS-SWA-PTR BY 16                                 
        GIVING WS-WORK                                   
        REMAINDER WS-RIGHT-HEX-DIGIT.                   
    IF WS-RIGHT-HEX-DIGIT NOT = 15                       
        COMPUTE WS-PTR = WS-SWA-PTR + 16                 
    ELSE                                                 
        MOVE X'0000021C' TO WS-TCB-ADDRESS-POINTER       
        SET ADDRESS OF TCB-POINTER TO WS-TCB-ADDR-POINTER
        SET ADDRESS OF TCB TO TCB-POINTER               
        SET ADDRESS OF JSCB TO JSCB-POINTER             
        SET ADDRESS OF QMPL TO QMPL-POINTER             
        SET ADDRESS OF QMAT TO QMAT-POINTER             
        SET WS-QMAT-POINTER TO QMAT-POINTER             
        PERFORM UNTIL WS-SWA-PTR <= 65536               
            SET WS-QMAT-POINTER TO QMAT-NEXT-POINTER     
            SET ADDRESS OF QMAT TO QMAT-NEXT-POINTER     
            COMPUTE WS-SWA-PTR = WS-SWA-PTR - 65536     
        END-PERFORM                                     
        COMPUTE WS-PTR = WS-SWA-PTR + WS-QMAT-PTR + 1   
        SET ADDRESS OF SWA TO WS-POINTER                 
        SET WS-POINTER TO JFCB-ADDR                     
        COMPUTE WS-PTR = WS-PTR + 16                     
     END-IF.


We've been using this code for some time in production (successfully).

Suddenly it's not working, or rather, it's working in Xpediter, but not when the program is called in a BMP. I appreciate that most people would say "rewrite the code using assembler", but like many others, I can't write code in that language. I'm hoping someone will have a suggestion as to what might be wrong (I have a suspicion it's something stupid like changed default compiler parms or similar). The displays included here are ones simply included in the code from the URL above at "strategic" places. SHBG0920 is our name for the program included above.

Here are the Xpediter displays
Quote:

About to call shbg0920
SHBG0920 dd-name-in=GSAMFB01***
start of perform
ca-swareq, pointer = 000000111
ws-work = 000000006 ws-right-hex-digit = 0015
else
ws-swa-ptr=000000111
jfcb-addr=2139910952
********************************************
start of perform
ca-swareq, pointer = 000000303
ws-work = 000000018 ws-right-hex-digit = 0015
else
ws-swa-ptr=000000303
jfcb-addr=2139912104

and here are the BMP ones
Quote:

About to call shbg0920
SHBG0920 dd-name-in=GSAMFB01***
start of perform
ca-swareq, pointer = 000000033
ws-work = 000000002 ws-right-hex-digit = 0001
ws-right-hex-digit not = 15
********************************************
start of perform
ca-swareq, pointer = 000000039
ws-work = 000000002 ws-right-hex-digit = 0007
ws-right-hex-digit not = 15
********************************************
start of perform
ca-swareq, pointer = 000000045
ws-work = 000000002 ws-right-hex-digit = 0013
ws-right-hex-digit not = 15
********************************************
start of perform
ca-swareq, pointer = 000000051
ws-work = 000000003 ws-right-hex-digit = 0003
ws-right-hex-digit not = 15
********************************************
start of perform
ca-swareq, pointer = 000000057
ws-work = 000000003 ws-right-hex-digit = 0009
ws-right-hex-digit not = 15
start of perform
ca-swareq, pointer = 000000063
ws-work = 000000003 ws-right-hex-digit = 0015
else
ws-swa-ptr=000000063
CEE3204S The system detected a protection exception (System Completion Code=0C4)
From compile unit SHBG0920 at entry point SHBG0920 at compile unit offs
at address 38D2B8F8.

Fault analyzer gives the following information:-
Quote:

The cause of the failure was program SHBG0920 in module Q2696000. The COBOL
source code that immediately preceded the failure was:

Source
Line #
000316 display 'jfcb-addr='jfcb-addr

The COBOL source code for data fields involved in the failure:

Source
Line #
000182 05 jfcb-addr usage is pointer.

Data field values at time of abend:

JFCB-ADDR = *** Not addressable ***


I appreciate that Xpediter and running a BMP are apples and pears, but if anyone can give a suggestion, it would be greatly appreciated.

Code in-lined
_________________
Michael
Back to top
View user's profile Send private message Send e-mail
misi01
Advanced


Joined: 02 Dec 2002
Posts: 616
Topics: 171
Location: Stockholm, Sweden

PostPosted: Tue Sep 22, 2015 2:46 am    Post subject: Reply with quote

I'll append a preliminary reply to this.

Fortunately, I had old JCL that called the failing program and tested this as well. Surprise, no error. In the end, the only (?) difference seemed to be in the job card that contained differing SCHENV parms (not sure if SCHENV is a bank parm or a standard one).

Will post reply once I get a reply from our support
_________________
Michael
Back to top
View user's profile Send private message Send e-mail
William Collins
Supermod


Joined: 03 Jun 2012
Posts: 437
Topics: 0

PostPosted: Tue Sep 22, 2015 5:03 am    Post subject: Reply with quote

There's pointer 'rithmetic in that thar program, and the REDEFINESes only use COMP.

What is your value for compiler option TRUNC? If STD, definitely potential trouble, if OPT, possibly potential trouble, if BIN it will be OK.

For the original linked code, the OP probably had TRUNC(BIN), or just got lucky (avoided the potential trouble).

COMP/COMP-4/BINARY PIC S9(9) or PIC 9(9) have a maximum value of 999,999,999, the maximum size defined by the PICture.

COMP-5 PIC S9(9) or PIC 9(9) can use all the bits, so has an appropriate binary maximum (and minimum for the signed field).

You should change all the COMPs in the REDEFINESes to COMP-5.

With TRUNC(STD), if you happen to have an address greater than 999,999,999 (decimal) it will be truncated in the arithmetic.

With TRUNC(OPT), if you happen to have an address greater than 999,999,999 (decimal) it may be truncated in the arithmetic, depending on the exact code sequence generated.

With TRUNC(BIN) there will be no truncation (given the unlikelihood that the address will ever be so "high" that the arithmetic will bust it).

Of course, this may not be your problem.

Since your program has been working happily you may have TRUNC(BIN).

It would be a nightmare if someone just changed your Production compile option TRUNC. A nightmare. Hope that's not happened.

Make them COMP-5, then you are not affected by TRUNC (COMP-5 is always COMP-5, TRUNC(BIN) makes COMP/COMP-4/BINARY into implicit COMP-5).
Back to top
View user's profile Send private message
William Collins
Supermod


Joined: 03 Jun 2012
Posts: 437
Topics: 0

PostPosted: Tue Sep 22, 2015 5:19 am    Post subject: Reply with quote

Gosh, there's also this:
Code:

01  WS-WORK                             PIC S9(9) COMP.


So I have to mention this:

Don't (assuming not using TRUNC(BIN)) use nine-digit COMP/COMP-4/BINARY fields. There's a potential overhead with a conversion to a double-word, calculation, reconversion to a full-word.

If you need nine digits and doing arithmetic, consider using PIC S/9(10).

That's an efficiency-only thing.

The program, I know it's not yours, is using WS-WORK in a stupid manner anyway. Why divide the whole thing to get the value of the last half-byte? Indeed, it is not even the value that is wanted, just to know whether b'1111' or not.
Back to top
View user's profile Send private message
misi01
Advanced


Joined: 02 Dec 2002
Posts: 616
Topics: 171
Location: Stockholm, Sweden

PostPosted: Tue Sep 22, 2015 6:40 am    Post subject: Reply with quote

Thanks William. I received the following from support

In SCHENV(OSI1) we're running the latest release of z/OS; V2.2.
In SCHENV(OSI2) we're running V2.1

Just tested, V2.1 works, V2.2 crashes. I'll have to get back to them
_________________
Michael
Back to top
View user's profile Send private message Send e-mail
William Collins
Supermod


Joined: 03 Jun 2012
Posts: 437
Topics: 0

PostPosted: Tue Sep 22, 2015 6:50 am    Post subject: Reply with quote

It may be one of those cases I always warn about. If you do use Assembler, the IBM-provided macros, then when there is a new OS IBM changes any required macros.

The problem with COBOL and Control Blocks is that IBM supplies nothing. So if something does change in the Control Blocks your COBOL program is using, you have to make requisite changes yourself.

The people who installed the V2.2 (they got that in quick) at your site would have a list of any macros which have changed and are related to Control Blocks. Whether it is a list on its own, or intermingled with other stuff, I have no clue, but they should be able to readily find out if any have been updated, and then you can check those against the Control Blocks the COBOL program uses.

Check your TRUNC option in case someone changed that. I presume it is the V2.1 in Production and you're using V2.2?
Back to top
View user's profile Send private message
misi01
Advanced


Joined: 02 Dec 2002
Posts: 616
Topics: 171
Location: Stockholm, Sweden

PostPosted: Thu Sep 24, 2015 1:36 pm    Post subject: Reply with quote

As you state William, a colleague is going to rewrite it using assembler
_________________
Michael
Back to top
View user's profile Send private message Send e-mail
haatvedt
Beginner


Joined: 14 Nov 2003
Posts: 66
Topics: 0
Location: St Cloud, Minnesota USA

PostPosted: Fri Oct 02, 2015 10:00 pm    Post subject: Reply with quote

One thing that you may want to check is to see if the SWA has been moved above the line.

We had a COBOL program that was using the SWA and after the SWA moved above the line it would not work. The solution was to create a small Assembler utility.
_________________
Chuck Haatvedt

email --> clastnameatcharterdotnet

(replace lastname, at, dot with appropriate
characters)
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic   printer-friendly view    MVSFORUMS.com Forum Index -> Application Programming All times are GMT - 5 Hours
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


MVSFORUMS
Powered by phpBB © 2001, 2005 phpBB Group