home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / ibm370 / ik0gup.asm < prev    next >
Assembly Source File  |  2020-01-01  |  45KB  |  554 lines

  1. GUPI     TITLE 'Generic Update Program for IBM 370'                     00001000
  2. *                                                                       00002000
  3. * (c) 1987, J. F. Chandler                                              00003000
  4. *                                                                       00004000
  5. * Permission is granted to any individual or institution to copy or     00005000
  6. * use this program, except for explicitly commercial purposes.          00006000
  7. *                                                                       00007000
  8. * This program consists of two parts: generic (the present file         00008000
  9. * IK0GUP.ASM plus some macros shared with Kermit-370) and system-       00009000
  10. * specific (the file IKxGUP.ASM plus some more shared macros).  Here,   00010000
  11. * "x" represents the target system code, such as "T" for TSO.  IKxGUP   00011000
  12. * is composed of "COPY" elements (designed to be fetched from a macro   00012000
  13. * library) plus, perhaps, some specialized GUPI macros.  The simplest   00013000
  14. * method of assembling this program is to make a macro library out of   00014000
  15. * IKxGUP or to include its members in the Kermit-370 library, if any.   00015000
  16. * Like the corresponding Kermit files IKxMAC.ASM, the specific part of  00016000
  17. * GUPI is divided into members by lines beginning  "*COPY" and          00017000
  18. * containing the member name in columns 55-62.  If the Kermit-370       00018000
  19. * macros are not kept in a library, the ones needed by GUPI can be      00019000
  20. * inserted by hand before the first EJECT.                              00020000
  21. *                                                                       00021000
  22. * Kermit macros used in the generic code:                               00022000
  23. *  CLOSF, DMSFREE, DMSFRET, ENTER, EXIT, FDBD, FDBPAT, KCALL,  @SC90047 00023290
  24. *  KMAIN,                                                      @SC90047 00023580
  25. *  LOCALS, LREG, OPENF, PTEXT, READF, RET, WRITF, WTEXT        @SC88111 00024000
  26. *                                                                       00025000
  27. * 1. System-specific code is responsible for the interface between the  00026000
  28. *    program on the one hand and the user and operating system on the   00027000
  29. *    other.  The user interface consists of supplying the following     00028000
  30. *    information:                                                       00029000
  31. *        SRCNAM - file spec of the base source                          00030000
  32. *        CTLNAM - file spec of the update controls                      00031000
  33. *        OUTNAM - file spec of the output new source                    00032000
  34. *        MRKD   - 3-character sequence label to be placed in columns    00033000
  35. *                 73-75 of inserted or renumbered records in 5-column   00034000
  36. *                 updating mode.                                        00035000
  37. *        FLG    - byte of flags governing the options of in-core vs.    00036000
  38. *                 disk-to-disk updates and 5- vs. 8-column mode.        00037000
  39. *    The system-specific code must also include subroutine DISKIO and   00038000
  40. *    any other system-interface routines for error message, memory      00039000
  41. *    management, and the like.                                          00040000
  42. *                                                                       00041000
  43. * 2. Generic code carries out the update function, reading the source   00042000
  44. *    and control files and writing the updated output.  In disk-to-disk 00043000
  45. *    mode, GUPI makes a single pass (reading and writing in parallel    00044000
  46. *    with minimal buffering), and the control commands must form a      00045000
  47. *    non-overlapping monotonic sequence, but in-core update mode allows 00046000
  48. *    any number of sub-sequences to be applied cumulatively by making   00047000
  49. *    three passes: (1) read the entire source, (2) apply updates, and   00048000
  50. *    (3) write out the new source.                                      00049000
  51. *                                                                       00050000
  52. *    The update control file consists of control cards and data cards.  00051000
  53. *    All control cards begin with './' in columns 1-2 followed by       00052000
  54. *    free-form fields in columns 4-50, and all other cards are          00053000
  55. *    considered data cards.  In the following, parentheses denote       00054000
  56. *    optional items, upper-case items are verbatim, and lower-case      00055000
  57. *    items are 'variables' to be filled in.                             00056000
  58. *                                                                       00057000
  59. *    Comment:  ./ *   remarks                                           00058000
  60. *        Annotates the update file.  No other function.                 00059000
  61. *                                                                       00060000
  62. *    Sequence: ./ S   seq1 inc (mark)                                   00061000
  63. *        Resequences the entire source file.  The output starts with    00062000
  64. *        number 'seq1' and steps by 'inc'.  If a 'mark' is supplied, it 00063000
  65. *        replaces the default contents of columns 73-75.                00064000
  66. *                                                                       00065000
  67. *    Delete:   ./ D   line1 (line2)                                     00066000
  68. *        Removes source line 'line1' or lines 'line1' through 'line2'   00067000
  69. *        inclusive.  The starting and ending line numbers must exist    00068000
  70. *        in the source file.                                            00069000
  71. *                                                                       00070000
  72. *    Insert:   ./ I   line1  ($ seq1 inc)                               00071000
  73. *        Inserts the immediately following data cards after line        00072000
  74. *        'line1' (which must exist) in the source.  The inserted cards  00073000
  75. *        are resequenced from 'seq1' by 'inc' and must fit strictly     00074000
  76. *        between line 'line1' and its successor.                        00075000
  77. *                                                                       00076000
  78. *    Replace:  ./ R   line1  (line2)  ($ seq1 inc)                      00077000
  79. *        Deletes source lines as in the Delete command and then inserts 00078000
  80. *        as in the Insert command except that the new cards are added   00079000
  81. *        in place of the deleted range.                                 00080000
  82. *                                                                       00081000
  83.          SPACE 4                                               @SC88111 00081100
  84. *  Update history:                                             @SC88111 00081200
  85. * Version 1.1 - 88/8/31 - Implement system-specific epilog,    @SC88111 00081300
  86. *                         allow RECFM=V control file, use new  @SC88111 00081400
  87. *                         FDBPAT macro                         @SC88111 00081500
  88. * Version 1.2 - 88/12/16- Correct RESEQ bug, more careful seq  @SC88351 00081600
  89. *                         checking                             @SC88351 00081700
  90. * Version 1.3 - 90/02/16- Correct bug preventing replacement   @SC90047 00081800
  91. *                         of first card, remove ADCON          @SC90047 00081900
  92.          EJECT                                                          00082000
  93.          PRINT NOGEN                                                    00083000
  94.          GBLC  &STORDS                                         @SC89268 00083300
  95.          COPY  GUPSPC                                          @SC89268 00083600
  96. *          Generic preliminaries                                        00084000
  97.          FDBD                                                           00085000
  98. *                                                                       00086000
  99.          USING &STORDS,KWRKBASE                                @SC89268 00087000
  100.          USING COMMON,10                                                00088000
  101. *                                                                       00089000
  102. *                                                                       00091000
  103. GUPI     ENTER MAIN                                                     00092000
  104.          COPY  GUPNIT                                                   00093000
  105.          TITLE 'Update: process control cards'                          00094000
  106. OPN      DS    0H                                                       00095000
  107.          MVC   MRK,MRKD      Default label field                        00096000
  108.          LA    3,CTLBUF                                                 00097000
  109.          ST    3,INSBP       Set up control buffer                      00098000
  110.          MVC   VARS(LVARS),IVARS                                        00099000
  111.          OPENF I,SRCNAM,FDBP,SRC,E=OPNERR                               00100000
  112.          OPENF I,CTLNAM,FDBP,CTL,E=OPNERR                               00101000
  113.          OPENF O,OUTNAM,FDBP,OUT,E=OPNERR                               00102000
  114.          OI    FLG,XXTOP     Start at top of file                       00103000
  115.          ZAP   LSTNO,=P'0'   Clear sequence numbers                     00104000
  116.          ZAP   OUTNO,=P'0'                                              00105000
  117.          SR    6,6                                                      00106000
  118.          TM    FLG,XXCOR     In-core?                                   00107000
  119.          BZ    CTLP          No, just start reading                     00108000
  120. *                                                                       00109000
  121. *          Read entire file into core                                   00110000
  122.          BAL   9,GBLK                                                   00111000
  123.          LA    3,4(1)                                                   00112000
  124.          ST    3,INSBP       Set up control buffer                      00113000
  125.          LA    6,SPTR                                                   00114000
  126. RLP      BAL   9,GBLK        Get buffer                                 00115000
  127.          LA    3,4(1)        Start of card                              00116000
  128.          LR    4,1           Save ptr                                   00117000
  129.          READF SRC,BUFFER=(3),E=RLPZ                                    00118000
  130.          ST    4,0(6)        Add to chain                               00119000
  131.          LR    6,4                                                      00120000
  132.          B     RLP                                                      00121000
  133. RLPZ     C     15,=F'12'     Eof?                                       00122000
  134.          BNE   DSKERR        No, quit                                   00123000
  135. *                                                                       00124000
  136. *          Main loop - read a control card                              00125000
  137. CTLP     L     3,INSBP       Ptr to control buffer                      00126000
  138.          READF CTL,BUFFER=(3),E=CTLZ                                    00127000
  139.          CLC   =C'./ ',0(3)  Control card?                              00128000
  140.          BNE   ERR0          No, too bad                                00129000
  141. CTLQ     CH    0,*+10        R0 has length read                @SC88244 00130000
  142.          BNH   *+8                                             @SC88244 00130200
  143.           LA   0,50          Ignore anything after col 50      @SC88244 00130400
  144.          AR    0,3                                             @SC88244 00130600
  145.          LA    1,80(,3)      End of card buffer                @SC88244 00130800
  146.          SR    1,0           Length to blank                   @SC88244 00131000
  147.          SR    15,15                                           @SC88244 00131200
  148.          ICM   15,8,=C' '                                      @SC88244 00131400
  149.          MVCL  0,14                                            @SC88244 00131600
  150.          LA    0,2(3)                                                   00132000
  151.          ST    0,COL         Set up scan                                00133000
  152.          BAL   14,SCANN      Find command                               00134000
  153.           NOP  0                                                        00135000
  154.          MVC   CMD,0(3)                                                 00136000
  155.          CLI   1(3),C' '     Should be 1 char                           00137000
  156.          BNE   ERR1          No, bad syntax                             00138000
  157.          CLI   CMD,C'*'      Comment?                                   00139000
  158.          BE    CTLP          Yes, ignore it                             00140000
  159.          LA    1,4                                                      00141000
  160. CMDLP    IC    0,CMDTB-1(1)  Get next command                           00142000
  161.          CLM   0,1,CMD       Match?                                     00143000
  162.          BE    CMDF          Ok                                         00144000
  163.          BCT   1,CMDLP                                                  00145000
  164.          B     ERR1          Bad command                                00146000
  165. CMDTB    DC    C'SDIR'                                                  00147000
  166. CMDF     BCT   1,PROC        Go if not sequence                         00148000
  167. *          Resequence source deck                                       00149000
  168.          ZAP   INCNO,=P'10'  Default increment                          00150000
  169.          TM    FLG,XX8       5-column?                                  00151000
  170.          BZ    *+10          Yes                                        00152000
  171.          ZAP   INCNO,=P'1000' 8-column default                          00153000
  172.          MVC   NXTNO,INCNO                                              00154000
  173.          MVC   MRK,MRKD      Default label field                        00155000
  174.          BAL   14,SCANN      Get start value                            00156000
  175.           B    SEQ1          Use defaults                               00157000
  176.          MVC   NXTNO,ARGNO                                              00158000
  177.          BAL   14,SCANN      Get increment value                        00159000
  178.           B    SEQ1          Use default                                00160000
  179.          MVC   INCNO,ARGNO                                              00161000
  180.          BAL   14,SCANN      Check for label field                      00162000
  181.           NOP  0                                                        00163000
  182.          CLI   0(3),C' '                                                00164000
  183.          BE    SEQ1                                                     00165000
  184.          MVC   MRK,0(3)      Use it                                     00166000
  185. SEQ1     ZAP   ARGNO,=P'0'   At start of file?                          00167000
  186.          BAL   14,SEQCHK                                                00168000
  187. SEQL     BAL   14,NEXT       Get a card                        @SC88351 00169000
  188.          LTR   3,3           End?                                       00170000
  189.          BZ    CTLP          Yes, back to control stream                00171000
  190.          BAL   14,SNUM       Renumber it                                00172000
  191.          B     SEQL                                            @SC88351 00173000
  192. *                                                                       00175000
  193. *          Process an editing card                                      00176000
  194. PROC     BAL   14,SCANN      Get seqno 1                                00177000
  195.           B    ERR1          Missing                                    00178000
  196.          MVC   NXTNO,ARGNO   Default start                              00179000
  197.          LM    0,1,NXTNO                                                00180000
  198.          SRL   1,24          Remove garbage                             00181000
  199.          LA    2,X'10'       Default increment =P'1'                    00182000
  200.          LA    3,5           Max for checking                           00183000
  201. PROCDL   SRDL  0,4           Check next digit                           00184000
  202.          LTR   1,1           Found non-zero?                            00185000
  203.          BNZ   PROCDF        Yes, got it                                00186000
  204.          SLL   2,4           No, try * 10                               00187000
  205.          BCT   3,PROCDL                                                 00188000
  206. PROCDF   ST    2,TMPDW+4                                                00189000
  207.          OI    TMPDW+7,15    Fix sign                                   00190000
  208.          ZAP   INCNO,TMPDW+4(4)                                         00191000
  209.          BAL   14,INCNXT     Default start                     @SC88351 00192000
  210.          BAL   14,SEQCHK     Check order                                00193000
  211.          BAL   14,FIND       Get proper source card                     00194000
  212.          ST    6,SAV6        Save current card ptr                      00195000
  213.          CLI   CMD,C'I'                                                 00196000
  214.          BE    *+8           No deletion                                00197000
  215.          OI    FLG,XXKIL     Delete                                     00198000
  216.          BAL   14,SCANN      Get end of range                           00199000
  217.           B    PRC2          Just one card                              00200000
  218.          BAL   14,FIND       Find end of range                          00201000
  219.          BAL   14,SCANN      Should be followed by '$'                  00202000
  220.           B    PRC2          Ok                                         00203000
  221.          B     ERR1          Oops, extra number there                   00204000
  222. PRC2     BAL   14,NEXT       Skip over this card                        00205000
  223.          BAL   14,KILL       Delete, if necessary                       00206000
  224.          CLI   CMD,C'D'                                                 00207000
  225.          BE    CTLP          Done if delete                             00208000
  226.          BAL   14,SCANN      Insert starting number?                    00209000
  227.           B    INSRT         No, use defaults                           00210000
  228.          MVC   NXTNO,ARGNO   Yes                                        00211000
  229.          CLC   OUTNO,NXTNO   Is it ok?                                  00212000
  230.          BNL   ERR3          Out of sequence                            00213000
  231.          BAL   14,SCANN      Increment?                                 00214000
  232.           B    INSRT         No, use default                            00215000
  233.          MVC   INCNO,ARGNO                                              00216000
  234. INSRT    L     3,INSBP       Ptr to buffer                              00217000
  235. INS3     READF CTL,BUFFER=(3),E=CTLZ                                    00218000
  236.          CLC   =C'./ ',0(3)                                             00219000
  237.          BE    INS5          End of insertion                  @SC88351 00220000
  238.          AR    0,3                                             @SC88244 00220100
  239.          LA    1,72(,3)      Must fill to col 72               @SC88244 00220200
  240.          SR    1,0           Length to blank, if any           @SC88244 00220300
  241.          BNP   INS3A         No need to fill                   @SC88244 00220400
  242.          SR    15,15                                           @SC88244 00220500
  243.          ICM   15,8,=C' '                                      @SC88244 00220600
  244.          MVCL  0,14          Fill with blanks                  @SC88244 00220700
  245. INS3A    DS    0H                                              @SC88244 00220800
  246.          BAL   14,SNUM       Sequence new card                          00221000
  247.          TM    FLG,XXCOR     In-core?                                   00224000
  248.          BZ    INS4          No, write it out                           00225000
  249.          SH    3,EH4         Get chain ptr for buffer                   00226000
  250.          MVC   0(4,3),0(6)   Insert into file                           00227000
  251.          ST    3,0(6)                                                   00228000
  252.          LR    6,3           New card is before 'current' one           00229000
  253.          BAL   9,GBLK        Get buffer                                 00230000
  254. EH4      EQU   *+2           Offset to card                             00231000
  255.          LA    3,4(1)                                                   00232000
  256.          ST    3,INSBP                                                  00233000
  257.          B     INS3                                                     00234000
  258. INS4     WRITF OUT,BUFFER=(3),E=DSKERR                                  00235000
  259.          B     INS3                                                     00236000
  260. INS5     CLC   OUTNO,LSTNO   Are we in order?                  @SC88351 00236200
  261.          BNL   ERR5          No, give up                       @SC88351 00236400
  262.          B     CTLQ                                            @SC88351 00236600
  263. *                                                                       00237000
  264. *          END OF CONTROL FILE INPUT                                    00238000
  265. CTLZ     CLOSF CTL                                                      00239000
  266.          TM    FLG,XXCOR     In-core?                                   00240000
  267.          BZ    RDMP          No, copy rest of source to output          00241000
  268. *          Write out file and release storage                           00242000
  269.          LA    6,SPTR        Start of file                              00243000
  270. DMPLP    ICM   6,15,0(6)     Get next card                              00244000
  271.          BZ    DMPZ          Done                                       00245000
  272.          LA    3,4(6)                                                   00246000
  273.          WRITF OUT,BUFFER=(3),E=DSKERR                                  00247000
  274.          B     DMPLP                                                    00248000
  275. DMPZ     L     6,BPTR        Start of blocks                            00249000
  276. FRELP    LTR   1,6           Reached end of chain?                      00250000
  277.          BZ    FREZ          Yes, all released                          00251000
  278.          ICM   6,15,0(6)     Ptr to next                                00252000
  279.          LA    0,(99*84+4)/8                                            00253000
  280.          DMSFRET DWORDS=(0),LOC=(1)                                     00254000
  281.          B     FRELP                                                    00255000
  282. *                                                                       00256000
  283. RDMP     BAL   14,NEXT       Get a card                                 00257000
  284.          LTR   3,3                                                      00258000
  285.          BNZ   RDMP          Keep copying                               00259000
  286. *        B     FREZ                                                     00260000
  287. FREZ     CLOSF OUT           Close files                                00261000
  288.          CLOSF SRC                                                      00262000
  289.          SR    15,15         Ok                                         00263000
  290. QUIT     DS    0H                                              @SC88111 00264000
  291.          COPY  GUPFIN                                          @SC88111 00264200
  292.          RET   MAIN                                            @SC88111 00264400
  293.          TITLE 'Update: various subroutines'                            00265000
  294. *          Renumber a source or inserted record                         00266000
  295. SNUM     UNPK  72(8,3),NXTNO Replace sequence field                     00267000
  296.          OI    79(3),C'0'    Fix zone                                   00268000
  297.          TM    FLG,XX8       Is it 8-col?                               00269000
  298.          BO    *+10          Yes                                        00270000
  299.          MVC   72(3,3),MRK   Just 5                                     00271000
  300.          MVC   OUTNO,NXTNO   Note current number (inserted)    @SC88351 00272000
  301. INCNXT   AP    NXTNO,INCNO                                     @SC88351 00272500
  302.          OI    NXTNO+4,15    Set uniform sign code             @SC88351 00273000
  303.          BR    14                                                       00274000
  304. *                                                                       00275000
  305. *          Check sequence numbers.  if out of order, assume new batch   00276000
  306. SEQCHK   CP    LSTNO,ARGNO   Sequence ok?                               00277000
  307.          BNHR  14            Ok                                         00278000
  308.          TM    FLG,XXCOR     In-core?                                   00279000
  309.          BZ    ERR2          No, can't back up                          00280000
  310.          OI    FLG,XXTOP     Yes, start at top                          00281000
  311.          ZAP   LSTNO,=P'0'                                              00282000
  312.          ZAP   OUTNO,=P'0'                                     @SC90047 00282500
  313.          BR    14                                                       00283000
  314. *                                                                       00284000
  315. *          Remove deleted cards (if in-core)                            00285000
  316. KILL     TM    FLG,XXKIL                                                00286000
  317.          BZR   14            Not deleting                               00287000
  318.          NI    FLG,255-XXKIL Now turn it off                            00288000
  319.          TM    FLG,XXCOR     In-core?                                   00289000
  320.          BZR   14            No, cards were flushed already             00290000
  321.          L     1,SAV6        -> start of range                          00291000
  322.          L     2,0(1)        Start                                      00292000
  323.          MVC   0(4,1),0(6)   Unchain card(s)                            00293000
  324.          MVC   0(4,6),FPTR   Put on free chain                          00294000
  325.          ST    2,FPTR                                                   00295000
  326.          LR    6,1           Fix current ptr                            00296000
  327.          BR    14                                                       00297000
  328. *                                                                       00298000
  329. *          Find desired sequence number                                 00299000
  330. FIND     CLC   LSTNO,ARGNO   Match?                            @SC88351 00300000
  331.          BER   14            Ok                                         00301000
  332.          BH    ERR6          Went too far                               00302000
  333.          ST    14,FNDSV                                        @SC88111 00302500
  334.          BAL   9,NEXTA       Get next                                   00303000
  335.          L     14,FNDSV                                        @SC88111 00303500
  336.          LTR   3,3                                                      00304000
  337.          BZ    ERR6          Not found                                  00305000
  338.          B     FIND                                                     00306000
  339. *                                                                       00307000
  340. *          Get next card                                                00308000
  341. NEXT     LR    9,14          Direct return                              00309000
  342. NEXTA    TM    FLG,XXKIL+XXTOP                                          00310000
  343.          BNZ   NEXTB         Nothing for output                         00311000
  344. NEXTOK   MVC   OUTNO,LSTNO   Save output sequence                       00316000
  345. NEXTB    TM    FLG,XXCOR     In-core?                                   00317000
  346.          BZ    RNEXT         No, read it                                00318000
  347.          TM    FLG,XXTOP                                                00319000
  348.          BZ    NEXTN                                                    00320000
  349.          LA    6,SPTR        Start at top                               00321000
  350.          B     NEXTS         Rejoin with predecessor of new             00322000
  351. NEXTN    ICM   3,15,0(6)     Get ptr to current card, if any            00323000
  352.          BZR   9             At eof                                     00324000
  353.          LR    6,3           Move to next                               00325000
  354. NEXTS    ICM   3,15,0(6)     Get ptr to new card, if any                00326000
  355.          BZ    NEXTZ         At eof                            @SC88351 00327000
  356.          LA    3,4(3)        Ptr to card itself                         00328000
  357. NEXTP    NI    FLG,255-XXINS-XXTOP Started down file                    00329000
  358.          MVC   TMPDW,72(3)   Copy sequence field                        00330000
  359.          TM    FLG,XX8                                                  00331000
  360.          BO    *+10                                                     00332000
  361.          MVC   TMPDW(3),=C'000'  Only 5 digits used                     00333000
  362.          TRT   TMPDW,NUMB    Valid?                                     00334000
  363.          BNZR  9                                                        00335000
  364.          PACK  LSTNO,TMPDW   Save value                                 00336000
  365.          BR    9             Return                                     00337000
  366. *                                                                       00338000
  367. RNEXT    TM    FLG,XXEOF     Already hit end?                           00339000
  368.          BO    RNXZ          Yes, don't read again                      00340000
  369.          LA    3,SRCBUF                                                 00341000
  370.          TM    FLG,XXKIL+XXTOP                                          00342000
  371.          BNZ   RNXA          No current card, or killing anyway         00343000
  372.          WRITF OUT,BUFFER=(3),E=DSKERR                                  00344000
  373. RNXA     READF SRC,BUFFER=(3),E=RNXE                                    00345000
  374.          B     NEXTP                                                    00346000
  375. RNXE     C     15,=F'12'     Eof?                                       00347000
  376.          BNE   DSKERR        No, quit                                   00348000
  377. RNXZ     SR    3,3           Indicate eof                               00349000
  378.          OI    FLG,XXEOF     Remember it                                00350000
  379. NEXTZ    MVI   LSTNO,X'99'   Mark infinite sequence number     @SC88351 00350500
  380.          BR    9             Return                                     00351000
  381. *                                                                       00352000
  382. *          Add a block of buffers to free chain, then get one           00353000
  383. GMORE    LA    0,(99*84+4)/8 Get 99 at once                             00354000
  384.          DMSFREE DWORDS=(0),ERR=ERR4                                    00355000
  385.          MVC   0(4,1),BPTR   Add to block chain                         00356000
  386.          ST    1,BPTR                                                   00357000
  387.          LA    1,4(1)        First new buffer                           00358000
  388.          LA    0,99          Counter                                    00359000
  389. GCHN     MVC   0(4,1),FPTR   Add to chain                               00360000
  390.          ST    1,FPTR                                                   00361000
  391.          LA    1,84(1)                                                  00362000
  392.          BCT   0,GCHN                                                   00363000
  393. *          Get a free buffer (GBLK) ptr in R1                           00364000
  394. GBLK     ICM   1,15,FPTR                                                00365000
  395.          BZ    GMORE         Need to get some more                      00366000
  396.          MVC   FPTR,0(1)                                                00367000
  397.          XC    0(4,1),0(1)   Clear chain ptr                            00368000
  398.          BR    9             AND RETURN                                 00369000
  399. *                                                                       00370000
  400. *          Find next numeric field in card, skip if ok                  00371000
  401. SCANN    SR    1,1                                                      00372000
  402.          L     3,COL         Current position                           00373000
  403.          TRT   0(30,3),NBLNK Next non-blank                             00374000
  404.          BZR   14            Nothing                                    00375000
  405.          LR    3,1           Ptr to field                               00376000
  406.          TRT   0(10,3),BLNK  End of field                               00377000
  407.          BZR   14            Too long                                   00378000
  408.          ST    1,COL         New position                               00379000
  409.          CLI   0(3),C'0'     Numeric?                                   00380000
  410.          BLR   14            No, skip it                                00381000
  411.          BCTR  1,0           Last char                                  00382000
  412.          SR    1,3           Count - 1                                  00383000
  413.          EX    1,TRTN        Check valid digits                         00384000
  414.          BNZ   ERR1          Oops                                       00385000
  415.          EX    1,PCKA                                                   00386000
  416.          OI    ARGNO+4,15    Fix sign, just in case                     00387000
  417.          B     4(14)         Got it                                     00388000
  418. PCKA     PACK  ARGNO,0(,3)                                              00389000
  419. TRTN     TRT   0(,3),NUMB                                               00390000
  420.          TITLE 'Update: error messages'                                 00391000
  421. ERR0     PTEXT 'MISSING CONTROL CARD'                                   00392000
  422.          B     ERPNC                                                    00393000
  423. ERR1     PTEXT 'INVALID CONTROL CARD'                                   00394000
  424.          B     ERPRT                                                    00395000
  425. ERR2     PTEXT 'CONTROL CARD OUT OF ORDER, DISK-TO-DISK MODE'           00396000
  426.          B     ERPNC                                                    00397000
  427. ERR3     MVC   LSTNO,NXTNO   Get bad number                             00398000
  428.          B     ERR5                                                     00399000
  429. ERR4     PTEXT 'FREE STORAGE EXHAUSTED, TRY DISK-TO-DISK UPDATE'        00400000
  430. ERRMSG   WTEXT (3),(4)       Type it                                    00401000
  431.          B     ERREX                                                    00402000
  432. ERR5     UNPK  MSGS2,LSTNO   Set up message                             00403000
  433.          OI    MSGS2+7,C'0'                                             00404000
  434.          UNPK  MSGS1,OUTNO                                              00405000
  435.          OI    MSGS1+7,C'0'                                             00406000
  436.          PTEXT MSGSQ,LMSGSQ                                             00407000
  437.          B     ERPNC                                                    00408000
  438. ERR6     PTEXT 'SEQUENCE NUMBER NOT FOUND'                              00409000
  439.          B     ERPRT                                                    00410000
  440. ERPNC    XC    COL,COL       No column indicator                        00411000
  441. ERPRT    WTEXT (3),(4)                                                  00412000
  442.          L     5,INSBP                                                  00413000
  443.          WTEXT (5),80                                                   00414000
  444.          ICM   3,15,COL      Any column to mark                         00415000
  445.          BZ    ERREX         No                                         00416000
  446.          MVI   0(5),C' '     Blank out buffer                           00417000
  447.          MVC   1(79,5),0(5)                                             00418000
  448.          MVI   0(3),C'*'                                                00419000
  449.          WTEXT (5),80                                                   00420000
  450. ERREX    LA    15,20                                                    00421000
  451.          B     QUIT                                                     00422000
  452.          LOCALS                                                         00423000
  453. QUPDT    EXIT                                                           00424000
  454.          TITLE 'Update: Common code, constants, and variables'          00425000
  455. COMMON   CSECT                                                          00426000
  456. *                                                                       00427000
  457. * Utility routine to set up linkage                                     00428000
  458. SUBENT   LR    KSUBBASE,15   CSECT addressibility              @SC89268 00429000
  459.          L     15,STKPTR     Current end of stack              @SC86295 00430000
  460.          AR    0,15          Our needs                         @SC86295 00431000
  461.          C     0,STKLIM      Does it fit?                      @SC86295 00432000
  462.          BH    SUBDIE        No, (that's incredible)           @SC86295 00433000
  463.          ST    0,STKPTR      New end                           @SC86295 00434000
  464.          ST    13,4(15)      Link subroutines                  @SC86295 00435000
  465.          ST    15,8(13)                                        @SC86295 00436000
  466.          L     0,20(13)      Restore R0                        @SC86295 00437000
  467.          LR    13,15                                           @SC86295 00438000
  468.          BR    14            Go                                @SC86295 00439000
  469. SUBDIE   LM    14,12,12(13)                                    @SC86295 00440000
  470.          SR    15,15                                           @SC86295 00441000
  471.          BCTR  15,0          Set return code = -1              @SC86295 00442000
  472.          BR    14            Go                                @SC86295 00443000
  473. *                                                                       00444000
  474. RTRN2    LA    15,2          Indicate error                    @SC86295 00445000
  475.          B     RTRN                                            @SC86295 00446000
  476. RTRN0    SR    15,15         No errors                         @SC86295 00447000
  477.          B     RTRN                                            @SC86295 00448000
  478. RTRN1    LA    15,1          Indicate error                    @SC86295 00449000
  479. RTRN     ST    13,STKPTR     Free the storage                  @SC86295 00450000
  480.          L     13,4(13)      Unlink                            @SC86295 00451000
  481.          L     14,12(13)     Restore registers                 @SC86295 00452000
  482.          LM    0,12,20(13)                                     @SC86295 00453000
  483.          LTR   15,15         Test return code                  @SC86295 00454000
  484.          BR    14                                              @SC86295 00455000
  485. *                                                                       00456000
  486. *          Constants                                                    00457000
  487. NBLNK    DC    64X'1',X'0',191X'1'   Find non-blank, if any             00458000
  488. BLNK     DC    64X'0',X'1',191X'0'   Find blank, if any                 00459000
  489. NUMB     DC    240X'1',10X'0',6X'1'  Find non-digit, if any             00460000
  490. TRHEX    EQU   *-240                                                    00461000
  491.          DC    C'0123456789ABCDEF'   Convert to characters              00462000
  492. F4       DC    F'4'                                                     00463000
  493. F8       DC    F'8'                                                     00464000
  494. FDBP     DS    0F            Pattern for file FDB                       00466000
  495.          DC    A(0,80)       Buffer ptr, length                         00467000
  496.          FDBPAT ,F,80        F/80 file                         @SC88111 00469000
  497. IVARS    DS    0D                                                       00470000
  498. IMSGSQ   DC    C'SEQUENCE ERROR: '                                      00471000
  499.          DC    CL8' ',C' TO '                                           00472000
  500.          DC    CL8' '                                                   00473000
  501. *          Variables                                                    00474000
  502. &STORDS  DSECT ,                                               @SC89268 00475000
  503. STORAG   EQU   *                                               @SC89268 00475500
  504. TMPDW    DS    D             For conversions                            00476000
  505. STKLO    DS    A             Start of stack space              @SC89089 00476300
  506. STKHI    DS    A             High extent of stack usage        @SC89089 00476600
  507. STKPTR   DS    A             Save area stack                            00477000
  508. STKLIM   DS    A             ditto                                      00478000
  509. SPTR     DS    A             Ptr to start of file                       00479000
  510. FPTR     DS    A             Ptr to free list                           00480000
  511. BPTR     DS    A             Allocation block list                      00481000
  512. INSBP    DS    A             Ptr to control buffer                      00482000
  513. COL      DS    A             Current scan column ptr                    00483000
  514. SAV6     DS    A             Saved card ptr                             00484000
  515. FNDSV    DS    F             Return address for FIND           @SC88111 00484500
  516.          DS    0F                                                       00485000
  517. NXTNO    DS    PL5           Next sequence number for insert/reseq      00486000
  518. INCNO    DS    PL5           Sequencing increment                       00487000
  519. LSTNO    DS    PL5           Current sequence number                    00488000
  520. OUTNO    DS    PL5           Last card written                          00489000
  521. ARGNO    DS    PL5           Number read from control card              00490000
  522. CTL      DS    F             Ticket to control input                    00492000
  523. SRC      DS    F             Ticket to input source                     00493000
  524. OUT      DS    F             Ticket to output file                      00494000
  525. CTLBUF   DS    CL80          Buffers                                    00495000
  526. SRCBUF   DS    CL80                                                     00496000
  527. CMD      DS    C             Control command                            00497000
  528. MRK      DS    CL3           Sequence label field                       00498000
  529.          COPY  GUPVAR        System-specific variables                  00499000
  530. VARS     DS    0D                                                       00500000
  531. MSGSQ    DC    C'SEQUENCE ERROR: '                                      00501000
  532. MSGS1    DC    CL8' ',C' TO '                                           00502000
  533. MSGS2    DC    CL8' '                                                   00503000
  534. LMSGSQ   EQU   *-MSGSQ                                                  00504000
  535. LVARS    EQU   *-VARS                                                   00505000
  536. *                                                                       00506000
  537. *          User interface information                                   00507000
  538. SRCNAM   DS    CL(LFID)      Input file name                            00508000
  539. CTLNAM   DS    CL(LFID)      Control file name                          00509000
  540. OUTNAM   DS    CL(LFID)      Output file name                           00510000
  541. MRKD     DS    CL3           Default sequence label field               00511000
  542. FLG      DS    X             Flags                                      00512000
  543. XXKIL    EQU   X'80'         Deleting source records                    00513000
  544. XXTOP    EQU   X'40'         At top of file                             00514000
  545. XXINS    EQU   X'20'         Latest card is inserted                    00515000
  546. XXEOF    EQU   X'10'         Reached end of source                      00516000
  547. XX8      EQU   X'02'         8-column sequence field                    00517000
  548. XXCOR    EQU   X'01'         Perform update in-core                     00518000
  549.          DS    0D                                                       00519000
  550. STODWDS  EQU   (*-STORAG)/8  Length of storage                          00520000
  551.          COPY  GUPSUB                                                   00521000
  552. *                                                                       00522000
  553.          END   GUPI                                                     00523000
  554.