'HEAD' REGISTER STACK MANAGEMENT
C     EDIT DATE   16NOV78  15:08
C     SOURCE FILE RGSAVEAPB.FS
C     AUTHOR      A.P.BUCHALTER
C     CLUSTER       20

C     ROUTINES TO SAVE REGISTER CONTENTS FOR OPTIMIZATION
C     DURING THE EVALUATION OF BOOLEAN EXPRESSIONS AND
C     CODE GENERATION OF ALTERNATIVE PATHS THROUGH CONDITIONALS
C     AT VARIOUS POINTS, THE CURRENT REGISTER CONTENTS AS STORED
C     IN THE ARRAYS ACADDR,ACTYPE,ACSUBS,ETC. WILL BE SAVED
C     IN A REGISTER STACK AREA.
C     TO ALLOW MORE REGISTER LEVELS TO BE SAVED, ONLY A SUBSET
C     OF THE REGISTERS WILL BE SAVED. NAMELY:
C        AREG- ALL 5 PARAMETERS
C        YREG- ONLY YREG OF FORM: 'LOC'X[0+K] OR 'SP'X[0]+K
C              ONLY THE THREE PARAMETERS 'MODE',X, AND K SAVED
C        CTS - ONLY CT REGISTERS OF FORM: 'LOC'0['SP'X+0]
C              ONLY X WILL BE SAVED
C     THEREFORE, 15 ITEMS WILL BE SAVED FOR EACH REGISTER LEVEL
C     EACH LEVEL IN REGSTK WILL BE ORGANIZED AS:
C        REGSTK(LEVEL,1-5)= AREG PARAMETERS
C        REGSTK(LEVEL,6-8)= ACADDR(YREG),ACTYPE(YREG),ACBIAS(YREG)
C        REGSTK(LEVEL,9-15)=ACSUBS(CTX)
      'OUTFILE' RSTK00APB.FR
C     EDIT DATE   16NOV78  15:08
C     SOURCE FILE RGSAVEAPB.FS
C     AUTHOR      A.P.BUCHALTER
N     OVERLAY     OLCRM
      SUBROUTINE STKREG(LEVEL,SAVTYP)
      INTEGER LEVEL,SAVTYP
      'INCLUDE' RMCOMJHP.IN,
      'INCLUDE' CTRLAJH.IN,
      'INCLUDE' LOGOSAJH.IN,
      'INCLUDE' REGSJHP.IN,
      'INCLUDE' PRTCOMFTM.IN,
      'INCLUDE' NLISTCFTM.IN,
      INTEGER BASE,CNTX,STKX,CT
     'INCLUDE' RSTDEFAPB.IN,P
'EJECT'
     'IF' (DUMFLG .NE. 0)
         CALL EST('STKREG',LBUF,1,6)
         CALL ESP(LEVEL,LBUF,10,12)
         CALL ESP(SAVTYP,LBUF,14,16)
         CALL SGLPRT
         'ENDIF'
      IF (LEVEL .GT. MAXLEV(SAVTYP)) RETURN
      BASE=SAVSIZ*(LEVEL+LEVST(SAVTYP))+1
C     SAVE ALL 5 PARAMETERS FOR THE AREG
      REGSTK(BASE)=ACADDR(AREG)
      REGSTK(BASE+1)=ACTYPE(AREG)
      REGSTK(BASE+2)=ACSUBS(AREG)
      REGSTK(BASE+3)=ACSBTY(AREG)
      REGSTK(BASE+4)=ACBIAS(AREG)
C     SAVE YREG IF OF FORM: 'LOC'X[0+K] OR 'SP'X[0]+K
C     ONLY SAVE X,MODE, AND K
      STKX=BASE+5
      'IF' (ACSUBS(YREG) .NE. 0)
         REGSTK(STKX)=0
         REGSTK(STKX+1)=0
         REGSTK(STKX+2)=0
         'ELSE'
         REGSTK(STKX)=ACADDR(YREG)
         REGSTK(STKX+1)=ACTYPE(YREG)
         REGSTK(STKX+2)=ACBIAS(YREG)
         'ENDIF'
C     SAVE CT REGISTER IF OF FORM: 'LOC'X[0+0]
C     ONLY SAVE X
      STKX=BASE+8
      'DOLOOP' CNTX=4,10
         'IF' ((ACTYPE(CNTX) .NE. ADRFLG) .OR. ^
               (ACADDR(CNTX) .NE. NULLX) .OR. ^
               (ACSBTY(CNTX) .NE. DPMODE) .OR. ^
               (ACBIAS(CNTX) .NE. 0))
            REGSTK(STKX)=0
            'ELSE'
            REGSTK(STKX)=ACSUBS(CNTX)
            'ENDIF'
         STKX=STKX+1
         'END'
      CALL RSTDMP(BASE)
      END
      'OUTFILE'  RSTK01APB.FR
