mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-23 20:15:05 +02:00
WIP
This commit is contained in:
Justin Ethier
parent
0cd4d2e796
commit
a84c8b9339
3 changed files with 43 additions and 34 deletions
9
Makefile
9
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
|
||||
|
||||
|
|
|
|||
|
|
@ -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);}}
|
||||
|
|
|
|||
|
|
@ -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 "}")
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue