[project @ 2000-03-17 12:40:03 by simonmar]

Add the readBlahOffAddr suite of primitives.  The previous method of
using indexStuffOffAddr didn't enforce proper ordering in the I/O
monad.

The indexBlahOffAddr primops may go away in the future if/when we
figure out how to make unsafePerformIO into a no-op at the back end.

diff --git a/ghc/compiler/nativeGen/StixPrim.lhs b/ghc/compiler/nativeGen/StixPrim.lhs
index 945b73b..e718379 100644 (file)
--- a/ghc/compiler/nativeGen/StixPrim.lhs
+++ b/ghc/compiler/nativeGen/StixPrim.lhs
@@ -178,6 +178,9 @@ primCode [lhs] (ReadByteArrayOp pk) [obj, ix]
     in
     returnUs (\xs -> assign : xs)
 
+primCode lhs@[_] (ReadOffAddrOp pk) args
+  = primCode lhs (IndexOffAddrOp pk) args
+
 primCode [lhs] (IndexOffAddrOp pk) [obj, ix]
   = let
        lhs' = amodeToStix lhs

diff --git a/ghc/compiler/prelude/PrimOp.lhs b/ghc/compiler/prelude/PrimOp.lhs
index 7be5595..1db8757 100644 (file)
--- a/ghc/compiler/prelude/PrimOp.lhs
+++ b/ghc/compiler/prelude/PrimOp.lhs
@@ -148,9 +148,11 @@ data PrimOp
     | ReadByteArrayOp  PrimRep
     | WriteByteArrayOp PrimRep
     | IndexByteArrayOp PrimRep
-    | IndexOffAddrOp   PrimRep
+    | ReadOffAddrOp    PrimRep
     | WriteOffAddrOp    PrimRep
-       -- PrimRep can be one of {Char,Int,Addr,Float,Double}Kind.
+    | IndexOffAddrOp   PrimRep
+       -- PrimRep can be one of :
+       --      {Char,Int,Word,Addr,Float,Double,StablePtr,Int64,Word64}Rep.
        -- This is just a cheesy encoding of a bunch of ops.
        -- Note that ForeignObjRep is not included -- the only way of
        -- creating a ForeignObj is with a ccall or casm.
@@ -499,66 +501,76 @@ tagOf_PrimOp (IndexOffForeignObjOp DoubleRep) = ILIT(187)
 tagOf_PrimOp (IndexOffForeignObjOp StablePtrRep) = ILIT(188)
 tagOf_PrimOp (IndexOffForeignObjOp Int64Rep)  = ILIT(189)
 tagOf_PrimOp (IndexOffForeignObjOp Word64Rep) = ILIT(190)
