|
|
385abae |
Description: <short summary of the patch>
|
|
|
385abae |
TODO: Put a short summary on the line above and replace this paragraph
|
|
|
385abae |
with a longer explanation of this change. Complete the meta-information
|
|
|
385abae |
with other relevant fields (see below for details). To make it easier, the
|
|
|
385abae |
information below has been extracted from the changelog. Adjust it or drop
|
|
|
385abae |
it.
|
|
|
385abae |
.
|
|
|
385abae |
gcl (2.6.12-60) unstable; urgency=medium
|
|
|
385abae |
.
|
|
|
385abae |
* list_order.18
|
|
|
385abae |
Author: Camm Maguire <camm@debian.org>
|
|
|
385abae |
|
|
|
385abae |
---
|
|
|
385abae |
The information above should follow the Patch Tagging Guidelines, please
|
|
|
385abae |
checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
|
|
|
385abae |
are templates for supplementary fields that you might want to add:
|
|
|
385abae |
|
|
|
385abae |
Origin: <vendor|upstream|other>, <url of original patch>
|
|
|
385abae |
Bug: <url in upstream bugtracker>
|
|
|
385abae |
Bug-Debian: https://bugs.debian.org/<bugnumber>
|
|
|
385abae |
Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
|
|
|
385abae |
Forwarded: <no|not-needed|url proving that it has been forwarded>
|
|
|
385abae |
Reviewed-By: <name and email of someone who approved the patch>
|
|
|
385abae |
Last-Update: 2018-01-24
|
|
|
385abae |
|
|
|
385abae |
--- gcl-2.6.12.orig/lsp/gcl_mislib.lsp
|
|
|
385abae |
+++ gcl-2.6.12/lsp/gcl_mislib.lsp
|
|
|
385abae |
@@ -166,24 +166,45 @@
|
|
|
385abae |
(setq *load-path* nl))
|
|
|
385abae |
nil)
|
|
|
385abae |
|
|
|
385abae |
-(defun default-symtab nil (concatenate 'string *tmp-dir* "gcl_symtab"))
|
|
|
385abae |
-
|
|
|
385abae |
(defun gprof-output (symtab gmon)
|
|
|
385abae |
(with-open-file
|
|
|
385abae |
(s (format nil "|gprof -S '~a' '~a' '~a'" symtab (kcl-self) gmon))
|
|
|
385abae |
(copy-stream s *standard-output*)))
|
|
|
385abae |
|
|
|
385abae |
+(defun write-symtab (symtab start end &aux (*package* (find-package "KEYWORD")))
|
|
|
385abae |
+
|
|
|
385abae |
+ (with-open-file
|
|
|
385abae |
+ (s symtab :direction :output :if-exists :supersede)
|
|
|
385abae |
+
|
|
|
385abae |
+ (format s "~16,'0x T ~a~%" start "GCL_MONSTART")
|
|
|
385abae |
|
|
|
385abae |
-(defun gprof-start (&optional (start 0 start-p) (end 0 end-p) (symtab (default-symtab)))
|
|
|
385abae |
- (unless end-p
|
|
|
385abae |
- (multiple-value-bind
|
|
|
385abae |
- (s e)
|
|
|
385abae |
- (gprof-addresses)
|
|
|
385abae |
- (setq start (if start-p start s) end e)))
|
|
|
385abae |
- (when (monstartup start end)
|
|
|
385abae |
- (write-symtab symtab start end)))
|
|
|
385abae |
+ (dolist (p (list-all-packages))
|
|
|
385abae |
+ (do-symbols (x p)
|
|
|
385abae |
+ (when (and (eq (symbol-package x) p) (fboundp x))
|
|
|
385abae |
+ (let* ((y (symbol-function x))
|
|
|
385abae |
+ (y (if (and (consp y) (eq 'macro (car y))) (cdr y) y))
|
|
|
385abae |
+ (y (if (compiled-function-p y) (function-start y) 0)))
|
|
|
385abae |
+ (when (<= start y end)
|
|
|
385abae |
+ (format s "~16,'0x T ~s~%" y x))))))
|
|
|
385abae |
+
|
|
|
385abae |
+ (let ((string-register ""))
|
|
|
385abae |
+ (dotimes (i (ptable-alloc-length))
|
|
|
385abae |
+ (multiple-value-bind
|
|
|
385abae |
+ (x y) (ptable i string-register)
|
|
|
385abae |
+ (when (<= start x end)
|
|
|
385abae |
+ (format s "~16,'0x T ~a~%" x y)))))
|
|
|
385abae |
+
|
|
|
385abae |
+ (format s "~16,'0x T ~a~%" end "GCL_MONEND"))
|
|
|
385abae |
+
|
|
|
385abae |
+ symtab)
|
|
|
385abae |
+
|
|
|
385abae |
+(defun gprof-start (&optional (symtab "gcl_symtab") (adrs (gprof-addresses))
|
|
|
385abae |
+ &aux (start (car adrs))(end (cdr adrs)))
|
|
|
385abae |
+ (let ((symtab (write-symtab symtab start end)))
|
|
|
385abae |
+ (when (monstartup start end)
|
|
|
385abae |
+ symtab)))
|
|
|
385abae |
|
|
|
385abae |
-(defun gprof-quit (&optional (symtab (default-symtab)) &aux (gmon (mcleanup)))
|
|
|
385abae |
+(defun gprof-quit (&optional (symtab "gcl_symtab") &aux (gmon (mcleanup)))
|
|
|
385abae |
(when gmon
|
|
|
385abae |
(gprof-output symtab gmon)))
|
|
|
385abae |
|
|
|
385abae |
--- gcl-2.6.12.orig/o/fat_string.c
|
|
|
385abae |
+++ gcl-2.6.12/o/fat_string.c
|
|
|
385abae |
@@ -59,17 +59,16 @@ DEFUN_NEW("PROFILE",object,fSprofile,SI
|
|
|
385abae |
}
|
|
|
385abae |
|
|
|
385abae |
#endif
|
|
|
385abae |
-DEFUN_NEW("FUNCTION-START",object,fSfunction_start,SI
|
|
|
385abae |
- ,1,1,NONE,OO,OO,OO,OO,(object funobj),"")
|
|
|
385abae |
-{/* 1 args */
|
|
|
385abae |
- if(type_of(funobj)!=t_cfun
|
|
|
385abae |
- && type_of(funobj)!=t_sfun
|
|
|
385abae |
- && type_of(funobj)!=t_vfun
|
|
|
385abae |
- && type_of(funobj)!=t_afun
|
|
|
385abae |
- && type_of(funobj)!=t_gfun)
|
|
|
385abae |
- FEerror("not compiled function",0);
|
|
|
385abae |
- funobj=make_fixnum((long) (funobj->cf.cf_self));
|
|
|
385abae |
- RETURN1(funobj);
|
|
|
385abae |
+DEFUN_NEW("FUNCTION-START",object,fSfunction_start,SI,1,1,NONE,OO,OO,OO,OO,(object funobj),"") {
|
|
|
385abae |
+
|
|
|
385abae |
+ switch (type_of(funobj)) {
|
|
|
385abae |
+ case t_cfun:case t_sfun:case t_vfun:case t_afun:case t_gfun:case t_closure:case t_cclosure:
|
|
|
385abae |
+ return make_fixnum((long) (funobj->cf.cf_self));
|
|
|
385abae |
+ default:
|
|
|
385abae |
+ TYPE_ERROR(funobj,sLcompiled_function);
|
|
|
385abae |
+ return Cnil;
|
|
|
385abae |
+ }
|
|
|
385abae |
+
|
|
|
385abae |
}
|
|
|
385abae |
|
|
|
385abae |
/* begin fasl stuff*/
|
|
|
385abae |
--- gcl-2.6.12.orig/o/gprof.c
|
|
|
385abae |
+++ gcl-2.6.12/o/gprof.c
|
|
|
385abae |
@@ -12,13 +12,11 @@ DEFUN_NEW("MCLEANUP",object,fSmcleanup,S
|
|
|
385abae |
if (!gprof_on)
|
|
|
385abae |
return Cnil;
|
|
|
385abae |
|
|
|
385abae |
- massert(getcwd(FN1,sizeof(FN1)));
|
|
|
385abae |
- massert(!chdir(P_tmpdir));
|
|
|
385abae |
- _mcleanup();
|
|
|
385abae |
- massert(!chdir(FN1));
|
|
|
385abae |
+ massert((_mcleanup(),1));
|
|
|
385abae |
gprof_on=0;
|
|
|
385abae |
- massert(snprintf(FN1,sizeof(FN1),"%s/gmon.out",P_tmpdir)>0);
|
|
|
385abae |
- return make_simple_string(FN1);
|
|
|
385abae |
+
|
|
|
385abae |
+ return make_simple_string("gmon.out");
|
|
|
385abae |
+
|
|
|
385abae |
}
|
|
|
385abae |
|
|
|
385abae |
static inline int
|
|
|
385abae |
@@ -48,11 +46,10 @@ void
|
|
|
385abae |
gprof_cleanup(void) {
|
|
|
385abae |
|
|
|
385abae |
FFN(fSmcleanup)();
|
|
|
385abae |
- /*rename gmon?*/
|
|
|
385abae |
|
|
|
385abae |
}
|
|
|
385abae |
|
|
|
385abae |
-DEFUNM_NEW("GPROF-ADDRESSES",object,fSgprof_addresses,SI,0,0,NONE,OO,OO,OO,OO,(void),"") {
|
|
|
385abae |
+DEFUN_NEW("GPROF-ADDRESSES",object,fSgprof_addresses,SI,0,0,NONE,OO,OO,OO,OO,(void),"") {
|
|
|
385abae |
|
|
|
385abae |
void *min=heap_end,*max=data_start,*c;
|
|
|
385abae |
static void *mintext;
|
|
|
385abae |
@@ -77,10 +74,8 @@ DEFUNM_NEW("GPROF-ADDRESSES",object,fSgp
|
|
|
385abae |
mintext=data_start;
|
|
|
385abae |
|
|
|
385abae |
#ifdef GCL_GPROF
|
|
|
385abae |
- for (i=0;i
|
|
|
385abae |
+ for (i=0;i
|
|
|
385abae |
mintext=(void *)c_table.ptable[i].address
|
|
|
385abae |
- for (i=0;i
|
|
|
385abae |
- mintext=(void *)c_table.local_ptable[i].address
|
|
|
385abae |
#endif
|
|
|
385abae |
|
|
|
385abae |
}
|
|
|
385abae |
@@ -88,7 +83,7 @@ DEFUNM_NEW("GPROF-ADDRESSES",object,fSgp
|
|
|
385abae |
if (mintext
|
|
|
385abae |
min=mintext;
|
|
|
385abae |
|
|
|
385abae |
- RETURN2(make_fixnum((fixnum)min),make_fixnum((fixnum)max));
|
|
|
385abae |
+ return MMcons(make_fixnum((fixnum)min),make_fixnum((fixnum)max));
|
|
|
385abae |
|
|
|
385abae |
}
|
|
|
385abae |
|
|
|
385abae |
@@ -98,40 +93,14 @@ DEFUN_NEW("KCL-SELF",object,fSkcl_self,S
|
|
|
385abae |
|
|
|
385abae |
}
|
|
|
385abae |
|
|
|
385abae |
-DEFUN_NEW("WRITE-SYMTAB",object,fSwrite_symtab,SI,3,3,NONE,OO,II,OO,OO,
|
|
|
385abae |
- (object symtab,ufixnum start,ufixnum end),"") {
|
|
|
385abae |
-
|
|
|
385abae |
- struct package *p;
|
|
|
385abae |
- object l,s,f,*b,*be;
|
|
|
385abae |
- FILE *pp;
|
|
|
385abae |
- ufixnum i;
|
|
|
385abae |
-
|
|
|
385abae |
- coerce_to_filename(symtab,FN1);
|
|
|
385abae |
- pp=fopen(FN1,"w");
|
|
|
385abae |
- fprintf(pp,"%016lx T GCL_MONSTART\n",start);
|
|
|
385abae |
- for (p=pack_pointer;p;p=p->p_link)
|
|
|
385abae |
- for (i=0,b=p->p_internal,be=b+p->p_internal_size;b;
|
|
|
385abae |
- b=i ? NULL : p->p_external,be=b+p->p_external_size,i=1)
|
|
|
385abae |
- for (;b
|
|
|
385abae |
- for (l=*b;consp(l);l=l->c.c_cdr)
|
|
|
385abae |
- if ((f=(s=l->c.c_car)->s.s_gfdef)!=OBJNULL && s->s.s_hpack==(object)p)
|
|
|
385abae |
- switch(type_of(f)) {
|
|
|
385abae |
- case t_cfun:case t_sfun:case t_vfun:case t_afun:case t_gfun:
|
|
|
385abae |
- if ((ufixnum)f->cf.cf_self>=start && (ufixnum)f->cf.cf_self
|
|
|
385abae |
- fprintf(pp,"%016lx T %-.*s::%-.*s\n",
|
|
|
385abae |
- (ufixnum)f->cf.cf_self,
|
|
|
385abae |
- p->p_name->st.st_fillp,p->p_name->st.st_self,
|
|
|
385abae |
- s->st.st_fillp,s->st.st_self);
|
|
|
385abae |
- break;
|
|
|
385abae |
- }
|
|
|
385abae |
- fprintf(pp,"%016lx T GCL_MONEND\n",end);
|
|
|
385abae |
-
|
|
|
385abae |
- for (i=0;i
|
|
|
385abae |
- fprintf(pp,"%016lx T %s\n",c_table.ptable[i].address,c_table.ptable[i].string);
|
|
|
385abae |
- for (i=0;i
|
|
|
385abae |
- fprintf(pp,"%016lx t %s\n",c_table.local_ptable[i].address,c_table.local_ptable[i].string);
|
|
|
385abae |
- fclose(pp);
|
|
|
385abae |
-
|
|
|
385abae |
- return symtab;
|
|
|
385abae |
+DEFUN_NEW("PTABLE-ALLOC-LENGTH",object,fSptable_alloc_length,SI,0,0,NONE,OO,OO,OO,OO,(void),"") {
|
|
|
385abae |
+ return make_fixnum(c_table.alloc_length);
|
|
|
385abae |
+}
|
|
|
385abae |
|
|
|
385abae |
+DEFUNM_NEW("PTABLE",object,fSptable,SI,2,2,NONE,OI,OO,OO,OO,(ufixnum i,object s),"") {
|
|
|
385abae |
+ check_type_string(&s);
|
|
|
385abae |
+ massert(i
|
|
|
385abae |
+ s->st.st_self=(void *)c_table.ptable[i].string;
|
|
|
385abae |
+ s->st.st_fillp=s->st.st_dim=strlen(s->st.st_self);
|
|
|
385abae |
+ RETURN2(make_fixnum(c_table.ptable[i].address),s);
|
|
|
385abae |
}
|