gc4.0 tarball import gc4_0
authorHans Boehm <boehm@acm.org>
Thu, 7 Apr 1994 00:00:00 +0000 (00:00 +0000)
committerIvan Maidanski <ivmai@mail.ru>
Sat, 17 May 2014 12:31:29 +0000 (16:31 +0400)
53 files changed:
Makefile
NT_MAKEFILE [new file with mode: 0644]
OS2_MAKEFILE
PCR-Makefile
README
README.QUICK [new file with mode: 0644]
README.win32 [new file with mode: 0644]
allchblk.c [moved from allochblk.c with 95% similarity]
alloc.c
blacklst.c [moved from black_list.c with 97% similarity]
callprocs [new file with mode: 0755]
checksums.c
config.h
cord/cord.h
cord/cord_basics.c
cord/cord_extras.c
cord/cord_position.h
cord/cord_printf.c [new file with mode: 0644]
cord/cord_test.c
cord/de.c
cord/ec.h
dbg_mlc.c [moved from debug_malloc.c with 77% similarity]
dyn_load.c [moved from dynamic_load.c with 50% similarity]
finalize.c
gc.h
gc_c++.cc [new file with mode: 0644]
gc_c++.h [new file with mode: 0644]
gc_hdrs.h [moved from gc_headers.h with 89% similarity]
gc_inl.h [new file with mode: 0644]
gc_inline.h
gc_mark.h [new file with mode: 0644]
gc_priv.h [new file with mode: 0644]
gc_private.h
gc_typed.h [new file with mode: 0644]
headers.c
include/gc_typed.h [new file with mode: 0644]
mach_dep.c
malloc.c
mark.c
mark_roots.c [deleted file]
mark_rts.c [new file with mode: 0644]
misc.c
new_hblk.c
obj_map.c
os_dep.c
pcr_interface.c
real_malloc.c
reclaim.c
setjmp_t.c [moved from setjmp_test.c with 89% similarity]
solaris_threads.c [new file with mode: 0644]
stubborn.c
test.c
typd_mlc.c [new file with mode: 0644]

index cec5b41..29f8cc0 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -1,19 +1,57 @@
+# Primary targets:
+# gc.a - builds basic library
+# c++ - adds C++ interface to library and include directory
+# cords - adds cords (heavyweight strings) to library and include directory
+# test - prints porting information, then builds basic version of gc.a, and runs
+#        some tests of collector and cords.  Does not add cords or c++ interface to gc.a
+# cord/de - builds dumb editor based on cords.
+CC= cc
+CXX=g++
+# Needed only for "make c++", which adds the c++ interface
+
+CFLAGS= -O -DALL_INTERIOR_POINTERS -DSILENT
+# Setjmp_test may yield overly optimistic results when compiled
+# without optimization.
+# -DSILENT disables statistics printing, and improves performance.
+# -DCHECKSUMS reports on erroneously clear dirty bits, and unexpectedly
+#   altered stubborn objects, at substantial performance cost.
+# -DFIND_LEAK causes the collector to assume that all inaccessible
+#   objects should have been explicitly deallocated, and reports exceptions
+# -DSOLARIS_THREADS enables support for Solaris (thr_) threads.
+#   (Clients should also define SOLARIS_THREADS and then include
+#   gc.h before performing thr_ or GC_ operations.)
+# -DALL_INTERIOR_POINTERS allows all pointers to the interior
+#   of objects to be recognized.  (See gc_private.h for consequences.)
+# -DSMALL_CONFIG tries to tune the collector for small heap sizes,
+#   usually causing it to use less space in such situations.
+#   Incremental collection no longer works in this case.
+
+AR= ar
+RANLIB= ranlib
+
+
 # Redefining srcdir allows object code for the nonPCR version of the collector
 # to be generated in different directories
 srcdir = .
 VPATH = $(srcdir)
 
-OBJS= alloc.o reclaim.o allochblk.o misc.o mach_dep.o os_dep.o mark_roots.o headers.o mark.o obj_map.o black_list.o finalize.o new_hblk.o real_malloc.o dynamic_load.o debug_malloc.o malloc.o stubborn.o checksums.o
+OBJS= alloc.o reclaim.o allchblk.o misc.o mach_dep.o os_dep.o mark_rts.o headers.o mark.o obj_map.o blacklst.o finalize.o new_hblk.o dyn_load.o dbg_mlc.o malloc.o stubborn.o checksums.o solaris_threads.o typd_mlc.o
+
+CSRCS= reclaim.c allchblk.c misc.c alloc.c mach_dep.c os_dep.c mark_rts.c headers.c mark.c obj_map.c pcr_interface.c blacklst.c finalize.c new_hblk.c real_malloc.c dyn_load.c dbg_mlc.c malloc.c stubborn.c checksums.c solaris_threads.c typd_mlc.c
 
-CSRCS= reclaim.c allochblk.c misc.c alloc.c mach_dep.c os_dep.c mark_roots.c headers.c mark.c obj_map.c pcr_interface.c black_list.c finalize.c new_hblk.c real_malloc.c dynamic_load.c debug_malloc.c malloc.c stubborn.c checksums.c
+CORD_SRCS=  cord/cord_basics.c cord/cord_extras.c cord/cord_printf.c cord/de.c cord/cord_test.c cord/cord.h cord/ec.h cord/cord_position.h
 
-CORD_SRCS=  cord/cord_basics.c cord/cord_extras.c cord/de.c cord/cord_test.c cord/cord.h cord/ec.h cord/cord_position.h
+CORD_OBJS=  cord/cord_basics.o cord/cord_extras.o cord/cord_printf.o
 
-CORD_OBJS=  cord/cord_basics.o cord/cord_extras.o
+SRCS= $(CSRCS) mips_mach_dep.s rs6000_mach_dep.s alpha_mach_dep.s sparc_mach_dep.s gc.h gc_typed.h gc_hdrs.h gc_priv.h gc_private.h config.h gc_mark.h gc_inl.h gc_inline.h gc.man if_mach.c if_not_there.c gc_c++.cc gc_c++.h $(CORD_SRCS)
 
-SRCS= $(CSRCS) mips_mach_dep.s rs6000_mach_dep.s alpha_mach_dep.s sparc_mach_dep.s gc.h gc_headers.h gc_private.h config.h gc_inline.h gc.man if_mach.c if_not_there.c $(CORD_SRCS)
+OTHER_FILES= Makefile PCR-Makefile OS2_MAKEFILE NT_MAKEFILE \
+           README test.c setjmp_t.c SMakefile.amiga SCoptions.amiga \
+           README.amiga README.win32 cord/README include/gc.h \
+           include/gc_typed.h README.QUICK callprocs
 
-INCLUDE_FILES= gc.h cord/cord.h cord/ec.h cord/cord_position.h
+CORD_INCLUDE_FILES= $(srcdir)/gc.h $(srcdir)/cord/cord.h $(srcdir)/cord/ec.h \
+           $(srcdir)/cord/cord_position.h
 
 # Libraries needed for curses applications.  Only needed for de.
 CURSES= -lcurses -ltermlib
@@ -23,18 +61,6 @@ CURSES= -lcurses -ltermlib
 # the SHELL environment variable.
 SHELL= /bin/sh
 
-AR= ar
-RANLIB= ranlib
-CC= cc
-CFLAGS= -O -DSILENT
-# Setjmp_test may yield overly optimistic results when compiled
-# without optimization.
-# -DSILENT disables statistics printing, and improves performance.
-# -DCHECKSUMS reports on erroneously clear dirty bits, and unexpectedly
-# altered stubborn objects, at substantial performance cost.
-# -DFIND_LEAK causes the collector to assume that all inaccessible
-# objects should have been explicitly deallocated, and reports exceptions
-
 SPECIALCFLAGS = 
 # Alternative flags to the C compiler for mach_dep.c.
 # Mach_dep.c often doesn't like optimization, and it's
@@ -46,11 +72,17 @@ ALPHACFLAGS = -non_shared
 
 all: gc.a gctest
 
-pcr: PCR-Makefile gc_private.h gc_headers.h gc.h config.h mach_dep.o $(SRCS)
+pcr: PCR-Makefile gc_private.h gc_hdrs.h gc.h config.h mach_dep.o $(SRCS)
        make -f PCR-Makefile depend
        make -f PCR-Makefile
 
-$(OBJS) test.o: $(srcdir)/gc_private.h $(srcdir)/gc_headers.h $(srcdir)/gc.h $(srcdir)/config.h
+$(OBJS) test.o: $(srcdir)/gc_priv.h $(srcdir)/gc_hdrs.h $(srcdir)/gc.h \
+    $(srcdir)/config.h $(srcdir)/gc_typed.h Makefile
+# The dependency on Makefile is needed.  Changing
+# options such as -DSILENT affects the size of GC_arrays,
+# invalidating all .o files that rely on gc_priv.h
+
+mark.o typd_mlc.o finalize.o: $(srcdir)/gc_mark.h
 
 gc.a: $(OBJS)
        $(AR) ru gc.a $(OBJS)
@@ -60,9 +92,17 @@ gc.a: $(OBJS)
 cords: $(CORD_OBJS) cord/cord_test
        $(AR) ru gc.a $(CORD_OBJS)
        $(RANLIB) gc.a || cat /dev/null
-       ln cord/cord.h include/cord.h
-       ln cord/ec.h include/ec.h
-       ln cord/cord_position.h include/cord_position.h
+       cp $(srcdir)/cord/cord.h include/cord.h
+       cp $(srcdir)/cord/ec.h include/ec.h
+       cp $(srcdir)/cord/cord_position.h include/cord_position.h
+
+gc_c++.o: $(srcdir)/gc_c++..cc $(srcdir)/gc_c++.h
+       $(CXX) -c -O $(srcdir)/gc_c++..cc
+       
+c++: gc_c++.o $(srcdir)/gc_c++.h
+       $(AR) ru gc.a gc_c++.o
+       $(RANLIB) gc.a || cat /dev/null
+       cp $(srcdir)/gc_c++.h include/gc_c++.h 
 
 mach_dep.o: $(srcdir)/mach_dep.c $(srcdir)/mips_mach_dep.s $(srcdir)/rs6000_mach_dep.s if_mach if_not_there
        rm -f mach_dep.o
@@ -72,23 +112,30 @@ mach_dep.o: $(srcdir)/mach_dep.c $(srcdir)/mips_mach_dep.s $(srcdir)/rs6000_mach
        ./if_mach SPARC SUNOS5 as -o mach_dep.o $(srcdir)/sparc_mach_dep.s
        ./if_not_there mach_dep.o $(CC) -c $(SPECIALCFLAGS) $(srcdir)/mach_dep.c
 
-mark_roots.o: $(srcdir)/mark_roots.c
-       rm -f mark_roots.o
-       ./if_mach ALPHA "" $(CC) -c $(CFLAGS) -Wo,-notail $(srcdir)/mark_roots.c
-       ./if_not_there mark_roots.o $(CC) -c $(CFLAGS) $(srcdir)/mark_roots.c
+mark_rts.o: $(srcdir)/mark_rts.c if_mach if_not_there
+       rm -f mark_rts.o
+       ./if_mach ALPHA "" $(CC) -c $(CFLAGS) -Wo,-notail $(srcdir)/mark_rts.c
+       ./if_not_there mark_rts.o $(CC) -c $(CFLAGS) $(srcdir)/mark_rts.c
 #      work-around for DEC optimizer tail recursion elimination bug
 
-cord/cord_basics.o: $(srcdir)/cord/cord_basics.c $(INCLUDE_FILES)
+cord/cord_basics.o: $(srcdir)/cord/cord_basics.c $(CORD_INCLUDE_FILES)
        $(CC) $(CFLAGS) -c -o cord/cord_basics.o $(srcdir)/cord/cord_basics.c
 
-cord/cord_extras.o: $(srcdir)/cord/cord_extras.c $(INCLUDE_FILES)
+cord/cord_extras.o: $(srcdir)/cord/cord_extras.c $(CORD_INCLUDE_FILES)
        $(CC) $(CFLAGS) -c -o cord/cord_extras.o $(srcdir)/cord/cord_extras.c
 
+cord/cord_printf.o: $(srcdir)/cord/cord_printf.c $(CORD_INCLUDE_FILES)
+       $(CC) $(CFLAGS) -c -o cord/cord_printf.o $(srcdir)/cord/cord_printf.c
+
 cord/cord_test: $(srcdir)/cord/cord_test.c $(CORD_OBJS) gc.a
-       $(CC) $(CFLAGS) -o cord/cord_test $(srcdir)/cord/cord_test.c $(CORD_OBJS) gc.a
+       rm -f cord/cord_test
+       ./if_mach SPARC SUNOS5 $(CC) $(CFLAGS) -o cord/cord_test $(srcdir)/cord/cord_test.c $(CORD_OBJS) gc.a -lthread
+       ./if_not_there cord/cord_test $(CC) $(CFLAGS) -o cord/cord_test $(srcdir)/cord/cord_test.c $(CORD_OBJS) gc.a
 
 cord/de: $(srcdir)/cord/de.c $(CORD_OBJS) gc.a
-       $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c $(CORD_OBJS) gc.a $(CURSES)
+       rm -f cord/de
+       ./if_mach SPARC SUNOS5 $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c $(CORD_OBJS) gc.a $(CURSES) -lthread
+       ./if_not_there cord/de $(CC) $(CFLAGS) -o cord/de $(srcdir)/cord/de.c $(CORD_OBJS) gc.a $(CURSES)
 
 if_mach: $(srcdir)/if_mach.c $(srcdir)/config.h
        $(CC) $(CFLAGS) -o if_mach $(srcdir)/if_mach.c
@@ -105,15 +152,16 @@ clean:
 gctest: test.o gc.a if_mach if_not_there
        rm -f gctest
        ./if_mach ALPHA "" $(CC) $(CFLAGS) -o gctest $(ALPHACFLAGS) test.o gc.a
+       ./if_mach SPARC SUNOS5 $(CC) $(CFLAGS) -o gctest $(CFLAGS) test.o gc.a -lthread
        ./if_not_there gctest $(CC) $(CFLAGS) -o gctest test.o gc.a
 
 # If an optimized setjmp_test generates a segmentation fault,
 # odds are your compiler is broken.  Gctest may still work.
-# Try compiling setjmp_test unoptimized.
-setjmp_test: $(srcdir)/setjmp_test.c $(srcdir)/gc.h if_mach if_not_there
+# Try compiling setjmp_t.c unoptimized.
+setjmp_test: $(srcdir)/setjmp_t.c $(srcdir)/gc.h if_mach if_not_there
        rm -f setjmp_test
-       ./if_mach ALPHA "" $(CC) $(CFLAGS) -o setjmp_test $(ALPHACFLAGS) $(srcdir)/setjmp_test.c
-       ./if_not_there setjmp_test $(CC) $(CFLAGS) -o setjmp_test $(srcdir)/setjmp_test.c
+       ./if_mach ALPHA "" $(CC) $(CFLAGS) -o setjmp_test $(ALPHACFLAGS) $(srcdir)/setjmp_t.c
+       ./if_not_there setjmp_test $(CC) $(CFLAGS) -o setjmp_test $(srcdir)/setjmp_t.c
 
 test: setjmp_test gctest
        ./setjmp_test
@@ -121,9 +169,10 @@ test: setjmp_test gctest
        make cord/cord_test
        cord/cord_test
 
-tar:
-       tar cvf gc.tar $(SRCS) Makefile PCR-Makefile OS2_MAKEFILE README test.c setjmp_test.c \
-               SMakefile.amiga SCoptions.amiga README.amiga cord/README include/gc.h
+gc.tar: $(SRCS) $(OTHER_FILES)
+       tar cvf gc.tar $(SRCS) $(OTHER_FILES)
+
+gc.tar.Z: gc.tar
        compress gc.tar
 
 lint: $(CSRCS) test.c
diff --git a/NT_MAKEFILE b/NT_MAKEFILE
new file mode 100644 (file)
index 0000000..40d4bee
--- /dev/null
@@ -0,0 +1,25 @@
+# Makefile for Windows NT.  Assumes Microsoft compiler, and a single thread.
+# DLLs are included in the root set under NT, but not under win32S.
+
+!include <ntwin32.mak>
+
+# We also haven't figured out how to do partial links or build static libraries.  Hence a
+# client currently needs to link against all of the following:
+
+OBJS= alloc.obj reclaim.obj allchblk.obj misc.obj mach_dep.obj os_dep.obj mark_rts.obj headers.obj mark.obj obj_map.obj blacklst.obj finalize.obj new_hblk.obj dbg_mlc.obj malloc.obj stubborn.obj dyn_load.obj typd_mlc.obj
+
+all: $(OBJS) gctest.exe
+
+.c.obj:
+       $(cc) $(cdebug) $(cflags) $(cvars) -DSMALL_CONFIG -DSILENT -DALL_INTERIOR_POINTERS $*.c
+
+$(OBJS) test.obj: gc_priv.h gc_hdrs.h gc.h
+
+gctest.exe: test.obj gc.lib
+#      The following works for win32 debugging.  For win32s debugging use debugtype:coff
+#      and add mapsympe line.
+       $(link) -debug:full -debugtype:cv $(guiflags) -stack:131072 -out:$*.exe test.obj $(conlibs) gc.lib
+#      mapsympe -n -o gctest.sym gctest.exe
+
+gc.lib: $(OBJS)
+       lib32 /MACHINE:i386 /out:gc.lib $(OBJS)
\ No newline at end of file
index a5d98f8..96dcb96 100644 (file)
@@ -6,10 +6,10 @@
 # We also haven't figured out how to do partial links or build static libraries.  Hence a
 # client currently needs to link against all of the following:
 
-OBJS= alloc.obj reclaim.obj allochblk.obj misc.obj mach_dep.obj os_dep.obj mark_roots.obj headers.obj mark.obj obj_map.obj black_list.obj finalize.obj new_hblk.obj real_malloc.obj dynamic_load.obj debug_malloc.obj malloc.obj stubborn.obj
+OBJS= alloc.obj reclaim.obj allochblk.obj misc.obj mach_dep.obj os_dep.obj mark_rts.obj headers.obj mark.obj obj_map.obj blacklst.obj finalize.obj new_hblk.obj dbg_mlc.obj malloc.obj stubborn.obj typd_mlc.obj
 
 CC= icc
-CFLAGS= /O /Q /DSILENT
+CFLAGS= /O /Q /DSILENT /DSMALL_CONFIG /DALL_INTERIOR_POINTERS
 # Use /Ti instead of /O for debugging
 # Setjmp_test may yield overly optimistic results when compiled
 # without optimization.
index 0be383a..637ceb7 100644 (file)
@@ -1,6 +1,6 @@
-OBJS= alloc.o reclaim.o allochblk.o misc.o mach_dep.o os_dep.o mark_roots.o headers.o mark.o obj_map.o pcr_interface.o black_list.o finalize.o new_hblk.o real_malloc.o dynamic_load.o debug_malloc.o malloc.o stubborn.o
+OBJS= alloc.o reclaim.o allchblk.o misc.o mach_dep.o os_dep.o mark_rts.o headers.o mark.o obj_map.o pcr_interface.o blacklst.o finalize.o new_hblk.o real_malloc.o dynamic_load.o dbg_mlc.o malloc.o stubborn.o
 
-CSRCS= reclaim.c allochblk.c misc.c alloc.c mach_dep.c os_dep.c mark_roots.c headers.c mark.c obj_map.c pcr_interface.c black_list.c finalize.c new_hblk.c real_malloc.c dynamic_load.c debug_malloc.c malloc.c stubborn.c
+CSRCS= reclaim.c allchblk.c misc.c alloc.c mach_dep.c os_dep.c mark_rts.c headers.c mark.c obj_map.c pcr_interface.c blacklst.c finalize.c new_hblk.c real_malloc.c dynamic_load.c debug_mlc.c malloc.c stubborn.c
 
 SHELL= /bin/sh
 
diff --git a/README b/README
index 60381f5..2e0e2aa 100644 (file)
--- a/README
+++ b/README
@@ -8,7 +8,7 @@ Permission is hereby granted to copy this garbage collector for any purpose,
 provided the above notices are retained on all copies.
 
 
-This is version 3.7.  Note that functions were renamed since version 1.9
+This is version 4.0.  Note that functions were renamed since version 1.9
 to make naming consistent with PCR collectors.
 
 HISTORY -
@@ -34,11 +34,15 @@ specific code. Manuel Serrano (serrano@cornas.inria.fr) supplied linux and
 Sony News specific code.  Al Dosser provided Alpha/OSF/1 code.  He and
 Dave Detlefs(detlefs@src.dec.com) also provided several generic bug fixes.
 Alistair G. Crooks(agc@uts.amdahl.com) supplied the NetBSD and 386BSD ports.
+Jeffrey Hsu (hsu@soda.berkeley.edu) provided the FreeBSD port.
 Brent Benson (brent@jade.ssd.csd.harris.com) ported the collector to
 a Motorola 88K processor running CX/UX (Harris NightHawk).
 Ari Huttunen (Ari.Huttunen@hut.fi) generalized the OS/2 port to
 nonIBM development environments (a nontrivial task).
 David Chase, then at Olivetti Research, suggested several improvements.
+Scott Schwartz (schwartz@groucho.cse.psu.edu) supplied some of the
+code to save and print call stacks for leak detection on a SPARC.
+Jesse Hull and John Ellis supplied the C++ interface code.
 (Blame for misinstallation of these modifications goes to the first author,
 however.)
 
@@ -173,12 +177,15 @@ include subdirectory.  (Normally this is just gc.h.  "Make cord" adds
 "cord.h" and "ec.h".)
 
   The collector currently is designed to run essentially unmodified on
-the following machines:
+the following machines (most of the operating systems mentioned are
+trademarks of their respective holders):
 
            Sun 3
-           Sun 4 under SunOS 4.X or Solaris2.X
+           Sun 4 under SunOS 4.X or Solaris2.X (with or without threads)
            Vax under 4.3BSD, Ultrix
            Intel 386 or 486 under many operating systems, but not MSDOS.
+               (Win32S is somewhat supported, so it is possible to
+               build applications for Windows 3.1)
            Sequent Symmetry  (single threaded)
            Encore Multimax   (single threaded)
            MIPS M/120 (and presumably M/2000) (RISC/os 4.0 with BSD libraries)
@@ -194,13 +201,11 @@ the following machines:
            Commodore Amiga (see README.amiga)
            NeXT machines
 
-  For these machines you should check in config.h
-to verify that the machine type is correctly defined.  On 
-nonSun machines, you may also need to make changes to the
-Makefile, as described by comments there.
+  In a few cases (Amiga, OS/2, Win32) a separate makefile is supplied.
 
   Dynamic libraries are completely supported only under SunOS
-(and even that support is not functional on the last Sun 3 release).
+(and even that support is not functional on the last Sun 3 release),
+IRIX 5, Win32 (not Win32S) and OSF/1 on DEC AXP machines.
 On other machines we recommend that you do one of the following:
 
   1) Add dynamic library support (and send us the code).
@@ -379,7 +384,7 @@ near the top of gc_private.h.
 #define malloc(n) GC_malloc(n)
 #define calloc(m,n) GC_malloc((m)*(n))
 
-  For small pieces of VERY allocation intensive code, gc_inline.h
+  For small pieces of VERY allocation intensive code, gc_inl.h
 includes some allocation macros that may be used in place of GC_malloc
 and friends.
 
@@ -387,14 +392,8 @@ and friends.
 To avoid name conflicts, client code should avoid this prefix, except when
 accessing garbage collector routines or variables.
 
-  The internals of the collector understand different object "kinds" (sometimes
-called "regions").  By default, the only two kinds are ATOMIC and NORMAL.
-Its should be possible to add others, e.g. for data types for which layout
-information is known.  The allocation routine "GC_generic_malloc"
-takes an explicit kind argument.  (You will probably want to add
-faster kind-specific routines as well.) You will need to add another kind
-descriptor, including your own mark routine to add a new object kind.
-This requires a fairly detailed understanding of at least GC_mark.
+  Thre are provisions for allocation with explicit type information.
+This is rarely necessary.  Details can be found in gc_typed.h.
 
 
 USE AS LEAK DETECTOR:
@@ -402,19 +401,26 @@ 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_private.h.  This will cause the collector to invoke the report_leak
+gc_priv.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.
+not included here, except on SPARC machines.
   If all objects are allocated with GC_DEBUG_MALLOC (see next section),
 then the default version of report_leak will report the source file
 and line number at which the leaked object was allocated.  This may
-sometimes be sufficient.
-
+sometimes be sufficient.  (On SPARC/SUNOS4 machines, it will also report
+a cryptic stack trace.  This can often be turned into a sympolic stack
+trace by invoking program "foo" with "callprocs foo".  Callprocs is
+a short shell script that invokes adb to expand program counter values
+to symbolic addresses.  It was largely supplied by Scott Schwartz.)
+  Note that the debugging facilities described in the next section can
+sometimes be slightly LESS effective in leak finding mode, since in
+leak finding mode, GC_debug_free actually results in reuse of the object.
+(Otherwise the object is simply marked invalid.)
 
 DEBUGGING FACILITIES:
 
@@ -539,9 +545,9 @@ heap sizes.  But collection pauses will increase for larger heaps.
 per MB of accessible memory that needs to be scanned.  Your mileage
 may vary.)  The incremental/generational collection facility helps,
 but is portable only if "stubborn" allocation is used.
-  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.
+  Please address bug reports to boehm@parc.xerox.com.  If you are
+contemplatinga major addition, you might also send mail to ask whether
+it's already been done.
 
 RECENT VERSIONS:
 
@@ -718,4 +724,46 @@ Version 3.7:
 - Added a workaround for an HP/UX compiler bug.
 - Fixed another stack clearing performance bug.  Reworked
   that code once more.
-
+  
+Version 4.0:
+- Added support for Solaris threads (which was possible
+  only be reimplementing some fraction of Solaris threads,
+  since Sun doesn't currently make the thread debugging
+  interface available).
+- Added non-threads win32 and win32S support.
+- (Grudgingly, with suitable muttering of obscenities) renamed
+  files so that the collector distribution could live on a FAT
+  file system.  Files that are guaranteed to be useless on
+  a PC still have long names.  Gc_inline.h and gc_private.h
+  still exist, but now just include  gc_inl.h and gc_priv.h.
+- Fixed a really obscure bug in finalization that could cause
+  undetected mark stack overflows.  (I would be surprised if
+  any real code ever tickled this one.)
+- Changed finalization code to dynamically resize the hash
+  tables it maintains.  (This probably does not matter for well-
+  -written code.  It no doubt does for C++ code that overuses
+  destructors.)
+- Added typed allocation primitves.  Rewrote the marker to
+  accommodate them with more reasonable efficiency.  This
+  change should also speed up marking for GC_malloc allocated
+  objects a little.  See gc_typed.h for new primitives.
+- Improved debugging facilities slightly.  Allocation time
+  stack traces are now kept by default on SPARC/SUNOS4.
+  (Thanks to Scott Schwartz.)
+- Added better support for small heap applications.
+- Significantly extended cord package.  Fixed a bug in the
+  implementation of lazily read files.  Printf and friends now
+  have cord variants.  Cord traversals are a bit faster.
+- Made ALL_INTERIOR_POINTERS recognition the default.
+- Fixed de so that it can run in constant space, independent
+  of file size.  Added simple string searching to cords and de.
+- Added the Hull-Ellis C++ interface.
+- Added dynamic library support for OSF/1.
+  (Thanks to Al Dosser and Tim Bingham at DEC.)
+- Changed argument to GC_expand_hp to be expressed
+  in units of bytes instead of heap blocks.  (Necessary
+  since the heap block size now varies depending on
+  configuration.  The old version was never very clean.)
+- Added GC_get_heap_size().  The previous "equivalent"
+  was broken.
+- Restructured the Makefile a bit.  
diff --git a/README.QUICK b/README.QUICK
new file mode 100644 (file)
index 0000000..9778bdc
--- /dev/null
@@ -0,0 +1,33 @@
+Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+Copyright (c) 1991-1994 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.
+
+
+For more details and the names of other contributors, see the
+README file and gc.h.  This file describes typical use of
+the collector on a machine that is already supported.
+
+INSTALLATION:
+Under UN*X, type "make test".  Under OS/2 or Windows NT, copy the
+appropriate makefile to MAKEFILE, read it, and type "nmake test".
+Read the machine specific README if one exists.  The only way to
+develop code with the collector for Windows 3.1 is to develop under
+Windows NT, and then to use win32S.
+
+If you wish to use the cord (structured string) library type
+"make cords".  If you wish to use the collector from C++, type
+"make c++".  These add further files to gc.a and to the include
+subdirectory.  See cord/cord.h and gc_c++.h.
+
+TYPICAL USE:
+Include "gc.h" from this directory.  Link against the appropriate library
+("gc.a" under UN*X).  Replace calls to malloc by calls to GC_MALLOC,
+and calls to realloc by calls to GC_REALLOC.  If the object is known
+to never contain pointers, use GC_MALLOC_ATOMIC instead of
+GC_MALLOC.
+
diff --git a/README.win32 b/README.win32
new file mode 100644 (file)
index 0000000..7affdb1
--- /dev/null
@@ -0,0 +1,22 @@
+The collector currently does not handle multiple threads.  There
+is good reason to believe this is fixable.  (SRC M3 works with
+NT threads.)
+
+The collector has only been compiler under Windows NT, with the
+Microsoft tools.
+
+It runs under both win32s and win32, but with different semantics.
+Under win32, all writable pages outside of the heaps and stack are
+scanned for roots.  Thus the collector sees pointers in DLL data
+segments.  Under win32s, only the main data segment is scanned.
+Thus all accessible objects should be excessible from local variables
+or variables in the main data segment.
+
+(There are two reasons for this.  We didn't want to see many 16:16
+pointers.  And the VirtualQuery call has different semantics under
+the two systems.)
+
+The collector test program "gctest" is linked as a GUI application,
+but does not open any windows.  Its output appears in the file
+"gc.log".  It may be started from the file manager.  The hour glass
+cursor will appear as long as it's running.
\ No newline at end of file
similarity index 95%
rename from allochblk.c
rename to allchblk.c
index 5c22f2b..c7373ab 100644 (file)
@@ -8,11 +8,12 @@
  * Permission is hereby granted to copy this garbage collector for any purpose,
  * provided the above notices are retained on all copies.
  */
+/* Boehm, March 28, 1994 2:05 pm PST */
 
 #define DEBUG
 #undef DEBUG
 #include <stdio.h>
-#include "gc_private.h"
+#include "gc_priv.h"
 
 
 /**/
@@ -70,6 +71,8 @@ register hdr * hhdr;
 word sz;       /* object size in words */
 int kind;
 {
+    register word descr;
+    
     /* Add description of valid object pointers */
       if (!GC_add_map_entry(sz)) return(FALSE);
       hhdr -> hb_map = GC_obj_map[sz > MAXOBJSZ? 0 : sz];
@@ -77,12 +80,14 @@ int kind;
     /* Set size, kind and mark proc fields */
       hhdr -> hb_sz = sz;
       hhdr -> hb_obj_kind = kind;
-      hhdr -> hb_mark_proc = GC_obj_kinds[kind].ok_mark_proc;
+      descr = GC_obj_kinds[kind].ok_descriptor;
+      if (GC_obj_kinds[kind].ok_relocate_descr) descr += WORDS_TO_BYTES(sz);
+      hhdr -> hb_descr = descr;
       
     /* Clear mark bits */
       GC_clear_hdr_marks(hhdr);
       
-    hhdr -> hb_last_reclaimed = GC_gc_no;
+    hhdr -> hb_last_reclaimed = (unsigned short)GC_gc_no;
     return(TRUE);
 }
 
@@ -137,12 +142,12 @@ int kind;
            /* This prevents us from disassembling a single large block */
            /* to get tiny blocks.                                      */
            {
-             word next_size;
+             signed_word next_size;
              
              thishbp = hhdr -> hb_next;
              if (thishbp == 0) thishbp = GC_hblkfreelist; 
              thishdr = HDR(thishbp);
-             next_size = thishdr -> hb_sz;
+             next_size = (signed_word)(thishdr -> hb_sz);
              if (next_size < size_avail
                  && next_size >= size_needed
                  && !GC_is_black_listed(thishbp, (word)size_needed)) {
@@ -195,8 +200,7 @@ int kind;
                                  BYTES_TO_WORDS(hhdr->hb_sz - HDR_BYTES),
                                  PTRFREE); /* Cant fail */
                        if (GC_debugging_started) {
-                           bzero((char *)hbp + HDR_BYTES,
-                                 (int)(hhdr->hb_sz - HDR_BYTES));
+                           BZERO(hbp + HDR_BYTES, hhdr->hb_sz - HDR_BYTES);
                        }
                        if (GC_savhbp == hbp) GC_savhbp = prevhbp;
                      }
@@ -254,7 +258,7 @@ int kind;
     /* Clear block if necessary */
        if (GC_debugging_started
            || sz > MAXOBJSZ && GC_obj_kinds[kind].ok_init) {
-           bzero((char *)thishbp + HDR_BYTES,  (int)(size_needed - HDR_BYTES));
+           BZERO(thishbp + HDR_BYTES,  size_needed - HDR_BYTES);
        }
     
     return( thishbp );
diff --git a/alloc.c b/alloc.c
index 97b9c18..559289e 100644 (file)
--- a/alloc.c
+++ b/alloc.c
@@ -1,6 +1,6 @@
 /*
  * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
- * Copyright (c) 1991-1993 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1991-1994 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.
@@ -9,13 +9,13 @@
  * provided the above notices are retained on all copies.
  *
  */
-/* Boehm, November 18, 1993 12:30 pm PST */
+/* Boehm, April 6, 1994 10:55 am PDT */
 
 
 # include <stdio.h>
 # include <signal.h>
 # include <sys/types.h>
-# include "gc_private.h"
+# include "gc_priv.h"
 
 /*
  * Separate free lists are maintained for different sized objects
@@ -206,6 +206,8 @@ void GC_gcollect_inner()
 int GC_deficit = 0;    /* The number of extra calls to GC_mark_some    */
                        /* that we have made.                           */
                        /* Negative values are equivalent to 0.         */
+extern bool GC_collection_in_progress();
+
 void GC_collect_a_little(n)
 int n;
 {
@@ -518,6 +520,11 @@ word n;
        GC_printf2("Increasing heap size by %lu after %lu allocated bytes\n",
                   (unsigned long)bytes,
                   (unsigned long)WORDS_TO_BYTES(GC_words_allocd));
+#      ifdef UNDEFINED
+         GC_printf1("Root size = %lu\n", GC_root_size);
+         GC_print_block_list(); GC_print_hblkfreelist();
+         GC_printf0("\n");
+#      endif
 #   endif
     expansion_slop = 8 * WORDS_TO_BYTES(min_words_allocd());
     if (5 * HBLKSIZE * MAXHINCR > expansion_slop) {
@@ -542,8 +549,9 @@ word n;
 }
 
 /* Really returns a bool, but it's externally visible, so that's clumsy. */
-int GC_expand_hp(n)
-int n;
+/* Arguments is in bytes.                                              */
+int GC_expand_hp(bytes)
+size_t bytes;
 {
     int result;
     DCL_LOCK_STATE;
@@ -551,7 +559,7 @@ int n;
     DISABLE_SIGNALS();
     LOCK();
     if (!GC_is_initialized) GC_init_inner();
-    result = (int)GC_expand_hp_inner((word)n);
+    result = (int)GC_expand_hp_inner(divHBLKSZ((word)bytes));
     UNLOCK();
     ENABLE_SIGNALS();
     return(result);
similarity index 97%
rename from black_list.c
rename to blacklst.c
index 8dee33d..4946784 100644 (file)
@@ -8,7 +8,8 @@
  * Permission is hereby granted to copy this garbage collector for any purpose,
  * provided the above notices are retained on all copies.
  */
-# include "gc_private.h"
+/* Boehm, March 28, 1994 2:04 pm PST */
+# include "gc_priv.h"
 
 /*
  * We maintain several hash tables of hblks that have had false hits.
@@ -42,7 +43,7 @@ word * GC_incomplete_normal_bl;
 word * GC_old_stack_bl;
 word * GC_incomplete_stack_bl;
 
-GC_bl_init()
+void GC_bl_init()
 {
 # ifndef ALL_INTERIOR_POINTERS
     GC_old_normal_bl = (word *)
@@ -66,7 +67,7 @@ GC_bl_init()
 void GC_clear_bl(doomed)
 word *doomed;
 {
-    bzero((char *)doomed, (int)sizeof(page_hash_table));
+    BZERO(doomed, sizeof(page_hash_table));
 }
 
 /* Signal the completion of a collection.  Turn the incomplete black   */
diff --git a/callprocs b/callprocs
new file mode 100755 (executable)
index 0000000..4f105cc
--- /dev/null
+++ b/callprocs
@@ -0,0 +1,3 @@
+#!/bin/sh
+GC_DEBUG=1
+$* 2>&1 | awk '{print "0x3e=c\""$0"\""};/^\t##PC##=/ {if ($2 != 0) {print $2"?i"}}' | adb $1 | sed "s/^                >/>/"
index c284db7..4cfb074 100644 (file)
@@ -1,6 +1,16 @@
+/*
+ * Copyright (c) 1992-1994 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.
+ */
+/* Boehm, February 18, 1994 2:04 pm PST */
 # ifdef CHECKSUMS
 
-# include "gc_private.h"
+# include "gc_priv.h"
 
 /* This is debugging code intended to verify the results of dirty bit  */
 /* computations. Works only in a single threaded environment.          */
index aa720e4..5d45ee4 100644 (file)
--- a/config.h
+++ b/config.h
 #   define mach_type_known
 # endif
 # if defined(NeXT) && defined(mc68000)
-#    define M68K
-#    define NEXT
-#    define mach_type_known
+#   define M68K
+#   define NEXT
+#   define mach_type_known
+# endif
+# if defined(__FreeBSD__) && defined(i386)
+#   define I386
+#   define FREEBSD
+#   define mach_type_known
 # endif
 # if defined(__NetBSD__) && defined(i386)
+#   define I386
+#   define NETBSD
+#   define mach_type_known
+# endif
+# if defined(bsdi) && defined(i386)
 #    define I386
-#    define NETBSD
+#    define BSDI
 #    define mach_type_known
 # endif
 # if !defined(mach_type_known) && defined(__386BSD__)
-#    define I386
-#    define THREE86BSD
-#    define mach_type_known
+#   define I386
+#   define THREE86BSD
+#   define mach_type_known
 # endif
 # if defined(_CX_UX) && defined(_M88K)
-#    define M88K
-#    define CX_UX
-#    define mach_type_known
+#   define M88K
+#   define CX_UX
+#   define mach_type_known
+# endif
+# if defined(_MSDOS) && (_M_IX86 == 300) || (_M_IX86 == 400)
+#   define I386
+#   define MSWIN32     /* or Win32s */
+#   define mach_type_known
 # endif
 
 /* Feel free to add more clauses here */
                    /*             and AMIGA variants)                  */
                    /*             I386       ==> Intel 386             */
                    /*              (SEQUENT, OS2, SCO, LINUX, NETBSD,  */
-                   /*               THREE86BSD variants,               */
-                   /*               some are incomplete or untested)   */
+                   /*               FREEBSD, THREE86BSD, MSWIN32,      */
+                   /*               BSDI, SUNOS5 variants)             */
                     /*             NS32K      ==> Encore Multimax      */
                     /*             MIPS       ==> R2000 or R3000       */
                     /*                 (RISCOS, ULTRIX variants)       */
  *
  * CPP_WORD_SZ is a simple integer constant representing the word size.
  * in bits.  We assume byte addressibility, where a byte has 8 bits.
- * We also assume CPP_WORD_SZ is either 32 or 64.  Only 32 is completely
- * implemented.  (We care about the length of pointers, not hardware
+ * We also assume CPP_WORD_SZ is either 32 or 64.
+ * (We care about the length of pointers, not hardware
  * bus widths.  Thus a 64 bit processor with a C compiler that uses
- * 32 bit pointers should use CPP_WORD_SZ of 32, not 64.)
+ * 32 bit pointers should use CPP_WORD_SZ of 32, not 64. Default is 32.)
  *
  * MACH_TYPE is a string representation of the machine type.
  * OS_TYPE is analogous for the OS.
  * implementation to be used:
  *   MPROTECT_VDB: Write protect the heap and catch faults.
  *   PROC_VDB: Use the SVR4 /proc primitives to read dirty bits.
+ *
+ * An architecture may define DYNAMIC_LOADING if dynamic_load.c
+ * defined GC_register_dynamic_libraries() for the architecture.
  */
 
 
        extern char etext;
 #      define DATASTART ((ptr_t)((((word) (&etext)) + 0x1ffff) & ~0x1ffff))
 #      define HEURISTIC1       /* differs      */
+#      define DYNAMIC_LOADING
 #   endif
 #   ifdef HP
 #      define OS_TYPE "HP"
 #      define MPROTECT_VDB
 #   endif
 #   define HEURISTIC1
+#   define DYNAMIC_LOADING
 # endif
 
 # ifdef I386
 #   endif
 #   ifdef OS2
 #      define OS_TYPE "OS2"
-#      define DATASTART ((ptr_t)((((word) (&etext)) + 0x3fffff) \
-                                 & ~0x3fffff) \
-                                +((word)&etext & 0xfff))
-               /* STACKBOTTOM is handled specially in GC_init_inner.   */
-               /* OS2 actually has the right system call!              */
+               /* STACKBOTTOM and DATASTART are handled specially in   */
+               /* os_dep.c. OS2 actually has the right                 */
+               /* system call!                                         */
+#   endif
+#   ifdef MSWIN32
+#      define OS_TYPE "MSWIN32"
+               /* STACKBOTTOM and DATASTART are handled specially in   */
+               /* os_dep.c.                                            */
+#   endif
+#   ifdef FREEBSD
+#      define OS_TYPE "FREEBSD"
+#      define MPROTECT_VDB
 #   endif
 #   ifdef NETBSD
 #      define OS_TYPE "NETBSD"
-#      define HEURISTIC2
-       extern char etext;
-#      define DATASTART ((ptr_t)(&etext))
-#    endif
+#   endif
 #   ifdef THREE86BSD
 #      define OS_TYPE "THREE86BSD"
-#      define ALIGNMENT 4
+#   endif
+#   ifdef BSDI
+#      define OS_TYPE "BSDI"
+#   endif
+#   if defined(FREEBSD) || defined(NETBSD) \
+        || defined(THREE86BSD) || defined(BSDI)
+#      define HEURISTIC2
        extern char etext;
 #      define DATASTART ((ptr_t)(&etext))
-#    endif
+#   endif
 # endif
 
 # ifdef NS32K
 #   ifdef IRIX5
 #      define OS_TYPE "IRIX5"
 #      define MPROTECT_VDB
+#      define DYNAMIC_LOADING
 #   endif
 # endif
 
 # endif
 
 # ifdef PCR
+#   undef DYNAMIC_LOADING
 #   undef STACKBOTTOM
 #   undef HEURISTIC1
 #   undef HEURISTIC2
 #   undef MPROTECT_VDB
 # endif
 
+# ifdef SMALL_CONFIG
+/* Presumably not worth the space it takes. */
+#   undef PROC_VDB
+#   undef MPROTECT_VDB
+# endif
+
 # if !defined(PCR_VDB) && !defined(PROC_VDB) && !defined(MPROTECT_VDB)
 #   define DEFAULT_VDB
 # endif
index a6795bd..5ed2222 100644 (file)
@@ -9,6 +9,7 @@
  *
  * Author: Hans-J. Boehm (boehm@parc.xerox.com)
  */
+/* Boehm, January 21, 1994 5:10 pm PST */
  
 /*
  * Cords are immutable character strings.  A number of operations
@@ -159,7 +160,7 @@ int CORD_riter(CORD x, CORD_iter_fn f1, void * client_data);
        /* Move the position to the preceding character.
        /* P must be initialized and valid.
        /* Invalidates p if past beginning:
-       void CORD_next(CORD_pos p);
+       void CORD_prev(CORD_pos p);
        
        /* Is the position valid, i.e. inside the cord?
        int CORD_pos_valid(CORD_pos p);
@@ -179,15 +180,29 @@ void CORD_dump(CORD x);
 /* The following could easily be implemented by the client.  They are  */
 /* provided in cord_extras.c for convenience.                          */
 
+/* Concatenate a character to the end of a cord.       */
+CORD CORD_cat_char(CORD x, char c);
+
 /* Return the character in CORD_substr(x, i, 1)        */
 char CORD_fetch(CORD x, size_t i);
 
 /* Return < 0, 0, or > 0, depending on whether x < y, x = y, x > y     */
 int CORD_cmp(CORD x, CORD y);
 
-/* Return a cord consisting of i ASCII NULs.  Dangerous in             */
-/* conjunction with CORD_to_char_star.                                 */
-CORD CORD_nul(size_t i);
+/* A generalization that takes both starting positions for the                 */
+/* comparison, and a limit on the number of characters to be compared. */
+int CORD_ncmp(CORD x, size_t x_start, CORD y, size_t y_start, size_t len);
+
+/* Find the first occurrence of s in x at position start or later.     */
+/* Return the position of the first character of s in x, or            */
+/* CORD_NOT_FOUND if there is none.                                    */
+size_t CORD_str(CORD x, size_t start, CORD s);
+
+/* Return a cord consisting of i copies of (possibly NUL) c.  Dangerous        */
+/* in conjunction with CORD_to_char_star.                              */
+/* The resulting representation takes constant space, independent of i.        */
+CORD CORD_chars(char c, size_t i);
+# define CORD_nul(i) CORD_chars('\0', (i))
 
 /* Turn a file into cord.  The file must be seekable.  Its contents    */
 /* must remain constant.  The file may be accessed as an immediate     */
@@ -231,4 +246,43 @@ size_t CORD_chr(CORD x, size_t i, int c);
 /* of (char) c inside x at position i or earlier. The value i          */
 /* must be < CORD_len(x).                                              */
 size_t CORD_rchr(CORD x, size_t i, int c);
+
+
+/* The following are also not primitive, but are implemented in        */
+/* cord_printf.c.  They provide functionality similar to the ANSI C    */
+/* functions with corresponding names, but with the following          */
+/* additions and changes:                                              */
+/* 1. A %r conversion specification specifies a CORD argument.  Field  */
+/*    width, precision, etc. have the same semantics as for %s.                */
+/*    (Note that %c,%C, and %S were already taken.)                    */
+/* 2. The format string is represented as a CORD.                      */
+/* 3. CORD_sprintf and CORD_vsprintf assign the result through the 1st */      /*    argument. Unlike their ANSI C versions, there is no need to guess */
+/*    the correct buffer size.                                         */
+/* 4. Most of the conversions are implement through the native                 */
+/*    vsprintf.  Hence they are usually no faster, and                         */
+/*    idiosyncracies of the native printf are preserved.  However,     */
+/*    CORD arguments to CORD_sprintf and CORD_vsprintf are NOT copied; */
+/*    the result shares the original structure.  This may make them    */
+/*    very efficient in some unusual applications.                     */
+/*    The format string is copied.                                     */
+/* All functions return the number of characters generated or -1 on    */
+/* error.  This complies with the ANSI standard, but is inconsistent   */
+/* with some older implementations of sprintf.                         */
+
+/* The implementation of these is probably less portable than the rest */
+/* of this package.                                                    */
+
+#ifndef CORD_NO_IO
+
+#include <stdarg.h>
+
+int CORD_sprintf(CORD * out, CORD format, ...);
+int CORD_vsprintf(CORD * out, CORD format, va_list args);
+int CORD_fprintf(FILE * f, CORD format, ...);
+int CORD_vfprintf(FILE * f, CORD format, va_list args);
+int CORD_printf(CORD format, ...);
+int CORD_vprintf(CORD format, va_list args);
+
+#endif /* CORD_NO_IO */
+
 # endif /* CORD_H */
index 345761e..2d2ae21 100644 (file)
@@ -757,7 +757,7 @@ void CORD__extend_path(register CORD_pos p)
 
 char CORD__pos_fetch(register CORD_pos p)
 {
-    /* Leaf is not a function node */
+    /* Leaf is a function node */
     struct CORD_pe * pe = &((p)[0].path[(p)[0].path_len]);
     CORD leaf = pe -> pe_cord;
     register struct Function * f = &(((CordRep *)leaf) -> function);
@@ -768,22 +768,42 @@ char CORD__pos_fetch(register CORD_pos p)
 
 void CORD__next(register CORD_pos p)
 {
+    register size_t cur_pos = p[0].cur_pos + 1;
+    register struct CORD_pe * current_pe = &((p)[0].path[(p)[0].path_len]);
+    register CORD leaf = current_pe -> pe_cord;
+    
     /* Leaf is not a string or we're at end of leaf */
-    p[0].cur_pos++;
-    if (p[0].cur_end == 0) {
+    p[0].cur_pos = cur_pos;
+    if (!IS_STRING(leaf)) {
        /* Function leaf        */
-       struct CORD_pe * pe = &(p[0].path[p[0].path_len]);
-       CORD leaf = pe -> pe_cord;
        register struct Function * f = &(((CordRep *)leaf) -> function);
+       register size_t start_pos = current_pe -> pe_start_pos;
+       register size_t end_pos = start_pos + f -> len;
        
-       if (p[0].cur_pos < pe -> pe_start_pos + f -> len) return;
+       if (cur_pos < end_pos) {
+         /* Fill cache and return. */
+           register int i;
+           register int limit = cur_pos + FUNCTION_BUF_SZ;
+           register CORD_fn fn = f -> fn;
+           register void * client_data = f -> client_data;
+           
+           if (limit > end_pos) {
+               limit = end_pos;
+           }
+           for (i = cur_pos; i < limit; i++) {
+               p[0].function_buf[i - cur_pos] =
+                       (*fn)(i - start_pos, client_data);
+           }
+           p[0].cur_start = cur_pos;
+           p[0].cur_leaf = p[0].function_buf;
+           p[0].cur_end = limit;
+           return;
+       }
     }
     /* End of leaf     */
     /* Pop the stack until we find two concatenation nodes with the    */
     /* same start position: this implies we were in left part.         */
     {
-       register struct CORD_pe * current_pe = &((p)[0].path[(p)[0].path_len]);
-       
        while (p[0].path_len > 0
               && current_pe[0].pe_start_pos != current_pe[-1].pe_start_pos) {
            p[0].path_len--;
index b4bc6af..67b6f11 100644 (file)
@@ -1,5 +1,5 @@
 /*
- * Copyright (c) 1993 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1993-1994 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.
@@ -14,6 +14,7 @@
  * implementation.  They serve also serve as example client code for
  * cord_basics.
  */
+/* Boehm, January 4, 1994 5:53 pm PST */
 # include <stdio.h>
 # include <string.h>
 # include "cord.h"
@@ -40,9 +41,20 @@ typedef void (* oom_fn)(void);
 # define OUT_OF_MEMORY {  if (CORD_oom_fn != (oom_fn) 0) (*CORD_oom_fn)(); \
                          abort("Out of memory\n"); }
 
+CORD CORD_cat_char(CORD x, char c)
+{
+    register char * string;
+    
+    if (c == '\0') return(CORD_cat(x, CORD_nul(1)));
+    string = GC_MALLOC_ATOMIC(2);
+    if (string == 0) OUT_OF_MEMORY;
+    string[0] = c;
+    string[1] = '\0';
+    return(CORD_cat_char_star(x, string, 1));
+}
+
 typedef struct {
-       size_t min;
-       size_t max;
+       size_t len;
        size_t count;
        char * buf;
 } CORD_fill_data;
@@ -54,7 +66,7 @@ int CORD_fill_proc(char c, void * client_data)
     
     (d -> buf)[count] = c;
     d -> count = ++count;
-    if (count >= d -> min) {
+    if (count >= d -> len) {
        return(1);
     } else {
        return(0);
@@ -65,114 +77,119 @@ int CORD_batched_fill_proc(const char * s, void * client_data)
 {
     register CORD_fill_data * d = (CORD_fill_data *)client_data;
     register size_t count = d -> count;
-    register size_t max = d -> max;
+    register size_t max = d -> len;
     register char * buf = d -> buf;
     register const char * t = s;
     
     while(((d -> buf)[count] = *t++) != '\0') {
         count++;
-        if (count >= max) break;
+        if (count >= max) {
+            d -> count = count;
+            return(1);
+        }
     }
     d -> count = count;
-    if (count >= d -> min) {
-       return(1);
-    } else {
-       return(0);
-    }
+    return(0);
 }
 
-/* Fill buf with between min and max characters starting at i.  Returns */
-/* the number of characters actually put in buf. Assumes min characters        */
-/* are available.                                                      */ 
-size_t CORD_fill_buf(CORD x, size_t i, size_t min,
-                            size_t max, char * buf)
+/* Fill buf with between min and max characters starting at i.         */
+/* Assumes len characters are available.                               */ 
+void CORD_fill_buf(CORD x, size_t i, size_t len, char * buf)
 {
     CORD_fill_data fd;
     
-    fd.min = min;
-    fd.max = max;
+    fd.len = len;
     fd.buf = buf;
     fd.count = 0;
     (void)CORD_iter5(x, i, CORD_fill_proc, CORD_batched_fill_proc, &fd);
-    return(fd.count);
 }
 
-
-/* Compare two nonempty strings the hard way. */
-int CORD_cmp_general_case(CORD x, size_t xlen, CORD y, size_t ylen)
+int CORD_cmp(CORD x, CORD y)
 {
-    char xbuf [BUFSZ];
-    char ybuf [BUFSZ];
-    register size_t pos = 0;   /* First position not yet transfered to xbuf */
-    register size_t n_to_get;
-    register int result;  
-    for (;;) {
-        n_to_get = BUFSZ;
-        if (xlen < BUFSZ) n_to_get = xlen;
-        if (ylen < n_to_get) n_to_get = ylen;
-        (void) CORD_fill_buf(x, pos, n_to_get, n_to_get, xbuf);
-        (void) CORD_fill_buf(y, pos, n_to_get, n_to_get, ybuf);
-        result = strncmp(xbuf,ybuf,n_to_get);
-        if (result != 0) return(result);
-        pos += n_to_get; xlen -= n_to_get; ylen -= n_to_get;
-        if (xlen == 0) {
-            if (ylen == 0) {
-               return(0);
-            } else {
+    CORD_pos xpos;
+    CORD_pos ypos;
+    register size_t avail, yavail;
+    
+    if (y == CORD_EMPTY) return(x != CORD_EMPTY);
+    if (x == CORD_EMPTY) return(-1);
+    if (IS_STRING(y) && IS_STRING(x)) return(strcmp(x,y));
+    CORD_set_pos(xpos, x, 0);
+    CORD_set_pos(ypos, y, 0);
+    for(;;) {
+        if (!CORD_pos_valid(xpos)) {
+            if (CORD_pos_valid(ypos)) {
                return(-1);
+            } else {
+                return(0);
             }
         }
-        if (ylen == 0) {
+        if (!CORD_pos_valid(ypos)) {
             return(1);
         }
+        if ((avail = CORD_pos_chars_left(xpos)) <= 0
+            || (yavail = CORD_pos_chars_left(ypos)) <= 0) {
+            register char xcurrent = CORD_pos_fetch(xpos);
+            register char ycurrent = CORD_pos_fetch(ypos);
+            if (xcurrent != ycurrent) return(xcurrent - ycurrent);
+            CORD_next(xpos);
+            CORD_next(ypos);
+        } else {
+            /* process as many characters as we can    */
+            register int result;
+            
+            if (avail > yavail) avail = yavail;
+            result = strncmp(CORD_pos_cur_char_addr(xpos),
+                            CORD_pos_cur_char_addr(ypos), avail);
+            if (result != 0) return(result);
+            CORD_pos_advance(xpos, avail);
+            CORD_pos_advance(ypos, avail);
+        }
     }
 }
 
-
-int CORD_cmp(CORD x, CORD y)
+int CORD_ncmp(CORD x, size_t x_start, CORD y, size_t y_start, size_t len)
 {
-    if (x == 0) {
-        if (y == 0) {
-            return (0);
-        } else {
-            return(-1);
+    CORD_pos xpos;
+    CORD_pos ypos;
+    register size_t count;
+    register size_t avail, yavail;
+    
+    CORD_set_pos(xpos, x, x_start);
+    CORD_set_pos(ypos, y, y_start);
+    for(count = 0; count < len;) {
+        if (!CORD_pos_valid(xpos)) {
+            if (CORD_pos_valid(ypos)) {
+               return(-1);
+            } else {
+                return(0);
+            }
         }
-    }
-    if (y == 0) return(1);
-    if(IS_STRING(x) && IS_STRING(y)) {
-        return(strcmp(x, y));
-    }
-    {
-#      define SBUFLEN 30
-#      define MINCMPLEN 5
-        char xbuf[SBUFLEN];
-        char ybuf[SBUFLEN];
-        register size_t xlen = CORD_len(x);
-        register size_t ylen = CORD_len(y);
-        register size_t req_len = 0;
-        register int result;
-        
-        if (xlen <= SBUFLEN) req_len = xlen;
-        if (ylen <= SBUFLEN && ylen < xlen) req_len = ylen;
-        if (req_len != 0) {
-            (void) CORD_fill_buf(x, 0, req_len, req_len, xbuf);
-            (void) CORD_fill_buf(x, 0, req_len, req_len, ybuf);
-            result = strncmp(xbuf, ybuf, req_len);
-            if (result != 0) return(result);
-            return(xlen-ylen);
+        if (!CORD_pos_valid(ypos)) {
+            return(1);
+        }
+        if ((avail = CORD_pos_chars_left(xpos)) <= 0
+            || (yavail = CORD_pos_chars_left(ypos)) <= 0) {
+            register char xcurrent = CORD_pos_fetch(xpos);
+            register char ycurrent = CORD_pos_fetch(ypos);
+            if (xcurrent != ycurrent) return(xcurrent - ycurrent);
+            CORD_next(xpos);
+            CORD_next(ypos);
+            count++;
         } else {
-            /* Both have length > SBUFLEN */
-            register size_t xchars;
-            register size_t ychars;
+            /* process as many characters as we can    */
             register int result;
             
-            xchars = CORD_fill_buf(x, 0, MINCMPLEN, SBUFLEN, xbuf);
-            ychars = CORD_fill_buf(y, 0, MINCMPLEN, SBUFLEN, ybuf);
-            result = strncmp(xbuf, ybuf, xchars < ychars? xchars : ychars);
+            if (avail > yavail) avail = yavail;
+            count += avail;
+            if (count > len) avail -= (count - len);
+            result = strncmp(CORD_pos_cur_char_addr(xpos),
+                            CORD_pos_cur_char_addr(ypos), avail);
             if (result != 0) return(result);
-            return(CORD_cmp_general_case(x, xlen, y, ylen));
+            CORD_pos_advance(xpos, avail);
+            CORD_pos_advance(ypos, avail);
         }
     }
+    return(0);
 }
 
 char * CORD_to_char_star(CORD x)
@@ -184,32 +201,18 @@ char * CORD_to_char_star(CORD x)
     len = CORD_len(x);
     result = (char *)GC_MALLOC_ATOMIC(len + 1);
     if (result == 0) OUT_OF_MEMORY;
-    if (CORD_fill_buf(x, 0, len, len, result) != len) abort("Goofed");
+    CORD_fill_buf(x, 0, len, result);
     result[len] = '\0';
     return(result);
 }
 
-typedef struct FetchDataRep {
-    struct FetchCacheRep * new_cache;
-    char character;
-} * fetch_data;
-
-int CORD_fetch_proc(char c, void * client_data)
-{
-    register fetch_data d = (fetch_data)client_data;
-    
-    d -> character = c;
-    return(1);
-}
-
 char CORD_fetch(CORD x, size_t i)
 {
-    struct FetchDataRep result;
+    CORD_pos xpos;
     
-    if (!CORD_iter5(x, i, CORD_fetch_proc, CORD_NO_FN, &result)) {
-       abort("bad index?");
-    }
-    return (result.character);
+    CORD_set_pos(xpos, x, i);
+    if (!CORD_pos_valid(xpos)) abort("bad index?");
+    return(CORD_pos_fetch(xpos));
 }
 
 
@@ -300,6 +303,61 @@ size_t CORD_rchr(CORD x, size_t i, int c)
     }
 }
 
+/* Find the first occurrence of s in x at position start or later.     */
+/* This uses an asymptotically poor algorithm, which should typically  */
+/* perform acceptably.  We compare the first few characters directly,  */
+/* and call CORD_ncmp whenever there is a partial match.               */
+/* This has the advantage that we allocate very little, or not at all. */
+/* It's very fast if there are few close misses.                       */
+size_t CORD_str(CORD x, size_t start, CORD s)
+{
+    CORD_pos xpos;
+    size_t xlen = CORD_len(x);
+    size_t slen;
+    register size_t start_len;
+    const char * s_start;
+    unsigned long s_buf = 0;   /* The first few characters of s        */
+    unsigned long x_buf;       /* Start of candidate substring.        */
+    unsigned long mask = 0;
+    register int i;
+    register int match_pos;
+    
+    if (s == CORD_EMPTY) return(i);
+    if (IS_STRING(s)) {
+        s_start = s;
+        slen = strlen(s);
+    } else {
+        s_start = CORD_to_char_star(CORD_substr(s, 0, sizeof(unsigned long)));
+        slen = CORD_len(s);
+    }
+    if (xlen < start || xlen - start < slen) return(CORD_NOT_FOUND);
+    start_len = slen;
+    if (start_len > sizeof(unsigned long)) start_len = sizeof(unsigned long);
+    CORD_set_pos(xpos, x, start);
+    for (i = 0; i < start_len; i++) {
+        mask <<= 8;
+        mask |= 0xff;
+        s_buf <<= 8;
+        s_buf |= s_start[i];
+        x_buf <<= 8;
+        x_buf |= CORD_pos_fetch(xpos);
+        CORD_next(xpos);
+    }
+    for (match_pos = start; match_pos < xlen - slen; match_pos++) {
+       if ((x_buf & mask) == s_buf) {
+           if (slen == start_len ||
+               CORD_ncmp(x, match_pos + start_len,
+                         s, start_len, slen - start_len) == 0) {
+               return(match_pos);
+           }
+       }
+       x_buf <<= 8;
+        x_buf |= CORD_pos_fetch(xpos);
+        CORD_next(xpos);
+    }
+    return(CORD_NOT_FOUND);
+}
+
 void CORD_ec_flush_buf(CORD_ec x)
 {
     register size_t len = x[0].ec_bufptr - x[0].ec_buf;
@@ -313,16 +371,22 @@ void CORD_ec_flush_buf(CORD_ec x)
     x[0].ec_bufptr = x[0].ec_buf;
 }
 
+void CORD_ec_append_cord(CORD_ec x, CORD s)
+{
+    CORD_ec_flush_buf(x);
+    x[0].ec_cord = CORD_cat(x[0].ec_cord, s);
+}
+
 /*ARGSUSED*/
 char CORD_nul_func(size_t i, void * client_data)
 {
-    return('\0');
+    return((char)(unsigned long)client_data);
 }
 
 
-CORD CORD_nul(size_t i)
+CORD CORD_chars(char c, size_t i)
 {
-    return(CORD_from_fn(CORD_nul_func, 0, i));
+    return(CORD_from_fn(CORD_nul_func, (void *)(unsigned long)c, i));
 }
 
 CORD CORD_from_file_eager(FILE * f)
@@ -365,7 +429,7 @@ CORD CORD_from_file_eager(FILE * f)
 
 # define LOG_CACHE_SZ 14
 # define CACHE_SZ (1 << LOG_CACHE_SZ)
-# define LOG_LINE_SZ 7
+# define LOG_LINE_SZ 9
 # define LINE_SZ (1 << LOG_LINE_SZ)
 
 typedef struct {
@@ -475,7 +539,7 @@ CORD CORD_from_file_lazy(FILE * f)
     return(CORD_from_file_lazy_inner(f, len));
 }
 
-# define LAZY_THRESHOLD (16*1024 + 1)
+# define LAZY_THRESHOLD (128*1024 + 1)
 
 CORD CORD_from_file(FILE * f)
 {
index 3f7c5ef..cc91122 100644 (file)
@@ -21,13 +21,22 @@ typedef struct CORD_pos {
     int path_len;
 #      define CORD_POS_INVALID (0x55555555)
                /* path_len == INVALID <==> position invalid */
-    struct CORD_pe path[MAX_DEPTH + 1];
-       /* path[path_len] is the leaf corresponding to cur_pos  */
-       /* path[0].pe_cord is the cord we point to.             */
     const char *cur_leaf;      /* Current leaf, if it is a string.     */
+                               /* If the current leaf is a function,   */
+                               /* then this may point to function_buf  */
+                               /* containing the next few characters.  */
+                               /* Always points to a valid string      */
+                               /* containing the current character     */
+                               /* unless cur_end is 0.                 */
     size_t cur_start;  /* Start position of cur_leaf   */
     size_t cur_end;    /* Ending position of cur_leaf  */
-                       /* 0 if leaf is not string.     */
+                       /* 0 if cur_leaf is invalid.    */
+    struct CORD_pe path[MAX_DEPTH + 1];
+       /* path[path_len] is the leaf corresponding to cur_pos  */
+       /* path[0].pe_cord is the cord we point to.             */
+#   define FUNCTION_BUF_SZ 8
+    char function_buf[FUNCTION_BUF_SZ];        /* Space for next few chars     */
+                                       /* from function node.          */
 } CORD_pos[1];
 
 /* Extract the cord from a position:   */
@@ -51,19 +60,19 @@ void CORD_next(CORD_pos p);
 /* Move the position to the preceding character.       */
 /* P must be initialized and valid.                    */
 /* Invalidates p if past beginning:                    */
-void CORD_next(CORD_pos p);
+void CORD_prev(CORD_pos p);
        
 /* Is the position valid, i.e. inside the cord?                */
 int CORD_pos_valid(CORD_pos p);
 
  
 #define CORD_pos_fetch(p)      \
-    (((p)[0].cur_start <= (p)[0].cur_pos && (p)[0].cur_pos < (p)[0].cur_end)? \
+    (((p)[0].cur_end != 0)? \
        (p)[0].cur_leaf[(p)[0].cur_pos - (p)[0].cur_start] \
        : CORD__pos_fetch(p))
 
 #define CORD_next(p)   \
-    (((p)[0].cur_pos < (p)[0].cur_end - 1)? \
+    (((p)[0].cur_pos + 1 < (p)[0].cur_end)? \
        ((p)[0].cur_pos++, 1) \
        : CORD__next(p))
 
@@ -78,4 +87,16 @@ int CORD_pos_valid(CORD_pos p);
 
 #define CORD_pos_valid(p) ((p)[0].path_len != CORD_POS_INVALID)
 
+/* Some grubby stuff for performance-critical friends: */
+#define CORD_pos_chars_left(p) ((long)((p)[0].cur_end) - (long)((p)[0].cur_pos))
+       /* Number of characters in cache.  <= 0 ==> none        */
+
+#define CORD_pos_advance(p,n) ((p)[0].cur_pos += (n) - 1, CORD_next(p))
+       /* Advance position by n characters     */
+       /* 0 < n < CORD_pos_chars_left(p)       */
+
+#define CORD_pos_cur_char_addr(p) \
+       (p)[0].cur_leaf + ((p)[0].cur_pos - (p)[0].cur_start)
+       /* address of current character in cache.       */
+
 #endif
diff --git a/cord/cord_printf.c b/cord/cord_printf.c
new file mode 100644 (file)
index 0000000..5f06220
--- /dev/null
@@ -0,0 +1,376 @@
+/* An sprintf implementation that understands cords.  This is probably */
+/* not terribly portable.  It assumes an ANSI stdarg.h.  It further    */
+/* assumes that I can make copies of va_list variables, and read       */
+/* arguments repeatedly by applyting va_arg to the copies.  This       */
+/* could be avoided at some performance cost.                          */
+/* We also assume that unsigned and signed integers of various kinds   */
+/* have the same sizes, and can be cast back and forth.                        */
+/* We assume that void * and char * have the same size.                        */
+/* All this cruft is needed because we want to rely on the underlying  */
+/* sprintf implementation whenever possible.                           */
+/* Boehm, January 21, 1994 5:10 pm PST */
+
+#include "cord.h"
+#include "ec.h"
+#include <stdio.h>
+#include <stdarg.h>
+#include <string.h>
+#include "../gc.h"
+
+#define CONV_SPEC_LEN 50       /* Maximum length of a single   */
+                               /* conversion specification.    */
+#define CONV_RESULT_LEN 50     /* Maximum length of any        */
+                               /* conversion with default      */
+                               /* width and prec.              */
+
+
+static int ec_len(CORD_ec x)
+{
+    return(CORD_len(x[0].ec_cord) + (x[0].ec_bufptr - x[0].ec_buf));
+}
+
+/* Possible nonumeric precision values.        */
+# define NONE -1
+# define VARIABLE -2
+/* Copy the conversion specification from CORD_pos into the buffer buf */
+/* Return negative on error.                                           */
+/* Source initially points one past the leading %.                     */
+/* It is left pointing at the conversion type.                         */
+/* Assign field width and precision to *width and *prec.               */
+/* If width or prec is *, VARIABLE is assigned.                                */
+/* Set *left to 1 if left adjustment flag is present.                  */
+/* Set *long_arg to 1 if long flag ('l' or 'L') is present, or to      */
+/* -1 if 'h' is present.                                               */
+static int extract_conv_spec(CORD_pos source, char *buf,
+                            int * width, int *prec, int *left, int * long_arg)
+{
+    register int result = 0;
+    register int current_number = 0;
+    register int saw_period = 0;
+    register int saw_number;
+    register int chars_so_far = 0;
+    register char current;
+    
+    *width = NONE;
+    buf[chars_so_far++] = '%';
+    while(CORD_pos_valid(source)) {
+        if (chars_so_far >= CONV_SPEC_LEN) return(-1);
+        current = CORD_pos_fetch(source);
+        buf[chars_so_far++] = current;
+        switch(current) {
+         case '*':
+           saw_number = 1;
+           current_number = VARIABLE;
+           break;
+          case '0':
+            if (!saw_number) {
+                /* Zero fill flag; ignore */
+                break;
+            } /* otherwise fall through: */
+          case '1':
+         case '2':
+         case '3':
+         case '4':
+         case '5':
+          case '6':
+         case '7':
+         case '8':
+         case '9':
+           saw_number = 1;
+           current_number *= 10;
+           current_number += current - '0';
+           break;
+         case '.':
+           saw_period = 1;
+           if(saw_number) {
+               *width = current_number;
+               saw_number = 0;
+           }
+           current_number = 0;
+           break;
+         case 'l':
+         case 'L':
+           *long_arg = 1;
+           current_number = 0;
+           break;
+         case 'h':
+           *long_arg = -1;
+           current_number = 0;
+           break;
+         case ' ':
+         case '+':
+         case '#':
+           current_number = 0;
+           break;
+         case '-':
+           *left = 1;
+           current_number = 0;
+           break;
+         case 'd':
+         case 'i':
+         case 'o':
+         case 'u':
+         case 'x':
+         case 'X':
+         case 'f':
+         case 'e':
+         case 'E':
+         case 'g':
+         case 'G':
+         case 'c':
+         case 'C':
+         case 's':
+         case 'S':
+         case 'p':
+         case 'n':
+         case 'r':
+           goto done;          
+          default:
+            return(-1);
+        }
+        CORD_next(source);
+    }
+    return(-1);
+  done:
+    if (saw_number) {
+       if (saw_period) {
+           *prec = current_number;
+       } else {
+           *prec = NONE;
+           *width = current_number;
+       }
+    } else {
+       *prec = NONE;
+    }
+    buf[chars_so_far] = '\0';
+    return(result);
+}
+
+int CORD_vsprintf(CORD * out, CORD format, va_list args)
+{
+    CORD_ec result;
+    register int count;
+    register char current;
+    CORD_pos pos;
+    char conv_spec[CONV_SPEC_LEN + 1];
+    
+    CORD_ec_init(result);
+    for (CORD_set_pos(pos, format, 0); CORD_pos_valid(pos); CORD_next(pos)) {
+               current = CORD_pos_fetch(pos);
+               if (current == '%') {
+            CORD_next(pos);
+            if (!CORD_pos_valid(pos)) return(-1);
+            current = CORD_pos_fetch(pos);
+            if (current == '%') {
+                       CORD_ec_append(result, current);
+            } else {
+               int width, prec;
+               int left_adj = 0;
+               int long_arg = 0;
+               CORD arg;
+               size_t len;
+               
+               if (extract_conv_spec(pos, conv_spec,
+                                     &width, &prec,
+                                     &left_adj, &long_arg) < 0) {
+                   return(-1);
+               }
+               current = CORD_pos_fetch(pos);
+               switch(current) {
+                   case 'n':
+                       /* Assign length to next arg */
+                       if (long_arg == 0) {
+                           int * pos_ptr;
+                           pos_ptr = va_arg(args, int *);
+                           *pos_ptr = ec_len(result);
+                       } else if (long_arg > 0) {
+                           long * pos_ptr;
+                           pos_ptr = va_arg(args, long *);
+                           *pos_ptr = ec_len(result);
+                       } else {
+                           short * pos_ptr;
+                           pos_ptr = va_arg(args, short *);
+                           *pos_ptr = ec_len(result);
+                       }
+                       goto done;
+                   case 'r':
+                       /* Append cord and any padding  */
+                       if (width == VARIABLE) width = va_arg(args, int);
+                       if (prec == VARIABLE) prec = va_arg(args, int);
+                       arg = va_arg(args, CORD);
+                       len = CORD_len(arg);
+                       if (prec != NONE && len > prec) {
+                         if (prec < 0) return(-1);
+                         arg = CORD_substr(arg, 0, prec);
+                         len = prec;
+                       }
+                       if (width != NONE && len < width) {
+                         char * blanks = GC_MALLOC_ATOMIC(width-len+1);
+
+                         memset(blanks, ' ', width-len);
+                         blanks[width-len] = '\0';
+                         if (left_adj) {
+                           arg = CORD_cat(arg, blanks);
+                         } else {
+                           arg = CORD_cat(blanks, arg);
+                         }
+                       }
+                       CORD_ec_append_cord(result, arg);
+                       goto done;
+                   case 'c':
+                       if (width == NONE && prec == NONE) {
+                           register char c = va_arg(args, char);
+
+                           CORD_ec_append(result, c);
+                           goto done;
+                       }
+                       break;
+                   case 's':
+                       if (width == NONE && prec == NONE) {
+                           char * str = va_arg(args, char *);
+                           register char c;
+
+                           while (c = *str++) {
+                               CORD_ec_append(result, c);
+                           }
+                           goto done;
+                       }
+                       break;
+                   default:
+                       break;
+               }
+               /* Use standard sprintf to perform conversion */
+               {
+                   register char * buf;
+                   int needed_sz;
+                   va_list vsprintf_args = args;
+                       /* The above does not appear to be sanctioned   */
+                       /* by the ANSI C standard.                      */
+                   int max_size = 0;
+                       
+                   if (width == VARIABLE) width = va_arg(args, int);
+                   if (prec == VARIABLE) prec = va_arg(args, int);
+                   if (width != NONE) max_size = width;
+                   if (prec != NONE && prec > max_size) max_size = prec;
+                   max_size += CONV_RESULT_LEN;
+                   if (max_size >= CORD_BUFSZ) {
+                       buf = GC_MALLOC_ATOMIC(max_size + 1);
+                   } else {
+                       if (CORD_BUFSZ - (result[0].ec_bufptr-result[0].ec_buf)
+                           < max_size) {
+                           CORD_ec_flush_buf(result);
+                       }
+                       buf = result[0].ec_bufptr;
+                   }
+                   switch(current) {
+                       case 'd':
+                       case 'i':
+                       case 'o':
+                       case 'u':
+                       case 'x':
+                       case 'X':
+                       case 'c':
+                           if (long_arg <= 0) {
+                             (void) va_arg(args, int);
+                           } else if (long_arg > 0) {
+                             (void) va_arg(args, long);
+                           }
+                           break;
+                       case 's':
+                       case 'p':
+                           (void) va_arg(args, char *);
+                           break;
+                       case 'f':
+                       case 'e':
+                       case 'E':
+                       case 'g':
+                       case 'G':
+                           (void) va_arg(args, double);
+                           break;
+                       default:
+                           return(-1);
+                   }
+                   len = (size_t)vsprintf(buf, conv_spec, vsprintf_args);
+                   if ((char *)len == buf) {
+                       /* old style vsprintf */
+                       len = strlen(buf);
+                   } else if (len < 0) {
+                       return(-1);
+                   }
+                   if (buf != result[0].ec_bufptr) {
+                       register char c;
+
+                       while (c = *buf++) {
+                           CORD_ec_append(result, c);
+                       }
+                   } else {
+                       result[0].ec_bufptr = buf + len;
+                   }
+               }
+              done:;
+            }
+        } else {
+            CORD_ec_append(result, current);
+        }
+    }
+    count = ec_len(result);
+    *out = CORD_balance(CORD_ec_to_cord(result));
+    return(count);
+}
+
+int CORD_sprintf(CORD * out, CORD format, ...)
+{
+    va_list args;
+    int result;
+    
+    va_start(args, format);
+    result = CORD_vsprintf(out, format, args);
+    va_end(args);
+    return(result);
+}
+
+int CORD_fprintf(FILE * f, CORD format, ...)
+{
+    va_list args;
+    int result;
+    CORD out;
+    
+    va_start(args, format);
+    result = CORD_vsprintf(&out, format, args);
+    va_end(args);
+    if (result > 0) CORD_put(out, f);
+    return(result);
+}
+
+int CORD_vfprintf(FILE * f, CORD format, va_list args)
+{
+    int result;
+    CORD out;
+    
+    result = CORD_vsprintf(&out, format, args);
+    if (result > 0) CORD_put(out, f);
+    return(result);
+}
+
+int CORD_printf(CORD format, ...)
+{
+    va_list args;
+    int result;
+    CORD out;
+    
+    va_start(args, format);
+    result = CORD_vsprintf(&out, format, args);
+    va_end(args);
+    if (result > 0) CORD_put(out, stdout);
+    return(result);
+}
+
+int CORD_vprintf(CORD format, va_list args)
+{
+    int result;
+    CORD out;
+    
+    result = CORD_vsprintf(&out, format, args);
+    if (result > 0) CORD_put(out, stdout);
+    return(result);
+}
index 24cf17c..035c7b9 100644 (file)
@@ -5,7 +5,7 @@
 /* that real clients shouldn't rely on.                                        */
 
 # define ABORT(string) \
-{ int x = 0; fprintf(stderr, "FAILED: %s\n", string); x = 1 / x; }
+{ int x = 0; fprintf(stderr, "FAILED: %s\n", string); x = 1 / x; abort(); }
 
 int count;
 
@@ -27,11 +27,16 @@ int test_fn(char c, void * client_data)
     }
 }
 
+char id_cord_fn(size_t i, void * client_data)
+{
+    return((char)i);
+}
 
 test_basics()
 {
     CORD x = "ab";
     register int i;
+    char c;
     CORD y;
     CORD_pos p;
     
@@ -83,6 +88,15 @@ test_basics()
     y = CORD_substr(x, 1023, 5);
     if (!IS_STRING(y)) ABORT("short cord should usually be a string");
     if (strcmp(y, "babab") != 0) ABORT("bad CORD_substr result");
+    y = CORD_from_fn(id_cord_fn, 0, 13);
+    i = 0;
+    CORD_set_pos(p, y, i);
+    while(CORD_pos_valid(p)) {
+        c = CORD_pos_fetch(p);
+               if(c != i) ABORT("Traversal of function node failed");
+       CORD_next(p); i++;
+    }
+    if (i != 13) ABORT("Bad apparent length for function node");
 }
 
 test_extras()
@@ -131,12 +145,44 @@ test_extras()
     if (strcmp(CORD_substr(w, 1000*36, 2), "ab") != 0)
        ABORT("short file substr wrong");
     if (remove("/tmp/cord_test") != 0) ABORT("remove failed");
+    if (CORD_str(x,1,"9a") != 35) ABORT("CORD_str failed 1");
+    if (CORD_str(x,0,"9abcdefghijk") != 35) ABORT("CORD_str failed 2");
+    if (CORD_str(x,0,"9abcdefghijx") != CORD_NOT_FOUND)
+       ABORT("CORD_str failed 3");
+    if (CORD_str(x,0,"9>") != CORD_NOT_FOUND) ABORT("CORD_str failed 4");
+}
+
+test_printf()
+{
+    CORD result;
+    char result2[200];
+    long l;
+    short s;
+    CORD x;
+    
+    if (CORD_sprintf(&result, "%7.2f%ln", 3.14159, &l) != 7)
+       ABORT("CORD_sprintf failed 1");
+    if (CORD_cmp(result, "   3.14") != 0)ABORT("CORD_sprintf goofed 1");
+    if (l != 7) ABORT("CORD_sprintf goofed 2");
+    if (CORD_sprintf(&result, "%-7.2s%hn%c%s", "abcd", &s, 'x', "yz") != 10)
+       ABORT("CORD_sprintf failed 2");
+    if (CORD_cmp(result, "ab     xyz") != 0)ABORT("CORD_sprintf goofed 3");
+    if (s != 7) ABORT("CORD_sprintf goofed 4");
+    x = "abcdefghij";
+    x = CORD_cat(x,x);
+    x = CORD_cat(x,x);
+    x = CORD_cat(x,x);
+    if (CORD_sprintf(&result, "->%-120.78r!\n", x) != 124)
+       ABORT("CORD_sprintf failed 3");
+    (void) sprintf(result2, "->%-120.78s!\n", CORD_to_char_star(x));
+    if (CORD_cmp(result, result2) != 0)ABORT("CORD_sprintf goofed 5");
 }
 
 main()
 {
     test_basics();
     test_extras();
-    fprintf(stderr, "SUCCEEDED\n");
+    test_printf();
+    CORD_fprintf(stderr, "SUCCEEDED\n");
     return(0);
 }
index 9922169..0c99c9f 100644 (file)
--- a/cord/de.c
+++ b/cord/de.c
  *     The redisplay algorithm doesn't let curses do the scrolling.
  *     The rule for moving the window over the file is suboptimal.
  */
+/* Boehm, January 5, 1994 2:35 pm PST */
 #include <stdio.h>
 #include <curses.h>
 #include "../gc.h"
 #include "cord.h"
 
 /* List of line number to position mappings, in descending order. */
+/* There may be holes.                                           */
 typedef struct LineMapRep {
     int line;
     size_t pos;
@@ -45,7 +47,11 @@ typedef struct HistoryRep {
 history now = 0;
 CORD current;          /* == now -> file_contents.     */
 size_t current_len;    /* Current file length.         */
-line_map current_map = 0;      /* Current line no. to pos. map */
+line_map current_map = 0;      /* Current line no. to pos. map  */
+size_t current_map_size = 0;   /* Number of current_map entries.       */
+                               /* Not always accurate, but reset       */
+                               /* by prune_map.                        */
+# define MAX_MAP_SIZE 3000
 
 /* Current display position */
 int dis_line = 0;
@@ -64,22 +70,44 @@ size_t file_pos = 0;        /* Character position corresponding to cursor.  */
 /* Invalidate line map for lines > i */
 void invalidate_map(int i)
 {
-    while(current_map -> line > i) current_map = current_map -> previous;
+    while(current_map -> line > i) {
+        current_map = current_map -> previous;
+        current_map_size--;
+    }
 }
 
+/* Reduce the number of map entries to save space for huge files. */
+/* This also affects maps in histories.                                  */
+void prune_map()
+{
+    line_map map = current_map;
+    int start_line = map -> line;
+    
+    current_map_size = 0;
+    for(; map != 0; map = map -> previous) {
+       current_map_size++;
+       if (map -> line < start_line - LINES && map -> previous != 0) {
+           map -> previous = map -> previous -> previous;
+       }
+    }
+}
 /* Add mapping entry */
 void add_map(int line, size_t pos)
 {
     line_map new_map = GC_NEW(struct LineMapRep);
     
+    if (current_map_size >= MAX_MAP_SIZE) prune_map();
     new_map -> line = line;
     new_map -> pos = pos;
     new_map -> previous = current_map;
     current_map = new_map;
+    current_map_size++;
 }
 
+
+
 /* Return position of column *c of ith line in   */
-/* current file. Adjust c to be within the line. */
+/* current file. Adjust *c to be within the line.*/
 /* A 0 pointer is taken as 0 column.            */
 /* Returns CORD_NOT_FOUND if i is too big.      */
 /* Assumes i > dis_line.                        */
@@ -90,7 +118,8 @@ size_t line_pos(int i, int *c)
     size_t next;
     line_map map = current_map;
     
-    while (map -> line > i) map = map -> previous; 
+    while (map -> line > i) map = map -> previous;
+    if (map -> line < i - 2) /* rebuild */ invalidate_map(i);
     for (j = map -> line, cur = map -> pos; j < i;) {
        cur = CORD_chr(current, cur, '\n');
         if (cur == current_len-1) return(CORD_NOT_FOUND);
@@ -218,6 +247,7 @@ void fix_cursor(void)
     if (need_redisplay != NONE) redisplay();
     move(line - dis_line, col - dis_col);
     refresh();
+    fflush(stdout);
 }
 
 /* Make sure line, col, and dis_pos are somewhere inside file. */
@@ -239,6 +269,20 @@ void fix_pos()
     }
 }
 
+/*
+ * beep() is part of some curses packages and not others.
+ * We try to match the type of the builtin one, if any.
+ */
+#ifdef __STDC__
+    int beep(void)
+#else
+    int beep()
+#endif
+{
+    putc('\007', stderr);
+    return(0);
+}
+
 # define UP '\020'     /* ^P */
 # define DOWN '\016'   /* ^N */
 # define LEFT '\002'   /* ^B */
@@ -249,6 +293,8 @@ void fix_pos()
 # define WRITE '\027'  /* ^W */
 # define QUIT '\004'   /* ^D */
 # define REPEAT '\022' /* ^R */
+# define LOCATE '\014' /* ^L */
+# define TOP '\024'    /* ^T */
 
 main(argc, argv)
 int argc;
@@ -260,6 +306,8 @@ char ** argv;
 #   define NO_PREFIX -1
 #   define BARE_PREFIX -2
     int repeat_count = NO_PREFIX;
+    int locate_mode = 0;       /* Currently between 2 ^Ls      */
+    CORD locate_string = CORD_EMPTY;
     int i, file_len;
     int need_fix_pos; 
 
@@ -278,7 +326,6 @@ char ** argv;
     add_hist(initial);
     now -> map = current_map;
     now -> previous = now;  /* Can't back up further: beginning of the world */
-    GC_enable_incremental();
     setvbuf(stdout, GC_MALLOC_ATOMIC(8192), _IOFBF, 8192);
     initscr();
     noecho(); nonl(); cbreak();
@@ -287,6 +334,35 @@ char ** argv;
     
     while ((c = getchar()) != QUIT) {
       if ( c == '\r') c = '\n';
+      if (locate_mode) {
+          size_t new_pos;
+          
+          if (c == LOCATE) {
+              locate_mode = 0;
+              locate_string = CORD_EMPTY;
+              continue;
+          }
+          locate_string = CORD_cat_char(locate_string,c);
+          new_pos = CORD_str(current, file_pos - CORD_len(locate_string) + 1,
+                            locate_string);
+          if (new_pos != CORD_NOT_FOUND) {
+              need_redisplay = ALL;
+              new_pos += CORD_len(locate_string);
+              for (;;) {
+                 file_pos = line_pos(line + 1, 0);
+                 if (file_pos > new_pos) break;
+                 line++;
+              }
+              col = new_pos - line_pos(line, 0);
+              file_pos = new_pos;
+              fix_cursor();
+          } else {
+              locate_string = CORD_substr(locate_string, 0,
+                                         CORD_len(locate_string) - 1);
+              beep();
+          }
+          continue;
+      }
       if ( c == REPEAT ) {
        repeat_count = BARE_PREFIX; continue;
       } else if (isdigit(c)){
@@ -304,6 +380,12 @@ char ** argv;
       need_fix_pos = 0;
       for (i = 0; i < repeat_count; i++) {
         switch(c) {
+          case LOCATE:
+            locate_mode = 1;
+            break;
+          case TOP:
+            line = col = file_pos = 0;
+            break;
          case UP:
            if (line != 0) {
                line--;
@@ -328,7 +410,10 @@ char ** argv;
            need_redisplay = ALL; need_fix_pos = 1;
            break;
          case BS:
-           if (col == 0) break;
+           if (col == 0) {
+               beep();
+               break;
+           }
            col--; file_pos--;
            /* fall through: */
          case DEL:
@@ -355,12 +440,10 @@ char ** argv;
             break;
          default:
            {
-               char * new_char = GC_MALLOC_ATOMIC(2);
                CORD left_part = CORD_substr(current, 0, file_pos);
                CORD right_part = CORD_substr(current, file_pos, current_len);
                
-               new_char[0] = c; new_char[1] = '\0';
-               add_hist(CORD_cat(CORD_cat(left_part, new_char), right_part));
+               add_hist(CORD_cat(CORD_cat_char(left_part, c), right_part));
                invalidate_map(line);
                if (c == '\n') {
                    col = 0; line++; file_pos++;
@@ -384,5 +467,6 @@ usage:
     fprintf(stderr, "Usage: %s file\n", argv[0]);
     fprintf(stderr, "Cursor keys: ^B(left) ^F(right) ^P(up) ^N(down)\n");
     fprintf(stderr, "Undo: ^U    Write: ^W   Quit:^D  Repeat count: ^R[n]\n");
+    fprintf(stderr, "Top: ^T   Locate (search, find): ^L text ^L\n");
     exit(1);
 }
index 9d02f77..da2f58b 100644 (file)
--- a/cord/ec.h
+++ b/cord/ec.h
@@ -44,7 +44,7 @@ typedef struct CORD_ec_struct {
 /* ec_buf[0 ... (ec_bufptr-ec_buf-1)]                                  */
 
 /* Flush the buffer part of the extended chord into ec_cord.   */
-/* Note that this is the only real function, and it is         */
+/* Note that this is almost the only real function, and it is  */
 /* implemented in 6 lines in cord_extras.c                     */
 void CORD_ec_flush_buf(CORD_ec x);
       
@@ -63,4 +63,8 @@ void CORD_ec_flush_buf(CORD_ec x);
        *((x)[0].ec_bufptr)++ = (c); \
     }
 
+/* Append a cord to an extensible cord.  Structure remains shared with         */
+/* original.                                                           */
+void CORD_ec_append_cord(CORD_ec x, CORD s);
+
 # endif /* EC_H */
similarity index 77%
rename from debug_malloc.c
rename to dbg_mlc.c
index 4b7b224..79a301e 100644 (file)
+++ b/dbg_mlc.c
@@ -1,14 +1,49 @@
-# include "gc_private.h"
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 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.
+ */
+/* Boehm, April 5, 1994 1:52 pm PDT */
+# include "gc_priv.h"
+
+/* Do we want to and know how to save the call stack at the time of    */
+/* an allocation?  How much space do we want to use in each object?    */
+
+# if defined(SPARC) && defined(SUNOS4)
+#   include <machine/frame.h>
+#   define SAVE_CALL_CHAIN
+#   define NFRAMES 5   /* Number of frames to save. */
+#   define NARGS 2     /* Mumber of arguments to save for each call. */
+#   if NARGS > 6
+       --> We only know how to to get the first 6 arguments
+#   endif
+# endif
+
 # define START_FLAG ((word)0xfedcedcb)
 # define END_FLAG ((word)0xbcdecdef)
        /* Stored both one past the end of user object, and one before  */
        /* the end of the object as seen by the allocator.              */
 
+#ifdef SAVE_CALL_CHAIN
+    struct callinfo {
+       word ci_pc;
+       word ci_arg[NARGS];
+    };
+#endif
+
 /* Object header */
 typedef struct {
-    char * oh_string;  /* object descriptor string     */
+    char * oh_string;          /* object descriptor string     */
     word oh_int;               /* object descriptor integers   */
-    word oh_sz;                /* Original malloc arg.         */
+#   ifdef SAVE_CALL_CHAIN
+      struct callinfo oh_ci[NFRAMES];
+#   endif
+    word oh_sz;                        /* Original malloc arg.         */
     word oh_sf;                        /* start flag */
 } oh;
 /* The size of the above structure is assumed not to dealign things,   */
@@ -18,6 +53,58 @@ typedef struct {
 #undef ROUNDED_UP_WORDS
 #define ROUNDED_UP_WORDS(n) BYTES_TO_WORDS((n) + WORDS_TO_BYTES(1) - 1)
 
+#if defined(SPARC) && defined(SUNOS4)
+/* Fill in the pc and argument information for up to NFRAMES of my     */
+/* callers.  Ignore my frame and my callers frame.                     */
+void GC_save_callers (info) 
+struct callinfo info[NFRAMES];
+{
+  struct frame *frame;
+  struct frame *fp;
+  int nframes = 0;
+  word GC_save_regs_in_stack();
+
+  frame = (struct frame *) GC_save_regs_in_stack ();
+  
+  for (fp = frame -> fr_savfp; fp != 0 && nframes < NFRAMES;
+       fp = fp -> fr_savfp, nframes++) {
+      register int i;
+      
+      info[nframes].ci_pc = fp->fr_savpc;
+      for (i = 0; i < NARGS; i++) {
+       info[nframes].ci_arg[i] = fp->fr_arg[i];
+      }
+  }
+  if (nframes < NFRAMES) info[nframes].ci_pc = 0;
+}
+
+void GC_print_callers (info)
+struct callinfo info[NFRAMES];
+{
+    register int i,j;
+    
+    GC_err_printf0("\tCall chain at allocation:\n");
+    for (i = 0; i < NFRAMES; i++) {
+       if (info[i].ci_pc == 0) break;
+       GC_err_printf1("\t##PC##= 0x%X\n\t\targs: ", info[i].ci_pc);
+       for (j = 0; j < NARGS; j++) {
+           if (j != 0) GC_err_printf0(", ");
+           GC_err_printf2("%d (0x%X)", info[i].ci_arg[j],info[i].ci_arg[j]);
+       }
+       GC_err_printf0("\n");
+    }
+}
+
+#endif /* SPARC & SUNOS4 */
+
+#ifdef SAVE_CALL_CHAIN
+#   define ADD_CALL_CHAIN(base) GC_save_callers(((oh *)(base)) -> oh_ci)
+#   define PRINT_CALL_CHAIN(base) GC_print_callers(((oh *)(base)) -> oh_ci)
+#else
+#   define ADD_CALL_CHAIN(base)
+#   define PRINT_CALL_CHAIN(base)
+#endif
+
 /* Check whether object with base pointer p has debugging info */ 
 /* p is assumed to point to a legitimate object in our part    */
 /* of the heap.                                                        */
@@ -97,6 +184,7 @@ ptr_t p;
     GC_err_puts(ohdr -> oh_string);
     GC_err_printf2(":%ld, sz=%ld)\n", (unsigned long)(ohdr -> oh_int),
                                      (unsigned long)(ohdr -> oh_sz));
+    PRINT_CALL_CHAIN(ohdr);
 }
 void GC_print_smashed_obj(p, clobbered_addr)
 ptr_t p, clobbered_addr;
@@ -105,11 +193,16 @@ ptr_t p, clobbered_addr;
     
     GC_err_printf2("0x%lx in object at 0x%lx(", (unsigned long)clobbered_addr,
                                                (unsigned long)p);
-    if (clobbered_addr <= (ptr_t)(&(ohdr -> oh_sz))) {
+    if (clobbered_addr <= (ptr_t)(&(ohdr -> oh_sz))
+        || ohdr -> oh_string == 0) {
         GC_err_printf1("<smashed>, appr. sz = %ld)\n",
                       BYTES_TO_WORDS(GC_size((ptr_t)ohdr)));
     } else {
-        GC_err_puts(ohdr -> oh_string);
+        if (ohdr -> oh_string[0] == '\0') {
+            GC_err_puts("EMPTY(smashed?)");
+        } else {
+            GC_err_puts(ohdr -> oh_string);
+        }
         GC_err_printf2(":%ld, sz=%ld)\n", (unsigned long)(ohdr -> oh_int),
                                          (unsigned long)(ohdr -> oh_sz));
     }
@@ -145,6 +238,7 @@ void GC_start_debugging()
     if (!GC_debugging_started) {
        GC_start_debugging();
     }
+    ADD_CALL_CHAIN(result);
     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 }
 
@@ -170,6 +264,7 @@ void GC_start_debugging()
     if (!GC_debugging_started) {
        GC_start_debugging();
     }
+    ADD_CALL_CHAIN(result);
     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 }
 
@@ -236,6 +331,7 @@ extern_ptr_t p;
     if (!GC_debugging_started) {
         GC_start_debugging();
     }
+    ADD_CALL_CHAIN(result);
     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 }
 
@@ -260,6 +356,7 @@ extern_ptr_t p;
     if (!GC_debugging_started) {
         GC_start_debugging();
     }
+    ADD_CALL_CHAIN(result);
     return (GC_store_debug_info(result, (word)lb, s, (word)i));
 }
 
@@ -277,7 +374,7 @@ extern_ptr_t p;
     if (base == 0) {
         GC_err_printf1("Attempt to free invalid pointer %lx\n",
                       (unsigned long)p);
-        ABORT("free(invalid pointer)");
+        if (p != 0) ABORT("free(invalid pointer)");
     }
     if ((ptr_t)p - (ptr_t)base != sizeof(oh)) {
         GC_err_printf1(
@@ -286,11 +383,20 @@ extern_ptr_t p;
     } else {
       clobbered = GC_check_annotated_obj((oh *)base);
       if (clobbered != 0) {
-        GC_err_printf0("GC_debug_free: found smashed object at ");
+        if (((oh *)base) -> oh_sz == GC_size(base)) {
+            GC_err_printf0(
+                  "GC_debug_free: found previously deallocated (?) object at ");
+        } else {
+            GC_err_printf0("GC_debug_free: found smashed object at ");
+        }
         GC_print_smashed_obj(p, clobbered);
       }
+      /* Invalidate size */
+      ((oh *)base) -> oh_sz = GC_size(base);
     }
-    GC_free(GC_base(p));
+#   ifdef FIND_LEAK
+        GC_free(base);
+#   endif
 }
 
 # ifdef __STDC__
@@ -347,7 +453,7 @@ extern_ptr_t p;
     old_sz = ((oh *)base) -> oh_sz;
     if (old_sz < copy_sz) copy_sz = old_sz;
     if (result == 0) return(0);
-    bcopy((char *)p, (char *)result, (int) copy_sz);
+    BCOPY(p, result,  copy_sz);
     return(result);
 }
 
similarity index 50%
rename from dynamic_load.c
rename to dyn_load.c
index 0378eb9..a780645 100644 (file)
@@ -1,5 +1,5 @@
 /*
- * Copyright (c) 1991-1993 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1991-1994 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.
@@ -9,7 +9,7 @@
  * Author: Bill Janssen
  * Modified by: Hans Boehm
  */
-/* Boehm, December 17, 1993 4:46 pm PST */
+/* Boehm, March 31, 1994 12:43 pm PST */
 
 /*
  * This is incredibly OS specific code for tracking down data sections in
  * But then not much of anything is safe in the presence of dlclose.
  */
 #include <sys/types.h>
-#include "gc_private.h"
+#include "gc_priv.h"
 
-#ifdef DYNAMIC_LOADING
-#if !defined(SUNOS4) && !defined(SUNOS5) && !defined(IRIX5)
- --> We only know how to find data segments of dynamic libraries under SunOS
- --> and under IRIX5.  Other SVR4 variants might not be too hard to add.
+#if (defined(DYNAMIC_LOADING) || defined(MSWIN32)) && !defined(PCR)
+#if !defined(SUNOS4) && !defined(SUNOS5) && !defined(IRIX5) && !defined(MSWIN32)
+ --> We only know how to find data segments of dynamic libraries under SunOS,
+ --> IRIX5 and Win32.  Additional SVR4 variants might not be too hard to add.
 #endif
 
 #include <stdio.h>
@@ -123,11 +123,31 @@ static ptr_t GC_first_common()
 
 # if defined(SUNOS4) || defined(SUNOS5)
 /* Add dynamic library data sections to the root set.          */
-# if !defined(PCR) && defined(THREADS)
+# if !defined(PCR) && !defined(SOLARIS_THREADS) && defined(THREADS)
 #   ifndef SRC_M3
        --> fix mutual exclusion with dlopen
 #   endif  /* We assume M3 programs don't call dlopen for now */
 # endif
+
+# ifdef SOLARIS_THREADS
+  /* Redefine dlopen to guarantee mutual exclusion with        */
+  /* GC_register_dynamic_libraries.                    */
+  /* assumes that dlopen doesn't need to call GC_malloc        */
+  /* and friends.                                      */
+# include <thread.h>
+# include <synch.h>
+  
+void * GC_dlopen(const char *path, int mode)
+{
+    void * result;
+    
+    mutex_lock(&GC_allocate_ml);
+    result = dlopen(path, mode);
+    mutex_unlock(&GC_allocate_ml);
+    return(result);
+}
+# endif
+
 void GC_register_dynamic_libraries()
 {
   struct link_map *lm = GC_FirstDLOpenedLinkMap();
@@ -279,10 +299,219 @@ void GC_register_dynamic_libraries()
 
 #endif  /* IRIX5 */
 
+# ifdef MSWIN32
+
+# define WIN32_LEAN_AND_MEAN
+# define NOSERVICE
+# include <windows.h>
+# include <stdlib.h>
+
+  /* We traverse the entire address space and register all segments    */
+  /* that could possibly have been written to.                         */
+  DWORD GC_allocation_granularity;
+  
+  extern bool GC_is_heap_base (ptr_t p);
+  
+  void GC_cond_add_roots(char *base, char * limit)
+  {
+    char dummy;
+    char * stack_top
+           = (char *) ((word)(&dummy) & ~(GC_allocation_granularity-1));
+    if (base == limit) return;
+    if (limit > stack_top && base < GC_stackbottom) {
+       /* Part of the stack; ignore it. */
+       return;
+    }
+    GC_add_roots_inner(base, limit);
+  }
+  
+  extern bool GC_win32s;
+  
+  void GC_register_dynamic_libraries()
+  {
+    MEMORY_BASIC_INFORMATION buf;
+    SYSTEM_INFO sysinfo;
+    DWORD result;
+    DWORD protect;
+    LPVOID p;
+    char * base;
+    char * limit, * new_limit;
+    
+    if (GC_win32s) return;
+    GetSystemInfo(&sysinfo);
+    base = limit = p = sysinfo.lpMinimumApplicationAddress;
+    GC_allocation_granularity = sysinfo.dwAllocationGranularity;
+    while (p < sysinfo.lpMaximumApplicationAddress) {
+        result = VirtualQuery(p, &buf, sizeof(buf));
+        if (result != sizeof(buf)) {
+            ABORT("Weird VirtualQuery result");
+        }
+        new_limit = (char *)p + buf.RegionSize;
+        protect = buf.Protect;
+        if (buf.State == MEM_COMMIT
+            && (protect == PAGE_EXECUTE_READWRITE
+                || protect == PAGE_READWRITE)
+            && !GC_is_heap_base(buf.AllocationBase)) {
+            if ((char *)p == limit) {
+                limit = new_limit;
+            } else {
+                GC_cond_add_roots(base, limit);
+                base = p;
+                limit = new_limit;
+            }
+        }
+        if (p > (LPVOID)new_limit /* overflow */) break;
+        p = (LPVOID)new_limit;
+    }
+    GC_cond_add_roots(base, limit);
+  }
+
+#endif /* MSWIN32 */
+
+#if defined(ALPHA)
+void GC_register_dynamic_libraries()
+{
+  int status;
+  ldr_process_t mypid;
+
+  /* module */
+    ldr_module_t moduleid = LDR_NULL_MODULE;
+    ldr_module_info_t moduleinfo;
+    size_t moduleinfosize = sizeof(moduleinfo);
+    size_t modulereturnsize;    
+
+  /* region */
+    ldr_region_t region; 
+    ldr_region_info_t regioninfo;
+    size_t regioninfosize = sizeof(regioninfo);
+    size_t regionreturnsize;
+
+  /* Obtain id of this process */
+    mypid = ldr_my_process();
+  
+  /* For each module */
+    while (TRUE) {
+
+      /* Get the next (first) module */
+        status = ldr_next_module(mypid, &moduleid);
+
+      /* Any more modules? */
+        if (moduleid == LDR_NULL_MODULE)
+            break;    /* No more modules */
+
+      /* Check status AFTER checking moduleid because */
+      /* of a bug in the non-shared ldr_next_module stub */
+        if (status != 0 ) {
+            GC_printf("dynamic_load: status = %ld\n", (long)status);
+            {
+                extern char *sys_errlist[];
+                extern int sys_nerr;
+                extern int errno;
+                if (errno <= sys_nerr) {
+                    GC_printf("dynamic_load: %s\n", sys_errlist[errno]);
+               } else {
+                    GC_printf("dynamic_load: %d\n", errno);
+                }
+        }
+            ABORT("ldr_next_module failed");
+         }
+
+      /* Get the module information */
+        status = ldr_inq_module(mypid, moduleid, &moduleinfo,
+                                moduleinfosize, &modulereturnsize); 
+        if (status != 0 )
+            ABORT("ldr_inq_module failed");
+
+      /* is module for the main program (i.e. nonshared portion)? */
+          if (moduleinfo.lmi_flags & LDR_MAIN)
+              continue;    /* skip the main module */
+
+#     ifdef VERBOSE
+          GC_printf("---Module---\n");
+          GC_printf("Module ID            = %16ld\n", moduleinfo.lmi_modid);
+          GC_printf("Count of regions     = %16d\n", moduleinfo.lmi_nregion);
+          GC_printf("flags for module     = %16lx\n", moduleinfo.lmi_flags); 
+          GC_printf("pathname of module   = \"%s\"\n", moduleinfo.lmi_name);
+#     endif
+
+      /* For each region in this module */
+        for (region = 0; region < moduleinfo.lmi_nregion; region++) {
+
+          /* Get the region information */
+            status = ldr_inq_region(mypid, moduleid, region, &regioninfo,
+                                    regioninfosize, &regionreturnsize);
+            if (status != 0 )
+                ABORT("ldr_inq_region failed");
+
+          /* only process writable (data) regions */
+            if (! (regioninfo.lri_prot & LDR_W))
+                continue;
+
+#         ifdef VERBOSE
+              GC_printf("--- Region ---\n");
+              GC_printf("Region number    = %16ld\n",
+                       regioninfo.lri_region_no);
+              GC_printf("Protection flags = %016x\n",  regioninfo.lri_prot);
+              GC_printf("Virtual address  = %16p\n",   regioninfo.lri_vaddr);
+              GC_printf("Mapped address   = %16p\n",   regioninfo.lri_mapaddr);
+              GC_printf("Region size      = %16ld\n",  regioninfo.lri_size);
+              GC_printf("Region name      = \"%s\"\n", regioninfo.lri_name);
+#         endif
+
+          /* register region as a garbage collection root */
+            GC_add_roots_inner (
+                (char *)regioninfo.lri_mapaddr,
+                (char *)regioninfo.lri_mapaddr + regioninfo.lri_size);
+
+        }
+    }
+}
+#endif
+
+
 #else /* !DYNAMIC_LOADING */
 
+#ifdef PCR
+
+#   include "il/PCR_IL.h"
+#   include "th/PCR_ThCtl.h"
+#   include "mm/PCR_MM.h"
+
+void GC_register_dynamic_libraries()
+{
+    /* Add new static data areas of dynamically loaded modules.        */
+        {
+          PCR_IL_LoadedFile * p = PCR_IL_GetLastLoadedFile();
+          PCR_IL_LoadedSegment * q;
+          
+          /* Skip uncommited files */
+          while (p != NIL && !(p -> lf_commitPoint)) {
+              /* The loading of this file has not yet been committed   */
+              /* Hence its description could be inconsistent.                  */
+              /* Furthermore, it hasn't yet been run.  Hence its data  */
+              /* segments can't possibly reference heap allocated      */
+              /* objects.                                              */
+              p = p -> lf_prev;
+          }
+          for (; p != NIL; p = p -> lf_prev) {
+            for (q = p -> lf_ls; q != NIL; q = q -> ls_next) {
+              if ((q -> ls_flags & PCR_IL_SegFlags_Traced_MASK)
+                  == PCR_IL_SegFlags_Traced_on) {
+                GC_add_roots_inner
+                       ((char *)(q -> ls_addr), 
+                        (char *)(q -> ls_addr) + q -> ls_bytes);
+              }
+            }
+          }
+        }
+}
+
+
+#else /* !PCR */
+
 void GC_register_dynamic_libraries(){}
 
 int GC_no_dynamic_loading;
 
+#endif /* !PCR */
 #endif /* !DYNAMIC_LOADING */
index 661cc06..8199fa1 100644 (file)
@@ -1,6 +1,6 @@
 /*
  * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
- * Copyright (c) 1991, 1992 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1991-1994 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.
  */
+/* Boehm, April 5, 1994 1:42 pm PDT */
 # define I_HIDE_POINTERS
 # include "gc.h"
-# include "gc_private.h"
-# ifdef __STDC__
-    typedef void * void_star;
-# else
-    typedef char * void_star;
-# endif
+# include "gc_priv.h"
+# include "gc_mark.h"
+
+# define HASH3(addr,size,log_size) \
+    ((((word)(addr) >> 3) ^ ((word)(addr) >> (3+(log_size)))) \
+    & ((size) - 1))
+#define HASH2(addr,log_size) HASH3(addr, 1 << log_size, log_size)
+
+struct hash_chain_entry {
+    word hidden_key;
+    struct hash_chain_entry * next;
+};
 
-# define LOG_TSIZE 7
-# define TSIZE (1 << LOG_TSIZE)
-# define HASH(addr) \
-    ((((word)(addr) >> 3) ^ ((word)(addr) >> (3+LOG_TSIZE))) \
-    & (TSIZE - 1))
-    
 static struct disappearing_link {
+    struct hash_chain_entry prolog;
+#   define dl_hidden_link prolog.hidden_key
+                               /* Field to be cleared.         */
+#   define dl_next(x) (struct disappearing_link *)((x) -> prolog.next)
+#   define dl_set_next(x,y) (x) -> prolog.next = (struct hash_chain_entry *)(y)
+
     word dl_hidden_obj;                /* Pointer to object base       */
-    word dl_hidden_link;       /* Field to be cleared.         */
-    struct disappearing_link * dl_next;
-} * dl_head[TSIZE] = {0};
+} **dl_head = 0;
+
+static signed_word log_dl_table_size = -1;
+                       /* Binary log of                                */
+                       /* current size of array pointed to by dl_head. */
+                       /* -1 ==> size is 0.                            */
+
+word GC_dl_entries = 0;        /* Number of entries currently in disappearing  */
+                       /* link table.                                  */
 
 static struct finalizable_object {
-    word fo_hidden_base;       /* Pointer to object base       */
+    struct hash_chain_entry prolog;
+#   define fo_hidden_base prolog.hidden_key
+                               /* Pointer to object base.      */
+#   define fo_next(x) (struct finalizable_object *)((x) -> prolog.next)
+#   define fo_set_next(x,y) (x) -> prolog.next = (struct hash_chain_entry *)(y)
     GC_finalization_proc fo_fn;        /* Finalizer.                   */
     ptr_t fo_client_data;
     word fo_object_size;       /* In bytes.                    */
-    struct finalizable_object * fo_next;
-} * fo_head[TSIZE] = {0};
+} **fo_head = 0;
+
+static signed_word log_fo_table_size = -1;
+
+word GC_fo_entries = 0;
 
 # ifdef SRC_M3
 void GC_push_finalizer_structures()
 {
-    GC_push_all((ptr_t)dl_head, (ptr_t)(dl_head + TSIZE));
-    GC_push_all((ptr_t)fo_head, (ptr_t)(fo_head + TSIZE));
+    GC_push_all((ptr_t)(&dl_head), (ptr_t)(&dl_head) + sizeof(word));
+    GC_push_all((ptr_t)(&fo_head), (ptr_t)(&fo_head) + sizeof(word));
 }
 # endif
 
-# define ALLOC(x, t) t *x = (t *)GC_malloc(sizeof (t))
+# define ALLOC(x, t) t *x = GC_NEW(t)
+
+/* Double the size of a hash table. *size_ptr is the log of its current        */
+/* size.  May be a noop.                                               */
+/* *table is a pointer to an array of hash headers.  If we succeed, we */
+/* update both *table and *log_size_ptr.                               */
+/* Lock is held.  Signals are disabled.                                        */
+void GC_grow_table(table, log_size_ptr)
+struct hash_chain_entry ***table;
+signed_word * log_size_ptr;
+{
+    register int i;
+    register struct hash_chain_entry *p;
+    int log_old_size = *log_size_ptr;
+    register int log_new_size = log_old_size + 1;
+    word old_size = ((log_old_size == -1)? 0: (1 << log_old_size));
+    register word new_size = 1 << log_new_size;
+    struct hash_chain_entry **new_table = (struct hash_chain_entry **)
+       GC_generic_malloc_inner(
+               new_size * (word)(sizeof(struct hash_chain_entry *)),
+               NORMAL);
+    
+    if (new_table == 0) return;
+    for (i = 0; i < old_size; i++) {
+      p = (*table)[i];
+      while (p != 0) {
+        register ptr_t real_key = (ptr_t)REVEAL_POINTER(p -> hidden_key);
+        register struct hash_chain_entry *next = p -> next;
+        register int new_hash = HASH3(real_key, new_size, log_new_size);
+        
+        p -> next = new_table[new_hash];
+        new_table[new_hash] = p;
+        p = next;
+      }
+    }
+    *log_size_ptr = log_new_size;
+    *table = new_table;
+}
+
 
 int GC_register_disappearing_link(link)
-void_star * link;
+extern_ptr_t * link;
 {
     ptr_t base;
     
-    base = (ptr_t)GC_base((void_star)link);
+    base = (ptr_t)GC_base((extern_ptr_t)link);
     if (base == 0)
        ABORT("Bad arg to GC_register_disappearing_link");
     return(GC_general_register_disappearing_link(link, base));
 }
 
 int GC_general_register_disappearing_link(link, obj)
-void_star * link;
-void_star obj;
+extern_ptr_t * link;
+extern_ptr_t obj;
 {
     struct disappearing_link *curr_dl;
     int index;
@@ -68,17 +126,35 @@ void_star obj;
       ALLOC(new_dl, struct disappearing_link);
     DCL_LOCK_STATE;
     
-    index = HASH(link);
     if ((word)link & (ALIGNMENT-1))
        ABORT("Bad arg to GC_general_register_disappearing_link");
-    DISABLE_SIGNALS();
-    LOCK();
+#   ifdef THREADS
+       DISABLE_SIGNALS();
+       LOCK();
+#   endif
+    if (log_dl_table_size == -1 || GC_dl_entries > (1 << log_dl_table_size)) {
+#      ifndef THREADS
+           DISABLE_SIGNALS();
+#      endif
+       GC_grow_table((struct hash_chain_entry ***)(&dl_head),
+                     &log_dl_table_size);
+#      ifdef PRINTSTATS
+           GC_printf1("Grew dl table to %lu entries\n",
+                       (unsigned long)(1 << log_dl_table_size));
+#      endif
+#      ifndef THREADS
+           ENABLE_SIGNALS();
+#      endif
+    }
+    index = HASH2(link, log_dl_table_size);
     curr_dl = dl_head[index];
-    for (curr_dl = dl_head[index]; curr_dl != 0; curr_dl = curr_dl -> dl_next) {
+    for (curr_dl = dl_head[index]; curr_dl != 0; curr_dl = dl_next(curr_dl)) {
         if (curr_dl -> dl_hidden_link == HIDE_POINTER(link)) {
             curr_dl -> dl_hidden_obj = HIDE_POINTER(obj);
-            UNLOCK();
-           ENABLE_SIGNALS();
+#          ifdef THREADS
+                UNLOCK();
+               ENABLE_SIGNALS();
+#          endif
            GC_free((extern_ptr_t)new_dl);
             return(1);
         }
@@ -86,22 +162,25 @@ void_star obj;
     {
         new_dl -> dl_hidden_obj = HIDE_POINTER(obj);
         new_dl -> dl_hidden_link = HIDE_POINTER(link);
-        new_dl -> dl_next = dl_head[index];
+        dl_set_next(new_dl, dl_head[index]);
         dl_head[index] = new_dl;
-        UNLOCK();
-        ENABLE_SIGNALS();
+        GC_dl_entries++;
+#      ifdef THREADS
+            UNLOCK();
+            ENABLE_SIGNALS();
+#      endif
         return(0);
     }
 }
 
 int GC_unregister_disappearing_link(link)
-void_star * link;
+extern_ptr_t * link;
 {
     struct disappearing_link *curr_dl, *prev_dl;
     int index;
     DCL_LOCK_STATE;
     
-    index = HASH(link);
+    index = HASH2(link, log_dl_table_size);
     if (((unsigned long)link & (ALIGNMENT-1)))
        return(0);
     DISABLE_SIGNALS();
@@ -110,88 +189,128 @@ void_star * link;
     while (curr_dl != 0) {
         if (curr_dl -> dl_hidden_link == HIDE_POINTER(link)) {
             if (prev_dl == 0) {
-                dl_head[index] = curr_dl -> dl_next;
+                dl_head[index] = dl_next(curr_dl);
             } else {
-               prev_dl -> dl_next = curr_dl -> dl_next;
+                dl_set_next(prev_dl, dl_next(curr_dl));
             }
+            GC_dl_entries--;
             UNLOCK();
            ENABLE_SIGNALS();
             GC_free((extern_ptr_t)curr_dl);
             return(1);
         }
         prev_dl = curr_dl;
-        curr_dl = curr_dl -> dl_next;
+        curr_dl = dl_next(curr_dl);
     }
     UNLOCK();
     ENABLE_SIGNALS();
     return(0);
 }
 
+/* Register a finalization function.  See gc.h for details.    */
+/* in the nonthreads case, we try to avoid disabling signals,  */
+/* since it can be expensive.  Threads packages typically      */
+/* make it cheaper.                                            */
 void GC_register_finalizer(obj, fn, cd, ofn, ocd)
-void_star obj;
+extern_ptr_t obj;
 GC_finalization_proc fn;
-void_star cd;
+extern_ptr_t cd;
 GC_finalization_proc * ofn;
-void_star * ocd;
+extern_ptr_t * ocd;
 {
     ptr_t base;
     struct finalizable_object * curr_fo, * prev_fo;
     int index;
-    /* Allocate before acquiring lock */
-      ALLOC(new_fo, struct finalizable_object);
+    struct finalizable_object *new_fo;
     DCL_LOCK_STATE;
-    
-    DISABLE_SIGNALS();
-    LOCK();
-    base = (ptr_t)GC_base((void_star)obj);
-    index = HASH(base);
-    if (base != obj)
-               ABORT("Bad arg to GC_register_finalizer");
+
+    if (log_fo_table_size == -1 || GC_fo_entries > (1 << log_fo_table_size)) {
+       DISABLE_SIGNALS();
+        LOCK();
+       GC_grow_table((struct hash_chain_entry ***)(&fo_head),
+                     &log_fo_table_size);
+#      ifdef PRINTSTATS
+           GC_printf1("Grew fo table to %lu entries\n",
+                       (unsigned long)(1 << log_fo_table_size));
+#      endif
+#      ifndef THREADS
+         UNLOCK();     /* Presumably noop */
+         ENABLE_SIGNALS();
+#      endif
+    } else {
+#     ifdef THREADS
+       DISABLE_SIGNALS();
+       LOCK();
+#     endif
+    }
+    /* in the THREADS case signals are disabled and we hold allocation */
+    /* lock; otherwise neither is true.  Proceed carefully.            */
+    base = (ptr_t)obj;
+    index = HASH2(base, log_fo_table_size);
     prev_fo = 0; curr_fo = fo_head[index];
     while (curr_fo != 0) {
         if (curr_fo -> fo_hidden_base == HIDE_POINTER(base)) {
+            /* Interruption by a signal in the middle of this  */
+            /* should be safe.  The client may see only *ocd   */
+            /* updated, but we'll declare that to be his       */
+            /* problem.                                                */
+            if (ocd) *ocd = (extern_ptr_t) curr_fo -> fo_client_data;
             if (ofn) *ofn = curr_fo -> fo_fn;
-            if (ocd) *ocd = (void_star) curr_fo -> fo_client_data;
+            /* Delete the structure for base. */
+                if (prev_fo == 0) {
+                  fo_head[index] = fo_next(curr_fo);
+                } else {
+                  fo_set_next(prev_fo, fo_next(curr_fo));
+                }
             if (fn == 0) {
-                /* Delete the structure for base. */
-                  if (prev_fo == 0) {
-                    fo_head[index] = curr_fo -> fo_next;
-                  } else {
-                    prev_fo -> fo_next = curr_fo -> fo_next;
-                  }
-                  UNLOCK();
-                 ENABLE_SIGNALS();
-                  GC_free((extern_ptr_t)curr_fo);
+                GC_fo_entries--;
+                  /* May not happen if we get a signal.  But a high    */
+                  /* estimate will only make the table larger than     */
+                  /* necessary.                                                */
+                GC_free((extern_ptr_t)curr_fo);
             } else {
                 curr_fo -> fo_fn = fn;
                 curr_fo -> fo_client_data = (ptr_t)cd;
+               /* Reinsert it.  We deleted it first to maintain        */
+               /* consistency in the event of a signal.                */
+               if (prev_fo == 0) {
+                  fo_head[index] = curr_fo;
+                } else {
+                  fo_set_next(prev_fo, curr_fo);
+                }
+            }
+#          ifdef THREADS
                 UNLOCK();
                ENABLE_SIGNALS();
-            }
-            GC_free((extern_ptr_t)new_fo);
+#          endif
             return;
         }
         prev_fo = curr_fo;
-        curr_fo = curr_fo -> fo_next;
+        curr_fo = fo_next(curr_fo);
     }
-    {
-        if (ofn) *ofn = 0;
-        if (ocd) *ocd = 0;
-        if (fn == 0) {
+    if (ofn) *ofn = 0;
+    if (ocd) *ocd = 0;
+    if (fn == 0) {
+#      ifdef THREADS
             UNLOCK();
            ENABLE_SIGNALS();
-           GC_free((extern_ptr_t)new_fo);
-            return;
-        }
-        new_fo -> fo_hidden_base = (word)HIDE_POINTER(base);
-        new_fo -> fo_fn = fn;
-        new_fo -> fo_client_data = (ptr_t)cd;
-        new_fo -> fo_object_size = GC_size(base);
-        new_fo -> fo_next = fo_head[index];
-        fo_head[index] = new_fo;
+#      endif
+        return;
     }
+#   ifdef THREADS
+      new_fo = (struct finalizable_object *)
+       GC_generic_malloc_inner(sizeof(struct finalizable_object),NORMAL);
+#   else
+      new_fo = GC_NEW(struct finalizable_object);
+#   endif
+    new_fo -> fo_hidden_base = (word)HIDE_POINTER(base);
+    new_fo -> fo_fn = fn;
+    new_fo -> fo_client_data = (ptr_t)cd;
+    new_fo -> fo_object_size = GC_size(base);
+    fo_set_next(new_fo, fo_head[index]);
+    GC_fo_entries++;
+    fo_head[index] = new_fo;
     UNLOCK();
-    ENABLE_SIGNALS();
 }
 
 /* Called with world stopped.  Cause disappearing links to disappear,  */
@@ -200,50 +319,72 @@ void GC_finalize()
 {
     struct disappearing_link * curr_dl, * prev_dl, * next_dl;
     struct finalizable_object * curr_fo, * prev_fo, * next_fo;
-    ptr_t real_ptr;
+    ptr_t real_ptr, real_link;
     register int i;
+    int dl_size = 1 << log_dl_table_size;
+    int fo_size = 1 << log_fo_table_size;
     
   /* Make disappearing links disappear */
-    for (i = 0; i < TSIZE; i++) {
+    for (i = 0; i < dl_size; i++) {
       curr_dl = dl_head[i];
       prev_dl = 0;
       while (curr_dl != 0) {
         real_ptr = (ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_obj);
+        real_link = (ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_link);
         if (!GC_is_marked(real_ptr)) {
-            *(word *)(REVEAL_POINTER(curr_dl -> dl_hidden_link)) = 0;
-            next_dl = curr_dl -> dl_next;
+            *(word *)real_link = 0;
+            next_dl = dl_next(curr_dl);
             if (prev_dl == 0) {
                 dl_head[i] = next_dl;
             } else {
-                prev_dl -> dl_next = next_dl;
+                dl_set_next(prev_dl, next_dl);
             }
             GC_clear_mark_bit((ptr_t)curr_dl);
+            GC_dl_entries--;
             curr_dl = next_dl;
         } else {
             prev_dl = curr_dl;
-            curr_dl = curr_dl -> dl_next;
+            curr_dl = dl_next(curr_dl);
         }
       }
     }
   /* Mark all objects reachable via chains of 1 or more pointers       */
   /* from finalizable objects.                                         */
-    for (i = 0; i < TSIZE; i++) {
-      for (curr_fo = fo_head[i]; curr_fo != 0; curr_fo = curr_fo -> fo_next) {
+#   ifdef PRINTSTATS
+        if (GC_mark_state != MS_NONE) ABORT("Bad mark state");
+#   endif
+    for (i = 0; i < fo_size; i++) {
+      for (curr_fo = fo_head[i]; curr_fo != 0; curr_fo = fo_next(curr_fo)) {
         real_ptr = (ptr_t)REVEAL_POINTER(curr_fo -> fo_hidden_base);
         if (!GC_is_marked(real_ptr)) {
-            GC_push_all(real_ptr, real_ptr + curr_fo -> fo_object_size);
+            hdr * hhdr = HDR(real_ptr);
+            
+            PUSH_OBJ((word *)real_ptr, hhdr, GC_mark_stack_top,
+                    &(GC_mark_stack[GC_mark_stack_size]));
             while (!GC_mark_stack_empty()) GC_mark_from_mark_stack();
+            if (GC_mark_state != MS_NONE) {
+                /* Mark stack overflowed. Very unlikely. */
+#              ifdef PRINTSTATS
+                   if (GC_mark_state != MS_INVALID) ABORT("Bad mark state");
+                   GC_printf0("Mark stack overflowed in finalization!!\n");
+#              endif
+               /* Make mark bits consistent again.  Forget about       */
+               /* finalizing this object for now.                      */
+                   GC_set_mark_bit(real_ptr);
+                   while (!GC_mark_some());
+            }
+            /* 
+            if (GC_is_marked(real_ptr)) {
+                --> Report finalization cycle here, if desired
+            }
+            */
         }
-        /* 
-        if (GC_is_marked(real_ptr)) {
-            --> Report finalization cycle here, if desired
-        }
-        */
+        
       }
     }
   /* Invoke finalization code for all objects that are still           */
   /* unreachable.                                                      */
-    for (i = 0; i < TSIZE; i++) {
+    for (i = 0; i < fo_size; i++) {
       curr_fo = fo_head[i];
       prev_fo = 0;
       while (curr_fo != 0) {
@@ -251,34 +392,59 @@ void GC_finalize()
         if (!GC_is_marked(real_ptr)) {
             (*(curr_fo -> fo_fn))(real_ptr, curr_fo -> fo_client_data);
             GC_set_mark_bit(real_ptr);
-            next_fo = curr_fo -> fo_next;
+            next_fo = fo_next(curr_fo);
             if (prev_fo == 0) {
                 fo_head[i] = next_fo;
             } else {
-                prev_fo -> fo_next = next_fo;
+                fo_set_next(prev_fo, next_fo);
             }
-            if (!GC_is_marked((ptr_t)curr_fo)) {
+#          ifdef PRINTSTATS
+              if (!GC_is_marked((ptr_t)curr_fo)) {
                 ABORT("GC_finalize: found accessible unmarked object\n");
-            }
+              }
+#          endif
             GC_clear_mark_bit((ptr_t)curr_fo);
+            GC_fo_entries--;
             curr_fo = next_fo;
         } else {
             prev_fo = curr_fo;
-            curr_fo = curr_fo -> fo_next;
+            curr_fo = fo_next(curr_fo);
+        }
+      }
+    }
+  /* Remove dangling disappearing links. */
+    for (i = 0; i < dl_size; i++) {
+      curr_dl = dl_head[i];
+      prev_dl = 0;
+      while (curr_dl != 0) {
+        real_link = GC_base((ptr_t)REVEAL_POINTER(curr_dl -> dl_hidden_link));
+        if (real_link != 0 && !GC_is_marked(real_link)) {
+            next_dl = dl_next(curr_dl);
+            if (prev_dl == 0) {
+                dl_head[i] = next_dl;
+            } else {
+                dl_set_next(prev_dl, next_dl);
+            }
+            GC_clear_mark_bit((ptr_t)curr_dl);
+            GC_dl_entries--;
+            curr_dl = next_dl;
+        } else {
+            prev_dl = curr_dl;
+            curr_dl = dl_next(curr_dl);
         }
       }
     }
 }
 
 # ifdef __STDC__
-    void_star GC_call_with_alloc_lock(GC_fn_type fn, void_star client_data)
+    extern_ptr_t GC_call_with_alloc_lock(GC_fn_type fn, extern_ptr_t client_data)
 # else
-    void_star GC_call_with_alloc_lock(fn, client_data)
+    extern_ptr_t GC_call_with_alloc_lock(fn, client_data)
     GC_fn_type fn;
-    void_star client_data;
+    extern_ptr_t client_data;
 # endif
 {
-    void_star result;
+    extern_ptr_t result;
     DCL_LOCK_STATE;
     
     DISABLE_SIGNALS();
diff --git a/gc.h b/gc.h
index 3ca0deb..25ce205 100644 (file)
--- a/gc.h
+++ b/gc.h
@@ -8,11 +8,11 @@
  * Permission is hereby granted to copy this garbage collector for any purpose,
  * provided the above notices are retained on all copies.
  */
-/* Boehm, December 20, 1993 3:05 pm PST */
+/* Boehm, April 6, 1994 10:55 am PDT */
  
-#ifndef GC_H
+#ifndef _GC_H
 
-# define GC_H
+# define _GC_H
 
 # include <stddef.h>
 
@@ -29,13 +29,9 @@ typedef long GC_signed_word;
 
 /* Public read-only variables */
 
-extern GC_word GC_heapsize;       /* Heap size in bytes */
-
 extern GC_word GC_gc_no;/* Counter incremented per collection.         */
                        /* Includes empty GCs at startup.               */
                        
-extern int GC_incremental;  /* Using incremental/generational collection. */
-
 
 /* Public R/W variables */
 
@@ -68,9 +64,10 @@ extern GC_word GC_free_space_divisor;
                        /* Increasing its value will use less space     */
                        /* but more collection time.  Decreasing it     */
                        /* will appreciably decrease collection time    */
-                       /* at the expens of space.                      */
+                       /* at the expense of space.                     */
                        /* GC_free_space_divisor = 1 will effectively   */
                        /* disable collections.                         */
+
                        
 /* Public procedures */
 /*
@@ -160,7 +157,7 @@ void GC_end_stubborn_change(/* p */);
 
 /* Explicitly increase the heap size.  */
 /* Returns 0 on failure, 1 on success.  */
-extern int GC_expand_hp(/* number_of_4K_blocks */);
+extern int GC_expand_hp(/* number_of_bytes */);
 
 /* Clear the set of root segments */
 extern void GC_clear_roots();
@@ -183,6 +180,11 @@ void GC_register_displacement(/* n */);
 /* Explicitly trigger a collection.    */
 void GC_gcollect();
 
+/* Return the number of bytes in the heap.  Excludes collector private */
+/* data structures.  Includes empty blocks and fragmentation loss.     */
+/* Includes some pages that were allocated but never written.          */
+size_t GC_get_heap_size();
+
 /* Enable incremental/generational collection. */
 /* Not advisable unless dirty bits are                 */
 /* available or most heap objects are          */
@@ -254,7 +256,7 @@ void GC_debug_end_stubborn_change(/* p */);
 # define GC_NEW(t) (t *)GC_MALLOC(sizeof (t))
 # define GC_NEW_ATOMIC(t) (t *)GC_MALLOC_ATOMIC(sizeof (t))
 # define GC_NEW_STUBBORN(t) (t *)GC_MALLOC_STUBBORN(sizeof (t))
-# define GC_NEW_UNCOLLECTABLE(t) (t *)GC_NEW_UNCOLLECTABLE(sizeof (t))
+# define GC_NEW_UNCOLLECTABLE(t) (t *)GC_MALLOC_UNCOLLECTABLE(sizeof (t))
 
 /* Finalization.  Some of these primitives are grossly unsafe.         */
 /* The idea is to make them both cheap, and sufficient to build                */
@@ -298,6 +300,10 @@ void GC_register_finalizer(/* void * obj,
        /* pointers only if the allocation lock is held, and    */
        /* such conversions are not performed by finalization   */
        /* routines.                                            */
+       /* If GC_register_finalizer is aborted as a result of   */
+       /* a signal, the object may be left with no             */
+       /* finalization, even if neither the old nor new        */
+       /* finalizer were NULL.                                 */
 
 /* The following routine may be used to break cycles between   */
 /* finalizable objects, thus causing cyclic finalizable                */
@@ -378,4 +384,35 @@ int GC_unregister_disappearing_link(/* void ** link */);
 #   endif
 # endif
 
-#endif
+#ifdef SOLARIS_THREADS
+/* We need to intercept calls to many of the threads primitives, so    */
+/* that we can locate thread stacks and stop the world.                        */
+/* Note also that the collector cannot see thread specific data.       */
+/* Thread specific data should generally consist of pointers to                */
+/* uncollectable objects, which are deallocated using the destructor   */
+/* facility in thr_keycreate.                                          */
+# include <thread.h>
+  int GC_thr_create(void *stack_base, size_t stack_size,
+                    void *(*start_routine)(void *), void *arg, long flags,
+                    thread_t *new_thread);
+  int GC_thr_join(thread_t wait_for, thread_t *departed, void **status);
+  int GC_thr_suspend(thread_t target_thread);
+  int GC_thr_continue(thread_t target_thread);
+  void * GC_dlopen(const char *path, int mode);
+
+# define thr_create GC_thr_create
+# define thr_join GC_thr_join
+# define thr_suspend GC_thr_suspend
+# define thr_continue GC_thr_continue
+# define dlopen GC_dlopen
+
+/* This returns a list of objects, linked through their first          */
+/* word.  Its use can greatly reduce lock contention problems, since   */
+/* the allocation lock can be acquired and released many fewer times.  */
+void * GC_malloc_many(size_t lb);
+#define GC_NEXT(p) (*(void **)(p))     /* Retrieve the next element    */
+                                       /* in returned list.            */
+
+#endif /* SOLARIS_THREADS */
+
+#endif /* _GC_H */
diff --git a/gc_c++.cc b/gc_c++.cc
new file mode 100644 (file)
index 0000000..6654241
--- /dev/null
+++ b/gc_c++.cc
@@ -0,0 +1,33 @@
+/*************************************************************************
+
+
+Copyright (c) 1994 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 code for any purpose,
+provided the above notices are retained on all copies.
+
+This implementation module for gc_c++.h provides an implementation of
+the global operators "new" and "delete" that calls the Boehm
+allocator.  All objects allocated by this implementation will be
+non-collectable but part of the root set of the collector.
+
+You should ensure (using implementation-dependent techniques) that the
+linker finds this module before the library that defines the default
+built-in "new" and "delete".
+
+
+**************************************************************************/
+
+#include "gc_c++.h"
+
+void* operator new( size_t size ) {
+    return GC_MALLOC_UNCOLLECTABLE( size ); }
+  
+void operator delete( void* obj ) {
+    return GC_FREE( obj ); }
+  
+
+
diff --git a/gc_c++.h b/gc_c++.h
new file mode 100644 (file)
index 0000000..0c0ee27
--- /dev/null
+++ b/gc_c++.h
@@ -0,0 +1,158 @@
+
+/****************************************************************************
+
+Copyright (c) 1994 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 code for any purpose,
+provided the above notices are retained on all copies.
+
+C++ Interface to the Boehm Collector
+
+    Jesse Hull and John Ellis
+    Last modified on Tue Feb 15 14:43:02 PST 1994 by ellis
+
+This interface provides access to the Boehm collector (versions 3.6
+and later).  It is intended to provide facilities similar to those
+described in the Ellis-Detlefs proposal for C++ garbage collection.
+
+To make a class collectable, derive it from the base class "gc":
+
+    class MyClass: gc {...}
+
+Then, "new MyClass" will allocate intances that will be automatically
+garbage collected.
+
+Collected objects can be explicitly deleted with "delete", e.g.
+
+    MyClass* m = ...;
+    delete m;
+
+This will free the object's storage immediately.
+
+Collected instances of non-class types can be allocated using
+placement syntax with the argument "GC":
+
+    typedef int A[ 10 ];
+    A* a = new (GC) A;
+
+The built-in "operator new" continues to allocate non-collectible
+objects that the programmer must explicitly delete.  Collected object
+may freely point at non-collected objects, and vice versa.
+
+Object clean-up (finalization) can be specified using class
+"gc_cleanup".  When an object derived from "gc_cleanup" is discovered
+to be inaccessible by the collector, or when it is explicitly deleted,
+its destructors will be invoked first.
+
+Clean-up functions for non-class types can be specified as additional
+placement arguments:
+
+    A* a = new (GC, MyCleanup) A;
+
+An object is considered "accessible" by the collector if it can be
+reached by a path of pointers from static variables, automatic
+variables of active functions, or from another object with clean-up
+enabled.  This implies that if object A and B both have clean-up
+enabled, and A points at B, B will be considered accessible, and A's
+clean-up will be be invoked before B's.  If A points at B and B points
+back to A, forming a cycle, that's considered a storage leak, and
+neither will ever become inaccessible.  See the C interface gc.h for
+low-level facilities for handling such cycles of objects with cleanup.
+
+****************************************************************************/
+
+#ifndef GC_C++_H
+#define GC_C++_H
+
+extern "C" {
+#include "gc.h"
+}
+
+enum GCPlacement {GC, NoGC};
+
+class gc {
+public:
+    void* operator new( size_t size );
+    void* operator new( size_t size, GCPlacement gcp );
+    void operator delete( void* obj ); };
+    /*
+    Intances of classes derived from "gc" will be allocated in the 
+    collected heap by default, unless an explicit NoGC placement is
+    specified. */
+
+class gc_cleanup: public gc {
+public:
+    gc_cleanup();
+    virtual ~gc_cleanup();
+private:
+    static void cleanup( void* obj, void* clientData ); };
+    /*
+    Instances of classes derived from "gc_cleanup" will be allocated
+    in the collected heap by default.  Further, when the collector
+    discovers an instance is inaccessible (see above) or when the
+    instance is explicitly deleted, its destructors will be invoked.
+    NOTE: Only one instance of "gc_cleanup" should occur in the
+    inheritance heirarchy -- i.e. it should always be a virtual
+    base. */
+
+void* operator new( 
+    size_t size, 
+    GCPlacement gcp,
+    void (*cleanup)( void*, void* ) = 0,
+    void* clientData = 0 );
+    /*
+    If "gcp = GC", then this "operator new" allocates in the collected
+    heap, otherwise in the non-collected heap.  When the allocated
+    object "obj" becomes inaccessible, the collector will invoke the
+    function "cleanup( obj, clientData )".  It is an error to specify
+    a non-null "cleanup" when "gcp = NoGC". */
+
+/****************************************************************************
+
+Inline implementation
+
+****************************************************************************/
+
+inline void* gc::operator new( size_t size ) {
+    return GC_MALLOC( size ); };
+
+inline void* gc::operator new( size_t size, GCPlacement gcp ) {
+    if (gcp == GC) 
+        return GC_MALLOC( size );
+    else
+        return GC_MALLOC_UNCOLLECTABLE( size ); }
+
+inline void gc::operator delete( void* obj ) {
+    GC_FREE( obj ); }; 
+
+inline gc_cleanup::gc_cleanup() {
+    GC_REGISTER_FINALIZER( GC_base( this ), cleanup, this, 0, 0 ); }
+
+inline void gc_cleanup::cleanup( void* obj, void* realThis ) {
+    ((gc_cleanup*) realThis)->~gc_cleanup(); }
+
+inline gc_cleanup::~gc_cleanup() {
+    GC_REGISTER_FINALIZER( this, 0, 0, 0, 0 ); }
+
+inline void* operator new( 
+    size_t size, 
+    GCPlacement gcp,
+    void (*cleanup)( void*, void* ) = 0,
+    void* clientData = 0 )
+{
+    void* obj;
+
+    if (gcp == GC) {
+        obj = GC_MALLOC( size );
+        if (cleanup != 0) 
+            GC_REGISTER_FINALIZER( obj, cleanup, clientData, 0, 0 ); }
+    else {
+        obj = GC_MALLOC_UNCOLLECTABLE( size ); };
+    return obj; }
+        
+
+#endif
+
similarity index 89%
rename from gc_headers.h
rename to gc_hdrs.h
index 025adfd..3186d71 100644 (file)
+++ b/gc_hdrs.h
@@ -8,7 +8,7 @@
  * Permission is hereby granted to copy this garbage collector for any purpose,
  * provided the above notices are retained on all copies.
  */
-/* Boehm, November 15, 1993 1:37 pm PST */
+/* Boehm, March 10, 1994 3:36 pm PST */
 # ifndef GC_HEADERS_H
 # define GC_HEADERS_H
 typedef struct hblkhdr hdr;
@@ -28,7 +28,12 @@ typedef struct hblkhdr hdr;
 # endif
 
 /* Define appropriate out-degrees for each of the two tree levels      */
-# define LOG_BOTTOM_SZ 10
+# ifdef SMALL_CONFIG
+#   define LOG_BOTTOM_SZ 11
+       /* Keep top index size reasonable with smaller blocks. */
+# else
+#   define LOG_BOTTOM_SZ 10
+# endif
 # ifndef HASH_TL
 #   define LOG_TOP_SZ (WORDSZ - LOG_BOTTOM_SZ - LOG_HBLKSIZE)
 # else
@@ -75,12 +80,17 @@ typedef struct bi {
 # ifndef HASH_TL
 #   define BI(p) (GC_top_index \
                [(word)(p) >> (LOG_BOTTOM_SZ + LOG_HBLKSIZE)])
-#   define HDR(p) (BI(p)->index \
+#   define HDR_INNER(p) (BI(p)->index \
                [((word)(p) >> LOG_HBLKSIZE) & (BOTTOM_SZ - 1)])
+#   ifdef SMALL_CONFIG
+#      define HDR(p) GC_find_header((ptr_t)(p))
+#   else
+#      define HDR(p) HDR_INNER(p)
+#   endif
 #   define GET_BI(p, bottom_indx) (bottom_indx) = BI(p)
 #   define GET_HDR(p, hhdr) (hhdr) = HDR(p)
-#   define SET_HDR(p, hhdr) HDR(p) = (hhdr)
-#   define GET_HDR_ADDR(p, ha) (ha) = &(HDR(p))
+#   define SET_HDR(p, hhdr) HDR_INNER(p) = (hhdr)
+#   define GET_HDR_ADDR(p, ha) (ha) = &(HDR_INNER(p))
 # else /* hash */
 /*  Hash function for tree top level */
 #   define TL_HASH(hi) ((hi) & (TOP_SZ - 1))
diff --git a/gc_inl.h b/gc_inl.h
new file mode 100644 (file)
index 0000000..4f1ad6c
--- /dev/null
+++ b/gc_inl.h
@@ -0,0 +1,92 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991, 1992 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.
+ */
+/* Boehm, February 18, 1994 1:49 pm PST */
+# ifndef GC_PRIVATE_H
+#   include "gc_priv.h"
+# endif
+
+/* Allocate n words (NOT BYTES).  X is made to point to the result.    */
+/* It is assumed that n < MAXOBJSZ, and                                        */
+/* that n > 0.  On machines requiring double word alignment of some    */
+/* data, we also assume that n is 1 or even.  This bypasses the                */
+/* MERGE_SIZES mechanism.  In order to minimize the number of distinct */
+/* free lists that are maintained, the caller should ensure that a     */
+/* small number of distinct values of n are used.  (The MERGE_SIZES    */
+/* mechanism normally does this by ensuring that only the leading three        */
+/* bits of n may be nonzero.  See misc.c for details.)  We really      */
+/* recommend this only in cases in which n is a constant, and no       */
+/* locking is required.                                                        */
+/* In that case it may allow the compiler to perform substantial       */
+/* additional optimizations.                                           */
+# define GC_MALLOC_WORDS(result,n) \
+{      \
+    register ptr_t op; \
+    register ptr_t *opp;       \
+    DCL_LOCK_STATE;    \
+       \
+    opp = &(GC_objfreelist[n]);        \
+    FASTLOCK();        \
+    if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {  \
+        FASTUNLOCK();  \
+        (result) = GC_generic_malloc_words_small((n), NORMAL); \
+    } else {   \
+        *opp = obj_link(op);   \
+        obj_link(op) = 0;      \
+        GC_words_allocd += (n);        \
+        FASTUNLOCK();  \
+        (result) = (extern_ptr_t) op;  \
+    }  \
+}
+
+
+/* The same for atomic objects:        */
+# define GC_MALLOC_ATOMIC_WORDS(result,n) \
+{      \
+    register ptr_t op; \
+    register ptr_t *opp;       \
+    DCL_LOCK_STATE;    \
+       \
+    opp = &(GC_aobjfreelist[n]);       \
+    FASTLOCK();        \
+    if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {  \
+        FASTUNLOCK();  \
+        (result) = GC_generic_malloc_words_small((n), PTRFREE);        \
+    } else {   \
+        *opp = obj_link(op);   \
+        obj_link(op) = 0;      \
+        GC_words_allocd += (n);        \
+        FASTUNLOCK();  \
+        (result) = (extern_ptr_t) op;  \
+    }  \
+}
+
+/* And once more for two word initialized objects: */
+# define GC_CONS(result, first, second) \
+{      \
+    register ptr_t op; \
+    register ptr_t *opp;       \
+    DCL_LOCK_STATE;    \
+       \
+    opp = &(GC_objfreelist[2]);        \
+    FASTLOCK();        \
+    if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {  \
+        FASTUNLOCK();  \
+        op = GC_generic_malloc_words_small(2, NORMAL); \
+    } else {   \
+        *opp = obj_link(op);   \
+        GC_words_allocd += 2;  \
+        FASTUNLOCK();  \
+    } \
+    ((word *)op)[0] = (word)(first);   \
+    ((word *)op)[1] = (word)(second);  \
+    (result) = (extern_ptr_t) op;      \
+}
index fd7be47..db62d1d 100644 (file)
@@ -1,91 +1 @@
-/* 
- * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
- * Copyright (c) 1991, 1992 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.
- */
-# ifndef GC_PRIVATE_H
-#   include "gc_private.h"
-# endif
-
-/* Allocate n words (NOT BYTES).  X is made to point to the result.    */
-/* It is assumed that n < MAXOBJSZ, and                                        */
-/* that n > 0.  On machines requiring double word alignment of some    */
-/* data, we also assume that n is 1 or even.  This bypasses the                */
-/* MERGE_SIZES mechanism.  In order to minimize the number of distinct */
-/* free lists that are maintained, the caller should ensure that a     */
-/* small number of distinct values of n are used.  (The MERGE_SIZES    */
-/* mechanism normally does this by ensuring that only the leading three        */
-/* bits of n may be nonzero.  See misc.c for details.)  We really      */
-/* recommend this only in cases in which n is a constant, and no       */
-/* locking is required.                                                        */
-/* In that case it may allow the compiler to perform substantial       */
-/* additional optimizations.                                           */
-# define GC_MALLOC_WORDS(result,n) \
-{      \
-    register ptr_t op; \
-    register ptr_t *opp;       \
-    DCL_LOCK_STATE;    \
-       \
-    opp = &(GC_objfreelist[n]);        \
-    FASTLOCK();        \
-    if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {  \
-        FASTUNLOCK();  \
-        (result) = GC_generic_malloc_words_small((n), NORMAL); \
-    } else {   \
-        *opp = obj_link(op);   \
-        obj_link(op) = 0;      \
-        GC_words_allocd += (n);        \
-        FASTUNLOCK();  \
-        (result) = (extern_ptr_t) op;  \
-    }  \
-}
-
-
-/* The same for atomic objects:        */
-# define GC_MALLOC_ATOMIC_WORDS(result,n) \
-{      \
-    register ptr_t op; \
-    register ptr_t *opp;       \
-    DCL_LOCK_STATE;    \
-       \
-    opp = &(GC_aobjfreelist[n]);       \
-    FASTLOCK();        \
-    if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {  \
-        FASTUNLOCK();  \
-        (result) = GC_generic_malloc_words_small((n), PTRFREE);        \
-    } else {   \
-        *opp = obj_link(op);   \
-        obj_link(op) = 0;      \
-        GC_words_allocd += (n);        \
-        FASTUNLOCK();  \
-        (result) = (extern_ptr_t) op;  \
-    }  \
-}
-
-/* And once more for two word initialized objects: */
-# define GC_CONS(result, first, second) \
-{      \
-    register ptr_t op; \
-    register ptr_t *opp;       \
-    DCL_LOCK_STATE;    \
-       \
-    opp = &(GC_objfreelist[2]);        \
-    FASTLOCK();        \
-    if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {  \
-        FASTUNLOCK();  \
-        op = GC_generic_malloc_words_small(2, NORMAL); \
-    } else {   \
-        *opp = obj_link(op);   \
-        GC_words_allocd += 2;  \
-        FASTUNLOCK();  \
-    } \
-    ((word *)op)[0] = (word)(first);   \
-    ((word *)op)[1] = (word)(second);  \
-    (result) = (extern_ptr_t) op;      \
-}
+# include "gc_inl.h"
diff --git a/gc_mark.h b/gc_mark.h
new file mode 100644 (file)
index 0000000..81c18fd
--- /dev/null
+++ b/gc_mark.h
@@ -0,0 +1,206 @@
+/*
+ * Copyright (c) 1991-1994 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.
+ *
+ */
+/* Boehm, April 4, 1994 3:54 pm PDT */
+
+/*
+ * Declarations of mark stack.  Needed by marker and client supplied mark
+ * routines.  To be included after gc_priv.h.
+ */
+#ifndef GC_MARK_H
+# define GC_MARK_H
+
+/* A client supplied mark procedure.  Returns new mark stack pointer.  */
+/* Not currently used for predefined object kinds.                     */
+/* Primary effect should be to push new entries on the mark stack.     */
+/* Mark stack pointer values are passed and returned explicitly.       */
+/* Global variables decribing mark stack are not necessarily valid.    */
+/* (This usually saves a few cycles by keeping things in registers.)   */
+/* Assumed to scan about PROC_BYTES on average.  If it needs to do     */
+/* much more work than that, it should do it in smaller pieces by      */
+/* pushing itself back on the mark stack.                              */
+/* Note that it should always do some work (defined as marking some    */
+/* objects) before pushing more than one entry on the mark stack.      */
+/* This is required to ensure termination in the event of mark stack   */
+/* overflows.                                                          */
+/* This procedure is always called with at least one empty entry on the */
+/* mark stack.                                                         */
+/* Boehm, March 15, 1994 2:38 pm PST */
+# define PROC_BYTES 100
+typedef struct ms_entry * (*mark_proc)(/* word * addr, mark_stack_ptr,
+                                         mark_stack_limit, env */);
+                                         
+# define LOG_MAX_MARK_PROCS 6
+# define MAX_MARK_PROCS (1 << LOG_MAX_MARK_PROCS)
+extern mark_proc GC_mark_procs[MAX_MARK_PROCS];
+extern word GC_n_mark_procs;
+
+/* Object descriptors on mark stack or in objects.  Low order two      */
+/* bits are tags distinguishing among the following 4 possibilities    */
+/* for the high order 30 bits.                                         */
+#define DS_TAG_BITS 2
+#define DS_TAGS   ((1 << DS_TAG_BITS) - 1)
+#define DS_LENGTH 0    /* The entire word is a length in bytes that    */
+                       /* must be a multiple of 4.                     */
+#define DS_BITMAP 1    /* 30 bits are a bitmap describing pointer      */
+                       /* fields.  The msb is 1 iff the first word     */
+                       /* is a pointer.                                */
+                       /* (This unconventional ordering sometimes      */
+                       /* makes the marker slightly faster.)           */
+                       /* Zeroes indicate definite nonpointers.  Ones  */
+                       /* indicate possible pointers.                  */
+                       /* Only usable if pointers are word aligned.    */
+#   define BITMAP_BITS (WORDSZ - DS_TAG_BITS)
+#define DS_PROC   2
+                       /* The objects referenced by this object can be */
+                       /* pushed on the mark stack by invoking         */
+                       /* PROC(descr).  ENV(descr) is passed as the    */
+                       /* last argument.                               */
+#   define PROC(descr) \
+               (GC_mark_procs[((descr) >> DS_TAG_BITS) & (MAX_MARK_PROCS-1)])
+#   define ENV(descr) \
+               ((descr) >> (DS_TAG_BITS + LOG_MAX_MARK_PROCS))
+#   define MAX_ENV \
+             (((word)1 << (WORDSZ - DS_TAG_BITS - LOG_MAX_MARK_PROCS)) - 1)
+#   define MAKE_PROC(proc_index, env) \
+           (((((env) << LOG_MAX_MARK_PROCS) | (proc_index)) << DS_TAG_BITS) \
+           | DS_PROC)
+#define DS_PER_OBJECT 3        /* The real descriptor is at the                */
+                       /* byte displacement from the beginning of the  */
+                       /* object given by descr & ~DS_TAGS             */
+                       
+typedef struct ms_entry {
+    word * mse_start;   /* First word of object */
+    word mse_descr;    /* Descriptor; low order two bits are tags,     */
+                       /* identifying the upper 30 bits as one of the  */
+                       /* following:                                   */
+} mse;
+
+extern word GC_mark_stack_size;
+
+extern mse * GC_mark_stack_top;
+
+extern mse * GC_mark_stack;
+
+word GC_find_start();
+
+mse * GC_signal_mark_stack_overflow();
+
+# ifdef GATHERSTATS
+#   define ADD_TO_ATOMIC(sz) GC_atomic_in_use += (sz)
+#   define ADD_TO_COMPOSITE(sz) GC_composite_in_use += (sz)
+# else
+#   define ADD_TO_ATOMIC(sz)
+#   define ADD_TO_COMPOSITE(sz)
+# endif
+
+/* Push the object obj with corresponding heap block header hhdr onto  */
+/* the mark stack.                                                     */
+# define PUSH_OBJ(obj, hhdr, mark_stack_top, mark_stack_limit) \
+{ \
+    register word _descr = (hhdr) -> hb_descr; \
+        \
+    if (_descr == 0) { \
+       ADD_TO_ATOMIC((hhdr) -> hb_sz); \
+    } else { \
+        ADD_TO_COMPOSITE((hhdr) -> hb_sz); \
+        mark_stack_top++; \
+        if (mark_stack_top >= mark_stack_limit) { \
+          mark_stack_top = GC_signal_mark_stack_overflow(mark_stack_top); \
+        } \
+        mark_stack_top -> mse_start = (obj); \
+        mark_stack_top -> mse_descr = _descr; \
+    } \
+}
+
+/* Push the contenst of current onto the mark stack if it is a valid   */
+/* ptr to a currently unmarked object.  Mark it.                       */
+# define PUSH_CONTENTS(current, mark_stack_top, mark_stack_limit) \
+{ \
+    register int displ;  /* Displacement in block; first bytes, then words */ \
+    register hdr * hhdr; \
+    register map_entry_type map_entry; \
+    \
+    GET_HDR(current,hhdr); \
+    if (IS_FORWARDING_ADDR_OR_NIL(hhdr)) { \
+         current = GC_find_start(current, hhdr); \
+         if (current == 0) continue; \
+         hhdr = HDR(current); \
+    } \
+    displ = HBLKDISPL(current); \
+    map_entry = MAP_ENTRY((hhdr -> hb_map), displ); \
+    if (map_entry == OBJ_INVALID) { \
+        GC_ADD_TO_BLACK_LIST_NORMAL(current); continue; \
+    } \
+    displ = BYTES_TO_WORDS(displ); \
+    displ -= map_entry; \
+       \
+    { \
+        register word * mark_word_addr = hhdr -> hb_marks + divWORDSZ(displ); \
+        register word mark_word = *mark_word_addr; \
+        register word mark_bit = (word)1 << modWORDSZ(displ); \
+          \
+        if (mark_word & mark_bit) { \
+             /* Mark bit is already set */ \
+             continue; \
+        } \
+        *mark_word_addr = mark_word | mark_bit; \
+    } \
+    PUSH_OBJ(((word *)(HBLKPTR(current)) + displ), hhdr, \
+            mark_stack_top, mark_stack_limit) \
+}
+
+extern bool GC_mark_stack_too_small;
+                               /* We need a larger mark stack.  May be */
+                               /* set by client supplied mark routines.*/
+
+typedef int mark_state_t;      /* Current state of marking, as follows:*/
+                               /* Used to remember where we are during */
+                               /* concurrent marking.                  */
+
+                               /* We say something is dirty if it was  */
+                               /* written since the last time we       */
+                               /* retrieved dirty bits.  We say it's   */
+                               /* grungy if it was marked dirty in the */
+                               /* last set of bits we retrieved.       */
+                               
+                               /* Invariant I: all roots and marked    */
+                               /* objects p are either dirty, or point */
+                               /* objects q that are either marked or  */
+                               /* a pointer to q appears in a range    */
+                               /* on the mark stack.                   */
+
+# define MS_NONE 0             /* No marking in progress. I holds.     */
+                               /* Mark stack is empty.                 */
+
+# define MS_PUSH_RESCUERS 1    /* Rescuing objects are currently       */
+                               /* being pushed.  I holds, except       */
+                               /* that grungy roots may point to       */
+                               /* unmarked objects, as may marked      */
+                               /* grungy objects above scan_ptr.       */
+
+# define MS_PUSH_UNCOLLECTABLE 2
+                               /* I holds, except that marked          */
+                               /* uncollectable objects above scan_ptr */
+                               /* may point to unmarked objects.       */
+                               /* Roots may point to unmarked objects  */
+
+# define MS_ROOTS_PUSHED 3     /* I holds, mark stack may be nonempty  */
+
+# define MS_PARTIALLY_INVALID 4        /* I may not hold, e.g. because of M.S. */
+                               /* overflow.  However marked heap       */
+                               /* objects below scan_ptr point to      */
+                               /* marked or stacked objects.           */
+
+# define MS_INVALID 5          /* I may not hold.                      */
+
+extern mark_state_t GC_mark_state;
+
+#endif  /* GC_MARK_H */
diff --git a/gc_priv.h b/gc_priv.h
new file mode 100644 (file)
index 0000000..3b2db25
--- /dev/null
+++ b/gc_priv.h
@@ -0,0 +1,1139 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 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.
+ */
+/* Boehm, March 31, 1994 1:01 pm PST */
+
+# ifndef GC_PRIVATE_H
+# define GC_PRIVATE_H
+
+# ifndef GC_H
+#   include "gc.h"
+# endif
+
+typedef GC_word word;
+typedef GC_signed_word signed_word;
+
+# ifndef CONFIG_H
+#   include "config.h"
+# endif
+
+# ifndef HEADERS_H
+#   include "gc_hdrs.h"
+# endif
+
+# ifndef bool
+    typedef int bool;
+# endif
+# define TRUE 1
+# define FALSE 0
+
+typedef char * ptr_t;  /* A generic pointer to which we can add        */
+                       /* byte displacments.                           */
+                       /* Prefereably identical to caddr_t, if it      */
+                       /* exists.                                      */
+                       
+#if defined(__STDC__)
+#   include <stdlib.h>
+#   if !(defined( sony_news ) )
+#       include <stddef.h>
+#   endif
+    typedef void * extern_ptr_t;
+#   define VOLATILE volatile
+#else
+#   ifdef MSWIN32
+#      include <stdlib.h>
+#   endif
+    typedef char * extern_ptr_t;
+#   define VOLATILE
+#endif
+
+#ifdef AMIGA
+#   define GC_FAR __far
+#else
+#   define GC_FAR
+#endif
+
+/*********************************/
+/*                               */
+/* Definitions for conservative  */
+/* collector                     */
+/*                               */
+/*********************************/
+
+/*********************************/
+/*                               */
+/* Easily changeable parameters  */
+/*                               */
+/*********************************/
+
+#define STUBBORN_ALLOC /* Define stubborn allocation primitives        */
+#if defined(SRC_M3) || defined(SMALL_CONFIG)
+# undef STUBBORN_ALLOC
+#endif
+
+
+/* #define ALL_INTERIOR_POINTERS */
+                   /* Forces all pointers into the interior of an      */
+                   /* object to be considered valid.  Also causes the  */
+                   /* sizes of all objects to be inflated by at least  */
+                   /* one byte.  This should suffice to guarantee      */
+                   /* that in the presence of a compiler that does     */
+                   /* not perform garbage-collector-unsafe             */
+                   /* optimizations, all portable, strictly ANSI       */
+                   /* conforming C programs should be safely usable    */
+                   /* with malloc replaced by GC_malloc and free       */
+                   /* calls removed.  There are several disadvantages: */
+                   /* 1. There are probably no interesting, portable,  */
+                   /*    strictly ANSI conforming C programs.          */
+                   /* 2. This option makes it hard for the collector   */
+                   /*    to allocate space that is not ``pointed to''  */
+                   /*    by integers, etc.  Under SunOS 4.X with a     */
+                   /*    statically linked libc, we empiricaly         */
+                   /*    observed that it would be difficult to        */
+                   /*    allocate individual objects larger than 100K. */
+                   /*    Even if only smaller objects are allocated,   */
+                   /*    more swap space is likely to be needed.       */
+                   /*    Fortunately, much of this will never be       */
+                   /*    touched.                                      */
+                   /* If you can easily avoid using this option, do.   */
+                   /* If not, try to keep individual objects small.    */
+                   
+#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
+
+#define PRINTBLACKLIST         /* Print black listed blocks, i.e. values that     */
+                       /* cause the allocator to avoid allocating certain */
+                       /* blocks in order to avoid introducing "false     */
+                       /* hits".                                          */
+#undef PRINTBLACKLIST
+
+#ifdef SILENT
+#  ifdef PRINTSTATS
+#    undef PRINTSTATS
+#  endif
+#  ifdef PRINTTIMES
+#    undef PRINTTIMES
+#  endif
+#  ifdef PRINTNBLOCKS
+#    undef PRINTNBLOCKS
+#  endif
+#endif
+
+#if defined(PRINTSTATS) && !defined(GATHERSTATS)
+#   define GATHERSTATS
+#endif
+
+# if defined(SOLARIS_THREADS) && !defined(SUNOS5)
+--> inconsistent configuration
+# endif
+# if defined(PCR) || defined(SRC_M3) || defined(SOLARIS_THREADS)
+#   define THREADS
+# endif
+
+#ifdef SPARC
+#   define ALIGN_DOUBLE  /* Align objects of size > 1 word on 2 word   */
+                        /* boundaries.  Wasteful of memory, but       */
+                        /* apparently required by SPARC architecture. */
+#   define ASM_CLEAR_CODE      /* Stack clearing is crucial, and we    */
+                               /* include assembly code to do it well. */
+#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 GC_allocobj and     */
+                   /* GC_allocaobj directly.                             */
+                   /* Slows down average programs slightly.  May however */
+                   /* substantially reduce fragmentation if allocation   */
+                   /* request sizes are widely scattered.                */
+                   /* May save significant amounts of space for obj_map  */
+                   /* entries.                                           */
+
+/* ALIGN_DOUBLE requires MERGE_SIZES at present. */
+# if defined(ALIGN_DOUBLE) && !defined(MERGE_SIZES)
+#   define MERGE_SIZES
+# endif
+
+#ifdef ALL_INTERIOR_POINTERS
+# define ADD_BYTE_AT_END
+#endif
+
+
+# define MINHINCR 16       /* Minimum heap increment, in blocks of HBLKSIZE  */
+# define MAXHINCR 512      /* Maximum heap increment, in blocks              */
+
+# define TIME_LIMIT 50    /* We try to keep pause times from exceeding  */
+                          /* this by much. In milliseconds.             */
+
+/*********************************/
+/*                               */
+/* OS interface routines        */
+/*                               */
+/*********************************/
+
+#include <time.h>
+#if !defined(__STDC__) && defined(SPARC) && defined(SUNOS4)
+   clock_t clock();    /* Not in time.h, where it belongs      */
+#endif
+#if !defined(CLOCKS_PER_SEC)
+#   define CLOCKS_PER_SEC 1000000
+/*
+ * This is technically a bug in the implementation.  ANSI requires that
+ * CLOCKS_PER_SEC be defined.  But at least under SunOS4.1.1, it isn't.
+ * Also note that the combination of ANSI C and POSIX is incredibly gross
+ * here. The type clock_t is used by both clock() and times().  But on
+ * some machines thes use different notions of a clock tick,  CLOCKS_PER_SEC
+ * seems to apply only to clock.  Hence we use it here.  On many machines,
+ * including SunOS, clock actually uses units of microseconds (which are
+ * not really clock ticks).
+ */
+#endif
+#define CLOCK_TYPE clock_t
+#define GET_TIME(x) x = clock()
+#define MS_TIME_DIFF(a,b) ((unsigned long) \
+               (1000.0*(double)((a)-(b))/(double)CLOCKS_PER_SEC))
+
+/* We use bzero and bcopy internally.  They may not be available.      */
+# if defined(SPARC) && defined(SUNOS4)
+#   define BCOPY_EXISTS
+# endif
+# if defined(M68K) && defined(AMIGA)
+#   define BCOPY_EXISTS
+# endif
+# if defined(M68K) && defined(NEXT)
+#   define BCOPY_EXISTS
+# endif
+# if defined(VAX)
+#   define BCOPY_EXISTS
+# endif
+# if defined(AMIGA)
+#   include <string.h>
+#   define BCOPY_EXISTS
+# endif
+
+# ifndef BCOPY_EXISTS
+#   include <string.h>
+#   define BCOPY(x,y,n) memcpy(y, x, (size_t)(n))
+#   define BZERO(x,n)  memset(x, 0, (size_t)(n))
+# else
+#   define BCOPY(x,y,n) bcopy((char *)(x),(char *)(y),(int)(n))
+#   define BZERO(x,n) bzero((char *)(x),(int)(n))
+# endif
+
+/* HBLKSIZE aligned allocation.  0 is taken to mean failure    */
+/* space is assumed to be cleared.                             */
+# ifdef PCR
+    char * real_malloc();
+#   define GET_MEM(bytes) HBLKPTR(real_malloc((size_t)bytes + HBLKSIZE) \
+                                 + HBLKSIZE-1)
+# else
+#   ifdef OS2
+      void * os2_alloc(size_t bytes);
+#     define GET_MEM(bytes) HBLKPTR((ptr_t)os2_alloc((size_t)bytes + HBLKSIZE) \
+                                    + HBLKSIZE-1)
+#   else
+#     if defined(AMIGA) || defined(NEXT)
+#       define GET_MEM(bytes) HBLKPTR(calloc(1, (size_t)bytes + HBLKSIZE) \
+                               + HBLKSIZE-1)
+#     else
+#      ifdef MSWIN32
+          extern ptr_t GC_win32_get_mem();
+#         define GET_MEM(bytes) (struct hblk *)GC_win32_get_mem(bytes)
+#      else
+          extern ptr_t GC_unix_get_mem();
+#         define GET_MEM(bytes) (struct hblk *)GC_unix_get_mem(bytes)
+#      endif
+#     endif
+#   endif
+# endif
+
+/*
+ * Mutual exclusion between allocator/collector routines.
+ * Needed if there is more than one allocator thread.
+ * FASTLOCK() is assumed to try to acquire the lock in a cheap and
+ * dirty way that is acceptable for a few instructions, e.g. by
+ * inhibiting preemption.  This is assumed to have succeeded only
+ * if a subsequent call to FASTLOCK_SUCCEEDED() returns TRUE.
+ * FASTUNLOCK() is called whether or not FASTLOCK_SUCCEEDED().
+ * If signals cannot be tolerated with the FASTLOCK held, then
+ * FASTLOCK should disable signals.  The code executed under
+ * FASTLOCK is otherwise immune to interruption, provided it is
+ * not restarted.
+ * DCL_LOCK_STATE declares any local variables needed by LOCK and UNLOCK
+ * and/or DISABLE_SIGNALS and ENABLE_SIGNALS and/or FASTLOCK.
+ * (There is currently no equivalent for FASTLOCK.)
+ */  
+# ifdef THREADS
+#  ifdef PCR
+#    include  "th/PCR_Th.h"
+#    include  "th/PCR_ThCrSec.h"
+     extern struct PCR_Th_MLRep GC_allocate_ml;
+#    define DCL_LOCK_STATE  PCR_sigset_t GC_old_sig_mask
+#    define LOCK() PCR_Th_ML_Acquire(&GC_allocate_ml) 
+#    define UNLOCK() PCR_Th_ML_Release(&GC_allocate_ml)
+#    define FASTLOCK() PCR_ThCrSec_EnterSys()
+     /* Here we cheat (a lot): */
+#        define FASTLOCK_SUCCEEDED() (*(int *)(&GC_allocate_ml) == 0)
+               /* TRUE if nobody currently holds the lock */
+#    define FASTUNLOCK() PCR_ThCrSec_ExitSys()
+#  endif
+#  ifdef SRC_M3
+     extern word RT0u__inCritical;
+#    define LOCK() RT0u__inCritical++
+#    define UNLOCK() RT0u__inCritical--
+#  endif
+#  ifdef SOLARIS_THREADS
+#    include <thread.h>
+#    include <signal.h>
+     extern mutex_t GC_allocate_ml;
+#    define LOCK() mutex_lock(&GC_allocate_ml);
+#    define UNLOCK() mutex_unlock(&GC_allocate_ml);
+#  endif
+# else
+#    define LOCK()
+#    define UNLOCK()
+# endif
+
+# ifndef DCL_LOCK_STATE
+#   define DCL_LOCK_STATE
+# endif
+# ifndef FASTLOCK
+#   define FASTLOCK() LOCK()
+#   define FASTLOCK_SUCCEEDED() TRUE
+#   define FASTUNLOCK() UNLOCK()
+# endif
+
+/* Delay any interrupts or signals that may abort this thread.  Data   */
+/* structures are in a consistent state outside this pair of calls.    */
+/* ANSI C allows both to be empty (though the standard isn't very      */
+/* clear on that point).  Standard malloc implementations are usually  */
+/* neither interruptable nor thread-safe, and thus correspond to       */
+/* empty definitions.                                                  */
+# ifdef PCR
+#   define DISABLE_SIGNALS() \
+                PCR_Th_SetSigMask(PCR_allSigsBlocked,&GC_old_sig_mask)
+#   define ENABLE_SIGNALS() \
+               PCR_Th_SetSigMask(&GC_old_sig_mask, NIL)
+# else
+#   if defined(SRC_M3) || defined(AMIGA) || defined(SOLARIS_THREADS) || defined(MSWIN32)
+                       /* Also useful for debugging, and unusually     */
+                       /* correct client code.                         */
+       /* Should probably use thr_sigsetmask for SOLARIS_THREADS. */
+#     define DISABLE_SIGNALS()
+#     define ENABLE_SIGNALS()
+#   else
+#     define DISABLE_SIGNALS() GC_disable_signals()
+       void GC_disable_signals();
+#     define ENABLE_SIGNALS() GC_enable_signals()
+       void GC_enable_signals();
+#   endif
+# endif
+
+/*
+ * Stop and restart mutator threads.
+ */
+# ifdef PCR
+#     include "th/PCR_ThCtl.h"
+#     define STOP_WORLD() \
+       PCR_ThCtl_SetExclusiveMode(PCR_ThCtl_ExclusiveMode_stopNormal, \
+                                  PCR_allSigsBlocked, \
+                                  PCR_waitForever)
+#     define START_WORLD() \
+       PCR_ThCtl_SetExclusiveMode(PCR_ThCtl_ExclusiveMode_null, \
+                                  PCR_allSigsBlocked, \
+                                  PCR_waitForever);
+# else
+#   ifdef SOLARIS_THREADS
+#     define STOP_WORLD() GC_stop_world()
+#     define START_WORLD() GC_start_world()
+#   else
+#     define STOP_WORLD()
+#     define START_WORLD()
+#   endif
+# endif
+
+/* Abandon ship */
+# ifdef PCR
+    void PCR_Base_Panic(const char *fmt, ...);
+#   define ABORT(s) PCR_Base_Panic(s)
+# else
+#   ifdef SMALL_CONFIG
+#      define ABORT(msg) abort();
+#   else
+       void GC_abort();
+#       define ABORT(msg) GC_abort(msg);
+#   endif
+# endif
+
+/* Exit abnormally, but without making a mess (e.g. out of memory) */
+# ifdef PCR
+    void PCR_Base_Exit(int status);
+#   define EXIT() PCR_Base_Exit(1)
+# else
+#   define EXIT() (void)exit(1)
+# endif
+
+/* Print warning message, e.g. almost out of memory.   */
+# define WARN(s) GC_printf0(s)
+
+/*********************************/
+/*                               */
+/* Word-size-dependent defines   */
+/*                               */
+/*********************************/
+
+#if CPP_WORDSZ == 32
+#  define WORDS_TO_BYTES(x)   ((x)<<2)
+#  define BYTES_TO_WORDS(x)   ((x)>>2)
+#  define LOGWL               ((word)5)    /* log[2] of CPP_WORDSZ */
+#  define modWORDSZ(n) ((n) & 0x1f)          /* n mod size of word         */
+#endif
+
+#if CPP_WORDSZ == 64
+#  define WORDS_TO_BYTES(x)   ((x)<<3)
+#  define BYTES_TO_WORDS(x)   ((x)>>3)
+#  define LOGWL               ((word)6)    /* log[2] of CPP_WORDSZ */
+#  define modWORDSZ(n) ((n) & 0x3f)          /* n mod size of word         */
+#endif
+
+#define WORDSZ ((word)CPP_WORDSZ)
+#define SIGNB  ((word)1 << (WORDSZ-1))
+#define BYTES_PER_WORD      ((word)(sizeof (word)))
+#define ONES                ((word)(-1))
+#define divWORDSZ(n) ((n) >> LOGWL)       /* divide n by size of word      */
+
+/*********************/
+/*                   */
+/*  Size Parameters  */
+/*                   */
+/*********************/
+
+/*  heap block size, bytes. Should be power of 2 */
+
+#ifdef SMALL_CONFIG
+#   define CPP_LOG_HBLKSIZE 10
+#else
+# if CPP_WORDSZ == 32
+#   define CPP_LOG_HBLKSIZE 12
+# else
+#   define CPP_LOG_HBLKSIZE 13
+# endif
+#endif
+#define LOG_HBLKSIZE   ((word)CPP_LOG_HBLKSIZE)
+#define CPP_HBLKSIZE (1 << CPP_LOG_HBLKSIZE)
+#define HBLKSIZE ((word)CPP_HBLKSIZE)
+
+
+/*  max size objects supported by freelist (larger objects may be   */
+/*  allocated, but less efficiently)                                */
+
+#define CPP_MAXOBJSZ    BYTES_TO_WORDS(CPP_HBLKSIZE/2)
+#define MAXOBJSZ ((word)CPP_MAXOBJSZ)
+               
+# define divHBLKSZ(n) ((n) >> LOG_HBLKSIZE)
+
+# define HBLK_PTR_DIFF(p,q) divHBLKSZ((ptr_t)p - (ptr_t)q)
+       /* Equivalent to subtracting 2 hblk pointers.   */
+       /* We do it this way because a compiler should  */
+       /* find it hard to use an integer division      */
+       /* instead of a shift.  The bundled SunOS 4.1   */
+       /* o.w. sometimes pessimizes the subtraction to */
+       /* involve a call to .div.                      */
+# define modHBLKSZ(n) ((n) & (HBLKSIZE-1))
+# define HBLKPTR(objptr) ((struct hblk *)(((word) (objptr)) & ~(HBLKSIZE-1)))
+
+# define HBLKDISPL(objptr) (((word) (objptr)) & (HBLKSIZE-1))
+
+/* Round up byte allocation requests to integral number of words, etc. */
+# ifdef ADD_BYTE_AT_END
+#   define ROUNDED_UP_WORDS(n) BYTES_TO_WORDS((n) + WORDS_TO_BYTES(1))
+#   define SMALL_OBJ(bytes) ((bytes) < WORDS_TO_BYTES(MAXOBJSZ))
+#   define ADD_SLOP(bytes) ((bytes)+1)
+# else
+#   define ROUNDED_UP_WORDS(n) BYTES_TO_WORDS((n) + WORDS_TO_BYTES(1) - 1)
+#   define SMALL_OBJ(bytes) ((bytes) <= WORDS_TO_BYTES(MAXOBJSZ))
+#   define ADD_SLOP(bytes) (bytes)
+# endif
+
+
+/*
+ * Hash table representation of sets of pages.  This assumes it is
+ * OK to add spurious entries to sets.
+ * Used by black-listing code, and perhaps by dirty bit maintenance code.
+ */
+# define LOG_PHT_ENTRIES  14   /* Collisions are likely if heap grows  */
+                               /* to more than 16K hblks = 64MB.       */
+                               /* Each hash table occupies 2K bytes.   */
+# define PHT_ENTRIES ((word)1 << LOG_PHT_ENTRIES)
+# define PHT_SIZE (PHT_ENTRIES >> LOGWL)
+typedef word page_hash_table[PHT_SIZE];
+
+# define PHT_HASH(addr) ((((word)(addr)) >> LOG_HBLKSIZE) & (PHT_ENTRIES - 1))
+
+# define get_pht_entry_from_index(bl, index) \
+               (((bl)[divWORDSZ(index)] >> modWORDSZ(index)) & 1)
+# define set_pht_entry_from_index(bl, index) \
+               (bl)[divWORDSZ(index)] |= (word)1 << modWORDSZ(index)
+# define clear_pht_entry_from_index(bl, index) \
+               (bl)[divWORDSZ(index)] &= ~((word)1 << modWORDSZ(index))
+       
+
+
+/********************************************/
+/*                                          */
+/*    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/CPP_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*CPP_WORDSZ - 1) \
+                         / (2*CPP_WORDSZ))*2)
+# else
+#   define MARK_BITS_SZ ((MARK_BITS_PER_HBLK + CPP_WORDSZ - 1)/CPP_WORDSZ)
+# endif
+          /* Upper bound on number of mark words per heap block  */
+
+struct hblkhdr {
+    word hb_sz;  /* If in use, size in words, of objects in the block. */
+                /* if free, the size in bytes of the whole block      */
+    struct hblk * hb_next;     /* Link field for hblk free list         */
+                               /* and for lists of chunks waiting to be */
+                               /* reclaimed.                            */
+    word hb_descr;             /* object descriptor for marking.  See  */
+                               /* mark.h.                              */
+    char* hb_map;      /* A pointer to a pointer validity map of the block. */
+                       /* See GC_obj_map.                                   */
+                       /* Valid for all blocks with headers.                */
+                       /* Free blocks point to GC_invalid_map.              */
+    unsigned short hb_obj_kind;
+                        /* Kind of objects in the block.  Each kind    */
+                        /* identifies a mark procedure and a set of    */
+                        /* list headers.  sometimes called regions.    */
+    unsigned short hb_last_reclaimed;
+                               /* Value of GC_gc_no when block was     */
+                               /* last allocated or swept. May wrap.   */
+    word hb_marks[MARK_BITS_SZ];
+                           /* Bit i in the array refers to the             */
+                           /* object starting at the ith word (header      */
+                           /* INCLUDED) in the heap block.                 */
+                           /* The lsb of word 0 is numbered 0.             */
+};
+
+/*  heap block body */
+
+# define DISCARD_WORDS 0
+       /* Number of words to be dropped at the beginning of each block */
+       /* Must be a multiple of WORDSZ.  May reasonably be nonzero     */
+       /* on machines that don't guarantee longword alignment of       */
+       /* pointers, so that the number of false hits is minimized.     */
+       /* 0 and WORDSZ are probably the only reasonable values.        */
+
+# define BODY_SZ ((HBLKSIZE-WORDS_TO_BYTES(DISCARD_WORDS))/sizeof(word))
+
+struct hblk {
+#   if (DISCARD_WORDS != 0)
+        word garbage[DISCARD_WORDS];
+#   endif
+    word hb_body[BODY_SZ];
+};
+
+# define HDR_WORDS ((word)DISCARD_WORDS)
+# define HDR_BYTES ((word)WORDS_TO_BYTES(DISCARD_WORDS))
+
+# define OBJ_SZ_TO_BLOCKS(sz) \
+    divHBLKSZ(HDR_BYTES + WORDS_TO_BYTES(sz) + HBLKSIZE-1)
+    /* Size of block (in units of HBLKSIZE) needed to hold objects of  */
+    /* given sz (in words).                                            */
+
+/* Object free list link */
+# define obj_link(p) (*(ptr_t *)(p))
+
+/*  lists of all heap blocks and free lists    */
+/* These are grouped together in a struct      */
+/* so that they can be easily skipped by the   */
+/* GC_mark routine.                            */
+/* The ordering is weird to make GC_malloc     */
+/* faster by keeping the important fields      */
+/* sufficiently close together that a          */
+/* single load of a base register will do.     */
+/* Scalars that could easily appear to         */
+/* be pointers are also put here.              */
+
+struct _GC_arrays {
+  word _heapsize;
+  ptr_t _last_heap_addr;
+  ptr_t _prev_heap_addr;
+  word _words_allocd_before_gc;
+               /* Number of words allocated before this        */
+               /* collection cycle.                            */
+# ifdef GATHERSTATS
+    word _composite_in_use;
+               /* Number of words in accessible composite      */
+               /* objects.                                     */
+    word _atomic_in_use;
+               /* Number of words in accessible atomic         */
+               /* objects.                                     */
+# endif
+  word _words_allocd;
+       /* Number of words allocated during this collection cycle */
+  word _words_wasted;
+       /* Number of words wasted due to internal fragmentation  */
+       /* in large objects allocated since last gc. Approximate.*/
+  word _non_gc_bytes_at_gc;
+       /* Number of explicitly managed bytes of storage        */
+       /* at last collection.                                  */
+  word _mem_freed;
+       /* Number of explicitly deallocated words of memory     */
+       /* since last collection.                               */
+       
+  ptr_t _objfreelist[MAXOBJSZ+1];
+                         /* free list for objects */
+# ifdef MERGE_SIZES
+    unsigned _size_map[WORDS_TO_BYTES(MAXOBJSZ+1)];
+       /* Number of words to allocate for a given allocation request in */
+       /* bytes.                                                        */
+# endif 
+  ptr_t _aobjfreelist[MAXOBJSZ+1];
+                         /* free list for atomic objs  */
+
+  ptr_t _uobjfreelist[MAXOBJSZ+1];
+                         /* uncollectable but traced objs      */
+
+# ifdef STUBBORN_ALLOC
+    ptr_t _sobjfreelist[MAXOBJSZ+1];
+# endif
+                         /* free list for immutable objects    */
+  ptr_t _obj_map[MAXOBJSZ+1];
+                       /* If not NIL, then a pointer to a map of valid  */
+                      /* object addresses. hbh_map[sz][i] is j if the  */
+                      /* address block_start+i is a valid pointer      */
+                      /* to an object at                               */
+                      /* block_start+i&~3 - WORDS_TO_BYTES(j).         */
+                      /* (If ALL_INTERIOR_POINTERS is defined, then    */
+                      /* instead ((short *)(hbh_map[sz])[i] is j if    */
+                      /* block_start+WORDS_TO_BYTES(i) is in the       */
+                      /* interior of an object starting at             */
+                      /* block_start+WORDS_TO_BYTES(i-j)).             */
+                      /* It is OBJ_INVALID if                          */
+                      /* block_start+WORDS_TO_BYTES(i) is not          */
+                      /* valid as a pointer to an object.              */
+                      /* We assume that all values of j <= OBJ_INVALID */
+                      /* The zeroth entry corresponds to large objects.*/
+#   ifdef ALL_INTERIOR_POINTERS
+#      define map_entry_type short
+#       define OBJ_INVALID 0x7fff
+#      define MAP_ENTRY(map, bytes) \
+               (((map_entry_type *)(map))[BYTES_TO_WORDS(bytes)])
+#      define MAP_ENTRIES BYTES_TO_WORDS(HBLKSIZE)
+#      define MAP_SIZE (MAP_ENTRIES * sizeof(map_entry_type))
+#      define OFFSET_VALID(displ) TRUE
+#      define CPP_MAX_OFFSET (HBLKSIZE - HDR_BYTES - 1)
+#      define MAX_OFFSET ((word)CPP_MAX_OFFSET)
+#   else
+#      define map_entry_type char
+#       define OBJ_INVALID 0x7f
+#      define MAP_ENTRY(map, bytes) \
+               (map)[bytes]
+#      define MAP_ENTRIES HBLKSIZE
+#      define MAP_SIZE MAP_ENTRIES
+#      define CPP_MAX_OFFSET (WORDS_TO_BYTES(OBJ_INVALID) - 1) 
+#      define MAX_OFFSET ((word)CPP_MAX_OFFSET)
+#      define VALID_OFFSET_SZ \
+         (CPP_MAX_OFFSET > WORDS_TO_BYTES(CPP_MAXOBJSZ)? \
+          CPP_MAX_OFFSET+1 \
+          : WORDS_TO_BYTES(CPP_MAXOBJSZ)+1)
+       char _valid_offsets[VALID_OFFSET_SZ];
+                               /* GC_valid_offsets[i] == TRUE ==> i    */
+                               /* is registered as a displacement.     */
+#      define OFFSET_VALID(displ) GC_valid_offsets[displ]
+       char _modws_valid_offsets[sizeof(word)];
+                               /* GC_valid_offsets[i] ==>                */
+                               /* GC_modws_valid_offsets[i%sizeof(word)] */
+#   endif
+  struct hblk * _reclaim_list[MAXOBJSZ+1];
+  struct hblk * _areclaim_list[MAXOBJSZ+1];
+  struct hblk * _ureclaim_list[MAXOBJSZ+1];
+# ifdef STUBBORN_ALLOC
+      struct hblk * _sreclaim_list[MAXOBJSZ+1];
+      page_hash_table _changed_pages;
+        /* Stubborn object pages that were changes since last call to  */
+       /* GC_read_changed.                                             */
+      page_hash_table _prev_changed_pages;
+        /* Stubborn object pages that were changes before last call to */
+       /* GC_read_changed.                                             */
+# endif
+# if defined(PROC_VDB) || defined(MPROTECT_VDB)
+      page_hash_table _grungy_pages; /* Pages that were dirty at last     */
+                                    /* GC_read_dirty.                     */
+# endif
+# define MAX_HEAP_SECTS 256    /* Separately added heap sections. */
+  struct HeapSect {
+      ptr_t hs_start; word hs_bytes;
+  } _heap_sects[MAX_HEAP_SECTS];
+# ifdef MSWIN32
+    ptr_t _heap_bases[MAX_HEAP_SECTS];
+               /* Start address of memory regions obtained from kernel. */
+# endif
+  /* Block header index; see gc_headers.h */
+  bottom_index _all_nils;
+  bottom_index * _top_index [TOP_SZ];
+};
+
+extern GC_FAR struct _GC_arrays GC_arrays; 
+
+# define GC_objfreelist GC_arrays._objfreelist
+# define GC_aobjfreelist GC_arrays._aobjfreelist
+# define GC_uobjfreelist GC_arrays._uobjfreelist
+# define GC_sobjfreelist GC_arrays._sobjfreelist
+# define GC_valid_offsets GC_arrays._valid_offsets
+# define GC_modws_valid_offsets GC_arrays._modws_valid_offsets
+# define GC_reclaim_list GC_arrays._reclaim_list
+# define GC_areclaim_list GC_arrays._areclaim_list
+# define GC_ureclaim_list GC_arrays._ureclaim_list
+# ifdef STUBBORN_ALLOC
+#    define GC_sreclaim_list GC_arrays._sreclaim_list
+#    define GC_changed_pages GC_arrays._changed_pages
+#    define GC_prev_changed_pages GC_arrays._prev_changed_pages
+# endif
+# define GC_obj_map GC_arrays._obj_map
+# define GC_last_heap_addr GC_arrays._last_heap_addr
+# define GC_prev_heap_addr GC_arrays._prev_heap_addr
+# define GC_words_allocd GC_arrays._words_allocd
+# define GC_words_wasted GC_arrays._words_wasted
+# define GC_non_gc_bytes_at_gc GC_arrays._non_gc_bytes_at_gc
+# define GC_mem_freed GC_arrays._mem_freed
+# define GC_heapsize GC_arrays._heapsize
+# define GC_words_allocd_before_gc GC_arrays._words_allocd_before_gc
+# define GC_heap_sects GC_arrays._heap_sects
+# ifdef MSWIN32
+#   define GC_heap_bases GC_arrays._heap_bases
+# endif
+# define GC_all_nils GC_arrays._all_nils
+# define GC_top_index GC_arrays._top_index
+# if defined(PROC_VDB) || defined(MPROTECT_VDB)
+#   define GC_grungy_pages GC_arrays._grungy_pages
+# endif
+# ifdef GATHERSTATS
+#   define GC_composite_in_use GC_arrays._composite_in_use
+#   define GC_atomic_in_use GC_arrays._atomic_in_use
+# endif
+# ifdef MERGE_SIZES
+#   define GC_size_map GC_arrays._size_map
+# endif
+
+# define beginGC_arrays ((ptr_t)(&GC_arrays))
+# define endGC_arrays (((ptr_t)(&GC_arrays)) + (sizeof GC_arrays))
+
+
+# define MAXOBJKINDS 16
+
+/* Object kinds: */
+extern struct obj_kind {
+   ptr_t *ok_freelist; /* Array of free listheaders for this kind of object */
+                       /* Point either to GC_arrays or to storage allocated */
+                       /* with GC_scratch_alloc.                            */
+   struct hblk **ok_reclaim_list;
+                       /* List headers for lists of blocks waiting to be */
+                       /* swept.                                         */
+   word ok_descriptor;  /* Descriptor template for objects in this     */
+                       /* block.                                       */
+   bool ok_relocate_descr;
+                       /* Add object size in bytes to descriptor       */
+                       /* template to obtain descriptor.  Otherwise    */
+                       /* template is used as is.                      */
+   bool ok_init;     /* Clear objects before putting them on the free list. */
+} GC_obj_kinds[MAXOBJKINDS];
+/* Predefined kinds: */
+# define PTRFREE 0
+# define NORMAL  1
+# define UNCOLLECTABLE 2
+# define STUBBORN 3
+
+extern int GC_n_kinds;
+
+extern word GC_n_heap_sects;   /* Number of separately added heap      */
+                               /* sections.                            */
+
+# ifdef MSWIN32
+extern word GC_n_heap_bases;   /* See GC_heap_bases.   */
+# endif
+
+extern char * GC_invalid_map;
+                       /* Pointer to the nowhere valid hblk map */
+                       /* Blocks pointing to this map are free. */
+
+extern struct hblk * GC_hblkfreelist;
+                               /* List of completely empty heap blocks */
+                               /* Linked through hb_next field of      */
+                               /* header structure associated with     */
+                               /* block.                               */
+
+extern bool GC_is_initialized;         /* GC_init() has been run.      */
+
+extern bool GC_objects_are_marked;     /* There are marked objects in  */
+                                       /* the heap.                    */
+
+extern int GC_incremental;  /* Using incremental/generational collection. */
+
+extern bool GC_dirty_maintained;/* Dirty bits are being maintained,    */
+                               /* either for incremental collection,   */
+                               /* or to limit the root set.            */
+
+# ifndef PCR
+    extern ptr_t GC_stackbottom;       /* Cool end of user stack       */
+# endif
+
+extern word GC_root_size;      /* Total size of registered root sections */
+
+extern bool GC_debugging_started;      /* GC_debug_malloc has been called. */ 
+
+extern ptr_t GC_least_plausible_heap_addr;
+extern ptr_t GC_greatest_plausible_heap_addr;
+                       /* Bounds on the heap.  Guaranteed valid        */
+                       /* Likely to include future heap expansion.     */
+                       
+/* Operations */
+# ifndef abs
+#   define abs(x)  ((x) < 0? (-(x)) : (x))
+# endif
+
+
+/*  Marks are in a reserved area in                          */
+/*  each heap block.  Each word has one mark bit associated  */
+/*  with it. Only those corresponding to the beginning of an */
+/*  object are used.                                         */
+
+
+/* Mark bit perations */
+
+/*
+ * Retrieve, set, clear the mark bit corresponding
+ * to the nth word in a given heap block.
+ *
+ * (Recall that bit n corresponds to object beginning at word n
+ * relative to the beginning of the block, including unused words)
+ */
+
+# define mark_bit_from_hdr(hhdr,n) (((hhdr)->hb_marks[divWORDSZ(n)] \
+                           >> (modWORDSZ(n))) & (word)1)
+# define set_mark_bit_from_hdr(hhdr,n) (hhdr)->hb_marks[divWORDSZ(n)] \
+                               |= (word)1 << modWORDSZ(n)
+
+# define clear_mark_bit_from_hdr(hhdr,n) (hhdr)->hb_marks[divWORDSZ(n)] \
+                               &= ~((word)1 << modWORDSZ(n))
+
+/* Important internal collector routines */
+
+void GC_apply_to_all_blocks(/*fn, client_data*/);
+                       /* Invoke fn(hbp, client_data) for each         */
+                       /* allocated heap block.                        */
+struct hblk * GC_next_block(/* struct hblk * h */);
+void GC_mark_init();
+void GC_clear_marks(); /* Clear mark bits for all heap objects. */
+void GC_mark_from_mark_stack(); /* Mark from everything on the mark stack. */
+                               /* Return after about one pages worth of   */
+                               /* work.                                   */
+bool GC_mark_stack_empty();
+bool GC_mark_some();   /* Perform about one pages worth of marking     */
+                       /* work of whatever kind is needed.  Returns    */
+                       /* quickly if no collection is in progress.     */
+                       /* Return TRUE if mark phase finished.          */
+void GC_initiate_full();       /* initiate full collection.            */
+void GC_initiate_partial();    /* initiate partial collection.         */                      
+void GC_push_all(/*b,t*/);     /* Push everything in a range           */
+                               /* onto mark stack.                     */
+void GC_push_dirty(/*b,t*/);      /* Push all possibly changed         */
+                                 /* subintervals of [b,t) onto         */
+                                 /* mark stack.                        */
+#ifndef SMALL_CONFIG
+  void GC_push_conditional(/* ptr_t b, ptr_t t, bool all*/);
+#else
+# define GC_push_conditional(b, t, all) GC_push_all(b, t)
+#endif
+                                /* Do either of the above, depending   */
+                               /* on the third arg.                    */
+void GC_push_all_stack(/*b,t*/);    /* As above, but consider          */
+                                   /*  interior pointers as valid      */
+void GC_push_roots(/* bool all */); /* Push all or dirty roots.        */
+extern void (*GC_push_other_roots)();
+                       /* Push system or application specific roots    */
+                       /* onto the mark stack.  In some environments   */
+                       /* (e.g. threads environments) this is          */
+                       /* predfined to be non-zero.  A client supplied */
+                       /* replacement should also call the original    */
+                       /* function.                                    */
+void GC_push_regs();   /* Push register contents onto mark stack.      */
+void GC_remark();      /* Mark from all marked objects.  Used  */
+                       /* only if we had to drop something.    */
+void GC_push_one(/*p*/);       /* If p points to an object, mark it    */
+                               /* and push contents on the mark stack  */
+void GC_push_one_checked(/*p*/); /* Ditto, omits plausibility test     */
+void GC_push_marked(/* struct hblk h, hdr * hhdr */);
+               /* Push contents of all marked objects in h onto        */
+               /* mark stack.                                          */
+#ifdef SMALL_CONFIG
+# define GC_push_next_marked_dirty(h) GC_push_next_marked(h)
+#else
+  struct hblk * GC_push_next_marked_dirty(/* h */);
+               /* Invoke GC_push_marked on next dirty block above h.   */
+               /* Return a pointer just past the end of this block.    */
+#endif /* !SMALL_CONFIG */
+struct hblk * GC_push_next_marked(/* h */);
+               /* Ditto, but also mark from clean pages.       */
+struct hblk * GC_push_next_marked_uncollectable(/* h */);
+               /* Ditto, but mark only from uncollectable pages.       */
+bool GC_stopped_mark(); /* Stop world and mark from all roots  */
+                       /* and rescuers.                        */
+void GC_clear_hdr_marks(/* hhdr */);  /* Clear the mark bits in a header */
+void GC_add_roots_inner();
+void GC_register_dynamic_libraries();
+               /* Add dynamic library data sections to the root set. */
+
+/* Machine dependent startup routines */
+ptr_t GC_get_stack_base();
+void GC_register_data_segments();
+
+/* Black listing: */
+void GC_bl_init();     
+# ifndef ALL_INTERIOR_POINTERS
+    void GC_add_to_black_list_normal(/* bits */);
+                       /* Register bits as a possible future false     */
+                       /* reference from the heap or static data       */
+#   define GC_ADD_TO_BLACK_LIST_NORMAL(bits) GC_add_to_black_list_normal(bits)
+# else
+#   define GC_ADD_TO_BLACK_LIST_NORMAL(bits) GC_add_to_black_list_stack(bits)
+# endif
+
+void GC_add_to_black_list_stack(/* bits */);
+struct hblk * GC_is_black_listed(/* h, len */);
+                       /* If there are likely to be false references   */
+                       /* to a block starting at h of the indicated    */
+                       /* length, then return the next plausible       */
+                       /* starting location for h that might avoid     */
+                       /* these false references.                      */
+void GC_promote_black_lists();
+                       /* Declare an end to a black listing phase.     */
+                       
+ptr_t GC_scratch_alloc(/*bytes*/);
+                               /* GC internal memory allocation for    */
+                               /* small objects.  Deallocation is not  */
+                               /* possible.                            */
+       
+/* Heap block layout maps: */                  
+void GC_invalidate_map(/* hdr */);
+                               /* Remove the object map associated     */
+                               /* with the block.  This identifies     */
+                               /* the block as invalid to the mark     */
+                               /* routines.                            */
+bool GC_add_map_entry(/*sz*/);
+                               /* Add a heap block map for objects of  */
+                               /* size sz to obj_map.                  */
+                               /* Return FALSE on failure.             */
+void GC_register_displacement_inner(/*offset*/);
+                               /* Version of GC_register_displacement  */
+                               /* that assumes lock is already held    */
+                               /* and signals are already disabled.    */
+
+/*  hblk allocation: */                
+void GC_new_hblk(/*size_in_words, kind*/);
+                               /* Allocate a new heap block, and build */
+                               /* a free list in it.                   */                              
+struct hblk * GC_allochblk(/*size_in_words, kind*/);
+                               /* Allocate a heap block, clear it if   */
+                               /* for composite objects, inform        */
+                               /* the marker that block is valid       */
+                               /* for objects of indicated size.       */
+                               /* sz < 0 ==> atomic.                   */ 
+void GC_freehblk();            /* Deallocate a heap block and mark it  */
+                               /* as invalid.                          */
+                               
+/*  Misc GC: */
+void GC_init_inner();
+bool GC_expand_hp_inner();
+void GC_start_reclaim(/*abort_if_found*/);
+                               /* Restore unmarked objects to free     */
+                               /* lists, or (if abort_if_found is      */
+                               /* TRUE) report them.                   */
+                               /* Sweeping of small object pages is    */
+                               /* largely deferred.                    */
+void GC_continue_reclaim(/*size, kind*/);
+                               /* Sweep pages of the given size and    */
+                               /* kind, as long as possible, and       */
+                               /* as long as the corr. free list is    */
+                               /* empty.                               */
+void GC_reclaim_or_delete_all();
+                               /* Arrange for all reclaim lists to be  */
+                               /* empty.  Judiciously choose between   */
+                               /* sweeping and discarding each page.   */
+bool GC_block_empty(/* hhdr */); /* Block completely unmarked?         */
+void GC_gcollect_inner();
+                               /* Collect; caller must have acquired   */
+                               /* lock and disabled signals.           */
+                               /* FALSE return indicates nothing was   */
+                               /* done due to insufficient allocation. */
+void GC_finish_collection();   /* Finish collection.  Mark bits are    */
+                               /* consistent and lock is still held.   */
+bool GC_collect_or_expand(/* needed_blocks */);
+                               /* Collect or expand heap in an attempt */
+                               /* make the indicated number of free    */
+                               /* blocks available.  Should be called  */
+                               /* until it fails by returning FALSE.   */
+void GC_init();                        /* Initialize collector.                */
+void GC_collect_a_little(/* n */);
+                               /* Do n units worth of garbage          */
+                               /* collection work, if appropriate.     */
+                               /* A unit is an amount appropriate for  */
+                               /* HBLKSIZE bytes of allocation.        */
+ptr_t GC_generic_malloc(/* bytes, kind */);
+                               /* Allocate an object of the given      */
+                               /* kind.  By default, there are only    */
+                               /* two kinds: composite, and atomic.    */
+                               /* We claim it's possible for clever    */
+                               /* client code that understands GC      */
+                               /* internals to add more, e.g. to       */
+                               /* communicate object layout info       */
+                               /* to the collector.                    */
+ptr_t GC_generic_malloc_inner(/* bytes, kind */);
+                               /* Ditto, but I already hold lock, etc. */
+ptr_t GC_generic_malloc_words_small(/*words, kind*/);
+                               /* As above, but size in units of words */
+                               /* Bypasses MERGE_SIZES.  Assumes       */
+                               /* words <= MAXOBJSZ.                   */
+ptr_t GC_allocobj(/* sz_inn_words, kind */);
+                               /* Make the indicated                     */
+                               /* free list nonempty, and return its   */
+                               /* head.                                */
+
+void GC_init_headers();
+bool GC_install_header(/*h*/);
+                               /* Install a header for block h.        */
+                               /* Return FALSE on failure.             */
+bool GC_install_counts(/*h, sz*/);
+                               /* Set up forwarding counts for block   */
+                               /* h of size sz.                        */
+                               /* Return FALSE on failure.             */
+void GC_remove_header(/*h*/);
+                               /* Remove the header for block h.       */
+void GC_remove_counts(/*h, sz*/);
+                               /* Remove forwarding counts for h.      */
+hdr * GC_find_header(/*p*/);   /* Debugging only.                      */
+
+void GC_finalize();    /* Perform all indicated finalization actions   */
+                       /* on unmarked objects.                         */
+                       
+void GC_add_to_heap(/*p, bytes*/);
+                       /* Add a HBLKSIZE aligned chunk to the heap.    */
+
+void GC_print_obj(/* ptr_t p */);
+                       /* P points to somewhere inside an object with  */
+                       /* debugging info.  Print a human readable      */
+                       /* description of the object to stderr.         */
+extern void (*GC_check_heap)();
+                       /* Check that all objects in the heap with      */
+                       /* debugging info are intact.  Print            */
+                       /* descriptions of any that are not.            */
+                       
+/* Virtual dirty bit implementation:           */
+/* Each implementation exports the following:  */
+void GC_read_dirty();  /* Retrieve dirty bits. */
+bool GC_page_was_dirty(/* struct hblk * h  */);
+                       /* Read retrieved dirty bits.   */
+bool GC_page_was_ever_dirty(/* struct hblk * h  */);
+                       /* Could the page contain valid heap pointers?  */
+void GC_is_fresh(/* struct hblk * h, word number_of_blocks  */);
+                       /* Assert the region currently contains no      */
+                       /* valid pointers.                              */
+void GC_write_hint(/* struct hblk * h  */);
+                       /* h is about to be written.    */
+void GC_dirty_init();
+
+/* Slow/general mark bit manipulation: */
+bool GC_is_marked();
+void GC_clear_mark_bit();
+void GC_set_mark_bit();
+
+/* Stubborn objects: */
+void GC_read_changed();        /* Analogous to GC_read_dirty */
+bool GC_page_was_changed(/* h */);     /* Analogous to GC_page_was_dirty */
+void GC_clean_changing_list(); /* Collect obsolete changing list entries */
+void GC_stubborn_init();
+
+/* Debugging print routines: */
+void GC_print_block_list();
+void GC_print_hblkfreelist();
+
+/* Make arguments appear live to compiler */
+void GC_noop();
+
+/* Logging and diagnostic output:      */
+void GC_printf(/* format, a, b, c, d, e, f */);
+                       /* A version of printf that doesn't allocate,   */
+                       /* is restricted to long arguments, and         */
+                       /* (unfortunately) doesn't use varargs for      */
+                       /* portability.  Restricted to 6 args and       */
+                       /* 1K total output length.                      */
+                       /* (We use sprintf.  Hopefully that doesn't     */
+                       /* allocate for long arguments.)                */
+# define GC_printf0(f) GC_printf(f, 0l, 0l, 0l, 0l, 0l, 0l)
+# define GC_printf1(f,a) GC_printf(f, (long)a, 0l, 0l, 0l, 0l, 0l)
+# define GC_printf2(f,a,b) GC_printf(f, (long)a, (long)b, 0l, 0l, 0l, 0l)
+# define GC_printf3(f,a,b,c) GC_printf(f, (long)a, (long)b, (long)c, 0l, 0l, 0l)
+# define GC_printf4(f,a,b,c,d) GC_printf(f, (long)a, (long)b, (long)c, \
+                                           (long)d, 0l, 0l)
+# define GC_printf5(f,a,b,c,d,e) GC_printf(f, (long)a, (long)b, (long)c, \
+                                             (long)d, (long)e, 0l)
+# define GC_printf6(f,a,b,c,d,e,g) GC_printf(f, (long)a, (long)b, (long)c, \
+                                               (long)d, (long)e, (long)g)
+
+void GC_err_printf(/* format, a, b, c, d, e, f */);
+# define GC_err_printf0(f) GC_err_puts(f)
+# define GC_err_printf1(f,a) GC_err_printf(f, (long)a, 0l, 0l, 0l, 0l, 0l)
+# define GC_err_printf2(f,a,b) GC_err_printf(f, (long)a, (long)b, 0l, 0l, 0l, 0l)
+# define GC_err_printf3(f,a,b,c) GC_err_printf(f, (long)a, (long)b, (long)c, \
+                                                 0l, 0l, 0l)
+# define GC_err_printf4(f,a,b,c,d) GC_err_printf(f, (long)a, (long)b, \
+                                                   (long)c, (long)d, 0l, 0l)
+# define GC_err_printf5(f,a,b,c,d,e) GC_err_printf(f, (long)a, (long)b, \
+                                                     (long)c, (long)d, \
+                                                     (long)e, 0l)
+# define GC_err_printf6(f,a,b,c,d,e,g) GC_err_printf(f, (long)a, (long)b, \
+                                                       (long)c, (long)d, \
+                                                       (long)e, (long)g)
+                       /* Ditto, writes to stderr.                     */
+                       
+void GC_err_puts(/* char *s */);
+                       /* Write s to stderr, don't buffer, don't add   */
+                       /* newlines, don't ...                          */
+
+# endif /* GC_PRIVATE_H */
index 1af60be..3dd7c85 100644 (file)
@@ -1,1074 +1 @@
-/* 
- * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
- * Copyright (c) 1991-1993 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.
- */
-/* Boehm, December 16, 1993 4:52 pm PST */
-
-# ifndef GC_PRIVATE_H
-# define GC_PRIVATE_H
-
-# ifndef GC_H
-#   include "gc.h"
-# endif
-
-typedef GC_word word;
-typedef GC_signed_word signed_word;
-
-# ifndef CONFIG_H
-#   include "config.h"
-# endif
-
-# ifndef HEADERS_H
-#   include "gc_headers.h"
-# endif
-
-# ifndef bool
-    typedef int bool;
-# endif
-# define TRUE 1
-# define FALSE 0
-
-typedef char * ptr_t;  /* A generic pointer to which we can add        */
-                       /* byte displacments.                           */
-                       /* Prefereably identical to caddr_t, if it      */
-                       /* exists.                                      */
-                       
-#ifdef __STDC__
-#   include <stdlib.h>
-#   if !(defined( sony_news ) )
-#       include <stddef.h>
-#   endif
-    typedef void * extern_ptr_t;
-#   define VOLATILE volatile
-#else
-    typedef char * extern_ptr_t;
-#   define VOLATILE
-#endif
-
-#ifdef AMIGA
-#   define FAR __far
-#else
-#   define FAR
-#endif
-
-/*********************************/
-/*                               */
-/* Definitions for conservative  */
-/* collector                     */
-/*                               */
-/*********************************/
-
-/*********************************/
-/*                               */
-/* Easily changeable parameters  */
-/*                               */
-/*********************************/
-
-#define STUBBORN_ALLOC /* Define stubborn allocation primitives        */
-#ifdef SRC_M3
-# undef STUBBORN_ALLOC
-#endif
-
-
-#define ALL_INTERIOR_POINTERS
-                   /* Forces all pointers into the interior of an      */
-                   /* object to be considered valid.  Also causes the  */
-                   /* sizes of all objects to be inflated by at least  */
-                   /* one byte.  This should suffice to guarantee      */
-                   /* that in the presence of a compiler that does     */
-                   /* not perform garbage-collector-unsafe             */
-                   /* optimizations, all portable, strictly ANSI       */
-                   /* conforming C programs should be safely usable    */
-                   /* with malloc replaced by GC_malloc and free       */
-                   /* calls removed.  There are several disadvantages: */
-                   /* 1. There are probably no interesting, portable,  */
-                   /*    strictly ANSI conforming C programs.          */
-                   /* 2. This option makes it hard for the collector   */
-                   /*    to allocate space that is not ``pointed to''  */
-                   /*    by integers, etc.  Under SunOS 4.X with a     */
-                   /*    statically linked libc, we empiricaly         */
-                   /*    observed that it would be difficult to        */
-                   /*    allocate individual objects larger than 100K. */
-                   /*    Even if only smaller objects are allocated,   */
-                   /*    more swap space is likely to be needed.       */
-                   /*    Fortunately, much of this will never be       */
-                   /*    touched.                                      */
-                   /* If you can easily avoid using this option, do.   */
-                   /* If not, try to keep individual objects small.    */
-#undef ALL_INTERIOR_POINTERS
-                   
-#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
-
-#define PRINTBLACKLIST         /* Print black listed blocks, i.e. values that     */
-                       /* cause the allocator to avoid allocating certain */
-                       /* blocks in order to avoid introducing "false     */
-                       /* hits".                                          */
-#undef PRINTBLACKLIST
-
-#ifdef SILENT
-#  ifdef PRINTSTATS
-#    undef PRINTSTATS
-#  endif
-#  ifdef PRINTTIMES
-#    undef PRINTTIMES
-#  endif
-#  ifdef PRINTNBLOCKS
-#    undef PRINTNBLOCKS
-#  endif
-#endif
-
-#if defined(PRINTSTATS) && !defined(GATHERSTATS)
-#   define GATHERSTATS
-#endif
-
-# if defined(PCR) || defined(SRC_M3)
-#   define THREADS
-# endif
-
-#ifdef SPARC
-#   define ALIGN_DOUBLE  /* Align objects of size > 1 word on 2 word   */
-                        /* boundaries.  Wasteful of memory, but       */
-                        /* apparently required by SPARC architecture. */
-#   define ASM_CLEAR_CODE      /* Stack clearing is crucial, and we    */
-                               /* include assembly code to do it well. */
-#endif
-
-#if defined(SPARC) || defined(M68K) && defined(SUNOS4) || defined(IRIX5)
-# if !defined(PCR)
-#   define DYNAMIC_LOADING /* Search dynamic libraries for roots.      */
-# else
-    /* PCR handles any dynamic loading whether with dlopen or otherwise */
-# endif
-#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 GC_allocobj and     */
-                   /* GC_allocaobj directly.                             */
-                   /* Slows down average programs slightly.  May however */
-                   /* substantially reduce fragmentation if allocation   */
-                   /* request sizes are widely scattered.                */
-                   /* May save significant amounts of space for obj_map  */
-                   /* entries.                                           */
-
-/* ALIGN_DOUBLE requires MERGE_SIZES at present. */
-# if defined(ALIGN_DOUBLE) && !defined(MERGE_SIZES)
-#   define MERGE_SIZES
-# endif
-
-
-# define MINHINCR 16       /* Minimum heap increment, in blocks of HBLKSIZE  */
-# define MAXHINCR 512      /* Maximum heap increment, in blocks              */
-
-# define TIME_LIMIT 50    /* We try to keep pause times from exceeding  */
-                          /* this by much. In milliseconds.             */
-
-/*********************************/
-/*                               */
-/* OS interface routines        */
-/*                               */
-/*********************************/
-
-#include <time.h>
-#if !defined(__STDC__) && defined(SPARC) && defined(SUNOS4)
-   clock_t clock();    /* Not in time.h, where it belongs      */
-#endif
-#if !defined(CLOCKS_PER_SEC)
-#   define CLOCKS_PER_SEC 1000000
-/*
- * This is technically a bug in the implementation.  ANSI requires that
- * CLOCKS_PER_SEC be defined.  But at least under SunOS4.1.1, it isn't.
- * Also note that the combination of ANSI C and POSIX is incredibly gross
- * here. The type clock_t is used by both clock() and times().  But on
- * some machines thes use different notions of a clock tick,  CLOCKS_PER_SEC
- * seems to apply only to clock.  Hence we use it here.  On many machines,
- * including SunOS, clock actually uses units of microseconds (which are
- * not really clock ticks).
- */
-#endif
-#define CLOCK_TYPE clock_t
-#define GET_TIME(x) x = clock()
-#define MS_TIME_DIFF(a,b) ((unsigned long) \
-               (1000.0*(double)((a)-(b))/(double)CLOCKS_PER_SEC))
-
-/* We use bzero and bcopy internally.  They may not be available.      */
-# if defined(SPARC) && defined(SUNOS4)
-#   define BCOPY_EXISTS
-# endif
-# if defined(M68K) && defined(AMIGA)
-#   define BCOPY_EXISTS
-# endif
-# if defined(M68K) && defined(NEXT)
-#   define BCOPY_EXISTS
-# endif
-# if defined(VAX)
-#   define BCOPY_EXISTS
-# endif
-# if defined(AMIGA)
-#   include <string.h>
-#   define BCOPY_EXISTS
-# endif
-
-# ifndef BCOPY_EXISTS
-#   include <string.h>
-#   define bcopy(x,y,n) memcpy(y,x,n)
-#   define bzero(x,n)  memset(x, 0, n)
-# endif
-
-/* HBLKSIZE aligned allocation.  0 is taken to mean failure    */
-/* space is assumed to be cleared.                             */
-# ifdef PCR
-    char * real_malloc();
-#   define GET_MEM(bytes) HBLKPTR(real_malloc((size_t)bytes + HBLKSIZE) \
-                                 + HBLKSIZE-1)
-# else
-#   ifdef OS2
-      void * os2_alloc(size_t bytes);
-#     define GET_MEM(bytes) HBLKPTR((ptr_t)os2_alloc((size_t)bytes + HBLKSIZE) \
-                                    + HBLKSIZE-1)
-#   else
-#     if defined(AMIGA) || defined(NEXT)
-#       define GET_MEM(bytes) HBLKPTR(calloc(1, (size_t)bytes + HBLKSIZE) \
-                               + HBLKSIZE-1)
-#     else
-        extern ptr_t GC_unix_get_mem();
-#       define GET_MEM(bytes) (struct hblk *)GC_unix_get_mem(bytes)
-#     endif
-#   endif
-# endif
-
-/*
- * Mutual exclusion between allocator/collector routines.
- * Needed if there is more than one allocator thread.
- * FASTLOCK() is assumed to try to acquire the lock in a cheap and
- * dirty way that is acceptable for a few instructions, e.g. by
- * inhibiting preemption.  This is assumed to have succeeded only
- * if a subsequent call to FASTLOCK_SUCCEEDED() returns TRUE.
- * FASTUNLOCK() is called whether or not FASTLOCK_SUCCEEDED().
- * If signals cannot be tolerated with the FASTLOCK held, then
- * FASTLOCK should disable signals.  The code executed under
- * FASTLOCK is otherwise immune to interruption, provided it is
- * not restarted.
- * DCL_LOCK_STATE declares any local variables needed by LOCK and UNLOCK
- * and/or DISABLE_SIGNALS and ENABLE_SIGNALS and/or FASTLOCK.
- * (There is currently no equivalent for FASTLOCK.)
- */  
-# ifdef THREADS
-#  ifdef PCR
-#    include  "th/PCR_Th.h"
-#    include  "th/PCR_ThCrSec.h"
-     extern struct PCR_Th_MLRep GC_allocate_ml;
-#    define DCL_LOCK_STATE  PCR_sigset_t GC_old_sig_mask
-#    define LOCK() PCR_Th_ML_Acquire(&GC_allocate_ml) 
-#    define UNLOCK() PCR_Th_ML_Release(&GC_allocate_ml)
-#    define FASTLOCK() PCR_ThCrSec_EnterSys()
-     /* Here we cheat (a lot): */
-#        define FASTLOCK_SUCCEEDED() (*(int *)(&GC_allocate_ml) == 0)
-               /* TRUE if nobody currently holds the lock */
-#    define FASTUNLOCK() PCR_ThCrSec_ExitSys()
-#  endif
-#  ifdef SRC_M3
-     extern word RT0u__inCritical;
-#    define LOCK() RT0u__inCritical++
-#    define UNLOCK() RT0u__inCritical--
-#  endif
-# else
-#    define LOCK()
-#    define UNLOCK()
-
-# endif
-
-# ifndef DCL_LOCK_STATE
-#   define DCL_LOCK_STATE
-# endif
-# ifndef FASTLOCK
-#   define FASTLOCK() LOCK()
-#   define FASTLOCK_SUCCEEDED() TRUE
-#   define FASTUNLOCK() UNLOCK()
-# endif
-
-/* Delay any interrupts or signals that may abort this thread.  Data   */
-/* structures are in a consistent state outside this pair of calls.    */
-/* ANSI C allows both to be empty (though the standard isn't very      */
-/* clear on that point).  Standard malloc implementations are usually  */
-/* neither interruptable nor thread-safe, and thus correspond to       */
-/* empty definitions.                                                  */
-# ifdef PCR
-#   define DISABLE_SIGNALS() \
-                PCR_Th_SetSigMask(PCR_allSigsBlocked,&GC_old_sig_mask)
-#   define ENABLE_SIGNALS() \
-               PCR_Th_SetSigMask(&GC_old_sig_mask, NIL)
-# else
-#   if defined(SRC_M3) || defined(AMIGA)
-                       /* Also useful for debugging, and unusually     */
-                       /* correct client code.                         */
-#     define DISABLE_SIGNALS()
-#     define ENABLE_SIGNALS()
-#   else
-#     define DISABLE_SIGNALS() GC_disable_signals()
-       void GC_disable_signals();
-#     define ENABLE_SIGNALS() GC_enable_signals()
-       void GC_enable_signals();
-#   endif
-# endif
-
-/*
- * Stop and restart mutator threads.
- */
-# ifdef PCR
-#     include "th/PCR_ThCtl.h"
-#     define STOP_WORLD() \
-       PCR_ThCtl_SetExclusiveMode(PCR_ThCtl_ExclusiveMode_stopNormal, \
-                                  PCR_allSigsBlocked, \
-                                  PCR_waitForever)
-#     define START_WORLD() \
-       PCR_ThCtl_SetExclusiveMode(PCR_ThCtl_ExclusiveMode_null, \
-                                  PCR_allSigsBlocked, \
-                                  PCR_waitForever);
-# else
-#     define STOP_WORLD()
-#     define START_WORLD()
-# endif
-
-/* Abandon ship */
-# ifdef PCR
-    void PCR_Base_Panic(const char *fmt, ...);
-#   define ABORT(s) PCR_Base_Panic(s)
-# else
-#   define ABORT(msg) { GC_err_printf1("%s\n", msg); (void) abort(); }
-# endif
-
-/* Exit abnormally, but without making a mess (e.g. out of memory) */
-# ifdef PCR
-    void PCR_Base_Exit(int status);
-#   define EXIT() PCR_Base_Exit(1)
-# else
-#   define EXIT() (void)exit(1)
-# endif
-
-/* Print warning message, e.g. almost out of memory.   */
-# define WARN(s) GC_printf0(s)
-
-/*********************************/
-/*                               */
-/* Word-size-dependent defines   */
-/*                               */
-/*********************************/
-
-#if CPP_WORDSZ == 32
-#  define WORDS_TO_BYTES(x)   ((x)<<2)
-#  define BYTES_TO_WORDS(x)   ((x)>>2)
-#  define LOGWL               ((word)5)    /* log[2] of CPP_WORDSZ */
-#  define modWORDSZ(n) ((n) & 0x1f)          /* n mod size of word         */
-#endif
-
-#if CPP_WORDSZ == 64
-#  define WORDS_TO_BYTES(x)   ((x)<<3)
-#  define BYTES_TO_WORDS(x)   ((x)>>3)
-#  define LOGWL               ((word)6)    /* log[2] of CPP_WORDSZ */
-#  define modWORDSZ(n) ((n) & 0x3f)          /* n mod size of word         */
-#endif
-
-#define WORDSZ ((word)CPP_WORDSZ)
-#define SIGNB  ((word)1 << (WORDSZ-1))
-#define BYTES_PER_WORD      ((word)(sizeof (word)))
-#define ONES                ((word)(-1))
-#define divWORDSZ(n) ((n) >> LOGWL)       /* divide n by size of word      */
-
-/*********************/
-/*                   */
-/*  Size Parameters  */
-/*                   */
-/*********************/
-
-/*  heap block size, bytes. Should be power of 2 */
-
-#if CPP_WORDSZ == 32
-#   define CPP_LOG_HBLKSIZE 12
-#else
-#   define CPP_LOG_HBLKSIZE 13
-#endif
-#define LOG_HBLKSIZE   ((word)CPP_LOG_HBLKSIZE)
-#define CPP_HBLKSIZE (1 << CPP_LOG_HBLKSIZE)
-#define HBLKSIZE ((word)CPP_HBLKSIZE)
-
-
-/*  max size objects supported by freelist (larger objects may be   */
-/*  allocated, but less efficiently)                                */
-
-#define CPP_MAXOBJSZ    BYTES_TO_WORDS(CPP_HBLKSIZE/2)
-#define MAXOBJSZ ((word)CPP_MAXOBJSZ)
-               
-# define divHBLKSZ(n) ((n) >> LOG_HBLKSIZE)
-
-# define HBLK_PTR_DIFF(p,q) divHBLKSZ((ptr_t)p - (ptr_t)q)
-       /* Equivalent to subtracting 2 hblk pointers.   */
-       /* We do it this way because a compiler should  */
-       /* find it hard to use an integer division      */
-       /* instead of a shift.  The bundled SunOS 4.1   */
-       /* o.w. sometimes pessimizes the subtraction to */
-       /* involve a call to .div.                      */
-# define modHBLKSZ(n) ((n) & (HBLKSIZE-1))
-# define HBLKPTR(objptr) ((struct hblk *)(((word) (objptr)) & ~(HBLKSIZE-1)))
-
-# define HBLKDISPL(objptr) (((word) (objptr)) & (HBLKSIZE-1))
-
-/* Round up byte allocation requests to integral number of words: */
-# ifdef ALL_INTERIOR_POINTERS
-#   define ROUNDED_UP_WORDS(n) BYTES_TO_WORDS((n) + WORDS_TO_BYTES(1))
-# else
-#   define ROUNDED_UP_WORDS(n) BYTES_TO_WORDS((n) + WORDS_TO_BYTES(1) - 1)
-# endif
-
-
-/*
- * Hash table representation of sets of pages.  This assumes it is
- * OK to add spurious entries to sets.
- * Used by black-listing code, and perhaps by dirty bit maintenance code.
- */
-# define LOG_PHT_ENTRIES  14   /* Collisions are likely if heap grows  */
-                               /* to more than 16K hblks = 64MB.       */
-                               /* Each hash table occupies 2K bytes.   */
-# define PHT_ENTRIES ((word)1 << LOG_PHT_ENTRIES)
-# define PHT_SIZE (PHT_ENTRIES >> LOGWL)
-typedef word page_hash_table[PHT_SIZE];
-
-# define PHT_HASH(addr) ((((word)(addr)) >> LOG_HBLKSIZE) & (PHT_ENTRIES - 1))
-
-# define get_pht_entry_from_index(bl, index) \
-               (((bl)[divWORDSZ(index)] >> modWORDSZ(index)) & 1)
-# define set_pht_entry_from_index(bl, index) \
-               (bl)[divWORDSZ(index)] |= (word)1 << modWORDSZ(index)
-# define clear_pht_entry_from_index(bl, index) \
-               (bl)[divWORDSZ(index)] &= ~((word)1 << modWORDSZ(index))
-       
-
-
-/********************************************/
-/*                                          */
-/*    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/CPP_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*CPP_WORDSZ - 1) \
-                         / (2*CPP_WORDSZ))*2)
-# else
-#   define MARK_BITS_SZ ((MARK_BITS_PER_HBLK + CPP_WORDSZ - 1)/CPP_WORDSZ)
-# endif
-          /* Upper bound on number of mark words per heap block  */
-          
-/* Mark stack entries. */
-typedef struct ms_entry {
-    word * mse_start;  /* inclusive */
-    word * mse_end;    /* exclusive */
-} mse;
-
-typedef mse * (*mark_proc)(/* word * addr, hdr * hhdr, mse * msp, mse * msl */);
-         /* Procedure to arrange for the descendents of the object at  */
-         /* addr to be marked.  Msp points at the top entry on the     */
-         /* mark stack.  Msl delimits the hot end of the mark stack.   */
-         /* hhdr is the hdr structure corresponding to addr.           */
-         /* Returns the new mark stack pointer.                        */
-
-struct hblkhdr {
-    word hb_sz;  /* If in use, size in words, of objects in the block. */
-                /* if free, the size in bytes of the whole block      */
-    struct hblk * hb_next;     /* Link field for hblk free list         */
-                               /* and for lists of chunks waiting to be */
-                               /* reclaimed.                            */
-    mark_proc hb_mark_proc;   /* Procedure to mark objects.  Can        */
-                               /* also be retrived through obj_kind.    */
-                               /* But one level of indirection matters  */
-                               /* here.                                 */
-    char* hb_map;      /* A pointer to a pointer validity map of the block. */
-                       /* See GC_obj_map.                                   */
-                       /* Valid for all blocks with headers.                */
-                       /* Free blocks point to GC_invalid_map.              */
-    unsigned short hb_obj_kind;
-                        /* Kind of objects in the block.  Each kind    */
-                        /* identifies a mark procedure and a set of    */
-                        /* list headers.  sometimes called regions.    */
-    unsigned short hb_last_reclaimed;
-                               /* Value of GC_gc_no when block was     */
-                               /* last allocated or swept. May wrap.   */
-    word hb_marks[MARK_BITS_SZ];
-                           /* Bit i in the array refers to the             */
-                           /* object starting at the ith word (header      */
-                           /* INCLUDED) in the heap block.                 */
-                           /* The lsb of word 0 is numbered 0.             */
-};
-
-/*  heap block body */
-
-# define DISCARD_WORDS 0
-       /* Number of words to be dropped at the beginning of each block */
-       /* Must be a multiple of WORDSZ.  May reasonably be nonzero     */
-       /* on machines that don't guarantee longword alignment of       */
-       /* pointers, so that the number of false hits is minimized.     */
-       /* 0 and WORDSZ are probably the only reasonable values.        */
-
-# define BODY_SZ ((HBLKSIZE-WORDS_TO_BYTES(DISCARD_WORDS))/sizeof(word))
-
-struct hblk {
-#   if (DISCARD_WORDS != 0)
-        word garbage[DISCARD_WORDS];
-#   endif
-    word hb_body[BODY_SZ];
-};
-
-# define HDR_WORDS ((word)DISCARD_WORDS)
-# define HDR_BYTES ((word)WORDS_TO_BYTES(DISCARD_WORDS))
-
-# define OBJ_SZ_TO_BLOCKS(sz) \
-    divHBLKSZ(HDR_BYTES + WORDS_TO_BYTES(sz) + HBLKSIZE-1)
-    /* Size of block (in units of HBLKSIZE) needed to hold objects of  */
-    /* given sz (in words).                                            */
-
-/* Object free list link */
-# define obj_link(p) (*(ptr_t *)(p))
-
-/*  lists of all heap blocks and free lists    */
-/* These are grouped together in a struct      */
-/* so that they can be easily skipped by the   */
-/* GC_mark routine.                            */
-/* The ordering is weird to make GC_malloc     */
-/* faster by keeping the important fields      */
-/* sufficiently close together that a          */
-/* single load of a base register will do.     */
-/* Scalars that could easily appear to         */
-/* be pointers are also put here.              */
-
-struct _GC_arrays {
-  word _heapsize;
-  ptr_t _last_heap_addr;
-  ptr_t _prev_heap_addr;
-  word _words_allocd_before_gc;
-               /* Number of words allocated before this        */
-               /* collection cycle.                            */
-# ifdef GATHERSTATS
-    word _composite_in_use;
-               /* Number of words in accessible composite      */
-               /* objects.                                     */
-    word _atomic_in_use;
-               /* Number of words in accessible atomic         */
-               /* objects.                                     */
-# endif
-  word _words_allocd;
-       /* Number of words allocated during this collection cycle */
-  word _words_wasted;
-       /* Number of words wasted due to internal fragmentation  */
-       /* in large objects allocated since last gc. Approximate.*/
-  word _non_gc_bytes_at_gc;
-       /* Number of explicitly managed bytes of storage        */
-       /* at last collection.                                  */
-  word _mem_freed;
-       /* Number of explicitly deallocated words of memory     */
-       /* since last collection.                               */
-       
-  ptr_t _objfreelist[MAXOBJSZ+1];
-                         /* free list for objects */
-# ifdef MERGE_SIZES
-    unsigned _size_map[WORDS_TO_BYTES(MAXOBJSZ+1)];
-       /* Number of words to allocate for a given allocation request in */
-       /* bytes.                                                        */
-# endif 
-  ptr_t _aobjfreelist[MAXOBJSZ+1];
-                         /* free list for atomic objs  */
-
-  ptr_t _uobjfreelist[MAXOBJSZ+1];
-                         /* uncollectable but traced objs      */
-
-# ifdef STUBBORN_ALLOC
-    ptr_t _sobjfreelist[MAXOBJSZ+1];
-# endif
-                         /* free list for immutable objects    */
-  ptr_t _obj_map[MAXOBJSZ+1];
-                       /* If not NIL, then a pointer to a map of valid  */
-                      /* object addresses. hbh_map[sz][i] is j if the  */
-                      /* address block_start+i is a valid pointer      */
-                      /* to an object at                               */
-                      /* block_start+i&~3 - WORDS_TO_BYTES(j).         */
-                      /* (If ALL_INTERIOR_POINTERS is defined, then    */
-                      /* instead ((short *)(hbh_map[sz])[i] is j if    */
-                      /* block_start+WORDS_TO_BYTES(i) is in the       */
-                      /* interior of an object starting at             */
-                      /* block_start+WORDS_TO_BYTES(i-j)).             */
-                      /* It is OBJ_INVALID if                          */
-                      /* block_start+WORDS_TO_BYTES(i) is not          */
-                      /* valid as a pointer to an object.              */
-                      /* We assume that all values of j <= OBJ_INVALID */
-                      /* The zeroth entry corresponds to large objects.*/
-#   ifdef ALL_INTERIOR_POINTERS
-#      define map_entry_type short
-#       define OBJ_INVALID 0x7fff
-#      define MAP_ENTRY(map, bytes) \
-               (((map_entry_type *)(map))[BYTES_TO_WORDS(bytes)])
-#      define MAP_ENTRIES BYTES_TO_WORDS(HBLKSIZE)
-#      define MAP_SIZE (MAP_ENTRIES * sizeof(map_entry_type))
-#      define OFFSET_VALID(displ) TRUE
-#      define CPP_MAX_OFFSET (HBLKSIZE - HDR_BYTES - 1)
-#      define MAX_OFFSET ((word)CPP_MAX_OFFSET)
-#   else
-#      define map_entry_type char
-#       define OBJ_INVALID 0x7f
-#      define MAP_ENTRY(map, bytes) \
-               (map)[bytes]
-#      define MAP_ENTRIES HBLKSIZE
-#      define MAP_SIZE MAP_ENTRIES
-#      define CPP_MAX_OFFSET (WORDS_TO_BYTES(OBJ_INVALID) - 1) 
-#      define MAX_OFFSET ((word)CPP_MAX_OFFSET)
-#      define VALID_OFFSET_SZ \
-         (CPP_MAX_OFFSET > WORDS_TO_BYTES(CPP_MAXOBJSZ)? \
-          CPP_MAX_OFFSET+1 \
-          : WORDS_TO_BYTES(CPP_MAXOBJSZ)+1)
-       char _valid_offsets[VALID_OFFSET_SZ];
-                               /* GC_valid_offsets[i] == TRUE ==> i    */
-                               /* is registered as a displacement.     */
-#      define OFFSET_VALID(displ) GC_valid_offsets[displ]
-       char _modws_valid_offsets[sizeof(word)];
-                               /* GC_valid_offsets[i] ==>                */
-                               /* GC_modws_valid_offsets[i%sizeof(word)] */
-#   endif
-  struct hblk * _reclaim_list[MAXOBJSZ+1];
-  struct hblk * _areclaim_list[MAXOBJSZ+1];
-  struct hblk * _ureclaim_list[MAXOBJSZ+1];
-# ifdef STUBBORN_ALLOC
-      struct hblk * _sreclaim_list[MAXOBJSZ+1];
-      page_hash_table _changed_pages;
-        /* Stubborn object pages that were changes since last call to  */
-       /* GC_read_changed.                                             */
-      page_hash_table _prev_changed_pages;
-        /* Stubborn object pages that were changes before last call to */
-       /* GC_read_changed.                                             */
-# endif
-# if defined(PROC_VDB) || defined(MPROTECT_VDB)
-      page_hash_table _grungy_pages; /* Pages that were dirty at last     */
-                                    /* GC_read_dirty.                     */
-# endif
-# define MAX_HEAP_SECTS 256    /* Separately added heap sections. */
-  struct HeapSect {
-      ptr_t hs_start; word hs_bytes;
-  } _heap_sects[MAX_HEAP_SECTS];
-  /* Block header index; see gc_headers.h */
-  bottom_index _all_nils;
-  bottom_index * _top_index [TOP_SZ];
-};
-
-extern FAR struct _GC_arrays GC_arrays; 
-
-# define GC_objfreelist GC_arrays._objfreelist
-# define GC_aobjfreelist GC_arrays._aobjfreelist
-# define GC_uobjfreelist GC_arrays._uobjfreelist
-# define GC_sobjfreelist GC_arrays._sobjfreelist
-# define GC_valid_offsets GC_arrays._valid_offsets
-# define GC_modws_valid_offsets GC_arrays._modws_valid_offsets
-# define GC_reclaim_list GC_arrays._reclaim_list
-# define GC_areclaim_list GC_arrays._areclaim_list
-# define GC_ureclaim_list GC_arrays._ureclaim_list
-# ifdef STUBBORN_ALLOC
-#    define GC_sreclaim_list GC_arrays._sreclaim_list
-#    define GC_changed_pages GC_arrays._changed_pages
-#    define GC_prev_changed_pages GC_arrays._prev_changed_pages
-# endif
-# define GC_obj_map GC_arrays._obj_map
-# define GC_last_heap_addr GC_arrays._last_heap_addr
-# define GC_prev_heap_addr GC_arrays._prev_heap_addr
-# define GC_words_allocd GC_arrays._words_allocd
-# define GC_words_wasted GC_arrays._words_wasted
-# define GC_non_gc_bytes_at_gc GC_arrays._non_gc_bytes_at_gc
-# define GC_mem_freed GC_arrays._mem_freed
-# define GC_heapsize GC_arrays._heapsize
-# define GC_words_allocd_before_gc GC_arrays._words_allocd_before_gc
-# define GC_heap_sects GC_arrays._heap_sects
-# define GC_all_nils GC_arrays._all_nils
-# define GC_top_index GC_arrays._top_index
-# if defined(PROC_VDB) || defined(MPROTECT_VDB)
-#   define GC_grungy_pages GC_arrays._grungy_pages
-# endif
-# ifdef GATHERSTATS
-#   define GC_composite_in_use GC_arrays._composite_in_use
-#   define GC_atomic_in_use GC_arrays._atomic_in_use
-# endif
-# ifdef MERGE_SIZES
-#   define GC_size_map GC_arrays._size_map
-# endif
-
-# define beginGC_arrays ((ptr_t)(&GC_arrays))
-# define endGC_arrays (((ptr_t)(&GC_arrays)) + (sizeof GC_arrays))
-
-
-# define MAXOBJKINDS 16
-
-/* Object kinds: */
-extern struct obj_kind {
-   ptr_t *ok_freelist; /* Array of free listheaders for this kind of object */
-                       /* Point either to GC_arrays or to storage allocated */
-                       /* with GC_scratch_alloc.                            */
-   struct hblk **ok_reclaim_list;
-                       /* List headers for lists of blocks waiting to be */
-                       /* swept.                                         */
-   mark_proc ok_mark_proc; /* Procedure to either mark referenced objects,  */
-                          /* or push them on the mark stack.               */
-   bool ok_init;     /* Clear objects before putting them on the free list. */
-} GC_obj_kinds[MAXOBJKINDS];
-/* Predefined kinds: */
-# define PTRFREE 0
-# define NORMAL  1
-# define UNCOLLECTABLE 2
-# define STUBBORN 3
-
-extern word GC_n_heap_sects;   /* Number of separately added heap      */
-                               /* sections.                            */
-
-extern int GC_n_kinds;
-
-extern char * GC_invalid_map;
-                       /* Pointer to the nowhere valid hblk map */
-                       /* Blocks pointing to this map are free. */
-
-extern struct hblk * GC_hblkfreelist;
-                               /* List of completely empty heap blocks */
-                               /* Linked through hb_next field of      */
-                               /* header structure associated with     */
-                               /* block.                               */
-
-extern bool GC_is_initialized;         /* GC_init() has been run.      */
-
-extern bool GC_objects_are_marked;     /* There are marked objects in  */
-                                       /* the heap.                    */
-
-# ifndef PCR
-    extern ptr_t GC_stackbottom;       /* Cool end of user stack       */
-# endif
-
-extern word GC_root_size;      /* Total size of registered root sections */
-
-extern bool GC_debugging_started;      /* GC_debug_malloc has been called. */ 
-
-extern ptr_t GC_least_plausible_heap_addr;
-extern ptr_t GC_greatest_plausible_heap_addr;
-                       /* Bounds on the heap.  Guaranteed valid        */
-                       /* Likely to include future heap expansion.     */
-                       
-/* Operations */
-# ifndef abs
-#   define abs(x)  ((x) < 0? (-(x)) : (x))
-# endif
-
-
-/*  Marks are in a reserved area in                          */
-/*  each heap block.  Each word has one mark bit associated  */
-/*  with it. Only those corresponding to the beginning of an */
-/*  object are used.                                         */
-
-
-/* Mark bit perations */
-
-/*
- * Retrieve, set, clear the mark bit corresponding
- * to the nth word in a given heap block.
- *
- * (Recall that bit n corresponds to object beginning at word n
- * relative to the beginning of the block, including unused words)
- */
-
-# define mark_bit_from_hdr(hhdr,n) (((hhdr)->hb_marks[divWORDSZ(n)] \
-                           >> (modWORDSZ(n))) & (word)1)
-# define set_mark_bit_from_hdr(hhdr,n) (hhdr)->hb_marks[divWORDSZ(n)] \
-                               |= (word)1 << modWORDSZ(n)
-
-# define clear_mark_bit_from_hdr(hhdr,n) (hhdr)->hb_marks[divWORDSZ(n)] \
-                               &= ~((word)1 << modWORDSZ(n))
-
-/* Important internal collector routines */
-
-void GC_apply_to_all_blocks(/*fn, client_data*/);
-                       /* Invoke fn(hbp, client_data) for each         */
-                       /* allocated heap block.                        */
-struct hblk * GC_next_block(/* struct hblk * h */);
-mse * GC_no_mark_proc(/*addr,hhdr,msp,msl*/);
-                       /* Mark procedure for PTRFREE objects.  */
-mse * GC_normal_mark_proc(/*addr,hhdr,msp,msl*/);
-                       /* Mark procedure for NORMAL objects.   */
-void GC_mark_init();
-void GC_clear_marks(); /* Clear mark bits for all heap objects. */
-void GC_mark_from_mark_stack(); /* Mark from everything on the mark stack. */
-                               /* Return after about one pages worth of   */
-                               /* work.                                   */
-bool GC_mark_stack_empty();
-bool GC_mark_some();   /* Perform about one pages worth of marking     */
-                       /* work of whatever kind is needed.  Returns    */
-                       /* quickly if no collection is in progress.     */
-                       /* Return TRUE if mark phase finished.          */
-void GC_initiate_full();       /* initiate full collection.            */
-void GC_initiate_partial();    /* initiate partial collection.         */                      
-void GC_push_all(/*b,t*/);     /* Push everything in a range           */
-                               /* onto mark stack.                     */
-void GC_push_dirty(/*b,t*/);      /* Push all possibly changed         */
-                                 /* subintervals of [b,t) onto         */
-                                 /* mark stack.                        */
-void GC_push_conditional(/* ptr_t b, ptr_t t, bool all*/);
-                                /* Do either of the above, depending   */
-                               /* on the third arg.                    */
-void GC_push_all_stack(/*b,t*/);    /* As above, but consider          */
-                                   /*  interior pointers as valid      */
-void GC_push_roots(/* bool all */); /* Push all or dirty roots.        */
-void GC_push_regs();   /* Push register contents onto mark stack.      */
-void GC_remark();      /* Mark from all marked objects.  Used  */
-                       /* only if we had to drop something.    */
-void GC_push_one(/*p*/);       /* If p points to an object, mark it    */
-                               /* and push contents on the mark stack  */
-void GC_push_one_checked(/*p*/); /* Ditto, omits plausibility test     */
-void GC_push_marked(/* struct hblk h, hdr * hhdr */);
-               /* Push contents of all marked objects in h onto        */
-               /* mark stack.                                          */
-struct hblk * GC_push_next_marked_dirty(/* h */);
-               /* Invoke GC_push_marked on next dirty block above h.   */
-               /* Return a pointer just past the end of this block.    */
-struct hblk * GC_push_next_marked(/* h */);
-               /* Ditto, but also mark from clean pages.       */
-struct hblk * GC_push_next_marked_uncollectable(/* h */);
-               /* Ditto, but mark only from uncollectable pages.       */
-bool GC_stopped_mark(); /* Stop world and mark from all roots  */
-                       /* and rescuers.                        */
-void GC_clear_hdr_marks(/* hhdr */);  /* Clear the mark bits in a header */
-void GC_add_roots_inner();
-void GC_register_dynamic_libraries();
-               /* Add dynamic library data sections to the root set. */
-
-/* Machine dependent startup routines */
-ptr_t GC_get_stack_base();
-void GC_register_data_segments();
-                       
-# ifndef ALL_INTERIOR_POINTERS
-    void GC_add_to_black_list_normal(/* bits */);
-                       /* Register bits as a possible future false     */
-                       /* reference from the heap or static data       */
-#   define GC_ADD_TO_BLACK_LIST_NORMAL(bits) GC_add_to_black_list_normal(bits)
-# else
-#   define GC_ADD_TO_BLACK_LIST_NORMAL(bits) GC_add_to_black_list_stack(bits)
-# endif
-
-void GC_add_to_black_list_stack(/* bits */);
-struct hblk * GC_is_black_listed(/* h, len */);
-                       /* If there are likely to be false references   */
-                       /* to a block starting at h of the indicated    */
-                       /* length, then return the next plausible       */
-                       /* starting location for h that might avoid     */
-                       /* these false references.                      */
-void GC_promote_black_lists();
-                       /* Declare an end to a black listing phase.     */
-                       
-ptr_t GC_scratch_alloc(/*bytes*/);
-                               /* GC internal memory allocation for    */
-                               /* small objects.  Deallocation is not  */
-                               /* possible.                            */
-                               
-void GC_invalidate_map(/* hdr */);
-                               /* Remove the object map associated     */
-                               /* with the block.  This identifies     */
-                               /* the block as invalid to the mark     */
-                               /* routines.                            */
-bool GC_add_map_entry(/*sz*/);
-                               /* Add a heap block map for objects of  */
-                               /* size sz to obj_map.                  */
-                               /* Return FALSE on failure.             */
-void GC_register_displacement_inner(/*offset*/);
-                               /* Version of GC_register_displacement  */
-                               /* that assumes lock is already held    */
-                               /* and signals are already disabled.    */
-                               
-void GC_init_inner();
-                               
-void GC_new_hblk(/*size_in_words, kind*/);
-                               /* Allocate a new heap block, and build */
-                               /* a free list in it.                   */                              
-struct hblk * GC_allochblk(/*size_in_words, kind*/);
-                               /* Allocate a heap block, clear it if   */
-                               /* for composite objects, inform        */
-                               /* the marker that block is valid       */
-                               /* for objects of indicated size.       */
-                               /* sz < 0 ==> atomic.                   */ 
-void GC_freehblk();            /* Deallocate a heap block and mark it  */
-                               /* as invalid.                          */
-                               
-void GC_start_reclaim(/*abort_if_found*/);
-                               /* Restore unmarked objects to free     */
-                               /* lists, or (if abort_if_found is      */
-                               /* TRUE) report them.                   */
-                               /* Sweeping of small object pages is    */
-                               /* largely deferred.                    */
-void GC_continue_reclaim(/*size, kind*/);
-                               /* Sweep pages of the given size and    */
-                               /* kind, as long as possible, and       */
-                               /* as long as the corr. free list is    */
-                               /* empty.                               */
-void GC_reclaim_or_delete_all();
-                               /* Arrange for all reclaim lists to be  */
-                               /* empty.  Judiciously choose between   */
-                               /* sweeping and discarding each page.   */
-bool GC_block_empty(/* hhdr */); /* Block completely unmarked?         */
-void GC_gcollect_inner();
-                               /* Collect; caller must have acquired   */
-                               /* lock and disabled signals.           */
-                               /* FALSE return indicates nothing was   */
-                               /* done due to insufficient allocation. */
-void GC_finish_collection();   /* Finish collection.  Mark bits are    */
-                               /* consistent and lock is still held.   */
-bool GC_collect_or_expand(/* needed_blocks */);
-                               /* Collect or expand heap in an attempt */
-                               /* make the indicated number of free    */
-                               /* blocks available.  Should be called  */
-                               /* until it fails by returning FALSE.   */
-void GC_init();                        /* Initialize collector.                */
-void GC_collect_a_little(/* n */);
-                               /* Do n units worth of garbage          */
-                               /* collection work, if appropriate.     */
-                               /* A unit is an amount appropriate for  */
-                               /* HBLKSIZE bytes of allocation.        */
-ptr_t GC_generic_malloc(/* bytes, kind */);
-                               /* Allocate an object of the given      */
-                               /* kind.  By default, there are only    */
-                               /* two kinds: composite, and atomic.    */
-                               /* We claim it's possible for clever    */
-                               /* client code that understands GC      */
-                               /* internals to add more, e.g. to       */
-                               /* communicate object layout info       */
-                               /* to the collector.                    */
-ptr_t GC_generic_malloc_inner(/* bytes, kind */);
-                               /* Ditto, but I already hold lock, etc. */
-ptr_t GC_generic_malloc_words_small(/*words, kind*/);
-                               /* As above, but size in units of words */
-                               /* Bypasses MERGE_SIZES.  Assumes       */
-                               /* words <= MAXOBJSZ.                   */
-ptr_t GC_allocobj(/* sz_inn_words, kind */);
-                               /* Make the indicated                     */
-                               /* free list nonempty, and return its   */
-                               /* head.                                */
-                               
-bool GC_install_header(/*h*/);
-                               /* Install a header for block h.        */
-                               /* Return FALSE on failure.             */
-bool GC_install_counts(/*h, sz*/);
-                               /* Set up forwarding counts for block   */
-                               /* h of size sz.                        */
-                               /* Return FALSE on failure.             */
-void GC_remove_header(/*h*/);
-                               /* Remove the header for block h.       */
-void GC_remove_counts(/*h, sz*/);
-                               /* Remove forwarding counts for h.      */
-hdr * GC_find_header(/*p*/);   /* Debugging only.                      */
-
-void GC_finalize();    /* Perform all indicated finalization actions   */
-                       /* on unmarked objects.                         */
-                       
-void GC_add_to_heap(/*p, bytes*/);
-                       /* Add a HBLKSIZE aligned chunk to the heap.    */
-
-void GC_print_obj(/* ptr_t p */);
-                       /* P points to somewhere inside an object with  */
-                       /* debugging info.  Print a human readable      */
-                       /* description of the object to stderr.         */
-extern void (*GC_check_heap)();
-                       /* Check that all objects in the heap with      */
-                       /* debugging info are intact.  Print            */
-                       /* descriptions of any that are not.            */
-                       
-/* Virtual dirty bit implementation:           */
-/* Each implementation exports the following:  */
-void GC_read_dirty();  /* Retrueve dirty bits. */
-bool GC_page_was_dirty(/* struct hblk * h  */);
-                       /* Read retrieved dirty bits.   */
-void GC_write_hint(/* struct hblk * h  */);
-                       /* h is about to be written.    */
-void GC_dirty_init();
-
-/* Slow/general mark bit manipulation: */
-bool GC_is_marked();
-void GC_clear_mark_bit();
-void GC_set_mark_bit();
-
-/* Stubborn objects: */
-void GC_read_changed();        /* Analogous to GC_read_dirty */
-bool GC_page_was_changed(/* h */);     /* Analogous to GC_page_was_dirty */
-void GC_clean_changing_list(); /* Collect obsolete changing list entries */
-void GC_stubborn_init();
-
-/* Debugging print routines: */
-void GC_print_block_list();
-void GC_print_hblkfreelist();
-
-/* Logging and diagnostic output:      */
-void GC_printf(/* format, a, b, c, d, e, f */);
-                       /* A version of printf that doesn't allocate,   */
-                       /* is restricted to long arguments, and         */
-                       /* (unfortunately) doesn't use varargs for      */
-                       /* portability.  Restricted to 6 args and       */
-                       /* 1K total output length.                      */
-                       /* (We use sprintf.  Hopefully that doesn't     */
-                       /* allocate for long arguments.)                */
-# define GC_printf0(f) GC_printf(f, 0l, 0l, 0l, 0l, 0l, 0l)
-# define GC_printf1(f,a) GC_printf(f, (long)a, 0l, 0l, 0l, 0l, 0l)
-# define GC_printf2(f,a,b) GC_printf(f, (long)a, (long)b, 0l, 0l, 0l, 0l)
-# define GC_printf3(f,a,b,c) GC_printf(f, (long)a, (long)b, (long)c, 0l, 0l, 0l)
-# define GC_printf4(f,a,b,c,d) GC_printf(f, (long)a, (long)b, (long)c, \
-                                           (long)d, 0l, 0l)
-# define GC_printf5(f,a,b,c,d,e) GC_printf(f, (long)a, (long)b, (long)c, \
-                                             (long)d, (long)e, 0l)
-# define GC_printf6(f,a,b,c,d,e,g) GC_printf(f, (long)a, (long)b, (long)c, \
-                                               (long)d, (long)e, (long)g)
-
-void GC_err_printf(/* format, a, b, c, d, e, f */);
-# define GC_err_printf0(f) GC_err_puts(f)
-# define GC_err_printf1(f,a) GC_err_printf(f, (long)a, 0l, 0l, 0l, 0l, 0l)
-# define GC_err_printf2(f,a,b) GC_err_printf(f, (long)a, (long)b, 0l, 0l, 0l, 0l)
-# define GC_err_printf3(f,a,b,c) GC_err_printf(f, (long)a, (long)b, (long)c, \
-                                                 0l, 0l, 0l)
-# define GC_err_printf4(f,a,b,c,d) GC_err_printf(f, (long)a, (long)b, \
-                                                   (long)c, (long)d, 0l, 0l)
-# define GC_err_printf5(f,a,b,c,d,e) GC_err_printf(f, (long)a, (long)b, \
-                                                     (long)c, (long)d, \
-                                                     (long)e, 0l)
-# define GC_err_printf6(f,a,b,c,d,e,g) GC_err_printf(f, (long)a, (long)b, \
-                                                       (long)c, (long)d, \
-                                                       (long)e, (long)g)
-                       /* Ditto, writes to stderr.                     */
-                       
-void GC_err_puts(/* char *s */);
-                       /* Write s to stderr, don't buffer, don't add   */
-                       /* newlines, don't ...                          */
-
-# endif /* GC_PRIVATE_H */
+# include "gc_priv.h"
diff --git a/gc_typed.h b/gc_typed.h
new file mode 100644 (file)
index 0000000..4638e94
--- /dev/null
@@ -0,0 +1,72 @@
+/*
+ * Some simple primitives for allocation with explicit type information.
+ * Facilities for dynamic type inference may be added later.
+ * Should be used only for extremely performance critical applications,
+ * or if conservative collector leakage is otherwise a problem (unlikely).
+ * Note that this is implemented completely separately from the rest
+ * of the collector, and is not linked in unless referenced.
+ */
+/* Boehm, April 6, 1994 10:44 am PDT */
+
+#ifndef _GC_TYPED_H
+# define _GC_TYPED_H
+# ifndef _GC_H
+#   include "gc.h"
+# endif
+
+typedef GC_word * GC_bitmap;
+       /* The least significant bit of the first word is one if        */
+       /* the first word in the object may be a pointer.               */
+       
+# define GC_get_bit(bm, index) \
+               (((bm)[divWORDSZ(index)] >> modWORDSZ(index)) & 1)
+# define GC_set_bit(bm, index) \
+               (bm)[divWORDSZ(index)] |= (word)1 << modWORDSZ(index)
+
+typedef GC_word GC_descr;
+
+#if defined(__STDC__) || defined(__cplusplus)
+  extern GC_descr GC_make_descriptor(GC_bitmap bm, size_t len);
+#else
+  extern GC_descr GC_make_descriptor(/* GC_bitmap bm, size_t len */);
+#endif
+               /* Return a type descriptor for the object whose layout */
+               /* is described by the argument.                        */
+               /* The least significant bit of the first word is one   */
+               /* if the first word in the object may be a pointer.    */
+               /* The second argument specifies the number of          */
+               /* meaningful bits in the bitmap.  The actual object    */
+               /* may be larger (but not smaller).  Any additional     */
+               /* words in the object are assumed not to contain       */
+               /* pointers.                                            */
+               /* Returns a conservative approximation in the          */
+               /* (unlikely) case of insufficient memory to build      */
+               /* the descriptor.  Calls to GC_make_descriptor         */
+               /* may consume some amount of a finite resource.  This  */
+               /* is intended to be called once per type, not once     */
+               /* per allocation.                                      */
+
+#if defined(__STDC__) || defined(__cplusplus)
+  extern void * GC_malloc_explicitly_typed(size_t size_in_bytes, GC_descr d);
+#else
+  extern char * GC_malloc_explicitly_typed(/* size_in_bytes, descriptor */);
+#endif
+               /* Allocate an object whose layout is described by d.   */
+               /* The resulting object MAY NOT BE PASSED TO REALLOC.   */
+               
+#if defined(__STDC__) || defined(__cplusplus)
+  extern void * GC_calloc_explicitly_typed(size_t nelements,
+                                          size_t element_size_in_bytes,
+                                          GC_descr d);
+#else
+  char * GC_calloc_explicitly_typed(/* nelements, size_in_bytes, descriptor */);
+       /* Allocate an array of nelements elements, each of the */
+       /* given size, and with the given descriptor.           */
+       /* The elemnt size must be a multiple of the byte       */
+       /* alignment required for pointers.  E.g. on a 32-bit   */
+       /* machine with 16-bit aligned pointers, size_in_bytes  */
+       /* must be a multiple of 2.                             */
+#endif
+
+#endif /* _GC_TYPED_H */
+
index 3cb76b9..76a0088 100644 (file)
--- a/headers.c
+++ b/headers.c
@@ -1,6 +1,6 @@
 /* 
  * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
- * Copyright (c) 1991-1993 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1991-1994 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.
@@ -8,6 +8,7 @@
  * Permission is hereby granted to copy this garbage collector for any purpose,
  * provided the above notices are retained on all copies.
  */
+/* Boehm, March 28, 1994 2:04 pm PST */
  
 /*
  * This implements:
@@ -18,7 +19,7 @@
  * level tree.
  */
  
-# include "gc_private.h"
+# include "gc_priv.h"
 
 bottom_index * GC_all_bottom_indices = 0;
  
@@ -26,12 +27,12 @@ bottom_index * GC_all_bottom_indices = 0;
 hdr * GC_find_header(h)
 ptr_t h;
 {
-#   ifdef TL_HASH
+#   ifdef HASH_TL
        register hdr * result;
        GET_HDR(h, result);
        return(result);
 #   else
-       return(HDR(h));
+       return(HDR_INNER(h));
 #   endif
 }
  
@@ -95,7 +96,7 @@ hdr * hhdr;
     hdr_free_list = hhdr;
 }
  
-GC_init_headers()
+void GC_init_headers()
 {
     register int i;
      
@@ -125,7 +126,7 @@ register word addr;
       }
       r = (bottom_index*)GC_scratch_alloc((word)(sizeof (bottom_index)));
       if (r == 0) return(FALSE);
-      bzero((char *)r, (int)(sizeof (bottom_index)));
+      BZERO(r, sizeof (bottom_index));
       r -> hash_link = old;
       GC_top_index[i] = r;
 #   else
@@ -133,7 +134,7 @@ register word addr;
       r = (bottom_index*)GC_scratch_alloc((word)(sizeof (bottom_index)));
       if (r == 0) return(FALSE);
       GC_top_index[hi] = r;
-      bzero((char *)r, (int)(sizeof (bottom_index)));
+      BZERO(r, sizeof (bottom_index));
 # endif
     r -> key = hi;
     /* Add it to the list of bottom indices */
@@ -239,7 +240,7 @@ struct hblk * h;
     
     GET_BI(h, bi);
     if (bi == &GC_all_nils) {
-        register int hi = (word)h >> (LOG_BOTTOM_SZ + LOG_HBLKSIZE);
+        register word hi = (word)h >> (LOG_BOTTOM_SZ + LOG_HBLKSIZE);
         bi = GC_all_bottom_indices;
         while (bi != 0 && bi -> key < hi) bi = bi -> asc_link;
         j = 0;
diff --git a/include/gc_typed.h b/include/gc_typed.h
new file mode 100644 (file)
index 0000000..401fd06
--- /dev/null
@@ -0,0 +1,67 @@
+/*
+ * Some simple primitives for allocation with explicit type information.
+ * Facilities for dynamic type inference may be added later.
+ * Should be used only for extremely performance critical applications,
+ * or if conservative collector leakage is otherwise a problem (unlikely).
+ * Note that this is implemented completely separately from the rest
+ * of the collector, and is not linked in unless referenced.
+ */
+/* Boehm, March 31, 1994 4:43 pm PST */
+
+#ifndef _GC_TYPED_H
+# define _GC_TYPED_H
+# ifndef _GC_H
+#   include "gc.h"
+# endif
+
+typedef GC_word * GC_bitmap;
+       /* The least significant bit of the first word is one if        */
+       /* the first word in the object may be a pointer.               */
+       
+# define GC_get_bit(bm, index) \
+               (((bm)[divWORDSZ(index)] >> modWORDSZ(index)) & 1)
+# define GC_set_bit(bm, index) \
+               (bm)[divWORDSZ(index)] |= (word)1 << modWORDSZ(index)
+
+typedef GC_word GC_descr;
+
+#if defined(__STDC__) || defined(__cplusplus)
+  extern GC_descr GC_make_decriptor(GC_bitmap bm, size_t len);
+#else
+  extern GC_descr GC_make_decriptor(/* GC_bitmap bm, size_t len */);
+#endif
+               /* Return a type descriptor for the object whose layout */
+               /* is described by the argument.                        */
+               /* The least significant bit of the first word is one   */
+               /* if the first word in the object may be a pointer.    */
+               /* The second argument specifies the number of          */
+               /* meaningful bits in the bitmap.  The actual object    */
+               /* may be larger (but not smaller).  Any additional     */
+               /* words in the object are assumed not to contain       */
+               /* pointers.                                            */
+               /* Returns (GC_descr)(-1) on failure (no memory).       */
+
+#if defined(__STDC__) || defined(__cplusplus)
+  extern void * GC_malloc_explicitly_typed(size_t size_in_bytes, GC_descr d);
+#else
+  extern char * GC_malloc_explicitly_typed(/* size_in_bytes, descriptor */);
+#endif
+               /* Allocate an object whose layout is described by d.   */
+               /* The resulting object MAY NOT BE PASSED TO REALLOC.   */
+               
+#if defined(__STDC__) || defined(__cplusplus)
+  extern void * GC_calloc_explicitly_typed(size_t nelements,
+                                          size_t element_size_in_bytes,
+                                          GC_descr d);
+#else
+  char * GC_calloc_explicitly_typed(/* nelements, size_in_bytes, descriptor */);
+       /* Allocate an array of nelements elements, each of the */
+       /* given size, and with the given descriptor.           */
+       /* The elemnt size must be a multiple of the byte       */
+       /* alignment required for pointers.  E.g. on a 32-bit   */
+       /* machine with 16-bit aligned pointers, size_in_bytes  */
+       /* must be a multiple of 2.                             */
+#endif
+
+#endif /* _GC_TYPED_H */
+
index 043335c..b189b87 100644 (file)
@@ -1,4 +1,15 @@
-# include "gc_private.h"
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 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.
+ */
+/* Boehm, April 5, 1994 1:46 pm PDT */
+# include "gc_priv.h"
 # include <stdio.h>
 # include <setjmp.h>
 # if defined(OS2) || defined(CX_UX)
@@ -6,6 +17,7 @@
 #   define _longjmp(b,v) longjmp(b,v)
 # 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       */
@@ -106,7 +118,7 @@ __asm GC_push_regs(
          GC_push_one(d7);
 #       endif
 
-#       if defined(I386) && !defined(OS2) && !defined(SUNOS5)
+#       if defined(I386) &&!defined(OS2) &&!defined(SUNOS5) &&!defined(MSWIN32)
        /* I386 code, generic code does not appear to work */
        /* It does appear to work under OS2, and asms dont */
          asm("pushl %eax");  asm("call _GC_push_one"); asm("addl $4,%esp");
@@ -117,6 +129,28 @@ __asm GC_push_regs(
          asm("pushl %ebx");  asm("call _GC_push_one"); asm("addl $4,%esp");
 #       endif
 
+#       if defined(I386) && defined(MSWIN32)
+       /* I386 code, Microsoft variant         */
+         __asm  push eax
+         __asm  call GC_push_one
+         __asm  add esp,4
+         __asm  push ecx
+         __asm  call GC_push_one
+         __asm  add esp,4
+         __asm  push edx
+         __asm  call GC_push_one
+         __asm  add esp,4
+         __asm  push esi
+         __asm  call GC_push_one
+         __asm  add esp,4
+         __asm  push edi
+         __asm  call GC_push_one
+         __asm  add esp,4
+         __asm  push ebx
+         __asm  call GC_push_one
+         __asm  add esp,4
+#       endif
+
 #       if defined(I386) && defined(SUNOS5)
        /* I386 code, SVR4 variant, generic code does not appear to work */
          asm("pushl %eax");  asm("call GC_push_one"); asm("addl $4,%esp");
@@ -137,10 +171,10 @@ __asm GC_push_regs(
 
 #       ifdef SPARC
          {
-             void GC_save_regs_in_stack();
+             word GC_save_regs_in_stack();
              
              /* generic code will not work */
-             GC_save_regs_in_stack();
+             (void)GC_save_regs_in_stack();
          }
 #       endif
 
@@ -232,7 +266,7 @@ __asm GC_push_regs(
 }
 
 /* On register window machines, we need a way to force registers into  */
-/* the stack.                                                          */
+/* the stack.  Return sp.                                              */
 # ifdef SPARC
     asm("      .seg    \"text\"");
 #   ifdef SUNOS5
@@ -248,7 +282,7 @@ __asm GC_push_regs(
     asm("      nop");
     
 #   ifdef LINT
-       void GC_save_regs_in_stack() {}
+       word GC_save_regs_in_stack() { return(0 /* sp really */);}
 #   endif
 # endif
 
index e78c266..ed80a87 100644 (file)
--- a/malloc.c
+++ b/malloc.c
@@ -1,6 +1,6 @@
 /* 
  * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
- * Copyright (c) 1991-1993 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1991-1994 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.
@@ -8,23 +8,14 @@
  * Permission is hereby granted to copy this garbage collector for any purpose,
  * provided the above notices are retained on all copies.
  */
-/* Boehm, November 17, 1993 5:51 pm PST */
+/* Boehm, March 29, 1994 4:40 pm PST */
  
 #include <stdio.h>
-#include "gc_private.h"
+#include "gc_priv.h"
 
 extern ptr_t GC_clear_stack(); /* in misc.c, behaves like identity */
 void GC_extend_size_map();     /* in misc.c. */
 
-# ifdef ALL_INTERIOR_POINTERS
-#   define SMALL_OBJ(bytes) ((bytes) < WORDS_TO_BYTES(MAXOBJSZ))
-#   define ADD_SLOP(bytes) ((bytes)+1)
-# else
-#   define SMALL_OBJ(bytes) ((bytes) <= WORDS_TO_BYTES(MAXOBJSZ))
-#   define ADD_SLOP(bytes) (bytes)
-# endif
-
-
 /* allocate lb bytes for an object of kind.    */
 /* Should not be used to directly to allocate  */
 /* objects such as STUBBORN objects that       */
@@ -141,6 +132,72 @@ out:
     return((ptr_t)op);
 }
 
+#if defined(THREADS) && !defined(SRC_M3)
+/* Return a list of 1 or more objects of the indicated size, linked    */
+/* through the first word in the object.  This has the advantage that  */
+/* it acquires the allocation lock only once, and may greatly reduce   */
+/* time wasted contending for the allocation lock.  Typical usage would */
+/* be in a thread that requires many items of the same size.  It would */
+/* keep its own free list in thread-local storage, and call            */
+/* GC_malloc_many or friends to replenish it.  (We do not round up     */
+/* object sizes, since a call indicates the intention to consume many  */
+/* objects of exactly this size.)                                      */
+/* Note that the client should usually clear the link field.           */
+ptr_t GC_generic_malloc_many(lb, k)
+register word lb;
+register int k;
+{
+ptr_t op;
+register ptr_t p;
+ptr_t *opp;
+word lw;
+register word my_words_allocd;
+DCL_LOCK_STATE;
+
+    if (!SMALL_OBJ(lb)) {
+        op = GC_generic_malloc(lb, k);
+        obj_link(op) = 0;
+        return(op);
+    }
+    lw = ROUNDED_UP_WORDS(lb);
+    DISABLE_SIGNALS();
+    LOCK();
+    opp = &(GC_obj_kinds[k].ok_freelist[lw]);
+    if( (op = *opp) == 0 ) {
+        if (!GC_is_initialized) {
+            GC_init_inner();
+        }
+       op = GC_clear_stack(GC_allocobj(lw, k));
+       if (op == 0) goto out;
+    }
+    *opp = 0;
+    my_words_allocd = 0;
+    for (p = op; p != 0; p = obj_link(p)) {
+        my_words_allocd += lw;
+        if (my_words_allocd >= BODY_SZ) {
+            *opp = obj_link(p);
+            obj_link(p) = 0;
+            break;
+        }
+    }
+    GC_words_allocd += my_words_allocd;
+    
+out:
+    UNLOCK();
+    ENABLE_SIGNALS();
+    return(op);
+
+}
+
+void * GC_malloc_many(size_t lb)
+{
+    return(GC_generic_malloc_many(lb, NORMAL));
+}
+
+/* Note that the "atomic" version of this would be unsafe, since the   */
+/* links would not be seen by the collector.                           */
+# endif
+
 #define GENERAL_MALLOC(lb,k) \
     (extern_ptr_t)GC_clear_stack(GC_generic_malloc((word)lb, k))
 /* We make the GC_clear_stack_call a tail call, hoping to get more of  */
@@ -232,6 +289,10 @@ DCL_LOCK_STATE;
 
     if( SMALL_OBJ(lb) ) {
 #       ifdef MERGE_SIZES
+#        ifdef ADD_BYTE_AT_END
+           lb--; /* We don't need the extra byte, since this won't be  */
+                 /* collected anyway.                                  */
+#        endif
          lw = GC_size_map[lb];
 #      else
          lw = ROUNDED_UP_WORDS(lb);
@@ -307,7 +368,7 @@ int knd;
 {
 register struct hblk * h;
 register hdr * hhdr;
-register signed_word sz;        /* Current size in bytes       */
+register word sz;       /* Current size in bytes       */
 register word orig_sz;  /* Original sz in bytes        */
 int obj_kind;
 
@@ -338,7 +399,7 @@ int obj_kind;
              /* Clear unneeded part of object to avoid bogus pointer */
              /* tracing.                                             */
              /* Safe for stubborn objects.                           */
-               bzero(((char *)p) + lb, (int)(orig_sz - lb));
+               BZERO(((ptr_t)p) + lb, orig_sz - lb);
            }
            return(p);
        } else {
@@ -349,7 +410,7 @@ int obj_kind;
              if (result == 0) return(0);
                  /* Could also return original object.  But this       */
                  /* gives the client warning of imminent disaster.     */
-             bcopy(p, result, (int)lb);
+             BCOPY(p, result, lb);
              GC_free(p);
              return(result);
        }
@@ -359,7 +420,7 @@ int obj_kind;
                GC_generic_or_special_malloc((word)lb, obj_kind);
 
          if (result == 0) return(0);
-         bcopy(p, result, (int)sz);
+         BCOPY(p, result, sz);
          GC_free(p);
          return(result);
     }
@@ -395,7 +456,7 @@ int obj_kind;
        /* inconsistent.  We claim this is benign.                      */
        if (knd == UNCOLLECTABLE) GC_non_gc_bytes -= sz;
        if (ok -> ok_init) {
-           bzero((char *)((word *)p + 1), (int)(WORDS_TO_BYTES(sz-1)));
+           BZERO((word *)p + 1, WORDS_TO_BYTES(sz-1));
        }
        flh = &(ok -> ok_freelist[sz]);
        obj_link(p) = *flh;
@@ -411,3 +472,4 @@ int obj_kind;
         ENABLE_SIGNALS();
     }
 }
+
diff --git a/mark.c b/mark.c
index b37b7c9..882ed3f 100644 (file)
--- a/mark.c
+++ b/mark.c
@@ -1,7 +1,7 @@
 
 /*
  * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
- * Copyright (c) 1991,1992 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1991-1994 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.
 
 
 # include <stdio.h>
-# include "gc_private.h"
+# include "gc_priv.h"
+# include "gc_mark.h"
+
+/* We put this here to minimize the risk of inlining. */
+/*VARARGS*/
+void GC_noop() {}
+
+mark_proc GC_mark_procs[MAX_MARK_PROCS] = {0};
+word GC_n_mark_procs = 0;
+
+/* Initialize GC_obj_kinds properly and standard free lists properly.          */
+/* This must be done statically since they may be accessed before      */
+/* GC_init is called.                                                  */
+/* It's done here, since we need to deal with mark descriptors.                */
+struct obj_kind GC_obj_kinds[MAXOBJKINDS] = {
+/* PTRFREE */ { &GC_aobjfreelist[0], &GC_areclaim_list[0],
+               0 | DS_LENGTH, FALSE, FALSE },
+/* NORMAL  */ { &GC_objfreelist[0], &GC_reclaim_list[0],
+#              ifdef ADD_BYTE_AT_END
+               WORDS_TO_BYTES(-1) | DS_LENGTH,
+#              else
+               0 | DS_LENGTH,
+#              endif
+               TRUE /* add length to descr */, TRUE },
+/* UNCOLLECTABLE */
+             { &GC_uobjfreelist[0], &GC_ureclaim_list[0],
+               0 | DS_LENGTH, TRUE /* add length to descr */, TRUE },
+# ifdef STUBBORN_ALLOC
+/*STUBBORN*/ { &GC_sobjfreelist[0], &GC_sreclaim_list[0],
+               0 | DS_LENGTH, TRUE /* add length to descr */, TRUE },
+# endif
+};
+
+# ifdef STUBBORN_ALLOC
+  int GC_n_kinds = 4;
+# else
+  int GC_n_kinds = 3;
+# endif
+
 
 # define INITIAL_MARK_STACK_SIZE (1*HBLKSIZE)
                /* INITIAL_MARK_STACK_SIZE * sizeof(mse) should be a    */
@@ -36,49 +74,10 @@ mse * GC_mark_stack_top;
 
 static struct hblk * scan_ptr;
 
-
-typedef int mark_state_t;      /* Current state of marking, as follows:*/
-                               /* Used to remember where we are during */
-                               /* concurrent marking.                  */
-
-                               /* We say something is dirty if it was  */
-                               /* written since the last time we       */
-                               /* retrieved dirty bits.  We say it's   */
-                               /* grungy if it was marked dirty in the */
-                               /* last set of bits we retrieved.       */
-                               
-                               /* Invariant I: all roots and marked    */
-                               /* objects p are either dirty, or point */
-                               /* objects q that are either marked or  */
-                               /* a pointer to q appears in a range    */
-                               /* on the mark stack.                   */
-
-# define MS_NONE 0             /* No marking in progress. I holds.     */
-                               /* Mark stack is empty.                 */
-
-# define MS_PUSH_RESCUERS 1    /* Rescuing objects are currently       */
-                               /* being pushed.  I holds, except       */
-                               /* that grungy roots may point to       */
-                               /* unmarked objects, as may marked      */
-                               /* grungy objects above scan_ptr.       */
-
-# define MS_PUSH_UNCOLLECTABLE 2
-                               /* I holds, except that marked          */
-                               /* uncollectable objects above scan_ptr */
-                               /* may point to unmarked objects.       */
-                               /* Roots may point to unmarked objects  */
-
-# define MS_ROOTS_PUSHED 3     /* I holds, mark stack may be nonempty  */
-
-# define MS_PARTIALLY_INVALID 4        /* I may not hold, e.g. because of M.S. */
-                               /* overflow.  However marked heap       */
-                               /* objects below scan_ptr point to      */
-                               /* marked or stacked objects.           */
-
-# define MS_INVALID 5          /* I may not hold.                      */
-
 mark_state_t GC_mark_state = MS_NONE;
 
+bool GC_mark_stack_too_small = FALSE;
+
 bool GC_objects_are_marked = FALSE;    /* Are there collectable marked */
                                        /* objects in the heap?         */
 
@@ -91,7 +90,7 @@ bool GC_collection_in_progress()
 void GC_clear_hdr_marks(hhdr)
 register hdr * hhdr;
 {
-    bzero((char *)(hhdr -> hb_marks), (int)(MARK_BITS_SZ*sizeof(word)));
+    BZERO(hhdr -> hb_marks, MARK_BITS_SZ*sizeof(word));
 }
 
 /*
@@ -162,22 +161,6 @@ void GC_clear_marks()
 
 }
 
-
-/*
- * Push some dummy entries onto bottom of mark stack to allow
- * marker to operate in bigger chunks between bounds checks.
- * This is a pretty extreme performance hack ...
- */
-void GC_prime_marker()
-{
-    register int i;
-    static word dummy = 0;
-
-    for (i = 0; i < INITIAL_MARK_STACK_SIZE/64; i++) {
-        GC_push_all((ptr_t)(&dummy), (ptr_t)(&dummy + 1));
-    }
-}
-                       
 /* Initiate full marking.      */
 void GC_initiate_full()
 {
@@ -203,14 +186,13 @@ void GC_initiate_full()
 #   ifdef GATHERSTATS
        GC_n_rescuing_pages = 0;
 #   endif
-    GC_prime_marker();
 }
 
 /* Initiate partial marking.   */
 /*ARGSUSED*/
 void GC_initiate_partial()
 {
-    if (GC_incremental) GC_read_dirty();
+    if (GC_dirty_maintained) GC_read_dirty();
 #   ifdef STUBBORN_ALLOC
        GC_read_changed();
 #   endif
@@ -218,7 +200,7 @@ void GC_initiate_partial()
        {
            extern void GC_check_dirty();
            
-           if (GC_incremental) GC_check_dirty();
+           if (GC_dirty_maintained) GC_check_dirty();
        }
 #   endif
 #   ifdef GATHERSTATS
@@ -231,7 +213,6 @@ void GC_initiate_partial()
     } /* else this is really a full collection, and mark       */
       /* bits are invalid.                                     */
     scan_ptr = 0;
-    GC_prime_marker();
 }
 
 
@@ -290,6 +271,9 @@ bool GC_mark_some()
                return(FALSE);
            } else {
                GC_mark_state = MS_NONE;
+               if (GC_mark_stack_too_small) {
+                   alloc_mark_stack(2*GC_mark_stack_size);
+               }
                return(TRUE);
            }
            
@@ -303,12 +287,9 @@ bool GC_mark_some()
                GC_mark_from_mark_stack();
                return(FALSE);
            }
-           if (scan_ptr == 0 && GC_mark_state == MS_INVALID) {
+           if (scan_ptr == 0
+               && (GC_mark_state == MS_INVALID || GC_mark_stack_too_small)) {
                alloc_mark_stack(2*GC_mark_stack_size);
-#              ifdef PRINTSTATS
-                   GC_printf1("Grew mark stack to %lu frames\n",
-                              (unsigned long) GC_mark_stack_size);
-#              endif
                GC_mark_state = MS_PARTIALLY_INVALID;
            }
            scan_ptr = GC_push_next_marked(scan_ptr);
@@ -326,60 +307,66 @@ bool GC_mark_some()
     }
 }
 
-/* Mark procedure for objects that may contain arbitrary pointers.     */
-/* Msp is the current mark stack pointer. Msl limits the stack.                */
-/* We return the new stack pointer value.                              */
-/* The object at addr has already been marked.  Our job is to make     */
-/* sure that its descendents are marked.                               */
-mse * GC_normal_mark_proc(addr, hhdr, msp, msl)
-register word * addr;
-register hdr * hhdr;
-register mse * msp, * msl;
+
+bool GC_mark_stack_empty()
 {
-    register word sz = hhdr -> hb_sz;
-    
-    msp++;
-    /* Push the contents of the object on the mark stack. */
-        if (msp >= msl) {
-            GC_mark_state = MS_INVALID;
-#          ifdef PRINTSTATS
-              GC_printf1("Mark stack overflow; current size = %lu entries\n",
-                        GC_mark_stack_size);
-#          endif
-           return(msp-INITIAL_MARK_STACK_SIZE/8);
-       }
-        msp -> mse_start = addr;
-#      ifdef ALL_INTERIOR_POINTERS
-           /* Last word can't possibly contain pointers, since we      */
-           /* pad the size by a byte.                                  */
-            msp -> mse_end = addr + sz - 1;
-#      else
-            msp -> mse_end = addr + sz;
-#      endif
-#   ifdef GATHERSTATS
-       GC_composite_in_use += sz;
-#   endif
-    return(msp);
-}
+    return(GC_mark_stack_top < GC_mark_stack);
+}      
 
-/* Mark procedure for objects that are known to contain no pointers.   */
+#ifdef PROF_MARKER
+    word GC_prof_array[10];
+#   define PROF(n) GC_prof_array[n]++
+#else
+#   define PROF(n)
+#endif
+
+/* Given a pointer to someplace other than a small object page or the  */
+/* first page of a large object, return a pointer either to the                */
+/* start of the large object or NIL.                                   */
+/* In the latter case black list the address current.                  */
 /*ARGSUSED*/
-mse * GC_no_mark_proc(addr, hhdr, msp, msl)
-register word * addr;
+word GC_find_start(current, hhdr)
+register word current;
 register hdr * hhdr;
-register mse * msp, * msl;
 {
-#   ifdef GATHERSTATS
-       GC_atomic_in_use += hhdr -> hb_sz;
+#   ifdef ALL_INTERIOR_POINTERS
+       if (hhdr != 0) {
+           register word orig = current;
+           
+           current = (word)HBLKPTR(current) + HDR_BYTES;
+           do {
+             current = current - HBLKSIZE*(int)hhdr;
+             hhdr = HDR(current);
+           } while(IS_FORWARDING_ADDR_OR_NIL(hhdr));
+           /* current points to the start of the large object */
+           if ((word *)orig - (word *)current
+                >= hhdr->hb_sz) {
+               /* Pointer past the end of the block */
+               GC_ADD_TO_BLACK_LIST_NORMAL(orig);
+               return(0);
+           }
+           return(current);
+       } else {
+           GC_ADD_TO_BLACK_LIST_NORMAL(current);
+           return(0);
+        }
+#   else
+        GC_ADD_TO_BLACK_LIST_NORMAL(current);
+        return(0);
 #   endif
-    return(msp);
 }
 
-
-bool GC_mark_stack_empty()
+mse * GC_signal_mark_stack_overflow(msp)
+mse * msp;
 {
-    return(GC_mark_stack_top < GC_mark_stack);
-}      
+    GC_mark_state = MS_INVALID;
+#   ifdef PRINTSTATS
+       GC_printf1("Mark stack overflow; current size = %lu entries\n",
+                   GC_mark_stack_size);
+#    endif
+     return(msp-INITIAL_MARK_STACK_SIZE/8);
+}
+
 
 /*
  * Mark objects pointed to by the regions described by
@@ -395,108 +382,81 @@ void GC_mark_from_mark_stack()
   mse * GC_mark_stack_top_reg = GC_mark_stack_top;
   mse * mark_stack_limit = &(GC_mark_stack[GC_mark_stack_size]);
   int credit = HBLKSIZE;       /* Remaining credit for marking work    */
-  register int safe_credit;     /* Amount of credit we can safely use  */
-                               /* before checking stack bounds.        */
-                               /* Gross hack to safe a couple of       */
-                               /* instructions in the loop.            */
   register word * current_p;   /* Pointer to current candidate ptr.    */
   register word current;       /* Candidate pointer.                   */
   register word * limit;       /* (Incl) limit of current candidate    */
                                /* range                                */
+  register word descr;
   register ptr_t greatest_ha = GC_greatest_plausible_heap_addr;
   register ptr_t least_ha = GC_least_plausible_heap_addr;
-# define SPLIT_RANGE_WORDS 128
+# define SPLIT_RANGE_WORDS 128  /* Must be power of 2.         */
 
   GC_objects_are_marked = TRUE;
-  while (GC_mark_stack_top_reg >= GC_mark_stack_reg && credit > 0) {
-   safe_credit = WORDS_TO_BYTES(GC_mark_stack_top_reg - GC_mark_stack_reg + 1);
-   if (safe_credit > credit) {
-       safe_credit = credit;
-       credit = 0;
-   } else {
-       credit -= safe_credit;
-   }
-   while (safe_credit > 0) {
-    /* Stack must be nonempty */
-    register int displ;  /* Displacement in block; first bytes, then words */
-    register hdr * hhdr;
-    register map_entry_type map_entry;
-
+  while (/* GC_mark_stack_top_reg >= GC_mark_stack_reg && credit >= 0 */
+        (((ptr_t)GC_mark_stack_top_reg
+          - (ptr_t)GC_mark_stack_reg) | credit) >= 0) {
     current_p = GC_mark_stack_top_reg -> mse_start;
-    limit = GC_mark_stack_top_reg -> mse_end;
-    safe_credit -= (ptr_t)limit - (ptr_t)current_p;
-    if (limit - current_p > SPLIT_RANGE_WORDS) {
-      /* Process part of the range to avoid pushing too much on the    */
-      /* stack.                                                                */
-         GC_mark_stack_top_reg -> mse_start =
-               limit = current_p + SPLIT_RANGE_WORDS;
-      /* Make sure that pointers overlapping the two ranges are                */
-      /* considered.                                                   */
-         limit += sizeof(word) - ALIGNMENT;
+    descr = GC_mark_stack_top_reg -> mse_descr;
+  retry:  
+    if (descr & ((~(WORDS_TO_BYTES(SPLIT_RANGE_WORDS) - 1)) | DS_TAGS)) {
+      word tag = descr & DS_TAGS;
+      
+      switch(tag) {
+        case DS_LENGTH:
+          /* Large length.                                             */
+          /* Process part of the range to avoid pushing too much on the        */
+          /* stack.                                                    */
+          GC_mark_stack_top_reg -> mse_start =
+               limit = current_p + SPLIT_RANGE_WORDS-1;
+          GC_mark_stack_top_reg -> mse_descr -=
+                       WORDS_TO_BYTES(SPLIT_RANGE_WORDS-1);
+          /* Make sure that pointers overlapping the two ranges are    */
+          /* considered.                                               */
+          limit += sizeof(word) - ALIGNMENT;
+          break;
+        case DS_BITMAP:
+          GC_mark_stack_top_reg--;
+          descr &= ~DS_TAGS;
+          credit -= WORDS_TO_BYTES(WORDSZ/2); /* guess */
+          while (descr != 0) {
+            if ((signed_word)descr < 0) {
+              current = *current_p++;
+              descr <<= 1;
+              if ((ptr_t)current < least_ha) continue;
+              if ((ptr_t)current >= greatest_ha) continue;
+              PUSH_CONTENTS(current, GC_mark_stack_top_reg, mark_stack_limit);
+            } else {
+              descr <<= 1;
+              current_p++;
+            }
+          }
+          continue;
+        case DS_PROC:
+          GC_mark_stack_top_reg--;
+          credit -= PROC_BYTES;
+          GC_mark_stack_top_reg =
+              (*PROC(descr))
+                   (current_p, GC_mark_stack_top_reg,
+                   mark_stack_limit, ENV(descr));
+          continue;
+        case DS_PER_OBJECT:
+          descr = *(word *)((ptr_t)current_p + descr - tag);
+          goto retry;
+      }
     } else {
       GC_mark_stack_top_reg--;
+      limit = (word *)(((ptr_t)current_p) + (word)descr);
     }
+    /* The simple case in which we're scanning a range.        */
+    credit -= (ptr_t)limit - (ptr_t)current_p;
     limit -= 1;
-    
     while (current_p <= limit) {
       current = *current_p;
       current_p = (word *)((char *)current_p + ALIGNMENT);
-      
       if ((ptr_t)current < least_ha) continue;
       if ((ptr_t)current >= greatest_ha) continue;
-      GET_HDR(current,hhdr);
-      if (IS_FORWARDING_ADDR_OR_NIL(hhdr)) {
-#      ifdef ALL_INTERIOR_POINTERS
-         if (hhdr != 0) {
-           register word orig = current;
-           
-           current = (word)HBLKPTR(current) + HDR_BYTES;
-           do {
-             current = current - HBLKSIZE*(int)hhdr;
-             hhdr = HDR(current);
-           } while(IS_FORWARDING_ADDR_OR_NIL(hhdr));
-           /* current points to the start of the large object */
-           if ((word *)orig - (word *)current
-                >= hhdr->hb_sz) {
-               /* Pointer past the end of the block */
-               GC_ADD_TO_BLACK_LIST_NORMAL(current);
-               continue;
-           }
-         } else {
-           GC_ADD_TO_BLACK_LIST_NORMAL(current);
-            continue;
-          }
-#      else
-          GC_ADD_TO_BLACK_LIST_NORMAL(current);
-          continue;
-#      endif         
-      }
-      displ = HBLKDISPL(current);
-      map_entry = MAP_ENTRY((hhdr -> hb_map), displ);
-      if (map_entry == OBJ_INVALID) {
-          GC_ADD_TO_BLACK_LIST_NORMAL(current);
-          continue;
-      }
-      displ = BYTES_TO_WORDS(displ);
-      displ -= map_entry;
-
-      {
-          register word * mark_word_addr = hhdr -> hb_marks + divWORDSZ(displ);
-          register word mark_word = *mark_word_addr;
-          register word mark_bit = (word)1 << modWORDSZ(displ);
-          
-          if (mark_word & mark_bit) {
-             /* Mark bit is already set */
-             continue;
-          }
-          *mark_word_addr = mark_word | mark_bit;
-      }
-    
-      GC_mark_stack_top_reg =
-          (* (hhdr -> hb_mark_proc))((word *)(HBLKPTR(current)) + displ, hhdr,
-                                    GC_mark_stack_top_reg, mark_stack_limit);
+      PUSH_CONTENTS(current, GC_mark_stack_top_reg, mark_stack_limit);
     }
-   }
   }
   GC_mark_stack_top = GC_mark_stack_top_reg;
 }
@@ -508,6 +468,7 @@ word n;
 {
     mse * new_stack = (mse *)GC_scratch_alloc(n * sizeof(struct ms_entry));
     
+    GC_mark_stack_too_small = FALSE;
     if (GC_mark_stack_size != 0) {
         if (new_stack != 0) {
           word displ = HBLKDISPL(GC_mark_stack);
@@ -523,6 +484,15 @@ word n;
            }
           GC_mark_stack = new_stack;
           GC_mark_stack_size = n;
+#        ifdef PRINTSTATS
+             GC_printf1("Grew mark stack to %lu frames\n",
+                        (unsigned long) GC_mark_stack_size);
+#        endif
+        } else {
+#        ifdef PRINTSTATS
+             GC_printf1("Failed to grow mark stack to %lu frames\n",
+                        (unsigned long) n);
+#        endif
         }
     } else {
         if (new_stack == 0) {
@@ -551,26 +521,38 @@ void GC_push_all(bottom, top)
 ptr_t bottom;
 ptr_t top;
 {
+    register word length;
+    
     bottom = (ptr_t)(((word) bottom + ALIGNMENT-1) & ~(ALIGNMENT-1));
     top = (ptr_t)(((word) top) & ~(ALIGNMENT-1));
-    
     if (top == 0 || bottom == top) return;
     GC_mark_stack_top++;
     if (GC_mark_stack_top >= GC_mark_stack + GC_mark_stack_size) {
        ABORT("unexpected mark stack overflow");
     }
+    length = top - bottom;
+#   if DS_TAGS > ALIGNMENT - 1
+       length += DS_TAGS;
+       length &= ~DS_TAGS;
+#   endif
     GC_mark_stack_top -> mse_start = (word *)bottom;
-    GC_mark_stack_top -> mse_end = (word *)top;
+    GC_mark_stack_top -> mse_descr = length;
 }
 
 /*
  * Analogous to the above, but push only those pages that may have been
- * dirtied.
- * Should not overflow mark stack.
+ * dirtied.  A block h is assumed dirty if dirty_fn(h) != 0.
+ * We use push_fn to actually push the block.
+ * Will not overflow mark stack if push_fn pushes a small fixed number
+ * of entries.  (This is invoked only if push_fn pushes a single entry,
+ * or if it marks each object before pushing it, thus ensuring progress
+ * in the event of a stack overflow.)
  */
-void GC_push_dirty(bottom, top)
+void GC_push_dirty(bottom, top, dirty_fn, push_fn)
 ptr_t bottom;
 ptr_t top;
+int (*dirty_fn)(/* struct hblk * h */);
+void (*push_fn)(/* ptr_t bottom, ptr_t top */);
 {
     register struct hblk * h;
 
@@ -580,34 +562,30 @@ ptr_t top;
     if (top == 0 || bottom == top) return;
     h = HBLKPTR(bottom + HBLKSIZE);
     if (top <= (ptr_t) h) {
-       if (GC_page_was_dirty(h-1)) {
-           GC_push_all(bottom, top);
+       if ((*dirty_fn)(h-1)) {
+           (*push_fn)(bottom, top);
        }
        return;
     }
-    if (GC_page_was_dirty(h-1)) {
-        GC_push_all(bottom, (ptr_t)h);
+    if ((*dirty_fn)(h-1)) {
+        (*push_fn)(bottom, (ptr_t)h);
     }
     while ((ptr_t)(h+1) <= top) {
-       if (GC_page_was_dirty(h)) {
-           GC_mark_stack_top++;
-           GC_mark_stack_top -> mse_start = (word *)h;
-           h++;
-           if (GC_mark_stack_top - GC_mark_stack
+       if ((*dirty_fn)(h)) {
+           if ((word)(GC_mark_stack_top - GC_mark_stack)
                > 3 * GC_mark_stack_size / 4) {
                /* Danger of mark stack overflow */
-               GC_mark_stack_top -> mse_end = (word *)top;
+               (*push_fn)((ptr_t)h, top);
                return;
            } else {
-               GC_mark_stack_top -> mse_end = (word *)h;
+               (*push_fn)((ptr_t)h, (ptr_t)(h+1));
            }
-       } else {
-           h++;
        }
+       h++;
     }
     if ((ptr_t)h != top) {
-       if (GC_page_was_dirty(h)) {
-            GC_push_all((ptr_t)h, top);
+       if ((*dirty_fn)(h)) {
+            (*push_fn)((ptr_t)h, top);
         }
     }
     if (GC_mark_stack_top >= GC_mark_stack + GC_mark_stack_size) {
@@ -615,16 +593,27 @@ ptr_t top;
     }
 }
 
+# ifndef SMALL_CONFIG
 void GC_push_conditional(bottom, top, all)
 ptr_t bottom;
 ptr_t top;
 {
     if (all) {
-       GC_push_all(bottom, top);
+      if (GC_dirty_maintained) {
+#      ifdef PROC_VDB
+           /* Pages that were never dirtied cannot contain pointers    */
+           GC_push_dirty(bottom, top, GC_page_was_ever_dirty, GC_push_all);
+#      else
+           GC_push_all(bottom, top);
+#      endif
+      } else {
+       GC_push_all(bottom, top);
+      }
     } else {
-       GC_push_dirty(bottom, top);
+       GC_push_dirty(bottom, top, GC_page_was_dirty, GC_push_all);
     }
 }
+#endif
 
 /*
  * Push a single value onto mark stack. Mark from the object pointed to by p.
@@ -654,7 +643,11 @@ ptr_t top;
         GC_push_one_checked(p,AIP);    \
     }
 
-void GC_push_one(p)
+# ifdef MSWIN32
+  void __cdecl GC_push_one(p)
+# else
+  void GC_push_one(p)
+# endif
 word p;
 {
     GC_PUSH_ONE_STACK(p);
@@ -714,11 +707,8 @@ register bool interior_ptrs;
     } else {
        if (!mark_bit_from_hdr(hhdr, displ)) {
            set_mark_bit_from_hdr(hhdr, displ);
-           GC_mark_stack_top =
-               (* (hhdr -> hb_mark_proc))((word *)r,
-                                         hhdr,
-                                         GC_mark_stack_top,
-                                         &(GC_mark_stack[GC_mark_stack_size]));
+           PUSH_OBJ((word *)r, hhdr, GC_mark_stack_top,
+                    &(GC_mark_stack[GC_mark_stack_size]));
        }
     }
 }
@@ -756,6 +746,7 @@ ptr_t top;
 # endif
 }
 
+#ifndef SMALL_CONFIG
 /* Push all objects reachable from marked objects in the given block */
 /* of size 1 objects.                                               */
 void GC_push_marked1(h, hhdr)
@@ -881,7 +872,7 @@ register hdr * hhdr;
 #   undef GC_least_plausible_heap_addr        
 }
 
-
+#endif /* SMALL_CONFIG */
 
 /* Push all objects reachable from marked objects in the given block */
 void GC_push_marked(h, hhdr)
@@ -909,6 +900,7 @@ register hdr * hhdr;
     }
     
     switch(sz) {
+#   ifndef SMALL_CONFIG    
      case 1:
        GC_push_marked1(h, hhdr);
        break;
@@ -918,6 +910,7 @@ register hdr * hhdr;
      case 4:
        GC_push_marked4(h, hhdr);
        break;
+#   endif       
      default:
       GC_mark_stack_top_reg = GC_mark_stack_top;
       for (p = (word *)h + HDR_WORDS, word_no = HDR_WORDS; p <= lim;
@@ -925,11 +918,7 @@ register hdr * hhdr;
          /* This needs manual optimization: */
          if (mark_bit_from_hdr(hhdr, word_no)) {
            /* Mark from fields inside the object */
-             GC_mark_stack_top_reg =
-               (* (hhdr -> hb_mark_proc))((word *)p,
-                                         hhdr,
-                                         GC_mark_stack_top_reg,
-                                         mark_stack_limit);
+             PUSH_OBJ((word *)p, hhdr, GC_mark_stack_top_reg, mark_stack_limit);
 #           ifdef GATHERSTATS
                /* Subtract this object from total, since it was        */
                /* added in twice.                                      */
@@ -941,6 +930,7 @@ register hdr * hhdr;
     }
 }
 
+#ifndef SMALL_CONFIG
 /* Test whether any page in the given block is dirty   */
 bool GC_block_was_dirty(h, hhdr)
 struct hblk *h;
@@ -961,8 +951,9 @@ register hdr * hhdr;
          return(FALSE);
     }
 }
+#endif /* SMALL_CONFIG */
 
-/* Identical to above, but return address of next block        */
+/* Similar to GC_push_next_marked, but return address of next block    */
 struct hblk * GC_push_next_marked(h)
 struct hblk *h;
 {
@@ -975,13 +966,14 @@ struct hblk *h;
     return(h + OBJ_SZ_TO_BLOCKS(hhdr -> hb_sz));
 }
 
+#ifndef SMALL_CONFIG
 /* Identical to above, but mark only from dirty pages  */
 struct hblk * GC_push_next_marked_dirty(h)
 struct hblk *h;
 {
     register hdr * hhdr = HDR(h);
     
-    if (!GC_incremental) { ABORT("dirty bits not set up"); }
+    if (!GC_dirty_maintained) { ABORT("dirty bits not set up"); }
     for (;;) {
         h = GC_next_block(h);
         if (h == 0) return(0);
@@ -1002,6 +994,7 @@ struct hblk *h;
     GC_push_marked(h, hhdr);
     return(h + OBJ_SZ_TO_BLOCKS(hhdr -> hb_sz));
 }
+#endif
 
 /* Similar to above, but for uncollectable pages.  Needed since we     */
 /* do not clear marks for such pages, even for full collections.       */
@@ -1021,3 +1014,4 @@ struct hblk *h;
     return(h + OBJ_SZ_TO_BLOCKS(hhdr -> hb_sz));
 }
 
+
diff --git a/mark_roots.c b/mark_roots.c
deleted file mode 100644 (file)
index 81d6589..0000000
+++ /dev/null
@@ -1,329 +0,0 @@
-# include <stdio.h>
-# include "gc_private.h"
-
-# ifdef PCR
-#   define MAX_ROOT_SETS 1024
-#   include "il/PCR_IL.h"
-#   include "th/PCR_ThCtl.h"
-#   include "mm/PCR_MM.h"
-# else
-#   define MAX_ROOT_SETS 64
-# endif
-
-/* Data structure for list of root sets.                               */
-/* We keep a hash table, so that we can filter out duplicate additions.        */
-struct roots {
-       ptr_t r_start;
-       ptr_t r_end;
-       struct roots * r_next;
-};
-
-static struct roots static_roots[MAX_ROOT_SETS];
-
-static n_root_sets = 0;
-
-       /* static_roots[0..n_root_sets) contains the valid root sets. */
-
-#define RT_SIZE 64  /* Power of 2, may be != MAX_ROOT_SETS */
-#define LOG_RT_SIZE 6
-
-static struct roots * root_index[RT_SIZE];
-       /* Hash table header.  Used only to check whether a range is    */
-       /* already present.                                             */
-
-static int rt_hash(addr)
-char * addr;
-{
-    word result = (word) addr;
-#   if CPP_WORDSZ > 8*LOG_RT_SIZE
-       result ^= result >> 8*LOG_RT_SIZE;
-#   endif
-#   if CPP_WORDSZ > 4*LOG_RT_SIZE
-       result ^= result >> 4*LOG_RT_SIZE;
-#   endif
-    result ^= result >> 2*LOG_RT_SIZE;
-    result ^= result >> LOG_RT_SIZE;
-    result &= (RT_SIZE-1);
-    return(result);
-}
-
-/* Is a range starting at b already in the table? If so return a       */
-/* pointer to it, else NIL.                                            */
-struct roots * GC_roots_present(b)
-char *b;
-{
-    register int h = rt_hash(b);
-    register struct roots *p = root_index[h];
-    
-    while (p != 0) {
-        if (p -> r_start == (ptr_t)b) return(p);
-        p = p -> r_next;
-    }
-    return(FALSE);
-}
-
-/* Add the given root structure to the index. */
-static void add_roots_to_index(p)
-struct roots *p;
-{
-    register int h = rt_hash(p -> r_start);
-    
-    p -> r_next = root_index[h];
-    root_index[h] = p;
-}
-
-
-word GC_root_size = 0;
-
-void GC_add_roots(b, e)
-char * b; char * e;
-{
-    DCL_LOCK_STATE;
-    
-    DISABLE_SIGNALS();
-    LOCK();
-    GC_add_roots_inner(b, e);
-    UNLOCK();
-    ENABLE_SIGNALS();
-}
-
-
-/* Add [b,e) to the root set.  Adding the same interval a second time  */
-/* is a moderately fast noop, and hence benign.  We do not handle      */
-/* different but overlapping intervals efficiently.  (We do handle     */
-/* them correctly.)                                                    */
-void GC_add_roots_inner(b, e)
-char * b; char * e;
-{
-    struct roots * old;
-    
-    /* We exclude GC data structures from root sets.  It's usually safe        */
-    /* to mark from those, but it is a waste of time.                  */
-    if ( (ptr_t)b < beginGC_arrays && (ptr_t)e > beginGC_arrays) {
-        if ((ptr_t)e <= endGC_arrays) {
-            e = (char *)beginGC_arrays;
-        } else {
-            GC_add_roots_inner(b, (char *)beginGC_arrays);
-            GC_add_roots_inner((char *)endGC_arrays, e);
-            return;
-        }
-    } else if ((ptr_t)b < endGC_arrays && (ptr_t)e > endGC_arrays) {
-        b = (char *)endGC_arrays;
-    }
-    old = GC_roots_present(b);
-    if (old != 0) {
-        if ((ptr_t)e <= old -> r_end) /* already there */ return;
-        /* else extend */
-        GC_root_size += (ptr_t)e - old -> r_end;
-        old -> r_end = (ptr_t)e;
-        return;
-    }
-    if (n_root_sets == MAX_ROOT_SETS) {
-        ABORT("Too many root sets\n");
-    }
-    static_roots[n_root_sets].r_start = (ptr_t)b;
-    static_roots[n_root_sets].r_end = (ptr_t)e;
-    static_roots[n_root_sets].r_next = 0;
-    add_roots_to_index(static_roots + n_root_sets);
-    GC_root_size += (ptr_t)e - (ptr_t)b;
-    n_root_sets++;
-}
-
-void GC_clear_roots()
-{
-    DCL_LOCK_STATE;
-    
-    DISABLE_SIGNALS();
-    LOCK();
-    n_root_sets = 0;
-    GC_root_size = 0;
-    UNLOCK();
-    ENABLE_SIGNALS();
-}
-
-# ifdef THREADS
-#   ifdef PCR
-PCR_ERes GC_push_thread_stack(PCR_Th_T *t, PCR_Any dummy)
-{
-    struct PCR_ThCtl_TInfoRep info;
-    PCR_ERes result;
-    
-    info.ti_stkLow = info.ti_stkHi = 0;
-    result = PCR_ThCtl_GetInfo(t, &info);
-    GC_push_all_stack((ptr_t)(info.ti_stkLow), (ptr_t)(info.ti_stkHi));
-    return(result);
-}
-
-/* Push the contents of an old object. We treat this as stack  */
-/* data only becasue that makes it robust against mark stack   */
-/* overflow.                                                   */
-PCR_ERes GC_push_old_obj(void *p, size_t size, PCR_Any data)
-{
-    GC_push_all_stack((ptr_t)p, (ptr_t)p + size);
-    return(PCR_ERes_okay);
-}
-#   endif
-
-#   ifdef SRC_M3
-extern void ThreadF__ProcessStacks();
-
-void GC_push_thread_stack(start, stop)
-word start, stop;
-{
-   GC_push_all_stack((ptr_t)start, (ptr_t)stop + sizeof(word));
-}
-#   endif
-
-# else /* ! THREADS */
-ptr_t GC_approx_sp()
-{
-    word dummy;
-    
-    return((ptr_t)(&dummy));
-}
-# endif
-
-# ifdef SRC_M3
-# ifdef ALL_INTERIOR_POINTERS
-    --> misconfigured
-# endif
-/* Push routine with M3 specific calling convention. */
-GC_m3_push_root(dummy1, p, dummy2, dummy3)
-word *p;
-ptr_t dummy1, dummy2;
-int dummy3;
-{
-    word q = *p;
-    
-    if ((ptr_t)(q) >= GC_least_plausible_heap_addr
-        && (ptr_t)(q) < GC_greatest_plausible_heap_addr) {
-        GC_push_one_checked(q,FALSE);
-    }
-}
-
-/* M3 set equivalent to RTHeap.TracedRefTypes */
-typedef struct { int elts[1]; }  RefTypeSet;
-RefTypeSet GC_TracedRefTypes = {{0x1}};
-
-/* From finalize.c */
-extern void GC_push_finalizer_structures();
-
-/* From stubborn.c: */
-# ifdef STUBBORN_ALLOC
-    extern extern_ptr_t * GC_changing_list_start;
-# endif
-# endif
-
-/*
- * Call the mark routines (GC_tl_push for a single pointer, GC_push_conditional
- * on groups of pointers) on every top level accessible pointer.
- * If all is FALSE, arrange to push only possibly altered values.
- */
-
-void GC_push_roots(all)
-bool all;
-{
-    register int i;
-
-    /*
-     * push registers - i.e., call GC_push_one(r) for each
-     * register contents r.
-     */
-        GC_push_regs(); /* usually defined in machine_dep.c */
-        
-    /*
-     * Next push static data.  This must happen early on, since it's
-     * not robust against mark stack overflow.
-     */
-     /* Reregister dynamic libraries, in case one got added.   */
-#      ifndef SRC_M3
-         GC_register_dynamic_libraries();
-#      endif
-#      ifdef PCR
-        /* Add new static data areas of dynamically loaded modules.    */
-        {
-          PCR_IL_LoadedFile * p = PCR_IL_GetLastLoadedFile();
-          PCR_IL_LoadedSegment * q;
-          
-          /* Skip uncommited files */
-          while (p != NIL && !(p -> lf_commitPoint)) {
-              /* The loading of this file has not yet been committed   */
-              /* Hence its description could be inconsistent.                  */
-              /* Furthermore, it hasn't yet been run.  Hence its data  */
-              /* segments can't possibly reference heap allocated      */
-              /* objects.                                              */
-              p = p -> lf_prev;
-          }
-          for (; p != NIL; p = p -> lf_prev) {
-            for (q = p -> lf_ls; q != NIL; q = q -> ls_next) {
-              if ((q -> ls_flags & PCR_IL_SegFlags_Traced_MASK)
-                  == PCR_IL_SegFlags_Traced_on) {
-                GC_add_roots_inner
-                       ((char *)(q -> ls_addr), 
-                        (char *)(q -> ls_addr) + q -> ls_bytes);
-              }
-            }
-          }
-        }
-#      endif
-     /* Mark everything in static data areas                             */
-       for (i = 0; i < n_root_sets; i++) {
-         GC_push_conditional(static_roots[i].r_start,
-                            static_roots[i].r_end, all);
-       }
-       
-#    ifdef SRC_M3
-       /* Use the M3 provided routine for finding static roots.        */
-       /* This is a bit dubious, since it presumes no C roots. */
-       /* We handle the collector roots explicitly.            */
-       {
-#       ifdef STUBBORN_ALLOC
-           GC_push_one(GC_changing_list_start);
-#       endif
-        GC_push_finalizer_structures();
-        RTMain__GlobalMapProc(GC_m3_push_root, 0, GC_TracedRefTypes);
-       }
-#    endif
-    
-#   ifdef PCR
-       /* Traverse data allocated by previous memory managers.         */
-       {
-         extern struct PCR_MM_ProcsRep * GC_old_allocator;
-         
-         if ((*(GC_old_allocator->mmp_enumerate))(PCR_Bool_false,
-                                                  GC_push_old_obj, all)
-             != PCR_ERes_okay) {
-             ABORT("Old object enumeration failed");
-         }
-       }
-#   endif
-       
-    /*
-     * Now traverse stacks.
-     */
-#   ifdef PCR 
-        /* Traverse all thread stacks. */
-          if (PCR_ERes_IsErr(
-                PCR_ThCtl_ApplyToAllOtherThreads(GC_push_thread_stack,0))
-              || PCR_ERes_IsErr(GC_push_thread_stack(PCR_Th_CurrThread(), 0))) {
-              ABORT("Thread stack marking failed\n");
-          }
-#   endif
-#   ifdef SRC_M3
-       if (GC_words_allocd > 0) {
-           ThreadF__ProcessStacks(GC_push_thread_stack);
-       }
-       /* Otherwise this isn't absolutely necessary, and we have       */
-       /* startup ordering problems.                                   */
-#   endif
-#   ifndef THREADS
-        /* Mark everything on the stack.           */
-#        ifdef STACK_GROWS_DOWN
-           GC_push_all_stack( GC_approx_sp(), GC_stackbottom );
-#        else
-           GC_push_all_stack( GC_stackbottom, GC_approx_sp() );
-#        endif
-#   endif
-
-}
-
diff --git a/mark_rts.c b/mark_rts.c
new file mode 100644 (file)
index 0000000..9aed4ce
--- /dev/null
@@ -0,0 +1,277 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 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.
+ */
+/* Boehm, March 31, 1994 1:19 pm PST */
+# include <stdio.h>
+# include "gc_priv.h"
+
+# ifdef PCR
+#   define MAX_ROOT_SETS 1024
+# else
+#   ifdef MSWIN32
+#      define MAX_ROOT_SETS 512
+           /* Under NT, we add only written pages, which can result    */
+           /* in many small root sets.                                 */
+#   else
+#       define MAX_ROOT_SETS 64
+#   endif
+# endif
+
+/* Data structure for list of root sets.                               */
+/* We keep a hash table, so that we can filter out duplicate additions.        */
+/* Under Win32, we need to do a better job of filtering overlaps, so   */
+/* we resort to sequential search, and pay the price.                  */
+struct roots {
+       ptr_t r_start;
+       ptr_t r_end;
+#      ifndef MSWIN32
+         struct roots * r_next;
+#      endif
+};
+
+static struct roots static_roots[MAX_ROOT_SETS];
+
+static int n_root_sets = 0;
+
+       /* static_roots[0..n_root_sets) contains the valid root sets. */
+
+#ifndef MSWIN32
+#   define LOG_RT_SIZE 6
+#   define RT_SIZE (1 << LOG_RT_SIZE)  /* Power of 2, may be != MAX_ROOT_SETS */
+
+    static struct roots * root_index[RT_SIZE];
+       /* Hash table header.  Used only to check whether a range is    */
+       /* already present.                                             */
+
+static int rt_hash(addr)
+char * addr;
+{
+    word result = (word) addr;
+#   if CPP_WORDSZ > 8*LOG_RT_SIZE
+       result ^= result >> 8*LOG_RT_SIZE;
+#   endif
+#   if CPP_WORDSZ > 4*LOG_RT_SIZE
+       result ^= result >> 4*LOG_RT_SIZE;
+#   endif
+    result ^= result >> 2*LOG_RT_SIZE;
+    result ^= result >> LOG_RT_SIZE;
+    result &= (RT_SIZE-1);
+    return(result);
+}
+
+/* Is a range starting at b already in the table? If so return a       */
+/* pointer to it, else NIL.                                            */
+struct roots * GC_roots_present(b)
+char *b;
+{
+    register int h = rt_hash(b);
+    register struct roots *p = root_index[h];
+    
+    while (p != 0) {
+        if (p -> r_start == (ptr_t)b) return(p);
+        p = p -> r_next;
+    }
+    return(FALSE);
+}
+
+/* Add the given root structure to the index. */
+static void add_roots_to_index(p)
+struct roots *p;
+{
+    register int h = rt_hash(p -> r_start);
+    
+    p -> r_next = root_index[h];
+    root_index[h] = p;
+}
+
+# else /* MSWIN32 */
+
+#   define add_roots_to_index(p)
+
+# endif
+
+
+
+
+word GC_root_size = 0;
+
+void GC_add_roots(b, e)
+char * b; char * e;
+{
+    DCL_LOCK_STATE;
+    
+    DISABLE_SIGNALS();
+    LOCK();
+    GC_add_roots_inner(b, e);
+    UNLOCK();
+    ENABLE_SIGNALS();
+}
+
+
+/* Add [b,e) to the root set.  Adding the same interval a second time  */
+/* is a moderately fast noop, and hence benign.  We do not handle      */
+/* different but overlapping intervals efficiently.  (We do handle     */
+/* them correctly.)                                                    */
+void GC_add_roots_inner(b, e)
+char * b; char * e;
+{
+    struct roots * old;
+    
+    /* We exclude GC data structures from root sets.  It's usually safe        */
+    /* to mark from those, but it is a waste of time.                  */
+    if ( (ptr_t)b < endGC_arrays && (ptr_t)e > beginGC_arrays) {
+        if ((ptr_t)e <= endGC_arrays) {
+            if ((ptr_t)b >= beginGC_arrays) return;
+            e = (char *)beginGC_arrays;
+        } else if ((ptr_t)b >= beginGC_arrays) {
+            b = (char *)endGC_arrays;
+        } else {
+            GC_add_roots_inner(b, (char *)beginGC_arrays);
+            GC_add_roots_inner((char *)endGC_arrays, e);
+            return;
+        }
+    }
+#   ifdef MSWIN32
+      /* Spend the time to ensure that there are no overlapping        */
+      /* or adjacent intervals.                                        */
+      /* This could be done faster with e.g. a                 */
+      /* balanced tree.  But the execution time here is                */
+      /* virtually guaranteed to be dominated by the time it   */
+      /* takes to scan the roots.                              */
+      {
+        register int i;
+        
+        for (i = 0; i < n_root_sets; i++) {
+            old = static_roots + i;
+            if ((ptr_t)b <= old -> r_end && (ptr_t)e >= old -> r_start) {
+                if ((ptr_t)b < old -> r_start) {
+                    old -> r_start = (ptr_t)b;
+                }
+                if ((ptr_t)e > old -> r_end) {
+                    old -> r_end = (ptr_t)e;
+                }
+                break;
+            }
+        }
+        if (i < n_root_sets) {
+          /* merge other overlapping intervals */
+            struct roots *other;
+            
+            for (i++; i < n_root_sets; i++) {
+              other = static_roots + i;
+              b = (char *)(other -> r_start);
+              e = (char *)(other -> r_end);
+              if ((ptr_t)b <= old -> r_end && (ptr_t)e >= old -> r_start) {
+                if ((ptr_t)b < old -> r_start) {
+                    old -> r_start = (ptr_t)b;
+                }
+                if ((ptr_t)e > old -> r_end) {
+                    old -> r_end = (ptr_t)e;
+                }
+                /* Delete this entry. */
+                  other -> r_start = static_roots[n_root_sets-1].r_start;
+                  other -> r_end = static_roots[n_root_sets-1].r_end;
+                  n_root_sets--;
+              }
+            }
+          return;
+        }
+      }
+#   else
+      old = GC_roots_present(b);
+      if (old != 0) {
+        if ((ptr_t)e <= old -> r_end) /* already there */ return;
+        /* else extend */
+        GC_root_size += (ptr_t)e - old -> r_end;
+        old -> r_end = (ptr_t)e;
+        return;
+      }
+#   endif
+    if (n_root_sets == MAX_ROOT_SETS) {
+        ABORT("Too many root sets\n");
+    }
+    static_roots[n_root_sets].r_start = (ptr_t)b;
+    static_roots[n_root_sets].r_end = (ptr_t)e;
+#   ifndef MSWIN32
+      static_roots[n_root_sets].r_next = 0;
+#   endif
+    add_roots_to_index(static_roots + n_root_sets);
+    GC_root_size += (ptr_t)e - (ptr_t)b;
+    n_root_sets++;
+}
+
+void GC_clear_roots()
+{
+    DCL_LOCK_STATE;
+    
+    DISABLE_SIGNALS();
+    LOCK();
+    n_root_sets = 0;
+    GC_root_size = 0;
+    UNLOCK();
+    ENABLE_SIGNALS();
+}
+
+# ifndef THREADS
+ptr_t GC_approx_sp()
+{
+    word dummy;
+    
+    return((ptr_t)(&dummy));
+}
+# endif
+
+/*
+ * Call the mark routines (GC_tl_push for a single pointer, GC_push_conditional
+ * on groups of pointers) on every top level accessible pointer.
+ * If all is FALSE, arrange to push only possibly altered values.
+ */
+
+void GC_push_roots(all)
+bool all;
+{
+    register int i;
+
+    /*
+     * push registers - i.e., call GC_push_one(r) for each
+     * register contents r.
+     */
+        GC_push_regs(); /* usually defined in machine_dep.c */
+        
+    /*
+     * Next push static data.  This must happen early on, since it's
+     * not robust against mark stack overflow.
+     */
+     /* Reregister dynamic libraries, in case one got added.   */
+#      if (defined(DYNAMIC_LOADING) || defined(MSWIN32) || defined(PCR)) \
+           && !defined(SRC_M3)
+         GC_register_dynamic_libraries();
+#      endif
+     /* Mark everything in static data areas                             */
+       for (i = 0; i < n_root_sets; i++) {
+         GC_push_conditional(static_roots[i].r_start,
+                            static_roots[i].r_end, all);
+       }
+
+    /*
+     * Now traverse stacks.
+     */
+#   ifndef THREADS
+        /* Mark everything on the stack.           */
+#        ifdef STACK_GROWS_DOWN
+           GC_push_all_stack( GC_approx_sp(), GC_stackbottom );
+#        else
+           GC_push_all_stack( GC_stackbottom, GC_approx_sp() );
+#        endif
+#   endif
+    if (GC_push_other_roots != 0) (*GC_push_other_roots)();
+       /* In the threads case, this also pushes thread stacks. */
+}
+
diff --git a/misc.c b/misc.c
index 139605b..1d72b9c 100644 (file)
--- a/misc.c
+++ b/misc.c
@@ -1,6 +1,6 @@
 /* 
  * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
- * Copyright (c) 1991-1993 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1991-1994 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.
@@ -8,7 +8,7 @@
  * Permission is hereby granted to copy this garbage collector for any purpose,
  * provided the above notices are retained on all copies.
  */
-/* Boehm, March 14, 1994 3:21 pm PST */
+/* Boehm, April 6, 1994 11:53 am PDT */
 
 #define DEBUG       /* Some run-time consistency checks */
 #undef DEBUG
@@ -18,7 +18,7 @@
 #include <stdio.h>
 #include <signal.h>
 #define I_HIDE_POINTERS        /* To make GC_call_with_alloc_lock visible */
-#include "gc_private.h"
+#include "gc_priv.h"
 
 # ifdef THREADS
 #   ifdef PCR
        /* Critical section counter is defined in the M3 runtime        */
        /* That's all we use.                                           */
 #     else
-       --> declare allocator lock here
+#      ifdef SOLARIS_THREADS
+         mutex_t GC_allocate_ml;       /* Implicitly initialized.      */
+#      else
+         --> declare allocator lock here
+#      endif
 #     endif
 #   endif
 # endif
 
-FAR struct _GC_arrays GC_arrays = { 0 };
-
-/* Initialize GC_obj_kinds properly and standard free lists properly.          */
-/* This must be done statically since they may be accessed before      */
-/* GC_init is called.                                                  */
-struct obj_kind GC_obj_kinds[MAXOBJKINDS] = {
-/* PTRFREE */ { &GC_aobjfreelist[0], &GC_areclaim_list[0],
-               GC_no_mark_proc, FALSE },
-/* NORMAL  */ { &GC_objfreelist[0], &GC_reclaim_list[0],
-               GC_normal_mark_proc, TRUE },
-/* UNCOLLECTABLE */
-             { &GC_uobjfreelist[0], &GC_ureclaim_list[0],
-               GC_normal_mark_proc, TRUE },
-# ifdef STUBBORN_ALLOC
-/*STUBBORN*/ { &GC_sobjfreelist[0], &GC_sreclaim_list[0],
-               GC_normal_mark_proc, TRUE },
-# endif
-};
+GC_FAR struct _GC_arrays GC_arrays = { 0 };
 
-# ifdef STUBBORN_ALLOC
-  int GC_n_kinds = 4;
-# else
-  int GC_n_kinds = 3;
-# endif
 
 bool GC_debugging_started = FALSE;
        /* defined here so we don't have to load debug_malloc.o */
@@ -98,6 +80,9 @@ extern signed_word GC_mem_found;
              GC_size_map[i] = ROUNDED_UP_WORDS(i);
 #           endif
        }
+       for (i = 8*sizeof(word) + 1; i <= 16 * sizeof(word); i++) {
+             GC_size_map[i] = (ROUNDED_UP_WORDS(i) + 1) & (~1);
+       }
        /* We leave the rest of the array to be filled in on demand. */
     }
     
@@ -118,7 +103,7 @@ extern signed_word GC_mem_found;
        word much_smaller_than_i = byte_sz - (byte_sz >> 2);
        register word low_limit;        /* The lowest indexed entry we  */
                                        /* initialize.                  */
-       register int j;
+       register word j;
        
        if (GC_size_map[smaller_than_i] == 0) {
            low_limit = much_smaller_than_i;
@@ -138,7 +123,7 @@ extern signed_word GC_mem_found;
            word_sz = MAXOBJSZ;
        }
        byte_sz = WORDS_TO_BYTES(word_sz);
-#      ifdef ALL_INTERIOR_POINTERS
+#      ifdef ADD_BYTE_AT_END
            /* We need one extra byte; don't fill in GC_size_map[byte_sz] */
            byte_sz--;
 #      endif
@@ -202,7 +187,7 @@ word limit;
 {
     word dummy[CLEAR_SIZE];
     
-    bzero((char *)dummy, (int)(CLEAR_SIZE*sizeof(word)));
+    BZERO(dummy, CLEAR_SIZE*sizeof(word));
     if ((word)(dummy) COOLER_THAN limit) {
         (void) GC_clear_stack_inner(arg, limit);
     }
@@ -242,7 +227,7 @@ ptr_t arg;
        /* thus more junk remains accessible, thus the heap gets        */
        /* larger ...                                                   */
 # ifdef THREADS
-    bzero((char *)dummy, (int)(CLEAR_SIZE*sizeof(word)));
+    BZERO(dummy, CLEAR_SIZE*sizeof(word));
 # else
     if (GC_gc_no > GC_stack_last_cleared) {
         /* Start things over, so we clear the entire stack again */
@@ -341,6 +326,11 @@ ptr_t arg;
     }
 }
 
+size_t GC_get_heap_size()
+{
+    return ((size_t) GC_heapsize);
+}
+
 bool GC_is_initialized = FALSE;
 
 void GC_init()
@@ -355,13 +345,24 @@ void GC_init()
 
 }
 
+#ifdef MSWIN32
+    extern void GC_init_win32();
+#endif
+
 void GC_init_inner()
 {
     word dummy;
     
     if (GC_is_initialized) return;
     GC_is_initialized = TRUE;
-#   ifndef THREADS
+#   ifdef MSWIN32
+       GC_init_win32();
+#   endif
+#   ifdef SOLARIS_THREADS
+       /* We need dirty bits in order to find live stack sections.     */
+        GC_dirty_init();
+#   endif
+#   if !defined(THREADS) || defined(SOLARIS_THREADS)
       if (GC_stackbottom == 0) {
        GC_stackbottom = GC_get_stack_base();
       }
@@ -467,6 +468,10 @@ void GC_enable_incremental()
 # ifndef FIND_LEAK
     DISABLE_SIGNALS();
     LOCK();
+    if (GC_incremental) goto out;
+#   ifndef SOLARIS_THREADS
+        GC_dirty_init();
+#   endif
     if (!GC_is_initialized) {
         GC_init_inner();
     }
@@ -482,14 +487,42 @@ void GC_enable_incremental()
     }   /* else we're OK in assuming everything's      */
        /* clean since nothing can point to an          */
        /* unmarked object.                             */
-    GC_dirty_init();
     GC_read_dirty();
     GC_incremental = TRUE;
+out:
     UNLOCK();
     ENABLE_SIGNALS();
 # endif
 }
 
+#if defined(OS2) || defined(MSWIN32)
+    FILE * GC_stdout = NULL;
+    FILE * GC_stderr = NULL;
+#endif
+
+#ifdef MSWIN32
+  void GC_set_files()
+  {
+    if (GC_stdout == NULL) {
+       GC_stdout = fopen("gc.log", "wt");
+    }
+    if (GC_stderr == NULL) {
+       GC_stderr = GC_stdout;
+    }
+  }
+#endif
+
+#ifdef OS2
+  void GC_set_files()
+  {
+      if (GC_stdout == NULL) {
+       GC_stdout = stdout;
+    }
+    if (GC_stderr == NULL) {
+       GC_stderr = stderr;
+    }
+#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.        */
@@ -506,10 +539,12 @@ long a, b, c, d, e, f;
     buf[1024] = 0x15;
     (void) sprintf(buf, format, a, b, c, d, e, f);
     if (buf[1024] != 0x15) ABORT("GC_printf clobbered stack");
-#   ifdef OS2
+#   if defined(OS2) || defined(MSWIN32)
+      GC_set_files();
       /* We hope this doesn't allocate */
-      if (fwrite(buf, 1, strlen(buf), stdout) != strlen(buf))
+      if (fwrite(buf, 1, strlen(buf), GC_stdout) != strlen(buf))
           ABORT("write to stdout failed");
+      fflush(GC_stdout);
 #   else
       if (write(1, buf, strlen(buf)) < 0) ABORT("write to stdout failed");
 #   endif
@@ -524,10 +559,12 @@ long a, b, c, d, e, f;
     buf[1024] = 0x15;
     (void) sprintf(buf, format, a, b, c, d, e, f);
     if (buf[1024] != 0x15) ABORT("GC_err_printf clobbered stack");
-#   ifdef OS2
+#   if defined(OS2) || defined(MSWIN32)
+      GC_set_files();
       /* We hope this doesn't allocate */
-      if (fwrite(buf, 1, strlen(buf), stderr) != strlen(buf))
+      if (fwrite(buf, 1, strlen(buf), GC_stderr) != strlen(buf))
           ABORT("write to stderr failed");
+      fflush(GC_stderr);
 #   else
       if (write(2, buf, strlen(buf)) < 0) ABORT("write to stderr failed");
 #   endif
@@ -536,15 +573,26 @@ long a, b, c, d, e, f;
 void GC_err_puts(s)
 char *s;
 {
-#   ifdef OS2
+#   if defined(OS2) || defined(MSWIN32)
+      GC_set_files();
       /* We hope this doesn't allocate */
-      if (fwrite(s, 1, strlen(s), stderr) != strlen(s))
+      if (fwrite(s, 1, strlen(s), GC_stderr) != strlen(s))
           ABORT("write to stderr failed");
+      fflush(GC_stderr);
 #   else
       if (write(2, s, strlen(s)) < 0) ABORT("write to stderr failed");
 #   endif
 }
 
+#ifndef PCR
+void GC_abort(msg)
+char * msg;
+{
+    GC_err_printf1("%s\n", msg);
+    (void) abort();
+}
+#endif
+
 # ifdef SRC_M3
 void GC_enable()
 {
index 78b5bf5..e93441c 100644 (file)
@@ -1,6 +1,6 @@
 /*
  * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
- * Copyright (c) 1991,1992 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1991-1994 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.
  *     ptr_t GC_build_flXXX(h, old_fl)
  *     void GC_new_hblk(n)
  */
-/* Boehm, December 17, 1993 11:53 am PST */
+/* Boehm, April 1, 1994 5:42 pm PST */
 
 
 # include <stdio.h>
-# include "gc_private.h"
+# include "gc_priv.h"
 
+#ifndef SMALL_CONFIG
 /*
  * Build a free list for size 1 objects inside hblk h.  Set the last link to
  * be ofl.  Return a pointer tpo the first free list entry.
@@ -143,6 +144,7 @@ ptr_t ofl;
     return((ptr_t)(p-4));
 }
 
+#endif /* !SMALL_CONFIG */
 
 /*
  * Allocate a new heapblock for small objects of size n.
@@ -171,6 +173,7 @@ int kind;
 
   /* Handle small objects sizes more efficiently.  For larger objects  */
   /* the difference is less significant.                               */
+#  ifndef SMALL_CONFIG
     switch (sz) {
         case 1: GC_obj_kinds[kind].ok_freelist[1] =
                  GC_build_fl1(h, GC_obj_kinds[kind].ok_freelist[1]);
@@ -202,15 +205,17 @@ int kind;
         default:
                break;
     }
+#  endif /* !SMALL_CONFIG */
     
   /* Clear the page if necessary. */
-    if (clear) bzero((char *)h, (int)HBLKSIZE);
+    if (clear) BZERO(h, HBLKSIZE);
     
   /* Add objects to free list */
     p = &(h -> hb_body[sz]);   /* second object in *h  */
     prev = &(h -> hb_body[0]);         /* One object behind p  */
     last_object = (word *)((char *)h + HBLKSIZE);
-    last_object -= sz;  /* Last place for last object to start */
+    last_object -= 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) {
index 40b2d88..c86dcc5 100644 (file)
--- a/obj_map.c
+++ b/obj_map.c
@@ -8,16 +8,15 @@
  * Permission is hereby granted to copy this garbage collector for any purpose,
  * provided the above notices are retained on all copies.
  */
+/* Boehm, February 24, 1994 3:55 pm PST */
   
 /* Routines for maintaining maps describing heap block
  * layouts for various object sizes.  Allows fast pointer validity checks
  * and fast location of object start locations on machines (such as SPARC)
  * with slow division.
- *
- * Boehm, February 6, 1992 1:00:09 pm PST
  */
  
-# include "gc_private.h"
+# include "gc_priv.h"
 
 char * GC_invalid_map = 0;
 
@@ -62,7 +61,7 @@ void GC_register_displacement_inner(offset)
 word offset;
 {
 # ifndef ALL_INTERIOR_POINTERS
-    register int i;
+    register unsigned i;
     
     if (offset > MAX_OFFSET) {
         ABORT("Bad argument to GC_register_displacement");
@@ -73,14 +72,14 @@ word offset;
       for (i = 0; i <= MAXOBJSZ; i++) {
           if (GC_obj_map[i] != 0) {
              if (i == 0) {
-               GC_obj_map[i][offset + HDR_BYTES] = BYTES_TO_WORDS(offset);
+               GC_obj_map[i][offset + HDR_BYTES] = (char)BYTES_TO_WORDS(offset);
              } else {
-               register int j;
-               register int lb = WORDS_TO_BYTES(i);
+               register unsigned j;
+               register unsigned lb = WORDS_TO_BYTES(i);
                
                if (offset < lb) {
                  for (j = offset + HDR_BYTES; j < HBLKSIZE; j += lb) {
-                   GC_obj_map[i][j] = BYTES_TO_WORDS(offset);
+                   GC_obj_map[i][j] = (char)BYTES_TO_WORDS(offset);
                  }
                }
              }
@@ -96,8 +95,8 @@ word offset;
 bool GC_add_map_entry(sz)
 word sz;
 {
-    register int obj_start;
-    register int displ;
+    register unsigned obj_start;
+    register unsigned displ;
     register char * new_map;
     
     if (sz > MAXOBJSZ) sz = 0;
index f713c61..828de36 100644 (file)
--- a/os_dep.c
+++ b/os_dep.c
@@ -1,5 +1,5 @@
 /*
- * Copyright (c) 1991-1993 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1991-1994 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.
@@ -7,17 +7,21 @@
  * Permission is hereby granted to copy this garbage collector for any purpose,
  * provided the above notices are retained on all copies.
  */
-/* Boehm, December 16, 1993 4:25 pm PST */
+/* Boehm, April 4, 1994 3:08 pm PDT */
 # if !defined(OS2) && !defined(PCR) && !defined(AMIGA)
 #   include <sys/types.h>
 # endif
-# include "gc_private.h"
+# include "gc_priv.h"
 # include <stdio.h>
 # include <signal.h>
 
 /* Blatantly OS dependent routines, except for those that are related  */
 /* dynamic loading.                                                    */
 
+#ifdef FREEBSD
+#  include <machine/trap.h>
+#endif
+
 #ifdef AMIGA
 # include <proto/exec.h>
 # include <proto/dos.h>
 # include <workbench/startup.h>
 #endif
 
+#ifdef MSWIN32
+# define WIN32_LEAN_AND_MEAN
+# define NOSERVICE
+# include <windows.h>
+#endif
+
 #ifdef IRIX5
 # include <sys/uio.h>
 #endif
 
+#ifdef PCR
+# include "il/PCR_IL.h"
+# include "th/PCR_ThCtl.h"
+# include "mm/PCR_MM.h"
+#endif
+
 # ifdef OS2
 
+# include <stddef.h>
+
 # ifndef __IBMC__ /* e.g. EMX */
 
 struct exe_hdr {
@@ -91,6 +109,7 @@ struct o32_obj {
 # define INCL_DOSPROCESS
 # define INCL_DOSERRORS
 # define INCL_DOSMODULEMGR
+# define INCL_DOSMEMMGR
 # include <os2.h>
 
 /* A kludge to get around what appears to be a header file bug */
@@ -128,7 +147,7 @@ void GC_enable_signals(void)
 
 # else
 
-#  if !defined(PCR) && !defined(AMIGA)
+#  if !defined(PCR) && !defined(AMIGA) && !defined(MSWIN32)
 
 #   ifdef sigmask
        /* Use the traditional BSD interface */
@@ -155,6 +174,11 @@ static SIGSET_T old_mask;
 
 static SIGSET_T dummy;
 
+#if defined(PRINTSTATS) && !defined(THREADS)
+# define CHECK_SIGNALS
+  int GC_sig_disabled = 0;
+#endif
+
 void GC_disable_signals()
 {
     if (!mask_initialized) {
@@ -176,12 +200,20 @@ void GC_disable_signals()
            SIG_DEL(new_mask, SIGTRAP);
 #      endif 
        mask_initialized = TRUE;
-    }     
+    }
+#   ifdef CHECK_SIGNALS
+       if (GC_sig_disabled != 0) ABORT("Nested disables");
+       GC_sig_disabled++;
+#   endif
     SIGSETMASK(old_mask,new_mask);
 }
 
 void GC_enable_signals()
 {
+#   ifdef CHECK_SIGNALS
+       if (GC_sig_disabled != 1) ABORT("Unmatched enable");
+       GC_sig_disabled--;
+#   endif
     SIGSETMASK(dummy,old_mask);
 }
 
@@ -195,6 +227,59 @@ void GC_enable_signals()
  * With threads, GC_mark_roots needs to know how to do this.
  * Called with allocator lock held.
  */
+# ifdef MSWIN32
+
+/* Get the page size.  */
+word GC_page_size = 0;
+
+word GC_get_page_size()
+{
+    SYSTEM_INFO sysinfo;
+    
+    if (GC_page_size == 0) {
+        GetSystemInfo(&sysinfo);
+        GC_page_size = sysinfo.dwPageSize;
+    }
+    return(GC_page_size);
+}
+
+# define is_writable(prot) ((prot) == PAGE_READWRITE \
+                           || (prot) == PAGE_WRITECOPY \
+                           || (prot) == PAGE_EXECUTE_READWRITE \
+                           || (prot) == PAGE_EXECUTE_WRITECOPY)
+/* Return the number of bytes that are writable starting at p. */
+/* The pointer p is assumed to be page aligned.                        */
+/* If base is not 0, *base becomes the beginning of the        */
+/* allocation region containing p.                             */
+word GC_get_writable_length(ptr_t p, ptr_t *base)
+{
+    MEMORY_BASIC_INFORMATION buf;
+    word result;
+    word protect;
+    
+    result = VirtualQuery(p, &buf, sizeof(buf));
+    if (result != sizeof(buf)) ABORT("Weird VirtualQuery result");
+    if (base != 0) *base = (ptr_t)(buf.AllocationBase);
+    protect = (buf.Protect & ~(PAGE_GUARD | PAGE_NOCACHE));
+    if (!is_writable(protect)) {
+        return(0);
+    }
+    if (buf.State != MEM_COMMIT) return(0);
+    return(buf.RegionSize);
+}
+
+ptr_t GC_get_stack_base()
+{
+    int dummy;
+    ptr_t sp = (ptr_t)(&dummy);
+    ptr_t trunc_sp = (ptr_t)((word)sp & ~(GC_get_page_size() - 1));
+    word size = GC_get_writable_length(trunc_sp, 0);
+   
+    return(trunc_sp + size);
+}
+
+
+# else
 
 # ifdef OS2
 
@@ -344,6 +429,7 @@ ptr_t GC_get_stack_base()
 
 # endif /* ! AMIGA */
 # endif /* ! OS2 */
+# endif /* ! MSWIN32 */
 
 /*
  * Register static data segment(s) as roots.
@@ -444,6 +530,105 @@ void GC_register_data_segments()
 }
 
 # else
+
+# ifdef MSWIN32
+  /* Unfortunately, we have to handle win32s very differently from NT,         */
+  /* Since VirtualQuery has very different semantics.  In particular,  */
+  /* under win32s a VirtualQuery call on an unmapped page returns an   */
+  /* invalid result.  Under GC_register_data_segments is a noop and    */
+  /* all real work is done by GC_register_dynamic_libraries.  Under    */
+  /* win32s, we cannot find the data segments associated with dll's.   */
+  /* We rgister the main data segment here.                            */
+  bool GC_win32s = FALSE;      /* We're running under win32s.  */
+  
+  void GC_init_win32()
+  {
+      if (GetVersion() & 0x80000000) GC_win32s = TRUE;
+  }
+  
+  /* Return the smallest address a such that VirtualQuery              */
+  /* returns correct results for all addresses between a and start.    */
+  /* Assumes VirtualQuery returns correct information for start.       */
+  ptr_t GC_least_described_address(ptr_t start)
+  {  
+    MEMORY_BASIC_INFORMATION buf;
+    SYSTEM_INFO sysinfo;
+    DWORD result;
+    LPVOID limit;
+    ptr_t p;
+    LPVOID q;
+    
+    GetSystemInfo(&sysinfo);
+    limit = sysinfo.lpMinimumApplicationAddress;
+    p = (ptr_t)((word)start & ~(GC_get_page_size() - 1));
+    for (;;) {
+       q = (LPVOID)(p - GC_get_page_size());
+       if ((ptr_t)q > (ptr_t)p /* underflow */ || q < limit) break;
+       result = VirtualQuery(q, &buf, sizeof(buf));
+       if (result != sizeof(buf)) break;
+       p = (ptr_t)(buf.AllocationBase);
+    }
+    return(p);
+  }
+  
+  /* Is p the start of either the malloc heap, or of one of our */
+  /* heap sections?                                            */
+  bool GC_is_heap_base (ptr_t p)
+  {
+     static ptr_t malloc_heap_pointer = 0;
+     register unsigned i;
+     register DWORD result;
+     
+     if (malloc_heap_pointer = 0) {
+        MEMORY_BASIC_INFORMATION buf;
+        result = VirtualQuery(malloc(1), &buf, sizeof(buf));
+        if (result != sizeof(buf)) {
+            ABORT("Weird VirtualQuery result");
+        }
+        malloc_heap_pointer = (ptr_t)(buf.AllocationBase);
+     }
+     if (p == malloc_heap_pointer) return(TRUE);
+     for (i = 0; i < GC_n_heap_bases; i++) {
+         if (GC_heap_bases[i] == p) return(TRUE);
+     }
+     return(FALSE);
+  }
+  
+  void GC_register_data_segments()
+  {
+      MEMORY_BASIC_INFORMATION buf;
+      SYSTEM_INFO sysinfo;
+      DWORD result;
+      DWORD protect;
+      LPVOID p;
+      char * base;
+      char * limit, * new_limit;
+      static char dummy;
+    
+      if (!GC_win32s) return;
+      p = base = limit = GC_least_described_address((ptr_t)(&dummy));
+      GetSystemInfo(&sysinfo);
+      while (p < sysinfo.lpMaximumApplicationAddress) {
+        result = VirtualQuery(p, &buf, sizeof(buf));
+        if (result != sizeof(buf) || GC_is_heap_base(buf.AllocationBase)) break;
+        new_limit = (char *)p + buf.RegionSize;
+        protect = buf.Protect;
+        if (buf.State == MEM_COMMIT
+            && is_writable(protect)) {
+            if ((char *)p == limit) {
+                limit = new_limit;
+            } else {
+                if (base != limit) GC_add_roots_inner(base, limit);
+                base = p;
+                limit = new_limit;
+            }
+        }
+        if (p > (LPVOID)new_limit /* overflow */) break;
+        p = (LPVOID)new_limit;
+      }
+      if (base != limit) GC_add_roots_inner(base, limit);
+  }
+# else
 # ifdef AMIGA
 
   void GC_register_data_segments()
@@ -500,9 +685,14 @@ void GC_register_data_segments()
 }
 
 # endif  /* ! AMIGA */
+# endif  /* ! MSWIN32 */
 # endif  /* ! OS2 */
 
-# if !defined(OS2) && !defined(PCR) && !defined(AMIGA)
+/*
+ * Auxiliary routines for obtaining memory from OS.
+ */
+# if !defined(OS2) && !defined(PCR) && !defined(AMIGA) && !defined(MSWIN32)
 
 extern caddr_t sbrk();
 # ifdef __STDC__
@@ -528,6 +718,181 @@ word bytes;
 
 # endif
 
+# ifdef __OS2__
+
+void * os2_alloc(size_t bytes)
+{
+    void * result;
+
+    if (DosAllocMem(&result, bytes, PAG_EXECUTE | PAG_READ |
+                                   PAG_WRITE | PAG_COMMIT)
+                   != NO_ERROR) {
+       return(0);
+    }
+    if (result == 0) return(os2_alloc(bytes));
+    return(result);
+}
+
+# endif /* OS2 */
+
+
+# ifdef MSWIN32
+word GC_n_heap_bases = 0;
+
+ptr_t GC_win32_get_mem(bytes)
+word bytes;
+{
+    ptr_t result;
+    
+    if (GC_win32s) {
+       /* VirtualAlloc doesn't like PAGE_EXECUTE_READWRITE.    */
+       /* There are also unconfirmed rumors of other           */
+       /* problems, so we dodge the issue.                     */
+        result = (ptr_t) GlobalAlloc(0, bytes + HBLKSIZE);
+        result = (ptr_t)(((word)result + HBLKSIZE) & ~(HBLKSIZE-1));
+    } else {
+        result = (ptr_t) VirtualAlloc(NULL, bytes,
+                                     MEM_COMMIT | MEM_RESERVE,
+                                     PAGE_EXECUTE_READWRITE);
+    }
+    if (HBLKDISPL(result) != 0) ABORT("Bad VirtualAlloc result");
+       /* If I read the documentation correctly, this can      */
+       /* only happen if HBLKSIZE > 64k or not a power of 2.   */
+    if (GC_n_heap_bases >= MAX_HEAP_SECTS) ABORT("Too many heap sections");
+    GC_heap_bases[GC_n_heap_bases++] = result;
+    return(result);                      
+}
+
+# endif
+
+/* Routine for pushing any additional roots.  In THREADS       */
+/* environment, this is also responsible for marking from      */
+/* thread stacks.  In the SRC_M3 case, it also handles         */
+/* global variables.                                           */
+#ifndef THREADS
+void (*GC_push_other_roots)() = 0;
+#else /* THREADS */
+
+# ifdef PCR
+PCR_ERes GC_push_thread_stack(PCR_Th_T *t, PCR_Any dummy)
+{
+    struct PCR_ThCtl_TInfoRep info;
+    PCR_ERes result;
+    
+    info.ti_stkLow = info.ti_stkHi = 0;
+    result = PCR_ThCtl_GetInfo(t, &info);
+    GC_push_all_stack((ptr_t)(info.ti_stkLow), (ptr_t)(info.ti_stkHi));
+    return(result);
+}
+
+/* Push the contents of an old object. We treat this as stack  */
+/* data only becasue that makes it robust against mark stack   */
+/* overflow.                                                   */
+PCR_ERes GC_push_old_obj(void *p, size_t size, PCR_Any data)
+{
+    GC_push_all_stack((ptr_t)p, (ptr_t)p + size);
+    return(PCR_ERes_okay);
+}
+
+
+void GC_default_push_other_roots()
+{
+    /* Traverse data allocated by previous memory managers.            */
+       {
+         extern struct PCR_MM_ProcsRep * GC_old_allocator;
+         
+         if ((*(GC_old_allocator->mmp_enumerate))(PCR_Bool_false,
+                                                  GC_push_old_obj, all)
+             != PCR_ERes_okay) {
+             ABORT("Old object enumeration failed");
+         }
+       }
+    /* Traverse all thread stacks. */
+       if (PCR_ERes_IsErr(
+                PCR_ThCtl_ApplyToAllOtherThreads(GC_push_thread_stack,0))
+              || PCR_ERes_IsErr(GC_push_thread_stack(PCR_Th_CurrThread(), 0))) {
+              ABORT("Thread stack marking failed\n");
+       }
+}
+
+# endif /* PCR */
+
+# ifdef SRC_M3
+
+# ifdef ALL_INTERIOR_POINTERS
+    --> misconfigured
+# endif
+
+
+extern void ThreadF__ProcessStacks();
+
+void GC_push_thread_stack(start, stop)
+word start, stop;
+{
+   GC_push_all_stack((ptr_t)start, (ptr_t)stop + sizeof(word));
+}
+
+/* Push routine with M3 specific calling convention. */
+GC_m3_push_root(dummy1, p, dummy2, dummy3)
+word *p;
+ptr_t dummy1, dummy2;
+int dummy3;
+{
+    word q = *p;
+    
+    if ((ptr_t)(q) >= GC_least_plausible_heap_addr
+        && (ptr_t)(q) < GC_greatest_plausible_heap_addr) {
+        GC_push_one_checked(q,FALSE);
+    }
+}
+
+/* M3 set equivalent to RTHeap.TracedRefTypes */
+typedef struct { int elts[1]; }  RefTypeSet;
+RefTypeSet GC_TracedRefTypes = {{0x1}};
+
+/* From finalize.c */
+extern void GC_push_finalizer_structures();
+
+/* From stubborn.c: */
+# ifdef STUBBORN_ALLOC
+    extern extern_ptr_t * GC_changing_list_start;
+# endif
+
+
+void GC_default_push_other_roots()
+{
+    /* Use the M3 provided routine for finding static roots.   */
+    /* This is a bit dubious, since it presumes no C roots.    */
+    /* We handle the collector roots explicitly.               */
+       {
+#       ifdef STUBBORN_ALLOC
+           GC_push_one(GC_changing_list_start);
+#       endif
+        GC_push_finalizer_structures();
+        RTMain__GlobalMapProc(GC_m3_push_root, 0, GC_TracedRefTypes);
+       }
+       if (GC_words_allocd > 0) {
+           ThreadF__ProcessStacks(GC_push_thread_stack);
+       }
+       /* Otherwise this isn't absolutely necessary, and we have       */
+       /* startup ordering problems.                                   */
+}
+
+# endif /* SRC_M3 */
+
+# ifdef SOLARIS_THREADS
+
+void GC_default_push_other_roots()
+{
+    GC_push_all_stacks();
+}
+
+# endif /* SOLARIS_THREADS */
+
+void (*GC_push_other_roots)() = GC_default_push_other_roots;
+
+#endif
+
 /*
  * Routines for accessing dirty  bits on virtual pages.
  * We plan to eventaually implement four strategies for doing so:
@@ -549,6 +914,8 @@ word bytes;
  *             or write only to the stack.
  */
  
+bool GC_dirty_maintained;
+
 # ifdef DEFAULT_VDB
 
 /* All of the following assume the allocation lock is held, and        */
@@ -578,7 +945,30 @@ struct hblk *h;
     return(TRUE);
 }
 
-/* A call hints that h is about to be written  */
+/*
+ * The following two routines are typically less crucial.  They matter
+ * most with large dynamic libraries, or if we can't accurately identify
+ * stacks, e.g. under Solaris 2.X.  Otherwise the following default
+ * versions are adequate.
+ */
+/* Could any valid GC heap pointer ever have been written to this page?        */
+/*ARGSUSED*/
+bool GC_page_was_ever_dirty(h)
+struct hblk *h;
+{
+    return(TRUE);
+}
+
+/* Reset the n pages starting at h to "was never dirty" status.        */
+void GC_is_fresh(h, n)
+struct hblk *h;
+word n;
+{
+}
+
+/* A call hints that h is about to be written. */
+/* May speed up some dirty bit implementations.        */
 /*ARGSUSED*/
 void GC_write_hint(h)
 struct hblk *h;
@@ -601,6 +991,7 @@ struct hblk *h;
  * except as a result of a read system call.  This means clients must
  * either ensure that system calls do not touch the heap, or must
  * provide their own wrappers analogous to the one for read.
+ * We assume the page size is a multiple of HBLKSIZE.
  * This implementation is currently SunOS 4.X and IRIX 5.X specific, though we
  * tried to use portable code where easily possible.  It is known
  * not to work under a number of other systems.
@@ -634,28 +1025,46 @@ word addr;
     return(FALSE);
 }
 
+#if defined(SUNOS4) || defined(FREEBSD)
+    typedef void (* SIG_PF)();
+#endif
+
+#if defined(ALPHA) /* OSF1 */
+    typedef void (* SIG_PF)(int);
+#endif
+#if defined(IRIX5) || defined(ALPHA) /* OSF1 */
+    typedef void (* REAL_SIG_PF)(int, int, struct sigcontext *);
+#endif
+
+SIG_PF GC_old_bus_handler;
+SIG_PF GC_old_segv_handler;
+
 /*ARGSUSED*/
-# ifdef SUNOS4
+# if defined (SUNOS4) || defined(FREEBSD)
     void GC_write_fault_handler(sig, code, scp, addr)
     int sig, code;
     struct sigcontext *scp;
     char * addr;
-#   define SIG_OK (sig == SIGSEGV || sig == SIGBUS)
-#   define CODE_OK (FC_CODE(code) == FC_PROT \
-                   || (FC_CODE(code) == FC_OBJERR \
-                       && FC_ERRNO(code) == FC_PROT))
-
-# else
-#   if defined(IRIX5) || defined(ALPHA) /* OSF1 */
-#     include <errno.h>
-      void GC_write_fault_handler(int sig, int code, struct sigcontext *scp)
-#     define SIG_OK (sig == SIGSEGV)
-#     ifdef ALPHA
-#      define SIG_PF void (*)(int)
-#       define CODE_OK (code == 2 /* experimentally determined */)
-#     else
-#       define CODE_OK (code == EACCES)
-#     endif
+#   ifdef SUNOS4
+#     define SIG_OK (sig == SIGSEGV || sig == SIGBUS)
+#     define CODE_OK (FC_CODE(code) == FC_PROT \
+                   || (FC_CODE(code) == FC_OBJERR \
+                      && FC_ERRNO(code) == FC_PROT))
+#   endif
+#   ifdef FREEBSD
+#     define SIG_OK (sig == SIGBUS)
+#     define CODE_OK (code == BUS_PAGE_FAULT)
+#   endif
+# endif
+# if defined(IRIX5) || defined(ALPHA) /* OSF1 */
+#   include <errno.h>
+    void GC_write_fault_handler(int sig, int code, struct sigcontext *scp)
+#   define SIG_OK (sig == SIGSEGV)
+#   ifdef ALPHA
+#     define CODE_OK (code == 2 /* experimentally determined */)
+#   endif
+#   ifdef IRIX5
+#     define CODE_OK (code == EACCES)
 #   endif
 # endif
 {
@@ -672,7 +1081,23 @@ word addr;
                        (struct hblk *)((word)addr & ~(GC_page_size-1));
         
         if (HDR(addr) == 0 && !GC_just_outside_heap((word)addr)) {
-            ABORT("Unexpected bus error or segmentation fault");
+            SIG_PF old_handler;
+            
+            if (sig == SIGSEGV) {
+               old_handler = GC_old_segv_handler;
+            } else {
+                old_handler = GC_old_bus_handler;
+            }
+            if (old_handler == SIG_DFL) {
+                ABORT("Unexpected bus error or segmentation fault");
+            } else {
+#              if defined (SUNOS4) || defined(FREEBSD)
+                 (*old_handler) (sig, code, scp, addr);
+#              else
+                 (*(REAL_SIG_PF)old_handler) (sig, code, scp);
+#              endif
+               return;
+            }
         }
         for (i = 0; i < divHBLKSZ(GC_page_size); i++) {
             register int index = PHT_HASH(h+i);
@@ -721,22 +1146,34 @@ struct hblk *h;
                                 
 void GC_dirty_init()
 {
+    GC_dirty_maintained = TRUE;
     GC_page_size = getpagesize();
     if (GC_page_size % HBLKSIZE != 0) {
         GC_err_printf0("Page size not multiple of HBLKSIZE\n");
         ABORT("Page size not multiple of HBLKSIZE");
     }
-#   ifdef SUNOS4
-      if (signal(SIGBUS, GC_write_fault_handler) != SIG_DFL) {
-        GC_err_printf0("Clobbered other SIGBUS handler\n");
+#   if defined(SUNOS4) || defined(FREEBSD)
+      GC_old_bus_handler = signal(SIGBUS, GC_write_fault_handler);
+      if (GC_old_bus_handler == SIG_IGN) {
+        GC_err_printf0("Previously ignored bus error!?");
+        GC_old_bus_handler == SIG_DFL;
       }
-      if (signal(SIGSEGV, GC_write_fault_handler) != SIG_DFL) {
-        GC_err_printf0("Clobbered other SIGSEGV handler\n");
+      if (GC_old_bus_handler != SIG_DFL) {
+#      ifdef PRINTSTATS
+          GC_err_printf0("Replaced other SIGBUS handler\n");
+#      endif
       }
 #   endif
-#   if defined(IRIX5) || defined(ALPHA)
-      if (signal(SIGSEGV, (SIG_PF)GC_write_fault_handler) != SIG_DFL) {
-        GC_err_printf0("Clobbered other SIGSEGV handler\n");
+#   if defined(IRIX5) || defined(ALPHA) || defined(SUNOS4)
+      GC_old_segv_handler = signal(SIGSEGV, (SIG_PF)GC_write_fault_handler);
+      if (GC_old_segv_handler == SIG_IGN) {
+        GC_err_printf0("Previously ignored segmentation violation!?");
+        GC_old_segv_handler == SIG_DFL;
+      }
+      if (GC_old_segv_handler != SIG_DFL) {
+#      ifdef PRINTSTATS
+          GC_err_printf0("Replaced other SIGSEGV handler\n");
+#      endif
       }
 #   endif
 }
@@ -770,9 +1207,9 @@ void GC_protect_heap()
 
 void GC_read_dirty()
 {
-    bcopy((char *)GC_dirty_pages, (char *)GC_grungy_pages,
-          (int)(sizeof GC_dirty_pages));
-    bzero((char *)GC_dirty_pages, (int)(sizeof GC_dirty_pages));
+    BCOPY(GC_dirty_pages, GC_grungy_pages,
+          (sizeof GC_dirty_pages));
+    BZERO(GC_dirty_pages, (sizeof GC_dirty_pages));
     GC_protect_heap();
 }
 
@@ -784,16 +1221,21 @@ struct hblk * h;
     return(HDR(h) == 0 || get_pht_entry_from_index(GC_grungy_pages, index));
 }
 
+/*
+ * If this code needed to be thread-safe, the following would need to
+ * acquire and release the allocation lock.  This is tricky, since e.g.
+ * the cord package issues a read while it already holds the allocation lock.
+ */
+# ifdef THREADS
+       --> fix this
+# endif
 void GC_begin_syscall()
 {
-    DISABLE_SIGNALS();
-    LOCK();
 }
 
 void GC_end_syscall()
 {
-    UNLOCK();
-    ENABLE_SIGNALS();
 }
 
 void GC_unprotect_range(addr, len)
@@ -865,6 +1307,21 @@ int nbyte;
     return(result);
 }
 
+/*ARGSUSED*/
+bool GC_page_was_ever_dirty(h)
+struct hblk *h;
+{
+    return(TRUE);
+}
+
+/* Reset the n pages starting at h to "was never dirty" status.        */
+/*ARGSUSED*/
+void GC_is_fresh(h, n)
+struct hblk *h;
+word n;
+{
+}
+
 # endif /* MPROTECT_VDB */
 
 # ifdef PROC_VDB
@@ -891,6 +1348,34 @@ int nbyte;
 #define BUFSZ 20000
 char *GC_proc_buf;
 
+page_hash_table GC_written_pages = { 0 };      /* Pages ever dirtied   */
+
+#ifdef SOLARIS_THREADS
+/* We don't have exact sp values for threads.  So we count on  */
+/* occasionally declaring stack pages to be fresh.  Thus we    */
+/* need a real implementation of GC_is_fresh.  We can't clear  */
+/* entries in GC_written_pages, since that would declare all   */
+/* pages with the given hash address to be fresh.              */
+#   define MAX_FRESH_PAGES 8*1024      /* Must be power of 2 */
+    struct hblk ** GC_fresh_pages;     /* A direct mapped cache.       */
+                                       /* Collisions are dropped.      */
+
+#   define FRESH_PAGE_SLOT(h) (divHBLKSZ((word)(h)) & (MAX_FRESH_PAGES-1))
+#   define ADD_FRESH_PAGE(h) \
+       GC_fresh_pages[FRESH_PAGE_SLOT(h)] = (h)
+#   define PAGE_IS_FRESH(h) \
+       (GC_fresh_pages[FRESH_PAGE_SLOT(h)] == (h) && (h) != 0)
+#endif
+
+/* Add all pages in pht2 to pht1 */
+void GC_or_pages(pht1, pht2)
+page_hash_table pht1, pht2;
+{
+    register int i;
+    
+    for (i = 0; i < PHT_SIZE; i++) pht1[i] |= pht2[i];
+}
+
 int GC_proc_fd;
 
 void GC_dirty_init()
@@ -898,6 +1383,17 @@ void GC_dirty_init()
     int fd;
     char buf[30];
 
+    GC_dirty_maintained = TRUE;
+    if (GC_words_allocd != 0 || GC_words_allocd_before_gc != 0) {
+       register int i;
+    
+        for (i = 0; i < PHT_SIZE; i++) GC_written_pages[i] = (word)(-1);
+#       ifdef PRINTSTATS
+           GC_printf1("Allocated words:%lu:all pages may have been written\n",
+                      (unsigned long)
+                               (GC_words_allocd + GC_words_allocd_before_gc));
+#      endif       
+    }
     sprintf(buf, "/proc/%d", getpid());
     fd = open(buf, O_RDONLY);
     if (fd < 0) {
@@ -908,6 +1404,15 @@ void GC_dirty_init()
        ABORT("/proc ioctl failed");
     }
     GC_proc_buf = GC_scratch_alloc(BUFSZ);
+#   ifdef SOLARIS_THREADS
+       GC_fresh_pages = (struct hblk **)
+         GC_scratch_alloc(MAX_FRESH_PAGES * sizeof (struct hblk *));
+       if (GC_fresh_pages == 0) {
+           GC_err_printf0("No space for fresh pages\n");
+           EXIT();
+       }
+       BZERO(GC_fresh_pages, MAX_FRESH_PAGES * sizeof (struct hblk *));
+#   endif
 }
 
 /* Ignore write hints. They don't help us here.        */
@@ -927,7 +1432,7 @@ void GC_read_dirty()
     ptr_t current_addr, limit;
     int i;
 
-    bzero((char *)GC_grungy_pages, (int)(sizeof GC_grungy_pages));
+    BZERO(GC_grungy_pages, (sizeof GC_grungy_pages));
     
     bufp = GC_proc_buf;
     if (read(GC_proc_fd, bufp, BUFSZ) <= 0) {
@@ -955,6 +1460,15 @@ void GC_read_dirty()
                        register word index = PHT_HASH(h);
                        
                        set_pht_entry_from_index(GC_grungy_pages, index);
+#                      ifdef SOLARIS_THREADS
+                         {
+                           register int slot = FRESH_PAGE_SLOT(h);
+                           
+                           if (GC_fresh_pages[slot] == h) {
+                               GC_fresh_pages[slot] = 0;
+                           }
+                         }
+#                      endif
                        h++;
                    }
                }
@@ -962,14 +1476,62 @@ void GC_read_dirty()
            bufp += sizeof(long) - 1;
            bufp = (char *)((unsigned long)bufp & ~(sizeof(long)-1));
        }
+    /* Update GC_written_pages. */
+        GC_or_pages(GC_written_pages, GC_grungy_pages);
+#   ifdef SOLARIS_THREADS
+      /* Make sure that old stacks are considered completely clean     */
+      /* unless written again.                                         */
+       GC_old_stacks_are_fresh();
+#   endif
 }
 
 bool GC_page_was_dirty(h)
 struct hblk *h;
 {
     register word index = PHT_HASH(h);
+    register bool result;
     
-    return(get_pht_entry_from_index(GC_grungy_pages, index));
+    result = get_pht_entry_from_index(GC_grungy_pages, index);
+#   ifdef SOLARIS_THREADS
+       if (result && PAGE_IS_FRESH(h)) result = FALSE;
+       /* This happens only if page was declared fresh since   */
+       /* the read_dirty call, e.g. because it's in an unused  */
+       /* thread stack.  It's OK to treat it as clean, in      */
+       /* that case.  And it's consistent with                 */
+       /* GC_page_was_ever_dirty.                              */
+#   endif
+    return(result);
+}
+
+bool GC_page_was_ever_dirty(h)
+struct hblk *h;
+{
+    register word index = PHT_HASH(h);
+    register bool result;
+    
+    result = get_pht_entry_from_index(GC_written_pages, index);
+#   ifdef SOLARIS_THREADS
+       if (result && PAGE_IS_FRESH(h)) result = FALSE;
+#   endif
+    return(result);
+}
+
+void GC_is_fresh(h, n)
+struct hblk *h;
+word n;
+{
+
+    register word index;
+    
+#   ifdef SOLARIS_THREADS
+      register word i;
+      
+      if (GC_fresh_pages != 0) {
+        for (i = 0; i < n; i++) {
+          PAGE_IS_FRESH(h + n);
+        }
+      }
+#   endif
 }
 
 # endif /* PROC_VDB */
@@ -988,6 +1550,7 @@ ptr_t GC_vd_base;  /* Address corresponding to GC_grungy_bits[0]   */
 
 void GC_dirty_init()
 {
+    GC_dirty_maintained = TRUE;
     /* For the time being, we assume the heap generally grows up */
     GC_vd_base = GC_heap_sects[0].hs_start;
     if (GC_vd_base == 0) {
index 2a2684b..37615ae 100644 (file)
@@ -1,6 +1,5 @@
 /* 
- * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
- * Copyright (c) 1991, 1992 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1991-1994 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.
@@ -8,7 +7,8 @@
  * Permission is hereby granted to copy this garbage collector for any purpose,
  * provided the above notices are retained on all copies.
  */
-# include "gc_private.h"
+/* Boehm, March 28, 1994 1:58 pm PST */
+# include "gc_priv.h"
 
 # ifdef PCR
 /*
@@ -25,7 +25,7 @@ void * GC_AllocProc(size_t size, PCR_Bool ptrFree, PCR_Bool clear )
 {
     if (ptrFree) {
         void * result = (void *)GC_malloc_atomic(size);
-        if (clear && result != 0) bzero(result, size);
+        if (clear && result != 0) BZERO(result, size);
         return(result);
     } else {
         return((void *)GC_malloc(size));
index 5718ca2..c73a1bf 100644 (file)
@@ -1,6 +1,15 @@
-/* We put this here to minimize the risk of inlining. */
-/*VARARGS*/
-GC_noop() {}
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 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.
+ */
+/* Boehm, February 18, 1994 2:23 pm PST */
+
 
 # ifdef PCR
 /*
@@ -22,24 +31,3 @@ GC_noop() {}
 }
 #endif /* PCR */
 
-# ifdef __OS2__
-
-# include <stddef.h>
-# define INCL_DOSMEMMGR
-# define INCL_DOSERRORS
-# include <os2.h>
-
-void * os2_alloc(size_t bytes)
-{
-    void * result;
-
-    if (DosAllocMem(&result, bytes, PAG_EXECUTE | PAG_READ |
-                                   PAG_WRITE | PAG_COMMIT)
-                   != NO_ERROR) {
-       return(0);
-    }
-    if (result == 0) return(os2_alloc(bytes));
-    return(result);
-}
-
-# endif /* OS2 */
index 8b3ffbf..f3b4bde 100644 (file)
--- a/reclaim.c
+++ b/reclaim.c
@@ -1,6 +1,6 @@
 /* 
  * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
- * Copyright (c) 1991-1993 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1991-1994 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.
@@ -8,9 +8,10 @@
  * Permission is hereby granted to copy this garbage collector for any purpose,
  * provided the above notices are retained on all copies.
  */
+/* Boehm, March 1, 1994 3:30 pm PST */
 
 #include <stdio.h>
-#include "gc_private.h"
+#include "gc_priv.h"
 
 signed_word GC_mem_found = 0;
                        /* Number of longwords of memory GC_reclaimed     */
@@ -121,6 +122,8 @@ register word sz;
     return(list);
 }
 
+#ifndef SMALL_CONFIG
+
 /*
  * A special case for 2 word composite objects (e.g. cons cells):
  */
@@ -229,6 +232,8 @@ register ptr_t list;
 #   undef DO_OBJ
 }
 
+#endif /* !SMALL_CONFIG */
+
 /* The same thing, but don't clear objects: */
 /*ARGSUSED*/
 ptr_t GC_reclaim_uninit(hbp, hhdr, sz, list, abort_if_found)
@@ -267,6 +272,7 @@ register word sz;
     return(list);
 }
 
+#ifndef SMALL_CONFIG
 /*
  * Another special case for 2 word atomic objects:
  */
@@ -416,13 +422,15 @@ register ptr_t list;
 #   undef DO_OBJ
 }
 
+#endif /* !SMALL_CONFIG */
+
 /*
  * Restore unmarked small objects in the block pointed to by hbp
  * to the appropriate object free list.
  * If entirely empty blocks are to be completely deallocated, then
  * caller should perform that check.
  */
-GC_reclaim_small_nonempty_block(hbp, abort_if_found)
+void GC_reclaim_small_nonempty_block(hbp, abort_if_found)
 register struct hblk *hbp;     /* ptr to current heap block            */
 int abort_if_found;            /* Abort if a reclaimable object is found */
 {
@@ -433,13 +441,14 @@ int abort_if_found;               /* Abort if a reclaimable object is found */
     
     hhdr = HDR(hbp);
     sz = hhdr -> hb_sz;
-    hhdr -> hb_last_reclaimed = GC_gc_no;
+    hhdr -> hb_last_reclaimed = (unsigned short) GC_gc_no;
     ok = &GC_obj_kinds[hhdr -> hb_obj_kind];
     flh = &(ok -> ok_freelist[sz]);
     GC_write_hint(hbp);
 
     if (ok -> ok_init) {
       switch(sz) {
+#      ifndef SMALL_CONFIG
         case 1:
             *flh = GC_reclaim1(hbp, hhdr, *flh, abort_if_found);
             break;
@@ -449,12 +458,14 @@ int abort_if_found;               /* Abort if a reclaimable object is found */
         case 4:
             *flh = GC_reclaim_clear4(hbp, hhdr, *flh, abort_if_found);
             break;
+#      endif
         default:
             *flh = GC_reclaim_clear(hbp, hhdr, sz, *flh, abort_if_found);
             break;
       }
     } else {
       switch(sz) {
+#      ifndef SMALL_CONFIG
         case 1:
             *flh = GC_reclaim1(hbp, hhdr, *flh, abort_if_found);
             break;
@@ -464,6 +475,7 @@ int abort_if_found;         /* Abort if a reclaimable object is found */
         case 4:
             *flh = GC_reclaim_uninit4(hbp, hhdr, *flh, abort_if_found);
             break;
+#      endif
         default:
             *flh = GC_reclaim_uninit(hbp, hhdr, sz, *flh, abort_if_found);
             break;
similarity index 89%
rename from setjmp_test.c
rename to setjmp_t.c
index 5d7426a..f35cf68 100644 (file)
@@ -1,3 +1,14 @@
+/*
+ * Copyright (c) 1991-1994 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.
+ */
+/* Boehm, February 18, 1994 2:00 pm PST */
 /* 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        */
diff --git a/solaris_threads.c b/solaris_threads.c
new file mode 100644 (file)
index 0000000..71d6beb
--- /dev/null
@@ -0,0 +1,513 @@
+/* 
+ * Copyright (c) 1994 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.
+ */
+/*
+ * Support code for Solaris threads.  Provides functionality we wish Sun
+ * had provided.  Relies on some information we probably shouldn't rely on.
+ */
+/* Boehm, April 5, 1994 1:30 pm PDT */
+
+# if defined(SOLARIS_THREADS)
+
+# include "gc_priv.h"
+# include <thread.h>
+# include <synch.h>
+# include <sys/types.h>
+# include <sys/mman.h>
+# include <sys/time.h>
+# include <sys/resource.h>
+# define _CLASSIC_XOPEN_TYPES
+# include <unistd.h>
+
+#undef thr_join
+#undef thr_create
+#undef thr_suspend
+#undef thr_continue
+
+mutex_t GC_thr_lock;           /* Acquired before allocation lock      */
+cond_t GC_prom_join_cv;                /* Broadcast whenany thread terminates  */
+cond_t GC_create_cv;           /* Signalled when a new undetached      */
+                               /* thread starts.                       */
+
+bool GC_thr_initialized = FALSE;
+
+size_t GC_min_stack_sz;
+
+size_t GC_page_sz;
+
+# define N_FREE_LISTS 25
+ptr_t GC_stack_free_lists[N_FREE_LISTS] = { 0 };
+               /* GC_stack_free_lists[i] is free list for stacks of    */
+               /* size GC_min_stack_sz*2**i.                           */
+               /* Free lists are linked through first word.            */
+
+/* Return a stack of size at least *stack_size.  *stack_size is        */
+/* replaced by the actual stack size.                          */
+/* Caller holds GC_thr_lock.                                   */
+ptr_t GC_stack_alloc(size_t * stack_size)
+{
+    register size_t requested_sz = *stack_size;
+    register size_t search_sz = GC_min_stack_sz;
+    register int index = 0;    /* = log2(search_sz/GC_min_stack_sz) */
+    register ptr_t result;
+    
+    while (search_sz < requested_sz) {
+        search_sz *= 2;
+        index++;
+    }
+    if ((result = GC_stack_free_lists[index]) == 0
+        && (result = GC_stack_free_lists[index+1]) != 0) {
+        /* Try next size up. */
+        search_sz *= 2; index++;
+    }
+    if (result != 0) {
+        GC_stack_free_lists[index] = *(ptr_t *)result;
+    } else {
+        result = (ptr_t) GC_scratch_alloc(search_sz + 2*GC_page_sz);
+        result = (ptr_t)(((word)result + GC_page_sz) & ~(GC_page_sz - 1));
+        /* Protect hottest page to detect overflow. */
+        mprotect(result, GC_page_sz, PROT_NONE);
+        GC_is_fresh((struct hblk *)result, divHBLKSZ(search_sz));
+        result += GC_page_sz;
+    }
+    *stack_size = search_sz;
+    return(result);
+}
+
+/* Caller holds GC_thr_lock.                                   */
+void GC_stack_free(ptr_t stack, size_t size)
+{
+    register int index = 0;
+    register size_t search_sz = GC_min_stack_sz;
+    
+    while (search_sz < size) {
+        search_sz *= 2;
+        index++;
+    }
+    if (search_sz != size) ABORT("Bad stack size");
+    *(ptr_t *)stack = GC_stack_free_lists[index];
+    GC_stack_free_lists[index] = stack;
+}
+
+void GC_my_stack_limits();
+
+/* Notify virtual dirty bit implementation that known empty parts of   */
+/* stacks do not contain useful data.                                  */ 
+void GC_old_stacks_are_fresh()
+{
+    register int i;
+    register ptr_t p;
+    register size_t sz;
+    register struct hblk * h;
+    int dummy;
+    
+    if (!GC_thr_initialized) GC_thr_init();
+    for (i = 0, sz= GC_min_stack_sz; i < N_FREE_LISTS;
+         i++, sz *= 2) {
+         for (p = GC_stack_free_lists[i]; p != 0; p = *(ptr_t *)p) {
+             h = (struct hblk *)(((word)p + HBLKSIZE-1) & ~(HBLKSIZE-1));
+             if ((ptr_t)h == p) {
+                 GC_is_fresh((struct hblk *)p, divHBLKSZ(sz));
+             } else {
+                 GC_is_fresh((struct hblk *)p, divHBLKSZ(sz) - 1);
+                 BZERO(p, (ptr_t)h - p);
+             }
+         }
+    }
+    GC_my_stack_limits();
+}
+
+/* The set of all known threads.  We intercept thread creation and     */
+/* joins.  We never actually create detached threads.  We allocate all         */
+/* new thread stacks ourselves.  These allow us to maintain this       */
+/* data structure.                                                     */
+/* Protected by GC_thr_lock.                                           */
+/* Some of this should be declared vaolatile, but that's incosnsistent */
+/* with some library routine declarations.  In particular, the                 */
+/* definition of cond_t doesn't mention volatile!                      */
+typedef struct GC_Thread_Rep {
+    struct GC_Thread_Rep * next;
+    thread_t id;
+    word flags;
+#      define FINISHED 1       /* Thread has exited.   */
+#      define DETACHED 2       /* Thread is intended to be detached.   */
+#      define CLIENT_OWNS_STACK        4
+                               /* Stack was supplied by client.        */
+#      define SUSPENDED 8      /* Currently suspended. */      
+    ptr_t stack;
+    size_t stack_size;
+    cond_t join_cv;
+    void * status;
+} * GC_thread;
+
+# define THREAD_TABLE_SZ 128   /* Must be power of 2   */
+volatile GC_thread GC_threads[THREAD_TABLE_SZ];
+
+/* Add a thread to GC_threads.  We assume it wasn't already there.     */
+/* Caller holds GC_thr_lock if there is > 1 thread.                    */
+/* Initial caller may hold allocation lock.                            */
+GC_thread GC_new_thread(thread_t id)
+{
+    int hv = ((word)id) % THREAD_TABLE_SZ;
+    GC_thread result;
+    static struct GC_Thread_Rep first_thread;
+    static bool first_thread_used = FALSE;
+    
+    if (!first_thread_used) {
+       result = &first_thread;
+       first_thread_used = TRUE;
+       /* Dont acquire allocation lock, since we may already hold it. */
+    } else {
+        result = GC_NEW(struct GC_Thread_Rep);
+    }
+    if (result == 0) return(0);
+    result -> id = id;
+    result -> next = GC_threads[hv];
+    GC_threads[hv] = result;
+    /* result -> finished = 0; */
+    (void) cond_init(&(result->join_cv), USYNC_THREAD, 0);
+    return(result);
+}
+
+/* Delete a thread from GC_threads.  We assume it is there.    */
+/* (The code intentionally traps if it wasn't.)                        */
+/* Caller holds GC_thr_lock.                                   */
+void GC_delete_thread(thread_t id)
+{
+    int hv = ((word)id) % THREAD_TABLE_SZ;
+    register GC_thread p = GC_threads[hv];
+    register GC_thread prev = 0;
+    
+    while (p -> id != id) {
+        prev = p;
+        p = p -> next;
+    }
+    if (prev == 0) {
+        GC_threads[hv] = p -> next;
+    } else {
+        prev -> next = p -> next;
+    }
+}
+
+/* Return the GC_thread correpsonding to a given thread_t.     */
+/* Returns 0 if it's not there.                                        */
+/* Caller holds GC_thr_lock.                                   */
+GC_thread GC_lookup_thread(thread_t id)
+{
+    int hv = ((word)id) % THREAD_TABLE_SZ;
+    register GC_thread p = GC_threads[hv];
+    
+    while (p != 0 && p -> id != id) p = p -> next;
+    return(p);
+}
+
+/* Notify dirty bit implementation of unused parts of my stack. */
+void GC_my_stack_limits()
+{
+    int dummy;
+    register ptr_t hottest = (ptr_t)((word)(&dummy) & ~(HBLKSIZE-1));
+    register GC_thread me = GC_lookup_thread(thr_self());
+    register size_t stack_size = me -> stack_size;
+    register ptr_t stack;
+    
+    if (stack_size == 0) {
+      /* original thread */
+        struct rlimit rl;
+         
+        if (getrlimit(RLIMIT_STACK, &rl) != 0) ABORT("getrlimit failed");
+        /* Empirically, what should be the stack page with lowest      */
+        /* address is actually inaccessible.                           */
+        stack_size = ((word)rl.rlim_cur & ~(HBLKSIZE-1)) - GC_page_sz;
+        stack = GC_stackbottom - stack_size + GC_page_sz;
+    } else {
+        stack = me -> stack;
+    }
+    if (stack > hottest || stack + stack_size < hottest) {
+       ABORT("sp out of bounds");
+    }
+    GC_is_fresh((struct hblk *)stack, divHBLKSZ(hottest - stack));
+}
+
+
+/* Caller holds allocation lock.       */
+void GC_stop_world()
+{
+    thread_t my_thread = thr_self();
+    register int i;
+    register GC_thread p;
+    
+    for (i = 0; i < THREAD_TABLE_SZ; i++) {
+      for (p = GC_threads[i]; p != 0; p = p -> next) {
+        if (p -> id != my_thread && !(p -> flags & SUSPENDED)) {
+            if (thr_suspend(p -> id) < 0) ABORT("thr_suspend failed");
+        }
+      }
+    }
+}
+
+/* Caller holds allocation lock.       */
+void GC_start_world()
+{
+    thread_t my_thread = thr_self();
+    register int i;
+    register GC_thread p;
+    
+    for (i = 0; i < THREAD_TABLE_SZ; i++) {
+      for (p = GC_threads[i]; p != 0; p = p -> next) {
+        if (p -> id != my_thread && !(p -> flags & SUSPENDED)) {
+            if (thr_continue(p -> id) < 0) ABORT("thr_continue failed");
+        }
+      }
+    }
+}
+
+
+void GC_push_all_stacks()
+{
+    /* We assume the world is stopped. */
+    register int i;
+    register GC_thread p;
+    word dummy;
+    register ptr_t sp = (ptr_t) (&dummy);
+    register ptr_t bottom, top;
+    struct rlimit rl;
+    
+#   define PUSH(bottom,top) \
+      if (GC_dirty_maintained) { \
+       GC_push_dirty((bottom), (top), GC_page_was_ever_dirty, \
+                     GC_push_all_stack); \
+      } else { \
+        GC_push_all((bottom), (top)); \
+      }
+    if (!GC_thr_initialized) GC_thr_init();
+    for (i = 0; i < THREAD_TABLE_SZ; i++) {
+      for (p = GC_threads[i]; p != 0; p = p -> next) {
+        if (p -> stack_size != 0) {
+            bottom = p -> stack;
+            top = p -> stack + p -> stack_size;
+        } else {
+            /* The original stack. */
+            if (getrlimit(RLIMIT_STACK, &rl) != 0) ABORT("getrlimit failed");
+            bottom = GC_stackbottom - rl.rlim_cur + GC_page_sz;
+            top = GC_stackbottom;
+        }
+        if ((word)sp > (word)bottom && (word)sp < (word)top) bottom = sp;
+        PUSH(bottom, top);
+      }
+    }
+}
+
+/* The only thread that ever really performs a thr_join.       */
+void * GC_thr_daemon(void * dummy)
+{
+    void *status;
+    thread_t departed;
+    register GC_thread t;
+    register int i;
+    register int result;
+    
+    for(;;) {
+      start:
+        result = thr_join((thread_t)0, &departed, &status);
+       mutex_lock(&GC_thr_lock);
+       if (result != 0) {
+           /* No more threads; wait for create. */
+           for (i = 0; i < THREAD_TABLE_SZ; i++) {
+               for (t = GC_threads[i]; t != 0; t = t -> next) {
+                    if (!(t -> flags & (DETACHED | FINISHED))) {
+                      mutex_unlock(&GC_thr_lock);
+                      goto start; /* Thread started just before we */
+                                 /* acquired the lock.            */
+                    }
+                }
+            }
+            cond_wait(&GC_create_cv, &GC_thr_lock);
+            mutex_unlock(&GC_thr_lock);
+            goto start;
+       }
+       t = GC_lookup_thread(departed);
+       if (!(t -> flags & CLIENT_OWNS_STACK)) {
+           GC_stack_free(t -> stack, t -> stack_size);
+       }
+       if (t -> flags & DETACHED) {
+           GC_delete_thread(departed);
+       } else {
+           t -> status = status;
+           t -> flags |= FINISHED;
+           cond_signal(&(t -> join_cv));
+           cond_broadcast(&GC_prom_join_cv);
+       }
+       mutex_unlock(&GC_thr_lock);
+    }
+}
+
+GC_thr_init()
+{
+    GC_thread t;
+    /* This gets called from the first thread creation, so     */
+    /* mutual exclusion is not an issue.                       */
+    GC_thr_initialized = TRUE;
+    GC_min_stack_sz = ((thr_min_stack() + HBLKSIZE-1) & ~(HBLKSIZE - 1));
+    GC_page_sz = sysconf(_SC_PAGESIZE);
+    mutex_init(&GC_thr_lock, USYNC_THREAD, 0);
+    cond_init(&GC_prom_join_cv, USYNC_THREAD, 0);
+    cond_init(&GC_create_cv, USYNC_THREAD, 0);
+    /* Add the initial thread, so we can stop it.      */
+      t = GC_new_thread(thr_self());
+      t -> stack_size = 0;
+      t -> flags = DETACHED;
+    if (thr_create(0 /* stack */, 0 /* stack_size */, GC_thr_daemon,
+                  0 /* arg */, THR_DETACHED | THR_DAEMON,
+                  0 /* thread_id */) != 0) {
+       ABORT("Cant fork daemon");
+    }
+    
+}
+
+/* We acquire the allocation lock to prevent races with        */
+/* stopping/starting world.                                    */
+int GC_thr_suspend(thread_t target_thread)
+{
+    GC_thread t;
+    int result;
+    
+    mutex_lock(&GC_thr_lock);
+    LOCK();
+    result = thr_suspend(target_thread);
+    if (result == 0) {
+       t = GC_lookup_thread(target_thread);
+       if (t == 0) ABORT("thread unknown to GC");
+        t -> flags |= SUSPENDED;
+    }
+    UNLOCK();
+    mutex_unlock(&GC_thr_lock);
+    return(result);
+}
+
+int GC_thr_continue(thread_t target_thread)
+{
+    GC_thread t;
+    int result;
+    
+    mutex_lock(&GC_thr_lock);
+    LOCK();
+    result = thr_continue(target_thread);
+    if (result == 0) {
+       t = GC_lookup_thread(target_thread);
+       if (t == 0) ABORT("thread unknown to GC");
+        t -> flags &= ~SUSPENDED;
+    }
+    UNLOCK();
+    mutex_unlock(&GC_thr_lock);
+    return(result);
+}
+
+int GC_thr_join(thread_t wait_for, thread_t *departed, void **status)
+{
+    register GC_thread t;
+    int result = 0;
+    
+    mutex_lock(&GC_thr_lock);
+    if (wait_for == 0) {
+        register int i;
+        register bool thread_exists;
+    
+       for (;;) {
+         thread_exists = FALSE;
+         for (i = 0; i < THREAD_TABLE_SZ; i++) {
+           for (t = GC_threads[i]; t != 0; t = t -> next) {
+              if (!(t -> flags & DETACHED)) {
+                if (t -> flags & FINISHED) {
+                  goto found;
+                }
+                thread_exists = TRUE;
+              }
+            }
+          }
+          if (!thread_exists) {
+              result = ESRCH;
+             goto out;
+          }
+          cond_wait(&GC_prom_join_cv, &GC_thr_lock);
+        }
+    } else {
+        t = GC_lookup_thread(wait_for);
+       if (t == 0 || t -> flags & DETACHED) {
+           result = ESRCH;
+           goto out;
+       }
+       if (wait_for == thr_self()) {
+           result = EDEADLK;
+           goto out;
+       }
+       while (!(t -> flags & FINISHED)) {
+            cond_wait(&(t -> join_cv), &GC_thr_lock);
+       }
+       
+    }
+  found:
+    if (status) *status = t -> status;
+    if (departed) *departed = t -> id;
+    cond_destroy(&(t -> join_cv));
+    GC_delete_thread(t -> id);
+  out:
+    mutex_unlock(&GC_thr_lock);
+    return(result);
+}
+
+
+int
+GC_thr_create(void *stack_base, size_t stack_size,
+              void *(*start_routine)(void *), void *arg, long flags,
+              thread_t *new_thread)
+{
+    int result;
+    GC_thread t;
+    thread_t my_new_thread;
+    word my_flags = 0;
+    void * stack = stack_base;
+   
+    if (!GC_thr_initialized) GC_thr_init();
+    mutex_lock(&GC_thr_lock);
+    if (stack == 0) {
+       if (stack_size == 0) stack_size = GC_min_stack_sz;
+       stack = (void *)GC_stack_alloc(&stack_size);
+       if (stack == 0) {
+           mutex_unlock(&GC_thr_lock);
+           return(ENOMEM);
+       }
+    } else {
+       my_flags |= CLIENT_OWNS_STACK;
+    }
+    if (flags & THR_DETACHED) my_flags |= DETACHED;
+    if (flags & THR_SUSPENDED) my_flags |= SUSPENDED;
+    result = thr_create(stack, stack_size, start_routine,
+                       arg, flags & ~THR_DETACHED, &my_new_thread);
+    if (result == 0) {
+        t = GC_new_thread(my_new_thread);
+        t -> flags = my_flags;
+        if (!(my_flags & DETACHED)) cond_init(&(t -> join_cv), USYNC_THREAD, 0);
+        t -> stack = stack;
+        t -> stack_size = stack_size;
+        if (new_thread != 0) *new_thread = my_new_thread;
+        cond_signal(&GC_create_cv);
+    } else if (!(my_flags & CLIENT_OWNS_STACK)) {
+       GC_stack_free(stack, stack_size);
+    }        
+    mutex_unlock(&GC_thr_lock);  
+    return(result);
+}
+
+# else
+
+#ifndef LINT
+  int GC_no_sunOS_threads;
+#endif
+
+# endif /* SOLARIS_THREADS */
index 349ea13..f2fb83c 100644 (file)
@@ -1,7 +1,6 @@
-
 /* 
  * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
- * Copyright (c) 1991-1993 by Xerox Corporation.  All rights reserved.
+ * Copyright (c) 1991-1994 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.
@@ -9,20 +8,14 @@
  * Permission is hereby granted to copy this garbage collector for any purpose,
  * provided the above notices are retained on all copies.
  */
+/* Boehm, March 28, 1994 1:55 pm PST */
 
 
-#include "gc_private.h"
+#include "gc_priv.h"
 
 # ifdef STUBBORN_ALLOC
 /* Stubborn object (hard to change, nearly immutable) allocation. */
 
-
-# ifdef ALL_INTERIOR_POINTERS
-#   define SMALL_OBJ(bytes) ((bytes) < WORDS_TO_BYTES(MAXOBJSZ))
-# else
-#   define SMALL_OBJ(bytes) ((bytes) <= WORDS_TO_BYTES(MAXOBJSZ))
-# endif
-
 extern ptr_t GC_clear_stack(); /* in misc.c, behaves like identity */
 
 #define GENERAL_MALLOC(lb,k) \
@@ -57,8 +50,8 @@ void GC_stubborn_init()
                        GC_generic_malloc_inner(
                                (word)(INIT_SIZE * sizeof(extern_ptr_t)),
                                PTRFREE);
-    bzero((char *)GC_changing_list_start,
-         (int)(INIT_SIZE * sizeof(extern_ptr_t)));
+    BZERO(GC_changing_list_start,
+         INIT_SIZE * sizeof(extern_ptr_t));
     if (GC_changing_list_start == 0) {
         GC_err_printf0("Insufficient space to start up\n");
         ABORT("GC_stubborn_init: put of space");
@@ -80,7 +73,7 @@ void GC_stubborn_init()
 bool GC_compact_changing_list()
 {
     register extern_ptr_t *p, *q;
-    register int count = 0;
+    register word count = 0;
     word old_size = GC_changing_list_limit-GC_changing_list_start+1;
     register word new_size = old_size;
     extern_ptr_t * new_list;
@@ -96,7 +89,7 @@ bool GC_compact_changing_list()
                /* consider these.  We do want the list itself to be      */
                /* collectable.                                           */
     if (new_list == 0) return(FALSE);
-    bzero((char *)new_list, (int)(new_size * sizeof(extern_ptr_t)));
+    BZERO(new_list, new_size * sizeof(extern_ptr_t));
     q = new_list;
     for (p = GC_changing_list_start; p < GC_changing_list_limit; p++) {
         if (*p != 0) *q++ = *p;
@@ -242,9 +235,9 @@ void GC_read_changed()
     register word index;
     
     if (p == 0) /* initializing */ return;
-    bcopy((char *)GC_changed_pages, (char *)GC_prev_changed_pages,
-          (int)(sizeof GC_changed_pages));
-    bzero((char *)GC_changed_pages, (int)(sizeof GC_changed_pages));
+    BCOPY(GC_changed_pages, GC_prev_changed_pages,
+          (sizeof GC_changed_pages));
+    BZERO(GC_changed_pages, (sizeof GC_changed_pages));
     for (; p <= GC_changing_list_current; p++) {
         if ((q = *p) != 0) {
             h = HBLKPTR(q);
diff --git a/test.c b/test.c
index 2108681..74c2e4f 100644 (file)
--- a/test.c
+++ b/test.c
@@ -1,19 +1,44 @@
+/* 
+ * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
+ * Copyright (c) 1991-1994 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.
+ */
+/* Boehm, April 6, 1994 12:19 pm PDT */
 /* An incomplete test for the garbage collector.               */
 /* Some more obscure entry points are not tested at all.       */
-/* Boehm, November 24, 1993 5:14 pm PST */
+
 # include <stdlib.h>
 # include <stdio.h>
 # include "gc.h"
+# include "gc_typed.h"
+# include "gc_priv.h"  /* For output and some statistics       */
+# include "config.h"
+
+# ifdef MSWIN32
+#   include <windows.h>
+# endif
+
 # ifdef PCR
 #   include "th/PCR_ThCrSec.h"
 #   include "th/PCR_Th.h"
 # endif
 
+# ifdef SOLARIS_THREADS
+#   include <thread.h>
+#   include <synch.h>
+# endif
+
+# if defined(PCR) || defined(SOLARIS_THREADS)
+#   define THREADS
+# endif
+
 # ifdef AMIGA
    long __stack = 200000;
-#  define FAR __far
-# else
-#  define FAR
 # endif
 
 # define FAIL (void)abort()
@@ -59,13 +84,14 @@ sexpr y;
     
     r = (sexpr) GC_MALLOC_STUBBORN(sizeof(struct SEXPR) + my_extra);
     if (r == 0) {
-        (void)printf("Out of memory\n");
+        (void)GC_printf0("Out of memory\n");
         exit(1);
     }
     for (p = (int *)r;
          ((char *)p) < ((char *)r) + my_extra + sizeof(struct SEXPR); p++) {
        if (*p) {
-           (void)printf("Found nonzero at %X - allocator is broken\n", p);
+           (void)GC_printf1("Found nonzero at 0x%lx - allocator is broken\n",
+                            (unsigned long)p);
            FAIL;
         }
         *p = 13;
@@ -93,7 +119,7 @@ sexpr y;
     
     r = (sexpr) GC_MALLOC(sizeof(struct SEXPR));
     if (r == 0) {
-        (void)printf("Out of memory\n");
+        (void)GC_printf0("Out of memory\n");
         exit(1);
     }
     r -> sexpr_car = x;
@@ -109,7 +135,7 @@ sexpr y;
     
     r = (sexpr) GC_MALLOC_UNCOLLECTABLE(sizeof(struct SEXPR));
     if (r == 0) {
-        (void)printf("Out of memory\n");
+        (void)GC_printf0("Out of memory\n");
         exit(1);
     }
     r -> sexpr_car = x;
@@ -162,13 +188,13 @@ sexpr list;
 int low, up;
 {
     if ((int)(car(car(list))) != low) {
-        (void)printf(
+        (void)GC_printf0(
            "List reversal produced incorrect list - collector is broken\n");
         exit(1);
     }
     if (low == up) {
         if (cdr(list) != nil) {
-           (void)printf("List too long - collector is broken\n");
+           (void)GC_printf0("List too long - collector is broken\n");
            exit(1);
         }
     } else {
@@ -183,13 +209,13 @@ sexpr list;
 int low, up;
 {
     if ((int)(car(car(list))) != low) {
-        (void)printf(
+        (void)GC_printf0(
            "Uncollectable list corrupted - collector is broken\n");
         exit(1);
     }
     if (low == up) {
         if (UNCOLLECTABLE_CDR(list) != nil) {
-           (void)printf("Uncollectable ist too long - collector is broken\n");
+           (void)GC_printf0("Uncollectable ist too long - collector is broken\n");
            exit(1);
         }
     } else {
@@ -202,14 +228,14 @@ void print_int_list(x)
 sexpr x;
 {
     if (is_nil(x)) {
-        (void)printf("NIL\n");
+        (void)GC_printf0("NIL\n");
     } else {
-        (void)printf("(%d)", car(car(x)));
+        (void)GC_printf1("(%ld)", (long)(car(car(x))));
         if (!is_nil(cdr(x))) {
-            (void)printf(", ");
+            (void)GC_printf0(", ");
             (void)print_int_list(cdr(x));
         } else {
-            (void)printf("\n");
+            (void)GC_printf0("\n");
         }
     }
 }
@@ -225,14 +251,19 @@ struct {
  * Repeatedly reverse lists built out of very different sized cons cells.
  * Check that we didn't lose anything.
  */
-reverse_test()
+void reverse_test()
 {
     int i;
     sexpr b;
     sexpr c;
     sexpr d;
     sexpr e;
-#   define BIG 4500
+#   if defined(MSWIN32)
+      /* Win32S only allows 128K stacks */
+#     define BIG 1000
+#   else
+#     define BIG 4500
+#   endif
 
     a = ints(1, 49);
     b = ints(1, 50);
@@ -250,11 +281,12 @@ reverse_test()
     for (i = 0; i < 50; i++) {
         b = reverse(reverse(b));
     }
+    check_ints(b,1,50);
     for (i = 0; i < 60; i++) {
        /* This maintains the invariant that a always points to a list of */
        /* 49 integers.  Thus this is thread safe without locks.          */
         a = reverse(reverse(a));
-#      if !defined(AT_END) && !defined(PCR)
+#      if !defined(AT_END) && !defined(THREADS)
          /* This is not thread safe, since realloc explicitly deallocates */
           if (i & 1) {
             a = (sexpr)GC_REALLOC((void_star)a, 500);
@@ -296,7 +328,7 @@ int dropped_something = 0;
 {
   tn * t = (tn *)obj;
   if ((int)client_data != t -> level) {
-     (void)printf("Wrong finalization data - collector is broken\n");
+     (void)GC_printf0("Wrong finalization data - collector is broken\n");
      FAIL;
   }
   finalized_count++;
@@ -305,7 +337,7 @@ int dropped_something = 0;
 size_t counter = 0;
 
 # define MAX_FINALIZED 8000
-FAR GC_word live_indicators[MAX_FINALIZED] = {0};
+GC_FAR GC_word live_indicators[MAX_FINALIZED] = {0};
 int live_indicators_count = 0;
 
 tn * mktree(n)
@@ -315,7 +347,7 @@ int n;
     
     if (n == 0) return(0);
     if (result == 0) {
-        (void)printf("Out of memory\n");
+        (void)GC_printf0("Out of memory\n");
         exit(1);
     }
     result -> level = n;
@@ -328,36 +360,48 @@ int n;
         result -> rchild -> lchild = tmp;
     }
     if (counter++ % 119 == 0) {
+        int my_index;
+        
+        {
+#        ifdef PCR
+           PCR_ThCrSec_EnterSys();
+           /* Losing a count here causes erroneous report of failure. */
+#        endif
+#        ifdef SOLARIS_THREADS
+           static mutex_t incr_lock;
+           mutex_lock(&incr_lock);
+#        endif
+          finalizable_count++;
+          my_index = live_indicators_count++;
+#        ifdef PCR
+           PCR_ThCrSec_ExitSys();
+#        endif
+#        ifdef SOLARIS_THREADS
+           mutex_unlock(&incr_lock);
+#        endif
+       }
+
         GC_REGISTER_FINALIZER((void_star)result, finalizer, (void_star)n,
                              (GC_finalization_proc *)0, (void_star *)0);
-        live_indicators[live_indicators_count] = 13;
+        live_indicators[my_index] = 13;
         if (GC_general_register_disappearing_link(
-               (void_star *)(&(live_indicators[live_indicators_count])),
+               (void_star *)(&(live_indicators[my_index])),
                (void_star)result) != 0) {
-               printf("GC_general_register_disappearing_link failed\n");
+               GC_printf0("GC_general_register_disappearing_link failed\n");
                FAIL;
         }
         if (GC_unregister_disappearing_link(
                (void_star *)
-                  (&(live_indicators[live_indicators_count]))) == 0) {
-               printf("GC_unregister_disappearing_link failed\n");
+                  (&(live_indicators[my_index]))) == 0) {
+               GC_printf0("GC_unregister_disappearing_link failed\n");
                FAIL;
         }
         if (GC_general_register_disappearing_link(
-               (void_star *)(&(live_indicators[live_indicators_count])),
+               (void_star *)(&(live_indicators[my_index])),
                (void_star)result) != 0) {
-               printf("GC_general_register_disappearing_link failed 2\n");
+               GC_printf0("GC_general_register_disappearing_link failed 2\n");
                FAIL;
         }
-        live_indicators_count++;
-#      ifdef PCR
-           PCR_ThCrSec_EnterSys();
-           /* Losing a count here causes erroneous report of failure. */
-#      endif
-        finalizable_count++;
-#      ifdef PCR
-           PCR_ThCrSec_ExitSys();
-#      endif
     }
     return(result);
 }
@@ -367,12 +411,13 @@ tn *t;
 int n;
 {
     if (n == 0 && t != 0) {
-        (void)printf("Clobbered a leaf - collector is broken\n");
+        (void)GC_printf0("Clobbered a leaf - collector is broken\n");
         FAIL;
     }
     if (n == 0) return;
     if (t -> level != n) {
-        (void)printf("Lost a node at level %d - collector is broken\n", n);
+        (void)GC_printf1("Lost a node at level %lu - collector is broken\n",
+                        (unsigned long)n);
         FAIL;
     }
     if (counter++ % 373 == 0) (void) GC_MALLOC(counter%5001);
@@ -381,28 +426,65 @@ int n;
     chktree(t -> rchild, n-1);
 }
 
+# ifdef SOLARIS_THREADS
+thread_key_t fl_key;
+
+void * alloc8bytes()
+{
+    void ** my_free_list_ptr;
+    void * my_free_list;
+    
+    if (thr_getspecific(fl_key, (void **)(&my_free_list_ptr)) != 0) {
+       (void)GC_printf0("thr_getspecific failed\n");
+       FAIL;
+    }
+    if (my_free_list_ptr == 0) {
+        my_free_list_ptr = GC_NEW_UNCOLLECTABLE(void *);
+        if (thr_setspecific(fl_key, my_free_list_ptr) != 0) {
+           (void)GC_printf0("thr_setspecific failed\n");
+           FAIL;
+        }
+    }
+    my_free_list = *my_free_list_ptr;
+    if (my_free_list == 0) {
+        my_free_list = GC_malloc_many(8);
+        if (my_free_list == 0) {
+            (void)GC_printf0("alloc8bytes out of memory\n");
+           FAIL;
+        }
+    }
+    *my_free_list_ptr = GC_NEXT(my_free_list);
+    GC_NEXT(my_free_list) = 0;
+    return(my_free_list);
+}
+
+#else
+# define alloc8bytes() GC_MALLOC_ATOMIC(8)
+#endif
+
 void alloc_small(n)
 int n;
 {
     register int i;
     
     for (i = 0; i < n; i += 8) {
-        if (GC_MALLOC_ATOMIC(8) == 0) {
-            (void)printf("Out of memory\n");
+        if (alloc8bytes() == 0) {
+            (void)GC_printf0("Out of memory\n");
             FAIL;
         }
     }
 }
 
-tree_test()
+void tree_test()
 {
-    tn * root = mktree(16);
+    tn * root;
     register int i;
     
+    root = mktree(16);
     alloc_small(5000000);
     chktree(root, 16);
     if (finalized_count && ! dropped_something) {
-        (void)printf("Premature finalization - collector is broken\n");
+        (void)GC_printf0("Premature finalization - collector is broken\n");
         FAIL;
     }
     dropped_something = 1;
@@ -415,9 +497,65 @@ tree_test()
     alloc_small(5000000);
 }
 
-# include "gc_private.h"
+unsigned n_tests = 0;
 
-int n_tests = 0;
+/* A very simple test of explicitly typed allocation   */
+void typed_test()
+{
+    GC_word * old, * new;
+    GC_word bm3 = 0x3;
+    GC_word bm2 = 0x2;
+    GC_word bm_large = 0xf7ff7fff;
+    GC_descr d1 = GC_make_descriptor(&bm3, 2);
+    GC_descr d2 = GC_make_descriptor(&bm2, 2);
+#   ifndef LINT
+      GC_descr dummy = GC_make_descriptor(&bm_large, 32);
+#   endif
+    GC_descr d3 = GC_make_descriptor(&bm_large, 32);
+    register int i;
+    
+    old = 0;
+    for (i = 0; i < 4000; i++) {
+        new = (GC_word *) GC_malloc_explicitly_typed(4 * sizeof(GC_word), d1);
+        new[0] = 17;
+        new[1] = (GC_word)old;
+        old = new;
+        new = (GC_word *) GC_malloc_explicitly_typed(4 * sizeof(GC_word), d2);
+        new[0] = 17;
+        new[1] = (GC_word)old;
+        old = new;
+        new = (GC_word *) GC_malloc_explicitly_typed(13 * sizeof(GC_word), d3);
+        new[0] = 17;
+        new[1] = (GC_word)old;
+        old = new;
+        new = (GC_word *) GC_calloc_explicitly_typed(4, 2 * sizeof(GC_word),
+                                                    d1);
+        new[0] = 17;
+        new[1] = (GC_word)old;
+        old = new;
+        if (i & 0xff) {
+          new = (GC_word *) GC_calloc_explicitly_typed(7, 3 * sizeof(GC_word),
+                                                    d2);
+        } else {
+          new = (GC_word *) GC_calloc_explicitly_typed(1001,
+                                                      3 * sizeof(GC_word),
+                                                      d2);
+        }
+        new[0] = 17;
+        new[1] = (GC_word)old;
+        old = new;
+    }
+    for (i = 0; i < 20000; i++) {
+        if (new[0] != 17) {
+            (void)GC_printf1("typed alloc failed at %lu\n",
+                            (unsigned long)i);
+            FAIL;
+        }
+        new[0] = 0;
+        old = new;
+        new = (GC_word *)(old[1]);
+    }
+}
 
 void run_one_test()
 {
@@ -426,11 +564,18 @@ void run_one_test()
 #   ifndef GC_DEBUG
        if (GC_size(GC_MALLOC(7)) != 8
            || GC_size(GC_MALLOC(15)) != 16) {
-           (void)printf ("GC_size produced unexpected results\n");
+           (void)GC_printf0("GC_size produced unexpected results\n");
            FAIL;
        }
 #   endif
     reverse_test();
+#   ifdef PRINTSTATS
+       GC_printf0("-------------Finished reverse_test\n");
+#   endif
+    typed_test();
+#   ifdef PRINTSTATS
+       GC_printf0("-------------Finished typed_test\n");
+#   endif
     tree_test();
     LOCK();
     n_tests++;
@@ -457,15 +602,16 @@ void check_heap_stats()
       for (i = 0; i < 16; i++) {
         GC_gcollect();
       }
-    (void)printf("Completed %d tests\n", n_tests);
-    (void)printf("Finalized %d/%d objects - ",
-                finalized_count, finalizable_count);
+    (void)GC_printf1("Completed %lu tests\n", (unsigned long)n_tests);
+    (void)GC_printf2("Finalized %lu/%lu objects - ",
+                    (unsigned long)finalized_count,
+                    (unsigned long)finalizable_count);
     if (finalized_count > finalizable_count
         || finalized_count < finalizable_count/2) {
-        (void)printf ("finalization is probably broken\n");
+        (void)GC_printf0("finalization is probably broken\n");
         FAIL;
     } else {
-        (void)printf ("finalization is probably ok\n");
+        (void)GC_printf0("finalization is probably ok\n");
     }
     still_live = 0;
     for (i = 0; i < MAX_FINALIZED; i++) {
@@ -474,54 +620,65 @@ void check_heap_stats()
        }
     }
     if (still_live != finalizable_count - finalized_count) {
-        (void)printf
-            ("%d disappearing links remain - disappearing links are broken\n");
+        (void)GC_printf1
+            ("%lu disappearing links remain - disappearing links are broken\n",
+             (unsigned long) still_live);
         FAIL;
     }
-    (void)printf("Total number of bytes allocated is %d\n",
-                WORDS_TO_BYTES(GC_words_allocd + GC_words_allocd_before_gc));
-    (void)printf("Final heap size is %d bytes\n", GC_heapsize);
+    (void)GC_printf1("Total number of bytes allocated is %lu\n",
+               (unsigned long)
+                  WORDS_TO_BYTES(GC_words_allocd + GC_words_allocd_before_gc));
+    (void)GC_printf1("Final heap size is %lu bytes\n",
+                    (unsigned long)GC_get_heap_size());
     if (WORDS_TO_BYTES(GC_words_allocd + GC_words_allocd_before_gc)
         < 33500000*n_tests) {
-        (void)printf("Incorrect execution - missed some allocations\n");
+        (void)GC_printf0("Incorrect execution - missed some allocations\n");
         FAIL;
     }
-    if (GC_heapsize > max_heap_sz*n_tests) {
-        (void)printf("Unexpected heap growth - collector may be broken\n");
+    if (GC_get_heap_size() > max_heap_sz*n_tests) {
+        (void)GC_printf0("Unexpected heap growth - collector may be broken\n");
         FAIL;
     }
-    (void)printf("Collector appears to work\n");
+    (void)GC_printf0("Collector appears to work\n");
 }
 
-#ifndef PCR
-main()
+#if !defined(PCR) && !defined(SOLARIS_THREADS) || defined(LINT)
+#ifdef MSWIN32
+  int APIENTRY WinMain(HINSTANCE instance, HINSTANCE prev, LPSTR cmd, int n)
+#else
+  int main()
+#endif
 {
     n_tests = 0;
 #   if defined(MPROTECT_VDB) || defined(PROC_VDB)
       GC_enable_incremental();
-      (void) printf("Switched to incremental mode\n");
+      (void) GC_printf0("Switched to incremental mode\n");
 #     if defined(MPROTECT_VDB)
-       (void)printf("Emulating dirty bits with mprotect/signals\n");
+       (void)GC_printf0("Emulating dirty bits with mprotect/signals\n");
 #     else
-       (void)printf("Reading dirty bits from /proc\n");
+       (void)GC_printf0("Reading dirty bits from /proc\n");
 #      endif
 #   endif
     run_one_test();
     check_heap_stats();
     (void)fflush(stdout);
 #   ifdef LINT
-       /* Entry points we should be testing, but aren't */
+       /* Entry points we should be testing, but aren't.                  */
        /* Some can be tested by defining GC_DEBUG at the top of this file */
+       /* This is a bit SunOS4 specific.                                  */                   
        GC_noop(GC_expand_hp, GC_add_roots, GC_clear_roots,
                GC_register_disappearing_link,
                GC_print_obj, GC_debug_change_stubborn,
                GC_debug_end_stubborn_change, GC_debug_malloc_uncollectable,
                GC_debug_free, GC_debug_realloc, GC_generic_malloc_words_small,
-               GC_init, GC_make_closure, GC_debug_invoke_finalizer);
+               GC_init, GC_make_closure, GC_debug_invoke_finalizer,
+               GC_page_was_ever_dirty, GC_is_fresh);
 #   endif
     return(0);
 }
-# else
+# endif
+
+#ifdef PCR
 test()
 {
     PCR_Th_T * th1;
@@ -535,11 +692,11 @@ test()
     run_one_test();
     if (PCR_Th_T_Join(th1, &code, NIL, PCR_allSigsBlocked, PCR_waitForever)
         != PCR_ERes_okay || code != 0) {
-        (void)printf("Thread 1 failed\n");
+        (void)GC_printf0("Thread 1 failed\n");
     }
     if (PCR_Th_T_Join(th2, &code, NIL, PCR_allSigsBlocked, PCR_waitForever)
         != PCR_ERes_okay || code != 0) {
-        (void)printf("Thread 2 failed\n");
+        (void)GC_printf0("Thread 2 failed\n");
     }
     check_heap_stats();
     (void)fflush(stdout);
@@ -547,3 +704,43 @@ test()
 }
 #endif
 
+#ifdef SOLARIS_THREADS
+void * thr_run_one_test(void * arg)
+{
+    run_one_test();
+    return(0);
+}
+main()
+{
+    thread_t th1;
+    thread_t th2;
+    int code;
+
+    n_tests = 0;
+    GC_enable_incremental();
+    if (thr_keycreate(&fl_key, GC_free) != 0) {
+        (void)GC_printf1("Key creation failed %lu\n", (unsigned long)code);
+       FAIL;
+    }
+    if ((code = thr_create(0, 1024*1024, thr_run_one_test, 0, 0, &th1)) != 0) {
+       (void)GC_printf1("Thread 1 creation failed %lu\n", (unsigned long)code);
+       FAIL;
+    }
+    if ((code = thr_create(0, 1024*1024, thr_run_one_test, 0, THR_NEW_LWP, &th2)) != 0) {
+       (void)GC_printf1("Thread 2 creation failed %lu\n", (unsigned long)code);
+       FAIL;
+    }
+    run_one_test();
+    if ((code = thr_join(th1, 0, 0)) != 0) {
+        (void)GC_printf1("Thread 1 failed %lu\n", (unsigned long)code);
+        FAIL;
+    }
+    if (thr_join(th2, 0, 0) != 0) {
+        (void)GC_printf1("Thread 2 failed %lu\n", (unsigned long)code);
+        FAIL;
+    }
+    check_heap_stats();
+    (void)fflush(stdout);
+    return(0);
+}
+#endif
diff --git a/typd_mlc.c b/typd_mlc.c
new file mode 100644 (file)
index 0000000..7cca4fe
--- /dev/null
@@ -0,0 +1,772 @@
+/*
+ * Copyright (c) 1991-1994 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.
+ *
+ */
+/* Boehm, April 6, 1994 12:49 pm PDT */
+
+
+/*
+ * Some simple primitives for allocation with explicit type information.
+ * Simple objects are allocated such that they contain a GC_descr at the
+ * end (in the last allocated word).  This descriptor may be a procedure
+ * which then examines an extended descriptor passed as its environment.
+ *
+ * Arrays are treated as simple objects if they have sufficiently simple
+ * structure.  Otherwise they are allocated from an array kind that supplies
+ * a special mark procedure.  These arrays contain a pointer to a
+ * complex_descriptor as their last word.
+ * This is done because the environment field is too small, and the collector
+ * must trace the complex_descriptor.
+ *
+ * Note that descriptors inside objects may appear cleared, if we encounter a
+ * false refrence to an object on a free list.  In the GC_descr case, this
+ * is OK, since a 0 descriptor corresponds to examining no fields.
+ * In the complex_descriptor case, we explicitly check for that case.
+ *
+ * MAJOR PARTS OF THIS CODE HAVE NOT BEEN TESTED AT ALL and are not testable,
+ * since they are not accessible through the current interface.
+ */
+
+#include "gc_priv.h"
+#include "gc_mark.h"
+#include "gc_typed.h"
+
+# ifdef ADD_BYTE_AT_END
+#   define EXTRA_BYTES (sizeof(word) - 1)
+# else
+#   define EXTRA_BYTES (sizeof(word))
+# endif
+
+bool GC_explicit_typing_initialized = FALSE;
+
+int GC_explicit_kind;  /* Object kind for objects with indirect        */
+                       /* (possibly extended) descriptors.             */
+
+int GC_array_kind;     /* Object kind for objects with complex         */
+                       /* descriptors and GC_array_mark_proc.          */
+
+/* Extended descriptors.  GC_typed_mark_proc understands these.        */
+/* These are used for simple objects that are larger than what */
+/* can be described by a BITMAP_BITS sized bitmap.             */
+typedef struct {
+       word ed_bitmap; /* lsb corresponds to first word.       */
+       bool ed_continued;      /* next entry is continuation.  */
+} ext_descr;
+
+/* Array descriptors.  GC_array_mark_proc understands these.   */
+/* We may eventually need to add provisions for headers and    */
+/* trailers.  Hence we provide for tree structured descriptors, */
+/* though we don't really use them currently.                  */
+typedef union ComplexDescriptor {
+    struct LeafDescriptor {    /* Describes simple array       */
+        word ld_tag;
+#      define LEAF_TAG 1
+       word ld_size;           /* bytes per element    */
+                               /* multiple of ALIGNMENT        */
+       word ld_nelements;      /* Number of elements.  */
+       GC_descr ld_descriptor; /* A simple length, bitmap,     */
+                               /* or procedure descriptor.     */
+    } ld;
+    struct ComplexArrayDescriptor {
+        word ad_tag;
+#      define ARRAY_TAG 2
+       word ad_nelements;
+       union ComplexDescriptor * ad_element_descr;
+    } ad;
+    struct SequenceDescriptor {
+        word sd_tag;
+#      define SEQUENCE_TAG 3
+       union ComplexDescriptor * sd_first;
+       union ComplexDescriptor * sd_second;
+    } sd;
+} complex_descriptor;
+#define TAG ld.ld_tag
+
+ext_descr * GC_ext_descriptors;        /* Points to array of extended  */
+                               /* descriptors.                 */
+
+word GC_ed_size = 0;   /* Current size of above arrays.        */
+# define ED_INITIAL_SIZE 100;
+
+word GC_avail_descr = 0;       /* Next available slot.         */
+
+int GC_typed_mark_proc_index;  /* Indices of my mark           */
+int GC_array_mark_proc_index;  /* procedures.                  */
+
+/* Add a multiword bitmap to GC_ext_descriptors arrays.  Return        */
+/* starting index.                                             */
+/* Returns -1 on failure.                                      */
+/* Caller does not hold allocation lock.                       */
+signed_word GC_add_ext_descriptor(bm, nbits)
+GC_bitmap bm;
+word nbits;
+{
+    register size_t nwords = divWORDSZ(nbits + WORDSZ-1);
+    register signed_word result;
+    register word i;
+    register word last_part;
+    register int extra_bits;
+    DCL_LOCK_STATE;
+
+    DISABLE_SIGNALS();
+    LOCK();
+    while (GC_avail_descr + nwords >= GC_ed_size) {
+       ext_descr * new;
+       size_t new_size;
+       word ed_size = GC_ed_size;
+       
+       UNLOCK();
+        ENABLE_SIGNALS();
+       if (ed_size == 0) {
+           new_size = ED_INITIAL_SIZE;
+       } else {
+           new_size = 2 * ed_size;
+           if (new_size > MAX_ENV) return(-1);
+       } 
+       new = (ext_descr *) GC_malloc_atomic(new_size * sizeof(ext_descr));
+       if (new == 0) return(-1);
+       DISABLE_SIGNALS();
+        LOCK();
+        if (ed_size == GC_ed_size) {
+            if (GC_avail_descr != 0) {
+               BCOPY(GC_ext_descriptors, new,
+                     GC_avail_descr * sizeof(ext_descr));
+           }
+           GC_ed_size = new_size;
+           GC_ext_descriptors = new;
+       }  /* else another thread already resized it in the meantime */
+    }
+    result = GC_avail_descr;
+    for (i = 0; i < nwords-1; i++) {
+        GC_ext_descriptors[result + i].ed_bitmap = bm[i];
+        GC_ext_descriptors[result + i].ed_continued = TRUE;
+    }
+    last_part = bm[i];
+    /* Clear irrelevant bits. */
+    extra_bits = nwords * WORDSZ - nbits;
+    last_part <<= extra_bits;
+    last_part >>= extra_bits;
+    GC_ext_descriptors[result + i].ed_bitmap = last_part;
+    GC_ext_descriptors[result + i].ed_continued = FALSE;
+    GC_avail_descr += nwords;
+    UNLOCK();
+    ENABLE_SIGNALS();
+    return(result);
+}
+
+/* Table of bitmap descriptors for n word long all pointer objects.    */
+GC_descr GC_bm_table[WORDSZ/2];
+       
+/* Return a descriptor for the concatenation of 2 nwords long objects, */
+/* each of which is described by descriptor.                           */
+/* The result is known to be short enough to fit into a bitmap         */
+/* descriptor.                                                         */
+/* Descriptor is a DS_LENGTH or DS_BITMAP descriptor.                  */
+GC_descr GC_double_descr(descriptor, nwords)
+register GC_descr descriptor;
+register word nwords;
+{
+    if (descriptor && DS_TAGS == DS_LENGTH) {
+        descriptor = GC_bm_table[BYTES_TO_WORDS((word)descriptor)];
+    };
+    descriptor |= (descriptor & ~DS_TAGS) >> nwords;
+    return(descriptor);
+}
+
+complex_descriptor * GC_make_sequence_descriptor();
+
+/* Build a descriptor for an array with nelements elements,    */
+/* each of which can be described by a simple descriptor.      */
+/* We try to optimize some common cases.                       */
+/* If the result is COMPLEX, then a complex_descr* is returned  */
+/* in *complex_d.                                                      */
+/* If the result is LEAF, then we built a LeafDescriptor in    */
+/* the structure pointed to by leaf.                           */
+/* The tag in the leaf structure is not set.                   */
+/* If the result is SIMPLE, then a GC_descr                    */
+/* is returned in *simple_d.                                   */
+/* If the result is NO_MEM, then                               */
+/* we failed to allocate the descriptor.                       */
+/* The implementation knows that DS_LENGTH is 0.               */
+/* *leaf, *complex_d, and *simple_d may be used as temporaries */
+/* during the construction.                                    */
+# define COMPLEX 2
+# define LEAF 1
+# define SIMPLE 0
+# define NO_MEM (-1)
+int GC_make_array_descriptor(nelements, size, descriptor,
+                            simple_d, complex_d, leaf)
+word size;
+word nelements;
+GC_descr descriptor;
+GC_descr *simple_d;
+complex_descriptor **complex_d;
+struct LeafDescriptor * leaf;
+{
+#   define OPT_THRESHOLD 50
+       /* For larger arrays, we try to combine descriptors of adjacent */
+       /* descriptors to speed up marking, and to reduce the amount    */
+       /* of space needed on the mark stack.                           */
+    if ((descriptor & DS_TAGS) == DS_LENGTH) {
+      if ((word)descriptor == size) {
+       *simple_d = nelements * descriptor;
+       return(SIMPLE);
+      } else if ((word)descriptor == 0) {
+        *simple_d = (GC_descr)0;
+        return(SIMPLE);
+      }
+    }
+    if (nelements <= OPT_THRESHOLD) {
+      if (nelements <= 1) {
+        if (nelements == 1) {
+            *simple_d = descriptor;
+            return(SIMPLE);
+        } else {
+            *simple_d = (GC_descr)0;
+            return(SIMPLE);
+        }
+      }
+    } else if (size <= BITMAP_BITS/2
+              && (descriptor & DS_TAGS) != DS_PROC
+              && (size & (sizeof(word)-1)) == 0) {
+      int result =      
+          GC_make_array_descriptor(nelements/2, 2*size,
+                                  GC_double_descr(descriptor,
+                                                  BYTES_TO_WORDS(size)),
+                                  simple_d, complex_d, leaf);
+      if ((nelements & 1) == 0) {
+          return(result);
+      } else {
+          struct LeafDescriptor * one_element =
+              (struct LeafDescriptor *)
+               GC_malloc_atomic(sizeof(struct LeafDescriptor));
+          
+          if (result == NO_MEM || one_element == 0) return(NO_MEM);
+          one_element -> ld_tag = LEAF_TAG;
+          one_element -> ld_size = size;
+          one_element -> ld_nelements = 1;
+          one_element -> ld_descriptor = descriptor;
+          switch(result) {
+            case SIMPLE:
+            {
+              struct LeafDescriptor * beginning =
+                (struct LeafDescriptor *)
+                 GC_malloc_atomic(sizeof(struct LeafDescriptor));
+              if (beginning == 0) return(NO_MEM);
+              beginning -> ld_tag = LEAF_TAG;
+              beginning -> ld_size = size;
+              beginning -> ld_nelements = 1;
+              beginning -> ld_descriptor = *simple_d;
+              *complex_d = GC_make_sequence_descriptor(
+                               (complex_descriptor *)beginning,
+                               (complex_descriptor *)one_element);
+              break;
+            }
+            case LEAF:
+            {
+              struct LeafDescriptor * beginning =
+                (struct LeafDescriptor *)
+                 GC_malloc_atomic(sizeof(struct LeafDescriptor));
+              if (beginning == 0) return(NO_MEM);
+              beginning -> ld_tag = LEAF_TAG;
+              beginning -> ld_size = leaf -> ld_size;
+              beginning -> ld_nelements = leaf -> ld_nelements;
+              beginning -> ld_descriptor = leaf -> ld_descriptor;
+              *complex_d = GC_make_sequence_descriptor(
+                               (complex_descriptor *)beginning,
+                               (complex_descriptor *)one_element);
+              break;
+            }
+            case COMPLEX:
+              *complex_d = GC_make_sequence_descriptor(
+                               *complex_d,
+                               (complex_descriptor *)one_element);
+              break;
+          }
+          return(COMPLEX);
+      }
+    }
+    {
+        leaf -> ld_size = size;
+        leaf -> ld_nelements = nelements;
+        leaf -> ld_descriptor = descriptor;
+        return(LEAF);
+    }
+}
+
+complex_descriptor * GC_make_sequence_descriptor(first, second)
+complex_descriptor * first;
+complex_descriptor * second;
+{
+    struct SequenceDescriptor * result =
+        (struct SequenceDescriptor *)
+               GC_malloc(sizeof(struct SequenceDescriptor));
+    /* Can't result in overly conservative marking, since tags are     */
+    /* very small integers. Probably faster than maintaining type      */
+    /* info.                                                           */    
+    if (result != 0) {
+       result -> sd_tag = SEQUENCE_TAG;
+        result -> sd_first = first;
+        result -> sd_second = second;
+    }
+    return((complex_descriptor *)result);
+}
+
+#ifdef UNDEFINED
+complex_descriptor * GC_make_complex_array_descriptor(nelements, descr)
+word nelements;
+complex_descriptor * descr;
+{
+    struct ComplexArrayDescriptor * result =
+        (struct ComplexArrayDescriptor *)
+               GC_malloc(sizeof(struct ComplexArrayDescriptor));
+    
+    if (result != 0) {
+       result -> ad_tag = ARRAY_TAG;
+        result -> ad_nelements = nelements;
+        result -> ad_element_descr = descr;
+    }
+    return((complex_descriptor *)result);
+}
+#endif
+
+ptr_t * GC_eobjfreelist;
+
+ptr_t * GC_arobjfreelist;
+
+struct hblk ** GC_ereclaim_list;
+
+struct hblk ** GC_arreclaim_list;
+
+mse * GC_typed_mark_proc();
+
+mse * GC_array_mark_proc();
+
+GC_descr GC_generic_array_descr;
+
+/* Caller does not hold allocation lock. */
+void GC_init_explicit_typing()
+{
+    register int i;
+    ptr_t * eobjfreelist;
+    ptr_t * arobjfreelist;
+    struct hblk ** ereclaim_list;
+    struct hblk ** arreclaim_list;
+    DCL_LOCK_STATE;
+
+    
+#   ifdef PRINTSTATS
+       if (sizeof(struct LeafDescriptor) % sizeof(word) != 0)
+           ABORT("Bad leaf descriptor size");
+#   endif
+    /* Preallocate before acquiring lock. */
+      eobjfreelist = (ptr_t *)
+          GC_generic_malloc_inner((MAXOBJSZ+1)*sizeof(ptr_t), PTRFREE);
+      if (eobjfreelist == 0) ABORT("Couldn't allocate GC_eobjfreelist");
+      BZERO(eobjfreelist, (MAXOBJSZ+1)*sizeof(ptr_t));
+      ereclaim_list = (struct hblk **)
+       GC_generic_malloc_inner((MAXOBJSZ+1)*sizeof(struct hblk *), PTRFREE);
+      if (ereclaim_list == 0) ABORT("Couldn't allocate GC_ereclaim_list");
+      BZERO(ereclaim_list, (MAXOBJSZ+1)*sizeof(struct hblk *));
+      arobjfreelist = (ptr_t *)
+          GC_generic_malloc_inner((MAXOBJSZ+1)*sizeof(ptr_t), PTRFREE);
+      if (arobjfreelist == 0) ABORT("Couldn't allocate GC_arobjfreelist");
+      BZERO(arobjfreelist, (MAXOBJSZ+1)*sizeof(ptr_t));
+      arreclaim_list = (struct hblk **)
+       GC_generic_malloc_inner((MAXOBJSZ+1)*sizeof(struct hblk *), PTRFREE);
+      if (arreclaim_list == 0) ABORT("Couldn't allocate GC_arreclaim_list");
+      BZERO(arreclaim_list, (MAXOBJSZ+1)*sizeof(struct hblk *));
+    DISABLE_SIGNALS();
+    LOCK();
+    if (GC_explicit_typing_initialized) {
+      UNLOCK();
+      ENABLE_SIGNALS();
+      return;
+    }
+    GC_explicit_typing_initialized = TRUE;
+    /* Set up object kind with simple indirect descriptor. */
+      GC_eobjfreelist = eobjfreelist;
+      GC_ereclaim_list = ereclaim_list;
+      GC_explicit_kind = GC_n_kinds++;
+      GC_obj_kinds[GC_explicit_kind].ok_freelist = GC_eobjfreelist;
+      GC_obj_kinds[GC_explicit_kind].ok_reclaim_list = GC_ereclaim_list;
+      GC_obj_kinds[GC_explicit_kind].ok_descriptor =
+               (((word)WORDS_TO_BYTES(-1)) | DS_PER_OBJECT);
+      GC_obj_kinds[GC_explicit_kind].ok_relocate_descr = TRUE;
+      GC_obj_kinds[GC_explicit_kind].ok_init = TRUE;
+               /* Descriptors are in the last word of the object. */
+      GC_typed_mark_proc_index = GC_n_mark_procs;
+      GC_mark_procs[GC_typed_mark_proc_index] = GC_typed_mark_proc;
+      GC_n_mark_procs++;
+        /* Moving this up breaks DEC AXP compiler.      */
+    /* Set up object kind with array descriptor. */
+      GC_arobjfreelist = arobjfreelist;
+      GC_arreclaim_list = arreclaim_list;
+      if (GC_arreclaim_list == 0) ABORT("Couldn't allocate GC_arreclaim_list");
+      if (GC_n_mark_procs >= MAX_MARK_PROCS)
+               ABORT("No slot for array mark proc");
+      GC_array_mark_proc_index = GC_n_mark_procs++;
+      if (GC_n_kinds >= MAXOBJKINDS)
+               ABORT("No kind available for array objects");
+      GC_array_kind = GC_n_kinds++;
+      GC_obj_kinds[GC_array_kind].ok_freelist = GC_arobjfreelist;
+      GC_obj_kinds[GC_array_kind].ok_reclaim_list = GC_arreclaim_list;
+      GC_obj_kinds[GC_array_kind].ok_descriptor =
+               MAKE_PROC(GC_array_mark_proc_index, 0);;
+      GC_obj_kinds[GC_array_kind].ok_relocate_descr = FALSE;
+      GC_obj_kinds[GC_array_kind].ok_init = TRUE;
+               /* Descriptors are in the last word of the object. */
+            GC_mark_procs[GC_array_mark_proc_index] = GC_array_mark_proc;
+      for (i = 0; i < WORDSZ/2; i++) {
+          GC_descr d = (((word)(-1)) >> (WORDSZ - i)) << (WORDSZ - i);
+          d |= DS_BITMAP;
+          GC_bm_table[i] = d;
+      }
+      GC_generic_array_descr = MAKE_PROC(GC_array_mark_proc_index, 0); 
+    UNLOCK();
+    ENABLE_SIGNALS();
+}
+
+mse * GC_typed_mark_proc(addr, mark_stack_ptr, mark_stack_limit, env)
+register word * addr;
+register mse * mark_stack_ptr;
+mse * mark_stack_limit;
+word env;
+{
+    register word bm = GC_ext_descriptors[env].ed_bitmap;
+    register word * current_p = addr;
+    register word current;
+    register ptr_t greatest_ha = GC_greatest_plausible_heap_addr;
+    register ptr_t least_ha = GC_least_plausible_heap_addr;
+    
+    for (; bm != 0; bm >>= 1, current_p++) {
+       if (bm & 1) {
+           current = *current_p;
+           if ((ptr_t)current >= least_ha && (ptr_t)current <= greatest_ha) {
+               PUSH_CONTENTS(current, mark_stack_ptr, mark_stack_limit);
+           }
+       }
+    }
+    if (GC_ext_descriptors[env].ed_continued) {
+        /* Push an entry with the rest of the descriptor back onto the */
+        /* stack.  Thus we never do too much work at once.  Note that  */
+        /* we also can't overflow the mark stack unless we actually    */
+        /* mark something.                                             */
+        mark_stack_ptr++;
+        if (mark_stack_ptr >= mark_stack_limit) {
+            mark_stack_ptr = GC_signal_mark_stack_overflow(mark_stack_ptr);
+        }
+        mark_stack_ptr -> mse_start = addr + WORDSZ;
+        mark_stack_ptr -> mse_descr =
+               MAKE_PROC(GC_typed_mark_proc_index, env+1);
+    }
+    return(mark_stack_ptr);
+}
+
+/* Return the size of the object described by d.  It would be faster to        */
+/* store this directly, or to compute it as part of                    */
+/* GC_push_complex_descriptor, but hopefully it doesn't matter.                */
+word GC_descr_obj_size(d)
+register complex_descriptor *d;
+{
+    switch(d -> TAG) {
+      case LEAF_TAG:
+       return(d -> ld.ld_nelements * d -> ld.ld_size);
+      case ARRAY_TAG:
+        return(d -> ad.ad_nelements
+               * GC_descr_obj_size(d -> ad.ad_element_descr));
+      case SEQUENCE_TAG:
+        return(GC_descr_obj_size(d -> sd.sd_first)
+               + GC_descr_obj_size(d -> sd.sd_second));
+      default:
+        ABORT("Bad complex descriptor");
+        /*NOTREACHED*/
+    }
+}
+
+/* Push descriptors for the object at addr with complex descriptor d   */
+/* onto the mark stack.  Return 0 if the mark stack overflowed.        */
+mse * GC_push_complex_descriptor(addr, d, msp, msl)
+word * addr;
+register complex_descriptor *d;
+register mse * msp;
+mse * msl;
+{
+    register ptr_t current = (ptr_t) addr;
+    register word nelements;
+    register word sz;
+    register word i;
+    
+    switch(d -> TAG) {
+      case LEAF_TAG:
+        {
+          register GC_descr descr = d -> ld.ld_descriptor;
+          
+          nelements = d -> ld.ld_nelements;
+          if (msl - msp <= (ptrdiff_t)nelements) return(0);
+          sz = d -> ld.ld_size;
+          for (i = 0; i < nelements; i++) {
+              msp++;
+              msp -> mse_start = (word *)current;
+              msp -> mse_descr = descr;
+              current += sz;
+          }
+          return(msp);
+        }
+      case ARRAY_TAG:
+        {
+          register complex_descriptor *descr = d -> ad.ad_element_descr;
+          
+          nelements = d -> ad.ad_nelements;
+          sz = GC_descr_obj_size(descr);
+          for (i = 0; i < nelements; i++) {
+              msp = GC_push_complex_descriptor((word *)current, descr,
+                                               msp, msl);
+              if (msp == 0) return(0);
+              current += sz;
+          }
+          return(msp);
+        }
+      case SEQUENCE_TAG:
+        {
+          sz = GC_descr_obj_size(d -> sd.sd_first);
+          msp = GC_push_complex_descriptor((word *)current, d -> sd.sd_first,
+                                          msp, msl);
+          if (msp == 0) return(0);
+          current += sz;
+          msp = GC_push_complex_descriptor((word *)current, d -> sd.sd_second,
+                                          msp, msl);
+          return(msp);
+        }
+      default:
+        ABORT("Bad complex descriptor");
+        /*NOTREACHED*/
+    }
+}
+
+/*ARGSUSED*/
+mse * GC_array_mark_proc(addr, mark_stack_ptr, mark_stack_limit, env)
+register word * addr;
+register mse * mark_stack_ptr;
+mse * mark_stack_limit;
+word env;
+{
+    register hdr * hhdr = HDR(addr);
+    register word sz = hhdr -> hb_sz;
+    register complex_descriptor * descr = (complex_descriptor *)(addr[sz-1]);
+    mse * orig_mark_stack_ptr = mark_stack_ptr;
+    mse * new_mark_stack_ptr;
+    
+    if (descr == 0) {
+       /* Found a reference to a free list entry.  Ignore it. */
+       return(orig_mark_stack_ptr);
+    }
+    /* In use counts were already updated when array descriptor was    */
+    /* pushed.  Here we only replace it by subobject descriptors, so   */
+    /* no update is necessary.                                         */
+    new_mark_stack_ptr = GC_push_complex_descriptor(addr, descr,
+                                                   mark_stack_ptr,
+                                                   mark_stack_limit-1);
+    if (new_mark_stack_ptr == 0) {
+       /* Doesn't fit.  Conservatively push the whole array as a unit  */
+       /* and request a mark stack expansion.                          */
+       /* This cannot cause a mark stack overflow, since it replaces   */
+       /* the original array entry.                                    */
+       GC_mark_stack_too_small = TRUE;
+       new_mark_stack_ptr = orig_mark_stack_ptr + 1;
+       new_mark_stack_ptr -> mse_start = addr;
+       new_mark_stack_ptr -> mse_descr = WORDS_TO_BYTES(sz) | DS_LENGTH;
+    } else {
+        /* Push descriptor itself */
+        new_mark_stack_ptr++;
+        new_mark_stack_ptr -> mse_start = addr + sz - 1;
+        new_mark_stack_ptr -> mse_descr = sizeof(word);
+    }
+    return(new_mark_stack_ptr);
+}
+
+#if defined(__STDC__) || defined(__cplusplus)
+  GC_descr GC_make_descriptor(GC_bitmap bm, size_t len)
+#else
+  GC_descr GC_make_descriptor(bm, len)
+  GC_bitmap bm;
+  size_t len;
+#endif
+{
+    register signed_word last_set_bit = len - 1;
+    register word result;
+    register int i;
+#   define HIGH_BIT (((word)1) << (WORDSZ - 1))
+    
+    if (!GC_explicit_typing_initialized) GC_init_explicit_typing();
+    while (last_set_bit >= 0 && !GC_get_bit(bm, last_set_bit)) last_set_bit --;
+    if (last_set_bit < 0) return(0 /* no pointers */);
+#   if ALIGNMENT == CPP_WORDSZ/8
+    {
+      register bool all_bits_set = TRUE;
+      for (i = 0; i < last_set_bit; i++) {
+       if (!GC_get_bit(bm, i)) {
+           all_bits_set = FALSE;
+           break;
+       }
+      }
+      if (all_bits_set) {
+       /* An initial section contains all pointers.  Use length descriptor. */
+        return(WORDS_TO_BYTES(last_set_bit+1) | DS_LENGTH);
+      }
+    }
+#   endif
+    if (last_set_bit < BITMAP_BITS) {
+       /* Hopefully the common case.                   */
+       /* Build bitmap descriptor (with bits reversed) */
+       result = HIGH_BIT;
+       for (i = last_set_bit - 1; i >= 0; i--) {
+           result >>= 1;
+           if (GC_get_bit(bm, i)) result |= HIGH_BIT;
+       }
+       result |= DS_BITMAP;
+       return(result);
+    } else {
+       signed_word index;
+       
+       index = GC_add_ext_descriptor(bm, (word)last_set_bit+1);
+       if (index == -1) return(WORDS_TO_BYTES(last_set_bit+1) | DS_LENGTH);
+                               /* Out of memory: use conservative      */
+                               /* approximation.                       */
+       result = MAKE_PROC(GC_typed_mark_proc_index, (word)index);
+       return(result);
+    }
+}
+
+ptr_t GC_clear_stack();
+
+#define GENERAL_MALLOC(lb,k) \
+    (extern_ptr_t)GC_clear_stack(GC_generic_malloc((word)lb, k))
+    
+#if defined(__STDC__) || defined(__cplusplus)
+  extern void * GC_malloc_explicitly_typed(size_t lb, GC_descr d)
+#else
+  extern char * GC_malloc_explicitly_typed(lb, d)
+  size_t lb;
+  GC_descr d;
+#endif
+{
+register ptr_t op;
+register ptr_t * opp;
+register word lw;
+DCL_LOCK_STATE;
+
+    lb += EXTRA_BYTES;
+    if( SMALL_OBJ(lb) ) {
+#       ifdef MERGE_SIZES
+         lw = GC_size_map[lb];
+#      else
+         lw = ROUNDED_UP_WORDS(lb);
+#       endif
+       opp = &(GC_eobjfreelist[lw]);
+       FASTLOCK();
+        if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {
+            FASTUNLOCK();
+            op = (ptr_t)GENERAL_MALLOC((word)lb, GC_explicit_kind);
+#          ifdef MERGE_SIZES
+               lw = GC_size_map[lb];   /* May have been uninitialized. */            
+#          endif
+        } else {
+            *opp = obj_link(op);
+            GC_words_allocd += lw;
+            FASTUNLOCK();
+        }
+   } else {
+       op = (ptr_t)GENERAL_MALLOC((word)lb, GC_explicit_kind);
+       lw = BYTES_TO_WORDS(GC_size(op));
+   }
+   ((word *)op)[lw - 1] = d;
+   return((extern_ptr_t) op);
+}
+
+#if defined(__STDC__) || defined(__cplusplus)
+  void * GC_calloc_explicitly_typed(size_t n,
+                                   size_t lb,
+                                   GC_descr d)
+#else
+  char * GC_calloc_explicitly_typed(n, lb, d)
+  size_t n;
+  size_t lb;
+  GC_descr d;
+#endif
+{
+register ptr_t op;
+register ptr_t * opp;
+register word lw;
+GC_descr simple_descr;
+complex_descriptor *complex_descr;
+register int descr_type;
+struct LeafDescriptor leaf;
+DCL_LOCK_STATE;
+
+    descr_type = GC_make_array_descriptor((word)n, (word)lb, d,
+                                         &simple_descr, &complex_descr, &leaf);
+    switch(descr_type) {
+       case NO_MEM: return(0);
+       case SIMPLE: return(GC_malloc_explicitly_typed(n*lb, simple_descr));
+       case LEAF:
+           lb *= n;
+           lb += sizeof(struct LeafDescriptor) + EXTRA_BYTES;
+           break;
+       case COMPLEX:
+           lb *= n;
+           lb += EXTRA_BYTES;
+           break;
+    }
+    if( SMALL_OBJ(lb) ) {
+#       ifdef MERGE_SIZES
+         lw = GC_size_map[lb];
+#      else
+         lw = ROUNDED_UP_WORDS(lb);
+#       endif
+       opp = &(GC_arobjfreelist[lw]);
+       FASTLOCK();
+        if( !FASTLOCK_SUCCEEDED() || (op = *opp) == 0 ) {
+            FASTUNLOCK();
+            op = (ptr_t)GENERAL_MALLOC((word)lb, GC_array_kind);
+#          ifdef MERGE_SIZES
+               lw = GC_size_map[lb];   /* May have been uninitialized. */            
+#          endif
+        } else {
+            *opp = obj_link(op);
+            GC_words_allocd += lw;
+            FASTUNLOCK();
+        }
+   } else {
+       op = (ptr_t)GENERAL_MALLOC((word)lb, GC_array_kind);
+       lw = BYTES_TO_WORDS(GC_size(op));
+   }
+   if (descr_type == LEAF) {
+       /* Set up the descriptor inside the object itself. */
+       VOLATILE struct LeafDescriptor * lp =
+           (struct LeafDescriptor *)
+               ((word *)op
+                + lw - (BYTES_TO_WORDS(sizeof(struct LeafDescriptor)) + 1));
+                
+       lp -> ld_tag = LEAF_TAG;
+       lp -> ld_size = leaf.ld_size;
+       lp -> ld_nelements = leaf.ld_nelements;
+       lp -> ld_descriptor = leaf.ld_descriptor;
+       ((VOLATILE word *)op)[lw - 1] = (word)lp;
+   } else {
+       ((word *)op)[lw - 1] = (word)complex_descr;
+       /* Make sure the descriptor is cleared once there is any danger */
+       /* it may have been collected.                                  */
+       (void)
+         GC_general_register_disappearing_link((extern_ptr_t *)
+                                                 ((word *)op+lw-1),
+                                                         (extern_ptr_t) op);
+   }
+   return((extern_ptr_t) op);
+}