&TAG     PROC  &LAB,2,&COVER=15,&COVADR=*,&SA=                          SAV00010
SAVE     NAME                                                           SAV00020
.*                                                                      SAV00030
                                                           DO 0         SAV00040
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *  *  SAV00050
*                                                                    *  SAV00060
*   THE FOLLOWING PROGRAMS ARE THE SOLE PROPERTY OF SPERRY           *  SAV00070
*                                                                    *  SAV00080
* UNIVAC CONTAINING ITS PROPRIETARY, CONFIDENTIAL INFORMATION        *  SAV00090
*                                                                    *  SAV00100
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *  *  SAV00110
                                                           ENDO         SAV00120
.*                                                                      SAV00210
         LCL   &PRLABEL                                                 SAV00220
         LCL   &RWORK,&ADR,&P1,&P2,&P3,&P4,&REG,&LAST,&JJ               SAV00230
         LCL   &J,&P5,&VARBL                                            SAV00240
.*                                                                      SAV00250
.********************************************************************** SAV00260
.*                                                                    * SAV00270
.*                                                                    * SAV00280
.*       PROC TO GENERATE CODE TO:                                    * SAV00290
.*                                                                    * SAV00300
.*             SAVE CALLING PROGRAM'S REGISTERS,                      * SAV00310
.*             SAVE ENTRY AND EXIT ADDRESS REGISTERS,                 * SAV00320
.*             LOAD REG 13 WITH A POINTER TO A SAVE AREA,             * SAV00330
.*             ISSUE A USING WITH A SUITABLE BASE REG AND DISPL.      * SAV00340
.*                                                                    * SAV00350
.********************************************************************** SAV00360
.*                                                                      SAV00370
&ADR     SET   ('&SA'=''=0)*4+4                                         SAV00380
&ADR     SET   &ADR+((('&COVADR'='*')++('&COVADR'='&TAG'))=0)*4         SAV00390
&ADR     SET &ADR+4*((((N'&LAB)=0)++('&LAB(1)'='(0,0)'))**('&SA'=''=0)) SAV00400
.*                                                                      SAV00410
         DO    &ADR=4=0                                                 SAV00420
                   CNOP  0,4                                            SAV00430
         ENDO                                                           SAV00440
.*                                                                      SAV00450
.*       ISSUE USING STATEMENT                                          SAV00460
.*                                                                      SAV00470
&PRLABEL SET   '&TAG.        '(1,8)                                     SAV00480
&PRLABEL           DS    0H                                             SAV00490
.*                                                                      SAV00500
         DO    ('&COVADR'='*')++('&COVADR'='&TAG')                      SAV00510
&P5      SET   ',&COVER'                                                SAV00520
         DO    '&COVER'(1,1)='('                                        SAV00530
&I       DO    (N'&COVER)/2                                             SAV00540
&J       SET   &I*2                                                     SAV00550
&P1      SET   '&P2'                                                    SAV00560
&P2      SET   '&P3'                                                    SAV00570
&P3      SET   '&P4'                                                    SAV00580
&P4      SET   ',&COVER(&J-1),&COVER(&J)'                               SAV00590
         ENDO                                                           SAV00600
&P5      SET   ''                                                       SAV00610
         DO    (((N'&COVER)/2*2)=(N'&COVER))=0                          SAV00620
&P5      SET   ',&COVER(N'&COVER)'                                      SAV00630
         ENDO                                                           SAV00640
         ENDO                                                           SAV00650
                   USING *&P1&P2&P3&P4&P5                               SAV00660
         ENDO                                                           SAV00670
.*                                                                      SAV00680
.*       RESERVE & BRANCH AROUND ADDRESS CONSTANTS                      SAV00690
.*                                                                      SAV00700
         DO    &ADR=4=0                                                 SAV00710
                   B     &ADR.(,15)                                     SAV00720
         DO    '&SA'=''=0                                               SAV00730
                   DC    A(&SA)                                         SAV00740
         ENDO                                                           SAV00750
         DO    (((N'&LAB)=0)**('&SA'=''=0))                             SAV00760
                   DC    F'0'                                           SAV00770
         ENDO                                                           SAV00780
         DO    (('&COVADR'='*')++('&COVADR'='&TAG'))=0                  SAV00790
                   DC    A(&COVADR)                                     SAV00800
         ENDO                                                           SAV00810
&ADR     SET   &ADR-4                                                   SAV00820
         ENDO                                                           SAV00830
.*                                                                      SAV00840
.*       GENERATE REGISTER SAVING INSTRUCTIONS                          SAV00850
.*                                                                      SAV00860
         DO    N'&LAB>0                                                 SAV00870
                   SARG$ &LAB(1),&LAB(2)                                SAV00880
         ENDO                                                           SAV00890
.*                                                                      SAV00900
.*       LINK HIGHER, LOWER, AND CURRENT LEVEL SAVE AREAS               SAV00910
.*                                                                      SAV00920
         DO    '&SA'=''=0                                               SAV00930
         DO    (N'&LAB>0)**('&LAB(1)'='(0,0)'=0)                        SAV00940
&RWORK   SET   '&LAB(1,1)'                                              SAV00950
         DO    '&LAB(1,1)'=''                                           SAV00960
&RWORK   SET   '14'                                                     SAV00970
         ENDO                                                           SAV00980
&RWORK   SET   &RWORK+('&RWORK'='0')                                    SAV00990
&RWORK   SET   '&RWORK'                                                 SAV01000
&VARBL   SET   &RWORK*4+20-64*(&RWORK>13)                               SAV01010
                   LR    &RWORK,13                                      SAV01020
                   L     13,4(,15)                                      SAV01030
                   ST    &RWORK,4(,13)                                  SAV01040
                   ST    13,8(,&RWORK)                                  SAV01050
                   L     &RWORK,&VARBL.(,&RWORK)                        SAV01060
         GOTO  .LAB2                                                    SAV01070
         ENDO                                                           SAV01080
                   ST    13,8(,15)                                      SAV01090
                   L     13,4(,15)                                      SAV01100
                   MVC   4(4,13),8(15)                                  SAV01110
.LAB2    LABEL                                                          SAV01120
         ENDO                                                           SAV01130
.*                                                                      SAV01140
.*       LOAD COVER REGISTER(S)                                         SAV01150
.*                                                                      SAV01160
&REG     SET   '&COVER'                                                 SAV01170
.*                                                                      SAV01180
         DO    '&COVER'(1,1)='('                                        SAV01190
&REG     SET   '&COVER(1)'                                              SAV01200
         ENDO                                                           SAV01210
.*                                                                      SAV01220
         DO    (('&COVADR'='*')++('&COVADR'='&TAG'))=0                  SAV01230
                   L     &REG,&ADR.(,15)                                SAV01240
         GOTO  .LAB1                                                    SAV01250
         ENDO                                                           SAV01260
         DO    &REG=15=0                                                SAV01270
                   LR    &REG,15                                        SAV01280
         ENDO                                                           SAV01290
.LAB1    LABEL                                                          SAV01300
.*                                                                      SAV01310
         DO    N'&COVER>1                                               SAV01320
&LAST    SET   N'&COVER                                                 SAV01330
                   LA    &COVER(&LAST),4095                             SAV01340
&I       DO    N'&COVER-1                                               SAV01350
&JJ      SET   &I+1                                                     SAV01360
                   LA    &COVER(&JJ),1(&COVER(&I),&COVER(&LAST))        SAV01370
         ENDO                                                           SAV01390
         ENDO                                                           SAV01400
.*                                                                      SAV01410
         END                                                            SAV01420
