st/lama_byterun
1
0
Fork 0
mirror of https://github.com/ProgramSnail/Lama.git synced 2025-12-06 06:48:48 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Merge pull request #1 from dboulytchev/forGCFix

Browse source 
GC fix
This commit is contained in:
Dmitry Boulytchev 2019-04-24 17:45:14 +03:00 • committed by GitHub
commit b100346911
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
7 changed files with 197 additions and 76 deletions
Download patch file Download diff file Expand all files Collapse all files

22
doc/lectures.out Executable file
View file

@ -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

BIN
doc/lectures.pdf Executable file
View file

Binary file not shown.

2
regression/x86only/Makefile
View file

@ -7,7 +7,7 @@ RC=../../src/rc.opt
check: $(TESTS) check: $(TESTS)
$(TESTS): %: %.expr $(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: clean:
rm -f test*.log *.s *~ $(TESTS) rm -f test*.log *.s *~ $(TESTS)

BIN
regression/x86only/vgcore.3910 Normal file
View file

Binary file not shown.

2
runtime/gc_runtime.s
View file

@ -15,7 +15,7 @@ __gc_stack_top: .long 0
.extern gc_test_and_copy_root .extern gc_test_and_copy_root
.text .text
L__gc_init: movl %esp, __gc_stack_bottom L__gc_init: movl %ebp, __gc_stack_bottom
addl $4, __gc_stack_bottom addl $4, __gc_stack_bottom
call init_pool call init_pool
ret ret

239
runtime/runtime.c
View file

@ -9,19 +9,39 @@
# include <assert.h> # include <assert.h>
// # define DEBUG_PRINT 1 // # 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 STRING_TAG 0x00000001
# define ARRAY_TAG 0x00000003 # define ARRAY_TAG 0x00000003
# define SEXP_TAG 0x00000005 # define SEXP_TAG 0x00000005
# define LEN(x) ((x & 0xFFFFFFF8) >> 3) # 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_DATA(x) ((data*)((char*)(x)-sizeof(int)))
# define TO_SEXP(x) ((sexp*)((char*)(x)-2*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 UNBOXED(x) (((int) (x)) & 0x0001)
# define UNBOX(x) (((int) (x)) >> 1) # define UNBOX(x) (((int) (x)) >> 1)
# define BOX(x) ((((int) (x)) << 1) | 0x0001) # define BOX(x) ((((int) (x)) << 1) | 0x0001)
typedef struct { typedef struct {
@ -37,7 +57,7 @@ typedef struct {
extern void* alloc (size_t); extern void* alloc (size_t);
extern int Blength (void *p) { extern int Blength (void *p) {
data *a = (char*) BOX (NULL); data *a = (data*) BOX (NULL);
a = TO_DATA(p); a = TO_DATA(p);
return BOX(LEN(a->tag)); return BOX(LEN(a->tag));
} }
@ -45,19 +65,19 @@ extern int Blength (void *p) {
char* de_hash (int n) { char* de_hash (int n) {
static char *chars = (char*) BOX (NULL); static char *chars = (char*) BOX (NULL);
static char buf[6] = {0,0,0,0,0,0}; static char buf[6] = {0,0,0,0,0,0};
char *p = (char*) BOX (NULL); char *p = (char *) BOX (NULL);
chars = "_abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNJPQRSTUVWXYZ"; chars = "_abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNJPQRSTUVWXYZ";
p = &buf[5]; p = &buf[5];
#ifdef DEBUG_PRINT #ifdef DEBUG_PRINT
printf ("de_hash: tag: %d\n", n); printf ("de_hash: tag: %d\n", n); fflush (stdout);
#endif #endif
*p-- = 0; *p-- = 0;
while (n != 0) { while (n != 0) {
#ifdef DEBUG_PRINT #ifdef DEBUG_PRINT
printf ("char: %c\n", chars [n & 0x003F]); printf ("char: %c\n", chars [n & 0x003F]); fflush (stdout);
#endif #endif
*p-- = chars [n & 0x003F]; *p-- = chars [n & 0x003F];
n = n >> 6; n = n >> 6;
@ -135,7 +155,11 @@ static void printValue (void *p) {
break; break;
case SEXP_TAG: { case SEXP_TAG: {
#ifndef DEBUG_PRINT
char * tag = de_hash (TO_SEXP(p)->tag); 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) { if (strcmp (tag, "cons") == 0) {
data *b = a; data *b = a;
@ -167,7 +191,7 @@ static void printValue (void *p) {
} }
} }
break; break;
default: default:
printStringBuf ("*** invalid tag: %x ***", TAG(a->tag)); printStringBuf ("*** invalid tag: %x ***", TAG(a->tag));
} }
@ -204,7 +228,7 @@ extern void* Bstring (void *p) {
} }
extern void* Bstringval (void *p) { extern void* Bstringval (void *p) {
void *s = BOX(NULL); void *s = (void *) BOX (NULL);
__pre_gc () ; __pre_gc () ;
@ -229,8 +253,7 @@ extern void* Barray (int n, ...) {
__pre_gc (); __pre_gc ();
#ifdef DEBUG_PRINT #ifdef DEBUG_PRINT
printf ("Barray: create n = %d\n", n); printf ("Barray: create n = %d\n", n); fflush(stdout);
fflush(stdout);
#endif #endif
r = (data*) alloc (sizeof(int) * (n+1)); r = (data*) alloc (sizeof(int) * (n+1));
@ -256,12 +279,12 @@ extern void* Bsexp (int n, ...) {
int ai = BOX(0); int ai = BOX(0);
size_t * p = NULL; size_t * p = NULL;
sexp *r = (sexp*) BOX (NULL); sexp *r = (sexp*) BOX (NULL);
data *d = (sexp*) BOX (NULL); data *d = (data *) BOX (NULL);
__pre_gc () ; __pre_gc () ;
#ifdef DEBUG_PRINT #ifdef DEBUG_PRINT
printf("Bsexp: allocate %zu!\n",sizeof(int) * (n+1)); printf("Bsexp: allocate %zu!\n",sizeof(int) * (n+1)); fflush (stdout);
#endif #endif
r = (sexp*) alloc (sizeof(int) * (n+1)); r = (sexp*) alloc (sizeof(int) * (n+1));
d = &(r->contents); d = &(r->contents);
@ -279,6 +302,11 @@ extern void* Bsexp (int n, ...) {
} }
r->tag = va_arg(args, int); r->tag = va_arg(args, int);
#ifdef DEBUG_PRINT
r->tag = SEXP_TAG | ((r->tag) << 3);
#endif
va_end(args); va_end(args);
__post_gc(); __post_gc();
@ -287,9 +315,14 @@ extern void* Bsexp (int n, ...) {
} }
extern int Btag (void *d, int t, 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); r = TO_DATA(d);
#ifndef DEBUG_PRINT
return BOX(TAG(r->tag) == SEXP_TAG && TO_SEXP(d)->tag == t && LEN(r->tag) == n); 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) { 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 const size_t __gc_data_end, __gc_data_start;
extern void L__gc_init (); extern void L__gc_init ();
extern void __pre_gc ();
extern void __post_gc ();
extern void __gc_root_scan_stack (); 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 = 128;
// static size_t SPACE_SIZE = 1280;
# define POOL_SIZE (2*SPACE_SIZE) # 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) { static void swap (size_t ** a, size_t ** b) {
size_t * t = *a; size_t * t = *a;
*a = *b; *a = *b;
@ -484,7 +504,7 @@ static void copy_elements (size_t *where, size_t *from, int len) {
p = gc_copy ((size_t*) elem); p = gc_copy ((size_t*) elem);
*where = p; *where = p;
#ifdef DEBUG_PRINT #ifdef DEBUG_PRINT
printf ("copy_elements: fix %x: %x\n", from, *where); printf ("copy_elements: fix %p: %p\n", from, *where); fflush (stdout);
#endif #endif
where ++; where ++;
} }
@ -492,19 +512,23 @@ static void copy_elements (size_t *where, size_t *from, int len) {
} }
static void extend_spaces (void) { static void extend_spaces (void) {
void *p1 = mremap(from_space.begin, SPACE_SIZE, 2*SPACE_SIZE, 0); void *p1 = (void *) BOX (NULL), *p2 = (void *) BOX (NULL);
void *p2 = mremap(to_space.begin , SPACE_SIZE, 2*SPACE_SIZE, 0); size_t old_space_size = SPACE_SIZE * sizeof(size_t),
if (p1 == MAP_FAILED || p2 == MAP_FAILED) { new_space_size = (SPACE_SIZE << 1) * sizeof(size_t);
perror("ERROR: extend_spaces: mmap failed\n"); 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); exit (1);
} }
#ifdef DEBUG_PRINT #ifdef DEBUG_PRINT
printf ("extend: %x %x %x %x\n", p1, p2, from_space.begin, to_space.begin); printf ("extend: %p %p %p %p\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\n" , from_space.end, to_space.end, current);
fflush (stdout);
#endif #endif
from_space.end += SPACE_SIZE; from_space.end += SPACE_SIZE;
to_space.end += SPACE_SIZE; to_space.end += SPACE_SIZE;
SPACE_SIZE += SPACE_SIZE; SPACE_SIZE = SPACE_SIZE << 1;
from_space.size = SPACE_SIZE; from_space.size = SPACE_SIZE;
to_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; int len1, len2, len3;
void * objj; void * objj;
void * newobjj = (void*)current; 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 #endif
if (!IS_VALID_HEAP_POINTER(obj)) { if (!IS_VALID_HEAP_POINTER(obj)) {
#ifdef DEBUG_PRINT #ifdef DEBUG_PRINT
printf ("gc_copy: invalid ptr: %x\n", obj); printf ("gc_copy: invalid ptr: %p\n", obj); fflush (stdout);
#endif #endif
return obj; return obj;
} }
if (!IN_PASSIVE_SPACE(current) && current != to_space.end) { if (!IN_PASSIVE_SPACE(current) && current != to_space.end) {
#ifdef DEBUG_PRINT #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); fflush(stdout);
#endif #endif
perror("ERROR: gc_copy: out-of-space\n"); 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)) { if (IS_FORWARD_PTR(d->tag)) {
#ifdef DEBUG_PRINT #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); fflush(stdout);
#endif #endif
return (size_t *) d->tag; return (size_t *) d->tag;
@ -552,8 +577,7 @@ extern size_t * gc_copy (size_t *obj) {
switch (TAG(d->tag)) { switch (TAG(d->tag)) {
case ARRAY_TAG: case ARRAY_TAG:
#ifdef DEBUG_PRINT #ifdef DEBUG_PRINT
printf ("gc_copy:array_tag; len = %zu\n", LEN(d->tag)); printf ("gc_copy:array_tag; len = %zu\n", LEN(d->tag)); fflush (stdout);
fflush(stdout);
#endif #endif
current += (LEN(d->tag) + 1) * sizeof (int); current += (LEN(d->tag) + 1) * sizeof (int);
*copy = d->tag; *copy = d->tag;
@ -565,8 +589,7 @@ extern size_t * gc_copy (size_t *obj) {
case STRING_TAG: case STRING_TAG:
#ifdef DEBUG_PRINT #ifdef DEBUG_PRINT
printf ("gc_copy:string_tag; len = %d\n", LEN(d->tag) + 1); printf ("gc_copy:string_tag; len = %d\n", LEN(d->tag) + 1); fflush (stdout);
fflush(stdout);
#endif #endif
current += LEN(d->tag) * sizeof(char) + sizeof (int); current += LEN(d->tag) * sizeof(char) + sizeof (int);
*copy = d->tag; *copy = d->tag;
@ -582,7 +605,8 @@ extern size_t * gc_copy (size_t *obj) {
len1 = LEN(s->contents.tag); len1 = LEN(s->contents.tag);
len2 = LEN(s->tag); len2 = LEN(s->tag);
len3 = LEN(d->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 #endif
current += (LEN(s->contents.tag) + 2) * sizeof (int); current += (LEN(s->contents.tag) + 2) * sizeof (int);
*copy = s->tag; *copy = s->tag;
@ -596,15 +620,14 @@ extern size_t * gc_copy (size_t *obj) {
default: default:
#ifdef DEBUG_PRINT #ifdef DEBUG_PRINT
printf ("ERROR: gc_copy: weird tag: %x", TAG(d->tag)); printf ("ERROR: gc_copy: weird tag: %p", TAG(d->tag)); fflush (stdout);
fflush(stdout);
#endif #endif
perror ("ERROR: gc_copy: weird tag"); perror ("ERROR: gc_copy: weird tag");
exit (1); exit (1);
} }
#ifdef DEBUG_PRINT #ifdef DEBUG_PRINT
printf("gc_copy: %x (%x) -> %x (%x); new-current = %x\n", obj, objj, copy, newobjj, current); printf ("gc_copy: %p(%p) -> %p (%p); new-current = %p\n", obj, objj, copy, newobjj, current);
fflush(stdout); fflush (stdout);
#endif #endif
return copy; return copy;
} }
@ -612,7 +635,7 @@ extern size_t * gc_copy (size_t *obj) {
extern void gc_test_and_copy_root (size_t ** root) { extern void gc_test_and_copy_root (size_t ** root) {
if (IS_VALID_HEAP_POINTER(*root)) { if (IS_VALID_HEAP_POINTER(*root)) {
#ifdef DEBUG_PRINT #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 #endif
*root = gc_copy (*root); *root = gc_copy (*root);
} }
@ -627,14 +650,14 @@ extern void gc_root_scan_data (void) {
} }
extern void init_pool (void) { extern void init_pool (void) {
from_space.begin = mmap(NULL, SPACE_SIZE, PROT_READ | PROT_WRITE, size_t space_size = SPACE_SIZE * sizeof(size_t);
MAP_PRIVATE | MAP_ANONYMOUS | MAP_32BIT, -1, 0); from_space.begin = mmap (NULL, space_size, PROT_READ | PROT_WRITE,
to_space.begin = mmap(NULL, SPACE_SIZE, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANONYMOUS | MAP_32BIT, -1, 0);
MAP_PRIVATE | MAP_ANONYMOUS | MAP_32BIT, -1, 0); to_space.begin = mmap (NULL, space_size, PROT_READ | PROT_WRITE,
if (to_space.begin == MAP_FAILED || MAP_PRIVATE | MAP_ANONYMOUS | MAP_32BIT, -1, 0);
from_space.begin == MAP_FAILED) { if (to_space.begin == MAP_FAILED || from_space.begin == MAP_FAILED) {
perror("ERROR: init_pool: mmap failed\n"); perror ("EROOR: init_pool: mmap failed\n");
exit (1); exit (1);
} }
from_space.current = from_space.begin; from_space.current = from_space.begin;
from_space.end = from_space.begin + SPACE_SIZE; from_space.end = from_space.begin + SPACE_SIZE;
@ -651,26 +674,29 @@ static int free_pool (pool * p) {
static void * gc (size_t size) { static void * gc (size_t size) {
current = to_space.begin; current = to_space.begin;
#ifdef DEBUG_PRINT #ifdef DEBUG_PRINT
printf("\ngc: current: %x; to_space.b = %x; to_space.e = %x; f_space.b = %x; f_space.e = %x\n", 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); current, to_space.begin, to_space.end, from_space.begin, from_space.end);
fflush (stdout);
#endif #endif
gc_root_scan_data (); gc_root_scan_data ();
#ifdef DEBUG_PRINT #ifdef DEBUG_PRINT
printf("gc: data is scanned\n"); printf ("gc: data is scanned\n"); fflush (stdout);
#endif #endif
__gc_root_scan_stack (); __gc_root_scan_stack ();
if (!IN_PASSIVE_SPACE(current)) { if (!IN_PASSIVE_SPACE(current)) {
perror ("ASSERT: !IN_PASSIVE_SPACE(current)\n"); perror ("ASSERT: !IN_PASSIVE_SPACE(current)\n");
exit (1); exit (1);
} }
while (current + size >= to_space.end) { while (current + size >= to_space.end) {
#ifdef DEBUG_PRINT #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 #endif
extend_spaces (); extend_spaces ();
#ifdef DEBUG_PRINT #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 #endif
} }
assert (IN_PASSIVE_SPACE(current)); assert (IN_PASSIVE_SPACE(current));
@ -679,27 +705,100 @@ static void * gc (size_t size) {
gc_swap_spaces (); gc_swap_spaces ();
from_space.current = current + size; from_space.current = current + size;
#ifdef DEBUG_PRINT #ifdef DEBUG_PRINT
printf ("gc: end: (allocate!) return %x; from_space.current %x; from_space.end \n\n", printf ("gc: end: (allocate!) return %p; from_space.current %p; from_space.end %p \n\n",
current, from_space.current, from_space.end); current, from_space.current, from_space.end);
fflush (stdout);
#endif #endif
return (void *) current; 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) { extern void * alloc (size_t size) {
void * p = (void*)BOX(NULL); void * p = (void*)BOX(NULL);
if (from_space.current + size < from_space.end) { if (from_space.current + size < from_space.end) {
#ifdef DEBUG_PRINT #ifdef DEBUG_PRINT
printf("alloc: current: %x %zu", from_space.current, size); printf ("alloc: current: %p %zu", from_space.current, size); fflush (stdout);
#endif #endif
p = (void*) from_space.current; p = (void*) from_space.current;
from_space.current += size; from_space.current += size;
#ifdef DEBUG_PRINT #ifdef DEBUG_PRINT
printf(";new current: %x \n", from_space.current); printf (";new current: %p \n", from_space.current); fflush (stdout);
#endif #endif
return p; return p;
} }
#ifdef DEBUG_PRINT #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 #endif
return gc (size); return gc (size);
} }

8
src/SM.ml
View file

@ -263,10 +263,10 @@ let compile (defs, p) =
add_code (compile_expr lsv env e) lsv false [CALL (".stringval", 1)] add_code (compile_expr lsv env e) lsv false [CALL (".stringval", 1)]
| Expr.Assign (x, e) -> let lassn, env = env#get_label in | Expr.Assign (x, e) -> let lassn, env = env#get_label in
(*(match x with add_code (compile_list lassn env [x; e]) lassn false [match x with Expr.ElemRef _ -> STA | _ -> STI]
| Expr.Ref x -> add_code (compile_expr lassn env e) lassn false [ST x] (* (match x with
| _ ->*) add_code (compile_list lassn env [x; e]) lassn false [match x with Expr.ElemRef _ -> STA | _ -> STI] * | 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, [] | Expr.Skip -> env, false, []