Upload

Digital Research

ASSEMBLY & COMPILE TOOLS/PLM VAX COMPILER/plmvax/regs.for

@@ -0,0 +1,139 @@
+C***********************************************************************
+C
+C				REGS.FOR
+C
+C
+C		D I S C L A I M E R   N O T I C E		      
+C		-------------------   -----------
+C
+C  This document and/or portions of the material and data furnished
+C  herewith, was developed under sponsorship of the U. S. Government.
+C  Neither the U.S. nor the U.S.D.O.E., nor the Leland Stanford Junior
+C  University, nor their employees, nor their respective contractors,
+C  subcontractors, or their employees, makes any warranty, express or
+C  implied, or assumes any liability or responsibility for accuracy,
+C  completeness or usefulness of any information, apparatus, product
+C  or process disclosed, or represents that its use will not infringe
+C  privately-owned rights.  Mention of any product, its manufacturer,
+C  or suppliers shall not, nor is it intended to, imply approval, dis-
+C  approval, or fitness for any particular use.  The U. S. and the
+C  University at all times retain the right to use and disseminate same
+C  for any purpose whatsoever.  Such distribution shall be made by the
+C  National Energy Software Center at the Argonne National Laboratory
+C  and only subject to the distributee furnishing satisfactory proof
+C  that he has a valid license from the Intel Corporation in effect.
+C
+C-----------------------------------------------------------------------
+C
+C    This module of the PL/M-VAX compiler contains routines to manage
+C    register allocation and preservation.
+C
+C-----------------------------------------------------------------------
+C
+C    15OCT81  Alex Hunter  1. Experimental version. (V54.)
+C    14NOV81  Alex Hunter  1. If LARGE OVERLAY, then add R12 to
+C			      register pool. (V6.2)
+C
+C-----------------------------------------------------------------------
+      INTEGER*2 FUNCTION ALLOCATE_REG_WITH_PREFERENCE(TYPE,POSSIBLE_REG)
+      INCLUDE 'PLMCOM.FOR/NOLIST'
+      INTEGER*4 LAST_REG,FIRST_REG,R
+      LOGICAL*4 AVAILABLE(1:16)
+ 
+      R = POSSIBLE_REG
+ 
+C------- First try to allocate the preferred register.
+ 
+      IF (REGISTER(R) .AND. AVAILABLE(R) .AND.
+     #    (BYTE_SIZE(TYPE).LE.4 .OR. AVAILABLE(R+1))) GO TO 10
+ 
+C------- Otherwise, use the normal allocation algorithm.
+ 
+C---------------------------------------------
+      ENTRY ALLOCATE_REG(TYPE)
+C---------------------------------------------
+      DO R = LAST_REG-1, FIRST_REG, -1
+         IF (AVAILABLE(R) .AND.
+     #       (BYTE_SIZE(TYPE).LE.4 .OR. AVAILABLE(R+1))) GO TO 10
+      ENDDO
+ 
+      CALL ERROR('REGISTER POOL EXHAUSTED')
+      ALLOCATE_REG = LAST_REG-1   ! Just so we can keep compiling.
+      NODE_TYPE(ALLOCATE_REG) = TYPE
+      RETURN
+ 
+C------- Here when we have an available register.
+ 
+10    CONTINUE
+      ALLOCATE_REG = R
+      CALL PRESERVE_REG(R)
+      AVAILABLE(R) = .FALSE.
+      NODE_TYPE(R) = TYPE
+      IF (BYTE_SIZE(TYPE).GT.4) THEN
+         CALL PRESERVE_REG(R+1)
+         AVAILABLE(R+1) = .FALSE.
+         NODE_TYPE(R+1) = TYPE
+      ENDIF
+      RETURN
+C--------------------------------------
+      ENTRY FREE_REGS()
+C--------------------------------------
+      IF (MODEL.EQ.4.AND.OVERLAY_FLAG) THEN
+         LAST_REG=12
+      ELSEIF (MODEL.EQ.2 .OR. MODEL.EQ.4) THEN
+         LAST_REG=11
+      ELSE
+         LAST_REG=10
+      ENDIF
+      FIRST_REG=PROC_AP(PROC_LEVEL)+1
+      DO R=1,LAST_REG
+         AVAILABLE(R) = R.GE.FIRST_REG .AND. R.LT.LAST_REG
+      ENDDO
+      RETURN
+C--------------------------------------
+      ENTRY FREE_REG(REG)
+C--------------------------------------
+      AVAILABLE(REG) = .TRUE.
+      IF (BYTE_SIZE(NODE_TYPE(REG)).GT.4) THEN
+         AVAILABLE(REG+1) = .TRUE.
+      ENDIF
+      RETURN
+      END
+C-------------------------------------------------------
+      SUBROUTINE PRESERVE_REG(REG)
+      INCLUDE 'PLMCOM.FOR/NOLIST'
+ 
+      PROC_ENTRY_MASK(PROC_LEVEL)=PROC_ENTRY_MASK(PROC_LEVEL).OR.
+     #                            ISHFT(1,REG)
+      RETURN
+      END
+C--------------------------------------------------------
+      CHARACTER*40 FUNCTION REGISTER_MASK(MASK)
+      IMPLICIT INTEGER*2 (A-Z)
+      CHARACTER*3 REGNAME(0:15)
+      DATA REGNAME
+     //'R0','R1','R2','R3','R4','R5','R6','R7','R8','R9'
+     ,,'R10','R11','AP','FP','SP','PC'
+     //
+      INTEGER*2 REGLEN(0:15)
+      DATA REGLEN
+     //2,2,2,2,2,2,2,2,2,2,3,3,2,2,2,2/
+ 
+      REGISTER_MASK='^M<'
+      N=4
+ 
+      DO 10 I=0,15
+      IF ((ISHFT(MASK,-I).AND.1).NE.0) THEN
+         IF (N.GT.4) THEN
+            REGISTER_MASK(N:)=','
+            N=N+1
+         ENDIF
+         REGISTER_MASK(N:)=REGNAME(I)
+         N=N+REGLEN(I)
+      ENDIF
+10    CONTINUE
+ 
+      REGISTER_MASK(N:)='>'
+   
+      RETURN
+      END