diff --git a/basis/compiler/cfg/builder/alien/alien.factor b/basis/compiler/cfg/builder/alien/alien.factor index 7bf45e959a..04ac2bf496 100644 --- a/basis/compiler/cfg/builder/alien/alien.factor +++ b/basis/compiler/cfg/builder/alien/alien.factor @@ -102,7 +102,7 @@ M: #alien-invoke emit-node [ { [ caller-parameters ] - [ ##prepare-var-args alien-invoke-dlsym ##alien-invoke ] + [ ##prepare-var-args alien-invoke-dlsym ##alien-invoke ] [ emit-stack-frame ] [ box-return* ] } cleave @@ -111,7 +111,7 @@ M: #alien-invoke emit-node M:: #alien-indirect emit-node ( node -- ) node [ D 0 ^^peek -1 ##inc-d ^^unbox-any-c-ptr :> src - [ caller-parameters src ##alien-indirect ] + [ caller-parameters src ##alien-indirect ] [ emit-stack-frame ] [ box-return* ] tri diff --git a/basis/compiler/cfg/builder/alien/boxing/boxing.factor b/basis/compiler/cfg/builder/alien/boxing/boxing.factor index 6f5f46b9c1..1992d7539a 100644 --- a/basis/compiler/cfg/builder/alien/boxing/boxing.factor +++ b/basis/compiler/cfg/builder/alien/boxing/boxing.factor @@ -105,13 +105,13 @@ M: struct-c-type flatten-parameter-type frob-struct flatten-c-type ; GENERIC: box ( vregs reps c-type -- dst ) M: c-type box - [ first ] [ drop ] [ [ boxer>> ] [ rep>> ] bi ] tri* ^^box ; + [ first ] [ drop ] [ [ boxer>> ] [ rep>> ] bi ] tri* ^^box ; M: long-long-type box - [ first2 ] [ drop ] [ boxer>> ] tri* ^^box-long-long ; + [ first2 ] [ drop ] [ boxer>> ] tri* ^^box-long-long ; M: struct-c-type box - '[ _ heap-size ^^allot-byte-array dup ^^unbox-byte-array ] 2dip + '[ _ heap-size ^^allot-byte-array dup ^^unbox-byte-array ] 2dip implode-struct ; GENERIC: box-parameter ( vregs reps c-type -- dst ) diff --git a/basis/compiler/cfg/finalization/finalization.factor b/basis/compiler/cfg/finalization/finalization.factor index 5440ba6eef..83bcc0b0b1 100644 --- a/basis/compiler/cfg/finalization/finalization.factor +++ b/basis/compiler/cfg/finalization/finalization.factor @@ -1,15 +1,17 @@ ! Copyright (C) 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: compiler.cfg.gc-checks compiler.cfg.representations -compiler.cfg.save-contexts compiler.cfg.ssa.destruction -compiler.cfg.build-stack-frame compiler.cfg.linear-scan -compiler.cfg.scheduling ; +USING: kernel compiler.cfg.gc-checks +compiler.cfg.representations compiler.cfg.save-contexts +compiler.cfg.ssa.destruction compiler.cfg.build-stack-frame +compiler.cfg.linear-scan compiler.cfg.scheduling +compiler.cfg.stacks.uninitialized ; IN: compiler.cfg.finalization : finalize-cfg ( cfg -- cfg' ) select-representations schedule-instructions insert-gc-checks + dup compute-uninitialized-sets insert-save-contexts destruct-ssa linear-scan diff --git a/basis/compiler/cfg/gc-checks/gc-checks.factor b/basis/compiler/cfg/gc-checks/gc-checks.factor index 60f81f77d9..50cd67567c 100644 --- a/basis/compiler/cfg/gc-checks/gc-checks.factor +++ b/basis/compiler/cfg/gc-checks/gc-checks.factor @@ -9,10 +9,7 @@ compiler.cfg.registers compiler.cfg.utilities compiler.cfg.comparisons compiler.cfg.instructions -compiler.cfg.predecessors -compiler.cfg.liveness -compiler.cfg.liveness.ssa -compiler.cfg.stacks.uninitialized ; +compiler.cfg.predecessors ; IN: compiler.cfg.gc-checks >instructions ; -: scrubbed ( uninitialized-locs -- scrub-d scrub-r ) - [ ds-loc? ] partition [ [ n>> ] map ] bi@ ; - -: ( uninitialized-locs gc-roots -- bb ) - [ ] 2dip - [ [ scrubbed ] dip ##gc-map ##call-gc ##branch ] V{ } make +: ( -- bb ) + + [ ##call-gc ##branch ] V{ } make >>instructions t >>unlikely? ; :: insert-guard ( body check bb -- ) @@ -69,7 +63,7 @@ IN: compiler.cfg.gc-checks check predecessors>> [ bb check update-successors ] each ; -: (insert-gc-check) ( uninitialized-locs gc-roots phis size bb -- ) +: (insert-gc-check) ( phis size bb -- ) [ [ ] 2dip ] dip insert-guard ; GENERIC: allocation-size* ( insn -- n ) @@ -85,35 +79,17 @@ M: ##box-displaced-alien allocation-size* drop 5 cells ; [ ##allocation? ] filter [ allocation-size* data-alignment get align ] map-sum ; -: gc-live-in ( bb -- vregs ) - [ live-in keys ] [ instructions>> [ ##phi? ] filter [ dst>> ] map ] bi - append ; - -: live-tagged ( bb -- vregs ) - gc-live-in [ rep-of tagged-rep? ] filter ; - : remove-phis ( bb -- phis ) [ [ ##phi? ] partition ] change-instructions drop ; : insert-gc-check ( bb -- ) - { - [ uninitialized-locs ] - [ live-tagged ] - [ remove-phis ] - [ allocation-size ] - [ ] - } cleave - (insert-gc-check) ; + [ remove-phis ] [ allocation-size ] [ ] tri (insert-gc-check) ; PRIVATE> : insert-gc-checks ( cfg -- cfg' ) dup blocks-with-gc [ - [ - needs-predecessors - dup compute-ssa-live-sets - dup compute-uninitialized-sets - ] dip + [ needs-predecessors ] dip [ insert-gc-check ] each cfg-changed ] unless-empty ; diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index b46a42d8d5..39d2ab81cd 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/basis/compiler/cfg/instructions/instructions.factor @@ -670,27 +670,28 @@ literal: size align offset ; INSN: ##box def: dst/tagged-rep use: src -literal: boxer rep ; +literal: boxer rep gc-map ; INSN: ##box-long-long def: dst/tagged-rep use: src1/int-rep src2/int-rep -literal: boxer ; +literal: boxer gc-map ; INSN: ##allot-byte-array def: dst/tagged-rep -literal: size ; +literal: size gc-map ; INSN: ##prepare-var-args ; INSN: ##alien-invoke -literal: symbols dll ; +literal: symbols dll gc-map ; INSN: ##cleanup literal: n ; INSN: ##alien-indirect -use: src/int-rep ; +use: src/int-rep +literal: gc-map ; INSN: ##alien-assembly literal: quot ; @@ -819,10 +820,7 @@ INSN: ##check-nursery-branch literal: size cc temp: temp1/int-rep temp2/int-rep ; -INSN: ##call-gc ; - -INSN: ##gc-map -literal: scrub-d scrub-r gc-roots ; +INSN: ##call-gc literal: gc-map ; ! Spills and reloads, inserted by register allocator TUPLE: spill-slot { n integer } ; @@ -860,6 +858,23 @@ UNION: conditional-branch-insn UNION: ##read ##slot ##slot-imm ##vm-field ##alien-global ; UNION: ##write ##set-slot ##set-slot-imm ##set-vm-field ; +! Instructions that contain subroutine calls to functions which +! allocate memory +UNION: gc-map-insn +##call-gc +##alien-invoke +##alien-indirect +##box +##box-long-long +##allot-byte-array ; + +M: gc-map-insn clone call-next-method [ clone ] change-gc-map ; + +! Each one has a gc-map slot +TUPLE: gc-map scrub-d scrub-r gc-roots ; + +: ( -- gc-map ) gc-map new ; + ! Instructions that clobber registers. They receive inputs and ! produce outputs in spill slots. UNION: hairy-clobber-insn diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor index e6d220a90c..cab4438ec9 100644 --- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor +++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor @@ -142,8 +142,10 @@ RENAMING: assign [ vreg>reg ] [ vreg>reg ] [ vreg>reg ] M: vreg-insn assign-registers-in-insn [ assign-insn-defs ] [ assign-insn-uses ] [ assign-insn-temps ] tri ; -M: ##gc-map assign-registers-in-insn - [ [ vreg>reg ] map ] change-gc-roots drop ; +M: gc-map-insn assign-registers-in-insn + [ [ assign-insn-defs ] [ assign-insn-uses ] [ assign-insn-temps ] tri ] + [ gc-map>> [ [ vreg>reg ] map ] change-gc-roots drop ] + bi ; M: insn assign-registers-in-insn drop ; diff --git a/basis/compiler/cfg/liveness/liveness.factor b/basis/compiler/cfg/liveness/liveness.factor index a10b48cc0c..1a5287355d 100644 --- a/basis/compiler/cfg/liveness/liveness.factor +++ b/basis/compiler/cfg/liveness/liveness.factor @@ -1,25 +1,40 @@ -! Copyright (C) 2009 Slava Pestov. +! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel accessors assocs sequences sets compiler.cfg.def-use compiler.cfg.dataflow-analysis -compiler.cfg.instructions ; +compiler.cfg.instructions compiler.cfg.registers +cpu.architecture ; IN: compiler.cfg.liveness ! See http://en.wikipedia.org/wiki/Liveness_analysis -! Do not run after SSA construction +! Do not run after SSA construction; compiler.cfg.liveness.ssa +! should be used instead. The transfer-liveness word is used +! by SSA liveness too, so it handles ##phi instructions. BACKWARD-ANALYSIS: live -GENERIC: insn-liveness ( live-set insn -- ) +GENERIC: visit-insn ( live-set insn -- live-set ) : kill-defs ( live-set insn -- live-set ) - defs-vreg [ over delete-at ] when* ; + defs-vreg [ over delete-at ] when* ; inline : gen-uses ( live-set insn -- live-set ) - dup ##phi? [ drop ] [ uses-vregs [ over conjoin ] each ] if ; + uses-vregs [ over conjoin ] each ; inline + +M: vreg-insn visit-insn [ kill-defs ] [ gen-uses ] bi ; + +: fill-gc-map ( live-set insn -- live-set ) + gc-map>> over keys [ rep-of tagged-rep? ] filter >>gc-roots drop ; + +M: gc-map-insn visit-insn + [ kill-defs ] [ fill-gc-map ] [ gen-uses ] tri ; + +M: ##phi visit-insn kill-defs ; + +M: insn visit-insn drop ; : transfer-liveness ( live-set instructions -- live-set' ) - [ clone ] [ ] bi* [ [ kill-defs ] [ gen-uses ] bi ] each ; + [ clone ] [ ] bi* [ visit-insn ] each ; : local-live-in ( instructions -- live-set ) [ H{ } ] dip transfer-liveness keys ; diff --git a/basis/compiler/cfg/stacks/uninitialized/uninitialized.factor b/basis/compiler/cfg/stacks/uninitialized/uninitialized.factor index 982e9b872c..7498cddf10 100644 --- a/basis/compiler/cfg/stacks/uninitialized/uninitialized.factor +++ b/basis/compiler/cfg/stacks/uninitialized/uninitialized.factor @@ -9,11 +9,17 @@ IN: compiler.cfg.stacks.uninitialized ! Consider the following sequence of instructions: ! ##inc-d 2 -! ##gc +! ... +! ##allot ! ##replace ... D 0 ! ##replace ... D 1 -! The GC check runs before stack locations 0 and 1 have been initialized, -! and it needs to zero them out so that GC doesn't try to trace them. +! The GC check runs before stack locations 0 and 1 have been +! initialized, and so the GC needs to scrub them so that they +! don't get traced. This is achieved by computing uninitialized +! locations with a dataflow analysis, and recording the +! information in GC maps. The scrub_contexts() method on +! vm/gc.cpp reads this information from GC maps and performs +! the scrubbing. > ds-loc handle-inc ; - M: ##inc-r visit-insn n>> rs-loc handle-inc ; ERROR: uninitialized-peek insn ; @@ -46,6 +51,12 @@ M: ##peek visit-insn visit-peek ; M: ##replace visit-insn visit-replace ; M: ##replace-imm visit-insn visit-replace ; +M: gc-map-insn visit-insn + gc-map>> + ds-loc get clone >>scrub-d + rs-loc get clone >>scrub-r + drop ; + M: insn visit-insn drop ; : prepare ( pair -- ) @@ -59,9 +70,6 @@ M: insn visit-insn drop ; : (join-sets) ( seq1 seq2 -- seq ) 2dup [ length ] bi@ max '[ _ 1 pad-tail ] bi@ [ bitand ] 2map ; -: (uninitialized-locs) ( seq quot -- seq' ) - [ [ drop 0 = ] selector [ each-index ] dip ] dip map ; inline - PRIVATE> FORWARD-ANALYSIS: uninitialized @@ -71,11 +79,3 @@ M: uninitialized-analysis transfer-set ( pair bb analysis -- pair' ) M: uninitialized-analysis join-sets ( sets analysis -- pair ) 2drop sift [ f ] [ [ ] [ [ (join-sets) ] 2map ] map-reduce ] if-empty ; - -: uninitialized-locs ( bb -- locs ) - uninitialized-in dup [ - first2 - [ [ ] (uninitialized-locs) ] - [ [ ] (uninitialized-locs) ] - bi* append f like - ] when ; diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index f33999ab89..68b01beed9 100755 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -258,7 +258,6 @@ CODEGEN: ##restore-context %restore-context CODEGEN: ##vm-field %vm-field CODEGEN: ##set-vm-field %set-vm-field CODEGEN: ##alien-global %alien-global -CODEGEN: ##gc-map %gc-map CODEGEN: ##call-gc %call-gc CODEGEN: ##spill %spill CODEGEN: ##reload %reload diff --git a/basis/compiler/codegen/fixup/fixup-tests.factor b/basis/compiler/codegen/fixup/fixup-tests.factor index fcb33e4937..f068861126 100644 --- a/basis/compiler/codegen/fixup/fixup-tests.factor +++ b/basis/compiler/codegen/fixup/fixup-tests.factor @@ -1,6 +1,7 @@ USING: namespaces byte-arrays make compiler.codegen.fixup bit-arrays accessors classes.struct tools.test kernel math -sequences alien.c-types specialized-arrays boxes ; +sequences alien.c-types specialized-arrays boxes +compiler.cfg.instructions system cpu.architecture ; SPECIALIZED-ARRAY: uint IN: compiler.codegen.fixup.tests @@ -10,19 +11,23 @@ STRUCT: gc-info { gc-root-count uint } { return-address-count uint } ; +SINGLETON: fake-cpu + +fake-cpu \ cpu set + +M: fake-cpu gc-root-offsets ; + [ ] [ [ init-fixup 50 % - { { } { } { } } set-next-gc-map - gc-map-here + T{ gc-map f B{ } B{ } V{ } } gc-map-here 50 % - { { 0 4 } { 1 } { 1 3 } } set-next-gc-map - gc-map-here + T{ gc-map f B{ 0 1 1 1 0 } B{ 1 0 } V{ 1 3 } } gc-map-here emit-gc-info ] B{ } make diff --git a/basis/compiler/codegen/fixup/fixup.factor b/basis/compiler/codegen/fixup/fixup.factor index f0730e91d8..b4ef317b67 100644 --- a/basis/compiler/codegen/fixup/fixup.factor +++ b/basis/compiler/codegen/fixup/fixup.factor @@ -4,8 +4,9 @@ USING: arrays bit-arrays byte-arrays byte-vectors generic assocs hashtables io.binary kernel kernel.private math namespaces make sequences words quotations strings alien.accessors alien.strings layouts system combinators math.bitwise math.order -combinators.smart accessors growable fry compiler.constants -memoize boxes ; +combinators.short-circuit combinators.smart accessors growable +fry memoize compiler.constants compiler.cfg.instructions +cpu.architecture ; IN: compiler.codegen.fixup ! Utilities @@ -149,30 +150,37 @@ MEMO: cached-string>symbol ( symbol -- obj ) string>symbol ; ! uint ! uint -SYMBOLS: next-gc-map return-addresses gc-maps ; +SYMBOLS: return-addresses gc-maps ; -: gc-map? ( triple -- ? ) +: gc-map-needed? ( gc-map -- ? ) ! If there are no stack locations to scrub and no GC roots, ! there's no point storing the GC map. - [ empty? not ] any? ; + dup [ + { + [ scrub-d>> empty? ] + [ scrub-r>> empty? ] + [ gc-roots>> empty? ] + } 1&& not + ] when ; -: gc-map-here ( -- ) - next-gc-map get box> dup gc-map? [ +: gc-map-here ( gc-map -- ) + dup gc-map-needed? [ gc-maps get push compiled-offset return-addresses get push ] [ drop ] if ; -: set-next-gc-map ( gc-map -- ) next-gc-map get >box ; +: emit-scrub ( seqs -- n ) + ! seqs is a sequence of sequences of 0/1 + dup [ length ] [ max ] map-reduce + [ '[ [ 0 = ] ?{ } map-as _ f pad-tail % ] each ] keep ; : integers>bits ( seq n -- bit-array ) [ '[ [ t ] dip _ set-nth ] each ] keep ; -: emit-bitmap ( seqs -- n ) +: emit-gc-roots ( seqs -- n ) ! seqs is a sequence of sequences of integers 0..n-1 - [ 0 ] [ - dup [ [ 0 ] [ supremum 1 + ] if-empty ] [ max ] map-reduce - [ '[ _ integers>bits % ] each ] keep - ] if-empty ; + dup [ [ 0 ] [ supremum 1 + ] if-empty ] [ max ] map-reduce + [ '[ _ integers>bits % ] each ] keep ; : emit-uint ( n -- ) building get push-uint ; @@ -182,9 +190,9 @@ SYMBOLS: next-gc-map return-addresses gc-maps ; return-addresses get empty? [ 0 emit-uint ] [ gc-maps get [ - [ [ first ] map emit-bitmap ] - [ [ second ] map emit-bitmap ] - [ [ third ] map emit-bitmap ] tri + [ [ scrub-d>> ] map emit-scrub ] + [ [ scrub-r>> ] map emit-scrub ] + [ [ gc-roots>> gc-root-offsets ] map emit-gc-roots ] tri ] ?{ } make underlying>> % return-addresses get [ emit-uint ] each [ emit-uint ] tri@ @@ -208,12 +216,10 @@ SYMBOLS: next-gc-map return-addresses gc-maps ; BV{ } clone relocation-table set V{ } clone binary-literal-table set V{ } clone return-addresses set - V{ } clone gc-maps set - next-gc-map set ; + V{ } clone gc-maps set ; : check-fixup ( seq -- ) - length data-alignment get mod 0 assert= - next-gc-map get occupied>> f assert= ; + length data-alignment get mod 0 assert= ; : with-fixup ( quot -- code ) '[ diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index 279947bd43..931dccece1 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -225,6 +225,8 @@ M: object vm-stack-space 0 ; ! %store-memory work HOOK: complex-addressing? cpu ( -- ? ) +HOOK: gc-root-offsets cpu ( seq -- seq' ) + HOOK: %load-immediate cpu ( reg val -- ) HOOK: %load-reference cpu ( reg obj -- ) HOOK: %load-float cpu ( reg val -- ) @@ -488,8 +490,7 @@ HOOK: %write-barrier-imm cpu ( src slot tag temp1 temp2 -- ) ! GC checks HOOK: %check-nursery-branch cpu ( label size cc temp1 temp2 -- ) -HOOK: %gc-map cpu ( scrub-d scrub-r gc-roots -- ) -HOOK: %call-gc cpu ( -- ) +HOOK: %call-gc cpu ( gc-map -- ) HOOK: %prologue cpu ( n -- ) HOOK: %epilogue cpu ( n -- ) @@ -595,11 +596,11 @@ HOOK: %local-allot cpu ( dst size align offset -- ) ! Call a function to convert a value into a tagged pointer, ! possibly allocating a bignum, float, or alien instance, ! which is then pushed on the data stack -HOOK: %box cpu ( dst src func rep -- ) +HOOK: %box cpu ( dst src func rep gc-map -- ) -HOOK: %box-long-long cpu ( dst src1 src2 func -- ) +HOOK: %box-long-long cpu ( dst src1 src2 func gc-map -- ) -HOOK: %allot-byte-array cpu ( dst size -- ) +HOOK: %allot-byte-array cpu ( dst size gc-map -- ) HOOK: %restore-context cpu ( temp1 temp2 -- ) @@ -609,13 +610,13 @@ HOOK: %prepare-var-args cpu ( -- ) M: object %prepare-var-args ; -HOOK: %alien-invoke cpu ( function library -- ) +HOOK: %alien-invoke cpu ( function library gc-map -- ) HOOK: %cleanup cpu ( n -- ) M: object %cleanup ( n -- ) drop ; -HOOK: %alien-indirect cpu ( src -- ) +HOOK: %alien-indirect cpu ( src gc-map -- ) HOOK: %load-reg-param cpu ( dst reg rep -- ) diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index 50835affb0..48cc88a4f8 100755 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -134,7 +134,7 @@ M: x86.32 %store-reg-param ( src reg rep -- ) EAX src tagged-rep %copy 4 save-vm-ptr 0 stack@ EAX MOV - func f %alien-invoke ; + func f f %alien-invoke ; M:: x86.32 %unbox ( dst src func rep -- ) src func call-unbox-func @@ -146,36 +146,37 @@ M:: x86.32 %unbox-long-long ( src out func -- ) EAX out int-rep %copy 4 stack@ EAX MOV 8 save-vm-ptr - func f %alien-invoke ; + func f f %alien-invoke ; -M:: x86.32 %box ( dst src func rep -- ) +M:: x86.32 %box ( dst src func rep gc-map -- ) rep rep-size save-vm-ptr src rep %store-return 0 stack@ rep %load-return - func f %alien-invoke + func f gc-map %alien-invoke dst EAX tagged-rep %copy ; -M:: x86.32 %box-long-long ( dst src1 src2 func -- ) +M:: x86.32 %box-long-long ( dst src1 src2 func gc-map -- ) 8 save-vm-ptr EAX src1 int-rep %copy 0 stack@ EAX int-rep %copy EAX src2 int-rep %copy 4 stack@ EAX int-rep %copy - func f %alien-invoke + func f gc-map %alien-invoke dst EAX tagged-rep %copy ; -M:: x86.32 %allot-byte-array ( dst size -- ) +M:: x86.32 %allot-byte-array ( dst size gc-map -- ) 4 save-vm-ptr 0 stack@ size MOV - "allot_byte_array" f %alien-invoke + "allot_byte_array" f gc-map %alien-invoke dst EAX tagged-rep %copy ; -M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ; +M: x86.32 %alien-invoke + [ 0 CALL rc-relative rel-dlsym ] dip gc-map-here ; M: x86.32 %begin-callback ( -- ) 0 save-vm-ptr 4 stack@ 0 MOV - "begin_callback" f %alien-invoke ; + "begin_callback" f f %alien-invoke ; M: x86.32 %alien-callback ( quot -- ) [ EAX ] dip %load-reference @@ -183,7 +184,7 @@ M: x86.32 %alien-callback ( quot -- ) M: x86.32 %end-callback ( -- ) 0 save-vm-ptr - "end_callback" f %alien-invoke ; + "end_callback" f f %alien-invoke ; GENERIC: float-function-param ( n dst src -- ) @@ -198,13 +199,13 @@ M:: register float-function-param ( n dst src -- ) M:: x86.32 %unary-float-function ( dst src func -- ) 0 dst src float-function-param - func "libm" load-library %alien-invoke + func "libm" load-library f %alien-invoke dst double-rep %load-return ; M:: x86.32 %binary-float-function ( dst src1 src2 func -- ) 0 dst src1 float-function-param 8 dst src2 float-function-param - func "libm" load-library %alien-invoke + func "libm" load-library f %alien-invoke dst double-rep %load-return ; : funny-large-struct-return? ( return abi -- ? ) diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index 65acdfbeb9..7a5e8a1af3 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -90,30 +90,29 @@ M:: x86.64 %store-reg-param ( src reg rep -- ) M:: x86.64 %unbox ( dst src func rep -- ) param-reg-0 src tagged-rep %copy param-reg-1 %mov-vm-ptr - func f %alien-invoke + func f f %alien-invoke dst rep %load-return ; -M:: x86.64 %box ( dst src func rep -- ) +M:: x86.64 %box ( dst src func rep gc-map -- ) 0 rep reg-class-of cdecl param-regs at nth src rep %copy rep int-rep? os windows? or param-reg-1 param-reg-0 ? %mov-vm-ptr - func f %alien-invoke + func f gc-map %alien-invoke dst int-rep %load-return ; -M:: x86.64 %allot-byte-array ( dst size -- ) +M:: x86.64 %allot-byte-array ( dst size gc-map -- ) param-reg-0 size MOV param-reg-1 %mov-vm-ptr - "allot_byte_array" f %alien-invoke + "allot_byte_array" f gc-map %alien-invoke dst int-rep %load-return ; M: x86.64 %alien-invoke - R11 0 MOV - rc-absolute-cell rel-dlsym - R11 CALL ; + [ R11 0 MOV rc-absolute-cell rel-dlsym R11 CALL ] dip + gc-map-here ; M: x86.64 %begin-callback ( -- ) param-reg-0 %mov-vm-ptr param-reg-1 0 MOV - "begin_callback" f %alien-invoke ; + "begin_callback" f f %alien-invoke ; M: x86.64 %alien-callback ( quot -- ) [ param-reg-0 ] dip %load-reference @@ -121,14 +120,14 @@ M: x86.64 %alien-callback ( quot -- ) M: x86.64 %end-callback ( -- ) param-reg-0 %mov-vm-ptr - "end_callback" f %alien-invoke ; + "end_callback" f f %alien-invoke ; : float-function-param ( i src -- ) [ float-regs cdecl param-regs at nth ] dip double-rep %copy ; M:: x86.64 %unary-float-function ( dst src func -- ) 0 src float-function-param - func "libm" load-library %alien-invoke + func "libm" load-library f %alien-invoke dst double-rep %load-return ; M:: x86.64 %binary-float-function ( dst src1 src2 func -- ) @@ -136,7 +135,7 @@ M:: x86.64 %binary-float-function ( dst src1 src2 func -- ) ! src2 is always a spill slot 0 src1 float-function-param 1 src2 float-function-param - func "libm" load-library %alien-invoke + func "libm" load-library f %alien-invoke dst double-rep %load-return ; M: x86.64 long-long-on-stack? f ; diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 05251818b5..d3adcf3960 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -480,13 +480,10 @@ M:: x86 %check-nursery-branch ( label size cc temp1 temp2 -- ) { cc/<= [ label JG ] } } case ; -: gc-root-offsets ( seq -- seq' ) +M: x86 gc-root-offsets [ n>> spill-offset special-offset cell + cell /i ] map f like ; -M: x86 %gc-map ( scrub-d scrub-r gc-roots -- ) - gc-root-offsets 3array set-next-gc-map ; - -M: x86 %call-gc +M: x86 %call-gc ( gc-map -- ) \ minor-gc %call gc-map-here ; @@ -612,8 +609,8 @@ M:: x86 %load-stack-param ( dst n rep -- ) M:: x86 %local-allot ( dst size align offset -- ) dst offset local-allot-offset special-offset stack@ LEA ; -M: x86 %alien-indirect ( src -- ) - ?spill-slot CALL ; +M: x86 %alien-indirect ( src gc-map -- ) + [ ?spill-slot CALL ] [ gc-map-here ] bi* ; M: x86 %loop-entry 16 alignment [ NOP ] times ; diff --git a/vm/collector.hpp b/vm/collector.hpp index 400e15b974..4a9eec5967 100644 --- a/vm/collector.hpp +++ b/vm/collector.hpp @@ -43,6 +43,8 @@ template struct gc_workhorse : no_fi object *fixup_data(object *obj) { + parent->check_data_pointer(obj); + if(!policy.should_copy_p(obj)) { policy.visited_object(obj); diff --git a/vm/contexts.cpp b/vm/contexts.cpp index 6247b879c6..8ec3363662 100644 --- a/vm/contexts.cpp +++ b/vm/contexts.cpp @@ -65,7 +65,12 @@ void context::scrub_stacks(gc_info *info, cell index) for(cell loc = 0; loc < info->scrub_d_count; loc++) { if(bitmap_p(bitmap,base + loc)) + { +#ifdef DEBUG_GC_MAPS + std::cout << "scrubbing datastack location " << loc << std::endl; +#endif ((cell *)datastack)[-loc] = 0; + } } } @@ -75,7 +80,12 @@ void context::scrub_stacks(gc_info *info, cell index) for(cell loc = 0; loc < info->scrub_r_count; loc++) { if(bitmap_p(bitmap,base + loc)) + { +#ifdef DEBUG_GC_MAPS + std::cout << "scrubbing retainstack location " << loc << std::endl; +#endif ((cell *)retainstack)[-loc] = 0; + } } } } diff --git a/vm/slot_visitor.hpp b/vm/slot_visitor.hpp index ba78b4b76c..4223f94a57 100644 --- a/vm/slot_visitor.hpp +++ b/vm/slot_visitor.hpp @@ -296,6 +296,9 @@ struct call_frame_slot_visitor { if(index == -1) return; +#ifdef DEBUG_GC_MAPS + std::cout << "call frame code block " << compiled << " with offset " << return_address << std::endl; +#endif u8 *bitmap = info->gc_info_bitmap(); cell base = info->spill_slot_base(index); cell *stack_pointer = (cell *)(parent->frame_successor(frame) + 1); @@ -303,7 +306,12 @@ struct call_frame_slot_visitor { for(cell spill_slot = 0; spill_slot < info->gc_root_count; spill_slot++) { if(bitmap_p(bitmap,base + spill_slot)) + { +#ifdef DEBUG_GC_MAPS + std::cout << "visiting spill slot " << spill_slot << std::endl; +#endif visitor->visit_handle(&stack_pointer[spill_slot]); + } } } };