blob: 3bbcbf1bd3627d5b09df5aaa2159b2e36dcfb264 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
#include "MachDeps.h"
#include "Rts.h"
#include "RtsAPI.h"
#include "rts/Messages.h"
#include "rts/Types.h"
#include "rts/storage/ClosureTypes.h"
#include "rts/storage/Closures.h"
#include "rts/storage/InfoTables.h"
StgWord stackFrameSize(StgStack *stack, StgWord index) {
StgClosure *c = (StgClosure *)stack->sp + index;
ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
return stack_frame_sizeW(c);
}
StgStack *getUnderflowFrameStack(StgStack *stack, StgWord index) {
StgClosure *frame = (StgClosure *)stack->sp + index;
ASSERT(LOOKS_LIKE_CLOSURE_PTR(frame));
const StgRetInfoTable *info = get_ret_itbl((StgClosure *)frame);
if (info->i.type == UNDERFLOW_FRAME) {
return ((StgUnderflowFrame *)frame)->next_chunk;
} else {
return NULL;
}
}
// Only exists to make the get_itbl macro available in Haskell code (via FFI).
const StgInfoTable *getItbl(StgClosure *closure) {
ASSERT(LOOKS_LIKE_CLOSURE_PTR(closure));
return get_itbl(closure);
};
StgWord getBitmapSize(StgClosure *c) {
ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
const StgInfoTable *info = get_itbl(c);
StgWord bitmap = info->layout.bitmap;
return BITMAP_SIZE(bitmap);
}
StgWord getRetFunBitmapSize(StgRetFun *ret_fun) {
ASSERT(LOOKS_LIKE_CLOSURE_PTR(ret_fun));
const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));
switch (fun_info->f.fun_type) {
case ARG_GEN:
return BITMAP_SIZE(fun_info->f.b.bitmap);
case ARG_GEN_BIG:
return GET_FUN_LARGE_BITMAP(fun_info)->size;
default:
return BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
}
}
StgWord getBitmapWord(StgClosure *c) {
ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
const StgInfoTable *info = get_itbl(c);
StgWord bitmap = info->layout.bitmap;
StgWord bitmapWord = BITMAP_BITS(bitmap);
return bitmapWord;
}
StgWord getRetFunBitmapWord(StgRetFun *ret_fun) {
ASSERT(LOOKS_LIKE_CLOSURE_PTR(ret_fun));
const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));
fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));
switch (fun_info->f.fun_type) {
case ARG_GEN:
return BITMAP_BITS(fun_info->f.b.bitmap);
case ARG_GEN_BIG:
// Cannot do more than warn and exit.
errorBelch("Unexpected ARG_GEN_BIG StgRetFun closure %p", ret_fun);
stg_exit(EXIT_INTERNAL_ERROR);
default:
return BITMAP_BITS(stg_arg_bitmaps[fun_info->f.fun_type]);
}
}
StgWord getLargeBitmapSize(StgClosure *c) {
ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
const StgInfoTable *info = get_itbl(c);
StgLargeBitmap *bitmap = GET_LARGE_BITMAP(info);
return bitmap->size;
}
StgWord getRetFunSize(StgRetFun *ret_fun) {
ASSERT(LOOKS_LIKE_CLOSURE_PTR(ret_fun));
const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));
fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));
switch (fun_info->f.fun_type) {
case ARG_GEN:
return BITMAP_SIZE(fun_info->f.b.bitmap);
case ARG_GEN_BIG:
return GET_FUN_LARGE_BITMAP(fun_info)->size;
default:
return BITMAP_SIZE(stg_arg_bitmaps[fun_info->f.fun_type]);
}
}
StgWord getBCOLargeBitmapSize(StgClosure *c) {
ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
StgBCO *bco = (StgBCO *)*c->payload;
return BCO_BITMAP_SIZE(bco);
}
StgWord *getLargeBitmap(Capability *cap, StgClosure *c) {
ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
const StgInfoTable *info = get_itbl(c);
StgLargeBitmap *bitmap = GET_LARGE_BITMAP(info);
return bitmap->bitmap;
}
StgWord *getRetFunLargeBitmap(Capability *cap, StgRetFun *ret_fun) {
ASSERT(LOOKS_LIKE_CLOSURE_PTR(ret_fun));
const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));
StgLargeBitmap *bitmap = GET_FUN_LARGE_BITMAP(fun_info);
return bitmap->bitmap;
}
StgWord *getBCOLargeBitmap(Capability *cap, StgClosure *c) {
ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
StgBCO *bco = (StgBCO *)*c->payload;
StgLargeBitmap *bitmap = BCO_BITMAP(bco);
return bitmap->bitmap;
}
StgStack *getUnderflowFrameNextChunk(StgUnderflowFrame *frame) {
return frame->next_chunk;
}
StgWord getRetFunType(StgRetFun *ret_fun) {
ASSERT(LOOKS_LIKE_CLOSURE_PTR(ret_fun));
const StgFunInfoTable *fun_info = get_fun_itbl(UNTAG_CLOSURE(ret_fun->fun));
return fun_info->f.fun_type;
}
StgClosure *getStackClosure(StgClosure **c) { return *c; }
|
