From 67a402e25d3707ce4e031e809b874f8341032d23 Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Wed, 6 Sep 2000 10:23:52 +0000
Subject: [PATCH] [project @ 2000-09-06 10:23:52 by simonmar] Add new PrimRep,
 namely PrimPtrRep, as a catch-all for the various boxed
 primitive types that currently don't have their own
 PrimReps. Use this for MVar# and MutVar#.  This fixes a
 crash in the code generator when a function returns one of
 these types.

---
 ghc/compiler/absCSyn/PprAbsC.lhs    |    1 +
 ghc/compiler/codeGen/CgRetConv.lhs  |    3 ++-
 ghc/compiler/nativeGen/MachMisc.lhs |    1 +
 ghc/compiler/prelude/PrimRep.lhs    |    7 +++++++
 ghc/compiler/prelude/TysPrim.lhs    |    6 +++---
 5 files changed, 14 insertions(+), 4 deletions(-)

diff --git a/ghc/compiler/absCSyn/PprAbsC.lhs b/ghc/compiler/absCSyn/PprAbsC.lhs
index 82431ab..01952d4 100644
--- a/ghc/compiler/absCSyn/PprAbsC.lhs
+++ b/ghc/compiler/absCSyn/PprAbsC.lhs
@@ -1300,6 +1300,7 @@ pprUnionTag StablePtrRep	= char 'p'
 pprUnionTag StableNameRep	= char 'p'
 pprUnionTag WeakPtrRep		= char 'p'
 pprUnionTag ForeignObjRep	= char 'p'
+pprUnionTag PrimPtrRep		= char 'p'
 
 pprUnionTag ThreadIdRep		= char 't'
 
diff --git a/ghc/compiler/codeGen/CgRetConv.lhs b/ghc/compiler/codeGen/CgRetConv.lhs
index 4c0151e..fa7215b 100644
--- a/ghc/compiler/codeGen/CgRetConv.lhs
+++ b/ghc/compiler/codeGen/CgRetConv.lhs
@@ -1,7 +1,7 @@
 %
 % (c) The GRASP Project, Glasgow University, 1992-1998
 %
-% $Id: CgRetConv.lhs,v 1.24 2000/08/07 23:37:20 qrczak Exp $
+% $Id: CgRetConv.lhs,v 1.25 2000/09/06 10:23:52 simonmar Exp $
 %
 \section[CgRetConv]{Return conventions for the code generator}
 
@@ -89,6 +89,7 @@ dataReturnConvPrim VoidRep	= VoidReg
 -- Return a primitive-array pointer in the usual register:
 dataReturnConvPrim ArrayRep     = VanillaReg ArrayRep ILIT(1)
 dataReturnConvPrim ByteArrayRep = VanillaReg ByteArrayRep ILIT(1)
+dataReturnConvPrim PrimPtrRep   = VanillaReg PrimPtrRep ILIT(1)
 
 dataReturnConvPrim StablePtrRep = VanillaReg StablePtrRep ILIT(1)
 dataReturnConvPrim ForeignObjRep = VanillaReg ForeignObjRep ILIT(1)
