From 6d04bf9c4a230f79ed6c240ee76fcde55a74c0b3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 3 Jun 2009 03:22:27 -0500 Subject: [PATCH 1/6] Linear scan: build live ranges --- basis/compiler/cfg/def-use/def-use.factor | 8 -- .../cfg/linear-scan/linear-scan-tests.factor | 21 +--- .../live-intervals/live-intervals.factor | 106 ++++++++++++++---- 3 files changed, 86 insertions(+), 49 deletions(-) diff --git a/basis/compiler/cfg/def-use/def-use.factor b/basis/compiler/cfg/def-use/def-use.factor index cdd767ef8d..4ff9814e6d 100644 --- a/basis/compiler/cfg/def-use/def-use.factor +++ b/basis/compiler/cfg/def-use/def-use.factor @@ -8,14 +8,6 @@ GENERIC: temp-vregs ( insn -- seq ) GENERIC: uses-vregs ( insn -- seq ) M: ##flushable defs-vregs dst>> 1array ; -M: ##unary/temp defs-vregs dst>> 1array ; -M: ##allot defs-vregs dst>> 1array ; -M: ##slot defs-vregs dst>> 1array ; -M: ##set-slot defs-vregs temp>> 1array ; -M: ##string-nth defs-vregs dst>> 1array ; -M: ##compare defs-vregs dst>> 1array ; -M: ##compare-imm defs-vregs dst>> 1array ; -M: ##compare-float defs-vregs dst>> 1array ; M: insn defs-vregs drop f ; M: ##write-barrier temp-vregs [ card#>> ] [ table>> ] bi 2array ; diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor index 030d8503e9..e0cbe3774f 100644 --- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor +++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor @@ -242,11 +242,12 @@ SYMBOL: max-uses max-insns get [ 0 ] replicate taken set max-insns get [ dup ] H{ } map>assoc available set [ - live-interval new + \ live-interval new swap int-regs swap vreg boa >>vreg max-uses get random 2 max [ not-taken ] replicate natural-sort [ >>uses ] [ first >>start ] bi dup uses>> last >>end + dup [ start>> ] [ end>> ] bi 1vector >>ranges ] map ] with-scope ; @@ -271,24 +272,6 @@ USING: math.private compiler.cfg.debugger ; test-cfg first optimize-cfg linear-scan drop ] unit-test -[ f ] [ - T{ basic-block - { instructions - V{ - T{ ##allot - f - T{ vreg f int-regs 1 } - 40 - array - T{ vreg f int-regs 2 } - f - } - } - } - } clone [ [ clone ] map ] change-instructions - dup 1array (linear-scan) instructions>> first regs>> values all-equal? -] unit-test - [ 0 1 ] [ { T{ live-interval 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 55bcdc7470..78ac9428d8 100644 --- a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor +++ b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor @@ -1,26 +1,56 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: namespaces kernel assocs accessors sequences math fry +USING: namespaces kernel assocs accessors sequences math math.order fry compiler.cfg.instructions compiler.cfg.registers -compiler.cfg.def-use ; +compiler.cfg.def-use compiler.cfg.liveness compiler.cfg ; IN: compiler.cfg.linear-scan.live-intervals +TUPLE: live-range from to ; + +C: live-range + TUPLE: live-interval vreg reg spill-to reload-from split-before split-after -start end uses +start end ranges uses copy-from ; -: add-use ( n live-interval -- ) - dup live-interval? [ "No def" throw ] unless - [ (>>end) ] [ uses>> push ] 2bi ; +ERROR: dead-value-error vreg ; -: ( start vreg -- live-interval ) - live-interval new +: shorten-range ( n live-interval -- ) + dup ranges>> empty? + [ vreg>> dead-value-error ] [ ranges>> last (>>from) ] if ; + +: extend-range ( from to live-range -- ) + ranges>> last + [ max ] change-to + [ min ] change-from + drop ; + +: add-new-range ( from to live-interval -- ) + [ ] dip ranges>> push ; + +: extend-range? ( to live-interval -- ? ) + ranges>> [ drop f ] [ last from>> >= ] if-empty ; + +: add-range ( from to live-interval -- ) + 2dup extend-range? + [ extend-range ] [ add-new-range ] if ; + +: add-use ( n live-interval -- ) + uses>> push ; + +: ( vreg -- live-interval ) + \ live-interval new V{ } clone >>uses - swap >>vreg - over >>start - [ add-use ] keep ; + V{ } clone >>ranges + swap >>vreg ; + +: block-from ( -- n ) + basic-block get instructions>> first insn#>> ; + +: block-to ( -- n ) + basic-block get instructions>> last insn#>> ; M: live-interval hashcode* nip [ start>> ] [ end>> 1000 * ] bi + ; @@ -31,23 +61,31 @@ M: live-interval clone ! Mapping from vreg to live-interval SYMBOL: live-intervals -: new-live-interval ( n vreg live-intervals -- ) - 2dup key? [ - at add-use - ] [ - [ [ ] keep ] dip set-at - ] if ; +: live-interval ( vreg live-intervals -- live-interval ) + [ ] cache ; GENERIC: compute-live-intervals* ( insn -- ) M: insn compute-live-intervals* drop ; +: handle-output ( n vreg live-intervals -- ) + live-interval + [ add-use ] [ shorten-range ] 2bi ; + +: handle-input ( n vreg live-intervals -- ) + live-interval + [ [ block-from ] 2dip add-range ] [ add-use ] 2bi ; + +: handle-temp ( n vreg live-intervals -- ) + live-interval + [ dupd add-range ] [ add-use ] 2bi ; + M: vreg-insn compute-live-intervals* dup insn#>> live-intervals get - [ [ uses-vregs ] 2dip '[ _ swap _ at add-use ] each ] - [ [ defs-vregs ] 2dip '[ _ swap _ new-live-interval ] each ] - [ [ temp-vregs ] 2dip '[ _ swap _ new-live-interval ] each ] + [ [ defs-vregs ] 2dip '[ [ _ ] dip _ handle-output ] each ] + [ [ uses-vregs ] 2dip '[ [ _ ] dip _ handle-input ] each ] + [ [ temp-vregs ] 2dip '[ [ _ ] dip _ handle-temp ] each ] 3tri ; : record-copy ( insn -- ) @@ -59,8 +97,32 @@ M: ##copy compute-live-intervals* M: ##copy-float compute-live-intervals* [ call-next-method ] [ record-copy ] bi ; +: handle-live-out ( bb -- ) + live-out keys block-from block-to live-intervals get '[ + [ _ _ ] dip _ live-interval add-range + ] each ; + +: compute-live-intervals-step ( bb -- ) + [ basic-block set ] + [ handle-live-out ] + [ instructions>> [ compute-live-intervals* ] each ] tri ; + +: compute-start/end ( live-interval -- ) + dup ranges>> [ first from>> ] [ last to>> ] bi + [ >>start ] [ >>end ] bi* drop ; + +: finish-live-intervals ( live-intervals -- ) + ! Since live intervals are computed in a backward order, we have + ! to reverse some sequences, and compute the start and end. + [ + [ ranges>> reverse-here ] + [ uses>> reverse-here ] + [ compute-start/end ] + tri + ] each ; + : compute-live-intervals ( rpo -- live-intervals ) H{ } clone [ live-intervals set - [ instructions>> [ compute-live-intervals* ] each ] each - ] keep values ; + [ compute-live-intervals-step ] each + ] keep values dup finish-live-intervals ; From ade5db24059a6877b3bdfacda2e0a604b900f1fa Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 3 Jun 2009 03:22:46 -0500 Subject: [PATCH 2/6] cpu.x86: fix small register intrinsics on x86-64 --- basis/compiler/tests/codegen.factor | 9 +++++- basis/cpu/x86/x86.factor | 45 +++++++++++++++++++++-------- 2 files changed, 41 insertions(+), 13 deletions(-) diff --git a/basis/compiler/tests/codegen.factor b/basis/compiler/tests/codegen.factor index e0bc917f1c..47c6fa31e7 100644 --- a/basis/compiler/tests/codegen.factor +++ b/basis/compiler/tests/codegen.factor @@ -2,7 +2,7 @@ USING: generalizations accessors arrays compiler kernel kernel.private math hashtables.private math.private namespaces sequences tools.test namespaces.private slots.private sequences.private byte-arrays alien alien.accessors layouts words definitions compiler.units io -combinators vectors grouping make ; +combinators vectors grouping make alien.c-types ; QUALIFIED: namespaces.private IN: compiler.tests.codegen @@ -282,3 +282,10 @@ TUPLE: cucumber ; M: cucumber equal? "The cucumber has no equal" throw ; [ t ] [ [ cucumber ] compile-call cucumber eq? ] unit-test + +[ 4294967295 B{ 255 255 255 255 } -1 ] +[ + -1 -1 + [ [ 0 alien-unsigned-cell swap ] [ 0 alien-signed-2 ] bi ] + compile-call +] unit-test \ No newline at end of file diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index 375ea32940..ef353281e5 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -327,17 +327,29 @@ M:: x86 %box-alien ( dst src temp -- ) "end" resolve-label ] with-scope ; -: small-reg-4 ( reg -- reg' ) +: small-reg-8 ( reg -- reg' ) H{ - { EAX EAX } - { ECX ECX } - { EDX EDX } - { EBX EBX } - { ESP ESP } - { EBP EBP } - { ESI ESP } - { EDI EDI } + { 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 } @@ -373,12 +385,21 @@ M:: x86 %box-alien ( dst src temp -- ) { 1 [ small-reg-1 ] } { 2 [ small-reg-2 ] } { 4 [ small-reg-4 ] } + { 8 [ small-reg-8 ] } } case ; -: small-regs ( -- regs ) { EAX ECX EDX EBX } ; inline +HOOK: small-regs cpu ( -- 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 ; : small-reg-that-isn't ( exclude -- reg' ) - small-regs swap [ small-reg-4 ] map '[ _ memq? not ] find nip ; + small-regs swap [ small-reg-native ] map '[ _ memq? not ] find nip ; : with-save/restore ( reg quot -- ) [ drop PUSH ] [ call ] [ drop POP ] 2tri ; inline @@ -388,7 +409,7 @@ M:: x86 %box-alien ( dst src temp -- ) #! 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-4 small-regs memq? [ dst quot call ] [ + dst small-reg-native small-regs memq? [ dst quot call ] [ exclude small-reg-that-isn't [ quot call ] with-save/restore ] if ; inline From 49f670be05afdf94830c23f2df8cc92d2511c7e9 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 3 Jun 2009 03:23:55 -0500 Subject: [PATCH 3/6] Fix 32-bit bootstrap --- basis/cpu/x86/32/32.factor | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index cf84b083fe..b591b254f8 100755 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -3,10 +3,11 @@ USING: locals alien.c-types alien.syntax arrays kernel math namespaces sequences system layouts io vocabs.loader accessors init combinators command-line cpu.x86.assembler -cpu.x86 cpu.architecture compiler compiler.units +cpu.x86 cpu.architecture make compiler compiler.units compiler.constants compiler.alien compiler.codegen compiler.codegen.fixup compiler.cfg.instructions -compiler.cfg.builder compiler.cfg.intrinsics make ; +compiler.cfg.builder compiler.cfg.intrinsics +compiler.cfg.stack-frame ; IN: cpu.x86.32 ! We implement the FFI for Linux, OS X and Windows all at once. From 6599beefd69a26594faef6d1c376d65f0323a7ff Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 3 Jun 2009 11:02:41 -0500 Subject: [PATCH 4/6] typo in opengl.gl --- basis/opengl/gl/gl.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/basis/opengl/gl/gl.factor b/basis/opengl/gl/gl.factor index 39a8a2c4fe..be457dcd00 100644 --- a/basis/opengl/gl/gl.factor +++ b/basis/opengl/gl/gl.factor @@ -1872,7 +1872,7 @@ GL-FUNCTION: void glUniform4uivEXT { } ( GLint location, GLsizei count, GLuint* GL-FUNCTION: void glGetUniformuivEXT { } ( GLuint program, GLint location, GLuint* params ) ; GL-FUNCTION: void glBindFragDataLocationEXT { } ( GLuint program, GLuint colorNumber, GLchar* name ) ; -GL-FUNCTION: GLint GetFragDataLocationEXT { } ( GLuint program, GLchar* name ) ; +GL-FUNCTION: GLint glGetFragDataLocationEXT { } ( GLuint program, GLchar* name ) ; CONSTANT: GL_VERTEX_ATTRIB_ARRAY_INTEGER_EXT HEX: 88FD CONSTANT: GL_SAMPLER_1D_ARRAY_EXT HEX: 8DC0 From 0169934f6dfdd6ff565ee113588db7841c41a757 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 3 Jun 2009 11:03:34 -0500 Subject: [PATCH 5/6] null-world class for interactive OpenGL use --- basis/ui/gadgets/worlds/worlds.factor | 1 - basis/ui/ui.factor | 5 ++++- extra/ui/gadgets/worlds/null/null.factor | 27 ++++++++++++++++++++++++ 3 files changed, 31 insertions(+), 2 deletions(-) create mode 100644 extra/ui/gadgets/worlds/null/null.factor diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor index 38fb220c69..dfce3d3eee 100755 --- a/basis/ui/gadgets/worlds/worlds.factor +++ b/basis/ui/gadgets/worlds/worlds.factor @@ -217,4 +217,3 @@ M: world check-world-pixel-format : with-world-pixel-format ( world quot -- ) [ dup dup world-pixel-format-attributes ] dip [ 2dup check-world-pixel-format ] prepose with-disposal ; inline - diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor index 144530399c..aee19279a4 100644 --- a/basis/ui/ui.factor +++ b/basis/ui/ui.factor @@ -206,8 +206,11 @@ PRIVATE> : open-world-window ( world -- ) dup pref-dim >>dim dup relayout graft ; +: open-window* ( gadget title/attributes -- window ) + ?attributes [ open-world-window ] keep ; + : open-window ( gadget title/attributes -- ) - ?attributes open-world-window ; + open-window* drop ; : set-fullscreen ( gadget ? -- ) [ find-world ] dip (set-fullscreen) ; diff --git a/extra/ui/gadgets/worlds/null/null.factor b/extra/ui/gadgets/worlds/null/null.factor new file mode 100644 index 0000000000..26fc3e8a94 --- /dev/null +++ b/extra/ui/gadgets/worlds/null/null.factor @@ -0,0 +1,27 @@ +USING: accessors kernel ui ui.backend ui.gadgets +ui.gadgets.worlds ui.pixel-formats ; +IN: ui.gadgets.worlds.null + +TUPLE: null-world < world ; +M: null-world begin-world drop ; +M: null-world end-world drop ; +M: null-world draw-world* drop ; +M: null-world resize-world drop ; +M: null-world pref-dim* drop { 512 512 } ; + +: null-window ( title -- world ) + + swap >>title + null-world >>world-class + { + windowed + double-buffered + backing-store + T{ depth-bits f 24 } + } >>pixel-format-attributes + f swap open-window* ; + +: into-window ( world quot -- world ) + [ dup handle>> ] dip with-gl-context ; inline + + From 469d7af27a11868f17cec75ea628f4fb46064b72 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Wed, 3 Jun 2009 19:55:38 -0500 Subject: [PATCH 6/6] Catch and wrap game-loop errors and send them through the UI when available. much nicer than having to check the console --- extra/game-loop/game-loop.factor | 21 ++++++++++++++++--- .../game-loop/prettyprint/prettyprint.factor | 9 ++++++++ 2 files changed, 27 insertions(+), 3 deletions(-) create mode 100644 extra/game-loop/prettyprint/prettyprint.factor diff --git a/extra/game-loop/game-loop.factor b/extra/game-loop/game-loop.factor index 8abbe6ba25..982319541b 100644 --- a/extra/game-loop/game-loop.factor +++ b/extra/game-loop/game-loop.factor @@ -1,5 +1,5 @@ -USING: accessors calendar destructors kernel math math.order namespaces -system threads ; +USING: accessors calendar continuations destructors kernel math +math.order namespaces system threads ui ui.gadgets.worlds ; IN: game-loop TUPLE: game-loop @@ -27,6 +27,16 @@ SYMBOL: game-loop CONSTANT: MAX-FRAMES-TO-SKIP 5 +DEFER: stop-loop + +TUPLE: game-loop-error game-loop error ; + +: ?ui-error ( error -- ) + ui-running? [ ui-error ] [ rethrow ] if ; + +: game-loop-error ( game-loop error -- ) + [ drop stop-loop ] [ \ game-loop-error boa ?ui-error ] 2bi ; + > - ; @@ -91,3 +103,6 @@ PRIVATE> M: game-loop dispose stop-loop ; +USING: vocabs vocabs.loader ; + +"prettyprint" vocab [ "game-loop.prettyprint" require ] when diff --git a/extra/game-loop/prettyprint/prettyprint.factor b/extra/game-loop/prettyprint/prettyprint.factor new file mode 100644 index 0000000000..8b20dd4c9d --- /dev/null +++ b/extra/game-loop/prettyprint/prettyprint.factor @@ -0,0 +1,9 @@ +! (c)2009 Joe Groff bsd license +USING: accessors debugger game-loop io ; +IN: game-loop.prettyprint + +M: game-loop-error error. + "An error occurred inside a game loop." print + "The game loop has been stopped to prevent runaway errors." print + "The error was:" print nl + error>> error. ;