1 /*
2 * Copyright © 1988-2004 Keith Packard and Bart Massey.
3 * All Rights Reserved. See the file COPYING in this directory
4 * for licensing information.
5 */
6
7 #include <assert.h>
8 #include "nickle.h"
9 #include "ref.h"
10
11 Value running;
12 Value stopped;
13 Bool signalException;
14
15 extern void dumpSleep (void), dumpThreads (void);
16
17 static void
_ThreadInsert(Value thread)18 _ThreadInsert (Value thread)
19 {
20 Value *prev, t;
21
22 switch (thread->thread.state) {
23 case ThreadRunning:
24 prev = &running;
25 break;
26 case ThreadSuspended:
27 prev = &stopped;
28 break;
29 case ThreadFinished:
30 default:
31 return;
32 }
33 for (; (t = *prev); prev = &t->thread.next)
34 if (t->thread.priority < thread->thread.priority)
35 break;
36 thread->thread.next = t;
37 *prev = thread;
38 }
39
40 static void
_ThreadRemove(Value thread)41 _ThreadRemove (Value thread)
42 {
43 Value *prev;
44
45 switch (thread->thread.state) {
46 case ThreadRunning:
47 prev = &running;
48 break;
49 case ThreadSuspended:
50 prev = &stopped;
51 break;
52 case ThreadFinished:
53 default:
54 return;
55 }
56 for (; *prev != thread; prev = &(*prev)->thread.next);
57 *prev = thread->thread.next;
58 }
59
60 void
ThreadSetState(Value thread,ThreadState state)61 ThreadSetState (Value thread, ThreadState state)
62 {
63 if (state != thread->thread.state)
64 {
65 _ThreadRemove (thread);
66 thread->thread.state = state;
67 _ThreadInsert (thread);
68 }
69 }
70
71 void
ThreadSleep(Value thread,Value sleep,int priority)72 ThreadSleep (Value thread, Value sleep, int priority)
73 {
74 thread->thread.priority = priority;
75 thread->thread.sleep = sleep;
76 SetSignalSuspend ();
77 }
78
79 void
ThreadStepped(Value thread)80 ThreadStepped (Value thread)
81 {
82 Value t;
83
84 if ((t = thread->thread.next) &&
85 thread->thread.priority <= t->thread.priority)
86 {
87 _ThreadRemove (thread);
88 _ThreadInsert (thread);
89 }
90 }
91
92 void
ThreadsWakeup(Value sleep,WakeKind kind)93 ThreadsWakeup (Value sleep, WakeKind kind)
94 {
95 Value thread, next;
96
97 for (thread = stopped; thread; thread = next)
98 {
99 next = thread->thread.next;
100 if ((thread->thread.state == ThreadSuspended) &&
101 thread->thread.sleep == sleep)
102 {
103 thread->thread.sleep = 0;
104 ThreadSetState (thread, ThreadRunning);
105 if (kind == WakeOne)
106 break;
107 }
108 }
109 }
110
111 Bool lastThreadError;
112
113 void
ThreadFinish(Value thread,Bool error)114 ThreadFinish (Value thread, Bool error)
115 {
116 if (thread->thread.state != ThreadFinished)
117 {
118 ThreadSetState (thread, ThreadFinished);
119 ThreadsWakeup (thread, WakeAll);
120 lastThreadError = error;
121 }
122 }
123
124 Value
do_Thread_join(Value target)125 do_Thread_join (Value target)
126 {
127 ENTER ();
128 if (!ValueIsThread(target))
129 {
130 RaiseStandardException (exception_invalid_argument, 3,
131 NewStrString ("join needs thread argument"),
132 target, Void);
133 RETURN (Void);
134 }
135 if (target->thread.state != ThreadFinished)
136 {
137 ThreadSleep (running, target, PrioritySync);
138 RETURN (Void);
139 }
140 RETURN (target->thread.continuation.value);
141 }
142
143 static void
ThreadListState(Value thread)144 ThreadListState (Value thread)
145 {
146 switch (thread->thread.state) {
147 case ThreadRunning:
148 FilePuts (FileStdout, " running");
149 break;
150 case ThreadSuspended:
151 FilePuts (FileStdout, " suspended");
152 break;
153 case ThreadFinished:
154 FilePuts (FileStdout, " finished");
155 break;
156 }
157 }
158
159 Value
do_Thread_list(void)160 do_Thread_list (void)
161 {
162 ENTER ();
163 Value t;
164
165 for (t = running; t; t = t->thread.next)
166 {
167 FilePrintf (FileStdout, "\t%%%d", t->thread.id);
168 ThreadListState (t);
169 FileOutput (FileStdout, '\n');
170 }
171 for (t = stopped; t; t = t->thread.next)
172 {
173 FilePrintf (FileStdout, "\t%%%d", t->thread.id);
174 ThreadListState (t);
175 if (t->thread.sleep)
176 FilePrintf (FileStdout, " %g", t->thread.sleep);
177 FileOutput (FileStdout, '\n');
178 }
179 RETURN(Void);
180 }
181
182 Value
do_Thread_id_to_thread(Value id)183 do_Thread_id_to_thread (Value id)
184 {
185 ENTER ();
186 int i;
187 Value t;
188
189 i = IntPart (id, "Invalid thread id");
190 if (aborting)
191 RETURN (Void);
192 for (t = running; t; t = t->thread.next)
193 if (t->thread.id == i)
194 RETURN (t);
195 for (t = stopped; t; t = t->thread.next)
196 if (t->thread.id == i)
197 RETURN (t);
198 RETURN (Void);
199 }
200
201 Value
do_Thread_current(void)202 do_Thread_current (void)
203 {
204 ENTER ();
205 Value ret;
206 if (running)
207 ret = running;
208 else
209 ret = Void;
210 RETURN (ret);
211 }
212
213 Value
do_Thread_set_priority(Value thread,Value priority)214 do_Thread_set_priority (Value thread, Value priority)
215 {
216 ENTER ();
217 int i;
218 if (!ValueIsThread(thread))
219 {
220 RaiseStandardException (exception_invalid_argument, 3,
221 NewStrString ("set_priority: not a thread"),
222 thread, priority);
223 RETURN (Void);
224 }
225 i = IntPart (priority, "Invalid thread priority");
226 if (aborting)
227 RETURN (Void);
228 if (i != thread->thread.priority)
229 {
230 _ThreadRemove (thread);
231 thread->thread.priority = i;
232 _ThreadInsert (thread);
233 }
234 RETURN (NewInt (thread->thread.priority));
235 }
236
237 Value
do_Thread_get_priority(Value thread)238 do_Thread_get_priority (Value thread)
239 {
240 ENTER ();
241 if (!ValueIsThread(thread))
242 {
243 RaiseStandardException (exception_invalid_argument, 3,
244 NewStrString ("get_priority: not a thread"),
245 thread, Void);
246 RETURN (Void);
247 }
248 RETURN (NewInt (thread->thread.priority));
249 }
250
251 static int
KillThread(Value thread)252 KillThread (Value thread)
253 {
254 int ret;
255
256 if (!ValueIsThread(thread))
257 {
258 RaiseStandardException (exception_invalid_argument, 3,
259 NewStrString ("kill: not a thread"),
260 thread, Void);
261 return 0;
262 }
263 if (thread->thread.state == ThreadFinished)
264 ret = 0;
265 else
266 ret = 1;
267 ThreadFinish (thread, False);
268 return ret;
269 }
270
271 Value
do_Thread_kill(int n,Value * p)272 do_Thread_kill (int n, Value *p)
273 {
274 ENTER ();
275 Value thread;
276 int ret = 0;
277
278 if (n == 0)
279 {
280 thread = lookupVar (0, "thread");
281 if (!ValueIsThread(thread))
282 RaiseStandardException (exception_invalid_argument, 3,
283 NewStrString ("kill: no default thread"),
284 thread, Void);
285 else
286 ret = KillThread (thread);
287 }
288 else
289 {
290 while (n--)
291 ret += KillThread (*p++);
292 }
293 RETURN (NewInt (ret));
294 }
295
296 void
TraceFunction(Value file,FramePtr frame,CodePtr code,ExprPtr name)297 TraceFunction (Value file, FramePtr frame, CodePtr code, ExprPtr name)
298 {
299 int fe;
300
301 FilePuts (file, " ");
302 if (name)
303 PrettyExpr (file, name, -1, 0, False);
304 else
305 FilePuts (file, "<anonymous>");
306 FilePuts (file, " (");
307 for (fe = 0; fe < code->base.argc; fe++)
308 {
309 if (fe)
310 FilePuts (file, ", ");
311 FilePrintf (file, "%G", BoxValue (frame->frame, fe));
312 }
313 FilePuts (file, ")\n");
314 }
315
316 static void
TraceStatement(Value file,ExprPtr stat)317 TraceStatement (Value file, ExprPtr stat)
318 {
319 FilePrintf (file, "%A:%d: ", stat->base.file, stat->base.line);
320 PrettyStat (file, stat, False);
321 }
322
323 void
TraceFrame(Value file,FramePtr frame,ObjPtr obj,InstPtr pc,int depth)324 TraceFrame (Value file, FramePtr frame, ObjPtr obj, InstPtr pc, int depth)
325 {
326 ENTER ();
327 int max;
328 CodePtr code;
329
330 if (obj && pc)
331 TraceStatement (file, ObjStatement (obj, pc));
332 for (max = depth; frame && max--; frame = frame->previous)
333 {
334 code = frame->function->func.code;
335 TraceFunction (file, frame, code, code->base.name);
336 TraceStatement (file, ObjStatement (frame->saveObj, frame->savePc));
337 }
338 EXIT ();
339 }
340
341 #ifdef DEBUG_JUMP
342 static void
TraceIndent(int indent)343 TraceIndent (int indent)
344 {
345 while (indent--)
346 FilePuts (FileStdout, " ");
347 }
348 #endif
349
350 Value
do_Thread_trace(int n,Value * p)351 do_Thread_trace (int n, Value *p)
352 {
353 ENTER ();
354 Value v;
355 FramePtr frame;
356 InstPtr pc;
357 ObjPtr obj;
358 int depth = 20;
359
360 if (n == 0)
361 v = lookupVar (0, "cont");
362 else
363 v = p[0];
364 if (n > 1)
365 {
366 depth = IntPart (p[1], "Invalid trace depth");
367 if (aborting)
368 RETURN (Void);
369 }
370 switch (ValueTag(v)) {
371 case rep_thread:
372 case rep_continuation:
373 frame = v->continuation.frame;
374 pc = v->continuation.pc;
375 obj = v->continuation.obj;
376 break;
377 default:
378 if (n == 0)
379 RaiseStandardException (exception_invalid_argument, 3,
380 NewStrString ("trace: no default continuation"),
381 NewInt (0), Void);
382 else
383 RaiseStandardException (exception_invalid_argument, 3,
384 NewStrString ("Thread::trace: neither continuation nor thread"),
385 NewInt (0), v);
386 RETURN (Void);
387 }
388 TraceFrame (FileStdout, frame, obj, pc, depth);
389 RETURN(Void);
390 }
391
392 static void
ThreadMark(void * object)393 ThreadMark (void *object)
394 {
395 ThreadPtr thread = object;
396
397 ContinuationMark (&thread->continuation);
398 MemReference (thread->jump);
399 MemReference (thread->sleep);
400 MemReference (thread->next);
401 }
402
403 static Bool
ThreadPrint(Value f,Value av,char format,int base,int width,int prec,int fill)404 ThreadPrint (Value f, Value av, char format, int base, int width, int prec, int fill)
405 {
406 FilePrintf (f, "%%%d", av->thread.id);
407 return True;
408 }
409
410 ValueRep ThreadRep = {
411 { ThreadMark, 0, "ThreadRep" }, /* base */
412 rep_thread, /* tag */
413 { /* binary */
414 0,
415 0,
416 0,
417 0,
418 0,
419 0,
420 0,
421 ValueEqual,
422 0,
423 0,
424 },
425 { /* unary */
426 0,
427 0,
428 0,
429 },
430 0,
431 0,
432 ThreadPrint,
433 0,
434 };
435
436 static int ThreadId;
437
438 Value
NewThread(FramePtr frame,ObjPtr code)439 NewThread (FramePtr frame, ObjPtr code)
440 {
441 ENTER ();
442 Value ret;
443
444 ret = ALLOCATE (&ThreadRep.data, sizeof (Thread));
445
446 ret->thread.jump = 0;
447 ret->thread.state = ThreadRunning;
448 ret->thread.priority = 0;
449 ret->thread.sleep = 0;
450 ret->thread.id = ++ThreadId;
451 ret->thread.partial = 0;
452 ret->thread.next = 0;
453
454 ContinuationInit (&ret->thread.continuation);
455 ret->thread.continuation.obj = code;
456 ret->thread.continuation.pc = ObjCode (code, 0);
457 ret->thread.continuation.frame = frame;
458
459 complete = True;
460 if (code->error)
461 ret->thread.state = ThreadFinished;
462 _ThreadInsert (ret);
463 RETURN (ret);
464 }
465
466 typedef struct _blockHandler {
467 DataType *data;
468 struct _blockHandler *next;
469 NickleBlockHandler handler;
470 void *closure;
471 } BlockHandler;
472
473 static void
BlockHandlerMark(void * object)474 BlockHandlerMark (void *object)
475 {
476 BlockHandler *bh = object;
477
478 MemReference (bh->next);
479 }
480
481 DataType BlockHandlerType = { BlockHandlerMark, 0, "BlockHandlerType" };
482
483 static BlockHandler *blockHandlers;
484
485 void
ThreadsRegisterBlockHandler(NickleBlockHandler handler,void * closure)486 ThreadsRegisterBlockHandler (NickleBlockHandler handler, void *closure)
487 {
488 ENTER ();
489 BlockHandler *bh = ALLOCATE (&BlockHandlerType, sizeof (BlockHandler));
490 bh->next = blockHandlers;
491 blockHandlers = bh;
492 bh->handler = handler;
493 bh->closure = closure;
494 EXIT ();
495 }
496
497 void
ThreadsUnregisterBlockHandler(NickleBlockHandler handler,void * closure)498 ThreadsUnregisterBlockHandler (NickleBlockHandler handler, void *closure)
499 {
500 ENTER ();
501 BlockHandler **prev, *bh;
502
503 for (prev = &blockHandlers; (bh = *prev); prev = &bh->next)
504 {
505 if (bh->handler == handler && bh->closure == closure)
506 {
507 bh->handler = 0;
508 *prev = bh->next;
509 }
510 }
511 EXIT ();
512 }
513
514 void
ThreadsBlock(void)515 ThreadsBlock (void)
516 {
517 BlockHandler *bh, *next;
518
519 for (bh = blockHandlers; bh; bh = next)
520 {
521 next = bh->next;
522 if (bh->handler)
523 (*bh->handler) (bh->closure);
524 }
525
526 /* Pend in either select or sigsuspend, depending
527 * on whether there are files blocked
528 */
529 if (!running)
530 FileCheckBlocked(True);
531 }
532
533 ReferencePtr RunningReference, StoppedReference;
534 ReferencePtr BlockHandlerReference;
535
536 void
ThreadInit(void)537 ThreadInit (void)
538 {
539 ENTER ();
540 RunningReference = NewReference ((void **) &running);
541 MemAddRoot (RunningReference);
542 StoppedReference = NewReference ((void **) &stopped);
543 MemAddRoot (StoppedReference);
544 BlockHandlerReference = NewReference ((void **) &blockHandlers);
545 MemAddRoot (BlockHandlerReference);
546 EXIT ();
547 }
548
549 DataType FarJumpType = { 0, 0, "FarJumpType" };
550
551 FarJumpPtr
NewFarJump(int inst,int twixt,int catch,int frame)552 NewFarJump (int inst, int twixt, int catch, int frame)
553 {
554 ENTER ();
555 FarJumpPtr farJump;
556
557 farJump = ALLOCATE (&FarJumpType, sizeof (FarJump));
558 farJump->inst = inst;
559 farJump->twixt = twixt;
560 farJump->catch = catch;
561 farJump->frame = frame;
562 RETURN (farJump);
563 }
564
565 Value
FarJumpContinuation(ContinuationPtr continuation,FarJumpPtr farJump)566 FarJumpContinuation (ContinuationPtr continuation, FarJumpPtr farJump)
567 {
568 ENTER ();
569 Value ret;
570 CatchPtr catch;
571 TwixtPtr twixt;
572 FramePtr frame;
573 InstPtr pc;
574 ObjPtr obj;
575 int twixts;
576 int catches;
577 int frames;
578
579 ret = NewContinuation (continuation, 0);
580
581 /*
582 * Unwind twixts
583 */
584 twixts = farJump->twixt;
585 twixt = ret->continuation.twixts;
586 while (twixts--)
587 twixt = twixt->continuation.twixts;
588 ret->continuation.twixts = twixt;
589
590 /*
591 * Unwind catches
592 */
593 #ifdef DEBUG_JUMP
594 FilePrintf (FileStdout, "FarJump catches before: ");
595 ThreadCatches (running);
596 #endif
597 catches = farJump->catch;
598 catch = ret->continuation.catches;
599 while (catches--)
600 catch = catch->continuation.catches;
601 ret->continuation.catches = catch;
602 #ifdef DEBUG_JUMP
603 FilePrintf (FileStdout, "FarJump catches after: ");
604 ThreadCatches (running);
605 #endif
606
607 /*
608 * Unwind frames
609 */
610 frames = farJump->frame;
611 frame = ret->continuation.frame;
612 obj = continuation->obj;
613 pc = continuation->pc;
614 if (farJump->inst < 0)
615 frames++;
616 while (frames--)
617 {
618 pc = frame->savePc;
619 obj = frame->saveObj;
620 frame = frame->previous;
621 }
622 ret->continuation.frame = frame;
623 /*
624 * Set pc for non-return jumps
625 */
626 if (farJump->inst >= 0)
627 pc = ObjCode (obj, farJump->inst);
628
629 /*
630 * Assertion here -- the stack is OK because
631 * only intervening catch frames are on the stack
632 * and they never have extra values on the stack
633 */
634
635 ret->continuation.pc = pc;
636 ret->continuation.obj = obj;
637 RETURN (ret);
638 }
639
640 void
ContinuationMark(void * object)641 ContinuationMark (void *object)
642 {
643 ContinuationPtr continuation = object;
644
645 assert (!continuation->pc ||
646 (ObjCode (continuation->obj, 0) <= continuation->pc &&
647 continuation->pc <= ObjCode (continuation->obj, ObjLast(continuation->obj))));
648 MemReference (continuation->obj);
649 MemReference (continuation->frame);
650 MemReference (continuation->stack);
651 MemReference (continuation->value);
652 MemReference (continuation->catches);
653 MemReference (continuation->twixts);
654 }
655
656 static Bool
ContinuationPrint(Value f,Value av,char format,int base,int width,int prec,int fill)657 ContinuationPrint (Value f, Value av, char format, int base, int width, int prec, int fill)
658 {
659 FilePuts (f, "continutation");
660 return True;
661 }
662
663 ValueRep ContinuationRep = {
664 { ContinuationMark, 0, "ContinuationRep" }, /* base */
665 rep_continuation, /* tag */
666 { /* binary */
667 0,
668 0,
669 0,
670 0,
671 0,
672 0,
673 0,
674 ValueEqual,
675 0,
676 0,
677 },
678 { /* unary */
679 0,
680 0,
681 0,
682 },
683 0,
684 0,
685 ContinuationPrint,
686 0,
687 };
688
689 Value
NewContinuation(ContinuationPtr continuation,InstPtr pc)690 NewContinuation (ContinuationPtr continuation, InstPtr pc)
691 {
692 ENTER ();
693 Value ret;
694
695 ret = ALLOCATE (&ContinuationRep.data, sizeof (Continuation));
696 ContinuationSet (&ret->continuation, continuation);
697 ret->continuation.pc = pc;
698 RETURN (ret);
699 }
700
701 static ContinuationPtr
EmptyContinuation(void)702 EmptyContinuation (void)
703 {
704 ENTER ();
705 Value ret;
706
707 ret = ALLOCATE (&ContinuationRep.data, sizeof (Continuation));
708 ContinuationInit (&ret->continuation);
709 RETURN (&ret->continuation);
710 }
711
712 #ifdef DEBUG_JUMP
713 int dump_jump = 0;
714
715 void
ContinuationTrace(char * where,Continuation * continuation,int indent)716 ContinuationTrace (char *where, Continuation *continuation, int indent)
717 {
718 int s;
719 StackObject *stack = continuation->stack;
720 CatchPtr catches = continuation->catches;
721 TwixtPtr twixts = continuation->twixts;
722 ObjPtr obj = continuation->obj;
723 InstPtr pc = continuation->pc;
724
725 if (!dump_jump)
726 return;
727 TraceIndent (indent);
728 FilePuts (FileStdout, "*** ");
729 FilePuts (FileStdout, where);
730 FilePuts (FileStdout, " ***\n");
731 TraceIndent (indent);
732 FilePuts (FileStdout, "stack: ");
733 for (s = 0; STACK_TOP(stack) + (s) < STACK_MAX(stack); s++)
734 {
735 if (s)
736 FilePuts (FileStdout, ", ");
737 FilePrintf (FileStdout, "%g", STACK_ELT(stack, s));
738 }
739 FilePuts (FileStdout, "\n");
740 TraceIndent (indent);
741 FilePuts (FileStdout, "frame:\nCALLS\n");
742 TraceFrame (FileStdout, continuation->frame, obj, pc, 20);
743 FilePuts (FileStdout, "END CALLS\n");
744 TraceIndent (indent);
745 FilePuts (FileStdout, "catches: ");
746 for (s = 0; catches; catches = catches->continuation.catches, s++)
747 {
748 if (s)
749 FilePuts (FileStdout, ", ");
750 FilePrintf (FileStdout, "%A", catches->exception->symbol.name);
751 }
752 FilePuts (FileStdout, "\n");
753 TraceIndent (indent);
754 FilePuts (FileStdout, "statement: ");
755 if (obj && pc)
756 PrettyStat (FileStdout, ObjStatement (obj, pc), False);
757 else
758 FilePuts (FileStdout, "corrupted continuation!\n");
759 for (s = 0; twixts; twixts = twixts->continuation.twixts, s++)
760 {
761 ContinuationTrace ("twixt", &twixts->continuation, indent+1);
762 }
763 }
764 #endif
765
766 InstPtr
ContinuationSet(ContinuationPtr dst,ContinuationPtr src)767 ContinuationSet (ContinuationPtr dst, ContinuationPtr src)
768 {
769 ENTER ();
770 dst->value = src->value;
771 dst->pc = 0;
772 dst->obj = src->obj;
773 dst->frame = src->frame;
774 dst->stack = 0;
775 dst->catches = src->catches;
776 dst->twixts = src->twixts;
777 /* last, to make sure remaining entries are initialized before any GC */
778 dst->stack = StackCopy (src->stack);
779 RETURN (src->pc);
780 }
781
782 void
ContinuationInit(ContinuationPtr dst)783 ContinuationInit (ContinuationPtr dst)
784 {
785 dst->pc = 0;
786 dst->obj = 0;
787 dst->frame = 0;
788 dst->value = Void;
789 dst->catches = 0;
790 dst->twixts = 0;
791 dst->stack = 0;
792 dst->stack = StackCreate ();
793 }
794
795 static void
MarkJump(void * object)796 MarkJump (void *object)
797 {
798 JumpPtr jump = object;
799
800 MemReference (jump->enter);
801 MemReference (jump->entering);
802 MemReference (jump->leave);
803 MemReference (jump->parent);
804 MemReference (jump->continuation);
805 MemReference (jump->ret);
806 }
807
808 DataType JumpType = { MarkJump, 0, "JumpType" };
809
810 JumpPtr
NewJump(TwixtPtr leave,TwixtPtr enter,TwixtPtr parent,ContinuationPtr continuation,Value ret)811 NewJump (TwixtPtr leave, TwixtPtr enter, TwixtPtr parent,
812 ContinuationPtr continuation, Value ret)
813 {
814 ENTER ();
815 JumpPtr jump;
816
817 jump = ALLOCATE (&JumpType, sizeof (Jump));
818 jump->leave = leave;
819 jump->enter = enter;
820 jump->entering = TwixtNext (parent, enter);
821 jump->parent = parent;
822 jump->continuation = continuation;
823 jump->ret = ret;
824 RETURN (jump);
825 }
826
827 /*
828 * An unhandled exception will attempt to jump to NULL,
829 * catch that and invoke the debugger. When the exception
830 * was raised, the code carefully pushed a continuation from
831 * the point of the exception to pass to the debugger
832 */
833
834 static void
JumpUnhandledException(Value thread)835 JumpUnhandledException (Value thread)
836 {
837 Value continuation = STACK_POP (thread->thread.continuation.stack);
838
839 /* make exec loop reschedule */
840 if (thread == running)
841 SetSignalError ();
842 DebugStart (continuation);
843 ThreadFinish (thread, True);
844 }
845
846 /*
847 * Figure out where to go next in a longjmp through twixts
848 */
849 Value
JumpContinue(Value thread,InstPtr * next)850 JumpContinue (Value thread, InstPtr *next)
851 {
852 ENTER ();
853 JumpPtr jump = thread->thread.jump;
854 TwixtPtr twixt;
855
856 if (jump->leave)
857 {
858 /*
859 * Going up
860 */
861 twixt = jump->leave;
862 ContinuationSet (&thread->thread.continuation, &twixt->continuation);
863 *next = twixt->leave;
864 jump->leave = twixt->continuation.twixts;
865 /*
866 * Matching element of the twixt chain, next time start
867 * back down the other side
868 */
869 if (jump->leave == jump->parent)
870 jump->leave = 0;
871 }
872 else if (jump->entering)
873 {
874 /*
875 * Going down
876 */
877 twixt = jump->entering;
878 *next = ContinuationSet (&thread->thread.continuation, &twixt->continuation);
879 jump->entering = TwixtNext (jump->entering, jump->enter);
880 }
881 else
882 {
883 /*
884 * All done, set to final continuation and drop the jump object
885 */
886 *next = ContinuationSet (&thread->thread.continuation, jump->continuation);
887 thread->thread.jump = 0;
888 }
889 if (!*next)
890 JumpUnhandledException (thread);
891 RETURN (jump->ret);
892 }
893
894 /*
895 * Build a Jump that threads through all of the necessary twixt blocks
896 * ending up at 'continuation' returning 'ret'
897 */
898 InstPtr
JumpStart(Value thread,ContinuationPtr continuation,Value ret)899 JumpStart (Value thread, ContinuationPtr continuation, Value ret)
900 {
901 ENTER ();
902 int diff;
903 TwixtPtr leave = thread->thread.continuation.twixts;
904 TwixtPtr enter = continuation->twixts;
905 TwixtPtr leave_parent, enter_parent, parent;
906 InstPtr next;
907
908 /*
909 * Make both lists the same length. Note that either can be empty
910 */
911 leave_parent = leave;
912 enter_parent = enter;
913 diff = TwixtDepth (leave_parent) - TwixtDepth (enter_parent);
914 if (diff >= 0)
915 while (diff-- > 0)
916 leave_parent = leave_parent->continuation.twixts;
917 else
918 while (diff++ < 0)
919 enter_parent = enter_parent->continuation.twixts;
920 /*
921 * Now find the common parent
922 */
923 while (leave_parent != enter_parent)
924 {
925 leave_parent = leave_parent->continuation.twixts;
926 enter_parent = enter_parent->continuation.twixts;
927 }
928
929 parent = enter_parent;
930 /*
931 * Build a data structure to get from leave to enter via parent
932 */
933 thread->thread.jump = NewJump (leave, enter, parent, continuation, ret);
934 /*
935 * Don't need the jump return value yet; we're off to the twixt
936 * blocks; after that, the return value will get retrieved by the
937 * final OpLeaveDone or OpEnterDone instruction
938 */
939 (void) JumpContinue (thread, &next);
940 RETURN (next);
941 }
942
943 Value
ContinuationJump(Value thread,ContinuationPtr continuation,Value ret,InstPtr * next)944 ContinuationJump (Value thread, ContinuationPtr continuation, Value ret, InstPtr *next)
945 {
946 #ifdef DEBUG_JUMP
947 ContinuationTrace ("ContinuationJump from", &thread->thread.continuation, 1);
948 ContinuationTrace ("ContinuationJump to", continuation, 1);
949 #endif
950 ENTER ();
951 /*
952 * If there are twixt enter or leave blocks to execute, build a Jump
953 * that walks them and then resets the continuation.
954 *
955 * Otherwise, just jump
956 */
957 if (thread->thread.continuation.twixts != continuation->twixts)
958 *next = JumpStart (thread, continuation, ret);
959 else
960 *next = ContinuationSet (&thread->thread.continuation, continuation);
961 if (!*next)
962 JumpUnhandledException (thread);
963 RETURN (ret);
964 }
965
966 /*
967 * It is necessary that SetJump and LongJump have the same number
968 * of arguments -- the arguments pushed by SetJump will have to be
969 * popped when LongJump executes. If this is not so, the stack copy
970 * created here should be adjusted to account for this difference
971 */
972 Value
do_setjmp(Value continuation_ref,Value ret)973 do_setjmp (Value continuation_ref, Value ret)
974 {
975 ENTER ();
976 Value continuation;
977
978 if (!ValueIsRef(continuation_ref))
979 {
980 RaiseStandardException (exception_invalid_argument, 3,
981 NewStrString ("setjump: not a reference"),
982 NewInt (0), continuation_ref);
983 RETURN (Void);
984 }
985 continuation = NewContinuation (&running->thread.continuation,
986 running->thread.continuation.pc + 1);
987 /*
988 * Adjust stack for set jump return
989 */
990 STACK_DROP (continuation->continuation.stack, 2);
991 RefValueSet (continuation_ref, continuation);
992 #ifdef DEBUG_JUMP
993 ContinuationTrace ("do_setjmp", &continuation->continuation, 1);
994 #endif
995 RETURN (ret);
996 }
997
998 Value
do_longjmp(InstPtr * next,Value continuation,Value ret)999 do_longjmp (InstPtr *next, Value continuation, Value ret)
1000 {
1001 ENTER ();
1002
1003 if (!running)
1004 RETURN (Void);
1005 if (!ValueIsContinuation(continuation))
1006 {
1007 RaiseStandardException (exception_invalid_argument, 3,
1008 NewStrString ("longjmp: non-continuation argument"),
1009 NewInt (0), continuation);
1010 RETURN (Void);
1011 }
1012 RETURN (ContinuationJump (running, &continuation->continuation, ret, next));
1013 }
1014
1015 static void
CatchMark(void * object)1016 CatchMark (void *object)
1017 {
1018 CatchPtr catch = object;
1019
1020 ContinuationMark (&catch->continuation);
1021 MemReference (catch->exception);
1022 }
1023
1024 DataType CatchType = { CatchMark, 0, "CatchType" };
1025
1026 CatchPtr
NewCatch(Value thread,SymbolPtr exception)1027 NewCatch (Value thread, SymbolPtr exception)
1028 {
1029 ENTER();
1030 CatchPtr catch;
1031
1032 catch = ALLOCATE (&CatchType, sizeof (Catch));
1033 catch->exception = exception;
1034 ContinuationSet (&catch->continuation, &thread->thread.continuation);
1035 catch->continuation.pc = thread->thread.continuation.pc + 1;
1036 RETURN (catch);
1037 }
1038
1039 static void
TwixtMark(void * object)1040 TwixtMark (void *object)
1041 {
1042 TwixtPtr twixt = object;
1043
1044 ContinuationMark (&twixt->continuation);
1045 }
1046
1047 DataType TwixtType = { TwixtMark, 0, "TwixtType" };
1048
1049 TwixtPtr
NewTwixt(ContinuationPtr continuation,InstPtr enter,InstPtr leave)1050 NewTwixt (ContinuationPtr continuation,
1051 InstPtr enter,
1052 InstPtr leave)
1053 {
1054 ENTER ();
1055 TwixtPtr twixt;
1056
1057 twixt = ALLOCATE (&TwixtType, sizeof (Twixt));
1058 twixt->leave = leave;
1059 if (continuation->twixts)
1060 twixt->depth = continuation->twixts->depth + 1;
1061 else
1062 twixt->depth = 1;
1063 ContinuationSet (&twixt->continuation, continuation);
1064 twixt->continuation.pc = enter;
1065 RETURN (twixt);
1066 }
1067
1068 /*
1069 * Twixts are chained deepest first. Walking
1070 * down the list is a bit of work
1071 */
1072
1073 TwixtPtr
TwixtNext(TwixtPtr twixt,TwixtPtr last)1074 TwixtNext (TwixtPtr twixt, TwixtPtr last)
1075 {
1076 if (last == twixt)
1077 return 0;
1078 while (last->continuation.twixts != twixt)
1079 last = last->continuation.twixts;
1080 return last;
1081 }
1082
1083 void
RaiseException(Value thread,SymbolPtr except,Value args,InstPtr * next)1084 RaiseException (Value thread, SymbolPtr except, Value args, InstPtr *next)
1085 {
1086 ENTER ();
1087 CatchPtr catch;
1088 ContinuationPtr continuation = 0;
1089
1090 for (catch = thread->thread.continuation.catches;
1091 catch;
1092 catch = catch->continuation.catches)
1093 {
1094 if (catch->exception == except)
1095 {
1096 continuation = &catch->continuation;
1097 /*
1098 * Hold a reference to this nested value because
1099 * ContinuationJump is about to smash the thread
1100 */
1101 REFERENCE (catch);
1102 break;
1103 }
1104 }
1105 /* unhandled exception -- build an empty continuation and jump to it */
1106 if (!continuation)
1107 {
1108 int i;
1109 InstPtr pc = thread->thread.continuation.pc;
1110
1111 PrintError ("Unhandled exception %A (", except->symbol.name);
1112 if (args)
1113 {
1114 int dim = ArrayLimits(&args->array)[0];
1115 for (i = 0; i < dim; i++)
1116 {
1117 PrintError ("%g", ArrayValue (&args->array, i));
1118 if (i < dim - 1)
1119 PrintError (", ");
1120 }
1121 }
1122 PrintError (")\n");
1123 TraceFrame (FileStderr, thread->thread.continuation.frame,
1124 thread->thread.continuation.obj,
1125 pc,
1126 20);
1127 continuation = EmptyContinuation();
1128 STACK_PUSH (continuation->stack,
1129 NewContinuation (&thread->thread.continuation, pc));
1130 }
1131 ContinuationJump (thread, continuation, args, next);
1132 EXIT ();
1133 }
1134
1135 SymbolPtr standardExceptions[_num_standard_exceptions];
1136 StandardException standardException;
1137 Value standardExceptionArgs;
1138 ReferencePtr standardExceptionArgsRef;
1139
1140 void
RegisterStandardException(StandardException se,SymbolPtr sym)1141 RegisterStandardException (StandardException se,
1142 SymbolPtr sym)
1143 {
1144 ENTER ();
1145 standardExceptions[se] = sym;
1146 MemAddRoot (sym);
1147 if (!standardExceptionArgsRef)
1148 {
1149 standardExceptionArgsRef = NewReference ((void **) &standardExceptionArgs);
1150 MemAddRoot (standardExceptionArgsRef);
1151 }
1152 EXIT ();
1153 }
1154
1155 SymbolPtr
CheckStandardException(void)1156 CheckStandardException (void)
1157 {
1158 SymbolPtr except = standardExceptions[standardException];
1159
1160 signalException = False;
1161 standardException = exception_none;
1162 standardExceptionArgs = 0;
1163 return except;
1164 }
1165
1166 void
RaiseStandardException(StandardException se,int argc,...)1167 RaiseStandardException (StandardException se,
1168 int argc,
1169 ...)
1170 {
1171 ENTER ();
1172 Value args;
1173 int i;
1174 va_list va;
1175
1176 va_start (va, argc);
1177 i = argc;
1178 args = NewArray (False, False, typePoly, 1, &i);
1179 for (i = 0; i < argc; i++)
1180 ArrayValueSet (&args->array, i, va_arg (va, Value));
1181 standardException = se;
1182 standardExceptionArgs = args;
1183 SetSignalException ();
1184 EXIT ();
1185 }
1186
1187 Value
JumpStandardException(Value thread,InstPtr * next)1188 JumpStandardException (Value thread, InstPtr *next)
1189 {
1190 ENTER ();
1191 SymbolPtr except = standardExceptions[standardException];
1192 Value args = standardExceptionArgs;
1193
1194 aborting = False;
1195 if (except)
1196 RaiseException (thread, except, args, next);
1197 standardException = exception_none;
1198 standardExceptionArgs = 0;
1199 RETURN (args);
1200 }
1201
1202 static void
SignalThread(Value thread,Value signal,Bool executing)1203 SignalThread (Value thread, Value signal, Bool executing)
1204 {
1205 ENTER ();
1206 int i = 1;
1207 Value args = NewArray (False, False, typePoly, 1, &i);
1208 SymbolPtr except = standardExceptions[exception_signal];
1209
1210 ArrayValueSet (&args->array, 0, signal);
1211 if (thread == running && executing)
1212 {
1213 standardException = exception_signal;
1214 standardExceptionArgs = args;
1215 SetSignalException ();
1216 }
1217 else if (except)
1218 {
1219 InstPtr next;
1220
1221 RaiseException (thread, except, args, &next);
1222 thread->thread.continuation.value = args;
1223 thread->thread.continuation.pc = next;
1224 if (thread->thread.state == ThreadSuspended) {
1225 thread->thread.sleep = 0;
1226 ThreadSetState (thread, ThreadRunning);
1227 }
1228 }
1229 EXIT ();
1230 }
1231
1232 void
ThreadsSignal(Value signal)1233 ThreadsSignal (Value signal)
1234 {
1235 ENTER ();
1236 Value thread, next;
1237
1238 /* do running first -- signalling makes threads run */
1239 for (thread = running; thread; thread = next)
1240 {
1241 next = thread->thread.next;
1242 SignalThread (thread, signal, False);
1243 }
1244 for (thread = stopped; thread; thread = next)
1245 {
1246 next = thread->thread.next;
1247 SignalThread (thread, signal, False);
1248 }
1249 EXIT ();
1250 }
1251
1252 Value
do_Thread_signal(Value thread,Value signal)1253 do_Thread_signal (Value thread, Value signal)
1254 {
1255 ENTER ();
1256 SignalThread (thread, signal, True);
1257 RETURN (Void);
1258 }
1259