54 lines
1.8 KiB
Factor
54 lines
1.8 KiB
Factor
! Copyright (C) 2015 Björn Lindqvist
|
|
! See http://factorcode.org/license.txt for BSD license
|
|
!
|
|
! Tools to follow references in the loaded image.
|
|
USING: accessors arrays byte-arrays fry kernel layouts math
|
|
math.bitwise sequences slots.syntax tools.image-analyzer.relocations
|
|
tools.image-analyzer.utils ;
|
|
IN: tools.image-analyzer.references
|
|
QUALIFIED-WITH: tools.image-analyzer.vm vm
|
|
|
|
! Edges in the heap
|
|
GENERIC: pointers ( heap heap-node struct -- seq )
|
|
|
|
: find-heap-node* ( heap untagged-ptr -- node )
|
|
'[ address>> _ = ] find nip ;
|
|
|
|
: find-heap-node ( heap ptr -- node )
|
|
untag find-heap-node* ;
|
|
|
|
: load-relocations ( heap code-block -- seq )
|
|
relocation>> find-heap-node payload>> >byte-array byte-array>relocations
|
|
[ interesting-relocation? ] filter ;
|
|
|
|
: relocation>pointer ( heap-node relocation -- ptr )
|
|
[ [ address>> ] [ payload>> ] bi ] dip decode-relocation ;
|
|
|
|
: relocation-pointers ( heap heap-node code-block -- seq )
|
|
swapd load-relocations [ relocation>pointer ] with map ;
|
|
|
|
: filter-data-pointers ( seq -- seq' )
|
|
[ 15 mask 1 <= ] reject ;
|
|
|
|
M: vm:array pointers ( heap heap-node struct -- seq )
|
|
drop nip payload>> filter-data-pointers ;
|
|
|
|
M: vm:code-block pointers ( heap heap-node struct -- seq )
|
|
[ relocation-pointers ] [ slots{ owner parameters relocation } ] bi
|
|
append ;
|
|
|
|
M: vm:quotation pointers ( heap heap-node struct -- seq )
|
|
2nip [ array>> ] [ entry_point>> 4 cell * - ] bi 2array ;
|
|
|
|
M: vm:word pointers ( heap heap-node struct -- seq )
|
|
2nip [
|
|
slots{ def name pic_def pic_tail_def props subprimitive vocabulary }
|
|
filter-data-pointers
|
|
] [ entry_point>> 4 cell * - ] bi suffix ;
|
|
|
|
M: object pointers ( heap heap-node struct -- seq )
|
|
3drop { } ;
|
|
|
|
: collect-pointers ( heap heap-node -- seq )
|
|
dup object>> pointers [ 1 <= ] reject [ untag ] map ;
|