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

-/*      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

-    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=max;

+

+  if (!mintext) {

+

+    mintext=data_start;

+

+#ifdef GCL_GPROF

+    for (i=0;i

+      mintext=(void *)c_table.ptable[i].address

+    for (i=0;i

+      mintext=(void *)c_table.local_ptable[i].address

+#endif

+

+  }

+

+  if (mintext

+    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

+	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

+		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

+    fprintf(pp,"%016lx T %s\n",c_table.ptable[i].address,c_table.ptable[i].string);

+  for (i=0;i

+    fprintf(pp,"%016lx t %s\n",c_table.local_ptable[i].address,c_table.local_ptable[i].string);

+  fclose(pp);