*COPY                                                 GUPVAR            10000000
*          Specific variables                                           10001000
EVCTR    DS    F             File sequence number                   TSO 10002000
ICPRGS   DS    4F            Saved registers for type-out      @SC88026 10003000
*                                                                       10004000
PPLAREA  DS    A(0,0,CPECB,PRSPCL,RESULT,0,USERBLK)            GUP1.1   10005000
CPECB    DS    F             GETLINE/PUTLINE/PUTGET ECB        @TS86001 10006000
RESULT   DS    A             Parse PDL ptr                     GUP1.1   10007000
USERBLK  DS    D             Parse work area (not used)        GUP1.1   10008000
*                                                                       10009000
CAMLOC   DS    4F            Ptrs for locating dataset         @SC86299 10010000
CAMOBT   DS    4F            Ptrs for getting DSCB             @SC86299 10011000
CAMVOLS  DS    0D,XL265      Storage for volume list           @SC86299 10012000
CAMDSCB  DS    0F,XL101      Storage for DSCB                  @SC88014 10013000
         ORG   CAMDSCB+1                                       @SC88014 10014000
DS1VOL   DS    CL6,XL2       Volume serial                     @SC86299 10015000
DS1CRDT  DS    2XL3,3X,XL13  Creation date                     @SC86299 10016000
DS1RFDT  DS    XL3,XL4       Reference date                    @SC86299 10017000
DS1DSO   DS    XL2           Dataset org                       @SC86299 10018000
DS1RCF   DS    X             Record format                     @SC86299 10019000
DS1OPT   DS    X             Error option                      @SC86299 10020000
DS1BLK   DS    H             Block size                        @SC86299 10021000
DS1LRC   DS    H             Logical record length             @SC86299 10022000
         ORG   ,                                               @SC86299 10023000
DYNPL    DS    A(0,0,0,0,DYNDSP,0),X'80',AL3(DYNRC)            GUP1.1   10024000
DYNRC    DS    F                                               @SC86299 10025000
DYNDSP   DS    X                                               @SC86299 10026000
FNAME    DS    CL130         Buffer for reading                     TSO 10027000
*COPY                                                 GUPSPC            10028000
*        External references in TSO GUPI:                               10028100
*  CLOSE    DCB      FREEMAIN FREEPOOL GETMAIN  IKJCPPL  IKJENDP        10028200
*  IKJIDENT IKJKEYWD IKJNAME  IKJPARM  IKJPOSIT IKJSUBF  LINK           10028300
*  LOCATE   OBTAIN   OPEN     SAVE                                      10028400
*                                                                       10028500
*          Specific preliminaries                                       10029000
&STORDS  SETC  'KSTORG'      Storage DSECT for Kermit globals  @SC89268 10029500
*                                                                       10030000
LFID     EQU   60            Filespec length                   GUP1.2   10031000
STKDWDS  EQU   511           Requested stack length                 TSO 10032000
XXBAT    EQU   X'04'         Special flag for batch mode       GUP1.1   10033000
KWRKBASE EQU   11            Base register for work area       @SC89268 10033300
KSUBBASE EQU   12            Base register for CSECT           @SC89268 10033600
*                                                                       10034000
         IKJCPPL ,                                             GUP1.1   10035000
*COPY                                                 GUPFIN            10036000
         LR    2,15          Save return code                  GUP1.1   10037000
         CLOSE MSGFIL                                          GUP1.1   10038000
         LR    15,2          Return code                       GUP1.1   10039000
*COPY                                                 GUPNIT            10040000
*          TSO user interface                                       TSO 10041000
*                                                                       10042000
         LA    4,DYNDSP      Set up DYNALC plist               GUP1.2   10043000
         LA    6,DYNRC                                         GUP1.2   10044000
         STM   4,6,DYNPL+16                                    GUP1.2   10045000
         OI    DYNPL+24,X'80' Mark end of plist                GUP1.2   10046000
