Check, find, & replace (CFR)
-------------------------------------------------------------------------

>General description

CFR is a file support utility for professional use. It is not a  replacement for 
XEDIT. Unlike XEDIT, which is used in conversational mode, CFR works 
in batch mode.

Mostly CFR is intended to manipulate very large CMS files with record 
lengths of up to 64 K bytes.

CFR operates in three modes:
* Check: checks file contents to verify that a file contains only specified 
codes.
* Find: searches to determine if a file contains a given string.
* Replace: replaces occurences of a search string in a file; if the 
replacement string is empty, the search string is excluded from the file.

CFR was written in Assembler and REXX. Its assembler code is optimized 
for speedy execution and high productivity.

>Basic software

CFR was created in CMS with VM/SP Release 5.

>Memory requirements

The size of CFR is 1912 bytes. To accelerate fixed-length file processing, a 
buffer area size of 1 Mb is allocated in execution time.

>CFR EXEC usage

CFR EXEC has no parameters. The user selects mode and inputs parameters 
during interactive dialog.

The user is always prompted to enter a source file and the record number 
where processing should start. By default, processing will start with the first 
record.

In Check mode, the EBCDIC code table is displayed by CFR. The user may 
set or unset chosen codes. Only set codes are considered valid when a file is 
verified.

Codes to be set may be entered as a characters or hexadecimal numbers from 
x'0' to x'FF'. Hexadecimal numbers must be preceded by X with no 
following apostrophe.

The syntax of a command line is
<operation> {< char> | <hex>} [<char> | <hex>]
where operation = S or U, char = a single character, and hex = a 
hexadecimal number in (x'0',x'ff').

Examples of setting and unsetting codes are as follows:
  S A        setted code A, C1 in hex
  U X0       unsetted hex code 0
  S XF0 XF9  setted all codes in range 0-9, F0-F9 in hex
  U A Z      unset all codes in range A-Z, C1-E9 in hex

Find mode, determines whether a file contains a given text or hexadecimal 
string. The search is terminated after finding the first occurence of that 
string.

Examples of searching for a string are as follows:
  ABC      char string
  X010203  hex string

Replace mode replaces or excludes all occurences of a given string. The 
search string and replacement string may different lengths. If the 
replacement is length zero, an empty string, then all occurences of the search 
string are excluded from the source file.

An example of search and replace follows:
  Search  Replacement  Action
  ------  -----------  ------
  123     X000102      replace, one-to-one, no file size changes
  ABC     <none>       exclude, possible prompt for a pad
  X00     X404040      replace, possible truncation of a records

If the replacement string is longer than the search string, the resulting record 
is truncated from the right, up to the record size of the source file.

If the replacement string is shorter than the search string and the source file 
has a fixed record format, then a padding character must be specified. The 
padding character is a single character or a hexadecimal number.

Examples of padding character declaration are:
<none>  blank, x'40'
0       0, x'F0'
X0      not displayable code, x'00'
X40     blank, x'40'

Note: Replace mode creates a new file containing the replacements. The new 
file may be larger than the source file. This fact must be considered when a 
minidisk is specified for the target file.

>CFR distribution material

CFR EXEC, INSTALLATION
/********************************************************************/
/***                                                  ***         ***/
/*** CFRINST            generate CFR MODULE           ***  DG"99  ***/
/***                                                  ***         ***/
/********************************************************************/
/***   SIZE 00048  VER 1.0 MOD 000  TIME 19:32:42 DATE 09/07/99   ***/
/********************************************************************/

  HI = '1DF8'X
  LO = '1DF0'X
  CLRSCRN
  DO 11
    SAY
  END
  MESSAGE = 'user request'
