GUPI     TITLE 'Generic Update Program for IBM 370'                     00001000
*                                                                       00002000
* (c) 1987, J. F. Chandler                                              00003000
*                                                                       00004000
* Permission is granted to any individual or institution to copy or     00005000
* use this program, except for explicitly commercial purposes.          00006000
*                                                                       00007000
* This program consists of two parts: generic (the present file         00008000
* IK0GUP.ASM plus some macros shared with Kermit-370) and system-       00009000
* specific (the file IKxGUP.ASM plus some more shared macros).  Here,   00010000
* "x" represents the target system code, such as "T" for TSO.  IKxGUP   00011000
* is composed of "COPY" elements (designed to be fetched from a macro   00012000
* library) plus, perhaps, some specialized GUPI macros.  The simplest   00013000
* method of assembling this program is to make a macro library out of   00014000
* IKxGUP or to include its members in the Kermit-370 library, if any.   00015000
* Like the corresponding Kermit files IKxMAC.ASM, the specific part of  00016000
* GUPI is divided into members by lines beginning  "*COPY" and          00017000
* containing the member name in columns 55-62.  If the Kermit-370       00018000
* macros are not kept in a library, the ones needed by GUPI can be      00019000
* inserted by hand before the first EJECT.                              00020000
*                                                                       00021000
* Kermit macros used in the generic code:                               00022000
*  CLOSF, DMSFREE, DMSFRET, ENTER, EXIT, FDBD, FDBPAT, KCALL,  @SC90047 00023290
*  KMAIN,                                                      @SC90047 00023580
*  LOCALS, LREG, OPENF, PTEXT, READF, RET, WRITF, WTEXT        @SC88111 00024000
*                                                                       00025000
* 1. System-specific code is responsible for the interface between the  00026000
*    program on the one hand and the user and operating system on the   00027000
*    other.  The user interface consists of supplying the following     00028000
*    information:                                                       00029000
*        SRCNAM - file spec of the base source                          00030000
*        CTLNAM - file spec of the update controls                      00031000
*        OUTNAM - file spec of the output new source                    00032000
*        MRKD   - 3-character sequence label to be placed in columns    00033000
*                 73-75 of inserted or renumbered records in 5-column   00034000
*                 updating mode.                                        00035000
*        FLG    - byte of flags governing the options of in-core vs.    00036000
*                 disk-to-disk updates and 5- vs. 8-column mode.        00037000
*    The system-specific code must also include subroutine DISKIO and   00038000
*    any other system-interface routines for error message, memory      00039000
*    management, and the like.                                          00040000
*                                                                       00041000
* 2. Generic code carries out the update function, reading the source   00042000
*    and control files and writing the updated output.  In disk-to-disk 00043000
*    mode, GUPI makes a single pass (reading and writing in parallel    00044000
*    with minimal buffering), and the control commands must form a      00045000
*    non-overlapping monotonic sequence, but in-core update mode allows 00046000
*    any number of sub-sequences to be applied cumulatively by making   00047000
*    three passes: (1) read the entire source, (2) apply updates, and   00048000
*    (3) write out the new source.                                      00049000
*                                                                       00050000
*    The update control file consists of control cards and data cards.  00051000
*    All control cards begin with './' in columns 1-2 followed by       00052000
*    free-form fields in columns 4-50, and all other cards are          00053000
*    considered data cards.  In the following, parentheses denote       00054000
*    optional items, upper-case items are verbatim, and lower-case      00055000
*    items are 'variables' to be filled in.                             00056000
*                                                                       00057000
*    Comment:  ./ *   remarks                                           00058000
*        Annotates the update file.  No other function.                 00059000
*                                                                       00060000
*    Sequence: ./ S   seq1 inc (mark)                                   00061000
*        Resequences the entire source file.  The output starts with    00062000
*        number 'seq1' and steps by 'inc'.  If a 'mark' is supplied, it 00063000
*        replaces the default contents of columns 73-75.                00064000
*                                                                       00065000
*    Delete:   ./ D   line1 (line2)                                     00066000
*        Removes source line 'line1' or lines 'line1' through 'line2'   00067000
*        inclusive.  The starting and ending line numbers must exist    00068000
*        in the source file.                                            00069000
*                                                                       00070000
*    Insert:   ./ I   line1  ($ seq1 inc)                               00071000
*        Inserts the immediately following data cards after line        00072000
*        'line1' (which must exist) in the source.  The inserted cards  00073000
*        are resequenced from 'seq1' by 'inc' and must fit strictly     00074000
*        between line 'line1' and its successor.                        00075000
*                                                                       00076000
*    Replace:  ./ R   line1  (line2)  ($ seq1 inc)                      00077000
*        Deletes source lines as in the Delete command and then inserts 00078000
*        as in the Insert command except that the new cards are added   00079000
*        in place of the deleted range.                                 00080000
*                                                                       00081000
         SPACE 4                                               @SC88111 00081100
