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)
$(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)

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

239
runtime/runtime.c
View file

@ -9,19 +9,39 @@
# include <assert.h>
// # 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);
}

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)]
| 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, []