0 swap seek-past-padding { } ;
: layout-address ( rel-base tuple -- address )
- layout>> 15 unmask - neg ;
+ layout>> untag - neg ;
M: array-payload read-payload ( rel-base object -- payload )
nip read-array-payload ;
[ gc-map-needed? ] filter ;
: tally-gc-maps ( gc-maps -- seq/f )
- [ f ] [ {
- [ [ scrub-d>> length ] map supremum ]
- [ [ scrub-r>> length ] map supremum ]
- [ [ gc-root-offsets ] map largest-spill-slot ]
- [ [ derived-root-offsets ] map [ keys ] map largest-spill-slot ]
- [ length ]
- } cleave 5 narray ] if-empty ;
+ [ f ] [
+ {
+ [ [ scrub-d>> length ] map supremum ]
+ [ [ scrub-r>> length ] map supremum ]
+ [ [ gc-root-offsets ] map largest-spill-slot ]
+ [ [ derived-root-offsets ] map [ keys ] map largest-spill-slot ]
+ [ length ]
+ } cleave 5 narray
+ ] if-empty ;
! Like word>gc-info but uses the compiler
: word>gc-info-expected ( word -- seq/f )
[ [ word>gc-info-expected ] [ word>gc-info ] bi same-gc-info? ] reject
] unit-test
-
! Originally from llvm.types, but llvm moved to unmaintained
TYPEDEF: void* LLVMTypeRef
TYPEDEF: void* LLVMTypeHandleRef
! base-pointer-groups
{ t } [
- \ resolve-types
+\ resolve-types
[ base-pointer-groups-expected ] [ base-pointer-groups-decoded ] bi =
] unit-test
{ t } [
\ opencl:cl-queue-kernel deterministic-gc-info?
] unit-test
+
+
+
+! TODO: try on 32 bit \ feedback-format:
-! Copyright (C) 2013 Björn Lindqvist
+! Copyright (C) 2015 - 2016 Björn Lindqvist
! See http://factorcode.org/license.txt for BSD license
USING: accessors alien.strings assocs classes fry graphviz
-graphviz.attributes graphviz.notation math.bitwise sequences
-sets system tools.image-analyzer.references tools.image-analyzer.vm
-vocabs.parser ;
+graphviz.attributes graphviz.notation math.bitwise sequences sets
+system tools.image-analyzer.references tools.image-analyzer.utils
+tools.image-analyzer.vm vocabs.parser ;
IN: tools.image-analyzer.graphviz
FROM: arrays => 1array 2array ;
FROM: byte-arrays => >byte-array ;
: add-root-node ( graph ptr index -- graph )
over 15 mask 1 <= [ 2drop ] [
- [ swap 15 unmask add-edge ] keep <root-node> add
+ [ swap untag add-edge ] keep <root-node> add
] if ;
: add-root-nodes ( graph image -- graph )
-! Copyright (C) 2013 Björn Lindqvist
+! 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 math.order sequences sets slots.syntax
-tools.image-analyzer.relocations ;
+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 )
- 15 unmask '[ address>> _ = ] find nip ;
+ untag find-heap-node* ;
: load-relocations ( heap code-block -- seq )
relocation>> find-heap-node payload>> >byte-array byte-array>relocations
3drop { } ;
: collect-pointers ( heap heap-node -- seq )
- dup object>> pointers [ 1 <= ] reject [ 15 unmask ] map ;
+ dup object>> pointers [ 1 <= ] reject [ untag ] map ;
-USING: accessors alien alien.c-types alien.data arrays bit-arrays classes
-continuations destructors fry io io.streams.throwing kernel locals
-math namespaces sequences words ;
+USING: accessors alien alien.c-types alien.data arrays bit-arrays
+classes continuations destructors fry io io.streams.throwing kernel
+locals math math.bitwise namespaces sequences words ;
IN: tools.image-analyzer.utils
+: untag ( ptr -- ptr' )
+ 15 unmask ;
+
: class-heap-size ( instance -- n )
class-of heap-size ;