%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
-% $Id: Costs.lhs,v 1.27 2000/10/24 07:35:00 simonpj Exp $
+% $Id: Costs.lhs,v 1.28 2001/01/15 16:55:24 sewardj Exp $
%
% Only needed in a GranSim setup -- HWL
% ---------------------------------------------------------------------------
gmpOps :: [PrimOp]
gmpOps =
[ IntegerAddOp , IntegerSubOp , IntegerMulOp
- , IntegerQuotRemOp , IntegerDivModOp , IntegerNegOp
+ , IntegerQuotRemOp , IntegerDivModOp
, IntegerCmpOp
, Integer2IntOp , Int2IntegerOp
]
\begin{code}
-- NB: ordering of clauses somewhere driven by
-- the desire to getting sane patt-matching behavior
-primCode res@[sr,dr] IntegerNegOp arg@[sa,da]
- = gmpNegate (sr,dr) (sa,da)
-
primCode [res] IntegerCmpOp args@[sa1,da1, sa2,da2]
= gmpCompare res (sa1,da1, sa2,da2)
-----------------------------------------------------------------------
--- $Id: primops.txt,v 1.14 2001/01/15 09:55:41 sewardj Exp $
+-- $Id: primops.txt,v 1.15 2001/01/15 16:55:24 sewardj Exp $
--
-- Primitive Operations
--
--- Integer# ---
------------------------------------------------------------------------
-primop IntegerNegOp "negateInteger#" GenPrimOp
- Int# -> ByteArr# -> (# Int#, ByteArr# #)
-
primop IntegerAddOp "plusInteger#" GenPrimOp
Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
with commutable = True
primop ReadOffAddrOp_StablePtr "readStablePtrOffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, StablePtr# a #)
-primop ReadOffAddrOp_ForeignObj "readForeignObjOffAddr#" GenPrimOp
- Addr# -> Int# -> State# s -> (# State# s, ForeignObj# #)
-
primop ReadOffAddrOp_Int8 "readInt8OffAddr#" GenPrimOp
Addr# -> Int# -> State# s -> (# State# s, Int# #)
usage = { mangle ParAtForNowOp [mkO, mkZ, mkP, mkP, mkP, mkP, mkM] mkM }
has_side_effects = True
-primop CopyableOp "copyable#" GenPrimOp
- a -> Int#
- with
- usage = { mangle CopyableOp [mkZ] mkR }
- has_side_effects = True
-
-primop NoFollowOp "noFollow#" GenPrimOp
- a -> Int#
- with
- usage = { mangle NoFollowOp [mkZ] mkR }
- has_side_effects = True
+-- copyable# and noFollow# have no corresponding entry in
+-- PrelGHC.hi-boot, so I don't know whether they should still
+-- be here or not. JRS, 15 Jan 01
+--
+--primop CopyableOp "copyable#" GenPrimOp
+-- a -> Int#
+-- with
+-- usage = { mangle CopyableOp [mkZ] mkR }
+-- has_side_effects = True
+--
+--primop NoFollowOp "noFollow#" GenPrimOp
+-- a -> Int#
+-- with
+-- usage = { mangle NoFollowOp [mkZ] mkR }
+-- has_side_effects = True
------------------------------------------------------------------------
/* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.h,v 1.31 2000/12/20 15:26:50 rrt Exp $
+ * $Id: StgMiscClosures.h,v 1.32 2001/01/15 16:55:25 sewardj Exp $
*
* (c) The GHC Team, 1998-1999
*
/* Magic glue code for when compiled code returns a value in R1/F1/D1
to the interpreter. */
-extern DLL_IMPORT_RTS const vec_info_8 stg_ctoi_ret_R1_info;
+extern DLL_IMPORT_RTS const vec_info_8 stg_ctoi_ret_R1p_info;
+extern DLL_IMPORT_RTS const vec_info_8 stg_ctoi_ret_R1n_info;
extern DLL_IMPORT_RTS const vec_info_8 stg_ctoi_ret_F1_info;
extern DLL_IMPORT_RTS const vec_info_8 stg_ctoi_ret_D1_info;
* Copyright (c) 1994-2000.
*
* $RCSfile: Interpreter.c,v $
- * $Revision: 1.12 $
- * $Date: 2001/01/15 09:55:41 $
+ * $Revision: 1.13 $
+ * $Date: 2001/01/15 16:55:25 $
* ---------------------------------------------------------------------------*/
#ifdef GHCI
int tag = StackWord(0);
StgInfoTable* ret_itbl = (StgInfoTable*)StackWord(tag +1);
ASSERT(tag <= 2); /* say ... */
- if (ret_itbl == (StgInfoTable*)&stg_ctoi_ret_R1_info
+ if (ret_itbl == (StgInfoTable*)&stg_ctoi_ret_R1p_info
+ || ret_itbl == (StgInfoTable*)&stg_ctoi_ret_R1n_info
|| ret_itbl == (StgInfoTable*)&stg_ctoi_ret_F1_info
|| ret_itbl == (StgInfoTable*)&stg_ctoi_ret_D1_info) {
/* Returning to interpreted code. Interpret the BCO
/* -----------------------------------------------------------------------------
- * $Id: Linker.c,v 1.7 2001/01/10 17:21:18 sewardj Exp $
+ * $Id: Linker.c,v 1.8 2001/01/15 16:55:25 sewardj Exp $
*
* (c) The GHC Team, 2000
*
SymX(stg_INTLIKE_closure) \
SymX(stg_CAF_UNENTERED_entry) \
SymX(newCAF) \
+ SymX(newBCOzh_fast) \
SymX(putMVarzh_fast) \
SymX(newMVarzh_fast) \
SymX(takeMVarzh_fast) \
/* -----------------------------------------------------------------------------
- * $Id: Printer.c,v 1.32 2001/01/10 17:21:18 sewardj Exp $
+ * $Id: Printer.c,v 1.33 2001/01/15 16:55:25 sewardj Exp $
*
* (c) The GHC Team, 1994-2000.
*
StgClosure* c = (StgClosure*)(*sp);
printPtr((StgPtr)*sp);
#ifdef GHCI
- if (c == (StgClosure*)&stg_ctoi_ret_R1_info) {
- fprintf(stderr, "\t\t\tstg_ctoi_ret_R1_info\n" );
+ if (c == (StgClosure*)&stg_ctoi_ret_R1p_info) {
+ fprintf(stderr, "\t\t\tstg_ctoi_ret_R1p_info\n" );
+ } else
+ if (c == (StgClosure*)&stg_ctoi_ret_R1n_info) {
+ fprintf(stderr, "\t\t\tstg_ctoi_ret_R1n_info\n" );
} else
if (c == (StgClosure*)&stg_ctoi_ret_F1_info) {
fprintf(stderr, "\t\t\tstg_ctoi_ret_F1_info\n" );
/* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.hc,v 1.57 2001/01/10 17:21:18 sewardj Exp $
+ * $Id: StgMiscClosures.hc,v 1.58 2001/01/15 16:55:25 sewardj Exp $
*
* (c) The GHC Team, 1998-2000
*
/* Some info tables to be used when compiled code returns a value to
the interpreter, i.e. the interpreter pushes one of these onto the
stack before entering a value. What the code does is to
- impedance-match the compiled return convention (in R1/F1/D1 etc) to
+ impedance-match the compiled return convention (in R1p/R1n/F1/D1 etc) to
the interpreter's convention (returned value is on top of stack),
and then cause the scheduler to enter the interpreter.
ptr to one of these info tables.
The info table code, both direct and vectored, must:
- * push R1/F1/D1 on the stack
+ * push R1/F1/D1 on the stack, and its tag if necessary
* push the BCO (so it's now on the stack twice)
* Yield, ie, go to the scheduler.
haven't got a good story about that yet.
*/
-/* When the returned value is in R1 ... */
-#define STG_CtoI_RET_R1_Template(label) \
+/* When the returned value is in R1 and it is a pointer, so doesn't
+ need tagging ... */
+#define STG_CtoI_RET_R1p_Template(label) \
IFN_(label) \
{ \
StgPtr bco; \
FE_ \
}
-STG_CtoI_RET_R1_Template(stg_ctoi_ret_R1_entry);
-STG_CtoI_RET_R1_Template(stg_ctoi_ret_R1_0_entry);
-STG_CtoI_RET_R1_Template(stg_ctoi_ret_R1_1_entry);
-STG_CtoI_RET_R1_Template(stg_ctoi_ret_R1_2_entry);
-STG_CtoI_RET_R1_Template(stg_ctoi_ret_R1_3_entry);
-STG_CtoI_RET_R1_Template(stg_ctoi_ret_R1_4_entry);
-STG_CtoI_RET_R1_Template(stg_ctoi_ret_R1_5_entry);
-STG_CtoI_RET_R1_Template(stg_ctoi_ret_R1_6_entry);
-STG_CtoI_RET_R1_Template(stg_ctoi_ret_R1_7_entry);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_entry);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_0_entry);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_1_entry);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_2_entry);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_3_entry);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_4_entry);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_5_entry);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_6_entry);
+STG_CtoI_RET_R1p_Template(stg_ctoi_ret_R1p_7_entry);
+
+VEC_POLY_INFO_TABLE(stg_ctoi_ret_R1p,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
+
+
+
+/* When the returned value is in R1 and it isn't a pointer. */
+#define STG_CtoI_RET_R1n_Template(label) \
+ IFN_(label) \
+ { \
+ StgPtr bco; \
+ FB_ \
+ bco = ((StgPtr*)Sp)[1]; \
+ Sp -= 1; \
+ ((StgPtr*)Sp)[0] = (StgPtr)R1.i; \
+ Sp -= 1; \
+ ((StgPtr*)Sp)[0] = (StgPtr)1; /* tag */ \
+ Sp -= 1; \
+ ((StgPtr*)Sp)[0] = bco; \
+ JMP_(stg_yield_to_interpreter); \
+ FE_ \
+ }
+
+STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_entry);
+STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_0_entry);
+STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_1_entry);
+STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_2_entry);
+STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_3_entry);
+STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_4_entry);
+STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_5_entry);
+STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_6_entry);
+STG_CtoI_RET_R1n_Template(stg_ctoi_ret_R1n_7_entry);
+
+VEC_POLY_INFO_TABLE(stg_ctoi_ret_R1n,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
+
-VEC_POLY_INFO_TABLE(stg_ctoi_ret_R1,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/, RET_BCO,, EF_);
/* When the returned value is in F1 ... */
#define STG_CtoI_RET_F1_Template(label) \
bco = ((StgPtr*)Sp)[1]; \
Sp -= sizeofW(StgFloat); \
ASSIGN_FLT((W_*)Sp, F1); \
+ Sp -= 1; \
+ ((StgPtr*)Sp)[0] = (StgPtr)sizeofW(StgFloat); \
Sp -= 1; \
((StgPtr*)Sp)[0] = bco; \
JMP_(stg_yield_to_interpreter); \
bco = ((StgPtr*)Sp)[1]; \
Sp -= sizeofW(StgDouble); \
ASSIGN_DBL((W_*)Sp, D1); \
+ Sp -= 1; \
+ ((StgPtr*)Sp)[0] = (StgPtr)sizeofW(StgDouble); \
Sp -= 1; \
((StgPtr*)Sp)[0] = bco; \
JMP_(stg_yield_to_interpreter); \