'HEAD'  REGISTER MANAGEMENT
C     EDIT DATE   14JAN79  09:14
C     SOURCE FILE REGMANJHP.FS
C     AUTHOR      J.H.PERINE
C     CLUSTER     20
      'OUTFILE'   REGMANJHP.FR
      SUBROUTINE  REGMAN (FUNC, REG, AUX)
      'INCLUDE'   NLISTCFTM.IN,
      'INCLUDE'   WFLAGSJHP.IN,
      'INCLUDE'   REGSJHP.IN,
      'INCLUDE'   STKDEFA.IN,
      'INCLUDE'   STKDEFB.IN,
      'INCLUDE'   RMCOMJHP.IN,P
      INTEGER     FUNC,   REG,    AUX
      INTEGER     SRREG,  SRX,    CREG,   CTREG,  FREECT, MAXCT
      INTEGER     RET,    SRRET,  ACX,    PASS
      INTEGER     STINS (3),      AC (11, 5)
      EQUIVALENCE (ACADDR, AC)
      DATA        STINS / 133, ^     // STA ZP
                          134, ^     // STX ZP
                          132 /      // STY ZP
C     SWITCH ON FUNCTION CODE
      ASSIGN 1 TO RET
      FREECT = AUX                   // FREE REGISTER COUNT FOR CTFREE
      GO TO ( 100, ^  // ERASE ALL REGISTER CONTENTS
              200, ^  // ERASE SPECIFIC REGISTER CONTENTS
              300, ^  // ERASE STATUS OF ALL REGISTERS
              400, ^  // TRANSFER REGISTER TO REGISTER
              500, ^  // TEMP STORE
              600, ^  // FIND FREE CT
              700  ^  // SET CONTENTS FROM STACK
         ), FUNC
C     COMMON EXIT
1     RETURN
      'EJECT'
C     ERASE ALL REGISTER CONTENTS
100   CALL SET (0, ACADDR, 11)
      GO TO 1
C     ERASE SPECIFIC REGISTER CONTENTS
200   ACADDR (REG) = 0
      GO TO 1
C     ERASE ACTIVE STATUS OF ALL REGISTERS
300   CALL SET (0, STATUS, NRREGS)
      ACTHI = 0
      ACTLO = 0
      GO TO 1
C     REGISTER/REGISTER TRANSFER
C
C     CALL REGMAN (TRAREG, REGIN, REGOUT)

400   'IF' (AUX .EQ. YREG .AND. BIAS (REG) .NE. 0)
         ACADDR (YREG) = 0
         'ELSE'
         'DOLOOP' ACX = 1, 5
            AC (AUX, ACX) = AC (REG, ACX)
            'END'
         'ENDIF'
C     SET NZREG TO OUTREG
      ACADDR (NZREG) = REGS (AUX)
      'DOLOOP' ACX = 2, 5
         AC (NZREG, ACX) = 0
         'END'
      CALL DUMST ('REG4')
      GO TO RET
      'EJECT'
C     DO TEMP STORE IF REGISTER IS ACTIVE
500   SRREG = REG
C     CHECK FOR ACTIVE
      SRX = STATUS (SRREG)
      'IF' ( SRX .NE. 0 )
C        REGISTER IS ACTIVE
         CALL DUMST ('REG5')
         FREECT = 1            // ALWAYS NEED 1 CT
         'IF' (MODE (SRX) .EQ. SPMODE)
C           GET A COMPILER TEMP
            ASSIGN 520 TO RET
            GO TO 600
520         CALL BLDOP (STINS (SRREG), WF5, 0, REGS (CREG), WF7)
            'ELSE'
C           DOUBLE AREG SAVE
            'IF' (ACTHI .GT. YREG)
C              HI IS IN CT; STAZP CTN (LOW)
               CREG = ACTHI
               CTREG = REGS (CREG)
               CALL BLDOP (STINS (ACTLO), WF5, 0, CTREG, WF7)
               'ELSE'
               'IF' (ACTLO .GT. YREG)
C                 LOW IS IN CT; STAZP CTN+1 (HI)
                  CREG = ACTLO
                  CTREG= REGS (CREG)
                  CALL BLDOP (STINS (ACTHI), WF5, 1, CTREG, WF7)
                  'ELSE'
C                 IN AREG/XREG GET NEW CT
                  ASSIGN 530 TO RET
                  GO TO 600
530               CALL BLDOP (STINS (ACTLO), WF5, 0, CTREG, WF7)
                  CALL BLDOP (STINS (ACTHI), WF5, 1, CTREG, WF7)
                  STATUS (XREG) = 0
                  'ENDIF'
               'ENDIF'
            ACTHI = 0
            ACTLO = 0
            'ENDIF'
         STATUS (SRREG) = 0
         STATUS (CREG) = SRX
         NAMEX (SRX) = CTREG
         AUX = CREG
         ASSIGN 540 TO RET
         GO TO 400           // SET THE CONTENTS OF THE CT REGISTER
         'ENDIF'
540   ACADDR (SRREG) = 0
      GO TO 1
      'EJECT'
C     FIND EMPTY SPACE IN CT
C     MAKE TWO PASSES
C        1. STATUS = 0 AND CONTENTS = 0
C        2. STATUS = 0
C
600   MAXCT = NRREGS + 1 - FREECT
      'DOLOOP' PASS = 1, 2
         'DOLOOP' CREG = 4, MAXCT
            'IF' (STATUS (CREG) .EQ. 0 ^
               .AND. (PASS .EQ. 2 .OR. ACADDR (CREG) .EQ. 0))
               'IF' (FREECT .EQ. 2 .AND. STATUS (CREG+1) .NE. 0)
C                 NOT A FREE PAIR, KEEP LOOKING
                  'NEXT'
                  'ENDIF'
               IF (FUNC .EQ. 6) REG = CREG   // RETURN IT TO CALLER
               CTREG = REGS (CREG)
               GO TO RET
               'ENDIF'
            'END'
         'END'
      CALL FATAL (69)
      GO TO RET

C     SET REGISTER CONTENTS FROM STACK
C
C     CALL REGMAN (SETREG, REG, STACKX)

700   IF (AUX .NE. 0) ^
         CALL REGSRC (6, NAMEX (AUX), MODE (AUX), ^
                         SUBX  (AUX), SUBXM (AUX),^
                         BIAS (AUX),  REG)
      GO TO 1
      END