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@)