/* A very simplified runtime system for the native code compiler */ #include #include int heapsize = 1024 * 1024; /* 1M */ char * young_start, * young_ptr, * young_end; char * remembered_set[4096]; char ** remembered_ptr = remembered_set; char ** remembered_end = remembered_set + 4096; void garbage_collection(request) int request; { young_start = malloc(heapsize); if (young_start == NULL) { fprintf(stderr, "Out of heap size\n"); exit(2); } young_end = young_start + heapsize; young_ptr = young_end - request; } void realloc_remembered() { remembered_ptr = remembered_set; } extern int caml_start_program(); typedef long value; value print_int(n) value n; { printf("%d", n>>1); return 1; } value print_string(s) value s; { printf("%s", (char *) s); return 1; } value equal(v1, v2) value v1, v2; { value * p1, * p2; value hdr1, hdr2, size, i; tailcall: if (v1 == v2) return 3; /* true */ if (v1 & 1) return 1; /* false */ if (v1 & 1) return 1; /* false */ p1 = (value *) v1; p2 = (value *) v2; hdr1 = p1[-1]; hdr2 = p2[-1]; if (hdr1 != hdr2) return 1; /* false */ size = hdr1 >> 10; switch(hdr1 & 0xFF) { case 251: fprintf(stderr, "equal between functions\n"); exit(2); case 253: for (i = 0; i < size; i++) if (p1[i] != p2[i]) return 1; return 3; case 254: if (*((double *) v1) = *((double *) v2)) return 3; else return 1; default: for (i = 0; i < size-1; i++) if (equal(p1[i], p2[i]) == 1) return 1; v1 = p1[i]; v2 = p2[i]; goto tailcall; } } value notequal(v1, v2) value v1, v2; { return (4 - equal(v1, v2)); } #define COMPARISON(name) \ value name(v1, v2) \ value v1, v2; \ { \ fprintf(stderr, "%s not implemented.\n", #name); \ exit(2); \ } COMPARISON(greaterequal) COMPARISON(lessequal) COMPARISON(greaterthan) COMPARISON(lessthan) value alloc_dummy(size) int size; { value * block; int bsize, i; bsize = (size + 1) * sizeof(value); young_ptr -= bsize; if (young_ptr < young_start) garbage_collection(bsize); block = (value *) young_ptr + 1; block[-1] = size << 10; for (i = 0; i < size; i++) block[i] = 0; return (value) block; } static struct { value header; char data[16]; } match_failure_id = { 0, "Match_failure" }; /* to be revised */ char * Match_failure = match_failure_id.data; int main(argc, argv) int argc; char ** argv; { garbage_collection(0); if (caml_start_program() != 0) { fprintf(stderr, "Uncaught exception\n"); exit(2); } return 0; }