gcl-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: [Gcl-devel] Re: GCL allocation


From: Camm Maguire
Subject: Re: [Gcl-devel] Re: GCL allocation
Date: 10 Sep 2003 16:10:57 -0400
User-agent: Gnus/5.09 (Gnus v5.9.0) Emacs/21.2

Greetings, and thanks for your clarification.

1) Normally, the user installs gcl by executing 'make install' and
   then invoking gcl via its shell script wrapper, gcl.  In this way
   the saved image is invoked with its full path and your problem is
   avoided. 

2) I don't know exactly why this is not desirable in acl2, but in any
   case I've just checked in a fix for you into 2.6.1 and CVS head.
   The saved_image will attempt to find its full path and use that
   when saving the system. 

3) So far this is installed for linux (and solaris) only, and will
   work only if the /proc filesystem is mounted.  There may be a
   better way, but I don't know of one right now.

4) I'd appreciate patches defining the macro GET_FULL_PATH_SELF in the
   windows, mac, and xBSD headers from people with machines on which
   to test the definition.  Mike and Aurelian, if you want me to
   simply install the snippets you emailed to me instead, please let
   me know.

Take care,
=============================================================================
Index: h/linux.h
===================================================================
RCS file: /cvsroot/gcl/gcl/h/linux.h,v
retrieving revision 1.7.6.1
diff -u -r1.7.6.1 linux.h
--- h/linux.h   4 Sep 2003 02:16:04 -0000       1.7.6.1
+++ h/linux.h   10 Sep 2003 19:31:41 -0000
@@ -168,3 +168,20 @@
    setbuf(stdout,0);
 
 #define INIT_CORE_END terminal_io->sm.sm_object0->sm.sm_fp = 
stdin;terminal_io->sm.sm_object1->sm.sm_fp = stdout;
+
+#include <limits.h>
+#include <sys/stat.h>
+#define GET_FULL_PATH_SELF(a_) do {\
+ char b[20];\
+ static char q[PATH_MAX];\
+ struct stat ss;\
+ if (snprintf(b,sizeof(b),"/proc/%d/exe",getpid())<=0)\
+   error("Cannot write proc exe pathname");\
+ if (stat(b,&ss)) \
+   (a_)=argv[0];\
+ else {\
+   if (!realpath(b,q)) \
+     error("realpath error");\
+   (a_)=q;\
+ }\
+} while(0)
=============================================================================

Jun Sawada <address@hidden> writes:

