diff --git a/Makefile b/Makefile index e73151eb..d96be379 100644 --- a/Makefile +++ b/Makefile @@ -12,6 +12,15 @@ cgen.so: cgen.scm parser.so: parser.scm csc -s parser.scm +libcyclone.a: runtime.c runtime.h + gcc -c runtime.c -o runtime.o + ar rcs libcyclone.a runtime.o +# Instructions from: http://www.adp-gmbh.ch/cpp/gcc/create_lib.html +# Note compiler will have to link to this, eg: +#Linking against static library +#gcc -static main.c -L. -lmean -o statically_linked +#Note: the first three letters (the lib) must not be specified, as well as the suffix (.a) + cyclone: cyclone.scm trans.so cgen.so parser.so csc cyclone.scm diff --git a/runtime.c b/runtime.c new file mode 100644 index 00000000..2e8a9692 --- /dev/null +++ b/runtime.c @@ -0,0 +1,114 @@ +#include "runtime.h" + +/** + * Take list of args and call a function with them as params. + * + * Note memory scheme below is not compatible with GC, + * so macro calls funcs directly. + */ + +// TODO: the following slows down compilation significantly. +// it's not just the hack, but rather the size of the expanded code. +// suggest creating a runtime library that will be linked to +// the compiled executable. maybe just a small static lib for now + +/** + * Receive a list of arguments and apply them to the given function + */ +void dispatch(int argc, function_type func, object clo, object cont, object args) { + // TODO: is this portable? may be better to have a dedicated memory area and +// just copy to it as needed + object b[argc]; // OK to do this? + int i; + for (i = 0; i < argc; i++){ + b[i] = car(args); + args = cdr(args); + } + +/* The following is based on the macro expansion code from CHICKEN's do_apply */ + +/* PTR_O_p