*  Update history:                                             @SC88111 00081200
* Version 1.1 - 88/8/31 - Implement system-specific epilog,    @SC88111 00081300
*                         allow RECFM=V control file, use new  @SC88111 00081400
*                         FDBPAT macro                         @SC88111 00081500
* Version 1.2 - 88/12/16- Correct RESEQ bug, more careful seq  @SC88351 00081600
*                         checking                             @SC88351 00081700
* Version 1.3 - 90/02/16- Correct bug preventing replacement   @SC90047 00081800
*                         of first card, remove ADCON          @SC90047 00081900
         EJECT                                                          00082000
         PRINT NOGEN                                                    00083000
         GBLC  &STORDS                                         @SC89268 00083300
         COPY  GUPSPC                                          @SC89268 00083600
*          Generic preliminaries                                        00084000
         FDBD                                                           00085000
*                                                                       00086000
         USING &STORDS,KWRKBASE                                @SC89268 00087000
         USING COMMON,10                                                00088000
*                                                                       00089000
*                                                                       00091000
GUPI     ENTER MAIN                                                     00092000
         COPY  GUPNIT                                                   00093000
         TITLE 'Update: process control cards'                          00094000
OPN      DS    0H                                                       00095000
         MVC   MRK,MRKD      Default label field                        00096000
         LA    3,CTLBUF                                                 00097000
         ST    3,INSBP       Set up control buffer                      00098000
         MVC   VARS(LVARS),IVARS                                        00099000
         OPENF I,SRCNAM,FDBP,SRC,E=OPNERR                               00100000
         OPENF I,CTLNAM,FDBP,CTL,E=OPNERR                               00101000
         OPENF O,OUTNAM,FDBP,OUT,E=OPNERR                               00102000
         OI    FLG,XXTOP     Start at top of file                       00103000
         ZAP   LSTNO,=P'0'   Clear sequence numbers                     00104000
         ZAP   OUTNO,=P'0'                                              00105000
         SR    6,6                                                      00106000
         TM    FLG,XXCOR     In-core?                                   00107000
         BZ    CTLP          No, just start reading                     00108000
*                                                                       00109000
*          Read entire file into core                                   00110000
         BAL   9,GBLK                                                   00111000
         LA    3,4(1)                                                   00112000
         ST    3,INSBP       Set up control buffer                      00113000
         LA    6,SPTR                                                   00114000
RLP      BAL   9,GBLK        Get buffer                                 00115000
         LA    3,4(1)        Start of card                              00116000
         LR    4,1           Save ptr                                   00117000
         READF SRC,BUFFER=(3),E=RLPZ                                    00118000
         ST    4,0(6)        Add to chain                               00119000
         LR    6,4                                                      00120000
         B     RLP                                                      00121000
RLPZ     C     15,=F'12'     Eof?                                       00122000
         BNE   DSKERR        No, quit                                   00123000
*                                                                       00124000
*          Main loop - read a control card                              00125000
CTLP     L     3,INSBP       Ptr to control buffer                      00126000
         READF CTL,BUFFER=(3),E=CTLZ                                    00127000
         CLC   =C'./ ',0(3)  Control card?                              00128000
         BNE   ERR0          No, too bad                                00129000