SAY'--- Start CFR MODULE generation - reply Y or N'HI TIME(L)LO
  PULL REPLY
  IF REPLY ^= 'Y' THEN
  SIGNAL ERROR
  SET CMSTYPE HT
  STATE CFR MODULE A
  SAVE_RC = RC
  SET CMSTYPE RT
  IF SAVE_RC = 0 THEN
  DO
    SAY '--- CFR MODULE found on disk A'HI TIME(L)LO
    SAY '--- Replace CFR MODULE A - reply Y or N'HI TIME(L)LO
    PULL REPLY
    IF REPLY ^= 'Y' THEN
    SIGNAL ERROR
  END
  SET CMSTYPE HT
  SIGNAL ON ERROR
  MESSAGE = 'error when assemble' CFR
  ASSEMBLE CFR
  ERASE CFR LISTING A
  MESSAGE = 'error when load' CFR
  LOAD CFR '(' NOMAP NOLIBE
  MESSAGE = 'error when genmod' CFR
  GENMOD
  ERASE CFR TEXT A
  SIGNAL OFF ERROR
  SET CMSTYPE RT
  SAY '--- CFR MODULE generated successfully'HI TIME(L)LO
  EXIT
ERROR:
  SET CMSTYPE RT
SAY '--- CFR MODULE not generated due to' MESSAGE HI TIME(L)LO