*                                                                       10047000
         TM    0(1),X'80'    What kind of plist?               GUP1.1   10048000
         BZ    GUPCP         Seems to be CP                    GUP1.1   10049000
         MVC   SRCNAM(3*LFID+3),BATDDNS  Copy ddnames+mark     GUP1.1   10050000
         LA    4,XXCOR+XX8+XXBAT Default flags                 GUP1.1   10051000
         L     1,0(1)        Ptr to parm string                GUP1.1   10052000
         LH    2,0(1)        Get length                        GUP1.1   10053000
OPTLP    SR    0,0           Mask: zeroes                      GUP1.1   10054000
         CH    2,EH2         Enough for a 'NO'?                GUP1.1   10055000
         BL    OPTZ          No                                GUP1.1   10056000
         CLC   =C'NO',2(1)   Is it?                            GUP1.1   10057000
         BNE   OPTYES        No, assume positive option        GUP1.1   10058000
EH2      EQU   *+2,2                                           GUP1.1   10059000
         LA    1,2(1)        Yes, it is.  Space over the NO    GUP1.1   10060000
         SH    2,EH2         Cut off the NO                    GUP1.1   10061000
         BCTR  0,0           Mask: ones                        GUP1.1   10062000
OPTYES   SH    2,EH4         See if room for option            GUP1.1   10063000
         BL    OPTZ          No, done scan                     GUP1.1   10064000
         CLC   =C'MARK=',2(1)                                  GUP1.1   10065000
         BNE   OPTCK         Check flags                       GUP1.1   10066000
         SH    2,EH4         See if mark field available       GUP1.1   10067000
         BL    OPTZ          No, done scan                     GUP1.1   10068000
         MVC   MRKD,7(1)     Copy in case NOSEQ8               GUP1.1   10069000
         LA    1,8(1)        Space over option                 GUP1.1   10070000
         B     OPTLQ                                           GUP1.1   10071000
OPTCK    LA    3,XX8         Test for SEQ8                     GUP1.1   10072000
         CLC   =C'SEQ8',2(1)                                   GUP1.1   10073000
         BE    OPTOK         Found it                          GUP1.1   10074000
         LA    3,XXCOR       Test for in-storage               GUP1.1   10075000
         CLC   =C'STOR',2(1)                                   GUP1.1   10076000
         BNE   OPTZ          None of these, give up            GUP1.1   10077000
OPTOK    OR    4,3           Turn flag on                      GUP1.1   10078000
         NR    3,0                                             GUP1.1   10079000
         XR    4,3           Turn off if "NO"                  GUP1.1   10080000
         LA    1,4(1)        Advance ptr over option           GUP1.1   10081000
OPTLQ    LTR   2,2           Any more options?                 GUP1.1   10082000
         BNP   OPTZ                                            GUP1.1   10083000
         CLI   2(1),C','     Make sure there is a separator    GUP1.1   10084000
         BNE   OPTZ          No, give up                       GUP1.1   10085000
         LA    1,1(1)                                          GUP1.1   10086000
         BCT   2,OPTLP                                         GUP1.1   10087000
OPTZ     STC   4,FLG         Save current flags                GUP1.1   10088000
         OPEN  (MSGFIL,OUTPUT)  Message data set               GUP1.1   10089000
         TM    MSGFIL+FABOFLGS-FABD,X'10'                      GUP1.1   10090000
         BZ    ERREX         Oops                              GUP1.1   10091000
         B     OPN                                             GUP1.1   10092000
*                                                                       10093000
         USING CPPL,1                                          @SC86299 10094000
GUPCP    MVI   SRCNAM,C' '                                     GUP1.1   10095000
         MVC   SRCNAM+1(3*LFID+2),SRCNAM  Blank out parm area  GUP1.1   10096000
         MVI   FLG,0                                           GUP1.1   10097000
         L     3,CPPLUPT     Fill in parse parameter list      GUP1.1   10098000
         L     4,CPPLECT                                       GUP1.1   10099000
         LA    5,CPECB                                         GUP1.2   10100000
         L     6,=V(PRSPCL)                                    GUP1.2   10101000
         LA    7,RESULT                                        GUP1.2   10102000
         L     8,CPPLCBUF                                      GUP1.2   10103000
         LA    9,USERBLK                                       GUP1.2   10104000
         STM   3,9,PPLAREA                                     GUP1.1   10105000
         DROP  1                                               GUP1.1   10106000
         MVI   CPECB,0                                         GUP1.1   10107000
         LINK  EP=IKJPARS,MF=(E,PPLAREA) Perform parsing serviceUP1.1   10108000
         LTR   15,15         Any good?                         GUP1.1   10109000
         BNZ   ERREX         No, exit with error               GUP1.1   10110000
