Skip to content

GitLab

Commit 7385dd9f authored by sewardj's avatar sewardj
Browse files

[project @ 2001-01-15 16:55:24 by sewardj] 

In interpreted code, basic support for routing primop calls through
to functions in PrelPrimopWrappers.lhs.
parent 2015743e
Hide whitespace changes
Inline Side-by-side
ghc/compiler/absCSyn/Costs.lhs
View file @ 7385dd9f
%
% (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
% ---------------------------------------------------------------------------
......@@ -358,7 +358,7 @@ floatOps =
gmpOps :: [PrimOp]
gmpOps =
[ IntegerAddOp , IntegerSubOp , IntegerMulOp
, IntegerQuotRemOp , IntegerDivModOp , IntegerNegOp
, IntegerQuotRemOp , IntegerDivModOp
, IntegerCmpOp
, Integer2IntOp , Int2IntegerOp
]
......
ghc/compiler/nativeGen/StixPrim.lhs
View file @ 7385dd9f
......@@ -55,9 +55,6 @@ and modify our heap check accordingly.
\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)
......
ghc/compiler/prelude/primops.txt
View file @ 7385dd9f
-----------------------------------------------------------------------
-- $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
--
......@@ -362,9 +362,6 @@ primop Int64ToIntegerOp "int64ToInteger#" GenPrimOp
--- Integer# ---
------------------------------------------------------------------------
primop IntegerNegOp "negateInteger#" GenPrimOp
Int# -> ByteArr# -> (# Int#, ByteArr# #)
primop IntegerAddOp "plusInteger#" GenPrimOp
Int# -> ByteArr# -> Int# -> ByteArr# -> (# Int#, ByteArr# #)
with commutable = True
......@@ -772,9 +769,6 @@ primop ReadOffAddrOp_Double "readDoubleOffAddr#" GenPrimOp
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# #)
......@@ -1256,17 +1250,21 @@ primop ParAtForNowOp "parAtForNow#" GenPrimOp
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
------------------------------------------------------------------------
......
ghc/includes/StgMiscClosures.h
View file @ 7385dd9f
/* -----------------------------------------------------------------------------
* $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
*
......@@ -69,7 +69,8 @@ STGFUN(stg_interp_constr8_entry);
/* 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;
......
ghc/rts/Interpreter.c
View file @ 7385dd9f
......@@ -5,8 +5,8 @@
* 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
......@@ -429,7 +429,8 @@ StgThreadReturnCode interpretBCO ( Capability* cap )
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
......
ghc/rts/Linker.c
View file @ 7385dd9f
/* -----------------------------------------------------------------------------
* $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
*
......@@ -138,6 +138,7 @@ static int ocResolve_PEi386 ( ObjectCode* oc );
SymX(stg_INTLIKE_closure) \
SymX(stg_CAF_UNENTERED_entry) \
SymX(newCAF) \
SymX(newBCOzh_fast) \
SymX(putMVarzh_fast) \
SymX(newMVarzh_fast) \
SymX(takeMVarzh_fast) \
......
ghc/rts/Printer.c
View file @ 7385dd9f
/* -----------------------------------------------------------------------------
* $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.
*
......@@ -385,8 +385,11 @@ StgPtr printStackObj( StgPtr sp )
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" );
......
ghc/rts/StgMiscClosures.hc
View file @ 7385dd9f
/* -----------------------------------------------------------------------------
* $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
*
......@@ -77,7 +77,7 @@ FN_(stg_interp_constr8_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),7)); FE_ }
/* 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.
......@@ -87,7 +87,7 @@ FN_(stg_interp_constr8_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),7)); FE_ }
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.
......@@ -108,8 +108,9 @@ FN_(stg_interp_constr8_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),7)); FE_ }
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; \
......@@ -123,17 +124,50 @@ FN_(stg_interp_constr8_entry) { FB_ JMP_(RET_VEC((P_)(*Sp),7)); FE_ }
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) \
......@@ -144,6 +178,8 @@ VEC_POLY_INFO_TABLE(stg_ctoi_ret_R1,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/,
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); \
......@@ -172,6 +208,8 @@ VEC_POLY_INFO_TABLE(stg_ctoi_ret_F1,0, NULL/*srt*/, 0/*srt_off*/, 0/*srt_len*/,
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); \
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment