diff --git a/doc/lectures.out b/doc/lectures.out new file mode 100755 index 000000000..22a2ca2f6 --- /dev/null +++ b/doc/lectures.out @@ -0,0 +1,22 @@ +\BOOKMARK [1][-]{section.1}{Introduction:\040Languages,\040Semantics,\040Interpreters,\040Compilers}{}% 1 +\BOOKMARK [2][-]{subsection.1.1}{Language\040and\040semantics}{section.1}% 2 +\BOOKMARK [2][-]{subsection.1.2}{Interpreters}{section.1}% 3 +\BOOKMARK [2][-]{subsection.1.3}{Compilers}{section.1}% 4 +\BOOKMARK [2][-]{subsection.1.4}{The\040first\040example:\040language\040of\040expressions}{section.1}% 5 +\BOOKMARK [1][-]{section.2}{Statements,\040Stack\040Machine,\040Stack\040Machine\040Compiler}{}% 6 +\BOOKMARK [2][-]{subsection.2.1}{Statements}{section.2}% 7 +\BOOKMARK [1][-]{section.3}{Stack\040Machine}{}% 8 +\BOOKMARK [2][-]{subsection.3.1}{A\040Compiler\040for\040the\040Stack\040Machine}{section.3}% 9 +\BOOKMARK [1][-]{section.4}{Structural\040Induction}{}% 10 +\BOOKMARK [2][-]{subsection.4.1}{Structural\040Control\040Flow}{section.4}% 11 +\BOOKMARK [2][-]{subsection.4.2}{Extended\040Stack\040Machine}{section.4}% 12 +\BOOKMARK [2][-]{subsection.4.3}{Syntax\040Extensions}{section.4}% 13 +\BOOKMARK [1][-]{section.5}{Procedures}{}% 14 +\BOOKMARK [1][-]{section.6}{Extended\040Stack\040Machine}{}% 15 +\BOOKMARK [1][-]{section.7}{Functions}{}% 16 +\BOOKMARK [2][-]{subsection.7.1}{Functions\040in\040Expressions}{section.7}% 17 +\BOOKMARK [2][-]{subsection.7.2}{Return\040Statement}{section.7}% 18 +\BOOKMARK [1][-]{section.8}{Arrays\040and\040strings}{}% 19 +\BOOKMARK [2][-]{subsection.8.1}{Adding\040arrays\040on\040expression\040level}{section.8}% 20 +\BOOKMARK [2][-]{subsection.8.2}{Adding\040arrays\040on\040statement\040level}{section.8}% 21 +\BOOKMARK [2][-]{subsection.8.3}{Strings}{section.8}% 22 diff --git a/doc/lectures.pdf b/doc/lectures.pdf new file mode 100755 index 000000000..0d6499723 Binary files /dev/null and b/doc/lectures.pdf differ diff --git a/regression/x86only/Makefile b/regression/x86only/Makefile index d78ca38c1..3584822b1 100644 --- a/regression/x86only/Makefile +++ b/regression/x86only/Makefile @@ -7,7 +7,7 @@ RC=../../src/rc.opt check: $(TESTS) $(TESTS): %: %.expr - @RC_RUNTIME=../../runtime $(RC) $< && cat $@.input | ./$@ > $@.log && diff $@.log orig/$@.log + @RC_RUNTIME=../../runtime $(RC) $< && cat $@.input | ./$@ > $@.log && diff -u $@.log orig/$@.log clean: rm -f test*.log *.s *~ $(TESTS) diff --git a/regression/x86only/vgcore.3910 b/regression/x86only/vgcore.3910 new file mode 100644 index 000000000..81220a5b3 Binary files /dev/null and b/regression/x86only/vgcore.3910 differ diff --git a/runtime/gc_runtime.s b/runtime/gc_runtime.s index e10fcc71b..ac8668c40 100644 --- a/runtime/gc_runtime.s +++ b/runtime/gc_runtime.s @@ -15,7 +15,7 @@ __gc_stack_top: .long 0 .extern gc_test_and_copy_root .text -L__gc_init: movl %esp, __gc_stack_bottom +L__gc_init: movl %ebp, __gc_stack_bottom addl $4, __gc_stack_bottom call init_pool ret diff --git a/runtime/runtime.c b/runtime/runtime.c index 9075105a9..f339db8b7 100644 --- a/runtime/runtime.c +++ b/runtime/runtime.c @@ -9,19 +9,39 @@ # include // # define DEBUG_PRINT 1 +/* GC pool structure and data; declared here in order to allow debug print */ +typedef struct { + size_t * begin; + size_t * end; + size_t * current; + size_t size; +} pool; + +static pool from_space; +static pool to_space; +size_t *current; +/* end */ + +/* GC extern invariant for built-in functions */ +extern void __pre_gc (); +extern void __post_gc (); +/* end */ # define STRING_TAG 0x00000001 # define ARRAY_TAG 0x00000003 # define SEXP_TAG 0x00000005 # define LEN(x) ((x & 0xFFFFFFF8) >> 3) -# define TAG(x) (x & 0x00000007) +# define TAG(x) (x & 0x00000007) # define TO_DATA(x) ((data*)((char*)(x)-sizeof(int))) # define TO_SEXP(x) ((sexp*)((char*)(x)-2*sizeof(int))) +#ifdef DEBUG_PRINT // GET_SEXP_TAG is necessary for printing from space +# define GET_SEXP_TAG(x) (LEN(x)) +#endif -# define UNBOXED(x) (((int) (x)) & 0x0001) -# define UNBOX(x) (((int) (x)) >> 1) +# define UNBOXED(x) (((int) (x)) & 0x0001) +# define UNBOX(x) (((int) (x)) >> 1) # define BOX(x) ((((int) (x)) << 1) | 0x0001) typedef struct { @@ -37,7 +57,7 @@ typedef struct { extern void* alloc (size_t); extern int Blength (void *p) { - data *a = (char*) BOX (NULL); + data *a = (data*) BOX (NULL); a = TO_DATA(p); return BOX(LEN(a->tag)); } @@ -45,19 +65,19 @@ extern int Blength (void *p) { char* de_hash (int n) { static char *chars = (char*) BOX (NULL); static char buf[6] = {0,0,0,0,0,0}; - char *p = (char*) BOX (NULL); + char *p = (char *) BOX (NULL); chars = "_abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNJPQRSTUVWXYZ"; p = &buf[5]; #ifdef DEBUG_PRINT - printf ("de_hash: tag: %d\n", n); + printf ("de_hash: tag: %d\n", n); fflush (stdout); #endif *p-- = 0; while (n != 0) { #ifdef DEBUG_PRINT - printf ("char: %c\n", chars [n & 0x003F]); + printf ("char: %c\n", chars [n & 0x003F]); fflush (stdout); #endif *p-- = chars [n & 0x003F]; n = n >> 6; @@ -135,7 +155,11 @@ static void printValue (void *p) { break; case SEXP_TAG: { +#ifndef DEBUG_PRINT char * tag = de_hash (TO_SEXP(p)->tag); +#else + char * tag = de_hash (GET_SEXP_TAG(TO_SEXP(p)->tag)); +#endif if (strcmp (tag, "cons") == 0) { data *b = a; @@ -167,7 +191,7 @@ static void printValue (void *p) { } } break; - + default: printStringBuf ("*** invalid tag: %x ***", TAG(a->tag)); } @@ -204,7 +228,7 @@ extern void* Bstring (void *p) { } extern void* Bstringval (void *p) { - void *s = BOX(NULL); + void *s = (void *) BOX (NULL); __pre_gc () ; @@ -229,8 +253,7 @@ extern void* Barray (int n, ...) { __pre_gc (); #ifdef DEBUG_PRINT - printf ("Barray: create n = %d\n", n); - fflush(stdout); + printf ("Barray: create n = %d\n", n); fflush(stdout); #endif r = (data*) alloc (sizeof(int) * (n+1)); @@ -256,12 +279,12 @@ extern void* Bsexp (int n, ...) { int ai = BOX(0); size_t * p = NULL; sexp *r = (sexp*) BOX (NULL); - data *d = (sexp*) BOX (NULL); + data *d = (data *) BOX (NULL); __pre_gc () ; #ifdef DEBUG_PRINT - printf("Bsexp: allocate %zu!\n",sizeof(int) * (n+1)); + printf("Bsexp: allocate %zu!\n",sizeof(int) * (n+1)); fflush (stdout); #endif r = (sexp*) alloc (sizeof(int) * (n+1)); d = &(r->contents); @@ -279,6 +302,11 @@ extern void* Bsexp (int n, ...) { } r->tag = va_arg(args, int); + +#ifdef DEBUG_PRINT + r->tag = SEXP_TAG | ((r->tag) << 3); +#endif + va_end(args); __post_gc(); @@ -287,9 +315,14 @@ extern void* Bsexp (int n, ...) { } extern int Btag (void *d, int t, int n) { - data *r = (data*) BOX (NULL); + data *r = (data *) BOX (NULL); r = TO_DATA(d); +#ifndef DEBUG_PRINT return BOX(TAG(r->tag) == SEXP_TAG && TO_SEXP(d)->tag == t && LEN(r->tag) == n); +#else + return BOX(TAG(r->tag) == SEXP_TAG && + GET_SEXP_TAG(TO_SEXP(d)->tag) == t && LEN(r->tag) == n); +#endif } extern int Barray_patt (void *d, int n) { @@ -421,9 +454,6 @@ extern int Lwrite (int n) { extern const size_t __gc_data_end, __gc_data_start; extern void L__gc_init (); -extern void __pre_gc (); -extern void __post_gc (); - extern void __gc_root_scan_stack (); /* ======================================== */ @@ -431,19 +461,9 @@ extern void __gc_root_scan_stack (); /* ======================================== */ static size_t SPACE_SIZE = 128; +// static size_t SPACE_SIZE = 1280; # define POOL_SIZE (2*SPACE_SIZE) -typedef struct { - size_t * begin; - size_t * end; - size_t * current; - size_t size; -} pool; - -static pool from_space; -static pool to_space; -size_t * current; - static void swap (size_t ** a, size_t ** b) { size_t * t = *a; *a = *b; @@ -484,7 +504,7 @@ static void copy_elements (size_t *where, size_t *from, int len) { p = gc_copy ((size_t*) elem); *where = p; #ifdef DEBUG_PRINT - printf ("copy_elements: fix %x: %x\n", from, *where); + printf ("copy_elements: fix %p: %p\n", from, *where); fflush (stdout); #endif where ++; } @@ -492,19 +512,23 @@ static void copy_elements (size_t *where, size_t *from, int len) { } static void extend_spaces (void) { - void *p1 = mremap(from_space.begin, SPACE_SIZE, 2*SPACE_SIZE, 0); - void *p2 = mremap(to_space.begin , SPACE_SIZE, 2*SPACE_SIZE, 0); - if (p1 == MAP_FAILED || p2 == MAP_FAILED) { - perror("ERROR: extend_spaces: mmap failed\n"); + void *p1 = (void *) BOX (NULL), *p2 = (void *) BOX (NULL); + size_t old_space_size = SPACE_SIZE * sizeof(size_t), + new_space_size = (SPACE_SIZE << 1) * sizeof(size_t); + p1 = mremap(from_space.begin, old_space_size, new_space_size, 0); + p2 = mremap(to_space.begin , old_space_size, new_space_size, 0); + if (p1 == MAP_FAILED || p2 == MAP_FAILED) { + perror("EROOR: extend_spaces: mmap failed\n"); exit (1); } #ifdef DEBUG_PRINT - printf ("extend: %x %x %x %x\n", p1, p2, from_space.begin, to_space.begin); - printf ("extend: %x %x %x\n", from_space.end, to_space.end, current); + printf ("extend: %p %p %p %p\n", p1, p2, from_space.begin, to_space.begin); + printf ("extend: %p %p %p\n" , from_space.end, to_space.end, current); + fflush (stdout); #endif from_space.end += SPACE_SIZE; to_space.end += SPACE_SIZE; - SPACE_SIZE += SPACE_SIZE; + SPACE_SIZE = SPACE_SIZE << 1; from_space.size = SPACE_SIZE; to_space.size = SPACE_SIZE; } @@ -518,19 +542,20 @@ extern size_t * gc_copy (size_t *obj) { int len1, len2, len3; void * objj; void * newobjj = (void*)current; - printf("gc_copy: %x cur = %x starts\n", obj, current); + printf ("gc_copy: %p cur = %p starts\n", obj, current); + fflush (stdout); #endif if (!IS_VALID_HEAP_POINTER(obj)) { #ifdef DEBUG_PRINT - printf ("gc_copy: invalid ptr: %x\n", obj); + printf ("gc_copy: invalid ptr: %p\n", obj); fflush (stdout); #endif return obj; } if (!IN_PASSIVE_SPACE(current) && current != to_space.end) { #ifdef DEBUG_PRINT - printf("ERROR: gc_copy: out-of-space %x %x %x\n", current, to_space.begin, to_space.end); + printf("ERROR: gc_copy: out-of-space %p %p %p\n", current, to_space.begin, to_space.end); fflush(stdout); #endif perror("ERROR: gc_copy: out-of-space\n"); @@ -539,7 +564,7 @@ extern size_t * gc_copy (size_t *obj) { if (IS_FORWARD_PTR(d->tag)) { #ifdef DEBUG_PRINT - printf ("gc_copy: IS_FORWARD_PTR: return! %x\n", (size_t *) d->tag); + printf ("gc_copy: IS_FORWARD_PTR: return! %p\n", (size_t *) d->tag); fflush(stdout); #endif return (size_t *) d->tag; @@ -552,8 +577,7 @@ extern size_t * gc_copy (size_t *obj) { switch (TAG(d->tag)) { case ARRAY_TAG: #ifdef DEBUG_PRINT - printf ("gc_copy:array_tag; len = %zu\n", LEN(d->tag)); - fflush(stdout); + printf ("gc_copy:array_tag; len = %zu\n", LEN(d->tag)); fflush (stdout); #endif current += (LEN(d->tag) + 1) * sizeof (int); *copy = d->tag; @@ -565,8 +589,7 @@ extern size_t * gc_copy (size_t *obj) { case STRING_TAG: #ifdef DEBUG_PRINT - printf ("gc_copy:string_tag; len = %d\n", LEN(d->tag) + 1); - fflush(stdout); + printf ("gc_copy:string_tag; len = %d\n", LEN(d->tag) + 1); fflush (stdout); #endif current += LEN(d->tag) * sizeof(char) + sizeof (int); *copy = d->tag; @@ -582,7 +605,8 @@ extern size_t * gc_copy (size_t *obj) { len1 = LEN(s->contents.tag); len2 = LEN(s->tag); len3 = LEN(d->tag); - printf("len1 = %li, len2=%li, len3 = %li\n",len1,len2,len3); + printf ("len1 = %li, len2=%li, len3 = %li\n", len1, len2, len3); + fflush (stdout); #endif current += (LEN(s->contents.tag) + 2) * sizeof (int); *copy = s->tag; @@ -596,15 +620,14 @@ extern size_t * gc_copy (size_t *obj) { default: #ifdef DEBUG_PRINT - printf ("ERROR: gc_copy: weird tag: %x", TAG(d->tag)); - fflush(stdout); + printf ("ERROR: gc_copy: weird tag: %p", TAG(d->tag)); fflush (stdout); #endif perror ("ERROR: gc_copy: weird tag"); exit (1); } #ifdef DEBUG_PRINT - printf("gc_copy: %x (%x) -> %x (%x); new-current = %x\n", obj, objj, copy, newobjj, current); - fflush(stdout); + printf ("gc_copy: %p(%p) -> %p (%p); new-current = %p\n", obj, objj, copy, newobjj, current); + fflush (stdout); #endif return copy; } @@ -612,7 +635,7 @@ extern size_t * gc_copy (size_t *obj) { extern void gc_test_and_copy_root (size_t ** root) { if (IS_VALID_HEAP_POINTER(*root)) { #ifdef DEBUG_PRINT - printf ("gc_test_and_copy_root: root %x %x\n", root, *root); + printf ("gc_test_and_copy_root: root %p %p\n", root, *root); fflush (stdout); #endif *root = gc_copy (*root); } @@ -627,14 +650,14 @@ extern void gc_root_scan_data (void) { } extern void init_pool (void) { - from_space.begin = mmap(NULL, SPACE_SIZE, PROT_READ | PROT_WRITE, - MAP_PRIVATE | MAP_ANONYMOUS | MAP_32BIT, -1, 0); - to_space.begin = mmap(NULL, SPACE_SIZE, PROT_READ | PROT_WRITE, - MAP_PRIVATE | MAP_ANONYMOUS | MAP_32BIT, -1, 0); - if (to_space.begin == MAP_FAILED || - from_space.begin == MAP_FAILED) { - perror("ERROR: init_pool: mmap failed\n"); - exit (1); + size_t space_size = SPACE_SIZE * sizeof(size_t); + from_space.begin = mmap (NULL, space_size, PROT_READ | PROT_WRITE, + MAP_PRIVATE | MAP_ANONYMOUS | MAP_32BIT, -1, 0); + to_space.begin = mmap (NULL, space_size, PROT_READ | PROT_WRITE, + MAP_PRIVATE | MAP_ANONYMOUS | MAP_32BIT, -1, 0); + if (to_space.begin == MAP_FAILED || from_space.begin == MAP_FAILED) { + perror ("EROOR: init_pool: mmap failed\n"); + exit (1); } from_space.current = from_space.begin; from_space.end = from_space.begin + SPACE_SIZE; @@ -651,26 +674,29 @@ static int free_pool (pool * p) { static void * gc (size_t size) { current = to_space.begin; #ifdef DEBUG_PRINT - printf("\ngc: current: %x; to_space.b = %x; to_space.e = %x; f_space.b = %x; f_space.e = %x\n", - current, to_space.begin, to_space.end, from_space.begin, from_space.end); + printf ("\ngc: current:%p; to_space.b =%p; to_space.e =%p; f_space.b = %p; f_space.e = %p\n", + current, to_space.begin, to_space.end, from_space.begin, from_space.end); + fflush (stdout); #endif - gc_root_scan_data (); + gc_root_scan_data (); #ifdef DEBUG_PRINT - printf("gc: data is scanned\n"); + printf ("gc: data is scanned\n"); fflush (stdout); #endif __gc_root_scan_stack (); if (!IN_PASSIVE_SPACE(current)) { perror ("ASSERT: !IN_PASSIVE_SPACE(current)\n"); - exit (1); + exit (1); } while (current + size >= to_space.end) { #ifdef DEBUG_PRINT - printf ("gc pre-extend_spaces : %x %x %x \n", current, size, to_space.end); + printf ("gc pre-extend_spaces : %p %zu %p \n", current, size, to_space.end); + fflush (stdout); #endif extend_spaces (); #ifdef DEBUG_PRINT - printf ("gc post-extend_spaces: %x %x %x \n", current, size, to_space.end); + printf ("gc post-extend_spaces: %p %zu %p \n", current, size, to_space.end); + fflush (stdout); #endif } assert (IN_PASSIVE_SPACE(current)); @@ -679,27 +705,100 @@ static void * gc (size_t size) { gc_swap_spaces (); from_space.current = current + size; #ifdef DEBUG_PRINT - printf ("gc: end: (allocate!) return %x; from_space.current %x; from_space.end \n\n", - current, from_space.current, from_space.end); + printf ("gc: end: (allocate!) return %p; from_space.current %p; from_space.end %p \n\n", + current, from_space.current, from_space.end); + fflush (stdout); #endif return (void *) current; } +#ifdef DEBUG_PRINT +static void printFromSpace (void) { + size_t * cur = from_space.begin, *tmp = NULL; + data * d = NULL; + sexp * s = NULL; + size_t len = 0; + + printf ("\nHEAP SNAPSHOT\n===================\n"); + printf ("f_begin = %p, f_end = %p,\n", from_space.begin, from_space.end); + while (cur < from_space.current) { + printf ("data at %p", cur); + d = (data *) cur; + + switch (TAG(d->tag)) { + + case STRING_TAG: + printf ("(=>%p): STRING\n\t%s\n", d->contents, d->contents); + len = LEN(d->tag) + 1; + fflush (stdout); + break; + + case ARRAY_TAG: + printf ("(=>%p): ARRAY\n\t", d->contents); + len = LEN(d->tag); + for (int i = 0; i < len; i++) { + int elem = ((int*)d->contents)[i]; + if (UNBOXED(elem)) printf ("%d ", elem); + else printf ("%p ", elem); + } + len += 1; + printf ("\n"); + fflush (stdout); + break; + + case SEXP_TAG: + s = (sexp *) d; + d = (data *) &(s->contents); + char * tag = de_hash (GET_SEXP_TAG(s->tag)); + printf ("(=>%p): SEXP\n\ttag(%s) ", s->contents.contents, tag); + len = LEN(d->tag); + tmp = (s->contents.contents); + for (int i = 0; i < len; i++) { + int elem = ((int*)tmp)[i]; + if (UNBOXED(elem)) printf ("%d ", UNBOX(elem)); + else printf ("%p ", elem); + } + len += 2; + printf ("\n"); + fflush (stdout); + break; + + case 0: + printf ("\nprintFromSpace: end!\n===================\n\n"); + return; + + default: + printf ("\nprintFromSpace: ERROR: bad tag %d", TAG(d->tag)); + fflush (stdout); + exit (1); + } + cur += len * sizeof(int); + printf ("len = %zu, new cur = %p\n", len, cur); + } +} +#endif + extern void * alloc (size_t size) { void * p = (void*)BOX(NULL); if (from_space.current + size < from_space.end) { #ifdef DEBUG_PRINT - printf("alloc: current: %x %zu", from_space.current, size); + printf ("alloc: current: %p %zu", from_space.current, size); fflush (stdout); #endif p = (void*) from_space.current; from_space.current += size; #ifdef DEBUG_PRINT - printf(";new current: %x \n", from_space.current); + printf (";new current: %p \n", from_space.current); fflush (stdout); #endif return p; } #ifdef DEBUG_PRINT - printf("alloc: call gc: %zu\n", size); + printf ("alloc: call gc: %zu\n", size); fflush (stdout); + printFromSpace(); fflush (stdout); +#endif + p = gc (size); +#ifdef DEBUG_PRINT + printf("gc END\n\n"); fflush (stdout); + printFromSpace(); fflush (stdout); #endif return gc (size); } diff --git a/src/SM.ml b/src/SM.ml index 880a173b6..5c44ef75a 100644 --- a/src/SM.ml +++ b/src/SM.ml @@ -263,10 +263,10 @@ let compile (defs, p) = add_code (compile_expr lsv env e) lsv false [CALL (".stringval", 1)] | Expr.Assign (x, e) -> let lassn, env = env#get_label in - (*(match x with - | Expr.Ref x -> add_code (compile_expr lassn env e) lassn false [ST x] - | _ ->*) add_code (compile_list lassn env [x; e]) lassn false [match x with Expr.ElemRef _ -> STA | _ -> STI] - (*--) *) + add_code (compile_list lassn env [x; e]) lassn false [match x with Expr.ElemRef _ -> STA | _ -> STI] + (* (match x with + * | Expr.Ref x -> add_code (compile_expr lassn env e) lassn false [ST x] + * | _ -> add_code (compile_list lassn env [x; e]) lassn false [match x with Expr.ElemRef _ -> STA | _ -> STI]) *) | Expr.Skip -> env, false, []