&LABEL PROC  ,,&BASE=12,&NAME=,&SAVER=SA,&TY=F,&SAVE=ON,&REG=9
XM7BGN   NAME
BEGIN    NAME
.* * * * *  * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
.*                                                                  *
.*    THE FOLLOWING PROGRAMS ARE THE SOLE PROPERTY OF SPERRY        *
.*                                                                  *
.*   UNIVAC CONTAINING ITS PROPRIETARY,CONFIDENTIAL INFORMATION     *
.*                                                                  *
.* * * * *  * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
         GBLB  &SVFLAG
         GBLC  &ENTRY1
         LCLC  &SECTION,&SAVEA,&TEMP
         LCLA  &ID,&A
         SPACE 2
.*       THIS MACRO SETS UP A BASE REGISTER AND LINKAGE FOR ANY LEVEL
.*       CSECT.
.*       BASE REGISTER IS DEFAULTED TO 12 IF NOT SUPPLIED
.*       A NAME IDENTIFIER IS ALLOWED AND DEFAULTS TO THE LABEL
.*       OR CSECT NAME IF NO LABEL; NOTE:  IF CSECT NAME IS NULL AN
.*       ERROR CO45 9S SUPPLIED AND NO NAME GENERATION IS SUPPLIED
.*        NAME = OFF IMPLIES NO IDENTIFIER DESIRED
.*       IF A SAVE AREA NAME IS DESIRED, IT CAN BE SUPPLIED THROUGH THE
.*       OPERAND SAVER, A DEFAULT OF SA AND SYSNDX IS USED IF  OMITTED
.*       TY SPECIFIES THE HEX CHARACTER TO BE USED IN SAVE AREA
.*       SAVE ALLOWS THE TURNING OFF OF THE SAVE AREA GENERATION FOR
.*       LOWEST LEVEL SUBPROGRAMS
.*       REG USED DEFAULTS TO 9 FOR SAVE SCRATCH
         AIF   ('&NAME' EQ 'OFF').A1   NAME OFF IMPLIES NO IDENTIFIER
         AIF   ('&NAME' NE '').A2      DEFAULT TO LABEL IF NULL
         AIF   ('&LABEL' EQ '').A6     CHECK FOR NULL LABEL
&SECTION SETC  '&LABEL'
&ID      SETA  ((K'&LABEL+2)/2)*2-1    SET TO AN ODD VALUE
         AGO   .A9
.A2      ANOP
&SECTION SETC  '&NAME'
&ID      SETA  ((K'&NAME+2)/2)*2-1     SET TO ODD VALUE
.A9      ANOP
&A       SETA  &ID+5
         B     &A.(0,15)      BRANCH AROUND CONSTANTS
         DC    AL1(&ID)
         DC    CL&ID'&SECTION'
&LABEL   STM   14,12,12(13)
         AGO   .A4
.A1      ANOP
&LABEL   STM   14,12,12(13)
.A4      BALR  &BASE,R0     SET UP A BASE REGISTER
         USING *,&BASE                    NOTE ITS USAGE
         AIF   ('&SAVE' EQ 'OFF').A15  BYAPSS LOADS FOR NO SAVE AREA
&SVFLAG  SETB  0                       RESET TO 0 FOR NEXT TRY
         LR    &REG,13 LOAD SAVE POINTER
         AIF   ('&SAVER' EQ 'SA').A5
&SAVEA   SETC  '&SAVER'
         AGO   .A7
.A5      ANOP
&SAVEA   SETC  'SA'.'&SYSNDX'
.A7      AIF   ('&SAVE'(1,5) EQ 'ENTRY').A12
&ENTRY1  SETC  '&SAVEA'
         AIF   ('&SAVE' NE 'ON').A10
.A11     CNOP  0,4
         BAL   13,*+76       BRANCH AND LOAD REGISTER 13 WITH SAVE AREA
&SAVEA   DC    18X'&TY&TY&TY&TY&TY&TY&TY&TY'     SAVE AREA
.A3      ST    13,8(0,&REG)   STORE POINTER
         ST    &REG,4(0,13)  STORE SECOND POINTER
         SPACE 2
         AGO   .A16
.A6      AIF   ('&SYSECT' EQ '').A8    CHECK FOR NULL CSECT NAME
&SECTION SETC  '&SYSECT'          SET TO CSECT NAME
&ID      SETA  9
         AGO   .A9
.A8      MNOTE *,'**** CSECT NAME NULL AND NO LABEL ****'
         AGO   .A1
.A10     MNOTE *,'UNIDENTIFIEABLE &SAVE '
         AGO   .A11
.A12     CNOP  0,4
         B     *+8
         AIF   (K'&SAVE LE 5).A13
&TEMP    SETC  '&SAVE'(6,8)
         DC    A(&TEMP)
         AGO   .A14
.A13     DC    A(&ENTRY1)
.A14     L     13,*-4
         AGO   .A3
.A15     ANOP
&SVFLAG  SETB  1                       SET FLAG TO ONE
.A16     ANOP
         END