CTLQ     CH    0,*+10        R0 has length read                @SC88244 00130000
         BNH   *+8                                             @SC88244 00130200
          LA   0,50          Ignore anything after col 50      @SC88244 00130400
         AR    0,3                                             @SC88244 00130600
         LA    1,80(,3)      End of card buffer                @SC88244 00130800
         SR    1,0           Length to blank                   @SC88244 00131000
         SR    15,15                                           @SC88244 00131200
         ICM   15,8,=C' '                                      @SC88244 00131400
         MVCL  0,14                                            @SC88244 00131600
         LA    0,2(3)                                                   00132000
         ST    0,COL         Set up scan                                00133000
         BAL   14,SCANN      Find command                               00134000
          NOP  0                                                        00135000
         MVC   CMD,0(3)                                                 00136000
         CLI   1(3),C' '     Should be 1 char                           00137000
         BNE   ERR1          No, bad syntax                             00138000
         CLI   CMD,C'*'      Comment?                                   00139000
         BE    CTLP          Yes, ignore it                             00140000
         LA    1,4                                                      00141000
CMDLP    IC    0,CMDTB-1(1)  Get next command                           00142000
         CLM   0,1,CMD       Match?                                     00143000
         BE    CMDF          Ok                                         00144000
         BCT   1,CMDLP                                                  00145000
         B     ERR1          Bad command                                00146000
CMDTB    DC    C'SDIR'                                                  00147000
CMDF     BCT   1,PROC        Go if not sequence                         00148000
*          Resequence source deck                                       00149000
         ZAP   INCNO,=P'10'  Default increment                          00150000
         TM    FLG,XX8       5-column?                                  00151000
         BZ    *+10          Yes                                        00152000
         ZAP   INCNO,=P'1000' 8-column default                          00153000
         MVC   NXTNO,INCNO                                              00154000
         MVC   MRK,MRKD      Default label field                        00155000
         BAL   14,SCANN      Get start value                            00156000
          B    SEQ1          Use defaults                               00157000
         MVC   NXTNO,ARGNO                                              00158000
         BAL   14,SCANN      Get increment value                        00159000
          B    SEQ1          Use default                                00160000
         MVC   INCNO,ARGNO                                              00161000
         BAL   14,SCANN      Check for label field                      00162000
          NOP  0                                                        00163000
         CLI   0(3),C' '                                                00164000
         BE    SEQ1                                                     00165000
         MVC   MRK,0(3)      Use it                                     00166000
SEQ1     ZAP   ARGNO,=P'0'   At start of file?                          00167000
         BAL   14,SEQCHK                                                00168000
SEQL     BAL   14,NEXT       Get a card                        @SC88351 00169000
         LTR   3,3           End?                                       00170000
         BZ    CTLP          Yes, back to control stream                00171000
         BAL   14,SNUM       Renumber it                                00172000
         B     SEQL                                            @SC88351 00173000
*                                                                       00175000
*          Process an editing card                                      00176000
PROC     BAL   14,SCANN      Get seqno 1                                00177000
          B    ERR1          Missing                                    00178000
         MVC   NXTNO,ARGNO   Default start                              00179000
         LM    0,1,NXTNO                                                00180000
         SRL   1,24          Remove garbage                             00181000
         LA    2,X'10'       Default increment =P'1'                    00182000
         LA    3,5           Max for checking                           00183000
PROCDL   SRDL  0,4           Check next digit                           00184000
         LTR   1,1           Found non-zero?                            00185000
         BNZ   PROCDF        Yes, got it                                00186000
         SLL   2,4           No, try * 10                               00187000
         BCT   3,PROCDL                                                 00188000
