Portal | Manuals | References | Downloads | Info | Programs | JCLs | Master the Mainframes
IBM Mainframe Computers Forums Index
 
Register
 
IBM Mainframe Computers Forums Index Mainframe: Search IBM Mainframe Forum: FAQ Memberlist Usergroups Profile Log in to check your private messages Log in
 

 

handling variable ==> undefined record length dataset

 
Post new topic   Reply to topic    IBMMAINFRAMES.com Support Forums -> CLIST & REXX
View previous topic :: :: View next topic  
Author Message
Adit Nigam

New User


Joined: 08 Apr 2010
Posts: 9
Location: Bangalore

PostPosted: Thu Apr 08, 2010 12:23 pm    Post subject: handling variable ==> undefined record length dataset
Reply with quote

I use EXECIO for file related operations but that works only for FB dataset PS or PDS. if i want to read the content of some variable length library member how should I go about it?[/Search][/b]
Back to top
View user's profile Send private message

expat

Global Moderator


Joined: 14 Mar 2007
Posts: 8593
Location: Back in jolly old England

PostPosted: Thu Apr 08, 2010 12:24 pm    Post subject:
Reply with quote

EXECIO works fine for me with VB records
Back to top
View user's profile Send private message
Adit Nigam

New User


Joined: 08 Apr 2010
Posts: 9
Location: Bangalore

PostPosted: Thu Apr 08, 2010 12:38 pm    Post subject:
Reply with quote

I am getting following error message

IRX0509E Invalid record format for data set allocated to file SAMPLE. RECFM must be fixed or variable. Spanned records or records with track overflow are not supported.


SORRY, The dataset is not VB its U icon_confused.gif
Back to top
View user's profile Send private message
expat

Global Moderator


Joined: 14 Mar 2007
Posts: 8593
Location: Back in jolly old England

PostPosted: Thu Apr 08, 2010 12:46 pm    Post subject:
Reply with quote

EXECIO DOES NOT support RECFM=U or spanned records.
Back to top
View user's profile Send private message
Adit Nigam

New User


Joined: 08 Apr 2010
Posts: 9
Location: Bangalore

PostPosted: Thu Apr 08, 2010 12:48 pm    Post subject:
Reply with quote

is there any other way to read RECFM = U without using EXECIO? icon_confused.gif
Back to top
View user's profile Send private message
PeterHolland

Global Moderator


Joined: 27 Oct 2009
Posts: 2435
Location: Netherlands, Amstelveen

PostPosted: Thu Apr 08, 2010 1:44 pm    Post subject:
Reply with quote

Call the OUTTRAP function to intercept TSO command output.
Execute the TSO (actually IDCAMS) PRINT command with the CHAR or HEX option
Process the PRINT output
Back to top
View user's profile Send private message
Adit Nigam

New User


Joined: 08 Apr 2010
Posts: 9
Location: Bangalore

PostPosted: Thu Apr 08, 2010 2:22 pm    Post subject:
Reply with quote

Thank you very much.
It worked... icon_biggrin.gif
Back to top
View user's profile Send private message
PeterHolland

Global Moderator


Joined: 27 Oct 2009
Posts: 2435
Location: Netherlands, Amstelveen

PostPosted: Thu Apr 08, 2010 4:58 pm    Post subject:
Reply with quote

You are welcome.
Back to top
View user's profile Send private message
enrico-sorichetti

Global Moderator


Joined: 14 Mar 2007
Posts: 10274
Location: italy

PostPosted: Thu Apr 08, 2010 8:41 pm    Post subject: Reply to: handling variable record length dataset
Reply with quote

here is a code snippet that will provide the function required
I pulled from the CBT tape file 814 and as such i believe it is in the public domain

Code:
Extended EXECIO

Problem addressed

The I/O model for sequential dataset processing as implemented
in REXX under MVS has one significant deficiency, namely the
lack of support for undefined format records (RECFM=U). The
XEXECIO command described in this article provides such
processing.