diff --git a/ghc/compiler/nativeGen/MachMisc.lhs b/ghc/compiler/nativeGen/MachMisc.lhs
index 213da00..00462da 100644
--- a/ghc/compiler/nativeGen/MachMisc.lhs
+++ b/ghc/compiler/nativeGen/MachMisc.lhs
@@ -283,6 +283,7 @@ primRepToSize FloatRep	    = IF_ARCH_alpha( TF, IF_ARCH_i386( F, IF_ARCH_sparc(
 primRepToSize DoubleRep	    = IF_ARCH_alpha( TF, IF_ARCH_i386( DF,IF_ARCH_sparc( DF,)))
 primRepToSize ArrayRep	    = IF_ARCH_alpha( Q,	 IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
 primRepToSize ByteArrayRep  = IF_ARCH_alpha( Q,	 IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
+primRepToSize PrimPtrRep    = IF_ARCH_alpha( Q,	 IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
 primRepToSize WeakPtrRep    = IF_ARCH_alpha( Q,	 IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
 primRepToSize ForeignObjRep = IF_ARCH_alpha( Q,  IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
 primRepToSize BCORep        = IF_ARCH_alpha( Q,  IF_ARCH_i386( L, IF_ARCH_sparc( W ,)))
diff --git a/ghc/compiler/prelude/PrimRep.lhs b/ghc/compiler/prelude/PrimRep.lhs
index 2a84114..ab6fdc4 100644
--- a/ghc/compiler/prelude/PrimRep.lhs
+++ b/ghc/compiler/prelude/PrimRep.lhs
@@ -78,6 +78,11 @@ data PrimRep
   | ArrayRep		-- Primitive array of Haskell pointers
   | ByteArrayRep	-- Primitive array of bytes (no Haskell pointers)
 
+  | PrimPtrRep		-- Used for MutVars and MVars; 
+			-- a pointer to a primitive object
+			-- ToDo: subsumes WeakPtrRep, ThreadIdRep, 
+			-- StableNameRep, ForeignObjRep, and BCORep ?
+
   | VoidRep		-- Occupies no space at all!
 			-- (Primitive states are mapped onto this)
   deriving (Eq, Ord)
@@ -117,6 +122,7 @@ isFollowableRep ByteArrayRep  = True	-- 	''
 isFollowableRep WeakPtrRep    = True	-- 	''
 isFollowableRep ForeignObjRep = True	-- 	''
 isFollowableRep StableNameRep = True    --      ''
+isFollowableRep PrimPtrRep    = True    --      ''
 isFollowableRep ThreadIdRep   = True	-- pointer to a TSO
 
 isFollowableRep other	      = False
@@ -227,6 +233,7 @@ showPrimRep AddrRep	   = "StgAddr"
 showPrimRep FloatRep	   = "StgFloat"
 showPrimRep DoubleRep	   = "StgDouble"
 showPrimRep ArrayRep	   = "P_" -- see comment below
+showPrimRep PrimPtrRep	   = "P_"
 showPrimRep ByteArrayRep   = "StgByteArray"
 showPrimRep StablePtrRep   = "StgStablePtr"
 showPrimRep StableNameRep  = "P_"
diff --git a/ghc/compiler/prelude/TysPrim.lhs b/ghc/compiler/prelude/TysPrim.lhs
index 4be0716..918b8c3 100644
--- a/ghc/compiler/prelude/TysPrim.lhs
+++ b/ghc/compiler/prelude/TysPrim.lhs
@@ -165,7 +165,7 @@ system, to parameterise State#.
 
 \begin{code}
 realWorldTy	     = mkTyConTy realWorldTyCon
-realWorldTyCon	     = pcPrimTyCon realWorldTyConKey SLIT("RealWorld") 0 [] PtrRep
+realWorldTyCon	     = pcPrimTyCon realWorldTyConKey SLIT("RealWorld") 0 [] PrimPtrRep
 realWorldStatePrimTy = mkStatePrimTy realWorldTy	-- State# RealWorld
 \end{code}
 
@@ -204,7 +204,7 @@ mkMutableByteArrayPrimTy s  = mkTyConApp mutableByteArrayPrimTyCon [s]
 
 \begin{code}
 mutVarPrimTyCon = pcPrimTyCon mutVarPrimTyConKey SLIT("MutVar#")
-                              2 vrcsZP PtrRep
+                              2 vrcsZP PrimPtrRep
 
 mkMutVarPrimTy s elt 	    = mkTyConApp mutVarPrimTyCon [s, elt]
 \end{code}
@@ -217,7 +217,7 @@ mkMutVarPrimTy s elt 	    = mkTyConApp mutVarPrimTyCon [s, elt]
 
 \begin{code}
 mVarPrimTyCon = pcPrimTyCon mVarPrimTyConKey SLIT("MVar#")
-                            2 vrcsZP PtrRep
+                            2 vrcsZP PrimPtrRep
 
 mkMVarPrimTy s elt 	    = mkTyConApp mVarPrimTyCon [s, elt]
 \end{code}
-- 
1.7.10.4