home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
archives
/
ibm370.zip
/
ik0gup.asm
< prev
next >
Wrap
Assembly Source File
|
1992-09-30
|
45KB
|
554 lines
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