Blob Blame Raw
Description: <short summary of the patch>
 TODO: Put a short summary on the line above and replace this paragraph
 with a longer explanation of this change. Complete the meta-information
 with other relevant fields (see below for details). To make it easier, the
 information below has been extracted from the changelog. Adjust it or drop
 it.
 .
 gcl (2.6.12-59) unstable; urgency=medium
 .
   * list_order.16
Author: Camm Maguire <camm@debian.org>

---
The information above should follow the Patch Tagging Guidelines, please
checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
are templates for supplementary fields that you might want to add:

Origin: <vendor|upstream|other>, <url of original patch>
Bug: <url in upstream bugtracker>
Bug-Debian: https://bugs.debian.org/<bugnumber>
Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
Forwarded: <no|not-needed|url proving that it has been forwarded>
Reviewed-By: <name and email of someone who approved the patch>
Last-Update: 2018-01-23

--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp
@@ -98,7 +98,9 @@
 (defvar *default-c-file* nil)
 (defvar *default-h-file* nil)
 (defvar *default-data-file* nil)
+(defvar *default-prof-p* nil)
 (defvar *keep-gaz* nil)
+(defvar *prof-p* nil)
 
 ;;  (list section-length split-file-names next-section-start-file-position)
 ;;  Many c compilers cannot handle the large C files resulting from large lisp files.
@@ -167,10 +169,12 @@
                            (data-file *default-data-file*)
 			   (c-debug nil)
                            (system-p *default-system-p*)
+                           (prof-p *default-prof-p*)
 			   (print nil)
                            (load nil)
                       &aux (*standard-output* *standard-output*)
-                           (*error-output* *error-output*)
+		           (*prof-p* prof-p)
+		           (*error-output* *error-output*)
                            (*compiler-in-use* *compiler-in-use*)
 			   (*c-debug* c-debug)
 			   (*compile-print* (or print *compile-print*))
@@ -488,8 +492,9 @@ Cannot compile ~a.~%"
 	  (t (setq dir ".")))
     (setq na  (namestring
 	       (make-pathname :name name :type (pathname-type(first args)))))
