From: Camm Maguire Date: Sun, 13 Nov 2022 12:55:14 +0000 (+0000) Subject: X-Git-Tag: archive/raspbian/2.7.1-4+rpi1~2^2^2~74 X-Git-Url: https://dgit.raspbian.org/?a=commitdiff_plain;h=a66ccd0cd8dd6eb8ffd64453017b77b9a64aa3d8;p=gcl27.git 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 Gbp-Pq: Name list_order.17 --- diff --git a/cmpnew/gcl_cmpmain.lsp b/cmpnew/gcl_cmpmain.lsp index 4552326..5c41c2c 100755 --- a/cmpnew/gcl_cmpmain.lsp +++ b/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* diff --git a/cmpnew/gcl_cmpwt.lsp b/cmpnew/gcl_cmpwt.lsp index 660a0f8..a852c3e 100755 --- a/cmpnew/gcl_cmpwt.lsp +++ b/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) diff --git a/configure b/configure index 01e0bd8..0b8487d 100755 --- a/configure +++ b/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 diff --git a/configure.in b/configure.in index 0d52260..e98511c 100644 --- a/configure.in +++ b/configure.in @@ -342,22 +342,25 @@ AC_ARG_ENABLE([gprof],[ --enable-gprof builds gcl with -pg in CFLAGS to enable 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]) diff --git a/h/gclincl.h.in b/h/gclincl.h.in index 75fa9fe..82257ed 100644 --- a/h/gclincl.h.in +++ b/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 */ diff --git a/h/lu.h b/h/lu.h index e075c7a..93aed56 100644 --- a/h/lu.h +++ b/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; }; diff --git a/h/protoize.h b/h/protoize.h index 8845594..ad8bdb5 100644 --- a/h/protoize.h +++ b/h/protoize.h @@ -1788,10 +1788,8 @@ int sigprocmask ( int how, const sigset_t *set, sigset_t *oldset ); 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); diff --git a/h/ptable.h b/h/ptable.h index 1472866..ba0b4fb 100755 --- a/h/ptable.h +++ b/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; }; diff --git a/lsp/gcl_mislib.lsp b/lsp/gcl_mislib.lsp index 7a0cd9d..fb6cd04 100755 --- a/lsp/gcl_mislib.lsp +++ b/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))) + + + diff --git a/o/alloc.c b/o/alloc.c index a046f99..fc2b481 100644 --- a/o/alloc.c +++ b/o/alloc.c @@ -1177,24 +1177,6 @@ init_tm(enum type t, char *name, int elsize, int nelts, int sgc,int distinct) { 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 (stextend || s>textstart)) - textstart=s; - - textpage=2*(textend-textstart)/PAGESIZE; - -} -#endif - object malloc_list=Cnil; #include @@ -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>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; } diff --git a/o/cmpaux.c b/o/cmpaux.c index 5d555d0..a6ec476 100755 --- a/o/cmpaux.c +++ b/o/cmpaux.c @@ -393,6 +393,15 @@ call_init(int init_address, object memory, object fasl_vec, FUNC fptr) */ +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 char *file) { 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); diff --git a/o/fasldlsym.c b/o/fasldlsym.c index dda1dcb..7967e4b 100755 --- a/o/fasldlsym.c +++ b/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); diff --git a/o/gprof.c b/o/gprof.c new file mode 100644 index 0000000..a0f4f8a --- /dev/null +++ b/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;itm_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_startcfd.cfd_start : min; + max=(void *)x->cfd.cfd_start+x->cfd.cfd_size>max ? x->cfd.cfd_start+x->cfd.cfd_size : max; + } + + if (maxp_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 (;bc.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_selfcf.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;icfd.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 diff --git a/o/sfaslbfd.c b/o/sfaslbfd.c index 296fe4c..9115794 100644 --- a/o/sfaslbfd.c +++ b/o/sfaslbfd.c @@ -269,9 +269,7 @@ fasload(object faslfile) { curr_size=(unsigned long)current; max_align=1<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); diff --git a/o/sfaslcoff.c b/o/sfaslcoff.c index 6f7c6b7..e8e534e 100644 --- a/o/sfaslcoff.c +++ b/o/sfaslcoff.c @@ -207,10 +207,8 @@ load_memory(struct scnhdr *sec1,struct scnhdr *sece,void *st) { 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;secn_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;symn_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)); diff --git a/o/sfaslelf.c b/o/sfaslelf.c index f649fa4..d2b623f 100755 --- a/o/sfaslelf.c +++ b/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 *v1,ul **got,ul **gote) { 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 *syme,const char *st1,Sym *d1,Sym *de,con for (sym=sym1;symcfd.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;symn_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;symn_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)); diff --git a/o/sfaslmacosx.c b/o/sfaslmacosx.c index 4a2ce7f..92a15fb 100644 --- a/o/sfaslmacosx.c +++ b/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); diff --git a/o/unixfasl.c b/o/unixfasl.c index 592ba3a..d092706 100755 --- a/o/unixfasl.c +++ b/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_int,SI,2,2,NONE,II,OO,OO,OO,(object fas 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;} diff --git a/unixport/makefile b/unixport/makefile index 7e4757c..f4a2998 100644 --- a/unixport/makefile +++ b/unixport/makefile @@ -69,28 +69,26 @@ $(LSPDIR)/auto_new.lsp: $(LSPDIR)/auto.lsp [ "$(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 diff --git a/unixport/sys_init.lsp.in b/unixport/sys_init.lsp.in index 1390632..0d38476 100644 --- a/unixport/sys_init.lsp.in +++ b/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@)