Ticket #1356: 0001-Store-thread-names-in-the-trasce-buffer-not-threads.patch

File 0001-Store-thread-names-in-the-trasce-buffer-not-threads.patch, 3.5 KB (added by felix winkelmann, 6 years ago)

  • eval.scm 

    From ab06e8b06a0fd8479917a37cb1fa35449f72ef59 Mon Sep 17 00:00:00 2001
From: felix <felix@call-with-current-continuation.org>
Date: Fri, 27 Oct 2017 18:02:51 +0200
Subject: [PATCH] Store thread names in the trasce buffer, not threads.

This avoids keeping threads too long, but may fail when extracting the
backtrace of a specific thread from the thread-buffer (see also #1356)
---
 eval.scm    |    7 +++++--
 library.scm |    7 ++++---
 runtime.c   |    7 ++++++-
 support.scm |    4 +++-
 4 files changed, 18 insertions(+), 7 deletions(-)

diff --git a/eval.scm b/eval.scm
index 0426e64..1a2f68e 100644
    a b  
    8383(define compile-to-closure
    8484  (let ((reverse reverse))
    8585    (lambda (exp env se #!optional cntr evalenv static tl?)
     86      (define-syntax thread-name
     87        (syntax-rules ()
     88          ((_ t) (##sys#slot t 6))))
    8689
    8790      (define (find-id id se)           ; ignores macro bindings
    8891        (cond ((null? se) #f)
    … …  
    114117           "C_emit_eval_trace_info"
    115118           info
    116119           (##sys#make-structure 'frameinfo cntr e v)
    117            ##sys#current-thread) ) )
     120           (thread-name ##sys#current-thread) ) ) )
    118121     
    119122      (define (emit-syntax-trace-info tf info cntr)
    120123        (when tf
    … …  
    122125           "C_emit_syntax_trace_info"
    123126           info
    124127           cntr
    125            ##sys#current-thread) ) )
     128           (thread-name ##sys#current-thread) ) ) )
    126129       
    127130      (define (decorate p ll h cntr)
    128131        (eval-decorator p ll h cntr))

  • library.scm 

    diff --git a/library.scm b/library.scm
index d7c9387..9126c33 100644
    a b EOF 
    47074707             (c +trace-buffer-entry-slot-count+)
    47084708             (vec (##sys#make-vector (fx* c tbl) #f))
    47094709             (r (##core#inline "C_fetch_trace" start vec))
    4710              (n (if (fixnum? r) r (fx* c tbl))))
     4710             (n (if (fixnum? r) r (fx* c tbl)))
     4711             (tname (and thread (##sys#slot thread 6))))
    47114712        (let loop ((i 0))
    47124713          (if (fx>= i n)
    47134714              '()
    4714               (let ((t (##sys#slot vec (fx+ i 3)))) ; thread
    4715                 (if (or (not t) (not thread) (eq? thread t))
     4715              (let ((t (##sys#slot vec (fx+ i 3)))) ; thread name
     4716                (if (or (not t) (not thread) (eq? tname t))
    47164717                    (cons (vector
    47174718                           (extract (##sys#slot vec i)) ; raw
    47184719                           (##sys#slot vec (fx+ i 1))   ; cooked1

  • runtime.c 

    diff --git a/runtime.c b/runtime.c
index 9423993..3faa7de 100644
    a b static C_TLS int timezone; 
    259259# define SIGBUS                      0
    260260#endif
    261261
     262#define C_thread_name(x)   C_block_item((x), 6)
     263
    262264
    263265/* Type definitions: */
    264266
    … … done: 
    44084410
    44094411C_regparm void C_fcall C_trace(C_char *name)
    44104412{
     4413  C_word thread;
     4414
    44114415  if(show_trace) {
    44124416    C_fputs(name, C_stderr);
    44134417    C_fputc('\n', C_stderr);
    … … C_regparm void C_fcall C_trace(C_char *name) 
    44324436  trace_buffer_top->raw = name;
    44334437  trace_buffer_top->cooked1 = C_SCHEME_FALSE;
    44344438  trace_buffer_top->cooked2 = C_SCHEME_FALSE;
    4435   trace_buffer_top->thread = C_block_item(current_thread_symbol, 0);
     4439  thread = C_block_item(current_thread_symbol, 0);
     4440  trace_buffer_top->thread = C_thread_name(thread);
    44364441  ++trace_buffer_top;
    44374442}
    44384443

  • support.scm 

    diff --git a/support.scm b/support.scm
index 9d00b37..f29258c 100644
    a b  
    193193
    194194;; Move to C-platform?
    195195(define (emit-syntax-trace-info info cntr)
    196   (##core#inline "C_emit_syntax_trace_info" info cntr ##sys#current-thread) )
     196  (define (thread-name t) (##sys#slot t 6))
     197  (##core#inline "C_emit_syntax_trace_info" info cntr
     198                 (thread-name ##sys#current-thread)))
    197199
    198200(define (map-llist proc llist)
    199201  (let loop ([llist llist])