IBM Mainframe Forum Index
 
Log In
 
IBM Mainframe Forum Index Mainframe: Search IBM Mainframe Forum: FAQ Register
 

How to Read KSDS Data Component Directly (as an ESDS)?


IBM Mainframe Forums -> COBOL Programming
Post new topic   Reply to topic
View previous topic :: View next topic  
Author Message
ApexNC

New User


Joined: 10 Feb 2006
Posts: 19
Location: USA

PostPosted: Sun Sep 29, 2013 1:25 am
Reply with quote

Reading the Data Component of a KSDS separately as an ESDS is simple in Assembler using MACRF=ADR on the ACB and OPTCD=(ADR,RBA) on the RPL. I have a vague memory of also doing this with COBOL (I remember seeing it recommended somewhere for efficiency) but all my attempts in the last 3 days have failed. Now I wonder if I ever actually *did* do this in COBOL.

VSAM.FILE <- Cluster
VSAM.FILE.DATA <- Data (THIS is what I want to read directly, eg with "//ESDS DD DISP=SHR,DSN=VSAM.FILE.DATA" in JCL)
VSAM.FILE.INDEX <- Index

Has anyone here ever done this in COBOL? For sequential processing of a KSDS, it's supposed to eliminate the needless overhead of having to go through the Index.

Here are my "best effort" SELECT and FD, which work fine for reading an ESDS defined as such, but does NOT work for reading the Data component of a KSDS directly:

FILE-CONTROL.
SELECT INFILE ASSIGN AS-INFILE
STATUS FILE-STATUS.
DATA DIVISION.
FILE SECTION.
FD INFILE.
01 INREC PIC X(80).

For testing, I defined KSDS and ESDS files with AVG and MAX LRECL both = 80. KSDS has "KEYS (8 0)" but I don't think that matters. Both files have 8 identical records with an 8-digit sequence number in columns 1 through 8.

With Assembler, I can read both the ESDS and the KSDS Data Component using one program coded to read an ESDS sequentially. But with COBOL, I can only read the file defined as an ESDS. When I try to read the KSDS Data component as an ESDS, I get File Status 39: "The OPEN statement was unsuccessful because a conflict was detected between the fixed file attributes and the attributes specified for that file in the program....".

If anyone here knows how to code a COBOL program to read a KSDS data component as an ESDS, I'd LOVE to know how you do it!
Back to top
View user's profile Send private message
ApexNC

New User


Joined: 10 Feb 2006
Posts: 19
Location: USA

PostPosted: Sun Sep 29, 2013 1:28 am
Reply with quote

Just to clarify, when I said "both files have 8 identical records", what I mean was "the records are exactly the same on both files", NOT that all 8 records are identical.
Back to top
View user's profile Send private message
dick scherrer

Moderator Emeritus


Joined: 23 Nov 2006
Posts: 19244
Location: Inside the Matrix

PostPosted: Sun Sep 29, 2013 8:25 am
Reply with quote

Hello,

I know of no way to read a KSDS as an ESDS in COBOL.

They are different data storage approaches. The way KSDS data is stored is not the same as the way ESDS data is stored.
Back to top
View user's profile Send private message
ApexNC

New User


Joined: 10 Feb 2006
Posts: 19
Location: USA

PostPosted: Sun Sep 29, 2013 7:14 pm
Reply with quote

FWIW, it's easy in Assembler. The following 20 lines of code will read and display all records from a fixed-length ESDS defined as such OR a the data component of a KSDS. To Assembler, they appear identical.

Code:

READESDS CSECT
         LR    12,15
         USING READESDS,12
         ST    14,R14SAVE
         OPEN  (ACB,,DCB,OUTPUT)
LOOP     GET   RPL=RPL
         L     0,REC@        R0 -> ESDS RECORD
         PUT   DCB,(0)       OUTPUT
         B     LOOP          CONTINUE
EOF      CLOSE (ACB,,DCB)
         L     14,R14SAVE
         BR    14            RETURN