CFR EXEC
/********************************************************************/
/***                                                  ***         ***/
/*** CFR             check, find & replace            ***  DG"99  ***/
/***                                                  ***         ***/
/********************************************************************/
/***   SIZE 00317  VER 1.0 MOD 000  TIME 19:54:24 DATE 09/07/99   ***/
/********************************************************************/

  HI = '1DF8'X
  LO = '1DF0'X
  CLRSCRN
  DO 10
    SAY
  END
  SAY '>>>---> Check, find & replace -'
  SAY
  SAY '        Select mode ---------'
  SAY
  SAY '        1 - Check'
  SAY '        2 - Find'
  SAY '        3 - Replace'
  SAY '------- Enter 1, 2, or 3'
  PULL MODE .
  IF MODE = '' ! VERIFY(MODE, '123') ^= 0 THEN
  EXIT
  IF LEFT(MODE, 1) = '1' THEN
  MODE = 'C'
  ELSE
  IF LEFT(MODE, 1) = '2' THEN
  MODE = 'F'
  ELSE
  IF LEFT(MODE, 1) = '3' THEN
  MODE = 'R'
  FLR = ' '
  CLRSCRN
  DO 10
    SAY
  END
  DO FOREVER
    SAY '--- Enter source file - reply FN FT FM or 0/exit/'
    PULL FN FT FM
    IF FN = '0' THEN
    EXIT
    IF FM ^= '' THEN
    LISTFILE FN FT FM '(STACK ALL'
    IF QUEUED() = 1 THEN
    LEAVE
    SAY '--- File' FN FT FM 'not found'
  END
  PULL . . . RECFM . RECORDS .
  SAY '--- Enter start record number or none to process all records'
  PULL START .
  IF LENGTH(START) > 0 THEN
    IF VERIFY(START, '0123456789') > 0 THEN
  EXIT
  ELSE
  START = MIN(START, RECORDS)
  IF MODE ^= 'C' THEN
  DO FOREVER
    SAY '--- Enter search string'
    PULL FND
    IF LENGTH(FND) = 0 THEN
    ITERATE
    IF SUBSTR(FND, 1, 1) = 'X' THEN
    DO
      FND = SUBSTR(FND, 2)
      IF VERIFY(FND, '0123456789ABCDEF') > 0 THEN
      DO
        SAY '>>> Errors in hexadecimal data'
        ITERATE
      END
      ELSE
      FND = X2C(FND)
    END
    SAY 'Cha['FND']'
    HEX_R = C2X(FND)
    CALL HEX_GEN
    SAY '--- Enter 1/Yes/ to process'
    PULL ANS .
    IF ANS = 1 THEN
    LEAVE
  END
  IF MODE = 'R' THEN
  DO
    CLRSCRN
    DO 10
      SAY
    END
    DO FOREVER
      SAY '--- Enter replacement string'
      PULL REP
      IF SUBSTR(REP, 1, 1) = 'X' THEN
      DO
        REP = SUBSTR(REP, 2)
        IF VERIFY(REP, '0123456789ABCDEF') > 0 THEN
        DO
          SAY '>>> Errors in hexadecimal data'
          ITERATE
        END
        ELSE
        REP = X2C(REP)
      END
      IF LENGTH(REP) = 0 THEN
      SAY '    Found occurences will be excluded'
      ELSE
      DO
        SAY 'Cha['REP']'
        HEX_R = C2X(REP)
        CALL HEX_GEN
      END
      SAY '--- Enter 1/Yes/ to process'
      PULL ANS .
      IF ANS = 1 THEN
      LEAVE
    END
    CLRSCRN
    DO 10
      SAY
    END
    SAY '--- Enter target file - reply FN FT FM'
    PULL FN1 FT1 FM1
    IF FM1 = '' THEN
    EXIT
    IF LENGTH(FM1) ^= 0 THEN
    DO
      SET CMSTYPE HT
      MAKEBUF
      QUERY DISK FM1 '(' STACK LIFO
      PULL . . . STATUS .
      DROPBUF
      SET CMSTYPE RT
      IF STATUS ^= 'R/W' THEN
      DO
        SAY '--- Disk ' FM1 'is read/only'
        EXIT
      END
    END
    SET CMSTYPE HT
    LISTFILE FN1 FT1 FM1
    RC_SAVE = RC
    SET CMSTYPE RT
    IF RC_SAVE = 0 THEN
    DO
      SAY '--- File' FN1 FT1 FM1 'found - enter 1/Yes/ to erase'
      PULL ANS .
      IF ANS ^= '1' THEN
      EXIT
      ERASE FN1 FT1 FM1
    END
    IF RECFM = 'F' THEN
      IF LENGTH(FND) > LENGTH(REP) THEN
    DO FOREVER
      SAY '--- Enter padding char to fill record after replace'
      PULL FLR .
      IF FLR = '' THEN
      FLR = 'X40'
      IF SUBSTR(FLR, 1, 1) = 'X' THEN
      DO
        FLR = RIGHT(                                              ,
                 SUBSTR(FLR, 2, MIN(LENGTH(FLR)-1, 2)), 2, '0')
        FLR = X2C(FLR)
      END
      ELSE
      FLR = SUBSTR(FLR, 1, 1)
      SAY '    Fixed records will be filled with ' FLR '(char) ->',
                                          C2X(FLR) '(hex)'
      SAY '--- Enter 1/Yes/ to process with above setting'
      PULL ANS .
      IF ANS = 1 THEN
      LEAVE
    END
  END
  IF MODE = 'C' THEN
  DO
    MARK = COPIES('40'X, 256)
    HEX = '0123456789ABCDEF'
    SWITCH = 1
    DO FOREVER
      CALL SHOW
      IF SWITCH = 0 THEN
      DO
        SAY CENTER('Enter BLANK/continue/, 1/process/, 0/exit/',    ,
                      79, '+')
        PULL ANS .
        IF VERIFY(ANS, ' 10') = 0 THEN
        DO
          IF ANS = '0' THEN
          DO
            CLRSCRN
            EXIT
          END
          SWITCH = 1
          IF ANS = '1' THEN
          DO
            IF VERIFY(MARK, '40'X) = 0 THEN
            DO
              CLRSCRN
              DO 21
                SAY
              END
              SAY '--- Codes to check not found'
              SLEEP 5 SEC
              ITERATE
            END
            ELSE
            LEAVE
          END
        END
        ITERATE
      END
      SWITCH = 0
      SAY '--- Enter S/set/ or U/unset/ and CHAR/HEX or'             ,
               'range as CHAR CHAR or HEX HEX'LO
      PULL ACTION CODE_1 CODE_2
      IF ACTION = 'S' THEN
      SHOW_WITH = '+'
      ELSE
      SHOW_WITH = ' '
      I = 0
      IF LENGTH(CODE_2) > 0 THEN
      DO
        IF LENGTH(CODE_1) = 1 THEN
          IF LENGTH(CODE_2) = 1 THEN
        DO
          IF X2D(C2X(CODE_1)) ^> X2D(C2X(CODE_2)) THEN
          I = X2D(C2X(CODE_2)) - X2D(C2X(CODE_1)) + 1
          J = X2D(C2X(CODE_1)) + 1
        END
        IF LENGTH(CODE_1) > 1 THEN
          IF LENGTH(CODE_2) > 1 THEN
        DO
          CODE_1 = SUBSTR(CODE_1, 2)
          CODE_2 = SUBSTR(CODE_2, 2)
          IF DATATYPE(CODE_1 !! CODE_2, 'X') THEN
            IF X2D(CODE_1) ^> X2D(CODE_2) THEN
          I = X2D(CODE_2) - X2D(CODE_1) + 1
          J = X2D(CODE_1) + 1
        END
      END
      ELSE
      DO
        IF LENGTH(CODE_1) = 1 THEN
        DO
          I = 1
          J = X2D(C2X(CODE_1)) + 1
        END
        ELSE
        IF LENGTH(CODE_1) > 1 THEN
        DO
          CODE_1 = SUBSTR(CODE_1, 2)
          IF ^ DATATYPE(CODE_1, 'X') THEN
          I = 0
          ELSE
          DO
            I = 1
            J = X2D(CODE_1) + 1
          END
        END
      END
      IF I > 0 THEN
        IF J < 256 THEN
      MARK = OVERLAY(COPIES(SHOW_WITH, VALUE(I)), MARK, J)
    END
  END
  TAB = ''
  DO I = 1 TO 256
    IF SUBSTR(MARK, I, 1) = ' ' THEN
    TAB = TAB !! 'FF'X
    ELSE
    TAB = TAB !! '00'X
  END
  CLRSCRN
  DO 16
    SAY
  END
  CFR  MODE RIGHT(START, 8, '0') FN FT FM FN1 FT1 FM1
  IF RC ^= 0  THEN
  SAY '--- The above error caused CFR abend'
  SAY
  EXIT
