From: Chris Hanson Date: Mon, 9 Oct 2006 06:51:10 +0000 (+0000) Subject: Change interface to C native code to simplify porting to new X-Git-Tag: 20090517-FFI~898 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=8af2c70e44dc74f41f371d4391af0a56e01a24a4;p=mit-scheme.git Change interface to C native code to simplify porting to new microcode. --- diff --git a/v7/src/microcode/cmpauxmd/c.c b/v7/src/microcode/cmpauxmd/c.c index 90a4ad102..abce8f567 100644 --- a/v7/src/microcode/cmpauxmd/c.c +++ b/v7/src/microcode/cmpauxmd/c.c @@ -1,6 +1,6 @@ /* -*-C-*- -$Id: c.c,v 1.17 2006/09/25 04:36:56 cph Exp $ +$Id: c.c,v 1.18 2006/10/09 06:51:04 cph Exp $ Copyright 1993,2002,2006 Massachusetts Institute of Technology @@ -255,24 +255,28 @@ DEFUN (find_compiled_block, (name), char * name) } int -DEFUN (declare_compiled_data, - (name, decl_data, data_proc), +DEFUN (declare_compiled_data_ns, (name, data_proc), char * name - AND int EXFUN ((* decl_data), (void)) AND SCHEME_OBJECT * EXFUN ((* data_proc), (entry_count_t))) { entry_count_t slot = (find_compiled_block (name)); - - if (slot == max_compiled_blocks) - return (-1); - - if ((compiled_blocks_table[slot].data.errgen != uninitialized_data) - && (compiled_blocks_table[slot].data.constructor != data_proc)) + if ((slot == max_compiled_blocks) + || ((compiled_blocks_table[slot].data.errgen != uninitialized_data) + && (compiled_blocks_table[slot].data.constructor != data_proc))) return (-1); - compiled_blocks_table[slot].flags &= (~ COMPILED_BLOCK_FLAG_DATA_ONLY); compiled_blocks_table[slot].data.constructor = data_proc; - return (* decl_data) (); + return (0); +} + +int +DEFUN (declare_compiled_data, (name, decl_data, data_proc), + char * name + AND int EXFUN ((* decl_data), (void)) + AND SCHEME_OBJECT * EXFUN ((* data_proc), (entry_count_t))) +{ + int rc = (declare_compiled_data_ns (name, data_proc)); + return ((rc == 0) ? ((*decl_data) ()) : rc); } SCHEME_OBJECT @@ -293,8 +297,7 @@ DEFUN (initialize_subblock, (name), char * name) } SCHEME_OBJECT -DEFUN (initialize_C_compiled_block, (argno, name), - int argno AND char * name) +DEFUN (initialize_C_compiled_block, (argno, name), int argno AND char * name) { SCHEME_OBJECT val; entry_count_t slot; diff --git a/v7/src/microcode/compinit.c b/v7/src/microcode/compinit.c index c3457ea38..382e8d3db 100644 --- a/v7/src/microcode/compinit.c +++ b/v7/src/microcode/compinit.c @@ -1,6 +1,6 @@ /* -*-C-*- -$Id: compinit.c,v 1.7 2006/09/16 11:19:09 gjr Exp $ +$Id: compinit.c,v 1.8 2006/10/09 06:50:53 cph Exp $ Copyright (c) 1992-1999, 2006 Massachusetts Institute of Technology @@ -28,40 +28,54 @@ USA. #undef DECLARE_COMPILED_CODE #undef DECLARE_COMPILED_DATA +#undef DECLARE_COMPILED_DATA_NS #undef DECLARE_DATA_OBJECT -#define DECLARE_COMPILED_CODE(name, nentries, decl_code, code) do \ -{ \ - extern int EXFUN (decl_code, (void)); \ - extern SCHEME_OBJECT * EXFUN (code, \ - (SCHEME_OBJECT *, entry_count_t)); \ - int result = \ - (declare_compiled_code (name, nentries, decl_code, code)); \ +#define DECLARE_COMPILED_CODE(name, nentries, decl_code, code) \ +extern int EXFUN (decl_code, (void)); \ +extern SCHEME_OBJECT * EXFUN (code, (SCHEME_OBJECT *, entry_count_t)); + +#define DECLARE_COMPILED_DATA(name, decl_data, data) \ +extern int EXFUN (decl_data, (void)); \ +extern SCHEME_OBJECT * EXFUN (data, (entry_count_t)); + +#define DECLARE_COMPILED_DATA_NS(name, data) \ +extern SCHEME_OBJECT * EXFUN (data, (entry_count_t)); + +#define DECLARE_DATA_OBJECT(name, data) \ +extern SCHEME_OBJECT EXFUN (data, (void)); + +#include "compinit.h" + +#undef DECLARE_COMPILED_CODE +#undef DECLARE_COMPILED_DATA +#undef DECLARE_COMPILED_DATA_NS +#undef DECLARE_DATA_OBJECT + +#define DECLARE_COMPILED_CODE(name, nentries, decl_code, code) \ + result = (declare_compiled_code (name, nentries, decl_code, code)); \ if (result != 0) \ - return (result); \ -} while (0) - -#define DECLARE_COMPILED_DATA(name, decl_data, data) do \ -{ \ - extern int EXFUN (decl_data, (void)); \ - extern SCHEME_OBJECT * EXFUN (data, (entry_count_t)); \ - int result = (declare_compiled_data (name, decl_data, data)); \ + return (result); + +#define DECLARE_COMPILED_DATA(name, decl_data, data) \ + result = (declare_compiled_data (name, decl_data, data)); \ if (result != 0) \ - return (result); \ -} while (0) - -#define DECLARE_DATA_OBJECT(name, data) do \ -{ \ - extern SCHEME_OBJECT EXFUN (data, (void)); \ - \ - int result = (declare_data_object (name, data)); \ + return (result); + +#define DECLARE_COMPILED_DATA_NS(name, data) \ + result = (declare_compiled_data_ns (name, data)); \ + if (result != 0) \ + return (result); + +#define DECLARE_DATA_OBJECT(name, data) \ + result = (declare_data_object (name, data)); \ if (result != 0) \ - return (result); \ -} while (0) + return (result); int DEFUN_VOID (initialize_compiled_code_blocks) { + int result; #include "compinit.h" return (0); } diff --git a/v7/src/microcode/liarc.h b/v7/src/microcode/liarc.h index 1e7bd0f04..5e38a9139 100644 --- a/v7/src/microcode/liarc.h +++ b/v7/src/microcode/liarc.h @@ -1,6 +1,6 @@ /* -*-C-*- -$Id: liarc.h,v 1.22 2006/09/16 11:19:09 gjr Exp $ +$Id: liarc.h,v 1.23 2006/10/09 06:50:58 cph Exp $ Copyright (c) 1992-2002, 2006 Massachusetts Institute of Technology @@ -228,6 +228,10 @@ REGISTER SCHEME_OBJECT * lcl_membase = memory_base JUMP ((SCHEME_OBJECT *) (current_block[label])) #define POP_RETURN() goto pop_return + +#define INVOKE_PRIMITIVE_DECLS \ + SCHEME_OBJECT primitive; \ + long primitive_nargs; #define INVOKE_PRIMITIVE(prim, nargs) do \ { \ @@ -235,8 +239,9 @@ REGISTER SCHEME_OBJECT * lcl_membase = memory_base primitive_nargs = (nargs); \ goto invoke_primitive; \ } while (0) - -#define INVOKE_PRIMITIVE_CODE() do \ + +#define INVOKE_PRIMITIVE_TARGET \ +DEFLABEL (invoke_primitive) \ { \ SCHEME_OBJECT * destination; \ \ @@ -246,58 +251,86 @@ REGISTER SCHEME_OBJECT * lcl_membase = memory_base destination = (OBJECT_ADDRESS (STACK_POP ())); \ CACHE_VARIABLES (); \ JUMP (destination); \ -} while(0) - -#define INVOKE_INTERFACE_CODE() do \ -{ \ - SCHEME_OBJECT * destination; \ - \ - UNCACHE_VARIABLES (); \ - destination = (invoke_utility (utlarg_code, utlarg_1, utlarg_2, \ - utlarg_3, utlarg_4)); \ - CACHE_VARIABLES (); \ - JUMP (destination); \ -} while (0) +} + +#define INVOKE_INTERFACE_DECLS \ + int utlarg_code; \ + long utlarg_1; \ + long utlarg_2; \ + long utlarg_3; \ + long utlarg_4; -#define INVOKE_INTERFACE_4(code, one, two, three, four) do \ +#define INVOKE_INTERFACE_0(code) do \ { \ - utlarg_4 = ((long) (four)); \ - utlarg_3 = ((long) (three)); \ - utlarg_2 = ((long) (two)); \ - utlarg_1 = ((long) (one)); \ utlarg_code = (code); \ - goto invoke_interface_4; \ + goto invoke_interface_0; \ } while (0) -#define INVOKE_INTERFACE_3(code, one, two, three) do \ +#define INVOKE_INTERFACE_1(code, one) do \ { \ - utlarg_3 = ((long) (three)); \ - utlarg_2 = ((long) (two)); \ - utlarg_1 = ((long) (one)); \ utlarg_code = (code); \ - goto invoke_interface_3; \ + utlarg_1 = ((long) (one)); \ + goto invoke_interface_1; \ } while (0) #define INVOKE_INTERFACE_2(code, one, two) do \ { \ - utlarg_2 = ((long) (two)); \ - utlarg_1 = ((long) (one)); \ utlarg_code = (code); \ + utlarg_1 = ((long) (one)); \ + utlarg_2 = ((long) (two)); \ goto invoke_interface_2; \ } while (0) -#define INVOKE_INTERFACE_1(code, one) do \ +#define INVOKE_INTERFACE_3(code, one, two, three) do \ { \ - utlarg_1 = ((long) (one)); \ utlarg_code = (code); \ - goto invoke_interface_1; \ + utlarg_1 = ((long) (one)); \ + utlarg_2 = ((long) (two)); \ + utlarg_3 = ((long) (three)); \ + goto invoke_interface_3; \ } while (0) -#define INVOKE_INTERFACE_0(code) do \ +#define INVOKE_INTERFACE_4(code, one, two, three, four) do \ { \ utlarg_code = (code); \ - goto invoke_interface_0; \ + utlarg_1 = ((long) (one)); \ + utlarg_2 = ((long) (two)); \ + utlarg_3 = ((long) (three)); \ + utlarg_4 = ((long) (four)); \ + goto invoke_interface_4; \ } while (0) + +#define INVOKE_INTERFACE_TARGET_0 \ +DEFLABEL (invoke_interface_0) \ + utlarg_1 = 0; \ + INVOKE_INTERFACE_TARGET_1 + +#define INVOKE_INTERFACE_TARGET_1 \ +DEFLABEL (invoke_interface_1) \ + utlarg_2 = 0; \ + INVOKE_INTERFACE_TARGET_2 + +#define INVOKE_INTERFACE_TARGET_2 \ +DEFLABEL (invoke_interface_2) \ + utlarg_3 = 0; \ + INVOKE_INTERFACE_TARGET_3 + +#define INVOKE_INTERFACE_TARGET_3 \ +DEFLABEL (invoke_interface_3) \ + utlarg_4 = 0; \ + INVOKE_INTERFACE_TARGET_4 + +#define INVOKE_INTERFACE_TARGET_4 \ +DEFLABEL (invoke_interface_4) \ +{ \ + SCHEME_OBJECT * destination; \ + \ + UNCACHE_VARIABLES (); \ + destination = (invoke_utility (utlarg_code, utlarg_1, utlarg_2, \ + utlarg_3, utlarg_4)); \ + CACHE_VARIABLES (); \ + JUMP (destination); \ +} #define MAX_BIT_SHIFT DATUM_LENGTH @@ -380,19 +413,17 @@ struct liarc_data_S SCHEME_OBJECT * EXFUN ((* data), (entry_count_t)); }; -#define DECLARE_SUBCODE(name, nentries, decl_code, code) do \ +#define DECLARE_SUBCODE(name, nentries, code) do \ { \ - int result = (declare_compiled_code (name, nentries, \ - decl_code, code)); \ - \ + int result \ + = (declare_compiled_code (name, nentries, NO_SUBBLOCKS, code)); \ if (result != 0) \ return (result); \ } while (0) -#define DECLARE_SUBDATA(name, decl_data, data) do \ +#define DECLARE_SUBDATA(name, data) do \ { \ - int result = (declare_compiled_data (name, decl_data, data)); \ - \ + int result = (declare_compiled_data (name, NO_SUBBLOCKS, data)); \ if (result != 0) \ return (result); \ } while (0) @@ -419,84 +450,73 @@ struct liarc_data_S #ifndef COMPILE_FOR_DYNAMIC_LOADING -/* This does nothing in the sources. */ - -# define DECLARE_COMPILED_CODE(name, nentries, decl_code, code) \ - extern int EXFUN (decl_code, (void)); \ - extern SCHEME_OBJECT * EXFUN (code, (SCHEME_OBJECT *, entry_count_t)); - -# define DECLARE_COMPILED_DATA(name, decl_data, data) \ - extern int EXFUN (decl_data, (void)); \ - extern SCHEME_OBJECT * EXFUN (data, (entry_count_t)); - -# define DECLARE_DATA_OBJECT(name, data) \ - extern SCHEME_OBJECT EXFUN (data, (void)); - -# define DECLARE_DYNAMIC_INITIALIZATION(name) - -# define DECLARE_DYNAMIC_OBJECT_INITIALIZATION(name) +#define DECLARE_COMPILED_CODE(name, nentries, decl_code, code) +#define DECLARE_COMPILED_DATA(name, decl_data, data) +#define DECLARE_COMPILED_DATA_NS(name, data) +#define DECLARE_DATA_OBJECT(name, data) +#define DECLARE_DYNAMIC_INITIALIZATION(name) +#define DECLARE_DYNAMIC_OBJECT_INITIALIZATION(name) #else /* COMPILE_FOR_DYNAMIC_LOADING */ -# define DECLARE_COMPILED_CODE(name, nentries, decl_code, code) \ - static int \ - DEFUN_VOID (dload_initialize_code) \ - { \ - int EXFUN (decl_code, (void)); \ - SCHEME_OBJECT * EXFUN (code, (SCHEME_OBJECT *, entry_count_t)); \ - \ - return (declare_compiled_code (name, nentries, \ - decl_code, code)); \ - } - -# define DECLARE_COMPILED_DATA(name, decl_data, data) \ - static int \ - DEFUN_VOID (dload_initialize_data) \ - { \ - int EXFUN (decl_data, (void)); \ - SCHEME_OBJECT * EXFUN (data, (entry_count_t)); \ - \ - return (declare_compiled_data (name, decl_data, data)); \ - } - -# define DECLARE_DATA_OBJECT(name, data) \ - static int \ - DEFUN_VOID (dload_initialize_data) \ - { \ - SCHEME_OBJECT EXFUN (data, (void)); \ - \ - return (declare_data_object (name, data)); \ - } +#define DECLARE_COMPILED_CODE(name, nentries, decl_code, code) \ +int EXFUN (decl_code, (void)); \ +SCHEME_OBJECT * EXFUN (code, (SCHEME_OBJECT *, entry_count_t)); \ +static int \ +DEFUN_VOID (dload_initialize_code) \ +{ \ + return (declare_compiled_code (name, nentries, decl_code, code)); \ +} + +#define DECLARE_COMPILED_DATA(name, decl_data, data) \ +int EXFUN (decl_data, (void)); \ +SCHEME_OBJECT * EXFUN (data, (entry_count_t)); \ +static int \ +DEFUN_VOID (dload_initialize_data) \ +{ \ + return (declare_compiled_data (name, decl_data, data)); \ +} + +#define DECLARE_COMPILED_DATA_NS(name, data) \ +SCHEME_OBJECT * EXFUN (data, (entry_count_t)); \ +static int \ +DEFUN_VOID (dload_initialize_data) \ +{ \ + return (declare_compiled_data_ns (name, data)); \ +} +#define DECLARE_DATA_OBJECT(name, data) \ +SCHEME_OBJECT EXFUN (data, (void)); \ +static int \ +DEFUN_VOID (dload_initialize_data) \ +{ \ + return (declare_data_object (name, data)); \ +} -# define DECLARE_DYNAMIC_INITIALIZATION(name) \ - extern char * EXFUN (dload_initialize_file, (void)); \ - \ - char * \ - DEFUN_VOID (dload_initialize_file) \ - { \ - int result = (dload_initialize_code ()); \ - if (result != 0) \ - return ((char *) NULL); \ - result = (dload_initialize_data ()); \ - if (result != 0) \ - return ((char *) NULL); \ - else \ - return (name); \ - } - -# define DECLARE_DYNAMIC_OBJECT_INITIALIZATION(name) \ - extern char * EXFUN (dload_initialize_file, (void)); \ - \ - char * \ - DEFUN_VOID (dload_initialize_file) \ - { \ - int result = (dload_initialize_data ()); \ - if (result != 0) \ - return ((char *) NULL); \ - else \ - return (name); \ - } +#define DECLARE_DYNAMIC_INITIALIZATION(name) \ +char * \ +DEFUN_VOID (dload_initialize_file) \ +{ \ + int result = (dload_initialize_code ()); \ + if (result != 0) \ + return ((char *) NULL); \ + result = (dload_initialize_data ()); \ + if (result != 0) \ + return ((char *) NULL); \ + else \ + return (name); \ +} + +#define DECLARE_DYNAMIC_OBJECT_INITIALIZATION(name) \ +char * \ +DEFUN_VOID (dload_initialize_file) \ +{ \ + int result = (dload_initialize_data ()); \ + if (result != 0) \ + return ((char *) NULL); \ + else \ + return (name); \ +} #endif /* COMPILE_FOR_DYNAMIC_LOADING */ @@ -519,6 +539,9 @@ extern int (char *, int EXFUN ((*), (void)), SCHEME_OBJECT * EXFUN ((*), (entry_count_t)))), + EXFUN (declare_compiled_data_ns, + (char *, + SCHEME_OBJECT * EXFUN ((*), (entry_count_t)))), EXFUN (declare_data_object, (char *, SCHEME_OBJECT EXFUN ((*), (void)))), diff --git a/v7/src/microcode/makegen/Makefile.in.in b/v7/src/microcode/makegen/Makefile.in.in index 15bd3f30c..e10ce1920 100644 --- a/v7/src/microcode/makegen/Makefile.in.in +++ b/v7/src/microcode/makegen/Makefile.in.in @@ -1,6 +1,6 @@ # -*- Makefile -*- # -# $Id: Makefile.in.in,v 1.33 2006/10/01 21:00:46 cph Exp $ +# $Id: Makefile.in.in,v 1.34 2006/10/09 06:51:10 cph Exp $ # # Copyright 2000,2001,2002,2003,2005,2006 Massachusetts Institute of Technology # @@ -374,11 +374,11 @@ $(GC_HEAD_FILES) compinit.h: $(COMPILED_SOURCES) liarc.tch Makefile rm -f $@ grep \^DECLARE_COMPILED_CODE liarc.tch $(COMPILED_SOURCES) \ - | sed -e 's/.*:/ /' -e 's/)/);/' > $@ + | sed -e 's/.*:/ /' > $@ grep \^DECLARE_COMPILED_DATA liarc.tch $(COMPILED_SOURCES) \ - | sed -e 's/.*:/ /' -e 's/)/);/' >> $@ + | sed -e 's/.*:/ /' >> $@ grep \^DECLARE_DATA_OBJECT liarc.tch $(COMPILED_SOURCES) \ - | sed -e 's/.*:/ /' -e 's/)/);/' >> $@ + | sed -e 's/.*:/ /' >> $@ foo $(COMPILED_OBJECTS): liarc.tch liarc.tch: liarc.h $(LIARC_HEAD_FILES)