Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/runtime/kernel/run-ml.c
ViewVC logotype

Annotation of /sml/trunk/src/runtime/kernel/run-ml.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 224 - (view) (download) (as text)

1 : monnier 2 /* run-ml.c
2 :     *
3 :     * COPYRIGHT (c) 1993 by AT&T Bell Laboratories.
4 :     */
5 :    
6 :     #include "ml-base.h"
7 :     #include "ml-limits.h"
8 :     #include "ml-values.h"
9 :     #include "vproc-state.h"
10 :     #include "reg-mask.h"
11 :     #include "ml-state.h"
12 :     #include "tags.h"
13 :     #include "ml-request.h"
14 :     #include "ml-objects.h"
15 :     #include "ml-globals.h"
16 :     #include "ml-signals.h"
17 :     #include "c-library.h"
18 :     #include "profile.h"
19 : monnier 8 #include "gc.h"
20 : monnier 2
21 :     /* local functions */
22 :     PVT void UncaughtExn (ml_val_t e);
23 :    
24 :    
25 :     /* ApplyMLFn:
26 :     *
27 :     * Apply the ML closure f to arg and return the result. If the flag useCont
28 :     * is set, then the ML state has already been initialized with a return
29 :     * continuation (by SaveCState).
30 :     */
31 :     ml_val_t ApplyMLFn (ml_state_t *msp, ml_val_t f, ml_val_t arg, bool_t useCont)
32 :     {
33 :     int i;
34 :    
35 :     InitMLState (msp);
36 :    
37 :     /* initialize the calling context */
38 :     msp->ml_exnCont = PTR_CtoML(handle_v+1);
39 :     msp->ml_varReg = ML_unit;
40 :     msp->ml_arg = arg;
41 :     if (! useCont)
42 :     msp->ml_cont = PTR_CtoML(return_c);
43 :     msp->ml_closure = f;
44 :     msp->ml_pc =
45 :     msp->ml_linkReg = GET_CODE_ADDR(f);
46 :    
47 :     RunML (msp);
48 :    
49 :     return msp->ml_arg;
50 :    
51 :     } /* end of ApplyMLFn */
52 :    
53 :    
54 :     /* RaiseMLExn:
55 :     *
56 :     * Modify the ML state, so that the given exception will be raised
57 :     * when ML is resumed.
58 :     */
59 :     void RaiseMLExn (ml_state_t *msp, ml_val_t exn)
60 :     {
61 :     ml_val_t kont = msp->ml_exnCont;
62 :    
63 :     /** NOTE: we should have a macro defined in ml-state.h for this **/
64 :     msp->ml_arg = exn;
65 :     msp->ml_closure = kont;
66 :     msp->ml_cont = ML_unit;
67 :     msp->ml_pc =
68 :     msp->ml_linkReg = GET_CODE_ADDR(kont);
69 :    
70 :     } /* end of RaiseMLExn. */
71 :    
72 :    
73 :     /* RunML:
74 :     */
75 :     void RunML (ml_state_t *msp)
76 :     {
77 :     int request;
78 :     vproc_state_t *vsp = msp->ml_vproc;
79 :     ml_val_t prevProfIndex = PROF_OTHER;
80 :    
81 :     while (TRUE) {
82 :    
83 :     ASSIGN(ProfCurrent, prevProfIndex);
84 :     request = restoreregs(msp);
85 :     prevProfIndex = DEREF(ProfCurrent);
86 :     ASSIGN(ProfCurrent, PROF_RUNTIME);
87 :    
88 :     if (request == REQ_GC) {
89 :     if (vsp->vp_handlerPending) { /* this is really a signal */
90 :     /* check for GC */
91 :     if (NeedGC (msp, 4*ONE_K))
92 :     InvokeGC (msp, 0);
93 :     /* invoke the ML signal handler */
94 :     ChooseSignal (vsp);
95 :     msp->ml_arg = MakeHandlerArg (msp, sigh_resume);
96 :     msp->ml_cont = PTR_CtoML(sigh_return_c);
97 :     msp->ml_exnCont = PTR_CtoML(handle_v+1);
98 :     msp->ml_closure = DEREF(MLSignalHandler);
99 :     msp->ml_pc =
100 :     msp->ml_linkReg = GET_CODE_ADDR(msp->ml_closure);
101 :     vsp->vp_inSigHandler = TRUE;
102 :     vsp->vp_handlerPending = FALSE;
103 :     }
104 :     #ifdef SOFT_POLL
105 :     else if (msp->ml_pollPending && !msp->ml_inPollHandler) {
106 :     /* this is a poll event */
107 :     #if defined(MP_SUPPORT) && defined(MP_GCPOLL)
108 :     /* Note: under MP, polling is used for GC only */
109 :     #ifdef POLL_DEBUG
110 :     SayDebug ("run-ml: poll event\n");
111 :     #endif
112 :     msp->ml_pollPending = FALSE;
113 :     InvokeGC (msp,0);
114 :     #else
115 :     /* check for GC */
116 :     if (NeedGC (msp, 4*ONE_K))
117 :     InvokeGC (msp, 0);
118 :     msp->ml_arg = MakeResumeCont(msp, pollh_resume);
119 :     msp->ml_cont = PTR_CtoML(pollh_return_c);
120 :     msp->ml_exnCont = PTR_CtoML(handle_v+1);
121 :     msp->ml_closure = DEREF(MLPollHandler);
122 :     msp->ml_pc =
123 :     msp->ml_linkReg = GET_CODE_ADDR(msp->ml_closure);
124 :     msp->ml_inPollHandler = TRUE;
125 :     msp->ml_pollPending = FALSE;
126 :     #endif /* MP_SUPPORT */
127 :     }
128 :     #endif /* SOFT_POLL */
129 :     else
130 :     InvokeGC (msp, 0);
131 :     }
132 :     else {
133 :     #ifdef BASE_INDX
134 :     msp->ml_baseReg = ML_unit; /* not a live root */
135 :     #endif
136 :     switch (request) {
137 :     case REQ_RETURN:
138 :     /* do a minor collection to clear the store list; we set the PC to
139 :     * a non-root value, incase the minor collection triggers a major
140 :     * collection.
141 :     */
142 :     msp->ml_pc = ML_unit;
143 :     InvokeGC (msp, 0);
144 :     return;
145 :    
146 :     case REQ_EXN: /* an UncaughtExn exception */
147 :     UncaughtExn (msp->ml_arg);
148 :     return;
149 :    
150 : monnier 8 case REQ_FAULT: { /* a hardware fault */
151 :     ml_val_t loc, traceStk, exn;
152 :     char buf1[128];
153 :     if (BO_AddrToCodeObjTag(msp->ml_faultPC, buf1, sizeof(buf1))
154 :     != NIL(char *))
155 :     {
156 :     char buf2[192];
157 :     sprintf(buf2, "<file %s>", buf1);
158 :     loc = ML_CString(msp, buf2);
159 :     }
160 :     else
161 :     loc = ML_CString(msp, "<unknown file>");
162 :     LIST_cons(msp, traceStk, loc, LIST_nil);
163 :     EXN_ALLOC(msp, exn, msp->ml_faultExn, ML_unit, traceStk);
164 :     RaiseMLExn (msp, exn);
165 :     } break;
166 : monnier 2
167 :     case REQ_BIND_CFUN:
168 :     msp->ml_arg = BindCFun (
169 : monnier 223 STR_MLtoC(REC_SEL(msp->ml_arg, 0)),
170 :     STR_MLtoC(REC_SEL(msp->ml_arg, 1)));
171 : monnier 2 SETUP_RETURN(msp);
172 :     break;
173 :    
174 :     case REQ_CALLC: {
175 :     ml_val_t (*f)(), arg;
176 :    
177 :     SETUP_RETURN(msp);
178 :     msp->ml_liveRegMask = RET_MASK;
179 :     if (NeedGC (msp, 8*ONE_K))
180 :     InvokeGC (msp, 0);
181 :    
182 :     #ifdef INDIRECT_CFUNC
183 :     f = ((cfunc_binding_t *)REC_SELPTR(Word_t, msp->ml_arg, 0))->cfunc;
184 :     # ifdef DEBUG_TRACE_CCALL
185 :     SayDebug("CALLC: %s (%#x)\n",
186 :     ((cfunc_binding_t *)REC_SELPTR(Word_t, msp->ml_arg, 0))->name,
187 :     REC_SEL(msp->ml_arg, 1));
188 :     # endif
189 :     #else
190 :     f = (cfunc_t) REC_SELPTR(Word_t, msp->ml_arg, 0);
191 :     # ifdef DEBUG_TRACE_CCALL
192 :     SayDebug("CALLC: %#x (%#x)\n", f, REC_SEL(msp->ml_arg, 1));
193 :     # endif
194 :     #endif
195 :     arg = REC_SEL(msp->ml_arg, 1);
196 :     msp->ml_arg = (*f)(msp, arg);
197 :     } break;
198 :    
199 :     case REQ_ALLOC_STRING:
200 :     msp->ml_arg = ML_AllocString (msp, INT_MLtoC(msp->ml_arg));
201 :     SETUP_RETURN(msp);
202 :     break;
203 :    
204 :     case REQ_ALLOC_BYTEARRAY:
205 :     msp->ml_arg = ML_AllocBytearray (msp, INT_MLtoC(msp->ml_arg));
206 :     SETUP_RETURN(msp);
207 :     break;
208 :    
209 :     case REQ_ALLOC_REALDARRAY:
210 :     msp->ml_arg = ML_AllocRealdarray (msp, INT_MLtoC(msp->ml_arg));
211 :     SETUP_RETURN(msp);
212 :     break;
213 :    
214 :     case REQ_ALLOC_ARRAY:
215 :     msp->ml_arg = ML_AllocArray (msp,
216 :     REC_SELINT(msp->ml_arg, 0), REC_SEL(msp->ml_arg, 1));
217 :     SETUP_RETURN(msp);
218 :     break;
219 :    
220 :     case REQ_ALLOC_VECTOR:
221 :     msp->ml_arg = ML_AllocVector (msp,
222 :     REC_SELINT(msp->ml_arg, 0), REC_SEL(msp->ml_arg, 1));
223 :     SETUP_RETURN(msp);
224 :     break;
225 :    
226 :     case REQ_SIG_RETURN:
227 :     #ifdef SIGNAL_DEBUG
228 :     SayDebug("REQ_SIG_RETURN: arg = %#x, pending = %d, inHandler = %d\n",
229 :     msp->ml_arg, vsp->vp_handlerPending, vsp->vp_inSigHandler);
230 :     #endif
231 :     /* throw to the continuation */
232 :     SETUP_THROW(msp, msp->ml_arg, ML_unit);
233 :     /* note that we are exiting the handler */
234 :     vsp->vp_inSigHandler = FALSE;
235 :     break;
236 :    
237 :     #ifdef SOFT_POLL
238 :     case REQ_POLL_RETURN:
239 :     /* throw to the continuation */
240 :     SETUP_THROW(msp, msp->ml_arg, ML_unit);
241 :     /* note that we are exiting the handler */
242 :     msp->ml_inPollHandler = FALSE;
243 :     ResetPollLimit (msp);
244 :     break;
245 :     #endif
246 :    
247 :     #ifdef SOFT_POLL
248 :     case REQ_POLL_RESUME:
249 :     #endif
250 :     case REQ_SIG_RESUME:
251 :     #ifdef SIGNAL_DEBUG
252 :     SayDebug("REQ_SIG_RESUME: arg = %#x\n", msp->ml_arg);
253 :     #endif
254 :     LoadResumeState (msp);
255 :     break;
256 :    
257 :     case REQ_BUILD_LITERALS:
258 : monnier 223 Die ("BUILD_LITERALS request");
259 : monnier 2 break;
260 :    
261 :     default:
262 :     Die ("unknown request code = %d", request);
263 :     break;
264 :     } /* end switch */
265 :     }
266 :     } /* end of while */
267 :    
268 :     } /* end of RunML */
269 :    
270 :    
271 :     /* UncaughtExn:
272 :     * Handle an uncaught exception.
273 :     */
274 :     PVT void UncaughtExn (ml_val_t e)
275 :     {
276 :     ml_val_t name = REC_SEL(REC_SEL(e, 0), 0);
277 :     ml_val_t val = REC_SEL(e, 1);
278 :     ml_val_t traceBack = REC_SEL(e, 2);
279 :     char buf[1024];
280 :    
281 :     if (isUNBOXED(val))
282 :     sprintf (buf, "%d\n", INT_MLtoC(val));
283 :     else {
284 : monnier 223 ml_val_t desc = OBJ_DESC(val);
285 :     if (desc == DESC_string)
286 :     sprintf (buf, "\"%.*s\"", GET_SEQ_LEN(val), STR_MLtoC(val));
287 : monnier 2 else
288 :     sprintf (buf, "<unknown>");
289 :     }
290 :    
291 :     if (traceBack != LIST_nil) {
292 :     /* find the information about where this exception was raised */
293 :     ml_val_t next = traceBack;
294 :     do {
295 :     traceBack = next;
296 :     next = LIST_tl(traceBack);
297 :     } while (next != LIST_nil);
298 :     val = LIST_hd(traceBack);
299 :     sprintf (buf+strlen(buf), " raised at %.*s",
300 : monnier 223 GET_SEQ_LEN(val), STR_MLtoC(val));
301 : monnier 2 }
302 :    
303 :     Die ("Uncaught exception %.*s with %s\n",
304 : monnier 223 GET_SEQ_LEN(name), GET_SEQ_DATAPTR(char, name), buf);
305 : monnier 2
306 :     Exit (1);
307 :    
308 :     } /* end of UncaughtExn */

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0