C     EDIT DATE   16NOV78  15:08
C     SOURCE FILE RGSAVEAPB.FS
C     AUTHOR      A.P.BUCHALTER
C     CLUSTER     ?
      SUBROUTINE MRGREG(LEVEL,SAVTYP)
C     MERGE LEVEL LEVEL WITH CURRENT LEVEL
      INTEGER LEVEL,SAVTYP
      'INCLUDE' RMCOMJHP.IN,
      'INCLUDE' RMCODES.IN,
      'INCLUDE' REGSJHP.IN,
      'INCLUDE' PRTCOMFTM.IN,
      'INCLUDE' NLISTCFTM.IN,
      'INCLUDE' CTRLAJH.IN,
      'INCLUDE' LOGOSAJH.IN,
      INTEGER CNTX,STKX,BASE
      'INCLUDE' RSTDEFAPB.IN,
      'IF' (DUMFLG .NE. 0)
         CALL EST('MRGLEV',LBUF,1,6)
         CALL ESP(LEVEL,LBUF,10,12)
         CALL ESP(SAVTYP,LBUF,14,16)
         CALL SGLPRT
         'ENDIF'
      'IF' (LEVEL .GT. MAXLEV(SAVTYP))
         CALL REGMAN(CLRACV,0,0)
         RETURN
         'ENDIF'
      BASE=SAVSIZ*(LEVEL+LEVST(SAVTYP))+1
      CALL RSTDMP(BASE)
C     CLEAR XREG AND NZREG SINCE THEY ARE NOT SAVED
      CALL REGMAN(CLRACX,NZREG,0)
      CALL REGMAN(CLRACX,XREG,0)
      IF ((ACADDR(AREG) .NE. REGSTK(BASE)) .OR. ^
          (ACTYPE(AREG) .NE. REGSTK(BASE+1)) .OR. ^
           (ACSUBS(AREG) .NE. REGSTK(BASE+2)) .OR. ^
           (ACSBTY(AREG) .NE. REGSTK(BASE+3)) .OR. ^
           (ACBIAS(AREG) .NE. REGSTK(BASE+4))) ^
               CALL REGMAN(CLRACX,AREG,0)

C     CLEAR YREG IF ANY OF 4 PARAMETERS DON'T MATCH
      STKX=BASE+5
      IF ((ACADDR(YREG) .NE. REGSTK(STKX)) .OR. ^
          (ACTYPE(YREG) .NE. REGSTK(STKX+1)) .OR. ^
          (ACSUBS(YREG) .NE. 0)            .OR. ^
          (ACBIAS(YREG) .NE. REGSTK(STKX+2))) ^
         CALL REGMAN(CLRACX,YREG,0)
C     CLEAR ANY CT REGS WHICH DON'T MATCH
      STKX=BASE+8
      'DOLOOP' CNTX=4,10
         IF ((ACADDR(CNTX) .NE. NULLX) .OR. ^
             (ACTYPE(CNTX) .NE. ADRFLG)       .OR. ^
             (ACSUBS(CNTX) .NE. REGSTK(STKX))         .OR. ^
             (ACSBTY(CNTX) .NE. DPMODE) .OR. ^
             (ACBIAS(CNTX) .NE. 0)) ^
           CALL REGMAN(CLRACX,CNTX,0)
         STKX=STKX+1
         'END'
      END
      'OUTFILE' RSTK02APB.FR
      SUBROUTINE EXRGLV(LEVEL,SAVTYP)
C     SWAP CURRENT REGISTER WITH THOSE AT LEVEL LEVEL
      INTEGER LEVEL,SAVTYP
      'INCLUDE' RMCOMJHP.IN,
      'INCLUDE' RMCODES.IN,
      'INCLUDE' REGSJHP.IN,
      'INCLUDE' PRTCOMFTM.IN,
      'INCLUDE' NLISTCFTM.IN,
      'INCLUDE' CTRLAJH.IN,
      'INCLUDE' LOGOSAJH.IN,
      INTEGER BASE,SCRBAS,SCRX,CNTX,STKX
      'INCLUDE' RSTDEFAPB.IN,
      'IF' (DUMFLG .NE. 0)
         CALL EST('EXRGLV',LBUF,1,6)
         CALL ESP(LEVEL,LBUF,10,12)
         CALL ESP(SAVTYP,LBUF,14,16)
         CALL SGLPRT
         'ENDIF'
      'IF' (LEVEL .GT. MAXLEV(SAVTYP))
         CALL REGMAN(CLRACV,0,0)
         RETURN
         'ENDIF'
      BASE=SAVSIZ*(LEVEL+LEVST(SAVTYP))+1
      CALL RSTDMP(BASE)
C     CLEAR XREG AND NZREG SINCEE THEY ARENT SAVED
      CALL REGMAN(CLRACX,XREG,0)
      CALL REGMAN(CLRACX,NZREG,0)