PROCDF   ST    2,TMPDW+4                                                00189000
         OI    TMPDW+7,15    Fix sign                                   00190000
         ZAP   INCNO,TMPDW+4(4)                                         00191000
         BAL   14,INCNXT     Default start                     @SC88351 00192000
         BAL   14,SEQCHK     Check order                                00193000
         BAL   14,FIND       Get proper source card                     00194000
         ST    6,SAV6        Save current card ptr                      00195000
         CLI   CMD,C'I'                                                 00196000
         BE    *+8           No deletion                                00197000
         OI    FLG,XXKIL     Delete                                     00198000
         BAL   14,SCANN      Get end of range                           00199000
          B    PRC2          Just one card                              00200000
         BAL   14,FIND       Find end of range                          00201000
         BAL   14,SCANN      Should be followed by '$'                  00202000
          B    PRC2          Ok                                         00203000
         B     ERR1          Oops, extra number there                   00204000
PRC2     BAL   14,NEXT       Skip over this card                        00205000
         BAL   14,KILL       Delete, if necessary                       00206000
         CLI   CMD,C'D'                                                 00207000
         BE    CTLP          Done if delete                             00208000
         BAL   14,SCANN      Insert starting number?                    00209000
          B    INSRT         No, use defaults                           00210000
         MVC   NXTNO,ARGNO   Yes                                        00211000
         CLC   OUTNO,NXTNO   Is it ok?                                  00212000
         BNL   ERR3          Out of sequence                            00213000
         BAL   14,SCANN      Increment?                                 00214000
          B    INSRT         No, use default                            00215000
         MVC   INCNO,ARGNO                                              00216000
INSRT    L     3,INSBP       Ptr to buffer                              00217000
INS3     READF CTL,BUFFER=(3),E=CTLZ                                    00218000
         CLC   =C'./ ',0(3)                                             00219000
         BE    INS5          End of insertion                  @SC88351 00220000
         AR    0,3                                             @SC88244 00220100
         LA    1,72(,3)      Must fill to col 72               @SC88244 00220200
         SR    1,0           Length to blank, if any           @SC88244 00220300
         BNP   INS3A         No need to fill                   @SC88244 00220400
         SR    15,15                                           @SC88244 00220500
         ICM   15,8,=C' '                                      @SC88244 00220600
         MVCL  0,14          Fill with blanks                  @SC88244 00220700
INS3A    DS    0H                                              @SC88244 00220800
         BAL   14,SNUM       Sequence new card                          00221000
         TM    FLG,XXCOR     In-core?                                   00224000
         BZ    INS4          No, write it out                           00225000
         SH    3,EH4         Get chain ptr for buffer                   00226000
         MVC   0(4,3),0(6)   Insert into file                           00227000
         ST    3,0(6)                                                   00228000
         LR    6,3           New card is before 'current' one           00229000
         BAL   9,GBLK        Get buffer                                 00230000
EH4      EQU   *+2           Offset to card                             00231000
         LA    3,4(1)                                                   00232000
         ST    3,INSBP                                                  00233000
         B     INS3                                                     00234000
INS4     WRITF OUT,BUFFER=(3),E=DSKERR                                  00235000
         B     INS3                                                     00236000
INS5     CLC   OUTNO,LSTNO   Are we in order?                  @SC88351 00236200
         BNL   ERR5          No, give up                       @SC88351 00236400
         B     CTLQ                                            @SC88351 00236600
*                                                                       00237000
*          END OF CONTROL FILE INPUT                                    00238000
CTLZ     CLOSF CTL                                                      00239000
         TM    FLG,XXCOR     In-core?                                   00240000
         BZ    RDMP          No, copy rest of source to output          00241000
*          Write out file and release storage                           00242000
         LA    6,SPTR        Start of file                              00243000
DMPLP    ICM   6,15,0(6)     Get next card                              00244000
         BZ    DMPZ          Done                                       00245000
         LA    3,4(6)                                                   00246000
         WRITF OUT,BUFFER=(3),E=DSKERR                                  00247000
         B     DMPLP                                                    00248000