DCB      DCB   DDNAME=OUTFILE,DSORG=PS,MACRF=PM
ACB      ACB   DDNAME=INFILE,MACRF=ADR,EXLST=EXLST
RPL      RPL   ACB=ACB,ARG=XRBA,AREA=REC@,OPTCD=(ADR,LOC,XRBA)
EXLST    EXLST EODAD=EOF
R14SAVE  DS    F
XRBA     DS    XL8
REC@     DS    A
         END


JCL to run the above:

Code:

// EXEC PGM=READESDS
//OUTFILE DD SYSOUT=*,DCB=(RECFM=FB,LRECL=<lrecl>)
//INFILE DD DISP=SHR,DSN=<ESDS or KSDS Data Compenent>
Back to top
View user's profile Send private message
Robert Sample

Global Moderator


Joined: 06 Jun 2008
Posts: 8696
Location: Dubuque, Iowa, USA

PostPosted: Sun Sep 29, 2013 7:49 pm
Reply with quote

What does your assembler code do in the case of CA splits on the KSDS data set? The records will not be physically stored in entry sequence, nor will they be physically stored in key sequence after a CA split.

I think what you've done is write an assembler program to return KSDS records in a semi-random fashion.
Back to top
View user's profile Send private message
ApexNC

New User


Joined: 10 Feb 2006
Posts: 19
Location: USA

PostPosted: Sun Sep 29, 2013 11:26 pm
Reply with quote

The records will be returned in whatever order they are in on the data component. If sequence doesn't matter, and sometimes it doesn't, then reading from the data component directly saves the overhead of going through the index.

I'll try to find where I saw this recommended. I think it may have been in one of the Jay Ranade books.
Back to top
View user's profile Send private message
dick scherrer

Moderator Emeritus


Joined: 23 Nov 2006
Posts: 19244
Location: Inside the Matrix

PostPosted: Mon Sep 30, 2013 6:37 am
Reply with quote

Hello,

I'll not go into pro's and con's, but I believe the data should be read in the way intended. What happens if some internal improvement is made to the access method and "old" tricky code "falls down" after an upgrade.

From my own experience, exponentially more can be done in assembler but it should rarely (if ever) be used for business application code. Each year there are fewer and fewer people who Actually Know assembler. Getting a couple of routines to run does Not constitute knowing assembler. Besides, most organizations will not allow new assembler application code to be built/promoted.

But I thought the question was doing something like this using COBOL. COBOL does not do what you want, so i'd suggest using COBOL as it is intended. Someone else will have to maintain this when you have moved on. . .
Back to top
View user's profile Send private message
ApexNC

New User


Joined: 10 Feb 2006
Posts: 19
Location: USA

PostPosted: Mon Sep 30, 2013 9:21 am
Reply with quote

This is a quest for knowledge, not a business solution, so I'm not concerned with maintenance issues or acceptability. The question is indeed "How can this be done in COBOL?" So far, I've just heard "I know of no way". For me, that's not a good enough reason to give up.
Back to top
View user's profile Send private message
Bill Woodger

Moderator Emeritus


Joined: 09 Mar 2011
Posts: 7309
Location: Inside the Matrix

PostPosted: Mon Sep 30, 2013 2:00 pm
Reply with quote

Before any tangle ensues, I know the TS/OP.

It is a quest spurred on by a smarmy salesman and the question of why it can be done in Assembler and not in COBOL. It is just extending a Proof of Concept.

It comes down to "can a KSDS data component be read directly in COBOL without going through the index levels (with the consequences which flow from that)?"

If there are any "yes, this way" or "perhaps, try this" or "definitely not, becuase of this" on the technical issues, that would be good.

It is not destined for Production, as there are more shortcomings in addition to those alfready pointed out.

Results so far suggest that up to 50% of the processing of a KSDS serially (in key sequence) is due to the indexes. There will be no solid figure for this, as it depends on so many things, We all unloading a KSDS to a PS and processing it sequentially then reloading it doesn't require many steps using the PS to give performance benefits. We know why. Is there a way to do it differently, in limited circumstances (order of the data not relevant to the program)?

Specifically relating to the question that is, not just a further pile of suggestions on how to do it differently :-)
Back to top
View user's profile Send private message
ApexNC

New User


Joined: 10 Feb 2006
Posts: 19
Location: USA

PostPosted: Tue Oct 01, 2013 12:38 am
Reply with quote