-   (format nil  "~a -I~a ~a ~a -c ~a -o ~a ~a"
+   (format nil  "~a ~a -I~a ~a ~a -c ~a -o ~a ~a"
 	   *cc*
+	   (if *prof-p* " -pg " "")
 	   (concatenate 'string si::*system-directory* "../h")
 	   (if (and (boundp '*c-debug*) *c-debug*) " -g " "")
            (case *speed*
--- gcl-2.6.12.orig/cmpnew/gcl_cmpwt.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmpwt.lsp
@@ -124,6 +124,7 @@
     x))
 
 (defun wt-data-file ()
+  (when *prof-p* (add-init `(si::mark-memory-as-profiling)))
   (verify-data-vector (data-vector))
   (let* ((vec (coerce (nreverse (data-inits)) 'vector)))
     (verify-data-vector vec)
--- gcl-2.6.12.orig/configure
+++ gcl-2.6.12/configure
@@ -4131,30 +4131,11 @@ $as_echo "disabled" >&6; }
 		   else
 		       { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5
 $as_echo "ok" >&6; }
-		       { $as_echo "$as_me:${as_lineno-$LINENO}: checking for text start" >&5
-$as_echo_n "checking for text start... " >&6; }
-		       echo 'int main () {return(0);}' >foo.c
-		       $CC foo.c -o foo
-		       GCL_GPROF_START=`nm foo | $AWK  '/  *[TD]  *__*start$/ {print $NF}'` # D for ppc64 -- FIXME custreloc
-		       rm -f foo.c foo
-		       if test "$GCL_GPROF_START" != "" ; then
-			   { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GCL_GPROF_START" >&5
-$as_echo "$GCL_GPROF_START" >&6; }
-
-cat >>confdefs.h <<_ACEOF
-#define GCL_GPROF_START $GCL_GPROF_START
-_ACEOF
-
-			   assert_arg_to_cflags -pg
-			   case $use in
-			       s390*) ;; # relocation truncation bug in gcc
-			       *) TLIBS="$TLIBS -pg";;
-			   esac
-       			   TFPFLAG=""
+     		       assert_arg_to_cflags -pg
+       		       TFPFLAG=""
 
 $as_echo "#define GCL_GPROF 1" >>confdefs.h
 
-		       fi
 		   fi
 	       fi
 fi
--- gcl-2.6.12.orig/configure.in
+++ gcl-2.6.12/configure.in
@@ -342,22 +342,25 @@ AC_ARG_ENABLE([gprof],[  --enable-gprof
 		       AC_MSG_RESULT([disabled])
 		   else
 		       AC_MSG_RESULT([ok])
-		       AC_MSG_CHECKING([for text start])
-		       echo 'int main () {return(0);}' >foo.c
-		       $CC foo.c -o foo
-		       GCL_GPROF_START=`nm foo | $AWK  '/  *[[TD]]  *__*start$/ {print $NF}'` # D for ppc64 -- FIXME custreloc
-		       rm -f foo.c foo
-		       if test "$GCL_GPROF_START" != "" ; then
-			   AC_MSG_RESULT($GCL_GPROF_START)
-			   AC_DEFINE_UNQUOTED(GCL_GPROF_START,$GCL_GPROF_START,[starting address for gprof])
-			   assert_arg_to_cflags -pg
-			   case $use in
-			       s390*) ;; # relocation truncation bug in gcc
-			       *) TLIBS="$TLIBS -pg";;
-			   esac
-       			   TFPFLAG=""
-			   AC_DEFINE(GCL_GPROF,1,[use gprof profiling])
-		       fi			   
+     		       assert_arg_to_cflags -pg
+       		       TFPFLAG=""
+		       AC_DEFINE(GCL_GPROF,1,[use gprof profiling])
+dnl 		       AC_MSG_CHECKING([for text start])
+dnl 		       echo 'int main () {return(0);}' >foo.c
+dnl 		       $CC foo.c -o foo
+dnl 		       GCL_GPROF_START=`nm foo | $AWK  '/  *[[TD]]  *__*start$/ {print $NF}'` # D for ppc64 -- FIXME custreloc
+dnl 		       rm -f foo.c foo
+dnl 		       if test "$GCL_GPROF_START" != "" ; then
+dnl 			   AC_MSG_RESULT($GCL_GPROF_START)
+dnl 			   AC_DEFINE_UNQUOTED(GCL_GPROF_START,$GCL_GPROF_START,[starting address for gprof])
+dnl 			   assert_arg_to_cflags -pg
+dnl #			   case $use in
+dnl #			       s390*) ;; # relocation truncation bug in gcc
+dnl #			       *) TLIBS="$TLIBS -pg";;
+dnl #			   esac
+dnl        			   TFPFLAG=""
+dnl 			   AC_DEFINE(GCL_GPROF,1,[use gprof profiling])
+dnl 		       fi
 		   fi
 	       fi])
 
--- gcl-2.6.12.orig/h/gclincl.h.in
+++ gcl-2.6.12/h/gclincl.h.in
@@ -53,9 +53,6 @@
 /* use gprof profiling */
 #undef GCL_GPROF
 
-/* starting address for gprof */
-#undef GCL_GPROF_START
-
 /* No gettimeofday call -- fixme */
 #undef GETTOD_NOT_DECLARED
 
@@ -153,6 +150,9 @@
 /* use libbfd */
 #undef HAVE_LIBBFD
 
+/* Define to 1 if you have the `dl' library (-ldl). */
+#undef HAVE_LIBDL
+
 /* Define to 1 if you have the `opcodes' library (-lopcodes). */
 #undef HAVE_LIBOPCODES
 
@@ -255,9 +255,6 @@
 /* using xgcl */
 #undef HAVE_XGCL
 
-/* number of pages to use for hole */
-#undef HOLEPAGE
-
 /* Host cpu */
 #undef HOST_CPU
 
@@ -267,9 +264,6 @@
 /* Host system */
 #undef HOST_SYSTEM
 
-/* time system constant */
-#undef HZ
-
 /* invocation history stack size */
 #undef IHSSIZE
 
@@ -321,7 +315,7 @@
 /* can use C extension for object alignment */
 #undef OBJ_ALIGN
 
-/* needed object alignment in bytes */
+/* needed object alignment bytes */
 #undef OBJ_ALIGNMENT
 
 /* Define to the address where bug reports for this package should be sent. */
@@ -345,7 +339,7 @@
 /* system pagewidth */
 #undef PAGEWIDTH
 
-/* have sigcontext in signal.h */
+/* have sigcontext of signal.h */
 #undef SIGNAL_H_HAS_SIGCONTEXT
 
 /* sizeof linked list for contiguous pages */
--- gcl-2.6.12.orig/h/lu.h
+++ gcl-2.6.12/h/lu.h
@@ -355,7 +355,8 @@ struct cfdata {
   FIRSTWORD;
   char *cfd_start;
   int cfd_size;
-  int cfd_fillp;
+  int cfd_fillp:31;
+  int cfd_prof:1;
   object *cfd_self;
   SPAD;
 };
--- gcl-2.6.12.orig/h/protoize.h
+++ gcl-2.6.12/h/protoize.h
@@ -1788,10 +1788,8 @@ int sigprocmask ( int how, const sigset_
 void recreate_heap1 ( void );
 #endif
 
-#ifdef GCL_GPROF
 void
 gprof_cleanup(void);
-#endif
 
 int
 msystem(const char *);
@@ -1970,3 +1968,6 @@ seek_to_end_ofile(FILE *);
 
 void
 travel_find_sharing(object,object);
+
+object
+new_cfdata(void);
--- gcl-2.6.12.orig/h/ptable.h
+++ gcl-2.6.12/h/ptable.h
@@ -38,6 +38,8 @@ typedef struct node TABL[];
 struct  string_address_table
 { struct node *ptable;
   unsigned int length;
+  struct node *local_ptable;
+  unsigned int local_length;
   unsigned int alloc_length;
 };
 
--- gcl-2.6.12.orig/lsp/gcl_mislib.lsp
+++ gcl-2.6.12/lsp/gcl_mislib.lsp
@@ -165,3 +165,27 @@
       (push (string-concatenate s l) nl))
     (setq *load-path* nl))
   nil)
+
+(defun default-symtab nil (concatenate 'string *tmp-dir* "gcl_symtab"))
+
+(defun gprof-output (symtab gmon)
+  (with-open-file
+     (s (format nil "|gprof -S '~a' '~a' '~a'" symtab (kcl-self) gmon))
+     (copy-stream s *standard-output*)))
+
+
+(defun gprof-start (&optional (start 0 start-p) (end 0 end-p) (symtab (default-symtab)))
+  (unless end-p
+    (multiple-value-bind
+     (s e)
+     (gprof-addresses)
+     (setq start (if start-p start s) end e)))
+  (when (monstartup start end)
+    (write-symtab symtab start end)))
+
+(defun gprof-quit (&optional (symtab (default-symtab)) &aux (gmon (mcleanup)))
+  (when gmon
+    (gprof-output symtab gmon)))
+
+
+
--- gcl-2.6.12.orig/o/alloc.c
+++ gcl-2.6.12/o/alloc.c
@@ -1177,24 +1177,6 @@ init_tm(enum type t, char *name, int els
    call is too fragile.  20050115 CM*/
 static int gcl_alloc_initialized;
 
-
-#ifdef GCL_GPROF
-static unsigned long textstart,textend,textpage;
-static void init_textpage() {
-
-  extern void *GCL_GPROF_START;
-  unsigned long s=(unsigned long)GCL_GPROF_START;
-
-  textstart=(unsigned long)&GCL_GPROF_START;
-  textend=(unsigned long)&etext;
-  if (s<textend && (textstart>textend || s>textstart))
-    textstart=s;
-
-  textpage=2*(textend-textstart)/PAGESIZE;
-  
-}
-#endif
-
 object malloc_list=Cnil;
 
 #include <signal.h>
@@ -1220,10 +1202,6 @@ gcl_init_alloc(void *cs_start) {
   init_darwin_zone_compat ();
 #endif
   
-#ifdef GCL_GPROF
-  init_textpage();
-#endif
-  
 #if defined(BSD) && defined(RLIMIT_STACK)
   {
     struct rlimit rl;
@@ -1301,11 +1279,6 @@ gcl_init_alloc(void *cs_start) {
   initial_sbrk=data_start=heap_end;
   first_data_page=page(data_start);
   
-/* #ifdef GCL_GPROF */
-/*   if (new_holepage<textpage) */
-/*      new_holepage=textpage; */
-/* #endif */
-
   /* Unused (at present) tm_distinct flag added.  Note that if cons
      and fixnum share page types, errors will be introduced.
 
@@ -1348,10 +1321,6 @@ gcl_init_alloc(void *cs_start) {
   ncbpage = 0;
   tm_table[t_contiguous].tm_min_grow=256;
   set_tm_maxpage(tm_table+t_contiguous,1);
-#ifdef GCL_GPROF
-  if (maxcbpage<textpage)
-    set_tm_maxpage(tm_table+t_contiguous,textpage);
-#endif
 
   set_tm_maxpage(tm_table+t_relocatable,1);
   nrbpage=0;
@@ -1563,113 +1532,6 @@ DEFUN_NEW("GET-HOLE-SIZE",object,fSget_h
   RETURN1(make_fixnum((rb_start-heap_end)>>PAGEWIDTH));
 }
 
-
-#ifdef GCL_GPROF
-
-static unsigned long start,end,gprof_on;
-static void *initial_monstartup_pointer;
-
-void
-gprof_cleanup(void) {
-
-  extern void _mcleanup(void);
-
-  if (initial_monstartup_pointer) {
-    _mcleanup();
-    gprof_on=0;
-  }
-
-  if (gprof_on) {
-
-    char b[PATH_MAX],b1[PATH_MAX];
-
-    if (!getcwd(b,sizeof(b)))
-      FEerror("Cannot get working directory", 0);
-    if (chdir(P_tmpdir))
-      FEerror("Cannot change directory to tmpdir", 0);
-    _mcleanup();
-    if (snprintf(b1,sizeof(b1),"gmon.out.%u",getpid())<=0)
-      FEerror("Cannot write temporary gmon filename", 0);
-    if (rename("gmon.out",b1))
-      FEerror("Cannot rename gmon.out",0);
-    if (chdir(b))
-      FEerror("Cannot restore working directory", 0);
-    gprof_on=0;
-
-  }
-
-}
-    
-static inline int
-my_monstartup(unsigned long start,unsigned long end) {
-
-  extern void monstartup(unsigned long,unsigned long);
-
-  monstartup(start,end);
-
-  return 0;
-
-}
-
-DEFUN_NEW("GPROF-START",object,fSgprof_start,SI,0,0,NONE,OO,OO,OO,OO,(void),"") {
-
-  extern void *GCL_GPROF_START;
-  static int n;
-
-  if (!gprof_on) {
-    start=start ? start : textstart;
-    end=end ? end : textend;
-    writable_malloc_wrap(my_monstartup,int,start,end);
-    gprof_on=1;
-    if (!n && atexit(gprof_cleanup)) {
-      FEerror("Cannot setup gprof_cleanup on exit", 0);
-      n=1;
-    }
-  }
-
-  return Cnil;
-
-}
-
-DEFUN_NEW("GPROF-SET",object,fSgprof_set,SI
-       ,2,2,NONE,OI,IO,OO,OO,(fixnum dstart,fixnum dend),"")
-{
-
-  start=dstart;
-  end=dend;
-
-  return Cnil;
-
-}
-
-DEFUN_NEW("GPROF-QUIT",object,fSgprof_quit,SI
-       ,0,0,NONE,OO,OO,OO,OO,(void),"")
-{
-  extern void _mcleanup(void);
-  char b[PATH_MAX],b1[PATH_MAX];
-  FILE *pp;
-  unsigned n;
-
-  if (!gprof_on)
-    return Cnil;
-
-  massert(getcwd(b,sizeof(b)));
-  massert(!chdir(P_tmpdir));
-  _mcleanup();
-  massert(snprintf(b1,sizeof(b1),"gprof '%s'",kcl_self)>0);
-  massert((pp=popen(b1,"r")));
-  while ((n=fread(b1,1,sizeof(b1),pp)))
-    massert(fwrite(b1,1,n,stdout));
-  massert(pclose(pp)>=0);
-  massert(!chdir(b));
-  gprof_on=0;
-
-  return Cnil;
-
-}
-
-#endif
-
 DEFUN_NEW("SET-STARTING-HOLE-DIVISOR",object,fSset_starting_hole_divisor,SI,1,1,NONE,II,OO,OO,OO,(fixnum div),"") {
   if (div>0 && div <100)
     starting_hole_div=div;
@@ -1808,20 +1670,7 @@ malloc_internal(size_t size) {
 void *
 malloc(size_t size) {
 
-  void *v=malloc_internal(size);;
-
-  /* FIXME: this is just to handle clean freeing of the
-     monstartup memory allocated automatically on raw image
-     startup.  In saved images, monstartup memory is only
-     allocated with gprof-start. 20040804 CM*/
-#ifdef GCL_GPROF
-  if (raw_image && size>(textend-textstart) && !initial_monstartup_pointer) {
-    massert(!atexit(gprof_cleanup));
-    initial_monstartup_pointer=v;
-  }
-#endif
-  
-  return v;
+  return malloc_internal(size);
   
 }
 
@@ -1830,7 +1679,6 @@ void
 free(void *ptr) {
 
   object *p,pp;
-  static void *initial_monstartup_pointer_echo;
   
   if (ptr == 0)
     return;
@@ -1839,15 +1687,9 @@ free(void *ptr) {
     if ((pp)->c.c_car->st.st_self == ptr) {
       (pp)->c.c_car->st.st_self = NULL;
       *p = pp->c.c_cdr;
-#ifdef GCL_GPROF
-      if (initial_monstartup_pointer==ptr) {
-	initial_monstartup_pointer_echo=ptr;
-	initial_monstartup_pointer=NULL;
-      }
-#endif
       return;
     }
-  if (ptr!=initial_monstartup_pointer_echo) {
+  {
     static void *old_ptr;
     if (old_ptr==ptr) return;
     old_ptr=ptr;
@@ -1855,7 +1697,6 @@ free(void *ptr) {
     FEerror("free(3) error.",0);
 #endif
   }
-  initial_monstartup_pointer_echo=NULL;
   return;
 }
  
--- gcl-2.6.12.orig/o/cmpaux.c
+++ gcl-2.6.12/o/cmpaux.c
@@ -393,6 +393,15 @@ call_init(int init_address, object memor
 
    */
 
+DEFUN_NEW("MARK-MEMORY-AS-PROFILING",object,fSmark_memory_as_profiling,SI,0,0,
+	  NONE,OO,OO,OO,OO,(void),"") {
+
+  sSPmemory->s.s_dbind->cfd.cfd_prof=1;
+
+  return Cnil;
+
+}
+
 void
 do_init(object *statVV)
 {object fasl_vec=sSPinit->s.s_dbind;
@@ -467,6 +476,22 @@ char *s;
 	
 #endif
 
+object
+new_cfdata(void) {
+
+  object memory=alloc_object(t_cfdata);
+
+  memory->cfd.cfd_size=0;
+  memory->cfd.cfd_fillp=0;
+  memory->cfd.cfd_prof=0;
+  memory->cfd.cfd_self=0;
+  memory->cfd.cfd_start=0;
+
+  return memory;
+
+}
+
+
 void
 gcl_init_or_load1(void (*fn)(void),const char *file) {
 
@@ -476,10 +501,7 @@ gcl_init_or_load1(void (*fn)(void),const
     object fasl_data;
     file=FIX_PATH_STRING(file);
     
-    memory=alloc_object(t_cfdata);
-    memory->cfd.cfd_self=0;
-    memory->cfd.cfd_fillp=0;
-    memory->cfd.cfd_size = 0;
+    memory=new_cfdata();
     memory->cfd.cfd_start= (char *)fn;
     printf("Initializing %s\n",file); fflush(stdout);
     fasl_data = read_fasl_data(file);
--- gcl-2.6.12.orig/o/fasldlsym.c
+++ gcl-2.6.12/o/fasldlsym.c
@@ -101,10 +101,7 @@ fasload(object faslfile) {
   SEEK_TO_END_OFILE(faslstream->sm.sm_fp);
 
   data = read_fasl_vector(faslstream);
-  memory = alloc_object(t_cfdata);
-  memory->cfd.cfd_self = NULL;
-  memory->cfd.cfd_start = NULL;
-  memory->cfd.cfd_size = 0;
+  memory=new_cfdata();
 
   if(symbol_value(sLAload_verboseA)!=Cnil)	
     printf(" start address (dynamic) %p ",fptr);
--- /dev/null
+++ gcl-2.6.12/o/gprof.c
@@ -0,0 +1,137 @@
+#include "include.h"
+#include "page.h"
+#include "ptable.h"
+
+
+static unsigned long gprof_on;
+
+DEFUN_NEW("MCLEANUP",object,fSmcleanup,SI,0,0,NONE,OO,OO,OO,OO,(void),"") {
+
+  extern void _mcleanup(void);
+
+  if (!gprof_on)
+    return Cnil;
+
+  massert(getcwd(FN1,sizeof(FN1)));
+  massert(!chdir(P_tmpdir));
+  _mcleanup();
+  massert(!chdir(FN1));
+  gprof_on=0;
+  massert(snprintf(FN1,sizeof(FN1),"%s/gmon.out",P_tmpdir)>0);
+  return make_simple_string(FN1);
+}
+
+static inline int
+my_monstartup(unsigned long start,unsigned long end) {
+
+  extern void monstartup(unsigned long,unsigned long);
+
+  monstartup(start,end);
+
+  return 0;
+
+}
+
+DEFUN_NEW("MONSTARTUP",object,fSmonstartup,SI,2,2,NONE,OI,IO,OO,OO,(ufixnum start,ufixnum end),"") {
+
+  if (gprof_on)
+    return Cnil;
+
+  writable_malloc_wrap(my_monstartup,int,start,end);
+  gprof_on=1;
+
+  return Ct;
+
+}
+
+void
+gprof_cleanup(void) {
+
+  FFN(fSmcleanup)();
+  /*rename gmon?*/
+
+}
+
+DEFUNM_NEW("GPROF-ADDRESSES",object,fSgprof_addresses,SI,0,0,NONE,OO,OO,OO,OO,(void),"") {
+
+  void *min=heap_end,*max=data_start,*c;
+  static void *mintext;
+  struct pageinfo *v;
+  object x;
+  fixnum i;
+  struct typemanager *tm=tm_of(t_cfdata);
+
+  for (v=cell_list_head;v;v=v->next)
+    if (v->type==tm->tm_type)
+      for (c=pagetochar(page(v)),i=0;i<tm->tm_nppage;i++,c+=tm->tm_size)
+	if (!is_free((x=c)) && type_of(x)==t_cfdata && x->cfd.cfd_prof) {
+	  min=(void *)x->cfd.cfd_start<min ? x->cfd.cfd_start : min;
+	  max=(void *)x->cfd.cfd_start+x->cfd.cfd_size>max ? x->cfd.cfd_start+x->cfd.cfd_size : max;
+	}
+
+  if (max<min)
+    min=max;
+
+  if (!mintext) {
+
+    mintext=data_start;
+
+#ifdef GCL_GPROF
+    for (i=0;i<c_table.length;i++)
+      mintext=(void *)c_table.ptable[i].address<mintext ? (void *)c_table.ptable[i].address : mintext;
+    for (i=0;i<c_table.local_length;i++)
+      mintext=(void *)c_table.local_ptable[i].address<mintext ? (void *)c_table.local_ptable[i].address : mintext;
+#endif
+
+  }
+
+  if (mintext<data_start)
+    min=mintext;
+
+  RETURN2(make_fixnum((fixnum)min),make_fixnum((fixnum)max));
+
+}
+
+DEFUN_NEW("KCL-SELF",object,fSkcl_self,SI,0,0,NONE,OO,OO,OO,OO,(void),"") {
+
+  return make_simple_string(kcl_self);
+
+}
+
+DEFUN_NEW("WRITE-SYMTAB",object,fSwrite_symtab,SI,3,3,NONE,OO,II,OO,OO,
+     (object symtab,ufixnum start,ufixnum end),"") {
+
+  struct package *p;
+  object l,s,f,*b,*be;
+  FILE *pp;
+  ufixnum i;
+
+  coerce_to_filename(symtab,FN1);
+  pp=fopen(FN1,"w");
+  fprintf(pp,"%016lx T GCL_MONSTART\n",start);
+  for (p=pack_pointer;p;p=p->p_link)
+    for (i=0,b=p->p_internal,be=b+p->p_internal_size;b;
+	 b=i ? NULL : p->p_external,be=b+p->p_external_size,i=1)
+      for (;b<be;b++)
+	for (l=*b;consp(l);l=l->c.c_cdr)
+	  if ((f=(s=l->c.c_car)->s.s_gfdef)!=OBJNULL && s->s.s_hpack==(object)p)
+	    switch(type_of(f)) {
+	    case t_cfun:case t_sfun:case t_vfun:case t_afun:case t_gfun:
+	      if ((ufixnum)f->cf.cf_self>=start && (ufixnum)f->cf.cf_self<end)
+		fprintf(pp,"%016lx T %-.*s::%-.*s\n",
+			(ufixnum)f->cf.cf_self,
+			p->p_name->st.st_fillp,p->p_name->st.st_self,
+			s->st.st_fillp,s->st.st_self);
+	      break;
+	    }
+  fprintf(pp,"%016lx T GCL_MONEND\n",end);
+
+  for (i=0;i<c_table.length;i++)
+    fprintf(pp,"%016lx T %s\n",c_table.ptable[i].address,c_table.ptable[i].string);
+  for (i=0;i<c_table.local_length;i++)
+    fprintf(pp,"%016lx t %s\n",c_table.local_ptable[i].address,c_table.local_ptable[i].string);
+  fclose(pp);
+
+  return symtab;
+
+}
--- gcl-2.6.12.orig/o/main.c
+++ gcl-2.6.12/o/main.c
@@ -334,9 +334,7 @@ minimize_image(void) {
   nrbpage=0;
   resize_hole(0,t_relocatable,0);
 
-#ifdef GCL_GPROF
   gprof_cleanup();
-#endif
   
 #if defined(BSD) || defined(ATT)  
   mbrk(core_end=heap_end);
@@ -425,9 +423,7 @@ gcl_cleanup(int gc) {
   {extern void _cleanup(void);_cleanup();}
 #endif
 
-#ifdef GCL_GPROF
   gprof_cleanup();
-#endif
 
   if (gc) {
 
--- gcl-2.6.12.orig/o/makefile
+++ gcl-2.6.12/o/makefile
@@ -20,7 +20,7 @@ OBJS:=$(addsuffix .o,typespec main alloc
 	num_pred num_comp num_arith num_sfun num_co num_log num_rand earith character sequence list hash\
 	array string regexpr structure toplevel file read backq print format pathname unixfsys unixfasl\
 	error unixtime unixsys unixsave funlink fat_string run_process nfunlink usig usig2 utils makefun\
-	sockets clxsocket init_pari nsocket sfasl prelink)
+	sockets clxsocket init_pari nsocket sfasl prelink gprof)
 OBJS:=$(OBJS) $(RL_OBJS) $(EXTRAS)
 
 INI_FILES=$(patsubst %.o,%.ini,${OBJS})
@@ -33,6 +33,9 @@ all:  $(OBJECTS)
 boot.o: boot.c $(DECL) boot.h
 	$(CC) -c $(CFLAGS) $(DEFS) -fPIC $*.c $(AUX_INFO) 
 
+gprof.o: gprof.c $(DECL)
+	$(CC) -c $(CFLAGS) $(DEFS) -pg $*.c $(AUX_INFO)
+
 prelink.o: prelink.c $(DECL)
 	$(CC) -c $(filter-out -pg,$(CFLAGS)) -fPIE $(DEFS) $*.c $(AUX_INFO)
 
--- gcl-2.6.12.orig/o/sfasl.c
+++ gcl-2.6.12/o/sfasl.c
@@ -273,17 +273,15 @@ SEEK_TO_END_OFILE(fp);
 /* allocate some memory */
 #ifndef STAND	
 	{BEGIN_NO_INTERRUPT;
-	memory = alloc_object(t_cfdata);
-	memory->cfd.cfd_self = 0;
-	memory->cfd.cfd_start = 0;
-	memory->cfd.cfd_size = datasize+textsize+bsssize + extra_bss;
-	vs_push(memory);
-        the_start=start_address=        
-	 memory->cfd.cfd_start =	
-	 alloc_contblock(memory->cfd.cfd_size);
-	 sfaslp->s_start_data = start_address + textsize;
-	 sfaslp->s_start_bss = start_address + textsize + datasize;
-	 END_NO_INTERRUPT;
+	  memory=new_cfdata();
+	  memory->cfd.cfd_size = datasize+textsize+bsssize + extra_bss;
+	  vs_push(memory);
+	  the_start=start_address=
+	    memory->cfd.cfd_start=
+	    alloc_contblock(memory->cfd.cfd_size);
+	  sfaslp->s_start_data = start_address + textsize;
+	  sfaslp->s_start_bss = start_address + textsize + datasize;
+	  END_NO_INTERRUPT;
        }
 #else
 	the_start = start_address
--- gcl-2.6.12.orig/o/sfaslbfd.c
+++ gcl-2.6.12/o/sfaslbfd.c
@@ -269,9 +269,7 @@ fasload(object faslfile) {
   curr_size=(unsigned long)current;
   max_align=1<<max_align;
 
-  memory = alloc_object(t_cfdata);
-  memory->cfd.cfd_self = 0;
-  memory->cfd.cfd_start = 0;
+  memory=new_cfdata();
   memory->cfd.cfd_size = curr_size + (max_align > sizeof(char *) ? max_align :0);
   
   memory->cfd.cfd_start=alloc_contblock(memory->cfd.cfd_size);
--- gcl-2.6.12.orig/o/sfaslcoff.c
+++ gcl-2.6.12/o/sfaslcoff.c
@@ -207,10 +207,8 @@ load_memory(struct scnhdr *sec1,struct s
     if (ALLOC_SEC(sec))
       sec->s_paddr=sz;
 
-  memory = alloc_object(t_cfdata);
+  memory=new_cfdata();
   memory->cfd.cfd_size=sz;
-  memory->cfd.cfd_self=0;
-  memory->cfd.cfd_start=0;
   memory->cfd.cfd_start=alloc_code_space(sz);
 
   for (sec=sec1;sec<sece;sec++) {
@@ -259,7 +257,7 @@ load_self_symbols() {
 
   for (ns=sl=0,sym=sy1;sym<sye;sym++) {
 
-    if (sym->n_sclass!=2 || sym->n_scnum<1)
+    if (sym->n_sclass<2 || sym->n_sclass>3 || sym->n_scnum<1)
       continue;
     
     ns++;
@@ -270,7 +268,7 @@ load_self_symbols() {
 
   }
 
-  c_table.alloc_length=c_table.length=ns;
+  c_table.alloc_length=ns;
   assert(c_table.ptable=malloc(sizeof(*c_table.ptable)*c_table.alloc_length));
   assert(st=malloc(sl));
 
@@ -296,9 +294,36 @@ load_self_symbols() {
     sym+=sym->n_numaux;
     
   }
-
+  c_table.length=a-c_table.ptable;
   qsort(c_table.ptable,c_table.length,sizeof(*c_table.ptable),node_compare);
 
+  for (c_table.local_ptable=a,sym=sy1;sym<sye;sym++) {
+
+    if (sym->n_sclass!=3 || sym->n_scnum<1)
+      continue;
+
+    NM(sym,st1,s,strcpy(st,s));
+
+    sec=sec1+sym->n_scnum-1;
+    jj=sym->n_value+sec->s_vaddr+h->h_ibase;
+
+#ifdef FIX_ADDRESS
+    FIX_ADDRESS(jj);
+#endif
+
+    a->address=jj;
+    a->string=st;
+
+    a++;
+    st+=strlen(st)+1;
+    sym+=sym->n_numaux;
+
+  }
+  c_table.local_length=a-c_table.local_ptable;
+  qsort(c_table.local_ptable,c_table.local_length,sizeof(*c_table.local_ptable),node_compare);
+
+  massert(c_table.alloc_length==c_table.length+c_table.local_length);
+
   massert(!un_mmap(v1,ve));
   massert(!fclose(f));
 
--- gcl-2.6.12.orig/o/sfaslelf.c
+++ gcl-2.6.12/o/sfaslelf.c
@@ -55,9 +55,12 @@ License for more details.
 #define ulmax(a_,b_) ({ul _a=a_,_b=b_;_a<_b ? _b : _a;})
 #define ALLOC_SEC(sec) (sec->sh_flags&SHF_ALLOC && (sec->sh_type==SHT_PROGBITS || sec->sh_type==SHT_NOBITS))
 #define LOAD_SEC(sec) (sec->sh_flags&SHF_ALLOC &&  sec->sh_type==SHT_PROGBITS)
-#define LOAD_SYM_BY_BIND(sym) ({ul _b=ELF_ST_BIND(sym->st_info); sym->st_value && (_b==STB_GLOBAL || _b==STB_WEAK);})
-#define LOAD_SYM_BY_NAME(sym,st1) 0
-#define LOAD_SYM(sym,st1) (LOAD_SYM_BY_BIND(sym)||LOAD_SYM_BY_NAME(sym,st1))
+#define EXT_SYM(sym) ({ul _b=ELF_ST_BIND(sym->st_info); \
+      sym->st_value && (_b==STB_GLOBAL || _b==STB_WEAK);})
+#define LOCAL_SYM(sym) (sym->st_value && \
+			ELF_ST_BIND(sym->st_info)==STB_LOCAL)
+			/* && ELF_ST_TYPE(sym->st_info)==STT_FUNC) */
+#define LOAD_SYM(sym) (EXT_SYM(sym)||LOCAL_SYM(sym))
 
 #define MASK(n) (~(~0ULL << (n)))
 
@@ -271,10 +274,8 @@ load_memory(Shdr *sec1,Shdr *sece,void *
     sz+=gsz;
   }
 
-  memory=alloc_object(t_cfdata);
+  memory=new_cfdata();
   memory->cfd.cfd_size=sz;
-  memory->cfd.cfd_self=0;
-  memory->cfd.cfd_start=0;
   memory->cfd.cfd_start=alloc_code_space(sz);
 
   a=(ul)memory->cfd.cfd_start;
@@ -411,7 +412,7 @@ calc_space(ul *ns,ul *sl,Sym *sym1,Sym *
 
   for (sym=sym1;sym<syme;sym++) {
     
-    if (!LOAD_SYM(sym,st1))
+    if (!LOAD_SYM(sym))
       continue;
 
     if (d1) {
@@ -431,13 +432,13 @@ calc_space(ul *ns,ul *sl,Sym *sym1,Sym *
 
 static int
 load_ptable(struct node **a,char **s,Sym *sym1,Sym *syme,const char *st1,
-	    Sym *d1,Sym *de,const char *ds1) {
+	    Sym *d1,Sym *de,const char *ds1,ufixnum lp) {
 
   Sym *sym,*d;
 
   for (sym=sym1;sym<syme;sym++) {
 
-    if (!LOAD_SYM(sym,st1))
+    if (!LOAD_SYM(sym) || (LOCAL_SYM(sym) ? !lp : lp))
       continue;
 
     if (d1) {
@@ -488,16 +489,23 @@ load_self_symbols() {
   massert(!calc_space(&ns,&sl,dsym1,dsyme,dst1,NULL,NULL,NULL));
   massert(!calc_space(&ns,&sl,sym1,syme,st1,dsym1,dsyme,dst1));
 
-  c_table.alloc_length=c_table.length=ns;
+  c_table.alloc_length=ns;
   massert(c_table.ptable=malloc(sizeof(*c_table.ptable)*c_table.alloc_length));
   massert(s=malloc(sl));
 
   a=c_table.ptable;
-  massert(!load_ptable(&a,&s,dsym1,dsyme,dst1,NULL,NULL,NULL));
-  massert(!load_ptable(&a,&s,sym1,syme,st1,dsym1,dsyme,dst1));
-  
+  massert(!load_ptable(&a,&s,dsym1,dsyme,dst1,NULL,NULL,NULL,0));
+  massert(!load_ptable(&a,&s,sym1,syme,st1,dsym1,dsyme,dst1,0));
+  c_table.length=a-c_table.ptable;
   qsort(c_table.ptable,c_table.length,sizeof(*c_table.ptable),node_compare);
 
+  c_table.local_ptable=a;
+  massert(!load_ptable(&a,&s,sym1,syme,st1,dsym1,dsyme,dst1,1));
+  c_table.local_length=a-c_table.local_ptable;
+  qsort(c_table.local_ptable,c_table.local_length,sizeof(*c_table.local_ptable),node_compare);
+
+  massert(c_table.alloc_length==c_table.length+c_table.local_length);
+
   massert(!un_mmap(v1,ve));
   massert(!fclose(f));
 
--- gcl-2.6.12.orig/o/sfaslmacho.c
+++ gcl-2.6.12/o/sfaslmacho.c
@@ -203,10 +203,8 @@ load_memory(struct section *sec1,struct
     sz+=gsz;
   }
   
-  memory=alloc_object(t_cfdata); 
+  memory=new_cfdata();
   memory->cfd.cfd_size=sz; 
-  memory->cfd.cfd_self=0; 
-  memory->cfd.cfd_start=0; 
   memory->cfd.cfd_start=alloc_code_space(sz);
 
   a=(ul)memory->cfd.cfd_start;
@@ -411,23 +409,19 @@ load_self_symbols() {
     
     if (sym->n_type & N_STAB)
       continue;
-    if (!(sym->n_type & N_EXT))
-      continue;
 
     ns++;
     sl+=strlen(sym->n_un.n_strx+strtab)+1;
 
   }
   
-  c_table.alloc_length=c_table.length=ns;
+  c_table.alloc_length=ns;
   assert(c_table.ptable=malloc(sizeof(*c_table.ptable)*c_table.alloc_length));
   assert(s=malloc(sl));
 
   for (a=c_table.ptable,sym=sym1;sym<syme;sym++) {
     
-    if (sym->n_type & N_STAB)
-      continue;
-    if (!(sym->n_type & N_EXT))
+    if (sym->n_type & N_STAB || !(sym->n_type & N_EXT))
       continue;
 
     a->address=sym->n_value;
@@ -438,9 +432,28 @@ load_self_symbols() {
     s+=strlen(s)+1;
 
   }
-  
+  c_table.length=a-c_table.ptable;
   qsort(c_table.ptable,c_table.length,sizeof(*c_table.ptable),node_compare);
 
+  c_table.local_ptable=a;
+  for (a=c_table.ptable,sym=sym1;sym<syme;sym++) {
+
+    if (sym->n_type & N_STAB || sym->n_type & N_EXT)
+      continue;
+
+    a->address=sym->n_value;
+    a->string=s;
+    strcpy(s,sym->n_un.n_strx+strtab);
+
+    a++;
+    s+=strlen(s)+1;
+
+  }
+  c_table.local_length=a-c_table.local_ptable;
+  qsort(c_table.local_ptable,c_table.local_length,sizeof(*c_table.local_ptable),node_compare);
+
+  massert(c_table.alloc_length==c_table.length+c_table.local_length);
+
   massert(!un_mmap(addr,addre));
   massert(!fclose(f));
 
--- gcl-2.6.12.orig/o/sfaslmacosx.c
+++ gcl-2.6.12/o/sfaslmacosx.c
@@ -232,10 +232,7 @@ int fasload (object faslfile)
     
     close_stream (faslstream);
     
-    memory = alloc_object (t_cfdata);
-    memory->cfd.cfd_self = NULL;
-    memory->cfd.cfd_start = NULL;
-    memory->cfd.cfd_size = 0;
+    memory=new_cfdata();
     
     if (symbol_value (sLAload_verboseA) != Cnil)	
         printf (" start address (dynamic) %p ", fptr);
--- gcl-2.6.12.orig/o/unixfasl.c
+++ gcl-2.6.12/o/unixfasl.c
@@ -146,9 +146,7 @@ object faslfile;
 	fread(&header, sizeof(header), 1, fp);
 #endif
 
-	memory = alloc_object(t_cfdata);
-	memory->cfd.cfd_self = NULL;
-	memory->cfd.cfd_start = NULL;
+	memory=new_cfdata();
 	memory->cfd.cfd_size = textsize + datasize + bsssize;
 	vs_push(memory);
 	/* If the file is smaller than the space asked for, typically the file
@@ -314,12 +312,10 @@ DEFUN_NEW("FASLINK-INT",object,fSfaslink
 	setbuf(fp, buf);
 	fread(&header, sizeof(header), 1, fp);
 	{BEGIN_NO_INTERRUPT;
-	memory = alloc_object(t_cfdata);
-	memory->cfd.cfd_self=0;
-	memory->cfd.cfd_start = NULL;
-	memory->cfd.cfd_size = textsize + datasize + bsssize;
-	vs_push(memory);
-	memory->cfd.cfd_start = ALLOC_ALIGNED(alloc_contblock,
+	  memory=new_cfdata();
+	  memory->cfd.cfd_size = textsize + datasize + bsssize;
+	  vs_push(memory);
+	  memory->cfd.cfd_start = ALLOC_ALIGNED(alloc_contblock,
 					      memory->cfd.cfd_size,
 					      sizeof(double));
 	END_NO_INTERRUPT;}
--- gcl-2.6.12.orig/unixport/makefile
+++ gcl-2.6.12/unixport/makefile
@@ -69,28 +69,26 @@ $(LSPDIR)/auto_new.lsp: $(LSPDIR)/auto.l
 	[ "$(RL_OBJS)" = "" ] || \
 		echo "(AUTOLOAD 'init-readline '|readline|)" >>$@
 
-sys_init.lsp: sys_init.lsp.in
+saved_%:raw_% $(RSYM) sys_init.lsp.in raw_%_map msys \
+		$(CMPDIR)/gcl_cmpmain.lsp \
+		$(CMPDIR)/gcl_lfun_list.lsp \
+		$(CMPDIR)/gcl_cmpopt.lsp $(HDIR)/cmpinclude.h \
+		$(LSPDIR)/gcl_auto_new.lsp
 
-	cat $< | sed \
+	cat sys_init.lsp.in | sed \
 		-e "s#@LI-VERS@#(`cat ../majvers`.`cat ../minvers`) `cat ../release`#1" \
 		-e "s#@LI-EXTVERS@#`cat ../minvers | cut -f2 -d.`#1" \
 		-e "s#@LI-MINVERS@#`cat ../minvers | cut -f1 -d.`#1" \
 		-e "s#@LI-MAJVERS@#`cat ../majvers`#1" \
 		-e "s#@LI-RELEASE@#`cat ../release`#1" \
-		-e "s#@LI-CC@#\"$(GCL_CC) -c $(FINAL_CFLAGS)\"#1" \
+		-e "s#@LI-CC@#\"$(GCL_CC) -c $(filter-out -pg,$(FINAL_CFLAGS))\"#1" \
+		-e "s#@LI-DFP@#\"$(filter -pg,$(FINAL_CFLAGS))\"#1" \
 		-e "s#@LI-LD@#\"$(GCL_CC) $(LD_FLAGS) -o \"#1" \
-		-e "s#@LI-LD-LIBS@#\" $(LD_LIBS_PRE) -l$* $(LD_LIBS_POST)\"#1" \
+		-e "s#@LI-LD-LIBS@#\" $(LD_LIBS_POST)\"#1" \
 		-e "s#@LI-OPT-THREE@#\"$(O3FLAGS)\"#1" \
 		-e "s#@LI-OPT-TWO@#\"$(O2FLAGS)\"#1" \
-		-e "s#@LI-INIT-LSP@#\"$@\"#1" >$@
-
-saved_%:raw_% $(RSYM) sys_init.lsp raw_%_map msys \
-		$(CMPDIR)/gcl_cmpmain.lsp \
-		$(CMPDIR)/gcl_lfun_list.lsp \
-		$(CMPDIR)/gcl_cmpopt.lsp $(HDIR)/cmpinclude.h \
-		$(LSPDIR)/gcl_auto_new.lsp
+		-e "s#@LI-INIT-LSP@#\"$@\"#1" >foo
 
-	cp sys_init.lsp foo
 	echo "(unless si::*quit-tags* (in-package \"USER\")(system:save-system \"$@\"))" >>foo
 	j=$$(ar t lib$*.a |grep ^gcl_);[ "$$j" = "" ] || ar x lib$*.a $$j #accelerator
 	$(PORTDIR)/raw_$*$(EXE) $(PORTDIR)/ -libdir $(GCLDIR)/ < foo
@@ -160,7 +158,7 @@ map_%:
 clean:
 	rm -rf  saved_*$(EXE) raw_*$(EXE) *.o core a.out $(RSYM) \
 		$(LSPDIR)/auto_new.lsp foo *maxima* init_*.lsp lib*.a gmp* bfd* *.lsp.tmp \
-		gazonk*.lsp plt*h *_map saved_* lib* raw_* msys out* log* tmp* gcl.script sys_init.lsp
+		gazonk*.lsp plt*h *_map saved_* lib* raw_* msys out* log* tmp* gcl.script
 
 .INTERMEDIATE: init_ansi_gcl.lsp.tmp init_gcl.lsp.tmp raw_gcl raw_ansi_gcl
 .PRECIOUS: init_pre_gcl.lsp init_gcl.lsp init_ansi_gcl.lsp
--- gcl-2.6.12.orig/unixport/sys_init.lsp.in
+++ gcl-2.6.12/unixport/sys_init.lsp.in
@@ -59,8 +59,10 @@
 
 (in-package :compiler)
 (setq *cc* @LI-CC@
+      *default-prof-p* (> (length @LI-DFP@) 0)
       *ld* @LI-LD@
       *ld-libs* @LI-LD-LIBS@
+      *ld-libs* (concatenate 'string "-l" #+ansi-cl "ansi_" "gcl " *ld-libs*)
       *opt-three* @LI-OPT-THREE@
       *opt-two* @LI-OPT-TWO@
       *init-lsp* @LI-INIT-LSP@)