_(o): list of COUNT = ((2 ** P) * B) '*(b+I)' arguments, + * with offset I in range [o, o+COUNT-1]. + */ +#define PTR_O_p0_0(o) +#define PTR_O_p1_0(o) +#define PTR_O_p2_0(o) +#define PTR_O_p3_0(o) +#define PTR_O_p4_0(o) +#define PTR_O_p5_0(o) +#define PTR_O_p6_0(o) +#define PTR_O_p7_0(o) +#define PTR_O_p0_1(o) , *(b+(o)) +#define PTR_O_p1_1(o) , *(b+(o)), *(b+(o+1)) +#define PTR_O_p2_1(o) PTR_O_p1_1(o) PTR_O_p1_1(o+2) +#define PTR_O_p3_1(o) PTR_O_p2_1(o) PTR_O_p2_1(o+4) +#define PTR_O_p4_1(o) PTR_O_p3_1(o) PTR_O_p3_1(o+8) +#define PTR_O_p5_1(o) PTR_O_p4_1(o) PTR_O_p4_1(o+16) +#define PTR_O_p6_1(o) PTR_O_p5_1(o) PTR_O_p5_1(o+32) +#define PTR_O_p7_1(o) PTR_O_p6_1(o) PTR_O_p6_1(o+64) + +/* CASE_C_PROC_p0 (n0, p6,p5,p4,p3,p2,p1,p0): + * let's note = - 2; the macro inserts: + * case : ((C_cproc)pr) (, fn, k, ); + * where is: *(b+1), ..., *(b+) + * ( is empty for == 2). + * We must have: n0 = SUM (i = 7 to 0, p * (1 << i)). + * CASE_C_PROC_p (...): + * like CASE_C_PROC_p, but with doubled output... + */ +#define CASE_C_PROC_p0(n0, p6,p5,p4,p3,p2,p1,p0) \ + case (n0-2): func(n0-1, clo, cont \ +PTR_O_p6_##p6(((n0-2)&0x80)+0)\ +PTR_O_p5_##p5(((n0-2)&0xC0)+0)\ +PTR_O_p4_##p4(((n0-2)&0xE0)+0)\ +PTR_O_p3_##p3(((n0-2)&0xF0)+0)\ +PTR_O_p2_##p2(((n0-2)&0xF8)+0)\ +PTR_O_p1_##p1(((n0-2)&0xFC)+0)\ +PTR_O_p0_##p0(((n0-2)&0xFE)+0)); +#define CASE_C_PROC_p1( n0,n1, p6,p5,p4,p3,p2,p1) \ + CASE_C_PROC_p0 (n0, p6,p5,p4,p3,p2,p1,0) \ + CASE_C_PROC_p0 (n1, p6,p5,p4,p3,p2,p1,1) +#define CASE_C_PROC_p2( n0,n1,n2,n3, p6,p5,p4,p3,p2) \ + CASE_C_PROC_p1 (n0,n1, p6,p5,p4,p3,p2,0) \ + CASE_C_PROC_p1 (n2,n3, p6,p5,p4,p3,p2,1) +#define CASE_C_PROC_p3( n0,n1,n2,n3,n4,n5,n6,n7, p6,p5,p4,p3) \ + CASE_C_PROC_p2 (n0,n1,n2,n3, p6,p5,p4,p3,0) \ + CASE_C_PROC_p2 (n4,n5,n6,n7, p6,p5,p4,p3,1) + switch(argc) { + CASE_C_PROC_p3 (2,3,4,5,6,7,8,9, 0,0,0,0) + CASE_C_PROC_p3 (10,11,12,13,14,15,16,17, 0,0,0,1) + CASE_C_PROC_p3 (18,19,20,21,22,23,24,25, 0,0,1,0) + CASE_C_PROC_p3 (26,27,28,29,30,31,32,33, 0,0,1,1) + CASE_C_PROC_p3 (34,35,36,37,38,39,40,41, 0,1,0,0) + CASE_C_PROC_p3 (42,43,44,45,46,47,48,49, 0,1,0,1) + CASE_C_PROC_p3 (50,51,52,53,54,55,56,57, 0,1,1,0) + CASE_C_PROC_p3 (58,59,60,61,62,63,64,65, 0,1,1,1) + CASE_C_PROC_p0 (66, 1,0,0,0,0,0,0) + CASE_C_PROC_p0 (67, 1,0,0,0,0,0,1) + CASE_C_PROC_p1 (68,69, 1,0,0,0,0,1) + CASE_C_PROC_p2 (70,71,72,73, 1,0,0,0,1) + CASE_C_PROC_p3 (74,75,76,77,78,79,80,81, 1,0,0,1) + CASE_C_PROC_p3 (82,83,84,85,86,87,88,89, 1,0,1,0) + CASE_C_PROC_p3 (90,91,92,93,94,95,96,97, 1,0,1,1) + CASE_C_PROC_p3 (98,99,100,101,102,103,104,105, 1,1,0,0) + CASE_C_PROC_p3 (106,107,108,109,110,111,112,113, 1,1,0,1) + CASE_C_PROC_p3 (114,115,116,117,118,119,120,121, 1,1,1,0) + CASE_C_PROC_p2 (122,123,124,125, 1,1,1,1,0) + CASE_C_PROC_p1 (126,127, 1,1,1,1,1,0) + CASE_C_PROC_p0 (128, 1,1,1,1,1,1,0) + default: //barf(C_TOO_MANY_PARAMETERS_ERROR, "apply"); + // TODO: not good enough, throw an exception instead, using (error) + printf("Unhandled number of function arguments: %d\n", argc); + exit(1); + } +} + +/** + * Same as above but for a varargs C function + */ +void dispatch_va(int argc, function_type_va func, object clo, object cont, object args) { +// TODO: DISPATCH_RETURN_CALL_FUNC + printf("TODO: implement\n"); + exit(1); +} + diff --git a/runtime.h b/runtime.h index d38ca739..3843c6d5 100644 --- a/runtime.h +++ b/runtime.h @@ -9,10 +9,6 @@ #ifndef CYCLONE_RUNTIME_H #define CYCLONE_RUNTIME_H -/* If this is set, GC is called every function call. */ -/* Only turn this on for debugging!!! */ -#define DEBUG_ALWAYS_GC 0 - /* Debug GC flag */ #define DEBUG_GC 0 @@ -355,9 +351,11 @@ static object memberp(object,list); static object memqp(object,list); static char *transport(char *,int); static void GC(closure,object*,int) never_returns; - static void main_main(long stack_size,long heap_size,char *stack_base) never_returns; -static long long_arg(int argc,char **argv,char *name,long dval); +//static long long_arg(int argc,char **argv,char *name,long dval); + +void dispatch(int argc, function_type func, object clo, object cont, object args); +void dispatch_va(int argc, function_type_va func, object clo, object cont, object args); /* Primitive types */ //typedef void (*prim_function_type)(); @@ -1397,118 +1395,6 @@ typedef union { string_type string_t; } common_type; -/** - * Take list of args and call a function with them as params. - * - * Note memory scheme below is not compatible with GC, - * so macro calls funcs directly. - */ - -// TODO: the following slows down compilation significantly. -// it's not just the hack, but rather the size of the expanded code. -// suggest creating a runtime library that will be linked to -// the compiled executable. maybe just a small static lib for now - -/** - * Receive a list of arguments and apply them to the given function - */ -static void dispatch(int argc, function_type func, object clo, object cont, object args) { - // TODO: is this portable? may be better to have a dedicated memory area and -// just copy to it as needed - object b[argc]; // OK to do this? - int i; - for (i = 0; i < argc; i++){ - b[i] = car(args); - args = cdr(args); - } - -/* The following is based on the macro expansion code from CHICKEN's do_apply */ - -/* PTR_O_p