*          Interpret results                                   GUP1.1   10111000
         L     8,RESULT      Address parsed data               GUP1.1   10112000
         USING IKJPARMD,8                                      GUP1.1   10113000
         LA    1,PRSSRC      -> Base dataset name info         GUP1.1   10114000
         LA    6,SRCNAM      -> Destination field              GUP1.1   10115000
         BAL   7,MOVDSN      Move dataset name                 GUP1.1   10116000
         LA    1,PRSCTL      Do update DSN                     GUP1.1   10117000
         LA    6,CTLNAM                                        GUP1.1   10118000
         BAL   7,MOVDSN                                        GUP1.1   10119000
         LA    1,PRSOUT      Do output DSN                     GUP1.1   10120000
         LA    6,OUTNAM                                        GUP1.1   10121000
         BAL   7,MOVDSN                                        GUP1.1   10122000
         CLI   PRSSEQ8+1,1   SEQ8 option set?                  GUP1.1   10123000
         BNE   *+8           No                                GUP1.1   10124000
         OI    FLG,XX8       Yes, enable flag                  GUP1.1   10125000
         CLI   PRSSTOR+1,1   STOR option set?                  GUP1.1   10126000
         BNE   *+8           No                                GUP1.1   10127000
         OI    FLG,XXCOR     Yes, enable flag                  GUP1.1   10128000
         LA    1,PRSMRKV                                       GUP1.1   10129000
         LA    6,MRKD                                          GUP1.1   10130000
         BAL   7,MOVMEM      Move mark, if any                 GUP1.1   10131000
         B     OPN           Done                              GUP1.1   10132000
*                                                                       10133000
MOVDSN   L     2,0(1)        --> dataset name                  GUP1.1   10134000
         LH    3,4(1)        Length                            GUP1.1   10135000
         BCTR  3,0                                             GUP1.1   10136000
         EX    3,CPYTXT      Move dataset name                 GUP1.1   10137000
         LA    6,44(6)       Point to member storage           GUP1.1   10138000
         LA    1,8(1)                                          GUP1.1   10139000
MOVMEM   L     2,0(1)        Member name                       GUP1.1   10140000
         LTR   2,2           Test for member                   GUP1.1   10141000
         BZR   7             None                              GUP1.1   10142000
         LH    3,4(1)        Length                            GUP1.1   10143000
         BCTR  3,0                                             GUP1.1   10144000
         EX    3,CPYTXT      Move member name                  GUP1.1   10145000
         BR    7                                               GUP1.1   10146000
CPYTXT   MVC   0(,6),0(2)                                      GUP1.1   10147000
         DROP  8                                               GUP1.1   10148000
*                                                                       10149000
WTEXT    STM   14,1,ICPRGS   Save registers                    GUP1.1   10150000
         TM    FLG,XXBAT     Batch version?                    GUP1.1   10151000
         BZ    WTXCP         No, just do a TPUT                GUP1.1   10152000
         STH   0,MSGFIL+FABLRECL-FABD Save LRECL               GUP1.1   10153000
         LR    0,1                                             GUP1.1   10154000
         PUT   MSGFIL,(0)    And write it out                  GUP1.1   10155000
         B     WTXRET                                          GUP1.1   10156000
WTXCP    SVC   93                                              GUP1.1   10157000
WTXRET   LM    14,1,ICPRGS   Restore and return                GUP1.1   10158000
         BR    15                                              GUP1.1   10159000
