1 /* file: "picobit-vm.c" */
4 * Copyright 2004 by Marc Feeley, All Rights Reserved.
8 * 15/08/2004 Release of version 1
9 * 06/07/2008 Modified for PICOBOARD2_R3
10 * 07/18/2008 Modified to use new object representation
16 /*---------------------------------------------------------------------------*/
21 typedef unsigned char uint8
;
22 typedef unsigned short uint16
;
23 typedef unsigned long uint32
;
25 /*---------------------------------------------------------------------------*/
45 static volatile near uint8 FW_VALUE_UP @
0x33;
46 static volatile near uint8 FW_VALUE_HI @
0x33;
47 static volatile near uint8 FW_VALUE_LO @
0x33;
49 #define ACTIVITY_LED1_LAT LATB
50 #define ACTIVITY_LED1_BIT 5
51 #define ACTIVITY_LED2_LAT LATB
52 #define ACTIVITY_LED2_BIT 4
53 static volatile near bit ACTIVITY_LED1 @
((unsigned)&ACTIVITY_LED1_LAT
*8)+ACTIVITY_LED1_BIT
;
54 static volatile near bit ACTIVITY_LED2 @
((unsigned)&ACTIVITY_LED2_LAT
*8)+ACTIVITY_LED2_BIT
;
65 #include <sys/types.h>
66 #include <sys/timeb.h>
75 /*---------------------------------------------------------------------------*/
79 #define CODE_START 0x5000
82 // TODO should this be read from the file like constants or statically allocated ? if read, it might cause problems because of dynamic allocation
86 #define IF_GC_TRACE(x) x
89 #define IF_GC_TRACE(x)
92 /*---------------------------------------------------------------------------*/
97 #define ERROR(msg) halt_with_error()
98 #define TYPE_ERROR(type) halt_with_error()
105 #define ERROR(msg) error (msg)
106 #define TYPE_ERROR(type) type_error (type)
108 void error (char *msg
)
110 printf ("ERROR: %s\n", msg
);
114 void type_error (char *type
)
116 printf ("ERROR: An argument of type %s was expected\n", type
);
123 /*---------------------------------------------------------------------------*/
131 typedef uint16 ram_addr
;
132 typedef uint16 rom_addr
;
136 /*---------------------------------------------------------------------------*/
138 #define MAX_VEC_ENCODING 8191
139 #define MIN_VEC_ENCODING 4096
140 #define VEC_BYTES ((MAX_VEC_ENCODING - MIN_VEC_ENCODING + 1)*4)
141 // TODO this is new. if the pic has less than 8k of memory, start this lower
142 // TODO max was 8192 for ram, would have been 1 too much (watch out, master branch still has that), now corrected
143 // TODO the pic actually has 2k, so change these FOOBAR
144 // TODO we'd only actually need 1024 or so for ram and vectors, since we can't address more. this gives us a lot of rom space
146 #define MAX_RAM_ENCODING 4095
147 #define MIN_RAM_ENCODING 512
148 #define RAM_BYTES ((MAX_RAM_ENCODING - MIN_RAM_ENCODING + 1)*4)
149 // TODO watch out if we address more than what the PIC actually has
152 // TODO subtracts min_ram since vectors are actually in ram
153 #define OBJ_TO_VEC_ADDR(o,f) (((ram_addr)((uint16)(o) - MIN_RAM_ENCODING) << 2) + (f))
154 #define OBJ_TO_RAM_ADDR(o,f) (((ram_addr)((uint16)(o) - MIN_RAM_ENCODING) << 2) + (f))
155 #define OBJ_TO_ROM_ADDR(o,f) (((rom_addr)((uint16)(o) - MIN_ROM_ENCODING) << 2) + (CODE_START + 4 + (f)))
160 #define ram_get(a) *(uint8*)(a+0x200)
161 #define ram_set(a,x) *(uint8*)(a+0x200) = (x)
162 // TODO change these since we change proportion of ram and rom ?
168 uint8 ram_mem
[RAM_BYTES
+ VEC_BYTES
];
170 #define ram_get(a) ram_mem[a]
171 #define ram_set(a,x) ram_mem[a] = (x)
176 /*---------------------------------------------------------------------------*/
180 /* #if WORD_BITS == 8 */
181 /* #endif */ // TODO useless
183 uint8
rom_get (rom_addr a
)
185 return *(rom uint8
*)a
;
193 #define ROM_BYTES 8192
194 // TODO the new pics have 32k, change this ? minus the vm size, firmware ?
196 uint8 rom_mem
[ROM_BYTES
] =
199 #define PUTCHAR_LIGHT_not
202 0xFB, 0xD7, 0x03, 0x00, 0x00, 0x00, 0x00, 0x32
203 , 0x03, 0x00, 0x00, 0x00, 0x03, 0x00, 0x00, 0x00
204 , 0x08, 0x50, 0x80, 0x16, 0xFE, 0xE8, 0x00, 0xFC
205 , 0x32, 0x80, 0x2D, 0xFE, 0xFC, 0x31, 0x80, 0x43
206 , 0xFE, 0xFC, 0x33, 0x80, 0x2D, 0xFE, 0xFC, 0x31
207 , 0x80, 0x43, 0xFE, 0x90, 0x16, 0x01, 0x20, 0xFC
208 , 0x32, 0xE3, 0xB0, 0x37, 0x09, 0xF3, 0xFF, 0x20
209 , 0xFC, 0x33, 0xE3, 0xB0, 0x40, 0x0A, 0xF3, 0xFF
210 , 0x08, 0xF3, 0xFF, 0x01, 0x40, 0x21, 0xD1, 0x00
211 , 0x02, 0xC0, 0x4C, 0x71, 0x01, 0x20, 0x50, 0x90
212 , 0x51, 0x00, 0xF1, 0x40, 0xD8, 0xB0, 0x59, 0x90
216 0xFB, 0xD7, 0x00, 0x00, 0x80, 0x08, 0xFE, 0xE8
217 , 0x00, 0xF6, 0xF5, 0x90, 0x08
221 uint8
rom_get (rom_addr a
)
223 return rom_mem
[a
-CODE_START
];
228 obj globals
[GLOVARS
];
230 /*---------------------------------------------------------------------------*/
238 fixnum n MIN_FIXNUM -> 3 ... MAX_FIXNUM -> 3 + (MAX_FIXNUM-MIN_FIXNUM)
239 rom object 4 + (MAX_FIXNUM-MIN_FIXNUM) ... MIN_RAM_ENCODING-1
240 ram object MIN_RAM_ENCODING ... MAX_RAM_ENCODING
241 vector MIN_VEC_ENCODING ... 8191
243 layout of memory allocated objects:
245 G's represent mark bits used by the gc
247 bignum n 00G00000 uuuuuuuu hhhhhhhh llllllll (24 bit signed integer)
248 TODO we could have 29-bit integers
250 pair 1GGaaaaa aaaaaaaa 000ddddd dddddddd
253 gives an address space of 2^13 * 4 = 32k divided between simple objects,
256 symbol 1GG00000 00000000 00100000 00000000
258 string 1GG***** *chars** 01000000 00000000
260 vector 1GG***** *elems** 01100000 00000000 TODO old
261 vector 1GGxxxxx xxxxxxxx 011yyyyy yyyyyyyy
262 x is length of the vector, in bytes
263 y is pointer to the elements themselves (stored in vector space)
264 TODO pointer could be shorter since it always points in vector space, same for length, will never be this long
265 TODO show how vectors are represented in vector space
266 TODO what kind of gc to have for vectors ? if we have a copying gc (which we argues against in the paper), we might need a header in vector space to point to the ram header, so it can update the pointer when the vector is copied
267 TODO have a header with length here that points to vector space, or have the header in vector space, for now, header is in ordinary ram
268 TODO how to deal with gc ? mayeb when we sweep a vector header, go sweep its contents in vector space ?
270 closure 01Gaaaaa aaaaaaaa aaaxxxxx xxxxxxxx
271 0x5ff<a<0x4000 is entry
272 x is pointer to environment
273 the reason why the environment is on the cdr (and the entry is split on 3
274 bytes) is that, when looking for a variable, a closure is considered to be a
275 pair. The compiler adds an extra offset to any variable in the closure's
276 environment, so the car of the closure (which doesn't really exist) is never
277 checked, but the cdr is followed to find the other bindings
279 continuation 1GGxxxxx xxxxxxxx 100yyyyy yyyyyyyy
280 x is parent continuation
281 y is pointer to the second half, which is a closure (contains env and entry)
283 An environment is a list of objects built out of pairs. On entry to
284 a procedure the environment is the list of parameters to which is
285 added the environment of the closure being called.
287 The first byte at the entry point of a procedure gives the arity of
290 n = 0 to 127 -> procedure has n parameters (no rest parameter)
291 n = -128 to -1 -> procedure has -n parameters, the last is
299 #define MIN_FIXNUM_ENCODING 3
301 #define MAX_FIXNUM 255
302 #define MIN_ROM_ENCODING (MIN_FIXNUM_ENCODING+MAX_FIXNUM-MIN_FIXNUM+1)
304 #define ENCODE_FIXNUM(n) ((obj)(n) + (MIN_FIXNUM_ENCODING - MIN_FIXNUM))
305 #define DECODE_FIXNUM(o) ((int32)(o) - (MIN_FIXNUM_ENCODING - MIN_FIXNUM))
307 // TODO why this ifdef ?
309 #define IN_VEC(o) ((o) >= MIN_VEC_ENCODING)
310 #define IN_RAM(o) (!IN_VEC(o) && ((o) >= MIN_RAM_ENCODING))
311 #define IN_ROM(o) (!IN_VEC(o) && !IN_RAM(o) && ((o) >= MIN_ROM_ENCODING))
313 // TODO performance ?
315 // bignum first byte : 00G00000
316 #define BIGNUM_FIELD0 0
317 #define RAM_BIGNUM(o) ((ram_get_field0 (o) & 0xc0) == BIGNUM_FIELD0)
318 #define ROM_BIGNUM(o) ((rom_get_field0 (o) & 0xc0) == BIGNUM_FIELD0)
320 // composite first byte : 1GGxxxxx
321 #define COMPOSITE_FIELD0 0x80
322 #define RAM_COMPOSITE(o) ((ram_get_field0 (o) & 0x80) == COMPOSITE_FIELD0)
323 #define ROM_COMPOSITE(o) ((rom_get_field0 (o) & 0x80) == COMPOSITE_FIELD0)
325 // pair third byte : 000xxxxx
326 #define PAIR_FIELD2 0
327 #define RAM_PAIR(o) (RAM_COMPOSITE (o) && ((ram_get_field2 (o) & 0xe0) == PAIR_FIELD2))
328 #define ROM_PAIR(o) (ROM_COMPOSITE (o) && ((rom_get_field2 (o) & 0xe0) == PAIR_FIELD2))
330 // symbol third byte : 001xxxxx
331 #define SYMBOL_FIELD2 0x20
332 #define RAM_SYMBOL(o) (RAM_COMPOSITE (o) && ((ram_get_field2 (o) & 0xe0) == SYMBOL_FIELD2))
333 #define ROM_SYMBOL(o) (ROM_COMPOSITE (o) && ((rom_get_field2 (o) & 0xe0) == SYMBOL_FIELD2))
335 // string third byte : 010xxxxx
336 #define STRING_FIELD2 0x40
337 #define RAM_STRING(o) (RAM_COMPOSITE (o) && ((ram_get_field2 (o) & 0xe0) == STRING_FIELD2))
338 #define ROM_STRING(o) (ROM_COMPOSITE (o) && ((rom_get_field2 (o) & 0xe0) == STRING_FIELD2))
340 // vector third byte : 011xxxxx
341 #define VECTOR_FIELD2 0x60
342 #define RAM_VECTOR(o) (RAM_COMPOSITE (o) && ((ram_get_field2 (o) & 0xe0) == VECTOR_FIELD2))
343 #define ROM_VECTOR(o) (ROM_COMPOSITE (o) && ((rom_get_field2 (o) & 0xe0) == VECTOR_FIELD2))
344 // TODO this is only for headers
346 // continuation third byte : 100xxxxx
347 #define CONTINUATION_FIELD2 0x80
348 #define RAM_CONTINUATION(o) (RAM_COMPOSITE (o) && ((ram_get_field2 (o) & 0xe0) == CONTINUATION_FIELD2))
349 #define ROM_CONTINUATION(o) (ROM_COMPOSITE (o) && ((rom_get_field2 (o) & 0xe0) == CONTINUATION_FIELD2))
351 // closure first byte : 01Gxxxxx
352 #define CLOSURE_FIELD0 0x40
353 #define RAM_CLOSURE(o) ((ram_get_field0 (o) & 0xc0) == CLOSURE_FIELD0)
354 #define ROM_CLOSURE(o) ((rom_get_field0 (o) & 0xc0) == CLOSURE_FIELD0)
357 /*---------------------------------------------------------------------------*/
359 #define RAM_GET_FIELD0_MACRO(o) ram_get (OBJ_TO_RAM_ADDR(o,0))
360 #define RAM_SET_FIELD0_MACRO(o,val) ram_set (OBJ_TO_RAM_ADDR(o,0), val)
361 #define ROM_GET_FIELD0_MACRO(o) rom_get (OBJ_TO_ROM_ADDR(o,0))
363 #define RAM_GET_GC_TAGS_MACRO(o) (RAM_GET_FIELD0_MACRO(o) & 0x60)
364 #define RAM_GET_GC_TAG0_MACRO(o) (RAM_GET_FIELD0_MACRO(o) & 0x20)
365 #define RAM_GET_GC_TAG1_MACRO(o) (RAM_GET_FIELD0_MACRO(o) & 0x40)
366 #define RAM_SET_GC_TAGS_MACRO(o,tags) \
367 (RAM_SET_FIELD0_MACRO(o,(RAM_GET_FIELD0_MACRO(o) & 0x9f) | (tags)))
368 #define RAM_SET_GC_TAG0_MACRO(o,tag) \
369 RAM_SET_FIELD0_MACRO(o,(RAM_GET_FIELD0_MACRO(o) & 0xdf) | (tag))
370 #define RAM_SET_GC_TAG1_MACRO(o,tag) \
371 RAM_SET_FIELD0_MACRO(o,(RAM_GET_FIELD0_MACRO(o) & 0xbf) | (tag))
374 #define RAM_GET_FIELD1_MACRO(o) ram_get (OBJ_TO_RAM_ADDR(o,1))
375 #define RAM_GET_FIELD2_MACRO(o) ram_get (OBJ_TO_RAM_ADDR(o,2))
376 #define RAM_GET_FIELD3_MACRO(o) ram_get (OBJ_TO_RAM_ADDR(o,3))
377 #define RAM_SET_FIELD1_MACRO(o,val) ram_set (OBJ_TO_RAM_ADDR(o,1), val)
378 #define RAM_SET_FIELD2_MACRO(o,val) ram_set (OBJ_TO_RAM_ADDR(o,2), val)
379 #define RAM_SET_FIELD3_MACRO(o,val) ram_set (OBJ_TO_RAM_ADDR(o,3), val)
380 #define ROM_GET_FIELD1_MACRO(o) rom_get (OBJ_TO_ROM_ADDR(o,1))
381 #define ROM_GET_FIELD2_MACRO(o) rom_get (OBJ_TO_ROM_ADDR(o,2))
382 #define ROM_GET_FIELD3_MACRO(o) rom_get (OBJ_TO_ROM_ADDR(o,3))
383 #define VEC_GET_BYTE0_MACRO(o) ram_get (OBJ_TO_RAM_ADDR(o,0))
384 #define VEC_GET_BYTE1_MACRO(o) ram_get (OBJ_TO_RAM_ADDR(o,1))
385 #define VEC_GET_BYTE2_MACRO(o) ram_get (OBJ_TO_RAM_ADDR(o,2))
386 #define VEC_GET_BYTE3_MACRO(o) ram_get (OBJ_TO_RAM_ADDR(o,3))
387 #define VEC_SET_BYTE0_MACRO(o,val) ram_set (OBJ_TO_RAM_ADDR(o,0), val)
388 #define VEC_SET_BYTE1_MACRO(o,val) ram_set (OBJ_TO_RAM_ADDR(o,1), val)
389 #define VEC_SET_BYTE2_MACRO(o,val) ram_set (OBJ_TO_RAM_ADDR(o,2), val)
390 #define VEC_SET_BYTE3_MACRO(o,val) ram_set (OBJ_TO_RAM_ADDR(o,3), val)
391 // TODO put these in the ifdef ? and is the ifdef necessary ? are the vec macros necessary ? use the word field instead of byte, for consistency ?
394 uint8
ram_get_gc_tags (obj o
) { return RAM_GET_GC_TAGS_MACRO(o
); }
395 uint8
ram_get_gc_tag0 (obj o
) { return RAM_GET_GC_TAG0_MACRO(o
); }
396 uint8
ram_get_gc_tag1 (obj o
) { return RAM_GET_GC_TAG1_MACRO(o
); }
397 void ram_set_gc_tags (obj o
, uint8 tags
) { RAM_SET_GC_TAGS_MACRO(o
, tags
); }
398 void ram_set_gc_tag0 (obj o
, uint8 tag
) { RAM_SET_GC_TAG0_MACRO(o
,tag
); }
399 void ram_set_gc_tag1 (obj o
, uint8 tag
) { RAM_SET_GC_TAG1_MACRO(o
,tag
); }
400 uint8
ram_get_field0 (obj o
) { return RAM_GET_FIELD0_MACRO(o
); }
401 word
ram_get_field1 (obj o
) { return RAM_GET_FIELD1_MACRO(o
); }
402 word
ram_get_field2 (obj o
) { return RAM_GET_FIELD2_MACRO(o
); }
403 word
ram_get_field3 (obj o
) { return RAM_GET_FIELD3_MACRO(o
); }
404 void ram_set_field0 (obj o
, uint8 val
) { RAM_SET_FIELD0_MACRO(o
,val
); }
405 void ram_set_field1 (obj o
, word val
) { RAM_SET_FIELD1_MACRO(o
,val
); }
406 void ram_set_field2 (obj o
, word val
) { RAM_SET_FIELD2_MACRO(o
,val
); }
407 void ram_set_field3 (obj o
, word val
) { RAM_SET_FIELD3_MACRO(o
,val
); }
408 uint8
rom_get_field0 (obj o
) { return ROM_GET_FIELD0_MACRO(o
); }
409 word
rom_get_field1 (obj o
) { return ROM_GET_FIELD1_MACRO(o
); }
410 word
rom_get_field2 (obj o
) { return ROM_GET_FIELD2_MACRO(o
); }
411 word
rom_get_field3 (obj o
) { return ROM_GET_FIELD3_MACRO(o
); }
412 /* word vec_get_byte0 (obj o) { return VEC_GET_BYTE0_MACRO(o); } */
413 /* word vec_get_byte1 (obj o) { return VEC_GET_BYTE1_MACRO(o); } */
414 /* word vec_get_byte2 (obj o) { return VEC_GET_BYTE2_MACRO(o); } */
415 /* word vec_get_byte3 (obj o) { return VEC_GET_BYTE3_MACRO(o); } */
416 /* word vec_set_byte0 (obj o, word val) { VEC_SET_BYTE0_MACRO(o,val); } */
417 /* word vec_set_byte1 (obj o, word val) { VEC_SET_BYTE1_MACRO(o,val); } */
418 /* word vec_set_byte2 (obj o, word val) { VEC_SET_BYTE2_MACRO(o,val); } */
419 /* word vec_set_byte3 (obj o, word val) { VEC_SET_BYTE3_MACRO(o,val); } */
420 // TODO use the word field or byte ? actually the ram functions are used, since this is in ram anyways
422 obj
ram_get_car (obj o
)
423 { return ((ram_get_field0 (o
) & 0x1f) << 8) | ram_get_field1 (o
); }
424 obj
rom_get_car (obj o
)
425 { return ((rom_get_field0 (o
) & 0x1f) << 8) | rom_get_field1 (o
); }
426 obj
ram_get_cdr (obj o
)
427 { return ((ram_get_field2 (o
) & 0x1f) << 8) | ram_get_field3 (o
); }
428 obj
rom_get_cdr (obj o
)
429 { return ((rom_get_field2 (o
) & 0x1f) << 8) | rom_get_field3 (o
); }
430 void ram_set_car (obj o
, obj val
)
432 ram_set_field0 (o
, (val
>> 8) | (ram_get_field0 (o
) & 0xe0));
433 ram_set_field1 (o
, val
& 0xff);
435 void ram_set_cdr (obj o
, obj val
)
437 ram_set_field2 (o
, (val
>> 8) | (ram_get_field2 (o
) & 0xe0));
438 ram_set_field3 (o
, val
& 0xff);
440 obj
ram_get_entry (obj o
)
442 return (((ram_get_field0 (o
) & 0x1f) << 11)
443 | (ram_get_field1 (o
) << 3)
444 | (ram_get_field2 (o
) >> 5));
446 obj
rom_get_entry (obj o
)
448 return (((rom_get_field0 (o
) & 0x1f) << 11)
449 | (rom_get_field1 (o
) << 3)
450 | (rom_get_field2 (o
) >> 5));
453 obj
get_global (uint8 i
)
458 void set_global (uint8 i
, obj o
)
464 void show_type (obj o
) // for debugging purposes
467 if (o
== OBJ_FALSE
) printf("#f");
468 else if (o
== OBJ_TRUE
) printf("#t");
469 else if (o
== OBJ_NULL
) printf("()");
470 else if (o
< MIN_ROM_ENCODING
) printf("fixnum");
473 if (RAM_BIGNUM(o
)) printf("ram bignum");
474 else if (RAM_PAIR(o
)) printf("ram pair");
475 else if (RAM_SYMBOL(o
)) printf("ram symbol");
476 else if (RAM_STRING(o
)) printf("ram string");
477 else if (RAM_VECTOR(o
)) printf("ram vector");
478 else if (RAM_CONTINUATION(o
)) printf("ram continuation");
479 else if (RAM_CLOSURE(o
)) printf("ram closure");
483 if (ROM_BIGNUM(o
)) printf("rom bignum");
484 else if (ROM_PAIR(o
)) printf("rom pair");
485 else if (ROM_SYMBOL(o
)) printf("rom symbol");
486 else if (ROM_STRING(o
)) printf("rom string");
487 else if (ROM_VECTOR(o
)) printf("rom vector");
488 else if (ROM_CONTINUATION(o
)) printf("rom continuation");
489 else if (RAM_CLOSURE(o
)) printf("rom closure");
496 /*---------------------------------------------------------------------------*/
498 /* Interface to GC */
500 // TODO explain what each tag means, with 1-2 mark bits
501 #define GC_TAG_0_LEFT (1<<5)
502 // TODO was 3<<5, changed to play nice with procedures and bignums, but should actually set only this bit, not clear the other
503 #define GC_TAG_1_LEFT (2<<5)
504 #define GC_TAG_UNMARKED (0<<5)
506 /* Number of object fields of objects in ram */
507 #define HAS_2_OBJECT_FIELDS(visit) (RAM_PAIR(visit) || RAM_CONTINUATION(visit))
508 #define HAS_1_OBJECT_FIELD(visit) (RAM_COMPOSITE(visit) || RAM_CLOSURE(visit))
509 // all composites except pairs and continuations have 1 object field
510 // TODO if we ever have true bignums, bignums will have 1 object field
512 #define NIL OBJ_FALSE
514 /*---------------------------------------------------------------------------*/
516 /* Garbage collector */
518 obj free_list
; /* list of unused cells */
519 obj free_list_vec
; /* list of unused cells in vector space */
521 obj arg1
; /* root set */
528 uint8 na
; /* interpreter variables */
538 void init_ram_heap (void)
541 obj o
= MAX_RAM_ENCODING
;
545 while (o
>= MIN_RAM_ENCODING
)
547 ram_set_gc_tags (o
, GC_TAG_UNMARKED
);
548 ram_set_car (o
, free_list
);
553 free_list_vec
= MIN_VEC_ENCODING
;
554 ram_set_car (free_list_vec
, 0); // TODO is ram_set_car appropriate ? now we have vector space objects that can either be a list or 4 bytes
555 // each node of the free list must know the free length that follows it
556 // this free length is stored in words, not in bytes
557 // if we did count in bytes, the number might need more than 13 bits
558 ram_set_cdr (free_list_vec
, VEC_BYTES
/ 4);
559 // TODO so, at the start, we have only 1 node that says the whole space is free
561 for (i
=0; i
<GLOVARS
; i
++)
562 set_global (i
, OBJ_FALSE
);
589 // IF_GC_TRACE(printf ("push stack=%d (tag=%d) visit=%d (tag=%d)\n", stack, ram_get_gc_tags (stack)>>5, visit, ram_get_gc_tags (visit)>>5)); // TODO error here, tried to get the tag of nil
590 IF_GC_TRACE(printf ("push stack=%d visit=%d (tag=%d)\n", stack
, visit
, ram_get_gc_tags (visit
)>>5));
592 if ((HAS_1_OBJECT_FIELD (visit
) && ram_get_gc_tag0 (visit
))
593 || (HAS_2_OBJECT_FIELDS (visit
)
594 && (ram_get_gc_tags (visit
) != GC_TAG_UNMARKED
)))
595 // TODO ugly condition
596 IF_GC_TRACE(printf ("case 1\n"));
599 if (HAS_2_OBJECT_FIELDS(visit
)) // pairs and continuations
601 IF_GC_TRACE(printf ("case 5\n"));
605 temp
= ram_get_cdr (visit
);
609 IF_GC_TRACE(printf ("case 6\n"));
610 ram_set_gc_tags (visit
, GC_TAG_1_LEFT
);
611 ram_set_cdr (visit
, stack
);
615 IF_GC_TRACE(printf ("case 7\n"));
620 if (HAS_1_OBJECT_FIELD(visit
))
622 IF_GC_TRACE(printf ("case 8\n"));
626 if (RAM_CLOSURE(visit
)) // closures have the pointer in the cdr
627 temp
= ram_get_cdr (visit
);
629 temp
= ram_get_car (visit
);
633 IF_GC_TRACE(printf ("case 9\n"));
634 ram_set_gc_tag0 (visit
, GC_TAG_0_LEFT
);
635 if (RAM_CLOSURE(visit
))
636 ram_set_cdr (visit
, stack
);
638 ram_set_car (visit
, stack
);
643 IF_GC_TRACE(printf ("case 10\n"));
646 IF_GC_TRACE(printf ("case 11\n"));
648 ram_set_gc_tag0 (visit
, GC_TAG_0_LEFT
);
653 /* IF_GC_TRACE(printf ("pop stack=%d (tag=%d) visit=%d (tag=%d)\n", stack, ram_get_gc_tags (stack)>>6, visit, ram_get_gc_tags (visit)>>6)); */
654 // TODO, like for push, getting the gc tags of nil is not great
655 IF_GC_TRACE(printf ("pop stack=%d visit=%d (tag=%d)\n", stack
, visit
, ram_get_gc_tags (visit
)>>6));
659 if (HAS_2_OBJECT_FIELDS(stack
) && ram_get_gc_tag1 (stack
))
661 IF_GC_TRACE(printf ("case 13\n"));
663 temp
= ram_get_cdr (stack
); /* pop through cdr */
664 ram_set_cdr (stack
, visit
);
668 ram_set_gc_tag1(visit
, GC_TAG_UNMARKED
);
669 // we unset the "1-left" bit
674 if (RAM_CLOSURE(stack
))
675 // closures have one object field, but it's in the cdr
677 IF_GC_TRACE(printf ("case 13.5\n")); // TODO renumber cases
679 temp
= ram_get_cdr (stack
); /* pop through cdr */
680 ram_set_cdr (stack
, visit
);
687 IF_GC_TRACE(printf ("case 14\n"));
689 temp
= ram_get_car (stack
); /* pop through car */
690 ram_set_car (stack
, visit
);
711 obj visit
= MAX_RAM_ENCODING
;
715 while (visit
>= MIN_RAM_ENCODING
)
717 if ((RAM_COMPOSITE(visit
)
718 && (ram_get_gc_tags (visit
) == GC_TAG_UNMARKED
)) // 2 mark bit
719 || !(ram_get_gc_tags (visit
) & GC_TAG_0_LEFT
)) // 1 mark bit
722 if (RAM_VECTOR(visit
))
723 // when we sweep a vector, we also have to sweep its contents
725 obj o
= ram_get_cdr (visit
);
726 uint16 i
= ram_get_car (visit
); // number of elements
727 ram_set_car (o
, free_list_vec
);
728 ram_set_cdr (o
, (i
+ 3) / 4); // free length, in words
730 // TODO fuse free spaces if needed ? would be a good idea FOOBAR or maybe just fuse when we call the gc ? actually, compacting might be a better idea, but would need a second header in vector space that would point to the header in ram
732 ram_set_car (visit
, free_list
);
737 if (RAM_COMPOSITE(visit
))
738 ram_set_gc_tags (visit
, GC_TAG_UNMARKED
);
739 else // only 1 mark bit to unset
740 ram_set_gc_tag0 (visit
, GC_TAG_UNMARKED
);
752 printf ("**************** memory needed = %d\n", max_live
+1);
762 IF_GC_TRACE(printf("\nGC BEGINS\n"));
764 IF_GC_TRACE(printf("arg1\n"));
766 IF_GC_TRACE(printf("arg2\n"));
768 IF_GC_TRACE(printf("arg3\n"));
770 IF_GC_TRACE(printf("arg4\n"));
772 IF_GC_TRACE(printf("cont\n"));
774 IF_GC_TRACE(printf("env\n"));
775 mark (env
); // TODO do we mark the free list or do we rebuild it every time ? what about vectors ?
777 for (i
=0; i
<GLOVARS
; i
++)
778 mark (get_global (i
));
783 obj
alloc_ram_cell (void)
797 ERROR("memory is full");
802 free_list
= ram_get_car (o
);
807 obj
alloc_ram_cell_init (uint8 f0
, uint8 f1
, uint8 f2
, uint8 f3
)
809 obj o
= alloc_ram_cell ();
811 ram_set_field0 (o
, f0
);
812 ram_set_field1 (o
, f1
);
813 ram_set_field2 (o
, f2
);
814 ram_set_field3 (o
, f3
);
819 obj
alloc_vec_cell (uint16 n
) // TODO add a init version ?
821 obj o
= free_list_vec
;
830 while ((ram_get_cdr (o
) * 4) < n
) // free space too small
831 { // TODO BREGG IMPORTANT : si on atteint le fond de la free list, 0, le get_cdr foire, et on meurt avant de pouvoir faire du gc
832 if (o
== 0) // no free space, or none big enough
834 if (gc_done
) // we gc'd, but no space is big enough for the vector
835 ERROR("no room for vector");
843 } // TODO fuse adjacent free spaces, and maybe compact ? FOOBAR
848 // case 1 : the new vector fills every free word advertized, we remove the
849 // node from the free list
850 // TODO mettre le cdr de o dans une var temporaire ?
851 if ((n
- (ram_get_cdr(o
) * 4)) < 4) // TODO is there a better way ?
854 ram_set_car (prec
, ram_get_car (o
));
856 free_list_vec
= ram_get_car (o
);
858 // case 2 : there is still some space left in the free section, create a new
859 // node to represent this space
862 obj new_free
= o
+ (n
+ 3)/4;
864 ram_set_car (prec
, new_free
);
866 free_list_vec
= new_free
;
867 ram_set_car (new_free
, ram_get_car (o
));
868 ram_set_cdr (new_free
, ram_get_cdr (o
) - (n
+ 3)/4); // TODO documenter structure de cette free list quelque part
874 /*---------------------------------------------------------------------------*/
876 int32
decode_int (obj o
)
882 if (o
< MIN_FIXNUM_ENCODING
)
883 TYPE_ERROR("integer");
885 if (o
<= (MIN_FIXNUM_ENCODING
+ (MAX_FIXNUM
- MIN_FIXNUM
)))
886 return DECODE_FIXNUM(o
);
891 TYPE_ERROR("integer");
893 u
= ram_get_field1 (o
);
894 h
= ram_get_field2 (o
);
895 l
= ram_get_field3 (o
);
900 TYPE_ERROR("integer");
902 u
= rom_get_field1 (o
);
903 h
= rom_get_field2 (o
);
904 l
= rom_get_field3 (o
);
907 TYPE_ERROR("integer");
910 return ((int32
)((((int16
)u
- 256) << 8) + h
) << 8) + l
;
912 return ((int32
)(((int16
)u
<< 8) + h
) << 8) + l
;
915 obj
encode_int (int32 n
)
917 if (n
>= MIN_FIXNUM
&& n
<= MAX_FIXNUM
)
918 return ENCODE_FIXNUM(n
);
920 return alloc_ram_cell_init (BIGNUM_FIELD0
, n
>> 16, n
>> 8, n
);
923 /*---------------------------------------------------------------------------*/
935 else if (o
== OBJ_TRUE
)
937 else if (o
== OBJ_NULL
)
939 else if (o
<= (MIN_FIXNUM_ENCODING
+ (MAX_FIXNUM
- MIN_FIXNUM
)))
940 printf ("%d", DECODE_FIXNUM(o
));
941 else // TODO past here, everything is either in ram or in rom, until we add a 3rd space for vectors, that is
950 if ((in_ram
&& RAM_BIGNUM(o
)) || (!in_ram
&& ROM_BIGNUM(o
)))
951 printf ("%d", decode_int (o
));
952 else if ((in_ram
&& RAM_COMPOSITE(o
)) || (!in_ram
&& ROM_COMPOSITE(o
)))
957 if ((in_ram
&& RAM_PAIR(o
)) || (!in_ram
&& ROM_PAIR(o
))) // TODO not exactly efficient, fix it
961 car
= ram_get_car (o
);
962 cdr
= ram_get_cdr (o
);
966 car
= rom_get_car (o
);
967 cdr
= rom_get_cdr (o
);
978 else if ((IN_RAM(cdr
) && RAM_PAIR(cdr
))
979 || (IN_ROM(cdr
) && ROM_PAIR(cdr
)))
983 car
= ram_get_car (cdr
);
984 cdr
= ram_get_cdr (cdr
);
988 car
= rom_get_car (cdr
);
989 cdr
= rom_get_cdr (cdr
);
1002 else if ((in_ram
&& RAM_SYMBOL(o
)) || (!in_ram
&& ROM_SYMBOL(o
)))
1003 printf ("#<symbol>");
1004 else if ((in_ram
&& RAM_STRING(o
)) || (!in_ram
&& ROM_STRING(o
)))
1005 printf ("#<string>");
1006 else if ((in_ram
&& RAM_VECTOR(o
)) || (!in_ram
&& ROM_VECTOR(o
)))
1007 printf ("#<vector %d>", o
); // TODO do better DEBUG BREGG
1011 car
= ram_get_car (o
);
1012 cdr
= ram_get_cdr (o
);
1013 goto loop
; // TODO ugly hack, takes advantage of the fact that pairs and continuations have the same layout
1021 if (IN_RAM(o
)) // TODO can closures be in rom ? I don't think so
1022 env
= ram_get_cdr (o
);
1024 env
= rom_get_cdr (o
);
1027 pc
= ram_get_entry (o
);
1029 pc
= rom_get_entry (o
);
1031 printf ("{0x%04x ", pc
);
1040 void show_state (rom_addr pc
)
1043 printf ("pc=0x%04x bytecode=0x%02x env=", pc
, rom_get (pc
));
1060 /*---------------------------------------------------------------------------*/
1062 /* Integer operations */
1064 #define encode_bool(x) ((obj)(x))
1066 void prim_numberp (void)
1068 if (arg1
>= MIN_FIXNUM_ENCODING
1069 && arg1
<= (MIN_FIXNUM_ENCODING
+ (MAX_FIXNUM
- MIN_FIXNUM
)))
1074 arg1
= encode_bool (RAM_BIGNUM(arg1
));
1075 else if (IN_ROM(arg1
))
1076 arg1
= encode_bool (ROM_BIGNUM(arg1
));
1082 void decode_2_int_args (void)
1084 a1
= decode_int (arg1
);
1085 a2
= decode_int (arg2
);
1088 void prim_add (void)
1090 decode_2_int_args ();
1091 arg1
= encode_int (a1
+ a2
);
1095 void prim_sub (void)
1097 decode_2_int_args ();
1098 arg1
= encode_int (a1
- a2
);
1102 void prim_mul (void)
1104 decode_2_int_args ();
1105 arg1
= encode_int (a1
* a2
);
1109 void prim_div (void)
1111 decode_2_int_args ();
1113 ERROR("divide by 0");
1114 arg1
= encode_int (a1
/ a2
);
1118 void prim_rem (void)
1120 decode_2_int_args ();
1122 ERROR("divide by 0");
1123 arg1
= encode_int (a1
% a2
);
1127 void prim_neg (void)
1129 a1
= decode_int (arg1
);
1130 arg1
= encode_int (- a1
);
1135 decode_2_int_args ();
1136 arg1
= encode_bool (a1
== a2
);
1142 decode_2_int_args ();
1143 arg1
= encode_bool (a1
< a2
);
1149 decode_2_int_args ();
1150 arg1
= encode_bool (a1
> a2
);
1154 void prim_ior (void)
1156 a1
= decode_int (arg1
);
1157 a2
= decode_int (arg2
);
1158 arg1
= encode_int (a1
| a2
);
1162 void prim_xor (void)
1164 a1
= decode_int (arg1
);
1165 a2
= decode_int (arg2
);
1166 arg1
= encode_int (a1
^ a2
);
1171 /*---------------------------------------------------------------------------*/
1173 /* List operations */
1175 void prim_pairp (void)
1178 arg1
= encode_bool (RAM_PAIR(arg1
));
1179 else if (IN_ROM(arg1
))
1180 arg1
= encode_bool (ROM_PAIR(arg1
));
1185 obj
cons (obj car
, obj cdr
)
1187 return alloc_ram_cell_init (COMPOSITE_FIELD0
| (car
>> 8), // TODO was ((car & 0x1f00) >> 8), probably redundant
1189 PAIR_FIELD2
| (cdr
>> 8), // TODO was ((cdr & 0x1f00) >> 8), probably redundant
1193 void prim_cons (void)
1195 arg1
= cons (arg1
, arg2
);
1199 void prim_car (void)
1203 if (!RAM_PAIR(arg1
))
1205 arg1
= ram_get_car (arg1
);
1207 else if (IN_ROM(arg1
))
1209 if (!ROM_PAIR(arg1
))
1211 arg1
= rom_get_car (arg1
);
1219 void prim_cdr (void)
1223 if (!RAM_PAIR(arg1
))
1225 arg1
= ram_get_cdr (arg1
);
1227 else if (IN_ROM(arg1
))
1229 if (!ROM_PAIR(arg1
))
1231 arg1
= rom_get_cdr (arg1
);
1239 void prim_set_car (void)
1243 if (!RAM_PAIR(arg1
))
1246 ram_set_car (arg1
, arg2
);
1256 void prim_set_cdr (void)
1260 if (!RAM_PAIR(arg1
))
1263 ram_set_cdr (arg1
, arg2
);
1273 void prim_nullp (void)
1275 arg1
= encode_bool (arg1
== OBJ_NULL
);
1278 /*---------------------------------------------------------------------------*/
1280 /* Vector operations */
1282 void prim_u8vectorp (void)
1285 arg1
= encode_bool (RAM_VECTOR(arg1
));
1286 else if (IN_ROM(arg1
))
1287 arg1
= encode_bool (ROM_VECTOR(arg1
));
1292 void prim_make_u8vector (void)
1294 obj elems
= alloc_vec_cell (arg1
); // arg1 is length
1295 arg1
= alloc_ram_cell_init (COMPOSITE_FIELD0
| (arg1
>> 8),
1297 VECTOR_FIELD2
| (elems
>> 8),
1299 // the contents of the vector are intentionally left as they were.
1300 // it is up to the library functions to set them accordingly
1303 void prim_u8vector_ref (void)
1304 { // TODO how do we deal with rom vectors ? as lists ? they're never all that long
1305 arg2
= decode_int (arg2
);
1309 if (!RAM_VECTOR(arg1
))
1310 TYPE_ERROR("vector");
1311 if (ram_get_car (arg1
) < arg2
)
1312 ERROR("vector index too large");
1313 arg1
= ram_get_cdr (arg1
);
1315 else if (IN_ROM(arg1
))
1317 if (!ROM_VECTOR(arg1
))
1318 TYPE_ERROR("vector");
1319 if (rom_get_car (arg1
) < arg2
)
1320 ERROR("vector index too large");
1321 arg1
= rom_get_cdr (arg1
);
1324 TYPE_ERROR("vector");
1334 arg1
= ram_get_field0 (arg1
); break;
1336 arg1
= ram_get_field1 (arg1
); break;
1338 arg1
= ram_get_field2 (arg1
); break;
1340 arg1
= ram_get_field3 (arg1
); break;
1343 arg1
= encode_int (arg1
);
1345 else // rom vector, stored as a list
1346 { // TODO since these are stored as lists, nothing prevents us from having ordinary vectors, and not just byte vectors. in rom, both are lists so they are the same. in ram, byte vectors are in vector space, while ordinary vectors are still lists (the functions are already in the library)
1348 arg1
= rom_get_cdr (arg1
);
1350 arg1
= rom_get_car (arg1
);
1356 void prim_u8vector_set (void)
1357 { // TODO a lot in common with ref, abstract that
1358 arg2
= decode_int (arg2
);
1359 arg3
= decode_int (arg3
);
1362 ERROR("byte vectors can only contain bytes");
1366 if (!RAM_VECTOR(arg1
))
1367 TYPE_ERROR("vector");
1368 if (ram_get_car (arg1
) < arg2
)
1369 ERROR("vector index too large");
1370 arg1
= ram_get_cdr (arg1
);
1372 // TODO no rom vector header can point to vector space, right ?
1374 TYPE_ERROR("vector");
1382 ram_set_field0 (arg1
, arg3
); break;
1384 ram_set_field1 (arg1
, arg3
); break;
1386 ram_set_field2 (arg1
, arg3
); break;
1388 ram_set_field3 (arg1
, arg3
); break;
1396 void prim_u8vector_length (void)
1400 if (!RAM_VECTOR(arg1
))
1401 TYPE_ERROR("vector");
1402 arg1
= encode_int (ram_get_car (arg1
));
1404 else if (IN_ROM(arg1
))
1406 if (!ROM_VECTOR(arg1
))
1407 TYPE_ERROR("vector");
1408 arg1
= rom_get_car (arg1
);
1411 TYPE_ERROR("vector");
1414 /*---------------------------------------------------------------------------*/
1416 /* Miscellaneous operations */
1418 void prim_eqp (void)
1420 arg1
= encode_bool (arg1
== arg2
);
1424 void prim_not (void)
1426 arg1
= encode_bool (arg1
== OBJ_FALSE
);
1429 void prim_symbolp (void)
1432 arg1
= encode_bool (RAM_SYMBOL(arg1
));
1433 else if (IN_ROM(arg1
))
1434 arg1
= encode_bool (ROM_SYMBOL(arg1
));
1439 void prim_stringp (void)
1442 arg1
= encode_bool (RAM_STRING(arg1
));
1443 else if (IN_ROM(arg1
))
1444 arg1
= encode_bool (ROM_STRING(arg1
));
1449 void prim_string2list (void)
1453 if (!RAM_STRING(arg1
))
1454 TYPE_ERROR("string");
1456 arg1
= ram_get_car (arg1
);
1458 else if (IN_ROM(arg1
))
1460 if (!ROM_STRING(arg1
))
1461 TYPE_ERROR("string");
1463 arg1
= rom_get_car (arg1
);
1466 TYPE_ERROR("string");
1469 void prim_list2string (void)
1471 arg1
= alloc_ram_cell_init (COMPOSITE_FIELD0
| ((arg1
& 0x1f00) >> 8),
1478 /*---------------------------------------------------------------------------*/
1480 /* Robot specific operations */
1483 void prim_print (void)
1498 int32
read_clock (void)
1504 now
= from_now( 0 );
1512 static int32 start
= 0;
1517 now
= tb
.time
* 1000 + tb
.millitm
;
1524 static int32 start
= 0;
1527 if (gettimeofday (&tv
, NULL
) == 0)
1529 now
= tv
.tv_sec
* 1000 + tv
.tv_usec
/ 1000;
1543 void prim_clock (void)
1545 arg1
= encode_int (read_clock ());
1549 void prim_motor (void)
1551 decode_2_int_args ();
1553 if (a1
< 1 || a1
> 2 || a2
< -100 || a2
> 100)
1554 ERROR("argument out of range to procedure \"motor\"");
1564 printf ("motor %d -> power=%d\n", a1
, a2
);
1574 void prim_led (void)
1576 decode_2_int_args ();
1577 a3
= decode_int (arg3
);
1579 if (a1
< 1 || a1
> 3 || a2
< 0 || a3
< 0)
1580 ERROR("argument out of range to procedure \"led\"");
1584 LED_set( a1
, a2
, a3
);
1590 printf ("led %d -> duty=%d period=%d\n", a1
, a2
, a3
);
1601 void prim_led2_color (void)
1603 a1
= decode_int (arg1
);
1605 if (a1
< 0 || a1
> 1)
1606 ERROR("argument out of range to procedure \"led2-color\"");
1610 LED2_color_set( a1
);
1616 printf ("led2-color -> %s\n", (a1
==0)?"green":"red");
1625 void prim_getchar_wait (void)
1627 decode_2_int_args();
1628 a1
= read_clock () + a1
;
1630 if (a1
< 0 || a2
< 1 || a2
> 3)
1631 ERROR("argument out of range to procedure \"getchar-wait\"");
1638 serial_port_set ports
;
1639 ports
= serial_rx_wait_with_timeout( a2
, a1
);
1641 arg1
= encode_int (serial_rx_read( ports
));
1656 arg1
= encode_int (_getch ());
1659 } while (read_clock () < a1
);
1664 arg1
= encode_int (getchar ());
1672 void prim_putchar (void)
1674 decode_2_int_args ();
1676 if (a1
< 0 || a1
> 255 || a2
< 1 || a2
> 3)
1677 ERROR("argument out of range to procedure \"putchar\"");
1681 serial_tx_write( a2
, a1
);
1697 void prim_beep (void)
1699 decode_2_int_args ();
1701 if (a1
< 1 || a1
> 255 || a2
< 0)
1702 ERROR("argument out of range to procedure \"beep\"");
1706 beep( a1
, from_now( a2
) );
1712 printf ("beep -> freq-div=%d duration=%d\n", a1
, a2
);
1722 void prim_adc (void)
1726 a1
= decode_int (arg1
);
1728 if (a1
< 1 || a1
> 3)
1729 ERROR("argument out of range to procedure \"adc\"");
1739 x
= read_clock () & 255;
1741 if (x
> 127) x
= 256 - x
;
1747 arg1
= encode_int (x
);
1751 void prim_dac (void)
1753 a1
= decode_int (arg1
);
1755 if (a1
< 0 || a1
> 255)
1756 ERROR("argument out of range to procedure \"dac\"");
1766 printf ("dac -> %d\n", a1
);
1775 void prim_sernum (void)
1791 arg1
= encode_int (x
);
1795 /*---------------------------------------------------------------------------*/
1799 int hidden_fgetc (FILE *f
)
1809 #define fgetc(f) hidden_fgetc(f)
1811 void write_hex_nibble (int n
)
1813 putchar ("0123456789ABCDEF"[n
]);
1816 void write_hex (uint8 n
)
1818 write_hex_nibble (n
>> 4);
1819 write_hex_nibble (n
& 0x0f);
1824 if (c
>= '0' && c
<= '9')
1827 if (c
>= 'A' && c
<= 'F')
1828 return (c
- 'A' + 10);
1830 if (c
>= 'a' && c
<= 'f')
1831 return (c
- 'a' + 10);
1836 int read_hex_byte (FILE *f
)
1838 int h1
= hex (fgetc (f
));
1839 int h2
= hex (fgetc (f
));
1841 if (h1
>= 0 && h2
>= 0)
1842 return (h1
<<4) + h2
;
1847 int read_hex_file (char *filename
)
1850 FILE *f
= fopen (filename
, "r");
1860 for (i
=0; i
<ROM_BYTES
; i
++)
1865 while ((c
= fgetc (f
)) != EOF
)
1867 if ((c
== '\r') || (c
== '\n'))
1871 (len
= read_hex_byte (f
)) < 0 ||
1872 (a1
= read_hex_byte (f
)) < 0 ||
1873 (a2
= read_hex_byte (f
)) < 0 ||
1874 (t
= read_hex_byte (f
)) < 0)
1880 sum
= len
+ a1
+ a2
+ t
;
1888 unsigned long adr
= ((unsigned long)hi16
<< 16) + a
- CODE_START
;
1890 if ((b
= read_hex_byte (f
)) < 0)
1893 if (adr
>= 0 && adr
< ROM_BYTES
)
1896 a
= (a
+ 1) & 0xffff;
1913 if ((a1
= read_hex_byte (f
)) < 0 ||
1914 (a2
= read_hex_byte (f
)) < 0)
1919 hi16
= (a1
<<8) + a2
;
1924 if ((b
= read_hex_byte (f
)) < 0)
1931 printf ("*** HEX file checksum error (expected 0x%02x)\n", sum
);
1937 if ((c
!= '\r') && (c
!= '\n'))
1948 printf ("*** HEX file syntax error\n");
1958 /*---------------------------------------------------------------------------*/
1960 #define FETCH_NEXT_BYTECODE() bytecode = rom_get (pc++)
1962 #define BEGIN_DISPATCH() \
1964 IF_TRACE(show_state (pc)); \
1965 FETCH_NEXT_BYTECODE(); \
1966 bytecode_hi4 = bytecode & 0xf0; \
1967 bytecode_lo4 = bytecode & 0x0f; \
1968 switch (bytecode_hi4 >> 4) {
1970 #define END_DISPATCH() }
1972 #define CASE(opcode) case (opcode>>4):;
1974 #define DISPATCH(); goto dispatch;
1979 #define bytecode TABLAT
1980 #define bytecode_hi4 WREG
1983 #define PUSH_CONSTANT1 0x00
1984 #define PUSH_CONSTANT2 0x10
1985 #define PUSH_STACK1 0x20
1986 #define PUSH_STACK2 0x30
1987 #define PUSH_GLOBAL 0x40
1988 #define SET_GLOBAL 0x50
1991 #define LABEL_INSTR 0x80
1992 #define PUSH_CONSTANT_LONG 0x90
1994 // TODO these are free
1996 #define GOTO_IF_FALSE 0xb0
1997 #define CLOSURE 0xc0
2005 char *prim_name
[48] =
2029 "prim #%graft-to-cont",
2030 "prim #%return-to-cont",
2034 "prim #%string->list",
2035 "prim #%list->string",
2036 "prim #%make-u8vector", // TODO was prim29
2037 "prim #%u8vector-ref", // TODO was prim30
2038 "prim #%u8vector-set!", // TODO was prim31
2043 "prim #%led2-color",
2044 "prim #%getchar-wait",
2048 "prim #%u8vector?", // TODO was dac, but it's not plugged to anything
2050 "prim #%u8vector-length", // TODO was prim43
2051 "push-constant [long]",
2059 #define PUSH_ARG1() push_arg1 ()
2062 void push_arg1 (void)
2064 env
= cons (arg1
, env
);
2070 obj o
= ram_get_car (env
);
2071 env
= ram_get_cdr (env
);
2075 void pop_procedure (void)
2081 if (!RAM_CLOSURE(arg1
))
2082 TYPE_ERROR("procedure");
2084 entry
= ram_get_entry (arg1
) + CODE_START
; // FOO all addresses in the bytecode should be from 0, not from CODE_START, should be fixed everywhere, but might not be
2086 else if (IN_ROM(arg1
))
2088 if (!ROM_CLOSURE(arg1
))
2089 TYPE_ERROR("procedure");
2091 entry
= rom_get_entry (arg1
) + CODE_START
;
2094 TYPE_ERROR("procedure");
2097 void handle_arity_and_rest_param (void)
2101 np
= rom_get (entry
++);
2103 if ((np
& 0x80) == 0)
2106 ERROR("wrong number of arguments");
2113 ERROR("wrong number of arguments");
2121 arg3
= cons (arg4
, arg3
);
2127 arg1
= cons (arg3
, arg1
);
2132 void build_env (void)
2138 arg1
= cons (arg3
, arg1
);
2146 void save_cont (void)
2148 // the second half is a closure
2149 arg3
= alloc_ram_cell_init (CLOSURE_FIELD0
| (pc
>> 11),
2151 ((pc
& 0x0007) << 5) | (env
>> 8),
2153 cont
= alloc_ram_cell_init (COMPOSITE_FIELD0
| (cont
>> 8),
2155 CONTINUATION_FIELD2
| (arg3
>> 8),
2160 void interpreter (void)
2164 pc
= (CODE_START
+ 4) + ((rom_addr
)rom_get (CODE_START
+2) << 2);
2168 /***************************************************************************/
2169 CASE(PUSH_CONSTANT1
);
2171 IF_TRACE(printf(" (push-constant "); show (bytecode_lo4
); printf (")\n"));
2173 arg1
= bytecode_lo4
;
2179 /***************************************************************************/
2180 CASE(PUSH_CONSTANT2
);
2182 IF_TRACE(printf(" (push-constant "); show (bytecode_lo4
+16); printf (")\n"));
2183 arg1
= bytecode_lo4
+16;
2189 /***************************************************************************/
2192 IF_TRACE(printf(" (push-stack %d)\n", bytecode_lo4
));
2196 while (bytecode_lo4
!= 0)
2198 arg1
= ram_get_cdr (arg1
);
2202 arg1
= ram_get_car (arg1
);
2208 /***************************************************************************/
2211 IF_TRACE(printf(" (push-stack %d)\n", bytecode_lo4
+16));
2217 while (bytecode_lo4
!= 0)
2219 arg1
= ram_get_cdr (arg1
);
2223 arg1
= ram_get_car (arg1
);
2229 /***************************************************************************/
2232 IF_TRACE(printf(" (push-global %d)\n", bytecode_lo4
));
2234 arg1
= get_global (bytecode_lo4
);
2240 /***************************************************************************/
2243 IF_TRACE(printf(" (set-global %d)\n", bytecode_lo4
));
2245 set_global (bytecode_lo4
, POP());
2249 /***************************************************************************/
2252 IF_TRACE(printf(" (call %d)\n", bytecode_lo4
));
2257 handle_arity_and_rest_param ();
2268 /***************************************************************************/
2271 IF_TRACE(printf(" (jump %d)\n", bytecode_lo4
));
2276 handle_arity_and_rest_param ();
2286 /***************************************************************************/
2289 switch (bytecode_lo4
)
2291 case 0: // call-toplevel TODO put these in separate functions ?
2292 FETCH_NEXT_BYTECODE();
2295 FETCH_NEXT_BYTECODE();
2297 IF_TRACE(printf(" (call-toplevel 0x%04x)\n",
2298 ((arg2
<< 8) | bytecode
) + CODE_START
));
2300 entry
= (arg2
<< 8) + bytecode
+ CODE_START
;
2303 na
= rom_get (entry
++);
2316 case 1: // jump-toplevel
2317 FETCH_NEXT_BYTECODE();
2320 FETCH_NEXT_BYTECODE();
2322 IF_TRACE(printf(" (jump-toplevel 0x%04x)\n",
2323 ((arg2
<< 8) | bytecode
) + CODE_START
));
2325 entry
= (arg2
<< 8) + bytecode
+ CODE_START
; // TODO this is a common pattern
2328 na
= rom_get (entry
++);
2341 FETCH_NEXT_BYTECODE();
2344 FETCH_NEXT_BYTECODE();
2346 IF_TRACE(printf(" (goto 0x%04x)\n",
2347 (arg2
<< 8) + bytecode
+ CODE_START
));
2349 pc
= (arg2
<< 8) + bytecode
+ CODE_START
;
2353 case 3: // goto-if-false
2354 FETCH_NEXT_BYTECODE();
2357 FETCH_NEXT_BYTECODE();
2359 IF_TRACE(printf(" (goto-if-false 0x%04x)\n",
2360 (arg2
<< 8) + bytecode
+ CODE_START
));
2362 if (POP() == OBJ_FALSE
)
2363 pc
= (arg2
<< 8) + bytecode
+ CODE_START
;
2368 FETCH_NEXT_BYTECODE();
2371 FETCH_NEXT_BYTECODE();
2373 IF_TRACE(printf(" (closure 0x%04x)\n", (arg2
<< 8) | bytecode
));
2375 arg3
= POP(); // env
2377 entry
= (arg2
<< 8) | bytecode
;
2379 arg1
= alloc_ram_cell_init (CLOSURE_FIELD0
| (arg2
>> 3),
2380 ((arg2
& 0x07) << 5) | (bytecode
>> 3),
2381 ((bytecode
&0x07) <<5) |((arg3
&0x1f00) >>8),
2391 case 5: // call-toplevel-short
2392 FETCH_NEXT_BYTECODE(); // TODO the sort version have a lot in common with the long ones, abstract ?
2394 IF_TRACE(printf(" (call-toplevel-short 0x%04x)\n",
2395 pc
+ bytecode
+ CODE_START
));
2397 entry
= pc
+ bytecode
+ CODE_START
;
2400 na
= rom_get (entry
++);
2412 case 6: // jump-toplevel-short
2413 FETCH_NEXT_BYTECODE();
2415 IF_TRACE(printf(" (jump-toplevel-short 0x%04x)\n",
2416 pc
+ bytecode
+ CODE_START
));
2418 entry
= pc
+ bytecode
+ CODE_START
;
2421 na
= rom_get (entry
++);
2432 case 7: // goto-short
2433 FETCH_NEXT_BYTECODE();
2435 IF_TRACE(printf(" (goto-short 0x%04x)\n", pc
+ bytecode
+ CODE_START
));
2437 pc
= pc
+ bytecode
+ CODE_START
;
2441 case 8: // goto-if-false-short
2442 FETCH_NEXT_BYTECODE();
2444 IF_TRACE(printf(" (goto-if-false-short 0x%04x)\n",
2445 pc
+ bytecode
+ CODE_START
));
2447 if (POP() == OBJ_FALSE
)
2448 pc
= pc
+ bytecode
+ CODE_START
;
2452 case 9: // closure-short TODO I doubt these short instrs will have great effect, and this is the one I doubt the most about
2453 FETCH_NEXT_BYTECODE();
2455 IF_TRACE(printf(" (closure-short 0x%04x)\n", pc
+ bytecode
));
2457 arg3
= POP(); // env
2459 entry
= pc
+ bytecode
; // TODO makes sense for a closure ?
2461 arg1
= alloc_ram_cell_init (CLOSURE_FIELD0
| (arg2
>> 3),
2462 ((arg2
& 0x07) << 5) | (bytecode
>> 3),
2463 ((bytecode
&0x07) <<5) |((arg3
&0x1f00) >>8),
2482 case 14: // push_global [long]
2483 FETCH_NEXT_BYTECODE();
2485 IF_TRACE(printf(" (push-global [long] %d)\n", bytecode
));
2487 arg1
= get_global (bytecode
);
2493 case 15: // set_global [long]
2494 FETCH_NEXT_BYTECODE();
2496 IF_TRACE(printf(" (set-global [long] %d)\n", bytecode
));
2498 set_global (bytecode
, POP());
2505 /***************************************************************************/
2506 CASE(PUSH_CONSTANT_LONG
);
2508 /* push-constant [long] */
2510 FETCH_NEXT_BYTECODE();
2512 IF_TRACE(printf(" (push [long] 0x%04x)\n", (bytecode_lo4
<< 8) + bytecode
));
2514 arg1
= (bytecode_lo4
<< 8) | bytecode
;
2519 /***************************************************************************/
2520 CASE(GOTO
); // BREGG move
2524 /***************************************************************************/
2525 CASE(GOTO_IF_FALSE
); // BREGG move
2529 /***************************************************************************/
2530 CASE(CLOSURE
); // BREGG move
2534 /***************************************************************************/
2537 IF_TRACE(printf(" (%s)\n", prim_name
[bytecode_lo4
]));
2539 switch (bytecode_lo4
)
2542 arg1
= POP(); prim_numberp (); PUSH_ARG1(); break;
2544 arg2
= POP(); arg1
= POP(); prim_add (); PUSH_ARG1(); break;
2546 arg2
= POP(); arg1
= POP(); prim_sub (); PUSH_ARG1(); break;
2548 arg2
= POP(); arg1
= POP(); prim_mul (); PUSH_ARG1(); break;
2550 arg2
= POP(); arg1
= POP(); prim_div (); PUSH_ARG1(); break;
2552 arg2
= POP(); arg1
= POP(); prim_rem (); PUSH_ARG1(); break;
2554 arg1
= POP(); prim_neg (); PUSH_ARG1(); break;
2556 arg2
= POP(); arg1
= POP(); prim_eq (); PUSH_ARG1(); break;
2558 arg2
= POP(); arg1
= POP(); prim_lt (); PUSH_ARG1(); break;
2560 arg2
= POP(); arg1
= POP(); prim_ior (); PUSH_ARG1(); break;
2562 arg2
= POP(); arg1
= POP(); prim_gt (); PUSH_ARG1(); break;
2564 arg2
= POP(); arg1
= POP(); prim_xor (); PUSH_ARG1(); break;
2566 arg1
= POP(); prim_pairp (); PUSH_ARG1(); break;
2568 arg2
= POP(); arg1
= POP(); prim_cons (); PUSH_ARG1(); break;
2570 arg1
= POP(); prim_car (); PUSH_ARG1(); break;
2572 arg1
= POP(); prim_cdr (); PUSH_ARG1(); break;
2577 /***************************************************************************/
2580 IF_TRACE(printf(" (%s)\n", prim_name
[bytecode_lo4
+16]));
2582 switch (bytecode_lo4
)
2585 arg2
= POP(); arg1
= POP(); prim_set_car (); break;
2587 arg2
= POP(); arg1
= POP(); prim_set_cdr (); break;
2589 arg1
= POP(); prim_nullp (); PUSH_ARG1(); break;
2591 arg2
= POP(); arg1
= POP(); prim_eqp (); PUSH_ARG1(); break;
2593 arg1
= POP(); prim_not (); PUSH_ARG1(); break;
2595 /* prim #%get-cont */
2600 /* prim #%graft-to-cont */
2602 arg1
= POP(); /* thunk to call */
2603 cont
= POP(); /* continuation */
2610 handle_arity_and_rest_param ();
2620 /* prim #%return-to-cont */
2622 arg1
= POP(); /* value to return */
2623 cont
= POP(); /* continuation */
2625 arg2
= ram_get_cdr (cont
);
2627 pc
= ram_get_entry (arg2
);
2629 env
= ram_get_cdr (arg2
);
2630 cont
= ram_get_car (cont
);
2640 /* prim #%symbol? */
2641 arg1
= POP(); prim_symbolp (); PUSH_ARG1(); break;
2643 /* prim #%string? */
2644 arg1
= POP(); prim_stringp (); PUSH_ARG1(); break;
2646 /* prim #%string->list */
2647 arg1
= POP(); prim_string2list (); PUSH_ARG1(); break;
2649 /* prim #%list->string */
2650 arg1
= POP(); prim_list2string (); PUSH_ARG1(); break;
2652 /* prim #%make-u8vector */
2653 arg1
= POP(); prim_make_u8vector (); PUSH_ARG1(); break;
2655 /* prim #%u8vector-ref */
2656 arg2
= POP(); arg1
= POP(); prim_u8vector_ref (); PUSH_ARG1(); break;
2658 /* prim #%u8vector-set! */
2659 arg3
= POP(); arg2
= POP(); arg1
= POP(); prim_u8vector_set (); break;
2664 /***************************************************************************/
2667 IF_TRACE(printf(" (%s)\n", prim_name
[bytecode_lo4
+32]));
2669 switch (bytecode_lo4
)
2678 prim_clock (); PUSH_ARG1(); break;
2681 arg2
= POP(); arg1
= POP(); prim_motor (); break;
2684 arg3
= POP(); arg2
= POP(); arg1
= POP(); prim_led (); ;break;
2686 /* prim #%led2-color */
2687 arg1
= POP(); prim_led2_color (); break;
2689 /* prim #%getchar-wait */
2690 arg2
= POP(); arg1
= POP(); prim_getchar_wait (); PUSH_ARG1(); break;
2692 /* prim #%putchar */
2693 arg2
= POP(); arg1
= POP(); prim_putchar (); break;
2696 arg2
= POP(); arg1
= POP(); prim_beep (); break;
2699 arg1
= POP(); prim_adc (); PUSH_ARG1(); break;
2701 /* prim #%u8vector? */
2702 arg1
= POP(); prim_u8vectorp (); PUSH_ARG1(); break;
2705 prim_sernum (); PUSH_ARG1(); break;
2707 /* prim #%u8vector-length */
2708 arg1
= POP(); prim_u8vector_length (); PUSH_ARG1(); break;
2710 // FREE find something to do with this
2725 arg2
= ram_get_cdr (cont
);
2726 pc
= ram_get_entry (arg2
);
2727 env
= ram_get_cdr (arg2
);
2728 cont
= ram_get_car (cont
);
2736 /***************************************************************************/
2741 /*---------------------------------------------------------------------------*/
2747 printf ("usage: sim file.hex\n");
2751 int main (int argc
, char *argv
[])
2754 rom_addr rom_start_addr
= 0;
2756 if (argc
> 1 && argv
[1][0] == '-' && argv
[1][1] == 's')
2763 if ((h1
= hex (argv
[1][2])) < 0 ||
2764 (h2
= hex (argv
[1][3])) < 0 ||
2765 (h3
= hex (argv
[1][4])) != 0 ||
2766 (h4
= hex (argv
[1][5])) != 0 ||
2770 rom_start_addr
= (h1
<< 12) | (h2
<< 8) | (h3
<< 4) | h4
;
2777 printf ("Start address = 0x%04x\n", rom_start_addr
); // TODO says 0, but should be CODE_START ?
2783 if (!read_hex_file (argv
[1]))
2784 printf ("*** Could not read hex file \"%s\"\n", argv
[1]);
2789 if (rom_get (CODE_START
+0) != 0xfb ||
2790 rom_get (CODE_START
+1) != 0xd7)
2791 printf ("*** The hex file was not compiled with PICOBIT\n");
2795 for (i
=0; i
<8192; i
++) // TODO remove this ? and not the night address space, now 16 bits
2796 if (rom_get (i
) != 0xff)
2797 printf ("rom_mem[0x%04x] = 0x%02x\n", i
, rom_get (i
));
2803 printf ("**************** memory needed = %d\n", max_live
+1);
2813 /*---------------------------------------------------------------------------*/