Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-07-12 15:27:36 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

WIP - unpacking args

Browse source
This commit is contained in:
Justin Ethier 2021-02-09 17:38:49 -05:00
parent f428d2c4de
commit d162dd8fbc
1 changed files with 39 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

45
scheme/cyclone/cgen.sld
View file

@ -1780,6 +1780,12 @@
(and (and
(> (string-length tmp-ident) 3) (> (string-length tmp-ident) 3)
(equal? "self" (substring tmp-ident 0 4)))) (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? (has-loop?
(or (or
(adbf:calls-self? (adb:get/default (ast:lambda-id exp) (adb:make-fnc))) (adbf:calls-self? (adb:get/default (ast:lambda-id exp) (adb:make-fnc)))
@ -1796,6 +1802,18 @@
arg-closure arg-closure
(string-append arg-closure ","))) (string-append arg-closure ",")))
formals)) 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)) (env-closure (lambda->env exp))
(body (c-compile-exp (body (c-compile-exp
(car (ast:lambda-body exp)) ; car ==> assume single expr in lambda body after CPS (car (ast:lambda-body exp)) ; car ==> assume single expr in lambda body after CPS
@ -1807,9 +1825,10 @@
(cons (cons
(lambda (name) (lambda (name)
(string-append "static " return-type " " name (string-append "static " return-type " " name
"(void *data, " arg-argc c-formals
formals* " {\n"
") {\n" "UNPACKED: " c-arg-unpacking
"\n"
preamble preamble
(if (ast:lambda-varargs? exp) (if (ast:lambda-varargs? exp)
;; Load varargs from C stack into Scheme list ;; Load varargs from C stack into Scheme list
@ -2017,7 +2036,11 @@
"static void __lambda_" "static void __lambda_"
(number->string (car l)) (number->string (car l))
"(void *data, object clo, int argc, object *args" "(void *data, object clo, int argc, object *args"
") ;")))) ") ;"
"/*"
(cdadr l)
"*/"
))))
lambdas) lambdas)
(emit "") (emit "")
@ -2036,7 +2059,6 @@
(when (and *optimize-well-known-lambdas* (when (and *optimize-well-known-lambdas*
(adbf:well-known fnc) (adbf:well-known fnc)
(equal? (adbf:closure-size fnc) 1)) (equal? (adbf:closure-size fnc) 1))
;; (trace:error `(JAE ,(car l) ,l ,fnc))
(let* ((params-str (cdadr l)) (let* ((params-str (cdadr l))
(args-str (args-str
(string-join (string-join
@ -2044,7 +2066,15 @@
(string-split (string-split
(string-replace-all params-str "object" "") (string-replace-all params-str "object" "")
#\,)) #\,))
#\,))) #\,))
(unpack-args-str
(string-join
(cdr
(string-split
(string-replace-all params-str "object" "")
#\,))
#\;))
)
(emit* (emit*
"static void __lambda_gc_ret_" "static void __lambda_gc_ret_"
(number->string (car l)) (number->string (car l))
@ -2052,6 +2082,8 @@
params-str params-str
")" ")"
"{" "{"
;; cargs TODO: this is broken, will fix later
unpack-args-str
"\nobject obj = " "\nobject obj = "
"((closure1)" (mangle (car (adbf:all-params fnc))) ")->element;\n" "((closure1)" (mangle (car (adbf:all-params fnc))) ")->element;\n"
"__lambda_" "__lambda_"
@ -2066,6 +2098,7 @@
;; Print the definitions: ;; Print the definitions:
(for-each (for-each
(lambda (l) (lambda (l)
;(trace:error `(JAE def ,l))
(cond (cond
((equal? 'precompiled-lambda (caadr l)) ((equal? 'precompiled-lambda (caadr l))
(emit* (emit*