Solution

To simplify its use, XEXECIO has the same general syntax as the
standard EXECIO command. The solution as presented in this
article assumes that an installation environment user has a router
program that interprets that first word in the specified expression
as a subcommand and passes the remainder of the expression to
the appropriate processing program (in this case the XEXECIO
program code). XEXECIO could, of course, run in its own
environment. The major difference between the XEXECIO and
EXECIO syntax is the absence of the FINIS parameter - the
implemented version of XEXECIO always closes the specified
dataset.

Invocation syntax

      XEXECIO    count    DISKW ddname (STEM varname
                 *        DISKR ddname (STEM varname
                                        FIFO
                                        LIFO

count

The maximum number of records to be processed. * indicates a
high-value (ie no limit). In write mode, the processing ends when
this number is reached, the end of the stack is reached, or a null
stem variable is referenced, whichever occurs first. In read mode,
the processing ends when this number is reached or the end of the
input file is reached, whichever occurs first.

DISKW

Write mode.

DISKR

Read mode.

ddname

The name of the DD statement that specifies the dataset to be
processed.

FIFO

The queue is processed in first-in/first-out sequence. This is the
default.

LIFO

The queue is processed in last-in/first-out sequence.

STEM

The STEM keyword specifies that stem variables are to be used.
The stack is used if this parameter is omitted.

varname

The name of the stem variable that contains (is to contain) the
records to be processed. The records are named varname.1,... .

Return code

XEXECIO returns one of the values:

0      OK.

4      OK, no records written.

8      OK, one or more records truncated (one or more records to
      be written were longer than the blocksize specified for the
      dataset - the records are truncated to the maximum permitted
      blocksize).

12      Open error.

16      ESPIE exit taken (invalid parameter).

20      Parsing error.

24      ENVBLOCK locate error.

28      Internal error (buffer overflow).

Sample invocation

/* REXX - XEXECIO sample */
ADDRESS TSO "ALLOC F(DD) DA('U.DATA') SHR REUS";
SAY "stack fifo"
ADDRESS USER "XEXECIO * READ DD (FIFO";
SAY "XEXECIO RC" RC
SAY "queued" queued();
DO i = 1 TO queued()
  PARSE PULL a
  SAY a
END
SAY "stack lifo"
ADDRESS USER  "XEXECIO * READ DD (LIFO";
SAY "XEXECIO RC" RC
SAY "queued" queued();
DO i = 1 TO queued()
  PARSE PULL a
  SAY a
END
SAY "stem"
ADDRESS USER "XEXECIO * READ DD (STEM A."
SAY 1 A.1
SAY 2 A.2
SAY 3 A.3
EXIT
B.1 = "gamma"
B.2 = "delta"
B.3 = "a23456789b123456789c123456789d123456789e123456789";
ADDRESS USER "XEXECIO 3 WRITE DD (STEM B.";
push "zzzzzzzsdfsdfsfdsfsdfsdfsfsd"
ADDRESS USER "XEXECIO * WRITE DD";
SAY "RC" RC

Program code

Programs that use REXX services must be written in 31-bit
address mode. XEXECIO uses 24-bit residency mode because of
BSAM file processing. XEXECIO is written as re-entrant code.

         MACRO
         DCX   &P
.* macro for the definition of INSTBLK entries
         GBLC  &CSECT
         AIF   ('&CSECT' NE '').A1
&CSECT   SETC  '&SYSECT'
.A1      ANOP
&CSECT   CSECT
STMT&SYSNDX DC C&P
$INSTBLK CSECT
         DC    A(STMT&SYSNDX,L'STMT&SYSNDX)
         MEND
         TITLE 'Extended EXECIO'
* Register usage:
*   R5   A(DCB)
*   R6   A(SHVBLK)
*   R7   A(common area)
*   R8   A(External Entry Points Vector)
*   R9   A(ENVBLOCK)
*   R10  option table (branch address)
*   R12  base register
XEXECIO  CSECT
XEXECIO  AMODE 31    REXX addressing mode
XEXECIO  RMODE 24    I/O residency (addressing) mode
         BAKR  R14,0 save registers and return address
         BASR  R12,0 base register
         USING *,R12
* R0: A(Environment Block)
* R1: A(Host Command Environment Routine parameter list)
         LR    R9,R0              A(ENVBLOCK)
         LM    R2,R5,4(R1)
* initialization
         STORAGE OBTAIN,LENGTH=$XEXECIO_L,SP=1
         LR    R7,R1
         USING $XEXECIO,R7
         LA    R13,SA             set program save area
         ST    R5,ACMDRC          A(command ReturnCode)
         LA    R5,DCBIN           set default DCB (input)
         USING IHADCB,R5
         USING ENVBLOCK,R9
* set ESPIE (Addressing+Data)
         ESPIE SET,EXCP0CX,(5,7)
         B     CONTINUE
EXCP0CX  DS    0H
         BALR  R15,0
         USING *,R15
         MVC   RC,=H'16'          RC: ESPIE-exit taken
         B     EXIT
         DROP  R15
CONTINUE DS    0H
* initialize work area
         MVI   FLAG,0             processing flag
         MVC   LELEME(8),=2F'-1'
         MVI   VNINDEXX,C' '
         ZAP   INDEX,=P'0'
         LA    R1,ARGLIST
         ST    R1,AARGLIST
         LA    R1,EVALBLK
         ST    R1,AEVALBLK
         MVC   EVSIZE,=A((EVDATAE-EVALBLK)/8)
         MVC   EVLEN,=XL4'80000000'
         MVC   MAXRC,=H'-1'
         OI    FLAG,#NOREC        preset no-records-processed flag
         LA    R1,IOA
         ST    R1,AREC
         LA    R1,INSTBLK
         ST    R1,AINSTBLK        A(INSTBLK)
         MVC   INSTBLK_ACRONYM,=CL8'IRXINSTB'
         MVC   INSTBLK_HDRLEN,=F'128'  L(INSTBLK header)
         L     R1,=A($INSTBLK)
         ST    R1,INSTBLK_ADDRESS      INSTBLK entries
         MVC   INSTBLK_USEDLEN,=A(USEDLEN)
         MVC   INSTBLK_MEMBER,=CL8' '
         MVC   INSTBLK_DDNAME,=CL8' '
         MVC   INSTBLK_SUBCOM,=CL8'MVS'
         MVC   INSTBLK_DSNLEN,=F'0'
         MVC   DCBIN(DCBINL),DCBIN#
         MVC   DCBOUT(DCBOUTL),DCBOUT#
         MVC   OPEN(OPENL),OPEN#
         MVC   CLOSE(CLOSEL),CLOSE#
         L     R2,0(R2)           A(parm)
         L     R3,0(R3)           L(parm)
         STM   R2,R3,AELEM
         L     R8,ENVBLOCK_IRXEXTE
         USING IRXEXTE,R8
* process
         MVC   RC,=H'20'          RC: parsing error
         L     R15,IRXEXEC        A(IRXEXEC)
         CALL (15),                                                    X
               (P0,AARGLIST,FLAGS,AINSTBLK,P0,AEVALBLK,P0,P0),VL,      X
               MF=(E,CALL8)
         SR    R15,R15
         IC    R15,EVDATA
         N     R15,=F'7'          clear high-order
         LTR   R15,R15
         BNZ   EXIT               parsing error
* retrieve passed parameters (from stack)
         L     R15,IRXSTK         A(IRXSTK)
         CALL (15),(PULL,AELEM,LELEM,FRC),VL,MF=(E,CALL4)
* save stack entry
         MVC   RC,=H'28'          RC: internal error (overflow)
         LM    R0,R1,AELEM
         LA    R2,BUF             A(buffer)
         ST    R2,AELEM           set pointer
         LR    R3,R1              L(entry)
         C     R3,=A(L'BUF-1)
         BH    EXIT               overflow error
         MVCL  R2,R0              save stack entry
         MVI   0(R2),C' '         set blank at end of buffer
* parse out variables - stack entries have form: /varname vardata
* get /DD (DD name)
         LA    R1,#DD
         BAL   R14,GETSVAR        get formatted stack variable
* R2: A(DD name), R3: LC(DD name)
         LTR   R3,R3
         BM    EXIT               DD missing
         MVC   DDNAME,=CL8' '     clear DDname
         MVC   DDNAME(0),0(R2)    set DDname
         EX    R3,*-6
* get /NREC
         LA    R1,#NREC
         BAL   R14,GETSVAR        get formatted stack variable
         LTR   R3,R3
         BM    EXIT               NREC missing
         ZAP   NREC,=P'999999999' set high-value (default)
         CLI   0(R2),C'*'
         BE    *+14
         PACK  NREC,0(0,R2)
         EX    R3,*-6
* get /VARNAME
         LA    R1,#VARNAME
         BAL   R14,GETSVAR
         LTR   R3,R3
         BM    NOVARNAM           VARNAME missing
         MVC   VARNAME,BLANK      BLANK(VARNAME)
         MVC   VARNAME(0),0(R2)
         EX    R3,*-6
NOVARNAM LA    R1,1(R3)           L(VARNAME)
         ST    R1,VARNAMEL
         LA    R1,#IOOP
         BAL   R14,GETSVAR        get formatted stack variable
* R2: A(vardata), R3: LC(vardata)
         LTR   R3,R3
         BM    EXIT               IOOP missing
         MVC   RC,=H'12'          RC: open error
         CLC   =C'READ',0(R2)
         BNE   A010               not READ
         MVC   DCBDDNAM,DDNAME
         OPEN  ((5),(INPUT)),MF=(E,OPEN)
         LTR   R15,R15
         BNZ   EXIT               open error
         LH    R0,DCBBLKSI
         ST    R0,RECLEN
         B     A2000              READ processing
A010     DS    0H                 WRITE processing
         LA    R5,DCBOUT
         MVC   DCBDDNAM,DDNAME
         OPEN  ((5),(OUTPUT)),MF=(E,OPEN)
         LTR   R15,R15
         BNZ   EXIT               open error
         LH    R0,DCBBLKSI
         ST    R0,RECLEN
         B     A1000              WRITE processing
EOP      MVC   RC,=H'0'           end of processing
         TM    FLAG,#NOREC        test flag
         BZ    EXIT               records processed
         MVC   RC,=H'4'           else warning
EXIT     TM    DCBOFLGS,DCBOFOPN  test whether OPEN performed
         BZ    NOOPEN             :no OPEN
         CLOSE ((5)),MF=(E,CLOSE)
NOOPEN   LH    R15,RC
         LH    R0,MAXRC
         LTR   R0,R0
         BM    *+6
         LR    R15,R0
         L     R1,ACMDRC
         ST    R15,0(R1)          set command return code
* release allocated main-storage
         STORAGE RELEASE,LENGTH=$XEXECIO_L,ADDR=(7),SP=1
         SR    R15,R15            zeroize program return code
         PR    ,                  program return
         TITLE 'Write processing'
A1000    DS    0H write record (processing)
         MVC   RC,=H'0'           reset RC
         AP    INDEX,=P'1'
         CP    INDEX,NREC
         BH    EOP                last record written
         ICM   R3,B'1111',VARNAMEL test whether no VARNAME (=stack)
         BZ    A1100              :stack processing
* get next variable
         MVC   VNINDEX,=X'4020202020202120'
         LA    R1,VNINDEX+7
         EDMK  VNINDEX,INDEX
         MVC   VNINDEX,0(R1)      set into <VNINDEX>
* get record content
         MVC   VN,VARNAME
         LA    R1,VN(R3)          R3: L(varname)
         MVC   0(8,R1),VNINDEX
         L     R3,AREC
         L     R4,RECLEN
         BAL   R14,GETVAR
* R4: L(record)
A1040    LTR   R4,R4
         BZ    EXIT               null variable (=job end)
*   R3: A(variable data)
*   R4: L(variable data)
         USING IHADCB,R5
         CH    R4,DCBBLKSI
         BNH   *+14
         MVC   MAXRC,=H'8'        RC: record truncated
         LH    R4,DCBBLKSI        set maximum length
         WRITE DECB2,SF,(5),(3),(4),MF=E
         CHECK DECB2
         NI    FLAG,X'FF'-#NOREC  reset flag
A1030    B     A1000              return to processing loop
A1100    DS    0H                 get next stack variable
         L     R15,IRXSTK         A(IRXSTK)
         CALL  (15),(PULL,AELEM,LELEM,FRC),VL,MF=(E,CALL4)
         CH    R15,=H'4'
         BH    EXIT
         BE    EOP                end of stack
* else stack element retrieved, move to buffer
         LM    R0,R1,AELEM
         LR    R15,R1             length
         LR    R4,R1              L(variable)
         L     R14,AREC           A(target)
         LR    R3,R14             A(variable)
         MVCL  R14,R0             move record
         B     A1040              process record
         TITLE 'Read processing'
A2000    MVC   RC,=H'0'           reset RC
* get /OPTKYWD
         LA    R1,#OPTKYWD
         BAL   R14,GETSVAR
         CLC   =C'LIFO',0(R2)
         BNE   *+10
         MVC   STACKOP,=CL8'PUSH'
         CLC   =C'FIFO',0(R2)
         BNE   *+10
         MVC   STACKOP,=CL8'QUEUE'
A2100    BAL   R14,READREC
         AP    INDEX,=P'1'        increment record count
         CP    INDEX,NREC
         BH    EOP                last record read
         NI    FLAG,X'FF'-#NOREC  reset flag
         ICM   R1,B'1111',VARNAMEL L(VARNAME)
         BZ    A2200              :0, use stack
* convert INDEX to character format (.n)
         MVC   VNINDEX,=X'4020202020202120'
         LA    R1,VNINDEX+7
         EDMK  VNINDEX,INDEX
         MVC   VNINDEX,0(R1)      set into <VNINDEX>
* store record <varname>i)
* <VN>: variable name
*   R3: A(variable data)
*   R4: L(variable data)
         L     R3,AREC            A(record)
         L     R4,RECLEN          L(record)
         MVC   VN,VARNAME         variable name
         L     R1,VARNAMEL        L(VARNAME)
         LA    R1,VN(R1)
         MVC   0(8,R1),VNINDEX
         BAL   R14,SETVAR         pass to REXX
         B     A2100              return to read-loop
A2200    DS    0H                 store variable in stack
         L     R15,IRXSTK         A(IRXSTK)
         CALL (15),(STACKOP,AREC,RECLEN,FRC),VL,MF=(E,CALL4)
         B     A2100              read loop
EOF      DS    0H                 end of file
* output number of records processed
         ICM   R1,B'1111',VARNAMEL L(VARNAME)
         BZ    EOP                :0 (stack processing)
         ZAP   D,INDEX
         MVC   VN,VARNAME         VARNAME (STEM)
         LA    R1,VN(R1)          +L(VARNAME)
         MVC   0(2,R1),=C'0 '     0-variable
         OI    D+7,X'0F'          remove sign from count
         UNPK  WK,D               set into display form
         LA    R3,WK              A(record count)
         LA    R4,L'WK            L(record count)
* set data into REXX variable
         BAL   R14,SETVAR
         B     EOP                end of processing
         TITLE 'Subroutines'
GETSVAR  ST    R14,RA_GETSVAR     set return address
* Function: Get variable from formatted stack
* input:
*  R1: A(comparand)
* output:
*  R2: A(entry); R3: LC(entry)
*  R15: 20 (comparand not found)
         LA    R15,BUF
GETSVAR2 CLC   =C'//',0(R15)
         BE    GETSVAR3           last entry
         CLC   0(10,R1),0(R15)
         PACK  D,10(5,R15)        LENGTH(variable)
         CVB   R3,D
         BE    GETSVAR1           varname found
         LA    R15,17(R3,R15)     bump buffer address
         CLC   =C'//',0(R15)
         B     GETSVAR2           get next entry
* end of buffer, entry not found
GETSVAR3 LA    R15,20
         B     EXIT               exit
GETSVAR1 DS    0H                 varname found, get vardata
         LA    R2,16(R15)         A(data)
         BCTR  R3,0               LC(vardata)
         L     R14,RA_GETSVAR
         BR    R14                return
GETVAR   ST    R14,RA_GETVAR
* Function: Get REXX variable
* input:
*  <VN>: variable name
* output:
*  R3: A(variable)
*  R4: L(variable)
         BAL   R14,GETVNL         get L(VN)
         LA    R6,IRX_SHVBLOCK
         USING SHVBLOCK,R6
         ST    R0,SHVNAML         L(name), normalized
         LA    R1,VN              A(name)
         ST    R1,SHVNAMA
         MVI   SHVCODE,SHVFETCH   Fetch
         ST    R3,SHVVALA         A(buffer)
         ST    R4,SHVBUFL         L(buffer)
         L     R15,IRXEXCOM       A(IRXEXCOM)
         CALL (15),(IRX_IRXEXCOM,0,0,IRX_SHVBLOCK),VL,MF=(E,CALL4)
         L     R4,SHVVALL         L(data)
         L     R14,RA_GETVAR      load return address
         TM    SHVRET,SHVNEWV     new variable?
         BZR   R14                :no, return
         SR    R4,R4              else zeroize length
         BR    R14                return
GETVNL   DS    0H
* Function: Determine actual (normalized) length of name
* input: <VN> - name
* output: R0: L(name), normalised
         LA    R1,L'VN
         SR    R0,R0              counter
         LA    R15,VN
GETVNL1  CLI   0(R15),C' '
         BER   R14                end found
         AH    R0,=H'1'           increment counter
         LA    R15,1(R15)         bump address
         BCT   R1,GETVNL1
         BR    R14
SETVAR   ST    R14,RA_SETVAR
* Function: Set REXX variable
* input:
*  <VN>: variable name
*  R3: A(variable data)
*  R4: L(variable data)
         BAL   R14,GETVNL         get L(VN) -> R0
         LA    R6,IRX_SHVBLOCK
         USING SHVBLOCK,R6
         ST    R0,SHVNAML         L(name), normalized
         LA    R1,VN              A(name)
         ST    R1,SHVNAMA
         MVI   SHVCODE,SHVSTORE   set store-flag
         ST    R3,SHVVALA         A(data)
         ST    R4,SHVVALL         L(data)
         L     R15,IRXEXCOM       A(IRXEXCOM)
         CALL (15),(IRX_IRXEXCOM,0,0,IRX_SHVBLOCK),VL,MF=(E,CALL4)
         L     R14,RA_SETVAR
         BR    R14                return
READREC  ST    R14,RA_READREC
         LH    R4,DCBBLKSI
         READ  DECB1,SF,(5),IOA,(4),MF=E
         CHECK DECB1
         LH    R4,DCBLRECL
         LA    R3,IOA
*   R3: A(variable data)
*   R4: L(variable data)
         STM   R3,R4,AREC         A(record), L(record)
         L     R14,RA_READREC
         BR    R14
         TITLE 'Constants'
#IOOP    DC    C'/IOOP_____'      READ, WRITE
#L       EQU   *-#IOOP            entry length
#NREC    DC    C'/NREC_____'      * or number
#DD      DC    C'/DD_______'      DD-name
#VARNAME DC    C'/VARNAME__'      varname or blank
#OPTKYWD DC    C'/OPTKYWD__'      STEM, FIFO or LIFO
PULL     DC    CL8'PULL'
BLANK    DC    CL16' '
P0       DC    A(0)
FLAGS    DC    X'80000000'        invoke as command
IRX_IRXEXCOM DC CL8'IRXEXCOM'
OPEN#    OPEN  (0),MF=L
OPENL    EQU   *-OPEN#
CLOSE#   CLOSE (0),MF=L
CLOSEL   EQU   *-CLOSE#
DCBIN#   DCB   DDNAME=DUMMY,DSORG=PS,MACRF=R,DEVD=DA,EODAD=EOP,        x
               RECFM=U
DCBINL   EQU   *-DCBIN#
DCBOUT#  DCB   DDNAME=DUMMY,DSORG=PS,MACRF=W,DEVD=DA
DCBOUTL  EQU   *-DCBOUT#
         LTORG
         TITLE 'Variables and data areas'
$XEXECIO DSECT
SA       DS    18F                save area
ACMDRC   DS    A                  A(command return code)
DCBIN    DS    (DCBINL)X
DCBOUT   DS    (DCBOUTL)X
OPEN     DS    (OPENL)X
CLOSE    DS    (CLOSEL)X
         READ  DECB1,SF,0,0,'S',MF=L
         WRITE DECB2,SF,0,0,'S',MF=L
CALL4    CALL  ,(0,0,0,0),MF=L
CALL8    CALL  ,(0,0,0,0,0,0,0,0),MF=L
REGSA     DS   F     register save areas
RA_READREC DS  A
RA_GETSVAR DS  A
RA_GETVAR DS   A
RA_SETVAR DS   A
RC       DS    H
MAXRC    DC    H'-1'
CONDCODE DS    X     condition code (for branch)
INDEX    DS    PL4   record number counter
VNINDEX  DS    CL8' '
VNINDEXX DS    C' '
FLAG     DS    X     processing flag
#NOREC   EQU   X'01' no records processed
SRA      DS    A     save return address
D        DS    0D,PL8 double-word work area
WK       DS    CL6   work field
* the next two fields are contiguous
AREC     DS    A     )            A(record)
RECLEN   DS    A     )            L(record (block) )
NREC     DS    PL8   record counter
VARNAMEL DS    F     L(<VARNAME>)
VARNAME  DS    CL16  <VARNAME>
VN       DS    2CL16 'stem'-variable (<VARNAME>n, n = 1, 2, ...
DDNAME   DS    CL8   <DDNAME>
STACKOP  DS    CL8   stack operation (PUSH, QUEUE)
FRC      DS    F     function return code
BUF      DS    CL512 stack buffer
AARGLIST DS    A(ARGLIST)
ARGLIST  DS    0A    Argument List (also used for stack processing)
AELEM    DS    2A
         ORG   AELEM+4
LELEM    DS    F
LELEME   DS    2F'-1'
AEVALBLK DS    A(EVALBLK)
EVALBLK  DS    0F    align
         DS    F     reserved
EVSIZE   DS    A((EVDATAE-EVALBLK)/8)
EVLEN    DS    XL4'80000000'      L(data)
         DS    F     reserved
EVDATA   DS    CL64  data
EVDATAE  EQU   *
         DS    0F    align
AINSTBLK DS    A(INSTBLK)
INSTBLK  DS    0H
INSTBLK_ACRONYM DS   CL8'IRXINSTB'
INSTBLK_HDRLEN  DS   F'128' L(INSTBLK header)
         DS    F     reserved
INSTBLK_ADDRESS DS   A($INSTBLK) INSTBLK entries
INSTBLK_USEDLEN DS   A(USEDLEN)
INSTBLK_MEMBER  DS   CL8' '  member name (unused)
INSTBLK_DDNAME  DS   CL8' '  DD name (unused)
INSTBLK_SUBCOM  DS   CL8'MVS' subcom
         DS    F     reserved
INSTBLK_DSNLEN  DS   F       L(DSN)
         DS    CL54' '       DSN, unused
         ORG   INSTBLK+128
IRX_SHVBLOCK DS (SHVBLEN)X'0'
IOA      DS    CL(X'8000')
$XEXECIO_L EQU *-$XEXECIO
         TITLE 'DSECTs'
         DCBD  DEVD=DA,DSORG=PS
         IRXENVB
         IRXEXTE
         IRXSHVB
         TITLE 'INSTBLK entries'
XEXECIO  CSECT
 DCX '/* REXX  - process parameter list */'
 DCX 'PARSE ARG kywd nrec ioop dd option;'
 DCX 'PARSE UPPER VAR ioop ioop;'
 DCX 'PARSE UPPER VAR dd dd;'
 DCX 'option = STRIP(option,"T",")");'
 DCX 'SELECT;'
 DCX '  WHEN ioop = "WRITE" THEN DO;'
 DCX '    PARSE UPPER VAR option "(" "STEM" varname wtop .;'
 DCX '    IF wtop <> "" THEN CALL ErrorExit(4);'
 DCX '  END;'
 DCX '  WHEN ioop = "READ" THEN DO;'
 DCX '    PARSE VAR option "(" optkywd varname;'
 DCX '    PARSE UPPER VAR varname varname;'
 DCX '    SELECT'
 DCX '      WHEN optkywd = "STEM" THEN NOP;'
 DCX '      WHEN optkywd = "LIFO" THEN NOP;'
 DCX '      WHEN optkywd = "FIFO" THEN NOP;'
 DCX '      WHEN optkywd = "" THEN optkywd = "FIFO";'
 DCX '      OTHERWISE;'
 DCX '        CALL ErrorExit(2);'
 DCX '    END;'
 DCX '  END;'
 DCX '  OTHERWISE;'
 DCX '    CALL ErrorExit(3);'
 DCX 'END;'
 DCX '/* set stack entry */'
 DCX 'PUSH "/NREC_____"RIGHT(LENGTH(nrec),5,0) nrec,'
 DCX '  "/DD_______"RIGHT(LENGTH(dd),5,0) dd,'
 DCX '  "/IOOP_____"RIGHT(LENGTH(ioop),5,0) ioop,'
 DCX '  "/VARNAME__"RIGHT(LENGTH(varname),5,0) varname,'
 DCX '  "/OPTKYWD__"RIGHT(LENGTH(optkywd),5,0) optkywd,'
 DCX '  "//";/* end of list */'
 DCX 'EXIT 0;'
 DCX 'ErrorExit:'
 DCX '  SAY "Parsing error" ARG(1)'
 DCX '  EXIT ARG(1);'
$INSTBLK CSECT
USEDLEN  EQU *-$INSTBLK
         END


Anthony Rudd
Technical Consultant (Germany)                                              c A S Rudd 1994

Back to top
View user's profile Send private message
View previous topic :: :: View next topic  
Post new topic   Reply to topic    IBMMAINFRAMES.com Support Forums -> CLIST & REXX All times are GMT + 6 Hours
Page 1 of 1

 

Search our Forum:

Similar Topics
Topic Author Forum Replies Posted
No new posts Browse dataset cvnlynn CLIST & REXX 4 Tue Jul 18, 2017 3:52 am
No new posts Need to write record of PS File in ex... Chandan1993 JCL & VSAM 1 Wed Jun 07, 2017 1:35 am
No new posts Can I traverse a STEM variable? chong.zhou CLIST & REXX 5 Wed May 31, 2017 3:54 pm
No new posts Fileaid 2 commands instream work. In ... descann Compuware & Other Tools 2 Tue May 16, 2017 3:31 pm
No new posts Converting Variable block file to Fix... bhavana yalavarthi DFSORT/ICETOOL 10 Tue May 16, 2017 2:20 pm


Facebook
Back to Top
 
Mainframe Wiki | Forum Rules | Bookmarks | Subscriptions | FAQ | Tutorials | Contact Us