suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

repair for make-object-finder with threads

Browse Source 
The `(cdr tc-ptr-offsets)` in the recrusrion was wrong, but use
`thread->objects` and `thread->stack-objects` to work more generally.

original commit: fd620699dc620d3d1a522800a7dfaff6cc0393bb
This commit is contained in:
Matthew Flatt 2019-06-26 12:01:31 -06:00
parent dd0fe4ac40
commit 57c997042e
1 changed files with 1 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
s/inspect.ss
View File

@ -2983,13 +2983,7 @@
(let ([th (lambda () (if (output-port? x) (construct-proc (port-output-buffer x) next-proc) next-proc))]) (let ([th (lambda () (if (output-port? x) (construct-proc (port-output-buffer x) next-proc) next-proc))])
(if (input-port? x) (construct-proc (port-input-buffer x) (th)) (th))))] (if (input-port? x) (construct-proc (port-input-buffer x) (th)) (th))))]
[(thread? x) [(thread? x)
(let ([tc ($object-ref 'scheme-object x (constant thread-tc-disp))]) (construct-proc (thread->objects x) (thread->stack-objects x) next-proc)]
(if (eqv? tc 0)
next-proc
(let f ([disp-list tc-ptr-offsets])
(if (null? disp-list)
next-proc
(construct-proc ($object-ref 'scheme-object tc (car disp-list)) (f (cdr tc-ptr-offsets)))))))]
[($tlc? x) (construct-proc ($tlc-ht x) ($tlc-keyval x) ($tlc-next x) next-proc)] [($tlc? x) (construct-proc ($tlc-ht x) ($tlc-keyval x) ($tlc-next x) next-proc)]
[else ($oops who "missing case for ~s" x)])]) [else ($oops who "missing case for ~s" x)])])
; check if this node is what we're looking for ; check if this node is what we're looking for