--- /dev/null
+OBJS= alloc.o reclaim.o allochblk.o misc.o mach_dep.o mark_roots.o
+# add rt_allocobj.o for RT version
+
+SRCS= reclaim.c allochblk.c misc.c alloc.c mach_dep.c rt_allocobj.s mips_mach_dep.s mark_roots.c
+
+CFLAGS= -O
+
+# Set SPECIALCFLAGS to -q nodirect_code on Encore.
+# On Sun systems under 4.0, it's probably safer to link with -Bstatic.
+# I'm not sure that all static data will otherwise be found.
+# It also makes sense to replace -O with -O4, though it doesn't appear
+# to make much difference.
+
+SPECIALCFLAGS =
+
+all: gc.a gctest
+
+$(OBJS): gc.h
+
+gc.a: $(OBJS)
+ ar ru gc.a $(OBJS)
+ ranlib gc.a
+
+# mach_dep.c doesn't like optimization
+# On a MIPS machine, move mips_mach_dep.s to mach_dep.s and remove
+# mach_dep.c as well as the following two lines from this Makefile
+# On an IBM RS6000, do the same thing with rs6000_mach_dep.s. Notice
+# that the assembly language interface to the allocator is not completely
+# implemented on an RS6000.
+mach_dep.o: mach_dep.c
+ cc -c ${SPECIALCFLAGS} mach_dep.c
+
+clean:
+ rm -f gc.a test.o cons.o gctest output-local output-diff $(OBJS)
+
+test.o: cons.h test.c
+
+cons.o: cons.h cons.c
+
+# On a MIPS system, the BSD version of libc.a should be used to get
+# sigsetmask. I found it necessary to link against the system V
+# library first, to get a working version of fprintf. But this may have
+# been due to my failure to find the right version of stdio.h or some
+# such thing.
+gctest: test.o cons.o gc.a
+ cc $(CFLAGS) -o gctest test.o cons.o gc.a
+
+setjmp_test: setjmp_test.c gc.h
+ cc -o setjmp_test -O setjmp_test.c
+
+test: setjmp_test gctest
+ ./setjmp_test
+ @echo "WARNING: for GC test to work, all debugging output must be turned off"
+ rm -f output-local
+ ./gctest > output-local
+ -diff correct-output output-local > output-diff
+ -@test -s output-diff && echo 'Output of program "gctest" is not correct. GC does not work.' || echo 'Output of program "gctest" is correct. GC probably works.'
+
+shar:
+ makescript -o gc.shar README Makefile gc.h ${SRCS} test.c cons.c cons.h
--- /dev/null
+Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+Copyright (c) 1991 by Xerox Corporation. All rights reserved.
+
+THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+
+Permission is hereby granted to copy this garbage collector for any purpose,
+provided the above notices are retained on all copies.
+
+
+This is version 1.9.
+
+HISTORY -
+
+ This collector was developed as a part of research projects supported in
+part by the National Science Foundation and the Defense Advance Research
+Projects Agency. The SPARC specific code was contributed by Mark Weiser
+(weiser.pa@xerox.com). The Encore Multimax modifications were supplied by
+Kevin Kenny (kenny@m.cs.uiuc.edu). The adaptation to the RT is largely due
+to Vernon Lee (scorpion@rice.edu), on machines made available by IBM.
+The HP specific code and a number of good suggestions for improving the
+generic code are due to Walter Underwood (wunder@hp-ses.sde.hp.com).
+Robert Brazile (brazile@diamond.bbn.com) supplied the ULTRIX code.
+(Blame for misinstallation of those modifications goes to the first author,
+however.) Some of the improvements incorporated in this version were
+suggested by David Chase, then at Olivetti Research.
+
+ This is intended to be a general purpose, garbage collecting storage
+allocator. The algorithms used are described in:
+
+Boehm, H., and M. Weiser, "Garbage Collection in an Uncooperative Environment",
+Software Practice & Experience, September 1988, pp. 807-820.
+
+ Many of the ideas underlying the collector have previously been explored
+by others. (We discovered recently that Doug McIlroy wrote a more or less
+similar collector that is part of version 8 UNIX (tm).) However none of this
+work appears to have been widely disseminated.
+
+ The tools for detecting storage leaks described in the above paper
+are not included here. There is some hope that they might be released
+by Xerox in the future.
+
+
+GENERAL DESCRIPTION
+
+ Since the collector does not require pointers to be tagged, it does not
+attempt to insure that all inaccessible storage is reclaimed. However,
+in our experience, it is typically more successful at reclaiming unused
+memory than most C programs using explicit deallocation.
+
+ In the following, an "object" is defined to be a region of memory allocated
+by the routines described below.
+
+ Any objects not intended to be collected must be pointed to either
+from other such accessible objects, or from the registers,
+stack, data, or statically allocated bss segments. It is usually assumed
+that all such pointers point to the beginning of the object. (This does
+not disallow interior pointers; it simply requires that there must be a
+pointer to the beginning of every accessible object, in addition to any
+interior pointers. Conditionally compiled code to check for pointers to the
+interiors of objects is supplied. As explained in "gc.h", this
+may create other problems, but on modern machines requiring 32-bit-aligned
+pointers, this is often acceptable.)
+
+ Note that pointers inside memory allocated by the standard "malloc" are not
+seen by the garbage collector. Thus objects pointed to only from such a
+region may be prematurely deallocated. It is thus suggested that the
+standard "malloc" be used only for memory regions, such as I/O buffers, that
+are guaranteed not to contain pointers. Pointers in C language automatic,
+static, or register variables, are correctly recognized.
+
+ The collector does not understand SunOS 4.x dynamic libraries. Space
+allocated by the dynamic linker past at addresses higher than "_end" will not
+be seen by the collector. (We have not had a chance to track down exactly
+what ends up there. Some data does. If we understood exactly where things
+ended up, it would probably be easy to fix this problem.) When in doubt,
+use -Bstatic.
+
+ The collector is designed to minimize stack growth if list-like structures
+store the link in their first field; for example
+
+ struct list_node {
+ struct list_node * link; /* first field */
+ ...
+ };
+
+instead of
+
+ struct list_node {
+ ...
+ struct list_node * link; /* last field */
+ };
+
+ This should not matter for lists that are less than tens of thousands
+of elements long.
+
+ Signal processing for most signals is deferred during collection. (The
+necessary calls to sigsetmask may need to be commented out under a pure
+system V implementation, since there does not seem to be an equivalent
+call. Multiple calls to signal are likely to be slow.)
+
+INSTALLATION AND PORTABILITY
+
+ As distributed, the collector produces garbage collection statistics
+during every collection. Once the collector is known to operate properly,
+these can be suppressed by defining the macro SILENT at the top
+of "gc.h". (The given statistics exhibit a few peculiarities.
+Things don't appear to add up for a variety of reasons, most notably
+fragmentation losses. These are probably much more significant for the
+contrived program "test.c" than for your application.)
+
+ Note that typing "make test" will automatically compare the output
+of the test program against the correct output. This does require that
+collection statistics have been disabled.
+
+ The Makefile will generate a library gc.a which you should link against.
+It is suggested that if you need to replace a piece of the collector
+(e.g. mark_roots.c) you simply list your version ahead of gc.a on the
+ld command line, rather than replacing the one in gc.a.
+
+ The collector currently is designed to run essentially unmodified on
+the following machines:
+
+ Sun 3
+ Sun 4 (except under some versions of 3.2)
+ Vax under Berkeley UNIX
+ Sequent Symmetry (no concurrency)
+ Encore Multimax (no concurrency)
+ MIPS M/120 (and presumably M/2000) (RISC/os 4.0 with BSD libraries)
+ IBM PC/RT (Berkeley UNIX)
+ IBM RS/6000
+ HP9000/300
+
+ For these machines you should check the beginning of gc.h
+to verify that the machine type is correctly defined. On an Encore Multimax,
+MIPS M/120, or a PC/RT, you will also need to make changes to the
+Makefile, as described by comments there.
+
+ In all cases we assume that pointer alignment is consistent with that
+enforced by the standard C compilers. If you use a nonstandard compiler
+you may have to adjust the alignment parameters defined in gc.h.
+
+ On a MIPS machine or PC/RT, we assume that no calls to sbrk occur during a
+collection. (This is necessary due to the way stack expansion works on these
+machines.) This may become false if certain kinds of I/O calls are inserted
+into the collector.
+
+ For machines not already mentioned, or for nonstandard compilers, the
+following are likely to require change:
+
+1. The parameters at the top of gc.h and the definition of
+ TMP_POINTER_MASK further down in the same file.
+
+2. mach_dep.c.
+ The most important routine here is one to mark from registers.
+ The distributed file includes a generic hack (based on setjmp) that
+ happens to work on many machines, and may work on yours. Try
+ compiling and running setjmp_test.c to see whether it has a chance of
+ working. (This is not correct C, so don't blame your compiler if it
+ doesn't work. Based on limited experience, register window machines
+ are likely to cause trouble. If your version of setjmp claims that
+ all accessible variables, including registers, have the value they
+ had at the time of the longjmp, it also will not work. Vanilla 4.2 BSD
+ makes such a claim. SunOS does not.)
+ This file also contains interface routines that save registers
+ not normally preserved by the C compiler. These are intended for
+ a fast assembly language interface to the allocator, such as the
+ one that is used by the Russell compiler. (These routines work
+ only for small objects. A call to one of these routines ensures
+ that the free list for a particular object size is nonempty. Normally
+ in-line code would call these routines only after finding an empty free
+ list for an about-to-be-allocated object size.) If a pure C interface
+ is used, these routines are not needed.
+ If your machine does not allow in-line assembly code, or if you prefer
+ not to use such a facility, mach_dep.c may be replaced by a .s file
+ (as we did for the MIPS machine and the PC/RT).
+
+3. mark_roots.c.
+ These are the top level mark routines that determine which sections
+ of memory the collector should mark from. This is normally not
+ architecture specific (aside from the macros defined in gc.h and
+ referenced here), but it can be programming language and compiler
+ specific. The supplied routine should work for most C compilers
+ running under UNIX.
+
+4. The sigsetmask call does not appear to exist under system V UNIX.
+ It is used by the collector to block and unblock signals at times at
+ which an asynchronous allocation inside a signal handler could not
+ be tolerated. Under system V, it is possible to remove these calls,
+ provided no storage allocation is done by signal handlers. The
+ alternative is to issue a sequence of system V system calls, one per
+ signal that is actually used. This may be a bit slow.
+
+ For a different versions of Berkeley UN*X or different machines using the
+Motorola 68000, Vax, SPARC, 80386, NS 32000, PC/RT, or MIPS architecture,
+it should frequently suffice to change definitions in gc.h.
+
+
+THE C INTERFACE TO THE ALLOCATOR
+
+ The following routines are intended to be directly called by the user.
+Note that only gc_malloc and gc_init are necessary. Gc_realloc is provided
+for applications that already use realloc. The remaining routines are used
+solely to enhance performance. It is suggested that they be used only after
+initial debugging.
+
+1) gc_init()
+ - called once before allocation to initialize the collector.
+
+2) gc_malloc(nbytes)
+ - allocate an object of size nbytes. Unlike malloc, the object is
+ cleared before being returned to the user. (For even better performance,
+ it may help to expand the relevant part of gc_malloc in line.
+ This is done by the Russell compiler, for example.) Gc_malloc will
+ invoke the garbage collector when it determines this to be appropriate.
+ (A number of previous collector bugs resulted in objects not getting
+ completely cleared. We claim these are all fixed. But if you encounter
+ problems, this is a likely source to check for. The collector tries
+ hard to avoid clearing any words that it doesn't have to. Thus this
+ is a bit subtle.) Gc_malloc fails (generates a segmentation fault)
+ if it is called with a 0 argument.
+
+3) gc_malloc_atomic(nbytes)
+ - allocate an object of size nbytes that is guaranteed not to contain any
+ pointers. The returned object is not guaranteed to be cleeared.
+ (Can always be replaced by gc_malloc, but results in faster collection
+ times. The collector will probably run faster if large character
+ arrays, etc. are allocated with gc_malloc_atomic than if they are
+ statically allocated.)
+
+4) gc_realloc(object, new_size)
+ - change the size of object to be new_size. Returns a pointer to the
+ new object, which may, or may not, be the same as the pointer to
+ the old object. The new object is taken to be atomic iff the old one
+ was. If the new object is composite and larger than the original object,
+ then the newly added bytes are cleared (we hope). This is very likely
+ to allocate a new object, unless MERGE_SIZES is defined in gc.h.
+ Even then, it is likely to recycle the old object only if the object
+ is grown in small additive increments (which, we claim, is generally bad
+ coding practice.)
+
+5) gc_free(object)
+ - explicitly deallocate an object returned by gc_malloc or
+ gc_malloc_atomic. Not necessary, but can be used to minimize
+ collections if performance is critical.
+
+6) expand_hp(number_of_4K_blocks)
+ - Explicitly increase the heap size. (This is normally done automatically
+ if a garbage collection failed to reclaim enough memory. Explicit
+ calls to expand_hp may prevent unnecessarily frequent collections at
+ program startup.)
+
+ The global variable dont_gc can be set to a non-zero value to inhibit
+collections, e.g. during a time-critical section of code. (This may cause
+otherwise unnecessary expansion of the process' memory.)
+
+ The variable non_gc_bytes, which is normally 0, may be changed to reflect
+the amount of memory allocated by the above routines that should not be
+considered as a candidate for collection. Collections are inhibited
+if this exceeds a given fraction (currently 3/4) of the total heap size.
+The heap is simply expanded instead. Careless use may, of course, result
+in excessive memory consumption.
+
+ Some additional tuning is possible through the parameters defined
+near the top of gc.h.
+
+ The two gc_malloc routines may be declared to return a suitable pointer
+type. It is not intended that gc.h be included by the user program.
+If only gc_malloc is intended to be used, it might be appropriate to define:
+
+#define malloc(n) gc_malloc(n)
+#define calloc(m,n) gc_malloc((m)*(n))
+
+ More complete emulations of the standard C allocation routines are
+contained and described in "interface.c" (contributed by David Chase).
+
+ No attempt is made to use obscure names for garbage collector routines
+and data structures. Name conflicts are possible. (Running "nm gc.a"
+should identify names to be avoided.)
+
+
+ASSEMBLY LANGUAGE INTERFACE
+
+ There is a provision for a very fast assembly language and/or in-line
+C interface. See the beginning comments in alloc.c. On some architectures,
+additional code must be supplied near the beginning of mach_dep.c for
+this to work. Using an assembly language interface, and partially
+expanding the allocation code in-line, most allocations will take on the
+order of 4 or 5 instructions each. (Explicit deallocations can be kept
+down to something similar if the object is atomic and of known size.
+Note that in-line deallocation code for composite objects should clear
+the object before returning it to the appropriate free list.)
+
+USE AS LEAK DETECTOR:
+
+ The collector may be used to track down leaks in C programs that are
+intended to run with malloc/free (e.g. code with extreme real-time or
+portability constraints). To do so define FIND_LEAK somewhere in gc.h.
+This will cause the collector to invoke the report_leak routine defined
+near the top of reclaim.c whenever an inaccessible object is found that has
+not been explicitly freed.
+ Productive use of this facility normally involves redefining report_leak
+to do something more intelligent. This typically requires annotating
+objects with additional information (e.g. creation time stack trace) that
+identifies their origin. Such code is typically not very portable, and is
+not included here.
+
+
+BUGS
+
+ Recently fixed bugs:
+
+ Version 1.3 and immediately preceding versions contained spurious
+assembly language assignments to TMP_SP. Only the assignment in the PC/RT
+code is necessary. On other machines, with certain compiler options,
+the assignments can lead to an unsaved register being overwritten.
+Known to cause problems under SunOS 3.5 WITHOUT the -O option. (With
+-O the compiler recognizes it as dead code. It probably shouldn't,
+but that's another story.)
+
+ Version 1.4 and earlier versions used compile time determined values
+for the stack base. This no longer works on Sun 3s, since Sun 3/80s use
+a different stack base. We now use a straightforward heuristic on all
+machines on which it is known to work (incl. Sun 3s) and compile-time
+determined values for the rest. There should really be library calls
+to determine such values.
+
+ Version 1.5 and earlier did not ensure 8 byte alignment for objects
+allocated on a sparc based machine.
+
+ Please address bug reports to boehm@xerox.com. If you are contemplating
+a major addition, you might also send mail to ask whether it's already
+been done.
+
+ Version 1.8 added ULTRIX support in gc.h.
+
+ Version 1.9 fixed a serious realloc bug. Expanding a large pointerful
+object by a small amount could result in pointers in the added section
+not getting scanned.
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991 by Xerox Corporation. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to copy this compiler for any purpose,
+ * provided the above notices are retained on all copies.
+ *
+ * This file contains the functions:
+ * void new_hblk(n)
+ * static void clear_marks()
+ * mark(alignment)
+ * mark_all(b,t,alignment)
+ * void gcollect()
+ * expand_hp: func[val Short] val Void
+ * struct obj * _allocobj(sz)
+ * struct obj * _allocaobj(sz)
+ */
+
+
+# include <stdio.h>
+# include <signal.h>
+# include <sys/types.h>
+# include <sys/times.h>
+# include "gc.h"
+
+/* Leaving these defined enables output to stderr. In order of */
+/* increasing verbosity: */
+#define REPORT_FAILURE /* Print values that looked "almost" like pointers */
+#undef REPORT_FAILURE
+#define DEBUG /* Verbose debugging output */
+#undef DEBUG
+#define DEBUG2 /* EXTREMELY verbose debugging output */
+#undef DEBUG2
+#define USE_STACK /* Put mark stack onto process stack. This assumes */
+ /* that it's safe to put data below the stack ptr, */
+ /* and that the system will expand the stack as */
+ /* necessary. This is known to be true under Sun */
+ /* UNIX (tm) and Vax Berkeley UNIX. It is also */
+ /* known to be false under some other UNIX */
+ /* implementations. */
+#undef USE_HEAP
+#ifdef RT
+# define USE_HEAP
+# undef USE_STACK
+#endif
+#ifdef MIPS
+# define USE_HEAP
+# undef USE_STACK
+#endif
+
+/*
+ * This is an attempt at a garbage collecting storage allocator
+ * that should run on most UNIX systems. The garbage
+ * collector is overly conservative in that it may fail to reclaim
+ * inaccessible storage. On the other hand, it does not assume
+ * any runtime tag information.
+ * We make the following assumptions:
+ * 1. We are running under something that looks like Berkeley UNIX,
+ * on one of the supported architectures.
+ * 2. For every accessible object, a pointer to it is stored in
+ * a) the stack segment, or
+ * b) the data or bss segment, or
+ * c) the registers, or
+ * d) an accessible block.
+ *
+ */
+
+/*
+ * Separate free lists are maintained for different sized objects
+ * up to MAXOBJSZ or MAXAOBJSZ.
+ * The lists objfreelist[i] contain free objects of size i which may
+ * contain nested pointers. The lists aobjfreelist[i] contain free
+ * atomic objects, which may not contain nested pointers.
+ * The call allocobj(i) insures that objfreelist[i] points to a non-empty
+ * free list it returns a pointer to the first entry on the free list.
+ * Allocobj may be called to allocate an object of (small) size i
+ * as follows:
+ *
+ * opp = &(objfreelist[i]);
+ * if (*opp == (struct obj *)0) allocobj(i);
+ * ptr = *opp;
+ * *opp = ptr->next;
+ *
+ * The call to allocobj may be replaced by a call to _allocobj if it
+ * is made from C, or if C register save conventions are sufficient.
+ * Note that this is very fast if the free list is non-empty; it should
+ * only involve the execution of 4 or 5 simple instructions.
+ * All composite objects on freelists are cleared, except for
+ * their first longword.
+ */
+
+/*
+ * The allocator uses allochblk to allocate large chunks of objects.
+ * These chunks all start on addresses which are multiples of
+ * HBLKSZ. All starting addresses are maintained on a contiguous
+ * list so that they can be traversed in the sweep phase of garbage collection.
+ * This makes it possible to check quickly whether an
+ * arbitrary address corresponds to an object administered by the
+ * allocator.
+ * We make the (probably false) claim that this can be interrupted
+ * by a signal with at most the loss of some chunk of memory.
+ */
+
+/* Declarations for fundamental data structures. These are grouped */
+/* together, so that the collector can skip over them. */
+/* This relies on some assumptions about the compiler that are not */
+/* guaranteed valid, but ... */
+
+long heapsize = 0; /* Heap size in bytes */
+
+long non_gc_bytes = 0; /* Number of bytes not intended to be collected */
+
+char copyright[] = "Copyright 1988,1989 Hans-J. Boehm and Alan J. Demers";
+char copyright2[] =
+ "Copyright (c) 1991 by Xerox Corporation. All rights reserved.";
+char copyright3[] =
+ "THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY";
+char copyright4[] =
+ " EXPRESSED OR IMPLIED. ANY USE IS AT YOUR OWN RISK.";
+
+/* Return a rough approximation to the stack pointer. A hack, */
+/* but it's semi-portable. */
+word * get_current_sp()
+{
+ word x;
+ return(&x);
+}
+
+/*
+ * Allocate a new heapblock for objects of size n.
+ * Add all of the heapblock's objects to the free list for objects
+ * of that size. A negative n requests atomic objects.
+ */
+void new_hblk(n)
+long n;
+{
+ register word *p,
+ *r;
+ word *last_object; /* points to last object in new hblk */
+ register struct hblk *h; /* the new heap block */
+ register long abs_sz; /* |n| */
+ register int i;
+
+# ifdef PRINTSTATS
+ if ((sizeof (struct hblk)) > HBLKSIZE) {
+ abort("HBLK SZ inconsistency");
+ }
+# endif
+
+ /* Allocate a new heap block */
+ h = allochblk(n);
+
+ /* Add it to hblklist */
+ add_hblklist(h);
+
+ /* Add objects to free list */
+ abs_sz = abs(n);
+ p = &(h -> hb_body[abs_sz]); /* second object in *h */
+ r = &(h -> hb_body[0]); /* One object behind p */
+ last_object = ((word *)((char *)h + HBLKSIZE)) - abs_sz;
+ /* Last place for last object to start */
+
+ /* make a list of all objects in *h with head as last object */
+ while (p <= last_object) {
+ /* current object's link points to last object */
+ ((struct obj *)p) -> obj_link = (struct obj *)r;
+ r = p;
+ p += abs_sz;
+ }
+ p -= abs_sz; /* p now points to last object */
+
+ /*
+ * put p (which is now head of list of objects in *h) as first
+ * pointer in the appropriate free list for this size.
+ */
+ if (n < 0) {
+ ((struct obj *)(h -> hb_body)) -> obj_link = aobjfreelist[abs_sz];
+ aobjfreelist[abs_sz] = ((struct obj *)p);
+ } else {
+ ((struct obj *)(h -> hb_body)) -> obj_link = objfreelist[abs_sz];
+ objfreelist[abs_sz] = ((struct obj *)p);
+ }
+
+ /*
+ * Set up mask in header to facilitate alignment checks
+ * See "gc.h" for a description of how this works.
+ */
+# ifndef RT
+ switch (abs_sz) {
+ case 1:
+ h -> hb_mask = 0x3;
+ break;
+ case 2:
+ h -> hb_mask = 0x7;
+ break;
+ case 4:
+ h -> hb_mask = 0xf;
+ break;
+ case 8:
+ h -> hb_mask = 0x1f;
+ break;
+ case 16:
+ h -> hb_mask = 0x3f;
+ break;
+ /* By default it remains set to a negative value */
+ }
+# else
+ /* the 4.2 pcc C compiler did not produce correct code for the switch */
+ if (abs_sz == 1) { h -> hb_mask = 0x3; }
+ else if (abs_sz == 2) { h -> hb_mask = 0x7; }
+ else if (abs_sz == 4) { h -> hb_mask = 0xf; }
+ else if (abs_sz == 8) { h -> hb_mask = 0x1f; }
+ else if (abs_sz == 16) { h -> hb_mask = 0x3f; }
+ /* else skip; */
+# endif
+
+# ifdef DEBUG
+ gc_printf("Allocated new heap block at address 0x%X\n",
+ h);
+# endif
+}
+
+
+/* some more variables */
+
+extern long mem_found; /* Number of reclaimed longwords */
+ /* after garbage collection */
+
+extern long atomic_in_use, composite_in_use;
+extern errno;
+
+/*
+ * Clear mark bits in all allocated heap blocks
+ */
+static void clear_marks()
+{
+ register int j;
+ register struct hblk **p;
+ register struct hblk *q;
+
+# ifdef HBLK_MAP
+ for (q = (struct hblk *) heapstart; ((char*)q) < heaplim; q++)
+ if (is_hblk(q)) {
+# else
+ for (p = hblklist; p < last_hblk; p++) {
+ q = *p;
+# endif
+ for (j = 0; j < MARK_BITS_SZ; j++) {
+ q -> hb_marks[j] = 0;
+ }
+ }
+}
+
+/* Limits of stack for mark routine. Set by caller to mark. */
+/* All items between mark_stack_top and mark_stack_bottom-1 still need */
+/* to be marked. All items on the stack satisfy quicktest. They do */
+/* not necessarily reference real objects. */
+word * mark_stack_bottom;
+word * mark_stack_top;
+
+#ifdef USE_STACK
+# define STACKGAP 1024 /* Gap in longwords between hardware stack and */
+ /* the mark stack. */
+ /* Must suffice for printf calls and signal */
+ /* handling. */
+#endif
+
+
+#ifdef USE_STACK
+# define PUSH_MS(ptr) *(--mark_stack_top) = (word) ptr
+# define NOT_DONE(a,b) (a < b)
+#else
+# ifdef USE_HEAP
+ char *cur_break = 0;
+
+# define STACKINCR 0x4000
+# define PUSH_MS(ptr) \
+ mark_stack_top++; \
+ if ((char*)mark_stack_top >= cur_break) { \
+ if (sbrk(STACKINCR) == -1) { \
+ fprintf(stderr, "sbrk failed, code = %d\n",errno); \
+ exit(1); \
+ } else { \
+ cur_break += STACKINCR; \
+ } \
+ } \
+ *mark_stack_top = (word) ptr
+# define NOT_DONE(a,b) (a > b)
+# else
+ --> where does the mark stack go? <--
+# endif
+#endif
+
+
+/* Mark all objects corresponding to pointers between mark_stack_bottom */
+/* and mark_stack_top. Assume that nested pointers are aligned */
+/* on alignment-byte boundaries. */
+mark(alignment)
+int alignment;
+{
+ register long sz;
+ extern char end, etext;
+ register struct obj *p; /* pointer to current object to be marked */
+
+ while (NOT_DONE(mark_stack_top,mark_stack_bottom)) {
+ register long word_no;
+ register long mask;
+ register struct hblk * h;
+
+# ifdef USE_STACK
+ p = (struct obj *)(*mark_stack_top++);
+# else
+# ifdef USE_HEAP
+ p = (struct obj *)(*mark_stack_top--);
+# else
+ --> fixit <--
+# endif
+# endif
+
+ /* if not a pointer to obj on heap, skip it */
+ if (((char *) p) >= heaplim) {
+ continue;
+ }
+
+ h = HBLKPTR(p);
+
+# ifndef INTERIOR_POINTERS
+ /* Check mark bit first, since this test is much more likely to */
+ /* fail than later ones. */
+ word_no = ((word *)p) - ((word *)h);
+ if (mark_bit(h, word_no)) {
+ continue;
+ }
+# endif
+
+# ifdef INTERIOR_POINTERS
+ if (!is_hblk(h)) {
+ char m = get_map(h);
+ while (m > 0 && m < 0x7f) {
+ h -= m;
+ m = get_map(h);
+ }
+ if (m == HBLK_INVALID) {
+# ifdef REPORT_FAILURE
+ gc_printf("-> Pointer to non-heap loc: %X\n", p);
+# endif
+ continue;
+ }
+ }
+ if (((long)p) - ((long)h) < sizeof (struct hblkhdr)) {
+ continue;
+ }
+# else
+ if (!is_hblk(h)) {
+# ifdef REPORT_FAILURE
+ gc_printf("-> Pointer to non-heap loc: %X\n", p);
+# endif
+ continue;
+ }
+# endif
+ sz = HB_SIZE(h);
+ mask = h -> hb_mask;
+
+# ifdef INTERIOR_POINTERS
+ word_no = get_word_no(p,h,sz,mask);
+# else
+ if (!is_proper_obj(p,h,sz,mask)) {
+# ifdef REPORT_FAILURE
+ gc_printf("-> Bad pointer to heap block: %X,sz = %d\n",p,sz);
+# endif
+ continue;
+ }
+# endif
+
+ if (word_no + sz > BYTES_TO_WORDS(HBLKSIZE)
+ && word_no != BYTES_TO_WORDS(sizeof(struct hblkhdr))
+ /* Not first object */) {
+ /*
+ * Note that we dont necessarily check for pointers to the block header.
+ * This doesn't cause any problems, since we have mark
+ * bits allocated for such bogus objects.
+ * We have to check for references past the last object, since
+ * marking from uch an "object" could cause an exception.
+ */
+# ifdef REPORT_FAILURE
+ gc_printf("-> Bad pointer to heap block: %X,sz = %d\n",p,sz);
+# endif
+ continue;
+ }
+
+# ifdef INTERIOR_POINTERS
+ if (mark_bit(h, word_no)) {
+ continue;
+ }
+# endif
+
+# ifdef DEBUG2
+ gc_printf("*** set bit for heap %x, word %x\n",h,word_no);
+# endif
+ set_mark_bit(h, word_no);
+ if (h -> hb_sz < 0) {
+ /* Atomic object */
+ continue;
+ }
+ {
+ /* Mark from fields inside the object */
+ register struct obj ** q;
+ register struct obj * r;
+ register long lim; /* Should be struct obj **, but we're out of */
+ /* A registers on a 68000. */
+
+# ifdef INTERIOR_POINTERS
+ /* Adjust p, so that it's properly aligned */
+# ifdef DEBUG
+ if (p != ((struct obj *)(((word *)h) + word_no))) {
+ gc_printf("Adjusting from %X to ", p);
+ p = ((struct obj *)(((word *)h) + word_no));
+ gc_printf("%X\n", p);
+ } else {
+ p = ((struct obj *)(((word *)h) + word_no));
+ }
+# else
+ p = ((struct obj *)(((word *)h) + word_no));
+# endif
+# endif
+# ifdef UNALIGNED
+ lim = ((long)(&(p -> obj_component[sz]))) - 3;
+# else
+ lim = (long)(&(p -> obj_component[sz]));
+# endif
+ for (q = (struct obj **)(&(p -> obj_component[0]));
+ q < (struct obj **)lim;) {
+ r = *q;
+ if (quicktest(r)) {
+# ifdef DEBUG2
+ gc_printf("Found plausible nested pointer");
+ gc_printf(": 0x%X inside 0x%X at 0x%X\n", r, p, q);
+# endif
+ PUSH_MS(((word)r));
+ }
+# ifdef UNALIGNED
+ q = ((struct obj **)(((long)q)+alignment));
+# else
+ q++;
+# endif
+ }
+ }
+ }
+}
+
+
+/*********************************************************************/
+/* Mark all locations reachable via pointers located between b and t */
+/* b is the first location to be checked. t is one past the last */
+/* location to be checked. */
+/* Assume that pointers are aligned on alignment-byte */
+/* boundaries. */
+/*********************************************************************/
+void mark_all(b, t, alignment)
+word * b;
+word * t;
+int alignment;
+{
+ register word *p;
+ register word r;
+ register word *lim;
+
+# ifdef DEBUG
+ gc_printf("Checking for pointers between 0x%X and 0x%X\n",
+ b, t);
+# endif
+
+ /* Allocate mark stack, leaving a hole below the real stack. */
+# ifdef USE_STACK
+ mark_stack_bottom = get_current_sp() - STACKGAP;
+ mark_stack_top = mark_stack_bottom;
+# else
+# ifdef USE_HEAP
+ mark_stack_bottom = (word *) sbrk(0); /* current break */
+ cur_break = (char *) mark_stack_bottom;
+ mark_stack_top = mark_stack_bottom;
+# else
+ -> then where should the mark stack go ? <-
+# endif
+# endif
+
+ /* Round b down so it is properly aligned */
+# ifdef UNALIGNED
+ if (alignment == 2) {
+ b = (word *)(((long) b) & ~1);
+ } else if (alignment == 4) {
+ b = (word *)(((long) b) & ~3);
+ } else if (alignment != 1) {
+ fprintf(stderr, "Bad alignment parameter to mark_all\n");
+ abort(alignment);
+ }
+# else
+ b = (word *)(((long) b) & ~3);
+# endif
+
+ /* check all pointers in range and put on mark_stack if quicktest true */
+ lim = t - 1 /* longword */;
+ for (p = b; ((unsigned) p) <= ((unsigned) lim);) {
+ /* Coercion to unsigned in the preceding appears to be necessary */
+ /* due to a bug in the 4.2BSD C compiler. */
+ r = *p;
+ if (quicktest(r)) {
+# ifdef DEBUG2
+ gc_printf("Found plausible pointer: %X\n", r);
+# endif
+ PUSH_MS(r); /* push r onto the mark stack */
+ }
+# ifdef UNALIGNED
+ p = (word *)(((char *)p) + alignment);
+# else
+ p++;
+# endif
+ }
+ if (mark_stack_top != mark_stack_bottom) mark(alignment);
+
+# ifdef USE_HEAP
+ brk(mark_stack_bottom); /* reset break to where it was before */
+ cur_break = (char *) mark_stack_bottom;
+# endif
+}
+
+/*
+ * Restore inaccessible objects to the free list
+ * update mem_found (number of reclaimed longwords after garbage collection)
+ */
+void gcollect()
+{
+ extern void mark_regs();
+
+ extern int holdsigs(); /* disables non-urgent signals - see the */
+ /* file "callcc.c" */
+
+ long Omask = 0; /* mask to restore signal mask to after
+ * critical section.
+ */
+
+# ifdef PRINTTIMES
+ /* some debugging values */
+ double start_time = 0;
+ double mark_time = 0;
+ double done_time = 0;
+ static struct tms time_buf;
+# define FTIME \
+ (((double)(time_buf.tms_utime + time_buf.tms_stime))/FLOAT_HZ)
+
+ /* Get starting time */
+ times(&time_buf);
+ start_time = FTIME;
+# endif
+
+# ifdef DEBUG2
+ gc_printf("Here we are in gcollect\n");
+# endif
+
+ /* Don't want to deal with signals in the middle so mask 'em out */
+ Omask = holdsigs();
+
+ /* Mark from all roots. */
+ mark_roots();
+
+# ifdef FIND_LEAK
+ /* Mark all objects on the free list. All objects should be */
+ /* marked when we're done. */
+ {
+ register int size; /* current object size */
+ register struct obj * p; /* pointer to current object */
+ register struct hblk * q; /* pointer to block containing *p */
+ register int word_no; /* "index" of *p in *q */
+
+ for (size = 1; size < MAXOBJSZ; size++) {
+ for (p= objfreelist[size]; p != ((struct obj *)0); p=p->obj_link){
+ q = HBLKPTR(p);
+ word_no = (((word *)p) - ((word *)q));
+ set_mark_bit(q, word_no);
+ }
+ }
+ for (size = 1; size < MAXAOBJSZ; size++) {
+ for(p= aobjfreelist[size]; p != ((struct obj *)0); p=p->obj_link){
+ q = HBLKPTR(p);
+ word_no = (((long *)p) - ((long *)q));
+ set_mark_bit(q, word_no);
+ }
+ }
+ }
+ /* Check that everything is marked */
+ reclaim(TRUE);
+# endif
+
+ /* Clear free list mark bits, in case they got accidentally marked */
+ /* Note: HBLKPTR(p) == pointer to head of block containing *p */
+ /* Also subtract memory remaining from mem_found count. */
+ /* Note that composite objects on free list are cleared. */
+ /* Thus accidentally marking a free list is not a problem; only */
+ /* objects on the list itself will be marked, and that's fixed here. */
+ {
+ register int size; /* current object size */
+ register struct obj * p; /* pointer to current object */
+ register struct hblk * q; /* pointer to block containing *p */
+ register int word_no; /* "index" of *p in *q */
+# ifdef REPORT_FAILURE
+ int prev_failure = 0;
+# endif
+
+ for (size = 1; size < MAXOBJSZ; size++) {
+ for (p= objfreelist[size]; p != ((struct obj *)0); p=p->obj_link){
+ q = HBLKPTR(p);
+ word_no = (((word *)p) - ((word *)q));
+# ifdef REPORT_FAILURE
+ if (!prev_failure && mark_bit(q, word_no)) {
+ gc_printf("-> Pointer to composite free list: %X,sz = %d\n",
+ p, size);
+ prev_failure = 1;
+ }
+# endif
+ clear_mark_bit(q, word_no);
+ mem_found -= size;
+ }
+# ifdef REPORT_FAILURE
+ prev_failure = 0;
+# endif
+ }
+ for (size = 1; size < MAXAOBJSZ; size++) {
+ for(p= aobjfreelist[size]; p != ((struct obj *)0); p=p->obj_link){
+ q = HBLKPTR(p);
+ word_no = (((long *)p) - ((long *)q));
+# ifdef REPORT_FAILURE
+ if (!prev_failure && mark_bit(q, word_no)) {
+ gc_printf("-> Pointer to atomic free list: %X,sz = %d\n",
+ p, size);
+ prev_failure = 1;
+ }
+# endif
+ clear_mark_bit(q, word_no);
+ mem_found -= size;
+ }
+# ifdef REPORT_FAILURE
+ prev_failure = 0;
+# endif
+ }
+ }
+
+# ifdef PRINTTIMES
+ /* Get intermediate time */
+ times(&time_buf);
+ mark_time = FTIME;
+# endif
+
+# ifdef PRINTSTATS
+ gc_printf("Bytes recovered before reclaim - f.l. count = %d\n",
+ WORDS_TO_BYTES(mem_found));
+# endif
+
+ /* Reconstruct free lists to contain everything not marked */
+ reclaim(FALSE);
+
+ /* clear mark bits in all allocated heap blocks */
+ clear_marks();
+
+# ifdef PRINTSTATS
+ gc_printf("Reclaimed %d bytes in heap of size %d bytes\n",
+ WORDS_TO_BYTES(mem_found), heapsize);
+ gc_printf("%d (atomic) + %d (composite) bytes in use\n",
+ WORDS_TO_BYTES(atomic_in_use),
+ WORDS_TO_BYTES(composite_in_use));
+# endif
+
+ /*
+ * What follows is somewhat heuristic. Constant may benefit
+ * from tuning ...
+ */
+# ifndef FIND_LEAK
+ /* In the leak finding case, we expect gcollect to be called manually */
+ /* before we're out of heap space. */
+ if (WORDS_TO_BYTES(mem_found) * 4 < heapsize) {
+ /* Less than about 1/4 of available memory was reclaimed - get more */
+ {
+ long size_to_get = HBLKSIZE + hincr * HBLKSIZE;
+ struct hblk * thishbp;
+ char * nheaplim;
+
+ thishbp = HBLKPTR(((unsigned)sbrk(0))+HBLKSIZE-1 );
+ nheaplim = (char *) (((unsigned)thishbp) + size_to_get);
+ if( ((char *) brk(nheaplim)) == ((char *)-1) ) {
+ write(2,"Out of memory, trying to continue ...\n",38);
+ } else {
+ heaplim = nheaplim;
+ thishbp->hb_sz =
+ BYTES_TO_WORDS(size_to_get - sizeof(struct hblkhdr));
+ freehblk(thishbp);
+ heapsize += size_to_get;
+ update_hincr;
+ }
+# ifdef PRINTSTATS
+ gc_printf("Gcollect: needed to increase heap size by %d\n",
+ size_to_get);
+# endif
+ }
+ }
+# endif
+
+ /* Reset mem_found for next collection */
+ mem_found = 0;
+
+ /* Reenable signals */
+ sigsetmask(Omask);
+
+ /* Get final time */
+# ifdef PRINTTIMES
+ times(&time_buf);
+ done_time = FTIME;
+ gc_printf("Garbage collection took %d + %d msecs\n",
+ (int)(1000.0 * (mark_time - start_time)),
+ (int)(1000.0 * (done_time - mark_time)));
+# endif
+}
+
+/*
+ * this explicitly increases the size of the heap. It is used
+ * internally, but my also be invoked directly by the user.
+ * The argument is in units of HBLKSIZE.
+ */
+void expand_hp(n)
+int n;
+{
+ struct hblk * thishbp = HBLKPTR(((unsigned)sbrk(0))+HBLKSIZE-1 );
+ extern int holdsigs();
+ int Omask;
+
+ /* Don't want to deal with signals in the middle of this */
+ Omask = holdsigs();
+
+ heaplim = (char *) (((unsigned)thishbp) + n * HBLKSIZE);
+ if (n > 2*hincr) {
+ hincr = n/2;
+ }
+ if( ((char *) brk(heaplim)) == ((char *)-1) ) {
+ write(2,"Out of Memory!\n",15);
+ exit(-1);
+ }
+# ifdef PRINTSTATS
+ gc_printf("Voluntarily increasing heap size by %d\n",
+ n*HBLKSIZE);
+# endif
+ thishbp->hb_sz = BYTES_TO_WORDS(n * HBLKSIZE - sizeof(struct hblkhdr));
+ freehblk(thishbp);
+ heapsize += ((char *)heaplim) - ((char *)thishbp);
+ /* Reenable signals */
+ sigsetmask(Omask);
+}
+
+
+extern int dont_gc; /* Unsafe to start garbage collection */
+
+/*
+ * Make sure the composite object free list for sz is not empty.
+ * Return a pointer to the first object on the free list.
+ * The object MUST BE REMOVED FROM THE FREE LIST BY THE CALLER.
+ *
+ * note: _allocobj
+ */
+struct obj * _allocobj(sz)
+long sz;
+{
+ if (sz == 0) return((struct obj *)0);
+
+# ifdef DEBUG2
+ gc_printf("here we are in _allocobj\n");
+# endif
+
+ if (objfreelist[sz] == ((struct obj *)0)) {
+ if (hblkfreelist == ((struct hblk *)0) && !dont_gc) {
+ if (GC_DIV * non_gc_bytes < GC_MULT * heapsize) {
+# ifdef DEBUG
+ gc_printf("Calling gcollect\n");
+# endif
+ gcollect();
+ } else {
+ expand_hp(NON_GC_HINCR);
+ }
+ }
+ if (objfreelist[sz] == ((struct obj *)0)) {
+# ifdef DEBUG
+ gc_printf("Calling new_hblk\n");
+# endif
+ new_hblk(sz);
+ }
+ }
+# ifdef DEBUG2
+ gc_printf("Returning %x from _allocobj\n",objfreelist[sz]);
+ gc_printf("Objfreelist[%d] = %x\n",sz,objfreelist[sz]);
+# endif
+ return(objfreelist[sz]);
+}
+
+/*
+ * Make sure the atomic object free list for sz is not empty.
+ * Return a pointer to the first object on the free list.
+ * The object MUST BE REMOVED FROM THE FREE LIST BY THE CALLER.
+ *
+ * note: this is called by allocaobj (see the file mach_dep.c)
+ */
+struct obj * _allocaobj(sz)
+long sz;
+{
+ if (sz == 0) return((struct obj *)0);
+
+ if (aobjfreelist[sz] == ((struct obj *) 0)) {
+ if (hblkfreelist == ((struct hblk *)0) && !dont_gc) {
+ if (GC_DIV * non_gc_bytes < GC_MULT * heapsize) {
+# ifdef DEBUG
+ gc_printf("Calling gcollect\n");
+# endif
+ gcollect();
+ } else {
+ expand_hp(NON_GC_HINCR);
+ }
+ }
+ if (aobjfreelist[sz] == ((struct obj *) 0)) {
+ new_hblk(-sz);
+ }
+ }
+ return(aobjfreelist[sz]);
+}
+
+# ifdef SPARC
+ put_mark_stack_bottom(val)
+ long val;
+ {
+ mark_stack_bottom = (word *)val;
+ }
+# endif
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991 by Xerox Corporation. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to copy this compiler for any purpose,
+ * provided the above notices are retained on all copies.
+ */
+
+#define DEBUG
+#undef DEBUG
+#include <stdio.h>
+#include "gc.h"
+
+
+/**/
+/* allocate/free routines for heap blocks
+/* Note that everything called from outside the garbage collector
+/* should be prepared to abort at any point as the result of a signal.
+/**/
+
+/*
+ * Free heap blocks are kept on a list sorted by address.
+ * The hb_hdr.hbh_sz field of a free heap block contains the length
+ * (in bytes) of the entire block.
+ * Neighbors are coalesced.
+ */
+
+struct hblk *savhbp = (struct hblk *)0; /* heap block preceding next */
+ /* block to be examined by */
+ /* allochblk. */
+
+/*
+ * Return 1 if there is a heap block sufficient for object size sz,
+ * 0 otherwise. Advance savhbp to point to the block prior to the
+ * first such block.
+ */
+int sufficient_hb(sz)
+int sz;
+{
+register struct hblk *hbp;
+struct hblk *prevhbp;
+int size_needed, size_avail;
+int first_time = 1;
+
+ size_needed = WORDS_TO_BYTES(sz>0? sz : -sz);
+ size_needed = (size_needed+sizeof(struct hblkhdr)+HBLKSIZE-1) & ~HBLKMASK;
+# ifdef DEBUG
+ gc_printf("sufficient_hb: sz = %d, size_needed = 0x%X\n",
+ sz, size_needed);
+# endif
+ /* search for a big enough block in free list */
+ hbp = savhbp;
+ for(;;) {
+ prevhbp = hbp;
+ hbp = ((prevhbp == (struct hblk *)0)
+ ? hblkfreelist
+ : prevhbp->hb_next);
+
+ if( prevhbp == savhbp && !first_time) {
+ /* no sufficiently big blocks on free list */
+ return(0);
+ }
+ first_time = 0;
+ if( hbp == (struct hblk *)0 ) continue;
+ size_avail = hbp->hb_sz;
+ if( size_avail >= size_needed ) {
+ savhbp = prevhbp;
+ return(1);
+ }
+ }
+}
+
+/*
+ * Allocate (and return pointer to) a heap block
+ * for objects of size |sz|.
+ *
+ * NOTE: Caller is responsible for adding it to global hblklist
+ * and for building an object freelist in it.
+ *
+ * The new block is guaranteed to be cleared if sz > 0.
+ */
+struct hblk *
+allochblk(sz)
+long sz;
+{
+ register struct hblk *thishbp;
+ register struct hblk *hbp;
+ struct hblk *prevhbp;
+ long size_needed, /* number of bytes in requested objects */
+ uninit, /* => Found uninitialized block */
+ size_avail;
+ int first_time = 1;
+
+ char *sbrk(); /* data segment size increasing */
+ char *brk(); /* functions */
+
+ size_needed = WORDS_TO_BYTES(sz>0? sz : -sz);
+ size_needed = (size_needed+sizeof(struct hblkhdr)+HBLKSIZE-1) & ~HBLKMASK;
+# ifdef DEBUG
+ gc_printf("(allochblk) sz = %x, size_needed = 0x%X\n", sz, size_needed);
+# endif
+
+ /* search for a big enough block in free list */
+ hbp = savhbp;
+ for(;;) {
+
+ prevhbp = hbp;
+ hbp = ((prevhbp == (struct hblk *)0)
+ ? hblkfreelist
+ : prevhbp->hb_next);
+
+ if( prevhbp == savhbp && !first_time) {
+ /* no sufficiently big blocks on free list, */
+ /* let thishbp --> a newly-allocated block, */
+ /* free it (to merge into existing block */
+ /* list) and start the search again, this */
+ /* time with guaranteed success. */
+ int size_to_get = size_needed + hincr * HBLKSIZE;
+ extern int holdsigs();
+ int Omask;
+
+ /* Don't want to deal with signals in the middle of this */
+ Omask = holdsigs();
+
+ update_hincr;
+ thishbp = HBLKPTR(((unsigned)sbrk(0))+HBLKSIZE-1 );
+ heaplim = (char *) (((unsigned)thishbp) + size_to_get);
+
+ if( (brk(heaplim)) == ((char *)-1) ) {
+ write(2,"Out of Memory! Giving up ...\n", 30);
+ exit(-1);
+ }
+# ifdef PRINTSTATS
+ gc_printf("Need to increase heap size by %d\n",
+ size_to_get);
+# endif
+ heapsize += size_to_get;
+ thishbp->hb_sz =
+ BYTES_TO_WORDS(size_to_get - sizeof(struct hblkhdr));
+ freehblk(thishbp);
+ /* Reenable signals */
+ sigsetmask(Omask);
+ hbp = savhbp;
+ first_time = 1;
+ continue;
+ }
+
+ first_time = 0;
+
+ if( hbp == (struct hblk *)0 ) continue;
+
+ size_avail = hbp->hb_sz;
+ if( size_avail >= size_needed ) {
+ /* found a big enough block */
+ /* let thishbp --> the block */
+ /* set prevhbp, hbp to bracket it */
+ thishbp = hbp;
+ if( size_avail == size_needed ) {
+ hbp = hbp->hb_next;
+ uninit = thishbp -> hb_uninit;
+ } else {
+ uninit = thishbp -> hb_uninit;
+ thishbp -> hb_uninit = 1;
+ /* Just in case we get interrupted by a */
+ /* signal */
+ hbp = (struct hblk *)
+ (((unsigned)thishbp) + size_needed);
+ hbp->hb_uninit = uninit;
+ hbp->hb_next = thishbp->hb_next;
+ hbp->hb_sz = size_avail - size_needed;
+ }
+ /* remove *thishbp from hblk freelist */
+ if( prevhbp == (struct hblk *)0 ) {
+ hblkfreelist = hbp;
+ } else {
+ prevhbp->hb_next = hbp;
+ }
+ /* save current list search position */
+ savhbp = prevhbp;
+ break;
+ }
+ }
+
+ /* set size and mask field of *thishbp correctly */
+ thishbp->hb_sz = sz;
+ thishbp->hb_mask = -1; /* may be changed by new_hblk */
+
+ /* Clear block if necessary */
+ if (uninit && sz > 0) {
+ register word * p = &(thishbp -> hb_body[0]);
+ register word * plim;
+
+ plim = (word *)(((char *)thishbp) + size_needed);
+ while (p < plim) {
+ *p++ = 0;
+ }
+ }
+ /* Clear mark bits */
+ {
+ register word *p = (word *)(&(thishbp -> hb_marks[0]));
+ register word * plim = (word *)(&(thishbp -> hb_marks[MARK_BITS_SZ]));
+ while (p < plim) {
+ *p++ = 0;
+ }
+ }
+
+# ifdef DEBUG
+ gc_printf("Returning 0x%X\n", thishbp);
+# endif
+ return( thishbp );
+}
+
+/* Clear the header information in a previously allocated heap block p */
+/* so that it can be coalesced with an initialized heap block. */
+static clear_header(p)
+register struct hblk *p;
+{
+ p -> hb_sz = 0;
+# ifndef HBLK_MAP
+ p -> hb_index = (struct hblk **)0;
+# endif
+ p -> hb_next = 0;
+ p -> hb_mask = 0;
+# if MARK_BITS_SZ <= 60
+ /* Since this block was deallocated, only spurious mark */
+ /* bits corresponding to the header could conceivably be set */
+ p -> hb_marks[0] = 0;
+ p -> hb_marks[1] = 0;
+# else
+ --> fix it
+# endif
+}
+
+/*
+ * Free a heap block.
+ *
+ * Assume the block is not currently on hblklist.
+ *
+ * Coalesce the block with its neighbors if possible.
+
+ * All mark words (except possibly the first) are assumed to be cleared.
+ * The body is assumed to be cleared unless hb_uninit is nonzero.
+ */
+void
+freehblk(p)
+register struct hblk *p;
+{
+register struct hblk *hbp, *prevhbp;
+register int size;
+
+ /* savhbp may become invalid due to coalescing. Clear it. */
+ savhbp = (struct hblk *)0;
+
+ size = p->hb_sz;
+ if( size < 0 ) size = -size;
+ size =
+ ((WORDS_TO_BYTES(size)+sizeof(struct hblkhdr)+HBLKSIZE-1)
+ & (~HBLKMASK));
+ p->hb_sz = size;
+
+ prevhbp = (struct hblk *) 0;
+ hbp = hblkfreelist;
+
+ while( (hbp != (struct hblk *)0) && (hbp < p) ) {
+ prevhbp = hbp;
+ hbp = hbp->hb_next;
+ }
+
+ /* Coalesce with successor, if possible */
+ if( (((unsigned)p)+size) == ((unsigned)hbp) ) {
+ (p -> hb_uninit) |= (hbp -> hb_uninit);
+ p->hb_next = hbp->hb_next;
+ p->hb_sz += hbp->hb_sz;
+ if (!p -> hb_uninit) clear_header(hbp);
+ } else {
+ p->hb_next = hbp;
+ }
+
+ if( prevhbp == (struct hblk *)0 ) {
+ hblkfreelist = p;
+ } else if( (((unsigned)prevhbp) + prevhbp->hb_hdr.hbh_sz) ==
+ ((unsigned)p) ) {
+ /* Coalesce with predecessor */
+ (prevhbp->hb_uninit) |= (p -> hb_uninit);
+ prevhbp->hb_next = p->hb_next;
+ prevhbp->hb_sz += p->hb_sz;
+ if (!prevhbp -> hb_uninit) clear_header(p);
+ } else {
+ prevhbp->hb_next = p;
+ }
+}
+
+/* Add a heap block to hblklist or hblkmap. */
+void add_hblklist(hbp)
+struct hblk * hbp;
+{
+# ifdef HBLK_MAP
+ long size = hbp->hb_sz;
+ long index = divHBLKSZ(((long)hbp) - ((long)heapstart));
+ long i;
+
+ if( size < 0 ) size = -size;
+ size = (divHBLKSZ(WORDS_TO_BYTES(size)+sizeof(struct hblkhdr)+HBLKSIZE-1));
+ /* in units of HBLKSIZE */
+ hblkmap[index] = HBLK_VALID;
+ for (i = 1; i < size; i++) {
+ if (i < 0x7f) {
+ hblkmap[index+i] = i;
+ } else {
+ /* May overflow a char. Store largest possible value */
+ hblkmap[index+i] = 0x7e;
+ }
+ }
+# else
+ if (last_hblk >= &hblklist[MAXHBLKS]) {
+ fprintf(stderr, "Not configured for enough memory\n");
+ exit(1);
+ }
+ *last_hblk = hbp;
+ hbp -> hb_index = last_hblk;
+ last_hblk++;
+# endif
+}
+
+/* Delete a heap block from hblklist or hblkmap. */
+void del_hblklist(hbp)
+struct hblk * hbp;
+{
+# ifdef HBLK_MAP
+ long size = hbp->hb_sz;
+ long index = divHBLKSZ(((long)hbp) - ((long)heapstart));
+ long i;
+
+ if( size < 0 ) size = -size;
+ size = (divHBLKSZ(WORDS_TO_BYTES(size)+sizeof(struct hblkhdr)+HBLKSIZE-1));
+ /* in units of HBLKSIZE */
+ for (i = 0; i < size; i++) {
+ hblkmap[index+i] = HBLK_INVALID;
+ }
+# else
+ register struct hblk ** list_entry;
+ last_hblk--;
+ /* Let **last_hblk use the slot previously occupied by *hbp */
+ list_entry = hbp -> hb_index;
+ (*last_hblk) -> hb_index = list_entry;
+ *list_entry = *last_hblk;
+# endif
+}
+
+/* Initialize hblklist */
+void init_hblklist()
+{
+# ifdef DEBUG
+ gc_printf("Here we are in init_hblklist - ");
+ gc_printf("last_hblk = %x\n",&(hblklist[0]));
+# endif
+# ifndef HBLK_MAP
+ last_hblk = &(hblklist[0]);
+# endif
+}
--- /dev/null
+/* Silly implementation of Lisp cons. Intentionally wastes lots of space */
+/* to test collector. */
+# include <stdio.h>
+# include "cons.h"
+
+int extra_count = 0; /* Amount of space wasted in cons node */
+
+sexpr cons (x, y)
+sexpr x;
+sexpr y;
+{
+ register sexpr r;
+ register int i;
+ register int *p;
+
+ extra_count++;
+ extra_count %= 3000;
+ r = (sexpr) gc_malloc(8 + extra_count);
+ for (p = (int *)r; ((char *)p) < ((char *)r) + extra_count + 8; p++) {
+ if (*p) {
+ fprintf(stderr, "Found nonzero at %X\n", p);
+ abort(p);
+ }
+ *p = 13;
+ }
+ r -> sexpr_car = x;
+ r -> sexpr_cdr = y;
+ return(r);
+}
--- /dev/null
+struct SEXPR {
+ struct SEXPR * sexpr_car;
+ struct SEXPR * sexpr_cdr;
+};
+
+typedef struct SEXPR * sexpr;
+
+extern sexpr cons();
+
+# define nil ((sexpr) 0)
+# define car(x) ((x) -> sexpr_car)
+# define cdr(x) ((x) -> sexpr_cdr)
+# define null(x) ((x) == nil)
+
+# define head(x) car(x)
+# define tail(x) cdr(x)
+
+# define caar(x) car(car(x))
+# define cadr(x) car(cdr(x))
+# define cddr(x) cdr(cdr(x))
+# define cdar(x) cdr(car(x))
+# define caddr(x) car(cdr(cdr(x)))
+
+# define first(x) car(x)
+# define second(x) cadr(x)
+# define third(x) caddr(x)
+
+# define list1(x) cons(x, nil)
+# define list2(x,y) cons(x, cons(y, nil))
+# define list3(x,y,z) cons(x, cons(y, cons(z, nil)))
--- /dev/null
+1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100
+1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50
+100, 99, 98, 97, 96, 95, 94, 93, 92, 91, 90, 89, 88, 87, 86, 85, 84, 83, 82, 81, 80, 79, 78, 77, 76, 75, 74, 73, 72, 71, 70, 69, 68, 67, 66, 65, 64, 63, 62, 61, 60, 59, 58, 57, 56, 55, 54, 53, 52, 51, 50, 49, 48, 47, 46, 45, 44, 43, 42, 41, 40, 39, 38, 37, 36, 35, 34, 33, 32, 31, 30, 29, 28, 27, 26, 25, 24, 23, 22, 21, 20, 19, 18, 17, 16, 15, 14, 13, 12, 11, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1
+50, 49, 48, 47, 46, 45, 44, 43, 42, 41, 40, 39, 38, 37, 36, 35, 34, 33, 32, 31, 30, 29, 28, 27, 26, 25, 24, 23, 22, 21, 20, 19, 18, 17, 16, 15, 14, 13, 12, 11, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1
+1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100
+1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50
+100, 99, 98, 97, 96, 95, 94, 93, 92, 91, 90, 89, 88, 87, 86, 85, 84, 83, 82, 81, 80, 79, 78, 77, 76, 75, 74, 73, 72, 71, 70, 69, 68, 67, 66, 65, 64, 63, 62, 61, 60, 59, 58, 57, 56, 55, 54, 53, 52, 51, 50, 49, 48, 47, 46, 45, 44, 43, 42, 41, 40, 39, 38, 37, 36, 35, 34, 33, 32, 31, 30, 29, 28, 27, 26, 25, 24, 23, 22, 21, 20, 19, 18, 17, 16, 15, 14, 13, 12, 11, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1
+50, 49, 48, 47, 46, 45, 44, 43, 42, 41, 40, 39, 38, 37, 36, 35, 34, 33, 32, 31, 30, 29, 28, 27, 26, 25, 24, 23, 22, 21, 20, 19, 18, 17, 16, 15, 14, 13, 12, 11, 10, 9, 8, 7, 6, 5, 4, 3, 2, 1
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991 by Xerox Corporation. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to copy this compiler for any purpose,
+ * provided the above notices are retained on all copies.
+ */
+
+/* Machine specific parts contributed by various people. See README file. */
+
+/*********************************/
+/* */
+/* Definitions for conservative */
+/* collector */
+/* */
+/*********************************/
+
+/*********************************/
+/* */
+/* Easily changeable parameters */
+/* */
+/*********************************/
+
+# if defined(sun) && defined(mc68000)
+# define M68K_SUN
+# define mach_type_known
+# endif
+# if defined(hp9000s300)
+# define M68K_HP
+# define mach_type_known
+# endif
+# if defined(vax)
+# define VAX
+# ifdef ultrix
+# define ULTRIX
+# else
+# define BSD
+# endif
+# define mach_type_known
+# endif
+# if defined(mips)
+# define MIPS
+# ifdef ultrix
+# define ULTRIX
+# else
+# define RISCOS
+# endif
+# define mach_type_known
+# endif
+# if defined(sequent) && defined(i386)
+# define I386
+# define mach_type_known
+# endif
+# if defined(ibm032)
+# define RT
+# define mach_type_known
+# endif
+# if defined(sun) && defined(sparc)
+# define SPARC
+# define mach_type_known
+# endif
+# if defined(_IBMR2)
+# define IBMRS6000
+# define mach_type_known
+# endif
+
+
+/* Feel free to add more clauses here */
+
+/* Or manually define the machine type here. A machine type is */
+/* characterized by the architecture and assembler syntax. Some */
+/* machine types are further subdivided by OS. In that case, we use */
+/* the macros ULTRIX, RISCOS, and BSD to distinguish. */
+/* The distinction in these cases is usually the stack starting address */
+# ifndef mach_type_known
+# define M68K_SUN /* Guess "Sun" */
+ /* Mapping is: M68K_SUN ==> Sun3 assembler, */
+ /* M68K_HP ==> HP9000/300, */
+ /* I386 ==> Sequent Symmetry, */
+ /* NS32K ==> Encore Multimax, */
+ /* MIPS ==> R2000 or R3000 */
+ /* (RISCOS, ULTRIX variants) */
+ /* VAX ==> DEC VAX */
+ /* (BSD, ULTRIX variants) */
+# endif
+
+#define PRINTSTATS /* Print garbage collection statistics */
+ /* For less verbose output, undefine in reclaim.c */
+
+#define PRINTTIMES /* Print the amount of time consumed by each garbage */
+ /* collection. */
+
+#define PRINTBLOCKS /* Print object sizes associated with heap blocks, */
+ /* whether the objects are atomic or composite, and */
+ /* whether or not the block was found to be empty */
+ /* duing the reclaim phase. Typically generates */
+ /* about one screenful per garbage collection. */
+#undef PRINTBLOCKS
+
+#ifdef SILENT
+# ifdef PRINTSTATS
+# undef PRINTSTATS
+# endif
+# ifdef PRINTTIMES
+# undef PRINTTIMES
+# endif
+# ifdef PRINTNBLOCKS
+# undef PRINTNBLOCKS
+# endif
+#endif
+
+#define HBLK_MAP /* Maintain a map of all potential heap blocks */
+ /* starting at heapstart. */
+ /* Normally, this performs about as well as the */
+ /* standard stack of chunk pointers that is used */
+ /* otherwise. It loses if a small section of the */
+ /* heap consists of garbage collected objects. */
+ /* It is ESSENTIAL if pointers to object interiors */
+ /* are considered valid, i.e. if INTERIOR_POINTERS */
+ /* is defined. */
+#undef HBLK_MAP
+
+#define MAP_SIZE 8192 /* total data size < MAP_SIZE * HBLKSIZE = 32 Meg */
+#define MAXHBLKS 4096 /* Maximum number of chunks which can be */
+ /* allocated */
+#define INTERIOR_POINTERS
+ /* Follow pointers to the interior of an object. */
+ /* Substantially increases the probability of */
+ /* unnnecessary space retention. May be necessary */
+ /* with gcc -O or other C compilers that may clobber */
+ /* values of dead variables prematurely. Pcc */
+ /* derived compilers appear to pose no such problems. */
+ /* Empirical evidence suggests that this is probably */
+ /* still OK for most purposes, so long as pointers */
+ /* are known to be 32 bit aligned. The combination */
+ /* of INTERIOR_POINTERS and UNALIGNED (e.g. on a */
+ /* Sun 3 with the standard compiler) causes easily */
+ /* observable spurious retention and performance */
+ /* degradation. */
+#undef INTERIOR_POINTERS
+
+#ifdef SPARC
+# define ALIGN_DOUBLE /* Align objects of size > 1 word on 2 word */
+ /* boundaries. Wasteful of memory, but */
+ /* apparently required by SPARC architecture. */
+
+#endif
+
+#if defined(INTERIOR_POINTERS) && !defined(HBLK_MAP)
+ --> check for interior pointers requires a heap block map
+#endif
+
+#define MERGE_SIZES /* Round up some object sizes, so that fewer distinct */
+ /* free lists are actually maintained. This applies */
+ /* only to the top level routines in misc.c, not to */
+ /* user generated code that calls allocobj and */
+ /* allocaobj directly. */
+ /* Slows down average programs slightly. May however */
+ /* substantially reduce fragmentation if allocation */
+ /* request sizes are widely scattered. */
+#undef MERGE_SIZES
+
+/* ALIGN_DOUBLE requires MERGE_SIZES at present. */
+# if defined(ALIGN_DOUBLE) && !defined(MERGE_SIZES)
+# define MERGE_SIZES
+# endif
+
+
+/* For PRINTTIMES to tell the truth, we need to know the value of HZ for
+ this system. */
+
+#if defined(M68K_HP) || defined(M68K_SUN) || defined(SPARC)
+# include <sys/param.h>
+# define FLOAT_HZ (double)HZ
+#else
+# define FLOAT_HZ 60.0 /* Guess that we're in the U.S. */
+#endif
+
+#ifdef M68K_SUN
+# define UNALIGNED /* Pointers are not longword aligned */
+# define ALIGNMENT 2 /* Pointers are aligned on 2 byte boundaries */
+ /* by the Sun C compiler. */
+#else
+# ifdef VAX
+# undef UNALIGNED /* Pointers are longword aligned by 4.2 C compiler */
+# define ALIGNMENT 4
+# else
+# ifdef RT
+# undef UNALIGNED
+# define ALIGNMENT 4
+# else
+# ifdef SPARC
+# undef UNALIGNED
+# define ALIGNMENT 4
+# else
+# ifdef I386
+# undef UNALIGNED /* Sequent compiler aligns pointers */
+# define ALIGNMENT 4
+# else
+# ifdef NS32K
+# undef UNALIGNED /* Pointers are aligned on NS32K */
+# define ALIGNMENT 4
+# else
+# ifdef MIPS
+# undef UNALIGNED /* MIPS hardware requires pointer */
+ /* alignment */
+# define ALIGNMENT 4
+# else
+# ifdef M68K_HP
+# define UNALIGNED
+# define ALIGNMENT 2 /* 2 byte alignment inside struct/union, */
+ /* 4 bytes elsewhere */
+# else
+# ifdef IBMRS6000
+# undef UNALIGNED
+# define ALIGNMENT 4
+# else
+ --> specify alignment <--
+# endif
+# endif
+# endif
+# endif
+# endif
+# endif
+# endif
+# endif
+# endif
+
+# ifdef RT
+# define STACKTOP ((word *) 0x1fffd800)
+# else
+# ifdef I386
+# define STACKTOP ((word *) 0x3ffff000) /* For Sequent */
+# else
+# ifdef NS32K
+# define STACKTOP ((word *) 0xfffff000) /* for Encore */
+# else
+# ifdef MIPS
+# ifdef ULTRIX
+# define STACKTOP ((word *) 0x7fffc000)
+# else
+# ifdef RISCOS
+# define STACKTOP ((word *) 0x7ffff000)
+ /* Could probably be slightly lower since */
+ /* startup code allocates lots of junk */
+# else
+ --> fix it
+# endif
+# endif
+# else
+# ifdef M68K_HP
+# define STACKTOP ((word *) 0xffeffffc)
+ /* empirically determined. seems to work. */
+# else
+# ifdef IBMRS6000
+# define STACKTOP ((word *) 0x2ff80000)
+# else
+# if defined(VAX) && defined(ULTRIX)
+# define STACKTOP ((word *) 0x7fffc800)
+# else
+ /* other VAXes, SPARC, and various flavors of Sun 2s and Sun 3s use */
+ /* the default heuristic, which is to take the address of a local */
+ /* variable in gc_init, and round it up to the next multiple */
+ /* of 16 Meg. This is crucial on Suns, since various models */
+ /* that are supposed to be able to share executables, do not */
+ /* use the same stack base. In particular, Sun 3/80s are */
+ /* different from other Sun 3s. */
+ /* This probably works on some more of the above machines. */
+# endif
+# endif
+# endif
+# endif
+# endif
+# endif
+# endif
+
+/* Start of data segment for each of the above systems. Note that the */
+/* default case works only for contiguous text and data, such as on a */
+/* Vax. */
+# ifdef M68K_SUN
+# define DATASTART ((char *)((((long) (&etext)) + 0x1ffff) & ~0x1ffff))
+# else
+# ifdef RT
+# define DATASTART ((char *) 0x10000000)
+# else
+# ifdef I386
+# define DATASTART ((char *)((((long) (&etext)) + 0xfff) & ~0xfff))
+# else
+# ifdef NS32K
+ extern char **environ;
+# define DATASTART ((char *)(&environ))
+ /* hideous kludge: environ is the first */
+ /* word in crt0.o, and delimits the start */
+ /* of the data segment, no matter which */
+ /* ld options were passed through. */
+# else
+# ifdef MIPS
+# define DATASTART 0x10000000
+ /* Could probably be slightly higher since */
+ /* startup code allocates lots of junk */
+# else
+# ifdef M68K_HP
+# define DATASTART ((char *)((((long) (&etext)) + 0xfff) & ~0xfff))
+# else
+# ifdef IBMRS6000
+# define DATASTART ((char *)0x20000000)
+# else
+# define DATASTART (&etext)
+# endif
+# endif
+# endif
+# endif
+# endif
+# endif
+# endif
+
+# define HINCR 16 /* Initial heap increment, in blocks of 4K */
+# define MAXHINCR 512 /* Maximum heap increment, in blocks */
+# define HINCR_MULT 3 /* After each new allocation, hincr is multiplied */
+# define HINCR_DIV 2 /* by HINCR_MULT/HINCR_DIV */
+# define GC_MULT 3 /* Don't collect if the fraction of */
+ /* non-collectable memory in the heap */
+ /* exceeds GC_MUL/GC_DIV */
+# define GC_DIV 4
+
+# define NON_GC_HINCR 8 /* Heap increment if most of heap if collection */
+ /* was suppressed because most of heap is not */
+ /* collectable */
+
+/* heap address bounds. These are extreme bounds used for sanity checks. */
+/* HEAPLIM may have to be increased for machines with incredibly large */
+/* amounts of memory. */
+
+#ifdef RT
+# define HEAPSTART 0x10000000
+# define HEAPLIM 0x1fff0000
+#else
+# if defined(M68K_SUN) || defined(M68K_HP)
+# define HEAPSTART 0x00010000
+# define HEAPLIM 0x04000000
+# else
+# ifdef SPARC
+# define HEAPSTART 0x00010000
+# define HEAPLIM 0x10000000
+# else
+# ifdef VAX
+# define HEAPSTART 0x400
+# define HEAPLIM 0x10000000
+# else
+# ifdef I386
+# define HEAPSTART 0x1000
+# define HEAPLIM 0x10000000
+# else
+# ifdef NS32K
+# define HEAPSTART 0x2000
+# define HEAPLIM 0x10000000
+# else
+# ifdef MIPS
+# define HEAPSTART 0x10000000
+# define HEAPLIM 0x20000000
+# else
+# ifdef IBMRS6000
+# define HEAPSTART 0x20000000
+# define HEAPLIM 0x2ff70000
+# else
+ --> values unknown <--
+# endif
+# endif
+# endif
+# endif
+# endif
+# endif
+# endif
+#endif
+
+/*********************************/
+/* */
+/* Machine-dependent defines */
+/* */
+/*********************************/
+
+#define WORDS_TO_BYTES(x) ((x)<<2)
+#define BYTES_TO_WORDS(x) ((x)>>2)
+
+#define WORDSZ 32
+#define LOGWL 5 /* log[2] of above */
+#define BYTES_PER_WORD (sizeof (word))
+#define ONES 0xffffffff
+#define MSBYTE 0xff000000
+#define SIGNB 0x80000000
+#define MAXSHORT 0x7fff
+#define modHALFWORDSZ(n) ((n) & 0xf) /* mod n by size of half word */
+#define divHALFWORDSZ(n) ((n) >> 4) /* divide n by size of half word */
+#define modWORDSZ(n) ((n) & 0x1f) /* mod n by size of word */
+#define divWORDSZ(n) ((n) >> 5) /* divide n by size of word */
+#define twice(n) ((n) << 1) /* double n */
+
+typedef unsigned long word;
+
+#define TRUE 1
+#define FALSE 0
+
+/*********************/
+/* */
+/* Size Parameters */
+/* */
+/*********************/
+
+/* heap block size, bytes */
+/* for RT see comment below */
+
+#define HBLKSIZE 0x1000
+
+
+/* max size objects supported by freelist (larger objects may be */
+/* allocated, but less efficiently) */
+/* asm(".set MAXOBJSZ,0x200") if HBLKSIZE/2 == 0x200 */
+
+#define MAXOBJSZ (HBLKSIZE/8)
+ /* Should be BYTES_TO_WORDS(HBLKSIZE/2), but a cpp */
+ /* misfeature prevents that. */
+#define MAXAOBJSZ (HBLKSIZE/8)
+
+# define divHBLKSZ(n) ((n) >> 12)
+
+# define modHBLKSZ(n) ((n) & 0xfff)
+
+# define HBLKPTR(objptr) ((struct hblk *)(((long) (objptr)) & ~0xfff))
+
+
+
+/********************************************/
+/* */
+/* H e a p B l o c k s */
+/* */
+/********************************************/
+
+/* heap block header */
+#define HBLKMASK (HBLKSIZE-1)
+
+#define BITS_PER_HBLK (HBLKSIZE * 8)
+
+#define MARK_BITS_PER_HBLK (BITS_PER_HBLK/WORDSZ)
+ /* upper bound */
+ /* We allocate 1 bit/word. Only the first word */
+ /* in each object is actually marked. */
+
+# ifdef ALIGN_DOUBLE
+# define MARK_BITS_SZ (((MARK_BITS_PER_HBLK + 2*WORDSZ - 1)/(2*WORDSZ))*2)
+# else
+# define MARK_BITS_SZ ((MARK_BITS_PER_HBLK + WORDSZ - 1)/WORDSZ)
+# endif
+ /* Upper bound on number of mark words per heap block */
+
+struct hblkhdr {
+ long hbh_sz; /* sz > 0 ==> objects are sz-tuples of poss. pointers */
+ /* sz < 0 ==> objects are sz-tuples not pointers */
+ /* if free, the size in bytes of the whole block */
+ /* Misc.c knows that hbh_sz comes first. */
+# ifndef HBLK_MAP
+ struct hblk ** hbh_index; /* Pointer to heap block list entry */
+ /* for this block */
+# else
+# ifdef ALIGN_DOUBLE
+ /* Add another 1 word field to make the total even. Gross, but ... */
+ long hbh_dummy;
+# endif
+# endif
+ struct hblk * hbh_next; /* Link field for hblk free list */
+ long hbh_mask; /* If hbh_mask >= 0 then: */
+ /* x % (4 * hbh_sz) == x & hbh_mask */
+ /* sz is a power of 2 and < the size of a heap */
+ /* block. */
+ /* A hack to speed up pointer validity check on */
+ /* machines with slow division. */
+ long hbh_marks[MARK_BITS_SZ];
+ /* Bit i in the array refers to the */
+ /* object starting at the ith word (header */
+ /* INCLUDED) in the heap block. */
+ /* For free blocks, hbh_marks[0] = 1, indicates */
+ /* block is uninitialized. */
+};
+
+/* heap block body */
+
+# define BODY_SZ ((HBLKSIZE-sizeof(struct hblkhdr))/sizeof(word))
+
+struct hblk {
+ struct hblkhdr hb_hdr;
+ word hb_body[BODY_SZ];
+};
+
+# define hb_sz hb_hdr.hbh_sz
+# ifndef HBLK_MAP
+# define hb_index hb_hdr.hbh_index
+# endif
+# define hb_marks hb_hdr.hbh_marks
+# define hb_next hb_hdr.hbh_next
+# define hb_uninit hb_hdr.hbh_marks[0]
+# define hb_mask hb_hdr.hbh_mask
+
+/* lists of all heap blocks and free lists */
+/* These are grouped together in a struct */
+/* so that they can be easily skipped by the */
+/* mark routine. */
+/* Mach_dep.c knows about the internals */
+/* of this structure. */
+
+struct __gc_arrays {
+ struct obj * _aobjfreelist[MAXAOBJSZ+1];
+ /* free list for atomic objs*/
+ struct obj * _objfreelist[MAXOBJSZ+1];
+ /* free list for objects */
+# ifdef HBLK_MAP
+ char _hblkmap[MAP_SIZE];
+# define HBLK_INVALID 0 /* Not administered by collector */
+# define HBLK_VALID 0x7f /* Beginning of a valid heap block */
+ /* A value n, 0 < n < 0x7f denotes the continuation of a valid heap */
+ /* block which starts at the current address - n * HBLKSIZE or earlier */
+# else
+ struct hblk * _hblklist[MAXHBLKS];
+# endif
+};
+
+extern struct __gc_arrays _gc_arrays;
+
+# define objfreelist _gc_arrays._objfreelist
+# define aobjfreelist _gc_arrays._aobjfreelist
+# ifdef HBLK_MAP
+# define hblkmap _gc_arrays._hblkmap
+# else
+# define hblklist _gc_arrays._hblklist
+# endif
+
+# define begin_gc_arrays ((char *)(&_gc_arrays))
+# define end_gc_arrays (((char *)(&_gc_arrays)) + (sizeof _gc_arrays))
+
+struct hblk ** last_hblk; /* Pointer to one past the real end of hblklist */
+
+struct hblk * hblkfreelist;
+
+extern long heapsize; /* Heap size in bytes */
+
+long hincr; /* current heap increment, in blocks */
+
+/* Operations */
+# define update_hincr hincr = (hincr * HINCR_MULT)/HINCR_DIV; \
+ if (hincr > MAXHINCR) {hincr = MAXHINCR;}
+# define HB_SIZE(p) abs((p) -> hb_sz)
+# define abs(x) ((x) < 0? (-(x)) : (x))
+
+/* procedures */
+
+extern void
+freehblk();
+
+extern struct hblk *
+allochblk();
+
+/****************************/
+/* */
+/* Objects */
+/* */
+/****************************/
+
+/* object structure */
+
+struct obj {
+ union {
+ struct obj *oun_link; /* --> next object in freelist */
+# define obj_link obj_un.oun_link
+ word oun_component[1]; /* treats obj as list of words */
+# define obj_component obj_un.oun_component
+ } obj_un;
+};
+
+/* Test whether something points to a legitimate heap object */
+
+
+extern char end;
+
+# ifdef HBLK_MAP
+ char * heapstart; /* A lower bound on all heap addresses */
+ /* Known to be HBLKSIZE aligned. */
+# endif
+
+char * heaplim; /* 1 + last address in heap */
+
+word * stacktop; /* 1 + highest address in stack. Set by gc_init. */
+
+/* Check whether the given HBLKSIZE aligned hblk pointer refers to the */
+/* beginning of a legitimate chunk. */
+/* Assumes that *p is addressable */
+# ifdef HBLK_MAP
+# define is_hblk(p) (hblkmap[divHBLKSZ(((long)p) - ((long)heapstart))] \
+ == HBLK_VALID)
+# else
+# define is_hblk(p) ( (p) -> hb_index >= hblklist \
+ && (p) -> hb_index < last_hblk \
+ && *((p)->hb_index) == (p))
+# endif
+# ifdef INTERIOR_POINTERS
+ /* Return the hblk_map entry for the pointer p */
+# define get_map(p) (hblkmap[divHBLKSZ(((long)p) - ((long)heapstart))])
+# endif
+
+# ifdef INTERIOR_POINTERS
+ /* Return the word displacement of the beginning of the object to */
+ /* which q points. q is an address inside hblk p for objects of size s */
+ /* with mask m corresponding to s. */
+# define get_word_no(q,p,s,m) \
+ (((long)(m)) >= 0 ? \
+ (((((long)q) - ((long)p) - (sizeof (struct hblkhdr))) & ~(m)) \
+ + (sizeof (struct hblkhdr)) >> 2) \
+ : ((((long)q) - ((long)p) - (sizeof (struct hblkhdr)) >> 2) \
+ / (s)) * (s) \
+ + ((sizeof (struct hblkhdr)) >> 2))
+# else
+ /* Check whether q points to an object inside hblk p for objects of size s */
+ /* with mask m corresponding to s. */
+# define is_proper_obj(q,p,s,m) \
+ (((long)(m)) >= 0 ? \
+ (((((long)(q)) - (sizeof (struct hblkhdr))) & (m)) == 0) \
+ : (((long) (q)) - ((long)(p)) - (sizeof (struct hblkhdr))) \
+ % ((s) << 2) == 0)
+# endif
+
+/* The following is a quick test whether something is an object pointer */
+/* It may err in the direction of identifying bogus pointers */
+/* Assumes heap + text + data + bss < 64 Meg. */
+#ifdef M68K_SUN
+# define TMP_POINTER_MASK 0xfc000003 /* pointer & POINTER_MASK should be 0 */
+#else
+# ifdef RT
+# define TMP_POINTER_MASK 0xc0000003
+# else
+# ifdef VAX
+# define TMP_POINTER_MASK 0xfc000003
+# else
+# ifdef SPARC
+# define TMP_POINTER_MASK 0xfc000003
+# else
+# ifdef I386
+# define TMP_POINTER_MASK 0xfc000003
+# else
+# ifdef NS32K
+# define TMP_POINTER_MASK 0xfc000003
+# else
+# ifdef MIPS
+# define TMP_POINTER_MASK 0xc0000003
+# else
+# ifdef M68K_HP
+# define TMP_POINTER_MASK 0xfc000003
+# else
+# ifdef IBMRS6000
+# define TMP_POINTER_MASK 0xd0000003
+# else
+ --> dont know <--
+# endif
+# endif
+# endif
+# endif
+# endif
+# endif
+# endif
+# endif
+#endif
+
+#ifdef INTERIOR_POINTERS
+# define POINTER_MASK (TMP_POINTER_MASK & 0xfffffff8)
+ /* Don't pay attention to whether address is properly aligned */
+#else
+# define POINTER_MASK TMP_POINTER_MASK
+#endif
+
+#ifdef HBLK_MAP
+# define quicktest(p) (((long)(p)) > ((long)(heapstart)) \
+ && !(((unsigned long)(p)) & POINTER_MASK))
+#else
+# ifdef UNALIGNED
+# define quicktest(p) (((long)(p)) > ((long)(&end)) \
+ && !(((unsigned long)(p)) & POINTER_MASK) \
+ && (((long)(p)) & HBLKMASK))
+ /* The last test throws out pointers to the beginning of heap */
+ /* blocks. Small integers shifted by 16 bits tend to look */
+ /* like these. */
+# else
+# define quicktest(p) (((long)(p)) > ((long)(&end)) \
+ && !(((unsigned long)(p)) & POINTER_MASK))
+# endif
+#endif
+
+
+/* Marks are in a reserved area in */
+/* each heap block. Each word has one mark bits associated */
+/* with it. Only those corresponding to the beginning of an */
+/* object are used. */
+
+
+/* Operations */
+
+/*
+ * Retrieve, set, clear the mark bit corresponding
+ * to the nth word in a given heap block.
+ * Note that retrieval will work, so long as *hblk is addressable.
+ * In particular, the check whether hblk is a legitimate heap block
+ * can be postponed until after the mark bit is examined.
+ *
+ * (Recall that bit n corresponds to object beginning at word n)
+ */
+
+# define mark_bit(hblk,n) (((hblk)->hb_marks[divWORDSZ(n)] \
+ >> (modWORDSZ(n))) & 1)
+
+/* The following assume the mark bit in question is either initially */
+/* cleared or it already has its final value */
+# define set_mark_bit(hblk,n) (hblk)->hb_marks[divWORDSZ(n)] \
+ |= 1 << modWORDSZ(n)
+
+# define clear_mark_bit(hblk,n) (hblk)->hb_marks[divWORDSZ(n)] \
+ &= ~(1 << modWORDSZ(n))
+
+/* procedures */
+
+/* Small object allocation routines */
+extern struct obj * allocobj();
+extern struct obj * allocaobj();
+
+/* Small object allocation routines that mark only from registers */
+/* expected to be preserved by C. */
+extern struct obj * _allocobj();
+extern struct obj * _allocaobj();
+
+/* general purpose allocation routines */
+extern struct obj * gc_malloc();
+extern struct obj * gc_malloc_atomic();
+
--- /dev/null
+#include "gc.h"
+/* These are some additional routines to interface the collector to C */
+/* They were contributed by David Chase (chase@orc.olivetti.com) */
+/* They illustrates the use of non_gc_bytes, and provide an interface to */
+/* the storage allocator's size information. Note that there is a */
+/* check to guard against 0 length allocations. */
+/* Hacked by H. Boehm (11/16/89) to accomodate gc_realloc. */
+
+initialize_allocator() {
+ non_gc_bytes = 0;
+ gc_init();
+}
+
+
+/* Use of gc_gasp to report errors reduces risk of bizarre
+ interactions with I/O system in desperate situations. */
+
+gc_gasp(s) char * s;
+{
+ write(2,s,strlen(s));
+}
+
+
+/* This reports how many bytes are actually available to an object.
+ It is a fatal error to request the size of memory addressed by a
+ pointer not obtained from the storage allocator. */
+
+size_of_obj_in_bytes(p)
+ struct obj * p;
+{
+ register struct hblk * h;
+ register int size;
+
+ h = HBLKPTR(p);
+
+ if (is_hblk(h)) {
+ return (HB_SIZE(h))<<2;
+ }
+ gc_gasp("GC/size_of_obj_in_bytes: requested byte size of non-pointer!\n");
+ exit(1);
+}
+
+
+/* This free routine is merely advisory -- it reduces the estimate of
+ storage that won't be reclaimed in the next collection, thus
+ making it more likely that the collector will run next time more
+ memory is needed. */
+
+void free(p) {
+ int inc = size_of_obj_in_bytes(p);
+ non_gc_bytes -= inc;
+}
+
+/* This free routine adjusts the collector estimates of space in use,
+ but also actually releases the memory for reuse. It is thus "unsafe"
+ if the programmer "frees" memory that is actually still in use. */
+
+void unsafe_free(p) {
+ int inc = size_of_obj_in_bytes(p);
+ non_gc_bytes -= inc;
+ gc_free(p);
+}
+
+
+/* malloc and malloc_atomic are obvious substitutes for the C library
+ malloc. Note that the storage so allocated is regarded as not likely
+ to be reclaimed by the collector (until explicitly freed), and thus
+ its size is added to non_gc_bytes.
+*/
+
+word malloc(bytesize) {
+word result;
+if (bytesize == 0) bytesize = 4;
+result = (word) gc_malloc (bytesize);
+non_gc_bytes += (bytesize + 3) & ~3;
+return result;
+}
+
+word malloc_atomic(bytesize) {
+word result;
+if (bytesize == 0) bytesize = 4;
+result = (word) gc_malloc_atomic (bytesize);
+non_gc_bytes += (bytesize + 3) & ~3;
+return result;
+}
+
+word realloc(old,size) word old,size; {
+ int inc = size_of_obj_in_bytes(old);
+
+ non_gc_bytes += ((size + 3) & ~3) - inc;
+ return(gc_realloc(old, size);
+ }
+
--- /dev/null
+# include "gc.h"
+# include <setjmp.h>
+
+
+/* If no assembly calls are anticipated, it is only necessary to port */
+/* the mark_regs routine near the end of the file to your machine. */
+/* The allocobj and allocaobj routines are designed only as an assembly */
+/* language interface. The definitions of objfreelist and aobjfreelist */
+/* are useful only if in-line allocation code is generated. */
+
+/* Definitions similar to the following make it easier to access the free */
+/* lists from an assembly lnguage, or in-line C interface. */
+/* They should be added for other architectures. */
+
+
+struct __gc_arrays _gc_arrays = { 0 };
+ /* The purpose of the initialization is to force _gc_arrays */
+ /* into the data segment. The Fortran-based object file */
+ /* format used by many versions of UNIX otherwise makes the */
+ /* following impossible. (Note that some assemblers and */
+ /* linkers, notably those for Sun-3s, don't realize that */
+ /* this is impossible, and simply generate garbage.) */
+
+# ifdef M68K_SUN
+ asm(".globl _aobjfreelist");
+ asm(".globl _objfreelist");
+ asm("_aobjfreelist = __gc_arrays");
+ asm("_objfreelist = __gc_arrays+0x804");
+# endif
+# ifdef SPARC
+ asm(".global _aobjfreelist");
+ asm(".global _objfreelist");
+ asm("_aobjfreelist = __gc_arrays");
+ asm("_objfreelist = __gc_arrays+0x804");
+# endif
+# ifdef VAX
+ asm(".globl _aobjfreelist");
+ asm(".globl _objfreelist");
+ asm(".set _aobjfreelist,__gc_arrays");
+ asm(".set _objfreelist,__gc_arrays+0x804");
+# endif
+# ifdef RT
+ asm(".globl _aobjfreelist");
+ asm(".globl _objfreelist");
+ asm(".set _aobjfreelist,__gc_arrays");
+ asm(".set _objfreelist,__gc_arrays+0x804");
+# endif
+
+/* Call allocobj or allocaobj after first saving at least those registers */
+/* not preserved by the C compiler. The register used for return values */
+/* is not saved, since it will be clobbered anyway. */
+# ifdef RT
+ /* This is done in rt_allocobj.s */
+# else
+# ifdef M68K_HP
+ /* Optimizer is not safe, we want these suckers stored. */
+/* # pragma OPTIMIZE OFF - we claim this is unnecessary if -O flag */
+/* is not used. It breaks the collector */
+/* on other machines. */
+ asm(" text"); /* HP/Motorola assembler syntax */
+ asm(" global __allocobj");
+ asm(" global __allocaobj");
+ asm(" global _allocobj");
+ asm(" global _allocaobj");
+# else
+ asm(" .text"); /* Default (PDP-11 Unix syntax) */
+ asm(" .globl __allocobj");
+ asm(" .globl __allocaobj");
+ asm(" .globl _allocobj");
+ asm(" .globl _allocaobj");
+# endif
+
+# ifdef M68K_SUN
+ asm("_allocobj:");
+ asm(" link a6,#0");
+ asm(" movl d1,sp@-");
+ asm(" movl a0,sp@-");
+ asm(" movl a1,sp@-");
+ asm(" movl sp@(20),sp@-");
+ asm(" jbsr __allocobj");
+ asm(" addl #4,sp");
+ asm(" movl sp@+,a1");
+ asm(" movl sp@+,a0");
+ asm(" movl sp@+,d1");
+ asm(" unlk a6");
+ asm(" rts");
+
+ asm("_allocaobj:");
+ asm(" link a6,#0");
+ asm(" movl d1,sp@-");
+ asm(" movl a0,sp@-");
+ asm(" movl a1,sp@-");
+ asm(" movl sp@(20),sp@-");
+ asm(" jbsr __allocaobj");
+ asm(" addl #4,sp");
+ asm(" movl sp@+,a1");
+ asm(" movl sp@+,a0");
+ asm(" movl sp@+,d1");
+ asm(" unlk a6");
+ asm(" rts");
+# endif
+
+# ifdef M68K_HP
+ asm("_allocobj:");
+ asm(" link %a6,&0");
+ asm(" mov.l %d1,-(%sp)");
+ asm(" mov.l %a0,-(%sp)");
+ asm(" mov.l %a1,-(%sp)");
+ asm(" mov.l 20(%sp),-(%sp)");
+ asm(" jsr __allocobj");
+ asm(" add.l &4,%sp");
+ asm(" mov.l (%sp)+,%a1");
+ asm(" mov.l (%sp)+,%a0");
+ asm(" mov.l (%sp)+,%d1");
+ asm(" unlk %a6");
+ asm(" rts");
+
+ asm("_allocaobj:");
+ asm(" link %a6,&0");
+ asm(" mov.l %d1,-(%sp)");
+ asm(" mov.l %a0,-(%sp)");
+ asm(" mov.l %a1,-(%sp)");
+ asm(" mov.l 20(%sp),-(%sp)");
+ asm(" jsr __allocaobj");
+ asm(" add.l &4,%sp");
+ asm(" mov.l (%sp)+,%a1");
+ asm(" mov.l (%sp)+,%a0");
+ asm(" mov.l (%sp)+,%d1");
+ asm(" unlk %a6");
+ asm(" rts");
+# endif /* M68K_HP */
+
+# ifdef I386
+ asm(".data");
+ asm("gc_ret_value: .word 0");
+ asm(".word 0");
+ asm(".text");
+
+ asm("_allocaobj:");
+ asm("pushl %ebp");
+ asm("movl %esp,%ebp");
+ asm("pushal");
+ asm("pushl 8(%ebp)"); /* Push orignal argument */
+ asm("call __allocaobj");
+ asm("popl %ecx");
+ asm("movl %eax,gc_ret_value"); /* Save return value */
+ asm("popal");
+ asm("movl gc_ret_value,%eax");
+ asm("leave");
+ asm("ret");
+
+ asm("_allocobj:");
+ asm("pushl %ebp");
+ asm("movl %esp,%ebp");
+ asm("pushal");
+ asm("pushl 8(%ebp)"); /* Push orignal argument */
+ asm("call __allocobj");
+ asm("popl %ecx");
+ asm("movl %eax,gc_ret_value"); /* Save return value */
+ asm("popal");
+ asm("movl gc_ret_value,%eax");
+ asm("leave");
+ asm("ret");
+# endif
+
+# ifdef SPARC
+ asm("_allocaobj:");
+ asm(" ba __allocaobj");
+ asm(" nop");
+ asm("_allocobj:");
+ asm(" ba __allocobj");
+ asm(" nop");
+
+# include <sun4/trap.h>
+ asm(" .globl _save_regs_in_stack");
+ asm("_save_regs_in_stack:");
+ asm(" t 0x3 ! ST_FLUSH_WINDOWS");
+ asm(" mov %sp,%o0");
+ asm(" retl");
+ asm(" nop");
+# endif
+
+# ifdef VAX
+ asm("_allocobj:");
+ asm(".word 0x3e");
+ asm("pushl 4(ap)");
+ asm("calls $1,__allocobj");
+ asm("ret");
+ asm("_allocaobj:");
+ asm(".word 0x3e");
+ asm("pushl 4(ap)");
+ asm("calls $1,__allocaobj");
+ asm("ret");
+# endif
+
+# ifdef NS32K
+ asm("_allocobj:");
+ asm("enter [],$0");
+ asm("movd r1,tos");
+ asm("movd r2,tos");
+ asm("movd 8(fp),tos");
+ asm("bsr ?__allocobj");
+ asm("adjspb $-4");
+ asm("movd tos,r2");
+ asm("movd tos,r1");
+ asm("exit []");
+ asm("ret $0");
+ asm("_allocaobj:");
+ asm("enter [],$0");
+ asm("movd r1,tos");
+ asm("movd r2,tos");
+ asm("movd 8(fp),tos");
+ asm("bsr ?__allocaobj");
+ asm("adjspb $-4");
+ asm("movd tos,r2");
+ asm("movd tos,r1");
+ asm("exit []");
+ asm("ret $0");
+# endif
+
+
+# if !defined(VAX) && !defined(M68K_SUN) && !defined(M68K_HP)&& !defined(SPARC) && !defined(I386) && !defined(NS32K)
+ /* Assembly language interface routines undefined */
+# endif
+
+# endif
+
+/* Routine to mark from registers that are preserved by the C compiler. */
+/* This must be ported to every new architecture. There is a generic */
+/* version at the end, that is likely, but not guaranteed to work */
+/* on your architecture. Run the test_setjmp program to see whether */
+/* there is any chance it will work. */
+mark_regs()
+{
+# ifdef RT
+ register long TMP_SP; /* must be bound to r11 */
+# endif
+# ifdef VAX
+ /* VAX - generic code below does not work under 4.2 */
+ /* r1 through r5 are caller save, and therefore */
+ /* on the stack or dead. */
+ asm("pushl r11"); asm("calls $1,_tl_mark");
+ asm("pushl r10"); asm("calls $1,_tl_mark");
+ asm("pushl r9"); asm("calls $1,_tl_mark");
+ asm("pushl r8"); asm("calls $1,_tl_mark");
+ asm("pushl r7"); asm("calls $1,_tl_mark");
+ asm("pushl r6"); asm("calls $1,_tl_mark");
+# endif
+# ifdef M68K_SUN
+ /* M68K_SUN - could be replaced by generic code */
+ /* a0, a1 and d1 are caller save */
+ /* and therefore are on stack or dead. */
+
+ asm("subqw #0x4,sp"); /* allocate word on top of stack */
+
+ asm("movl a2,sp@"); asm("jbsr _tl_mark");
+ asm("movl a3,sp@"); asm("jbsr _tl_mark");
+ asm("movl a4,sp@"); asm("jbsr _tl_mark");
+ asm("movl a5,sp@"); asm("jbsr _tl_mark");
+ /* Skip frame pointer and stack pointer */
+ asm("movl d1,sp@"); asm("jbsr _tl_mark");
+ asm("movl d2,sp@"); asm("jbsr _tl_mark");
+ asm("movl d3,sp@"); asm("jbsr _tl_mark");
+ asm("movl d4,sp@"); asm("jbsr _tl_mark");
+ asm("movl d5,sp@"); asm("jbsr _tl_mark");
+ asm("movl d6,sp@"); asm("jbsr _tl_mark");
+ asm("movl d7,sp@"); asm("jbsr _tl_mark");
+
+ asm("addqw #0x4,sp"); /* put stack back where it was */
+# endif
+
+# ifdef M68K_HP
+ /* M68K_HP - could be replaced by generic code */
+ /* a0, a1 and d1 are caller save. */
+
+ asm("subq.w &0x4,%sp"); /* allocate word on top of stack */
+
+ asm("mov.l %a2,(%sp)"); asm("jsr _tl_mark");
+ asm("mov.l %a3,(%sp)"); asm("jsr _tl_mark");
+ asm("mov.l %a4,(%sp)"); asm("jsr _tl_mark");
+ asm("mov.l %a5,(%sp)"); asm("jsr _tl_mark");
+ /* Skip frame pointer and stack pointer */
+ asm("mov.l %d1,(%sp)"); asm("jsr _tl_mark");
+ asm("mov.l %d2,(%sp)"); asm("jsr _tl_mark");
+ asm("mov.l %d3,(%sp)"); asm("jsr _tl_mark");
+ asm("mov.l %d4,(%sp)"); asm("jsr _tl_mark");
+ asm("mov.l %d5,(%sp)"); asm("jsr _tl_mark");
+ asm("mov.l %d6,(%sp)"); asm("jsr _tl_mark");
+ asm("mov.l %d7,(%sp)"); asm("jsr _tl_mark");
+
+ asm("addq.w &0x4,%sp"); /* put stack back where it was */
+# endif /* M68K_HP */
+
+# ifdef I386
+ /* I386 code, generic code does not appear to work */
+ asm("pushl %eax"); asm("call _tl_mark"); asm("addl $4,%esp");
+ asm("pushl %ecx"); asm("call _tl_mark"); asm("addl $4,%esp");
+ asm("pushl %edx"); asm("call _tl_mark"); asm("addl $4,%esp");
+ asm("pushl %esi"); asm("call _tl_mark"); asm("addl $4,%esp");
+ asm("pushl %edi"); asm("call _tl_mark"); asm("addl $4,%esp");
+ asm("pushl %ebx"); asm("call _tl_mark"); asm("addl $4,%esp");
+# endif
+
+# ifdef NS32K
+ asm ("movd r3, tos"); asm ("bsr ?_tl_mark"); asm ("adjspb $-4");
+ asm ("movd r4, tos"); asm ("bsr ?_tl_mark"); asm ("adjspb $-4");
+ asm ("movd r5, tos"); asm ("bsr ?_tl_mark"); asm ("adjspb $-4");
+ asm ("movd r6, tos"); asm ("bsr ?_tl_mark"); asm ("adjspb $-4");
+ asm ("movd r7, tos"); asm ("bsr ?_tl_mark"); asm ("adjspb $-4");
+# endif
+
+# ifdef SPARC
+ /* generic code will not work */
+ save_regs_in_stack();
+# endif
+
+# ifdef RT
+ tl_mark(TMP_SP); /* tl_mark from r11 */
+
+ asm("cas r11, r6, r0"); tl_mark(TMP_SP); /* r6 */
+ asm("cas r11, r7, r0"); tl_mark(TMP_SP); /* through */
+ asm("cas r11, r8, r0"); tl_mark(TMP_SP); /* r10 */
+ asm("cas r11, r9, r0"); tl_mark(TMP_SP);
+ asm("cas r11, r10, r0"); tl_mark(TMP_SP);
+
+ asm("cas r11, r12, r0"); tl_mark(TMP_SP); /* r12 */
+ asm("cas r11, r13, r0"); tl_mark(TMP_SP); /* through */
+ asm("cas r11, r14, r0"); tl_mark(TMP_SP); /* r15 */
+ asm("cas r11, r15, r0"); tl_mark(TMP_SP);
+# endif
+
+# if 0
+ /* Generic code */
+ /* The idea is due to Parag Patel at HP. */
+ /* We're not sure whether he would like */
+ /* to be he acknowledged for it or not. */
+ {
+ jmp_buf regs;
+ register word * i = (word *) regs;
+ register word * lim = (word *) (((char *)(regs)) + (sizeof regs));
+
+ /* Setjmp on Sun 3s doesn't clear all of the buffer. */
+ /* That tends to preserve garbage. Clear it. */
+ for (; i < lim; i++) {
+ *i = 0;
+ }
+ (void) _setjmp(regs);
+ tl_mark_all(regs, lim);
+ }
+# endif
+
+ /* other machines... */
+# if !(defined M68K_SUN) && !defined(M68K_HP) && !(defined VAX) && !(defined RT) && !(defined SPARC) && !(defined I386) &&!(defined NS32K)
+ --> bad news <--
+# endif
+}
--- /dev/null
+# include <stdio.h>
+# include "gc.h"
+
+/* Call the mark routines (tl_mark for a single pointer, mark_all */
+/* on groups of pointers) on every top level accessible pointer. */
+/* This is source language specific. The following works for C. */
+
+mark_roots()
+{
+ int * dummy = 0;
+ long sp_approx = 0;
+
+ /*
+ * mark from registers - i.e., call tl_mark(i) for each
+ * register i
+ */
+ mark_regs(ALIGNMENT); /* usually defined in machine_dep.c */
+
+# ifdef DEBUG
+ gc_printf("done marking from regs - calling mark_all\n");
+# endif
+
+ /* put stack pointer into sp_approx */
+ /* and mark everything on the stack. */
+ /* A hack */
+ sp_approx = ((long)(&dummy));
+ mark_all( sp_approx, stacktop, ALIGNMENT );
+
+
+ /* Mark everything in data and bss segments. */
+ /* Skip gc data structures. (It's OK to mark these, but it wastes time.) */
+ {
+ extern char etext, end;
+
+ mark_all(DATASTART, begin_gc_arrays, ALIGNMENT);
+ mark_all(end_gc_arrays, &end, ALIGNMENT);
+ }
+}
+
+
+/* Top level mark routine. Mark from the object pointed to by p. */
+/* This is defined here, since alignment is not an explicit parameter. */
+/* Thus the routine is language specific. */
+/* Tl_mark is normally called by mark_regs, and thus must be defined. */
+void tl_mark(p)
+word * p;
+{
+ word * q;
+
+ q = p;
+ mark_all(&q, (&q)+1, ALIGNMENT);
+}
+
+/* Interface to mark_all that does not require alignment parameter. */
+/* Defined here to keep mach_dep.c programming language independent. */
+void tl_mark_all(b,t)
+word *b, *t;
+{
+ mark_all(b, t, ALIGNMENT);
+}
--- /dev/null
+# define call_mark(x) move $4,x; jal tl_mark
+
+ # Set up _gc_arrays with labels in the middle
+ .data
+ .globl _gc_arrays
+ .globl aobjfreelist
+ .globl objfreelist
+ .align 2
+_gc_arrays:
+aobjfreelist:
+ .word 0 : 513
+objfreelist:
+ .word 0 : 513
+ # either hblkmap or hblklist. Reserve space for HBLK_MAP, which is bigger.
+ .word 0 : 8192
+
+ .text
+ # Mark from machine registers that are saved by C compiler
+ .globl mark_regs
+ .ent mark_regs
+mark_regs:
+ subu $sp,4 ## Need to save only return address
+ sw $31,4($sp)
+ .mask 0x80000000,0
+ .frame $sp,4,$31
+ call_mark($2)
+ call_mark($3)
+ call_mark($16)
+ call_mark($17)
+ call_mark($18)
+ call_mark($19)
+ call_mark($20)
+ call_mark($21)
+ call_mark($22)
+ call_mark($23)
+ call_mark($30)
+ lw $31,4($sp)
+ addu $sp,4
+ j $31
+ .end mark_regs
+
+ .globl allocobj
+ .ent allocobj
+allocobj:
+ subu $sp,68
+ sw $31,68($sp)
+ sw $25,64($sp)
+ sw $24,60($sp)
+ sw $15,56($sp)
+ sw $14,52($sp)
+ sw $13,48($sp)
+ sw $12,44($sp)
+ sw $11,40($sp)
+ sw $10,36($sp)
+ sw $9,32($sp)
+ sw $8,28($sp)
+ sw $7,24($sp)
+ sw $6,20($sp)
+ sw $5,16($sp)
+ sw $4,12($sp)
+ sw $3,8($sp)
+ .set noat
+ sw $at,4($sp)
+ .set at
+ .mask 0x8300fffa,0
+ .frame $sp,68,$31
+ jal _allocobj
+ lw $31,68($sp)
+ lw $25,64($sp)
+ lw $24,60($sp)
+ lw $15,56($sp)
+ lw $14,52($sp)
+ lw $13,48($sp)
+ lw $12,44($sp)
+ lw $11,40($sp)
+ lw $10,36($sp)
+ lw $9,32($sp)
+ lw $8,28($sp)
+ lw $7,24($sp)
+ lw $6,20($sp)
+ lw $5,16($sp)
+ lw $4,12($sp)
+ lw $3,8($sp)
+ # don't restore $2, since it's the return value
+ .set noat
+ lw $at,4($sp)
+ .set at
+ addu $sp,68
+ j $31
+ .end allocobj
+
+ .globl allocaobj
+ .ent allocaobj
+allocaobj:
+ subu $sp,68
+ sw $31,68($sp)
+ sw $25,64($sp)
+ sw $24,60($sp)
+ sw $15,56($sp)
+ sw $14,52($sp)
+ sw $13,48($sp)
+ sw $12,44($sp)
+ sw $11,40($sp)
+ sw $10,36($sp)
+ sw $9,32($sp)
+ sw $8,28($sp)
+ sw $7,24($sp)
+ sw $6,20($sp)
+ sw $5,16($sp)
+ sw $4,12($sp)
+ sw $3,8($sp)
+ .set noat
+ sw $at,4($sp)
+ .set at
+ .mask 0x8300fffa,0
+ .frame $sp,68,$31
+ jal _allocaobj
+ lw $31,68($sp)
+ lw $25,64($sp)
+ lw $24,60($sp)
+ lw $15,56($sp)
+ lw $14,52($sp)
+ lw $13,48($sp)
+ lw $12,44($sp)
+ lw $11,40($sp)
+ lw $10,36($sp)
+ lw $9,32($sp)
+ lw $8,28($sp)
+ lw $7,24($sp)
+ lw $6,20($sp)
+ lw $5,16($sp)
+ lw $4,12($sp)
+ lw $3,8($sp)
+ # don't restore $2, since it's the return value
+ .set noat
+ lw $at,4($sp)
+ .set at
+ addu $sp,68
+ j $31
+ .end allocaobj
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991 by Xerox Corporation. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to copy this compiler for any purpose,
+ * provided the above notices are retained on all copies.
+ */
+
+#define DEBUG /* Some run-time consistency checks */
+#undef DEBUG
+#define VERBOSE
+#undef VERBOSE
+
+#include <stdio.h>
+#include <signal.h>
+#include "gc.h"
+
+int dont_gc = 0;
+extern long mem_found;
+
+# ifdef MERGE_SIZES
+# if MAXOBJSZ == MAXAOBJSZ
+# define MAXSZ MAXOBJSZ
+# else
+ --> causes problems here, since we cant map any size to a
+ size that doesnt have a free list. Either initialization
+ needs to be cleverer, or we need separate maps for atomic
+ and composite objects.
+# endif
+ long size_map[MAXSZ+1];
+
+ /* Set things up so that size_map[i] >= i, but not too much bigger */
+ /* and so that size_map contains relatively few distinct entries */
+ void init_size_map()
+ {
+ register int i;
+ register int i_rounded_up = 0;
+
+ for (i = 1; i < 8; i++) {
+# ifdef ALIGN_DOUBLE
+ size_map[i] = (i + 1) & (~1);
+# else
+ size_map[i] = i;
+# endif
+ }
+ for (i = 8; i <= MAXSZ; i++) {
+ if (i_rounded_up < i) {
+# ifdef ALIGN_DOUBLE
+ i_rounded_up = (i + (i >> 1) + 1) & (~1);
+# else
+ i_rounded_up = i + (i >> 1);
+# endif
+ if (i_rounded_up > MAXSZ) {
+ i_rounded_up = MAXSZ;
+ }
+ }
+ size_map[i] = i_rounded_up;
+ }
+ }
+# endif
+
+
+/* allocate lb bytes of atomic data */
+struct obj * gc_malloc_atomic(lb)
+int lb;
+{
+register struct obj *op;
+register struct obj **opp;
+register int lw = BYTES_TO_WORDS(lb + (sizeof (word)) -1);
+
+# ifdef VERBOSE
+ gc_printf("Here we are in gc_malloc_atomic(%d)\n",lw);
+# endif
+ if( lw <= MAXAOBJSZ ) {
+# ifdef MERGE_SIZES
+ lw = size_map[lw];
+# endif
+ opp = &(aobjfreelist[lw]);
+ if( (op = *opp) == ((struct obj *)0) ) {
+ op = _allocaobj(lw);
+ }
+# ifdef DEBUG
+ if ((op -> obj_link != ((struct obj *) 0)
+ && (((unsigned)(op -> obj_link)) > ((unsigned) HEAPLIM)
+ || ((unsigned)(op -> obj_link)) < ((unsigned) HEAPSTART)))) {
+ fprintf(stderr, "Bad free list in gc_malloc_atomic\n");
+ abort(op);
+ }
+# endif
+ *opp = op->obj_link;
+ op->obj_link = (struct obj *)0;
+ } else {
+ register struct hblk * h;
+ if (!sufficient_hb(-lw) && !dont_gc) {
+ gcollect();
+ }
+# ifdef VERBOSE
+ gc_printf("gc_malloc_atomic calling allochblk(%x)\n",lw);
+# endif
+ h = allochblk(-lw);
+ add_hblklist(h);
+ op = (struct obj *) (h -> hb_body);
+ }
+ return(op);
+}
+
+/* allocate lb bytes of possibly composite data */
+struct obj * gc_malloc(lb)
+int lb;
+{
+register struct obj *op;
+register struct obj **opp;
+register int lw = BYTES_TO_WORDS(lb + (sizeof (word)) -1);
+
+ if( lw <= MAXOBJSZ ) {
+# ifdef MERGE_SIZES
+ lw = size_map[lw];
+# endif
+ opp = &(objfreelist[lw]);
+ if( (op = *opp) == ((struct obj *)0) ) {
+ op = _allocobj(lw);
+ }
+# ifdef DEBUG
+ if ((op -> obj_link != ((struct obj *) 0)
+ && (((unsigned)(op -> obj_link)) > ((unsigned) HEAPLIM)
+ || ((unsigned)(op -> obj_link)) < ((unsigned) HEAPSTART)))) {
+ fprintf(stderr, "Bad free list in gc_malloc\n");
+ abort(op);
+ }
+# endif
+ *opp = op->obj_link;
+ op->obj_link = (struct obj *)0;
+ } else {
+ register struct hblk * h;
+
+ if (!sufficient_hb(lw) && !dont_gc) {
+ gcollect();
+ }
+# ifdef VERBOSE
+ gc_printf("gc_malloc calling allochblk(%x)\n",lw);
+# endif
+ h = allochblk(lw);
+ add_hblklist(h);
+ op = (struct obj *) (h -> hb_body);
+ }
+ return(op);
+}
+
+void gc_free();
+
+/* Change the size of the block pointed to by p to contain at least */
+/* lb bytes. The object may be (and quite likely will be) moved. */
+/* The new object is assumed to be atomic if the original object was. */
+/* Shrinking of large blocks is not implemented well. */
+struct obj * gc_realloc(p,lb)
+struct obj * p;
+int lb;
+{
+register struct obj *op;
+register struct obj **opp;
+register struct hblk * h;
+register int sz; /* Current size in bytes */
+register int orig_sz; /* Original sz in bytes */
+int is_atomic;
+
+ h = HBLKPTR(p);
+ sz = h -> hb_sz;
+ if (sz < 0) {
+ sz = -sz;
+ is_atomic = TRUE;
+ } else {
+ is_atomic = FALSE;
+ }
+ sz = WORDS_TO_BYTES(sz);
+ orig_sz = sz;
+
+ if (is_atomic) {
+ if (sz > WORDS_TO_BYTES(MAXAOBJSZ)) {
+ /* Round it up to the next whole heap block */
+ sz = (sz+sizeof(struct hblkhdr)+HBLKSIZE-1)
+ & (~HBLKMASK);
+ sz -= sizeof(struct hblkhdr);
+ h -> hb_sz = BYTES_TO_WORDS(sz);
+ }
+ if (lb <= sz) {
+ if (lb >= (sz >> 1)) {
+ /* Already big enough, but not too much bigger than object. */
+ /* Ignore the request. */
+ /* If sz is big enough, we should probably deallocate */
+ /* part of the heap block here, but ... */
+ return(p);
+ } else {
+ /* shrink */
+ struct obj * result = gc_malloc_atomic(lb);
+
+ bcopy(p, result, lb);
+ gc_free(p);
+ return(result);
+ }
+ } else {
+ /* grow */
+ struct obj * result = gc_malloc_atomic(lb);
+
+ bcopy(p, result, sz);
+ gc_free(p);
+ return(result);
+ }
+ } else /* composite */ {
+ if (sz > WORDS_TO_BYTES(MAXOBJSZ)) {
+ /* Round it up to the next whole heap block */
+ sz = (sz+sizeof(struct hblkhdr)+HBLKSIZE-1)
+ & (~HBLKMASK);
+ sz -= sizeof(struct hblkhdr);
+ h -> hb_sz = BYTES_TO_WORDS(sz);
+ /* Extra area is already cleared by allochblk. */
+ }
+ if (lb <= sz) {
+ if (lb >= (sz >> 1)) {
+ if (orig_sz > lb) {
+ /* Clear unneeded part of object to avoid bogus pointer */
+ /* tracing. */
+ bzero(((char *)p) + lb, orig_sz - lb);
+ }
+ return(p);
+ } else {
+ /* shrink */
+ struct obj * result = gc_malloc(lb);
+
+ bcopy(p, result, lb);
+ gc_free(p);
+ return(result);
+ }
+ } else {
+ /* grow */
+ struct obj * result = gc_malloc(lb);
+
+ bcopy(p, result, sz);
+ gc_free(p);
+ return(result);
+ }
+ }
+}
+
+/* Explicitly deallocate an object p */
+void gc_free(p)
+struct obj *p;
+{
+ register struct hblk *h;
+ register int sz;
+ register word * i;
+ register word * limit;
+
+ h = HBLKPTR(p);
+ sz = h -> hb_sz;
+ if (sz < 0) {
+ sz = -sz;
+ if (sz > MAXAOBJSZ) {
+ h -> hb_uninit = 1;
+ del_hblklist(h);
+ freehblk(h);
+ } else {
+ p -> obj_link = aobjfreelist[sz];
+ aobjfreelist[sz] = p;
+ }
+ } else {
+ /* Clear the object, other than link field */
+ limit = &(p -> obj_component[sz]);
+ for (i = &(p -> obj_component[1]); i < limit; i++) {
+ *i = 0;
+ }
+ if (sz > MAXOBJSZ) {
+ p -> obj_link = 0;
+ h -> hb_uninit = 0;
+ del_hblklist(h);
+ freehblk(h);
+ } else {
+ p -> obj_link = objfreelist[sz];
+ objfreelist[sz] = p;
+ }
+ }
+ /* Add it to mem_found to prevent anomalous heap expansion */
+ /* in the event of repeated explicit frees of objects of */
+ /* varying sizes. */
+ mem_found += sz;
+}
+
+
+/*
+ * Disable non-urgent signals
+ */
+int holdsigs()
+{
+ unsigned mask = 0xffffffff;
+
+ mask &= ~(1<<(SIGSEGV-1));
+ mask &= ~(1<<(SIGILL-1));
+ mask &= ~(1<<(SIGBUS-1));
+ mask &= ~(1<<(SIGIOT-1));
+ mask &= ~(1<<(SIGEMT-1));
+ mask &= ~(1<<(SIGTRAP-1));
+ mask &= ~(1<<(SIGQUIT-1));
+ return(sigsetmask(mask));
+}
+
+void gc_init()
+{
+ word dummy;
+# define STACKTOP_ALIGNMENT_M1 0xffffff
+
+ heaplim = (char *) (sbrk(0));
+# ifdef HBLK_MAP
+ heapstart = (char *) (HBLKPTR(((unsigned)sbrk(0))+HBLKSIZE-1 ));
+# endif
+# ifdef STACKTOP
+ stacktop = STACKTOP;
+# else
+ stacktop = (word *)((((long)(&dummy)) + STACKTOP_ALIGNMENT_M1)
+ & ~STACKTOP_ALIGNMENT_M1);
+# endif
+ hincr = HINCR;
+ expand_hp(hincr);
+ init_hblklist();
+# ifdef MERGE_SIZES
+ init_size_map();
+# endif
+}
+
+/* A version of printf that is unlikely to call malloc, and is thus safer */
+/* to call from the collector in case malloc has been bound to gc_malloc. */
+/* Assumes that no more than 1023 characters are written at once. */
+gc_printf(format, a, b, c, d, e, f)
+char * format;
+int a, b, c, d, e, f;
+{
+ char buf[1025];
+
+ buf[1025] = 0x15;
+ sprintf(buf, format, a, b, c, d, e, f);
+ if (buf[1025] != 0x15) abort("gc_printf clobbered stack");
+ if (write(1, buf, strlen(buf)) < 0) abort("write to stdout failed");
+}
\ No newline at end of file
--- /dev/null
+/*
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991 by Xerox Corporation. All rights reserved.
+ *
+ * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
+ * OR IMPLIED. ANY USE IS AT YOUR OWN RISK.
+ *
+ * Permission is hereby granted to copy this compiler for any purpose,
+ * provided the above notices are retained on all copies.
+ */
+
+#include <stdio.h>
+#include "gc.h"
+#define DEBUG
+#undef DEBUG
+#ifdef PRINTSTATS
+# define GATHERSTATS
+#endif
+
+long mem_found = 0; /* Number of longwords of memory reclaimed */
+
+long composite_in_use; /* Number of longwords in accessible composite */
+ /* objects. */
+
+long atomic_in_use; /* Number of longwords in accessible atomic */
+ /* objects. */
+
+# ifdef FIND_LEAK
+static report_leak(p, sz)
+long p, sz;
+{
+ /* Negative size ==> pointer-free (atomic) object */
+ /* sz is in words. */
+ abort(p, sz);
+}
+
+# define FOUND_FREE(hblk, word_no) \
+ if (abort_if_found) { \
+ report_leak((long)hblk + WORDS_TO_BYTES(word_no), hblk -> hb_sz); \
+ }
+# else
+# define FOUND_FREE(hblk, word_no)
+# endif
+
+/*
+ * reclaim phase
+ *
+ */
+
+reclaim(abort_if_found)
+int abort_if_found; /* Abort if a reclaimable object is found */
+{
+register struct hblk *hbp; /* ptr to current heap block */
+register int word_no; /* Number of word in block */
+register long i;
+register word *p; /* pointer to current word in block */
+register int mb; /* mark bit of current word */
+int sz; /* size of objects in current block */
+word *plim;
+struct hblk **nexthbp; /* ptr to ptr to current heap block */
+int nonempty; /* nonempty ^ done with block => block empty*/
+struct obj *list; /* used to build list of free words in block*/
+register int is_atomic; /* => current block contains atomic objs */
+
+# ifdef DEBUG
+ gc_printf("clearing all between %x and %x, %x and %x\n",
+ objfreelist, &objfreelist[MAXOBJSZ+1],
+ aobjfreelist,&aobjfreelist[MAXAOBJSZ+1]);
+# endif
+ if (!abort_if_found) {
+ register struct obj **fop;
+
+ for( fop = objfreelist; fop < &objfreelist[MAXOBJSZ+1]; fop++ ) {
+ *fop = (struct obj *)0;
+ }
+ for( fop = aobjfreelist; fop < &aobjfreelist[MAXAOBJSZ+1]; fop++ ) {
+ *fop = (struct obj *)0;
+ }
+ } /* otherwise free list objects are marked, and its safe to leave them */
+
+ atomic_in_use = 0;
+ composite_in_use = 0;
+
+# ifdef PRINTBLOCKS
+ gc_printf("reclaim: current block sizes:\n");
+# endif
+
+ /* go through all heap blocks (in hblklist) and reclaim unmarked objects */
+# ifdef HBLK_MAP
+ hbp = (struct hblk *) heapstart;
+ for (; ((char *)hbp) < heaplim; hbp++) if (is_hblk(hbp)) {
+/* fprintf(stderr, "Reclaiming in 0x%X\n", hbp); */
+# else
+ nexthbp = hblklist;
+ while( nexthbp < last_hblk ) {
+ hbp = *nexthbp++;
+# endif
+
+ nonempty = FALSE;
+ sz = hbp -> hb_sz;
+ is_atomic = 0;
+ if (sz < 0) {
+ sz = -sz;
+ is_atomic = 1; /* this block contains atomic objs */
+ }
+# ifdef PRINTBLOCKS
+ gc_printf("%d(%c",sz, (is_atomic)? 'a' : 'c');
+# endif
+
+ if( sz > (is_atomic? MAXAOBJSZ : MAXOBJSZ) ) { /* 1 big object */
+ mb = mark_bit(hbp, (hbp -> hb_body) - ((word *)(hbp)));
+ if( mb ) {
+# ifdef GATHERSTATS
+ if (is_atomic) {
+ atomic_in_use += sz;
+ } else {
+ composite_in_use += sz;
+ }
+# endif
+ nonempty = TRUE;
+ } else {
+ FOUND_FREE(hbp, (hbp -> hb_body) - ((word *)(hbp)));
+ mem_found += sz;
+ }
+ } else { /* group of smaller objects */
+ p = (word *)(hbp->hb_body);
+ word_no = ((word *)p) - ((word *)hbp);
+ plim = (word *)((((unsigned)hbp) + HBLKSIZE)
+ - WORDS_TO_BYTES(sz));
+
+ list = (is_atomic) ? aobjfreelist[sz] : objfreelist[sz];
+
+ /* go through all words in block */
+ while( p <= plim ) {
+ mb = mark_bit(hbp, word_no);
+
+ if( mb ) {
+# ifdef GATHERSTATS
+ if (is_atomic) atomic_in_use += sz;
+ else composite_in_use += sz;
+# endif
+# ifdef DEBUG
+ gc_printf("found a reachable obj\n");
+# endif
+ nonempty = TRUE;
+ p += sz;
+ } else {
+ FOUND_FREE(hbp, word_no);
+ mem_found += sz;
+ /* word is available - put on list */
+ ((struct obj *)p)->obj_link = list;
+ list = ((struct obj *)p);
+ if (is_atomic) {
+ p += sz;
+ } else {
+ /* Clear object, advance p to next object in the process */
+ i = (long)(p + sz);
+ p++; /* Skip link field */
+ while (p < (word *)i) {
+ *p++ = 0;
+ }
+ }
+ }
+ word_no += sz;
+ }
+
+ /*
+ * if block has reachable words in it, we can't reclaim the
+ * whole thing so put list of free words in block back on
+ * free list for this size.
+ */
+ if( nonempty ) {
+ if ( is_atomic ) aobjfreelist[sz] = list;
+ else objfreelist[sz] = list;
+ }
+ }
+
+# ifdef PRINTBLOCKS
+ gc_printf("%c),", nonempty ? 'n' : 'e' );
+# endif
+ if (!nonempty) {
+ if (!is_atomic && sz <= MAXOBJSZ) {
+ /* Clear words at beginning of objects */
+ /* Since most of it is already cleared */
+ p = (word *)(hbp->hb_body);
+ plim = (word *)((((unsigned)hbp) + HBLKSIZE)
+ - WORDS_TO_BYTES(sz));
+ while (p <= plim) {
+ *p = 0;
+ p += sz;
+ }
+ hbp -> hb_uninit = 0;
+ } else {
+ /* Mark it as being uninitialized */
+ hbp -> hb_uninit = 1;
+ }
+
+ /* remove this block from list of active blocks */
+ del_hblklist(hbp);
+
+# ifndef HBLK_MAP
+ /* This entry in hblklist just got replaced; look at it again */
+ /* This admittedly depends on the internals of del_hblklist... */
+ nexthbp--;
+# endif
+
+ freehblk(hbp);
+ } /* end if (one big object...) */
+ } /* end while (nexthbp ...) */
+
+# ifdef PRINTBLOCKS
+ gc_printf("\n");
+# endif
+}
--- /dev/null
+ # Set up _gc_arrays with labels in the middle
+ .csect data[RW]
+ .globl _gc_arrays
+ .globl aobjfreelist
+ .globl objfreelist
+ .align 2
+_gc_arrays:
+aobjfreelist:
+ .space 4*513
+objfreelist:
+ .space 4*513
+ # either hblkmap or hblklist. Reserve space for HBLK_MAP, which is bigger.
+ .space 4*8192
+
+ .csect
+ .set r0,0
+ .set r1,1
+ .set r2,2
+ .set r3,3
+ .set r4,4
+ .set r5,5
+ .set r6,6
+ .set r7,7
+ .set r8,8
+ .set r9,9
+ .set r10,10
+ .set r11,11
+ .set r12,12
+ .set r13,13
+ .set r14,14
+ .set r15,15
+ .set r16,16
+ .set r17,17
+ .set r18,18
+ .set r19,19
+ .set r20,20
+ .set r21,21
+ .set r22,22
+ .set r23,23
+ .set r24,24
+ .set r25,25
+ .set r26,26
+ .set r27,27
+ .set r28,28
+ .set r29,29
+ .set r30,30
+ .set r31,31
+
+ # Mark from machine registers that are saved by C compiler
+ .globl .mark_regs
+.mark_regs:
+ .extern .tl_mark
+ stu r1,-64(r1) # reserve stack frame
+ mflr r0 # save link register
+ st r0,0x48(r1)
+ oril r3,r2,0x0 # mark from r2
+ bl .tl_mark
+ cror 15,15,15
+ oril r3,r13,0x0 # mark from r13-r31
+ bl .tl_mark
+ cror 15,15,15
+ oril r3,r14,0x0
+ bl .tl_mark
+ cror 15,15,15
+ oril r3,r15,0x0
+ bl .tl_mark
+ cror 15,15,15
+ oril r3,r16,0x0
+ bl .tl_mark
+ cror 15,15,15
+ oril r3,r17,0x0
+ bl .tl_mark
+ cror 15,15,15
+ oril r3,r18,0x0
+ bl .tl_mark
+ cror 15,15,15
+ oril r3,r19,0x0
+ bl .tl_mark
+ cror 15,15,15
+ oril r3,r20,0x0
+ bl .tl_mark
+ cror 15,15,15
+ oril r3,r21,0x0
+ bl .tl_mark
+ cror 15,15,15
+ oril r3,r22,0x0
+ bl .tl_mark
+ cror 15,15,15
+ oril r3,r23,0x0
+ bl .tl_mark
+ cror 15,15,15
+ oril r3,r24,0x0
+ bl .tl_mark
+ cror 15,15,15
+ oril r3,r25,0x0
+ bl .tl_mark
+ cror 15,15,15
+ oril r3,r26,0x0
+ bl .tl_mark
+ cror 15,15,15
+ oril r3,r27,0x0
+ bl .tl_mark
+ cror 15,15,15
+ oril r3,r28,0x0
+ bl .tl_mark
+ cror 15,15,15
+ oril r3,r29,0x0
+ bl .tl_mark
+ cror 15,15,15
+ oril r3,r30,0x0
+ bl .tl_mark
+ cror 15,15,15
+ oril r3,r31,0x0
+ bl .tl_mark
+ cror 15,15,15
+ l r0,0x48(r1)
+ mtlr r0
+ ai r1,r1,64
+ br
--- /dev/null
+/*
+ * This (assembly) file contains the functions:
+ * struct obj * allocobj(sz)
+ * struct obj * allocaobj(sz)
+ */
+
+
+/*
+ * allocobj(i) insures that the free list entry for objects of size
+ * i is not empty.
+ *
+ * Call _allocobj after first saving the registers which
+ * are not guaranteed to be preserved (r0-r5 and r15).
+ *
+ * Note: the reason we have to use this interface between the caller
+ * and the garbage collector is in order to preserve the caller's registers
+ * which the C compiler would normally trash. We just stick 'em on the stack
+ * so that the mark_all procedure (which marks everything on the stack) will
+ * see them.
+ *
+ * this is the RT version.
+ */
+
+/* this prolog was copied from a cc-produced .s file */
+ .text
+ .align 2
+ .data
+ .align 2
+ .ltorg
+ .text
+ .ascii "<allocobj>"
+ .align 2
+ .globl _.allocobj
+_.allocobj:
+ .data
+ .globl _allocobj
+_allocobj: .long _.allocobj /* text area contains instr ptr */
+ .text
+ /*
+ * save registers which will be trashed on the stack in the place
+ * the RT linkage convention uses for saving registers
+ */
+ .using _allocobj,r14 /* tell assembler r14 is reliable base */
+ stm r3, -100+(3*4)(r1) /* we don't save r1 cause it's sp */
+ ai r1,r1,-(36+13*4)
+ mr r14, r0 /* initialize data area pointer */
+
+ balix r15, _._allocobj /* call _allocobj() */
+ get r0,$.long(__allocobj) /* get data area pointer */
+
+ lm r3, -100+(36+13*4)+(3*4)(r1) /* restore regs */
+ brx r15 /* return to caller (no restore req'd) */
+ ai r1, $(36+13*4) /* restore r1 to where it belongs */
+
+/* trace table for allocobj */
+ .align 2
+ .byte 0xdf /* magic1 */
+ .byte 0x07 /* code */
+ .byte 0xdf /* magic2 */
+ .byte 0x08 /* first_gpr << 4 | opt stuff */
+ .byte 0x01 /* no. args and stack reg num */
+ .byte 0x3c /* 0011 1100 ==> stack frame sz = 60 */
+ .data
+ .ltorg
+
+ .text
+ .ascii "<allocaobj>"
+ .align 2
+ .globl _.allocaobj
+_.allocaobj:
+ .data
+ .globl _allocaobj
+_allocaobj: .long _.allocaobj /* text area contains instr ptr */
+ .text
+ /*
+ * save registers which will be trashed on the stack in the place
+ * the RT linkage convention uses for saving registers
+ */
+ .using _allocaobj,r14 /* tell assembler r14 is reliable base */
+ stm r3, -100+(3*4)(r1) /* we don't save r1 cause it's sp */
+ ai r1,r1,-(36+13*4)
+ mr r14, r0 /* initialize data area pointer */
+
+ balix r15, _._allocaobj /* call _allocaobj() */
+ get r0,$.long(__allocaobj) /* get data area pointer */
+
+ lm r3, -100+(36+13*4)+(3*4)(r1) /* restore regs */
+ brx r15 /* return to caller (no restore req'd) */
+ ai r1, $(36+13*4) /* restore r1 to where it belongs */
+
+/* trace table for allocaobj */
+ .align 2
+ .byte 0xdf /* magic1 */
+ .byte 0x07 /* code */
+ .byte 0xdf /* magic2 */
+ .byte 0x08 /* first_gpr << 4 | opt stuff */
+ .byte 0x01 /* no. args and stack reg num */
+ .byte 0x3c /* 0011 1100 ==> stack frame sz = 60 */
+ .data
+ .ltorg
+
+
+.globl .oVpcc
+.globl .oVncs
+.set .oVpcc, 0
+.set .oVncs, 0
--- /dev/null
+/* Check whether setjmp actually saves registers in jmp_buf. */
+/* If it doesn't, the generic mark_regs code won't work. */
+/* Compilers vary as to whether they will put x in a */
+/* (callee-save) register without -O. The code is */
+/* contrived such that any decent compiler should put x in */
+/* a callee-save register with -O. Thus it is is */
+/* recommended that this be run optimized. (If the machine */
+/* has no callee-save registers, then the generic code is */
+/* safe, but this will not be noticed by this piece of */
+/* code.) */
+#include <stdio.h>
+#include <setjmp.h>
+#include "gc.h"
+main()
+{
+ jmp_buf b;
+ register int x = strlen("a"); /* 1, slightly disguised */
+ static int y = 0;
+
+ /* Encourage the compiler to keep x in a callee-save register */
+ printf("");
+ x = 2*x-1;
+ printf("");
+ x = 2*x-1;
+ setjmp(b);
+ if (y == 1) {
+ if (x == 2) {
+ printf("Generic mark_regs code probably wont work\n");
+# if defined(SPARC) || defined(IBMRS6000)
+ printf("Assembly code supplied\n");
+# else
+ printf("Need assembly code\n");
+# endif
+ } else if (x == 1) {
+ printf("Generic mark_regs code may work\n");
+ } else {
+ printf("Very strange setjmp implementation\n");
+ }
+ }
+ y++;
+ x = 2;
+ if (y == 1) longjmp(b,1);
+ return(0);
+}
+
+int g(x)
+int x;
+{
+ return(x);
+}
--- /dev/null
+/* Somewhat nonconvincing test for garbage collector. */
+/* Note that this intentionally uses the worlds worst implementation */
+/* of cons. It eats up gobs of memory in an attempt to break the */
+/* collector. Process size should grow to about 1.5 Meg and stay */
+/* there. */
+/* Should take about 25 seconds (2 minutes) to run on a */
+/* Sun 3/60 (Vax 11/750) */
+/* (The Vax does reasonably well here because the compiler assures */
+/* longword pointer alignment.) */
+
+# include <stdio.h>
+# include "cons.h"
+
+/* Return reverse(x) concatenated with y */
+sexpr reverse1(x, y)
+sexpr x, y;
+{
+ if (null(x)) {
+ return(y);
+ } else {
+ return( reverse1(cdr(x), cons(car(x), y)) );
+ }
+}
+
+sexpr reverse(x)
+sexpr x;
+{
+ return( reverse1(x, nil) );
+}
+
+sexpr ints(low, up)
+int low, up;
+{
+ if (low > up) {
+ return(nil);
+ } else {
+ return(cons(low, ints(low+1, up)));
+ }
+}
+
+void print_int_list(x)
+sexpr x;
+{
+ if (null(x)) {
+ printf("NIL\n");
+ } else {
+ printf("%d", car(x));
+ if (!null(cdr(x))) {
+ printf(", ");
+ print_int_list(cdr(x));
+ } else {
+ printf("\n");
+ }
+ }
+}
+
+/* Try to force a to be strangely aligned */
+struct {
+ char dummy;
+ sexpr aa;
+} A;
+#define a A.aa
+
+main()
+{
+ int i;
+ sexpr b;
+
+ gc_init();
+ a = ints(1, 100);
+ b = ints(1, 50);
+ print_int_list(a);
+ print_int_list(b);
+ print_int_list(reverse(a));
+ print_int_list(reverse(b));
+ for (i = 0; i < 100; i++) {
+ b = reverse(reverse(b));
+ }
+ print_int_list(a);
+ print_int_list(b);
+ print_int_list(reverse(a));
+ print_int_list(reverse(b));
+ return(0);
+}
+
projects / platform / upstream / libgc.git / commitdiff