From 2475699736f0cf51500320c39bbfd9c6ea5c03dd Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Fri, 23 Apr 2010 20:20:06 -0400 Subject: [PATCH] compiler.cfg: more flexible addressing for ##slot and ##set-slot --- .../cfg/instructions/instructions.factor | 9 ++++-- .../cfg/intrinsics/slots/slots.factor | 29 ++++++++++--------- basis/compiler/tests/low-level-ir.factor | 4 +-- basis/cpu/architecture/architecture.factor | 13 ++++++--- basis/cpu/x86/x86.factor | 23 +++++++++------ 5 files changed, 47 insertions(+), 31 deletions(-) diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index 4023247b82..4960722eb2 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/basis/compiler/cfg/instructions/instructions.factor @@ -73,7 +73,8 @@ temp: temp/int-rep ; ! Slot access INSN: ##slot def: dst/tagged-rep -use: obj/tagged-rep slot/int-rep ; +use: obj/tagged-rep slot/int-rep +literal: scale tag ; INSN: ##slot-imm def: dst/tagged-rep @@ -81,7 +82,8 @@ use: obj/tagged-rep literal: slot tag ; INSN: ##set-slot -use: src/tagged-rep obj/tagged-rep slot/int-rep ; +use: src/tagged-rep obj/tagged-rep slot/int-rep +literal: scale tag ; INSN: ##set-slot-imm use: src/tagged-rep obj/tagged-rep @@ -568,11 +570,12 @@ temp: temp/int-rep ; INSN: ##write-barrier use: src/tagged-rep slot/int-rep +literal: scale tag temp: temp1/int-rep temp2/int-rep ; INSN: ##write-barrier-imm use: src/tagged-rep -literal: slot +literal: slot tag temp: temp1/int-rep temp2/int-rep ; INSN: ##alien-global diff --git a/basis/compiler/cfg/intrinsics/slots/slots.factor b/basis/compiler/cfg/intrinsics/slots/slots.factor index 1ec648b908..a3f532b4db 100644 --- a/basis/compiler/cfg/intrinsics/slots/slots.factor +++ b/basis/compiler/cfg/intrinsics/slots/slots.factor @@ -1,9 +1,10 @@ -! Copyright (C) 2008, 2009 Slava Pestov. +! Copyright (C) 2008, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: layouts namespaces kernel accessors sequences math classes.algebra classes.builtin locals combinators -cpu.architecture compiler.tree.propagation.info -compiler.cfg.stacks compiler.cfg.hats compiler.cfg.registers +combinators.short-circuit cpu.architecture +compiler.tree.propagation.info compiler.cfg.stacks +compiler.cfg.hats compiler.cfg.registers compiler.cfg.instructions compiler.cfg.utilities compiler.cfg.builder.blocks compiler.constants ; IN: compiler.cfg.intrinsics.slots @@ -13,12 +14,13 @@ IN: compiler.cfg.intrinsics.slots : value-tag ( info -- n ) class>> class-tag ; -: ^^tag-offset>slot ( slot tag -- vreg' ) - [ ^^offset>slot ] dip ^^sub-imm ; +: slot-indexing ( slot tag -- slot scale tag ) + complex-addressing? + [ [ cell log2 ] dip ] [ [ ^^offset>slot ] dip ^^sub-imm 0 0 ] if ; : (emit-slot) ( infos -- dst ) [ 2inputs ] [ first value-tag ] bi* - ^^tag-offset>slot ^^slot ; + slot-indexing ^^slot ; : (emit-slot-imm) ( infos -- dst ) ds-drop @@ -28,9 +30,9 @@ IN: compiler.cfg.intrinsics.slots : immediate-slot-offset? ( value-info -- ? ) literal>> { - { [ dup fixnum? ] [ tag-fixnum immediate-arithmetic? ] } - [ drop f ] - } cond ; + [ fixnum? ] + [ cell * immediate-arithmetic? ] + } 1&& ; : emit-slot ( node -- ) dup node-input-infos @@ -47,12 +49,13 @@ IN: compiler.cfg.intrinsics.slots :: (emit-set-slot) ( infos -- ) 3inputs :> ( src obj slot ) - slot infos second value-tag ^^tag-offset>slot :> slot + infos second value-tag :> tag - src obj slot ##set-slot + slot tag slot-indexing :> ( slot scale tag ) + src obj slot scale tag ##set-slot infos emit-write-barrier? - [ obj slot next-vreg next-vreg ##write-barrier ] when ; + [ obj slot scale tag next-vreg next-vreg ##write-barrier ] when ; :: (emit-set-slot-imm) ( infos -- ) ds-drop @@ -65,7 +68,7 @@ IN: compiler.cfg.intrinsics.slots src obj slot tag ##set-slot-imm infos emit-write-barrier? - [ obj slot tag slot-offset next-vreg next-vreg ##write-barrier-imm ] when ; + [ obj slot tag next-vreg next-vreg ##write-barrier-imm ] when ; : emit-set-slot ( node -- ) dup node-input-infos diff --git a/basis/compiler/tests/low-level-ir.factor b/basis/compiler/tests/low-level-ir.factor index 02f5c93352..7ce43e9524 100644 --- a/basis/compiler/tests/low-level-ir.factor +++ b/basis/compiler/tests/low-level-ir.factor @@ -46,7 +46,7 @@ IN: compiler.tests.low-level-ir V{ T{ ##load-tagged f 1 $[ 2 cell log2 shift array type-number - ] } T{ ##load-reference f 0 { t f t } } - T{ ##slot f 0 0 1 } + T{ ##slot f 0 0 1 0 0 } } compile-test-bb ] unit-test @@ -61,7 +61,7 @@ IN: compiler.tests.low-level-ir V{ T{ ##load-tagged f 1 $[ 2 cell log2 shift array type-number - ] } T{ ##load-reference f 0 { t f t } } - T{ ##set-slot f 0 0 1 } + T{ ##set-slot f 0 0 1 0 0 } } compile-test-bb dup first eq? ] unit-test diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index c25ade8312..ea98a199ed 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -203,6 +203,11 @@ M: ulonglong-2-rep scalar-rep-of drop ulonglong-scalar-rep ; ! Mapping from register class to machine registers HOOK: machine-registers cpu ( -- assoc ) +! Specifies if %slot, %set-slot and %write-barrier accept the +! 'scale' and 'tag' parameters, and if %load-memory and +! %store-memory work +HOOK: complex-addressing? cpu ( -- ? ) + HOOK: %load-immediate cpu ( reg val -- ) HOOK: %load-reference cpu ( reg obj -- ) HOOK: %load-double cpu ( reg val -- ) @@ -220,9 +225,9 @@ HOOK: %return cpu ( -- ) HOOK: %dispatch cpu ( src temp -- ) -HOOK: %slot cpu ( dst obj slot -- ) +HOOK: %slot cpu ( dst obj slot scale tag -- ) HOOK: %slot-imm cpu ( dst obj slot tag -- ) -HOOK: %set-slot cpu ( src obj slot -- ) +HOOK: %set-slot cpu ( src obj slot scale tag -- ) HOOK: %set-slot-imm cpu ( src obj slot tag -- ) HOOK: %string-nth cpu ( dst obj index temp -- ) @@ -440,8 +445,8 @@ HOOK: %set-vm-field cpu ( src offset -- ) : %context ( dst -- ) 0 %vm-field ; HOOK: %allot cpu ( dst size class temp -- ) -HOOK: %write-barrier cpu ( src slot temp1 temp2 -- ) -HOOK: %write-barrier-imm cpu ( src slot temp1 temp2 -- ) +HOOK: %write-barrier cpu ( src slot scale tag temp1 temp2 -- ) +HOOK: %write-barrier-imm cpu ( src slot tag temp1 temp2 -- ) ! GC checks HOOK: %check-nursery cpu ( label size temp1 temp2 -- ) diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 86c8c5b46e..01c11c6aec 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -65,6 +65,8 @@ HOOK: temp-reg cpu ( -- reg ) HOOK: pic-tail-reg cpu ( -- reg ) +M: x86 complex-addressing? t ; + M: x86 %load-immediate dup 0 = [ drop dup XOR ] [ MOV ] if ; M: x86 %load-reference @@ -110,12 +112,12 @@ M: x86 %return ( -- ) 0 RET ; : align-code ( n -- ) 0 % ; -:: (%slot-imm) ( obj slot tag -- op ) - obj slot tag slot-offset [+] ; inline +: (%slot) ( obj slot scale tag -- op ) neg ; inline +: (%slot-imm) ( obj slot tag -- op ) slot-offset [+] ; inline -M: x86 %slot ( dst obj slot -- ) [+] MOV ; +M: x86 %slot ( dst obj slot scale tag -- ) (%slot) MOV ; M: x86 %slot-imm ( dst obj slot tag -- ) (%slot-imm) MOV ; -M: x86 %set-slot ( src obj slot -- ) [+] swap MOV ; +M: x86 %set-slot ( src obj slot scale tag -- ) (%slot) swap MOV ; M: x86 %set-slot-imm ( src obj slot tag -- ) (%slot-imm) swap MOV ; :: two-operand ( dst src1 src2 rep -- dst src ) @@ -283,7 +285,7 @@ M:: x86 %box-displaced-alien ( dst displacement base temp base-class -- ) dst 1 alien@ base MOV dst 3 alien@ displacement MOV - temp base displacement byte-array-offset [++] MOV + temp base displacement byte-array-offset [++] LEA dst 4 alien@ temp MOV "end" resolve-label @@ -445,16 +447,19 @@ M:: x86 %allot ( dst size class nursery-ptr -- ) HOOK: %mark-card cpu ( card temp -- ) HOOK: %mark-deck cpu ( card temp -- ) -:: (%write-barrier) ( src slot temp1 temp2 -- ) - temp1 src slot [+] LEA +:: (%write-barrier) ( temp1 temp2 -- ) temp1 card-bits SHR temp1 temp2 %mark-card temp1 deck-bits card-bits - SHR temp1 temp2 %mark-deck ; -M: x86 %write-barrier ( src slot temp1 temp2 -- ) (%write-barrier) ; +M:: x86 %write-barrier ( src slot scale tag temp1 temp2 -- ) + temp1 src slot scale tag (%slot) LEA + temp1 temp2 (%write-barrier) ; -M: x86 %write-barrier-imm ( src slot temp1 temp2 -- ) (%write-barrier) ; +M:: x86 %write-barrier-imm ( src slot tag temp1 temp2 -- ) + temp1 src slot tag (%slot-imm) LEA + temp1 temp2 (%write-barrier) ; M:: x86 %check-nursery ( label size temp1 temp2 -- ) temp1 load-zone-offset