-tagOf_PrimOp (WriteOffAddrOp CharRep)         = ILIT(191)
-tagOf_PrimOp (WriteOffAddrOp IntRep)          = ILIT(192)
-tagOf_PrimOp (WriteOffAddrOp WordRep)         = ILIT(193)
-tagOf_PrimOp (WriteOffAddrOp AddrRep)         = ILIT(194)
-tagOf_PrimOp (WriteOffAddrOp FloatRep)        = ILIT(195)
-tagOf_PrimOp (WriteOffAddrOp DoubleRep)       = ILIT(196)
-tagOf_PrimOp (WriteOffAddrOp StablePtrRep)    = ILIT(197)
-tagOf_PrimOp (WriteOffAddrOp ForeignObjRep)   = ILIT(198)
-tagOf_PrimOp (WriteOffAddrOp Int64Rep)        = ILIT(199)
-tagOf_PrimOp (WriteOffAddrOp Word64Rep)       = ILIT(200)
-tagOf_PrimOp UnsafeFreezeArrayOp             = ILIT(201)
-tagOf_PrimOp UnsafeFreezeByteArrayOp         = ILIT(202)
-tagOf_PrimOp UnsafeThawArrayOp               = ILIT(203)
-tagOf_PrimOp SizeofByteArrayOp               = ILIT(205)
-tagOf_PrimOp SizeofMutableByteArrayOp        = ILIT(206)
-tagOf_PrimOp NewMVarOp                       = ILIT(207)
-tagOf_PrimOp TakeMVarOp                              = ILIT(208)
-tagOf_PrimOp PutMVarOp                       = ILIT(209)
-tagOf_PrimOp SameMVarOp                              = ILIT(210)
-tagOf_PrimOp IsEmptyMVarOp                   = ILIT(211)
-tagOf_PrimOp MakeForeignObjOp                = ILIT(212)
-tagOf_PrimOp WriteForeignObjOp               = ILIT(213)
-tagOf_PrimOp MkWeakOp                        = ILIT(214)
-tagOf_PrimOp DeRefWeakOp                     = ILIT(215)
-tagOf_PrimOp FinalizeWeakOp                  = ILIT(216)
-tagOf_PrimOp MakeStableNameOp                = ILIT(217)
-tagOf_PrimOp EqStableNameOp                  = ILIT(218)
-tagOf_PrimOp StableNameToIntOp               = ILIT(219)
-tagOf_PrimOp MakeStablePtrOp                 = ILIT(220)
-tagOf_PrimOp DeRefStablePtrOp                = ILIT(221)
-tagOf_PrimOp EqStablePtrOp                   = ILIT(222)
-tagOf_PrimOp (CCallOp _ _ _ _)               = ILIT(223)
-tagOf_PrimOp ReallyUnsafePtrEqualityOp       = ILIT(224)
-tagOf_PrimOp SeqOp                           = ILIT(225)
-tagOf_PrimOp ParOp                           = ILIT(226)
-tagOf_PrimOp ForkOp                          = ILIT(227)
-tagOf_PrimOp KillThreadOp                    = ILIT(228)
-tagOf_PrimOp YieldOp                         = ILIT(229)
-tagOf_PrimOp MyThreadIdOp                    = ILIT(230)
-tagOf_PrimOp DelayOp                         = ILIT(231)
-tagOf_PrimOp WaitReadOp                              = ILIT(232)
-tagOf_PrimOp WaitWriteOp                     = ILIT(233)
-tagOf_PrimOp ParGlobalOp                     = ILIT(234)
-tagOf_PrimOp ParLocalOp                              = ILIT(235)
-tagOf_PrimOp ParAtOp                         = ILIT(236)
-tagOf_PrimOp ParAtAbsOp                              = ILIT(237)
-tagOf_PrimOp ParAtRelOp                              = ILIT(238)
-tagOf_PrimOp ParAtForNowOp                   = ILIT(239)
-tagOf_PrimOp CopyableOp                              = ILIT(240)
-tagOf_PrimOp NoFollowOp                              = ILIT(241)
-tagOf_PrimOp NewMutVarOp                     = ILIT(242)
-tagOf_PrimOp ReadMutVarOp                    = ILIT(243)
-tagOf_PrimOp WriteMutVarOp                   = ILIT(244)
-tagOf_PrimOp SameMutVarOp                    = ILIT(245)
-tagOf_PrimOp CatchOp                         = ILIT(246)
-tagOf_PrimOp RaiseOp                         = ILIT(247)
-tagOf_PrimOp BlockAsyncExceptionsOp          = ILIT(248)
-tagOf_PrimOp UnblockAsyncExceptionsOp        = ILIT(249)
-tagOf_PrimOp DataToTagOp                     = ILIT(250)
-tagOf_PrimOp TagToEnumOp                     = ILIT(251)
+tagOf_PrimOp (ReadOffAddrOp CharRep)          = ILIT(191)
+tagOf_PrimOp (ReadOffAddrOp IntRep)           = ILIT(192)
+tagOf_PrimOp (ReadOffAddrOp WordRep)          = ILIT(193)
+tagOf_PrimOp (ReadOffAddrOp AddrRep)          = ILIT(194)
+tagOf_PrimOp (ReadOffAddrOp FloatRep)         = ILIT(195)
+tagOf_PrimOp (ReadOffAddrOp DoubleRep)        = ILIT(196)
+tagOf_PrimOp (ReadOffAddrOp StablePtrRep)     = ILIT(197)
+tagOf_PrimOp (ReadOffAddrOp ForeignObjRep)    = ILIT(198)
+tagOf_PrimOp (ReadOffAddrOp Int64Rep)         = ILIT(199)
+tagOf_PrimOp (ReadOffAddrOp Word64Rep)        = ILIT(200)
+tagOf_PrimOp (WriteOffAddrOp CharRep)         = ILIT(201)
+tagOf_PrimOp (WriteOffAddrOp IntRep)          = ILIT(202)
+tagOf_PrimOp (WriteOffAddrOp WordRep)         = ILIT(203)
+tagOf_PrimOp (WriteOffAddrOp AddrRep)         = ILIT(205)
+tagOf_PrimOp (WriteOffAddrOp FloatRep)        = ILIT(206)
+tagOf_PrimOp (WriteOffAddrOp DoubleRep)       = ILIT(207)
+tagOf_PrimOp (WriteOffAddrOp StablePtrRep)    = ILIT(208)
+tagOf_PrimOp (WriteOffAddrOp ForeignObjRep)   = ILIT(209)
+tagOf_PrimOp (WriteOffAddrOp Int64Rep)        = ILIT(210)
+tagOf_PrimOp (WriteOffAddrOp Word64Rep)       = ILIT(211)
+tagOf_PrimOp UnsafeFreezeArrayOp             = ILIT(212)
+tagOf_PrimOp UnsafeFreezeByteArrayOp         = ILIT(213)
+tagOf_PrimOp UnsafeThawArrayOp               = ILIT(214)
+tagOf_PrimOp SizeofByteArrayOp               = ILIT(215)
+tagOf_PrimOp SizeofMutableByteArrayOp        = ILIT(216)
+tagOf_PrimOp NewMVarOp                       = ILIT(217)
+tagOf_PrimOp TakeMVarOp                              = ILIT(218)
+tagOf_PrimOp PutMVarOp                       = ILIT(219)
+tagOf_PrimOp SameMVarOp                              = ILIT(220)
+tagOf_PrimOp IsEmptyMVarOp                   = ILIT(221)
+tagOf_PrimOp MakeForeignObjOp                = ILIT(222)
+tagOf_PrimOp WriteForeignObjOp               = ILIT(223)
+tagOf_PrimOp MkWeakOp                        = ILIT(224)
+tagOf_PrimOp DeRefWeakOp                     = ILIT(225)
+tagOf_PrimOp FinalizeWeakOp                  = ILIT(226)
+tagOf_PrimOp MakeStableNameOp                = ILIT(227)
+tagOf_PrimOp EqStableNameOp                  = ILIT(228)
+tagOf_PrimOp StableNameToIntOp               = ILIT(229)
+tagOf_PrimOp MakeStablePtrOp                 = ILIT(230)
+tagOf_PrimOp DeRefStablePtrOp                = ILIT(231)
+tagOf_PrimOp EqStablePtrOp                   = ILIT(232)
+tagOf_PrimOp (CCallOp _ _ _ _)               = ILIT(233)
+tagOf_PrimOp ReallyUnsafePtrEqualityOp       = ILIT(234)
+tagOf_PrimOp SeqOp                           = ILIT(235)
+tagOf_PrimOp ParOp                           = ILIT(236)
+tagOf_PrimOp ForkOp                          = ILIT(237)
+tagOf_PrimOp KillThreadOp                    = ILIT(238)
+tagOf_PrimOp YieldOp                         = ILIT(239)
+tagOf_PrimOp MyThreadIdOp                    = ILIT(240)
+tagOf_PrimOp DelayOp                         = ILIT(241)
+tagOf_PrimOp WaitReadOp                              = ILIT(242)
+tagOf_PrimOp WaitWriteOp                     = ILIT(243)
+tagOf_PrimOp ParGlobalOp                     = ILIT(244)
+tagOf_PrimOp ParLocalOp                              = ILIT(245)
+tagOf_PrimOp ParAtOp                         = ILIT(246)
+tagOf_PrimOp ParAtAbsOp                              = ILIT(247)
+tagOf_PrimOp ParAtRelOp                              = ILIT(248)
+tagOf_PrimOp ParAtForNowOp                   = ILIT(249)
+tagOf_PrimOp CopyableOp                              = ILIT(250)
+tagOf_PrimOp NoFollowOp                              = ILIT(251)
+tagOf_PrimOp NewMutVarOp                     = ILIT(252)
+tagOf_PrimOp ReadMutVarOp                    = ILIT(253)
+tagOf_PrimOp WriteMutVarOp                   = ILIT(254)
+tagOf_PrimOp SameMutVarOp                    = ILIT(255)
+tagOf_PrimOp CatchOp                         = ILIT(256)
+tagOf_PrimOp RaiseOp                         = ILIT(257)
+tagOf_PrimOp BlockAsyncExceptionsOp          = ILIT(258)
+tagOf_PrimOp UnblockAsyncExceptionsOp        = ILIT(259)
+tagOf_PrimOp DataToTagOp                     = ILIT(260)
+tagOf_PrimOp TagToEnumOp                     = ILIT(261)
 
 tagOf_PrimOp op = pprPanic# "tagOf_PrimOp: pattern-match" (ppr op)
 --panic# "tagOf_PrimOp: pattern-match"
