1 /* file: "dispatch.c" */
4 * Copyright 2004-2009 by Marc Feeley and Vincent St-Amour, All Rights Reserved.
7 #include "picobit-vm.h"
9 void push_arg1 (void) {
10 env
= cons (arg1
, env
);
15 obj o
= ram_get_car (env
);
16 env
= ram_get_cdr (env
);
20 void pop_procedure (void) {
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 (void) {
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
);
70 void build_env (void) {
74 arg1
= cons (arg3
, arg1
);
82 void save_cont (void) {
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),
95 void interpreter (void) {
96 pc
= (CODE_START
+ 4) + ((rom_addr
)rom_get (CODE_START
+2) << 2);
98 glovars
= rom_get (CODE_START
+3); // number of global variables
104 /***************************************************************************/
105 CASE(PUSH_CONSTANT1
);
107 IF_TRACE(printf(" (push-constant "); show (bytecode_lo4
); printf (")\n"));
115 /***************************************************************************/
116 CASE(PUSH_CONSTANT2
);
118 IF_TRACE(printf(" (push-constant "); show (bytecode_lo4
+16); printf (")\n"));
119 arg1
= bytecode_lo4
+16;
125 /***************************************************************************/
128 IF_TRACE(printf(" (push-stack %d)\n", bytecode_lo4
));
132 while (bytecode_lo4
!= 0) {
133 arg1
= ram_get_cdr (arg1
);
137 arg1
= ram_get_car (arg1
);
143 /***************************************************************************/
146 IF_TRACE(printf(" (push-stack %d)\n", bytecode_lo4
+16));
152 while (bytecode_lo4
!= 0) {
153 arg1
= ram_get_cdr (arg1
);
157 arg1
= ram_get_car (arg1
);
163 /***************************************************************************/
166 IF_TRACE(printf(" (push-global %d)\n", bytecode_lo4
));
168 arg1
= get_global (bytecode_lo4
);
174 /***************************************************************************/
177 IF_TRACE(printf(" (set-global %d)\n", bytecode_lo4
));
179 set_global (bytecode_lo4
, POP());
183 /***************************************************************************/
186 IF_TRACE(printf(" (call %d)\n", bytecode_lo4
));
191 handle_arity_and_rest_param ();
202 /***************************************************************************/
205 IF_TRACE(printf(" (jump %d)\n", bytecode_lo4
));
210 handle_arity_and_rest_param ();
220 /***************************************************************************/
223 switch (bytecode_lo4
) {
224 case 0: // call-toplevel
225 FETCH_NEXT_BYTECODE();
228 FETCH_NEXT_BYTECODE();
230 IF_TRACE(printf(" (call-toplevel 0x%04x)\n",
231 ((arg2
<< 8) | bytecode
) + CODE_START
));
233 entry
= (arg2
<< 8) + bytecode
+ CODE_START
;
236 na
= rom_get (entry
++);
249 case 1: // jump-toplevel
250 FETCH_NEXT_BYTECODE();
253 FETCH_NEXT_BYTECODE();
255 IF_TRACE(printf(" (jump-toplevel 0x%04x)\n",
256 ((arg2
<< 8) | bytecode
) + CODE_START
));
258 entry
= (arg2
<< 8) + bytecode
+ CODE_START
;
261 na
= rom_get (entry
++);
274 FETCH_NEXT_BYTECODE();
277 FETCH_NEXT_BYTECODE();
279 IF_TRACE(printf(" (goto 0x%04x)\n",
280 (arg2
<< 8) + bytecode
+ CODE_START
));
282 pc
= (arg2
<< 8) + bytecode
+ CODE_START
;
286 case 3: // goto-if-false
287 FETCH_NEXT_BYTECODE();
290 FETCH_NEXT_BYTECODE();
292 IF_TRACE(printf(" (goto-if-false 0x%04x)\n",
293 (arg2
<< 8) + bytecode
+ CODE_START
));
295 if (POP() == OBJ_FALSE
)
296 pc
= (arg2
<< 8) + bytecode
+ CODE_START
;
301 FETCH_NEXT_BYTECODE();
304 FETCH_NEXT_BYTECODE();
306 IF_TRACE(printf(" (closure 0x%04x)\n", (arg2
<< 8) | bytecode
));
310 entry
= (arg2
<< 8) | bytecode
;
312 arg1
= alloc_ram_cell_init (CLOSURE_FIELD0
| (arg2
>> 3),
313 ((arg2
& 0x07) << 5) | (bytecode
>> 3),
314 ((bytecode
&0x07) <<5) |((arg3
&0x1f00) >>8),
324 case 5: // call-toplevel-short
325 FETCH_NEXT_BYTECODE(); // TODO the short version have a lot in common with the long ones, abstract ?
326 // TODO short instructions don't work at the moment
327 IF_TRACE(printf(" (call-toplevel-short 0x%04x)\n",
328 pc
+ bytecode
+ CODE_START
));
330 entry
= pc
+ bytecode
+ CODE_START
;
333 na
= rom_get (entry
++);
345 case 6: // jump-toplevel-short
346 FETCH_NEXT_BYTECODE();
348 IF_TRACE(printf(" (jump-toplevel-short 0x%04x)\n",
349 pc
+ bytecode
+ CODE_START
));
351 entry
= pc
+ bytecode
+ CODE_START
;
354 na
= rom_get (entry
++);
365 case 7: // goto-short
366 FETCH_NEXT_BYTECODE();
368 IF_TRACE(printf(" (goto-short 0x%04x)\n", pc
+ bytecode
+ CODE_START
));
370 pc
= pc
+ bytecode
+ CODE_START
;
374 case 8: // goto-if-false-short
375 FETCH_NEXT_BYTECODE();
377 IF_TRACE(printf(" (goto-if-false-short 0x%04x)\n",
378 pc
+ bytecode
+ CODE_START
));
380 if (POP() == OBJ_FALSE
)
381 pc
= pc
+ bytecode
+ CODE_START
;
385 case 9: // closure-short
386 FETCH_NEXT_BYTECODE();
388 IF_TRACE(printf(" (closure-short 0x%04x)\n", pc
+ bytecode
));
392 entry
= pc
+ bytecode
;
394 arg1
= alloc_ram_cell_init (CLOSURE_FIELD0
| (arg2
>> 3),
395 ((arg2
& 0x07) << 5) | (bytecode
>> 3),
396 ((bytecode
&0x07) <<5) |((arg3
&0x1f00) >>8),
415 case 14: // push_global [long]
416 FETCH_NEXT_BYTECODE();
418 IF_TRACE(printf(" (push-global [long] %d)\n", bytecode
));
420 arg1
= get_global (bytecode
);
426 case 15: // set_global [long]
427 FETCH_NEXT_BYTECODE();
429 IF_TRACE(printf(" (set-global [long] %d)\n", bytecode
));
431 set_global (bytecode
, POP());
438 /***************************************************************************/
439 CASE(PUSH_CONSTANT_LONG
);
441 /* push-constant [long] */
443 FETCH_NEXT_BYTECODE();
445 IF_TRACE(printf(" (push [long] 0x%04x)\n", (bytecode_lo4
<< 8) + bytecode
));
447 arg1
= (bytecode_lo4
<< 8) | bytecode
;
452 /***************************************************************************/
457 /***************************************************************************/
462 /***************************************************************************/
465 IF_TRACE(printf(" (%s)\n", prim_name
[bytecode_lo4
]));
467 switch (bytecode_lo4
) {
469 arg1
= POP(); prim_numberp (); PUSH_ARG1(); break;
471 arg2
= POP(); arg1
= POP(); prim_add (); PUSH_ARG1(); break;
473 arg2
= POP(); arg1
= POP(); prim_sub (); PUSH_ARG1(); break;
475 arg2
= POP(); arg1
= POP(); prim_mul (); PUSH_ARG1(); break;
477 arg2
= POP(); arg1
= POP(); prim_div (); PUSH_ARG1(); break;
479 arg2
= POP(); arg1
= POP(); prim_rem (); PUSH_ARG1(); break;
481 arg1
= POP(); prim_neg (); PUSH_ARG1(); break;
483 arg2
= POP(); arg1
= POP(); prim_eq (); PUSH_ARG1(); break;
485 arg2
= POP(); arg1
= POP(); prim_lt (); PUSH_ARG1(); break;
487 arg2
= POP(); arg1
= POP(); prim_ior (); PUSH_ARG1(); break; // TODO swap these 2 and geq, leq ?
489 arg2
= POP(); arg1
= POP(); prim_gt (); PUSH_ARG1(); break;
491 arg2
= POP(); arg1
= POP(); prim_xor (); PUSH_ARG1(); break;
493 arg1
= POP(); prim_pairp (); PUSH_ARG1(); break;
495 arg2
= POP(); arg1
= POP(); prim_cons (); PUSH_ARG1(); break;
497 arg1
= POP(); prim_car (); PUSH_ARG1(); break;
499 arg1
= POP(); prim_cdr (); PUSH_ARG1(); break;
504 /***************************************************************************/
507 IF_TRACE(printf(" (%s)\n", prim_name
[bytecode_lo4
+16]));
509 switch (bytecode_lo4
) {
511 arg2
= POP(); arg1
= POP(); prim_set_car (); break;
513 arg2
= POP(); arg1
= POP(); prim_set_cdr (); break;
515 arg1
= POP(); prim_nullp (); PUSH_ARG1(); break;
517 arg2
= POP(); arg1
= POP(); prim_eqp (); PUSH_ARG1(); break;
519 arg1
= POP(); prim_not (); PUSH_ARG1(); break;
521 /* prim #%get-cont */
526 /* prim #%graft-to-cont */
528 arg1
= POP(); /* thunk to call */
529 cont
= POP(); /* continuation */
536 handle_arity_and_rest_param ();
546 /* prim #%return-to-cont */
548 arg1
= POP(); /* value to return */
549 cont
= POP(); /* continuation */
551 arg2
= ram_get_cdr (cont
);
553 pc
= ram_get_entry (arg2
);
555 env
= ram_get_cdr (arg2
);
556 cont
= ram_get_car (cont
);
567 arg1
= POP(); prim_symbolp (); PUSH_ARG1(); break;
570 arg1
= POP(); prim_stringp (); PUSH_ARG1(); break;
572 /* prim #%string->list */
573 arg1
= POP(); prim_string2list (); PUSH_ARG1(); break;
575 /* prim #%list->string */
576 arg1
= POP(); prim_list2string (); PUSH_ARG1(); break;
578 /* prim #%make-u8vector */
579 arg2
= POP(); arg1
= POP(); prim_make_u8vector (); PUSH_ARG1(); break;
581 /* prim #%u8vector-ref */
582 arg2
= POP(); arg1
= POP(); prim_u8vector_ref (); PUSH_ARG1(); break;
584 /* prim #%u8vector-set! */
585 arg3
= POP(); arg2
= POP(); arg1
= POP(); prim_u8vector_set (); break;
590 /***************************************************************************/
593 IF_TRACE(printf(" (%s)\n", prim_name
[bytecode_lo4
+32]));
595 switch (bytecode_lo4
) {
603 prim_clock (); PUSH_ARG1(); break;
606 arg2
= POP(); arg1
= POP(); prim_motor (); break;
609 arg3
= POP(); arg2
= POP(); arg1
= POP(); prim_led (); ;break;
611 /* prim #%led2-color */
612 arg1
= POP(); prim_led2_color (); break;
614 /* prim #%getchar-wait */
615 arg2
= POP(); arg1
= POP(); prim_getchar_wait (); PUSH_ARG1(); break;
618 arg2
= POP(); arg1
= POP(); prim_putchar (); break;
621 arg2
= POP(); arg1
= POP(); prim_beep (); break;
624 arg1
= POP(); prim_adc (); PUSH_ARG1(); break;
626 /* prim #%u8vector? */
627 arg1
= POP(); prim_u8vectorp (); PUSH_ARG1(); break;
630 prim_sernum (); PUSH_ARG1(); break;
632 /* prim #%u8vector-length */
633 arg1
= POP(); prim_u8vector_length (); PUSH_ARG1(); break;
635 /* prim #%u8vector-copy! */
636 arg5
= POP(); arg4
= POP(); arg3
= POP(); arg2
= POP(); arg1
= POP();
637 prim_u8vector_copy (); break;
652 arg2
= ram_get_cdr (cont
);
653 pc
= ram_get_entry (arg2
);
654 env
= ram_get_cdr (arg2
);
655 cont
= ram_get_car (cont
);
663 /***************************************************************************/
667 IF_TRACE(printf(" (%s)\n", prim_name
[bytecode_lo4
]));
669 switch (bytecode_lo4
) {
671 /* prim #%boolean? */
672 arg1
= POP(); prim_booleanp (); PUSH_ARG1(); break;
674 /* prim #%network-init */
675 prim_network_init (); break;
677 /* prim #%network-cleanup */
678 prim_network_cleanup (); break;
680 /* prim #%receive-packet-to-u8vector */
681 arg1
= POP(); prim_receive_packet_to_u8vector (); PUSH_ARG1(); break;
683 /* prim #%send-packet-from-u8vector */
684 arg2
= POP(); arg1
= POP(); prim_send_packet_from_u8vector ();
688 arg2
= POP(); arg1
= POP(); prim_leq (); PUSH_ARG1(); break;
692 arg2
= POP(); arg1
= POP(); prim_geq (); PUSH_ARG1(); break;
718 /***************************************************************************/