From b010cd311687ed5a462821c00a436efa146426dd Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Sat, 30 May 2009 10:09:44 -0300 Subject: [PATCH 01/18] irc.logbot: Small refactoring --- extra/irc/logbot/logbot.factor | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/extra/irc/logbot/logbot.factor b/extra/irc/logbot/logbot.factor index ff8085a9a9..976a3832f4 100644 --- a/extra/irc/logbot/logbot.factor +++ b/extra/irc/logbot/logbot.factor @@ -21,15 +21,17 @@ SYMBOL: current-stream : timestamp-path ( timestamp -- path ) timestamp>ymd ".log" append log-directory prepend-path ; +: update-current-stream ( timestamp -- ) + current-stream get [ dispose ] when* + [ day-of-year current-day set ] + [ timestamp-path latin1 ] bi + current-stream set ; + +: same-day? ( timestamp -- ? ) day-of-year current-day get = ; + : timestamp>stream ( timestamp -- stream ) - dup day-of-year current-day get = [ - drop - ] [ - current-stream get [ dispose ] when* - [ day-of-year current-day set ] - [ timestamp-path latin1 ] bi - current-stream set - ] if current-stream get ; + dup same-day? [ drop ] [ update-current-stream ] if + current-stream get ; : log-message ( string timestamp -- ) [ add-timestamp ] [ timestamp>stream ] bi From 4c04ace2789c2849769d2b16bab81f9c816145ae Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Tue, 2 Jun 2009 09:09:27 -0300 Subject: [PATCH 02/18] irc.client: Temporary possible fix to the bug reported by anyhoo --- extra/irc/client/internals/internals.factor | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/extra/irc/client/internals/internals.factor b/extra/irc/client/internals/internals.factor index 1b4a4550dc..b065dfe2f0 100644 --- a/extra/irc/client/internals/internals.factor +++ b/extra/irc/client/internals/internals.factor @@ -75,8 +75,9 @@ M: to-many-chats message-forwards sender>> participant-chats ; GENERIC: process-message ( irc-message -- ) M: object process-message drop ; M: ping process-message trailing>> /PONG ; -M: join process-message [ sender>> ] [ chat> ] bi join-participant ; -M: part process-message [ sender>> ] [ chat> ] bi part-participant ; +! FIXME: it shouldn't be checking for the presence of chat here... +M: join process-message [ sender>> ] [ chat> ] bi [ join-participant ] [ drop ] if* ; +M: part process-message [ sender>> ] [ chat> ] bi [ part-participant ] [ drop ] if* ; M: quit process-message sender>> quit-participant ; M: nick process-message [ trailing>> ] [ sender>> ] bi rename-participant* ; M: rpl-nickname-in-use process-message name>> "_" append /NICK ; From 8bf389e9b55cf13d25b7aeff87fbd8c7edb1f513 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Wed, 22 Jul 2009 20:48:38 -0300 Subject: [PATCH 03/18] basis.xml: Add test to check that pull-event doesn't raise an exception when called on a pull-xml object --- basis/xml/tests/test.factor | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/basis/xml/tests/test.factor b/basis/xml/tests/test.factor index 74ba931c79..e371c3aab5 100644 --- a/basis/xml/tests/test.factor +++ b/basis/xml/tests/test.factor @@ -73,3 +73,7 @@ SYMBOL: xml-file [ T{ xml-chunk f V{ "hello" } } ] [ "hello" string>xml-chunk ] unit-test [ "1.1" ] [ "" string>xml prolog>> version>> ] unit-test [ "ß" ] [ "ß" read-xml children>string ] unit-test + +! tests +! this tests just checks that pull-event doesn't raise an exception +[ ] [ "vocab:xml/tests/test.xml" binary [ pull-event drop ] with-file-reader ] unit-test \ No newline at end of file From d8434ceed2c779dc463e98d02529ba9dcc3dd458 Mon Sep 17 00:00:00 2001 From: Bruno Deferrari Date: Wed, 22 Jul 2009 20:49:57 -0300 Subject: [PATCH 04/18] basis.xml: A fix for (calls init-parser so that the spot variable is binded) --- basis/xml/xml.factor | 1 + 1 file changed, 1 insertion(+) diff --git a/basis/xml/xml.factor b/basis/xml/xml.factor index cca1b5e2e0..a1d734f291 100755 --- a/basis/xml/xml.factor +++ b/basis/xml/xml.factor @@ -110,6 +110,7 @@ PRIVATE> TUPLE: pull-xml scope ; : ( -- pull-xml ) [ + init-parser input-stream [ ] change ! bring var in this scope init-xml text-now? on ] H{ } make-assoc From 5f4df2d661060a0b8d7c901f9cea9c5303ac5e25 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Wed, 29 Jul 2009 00:29:43 +0200 Subject: [PATCH 05/18] FUEL: Bug fix: parenthesis matching when ( belongs to a word. --- misc/fuel/fuel-syntax.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/misc/fuel/fuel-syntax.el b/misc/fuel/fuel-syntax.el index a4559c5c5c..73d6781313 100644 --- a/misc/fuel/fuel-syntax.el +++ b/misc/fuel/fuel-syntax.el @@ -281,7 +281,7 @@ ("\\_<\\(}\\)\\_>" (1 "){")) ;; Parenthesis: ("\\_<\\((\\)\\_>" (1 "()")) - ("\\_" (1 "()")) + ("\\_<\\w*\\((\\)\\_>" (1 "()")) ("\\_<\\()\\)\\_>" (1 ")(")) ("\\_<(\\((\\)\\_>" (1 "()")) ("\\_<\\()\\))\\_>" (1 ")(")) From cb36a40dc4fccfd9bf73c789efc9103b83bed0a4 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 29 Jul 2009 07:04:52 -0500 Subject: [PATCH 06/18] compiler.cfg.linear-scan: more test fixes --- basis/compiler/cfg/linear-scan/linear-scan-tests.factor | 5 ----- basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor | 2 +- 2 files changed, 1 insertion(+), 6 deletions(-) diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor index 1673b1b365..f38946f8e2 100644 --- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor +++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor @@ -1761,11 +1761,6 @@ test-diamond [ ] [ { 1 2 } test-linear-scan-on-cfg ] unit-test -[ ] [ - 1 get instructions>> first regs>> V int-regs 0 swap at - 2 get instructions>> first regs>> V int-regs 1 swap at assert= -] unit-test - ! Not until splitting is finished ! [ _copy ] [ 3 get instructions>> second class ] unit-test diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor b/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor index b1b44cde44..ee3595dd06 100644 --- a/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor +++ b/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor @@ -1,6 +1,6 @@ IN: compiler.cfg.linear-scan.resolve.tests USING: compiler.cfg.linear-scan.resolve tools.test kernel namespaces -compiler.cfg.instructions cpu.architecture make +compiler.cfg.instructions cpu.architecture make sequences compiler.cfg.linear-scan.allocation.state ; [ From 91e5c05f40a52dfacc5757c5c21c5416cb816973 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 29 Jul 2009 19:28:58 -0500 Subject: [PATCH 07/18] debug.cpp: fep now prints return addresses in call stack dump --- vm/debug.cpp | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/vm/debug.cpp b/vm/debug.cpp index 22e92809a7..5f78afb9db 100755 --- a/vm/debug.cpp +++ b/vm/debug.cpp @@ -173,10 +173,15 @@ void print_stack_frame(stack_frame *frame) print_string("\n"); print_obj(frame_scan(frame)); print_string("\n"); + print_string("word/quot addr: "); print_cell_hex((cell)frame_executing(frame)); - print_string(" "); + print_string("\n"); + print_string("word/quot xt: "); print_cell_hex((cell)frame->xt); print_string("\n"); + print_string("return address: "); + print_cell_hex((cell)FRAME_RETURN_ADDRESS(frame)); + print_string("\n"); } void print_callstack() From 73862a9a03940999eac37d6374c74011ccc52e3d Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 29 Jul 2009 21:44:08 -0500 Subject: [PATCH 08/18] cpu.x86.assembler: move operands to operands sub-vocabulary, clean up small-reg-* code in compiler backend --- basis/cpu/x86/32/32.factor | 13 +- basis/cpu/x86/64/64.factor | 13 +- basis/cpu/x86/64/unix/unix.factor | 8 +- .../cpu/x86/assembler/assembler-tests.factor | 3 +- basis/cpu/x86/assembler/assembler.factor | 98 +-------------- basis/cpu/x86/assembler/authors.txt | 1 + .../x86/assembler/operands/operands.factor | 118 ++++++++++++++++++ basis/cpu/x86/assembler/syntax/syntax.factor | 27 ++-- basis/cpu/x86/x86.factor | 87 ++----------- 9 files changed, 170 insertions(+), 198 deletions(-) create mode 100644 basis/cpu/x86/assembler/operands/operands.factor diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index 727131aa25..76699c1306 100755 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -1,13 +1,12 @@ ! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: locals alien.c-types alien.syntax arrays kernel fry -math namespaces sequences system layouts io vocabs.loader -accessors init combinators command-line cpu.x86.assembler -cpu.x86 cpu.architecture make compiler compiler.units +USING: locals alien.c-types alien.syntax arrays kernel fry math +namespaces sequences system layouts io vocabs.loader accessors init +combinators command-line make compiler compiler.units compiler.constants compiler.alien compiler.codegen -compiler.codegen.fixup compiler.cfg.instructions -compiler.cfg.builder compiler.cfg.intrinsics -compiler.cfg.stack-frame ; +compiler.codegen.fixup compiler.cfg.instructions compiler.cfg.builder +compiler.cfg.intrinsics compiler.cfg.stack-frame cpu.x86.assembler +cpu.x86.assembler.operands cpu.x86 cpu.architecture ; IN: cpu.x86.32 ! We implement the FFI for Linux, OS X and Windows all at once. diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index 8eb04eb2b5..f837c7de73 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -1,12 +1,11 @@ ! Copyright (C) 2005, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays kernel math namespaces make sequences -system layouts alien alien.c-types alien.accessors alien.structs -slots splitting assocs combinators locals cpu.x86.assembler -cpu.x86 cpu.architecture compiler.constants -compiler.codegen compiler.codegen.fixup -compiler.cfg.instructions compiler.cfg.builder -compiler.cfg.intrinsics compiler.cfg.stack-frame ; +USING: accessors arrays kernel math namespaces make sequences system +layouts alien alien.c-types alien.accessors alien.structs slots +splitting assocs combinators locals compiler.constants +compiler.codegen compiler.codegen.fixup compiler.cfg.instructions +compiler.cfg.builder compiler.cfg.intrinsics compiler.cfg.stack-frame +cpu.x86.assembler cpu.x86.assembler.operands cpu.x86 cpu.architecture ; IN: cpu.x86.64 M: x86.64 machine-registers diff --git a/basis/cpu/x86/64/unix/unix.factor b/basis/cpu/x86/64/unix/unix.factor index eea960d03d..7ab25b6d3f 100644 --- a/basis/cpu/x86/64/unix/unix.factor +++ b/basis/cpu/x86/64/unix/unix.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays sequences math splitting make assocs -kernel layouts system alien.c-types alien.structs -cpu.architecture cpu.x86.assembler cpu.x86 -compiler.codegen compiler.cfg.registers ; +USING: accessors arrays sequences math splitting make assocs kernel +layouts system alien.c-types alien.structs cpu.architecture +cpu.x86.assembler cpu.x86.assembler.operands cpu.x86 compiler.codegen +compiler.cfg.registers ; IN: cpu.x86.64.unix M: int-regs param-regs drop { RDI RSI RDX RCX R8 R9 } ; diff --git a/basis/cpu/x86/assembler/assembler-tests.factor b/basis/cpu/x86/assembler/assembler-tests.factor index 66adee6bf6..962309c67e 100644 --- a/basis/cpu/x86/assembler/assembler-tests.factor +++ b/basis/cpu/x86/assembler/assembler-tests.factor @@ -1,4 +1,5 @@ -USING: cpu.x86.assembler kernel tools.test namespaces make ; +USING: cpu.x86.assembler cpu.x86.operands +kernel tools.test namespaces make ; IN: cpu.x86.assembler.tests [ { HEX: 49 HEX: 89 HEX: 04 HEX: 24 } ] [ [ R12 [] RAX MOV ] { } make ] unit-test diff --git a/basis/cpu/x86/assembler/assembler.factor b/basis/cpu/x86/assembler/assembler.factor index e91ebdcb1a..f15704a015 100644 --- a/basis/cpu/x86/assembler/assembler.factor +++ b/basis/cpu/x86/assembler/assembler.factor @@ -1,89 +1,16 @@ -! Copyright (C) 2005, 2009 Slava Pestov. +! Copyright (C) 2005, 2009 Slava Pestov, Joe Groff. ! See http://factorcode.org/license.txt for BSD license. USING: arrays io.binary kernel combinators kernel.private math namespaces make sequences words system layouts math.order accessors -cpu.x86.assembler.syntax ; +cpu.x86.assembler.operands cpu.x86.assembler.operands.private ; QUALIFIED: sequences IN: cpu.x86.assembler ! A postfix assembler for x86-32 and x86-64. -! In 32-bit mode, { 1234 } is absolute indirect addressing. -! In 64-bit mode, { 1234 } is RIP-relative. -! Beware! - -! Register operands -- eg, ECX -REGISTERS: 8 AL CL DL BL SPL BPL SIL DIL R8B R9B R10B R11B R12B R13B R14B R15B ; - -ALIAS: AH SPL -ALIAS: CH BPL -ALIAS: DH SIL -ALIAS: BH DIL - -REGISTERS: 16 AX CX DX BX SP BP SI DI R8W R9W R10W R11W R12W R13W R14W R15W ; - -REGISTERS: 32 EAX ECX EDX EBX ESP EBP ESI EDI R8D R9D R10D R11D R12D R13D R14D R15D ; - -REGISTERS: 64 -RAX RCX RDX RBX RSP RBP RSI RDI R8 R9 R10 R11 R12 R13 R14 R15 ; - -REGISTERS: 128 -XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 -XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15 ; - -TUPLE: byte value ; - -C: byte - ; - -! Addressing modes -TUPLE: indirect base index scale displacement ; - -M: indirect extended? base>> extended? ; - -: canonicalize-EBP ( indirect -- indirect ) - #! { EBP } ==> { EBP 0 } - dup [ base>> { EBP RBP R13 } member? ] [ displacement>> not ] bi and - [ 0 >>displacement ] when ; - -ERROR: bad-index indirect ; - -: check-ESP ( indirect -- indirect ) - dup index>> { ESP RSP } memq? [ bad-index ] when ; - -: canonicalize ( indirect -- indirect ) - #! Modify the indirect to work around certain addressing mode - #! quirks. - canonicalize-EBP check-ESP ; - -: ( base index scale displacement -- indirect ) - indirect boa canonicalize ; : reg-code ( reg -- n ) "register" word-prop 7 bitand ; @@ -168,18 +95,6 @@ M: register displacement, drop ; : addressing ( reg# indirect -- ) [ mod-r/m, ] [ sib, ] [ displacement, ] tri ; -! Utilities -UNION: operand register indirect ; - -GENERIC: operand-64? ( operand -- ? ) - -M: indirect operand-64? - [ base>> ] [ index>> ] bi [ operand-64? ] either? ; - -M: register-64 operand-64? drop t ; - -M: object operand-64? drop f ; - : rex.w? ( rex.w reg r/m -- ? ) { { [ dup register-128? ] [ drop operand-64? ] } @@ -276,15 +191,6 @@ M: object operand-64? drop f ; PRIVATE> -: [] ( reg/displacement -- indirect ) - dup integer? [ [ f f f ] dip ] [ f f f ] if ; - -: [+] ( reg displacement -- indirect ) - dup integer? - [ dup zero? [ drop f ] when [ f f ] dip ] - [ f f ] if - ; - ! Moving stuff GENERIC: PUSH ( op -- ) M: register PUSH f HEX: 50 short-operand ; diff --git a/basis/cpu/x86/assembler/authors.txt b/basis/cpu/x86/assembler/authors.txt index 1901f27a24..580f882c8d 100755 --- a/basis/cpu/x86/assembler/authors.txt +++ b/basis/cpu/x86/assembler/authors.txt @@ -1 +1,2 @@ Slava Pestov +Joe Groff diff --git a/basis/cpu/x86/assembler/operands/operands.factor b/basis/cpu/x86/assembler/operands/operands.factor new file mode 100644 index 0000000000..733c57689b --- /dev/null +++ b/basis/cpu/x86/assembler/operands/operands.factor @@ -0,0 +1,118 @@ +! Copyright (C) 2008, 2009 Slava Pestov, Joe Groff. +! See http://factorcode.org/license.txt for BSD license. +USING: kernel words math accessors sequences cpu.x86.assembler.syntax ; +IN: cpu.x86.assembler.operands + +! In 32-bit mode, { 1234 } is absolute indirect addressing. +! In 64-bit mode, { 1234 } is RIP-relative. +! Beware! + +REGISTERS: 8 AL CL DL BL SPL BPL SIL DIL R8B R9B R10B R11B R12B R13B R14B R15B ; + +ALIAS: AH SPL +ALIAS: CH BPL +ALIAS: DH SIL +ALIAS: BH DIL + +REGISTERS: 16 AX CX DX BX SP BP SI DI R8W R9W R10W R11W R12W R13W R14W R15W ; + +REGISTERS: 32 EAX ECX EDX EBX ESP EBP ESI EDI R8D R9D R10D R11D R12D R13D R14D R15D ; + +REGISTERS: 64 +RAX RCX RDX RBX RSP RBP RSI RDI R8 R9 R10 R11 R12 R13 R14 R15 ; + +REGISTERS: 128 +XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 +XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15 ; + + ; + +! Addressing modes +TUPLE: indirect base index scale displacement ; + +M: indirect extended? base>> extended? ; + +: canonicalize-EBP ( indirect -- indirect ) + #! { EBP } ==> { EBP 0 } + dup [ base>> { EBP RBP R13 } member? ] [ displacement>> not ] bi and + [ 0 >>displacement ] when ; + +ERROR: bad-index indirect ; + +: check-ESP ( indirect -- indirect ) + dup index>> { ESP RSP } memq? [ bad-index ] when ; + +: canonicalize ( indirect -- indirect ) + #! Modify the indirect to work around certain addressing mode + #! quirks. + canonicalize-EBP check-ESP ; + +: ( base index scale displacement -- indirect ) + indirect boa canonicalize ; + +! Utilities +UNION: operand register indirect ; + +GENERIC: operand-64? ( operand -- ? ) + +M: indirect operand-64? + [ base>> ] [ index>> ] bi [ operand-64? ] either? ; + +M: register-64 operand-64? drop t ; + +M: object operand-64? drop f ; + +PRIVATE> + +: [] ( reg/displacement -- indirect ) + dup integer? [ [ f f f ] dip ] [ f f f ] if ; + +: [+] ( reg displacement -- indirect ) + dup integer? + [ dup zero? [ drop f ] when [ f f ] dip ] + [ f f ] if + ; + +TUPLE: byte value ; + +C: byte + + + +: 8-bit-version-of ( register -- register' ) 8 n-bit-version-of ; +: 16-bit-version-of ( register -- register' ) 16 n-bit-version-of ; +: 32-bit-version-of ( register -- register' ) 32 n-bit-version-of ; +: 64-bit-version-of ( register -- register' ) 64 n-bit-version-of ; +: native-version-of ( register -- register' ) cell-bits n-bit-version-of ; \ No newline at end of file diff --git a/basis/cpu/x86/assembler/syntax/syntax.factor b/basis/cpu/x86/assembler/syntax/syntax.factor index 631dcaa8f7..5b65c19155 100644 --- a/basis/cpu/x86/assembler/syntax/syntax.factor +++ b/basis/cpu/x86/assembler/syntax/syntax.factor @@ -1,14 +1,23 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel words words.symbol sequences lexer parser fry ; +USING: kernel words words.symbol sequences lexer parser fry +namespaces combinators assocs ; IN: cpu.x86.assembler.syntax -: define-register ( name num size -- ) - [ "cpu.x86.assembler" create dup define-symbol ] 2dip - [ dupd "register" set-word-prop ] dip - "register-size" set-word-prop ; +SYMBOL: registers -: define-registers ( names size -- ) - '[ _ define-register ] each-index ; +registers [ H{ } clone ] initialize -SYNTAX: REGISTERS: scan-word ";" parse-tokens swap define-registers ; +: define-register ( name num size -- word ) + [ "cpu.x86.assembler.operands" create ] 2dip { + [ 2drop ] + [ 2drop define-symbol ] + [ drop "register" set-word-prop ] + [ nip "register-size" set-word-prop ] + } 3cleave ; + +: define-registers ( size names -- ) + [ swap '[ _ define-register ] map-index ] [ drop ] 2bi + registers get set-at ; + +SYNTAX: REGISTERS: scan-word ";" parse-tokens define-registers ; diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 258f842598..337232c259 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs alien alien.c-types arrays strings -cpu.x86.assembler cpu.x86.assembler.private cpu.architecture -kernel kernel.private math memory namespaces make sequences -words system layouts combinators math.order fry locals +cpu.x86.assembler cpu.x86.assembler.private cpu.x86.assembler.operands +cpu.architecture kernel kernel.private math memory namespaces make +sequences words system layouts combinators math.order fry locals compiler.constants compiler.cfg.registers compiler.cfg.instructions @@ -264,67 +264,6 @@ M:: x86 %box-alien ( dst src temp -- ) "end" resolve-label ] with-scope ; -: small-reg-8 ( reg -- reg' ) - H{ - { EAX RAX } - { ECX RCX } - { EDX RDX } - { EBX RBX } - { ESP RSP } - { EBP RBP } - { ESI RSP } - { EDI RDI } - - { RAX RAX } - { RCX RCX } - { RDX RDX } - { RBX RBX } - { RSP RSP } - { RBP RBP } - { RSI RSP } - { RDI RDI } - } at ; inline - -: small-reg-4 ( reg -- reg' ) - small-reg-8 H{ - { RAX EAX } - { RCX ECX } - { RDX EDX } - { RBX EBX } - { RSP ESP } - { RBP EBP } - { RSI ESP } - { RDI EDI } - } at ; inline - -: small-reg-2 ( reg -- reg' ) - small-reg-4 H{ - { EAX AX } - { ECX CX } - { EDX DX } - { EBX BX } - { ESP SP } - { EBP BP } - { ESI SI } - { EDI DI } - } at ; inline - -: small-reg-1 ( reg -- reg' ) - small-reg-4 { - { EAX AL } - { ECX CL } - { EDX DL } - { EBX BL } - } at ; inline - -: small-reg ( reg size -- reg' ) - { - { 1 [ small-reg-1 ] } - { 2 [ small-reg-2 ] } - { 4 [ small-reg-4 ] } - { 8 [ small-reg-8 ] } - } case ; - HOOK: small-regs cpu ( -- regs ) M: x86.32 small-regs { EAX ECX EDX EBX } ; @@ -336,7 +275,7 @@ M: x86.32 small-reg-native small-reg-4 ; M: x86.64 small-reg-native small-reg-8 ; : small-reg-that-isn't ( exclude -- reg' ) - small-regs swap [ small-reg-native ] map '[ _ memq? not ] find nip ; + small-regs swap [ native-version-of ] map '[ _ memq? not ] find nip ; : with-save/restore ( reg quot -- ) [ drop PUSH ] [ call ] [ drop POP ] 2tri ; inline @@ -346,7 +285,7 @@ M: x86.64 small-reg-native small-reg-8 ; #! call the quot with that. Otherwise, we find a small #! register that is not in exclude, and call quot, saving #! and restoring the small register. - dst small-reg-native small-regs memq? [ dst quot call ] [ + dst small-regs memq? [ dst quot call ] [ exclude small-reg-that-isn't [ quot call ] with-save/restore ] if ; inline @@ -362,7 +301,7 @@ M: x86.64 small-reg-native small-reg-8 ; src2 CL quot call dst src2 XCHG ] [ - ECX small-reg-native [ + ECX native-version-of [ CL src2 MOV drop dst CL quot call ] with-save/restore @@ -380,8 +319,8 @@ M:: x86 %string-nth ( dst src index temp -- ) ! 8th bit indicates whether we have to load from ! the aux vector or not. temp src index [+] LEA - new-dst 1 small-reg temp string-offset [+] MOV - new-dst new-dst 1 small-reg MOVZX + new-dst 8-bit-version-of temp string-offset [+] MOV + new-dst new-dst 8-bit-version-of MOVZX ! Do we have to look at the aux vector? new-dst HEX: 80 CMP "end" get JL @@ -392,8 +331,8 @@ M:: x86 %string-nth ( dst src index temp -- ) new-dst index ADD new-dst index ADD ! Load high 16 bits - new-dst 2 small-reg new-dst byte-array-offset [+] MOV - new-dst new-dst 2 small-reg MOVZX + new-dst 16-bit-version-of new-dst byte-array-offset [+] MOV + new-dst new-dst 16-bit-version-of MOVZX new-dst 7 SHL ! Compute code point new-dst temp XOR @@ -405,12 +344,12 @@ M:: x86 %set-string-nth-fast ( ch str index temp -- ) ch { index str temp } [| new-ch | new-ch ch ?MOV temp str index [+] LEA - temp string-offset [+] new-ch 1 small-reg MOV + temp string-offset [+] new-ch 8-bit-version-of MOV ] with-small-register ; :: %alien-integer-getter ( dst src size quot -- ) dst { src } [| new-dst | - new-dst dup size small-reg dup src [] MOV + new-dst dup size 8 * n-bit-version-of dup src [] MOV quot call dst new-dst ?MOV ] with-small-register ; inline @@ -437,7 +376,7 @@ M: x86 %alien-double [] MOVSD ; :: %alien-integer-setter ( ptr value size -- ) value { ptr } [| new-value | new-value value ?MOV - ptr [] new-value size small-reg MOV + ptr [] new-value size 8 * n-bit-version-of MOV ] with-small-register ; inline M: x86 %set-alien-integer-1 1 %alien-integer-setter ; From 8ca17d053c51312a43bfaac6c8161738be8bbcae Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 29 Jul 2009 21:56:37 -0500 Subject: [PATCH 09/18] cpu.x86: use full set of 8-bit, 16-bit and 32-bit registers on x86-64 to avoid clumsy save/restore logic --- basis/cpu/x86/assembler/operands/operands.factor | 7 ++----- basis/cpu/x86/x86.factor | 15 +++++---------- 2 files changed, 7 insertions(+), 15 deletions(-) diff --git a/basis/cpu/x86/assembler/operands/operands.factor b/basis/cpu/x86/assembler/operands/operands.factor index 733c57689b..b931fcfd87 100644 --- a/basis/cpu/x86/assembler/operands/operands.factor +++ b/basis/cpu/x86/assembler/operands/operands.factor @@ -1,6 +1,7 @@ ! Copyright (C) 2008, 2009 Slava Pestov, Joe Groff. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel words math accessors sequences cpu.x86.assembler.syntax ; +USING: kernel words math accessors sequences namespaces +assocs layouts cpu.x86.assembler.syntax ; IN: cpu.x86.assembler.operands ! In 32-bit mode, { 1234 } is absolute indirect addressing. @@ -101,16 +102,12 @@ TUPLE: byte value ; C: byte - - : 8-bit-version-of ( register -- register' ) 8 n-bit-version-of ; : 16-bit-version-of ( register -- register' ) 16 n-bit-version-of ; : 32-bit-version-of ( register -- register' ) 32 n-bit-version-of ; diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 337232c259..5dc3ef2e0a 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -264,18 +264,13 @@ M:: x86 %box-alien ( dst src temp -- ) "end" resolve-label ] with-scope ; -HOOK: small-regs cpu ( -- regs ) +HOOK: small-reg? cpu ( reg -- regs ) -M: x86.32 small-regs { EAX ECX EDX EBX } ; -M: x86.64 small-regs { RAX RCX RDX RBX } ; - -HOOK: small-reg-native cpu ( reg -- reg' ) - -M: x86.32 small-reg-native small-reg-4 ; -M: x86.64 small-reg-native small-reg-8 ; +M: x86.32 small-reg? { EAX ECX EDX EBX } memq? ; +M: x86.64 small-reg? drop t ; : small-reg-that-isn't ( exclude -- reg' ) - small-regs swap [ native-version-of ] map '[ _ memq? not ] find nip ; + [ native-version-of ] map [ small-reg? not ] find nip ; : with-save/restore ( reg quot -- ) [ drop PUSH ] [ call ] [ drop POP ] 2tri ; inline @@ -285,7 +280,7 @@ M: x86.64 small-reg-native small-reg-8 ; #! call the quot with that. Otherwise, we find a small #! register that is not in exclude, and call quot, saving #! and restoring the small register. - dst small-regs memq? [ dst quot call ] [ + dst small-reg? [ dst quot call ] [ exclude small-reg-that-isn't [ quot call ] with-save/restore ] if ; inline From 1e8d13c1f16addf141914213ce20e952f536ca9f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 29 Jul 2009 22:32:22 -0500 Subject: [PATCH 10/18] cpu.x86.assembler: fix extended 8-bit registers (DIL, SIL, SPL, BPL) --- .../cpu/x86/assembler/assembler-tests.factor | 4 ++- basis/cpu/x86/assembler/assembler.factor | 36 +++++++++---------- .../x86/assembler/operands/operands.factor | 5 ++- 3 files changed, 23 insertions(+), 22 deletions(-) diff --git a/basis/cpu/x86/assembler/assembler-tests.factor b/basis/cpu/x86/assembler/assembler-tests.factor index 962309c67e..14d4a1dd7c 100644 --- a/basis/cpu/x86/assembler/assembler-tests.factor +++ b/basis/cpu/x86/assembler/assembler-tests.factor @@ -1,7 +1,9 @@ -USING: cpu.x86.assembler cpu.x86.operands +USING: cpu.x86.assembler cpu.x86.assembler.operands kernel tools.test namespaces make ; IN: cpu.x86.assembler.tests +[ { HEX: 40 HEX: 8a HEX: 2a } ] [ [ BPL RDX [] MOV ] { } make ] unit-test + [ { HEX: 49 HEX: 89 HEX: 04 HEX: 24 } ] [ [ R12 [] RAX MOV ] { } make ] unit-test [ { HEX: 49 HEX: 8b HEX: 06 } ] [ [ RAX R14 [] MOV ] { } make ] unit-test diff --git a/basis/cpu/x86/assembler/assembler.factor b/basis/cpu/x86/assembler/assembler.factor index f15704a015..cefc190105 100644 --- a/basis/cpu/x86/assembler/assembler.factor +++ b/basis/cpu/x86/assembler/assembler.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2005, 2009 Slava Pestov, Joe Groff. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays io.binary kernel combinators kernel.private math +USING: arrays io.binary kernel combinators kernel.private math locals namespaces make sequences words system layouts math.order accessors cpu.x86.assembler.operands cpu.x86.assembler.operands.private ; QUALIFIED: sequences @@ -10,8 +10,6 @@ IN: cpu.x86.assembler > EBP or reg-code ; @@ -86,9 +84,7 @@ M: indirect displacement, dup displacement>> dup [ swap base>> [ dup fits-in-byte? [ , ] [ 4, ] if ] [ 4, ] if - ] [ - 2drop - ] if ; + ] [ 2drop ] if ; M: register displacement, drop ; @@ -107,22 +103,25 @@ M: register displacement, drop ; : rex.b ( m op -- n ) [ extended? [ BIN: 00000001 bitor ] when ] keep - dup indirect? [ - index>> extended? [ BIN: 00000010 bitor ] when - ] [ - drop - ] if ; + dup indirect? [ index>> extended? [ BIN: 00000010 bitor ] when ] [ drop ] if ; -: rex-prefix ( reg r/m rex.w -- ) +: no-prefix? ( prefix reg r/m -- ? ) + [ BIN: 01000000 = ] + [ extended-8-bit-register? not ] + [ extended-8-bit-register? not ] tri* + and and ; + +:: rex-prefix ( reg r/m rex.w -- ) #! Compile an AMD64 REX prefix. - 2over rex.w? BIN: 01001000 BIN: 01000000 ? - swap rex.r swap rex.b - dup BIN: 01000000 = [ drop ] [ , ] if ; + rex.w reg r/m rex.w? BIN: 01001000 BIN: 01000000 ? + r/m rex.r + reg rex.b + dup reg r/m no-prefix? [ drop ] [ , ] if ; : 16-prefix ( reg r/m -- ) [ register-16? ] either? [ HEX: 66 , ] when ; -: prefix ( reg r/m rex.w -- ) 2over 16-prefix rex-prefix ; +: prefix ( reg r/m rex.w -- ) [ drop 16-prefix ] [ rex-prefix ] 3bi ; : prefix-1 ( reg rex.w -- ) f swap prefix ; @@ -184,10 +183,7 @@ M: register displacement, drop ; : 2-operand ( dst src op -- ) #! Sets the opcode's direction bit. It is set if the #! destination is a direct register operand. - 2over 16-prefix - direction-bit - operand-size-bit - (2-operand) ; + [ drop 16-prefix ] [ direction-bit operand-size-bit (2-operand) ] 3bi ; PRIVATE> diff --git a/basis/cpu/x86/assembler/operands/operands.factor b/basis/cpu/x86/assembler/operands/operands.factor index b931fcfd87..d3cb66ff12 100644 --- a/basis/cpu/x86/assembler/operands/operands.factor +++ b/basis/cpu/x86/assembler/operands/operands.factor @@ -102,10 +102,13 @@ TUPLE: byte value ; C: byte +: extended-8-bit-register? ( register -- ? ) + { SPL BPL SIL DIL } memq? ; + : n-bit-version-of ( register n -- register' ) ! Certain 8-bit registers don't exist in 32-bit mode... [ "register" word-prop ] dip registers get at nth - dup { SPL BPL SIL DIL } memq? cell 4 = and + dup extended-8-bit-register? cell 4 = and [ drop f ] when ; : 8-bit-version-of ( register -- register' ) 8 n-bit-version-of ; From b133649eddd8cad391cef32bbfa168b7487661b1 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 29 Jul 2009 23:35:51 -0500 Subject: [PATCH 11/18] compiler.cfg.ssa.destruction: tweak in preparation for landing Dan's new SSA liveness analysis --- basis/compiler/cfg/liveness/ssa/ssa.factor | 4 ++++ .../cfg/ssa/destruction/live-ranges/live-ranges.factor | 6 +++--- .../ssa/destruction/process-blocks/process-blocks.factor | 8 ++++---- 3 files changed, 11 insertions(+), 7 deletions(-) diff --git a/basis/compiler/cfg/liveness/ssa/ssa.factor b/basis/compiler/cfg/liveness/ssa/ssa.factor index 9fa22d22b1..dbfe2d70b4 100644 --- a/basis/compiler/cfg/liveness/ssa/ssa.factor +++ b/basis/compiler/cfg/liveness/ssa/ssa.factor @@ -55,3 +55,7 @@ SYMBOL: work-list H{ } clone live-outs set dup post-order add-to-work-list work-list get [ liveness-step ] slurp-deque ; + +: live-in? ( vreg bb -- ? ) live-in key? ; + +: live-out? ( vreg bb -- ? ) live-out key? ; \ No newline at end of file diff --git a/basis/compiler/cfg/ssa/destruction/live-ranges/live-ranges.factor b/basis/compiler/cfg/ssa/destruction/live-ranges/live-ranges.factor index 536f5e1e68..01aebd7e1c 100644 --- a/basis/compiler/cfg/ssa/destruction/live-ranges/live-ranges.factor +++ b/basis/compiler/cfg/ssa/destruction/live-ranges/live-ranges.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs fry kernel namespaces sequences math arrays compiler.cfg.def-use compiler.cfg.instructions -compiler.cfg.liveness compiler.cfg.rpo ; +compiler.cfg.liveness.ssa compiler.cfg.rpo ; IN: compiler.cfg.ssa.destruction.live-ranges ! Live ranges for interference testing @@ -52,9 +52,9 @@ PRIVATE> ERROR: bad-kill-index vreg bb ; : kill-index ( vreg bb -- n ) - 2dup live-out key? [ 2drop 1/0. ] [ + 2dup live-out? [ 2drop 1/0. ] [ 2dup kill-indices get at at* [ 2nip ] [ - drop 2dup live-in key? + drop 2dup live-in? [ bad-kill-index ] [ 2drop -1/0. ] if ] if ] if ; diff --git a/basis/compiler/cfg/ssa/destruction/process-blocks/process-blocks.factor b/basis/compiler/cfg/ssa/destruction/process-blocks/process-blocks.factor index f8c8a4d8b2..18af6e9904 100644 --- a/basis/compiler/cfg/ssa/destruction/process-blocks/process-blocks.factor +++ b/basis/compiler/cfg/ssa/destruction/process-blocks/process-blocks.factor @@ -4,7 +4,7 @@ USING: accessors assocs fry kernel locals math math.order arrays namespaces sequences sorting sets combinators combinators.short-circuit make compiler.cfg.def-use compiler.cfg.instructions -compiler.cfg.liveness +compiler.cfg.liveness.ssa compiler.cfg.dominance compiler.cfg.ssa.destruction.state compiler.cfg.ssa.destruction.forest @@ -19,13 +19,13 @@ IN: compiler.cfg.ssa.destruction.process-blocks SYMBOLS: phi-union unioned-blocks ; :: operand-live-into-phi-node's-block? ( bb src dst -- ? ) - src bb live-in key? ; + src bb live-in? ; :: phi-node-is-live-out-of-operand's-block? ( bb src dst -- ? ) - dst src def-of live-out key? ; + dst src def-of live-out? ; :: operand-is-phi-node-and-live-into-operand's-block? ( bb src dst -- ? ) - { [ src insn-of ##phi? ] [ src src def-of live-in key? ] } 0&& ; + { [ src insn-of ##phi? ] [ src src def-of live-in? ] } 0&& ; :: operand-being-renamed? ( bb src dst -- ? ) src processed-names get key? ; From 6274c0337afed6190fecc638cb7d4fe9933b5216 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 29 Jul 2009 23:43:00 -0500 Subject: [PATCH 12/18] compiler.cfg.ssa.destruction: fix --- .../cfg/ssa/destruction/process-blocks/process-blocks.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/compiler/cfg/ssa/destruction/process-blocks/process-blocks.factor b/basis/compiler/cfg/ssa/destruction/process-blocks/process-blocks.factor index 18af6e9904..ce2aa1c5d7 100644 --- a/basis/compiler/cfg/ssa/destruction/process-blocks/process-blocks.factor +++ b/basis/compiler/cfg/ssa/destruction/process-blocks/process-blocks.factor @@ -61,10 +61,10 @@ SYMBOLS: phi-union unioned-blocks ; } cond ; : node-is-live-in-of-child? ( node child -- ? ) - [ vreg>> ] [ bb>> live-in ] bi* key? ; + [ vreg>> ] [ bb>> ] bi* live-in? ; : node-is-live-out-of-child? ( node child -- ? ) - [ vreg>> ] [ bb>> live-out ] bi* key? ; + [ vreg>> ] [ bb>> ] bi* live-out? ; :: insert-copy ( bb src dst -- ) bb src dst trivial-interference From 791fbe4003d9824ce58a5a4422369492f0d8401b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 30 Jul 2009 02:13:30 -0500 Subject: [PATCH 13/18] compiler.cfg.linear-scan: fix case where a register can be made available for only a part of a live interval's lifetime, but there are no more usages after the split location. This case never came up until global stack analysis, at which point it started to be exercised on x86-32 --- .../linear-scan/allocation/allocation.factor | 18 --- .../allocation/spilling/spilling.factor | 90 ++++++------- .../allocation/splitting/splitting.factor | 4 - .../cfg/linear-scan/debugger/debugger.factor | 17 +-- .../cfg/linear-scan/linear-scan-tests.factor | 124 +++++++++++++----- .../live-intervals/live-intervals.factor | 1 - 6 files changed, 129 insertions(+), 125 deletions(-) diff --git a/basis/compiler/cfg/linear-scan/allocation/allocation.factor b/basis/compiler/cfg/linear-scan/allocation/allocation.factor index c197da9814..d55266e6e4 100644 --- a/basis/compiler/cfg/linear-scan/allocation/allocation.factor +++ b/basis/compiler/cfg/linear-scan/allocation/allocation.factor @@ -28,29 +28,11 @@ IN: compiler.cfg.linear-scan.allocation : no-free-registers? ( result -- ? ) second 0 = ; inline -: split-to-fit ( new n -- before after ) - split-interval - [ [ compute-start/end ] bi@ ] - [ >>split-next drop ] - [ ] - 2tri ; - -: register-partially-available ( new result -- ) - { - { [ 2dup second 1 - spill-live-out? ] [ drop spill-live-out ] } - { [ 2dup second 1 - spill-live-in? ] [ drop spill-live-in ] } - [ - [ second 1 - split-to-fit ] keep - '[ _ register-available ] [ add-unhandled ] bi* - ] - } cond ; - : assign-register ( new -- ) dup coalesce? [ coalesce ] [ dup register-status { { [ dup no-free-registers? ] [ drop assign-blocked-register ] } { [ 2dup register-available? ] [ register-available ] } - ! [ register-partially-available ] [ drop assign-blocked-register ] } cond ] if ; diff --git a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor index 14046a91f1..4dd3c8176c 100644 --- a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor +++ b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor @@ -28,23 +28,42 @@ ERROR: bad-live-ranges interval ; [ swap first (>>from) ] 2bi ; -: split-for-spill ( live-interval n -- before after ) - split-interval - { - [ [ trim-before-ranges ] [ trim-after-ranges ] bi* ] - [ [ compute-start/end ] bi@ ] - [ [ check-ranges ] bi@ ] - [ ] - } 2cleave ; - : assign-spill ( live-interval -- ) - dup vreg>> assign-spill-slot >>spill-to f >>split-next drop ; + dup vreg>> assign-spill-slot >>spill-to drop ; + +: spill-before ( before -- before/f ) + ! If the interval does not have any usages before the spill location, + ! then it is the second child of an interval that was split. We reload + ! the value and let the resolve pass insert a split later. + dup uses>> empty? [ drop f ] [ + { + [ ] + [ assign-spill ] + [ trim-before-ranges ] + [ compute-start/end ] + [ check-ranges ] + } cleave + ] if ; : assign-reload ( live-interval -- ) dup vreg>> assign-spill-slot >>reload-from drop ; -: split-and-spill ( live-interval n -- before after ) - split-for-spill 2dup [ assign-spill ] [ assign-reload ] bi* ; +: spill-after ( after -- after/f ) + ! If the interval has no more usages after the spill location, + ! then it is the first child of an interval that was split. We + ! spill the value and let the resolve pass insert a reload later. + dup uses>> empty? [ drop f ] [ + { + [ ] + [ assign-reload ] + [ trim-after-ranges ] + [ compute-start/end ] + [ check-ranges ] + } cleave + ] if ; + +: split-for-spill ( live-interval n -- before after ) + split-interval [ spill-before ] [ spill-after ] bi* ; : find-use-position ( live-interval new -- n ) [ uses>> ] [ start>> '[ _ >= ] ] bi* find nip 1/0. or ; @@ -72,47 +91,12 @@ ERROR: bad-live-ranges interval ; [ uses>> first ] [ second ] bi* > ; : spill-new ( new pair -- ) - drop - { - [ trim-after-ranges ] - [ compute-start/end ] - [ assign-reload ] - [ add-unhandled ] - } cleave ; - -: spill-live-out? ( live-interval n -- ? ) [ uses>> last ] dip < ; - -: spill-live-out ( live-interval -- ) - ! The interval has no more usages after the spill location. This - ! means it is the first child of an interval that was split. We - ! spill the value and let the resolve pass insert a reload later. - { - [ trim-before-ranges ] - [ compute-start/end ] - [ assign-spill ] - [ add-handled ] - } cleave ; - -: spill-live-in? ( live-interval n -- ? ) [ uses>> first ] dip > ; - -: spill-live-in ( live-interval -- ) - ! The interval does not have any usages before the spill location. - ! This means it is the second child of an interval that was - ! split. We reload the value and let the resolve pass insert a - ! split later. - { - [ trim-after-ranges ] - [ compute-start/end ] - [ assign-reload ] - [ add-unhandled ] - } cleave ; + drop spill-after add-unhandled ; : spill ( live-interval n -- ) - { - { [ 2dup spill-live-out? ] [ drop spill-live-out ] } - { [ 2dup spill-live-in? ] [ drop spill-live-in ] } - [ split-and-spill [ add-handled ] [ add-unhandled ] bi* ] - } cond ; + split-for-spill + [ [ add-handled ] when* ] + [ [ add-unhandled ] when* ] bi* ; :: spill-intersecting-active ( new reg -- ) ! If there is an active interval using 'reg' (there should be at @@ -149,8 +133,8 @@ ERROR: bad-live-ranges interval ; ! A register would be available for part of the new ! interval's lifetime if all active and inactive intervals ! using that register were split and spilled. - [ second 1 - split-and-spill add-unhandled ] keep - spill-available ; + [ second 1 - split-for-spill [ add-unhandled ] when* ] keep + '[ _ spill-available ] when* ; : assign-blocked-register ( new -- ) dup spill-status { diff --git a/basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor b/basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor index 0a67710bc8..874523d70a 100644 --- a/basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor +++ b/basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor @@ -27,9 +27,6 @@ IN: compiler.cfg.linear-scan.allocation.splitting : split-uses ( uses n -- before after ) '[ _ <= ] partition ; -: record-split ( live-interval before after -- ) - [ >>split-before ] [ >>split-after ] bi* drop ; inline - ERROR: splitting-too-early ; ERROR: splitting-too-late ; @@ -56,7 +53,6 @@ ERROR: splitting-atomic-interval ; live-interval clone :> after live-interval uses>> n split-uses before after [ (>>uses) ] bi-curry@ bi* live-interval ranges>> n split-ranges before after [ (>>ranges) ] bi-curry@ bi* - live-interval before after record-split before split-before after split-after ; diff --git a/basis/compiler/cfg/linear-scan/debugger/debugger.factor b/basis/compiler/cfg/linear-scan/debugger/debugger.factor index a350ee5f43..c9c1b77a0d 100644 --- a/basis/compiler/cfg/linear-scan/debugger/debugger.factor +++ b/basis/compiler/cfg/linear-scan/debugger/debugger.factor @@ -5,25 +5,12 @@ namespaces prettyprint compiler.cfg.linear-scan.live-intervals compiler.cfg.linear-scan.allocation compiler.cfg assocs ; IN: compiler.cfg.linear-scan.debugger -: check-assigned ( live-intervals -- ) - [ - reg>> - [ "Not all intervals have registers" throw ] unless - ] each ; - -: split-children ( live-interval -- seq ) - dup split-before>> [ - [ split-before>> ] [ split-after>> ] bi - [ split-children ] bi@ - append - ] [ 1array ] if ; - : check-linear-scan ( live-intervals machine-registers -- ) [ [ clone ] map dup [ [ vreg>> ] keep ] H{ } map>assoc live-intervals set - ] dip allocate-registers - [ split-children ] map concat check-assigned ; + ] dip + allocate-registers drop ; : picture ( uses -- str ) dup last 1 + CHAR: space diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor index f38946f8e2..df91109e78 100644 --- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor +++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor @@ -75,6 +75,9 @@ check-numbering? on { T{ live-range f 0 5 } } 0 split-ranges ] unit-test +H{ { int-regs 10 } { float-regs 20 } } clone spill-counts set +H{ } spill-slots set + [ T{ live-interval { vreg T{ vreg { reg-class int-regs } { n 1 } } } @@ -82,6 +85,7 @@ check-numbering? on { end 2 } { uses V{ 0 1 } } { ranges V{ T{ live-range f 0 2 } } } + { spill-to 10 } } T{ live-interval { vreg T{ vreg { reg-class int-regs } { n 1 } } } @@ -89,6 +93,7 @@ check-numbering? on { end 5 } { uses V{ 5 } } { ranges V{ T{ live-range f 5 5 } } } + { reload-from 10 } } ] [ T{ live-interval @@ -97,82 +102,61 @@ check-numbering? on { end 5 } { uses V{ 0 1 5 } } { ranges V{ T{ live-range f 0 5 } } } - } 2 split-for-spill [ f >>split-next ] bi@ + } 2 split-for-spill ] unit-test [ T{ live-interval - { vreg T{ vreg { reg-class int-regs } { n 1 } } } + { vreg T{ vreg { reg-class int-regs } { n 2 } } } { start 0 } { end 1 } { uses V{ 0 } } { ranges V{ T{ live-range f 0 1 } } } + { spill-to 11 } } T{ live-interval - { vreg T{ vreg { reg-class int-regs } { n 1 } } } + { vreg T{ vreg { reg-class int-regs } { n 2 } } } { start 1 } { end 5 } { uses V{ 1 5 } } { ranges V{ T{ live-range f 1 5 } } } + { reload-from 11 } } ] [ T{ live-interval - { vreg T{ vreg { reg-class int-regs } { n 1 } } } + { vreg T{ vreg { reg-class int-regs } { n 2 } } } { start 0 } { end 5 } { uses V{ 0 1 5 } } { ranges V{ T{ live-range f 0 5 } } } - } 0 split-for-spill [ f >>split-next ] bi@ + } 0 split-for-spill ] unit-test [ T{ live-interval - { vreg T{ vreg { reg-class int-regs } { n 1 } } } + { vreg T{ vreg { reg-class int-regs } { n 3 } } } { start 0 } { end 1 } { uses V{ 0 } } { ranges V{ T{ live-range f 0 1 } } } + { spill-to 12 } } T{ live-interval - { vreg T{ vreg { reg-class int-regs } { n 1 } } } + { vreg T{ vreg { reg-class int-regs } { n 3 } } } { start 20 } { end 30 } { uses V{ 20 30 } } { ranges V{ T{ live-range f 20 30 } } } + { reload-from 12 } } ] [ T{ live-interval - { vreg T{ vreg { reg-class int-regs } { n 1 } } } + { vreg T{ vreg { reg-class int-regs } { n 3 } } } { start 0 } { end 30 } { uses V{ 0 20 30 } } { ranges V{ T{ live-range f 0 8 } T{ live-range f 10 18 } T{ live-range f 20 30 } } } - } 10 split-for-spill [ f >>split-next ] bi@ -] unit-test - -[ - T{ live-interval - { vreg T{ vreg { reg-class int-regs } { n 1 } } } - { start 0 } - { end 4 } - { uses V{ 0 1 4 } } - { ranges V{ T{ live-range f 0 4 } } } - } - T{ live-interval - { vreg T{ vreg { reg-class int-regs } { n 1 } } } - { start 5 } - { end 10 } - { uses V{ 5 10 } } - { ranges V{ T{ live-range f 5 10 } } } - } -] [ - T{ live-interval - { vreg T{ vreg { reg-class int-regs } { n 1 } } } - { start 0 } - { end 10 } - { uses V{ 0 1 4 5 10 } } - { ranges V{ T{ live-range f 0 10 } } } - } 4 split-to-fit [ f >>split-next ] bi@ + } 10 split-for-spill ] unit-test [ @@ -352,6 +336,78 @@ check-numbering? on check-linear-scan ] must-fail +! Problem with spilling intervals with no more usages after the spill location + +[ ] [ + { + T{ live-interval + { vreg T{ vreg { n 1 } { reg-class int-regs } } } + { start 0 } + { end 20 } + { uses V{ 0 10 20 } } + { ranges V{ T{ live-range f 0 2 } T{ live-range f 10 20 } } } + } + T{ live-interval + { vreg T{ vreg { n 2 } { reg-class int-regs } } } + { start 0 } + { end 20 } + { uses V{ 0 10 20 } } + { ranges V{ T{ live-range f 0 2 } T{ live-range f 10 20 } } } + } + T{ live-interval + { vreg T{ vreg { n 3 } { reg-class int-regs } } } + { start 4 } + { end 8 } + { uses V{ 6 } } + { ranges V{ T{ live-range f 4 8 } } } + } + T{ live-interval + { vreg T{ vreg { n 4 } { reg-class int-regs } } } + { start 4 } + { end 8 } + { uses V{ 8 } } + { ranges V{ T{ live-range f 4 8 } } } + } + + ! This guy will invoke the 'spill partially available' code path + T{ live-interval + { vreg T{ vreg { n 5 } { reg-class int-regs } } } + { start 4 } + { end 8 } + { uses V{ 8 } } + { ranges V{ T{ live-range f 4 8 } } } + } + } + H{ { int-regs { "A" "B" } } } + check-linear-scan +] unit-test + + +! Test spill-new code path + +[ ] [ + { + T{ live-interval + { vreg T{ vreg { n 1 } { reg-class int-regs } } } + { start 0 } + { end 10 } + { uses V{ 0 6 10 } } + { ranges V{ T{ live-range f 0 10 } } } + } + + ! This guy will invoke the 'spill new' code path + T{ live-interval + { vreg T{ vreg { n 5 } { reg-class int-regs } } } + { start 2 } + { end 8 } + { uses V{ 8 } } + { ranges V{ T{ live-range f 2 8 } } } + } + } + H{ { int-regs { "A" } } } + check-linear-scan +] unit-test + SYMBOL: available SYMBOL: taken diff --git a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor index 77aae14503..48bef197e6 100644 --- a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor +++ b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor @@ -13,7 +13,6 @@ C: live-range TUPLE: live-interval vreg reg spill-to reload-from -split-before split-after split-next start end ranges uses copy-from ; From a9977d7c79239859f51e64fe23ecc70f251c1f1c Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 30 Jul 2009 02:22:37 -0500 Subject: [PATCH 14/18] cpu.x86: update non-optimizing compiler backends for assembler vocab split --- basis/cpu/x86/32/bootstrap.factor | 3 ++- basis/cpu/x86/64/bootstrap.factor | 3 ++- basis/cpu/x86/64/winnt/bootstrap.factor | 3 ++- basis/cpu/x86/bootstrap.factor | 8 ++++---- 4 files changed, 10 insertions(+), 7 deletions(-) diff --git a/basis/cpu/x86/32/bootstrap.factor b/basis/cpu/x86/32/bootstrap.factor index 490d37ccbc..674cc817d7 100644 --- a/basis/cpu/x86/32/bootstrap.factor +++ b/basis/cpu/x86/32/bootstrap.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2007, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: bootstrap.image.private kernel namespaces system -cpu.x86.assembler layouts vocabs parser compiler.constants ; +cpu.x86.assembler cpu.x86.assembler.operands layouts +vocabs parser compiler.constants ; IN: bootstrap.x86 4 \ cell set diff --git a/basis/cpu/x86/64/bootstrap.factor b/basis/cpu/x86/64/bootstrap.factor index c5c7e63dbc..8b0d53cda5 100644 --- a/basis/cpu/x86/64/bootstrap.factor +++ b/basis/cpu/x86/64/bootstrap.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2007, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: bootstrap.image.private kernel namespaces system -cpu.x86.assembler layouts vocabs parser compiler.constants math ; +layouts vocabs parser compiler.constants math +cpu.x86.assembler cpu.x86.assembler.operands ; IN: bootstrap.x86 8 \ cell set diff --git a/basis/cpu/x86/64/winnt/bootstrap.factor b/basis/cpu/x86/64/winnt/bootstrap.factor index ff15ef27af..0228082956 100644 --- a/basis/cpu/x86/64/winnt/bootstrap.factor +++ b/basis/cpu/x86/64/winnt/bootstrap.factor @@ -1,7 +1,8 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: bootstrap.image.private kernel namespaces system -cpu.x86.assembler layouts vocabs parser ; +layouts vocabs parser cpu.x86.assembler +cpu.x86.assembler.operands ; IN: bootstrap.x86 : stack-frame-size ( -- n ) 8 bootstrap-cells ; diff --git a/basis/cpu/x86/bootstrap.factor b/basis/cpu/x86/bootstrap.factor index 474ce2ea46..6363f17e48 100644 --- a/basis/cpu/x86/bootstrap.factor +++ b/basis/cpu/x86/bootstrap.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2007, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: bootstrap.image.private kernel kernel.private namespaces -system cpu.x86.assembler layouts compiler.units math -math.private compiler.constants vocabs slots.private words -locals.backend make sequences combinators arrays ; +USING: bootstrap.image.private kernel kernel.private namespaces system +layouts compiler.units math math.private compiler.constants vocabs +slots.private words locals.backend make sequences combinators arrays + cpu.x86.assembler cpu.x86.assembler.operands ; IN: bootstrap.x86 big-endian off From e1caaca6dfde03061639b6cfac927f98541a3562 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 30 Jul 2009 02:45:29 -0500 Subject: [PATCH 15/18] bootstrap.compiler: compile a few more words early, for a big bootstrap speed boost --- basis/bootstrap/compiler/compiler.factor | 35 +++++++++--------------- 1 file changed, 13 insertions(+), 22 deletions(-) diff --git a/basis/bootstrap/compiler/compiler.factor b/basis/bootstrap/compiler/compiler.factor index 0505dcb184..0a3ff10a8e 100755 --- a/basis/bootstrap/compiler/compiler.factor +++ b/basis/bootstrap/compiler/compiler.factor @@ -6,9 +6,8 @@ classes.private arrays hashtables vectors classes.tuple sbufs hashtables.private sequences.private math classes.tuple.private growable namespaces.private assocs words command-line vocabs io io.encodings.string libc splitting math.parser memory compiler.units -math.order compiler.tree.builder compiler.tree.optimizer -compiler.cfg.optimizer ; -FROM: compiler => enable-optimizer compile-word ; +math.order quotations quotations.private assocs.private ; +FROM: compiler => enable-optimizer ; IN: bootstrap.compiler ! Don't bring this in when deploying, since it will store a @@ -42,16 +41,24 @@ nl ! which are also quick to compile are replaced by ! compiled definitions as soon as possible. { - not + not ? + + 2over roll -roll array? hashtable? vector? tuple? sbuf? tombstone? + curry? compose? callable? + quotation? - array-nth set-array-nth + curry compose uncurry + + array-nth set-array-nth length>> wrap probe namestack* + + layout-of } compile-unoptimized "." write flush @@ -75,7 +82,7 @@ nl "." write flush { - hashcode* = get set + hashcode* = equal? assoc-stack (assoc-stack) get set } compile-unoptimized "." write flush @@ -100,22 +107,6 @@ nl "." write flush -{ build-tree } compile-unoptimized - -"." write flush - -{ optimize-tree } compile-unoptimized - -"." write flush - -{ optimize-cfg } compile-unoptimized - -"." write flush - -{ compile-word } compile-unoptimized - -"." write flush - vocabs [ words compile-unoptimized "." write flush ] each " done" print flush From d81dec5d459110483f193d9c7f5c8e98c2063fe2 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 30 Jul 2009 05:04:46 -0500 Subject: [PATCH 16/18] cpu.x86: fix a bug in small-register logic on 32-bit. Also, on 32-bit, we don't need to do any special register shuffling to work with 16-bit operands since all registers have 16-bit variants. So now only 8-bit operands on x86-32 require special treatment --- basis/cpu/x86/x86.factor | 113 ++++++++++++++++++++++----------------- 1 file changed, 65 insertions(+), 48 deletions(-) diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 5dc3ef2e0a..6e21b46fd5 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -264,52 +264,48 @@ M:: x86 %box-alien ( dst src temp -- ) "end" resolve-label ] with-scope ; -HOOK: small-reg? cpu ( reg -- regs ) +! The 'small-reg' mess is pretty crappy, but its only used on x86-32. +! On x86-64, all registers have 8-bit versions. However, a similar +! problem arises for shifts, where the shift count must be in CL, and +! so one day I will fix this properly by adding precoloring to the +! register allocator. -M: x86.32 small-reg? { EAX ECX EDX EBX } memq? ; -M: x86.64 small-reg? drop t ; +HOOK: has-small-reg? cpu ( reg size -- ? ) + +CONSTANT: have-byte-regs { EAX ECX EDX EBX } + +M: x86.32 has-small-reg? + { + { 8 [ have-byte-regs memq? ] } + { 16 [ drop t ] } + { 32 [ drop t ] } + } case ; + +M: x86.64 has-small-reg? drop t ; : small-reg-that-isn't ( exclude -- reg' ) - [ native-version-of ] map [ small-reg? not ] find nip ; + [ have-byte-regs ] dip + [ native-version-of ] map + '[ _ memq? not ] find nip ; : with-save/restore ( reg quot -- ) [ drop PUSH ] [ call ] [ drop POP ] 2tri ; inline -:: with-small-register ( dst exclude quot: ( new-dst -- ) -- ) - #! If the destination register overlaps a small register, we - #! call the quot with that. Otherwise, we find a small - #! register that is not in exclude, and call quot, saving - #! and restoring the small register. - dst small-reg? [ dst quot call ] [ +:: with-small-register ( dst exclude size quot: ( new-dst -- ) -- ) + ! If the destination register overlaps a small register with + ! 'size' bits, we call the quot with that. Otherwise, we find a + ! small register that is not in exclude, and call quot, saving and + ! restoring the small register. + dst size has-small-reg? [ dst quot call ] [ exclude small-reg-that-isn't [ quot call ] with-save/restore ] if ; inline -: shift-count? ( reg -- ? ) { ECX RCX } memq? ; - -:: emit-shift ( dst src1 src2 quot -- ) - src2 shift-count? [ - dst CL quot call - ] [ - dst shift-count? [ - dst src2 XCHG - src2 CL quot call - dst src2 XCHG - ] [ - ECX native-version-of [ - CL src2 MOV - drop dst CL quot call - ] with-save/restore - ] if - ] if ; inline - -M: x86 %shl [ SHL ] emit-shift ; -M: x86 %shr [ SHR ] emit-shift ; -M: x86 %sar [ SAR ] emit-shift ; - M:: x86 %string-nth ( dst src index temp -- ) + ! We request a small-reg of size 8 since those of size 16 are + ! a superset. "end" define-label - dst { src index temp } [| new-dst | + dst { src index temp } 8 [| new-dst | ! Load the least significant 7 bits into new-dst. ! 8th bit indicates whether we have to load from ! the aux vector or not. @@ -336,15 +332,15 @@ M:: x86 %string-nth ( dst src index temp -- ) ] with-small-register ; M:: x86 %set-string-nth-fast ( ch str index temp -- ) - ch { index str temp } [| new-ch | + ch { index str temp } 8 [| new-ch | new-ch ch ?MOV temp str index [+] LEA temp string-offset [+] new-ch 8-bit-version-of MOV ] with-small-register ; :: %alien-integer-getter ( dst src size quot -- ) - dst { src } [| new-dst | - new-dst dup size 8 * n-bit-version-of dup src [] MOV + dst { src } size [| new-dst | + new-dst dup size n-bit-version-of dup src [] MOV quot call dst new-dst ?MOV ] with-small-register ; inline @@ -352,35 +348,56 @@ M:: x86 %set-string-nth-fast ( ch str index temp -- ) : %alien-unsigned-getter ( dst src size -- ) [ MOVZX ] %alien-integer-getter ; inline -M: x86 %alien-unsigned-1 1 %alien-unsigned-getter ; -M: x86 %alien-unsigned-2 2 %alien-unsigned-getter ; +M: x86 %alien-unsigned-1 8 %alien-unsigned-getter ; +M: x86 %alien-unsigned-2 16 %alien-unsigned-getter ; +M: x86 %alien-unsigned-4 32 [ 2drop ] %alien-integer-getter ; : %alien-signed-getter ( dst src size -- ) [ MOVSX ] %alien-integer-getter ; inline -M: x86 %alien-signed-1 1 %alien-signed-getter ; -M: x86 %alien-signed-2 2 %alien-signed-getter ; -M: x86 %alien-signed-4 4 %alien-signed-getter ; - -M: x86 %alien-unsigned-4 4 [ 2drop ] %alien-integer-getter ; +M: x86 %alien-signed-1 8 %alien-signed-getter ; +M: x86 %alien-signed-2 16 %alien-signed-getter ; +M: x86 %alien-signed-4 32 %alien-signed-getter ; M: x86 %alien-cell [] MOV ; M: x86 %alien-float dupd [] MOVSS dup CVTSS2SD ; M: x86 %alien-double [] MOVSD ; :: %alien-integer-setter ( ptr value size -- ) - value { ptr } [| new-value | + value { ptr } size [| new-value | new-value value ?MOV - ptr [] new-value size 8 * n-bit-version-of MOV + ptr [] new-value size n-bit-version-of MOV ] with-small-register ; inline -M: x86 %set-alien-integer-1 1 %alien-integer-setter ; -M: x86 %set-alien-integer-2 2 %alien-integer-setter ; -M: x86 %set-alien-integer-4 4 %alien-integer-setter ; +M: x86 %set-alien-integer-1 8 %alien-integer-setter ; +M: x86 %set-alien-integer-2 16 %alien-integer-setter ; +M: x86 %set-alien-integer-4 32 %alien-integer-setter ; M: x86 %set-alien-cell [ [] ] dip MOV ; M: x86 %set-alien-float dup dup CVTSD2SS [ [] ] dip MOVSS ; M: x86 %set-alien-double [ [] ] dip MOVSD ; +: shift-count? ( reg -- ? ) { ECX RCX } memq? ; + +:: emit-shift ( dst src1 src2 quot -- ) + src2 shift-count? [ + dst CL quot call + ] [ + dst shift-count? [ + dst src2 XCHG + src2 CL quot call + dst src2 XCHG + ] [ + ECX native-version-of [ + CL src2 MOV + drop dst CL quot call + ] with-save/restore + ] if + ] if ; inline + +M: x86 %shl [ SHL ] emit-shift ; +M: x86 %shr [ SHR ] emit-shift ; +M: x86 %sar [ SAR ] emit-shift ; + : load-zone-ptr ( reg -- ) #! Load pointer to start of zone array 0 MOV "nursery" f rc-absolute-cell rel-dlsym ; From d71e2f9577d347962c81462562167e6ab703f87b Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 30 Jul 2009 05:12:40 -0500 Subject: [PATCH 17/18] cpu.x86: Fix shuffle bug. Shuffling bugs occurring in code that runs before optimizer/stack checker is online are only caught at runtime during bootstrap, what a pain --- basis/cpu/x86/x86.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 6e21b46fd5..5bad8e067c 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -281,7 +281,7 @@ M: x86.32 has-small-reg? { 32 [ drop t ] } } case ; -M: x86.64 has-small-reg? drop t ; +M: x86.64 has-small-reg? 2drop t ; : small-reg-that-isn't ( exclude -- reg' ) [ have-byte-regs ] dip From cd7a1d6c5837215a704a7179a69db7726e603b81 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 30 Jul 2009 08:27:52 -0500 Subject: [PATCH 18/18] Oopsie --- basis/cpu/x86/64/unix/bootstrap.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/cpu/x86/64/unix/bootstrap.factor b/basis/cpu/x86/64/unix/bootstrap.factor index e48a20a9de..b6d56840e2 100644 --- a/basis/cpu/x86/64/unix/bootstrap.factor +++ b/basis/cpu/x86/64/unix/bootstrap.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: bootstrap.image.private kernel namespaces system -cpu.x86.assembler layouts vocabs parser ; +cpu.x86.assembler cpu.x86.assembler.operands layouts vocabs parser ; IN: bootstrap.x86 : stack-frame-size ( -- n ) 4 bootstrap-cells ;