_(o): list of COUNT = ((2 ** P) * B) '*(b+I)' arguments, - * with offset I in range [o, o+COUNT-1]. - */ -#define PTR_O_p0_0(o) -#define PTR_O_p1_0(o) -#define PTR_O_p2_0(o) -#define PTR_O_p3_0(o) -#define PTR_O_p4_0(o) -#define PTR_O_p5_0(o) -#define PTR_O_p6_0(o) -#define PTR_O_p7_0(o) -#define PTR_O_p0_1(o) , *(b+(o)) -#define PTR_O_p1_1(o) , *(b+(o)), *(b+(o+1)) -#define PTR_O_p2_1(o) PTR_O_p1_1(o) PTR_O_p1_1(o+2) -#define PTR_O_p3_1(o) PTR_O_p2_1(o) PTR_O_p2_1(o+4) -#define PTR_O_p4_1(o) PTR_O_p3_1(o) PTR_O_p3_1(o+8) -#define PTR_O_p5_1(o) PTR_O_p4_1(o) PTR_O_p4_1(o+16) -#define PTR_O_p6_1(o) PTR_O_p5_1(o) PTR_O_p5_1(o+32) -#define PTR_O_p7_1(o) PTR_O_p6_1(o) PTR_O_p6_1(o+64) - -/* CASE_C_PROC_p0 (n0, p6,p5,p4,p3,p2,p1,p0): - * let's note = - 2; the macro inserts: - * case : ((C_cproc)pr) (, fn, k, ); - * where is: *(b+1), ..., *(b+) - * ( is empty for == 2). - * We must have: n0 = SUM (i = 7 to 0, p * (1 << i)). - * CASE_C_PROC_p (...): - * like CASE_C_PROC_p, but with doubled output... - */ -#define CASE_C_PROC_p0(n0, p6,p5,p4,p3,p2,p1,p0) \ - case (n0-2): func(n0-1, clo, cont \ -PTR_O_p6_##p6(((n0-2)&0x80)+0)\ -PTR_O_p5_##p5(((n0-2)&0xC0)+0)\ -PTR_O_p4_##p4(((n0-2)&0xE0)+0)\ -PTR_O_p3_##p3(((n0-2)&0xF0)+0)\ -PTR_O_p2_##p2(((n0-2)&0xF8)+0)\ -PTR_O_p1_##p1(((n0-2)&0xFC)+0)\ -PTR_O_p0_##p0(((n0-2)&0xFE)+0)); -#define CASE_C_PROC_p1( n0,n1, p6,p5,p4,p3,p2,p1) \ - CASE_C_PROC_p0 (n0, p6,p5,p4,p3,p2,p1,0) \ - CASE_C_PROC_p0 (n1, p6,p5,p4,p3,p2,p1,1) -#define CASE_C_PROC_p2( n0,n1,n2,n3, p6,p5,p4,p3,p2) \ - CASE_C_PROC_p1 (n0,n1, p6,p5,p4,p3,p2,0) \ - CASE_C_PROC_p1 (n2,n3, p6,p5,p4,p3,p2,1) -#define CASE_C_PROC_p3( n0,n1,n2,n3,n4,n5,n6,n7, p6,p5,p4,p3) \ - CASE_C_PROC_p2 (n0,n1,n2,n3, p6,p5,p4,p3,0) \ - CASE_C_PROC_p2 (n4,n5,n6,n7, p6,p5,p4,p3,1) - switch(argc) { - CASE_C_PROC_p3 (2,3,4,5,6,7,8,9, 0,0,0,0) - CASE_C_PROC_p3 (10,11,12,13,14,15,16,17, 0,0,0,1) - CASE_C_PROC_p3 (18,19,20,21,22,23,24,25, 0,0,1,0) - CASE_C_PROC_p3 (26,27,28,29,30,31,32,33, 0,0,1,1) - CASE_C_PROC_p3 (34,35,36,37,38,39,40,41, 0,1,0,0) - CASE_C_PROC_p3 (42,43,44,45,46,47,48,49, 0,1,0,1) - CASE_C_PROC_p3 (50,51,52,53,54,55,56,57, 0,1,1,0) - CASE_C_PROC_p3 (58,59,60,61,62,63,64,65, 0,1,1,1) - CASE_C_PROC_p0 (66, 1,0,0,0,0,0,0) - CASE_C_PROC_p0 (67, 1,0,0,0,0,0,1) - CASE_C_PROC_p1 (68,69, 1,0,0,0,0,1) - CASE_C_PROC_p2 (70,71,72,73, 1,0,0,0,1) - CASE_C_PROC_p3 (74,75,76,77,78,79,80,81, 1,0,0,1) - CASE_C_PROC_p3 (82,83,84,85,86,87,88,89, 1,0,1,0) - CASE_C_PROC_p3 (90,91,92,93,94,95,96,97, 1,0,1,1) - CASE_C_PROC_p3 (98,99,100,101,102,103,104,105, 1,1,0,0) - CASE_C_PROC_p3 (106,107,108,109,110,111,112,113, 1,1,0,1) - CASE_C_PROC_p3 (114,115,116,117,118,119,120,121, 1,1,1,0) - CASE_C_PROC_p2 (122,123,124,125, 1,1,1,1,0) - CASE_C_PROC_p1 (126,127, 1,1,1,1,1,0) - CASE_C_PROC_p0 (128, 1,1,1,1,1,1,0) - default: //barf(C_TOO_MANY_PARAMETERS_ERROR, "apply"); - // TODO: not good enough, throw an exception instead, using (error) - printf("Unhandled number of function arguments: %d\n", argc); - exit(1); - } -} - -/** - * Same as above but for a varargs C function - */ -static void dispatch_va(int argc, function_type_va func, object clo, object cont, object args) { -// TODO: DISPATCH_RETURN_CALL_FUNC - printf("TODO: implement\n"); - exit(1); -} - /* * * @param cont - Continuation for the function to call into @@ -1715,8 +1601,7 @@ static char *transport(x, gcgen) char *x; int gcgen; /* Major collection, transport objects on stack or old heap */ #define transp(p) \ temp = (p); \ -if (DEBUG_ALWAYS_GC || \ - (check_overflow(low_limit,temp) && \ +if ((check_overflow(low_limit,temp) && \ check_overflow(temp,high_limit)) || \ (check_overflow(old_heap_low_limit - 1, temp) && \ check_overflow(temp,old_heap_high_limit + 1))) \ @@ -1979,12 +1864,13 @@ static void main_main (stack_size,heap_size,stack_base) /* */ printf("main: your setjmp and/or longjmp are broken.\n"); exit(0);}} +/* static long long_arg(argc,argv,name,dval) int argc; char **argv; char *name; long dval; {int j; for(j=1;(j+1)