> Hi Camm,
> 
> Probably my explanation was not careful enough.  In order to recreate the
> problem, you need to copy unixport/saved_gcl to some file named other than
> "gcl", copy it to a directory included in $PATH, execute the copied file,
> and evaluate (si::save-system "gcl").  The name of the saved imaged does
> not matter, but the name of the gcl program itself matters.  I think it is
> easier to send you a complete log file and let you see exactly what I am
> talking about. Please feel free to ask more questions if you cannot
> recreate the symptom.
> 
> (See attached file: gcl-save-bug.log)
> 
> P.S.  It took a little time for me to figure out how to pull out the 2.6.1
> version, but the same thing occurs with it.
> 
> Thanks,
> 
>   Jun Sawada/Austin/IBM
>   IBM Austin Research Laboratory
>   Phone: 512-838-3233     T/L:  678-3233
> 
> Camm Maguire <address@hidden> on 09/05/2003 05:35:34 PM
> 
> To:    Jun Sawada/Austin/address@hidden
> cc:    "Matt Kaufmann" <address@hidden>, address@hidden,
>        address@hidden, address@hidden
> Subject:    Re: [Gcl-devel] Re: GCL allocation
> 
> 
> 
> 
> > BTW, I found that recent versions of gcl cannot save system image using
> > si::save-system unless the gcl  executable name is "gcl" or we specify
> the
> > full path of the executable when we start gcl named other than "gcl".
> >
> 
> I've just tried to reproduce this with 2.6.1 (current stable CVS
> candidate) and CVS HEAD (2.7.0) without success.
> I.e. (si:;save-system "gcl_saved") works fine for me.  Can you try
> with these versions?  My apologies for any confusion -- we've moved to
> a 'linux kernel' version naming system -- x.y.z, with y *even*
> dentotes a stable release, and y *odd* denotes developement/unstable.
> 
> If you need the latest reader patches I've put in for Matt Kaufmann,
> you need 2.7.0.  Please let me know if you need instructions on how to
> pull a given version from the CVS.  ftp.gnu.org is down for some time,
> and we are unable to post tarball releases at present.  Prebuild
> binaries can be found on the Debian website, however.
> 
> Take care,
> 
> >
> >  address@hidden test]$ gcl
> > GCL (GNU Common Lisp)  (2.5.3) Thu Jul  3 14:03:33 CDT 2003
> > Licensed under GNU Library General Public License
> > Dedicated to the memory of W. Schelter
> >
> > Use (help) to get some basic information on how to use GCL.
> >
> > >
> > >(si::save-system "gcl_saved")
> > address@hidden test]$ /usr/local/bin/gcl-p
> > GCL (GNU Common Lisp)  (2.6.0) Fri Aug 29 19:58:11 CDT 2003
> > Licensed under GNU Library General Public License
> > Dedicated to the memory of W. Schelter
> >
> > Use (help) to get some basic information on how to use GCL.
> >
> > >(si::save-system "gcl_saved")
> > address@hidden test]$ gcl-p
> > GCL (GNU Common Lisp)  (2.6.0) Fri Aug 29 19:58:11 CDT 2003
> > Licensed under GNU Library General Public License
> > Dedicated to the memory of W. Schelter
> >
> > Use (help) to get some basic information on how to use GCL.
> >
> > >(si::save-system "gcl_saved")
> > Can't open gcl-p for reading: errno 2
> > address@hidden test]$ acl2
> >
> >
> > This was not the case with old versions of GCL.  This becomes a problem
> > when I launch acl2 (without full path) and try to save the image using
> > si::system-save.   When did it stop working?  Could you fix the problem?
> >
> > Thanks,
> >
> >
> >   Jun Sawada/Austin/IBM
> >   IBM Austin Research Laboratory
> >   Phone: 512-838-3233     T/L:  678-3233
> >
> >
> >
> > Camm Maguire <address@hidden> on 08/29/2003 03:47:47 PM
> >
> > To:    "Matt Kaufmann" <address@hidden>
> > cc:    address@hidden, Jun Sawada/Austin/address@hidden,
> address@hidden,
> >        address@hidden
> > Subject:    Re: [Gcl-devel] Re: GCL allocation
> >
> >
> >
> > Greetings!  OK, I'm enclosing the final patch I've just committed.
> > Passes all known tests, but I'll be continuing to test it out in the
> > coming days.  Any reports on problems with this most appreciated.
> >
> > BTW, this shouldn't really affect performance that much, but should
> > completely cure the allocation error you reported in the bignum
> > example.  The patch you tested had some debugging calls which are now
> > removed unless one defined SGC_CONT_DEBUG.  Any further tests will
> > probably be a bit faster but noting to write home about.
> >
> > Here's an interesting toy benchmark based on your example:
> >
> >
> =============================================================================
> 
> >
> > test3.lisp
> >
> =============================================================================
> 
> >
> > (in-package 'user)
> > (defconstant *A* #x5A39BFA0E42A3D15)
> > (defconstant *M* (expt 2 63))
> > (defconstant *C* 1)
> >
> >
> > (defun genseed (seed)
> >   (mod (+ (* *A* seed) *C*) *M*))
> >
> >
> > (defun testfun (n seed)
> >   (if (or (not (integerp n)) (<= n 0))
> >       seed
> >       (let* ((s0 (genseed seed))
> >            (s1 (genseed s0)))
> >       (testfun (1- n) s1))))
> >
> >
> =============================================================================
> 
> >
> > foo
> >
> =============================================================================
> 
> >
> > ;(si::sgc-on t)
> > (si::allocate-relocatable-pages 500)
> > (si::allocate-contiguous-pages 500)
> > ;(si::allocate-sgc 'contiguous 500 3000 0)
> > (si::allocate 'cfun 166)
> > (si::allocate-sgc 'cfun 166 3000 0)
> > (in-package "USER")
> > ;(compile-file "/tmp/test3.lisp") ; test3.lisp is shown below
> > (load "/tmp/test3")
> > (format t "~S~%" (testfun 1000000 3))
> >
> =============================================================================
> 
> >
> > (defun bench (&aux res)
> > ;  (setq si::*notify-gbc* t)
> >   (si::allocate-relocatable-pages 500)
> >   (si::allocate-contiguous-pages 500)
> >   (dolist (on '(t nil))
> >     (dolist (reloc '(nil t))
> >       (dolist (bon '(0 167))
> >  (dolist (con '(0 500))
> >    (progn
> >      (si::set-gmp-allocate-relocatable reloc)
> >      (si::allocate-sgc 'cfun bon 3000 0)
> >      (si::allocate-sgc 'contiguous con 3000 0)
> >      (si::sgc-on nil)
> >      (si::sgc-on on)
> >      (si::gbc-time 0)
> >      (load "/tmp/foo")
> >      (let ((foo (list (list on reloc bon con) (si::gbc-time))))
> >        (format t "~S~%" foo)
> >        (push foo  res)))))))
> >   res
> >
> )=============================================================================
> 
> >
> >
> =============================================================================
> 
> >
> > (bench)
> >
> =============================================================================
> 
> >
> > ((NIL T 167 500) 33)
> > (((NIL T 167 500) 33) ((NIL T 167 0) 33) ((NIL T 0 500) 33)
> >  ((NIL T 0 0) 36) ((NIL NIL 167 500) 46) ((NIL NIL 167 0) 48)
> >  ((NIL NIL 0 500) 43) ((NIL NIL 0 0) 39) ((T T 167 500) 125)
> >  ((T T 167 0) 100) ((T T 0 500) 37) ((T T 0 0) 31) ((T NIL 167 500) 65)
> >  ((T NIL 167 0) 68) ((T NIL 0 500) 115) ((T NIL 0 0) 113))
> >
> =============================================================================
> 
> >
> >
> > Take care,
> >
> >
> =============================================================================
> 
> >
> > Index: debian/changelog
> > ===================================================================
> > RCS file: /cvsroot/gcl/gcl/debian/changelog,v
> > retrieving revision 1.220.2.1.4.1.2.1.2.1.2.2.2.1.2.16
> > diff -u -r1.220.2.1.4.1.2.1.2.1.2.2.2.1.2.16 changelog
> > --- debian/changelog    22 Aug 2003 17:09:42 -0000
> > 1.220.2.1.4.1.2.1.2.1.2.2.2.1.2.16
> > +++ debian/changelog    29 Aug 2003 20:38:47 -0000
> > @@ -37,8 +37,9 @@
> >      simultaneously
> >    * Add gazonk*.lsp to clean target
> >    * syntax fix to lsp/gprof.hc
> > +  * Add support for SGC contblock pages
> >
> > - -- Camm Maguire <address@hidden>  Fri, 22 Aug 2003 17:11:19 +0000
> > + -- Camm Maguire <address@hidden>  Fri, 29 Aug 2003 18:34:00 +0000
> >
> >  gcl (2.5.3-2) unstable; urgency=low
> >
> > Index: h/new_decl.h
> > ===================================================================
> > RCS file: /cvsroot/gcl/gcl/h/new_decl.h,v
> > retrieving revision 1.42.4.1.2.2
> > diff -u -r1.42.4.1.2.2 new_decl.h
> > --- h/new_decl.h  20 Jul 2003 18:00:12 -0000    1.42.4.1.2.2
> > +++ h/new_decl.h  29 Aug 2003 20:38:48 -0000
> > @@ -1,465 +1,406 @@
> > -EXTER  object   fLbye   (fixnum exitc) ;
> > -EXTER  object   fLquit   (fixnum exitc) ;
> > -EXTER  object   fLexit   (fixnum exitc) ;
> > -EXTER object  sSAno_initA ;
> > -EXTER  object   fLidentity   (object x0) ;
> > -EXTER  object   fLlisp_implementation_version   (void) ;
> > -EXTER object  sSAlisp_maxpagesA ;
> > -EXTER object  sSAsystem_directoryA ;
> > -EXTER object  sSAmultiply_stacksA ;
> > -EXTER object  sStop_level ;
> > -EXTER object  sSAcommand_argsA ;
> > -EXTER object  sSAafter_gbc_hookA ;
> > -EXTER object  sSAignore_maximum_pagesA ;
> > -EXTER  object   fSallocated   (object typ) ;
> > -EXTER  object   fSreset_number_used   (object typ) ;
> > -EXTER  object   fSstaticp   (object x) ;
> > -EXTER  object   fSallocate   (object type,fixnum npages,...) ;
> > -EXTER  object   fSallocate_sgc   (object type,fixnum min,fixnum
> max,fixnum
> > free_percent) ;
> > -EXTER  object   fSallocate_growth
> > -      (object type,fixnum min,fixnum max,fixnum percent,fixnum
> > percent_free) ;
> > -EXTER  object   fSallocate_contiguous_pages   (fixnum npages,...) ;
> > -EXTER  object   fSallocated_contiguous_pages   (void) ;
> > -EXTER  object   fSmaximum_contiguous_pages   (void) ;
> > -EXTER  object   fSallocate_relocatable_pages   (fixnum npages,...) ;
> > -EXTER  object   fSallocated_relocatable_pages   (void) ;
> > -EXTER  object   fSget_hole_size   (void) ;
> > -EXTER  object   fSset_hole_size   (fixnum npages,...) ;
> > -EXTER  object   fLgbc   (object x0) ;
> > -EXTER object  sSAnotify_gbcA ;
> > -EXTER object  sSAgbc_messageA ;
> > -EXTER object  sLcommon ;
> > -EXTER object  sLnull ;
> > -EXTER object  sLcons ;
> > -EXTER object  sLlist ;
> > -EXTER object  sLsymbol ;
> > -EXTER object  sLarray ;
> > -EXTER object  sLvector ;
> > -EXTER object  sLbit_vector ;
> > -EXTER object  sLstring ;
> > -EXTER object  sLsequence ;
> > -EXTER object  sLsimple_array ;
> > -EXTER object  sLsimple_vector ;
> > -EXTER object  sLsimple_bit_vector ;
> > -EXTER object  sLsimple_string ;
> > -EXTER object  sLfunction ;
> > -EXTER object  sLcompiled_function ;
> > -EXTER object  sLpathname ;
> > -EXTER object  sLcharacter ;
> > -EXTER object  sLnumber ;
> > -EXTER object  sLrational ;
> > -EXTER object  sLfloat ;
> > -EXTER object  sLstring_char ;
> > -EXTER object  sLinteger ;
> > -EXTER object  sLratio ;
> > -EXTER object  sLshort_float ;
> > -EXTER object  sLstandard_char ;
> > -EXTER object  sLboolean ;
> > -EXTER object  sLfixnum ;
> > -EXTER object  sLpositive_fixnum ;
> > -EXTER object  sLcomplex ;
> > -EXTER object  sLsingle_float ;
> > -EXTER object  sLpackage ;
> > -EXTER object  sLbignum ;
> > -EXTER object  sLrandom_state ;
> > -EXTER object  sLdouble_float ;
> > -EXTER object  sLstream ;
> > -EXTER object  sLbit ;
> > -EXTER object  sLreadtable ;
> > -EXTER object  sLlong_float ;
> > -EXTER object  sLhash_table ;
> > -EXTER object  sLkeyword ;
> > -EXTER object  sLstructure ;
> > -EXTER object  sLsatisfies ;
> > -EXTER object  sLmember ;
> > -EXTER object  sLnot ;
> > -EXTER object  sLor ;
> > -EXTER object  sLand ;
> > -EXTER object  sLvalues ;
> > -EXTER object  sLmod ;
> > -EXTER object  sLsigned_byte ;
> > -EXTER object  sLunsigned_byte ;
> > -EXTER object  sLsigned_char ;
> > -EXTER object  sLunsigned_char ;
> > -EXTER object  sLsigned_short ;
> > -EXTER object  sLunsigned_short ;
> > -EXTER object  sLA ;
> > -EXTER object  sLplusp ;
> > -EXTER object  sLmethod_combination ;
> > -EXTER object  sLarithmetic_error ;
> > -EXTER object  sLbase_char ;
> > -EXTER object  sLbase_string ;
> > -EXTER object  sLbroadcast_stream ;
> > -EXTER object  sLbuilt_in_class ;
> > -EXTER object  sLcell_error ;
> > -EXTER object  sLclass ;
> > -EXTER object  sLconcatenated_stream ;
> > -EXTER object  sLcondition ;
> > -EXTER object  sLcontrol_error ;
> > -EXTER object  sLdivision_by_zero ;
> > -EXTER object  sLecho_stream ;
> > -EXTER object  sLend_of_file ;
> > -EXTER object  sLerror ;
> > -EXTER object  sLextended_char ;
> > -EXTER object  sLfile_error ;
> > -EXTER object  sLfile_stream ;
> > -EXTER object  sLfloating_point_inexact ;
> > -EXTER object  sLfloating_point_invalid_operation ;
> > -EXTER object  sLfloating_point_overflow ;
> > -EXTER object  sLfloating_point_underflow ;
> > -EXTER object  sLgeneric_function ;
> > -EXTER object  sLlogical_pathname ;
> > -EXTER object  sLmethod ;
> > -EXTER object  sLpackage_error ;
> > -EXTER object  sLparse_error ;
> > -EXTER object  sLprint_not_readable ;
> > -EXTER object  sLprogram_error ;
> > -EXTER object  sLreader_error ;
> > -EXTER object  sLserious_condition ;
> > -EXTER object  sLsimple_base_string ;
> > -EXTER object  sLsimple_condition ;
> > -EXTER object  sLsimple_type_error ;
> > -EXTER object  sLsimple_warning ;
> > -EXTER object  sLstandard_class ;
> > -EXTER object  sLstandard_generic_function ;
> > -EXTER object  sLstandard_method ;
> > -EXTER object  sLstandard_object ;
> > -EXTER object  sLstorage_condition ;
> > -EXTER object  sLstream_error ;
> > -EXTER object  sLstring_stream ;
> > -EXTER object  sLstructure_class ;
> > -EXTER object  sLstructure_object ;
> > -EXTER object  sLstyle_warning ;
> > -EXTER object  sLsynonym_stream ;
> > -EXTER object  sLtwo_way_stream ;
> > -EXTER object  sLtype_error ;
> > -EXTER object  sLunbound_slot ;
> > -EXTER object  sLunbound_variable ;
> > -EXTER object  sLundefined_function ;
> > -EXTER object  sLwarning ;
> > -EXTER object  sSchar_size ;
> > -EXTER object  sSshort_size ;
> > -EXTER  object   fLfuncall   (object fun,...) ;
> > -EXTER  object   fLapply   (object fun,...) ;
> > -EXTER  object   fLeval   (object x0) ;
> > -EXTER  object   fLconstantp   (object x0) ;
> > -EXTER object  sSlambda_block_expanded ;
> > -EXTER object  sSAbreak_pointsA ;
> > -EXTER object  sSAbreak_stepA ;
> > -EXTER  object   fLmacroexpand   (object form,...) ;
> > -EXTER object  sLfuncall ;
> > -EXTER object  sLAmacroexpand_hookA ;
> > -EXTER object  sSdefmacroA ;
> > -EXTER object  sSAinhibit_macro_specialA ;
> > -EXTER  object   fLnot   (object x0) ;
> > -EXTER  object   fLnot   (object x0) ;
> > -EXTER  object   fLsymbolp   (object x0) ;
> > -EXTER  object   fLatom    (object x0) ;
> > -EXTER  object   fLconsp   (object x0) ;
> > -EXTER  object   fLlistp   (object x0) ;
> > -EXTER  object   fLnumberp   (object x0) ;
> > -EXTER  object   fLintegerp    (object x0) ;
> > -EXTER  object   fLrationalp   (object x0) ;
> > -EXTER  object   fLrealp   (object x0) ;
> > -EXTER  object   fLfloatp   (object x0) ;
> > -EXTER  object   fLcomplexp   (object x0) ;
> > -EXTER  object   fLcharacterp   (object x0) ;
> > -EXTER  object   fLstringp    (object x0) ;
> > -EXTER  object   fLbit_vector_p   (object x0) ;
> > -EXTER  object   fLvectorp   (object x0) ;
> > -EXTER  object   fLsimple_string_p   (object x0) ;
> > -EXTER  object   fLsimple_bit_vector_p    (object x0) ;
> > -EXTER  object   fLsimple_vector_p    (object x0) ;
> > -EXTER  object   fLarrayp    (object x0) ;
> > -EXTER  object   fLpackagep    (object x0) ;
> > -EXTER  object   fLfunctionp   (object x0) ;
> > -EXTER  object   fLcompiled_function_p   (object x0) ;
> > -EXTER  object   fLcommonp   (object x0) ;
> > -EXTER  object   fLeq   (object x0,object x1) ;
> > -EXTER  object   fLeql   (object x0,object x1) ;
> > -EXTER  object   fLequal   (object x0,object x1) ;
> > -EXTER  object   fLequalp   (object x0,object x1) ;
> > -EXTER  object   fScontains_sharp_comma   (object x0) ;
> > -EXTER  object   fSspicep    (object x0) ;
> > -EXTER  object   fSfixnump   (object x0) ;
> > -EXTER  object   fLset   (object symbol,object value) ;
> > -EXTER  object   fSfset   (object sym,object function) ;
> > -EXTER  object   fLmakunbound   (object sym) ;
> > -EXTER  object   fLfmakunbound   (object sym) ;
> > -EXTER object  sSclear_compiler_properties ;
> > -EXTER  object   fSclear_compiler_properties   (object x0,object x1) ;
> > -EXTER object  sLaref ;
> > -EXTER object  sLcar ;
> > -EXTER object  sLcdr ;
> > -EXTER object  sLchar ;
> > -EXTER object  sLdecf ;
> > -EXTER object  sLelt ;
> > -EXTER object  sLfill_pointer ;
> > -EXTER object  sLget ;
>  > -EXTER object  sLgetf ;
> > -EXTER object  sLgethash ;
> > -EXTER object  sLincf ;
> > -EXTER object  sLpop ;
> > -EXTER object  sLpush ;
> > -EXTER object  sLschar ;
> > -EXTER object  sLsetf ;
> > -EXTER object  sSsetf_lambda ;
> > -EXTER object  sSstructure_access ;
> > -EXTER object  sLsvref ;
> > -EXTER object  sStraced ;
> > -EXTER object  sLvector ;
> > -EXTER object  sKallow_other_keys ;
> > -EXTER  object   fSerror_set   (volatile object x0) ;
> > -EXTER object  sLgensym_counter ;
> > -EXTER  object   fSmc   (object name,object address) ;
> > -EXTER  object   fSmfsfun   (object name,object address,object argd) ;
> > -EXTER  object   fSmfvfun   (object name,object address,object argd) ;
> > -EXTER  object   fSmfvfun_key   (object symbol,object address,object
> > argd,object keys) ;
> > -EXTER  object   fSmf   (object name,object addr) ;
> > -EXTER  object   fSmm   (object name,object addr) ;
> > -EXTER  object   fScompiled_function_name   (object fun) ;
> > -EXTER  object   fSturbo_closure   (object funobj) ;
> > -EXTER  object   fSspecialp   (object sym) ;
> > -EXTER object  sSdebug ;
> > -EXTER  object   fSdefvar1   (object sym,object val,...) ;
> > -EXTER  object   fSdebug   (object sym,object val) ;
> > -EXTER  object   fSsetvv   (object index,object val) ;
> > -EXTER object  sSPmemory ;
> > -EXTER object  sSPinit ;
> > -EXTER   object    fSinit_cmp_anon   (void) ;
> > -EXTER object  sKexternal ;
> > -EXTER object  sKinherited ;
> > -EXTER object  sKinternal ;
> > -EXTER object  sKnicknames ;
> > -EXTER object  sKuse ;
> > -EXTER object  sLApackageA ;
> > -EXTER  object   fSset_gmp_allocate_relocatable
> > -      (object flag) ;
> > -EXTER  object   fSallocate_bigger_fixnum_range   (fixnum min,fixnum max)
> ;
> > -EXTER  object   fScmod   (object num) ;
> > -EXTER  object   fScplus   (object x0,object x1) ;
> > -EXTER  object   fSctimes   (object x0,object x1) ;
> > -EXTER  object   fScdifference   (object x0,object x1) ;
> > -EXTER  object   fLnth   (fixnum index,object list) ;
> > -EXTER  object   fLfirst   (object x) ;
> > -EXTER  object   fLsecond   (object x) ;
> > -EXTER  object   fLthird   (object x) ;
> > -EXTER  object   fLfourth   (object x) ;
> > -EXTER  object   fLfifth   (object x) ;
> > -EXTER  object   fLsixth   (object x) ;
> > -EXTER  object   fLseventh   (object x) ;
> > -EXTER  object   fLeighth   (object x) ;
> > -EXTER  object   fLninth   (object x) ;
> > -EXTER  object   fLtenth   (object x) ;
> > -EXTER  object   fSnext_hash_table_entry   (object table,object ind) ;
> > -EXTER  object   fLhash_table_test   (object table) ;
> > -EXTER  object   fLhash_table_size   (object table) ;
> > -EXTER object   sLarray_rank_limit ;
> > -EXTER object   sLarray_dimension_limit ;
> > -EXTER object   sLarray_total_size_limit ;
> > -EXTER object  sLbit ;
> > -EXTER   object    fLaref   (object x,fixnum i, ...) ;
> > -EXTER   object    fLsvref   (object x,ufixnum i) ;
> > -EXTER   object    fLrow_major_aref   (object x,fixnum i) ;
> > -EXTER   object    fSaset1   (object x, fixnum i,object val) ;
> > -EXTER   object    fSaset   (object x,fixnum i,object y, ...) ;
> > -EXTER   object    fSsvset   (object x,fixnum i,object val) ;
> > -EXTER  object   fSmake_vector1   (fixnum n,fixnum elt_type,object
> > staticp,...) ;
> > -EXTER  object   fSget_aelttype   (object x) ;
> > -EXTER  object   fSmake_vector   (object x0,object x1,object x2,object
> > x3,object x4,object x5,object x6,...) ;
> > -EXTER  object   fSmake_array1
> > -      (fixnum elt_type,object staticp,object initial_element,object
> > displaced_to,fixnum displaced_index_offset,
> >  -       object dimensions) ;
> > -EXTER  object   fScopy_array_portion   (object x,object y,fixnum
> i1,fixnum
> > i2,object n1o) ;
> > -EXTER  object   fSfill_pointer_set   (object x,fixnum i) ;
> > -EXTER  object   fLfill_pointer   (object x) ;
> > -EXTER  object
> > -      fLarray_has_fill_pointer_p   (object x) ;
> > -EXTER  object   fLarray_element_type   (object x) ;
> > -EXTER  object   fLadjustable_array_p   (object x) ;
> > -EXTER  object   fSdisplaced_array_p   (object x) ;
> > -EXTER  object   fLarray_rank   (object x) ;
> > -EXTER  object   fLarray_dimension   (object x,fixnum i) ;
> > -EXTER  object   fSreplace_array   (object old,object new) ;
> > -EXTER  object   fLarray_total_size   (object x) ;
> > -EXTER  object   fSaset_by_cursor   (object array,object val,object
> cursor)
> > ;
> > -EXTER object  sSAmatch_dataA ;
> > -EXTER object  sSAcase_fold_searchA ;
> > -EXTER  object   fSmatch_beginning   (fixnum i) ;
> > -EXTER  object   fSmatch_end   (fixnum i) ;
> > -EXTER  object   fSstring_match   (object pattern,object string,...) ;
> > -EXTER object  sSs_data ;
> > -EXTER object  sLcompile ;
> > -EXTER object  sLdeclare ;
> > -EXTER object  sLeval ;
> > -EXTER object  sLeval ;
> > -EXTER object  sSfunction_documentation ;
> > -EXTER object  sLload ;
> > -EXTER object  sLprogn ;
> > -EXTER object  sLtypep ;
> > -EXTER object  sLvalues ;
> > -EXTER object  sSvariable_documentation ;
> > -EXTER object  sLwarn ;
> > -EXTER object  sSAallow_gzipped_fileA ;
> > -EXTER object  sKmyaddr ;
> > -EXTER object  sKmyport ;
> > -EXTER object  sKasync ;
> > -EXTER object  sKhost ;
> > -EXTER object  sKserver ;
> > -EXTER object  sSsocket ;
> > -EXTER object  sLAstandard_inputA ;
> > -EXTER object  sLAstandard_outputA ;
> > -EXTER object  sLAerror_outputA ;
> > -EXTER object  sLAterminal_ioA ;
> > -EXTER object  sLAquery_ioA ;
> > -EXTER object  sLAdebug_ioA ;
> > -EXTER object  sLAtrace_outputA ;
> > -EXTER object  sSAignore_eof_on_terminal_ioA ;
> > -EXTER object  sSAload_pathnameA ;
> > -EXTER object  sLAload_verboseA ;
> > -EXTER object  sKabort ;
> > -EXTER object  sKappend ;
> > -EXTER object  sKcreate ;
> > -EXTER object  sKdefault ;
> > -EXTER object  sKdirection ;
> > -EXTER object  sKelement_type ;
> > -EXTER object  sKerror ;
> > -EXTER object  sKif_does_not_exist ;
> > -EXTER object  sKif_exists ;
> > -EXTER object  sKinput ;
> > -EXTER object  sKio ;
> > -EXTER object  sKnew_version ;
> > -EXTER object  sKoutput ;
> > -EXTER object  sKoverwrite ;
> > -EXTER object  sKprint ;
> > -EXTER object  sKprobe ;
> > -EXTER object  sKrename ;
> > -EXTER object  sKrename_and_delete ;
> > -EXTER object  sKset_default_pathname ;
> > -EXTER object  sKsupersede ;
> > -EXTER object  sKverbose ;
> > -EXTER object  sLAread_default_float_formatA ;
> > -EXTER object  sLAread_baseA ;
> > -EXTER object  sLAread_suppressA ;
> > -EXTER object  sSY ;
> > -EXTER object  sSYB ;
> > -EXTER object  sSYZ ;
> > -EXTER object  sLlistA ;
> > -EXTER object  sLappend ;
> > -EXTER object  sLnconc ;
> > -EXTER object  sLapply ;
> > -EXTER object  sLvector ;
> > -EXTER object  sKupcase ;
> > -EXTER object  sKdowncase ;
> > -EXTER object  sKcapitalize ;
> > -EXTER object  sKstream ;
> > -EXTER object  sKescape ;
> > -EXTER object  sKreadably ;
> > -EXTER object  sKpretty ;
> > -EXTER object  sKcircle ;
> > -EXTER object  sKbase ;
> > -EXTER object  sKradix ;
> > -EXTER object  sKcase ;
> > -EXTER object  sKgensym ;
> > -EXTER object  sKlevel ;
> > -EXTER object  sKlength ;
> > -EXTER object  sKarray ;
> > -EXTER object  sLAprint_escapeA ;
> > -EXTER object  sLAprint_readablyA ;
> > -EXTER object  sLAprint_prettyA ;
> > -EXTER object  sLAprint_circleA ;
> > -EXTER object  sLAprint_baseA ;
> > -EXTER object  sLAprint_radixA ;
> > -EXTER object  sLAprint_caseA ;
> > -EXTER object  sLAprint_gensymA ;
> > -EXTER object  sLAprint_levelA ;
> > -EXTER object  sLAprint_lengthA ;
> > -EXTER object  sLAprint_arrayA ;
> > -EXTER object  sSAprint_packageA ;
> > -EXTER object  sSAprint_structureA ;
> > -EXTER object  sSpretty_print_format ;
> > -EXTER object  sSAprint_nansA ;
> > -EXTER  object   fLformat   (object strm, object control,...) ;
> > -EXTER object  sSAindent_formatted_outputA ;
> > -EXTER  object   fSsetenv   (object variable,object value) ;
> > -EXTER  object   fLdelete_file   (object path) ;
> > -EXTER  object   fLerror   (object fmt_string,...) ;
> > -EXTER  object   fLspecific_error   (object error_name,object
> > fmt_string,...) ;
> > -EXTER  object   fLspecific_correctable_error
> > -       (object error_name,object fmt_string,...) ;
> > -EXTER  object   fLcerror   (object continue_fmt_string,object
> > fmt_string,...) ;
> > -EXTER  object   fSihs_top   (void) ;
> > -EXTER  object   fSihs_fun   (object x0) ;
> > -EXTER  object   fSihs_vs   (object x0) ;
> > -EXTER  object   fSfrs_top   (void) ;
> > -EXTER  object   fSfrs_vs   (object x0) ;
> > -EXTER  object   fSfrs_bds   (object x0) ;
> > -EXTER  object   fSfrs_class   (object x0) ;
> > -EXTER  object   fSfrs_tag   (object x0) ;
> > -EXTER  object   fSfrs_ihs   (object x0) ;
> > -EXTER  object   fSbds_top   (void) ;
> > -EXTER  object   fSbds_var   (object x0) ;
> > -EXTER  object   fSbds_val   (object x0) ;
> > -EXTER  object   fSvs_top   (void) ;
> > -EXTER  object   fSvs   (object x0) ;
> > -EXTER  object   fSsch_frs_base   (object x0,object x1) ;
> > -EXTER  object   fSinternal_super_go   (object tag,object x1,object x2) ;
> > -EXTER object  sSuniversal_error_handler ;
> > -EXTER  object   fSuniversal_error_handler   (object x0,object x1,object
> > x2,object x3,object error_fmt_string) ;
> > -EXTER object  sSterminal_interrupt ;
> > -EXTER object  sKwrong_type_argument ;
> > -EXTER object  sKtoo_few_arguments ;
> > -EXTER object  sKtoo_many_arguments ;
> > -EXTER object  sKunexpected_keyword ;
> > -EXTER object  sKinvalid_form ;
> > -EXTER object  sKunbound_variable ;
> > -EXTER object  sKinvalid_variable ;
> > -EXTER object  sKundefined_function ;
> > -EXTER object  sKinvalid_function ;
> > -EXTER object  sKpackage_error ;
> > -EXTER object  sKcatch ;
> > -EXTER object  sKprotect ;
> > -EXTER object  sKcatchall ;
> > -EXTER  object   fLget_universal_time   (void) ;
> > -EXTER  object   fLget_internal_real_time   (void) ;
> > -EXTER object  sSAdefault_time_zoneA ;
> > -EXTER  object   fSgetpid   (void) ;
> > -EXTER  object   fSuse_fast_links   (object flag,...) ;
> > -EXTER object  sScdefn ;
> > -EXTER object  sLAlink_arrayA ;
> > -EXTER  object   fSprofile   (object start_address,object scale) ;
> > -EXTER  object   fSfunction_start   (object funobj) ;
> > -EXTER  object   fSset_up_combined   (object first,...) ;
> > -EXTER  object   fSdisplay_profile   (object start_addr,object scal) ;
> > -EXTER  object   fSarray_adress   (object array) ;
> > -EXTER object  sSAprofile_arrayA ;
> > -EXTER object  sSAinterrupt_enableA ;
> > -EXTER object  sSsigusr1_interrupt ;
> > -EXTER object  sSsigio_interrupt ;
> > -EXTER  object   sSsignal_safety_required   (fixnum signo,fixnum safety)
> ;
> > -EXTER  object   fSallow_signal   (fixnum n) ;
> > -EXTER  object   fSinitfun
> > -      (object sym,object addr_ind,object argd,...) ;
> > -EXTER  object   fSinitmacro   (object first,...) ;
> > -EXTER  object   fSset_key_struct   (object key_struct_ind) ;
> > -EXTER  object   fSinvoke   (object x) ;
> > -EXTER  object   fSopen_named_socket   (fixnum port) ;
> > -EXTER  object   fSclose_fd   (fixnum fd) ;
> > -EXTER  object   fSclose_sfd   (object sfd) ;
> > -EXTER  object   fSaccept_socket_connection   (object named_socket) ;
> > -EXTER  object   fShostname_to_hostid   (object host) ;
> > -EXTER  object   fSgethostname   (void) ;
> > -EXTER  object   fShostid_to_hostname   (object host_id) ;
> > -EXTER  object   fScheck_fd_for_input   (fixnum fd,fixnum timeout) ;
> > -EXTER  object   fSclear_connection   (fixnum fd) ;
> > -EXTER  object   fSconnection_state_fd   (object sfd) ;
> > -EXTER  object   fSour_write   (object sfd,object buffer,fixnum nbytes) ;
> > -EXTER  object   fSour_read_with_offset   (object fd,object buffer,fixnum
> > offset,fixnum nbytes,fixnum timeout) ;
> > -EXTER  object   fSprint_to_string1   (object str,object x,object
> the_code)
> > ;
> > -EXTER  object   fSset_sigio_for_fd   (fixnum fd) ;
> > -EXTER  object   fSreset_string_input_stream   (object strm,object
> > string,fixnum start,fixnum end) ;
> > -EXTER  object   fScheck_state_input   (object osfd,fixnum timeout) ;
> > -EXTER  object   fSclear_connection_state   (object osfd) ;
> > -EXTER  object   fSgetpeername   (object sock) ;
> > -EXTER  object   fSgetsockname   (object sock) ;
> > -EXTER  object   fSset_blocking   (object sock,object setBlocking) ;
> > +EXTER object fLbye (fixnum exitc);
> > +EXTER object fLquit (fixnum exitc);
> > +EXTER object fLexit (fixnum exitc);
> > +EXTER object sSAno_initA;
> > +EXTER object fLidentity (object x0);
> > +EXTER object fLlisp_implementation_version (void);
> > +EXTER object sSAlisp_maxpagesA;
> > +EXTER object sSAsystem_directoryA;
> > +EXTER object sSAmultiply_stacksA;
> > +EXTER object sStop_level;
> > +EXTER object sSAcommand_argsA;
> > +EXTER object sSAafter_gbc_hookA;
> > +EXTER object sSAignore_maximum_pagesA;
> > +EXTER object fSallocated (object typ);
> > +EXTER object fSreset_number_used (object typ);
> > +EXTER object fSstaticp (object x);
> > +EXTER object fSallocate (object type,fixnum npages,...);
> > +EXTER object fSallocate_sgc (object type,fixnum min,fixnum max,fixnum
> > free_percent);
> > +EXTER object fSallocate_growth (object type,fixnum min,fixnum max,fixnum
> > percent,fixnum percent_free);
> > +EXTER object fSallocate_contiguous_pages (fixnum npages,...);
> > +EXTER object fSallocated_contiguous_pages (void);
> > +EXTER object fSmaximum_contiguous_pages (void);
> > +EXTER object fSallocate_relocatable_pages (fixnum npages,...);
> > +EXTER object fSallocated_relocatable_pages (void);
> > +EXTER object fSget_hole_size (void);
> > +EXTER object fSset_hole_size (fixnum npages,...);
> > +EXTER object fLgbc (object x0);
> > +EXTER object sSAnotify_gbcA;
> > +EXTER object sSAgbc_messageA;
> > +EXTER object sLcommon;
> > +EXTER object sLnull;
> > +EXTER object sLcons;
> > +EXTER object sLlist;
> > +EXTER object sLsymbol;
> > +EXTER object sLarray;
> > +EXTER object sLvector;
> > +EXTER object sLbit_vector;
> > +EXTER object sLstring;
> > +EXTER object sLsequence;
> > +EXTER object sLsimple_array;
> > +EXTER object sLsimple_vector;
> > +EXTER object sLsimple_bit_vector;
> > +EXTER object sLsimple_string;
> > +EXTER object sLfunction;
> > +EXTER object sLcompiled_function;
> > +EXTER object sLpathname;
> > +EXTER object sLcharacter;
> > +EXTER object sLnumber;
> > +EXTER object sLrational;
> > +EXTER object sLfloat;
> > +EXTER object sLstring_char;
> > +EXTER object sLinteger;
> > +EXTER object sLratio;
> > +EXTER object sLshort_float;
> > +EXTER object sLstandard_char;
> > +EXTER object sLboolean;
> > +EXTER object sLfixnum;
> > +EXTER object sLpositive_fixnum;
> > +EXTER object sLcomplex;
> > +EXTER object sLsingle_float;
> > +EXTER object sLpackage;
> > +EXTER object sLbignum;
> > +EXTER object sLrandom_state;
> > +EXTER object sLdouble_float;
> > +EXTER object sLstream;
> > +EXTER object sLbit;
> > +EXTER object sLreadtable;
> > +EXTER object sLlong_float;
> > +EXTER object sLhash_table;
> > +EXTER object sLkeyword;
> > +EXTER object sLstructure;
> > +EXTER object sLsatisfies;
> > +EXTER object sLmember;
> > +EXTER object sLnot;
> > +EXTER object sLor;
> > +EXTER object sLand;
> > +EXTER object sLvalues;
> > +EXTER object sLmod;
> > +EXTER object sLsigned_byte;
> > +EXTER object sLunsigned_byte;
> > +EXTER object sLsigned_char;
> > +EXTER object sLunsigned_char;
> > +EXTER object sLsigned_short;
> > +EXTER object sLunsigned_short;
> > +EXTER object sLA;
> > +EXTER object sLplusp;
> > +EXTER object sSchar_size;
> > +EXTER object sSshort_size;
> > +EXTER object fLfuncall (object fun,...);
> > +EXTER object fLapply (object fun,...);
> > +EXTER object fLeval (object x0);
> > +EXTER object fLconstantp (object x0);
>  > +EXTER object sSlambda_block_expanded;
> > +EXTER object sSAbreak_pointsA;
> > +EXTER object sSAbreak_stepA;
> > +EXTER object fLmacroexpand (object form,...);
> > +EXTER object sLfuncall;
> > +EXTER object sLAmacroexpand_hookA;
> > +EXTER object sSdefmacroA;
> > +EXTER object sSAinhibit_macro_specialA;
> > +EXTER object fLnot (object x0);
> > +EXTER object fLnot (object x0);
> > +EXTER object fLsymbolp (object x0);
> > +EXTER object fLatom (object x0);
> > +EXTER object fLconsp (object x0);
> > +EXTER object fLlistp (object x0);
> > +EXTER object fLnumberp (object x0);
> > +EXTER object fLintegerp (object x0);
> > +EXTER object fLrationalp (object x0);
> > +EXTER object fLrealp (object x0);
> > +EXTER object fLfloatp (object x0);
> > +EXTER object fLcomplexp (object x0);
> > +EXTER object fLcharacterp (object x0);
> > +EXTER object fLstringp (object x0);
> > +EXTER object fLbit_vector_p (object x0);
> > +EXTER object fLvectorp (object x0);
> > +EXTER object fLsimple_string_p (object x0);
> > +EXTER object fLsimple_bit_vector_p (object x0);
> > +EXTER object fLsimple_vector_p (object x0);
> > +EXTER object fLarrayp (object x0);
> > +EXTER object fLpackagep (object x0);
> > +EXTER object fLfunctionp (object x0);
> > +EXTER object fLcompiled_function_p (object x0);
> > +EXTER object fLcommonp (object x0);
> > +EXTER object fLeq (object x0,object x1);
> > +EXTER object fLeql (object x0,object x1);
> > +EXTER object fLequal (object x0,object x1);
> > +EXTER object fLequalp (object x0,object x1);
> > +EXTER object fScontains_sharp_comma (object x0);
> > +EXTER object fSspicep (object x0);
> > +EXTER object fSfixnump (object x0);
> > +EXTER object fLset (object symbol,object value);
> > +EXTER object fSfset (object sym,object function);
> > +EXTER object fLmakunbound (object sym);
> > +EXTER object fLfmakunbound (object sym);
> > +EXTER object sSclear_compiler_properties;
> > +EXTER object fSclear_compiler_properties (object x0,object x1);
> > +EXTER object sLaref;
> > +EXTER object sLcar;
> > +EXTER object sLcdr;
> > +EXTER object sLchar;
> > +EXTER object sLdecf;
> > +EXTER object sLelt;
> > +EXTER object sLfill_pointer;
> > +EXTER object sLget;
> > +EXTER object sLgetf;
> > +EXTER object sLgethash;
> > +EXTER object sLincf;
> > +EXTER object sLpop;
> > +EXTER object sLpush;
> > +EXTER object sLschar;
> > +EXTER object sLsetf;
> > +EXTER object sSsetf_lambda;
> > +EXTER object sSstructure_access;
> > +EXTER object sLsvref;
> > +EXTER object sStraced;
> > +EXTER object sLvector;
> > +EXTER object sKallow_other_keys;
> > +EXTER object fSerror_set (volatile object x0);
> > +EXTER object sLgensym_counter;
> > +EXTER object fSmc (object name,object address);
> > +EXTER object fSmfsfun (object name,object address,object argd);
> > +EXTER object fSmfvfun (object name,object address,object argd);
> > +EXTER object fSmfvfun_key (object symbol,object address,object
> argd,object
> > keys);
> > +EXTER object fSmf (object name,object addr);
> > +EXTER object fSmm (object name,object addr);
> > +EXTER object fScompiled_function_name (object fun);
> > +EXTER object fSturbo_closure (object funobj);
> > +EXTER object fSspecialp (object sym);
> > +EXTER object sSdebug;
> > +EXTER object fSdefvar1 (object sym,object val,...);
> > +EXTER object fSdebug (object sym,object val);
> > +EXTER object fSsetvv (object index,object val);
> > +EXTER object sSPmemory;
> > +EXTER object sSPinit;
> > +EXTER object fSinit_cmp_anon (void);
> > +EXTER object sKexternal;
> > +EXTER object sKinherited;
> > +EXTER object sKinternal;
> > +EXTER object sKnicknames;
> > +EXTER object sKuse;
> > +EXTER object sLApackageA;
> > +EXTER object fSset_gmp_allocate_relocatable (object flag);
> > +EXTER object fSallocate_bigger_fixnum_range (fixnum min,fixnum max);
> > +EXTER object fScmod (object num);
> > +EXTER object fScplus (object x0,object x1);
> > +EXTER object fSctimes (object x0,object x1);
> > +EXTER object fScdifference (object x0,object x1);
> > +EXTER object fLnth (fixnum index,object list);
> > +EXTER object fLfirst (object x);
> > +EXTER object fLsecond (object x);
> > +EXTER object fLthird (object x);
> > +EXTER object fLfourth (object x);
> > +EXTER object fLfifth (object x);
> > +EXTER object fLsixth (object x);
> >  +EXTER object fLseventh (object x);
> > +EXTER object fLeighth (object x);
> > +EXTER object fLninth (object x);
> > +EXTER object fLtenth (object x);
> > +EXTER object fSnext_hash_table_entry (object table,object ind);
> > +EXTER object fLhash_table_test (object table);
> > +EXTER object fLhash_table_size (object table);
> > +EXTER object sLarray_rank_limit;
> > +EXTER object sLarray_dimension_limit;
> > +EXTER object sLarray_total_size_limit;
> > +EXTER object sLbit;
> > +EXTER object fLaref (object x,fixnum i, ...);
> > +EXTER object fLsvref (object x,ufixnum i);
> > +EXTER object fLrow_major_aref (object x,fixnum i);
> > +EXTER object fSaset1 (object x, fixnum i,object val);
> > +EXTER object fSaset (object x,fixnum i,object y, ...);
> > +EXTER object fSsvset (object x,fixnum i,object val);
> > +EXTER object fSmake_vector1 (fixnum n,fixnum elt_type,object
> staticp,...);
> > +EXTER object fSget_aelttype (object x);
> > +EXTER object fSmake_vector (object x0,object x1,object x2,object
> x3,object
> > x4,object x5,object x6,...);
> > +EXTER object fSmake_array1 (fixnum elt_type,object staticp,object
> > initial_element,object displaced_to,fixnum displaced_index_offset, object
> > dimensions);
> > +EXTER object fScopy_array_portion (object x,object y,fixnum i1,fixnum
> > i2,object n1o);
> > +EXTER object fSfill_pointer_set (object x,fixnum i);
> > +EXTER object fLfill_pointer (object x);
> > +EXTER object fLarray_has_fill_pointer_p (object x);
> > +EXTER object fLarray_element_type (object x);
> > +EXTER object fLadjustable_array_p (object x);
> > +EXTER object fSdisplaced_array_p (object x);
> > +EXTER object fLarray_rank (object x);
> > +EXTER object fLarray_dimension (object x,fixnum i);
> > +EXTER object fSreplace_array (object old,object new);
> > +EXTER object fLarray_total_size (object x);
> > +EXTER object fSaset_by_cursor (object array,object val,object cursor);
> > +EXTER object sSAmatch_dataA;
> > +EXTER object sSAcase_fold_searchA;
> > +EXTER object fSmatch_beginning (fixnum i);
> > +EXTER object fSmatch_end (fixnum i);
> > +EXTER object fSstring_match (object pattern,object string,...);
> > +EXTER object sSs_data;
> > +EXTER object sLcompile;
> > +EXTER object sLdeclare;
> > +EXTER object sLeval;
> > +EXTER object sLeval;
> > +EXTER object sSfunction_documentation;
> > +EXTER object sLload;
> > +EXTER object sLprogn;
> > +EXTER object sLtypep;
> > +EXTER object sLvalues;
> > +EXTER object sSvariable_documentation;
> > +EXTER object sLwarn;
> > +EXTER object sSAallow_gzipped_fileA;
> > +EXTER object sKmyaddr;
> > +EXTER object sKmyport;
> > +EXTER object sKasync;
> > +EXTER object sKhost;
> > +EXTER object sKserver;
> > +EXTER object sSsocket;
> > +EXTER object sLAstandard_inputA;
> > +EXTER object sLAstandard_outputA;
> > +EXTER object sLAerror_outputA;
> > +EXTER object sLAterminal_ioA;
> > +EXTER object sLAquery_ioA;
> > +EXTER object sLAdebug_ioA;
> > +EXTER object sLAtrace_outputA;
> > +EXTER object sSAignore_eof_on_terminal_ioA;
> > +EXTER object sSAload_pathnameA;
> > +EXTER object sLAload_verboseA;
> > +EXTER object sKabort;
> > +EXTER object sKappend;
> > +EXTER object sKcreate;
> > +EXTER object sKdefault;
> > +EXTER object sKdirection;
> > +EXTER object sKelement_type;
> > +EXTER object sKerror;
> > +EXTER object sKif_does_not_exist;
> > +EXTER object sKif_exists;
> > +EXTER object sKinput;
> > +EXTER object sKio;
> > +EXTER object sKnew_version;
> > +EXTER object sKoutput;
> > +EXTER object sKoverwrite;
> > +EXTER object sKprint;
> > +EXTER object sKprobe;
> > +EXTER object sKrename;
> > +EXTER object sKrename_and_delete;
> > +EXTER object sKset_default_pathname;
> > +EXTER object sKsupersede;
> > +EXTER object sKverbose;
> > +EXTER object sLAread_default_float_formatA;
> > +EXTER object sLAread_baseA;
> > +EXTER object sLAread_suppressA;
> > +EXTER object sSY;
> > +EXTER object sSYB;
> > +EXTER object sSYZ;
> > +EXTER object sLlistA;
> > +EXTER object sLappend;
> > +EXTER object sLnconc;
> > +EXTER object sLapply;
> > +EXTER object sLvector;
> > +EXTER object sKupcase;
> > +EXTER object sKdowncase;
> > +EXTER object sKcapitalize;
> > +EXTER object sKstream;
> > +EXTER object sKescape;
> > +EXTER object sKreadably;
> > +EXTER object sKpretty;
> > +EXTER object sKcircle;
> > +EXTER object sKbase;
> > +EXTER object sKradix;
> > +EXTER object sKcase;
> > +EXTER object sKgensym;
> > +EXTER object sKlevel;
> > +EXTER object sKlength;
> > +EXTER object sKarray;
> > +EXTER object sLAprint_escapeA;
> > +EXTER object sLAprint_readablyA;
> > +EXTER object sLAprint_prettyA;
> > +EXTER object sLAprint_circleA;
> > +EXTER object sLAprint_baseA;
> > +EXTER object sLAprint_radixA;
> > +EXTER object sLAprint_caseA;
> > +EXTER object sLAprint_gensymA;
> > +EXTER object sLAprint_levelA;
> > +EXTER object sLAprint_lengthA;
> > +EXTER object sLAprint_arrayA;
> > +EXTER object sSAprint_packageA;
> > +EXTER object sSAprint_structureA;
> > +EXTER object sSpretty_print_format;
> > +EXTER object sSAprint_nansA;
> > +EXTER object fLformat (object strm, object control,...);
> > +EXTER object sSAindent_formatted_outputA;
> > +EXTER object fSsetenv (object variable,object value);
> > +EXTER object fLdelete_file (object path);
> > +EXTER object fLerror (object fmt_string,...);
> > +EXTER object fLspecific_error (object error_name,object fmt_string,...);
> > +EXTER object fLspecific_correctable_error (object error_name,object
> > fmt_string,...);
> > +EXTER object fLcerror (object continue_fmt_string,object
> fmt_string,...);
> > +EXTER object fSihs_top (void);
> > +EXTER object fSihs_fun (object x0);
> > +EXTER object fSihs_vs (object x0);
> > +EXTER object fSfrs_top (void);
> > +EXTER object fSfrs_vs (object x0);
> > +EXTER object fSfrs_bds (object x0);
> > +EXTER object fSfrs_class (object x0);
> > +EXTER object fSfrs_tag (object x0);
> > +EXTER object fSfrs_ihs (object x0);
> > +EXTER object fSbds_top (void);
> > +EXTER object fSbds_var (object x0);
> > +EXTER object fSbds_val (object x0);
> > +EXTER object fSvs_top (void);
> > +EXTER object fSvs (object x0);
> > +EXTER object fSsch_frs_base (object x0,object x1);
> > +EXTER object fSinternal_super_go (object tag,object x1,object x2);
> > +EXTER object sSuniversal_error_handler;
> > +EXTER object fSuniversal_error_handler (object x0,object x1,object
> > x2,object x3,object error_fmt_string);
> > +EXTER object sSterminal_interrupt;
> > +EXTER object sKwrong_type_argument;
> > +EXTER object sKtoo_few_arguments;
> > +EXTER object sKtoo_many_arguments;
> > +EXTER object sKunexpected_keyword;
> > +EXTER object sKinvalid_form;
> > +EXTER object sKunbound_variable;
> > +EXTER object sKinvalid_variable;
> > +EXTER object sKundefined_function;
> > +EXTER object sKinvalid_function;
> > +EXTER object sKpackage_error;
> > +EXTER object sKcatch;
> > +EXTER object sKprotect;
> > +EXTER object sKcatchall;
> > +EXTER object fLget_universal_time (void);
> > +EXTER object fLget_internal_real_time (void);
> > +EXTER object sSAdefault_time_zoneA;
> > +EXTER object fSgetpid (void);
> > +EXTER object fSuse_fast_links (object flag,...);
> > +EXTER object sScdefn;
> > +EXTER object sLAlink_arrayA;
> > +EXTER object fSprofile (object start_address,object scale);
> > +EXTER object fSfunction_start (object funobj);
> > +EXTER object fSset_up_combined (object first,...);
> > +EXTER object fSdisplay_profile (object start_addr,object scal);
> > +EXTER object fSarray_adress (object array);
> > +EXTER object sSAprofile_arrayA;
> > +EXTER object sSAinterrupt_enableA;
> > +EXTER object sSsigusr1_interrupt;
> > +EXTER object sSsigio_interrupt;
> > +EXTER object sSsignal_safety_required (fixnum signo,fixnum safety);
> > +EXTER object fSallow_signal (fixnum n);
> > +EXTER object fSinitfun (object sym,object addr_ind,object argd,...);
> > +EXTER object fSinitmacro (object first,...);
> > +EXTER object fSset_key_struct (object key_struct_ind);
> > +EXTER object fSinvoke (object x);
> > +EXTER object fSopen_named_socket (fixnum port);
> > +EXTER object fSclose_fd (fixnum fd);
> > +EXTER object fSclose_sfd (object sfd);
> > +EXTER object fSaccept_socket_connection (object named_socket);
> > +EXTER object fShostname_to_hostid (object host);
> > +EXTER object fSgethostname (void);
> > +EXTER object fShostid_to_hostname (object host_id);
> > +EXTER object fScheck_fd_for_input (fixnum fd,fixnum timeout);
> > +EXTER object fSclear_connection (fixnum fd);
> > +EXTER object fSconnection_state_fd (object sfd);
> > +EXTER object fSour_write (object sfd,object buffer,fixnum nbytes);
> > +EXTER object fSour_read_with_offset (object fd,object buffer,fixnum
> > offset,fixnum nbytes,fixnum timeout);
> > +EXTER object fSprint_to_string1 (object str,object x,object the_code);
> > +EXTER object fSset_sigio_for_fd (fixnum fd);
> > +EXTER object fSreset_string_input_stream (object strm,object
> string,fixnum
> > start,fixnum end);
> > +EXTER object fScheck_state_input (object osfd,fixnum timeout);
> > +EXTER object fSclear_connection_state (object osfd);
> > +EXTER object fSgetpeername (object sock);
> > +EXTER object fSgetsockname (object sock);
> > +EXTER object fSset_blocking (object sock,object setBlocking);
> > Index: h/object.h
> > ===================================================================
> > RCS file: /cvsroot/gcl/gcl/h/object.h,v
> > retrieving revision 1.18.4.1
> > diff -u -r1.18.4.1 object.h
> > --- h/object.h    16 Jul 2003 02:02:49 -0000    1.18.4.1
> > +++ h/object.h    29 Aug 2003 20:38:48 -0000
> > @@ -759,6 +759,7 @@
> >   short   tm_max_grow;    /* max amount to grow when growing */
> >   short   tm_growth_percent;  /* percent to increase maxpages */
> >   short   tm_percent_free;  /* percent which must be free after a gc for
> >   this type */
> > +        short   tm_distinct;       /* pages of this type are distinct */
> >
> >  };
> >
> > @@ -783,6 +784,20 @@
> >   The pointer to the contiguous blocks.
> >  */
> >  EXTER struct contblock *cb_pointer;      /*  contblock pointer  */
> > +
> > +/* SGC cont pages: After SGC_start, old_cb_pointer will be a linked
> > +   list of free blocks on non-SGC pages, and cb_pointer will be
> > +   likewise for SGC pages.  CM 20030827*/
> > +EXTER struct contblock *old_cb_pointer;  /*  old contblock pointer when
> in
> > SGC  */
> > +
> > +/* SGC cont pages: FIXME -- at some point, enable runtime disabling of
> > +   SGC cont pages.  Right now, the tm_sgc variable for type contiguous
> > +   will govern only the possible attempt to get new pages for SGC.
> > +   Contiguous pages normally allocated when SGC is on will always be
> > +   marked with SGC_PAGE_FLAG, as the current GBC algorithm always uses
> > +   sgc_contblock_sweep_phase in this case. */
> > +/* #define SGC_CONT_ENABLED (sgc_enabled &&
> tm_table[t_contiguous].tm_sgc)
> > */
> > +#define SGC_CONT_ENABLED (sgc_enabled)
> >
> >  /*
> >   Variables for memory management.
> > Index: h/page.h
> > ===================================================================
> > RCS file: /cvsroot/gcl/gcl/h/page.h,v
> > retrieving revision 1.4.4.1
> > diff -u -r1.4.4.1 page.h
> > --- h/page.h      21 Aug 2003 04:17:47 -0000    1.4.4.1
> > +++ h/page.h      29 Aug 2003 20:38:48 -0000
> > @@ -29,6 +29,12 @@
> >  #define ROUND_UP_PTR(n)      (((long)(n) + (PTR_ALIGN-1)) &
> >  ~(PTR_ALIGN-1))
> >  #define ROUND_DOWN_PTR(n) (((long)(n)  & ~(PTR_ALIGN-1)))
> >
> > +/* alignment required for contiguous pointers */
>  > +#define CPTR_ALIGN (PTR_ALIGN < sizeof(struct contblock) ?
>  sizeof(struct
> > contblock) : PTR_ALIGN)
> > +
> > +#define ROUND_UP_PTR_CONT(n) (((long)(n) + (CPTR_ALIGN-1)) &
> > ~(CPTR_ALIGN-1))
> > +#define ROUND_DOWN_PTR_CONT(n) (((long)(n)  & ~(CPTR_ALIGN-1)))
> > +
> >
> >  #ifdef SGC
> >
> > Index: h/protoize.h
> > ===================================================================
> > RCS file: /cvsroot/gcl/gcl/h/protoize.h,v
> > retrieving revision 1.26.4.1
> > diff -u -r1.26.4.1 protoize.h
> > --- h/protoize.h  16 Jul 2003 02:02:49 -0000    1.26.4.1
> > +++ h/protoize.h  29 Aug 2003 20:38:48 -0000
> > @@ -7,6 +7,7 @@
> >  /* alloc.c:376:OF */ extern object fSallocated (object typ); /* (typ)
> >  object typ; */
> >  /* alloc.c:401:OF */ extern object fSreset_number_used (object typ); /*
> >  (typ) object typ; */
> >  /* alloc.c:480:OF */ extern void insert_contblock (char *p, int s); /*
> (p,
> >  s) char *p; int s; */
> > +/* alloc.c:480:OF */ extern void insert_maybe_sgc_contblock (char *p,
> int
> >  s); /* (p, s) char *p; int s; */
> >  /* alloc.c:611:OF */ extern void set_maxpage (void); /* () */
> >  /* alloc.c:635:OF */ extern void init_alloc (void); /* () */
> >  /* alloc.c:737:OF */ extern object fSstaticp (object x); /* (x) object
> x;
> >  */
> > Index: o/alloc.c
> > ===================================================================
> > RCS file: /cvsroot/gcl/gcl/o/alloc.c,v
> > retrieving revision 1.19
> > diff -u -r1.19 alloc.c
> > --- o/alloc.c     1 Mar 2003 22:37:37 -0000     1.19
> > +++ o/alloc.c     29 Aug 2003 20:39:00 -0000
> > @@ -425,9 +425,19 @@
> >  /*
> >   printf("allocating %d-byte contiguous block...\n", n);
> >  */
> > +      /* SGC cont pages: contiguous pointers must be aligned at
> > +         CPTR_ALIGN, no smaller than sizeof (struct contblock).
> > +         Here we allocate a bigger block, and rely on the fact that
> > +         allocate_page returns pointers appropriately aligned,
> > +         being also aligned on page boundaries.  Protection against
> > +         a too small contblock was aforded before by a minimum
> > +         contblock size enforced by CBMINSIZE in insert_contblock.
> > +         However, this leads to a leak when many small cont blocks
> > +         are allocated, e.g. with bignums, so is now removed.  CM
> > +         20030827 */
> >
> >   g = FALSE;
> > -     n = ROUND_UP_PTR(n);
> > +     n = ROUND_UP_PTR_CONT(n);
> >
> >  ONCE_MORE:
> >    CHECK_INTERRUPT;
> > @@ -472,31 +482,87 @@
> >        }
> >   p = alloc_page(m);
> >
> > -     for (i = 0;  i < m;  i++)
> > +     for (i = 0;  i < m;  i++) {
> >    type_map[page(p) + i] = (char)t_contiguous;
> > +
> > +           /* SGC cont pages: Before this point, GCL never marked
> > contiguous
> > +              pages for SGC, causing no contiguous pages to be
> > +              swept when SGC was on.  Here we follow the behavior
> > +              for other pages in add_to_freelist. CM 20030827  */
> > +           if (SGC_CONT_ENABLED)
> > +             sgc_type_map[page(p)+i]|= SGC_PAGE_FLAG;
> > +     }
> >   ncbpage += m;
> >   insert_contblock(p+n, PAGESIZE*m - n);
> >   return(p);
> >  }
> >
> > +/* SGC cont pages: explicit free calls can come at any time, and we
> > +   must make sure to add the newly deallocated block to the right
> > +   list.  CM 20030827*/
> > +void
> > +insert_maybe_sgc_contblock(char *p,int s) {
> > +
> > +  struct contblock *tmp_cb_pointer;
> > +
> > +  if (SGC_CONT_ENABLED && ! SGC_PAGE_P(page(p))) {
> > +    tmp_cb_pointer=cb_pointer;
> > +    cb_pointer=old_cb_pointer;
> > +    sgc_enabled=0;
> > +    insert_contblock(p,s);
> > +    sgc_enabled=1;
> > +    old_cb_pointer=cb_pointer;
> > +    cb_pointer=tmp_cb_pointer;
> > +  } else
> > +    insert_contblock(p,s);
> > +
> > +}
> > +
> > +#ifdef SGC_CONT_DEBUG
> > +extern void overlap_check(struct contblock *,struct contblock *);
> > +#endif
> > +
> >  void
> >  insert_contblock(char *p, int s) {
> >
> >    struct contblock **cbpp, *cbp;
> >
> > -  if (s < CBMINSIZE)
> > +  /* SGC cont pages: This used to return when s<CBMINSIZE, but we need
> > +     to be able to sweep small (e.g. bignum) contblocks.  FIXME:
> > +     should never be called with s<=0 to begin with.  CM 20030827*/
> > +  if (s<=0)
> >      return;
> >    ncb++;
> >    cbp = (struct contblock *)p;
> > -  cbp->cb_size = s;
> > +  /* SGC cont pages: allocated sizes may not be zero mod CPTR_SIZE,
> > +     e.g. string fillp, but alloc_contblock rounded up the allocation
> > +     like this, which we follow here.  CM 20030827 */
> > +  cbp->cb_size = ROUND_UP_PTR_CONT(s);
> >    for (cbpp = &cb_pointer;  *cbpp;  cbpp = &((*cbpp)->cb_link))
> >      if ((*cbpp)->cb_size >= s) {
> > +#ifdef SGC_CONT_DEBUG
> > +      if (*cbpp==cbp) {
> > +     fprintf(stderr,"Trying to install a circle at %p\n",cbp);
> > +     exit(1);
> > +      }
> > +      if (sgc_enabled)
> > +     overlap_check(old_cb_pointer,cb_pointer);
> > +
> > +#endif
> >        cbp->cb_link = *cbpp;
> >        *cbpp = cbp;
> > +#ifdef SGC_CONT_DEBUG
> > +      if (sgc_enabled)
> > +     overlap_check(old_cb_pointer,cb_pointer);
> > +#endif
> >        return;
> >      }
> >    cbp->cb_link = NULL;
> >    *cbpp = cbp;
> > +#ifdef SGC_CONT_DEBUG
> > +  if (sgc_enabled)
> > +    overlap_check(old_cb_pointer,cb_pointer);
> > +#endif
> >
> >  }
> >
> > @@ -568,19 +634,30 @@
> >   return(p);
> >  }
> >
> > +/* Add a tm_distinct field to prevent page type sharing if desired.
> > +   Not used now, as its never desirable from an efficiency point of
> > +   view, and as the only known place one must separate is cons and
> > +   fixnum, which are of different sizes unless PTR_ALIGN is set too
> > +   high (e.g. 16 on a 32bit machine).  See the ordering of init_tm
> > +   calls for these types below -- reversing would wind up merging the
> > +   types with the current algorithm.  CM 20030827 */
> > +
> >  static void
> > -init_tm(enum type t, char *name, int elsize, int nelts, int sgc) {
> > +init_tm(enum type t, char *name, int elsize, int nelts, int sgc,int
> > distinct) {
> >
> >    int i, j;
> >    int maxpage;
> >    /* round up to next number of pages */
> >    maxpage = (((nelts * elsize) + PAGESIZE -1)/PAGESIZE);
> >    tm_table[(int)t].tm_name = name;
> > -  for (j = -1, i = 0;  i < (int)t_end;  i++)
> > -    if (tm_table[i].tm_size != 0 &&
> > -     tm_table[i].tm_size >= elsize &&
> > -     (j < 0 || tm_table[j].tm_size > tm_table[i].tm_size))
> > -      j = i;
> > +  j=-1;
> > +  if (!distinct)
> > +    for (i = 0;  i < (int)t_end;  i++)
> > +      if (tm_table[i].tm_size != 0 &&
> > +       tm_table[i].tm_size >= elsize &&
> > +       !tm_table[i].tm_distinct &&
> > +       (j < 0 || tm_table[j].tm_size > tm_table[i].tm_size))
> > +     j = i;
> >    if (j >= 0) {
> >      tm_table[(int)t].tm_type = (enum type)j;
> >      tm_table[j].tm_maxpage += maxpage;
> > @@ -598,6 +675,7 @@
> >    /*tm_table[(int)t].tm_npage = 0; */  /* dont zero nrbpage.. */
> >    tm_table[(int)t].tm_maxpage = maxpage;
> >    tm_table[(int)t].tm_gbccount = 0;
> > +  tm_table[(int)t].tm_distinct=distinct;
> >  #ifdef SGC
> >    tm_table[(int)t].tm_sgc = sgc;
> >    tm_table[(int)t].tm_sgc_max = 3000;
> > @@ -688,40 +766,46 @@
> >    for (i = 0;  i < MAXPAGE;  i++)
> >      type_map[i] = (char)t_other;
> >
> > +  /* Unused (at present) tm_distinct flag added.  Note that if cons
> > +     and fixnum share page types, errors will be introduced.
> > +
> > +     Gave each page type at least some sgc pages by default.  Of
> > +     course changeable by allocate-sgc.  CM 20030827 */
> > +
> >    init_tm(t_fixnum, "NFIXNUM",
> > -       sizeof(struct fixnum_struct), 8192,20);
> > -  init_tm(t_cons, ".CONS", sizeof(struct cons), 65536 ,50 );
> > -  init_tm(t_structure, "SSTRUCTURE", sizeof(struct structure), 5461,0 );
> > -  init_tm(t_cfun, "fCFUN", sizeof(struct cfun), 4096,0  );
> > -  init_tm(t_sfun, "gSFUN", sizeof(struct sfun),409,0 );
> > -  init_tm(t_string, "\"STRING", sizeof(struct string), 5461,1  );
> > -  init_tm(t_array, "aARRAY", sizeof(struct array), 4681,1 );
> > -  init_tm(t_symbol, "|SYMBOL", sizeof(struct symbol), 3640,1 );
> > -  init_tm(t_bignum, "BBIGNUM", sizeof(struct bignum), 2730,0 );
> > -  init_tm(t_ratio, "RRATIONAL", sizeof(struct ratio), 170,0 );
> > +       sizeof(struct fixnum_struct), 8192,20,0);
> > +  init_tm(t_cons, ".CONS", sizeof(struct cons), 65536 ,50,0 );
> > +  init_tm(t_structure, "SSTRUCTURE", sizeof(struct structure), 5461,1,0
> );
> > +  init_tm(t_cfun, "fCFUN", sizeof(struct cfun), 4096,1,0  );
> > +  init_tm(t_sfun, "gSFUN", sizeof(struct sfun),409,1,0 );
> > +  init_tm(t_string, "\"STRING", sizeof(struct string), 5461,1,0  );
> > +  init_tm(t_array, "aARRAY", sizeof(struct array), 4681,1,0 );
> > +  init_tm(t_symbol, "|SYMBOL", sizeof(struct symbol), 3640,1,0 );
> > +  init_tm(t_bignum, "BBIGNUM", sizeof(struct bignum), 2730,1,0 );
> > +  init_tm(t_ratio, "RRATIONAL", sizeof(struct ratio), 170,1,0 );
> >    init_tm(t_shortfloat, "FSHORT-FLOAT",
> > -       sizeof(struct shortfloat_struct), 256 ,1);
> > +       sizeof(struct shortfloat_struct), 256 ,1,0);
> >    init_tm(t_longfloat, "LLONG-FLOAT",
> > -       sizeof(struct longfloat_struct), 170 ,0);
> > -  init_tm(t_complex, "CCOMPLEX", sizeof(struct complex), 170 ,0);
> > -  init_tm(t_character,"#CHARACTER",sizeof(struct character), 256 ,0);
> > -  init_tm(t_package, ":PACKAGE", sizeof(struct package), 2*PAGESIZE /
> > sizeof(struct package),0);
> > -  init_tm(t_hashtable, "hHASH-TABLE", sizeof(struct hashtable), 78,0 );
> > -  init_tm(t_vector, "vVECTOR", sizeof(struct vector), 146 ,0);
> > -  init_tm(t_bitvector, "bBIT-VECTOR", sizeof(struct bitvector), 73 ,0);
> > -  init_tm(t_stream, "sSTREAM", sizeof(struct stream), 78 ,0);
> > -  init_tm(t_random, "$RANDOM-STATE", sizeof(struct random), 256 ,0);
> > -  init_tm(t_readtable, "rREADTABLE", sizeof(struct readtable), 256 ,0);
> > -  init_tm(t_pathname, "pPATHNAME", sizeof(struct pathname), 73 ,0);
> > -  init_tm(t_cclosure, "cCCLOSURE", sizeof(struct cclosure), 85 ,0);
> > -  init_tm(t_closure, "cCLOSURE", sizeof(struct cclosure), 85 ,0);
> > -  init_tm(t_vfun, "VVFUN", sizeof(struct vfun), 102 ,0);
> > -  init_tm(t_gfun, "gGFUN", sizeof(struct sfun), 0 ,0);
> > -  init_tm(t_afun, "AAFUN", sizeof(struct sfun), 0 ,0);
> > -  init_tm(t_cfdata, "cCFDATA", sizeof(struct cfdata), 102 ,0);
> > -  init_tm(t_spice, "!SPICE", sizeof(struct spice), 4096 ,0);
> > -  init_tm(t_relocatable, "%RELOCATABLE-BLOCKS", 1000,0,20);
> > -  init_tm(t_contiguous, "_CONTIGUOUS-BLOCKS", 1001,0,20);
> > +       sizeof(struct longfloat_struct), 170 ,1,0);
> > +  init_tm(t_complex, "CCOMPLEX", sizeof(struct complex), 170 ,1,0);
> > +  init_tm(t_character,"#CHARACTER",sizeof(struct character), 256 ,1,0);
> > +  init_tm(t_package, ":PACKAGE", sizeof(struct package), 2*PAGESIZE /
> > sizeof(struct package),1,0);
> > +  init_tm(t_hashtable, "hHASH-TABLE", sizeof(struct hashtable), 78,1,0
> );
> > +  init_tm(t_vector, "vVECTOR", sizeof(struct vector), 146 ,1,0);
> > +  init_tm(t_bitvector, "bBIT-VECTOR", sizeof(struct bitvector), 73
> ,1,0);
> > +  init_tm(t_stream, "sSTREAM", sizeof(struct stream), 78 ,1,0);
> > +  init_tm(t_random, "$RANDOM-STATE", sizeof(struct random), 256 ,1,0);
> > +  init_tm(t_readtable, "rREADTABLE", sizeof(struct readtable), 256
> ,1,0);
> > +  init_tm(t_pathname, "pPATHNAME", sizeof(struct pathname), 73 ,1,0);
> > +  init_tm(t_cclosure, "cCCLOSURE", sizeof(struct cclosure), 85 ,1,0);
> > +  init_tm(t_closure, "cCLOSURE", sizeof(struct cclosure), 85 ,1,0);
> > +  init_tm(t_vfun, "VVFUN", sizeof(struct vfun), 102 ,1,0);
> > +  init_tm(t_gfun, "gGFUN", sizeof(struct sfun), 0 ,1,0);
> > +  init_tm(t_afun, "AAFUN", sizeof(struct sfun), 0 ,1,0);
> > +  init_tm(t_cfdata, "cCFDATA", sizeof(struct cfdata), 102 ,1,0);
> > +  init_tm(t_spice, "!SPICE", sizeof(struct spice), 4096 ,1,0);
> > +  init_tm(t_relocatable, "%RELOCATABLE-BLOCKS", 1000,0,20,0);
> > +  init_tm(t_contiguous, "_CONTIGUOUS-BLOCKS", 1001,0,20,0);
> >    tm_table[t_relocatable].tm_nppage = PAGESIZE;
> >    tm_table[t_contiguous].tm_nppage = PAGESIZE;
> >
> > @@ -895,8 +979,15 @@
> >      FEerror("Can't allocate ~D pages for contiguous blocks.",
> >       1, make_fixnum(npages));
> >
> > -  for (i = 0;  i < m;  i++)
> > +  for (i = 0;  i < m;  i++) {
> >      type_map[page(p + PAGESIZE*i)] = (char)t_contiguous;
> > +    /* SGC cont pages: Before this point, GCL never marked contiguous
> > +       pages for SGC, causing no contiguous pages to be
> > +       swept when SGC was on.  Here we follow the behavior
> > +       for other pages in add_to_freelist. CM 20030827  */
> > +    if (SGC_CONT_ENABLED)
> > +      sgc_type_map[page(p)+i]|= SGC_PAGE_FLAG;
> > +  }
> >
> >    ncbpage += m;
> >    insert_contblock(p, PAGESIZE*m);
> > @@ -1140,8 +1231,9 @@
> >  #endif
> >   for (p = &malloc_list; *p && !endp(*p);  p = &((*p)->c.c_cdr))
> >    if ((*p)->c.c_car->st.st_self == ptr) {
> > -                 insert_contblock((*p)->c.c_car->st.st_self,
> > -                              (*p)->c.c_car->st.st_dim);
> > +/* SGC contblock pages: Its possible this is on an old page CM 20030827
> */
> > +                 insert_maybe_sgc_contblock((*p)->c.c_car->st.st_self,
> > +                                      (*p)->c.c_car->st.st_dim);
> >     (*p)->c.c_car->st.st_self = NULL;
> >     *p = (*p)->c.c_cdr;
> >     return ;
> > @@ -1189,7 +1281,8 @@
> >   x->st.st_fillp = x->st.st_dim = size;
> >   for (i = 0;  i < size;  i++)
> >     x->st.st_self[i] = ((char *)ptr)[i];
> > -     insert_contblock(ptr, j);
> > +/* SGC contblock pages: Its possible this is on an old page CM 20030827
> */
> > +     insert_maybe_sgc_contblock(ptr, j);
> >   return(x->st.st_self);
> >        }
> >      }
> > Index: o/external_funs.h
> > ===================================================================
> > RCS file: /cvsroot/gcl/gcl/o/external_funs.h,v
> > retrieving revision 1.2
> > diff -u -r1.2 external_funs.h
> > --- o/external_funs.h   15 Feb 2003 00:38:28 -0000    1.2
> > +++ o/external_funs.h   29 Aug 2003 20:39:00 -0000
> > @@ -17,6 +17,7 @@
> >  extern object fSallocated GPR((object typ));;
> >  extern char *alloc_contblock GPR((int n));;
> >  extern int insert_contblock GPR((char *p, int s));;
> > +extern int insert_maybe_sgc_contblock GPR((char *p, int s));;
> >  extern char *alloc_relblock GPR((int n));;
> >  extern int init_tm GPR((enum type t, char *name, int elsize, int nelts,
> >  int sgc));;
> >  extern int set_maxpage GPR((void));;
> > Index: o/file.d
> > ===================================================================
> > RCS file: /cvsroot/gcl/gcl/o/file.d,v
> > retrieving revision 1.21
> > diff -u -r1.21 file.d
> > --- o/file.d      18 Feb 2003 02:32:03 -0000    1.21
> > +++ o/file.d      29 Aug 2003 20:39:01 -0000
> > @@ -303,11 +303,13 @@
> >  deallocate_stream_buffer(strm)
> >  object strm;
> >  {
> > -  if (strm->sm.sm_buffer)
> > -    {insert_contblock(strm->sm.sm_buffer, BUFSIZ);
> > -     strm->sm.sm_buffer = 0;}
> > - else
> > -    printf("no buffer? %p  \n",strm->sm.sm_fp);
> > +
> > +/* SGC contblock pages: Its possible this is on an old page CM 20030827
> */
> > +  if (strm->sm.sm_buffer)
> > +    {insert_maybe_sgc_contblock(strm->sm.sm_buffer, BUFSIZ);
> > +    strm->sm.sm_buffer = 0;}
> > +  else
> > +    printf("no buffer? %p  \n",strm->sm.sm_fp);
> >
> >  #ifndef FCLOSE_SETBUF_OK
> >    strm->sm.sm_fp->_base = NULL;
> > Index: o/gbc.c
> > ===================================================================
> > RCS file: /cvsroot/gcl/gcl/o/gbc.c,v
> > retrieving revision 1.13.4.1
> > diff -u -r1.13.4.1 gbc.c
> > --- o/gbc.c 30 Jul 2003 15:11:12 -0000    1.13.4.1
>  > +++ o/gbc.c 29 Aug 2003 20:39:01 -0000
> > @@ -1012,19 +1012,24 @@
> >      e = pagetochar(j);
> >      for (p = s;  p < e;) {
> >        if (get_mark_bit((int *)p)) {
> > -     p += PTR_ALIGN;
> > +     /* SGC cont pages: cont blocks must be no smaller than
> > +        sizeof(struct contblock), and must not have a sweep
> > +        granularity greater than this amount (e.g. CPTR_ALIGN) if
> > +        contblock leaks are to be avoided.  Used to be aligned at
> > +        PTR_ALIGN. CM 20030827 */
> > +     p += CPTR_ALIGN;
> >   continue;
> >        }
> > -      q = p + PTR_ALIGN;
> > +      q = p + CPTR_ALIGN;
> >        while (q < e) {
> >   if (!get_mark_bit((int *)q)) {
> > -       q += PTR_ALIGN;
> > +       q += CPTR_ALIGN;
> >     continue;
> >   }
> >   break;
> >        }
> >        insert_contblock(p, q - p);
> > -      p = q + PTR_ALIGN;
> > +      p = q + CPTR_ALIGN;
> >      }
> >      i = j + 1;
> >    }
> > @@ -1067,8 +1072,8 @@
> >      if(sgc_enabled) sgc_quit();
> >
> >      }
> > -
> > -
> > +
> > +
> >  #ifdef DEBUG
> >    debug = symbol_value(sSAgbc_messageA) != Cnil;
> >  #endif
> > @@ -1278,6 +1283,9 @@
> >
> >    interrupt_enable = TRUE;
> >
> > +  if (in_sgc && sgc_enabled==0)
> > +    sgc_start();
> > +
> >    if (saving_system) {
> >      j = (rb_pointer-rb_start+PAGESIZE-1) / PAGESIZE;
> >
> > @@ -1323,10 +1331,6 @@
> >    if (GBC_exit_hook != NULL)
> >      (*GBC_exit_hook)();
> >
> > -
> > -  if (in_sgc && sgc_enabled==0)
> > -    sgc_start();
> > -
> >    if(gc_time>=0 && !--gc_recursive)
> >    {gc_time=gc_time+(gc_start=(runtime()-gc_start));}
> >
> >    if (sSAnotify_gbcA->s.s_dbind != Cnil) {
> > @@ -1423,8 +1427,10 @@
> >    if (!MAYBE_DATA_P(p) || (enum type)type_map[page(p)] != t_contiguous)
> >      return;
> >    q = p + s;
> > -  x = (int *)ROUND_DOWN_PTR(p);
> > -  y = (int *)ROUND_UP_PTR(q);
> > +  /* SGC cont pages: contblock pages must be no smaller than
> > +     sizeof(struct contblock).  CM 20030827 */
> > +  x = (int *)ROUND_DOWN_PTR_CONT(p);
> > +  y = (int *)ROUND_UP_PTR_CONT(q);
> >    for (;  x < y;  x++)
> >      set_mark_bit(x);
> >  }
> > Index: o/gmp.c
> > ===================================================================
> > RCS file: /cvsroot/gcl/gcl/o/gmp.c,v
> > retrieving revision 1.3
> > diff -u -r1.3 gmp.c
> > --- o/gmp.c 15 Feb 2003 00:38:28 -0000    1.3
> > +++ o/gmp.c 29 Aug 2003 20:39:01 -0000
> > @@ -15,7 +15,9 @@
> >    old = oldmem;
> >    bcopy(MP_SELF(big_gcprotect),new,oldsize);
> >    MP_SELF(big_gcprotect)=0;
> > -  if (inheap(oldmem)) insert_contblock(oldmem,oldsize);
> > +/* SGC contblock pages: Its possible this is on an old page CM 20030827
> */
> > +  if (inheap(oldmem)) insert_maybe_sgc_contblock(oldmem,oldsize);
> > +
> >    return new;
> >  }
> >
> > Index: o/sgbc.c
> > ===================================================================
> > RCS file: /cvsroot/gcl/gcl/o/sgbc.c,v
> > retrieving revision 1.9
> > diff -u -r1.9 sgbc.c
> > --- o/sgbc.c      15 Feb 2003 00:38:28 -0000    1.9
> > +++ o/sgbc.c      29 Aug 2003 20:39:01 -0000
> > @@ -887,19 +887,24 @@
> >      e = pagetochar(j);
> >      for (p = s;  p < e;) {
> >        if (get_mark_bit((int *)p)) {
>  > -     p += PTR_ALIGN;
> > +     /* SGC cont pages: cont blocks must be no smaller than
> > +        sizeof(struct contblock), and must not have a sweep
> > +        granularity greater than this amount (e.g. CPTR_ALIGN) if
> > +        contblock leaks are to be avoided.  Used to be aligned at
> > +        PTR_ALIGN. CM 20030827 */
> > +     p += CPTR_ALIGN;
> >   continue;
> >        }
> > -      q = p + PTR_ALIGN;
> > +      q = p + CPTR_ALIGN;
> >        while (q < e) {
> >   if (!get_mark_bit((int *)q)) {
> > -       q += PTR_ALIGN;
> > +       q += CPTR_ALIGN;
> >     continue;
> >   }
> >   break;
> >        }
> >        insert_contblock(p, q - p);
> > -      p = q + PTR_ALIGN;
> > +      p = q + CPTR_ALIGN;
> >      }
> >      i = j + 1;
> >    }
> > @@ -961,6 +966,71 @@
> >    return count;
> >  }
> >
> > +#ifdef SGC_CONT_DEBUG
> > +void
> > +overlap_check(struct contblock *t1,struct contblock *t2) {
> > +
> > +  struct contblock *p;
> > +
> > +  for (;t1;t1=t1->cb_link) {
> > +
> > +    if (!inheap(t1)) {
> > +      fprintf(stderr,"%p not in heap\n",t1);
> > +      exit(1);
> > +    }
> > +
> > +    for (p=t2;p;p=p->cb_link) {
> > +
> > +      if (!inheap(p)) {
> > +     fprintf(stderr,"%p not in heap\n",t1);
> > +     exit(1);
> > +      }
> > +
> > +      if ((p<=t1 && (void *)p+p->cb_size>(void *)t1) ||
> > +       (t1<=p && (void *)t1+t1->cb_size>(void *)p)) {
> > +     fprintf(stderr,"Overlap %u %p  %u
> %p\n",t1->cb_size,t1,p->cb_size,p);
> > +     exit(1);
> > +      }
> > +
> > +      if (p==p->cb_link) {
> > +     fprintf(stderr,"circle detected at %p\n",p);
> > +     exit(1);
> > +      }
> > +
> > +    }
> > +
> > +    if (t1==t1->cb_link) {
> > +      fprintf(stderr,"circle detected at %p\n",t1);
> > +      exit(1);
> > +    }
> > +
> > +  }
> > +
> > +}
> > +
> > +void
> > +tcc(struct contblock *t) {
> > +
> > +  for (;t;t=t->cb_link) {
> > +
> > +    if (!inheap(t)) {
> > +      fprintf(stderr,"%p not in heap\n",t);
> > +      break;
> > +    }
> > +
> > +    fprintf(stderr,"%u at %p\n",t->cb_size,t);
> > +
> > +    if (t==t->cb_link) {
> > +      fprintf(stderr,"circle detected at %p\n",t);
> > +      break;
> > +    }
> > +
> > +  }
> > +
> > +}
> > +
> > +#endif
> > +
> >  int
> >  sgc_start(void) {
> >
> > @@ -985,7 +1055,11 @@
> >      {
> >        int maxp=0;
> >        int j;
> > -      int minfree = tm->tm_sgc_minfree;
> > +      /* SGC cont pages: This used to be simply set to tm_sgc_minfree,
> > +      which is a definite bug, as minfree could then be zero,
> > +      leading this type to claim SGC pages not of its type as
> > +      specified in type_map.  CM 20030827*/
> > +      int minfree = tm->tm_sgc_minfree > 0 ? tm->tm_sgc_minfree : 1 ;
> >        int count;
> >        bzero(free_map,npages*sizeof(short));
> >        f = tm->tm_free;
> > @@ -1031,6 +1105,113 @@
> >     goto FIND_FREE_PAGES;
> >        }
> >      }
> > +
> > +/* SGC cont pages: Here we implement the contblock page division into
> > +   SGC and non-SGC types.  Unlike the other types, we need *whole*
> > +   free pages for contblock SGC, as there is no psersistent data
> > +   element (e.g. .m) on an allocated block itself which can indicate
> >  +   its live status.  If anything on a page which is to be marked
> > +   read-only points to a live object on an SGC cont page, it will
> > +   never be marked and will be erroneously swept.  It is also possible
> > +   for dead objects to unnecessarily mark dead regions on SGC pages
> > +   and delay sweeping until the pointing type is GC'ed if SGC is
> > +   turned off for the pointing type, e.g. tm_sgc=0. (This was so by
> > +   default for a number of types, including bignums, and has now been
> > +   corrected in init_alloc in alloc.c.) We can't get around this
> > +   AFAICT, as old data on (writable) SGC pages must be marked lest it
> > +   is lost, and (old) data on now writable non-SGC pages might point
> > +   to live regions on SGC pages, yet might not themselves be reachable
> > +   from the mark origin through an unbroken chain of writable pages.
> > +   In any case, the possibility of a lot of garbage marks on contblock
> > +   pages, especially when the blocks are small as in bignums, makes
> > +   necessary the sweeping of minimal contblocks to prevent leaks. CM
> > +   20030827 */
> > +  {
> > +
> > +    void *p=NULL;
> > +    unsigned i,j,k,count;
> > +    struct contblock *new_cb_pointer=NULL,*tmp_cb_pointer=NULL,**cbpp;
> > +
> > +    tm=tm_of(t_contiguous);
> > +
> > +    /* SGC cont pages:  First count whole free pages available.  CM
> > 20030827 */
> > +    for (cbpp=&cb_pointer,count=0;*cbpp;cbpp=&(*cbpp)->cb_link) {
> > +      p=PAGE_ROUND_UP((void *)(*cbpp));
> > +      k=p-((void *)(*cbpp));
> > +      if ((*cbpp)->cb_size<k || (*cbpp)->cb_size-k<PAGESIZE)
> > +     continue;
> > +      i=((*cbpp)->cb_size-k)/PAGESIZE;
> > +      count+=i;
> > +    }
> > +    count=tm->tm_sgc>count ? tm->tm_sgc - count : 0;
> > +
> > +    if (count>0) {
> > +      /* SGC cont pages: allocate more if necessary, dumping possible
> > +      GBC freed pages onto the old contblock list.  CM 20030827*/
> > +      int z=count+1;
> > +      void *p1=alloc_contblock(z*PAGESIZE);
> > +      p=PAGE_ROUND_UP(p1);
> > +      if (p>p1) {
> > +     z--;
> > +     insert_contblock(p1,p-p1);
> > +     insert_contblock(p+z*PAGESIZE,PAGESIZE-(p-p1));
> > +      }
> > +      tmp_cb_pointer=cb_pointer;
> > +      cb_pointer=new_cb_pointer;
> > +      /* SGC cont pages: add new pages to new contblock list. p is not
> > +      already on any list as ensured by alloc_contblock.  CM
> > +      20030827 */
> > +      insert_contblock(p,PAGESIZE*z);
> > +      new_cb_pointer=cb_pointer;
> > +      cb_pointer=tmp_cb_pointer;
> > +      for (i=0;i<z;i++)
> > +     sgc_type_map[page(p)+i]|= SGC_PAGE_FLAG;
> > +    }
> > +
> > +    for (cbpp=&cb_pointer;*cbpp;) {
> > +      p=PAGE_ROUND_UP((void *)(*cbpp));
> > +      k=p-((void *)(*cbpp));
> > +      if ((*cbpp)->cb_size<k || (*cbpp)->cb_size-k<PAGESIZE) {
> > +     cbpp=&(*cbpp)->cb_link;
> > +     continue;
> > +      }
> > +      i=((*cbpp)->cb_size-k)/PAGESIZE;
> > +      i*=PAGESIZE;
> > +      j=(*cbpp)->cb_size-i-k;
> > +      /* SGC contblock pages:  remove this block from old list CM
> 20030827
> > */
> > +      *cbpp=(*cbpp)->cb_link;
> > +      /* SGC contblock pages:  add fragments old list CM 20030827 */
> > +      if (k) {
> > +     ncb--;
> > +     insert_contblock(p-k,k);
> > +      }
> > +      if (j) {
> > +     ncb--;
> > +     insert_contblock(p+i,j);
> > +      }
> > +      tmp_cb_pointer=cb_pointer;
> > +      cb_pointer=new_cb_pointer;
> >  +      /* SGC contblock pages: add whole pages to new list, p p-k, and
> > +      p+i are guaranteed to be distinct when used. CM 20030827 */
> > +      insert_contblock(p,i);
> > +      new_cb_pointer=cb_pointer;
> > +      cb_pointer=tmp_cb_pointer;
> > +      i/=PAGESIZE;
> > +      for (j=0;j<i;j++)
> > +     sgc_type_map[page(p)+j]|= SGC_PAGE_FLAG;
> > +    }
> > +
> > +    /* SGC contblock pages: switch to new free SGC contblock list. CM
> > +       20030827 */
> > +    old_cb_pointer=cb_pointer;
> > +    cb_pointer=new_cb_pointer;
> > +
> > +#ifdef SGC_CONT_DEBUG
> > +    overlap_check(old_cb_pointer,cb_pointer);
> > +#endif
> > +
> > +  }
> > +
> >    /* Now  allocate the sgc relblock.   We do this as the tail
> >       end of the ordinary rb.     */
> >    {
> > @@ -1117,6 +1298,26 @@
> >      return 0;
> >    sgc_enabled=0;
> >    rb_start = old_rb_start;
> > +
> > +  /* SGC cont pages: restore contblocks, each tmp_cb_pointer coming
> > +     from the new list is guaranteed not to be on the old. Need to
> > +     grab 'next' before insert_contblock writes is.  CM 20030827 */
> > +  {
> > +
> > +    struct contblock *tmp_cb_pointer,*next;
> > +    if (old_cb_pointer) {
> > +#ifdef SGC_CONT_DEBUG
> > +      overlap_check(old_cb_pointer,cb_pointer);
> > +#endif
> > +      tmp_cb_pointer=cb_pointer;
> > +      cb_pointer=old_cb_pointer;
> > +      for (;tmp_cb_pointer;  tmp_cb_pointer=next) {
> > +     next=tmp_cb_pointer->cb_link;
> > +     insert_contblock((void *)tmp_cb_pointer,tmp_cb_pointer->cb_size);
> > +      }
> > +    }
> > +  }
> > +
> >    for (i= t_start; i < t_contiguous ; i++)
> >      if (TM_BASE_TYPE_P(i)) {
> >        tm=tm_of(i);
> >
> =============================================================================
> 
> >
> >
> >
> > "Matt Kaufmann" <address@hidden> writes:
> >
> > > Hi, Camm --
> > >
> > > Thanks for all your work!
> > >
> > > I've rebuilt GCL with your patches and rebuilt ACL2 on top of that.
> The
> > test
> > > completed successfully.  In case you're interested, the time is about
> the
> > same
> > > as before (actually slightly slower, though perhaps that's in the
> noise):
> > >
> > >   New GCL time (avoiding some compilation, as in the times below):
> > >   15413.890u 38.960s 4:17:41.55 99.9%   0+0k 0+0io 63427pf+0w
> > >
> > > Times reported previously:
> > >
> > >   Allegro CL (development environment) time:
> > >   3839.780u 19.680s 1:04:24.64 99.8%      0+0k 0+0io 85891pf+0w
> > >
> > >   GCL time:
> > >   14599.720u 39.610s 4:04:13.28 99.9%     0+0k 0+0io 54777pf+0w
> > >
> > > I have a question about this passage from your previous email:
> > >
> > >   As for your performance observations, as you know I still have a bit
> > >   of profiling on my todo list concerning acl2, so a definitive
> > >   statement will have to wait until then.  But I noticed in the
> existing
> > >   acl2 code a comment in which SGC is turned on "at the suggestion of
> > >   wfs" at a certain point.  Just to make sure we all understand, SGC is
> > >   a GC *write barrier*, it is only efficient if most of the data behind
> > >   the barrier (before executing (sgc-on t)) is static.  With your
> > >   enormous image, you should make sure that sgc is not turned on too
> > >   early.  As my patches only affect sgc contiguous pages, and as these
> > >   seem to affect your results, this may be a factor in your poor
> > >   performance.
> > >
> > > Can you expand on this?  Is your concern that we aren't including
> enough
> > > read-only stuff before saving the image?  We turn sgc on just before
> > doing some
> > > allocation, setting the hole size, and then saving the image.
> > >
> > > By the way, for what it's worth, here how I am configuring GCL:
> > >
> > > ./configure '--enable-maxpage=128*1024' '--x-libraries=/usr/X11R6/lib'
> > '--x-includes=/usr/X11R6/include'
> > >
> > > Thanks --
> > > -- Matt
> > >    cc: address@hidden, address@hidden, address@hidden
> > >    From: "Camm Maguire" <address@hidden>
> > >    Date: 29 Aug 2003 00:04:34 -0400
> > >    User-Agent: Gnus/5.09 (Gnus v5.9.0) Emacs/21.2
> > >    X-WSS-ID: 13500F5C1393624-01-01
> > >    Content-Type: text/plain;
> > >     charset=us-ascii
> > >
> > >    Greetings!  OK my apologies -- I wrongly assumed that
> alloc_contblock
> > >    returned aligned pages.  This one works for me (acl2 and maxima pass
> > >    all tests).  You can try it now, or wait until I clean up the
> > >    debugging stuff and commit into CVS version 2.5.4 sometime tomorrow.
> > >
> > >    Take care,
> > >
> > >
> >
> =============================================================================
> 
> >
> > >    Index: h/object.h
> > >    ===================================================================
> > >    RCS file: /cvsroot/gcl/gcl/h/object.h,v
> > >    retrieving revision 1.18.4.1
> > >    diff -u -r1.18.4.1 object.h
> > >    --- h/object.h     16 Jul 2003 02:02:49 -0000    1.18.4.1
> > >    +++ h/object.h     29 Aug 2003 03:54:25 -0000
> > >    @@ -759,6 +759,7 @@
> > >        short   tm_max_grow;    /* max amount to grow when growing */
> > >        short   tm_growth_percent;  /* percent to increase maxpages */
> > >        short   tm_percent_free;  /* percent which must be free after a
> gc
> > for this type */
> > >    +        short   tm_distinct;       /* pages of this type are
> distinct
> > */
> > >
> > >     };
> > >
> > >    Index: h/page.h
> > >    ===================================================================
> > >    RCS file: /cvsroot/gcl/gcl/h/page.h,v
> > >    retrieving revision 1.4.4.1
> > >    diff -u -r1.4.4.1 page.h
> > >    --- h/page.h 21 Aug 2003 04:17:47 -0000    1.4.4.1
> > >    +++ h/page.h 29 Aug 2003 03:54:25 -0000
> > >    @@ -29,6 +29,12 @@
> > >     #define ROUND_UP_PTR(n) (((long)(n) + (PTR_ALIGN-1)) &
> > ~(PTR_ALIGN-1))
> > >     #define ROUND_DOWN_PTR(n) (((long)(n)  & ~(PTR_ALIGN-1)))
> > >
> > >    +/* alignment required for contiguous pointers */
> > >    +#define CPTR_ALIGN (PTR_ALIGN < sizeof(struct contblock) ?
> > sizeof(struct contblock) : PTR_ALIGN)
> > >    +
> > >    +#define ROUND_UP_PTR_CONT(n)  (((long)(n) + (CPTR_ALIGN-1)) &
> > ~(CPTR_ALIGN-1))
> > >    +#define ROUND_DOWN_PTR_CONT(n) (((long)(n)  & ~(CPTR_ALIGN-1)))
> > >    +
> > >
> > >     #ifdef SGC
> > >
> > >    Index: o/alloc.c
> > >    ===================================================================
> > >    RCS file: /cvsroot/gcl/gcl/o/alloc.c,v
> > >    retrieving revision 1.19
> > >    diff -u -r1.19 alloc.c
> > >    --- o/alloc.c      1 Mar 2003 22:37:37 -0000     1.19
> > >    +++ o/alloc.c      29 Aug 2003 03:54:35 -0000
> > >    @@ -425,9 +425,19 @@
> > >     /*
> > >        printf("allocating %d-byte contiguous block...\n", n);
> > >     */
> > >    +       /* SGC cont pages: contiguous pointers must be aligned at
> > >    +          CPTR_ALIGN, no smaller than sizeof (struct contblock).
> > >    +          Here we allocate a bigger block, and rely on the fact
> that
> > >    +          allocate_page returns pointers appropriately aligned,
> > >    +          being also aligned on page boundaries.  Protection
> against
> > >    +          a too small contblock was aforded before by a minimum
> > >    +          contblock size enforced by CBMINSIZE in insert_contblock.
> > >    +          However, this leads to a leak when many small cont blocks
> > >    +          are allocated, e.g. with bignums, so is now removed.  CM
> > >    +          20030827 */
> > >
> > >        g = FALSE;
> > >    -      n = ROUND_UP_PTR(n);
> > >    +      n = ROUND_UP_PTR_CONT(n);
> > >
> > >     ONCE_MORE:
> > >         CHECK_INTERRUPT;
> > >    @@ -472,8 +482,16 @@
> > >       }
> > >        p = alloc_page(m);
> > >
> > >    -      for (i = 0;  i < m;  i++)
> > >    +      for (i = 0;  i < m;  i++) {
> > >              type_map[page(p) + i] = (char)t_contiguous;
> > >    +
> > >    +            /* SGC cont pages: Before this point, GCL never marked
> > contiguous
> > >    +               pages for SGC, causing no contiguous pages to be
> > >    +               swept when SGC was on.  Here we follow the behavior
> > >    +               for other pages in add_to_freelist. CM 20030827  */
> > >    +            if (sgc_enabled && tm_table[t_contiguous].tm_sgc)
> > >    +              sgc_type_map[page(p)+i]|= SGC_PAGE_FLAG;
> > >    +      }
> > >        ncbpage += m;
> > >        insert_contblock(p+n, PAGESIZE*m - n);
> > >        return(p);
> > >    @@ -484,19 +502,53 @@
> > >
> > >       struct contblock **cbpp, *cbp;
> > >
> > >    -  if (s < CBMINSIZE)
> > >    +  /* SGC cont pages: This used to return when s<CBMINSIZE, but we
> > need
> > >    +     to be able to sweep small (e.g. bignum) contblocks.  FIXME:
> > >    +     should never be called with s<=0 to begin with.  CM 20030827*/
> > >    +  if (s<=0)
> > >     return;
> > >       ncb++;
> > >       cbp = (struct contblock *)p;
> > >    -  cbp->cb_size = s;
> > >    +  /* SGC cont pages: allocated sizes may not be zero mod CPTR_SIZE,
>  > >    +     e.g. string fillp, but alloc_contblock rounded up the
>  allocation
> > >    +     like this, which we follow here.  CM 20030827 */
> > >    +  cbp->cb_size = ROUND_UP_PTR_CONT(s);
> > >       for (cbpp = &cb_pointer;  *cbpp;  cbpp = &((*cbpp)->cb_link))
> > >     if ((*cbpp)->cb_size >= s) {
> > >    +#undef DEBUG
> > >    +#define DEBUG
> > >    +#ifdef DEBUG
> > >    +      if (*cbpp==cbp) {
> > >    +      fprintf(stderr,"Trying to install a circle at %p\n",cbp);
> > >    +      exit(1);
> > >    +      }
> > >    +      if (sgc_enabled) {
> > >    +      extern struct contblock *old_cb_pointer;
> > >    +      extern void overlap_check(struct contblock *,struct contblock
> > *);
> > >    +
> > >    +      overlap_check(old_cb_pointer,cb_pointer);
> > >    +      }
> > >    +#endif
> > >       cbp->cb_link = *cbpp;
> > >       *cbpp = cbp;
> > >    +#ifdef DEBUG
> > >    +      if (sgc_enabled) {
> > >    +      extern struct contblock *old_cb_pointer;
> > >    +      extern void overlap_check(struct contblock *,struct contblock
> > *);
> > >    +      overlap_check(old_cb_pointer,cb_pointer);
> > >    +      }
> > >    +#endif
> > >       return;
> > >     }
> > >       cbp->cb_link = NULL;
> > >       *cbpp = cbp;
> > >    +#ifdef DEBUG
> > >    +  if (sgc_enabled) {
> > >    +    extern struct contblock *old_cb_pointer;
> > >    +    extern void overlap_check(struct contblock *,struct contblock
> *);
> > >    +    overlap_check(old_cb_pointer,cb_pointer);
> > >    +  }
> > >    +#endif
> > >
> > >     }
> > >
> > >    @@ -568,19 +620,30 @@
> > >        return(p);
> > >     }
> > >
> > >    +/* Add a tm_distinct field to prevent page type sharing if desired.
> > >    +   Not used now, as its never desirable from an efficiency point of
> > >    +   view, and as the only known place one must separate is cons and
> > >    +   fixnum, which are of different sizes unless PTR_ALIGN is set too
> > >    +   high (e.g. 16 on a 32bit machine).  See the ordering of init_tm
> > >    +   calls for these types below -- reversing would wind up merging
> the
> > >    +   types with the current algorithm.  CM 20030827 */
> > >    +
> > >     static void
> > >    -init_tm(enum type t, char *name, int elsize, int nelts, int sgc) {
> > >    +init_tm(enum type t, char *name, int elsize, int nelts, int sgc,int
> > distinct) {
> > >
> > >       int i, j;
> > >       int maxpage;
> > >       /* round up to next number of pages */
> > >       maxpage = (((nelts * elsize) + PAGESIZE -1)/PAGESIZE);
> > >       tm_table[(int)t].tm_name = name;
> > >    -  for (j = -1, i = 0;  i < (int)t_end;  i++)
> > >    -    if (tm_table[i].tm_size != 0 &&
> > >    -      tm_table[i].tm_size >= elsize &&
> > >    -      (j < 0 || tm_table[j].tm_size > tm_table[i].tm_size))
> > >    -      j = i;
> > >    +  j=-1;
> > >    +  if (!distinct)
> > >    +    for (i = 0;  i < (int)t_end;  i++)
> > >    +      if (tm_table[i].tm_size != 0 &&
> > >    +        tm_table[i].tm_size >= elsize &&
> > >    +        !tm_table[i].tm_distinct &&
> > >    +        (j < 0 || tm_table[j].tm_size > tm_table[i].tm_size))
> > >    +      j = i;
> > >       if (j >= 0) {
> > >     tm_table[(int)t].tm_type = (enum type)j;
> > >     tm_table[j].tm_maxpage += maxpage;
> > >    @@ -598,6 +661,7 @@
> > >       /*tm_table[(int)t].tm_npage = 0; */  /* dont zero nrbpage.. */
> > >       tm_table[(int)t].tm_maxpage = maxpage;
> > >       tm_table[(int)t].tm_gbccount = 0;
> > >    +  tm_table[(int)t].tm_distinct=distinct;
> > >     #ifdef SGC
> > >       tm_table[(int)t].tm_sgc = sgc;
> > >       tm_table[(int)t].tm_sgc_max = 3000;
> > >    @@ -688,40 +752,46 @@
> > >       for (i = 0;  i < MAXPAGE;  i++)
> > >     type_map[i] = (char)t_other;
> > >
> > >    +  /* Unused (at present) tm_distinct flag added.  Note that if cons
> > >    +     and fixnum share page types, errors will be introduced.
> > >    +
> > >    +     Gave each page type at least some sgc pages by default.  Of
> > >    +     course changeable by allocate-sgc.  CM 20030827 */
> > >    +
> > >       init_tm(t_fixnum, "NFIXNUM",
> > >    -        sizeof(struct fixnum_struct), 8192,20);
> > >    -  init_tm(t_cons, ".CONS", sizeof(struct cons), 65536 ,50 );
> > >    -  init_tm(t_structure, "SSTRUCTURE", sizeof(struct structure),
> 5461,0
> > );
> > >    -  init_tm(t_cfun, "fCFUN", sizeof(struct cfun), 4096,0  );
> > >    -  init_tm(t_sfun, "gSFUN", sizeof(struct sfun),409,0 );
> > >    -  init_tm(t_string, "\"STRING", sizeof(struct string), 5461,1  );
> > >    -  init_tm(t_array, "aARRAY", sizeof(struct array), 4681,1 );
> > >    -  init_tm(t_symbol, "|SYMBOL", sizeof(struct symbol), 3640,1 );
> > >    -  init_tm(t_bignum, "BBIGNUM", sizeof(struct bignum), 2730,0 );
> > >    -  init_tm(t_ratio, "RRATIONAL", sizeof(struct ratio), 170,0 );
> > >    +        sizeof(struct fixnum_struct), 8192,20,0);
> > >    +  init_tm(t_cons, ".CONS", sizeof(struct cons), 65536 ,50,0 );
> > >    +  init_tm(t_structure, "SSTRUCTURE", sizeof(struct structure),
> > 5461,1,0 );
> > >    +  init_tm(t_cfun, "fCFUN", sizeof(struct cfun), 4096,1,0  );
> > >    +  init_tm(t_sfun, "gSFUN", sizeof(struct sfun),409,1,0 );
> > >    +  init_tm(t_string, "\"STRING", sizeof(struct string), 5461,1,0  );
> > >    +  init_tm(t_array, "aARRAY", sizeof(struct array), 4681,1,0 );
> > >    +  init_tm(t_symbol, "|SYMBOL", sizeof(struct symbol), 3640,1,0 );
> > >    +  init_tm(t_bignum, "BBIGNUM", sizeof(struct bignum), 2730,1,0 );
> > >    +  init_tm(t_ratio, "RRATIONAL", sizeof(struct ratio), 170,1,0 );
> > >       init_tm(t_shortfloat, "FSHORT-FLOAT",
> > >    -        sizeof(struct shortfloat_struct), 256 ,1);
> > >    +        sizeof(struct shortfloat_struct), 256 ,1,0);
> > >       init_tm(t_longfloat, "LLONG-FLOAT",
> > >    -        sizeof(struct longfloat_struct), 170 ,0);
> > >    -  init_tm(t_complex, "CCOMPLEX", sizeof(struct complex), 170 ,0);
> > >    -  init_tm(t_character,"#CHARACTER",sizeof(struct character), 256
> ,0);
> > >    -  init_tm(t_package, ":PACKAGE", sizeof(struct package), 2*PAGESIZE
> /
> > sizeof(struct package),0);
> > >    -  init_tm(t_hashtable, "hHASH-TABLE", sizeof(struct hashtable),
> 78,0
> > );
> > >    -  init_tm(t_vector, "vVECTOR", sizeof(struct vector), 146 ,0);
> > >    -  init_tm(t_bitvector, "bBIT-VECTOR", sizeof(struct bitvector), 73
> > ,0);
> > >    -  init_tm(t_stream, "sSTREAM", sizeof(struct stream), 78 ,0);
> > >    -  init_tm(t_random, "$RANDOM-STATE", sizeof(struct random), 256
> ,0);
> > >    -  init_tm(t_readtable, "rREADTABLE", sizeof(struct readtable), 256
> > ,0);
> > >    -  init_tm(t_pathname, "pPATHNAME", sizeof(struct pathname), 73 ,0);
> > >    -  init_tm(t_cclosure, "cCCLOSURE", sizeof(struct cclosure), 85 ,0);
> > >    -  init_tm(t_closure, "cCLOSURE", sizeof(struct cclosure), 85 ,0);
> > >    -  init_tm(t_vfun, "VVFUN", sizeof(struct vfun), 102 ,0);
> > >    -  init_tm(t_gfun, "gGFUN", sizeof(struct sfun), 0 ,0);
> > >    -  init_tm(t_afun, "AAFUN", sizeof(struct sfun), 0 ,0);
> > >    -  init_tm(t_cfdata, "cCFDATA", sizeof(struct cfdata), 102 ,0);
> > >    -  init_tm(t_spice, "!SPICE", sizeof(struct spice), 4096 ,0);
> > >    -  init_tm(t_relocatable, "%RELOCATABLE-BLOCKS", 1000,0,20);
> > >    -  init_tm(t_contiguous, "_CONTIGUOUS-BLOCKS", 1001,0,20);
> > >    +        sizeof(struct longfloat_struct), 170 ,1,0);
> > >    +  init_tm(t_complex, "CCOMPLEX", sizeof(struct complex), 170 ,1,0);
> > >    +  init_tm(t_character,"#CHARACTER",sizeof(struct character), 256
> > ,1,0);
> > >    +  init_tm(t_package, ":PACKAGE", sizeof(struct package), 2*PAGESIZE
> /
> > sizeof(struct package),1,0);
> > >    +  init_tm(t_hashtable, "hHASH-TABLE", sizeof(struct hashtable),
> > 78,1,0 );
> >  >    +  init_tm(t_vector, "vVECTOR", sizeof(struct vector), 146 ,1,0);
> > >    +  init_tm(t_bitvector, "bBIT-VECTOR", sizeof(struct bitvector), 73
> > ,1,0);
> > >    +  init_tm(t_stream, "sSTREAM", sizeof(struct stream), 78 ,1,0);
> > >    +  init_tm(t_random, "$RANDOM-STATE", sizeof(struct random), 256
> > ,1,0);
> > >    +  init_tm(t_readtable, "rREADTABLE", sizeof(struct readtable), 256
> > ,1,0);
> > >    +  init_tm(t_pathname, "pPATHNAME", sizeof(struct pathname), 73
> ,1,0);
> > >    +  init_tm(t_cclosure, "cCCLOSURE", sizeof(struct cclosure), 85
> ,1,0);
> > >    +  init_tm(t_closure, "cCLOSURE", sizeof(struct cclosure), 85 ,1,0);
> > >    +  init_tm(t_vfun, "VVFUN", sizeof(struct vfun), 102 ,1,0);
> > >    +  init_tm(t_gfun, "gGFUN", sizeof(struct sfun), 0 ,1,0);
> > >    +  init_tm(t_afun, "AAFUN", sizeof(struct sfun), 0 ,1,0);
> > >    +  init_tm(t_cfdata, "cCFDATA", sizeof(struct cfdata), 102 ,1,0);
> > >    +  init_tm(t_spice, "!SPICE", sizeof(struct spice), 4096 ,1,0);
> > >    +  init_tm(t_relocatable, "%RELOCATABLE-BLOCKS", 1000,0,20,0);
> > >    +  init_tm(t_contiguous, "_CONTIGUOUS-BLOCKS", 1001,0,20,0);
> > >       tm_table[t_relocatable].tm_nppage = PAGESIZE;
> > >       tm_table[t_contiguous].tm_nppage = PAGESIZE;
> > >
> > >    @@ -895,8 +965,15 @@
> > >     FEerror("Can't allocate ~D pages for contiguous blocks.",
> > >            1, make_fixnum(npages));
> > >
> > >    -  for (i = 0;  i < m;  i++)
> > >    +  for (i = 0;  i < m;  i++) {
> > >     type_map[page(p + PAGESIZE*i)] = (char)t_contiguous;
> > >    +    /* SGC cont pages: Before this point, GCL never marked
> contiguous
> > >    +       pages for SGC, causing no contiguous pages to be
> > >    +       swept when SGC was on.  Here we follow the behavior
> > >    +       for other pages in add_to_freelist. CM 20030827  */
> > >    +    if (sgc_enabled && tm_table[t_contiguous].tm_sgc)
> > >    +      sgc_type_map[page(p)+i]|= SGC_PAGE_FLAG;
> > >    +  }
> > >
> > >       ncbpage += m;
> > >       insert_contblock(p, PAGESIZE*m);
> > >    @@ -1140,8 +1217,11 @@
> > >     #endif
> > >        for (p = &malloc_list; *p && !endp(*p);  p = &((*p)->c.c_cdr))
> > >              if ((*p)->c.c_car->st.st_self == ptr) {
> > >    -                  insert_contblock((*p)->c.c_car->st.st_self,
> > >    -                               (*p)->c.c_car->st.st_dim);
> > >    +/* SGC contblock pages: leave sweeping to GBC.  Could also try
> > >    +   protecting this with sgc_enabled && strm->d.s==SGC_NORMAL and a
> > >    +   switch to old_cb_pointer as appropriate  */
> > >    +/*                insert_contblock((*p)->c.c_car->st.st_self, */
> > >    +/*                             (*p)->c.c_car->st.st_dim); */
> > >                    (*p)->c.c_car->st.st_self = NULL;
> > >                    *p = (*p)->c.c_cdr;
> > >                    return ;
> > >    @@ -1189,7 +1269,10 @@
> > >        x->st.st_fillp = x->st.st_dim = size;
> > >        for (i = 0;  i < size;  i++)
> > >          x->st.st_self[i] = ((char *)ptr)[i];
> > >    -      insert_contblock(ptr, j);
> > >    +/* SGC contblock pages: leave sweeping to GBC.  Could also try
> > >    +   protecting this with sgc_enabled && strm->d.s==SGC_NORMAL and a
> > >    +   switch to old_cb_pointer as appropriate  */
> > >    +/*    insert_contblock(ptr, j); */
> > >        return(x->st.st_self);
> > >       }
> > >     }
> > >    Index: o/file.d
> > >    ===================================================================
> > >    RCS file: /cvsroot/gcl/gcl/o/file.d,v
> > >    retrieving revision 1.21
> > >    diff -u -r1.21 file.d
> > >    --- o/file.d 18 Feb 2003 02:32:03 -0000    1.21
> > >    +++ o/file.d 29 Aug 2003 03:54:35 -0000
> > >    @@ -303,11 +303,16 @@
> > >     deallocate_stream_buffer(strm)
> > >     object strm;
> > >     {
> > >    -  if (strm->sm.sm_buffer)
> > >    -    {insert_contblock(strm->sm.sm_buffer, BUFSIZ);
> > >    -     strm->sm.sm_buffer = 0;}
> > >    - else
> > >    -    printf("no buffer? %p  \n",strm->sm.sm_fp);
> > >    +
> > >    +/* SGC contblock pages: leave sweeping to GBC.  Could also try
> > >    +   protecting this with sgc_enabled && strm->d.s==SGC_NORMAL and a
> > >    +   switch to old_cb_pointer as appropriate  */
> > >    +
> > >    +/*   if (strm->sm.sm_buffer) */
> > >    +/*     {insert_contblock(strm->sm.sm_buffer, BUFSIZ); */
> > >    +/*      strm->sm.sm_buffer = 0;} */
> > >    +/*  else */
> > >    +/*     printf("no buffer? %p  \n",strm->sm.sm_fp); */
> > >
> > >     #ifndef FCLOSE_SETBUF_OK
> > >       strm->sm.sm_fp->_base = NULL;
> > >    Index: o/gbc.c
> > >    ===================================================================
> > >    RCS file: /cvsroot/gcl/gcl/o/gbc.c,v
> > >    retrieving revision 1.13.4.1
> > >    diff -u -r1.13.4.1 gbc.c
> > >    --- o/gbc.c  30 Jul 2003 15:11:12 -0000    1.13.4.1
> > >    +++ o/gbc.c  29 Aug 2003 03:54:36 -0000
> > >    @@ -1012,19 +1012,24 @@
> > >     e = pagetochar(j);
> > >     for (p = s;  p < e;) {
> > >       if (get_mark_bit((int *)p)) {
> > >    -      p += PTR_ALIGN;
> > >    +      /* SGC cont pages: cont blocks must be no smaller than
> > >    +         sizeof(struct contblock), and must not have a sweep
> > >    +         granularity greater than this amount (e.g. CPTR_ALIGN) if
> > >    +         contblock leaks are to be avoided.  Used to be aligned at
> > >    +         PTR_ALIGN. CM 20030827 */
> > >    +      p += CPTR_ALIGN;
> > >        continue;
> > >       }
> > >    -      q = p + PTR_ALIGN;
> > >    +      q = p + CPTR_ALIGN;
> > >       while (q < e) {
> > >        if (!get_mark_bit((int *)q)) {
> > >    -        q += PTR_ALIGN;
> > >    +        q += CPTR_ALIGN;
> > >          continue;
> > >        }
> > >        break;
> > >       }
> > >       insert_contblock(p, q - p);
> > >    -      p = q + PTR_ALIGN;
> > >    +      p = q + CPTR_ALIGN;
> > >     }
> > >     i = j + 1;
> > >       }
> > >    @@ -1067,8 +1072,8 @@
> > >     if(sgc_enabled) sgc_quit();
> > >
> > >     }
> > >    -
> > >    -
> > >    +
> > >    +
> > >     #ifdef DEBUG
> > >       debug = symbol_value(sSAgbc_messageA) != Cnil;
> > >     #endif
> > >    @@ -1278,6 +1283,9 @@
> > >
> > >       interrupt_enable = TRUE;
> > >
> > >    +  if (in_sgc && sgc_enabled==0)
> > >    +    sgc_start();
> > >    +
> > >       if (saving_system) {
> > >     j = (rb_pointer-rb_start+PAGESIZE-1) / PAGESIZE;
> > >
> > >    @@ -1323,10 +1331,6 @@
> > >       if (GBC_exit_hook != NULL)
> > >     (*GBC_exit_hook)();
> > >
> > >    -
> > >    -  if (in_sgc && sgc_enabled==0)
> > >    -    sgc_start();
> > >    -
> > >       if(gc_time>=0 && !--gc_recursive)
> > {gc_time=gc_time+(gc_start=(runtime()-gc_start));}
> > >
> > >       if (sSAnotify_gbcA->s.s_dbind != Cnil) {
> > >    @@ -1423,8 +1427,10 @@
> > >       if (!MAYBE_DATA_P(p) || (enum type)type_map[page(p)] !=
> > t_contiguous)
> > >     return;
> > >       q = p + s;
> > >    -  x = (int *)ROUND_DOWN_PTR(p);
> > >    -  y = (int *)ROUND_UP_PTR(q);
> > >    +  /* SGC cont pages: contblock pages must be no smaller than
> > >    +     sizeof(struct contblock).  CM 20030827 */
> > >    +  x = (int *)ROUND_DOWN_PTR_CONT(p);
> > >    +  y = (int *)ROUND_UP_PTR_CONT(q);
> > >       for (;  x < y;  x++)
> > >     set_mark_bit(x);
> > >     }
> > >    Index: o/gmp.c
> > >    ===================================================================
> > >    RCS file: /cvsroot/gcl/gcl/o/gmp.c,v
> > >    retrieving revision 1.3
> > >    diff -u -r1.3 gmp.c
> > >    --- o/gmp.c  15 Feb 2003 00:38:28 -0000    1.3
> > >    +++ o/gmp.c  29 Aug 2003 03:54:36 -0000
> > >    @@ -15,7 +15,10 @@
> > >       old = oldmem;
> > >       bcopy(MP_SELF(big_gcprotect),new,oldsize);
> > >       MP_SELF(big_gcprotect)=0;
> > >    -  if (inheap(oldmem)) insert_contblock(oldmem,oldsize);
> > >    +/* SGC contblock pages: leave sweeping to GBC.  Could also try
> > >    +   protecting this with sgc_enabled && strm->d.s==SGC_NORMAL and a
>  > >    +   switch to old_cb_pointer as appropriate  */
> > >    +/*   if (inheap(oldmem)) insert_contblock(oldmem,oldsize); */
> > >       return new;
> > >     }
> > >
> > >    Index: o/sgbc.c
> > >    ===================================================================
> > >    RCS file: /cvsroot/gcl/gcl/o/sgbc.c,v
> > >    retrieving revision 1.9
> > >    diff -u -r1.9 sgbc.c
> > >    --- o/sgbc.c 15 Feb 2003 00:38:28 -0000    1.9
> > >    +++ o/sgbc.c 29 Aug 2003 03:54:36 -0000
> > >    @@ -887,19 +887,24 @@
> > >     e = pagetochar(j);
> > >     for (p = s;  p < e;) {
> > >       if (get_mark_bit((int *)p)) {
> > >    -      p += PTR_ALIGN;
> > >    +      /* SGC cont pages: cont blocks must be no smaller than
> > >    +         sizeof(struct contblock), and must not have a sweep
> > >    +         granularity greater than this amount (e.g. CPTR_ALIGN) if
> > >    +         contblock leaks are to be avoided.  Used to be aligned at
> > >    +         PTR_ALIGN. CM 20030827 */
> > >    +      p += CPTR_ALIGN;
> > >        continue;
> > >       }
> > >    -      q = p + PTR_ALIGN;
> > >    +      q = p + CPTR_ALIGN;
> > >       while (q < e) {
> > >        if (!get_mark_bit((int *)q)) {
> > >    -        q += PTR_ALIGN;
> > >    +        q += CPTR_ALIGN;
> > >          continue;
> > >        }
> > >        break;
> > >       }
> > >       insert_contblock(p, q - p);
> > >    -      p = q + PTR_ALIGN;
> > >    +      p = q + CPTR_ALIGN;
> > >     }
> > >     i = j + 1;
> > >       }
> > >    @@ -961,6 +966,56 @@
> > >       return count;
> > >     }
> > >
> > >    +   /* SGC cont pages: After SGC_start, old_cb_pointer will be a
> > linked
> > >    +   list of free blocks on non-SGC pages, and cb_pointer will be
> > >    +   likewise for SGC pages.  CM 20030827*/
> > >    +struct contblock *old_cb_pointer;
> > >    +
> > >    +#undef MDEBUG
> > >    +#define MDEBUG
> > >    +#ifdef MDEBUG
> > >    +void
> > >    +overlap_check(struct contblock *t1,struct contblock *t2) {
> > >    +
> > >    +  struct contblock *p;
> > >    +
> > >    +  for (;t1;t1=t1->cb_link) {
> > >    +
> > >    +    if (!inheap(t1)) {
> > >    +      fprintf(stderr,"%p not in heap\n",t1);
> > >    +      exit(1);
> > >    +    }
> > >    +
> > >    +    for (p=t2;p;p=p->cb_link) {
> > >    +
> > >    +      if (!inheap(p)) {
> > >    +      fprintf(stderr,"%p not in heap\n",t1);
> > >    +      exit(1);
> > >    +      }
> > >    +
> > >    +      if ((p<=t1 && (void *)p+p->cb_size>(void *)t1) ||
> > >    +        (t1<=p && (void *)t1+t1->cb_size>(void *)p)) {
> > >    +      fprintf(stderr,"Overlap %u %p  %u
> > %p\n",t1->cb_size,t1,p->cb_size,p);
> > >    +      exit(1);
> > >    +      }
> > >    +
> > >    +      if (p==p->cb_link) {
> > >    +      fprintf(stderr,"circle detected at %p\n",p);
> > >    +      exit(1);
> > >    +      }
> > >    +
> > >    +    }
> > >    +
> > >    +    if (t1==t1->cb_link) {
> > >    +      fprintf(stderr,"circle detected at %p\n",t1);
> > >    +      exit(1);
> > >    +    }
> > >    +
> > >    +  }
> > >    +
> > >    +}
> > >    +#endif
> > >    +
> > >     int
> > >     sgc_start(void) {
> > >
> > >    @@ -985,7 +1040,11 @@
> > >     {
> > >       int maxp=0;
> > >       int j;
> > >    -      int minfree = tm->tm_sgc_minfree;
> > >    +      /* SGC cont pages: This used to be simply set to
> > tm_sgc_minfree,
> > >    +       which is a definite bug, as minfree could then be zero,
> > >    +       leading this type to claim SGC pages not of its type as
> > >    +       specified in type_map.  CM 20030827*/
> > >    +      int minfree = tm->tm_sgc_minfree > 0 ? tm->tm_sgc_minfree : 1
> ;
> > >       int count;
> > >       bzero(free_map,npages*sizeof(short));
> > >       f = tm->tm_free;
> > >    @@ -1031,6 +1090,112 @@
> > >          goto FIND_FREE_PAGES;
> > >       }
> > >     }
> > >    +
> > >    +/* SGC cont pages: Here we implement the contblock page division
> into
> > >    +   SGC and non-SGC types.  Unlike the other types, we need *whole*
> > >    +   free pages for contblock SGC, as there is no psersistent data
> > >    +   element (e.g. .m) on an allocated block itself which can
> indicate
> > >    +   its live status.  If anything on a page which is to be marked
> > >    +   read-only points to a live object on an SGC cont page, it will
> > >    +   never be marked and will be erroneously swept.  It is also
> > possible
> > >    +   for dead objects to unnecessarily mark dead regions on SGC pages
> > >    +   and delay sweeping until the pointing type is GC'ed if SGC is
> > >    +   turned off for the pointing type, e.g. tm_sgc=0. (This was so by
> > >    +   default for a number of types, including bignums, and has now
> been
> > >    +   corrected in init_alloc in alloc.c.) We can't get around this
> > >    +   AFAICT, as old data on (writable) SGC pages must be marked lest
> it
> > >    +   is lost, and (old) data on now writable non-SGC pages might
> point
> > >    +   to live regions on SGC pages, yet might not themselves be
> > reachable
> > >    +   from the mark origin through an unbroken chain of writable
> pages.
> > >    +   In any case, the possibility of a lot of garbage marks on
> > contblock
> > >    +   pages, especially when the blocks are small as in bignums, makes
> > >    +   necessary the sweeping of minimal contblocks to prevent leaks.
> CM
> > >    +   20030827 */
> > >    +  {
> > >    +    void *p=NULL;
> > >    +    unsigned i,j,k,count;
> > >    +    struct contblock
> > *new_cb_pointer=NULL,*tmp_cb_pointer=NULL,**cbpp;
> > >    +
> > >    +    tm=tm_of(t_contiguous);
> > >    +
> > >    +    /* SGC cont pages:  First count whole free pages available.  CM
> > 20030827 */
> > >    +    for (cbpp=&cb_pointer,count=0;*cbpp;cbpp=&(*cbpp)->cb_link) {
> > >    +      p=PAGE_ROUND_UP((void *)(*cbpp));
> > >    +      k=p-((void *)(*cbpp));
> > >    +      if ((*cbpp)->cb_size<k || (*cbpp)->cb_size-k<PAGESIZE)
> > >    +      continue;
> > >    +      i=((*cbpp)->cb_size-k)/PAGESIZE;
> > >    +      count+=i;
> > >    +    }
> > >    +    count=tm->tm_sgc>count ? tm->tm_sgc - count : 0;
> > >    +
> > >    +    if (count>0) {
> > >    +      /* SGC cont pages: allocate more if necessary, dumping
> possible
> > >    +       GBC freed pages onto the old contblock list.  CM 20030827*/
> > >    +      int z=count+1;
> > >    +      void *p1=alloc_contblock(z*PAGESIZE);
> > >    +      p=PAGE_ROUND_UP(p1);
> > >    +      if (p>p1) {
> > >    +      z--;
> > >    +      insert_contblock(p1,p-p1);
> > >    +      insert_contblock(p+z*PAGESIZE,PAGESIZE-(p-p1));
> > >    +      }
> > >    +      tmp_cb_pointer=cb_pointer;
> > >    +      cb_pointer=new_cb_pointer;
> > >    +      /* SGC cont pages: add new pages to new contblock list. p is
> > not
> > >    +       already on any list as ensured by alloc_contblock.  CM
> > >    +       20030827 */
> > >    +      insert_contblock(p,PAGESIZE*z);
> > >    +      new_cb_pointer=cb_pointer;
> > >    +      cb_pointer=tmp_cb_pointer;
> > >    +      for (i=0;i<z;i++)
> > >    +      sgc_type_map[page(p)+i]|= SGC_PAGE_FLAG;
> > >    +    }
> > >    +
> > >    +    for (cbpp=&cb_pointer;*cbpp;) {
> > >    +      p=PAGE_ROUND_UP((void *)(*cbpp));
> > >    +      k=p-((void *)(*cbpp));
> > >    +      if ((*cbpp)->cb_size<k || (*cbpp)->cb_size-k<PAGESIZE) {
> > >    +      cbpp=&(*cbpp)->cb_link;
> > >    +      continue;
> > >    +      }
> > >    +      i=((*cbpp)->cb_size-k)/PAGESIZE;
> > >    +      i*=PAGESIZE;
> > >    +      j=(*cbpp)->cb_size-i-k;
> > >    +      /* SGC contblock pages:  remove this block from old list CM
> > 20030827 */
> > >    +      *cbpp=(*cbpp)->cb_link;
> > >    +      /* SGC contblock pages:  add fragments old list CM 20030827
> */
> > >    +      if (k) {
> > >    +      ncb--;
> > >    +      insert_contblock(p-k,k);
> > >    +      }
> > >    +      if (j) {
> > >    +      ncb--;
> > >    +      insert_contblock(p+i,j);
> > >    +      }
> > >    +      tmp_cb_pointer=cb_pointer;
> > >    +      cb_pointer=new_cb_pointer;
> > >    +      /* SGC contblock pages: add whole pages to new list, p p-k,
> and
> > >    +       p+i are guaranteed to be distinct when used. CM 20030827 */
> > >    +      insert_contblock(p,i);
> > >    +      new_cb_pointer=cb_pointer;
> > >    +      cb_pointer=tmp_cb_pointer;
> > >    +      i/=PAGESIZE;
> > >    +      for (j=0;j<i;j++)
> > >    +      sgc_type_map[page(p)+j]|= SGC_PAGE_FLAG;
> > >    +    }
> > >    +
> > >    +    /* SGC contblock pages: switch to new free SGC contblock list.
> CM
> > >    +       20030827 */
> > >    +    old_cb_pointer=cb_pointer;
> > >    +    cb_pointer=new_cb_pointer;
> > >    +
> > >    +#ifdef MDEBUG
> > >    +    overlap_check(old_cb_pointer,cb_pointer);
> > >    +#endif
> > >    +
> > >    +  }
> > >    +
> > >       /* Now  allocate the sgc relblock.   We do this as the tail
> > >      end of the ordinary rb.     */
> > >       {
> > >    @@ -1117,6 +1282,25 @@
> > >     return 0;
> > >       sgc_enabled=0;
> > >       rb_start = old_rb_start;
> > >    +
> >  >    +  /* SGC cont pages: restore contblocks, each tmp_cb_pointer
> coming
> > >    +     from the new list is guaranteed not to be on the old. Need to
> > >    +     grab 'next' before insert_contblock writes is.  CM 20030827 */
> > >    +  {
> > >    +    struct contblock *tmp_cb_pointer,*next;
> > >    +#ifdef MDEBUG
> > >    +    overlap_check(old_cb_pointer,cb_pointer);
> > >    +#endif
> > >    +    if (old_cb_pointer) {
> > >    +      tmp_cb_pointer=cb_pointer;
> > >    +      cb_pointer=old_cb_pointer;
> > >    +      for (;tmp_cb_pointer;  tmp_cb_pointer=next) {
> > >    +      next=tmp_cb_pointer->cb_link;
> > >    +      insert_contblock((void
> > *)tmp_cb_pointer,tmp_cb_pointer->cb_size);
> > >    +      }
> > >    +    }
> > >    +  }
> > >    +
> > >       for (i= t_start; i < t_contiguous ; i++)
> > >     if (TM_BASE_TYPE_P(i)) {
> > >       tm=tm_of(i);
> > >
> >
> =============================================================================
> 
> >
> > >
> > >    "Matt Kaufmann" <address@hidden> writes:
> > >
> > >    > Hi, Camm --
> > >    >
> > >    > I applied your patches to the GCL version we have at AMD (which
> > incorporates
> > >    > the other patches you've sent) and got a segmentation violation
> > during GC.  The
> > >    > last few lines are as shown below.  I'm afraid I can't send out
> the
> > source
> > >    > files, but if there's some way you'd like me to re-run this test,
> > let me know.
> > >    > (Maybe you want to send me a tarball of gcl, or point to it on the
> > web for me
> > >    > to fetch, in case I messed up in applying the patches, and in case
> > you've made
> > >    > other patches that I don't have.)  Interestingly, the wall times
> for
> > the first
> > >    > two parts of the test were significantly different between this
> run
> > and the
> > >    > latest one before the new patches were applied.
> > >    >
> > >    > In minutes,
> > >    > new vs. old:
> > >    >
> > >    >  9 vs. 18 [model-raw]
> > >    > 26 vs. 16 [bvecp-raw]
> > >    >
> > >    > Here are those last few lines.
> > >    >
> > >    > [SGC for 58 STRING pages..(3398 writable)..(T=5).GC finished]
> > >    > [SGC for 58 STRING pages..(3399 writable)..(T=5).GC finished]
> > >    > [SGC for 53 CONTIGUOUS-BLOCKS pages..(3400 writable)..(T=5).GC
> > finished]
> > >    > [SGC for 58 STRING pages..(3405 writable)..(T=5).GC finished]
> > >    > [SGC for 58 STRING pages..(3406 writable)..(T=5).GC finished]
> > >    > [SGC for 58 STRING pages..(3406 writable)..(T=6).GC finished]
> > >    > [SGC for 58 STRING pages..(3426 writable)..(T=5).GC finished]
> > >    > [SGC for 918 CONS pages..(3443 writable)..(T=6).GC finished]
> > >    > [SGC for 918 CONS pages..(3443 writable)..(T=6).GC finished]
> > >    > [SGC for 918 CONS pages..(3444 writable)..(T=6).GC finished]
> > >    > [SGC for 53 CONTIGUOUS-BLOCKS pages..(3445 writable)..(T=7).GC
> > finished]
> > >    > [SGC for 58 STRING pages..(3556 writable)..(T=7).GC finished]
> > >    > [SGC for 58 STRING pages..(3592 writable)..(T=7).GC finished]
> > >    > [SGC for 58 STRING pages..(3627 writable)..(T=6).GC finished]
> > >    > [SGC for 58 STRING pages..(3663 writable)..(T=7).GC finished]
> > >    > [SGC for 95 SYMBOL pages..(3664 writable)..(T=7).GC finished]
> > >    > [SGC for 58 STRING pages..(3726 writable)..(T=7).GC finished]
> > >    > [SGC for 53 CONTIGUOUS-BLOCKS pages..(3764 writable)..(T=7).GC
> > finished]
> > >    > [SGC for 58 STRING pages..(3814 writable)..(T=8).GC finished]
> > >    > [SGC off][GC for 500 RELOCATABLE-BLOCKS pages..
> > >    > Unrecoverable error: Segmentation violation..
> > >    >
> > >    > -- Matt
> > >    >    Resent-From: address@hidden
> > >    >    Resent-To: address@hidden
> > >    >    cc: address@hidden, address@hidden, address@hidden
> > >    >    From: "Camm Maguire" <address@hidden>
> > >    >    Date: 27 Aug 2003 16:17:54 -0400
> > >    >    User-Agent: Gnus/5.09 (Gnus v5.9.0) Emacs/21.2
> > >    >    X-WSS-ID: 1350D47E1239945-01-01
> > >    >    Content-Type: text/plain;
> > >    >     charset=us-ascii
> > >    >
> > >    >    Greetings!
> > >    >
> > >    >    OK, here's the short version:
> > >    >
> > >    >    It was broken. Now its fixed :-).
> > >    >
> > >    >    Slightly longer than this, current GCL never marks contiguous
> > pages as
> > >    >    SGC pages, and only sweeps the latter when SGC is on, leading
> to
> > the
> > >    >    massive leak.  The extra reloc pages in the example put it over
> > the
> > >    >    top.
> > >    >
> > >    >    One can of course address this in several ways.  One is to turn
> > off
> > >    >    SGC on contiguous pages with (si::allocate-sgc 'contiguous 0
> 3000
> > 0).
> > >    >    But this is obviously not optimal.
> > >    >
> > >    >    Instead I've constructed a patch which implements SGC for
> > contiguous
> > >    >    pages.  Its quite tricky, being close to the most involved
> change
> > yet
> > >    >    I've made to GCL.  I've tried to document all the details in
> the
> > >    >    comments.  You can read them in the patch below if you'd like.
> > >    >
> > >    >    A patch of this import of course needs to be well tested.  All
> > goes
> > >    >    well with maxima, self-build, and ansi thus far.  Am presently
> > testing
> > >    >    the acl2 book certification.  Then it probably needs to be run
> by
> > >    >    axiom.  I've tried it on the test below using quite a few
> > permutations
> > >    >    of (allocate, allocate-sgc)
> (contiguous,relblock,cfun(==bignum)),
> > >    >    sgc-on, and even si::SET-GMP-ALLOCATE-RELOCATABLE successfully,
> > >    >    although nothing exhaustive as yet.
> > >    >
> > >    >    Just as a reminder, gmp bignums are allocated on contiguous
> pages
> > by
> > >    >    default, as these reproduce malloc semantics (i.e. they don't
> > move),
> > >    >    and one is thus assured that no caching in the external gmp
> > library
> > >    >    will be corrupted.  Dr. Schelter apparently audited the gmp
> code
> > at
> > >    >    the point when support for it was added, identifying and
> removing
> > >    >    precisely one malloc in a bad place with a safe alloca,
> allowing
> > >    >    bignums to be allocated on faster relocatable pages instead.  I
> > have
> > >    >    never repeated this analysis, but we do overwrite said malloc
> > with the
> > >    >    new alloca even when linking gmp in dynamically.  gmp could
> > introduce
> > >    >    another bad malloc without our noticing conceivably, but as of
> > right
> > >    >    now, relocatable bignums work fine at least in this test.  Of
>  > course
> > >    >    building GCL with its own copy of gmp will always work as it
> ever
> > >    >    has.  (si::set-gmp-allocate-relocatable t) to try it out.
> > >    >
> > >    >    Separately, several page types had no SGC pages allocated by
> > default,
> > >    >    including bignums, leading to a thrashing of sgc-on, sgc-off in
> > the
> > >    >    test below when the bignum header underwent GC.  I've remedied
> > this
> > >    >    default situation here as well.
> > >    >
> > >    >    I've not even committed this change yet as it still might need
> > >    >    a few minor adjustments, but it basically appears to be
> working.
> > >    >    Feedback from GC gurus of course appreciated as always :-).
> > Hammer on
> > >    >    it and find the bugs if you are so inclined!
> > >    >
> > >    >    To the list -- sorry about being delayed on this time consuming
> > >    >    project, but I feel it takes precedence over things I'd rather
> > get to,
> > >    >    like ansi support.
> > >    >
> > >    >    Take care,
> > >    >
> > >    >
> >
> =============================================================================
> 
> >
> > >    >    Index: h/object.h
> > >    >
> > ===================================================================
> > >    >    RCS file: /cvsroot/gcl/gcl/h/object.h,v
> > >    >    retrieving revision 1.18.4.1
> > >    >    diff -u -r1.18.4.1 object.h
> > >    >    --- h/object.h      16 Jul 2003 02:02:49 -0000    1.18.4.1
> > >    >    +++ h/object.h      27 Aug 2003 19:21:52 -0000
> > >    >    @@ -759,6 +759,7 @@
> > >    >         short   tm_max_grow;    /* max amount to grow when growing
> > */
> > >    >         short   tm_growth_percent;  /* percent to increase
> maxpages
> > */
> > >    >         short   tm_percent_free;  /* percent which must be free
> > after a gc for this type */
> > >    >    +        short   tm_distinct;       /* pages of this type are
> > distinct */
> > >    >
> > >    >     };
> > >    >
> > >    >    Index: h/page.h
> > >    >
> > ===================================================================
> > >    >    RCS file: /cvsroot/gcl/gcl/h/page.h,v
> > >    >    retrieving revision 1.4.4.1
> > >    >    diff -u -r1.4.4.1 page.h
> > >    >    --- h/page.h  21 Aug 2003 04:17:47 -0000    1.4.4.1
> > >    >    +++ h/page.h  27 Aug 2003 19:21:52 -0000
> > >    >    @@ -29,6 +29,12 @@
> > >    >     #define ROUND_UP_PTR(n)  (((long)(n) + (PTR_ALIGN-1)) &
> > ~(PTR_ALIGN-1))
> > >    >     #define ROUND_DOWN_PTR(n) (((long)(n)  & ~(PTR_ALIGN-1)))
> > >    >
> > >    >    +/* alignment required for contiguous pointers */
> > >    >    +#define CPTR_ALIGN (PTR_ALIGN < sizeof(struct contblock) ?
> > sizeof(struct contblock) : PTR_ALIGN)
> > >    >    +
> > >    >    +#define ROUND_UP_PTR_CONT(n)   (((long)(n) + (CPTR_ALIGN-1)) &
> > ~(CPTR_ALIGN-1))
> > >    >    +#define ROUND_DOWN_PTR_CONT(n) (((long)(n)  &
> ~(CPTR_ALIGN-1)))
> > >    >    +
> > >    >
> > >    >     #ifdef SGC
> > >    >
> > >    >    Index: o/alloc.c
> > >    >
> > ===================================================================
> > >    >    RCS file: /cvsroot/gcl/gcl/o/alloc.c,v
> > >    >    retrieving revision 1.19
> > >    >    diff -u -r1.19 alloc.c
> > >    >    --- o/alloc.c 1 Mar 2003 22:37:37 -0000     1.19
> > >    >    +++ o/alloc.c 27 Aug 2003 19:21:52 -0000
> > >    >    @@ -425,9 +425,19 @@
> > >    >     /*
> > >    >         printf("allocating %d-byte contiguous block...\n", n);
> > >    >     */
> > >    >    +  /* SGC cont pages: contiguous pointers must be aligned at
> > >    >    +     CPTR_ALIGN, no smaller than sizeof (struct contblock).
> > >    >    +     Here we allocate a bigger block, and rely on the fact
> that
> > >    >    +     allocate_page returns pointers appropriately aligned,
> > >    >    +     being also aligned on page boundaries.  Protection
> against
> > >    >    +     a too small contblock was aforded before by a minimum
> > >    >    +     contblock size enforced by CBMINSIZE in insert_contblock.
> > >    >    +     However, this leads to a leak when many small cont blocks
> > >    >    +     are allocated, e.g. with bignums, so is now removed.  CM
> > >    >    +     20030827 */
> > >    >
> > >    >         g = FALSE;
> > >    >    - n = ROUND_UP_PTR(n);
> > >    >    + n = ROUND_UP_PTR_CONT(n);
> > >    >
> > >    >     ONCE_MORE:
> > >    >          CHECK_INTERRUPT;
> > >    >    @@ -472,8 +482,16 @@
> > >    >        }
> > >    >         p = alloc_page(m);
> > >    >
> > >    >    - for (i = 0;  i < m;  i++)
> > >    >    + for (i = 0;  i < m;  i++) {
> > >    >               type_map[page(p) + i] = (char)t_contiguous;
> > >    >    +
> > >    >    +       /* SGC cont pages: Before this point, GCL never marked
> > contiguous
> > >    >    +          pages for SGC, causing no contiguous pages to be
> > >    >    +          swept when SGC was on.  Here we follow the behavior
> > >    >    +          for other pages in add_to_freelist. CM 20030827  */
> > >    >    +       if (sgc_enabled && tm_table[t_contiguous].tm_sgc)
> > >    >    +         sgc_type_map[page(p)+i]|= SGC_PAGE_FLAG;
> > >    >    + }
> > >    >         ncbpage += m;
> > >    >         insert_contblock(p+n, PAGESIZE*m - n);
> > >    >         return(p);
> > >    >    @@ -484,11 +502,17 @@
> > >    >
> > >    >       struct contblock **cbpp, *cbp;
> > >    >
> > >    >    -  if (s < CBMINSIZE)
> > >    >    +  /* SGC cont pages: This used to return when s<CBMINSIZE, but
> > we need
> > >    >    +     to be able to sweep small (e.g. bignum) contblocks.
> FIXME:
> > >    >    +     should never be called with s<=0 to begin with.  CM
> > 20030827*/
> > >    >    +  if (s<=0)
> > >    >      return;
> > >    >       ncb++;
> > >    >       cbp = (struct contblock *)p;
> > >    >    -  cbp->cb_size = s;
> > >    >    +  /* SGC cont pages: allocated sizes may not be zero mod
> > CPTR_SIZE,
> > >    >    +     e.g. string fillp, but alloc_contblock rounded up the
> > allocation
> > >    >    +     like this, which we follow here.  CM 20030827 */
> > >    >    +  cbp->cb_size = ROUND_UP_PTR_CONT(s);
> > >    >       for (cbpp = &cb_pointer;  *cbpp;  cbpp =
> &((*cbpp)->cb_link))
> > >    >      if ((*cbpp)->cb_size >= s) {
> > >    >        cbp->cb_link = *cbpp;
> > >    >    @@ -568,19 +592,30 @@
> > >    >         return(p);
> > >    >     }
> > >    >
> > >    >    +/* Add a tm_distinct field to prevent page type sharing if
> > desired.
> > >    >    +   Not used now, as its never desirable from an efficiency
> point
> > of
> > >    >    +   view, and as the only known place one must separate is cons
> > and
> > >    >    +   fixnum, which are of different sizes unless PTR_ALIGN is
> set
> > too
> > >    >    +   high (e.g. 16 on a 32bit machine).  See the ordering of
> > init_tm
> > >    >    +   calls for these types below -- reversing would wind up
> > merging the
> > >    >    +   types with the current algorithm.  CM 20030827 */
> > >    >    +
> > >    >     static void
> > >    >    -init_tm(enum type t, char *name, int elsize, int nelts, int
> sgc)
> > {
> > >    >    +init_tm(enum type t, char *name, int elsize, int nelts, int
> > sgc,int distinct) {
> > >    >
> > >    >       int i, j;
> > >    >       int maxpage;
> > >    >       /* round up to next number of pages */
> > >    >       maxpage = (((nelts * elsize) + PAGESIZE -1)/PAGESIZE);
> > >    >       tm_table[(int)t].tm_name = name;
> > >    >    -  for (j = -1, i = 0;  i < (int)t_end;  i++)
> > >    >    -    if (tm_table[i].tm_size != 0 &&
> > >    >    - tm_table[i].tm_size >= elsize &&
> > >    >    - (j < 0 || tm_table[j].tm_size > tm_table[i].tm_size))
> > >    >    -      j = i;
> > >    >    +  j=-1;
> > >    >    +  if (!distinct)
> > >    >    +    for (i = 0;  i < (int)t_end;  i++)
> > >    >    +      if (tm_table[i].tm_size != 0 &&
> > >    >    +   tm_table[i].tm_size >= elsize &&
> > >    >    +   !tm_table[i].tm_distinct &&
> > >    >    +   (j < 0 || tm_table[j].tm_size > tm_table[i].tm_size))
> > >    >    + j = i;
> > >    >       if (j >= 0) {
> > >    >      tm_table[(int)t].tm_type = (enum type)j;
> > >    >      tm_table[j].tm_maxpage += maxpage;
> > >    >    @@ -598,6 +633,7 @@
> > >    >       /*tm_table[(int)t].tm_npage = 0; */  /* dont zero nrbpage..
> */
> > >    >       tm_table[(int)t].tm_maxpage = maxpage;
> > >    >       tm_table[(int)t].tm_gbccount = 0;
> > >    >    +  tm_table[(int)t].tm_distinct=distinct;
> > >    >     #ifdef SGC
> > >    >       tm_table[(int)t].tm_sgc = sgc;
> > >    >       tm_table[(int)t].tm_sgc_max = 3000;
> > >    >    @@ -688,40 +724,46 @@
> > >    >       for (i = 0;  i < MAXPAGE;  i++)
> > >    >      type_map[i] = (char)t_other;
> > >    >
> > >    >    +  /* Unused (at present) tm_distinct flag added.  Note that if
> > cons
> > >    >    +     and fixnum share page types, errors will be introduced.
> > >    >    +
> > >    >    +     Gave each page type at least some sgc pages by default.
> Of
> > >    >    +     course changeable by allocate-sgc.  CM 20030827 */
> > >    >    +
> > >    >       init_tm(t_fixnum, "NFIXNUM",
> > >    >    -   sizeof(struct fixnum_struct), 8192,20);
> > >    >    -  init_tm(t_cons, ".CONS", sizeof(struct cons), 65536 ,50 );
> > >    >    -  init_tm(t_structure, "SSTRUCTURE", sizeof(struct structure),
> > 5461,0 );
> > >    >    -  init_tm(t_cfun, "fCFUN", sizeof(struct cfun), 4096,0  );
> > >    >    -  init_tm(t_sfun, "gSFUN", sizeof(struct sfun),409,0 );
> > >    >    -  init_tm(t_string, "\"STRING", sizeof(struct string), 5461,1
> > );
> > >    >    -  init_tm(t_array, "aARRAY", sizeof(struct array), 4681,1 );
> > >    >    -  init_tm(t_symbol, "|SYMBOL", sizeof(struct symbol), 3640,1
> );
> > >    >    -  init_tm(t_bignum, "BBIGNUM", sizeof(struct bignum), 2730,0
> );
> > >    >    -  init_tm(t_ratio, "RRATIONAL", sizeof(struct ratio), 170,0 );
> > >    >    +   sizeof(struct fixnum_struct), 8192,20,0);
> >  >    >    +  init_tm(t_cons, ".CONS", sizeof(struct cons), 65536 ,50,0
> );
> > >    >    +  init_tm(t_structure, "SSTRUCTURE", sizeof(struct structure),
> > 5461,1,0 );
> > >    >    +  init_tm(t_cfun, "fCFUN", sizeof(struct cfun), 4096,1,0  );
> > >    >    +  init_tm(t_sfun, "gSFUN", sizeof(struct sfun),409,1,0 );
> > >    >    +  init_tm(t_string, "\"STRING", sizeof(struct string),
> 5461,1,0
> > );
> > >    >    +  init_tm(t_array, "aARRAY", sizeof(struct array), 4681,1,0 );
> > >    >    +  init_tm(t_symbol, "|SYMBOL", sizeof(struct symbol), 3640,1,0
> > );
> > >    >    +  init_tm(t_bignum, "BBIGNUM", sizeof(struct bignum), 2730,1,0
> > );
> > >    >    +  init_tm(t_ratio, "RRATIONAL", sizeof(struct ratio), 170,1,0
> );
> > >    >       init_tm(t_shortfloat, "FSHORT-FLOAT",
> > >    >    -   sizeof(struct shortfloat_struct), 256 ,1);
> > >    >    +   sizeof(struct shortfloat_struct), 256 ,1,0);
> > >    >       init_tm(t_longfloat, "LLONG-FLOAT",
> > >    >    -   sizeof(struct longfloat_struct), 170 ,0);
> > >    >    -  init_tm(t_complex, "CCOMPLEX", sizeof(struct complex), 170
> > ,0);
> > >    >    -  init_tm(t_character,"#CHARACTER",sizeof(struct character),
> 256
> > ,0);
> > >    >    -  init_tm(t_package, ":PACKAGE", sizeof(struct package),
> > 2*PAGESIZE / sizeof(struct package),0);
> > >    >    -  init_tm(t_hashtable, "hHASH-TABLE", sizeof(struct
> hashtable),
> > 78,0 );
> > >    >    -  init_tm(t_vector, "vVECTOR", sizeof(struct vector), 146 ,0);
> > >    >    -  init_tm(t_bitvector, "bBIT-VECTOR", sizeof(struct
> bitvector),
> > 73 ,0);
> > >    >    -  init_tm(t_stream, "sSTREAM", sizeof(struct stream), 78 ,0);
> > >    >    -  init_tm(t_random, "$RANDOM-STATE", sizeof(struct random),
> 256
> > ,0);
> > >    >    -  init_tm(t_readtable, "rREADTABLE", sizeof(struct readtable),
> > 256 ,0);
> > >    >    -  init_tm(t_pathname, "pPATHNAME", sizeof(struct pathname), 73
> > ,0);
> > >    >    -  init_tm(t_cclosure, "cCCLOSURE", sizeof(struct cclosure), 85
> > ,0);
> > >    >    -  init_tm(t_closure, "cCLOSURE", sizeof(struct cclosure), 85
> > ,0);
> > >    >    -  init_tm(t_vfun, "VVFUN", sizeof(struct vfun), 102 ,0);
> > >    >    -  init_tm(t_gfun, "gGFUN", sizeof(struct sfun), 0 ,0);
> > >    >    -  init_tm(t_afun, "AAFUN", sizeof(struct sfun), 0 ,0);
> > >    >    -  init_tm(t_cfdata, "cCFDATA", sizeof(struct cfdata), 102 ,0);
> > >    >    -  init_tm(t_spice, "!SPICE", sizeof(struct spice), 4096 ,0);
> > >    >    -  init_tm(t_relocatable, "%RELOCATABLE-BLOCKS", 1000,0,20);
> > >    >    -  init_tm(t_contiguous, "_CONTIGUOUS-BLOCKS", 1001,0,20);
> > >    >    +   sizeof(struct longfloat_struct), 170 ,1,0);
> > >    >    +  init_tm(t_complex, "CCOMPLEX", sizeof(struct complex), 170
> > ,1,0);
> > >    >    +  init_tm(t_character,"#CHARACTER",sizeof(struct character),
> 256
> > ,1,0);
> > >    >    +  init_tm(t_package, ":PACKAGE", sizeof(struct package),
> > 2*PAGESIZE / sizeof(struct package),1,0);
> > >    >    +  init_tm(t_hashtable, "hHASH-TABLE", sizeof(struct
> hashtable),
> > 78,1,0 );
> > >    >    +  init_tm(t_vector, "vVECTOR", sizeof(struct vector), 146
> ,1,0);
> > >    >    +  init_tm(t_bitvector, "bBIT-VECTOR", sizeof(struct
> bitvector),
> > 73 ,1,0);
> > >    >    +  init_tm(t_stream, "sSTREAM", sizeof(struct stream), 78
> ,1,0);
> > >    >    +  init_tm(t_random, "$RANDOM-STATE", sizeof(struct random),
> 256
> > ,1,0);
> > >    >    +  init_tm(t_readtable, "rREADTABLE", sizeof(struct readtable),
> > 256 ,1,0);
> > >    >    +  init_tm(t_pathname, "pPATHNAME", sizeof(struct pathname), 73
> > ,1,0);
> > >    >    +  init_tm(t_cclosure, "cCCLOSURE", sizeof(struct cclosure), 85
> > ,1,0);
> > >    >    +  init_tm(t_closure, "cCLOSURE", sizeof(struct cclosure), 85
> > ,1,0);
> > >    >    +  init_tm(t_vfun, "VVFUN", sizeof(struct vfun), 102 ,1,0);
> > >    >    +  init_tm(t_gfun, "gGFUN", sizeof(struct sfun), 0 ,1,0);
> > >    >    +  init_tm(t_afun, "AAFUN", sizeof(struct sfun), 0 ,1,0);
> > >    >    +  init_tm(t_cfdata, "cCFDATA", sizeof(struct cfdata), 102
> ,1,0);
> > >    >    +  init_tm(t_spice, "!SPICE", sizeof(struct spice), 4096 ,1,0);
> > >    >    +  init_tm(t_relocatable, "%RELOCATABLE-BLOCKS", 1000,0,20,0);
> > >    >    +  init_tm(t_contiguous, "_CONTIGUOUS-BLOCKS", 1001,0,20,0);
> > >    >       tm_table[t_relocatable].tm_nppage = PAGESIZE;
> > >    >       tm_table[t_contiguous].tm_nppage = PAGESIZE;
> > >    >
> > >    >    Index: o/gbc.c
> > >    >
> > ===================================================================
> > >    >    RCS file: /cvsroot/gcl/gcl/o/gbc.c,v
> > >    >    retrieving revision 1.13.4.1
> > >    >    diff -u -r1.13.4.1 gbc.c
> > >    >    --- o/gbc.c   30 Jul 2003 15:11:12 -0000    1.13.4.1
> > >    >    +++ o/gbc.c   27 Aug 2003 19:21:52 -0000
> > >    >    @@ -1012,19 +1012,24 @@
> > >    >      e = pagetochar(j);
> > >    >      for (p = s;  p < e;) {
> > >    >        if (get_mark_bit((int *)p)) {
> > >    >    - p += PTR_ALIGN;
> > >    >    + /* SGC cont pages: cont blocks must be no smaller than
> > >    >    +    sizeof(struct contblock), and must not have a sweep
> > >    >    +    granularity greater than this amount (e.g. CPTR_ALIGN) if
> > >    >    +    contblock leaks are to be avoided.  Used to be aligned at
> > >    >    +    PTR_ALIGN. CM 20030827 */
> > >    >    + p += CPTR_ALIGN;
> > >    >         continue;
> > >    >        }
> > >    >    -      q = p + PTR_ALIGN;
> > >    >    +      q = p + CPTR_ALIGN;
> > >    >        while (q < e) {
> > >    >         if (!get_mark_bit((int *)q)) {
> > >    >    -   q += PTR_ALIGN;
> > >    >    +   q += CPTR_ALIGN;
> > >    >           continue;
> > >    >         }
>  > >    >         break;
> > >    >        }
> > >    >        insert_contblock(p, q - p);
> > >    >    -      p = q + PTR_ALIGN;
> > >    >    +      p = q + CPTR_ALIGN;
> > >    >      }
> > >    >      i = j + 1;
> > >    >       }
> > >    >    @@ -1067,8 +1072,8 @@
> > >    >      if(sgc_enabled) sgc_quit();
> > >    >
> > >    >      }
> > >    >    -
> > >    >    -
> > >    >    +
> > >    >    +
> > >    >     #ifdef DEBUG
> > >    >       debug = symbol_value(sSAgbc_messageA) != Cnil;
> > >    >     #endif
> > >    >    @@ -1423,8 +1428,10 @@
> > >    >       if (!MAYBE_DATA_P(p) || (enum type)type_map[page(p)] !=
> > t_contiguous)
> > >    >      return;
> > >    >       q = p + s;
> > >    >    -  x = (int *)ROUND_DOWN_PTR(p);
> > >    >    -  y = (int *)ROUND_UP_PTR(q);
> > >    >    +  /* SGC cont pages: contblock pages must be no smaller than
> > >    >    +     sizeof(struct contblock).  CM 20030827 */
> > >    >    +  x = (int *)ROUND_DOWN_PTR_CONT(p);
> > >    >    +  y = (int *)ROUND_UP_PTR_CONT(q);
> > >    >       for (;  x < y;  x++)
> > >    >      set_mark_bit(x);
> > >    >     }
> > >    >    Index: o/sgbc.c
> > >    >
> > ===================================================================
> > >    >    RCS file: /cvsroot/gcl/gcl/o/sgbc.c,v
> > >    >    retrieving revision 1.9
> > >    >    diff -u -r1.9 sgbc.c
> > >    >    --- o/sgbc.c  15 Feb 2003 00:38:28 -0000    1.9
> > >    >    +++ o/sgbc.c  27 Aug 2003 19:21:53 -0000
> > >    >    @@ -887,19 +887,24 @@
> > >    >      e = pagetochar(j);
> > >    >      for (p = s;  p < e;) {
> > >    >        if (get_mark_bit((int *)p)) {
> > >    >    - p += PTR_ALIGN;
> > >    >    + /* SGC cont pages: cont blocks must be no smaller than
> > >    >    +    sizeof(struct contblock), and must not have a sweep
> > >    >    +    granularity greater than this amount (e.g. CPTR_ALIGN) if
> > >    >    +    contblock leaks are to be avoided.  Used to be aligned at
> > >    >    +    PTR_ALIGN. CM 20030827 */
> > >    >    + p += CPTR_ALIGN;
> > >    >         continue;
> > >    >        }
> > >    >    -      q = p + PTR_ALIGN;
> > >    >    +      q = p + CPTR_ALIGN;
> > >    >        while (q < e) {
> > >    >         if (!get_mark_bit((int *)q)) {
> > >    >    -   q += PTR_ALIGN;
> > >    >    +   q += CPTR_ALIGN;
> > >    >           continue;
> > >    >         }
> > >    >         break;
> > >    >        }
> > >    >        insert_contblock(p, q - p);
> > >    >    -      p = q + PTR_ALIGN;
> > >    >    +      p = q + CPTR_ALIGN;
> > >    >      }
> > >    >      i = j + 1;
> > >    >       }
> > >    >    @@ -961,6 +966,11 @@
> > >    >       return count;
> > >    >     }
> > >    >
> > >    >    +   /* SGC cont pages: After SGC_start, old_cb_pointer will be
> a
> > linked
> > >    >    +   list of free blocks on non-SGC pages, and cb_pointer will
> be
> > >    >    +   likewise for SGC pages.  CM 20030827*/
> > >    >    +static struct contblock *old_cb_pointer;
> > >    >    +
> > >    >     int
> > >    >     sgc_start(void) {
> > >    >
> > >    >    @@ -1005,7 +1015,10 @@
> > >    >              count);fflush(stdout);
> > >    >     #endif
> > >    >        for(j=0,count=0; j <= maxp ;j++) {
>  > >    >    - if (free_map[j] >= minfree) {
> > >    >    + /* SGC cont pages: This used to be >=, which is a definite
> > >    >    +    bug, as minfree could be zero, leading this type to claim
> > >    >    +    SGC pages not of its type in type_map.  CM 20030827*/
> > >    >    + if (free_map[j] > minfree) {
> > >    >           sgc_type_map[j] |= (SGC_PAGE_FLAG | SGC_TEMP_WRITABLE);
> > >    >           ++count;
> > >    >           if (count >= tm->tm_sgc_max)
> > >    >    @@ -1031,6 +1044,101 @@
> > >    >           goto FIND_FREE_PAGES;
> > >    >        }
> > >    >      }
> > >    >    +
> > >    >    +/* SGC cont pages: Here we implement the contblock page
> division
> > into
> > >    >    +   SGC and non-SGC types.  Unlike the other types, we need
> > *whole*
> > >    >    +   free pages for contblock SGC, as there is no psersistent
> data
> > >    >    +   element (e.g. .m) on an allocated block itself which can
> > indicate
> > >    >    +   its live status.  If anything on a page which is to be
> marked
> > >    >    +   read-only points to a live object on an SGC cont page, it
> > will
> > >    >    +   never be marked and will be erroneously swept.  It is also
> > possible
> > >    >    +   for dead objects to unnecessarily mark dead regions on SGC
> > pages
> > >    >    +   and delay sweeping until the pointing type is GC'ed if SGC
> is
> > >    >    +   turned off for the pointing type, e.g. tm_sgc=0. (This was
> so
> > by
> > >    >    +   default for a number of types, including bignums, and has
> now
> > been
> > >    >    +   corrected in init_alloc in alloc.c.) We can't get around
> this
> > >    >    +   AFAICT, as old data on (writable) SGC pages must be marked
> > lest it
> > >    >    +   is lost, and (old) data on now writable non-SGC pages might
> > point
> > >    >    +   to live regions on SGC pages, yet might not themselves be
> > reachable
> > >    >    +   from the mark origin through an unbroken chain of writable
> > pages.
> > >    >    +   In any case, the possibility of a lot of garbage marks on
> > contblock
> > >    >    +   pages, especially when the blocks are small as in bignums,
> > makes
> > >    >    +   necessary the sweeping of minimal contblocks to prevent
> > leaks. CM
> > >    >    +   20030827 */
> > >    >    +  {
> > >    >    +    void *p=NULL;
> > >    >    +    unsigned i,j,k,count;
> > >    >    +    struct contblock
> > *new_cb_pointer=NULL,*tmp_cb_pointer=NULL,**cbpp;
> > >    >    +
> > >    >    +    tm=tm_of(t_contiguous);
> > >    >    +
> > >    >    +    /* SGC cont pages:  First count whole free pages
> available.
> > CM 20030827 */
> > >    >    +    for
> (cbpp=&cb_pointer,count=0;*cbpp;cbpp=&(*cbpp)->cb_link)
> > {
> > >    >    +      p=PAGE_ROUND_UP((void *)(*cbpp));
> > >    >    +      k=p-((void *)(*cbpp));
> > >    >    +      if ((*cbpp)->cb_size<k || (*cbpp)->cb_size-k<PAGESIZE)
> > >    >    + continue;
> > >    >    +      i=((*cbpp)->cb_size-k)/PAGESIZE;
> > >    >    +      count+=i;
> > >    >    +    }
> > >    >    +    count=tm->tm_sgc>count ? tm->tm_sgc - count : 0;
> > >    >    +
> > >    >    +    if (count>0) {
> > >    >    +      /* SGC cont pages: allocate more if necessary, dumping
> > possible
> > >    >    +  GBC freed pages onto the old contblock list.  CM 20030827*/
> > >    >    +      p=alloc_contblock(count*PAGESIZE);
> > >    >    +      tmp_cb_pointer=cb_pointer;
> > >    >    +      cb_pointer=new_cb_pointer;
> > >    >    +      /* SGC cont pages: add new pages to new contblock list.
> p
> > is not
> > >    >    +  already on any list as ensured by alloc_contblock.  CM
> > >    >    +  20030827 */
> > >    >    +      insert_contblock(p,PAGESIZE*count);
> > >    >    +      new_cb_pointer=cb_pointer;
> > >    >    +      cb_pointer=tmp_cb_pointer;
> > >    >    +      for (i=0;i<count;i++)
> > >    >    + sgc_type_map[page(p)+i]|= SGC_PAGE_FLAG;
> > >    >    +    }
> > >    >    +
> > >    >    +    for (cbpp=&cb_pointer;*cbpp;) {
> > >    >    +      p=PAGE_ROUND_UP((void *)(*cbpp));
> > >    >    +      k=p-((void *)(*cbpp));
> > >    >    +      if ((*cbpp)->cb_size<k || (*cbpp)->cb_size-k<PAGESIZE) {
> > >    >    + cbpp=&(*cbpp)->cb_link;
> > >    >    + continue;
> > >    >    +      }
> > >    >    +      i=((*cbpp)->cb_size-k)/PAGESIZE;
> > >    >    +      i*=PAGESIZE;
> > >    >    +      j=(*cbpp)->cb_size-i-k;
> > >    >    +      /* SGC contblock pages:  remove this block from old list
> > CM 20030827 */
> > >    >    +      *cbpp=(*cbpp)->cb_link;
> > >    >    +      /* SGC contblock pages:  add fragments old list CM
> > 20030827 */
> > >    >    +      if (k) {
> > >    >    + ncb--;
> > >    >    + insert_contblock(p-k,k);
> > >    >    +      }
> > >    >    +      if (j) {
> > >    >    + ncb--;
> > >    >    + insert_contblock(p+i,j);
> > >    >    +      }
> > >    >    +      tmp_cb_pointer=cb_pointer;
> > >    >    +      cb_pointer=new_cb_pointer;
> > >    >    +      /* SGC contblock pages: add whole pages to new list, p
> > p-k, and
> > >    >    +  p+i are guaranteed to be distinct when used. CM 20030827 */
> > >    >    +      insert_contblock(p,i);
> > >    >    +      new_cb_pointer=cb_pointer;
> > >    >    +      cb_pointer=tmp_cb_pointer;
> > >    >    +      i/=PAGESIZE;
> > >    >    +      for (j=0;j<i;j++)
> > >    >    + sgc_type_map[page(p)+j]|= SGC_PAGE_FLAG;
> > >    >    +    }
> > >    >    +
> > >    >    +    /* SGC contblock pages: switch to new free SGC contblock
> > list. CM
> > >    >    +       20030827 */
> > >    >    +    old_cb_pointer=cb_pointer;
> > >    >    +    cb_pointer=new_cb_pointer;
> > >    >    +
> > >    >    +  }
> > >    >    +
> > >    >       /* Now  allocate the sgc relblock.   We do this as the tail
> > >    >       end of the ordinary rb.     */
> > >    >       {
> > >    >    @@ -1117,6 +1225,22 @@
> > >    >      return 0;
> > >    >       sgc_enabled=0;
> > >    >       rb_start = old_rb_start;
> > >    >    +
> > >    >    +  /* SGC cont pages: restore contblocks, each tmp_cb_pointer
> > coming
> > >    >    +     from the new list is guaranteed not to be on the old.
> Need
> > to
> > >    >    +     grab 'next' before insert_contblock writes is.  CM
> 20030827
> > */
> > >    >    +  {
> > >    >    +    struct contblock *tmp_cb_pointer,*next;
> > >    >    +    if (old_cb_pointer) {
> > >    >    +      tmp_cb_pointer=cb_pointer;
> > >    >    +      cb_pointer=old_cb_pointer;
> > >    >    +      for (;tmp_cb_pointer;  tmp_cb_pointer=next) {
> > >    >    + next=tmp_cb_pointer->cb_link;
> > >    >    + insert_contblock((void
> > *)tmp_cb_pointer,tmp_cb_pointer->cb_size);
> > >    >    +      }
> > >    >    +    }
> > >    >    +  }
> > >    >    +
> > >    >       for (i= t_start; i < t_contiguous ; i++)
> > >    >      if (TM_BASE_TYPE_P(i)) {
> > >    >        tm=tm_of(i);
> > >    >
> >
> =============================================================================
> 
> >
> > >    >
> > >    >    Matt Kaufmann <address@hidden> writes:
> > >    >
> > >    >    > Hi, Camm --
> > >    >    >
> > >    >    > Below is an example where GCL 2.5.0 reports the following:
> > >    >    >
> > >    >    >   Error: Contiguous blocks exhausted.
> > >    >    >        Currently, 29486 pages are allocated.
> > >    >    >        Use ALLOCATE-CONTIGUOUS-PAGES to expand the space.
> > >    >    >   Fast links are on: do (si::use-fast-links nil) for
> debugging
> > >    >    >
> > >    >    > In fact, GCL appears to go into an infinite loop at this
> point,
> > until getting
> > >    >    > to this:
> > >    >    >
> > >    >    >   Error: Caught fatal error [memory may be damaged]
> > >    >    >   Fast links are on: do (si::use-fast-links nil) for
> debugging
> >  >    >    >   Error signalled by SYSTEM:UNIVERSAL-ERROR-HANDLER.
> > >    >    >   Broken at SYSTEM:UNIVERSAL-ERROR-HANDLER.  Type :H for
> Help.
> > >    >    >   >>
> > >    >    >
> > >    >    > The following six forms cause the error to happen.  However,
> if
> > either of the
> > >    >    > first two forms is omitted, then the error goes away.  Is
> this
> > expected
> > >    >    > behavior?  This came up because an ACL2 user got the above
> > error using the file
> > >    >    > test3.lisp shown below.  It turns out that GCL si::sgc-on is
> > called before the
> > >    >    > ACL2 image is saved, and that si::*top-level-hook* is set to
> > call
> > >    >    > si::allocate-relocatable-pages when ACL2 is started up.
> > >    >    >
> > >    >    > (si::sgc-on t)
> > >    >    > (si::allocate-relocatable-pages 500)
> > >    >    > (in-package "USER")
> > >    >    > (compile-file "test3.lisp") ; test3.lisp is shown below
> > >    >    > (load "test3")
> > >    >    > (testfun 1000000 3)
> > >    >    >
> > >    >    > ++++++++++++++++++++++++++++++ test3.lisp
> > ++++++++++++++++++++++++++++++
> > >    >    >
> > >    >    > (in-package 'user)
> > >    >    > (defconstant *A* #x5A39BFA0E42A3D15)
> > >    >    > (defconstant *M* (expt 2 63))
> > >    >    > (defconstant *C* 1)
> > >    >    >
> > >    >    >
> > >    >    > (defun genseed (seed)
> > >    >    >   (mod (+ (* *A* seed) *C*) *M*))
> > >    >    >
> > >    >    >
> > >    >    > (defun testfun (n seed)
> > >    >    >   (if (or (not (integerp n)) (<= n 0))
> > >    >    >       seed
> > >    >    >       (let* ((s0 (genseed seed))
> > >    >    >            (s1 (genseed s0)))
> > >    >    >       (testfun (1- n) s1))))
> > >    >    >
> > >    >    >
> > ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
> > >    >    >
> > >    >    > Thanks --
> > >    >    > -- Matt
> > >    >    >
> > >    >    >
> > >    >    >
> > >    >
> > >    >    --
> > >    >    Camm Maguire                                address@hidden
> > >    >
> >
> ==========================================================================
> > >    >    "The earth is but one country, and mankind its citizens."  --
> > Baha'u'llah
> > >    >
> > >    >
> > >    >
> > >    > _______________________________________________
> > >    > Gcl-devel mailing list
> > >    > address@hidden
> > >    > http://mail.gnu.org/mailman/listinfo/gcl-devel
> > >    >
> > >    >
> > >    >
> > >
> > >    --
> > >    Camm Maguire                               address@hidden
> > >
> >
> ==========================================================================
> > >    "The earth is but one country, and mankind its citizens."  --
> > Baha'u'llah
> > >
> > >
> > >
> > >
> >
> > --
> > Camm Maguire                                    address@hidden
> >
> ==========================================================================
> >  "The earth is but one country, and mankind its citizens."  --
> Baha'u'llah
> >
> >
> >
> >
> >
> 
> --
> Camm Maguire                                    address@hidden
> ==========================================================================
>  "The earth is but one country, and mankind its citizens."  --  Baha'u'llah
> 

-- 
Camm Maguire                                            address@hidden
==========================================================================
"The earth is but one country, and mankind its citizens."  --  Baha'u'llah




reply via email to

[Prev in Thread] Current Thread [Next in Thread]