From eaa0481f4083d57d544da5751673ae36ff395541 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Sun, 27 Dec 2015 23:16:58 -0500 Subject: [PATCH] Added Cyc-minor-gc --- include/cyclone/runtime.h | 2 ++ runtime.c | 15 +++++++++++++-- scheme/cyclone/cgen.sld | 8 ++++++-- scheme/cyclone/transforms.sld | 2 ++ scheme/eval.sld | 1 + 5 files changed, 24 insertions(+), 4 deletions(-) diff --git a/include/cyclone/runtime.h b/include/cyclone/runtime.h index 2e92bdf4..ae602353 100644 --- a/include/cyclone/runtime.h +++ b/include/cyclone/runtime.h @@ -192,6 +192,7 @@ void Cyc_end_thread(gc_thread_data *thd); void Cyc_exit_thread(gc_thread_data *thd); object Cyc_thread_sleep(void *data, object timeout); void GC(void *,closure,object*,int); +object Cyc_trigger_minor_gc(void *data, object cont); void Cyc_st_add(void *data, char *frame); void Cyc_st_print(void *data, FILE *out); @@ -231,6 +232,7 @@ extern const object primitive_Cyc_91has_91cycle_127; extern const object primitive_Cyc_91spawn_91thread_67; extern const object primitive_Cyc_91end_91thread_67; extern const object primitive_thread_91sleep_67; +extern const object primitive_Cyc_91minor_91gc; extern const object primitive__87; extern const object primitive__91; extern const object primitive__85; diff --git a/runtime.c b/runtime.c index 4c75f091..241cec09 100644 --- a/runtime.c +++ b/runtime.c @@ -1730,6 +1730,8 @@ void _Cyc_91end_91thread_67(void *data, object cont, object args) { void _thread_91sleep_67(void *data, object cont, object args) { Cyc_check_num_args(data, "thread-sleep!", 1, args); return_closcall1(data, cont, Cyc_thread_sleep(data, car(args))); } +void _Cyc_91minor_91gc_primitive(void *data, object cont, object args){ + Cyc_trigger_minor_gc(data, cont); } void __87(void *data, object cont, object args) { integer_type argc = Cyc_length(data, args); dispatch(data, argc.value, (function_type)dispatch_sum, cont, cont, args); } @@ -2265,6 +2267,13 @@ char *gc_move(char *obj, gc_thread_data *thd, int *alloci, int *heap_grown) { } \ } +object Cyc_trigger_minor_gc(void *data, object cont) { + gc_thread_data* thd = (gc_thread_data *)data; + thd->gc_args = boolean_t; + GC(data, cont, thd->gc_args, 1); + return nil; +} + // Do a minor GC int gc_minor(void *data, object low_limit, object high_limit, closure cont, object *args, int num_args) { @@ -2399,9 +2408,9 @@ void GC(void *data, closure cont, object *args, int num_args) int alloci = gc_minor(data, low_limit, high_limit, cont, args, num_args); // Cooperate with the collector thread gc_mut_cooperate((gc_thread_data *)data, alloci); -#if GC_DEBUG_TRACE +//#if GC_DEBUG_TRACE fprintf(stderr, "done with minor GC\n"); -#endif +//#endif // Let it all go, Neo... longjmp(*(((gc_thread_data *)data)->jmp_start), 1); } @@ -2537,6 +2546,7 @@ static primitive_type Cyc_91has_91cycle_127_primitive = {{0}, primitive_tag, "Cy static primitive_type Cyc_91spawn_91thread_67_primitive = {{0}, primitive_tag, "Cyc-spawn-thread!", &_Cyc_91spawn_91thread_67}; static primitive_type Cyc_91end_91thread_67_primitive = {{0}, primitive_tag, "Cyc-end-thread!", &_Cyc_91end_91thread_67}; static primitive_type thread_91sleep_67_primitive = {{0}, primitive_tag, "thread-sleep!", &_thread_91sleep_67}; +static primitive_type Cyc_91minor_91gc_primitive = {{0}, primitive_tag, "Cyc-minor-gc", &_Cyc_91minor_91gc_primitive}; static primitive_type _87_primitive = {{0}, primitive_tag, "+", &__87}; static primitive_type _91_primitive = {{0}, primitive_tag, "-", &__91}; static primitive_type _85_primitive = {{0}, primitive_tag, "*", &__85}; @@ -2657,6 +2667,7 @@ const object primitive_Cyc_91has_91cycle_127 = &Cyc_91has_91cycle_127_primitive; const object primitive_Cyc_91spawn_91thread_67 = &Cyc_91spawn_91thread_67_primitive; const object primitive_Cyc_91end_91thread_67 = &Cyc_91end_91thread_67_primitive; const object primitive_thread_91sleep_67 = &thread_91sleep_67_primitive; +const object primitive_Cyc_91minor_91gc = &Cyc_91minor_91gc_primitive; const object primitive__87 = &_87_primitive; const object primitive__91 = &_91_primitive; const object primitive__85 = &_85_primitive; diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index 1e856fbc..c700f468 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -535,6 +535,7 @@ ((eq? p 'substring) "Cyc_substring") ((eq? p 'Cyc-installation-dir) "Cyc_installation_dir") ((eq? p 'command-line-arguments) "Cyc_command_line_arguments") + ((eq? p 'Cyc-minor-gc) "Cyc_trigger_minor_gc") ((eq? p 'system) "Cyc_system") ((eq? p 'assq) "assq") ((eq? p 'assv) "assq") @@ -617,6 +618,7 @@ substring Cyc-installation-dir command-line-arguments + Cyc-minor-gc assq assv assoc @@ -655,6 +657,7 @@ ((eq? p 'read-char) "object") ((eq? p 'peek-char) "object") ((eq? p 'command-line-arguments) "object") + ((eq? p 'Cyc-minor-gc) "object") ((eq? p 'number->string) "object") ((eq? p 'symbol->string) "object") ((eq? p 'substring) "object") @@ -683,6 +686,7 @@ string-length substring + - * / apply command-line-arguments + Cyc-minor-gc Cyc-read-line read-char peek-char cons length vector-length cell)))) @@ -690,7 +694,7 @@ ;; Pass continuation as the function's first parameter? (define (prim:cont? exp) (and (prim? exp) - (member exp '(Cyc-read-line apply command-line-arguments number->string + (member exp '(Cyc-read-line apply command-line-arguments Cyc-minor-gc number->string read-char peek-char symbol->string list->string substring string-append make-vector list->vector Cyc-installation-dir)))) @@ -698,7 +702,7 @@ ;; Primitive functions that pass a continuation but have no other arguments (define (prim:cont/no-args? exp) (and (prim? exp) - (member exp '(command-line-arguments)))) + (member exp '(command-line-arguments Cyc-minor-gc)))) ;; Pass an integer arg count as the function's first parameter? (define (prim:arg-count? exp) diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld index 290630e3..d8219d7c 100644 --- a/scheme/cyclone/transforms.sld +++ b/scheme/cyclone/transforms.sld @@ -454,6 +454,7 @@ Cyc-spawn-thread! Cyc-end-thread! thread-sleep! + Cyc-minor-gc Cyc-stdout Cyc-stdin Cyc-stderr @@ -560,6 +561,7 @@ Cyc-spawn-thread! Cyc-end-thread! thread-sleep! + Cyc-minor-gc apply %halt exit diff --git a/scheme/eval.sld b/scheme/eval.sld index 2171b490..9c3f64e3 100644 --- a/scheme/eval.sld +++ b/scheme/eval.sld @@ -156,6 +156,7 @@ (list 'Cyc-installation-dir Cyc-installation-dir) (list 'system system) (list 'command-line-arguments command-line-arguments) + (list 'Cyc-minor-gc Cyc-minor-gc) (list 'error error) (list 'cons cons) (list 'cell-get cell-get)