*                                                                       10160000
MSGFIL   DCB   DDNAME=SYSPRINT,MACRF=PM,RECFM=U,BLKSIZE=130,DSORG=PS    10161000
*                                                                       10162000
BATDDNS  DC    CL(LFID)'+SYSUT1'                               GUP1.2   10163000
         DC    CL(LFID)'+SYSIN'                                GUP1.2   10164000
         DC    CL(LFID)'+SYSUT2'                               GUP1.2   10165000
         DC    C'   '        Leave sequence field blank        GUP1.1   10166000
*                                                                       10167000
PRSPCL   IKJPARM ,                                             GUP1.1   10168000
PRSSRC   IKJPOSIT DSNAME,USID,PROMPT='SOURCE DSNAME'           GUP1.1   10169000
PRSCTL   IKJPOSIT DSNAME,USID,PROMPT='UPDATE DSNAME'           GUP1.1   10170000
PRSOUT   IKJPOSIT DSNAME,USID,PROMPT='OUTPUT DSNAME'           GUP1.1   10171000
PRSSEQ8  IKJKEYWD DEFAULT='SEQ8'                               GUP1.1   10172000
         IKJNAME 'SEQ8'                                        GUP1.1   10173000
         IKJNAME 'NOSEQ8'                                      GUP1.1   10174000
PRSSTOR  IKJKEYWD DEFAULT='STOR'                               GUP1.1   10175000
         IKJNAME 'STOR'                                        GUP1.1   10176000
         IKJNAME 'NOSTOR'                                      GUP1.1   10177000
PRSMARK  IKJKEYWD ,                                            GUP1.1   10178000
         IKJNAME 'MARK',SUBFLD=PRS2MRK                         GUP1.1   10179000
PRS2MRK  IKJSUBF ,                                             GUP1.1   10180000
PRSMRKV  IKJIDENT 'SEQUENCE MARK',FIRST=ANY,OTHER=ANY,MAXLNTH=3 UP1.1   10181000
         IKJENDP ,                                             GUP1.1   10182000
GUPI     CSECT                                                          10183000
*                                                                   TSO 10184000
OPNERR   LA    1,L'OPNEM                                            TSO 10185000
         BAL   0,FILERR                                             TSO 10186000
OPNEM    DC    C'FILE NOT FOUND: '                                  TSO 10187000
DSKERR   LA    2,8(1)                                               TSO 10188000
         LA    1,L'DSKEM                                            TSO 10189000
         BAL   0,FILERR                                             TSO 10190000
DSKEM    DC    C'DISK ERROR ON FILE '                               TSO 10191000
*                                                                   TSO 10192000
FILERR   LA    4,FNAME       Buffer to use                          TSO 10193000
         LR    5,1                                                  TSO 10194000
         MVCL  4,0           Copy message                           TSO 10195000
         LA    3,LFID        Length of a name field                 TSO 10196000
         LR    5,3                                                  TSO 10197000
         MVCL  4,2           Copy name                              TSO 10198000
         LA    1,FNAME       Start of buffer again                  TSO 10199000
         SR    4,1                                                  TSO 10200000
         WTEXT (1),(4)                                              TSO 10201000
         B     ERREX                                                TSO 10202000
*COPY                                                 GUPSUB            10203000
         TITLE 'DISKIO Routine - performs disk I/O functions'           10204000
* Function selected on entry by R0:                                     10205000
* 1=> open (in): R1->pattern FDB, R2->name.  Returns R0->FAB, R1->FDB   10206000
* 2=> open (out): (same, but no complete FDB if new file)               10207000
* 4=> close file: R1->adr(FAB).                                         10208000
* 9=> read: R1->FAB.  Returns R15=12 if EOF, 0 if ok; R0=# data         10209000
* 10=> write: R1->FAB.  Returns R15=13 if disk full, 0 if ok.           10210000
DISKIO   ENTER                                                          10211000
         USING FABD,3                                          @SC86295 10212000
         SR    4,4           Signal no block assigned          @SC86295 10213000
         LA    6,FDBTRKAL-FDBD(1) Use pattern TRKAL            @SC88026 10214000
         ST    6,DYNPL+20    Set up calling sequence           GUP1.1   10215000
         BCT   0,DSKOPNO                                       @SC86295 10216000
