I have a COBOL program, RENT/31/ANY, that does the following

PSAOLD->TCB->TIOT->JFCB segments.

The program is run on z/OS 1.11 system.  I don't know the PTF level, it is a
customer site.

If the program is run from a one step job, or as the first step of a job it 
works.
However, subsequent executions of the program, second step and so on, fail with 
a S0C4
while checking the JFCB TIO-LEN field.  I have added Displays to the code 
below, and
it appears that JFCB-ADDR, from TIOT-SEG, for the first DDNAME, is 1024 bytes 
greater
in the second execution of the program from a job that executes the program two 
times.
I take no credit or blame for the logic of the program.  But I do need to 
determine
the cause of the failure.

Any ideas???

//STEP010  EXEC PGM=CALLJFCB
//DD1        DD DSN=ANY.DATA.SET1,DISP=SHR
//DD2        DD DSN=ANY.DATA.SET2,DISP=SHR 
//DD3        DD DSN=ANY.DATA.SET3,DISP=SHR
//STEP020  EXEC PGM=CALLJFCB
//DD1        DD DSN=ANY.DATA.SET1,DISP=SHR
//DD2        DD DSN=ANY.DATA.SET2,DISP=SHR 
//DD3        DD DSN=ANY.DATA.SET3,DISP=SHR 
 

Here is the program.  

       IDENTIFICATION DIVISION.                                        
       PROGRAM-ID. LDAGTJFC.                                           
      *----------------------------------------------------------------
      *  PASS JOB CONTROL INFORMATION TO CALLING PROGRAM               
      *                         
      *                                                                
      * USE THE TIO-LENGTH FOR ADVANCING THRU JFCB  - 20 AUG 2013      
      *----------------------------------------------------------------
                                                                       
       ENVIRONMENT DIVISION.                                           
       INPUT-OUTPUT SECTION.                                           
                                                                       
       DATA DIVISION.                                                  
       FILE SECTION.                                                   
                                                                       
       WORKING-STORAGE SECTION.                                        
       77  SUB1                 PIC 9(04) COMP.                        
       77  WS-PROG-ID           PIC X(08) VALUE 'XXXXXXXX'.            
RWP    77  WS-LEN               PIC S9(4) COMP.               
RWP    77  WS-LENGTH REDEFINES WS-LEN PIC X(02).              
RWP    01  WS-TIOT-SEG-POINT.                                 
RWP        05  WS-TIOT-SEG-POINTER USAGE IS POINTER.          
RWP        05  WS-TIOT-SEG-PNT REDEFINES WS-TIOT-SEG-POINTER  
RWP                                        PIC S9(9) COMP.    
                                                              
       01  TCB-ADDRESS-POINTER.                               
           05  TCB-ADDR-POINTER USAGE IS POINTER.             
       01  TIOT-SEG-POINT.                                    
           05  TIOT-SEG-POINTER USAGE IS POINTER.             
           05  TIOT-SEG-PNT REDEFINES TIOT-SEG-POINTER        
                 PIC S9(9) COMP.                              
       01  JFCB-POINT.                                        
           05  JFCB-POINTER USAGE IS POINTER.                 
           05  JFCB-POINT-RED REDEFINES JFCB-POINTER.         
               10  FILLER PIC X.                              
               10  JFCB-LOW-3 PIC X(3).                       
                                                              
       LINKAGE SECTION.                                   
       01  DDNAME-DSN-ARRAY.                              
           05  DDNAME-DSN   OCCURS 100 TIMES.             
               10  DDA-DDNAME  PIC X(8).                  
               10  DDA-DSN     PIC X(44).                 
       01 PSA.                                            
           05 FILLER     PIC X(540).                      
           05 PSATOLD    POINTER.                         
       01  TCB-POINTER USAGE IS POINTER.                  
       01  TCB.                                           
           05  FILLER   PIC X(12).                        
           05  TIOT-POINTER USAGE IS POINTER.             
       01  TIOT-START PIC X(24).                          
       01  TIOT-SEG.                                      
           05  TIO-LEN PIC X.                             
           05  FILLER  PIC X(3).                          
           05  DD-NAME  PIC X(8).                         
           05  JFCB-ADDR PIC X(3).                        
       01  JFCB.                                          
             05  FILLER PIC X(16).                             
           05  DS-NAME PIC X(44).                            
                                                             
                                                             
       PROCEDURE DIVISION USING DDNAME-DSN-ARRAY.            
                                                             
           SET ADDRESS OF PSA TO NULL                        
           MOVE ZERO          TO SUB1.                       
           MOVE ZERO          TO WS-LEN.                     
           SET ADDRESS OF TCB TO PSATOLD.                    
            SET ADDRESS OF TIOT-START 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 VARYING SUB1 FROM 1 BY 1              
                   UNTIL SUB1 > 100                      
                      OR TIO-LEN = LOW-VALUES            
             MOVE DD-NAME TO DDA-DDNAME(SUB1)            
             MOVE JFCB-ADDR TO JFCB-LOW-3                
             SET ADDRESS OF JFCB TO JFCB-POINTER         
             MOVE DS-NAME TO DDA-DSN(SUB1)               
             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.                                                              
                                            
                         






_____________________________________________________________
Netscape.  Just the Net You Need.

----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to [email protected] with the message: INFO IBM-MAIN

Reply via email to