Refactoring

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

View file

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

View file

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