*                                                                       10217000
* Open for input file whose name is at (R2), FDB at (R1)                10218000
         MVI   DYNDSP,X'88'  SHR,KEEP                          @SC86299 10219000
         BAL   9,DSKALC      Get FAB                           @SC86295 10220000
         BAL   2,DSKLKP      Get DSCB                          @SC86299 10221000
         BNZ   DSKER1        Not found                         @SC86295 10222000
         BAL   14,DSKVALS                                      @SC86295 10223000
         BAL   9,DSKFABS     Set up FAB from FDB               @SC86299 10224000
         CNOP  0,4                                             @SC86299 10225000
         BAL   2,DSKOPT      Open and test                     @SC86299 10226000
         OPEN  (0,INPUT),MF=L                                  @SC86299 10227000
*                                                                       10228000
* Open for output file whose name is at (R2), FDB at (R1)               10229000
DSKOPNO  BCT   0,DSKTEST                                       @SC86295 10230000
         MVI   DYNDSP,X'42'  NEW,CATLG                         @SC86299 10231000
         BAL   9,DSKALC      Get FAB                           @SC86295 10232000
         BAL   2,DSKLKP      Get DSCB                          @SC86299 10233000
         BNZ   DSKOPN        Not found, just writing new       @SC86299 10234000
         MVI   DYNDSP,X'18'  OLD,KEEP                          @SC86299 10235000
         TM    DS1DSO,2      PDS?                              GUP1.1   10236000
         BZ    DSKOPN        No, we just write over it         GUP1.1   10237000
         BAL   14,DSKVALS    Yes, copy DCB info                GUP1.1   10238000
         BAL   9,DSKFABS                                       GUP1.1   10239000
DSKOPN   CNOP  0,4                                             @SC86299 10240000
         BAL   2,DSKOPT      Open and test                     @SC86299 10241000
         OPEN  (0,OUTPUT),MF=L                                 @SC86299 10242000
DSKOPT   CLI   FABDSN,C'+'   Just DDNAME?                      GUP1.1   10243000
         BE    DSKOPDZ       Yes, don't need to allocate       GUP1.1   10244000
         KCALL DYNALC,DYNPL,EXT                                @SC86299 10245000
DSKOPDZ  DS    0H                                              GUP1.1   10246000
         OPEN  ((3)),MF=(E,(2))                                @SC86299 10247000
         TM    FABOFLGS,X'10'                                  @SC86299 10248000
         BZ    DSKER1        Didn't work                       @SC86299 10249000
         B     RTRN0                                           @SC86295 10250000
*                                                                       10251000
DSKTEST  BCT   0,DSKCLOS                                       @SC86295 10252000
         B     RTRN1                                           @SC86299 10253000
*                                                                       10254000
* Close file whose ticket is at (R1), release block                     10255000
DSKCLOS  BCT   0,DSKRED                                        @SC86295 10256000
         ICM   3,15,0(1)     Get FAB ptr, if any               @SC86295 10257000
         BZ    RTRN0         None, ignore                      @SC86295 10258000
         XC    0(4,1),0(1)   Yes, now clear ticket             @SC86295 10259000
         CLOSE ((3))                                           @SC86299 10260000
      FREEPOOL (3)                                             @SC86299 10261000
         LA    0,FABDWDS                                       @SC86295 10262000
         LR    1,3                                             @SC86299 10263000
       DMSFRET DWORDS=(0),LOC=(1)                              @SC86295 10264000
         B     RTRN0                                           @SC86295 10265000
