home *** CD-ROM | disk | FTP | other *** search
/ kermit.columbia.edu / kermit.columbia.edu.tar / kermit.columbia.edu / archives / deleteme.zip / iktgup.asm < prev    next >
Assembly Source File  |  1992-09-30  |  38KB  |  468 lines

  1. *COPY                                                 GUPVAR            10000000
  2. *          Specific variables                                           10001000
  3. EVCTR    DS    F             File sequence number                   TSO 10002000
  4. ICPRGS   DS    4F            Saved registers for type-out      @SC88026 10003000
  5. *                                                                       10004000
  6. PPLAREA  DS    A(0,0,CPECB,PRSPCL,RESULT,0,USERBLK)            GUP1.1   10005000
  7. CPECB    DS    F             GETLINE/PUTLINE/PUTGET ECB        @TS86001 10006000
  8. RESULT   DS    A             Parse PDL ptr                     GUP1.1   10007000
  9. USERBLK  DS    D             Parse work area (not used)        GUP1.1   10008000
  10. *                                                                       10009000
  11. CAMLOC   DS    4F            Ptrs for locating dataset         @SC86299 10010000
  12. CAMOBT   DS    4F            Ptrs for getting DSCB             @SC86299 10011000
  13. CAMVOLS  DS    0D,XL265      Storage for volume list           @SC86299 10012000
  14. CAMDSCB  DS    0F,XL101      Storage for DSCB                  @SC88014 10013000
  15.          ORG   CAMDSCB+1                                       @SC88014 10014000
  16. DS1VOL   DS    CL6,XL2       Volume serial                     @SC86299 10015000
  17. DS1CRDT  DS    2XL3,3X,XL13  Creation date                     @SC86299 10016000
  18. DS1RFDT  DS    XL3,XL4       Reference date                    @SC86299 10017000
  19. DS1DSO   DS    XL2           Dataset org                       @SC86299 10018000
  20. DS1RCF   DS    X             Record format                     @SC86299 10019000
  21. DS1OPT   DS    X             Error option                      @SC86299 10020000
  22. DS1BLK   DS    H             Block size                        @SC86299 10021000
  23. DS1LRC   DS    H             Logical record length             @SC86299 10022000
  24.          ORG   ,                                               @SC86299 10023000
  25. DYNPL    DS    A(0,0,0,0,DYNDSP,0),X'80',AL3(DYNRC)            GUP1.1   10024000
  26. DYNRC    DS    F                                               @SC86299 10025000
  27. DYNDSP   DS    X                                               @SC86299 10026000
  28. FNAME    DS    CL130         Buffer for reading                     TSO 10027000
  29. *COPY                                                 GUPSPC            10028000
  30. *        External references in TSO GUPI:                               10028100
  31. *  CLOSE    DCB      FREEMAIN FREEPOOL GETMAIN  IKJCPPL  IKJENDP        10028200
  32. *  IKJIDENT IKJKEYWD IKJNAME  IKJPARM  IKJPOSIT IKJSUBF  LINK           10028300
  33. *  LOCATE   OBTAIN   OPEN     SAVE                                      10028400
  34. *                                                                       10028500
  35. *          Specific preliminaries                                       10029000
  36. &STORDS  SETC  'KSTORG'      Storage DSECT for Kermit globals  @SC89268 10029500
  37. *                                                                       10030000
  38. LFID     EQU   60            Filespec length                   GUP1.2   10031000
  39. STKDWDS  EQU   511           Requested stack length                 TSO 10032000
  40. XXBAT    EQU   X'04'         Special flag for batch mode       GUP1.1   10033000
  41. KWRKBASE EQU   11            Base register for work area       @SC89268 10033300
  42. KSUBBASE EQU   12            Base register for CSECT           @SC89268 10033600
  43. *                                                                       10034000
  44.          IKJCPPL ,                                             GUP1.1   10035000
  45. *COPY                                                 GUPFIN            10036000
  46.          LR    2,15          Save return code                  GUP1.1   10037000
  47.          CLOSE MSGFIL                                          GUP1.1   10038000
  48.          LR    15,2          Return code                       GUP1.1   10039000
  49. *COPY                                                 GUPNIT            10040000
  50. *          TSO user interface                                       TSO 10041000
  51. *                                                                       10042000
  52.          LA    4,DYNDSP      Set up DYNALC plist               GUP1.2   10043000
  53.          LA    6,DYNRC                                         GUP1.2   10044000
  54.          STM   4,6,DYNPL+16                                    GUP1.2   10045000
  55.          OI    DYNPL+24,X'80' Mark end of plist                GUP1.2   10046000
  56. *                                                                       10047000
  57.          TM    0(1),X'80'    What kind of plist?               GUP1.1   10048000
  58.          BZ    GUPCP         Seems to be CP                    GUP1.1   10049000
  59.          MVC   SRCNAM(3*LFID+3),BATDDNS  Copy ddnames+mark     GUP1.1   10050000
  60.          LA    4,XXCOR+XX8+XXBAT Default flags                 GUP1.1   10051000
  61.          L     1,0(1)        Ptr to parm string                GUP1.1   10052000
  62.          LH    2,0(1)        Get length                        GUP1.1   10053000
  63. OPTLP    SR    0,0           Mask: zeroes                      GUP1.1   10054000
  64.          CH    2,EH2         Enough for a 'NO'?                GUP1.1   10055000
  65.          BL    OPTZ          No                                GUP1.1   10056000
  66.          CLC   =C'NO',2(1)   Is it?                            GUP1.1   10057000
  67.          BNE   OPTYES        No, assume positive option        GUP1.1   10058000
  68. EH2      EQU   *+2,2                                           GUP1.1   10059000
  69.          LA    1,2(1)        Yes, it is.  Space over the NO    GUP1.1   10060000
  70.          SH    2,EH2         Cut off the NO                    GUP1.1   10061000
  71.          BCTR  0,0           Mask: ones                        GUP1.1   10062000
  72. OPTYES   SH    2,EH4         See if room for option            GUP1.1   10063000
  73.          BL    OPTZ          No, done scan                     GUP1.1   10064000
  74.          CLC   =C'MARK=',2(1)                                  GUP1.1   10065000
  75.          BNE   OPTCK         Check flags                       GUP1.1   10066000
  76.          SH    2,EH4         See if mark field available       GUP1.1   10067000
  77.          BL    OPTZ          No, done scan                     GUP1.1   10068000
  78.          MVC   MRKD,7(1)     Copy in case NOSEQ8               GUP1.1   10069000
  79.          LA    1,8(1)        Space over option                 GUP1.1   10070000
  80.          B     OPTLQ                                           GUP1.1   10071000
  81. OPTCK    LA    3,XX8         Test for SEQ8                     GUP1.1   10072000
  82.          CLC   =C'SEQ8',2(1)                                   GUP1.1   10073000
  83.          BE    OPTOK         Found it                          GUP1.1   10074000
  84.          LA    3,XXCOR       Test for in-storage               GUP1.1   10075000
  85.          CLC   =C'STOR',2(1)                                   GUP1.1   10076000
  86.          BNE   OPTZ          None of these, give up            GUP1.1   10077000
  87. OPTOK    OR    4,3           Turn flag on                      GUP1.1   10078000
  88.          NR    3,0                                             GUP1.1   10079000
  89.          XR    4,3           Turn off if "NO"                  GUP1.1   10080000
  90.          LA    1,4(1)        Advance ptr over option           GUP1.1   10081000
  91. OPTLQ    LTR   2,2           Any more options?                 GUP1.1   10082000
  92.          BNP   OPTZ                                            GUP1.1   10083000
  93.          CLI   2(1),C','     Make sure there is a separator    GUP1.1   10084000
  94.          BNE   OPTZ          No, give up                       GUP1.1   10085000
  95.          LA    1,1(1)                                          GUP1.1   10086000
  96.          BCT   2,OPTLP                                         GUP1.1   10087000
  97. OPTZ     STC   4,FLG         Save current flags                GUP1.1   10088000
  98.          OPEN  (MSGFIL,OUTPUT)  Message data set               GUP1.1   10089000
  99.          TM    MSGFIL+FABOFLGS-FABD,X'10'                      GUP1.1   10090000
  100.          BZ    ERREX         Oops                              GUP1.1   10091000
  101.          B     OPN                                             GUP1.1   10092000
  102. *                                                                       10093000
  103.          USING CPPL,1                                          @SC86299 10094000
  104. GUPCP    MVI   SRCNAM,C' '                                     GUP1.1   10095000
  105.          MVC   SRCNAM+1(3*LFID+2),SRCNAM  Blank out parm area  GUP1.1   10096000
  106.          MVI   FLG,0                                           GUP1.1   10097000
  107.          L     3,CPPLUPT     Fill in parse parameter list      GUP1.1   10098000
  108.          L     4,CPPLECT                                       GUP1.1   10099000
  109.          LA    5,CPECB                                         GUP1.2   10100000
  110.          L     6,=V(PRSPCL)                                    GUP1.2   10101000
  111.          LA    7,RESULT                                        GUP1.2   10102000
  112.          L     8,CPPLCBUF                                      GUP1.2   10103000
  113.          LA    9,USERBLK                                       GUP1.2   10104000
  114.          STM   3,9,PPLAREA                                     GUP1.1   10105000
  115.          DROP  1                                               GUP1.1   10106000
  116.          MVI   CPECB,0                                         GUP1.1   10107000
  117.          LINK  EP=IKJPARS,MF=(E,PPLAREA) Perform parsing serviceUP1.1   10108000
  118.          LTR   15,15         Any good?                         GUP1.1   10109000
  119.          BNZ   ERREX         No, exit with error               GUP1.1   10110000
  120. *          Interpret results                                   GUP1.1   10111000
  121.          L     8,RESULT      Address parsed data               GUP1.1   10112000
  122.          USING IKJPARMD,8                                      GUP1.1   10113000
  123.          LA    1,PRSSRC      -> Base dataset name info         GUP1.1   10114000
  124.          LA    6,SRCNAM      -> Destination field              GUP1.1   10115000
  125.          BAL   7,MOVDSN      Move dataset name                 GUP1.1   10116000
  126.          LA    1,PRSCTL      Do update DSN                     GUP1.1   10117000
  127.          LA    6,CTLNAM                                        GUP1.1   10118000
  128.          BAL   7,MOVDSN                                        GUP1.1   10119000
  129.          LA    1,PRSOUT      Do output DSN                     GUP1.1   10120000
  130.          LA    6,OUTNAM                                        GUP1.1   10121000
  131.          BAL   7,MOVDSN                                        GUP1.1   10122000
  132.          CLI   PRSSEQ8+1,1   SEQ8 option set?                  GUP1.1   10123000
  133.          BNE   *+8           No                                GUP1.1   10124000
  134.          OI    FLG,XX8       Yes, enable flag                  GUP1.1   10125000
  135.          CLI   PRSSTOR+1,1   STOR option set?                  GUP1.1   10126000
  136.          BNE   *+8           No                                GUP1.1   10127000
  137.          OI    FLG,XXCOR     Yes, enable flag                  GUP1.1   10128000
  138.          LA    1,PRSMRKV                                       GUP1.1   10129000
  139.          LA    6,MRKD                                          GUP1.1   10130000
  140.          BAL   7,MOVMEM      Move mark, if any                 GUP1.1   10131000
  141.          B     OPN           Done                              GUP1.1   10132000
  142. *                                                                       10133000
  143. MOVDSN   L     2,0(1)        --> dataset name                  GUP1.1   10134000
  144.          LH    3,4(1)        Length                            GUP1.1   10135000
  145.          BCTR  3,0                                             GUP1.1   10136000
  146.          EX    3,CPYTXT      Move dataset name                 GUP1.1   10137000
  147.          LA    6,44(6)       Point to member storage           GUP1.1   10138000
  148.          LA    1,8(1)                                          GUP1.1   10139000
  149. MOVMEM   L     2,0(1)        Member name                       GUP1.1   10140000
  150.          LTR   2,2           Test for member                   GUP1.1   10141000
  151.          BZR   7             None                              GUP1.1   10142000
  152.          LH    3,4(1)        Length                            GUP1.1   10143000
  153.          BCTR  3,0                                             GUP1.1   10144000
  154.          EX    3,CPYTXT      Move member name                  GUP1.1   10145000
  155.          BR    7                                               GUP1.1   10146000
  156. CPYTXT   MVC   0(,6),0(2)                                      GUP1.1   10147000
  157.          DROP  8                                               GUP1.1   10148000
  158. *                                                                       10149000
  159. WTEXT    STM   14,1,ICPRGS   Save registers                    GUP1.1   10150000
  160.          TM    FLG,XXBAT     Batch version?                    GUP1.1   10151000
  161.          BZ    WTXCP         No, just do a TPUT                GUP1.1   10152000
  162.          STH   0,MSGFIL+FABLRECL-FABD Save LRECL               GUP1.1   10153000
  163.          LR    0,1                                             GUP1.1   10154000
  164.          PUT   MSGFIL,(0)    And write it out                  GUP1.1   10155000
  165.          B     WTXRET                                          GUP1.1   10156000
  166. WTXCP    SVC   93                                              GUP1.1   10157000
  167. WTXRET   LM    14,1,ICPRGS   Restore and return                GUP1.1   10158000
  168.          BR    15                                              GUP1.1   10159000
  169. *                                                                       10160000
  170. MSGFIL   DCB   DDNAME=SYSPRINT,MACRF=PM,RECFM=U,BLKSIZE=130,DSORG=PS    10161000
  171. *                                                                       10162000
  172. BATDDNS  DC    CL(LFID)'+SYSUT1'                               GUP1.2   10163000
  173.          DC    CL(LFID)'+SYSIN'                                GUP1.2   10164000
  174.          DC    CL(LFID)'+SYSUT2'                               GUP1.2   10165000
  175.          DC    C'   '        Leave sequence field blank        GUP1.1   10166000
  176. *                                                                       10167000
  177. PRSPCL   IKJPARM ,                                             GUP1.1   10168000
  178. PRSSRC   IKJPOSIT DSNAME,USID,PROMPT='SOURCE DSNAME'           GUP1.1   10169000
  179. PRSCTL   IKJPOSIT DSNAME,USID,PROMPT='UPDATE DSNAME'           GUP1.1   10170000
  180. PRSOUT   IKJPOSIT DSNAME,USID,PROMPT='OUTPUT DSNAME'           GUP1.1   10171000
  181. PRSSEQ8  IKJKEYWD DEFAULT='SEQ8'                               GUP1.1   10172000
  182.          IKJNAME 'SEQ8'                                        GUP1.1   10173000
  183.          IKJNAME 'NOSEQ8'                                      GUP1.1   10174000
  184. PRSSTOR  IKJKEYWD DEFAULT='STOR'                               GUP1.1   10175000
  185.          IKJNAME 'STOR'                                        GUP1.1   10176000
  186.          IKJNAME 'NOSTOR'                                      GUP1.1   10177000
  187. PRSMARK  IKJKEYWD ,                                            GUP1.1   10178000
  188.          IKJNAME 'MARK',SUBFLD=PRS2MRK                         GUP1.1   10179000
  189. PRS2MRK  IKJSUBF ,                                             GUP1.1   10180000
  190. PRSMRKV  IKJIDENT 'SEQUENCE MARK',FIRST=ANY,OTHER=ANY,MAXLNTH=3 UP1.1   10181000
  191.          IKJENDP ,                                             GUP1.1   10182000
  192. GUPI     CSECT                                                          10183000
  193. *                                                                   TSO 10184000
  194. OPNERR   LA    1,L'OPNEM                                            TSO 10185000
  195.          BAL   0,FILERR                                             TSO 10186000
  196. OPNEM    DC    C'FILE NOT FOUND: '                                  TSO 10187000
  197. DSKERR   LA    2,8(1)                                               TSO 10188000
  198.          LA    1,L'DSKEM                                            TSO 10189000
  199.          BAL   0,FILERR                                             TSO 10190000
  200. DSKEM    DC    C'DISK ERROR ON FILE '                               TSO 10191000
  201. *                                                                   TSO 10192000
  202. FILERR   LA    4,FNAME       Buffer to use                          TSO 10193000
  203.          LR    5,1                                                  TSO 10194000
  204.          MVCL  4,0           Copy message                           TSO 10195000
  205.          LA    3,LFID        Length of a name field                 TSO 10196000
  206.          LR    5,3                                                  TSO 10197000
  207.          MVCL  4,2           Copy name                              TSO 10198000
  208.          LA    1,FNAME       Start of buffer again                  TSO 10199000
  209.          SR    4,1                                                  TSO 10200000
  210.          WTEXT (1),(4)                                              TSO 10201000
  211.          B     ERREX                                                TSO 10202000
  212. *COPY                                                 GUPSUB            10203000
  213.          TITLE 'DISKIO Routine - performs disk I/O functions'           10204000
  214. * Function selected on entry by R0:                                     10205000
  215. * 1=> open (in): R1->pattern FDB, R2->name.  Returns R0->FAB, R1->FDB   10206000
  216. * 2=> open (out): (same, but no complete FDB if new file)               10207000
  217. * 4=> close file: R1->adr(FAB).                                         10208000
  218. * 9=> read: R1->FAB.  Returns R15=12 if EOF, 0 if ok; R0=# data         10209000
  219. * 10=> write: R1->FAB.  Returns R15=13 if disk full, 0 if ok.           10210000
  220. DISKIO   ENTER                                                          10211000
  221.          USING FABD,3                                          @SC86295 10212000
  222.          SR    4,4           Signal no block assigned          @SC86295 10213000
  223.          LA    6,FDBTRKAL-FDBD(1) Use pattern TRKAL            @SC88026 10214000
  224.          ST    6,DYNPL+20    Set up calling sequence           GUP1.1   10215000
  225.          BCT   0,DSKOPNO                                       @SC86295 10216000
  226. *                                                                       10217000
  227. * Open for input file whose name is at (R2), FDB at (R1)                10218000
  228.          MVI   DYNDSP,X'88'  SHR,KEEP                          @SC86299 10219000
  229.          BAL   9,DSKALC      Get FAB                           @SC86295 10220000
  230.          BAL   2,DSKLKP      Get DSCB                          @SC86299 10221000
  231.          BNZ   DSKER1        Not found                         @SC86295 10222000
  232.          BAL   14,DSKVALS                                      @SC86295 10223000
  233.          BAL   9,DSKFABS     Set up FAB from FDB               @SC86299 10224000
  234.          CNOP  0,4                                             @SC86299 10225000
  235.          BAL   2,DSKOPT      Open and test                     @SC86299 10226000
  236.          OPEN  (0,INPUT),MF=L                                  @SC86299 10227000
  237. *                                                                       10228000
  238. * Open for output file whose name is at (R2), FDB at (R1)               10229000
  239. DSKOPNO  BCT   0,DSKTEST                                       @SC86295 10230000
  240.          MVI   DYNDSP,X'42'  NEW,CATLG                         @SC86299 10231000
  241.          BAL   9,DSKALC      Get FAB                           @SC86295 10232000
  242.          BAL   2,DSKLKP      Get DSCB                          @SC86299 10233000
  243.          BNZ   DSKOPN        Not found, just writing new       @SC86299 10234000
  244.          MVI   DYNDSP,X'18'  OLD,KEEP                          @SC86299 10235000
  245.          TM    DS1DSO,2      PDS?                              GUP1.1   10236000
  246.          BZ    DSKOPN        No, we just write over it         GUP1.1   10237000
  247.          BAL   14,DSKVALS    Yes, copy DCB info                GUP1.1   10238000
  248.          BAL   9,DSKFABS                                       GUP1.1   10239000
  249. DSKOPN   CNOP  0,4                                             @SC86299 10240000
  250.          BAL   2,DSKOPT      Open and test                     @SC86299 10241000
  251.          OPEN  (0,OUTPUT),MF=L                                 @SC86299 10242000
  252. DSKOPT   CLI   FABDSN,C'+'   Just DDNAME?                      GUP1.1   10243000
  253.          BE    DSKOPDZ       Yes, don't need to allocate       GUP1.1   10244000
  254.          KCALL DYNALC,DYNPL,EXT                                @SC86299 10245000
  255. DSKOPDZ  DS    0H                                              GUP1.1   10246000
  256.          OPEN  ((3)),MF=(E,(2))                                @SC86299 10247000
  257.          TM    FABOFLGS,X'10'                                  @SC86299 10248000
  258.          BZ    DSKER1        Didn't work                       @SC86299 10249000
  259.          B     RTRN0                                           @SC86295 10250000
  260. *                                                                       10251000
  261. DSKTEST  BCT   0,DSKCLOS                                       @SC86295 10252000
  262.          B     RTRN1                                           @SC86299 10253000
  263. *                                                                       10254000
  264. * Close file whose ticket is at (R1), release block                     10255000
  265. DSKCLOS  BCT   0,DSKRED                                        @SC86295 10256000
  266.          ICM   3,15,0(1)     Get FAB ptr, if any               @SC86295 10257000
  267.          BZ    RTRN0         None, ignore                      @SC86295 10258000
  268.          XC    0(4,1),0(1)   Yes, now clear ticket             @SC86295 10259000
  269.          CLOSE ((3))                                           @SC86299 10260000
  270.       FREEPOOL (3)                                             @SC86299 10261000
  271.          LA    0,FABDWDS                                       @SC86295 10262000
  272.          LR    1,3                                             @SC86299 10263000
  273.        DMSFRET DWORDS=(0),LOC=(1)                              @SC86295 10264000
  274.          B     RTRN0                                           @SC86295 10265000
  275. *                                                                       10266000
  276. * Read from file whose ticket is at (R1)                                10267000
  277. DSKRED   SH    0,=H'4'                                                  10268000
  278.          BCT   0,DSKWRT                                        @SC86295 10269000
  279.          LTR   3,1           Get FAB ptr                       @SC86299 10270000
  280.          BNP   RTRN1         Not defined anymore               @SC86299 10271000
  281.          L     15,FABGET     I/O routine                       @SC86299 10272000
  282.          BALR  14,15         Go to it                          @SC86299 10273000
  283.          LM    4,5,FDBBUFF   Get buffer and size               @SC86299 10274000
  284.          LH    7,FABLRECL    Actual length                     @SC86299 10275000
  285.          AR    7,1           End of record                     @SC86299 10276000
  286.          BAL   2,DSKTV                                         @SC86299 10277000
  287.           LA   1,4(1)        Skip over SDW if V                @SC86299 10278000
  288.          SR    7,1           Revised length                    @SC86299 10279000
  289.          LR    6,1                                             @SC86299 10280000
  290.          CR    7,5                                             @SC86299 10281000
  291.          BNL   *+6                                             @SC86299 10282000
  292.          LR    5,7           Buffer not filled                 @SC86299 10283000
  293.          L     1,4(13)                                         @SC86299 10284000
  294.          ST    5,20(1)       Return length in R0               @SC86299 10285000
  295.          MVCL  4,6           Copy to buffer                    @SC86299 10286000
  296.          B     RTRN0                                           @SC86299 10287000
  297. * End of file on input. Don't close it yet.                    @SC86295 10288000
  298. DSKEOD   LA    15,12         End return code                   @SC86295 10289000
  299.          B     RTRN                                            @SC86295 10290000
  300. *                                                                       10291000
  301. * Write to file whose ticket is at (R1)                                 10292000
  302. DSKWRT   DS    0H                                                       10293000
  303.          LTR   3,1           Get FAB ptr                       @SC86299 10294000
  304.          BNP   RTRN1         Not defined anymore               @SC86299 10295000
  305.          LM    4,5,FDBBUFF   Get buffer and size               @SC86299 10296000
  306.          LR    6,5           Copy for LRECL                    @SC86299 10297000
  307.          CH    6,FDBLRC                                        @SC86299 10298000
  308.          BNH   *+8                                             @SC86299 10299000
  309.          LH    6,FDBLRC      Don't allow more than LRECL if V  @SC86299 10300000
  310.          BAL   2,DSKTV                                         @SC86299 10301000
  311.           LA   6,4(5)        + 4 if RECFM=V                    @SC86299 10302000
  312.          STH   6,FABLRECL    Set up for output                 @SC86299 10303000
  313.          L     15,FABGET     I/O routine                       @SC86299 10304000
  314.          BALR  14,15         Do it                             @SC86299 10305000
  315.          XC    0(4,1),0(1)                                     @SC86299 10306000
  316.          STCM  6,3,0(1)      In case V                         @SC86299 10307000
  317.          BAL   2,DSKTV                                         @SC86299 10308000
  318.           LA   1,4(1)        V: space over SDW                 @SC86299 10309000
  319.          LR    6,1                                             @SC86299 10310000
  320.          LR    7,5                                             @SC86299 10311000
  321.          MVCL  6,4           Copy to output record             @SC86299 10312000
  322.          B     RTRN0                                           @SC86295 10313000
  323. *                                                                       10314000
  324. DSKTV    TM    FABRECFM,FABRECU                                @SC86299 10315000
  325.          BNM   4(2)          U                                 @SC86299 10316000
  326.          TM    FABRECFM,FABRECF                                @SC86299 10317000
  327.          BO    4(2)          F                                 @SC86299 10318000
  328.          BR    2             V                                 @SC86299 10319000
  329. * Return on error, release useless block, if any                        10320000
  330. DSKER1   LTR   1,4           Any block assigned?               @SC86295 10321000
  331.          BZ    RTRN1         No                                @SC86295 10322000
  332.          LA    0,FABDWDS     Yes, release it                   @SC86295 10323000
  333.        DMSFRET DWORDS=(0),LOC=(1)                              @SC86295 10324000
  334.          B     RTRN1         Flag error                        @SC86295 10325000
  335. *                                                                       10326000
  336. DSKALC   LR    5,1           Save FDB ptr                      @SC86295 10327000
  337.          LA    6,1           Update counter                    @SC86299 10328000
  338.          A     6,EVCTR                                         @SC86299 10329000
  339.          ST    6,EVCTR                                         @SC86299 10330000
  340.          LA    0,FABDWDS                                       @SC86295 10331000
  341.        DMSFREE DWORDS=(0),ERR=DSKER1                           @SC86295 10332000
  342.          LR    3,1           New block ptr                     @SC86295 10333000
  343.          LR    4,1                                             @SC86295 10334000
  344.          L     1,4(13)                                         @SC86295 10335000
  345.          ST    3,20(1)       Return R0                         @SC86295 10336000
  346.          XC    0(8*FABDWDS,3),0(3)                             @SC86295 10337000
  347.          MVC   FDBD(FDBCOP),0(5) Copy user's FDB               @SC86295 10338000
  348.          MVC   FABDSN,0(2)                                     @SC86299 10339000
  349.          LR    15,2          Set up DSN ptr                    @SC86299 10340000
  350.          LA    0,FABDDNAM    Get DDN ptr                       @SC86299 10341000
  351.          LA    1,FDBUNT      Get UNIT ptr                      @SC86299 10342000
  352.          LA    2,FDBVOL      Get VOL ptr                       @SC86299 10343000
  353.          STM   15,2,DYNPL    Set up DYNALC                     @SC86299 10344000
  354.          MVI   FABBUFCB+3,1  Fill out DCB                      @SC86299 10345000
  355.          MVI   FABDSORG,X'40' =PS                              @SC86299 10346000
  356.          MVI   FABIOBAD+3,1                                    @SC86299 10347000
  357.          LA    0,DSKEOD                                        @SC86299 10348000
  358.          LA    1,DSKOPEX                                       @SC86299 10349000
  359.          STM   0,1,FABEODAD                                    @SC86299 10350000
  360.          UNPK  FABDDNAM,EVCTR(5)                               @SC86299 10351000
  361.          TR    FABDDNAM,TRHEX  Get unique DDNAME               @SC86299 10352000
  362.          MVI   FABDDNAM,C'K'                                   @SC86299 10353000
  363.          MVI   FABDDNAM+7,C'Z'                                 @SC86299 10354000
  364.          MVC   FABOFLGS(4),=X'02,00,48,48'                     @SC86299 10355000
  365.          MVI   FABCHECK+3,1                                    @SC86299 10356000
  366.          LA    1,RTRN1                                         @SC86299 10357000
  367.          ST    1,FABSYNAD    In case of error                  @SC86299 10358000
  368.          MVI   FABIOBA+3,1                                     @SC86299 10359000
  369.          MVI   FABEOBAD+3,1                                    GUP1.1   10360000
  370.          MVI   FABRECAD+3,1                                    GUP1.1   10361000
  371.          MVI   FABCNTRL+3,1                                    GUP1.1   10362000
  372.          MVI   FABEOB+3,1                                      @SC86299 10363000
  373. DSKFABS  LH    1,FDBLRC      Copy Info to DCB                  @SC86299 10364000
  374.          CLI   FABDSN,C'+'   Just DDNAME?                      GUP1.1   10365000
  375.          BE    DSKDDA        Yes, copy it to FAB               GUP1.1   10366000
  376.          STH   1,FABLRECL                                      @SC86299 10367000
  377.          MVC   FABBLKSI,FDBBLKSI                               @SC86299 10368000
  378.          MVI   FABRECFM,FABRECU                                @SC86299 10369000
  379.          CLI   FDBRCF,C'U'                                     @SC86299 10370000
  380.          BER   9                                               @SC86299 10371000
  381.          MVI   FABRECFM,FABRECF+FABRECBR                       @SC86299 10372000
  382.          CLI   FDBRCF,C'F'                                     @SC86299 10373000
  383.          BER   9                                               @SC86299 10374000
  384.          MVI   FABRECFM,FABRECV+FABRECBR                       @SC86299 10375000
  385.          LA    1,4(1)        Allow for RDW                     @SC86299 10376000
  386.          STH   1,FABLRECL                                      @SC86299 10377000
  387.          BR    9                                               @SC86299 10378000
  388. DSKDDA   MVC   FABDDNAM,FABDSN+1 Copy to DDNAME                GUP1.1   10379000
  389.          BR    9                                               GUP1.1   10380000
  390. *                                                                       10381000
  391. * Call with R15->name, return to R2 with CC set (Z if ok)               10382000
  392. DSKLKP   SR    0,0                                             @SC86299 10383000
  393.          CLI   0(15),C'+'    Just DDNAME?                      GUP1.1   10384000
  394.          BER   2             Yes, say we found it              GUP1.1   10385000
  395.          LA    1,CAMVOLS                                       @SC86299 10386000
  396.          LA    14,X'44'      Name code                         @SC86299 10387000
  397.          SLL   14,24                                           @SC86299 10388000
  398.          STM   14,1,CAMLOC   Save dsn ptr, etc                 @SC86299 10389000
  399.          LA    0,CAMVOLS+6                                     @SC86299 10390000
  400.          LA    1,CAMDSCB                                       @SC86299 10391000
  401.          LA    14,X'C1'      Search code                       @SC86299 10392000
  402.          SLL   14,24                                           @SC86299 10393000
  403.          STM   14,1,CAMOBT                                     @SC86299 10394000
  404.         LOCATE CAMLOC                                          @SC86299 10395000
  405.          LTR   6,15          Retain 1st code in R6             @SC86299 10396000
  406.          BNZR  2             Give up                           @SC86299 10397000
  407.         OBTAIN CAMOBT        Get DSCB                          @SC86299 10398000
  408.          LTR   15,15         Test return code                  @SC86299 10399000
  409.          BR    2                                               @SC86295 10400000
  410. *                                                                       10401000
  411. DSKVALS  LA    0,FDBD        Ptr to FDB                        @SC86295 10402000
  412.          L     1,4(13)                                         @SC86295 10403000
  413.          ST    0,24(1)       Return ptr to caller              @SC86295 10404000
  414.          CLI   FABDSN,C'+'   Just DDNAME?                      GUP1.1   10405000
  415.          BER   14            Yes, done: no DSCB                GUP1.1   10406000
  416.          MVC   FDBBLKSI,DS1BLK                                 @SC86299 10407000
  417.          MVC   FDBVOL,DS1VOL Copy volume name                  @SC86299 10408000
  418.          LH    1,DS1BLK      Use BLKSIZE if 'U'                @SC86299 10409000
  419.          MVI   FDBRCF,C'U'                                     @SC86299 10410000
  420.          TM    DS1RCF,FABRECU                                  @SC86299 10411000
  421.          BO    DSKVLR                                          @SC86299 10412000
  422.          LH    1,DS1LRC      Use LRECL if 'F'                  @SC86299 10413000
  423.          MVI   FDBRCF,C'F'                                     @SC86299 10414000
  424.          TM    DS1RCF,FABRECF                                  @SC86299 10415000
  425.          BO    DSKVLR                                          @SC86299 10416000
  426.          MVI   FDBRCF,C'V'                                     @SC86299 10417000
  427.          S     1,F4          Use LRECL-4 if 'V'                @SC86299 10418000
  428. DSKVLR   STH   1,FDBLRC                                        @SC86299 10419000
  429.          BR    14                                              @SC86299 10420000
  430. *                                                                       10421000
  431. DSKOPEX  DC    0F'0',X'85',AL3(DSKOPC) OPEN EXIT               @SC86299 10422000
  432. *                                                                       10423000
  433. DSKOPC   LR    3,1                                             @SC86299 10424000
  434.          LH    5,FABBLKSI                                      @SC86299 10425000
  435.          LTR   5,5                                             @SC86299 10426000
  436.          BP    *+8                                             @SC86299 10427000
  437.          LH    5,=H'6233'                                      @SC86299 10428000
  438.          LR    6,5                                             @SC86299 10429000
  439.          TM    FABRECFM,FABRECU                                @SC86299 10430000
  440.          BO    DSKOPS                                          @SC86299 10431000
  441.          LH    6,FABLRECL                                      @SC86299 10432000
  442.          BNZ   *+8                                             @SC86299 10433000
  443.          OI    FABRECFM,FABRECF+FABRECBR                       @SC86299 10434000
  444.          LTR   6,6                                             @SC86299 10435000
  445.          BP    DSKOPQ                                          @SC86299 10436000
  446.          LA    6,80                                            @SC86299 10437000
  447.          BAL   2,DSKTV                                         @SC88049 10438000
  448.           LA   6,4(6)        Allow LRECL=84 for VB             @SC88049 10439000
  449. DSKOPQ   TM    FABRECFM,FABRECF                                @SC86299 10440000
  450.          BZ    DSKOPV                                          @SC86299 10441000
  451.          SR    4,4                                             @SC86299 10442000
  452.          DR    4,6                                             @SC86299 10443000
  453.          LTR   5,5                                             @SC88104 10444000
  454.          BP    *+8                                             @SC88104 10445000
  455.          LA    5,1           BLKSIZE was less than LRECL!      @SC88104 10446000
  456.          MR    4,6                                             @SC86299 10447000
  457.          B     DSKOPS                                          @SC86299 10448000
  458. DSKOPV   LA    4,4(6)                                          @SC86299 10449000
  459.          CR    4,5                                             @SC86299 10450000
  460.          BNH   DSKOPS                                          @SC86299 10451000
  461.          LR    5,4                                             @SC86299 10452000
  462. DSKOPS   STH   6,FABLRECL                                      @SC86299 10453000
  463.          STH   5,FABBLKSI                                      @SC86299 10454000
  464.          BR    14                                              @SC86299 10455000
  465. *                                                                       10456000
  466.          LOCALS ,                                              @SC86295 10457000
  467.          EXIT                                                           10458000
  468.