HEX_GEN:
  REP_HEX_1 = ''
  REP_HEX_2 = ''
  DO I = 1 TO LENGTH(HEX_R) BY 2
    REP_HEX_1 = REP_HEX_1 !! SUBSTR(HEX_R, I, 1)
    REP_HEX_2 = REP_HEX_2 !! SUBSTR(HEX_R, I+1, 1)
  END
  SAY 'He1['REP_HEX_1'!'
  SAY 'He2['REP_HEX_2'!'
  RETURN
SHOW:
  CLRSCRN
  SAY 'Codes  >>> 1-63 <<<'
  SAY 'Hex 1' HI                                                     ,
    COPIES('0', 16)COPIES('1', 16)COPIES('2', 16)COPIES('3', 16)LO
  SAY 'Hex 2' HI COPIES(HEX, 4) LO
  SAY 'Chars'
  SAY LEFT('Check', 7) SUBSTR(MARK, 1, 64)
  SAY 'Codes  >>> 64-127 <<<'
  SAY 'Hex 1' HI                                                     ,
    COPIES('4', 16)COPIES('5', 16)COPIES('6', 16)COPIES('7', 16)LO
  SAY 'Hex 2' HI COPIES(HEX, 4) LO
  SAY 'Chars' HI XRANGE('40'X, '7F'X) LO
  SAY LEFT('Check', 7) SUBSTR(MARK, 65, 64)
  SAY 'Codes  >>> 128-191 <<<'
  SAY 'Hex 1' HI                                                     ,
    COPIES('8', 16)COPIES('9', 16)COPIES('A', 16)COPIES('B', 16)LO
  SAY 'Hex 2' HI COPIES(HEX, 4) LO
  SAY 'Chars' HI XRANGE('80'X, 'BF'X) LO
  SAY 'Codes  >>> 192-256 <<<'
  SAY LEFT('Check', 7) SUBSTR(MARK, 129, 64)
  SAY 'Hex 1' HI                                                     ,
    COPIES('C', 16)COPIES('D', 16)COPIES('E', 16)COPIES('F', 16)LO
  SAY 'Hex 2' HI COPIES(HEX, 4) LO
  SAY 'Chars' HI XRANGE('C0'X, 'FF'X) LO
  SAY LEFT('Check', 7) SUBSTR(MARK, 193, 64)
  RETURN

