From a84c8b9339c9f8026cd9bc3987bec0d528d64702 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 3 Nov 2015 23:04:13 -0500 Subject: [PATCH] WIP --- Makefile | 9 ++--- include/cyclone/runtime-main.h | 6 ++-- scheme/cyclone/cgen.sld | 62 +++++++++++++++++++--------------- 3 files changed, 43 insertions(+), 34 deletions(-) diff --git a/Makefile b/Makefile index abafa8ca..6ca4e7fb 100644 --- a/Makefile +++ b/Makefile @@ -150,8 +150,9 @@ sld: .PHONY: debug debug: - cyclone scheme/cyclone/macros.sld && sudo cp scheme/cyclone/macros.c /usr/local/share/cyclone/scheme/cyclone/ && sudo cp scheme/cyclone/macros.sld /usr/local/share/cyclone/scheme/cyclone/ && sudo cp scheme/cyclone/macros.o /usr/local/share/cyclone/scheme/cyclone/ && \ - cyclone scheme/cyclone/util.sld && sudo cp scheme/cyclone/util.c /usr/local/share/cyclone/scheme/cyclone/ && sudo cp scheme/cyclone/util.sld /usr/local/share/cyclone/scheme/cyclone/ && sudo cp scheme/cyclone/util.o /usr/local/share/cyclone/scheme/cyclone/ && \ - cyclone scheme/cyclone/transforms.sld && sudo cp scheme/cyclone/transforms.c /usr/local/share/cyclone/scheme/cyclone/ && sudo cp scheme/cyclone/transforms.sld /usr/local/share/cyclone/scheme/cyclone/ && sudo cp scheme/cyclone/transforms.o /usr/local/share/cyclone/scheme/cyclone/ && \ - cyclone -t cyclone.scm && cyclone -t icyc.scm && sudo make install-bin + cyclone scheme/cyclone/cgen.sld && sudo cp scheme/cyclone/cgen.* /usr/local/share/cyclone/scheme/cyclone/ && cyclone cyclone.scm && sudo make install-includes && sudo make install-libs && ./cyclone generate-c.scm +### cyclone scheme/cyclone/macros.sld && sudo cp scheme/cyclone/macros.c /usr/local/share/cyclone/scheme/cyclone/ && sudo cp scheme/cyclone/macros.sld /usr/local/share/cyclone/scheme/cyclone/ && sudo cp scheme/cyclone/macros.o /usr/local/share/cyclone/scheme/cyclone/ && \ +### cyclone scheme/cyclone/util.sld && sudo cp scheme/cyclone/util.c /usr/local/share/cyclone/scheme/cyclone/ && sudo cp scheme/cyclone/util.sld /usr/local/share/cyclone/scheme/cyclone/ && sudo cp scheme/cyclone/util.o /usr/local/share/cyclone/scheme/cyclone/ && \ +### cyclone scheme/cyclone/transforms.sld && sudo cp scheme/cyclone/transforms.c /usr/local/share/cyclone/scheme/cyclone/ && sudo cp scheme/cyclone/transforms.sld /usr/local/share/cyclone/scheme/cyclone/ && sudo cp scheme/cyclone/transforms.o /usr/local/share/cyclone/scheme/cyclone/ && \ +### cyclone -t cyclone.scm && cyclone -t icyc.scm && sudo make install-bin diff --git a/include/cyclone/runtime-main.h b/include/cyclone/runtime-main.h index 13e58601..e189f067 100644 --- a/include/cyclone/runtime-main.h +++ b/include/cyclone/runtime-main.h @@ -14,7 +14,7 @@ long global_stack_size = 0; long global_heap_size = 0; -static void c_entry_pt(int,closure,closure); +static void c_entry_pt(void *,int,closure,closure); static void Cyc_main(long stack_size,long heap_size,char *stack_base); static void Cyc_main (stack_size,heap_size,stack_base) @@ -87,9 +87,9 @@ static void Cyc_main (stack_size,heap_size,stack_base) // JAE - note for the general case, setjmp will return the data pointer's addy if (type_of(gc_cont) == cons_tag || prim(gc_cont)) { - Cyc_apply_from_buf(gc_num_ans, gc_cont, gc_ans); + Cyc_apply_from_buf(Cyc_thread, gc_num_ans, gc_cont, gc_ans); } else { - do_dispatch(gc_num_ans, ((closure)gc_cont)->fn, gc_cont, gc_ans); + do_dispatch(Cyc_thread, gc_num_ans, ((closure)gc_cont)->fn, gc_cont, gc_ans); } printf("Internal error: should never have reached this line\n"); exit(0);}} diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index 44c75577..65cfba86 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -110,12 +110,12 @@ (arry-assign (c-macro-array-assign num-args "buf" "a"))) (string-append "/* Check for GC, then call given continuation closure */\n" - "#define return_closcall" n "(cfn" args ") \\\n" + "#define return_closcall" n "(td,cfn" args ") \\\n" "{char stack; \\\n" " if (check_overflow(&stack,stack_limit1)) { \\\n" " object buf[" n "]; " arry-assign "\\\n" - " GC(cfn,buf," n "); return; \\\n" - " } else {closcall" n "((closure) (cfn)" args "); return;}}\n"))) + " GC(td,cfn,buf," n "); return; \\\n" + " } else {closcall" n "(td,(closure) (cfn)" args "); return;}}\n"))) (define (c-macro-return-direct num-args) (let ((args (c-macro-n-prefix num-args ",a")) @@ -123,13 +123,13 @@ (arry-assign (c-macro-array-assign num-args "buf" "a"))) (string-append "/* Check for GC, then call C function directly */\n" - "#define return_direct" n "(_fn" args ") { \\\n" + "#define return_direct" n "(td,_fn" args ") { \\\n" " char stack; \\\n" " if (check_overflow(&stack,stack_limit1)) { \\\n" " object buf[" n "]; " arry-assign " \\\n" " mclosure0(c1, _fn); \\\n" - " GC(&c1, buf, " n "); return; \\\n" - " } else { (_fn)(" n ",(closure)_fn" args "); }}\n"))) + " GC(td,&c1, buf, " n "); return; \\\n" + " } else { (_fn)(td," n ",(closure)_fn" args "); }}\n"))) (define (c-macro-closcall num-args) (let ((args (c-macro-n-prefix num-args ",a")) @@ -137,10 +137,10 @@ (n-1 (number->string (if (> num-args 0) (- num-args 1) 0))) (wrap (lambda (s) (if (> num-args 0) s "")))) (string-append - "#define closcall" n "(cfn" args ") " - (wrap (string-append "if (type_of(cfn) == cons_tag || prim(cfn)) { Cyc_apply(" n-1 ", (closure)a1, cfn" (if (> num-args 1) (substring args 3 (string-length args)) "") "); }")) + "#define closcall" n "(td,cfn" 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 " else { ") - "((cfn)->fn)(" n ",cfn" args ")" + "((cfn)->fn)(td," n ",cfn" args ")" (wrap ";}") ))) @@ -610,7 +610,7 @@ set-car! set-cdr! procedure? - set-cell!)) + set-cell!))) ;; Determine if primitive assigns (allocates) a C variable ;; EG: int v = prim(); @@ -713,6 +713,10 @@ "," cont "); ")) (else #f))) ;; END apply defs + (tdata (cond + ((prim/data-arg? p) "data ") + (else ""))) + (tdata-comma (if (> (string-length tdata) 0) "," "")) (c-var-assign (lambda (type) (let ((cv-name (mangle (gensym 'c)))) @@ -731,12 +735,16 @@ ;; Emit closure as first arg, if necessary (apply only) (cond (closure-def - (string-append "&" closure-sym + (string-append + tdata "," + "&" closure-sym (if (prim:cont-has-args? p) ", " ""))) ((prim:cont? p) - (string-append cont + (string-append + tdata "," + cont (if (prim:cont-has-args? p) ", " ""))) - (else ""))))))))) + (else tdata))))))))) (cond ((prim/c-var-assign p) (c-var-assign (prim/c-var-assign p))) @@ -753,9 +761,9 @@ cv-name ;; Already a pointer (string-append "&" cv-name)) ;; Point to data (list - (string-append c-func "(" cv-name))))) + (string-append c-func "(" cv-name tdata-comma tdata))))) (else - (c-code (string-append c-func "(")))))) + (c-code (string-append c-func "(" tdata tdata-comma)))))) ;; END primitives ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -812,7 +820,7 @@ (string-append (c:allocs->str (c:allocs cgen)) "return_direct" (number->string num-cargs) - "(" this-cont + "(data," this-cont (if (> num-cargs 0) "," "") ; TODO: how to propagate continuation - cont " " (c:body cgen) ");")))) @@ -864,7 +872,7 @@ (c:allocs->str (c:allocs cfun) "\n") (c:allocs->str (c:allocs cargs) "\n") "return_closcall" (number->string (c:num-args cargs)) - "(" + "(data," this-cont (if (> (c:num-args cargs) 0) "," "") (c:body cargs) @@ -883,7 +891,7 @@ (c:allocs->str (c:allocs cfun) "\n") (c:allocs->str (c:allocs cargs) "\n") "return_closcall" (number->string num-cargs) - "(" + "(data," this-cont (if (> num-cargs 0) "," "") (c:body cargs) @@ -1145,7 +1153,7 @@ (cons (lambda (name) (string-append "static void " name - "(int argc, " + "(void *data, int argc, " formals* ") {\n" preamble @@ -1231,7 +1239,7 @@ (lambda (l) (emit* "static void __lambda_" - (number->string (car l)) "(int argc, " + (number->string (car l)) "(void *data, int argc, " (cdadr l) ") ;")) lambdas) @@ -1247,14 +1255,14 @@ ; Emit entry point (cond (program? - (emit "static void c_entry_pt_first_lambda();") + (emit "static void c_entry_pt_first_lambda(void *data);") (for-each (lambda (lib-name) - (emit* "extern void c_" (lib:name->string lib-name) "_entry_pt(int argc, closure cont, object value);")) + (emit* "extern void c_" (lib:name->string lib-name) "_entry_pt(void *data, int argc, closure cont, object value);")) required-libs) - (emit "static void c_entry_pt(argc, env,cont) int argc; closure env,cont; { ")) + (emit "static void c_entry_pt(data, argc, env,cont) void *data; int argc; closure env,cont; { ")) (else - (emit* "void c_" (lib:name->string lib-name) "_entry_pt(argc, cont,value) int argc; closure cont; object value;{ ") + (emit* "void c_" (lib:name->string lib-name) "_entry_pt(data, argc, cont,value) void *data; int argc; closure cont; object value;{ ") ; DEBUG (emit (string-append "printf(\"init " (lib:name->string lib-name) "\\n\");")) )) @@ -1357,9 +1365,9 @@ (reverse required-libs)) ;; Init each lib's dependencies 1st (emit* ;; Start cont chain, but do not assume closcall1 macro was defined - "(" this-clo ".fn)(0, &" this-clo ", &" this-clo ");") + "(" this-clo ".fn)(data, 0, &" this-clo ", &" this-clo ");") (emit "}") - (emit "static void c_entry_pt_first_lambda(int argc, closure cont, object value) {") + (emit "static void c_entry_pt_first_lambda(void *data, int argc, closure cont, object value) {") ; DEBUG (emit (string-append "printf(\"init first lambda\\n\");")) (emit compiled-program))) (else @@ -1369,7 +1377,7 @@ (emit* "(((closure)" (mangle-global (lib:name->symbol lib-name)) - ")->fn)(1, cont, cont);") + ")->fn)(data, 1, cont, cont);") )) (emit "}")