DMPZ     L     6,BPTR        Start of blocks                            00249000
FRELP    LTR   1,6           Reached end of chain?                      00250000
         BZ    FREZ          Yes, all released                          00251000
         ICM   6,15,0(6)     Ptr to next                                00252000
         LA    0,(99*84+4)/8                                            00253000
         DMSFRET DWORDS=(0),LOC=(1)                                     00254000
         B     FRELP                                                    00255000
*                                                                       00256000
RDMP     BAL   14,NEXT       Get a card                                 00257000
         LTR   3,3                                                      00258000
         BNZ   RDMP          Keep copying                               00259000
*        B     FREZ                                                     00260000
FREZ     CLOSF OUT           Close files                                00261000
         CLOSF SRC                                                      00262000
         SR    15,15         Ok                                         00263000
QUIT     DS    0H                                              @SC88111 00264000
         COPY  GUPFIN                                          @SC88111 00264200
         RET   MAIN                                            @SC88111 00264400
         TITLE 'Update: various subroutines'                            00265000
*          Renumber a source or inserted record                         00266000
SNUM     UNPK  72(8,3),NXTNO Replace sequence field                     00267000
         OI    79(3),C'0'    Fix zone                                   00268000
         TM    FLG,XX8       Is it 8-col?                               00269000
         BO    *+10          Yes                                        00270000
         MVC   72(3,3),MRK   Just 5                                     00271000
         MVC   OUTNO,NXTNO   Note current number (inserted)    @SC88351 00272000
INCNXT   AP    NXTNO,INCNO                                     @SC88351 00272500
         OI    NXTNO+4,15    Set uniform sign code             @SC88351 00273000
         BR    14                                                       00274000
*                                                                       00275000
*          Check sequence numbers.  if out of order, assume new batch   00276000
SEQCHK   CP    LSTNO,ARGNO   Sequence ok?                               00277000
         BNHR  14            Ok                                         00278000
         TM    FLG,XXCOR     In-core?                                   00279000
         BZ    ERR2          No, can't back up                          00280000
         OI    FLG,XXTOP     Yes, start at top                          00281000
         ZAP   LSTNO,=P'0'                                              00282000
         ZAP   OUTNO,=P'0'                                     @SC90047 00282500
         BR    14                                                       00283000
*                                                                       00284000
*          Remove deleted cards (if in-core)                            00285000
KILL     TM    FLG,XXKIL                                                00286000
         BZR   14            Not deleting                               00287000
         NI    FLG,255-XXKIL Now turn it off                            00288000
         TM    FLG,XXCOR     In-core?                                   00289000
         BZR   14            No, cards were flushed already             00290000
         L     1,SAV6        -> start of range                          00291000
         L     2,0(1)        Start                                      00292000
         MVC   0(4,1),0(6)   Unchain card(s)                            00293000
         MVC   0(4,6),FPTR   Put on free chain                          00294000
         ST    2,FPTR                                                   00295000
         LR    6,1           Fix current ptr                            00296000
         BR    14                                                       00297000
*                                                                       00298000
*          Find desired sequence number                                 00299000
FIND     CLC   LSTNO,ARGNO   Match?                            @SC88351 00300000
         BER   14            Ok                                         00301000
         BH    ERR6          Went too far                               00302000
         ST    14,FNDSV                                        @SC88111 00302500
         BAL   9,NEXTA       Get next                                   00303000
         L     14,FNDSV                                        @SC88111 00303500
         LTR   3,3                                                      00304000
         BZ    ERR6          Not found                                  00305000
         B     FIND                                                     00306000
*                                                                       00307000
*          Get next card                                                00308000
NEXT     LR    9,14          Direct return                              00309000
NEXTA    TM    FLG,XXKIL+XXTOP                                          00310000
         BNZ   NEXTB         Nothing for output                         00311000
NEXTOK   MVC   OUTNO,LSTNO   Save output sequence                       00316000
NEXTB    TM    FLG,XXCOR     In-core?                                   00317000
         BZ    RNEXT         No, read it                                00318000
         TM    FLG,XXTOP                                                00319000
         BZ    NEXTN                                                    00320000
         LA    6,SPTR        Start at top                               00321000
         B     NEXTS         Rejoin with predecessor of new             00322000
