'HEAD' REGISTER MANAGEMENT
C     EDIT DATE   10DEC78  20:16
C     SOURCE FILE REGAPB.FS
C     AUTHOR      A.P. BUCHALTER
C     CLUSTER     20
      'OUTFILE'   OREGAPB.FR
C     EDIT DATE   10DEC78  20:16
C     SOURCE FILE REGAPB.FS
C     AUTHOR      A.P. BUCHALTER
N     OVERLAY     OLREG
C     ROUTINES TO KEEP TRACK OF REGISTER CONTENTS
      SUBROUTINE OREGS(FUNC, OPND, OTYPE, SUBSC, STYPE, BIAS, REG)
      INTEGER     FUNC, OPND, OTYPE, SUBSC, STYPE, BIAS, REG
      'INCLUDE'   NLISTCFTM.IN,
      'INCLUDE'   LOGOSAJH.IN,
      'INCLUDE'   RMCOMJHP.IN,
      'INCLUDE'   WFLAGSJHP.IN,
      'INCLUDE'   REGSJHP.IN,
      INTEGER     MODE, SBIAS, DBIAS
      INTEGER     REGLO,  REGHI
      LOGICAL     NLTEST
C     FUNCTIONS
C       SEARCH ALL = 1
C       SEARCH AXY = 2
C       SEARCH CTS = 3
C       SEARCH NZ  = 4
C       CLEAR MATCH = 5
C       SET = 6
C       LOADY = 7

      CALL REGDMP (FUNC)
      GO TO (100, 200, 300, 400, 500, 600, 700), FUNC
C     SEARCH ALL
100   REGLO = AREG
      REGHI = NZREG-1
      GO TO 8000
C     SEARCH A, X, Y
200   REGLO = AREG
      REGHI = YREG
      GO TO 8000
C     SEARCH CTS
300   REGLO = 4
      REGHI = NRREGS
      GO TO 8000
C     SEARCH NZ
400   REGLO = NZREG
      REGHI = NZREG
      GO TO 8000
      'EJECT'
C     CLEAR REGISTERS WHICH MATCH OPND OR SUBSCRIPT
500   'DOLOOP' REGLO = AREG, NZREG
        IF ((OPND .EQ. ACADDR(REGLO)  .AND. ^
            ACTYPE(REGLO) .NE. ADRFLG)   .OR. ^
           (ACSUBS(REGLO) .EQ. OPND .AND. ^
             ACSBTY(REGLO) .NE. ADRFLG)) ^
         ACADDR(REGLO) = 0
         'END'
      GO TO 9000

C     SET REGISTER
600   ACADDR (REG) = 0
      IF (OTYPE .EQ. DPMODE .AND. REG .LE. YREG) ^
         GO TO 9000
      IF (OPND .EQ. 0) ^
         GO TO 9000
      IF (NLTEST (OPND, REGBIT)) ^
         GO TO 9000
      'IF' (SUBSC .NE. 0)
         IF (NLTEST (SUBSC, REGBIT)) GO TO 9000
         'ENDIF'
      ACADDR(REG) = OPND
      ACTYPE(REG) = OTYPE
      ACSUBS(REG) = SUBSC
      ACSBTY(REG) = STYPE
      ACBIAS(REG) = BIAS
      GO TO 9000
      'EJECT'
C     LOAD Y - CAN WE USE WHAT IS IN YREG
C     CALLED AS REGSRC(7, SUBOP, WFSOP, SUBX, SUBXM, SUBXB, -)
C     WHERE DESIRE YREG TO BE:
C       'LOC'SUBX[0+SUBXB] OR 'SP'SUBX[0+0]+SUBXB
C      NOTE: THE YREG IS A VERY SPECIAL CASE. THE ACADDR, ETC. ARRAYS
C      HAVE A DIFFERENT INTERPRETATION.
C      IF MODE = 'LOC' THEN NORMAL INTERPRETATION
C      IF MODE = 'SP' THEN: YREG = ACADDR[ACSUBS+0]+ACBIAS
700   'IF' (OPND .EQ. 160)    // LDYIMM
         MODE = ADRFLG
         'ELSE'
         MODE = SPMODE
         'ENDIF'
      SBIAS = BIAS
C     IF 'MODE'SUBX[0+--] = YREG
      'IF' ((ACADDR(YREG) .EQ. SUBSC) .AND. ^
               ACTYPE(YREG) .EQ. MODE  .AND. ^
               ACSUBS(YREG) .EQ. 0)
         DBIAS = BIAS-ACBIAS(YREG)
C        CHECK +-1 FROM CURRENT BIAS
         'IF' (DBIAS .EQ. 1)
            OTYPE = WF4
            BIAS = 0
            OPND = 200   // INY
            'ELSE'
            'IF' (DBIAS .EQ. -1)
               OTYPE = WF4
               BIAS = 0
               OPND = 136   // DEY
               'ELSE'
               IF (DBIAS .EQ. 0) OPND = -1
               'ENDIF'
            'ENDIF'
         'ENDIF'
      ACADDR(YREG) = SUBSC
      ACTYPE(YREG) = MODE
      ACSUBS(YREG) = 0
      ACSBTY(YREG) = SPMODE
      ACBIAS(YREG) = SBIAS
      GO TO 9000
      'EJECT'
C     GENERAL REGISTER SEARCH
8000  'DOLOOP' REG = REGLO, REGHI
         IF (ACADDR(REG) .EQ. OPND .AND. ^
             ACTYPE(REG) .EQ. OTYPE .AND. ^
             ACSUBS(REG) .EQ. SUBSC .AND. ^
             ACSBTY(REG) .EQ. STYPE .AND. ^
           ACBIAS(REG) .EQ. BIAS) ^
         GO TO 9000
         'END'
C     NO MATCH
      REG = 0
9000  CALL REGDMP (REG)
      RETURN
      END
      'OUTFILE' REGAPB.FR
C     EDIT DATE   10DEC78  20:16
C     SOURCE FILE REGAPB.FS
C     AUTHOR      A.P. BUCHALTER
C     CLUSTER     ?
      SUBROUTINE REGSRC(FUNC, OPND, OTYPE, SUBSC, STYPE, BIAS, REG)
      EXTERNAL  OLREG
      INTEGER FUNC, OPND, OTYPE, SUBSC, STYPE, BIAS, REG
C     ROOT FOR OREGS SUBROUTINE

C      CALL OVLOD(OLREG)
      CALL OREGS(FUNC, OPND, OTYPE, SUBSC, STYPE, BIAS, REG)
      RETURN
      END