*                                                                       10266000
* Read from file whose ticket is at (R1)                                10267000
DSKRED   SH    0,=H'4'                                                  10268000
         BCT   0,DSKWRT                                        @SC86295 10269000
         LTR   3,1           Get FAB ptr                       @SC86299 10270000
         BNP   RTRN1         Not defined anymore               @SC86299 10271000
         L     15,FABGET     I/O routine                       @SC86299 10272000
         BALR  14,15         Go to it                          @SC86299 10273000
         LM    4,5,FDBBUFF   Get buffer and size               @SC86299 10274000
         LH    7,FABLRECL    Actual length                     @SC86299 10275000
         AR    7,1           End of record                     @SC86299 10276000
         BAL   2,DSKTV                                         @SC86299 10277000
          LA   1,4(1)        Skip over SDW if V                @SC86299 10278000
         SR    7,1           Revised length                    @SC86299 10279000
         LR    6,1                                             @SC86299 10280000
         CR    7,5                                             @SC86299 10281000
         BNL   *+6                                             @SC86299 10282000
         LR    5,7           Buffer not filled                 @SC86299 10283000
         L     1,4(13)                                         @SC86299 10284000
         ST    5,20(1)       Return length in R0               @SC86299 10285000
         MVCL  4,6           Copy to buffer                    @SC86299 10286000
         B     RTRN0                                           @SC86299 10287000
* End of file on input. Don't close it yet.                    @SC86295 10288000
DSKEOD   LA    15,12         End return code                   @SC86295 10289000
         B     RTRN                                            @SC86295 10290000
*                                                                       10291000
* Write to file whose ticket is at (R1)                                 10292000
DSKWRT   DS    0H                                                       10293000
         LTR   3,1           Get FAB ptr                       @SC86299 10294000
         BNP   RTRN1         Not defined anymore               @SC86299 10295000
         LM    4,5,FDBBUFF   Get buffer and size               @SC86299 10296000
         LR    6,5           Copy for LRECL                    @SC86299 10297000
         CH    6,FDBLRC                                        @SC86299 10298000
         BNH   *+8                                             @SC86299 10299000
         LH    6,FDBLRC      Don't allow more than LRECL if V  @SC86299 10300000
         BAL   2,DSKTV                                         @SC86299 10301000
          LA   6,4(5)        + 4 if RECFM=V                    @SC86299 10302000
         STH   6,FABLRECL    Set up for output                 @SC86299 10303000
         L     15,FABGET     I/O routine                       @SC86299 10304000
         BALR  14,15         Do it                             @SC86299 10305000
         XC    0(4,1),0(1)                                     @SC86299 10306000
         STCM  6,3,0(1)      In case V                         @SC86299 10307000
         BAL   2,DSKTV                                         @SC86299 10308000
          LA   1,4(1)        V: space over SDW                 @SC86299 10309000
         LR    6,1                                             @SC86299 10310000
         LR    7,5                                             @SC86299 10311000
         MVCL  6,4           Copy to output record             @SC86299 10312000
         B     RTRN0                                           @SC86295 10313000
*                                                                       10314000
DSKTV    TM    FABRECFM,FABRECU                                @SC86299 10315000
         BNM   4(2)          U                                 @SC86299 10316000
         TM    FABRECFM,FABRECF                                @SC86299 10317000
         BO    4(2)          F                                 @SC86299 10318000
         BR    2             V                                 @SC86299 10319000
* Return on error, release useless block, if any                        10320000
DSKER1   LTR   1,4           Any block assigned?               @SC86295 10321000
         BZ    RTRN1         No                                @SC86295 10322000
         LA    0,FABDWDS     Yes, release it                   @SC86295 10323000
       DMSFRET DWORDS=(0),LOC=(1)                              @SC86295 10324000
         B     RTRN1         Flag error                        @SC86295 10325000
