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 986 - (view) (download) (as text)

1 : monnier 249 /* run-ml.c
2 :     *
3 :     * COPYRIGHT (c) 1993 by AT&T Bell Laboratories.
4 :     */
5 :    
6 : blume 569 #include <stdio.h>
7 :    
8 : monnier 249 #include "ml-base.h"
9 :     #include "ml-limits.h"
10 :     #include "ml-values.h"
11 :     #include "vproc-state.h"
12 :     #include "ml-state.h"
13 :     #include "tags.h"
14 :     #include "ml-request.h"
15 :     #include "ml-objects.h"
16 :     #include "ml-globals.h"
17 :     #include "ml-signals.h"
18 :     #include "c-library.h"
19 :     #include "profile.h"
20 :     #include "gc.h"
21 :    
22 :     /* local functions */
23 :     PVT void UncaughtExn (ml_val_t e);
24 :    
25 :    
26 :     /* ApplyMLFn:
27 :     *
28 :     * Apply the ML closure f to arg and return the result. If the flag useCont
29 :     * is set, then the ML state has already been initialized with a return
30 :     * continuation (by SaveCState).
31 :     */
32 :     ml_val_t ApplyMLFn (ml_state_t *msp, ml_val_t f, ml_val_t arg, bool_t useCont)
33 :     {
34 :     InitMLState (msp);
35 :    
36 :     /* initialize the calling context */
37 :     msp->ml_exnCont = PTR_CtoML(handle_v+1);
38 :     msp->ml_varReg = ML_unit;
39 :     msp->ml_arg = arg;
40 :     if (! useCont)
41 :     msp->ml_cont = PTR_CtoML(return_c);
42 :     msp->ml_closure = f;
43 :     msp->ml_pc =
44 :     msp->ml_linkReg = GET_CODE_ADDR(f);
45 :    
46 :     RunML (msp);
47 :    
48 :     return msp->ml_arg;
49 :    
50 :     } /* end of ApplyMLFn */
51 :    
52 :    
53 :     /* RaiseMLExn:
54 :     *
55 :     * Modify the ML state, so that the given exception will be raised
56 :     * when ML is resumed.
57 :     */
58 :     void RaiseMLExn (ml_state_t *msp, ml_val_t exn)
59 :     {
60 :     ml_val_t kont = msp->ml_exnCont;
61 :    
62 :     /** NOTE: we should have a macro defined in ml-state.h for this **/
63 :     msp->ml_arg = exn;
64 :     msp->ml_closure = kont;
65 :     msp->ml_cont = ML_unit;
66 :     msp->ml_pc =
67 :     msp->ml_linkReg = GET_CODE_ADDR(kont);
68 :    
69 :     } /* end of RaiseMLExn. */
70 :    
71 : blume 569 extern int restoreregs (ml_state_t *msp);
72 : monnier 249
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 : blume 569 for (;;) {
82 : monnier 249
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 :     switch (request) {
134 :     case REQ_RETURN:
135 :     /* do a minor collection to clear the store list */
136 :     InvokeGC (msp, 0);
137 :     return;
138 :    
139 :     case REQ_EXN: /* an UncaughtExn exception */
140 :     UncaughtExn (msp->ml_arg);
141 :     return;
142 :    
143 :     case REQ_FAULT: { /* a hardware fault */
144 :     ml_val_t loc, traceStk, exn;
145 : blume 986 char *namestring;
146 :     if ((namestring = BO_AddrToCodeObjTag(msp->ml_faultPC)) != NIL(char *))
147 : monnier 249 {
148 :     char buf2[192];
149 : blume 986 sprintf(buf2, "<file %.184s>", namestring);
150 : monnier 249 loc = ML_CString(msp, buf2);
151 :     }
152 :     else
153 :     loc = ML_CString(msp, "<unknown file>");
154 :     LIST_cons(msp, traceStk, loc, LIST_nil);
155 :     EXN_ALLOC(msp, exn, msp->ml_faultExn, ML_unit, traceStk);
156 :     RaiseMLExn (msp, exn);
157 :     } break;
158 :    
159 :     case REQ_BIND_CFUN:
160 :     msp->ml_arg = BindCFun (
161 :     STR_MLtoC(REC_SEL(msp->ml_arg, 0)),
162 :     STR_MLtoC(REC_SEL(msp->ml_arg, 1)));
163 :     SETUP_RETURN(msp);
164 :     break;
165 :    
166 :     case REQ_CALLC: {
167 :     ml_val_t (*f)(), arg;
168 :    
169 :     SETUP_RETURN(msp);
170 :     if (NeedGC (msp, 8*ONE_K))
171 :     InvokeGC (msp, 0);
172 :    
173 :     #ifdef INDIRECT_CFUNC
174 :     f = ((cfunc_binding_t *)REC_SELPTR(Word_t, msp->ml_arg, 0))->cfunc;
175 :     # ifdef DEBUG_TRACE_CCALL
176 :     SayDebug("CALLC: %s (%#x)\n",
177 :     ((cfunc_binding_t *)REC_SELPTR(Word_t, msp->ml_arg, 0))->name,
178 :     REC_SEL(msp->ml_arg, 1));
179 :     # endif
180 :     #else
181 :     f = (cfunc_t) REC_SELPTR(Word_t, msp->ml_arg, 0);
182 :     # ifdef DEBUG_TRACE_CCALL
183 :     SayDebug("CALLC: %#x (%#x)\n", f, REC_SEL(msp->ml_arg, 1));
184 :     # endif
185 :     #endif
186 :     arg = REC_SEL(msp->ml_arg, 1);
187 :     msp->ml_arg = (*f)(msp, arg);
188 :     } break;
189 :    
190 :     case REQ_ALLOC_STRING:
191 :     msp->ml_arg = ML_AllocString (msp, INT_MLtoC(msp->ml_arg));
192 :     SETUP_RETURN(msp);
193 :     break;
194 :    
195 :     case REQ_ALLOC_BYTEARRAY:
196 :     msp->ml_arg = ML_AllocBytearray (msp, INT_MLtoC(msp->ml_arg));
197 :     SETUP_RETURN(msp);
198 :     break;
199 :    
200 :     case REQ_ALLOC_REALDARRAY:
201 :     msp->ml_arg = ML_AllocRealdarray (msp, INT_MLtoC(msp->ml_arg));
202 :     SETUP_RETURN(msp);
203 :     break;
204 :    
205 :     case REQ_ALLOC_ARRAY:
206 :     msp->ml_arg = ML_AllocArray (msp,
207 :     REC_SELINT(msp->ml_arg, 0), REC_SEL(msp->ml_arg, 1));
208 :     SETUP_RETURN(msp);
209 :     break;
210 :    
211 :     case REQ_ALLOC_VECTOR:
212 :     msp->ml_arg = ML_AllocVector (msp,
213 :     REC_SELINT(msp->ml_arg, 0), REC_SEL(msp->ml_arg, 1));
214 :     SETUP_RETURN(msp);
215 :     break;
216 :    
217 :     case REQ_SIG_RETURN:
218 :     #ifdef SIGNAL_DEBUG
219 :     SayDebug("REQ_SIG_RETURN: arg = %#x, pending = %d, inHandler = %d\n",
220 :     msp->ml_arg, vsp->vp_handlerPending, vsp->vp_inSigHandler);
221 :     #endif
222 :     /* throw to the continuation */
223 :     SETUP_THROW(msp, msp->ml_arg, ML_unit);
224 :     /* note that we are exiting the handler */
225 :     vsp->vp_inSigHandler = FALSE;
226 :     break;
227 :    
228 :     #ifdef SOFT_POLL
229 :     case REQ_POLL_RETURN:
230 :     /* throw to the continuation */
231 :     SETUP_THROW(msp, msp->ml_arg, ML_unit);
232 :     /* note that we are exiting the handler */
233 :     msp->ml_inPollHandler = FALSE;
234 :     ResetPollLimit (msp);
235 :     break;
236 :     #endif
237 :    
238 :     #ifdef SOFT_POLL
239 :     case REQ_POLL_RESUME:
240 :     #endif
241 :     case REQ_SIG_RESUME:
242 :     #ifdef SIGNAL_DEBUG
243 :     SayDebug("REQ_SIG_RESUME: arg = %#x\n", msp->ml_arg);
244 :     #endif
245 :     LoadResumeState (msp);
246 :     break;
247 :    
248 :     case REQ_BUILD_LITERALS:
249 :     Die ("BUILD_LITERALS request");
250 :     break;
251 :    
252 :     default:
253 :     Die ("unknown request code = %d", request);
254 :     break;
255 :     } /* end switch */
256 :     }
257 :     } /* end of while */
258 :    
259 :     } /* end of RunML */
260 :    
261 :    
262 :     /* UncaughtExn:
263 :     * Handle an uncaught exception.
264 :     */
265 :     PVT void UncaughtExn (ml_val_t e)
266 :     {
267 :     ml_val_t name = REC_SEL(REC_SEL(e, 0), 0);
268 :     ml_val_t val = REC_SEL(e, 1);
269 :     ml_val_t traceBack = REC_SEL(e, 2);
270 :     char buf[1024];
271 :    
272 :     if (isUNBOXED(val))
273 : blume 569 sprintf (buf, "%ld\n", (long int) INT_MLtoC(val));
274 : monnier 249 else {
275 :     ml_val_t desc = OBJ_DESC(val);
276 :     if (desc == DESC_string)
277 : blume 569 sprintf (buf, "\"%.*s\"", (int) GET_SEQ_LEN(val), STR_MLtoC(val));
278 : monnier 249 else
279 :     sprintf (buf, "<unknown>");
280 :     }
281 :    
282 :     if (traceBack != LIST_nil) {
283 :     /* find the information about where this exception was raised */
284 :     ml_val_t next = traceBack;
285 :     do {
286 :     traceBack = next;
287 :     next = LIST_tl(traceBack);
288 :     } while (next != LIST_nil);
289 :     val = LIST_hd(traceBack);
290 :     sprintf (buf+strlen(buf), " raised at %.*s",
291 : blume 569 (int) GET_SEQ_LEN(val), STR_MLtoC(val));
292 : monnier 249 }
293 :    
294 :     Die ("Uncaught exception %.*s with %s\n",
295 :     GET_SEQ_LEN(name), GET_SEQ_DATAPTR(char, name), buf);
296 :    
297 :     Exit (1);
298 :    
299 :     } /* end of UncaughtExn */

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