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

WIP

Browse source
This commit is contained in:
Justin Ethier 2021-02-01 23:02:08 -05:00
parent fc20a88578
commit f624e68a33
2 changed files with 21 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
runtime.c
View file

@ -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 // 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, ...) void Cyc_apply(void *data, int argc, closure cont, object prim, ...)
{ {
va_list ap; va_list ap;

32
scheme/cyclone/cgen.sld
View file

@ -145,12 +145,12 @@
;;"/* Check for GC, then call given continuation closure */\n" ;;"/* Check for GC, then call given continuation closure */\n"
"#define return_closcall" n "(td, clo" args ") { \\\n" "#define return_closcall" n "(td, clo" args ") { \\\n"
" char top; \\\n" " char top; \\\n"
" object buf[" n "]; " arry-assign "\\\n"
" if (stack_overflow(&top, (((gc_thread_data *)data)->stack_limit))) { \\\n" " if (stack_overflow(&top, (((gc_thread_data *)data)->stack_limit))) { \\\n"
" object buf[" n "]; " arry-assign "\\\n"
" GC(td, clo, buf, " n "); \\\n" " GC(td, clo, buf, " n "); \\\n"
" return; \\\n" " return; \\\n"
" } else {\\\n" " } else {\\\n"
" closcall" n "(td, (closure) (clo)" args "); \\\n" " closcall" n "(td, (closure) (clo), buf"
" return;\\\n" " return;\\\n"
" } \\\n" " } \\\n"
"}\n"))) "}\n")))
@ -233,12 +233,12 @@
(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, clo" args ") \\\n" "#define closcall" n "(td, clo, buf) \\\n"
(wrap (string-append "if (obj_is_not_closure(clo)) { \\\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") (wrap " else { \\\n")
" ((clo)->fn)(td, " n ", clo" args ")" " ((clo)->fn)(td, clo, " n ", buf)"
(wrap ";\\\n}")))) (wrap ";\\\n}"))))
(define (c-macro-n-prefix n prefix) (define (c-macro-n-prefix n prefix)
@ -707,10 +707,10 @@
(string-append "\"" (cstr:escape-chars str) "\"")) (string-append "\"" (cstr:escape-chars str) "\""))
(define-c string-byte-length (define-c string-byte-length
"(void *data, object clo, object k, int argc, object *args)" "(void *data, object clo, int argc, object *args)"
" Cyc_check_argc(data, \"string-byte-length\", argc, 1); " Cyc_check_argc(data, \"string-byte-length\", argc, 2);
object s = args[0]; object s = args[1];
return_closcall1(data, k, Cyc_string_byte_length(data, s)); ") return_closcall1(data, args[0], Cyc_string_byte_length(data, s)); ")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Primitives ;; Primitives
@ -2100,7 +2100,7 @@
(set! pairs (cons pair-sym pairs)))) (set! pairs (cons pair-sym pairs))))
*global-inlines*) *global-inlines*)
;; Link the pairs ;; Link the pairs
(let loop ((code '()) (let loop ((code '())
(ps pairs) (ps pairs)
(cs (map (lambda (_) (mangle (gensym 'c))) pairs))) (cs (map (lambda (_) (mangle (gensym 'c))) pairs)))
(cond (cond
@ -2121,11 +2121,15 @@
(loop (cons (string-append "make_pair(" (car cs) ", &" (car ps) ", &" (cadr cs) ");\n") code) (loop (cons (string-append "make_pair(" (car cs) ", &" (car ps) ", &" (cadr cs) ");\n") code)
(cdr ps) (cdr ps)
(cdr cs))))) (cdr cs)))))
TODO: (emit* "object buf[1];");
(if head-pair (if head-pair
TODO: need to change these function calls over ;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 ;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: 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* " } "))))
;; Emit entry point ;; Emit entry point