From 2afd1b48b7136c03b82fcc701b0a451ad8969308 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 20 Jan 2021 22:51:54 -0500 Subject: [PATCH 01/23] Use new signature for CPS prototypes --- scheme/cyclone/cgen.sld | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index 3fffa9a0..c9126e6e 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -2009,8 +2009,8 @@ (else (emit* "static void __lambda_" - (number->string (car l)) "(void *data, int argc, " - (cdadr l) + (number->string (car l)) + "(void *data, object clo, object k, int argc, object *args" ") ;")))) lambdas) From 23249133afb0be09e3ac52c00ee7ff2efdfa052f Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 21 Jan 2021 23:03:55 -0500 Subject: [PATCH 02/23] Added Cyc_check_argc macro to help w/new functions --- include/cyclone/runtime.h | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/include/cyclone/runtime.h b/include/cyclone/runtime.h index 20babd1c..f718d2c2 100644 --- a/include/cyclone/runtime.h +++ b/include/cyclone/runtime.h @@ -76,6 +76,15 @@ void gc_init_heap(long heap_size); } \ } +#define Cyc_check_argc(data, fnc_name, argc, expected) { \ + if (expected > argc) { \ + char buf[128]; \ + snprintf(buf, 127, "Expected %d arguments to %s but received %ld", \ + expected, fnc_name, argc); \ + Cyc_rt_raise_msg(data, buf); \ + } \ +} + #define Cyc_verify_mutable(data, obj) { \ if (immutable(obj)) Cyc_immutable_obj_error(data, obj); } #define Cyc_verify_immutable(data, obj) { \ From 6fc1966f7b91a940be765e4e72f49314dba3731a Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 21 Jan 2021 23:04:06 -0500 Subject: [PATCH 03/23] Issue #193 - WIP converting functions --- scheme/cyclone/cgen.sld | 28 +++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index c9126e6e..469a02cd 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -707,8 +707,10 @@ (string-append "\"" (cstr:escape-chars str) "\"")) (define-c string-byte-length - "(void *data, int argc, closure _, object k, object s)" - " return_closcall1(data, k, Cyc_string_byte_length(data, s)); ") + "(void *data, object clo, object k, int argc, object *args)" + " Cyc_check_argc(data, \"string-byte-length\", argc, 1); + object s = args[0]; + return_closcall1(data, k, Cyc_string_byte_length(data, s)); ") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Primitives @@ -2042,7 +2044,7 @@ (emit* "static void __lambda_gc_ret_" (number->string (car l)) - "(void *data, int argc," + "(void *data, int argc," TODO: update this and call below params-str ")" "{" @@ -2086,7 +2088,7 @@ ;; Emit inlinable function list (cond ((not program?) - (emit* "void c_" (lib:name->string lib-name) "_inlinable_lambdas(void *data, int argc, closure _, object cont){ ") + (emit* "void c_" (lib:name->string lib-name) "_inlinable_lambdas(void *data, object clo, object k, int argc, object *args){ ") (let ((pairs '()) (head-pair #f)) (for-each @@ -2120,22 +2122,23 @@ (cdr ps) (cdr cs))))) (if head-pair - (emit* "(((closure)cont)->fn)(data, 1, cont, &" head-pair ");") - (emit* "(((closure)cont)->fn)(data, 1, cont, NULL);")) + TODO: need to change these function calls over + also, go back and check our changes, I think there is at least one other direct closure call we need to update + (emit* "(((closure)k)->fn)(data, 1, k, &" head-pair ");") + (emit* "(((closure)k)->fn)(data, 1, k, NULL);")) (emit* " } ")))) ;; Emit entry point (cond (program? - (emit "static void c_entry_pt_first_lambda(void *data, int argc, closure cont, object value);") + (emit "static void c_entry_pt_first_lambda(void *data, object clo, object k, int argc, object *args);") (for-each (lambda (lib-name) - (emit* "extern void c_" (lib:name->string lib-name) "_entry_pt(void *data, int argc, closure cont, object value);")) + (emit* "extern void c_" (lib:name->string lib-name) "_entry_pt(void *data, object clo, object k, int argc, object* args);")) required-libs) - (emit "static void c_entry_pt(data, argc, env,cont) void *data; int argc; closure env,cont; { ")) + (emit "static void c_entry_pt(void *data, object clo, object k, int argc, object *args) { ")) (else - (emit* "void c_" (lib:name->string lib-name) "_entry_pt_first_lambda(data, argc, cont,value) void *data; int argc; closure cont; object value;{ ") - ;; DEBUG (emit (string-append "printf(\"init " (lib:name->string lib-name) "\\n\");")) + (emit* "void c_" (lib:name->string lib-name) "_entry_pt_first_lambda(void *data, object clo, object k, int argc, object *args){ ") )) ;; Set global-changed indicator @@ -2272,8 +2275,7 @@ ;; Start cont chain, but do not assume closcall1 macro was defined "(" this-clo ".fn)(data, 0, &" this-clo ", &" this-clo ");") (emit "}") - (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 "static void c_entry_pt_first_lambda(void *data, object clo, object k, int argc, object *args) {") (emit compiled-program) (emit ";"))) (else From 353791be99c55be5c75314a54d726a3b57dad0ff Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 29 Jan 2021 17:20:50 -0500 Subject: [PATCH 04/23] Update C-Calling-Conventions.md Added a note about FFI compatibility. --- docs/C-Calling-Conventions.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/C-Calling-Conventions.md b/docs/C-Calling-Conventions.md index 961da6dc..088ecaa2 100644 --- a/docs/C-Calling-Conventions.md +++ b/docs/C-Calling-Conventions.md @@ -151,7 +151,7 @@ TODO: Are there any complications in referencing vars from `args` rather than di ## Changes to the FFI -`define-c` needs to use the new signature. +`define-c` needs to use the new signature. **TBD if there is an efficient way to do this without also requiring a migration of existing `define-c` forms. It would be great if existing code would continue to work, thus not making this a breaking change. Perhaps the compiler can detect the old signature and generate scaffolding accordingly.** `(cyclone foreign)` will need to be modified to generate `define-c` forms that are compatible with the new signatures. From a650f41daf6aab08c59ccd97cddd226773423f73 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 1 Feb 2021 21:56:18 -0500 Subject: [PATCH 05/23] Not always an explicit continuation arg --- docs/C-Calling-Conventions.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/C-Calling-Conventions.md b/docs/C-Calling-Conventions.md index 961da6dc..38a50170 100644 --- a/docs/C-Calling-Conventions.md +++ b/docs/C-Calling-Conventions.md @@ -79,7 +79,7 @@ Note our `define-c` FFI requires the user to specify the same calling convention We want a signature similar to this: - static void __lambda(void *data, object closure, object k, int argc, object *args) ; + static void __lambda(void *data, object closure, int argc, object *args) ; That way we can pack all the extra arguments into `args` and call all functions using a single standard interface. From f624e68a33de8a8f9a14c385e4e85bb1e80a2b04 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 1 Feb 2021 23:02:08 -0500 Subject: [PATCH 06/23] WIP --- runtime.c | 3 +++ scheme/cyclone/cgen.sld | 32 ++++++++++++++++++-------------- 2 files changed, 21 insertions(+), 14 deletions(-) diff --git a/runtime.c b/runtime.c index 54711550..64e11133 100644 --- a/runtime.c +++ b/runtime.c @@ -5696,6 +5696,9 @@ object apply(void *data, object cont, object func, object args) } // Version of apply meant to be called from within compiled code +// TODO: in cargs branch we are swapping cont and prim below +// old call convention, EG: Cyc_apply(td, 0, (closure)(a1), clo); \ +// void Cyc_apply(void *data, int argc, closure cont, object prim, ...) { va_list ap; diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index 469a02cd..2be5230a 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -145,12 +145,12 @@ ;;"/* Check for GC, then call given continuation closure */\n" "#define return_closcall" n "(td, clo" args ") { \\\n" " char top; \\\n" + " object buf[" n "]; " arry-assign "\\\n" " if (stack_overflow(&top, (((gc_thread_data *)data)->stack_limit))) { \\\n" - " object buf[" n "]; " arry-assign "\\\n" " GC(td, clo, buf, " n "); \\\n" " return; \\\n" " } else {\\\n" - " closcall" n "(td, (closure) (clo)" args "); \\\n" + " closcall" n "(td, (closure) (clo), buf" " return;\\\n" " } \\\n" "}\n"))) @@ -233,12 +233,12 @@ (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 "(td, clo" args ") \\\n" + "#define closcall" n "(td, clo, buf) \\\n" (wrap (string-append "if (obj_is_not_closure(clo)) { \\\n" - " Cyc_apply(td, " n-1 ", (closure)(a1), clo" (if (> num-args 1) (substring args 3 (string-length args)) "") "); \\\n" + " Cyc_apply(td, clo, " n ", buf ); \\\n" "}")) (wrap " else { \\\n") - " ((clo)->fn)(td, " n ", clo" args ")" + " ((clo)->fn)(td, clo, " n ", buf)" (wrap ";\\\n}")))) (define (c-macro-n-prefix n prefix) @@ -707,10 +707,10 @@ (string-append "\"" (cstr:escape-chars str) "\"")) (define-c string-byte-length - "(void *data, object clo, object k, int argc, object *args)" - " Cyc_check_argc(data, \"string-byte-length\", argc, 1); - object s = args[0]; - return_closcall1(data, k, Cyc_string_byte_length(data, s)); ") + "(void *data, object clo, int argc, object *args)" + " Cyc_check_argc(data, \"string-byte-length\", argc, 2); + object s = args[1]; + return_closcall1(data, args[0], Cyc_string_byte_length(data, s)); ") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Primitives @@ -2100,7 +2100,7 @@ (set! pairs (cons pair-sym pairs)))) *global-inlines*) ;; Link the pairs - (let loop ((code '()) + (let loop ((code '()) (ps pairs) (cs (map (lambda (_) (mangle (gensym 'c))) pairs))) (cond @@ -2121,11 +2121,15 @@ (loop (cons (string-append "make_pair(" (car cs) ", &" (car ps) ", &" (cadr cs) ");\n") code) (cdr ps) (cdr cs))))) +TODO: (emit* "object buf[1];"); (if head-pair - TODO: need to change these function calls over - also, go back and check our changes, I think there is at least one other direct closure call we need to update - (emit* "(((closure)k)->fn)(data, 1, k, &" head-pair ");") - (emit* "(((closure)k)->fn)(data, 1, k, NULL);")) +;TODO: need to change these function calls over +;also, go back and check our changes, I think there is at least one other direct closure call we need to update +;; +;; TODO: yes, just search for all ->fn calls +;; + (emit* "(((closure)k)->fn)(data, k, 1, &" head-pair ");") + (emit* "(((closure)k)->fn)(data, k, 1, NULL);")) (emit* " } ")))) ;; Emit entry point From 12cda32850a1b961d9037099d246393721c75632 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 2 Feb 2021 15:55:14 -0500 Subject: [PATCH 07/23] Added a note about CPS conversion and continuation arguments --- docs/C-Calling-Conventions.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/C-Calling-Conventions.md b/docs/C-Calling-Conventions.md index 289afd1f..ec6577f2 100644 --- a/docs/C-Calling-Conventions.md +++ b/docs/C-Calling-Conventions.md @@ -58,7 +58,7 @@ Where: * `data` is state data for the current thread * `argc` indicates how many arguments were sent by the caller. Generally only applicable for variadic functions. * `closure` is the caller's closure. Note this is ignored for global functions as closures are never applicable to them. - * `k` is the continuation to call into next. + * `k` is the continuation to call into next. Note this is not necessarily present; it is often placed here as a result of the compiler's CPS conversion phase. In addition zero or more objects may be listed after that as well as an ellipsis `...` for variadic functions. For example: From ea85c89268a7767af79ba322ba279fd67565105f Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 2 Feb 2021 17:46:33 -0500 Subject: [PATCH 08/23] Use new calling conventions for macros --- scheme/cyclone/cgen.sld | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index 2be5230a..9ee476f5 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -150,7 +150,7 @@ " GC(td, clo, buf, " n "); \\\n" " return; \\\n" " } else {\\\n" - " closcall" n "(td, (closure) (clo), buf" + " closcall" n "(td, (closure) (clo), buf); \\\n" " return;\\\n" " } \\\n" "}\n"))) @@ -183,13 +183,13 @@ ;;"/* Check for GC, then call C function directly */\n" "#define return_direct" n "(td, _fn" args ") { \\\n" " char top; \\\n" + " object buf[" n "]; " arry-assign " \\\n" " if (stack_overflow(&top, (((gc_thread_data *)data)->stack_limit))) { \\\n" - " object buf[" n "]; " arry-assign " \\\n" " mclosure0(c1, (function_type) _fn); \\\n" " GC(td, &c1, buf, " n "); \\\n" " return; \\\n" " } else { \\\n" - " (_fn)(td, " n ", (closure)_fn" args "); \\\n" + " (_fn)(td, (closure)_fn, " n ", buf); \\\n" " }}\n"))) (define (c-macro-return-direct-with-closure num-args) @@ -200,12 +200,12 @@ ;;"/* Check for GC, then call C function directly */\n" "#define return_direct_with_clo" n "(td, clo, _fn" args ") { \\\n" " char top; \\\n" + " object buf[" n "]; " arry-assign "\\\n" " if (stack_overflow(&top, (((gc_thread_data *)data)->stack_limit))) { \\\n" - " object buf[" n "]; " arry-assign "\\\n" " GC(td, clo, buf, " n "); \\\n" " return; \\\n" " } else { \\\n" - " (_fn)(td, " n ", (closure)(clo)" args "); \\\n" + " (_fn)(td, (closure)(clo), " n ", buf); \\\n" " }}\n"))) ;; Generate hybrid macros that can call a function directly but also receives @@ -218,13 +218,13 @@ ;;"/* Check for GC, then call C function directly */\n" "#define return_direct_with_obj" n "(td, clo, _clo_fn, _fn" args ") { \\\n" " char top; \\\n" + " object buf[" n "]; " arry-assign "\\\n" " if (stack_overflow(&top, (((gc_thread_data *)data)->stack_limit))) { \\\n" - " object buf[" n "]; " arry-assign "\\\n" " mclosure1(c1, (function_type) _clo_fn, clo); \\\n" " GC(td, (closure)(&c1), buf, " n "); \\\n" " return; \\\n" " } else { \\\n" - " (_fn)(td, " n ", (closure)(clo)" args "); \\\n" + " (_fn)(td, (closure)(clo), " n ", buf); \\\n" " }}\n"))) (define (c-macro-closcall num-args) @@ -238,7 +238,7 @@ " Cyc_apply(td, clo, " n ", buf ); \\\n" "}")) (wrap " else { \\\n") - " ((clo)->fn)(td, clo, " n ", buf)" + " ((clo)->fn)(td, clo, " n ", buf); \\\n" (wrap ";\\\n}")))) (define (c-macro-n-prefix n prefix) @@ -2044,7 +2044,7 @@ (emit* "static void __lambda_gc_ret_" (number->string (car l)) - "(void *data, int argc," TODO: update this and call below + "(void *data, int argc," ; cargs TODO: update this and call below params-str ")" "{" @@ -2121,7 +2121,7 @@ (loop (cons (string-append "make_pair(" (car cs) ", &" (car ps) ", &" (cadr cs) ");\n") code) (cdr ps) (cdr cs))))) -TODO: (emit* "object buf[1];"); +;cargs TODO: (emit* "object buf[1];"); (if head-pair ;TODO: need to change these function calls over ;also, go back and check our changes, I think there is at least one other direct closure call we need to update From bf1d1e89e367f6e9ed6d044b493cd72b2384797f Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 2 Feb 2021 22:21:43 -0500 Subject: [PATCH 09/23] Revert changes to string-byte-length This allows us to run the module in the compiler right now --- scheme/cyclone/cgen.sld | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index 9ee476f5..de436cea 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -707,10 +707,14 @@ (string-append "\"" (cstr:escape-chars str) "\"")) (define-c string-byte-length - "(void *data, object clo, int argc, object *args)" - " Cyc_check_argc(data, \"string-byte-length\", argc, 2); - object s = args[1]; - return_closcall1(data, args[0], Cyc_string_byte_length(data, s)); ") + "(void *data, int argc, closure _, object k, object s)" + " return_closcall1(data, k, Cyc_string_byte_length(data, s)); ") +; cargs TODO: +;(define-c string-byte-length +; "(void *data, object clo, int argc, object *args)" +; " Cyc_check_argc(data, \"string-byte-length\", argc, 2); +; object s = args[1]; +; return_closcall1(data, args[0], Cyc_string_byte_length(data, s)); ") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Primitives From e1082710feb67cb417e0a904db85008ca7266797 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 2 Feb 2021 22:40:46 -0500 Subject: [PATCH 10/23] Added development items --- docs/C-Calling-Conventions.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/docs/C-Calling-Conventions.md b/docs/C-Calling-Conventions.md index ec6577f2..e0882f07 100644 --- a/docs/C-Calling-Conventions.md +++ b/docs/C-Calling-Conventions.md @@ -157,9 +157,9 @@ TODO: Are there any complications in referencing vars from `args` rather than di # Development Plan -- Modify compiler to generate code using the new calling conventions +- Modify compiler (scheme/cyclone/cgen.sld) to generate code using the new calling conventions. Test as best we can that C code is generated properly. - Add necessary header definitions -- Modify runtime / primitives to use calling convention -- Modify FFI and define-c definitions +- Modify runtime / primitives to use calling convention. Ensure runtime compiles with these changes in place. +- Modify FFI and define-c definitions in scheme files - Bring up the compiler in stages. Will need to use the current version of Cyclone to generate a version with the new function signatures. From 02fdcd25324bbec1836511ae459384611ee870b3 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 2 Feb 2021 22:58:00 -0500 Subject: [PATCH 11/23] WIP --- scheme/cyclone/cgen.sld | 24 ++++++++++-------------- 1 file changed, 10 insertions(+), 14 deletions(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index de436cea..ad894b49 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -2092,7 +2092,7 @@ ;; Emit inlinable function list (cond ((not program?) - (emit* "void c_" (lib:name->string lib-name) "_inlinable_lambdas(void *data, object clo, object k, int argc, object *args){ ") + (emit* "void c_" (lib:name->string lib-name) "_inlinable_lambdas(void *data, object clo, int argc, object *args){ ") (let ((pairs '()) (head-pair #f)) (for-each @@ -2125,28 +2125,23 @@ (loop (cons (string-append "make_pair(" (car cs) ", &" (car ps) ", &" (cadr cs) ");\n") code) (cdr ps) (cdr cs))))) -;cargs TODO: (emit* "object buf[1];"); + (emit* "object buf[1]; object cont = args[0]"); (if head-pair -;TODO: need to change these function calls over -;also, go back and check our changes, I think there is at least one other direct closure call we need to update -;; -;; TODO: yes, just search for all ->fn calls -;; - (emit* "(((closure)k)->fn)(data, k, 1, &" head-pair ");") - (emit* "(((closure)k)->fn)(data, k, 1, NULL);")) + (emit* "buf[0] = &" head-pair "; (((closure)cont)->fn)(data, cont, 1, buf);") + (emit* "buf[0] = NULL; (((closure)cont)->fn)(data, cont 1, buf);")) (emit* " } ")))) ;; Emit entry point (cond (program? - (emit "static void c_entry_pt_first_lambda(void *data, object clo, object k, int argc, object *args);") + (emit "static void c_entry_pt_first_lambda(void *data, object clo, int argc, object *args);") (for-each (lambda (lib-name) - (emit* "extern void c_" (lib:name->string lib-name) "_entry_pt(void *data, object clo, object k, int argc, object* args);")) + (emit* "extern void c_" (lib:name->string lib-name) "_entry_pt(void *data, object clo, int argc, object* args);")) required-libs) - (emit "static void c_entry_pt(void *data, object clo, object k, int argc, object *args) { ")) + (emit "static void c_entry_pt(void *data, object clo, int argc, object *args) { ")) (else - (emit* "void c_" (lib:name->string lib-name) "_entry_pt_first_lambda(void *data, object clo, object k, int argc, object *args){ ") + (emit* "void c_" (lib:name->string lib-name) "_entry_pt_first_lambda(void *data, object clo, int argc, object *args){ ") )) ;; Set global-changed indicator @@ -2283,12 +2278,13 @@ ;; Start cont chain, but do not assume closcall1 macro was defined "(" this-clo ".fn)(data, 0, &" this-clo ", &" this-clo ");") (emit "}") - (emit "static void c_entry_pt_first_lambda(void *data, object clo, object k, int argc, object *args) {") + (emit "static void c_entry_pt_first_lambda(void *data, object clo, int argc, object *args) {") (emit compiled-program) (emit ";"))) (else ;; Do not use closcall1 macro as it might not have been defined (emit "cont = ((closure1_type *)cont)->element;") +TODO: (emit* "(((closure)" (cgen:mangle-global (lib:name->symbol lib-name)) From a1d14eaa224d9ee44747acd1ce923be4bc99b756 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 2 Feb 2021 23:04:33 -0500 Subject: [PATCH 12/23] Added a note on branching --- docs/C-Calling-Conventions.md | 1 + 1 file changed, 1 insertion(+) diff --git a/docs/C-Calling-Conventions.md b/docs/C-Calling-Conventions.md index e0882f07..ff4a49fb 100644 --- a/docs/C-Calling-Conventions.md +++ b/docs/C-Calling-Conventions.md @@ -158,6 +158,7 @@ TODO: Are there any complications in referencing vars from `args` rather than di # Development Plan - Modify compiler (scheme/cyclone/cgen.sld) to generate code using the new calling conventions. Test as best we can that C code is generated properly. +- Branch off of master at this point?? At some point we will want to do this to prevent a nasty merge of cargs development back into master. - Add necessary header definitions - Modify runtime / primitives to use calling convention. Ensure runtime compiles with these changes in place. - Modify FFI and define-c definitions in scheme files From f428d2c4ded2afd55117eca71f79f4afb68e9236 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 8 Feb 2021 17:17:51 -0500 Subject: [PATCH 13/23] WIP --- runtime.c | 2 +- scheme/cyclone/cgen.sld | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/runtime.c b/runtime.c index 64e11133..17f758b3 100644 --- a/runtime.c +++ b/runtime.c @@ -5697,7 +5697,7 @@ object apply(void *data, object cont, object func, object args) // Version of apply meant to be called from within compiled code // TODO: in cargs branch we are swapping cont and prim below -// old call convention, EG: Cyc_apply(td, 0, (closure)(a1), clo); \ +// old call convention, EG: Cyc_apply(td, 0, (closure)(a1), clo); // void Cyc_apply(void *data, int argc, closure cont, object prim, ...) { diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index ad894b49..ea710138 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -2016,7 +2016,7 @@ (emit* "static void __lambda_" (number->string (car l)) - "(void *data, object clo, object k, int argc, object *args" + "(void *data, object clo, int argc, object *args" ") ;")))) lambdas) @@ -2276,19 +2276,19 @@ (reverse required-libs)) ;; Init each lib's dependencies 1st (emit* ;; Start cont chain, but do not assume closcall1 macro was defined - "(" this-clo ".fn)(data, 0, &" this-clo ", &" this-clo ");") + " object buf[1]; buf[0] = &" this-clo "; " + "(" this-clo ".fn)(data, &" this-clo ", 1, buf);") (emit "}") (emit "static void c_entry_pt_first_lambda(void *data, object clo, int argc, object *args) {") (emit compiled-program) (emit ";"))) (else ;; Do not use closcall1 macro as it might not have been defined - (emit "cont = ((closure1_type *)cont)->element;") -TODO: + (emit "object buf[1]; buf[0] = ((closure1_type *)clo)->element;") (emit* "(((closure)" (cgen:mangle-global (lib:name->symbol lib-name)) - ")->fn)(data, 1, cont, cont);") + ")->fn)(data, buf[0] 1, buf);") (emit* "}") (emit* "void c_" (lib:name->string lib-name) "_entry_pt(data, argc, cont,value) void *data; int argc; closure cont; object value;{ ") From d162dd8fbc602a00da93a748e48603afc5df6bf9 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 9 Feb 2021 17:38:49 -0500 Subject: [PATCH 14/23] WIP - unpacking args --- scheme/cyclone/cgen.sld | 45 +++++++++++++++++++++++++++++++++++------ 1 file changed, 39 insertions(+), 6 deletions(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index ea710138..c4435c49 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -1780,6 +1780,12 @@ (and (> (string-length tmp-ident) 3) (equal? "self" (substring tmp-ident 0 4)))) + (closure-name + (if has-closure? + (let* ((lis (string-split formals #\,)) + (var (cadr (string-split (car lis) #\space)))) + var) + "_")) (has-loop? (or (adbf:calls-self? (adb:get/default (ast:lambda-id exp) (adb:make-fnc))) @@ -1796,6 +1802,18 @@ arg-closure (string-append arg-closure ","))) formals)) + (c-formals + (cond + (cps? + (string-append + "(void *data, object " closure-name ", int argc, object *args)" + " /* " formals* " */\n")) + (else + (string-append + "(void *data, " arg-argc + formals* + ")")))) + (c-arg-unpacking formals) (env-closure (lambda->env exp)) (body (c-compile-exp (car (ast:lambda-body exp)) ; car ==> assume single expr in lambda body after CPS @@ -1807,9 +1825,10 @@ (cons (lambda (name) (string-append "static " return-type " " name - "(void *data, " arg-argc - formals* - ") {\n" + c-formals + " {\n" + "UNPACKED: " c-arg-unpacking + "\n" preamble (if (ast:lambda-varargs? exp) ;; Load varargs from C stack into Scheme list @@ -2017,7 +2036,11 @@ "static void __lambda_" (number->string (car l)) "(void *data, object clo, int argc, object *args" - ") ;")))) + ") ;" + "/*" + (cdadr l) + "*/" + )))) lambdas) (emit "") @@ -2036,7 +2059,6 @@ (when (and *optimize-well-known-lambdas* (adbf:well-known fnc) (equal? (adbf:closure-size fnc) 1)) - ;; (trace:error `(JAE ,(car l) ,l ,fnc)) (let* ((params-str (cdadr l)) (args-str (string-join @@ -2044,7 +2066,15 @@ (string-split (string-replace-all params-str "object" "") #\,)) - #\,))) + #\,)) + (unpack-args-str + (string-join + (cdr + (string-split + (string-replace-all params-str "object" "") + #\,)) + #\;)) + ) (emit* "static void __lambda_gc_ret_" (number->string (car l)) @@ -2052,6 +2082,8 @@ params-str ")" "{" + ;; cargs TODO: this is broken, will fix later + unpack-args-str "\nobject obj = " "((closure1)" (mangle (car (adbf:all-params fnc))) ")->element;\n" "__lambda_" @@ -2066,6 +2098,7 @@ ;; Print the definitions: (for-each (lambda (l) +;(trace:error `(JAE def ,l)) (cond ((equal? 'precompiled-lambda (caadr l)) (emit* From f7fe5dbf11b10efcaa8fba8d18b64d52c2189aff Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 9 Feb 2021 22:39:57 -0500 Subject: [PATCH 15/23] Unpack args array --- scheme/cyclone/cgen.sld | 25 +++++++++++++++++++++++-- 1 file changed, 23 insertions(+), 2 deletions(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index c4435c49..97f50281 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -1813,7 +1813,28 @@ "(void *data, " arg-argc formals* ")")))) - (c-arg-unpacking formals) + (c-arg-unpacking ;; Unpack args array into locals + (cond + ;; TODO: how to unpack varargs + (cps? + (let ((i 0) + (cstr "") + (args (string-split formals #\,))) + (for-each + (lambda (arg) + (set! cstr (string-append + cstr + arg + " = args[" + (number->string i) + "];" + )) + (set! i (+ i 1))) + (if has-closure? + (cdr args) + args)) + cstr)) + (else ""))) (env-closure (lambda->env exp)) (body (c-compile-exp (car (ast:lambda-body exp)) ; car ==> assume single expr in lambda body after CPS @@ -1827,7 +1848,7 @@ (string-append "static " return-type " " name c-formals " {\n" - "UNPACKED: " c-arg-unpacking + c-arg-unpacking "\n" preamble (if (ast:lambda-varargs? exp) From 95f8a171240eae81ff83b56d771812972d1112ee Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 10 Feb 2021 17:49:12 -0500 Subject: [PATCH 16/23] WIP - varargs --- scheme/cyclone/cgen.sld | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index 97f50281..84df0e2a 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -1820,6 +1820,13 @@ (let ((i 0) (cstr "") (args (string-split formals #\,))) + ;; Strip off extra varargs since we will load them + ;; up using a different technique + (when (ast:lambda-varargs? exp) + (set! args + (reverse + (cddr (reverse args))))) + ;; Generate code to unpack args into locals w/expected names (for-each (lambda (arg) (set! cstr (string-append @@ -1852,6 +1859,14 @@ "\n" preamble (if (ast:lambda-varargs? exp) +; TODO: varargs +; does it make more sense to write code here directly +; or modify load_varargs? basically want args[nx]...args[ny] to become a list +;; +;; TODO: is it possible to rewrite load_varargs to not use alloca? +;; should try this on master, because I would prefer to avoid alloca +;; here if at all possible +;; ;; Load varargs from C stack into Scheme list (string-append ;; DEBUGGING: From c77cfcd6f7501bdd22879ac83d943842047451d5 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Wed, 10 Feb 2021 22:28:21 -0500 Subject: [PATCH 17/23] unpack varargs --- include/cyclone/runtime.h | 19 ++++++------------- scheme/cyclone/cgen.sld | 26 +++++++++++++------------- 2 files changed, 19 insertions(+), 26 deletions(-) diff --git a/include/cyclone/runtime.h b/include/cyclone/runtime.h index f718d2c2..88fe774e 100644 --- a/include/cyclone/runtime.h +++ b/include/cyclone/runtime.h @@ -148,28 +148,21 @@ object Cyc_global_set_cps(void *thd, object cont, object sym, object * glo, obje our compiler will compute the difference between the number of required args and the number of provided ones, and pass the difference as 'count' */ -#define load_varargs(var, arg_var, count) \ - list var = (count > 0) ? alloca(sizeof(pair_type)*count) : NULL; \ +#define load_varargs(var, args_var, start, count) \ + list var = ((count) > 0) ? alloca(sizeof(pair_type)*(count)) : NULL; \ { \ int i; \ object tmp; \ - va_list va; \ - if (count > 0) { \ - va_start(va, arg_var); \ - for (i = 0; i < count; i++) { \ - if (i) { \ - tmp = va_arg(va, object); \ - } else { \ - tmp = arg_var; \ - } \ + if ((count) > 0) { \ + for (i = 0; i < (count); i++) { \ + tmp = arg[start + i]; \ var[i].hdr.mark = gc_color_red; \ var[i].hdr.grayed = 0; \ var[i].hdr.immutable = 0; \ var[i].tag = pair_tag; \ var[i].pair_car = tmp; \ - var[i].pair_cdr = (i == (count-1)) ? NULL : &var[i + 1]; \ + var[i].pair_cdr = (i == ((count)-1)) ? NULL : &var[i + 1]; \ } \ - va_end(va); \ } \ } /* Prototypes for primitive functions. */ diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index 84df0e2a..a8f834c3 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -1868,19 +1868,19 @@ ;; here if at all possible ;; ;; Load varargs from C stack into Scheme list - (string-append - ;; DEBUGGING: - ;; "printf(\"%d %d\\n\", argc, " - ;; (number->string (length (ast:lambda-formals->list exp))) ");" - "load_varargs(" - (mangle (ast:lambda-varargs-var exp)) - ", " - (mangle (ast:lambda-varargs-var exp)) - "_raw, argc - " (number->string - (- (length (ast:lambda-formals->list exp)) - 1 - (if has-closure? 1 0))) - ");\n"); + (let ((num-fixargs (- (length (ast:lambda-formals->list exp)) + 2 ;; include raw and "..." + (if has-closure? 1 0)))) + (string-append + ;; DEBUGGING: + ;; "printf(\"%d %d\\n\", argc, " + ;; (number->string (length (ast:lambda-formals->list exp))) ");" + "load_varargs(" + (mangle (ast:lambda-varargs-var exp)) + ", args" + ", " (number->string num-fixargs) + ", argc - " (number->string num-fixargs) + ");\n")) "") ; No varargs, skip (c:serialize (c:append From fc39cacbb302d6a5d94acbb7ecc4e3ad41e759c3 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 11 Feb 2021 14:45:26 -0500 Subject: [PATCH 18/23] varargs bug fixes, and cleanup --- scheme/cyclone/cgen.sld | 19 ++++++++----------- 1 file changed, 8 insertions(+), 11 deletions(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index a8f834c3..dd1b446c 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -1780,9 +1780,14 @@ (and (> (string-length tmp-ident) 3) (equal? "self" (substring tmp-ident 0 4)))) + (formals-as-list + (let ((lis (string-split formals #\,))) + (if (null? lis) + (list formals) + lis))) (closure-name (if has-closure? - (let* ((lis (string-split formals #\,)) + (let* ((lis formals-as-list) (var (cadr (string-split (car lis) #\space)))) var) "_")) @@ -1819,7 +1824,7 @@ (cps? (let ((i 0) (cstr "") - (args (string-split formals #\,))) + (args formals-as-list)) ;; Strip off extra varargs since we will load them ;; up using a different technique (when (ast:lambda-varargs? exp) @@ -1859,17 +1864,9 @@ "\n" preamble (if (ast:lambda-varargs? exp) -; TODO: varargs -; does it make more sense to write code here directly -; or modify load_varargs? basically want args[nx]...args[ny] to become a list -;; -;; TODO: is it possible to rewrite load_varargs to not use alloca? -;; should try this on master, because I would prefer to avoid alloca -;; here if at all possible -;; ;; Load varargs from C stack into Scheme list (let ((num-fixargs (- (length (ast:lambda-formals->list exp)) - 2 ;; include raw and "..." + 1 (if has-closure? 1 0)))) (string-append ;; DEBUGGING: From 9df5665dab822ba4822fed7835dd9a999eed3c49 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 11 Feb 2021 15:12:15 -0500 Subject: [PATCH 19/23] Add missing semicolon --- scheme/cyclone/cgen.sld | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index dd1b446c..69237692 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -2191,7 +2191,7 @@ (loop (cons (string-append "make_pair(" (car cs) ", &" (car ps) ", &" (cadr cs) ");\n") code) (cdr ps) (cdr cs))))) - (emit* "object buf[1]; object cont = args[0]"); + (emit* "object buf[1]; object cont = args[0];"); (if head-pair (emit* "buf[0] = &" head-pair "; (((closure)cont)->fn)(data, cont, 1, buf);") (emit* "buf[0] = NULL; (((closure)cont)->fn)(data, cont 1, buf);")) From 8b8af34390cee03440bc13cbdc7151c2481dbef2 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 11 Feb 2021 18:07:54 -0500 Subject: [PATCH 20/23] Cleanup and fix syntax errors --- scheme/cyclone/cgen.sld | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index 69237692..5dfc2cbb 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -2194,7 +2194,7 @@ (emit* "object buf[1]; object cont = args[0];"); (if head-pair (emit* "buf[0] = &" head-pair "; (((closure)cont)->fn)(data, cont, 1, buf);") - (emit* "buf[0] = NULL; (((closure)cont)->fn)(data, cont 1, buf);")) + (emit* "buf[0] = NULL; (((closure)cont)->fn)(data, cont, 1, buf);")) (emit* " } ")))) ;; Emit entry point @@ -2354,15 +2354,15 @@ (emit* "(((closure)" (cgen:mangle-global (lib:name->symbol lib-name)) - ")->fn)(data, buf[0] 1, buf);") + ")->fn)(data, buf[0], 1, buf);") (emit* "}") - (emit* "void c_" (lib:name->string lib-name) "_entry_pt(data, argc, cont,value) void *data; int argc; closure cont; object value;{ ") + (emit* "void c_" (lib:name->string lib-name) "_entry_pt(void *data, int argc, object cont, object value){ ") (emit* " register_library(\"" (lib:name->unique-string lib-name) "\");") (if (null? lib-pass-thru-exports) - (emit* " c_" (lib:name->string lib-name) "_entry_pt_first_lambda(data, argc, cont,value);") + (emit* " c_" (lib:name->string lib-name) "_entry_pt_first_lambda(data, argc, cont, value);") ;; GC to ensure objects are moved when exporting exports. ;; Otherwise there will be broken hearts :( (emit* From b6c2a353a82df4def08a87f9baa273c5d519ec40 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 11 Feb 2021 22:27:50 -0500 Subject: [PATCH 21/23] Compilation fixes --- include/cyclone/runtime-main.h | 2 +- include/cyclone/runtime.h | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/include/cyclone/runtime-main.h b/include/cyclone/runtime-main.h index bd47770d..0c882cd2 100644 --- a/include/cyclone/runtime-main.h +++ b/include/cyclone/runtime-main.h @@ -12,7 +12,7 @@ long global_stack_size = 0; long global_heap_size = 0; -static void c_entry_pt(void *, int, closure, closure); +static void c_entry_pt(void *data, object clo, int argc, object *args); static void Cyc_heap_init(long heap_size); static void Cyc_heap_init(long heap_size) diff --git a/include/cyclone/runtime.h b/include/cyclone/runtime.h index 88fe774e..7ae47a16 100644 --- a/include/cyclone/runtime.h +++ b/include/cyclone/runtime.h @@ -155,7 +155,7 @@ object Cyc_global_set_cps(void *thd, object cont, object sym, object * glo, obje object tmp; \ if ((count) > 0) { \ for (i = 0; i < (count); i++) { \ - tmp = arg[start + i]; \ + tmp = args_var[start + i]; \ var[i].hdr.mark = gc_color_red; \ var[i].hdr.grayed = 0; \ var[i].hdr.immutable = 0; \ @@ -174,7 +174,7 @@ object Cyc_global_set_cps(void *thd, object cont, object sym, object * glo, obje /**@{*/ object apply(void *data, object cont, object func, object args); -void Cyc_apply(void *data, int argc, closure cont, object prim, ...); +void Cyc_apply(void *data, object cont, int argc, object *args); void dispatch_apply_va(void *data, int argc, object clo, object cont, object func, ...); object apply_va(void *data, object cont, int argc, object func, ...); void dispatch(void *data, int argc, function_type func, object clo, object cont, From 81e0f82046600724df9ef1dd51dee0d875ef4358 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Thu, 11 Feb 2021 23:02:20 -0500 Subject: [PATCH 22/23] Fix order of arguments --- scheme/cyclone/cgen.sld | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index 5dfc2cbb..4bd09347 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -2357,12 +2357,12 @@ ")->fn)(data, buf[0], 1, buf);") (emit* "}") - (emit* "void c_" (lib:name->string lib-name) "_entry_pt(void *data, int argc, object cont, object value){ ") + (emit* "void c_" (lib:name->string lib-name) "_entry_pt(void *data, object cont, int argc, object value){ ") (emit* " register_library(\"" (lib:name->unique-string lib-name) "\");") (if (null? lib-pass-thru-exports) - (emit* " c_" (lib:name->string lib-name) "_entry_pt_first_lambda(data, argc, cont, value);") + (emit* " c_" (lib:name->string lib-name) "_entry_pt_first_lambda(data, cont, argc, value);") ;; GC to ensure objects are moved when exporting exports. ;; Otherwise there will be broken hearts :( (emit* From c22bb4898de86e4a89777941ef659c645da6542d Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Mon, 15 Feb 2021 15:06:11 -0500 Subject: [PATCH 23/23] Backwards compatibility for define-c expressions --- scheme/cyclone/cgen.sld | 60 ++++++++++++++++++++++++++++++++++++----- 1 file changed, 53 insertions(+), 7 deletions(-) diff --git a/scheme/cyclone/cgen.sld b/scheme/cyclone/cgen.sld index 4bd09347..1fbc3084 100644 --- a/scheme/cyclone/cgen.sld +++ b/scheme/cyclone/cgen.sld @@ -2134,13 +2134,30 @@ ;(trace:error `(JAE def ,l)) (cond ((equal? 'precompiled-lambda (caadr l)) - (emit* - "static void __lambda_" - (number->string (car l)) - (cadadr l) - " {" - (car (cddadr l)) - " }")) + (cond + ((equal? (substring (cadadr l) 0 42) + "(void *data, int argc, closure _, object k") + ;; Backwards compatibility for define-c expressions using + ;; the old style of all C parameters contained directly + ;; in the function definition. The above code finds them + ;; and below we emit code that unpacks the args array into + ;; a series of local variables + (emit* + "static void __lambda_" + (number->string (car l)) + "(void *data, object _, int args, object *args)" + " {" + (c:old-c-args->new-decls-from-args (cadadr l)) + (car (cddadr l)) + " }")) + (else + (emit* + "static void __lambda_" + (number->string (car l)) + (cadadr l) + " {" + (car (cddadr l)) + " }")))) ((equal? 'precompiled-inline-lambda (caadr l)) (emit* "static object __lambda_" @@ -2374,6 +2391,35 @@ (if program? (emit *c-main-function*)))) +;; Take an old define-c CPS function definition string such as: +;; +;; "(void *data, int argc, closure _, object k, object a, object b, object c)") +;; +;; And convert it to a series of local variable declarations, assigning a value +;; from our new `args` parameter. +;; +;; These declarations are returned as a string. +(define (c:old-c-args->new-decls-from-args cstr) + (let* ((args (cdddr + (string-split + (filter-invalid-chars cstr) + #\,))) ;; Get scheme list of any extra arguments + (vars (map (lambda (a) (cadr (string-split a #\space))) args)) ;; Get identifiers of variables + (i 0) + (str "")) + (for-each ;; Create a set of assignments from args array to new C local variables + (lambda (v) + (set! str (string-append str "object " v " = args[" (number->string i) "];")) + (set! i (+ i 1))) + vars) + str)) + +(define (filter-invalid-chars str) + (list->string + (filter + (lambda (c) + (not (member c '(#\( #\))))) + (string->list str)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Automatically generate blocks of code for the compiler