CFR ASSEMBLE
**********************************************************************
****                                                  ***         ****
**** CFR             check, find & replace            ***  DG"99  ****
****                                                  ***         ****
**********************************************************************
****   SIZE 00367  VER 1.0 MOD 000  TIME 19:23:59 DATE 09/07/99   ****
**********************************************************************
*                                                                    *
CFR      CSECT
         USING *,12
         ST    14,BACK2CMS
         MVC   REQ(1),8(1)
         LA    11,DCBREP
         LA    10,DCB
         USING FSCBD,10
         PACK  DOUBLE(8),16(8,1)
         CVB   15,DOUBLE
         ST    15,FSCBAITN
         MVC   DCB+8(24),24(1)
         CLI   REQ,C'R'
         BNE   GETREXX
         MVC   DCBREP+8(18),48(1)
GETREXX  EQU   *
         CLI   REQ,C'R'
         BNE   GETFND
         MVC   REXXID(3),=CL3'FLR'
         BAL   2,REXXDATA
         MVC   FILLER(1),REXXVAL
         MVC   REXXID(3),=CL3'REP'
         BAL   2,REXXDATA
         L     15,VALUELEN
         STH   15,LENREPL
         LTR   15,15
         BZ    GETFND
         BCTR  15,0
         STC   15,MVCR+1
         STC   15,MOVEREP+1
MVCR     MVC   REPLACE(64),REXXVAL
GETFND   EQU   *
         CLI   REQ,C'C'
         BE    GETTAB
         MVC   REXXID(3),=CL3'FND'
         BAL   2,REXXDATA
         L     15,VALUELEN
         STH   15,LENFIND
         BCTR  15,0
         STH   15,LENFJMP
         STC   15,MVCF+1
         STC   15,CLC+1
MVCF     MVC   FIND(64),REXXVAL
         B     OPEN
GETTAB   EQU   *
         MVC   REXXID(3),=CL3'TAB'
         BAL   2,REXXDATA
OPEN     EQU   *
         FSOPEN FSCB=DCB,ERROR=RET,FORM=E
         L     15,FSCBSIZE
         ST    15,LRECL
         MVC   DCBREP+X'24'(1),FSCBFV
         CLI   FSCBFV,C'F'
         BNE   CNV2DBL
         MVC   ALLOC(4),=A(128*512)
         B     COUNTBUF
CNV2DBL  EQU   *
         LA    15,7(15)
         SRL   15,3
         ST    15,ALLOC
COUNTBUF EQU   *
         SR    0,0
         L     1,ALLOC
         SLL   1,3
         D     0,LRECL
         ST    1,FSCBANIT
         USING FSCBD,11
         ST    1,FSCBANIT
         SR    0,0
         M     0,LRECL
         DROP  11
         USING FSCBD,10
         ST    1,FSCBSIZE
         USING FSCBD,11
         ST    1,FSCBSIZE
         D     0,=F'256'
         LTR   0,0
         BZ    SKIP
         BCTR  0,0
         STC   0,TRTREST+1
SKIP     EQU   *
         STM   0,1,REST
         L     0,ALLOC
         CLI   REQ,C'R'
         BNE   ASIS
         SLL   0,1
ASIS     EQU   *
         DMSFREE DWORDS=(0),TYPE=USER,AREA=HIGH,ERR=RET
         DROP  11
         USING FSCBD,10
         ST    1,FSCBBUFF
         L     0,FSCBSIZE
         AR    0,1
         USING FSCBD,11
         ST    0,FSCBBUFF
         DROP  11
         USING FSCBD,10
READNEXT EQU   *
         FSREAD FSCB=DCB,FORM=E
         CLI   FLAG,X'00'
         BE    JUMP
         MVI   FLAG,X'00'
         XC    FSCBAITN(4),FSCBAITN