*                                                                       10326000
DSKALC   LR    5,1           Save FDB ptr                      @SC86295 10327000
         LA    6,1           Update counter                    @SC86299 10328000
         A     6,EVCTR                                         @SC86299 10329000
         ST    6,EVCTR                                         @SC86299 10330000
         LA    0,FABDWDS                                       @SC86295 10331000
       DMSFREE DWORDS=(0),ERR=DSKER1                           @SC86295 10332000
         LR    3,1           New block ptr                     @SC86295 10333000
         LR    4,1                                             @SC86295 10334000
         L     1,4(13)                                         @SC86295 10335000
         ST    3,20(1)       Return R0                         @SC86295 10336000
         XC    0(8*FABDWDS,3),0(3)                             @SC86295 10337000
         MVC   FDBD(FDBCOP),0(5) Copy user's FDB               @SC86295 10338000
         MVC   FABDSN,0(2)                                     @SC86299 10339000
         LR    15,2          Set up DSN ptr                    @SC86299 10340000
         LA    0,FABDDNAM    Get DDN ptr                       @SC86299 10341000
         LA    1,FDBUNT      Get UNIT ptr                      @SC86299 10342000
         LA    2,FDBVOL      Get VOL ptr                       @SC86299 10343000
         STM   15,2,DYNPL    Set up DYNALC                     @SC86299 10344000
         MVI   FABBUFCB+3,1  Fill out DCB                      @SC86299 10345000
         MVI   FABDSORG,X'40' =PS                              @SC86299 10346000
         MVI   FABIOBAD+3,1                                    @SC86299 10347000
         LA    0,DSKEOD                                        @SC86299 10348000
         LA    1,DSKOPEX                                       @SC86299 10349000
         STM   0,1,FABEODAD                                    @SC86299 10350000
         UNPK  FABDDNAM,EVCTR(5)                               @SC86299 10351000
         TR    FABDDNAM,TRHEX  Get unique DDNAME               @SC86299 10352000
         MVI   FABDDNAM,C'K'                                   @SC86299 10353000
         MVI   FABDDNAM+7,C'Z'                                 @SC86299 10354000
         MVC   FABOFLGS(4),=X'02,00,48,48'                     @SC86299 10355000
         MVI   FABCHECK+3,1                                    @SC86299 10356000
         LA    1,RTRN1                                         @SC86299 10357000
         ST    1,FABSYNAD    In case of error                  @SC86299 10358000
         MVI   FABIOBA+3,1                                     @SC86299 10359000
         MVI   FABEOBAD+3,1                                    GUP1.1   10360000
         MVI   FABRECAD+3,1                                    GUP1.1   10361000
         MVI   FABCNTRL+3,1                                    GUP1.1   10362000
         MVI   FABEOB+3,1                                      @SC86299 10363000
DSKFABS  LH    1,FDBLRC      Copy Info to DCB                  @SC86299 10364000
         CLI   FABDSN,C'+'   Just DDNAME?                      GUP1.1   10365000
         BE    DSKDDA        Yes, copy it to FAB               GUP1.1   10366000
         STH   1,FABLRECL                                      @SC86299 10367000
         MVC   FABBLKSI,FDBBLKSI                               @SC86299 10368000
         MVI   FABRECFM,FABRECU                                @SC86299 10369000
         CLI   FDBRCF,C'U'                                     @SC86299 10370000
         BER   9                                               @SC86299 10371000
         MVI   FABRECFM,FABRECF+FABRECBR                       @SC86299 10372000
         CLI   FDBRCF,C'F'                                     @SC86299 10373000
         BER   9                                               @SC86299 10374000
         MVI   FABRECFM,FABRECV+FABRECBR                       @SC86299 10375000
         LA    1,4(1)        Allow for RDW                     @SC86299 10376000
         STH   1,FABLRECL                                      @SC86299 10377000
         BR    9                                               @SC86299 10378000
DSKDDA   MVC   FABDDNAM,FABDSN+1 Copy to DDNAME                GUP1.1   10379000
         BR    9                                               GUP1.1   10380000
*                                                                       10381000
* Call with R15->name, return to R2 with CC set (Z if ok)               10382000
DSKLKP   SR    0,0                                             @SC86299 10383000
         CLI   0(15),C'+'    Just DDNAME?                      GUP1.1   10384000
         BER   2             Yes, say we found it              GUP1.1   10385000
         LA    1,CAMVOLS                                       @SC86299 10386000
         LA    14,X'44'      Name code                         @SC86299 10387000
         SLL   14,24                                           @SC86299 10388000
         STM   14,1,CAMLOC   Save dsn ptr, etc                 @SC86299 10389000
         LA    0,CAMVOLS+6                                     @SC86299 10390000
         LA    1,CAMDSCB                                       @SC86299 10391000
         LA    14,X'C1'      Search code                       @SC86299 10392000
         SLL   14,24                                           @SC86299 10393000
         STM   14,1,CAMOBT                                     @SC86299 10394000
        LOCATE CAMLOC                                          @SC86299 10395000
         LTR   6,15          Retain 1st code in R6             @SC86299 10396000
         BNZR  2             Give up                           @SC86299 10397000
        OBTAIN CAMOBT        Get DSCB                          @SC86299 10398000
         LTR   15,15         Test return code                  @SC86299 10399000
         BR    2                                               @SC86295 10400000