C     MOVE THE SAVE REGISTERS IN DESIRED LEVEL TO
C     SCRATCH LEVEL AT TOP OF REGSTK
      SCRBAS=SCRLEV*SAVSIZ+1
      STKX=BASE
      CNTX=SAVSIZ-1+SCRBAS
      'DOLOOP' SCRX=SCRBAS,CNTX
          REGSTK(SCRX)=REGSTK(STKX)
         STKX=STKX+1
         'END'
C     MOVE THE CURRENT REGISTERS TO DESIRED SAVE LEVEL
      CALL STKREG(LEVEL,SAVTYP)
C     MOVE THE REGISTERS FROM SCRATCH AREA TO CURRENT REGISTERS
C     TRANSFER THE SAVE AREG
      ACADDR(AREG)=REGSTK(SCRBAS)
      ACTYPE(AREG)=REGSTK(SCRBAS+1)
      ACSUBS(AREG)=REGSTK(SCRBAS+2)
      ACSBTY(AREG)=REGSTK(SCRBAS+3)
      ACBIAS(AREG)=REGSTK(SCRBAS+4)
C     TRANSFER YREG WITH DEFAULT VALUES
      ACADDR(YREG)=REGSTK(SCRBAS+5)
      ACTYPE(YREG)=REGSTK(SCRBAS+6)
      ACSUBS(YREG)=0
      ACSBTY(YREG)=0
      ACBIAS(YREG)=REGSTK(SCRBAS+7)
C     TRANSFER THE CTS WITH DEFAULT VALUES
      STKX=SCRBAS+8
      'DOLOOP' CNTX=4,10
         CALL REGMAN(CLRACX,CNTX,0)
         'IF' (REGSTK(STKX) .NE. 0)
            ACADDR(CNTX)=NULLX
            ACTYPE(CNTX)=ADRFLG
            ACSUBS(CNTX)=REGSTK(STKX)
            ACSBTY(CNTX)=DPMODE
         'ENDIF'
         STKX=STKX+1
         'END'
      CALL RSTDMP(BASE)
      END
      'OUTFILE' RSTK03APB.FR
C     EDIT DATE   16NOV78  15:09
C     SOURCE FILE  RGSAVEAPB.FS
C     AUTHOR      A.P. BUCHALTER
N     OVERLAY OLRDM
      SUBROUTINE RSTDMP(BASE)
      INTEGER BASE
      'INCLUDE' RMCOMJHP.IN,
      'INCLUDE' REGSJHP.IN,
      'INCLUDE' PRTCOMFTM.IN,
      'INCLUDE' CTRLAJH.IN,
      'INCLUDE' NLISTCFTM.IN,
      'INCLUDE' LOGOSAJH.IN,
      INTEGER STKX,CTLO,CTHI,REG
      'INCLUDE' RSTDEFAPB.IN,
      IF (DUMFLG .EQ. 0) RETURN
      CALL EST('RSTDMP',LBUF,1,6)
      CALL ESP(BASE/SAVSIZ+1,LBUF,1,12)
      CALL SGLPRT
C     OUTPUT THE AREG
      CALL ESP(AREG,LBUF,1,2)
      CALL STKOUT(REGSTK(BASE),REGSTK(BASE+1),REGSTK(BASE+2), ^
        REGSTK(BASE+3),REGSTK(BASE+4))
C     OUTPUT THE YREG
      CALL ESP(YREG,LBUF,1,2)
      CALL STKOUT(REGSTK(BASE+5),REGSTK(BASE+6),0,0, ^
        REGSTK(BASE+7))
C     OUTPUT THE CTS
      CTLO=BASE+8
      CTHI=BASE+14
      REG=4
      'DOLOOP' STKX=CTLO,CTHI
         'IF' (REGSTK(STKX) .NE. 0)
            CALL ESP(REG,LBUF,1,2)
            CALL STKOUT(NULLX,ADRFLG,REGSTK(STKX),DPMODE,0)
            'ENDIF'
         REG=REG+1
         'END'
      END
      'OUTFILE'  RSTK04APB.FR
      SUBROUTINE STKOUT(ADDR,ATYPE,SUBS,SBTY,BIAS)
         INTEGER ADDR,ATYPE,SUBS,SBTY,BIAS
      'INCLUDE' NLNAMEFTM.IN,
      'INCLUDE' PRTCOMFTM.IN,
      INTEGER CLOCN,L
      'IF' (ADDR .NE. 0)
         L = CLOCN(ADDR)
         CALL EST(NAME,LBUF,4,19)
         CALL ESP(ATYPE,LBUF,21,23)
         'IF' (SUBS .NE. 0)
            L = CLOCN(SUBS)
            CALL EST(NAME,LBUF,26,41)
            CALL ESP(SBTY,LBUF,43,45)
            'ENDIF'
          CALL ESP(BIAS,LBUF,47,50)
          CALL SGLPRT
          'ENDIF'
       END