JUMP     EQU   *
         LTR   15,15
         BNZ   CLOSE
         L     9,FSCBBUFF
         CLI   REQ,C'C'
         BNE   CHECKF
         SR    1,1
         CLI   FSCBFV,C'V'
         BE    RECALC
         C     0,FSCBSIZE
         BNE   RECALC
         LM    14,15,REST
         B     CUTDCMD
RECALC   EQU   *
         LR    15,0
         SR    14,14
         D     14,=F'256'
         LTR   14,14
         BZ    CUTDCMD
         BCTR  14,0
         STC   14,TRTREST+1
CUTDCMD  EQU   *
         LTR   15,15
         BZ    CHKREST
DOLOOP   EQU   *
         TRT   0(256,9),TAB
         LTR   1,1
         BNZ   DISPMSG
         LA    9,256(9)
         BCT   15,DOLOOP
CHKREST  EQU   *
         LTR   14,14
         BZ    READNEXT
TRTREST  TRT   0(0,9),TAB
         LTR   1,1
         BZ    READNEXT
DISPMSG  EQU   *
         WTO   '--- Invalid characters FOUND'
         B     FREEMAIN
CHECKF   EQU   *
         CLI   FSCBFV,C'V'
         BE    SETVLEN
         C     0,FSCBSIZE
         BNE   CNTRECS
         L     2,FSCBANIT
         B     STARTCYC
CNTRECS  EQU   *
         SRDL  0,32
         D     0,LRECL
         LR    2,1
         B     STARTCYC
SETVLEN  EQU   *
         LA    2,1
STARTCYC EQU   *
         USING FSCBD,11
         L     7,FSCBBUFF
NEXTREC  EQU   *
         LR    3,9
         LR    6,7
         LR    15,3
         LR    14,7
         ST    14,ORIGRG14
         A     6,LRECL
         CLI   FSCBFV,C'F'
         BNE   ITSVFMT
         L     0,LRECL
ITSVFMT  EQU   *
         LA    8,1
         AR    9,0
         SH    9,LENFIND
NEXTPOS  EQU   *
CLC      CLC   0(0,3),FIND
         BNE   FINDCYC
         CLI   REQ,C'R'
         BE    SUBST
         WTO   '--- Search string FOUND'
         B     FREEMAIN
SUBST    EQU   *
         LR    1,3
         SR    1,15
         LTR   1,1
         BZ    REPONLY
         LR    5,1
         LR    0,14
         LR    4,15
         AR    1,7
         LR    14,6
         SR    14,1
         BP    LENOK
         AR    5,14
         LTR   5,5
         BNP   CONTINUE
LENOK    EQU   *
         LR    1,5
         AR    7,1
         MVCL  0,4
         CR    6,7
         BE    CONTINUE
REPONLY  EQU   *
         AH    3,LENFJMP
         CLI   LENREPL+1,X'00'
         BE    NOTHTOMV
         CR    6,7
         BNH   NOTHTOMV
         LR    5,6
         SR    5,7
         CH    5,LENREPL
         BH    SPACEOK
         SH    5,LENREPL
         LTR   5,5
         BZ    CONTINUE
         LPR   5,5
         EX    5,MOVEREP
         AR    7,5
         B     CONTINUE
SPACEOK  EQU   *
MOVEREP  MVC   0(64,7),REPLACE
NOTHTOMV EQU   *
         AH    7,LENREPL
         LA    15,1(3)
         LR    14,7
FINDCYC  EQU   *
         BXLE  3,8,NEXTPOS
LEAVE    EQU   *
         AH    9,LENFIND
         CLI   REQ,C'R'
         BNE   READNEXT
         LR    5,9
         C     14,ORIGRG14
         BE    MOVEASIS
         SR    5,15
         LR    1,6
         SR    1,7
         CR    1,5
         BE    MOVELONG
         BH    CHECKFV
         LR    5,1
         B     MOVELONG