@@ -773,6 +785,16 @@ allThePrimOps
        IndexOffAddrOp StablePtrRep,
        IndexOffAddrOp Int64Rep,
        IndexOffAddrOp Word64Rep,
+       ReadOffAddrOp CharRep,
+       ReadOffAddrOp IntRep,
+       ReadOffAddrOp WordRep,
+       ReadOffAddrOp AddrRep,
+       ReadOffAddrOp FloatRep,
+       ReadOffAddrOp DoubleRep,
+       ReadOffAddrOp ForeignObjRep,
+       ReadOffAddrOp StablePtrRep,
+       ReadOffAddrOp Int64Rep,
+       ReadOffAddrOp Word64Rep,
        WriteOffAddrOp CharRep,
        WriteOffAddrOp IntRep,
        WriteOffAddrOp WordRep,
@@ -1363,6 +1385,17 @@ primOpInfo (IndexOffAddrOp kind)
     in
     mkGenPrimOp op_str tvs [addrPrimTy, intPrimTy] prim_ty
 
+primOpInfo (ReadOffAddrOp kind)
+  = let
+       s = alphaTy; s_tv = alphaTyVar
+       op_str = _PK_ ("read" ++ primRepString kind ++ "OffAddr#")
+        (tvs, prim_ty) = mkPrimTyApp betaTyVars kind
+       state          = mkStatePrimTy s
+    in
+    mkGenPrimOp op_str (s_tv:tvs)
+       [addrPrimTy, intPrimTy, state]
+       (unboxedPair [state, prim_ty])
+
 primOpInfo (WriteOffAddrOp kind)
   = let
        s = alphaTy; s_tv = alphaTyVar

diff --git a/ghc/includes/PrimOps.h b/ghc/includes/PrimOps.h
index 1ce766d..a436ee6 100644 (file)
--- a/ghc/includes/PrimOps.h
+++ b/ghc/includes/PrimOps.h
@@ -1,5 +1,5 @@
 /* -----------------------------------------------------------------------------
- * $Id: PrimOps.h,v 1.46 2000/03/13 12:11:43 simonmar Exp $
+ * $Id: PrimOps.h,v 1.47 2000/03/17 12:40:03 simonmar Exp $
  *
  * (c) The GHC Team, 1998-1999
  *
@@ -221,15 +221,16 @@ typedef union {
 #define int2Addrzh(r,a)        r=(A_)(a)
 #define addr2Intzh(r,a)        r=(I_)(a)
 
-#define indexCharOffAddrzh(r,a,i)   r= ((C_ *)(a))[i]
-#define indexIntOffAddrzh(r,a,i)    r= ((I_ *)(a))[i]
-#define indexAddrOffAddrzh(r,a,i)   r= ((PP_)(a))[i]
-#define indexFloatOffAddrzh(r,a,i)  r= PK_FLT((P_) (((StgFloat *)(a)) + i))
-#define indexDoubleOffAddrzh(r,a,i) r= PK_DBL((P_) (((StgDouble *)(a)) + i))
-#define indexStablePtrOffAddrzh(r,a,i)    r= ((StgStablePtr *)(a))[i]
+#define readCharOffAddrzh(r,a,i)       r= ((C_ *)(a))[i]
+#define readIntOffAddrzh(r,a,i)        r= ((I_ *)(a))[i]
+#define readWordOffAddrzh(r,a,i)       r= ((W_ *)(a))[i]
+#define readAddrOffAddrzh(r,a,i)       r= ((PP_)(a))[i]
+#define readFloatOffAddrzh(r,a,i)      r= PK_FLT((P_) (((StgFloat *)(a)) + i))
+#define readDoubleOffAddrzh(r,a,i)     r= PK_DBL((P_) (((StgDouble *)(a)) + i))
+#define readStablePtrOffAddrzh(r,a,i)   r= ((StgStablePtr *)(a))[i]
 #ifdef SUPPORT_LONG_LONGS
-#define indexInt64OffAddrzh(r,a,i)  r= ((LI_ *)(a))[i]
-#define indexWord64OffAddrzh(r,a,i) r= ((LW_ *)(a))[i]
+#define readInt64OffAddrzh(r,a,i)      r= ((LI_ *)(a))[i]
+#define readWord64OffAddrzh(r,a,i)     r= ((LW_ *)(a))[i]
 #endif
 
 #define writeCharOffAddrzh(a,i,v)       ((C_ *)(a))[i] = (v)
@@ -245,6 +246,18 @@ typedef union {
 #define writeWord64OffAddrzh(a,i,v)  ((LW_ *)(a))[i] = (v)
 #endif
 
+#define indexCharOffAddrzh(r,a,i)      r= ((C_ *)(a))[i]
+#define indexIntOffAddrzh(r,a,i)       r= ((I_ *)(a))[i]
+#define indexWordOffAddrzh(r,a,i)      r= ((W_ *)(a))[i]
+#define indexAddrOffAddrzh(r,a,i)      r= ((PP_)(a))[i]
+#define indexFloatOffAddrzh(r,a,i)     r= PK_FLT((P_) (((StgFloat *)(a)) + i))
+#define indexDoubleOffAddrzh(r,a,i)    r= PK_DBL((P_) (((StgDouble *)(a)) + i))
+#define indexStablePtrOffAddrzh(r,a,i)  r= ((StgStablePtr *)(a))[i]
+#ifdef SUPPORT_LONG_LONGS
+#define indexInt64OffAddrzh(r,a,i)     r= ((LI_ *)(a))[i]
+#define indexWord64OffAddrzh(r,a,i)    r= ((LW_ *)(a))[i]
+#endif
+
 /* -----------------------------------------------------------------------------
    Float PrimOps.
    -------------------------------------------------------------------------- */
