diff -ruN klic-3.003-2002-01-12/include/klic/gd_macro.h klic-3.003-2002-01-12a/include/klic/gd_macro.h --- klic-3.003-2002-01-12/include/klic/gd_macro.h Mon Dec 31 12:04:47 2001 +++ klic-3.003-2002-01-12a/include/klic/gd_macro.h Sat Jan 12 20:05:30 2002 @@ -36,7 +36,6 @@ #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_body_no_arity(fa) GD_body0(GD_CLASS_NAME(),fa) #define GD_OBJ(x) G_MAKEFUNCTOR(x) @@ -315,14 +314,6 @@ long g_method_functor; \ q GD_ARGV[]; \ q *g_allocp; - -#define GDDEF_METHOD_NO_ARITY(fn) \ - q * \ - GD_body_no_arity(fn)(GD_SELF,g_method_functor,GD_ARGV,g_allocp) \ - GD_OBJ_TYPE *GD_SELF; \ - long g_method_functor; \ - q GD_ARGV[]; \ - q *g_allocp; /**********************************************************************/ #define GDDEF_GUNIFY() \ diff -ruN klic-3.003-2002-01-12/runtime/alloc.c klic-3.003-2002-01-12a/runtime/alloc.c --- klic-3.003-2002-01-12/runtime/alloc.c Sun Dec 30 17:14:44 2001 +++ klic-3.003-2002-01-12a/runtime/alloc.c Sat Jan 12 20:05:30 2002 @@ -79,7 +79,7 @@ if (num_gc_hooks >= gc_hooktab_size) { gc_hooktab_size *= 2; gc_hook_table = (q*(**)()) - realloc_check(gc_hook_table, gc_hooktab_size*sizeof(q*(**)())); + realloc_check((char*) gc_hook_table, gc_hooktab_size*sizeof(q*(**)())); } gc_hook_table[num_gc_hooks++] = routine; } @@ -92,7 +92,7 @@ if (num_after_gc_hooks >= after_gc_hooktab_size) { after_gc_hooktab_size *= 2; after_gc_hook_table = (q*(**)()) - realloc_check(after_gc_hook_table, + realloc_check((char*) after_gc_hook_table, after_gc_hooktab_size*sizeof(q*(**)())); } after_gc_hook_table[num_after_gc_hooks++] = routine; diff -ruN klic-3.003-2002-01-12/runtime/g_pointer.h klic-3.003-2002-01-12a/runtime/g_pointer.h --- klic-3.003-2002-01-12/runtime/g_pointer.h Fri Dec 28 13:46:47 2001 +++ klic-3.003-2002-01-12a/runtime/g_pointer.h Sat Jan 12 20:05:30 2002 @@ -9,8 +9,8 @@ #define _KLIC_G_POINTER_H_ struct pointer_object { - struct data_object_method_table *method_table; - char *pointer; + struct data_object_method_table* method_table; + char* pointer; }; #endif /* _KLIC_G_POINTER_H_ */ diff -ruN klic-3.003-2002-01-12/runtime/g_termarray.h klic-3.003-2002-01-12a/runtime/g_termarray.h --- klic-3.003-2002-01-12/runtime/g_termarray.h Fri Dec 28 13:46:47 2001 +++ klic-3.003-2002-01-12a/runtime/g_termarray.h Sat Jan 12 20:05:30 2002 @@ -9,7 +9,7 @@ #define _KLIC_G_TERMARRAY_H_ struct termarray_object { - struct data_object_method_table *method_table; + struct data_object_method_table* method_table; unsigned long nterm; q terms[1]; }; diff -ruN klic-3.003-2002-01-12/runtime/gc.c klic-3.003-2002-01-12a/runtime/gc.c --- klic-3.003-2002-01-12/runtime/gc.c Fri Jan 11 10:00:01 2002 +++ klic-3.003-2002-01-12a/runtime/gc.c Sat Jan 12 20:06:35 2002 @@ -24,28 +24,32 @@ #ifdef SHM #include "shm.h" -/* a following line is for debugging of reverse pointer problem. */ -static int hirata_bug1; - -#define push_shm_stack(addr,sp,max) \ -{ \ - if ( (sp) == max ) { \ - (sp) = make_shm_larger_stack(sp); \ - max = shm_gcmax; \ - } \ - *(sp)++ = (q*)(addr); \ -} +#define push_shm_stack(addr,sp,max) \ +do{ \ + if( (sp) == max ){ \ + (sp) = make_shm_larger_stack(sp); \ + max = shm_gcmax; \ + } \ + *(sp)++ = (q*) (addr); \ +}while(0) #endif /* SHM */ #define generic_gc(obj, allocp, sp) \ (method_table_of(obj)->gc((obj), (allocp), (sp))) +#ifdef DEBUGLIB +extern const struct predicate queue_empty_pred; +#endif + extern struct goalrec goal_queue_tail; -static Inline void flip_spaces() +static struct goalrec* collect_garbage(struct goalrec* qp); + +static Inline void +flip_spaces() { declare_globals; - q *tempp = new_space_top; + q* tempp = new_space_top; unsigned long temps = new_space_size; new_space_top = old_space_top; new_space_size = old_space_size; @@ -53,47 +57,47 @@ old_space_size = temps; } -static struct goalrec *collect_garbage(); - -struct goalrec *klic_gc(qp) - struct goalrec *qp; +extern struct goalrec* +klic_gc(qp) + struct goalrec* qp; { - timerstruct before, after; declare_globals; - static lastgc_dangerous = 0; + timerstruct before, after; + static int lastgc_dangerous = 0; static int make_heap_larger = 0; /* make heap larger in the next GC */ - q *new_new_space_top; + q* new_new_space_top; unsigned long bytesize; int k; - if (measure_gc) measure(before); + if( measure_gc ) measure(before); + gc_again: - if (make_heap_larger) { - q *new_old_space_top; + if( make_heap_larger ){ + q* new_old_space_top; heapsize *= 2; - if (heapsize > maxheapsize) heapsize = maxheapsize; - bytesize = (heapsize+incrementsize)*sizeof(q); - new_old_space_top = (q *)malloc(bytesize); - if (new_old_space_top != 0) { - new_new_space_top = (q *)malloc(bytesize); - if (new_new_space_top != 0) { + if( heapsize > maxheapsize ) heapsize = maxheapsize; + bytesize = (heapsize+incrementsize) * sizeof(q); + new_old_space_top = (q*) malloc(bytesize); + if( new_old_space_top != NULL ){ + new_new_space_top = (q*) malloc(bytesize); + if( new_new_space_top != NULL ){ free(old_space_top); old_space_top = new_old_space_top; old_space_size = bytesize; - } else { + }else{ free(new_old_space_top); - if (lastgc_dangerous) { + if( lastgc_dangerous ){ fatal("Not enough space collected and can't make heap larger"); } } } - } else if (lastgc_dangerous) { + }else if( lastgc_dangerous ){ fatalf("Maximum heap size specified (%u words) has been used up", maxheapsize); } flip_spaces(); copied_susp = 0; /* for perpetual suspension detection */ qp = collect_garbage(qp); - if (make_heap_larger) { + if( make_heap_larger ){ free(old_space_top); old_space_top = new_new_space_top; old_space_size = bytesize; @@ -101,15 +105,16 @@ make_heap_larger = (heapp-new_space_top+this_more_space > heapsize*maxactiveratio && heapsize < maxheapsize); - if (lastgc_dangerous = (real_heaplimit < heapp+this_more_space)) { + lastgc_dangerous = (real_heaplimit < heapp+this_more_space); + if( lastgc_dangerous ){ goto gc_again; } this_more_space = 0; gctimes++; #ifdef SHM - if ( F_shm_gc ) qp = shm_gc(qp); + if( F_shm_gc ) qp = shm_gc(qp); #endif - if (measure_gc) { + if( measure_gc ){ measure(after); #ifdef GETRUSAGE gcums += diff_usec(ru_utime)/1000; @@ -123,180 +128,179 @@ } -q** +extern q** make_larger_stack(sp) - q**sp; + q** sp; { declare_globals; - q **newstack; + q** newstack; gcstack_size *= 2; - newstack = (q**)realloc_check(gcstack, gcstack_size*sizeof(q*)); - sp = newstack+(sp-gcstack); + newstack = (q**) realloc_check(gcstack, gcstack_size*sizeof(q*)); + sp = newstack + (sp - gcstack); gcstack = newstack; - gcmax = newstack+gcstack_size; + gcmax = newstack + gcstack_size; return sp; } #ifdef SHM -q** make_shm_larger_stack(sp) - q**sp; +extern q** +make_shm_larger_stack(sp) + q** sp; { declare_globals; - q **newstack; + q** newstack; shm_gcstack_size *= 2; - newstack = (q**)realloc_check(shm_gcstack, shm_gcstack_size*sizeof(q*)); - sp = newstack+(sp-shm_gcstack); + newstack = (q**) realloc_check(shm_gcstack, shm_gcstack_size*sizeof(q*)); + sp = newstack + (sp - shm_gcstack); shm_gcstack = newstack; - shm_gcmax = newstack+shm_gcstack_size; + shm_gcmax = newstack + shm_gcstack_size; return sp; } -#endif +#endif /* SHM */ #define within_new_space(x) \ -( (unsigned long)(x) - (unsigned long)ntop < nsize) + ((unsigned long)(x) - (unsigned long)ntop < nsize) #define within_old_space(x) \ -( (unsigned long)(x) - (unsigned long)otop < osize) + ((unsigned long)(x) - (unsigned long)otop < osize) #define push_gc_stack(addr, sp, max) \ -{ \ - if ((sp) == max) { \ +do{ \ + if( (sp) == max ){ \ (sp) = make_larger_stack(sp); \ max = gcmax; \ } \ *(sp)++ = (addr); \ -} +}while(0) #ifdef SHM -#define reserve_copy(from, to, sp, max) \ -if (from == makeref(&from)) { \ - to = from = makeref(&to); \ -} else { \ - to = from; \ - if (!isatomic(from)) { \ - if ( is_shma(from) ) { \ - push_shm_stack(&to,shm_sp,shm_gcmax); \ - } else if ( within_old_space(from )) { \ - from = makeref(&to); \ - push_gc_stack(&to, sp, max); \ - } \ - } \ +#define reserve_copy(from, to, sp, max) \ +if( from == makeref(&from) ){ \ + to = from = makeref(&to); \ +}else{ \ + to = from; \ + if( !isatomic(from) ){ \ + if( is_shma(from) ){ \ + push_shm_stack(&to, shm_sp, shm_gcmax); \ + }else if( within_old_space(from) ){ \ + from = makeref(&to); \ + push_gc_stack(&to, sp, max); \ + } \ + } \ +} +#else /* not SHM */ +#define reserve_copy(from, to, sp, max) \ +if( from == makeref(&from) ){ \ + to = from = makeref(&to); \ +}else{ \ + to = from; \ + if( !isatomic(from) && within_old_space(from) ){ \ + from = makeref(&to); \ + push_gc_stack(&to, sp, max); \ + } \ } -#else -#define reserve_copy(from, to, sp, max) \ -if (from == makeref(&from)) { \ - to = from = makeref(&to); \ -} else { \ - to = from; \ - if (!isatomic(from) && within_old_space(from)) { \ - from = makeref(&to); \ - push_gc_stack(&to, sp, max); \ - } \ -} -#endif +#endif /* not SHM */ #define copy_one_goal(goal, sp, max, susp) \ -{ \ - struct goalrec *og=(goal); \ - int n = (og)->pred->arity; \ - struct goalrec *ng = (struct goalrec *)hp; \ +do{ \ + struct goalrec* og = (goal); \ + int n = og->pred->arity; \ + struct goalrec* ng = (struct goalrec*) hp; \ hp += n + 2; \ ng->next = og->next; \ og->next = ng; \ ng->pred = og->pred; \ og->pred = 0; \ - while (--n >= 0) { \ + while( --n >= 0 ){ \ reserve_copy(og->args[n], ng->args[n], (sp), (max)); \ } \ (goal) = ng; \ - if (susp) copied_susp++; \ -} + if( susp ) copied_susp++; \ +}while(0) -static q * +static q* copy_terms(hp, ntop, otop, nsize, osize, sp, max) - q *hp; - q *ntop, *otop; - unsigned long nsize, osize; - q **sp, **max; + q* hp; + q* ntop; + q* otop; + unsigned long nsize, osize; + q** sp; + q** max; { declare_globals; - while (sp > gcstack) { - q *addr = *--sp; - q obj = *addr; + while( sp > gcstack ){ + q* addr; + q obj; + + sp--; + addr = *sp; + obj = *addr; + loop: #ifdef SHM - if ( is_shma(obj) ) { - *addr = obj; - if ( ptagof(obj) != ATOMIC ) { - push_shm_stack(addr,shm_sp,shm_gcmax); - } - continue; - } + if( is_shma(obj) ){ + *addr = obj; + if( ptagof(obj) != ATOMIC ){ + push_shm_stack(addr, shm_sp, shm_gcmax); + } + continue; /* while stack rests */ + } #endif - switch (ptagof(obj)) { + + switch( ptagof(obj) ){ case ATOMIC: *addr = obj; break; + case VARREF: { q value; deref: value = derefone(obj); - switch (ptagof(value)) { + switch( ptagof(value) ){ case VARREF: - if (derefone(value) == obj) { - if (value == obj) { - if (within_new_space(addr)) { + if( derefone(value) == obj ){ + if( value == obj ){ + if( within_new_space(addr) ){ *addr = derefone(obj) = makeref(addr); - } else { + }else{ *addr = derefone(obj) = *hp = makeref(hp); hp++; } - } else { - struct susprec *s; -/* - if(value > obj) { - s = suspp(value); - } else { - s = suspp(obj); - } -*/ s = suspp(value); - if (is_generator_susp(s->u)) { - struct generator_susp *gsusp = generator_suspp(s); + }else{ + struct susprec* s = suspp(value); + if( is_generator_susp(s->u) ){ + struct generator_object* oldobj; + struct generator_susp* newgsusp; + struct generator_susp* gsusp = generator_suspp(s); + q newplace; q newvar = *addr = derefone(obj) = makeref(hp); + hp++; - { - struct generator_susp *newgsusp = generator_suspp(hp); - hp += sizeof(struct generator_susp) / sizeof(q); - derefone(newvar) = makeref(newgsusp); - newgsusp->backpt = makeref(newvar); - { - struct generator_object *oldobj = - untag_generator_susp(gsusp->u.o); - q newplace = (q)(oldobj->method_table); - if(!isstruct(newplace)) { - /* not yet copied */ - struct generator_object *newobj - = (struct generator_object *) - generic_gc(oldobj, hp, sp); - sp = gcsp; - hp = heapp; - oldobj->method_table = - (struct generator_object_method_table *) - makefunctor(newobj); - newgsusp->u.o = tag_generator_susp(newobj); - } else { - /* already copied */ - newgsusp->u.o = - tag_generator_susp(functorp(newplace)); - } - } + newgsusp = generator_suspp(hp); + hp += sizeof(struct generator_susp) / sizeof(q); + derefone(newvar) = makeref(newgsusp); + newgsusp->backpt = makeref(newvar); + oldobj = untag_generator_susp(gsusp->u.o); + newplace = (q) (oldobj->method_table); + if( isstruct(newplace) ){ + /* already copied */ + newgsusp->u.o = tag_generator_susp(functorp(newplace)); + }else{ + /* not yet copied */ + struct generator_object* newobj = + (struct generator_object*) generic_gc(oldobj, hp, sp); + sp = gcsp; + hp = heapp; + oldobj->method_table = + (struct generator_object_method_table*) makefunctor(newobj); + newgsusp->u.o = tag_generator_susp(newobj); } - } else { - struct hook *second_hook = s->u.first_hook.next; - struct hook *h = second_hook; + }else{ + struct hook* second_hook = s->u.first_hook.next; + struct hook* h = second_hook; struct hook dummy; - struct hook *last = &dummy; + struct hook* last = &dummy; union goal_or_consumer lastu; q newvar; @@ -304,41 +308,40 @@ newvar = *addr = derefone(obj) = *hp = makeref(hp); hp++; lastu.l = 0; - do { - union goal_or_consumer u; - u = h->u; - if (u.l != 0) { + do{ + union goal_or_consumer u = h->u; + if( u.l != 0 ){ union goal_or_consumer nu; nu.l = 0; - if (!is_consumer_hook(u)) { + if( !is_consumer_hook(u) ){ /* suspended goal */ - if (u.g->pred == 0) { + if( u.g->pred == 0 ){ nu.g = u.g->next; - } else if (!isref(u.g->next)) { + }else if( !isref(u.g->next) ){ nu.g = u.g; copy_one_goal(nu.g, sp, max, 1); - } else { - goto not_a_valid_hook; + }else{ + goto invalid_hook; } - } else { + }else{ /* consumer object */ - q newplace = (q)(untag_consumer_hook(u.o)->method_table); - if (isstruct(newplace)) { + q newplace = (q) (untag_consumer_hook(u.o)->method_table); + if( isstruct(newplace) ){ nu.o = tag_consumer_hook(functorp(newplace)); - } else { - struct consumer_object *newobj = - (struct consumer_object *) + }else{ + struct consumer_object* newobj = + (struct consumer_object*) generic_gc(untag_consumer_hook(u.o), hp, sp); sp = gcsp; hp = heapp; untag_consumer_hook(u.o)->method_table = - (struct consumer_object_method_table *) + (struct consumer_object_method_table*) makefunctor(newobj); nu.o = tag_consumer_hook(newobj); } } - if (lastu.l != 0) { - struct hook *nh = (struct hook *)hp; + if( lastu.l != 0 ){ + struct hook* nh = (struct hook*) hp; hp += sizeof(struct hook)/sizeof(q); nh->u = lastu; last->next = nh; @@ -346,34 +349,34 @@ } lastu = nu; } - not_a_valid_hook: + invalid_hook: h = h->next; - } while (h != second_hook); - if (lastu.l != 0) { - struct susprec *ns = (struct susprec *)hp; + }while( h != second_hook ); + if( lastu.l != 0 ){ + struct susprec* ns = (struct susprec*) hp; hp += sizeof(struct susprec)/sizeof(q); last->next = &ns->u.first_hook; ns->backpt = newvar; ns->u.first_hook.next = dummy.next; ns->u.first_hook.u = lastu; - derefone(newvar) = (q)ns; + derefone(newvar) = (q) ns; } } } - } else if (within_old_space(value)) { + }else if( within_old_space(value) ){ obj = value; goto deref; - } else { + }else{ *addr = value; #ifdef SHM - if ( is_shma(value) ) push_shm_stack(addr,shm_sp,shm_gcmax); + if( is_shma(value) ) push_shm_stack(addr, shm_sp, shm_gcmax); #endif } break; case CONS: - if (within_new_space(value)) { + if( within_new_space(value) ){ *addr = makeref(&cdr_of(value)); - } else { + }else{ obj = value; goto cons_case; } @@ -387,61 +390,62 @@ } } break; + case CONS: cons_case: - if (within_old_space(obj)) { + if( within_old_space(obj) ){ q cdr = cdr_of(obj); - if (!isstruct(cdr) || !within_new_space(cdr)) { + if( !isstruct(cdr) || !within_new_space(cdr) ){ q newcons = makecons(hp); hp += 2; reserve_copy(car_of(obj), car_of(newcons), sp, max); *addr = cdr_of(obj) = newcons; - if (isatomic(cdr)) { + if( isatomic(cdr) ){ cdr_of(newcons) = cdr; - } else { - if (cdr == makeref(&cdr_of(obj))) { + }else{ + if( cdr == makeref(&cdr_of(obj)) ){ cdr_of(newcons) = makeref(&cdr_of(newcons)); - } else { + }else{ addr = &cdr_of(newcons); obj = cdr; goto loop; } } - } else { + }else{ *addr = cdr; } - } else { + }else{ *addr = obj; } break; + default: /* FUNCTOR */ functor_case: - if (within_old_space(obj)) { + if( within_old_space(obj) ){ q f = functor_of(obj); - if(!isstruct(f)){ - if(isref(f)) { - struct data_object *oldobj - = (struct data_object *)functorp(obj); - q *newobj; + if( !isstruct(f) ){ + if( isref(f) ){ + struct data_object* oldobj = (struct data_object*) functorp(obj); + q* newobj; newobj = generic_gc(oldobj, hp, sp); sp = gcsp; hp = heapp; *addr = functor_of(obj) = makefunctor(newobj); - } else { + }else{ q newfunct = makefunctor(hp); int k = arityof(f); hp += k+1; *addr = functor_of(obj) = newfunct; functor_of(newfunct) = f; - do { + do{ k--; reserve_copy(arg(obj,k), arg(newfunct,k), sp, max); - } while (k > 0); + }while( k > 0 ); } - } else { + }else{ *addr = f; } - } else { + }else{ *addr = obj; } break; @@ -451,14 +455,17 @@ return hp; } -struct goalrec *copy_one_queue(qp, hp, ntop, otop, nsize, osize) - struct goalrec *qp; - q *hp; - q *ntop, *otop; - unsigned long nsize, osize; +static struct goalrec* +copy_one_queue(qp, hp, ntop, otop, nsize, osize) + struct goalrec* qp; + q* hp; + q* ntop; + q* otop; + unsigned long nsize, osize; { declare_globals; - struct goalrec *last, *next; + struct goalrec* last; + struct goalrec* next; /* Copy queue in reverse order */ /* By this, variables will have better chance to be allocated */ @@ -466,20 +473,20 @@ /* their instantiation */ /* First, reverse the goal queue */ - for (last=0; qp!=&goal_queue_tail; last=qp, qp=next) { + for( last=NULL; qp != &goal_queue_tail; last=qp, qp=next ){ next = qp->next; qp->next = last; } /* Then copy and rearrange the goal queue */ qp = last; last = &goal_queue_tail; - for (; qp != 0; qp=next) { - next=qp->next; + for( ; qp != NULL; qp=next ){ + next = qp->next; #ifdef SHM - if ( is_shma(qp) ) { - qp->next = last; - last = qp; - continue; + if( is_shma(qp) ){ + qp->next = last; + last = qp; + continue; /* for qp */ } #endif copy_one_goal(qp, gcsp, gcmax, 0); @@ -491,33 +498,34 @@ return last; } -static struct goalrec *collect_garbage(qp) - struct goalrec *qp; +static struct goalrec* +collect_garbage(qp) + struct goalrec* qp; { declare_globals; int k; q *allocp, *ntop, *otop; unsigned long nsize, osize; - struct prioqrec *pq = prioq.next; + struct prioqrec* pq = prioq.next; #ifdef DIST - if (node_wtc == 0) { + if( node_wtc == 0 ){ fatal("invalid WTC in gc"); } #endif - if (gctimes==0) { + if( gctimes==0 ){ /* allocate GC stack on first GC */ gcstack_size = GCSTACKSIZE; - gcstack = (q**)malloc_check(gcstack_size*sizeof(q*)); + gcstack = (q**) malloc_check(gcstack_size*sizeof(q*)); gcsp = gcstack; gcmax = gcstack+gcstack_size; #ifdef SHM shm_gcstack_size = GCSTACKSIZE; - shm_gcstack = (q**)malloc(shm_gcstack_size*sizeof(q*)); + shm_gcstack = (q**) malloc(shm_gcstack_size*sizeof(q*)); shm_sp = shm_gcstack; shm_gcmax = shm_gcstack+shm_gcstack_size; - } else { + }else{ shm_sp = shm_gcstack; #endif } @@ -525,222 +533,217 @@ #ifdef SHM /* copy into Shared-memory Generator hook data */ { - TADDRtbl* sptr = &ADDRtbl; TADDRtbl* nptr; - sptr = &ADDRtbl; - for(sptr=sptr->next;sptr!=&ADDRtbl;sptr=nptr) { + TADDRtbl* sptr = &ADDRtbl; + for( sptr=sptr->next; sptr != &ADDRtbl; sptr=nptr ){ nptr = sptr->next; - switch(ptagof(sptr->localA)) { + switch( ptagof(sptr->localA) ){ case CONS: - case FUNCTOR: { /* generator hook */ - struct generator_object* addi; - Shvar* objp; - q temp; - Re_try: - temp = derefone(sptr->globalA); - if ( !isref(temp) ) { break; } - if ( derefone(temp) != (q)sptr->globalA ) { - sptr->globalA = (q*)temp; goto Re_try; - } - addi = n_lock(((q)sptr->globalA),temp); - if ( derefone(sptr->globalA) != temp ) { goto Re_try; } - objp = (Shvar*)untag_generator_susp(addi); - if ( is_genhook(objp->chain)) { - q tempg; - shm_arg_copy(&sptr->localA,&tempg); - klic_barrier(); - *(sptr->globalA) = tempg; - free_local_tbl(sptr); - } else { - n_unlock(temp,addi); + case FUNCTOR: /* generator hook */ + { + struct generator_object* addi; + Shvar* objp; + q temp; + Re_try: + temp = derefone(sptr->globalA); + if( !isref(temp) ){ break; /* switch */ } + if( derefone(temp) != (q) sptr->globalA ){ + sptr->globalA = (q*) temp; + goto Re_try; + } + addi = n_lock((q) sptr->globalA, temp); + if( derefone(sptr->globalA) != temp ){ goto Re_try; } + objp = (Shvar*) untag_generator_susp(addi); + if( is_genhook(objp->chain) ){ + q tempg; + shm_arg_copy(&sptr->localA, &tempg); + klic_barrier(); + *(sptr->globalA) = tempg; + free_local_tbl(sptr); + }else{ + n_unlock(temp, addi); + } } } - } } } -#endif +#endif /* SHM */ allocp = ntop = heaptop = new_space_top; otop = old_space_top; real_heapbytesize = nsize = new_space_size; osize = old_space_size; real_heaplimit = allocp+heapsize; - if (interrupt_off) heaplimit = real_heaplimit; - else heaplimit = 0; - heapbottom = real_heaplimit+incrementsize; + heaplimit = (interrupt_off ? real_heaplimit : 0); + heapbottom = real_heaplimit + incrementsize; - for (k=0; kprio >= 0; pq = pq->next) { + for( ; pq->prio >= 0; pq = pq->next ){ pq->q = copy_one_queue(pq->q, allocp, ntop, otop, nsize, osize); allocp = heapp; } qp = copy_one_queue(qp, allocp, ntop, otop, nsize, osize); + #ifdef SHM { - TADDRtbl* sptr = &ADDRtbl; + q* hp = heapp; TADDRtbl* nptr; - q *hp = heapp; - sptr = &ADDRtbl; - for(sptr=sptr->next;sptr!=&ADDRtbl;sptr=nptr) { + TADDRtbl* sptr = &ADDRtbl; + for( sptr=sptr->next; sptr!=&ADDRtbl; sptr=nptr ){ nptr = sptr->next; - switch(ptagof(sptr->localA)) { + switch( ptagof(sptr->localA) ){ case CONS: - case FUNCTOR: { /* generator hook but anybody reqested */ - push_gc_stack((q*)&sptr->localA,gcsp,gcmax); + case FUNCTOR: /* generator hook but anybody reqested */ + push_gc_stack((q*) &sptr->localA, gcsp, gcmax); hp = copy_terms(hp, ntop, otop, nsize, osize, gcsp, gcmax); - push_shm_stack(&sptr->globalA,shm_sp,shm_gcmax); + push_shm_stack(&sptr->globalA, shm_sp, shm_gcmax); break; - } - case ATOMIC: { /* genarator object (distributed interface) */ - q wk = (q)untag_local(sptr->localA); - if ( !derefone(wk) ) { /* consumer */ - q top = (q)&(sptr->localA); - derefone(wk) = top; - derefone(top) = wk; - push_gc_stack(&top,gcsp,gcmax); -/* patch for debugging of hirata problem */ - hirata_bug1 = 1; - hp = copy_terms(hp, ntop, otop, nsize, osize, gcsp, gcmax); - hirata_bug1 = 0; - wk = derefone(top); - if ( wk != top ) { - sptr->localA = (q*)tag_local(wk); + case ATOMIC: /* genarator object (distributed interface) */ + { + q wk = (q) untag_local(sptr->localA); + if( !derefone(wk) ){ /* consumer */ + /* a following line is for debugging of reverse pointer problem. */ + static int hirata_bug1; + + q top = (q) &(sptr->localA); + derefone(wk) = top; + derefone(top) = wk; + push_gc_stack(&top, gcsp, gcmax); + + /* patch for debugging of hirata problem */ + hirata_bug1 = 1; + hp = copy_terms(hp, ntop, otop, nsize, osize, gcsp, gcmax); + hirata_bug1 = 0; + + wk = derefone(top); + if( wk == top ) + goto REM_HOOK; + sptr->localA = (q*) tag_local(wk); derefone(wk) = 0; - push_shm_stack(&sptr->globalA,shm_sp,shm_gcmax); - } else goto REM_HOOK; - break; - } else { /* generator */ - push_gc_stack(&wk,gcsp,gcmax); - hp = copy_terms(hp, ntop, otop, nsize, osize, gcsp, gcmax); - sptr->localA = (q*)tag_local(wk); - push_shm_stack(&sptr->globalA,shm_sp,shm_gcmax); + }else{ /* generator */ + push_gc_stack(&wk, gcsp, gcmax); + hp = copy_terms(hp, ntop, otop, nsize, osize, gcsp, gcmax); + sptr->localA = (q*) tag_local(wk); + } + push_shm_stack(&sptr->globalA, shm_sp, shm_gcmax); break; } - } - default: { /* normal goal */ - struct goalrec* wqp = (struct goalrec*)sptr->localA; - if ( !wqp ) { /* skip */ - } else if ( !wqp->pred ) { - sptr->localA = (q*)wqp->next; - } else if ( isint(wqp->next) ) { - copy_one_goal(wqp, gcsp, gcmax,1); - sptr->localA = (q*)wqp; - hp = copy_terms(hp, ntop, otop, nsize, osize, gcsp, gcmax); - if ( isref(sptr->globalA) ) { - q ww; - while (1) { - ww = derefone(sptr->globalA); - if ( isref(ww) ) { - if ( (q)sptr->globalA == derefone(ww) ) break; - else { - sptr->globalA = (q*)ww; - } - } else break; + default: /* normal goal */ + { + struct goalrec* wqp = (struct goalrec*) sptr->localA; + if( !wqp ){ /* skip */ + }else if( !wqp->pred ){ + sptr->localA = (q*) wqp->next; + }else if( isint(wqp->next) ){ + copy_one_goal(wqp, gcsp, gcmax, 1); + sptr->localA = (q*) wqp; + hp = copy_terms(hp, ntop, otop, nsize, osize, gcsp, gcmax); + if( isref(sptr->globalA) ){ + for(;;){ + q ww = derefone(sptr->globalA); + if( !isref(ww) || (q)sptr->globalA == derefone(ww) ) break; + sptr->globalA = (q*) ww; + } } - } - push_shm_stack(&sptr->globalA,shm_sp,shm_gcmax); - } else { - REM_HOOK: - sptr->localA = 0; - /* removes a hook record */ - { - struct generator_object* addi; - q sv; - Shvar* objp; - Sinfo *hk,*bsi,*si; - q var = (q)sptr->globalA; - sv = derefone(var); - if ( !isref(sv) || derefone(sv) != var ) { goto REM_skip; } - addi = n_lock(var,sv); - if ( derefone(var) != sv ) goto REM_skip; - objp = (Shvar*)untag_generator_susp(addi); - hk = objp->chain; - if ( hk->indp == sptr ) { - objp->chain = hk->next; - free_local_tbl(sptr); - } else { - for(bsi=hk,si=bsi->next;(si);bsi=si,si=si->next) { - if ( si->indp == sptr ) { - bsi->next = si->next; - free_local_tbl(sptr); - break; } + push_shm_stack(&sptr->globalA, shm_sp, shm_gcmax); + }else{ + REM_HOOK: + sptr->localA = 0; + /* removes a hook record */ + { + struct generator_object* addi; + q sv; + Shvar* objp; + Sinfo *hk, *bsi, *si; + q var = (q) sptr->globalA; + sv = derefone(var); + if( !isref(sv) || derefone(sv) != var ){ goto REM_skip; } + addi = n_lock(var, sv); + if( derefone(var) != sv ) goto REM_skip; + objp = (Shvar*) untag_generator_susp(addi); + hk = objp->chain; + if( hk->indp == sptr ){ + objp->chain = hk->next; + free_local_tbl(sptr); + }else{ + for( bsi=hk, si=bsi->next; si != NULL; bsi=si, si=si->next ){ + if( si->indp == sptr ){ + bsi->next = si->next; + free_local_tbl(sptr); + break; /* for si */ + } + } } + n_unlock(sv, addi); + REM_skip: + ; } - n_unlock(sv,addi); - REM_skip: - ; } } } - } } heapp = hp; } -#endif +#endif /* SHM */ #ifdef DEBUGLIB { - struct suspended_goal_rec *sgl = suspended_goal_list; - struct suspended_goal_rec **sgl_tail = &suspended_goal_list; - struct goalrec *dead_goal = 0; - q *hp = heapp; - if (copied_susp != suspensions-resumes) { + struct suspended_goal_rec* sgl; + struct suspended_goal_rec** sgl_tail = &suspended_goal_list; + struct goalrec* dead_goal = NULL; + q* hp = heapp; + if( copied_susp != suspensions-resumes ){ klic_fprintf(stderr, "%d perpetually suspending goals found\n", suspensions-resumes-copied_susp); } + /* First, we will copy the surface of suspended goal list. - This is needed to distinguish resumed goals and - goals copied while copying other goals in this list */ - while (sgl != 0) { - if (sgl->goal->pred == 0 || - /* already copied */ - !isref(sgl->goal->next) - /* or not resumed yet */ - ) { - struct suspended_goal_rec *newsgr = - (struct suspended_goal_rec *)hp; + * This is needed to distinguish resumed goals and + * goals copied while copying other goals in this list */ + for( sgl = suspended_goal_list; sgl != NULL; sgl = sgl->next ){ + if( sgl->goal->pred == 0 || !isref(sgl->goal->next) ){ + /* already copied or not resumed yet */ + struct suspended_goal_rec* newsgr = + (struct suspended_goal_rec*) hp; hp += sizeof(struct suspended_goal_rec)/sizeof(q); *sgl_tail = newsgr; newsgr->goal = sgl->goal; sgl_tail = &newsgr->next; } - sgl = sgl->next; } - *sgl_tail = 0; + *sgl_tail = NULL; + /* Next, we will copy the suspended goals */ - sgl = suspended_goal_list; - while (sgl != 0) { - if (sgl->goal->pred != 0) { + for( sgl = suspended_goal_list; sgl != NULL; sgl = sgl->next ) { + if( sgl->goal->pred == 0 ){ + sgl->goal = sgl->goal->next; + }else{ /* not copied yet */ copy_one_goal(sgl->goal, gcsp, gcmax, 0); hp = copy_terms(hp, ntop, otop, nsize, osize, gcsp, gcmax); dead_goal = sgl->goal; - } else { - sgl->goal = sgl->goal->next; } - sgl = sgl->next; } heapp = hp; - if (dead_goal != 0) { + if( dead_goal != 0 ){ /* we have to make the dead goal look like a normal ready queue */ - extern const struct predicate queue_empty_pred; - ((struct goalrec *)hp)->pred = &queue_empty_pred; - dead_goal->next = (struct goalrec *)hp; + ((struct goalrec*) hp)->pred = &queue_empty_pred; + dead_goal->next = (struct goalrec*) hp; hp += sizeof(struct goalrec)/sizeof(q); trace_deadlock(dead_goal); } } -#endif +#endif /* DEBUGLIB */ - if (copied_susp != suspensions-resumes) { + if( copied_susp != suspensions-resumes ){ fatal("Perpetually suspending goal(s) found during GC"); } - for (k=0; k #include #include #include "atom.h" #include "funct.h" /* arities, arityof, FUNCTORNUMBERBASE */ +#include #define GD_CLASS_NAME() predicate #define GD_OBJ_TYPE struct predicate_object @@ -25,18 +26,19 @@ #include -#include +extern const struct modinfo defined_modules[]; GD_USE_CLASS(vector); +GD_USE_CLASS(module); GDDEF_GUNIFY() { G_STD_DECL; - if(GD_SELF->method_table != GD_OTHER->method_table || - GD_SELF->pdesc != GD_OTHER->pdesc) + if( GD_SELF->method_table != GD_OTHER->method_table || + GD_SELF->pdesc != GD_OTHER->pdesc ) GD_GFAIL; - else + else GD_GSUCCEED; } @@ -44,8 +46,8 @@ { G_STD_DECL; - if(GD_SELF->method_table != GD_OTHER->method_table || - GD_SELF->pdesc != GD_OTHER->pdesc) + if( GD_SELF->method_table != GD_OTHER->method_table || + GD_SELF->pdesc != GD_OTHER->pdesc ) GD_UNIFY_FAIL; else GD_RETURN; @@ -54,11 +56,11 @@ GDDEF_GC() { G_STD_DECL; - GD_OBJ_TYPE *newself; + GD_OBJ_TYPE* newself; GDSET_NEWOBJ_IN_NEWGEN(newself); newself->pdesc = GD_SELF->pdesc; - GD_COPY_KL1_TERM_TO_NEWGEN(GD_SELF->module_obj,newself->module_obj); + GD_COPY_KL1_TERM_TO_NEWGEN(GD_SELF->module_obj, newself->module_obj); newself->predicate_name = GD_SELF->predicate_name; GD_RETURN_FROM_GC(newself); } @@ -69,7 +71,7 @@ { G_STD_DECL; - GD_UNIFY(GD_ARGV[0],GD_SELF->module_obj); + GD_UNIFY(GD_ARGV[0], GD_SELF->module_obj); GD_RETURN; } @@ -77,7 +79,7 @@ { G_STD_DECL; - GD_UNIFY(GD_ARGV[0],GD_SELF->predicate_name); + GD_UNIFY(GD_ARGV[0], GD_SELF->predicate_name); GD_RETURN; } @@ -90,69 +92,58 @@ GD_RETURN; } -#define GD_ALLOC_GOAL(goal, pdesc, arity) \ -{ \ - G_HEAPALLOC(goal,(size)+2,(struct goalrec *)); \ +#define GD_ALLOC_GOAL(goal, pdesc, size) \ +do{ \ + G_HEAPALLOC(goal, (size)+2, (struct goalrec*)); \ (goal)->pred = (pdesc); \ -} +}while(0) -#define GD_GOAL_ARG(i, goal) ((goal)->args[i]) - -#define G_ARITY_OF(fn) arityof(fn) +#define GD_GOAL_ARG(i, goal) ((goal)->args[i]) GDDEF_METHOD(apply_1) { G_STD_DECL; - - q func; + struct goalrec* goal; + q argv[2]; int size; + int i; + q func; GD_DEREF(GD_ARGV[0]); func = GD_ARGV[0]; - if (!G_ISFUNCTOR(func) || !(GD_IS_CLASS(vector, func))) { + if( !G_ISFUNCTOR(func) || !GD_IS_CLASS(vector, func) ){ GD_ERROR_IN_METHOD("Invalid argument specification", "apply"); } - { - struct goalrec *goal; - q argv[2]; - int i; - - GD_CALL_GMETHOD(func,vector_1,argv); - size = G_INTVAL(argv[0]); - if (GD_SELF->pdesc->arity != size) { - GD_ERROR_IN_METHOD("Arity mismatch", "apply"); - } - GD_ALLOC_GOAL(goal, GD_SELF->pdesc, size); - for(i=0; ipdesc->arity != size ){ + GD_ERROR_IN_METHOD("Arity mismatch", "apply"); + } + GD_ALLOC_GOAL(goal, GD_SELF->pdesc, size); + for( i=0; ipdesc, size); - for(i=0; ipdesc, size); + for( i=0; imodule_obj)))->name, - 0, 1); + GD_PRINT_KL1_TERMS + (((struct module_object*) G_FUNCTORP(GD_SELF->module_obj))->name, 0, 1); GD_PRINT(":"); GD_PRINT_KL1_TERMS(GD_SELF->predicate_name, 0, 1); GD_PRINTF("/%d)", GD_SELF->pdesc->arity); @@ -199,8 +189,10 @@ GDDEF_GMETHOD(predicate_0) { G_STD_DECL; - if (GD_SELF->pdesc) { GD_GSUCCEED; } - else { GD_GFAIL; } + if( GD_SELF->pdesc ) + { GD_GSUCCEED; } + else + { GD_GFAIL; } } GDDEF_GGENERIC() @@ -221,27 +213,27 @@ #include -const struct predicate* locate_predicate_in_module(mname, pname, arity) - q mname, pname; - long arity; -{ - unsigned char *modname = namestringof(mname); - unsigned char *predname = namestringof(pname); - extern const struct modinfo defined_modules[]; +extern const struct predicate* +locate_predicate_in_module(mname, pname, arity) + q mname, pname; + long arity; +{ + unsigned char* modname = namestringof(mname); + unsigned char* predname = namestringof(pname); const struct modinfo* mp; - for (mp = defined_modules; mp->name != 0; mp++) { - if (strcmp((char *)mp->name, (char *)modname) == 0) { + for( mp = defined_modules; mp->name != NULL; mp++ ){ + if( strcmp((char*) mp->name, (char*) modname) == 0 ){ const struct predinfo* const* pp; - for (pp = mp->preds; *pp != 0; pp++) { - if (strcmp((char *)((*pp)->name), (char *)predname) == 0 && - (*pp)->predstruct->arity == arity) { + for( pp = mp->preds; *pp != NULL; pp++ ){ + if( strcmp((char*) ((*pp)->name), (char*) predname) == 0 && + (*pp)->predstruct->arity == arity ){ return (*pp)->predstruct; } } - return 0; + return NULL; } } - return 0; + return NULL; } /* @@ -251,27 +243,27 @@ GDDEF_NEW() { GD_STD_DECL_FOR_NEW; - struct module_object *module_obj; + GD_OBJ_TYPE* newpred; + struct module_object* module_obj; const struct predicate* predaddr; q predname; int arity; - GD_USE_CLASS(module); + if( GD_ARGC != 3 ) GD_ERROR_IN_NEW("Too few or too many arguments"); - if (GD_ARGC!=3) GD_ERROR_IN_NEW("Too few or too many arguments"); 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)))) { + if( !G_ISFUNCTOR(GD_ARGV[0]) || + (((struct module_object*) G_FUNCTORP(GD_ARGV[0]))->method_table + != &GD_method_table0(module) ) ){ GD_ERROR_IN_NEW("First parameter is not a module"); } - module_obj = (struct module_object *)(G_FUNCTORP(GD_ARGV[0])); + module_obj = (struct module_object*) G_FUNCTORP(GD_ARGV[0]); GDSET_SYMARG_FOR_NEW(predname, GD_ARGV[1]); GDSET_INTARG_FOR_NEW(arity, GD_ARGV[2]); predaddr = locate_predicate_in_module(module_obj->name, predname, arity); - if (predaddr == 0) { + if( predaddr == 0 ){ char message[1024]; sprintf(message, "Nonexistent predicate %s:%s/%d", @@ -281,13 +273,9 @@ GD_ERROR_IN_NEW(message); } - { - GD_OBJ_TYPE *newpred; - - GDSET_NEWOBJ_FOR_NEW(newpred, sizeof(struct predicate_object)); - newpred->pdesc = predaddr; - newpred->module_obj = G_MAKEFUNCTOR(module_obj); - newpred->predicate_name = predname; - GD_RETURN_FROM_NEW(newpred); - } + GDSET_NEWOBJ_FOR_NEW(newpred, sizeof(struct predicate_object)); + newpred->pdesc = predaddr; + newpred->module_obj = G_MAKEFUNCTOR(module_obj); + newpred->predicate_name = predname; + GD_RETURN_FROM_NEW(newpred); } diff -ruN klic-3.003-2002-01-12/runtime/ge_exref.c klic-3.003-2002-01-12a/runtime/ge_exref.c --- klic-3.003-2002-01-12/runtime/ge_exref.c Sun Dec 30 17:14:44 2001 +++ klic-3.003-2002-01-12a/runtime/ge_exref.c Sat Jan 12 20:05:30 2002 @@ -32,7 +32,9 @@ #include #include -q read_hook_g_new(); +extern q read_hook_g_new(); +extern q* decode_exref(); +extern struct generator_object_method_table* get_exref_methtab(void); GGDEF_GENERATE() { @@ -45,7 +47,7 @@ generic_arg[2] = makeint(GG_SELF->wec); allocp = g_allocp; /* Using allocp in 'new_generic' */ - new_generic(read_hook_g_new, 3, rdhok, 0); + new_generic(read_hook_g_new, 3, rdhok, 0); g_allocp = allocp; /* Using allocp in 'new_generic' */ GG_SELF->method_table = 0; @@ -57,19 +59,17 @@ GG_SELF->gc_flag = IMPREC_RELEASED; heapp = g_allocp; - return(rdhok); + return rdhok; } -struct generator_object_method_table* get_exref_methtab(); - GGDEF_UNIFY() { G_STD_DECL; - struct generator_susp *gsusp = generator_suspp(derefone(GG_SELF)); - - struct exref_object *GG_OBJ = (struct exref_object *)untag_generator_susp(gsusp->u.o); + struct generator_susp* gsusp = generator_suspp(derefone(GG_SELF)); + struct exref_object* GG_OBJ = + (struct exref_object*) untag_generator_susp(gsusp->u.o); - GG_SWITCH_ON_TERM(list0,atomic0,functor0,generic_data0,susp0); + GG_SWITCH_ON_TERM(list0, atomic0, functor0, generic_data0, susp0); list0: atomic0: @@ -79,66 +79,65 @@ derefone(GG_SELF) = GG_TERM; - GG_OBJ->method_table = 0; + GG_OBJ->method_table = NULL; GG_OBJ->gc_flag = IMPREC_RELEASED; - GG_TERMINATE; + susp0: { - struct susprec *gterm = (struct susprec *)(derefone(GG_TERM)); + struct susprec* gterm = (struct susprec*) derefone(GG_TERM); - if(is_generator_susp(gterm->u)){ - struct generator_susp *gsusp1 = generator_suspp(derefone(GG_TERM)); - struct exref_object *dummy_obj = (struct exref_object *)untag_generator_susp(gsusp1->u.o); -/* fprintf(stderr, "Node:%d unify EXREF-GENERA",my_node);*/ - - if(dummy_obj-> method_table == get_exref_methtab()){ -/* fprintf(stderr, "Node:%d unify EXREF-EXREF",my_node);*/ - } else { - fatal("unify EXREF-UnknownGEN occur"); - } - - goto list0; - } else { -/* fprintf(stderr, "Node:%d unify EXREF-non-EXREF",my_node);*/ + if( is_generator_susp(gterm->u) ){ + struct generator_susp* gsusp1 = generator_suspp(derefone(GG_TERM)); + struct exref_object* dummy_obj = + (struct exref_object*) untag_generator_susp(gsusp1->u.o); + /* fprintf(stderr, "Node:%d unify EXREF-GENERA", my_node); */ + + if( dummy_obj->method_table == get_exref_methtab() ){ + /* fprintf(stderr, "Node:%d unify EXREF-EXREF", my_node); */ + }else{ + fatal("unify EXREF-UnknownGEN occur"); } + + goto list0; + }else{ + /* fprintf(stderr, "Node:%d unify EXREF-non-EXREF", my_node); */ + } } - return(NULL); /* Cannot unify now */ + return NULL; /* Cannot unify now */ } -extern void* decode_exref(); - GGDEF_ENCODE() { long send_wec; - if (GG_SELF->wec < MIN_WEC){ - fatal("invalid WEC in exref object"); + if( GG_SELF->wec < MIN_WEC ){ + fatal("invalid WEC in exref object"); } - if (GG_SELF->wec < MIN_WEC*2){ - return(GENERIC_FAILED); + if( GG_SELF->wec < MIN_WEC*2 ){ + return GENERIC_FAILED; } - send_wec = (GG_SELF->wec)>>1; + send_wec = (GG_SELF->wec) >> 1; GG_SELF->wec -= send_wec; - PUT_BUFFER(buffer, decode_exref); + PUT_BUFFER(buffer, decode_exref); PUT_BUFFER(buffer, GG_SELF->node); PUT_BUFFER(buffer, GG_SELF->index); PUT_BUFFER(buffer, send_wec); - return(GENERIC_SUCCEEDED); + return GENERIC_SUCCEEDED; } GGDEF_GC() { G_STD_DECL; - GG_OBJ_TYPE *newself; + GG_OBJ_TYPE* newself; - INT_CL_DEBUG_X(klic_fprintf(stdout,"exref GC invoked\n")); + INT_CL_DEBUG_X(klic_fprintf(stdout, "exref GC invoked\n")); - if(GG_SELF->gc_flag != IMPREC_NOT_COPIED){ + if( GG_SELF->gc_flag != IMPREC_NOT_COPIED ){ ioeprintf("invalid exref in GC\n"); ERROR_STOP; } @@ -170,13 +169,13 @@ GGDEF_NEW() /* node, index, wec */ { GG_STD_DECL_FOR_NEW; - GG_OBJ_TYPE *new_exref; + GG_OBJ_TYPE* new_exref; - GGSET_NEWOBJ_FOR_NEW(new_exref, (struct exref_object *)); + GGSET_NEWOBJ_FOR_NEW(new_exref, (struct exref_object*)); - new_exref->node = (long)intval(GG_ARGV[0]); - new_exref->index = (long)intval(GG_ARGV[1]); - new_exref->wec = (long)intval(GG_ARGV[2]); + new_exref->node = (long) intval(GG_ARGV[0]); + new_exref->index = (long) intval(GG_ARGV[1]); + new_exref->wec = (long) intval(GG_ARGV[2]); new_exref->to_exref = GG_MAKE_HOOK_VAR(new_exref); @@ -187,8 +186,8 @@ GG_RETURN_FROM_NEW(new_exref->to_exref); } -struct generator_object_method_table* +extern struct generator_object_method_table* get_exref_methtab() { - return(&GG_method_table); + return &GG_method_table; } diff -ruN klic-3.003-2002-01-12/runtime/ge_readhook.c klic-3.003-2002-01-12a/runtime/ge_readhook.c --- klic-3.003-2002-01-12/runtime/ge_readhook.c Sat Dec 29 12:46:20 2001 +++ klic-3.003-2002-01-12a/runtime/ge_readhook.c Sat Jan 12 20:05:30 2002 @@ -12,8 +12,15 @@ #include "atom.h" #include "funct.h" +#define GC_CLASS_NAME() read_hook +#define GC_OBJ_TYPE struct read_hook_object +#define GC_OBJ_SIZE(obj) G_SIZE_IN_Q(GC_OBJ_TYPE) + +#include +#include + struct read_hook_object{ - struct consumer_object_method_table *method_table; + struct consumer_object_method_table* method_table; long node; long index; long wec; @@ -21,46 +28,36 @@ long return_index; }; -#define GC_CLASS_NAME() read_hook -#define GC_OBJ_TYPE struct read_hook_object -#define GC_OBJ_SIZE(obj) G_SIZE_IN_Q(GC_OBJ_TYPE) - -#include -#include - GCDEF_UNIFY() { G_STD_DECL; - GC_SWITCH_ON_TERM(list0,atomic0,functor0,generic_data0,susp0); + GC_SWITCH_ON_TERM(list0, atomic0, functor0, generic_data0, susp0); list0: atomic0: functor0: generic_data0: - if(receive_answer_flag){ - if((GC_SELF->return_index) == answer_return_exp_index){ - INT_CL_DEBUG_X(klic_fprintf(stdout, - "rdhok receive answer value -> send_release \n")); + if( receive_answer_flag ){ + if( GC_SELF->return_index == answer_return_exp_index ){ + INT_CL_DEBUG_X + (klic_fprintf(stdout, "rdhok receive answer value -> send_release\n")); send_release(GC_SELF->node, GC_SELF->index, GC_SELF->wec); - } else { - INT_CL_DEBUG_X(klic_fprintf(stdout, - "rdhok receive answer value -> send_unify \n")); + }else{ + INT_CL_DEBUG_X + (klic_fprintf(stdout, "rdhok receive answer value -> send_unify\n")); send_unify(GC_SELF->node, GC_SELF->index, GC_SELF->wec, GC_TERM); - } - } else { - INT_CL_DEBUG_X(klic_fprintf(stdout, - "rdhok active unify -> send_unify \n")); - + } + }else{ + INT_CL_DEBUG_X(klic_fprintf(stdout, "rdhok active unify -> send_unify\n")); send_unify(GC_SELF->node, GC_SELF->index, GC_SELF->wec, GC_TERM); -/* (int)GC_SELF->method_table = 0;*/ - + /* GC_SELF->method_table = NULL; */ } GC_SELF->node = 0; GC_SELF->index = 0; GC_SELF->wec = 0; - GC_TERMINATE; + susp0: fatal("invalid data for unify rdhok"); } @@ -68,9 +65,9 @@ GCDEF_GC() { G_STD_DECL; - GC_OBJ_TYPE *newself; + GC_OBJ_TYPE* newself; - INT_CL_DEBUG_X(klic_fprintf(stdout,"readhook GC invoked\n")); + INT_CL_DEBUG_X(klic_fprintf(stdout, "readhook GC invoked\n")); GCSET_NEWOBJ_IN_NEWGEN(newself); @@ -96,20 +93,19 @@ GCDEF_NEW() /* node, index, wec */ { GC_STD_DECL_FOR_NEW; - GC_OBJ_TYPE *new_read_hook; + GC_OBJ_TYPE* new_read_hook; GCSET_NEWOBJ_FOR_NEW(new_read_hook, GC_OBJ_SIZE(new_read_hook)); - new_read_hook->node = (long)intval(GC_ARGV[0]); - new_read_hook->index = (long)intval(GC_ARGV[1]); - new_read_hook->wec = (long)intval(GC_ARGV[2]); + new_read_hook->node = (long) intval(GC_ARGV[0]); + new_read_hook->index = (long) intval(GC_ARGV[1]); + new_read_hook->wec = (long) intval(GC_ARGV[2]); new_read_hook->to_read_hook = GC_MAKE_HOOK_VAR(new_read_hook); - new_read_hook->return_index = send_read(new_read_hook->node, - new_read_hook->index, - new_read_hook->to_read_hook, - TRANSFER_CNT); + new_read_hook->return_index = send_read(new_read_hook->node, + new_read_hook->index, + new_read_hook->to_read_hook, + TRANSFER_CNT ); new_read_hook->wec--; /* WEC of EXREF in %read is 1 */ GC_RETURN_FROM_NEW(new_read_hook->to_read_hook); } - diff -ruN klic-3.003-2002-01-12/runtime/ge_replyhook.c klic-3.003-2002-01-12a/runtime/ge_replyhook.c --- klic-3.003-2002-01-12/runtime/ge_replyhook.c Sat Dec 29 12:46:20 2001 +++ klic-3.003-2002-01-12a/runtime/ge_replyhook.c Sat Jan 12 20:05:30 2002 @@ -9,13 +9,6 @@ #include "atom.h" #include "funct.h" -struct reply_hook_object{ - struct consumer_object_method_table *method_table; - long node; - long index; - long wec; -}; - #define GC_CLASS_NAME() reply_hook #define GC_OBJ_TYPE struct reply_hook_object #define GC_OBJ_SIZE(obj) G_SIZE_IN_Q(GC_OBJ_TYPE) @@ -23,24 +16,28 @@ #include #include +struct reply_hook_object{ + struct consumer_object_method_table* method_table; + long node; + long index; + long wec; +}; + GCDEF_UNIFY() { G_STD_DECL; -/* INT_CL_DEBUG_X(printf("replyhook active unify \n"));*/ + /* INT_CL_DEBUG_X(printf("replyhook active unify\n")); */ - GC_SWITCH_ON_TERM(list0,atomic0,functor0,generic_data0,susp0); + GC_SWITCH_ON_TERM(list0, atomic0, functor0, generic_data0, susp0); list0: atomic0: functor0: generic_data0: - send_answer_value(GC_TERM, - GC_SELF->node, - GC_SELF->index, - GC_SELF->wec); - + send_answer_value(GC_TERM, GC_SELF->node, GC_SELF->index, GC_SELF->wec); GC_TERMINATE; + susp0: fatal("invalid data for unify rhook"); } @@ -48,7 +45,7 @@ GCDEF_GC() { G_STD_DECL; - GC_OBJ_TYPE *newself; + GC_OBJ_TYPE* newself; GCSET_NEWOBJ_IN_NEWGEN(newself); newself->node = GC_SELF->node; @@ -62,28 +59,23 @@ {} - #define GCUSE_MY_UNIFY #define GCUSE_MY_GC #define GCUSE_MY_PRINT - #include -GCDEF_NEW() /* node, index, wec */ +GCDEF_NEW() /* node, index, wec */ { GC_STD_DECL_FOR_NEW; - GC_OBJ_TYPE *new_reply_hook; + GC_OBJ_TYPE* new_reply_hook; q var; - GCSET_NEWOBJ_FOR_NEW(new_reply_hook, GC_OBJ_SIZE(new_reply_hook)); new_reply_hook->node = intval(GC_ARGV[0]); new_reply_hook->index = intval(GC_ARGV[1]); new_reply_hook->wec = intval(GC_ARGV[2]); var = GC_MAKE_HOOK_VAR(new_reply_hook); -/* GC_RETURN_WITH_HOOK_FROM_NEW(var);*/ GC_RETURN_FROM_NEW(var); } - diff -ruN klic-3.003-2002-01-12/runtime/gen.kl1 klic-3.003-2002-01-12a/runtime/gen.kl1 --- klic-3.003-2002-01-12/runtime/gen.kl1 Fri Dec 28 13:46:47 2001 +++ klic-3.003-2002-01-12a/runtime/gen.kl1 Sat Jan 12 20:05:30 2002 @@ -5,31 +5,35 @@ % (Read COPYRIGHT-JIPDEC for detailed information.) ----------------------------------------------------------- */ -:- inline:"#include \"gobj.h\"". -:- inline:"#include \"g_pointer.h\"". -:- inline:"#include \"g_termarray.h\"". -:- inline:"typedef q * (*gd_func)();". +:- inline:" +#include \"gobj.h\" +#include \"g_pointer.h\" +#include \"g_termarray.h\" + +extern unsigned long enter_functor(); + +typedef q* (*gd_func)(); +". :- module generic. new(X,Funct,Argv) :- inline:" { unsigned long argc; - q *argv; - gd_func func = (gd_func)(((struct pointer_object *) - (data_objectp(%1)))->pointer); - argc = ((struct termarray_object *)(data_objectp(%2)))->nterm; - argv = ((struct termarray_object *)(data_objectp(%2)))->terms; - %0 = (q)func(argc,argv,allocp); + q* argv; + gd_func func = + (gd_func) (((struct pointer_object*) (data_objectp(%1)))->pointer); + argc = ((struct termarray_object*) (data_objectp(%2)))->nterm; + argv = ((struct termarray_object*) (data_objectp(%2)))->terms; + %0 = (q) func(argc, argv, allocp); allocp = heapp; }":[X0-any,Funct+functor,Argv+functor] | X0=X. generic(Funct,Obj) :- inline:" - allocp = gd_generic(allocp,%1,symval((functorp(%0))->functor), - &((functorp(%0))->args[0])); + allocp = gd_generic(allocp, %1, symval((functorp(%0))->functor), + &(functorp(%0)->args[0])); ":[Funct+functor,Obj+object] | true . generic(Funct,Obj) :- inline:"{ - extern unsigned long enter_functor(); unsigned long funct = enter_functor(symval(%0), 0); allocp = gd_generic(allocp, %1, funct, 0); }":[Funct+atom,Obj+object] | true . diff -ruN klic-3.003-2002-01-12/runtime/generic.c klic-3.003-2002-01-12a/runtime/generic.c --- klic-3.003-2002-01-12/runtime/generic.c Sat Dec 29 12:46:20 2001 +++ klic-3.003-2002-01-12a/runtime/generic.c Sat Jan 12 20:05:30 2002 @@ -13,72 +13,73 @@ #include #include #include "susp.h" +#include /* combuf */ -extern q *suspend_goal(); +#define G_NEW_GOAL &predicate_generic_xnew_3 +#define GD_GENERIC_GOAL &predicate_generic_xgeneric_2 + +extern q* suspend_goal(); extern q gd_new_pointer(); extern q gd_new_termarray(); - -module module_generic(); - extern const struct predicate predicate_generic_xgeneric_2; -#define G_NEW_GOAL &predicate_generic_xnew_3 -#define GD_GENERIC_GOAL &predicate_generic_xgeneric_2 +q method_result; /*************************** inlines *******************************/ -Inline q *G_SUSPEND(x,goal,g_allocp) - q x; - struct goalrec * goal; - q *g_allocp; +extern q* +G_SUSPEND(x, goal, g_allocp) + q x; + struct goalrec* goal; + q* g_allocp; { G_STD_DECL; return suspend_goal(g_allocp, goal, x, 1); } -Inline q *GD_MAKE_GENERIC_GOAL(goalp1,var,method_functor,argv,g_allocp) - struct goalrec **goalp1; - q var; - unsigned long method_functor; - q argv[]; - q *g_allocp; +extern q* +GD_MAKE_GENERIC_GOAL(goalp1, var, method_functor, argv, g_allocp) + struct goalrec** goalp1; + q var; + unsigned long method_functor; + q argv[]; + q* g_allocp; { G_STD_DECL; unsigned long argc = arities[method_functor - FUNCTORNUMBERBASE]; q objp; int i; - G_HEAPALLOC(objp,G_SIZE_IN_Q(struct functor)+argc-1, - makefunctor); + G_HEAPALLOC(objp, G_SIZE_IN_Q(struct functor)+argc-1, makefunctor); functor_of(objp) = makesym(method_functor); - for (i=0; ipred = GD_GENERIC_GOAL; (*goalp1)->args[0] = objp; (*goalp1)->args[1] = var; return g_allocp; } -Inline q *G_MAKE_THE_NEW_GOAL(var,goalp1,myself,argc,argv,g_allocp) - q *var; - struct goalrec **goalp1; - q (*myself)(); - unsigned long argc; - q argv[]; - q *g_allocp; +extern q* +G_MAKE_THE_NEW_GOAL(var, goalp1, myself, argc, argv, g_allocp) + q* var; + struct goalrec** goalp1; + q (*myself)(); + unsigned long argc; + q argv[]; + q* g_allocp; { G_STD_DECL; - q newobj,newobj2; q newvar; - newobj = gd_new_pointer(myself,g_allocp); - newobj2 = gd_new_termarray(argc,argv,heapp); - g_allocp = heapp; + q newobj = gd_new_pointer(myself, g_allocp); + q newobj2 = gd_new_termarray(argc, argv, heapp); + g_allocp = heapp; - G_HEAPALLOC(*goalp1,(G_SIZE_IN_Q(struct goalrec)-3),(struct goalrec *)); + G_HEAPALLOC(*goalp1, G_SIZE_IN_Q(struct goalrec)-3, (struct goalrec*)); G_MAKE_VAR(newvar); (*goalp1)->pred = G_NEW_GOAL; (*goalp1)->args[0] = newvar; @@ -90,151 +91,161 @@ /**********************************************************************/ #define GD_DEREF_FOR_GENERIC(obj) \ -{ \ - while (isref(obj)) { \ +do{ \ + while( isref(obj) ){ \ q temp0 = derefone(obj); \ - if(isref(temp0) && (obj) == derefone(temp0)) { \ - struct goalrec *goal; \ + if( isref(temp0) && (obj) == derefone(temp0) ){ \ + struct goalrec* goal; \ g_allocp = \ - GD_MAKE_GENERIC_GOAL(&goal,(obj),g_method_functor,g_argv,g_allocp); \ - g_allocp = G_SUSPEND((obj),goal,g_allocp); \ + GD_MAKE_GENERIC_GOAL(&goal,(obj),g_method_functor,g_argv,g_allocp); \ + g_allocp = G_SUSPEND((obj), goal, g_allocp); \ GD_RETURN; \ - } else { \ + }else{ \ (obj) = temp0; \ } \ } \ -} +}while(0) /**********************************************************************/ -q * -gd_generic(g_allocp,g_object,g_method_functor,g_argv) - q *g_allocp; - q g_object; - long g_method_functor; - q *g_argv; +extern q* +gd_generic(g_allocp, g_object, g_method_functor, g_argv) + q* g_allocp; + q g_object; + long g_method_functor; + q* g_argv; { G_STD_DECL; + struct data_object* g_obj; GD_DEREF_FOR_GENERIC(g_object); - if (!isfunctor(g_object) || !isref(functor_of(g_object))) { + if( !isfunctor(g_object) || !isref(functor_of(g_object)) ){ klic_printf("### method %F issued to %k ###\n", g_method_functor, g_object); fatal("Generic method issued to a non-object"); } - { - struct data_object *g_obj = data_objectp(g_object); - g_allocp = (g_obj->method_table) - ->body_generic(g_obj,g_method_functor,g_argv,g_allocp); - } + g_obj = data_objectp(g_object); + g_allocp = (g_obj->method_table) + ->body_generic(g_obj, g_method_functor, g_argv, g_allocp); GD_RETURN; - } /**********************************************************************/ -q +extern q GC_MAKE_HOOK_VAR(obj) - struct consumer_object *obj; + struct consumer_object* obj; { declare_globals; q newvar; - struct susprec *susp; + struct susprec* susp; - allocnewsusp(newvar,susp); + allocnewsusp(newvar, susp); susp->u.first_hook.u.o = tag_consumer_hook(obj); - return(newvar); + return newvar; } /************************* standard methods *************************/ -q GD_STD_GUNIFY(GD_SELF, GD_OTHER) - struct data_object *GD_SELF; - struct data_object *GD_OTHER; +extern q +GD_STD_GUNIFY(GD_SELF, GD_OTHER) + struct data_object* GD_SELF; + struct data_object* GD_OTHER; { GD_GSUCCEED; } -q *GD_STD_UNIFY(GD_SELF, GD_OTHER, g_allocp) - struct data_object *GD_SELF; - struct data_object *GD_OTHER; - q *g_allocp; +extern q* +GD_STD_UNIFY(GD_SELF, GD_OTHER, g_allocp) + struct data_object* GD_SELF; + struct data_object* GD_OTHER; + q* g_allocp; { - return(g_allocp); -} - -long GD_STD_PRINT(GD_SELF,g_fp,g_depth,g_length) - struct data_object *GD_SELF; - FILE *g_fp; - unsigned long g_depth; - unsigned long g_length; -{ - klic_fprintf(g_fp, "", (long)GD_SELF); - return(1L); + return g_allocp; } -q *GD_STD_GC(GD_SELF,g_allocp, g_sp) - struct data_object *GD_SELF; - q *g_allocp; - q **g_sp; +extern long +GD_STD_PRINT(GD_SELF, g_fp, g_depth, g_length) + struct data_object* GD_SELF; + FILE* g_fp; + unsigned long g_depth; + unsigned long g_length; +{ + klic_fprintf(g_fp, "", (long) GD_SELF); + return 1L; +} + +extern q* +GD_STD_GC(GD_SELF, g_allocp, g_sp) + struct data_object* GD_SELF; + q* g_allocp; + q** g_sp; { declare_globals; gcsp = g_sp; - return(g_allocp); + return g_allocp; } -long GD_STD_REGIST(GD_SELF,g_allocp) - struct data_object *GD_SELF; - q *g_allocp; +extern long +GD_STD_REGIST(GD_SELF, g_allocp) + struct data_object* GD_SELF; + q* g_allocp; { - return(1L); + return 1L; } -long GD_STD_DEALLOCATE(GD_SELF) - struct data_object *GD_SELF; +extern long +GD_STD_DEALLOCATE(GD_SELF) + struct data_object* GD_SELF; { - return(1L); + return 1L; } -q *GD_STD_CLOSE(GD_SELF, g_allocp) - q *g_allocp; - struct data_object *GD_SELF; +extern q* +GD_STD_CLOSE(GD_SELF, g_allocp) + q* g_allocp; + struct data_object* GD_SELF; { - return(g_allocp); + return g_allocp; } -q *GD_STD_GENERIC(GD_SELF, g_method_functor, GD_ARGV, g_allocp) - q *GD_SELF; - long g_method_functor; - q GD_ARGV[]; - q * g_allocp; +extern q* +GD_STD_GENERIC(GD_SELF, g_method_functor, GD_ARGV, g_allocp) + q* GD_SELF; + long g_method_functor; + q GD_ARGV[]; + q* g_allocp; { - return(g_allocp); + return g_allocp; } -q GD_STD_GGENERIC(GD_SELF, g_method_functor, GD_ARGV) - struct data_object *GD_SELF; - long g_method_functor; - q GD_ARGV[]; -{ - return(GENERIC_SUCCEEDED); +extern q +GD_STD_GGENERIC(GD_SELF, g_method_functor, GD_ARGV) + struct data_object* GD_SELF; + long g_method_functor; + q GD_ARGV[]; +{ + return GENERIC_SUCCEEDED; } -q GD_STD_COMPARE(GD_SELF, GD_OTHER) - struct data_object *GD_SELF, *GD_OTHER; +extern q +GD_STD_COMPARE(GD_SELF, GD_OTHER) + struct data_object* GD_SELF; + struct data_object* GD_OTHER; { debug_printf("### %k compared with %k ###\n", makefunctor(GD_SELF), makefunctor(GD_OTHER)); fatal("Comparision of objects of an inappropriate class made"); } -q GD_STD_HASH(GD_SELF, level) - struct data_object *GD_SELF; - long level; +extern q +GD_STD_HASH(GD_SELF, level) + struct data_object* GD_SELF; + long level; { - return makeint((long)GD_SELF->method_table); + return makeint((long) GD_SELF->method_table); } extern NeverReturn void @@ -242,48 +253,44 @@ char *errmsg, *where, *object_kind, *class; { fatalf("%s\n\t(in %s of %s object of class \"%s\")", - errmsg, (where==0 ? "unknown method" : where), - object_kind, (class==0 ? "" : class)); + errmsg, (where != NULL ? where : "unknown method"), + object_kind, (class != NULL ? class : "")); } -q GD_STD_ENCODE(self, buffer) - struct data_object *self; - /* combuf *buffer; */ - void *buffer; /* To avoid useless file include */ +extern q +GD_STD_ENCODE(self, buffer) + struct data_object* self; + combuf* buffer; { - return(GENERIC_FAILED); + return GENERIC_FAILED; } -q GD_STD_SHMCOPY(self) - struct data_object *self; +extern q +GD_STD_SHMCOPY(self) + struct data_object* self; { - fatal("Undefined Data object copied into shared-memory"); + fatal("Undefined Data object copied into shared-memory"); } /* - next variable for new method has not already used -struct generic *new_term; -*/ -q method_result; - -/* Generator object */ -q +extern q GG_MAKE_HOOK_VAR(obj) - struct generator_object *obj; + struct generator_object* obj; { declare_globals; q newvar; - struct generator_susp *gsusp; + struct generator_susp* gsusp; - allocnewgensusp(newvar,gsusp); + allocnewgensusp(newvar, gsusp); gsusp->u.o = tag_generator_susp(obj); - return(newvar); + return newvar; } -q GG_STD_SUSPEND() +extern q +GG_STD_SUSPEND() { - return(makecons(0)); + return makecons(0); } diff -ruN klic-3.003-2002-01-12/runtime/gfloat.c klic-3.003-2002-01-12a/runtime/gfloat.c --- klic-3.003-2002-01-12/runtime/gfloat.c Tue Jan 1 14:17:47 2002 +++ klic-3.003-2002-01-12a/runtime/gfloat.c Sat Jan 12 20:05:30 2002 @@ -10,17 +10,48 @@ #include /* debug_printf, klic_fprintf */ #include +#include "atom.h" +#include "funct.h" + #ifdef DIST #include "interpe.h" #endif -#include "atom.h" -#include "funct.h" +#ifdef SHM +#include "shm.h" +#endif #define GD_CLASS_NAME() float #define GD_OBJ_TYPE struct float_object #define GD_OBJ_SIZE(obj) (G_SIZE_IN_Q(GD_OBJ_TYPE)) +#define ALIGN() \ +do{ \ + if( sizeof(double) != sizeof(long) ){ \ + g_allocp = (q*) (((unsigned long)g_allocp + sizeof(double) - 1) \ + & -sizeof(double) ); \ + } \ +}while(0) + +#ifdef SHM +#define ALIGN_SHM() \ +do{ + if( sizeof(double) != sizeof(long) ){ \ + gallocp = (q*) (((unsigned long)gallocp + sizeof(double) - 1) \ + & -sizeof(double) ); \ + } +}while(0) +#endif /* SHM */ + +extern double atof(); +extern q convert_c_string_to_klic_string(); +extern unsigned char* generic_string_body(); + +#ifdef DIST +extern void push_decode_stack(); +static q* decode_float(combuf* inbuf, q* g_allocp); +#endif /* DIST */ + GD_USE_CLASS(byte__string); GD_OBJ_TYPE { @@ -28,46 +59,39 @@ double value; }; -#define ALIGN() \ -if (sizeof(double) != sizeof(long)) { \ - g_allocp = (q*)(((unsigned long)g_allocp + (sizeof(double) - 1)) \ - & (-sizeof(double))); \ -} +#ifdef DIST +union dl { + double d; + long l[2]; +}; +#endif /* DIST */ #ifdef SHM -#define ALIGN_SHM() \ -if (sizeof(double) != sizeof(long)) { \ - gallocp = (q*)(((unsigned long)gallocp + (sizeof(double) - 1)) \ - & (-sizeof(double))); \ -} - -#include "shm.h" GDDEF_SHMCOPY() { G_STD_DECL; - GD_OBJ_TYPE *newself; + GD_OBJ_TYPE* newself; - for (;;) { + for(;;){ ALIGN_SHM(); - newself = (GD_OBJ_TYPE *)gallocp; - gallocp = (q*)((unsigned long)gallocp + sizeof(struct float_object)); - if (gallocp <= glimit) break; + newself = (GD_OBJ_TYPE*) gallocp; + gallocp = (q*) ((unsigned long)gallocp + sizeof(struct float_object)); + if( gallocp <= glimit ) break; gallocp = shm_galloc(0); } newself->method_table = GD_SELF->method_table; newself->value = GD_SELF->value; - return(makefunctor(newself)); + return makefunctor(newself); } -#define GDUSE_MY_SHMCOPY -#endif +#endif /* SHM */ /* basic method definitions */ GDDEF_GUNIFY() { G_STD_DECL; - if (GD_SELF->method_table != GD_OTHER->method_table || - GD_SELF->value != GD_OTHER->value) + if( GD_SELF->method_table != GD_OTHER->method_table || + GD_SELF->value != GD_OTHER->value ) GD_GUNIFY_FAIL; GD_GSUCCEED; } @@ -76,8 +100,8 @@ { G_STD_DECL; - if (GD_SELF->method_table != GD_OTHER->method_table || - GD_SELF->value != GD_OTHER->value) + if( GD_SELF->method_table != GD_OTHER->method_table || + GD_SELF->value != GD_OTHER->value ) GD_UNIFY_FAIL; GD_RETURN; } @@ -85,7 +109,7 @@ GDDEF_GC() { G_STD_DECL; - GD_OBJ_TYPE *newself; + GD_OBJ_TYPE* newself; ALIGN(); GDSET_NEWOBJ_IN_NEWGEN(newself); @@ -98,25 +122,24 @@ GDDEF_METHOD(print_1) { G_STD_DECL; - extern q convert_c_string_to_klic_string(); double value = GD_SELF->value; q str; char buf[100]; - (void)sprintf(buf, "%1.16g", value); - if (STRCHR(buf, '.') == 0 && - strcmp(buf, "Infinity") && strcmp(buf, "-Infinity") && - strcmp(buf, "NaN")) { - char *exponent = STRCHR(buf, 'e'); - if (exponent != 0) { + sprintf(buf, "%1.16g", value); + if( STRCHR(buf, '.') == 0 && + strcmp(buf, "Infinity") != 0 && strcmp(buf, "-Infinity") != 0 && + strcmp(buf, "NaN") != 0 ){ + char* exponent = STRCHR(buf, 'e'); + if( exponent != NULL ){ char save[100]; - (void)strcpy(save, exponent); - (void)strcpy(exponent, ".0"); - (void)strcpy(exponent+2, save); - } else { - (void)strcat(buf, ".0"); + strcpy(save, exponent); + strcpy(exponent, ".0"); + strcpy(exponent+2, save); + }else{ + strcat(buf, ".0"); } } - str = convert_c_string_to_klic_string(buf,g_allocp); + str = convert_c_string_to_klic_string(buf, g_allocp); g_allocp = heapp; GD_UNIFY_VALUE(GD_ARGV[0], str); GD_RETURN; @@ -126,21 +149,23 @@ { G_STD_DECL; double value = GD_SELF->value; - q result = makeint((long)value); + q result = makeint((long) value); GD_UNIFY_VALUE(GD_ARGV[0], result); GD_RETURN; } -static double unary_plus(x) - double x; +static double +unary_plus(x) + double x; { return x; } -static double unary_minus(x) - double x; +static double +unary_minus(x) + double x; { - return(-x); + return -x; } /* Generic Method Table */ @@ -149,14 +174,16 @@ G_STD_DECL; double self, result; unsigned long result_index; - GD_OBJ_TYPE *newobj; + GD_OBJ_TYPE* newobj; double (*func)(); self = GD_SELF->value; GD_SWITCH_ON_METHOD { - GD_METHOD_CASE(print_1); - GD_METHOD_CASE(int_1); + + GD_METHOD_CASE(print_1); + GD_METHOD_CASE(int_1); break; + default: ALIGN(); GDSET_NEWOBJ(newobj); @@ -164,50 +191,22 @@ case 1: { result_index = 0; GD_SWITCH_ON_METHOD { - 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; - GD_METHOD_CASE_DIRECT(asin_1): - func = asin; goto apply_1; - GD_METHOD_CASE_DIRECT(acos_1): - func = acos; goto apply_1; - GD_METHOD_CASE_DIRECT(atan_1): - func = atan; goto apply_1; - GD_METHOD_CASE_DIRECT(sinh_1): - func = sinh; goto apply_1; - GD_METHOD_CASE_DIRECT(cosh_1): - func = cosh; goto apply_1; - GD_METHOD_CASE_DIRECT(tanh_1): - func = tanh; goto apply_1; - /* - GD_METHOD_CASE_DIRECT(asinh_1): - func = asinh; goto apply_1; - GD_METHOD_CASE_DIRECT(acosh_1): - func = acosh; goto apply_1; - GD_METHOD_CASE_DIRECT(atanh_1): - func = atanh; goto apply_1; - */ - GD_METHOD_CASE_DIRECT(exp_1): - func = exp; goto apply_1; - GD_METHOD_CASE_DIRECT(log_1): - func = log; goto apply_1; - GD_METHOD_CASE_DIRECT(sqrt_1): - func = sqrt; goto apply_1; - GD_METHOD_CASE_DIRECT(ceil_1): - func = ceil; goto apply_1; - GD_METHOD_CASE_DIRECT(floor_1): - func = floor; goto apply_1; - /* - GD_METHOD_CASE_DIRECT(round_1): - func = rint; goto apply_1; - */ - GD_METHOD_CASE_DIRECT(plus_1): - func = unary_plus; goto apply_1; - GD_METHOD_CASE_DIRECT(minus_1): - func = unary_minus; goto apply_1; + 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; + GD_METHOD_CASE_DIRECT(asin_1): func = asin; goto apply_1; + GD_METHOD_CASE_DIRECT(acos_1): func = acos; goto apply_1; + GD_METHOD_CASE_DIRECT(atan_1): func = atan; goto apply_1; + GD_METHOD_CASE_DIRECT(sinh_1): func = sinh; goto apply_1; + GD_METHOD_CASE_DIRECT(cosh_1): func = cosh; goto apply_1; + GD_METHOD_CASE_DIRECT(tanh_1): func = tanh; goto apply_1; + GD_METHOD_CASE_DIRECT(exp_1): func = exp; goto apply_1; + GD_METHOD_CASE_DIRECT(log_1): func = log; goto apply_1; + GD_METHOD_CASE_DIRECT(sqrt_1): func = sqrt; goto apply_1; + GD_METHOD_CASE_DIRECT(ceil_1): func = ceil; goto apply_1; + GD_METHOD_CASE_DIRECT(floor_1): func = floor; goto apply_1; + GD_METHOD_CASE_DIRECT(plus_1): func = unary_plus; goto apply_1; + GD_METHOD_CASE_DIRECT(minus_1): func = unary_minus; goto apply_1; GD_METHOD_CASE_DEFAULT; } } @@ -216,35 +215,35 @@ double another_value; GD_DEREF(another); result_index = 1; - if (!isfunctor(another) || - ((GD_OBJ_TYPE*)functorp(another))->method_table != - GD_SELF->method_table) { + if( !isfunctor(another) || + ((GD_OBJ_TYPE*) functorp(another))->method_table != + 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."); } - another_value = ((GD_OBJ_TYPE *)functorp(another))->value; + another_value = ((GD_OBJ_TYPE*) functorp(another))->value; GD_SWITCH_ON_METHOD { - GD_METHOD_CASE_DIRECT(add_2): + GD_METHOD_CASE_DIRECT(add_2): result = self + another_value; goto apply_2; - GD_METHOD_CASE_DIRECT(subtract_2): + GD_METHOD_CASE_DIRECT(subtract_2): result = self - another_value; goto apply_2; - GD_METHOD_CASE_DIRECT(multiply_2): + GD_METHOD_CASE_DIRECT(multiply_2): result = self * another_value; goto apply_2; - GD_METHOD_CASE_DIRECT(divide_2): + GD_METHOD_CASE_DIRECT(divide_2): result = self / another_value; goto apply_2; - GD_METHOD_CASE_DIRECT(pow_2): + GD_METHOD_CASE_DIRECT(pow_2): result = pow(self, another_value); goto apply_2; - GD_METHOD_CASE_DEFAULT; + GD_METHOD_CASE_DEFAULT; } break; } - GD_METHOD_CASE_DEFAULT; + GD_METHOD_CASE_DEFAULT; } } GD_RETURN; @@ -263,35 +262,35 @@ { \ G_STD_DECL; \ q otherq = GD_ARGV[0]; \ - GD_OBJ_TYPE *other; \ + GD_OBJ_TYPE* other; \ double self, theother; \ \ - if (!G_ISGOBJ(otherq)) GD_GFAIL; \ - other = (GD_OBJ_TYPE *)G_FUNCTORP(otherq); \ - if (other->method_table != GD_SELF->method_table) GD_GFAIL; \ + if( !G_ISGOBJ(otherq) ) GD_GFAIL; \ + other = (GD_OBJ_TYPE*) G_FUNCTORP(otherq); \ + if( other->method_table != GD_SELF->method_table ) GD_GFAIL; \ self = GD_SELF->value; \ theother = other->value; \ - if (comparison) GD_GSUCCEED; \ + if( comparison ) GD_GSUCCEED; \ GD_GFAIL; \ } GDDEF_GMETHOD(less__than_1) -{ COMPARE_METHOD((self < theother)); } +{ COMPARE_METHOD(self < theother); } GDDEF_GMETHOD(not__greater__than_1) -{ COMPARE_METHOD((self <= theother)); } +{ COMPARE_METHOD(self <= theother); } GDDEF_GMETHOD(not__less__than_1) -{ COMPARE_METHOD((self >= theother)); } +{ COMPARE_METHOD(self >= theother); } GDDEF_GMETHOD(greater__than_1) -{ COMPARE_METHOD((self > theother)); } +{ COMPARE_METHOD(self > theother); } GDDEF_GMETHOD(equal_1) -{ COMPARE_METHOD((self == theother)); } +{ COMPARE_METHOD(self == theother); } GDDEF_GMETHOD(not__equal_1) -{ COMPARE_METHOD((self != theother)); } +{ COMPARE_METHOD(self != theother); } GDDEF_GMETHOD(float_0) { @@ -326,11 +325,11 @@ GDDEF_COMPARE() { G_STD_DECL; - if (GD_SELF->value > GD_OTHER->value) { + if( GD_SELF->value > GD_OTHER->value ){ return G_MAKEINT(1); - } else if (GD_SELF->value < GD_OTHER->value) { + }else if( GD_SELF->value < GD_OTHER->value ){ return G_MAKEINT(-1); - } else { + }else{ return G_MAKEINT(0); } } @@ -338,32 +337,26 @@ GDDEF_HASH() { G_STD_DECL; - return G_MAKEINT((long)GD_SELF->value); + return G_MAKEINT((long) GD_SELF->value); } -#ifdef DIST -q *decode_float(); +#ifdef DIST GDDEF_ENCODE() { G_STD_DECL; PUT_BUFFER(buffer, decode_float); - if ( sizeof(double) == sizeof(long) ) { - PUT_BUFFER(buffer, (long) GD_SELF->value ); - } else { - union d2l { - double d; - long l[2]; - } dl; - + if( sizeof(double) == sizeof(long) ){ + PUT_BUFFER(buffer, (long) GD_SELF->value); + }else{ + union dl dl; dl.d = GD_SELF->value; - PUT_BUFFER(buffer, dl.l[0]); - PUT_BUFFER(buffer, dl.l[1]); + PUT_BUFFER(buffer, dl.l[0]); + PUT_BUFFER(buffer, dl.l[1]); } - return(GENERIC_SUCCEEDED); + return GENERIC_SUCCEEDED; } - -#endif +#endif /* DIST */ #define GDUSE_MY_GUNIFY #define GDUSE_MY_UNIFY @@ -372,6 +365,9 @@ #ifdef DIST #define GDUSE_MY_ENCODE #endif +#ifdef SHM +#define GDUSE_MY_SHMCOPY +#endif #define GDUSE_MY_GENERIC #define GDUSE_MY_GGENERIC #define GDUSE_MY_COMPARE @@ -386,20 +382,18 @@ { GD_STD_DECL_FOR_NEW; q init = GD_ARGV[0]; - GD_OBJ_TYPE *newobj; + GD_OBJ_TYPE* newobj; GD_DEREF_FOR_NEW(init); ALIGN(); - GDSET_NEWOBJ_FOR_NEW(newobj,G_SIZE_IN_Q(GD_OBJ_TYPE)); - if (G_ISINT(init)) { - 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) { - extern unsigned char *generic_string_body(); - double atof(); - newobj->value = atof((char *)generic_string_body(G_FUNCTORP(init))); - } else { + GDSET_NEWOBJ_FOR_NEW(newobj, G_SIZE_IN_Q(GD_OBJ_TYPE)); + if( G_ISINT(init) ){ + 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 ){ + 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"); } @@ -407,33 +401,27 @@ } #ifdef DIST - -void push_decode_stack(); - -q *decode_float(inbuf, g_allocp) - combuf *inbuf; - q *g_allocp; +static q* +decode_float(inbuf, g_allocp) + combuf* inbuf; + q* g_allocp; { G_STD_DECL; - GD_OBJ_TYPE *newobj; + GD_OBJ_TYPE* newobj; ALIGN(); - G_HEAPALLOC(newobj, G_SIZE_IN_Q(GD_OBJ_TYPE), (GD_OBJ_TYPE *)); + G_HEAPALLOC(newobj, G_SIZE_IN_Q(GD_OBJ_TYPE), (GD_OBJ_TYPE*)); newobj->method_table = &GD_method_table; - if ( sizeof(long) == sizeof(double) ) { + if( sizeof(long) == sizeof(double) ){ newobj->value = (double) GET_BUFFER(inbuf); - } else { - union l2d { - long l[2]; - double d; - } ld; - - ld.l[0] = (long) GET_BUFFER(inbuf); - ld.l[1] = (long) GET_BUFFER(inbuf); - newobj->value = ld.d; + }else{ + union dl dl; + dl.l[0] = (long) GET_BUFFER(inbuf); + dl.l[1] = (long) GET_BUFFER(inbuf); + newobj->value = dl.d; } - push_decode_stack((q)makefunctor(newobj)); - return (g_allocp); + push_decode_stack((q) makefunctor(newobj)); + return g_allocp; } -#endif +#endif /* DIST */ diff -ruN klic-3.003-2002-01-12/runtime/import_table.c klic-3.003-2002-01-12a/runtime/import_table.c --- klic-3.003-2002-01-12/runtime/import_table.c Mon Jan 7 15:40:54 2002 +++ klic-3.003-2002-01-12a/runtime/import_table.c Sat Jan 12 20:05:30 2002 @@ -16,21 +16,13 @@ #include "interpe.h" #include +#include "ge_exref.h" #define IMP_TABLE_INC_SIZE 0x1000 #define END_IMP_FREELIST (-1) #define END_IMP_TABLE (-1) #define UNUSED_IMPREC 0xf0f0f0ff /* This value is curious!! */ -struct exref_object{ - struct generator_object_method_table* method_table; - long pe_num; - long index; - long wec; - q to_exref; - long gc_flag; -}; - struct imp_entry{ long next; q object; @@ -105,15 +97,15 @@ exref = (struct exref_object*) imp_table[next_import].object; - if( exref->pe_num>total_node ){ + if( exref->node > total_node ){ ioeprintf("next_import is %d\n", next_import); - ioeprintf("PE %d invalid pe_num in send_release_after_gc\n", my_node); + ioeprintf("PE %d invalid node in send_release_after_gc\n", my_node); ERROR_STOP; - fatal("invalid pe_num in send_release_after_gc"); + fatal("invalid node in send_release_after_gc"); } - send_release(exref->pe_num, exref->index, exref->wec); + send_release(exref->node, exref->index, exref->wec); } @@ -126,9 +118,9 @@ while( next_impo != END_IMP_TABLE ){ ex_ref = (struct exref_object*) imp_table[next_impo].object; - if( intval(ex_ref->pe_num) > total_node ){ + if( intval(ex_ref->node) > total_node ){ ioeprintf("next_impo is %d\n", next_impo); - fatalf("invalid pe_num in chech_imp %s scan", when); + fatalf("invalid node in chech_imp %s scan", when); } next_impo = imp_table[next_impo].next; }