Interesting clues from IDCAMS and SORT:

(1) IDCAMS PRINT and REPRO have no problem referring to the Data Component alone:
Code:

// EXEC PGM=IDCAMS
//SYSPRINT DD SYSOUT=*
//OUTFILE DD DISP=SHR,DSN=VSAM.ESDS
//INFILE DD DISP=SHR,DSN=VSAM.KSDS.DATA
//SYSIN DD *
 PRINT INFILE (INFILE)                         
 REPRO INFILE (INFILE) OUTFILE (OUTFILE) REUSE
/*


(2) Using SORT FIELDS=COPY from KSDS Data to an ESDS, SORT says "ICE076A 0 VSAM INPUT ERROR L(72) SORTIN", which translates to "The application made a keyed request for access to an entry-sequenced data set." Interesting that it recognizes the input as an ESDS, but then tries to do a keyed read.
Code:

//SORT    EXEC PGM=SORT                       
//SYSOUT   DD  SYSOUT=*                       
//SORTOUT  DD  DISP=SHR,DSN=VSAM.ESDS
//SORTIN    DD  DISP=SHR,DSN=VSAM.KSDS.DATA
//SYSIN    DD  *                             
 SORT FIELDS=COPY                             
/*
Back to top
View user's profile Send private message
Bill Woodger

Moderator Emeritus


Joined: 09 Mar 2011
Posts: 7309
Location: Inside the Matrix

PostPosted: Tue Oct 01, 2013 1:37 am
Reply with quote

PRINT and REPRO are designed to work with everything they are documented for.

DFSORT is not doing a keyed read. It is making some access which implies a KSDS. DFSORT does not do keyed reads as such, but of course would, for a KSDS, inform AMS that it wanted to process the dataset for serial input.
Back to top
View user's profile Send private message
ApexNC

New User


Joined: 10 Feb 2006
Posts: 19
Location: USA

PostPosted: Tue Oct 01, 2013 7:17 am
Reply with quote

> "I'll try to find where I saw this recommended.
> I think it may have been in one of the Jay Ranade books."

Definitely not the 1987 edition of "VSAM: Performance, Design, and Fine Tuning." Ordered a 1986 edition of his "VSAM, Concepts, Programming and Design" - will see if it's in there.
Now I wonder if it was in one of Xephon's monthly "MVS" or "VSAM" "Update" booklets.
Back to top
View user's profile Send private message
Bill O'Boyle

CICS Moderator


Joined: 14 Jan 2008
Posts: 2501
Location: Atlanta, Georgia, USA

PostPosted: Tue Oct 01, 2013 7:40 am
Reply with quote

Index of Xephon - www.cbttape.org/xephon/
Back to top
View user's profile Send private message
ApexNC

New User


Joined: 10 Feb 2006
Posts: 19
Location: USA

PostPosted: Sat Oct 05, 2013 9:37 am
Reply with quote

In the COBOL group on LinkedIn, James McGee of Aflac suggested: "Create an Alternate index that references RBA..." Using an Alternate Index requires special setup and entails a lot of extra overhead, but for the purpose of using COBOL to read exactly the same records in either key sequence or entry sequence, it at least does work.

The following JCL creates an fixed-length ESDS base cluster, loads it with 80-byte records with an 8-byte "key" in pos 1, then builds an alternate index based on that "key" with records pointing to the corresponding RBAs in the ESDS:
Code:

// EXEC PGM=IDCAMS
//SYSPRINT DD SYSOUT=*
//SYSIN DD *
 DEFINE CLUSTER (NAME(VSAM.ESDS) RECSZ (80 80) TRK (1) -
   NONINDEXED)
 REPRO INFILE (INFILE) OUTDATASET (VSAM.ESDS)
 DEFINE AIX (NAME (VSAM.RBAKEYS) RELATE (VSAM.ESDS) KEYS (8 0) -
   RECSZ (17 17) TRK (1) UNIQUEKEY UPGRADE)
 BLDINDEX INDATASET (VSAM.ESDS) OUTDATASET (VSAM.RBAKEYS)
 DEFINE PATH (NAME (VSAM.KSDS) PATHENTRY (VSAM.RBAKEYS))
/*
//INFILE DD *
00000100 THIS IS THE FIRST RECORD
00000200 THIS IS THE SECOND RECORD
00000300 THIS IS THE THIRD RECORD
etc.
/*

Here is the sample COBOL
Code:

 IDENTIFICATION DIVISION.                           
 PROGRAM-ID. SAMPLE.                                 
 ENVIRONMENT DIVISION.                               
 INPUT-OUTPUT SECTION.                               
 FILE-CONTROL.                                       
     SELECT KSDS ASSIGN KSDS                         
       ORGANIZATION INDEXED RECORD KEY IS RECORD-KEY.
     SELECT ESDS ASSIGN AS-ESDS                     
       ORGANIZATION SEQUENTIAL.                     
 DATA DIVISION.                                     
 FILE SECTION.                                       
 FD  KSDS.                                           
 01  KSDS-RECORD.                                   
      05 RECORD-KEY PIC X(8).                         
      05 FILLER     PIC X(72).                       
 FD  ESDS.                                           
 01  ESDS-RECORD   PIC X(80).                       
 WORKING-STORAGE SECTION.
 01  FILLER        PIC X.                                 
     88 NOT-EOF          VALUE 'N'.                       
     88 EOF              VALUE 'Y'.                       
 PROCEDURE DIVISION.

     OPEN INPUT ESDS SET NOT-EOF TO TRUE                   
     PERFORM UNTIL EOF READ ESDS                           
       AT END SET EOF TO TRUE CLOSE ESDS                   
       NOT AT END DISPLAY ESDS-RECORD END-READ END-PERFORM

      OPEN INPUT KSDS SET NOT-EOF TO TRUE                   
      PERFORM UNTIL EOF READ KSDS                           
       AT END SET EOF TO TRUE CLOSE KSDS                   
       NOT AT END DISPLAY KSDS-RECORD END-READ END-PERFORM

      GOBACK.                                                                           

And the JCL to run the sample:
Code:

// EXEC PGM=SAMPLE
//SYSOUT DD SYSOUT=*
//ESDS DD DISP=SHR,DSN=VSAM.ESDS <- Base Cluster
//KSDS DD DISP=SHR,DSN=VSAM.KSDS <- Path (to the RBAKEYS Alt Index)

www.jaymoseley.com/hercules/vstutor/vstutor.htm - Not having much experience with Alternate Indices, I found the section of Jay Moseley's VSAM Tutorial on the subject (near the bottom) to be very helpful. The trickiest part for me was understanding the Record Size for the Alternate Index. With unique keys (as in this example) the AIX records are fixed length. The record size of 17 (for this example) was then calculated as follows (a+b+c):

(a) 5 bytes for control information
(b) Key length (8 bytes in this case)
(c) RBA length (4 bytes)
Back to top
View user's profile Send private message
ApexNC

New User


Joined: 10 Feb 2006
Posts: 19
Location: USA

PostPosted: Sat Oct 12, 2013 1:13 am
Reply with quote

> I'll try to find where I saw this recommended.
> I think it may have been in one of the Jay Ranade books.

It may indeed have been Jay Ranade's "VSAM Concepts, Programming and Design" (1985 - ISBN 0-07-051198-5). While it doesn't specifically mention sequential processing and does specify use of assembler, it is basically the same idea. From pages 21 & 23: "By programming an access routine in assembler language, you can access a record randomly in a KSDS or an ESDS if you know the RBA of the record. In such a case, you will bypass the index component of the KSDS and the access will be faster... Records in KSDS's and ESDS's can be accesed through an RBA. This is quicker than keyed access because it does not involve an index search."
Back to top
View user's profile Send private message
View previous topic :: :: View next topic  
Post new topic   Reply to topic View Bookmarks
All times are GMT + 6 Hours
Forum Index -> COBOL Programming

 


Similar Topics
Topic Forum Replies
No new posts Error to read log with rexx CLIST & REXX 11
No new posts Data set Rec-Cnt and Byte-Cnt Testing & Performance 2
No new posts SCOPE PENDING option -check data DB2 2
No new posts Check data with Exception Table DB2 0
No new posts JCL EXEC PARM data in C Java & MQSeries 2
Search our Forums:

Back to Top