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

Refactoring

Browse source
This commit is contained in:
Justin Ethier 2016-04-27 03:18:47 -04:00
parent 5d1a605b66
commit e892ed2270
2 changed files with 49 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

42
runtime.c
View file

@ -74,22 +74,40 @@ void Cyc_check_bounds(void *data, const char *label, int len, int index) {
/* END error checking */
/* These macros are hardcoded here to support functions in this module. */
#define closcall1(td,clo,a1) if (type_of(clo) == pair_tag || prim(clo)) { Cyc_apply(td,0, (closure)(a1), clo); } else { ((clo)->fn)(td,1,clo,a1);}
/* Return to continuation after checking for stack overflow. */
#define return_closcall1(td,clo,a1) { \
#define closcall1(td, clo,a1) \
if (type_of(clo) == pair_tag || prim(clo)) { \
Cyc_apply(td, 0, (closure)(a1), clo); \
} else { \
((clo)->fn)(td, 1, clo,a1);\
}
#define return_closcall1(td, clo,a1) { \
char top; \
if (stack_overflow(&top,(((gc_thread_data *)data)->stack_limit))) { \
if (stack_overflow(&top, (((gc_thread_data *)data)->stack_limit))) { \
object buf[1]; buf[0] = a1;\
GC(td,clo,buf,1); return; \
} else {closcall1(td,(closure) (clo),a1); return;}}
#define closcall2(td,clo,a1,a2) if (type_of(clo) == pair_tag || prim(clo)) { Cyc_apply(td,1, (closure)(a1), clo,a2); } else { ((clo)->fn)(td,2,clo,a1,a2);}
/* Return to continuation after checking for stack overflow. */
#define return_closcall2(td,clo,a1,a2) { \
GC(td, clo, buf, 1); \
return; \
} else {\
closcall1(td, (closure) (clo),a1); \
return;\
} \
}
#define closcall2(td, clo,a1,a2) \
if (type_of(clo) == pair_tag || prim(clo)) { \
Cyc_apply(td, 1, (closure)(a1), clo,a2); \
} else { \
((clo)->fn)(td, 2, clo,a1,a2);\
}
#define return_closcall2(td, clo,a1,a2) { \
char top; \
if (stack_overflow(&top,(((gc_thread_data *)data)->stack_limit))) { \
if (stack_overflow(&top, (((gc_thread_data *)data)->stack_limit))) { \
object buf[2]; buf[0] = a1;buf[1] = a2;\
GC(td,clo,buf,2); return; \
} else {closcall2(td,(closure) (clo),a1,a2); return;}}
GC(td, clo, buf, 2); \
return; \
} else {\
closcall2(td, (closure) (clo),a1,a2); \
return;\
} \
}
/*END closcall section */
/* Global variables. */

28
scheme/cyclone/cgen.sld
View file

@ -127,8 +127,13 @@
" char top; \\\n"
" if (stack_overflow(&top, (((gc_thread_data *)data)->stack_limit))) { \\\n"
" object buf[" n "]; " arry-assign "\\\n"
" GC(td,clo,buf," n "); return; \\\n"
" } else {closcall" n "(td,(closure) (clo)" args "); return;}}\n")))
" GC(td, clo, buf, " n "); \\\n"
" return; \\\n"
" } else {\\\n"
" closcall" n "(td, (closure) (clo)" args "); \\\n"
" return;\\\n"
" } \\\n"
"}\n")))
(define (c-macro-return-direct num-args)
(let ((args (c-macro-n-prefix num-args ",a"))
@ -141,8 +146,11 @@
" if (stack_overflow(&top, (((gc_thread_data *)data)->stack_limit))) { \\\n"
" object buf[" n "]; " arry-assign " \\\n"
" mclosure0(c1, _fn); \\\n"
" GC(td, &c1, buf, " n "); return; \\\n"
" } else { (_fn)(td," n ",(closure)_fn" args "); }}\n")))
" GC(td, &c1, buf, " n "); \\\n"
" return; \\\n"
" } else { \\\n"
" (_fn)(td, " n ", (closure)_fn" args "); \\\n"
" }}\n")))
(define (c-macro-closcall num-args)
(let ((args (c-macro-n-prefix num-args ",a"))
@ -150,11 +158,13 @@
(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 ") "
(wrap (string-append "if (type_of(clo) == pair_tag || prim(clo)) { Cyc_apply(td," n-1 ", (closure)(a1), clo" (if (> num-args 1) (substring args 3 (string-length args)) "") "); }"))
(wrap " else { ")
"((clo)->fn)(td," n ",clo" args ")"
(wrap ";}")
"#define closcall" n "(td, clo" args ") \\\n"
(wrap (string-append "if (type_of(clo) == pair_tag || prim(clo)) { \\\n"
" Cyc_apply(td, " n-1 ", (closure)(a1), clo" (if (> num-args 1) (substring args 3 (string-length args)) "") "); \\\n"
"}"))
(wrap " else { \\\n")
" ((clo)->fn)(td, " n ", clo" args ")"
(wrap ";\\\n}")
)))
(define (c-macro-n-prefix n prefix)