Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-25 13:05:05 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

WIP

Browse source
This commit is contained in:
Justin Ethier 2015-11-04 23:21:56 -05:00
parent ee5c79184d
commit 9545200722
1 changed files with 18 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
scheme/cyclone/cgen.sld
View file

@ -714,7 +714,7 @@
(else #f))) (else #f)))
;; END apply defs ;; END apply defs
(tdata (cond (tdata (cond
((prim/data-arg? p) "data ") ((prim/data-arg? p) "data")
(else ""))) (else "")))
(tdata-comma (if (> (string-length tdata) 0) "," "")) (tdata-comma (if (> (string-length tdata) 0) "," ""))
(c-var-assign (c-var-assign
@ -737,13 +737,11 @@
(closure-def (closure-def
(string-append (string-append
tdata "," tdata ","
"&" closure-sym "&" closure-sym))
(if (prim:cont-has-args? p) ", " "")))
((prim:cont? p) ((prim:cont? p)
(string-append (string-append
tdata "," tdata ","
cont cont))
(if (prim:cont-has-args? p) ", " "")))
(else tdata))))))))) (else tdata)))))))))
(cond (cond
((prim/c-var-assign p) ((prim/c-var-assign p)
@ -763,7 +761,7 @@
(list (list
(string-append c-func "(" cv-name tdata-comma tdata))))) (string-append c-func "(" cv-name tdata-comma tdata)))))
(else (else
(c-code (string-append c-func "(" tdata tdata-comma)))))) (c-code (string-append c-func "(" tdata))))))
;; END primitives ;; END primitives
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -845,7 +843,18 @@
(c:allocs c-args*) ;; fun alloc depends upon arg allocs (c:allocs c-args*) ;; fun alloc depends upon arg allocs
(list (string-append (list (string-append
(car (c:allocs c-fun)) (car (c:allocs c-fun))
(if (prim/c-var-assign fun) "" ",") ; Allocating C var (if (prim/c-var-assign fun)
;; Add a comma if there were any args to the func
(let* ((fnc-str (car (c:allocs c-fun)))
(len (string-length fnc-str)))
(write (string-append "(JAE-DEBUG " fnc-str))
(cond
((and (> len 0)
(not (equal? "("
(substring fnc-str (- len 1) len))))
",")
(else "")))
",")
(c:body c-args*) ");")))) (c:body c-args*) ");"))))
;; Args stay with body ;; Args stay with body
(c:append (c:append
@ -1255,7 +1264,7 @@
; Emit entry point ; Emit entry point
(cond (cond
(program? (program?
(emit "static void c_entry_pt_first_lambda(void *data);") (emit "static void c_entry_pt_first_lambda(void *data, int argc, closure cont, object value);")
(for-each (for-each
(lambda (lib-name) (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, int argc, closure cont, object value);"))