Import Debian changes 20180207-1
[hcoop/debian/mlton.git] / include / c-main.h
CommitLineData
7f918cf1
CE
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_MAIN_H_
10#define _C_MAIN_H_
11
12#include "common-main.h"
13#include "c-common.h"
14
15static GC_frameIndex returnAddressToFrameIndex (GC_returnAddress ra) {
16 return (GC_frameIndex)ra;
17}
18
19#define MLtonCallFromC \
20/* Globals */ \
21PRIVATE uintptr_t nextFun; \
22PRIVATE int returnToC; \
23static void MLton_callFromC () { \
24 struct cont cont; \
25 GC_state s; \
26 \
27 if (DEBUG_CCODEGEN) \
28 fprintf (stderr, "MLton_callFromC() starting\n"); \
29 s = &gcState; \
30 GC_setSavedThread (s, GC_getCurrentThread (s)); \
31 s->atomicState += 3; \
32 if (s->signalsInfo.signalIsPending) \
33 s->limit = s->limitPlusSlop - GC_HEAP_LIMIT_SLOP; \
34 /* Switch to the C Handler thread. */ \
35 GC_switchToThread (s, GC_getCallFromCHandlerThread (s), 0); \
36 nextFun = *(uintptr_t*)(s->stackTop - GC_RETURNADDRESS_SIZE); \
37 cont.nextChunk = nextChunks[nextFun]; \
38 returnToC = FALSE; \
39 do { \
40 cont=(*(struct cont(*)(void))cont.nextChunk)(); \
41 } while (not returnToC); \
42 returnToC = FALSE; \
43 s->atomicState += 1; \
44 GC_switchToThread (s, GC_getSavedThread (s), 0); \
45 s->atomicState -= 1; \
46 if (0 == s->atomicState \
47 && s->signalsInfo.signalIsPending) \
48 s->limit = 0; \
49 if (DEBUG_CCODEGEN) \
50 fprintf (stderr, "MLton_callFromC done\n"); \
51}
52
53#define MLtonMain(al, mg, mfs, mmc, pk, ps, mc, ml) \
54MLtonCallFromC \
55PUBLIC int MLton_main (int argc, char* argv[]) { \
56 struct cont cont; \
57 Initialize (al, mg, mfs, mmc, pk, ps); \
58 if (gcState.amOriginal) { \
59 real_Init(); \
60 PrepFarJump(mc, ml); \
61 } else { \
62 /* Return to the saved world */ \
63 nextFun = *(uintptr_t*)(gcState.stackTop - GC_RETURNADDRESS_SIZE); \
64 cont.nextChunk = nextChunks[nextFun]; \
65 } \
66 /* Trampoline */ \
67 while (1) { \
68 cont=(*(struct cont(*)(void))cont.nextChunk)(); \
69 cont=(*(struct cont(*)(void))cont.nextChunk)(); \
70 cont=(*(struct cont(*)(void))cont.nextChunk)(); \
71 cont=(*(struct cont(*)(void))cont.nextChunk)(); \
72 cont=(*(struct cont(*)(void))cont.nextChunk)(); \
73 cont=(*(struct cont(*)(void))cont.nextChunk)(); \
74 cont=(*(struct cont(*)(void))cont.nextChunk)(); \
75 cont=(*(struct cont(*)(void))cont.nextChunk)(); \
76 } \
77 return 1; \
78}
79
80#define MLtonLibrary(al, mg, mfs, mmc, pk, ps, mc, ml) \
81MLtonCallFromC \
82PUBLIC void LIB_OPEN(LIBNAME) (int argc, char* argv[]) { \
83 struct cont cont; \
84 Initialize (al, mg, mfs, mmc, pk, ps); \
85 if (gcState.amOriginal) { \
86 real_Init(); \
87 PrepFarJump(mc, ml); \
88 } else { \
89 /* Return to the saved world */ \
90 nextFun = *(uintptr_t*)(gcState.stackTop - GC_RETURNADDRESS_SIZE); \
91 cont.nextChunk = nextChunks[nextFun]; \
92 } \
93 /* Trampoline */ \
94 returnToC = FALSE; \
95 do { \
96 cont=(*(struct cont(*)(void))cont.nextChunk)(); \
97 } while (not returnToC); \
98} \
99PUBLIC void LIB_CLOSE(LIBNAME) () { \
100 struct cont cont; \
101 nextFun = *(uintptr_t*)(gcState.stackTop - GC_RETURNADDRESS_SIZE); \
102 cont.nextChunk = nextChunks[nextFun]; \
103 returnToC = FALSE; \
104 do { \
105 cont=(*(struct cont(*)(void))cont.nextChunk)(); \
106 } while (not returnToC); \
107 GC_done(&gcState); \
108}
109
110#endif /* #ifndef _C_MAIN_H */