Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
21462c00
Commit
21462c00
authored
Mar 02, 1999
by
sof
Browse files
[project @ 1999-03-02 19:44:07 by sof]
- misc changes to support DLLs - StgNat* --> StgWord*
parent
a496d068
Changes
16
Hide whitespace changes
Inline
Side-by-side
ghc/includes/Block.h
View file @
21462c00
/* -----------------------------------------------------------------------------
* $Id: Block.h,v 1.
4
1999/0
2
/0
5
1
6:02:19 simonm
Exp $
* $Id: Block.h,v 1.
5
1999/0
3
/0
2
1
9:44:07 sof
Exp $
*
* (c) The GHC Team, 1998-1999
*
...
...
@@ -47,12 +47,12 @@ typedef struct _bdescr {
struct
_bdescr
*
back
;
/* used (occasionally) for doubly-linked lists*/
struct
_generation
*
gen
;
/* generation */
struct
_step
*
step
;
/* step */
Stg
Nat
32
blocks
;
/* no. of blocks (if grp head, 0 otherwise) */
Stg
Nat
32
evacuated
;
/* block is in to-space */
Stg
Word
32
blocks
;
/* no. of blocks (if grp head, 0 otherwise) */
Stg
Word
32
evacuated
;
/* block is in to-space */
#if SIZEOF_VOID_P == 8
Stg
Nat
32
_padding
[
2
];
Stg
Word
32
_padding
[
2
];
#else
Stg
Nat
32
_padding
[
0
];
Stg
Word
32
_padding
[
0
];
#endif
}
bdescr
;
...
...
ghc/includes/ClosureMacros.h
View file @
21462c00
/* ----------------------------------------------------------------------------
* $Id: ClosureMacros.h,v 1.
4
1999/0
2
/0
5
1
6:02:20 simonm
Exp $
* $Id: ClosureMacros.h,v 1.
5
1999/0
3
/0
2
1
9:44:08 sof
Exp $
*
* (c) The GHC Team, 1998-1999
*
...
...
@@ -105,6 +105,28 @@ extern StgFun DATA_SECTION_END_MARKER_DECL;
#define IS_DATA_PTR(p) ((P_)(p) >= (P_)&TEXT_SECTION_END_MARKER && (P_)(p) < (P_)&DATA_SECTION_END_MARKER)
#define IS_USER_PTR(p) ((P_)(p) >= (P_)&DATA_SECTION_END_MARKER)
#ifdef HAVE_WIN32_DLL_SUPPORT
/* ToDo: clean up */
extern
char
*
base_non_committed
;
#define HEAP_ALLOCED(x) (((char*)(x) >= base_non_committed) && ((char*)(x) <= (base_non_committed + 128 * 1024 * 1024)))
#endif
#ifndef HAVE_WIN32_DLL_SUPPORT
#define LOOKS_LIKE_STATIC(r) IS_DATA_PTR(r)
#else
/* Static closures are 'identified' by being prefixed with a zero. This is
so that they can be distinguished from pointers to info tables. Relies
on the fact that info tables are reversed.
LOOKS_LIKE_STATIC_CLOSURE() - discriminates between static closures and info tbls
(needed by LOOKS_LIKE_GHC_INFO() below - [Win32 DLLs only.])
LOOKS_LIKE_STATIC() - distinguishes between static and heap allocated data.
*/
#define LOOKS_LIKE_STATIC(r) (!(HEAP_ALLOCED(r)))
#define LOOKS_LIKE_STATIC_CLOSURE(r) ((*(((unsigned long *)(r))-1)) == 0)
#endif
/* -----------------------------------------------------------------------------
Macros for distinguishing infotables from closures.
...
...
@@ -129,11 +151,13 @@ extern StgFun DATA_SECTION_END_MARKER_DECL;
#define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(info)
#else
/* otherwise we have entry pointers on closures */
#define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(info)
# ifdef HAVE_WIN32_DLL_SUPPORT
# define LOOKS_LIKE_GHC_INFO(info) (!HEAP_ALLOCED(info) && !LOOKS_LIKE_STATIC_CLOSURE(info))
# else
# define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(info)
# endif
#endif
#define LOOKS_LIKE_STATIC(r) IS_DATA_PTR(r)
/* -----------------------------------------------------------------------------
Macros for calculating how big a closure will be (used during allocation)
-------------------------------------------------------------------------- */
...
...
@@ -319,6 +343,6 @@ SET_STATIC_HDR(PrelBase_CZh_closure,PrelBase_CZh_info,costCentreStack,const);
#define bcoConstChar( bco, i ) (*stgCast(StgChar*, ((bco)->payload+(bco)->n_ptrs+i)))
#define bcoConstFloat( bco, i ) (PK_FLT(stgCast(StgWord*,(bco)->payload+(bco)->n_ptrs+i)))
#define bcoConstDouble( bco, i ) (PK_DBL(stgCast(StgWord*,(bco)->payload+(bco)->n_ptrs+i)))
#define bcoInstr( bco, i ) (stgCast(Stg
Nat
8*,
((bco)->payload+(bco)->n_ptrs+(bco)->n_words))[i])
#define bcoInstr( bco, i ) (stgCast(Stg
Word
8*, ((bco)->payload+(bco)->n_ptrs+(bco)->n_words))[i])
#endif
/* CLOSUREMACROS_H */
ghc/includes/InfoMacros.h
View file @
21462c00
/* ----------------------------------------------------------------------------
* $Id: InfoMacros.h,v 1.
3
1999/0
2
/0
5
1
6:02:22 simonm
Exp $
* $Id: InfoMacros.h,v 1.
4
1999/0
3
/0
2
1
9:44:09 sof
Exp $
*
* (c) The GHC Team, 1998-1999
*
...
...
@@ -48,7 +48,7 @@ INFO_TABLE_SRT_BITMAP(info, entry, bitmap_, srt_, srt_off_, srt_len_, \
prof_descr, prof_type) \
entry_class(entry); \
info_class StgInfoTable info = { \
layout : { bitmap : (Stg
Nat
32)bitmap_ },\
layout : { bitmap : (Stg
Word
32)bitmap_ },\
SRT_INFO(type,srt_,srt_off_,srt_len_), \
INIT_ENTRY(entry) \
}
...
...
@@ -139,7 +139,7 @@ typedef struct {
#define VEC_INFO_TABLE(bitmap_,srt_,srt_off_,srt_len_,type) \
i : { \
layout : { bitmap : (Stg
Nat
32)bitmap_ }, \
layout : { bitmap : (Stg
Word
32)bitmap_ }, \
SRT_INFO(type,srt_,srt_off_,srt_len_) \
}
...
...
@@ -163,7 +163,7 @@ typedef StgInfoTable StgPolyInfoTable;
#define VEC_POLY_INFO_TABLE(nm,bitmap_,srt_,srt_off_,srt_len_,type) \
StgFunPtr nm##_vec[8] = POLY_VEC(nm); \
const StgInfoTable nm##_info = { \
layout : { bitmap : (Stg
Nat
32)bitmap_ }, \
layout : { bitmap : (Stg
Word
32)bitmap_ }, \
SRT_INFO(type,srt_,srt_off_,srt_len_), \
vector : &nm##_vec, \
INIT_ENTRY(nm##_entry) \
...
...
@@ -185,7 +185,7 @@ typedef vec_info_8 StgPolyInfoTable;
const vec_info_8 nm##_info = { \
vec : POLY_VEC(nm), \
i : { \
layout : { bitmap : (Stg
Nat
32)bitmap_ }, \
layout : { bitmap : (Stg
Word
32)bitmap_ }, \
SRT_INFO(type,srt_,srt_off_,srt_len_), \
INIT_ENTRY(nm##_entry) \
} \
...
...
@@ -198,4 +198,16 @@ typedef vec_info_8 StgPolyInfoTable;
#define BITMAP(lbl,size) \
static const StgLargeBitmap lbl = { size, {
/* DLL_SRT_ENTRY is used on the Win32 side when filling initialising
an entry in an SRT table with a reference to a closure that's
living in a DLL. See elsewhere for reasons as to why we need
to distinguish these kinds of references.
(ToDo: fill in a more precise href.)
*/
#ifdef HAVE_WIN32_DLL_SUPPORT
#define DLL_SRT_ENTRY(x) ((StgClosure*)(((char*)&DLL_IMPORT_DATA_VAR(x)) + 1))
#else
#define DLL_SRT_ENTRY(x) no-can-do
#endif
#endif
/* INFOMACROS_H */
ghc/includes/InfoTables.h
View file @
21462c00
/* ----------------------------------------------------------------------------
* $Id: InfoTables.h,v 1.1
1
1999/0
2/15 12:12:55 simonm
Exp $
* $Id: InfoTables.h,v 1.1
2
1999/0
3/02 19:44:10 sof
Exp $
*
* (c) The GHC Team, 1998-1999
*
...
...
@@ -273,21 +273,21 @@ typedef struct {
*/
typedef
union
{
StgWord
bitmap
;
/* bit pattern, 1 = pointer, 0 = non-pointer */
StgWord
selector_offset
;
/* used in THUNK_SELECTORs */
StgLargeBitmap
*
large_bitmap
;
/* pointer to large bitmap structure */
#if SIZEOF_VOID_P == 8
struct
{
Stg
Nat
32
ptrs
;
/* number of pointers */
Stg
Nat
32
nptrs
;
/* number of non-pointers */
Stg
Word
32
ptrs
;
/* number of pointers */
Stg
Word
32
nptrs
;
/* number of non-pointers */
}
payload
;
#else
struct
{
Stg
Nat
16
ptrs
;
/* number of pointers */
Stg
Nat
16
nptrs
;
/* number of non-pointers */
Stg
Word
16
ptrs
;
/* number of pointers */
Stg
Word
16
nptrs
;
/* number of non-pointers */
}
payload
;
StgWord
bitmap
;
/* bit pattern, 1 = pointer, 0 = non-pointer */
StgWord
selector_offset
;
/* used in THUNK_SELECTORs */
StgLargeBitmap
*
large_bitmap
;
/* pointer to large bitmap structure */
#endif
}
StgClosureInfo
;
...
...
@@ -314,13 +314,13 @@ typedef struct _StgInfoTable {
#endif
StgClosureInfo
layout
;
/* closure layout info (pointer-sized) */
#if SIZEOF_VOID_P == 8
Stg
Nat
16
flags
;
/* } */
Stg
Word
16
flags
;
/* } */
StgClosureType
type
:
16
;
/* } These 4 elements fit into 64 bits */
Stg
Nat
32
srt_len
;
/* } */
Stg
Word
32
srt_len
;
/* } */
#else
Stg
Nat8
flags
;
/* } */
Stg
Word8
flags
;
/* } */
StgClosureType
type
:
8
;
/* } These 4 elements fit into 32 bits */
Stg
Nat
16
srt_len
;
/* } */
Stg
Word
16
srt_len
;
/* } */
#endif
#if USE_MINIINTERPRETER
StgFunPtr
(
*
vector
)[];
...
...
ghc/includes/Prelude.h
View file @
21462c00
/* -----------------------------------------------------------------------------
* $Id: Prelude.h,v 1.
5
1999/0
2
/0
5
1
6:02:24 simonm
Exp $
* $Id: Prelude.h,v 1.
6
1999/0
3
/0
2
1
9:44:11 sof
Exp $
*
* (c) The GHC Team, 1998-1999
*
...
...
@@ -10,30 +10,32 @@
#ifndef PRELUDE_H
#define PRELUDE_H
#ifdef COMPILING_RTS
#ifdef COMPILER
extern
const
StgClosure
PrelBase_Z91Z93_static_closure
;
extern
const
StgClosure
PrelBase_Z40Z41_static_closure
;
extern
const
StgClosure
PrelBase_True_static_closure
;
extern
const
StgClosure
PrelBase_False_static_closure
;
extern
DLL_IMPORT
const
StgClosure
PrelBase_Z91Z93_static_closure
;
extern
DLL_IMPORT
const
StgClosure
PrelBase_Z40Z41_static_closure
;
extern
DLL_IMPORT
const
StgClosure
PrelBase_True_static_closure
;
extern
DLL_IMPORT
const
StgClosure
PrelBase_False_static_closure
;
extern
DLL_IMPORT
const
StgClosure
PrelPack_unpackCString_closure
;
extern
const
StgClosure
PrelMain_mainIO_closure
;
extern
const
StgClosure
PrelPack_unpackCString_closure
;
extern
const
StgInfoTable
PrelBase_Czh_static_info
;
extern
const
StgInfoTable
PrelBase_Izh_static_info
;
extern
const
StgInfoTable
PrelBase_Fzh_static_info
;
extern
const
StgInfoTable
PrelBase_Dzh_static_info
;
extern
const
StgInfoTable
PrelAddr_Azh_static_info
;
extern
const
StgInfoTable
PrelAddr_Wzh_static_info
;
extern
const
StgInfoTable
PrelBase_Czh_con_info
;
extern
const
StgInfoTable
PrelBase_Izh_con_info
;
extern
const
StgInfoTable
PrelBase_Fzh_con_info
;
extern
const
StgInfoTable
PrelBase_Dzh_con_info
;
extern
const
StgInfoTable
PrelAddr_Azh_con_info
;
extern
const
StgInfoTable
PrelAddr_Wzh_con_info
;
extern
const
StgInfoTable
PrelAddr_I64zh_con_info
;
extern
const
StgInfoTable
PrelAddr_W64zh_con_info
;
extern
const
StgInfoTable
PrelStable_StablePtr_static_info
;
extern
const
StgInfoTable
PrelStable_StablePtr_con_info
;
extern
DLL_IMPORT
const
StgInfoTable
PrelBase_Czh_static_info
;
extern
DLL_IMPORT
const
StgInfoTable
PrelBase_Izh_static_info
;
extern
DLL_IMPORT
const
StgInfoTable
PrelBase_Fzh_static_info
;
extern
DLL_IMPORT
const
StgInfoTable
PrelBase_Dzh_static_info
;
extern
DLL_IMPORT
const
StgInfoTable
PrelAddr_Azh_static_info
;
extern
DLL_IMPORT
const
StgInfoTable
PrelAddr_Wzh_static_info
;
extern
DLL_IMPORT
const
StgInfoTable
PrelBase_Czh_con_info
;
extern
DLL_IMPORT
const
StgInfoTable
PrelBase_Izh_con_info
;
extern
DLL_IMPORT
const
StgInfoTable
PrelBase_Fzh_con_info
;
extern
DLL_IMPORT
const
StgInfoTable
PrelBase_Dzh_con_info
;
extern
DLL_IMPORT
const
StgInfoTable
PrelAddr_Azh_con_info
;
extern
DLL_IMPORT
const
StgInfoTable
PrelAddr_Wzh_con_info
;
extern
DLL_IMPORT
const
StgInfoTable
PrelAddr_I64zh_con_info
;
extern
DLL_IMPORT
const
StgInfoTable
PrelAddr_W64zh_con_info
;
extern
DLL_IMPORT
const
StgInfoTable
PrelStable_StablePtr_static_info
;
extern
DLL_IMPORT
const
StgInfoTable
PrelStable_StablePtr_con_info
;
/* Define canonical names so we can abstract away from the actual
* module these names are defined in.
...
...
@@ -88,4 +90,6 @@ extern const StgInfoTable StablePtr_static_info;
#endif
#endif
#endif
/* PRELUDE_H */
ghc/includes/PrimOps.h
View file @
21462c00
/* -----------------------------------------------------------------------------
* $Id: PrimOps.h,v 1.2
1
1999/03/0
1
1
0:25:20 simonm
Exp $
* $Id: PrimOps.h,v 1.2
2
1999/03/0
2
1
9:44:12 sof
Exp $
*
* (c) The GHC Team, 1998-1999
*
...
...
@@ -59,7 +59,7 @@
#define zlzezhzh(r,a,b) r=(I_)((a)<=(b))
/* used by returning comparison primops, defined in Prims.hc. */
extern
const
StgClosure
*
PrelBase_Bool_closure_tbl
[];
extern
DLL_IMPORT_RTS
const
StgClosure
*
PrelBase_Bool_closure_tbl
[];
/* -----------------------------------------------------------------------------
Char# PrimOps.
...
...
@@ -380,7 +380,7 @@ EF_(decodeDoublezh_fast);
#define integerToWord64zh(r, sa,da) \
{ unsigned long int* d; \
I_ aa; \
Stg
Nat
64 res;
\
Stg
Word
64 res; \
\
d = (unsigned long int *) (BYTE_ARR_CTS(da)); \
aa = ((StgArrWords *)da)->words; \
...
...
@@ -420,12 +420,12 @@ EF_(word64ToIntegerzh_fast);
/* The rest are (way!) out of line, implemented via C entry points.
*/
I_
stg_gtWord64
(
Stg
Nat
64
,
Stg
Nat
64
);
I_
stg_geWord64
(
Stg
Nat
64
,
Stg
Nat
64
);
I_
stg_eqWord64
(
Stg
Nat
64
,
Stg
Nat
64
);
I_
stg_neWord64
(
Stg
Nat
64
,
Stg
Nat
64
);
I_
stg_ltWord64
(
Stg
Nat
64
,
Stg
Nat
64
);
I_
stg_leWord64
(
Stg
Nat
64
,
Stg
Nat
64
);
I_
stg_gtWord64
(
Stg
Word
64
,
Stg
Word
64
);
I_
stg_geWord64
(
Stg
Word
64
,
Stg
Word
64
);
I_
stg_eqWord64
(
Stg
Word
64
,
Stg
Word
64
);
I_
stg_neWord64
(
Stg
Word
64
,
Stg
Word
64
);
I_
stg_ltWord64
(
Stg
Word
64
,
Stg
Word
64
);
I_
stg_leWord64
(
Stg
Word
64
,
Stg
Word
64
);
I_
stg_gtInt64
(
StgInt64
,
StgInt64
);
I_
stg_geInt64
(
StgInt64
,
StgInt64
);
...
...
@@ -434,8 +434,8 @@ I_ stg_neInt64 (StgInt64, StgInt64);
I_
stg_ltInt64
(
StgInt64
,
StgInt64
);
I_
stg_leInt64
(
StgInt64
,
StgInt64
);
LW_
stg_remWord64
(
Stg
Nat
64
,
Stg
Nat
64
);
LW_
stg_quotWord64
(
Stg
Nat
64
,
Stg
Nat
64
);
LW_
stg_remWord64
(
Stg
Word
64
,
Stg
Word
64
);
LW_
stg_quotWord64
(
Stg
Word
64
,
Stg
Word
64
);
LI_
stg_remInt64
(
StgInt64
,
StgInt64
);
LI_
stg_quotInt64
(
StgInt64
,
StgInt64
);
...
...
@@ -444,13 +444,13 @@ LI_ stg_plusInt64 (StgInt64, StgInt64);
LI_
stg_minusInt64
(
StgInt64
,
StgInt64
);
LI_
stg_timesInt64
(
StgInt64
,
StgInt64
);
LW_
stg_and64
(
Stg
Nat
64
,
Stg
Nat
64
);
LW_
stg_or64
(
Stg
Nat
64
,
Stg
Nat
64
);
LW_
stg_xor64
(
Stg
Nat
64
,
Stg
Nat
64
);
LW_
stg_not64
(
Stg
Nat
64
);
LW_
stg_and64
(
Stg
Word
64
,
Stg
Word
64
);
LW_
stg_or64
(
Stg
Word
64
,
Stg
Word
64
);
LW_
stg_xor64
(
Stg
Word
64
,
Stg
Word
64
);
LW_
stg_not64
(
Stg
Word
64
);
LW_
stg_shiftL64
(
Stg
Nat
64
,
StgInt
);
LW_
stg_shiftRL64
(
Stg
Nat
64
,
StgInt
);
LW_
stg_shiftL64
(
Stg
Word
64
,
StgInt
);
LW_
stg_shiftRL64
(
Stg
Word
64
,
StgInt
);
LI_
stg_iShiftL64
(
StgInt64
,
StgInt
);
LI_
stg_iShiftRL64
(
StgInt64
,
StgInt
);
LI_
stg_iShiftRA64
(
StgInt64
,
StgInt
);
...
...
@@ -460,8 +460,8 @@ I_ stg_int64ToInt (StgInt64);
LW_
stg_int64ToWord64
(
StgInt64
);
LW_
stg_wordToWord64
(
StgWord
);
W_
stg_word64ToWord
(
Stg
Nat
64
);
LI_
stg_word64ToInt64
(
Stg
Nat
64
);
W_
stg_word64ToWord
(
Stg
Word
64
);
LI_
stg_word64ToInt64
(
Stg
Word
64
);
#endif
/* -----------------------------------------------------------------------------
...
...
ghc/includes/Regs.h
View file @
21462c00
/* -----------------------------------------------------------------------------
* $Id: Regs.h,v 1.
3
1999/0
2
/0
5
1
6:02:26 simonm
Exp $
* $Id: Regs.h,v 1.
4
1999/0
3
/0
2
1
9:44:14 sof
Exp $
*
* (c) The GHC Team, 1998-1999
*
...
...
@@ -42,7 +42,7 @@ typedef struct {
StgFloat
rF4
;
StgDouble
rD1
;
StgDouble
rD2
;
Stg
Nat
64
rL1
;
Stg
Word
64
rL1
;
StgPtr
rSp
;
StgUpdateFrame
*
rSu
;
StgPtr
rSpLim
;
...
...
@@ -50,7 +50,7 @@ typedef struct {
StgPtr
rHpLim
;
}
StgRegTable
;
extern
StgRegTable
MainRegTable
;
extern
DLL_IMPORT_RTS
StgRegTable
MainRegTable
;
/*
* Registers Hp and HpLim are global across the entire system, and are
...
...
@@ -226,7 +226,7 @@ GLOBAL_REG_DECL(StgDouble,D2,REG_D2)
#endif
#ifdef REG_L1
GLOBAL_REG_DECL
(
Stg
Nat
64
,
L1
,
REG_L1
)
GLOBAL_REG_DECL
(
Stg
Word
64
,
L1
,
REG_L1
)
#else
#define L1 (BaseReg->rL1)
#endif
...
...
ghc/includes/RtsAPI.h
View file @
21462c00
/* ----------------------------------------------------------------------------
* $Id: RtsAPI.h,v 1.
3
1999/0
2
/0
5
1
6:02:27 simonm
Exp $
* $Id: RtsAPI.h,v 1.
4
1999/0
3
/0
2
1
9:44:15 sof
Exp $
*
* (c) The GHC Team, 1998-1999
*
...
...
@@ -48,7 +48,9 @@ HaskellObj rts_apply ( HaskellObj, HaskellObj );
------------------------------------------------------------------------- */
char
rts_getChar
(
HaskellObj
);
int
rts_getInt
(
HaskellObj
);
int
rts_getInt32
(
HaskellObj
);
unsigned
int
rts_getWord
(
HaskellObj
);
unsigned
int
rts_getWord32
(
HaskellObj
);
float
rts_getFloat
(
HaskellObj
);
double
rts_getDouble
(
HaskellObj
);
StgStablePtr
rts_getStablePtr
(
HaskellObj
);
...
...
ghc/includes/Stable.h
View file @
21462c00
/* -----------------------------------------------------------------------------
* $Id: Stable.h,v 1.
3
1999/0
2/26
1
2
:4
6:45 simonm
Exp $
* $Id: Stable.h,v 1.
4
1999/0
3/02
1
9
:4
4:16 sof
Exp $
*
* (c) The GHC Team, 1998-1999
*
...
...
@@ -27,10 +27,10 @@ typedef struct {
StgClosure
*
sn_obj
;
/* the StableName object (or NULL) */
}
snEntry
;
extern
snEntry
*
stable_ptr_table
;
extern
snEntry
*
stable_ptr_free
;
extern
DLL_IMPORT_RTS
snEntry
*
stable_ptr_table
;
extern
DLL_IMPORT_RTS
snEntry
*
stable_ptr_free
;
extern
unsigned
int
SPT_size
;
extern
DLL_IMPORT_RTS
unsigned
int
SPT_size
;
extern
inline
StgPtr
deRefStablePtr
(
StgStablePtr
sp
)
...
...
ghc/includes/Stg.h
View file @
21462c00
/* -----------------------------------------------------------------------------
* $Id: Stg.h,v 1.
6
1999/0
2
/0
5
1
6:02:28 simonm
Exp $
* $Id: Stg.h,v 1.
7
1999/0
3
/0
2
1
9:44:17 sof
Exp $
*
* (c) The GHC Team, 1998-1999
*
...
...
@@ -27,6 +27,34 @@
#define COMPILER 1
#endif
/* This is a feature test - doesn't belong here. FixMe. */
#ifdef __MINGW32__
#define HAVE_WIN32_DLL_SUPPORT
#endif
#ifdef HAVE_WIN32_DLL_SUPPORT
# if __GNUC__ && !defined(__declspec)
# define DLLIMPORT
# else
# define DLLIMPORT __declspec(dllimport)
# define DLLIMPORT_DATA(x) _imp__##x
# endif
#else
# define DLLIMPORT
#endif
#ifdef COMPILING_RTS
#define DLL_IMPORT DLLIMPORT
#define DLL_IMPORT_RTS
#define DLL_IMPORT_DATA
#define DLL_IMPORT_DATA_VAR(x) x
#else
#define DLL_IMPORT
#define DLL_IMPORT_RTS DLLIMPORT
#define DLL_IMPORT_DATA DLLIMPORT
#define DLL_IMPORT_DATA_VAR(x) _imp__##x
#endif
/* bit macros
*/
#define BITS_PER_BYTE 8
...
...
@@ -129,8 +157,13 @@ void _stgAssert (char *, unsigned int);
#include "Hooks.h"
/* Misc stuff without a home */
#ifdef BUILDING_RTS_DLL
extern
DLLIMPORT
char
**
prog_argv
;
/* so we can get at these from Haskell */
extern
DLLIMPORT
int
prog_argc
;
#else
extern
char
**
prog_argv
;
/* so we can get at these from Haskell */
extern
int
prog_argc
;
#endif
extern
char
**
environ
;
...
...
ghc/includes/StgMacros.h
View file @
21462c00
/* -----------------------------------------------------------------------------
* $Id: StgMacros.h,v 1.
6
1999/0
2/26 09:28:43 simonm
Exp $
* $Id: StgMacros.h,v 1.
7
1999/0
3/02 19:44:18 sof
Exp $
*
* (c) The GHC Team, 1998-1999
*
...
...
@@ -39,20 +39,24 @@
--------------------------------------------------------------------------- */
#define STGFUN(f) StgFunPtr f(void)
#define STATICFUN(f) static StgFunPtr f(void)
#define EXTFUN(f) extern StgFunPtr f(void)
#define EXTFUN_RTS(f) extern DLL_IMPORT_RTS StgFunPtr f(void)
#define FN_(f) F_ f(void)
#define IFN_(f) static F_ f(void)
#define IF_(f) static F_ f(void)
#define EF_(f) extern F_ f(void)
#define EDF_(f) extern DLLIMPORT F_ f(void)
#define ED_ extern
#define EDD_ extern DLLIMPORT
#define ED_RO_ extern const
#define ID_ extern
#define ID_RO_ extern const
#define EI_ extern const StgInfoTable
#define EDI_ extern DLLIMPORT const StgInfoTable
#define II_ extern const StgInfoTable
#define EC_ extern StgClosure
#define EDC_ extern DLLIMPORT StgClosure
#define IC_ extern StgClosure
/* -----------------------------------------------------------------------------
...
...
@@ -121,7 +125,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
/* -----------------------------------------------------------------------------
Argument checks.
If (Sp + <n_args>) > Su { JMP_(stg_updatePAP); }
If (Sp + <n_args>) > Su { JMP_(stg_update
_
PAP); }
Sp points to the topmost used word on the stack, and Su points to
the most recently pushed update frame.
...
...
@@ -160,7 +164,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
#define STK_CHK(headroom,ret,r,layout,tag_assts) \
if (Sp - headroom < SpLim) { \
EXTFUN(stg_chk_##layout);
\
EXTFUN
_RTS
(stg_chk_##layout); \
tag_assts \
(r) = (P_)ret; \
JMP_(stg_chk_##layout); \
...
...
@@ -168,7 +172,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
#define HP_CHK(headroom,ret,r,layout,tag_assts) \
if ((Hp += headroom) > HpLim) { \
EXTFUN(stg_chk_##layout);
\
EXTFUN
_RTS
(stg_chk_##layout); \
tag_assts \
(r) = (P_)ret; \
JMP_(stg_chk_##layout); \
...
...
@@ -177,7 +181,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
#define HP_STK_CHK(stk_headroom,hp_headroom,ret,r,layout,tag_assts) \
if (Sp - stk_headroom < SpLim || (Hp += hp_headroom) > HpLim) { \
EXTFUN(stg_chk_##layout);
\
EXTFUN
_RTS
(stg_chk_##layout); \
tag_assts \
(r) = (P_)ret; \
JMP_(stg_chk_##layout); \
...
...
@@ -201,14 +205,14 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
#define STK_CHK_NP(headroom,ptrs,tag_assts) \
if ((Sp - (headroom)) < SpLim) { \
EXTFUN(stg_gc_enter_##ptrs); \
EXTFUN
_RTS
(stg_gc_enter_##ptrs); \
tag_assts \
JMP_(stg_gc_enter_##ptrs); \
}
#define HP_CHK_NP(headroom,ptrs,tag_assts) \
if ((Hp += (headroom)) > HpLim) { \
EXTFUN(stg_gc_enter_##ptrs); \
EXTFUN
_RTS
(stg_gc_enter_##ptrs); \
tag_assts \
JMP_(stg_gc_enter_##ptrs); \
} \
...
...
@@ -216,7 +220,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
#define HP_CHK_SEQ_NP(headroom,ptrs,tag_assts) \
if ((Hp += (headroom)) > HpLim) { \
EXTFUN(stg_gc_seq_##ptrs);
\
EXTFUN
_RTS
(stg_gc_seq_##ptrs); \
tag_assts \
JMP_(stg_gc_seq_##ptrs); \
} \
...
...
@@ -224,7 +228,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
#define HP_STK_CHK_NP(stk_headroom, hp_headroom, ptrs, tag_assts) \
if ((Sp - (stk_headroom)) < SpLim || (Hp += (hp_headroom)) > HpLim) { \
EXTFUN(stg_gc_enter_##ptrs); \
EXTFUN
_RTS
(stg_gc_enter_##ptrs); \
tag_assts \
JMP_(stg_gc_enter_##ptrs); \
} \
...
...
@@ -234,7 +238,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
#define GEN_HP_CHK_ALT(headroom,lbl,tag_assts) \
if ((Hp += (headroom)) > HpLim) { \
EXTFUN(lbl); \
EXTFUN
_RTS
(lbl); \
tag_assts \
JMP_(lbl); \
} \
...
...
@@ -349,9 +353,11 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
out to be slowing us down we can make specialised ones.
-------------------------------------------------------------------------- */
EF_
(
stg_gen_yield
);
EF_
(
stg_gen_block
);
#define YIELD(liveness,reentry) \
{ \
EF_(stg_gen_yield); \
R9.w = (W_)LIVENESS_MASK(liveness); \
R10.w = (W_)reentry; \
JMP_(stg_gen_yield); \
...
...
@@ -359,7 +365,6 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
#define BLOCK(liveness,reentry) \
{ \
EF_(stg_gen_block); \
R9.w = (W_)LIVENESS_MASK(liveness); \
R10.w = (W_)reentry; \
JMP_(stg_gen_block); \
...
...
@@ -367,7 +372,7 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
#define BLOCK_NP(ptrs) \
{ \
EF_(stg_bock_##ptrs); \
EF_(stg_b
l
ock_##ptrs); \
JMP_(stg_block_##ptrs); \
}
...
...
@@ -378,8 +383,11 @@ static inline int IS_ARG_TAG( StgWord p ) { return p <= ARGTAG_MAX; }
We use a RET_DYN frame the same as for a dynamic heap check.
------------------------------------------------------------------------- */
#if COMPILING_RTS
EI_
(
stg_gen_chk_info
);
#else
EDI_
(
stg_gen_chk_info
);
#endif
/* -----------------------------------------------------------------------------
Vectored Returns
...
...
@@ -530,11 +538,11 @@ typedef union
}
int64_thing
;
typedef
union
{
Stg
Nat
64
w
;
{
Stg
Word
64
w
;
unpacked_double_word
wu
;
}
word64_thing
;
static
inline
void
ASSIGN_Word64
(
W_
p_dest
[],
Stg
Nat
64
src
)
static
inline
void
ASSIGN_Word64
(
W_
p_dest
[],
Stg
Word
64
src
)
{
word64_thing
y
;
y
.
w
=
src
;
...
...
@@ -542,7 +550,7 @@ static inline void ASSIGN_Word64(W_ p_dest[], StgNat64 src)
p_dest
[
1
]
=
y
.
wu
.
dlo
;
}
static
inline
Stg
Nat
64
PK_Word64
(
W_
p_src
[])
static
inline
Stg
Word
64
PK_Word64
(
W_
p_src
[])
{
word64_thing
y
;