From e792bb8488aa3c33d7b186abdf53aa8b0ef68b11 Mon Sep 17 00:00:00 2001 From: simonmar Date: Mon, 25 Jul 2005 14:12:51 +0000 Subject: [PATCH] [project @ 2005-07-25 14:12:48 by simonmar] Remove the ForeignObj# type, and all its PrimOps. The new efficient representation of ForeignPtr doesn't use ForeignObj# underneath, and there seems no need to keep it. --- ghc/compiler/codeGen/CgForeignCall.hs | 8 +-- ghc/compiler/codeGen/CgPrimOp.hs | 33 ----------- ghc/compiler/deSugar/DsCCall.lhs | 7 +-- ghc/compiler/deSugar/DsForeign.lhs | 8 +-- ghc/compiler/prelude/TysPrim.lhs | 24 -------- ghc/compiler/prelude/primops.txt.pp | 98 +++------------------------------ ghc/includes/ClosureTypes.h | 33 ++++++----- ghc/includes/Closures.h | 5 -- ghc/includes/StgMiscClosures.h | 4 -- ghc/includes/mkDerivedConstants.c | 3 - ghc/rts/ClosureFlags.c | 3 +- ghc/rts/FrontPanel.c | 1 - ghc/rts/LdvProfile.c | 1 - ghc/rts/Linker.c | 4 -- ghc/rts/PrimOps.cmm | 20 ------- ghc/rts/Printer.c | 6 -- ghc/rts/ProfHeap.c | 2 - ghc/rts/RetainerProfile.c | 4 -- ghc/rts/Sanity.c | 1 - ghc/rts/StgMiscClosures.cmm | 7 --- 20 files changed, 30 insertions(+), 242 deletions(-) diff --git a/ghc/compiler/codeGen/CgForeignCall.hs b/ghc/compiler/codeGen/CgForeignCall.hs index 417c3c5..b1e5037 100644 --- a/ghc/compiler/codeGen/CgForeignCall.hs +++ b/ghc/compiler/codeGen/CgForeignCall.hs @@ -211,15 +211,11 @@ currentNursery = CmmGlobal CurrentNursery -- ----------------------------------------------------------------------------- -- For certain types passed to foreign calls, we adjust the actual --- value passed to the call. Two main cases: for ForeignObj# we pass --- the pointer inside the ForeignObj# closure, and for ByteArray#/Array# we --- pass the address of the actual array, not the address of the heap object. +-- value passed to the call. For ByteArray#/Array# we pass the +-- address of the actual array, not the address of the heap object. shimForeignCallArg :: StgArg -> CmmExpr -> CmmExpr shimForeignCallArg arg expr - | tycon == foreignObjPrimTyCon - = cmmLoadIndexW expr fixedHdrSize - | tycon == arrayPrimTyCon || tycon == mutableArrayPrimTyCon = cmmOffsetB expr arrPtrsHdrSize diff --git a/ghc/compiler/codeGen/CgPrimOp.hs b/ghc/compiler/codeGen/CgPrimOp.hs index db01ee8..ccb252b 100644 --- a/ghc/compiler/codeGen/CgPrimOp.hs +++ b/ghc/compiler/codeGen/CgPrimOp.hs @@ -115,12 +115,6 @@ emitPrimOp [res] ReadMutVarOp [mutv] live emitPrimOp [] WriteMutVarOp [mutv,var] live = stmtC (CmmStore (cmmOffsetW mutv fixedHdrSize) var) -emitPrimOp [res] ForeignObjToAddrOp [fo] live - = stmtC (CmmAssign res (cmmLoadIndexW fo fixedHdrSize)) - -emitPrimOp [] WriteForeignObjOp [fo,addr] live - = stmtC (CmmStore (cmmOffsetW fo fixedHdrSize) addr) - -- #define sizzeofByteArrayzh(r,a) \ -- r = (((StgArrWords *)(a))->words * sizeof(W_)) emitPrimOp [res] SizeofByteArrayOp [arg] live @@ -192,25 +186,6 @@ emitPrimOp [r] ReadArrayOp [obj,ix] live = doReadPtrArrayOp r obj ix emitPrimOp [r] IndexArrayOp [obj,ix] live = doReadPtrArrayOp r obj ix emitPrimOp [] WriteArrayOp [obj,ix,v] live = doWritePtrArrayOp obj ix v --- IndexXXXoffForeignObj - -emitPrimOp res IndexOffForeignObjOp_Char args live = doIndexOffForeignObjOp (Just mo_u_8ToWord) I8 res args -emitPrimOp res IndexOffForeignObjOp_WideChar args live = doIndexOffForeignObjOp (Just mo_u_32ToWord) I32 res args -emitPrimOp res IndexOffForeignObjOp_Int args live = doIndexOffForeignObjOp Nothing wordRep res args -emitPrimOp res IndexOffForeignObjOp_Word args live = doIndexOffForeignObjOp Nothing wordRep res args -emitPrimOp res IndexOffForeignObjOp_Addr args live = doIndexOffForeignObjOp Nothing wordRep res args -emitPrimOp res IndexOffForeignObjOp_Float args live = doIndexOffForeignObjOp Nothing F32 res args -emitPrimOp res IndexOffForeignObjOp_Double args live = doIndexOffForeignObjOp Nothing F64 res args -emitPrimOp res IndexOffForeignObjOp_StablePtr args live = doIndexOffForeignObjOp Nothing wordRep res args -emitPrimOp res IndexOffForeignObjOp_Int8 args live = doIndexOffForeignObjOp (Just mo_s_8ToWord) I8 res args -emitPrimOp res IndexOffForeignObjOp_Int16 args live = doIndexOffForeignObjOp (Just mo_s_16ToWord) I16 res args -emitPrimOp res IndexOffForeignObjOp_Int32 args live = doIndexOffForeignObjOp (Just mo_s_32ToWord) I32 res args -emitPrimOp res IndexOffForeignObjOp_Int64 args live = doIndexOffForeignObjOp Nothing I64 res args -emitPrimOp res IndexOffForeignObjOp_Word8 args live = doIndexOffForeignObjOp (Just mo_u_8ToWord) I8 res args -emitPrimOp res IndexOffForeignObjOp_Word16 args live = doIndexOffForeignObjOp (Just mo_u_16ToWord) I16 res args -emitPrimOp res IndexOffForeignObjOp_Word32 args live = doIndexOffForeignObjOp (Just mo_u_32ToWord) I32 res args -emitPrimOp res IndexOffForeignObjOp_Word64 args live = doIndexOffForeignObjOp Nothing I64 res args - -- IndexXXXoffAddr emitPrimOp res IndexOffAddrOp_Char args live = doIndexOffAddrOp (Just mo_u_8ToWord) I8 res args @@ -295,7 +270,6 @@ emitPrimOp res WriteOffAddrOp_Int args live = doWriteOffAddrOp Nothing wo emitPrimOp res WriteOffAddrOp_Word args live = doWriteOffAddrOp Nothing wordRep res args emitPrimOp res WriteOffAddrOp_Addr args live = doWriteOffAddrOp Nothing wordRep res args emitPrimOp res WriteOffAddrOp_Float args live = doWriteOffAddrOp Nothing F32 res args -emitPrimOp res WriteOffAddrOp_ForeignObj args live = doWriteOffAddrOp Nothing wordRep res args emitPrimOp res WriteOffAddrOp_Double args live = doWriteOffAddrOp Nothing F64 res args emitPrimOp res WriteOffAddrOp_StablePtr args live = doWriteOffAddrOp Nothing wordRep res args emitPrimOp res WriteOffAddrOp_Int8 args live = doWriteOffAddrOp (Just mo_WordTo8) I8 res args @@ -487,7 +461,6 @@ translateOp SameMVarOp = Just mo_wordEq translateOp SameMutableArrayOp = Just mo_wordEq translateOp SameMutableByteArrayOp = Just mo_wordEq translateOp SameTVarOp = Just mo_wordEq -translateOp EqForeignObj = Just mo_wordEq translateOp EqStablePtrOp = Just mo_wordEq translateOp _ = Nothing @@ -528,12 +501,6 @@ callishOp _ = Nothing ------------------------------------------------------------------------------ -- Helpers for translating various minor variants of array indexing. -doIndexOffForeignObjOp maybe_post_read_cast rep [res] [addr,idx] - = mkBasicIndexedRead 0 maybe_post_read_cast rep res - (cmmLoadIndexW addr fixedHdrSize) idx -doIndexOffForeignObjOp _ _ _ _ - = panic "CgPrimOp: doIndexOffForeignObjOp" - doIndexOffAddrOp maybe_post_read_cast rep [res] [addr,idx] = mkBasicIndexedRead 0 maybe_post_read_cast rep res addr idx doIndexOffAddrOp _ _ _ _ diff --git a/ghc/compiler/deSugar/DsCCall.lhs b/ghc/compiler/deSugar/DsCCall.lhs index ece24b2..e630f04 100644 --- a/ghc/compiler/deSugar/DsCCall.lhs +++ b/ghc/compiler/deSugar/DsCCall.lhs @@ -113,7 +113,7 @@ dsCCall :: CLabelString -- C routine to invoke dsCCall lbl args may_gc result_ty = mapAndUnzipDs unboxArg args `thenDs` \ (unboxed_args, arg_wrappers) -> - boxResult [] id Nothing result_ty `thenDs` \ (ccall_result_ty, res_wrapper) -> + boxResult id Nothing result_ty `thenDs` \ (ccall_result_ty, res_wrapper) -> newUnique `thenDs` \ uniq -> let target = StaticTarget lbl @@ -257,8 +257,7 @@ unboxArg arg \begin{code} -boxResult :: [Id] - -> ((Maybe Type, CoreExpr -> CoreExpr) -> (Maybe Type, CoreExpr -> CoreExpr)) +boxResult :: ((Maybe Type, CoreExpr -> CoreExpr) -> (Maybe Type, CoreExpr -> CoreExpr)) -> Maybe Id -> Type -> DsM (Type, CoreExpr -> CoreExpr) @@ -274,7 +273,7 @@ boxResult :: [Id] -- the result type will be -- State# RealWorld -> (# State# RealWorld #) -boxResult arg_ids augment mbTopCon result_ty +boxResult augment mbTopCon result_ty = case tcSplitTyConApp_maybe result_ty of -- This split absolutely has to be a tcSplit, because we must -- see the IO type; and it's a newtype which is transparent to splitTyConApp. diff --git a/ghc/compiler/deSugar/DsForeign.lhs b/ghc/compiler/deSugar/DsForeign.lhs index 1523d83..d9e6ba4 100644 --- a/ghc/compiler/deSugar/DsForeign.lhs +++ b/ghc/compiler/deSugar/DsForeign.lhs @@ -210,12 +210,6 @@ dsFCall fn_id fcall no_hdrs let work_arg_ids = [v | Var v <- val_args] -- All guaranteed to be vars - -- These are the ids we pass to boxResult, which are used to decide - -- whether to touch# an argument after the call (used to keep - -- ForeignObj#s live across a 'safe' foreign import). - maybe_arg_ids | unsafe_call fcall = work_arg_ids - | otherwise = [] - forDotnet = case fcall of DNCall{} -> True @@ -242,7 +236,7 @@ dsFCall fn_id fcall no_hdrs in augmentResultDs `thenDs` \ augment -> topConDs `thenDs` \ topCon -> - boxResult maybe_arg_ids augment topCon io_res_ty `thenDs` \ (ccall_result_ty, res_wrapper) -> + boxResult augment topCon io_res_ty `thenDs` \ (ccall_result_ty, res_wrapper) -> newUnique `thenDs` \ ccall_uniq -> newUnique `thenDs` \ work_uniq -> diff --git a/ghc/compiler/prelude/TysPrim.lhs b/ghc/compiler/prelude/TysPrim.lhs index b28506e..7d397d6 100644 --- a/ghc/compiler/prelude/TysPrim.lhs +++ b/ghc/compiler/prelude/TysPrim.lhs @@ -33,7 +33,6 @@ module TysPrim( stableNamePrimTyCon, mkStableNamePrimTy, bcoPrimTyCon, bcoPrimTy, weakPrimTyCon, mkWeakPrimTy, - foreignObjPrimTyCon, foreignObjPrimTy, threadIdPrimTyCon, threadIdPrimTy, int32PrimTyCon, int32PrimTy, @@ -82,7 +81,6 @@ primTyCons , intPrimTyCon , int32PrimTyCon , int64PrimTyCon - , foreignObjPrimTyCon , bcoPrimTyCon , weakPrimTyCon , mutableArrayPrimTyCon @@ -129,7 +127,6 @@ mVarPrimTyConName = mkPrimTc FSLIT("MVar#") mVarPrimTyConKey mVarPrimTyCon tVarPrimTyConName = mkPrimTc FSLIT("TVar#") tVarPrimTyConKey tVarPrimTyCon stablePtrPrimTyConName = mkPrimTc FSLIT("StablePtr#") stablePtrPrimTyConKey stablePtrPrimTyCon stableNamePrimTyConName = mkPrimTc FSLIT("StableName#") stableNamePrimTyConKey stableNamePrimTyCon -foreignObjPrimTyConName = mkPrimTc FSLIT("ForeignObj#") foreignObjPrimTyConKey foreignObjPrimTyCon bcoPrimTyConName = mkPrimTc FSLIT("BCO#") bcoPrimTyConKey bcoPrimTyCon weakPrimTyConName = mkPrimTc FSLIT("Weak#") weakPrimTyConKey weakPrimTyCon threadIdPrimTyConName = mkPrimTc FSLIT("ThreadId#") threadIdPrimTyConKey threadIdPrimTyCon @@ -353,27 +350,6 @@ mkStableNamePrimTy ty = mkTyConApp stableNamePrimTyCon [ty] %************************************************************************ %* * -\subsection[TysPrim-foreign-objs]{The ``foreign object'' type} -%* * -%************************************************************************ - -A Foreign Object is just a boxed, unlifted, Addr#. They're needed -because finalisers (weak pointers) can't watch Addr#s, they can only -watch heap-resident objects. - -We can't use a lifted Addr# (such as Addr) because race conditions -could bite us. For example, if the program deconstructed the Addr -before passing its contents to a ccall, and a weak pointer was -watching the Addr, the weak pointer might deduce that the Addr was -dead before it really was. - -\begin{code} -foreignObjPrimTy = mkTyConTy foreignObjPrimTyCon -foreignObjPrimTyCon = pcPrimTyCon0 foreignObjPrimTyConName PtrRep -\end{code} - -%************************************************************************ -%* * \subsection[TysPrim-BCOs]{The ``bytecode object'' type} %* * %************************************************************************ diff --git a/ghc/compiler/prelude/primops.txt.pp b/ghc/compiler/prelude/primops.txt.pp index 482f7f0..1b0313d 100644 --- a/ghc/compiler/prelude/primops.txt.pp +++ b/ghc/compiler/prelude/primops.txt.pp @@ -1,5 +1,5 @@ ----------------------------------------------------------------------- --- $Id: primops.txt.pp,v 1.35 2005/03/07 15:16:41 simonmar Exp $ +-- $Id: primops.txt.pp,v 1.36 2005/07/25 14:12:48 simonmar Exp $ -- -- Primitive Operations -- @@ -118,11 +118,7 @@ section "The word size story." -> Int\#}; otherwise it has type {\tt ByteArr\# -> Int\# -> Int32\#}. This approach confines the necessary {\tt \#if}-defs to this file; no conditional compilation is needed - in the files that expose these primops, namely - \texttt{lib/std/PrelStorable.lhs}, - \texttt{hslibs/lang/ArrayBase.hs}, and (in deprecated - fashion) in \texttt{hslibs/lang/ForeignObj.lhs} and - \texttt{hslibs/lang/Addr.lhs}. + in the files that expose these primops. Finally, there are strongly deprecated primops for coercing between {\tt Addr\#}, the primitive type of machine @@ -1120,10 +1116,6 @@ primop WriteOffAddrOp_Addr "writeAddrOffAddr#" GenPrimOp Addr# -> Int# -> Addr# -> State# s -> State# s with has_side_effects = True -primop WriteOffAddrOp_ForeignObj "writeForeignObjOffAddr#" GenPrimOp - Addr# -> Int# -> ForeignObj# -> State# s -> State# s - with has_side_effects = True - primop WriteOffAddrOp_Float "writeFloatOffAddr#" GenPrimOp Addr# -> Int# -> Float# -> State# s -> State# s with has_side_effects = True @@ -1169,87 +1161,6 @@ primop WriteOffAddrOp_Word64 "writeWord64OffAddr#" GenPrimOp with has_side_effects = True ------------------------------------------------------------------------ -section "ForeignObj#" - {Operations on ForeignObj\#. The indexing operations are - all deprecated.} ------------------------------------------------------------------------- - -primop MkForeignObjOp "mkForeignObj#" GenPrimOp - Addr# -> State# RealWorld -> (# State# RealWorld, ForeignObj# #) - with - has_side_effects = True - out_of_line = True - -primop WriteForeignObjOp "writeForeignObj#" GenPrimOp - ForeignObj# -> Addr# -> State# s -> State# s - with - has_side_effects = True - -primop ForeignObjToAddrOp "foreignObjToAddr#" GenPrimOp - ForeignObj# -> Addr# - -primop TouchOp "touch#" GenPrimOp - o -> State# RealWorld -> State# RealWorld - with - has_side_effects = True - -primop EqForeignObj "eqForeignObj#" GenPrimOp - ForeignObj# -> ForeignObj# -> Bool - with commutable = True - -primop IndexOffForeignObjOp_Char "indexCharOffForeignObj#" GenPrimOp - ForeignObj# -> Int# -> Char# - {Read 8-bit character; offset in bytes.} - -primop IndexOffForeignObjOp_WideChar "indexWideCharOffForeignObj#" GenPrimOp - ForeignObj# -> Int# -> Char# - {Read 31-bit character; offset in 4-byte words.} - -primop IndexOffForeignObjOp_Int "indexIntOffForeignObj#" GenPrimOp - ForeignObj# -> Int# -> Int# - -primop IndexOffForeignObjOp_Word "indexWordOffForeignObj#" GenPrimOp - ForeignObj# -> Int# -> Word# - -primop IndexOffForeignObjOp_Addr "indexAddrOffForeignObj#" GenPrimOp - ForeignObj# -> Int# -> Addr# - -primop IndexOffForeignObjOp_Float "indexFloatOffForeignObj#" GenPrimOp - ForeignObj# -> Int# -> Float# - -primop IndexOffForeignObjOp_Double "indexDoubleOffForeignObj#" GenPrimOp - ForeignObj# -> Int# -> Double# - -primop IndexOffForeignObjOp_StablePtr "indexStablePtrOffForeignObj#" GenPrimOp - ForeignObj# -> Int# -> StablePtr# a - -primop IndexOffForeignObjOp_Int8 "indexInt8OffForeignObj#" GenPrimOp - ForeignObj# -> Int# -> Int# - -primop IndexOffForeignObjOp_Int16 "indexInt16OffForeignObj#" GenPrimOp - ForeignObj# -> Int# -> Int# - -primop IndexOffForeignObjOp_Int32 "indexInt32OffForeignObj#" GenPrimOp - ForeignObj# -> Int# -> INT32 - -primop IndexOffForeignObjOp_Int64 "indexInt64OffForeignObj#" GenPrimOp - ForeignObj# -> Int# -> INT64 - -primop IndexOffForeignObjOp_Word8 "indexWord8OffForeignObj#" GenPrimOp - ForeignObj# -> Int# -> Word# - -primop IndexOffForeignObjOp_Word16 "indexWord16OffForeignObj#" GenPrimOp - ForeignObj# -> Int# -> Word# - -primop IndexOffForeignObjOp_Word32 "indexWord32OffForeignObj#" GenPrimOp - ForeignObj# -> Int# -> WORD32 - -primop IndexOffForeignObjOp_Word64 "indexWord64OffForeignObj#" GenPrimOp - ForeignObj# -> Int# -> WORD64 - - - ------------------------------------------------------------------------- section "Mutable variables" {Operations on MutVar\#s, which behave like single-element mutable arrays.} ------------------------------------------------------------------------ @@ -1589,6 +1500,11 @@ primop FinalizeWeakOp "finalizeWeak#" GenPrimOp has_side_effects = True out_of_line = True +primop TouchOp "touch#" GenPrimOp + o -> State# RealWorld -> State# RealWorld + with + has_side_effects = True + ------------------------------------------------------------------------ section "Stable pointers and names" ------------------------------------------------------------------------ diff --git a/ghc/includes/ClosureTypes.h b/ghc/includes/ClosureTypes.h index 62cb667..99aaf9f 100644 --- a/ghc/includes/ClosureTypes.h +++ b/ghc/includes/ClosureTypes.h @@ -77,22 +77,21 @@ #define MUT_ARR_PTRS_FROZEN 53 #define MUT_VAR 54 #define WEAK 55 -#define FOREIGN 56 -#define STABLE_NAME 57 -#define TSO 58 -#define BLOCKED_FETCH 69 -#define FETCH_ME 60 -#define FETCH_ME_BQ 61 -#define RBH 62 -#define EVACUATED 63 -#define REMOTE_REF 64 -#define TVAR_WAIT_QUEUE 65 -#define TVAR 66 -#define TREC_CHUNK 67 -#define TREC_HEADER 68 -#define ATOMICALLY_FRAME 79 -#define CATCH_RETRY_FRAME 70 -#define CATCH_STM_FRAME 71 -#define N_CLOSURE_TYPES 72 +#define STABLE_NAME 56 +#define TSO 57 +#define BLOCKED_FETCH 68 +#define FETCH_ME 69 +#define FETCH_ME_BQ 60 +#define RBH 61 +#define EVACUATED 62 +#define REMOTE_REF 63 +#define TVAR_WAIT_QUEUE 64 +#define TVAR 65 +#define TREC_CHUNK 66 +#define TREC_HEADER 67 +#define ATOMICALLY_FRAME 78 +#define CATCH_RETRY_FRAME 79 +#define CATCH_STM_FRAME 70 +#define N_CLOSURE_TYPES 71 #endif /* CLOSURETYPES_H */ diff --git a/ghc/includes/Closures.h b/ghc/includes/Closures.h index 506592f..f9bfeb4 100644 --- a/ghc/includes/Closures.h +++ b/ghc/includes/Closures.h @@ -189,11 +189,6 @@ typedef struct { StgHeader header; } StgRetry; -typedef struct _StgForeignObj { - StgHeader header; - StgAddr data; /* pointer to data in non-haskell-land */ -} StgForeignObj; - typedef struct _StgStableName { StgHeader header; StgWord sn; diff --git a/ghc/includes/StgMiscClosures.h b/ghc/includes/StgMiscClosures.h index d1b7f5c..148e055 100644 --- a/ghc/includes/StgMiscClosures.h +++ b/ghc/includes/StgMiscClosures.h @@ -111,7 +111,6 @@ RTS_INFO(stg_FETCH_ME_BQ_info); #endif RTS_FUN_INFO(stg_BCO_info); RTS_INFO(stg_EVACUATED_info); -RTS_INFO(stg_FOREIGN_info); RTS_INFO(stg_WEAK_info); RTS_INFO(stg_DEAD_WEAK_info); RTS_INFO(stg_STABLE_NAME_info); @@ -171,7 +170,6 @@ RTS_ENTRY(stg_FETCH_ME_BQ_entry); #endif RTS_ENTRY(stg_BCO_entry); RTS_ENTRY(stg_EVACUATED_entry); -RTS_ENTRY(stg_FOREIGN_entry); RTS_ENTRY(stg_WEAK_entry); RTS_ENTRY(stg_DEAD_WEAK_entry); RTS_ENTRY(stg_STABLE_NAME_entry); @@ -567,8 +565,6 @@ RTS_FUN(mkWeakzh_fast); RTS_FUN(finalizzeWeakzh_fast); RTS_FUN(deRefWeakzh_fast); -RTS_FUN(mkForeignObjzh_fast); - RTS_FUN(newBCOzh_fast); RTS_FUN(mkApUpd0zh_fast); diff --git a/ghc/includes/mkDerivedConstants.c b/ghc/includes/mkDerivedConstants.c index 754189c..2cfd06e 100644 --- a/ghc/includes/mkDerivedConstants.c +++ b/ghc/includes/mkDerivedConstants.c @@ -357,9 +357,6 @@ main(int argc, char *argv[]) closure_field(StgCatchRetryFrame, alt_code); closure_field(StgCatchRetryFrame, first_code_trec); - closure_size(StgForeignObj); - closure_field(StgForeignObj,data); - closure_size(StgWeak); closure_field(StgWeak,link); closure_field(StgWeak,key); diff --git a/ghc/rts/ClosureFlags.c b/ghc/rts/ClosureFlags.c index d840bdd..8a3d97a 100644 --- a/ghc/rts/ClosureFlags.c +++ b/ghc/rts/ClosureFlags.c @@ -82,7 +82,6 @@ StgWord16 closure_flags[] = { /* MUT_ARR_PTRS_FROZEN = */ (_HNF| _NS| _UPT ), /* MUT_VAR = */ (_HNF| _NS| _MUT|_UPT ), /* WEAK = */ (_HNF| _NS| _UPT ), -/* FOREIGN = */ (_HNF| _NS| _UPT ), /* STABLE_NAME = */ (_HNF| _NS| _UPT ), /* TSO = */ (_HNF| _NS| _MUT|_UPT ), /* BLOCKED_FETCH = */ (_HNF| _NS| _MUT|_UPT ), @@ -100,7 +99,7 @@ StgWord16 closure_flags[] = { /* CATCH_STM_FRAME = */ ( _BTM ) }; -#if N_CLOSURE_TYPES != 72 +#if N_CLOSURE_TYPES != 71 #error Closure types changed: update ClosureFlags.c! #endif diff --git a/ghc/rts/FrontPanel.c b/ghc/rts/FrontPanel.c index e6126c1..a09c8cc 100644 --- a/ghc/rts/FrontPanel.c +++ b/ghc/rts/FrontPanel.c @@ -700,7 +700,6 @@ residencyCensus( void ) break; case WEAK: - case FOREIGN: case STABLE_NAME: case MVAR: case MUT_VAR: diff --git a/ghc/rts/LdvProfile.c b/ghc/rts/LdvProfile.c index ec91b1a..9fb2765 100644 --- a/ghc/rts/LdvProfile.c +++ b/ghc/rts/LdvProfile.c @@ -137,7 +137,6 @@ processHeapClosureForDead( StgClosure *c ) case WEAK: case MUT_VAR: - case FOREIGN: case BCO: case STABLE_NAME: size = sizeW_fromITBL(info); diff --git a/ghc/rts/Linker.c b/ghc/rts/Linker.c index f1a69cc..93a79d2 100644 --- a/ghc/rts/Linker.c +++ b/ghc/rts/Linker.c @@ -132,14 +132,11 @@ typedef struct _RtsSymbolVal { #if !defined(PAR) -#define Maybe_ForeignObj SymX(mkForeignObjzh_fast) - #define Maybe_Stable_Names SymX(mkWeakzh_fast) \ SymX(makeStableNamezh_fast) \ SymX(finalizzeWeakzh_fast) #else /* These are not available in GUM!!! -- HWL */ -#define Maybe_ForeignObj #define Maybe_Stable_Names #endif @@ -409,7 +406,6 @@ typedef struct _RtsSymbolVal { #endif #define RTS_SYMBOLS \ - Maybe_ForeignObj \ Maybe_Stable_Names \ Sym(StgReturn) \ SymX(stg_enter_info) \ diff --git a/ghc/rts/PrimOps.cmm b/ghc/rts/PrimOps.cmm index 84b34d0..01205c6 100644 --- a/ghc/rts/PrimOps.cmm +++ b/ghc/rts/PrimOps.cmm @@ -240,26 +240,6 @@ atomicModifyMutVarzh_fast } /* ----------------------------------------------------------------------------- - Foreign Object Primitives - -------------------------------------------------------------------------- */ - -mkForeignObjzh_fast -{ - /* R1 = ptr to foreign object, - */ - W_ result; - - ALLOC_PRIM( SIZEOF_StgForeignObj, NO_PTRS, mkForeignObjzh_fast); - - result = Hp - SIZEOF_StgForeignObj + WDS(1); - SET_HDR(result,stg_FOREIGN_info,W_[CCCS]); - StgForeignObj_data(result) = R1; - - /* returns (# s#, ForeignObj# #) */ - RET_P(result); -} - -/* ----------------------------------------------------------------------------- Weak Pointer Primitives -------------------------------------------------------------------------- */ diff --git a/ghc/rts/Printer.c b/ghc/rts/Printer.c index b454b46..7770631 100644 --- a/ghc/rts/Printer.c +++ b/ghc/rts/Printer.c @@ -380,12 +380,6 @@ printClosure( StgClosure *obj ) /* ToDo: chase 'link' ? */ break; - case FOREIGN: - debugBelch("FOREIGN("); - printPtr((StgPtr)( ((StgForeignObj*)obj)->data )); - debugBelch(")\n"); - break; - case STABLE_NAME: debugBelch("STABLE_NAME(%ld)\n", ((StgStableName*)obj)->sn); break; diff --git a/ghc/rts/ProfHeap.c b/ghc/rts/ProfHeap.c index 2593d1e..b640fea 100644 --- a/ghc/rts/ProfHeap.c +++ b/ghc/rts/ProfHeap.c @@ -159,7 +159,6 @@ static char *type_names[] = { , "MUT_VAR" , "WEAK" - , "FOREIGN" , "TSO" @@ -914,7 +913,6 @@ heapCensusChain( Census *census, bdescr *bd ) case MVAR: case WEAK: - case FOREIGN: case STABLE_NAME: case MUT_VAR: prim = rtsTrue; diff --git a/ghc/rts/RetainerProfile.c b/ghc/rts/RetainerProfile.c index d312b56..f458d8c 100644 --- a/ghc/rts/RetainerProfile.c +++ b/ghc/rts/RetainerProfile.c @@ -510,7 +510,6 @@ push( StgClosure *c, retainer c_child_r, StgClosure **first_child ) // layout.payload.ptrs, no SRT case CONSTR: - case FOREIGN: case STABLE_NAME: case BCO: case CONSTR_STATIC: @@ -816,7 +815,6 @@ pop( StgClosure **c, StgClosure **cp, retainer *r ) return; case CONSTR: - case FOREIGN: case STABLE_NAME: case BCO: case CONSTR_STATIC: @@ -1045,7 +1043,6 @@ isRetainer( StgClosure *c ) case CONSTR_STATIC: case FUN_STATIC: // misc - case FOREIGN: case STABLE_NAME: case BCO: case ARR_WORDS: @@ -2107,7 +2104,6 @@ sanityCheckHeapClosure( StgClosure *c ) case IND_PERM: case IND_OLDGEN: case IND_OLDGEN_PERM: - case FOREIGN: case BCO: case STABLE_NAME: return sizeW_fromITBL(info); diff --git a/ghc/rts/Sanity.c b/ghc/rts/Sanity.c index 89c1a7e..8e0093d 100644 --- a/ghc/rts/Sanity.c +++ b/ghc/rts/Sanity.c @@ -304,7 +304,6 @@ checkClosure( StgClosure* p ) #endif case BLACKHOLE: case CAF_BLACKHOLE: - case FOREIGN: case STABLE_NAME: case MUT_VAR: case CONSTR_INTLIKE: diff --git a/ghc/rts/StgMiscClosures.cmm b/ghc/rts/StgMiscClosures.cmm index 15f27d6..ed7b199 100644 --- a/ghc/rts/StgMiscClosures.cmm +++ b/ghc/rts/StgMiscClosures.cmm @@ -474,13 +474,6 @@ INFO_TABLE_CONSTR(stg_NO_FINALIZER,0,0,0,CONSTR_NOCAF_STATIC,"NO_FINALIZER","NO_ CLOSURE(stg_NO_FINALIZER_closure,stg_NO_FINALIZER); /* ---------------------------------------------------------------------------- - Foreign Objects are unlifted and therefore never entered. - ------------------------------------------------------------------------- */ - -INFO_TABLE(stg_FOREIGN,0,1,FOREIGN,"FOREIGN","FOREIGN") -{ foreign "C" barf("FOREIGN object entered!"); } - -/* ---------------------------------------------------------------------------- Stable Names are unlifted too. ------------------------------------------------------------------------- */ -- 1.7.10.4