CHECKFV  EQU   *
         CLI   FSCBFV,C'F'
         BE    FILLIT
         LR    1,5
FILLIT   EQU   *
         ICM   5,8,FILLER
         B     MOVELONG
MOVEASIS EQU   *
         SR    5,15
         LR    1,5
MOVELONG EQU   *
         LR    0,14
         LR    4,15
         LR    15,1
         MVCL  0,4
         LR    7,0
         B     PROCNEXT
CONTINUE EQU   *
         AH    9,LENFIND
PROCNEXT EQU   *
         BCT   2,NEXTREC
         DROP  11
         USING FSCBD,10
         L     0,FSCBNORD
         CLI   FSCBFV,C'F'
         BE    CNTBLOCK
         S     7,ORIGRG14
         LR    2,7
         B     SETFSCB
CNTBLOCK EQU   *
         CLC   FSCBSIZE(4),FSCBNORD
         BE    WRITE
         LR    2,0
         SRDL  0,32
         D     0,LRECL
         USING FSCBD,11
         ST    1,FSCBANIT
SETFSCB  EQU   *
         ST    2,FSCBSIZE
WRITE    EQU   *
         FSWRITE FSCB=DCBREP,ERROR=FREEMAIN,FORM=E
         B     READNEXT
CLOSE    EQU   *
         CLI   REQ,C'C'
         BNE   FMSG
         WTO   '--- Invalid characters NOT FOUND'
         B     FREEMAIN
FMSG     EQU   *
         CLI   REQ,C'F'
         BNE   RMSG
         WTO   '--- Search string NOT FOUND'
         B     FREEMAIN
RMSG     EQU   *
         WTO   '--- All occurrences are replaced'
FREEMAIN EQU   *
         FSCLOSE FSCB=DCB
         CLI   REQ,C'R'
         BNE   DMSFREE
         FSCLOSE FSCB=DCBREP
DMSFREE  EQU   *
         L     0,ALLOC
         DROP  11
         USING FSCBD,10
         L     1,FSCBBUFF
         CLI   REQ,C'R'
         BNE   DMSFRET
         SLL   0,1
DMSFRET  EQU   *
         DMSFRET DWORDS=(0),LOC=(1)
RET      EQU   *
         L     11,BACK2CMS
         BR    11
REXXDATA EQU   *
         LA    0,REXXPARM
         LA    1,COMMAND
         ICM   1,8,=X'02'
         SVC   202
         DC    AL4(1)
         LTR   15,15
         BM    RET
         BR    2
DOUBLE   DS    D
REXXPARM DC    A(COMMAND)
         DC    8X'00'
         DC    A(REQBLOK)
COMMAND  DC    CL8'EXECCOMM'
REQBLOK  DC    2A(0)
REQUEST  DC    C'F'
RETCODE  DC    3X'00'
BUFSIZE  DC    F'256'
         DC    A(REXXID)
NAMELEN  DC    F'3'
         DC    A(REXXVAL)
VALUELEN DS    F
EXTPLIST EQU   *
         DC    A(COMMVERB)
         DC    3A(0)
COMMVERB DC    CL8'SUBCOM'
BACK2CMS DS    F
ALLOC    DS    F
LRECL    DS    F
REST     DS    2F
ORIGRG14 DS    F
LENFIND  DS    H
LENREPL  DS    H
LENFJMP  DS    H
FIND     DS    8CL8
REPLACE  DS    8CL8
REXXVAL  DS    16CL16
REXXID   DS    CL3
REQ      DS    CL1
FILLER   DS    CL1
FLAG     DC    X'FF'
TAB      EQU   REXXVAL
         LTORG
DCB      FSCB  FORM=E
DCBREP   FSCB  FORM=E
         FSCBD
         END   CFR

CFR getting ready

CFRINST EXEC should be used to generate the CFR MODULE on disk A.

---------------------------------------------------------------------
©Dobrin Goranov
dg099@hotmail.com
---------------------------------------------------------------------
Published in VM Update, copyright SDS, Summer 2000, www.sdsusa.com