1 USING: accessors arrays assocs bit-arrays classes.struct combinators
2 combinators.short-circuit compiler compiler.cfg.debugger
3 compiler.cfg.instructions compiler.cfg.stack-frame compiler.cfg.utilities
4 compiler.codegen.gc-maps compiler.units fry generic grouping kernel math
5 namespaces random sequences sequences.generalizations slots.syntax
6 tools.gc-decode tools.test vm vocabs words compiler.cfg.linearization ;
7 QUALIFIED: cpu.x86.features.private
8 QUALIFIED: crypto.aes.utils
12 IN: tools.gc-decode.tests
14 ! byte-array>bit-array
21 B{ 239 1 } byte-array>bit-array
24 { ?{ t t t t t t t t } } [ B{ 255 } byte-array>bit-array ] unit-test
30 \ decode-gc-maps word>gc-info scrub-bits
35 \ effects:<effect> decode-gc-maps empty?
39 \ + decode-gc-maps empty?
44 \ decode-gc-maps decode-gc-maps
47 : cfg>gc-maps ( cfg -- gc-maps )
48 cfg>insns [ gc-map-insn? ] filter [ gc-map>> ] map
49 [ gc-map-needed? ] filter ;
51 : tally-gc-maps ( gc-maps -- seq/f )
53 [ [ scrub-d>> length ] map supremum ]
54 [ [ scrub-r>> length ] map supremum ]
55 [ [ gc-root-offsets ] map largest-spill-slot ]
56 [ [ derived-root-offsets ] map [ keys ] map largest-spill-slot ]
58 } cleave 5 narray ] if-empty ;
60 ! Like word>gc-info but uses the compiler
61 : word>gc-info-expected ( word -- seq/f )
62 test-regs first dup stack-frame>> stack-frame
63 [ cfg>gc-maps tally-gc-maps ] with-variable ;
65 : same-gc-info? ( compiler-gc-info gc-info -- ? )
66 [ struct-slot-values = ]
67 [ [ not ] dip return-address-count>> 0 = and ] 2bi or ;
69 ! Do it also for a bunch of random words
70 : normal? ( word -- ? )
71 { [ generic? ] [ primitive? ] [ inline? ] [ no-compile? ] } 1|| not ;
74 all-words [ normal? ] filter 50 sample
75 [ [ word>gc-info-expected ] [ word>gc-info ] bi same-gc-info? ] reject
78 : base-pointer-groups-expected ( word -- seq )
79 test-regs first dup stack-frame>> stack-frame [
80 cfg>gc-maps [ derived-root-offsets { } like ] { } map-as
83 : base-pointer-groups-decoded ( word -- seq )
84 word>gc-info base-pointer-groups [
85 [ swap 2array ] map-index [ nip -1 = not ] assoc-filter
90 \ llvm.types:resolve-types
91 [ base-pointer-groups-expected ] [ base-pointer-groups-decoded ] bi =
96 \ llvm.types:resolve-types
97 [ word>gc-info-expected ] [ word>gc-info ] bi same-gc-info?
101 \ opencl:cl-queue-kernel
102 [ word>gc-info-expected ] [ word>gc-info ] bi same-gc-info?
106 \ crypto.aes.utils:bytes>words
107 [ word>gc-info-expected ] [ word>gc-info ] bi same-gc-info?
111 \ cpu.x86.features.private:(sse-version)
112 [ word>gc-info-expected ] [ word>gc-info ] bi same-gc-info?
115 ! Ensure deterministic gc map generation.
116 : recompile-word>gc-info ( word -- gc-info )
117 [ 1array compile ] keep word>gc-info ;
119 : deterministic-gc-info? ( word -- ? )
121 _ recompile-word>gc-info struct-slot-values
122 dup last 0 = [ drop f ] when
123 ] replicate all-equal? ;
127 \ opencl:cl-queue-kernel deterministic-gc-info?