NEXTN    ICM   3,15,0(6)     Get ptr to current card, if any            00323000
         BZR   9             At eof                                     00324000
         LR    6,3           Move to next                               00325000
NEXTS    ICM   3,15,0(6)     Get ptr to new card, if any                00326000
         BZ    NEXTZ         At eof                            @SC88351 00327000
         LA    3,4(3)        Ptr to card itself                         00328000
NEXTP    NI    FLG,255-XXINS-XXTOP Started down file                    00329000
         MVC   TMPDW,72(3)   Copy sequence field                        00330000
         TM    FLG,XX8                                                  00331000
         BO    *+10                                                     00332000
         MVC   TMPDW(3),=C'000'  Only 5 digits used                     00333000
         TRT   TMPDW,NUMB    Valid?                                     00334000
         BNZR  9                                                        00335000
         PACK  LSTNO,TMPDW   Save value                                 00336000
         BR    9             Return                                     00337000
*                                                                       00338000
RNEXT    TM    FLG,XXEOF     Already hit end?                           00339000
         BO    RNXZ          Yes, don't read again                      00340000
         LA    3,SRCBUF                                                 00341000
         TM    FLG,XXKIL+XXTOP                                          00342000
         BNZ   RNXA          No current card, or killing anyway         00343000
         WRITF OUT,BUFFER=(3),E=DSKERR                                  00344000
RNXA     READF SRC,BUFFER=(3),E=RNXE                                    00345000
         B     NEXTP                                                    00346000
RNXE     C     15,=F'12'     Eof?                                       00347000
         BNE   DSKERR        No, quit                                   00348000
RNXZ     SR    3,3           Indicate eof                               00349000
         OI    FLG,XXEOF     Remember it                                00350000
NEXTZ    MVI   LSTNO,X'99'   Mark infinite sequence number     @SC88351 00350500
         BR    9             Return                                     00351000
*                                                                       00352000
*          Add a block of buffers to free chain, then get one           00353000
GMORE    LA    0,(99*84+4)/8 Get 99 at once                             00354000
         DMSFREE DWORDS=(0),ERR=ERR4                                    00355000
         MVC   0(4,1),BPTR   Add to block chain                         00356000
         ST    1,BPTR                                                   00357000
         LA    1,4(1)        First new buffer                           00358000
         LA    0,99          Counter                                    00359000
GCHN     MVC   0(4,1),FPTR   Add to chain                               00360000
         ST    1,FPTR                                                   00361000
         LA    1,84(1)                                                  00362000
         BCT   0,GCHN                                                   00363000
*          Get a free buffer (GBLK) ptr in R1                           00364000
GBLK     ICM   1,15,FPTR                                                00365000
         BZ    GMORE         Need to get some more                      00366000
         MVC   FPTR,0(1)                                                00367000
         XC    0(4,1),0(1)   Clear chain ptr                            00368000
         BR    9             AND RETURN                                 00369000
*                                                                       00370000
*          Find next numeric field in card, skip if ok                  00371000
SCANN    SR    1,1                                                      00372000
         L     3,COL         Current position                           00373000
         TRT   0(30,3),NBLNK Next non-blank                             00374000
         BZR   14            Nothing                                    00375000
         LR    3,1           Ptr to field                               00376000
         TRT   0(10,3),BLNK  End of field                               00377000
         BZR   14            Too long                                   00378000
         ST    1,COL         New position                               00379000
         CLI   0(3),C'0'     Numeric?                                   00380000
         BLR   14            No, skip it                                00381000
         BCTR  1,0           Last char                                  00382000
         SR    1,3           Count - 1                                  00383000
         EX    1,TRTN        Check valid digits                         00384000
         BNZ   ERR1          Oops                                       00385000
         EX    1,PCKA                                                   00386000
         OI    ARGNO+4,15    Fix sign, just in case                     00387000
         B     4(14)         Got it                                     00388000
PCKA     PACK  ARGNO,0(,3)                                              00389000
TRTN     TRT   0(,3),NUMB                                               00390000
         TITLE 'Update: error messages'                                 00391000
