Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-17 01:37:34 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Refactoring

Browse source
This commit is contained in:
Justin Ethier 2016-04-01 21:48:01 -04:00
parent 0da8dabc5a
commit a63f9a729e
4 changed files with 37 additions and 46 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
gc.c
View file

@ -752,8 +752,8 @@ int gc_is_stack_obj(gc_thread_data *thd, object obj)
char tmp; char tmp;
object low_limit = &tmp; object low_limit = &tmp;
object high_limit = thd->stack_start; object high_limit = thd->stack_start;
return (check_overflow(low_limit, obj) && return (stack_overflow(low_limit, obj) &&
check_overflow(obj, high_limit)); stack_overflow(obj, high_limit));
} }
/** /**
@ -1270,7 +1270,7 @@ void gc_thread_data_init(gc_thread_data *thd, int mut_num, char *stack_base, lon
#else #else
thd->stack_limit = stack_base + stack_size; thd->stack_limit = stack_base + stack_size;
#endif #endif
if (check_overflow(stack_base, &stack_ref)){ if (stack_overflow(stack_base, &stack_ref)){
fprintf(stderr, fprintf(stderr,
"Error: Stack is growing in the wrong direction! Rebuild with STACK_GROWTH_IS_DOWNWARD changed to %d\n", "Error: Stack is growing in the wrong direction! Rebuild with STACK_GROWTH_IS_DOWNWARD changed to %d\n",
(1 - STACK_GROWTH_IS_DOWNWARD)); (1 - STACK_GROWTH_IS_DOWNWARD));

17
include/cyclone/types.h
View file

@ -160,9 +160,9 @@ typedef long tag_type;
/* Determine if stack has overflowed */ /* Determine if stack has overflowed */
#if STACK_GROWTH_IS_DOWNWARD #if STACK_GROWTH_IS_DOWNWARD
#define check_overflow(x,y) ((x) < (y)) #define stack_overflow(x,y) ((x) < (y))
#else #else
#define check_overflow(x,y) ((x) > (y)) #define stack_overflow(x,y) ((x) > (y))
#endif #endif
/* Define object tag values. Could be an enum... /* Define object tag values. Could be an enum...
@ -207,7 +207,6 @@ typedef long tag_type;
* 0x10 - char * 0x10 - char
*/ */
// TODO: does this break negative numbers (IE, overwrite sign bit in 2's comp?)? may need a more sophisticated scheme to handle 31-bit numbers. also, ideally want to use 63 bits on a 64-bit system
#define obj_is_int(x) ((unsigned long)(x) & (unsigned long)1) #define obj_is_int(x) ((unsigned long)(x) & (unsigned long)1)
#define obj_obj2int(x) ((long)(x)>>1) #define obj_obj2int(x) ((long)(x)>>1)
#define obj_int2obj(c) ((void *)((((long)c)<<1) | 1)) #define obj_int2obj(c) ((void *)((((long)c)<<1) | 1))
@ -219,7 +218,7 @@ typedef long tag_type;
#define is_value_type(x) ((unsigned long)(x) & (unsigned long)3) #define is_value_type(x) ((unsigned long)(x) & (unsigned long)3)
#define is_object_type(x) (x && !is_value_type(x)) #define is_object_type(x) (x && !is_value_type(x))
/* Define function type. */ /* Function type */
typedef void (*function_type)(); typedef void (*function_type)();
typedef void (*function_type_va)(int, object, object, object, ...); typedef void (*function_type_va)(int, object, object, object, ...);
@ -305,7 +304,7 @@ typedef bytevector_type *bytevector;
#define make_empty_bytevector(v) bytevector_type v; v.hdr.mark = gc_color_red; v.hdr.grayed = 0; v.tag = bytevector_tag; v.len = 0; v.data = NULL; #define make_empty_bytevector(v) bytevector_type v; v.hdr.mark = gc_color_red; v.hdr.grayed = 0; v.tag = bytevector_tag; v.len = 0; v.data = NULL;
/* Define cons type. */ /* Pair (cons) type */
typedef struct {gc_header_type hdr; tag_type tag; object cons_car,cons_cdr;} cons_type; typedef struct {gc_header_type hdr; tag_type tag; object cons_car,cons_cdr;} cons_type;
typedef cons_type *list; typedef cons_type *list;
@ -362,14 +361,6 @@ typedef closure0_type *macro;
#define mclosure1(c,f,a) closure1_type c; c.hdr.mark = gc_color_red; c.hdr.grayed = 0; c.tag = closure1_tag; \ #define mclosure1(c,f,a) closure1_type c; c.hdr.mark = gc_color_red; c.hdr.grayed = 0; c.tag = closure1_tag; \
c.fn = f; c.num_args = -1; c.elt1 = a; c.fn = f; c.num_args = -1; c.elt1 = a;
#define mlist1(e1) (mcons(e1,nil))
#define mlist2(e2,e1) (mcons(e2,mlist1(e1)))
#define mlist3(e3,e2,e1) (mcons(e3,mlist2(e2,e1)))
#define mlist4(e4,e3,e2,e1) (mcons(e4,mlist3(e3,e2,e1)))
#define mlist5(e5,e4,e3,e2,e1) (mcons(e5,mlist4(e4,e3,e2,e1)))
#define mlist6(e6,e5,e4,e3,e2,e1) (mcons(e6,mlist5(e5,e4,e3,e2,e1)))
#define mlist7(e7,e6,e5,e4,e3,e2,e1) (mcons(e7,mlist6(e6,e5,e4,e3,e2,e1)))
#define make_cell(n,a) make_cons(n,a,nil); #define make_cell(n,a) make_cons(n,a,nil);
/* Primitive types */ /* Primitive types */

