diff -ruN klic-3.003-2002-03-19a/include/klic/bb.h klic-3.003-2002-03-20/include/klic/bb.h --- klic-3.003-2002-03-19a/include/klic/bb.h Fri Feb 22 09:24:09 2002 +++ klic-3.003-2002-03-20/include/klic/bb.h Wed Mar 20 15:35:27 2002 @@ -8,6 +8,8 @@ #ifndef _KLIC_BB_H_ #define _KLIC_BB_H_ +#include /* G_method_table0 */ + /* Addition */ @@ -427,12 +429,12 @@ */ extern q bblt_fix_2(q x); +extern struct data_object_method_table G_method_table0(float); #define bblt_fix(x, z) \ do{ \ - extern struct data_object_method_table TableName(float); \ if (!isfunctor(x) || !isgobj(x) || \ - functor_of(x) != (q) &TableName(float)) { \ + functor_of(x) != (q) &G_method_table0(float) ){ \ (z) = bblt_fix_2(x); \ } else { \ (z) = makeint((long) (float_value(x))); \ diff -ruN klic-3.003-2002-03-19a/include/klic/g_basic.h klic-3.003-2002-03-20/include/klic/g_basic.h --- klic-3.003-2002-03-19a/include/klic/g_basic.h Tue Mar 19 18:21:24 2002 +++ klic-3.003-2002-03-20/include/klic/g_basic.h Wed Mar 20 15:35:27 2002 @@ -50,6 +50,14 @@ #define G_guard0(class,fa) CONCATENATE_3(class, _g_guard_, fa) #define G_body0(class,fa) CONCATENATE_3(class, _g_body_, fa) +#define G_rappend(pref) G_rappend0(CLASS_NAME, pref) + +#define G_method_table0(class) G_rappend0(class, method_table) + +#define G_method_table G_method_table0(CLASS_NAME) + +#define G_CLASS_NAME_STRING G_stringify(CLASS_NAME) + /** G_HEAPALLOC: procedure * from: type& diff -ruN klic-3.003-2002-03-19a/include/klic/g_extern.h klic-3.003-2002-03-20/include/klic/g_extern.h --- klic-3.003-2002-03-19a/include/klic/g_extern.h Tue Mar 19 18:21:24 2002 +++ klic-3.003-2002-03-20/include/klic/g_extern.h Wed Mar 20 15:35:27 2002 @@ -15,8 +15,6 @@ extern void general_print( q* a, FILE* stream, unsigned long depth, unsigned long length ); -extern struct data_object_method_table argblock_object_method_table; - /* runtime/gen.c */ extern struct predicate predicate_generic_xnew_3; diff -ruN klic-3.003-2002-03-19a/include/klic/g_float.h klic-3.003-2002-03-20/include/klic/g_float.h --- klic-3.003-2002-03-19a/include/klic/g_float.h Thu Dec 27 19:15:58 2001 +++ klic-3.003-2002-03-20/include/klic/g_float.h Wed Mar 20 15:37:48 2002 @@ -13,8 +13,7 @@ double value; } float_structure_type; -#define declare_float_constant(value) \ -{ &float_g_data_method_table, (value) } +#define declare_float_constant(value) {&float_g_method_table, (value)} #define makefloat(x) makefunctor(&(x)) #define float_value(x) (((float_structure_type *) functorp(x))->value) diff -ruN klic-3.003-2002-03-19a/include/klic/g_string.h klic-3.003-2002-03-20/include/klic/g_string.h --- klic-3.003-2002-03-19a/include/klic/g_string.h Thu Dec 27 19:15:58 2001 +++ klic-3.003-2002-03-20/include/klic/g_string.h Wed Mar 20 15:38:24 2002 @@ -29,7 +29,7 @@ #define declare_string_constant_8(body, length) \ { \ - &byte__string_g_data_method_table, \ + &byte__string_g_method_table, \ STRING_SHALLOW_MARK, /* next */ \ (length), /* index */ \ 1, /* iscnst */ \ diff -ruN klic-3.003-2002-03-19a/include/klic/g_vector.h klic-3.003-2002-03-20/include/klic/g_vector.h --- klic-3.003-2002-03-19a/include/klic/g_vector.h Tue Mar 12 12:30:16 2002 +++ klic-3.003-2002-03-20/include/klic/g_vector.h Wed Mar 20 15:38:34 2002 @@ -26,7 +26,7 @@ #define declare_vector_constant(body, length) \ { \ - &vector_g_data_method_table, \ + &vector_g_method_table, \ VECTOR_SHALLOW_MARK, /* next */ \ (length), /* index */ \ 1, /* iscnst */ \ diff -ruN klic-3.003-2002-03-19a/include/klic/gb.h klic-3.003-2002-03-20/include/klic/gb.h --- klic-3.003-2002-03-19a/include/klic/gb.h Tue Mar 12 12:08:47 2002 +++ klic-3.003-2002-03-20/include/klic/gb.h Wed Mar 20 15:35:27 2002 @@ -11,6 +11,7 @@ #include /* CONCATENATE */ #include /* functoratom, arityof */ #include /* check_stack_for_alternatively */ +#include /* G_method_table0 */ /* runtime/cmphsh.c */ extern q builtin_compare_terms(q x, q y); @@ -185,12 +186,10 @@ /* Generic Object Manipulation */ -#define TableName(x) CONCATENATE(x, _g_data_method_table) - #define jump_if_not_in_class(x, class, lab) \ do{ \ - extern struct data_object_method_table TableName(class); \ - if (!isgobj(x) || functor_of(x) != (q) &TableName(class)) \ + extern struct data_object_method_table G_method_table0(class); \ + if (!isgobj(x) || functor_of(x) != (q) &G_method_table0(class)) \ goto lab; \ }while(0) diff -ruN klic-3.003-2002-03-19a/include/klic/gc_macro.h klic-3.003-2002-03-20/include/klic/gc_macro.h --- klic-3.003-2002-03-19a/include/klic/gc_macro.h Tue Mar 19 18:21:24 2002 +++ klic-3.003-2002-03-20/include/klic/gc_macro.h Wed Mar 20 15:35:27 2002 @@ -10,6 +10,7 @@ #include /* CONCATENATE */ #include /* fatal, debug_printf, klic_fprintf, klic_putc */ +#include extern q GC_wakeup_g_new(); @@ -24,20 +25,11 @@ q* var, struct goalrec** goalp1, q(*myself)(), unsigned long argc, q argv[] ); -#define GC_rappend(pref) G_rappend0(GC_CLASS_NAME(),pref) - /* runtime/generic.c */ extern q GC_MAKE_HOOK_VAR(struct consumer_object* obj); -#define GC_method_table0(class) CONCATENATE(class, _g_data_method_table) - -#define GC_method_table GC_method_table0(GC_CLASS_NAME()) - -#define GC_CLASS_NAME_STRING G_stringify(GC_CLASS_NAME()) - -#define GC_FAIL(errmsg) fatal(errmsg) #define GC_ERROR_IN_NEW(errmsg) \ - G_error((errmsg), "creation", "consumer", GC_CLASS_NAME_STRING) + G_error((errmsg), "creation", "consumer", G_CLASS_NAME_STRING) #define GC_RETURN_WITH_HOOK(x) \ do{ \ @@ -115,7 +107,7 @@ /**************************************************************************/ #define GCset_myself_for_new \ - q (*g_myself)() = GC_rappend(new) + q (*g_myself)() = G_rappend(new) #define GC_STD_DECL_FOR_NEW \ G_STD_DECL; \ @@ -123,7 +115,7 @@ #define GCDEF_NEW() \ -extern q GC_rappend(new) (long GC_ARGC, q* GC_ARGV) +extern q G_rappend(new) (long GC_ARGC, q* GC_ARGV) #define GC_DEREF_FOR_NEW(x) \ do{ \ @@ -161,7 +153,7 @@ G_PUSH_GOAL_TO_SPECIAL_QUEUE(goal); \ GC_RETURN_FROM_NEW(var); \ } \ - (newgobj)->method_table = &GC_method_table; \ + (newgobj)->method_table = &G_method_table; \ }while(0) #define GC_RETURN_FROM_NEW(x) \ @@ -173,7 +165,7 @@ /**********************************************************************/ #define GCDEF_UNIFY() \ -static void GC_rappend(active_unify) (GC_OBJ_TYPE* GC_SELF, q GC_TERM) +static void G_rappend(active_unify) (GC_OBJ_TYPE* GC_SELF, q GC_TERM) #define GC_PRINT(x) klic_fprintf(g_fp, (x)) @@ -182,7 +174,7 @@ #define GCDEF_PRINT() \ static \ long \ - GC_rappend(print) (GC_SELF,g_fp,g_depth,g_length) \ + G_rappend(print) (GC_SELF,g_fp,g_depth,g_length) \ GC_OBJ_TYPE *GC_SELF; \ FILE *g_fp; \ unsigned long g_depth; \ @@ -191,7 +183,7 @@ /******************************************************************/ #define GCDEF_GC() \ -static q* GC_rappend(gc) (GC_OBJ_TYPE* GC_SELF) +static q* G_rappend(gc) (GC_OBJ_TYPE* GC_SELF) #define GCSET_NEWOBJ_IN_NEWGEN(newobj) \ do{ \ @@ -208,7 +200,7 @@ #define GCDEF_DEALLOCATE() \ static void \ - GC_rappend(deallocate) (GC_SELF) \ + G_rappend(deallocate) (GC_SELF) \ GC_OBJ_TYPE* GC_SELF; /*******************************************/ @@ -254,7 +246,7 @@ while (!G_ISGOBJ(temp) || \ (struct data_object_method_table *) \ G_FUNCTOR_OF(temp) != \ - &byte__string_g_data_method_table) { \ + &byte__string_g_method_table) { \ if (G_ISREF(temp)) { \ q temp1 = G_DEREFONE(temp); \ if (G_ISREF(temp1) && G_DEREFONE(temp1) == temp) { \ diff -ruN klic-3.003-2002-03-19a/include/klic/gc_methtab.h klic-3.003-2002-03-20/include/klic/gc_methtab.h --- klic-3.003-2002-03-19a/include/klic/gc_methtab.h Mon Mar 11 14:02:55 2002 +++ klic-3.003-2002-03-20/include/klic/gc_methtab.h Wed Mar 20 15:35:27 2002 @@ -15,36 +15,35 @@ #define GC_STD_DEALLOCATE GD_STD_DEALLOCATE #define GC_STD_ENCODE GD_STD_ENCODE -struct consumer_object_method_table GC_method_table - = { +struct consumer_object_method_table G_method_table = { #ifndef GCUSE_MY_UNIFY #error "please GCDEF_UNIFY and GCUSE_MY_UNIFY" #else - GC_rappend(active_unify) , + G_rappend(active_unify) , #endif #ifndef GCUSE_MY_PRINT #error "please GCDEF_PRINT and GCUSE_MY_PRINT" #else - GC_rappend(print) , + G_rappend(print) , #endif #ifndef GCUSE_MY_GC #error "please GCDEF_GC and GCUSE_MY_GC" #else - GC_rappend(gc) , + G_rappend(gc) , #endif #ifndef GCUSE_MY_DEALLOCATE GC_STD_DEALLOCATE , #else - GC_rappend(deallocate) , + G_rappend(deallocate) , #endif #ifndef GCUSE_MY_ENCODE GC_STD_ENCODE #else - GC_rappend(encode) + G_rappend(encode) #endif }; diff -ruN klic-3.003-2002-03-19a/include/klic/gd_macro.h klic-3.003-2002-03-20/include/klic/gd_macro.h --- klic-3.003-2002-03-19a/include/klic/gd_macro.h Tue Mar 19 18:25:09 2002 +++ klic-3.003-2002-03-20/include/klic/gd_macro.h Wed Mar 20 15:35:27 2002 @@ -11,6 +11,7 @@ #include /* CONCATENATE */ #include /* functors, arities */ #include /* fatal, klic_fprintf, klic_putc */ +#include /* runtime/unify2.c */ extern q eq_terms_body(q x, q y); @@ -33,27 +34,20 @@ extern void G_SUSPEND(q x, struct goalrec* goal); -#define GD_rappend(pref) G_rappend0(GD_CLASS_NAME(),pref) -#define GD_guard(fa) G_guard0(GD_CLASS_NAME(),fa) -#define GD_body(fa) G_body0(GD_CLASS_NAME(),fa) +#define GD_guard(fa) G_guard0(CLASS_NAME,fa) +#define GD_body(fa) G_body0(CLASS_NAME,fa) #define GD_OBJ(x) G_MAKEFUNCTOR(x) -#define GD_method_table0(class) CONCATENATE(class, _g_data_method_table) -#define GD_method_table GD_method_table0(GD_CLASS_NAME()) - #define GD_USE_CLASS(class) \ -extern struct data_object_method_table GD_method_table0(class) - -#define GD_CLASS_NAME_STRING G_stringify(GD_CLASS_NAME()) +extern struct data_object_method_table G_method_table0(class) -#define GD_FAIL(errmsg) fatal(errmsg) #define GD_UNIFY_FAIL \ - G_error("Failure", "active unification", "data", GD_CLASS_NAME_STRING) + G_error("Failure", "active unification", "data", G_CLASS_NAME_STRING) #define GD_ERROR_IN_NEW(errmsg) \ - G_error((errmsg), "creation", "data", GD_CLASS_NAME_STRING) + G_error((errmsg), "creation", "data", G_CLASS_NAME_STRING) #define GD_ERROR_IN_METHOD(errmsg, methodname) \ - G_error((errmsg), (methodname), "data", GD_CLASS_NAME_STRING) + G_error((errmsg), (methodname), "data", G_CLASS_NAME_STRING) #define GD_GRETURN(x) do{ return (q) (x); }while(0) @@ -101,7 +95,7 @@ G_PUSH_GOAL_TO_SPECIAL_QUEUE(goal); \ GD_SUSPEND_NEW(var); \ } \ - (newgobj)->method_table = &GD_method_table; \ + (newgobj)->method_table = &G_method_table; \ }while(0) #define GDSET_NEWOBJ(newgobj) \ @@ -201,7 +195,7 @@ /**************************************************************************/ #define GDDEF_NEW() \ -extern q GD_rappend(new) (long GD_ARGC, q* GD_ARGV) +extern q G_rappend(new) (long GD_ARGC, q* GD_ARGV) #define GD_SUSPEND_NEW(v) \ do{ \ @@ -218,7 +212,7 @@ GDset_myself_for_new #define GDset_myself_for_new \ - q (*g_myself)() = GD_rappend(new) + q (*g_myself)() = G_rappend(new) /**************************************************************************/ #define GD_GUNIFY(x,y) eq_terms_body(x,y) @@ -269,13 +263,13 @@ /**********************************************************************/ #define GDDEF_GUNIFY() \ static q \ - GD_rappend(passive_unify) (GD_SELF, GD_OTHER) \ + G_rappend(passive_unify) (GD_SELF, GD_OTHER) \ GD_OBJ_TYPE * GD_SELF; \ GD_OBJ_TYPE * GD_OTHER; #define GDDEF_UNIFY() \ static void \ -GD_rappend(active_unify) (GD_OBJ_TYPE* GD_SELF, GD_OBJ_TYPE* GD_OTHER) +G_rappend(active_unify) (GD_OBJ_TYPE* GD_SELF, GD_OBJ_TYPE* GD_OTHER) #define GD_PUTC(x) klic_putc((x), g_fp) @@ -283,7 +277,7 @@ #define GDDEF_PRINT() \ static long \ - GD_rappend(print) (GD_SELF,g_fp,g_depth,g_length) \ + G_rappend(print) (GD_SELF,g_fp,g_depth,g_length) \ GD_OBJ_TYPE * GD_SELF; \ FILE *g_fp; \ unsigned long g_depth; \ @@ -311,17 +305,17 @@ #define GDDEF_COMPARE() \ static q \ - GD_rappend(compare) (GD_SELF,GD_OTHER) \ + G_rappend(compare) (GD_SELF,GD_OTHER) \ GD_OBJ_TYPE * GD_SELF, * GD_OTHER; #define GDDEF_HASH() \ static q \ - GD_rappend(hash) (GD_SELF,GD_LEVEL) \ + G_rappend(hash) (GD_SELF,GD_LEVEL) \ GD_OBJ_TYPE * GD_SELF; \ long GD_LEVEL; #define GDDEF_GC() \ -static q* GD_rappend(gc) (GD_OBJ_TYPE* GD_SELF) +static q* G_rappend(gc) (GD_OBJ_TYPE* GD_SELF) #define GD_RETURN_FROM_GC(newgobj) \ do{ \ @@ -330,18 +324,18 @@ #define GDDEF_DEALLOCATE() \ static void \ - GD_rappend(deallocate) (GD_SELF) \ + G_rappend(deallocate) (GD_SELF) \ GD_OBJ_TYPE* GD_SELF; #define GDDEF_GENERIC() \ static void \ -GD_rappend(generic) (GD_OBJ_TYPE* GD_SELF, long g_method_functor, q* GD_ARGV) +G_rappend(generic) (GD_OBJ_TYPE* GD_SELF, long g_method_functor, q* GD_ARGV) /**********************************************************************/ /* guard utility */ #define GDDEF_GGENERIC() \ static q \ - GD_rappend(guard_generic) (GD_SELF,g_method_functor,GD_ARGV) \ + G_rappend(guard_generic) (GD_SELF,g_method_functor,GD_ARGV) \ GD_OBJ_TYPE * GD_SELF; \ long g_method_functor; \ q GD_ARGV[]; @@ -411,7 +405,8 @@ /*******************************************/ #define GD_IS_CLASS(class,obj) \ - ((struct data_object_method_table *)(&(GD_method_table0(class))) == ((struct data_object_method_table *)functor_of(obj))) + ( (struct data_object_method_table*) &G_method_table0(class) == \ + (struct data_object_method_table*) functor_of(obj) ) #define GD_CALL_GMETHOD(obj,method,argv) \ ((q) ((((struct data_object *)functorp(obj))->method_table)->g_generic) \ @@ -420,7 +415,7 @@ #define GDDEF_ENCODE() \ q \ - GD_rappend(encode) (GD_SELF,buffer,depth) \ + G_rappend(encode) (GD_SELF,buffer,depth) \ GD_OBJ_TYPE * GD_SELF; \ combuf *buffer; \ long depth; diff -ruN klic-3.003-2002-03-19a/include/klic/gd_methtab.h klic-3.003-2002-03-20/include/klic/gd_methtab.h --- klic-3.003-2002-03-19a/include/klic/gd_methtab.h Tue Mar 19 14:26:10 2002 +++ klic-3.003-2002-03-20/include/klic/gd_methtab.h Wed Mar 20 15:35:27 2002 @@ -36,66 +36,65 @@ extern q GD_STD_ENCODE(struct data_object* self, void* buffer); -struct data_object_method_table GD_method_table - = { +struct data_object_method_table G_method_table = { #ifndef GDUSE_MY_GUNIFY GD_STD_GUNIFY , #else - GD_rappend(passive_unify) , + G_rappend(passive_unify) , #endif #ifndef GDUSE_MY_UNIFY GD_STD_UNIFY , #else - GD_rappend(active_unify) , + G_rappend(active_unify) , #endif #ifndef GDUSE_MY_PRINT GD_STD_PRINT , #else - GD_rappend(print) , + G_rappend(print) , #endif #ifndef GDUSE_MY_GC GD_STD_GC , #else - GD_rappend(gc) , + G_rappend(gc) , #endif #ifndef GDUSE_MY_DEALLOCATE GD_STD_DEALLOCATE , #else - GD_rappend(deallocate) , + G_rappend(deallocate) , #endif #ifndef GDUSE_MY_GENERIC GD_STD_GENERIC , #else - GD_rappend(generic) , + G_rappend(generic) , #endif #ifndef GDUSE_MY_GGENERIC GD_STD_GGENERIC , #else - GD_rappend(guard_generic) , + G_rappend(guard_generic) , #endif #ifndef GDUSE_MY_COMPARE GD_STD_COMPARE , #else - GD_rappend(compare) , + G_rappend(compare) , #endif #ifndef GDUSE_MY_HASH GD_STD_HASH , #else - GD_rappend(hash) , + G_rappend(hash) , #endif #ifndef GDUSE_MY_ENCODE GD_STD_ENCODE , #else - GD_rappend(encode) , + G_rappend(encode) , #endif }; diff -ruN klic-3.003-2002-03-19a/include/klic/generic.h klic-3.003-2002-03-20/include/klic/generic.h --- klic-3.003-2002-03-19a/include/klic/generic.h Tue Mar 12 12:28:24 2002 +++ klic-3.003-2002-03-20/include/klic/generic.h Wed Mar 20 15:35:27 2002 @@ -9,6 +9,7 @@ #define _KLIC_GENERIC_H_ #include /* CONCATENATE */ +#include /* G_method_table0 */ #include /* runtime/generic.c */ @@ -48,14 +49,10 @@ #define isgobj(x) (isref(functor_of(x))) -#define data_object_method_table_of(class) \ - CONCATENATE(class, _g_data_method_table) - #define isclass(x, class) \ - ((struct data_object_method_table *)(functor_of(x)) == \ - &data_object_method_table_of(class)) + ((struct data_object_method_table*) functor_of(x) == &G_method_table0(class)) #define declare_method_table_of(class) \ - extern struct data_object_method_table data_object_method_table_of(class) + extern struct data_object_method_table G_method_table0(class) #endif /* _KLIC_GENERIC_H_ */ diff -ruN klic-3.003-2002-03-19a/include/klic/gg_macro.h klic-3.003-2002-03-20/include/klic/gg_macro.h --- klic-3.003-2002-03-19a/include/klic/gg_macro.h Tue Mar 19 18:21:24 2002 +++ klic-3.003-2002-03-20/include/klic/gg_macro.h Wed Mar 20 15:35:27 2002 @@ -27,18 +27,8 @@ extern q GG_MAKE_HOOK_VAR(struct generator_object* obj); -#define GG_rappend(pref) G_rappend0(GG_CLASS_NAME(),pref) - #define GG_OBJ_SIZE G_SIZE_IN_Q(GG_OBJ_TYPE) -#define GG_method_table0(class) CONCATENATE(class, _g_generator_method_table) - -#define GG_method_table GG_method_table0(GG_CLASS_NAME()) - -#define GG_CLASS_NAME_STRING G_stringify(GG_CLASS_NAME()) - -#define GG_FAIL(errmsg) fatal(errmsg) - #define GG_TERMINATE do{ return !0; }while(0) #define GG_SUSPEND(var) \ @@ -111,13 +101,13 @@ /**************************************************************************/ #define GGset_myself_for_new \ - q (*g_myself)() = GG_rappend(new) + q (*g_myself)() = G_rappend(new) #define GG_STD_DECL_FOR_NEW \ G_STD_DECL; GGset_myself_for_new #define GGDEF_NEW() \ -extern q GG_rappend(new) (long GG_ARGC, q* GG_ARGV) +extern q G_rappend(new) (long GG_ARGC, q* GG_ARGV) #define GG_DEREF_FOR_NEW(x) \ do{ \ @@ -154,7 +144,7 @@ G_PUSH_GOAL_TO_SPECIAL_QUEUE(goal); \ GG_RETURN_FROM_NEW(var); \ } \ - (newgobj)->method_table = &GG_method_table; \ + (newgobj)->method_table = &G_method_table; \ }while(0) #define GG_RETURN_FROM_NEW(var) \ @@ -165,21 +155,21 @@ /**********************************************************************/ #define GGDEF_UNIFY() \ -static int GG_rappend(active_unify) (q GG_SELF, q GG_TERM) +static int G_rappend(active_unify) (q GG_SELF, q GG_TERM) #define GGDEF_SUSPEND() \ static q \ -GG_rappend(suspend) (GG_SELF, GG_GOAL) \ +G_rappend(suspend) (GG_SELF, GG_GOAL) \ q GG_SELF; \ struct goalrec* GG_GOAL; #define GGDEF_GENERATE() \ -static q GG_rappend(generate) (GG_OBJ_TYPE* GG_SELF) +static q G_rappend(generate) (GG_OBJ_TYPE* GG_SELF) #define GGDEF_PRINT() \ static \ long \ - GG_rappend(print) (GG_SELF,g_fp,g_depth,g_length) \ + G_rappend(print) (GG_SELF,g_fp,g_depth,g_length) \ GG_OBJ_TYPE *GG_SELF; \ FILE *g_fp; \ unsigned long g_depth; \ @@ -189,7 +179,7 @@ #define GGDEF_GC() \ -static q* GG_rappend(gc) (GG_OBJ_TYPE* GG_SELF) +static q* G_rappend(gc) (GG_OBJ_TYPE* GG_SELF) #define GGSET_NEWOBJ_IN_NEWGEN(newobj) \ do{ \ @@ -206,7 +196,7 @@ #define GGDEF_DEALLOCATE() \ static void \ - GG_rappend(deallocate) (GG_SELF) \ + G_rappend(deallocate) (GG_SELF) \ GG_OBJ_TYPE* GG_SELF; /*******************************************/ @@ -214,7 +204,7 @@ #define GGSET_INTARG_FOR_NEW(var,argv_i) \ do{ \ GG_DEREF_FOR_NEW(argv_i); \ - if(!G_ISINT(argv_i)) GG_FAIL("not integer"); \ + if(!G_ISINT(argv_i)) fatal("not integer"); \ (var) = G_INTVAL(argv_i); \ }while(0) @@ -233,7 +223,7 @@ #define GGDEF_ENCODE() \ static q \ - GG_rappend(encode) (GG_SELF, buffer, depth)\ + G_rappend(encode) (GG_SELF, buffer, depth)\ GG_OBJ_TYPE *GG_SELF;\ combuf *buffer;\ long depth; diff -ruN klic-3.003-2002-03-19a/include/klic/gg_methtab.h klic-3.003-2002-03-20/include/klic/gg_methtab.h --- klic-3.003-2002-03-19a/include/klic/gg_methtab.h Mon Mar 11 13:59:03 2002 +++ klic-3.003-2002-03-20/include/klic/gg_methtab.h Wed Mar 20 15:35:27 2002 @@ -17,48 +17,47 @@ #define GG_STD_DEALLOCATE GD_STD_DEALLOCATE #define GG_STD_ENCODE GD_STD_ENCODE -struct generator_object_method_table GG_method_table - = { +struct generator_object_method_table G_method_table = { #ifndef GGUSE_MY_UNIFY #error "please GGDEF_UNIFY and GGUSE_MY_UNIFY" #else - GG_rappend(active_unify) , + G_rappend(active_unify) , #endif #ifndef GGUSE_MY_GENERATE #error "please GGDEF_GENERATE and GGUSE_MY_GENERATE" #else - GG_rappend(generate) , + G_rappend(generate) , #endif #ifndef GGUSE_MY_SUSPEND GG_STD_SUSPEND, #else - GG_rappend(suspend) , + G_rappend(suspend) , #endif #ifndef GGUSE_MY_PRINT #error "please GGDEF_PRINT and GGUSE_MY_PRINT" #else - GG_rappend(print) , + G_rappend(print) , #endif #ifndef GGUSE_MY_GC #error "please GGDEF_GC and GGUSE_MY_GC" #else - GG_rappend(gc) , + G_rappend(gc) , #endif #ifndef GGUSE_MY_DEALLOCATE GG_STD_DEALLOCATE , #else - GG_rappend(deallocate) , + G_rappend(deallocate) , #endif #ifndef GGUSE_MY_ENCODE GG_STD_ENCODE #else - GG_rappend(encode) + G_rappend(encode) #endif }; diff -ruN klic-3.003-2002-03-19a/include/klic/gmodule.h klic-3.003-2002-03-20/include/klic/gmodule.h --- klic-3.003-2002-03-19a/include/klic/gmodule.h Sat Dec 29 12:46:20 2001 +++ klic-3.003-2002-03-20/include/klic/gmodule.h Wed Mar 20 15:38:52 2002 @@ -15,7 +15,7 @@ #define declare_module_constant(mod,name) \ { \ - &module_g_data_method_table, \ + &module_g_method_table, \ name \ } @@ -30,7 +30,7 @@ #define declare_pred_constant(pred,mod,name) \ { \ - &predicate_g_data_method_table, \ + &predicate_g_method_table, \ (struct predicate *)&pred, \ makemodule(mod), \ name \ diff -ruN klic-3.003-2002-03-19a/runtime/Makefile.tail klic-3.003-2002-03-20/runtime/Makefile.tail --- klic-3.003-2002-03-19a/runtime/Makefile.tail Tue Mar 19 13:56:28 2002 +++ klic-3.003-2002-03-20/runtime/Makefile.tail Wed Mar 20 15:35:27 2002 @@ -254,7 +254,7 @@ klicdb.refs: $(GENERIC_SRCS) cat $(GENERIC_SRCS) \ | sed -n -e \ - "s/.*G._CLASS_NAME()[ ]*\(.*\)/class_\1/p;s/.*G_USE_PREDICATE(predicate_\(.*\)_x.*).*/ref_module_\1/p;s/.*G._USE_CLASS(\(.*\)).*/ref_class_\1/p" \ + "s/.*CLASS_NAME[ ]*\(.*\)/class_\1/p;s/.*G_USE_PREDICATE(predicate_\(.*\)_x.*).*/ref_module_\1/p;s/.*G._USE_CLASS(\(.*\)).*/ref_class_\1/p" \ >newdb.refs ( test -f klicdb.refs && cmp klicdb.refs newdb.refs ) || \ rm -f klicdb.refs; mv newdb.refs klicdb.refs diff -ruN klic-3.003-2002-03-19a/runtime/gcode.c klic-3.003-2002-03-20/runtime/gcode.c --- klic-3.003-2002-03-19a/runtime/gcode.c Tue Mar 19 18:21:24 2002 +++ klic-3.003-2002-03-20/runtime/gcode.c Wed Mar 20 15:35:27 2002 @@ -20,7 +20,7 @@ #include "funct.h" /* arities */ #include -#define GD_CLASS_NAME() predicate +#define CLASS_NAME predicate #define GD_OBJ_TYPE struct predicate_object #define GD_OBJ_SIZE(obj) G_SIZE_IN_Q(GD_OBJ_TYPE) @@ -246,7 +246,7 @@ GD_DEREF_FOR_NEW(GD_ARGV[0]); if( !G_ISFUNCTOR(GD_ARGV[0]) || (((struct module_object*) G_FUNCTORP(GD_ARGV[0]))->method_table - != &GD_method_table0(module) ) ){ + != &G_method_table0(module) ) ){ GD_ERROR_IN_NEW("First parameter is not a module"); } module_obj = (struct module_object*) G_FUNCTORP(GD_ARGV[0]); diff -ruN klic-3.003-2002-03-19a/runtime/ge_exref.c klic-3.003-2002-03-20/runtime/ge_exref.c --- klic-3.003-2002-03-19a/runtime/ge_exref.c Tue Mar 12 13:01:33 2002 +++ klic-3.003-2002-03-20/runtime/ge_exref.c Wed Mar 20 15:35:27 2002 @@ -25,7 +25,7 @@ #include "funct.h" #include "ge_exref.h" -#define GG_CLASS_NAME() exref +#define CLASS_NAME exref #define GG_OBJ_TYPE struct exref_object #include @@ -185,5 +185,5 @@ extern struct generator_object_method_table* get_exref_methtab() { - return &GG_method_table; + return &G_method_table; } diff -ruN klic-3.003-2002-03-19a/runtime/ge_readhook.c klic-3.003-2002-03-20/runtime/ge_readhook.c --- klic-3.003-2002-03-19a/runtime/ge_readhook.c Mon Mar 11 17:13:23 2002 +++ klic-3.003-2002-03-20/runtime/ge_readhook.c Wed Mar 20 15:35:27 2002 @@ -12,7 +12,7 @@ #include "atom.h" #include "funct.h" -#define GC_CLASS_NAME() read_hook +#define CLASS_NAME read_hook #define GC_OBJ_TYPE struct read_hook_object #define GC_OBJ_SIZE(obj) G_SIZE_IN_Q(GC_OBJ_TYPE) diff -ruN klic-3.003-2002-03-19a/runtime/ge_replyhook.c klic-3.003-2002-03-20/runtime/ge_replyhook.c --- klic-3.003-2002-03-19a/runtime/ge_replyhook.c Mon Mar 11 17:13:35 2002 +++ klic-3.003-2002-03-20/runtime/ge_replyhook.c Wed Mar 20 15:35:27 2002 @@ -9,7 +9,7 @@ #include "atom.h" #include "funct.h" -#define GC_CLASS_NAME() reply_hook +#define CLASS_NAME reply_hook #define GC_OBJ_TYPE struct reply_hook_object #define GC_OBJ_SIZE(obj) G_SIZE_IN_Q(GC_OBJ_TYPE) diff -ruN klic-3.003-2002-03-19a/runtime/gfloat.c klic-3.003-2002-03-20/runtime/gfloat.c --- klic-3.003-2002-03-19a/runtime/gfloat.c Tue Mar 19 18:21:24 2002 +++ klic-3.003-2002-03-20/runtime/gfloat.c Wed Mar 20 15:35:27 2002 @@ -17,7 +17,7 @@ #include "interpe.h" #endif -#define GD_CLASS_NAME() float +#define CLASS_NAME float #define GD_OBJ_TYPE struct float_object #define GD_OBJ_SIZE(obj) (G_SIZE_IN_Q(GD_OBJ_TYPE)) @@ -183,7 +183,7 @@ GD_SELF->method_table ){ debug_printf("### \"%k\" given to floating point method %F ###\n", another, g_method_functor); - GD_FAIL("Invalid argument in floating point object method."); + fatal("Invalid argument in floating point object method."); } another_value = ((GD_OBJ_TYPE*) functorp(another))->value; GD_SWITCH_ON_METHOD { @@ -350,11 +350,11 @@ newobj->value = (double) G_INTVAL(init); }else if( G_ISGOBJ(init) && (struct data_object_method_table*) G_FUNCTOR_OF(init) - == &byte__string_g_data_method_table ){ + == &byte__string_g_method_table ){ newobj->value = atof((char*) generic_string_body(G_FUNCTORP(init))); }else{ debug_printf("### %k ###\n", init); - GD_FAIL("Invalid initial value for floating point objects"); + fatal("Invalid initial value for floating point objects"); } GD_RETURN_FROM_NEW(newobj); } @@ -370,7 +370,7 @@ ALIGN(); G_HEAPALLOC(newobj, G_SIZE_IN_Q(GD_OBJ_TYPE), (GD_OBJ_TYPE*)); - newobj->method_table = &GD_method_table; + newobj->method_table = &G_method_table; if( sizeof(long) == sizeof(double) ){ newobj->value = (double) GET_BUFFER(inbuf); }else{ diff -ruN klic-3.003-2002-03-19a/runtime/ggoal.c klic-3.003-2002-03-20/runtime/ggoal.c --- klic-3.003-2002-03-19a/runtime/ggoal.c Tue Mar 19 18:21:24 2002 +++ klic-3.003-2002-03-20/runtime/ggoal.c Wed Mar 20 15:39:22 2002 @@ -12,7 +12,7 @@ #include "atom.h" #include "funct.h" -#define GD_CLASS_NAME() goal +#define CLASS_NAME goal #define GD_OBJ_TYPE struct goal_object #define GD_OBJ_SIZE(obj) G_SIZE_IN_Q(GD_OBJ_TYPE) @@ -27,8 +27,8 @@ extern const struct predicate step_trigger_pred; extern const struct modinfo defined_modules[]; -extern struct data_object_method_table predicate_g_data_method_table; -extern struct data_object_method_table vector_g_data_method_table; +extern struct data_object_method_table predicate_g_method_table; +extern struct data_object_method_table vector_g_method_table; extern unsigned long enter_atom_body(); extern q size_of_vector(); @@ -317,7 +317,7 @@ struct goal_object* obj = (struct goal_object*) klic_alloc((sizeof(struct goal_object) + sizeof(long) - 1) / sizeof(long)); untrace_goal(goal); - obj->method_table = &goal_g_data_method_table; + obj->method_table = &goal_g_method_table; obj->goal = goal; obj->id = goal_obj_id++; return makefunctor(obj); diff -ruN klic-3.003-2002-03-19a/runtime/gio.c klic-3.003-2002-03-20/runtime/gio.c --- klic-3.003-2002-03-19a/runtime/gio.c Mon Mar 11 17:21:26 2002 +++ klic-3.003-2002-03-20/runtime/gio.c Wed Mar 20 15:39:39 2002 @@ -20,7 +20,7 @@ #include "atom.h" #include "funct.h" -#define GC_CLASS_NAME() file__io +#define CLASS_NAME file__io #define GC_OBJ_TYPE struct file_io_object #define GC_OBJ_SIZE(obj) G_SIZE_IN_Q(GC_OBJ_TYPE) @@ -94,7 +94,7 @@ }else #endif if( klic_putc(c, GC_SELF->outfile) == EOF ){ - GC_FAIL("putc failed"); + fatal("putc failed"); } }else if( G_ISFUNCTOR(message) ){ switch( G_SYMVAL(G_FUNCTOR_OF(message)) ){ @@ -162,7 +162,7 @@ } string = convert_binary_c_string_to_klic_string(buf, n); if( G_ISREF(string) ){ - GC_FAIL("internal error: string allocation for fread"); + fatal("internal error: string allocation for fread"); } free(buf); GC_UNIFY_VALUE(G_ARG(message, 1), string); @@ -187,7 +187,7 @@ else #endif if( klic_putc(c, GC_SELF->outfile) == EOF ){ - GC_FAIL("putc failed"); + fatal("putc failed"); } break; } @@ -358,7 +358,7 @@ inname, ((*inname != '\0' && *outname !='\0') ? "/" : ""), outname); - GC_FAIL("message error"); + fatal("message error"); } }else if( GC_TERM==NILATOM ){ #ifdef DIST @@ -456,8 +456,8 @@ if( infile != NILATOM && (!G_ISGOBJ(infile) || (struct data_object_method_table*) G_FUNCTOR_OF(infile) != - &pointer_g_data_method_table) ){ - GC_FAIL("First argument for file creation is not a pointer object"); + &pointer_g_method_table) ){ + fatal("First argument for file creation is not a pointer object"); } inpath = GC_ARGV[1]; GC_DEREF_FOR_NEW(inpath); @@ -467,8 +467,8 @@ if( outfile != NILATOM && (!G_ISGOBJ(outfile) || (struct data_object_method_table*) G_FUNCTOR_OF(outfile) != - &pointer_g_data_method_table) ){ - GC_FAIL("Third argument for file creation is not a pointer object"); + &pointer_g_method_table) ){ + fatal("Third argument for file creation is not a pointer object"); } outpath = GC_ARGV[3]; GC_DEREF_FOR_NEW(outpath); diff -ruN klic-3.003-2002-03-19a/runtime/gmerge.c klic-3.003-2002-03-20/runtime/gmerge.c --- klic-3.003-2002-03-19a/runtime/gmerge.c Mon Mar 11 17:22:20 2002 +++ klic-3.003-2002-03-20/runtime/gmerge.c Wed Mar 20 15:35:27 2002 @@ -16,7 +16,7 @@ q outstream; }; -#define GC_CLASS_NAME() merge +#define CLASS_NAME merge #define GC_OBJ_TYPE struct merge_object #define GC_OBJ_SIZE(obj) G_SIZE_IN_Q(GC_OBJ_TYPE) @@ -106,7 +106,7 @@ GC_RETURN_WITH_HOOK(GC_TERM); invalid_data: debug_printf("### %k ###\n", GC_TERM); - GC_FAIL("Invalid data unified with merger"); + fatal("Invalid data unified with merger"); gc_request: G_MAKE_VAR(newvar); GC_KL1_UNIFY(GC_TERM,newvar); diff -ruN klic-3.003-2002-03-19a/runtime/gmodule.c klic-3.003-2002-03-20/runtime/gmodule.c --- klic-3.003-2002-03-19a/runtime/gmodule.c Tue Mar 19 18:21:24 2002 +++ klic-3.003-2002-03-20/runtime/gmodule.c Wed Mar 20 15:35:27 2002 @@ -21,7 +21,7 @@ #include "atom.h" #include "funct.h" -#define GD_CLASS_NAME() module +#define CLASS_NAME module #define GD_OBJ_TYPE struct module_object #define GD_OBJ_SIZE(obj) ((sizeof(struct module_object))/sizeof(q)) diff -ruN klic-3.003-2002-03-19a/runtime/gmvv.c klic-3.003-2002-03-20/runtime/gmvv.c --- klic-3.003-2002-03-19a/runtime/gmvv.c Tue Mar 19 18:21:24 2002 +++ klic-3.003-2002-03-20/runtime/gmvv.c Wed Mar 20 15:35:27 2002 @@ -20,7 +20,7 @@ #include "atom.h" #include "funct.h" -#define GD_CLASS_NAME() vector +#define CLASS_NAME vector #define GD_OBJ_TYPE struct vector_object #define GD_OBJ_SIZE(obj) (G_SIZE_IN_Q(GD_OBJ_TYPE)) @@ -328,7 +328,7 @@ if (!G_ISFUNCTOR(anotherq) || another->method_table != GD_SELF->method_table) { debug_printf("### %k ###\n", another); - GD_FAIL("Invalid argument to string join"); + fatal("Invalid argument to string join"); } Shallow(another); size2 = another->index; @@ -537,7 +537,7 @@ G_STD_DECL; struct vector_object *newvect; heapalloc(newvect, G_SIZE_IN_Q(GD_OBJ_TYPE), (GD_OBJ_TYPE *)); - newvect->method_table = &GD_method_table; + newvect->method_table = &G_method_table; newvect->next = VECTOR_SHALLOW_MARK; newvect->iscnst = 0; newvect->index = size; @@ -583,7 +583,7 @@ inbuf->rd_index--; return; } - newvect->method_table = &GD_method_table; + newvect->method_table = &G_method_table; newvect-> index = size = (long)GET_BUFFER(inbuf); G_HEAPALLOC_WITH_CHECK(body, size, (q*), res); diff -ruN klic-3.003-2002-03-19a/runtime/gpointer.c klic-3.003-2002-03-20/runtime/gpointer.c --- klic-3.003-2002-03-19a/runtime/gpointer.c Mon Mar 11 17:25:45 2002 +++ klic-3.003-2002-03-20/runtime/gpointer.c Wed Mar 20 15:35:27 2002 @@ -8,7 +8,7 @@ #include #include "g_pointer.h" -#define GD_CLASS_NAME() pointer +#define CLASS_NAME pointer #define GD_OBJ_TYPE struct pointer_object #define GD_OBJ_SIZE(obj) (G_SIZE_IN_Q(GD_OBJ_TYPE)) @@ -53,9 +53,9 @@ GD_STD_DECL_FOR_NEW; GD_OBJ_TYPE *newobj; - if (GD_ARGC != 1) GD_FAIL("Argument mismatch in pointer:new"); + if (GD_ARGC != 1) fatal("Argument mismatch in pointer:new"); G_HEAPALLOC(newobj,GD_OBJ_SIZE(newobj),(GD_OBJ_TYPE *)); - newobj->method_table = &GD_method_table; + newobj->method_table = &G_method_table; newobj->pointer = (char *)GD_ARGV[0]; GD_RETURN_FROM_NEW(newobj); } diff -ruN klic-3.003-2002-03-19a/runtime/gstring.c klic-3.003-2002-03-20/runtime/gstring.c --- klic-3.003-2002-03-19a/runtime/gstring.c Tue Mar 19 18:27:31 2002 +++ klic-3.003-2002-03-20/runtime/gstring.c Wed Mar 20 15:35:27 2002 @@ -16,7 +16,7 @@ #include "interpe.h" #endif -#define GD_CLASS_NAME() byte__string +#define CLASS_NAME byte__string #define GD_OBJ_TYPE struct byte_string_object #define GD_OBJ_SIZE(obj) (G_SIZE_IN_Q(GD_OBJ_TYPE)) @@ -288,7 +288,7 @@ if (!G_ISFUNCTOR(anotherq) || another->method_table != GD_SELF->method_table) { debug_printf("### %k ###\n", another); - GD_FAIL("Invalid argument to string join"); + fatal("Invalid argument to string join"); } Shallow(another); size2 = another->index; @@ -626,7 +626,7 @@ inbuf->rd_index--; return; } - newstring->method_table = &GD_method_table; + newstring->method_table = &G_method_table; newstring->index = (long)GET_BUFFER(inbuf); size = ROUND_UP(newstring->index); @@ -740,8 +740,8 @@ } } -#undef GD_CLASS_NAME -#define GD_CLASS_NAME() string +#undef CLASS_NAME +#define CLASS_NAME string GDDEF_NEW() { diff -ruN klic-3.003-2002-03-19a/runtime/gtermarray.c klic-3.003-2002-03-20/runtime/gtermarray.c --- klic-3.003-2002-03-19a/runtime/gtermarray.c Mon Mar 11 17:27:36 2002 +++ klic-3.003-2002-03-20/runtime/gtermarray.c Wed Mar 20 15:35:27 2002 @@ -8,7 +8,7 @@ #include #include "g_termarray.h" -#define GD_CLASS_NAME() termarray +#define CLASS_NAME termarray #define GD_OBJ_TYPE struct termarray_object #define GD_OBJ_SIZE(obj) (G_SIZE_IN_Q(GD_OBJ_TYPE)+obj->nterm-1) @@ -62,7 +62,7 @@ int i; G_HEAPALLOC(newobj,G_SIZE_IN_Q(GD_OBJ_TYPE)+size-1,(GD_OBJ_TYPE *)); - newobj->method_table = &GD_method_table; + newobj->method_table = &G_method_table; newobj->nterm = size; for (i=0; iterms[i] = GD_ARGV[i]; diff -ruN klic-3.003-2002-03-19a/runtime/random.c klic-3.003-2002-03-20/runtime/random.c --- klic-3.003-2002-03-19a/runtime/random.c Mon Mar 11 17:27:59 2002 +++ klic-3.003-2002-03-20/runtime/random.c Wed Mar 20 15:35:27 2002 @@ -4,123 +4,118 @@ % (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center % (Read COPYRIGHT-JIPDEC for detailed information.) ----------------------------------------------------------- */ -/* - random number generator -*/ +/* random number generator */ + +#include /* NRAND48, fatalf */ #ifdef NRAND48 -#include /* fatalf */ +#include + #include #include #include -#include -#include +#include -#include +#define CLASS_NAME random__numbers +#define GC_OBJ_TYPE struct random_number_generator +#define GC_OBJ_SIZE(obj) G_SIZE_IN_Q(GC_OBJ_TYPE) -#define GG_CLASS_NAME() random__numbers -#define GG_OBJ_TYPE struct random_number_generator +#include -GG_OBJ_TYPE { - struct generator_object_method_table* method_table; +GC_OBJ_TYPE { + struct consumer_object_method_table* method_table; long range; long max; unsigned short state[3]; }; -/* - We don't define body unification method here, as body unification - with a random generator should be exceptional and the value - generation method defined below would suffice. -*/ - -GGDEF_GENERATE() +GCDEF_UNIFY() { G_STD_DECL; - q cons; - q res; - q var; - long one_random; - struct generator_susp* s; - - GG_TRY_TO_ALLOC(cons, makecons, 2, gc_request); - GG_TRY_TO_ALLOC(var, makeref, 1, gc_request); - GG_TRY_TO_ALLOC(s, (struct generator_susp*), - sizeof(struct generator_susp)/sizeof(q), gc_request); - - do{ - one_random = nrand48(GG_SELF->state); - }while( one_random >= GG_SELF->max ); - - car_of(cons) = makeint(one_random % GG_SELF->range); - derefone(var) = makeref(s); - cdr_of(cons) = var; - s->backpt = makeref(var); - s->u.o = tag_generator_susp(GG_SELF); - return cons; - gc_request: - return 0; + + top: + if( GC_TERM == NILATOM ){ + GC_TERMINATE; + }else if( isref(GC_TERM) ){ + q temp = derefone(GC_TERM); + if( isref(temp) && (temp == GC_TERM || derefone(temp) == GC_TERM) ){ + GC_RETURN_WITH_HOOK(GC_TERM); + }else{ + GC_TERM = temp; + goto top; + } + }else if( iscons(GC_TERM) ){ + long one_random; + + do{ + one_random = nrand48(GC_SELF->state); + }while( one_random >= GC_SELF->max ); + + derefone(car_of(GC_TERM)) = makeint(one_random % GC_SELF->range); + GC_TERM = cdr_of(GC_TERM); + goto top; + }else{ + fatalf("random_numbers: does not support message %k", GC_TERM); + } } -GGDEF_PRINT() +GCDEF_PRINT() { G_STD_DECL; - fprintf(g_fp, "RANDOM@%X", (q*)GG_SELF-new_space_top()); + fprintf(g_fp, "RANDOM@%X", (q*) GC_SELF - new_space_top()); return 0; } -GGDEF_GC() +GCDEF_GC() { G_STD_DECL; - q* newself = klic_alloc(sizeof(GG_OBJ_TYPE) / sizeof(q)); + q* newself = klic_alloc(sizeof(GC_OBJ_TYPE) / sizeof(q)); - BCOPY(GG_SELF, newself, sizeof(GG_OBJ_TYPE)); + BCOPY(GC_SELF, newself, sizeof(GC_OBJ_TYPE)); return newself; } -GGDEF_UNIFY() -{ - return 0; -} - -#define GGUSE_MY_GENERATE -#define GGUSE_MY_GC -#define GGUSE_MY_UNIFY -#define GGUSE_MY_PRINT +#define GCUSE_MY_UNIFY +#define GCUSE_MY_PRINT +#define GCUSE_MY_GC -#include +#include -GGDEF_NEW() +GCDEF_NEW() { - GG_STD_DECL_FOR_NEW; - q res; - q var; - GG_OBJ_TYPE* obj; + GC_STD_DECL_FOR_NEW; + GC_OBJ_TYPE* obj; long seed; long range; - if( GG_ARGC < 1 || 2 < GG_ARGC ){ - fatalf("Wrong number of arguments (%d) in creation of random number generator", - GG_ARGC); + if( GC_ARGC < 1 || 2 < GC_ARGC ){ + debug_printf("Wrong number of arguments (%d)", GC_ARGC); + GC_ERROR_IN_NEW(""); } - GGSET_INTARG_FOR_NEW(range, GG_ARGV[0]); - if( GG_ARGC > 1 ){ - GGSET_INTARG_FOR_NEW(seed, GG_ARGV[1]); + GC_DEREF_FOR_NEW(GC_ARGV[0]); + if( !isint(GC_ARGV[0]) ) GC_ERROR_IN_NEW("First argument is not integer"); + range = intval(GC_ARGV[0]); + if( range < 1 ){ + debug_printf("Invalid first argument (%d)", range); + GC_ERROR_IN_NEW(""); + } + + if( GC_ARGC > 1 ){ + GC_DEREF_FOR_NEW(GC_ARGV[1]); + if( !isint(GC_ARGV[1]) ) GC_ERROR_IN_NEW("Second argument is not integer"); + seed = intval(GC_ARGV[1]); }else{ seed = 0; } - if( range <1 ){ - fatalf("Invalid first argument (%d) in creation of random number generator", - range); - } - GGSET_NEWOBJ_FOR_NEW(obj, (GG_OBJ_TYPE*)); + + GCSET_NEWOBJ_FOR_NEW(obj, GC_OBJ_SIZE(obj)); obj->state[0] = seed >> (sizeof(seed)*4); obj->state[1] = seed >> (sizeof(seed)*2); obj->state[2] = seed >> (sizeof(seed)*0); obj->range = range; - obj->max = ((((unsigned long)(~0))<<1)>>1)/range*range; - GG_RETURN_FROM_NEW(GG_MAKE_HOOK_VAR(obj)); + obj->max = ((~0LU << 1) >> 1) / range * range; + GC_RETURN_FROM_NEW(GC_MAKE_HOOK_VAR((struct consumer_object*) obj)); } #endif /* NRAND48 */ diff -ruN klic-3.003-2002-03-19a/runtime/wakeup.c klic-3.003-2002-03-20/runtime/wakeup.c --- klic-3.003-2002-03-19a/runtime/wakeup.c Mon Mar 11 17:28:10 2002 +++ klic-3.003-2002-03-20/runtime/wakeup.c Wed Mar 20 15:35:27 2002 @@ -15,7 +15,7 @@ q y; }; -#define GC_CLASS_NAME() GC_wakeup +#define CLASS_NAME GC_wakeup #define GC_OBJ_TYPE struct GC_wakeup_object #define GC_OBJ_SIZE(obj) sizeof(GC_OBJ_TYPE) @@ -64,7 +64,7 @@ GC_OBJ_TYPE *wakeup; q var; - if (GC_ARGC != 2) GC_FAIL("arity mismatch in creation of a merger."); + if (GC_ARGC != 2) fatal("arity mismatch in creation of a merger."); GCSET_NEWOBJ_FOR_NEW(wakeup,GC_OBJ_SIZE(wakeup)); wakeup->x = GC_ARGV[0];