Import Debian changes 20180207-1
[hcoop/debian/mlton.git] / include / c-chunk.h
1 /* Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh
2 * Jagannathan, and Stephen Weeks.
3 * Copyright (C) 1997-2000 NEC Research Institute.
4 *
5 * MLton is released under a BSD-style license.
6 * See the file MLton-LICENSE for details.
7 */
8
9 #ifndef _C_CHUNK_H_
10 #define _C_CHUNK_H_
11
12 #include <stdio.h>
13
14 #include "ml-types.h"
15 #include "c-types.h"
16 #include "c-common.h"
17
18 #ifndef TRUE
19 #define TRUE 1
20 #endif
21
22 #ifndef FALSE
23 #define FALSE 0
24 #endif
25
26 #ifndef DEBUG_CCODEGEN
27 #define DEBUG_CCODEGEN FALSE
28 #endif
29
30 #define GCState ((Pointer)&gcState)
31 #define ExnStack *(size_t*)(GCState + ExnStackOffset)
32 #define FrontierMem *(Pointer*)(GCState + FrontierOffset)
33 #define Frontier frontier
34 #define StackBottom *(Pointer*)(GCState + StackBottomOffset)
35 #define StackTopMem *(Pointer*)(GCState + StackTopOffset)
36 #define StackTop stackTop
37
38 /* ------------------------------------------------- */
39 /* Memory */
40 /* ------------------------------------------------- */
41
42 #define C(ty, x) (*(ty*)(x))
43 #define G(ty, i) (global##ty [i])
44 #define GPNR(i) G(ObjptrNonRoot, i)
45 #define O(ty, b, o) (*(ty*)((b) + (o)))
46 #define X(ty, b, i, s, o) (*(ty*)((b) + ((i) * (s)) + (o)))
47 #define S(ty, i) *(ty*)(StackTop + (i))
48
49 /* ------------------------------------------------- */
50 /* Tests */
51 /* ------------------------------------------------- */
52
53 #define IsInt(p) (0x3 & (int)(p))
54
55 #define BZ(x, l) \
56 do { \
57 if (DEBUG_CCODEGEN) \
58 fprintf (stderr, "%s:%d: BZ(%d, %s)\n", \
59 __FILE__, __LINE__, (x), #l); \
60 if (0 == (x)) goto l; \
61 } while (0)
62
63 #define BNZ(x, l) \
64 do { \
65 if (DEBUG_CCODEGEN) \
66 fprintf (stderr, "%s:%d: BNZ(%d, %s)\n", \
67 __FILE__, __LINE__, (x), #l); \
68 if (x) goto l; \
69 } while (0)
70
71 #define FlushFrontier() \
72 do { \
73 FrontierMem = Frontier; \
74 } while (0)
75
76 #define FlushStackTop() \
77 do { \
78 StackTopMem = StackTop; \
79 } while (0)
80
81 #define CacheFrontier() \
82 do { \
83 Frontier = FrontierMem; \
84 } while (0)
85
86 #define CacheStackTop() \
87 do { \
88 StackTop = StackTopMem; \
89 } while (0)
90
91 /* ------------------------------------------------- */
92 /* Chunk */
93 /* ------------------------------------------------- */
94
95 #if (defined (__sun__) && defined (REGISTER_FRONTIER_STACKTOP))
96 #define Chunk(n) \
97 DeclareChunk(n) { \
98 struct cont cont; \
99 register unsigned int frontier asm("g5"); \
100 uintptr_t l_nextFun = nextFun; \
101 register unsigned int stackTop asm("g6");
102 #else
103 #define Chunk(n) \
104 DeclareChunk(n) { \
105 struct cont cont; \
106 Pointer frontier; \
107 uintptr_t l_nextFun = nextFun; \
108 Pointer stackTop;
109 #endif
110
111 #define ChunkSwitch(n) \
112 if (DEBUG_CCODEGEN) \
113 fprintf (stderr, "%s:%d: entering chunk %d l_nextFun = %d\n", \
114 __FILE__, __LINE__, n, (int)l_nextFun); \
115 CacheFrontier(); \
116 CacheStackTop(); \
117 while (1) { \
118 top: \
119 switch (l_nextFun) {
120
121 #define EndChunk \
122 default: \
123 /* interchunk return */ \
124 nextFun = l_nextFun; \
125 cont.nextChunk = (void*)nextChunks[nextFun]; \
126 leaveChunk: \
127 FlushFrontier(); \
128 FlushStackTop(); \
129 return cont; \
130 } /* end switch (l_nextFun) */ \
131 } /* end while (1) */ \
132 } /* end chunk */
133
134 /* ------------------------------------------------- */
135 /* Calling SML from C */
136 /* ------------------------------------------------- */
137
138 #define Thread_returnToC() \
139 do { \
140 if (DEBUG_CCODEGEN) \
141 fprintf (stderr, "%s:%d: Thread_returnToC()\n", \
142 __FILE__, __LINE__); \
143 returnToC = TRUE; \
144 return cont; \
145 } while (0)
146
147 /* ------------------------------------------------- */
148 /* farJump */
149 /* ------------------------------------------------- */
150
151 #define FarJump(n, l) \
152 do { \
153 PrepFarJump(n, l); \
154 goto leaveChunk; \
155 } while (0)
156
157 /* ------------------------------------------------- */
158 /* Stack */
159 /* ------------------------------------------------- */
160
161 #define Push(bytes) \
162 do { \
163 if (DEBUG_CCODEGEN) \
164 fprintf (stderr, "%s:%d: Push (%d)\n", \
165 __FILE__, __LINE__, bytes); \
166 StackTop += (bytes); \
167 } while (0)
168
169 #define Return() \
170 do { \
171 l_nextFun = *(uintptr_t*)(StackTop - sizeof(void*)); \
172 if (DEBUG_CCODEGEN) \
173 fprintf (stderr, "%s:%d: Return() l_nextFun = %d\n", \
174 __FILE__, __LINE__, (int)l_nextFun); \
175 goto top; \
176 } while (0)
177
178 #define Raise() \
179 do { \
180 if (DEBUG_CCODEGEN) \
181 fprintf (stderr, "%s:%d: Raise\n", \
182 __FILE__, __LINE__); \
183 StackTop = StackBottom + ExnStack; \
184 Return(); \
185 } while (0) \
186
187 /* ------------------------------------------------- */
188 /* Primitives */
189 /* ------------------------------------------------- */
190
191 #ifndef MLTON_CODEGEN_STATIC_INLINE
192 #define MLTON_CODEGEN_STATIC_INLINE static inline
193 #endif
194 /* Declare inlined math functions, since <math.h> isn't included.
195 */
196 #ifndef MLTON_CODEGEN_MATHFN
197 #define MLTON_CODEGEN_MATHFN(decl) decl
198 #endif
199 /* WordS<N>_quot and WordS<N>_rem can't be inlined with the C-codegen,
200 * because the gcc optimizer sometimes produces incorrect results when
201 * one of the arguments is a constant.
202 */
203 #ifndef MLTON_CODEGEN_WORDSQUOTREM
204 #define MLTON_CODEGEN_WORDSQUOTREM(func) PRIVATE
205 #endif
206 #ifndef MLTON_CODEGEN_WORDSQUOTREM_IMPL
207 #define MLTON_CODEGEN_WORDSQUOTREM_IMPL(func)
208 #endif
209 /* Declare memcpy, since <string.h> isn't included.
210 */
211 #ifndef MLTON_CODEGEN_MEMCPY
212 #define MLTON_CODEGEN_MEMCPY(decl)
213 #endif
214 MLTON_CODEGEN_MEMCPY(void * memcpy(void *, const void*, size_t);)
215 #include "basis-ffi.h"
216 #include "basis/coerce.h"
217 #include "basis/cpointer.h"
218 #include "basis/Real/Real-ops.h"
219 #include "basis/Real/Math-fns.h"
220 #include "basis/Word/Word-ops.h"
221 #include "basis/Word/Word-consts.h"
222 #include "basis/Word/Word-check.h"
223
224 /* ------------------------------------------------- */
225 /* Word */
226 /* ------------------------------------------------- */
227
228 #define WordS_addCheckCX(size, dst, cW, xW, l) \
229 do { \
230 WordS##size c = cW; \
231 WordS##size x = xW; \
232 WordS_addCheckBodyCX(size, c, x, goto l, dst = c + x); \
233 } while (0)
234 #define WordS8_addCheckCX(dst, c, x, l) WordS_addCheckCX(8, dst, c, x, l)
235 #define WordS16_addCheckCX(dst, c, x, l) WordS_addCheckCX(16, dst, c, x, l)
236 #define WordS32_addCheckCX(dst, c, x, l) WordS_addCheckCX(32, dst, c, x, l)
237 #define WordS64_addCheckCX(dst, c, x, l) WordS_addCheckCX(64, dst, c, x, l)
238
239 #define WordS8_addCheckXC(dst, x, c, l) WordS8_addCheckCX(dst, c, x, l)
240 #define WordS16_addCheckXC(dst, x, c, l) WordS16_addCheckCX(dst, c, x, l)
241 #define WordS32_addCheckXC(dst, x, c, l) WordS32_addCheckCX(dst, c, x, l)
242 #define WordS64_addCheckXC(dst, x, c, l) WordS64_addCheckCX(dst, c, x, l)
243
244 #define WordS8_addCheck WordS8_addCheckXC
245 #define WordS16_addCheck WordS16_addCheckXC
246 #define WordS32_addCheck WordS32_addCheckXC
247 #define WordS64_addCheck WordS64_addCheckXC
248
249
250 #define WordU_addCheckCX(size, dst, cW, xW, l) \
251 do { \
252 WordU##size c = cW; \
253 WordU##size x = xW; \
254 WordU_addCheckBodyCX(size, c, x, goto l, dst = c + x); \
255 } while (0)
256 #define WordU8_addCheckCX(dst, c, x, l) WordU_addCheckCX(8, dst, c, x, l)
257 #define WordU16_addCheckCX(dst, c, x, l) WordU_addCheckCX(16, dst, c, x, l)
258 #define WordU32_addCheckCX(dst, c, x, l) WordU_addCheckCX(32, dst, c, x, l)
259 #define WordU64_addCheckCX(dst, c, x, l) WordU_addCheckCX(64, dst, c, x, l)
260
261 #define WordU8_addCheckXC(dst, x, c, l) WordU8_addCheckCX(dst, c, x, l)
262 #define WordU16_addCheckXC(dst, x, c, l) WordU16_addCheckCX(dst, c, x, l)
263 #define WordU32_addCheckXC(dst, x, c, l) WordU32_addCheckCX(dst, c, x, l)
264 #define WordU64_addCheckXC(dst, x, c, l) WordU64_addCheckCX(dst, c, x, l)
265
266 #define WordU8_addCheck WordU8_addCheckXC
267 #define WordU16_addCheck WordU16_addCheckXC
268 #define WordU32_addCheck WordU32_addCheckXC
269 #define WordU64_addCheck WordU64_addCheckXC
270
271
272 #define WordS_negCheck(size, dst, xW, l) \
273 do { \
274 WordS##size x = xW; \
275 WordS_negCheckBody(size, x, goto l, dst = -x); \
276 } while (0)
277 #define Word8_negCheck(dst, x, l) WordS_negCheck(8, dst, x, l)
278 #define Word16_negCheck(dst, x, l) WordS_negCheck(16, dst, x, l)
279 #define Word32_negCheck(dst, x, l) WordS_negCheck(32, dst, x, l)
280 #define Word64_negCheck(dst, x, l) WordS_negCheck(64, dst, x, l)
281
282
283 #define WordS_subCheckCX(size, dst, cW, xW, l) \
284 do { \
285 WordS##size c = cW; \
286 WordS##size x = xW; \
287 WordS_subCheckBodyCX(size, c, x, goto l, dst = c - x); \
288 } while (0)
289 #define WordS8_subCheckCX(dst, c, x, l) WordS_subCheckCX(8, dst, c, x, l)
290 #define WordS16_subCheckCX(dst, c, x, l) WordS_subCheckCX(16, dst, c, x, l)
291 #define WordS32_subCheckCX(dst, c, x, l) WordS_subCheckCX(32, dst, c, x, l)
292 #define WordS64_subCheckCX(dst, c, x, l) WordS_subCheckCX(64, dst, c, x, l)
293
294 #define WordS_subCheckXC(size, dst, xW, cW, l) \
295 do { \
296 WordS##size x = xW; \
297 WordS##size c = cW; \
298 WordS_subCheckBodyXC(size, x, c, goto l, dst = x - c); \
299 } while (0)
300 #define WordS8_subCheckXC(dst, x, c, l) WordS_subCheckXC(8, dst, x, c, l)
301 #define WordS16_subCheckXC(dst, x, c, l) WordS_subCheckXC(16, dst, x, c, l)
302 #define WordS32_subCheckXC(dst, x, c, l) WordS_subCheckXC(32, dst, x, c, l)
303 #define WordS64_subCheckXC(dst, x, c, l) WordS_subCheckXC(64, dst, x, c, l)
304
305 #define WordS8_subCheck WordS8_subCheckXC
306 #define WordS16_subCheck WordS16_subCheckXC
307 #define WordS32_subCheck WordS32_subCheckXC
308 #define WordS64_subCheck WordS64_subCheckXC
309
310
311 #define WordS_mulCheck(size, dst, xW, yW, l) \
312 do { \
313 WordS##size x = xW; \
314 WordS##size y = yW; \
315 WordS_mulCheckBody(size, x, y, goto l, dst = x * y); \
316 } while (0)
317 #define WordS8_mulCheck(dst, x, y, l) WordS_mulCheck(8, dst, x, y, l)
318 #define WordS16_mulCheck(dst, x, y, l) WordS_mulCheck(16, dst, x, y, l)
319 #define WordS32_mulCheck(dst, x, y, l) WordS_mulCheck(32, dst, x, y, l)
320 #define WordS64_mulCheck(dst, x, y, l) WordS_mulCheck(64, dst, x, y, l)
321
322 #define WordU_mulCheck(size, dst, xW, yW, l) \
323 do { \
324 WordU##size x = xW; \
325 WordU##size y = yW; \
326 WordU_mulCheckBody(size, x, y, goto l, dst = x * y); \
327 } while (0)
328 #define WordU8_mulCheck(dst, x, y, l) WordU_mulCheck(8, dst, x, y, l)
329 #define WordU16_mulCheck(dst, x, y, l) WordU_mulCheck(16, dst, x, y, l)
330 #define WordU32_mulCheck(dst, x, y, l) WordU_mulCheck(32, dst, x, y, l)
331 #define WordU64_mulCheck(dst, x, y, l) WordU_mulCheck(64, dst, x, y, l)
332
333 #endif /* #ifndef _C_CHUNK_H_ */