*                                                                       10401000
DSKVALS  LA    0,FDBD        Ptr to FDB                        @SC86295 10402000
         L     1,4(13)                                         @SC86295 10403000
         ST    0,24(1)       Return ptr to caller              @SC86295 10404000
         CLI   FABDSN,C'+'   Just DDNAME?                      GUP1.1   10405000
         BER   14            Yes, done: no DSCB                GUP1.1   10406000
         MVC   FDBBLKSI,DS1BLK                                 @SC86299 10407000
         MVC   FDBVOL,DS1VOL Copy volume name                  @SC86299 10408000
         LH    1,DS1BLK      Use BLKSIZE if 'U'                @SC86299 10409000
         MVI   FDBRCF,C'U'                                     @SC86299 10410000
         TM    DS1RCF,FABRECU                                  @SC86299 10411000
         BO    DSKVLR                                          @SC86299 10412000
         LH    1,DS1LRC      Use LRECL if 'F'                  @SC86299 10413000
         MVI   FDBRCF,C'F'                                     @SC86299 10414000
         TM    DS1RCF,FABRECF                                  @SC86299 10415000
         BO    DSKVLR                                          @SC86299 10416000
         MVI   FDBRCF,C'V'                                     @SC86299 10417000
         S     1,F4          Use LRECL-4 if 'V'                @SC86299 10418000
DSKVLR   STH   1,FDBLRC                                        @SC86299 10419000
         BR    14                                              @SC86299 10420000
*                                                                       10421000
DSKOPEX  DC    0F'0',X'85',AL3(DSKOPC) OPEN EXIT               @SC86299 10422000
*                                                                       10423000
DSKOPC   LR    3,1                                             @SC86299 10424000
         LH    5,FABBLKSI                                      @SC86299 10425000
         LTR   5,5                                             @SC86299 10426000
         BP    *+8                                             @SC86299 10427000
         LH    5,=H'6233'                                      @SC86299 10428000
         LR    6,5                                             @SC86299 10429000
         TM    FABRECFM,FABRECU                                @SC86299 10430000
         BO    DSKOPS                                          @SC86299 10431000
         LH    6,FABLRECL                                      @SC86299 10432000
         BNZ   *+8                                             @SC86299 10433000
         OI    FABRECFM,FABRECF+FABRECBR                       @SC86299 10434000
         LTR   6,6                                             @SC86299 10435000
         BP    DSKOPQ                                          @SC86299 10436000
         LA    6,80                                            @SC86299 10437000
         BAL   2,DSKTV                                         @SC88049 10438000
          LA   6,4(6)        Allow LRECL=84 for VB             @SC88049 10439000
DSKOPQ   TM    FABRECFM,FABRECF                                @SC86299 10440000
         BZ    DSKOPV                                          @SC86299 10441000
         SR    4,4                                             @SC86299 10442000
         DR    4,6                                             @SC86299 10443000
         LTR   5,5                                             @SC88104 10444000
         BP    *+8                                             @SC88104 10445000
         LA    5,1           BLKSIZE was less than LRECL!      @SC88104 10446000
         MR    4,6                                             @SC86299 10447000
         B     DSKOPS                                          @SC86299 10448000
DSKOPV   LA    4,4(6)                                          @SC86299 10449000
         CR    4,5                                             @SC86299 10450000
         BNH   DSKOPS                                          @SC86299 10451000
         LR    5,4                                             @SC86299 10452000
DSKOPS   STH   6,FABLRECL                                      @SC86299 10453000
         STH   5,FABBLKSI                                      @SC86299 10454000
         BR    14                                              @SC86299 10455000
*                                                                       10456000
         LOCALS ,                                              @SC86295 10457000
         EXIT                                                           10458000