32
runtime.c
View file

@ -76,22 +76,22 @@ void Cyc_check_bounds(void *data, const char *label, int len, int index) {
/* END error checking */ /* END error checking */
/* These macros are hardcoded here to support functions in this module. */ /* These macros are hardcoded here to support functions in this module. */
#define closcall1(td,cfn,a1) if (type_of(cfn) == cons_tag || prim(cfn)) { Cyc_apply(td,0, (closure)(a1), cfn); } else { ((cfn)->fn)(td,1,cfn,a1);} #define closcall1(td,clo,a1) if (type_of(clo) == cons_tag || prim(clo)) { Cyc_apply(td,0, (closure)(a1), clo); } else { ((clo)->fn)(td,1,clo,a1);}
/* Return to continuation after checking for stack overflow. */ /* Return to continuation after checking for stack overflow. */
#define return_closcall1(td,cfn,a1) \ #define return_closcall1(td,clo,a1) \
{char stack; \ {char top; \
if (check_overflow(&stack,(((gc_thread_data *)data)->stack_limit))) { \ if (stack_overflow(&top,(((gc_thread_data *)data)->stack_limit))) { \
object buf[1]; buf[0] = a1;\ object buf[1]; buf[0] = a1;\
GC(td,cfn,buf,1); return; \ GC(td,clo,buf,1); return; \
} else {closcall1(td,(closure) (cfn),a1); return;}} } else {closcall1(td,(closure) (clo),a1); return;}}
#define closcall2(td,cfn,a1,a2) if (type_of(cfn) == cons_tag || prim(cfn)) { Cyc_apply(td,1, (closure)(a1), cfn,a2); } else { ((cfn)->fn)(td,2,cfn,a1,a2);} #define closcall2(td,clo,a1,a2) if (type_of(clo) == cons_tag || prim(clo)) { Cyc_apply(td,1, (closure)(a1), clo,a2); } else { ((clo)->fn)(td,2,clo,a1,a2);}
/* Return to continuation after checking for stack overflow. */ /* Return to continuation after checking for stack overflow. */
#define return_closcall2(td,cfn,a1,a2) \ #define return_closcall2(td,clo,a1,a2) \
{char stack; \ {char top; \
if (check_overflow(&stack,(((gc_thread_data *)data)->stack_limit))) { \ if (stack_overflow(&top,(((gc_thread_data *)data)->stack_limit))) { \
object buf[2]; buf[0] = a1;buf[1] = a2;\ object buf[2]; buf[0] = a1;buf[1] = a2;\
GC(td,cfn,buf,2); return; \ GC(td,clo,buf,2); return; \
} else {closcall2(td,(closure) (cfn),a1,a2); return;}} } else {closcall2(td,(closure) (clo),a1,a2); return;}}
/*END closcall section */ /*END closcall section */
/* Global variables. */ /* Global variables. */
@ -2680,8 +2680,8 @@ char *gc_move(char *obj, gc_thread_data *thd, int *alloci, int *heap_grown) {
#define gc_move2heap(obj) { \ #define gc_move2heap(obj) { \
temp = obj; \ temp = obj; \
if (check_overflow(low_limit, temp) && \ if (stack_overflow(low_limit, temp) && \
check_overflow(temp, high_limit)){ \ stack_overflow(temp, high_limit)){ \
(obj) = (object) gc_move(temp, (gc_thread_data *)data, &alloci, &heap_grown); \ (obj) = (object) gc_move(temp, (gc_thread_data *)data, &alloci, &heap_grown); \
} \ } \
} }
@ -3225,8 +3225,8 @@ object copy2heap(void *data, object obj)
{ {
char stack_pos; char stack_pos;
gc_thread_data *thd = (gc_thread_data *)data; gc_thread_data *thd = (gc_thread_data *)data;
int on_stack = check_overflow((object)(&stack_pos), obj) && int on_stack = stack_overflow((object)(&stack_pos), obj) &&
check_overflow(obj, (object)thd->stack_start); stack_overflow(obj, (object)thd->stack_start);
if (!is_object_type(obj) || !on_stack) { if (!is_object_type(obj) || !on_stack) {
return obj; return obj;
} }

28
scheme/cyclone/cgen.sld
View file

@ -122,26 +122,26 @@
(n (number->string num-args)) (n (number->string num-args))
(arry-assign (c-macro-array-assign num-args "buf" "a"))) (arry-assign (c-macro-array-assign num-args "buf" "a")))
(string-append (string-append
"/* Check for GC, then call given continuation closure */\n" ;"/* Check for GC, then call given continuation closure */\n"
"#define return_closcall" n "(td,cfn" args ") \\\n" "#define return_closcall" n "(td, clo" args ") \\\n"
"{char stack; \\\n" "{char top; \\\n"
" if (check_overflow(&stack,(((gc_thread_data *)data)->stack_limit))) { \\\n" " if (stack_overflow(&top, (((gc_thread_data *)data)->stack_limit))) { \\\n"
" object buf[" n "]; " arry-assign "\\\n" " object buf[" n "]; " arry-assign "\\\n"
" GC(td,cfn,buf," n "); return; \\\n" " GC(td,clo,buf," n "); return; \\\n"
" } else {closcall" n "(td,(closure) (cfn)" args "); return;}}\n"))) " } else {closcall" n "(td,(closure) (clo)" args "); return;}}\n")))
(define (c-macro-return-direct num-args) (define (c-macro-return-direct num-args)
(let ((args (c-macro-n-prefix num-args ",a")) (let ((args (c-macro-n-prefix num-args ",a"))
(n (number->string num-args)) (n (number->string num-args))
(arry-assign (c-macro-array-assign num-args "buf" "a"))) (arry-assign (c-macro-array-assign num-args "buf" "a")))
(string-append (string-append
"/* Check for GC, then call C function directly */\n" ;"/* Check for GC, then call C function directly */\n"
"#define return_direct" n "(td,_fn" args ") { \\\n" "#define return_direct" n "(td, _fn" args ") { \\\n"
" char stack; \\\n" " char top; \\\n"
" if (check_overflow(&stack,(((gc_thread_data *)data)->stack_limit))) { \\\n" " if (stack_overflow(&top, (((gc_thread_data *)data)->stack_limit))) { \\\n"
" object buf[" n "]; " arry-assign " \\\n" " object buf[" n "]; " arry-assign " \\\n"
" mclosure0(c1, _fn); \\\n" " mclosure0(c1, _fn); \\\n"
" GC(td,&c1, buf, " n "); return; \\\n" " GC(td, &c1, buf, " n "); return; \\\n"
" } else { (_fn)(td," n ",(closure)_fn" args "); }}\n"))) " } else { (_fn)(td," n ",(closure)_fn" args "); }}\n")))
(define (c-macro-closcall num-args) (define (c-macro-closcall num-args)
@ -150,10 +150,10 @@
(n-1 (number->string (if (> num-args 0) (- num-args 1) 0))) (n-1 (number->string (if (> num-args 0) (- num-args 1) 0)))
(wrap (lambda (s) (if (> num-args 0) s "")))) (wrap (lambda (s) (if (> num-args 0) s ""))))
(string-append (string-append
"#define closcall" n "(td,cfn" args ") " "#define closcall" n "(td,clo" args ") "
(wrap (string-append "if (type_of(cfn) == cons_tag || prim(cfn)) { Cyc_apply(td," n-1 ", (closure)(a1), cfn" (if (> num-args 1) (substring args 3 (string-length args)) "") "); }")) (wrap (string-append "if (type_of(clo) == cons_tag || prim(clo)) { Cyc_apply(td," n-1 ", (closure)(a1), clo" (if (> num-args 1) (substring args 3 (string-length args)) "") "); }"))
(wrap " else { ") (wrap " else { ")
"((cfn)->fn)(td," n ",cfn" args ")" "((clo)->fn)(td," n ",clo" args ")"
(wrap ";}") (wrap ";}")
))) )))