ERR0     PTEXT 'MISSING CONTROL CARD'                                   00392000
         B     ERPNC                                                    00393000
ERR1     PTEXT 'INVALID CONTROL CARD'                                   00394000
         B     ERPRT                                                    00395000
ERR2     PTEXT 'CONTROL CARD OUT OF ORDER, DISK-TO-DISK MODE'           00396000
         B     ERPNC                                                    00397000
ERR3     MVC   LSTNO,NXTNO   Get bad number                             00398000
         B     ERR5                                                     00399000
ERR4     PTEXT 'FREE STORAGE EXHAUSTED, TRY DISK-TO-DISK UPDATE'        00400000
ERRMSG   WTEXT (3),(4)       Type it                                    00401000
         B     ERREX                                                    00402000
ERR5     UNPK  MSGS2,LSTNO   Set up message                             00403000
         OI    MSGS2+7,C'0'                                             00404000
         UNPK  MSGS1,OUTNO                                              00405000
         OI    MSGS1+7,C'0'                                             00406000
         PTEXT MSGSQ,LMSGSQ                                             00407000
         B     ERPNC                                                    00408000
ERR6     PTEXT 'SEQUENCE NUMBER NOT FOUND'                              00409000
         B     ERPRT                                                    00410000
ERPNC    XC    COL,COL       No column indicator                        00411000
ERPRT    WTEXT (3),(4)                                                  00412000
         L     5,INSBP                                                  00413000
         WTEXT (5),80                                                   00414000
         ICM   3,15,COL      Any column to mark                         00415000
         BZ    ERREX         No                                         00416000
         MVI   0(5),C' '     Blank out buffer                           00417000
         MVC   1(79,5),0(5)                                             00418000
         MVI   0(3),C'*'                                                00419000
         WTEXT (5),80                                                   00420000
ERREX    LA    15,20                                                    00421000
         B     QUIT                                                     00422000
         LOCALS                                                         00423000
QUPDT    EXIT                                                           00424000
         TITLE 'Update: Common code, constants, and variables'          00425000
