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 82431ab1e20d..01952d419b0b 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 4c0151e20577..fa7215b30d76 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 213da0048d45..00462dab620f 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 2a84114ffb86..ab6fdc4f3961 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 4be07160c27b..918b8c3e34ce 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}
--
GitLab