a3e0025522b92850e77ca7d1ca7c8a22c257b8d4
1 /* file: "dispatch.c" */
4 * Copyright 2004-2009 by Marc Feeley and Vincent St-Amour, All Rights Reserved.
7 #include "picobit-vm.h"
10 env
= cons (arg1
, env
);
15 obj o
= ram_get_car (env
);
16 env
= ram_get_cdr (env
);
20 void pop_procedure () {
24 if (!RAM_CLOSURE(arg1
))
25 TYPE_ERROR("pop_procedure.0", "procedure");
27 entry
= ram_get_entry (arg1
) + CODE_START
;
29 else if (IN_ROM(arg1
)) {
30 if (!ROM_CLOSURE(arg1
))
31 TYPE_ERROR("pop_procedure.1", "procedure");
33 entry
= rom_get_entry (arg1
) + CODE_START
;
36 TYPE_ERROR("pop_procedure.2", "procedure");
39 void handle_arity_and_rest_param () {
42 np
= rom_get (entry
++);
44 if ((np
& 0x80) == 0) {
46 ERROR("handle_arity_and_rest_param.0", "wrong number of arguments");
52 ERROR("handle_arity_and_rest_param.1", "wrong number of arguments");
59 arg3
= cons (arg4
, arg3
);
65 arg1
= cons (arg3
, arg1
);
74 arg1
= cons (arg3
, arg1
);
83 // the second half is a closure
84 arg3
= alloc_ram_cell_init (CLOSURE_FIELD0
| (pc
>> 11),
86 ((pc
& 0x0007) << 5) | (env
>> 8),
88 cont
= alloc_ram_cell_init (COMPOSITE_FIELD0
| (cont
>> 8),
90 CONTINUATION_FIELD2
| (arg3
>> 8),
96 pc
= rom_get (CODE_START
+2);
97 pc
= (CODE_START
+ 4) + (pc
<< 2);
99 glovars
= rom_get (CODE_START
+3); // number of global variables
104 IF_TRACE(show_state (pc
));
105 FETCH_NEXT_BYTECODE();
106 bytecode_hi4
= bytecode
& 0xf0;
107 bytecode_lo4
= bytecode
& 0x0f;
109 switch (bytecode_hi4
>> 4) {
111 /*************************************************************************/
112 case PUSH_CONSTANT1
:
114 IF_TRACE(printf(" (push-constant "); show (bytecode_lo4
); printf (")\n"));
122 /*************************************************************************/
123 case PUSH_CONSTANT2
:
125 IF_TRACE(printf(" (push-constant "); show (bytecode_lo4
+16); printf (")\n"));
126 arg1
= bytecode_lo4
+16;
132 /*************************************************************************/
135 IF_TRACE(printf(" (push-stack %d)\n", bytecode_lo4
));
139 while (bytecode_lo4
!= 0) {
140 arg1
= ram_get_cdr (arg1
);
144 arg1
= ram_get_car (arg1
);
150 /*************************************************************************/
153 IF_TRACE(printf(" (push-stack %d)\n", bytecode_lo4
+16));
159 while (bytecode_lo4
!= 0) {
160 arg1
= ram_get_cdr (arg1
);
164 arg1
= ram_get_car (arg1
);
170 /*************************************************************************/
173 IF_TRACE(printf(" (push-global %d)\n", bytecode_lo4
));
175 arg1
= get_global (bytecode_lo4
);
181 /*************************************************************************/
184 IF_TRACE(printf(" (set-global %d)\n", bytecode_lo4
));
186 set_global (bytecode_lo4
, pop());
190 /*************************************************************************/
193 IF_TRACE(printf(" (call %d)\n", bytecode_lo4
));
198 handle_arity_and_rest_param ();
209 /*************************************************************************/
212 IF_TRACE(printf(" (jump %d)\n", bytecode_lo4
));
217 handle_arity_and_rest_param ();
227 /*************************************************************************/
230 switch (bytecode_lo4
) {
231 case 0: // call-toplevel
232 FETCH_NEXT_BYTECODE();
235 FETCH_NEXT_BYTECODE();
237 IF_TRACE(printf(" (call-toplevel 0x%04x)\n",
238 ((arg2
<< 8) | bytecode
) + CODE_START
));
240 entry
= (arg2
<< 8) + bytecode
+ CODE_START
;
243 na
= rom_get (entry
++);
256 case 1: // jump-toplevel
257 FETCH_NEXT_BYTECODE();
260 FETCH_NEXT_BYTECODE();
262 IF_TRACE(printf(" (jump-toplevel 0x%04x)\n",
263 ((arg2
<< 8) | bytecode
) + CODE_START
));
265 entry
= (arg2
<< 8) + bytecode
+ CODE_START
;
268 na
= rom_get (entry
++);
281 FETCH_NEXT_BYTECODE();
284 FETCH_NEXT_BYTECODE();
286 IF_TRACE(printf(" (goto 0x%04x)\n",
287 (arg2
<< 8) + bytecode
+ CODE_START
));
289 pc
= (arg2
<< 8) + bytecode
+ CODE_START
;
293 case 3: // goto-if-false
294 FETCH_NEXT_BYTECODE();
297 FETCH_NEXT_BYTECODE();
299 IF_TRACE(printf(" (goto-if-false 0x%04x)\n",
300 (arg2
<< 8) + bytecode
+ CODE_START
));
302 if (pop() == OBJ_FALSE
)
303 pc
= (arg2
<< 8) + bytecode
+ CODE_START
;
308 FETCH_NEXT_BYTECODE();
311 FETCH_NEXT_BYTECODE();
313 IF_TRACE(printf(" (closure 0x%04x)\n", (arg2
<< 8) | bytecode
));
317 entry
= (arg2
<< 8) | bytecode
;
320 alloc_ram_cell_init (CLOSURE_FIELD0
| (arg2
>> 3),
321 ((arg2
& 0x07) << 5) | (bytecode
>> 3),
322 ((bytecode
& 0x07) << 5) | ((arg3
& 0x1f00) >> 8),
333 case 5: // call-toplevel-short
334 FETCH_NEXT_BYTECODE(); // TODO the short version have a lot in common with the long ones, abstract ?
335 // TODO short instructions don't work at the moment
336 IF_TRACE(printf(" (call-toplevel-short 0x%04x)\n",
337 pc
+ bytecode
+ CODE_START
));
339 entry
= pc
+ bytecode
+ CODE_START
;
342 na
= rom_get (entry
++);
354 case 6: // jump-toplevel-short
355 FETCH_NEXT_BYTECODE();
357 IF_TRACE(printf(" (jump-toplevel-short 0x%04x)\n",
358 pc
+ bytecode
+ CODE_START
));
360 entry
= pc
+ bytecode
+ CODE_START
;
363 na
= rom_get (entry
++);
374 case 7: // goto-short
375 FETCH_NEXT_BYTECODE();
377 IF_TRACE(printf(" (goto-short 0x%04x)\n", pc
+ bytecode
+ CODE_START
));
379 pc
= pc
+ bytecode
+ CODE_START
;
383 case 8: // goto-if-false-short
384 FETCH_NEXT_BYTECODE();
386 IF_TRACE(printf(" (goto-if-false-short 0x%04x)\n",
387 pc
+ bytecode
+ CODE_START
));
389 if (pop() == OBJ_FALSE
)
390 pc
= pc
+ bytecode
+ CODE_START
;
394 case 9: // closure-short
395 FETCH_NEXT_BYTECODE();
397 IF_TRACE(printf(" (closure-short 0x%04x)\n", pc
+ bytecode
));
401 entry
= pc
+ bytecode
;
403 arg1
= alloc_ram_cell_init (CLOSURE_FIELD0
| (arg2
>> 3),
404 ((arg2
& 0x07) << 5) | (bytecode
>> 3),
405 ((bytecode
&0x07) <<5) |((arg3
&0x1f00) >>8),
425 case 14: // push_global [long]
426 FETCH_NEXT_BYTECODE();
428 IF_TRACE(printf(" (push-global [long] %d)\n", bytecode
));
430 arg1
= get_global (bytecode
);
436 case 15: // set_global [long]
437 FETCH_NEXT_BYTECODE();
439 IF_TRACE(printf(" (set-global [long] %d)\n", bytecode
));
441 set_global (bytecode
, pop());
448 /*************************************************************************/
449 case PUSH_CONSTANT_LONG
:
451 /* push-constant [long] */
453 FETCH_NEXT_BYTECODE();
455 IF_TRACE(printf(" (push [long] 0x%04x)\n", (bytecode_lo4
<< 8) + bytecode
));
457 // necessary since SIXPIC would have kept the result of the shift at 8 bits
459 arg1
= (arg1
<< 8) | bytecode
;
464 /*************************************************************************/
469 /*************************************************************************/
474 /*************************************************************************/
477 IF_TRACE(printf(" (%s)\n", prim_name
[bytecode_lo4
]));
479 switch (bytecode_lo4
) {
481 arg1
= pop(); prim_numberp (); push_arg1(); break;
483 arg2
= pop(); arg1
= pop(); prim_add (); push_arg1(); break;
485 arg2
= pop(); arg1
= pop(); prim_sub (); push_arg1(); break;
487 arg2
= pop(); arg1
= pop(); prim_mul (); push_arg1(); break;
489 arg2
= pop(); arg1
= pop(); prim_div (); push_arg1(); break;
491 arg2
= pop(); arg1
= pop(); prim_rem (); push_arg1(); break;
493 arg1
= pop(); prim_neg (); push_arg1(); break;
495 arg2
= pop(); arg1
= pop(); prim_eq (); push_arg1(); break;
497 arg2
= pop(); arg1
= pop(); prim_lt (); push_arg1(); break;
499 arg2
= pop(); arg1
= pop(); prim_leq (); push_arg1(); break;
501 arg2
= pop(); arg1
= pop(); prim_gt (); push_arg1(); break;
503 arg2
= pop(); arg1
= pop(); prim_geq (); push_arg1(); break;
505 arg1
= pop(); prim_pairp (); push_arg1(); break;
507 arg2
= pop(); arg1
= pop(); prim_cons (); push_arg1(); break;
509 arg1
= pop(); prim_car (); push_arg1(); break;
511 arg1
= pop(); prim_cdr (); push_arg1(); break;
516 /*************************************************************************/
519 IF_TRACE(printf(" (%s)\n", prim_name
[bytecode_lo4
+16]));
521 switch (bytecode_lo4
) {
523 arg2
= pop(); arg1
= pop(); prim_set_car (); break;
525 arg2
= pop(); arg1
= pop(); prim_set_cdr (); break;
527 arg1
= pop(); prim_nullp (); push_arg1(); break;
529 arg2
= pop(); arg1
= pop(); prim_eqp (); push_arg1(); break;
531 arg1
= pop(); prim_not (); push_arg1(); break;
533 /* prim #%get-cont */
538 /* prim #%graft-to-cont */
540 arg1
= pop(); /* thunk to call */
541 cont
= pop(); /* continuation */
548 handle_arity_and_rest_param ();
558 /* prim #%return-to-cont */
560 arg1
= pop(); /* value to return */
561 cont
= pop(); /* continuation */
563 arg2
= ram_get_cdr (cont
);
565 pc
= ram_get_entry (arg2
);
567 env
= ram_get_cdr (arg2
);
568 cont
= ram_get_car (cont
);
579 arg1
= pop(); prim_symbolp (); push_arg1(); break;
582 arg1
= pop(); prim_stringp (); push_arg1(); break;
584 /* prim #%string->list */
585 arg1
= pop(); prim_string2list (); push_arg1(); break;
587 /* prim #%list->string */
588 arg1
= pop(); prim_list2string (); push_arg1(); break;
590 /* prim #%make-u8vector */
591 arg2
= pop(); arg1
= pop(); prim_make_u8vector (); push_arg1(); break;
593 /* prim #%u8vector-ref */
594 arg2
= pop(); arg1
= pop(); prim_u8vector_ref (); push_arg1(); break;
596 /* prim #%u8vector-set! */
597 arg3
= pop(); arg2
= pop(); arg1
= pop(); prim_u8vector_set (); break;
602 /*************************************************************************/
605 IF_TRACE(printf(" (%s)\n", prim_name
[bytecode_lo4
+32]));
607 switch (bytecode_lo4
) {
615 prim_clock (); push_arg1(); break;
618 arg2
= pop(); arg1
= pop(); prim_motor (); break;
621 arg3
= pop(); arg2
= pop(); arg1
= pop(); prim_led (); ;break;
623 /* prim #%led2-color */
624 arg1
= pop(); prim_led2_color (); break;
626 /* prim #%getchar-wait */
627 arg2
= pop(); arg1
= pop(); prim_getchar_wait (); push_arg1(); break;
630 arg2
= pop(); arg1
= pop(); prim_putchar (); break;
633 arg2
= pop(); arg1
= pop(); prim_beep (); break;
636 arg1
= pop(); prim_adc (); push_arg1(); break;
638 /* prim #%u8vector? */
639 arg1
= pop(); prim_u8vectorp (); push_arg1(); break;
642 prim_sernum (); push_arg1(); break;
644 /* prim #%u8vector-length */
645 arg1
= pop(); prim_u8vector_length (); push_arg1(); break;
647 /* prim #%u8vector-copy! */
648 arg5
= pop(); arg4
= pop(); arg3
= pop(); arg2
= pop(); arg1
= pop();
649 prim_u8vector_copy (); break;
664 arg2
= ram_get_cdr (cont
);
665 pc
= ram_get_entry (arg2
);
666 env
= ram_get_cdr (arg2
);
667 cont
= ram_get_car (cont
);
675 /*************************************************************************/
679 IF_TRACE(printf(" (%s)\n", prim_name
[bytecode_lo4
]));
681 switch (bytecode_lo4
) {
683 /* prim #%boolean? */
684 arg1
= pop(); prim_booleanp (); push_arg1(); break;
686 /* prim #%network-init */
687 prim_network_init (); break;
689 /* prim #%network-cleanup */
690 prim_network_cleanup (); break;
692 /* prim #%receive-packet-to-u8vector */
693 arg1
= pop(); prim_receive_packet_to_u8vector (); push_arg1(); break;
695 /* prim #%send-packet-from-u8vector */
696 arg2
= pop(); arg1
= pop(); prim_send_packet_from_u8vector ();
699 arg2
= pop(); arg1
= pop(); prim_ior (); push_arg1(); break;
702 arg2
= pop(); arg1
= pop(); prim_xor (); push_arg1(); break;
728 /*************************************************************************/