COMMON   CSECT                                                          00426000
*                                                                       00427000
* Utility routine to set up linkage                                     00428000
SUBENT   LR    KSUBBASE,15   CSECT addressibility              @SC89268 00429000
         L     15,STKPTR     Current end of stack              @SC86295 00430000
         AR    0,15          Our needs                         @SC86295 00431000
         C     0,STKLIM      Does it fit?                      @SC86295 00432000
         BH    SUBDIE        No, (that's incredible)           @SC86295 00433000
         ST    0,STKPTR      New end                           @SC86295 00434000
         ST    13,4(15)      Link subroutines                  @SC86295 00435000
         ST    15,8(13)                                        @SC86295 00436000
         L     0,20(13)      Restore R0                        @SC86295 00437000
         LR    13,15                                           @SC86295 00438000
         BR    14            Go                                @SC86295 00439000
SUBDIE   LM    14,12,12(13)                                    @SC86295 00440000
         SR    15,15                                           @SC86295 00441000
         BCTR  15,0          Set return code = -1              @SC86295 00442000
         BR    14            Go                                @SC86295 00443000
*                                                                       00444000
RTRN2    LA    15,2          Indicate error                    @SC86295 00445000
         B     RTRN                                            @SC86295 00446000
RTRN0    SR    15,15         No errors                         @SC86295 00447000
         B     RTRN                                            @SC86295 00448000
RTRN1    LA    15,1          Indicate error                    @SC86295 00449000
RTRN     ST    13,STKPTR     Free the storage                  @SC86295 00450000
         L     13,4(13)      Unlink                            @SC86295 00451000
         L     14,12(13)     Restore registers                 @SC86295 00452000
         LM    0,12,20(13)                                     @SC86295 00453000
         LTR   15,15         Test return code                  @SC86295 00454000
         BR    14                                              @SC86295 00455000
*                                                                       00456000
*          Constants                                                    00457000
NBLNK    DC    64X'1',X'0',191X'1'   Find non-blank, if any             00458000
BLNK     DC    64X'0',X'1',191X'0'   Find blank, if any                 00459000
NUMB     DC    240X'1',10X'0',6X'1'  Find non-digit, if any             00460000
TRHEX    EQU   *-240                                                    00461000
         DC    C'0123456789ABCDEF'   Convert to characters              00462000
F4       DC    F'4'                                                     00463000
F8       DC    F'8'                                                     00464000
FDBP     DS    0F            Pattern for file FDB                       00466000
         DC    A(0,80)       Buffer ptr, length                         00467000
         FDBPAT ,F,80        F/80 file                         @SC88111 00469000
IVARS    DS    0D                                                       00470000
IMSGSQ   DC    C'SEQUENCE ERROR: '                                      00471000
         DC    CL8' ',C' TO '                                           00472000
         DC    CL8' '                                                   00473000
*          Variables                                                    00474000
&STORDS  DSECT ,                                               @SC89268 00475000
STORAG   EQU   *                                               @SC89268 00475500
TMPDW    DS    D             For conversions                            00476000
STKLO    DS    A             Start of stack space              @SC89089 00476300
STKHI    DS    A             High extent of stack usage        @SC89089 00476600
STKPTR   DS    A             Save area stack                            00477000
STKLIM   DS    A             ditto                                      00478000
SPTR     DS    A             Ptr to start of file                       00479000
FPTR     DS    A             Ptr to free list                           00480000
BPTR     DS    A             Allocation block list                      00481000
INSBP    DS    A             Ptr to control buffer                      00482000
COL      DS    A             Current scan column ptr                    00483000
SAV6     DS    A             Saved card ptr                             00484000
FNDSV    DS    F             Return address for FIND           @SC88111 00484500
         DS    0F                                                       00485000
NXTNO    DS    PL5           Next sequence number for insert/reseq      00486000
INCNO    DS    PL5           Sequencing increment                       00487000
LSTNO    DS    PL5           Current sequence number                    00488000
OUTNO    DS    PL5           Last card written                          00489000
ARGNO    DS    PL5           Number read from control card              00490000
CTL      DS    F             Ticket to control input                    00492000
SRC      DS    F             Ticket to input source                     00493000
OUT      DS    F             Ticket to output file                      00494000
CTLBUF   DS    CL80          Buffers                                    00495000
SRCBUF   DS    CL80                                                     00496000
CMD      DS    C             Control command                            00497000
MRK      DS    CL3           Sequence label field                       00498000
         COPY  GUPVAR        System-specific variables                  00499000
VARS     DS    0D                                                       00500000
MSGSQ    DC    C'SEQUENCE ERROR: '                                      00501000
MSGS1    DC    CL8' ',C' TO '                                           00502000
MSGS2    DC    CL8' '                                                   00503000
LMSGSQ   EQU   *-MSGSQ                                                  00504000
LVARS    EQU   *-VARS                                                   00505000
*                                                                       00506000
*          User interface information                                   00507000
SRCNAM   DS    CL(LFID)      Input file name                            00508000
CTLNAM   DS    CL(LFID)      Control file name                          00509000
OUTNAM   DS    CL(LFID)      Output file name                           00510000
MRKD     DS    CL3           Default sequence label field               00511000
FLG      DS    X             Flags                                      00512000
XXKIL    EQU   X'80'         Deleting source records                    00513000
XXTOP    EQU   X'40'         At top of file                             00514000
XXINS    EQU   X'20'         Latest card is inserted                    00515000
XXEOF    EQU   X'10'         Reached end of source                      00516000
XX8      EQU   X'02'         8-column sequence field                    00517000
XXCOR    EQU   X'01'         Perform update in-core                     00518000
         DS    0D                                                       00519000
STODWDS  EQU   (*-STORAG)/8  Length of storage                          00520000
         COPY  GUPSUB                                                   00521000
*                                                                       00522000
         END   GUPI                                                     00523000