@@ -560,29 +573,6 @@ extern I_ resetGenSymZh(void);
 #define indexWord64Arrayzh(r,a,i) indexWord64OffAddrzh(r,BYTE_ARR_CTS(a),i)
 #endif
 
-#define indexCharOffForeignObjzh(r,fo,i)   indexCharOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
-#define indexIntOffForeignObjzh(r,fo,i)    indexIntOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
-#define indexWordOffForeignObjzh(r,fo,i)   indexWordOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
-#define indexAddrOffForeignObjzh(r,fo,i)   indexAddrOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
-#define indexFloatOffForeignObjzh(r,fo,i)  indexFloatOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
-#define indexDoubleOffForeignObjzh(r,fo,i) indexDoubleOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
-#define indexStablePtrOffForeignObjzh(r,fo,i)  indexStablePtrOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
-#ifdef SUPPORT_LONG_LONGS
-#define indexInt64OffForeignObjzh(r,fo,i)  indexInt64OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
-#define indexWord64OffForeignObjzh(r,fo,i) indexWord64OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
-#endif
-
-#define indexCharOffAddrzh(r,a,i)   r= ((C_ *)(a))[i]
-#define indexIntOffAddrzh(r,a,i)    r= ((I_ *)(a))[i]
-#define indexWordOffAddrzh(r,a,i)   r= ((W_ *)(a))[i]
-#define indexAddrOffAddrzh(r,a,i)   r= ((PP_)(a))[i]
-#define indexFloatOffAddrzh(r,a,i)  r= PK_FLT((P_) (((StgFloat *)(a)) + i))
-#define indexDoubleOffAddrzh(r,a,i) r= PK_DBL((P_) (((StgDouble *)(a)) + i))
-#ifdef SUPPORT_LONG_LONGS
-#define indexInt64OffAddrzh(r,a,i)  r= ((LI_ *)(a))[i]
-#define indexWord64OffAddrzh(r,a,i) r= ((LW_ *)(a))[i]
-#endif
-
 /* Freezing arrays-of-ptrs requires changing an info table, for the
    benefit of the generational collector.  It needs to scavenge mutable
    objects, even if they are in old space.  When they become immutable,
@@ -864,6 +854,18 @@ EF_(makeForeignObjzh_fast);
 
 #define eqForeignObj(f1,f2)  ((f1)==(f2))
 
+#define indexCharOffForeignObjzh(r,fo,i)   indexCharOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#define indexIntOffForeignObjzh(r,fo,i)    indexIntOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#define indexWordOffForeignObjzh(r,fo,i)   indexWordOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#define indexAddrOffForeignObjzh(r,fo,i)   indexAddrOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#define indexFloatOffForeignObjzh(r,fo,i)  indexFloatOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#define indexDoubleOffForeignObjzh(r,fo,i) indexDoubleOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#define indexStablePtrOffForeignObjzh(r,fo,i)  indexStablePtrOffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#ifdef SUPPORT_LONG_LONGS
+#define indexInt64OffForeignObjzh(r,fo,i)  indexInt64OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#define indexWord64OffForeignObjzh(r,fo,i) indexWord64OffAddrzh(r,ForeignObj_CLOSURE_DATA(fo),i)
+#endif
+
 #endif
 
 /* -----------------------------------------------------------------------------

diff --git a/ghc/lib/std/PrelGHC.hi-boot b/ghc/lib/std/PrelGHC.hi-boot
index 94075d6..440f4ac 100644 (file)
--- a/ghc/lib/std/PrelGHC.hi-boot
+++ b/ghc/lib/std/PrelGHC.hi-boot
@@ -247,6 +247,17 @@ __export PrelGHC
   indexInt64OffAddrzh
   indexWord64OffAddrzh
   
+  readCharOffAddrzh
+  readIntOffAddrzh
+  readWordOffAddrzh
+  readAddrOffAddrzh
+  readForeignObjOffAddrzh
+  readFloatOffAddrzh
+  readDoubleOffAddrzh
+  readStablePtrOffAddrzh
+  readInt64OffAddrzh
+  readWord64OffAddrzh
+
   writeCharOffAddrzh
   writeIntOffAddrzh
   writeWordOffAddrzh