diff -ruN klic-3.003-2002-03-16/Configure klic-3.003-2002-03-19/Configure --- klic-3.003-2002-03-16/Configure Fri Mar 8 14:27:38 2002 +++ klic-3.003-2002-03-19/Configure Tue Mar 19 14:12:12 2002 @@ -401,19 +401,10 @@ echo $n "Configure also for parallel implementations? "$c if ask_yes_or_no no DEF_PARALLEL; then PARALELL=true -echo $n "Configure for distributed memory parallel KLIC? "$c -if ask_yes_or_no no DEF_DISTSYSTEM; then DISTSYSTEM=true ARCHIVES="$ARCHIVES libklicd.a" DLLIBS="$DLLIBS libklicd\$(DLLEXT)" else -disttype=pvm -#INCLUDESH=runtime/config/$disttype/config.h.sh -DISTSYSTEM=false -ROOTMAKE=root.mk.sh -INCLUDESH="config.h.sh" -fi -else PARALLEL=false disttype=pvm #INCLUDESH=runtime/config/$disttype/config.h.sh @@ -454,25 +445,6 @@ ROOTMAKE=runtime/config/$disttype/root.mk.sh INCLUDESH=runtime/config/$disttype/config.h.sh -fi - -if [ "$CROSS" = "false" ]; false; then -: ::::::::::::::::::: SHARED Memory SETTING :::::::::::::::::::: -echo ' ' -echo $n "Configure for shared memory parallel KLIC? "$c -if ask_yes_or_no no DEF_SHMSYSTEM; then - guess_arch - if [ $CPU != "Unknown_cpu" ]; then - ARCHIVES="$ARCHIVES libklics.a" - DLLIBS="$DLLIBS libklics$(DLLEXT)" - else - cat <disttests.log -shmtests: compilerdir runtimedir $(DLLTARGET) - cd shmtest; \ - LD_LIBRARY_PATH=../runtime:${LD_LIBRARY_PATH}; \ - export LD_LIBRARY_PATH; \ - $(MAKE) PARALLEL="$(PARALLEL)" KLICOPT="$(KLICOPT)" NODES="$(NODES)" \ - distclean all-test - install-basics: all install-compiler install-runtime $(DLLINSTALLTARGET) install-include install-compiler: compilerdir @@ -256,7 +249,6 @@ cd runtime; $(MAKE) clean LN="$(LN)" DLLIBS="$(DLLIBS)" cd test; $(MAKE) clean cd disttest; $(MAKE) clean - cd shmtest; $(MAKE) clean cd documents; $(MAKE) clean cd rmon; $(MAKE) clean - /bin/rm -f core Makefile.bak *~ \#*\# @@ -267,7 +259,6 @@ cd runtime; $(MAKE) distclean LN="$(LN)" DLLIBS="$(DLLIBS)" cd test; $(MAKE) distclean cd disttest; $(MAKE) distclean - cd shmtest; $(MAKE) distclean cd documents; $(MAKE) distclean cd rmon; $(MAKE) distclean - /bin/rm -f Makefile core Makefile.bak config.tmp config.sh \ @@ -280,7 +271,6 @@ cd runtime; $(MAKE) realclean LN="$(LN)" DLLIBS="$(DLLIBS)" cd test; $(MAKE) realclean cd disttest; $(MAKE) realclean - cd shmtest; $(MAKE) realclean cd documents; $(MAKE) realclean cd rmon; $(MAKE) realclean - /bin/rm -f Makefile core *.bak *.orig version.sed \ diff -ruN klic-3.003-2002-03-16/compiler/klic.c klic-3.003-2002-03-19/compiler/klic.c --- klic-3.003-2002-03-16/compiler/klic.c Tue Feb 26 16:48:44 2002 +++ klic-3.003-2002-03-19/compiler/klic.c Tue Mar 19 14:21:17 2002 @@ -214,7 +214,6 @@ /* Options */ static char distklic = 0; /***** added for klicdist *****/ -static char shmklic = 0; /***** added for klicshm *****/ static char* ofile = NULL; static int optlevel = 0; @@ -508,9 +507,6 @@ /*** for Distributed KLIC system ***/ if (distklic) { sprintf(bufp, DIST_COMPILER_FLAG, klic_incdir, name, inf->ext); - } else if ( shmklic ) { - sprintf(bufp, " -DSHM -I%s -I. %s%s", - klic_incdir, name, inf->ext); } else { sprintf(bufp, " -I%s -I. %s%s", klic_incdir, name, inf->ext); @@ -636,8 +632,6 @@ char* tptr; if ( distklic ) { tptr = LIBRARIES_D; - } else if ( shmklic ) { - tptr = LIBRARIES_S; } else if ( debug ) { tptr = LIBRARIES_T; } else { @@ -781,10 +775,6 @@ parallelism = atoi(Optarg()); goto nextarg; case 'R': do_recompile = 1; break; case 'S': make_asm = 1; break; - case 's': - if (strcmp(argv[optind],"-shm")==0) { - shmklic = 1; goto nextarg; - } case 'v': verbose = 1; break; case 'n': debug = 0; break; case 't': diff -ruN klic-3.003-2002-03-16/include/Makefile.tail klic-3.003-2002-03-19/include/Makefile.tail --- klic-3.003-2002-03-16/include/Makefile.tail Sat Feb 16 10:54:11 2002 +++ klic-3.003-2002-03-19/include/Makefile.tail Tue Mar 19 14:22:56 2002 @@ -8,8 +8,6 @@ DISTHEADERS = klic/distio.h klic/distproc.h klic/distpkt.h $(DISTMHEADERS) # klic/interpe.h klic/rmon.h -SHMHEADERS = # klic/shm.h klic/shm_machine.h - HEADERS = klic/config.h \ klic/alloc.h klic/atomstuffs.h \ klic/basic.h klic/bb.h klic/control.h \ @@ -31,14 +29,11 @@ # klic/trace.h klic/traceio.h klic/timer.h # klic/g_pointer.h klic/g_termarray.h klic/asyncio.h - -#ls: -# ls ${HEADERS} ${DISTHEADERS} ${SHMHEADERS} install: - $(INSTDIR) $(KLICINCLUDE)/klic if (test `pwd` != $(KLICINCLUDE)) then \ ($(INSTALLHDR) $(HEADERS) $(KLICINCLUDE)/klic);\ - for file in $(DISTHEADERS) $(SHMHEADERS); \ + for file in $(DISTHEADERS); \ do test -f $$file && \ $(INSTALLHDR) $$file $(KLICINCLUDE)/klic;\ done;\ diff -ruN klic-3.003-2002-03-16/include/klic/basic.h klic-3.003-2002-03-19/include/klic/basic.h --- klic-3.003-2002-03-16/include/klic/basic.h Mon Jan 21 20:55:25 2002 +++ klic-3.003-2002-03-19/include/klic/basic.h Tue Mar 19 14:23:49 2002 @@ -35,10 +35,7 @@ extern void debug_fprintf(); extern void klic_fprintf(); -/* - PARALLEL flag is DIST || SHM. -*/ -#if defined(DIST) || defined(SHM) +#ifdef DIST #define PARALLEL #endif diff -ruN klic-3.003-2002-03-16/include/klic/g_methtab.h klic-3.003-2002-03-19/include/klic/g_methtab.h --- klic-3.003-2002-03-16/include/klic/g_methtab.h Mon Mar 11 13:21:48 2002 +++ klic-3.003-2002-03-19/include/klic/g_methtab.h Tue Mar 19 14:24:19 2002 @@ -41,7 +41,6 @@ struct data_object *another_obj */ ); q (*hash)( /* struct data_object *obj, unsigned long level */ ); q (*encode)(/* struct data_object *obj, long node */); - q (*shmcopy)(/* struct data_object *obj */); }; #define data_objectp(obj) \ diff -ruN klic-3.003-2002-03-16/include/klic/gd_macro.h klic-3.003-2002-03-19/include/klic/gd_macro.h --- klic-3.003-2002-03-16/include/klic/gd_macro.h Mon Mar 11 17:41:07 2002 +++ klic-3.003-2002-03-19/include/klic/gd_macro.h Tue Mar 19 14:24:44 2002 @@ -431,9 +431,4 @@ combuf *buffer; \ long depth; -#define GDDEF_SHMCOPY() \ - q \ - GD_rappend(encode) (GD_SELF) \ - GD_OBJ_TYPE * GD_SELF; - #endif /* _KLIC_GD_MACRO_H_ */ diff -ruN klic-3.003-2002-03-16/include/klic/gd_methtab.h klic-3.003-2002-03-19/include/klic/gd_methtab.h --- klic-3.003-2002-03-16/include/klic/gd_methtab.h Tue Mar 12 12:08:47 2002 +++ klic-3.003-2002-03-19/include/klic/gd_methtab.h Tue Mar 19 14:26:10 2002 @@ -34,7 +34,6 @@ extern q GD_STD_HASH(struct data_object* GD_SELF, long level); extern q GD_STD_ENCODE(struct data_object* self, void* buffer); -extern q GD_STD_SHMCOPY(struct data_object* self); struct data_object_method_table GD_method_table @@ -97,12 +96,6 @@ GD_STD_ENCODE , #else GD_rappend(encode) , -#endif - -#ifndef GDUSE_MY_SHMCOPY - GD_STD_SHMCOPY -#else - GD_rappend(encode) #endif }; diff -ruN klic-3.003-2002-03-16/include/klic/struct.h klic-3.003-2002-03-19/include/klic/struct.h --- klic-3.003-2002-03-16/include/klic/struct.h Tue Feb 26 12:32:09 2002 +++ klic-3.003-2002-03-19/include/klic/struct.h Tue Mar 19 14:27:34 2002 @@ -202,20 +202,6 @@ /* parallel comm Imp. */ long my_num0; long num_pes0; - union { - /* shared-memory Imp. */ - struct { - long queued0; - struct ex_goalrec* ex_qp0; - long currid0; - long oldid0; - long shm_htop0; - long shm_hbyte0; - long dummy[10]; - } shm; - /* dist-memory Imp. */ - - } aux; } par; q generic_arg0[MAXGENERICARGS]; /* arguments of generic methods */ diff -ruN klic-3.003-2002-03-16/runtime/Makefile.tail klic-3.003-2002-03-19/runtime/Makefile.tail --- klic-3.003-2002-03-16/runtime/Makefile.tail Fri Mar 8 15:35:46 2002 +++ klic-3.003-2002-03-19/runtime/Makefile.tail Tue Mar 19 13:56:28 2002 @@ -5,7 +5,6 @@ # (Read COPYRIGHT-JIPDEC for detailed information.) # ---------------------------------------------------------- -SHMCFLAGS = $(CFLAGS) -DSHM -I../include DEFINITIONS=$(DISTCFLAGS) -I../include KLIC = ../compiler/klic -P$(PARALLEL) $(KLICOPT) \ -R -I../include -X. -K$(KL1CMP) -D../compiler/klicdb -v @@ -73,7 +72,6 @@ KL1NODCSRCS = bodyblt.c gunix.c io.c KL1DOBJS = bodyblt-d.o gunix-d.o io-d.o KL1DSRCS = bodyblt-d.c gunix-d.c io-d.c -KL1SOBJS = bodyblt-s.o gunix-s.o io.o EXTS = $(COMMONKL1EXTS) $(KL1EXTS) @@ -99,10 +97,6 @@ DDEBUGOBJS = debug-d.o gc.o trace-d.o step-d.o DDEBUGSRCS = debug-d.c gc.c trace-d.c step-d.c -SDEBUGOBJS = $(DEBUGOBJS) $(GENERIC_SHMOBJS) \ - kmain-s.o options-s.o debug-s.o newatom-s.o sched-s.o \ - intrpt-s.o gc-s.o trace-s.o step-s.o - COMMON_GENERIC_SRCS = \ gtermarray.c gmerge.c gcode.c gmodule.c ggoal.c gpointer.c random.c COMMON_GENERIC_OBJS = \ @@ -112,7 +106,6 @@ GENERIC_SEQOBJS = gfloat.o gio.o gmvv.o gstring.o GENERIC_DSRCS = gfloat-d.c gio-d.c gmvv-d.c gstring-d.c GENERIC_DOBJS = gfloat-d.o gio-d.o gmvv-d.o gstring-d.o -GENERIC_SHMOBJS = gfloat-s.o gio.o gmvv-s.o gstring-s.o GENERIC_SRCS = $(COMMON_GENERIC_SRCS) $(GENERIC_SEQSRCS) @@ -128,16 +121,9 @@ init_dist.o sendrecv.o distrmon.o profile.o \ $(DIST_OTHER_OBJS) $(DIST_GENERIC_OBJS) -SHM_GENERIC_SRCS = gg_shvar.c gg_shbusy.c -SHM_GENERIC_OBJS = gg_shvar.o gg_shbusy.o - -SHMSRCS = shm_rsv.c shm_throw.c shm_obj.c shm_gc.c -SHMOBJS = shm_rsv.o shm_throw.o shm_obj.o shm_gc.o - ALLOBJS = $(COMMONOBJS) $(DEBUGOBJS) \ - $(KL1NODOBJS) $(KL1DOBJS) $(KL1SOBJS) $(NODOBJS) $(DOBJS) \ - $(NODDEBUGOBJS) $(DDEBUGOBJS) $(SDEBUGOBJS) \ - $(DISTOBJS) $(SHMOBJS) $(SHM_GENERIC_OBJS) + $(KL1NODOBJS) $(KL1DOBJS) $(NODOBJS) $(DOBJS) \ + $(NODDEBUGOBJS) $(DDEBUGOBJS) $(DISTOBJS) uplevel: cd ..;make runtimedir @@ -162,11 +148,6 @@ ar rcv $@ $? $(RANLIB) $@ -libklics.a: $(COMMONOBJS) $(KL1SOBJS) $(SDEBUGOBJS) \ - $(SHM_GENERIC_OBJS) $(SHMOBJS) - ar rcv $@ $? - $(RANLIB) $@ - libklic$(DLLEXT): $(COMMONOBJS) $(KL1NODOBJS) $(NODOBJS) $(LDSHARED) -o $@ $? @@ -178,10 +159,6 @@ $(DDEBUGOBJS) $(DOBJS) $(DISTOBJS) $(LDSHARED) -o $@ $? -libklics$(DLLEXT): $(COMMONOBJS) $(KL1SOBJS) $(SDEBUGOBJS) \ - $(SHM_GENERIC_OBJS) $(SHMOBJS) - $(LDSHARED) -o $@ $? - kmain-d.c: kmain.c rm -f $@; $(LN) $? $@ debug-d.c: debug.c @@ -262,43 +239,6 @@ pipedio: pipedio.c $(CC) $(CFLAGS) $(LDFLAGS) -I../include -o pipedio pipedio.c -kmain-s.o: kmain.c options.h - $(CC) $(SHMCFLAGS) -c -o kmain-s.o kmain.c -options-s.o: options.c - $(CC) $(SHMCFLAGS) -c -o options-s.o options.c -gc-s.o: gc.c - $(CC) $(SHMCFLAGS) -c -o gc-s.o gc.c -debug-s.o: debug.c - $(CC) $(SHMCFLAGS) -c -o debug-s.o debug.c -sched-s.o: sched.c - $(CC) $(SHMCFLAGS) -c -o sched-s.o sched.c -newatom-s.o: newatom.c - $(CC) $(SHMCFLAGS) -c -o newatom-s.o newatom.c -bodyblt-s.o: bodyblt.c - $(CC) $(SHMCFLAGS) -c -o bodyblt-s.o bodyblt.c -gunix-s.o: gunix.c - $(CC) $(SHMCFLAGS) -c -o gunix-s.o gunix.c -gmvv-s.o: gmvv.c - $(CC) $(SHMCFLAGS) -c -o gmvv-s.o gmvv.c -gstring-s.o: gstring.c - $(CC) $(SHMCFLAGS) -c -o gstring-s.o gstring.c -gfloat-s.o: gfloat.c - $(CC) $(SHMCFLAGS) -c -o gfloat-s.o gfloat.c -intrpt-s.o: intrpt.c - $(CC) $(SHMCFLAGS) -c -o intrpt-s.o intrpt.c -trace-s.o: trace.c - $(CC) $(SHMCFLAGS) -c -o trace-s.o trace.c -step-s.o: step.c - $(CC) $(SHMCFLAGS) -c -o step-s.o step.c -shm_rsv.o: shm_rsv.c - $(CC) $(SHMCFLAGS) -c shm_rsv.c -shm_throw.o: shm_throw.c - $(CC) $(SHMCFLAGS) -c shm_throw.c -shm_obj.o: shm_obj.c - $(CC) $(SHMCFLAGS) -c shm_obj.c -shm_gc.o: shm_gc.c - $(CC) $(SHMCFLAGS) -c shm_gc.c - .kl1.c: $(KL1CMP) $< @@ -531,70 +471,6 @@ recsusp.o: recsusp.c \ ../include/klic/basic.h ../include/klic/config.h \ ../include/klic/struct.h ../include/klic/param.h -gg_shvar.o: gg_shvar.c \ - ../include/klic/basic.h ../include/klic/config.h \ - ../include/klic/struct.h ../include/klic/param.h \ - shm.h shm_machine.h -gg_shbusy.o: gg_shbusy.c \ - ../include/klic/basic.h ../include/klic/config.h \ - ../include/klic/struct.h ../include/klic/param.h \ - shm.h shm_machine.h -shm_rsv.o: shm_rsv.c \ - ../include/klic/basic.h ../include/klic/config.h \ - ../include/klic/struct.h ../include/klic/param.h \ - shm.h shm_machine.h -shm_throw.o: shm_throw.c \ - ../include/klic/basic.h ../include/klic/config.h \ - ../include/klic/struct.h ../include/klic/param.h \ - shm.h shm_machine.h -shm_obj.o: shm_obj.c \ - ../include/klic/basic.h ../include/klic/config.h \ - ../include/klic/struct.h ../include/klic/param.h \ - shm.h shm_machine.h -shm_gc.o: shm_gc.c \ - ../include/klic/basic.h ../include/klic/config.h \ - ../include/klic/struct.h ../include/klic/param.h \ - shm.h shm_machine.h -bodyblt-s.o: bodyblt.c \ - ../include/klic/basic.h ../include/klic/config.h \ - ../include/klic/struct.h ../include/klic/param.h \ - shm.h shm_machine.h -gunix-s.o: gunix.c \ - ../include/klic/basic.h ../include/klic/config.h \ - ../include/klic/struct.h ../include/klic/param.h \ - shm.h shm_machine.h -kaim-s.o: kmain.c \ - ../include/klic/basic.h ../include/klic/config.h \ - ../include/klic/struct.h ../include/klic/param.h \ - shm.h shm_machine.h options.h -options-s.o: options.c \ - ../include/klic/basic.h ../include/klic/config.h \ - ../include/klic/struct.h ../include/klic/param.h \ - shm.h shm_machine.h options.h -debug-s.o: debug.c \ - ../include/klic/basic.h ../include/klic/config.h \ - ../include/klic/struct.h ../include/klic/param.h \ - shm.h shm_machine.h -sched-s.o: sched.c \ - ../include/klic/basic.h ../include/klic/config.h \ - ../include/klic/struct.h ../include/klic/param.h \ - shm.h shm_machine.h -intrpt-s.o: intrpt.c \ - ../include/klic/basic.h ../include/klic/config.h \ - ../include/klic/struct.h ../include/klic/param.h \ - shm.h shm_machine.h -gc-s.o: gc.c \ - ../include/klic/basic.h ../include/klic/config.h \ - ../include/klic/struct.h ../include/klic/param.h \ - shm.h shm_machine.h -gmvv-s.o: gmvv.c \ - ../include/klic/basic.h ../include/klic/config.h \ - ../include/klic/struct.h ../include/klic/param.h \ - shm.h shm_machine.h -gstring-s.o: gstring.c \ - ../include/klic/basic.h ../include/klic/config.h \ - ../include/klic/struct.h ../include/klic/param.h \ - shm.h shm_machine.h main.o: main.c timer.o: timer.c \ ../include/klic/basic.h ../include/klic/config.h \ diff -ruN klic-3.003-2002-03-16/runtime/debug.c klic-3.003-2002-03-19/runtime/debug.c --- klic-3.003-2002-03-16/runtime/debug.c Mon Mar 4 10:38:31 2002 +++ klic-3.003-2002-03-19/runtime/debug.c Tue Mar 19 14:00:17 2002 @@ -29,10 +29,6 @@ #define Node_type() (io_node_flag == 0) #endif -#ifdef SHM -#include "shm.h" -#endif - /* Function name convention: @@ -72,9 +68,6 @@ } #ifdef DIST close_network(); -#endif -#ifdef SHM - abend(""); #endif exit(-1); } diff -ruN klic-3.003-2002-03-16/runtime/faisus.c klic-3.003-2002-03-19/runtime/faisus.c --- klic-3.003-2002-03-16/runtime/faisus.c Sat Mar 9 11:41:27 2002 +++ klic-3.003-2002-03-19/runtime/faisus.c Tue Mar 19 14:29:25 2002 @@ -89,18 +89,6 @@ struct hook* newhook; susp = suspp(derefone(reason)); /* for shm implementation */ -#ifdef SHM - /* - * On shared memory implementation, - * this `susp' may be instanciated by one of the other processors. - * Thus, check again. - */ - if ( !isref(susp) || reason != derefone(susp) ) { - resume_same_prio(goal); - return; - } -#endif /* SHM */ - /* generator object ? */ if (!is_generator_susp(susp->u)) { /* then allocate new hook */ diff -ruN klic-3.003-2002-03-16/runtime/gc.c klic-3.003-2002-03-19/runtime/gc.c --- klic-3.003-2002-03-16/runtime/gc.c Tue Mar 5 21:33:33 2002 +++ klic-3.003-2002-03-19/runtime/gc.c Tue Mar 19 14:06:43 2002 @@ -19,10 +19,6 @@ #include "interpe.h" #endif -#ifdef SHM -#include "shm.h" -#endif /* SHM */ - #define generic_gc(obj) (method_table_of(obj)->gc(obj)) extern const struct predicate queue_empty_pred; @@ -66,30 +62,6 @@ gcmax0 = newstack + gcstack_size; } -#ifdef SHM -extern q** -make_shm_larger_stack(sp) - q** sp; -{ - declare_globals; - q** newstack; - shm_gcstack_size *= 2; - newstack = (q**) realloc_check((void*) shm_gcstack, shm_gcstack_size*sizeof(q*)); - sp = newstack + (sp - shm_gcstack); - shm_gcstack = newstack; - shm_gcmax = newstack + shm_gcstack_size; - return sp; -} - -static void push_shm_stack(q* addr) -{ - if(shm_sp == shm_gcmax) - shm_sp = make_shm_larger_stack(shm_sp); - *shm_sp = addr; - shm_sp++; -} -#endif /* SHM */ - static int within_new_space(q* x) { return (unsigned long)x - (unsigned long)new_space_top() < new_space_size(); @@ -108,22 +80,6 @@ set_gcsp(gcsp() + 1); } -#ifdef SHM -#define reserve_copy(from, to) \ -if( from == makeref(&from) ){ \ - to = from = makeref(&to); \ -}else{ \ - to = from; \ - if( !isatomic(from) ){ \ - if( is_shma(from) ){ \ - push_shm_stack(&to); \ - }else if( within_old_space(from) ){ \ - from = makeref(&to); \ - push_gc_stack(&to); \ - } \ - } \ -} -#else /* not SHM */ #define reserve_copy(from, to) \ if( from == makeref(&from) ){ \ to = from = makeref(&to); \ @@ -134,7 +90,6 @@ push_gc_stack(&to); \ } \ } -#endif /* not SHM */ #define copy_one_goal(goal, susp) \ do{ \ @@ -165,16 +120,6 @@ obj = *addr; loop: -#ifdef SHM - if( is_shma(obj) ){ - *addr = obj; - if( ptagof(obj) != ATOMIC ){ - push_shm_stack(addr); - } - continue; /* while stack rests */ - } -#endif - switch( ptagof(obj) ){ case ATOMIC: *addr = obj; @@ -257,9 +202,6 @@ goto deref; } *addr = value; -#ifdef SHM - if( is_shma(value) ) push_shm_stack(addr); -#endif }else if( value == obj ){ if( within_new_space(addr) ){ *addr = derefone(obj) = makeref(addr); @@ -387,13 +329,6 @@ last = &goal_queue_tail; for( ; qp != NULL; qp=next ){ next = qp->next; -#ifdef SHM - if( is_shma(qp) ){ - qp->next = last; - last = qp; - continue; /* for qp */ - } -#endif copy_one_goal(qp, 0); copy_terms(); qp->next = last; @@ -423,55 +358,8 @@ gcstack = (q**) malloc_check(gcstack_size*sizeof(q*)); set_gcsp(gcstack); gcmax0 = gcstack + gcstack_size; -#ifdef SHM - shm_gcstack_size = GCSTACKSIZE; - shm_gcstack = (q**) malloc(shm_gcstack_size*sizeof(q*)); - shm_sp = shm_gcstack; - shm_gcmax = shm_gcstack+shm_gcstack_size; - }else{ - shm_sp = shm_gcstack; -#endif } -#ifdef SHM - /* copy into Shared-memory Generator hook data */ - { - TADDRtbl* nptr; - TADDRtbl* sptr = &ADDRtbl; - for( sptr=sptr->next; sptr != &ADDRtbl; sptr=nptr ){ - nptr = sptr->next; - 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; /* 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 /* SHM */ - set_heaptop(new_space_top()); set_heapp(new_space_top()); set_real_heapbytesize(new_space_size()); @@ -488,106 +376,6 @@ } qp = copy_one_queue(qp); -#ifdef SHM - { - TADDRtbl* nptr; - TADDRtbl* sptr = &ADDRtbl; - for( sptr=sptr->next; sptr!=&ADDRtbl; sptr=nptr ){ - nptr = sptr->next; - switch( ptagof(sptr->localA) ){ - case CONS: - case FUNCTOR: /* generator hook but anybody reqested */ - push_gc_stack((q*) &sptr->localA); - copy_terms(); - push_shm_stack(&sptr->globalA); - break; - 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); - - /* patch for debugging of hirata problem */ - hirata_bug1 = 1; - copy_terms(); - hirata_bug1 = 0; - - wk = derefone(top); - if( wk == top ) - goto REM_HOOK; - sptr->localA = (q*) tag_local(wk); - derefone(wk) = 0; - }else{ /* generator */ - push_gc_stack(&wk); - copy_terms(); - sptr->localA = (q*) tag_local(wk); - } - push_shm_stack(&sptr->globalA); - 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, 1); - sptr->localA = (q*) wqp; - copy_terms(); - 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); - }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: - ; - } - } - } - } - } - } -#endif /* SHM */ - { struct suspended_goal_rec* sgl; struct suspended_goal_rec** sgl_tail = &suspended_goal_list0; @@ -725,9 +513,6 @@ } reset_this_more_space(); gctimes++; -#ifdef SHM - if( F_shm_gc ) qp = shm_gc(qp); -#endif if( measure_gc ){ measure(after); #ifdef GETRUSAGE diff -ruN klic-3.003-2002-03-16/runtime/generic.c klic-3.003-2002-03-19/runtime/generic.c --- klic-3.003-2002-03-16/runtime/generic.c Tue Mar 12 12:08:47 2002 +++ klic-3.003-2002-03-19/runtime/generic.c Tue Mar 19 14:30:37 2002 @@ -232,13 +232,6 @@ return GENERIC_FAILED; } -extern q -GD_STD_SHMCOPY(self) - struct data_object* self; -{ - fatal("Undefined Data object copied into shared-memory"); -} - /* Generator object */ diff -ruN klic-3.003-2002-03-16/runtime/gfloat.c klic-3.003-2002-03-19/runtime/gfloat.c --- klic-3.003-2002-03-16/runtime/gfloat.c Tue Mar 12 12:51:29 2002 +++ klic-3.003-2002-03-19/runtime/gfloat.c Tue Mar 19 14:08:00 2002 @@ -17,10 +17,6 @@ #include "interpe.h" #endif -#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)) @@ -33,16 +29,6 @@ } \ }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(); @@ -66,25 +52,6 @@ }; #endif /* DIST */ -#ifdef SHM -GDDEF_SHMCOPY() -{ - G_STD_DECL; - GD_OBJ_TYPE* newself; - - for(;;){ - ALIGN_SHM(); - 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); -} -#endif /* SHM */ - /* basic method definitions */ GDDEF_GUNIFY() @@ -361,9 +328,6 @@ #define GDUSE_MY_GC #ifdef DIST #define GDUSE_MY_ENCODE -#endif -#ifdef SHM -#define GDUSE_MY_SHMCOPY #endif #define GDUSE_MY_GENERIC #define GDUSE_MY_GGENERIC diff -ruN klic-3.003-2002-03-16/runtime/gg_shbusy.c klic-3.003-2002-03-19/runtime/gg_shbusy.c --- klic-3.003-2002-03-16/runtime/gg_shbusy.c Mon Mar 11 17:16:26 2002 +++ klic-3.003-2002-03-19/runtime/gg_shbusy.c Thu Jan 1 09:00:00 1970 @@ -1,76 +0,0 @@ -/* ---------------------------------------------------------- -% (C)1995 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) -% (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center -% (Read COPYRIGHT-JIPDEC for detailed information.) ------------------------------------------------------------ */ -/* - sample program for generator object -*/ -#include - -#include /* fatal */ -#include -#include -#include -#include -#include -#include /* do_unify */ -#include "shm.h" - -#define GG_CLASS_NAME() shbusy -#define GG_OBJ_TYPE struct Shbusy - -#define One_more() (do_unify(GG_SELF, GG_TERM)) - -struct Shbusy { - struct generator_object_method_table *method_table; -}; - -GGDEF_UNIFY() -{ - G_STD_DECL; - - struct generator_object* gobj; - q pair = derefone(GG_SELF); - if( !isref(pair) || GG_SELF != derefone(pair) ){ One_more(); GG_TERMINATE; } - gobj = n_lock(GG_SELF, pair); - if( derefone(GG_SELF) == pair ){ - n_unlock(pair, gobj); - } - One_more(); - GG_TERMINATE; -} - -GGDEF_GENERATE() -{ - return makecons(0); -} - -GGDEF_SUSPEND() -{ - return makecons(0); -} - -GGDEF_PRINT() -{ - fprintf(g_fp, "", GG_SELF); - return 0; -} - -GGDEF_GC() -{ - fatal("bug!!!"); -} - -#define GGUSE_MY_UNIFY -#define GGUSE_MY_GENERATE -#define GGUSE_MY_SUSPEND -#define GGUSE_MY_GC -#define GGUSE_MY_PRINT - -#include - -GGDEF_NEW() -{ -} diff -ruN klic-3.003-2002-03-16/runtime/gg_shvar.c klic-3.003-2002-03-19/runtime/gg_shvar.c --- klic-3.003-2002-03-16/runtime/gg_shvar.c Tue Mar 12 12:08:47 2002 +++ klic-3.003-2002-03-19/runtime/gg_shvar.c Thu Jan 1 09:00:00 1970 @@ -1,343 +0,0 @@ -/* ---------------------------------------------------------- -% (C)1994,1995 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) -% (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center -% (Read COPYRIGHT-JIPDEC for detailed information.) ------------------------------------------------------------ */ -#include - -#include /* fatal */ -#include -#include -#include -#include -#include -#include /* do_unify */ -#include "gobj.h" -#include "shm.h" - -#define GENHOOK 1 -#define GENHOPT 1 - -#define GG_CLASS_NAME() shvar -#define GG_OBJ_TYPE struct Shvar - -#define One_more() (do_unify(GG_SELF, GG_TERM)) - -struct Shvar { - struct generator_object_method_table *method_table; - Sinfo chain; -}; - -extern Sinfo* shm_copy_chain(); -extern Sinfo* shm_merge_chain(); - -static Inline int -cmp_forward_ptr(q x, q y) -{ - declare_globals; - int xv = get_space(x); - int yv = get_space(y); - return (xv==yv) ? (x < y) : (xv < yv); -} - -static Inline int -is_forward_space_ptr(Sinfo* gp) -{ - int ok = 0; - int cid; - while( (cid = PLNE_ptr[cid]->direct) != -1 ){ - if( (unsigned long)((long)gp-(long)(PLNE_ptr[cid]->top_addr)) < SHM_SIZE ){ - ok = 1; - break; - } - } - return ok; -} - -GGDEF_UNIFY() -{ - G_STD_DECL; - - struct generator_object *addi; - Shvar *gobjp; - q pair = derefone(GG_SELF); - if( !isref(pair) || GG_SELF != derefone(pair) ){ One_more(); GG_TERMINATE; } - addi = n_lock(GG_SELF, pair); - if( pair != derefone(GG_SELF) ){ One_more(); GG_TERMINATE; } - - gobjp = (Shvar*) untag_generator_susp(addi); - GG_SWITCH_ON_TERM(cons, atomic, func, dobj, susp); - - atomic: - { - derefone(GG_SELF) = GG_TERM; - if( gobjp->chain ){ - if( is_genhook(gobjp->chain) ){ - shm_ck_request(gobjp->chain); - }else{ - shm_resume_goals(gobjp->chain); - } - } - GG_TERMINATE; - } - - cons: - func: - dobj: - { - q y; - if( GENHOOK && !gobjp->chain && !is_shma(GG_TERM) - && (!GENHOPT || last_shm_var == GG_SELF) ){ - gobjp = create_genhook(GG_TERM, GG_SELF); - n_unlock(pair, tag_generator_susp(gobjp)); - }else{ - ck_new_galloc(GG_SELF); - y = shm_copy(GG_TERM); - klic_barrier(); - derefone(GG_SELF) = y; - if( gobjp->chain ){ - if( is_genhook(gobjp->chain) ){ - shm_ck_request(gobjp->chain); - }else{ - shm_resume_goals(gobjp->chain); - } - } - } - GG_TERMINATE; - } - - susp: - { - q x = GG_SELF; - q temp = pair; - struct generator_object* xaddi = addi; - Shvar* xobjp = gobjp; - q y = GG_TERM; - q ytemp; - struct generator_object* yaddi; - Shvar* yobjp; - - Re_try: - ytemp = derefone(y); - if( !isref(ytemp) || y != derefone(ytemp) ){ - n_unlock(temp, xaddi); - One_more(); - GG_TERMINATE; - } - yaddi = generator_suspp(ytemp)->u.o; - /* if yaddi is generator_susp */ - if( (long)yaddi & 1L ){ - struct generator_object_method_table* m; - yobjp = (Shvar*) untag_generator_susp(yaddi); - m = yobjp->method; - if( m == SHM_VAR || m == SHM_BUSY ){ - if( x == y ){ - n_unlock(temp, xaddi); - GG_TERMINATE; - } - if( cmp_forward_ptr(x,y) ){ /* reverse order */ - q w; - n_unlock(temp, xaddi); - w = x; x = y; y = w; - w = temp; temp = ytemp; ytemp = w; - xaddi = n_lock(x, temp); - if( temp != derefone(x) ){ - One_more(); - GG_TERMINATE; - } - xobjp = (Shvar*) untag_generator_susp(xaddi); - } - - if( xobjp->chain ){ - if( is_genhook(xobjp->chain) ){ /* one is a generator hook. */ - derefone(x) = y; - shm_ck_request(xobjp->chain); - }else{ /* one is a normal hook */ - yaddi = n_lock(y, ytemp); - if( derefone(y) != ytemp ){ - n_unlock(temp,xaddi); - One_more(); - GG_TERMINATE; - } - yobjp = (Shvar*) untag_generator_susp(yaddi); - if( yobjp->chain ){ - if( is_genhook(yobjp->chain) ){ /* another is a generator hook. */ - Sinfo* ychain = yobjp->chain; - ck_new_galloc(yobjp); - /* Don't forget keeping direction */ - yobjp->chain = shm_copy_chain(xobjp->chain); - n_unlock(ytemp, yaddi); - derefone(x) = y; - shm_ck_request(ychain); - }else{ /* both are ordinary hooks */ - ck_new_galloc(yobjp); - yobjp->chain = shm_merge_chain(xobjp->chain, yobjp->chain); - n_unlock(ytemp, yaddi); - derefone(x) = y; - } - }else{ - ck_new_galloc(y); - if( is_cur_or_forward_ptr(xobjp) ){ - n_unlock(ytemp, tag_generator_susp(xobjp)); - derefone(x) = y; - }else{ - yobjp = (Shvar*) galloc(sizeof(Shvar)/sizeof(q)); - yobjp->method = SHM_VAR; - yobjp->chain = shm_copy_chain(xobjp->chain); - n_unlock(ytemp, tag_generator_susp(yobjp)); - derefone(x) = y; - } - } - } - }else{ /* x has no additional info. */ - derefone(x) = y; - } - }else{ /* y is an other local generator object */ - /* assumes user defined object. Not Exref */ - if( xobjp->chain ){ /* x has any info */ - struct generator_object* gobjy = untag_generator_susp(yaddi); - q tmpy; - tmpy = generic_generate(gobjy); - switch( (long)tmpy ){ - case (long) makeref(0): - GG_KL1_UNIFY(x, y); - GG_TERMINATE; - case (long) makecons(0): - fatal("system bug!!!"); - default: - derefone(y) = tmpy; - One_more(); - GG_TERMINATE; - } - }else{ /* x is a simple variable */ - xobjp = create_genhook(tag_local(y), x); - n_unlock(temp, tag_generator_susp(xobjp)); - } - } - }else{ /* y is a consumer */ - if( xobjp && is_genhook(xobjp->chain) ){ /* global generator hook */ - Shvar* tobj = shm_add_consumer(x, 0, y, glbl); - shm_ck_request(xobjp->chain); - n_unlock(temp, tag_generator_susp(tobj)); - }else{ - Shvar* tobj = (Shvar*) shm_add_consumer(x, xobjp, y, glbl); - n_unlock(temp, tag_generator_susp(tobj)); - } - } - GG_TERMINATE; - } -} - -GGDEF_GENERATE() -{ - return makecons(0); -} - -GGDEF_SUSPEND() -{ - G_STD_DECL; - struct generator_object* addi; - Sinfo* sptr; - Sinfo* gp; - Shvar* gvar; - q temp = derefone(GG_SELF); - if( !isref(temp) ) return makecons(0); - if( GG_SELF != derefone(temp) ) return makecons(0); - addi = n_lock(GG_SELF, temp); - if( derefone(GG_SELF) != temp ) return makecons(0); - ck_new_galloc(GG_SELF); - - /* creates shared memory hook chain */ - - gvar = (Shvar*) untag_generator_susp(addi); - gp = gvar->chain; - if( gp == NULL ){ /* First hook */ - Shvar* gptr = (Shvar*) galloc( (sizeof(Shvar)+sizeof(Sinfo))/sizeof(q) ); - sptr = (Sinfo*) (gptr+1); - gptr->method = SHM_VAR; - gptr->chain = sptr; - sptr->next = NULL; - sptr->PE_num = my_node; - sptr->prio = current_prio(); - sptr->indp = create_local_tbl(GG_GOAL, GG_SELF); - n_unlock(temp, tag_generator_susp(gptr)); - return makeref(0); - } - /* already any hooks */ - else if( is_genhook(gp) ){ /* shared generator hook */ - int pe_num; - long prio; - TADDRtbl* ind; - sptr = (Sinfo*) untag_generator_susp(gp); - pe_num = sptr->PE_num; - prio = sptr->prio; - ind = sptr->indp; - if( pe_num == my_node ){ - q temp; - q* tp = ind->globalA; - if( !isatomic(ind->localA) ){ - free_local_tbl(ind); - shm_arg_copy(&ind->localA, &temp); - klic_barrier(); - *tp = temp; - return makecons(0); - } - } - /* reuses Sinfo */ - gvar->method = SHM_VAR; - gvar->chain = sptr; - sptr->PE_num = my_node; - sptr->prio = current_prio(); - sptr->indp = create_local_tbl(GG_GOAL, GG_SELF); - shm_request_queueing(pe_num, prio, ind); - n_unlock(temp, addi); - return makeref(0); - }else{ /* ordinary hook */ - Sinfo* bgp = (Sinfo*) &(gvar->chain); - ck_new_galloc(gvar); - while( gp != NULL && !is_forward_space_ptr(gp) ){ - if( gp->PE_num == my_node ){ - if( (struct goalrec*)(gp->indp->localA) == GG_GOAL ){ - n_unlock(temp, addi); - return makeref(0); - }else{ - break; - } - } - bgp = gp; - gp = gp->next; - } - sptr = (Sinfo*) galloc(sizeof(Sinfo)/sizeof(q)); - bgp->next = sptr; - sptr->next = gp; - sptr->PE_num = my_node; - sptr->prio = current_prio(); - sptr->indp = create_local_tbl(GG_GOAL, GG_SELF); - n_unlock(temp, addi); - return makeref(0); - } -} - -GGDEF_PRINT() -{ - fprintf(g_fp, "", GG_SELF); - return 0; -} - -GGDEF_GC() -{ - fatal("bug!!!"); -} - -#define GGUSE_MY_UNIFY -#define GGUSE_MY_SUSPEND -#define GGUSE_MY_GENERATE -#define GGUSE_MY_GC -#define GGUSE_MY_PRINT - -#include - -GGDEF_NEW() -{ -} diff -ruN klic-3.003-2002-03-16/runtime/gmvv.c klic-3.003-2002-03-19/runtime/gmvv.c --- klic-3.003-2002-03-16/runtime/gmvv.c Tue Mar 12 12:52:47 2002 +++ klic-3.003-2002-03-19/runtime/gmvv.c Tue Mar 19 14:08:36 2002 @@ -16,9 +16,6 @@ #ifdef DIST #include "interpe.h" #endif -#ifdef SHM -#include "shm.h" -#endif #include "atom.h" #include "funct.h" @@ -192,35 +189,6 @@ } #endif /* DIST */ - -#ifdef SHM -GDDEF_SHMCOPY() -{ - G_STD_DECL; - GD_OBJ_TYPE *newself; - - newself = (GD_OBJ_TYPE *)galloc((sizeof(struct vector_object))); - Shallow(GD_SELF); - { - /* Shallow version */ - q *body = GD_SELF->body; - long size = GD_SELF->index; - q *newbody; - long k; - newbody = (q*)galloc(size); - newself->method_table = GD_SELF->method_table; - newself->next = VECTOR_SHALLOW_MARK; - newself->index = size; - newself->iscnst = 1; - newself->body = newbody; - for (k=0; kgenerate(obj)) -/*** for Shared-memory KLIC system ***/ -#define generic_shmcopy(obj) \ - (method_table_of(obj)->shmcopy(obj)) - #endif /* _KLIC_GOBJ_H_ */ diff -ruN klic-3.003-2002-03-16/runtime/gstring.c klic-3.003-2002-03-19/runtime/gstring.c --- klic-3.003-2002-03-16/runtime/gstring.c Tue Mar 12 12:53:57 2002 +++ klic-3.003-2002-03-19/runtime/gstring.c Tue Mar 19 14:08:55 2002 @@ -12,10 +12,6 @@ #include "atom.h" #include "funct.h" -#ifdef SHM -#include "shm.h" -#endif - #ifdef DIST #include "interpe.h" #endif @@ -175,33 +171,6 @@ } #endif /* DIST */ -#ifdef SHM -GDDEF_SHMCOPY() -{ - G_STD_DECL; - GD_OBJ_TYPE *newself; - - newself = (GD_OBJ_TYPE *)galloc((sizeof(struct byte_string_object))); - Shallow(GD_SELF); - newself->method_table = GD_SELF->method_table; - - newself->iscnst = 1; - { - unsigned char *body = GD_SELF->body; - unsigned char *newbody; - long size = GD_SELF->index; - long qsize = ROUND_UP(size); - - newbody = (unsigned char *)galloc(qsize); - newself->next = STRING_SHALLOW_MARK; - newself->index = size; - newself->body = newbody; - BCOPY(body,newbody,qsize*sizeof(q)); - } - return(makefunctor(newself)); -} -#endif /* SHM */ - /* Generic method */ GDDEF_METHOD(string_2) @@ -580,9 +549,6 @@ #define GDUSE_MY_GC #ifdef DIST #define GDUSE_MY_ENCODE -#endif -#ifdef SHM -#define GDUSE_MY_SHMCOPY #endif #define GDUSE_MY_GENERIC #define GDUSE_MY_GGENERIC diff -ruN klic-3.003-2002-03-16/runtime/gunix.kl1 klic-3.003-2002-03-19/runtime/gunix.kl1 --- klic-3.003-2002-03-16/runtime/gunix.kl1 Sat Mar 9 16:41:10 2002 +++ klic-3.003-2002-03-19/runtime/gunix.kl1 Tue Mar 19 13:58:20 2002 @@ -67,9 +67,6 @@ #ifdef DIST kill_child(); #endif -#ifdef SHM - abend(\"\"); -#endif exit(N); } diff -ruN klic-3.003-2002-03-16/runtime/intrpt.c klic-3.003-2002-03-19/runtime/intrpt.c --- klic-3.003-2002-03-16/runtime/intrpt.c Tue Mar 12 13:34:07 2002 +++ klic-3.003-2002-03-19/runtime/intrpt.c Tue Mar 19 14:04:56 2002 @@ -23,10 +23,6 @@ #define GC_OFF() #endif /* not DIST */ -#ifdef SHM -#include "shm.h" -#endif - extern struct goalrec* klic_gc(); extern int stepping_flag; @@ -112,18 +108,6 @@ fatal("Execution aborted by SIGINT"); } -#ifdef SHM - while( (volatile int) ext_queued ){ - *cur_status = 1; - ext_queued = 0; - klic_barrier(); - qp = get_invoked_goals(qp); - interrupt_off = -1; - heaplimit = real_heaplimit(); - retry |= (heapp() + this_more_space() >= heaplimit); - } -#endif - /* priority support */ if( higher_priority_goal0 ){ higher_priority_goal0 = 0; @@ -132,20 +116,10 @@ if( interrupt_off ) heaplimit = real_heaplimit(); } -#ifdef SHM - if( ck_shm_gc() || heapp() + this_more_space() >= real_heaplimit() ){ - *cur_status = 3; - /* ck_shm_gc will call another GC */ -#else if( heapp() + this_more_space() >= real_heaplimit() ){ -#endif GC_ON(); qp = klic_gc(qp); -#ifdef SHM - *cur_status = 1; -#endif GC_OFF(); - allocp = heapp(); } }while( retry ); diff -ruN klic-3.003-2002-03-16/runtime/kmain.c klic-3.003-2002-03-19/runtime/kmain.c --- klic-3.003-2002-03-16/runtime/kmain.c Tue Mar 12 13:34:55 2002 +++ klic-3.003-2002-03-19/runtime/kmain.c Tue Mar 19 13:59:28 2002 @@ -28,10 +28,6 @@ #include #endif -#ifdef SHM -#include "shm.h" -#endif - #ifdef DIST #include #include @@ -113,13 +109,6 @@ "B", (union all_type*) &shared_buffer_size, ARG_SIZE, "-B ", #endif -#ifdef SHM - "S", (union all_type*) &SHM_SIZE, ARG_SIZE, - "-S : shared-memory heap size, never expand", - - "D", (union all_type*) &Disp_child, ARG_SET, - "-D: display child process number on UNIX", -#endif "a", (union all_type*) &max_a_ratio, ARG_DOUBLE, "-a : active cell ratio to triger heap extension\n" \ "\t should be a floating point number >0 and <1", @@ -207,11 +196,6 @@ void init_virtualized_timer(); void init_klic_timer_handling(); #endif -#ifdef SHM - struct timeval time_before; - struct timezone tzp; - gettimeofday(&time_before, NULL); -#endif /*SHM*/ program_name = argv[0]; total_node = num_pes = 1; my_node = 0; @@ -294,13 +278,6 @@ maxheapsize0 = heapsize0; initalloc(); -#ifdef SHM - My_glbl = glbl = shm_init(glbl); -#if 0 /* for Debugging */ - getchar() -#endif -#endif - { extern struct goalrec *get_top_priority_queue(); struct goalrec *qp; @@ -362,9 +339,6 @@ #ifdef DIST if (IS_MASTER_NODE(my_node)) #endif -#ifdef SHM - if ( my_node == MASTER ) -#endif enqueue_goal(NULL, HIGHESTPRIO-1, qp, glbl); current_queue = get_top_priority_queue(); @@ -402,21 +376,6 @@ #endif /*DIST*/ } } -#ifdef SHM - if ( my_node == MASTER ) { - wait(0); - { - struct timeval time_after; - struct timezone tzp; - if (!gettimeofday(&time_after, NULL)) { - fprintf(stderr, - "Response time is %d msec\n", - (time_after.tv_sec - time_before.tv_sec)*1000 + - (time_after.tv_usec - time_before.tv_usec)/1000); - } - } - } -#endif /*SHM*/ return 0; } diff -ruN klic-3.003-2002-03-16/runtime/newatom.c klic-3.003-2002-03-19/runtime/newatom.c --- klic-3.003-2002-03-16/runtime/newatom.c Fri Feb 8 15:40:09 2002 +++ klic-3.003-2002-03-19/runtime/newatom.c Tue Mar 19 14:02:07 2002 @@ -14,10 +14,6 @@ #include /* functors, arities */ #include -#ifdef SHM -#include "shm.h" -#endif - #define Hashsize 1024 #define Namesize 1024 @@ -55,43 +51,9 @@ static long* nextatom; static long* nextfunctor; - -#ifndef SHM static unsigned char* namearea; static unsigned char* nameareap; -#else /* SHM */ -struct atomnamebuff { - unsigned char* namea0; - unsigned char* namep0; -}; - -struct atomnamebuff* shm_namep; - -#define namearea (shm_namep->namea0) -#define nameareap (shm_namep->namep0) - -#define malloc_check(sz) \ -( (Buff_S += (sz)) > Buff_E ? \ - (char*) abend("Atom Table overflow!") : (char*) (Buff_S - (sz)) ) - -extern void -init_shm_atom() -{ - struct atomhashtable* tmpahp; - struct functorhashtable* tmpfhp; - static char* Buff_S = shm_start_addr; - static char* Buff_E = Buff_S + ATOM_TABLE_SIZE; - shm_namep = (struct atomnamebuff*) malloc_check(sizeof(struct atomnamebuff)); - tmpahp = (struct atomhashtable*) malloc_check(sizeof(struct atomhashtable)); - *tmpahp = *atomhp; - atomhp = tmpahp; - tmpfhp = (struct functorhashtable*) malloc_check(sizeof(struct functorhashtable)); - *tmpfhp = *functhp; - functhp = tmpfhp; -} -#endif /* SHM */ - static long hash_name(name) @@ -234,10 +196,6 @@ if( strcmp((char*) name, ".")==0 ) return 1L; hashvalue = ((unsigned long) hash_name(name)) % atomhp->hashtablesize; -#ifdef SHM - s_lock(a_key()); -#endif - again: index = atomhp->table[hashvalue] - 1; if( index >= 0 ){ @@ -256,17 +214,11 @@ nameareap += namelen; *nameareap++ = '\0'; nextatom[atomhp->atomid] = -1; -#ifdef SHM - s_unlock(a_key()); -#endif return atomhp->atomid; }else{ index = index0; } } -#ifdef SHM - s_unlock(a_key()); -#endif return index; }else{ if( atomhp->atomid +1 == atomhp->nametablesize ){ @@ -282,9 +234,6 @@ nameareap += strlen((char*) name) + 1; nextatom[atomhp->atomid] = -1; } -#ifdef SHM - s_unlock(a_key()); -#endif return atomhp->atomid; } @@ -294,9 +243,6 @@ unsigned char** newatomnames; long* newnextatom; int i; -#ifdef SHM - if( is_shma(atomnames) ) abend("Can't expand on this version."); -#endif newatomnames = (unsigned char**) malloc_check((atomhp->nametablesize) * sizeof(char*)*2); newnextatom = (long*) @@ -338,10 +284,6 @@ hashvalue = ((long)(a_no + arity)) % functhp->hashtablesize; -#ifdef SHM - s_lock(f_key()); -#endif - again: index = functhp->table[hashvalue] - 1; if( index >= 0 ){ @@ -354,18 +296,11 @@ functorids[functhp->functorid] = a_no; aritiesof[functhp->functorid] = arity; nextfunctor[functhp->functorid] = -1; -#ifdef SHM - s_unlock(f_key()); -#endif return functhp->functorid; }else{ index = index0; } } - -#ifdef SHM - s_unlock(f_key()); -#endif return index; }else{ if( functhp->functorid +1 == functhp->functortablesize ){ @@ -377,10 +312,6 @@ aritiesof[functhp->functorid] = arity; nextfunctor[functhp->functorid] = -1; } - -#ifdef SHM - s_unlock(f_key()); -#endif return functhp->functorid; } @@ -389,9 +320,6 @@ unsigned long* newaritiesof; unsigned long* newnextfunctor; int i; -#ifdef SHM - if( is_shma(functorids) ) abend("Can't expand on this version."); -#endif newfunctorids = (unsigned long*) malloc_check((functhp->functortablesize) * sizeof(unsigned long)*2); newaritiesof = (unsigned long*) diff -ruN klic-3.003-2002-03-16/runtime/sched.c klic-3.003-2002-03-19/runtime/sched.c --- klic-3.003-2002-03-16/runtime/sched.c Tue Mar 12 12:08:47 2002 +++ klic-3.003-2002-03-19/runtime/sched.c Tue Mar 19 14:32:15 2002 @@ -18,22 +18,6 @@ #include "trace.h" /* enqueue_trace_rec, trace_enqueued_goals, trace_flag */ -#ifdef SHM -#include -#include "shm.h" - -extern jmp_buf klic_topmost; - -static module mastersucceed(struct global_variables* glbl, struct goalrec* qp, - q* allocp, const struct predicate* toppred ); - -static module childsucceed(struct global_variables* glbl, struct goalrec* qp, - q* allocp, const struct predicate* toppred ); - -static const struct predicate mastersucceed_pred = { mastersucceed, 0, 0 }; -static const struct predicate childsucceed_pred = { childsucceed, 0, 0 }; -#endif /* SHM */ - #define new_prioqrec(pqr) \ do{ \ struct prioqrec* temp; \ @@ -56,12 +40,6 @@ #ifdef DIST extern struct goalrec* send_throw_goal(); #endif -#ifdef SHM -extern struct goalrec* throw_goal_routine(); -#endif - -/* temp */ -extern struct ex_goalrec** shm_qp; extern module wait_prio_routine(struct global_variables* glbl, @@ -122,15 +100,7 @@ pq->prio = 0; allocp = klic_alloc(2); allocp[0] = (q) &goal_queue_tail; -#ifdef SHM - if( my_node == MASTER ){ - allocp[1] = (q) &mastersucceed_pred; - }else{ - allocp[1] = (q) &childsucceed_pred; - } -#else allocp[1] = (q) &topsucceed_pred; -#endif pq->q = (struct goalrec*) allocp; prioq0.next = pq; @@ -294,11 +264,7 @@ #ifdef DIST return send_throw_goal(intval(penum), gp, qp); #else -# ifdef SHM - return throw_goal_routine(intval(penum), qp, gp); -# else return enqueue_goal(qp, current_prio(), gp, glbl); -# endif #endif }else return enqueue_goal(qp, current_prio(), gp, glbl); } @@ -383,35 +349,6 @@ } } -#ifdef SHM -static void -put_priority_goal(qp, prio) - struct goalrec* qp; - long prio; -{ - declare_globals; - struct prioqrec* pq = &prioq0; - - while( pq->next->prio > prio ){ - pq = pq->next; - } - if( pq->next->prio == prio ){ - /* there are some active goals with the same priority */ - pq = pq->next; - qp->next = pq->q; - pq->q = qp; - }else{ - /* there are no goals with the same priority */ - struct prioqrec* newpq; - new_prioqrec(newpq); - newpq->next = pq->next; - pq->next = newpq; - newpq->prio = prio; - newpq->q = qp; - qp->next = &goal_queue_tail; - } -} -#endif /* queue_empty: @@ -430,166 +367,7 @@ const struct predicate* toppred; { set_heapp(allocp); -#ifdef SHM - if( ext_queued ){ - ext_queued = 0; - qp = get_invoked_goals(&goal_queue_tail); - current_queue = qp; - return (module) qp->pred->func; - } -#endif qp = get_top_priority_queue(); current_queue = qp; return (module) qp->pred->func; } - -#ifdef SHM -extern struct goalrec* -get_invoked_goals(qp) - struct goalrec* qp; -{ - declare_globals; - int key = p_key(my_node); - - struct ex_goalrec *sqp, *eqp; - - s_lock(key); - sqp = ex_qp->next; - if( sqp == NULL ){ s_unlock(key); return qp; } - eqp = sqp; - while( eqp->next != NULL ){ eqp = eqp->next; } - ex_qp = eqp; - s_unlock(key); - - put_priority_queue(qp, current_prio()); - eqp = sqp; - for(;;){ - put_priority_goal(&eqp->goal, eqp->prio); - if( eqp == ex_qp ) break; - eqp = eqp->next; - } - - return get_top_priority_queue(); -} - - -static module -mastersucceed(glbl, qp, allocp, toppred) - struct global_variables* glbl; - struct goalrec* qp; - q* allocp; - const struct predicate* toppred; -{ - int first, i; - set_heapp(allocp); - - /* printf("Wait master.\n"); */ - - WLoop: - if( !(ex_qp->next) ){ - klic_interrupt(qp); - if( current_queue != qp ){ - *cur_status = 1; - qp = current_queue; - toppred = qp->pred; - return (module) toppred->func; - } - - { - struct global_variables* tglbl; - for( i=1; ipar.aux.shm.ex_qp0 ) goto WLoop; - if( pe_status[i] ) goto WLoop; - } - if( ex_qp->next ) goto WLoop; - for( i=0; ipar.aux.shm.ex_qp0 ) && - !pe_status[i] ) continue; - for( i=0; ipar.aux.shm.ex_qp0 ) && - !pe_status[i] ) continue; - for( i=0; i=0; i-- ){ /* One more */ - tglbl = get_otherPE_glbl(i); - if( ( top_shm_qp[i] == tglbl->par.aux.shm.ex_qp0 ) && - !pe_status[i] ) continue; - for( i=0; iprio = HIGHESTPRIO-1; - qp = &eqp->goal; - qp->next = 0; - qp->pred = &topsucceed_pred; - shm_goal_stack(eqp, i); - } - longjmp(klic_topmost, 0); - } - } - qp = get_invoked_goals(qp); - { - module func; - toppred = qp->pred; - func = (module) toppred->func; - current_queue = qp; - return func; - } -} - - -static module -childsucceed(glbl, qp, allocp, toppred) - struct global_variables* glbl; - struct goalrec* qp; - q* allocp; - const struct predicate* toppred; -{ - set_heapp(allocp); - while( !(ex_qp->next) ){ - klic_interrupt(qp); - if( current_queue != qp ){ - *cur_status = 1; - qp = current_queue; - toppred = qp->pred; - return (module) toppred->func; - } - *cur_status = 0; - } - - *cur_status = 1; - klic_barrier(); - - qp = get_invoked_goals(qp); - /* dump_queue(qp); */ - - { - module func; - toppred = qp->pred; - func = (module) toppred->func; - current_queue = qp; - return func; - } -} -#endif /* SHM */ diff -ruN klic-3.003-2002-03-16/runtime/shm.h klic-3.003-2002-03-19/runtime/shm.h --- klic-3.003-2002-03-16/runtime/shm.h Tue Mar 12 12:08:47 2002 +++ klic-3.003-2002-03-19/runtime/shm.h Thu Jan 1 09:00:00 1970 @@ -1,233 +0,0 @@ -/* ---------------------------------------------------------- -% (C)1994,1995 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) -% (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center -% (Read COPYRIGHT-JIPDEC for detailed information.) ------------------------------------------------------------ */ - -#ifndef _KLIC_SHM_H_ -#define _KLIC_SHM_H_ - -/* Machine depending Dec */ -#include "shm_machine.h" - -#define currid (glbl->par.aux.shm.currid0) -#define oldid (glbl->par.aux.shm.oldid0) - -#define SHM_HEAP_TOP (glbl->par.aux.shm.shm_htop0) -#define SHP_SIZE (glbl->par.aux.shm.shm_hbyte0) - - /* number of Planes */ -extern long N_PLNE; - /* size of 1 Shared-memory plane */ -extern long SHM_SIZE; -extern long Disp_child; - -Extern int shm_trace_lock Init(0); - -#define MASTER 0 - -#define MAX_N_PE 32 - - /* Shared-memory address or no */ -#define is_shma(X) \ - ( (unsigned long)((long)(X)-(long)SHM_HEAP_TOP ) < SHP_SIZE ) - -/* calculates a hash key for lock */ -#define HTBL_base 0 -#define g_key() HTBL_base /* allocating shared-memory */ -#define m_key() (HTBL_base+1) /* updating the shared-memory management table */ -#define gc_key() (HTBL_base+2) /* for Sequential GC */ -#define a_key() (HTBL_base+3) /* updating atom table */ -#define f_key() (HTBL_base+4) /* updating functor table */ -#define tr_key() (HTBL_base+5) -#define p_key(penum) (HTBL_base+6 + (penum)) /* queuing a goal to external process */ - - /* global generator hook */ -#define is_genhook(X) ((long)(X) & 0x01) -#define tag_genhook(X) ((Sinfo*)((long)(X)+1)) -#define untag_genhook(X) ((Sinfo*)((long)(X)-1)) - /* local consumer or generator */ -#define tag_local(x) ((q)((char*)(x) + ATOMIC)) -#define untag_local(x) ((q)((char*)(x) - ATOMIC)) -#define ext_queued (glbl->par.aux.shm.queued0) -#define ex_qp (glbl->par.aux.shm.ex_qp0) - - /* adjusts the memory boundary */ -#define reckon(sz) ((long)((((sz)+sizeof(long)-1)/sizeof(long))*sizeof(long))) -#define get_adjust_addr(type,top,inc) \ - (((type)*) (((char*) (top)) + (reckon(sizeof(type)) * (inc)))) -#define get_otherPE_glbl(n) \ - get_adjust_addr(struct global_variables, top_shm_glbl, (n)) - - /* shared memory alloc */ -#define galloc(Siz) ( { q* addr = gallocp; \ - ((gallocp+=(Siz)) <= glimit)?addr:shm_galloc(Siz);}) - - -#define free_local_tbl(ptr) \ -do{ \ - TADDRtbl* sl = (TADDRtbl*) (ptr); \ - (sl->prev)->next = sl->next; \ - (sl->next)->prev = sl->prev; \ - sl->next = ADDRtbl_free; \ - ADDRtbl_free = sl; \ -}while(0) - - -#define get_space(X) ( {\ - int cid = currid;\ - int cnt = 1;\ - int no = 0;\ - do { \ - if ( (unsigned long)((long)(X)-(long)(PLNE_ptr[cid]->top_addr)) < SHM_SIZE ) \ - { no = cnt; break; } \ - cnt++; \ - } while( (cid = PLNE_ptr[cid]->direct) != (-1) ); \ - no; } ) - -#define ck_new_galloc(X) \ -do{ \ - int cid = currid;\ - while ( (cid = PLNE_ptr[cid]->direct) != (-1) ) { \ - if ( (unsigned long)((long)(X)-(long)(PLNE_ptr[cid]->top_addr) ) < SHM_SIZE ) { new_galloc(cid); break; }\ - }\ -}while(0) - - -#define is_cur_or_forward_ptr(X) ( {\ - int ok = 0;\ - int cid = currid;\ - do {\ - if ( (unsigned long)((long)(X)-(long)(PLNE_ptr[cid]->top_addr) ) < SHM_SIZE ) {\ - ok = 1; break;\ - }\ - } while ( (cid = PLNE_ptr[cid]->direct) != (-1) ) ;\ - ok; } ) - - - /* Structures */ -typedef struct addr_tbl { - struct addr_tbl* next; - struct addr_tbl* prev; - q* localA; - q* globalA; -} TADDRtbl; - -struct ex_goalrec { - struct ex_goalrec* next; - long prio; - struct goalrec goal; -} ; - -typedef struct PE_shook { - struct PE_shook* next; - long PE_num; - long prio; - TADDRtbl* indp; -} Sinfo; - -typedef struct shvar { - struct generator_object_method_table* method; - Sinfo* chain; -} Shvar; - -/* Management table of a shared memory plain */ -typedef struct { - long* top_addr; - long* caddr; - long direct; - long demand; - long proc[MAX_N_PE]; - long* limit1; - long* limit2; - long* limit3; -} PLNE; - -/* External declarations */ - -/* lock table address */ -extern int* lockp[]; - -/* common variables */ -extern int F_shm_gc; - -extern volatile PLNE* PLNE_ptr[]; - -extern int* volatile pe_status; -extern int* volatile cur_status; - -extern struct global_variables* top_shm_glbl; - -extern struct ex_goalrec** volatile top_shm_qp; - -/* runtime/shm_rsv.c */ -extern char* shm_start_addr; -extern int ATOM_TABLE_SIZE; - -/* memorized the last generated variable on shm */ -extern q last_shm_var; - -extern struct generator_object* qSHM_BUSY; -extern struct generator_object* pSHM_VAR; -extern struct generator_object_method_table* SHM_BUSY; -extern struct generator_object_method_table* SHM_VAR; - -/* current shared memory top address, limit of myself */ -extern q* gallocp; -extern q* glimit; - -extern TADDRtbl ADDRtbl; -extern TADDRtbl* ADDRtbl_free; - - -/* Declarations of functions */ - -/* runtime/shm_rsv.c */ - -/* common routines */ -extern struct global_variables* shm_init(struct global_variables* glbl); - -/* allocate shared memory routines */ -extern q* shm_galloc(int siz); - - -/* runtime/shm_throw.c */ - -/* copy argument into shared memory */ -extern q shm_copy(q src); - -/* stack a goal */ -extern int shm_goal_stack(struct ex_goalrec* goal, int num); - - -/* runtime/shm_obj.c */ - -extern Shvar* create_genhook(q* la, q* ga); - -extern Shvar* shm_add_consumer( - q shv, Shvar* shobj, q cvar, struct global_variables* glbl ); - -extern void shm_ck_request(Sinfo* chain); -extern void shm_resume_goals(Sinfo* hook); - -extern TADDRtbl* create_local_tbl(q* lcl, q* gbl); - - -/* runtime/newatom.c */ -extern void init_shm_atom(void); - -/* runtime/sched.c */ -extern struct goalrec* get_invoked_goals(struct goalrec* qp); - -/* runtime/shm_gc.c GC routines */ -extern int ck_shm_gc(void); -extern struct goalrec* shm_gc(struct goalrec* qp); - -/* for GC */ -extern q** shm_gcstack; -extern q** shm_gcmax; -extern q** shm_sp; -extern int shm_gcstack_size; - -#endif /* _KLIC_SHM_H_ */ diff -ruN klic-3.003-2002-03-16/runtime/shm_gc.c klic-3.003-2002-03-19/runtime/shm_gc.c --- klic-3.003-2002-03-16/runtime/shm_gc.c Mon Feb 25 13:28:20 2002 +++ klic-3.003-2002-03-19/runtime/shm_gc.c Thu Jan 1 09:00:00 1970 @@ -1,912 +0,0 @@ -/* ---------------------------------------------------------- -% (C)1994,1995 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) -% (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center -% (Read COPYRIGHT-JIPDEC for detailed information.) ------------------------------------------------------------ */ - -#include -#include /* fatalf */ -#include -#include "timing.h" -#include -#include /* arityof */ -#include "gobj.h" -#include -#include "shm.h" -#include - -extern q** make_shm_larger_stack(); - -/* ------- Optinal Flags --------------------------------- */ -/* FLAGS */ -/* IAFWD ... Implicit All Forwarding */ -/* ISFWD ... Implicit Single Forwarding */ -/* */ -/* PAR_GC ... Parallel GC (Parallel Copy) */ -/* SEQ_GC ... Sequential GC (Sequential Copy) */ -/* */ -/* ASYNC_GC... Asynchronous GC (On-the-fly GC) */ -/* SYNC_GC ... Synchronous GC (Stop-and-GC) */ - -/* -#define TOPDOWN -/**/ -#define BOTTOMUP -/**/ - -/* -#define ASYNC_GC /* Asynchronous GC */ -/**/ -#define SYNC_GC /* Synchronous GC */ -/**/ - -/* -#define PAR_GC /* Parallel GC */ -/**/ -#define SEQ_GC /* Sequential GC */ -/**/ - -/* -#define IAFWD /* Implicit All Forwarding */ -/**/ -#define ISFWD /* Implicit Single Forwarding */ -/**/ - -/* atomic swap(ptr,io) */ -/* *ptr <-> io */ -#define atomic_swap(ptr,io) ( {\ - register long v asm ("g2") = (long) io; \ - register long* s1 asm ("g3") = (long*) ptr; \ - asm volatile (" \ - swap [%%g3],%%g2; \ -" : "=g" (v) : "g" (v), "g" (s1) ); \ - io = (q) v; \ - } ) - -/* -/* BARRIERS */ -/* a_barrier ... to make sure mutators may not see uninitialized cells.*/ -/* Inserted between element initialization and assignment of */ -/* new structure to scavenging target cell. */ -/* (necessary only in Asynchronous GC) */ -/* p_barrier ... to make sure other collectors may not copy */ -/* nested objects in parallel with the current collector. */ -/* Inserted between forwarding and scavenging of nested objects. */ -/* This may help but does not ensure avoiding duplicate copying... */ -/* (necessary only in Asynchronous Parallel GC) */ -/* (In Synchronous Parallel GC, duplicate copying is avoided by */ -/* copy locking.) */ -/* */ -#ifdef ASYNC_GC -#define a_barrier() klic_barrier() -#else -#define a_barrier() -#endif - -#if defined(PAR_GC) && defined(ASYNC_GC) -#define p_barrier() klic_barrier() -#else -#define p_barrier() -#endif - -/* For debugging */ -#define ASSERT(cond,mess) /* \ - if( !(cond) ) \ - fatalf( "** ASSERT ERROR: %s. **\n", mess ); */ - -#define push_shm_stack(addr,sp,max) \ -{ \ - if ( (sp) == max ) { \ - (sp) = make_shm_larger_stack(sp); \ - max = shm_gcmax; \ - } \ - *(sp)++ = (q*)(addr); \ -} - -#define pop_gc_command() (q)(*--sp) -#define push_gc_command(x) push_shm_stack(x,sp,max) - -#define push_VALUE(val) push_gc_command(val) - -#define push_UPDATE(addr) push_gc_command(makeatomic(addr)) - -/* == GC STACK COMMANDS == */ -/* */ -/* SCAVENGE(x) (identified by VARREF tag) */ -/* q *x ... pointer to (q) in new local or new shared heap */ -/* action: copy *x to new shared heap and update *x */ -/* */ -#define push_SCAVENGE(addr) push_gc_command(makeref(addr)) - -#define within_new_space(X) (\ - (unsigned long)((long)(X) - (long)(PLNE_ptr[currid]->top_addr) ) < SHM_SIZE ) - -/* Global varibles */ -int F_shm_gc; -q** shm_gcstack; -q** shm_gcmax; -q** shm_sp; -int shm_gcstack_size; - -extern struct ex_goalrec** top_shm_next; -extern struct ex_goalrec** shm_qp; -extern struct goalrec goal_queue_tail; - -static int shm_gc_times = 0; -static int measure_shmgc = 1; - -static void shm_copy_terms(q** sp, q** max); -static void enter_shm_gc(void); -static void exit_shm_gc(void); - -/* checks shared-memory GC. called by "intrpt" routine */ -extern int -ck_shm_gc() -{ - declare_globals; - if( oldid != currid ){ - F_shm_gc = 1; - return 1; - }else if( PLNE_ptr[currid]->caddr > PLNE_ptr[currid]->limit1 ){ - F_shm_gc = 1; - return 1; - }else{ - return 0; - } -} - - - -#define chase_queue(qp, sp, max) (\ - {\ - struct goalrec top; \ - struct goalrec* before = ⊤ \ - top.next = qp; \ - for (; qp!=&goal_queue_tail; before=qp,qp=qp->next) { \ - if ( is_shma(qp) && !within_new_space(qp) ) { \ - int i,arity=qp->pred->arity; \ - struct goalrec* newg = (struct goalrec*)galloc(arity+2); \ - newg->next = qp->next; \ - newg->pred = qp->pred; \ - for(i=0;iargs[i] = qp->args[i] ) ) { \ - push_SCAVENGE(&(newg->args[i])); \ - } \ - } \ - before->next = qp = newg; \ - } \ - }; \ - top.next;} ) - -#define chase_ex_queue(exqp,sp,max) { \ - struct ex_goalrec* eqp; \ - struct ex_goalrec* before = \ - (struct ex_goalrec*)(top_shm_next+my_node); \ - before->next = exqp->next; \ - exqp = before; \ - eqp = before->next; \ - for(; eqp; before=eqp,eqp=eqp->next) { \ - if ( !within_new_space(eqp) ) { \ - int i,arity=eqp->goal.pred->arity; \ - struct ex_goalrec* newg = (struct ex_goalrec*)galloc(arity+4); \ - \ - newg->next = eqp->next; \ - newg->prio = eqp->prio; \ - newg->goal.pred = eqp->goal.pred; \ - for(i=0;igoal.args[i] = eqp->goal.args[i] ) ) {\ - push_SCAVENGE(&(newg->goal.args[i])); \ - } \ - } \ - before->next = eqp = newg; \ - } \ - } \ - *shm_qp = before; \ -} - -extern struct goalrec* -shm_gc(qp) - struct goalrec* qp; -{ - declare_globals; - struct prioqrec* pq = prioq().next; - - struct timeval before, after; - int i, j; - q** sp = shm_sp; - q** max = shm_gcmax; - int qkey; - int key = gc_key(); - *cur_status = 4; - - /* printf("The %dth process Shared memory GC start!!\n",my_node); */ - shm_gc_times++; - -#ifdef TOPDOWN - if( measure_shmgc ){ gettimeofday(&before); } -#endif - - enter_shm_gc(); - /* chases my external pool */ - qkey = p_key(my_node); - s_lock(qkey); - chase_ex_queue(ex_qp, sp, max); - s_unlock(qkey); - - /* chase qp */ - for( ; pq->prio >= 0; pq = pq->next ){ - pq->q = chase_queue(pq->q, sp, max); - } - qp = chase_queue(qp, sp, max); - - shm_copy_terms(sp, max); - - exit_shm_gc(); - -#ifdef TOPDOWN - if( measure_shmgc ){ - gettimeofday(&after); - gcums += (after.tv_sec - before.tv_sec)*1000000+(after.tv_usec-before.tv_usec); - } -#endif - - *cur_status = 3; - return qp; -} - -#ifdef TOPDOWN -/*----------------------------------------------------------------------*/ -/* TOP DOWN TERM COPY 1994/09/20 N.Ichiyoshi */ -/*----------------------------------------------------------------------*/ - -/* == FORWARDING SCHEMES == */ -/* */ -/* -- Before Copying and Forwarding -- */ -/* */ -/* (in old space) */ -/* */ -/* +-------+ */ -/* | FH | (functor header) */ -/* +-------+ */ -/* | X0 | (0-th argument) */ -/* +-------+ */ -/* | X1 | (1-st argument) */ -/* +-------+ */ -/* ... */ -/* +-------+ */ -/* | Xn | (n-th argument, n = arify) */ -/* +-------+ -/* */ -/* -- After Surface-Level Copying and Forwarding -- */ -/* */ -/* *** Implicit All Forwarding (IAFWD) *** */ -/* */ -/* (in old space) (in new space) */ -/* */ -/* +-------+ +-------+ */ -/* | FH | | FH | */ -/* +-------+ +-------+ */ -/* | REF +---------------> | X0 | */ -/* +-------+ +-------+ */ -/* | REF +---------------> | X1 | */ -/* +-------+ +-------+ */ -/* ... ... */ -/* +-------+ +-------+ */ -/* | REF +---------------> | Xn | */ -/* +-------+ +-------+ */ -/* */ -/* *** Implicit Single Forwarding (ISFWD) *** */ -/* */ -/* (in old space) (in new space) */ -/* */ -/* +-------+ +-------+ */ -/* | FH | | FH | */ -/* +-------+ +-------+ */ -/* | REF +---------------> | X0 | */ -/* +-------+ +-------+ */ -/* | PX1 | | X1 | */ -/* +-------+ +-------+ */ -/* ... ... */ -/* +-------+ +-------+ */ -/* | PXn | | Xn | */ -/* +-------+ +-------+ */ -/* */ -/* PXi = Xi, if Xi is atomic, */ -/* REF to new i-th element, if Xi is not atomic */ -/* */ -/* FORWARDING POINTER CELLS -/* - For CONS record, cdr contains forwarding pointer. */ -/* - For normal FUNCTOR record, args[0] contains forwarding pointer. */ -/* */ -/* ASSUMPTIONS */ -/* (1) The mutator process must not overwrite active cells in */ -/* shared heap other than unbound shared variables. */ -/* (In particular, it is assumed that there is no destructive */ -/* update of structure elements.) */ -/* (2) Under ISF, the mutator must not put REF pointer to new space */ -/* in a forwarding pointer cell. */ -/* (3) There is no functor with arity = 0. */ -/* */ - -/* == OFFSET VALUES (in number of q cells) == */ -/* */ -/* CDROFFSET ... offset of CDR from top of CONS record (=0) */ -/* FIRSTELTOFFSET ... offset of arg[0] from top of FUNCTOR record (=1)*/ -/* CARCDROFFSET ... offset of CAR from CDR (=1) */ -/* */ -/* N.B. In gcc, these are compiled as constants under -O option. */ -/* */ -static struct cons dummycons; -static struct functor dummyfunc; -#define CDROFFSET ((q*) &(dummycons.cdr) - (q*) &dummycons) -#define CARCDROFFSET ((q*) &(dummycons.car) - (q*) &(dummycons.cdr)) -#define FIRSTELTOFFSET ((q*) &(dummyfunc.args[0]) - (q*) &dummyfunc) - -#define qsizeof_cons (sizeof(struct cons)/sizeof(q)) /* 2 */ -#define qsizeof_functor(n) (sizeof(struct functor)/sizeof(q)+n-1) /* n+1 */ - -/* == COPY LOCK == */ -/* */ -/* In synchronous parallel GC, objects are locked in order to avoid */ -/* duplicate copying. */ -/* */ -#if defined(SYNC_GC) && defined(PAR_GC) -#define COPYING_MARK makeref(sizeof(q)) /* impossible as normal object */ -#endif - -static void -shm_copy_terms(sp, max) - q** sp; - q** max; -{ - declare_globals; - q *objp, obj; - while( sp > shm_gcstack ){ - (q) objp = pop_gc_command(); - ASSERT( isref(objp), "Shared heap topdown GC command error."); - objp = refp(objp); /* objp points to scavenging target cell */ - obj = *objp; /* obj is content of scavenging target cell */ - - TRO_LOOP: - - ASSERT( !is_shma(objp) || within_new_space(objp), "objp in old space"); - ASSERT( obj == *objp, "obj != *objp"); - - switch( ptagof(obj) ){ - case CONS: { - struct cons *old, *new; - old = consp(obj); - /* in new space ? */ - if( within_new_space(old) ) continue; - /* already copied ? */ -#ifdef ISFWD - if( isref(old->cdr) && within_new_space(refp(old->cdr)) ){ - *objp = makecons(refp(old->cdr) - CDROFFSET); - continue; - } -#endif -#ifdef IAFWD - if( isref(old->cdr) && within_new_space(refp(old->cdr)) && - old->car == makeref(refp(old->cdr) + CARCDROFFSET) ){ - *objp = makecons(refp(old->cdr) - CDROFFSET); - continue; - } -#endif -#if defined(SYNC_GC) && defined(PAR_GC) - { - q x = COPYING_MARK; - volatile q* fpp = &(old->cdr); - int offset = CDROFFSET; - atomic_swap(fpp, x); - if( x == COPYING_MARK ){ - /* being copied by somebody else */ - while( x == COPYING_MARK ) x = *fpp; - ASSERT( isref(x) && within_new_space(refp(x)), "bad fwd"); - *objp = makecons(refp(x) - offset); - continue; - } - /* allocation */ - new = (struct cons*) galloc(qsizeof_cons); - new->cdr = x; /* initialization of fwdptr position */ - new->car = old->car; - } -#else /* !defined(SYNC_GC) || !defined(PAR_GC) */ - /* allocation */ - new = (struct cons*) galloc(qsizeof_cons); - /* initialization */ - new->cdr = old->cdr; - new->car = old->car; -#endif - /* update of scavenging target */ - a_barrier(); - *objp = makecons(new); - /* forwarding */ - old->cdr = makeref(&(new->cdr)); -#ifdef IAFWD - old->car = makeref(&(new->car)); -#endif - /* nested scavenging */ - p_barrier(); - if( isatomic(new->car) ){ - /* N.B. In IAFWD, new->cdr is already REF to new->car. */ - objp = &(new->cdr); - obj = *objp; - }else{ - push_SCAVENGE(&(new->cdr)); -#ifdef ISFWD - old->car = makeref(&(new->car)); -#endif - objp = &(new->car); - obj = *objp; - } - goto TRO_LOOP; - } - case ATOMIC: { - continue; - } - case VARREF: { - q temp; - if( within_new_space(refp(obj)) ) continue; - temp = derefone(obj); - if( isref(temp) && obj == derefone(temp) ){ /* double loop */ - q svar; - struct generator_susp* vcell; - struct generator_object* addi; - Shvar* gvar; - addi = n_lock(obj, temp); - if( derefone(obj) != temp ){ - obj = derefone(obj); - *objp = obj; - goto TRO_LOOP; - } - svar = (q) galloc((sizeof(struct generator_susp)/sizeof(q))+1); - vcell = (struct generator_susp*) (((q*)svar) + 1); - vcell->backpt = (q) svar; - derefone(svar) = (q) vcell; - gvar = (Shvar*) untag_generator_susp(addi); - if( !gvar->chain ){ - vcell->u.o = tag_generator_susp(pSHM_VAR); - }else if( within_new_space(gvar) ){ - vcell->u.o = tag_generator_susp(gvar); - }else{ - Sinfo* dptr; - Sinfo* sptr; - Shvar* svar = (Shvar*) galloc((sizeof(Shvar)/sizeof(q))); - vcell->u.o = tag_generator_susp(svar); - svar->method = SHM_VAR; - dptr = (Sinfo*) &(svar->chain); - sptr = gvar->chain; - if( !is_genhook(sptr) ){ - while( sptr != NULL && !within_new_space(sptr) ){ - dptr->next = (Sinfo*) galloc((sizeof(Sinfo)/sizeof(q))); - dptr = dptr->next; - dptr->PE_num = sptr->PE_num; - dptr->prio = sptr->prio; - dptr->indp = sptr->indp; - sptr = sptr->next; - } - dptr->next = sptr; - }else{ - if( !within_new_space(sptr) ){ - Sinfo* addr = (Sinfo*) galloc((sizeof(Sinfo)/sizeof(q))); - sptr = untag_genhook(sptr); - dptr->next = tag_genhook(addr); - dptr = addr; - dptr->next = 0; - dptr->PE_num = sptr->PE_num; - dptr->prio = sptr->prio; - dptr->indp = sptr->indp; - }else{ - dptr->next = sptr; - } - } - } - a_barrier(); - derefone(obj) = makeref(svar); - *objp = makeref(svar); - continue; - }else{ /* obj is an invisible pointer */ - *objp = obj = temp; - goto TRO_LOOP; - } - } - case FUNCTOR: { - int i, arity; - q f; - struct functor *old, *new; - old = functorp(obj); - /* in new space ? */ - if( within_new_space(old) ) continue; - f = functor_of(obj); - if( isref(f) ){ - /*--- GENERIC OBJECT (data object) ---*/ - struct data_object* dobj = (struct data_object*) old; - obj = generic_shmcopy(dobj); - a_barrier(); - *objp = obj; - continue; - } - /*--- NORMAL FUNCTOR ---*/ - /* already copied ? */ -#ifdef ISFWD - /* arity > 0 is assumed */ - if( isref(old->args[0]) && within_new_space(refp(old->args[0])) ){ - new = (struct functor*) (refp(old->args[0]) - FIRSTELTOFFSET); - *objp = makefunctor(new); - continue; - } - arity = arityof(f); -#endif -#ifdef IAFWD - arity = arityof(f); - if( isref(old->args[0]) && within_new_space(refp(old->args[0])) ){ - q* neweltp = refp(old->args[0]) + 1; - int copied = 1; - for( i=1; iargs[i] != makeref(neweltp) ){ - copied = 0; - break; /* exit for statement */ - } - /* N.B. If arity is extremely large, neweltp might overflow. */ - /* But in that case, makeref(neweltp) becomes makeref(0), */ - /* which cannot be equal to old->args[i]. */ - } - if( copied ){ - new = (struct functor*) (refp(old->args[0]) - FIRSTELTOFFSET); - *objp = makefunctor(new); - continue; - } - } /* end if */ -#endif -#if defined(SYNC_GC) && defined(PAR_GC) - { - q x = COPYING_MARK; - volatile q* fpp = &(old->args[0]); - int offset = FIRSTELTOFFSET; - atomic_swap(fpp,x); - if( x == COPYING_MARK ){ - /* being copied by somebody else */ - while( x == COPYING_MARK ) x = *fpp; - ASSERT( isref(x) && within_new_space(refp(x)), "bad fwd"); - *objp = makefunctor(refp(x) - offset); - continue; - } - /* allocation */ - new = (struct functor*) galloc(qsizeof_functor(arity)); - /* initialization */ - new->functor = f; - new->args[0] = x; /* initialization of fwdptr position */ - for( i=1; iargs[i] = old->args[i]; - } - } -#else - /* allocation */ - new = (struct functor*) galloc(qsizeof_functor(arity)); - /* initialization */ - new->functor = f; - for( i=0; iargs[i] = old->args[i]; - } -#endif - /* update of scavenging target */ - a_barrier(); - *objp = makefunctor(new); - /* forwarding */ - old->args[0] = makeref(&(new->args[0])); -#ifdef IAFWD - for( i=1; iargs[i] = makeref(&(new->args[i])); - } -#endif - /* nested scavenging */ - p_barrier(); - for( i=arity-1; i>0; i-- ){ - if( ! isatomic(new->args[i]) ){ -#ifdef ISFWD - old->args[i] = makeref(&(new->args[i])); -#endif - push_SCAVENGE(&(new->args[i])); - } - } - objp = &(new->args[0]); - obj = *objp; - goto TRO_LOOP; - } /* case FUNCTOR */ - default: { - ASSERT(0, "Impossible case"); - } - } /* switch statement */ - } /* while (sp > shm_gcstack) */ -} -#endif /* TOPDOWN */ - -#ifdef BOTTOMUP -static void -shm_copy_terms(sp, max) - q** sp; - q** max; -{ - declare_globals; - q obj; - while( sp > shm_gcstack ){ - q* objp; - sp--; - objp = *sp; - switch( ptagof(objp) ){ - case ATOMIC: { /* in case of UPDATE */ - q* conta = (q*) ((long)objp - ATOMIC); - klic_barrier(); - *conta = obj; - break; - } - case CONS: - case FUNCTOR: { - obj = (q) objp; - break; - } - default: { - obj = *objp; - - ENTRY: - switch( ptagof(obj) ){ - case CONS: { - struct cons* new; - if( !is_shma(obj) ) break; /* assume text-area */ - if( within_new_space(obj) ) break; - new = (struct cons*) galloc(2); - *objp = makecons(new); - push_VALUE(makecons(new)); - new->cdr = cdr_of(obj); - if( !isatomic(new->cdr) ){ - push_UPDATE(&cdr_of(obj)); - push_SCAVENGE(&new->cdr); - } - new->car = car_of(obj); - if( isatomic(new->car) ) break; - push_UPDATE(&car_of(obj)); - objp = &new->car; - obj = *objp; - goto ENTRY; - } - case ATOMIC: { break; } - case VARREF: { - q temp; - if( within_new_space(obj) ){ break; } - temp = derefone(obj); - if( isref(temp) && obj == derefone(temp) ){ - q svar; - struct generator_susp* vcell; - struct generator_object* addi; - Shvar* gvar; - addi = n_lock(obj,temp); - if( derefone(obj) != temp ){ - obj = derefone(obj); - *objp = obj; - goto ENTRY; - } - svar = (q) galloc((sizeof(struct generator_susp)/sizeof(q))+1); - vcell = (struct generator_susp*) (((q*)svar) + 1); - vcell->backpt = (q) svar; - derefone(svar) = (q) vcell; - gvar = (Shvar*) untag_generator_susp(addi); - if( !gvar->chain ){ - vcell->u.o = tag_generator_susp(pSHM_VAR); - }else if( within_new_space(gvar) ){ - vcell->u.o = tag_generator_susp(gvar); - }else{ - Sinfo* dptr; - Sinfo* sptr; - Shvar* svar = (Shvar*) galloc((sizeof(Shvar)/sizeof(q))); - vcell->u.o = tag_generator_susp(svar); - svar->method = SHM_VAR; - dptr = (Sinfo*) &(svar->chain); - sptr = gvar->chain; - if( !is_genhook(sptr) ){ - while( sptr != NULL && !within_new_space(sptr)){ - dptr->next = (Sinfo*) galloc((sizeof(Sinfo)/sizeof(q))); - dptr = dptr->next; - dptr->PE_num = sptr->PE_num; - dptr->prio = sptr->prio; - dptr->indp = sptr->indp; - sptr = sptr->next; - } - dptr->next = sptr; - }else{ - if( !within_new_space(sptr) ){ - Sinfo* addr = (Sinfo*) galloc((sizeof(Sinfo)/sizeof(q))); - sptr = untag_genhook(sptr); - dptr->next = tag_genhook(addr); - dptr = addr; - dptr->next = NULL; - dptr->PE_num = sptr->PE_num; - dptr->prio = sptr->prio; - dptr->indp = sptr->indp; - }else{ - dptr->next = sptr; - } - } - } - klic_barrier(); - derefone(obj) = (q) svar; - *objp = obj = (q) svar; - break; - } - - { /* in case of an invisible pointer */ - *objp = obj = temp; - goto ENTRY; - } - } - default: { /* functor */ - int i, arity, aritym1; - struct functor* new; - q f; - if( !is_shma(obj) ) break; /* assume text-area */ - if( within_new_space(obj) ) break; - f = functor_of(obj); - if( isref(f) ){ - struct data_object* dobj = (struct data_object*) functorp(obj); - obj = generic_shmcopy(dobj); - klic_barrier(); - *objp = obj; - break; - } - arity = arityof(f); - aritym1 = arity-1; - new = (struct functor*) galloc(arity+1); - new->functor = f; - *objp = makefunctor(new); - push_VALUE(makefunctor(new)); - for( i=0; iargs[i] = arg(obj, i); - if( !isatomic(new->args[i]) ){ - push_UPDATE(&arg(obj,i)); - push_SCAVENGE(&(new->args[i])); - } - } - new->args[aritym1] = arg(obj, aritym1); - if( !isatomic(new->args[aritym1]) ){ - push_UPDATE(&arg(obj, aritym1)); - objp = &(new->args[aritym1]); - obj = *objp; - goto ENTRY; - } - } - } /* switch(ptogof(obj)) */ - } - } /* switch(ptagof(objp)) */ - } /* while( sp...) */ -} -#endif /* BOTTOMUP */ - - -static void -get_new_plane() -{ - declare_globals; - int i, id, j; - s_lock(m_key()); - if( PLNE_ptr[currid]->direct == -1 ){ - id = (currid + 1) % N_PLNE; - for( j=0; jproc[j] ){ - abend("Shared Memory overflow !!!"); - } - } - - /* initialize table */ - PLNE_ptr[id]->caddr = PLNE_ptr[id]->top_addr; - PLNE_ptr[id]->demand = 0; - PLNE_ptr[id]->direct = -1; - klic_barrier(); - PLNE_ptr[currid]->direct = id; - }else{ - id = PLNE_ptr[currid]->direct; - } - s_unlock(m_key()); - - currid = id; - PLNE_ptr[currid]->proc[my_node] = 1; - gallocp = glimit = (q*) 1; -} - -static void -enter_shm_gc() -{ - declare_globals; -#ifdef ASYNC_GC - if( currid == oldid ){ - PLNE_ptr[currid]->proc[my_node] = 3; - if( PLNE_ptr[currid]->direct == -1 ){ - get_new_plane(); - }else{ - currid = PLNE_ptr[currid]->direct; - PLNE_ptr[currid]->proc[my_node] = 2; - gallocp = glimit = (q*) 1; - } - }else{ - PLNE_ptr[oldid]->proc[my_node] = 10; - } - { - int j, next; - next = (currid + 1) % N_PLNE; - for( j=0; jproc[j] ){ - struct global_variables* tglbl = top_shm_glbl + j; - tglbl->interrupt_off0 = 0; - klic_barrier(); - tglbl->heaplimit0 = 0; - } - { - int waitC = 1000000; - for(;;){ - if( !(PLNE_ptr[next]->proc[j]) ) break; - if( !(waitC--) ) abend("Shared-memory overflow!!!"); - } - } - } - oldid = currid; - } -#endif /* ASYNCGC */ -#ifdef SYNC_GC - { - int i, j; - if( !PLNE_ptr[currid]->demand ){ - s_lock(m_key()); - if( !PLNE_ptr[currid]->demand ){ - PLNE_ptr[currid]->demand = 1; - for( j=0; jproc[j] ){ - struct global_variables* tglbl = top_shm_glbl + j; - tglbl->interrupt_off0 = 0; - klic_barrier(); - tglbl->heaplimit0 = 0; - } - } - PLNE_ptr[1-currid]->caddr = PLNE_ptr[1-currid]->top_addr; - PLNE_ptr[1-currid]->demand = 0; - } - s_unlock(m_key()); - } - PLNE_ptr[currid]->proc[my_node] = 0; - for( i=0; iproc[i] ) - {} - currid = 1 - currid; - gallocp = glimit = (q*) 1; - } -#endif /* SYNC_GC */ -#ifdef SEQ_GC - s_lock(gc_key()); -#endif -} - -static void -exit_shm_gc() -{ - declare_globals; -#ifdef SEQ_GC - s_unlock(gc_key()); -#endif -#ifdef SYNC_GC - { - int i; - PLNE_ptr[currid]->proc[my_node] = 1; - for( i=0; iproc[i] ) - {} - } -#endif -#ifdef ASYNC_GC - { - int i; - for( i=0; iproc[my_node] = 0; - } - PLNE_ptr[currid]->proc[my_node] = -1; - } -#endif - F_shm_gc = 0; -} diff -ruN klic-3.003-2002-03-16/runtime/shm_machine.h klic-3.003-2002-03-19/runtime/shm_machine.h --- klic-3.003-2002-03-16/runtime/shm_machine.h Wed Jan 2 14:44:16 2002 +++ klic-3.003-2002-03-19/runtime/shm_machine.h Thu Jan 1 09:00:00 1970 @@ -1,233 +0,0 @@ -/* ---------------------------------------------------------- -% (C)1994,1995 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) -% (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center -% (Read COPYRIGHT-JIPDEC for detailed information.) ------------------------------------------------------------ */ - -#ifndef _KLIC_SHM_MACHINE_H_ -#define _KLIC_SHM_MACHINE_H_ - - /* lock-unlock */ - - -#ifdef SPARC - -#define n_lock(shvp,sadp) ( { \ - register int* s1 asm ("g4") = (int*) (shvp); \ - register int* s2 asm ("g3") = (int*) (sadp); \ - register struct generator_object* befp asm ("g2"); \ - register struct generator_object* genp asm ("g5") = qSHM_BUSY; \ - asm ( " \ -0: \ - mov %%g5,%%g2; \ - swap [%%g3 + 4],%%g2; \ - cmp %%g2,%%g5; \ - bne 4f; \ - nop; \ -2: \ - ld [%%g4],%%g2; \ - cmp %%g3,%%g2; \ - bne 3f; \ - nop; \ - ld [%%g3 + 4],%%g2; \ - cmp %%g2,%%g5; \ - bne 0b; \ - nop; \ - b 2b; \ - nop; \ -3: \ - mov %%g5,%%g2; \ -4: \ -" : "=g" (befp), "=g" (s1) : "g" (s1), "g" (s2), "g" (genp) ); \ - (shvp) = (q) s1; \ - befp; \ - } ) - -#define n_unlock(sadp, genh) \ -do{ \ - register int* n1 asm ("g3") = (int*) (sadp); \ - register struct generator_object* n2 asm ("g4") = (genh); \ - asm volatile ( " \ - stbar; \ - st %%g4,[%%g3 + 4]; \ -" : : "g" (n1), "g" (n2) ) ;\ -}while(0) - -#define s_lock(key) \ -do{ \ - register int* val asm ("g3") = lockp[key]; \ - asm volatile ( " \ -0: \ - mov -1,%%g2; \ - swap [%%g3],%%g2; \ - cmp %%g2,0; \ - be 3f; \ - nop; \ -2: \ - ld [%%g3],%%g2; \ - cmp %%g2,0; \ - be 0b; \ - nop; \ - b 2b; \ - nop; \ -3: \ -" : : "g" (val) : "g2" ); \ -}while(0) - -#define s_unlock(key) -do{ \ - register int* val asm ("g3") = lockp[key]; \ - asm volatile ( " \ - stbar; \ - st %%g0,[%%g3]; \ -" : : "g" (val) ) ; \ -}while(0) - -#define klic_barrier() do{ asm volatile ( "stbar;" : : ); }while(0) - -#endif /* SPARC */ - - -#ifdef ALPHA - -#define n_lock(shvp,sadp) ( { \ - register long* s1 asm ("$4") = (long*) (shvp); \ - register long* s2 asm ("$3") = (long*) (sadp); \ - register struct generator_object* genp asm ("$5") = qSHM_BUSY; \ - register struct generator_object* befp asm ("$2"); \ - asm volatile ( " \ -1: \ - ldq_l $2,8($3); \ - cmpeq $2,$5,$1; \ - bne $1,2f; \ - bis $5,$5,$1; \ - stq_c $1,8($3); \ - bne $1,3f; \ -2: \ - ldq $2,8($3); \ - cmpeq $2,$5,$1; \ - beq $1,1b; \ - ldq $1,($4); \ - cmpeq $3,$1,$1; \ - beq $1,3f; \ - br 2b; \ -3: \ - mb; \ -" : "=g" (befp), "=g" (s1) : "g" (s1), "g" (s2), "g" (genp) : "$1" ); \ - (shvp) = (q) s1; \ - befp; \ - } ) - -#define n_unlock(sadp, genh) \ -do{ \ - register long* n1 asm ("$3") = (long*) (sadp); \ - register struct generator_object* n2 asm ("$4") = (genh); \ - asm volatile ( " \ - mb; \ - stq $4,8($3); \ -" : : "g" (n1), "g" (n2) ) ;\ -}while(0) - -#define s_lock(key) \ -do{ \ - register int* val asm ("$3") = lockp[key]; \ - asm volatile ( " \ -1: \ - ldl_l $1,0($3); \ - blbs $1,2f; \ - or $1,1,$2; \ - stl_c $2,0($3); \ - beq $2,2f; \ - br 3f; \ -2: \ - ldl $1,0($3); \ - blbc $1,1b; \ - br 2b; \ -3: \ -" : : "g" (val) : "$1","$2" ); \ -}while(0) - -#define s_unlock(key) \ -do{ \ - register int* val asm ("$3") = lockp[key]; \ - asm volatile ( " \ - mb; \ - stl $31,0($3); \ -" : : "g" (val) ) ; \ -}while(0) - -#define klic_barrier() do{ asm volatile ( "mb;" : : ); }while(0) - -#endif /* ALPHA */ - - -#ifdef INTEL -#define n_lock(shvp, sadp) ({ \ - register int* s1 asm ("%edx") = (int *) (shvp); \ - register int* s2 asm ("%ecx") = (int *) (sadp); \ - register struct generator_object* befp asm ("%ebx"); \ - register struct generator_object* genp asm ("%eax") = qSHM_BUSY; \ - asm ( " \ -0: \ - movl %%eax,%%ebx; \ - xchgl 4(%%ecx),%%ebx; \ - cmpl %%ebx,%%eax; \ - jne 4f; \ -2: \ - movl (%%edx),%%ebx; \ - cmpl %%ecx,%%ebx; \ - jne 3f; \ - movl 4(%%ecx),%%ebx; \ - cmpl %%ebx,%%eax; \ - jne 0b; \ - jmp 2b; \ -3: \ - movl %%eax,%%ebx; \ -4: \ -" : "=g" (befp), "=g" (s1) : "g" (s1), "g" (s2), "g" (genp) ); \ - (shvp) = (q) s1; \ - befp; \ - } ) - -#define n_unlock(sadp,genh) \ -do{ \ - register int* n1 asm ("%ecx") = (int*) (sadp); \ - register struct generator_object* n2 asm ("%edx") = (genh); \ - asm volatile ( " \ - movl %%edx,4(%%ecx); \ -" : : "g" (n1), "g" (n2) ) ;\ -}while(0) - -#define s_lock(key) { \ - register int* val asm ("%ecx") = lockp[key]; \ - asm volatile ( " \ - movl $0,%%edx; \ -6: \ - movl $-1,%%ebx; \ - xchgl (%%ecx),%%ebx; \ - cmpl %%ebx,%%edx; \ - je 8f; \ -7: \ - movl (%%ecx),%%ebx; \ - cmpl %%ebx,%%edx; \ - je 6b; \ - jmp 7b; \ -8: \ -" : : "g" (val) : "%ebx","%edx" ); \ -}while(0) - -#define s_unlock(key) \ -do{ \ - register int* val asm ("ecx") = lockp[key]; \ - asm volatile ( " \ - movl $0,(%%ecx); \ -" : : "g" (val) ) ; \ -}while(0) - -#define klic_barrier() do{;}while(0) - -#endif /* INTEL */ - - -#endif /* _KLIC_SHM_MACHINE_H_ */ diff -ruN klic-3.003-2002-03-16/runtime/shm_obj.c klic-3.003-2002-03-19/runtime/shm_obj.c --- klic-3.003-2002-03-16/runtime/shm_obj.c Tue Mar 12 12:08:47 2002 +++ klic-3.003-2002-03-19/runtime/shm_obj.c Thu Jan 1 09:00:00 1970 @@ -1,423 +0,0 @@ -/* ---------------------------------------------------------- -% (C)1994,1995 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) -% (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center -% (Read COPYRIGHT-JIPDEC for detailed information.) ------------------------------------------------------------ */ - -#include /* NULL */ -#include -#include -#include /* enqueue_goal */ -#include -#include -#include /* do_unify */ -#include -#include -#include "shm.h" - -extern void* calloc(); - -#define is_cur_space_ptr(X) \ - ((unsigned long) ((long)(X) - (long)(PLNE_ptr[currid]->top_addr)) < SHM_SIZE) - -/* unbound variable in shared memory (representating by a generic object) - +-------------------+ - V | - +---------+ +----+----+ - | var ---+-------->| * | - +---------+ +---------+ - Additional Info. - +---------+ - -*/ - -/* definition of an initail generator object on text area */ - -extern struct generator_object_method_table GG_method_table0(shvar); -extern struct generator_object_method_table GG_method_table0(shbusy); -struct generator_object_method_table* SHM_VAR = - &GG_method_table0(shvar); -struct generator_object_method_table* SHM_BUSY = - &GG_method_table0(shbusy); -Shvar xSHM_VAR = {&GG_method_table0(shvar), 0}; -struct generator_object* pSHM_VAR = (struct generator_object*) &xSHM_VAR; -Shvar xSHM_BUSY = {&GG_method_table0(shbusy), 0}; -struct generator_object* qSHM_BUSY = tag_generator_susp(&xSHM_BUSY); - - -/* address drive table */ -#define ADDRBULK 2048 -TADDRtbl ADDRtbl = { &ADDRtbl, &ADDRtbl, 0, 0 }; -TADDRtbl* ADDRtbl_free = NULL; - -#define new_addr_rec(lrec) \ -{ \ - TADDRtbl* temp; \ - temp = ADDRtbl_free; \ - while( temp == NULL ){ \ - ADDRtbl_free = more_addr_rec(); \ - } \ - ADDRtbl_free = temp->next; \ - (lrec) = temp; \ -} - - -static module shm_resume(struct global_variables* glbl, - struct goalrec* qp, q* allocp, const struct predicate* toppred); - -static module shm_request(struct global_variables* glbl, - struct goalrec* qp, q* allocp, const struct predicate* toppred); - -static const struct predicate shm_xresume_1 = { shm_resume, 0, 1 }; -static const struct predicate shm_xrequest_1 = { shm_request, 0, 1 }; - - -static TADDRtbl* -more_addr_rec() -{ - int k; - TADDRtbl* bulk = (TADDRtbl*) calloc(ADDRBULK, sizeof(TADDRtbl)); - for( k = ADDRBULK-1; k > 0; k-- ){ - bulk[k-1].next = &bulk[k]; - } - bulk[ADDRBULK-1].next = 0; - return bulk; -} - -/* d_shm_init - initializes free chain of external trigger */ -extern void -d_shm_init() -{ - TADDRtbl* bptr; - new_addr_rec(bptr); -} - - -extern Sinfo* -shm_copy_chain(xp) - Sinfo* xp; -{ - declare_globals; - Sinfo* ret; - Sinfo** retp = &ret; - while( xp != NULL && !is_cur_or_forward_ptr(xp) ){ - Sinfo* sp = (Sinfo*) galloc(sizeof(Sinfo)/sizeof(q)); - *sp = *xp; - *retp = sp; - retp = (Sinfo**) sp; - xp = xp->next; - } - *retp = xp; - return ret; -} - - -extern Sinfo* -shm_merge_chain(xp, yp) - Sinfo* xp; - Sinfo* yp; -{ - declare_globals; - Sinfo* ret; - Sinfo** retp = &ret; - while( xp != NULL ){ - if( !is_cur_or_forward_ptr(xp) ){ /* xp is old */ - Sinfo* sp = (Sinfo*) galloc(sizeof(Sinfo)/sizeof(q)); - *sp = *xp; - *retp = sp; - retp = (Sinfo**) sp; - }else if( !is_cur_space_ptr(xp) ){ /* xp is new */ - while( yp != NULL ){ - if( !is_cur_or_forward_ptr(yp) ){ /* yp is old */ - Sinfo* sp = (Sinfo*) galloc(sizeof(Sinfo)/sizeof(q)); - *sp = *yp; - *retp = sp; - retp = (Sinfo**) sp; - }else if( !is_cur_space_ptr(yp) ){ /* yp is new */ - while( yp != NULL ){ - *retp = yp; - retp = (Sinfo**) yp; - yp = yp->next; - } - *retp = xp; - return ret; - }else{ /* yp is cur */ - *retp = yp; - retp = (Sinfo**) yp; - } - yp = yp->next; - } - *retp = yp; - }else{ /* xp is cur */ - *retp = xp; - retp = (Sinfo**) xp; - } - xp = xp->next; - } - /* xp is no more new space */ - while( yp != NULL ){ - if( !is_cur_or_forward_ptr(yp) ){ /* yp is old */ - Sinfo* sp = (Sinfo*) galloc(sizeof(Sinfo)/sizeof(q)); - *sp = *yp; - *retp = sp; - retp = (Sinfo**) sp; - } else break; - yp = yp->next; - } - *retp = yp; - return ret; -} - - -/* shm_add_consumer(shrec,consumer_ref) - adds a shared memory variable -*/ -extern Shvar* -shm_add_consumer(shv, shobj, cvar, glbl) - q shv; - Shvar* shobj; - q cvar; - struct global_variables* glbl; -{ - q mid; - Sinfo* sptr; - ck_new_galloc(shv); - if( shobj != NULL && shobj->chain != NULL ){ - Sinfo* shrec = shobj->chain; - Sinfo* bp = (Sinfo*) &(shobj->chain); - ck_new_galloc(shrec); - while( !is_cur_or_forward_ptr(shrec) ){ - sptr = (Sinfo*) galloc(sizeof(Sinfo)/sizeof(q)); - *sptr = *shrec; - bp->next = sptr; - bp = sptr; - shrec = sptr->next; - } - sptr = (Sinfo*) galloc(sizeof(Sinfo)/sizeof(q)); - bp->next = sptr; - sptr->next = shrec; - sptr->PE_num = my_node; - sptr->prio = current_prio(); - mid = derefone(cvar); - derefone(cvar) = shv; - derefone(mid) = 0; - sptr->indp = create_local_tbl(tag_local(mid), shv); - return shobj; - }else{ - /* add first */ - Shvar* vr = (Shvar*) galloc((sizeof(Shvar)+sizeof(Sinfo))/sizeof(q)); - sptr = (Sinfo*) (vr + 1); - vr->method = SHM_VAR; - vr->chain = sptr; - sptr->next = 0; - sptr->PE_num = my_node; - sptr->prio = current_prio(); - mid = derefone(cvar); - derefone(cvar) = shv; - derefone(mid) = 0; - sptr->indp = create_local_tbl(tag_local(mid), shv); - return vr; - } -} - - -extern Shvar* -create_genhook(la, ga) - q* la; - q* ga; -{ - declare_globals; - Shvar* varp; - Sinfo* sptr; - ck_new_galloc(ga); - varp = (Shvar*) galloc((sizeof(Shvar)+sizeof(Sinfo))/sizeof(q)); - sptr = (Sinfo*) (varp + 1); - varp->method = SHM_VAR; - varp->chain = tag_genhook(sptr); - sptr->PE_num = my_node; - sptr->next = 0; - sptr->prio = HIGHESTPRIO - 1; - sptr->indp = create_local_tbl(la, ga); - return varp; -} - -/* queueing other PE's resume routine -*/ -static void resume_queueing(Pe_num, suspg, prio) - int Pe_num; - TADDRtbl* suspg; - long prio; -{ - struct ex_goalrec* tp; - struct goalrec* goal; - - tp = (struct ex_goalrec*) galloc(5); - tp->prio = prio; - goal = &tp->goal; - goal->next = 0; - goal->pred = &shm_xresume_1; - goal->args[0] = (q) ((unsigned long)suspg + ATOMIC); - - shm_goal_stack(tp, Pe_num); -} - -/* resume waiting process -*/ -extern void -shm_resume_goals(hook) - Sinfo* hook; -{ - declare_globals; - q* allocp = heapp(); - - while( hook != NULL ){ - if( hook->PE_num == my_node ){ - TADDRtbl* sptr = hook->indp; - q term = (q) sptr->localA; - q shm_term = (q) sptr->globalA; - - free_local_tbl(sptr); - - if( isatomic(term) ){ - q wp = untag_local(term); - q top = (q) &sptr->localA; - derefone(top) = wp; - derefone(wp) = top; - do_unify(top, shm_term); - allocp = heapp(); - }else{ - struct goalrec* goal = (struct goalrec*) term; - if( goal != NULL && isatomic(goal->next) ){ - long prio = intval(goal->next); - if( current_prio() != prio ){ - enqueue_goal(NULL, prio, goal, glbl); - }else{ - resume_same_prio(goal); - } - inc_resumes(); - } - } - }else{ - resume_queueing(hook->PE_num, hook->indp, hook->prio); - } - hook = hook->next; - } -} - - -extern void -shm_request_queueing(peno, prio, indp) - int peno; - long prio; - TADDRtbl* indp; -{ - struct ex_goalrec* tp; - struct goalrec *goal; - - tp = (struct ex_goalrec*) galloc(5); - tp->prio = prio; - goal = &tp->goal; - goal->next = 0; - goal->pred = &shm_xrequest_1; - goal->args[0] = (q) ((unsigned long)indp + ATOMIC); - - shm_goal_stack(tp, peno); -} - - -extern void -shm_ck_request(chain) - Sinfo* chain; -{ - declare_globals; - q* allocp = heapp(); - Sinfo* sptr = untag_genhook(chain); - int penum = sptr->PE_num; - TADDRtbl* indp = sptr->indp; - if( penum == my_node ){ - q temp; - free_local_tbl(indp); - shm_arg_copy(&indp->localA, &temp); - do_unify(indp->globalA, temp); - allocp = heapp(); - }else{ - shm_request_queueing(penum, current_prio(), indp); - } -} - - -extern TADDRtbl* -create_local_tbl(lcl, gbl) - q* lcl; - q* gbl; -{ - TADDRtbl* sl; - new_addr_rec(sl); - - sl->next = ADDRtbl.next; - ADDRtbl.next = sl; - (sl->next)->prev = sl; - sl->prev = &ADDRtbl; - sl->localA = lcl; - sl->globalA = gbl; - - return sl; -} - -static module -shm_resume(glbl, qp, allocp, toppred) - struct global_variables* glbl; - struct goalrec* qp; - q* allocp; - const struct predicate* toppred; -{ - TADDRtbl* tp = (TADDRtbl*) ((unsigned long)(qp->args[0]) - ATOMIC); - set_heapp(allocp); - free_local_tbl(tp); - if( isatomic(tp->localA) ){ /* consumer */ - q x = (q) untag_local(tp->localA); - q top = (q) &(tp->localA); - derefone(top) = x; - derefone(x) = top; - qp = qp->next; - do_unify(top, tp->globalA); - allocp = heapp(); - }else{ - struct goalrec* gp = (struct goalrec*) (tp->localA); - if( gp != NULL && isatomic(gp->next) ){ - gp->next = qp->next; - qp = gp; - inc_resumes(); - }else{ - qp = qp->next; - } - } - current_queue = qp; - return (module) (qp->pred)->func; -} - - -static module -shm_request(glbl, qp, allocp, toppred) - struct global_variables* glbl; - struct goalrec* qp; - q* allocp; - const struct predicate* toppred; -{ - TADDRtbl* tp = (TADDRtbl*) ((unsigned long)(qp->args[0]) - ATOMIC); - q var = (q) tp->globalA; - set_heapp(allocp); - free_local_tbl(tp); - qp = qp->next; - - if( isatomic(tp->localA) ){ /* local generator object */ - q x = untag_local(tp->localA); - do_unify(x, var); - }else{ /* shared-memory generator hook */ - do_unify(tp->localA, var); - } - current_queue = qp; - return (module) (qp->pred)->func; -} diff -ruN klic-3.003-2002-03-16/runtime/shm_rsv.c klic-3.003-2002-03-19/runtime/shm_rsv.c --- klic-3.003-2002-03-16/runtime/shm_rsv.c Wed Jan 2 14:44:16 2002 +++ klic-3.003-2002-03-19/runtime/shm_rsv.c Thu Jan 1 09:00:00 1970 @@ -1,402 +0,0 @@ -/* ---------------------------------------------------------- -% (C)1994,1995 Institute for New Generation Computer Technology -% (Read COPYRIGHT for detailed information.) -% (C)1996, 1997, 1998, 1999 Japan Information Processing Development Center -% (Read COPYRIGHT-JIPDEC for detailed information.) ------------------------------------------------------------ */ - -#include -#include -#include -#include -#include -#include -#include -#include "shm.h" -#include - -#define MAX_N_PLNE 8 - -/* -#define SYNC_GC /* Synchronous GC */ -/**/ -#define PAGE 4096 -#define HPAGE 2048 -#define N_PAGE 64 - -/* threshold value (favourable)THV1 %, (compel)THV2 % */ -#define THV1 90 -#define THV2 98 - -/* table size for locking */ -#define LOCK_size (6+total_node) - - -/* shm.h */ - -/* Number of plains (copying GC) */ -long N_PLNE = 3; - -long Disp_child = 0; - -int ATOM_TABLE_SIZE = 256*PAGE; /* 512KB */ - -/* Heap size on shared memory */ -long SHM_SIZE = PAGE*N_PAGE; - -int* lockp[6+MAX_N_PE]; -volatile PLNE* PLNE_ptr[MAX_N_PLNE]; -char* shm_start_addr; -struct global_variables* top_shm_glbl; -int* pe_status; -int* cur_status; -struct ex_goalrec** top_shm_qp; -struct ex_goalrec** shm_qp; -struct ex_goalrec** top_shm_next; - - /* current shared memory top address of myself */ -q* gallocp = 0; - /* current shared memory limit of myself */ -q* glimit = 0; - - -static int MON_SIZE; -static long SHM_SIZEq; -static long TOTAL_SIZE; - - /* Management variables on shared memory */ -static struct global_variables* shm_glblp = &globals; -static int* top_shm_pid; - - /* for Profile */ -static long My_measure; -static long* volatile Prof_measure = &My_measure; - -static long* get_page(int size); -static int* init_lock(int* addr); -extern void abend(char* mess); - -/* adjusts the memory boundary */ -#define adjust(x) ((long*)((((long)(x)+sizeof(long)-1)/sizeof(long))*sizeof(long))) - -/* Initialize shared memory. - allocaltes shared memory and intializes shared variables. -*/ -extern struct global_variables* -shm_init(glbl) - struct global_variables* glbl; -{ - long NUM_PE = total_node; - long MY_PENO; - int fds,i,j; - long* addr; - char bf[32]; - long GLOBALS, EXT_INFO, LOCK_AREA, PLANE_INF, PROFILE_B; - long BBUF[PAGE/sizeof(long)]; - - if ( NUM_PE < 1 || MAX_N_PE <= NUM_PE ) abend(" Number of processes ???"); - if ( N_PLNE < 2 || MAX_N_PLNE <= N_PLNE ) abend(" Number of spacees ???"); - - /* Management size on shared memory */ - GLOBALS = reckon(sizeof(struct global_variables))*NUM_PE; - EXT_INFO = reckon(sizeof(long)*NUM_PE + - sizeof(long)*NUM_PE + - sizeof(struct goalrec*)*NUM_PE + - sizeof(q*)*NUM_PE); - LOCK_AREA = reckon(sizeof(int)*LOCK_size); - PLANE_INF = reckon(sizeof(PLNE))*N_PLNE; - PROFILE_B = sizeof(long)*2; - - MON_SIZE = ATOM_TABLE_SIZE + - GLOBALS + - EXT_INFO + - LOCK_AREA + - PLANE_INF + - PROFILE_B; - - /* Shared Heap size */ - SHM_SIZE *= sizeof(q); /* byte count */ - SHM_SIZE = ((SHM_SIZE+PAGE-1)/PAGE)*PAGE; - SHM_SIZEq = SHM_SIZE/sizeof(q); - SHP_SIZE = SHM_SIZE * N_PLNE; - - if ( NUM_PE == 1 ) SHP_SIZE = 0; /* only 1 process */ - - TOTAL_SIZE = MON_SIZE + SHP_SIZE; - - /* management table */ - sprintf(bf,"/tmp/SHM%d",getpid()); - fds = open(bf,(O_RDWR|O_CREAT),0644); - for(j=0;j<(PAGE/sizeof(long));j++) BBUF[j] = -1; - lseek(fds,TOTAL_SIZE,SEEK_SET); - write(fds,BBUF,PAGE); - /* for(j=0;j<((TOTAL_SIZE+PAGE-1)/PAGE);j++) write(fds,BBUF,PAGE); */ - - shm_start_addr = - (char*) mmap(0, TOTAL_SIZE, (PROT_READ|PROT_WRITE), MAP_SHARED, fds, 0); - if( (long) shm_start_addr == -1 ) { - perror(0); - exit(1); - } - close(fds); - unlink(bf); - - SHM_HEAP_TOP = MON_SIZE + (long) shm_start_addr; - SHP_SIZE += 0xff; /* allowance */ - addr = adjust(shm_start_addr+ATOM_TABLE_SIZE); - top_shm_glbl = (struct global_variables*) addr; - for( i=0; ipar.aux.shm.ex_qp0 = (struct ex_goalrec*) top_shm_next + MY_PENO; - PLNE_ptr[0]->caddr = 0; - PLNE_ptr[1]->limit3 = (long*) MAXKLICINT; - - /* This fix is temporary. (from Chik) */ - init_shm_atom(); /* manages shared atom-id & funct-id */ - /* end fix */ - - return glbl; - } - - /* Each Heap plains */ - SHM_HEAP_TOP = (long) addr; - for( i=0; itop_addr = addr; - - PLNE_ptr[i]->caddr = addr; - PLNE_ptr[i]->direct = -1; - PLNE_ptr[i]->demand = 0; - for( j=0; j<=MAX_N_PE; j++ ) PLNE_ptr[i]->proc[j] = 0; - PLNE_ptr[i]->limit1 = addr+(SHM_SIZEq*THV1/100); - PLNE_ptr[i]->limit2 = addr+(SHM_SIZEq*THV2/100); - addr += SHM_SIZEq; - PLNE_ptr[i]->limit3 = addr; - } - - /* for Profile */ - Prof_measure = addr; - *Prof_measure = 0; - - init_shm_atom(); /* manages shared atom-id & funct-id */ - - currid = oldid = 0; - - /* invoke parallel process */ - { - int child; - *(top_shm_pid) = getpid(); - for( i=1; ipar.aux.shm.ex_qp0 = (struct ex_goalrec*)(top_shm_next + MY_PENO); - - /* at first 0 plain */ - /* - gallocp = glimit = 0; - PLNE_ptr[currid]->proc[MY_PENO] = 1; - */ - /* this allocation will be disappeared */ - galloc(0); - - return( glbl ); -} - -/* galloc - allocates shared memory specifyed size - if no current space, get from shared memory pool -*/ -extern q* -shm_galloc(siz) - int siz; -{ - declare_globals; - q* temp = gallocp; - GET_L: - gallocp += siz; - if( gallocp <= glimit ) return temp; - if( glimit == 0 ){ /* this means initial state */ - currid = 0; - PLNE_ptr[currid]->proc[my_node] = 1; - } - if( siz > HPAGE ){ - int npsize = (1+(siz/HPAGE)) * HPAGE; - temp = gallocp = (q*) get_page(npsize); - glimit = gallocp + npsize; - }else{ - temp = gallocp = (q*) get_page(HPAGE); - glimit = gallocp + HPAGE; - } - goto GET_L; -} - -/* get_page(siz) - get shared memory from shared memory pool -*/ -static long* -get_page(siz) - int siz; -{ - declare_globals; - long *temp, *pos; - int key = g_key(); - - ReTry: - s_lock(key); - pos = PLNE_ptr[currid]->caddr; - temp = pos + siz; - if( PLNE_ptr[currid]->limit1 >= temp ){ - PLNE_ptr[currid]->caddr = temp; - s_unlock(key); - return pos; - } - -#ifdef SYNC_GC - heaplimit = 0; -#else - if( currid != oldid ){ - if( *cur_status == 4 ){ /* inside GC */ - abend(" shared memory overflow !!!"); - } - heaplimit = 0; - } -#endif - - if( PLNE_ptr[currid]->limit3 >= temp ){ - PLNE_ptr[currid]->caddr = temp; - s_unlock(key); - return pos; - } - s_unlock(key); - -#ifdef SYNC_GC - abend(" Shared memory overflow !!!"); -#else - /* secondary try */ - { - int i, j; - if( PLNE_ptr[currid]->direct == -1 ){ - int key = m_key(); - s_lock(key); - if( PLNE_ptr[currid]->direct == -1 ){ - j = (currid + 1) % N_PLNE; - for( i=0; iproc[i] ){ - struct global_variables* tglbl = get_otherPE_glbl(i); - tglbl->interrupt_off0 = 0; - klic_barrier(); - tglbl->heaplimit0 = 0; - sleep(1); - if( PLNE_ptr[j]->proc[i] ){ - abend(" Shared memory overflow !!!"); - } - } - } - /* initialize table */ - PLNE_ptr[j]->caddr = PLNE_ptr[j]->top_addr; - PLNE_ptr[j]->demand = 0; - PLNE_ptr[j]->direct = -1; - PLNE_ptr[j]->proc[my_node] = 1; - PLNE_ptr[currid]->direct = j; - currid = j; - s_unlock(key); - goto ReTry; - } - s_unlock(key); - } - currid = PLNE_ptr[currid]->direct; - PLNE_ptr[currid]->proc[my_node] = 1; - goto ReTry; - } -#endif /* not SYNC_GC */ -} - -/* new_galloc --- change to the new plain from the old plain -*/ -extern void -new_galloc(cid) - int cid; -{ - declare_globals; - currid = cid; - PLNE_ptr[currid]->proc[my_node] = 1; - gallocp = glimit = (q*) 1; -} - -/* initialize a lock table -*/ -static int* -init_lock(addr) - int* addr; -{ - declare_globals; - int i, j; - for( i=0; i -#include -#include -#include -#include /* arityof */ -#include -#include "gobj.h" -#include "shm.h" /* last_shm_var */ -#include -#include "trace.h" /* trace_flag, trace_goal */ - -#define is_locala(X) \ - ((unsigned long) ((long) (X) - (long) heaptop()) < real_heapbytesize()) - -#define makeshvar(svar) \ -do{ \ - struct generator_susp* vcell; \ - (svar) = (q) galloc((sizeof(struct generator_susp) / sizeof(q)) + 1); \ - vcell = (struct generator_susp*) (((q*) svar) + 1); \ - vcell->backpt = (q) (svar); \ - vcell->u.o = tag_generator_susp(pSHM_VAR); \ - *((q*) svar) = (q) vcell; \ -}while(0) - -#define ck_throw_new_galloc(num) \ -do{ \ - int cid = currid;\ - while( (cid=PLNE_ptr[cid]->direct) != -1 ) { \ - if ( PLNE_ptr[cid]->proc[num] ) {new_galloc(cid);} \ - }\ -}while(0) - -q last_shm_var; - -/* phisc_pe(Logical_process_number) - convert a logical process number to a phisical shared process number -*/ -static int -phisc_pe(NO) - int NO; -{ - declare_globals; - if( 0 <= NO && NO < total_node ) - return(NO); - else - abend("Invalid PE number !!!"); -} - -/* shm_goal_copy(Local_goal_pointer,priority) - copy a goal into shared memory -*/ -static struct ex_goalrec* -shm_goal_copy(qp, prio) - struct goalrec* qp; - long prio; -{ - int i, j; - int arity = qp->pred->arity; - struct ex_goalrec* sgoal; - struct goalrec* goal; - sgoal = (struct ex_goalrec*) galloc(arity + 4); - sgoal->prio = prio; - goal = &sgoal->goal; - goal->next = 0; - goal->pred = qp->pred; - for( i=0; iargs[i], &goal->args[i]); - } - return sgoal; -} - -extern struct goalrec* -throw_goal_routine(N, qp, gp) - int N; /* logical process number */ - struct goalrec *qp, *gp; -{ - declare_globals; - struct goalrec *ng; - int k; - int num = phisc_pe(N); - struct ex_goalrec* sh_goal; - *cur_status = 2; - - ck_throw_new_galloc(num); - - if( trace_flag ){ - static long throw_trace_count = 0; - gp = trace_goal(gp, (num+1)*100000+throw_trace_count, NULL); - throw_trace_count++; - } - - sh_goal = shm_goal_copy(gp, current_prio()); - shm_goal_stack(sh_goal, num); - *cur_status = 1; - return qp; -} - - -/* shm_goal_stack(Shared_goal_pointer,stack_position) - stack a goal to shared other process's stack -*/ -extern int -shm_goal_stack(goal,num) - struct ex_goalrec* goal; - int num; -{ - struct ex_goalrec* tqp; - int key = p_key(num); - - goal->next = 0; - klic_barrier(); - s_lock(key); - - tqp = *(top_shm_qp+num); - tqp->next = goal; - *(top_shm_qp+num) = goal; - - s_unlock(key); - - { - struct global_variables* tglbl = get_otherPE_glbl(num); - if (tglbl->current_prio0 < goal->prio ) { - tglbl->par.aux.shm.queued0 = 1; - tglbl->interrupt_off0 = 0; - klic_barrier(); - tglbl->heaplimit0 = 0; - } else { - tglbl->par.aux.shm.queued0 = 1; - if (tglbl->current_prio0 < goal->prio ) { - tglbl->interrupt_off0 = 0; - klic_barrier(); - tglbl->heaplimit0 = 0; - } - } - klic_barrier(); - tglbl->par.aux.shm.queued0 = 1; - } -} - -/* *************** Copy Routines ****************************** */ - -#define ck_arg_copy(x,y) {\ - if ( isatomic(x) ) y = x;\ - else if ( isref(x) && x == (q)&(x) ) {\ - q sv;\ - makeshvar(sv);\ - y = x = last_shm_var = sv;\ - } else {\ - shm_arg_copy(&x,&y);\ - }\ -} - -#define ck_shm_arg_copy(x,y) {\ - if ( isatomic(x) ) y = x;\ - else {\ - shm_arg_copy(&x,&y);\ - }\ -} - - -extern q shm_copy(src) - q src; /* SrcAddr */ -{ - declare_globals; - q cnp; - q retval; - ENTRY: - switch(ptagof(src)) { - case CONS: - if ( is_locala(src) ) { - cnp = (q)galloc(2); - retval = makecons(cnp); - ck_arg_copy(car_of(src),car_of(retval)); - ck_arg_copy(cdr_of(src),cdr_of(retval)); - return( retval ); - } else if ( is_shma(src) ) { - if ( is_cur_or_forward_ptr(src) ) return(src); - /* shared-memory to shared-memory copy */ - cnp = (q)galloc(2); - retval = makecons(cnp); - ck_shm_arg_copy(car_of(src),car_of(retval)); - ck_shm_arg_copy(cdr_of(src),cdr_of(retval)); - return( retval ); - } else { /* assume text-area */ - return(src); - } - case ATOMIC: - return(src); - case VARREF: { - q temp = derefone(src); - if ( !isref(temp) ) { src = temp; goto ENTRY; } - if ( src == temp ) { - makeshvar(temp); - return( derefone(src) = temp ); - } else { - q temp1 = derefone(temp); - if ( !isref(temp1) ) { src = temp; goto ENTRY; } - if ( src == temp1 ) { - declare_globals; - if ( is_shma(src) ) { /* shared memory */ - if ( is_cur_or_forward_ptr(src) ) { - return( src ); - } else { /* Shared-memory to shared-memory movement */ - q svar; - struct generator_susp* vcell; - struct generator_object* addi; - Shvar* gvar; - addi = n_lock(src,temp); - if ( derefone(src) != temp ) goto ENTRY; - svar = (q)galloc((sizeof(struct generator_susp)/sizeof(q))+1); - vcell = (struct generator_susp*)(((q*)svar)+1); - vcell->backpt = (q)svar; - derefone(svar) = (q)vcell; - gvar = (Shvar*)untag_generator_susp(addi); - if ( !gvar->chain ) { - vcell->u.o = tag_generator_susp(pSHM_VAR); - klic_barrier(); - derefone(src) = svar; - return(svar); - } - if ( is_cur_or_forward_ptr(gvar) ) { - vcell->u.o = tag_generator_susp(gvar); - klic_barrier(); - derefone(src) = svar; - return(svar); - } else { - Sinfo* dptr; - Sinfo* sptr; - Shvar* svar = (Shvar*)galloc((sizeof(Shvar)/sizeof(q))); - vcell->u.o = tag_generator_susp(svar); - svar->method = SHM_VAR; - dptr = (Sinfo*)&(svar->chain); - sptr = gvar->chain; - if ( !is_genhook(sptr) ) { - while(sptr && !is_cur_or_forward_ptr(sptr)) { - dptr->next = (Sinfo*)galloc((sizeof(Sinfo)/sizeof(q))); - dptr = dptr->next; - dptr->PE_num = sptr->PE_num; - dptr->prio = sptr->prio; - dptr->indp = sptr->indp; - sptr = sptr->next; - } - dptr->next = sptr; - } else { - if ( !is_cur_or_forward_ptr(sptr) ) { - Sinfo* addr = (Sinfo*)galloc((sizeof(Sinfo)/sizeof(q))); - sptr = untag_genhook(sptr); - dptr->next = tag_genhook(addr); - dptr = addr; - dptr->next = 0; - dptr->PE_num = sptr->PE_num; - dptr->prio = sptr->prio; - dptr->indp = sptr->indp; - } else { - dptr->next = sptr; - } - } - } - klic_barrier(); - derefone(src) = svar; - return( svar ); - } - } else { /* local memory */ - Shvar* hobj; - struct susprec *sp = (struct susprec *)temp; - makeshvar(retval); - if ( is_generator_susp(sp->u) ) { - hobj = create_genhook(tag_local(src),retval); - } else { - hobj = shm_add_consumer(retval,0,src,glbl); - } - *(((struct generator_object**)retval+2)) = tag_generator_susp(hobj); - return( retval ); - } - } - src = temp; - goto ENTRY; - } - } - default: - { q f = functor_of(src); - int i,arity; - - if ( is_locala(src) ) { - if ( isref(f) ) { - struct data_object *obj - = (struct data_object *)functorp(src); - /* abend("Copied data object into shared memory!!!"); */ - return( generic_shmcopy(obj) ); - } - arity = arityof(f); - cnp = (q)galloc(arity+1); - retval = makefunctor(cnp); - ((struct functor*)cnp)->functor = functorp(src)->functor; - for(i=0;iargs[i],((struct functor*)cnp)->args[i]); - } - return( retval ); - } else if ( is_shma(src) ) { - if ( is_cur_or_forward_ptr(src) ) return( src ); - /* Shared-memory to shared-memory movement */ - if ( isref(f) ) { - struct data_object *obj - = (struct data_object *)functorp(src); - /* abend("Copied data object into shared memory!!!"); */ - return( generic_shmcopy(obj) ); - } - arity = arityof(f); - cnp = (q)galloc(arity+1); - retval = makefunctor(cnp); - ((struct functor*)cnp)->functor = functorp(src)->functor; - for(i=0;iargs[i],((struct functor*)cnp)->args[i]); - } - return( retval ); - } else { /* assume text-area */ - return( src ); - } - } - } -} - -/* shm_arg_copy(SrcAddr,DistAddr) - copy data into shared memory recursively -*/ -extern void -shm_arg_copy(srcp, distp) - q* srcp; - q* distp; -{ - declare_globals; - q src,cnp; - int i; - - ENTRY: - src = *srcp; - switch(ptagof(src)) { - case CONS: - if ( is_locala(src) ) { - cnp = (q)galloc(2); - *distp = makecons(cnp); - shm_arg_copy(&car_of(src),&(((struct cons*)cnp)->car)); - distp = &(((struct cons*)cnp)->cdr); - srcp = &cdr_of(src); - goto ENTRY; - } else if ( is_shma(src) ) { - if ( is_cur_or_forward_ptr(src) ) { *distp = src; return; } - cnp = (q)galloc(2); - shm_arg_copy(&car_of(src),&(((struct cons*)cnp)->car)); - shm_arg_copy(&cdr_of(src),&(((struct cons*)cnp)->cdr)); - klic_barrier(); - *distp = *srcp = makecons(cnp); /* patch */ return; - } else { /* assume text-area */ - *distp = src; return; - } - case ATOMIC: - *distp = src; - return; - case VARREF: { - q temp = derefone(src); - if ( !isref(temp) ) { srcp = (q*)src; goto ENTRY; } - if ( src == temp ) { - makeshvar(temp); - *distp = derefone(src) = temp; - return; - } else { - q temp1 = derefone(temp); - if ( !isref(temp1) ) { srcp = (q*)src; goto ENTRY; } - if ( src == temp1 ) { - declare_globals; - if ( is_shma(src) ) { /* a shared variable */ - if ( is_cur_or_forward_ptr(src) ) { - *distp = src; return; - } else { - q svar; - struct generator_susp* vcell; - struct generator_object* addi; - Shvar* gvar; - addi = n_lock(src,temp); - if ( derefone(src) != temp ) goto ENTRY; - svar = (q)galloc((sizeof(struct generator_susp)/sizeof(q))+1); - vcell = (struct generator_susp*)(((q*)svar)+1); - vcell->backpt = (q)svar; - derefone(svar) = (q)vcell; - gvar = (Shvar*)untag_generator_susp(addi); - if ( !gvar->chain ) { - vcell->u.o = tag_generator_susp(pSHM_VAR); - klic_barrier(); - derefone(src) = svar; - *distp = svar; - return; - } - if ( is_cur_or_forward_ptr(gvar) ) { - vcell->u.o = tag_generator_susp(gvar); - klic_barrier(); - derefone(src) = svar; - *distp = svar; - return; - } else { - Sinfo* dptr; - Sinfo* sptr; - Shvar* svar = (Shvar*)galloc((sizeof(Shvar)/sizeof(q))); - vcell->u.o = tag_generator_susp(svar); - svar->method = SHM_VAR; - dptr = (Sinfo*)&(svar->chain); - sptr = gvar->chain; - if ( !is_genhook(sptr) ) { - while(sptr && !is_cur_or_forward_ptr(sptr)) { - dptr->next = (Sinfo*)galloc((sizeof(Sinfo)/sizeof(q))); - dptr = dptr->next; - dptr->PE_num = sptr->PE_num; - dptr->prio = sptr->prio; - dptr->indp = sptr->indp; - sptr = sptr->next; - } -