diff -ruN klic-3.003-2002-03-26/compiler/obj.kl1 klic-3.003-2002-04-06/compiler/obj.kl1 --- klic-3.003-2002-03-26/compiler/obj.kl1 Sun Mar 24 18:05:27 2002 +++ klic-3.003-2002-04-06/compiler/obj.kl1 Sat Apr 6 20:52:48 2002 @@ -489,9 +489,9 @@ write_param( atom( Atom ))-Out :- klic_comp_write:write_atom( Atom )-Out. write_param( const( float( Id )))-Out :- - klicformat( "makefloat( float_const_~d )", [Id] )-Out. + klicformat( "makefunctor(&float_const_~d)", [Id] )-Out. write_param( const( predicate( Id )))-Out :- - klicformat( "makepred( pred_const_~d )", [Id] )-Out. + klicformat( "makefunctor(&pred_const_~d)", [Id] )-Out. write_param( const( list( Id )))-Out :- klicformat( "makecons( cons_const_~d )", [Id] )-Out. write_param( const( functor( Id )))-Out :- diff -ruN klic-3.003-2002-03-26/compiler/write.kl1 klic-3.003-2002-04-06/compiler/write.kl1 --- klic-3.003-2002-03-26/compiler/write.kl1 Sun Mar 24 18:18:25 2002 +++ klic-3.003-2002-04-06/compiler/write.kl1 Sat Apr 6 20:52:48 2002 @@ -176,11 +176,11 @@ write_const_elem( integer( N ))-Out :- klic_comp_obj:klicformat( " makeint( ~d ),\n", [N] )-Out. write_const_elem( float( K ))-Out :- - klic_comp_obj:klicformat( " makefloat( float_const_~d ),\n", [K] )-Out. + klic_comp_obj:klicformat( " makefunctor(&float_const_~d),\n", [K] )-Out. write_const_elem( predicate( K ))-Out :- - klic_comp_obj:klicformat( " makepred( pred_const_~d ),\n", [K] )-Out. + klic_comp_obj:klicformat( " makefunctor(&pred_const_~d),\n", [K] )-Out. write_const_elem( module( K ))-Out :- - klic_comp_obj:klicformat( " makepred( mod_const_~d ),\n", [K] )-Out. + klic_comp_obj:klicformat( " makefunctor(&mod_const_~d),\n", [K] )-Out. write_const_elem( list( K ))-Out :- klic_comp_obj:klicformat( " makecons( cons_const_~d ),\n", [K] )-Out. write_const_elem( functor( K ))-Out :- diff -ruN klic-3.003-2002-03-26/include/klic/bb.h klic-3.003-2002-04-06/include/klic/bb.h --- klic-3.003-2002-03-26/include/klic/bb.h Wed Mar 20 15:35:27 2002 +++ klic-3.003-2002-04-06/include/klic/bb.h Sat Apr 6 20:52:48 2002 @@ -437,7 +437,7 @@ functor_of(x) != (q) &G_method_table0(float) ){ \ (z) = bblt_fix_2(x); \ } else { \ - (z) = makeint((long) (float_value(x))); \ + (z) = makeint((long) float_value(x)); \ } \ }while(0) diff -ruN klic-3.003-2002-03-26/include/klic/control.h klic-3.003-2002-04-06/include/klic/control.h --- klic-3.003-2002-03-26/include/klic/control.h Tue Mar 19 18:21:24 2002 +++ klic-3.003-2002-04-06/include/klic/control.h Sat Apr 6 20:52:48 2002 @@ -36,31 +36,21 @@ * q: struct goalrec* */ -#define _ENQUEUE_AT_PRIORITY(p, q0, q, is_rel) \ - (assert(allocp==heapp()), \ - (qp = enqueue_after_waiting((struct goalrec*) (q0), \ - (p), (struct goalrec*) (q), (is_rel)) )) - -#define _ENQUEUE_AT_PRIORITY_NO_CHECK(prio, q0, q) \ - (qp = enqueue_goal((struct goalrec*) (q0), \ - (long) (prio), (struct goalrec*) (q), glbl)) - #define enqueue_at_priority(p, q0, q) \ -do{ assert(allocp==heapp()); _ENQUEUE_AT_PRIORITY(p, q0, q, 0); }while(0) + (qp = enqueue_after_waiting \ + ((struct goalrec*) (q0), (p), (struct goalrec*) (q), 0) ) #define enqueue_at_lower_priority(p, q0, q) \ -do{ assert(allocp==heapp()); _ENQUEUE_AT_PRIORITY(p, q0, q, 1); }while(0) + (qp = enqueue_after_waiting \ + ((struct goalrec*) (q0), (p), (struct goalrec*) (q), 1) ) #define enqueue_at_priority_no_check(x, q0, q) \ -do{ \ - _ENQUEUE_AT_PRIORITY_NO_CHECK(intval(x), q0, q); \ -}while(0) + (qp = enqueue_goal((struct goalrec*) (q0), \ + (long) intval(x), (struct goalrec*) (q), glbl )) #define enqueue_at_lower_priority_no_check(x, q0, q) \ -do{ \ - long prio = current_prio() - intval(x); \ - _ENQUEUE_AT_PRIORITY_NO_CHECK(prio, q0, q); \ -}while(0) + (qp = enqueue_goal((struct goalrec*) (q0), \ + (long) current_prio() - intval(x), (struct goalrec*) (q), glbl )) #define switch_on_pred() switch (toppred->pred) @@ -109,11 +99,6 @@ do{ \ _INC_REDUCTION_COUNT(500); \ if (heapp() < heaplimit) goto label; \ -}while(0) - -#define proceed() \ -do{ \ - goto proceed_label; \ }while(0) diff -ruN klic-3.003-2002-03-26/include/klic/g_float.h klic-3.003-2002-04-06/include/klic/g_float.h --- klic-3.003-2002-03-26/include/klic/g_float.h Wed Mar 20 15:37:48 2002 +++ klic-3.003-2002-04-06/include/klic/g_float.h Sat Apr 6 20:52:48 2002 @@ -8,14 +8,14 @@ #ifndef _KLIC_G_FLOAT_H_ #define _KLIC_G_FLOAT_H_ -typedef struct float_object { - struct data_object_method_table *method_table; +struct float_object { + struct data_object_method_table* method_table; double value; -} float_structure_type; +}; #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) +#define float_value(x) (((struct float_object*) functorp(x))->value) #endif /* _KLIC_G_FLOAT_H_ */ diff -ruN klic-3.003-2002-03-26/include/klic/g_string.h klic-3.003-2002-04-06/include/klic/g_string.h --- klic-3.003-2002-03-26/include/klic/g_string.h Wed Mar 20 15:38:24 2002 +++ klic-3.003-2002-04-06/include/klic/g_string.h Sat Apr 6 20:52:48 2002 @@ -22,8 +22,6 @@ unsigned char *body; }; -typedef struct byte_string_object string_structure_type_8; - #define STRING_SHALLOW_MARK (makeint(0)) #define IS_SHALLOW_STRING(s) ((s)->next == STRING_SHALLOW_MARK) diff -ruN klic-3.003-2002-03-26/include/klic/g_vector.h klic-3.003-2002-04-06/include/klic/g_vector.h --- klic-3.003-2002-03-26/include/klic/g_vector.h Wed Mar 20 15:38:34 2002 +++ klic-3.003-2002-04-06/include/klic/g_vector.h Sat Apr 6 20:52:48 2002 @@ -8,7 +8,7 @@ #ifndef _KLIC_G_VECTOR_H_ #define _KLIC_G_VECTOR_H_ -typedef struct vector_object { +struct vector_object { struct data_object_method_table *method_table; q next; int index:(8*sizeof(int)-1); /* size or index */ @@ -19,7 +19,7 @@ when deep, i.e., for difference records, the element that differs. */ q *body; -} vector_structure_type; +}; #define VECTOR_SHALLOW_MARK (makeint(0)) #define IS_SHALLOW_VECTOR(v) ((v)->next == VECTOR_SHALLOW_MARK) @@ -35,6 +35,5 @@ /* runtime/gmvv.c */ extern q create_vector(q* body, long size); -extern q create_vector0(q* body, long size); #endif /* _KLIC_G_VECTOR_H_ */ diff -ruN klic-3.003-2002-03-26/include/klic/gc_macro.h klic-3.003-2002-04-06/include/klic/gc_macro.h --- klic-3.003-2002-03-26/include/klic/gc_macro.h Sun Mar 24 16:31:13 2002 +++ klic-3.003-2002-04-06/include/klic/gc_macro.h Sat Apr 6 20:52:48 2002 @@ -30,15 +30,6 @@ return; \ }while(0) -/***************************************************************************/ - -#define GC_TRY_TO_ALLOC(new, type, size, gc_request) \ -do{ \ - q res; \ - G_HEAPALLOC_WITH_CHECK((new), (size), type, res); \ - if (res == GENERIC_GCREQUEST) goto gc_request; \ -}while(0) - /**********************************************************************/ #define GCDEF_UNIFY() \ @@ -102,7 +93,5 @@ } \ (_arg) = (struct byte_string_object*) functorp(temp); \ }while(0) - -#define GCSET_VAR(self) ((self) = makeref(&(self))) #endif /* _KLIC_GC_MACRO_H_ */ diff -ruN klic-3.003-2002-03-26/include/klic/gd_macro.h klic-3.003-2002-04-06/include/klic/gd_macro.h --- klic-3.003-2002-03-26/include/klic/gd_macro.h Sun Mar 24 15:41:21 2002 +++ klic-3.003-2002-04-06/include/klic/gd_macro.h Sat Apr 6 21:07:22 2002 @@ -24,8 +24,6 @@ #define GD_guard(fa) G_guard0(CLASS_NAME,fa) #define GD_body(fa) G_body0(CLASS_NAME,fa) -#define GD_OBJ(x) makefunctor(x) - #define GD_USE_CLASS(class) \ extern const struct data_object_method_table G_method_table0(class) @@ -34,11 +32,6 @@ #define GD_ERROR_IN_METHOD(errmsg, methodname) \ G_error((errmsg), (methodname), "data", G_CLASS_NAME_STRING) -#define GD_GRETURN(x) do{ return (q) (x); }while(0) - -#define GD_GFAIL do{ return GENERIC_FAILED; }while(0) -#define GD_GSUCCEED do{ return GENERIC_SUCCEEDED; }while(0) - /**************************************************/ #define GD_ALLOC_AREA(new,type,size) \ do{ \ @@ -70,98 +63,54 @@ #define GDSET_NEWOBJ(newgobj) \ do{ \ - q res; \ - G_HEAPALLOC_WITH_CHECK((newgobj), G_OBJ_SIZE, (G_OBJ_TYPE*), res); \ - if (res == GENERIC_GCREQUEST) { \ - struct goalrec *goal; \ - GD_MAKE_GENERIC_GOAL(&goal, makefunctor(g_self), \ - g_method_functor, g_argv ); \ - resume_same_prio(goal); \ - return; \ - } \ + GD_ALLOC_AREA((newgobj), (G_OBJ_TYPE*), G_OBJ_SIZE); \ (newgobj)->method_table = g_self->method_table; \ }while(0) /***************************************************************************/ #define GD_GDEREF(x) \ do{ \ - while (1) { \ - if (!isstruct(x)) { \ - if (atomicnotref(x)) { \ - break; \ - } else { \ - q temp0 = derefone(x); \ - if(isref(temp0) && (x) == derefone(temp0)) { \ - return(x); \ - } else { \ - (x) = temp0; \ - } \ - } \ + while( isref(x) ){ \ + q temp0 = derefone(x); \ + if( isref(temp0) && (x) == derefone(temp0) ){ \ + return (x); \ } else { \ - break; \ + (x) = temp0; \ } \ } \ }while(0) #define GD_DEREF(x) \ do{ \ - while (1) { \ - if (!isstruct(x)) { \ - if (atomicnotref(x)) { \ - break; \ - } else { \ - q temp0 = derefone(x); \ - if(isref(temp0) && (x) == derefone(temp0)) { \ - struct goalrec *goal; \ - GD_MAKE_GENERIC_GOAL(&goal, makefunctor(g_self), \ - g_method_functor, g_argv ); \ - G_SUSPEND((x), goal); \ - return; \ - } else { \ - (x) = temp0; \ - } \ - } \ + while( isref(x) ){ \ + q temp0 = derefone(x); \ + if( isref(temp0) && (x) == derefone(temp0) ){ \ + struct goalrec* goal; \ + GD_MAKE_GENERIC_GOAL(&goal, makefunctor(g_self), \ + g_method_functor, g_argv ); \ + G_SUSPEND((x), goal); \ + return; \ } else { \ - break; \ + (x) = temp0; \ } \ } \ }while(0) -/**************************************************************************/ - -#define GD_RETURN_FROM_NEW(x) \ -do{ \ - return makefunctor(x); \ -}while(0) - -/**************************************************************************/ -#define GD_GUNIFY(x,y) eq_terms_body(x,y) - /****************************************************/ -#define GD_SWITCH_ON_METHOD switch(g_method_functor) -#define GD_SWITCH_ON_ARITY switch (arities (g_method_functor)) - -#define GD_METHOD_CASE_DIRECT(fa) \ - case (long) G_functor(fa) +#define GD_METHOD_CASE_DIRECT(fa) case (long) G_functor(fa) #define GD_METHOD_CASE(fa) \ - case (long) G_functor(fa): \ + case (long) G_functor(fa): \ GD_body(fa) (g_self, g_method_functor, g_argv); \ break -#define GD_METHOD_CASE_DEFAULT \ - default: fatal("undefined method") - -#define GD_SWITCH_ON_GMETHOD_NAME \ - switch (functors (g_method_functor)) +#define GD_METHOD_CASE_DEFAULT default: fatal("undefined method") #define GD_METHOD_NAME_CASE(sym) \ case ((long)(G_atom(sym))) : \ GD_body(sym)(g_self, g_method_functor, g_argv); \ break -#define GD_METHOD_NAME_CASE_DEFAULT default: fatal("undefined method") - #define GDDEF_METHOD(fa) \ static void GD_body(fa) (G_OBJ_TYPE* g_self, long g_method_functor, q* g_argv) @@ -209,19 +158,15 @@ (G_OBJ_TYPE* g_self, long g_method_functor, q* g_argv) #define GD_GMETHOD_CASE(fa) \ - case (long) G_functor(fa): \ - { \ - q retval = (q) GD_guard(fa) (g_self, g_method_functor, g_argv); \ - GD_GRETURN(retval); \ - } \ - break + case (long) G_functor(fa): \ + return (q) GD_guard(fa) (g_self, g_method_functor, g_argv); #define GDDEF_GMETHOD(fa) \ static q GD_guard(fa) (G_OBJ_TYPE* g_self, long g_method_functor, q* g_argv) #define GD_GMETHOD_CASE_DEFAULT \ default: \ - GD_GFAIL + return GENERIC_FAILED /*******************************************/ /* utility */ @@ -259,20 +204,17 @@ #define GDSET_GINTARG_WITHIN_RANGE(var,x,from,to) \ do{ \ while( !isint(x) ){ \ - if( !isref(x) ) GD_GFAIL; \ + if( !isref(x) ) return GENERIC_FAILED; \ GD_GDEREF(x); \ } \ (var) = intval(x); \ - if((var) < (from) || (to) <= (var)) GD_GFAIL; \ + if( (var) < (from) || (to) <= (var) ) return GENERIC_FAILED; \ }while(0) /*******************************************/ -#define GD_IS_CLASS(class,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) \ - ((struct data_object *)functorp(obj), G_functor(method), (argv))) + ((q) ((struct data_object*) functorp(obj))->method_table->g_generic \ + ((struct data_object*) functorp(obj), G_functor(method), (argv)) ) #endif /* _KLIC_GD_MACRO_H_ */ diff -ruN klic-3.003-2002-03-26/include/klic/generic.h klic-3.003-2002-04-06/include/klic/generic.h --- klic-3.003-2002-03-26/include/klic/generic.h Sun Mar 24 17:13:05 2002 +++ klic-3.003-2002-04-06/include/klic/generic.h Sat Apr 6 20:52:48 2002 @@ -15,25 +15,15 @@ /* runtime/generic.c */ extern void gd_generic(q g_object, long g_method_functor, q* g_argv); -#define new_generic(name,argc,out) \ -do{ \ - (out) = (name)((argc), generic_arg); \ - allocp = heapp(); \ -}while(0) - -#define call_generic(obj,funct) \ - ( gd_generic((obj), (funct), generic_arg), \ - allocp = heapp() ) - #define guard_generic(object,mf,inargc,label) \ do{ \ - q *obj = (q *)functorp(object); \ - q retval = ((struct data_object_method_table *) \ - (*obj))->g_generic( obj, (mf), generic_arg); \ + q* obj = (q*) functorp(object); \ + q retval = ((struct data_object_method_table*) \ + (*obj))->g_generic(obj, (mf), generic_arg); \ \ if( retval != GENERIC_SUCCEEDED ){ \ - if( retval == GENERIC_FAILED ) { goto label ; } \ - else{ *reasonp++ = retval; goto label ; } \ + if( retval != GENERIC_FAILED ) *reasonp++ = retval; \ + goto label; \ } \ }while(0) diff -ruN klic-3.003-2002-03-26/include/klic/gg_macro.h klic-3.003-2002-04-06/include/klic/gg_macro.h --- klic-3.003-2002-03-26/include/klic/gg_macro.h Sun Mar 24 16:32:12 2002 +++ klic-3.003-2002-04-06/include/klic/gg_macro.h Sat Apr 6 20:52:48 2002 @@ -37,20 +37,12 @@ #define GG_DEREF(x) \ do{ \ - while (1) { \ - if (!isstruct(x)) { \ - if (atomicnotref(x)) { \ - break; \ - } else { \ - q temp0 = derefone(x); \ - if(isref(temp0) && (x) == derefone(temp0)) { \ - GG_SUSPEND(x); \ - } else { \ - (x) = temp0; \ - } \ - } \ + while( isref(x) ){ \ + q temp0 = derefone(x); \ + if( isref(temp0) && (x) == derefone(temp0) ){ \ + GG_SUSPEND(x); \ } else { \ - break; \ + (x) = temp0; \ } \ } \ }while(0) diff -ruN klic-3.003-2002-03-26/include/klic/gmodule.h klic-3.003-2002-04-06/include/klic/gmodule.h --- klic-3.003-2002-03-26/include/klic/gmodule.h Wed Mar 20 15:38:52 2002 +++ klic-3.003-2002-04-06/include/klic/gmodule.h Sat Apr 6 20:52:48 2002 @@ -8,10 +8,10 @@ #ifndef _KLIC_GMODULE_H_ #define _KLIC_GMODULE_H_ -typedef struct module_object { - struct data_object_method_table *method_table; +struct module_object { + struct data_object_method_table* method_table; q name; -} module_structure_type; +}; #define declare_module_constant(mod,name) \ { \ @@ -19,20 +19,18 @@ name \ } -#define makemodule(x) makefunctor(&(x)) - -typedef struct predicate_object { - struct data_object_method_table *method_table; +struct predicate_object { + struct data_object_method_table* method_table; const struct predicate* pdesc; /* atom tag */ q module_obj; q predicate_name; -} predicate_structure_type; +}; #define declare_pred_constant(pred,mod,name) \ { \ &predicate_g_method_table, \ (struct predicate *)&pred, \ - makemodule(mod), \ + makefunctor(&(mod)), \ name \ } diff -ruN klic-3.003-2002-03-26/include/klic/index.h klic-3.003-2002-04-06/include/klic/index.h --- klic-3.003-2002-03-26/include/klic/index.h Wed Feb 20 14:48:08 2002 +++ klic-3.003-2002-04-06/include/klic/index.h Sat Apr 6 20:52:48 2002 @@ -10,22 +10,20 @@ #define deref_and_switch(x, susp, atomic, cons, funct) \ do{ \ - while (1) { \ - if (!isstruct(x)) { \ - if (atomicnotref(x)) { \ - goto atomic; \ - } else { \ + for(;;){ \ + switch( ptagof(x) ){ \ + case ATOMIC: goto atomic; \ + case FUNCTOR: goto funct; \ + case CONS: goto cons; \ + case VARREF: \ + { \ q temp0 = derefone(x); \ - if(isref(temp0) && (x) == derefone(temp0)) { \ + if( isref(temp0) && (x) == derefone(temp0) ){ \ goto susp; \ } else { \ (x) = temp0; \ } \ } \ - } else { \ - if(functnotcons(x)) \ - goto funct; \ - else goto cons; \ } \ } \ }while(0) diff -ruN klic-3.003-2002-03-26/include/klic/sighndl.h klic-3.003-2002-04-06/include/klic/sighndl.h --- klic-3.003-2002-03-26/include/klic/sighndl.h Mon Feb 25 13:01:05 2002 +++ klic-3.003-2002-04-06/include/klic/sighndl.h Sat Apr 6 20:52:48 2002 @@ -19,12 +19,9 @@ #define NSIG 32 #endif -#define signal_flags (klic_sgnl_flags->flags) -#define signal_done (klic_sgnl_flags->done) - struct klic_sgnl_flags { volatile long flags[NSIG]; - int ((* volatile sgnl_handlers[NSIG])()); + int ((*volatile sgnl_handlers[NSIG])()); volatile long done; }; @@ -36,6 +33,8 @@ extern int add_signal_handler(int sig, int (*func)()); extern void register_streamed_signal(int sig, q stream); extern void init_klic_signal_handling(void); +extern void set_alarm_signal(void); +extern int signal_done(void); #endif /* USESIG */ diff -ruN klic-3.003-2002-03-26/runtime/gcode.c klic-3.003-2002-04-06/runtime/gcode.c --- klic-3.003-2002-03-26/runtime/gcode.c Sun Mar 24 16:19:57 2002 +++ klic-3.003-2002-04-06/runtime/gcode.c Sat Apr 6 20:52:48 2002 @@ -19,6 +19,7 @@ #include "atom.h" #include "funct.h" /* arities */ #include +#include /* isclass */ #define CLASS_NAME predicate #define G_OBJ_TYPE struct predicate_object @@ -33,13 +34,9 @@ GDDEF_GUNIFY() { - G_STD_DECL; - - if( g_self->method_table != GD_OTHER->method_table || - g_self->pdesc != GD_OTHER->pdesc ) - GD_GFAIL; - else - GD_GSUCCEED; + return (g_self->method_table == GD_OTHER->method_table && + g_self->pdesc == GD_OTHER->pdesc ) ? + GENERIC_SUCCEEDED : GENERIC_FAILED; } GDDEF_UNIFY() @@ -106,7 +103,7 @@ GD_DEREF(g_argv[0]); func = g_argv[0]; - if( !isfunctor(func) || !GD_IS_CLASS(vector, func) ){ + if( !isfunctor(func) || !isclass(func, vector) ){ GD_ERROR_IN_METHOD("Invalid argument specification", "apply"); } @@ -144,15 +141,15 @@ { G_STD_DECL; - GD_SWITCH_ON_METHOD { + switch( g_method_functor ){ GD_METHOD_CASE(module_1); GD_METHOD_CASE(name_1); GD_METHOD_CASE(arity_1); GD_METHOD_CASE(apply_1); default: - GD_SWITCH_ON_GMETHOD_NAME { + switch( functors(g_method_functor) ){ GD_METHOD_NAME_CASE(call); - GD_METHOD_NAME_CASE_DEFAULT; + GD_METHOD_CASE_DEFAULT; } } } @@ -175,21 +172,17 @@ const struct predicate* pred = g_self->pdesc; g_argv[0] = makeint(pred->arity); - GD_GSUCCEED; + return GENERIC_SUCCEEDED; } GDDEF_GMETHOD(predicate_0) { - G_STD_DECL; - if( g_self->pdesc ) - { GD_GSUCCEED; } - else - { GD_GFAIL; } + return (g_self->pdesc ? GENERIC_SUCCEEDED : GENERIC_FAILED); } GDDEF_GGENERIC() { - GD_SWITCH_ON_METHOD { + switch( g_method_functor ){ GD_GMETHOD_CASE(predicate_0); GD_GMETHOD_CASE(arity_1); GD_GMETHOD_CASE_DEFAULT; @@ -269,5 +262,5 @@ newpred->pdesc = predaddr; newpred->module_obj = makefunctor(module_obj); newpred->predicate_name = predname; - GD_RETURN_FROM_NEW(newpred); + return makefunctor(newpred); } diff -ruN klic-3.003-2002-03-26/runtime/generic.c klic-3.003-2002-04-06/runtime/generic.c --- klic-3.003-2002-03-26/runtime/generic.c Sun Mar 24 16:29:46 2002 +++ klic-3.003-2002-04-06/runtime/generic.c Sat Apr 6 20:52:48 2002 @@ -141,7 +141,7 @@ extern q GD_STD_GUNIFY(struct data_object* g_self, struct data_object* GD_OTHER) { - GD_GSUCCEED; + return GENERIC_SUCCEEDED; } extern q* diff -ruN klic-3.003-2002-03-26/runtime/gfloat.c klic-3.003-2002-04-06/runtime/gfloat.c --- klic-3.003-2002-03-26/runtime/gfloat.c Sun Mar 24 16:22:59 2002 +++ klic-3.003-2002-04-06/runtime/gfloat.c Sat Apr 6 21:10:34 2002 @@ -56,11 +56,9 @@ GDDEF_GUNIFY() { - G_STD_DECL; - if( g_self->method_table != GD_OTHER->method_table || - g_self->value != GD_OTHER->value ) - GD_GFAIL; - GD_GSUCCEED; + return (g_self->method_table == GD_OTHER->method_table && + g_self->value == GD_OTHER->value ) ? + GENERIC_SUCCEEDED : GENERIC_FAILED; } GDDEF_UNIFY() @@ -141,7 +139,7 @@ double (*func)(); self = g_self->value; - GD_SWITCH_ON_METHOD { + switch( g_method_functor ){ GD_METHOD_CASE(print_1); GD_METHOD_CASE(int_1); @@ -150,10 +148,10 @@ default: ALIGN(); GDSET_NEWOBJ(newobj); - GD_SWITCH_ON_ARITY { + switch( arities(g_method_functor) ){ case 1: { result_index = 0; - GD_SWITCH_ON_METHOD { + switch( g_method_functor ){ GD_METHOD_CASE_DIRECT(sin_1): func = sin; goto apply_1; GD_METHOD_CASE_DIRECT(cos_1): func = cos; goto apply_1; GD_METHOD_CASE_DIRECT(tan_1): func = tan; goto apply_1; @@ -186,7 +184,7 @@ fatal("Invalid argument in floating point object method."); } another_value = ((G_OBJ_TYPE*) functorp(another))->value; - GD_SWITCH_ON_METHOD { + switch( g_method_functor ){ GD_METHOD_CASE_DIRECT(add_2): result = self + another_value; goto apply_2; @@ -227,13 +225,12 @@ G_OBJ_TYPE* other; \ double self, theother; \ \ - if( !G_ISGOBJ(otherq) ) GD_GFAIL; \ + if( !G_ISGOBJ(otherq) ) return GENERIC_FAILED; \ other = (G_OBJ_TYPE*) functorp(otherq); \ - if( other->method_table != g_self->method_table ) GD_GFAIL; \ + if( other->method_table != g_self->method_table ) return GENERIC_FAILED; \ self = g_self->value; \ theother = other->value; \ - if( comparison ) GD_GSUCCEED; \ - GD_GFAIL; \ + return (comparison ? GENERIC_SUCCEEDED : GENERIC_FAILED); \ } GDDEF_GMETHOD(less__than_1) @@ -256,14 +253,13 @@ GDDEF_GMETHOD(float_0) { - G_STD_DECL; - GD_GSUCCEED; + return GENERIC_SUCCEEDED; } GDDEF_GGENERIC() { G_STD_DECL; - GD_SWITCH_ON_METHOD { + switch( g_method_functor ){ GD_GMETHOD_CASE(less__than_1); GD_GMETHOD_CASE(not__greater__than_1); GD_GMETHOD_CASE(not__less__than_1); @@ -356,7 +352,7 @@ debug_printf("### %k ###\n", init); fatal("Invalid initial value for floating point objects"); } - GD_RETURN_FROM_NEW(newobj); + return makefunctor(newobj); } #ifdef DIST diff -ruN klic-3.003-2002-03-26/runtime/ggoal.c klic-3.003-2002-04-06/runtime/ggoal.c --- klic-3.003-2002-03-26/runtime/ggoal.c Sat Mar 23 21:34:01 2002 +++ klic-3.003-2002-04-06/runtime/ggoal.c Sat Apr 6 20:52:48 2002 @@ -20,6 +20,7 @@ #include #include #include +#include /* isclass */ #include "trace.h" /* untrace_goal */ #define HashFunc(pred) ((((unsigned long) (pred)) >> 2) & hash_mask) @@ -201,7 +202,7 @@ newobj->goal = newgoal; do_shallow_unify(g_argv[1], oldarg); - G_UNIFY_VALUE(g_argv[3], GD_OBJ(newobj)); + G_UNIFY_VALUE(g_argv[3], makefunctor(newobj)); } GDDEF_METHOD(id_1) @@ -240,7 +241,7 @@ predq = g_argv[0]; GD_DEREF(predq); - if (!G_ISGOBJ(predq) || !GD_IS_CLASS(predicate, predq)) { + if( !G_ISGOBJ(predq) || !isclass(predq, predicate) ){ GD_ERROR_IN_METHOD("First argument is not a predicate object", "set_predicate"); } @@ -261,7 +262,7 @@ GDSET_NEWOBJ(newobj); newobj->goal = newgoal; - G_UNIFY_VALUE(g_argv[1], GD_OBJ(newobj)); + G_UNIFY_VALUE(g_argv[1], makefunctor(newobj)); } /* Generic Method Table */ @@ -269,7 +270,7 @@ { G_STD_DECL; - GD_SWITCH_ON_METHOD{ + switch( g_method_functor ){ GD_METHOD_CASE(reduce_0); GD_METHOD_CASE(step_4); GD_METHOD_CASE(arg_2); @@ -286,7 +287,7 @@ GDDEF_GGENERIC() { G_STD_DECL; - GD_SWITCH_ON_METHOD { + switch( g_method_functor ){ GD_GMETHOD_CASE_DEFAULT; } } @@ -338,7 +339,7 @@ } predq = g_argv[0]; G_DEREF_FOR_NEW(predq); - if (!G_ISGOBJ(predq) || !GD_IS_CLASS(predicate, predq)) { + if( !G_ISGOBJ(predq) || !isclass(predq, predicate) ){ G_ERROR_IN_NEW("First argument is not a predicate object"); } pred = (struct predicate_object *)functorp(predq); @@ -346,7 +347,7 @@ argvq = g_argv[1]; G_DEREF_FOR_NEW(argvq); - if (!G_ISGOBJ(argvq) || !GD_IS_CLASS(vector, argvq)) { + if( !G_ISGOBJ(argvq) || !isclass(argvq, vector) ){ G_ERROR_IN_NEW("Second argument is not a vector object"); } argv_arity = intval(size_of_vector(argvq)); @@ -364,5 +365,5 @@ G_SET_NEWOBJ_FOR_NEW(newobj, G_SIZE_IN_Q(G_OBJ_TYPE)); newobj->goal = newgoal; newobj->id = goal_obj_id++; - GD_RETURN_FROM_NEW(newobj); + return makefunctor(newobj); } diff -ruN klic-3.003-2002-03-26/runtime/gmerge.c klic-3.003-2002-04-06/runtime/gmerge.c --- klic-3.003-2002-03-26/runtime/gmerge.c Sun Mar 24 16:32:59 2002 +++ klic-3.003-2002-04-06/runtime/gmerge.c Sat Apr 6 20:52:48 2002 @@ -7,6 +7,7 @@ #include #include /* debug_printf */ +#include /* isclass */ #include "atom.h" #include "funct.h" @@ -53,10 +54,17 @@ list0: { - struct cons *newout; - GC_TRY_TO_ALLOC(newout,(struct cons *),2,gc_request); + struct cons* newout; + q res; + + G_HEAPALLOC_WITH_CHECK(newout, 2, (struct cons*), res); + if( res == GENERIC_GCREQUEST ){ + G_MAKE_VAR(newvar); + G_KL1_UNIFY(g_term, newvar); + GC_RETURN_WITH_HOOK(newvar); + } newout->car = car_of(g_term); - GCSET_VAR(newout->cdr); + newout->cdr = makeref(&(newout->cdr)); do_shallow_unify(g_self->outstream, makecons(newout)); g_self->outstream = newout->cdr; g_term = cdr_of(g_term); @@ -72,7 +80,7 @@ functor0: goto invalid_data; generic_data0: - if (GD_IS_CLASS(vector, g_term)) { + if( isclass(g_term, vector) ){ unsigned long size; unsigned long i; { @@ -87,30 +95,29 @@ q argv[2]; q hook_var; for (i=0; icount -= size - i -1; + G_MAKE_VAR(newvar); + GC_MAKE_MERGE_IN_GOAL(newvar, g_term, i, size); + GC_RETURN_WITH_HOOK(newvar); + } derefone(hook_var) = GC_MAKE_HOOK_VAR((struct consumer_object*) g_self); G_KL1_UNIFY(argv[1], hook_var); } } GC_TERMINATE; - gc_request2: - g_self->count -= size-i-1; - G_MAKE_VAR(newvar); - GC_MAKE_MERGE_IN_GOAL(newvar, g_term, i, size); - GC_RETURN_WITH_HOOK(newvar); } else goto invalid_data; susp0: GC_RETURN_WITH_HOOK(g_term); invalid_data: debug_printf("### %k ###\n", g_term); fatal("Invalid data unified with merger"); - gc_request: - G_MAKE_VAR(newvar); - G_KL1_UNIFY(g_term, newvar); - GC_RETURN_WITH_HOOK(newvar); } G_DEF_GC() diff -ruN klic-3.003-2002-03-26/runtime/gmodule.c klic-3.003-2002-04-06/runtime/gmodule.c --- klic-3.003-2002-03-26/runtime/gmodule.c Sun Mar 24 15:42:08 2002 +++ klic-3.003-2002-04-06/runtime/gmodule.c Sat Apr 6 20:52:48 2002 @@ -35,13 +35,9 @@ GDDEF_GUNIFY() { - G_STD_DECL; - - if (g_self->method_table != GD_OTHER->method_table || - g_self->name != GD_OTHER->name) - GD_GFAIL; - else - GD_GSUCCEED; + return (g_self->method_table == GD_OTHER->method_table && + g_self->name == GD_OTHER->name ) ? + GENERIC_SUCCEEDED : GENERIC_FAILED; } @@ -77,7 +73,7 @@ { G_STD_DECL; - GD_SWITCH_ON_METHOD { + switch( g_method_functor ){ GD_METHOD_CASE(name_1); GD_METHOD_CASE_DEFAULT; } @@ -94,8 +90,7 @@ GDDEF_GMETHOD(module_0) { - G_STD_DECL; - GD_GSUCCEED; + return GENERIC_SUCCEEDED; } GDDEF_GMETHOD(defined_2) @@ -105,22 +100,19 @@ q arity = g_argv[1]; GD_GDEREF(predname); - if( !issym(predname) ) GD_GFAIL; + if( !issym(predname) ) return GENERIC_FAILED; GD_GDEREF(arity); - if( !isint(arity) || intval(arity) < 0 ) GD_GFAIL; - if( locate_predicate_in_module(g_self->name, predname, - intval(arity)) != NULL ){ - GD_GSUCCEED; - } else { - GD_GFAIL; - } + if( !isint(arity) || intval(arity) < 0 ) return GENERIC_FAILED; + return + (locate_predicate_in_module(g_self->name, predname, intval(arity)) != NULL ? + GENERIC_SUCCEEDED : GENERIC_FAILED ); } GDDEF_GGENERIC() { G_STD_DECL; - GD_SWITCH_ON_METHOD { + switch( g_method_functor ){ GD_GMETHOD_CASE(module_0); GD_GMETHOD_CASE(defined_2); GD_GMETHOD_CASE_DEFAULT; @@ -156,9 +148,9 @@ G_OBJ_TYPE* newmodule; G_SET_NEWOBJ_FOR_NEW(newmodule, sizeof(struct module_object)); newmodule->name = atom; - GD_RETURN_FROM_NEW(newmodule); + return makefunctor(newmodule); } } /* not found: return the name atom itself */ - GD_RETURN_FROM_NEW(atom); + return makefunctor(atom); } diff -ruN klic-3.003-2002-03-26/runtime/gmvv.c klic-3.003-2002-04-06/runtime/gmvv.c --- klic-3.003-2002-03-26/runtime/gmvv.c Sun Mar 24 15:42:27 2002 +++ klic-3.003-2002-04-06/runtime/gmvv.c Sat Apr 6 20:52:48 2002 @@ -51,7 +51,7 @@ /* Go down to the shallwed version inverting pointers */ last = VECTOR_SHALLOW_MARK; - v = GD_OBJ(vector); + v = makefunctor(vector); do { next = VECTOR_OBJ(v)->next; VECTOR_OBJ(v)->next = last; @@ -86,28 +86,27 @@ { G_STD_DECL; long size, k; - if( g_self->method_table != GD_OTHER->method_table ) GD_GFAIL; + if( g_self->method_table != GD_OTHER->method_table ) return GENERIC_FAILED; Shallow(g_self); size = g_self->index; Shallow(GD_OTHER); - if (GD_OTHER->index != size) GD_GFAIL; + if( GD_OTHER->index != size ) return GENERIC_FAILED; for (k=0; kbody[k]; Shallow(g_self); - retval = GD_GUNIFY(g_self->body[k], x); + retval = eq_terms_body(g_self->body[k], x); switch ((long)retval) { case GENERIC_SUCCEEDED: break; case GENERIC_FAILED: - GD_GFAIL; - break; + return GENERIC_FAILED; default: - GD_GRETURN(retval); + return retval; } Shallow(GD_OTHER); } - GD_GSUCCEED; + return GENERIC_SUCCEEDED; } GDDEF_UNIFY() @@ -228,7 +227,7 @@ g_self->index = position; g_self->body = (q*) olddata; body[position] = g_argv[1]; - g_self->next = GD_OBJ(newvect); + g_self->next = makefunctor(newvect); newvect->body = body; } else { long k; @@ -241,7 +240,7 @@ newvect->next = VECTOR_SHALLOW_MARK; newvect->index = size; newvect->iscnst = 0; - G_UNIFY_VALUE(g_argv[2], GD_OBJ(newvect)); + G_UNIFY_VALUE(g_argv[2], makefunctor(newvect)); } GDDEF_METHOD(set__element_4) @@ -267,7 +266,7 @@ g_self->index = position; g_self->body = (q*) olddata; body[position] = g_argv[2]; - g_self->next = GD_OBJ(newvect); + g_self->next = makefunctor(newvect); newvect->body = body; } else { long k; @@ -280,7 +279,7 @@ newvect->next = VECTOR_SHALLOW_MARK; newvect->index = size; newvect->iscnst = 0; - G_UNIFY_VALUE(g_argv[3], GD_OBJ(newvect)); + G_UNIFY_VALUE(g_argv[3], makefunctor(newvect)); } GDDEF_METHOD(split_3) @@ -352,7 +351,7 @@ { G_STD_DECL; - GD_SWITCH_ON_METHOD{ + switch( g_method_functor ){ GD_METHOD_CASE(element_2); GD_METHOD_CASE(size_1); GD_METHOD_CASE(set__element_3); @@ -373,7 +372,7 @@ Shallow(g_self); GDSET_GINTARG_WITHIN_RANGE(position, g_argv[0], 0, g_self->index); g_argv[1] = g_self->body[position]; - GD_GSUCCEED; + return GENERIC_SUCCEEDED; } GDDEF_GMETHOD(vector_1) @@ -381,13 +380,13 @@ G_STD_DECL; Shallow(g_self); g_argv[0] = makeint(g_self->index); - GD_GSUCCEED; + return GENERIC_SUCCEEDED; } GDDEF_GGENERIC() { G_STD_DECL; - GD_SWITCH_ON_METHOD { + switch( g_method_functor ){ GD_GMETHOD_CASE(element_2); GD_GMETHOD_CASE(vector_1); GD_GMETHOD_CASE_DEFAULT; @@ -516,26 +515,16 @@ newvect->iscnst = 0; newvect->index = size; newvect->body = body; - GD_RETURN_FROM_NEW(newvect); + return makefunctor(newvect); } /* Interface with builtin predicates */ extern q -create_vector(body, size) - q* body; - long size; -{ - return create_vector0(body, size); -} - -extern q -create_vector0(body, size) - q* body; - long size; +create_vector(q* body, long size) { G_STD_DECL; - struct vector_object *newvect; + struct vector_object* newvect; heapalloc(newvect, G_SIZE_IN_Q(G_OBJ_TYPE), (G_OBJ_TYPE*)); newvect->method_table = &G_method_table; newvect->next = VECTOR_SHALLOW_MARK; diff -ruN klic-3.003-2002-03-26/runtime/gpointer.c klic-3.003-2002-04-06/runtime/gpointer.c --- klic-3.003-2002-03-26/runtime/gpointer.c Sun Mar 24 16:24:20 2002 +++ klic-3.003-2002-04-06/runtime/gpointer.c Sat Apr 6 20:52:48 2002 @@ -17,11 +17,9 @@ GDDEF_GUNIFY() { - G_STD_DECL; - - if (g_self->method_table != GD_OTHER->method_table) GD_GFAIL; - if (g_self->pointer != GD_OTHER->pointer) GD_GFAIL; - GD_GSUCCEED; + return (g_self->method_table == GD_OTHER->method_table && + g_self->pointer == GD_OTHER->pointer ) ? + GENERIC_SUCCEEDED : GENERIC_FAILED; } GDDEF_UNIFY() @@ -58,7 +56,7 @@ newobj = (G_OBJ_TYPE*) klic_alloc(G_OBJ_SIZE); newobj->method_table = &G_method_table; newobj->pointer = (char*) g_argv[0]; - GD_RETURN_FROM_NEW(newobj); + return makefunctor(newobj); } extern q diff -ruN klic-3.003-2002-03-26/runtime/gstring.c klic-3.003-2002-04-06/runtime/gstring.c --- klic-3.003-2002-03-26/runtime/gstring.c Sun Mar 24 15:42:59 2002 +++ klic-3.003-2002-04-06/runtime/gstring.c Sat Apr 6 20:52:48 2002 @@ -45,7 +45,7 @@ /* Go down to the shallwed version inverting pointers */ last = STRING_SHALLOW_MARK; - s = GD_OBJ(string); + s = makefunctor(string); do { next = STRING_OBJ(s)->next; STRING_OBJ(s)->next = last; @@ -80,22 +80,22 @@ { G_STD_DECL; long size, k; - if (g_self->method_table != GD_OTHER->method_table) GD_GFAIL; + if( g_self->method_table != GD_OTHER->method_table ) return GENERIC_FAILED; Shallow(g_self); size = g_self->index; Shallow(GD_OTHER); - if (GD_OTHER->index != size) GD_GFAIL; - if (IS_SHALLOW_STRING(g_self)) { - if (BCMP(g_self->body, GD_OTHER->body, size) != 0) GD_GFAIL; - } else { - for (k=0; kbody[k]; - Shallow(g_self); - if (g_self->body[k] != c) GD_GFAIL; - Shallow(GD_OTHER); - } + if( GD_OTHER->index != size ) return GENERIC_FAILED; + if( IS_SHALLOW_STRING(g_self) ){ + return (BCMP(g_self->body, GD_OTHER->body, size) == 0 ? + GENERIC_SUCCEEDED : GENERIC_FAILED ); } - GD_GSUCCEED; + for( k=0; kbody[k]; + Shallow(g_self); + if( g_self->body[k] != c ) return GENERIC_FAILED; + Shallow(GD_OTHER); + } + return GENERIC_SUCCEEDED; } GDDEF_UNIFY() @@ -226,7 +226,7 @@ g_self->index = position; g_self->body = (unsigned char *)(unsigned long)olddata; body[position] = newelem; - g_self->next = GD_OBJ(newstr); + g_self->next = makefunctor(newstr); newstr->body = body; } else { unsigned char *newbody; @@ -239,7 +239,7 @@ newstr->next = STRING_SHALLOW_MARK; newstr->index = size; newstr->iscnst = 0; - G_UNIFY_VALUE(g_argv[2], GD_OBJ(newstr)); + G_UNIFY_VALUE(g_argv[2], makefunctor(newstr)); } GDDEF_METHOD(split_3) @@ -339,7 +339,7 @@ { G_STD_DECL; - GD_SWITCH_ON_METHOD{ + switch( g_method_functor ){ GD_METHOD_CASE(string_2); GD_METHOD_CASE(element_2); GD_METHOD_CASE(size_1); @@ -362,7 +362,7 @@ Shallow(g_self); GDSET_GINTARG_WITHIN_RANGE(position, g_argv[0], 0, (long) g_self->index); g_argv[1] = makeint((long) g_self->body[position]); - GD_GSUCCEED; + return GENERIC_SUCCEEDED; } GDDEF_GMETHOD(string_2) @@ -372,7 +372,7 @@ Shallow(g_self); g_argv[0] = makeint(g_self->index); g_argv[1] = makeint(ELEMSIZE); - GD_GSUCCEED; + return GENERIC_SUCCEEDED; } static int compare_two_strings(G_OBJ_TYPE* s1, G_OBJ_TYPE* s2) @@ -415,11 +415,11 @@ G_OBJ_TYPE* other; int cmp; - if (!G_ISGOBJ(otherq)) GD_GFAIL; + if( !G_ISGOBJ(otherq) ) return GENERIC_FAILED; other = (G_OBJ_TYPE*) functorp(otherq); - if (other->method_table != g_self->method_table) GD_GFAIL; + if( other->method_table != g_self->method_table ) return GENERIC_FAILED; cmp = compare_two_strings(g_self, other); - if (cmp < 0) GD_GSUCCEED; else GD_GFAIL; + return cmp < 0 ? GENERIC_SUCCEEDED : GENERIC_FAILED; } GDDEF_GMETHOD(not__less__than_1) @@ -429,11 +429,11 @@ G_OBJ_TYPE* other; int cmp; - if (!G_ISGOBJ(otherq)) GD_GFAIL; + if( !G_ISGOBJ(otherq) ) return GENERIC_FAILED; other = (G_OBJ_TYPE*) functorp(otherq); - if (other->method_table != g_self->method_table) GD_GFAIL; + if( other->method_table != g_self->method_table ) return GENERIC_FAILED; cmp = compare_two_strings(g_self, other); - if (cmp >= 0) GD_GSUCCEED; else GD_GFAIL; + return cmp >= 0 ? GENERIC_SUCCEEDED : GENERIC_FAILED; } GDDEF_GMETHOD(estring_3) @@ -444,20 +444,20 @@ Shallow(g_self); size = g_self->index; - if( intval(g_argv[0]) != size ) GD_GFAIL; - if( intval(g_argv[1]) != ELEMSIZE ) GD_GFAIL; + if( intval(g_argv[0]) != size ) return GENERIC_FAILED; + if( intval(g_argv[1]) != ELEMSIZE ) return GENERIC_FAILED; tmp = g_argv[2]; for( k=0; k < size; k++, tmp = cdr_of(tmp) ){ - if( intval(car_of(tmp)) != g_self->body[k] ) GD_GFAIL; + if( intval(car_of(tmp)) != g_self->body[k] ) return GENERIC_FAILED; } - GD_GSUCCEED; + return GENERIC_SUCCEEDED; } GDDEF_GGENERIC() { G_STD_DECL; - GD_SWITCH_ON_METHOD { + switch( g_method_functor ){ GD_GMETHOD_CASE(element_2); GD_GMETHOD_CASE(string_2); GD_GMETHOD_CASE(less__than_1); @@ -601,7 +601,7 @@ newstr->iscnst = 0; newstr->index = size; newstr->body = body; - GD_RETURN_FROM_NEW(newstr); + return makefunctor(newstr); } #ifdef DIST diff -ruN klic-3.003-2002-03-26/runtime/gtermarray.c klic-3.003-2002-04-06/runtime/gtermarray.c --- klic-3.003-2002-03-26/runtime/gtermarray.c Sun Mar 24 16:27:38 2002 +++ klic-3.003-2002-04-06/runtime/gtermarray.c Sat Apr 6 20:52:48 2002 @@ -16,12 +16,10 @@ GDDEF_GUNIFY() { - G_STD_DECL; - - if (g_self->method_table != GD_OTHER->method_table) GD_GFAIL; - if (g_self->terms != GD_OTHER->terms) GD_GFAIL; - if (g_self->nterm != GD_OTHER->nterm) GD_GFAIL; - GD_GSUCCEED; + return (g_self->method_table == GD_OTHER->method_table && + g_self->terms == GD_OTHER->terms && + g_self->nterm == GD_OTHER->nterm ) ? + GENERIC_SUCCEEDED : GENERIC_FAILED; } GDDEF_UNIFY() @@ -67,5 +65,5 @@ for (i=0; iterms[i] = g_argv[i]; } - GD_RETURN_FROM_NEW(newobj); + return makefunctor(newobj); } diff -ruN klic-3.003-2002-03-26/runtime/intrpt.c klic-3.003-2002-04-06/runtime/intrpt.c --- klic-3.003-2002-03-26/runtime/intrpt.c Tue Mar 19 14:04:56 2002 +++ klic-3.003-2002-04-06/runtime/intrpt.c Sat Apr 6 20:52:48 2002 @@ -85,7 +85,7 @@ /* signal handling */ #ifdef USESIG - if( !signal_done ){ + if( !signal_done() ){ klic_signal_handler(); allocp = heapp(); retry = (heapp() + this_more_space() >= real_heaplimit()); diff -ruN klic-3.003-2002-03-26/runtime/kmain.c klic-3.003-2002-04-06/runtime/kmain.c --- klic-3.003-2002-03-26/runtime/kmain.c Tue Mar 26 16:08:40 2002 +++ klic-3.003-2002-04-06/runtime/kmain.c Sat Apr 6 20:52:48 2002 @@ -436,8 +436,8 @@ IDLE_ON(); #ifdef SHM_DIST if (!(IS_SHOEN_NODE(my_node))) { - if (interrupt_off) while ( (heapp() <= heaplimit) && (signal_done)); - if (!signal_done) { + if( interrupt_off ) while( (heapp() <= heaplimit) && signal_done() ) ; + if( !signal_done() ){ heaplimit = 0; interrupt_off = 0; } diff -ruN klic-3.003-2002-03-26/runtime/ktimer.c klic-3.003-2002-04-06/runtime/ktimer.c --- klic-3.003-2002-03-26/runtime/ktimer.c Tue Mar 12 13:59:02 2002 +++ klic-3.003-2002-04-06/runtime/ktimer.c Sat Apr 6 20:52:48 2002 @@ -13,7 +13,7 @@ #include /* malloc_check, register_gc_hook */ #include #include "timer.h" -#include +#include /* set_alarm_signal */ #include /* do_unify_value */ extern void copy_one_term(); @@ -23,8 +23,7 @@ declare_globals; interrupt_off = 0; heaplimit = 0; - signal_done = 0; - signal_flags[SIGALRM] = 1; + set_alarm_signal(); } struct timer_reservation_rec { diff -ruN klic-3.003-2002-03-26/runtime/signal.c klic-3.003-2002-04-06/runtime/signal.c --- klic-3.003-2002-03-26/runtime/signal.c Tue Mar 12 13:28:17 2002 +++ klic-3.003-2002-04-06/runtime/signal.c Sat Apr 6 20:52:48 2002 @@ -14,6 +14,7 @@ #include #include /* do_unify, do_unify_value */ +#define signal_flags (klic_sgnl_flags->flags) #define signal_handlers (klic_sgnl_flags->sgnl_handlers) extern void copy_one_term(); @@ -21,6 +22,12 @@ static struct klic_sgnl_flags my_klic_sgnl_flags; volatile struct klic_sgnl_flags* klic_sgnl_flags = &my_klic_sgnl_flags; +extern int signal_done(void){ return klic_sgnl_flags->done; } +extern void set_alarm_signal(void){ + klic_sgnl_flags->done = 0; + signal_flags[SIGALRM] = 1; +} + /**************************************** GENERAL SIGNAL HANDLING UTILITY ****************************************/ @@ -35,7 +42,7 @@ declare_globals; interrupt_off = 0; heaplimit = 0; - signal_done = 0; + klic_sgnl_flags->done = 0; signal_flags[sig] = 1; } @@ -48,14 +55,14 @@ int sig; do { - signal_done = 1; + klic_sgnl_flags->done = !0; for (sig = 0; sig < NSIG; sig++) { if (signal_flags[sig]) { int again; signal_flags[sig] = 0; again = signal_handlers[sig](sig); if (again) { - signal_done = 0; + klic_sgnl_flags->done = 0; signal_flags[sig] = 1; interrupt_off = 0; return; @@ -66,11 +73,11 @@ heaplimit = real_heaplimit(); for (sig = 0; sig < NSIG; sig++) { if (signal_flags[sig]) { - signal_done = 0; + klic_sgnl_flags->done = 0; break; } } - } while (!signal_done); + }while( !klic_sgnl_flags->done ); } /* Utility subroutine to add signal handlers */