Merge branch 'master' of git://factorcode.org/git/factor
						commit
						63e5b0d6d8
					
				| 
						 | 
					@ -0,0 +1 @@
 | 
				
			||||||
 | 
					Alaric Snell-Pym
 | 
				
			||||||
| 
						 | 
					@ -0,0 +1,67 @@
 | 
				
			||||||
 | 
					USING: help.markup help.syntax ;
 | 
				
			||||||
 | 
					IN: checksums.fnv1
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					HELP: fnv1-32
 | 
				
			||||||
 | 
					{ $class-description "Fowler-Noll-Vo checksum algorithm, v1, 32-bit." } ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					HELP: fnv1a-32
 | 
				
			||||||
 | 
					{ $class-description "Fowler-Noll-Vo checksum algorithm, v1a, 32-bit." } ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					HELP: fnv1-64
 | 
				
			||||||
 | 
					{ $class-description "Fowler-Noll-Vo checksum algorithm, v1, 64-bit." } ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					HELP: fnv1a-64
 | 
				
			||||||
 | 
					{ $class-description "Fowler-Noll-Vo checksum algorithm, v1a, 64-bit." } ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					HELP: fnv1-128
 | 
				
			||||||
 | 
					{ $class-description "Fowler-Noll-Vo checksum algorithm, v1, 128-bit." } ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					HELP: fnv1a-128
 | 
				
			||||||
 | 
					{ $class-description "Fowler-Noll-Vo checksum algorithm, v1a, 128-bit." } ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					HELP: fnv1-256
 | 
				
			||||||
 | 
					{ $class-description "Fowler-Noll-Vo checksum algorithm, v1, 256-bit." } ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					HELP: fnv1a-256
 | 
				
			||||||
 | 
					{ $class-description "Fowler-Noll-Vo checksum algorithm, v1a, 256-bit." } ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					HELP: fnv1-512
 | 
				
			||||||
 | 
					{ $class-description "Fowler-Noll-Vo checksum algorithm, v1, 512-bit." } ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					HELP: fnv1a-512
 | 
				
			||||||
 | 
					{ $class-description "Fowler-Noll-Vo checksum algorithm, v1a, 512-bit." } ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					HELP: fnv1-1024
 | 
				
			||||||
 | 
					{ $class-description "Fowler-Noll-Vo checksum algorithm, v1, 1024-bit." } ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					HELP: fnv1a-1024
 | 
				
			||||||
 | 
					{ $class-description "Fowler-Noll-Vo checksum algorithm, v1a, 1024-bit." } ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					ARTICLE: "checksums.fnv1" "Fowler-Noll-Vo checksum"
 | 
				
			||||||
 | 
					  "The Fowler-Noll-Vo checksum algorithm is another simple and fast checksum. It comes in 32, 64, 128, 256, 512 and 1024-bit versions, each in 1 and 1a variants. The 1a variants tend to produce a slightly better result. See http://en.wikipedia.org/wiki/Fowler_Noll_Vo_hash for more details."
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  { $subsection fnv1-32 }
 | 
				
			||||||
 | 
					  { $subsection fnv1a-32 }
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  { $subsection fnv1-64 }
 | 
				
			||||||
 | 
					  { $subsection fnv1a-64 }
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  { $subsection fnv1-128 }
 | 
				
			||||||
 | 
					  { $subsection fnv1a-128 }
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  { $subsection fnv1-256 }
 | 
				
			||||||
 | 
					  { $subsection fnv1a-256 }
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  { $subsection fnv1-512 }
 | 
				
			||||||
 | 
					  { $subsection fnv1a-512 }
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  { $subsection fnv1-1024 }
 | 
				
			||||||
 | 
					  { $subsection fnv1a-1024 }
 | 
				
			||||||
 | 
					 ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					ABOUT: "checksums.fnv1"
 | 
				
			||||||
| 
						 | 
					@ -0,0 +1,41 @@
 | 
				
			||||||
 | 
					USING: checksums.fnv1 checksums strings tools.test ;
 | 
				
			||||||
 | 
					IN: checksums.fnv1.tests
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					! A few test vectors taken from http://www.isthe.com/chongo/src/fnv/test_fnv.c
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					[ HEX: 811c9dc5 ] [ "" fnv1-32 checksum-bytes ] unit-test
 | 
				
			||||||
 | 
					[ HEX: 811c9dc5 ] [ "" fnv1a-32 checksum-bytes ] unit-test
 | 
				
			||||||
 | 
					[ HEX: cbf29ce484222325 ] [ "" fnv1-64 checksum-bytes ] unit-test
 | 
				
			||||||
 | 
					[ HEX: cbf29ce484222325 ] [ "" fnv1a-64 checksum-bytes ] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					[ HEX: 050c5d7e ] [ "a" fnv1-32 checksum-bytes ] unit-test
 | 
				
			||||||
 | 
					[ HEX: e40c292c ] [ "a" fnv1a-32 checksum-bytes ] unit-test
 | 
				
			||||||
 | 
					[ HEX: af63bd4c8601b7be ] [ "a" fnv1-64 checksum-bytes ] unit-test
 | 
				
			||||||
 | 
					[ HEX: af63dc4c8601ec8c ] [ "a" fnv1a-64 checksum-bytes ] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					[ HEX: 050c5d7d ] [ "b" fnv1-32 checksum-bytes ] unit-test
 | 
				
			||||||
 | 
					[ HEX: e70c2de5 ] [ "b" fnv1a-32 checksum-bytes ] unit-test
 | 
				
			||||||
 | 
					[ HEX: af63bd4c8601b7bd ] [ "b" fnv1-64 checksum-bytes ] unit-test
 | 
				
			||||||
 | 
					[ HEX: af63df4c8601f1a5 ] [ "b" fnv1a-64 checksum-bytes ] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					[ HEX: 31f0b262 ] [ "foobar" fnv1-32 checksum-bytes ] unit-test
 | 
				
			||||||
 | 
					[ HEX: bf9cf968 ] [ "foobar" fnv1a-32 checksum-bytes ] unit-test
 | 
				
			||||||
 | 
					[ HEX: 340d8765a4dda9c2 ] [ "foobar" fnv1-64 checksum-bytes ] unit-test
 | 
				
			||||||
 | 
					[ HEX: 85944171f73967e8 ] [ "foobar" fnv1a-64 checksum-bytes ] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					! I couldn't find any test vectors for 128, 256, 512, or 1024 versions of FNV1 hashes.
 | 
				
			||||||
 | 
					! So, just to check that your maths works the same as my maths, here's a few samples computed on my laptop.
 | 
				
			||||||
 | 
					! So they may be right or wrong, but either way, them failing is cause for concern somewhere...
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					[ 3897470310 ] [ "Hello, world!" fnv1-32 checksum-bytes ] unit-test
 | 
				
			||||||
 | 
					[ 3985698964 ] [ "Hello, world!" fnv1a-32 checksum-bytes ] unit-test
 | 
				
			||||||
 | 
					[ 7285062107457560934 ] [ "Hello, world!" fnv1-64 checksum-bytes ] unit-test
 | 
				
			||||||
 | 
					[ 4094109891673226228 ] [ "Hello, world!" fnv1a-64 checksum-bytes ] unit-test
 | 
				
			||||||
 | 
					[ 281580511747867177735318995358496831158 ] [ "Hello, world!" fnv1-128 checksum-bytes ] unit-test
 | 
				
			||||||
 | 
					[ 303126633380056630368940439484674414572 ] [ "Hello, world!" fnv1a-128 checksum-bytes ] unit-test
 | 
				
			||||||
 | 
					[ 104295939182568077644846978685759236849634734810631820736486253421270219742822 ] [ "Hello, world!" fnv1-256 checksum-bytes ] unit-test
 | 
				
			||||||
 | 
					[ 9495445728692795332446740615588417456874414534608540692485745371050033741380 ] [ "Hello, world!" fnv1a-256 checksum-bytes ] unit-test
 | 
				
			||||||
 | 
					[ 3577308325596719252093726711895047340166329831006673109476042102918876665433235513101496175651226507162015890004121912850661561110326527625579463564626958 ] [ "Hello, world!" fnv1-512 checksum-bytes ] unit-test
 | 
				
			||||||
 | 
					[ 3577308325596719162840652138474318309664256091923081930027929425092517582111473988451078821416039944023089883981242376700859598441397004715365740906054208 ] [ "Hello, world!" fnv1a-512 checksum-bytes ] unit-test
 | 
				
			||||||
 | 
					[ 52692754922840008511959888105094366091401994235075816792707658326855733053286986999719949898492311786648795846192078757217437117165934438286601534984230194601365788544275827382423366672856972872132009691615382991251544423521887009322211754219117294019951276080952271766377222613325328591830596794468813260226 ] [ "Hello, world!" fnv1-1024 checksum-bytes ] unit-test
 | 
				
			||||||
 | 
					[ 52692754922840008511959888105094366091401994235075816792707658326855804920671100511873485674717442819607149127986090276849364757610838433887624184145636764448608707614141109841761957788887305179569455221243999538336208648824673027111352338809582124430199044921035232455717748500524777795242051756321605065326 ] [ "Hello, world!" fnv1a-1024 checksum-bytes ] unit-test
 | 
				
			||||||
| 
						 | 
					@ -0,0 +1,106 @@
 | 
				
			||||||
 | 
					! Copyright (C) 2009 Alaric Snell-Pym
 | 
				
			||||||
 | 
					! See http://factorcode.org/license.txt for BSD license.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					USING: checksums classes.singleton kernel math math.ranges
 | 
				
			||||||
 | 
					math.vectors sequences ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					IN: checksums.fnv1
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					SINGLETON: fnv1-32
 | 
				
			||||||
 | 
					SINGLETON: fnv1a-32
 | 
				
			||||||
 | 
					SINGLETON: fnv1-64
 | 
				
			||||||
 | 
					SINGLETON: fnv1a-64
 | 
				
			||||||
 | 
					SINGLETON: fnv1-128
 | 
				
			||||||
 | 
					SINGLETON: fnv1a-128
 | 
				
			||||||
 | 
					SINGLETON: fnv1-256
 | 
				
			||||||
 | 
					SINGLETON: fnv1a-256
 | 
				
			||||||
 | 
					SINGLETON: fnv1-512
 | 
				
			||||||
 | 
					SINGLETON: fnv1a-512
 | 
				
			||||||
 | 
					SINGLETON: fnv1-1024
 | 
				
			||||||
 | 
					SINGLETON: fnv1a-1024
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					CONSTANT: fnv1-32-prime 16777619
 | 
				
			||||||
 | 
					CONSTANT: fnv1-64-prime 1099511628211
 | 
				
			||||||
 | 
					CONSTANT: fnv1-128-prime 309485009821345068724781371
 | 
				
			||||||
 | 
					CONSTANT: fnv1-256-prime 374144419156711147060143317175368453031918731002211
 | 
				
			||||||
 | 
					CONSTANT: fnv1-512-prime 35835915874844867368919076489095108449946327955754392558399825615420669938882575126094039892345713852759
 | 
				
			||||||
 | 
					CONSTANT: fnv1-1024-prime 5016456510113118655434598811035278955030765345404790744303017523831112055108147451509157692220295382716162651878526895249385292291816524375083746691371804094271873160484737966720260389217684476157468082573
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					CONSTANT: fnv1-32-mod HEX: ffffffff
 | 
				
			||||||
 | 
					CONSTANT: fnv1-64-mod HEX: ffffffffffffffff
 | 
				
			||||||
 | 
					CONSTANT: fnv1-128-mod HEX: ffffffffffffffffffffffffffffffff
 | 
				
			||||||
 | 
					CONSTANT: fnv1-256-mod HEX: ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
 | 
				
			||||||
 | 
					CONSTANT: fnv1-512-mod HEX: ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
 | 
				
			||||||
 | 
					CONSTANT: fnv1-1024-mod HEX: ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					CONSTANT: fnv1-32-basis HEX: 811c9dc5
 | 
				
			||||||
 | 
					CONSTANT: fnv1-64-basis HEX: cbf29ce484222325
 | 
				
			||||||
 | 
					CONSTANT: fnv1-128-basis HEX: 6c62272e07bb014262b821756295c58d
 | 
				
			||||||
 | 
					CONSTANT: fnv1-256-basis HEX: dd268dbcaac550362d98c384c4e576ccc8b1536847b6bbb31023b4c8caee0535
 | 
				
			||||||
 | 
					CONSTANT: fnv1-512-basis HEX: b86db0b1171f4416dca1e50f309990acac87d059c90000000000000000000d21e948f68a34c192f62ea79bc942dbe7ce182036415f56e34bac982aac4afe9fd9
 | 
				
			||||||
 | 
					CONSTANT: fnv1-1024-basis HEX: 5f7a76758ecc4d32e56d5a591028b74b29fc4223fdada16c3bf34eda3674da9a21d9000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004c6d7eb6e73802734510a555f256cc005ae556bde8cc9c6a93b21aff4b16c71ee90b3
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					M: fnv1-32 checksum-bytes ( bytes checksum -- value )
 | 
				
			||||||
 | 
					    drop
 | 
				
			||||||
 | 
					    fnv1-32-basis swap
 | 
				
			||||||
 | 
					    [ swap fnv1-32-prime * bitxor fnv1-32-mod bitand ] each ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					M: fnv1a-32 checksum-bytes ( bytes checksum -- value )
 | 
				
			||||||
 | 
					    drop
 | 
				
			||||||
 | 
					    fnv1-32-basis swap
 | 
				
			||||||
 | 
					    [ bitxor fnv1-32-prime * fnv1-32-mod bitand ] each ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					M: fnv1-64 checksum-bytes ( bytes checksum -- value )
 | 
				
			||||||
 | 
					    drop
 | 
				
			||||||
 | 
					    fnv1-64-basis swap
 | 
				
			||||||
 | 
					    [ swap fnv1-64-prime * bitxor fnv1-64-mod bitand ] each ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					M: fnv1a-64 checksum-bytes ( bytes checksum -- value )
 | 
				
			||||||
 | 
					    drop
 | 
				
			||||||
 | 
					    fnv1-64-basis swap
 | 
				
			||||||
 | 
					    [ bitxor fnv1-64-prime * fnv1-64-mod bitand ] each ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					M: fnv1-128 checksum-bytes ( bytes checksum -- value )
 | 
				
			||||||
 | 
					    drop
 | 
				
			||||||
 | 
					    fnv1-128-basis swap
 | 
				
			||||||
 | 
					    [ swap fnv1-128-prime * bitxor fnv1-128-mod bitand ] each ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					M: fnv1a-128 checksum-bytes ( bytes checksum -- value )
 | 
				
			||||||
 | 
					    drop
 | 
				
			||||||
 | 
					    fnv1-128-basis swap
 | 
				
			||||||
 | 
					    [ bitxor fnv1-128-prime * fnv1-128-mod bitand ] each ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					M: fnv1-256 checksum-bytes ( bytes checksum -- value )
 | 
				
			||||||
 | 
					    drop
 | 
				
			||||||
 | 
					    fnv1-256-basis swap
 | 
				
			||||||
 | 
					    [ swap fnv1-256-prime * bitxor fnv1-256-mod bitand ] each ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					M: fnv1a-256 checksum-bytes ( bytes checksum -- value )
 | 
				
			||||||
 | 
					    drop
 | 
				
			||||||
 | 
					    fnv1-256-basis swap
 | 
				
			||||||
 | 
					    [ bitxor fnv1-256-prime * fnv1-256-mod bitand ] each ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					M: fnv1-512 checksum-bytes ( bytes checksum -- value )
 | 
				
			||||||
 | 
					    drop
 | 
				
			||||||
 | 
					    fnv1-512-basis swap
 | 
				
			||||||
 | 
					    [ swap fnv1-512-prime * bitxor fnv1-512-mod bitand ] each ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					M: fnv1a-512 checksum-bytes ( bytes checksum -- value )
 | 
				
			||||||
 | 
					    drop
 | 
				
			||||||
 | 
					    fnv1-512-basis swap
 | 
				
			||||||
 | 
					    [ bitxor fnv1-512-prime * fnv1-512-mod bitand ] each ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					M: fnv1-1024 checksum-bytes ( bytes checksum -- value )
 | 
				
			||||||
 | 
					    drop
 | 
				
			||||||
 | 
					    fnv1-1024-basis swap
 | 
				
			||||||
 | 
					    [ swap fnv1-1024-prime * bitxor fnv1-1024-mod bitand ] each ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					M: fnv1a-1024 checksum-bytes ( bytes checksum -- value )
 | 
				
			||||||
 | 
					    drop
 | 
				
			||||||
 | 
					    fnv1-1024-basis swap
 | 
				
			||||||
 | 
					    [ bitxor fnv1-1024-prime * fnv1-1024-mod bitand ] each ;
 | 
				
			||||||
| 
						 | 
					@ -0,0 +1 @@
 | 
				
			||||||
 | 
					Fowler-Noll-Vo checksum algorithm
 | 
				
			||||||
| 
						 | 
					@ -0,0 +1,2 @@
 | 
				
			||||||
 | 
					Slava Pestov
 | 
				
			||||||
 | 
					Daniel Ehrenberg
 | 
				
			||||||
| 
						 | 
					@ -0,0 +1,35 @@
 | 
				
			||||||
 | 
					! Copyright (C) 2009 Daniel Ehrenberg.
 | 
				
			||||||
 | 
					! See http://factorcode.org/license.txt for BSD license.
 | 
				
			||||||
 | 
					USING: kernel tools.test accessors vectors sequences namespaces
 | 
				
			||||||
 | 
					arrays
 | 
				
			||||||
 | 
					cpu.architecture
 | 
				
			||||||
 | 
					compiler.cfg.def-use
 | 
				
			||||||
 | 
					compiler.cfg
 | 
				
			||||||
 | 
					compiler.cfg.debugger
 | 
				
			||||||
 | 
					compiler.cfg.instructions
 | 
				
			||||||
 | 
					compiler.cfg.registers ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					V{
 | 
				
			||||||
 | 
					    T{ ##peek f V int-regs 0 D 0 }
 | 
				
			||||||
 | 
					    T{ ##peek f V int-regs 1 D 0 }
 | 
				
			||||||
 | 
					    T{ ##peek f V int-regs 2 D 0 }
 | 
				
			||||||
 | 
					} 1 test-bb
 | 
				
			||||||
 | 
					V{
 | 
				
			||||||
 | 
					    T{ ##replace f V int-regs 2 D 0 }
 | 
				
			||||||
 | 
					} 2 test-bb
 | 
				
			||||||
 | 
					1 2 edge
 | 
				
			||||||
 | 
					V{
 | 
				
			||||||
 | 
					    T{ ##replace f V int-regs 0 D 0 }
 | 
				
			||||||
 | 
					} 3 test-bb
 | 
				
			||||||
 | 
					2 3 edge
 | 
				
			||||||
 | 
					V{ } 4 test-bb
 | 
				
			||||||
 | 
					V{ } 5 test-bb
 | 
				
			||||||
 | 
					3 { 4 5 } edges
 | 
				
			||||||
 | 
					V{
 | 
				
			||||||
 | 
					    T{ ##phi f V int-regs 2 H{ { 2 V int-regs 0 } { 3 V int-regs 1 } } }
 | 
				
			||||||
 | 
					} 6 test-bb
 | 
				
			||||||
 | 
					4 6 edge
 | 
				
			||||||
 | 
					5 6 edge
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					cfg new 1 get >>entry 0 set
 | 
				
			||||||
 | 
					[ ] [ 0 get [ compute-defs ] [ compute-uses ] bi ] unit-test
 | 
				
			||||||
| 
						 | 
					@ -1,7 +1,7 @@
 | 
				
			||||||
! Copyright (C) 2008, 2009 Slava Pestov.
 | 
					! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg.
 | 
				
			||||||
! See http://factorcode.org/license.txt for BSD license.
 | 
					! See http://factorcode.org/license.txt for BSD license.
 | 
				
			||||||
USING: accessors arrays kernel assocs sequences namespaces fry
 | 
					USING: accessors arrays kernel assocs sequences namespaces fry
 | 
				
			||||||
sets compiler.cfg.rpo compiler.cfg.instructions ;
 | 
					sets compiler.cfg.rpo compiler.cfg.instructions locals ;
 | 
				
			||||||
IN: compiler.cfg.def-use
 | 
					IN: compiler.cfg.def-use
 | 
				
			||||||
 | 
					
 | 
				
			||||||
GENERIC: defs-vreg ( insn -- vreg/f )
 | 
					GENERIC: defs-vreg ( insn -- vreg/f )
 | 
				
			||||||
| 
						 | 
					@ -80,18 +80,15 @@ SYMBOLS: defs insns uses ;
 | 
				
			||||||
        ] each-basic-block
 | 
					        ] each-basic-block
 | 
				
			||||||
    ] keep insns set ;
 | 
					    ] keep insns set ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: compute-uses ( cfg -- )
 | 
					:: compute-uses ( cfg -- )
 | 
				
			||||||
    H{ } clone [
 | 
					    ! Here, a phi node uses its argument in the block that it comes from.
 | 
				
			||||||
        '[
 | 
					    H{ } clone :> use
 | 
				
			||||||
            dup instructions>> [
 | 
					    cfg [| block |
 | 
				
			||||||
                uses-vregs [
 | 
					        block instructions>> [
 | 
				
			||||||
                    _ conjoin-at
 | 
					            dup ##phi?
 | 
				
			||||||
                ] with each
 | 
					            [ inputs>> [ use conjoin-at ] assoc-each ]
 | 
				
			||||||
            ] with each
 | 
					            [ uses-vregs [ block swap use conjoin-at ] each ]
 | 
				
			||||||
        ] each-basic-block
 | 
					            if
 | 
				
			||||||
    ] keep
 | 
					        ] each
 | 
				
			||||||
    [ keys ] assoc-map
 | 
					    ] each-basic-block
 | 
				
			||||||
    uses set ;
 | 
					    use [ keys ] assoc-map uses set ;
 | 
				
			||||||
 | 
					 | 
				
			||||||
: compute-def-use ( cfg -- )
 | 
					 | 
				
			||||||
    [ compute-defs ] [ compute-uses ] [ compute-insns ] tri ;
 | 
					 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -12,6 +12,7 @@ compiler.cfg.liveness.ssa
 | 
				
			||||||
compiler.cfg.ssa.cssa
 | 
					compiler.cfg.ssa.cssa
 | 
				
			||||||
compiler.cfg.ssa.interference
 | 
					compiler.cfg.ssa.interference
 | 
				
			||||||
compiler.cfg.ssa.interference.live-ranges
 | 
					compiler.cfg.ssa.interference.live-ranges
 | 
				
			||||||
 | 
					compiler.cfg.utilities
 | 
				
			||||||
compiler.utilities ;
 | 
					compiler.utilities ;
 | 
				
			||||||
IN: compiler.cfg.ssa.destruction
 | 
					IN: compiler.cfg.ssa.destruction
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -94,11 +95,13 @@ M: insn prepare-insn drop ;
 | 
				
			||||||
    ] each-basic-block ;
 | 
					    ] each-basic-block ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: destruct-ssa ( cfg -- cfg' )
 | 
					: destruct-ssa ( cfg -- cfg' )
 | 
				
			||||||
    dup construct-cssa
 | 
					    dup cfg-has-phis? [
 | 
				
			||||||
    compute-ssa-live-sets
 | 
					        dup construct-cssa
 | 
				
			||||||
    dup compute-defs
 | 
					        dup compute-defs
 | 
				
			||||||
    dup compute-dominance
 | 
					        dup compute-dominance
 | 
				
			||||||
    dup compute-live-ranges
 | 
					        compute-ssa-live-sets
 | 
				
			||||||
    dup prepare-coalescing
 | 
					        dup compute-live-ranges
 | 
				
			||||||
    process-copies
 | 
					        dup prepare-coalescing
 | 
				
			||||||
    dup perform-renaming ;
 | 
					        process-copies
 | 
				
			||||||
 | 
					        dup perform-renaming
 | 
				
			||||||
 | 
					    ] when ;
 | 
				
			||||||
| 
						 | 
					@ -9,7 +9,9 @@ compiler.cfg.ssa.liveness
 | 
				
			||||||
compiler.cfg.debugger
 | 
					compiler.cfg.debugger
 | 
				
			||||||
compiler.cfg.instructions
 | 
					compiler.cfg.instructions
 | 
				
			||||||
compiler.cfg.predecessors
 | 
					compiler.cfg.predecessors
 | 
				
			||||||
compiler.cfg.registers ;
 | 
					compiler.cfg.registers
 | 
				
			||||||
 | 
					compiler.cfg.dominance
 | 
				
			||||||
 | 
					compiler.cfg.def-use ;
 | 
				
			||||||
IN: compiler.cfg.ssa.liveness
 | 
					IN: compiler.cfg.ssa.liveness
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ t ] [ { 1 } 1 only? ] unit-test
 | 
					[ t ] [ { 1 } 1 only? ] unit-test
 | 
				
			||||||
| 
						 | 
					@ -17,85 +19,84 @@ IN: compiler.cfg.ssa.liveness
 | 
				
			||||||
[ f ] [ { 2 1 } 1 only? ] unit-test
 | 
					[ f ] [ { 2 1 } 1 only? ] unit-test
 | 
				
			||||||
[ f ] [ { 2 } 1 only? ] unit-test
 | 
					[ f ] [ { 2 } 1 only? ] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					: test-liveness ( -- )
 | 
				
			||||||
 | 
					    cfg new 0 get >>entry
 | 
				
			||||||
 | 
					    compute-predecessors
 | 
				
			||||||
 | 
					    dup compute-defs
 | 
				
			||||||
 | 
					    dup compute-uses
 | 
				
			||||||
 | 
					    dup compute-dominance
 | 
				
			||||||
 | 
					    precompute-liveness ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
V{
 | 
					V{
 | 
				
			||||||
    T{ ##peek f V int-regs 0 D 0 }
 | 
					    T{ ##peek f V int-regs 0 D 0 }
 | 
				
			||||||
    T{ ##replace f V int-regs 0 D 0 }
 | 
					    T{ ##replace f V int-regs 0 D 0 }
 | 
				
			||||||
    T{ ##replace f V int-regs 1 D 1 }
 | 
					    T{ ##replace f V int-regs 1 D 1 }
 | 
				
			||||||
} 1 test-bb
 | 
					} 0 test-bb
 | 
				
			||||||
 | 
					
 | 
				
			||||||
V{
 | 
					V{
 | 
				
			||||||
    T{ ##replace f V int-regs 2 D 0 }
 | 
					    T{ ##replace f V int-regs 2 D 0 }
 | 
				
			||||||
} 2 test-bb
 | 
					} 1 test-bb
 | 
				
			||||||
 | 
					
 | 
				
			||||||
V{
 | 
					V{
 | 
				
			||||||
    T{ ##replace f V int-regs 3 D 0 }
 | 
					    T{ ##replace f V int-regs 3 D 0 }
 | 
				
			||||||
} 3 test-bb
 | 
					} 2 test-bb
 | 
				
			||||||
 | 
					
 | 
				
			||||||
1 { 2 3 } edges
 | 
					0 { 1 2 } edges
 | 
				
			||||||
 | 
					
 | 
				
			||||||
cfg new 1 get >>entry 4 set
 | 
					[ ] [ test-liveness ] unit-test
 | 
				
			||||||
 | 
					 | 
				
			||||||
[ ] [ 4 get compute-predecessors drop ] unit-test
 | 
					 | 
				
			||||||
[ ] [ 4 get precompute-liveness ] unit-test
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ H{ } ] [ back-edge-targets get ] unit-test
 | 
					[ H{ } ] [ back-edge-targets get ] unit-test
 | 
				
			||||||
[ H{ } ] [ phi-outs get ] unit-test
 | 
					[ t ] [ 0 get R_q { 0 1 2 } [ get ] map unique = ] unit-test
 | 
				
			||||||
[ t ] [ 1 get R_q { 1 2 3 } [ get ] map unique = ] unit-test
 | 
					[ t ] [ 1 get R_q { 1 } [ get ] map unique = ] unit-test
 | 
				
			||||||
[ t ] [ 2 get R_q { 2 } [ get ] map unique = ] unit-test
 | 
					[ t ] [ 2 get R_q { 2 } [ get ] map unique = ] unit-test
 | 
				
			||||||
[ t ] [ 3 get R_q { 3 } [ get ] map unique = ] unit-test
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
: self-T_q ( n -- ? )
 | 
					: self-T_q ( n -- ? )
 | 
				
			||||||
    get [ T_q ] [ 1array unique ] bi = ;
 | 
					    get [ T_q ] [ 1array unique ] bi = ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					[ t ] [ 0 self-T_q ] unit-test
 | 
				
			||||||
[ t ] [ 1 self-T_q ] unit-test
 | 
					[ t ] [ 1 self-T_q ] unit-test
 | 
				
			||||||
[ t ] [ 2 self-T_q ] unit-test
 | 
					[ t ] [ 2 self-T_q ] unit-test
 | 
				
			||||||
[ t ] [ 3 self-T_q ] unit-test
 | 
					
 | 
				
			||||||
 | 
					[ f ] [ V int-regs 0 0 get live-in? ] unit-test
 | 
				
			||||||
 | 
					[ t ] [ V int-regs 1 0 get live-in? ] unit-test
 | 
				
			||||||
 | 
					[ t ] [ V int-regs 2 0 get live-in? ] unit-test
 | 
				
			||||||
 | 
					[ t ] [ V int-regs 3 0 get live-in? ] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					[ f ] [ V int-regs 0 0 get live-out? ] unit-test
 | 
				
			||||||
 | 
					[ f ] [ V int-regs 1 0 get live-out? ] unit-test
 | 
				
			||||||
 | 
					[ t ] [ V int-regs 2 0 get live-out? ] unit-test
 | 
				
			||||||
 | 
					[ t ] [ V int-regs 3 0 get live-out? ] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ f ] [ V int-regs 0 1 get live-in? ] unit-test
 | 
					[ f ] [ V int-regs 0 1 get live-in? ] unit-test
 | 
				
			||||||
[ t ] [ V int-regs 1 1 get live-in? ] unit-test
 | 
					[ f ] [ V int-regs 1 1 get live-in? ] unit-test
 | 
				
			||||||
[ t ] [ V int-regs 2 1 get live-in? ] unit-test
 | 
					[ t ] [ V int-regs 2 1 get live-in? ] unit-test
 | 
				
			||||||
[ t ] [ V int-regs 3 1 get live-in? ] unit-test
 | 
					[ f ] [ V int-regs 3 1 get live-in? ] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ f ] [ V int-regs 0 1 get live-out? ] unit-test
 | 
					[ f ] [ V int-regs 0 1 get live-out? ] unit-test
 | 
				
			||||||
[ f ] [ V int-regs 1 1 get live-out? ] unit-test
 | 
					[ f ] [ V int-regs 1 1 get live-out? ] unit-test
 | 
				
			||||||
[ t ] [ V int-regs 2 1 get live-out? ] unit-test
 | 
					[ f ] [ V int-regs 2 1 get live-out? ] unit-test
 | 
				
			||||||
[ t ] [ V int-regs 3 1 get live-out? ] unit-test
 | 
					[ f ] [ V int-regs 3 1 get live-out? ] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ f ] [ V int-regs 0 2 get live-in? ] unit-test
 | 
					[ f ] [ V int-regs 0 2 get live-in? ] unit-test
 | 
				
			||||||
[ f ] [ V int-regs 1 2 get live-in? ] unit-test
 | 
					[ f ] [ V int-regs 1 2 get live-in? ] unit-test
 | 
				
			||||||
[ t ] [ V int-regs 2 2 get live-in? ] unit-test
 | 
					[ f ] [ V int-regs 2 2 get live-in? ] unit-test
 | 
				
			||||||
[ f ] [ V int-regs 3 2 get live-in? ] unit-test
 | 
					[ t ] [ V int-regs 3 2 get live-in? ] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ f ] [ V int-regs 0 2 get live-out? ] unit-test
 | 
					[ f ] [ V int-regs 0 2 get live-out? ] unit-test
 | 
				
			||||||
[ f ] [ V int-regs 1 2 get live-out? ] unit-test
 | 
					[ f ] [ V int-regs 1 2 get live-out? ] unit-test
 | 
				
			||||||
[ f ] [ V int-regs 2 2 get live-out? ] unit-test
 | 
					[ f ] [ V int-regs 2 2 get live-out? ] unit-test
 | 
				
			||||||
[ f ] [ V int-regs 3 2 get live-out? ] unit-test
 | 
					[ f ] [ V int-regs 3 2 get live-out? ] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ f ] [ V int-regs 0 3 get live-in? ] unit-test
 | 
					 | 
				
			||||||
[ f ] [ V int-regs 1 3 get live-in? ] unit-test
 | 
					 | 
				
			||||||
[ f ] [ V int-regs 2 3 get live-in? ] unit-test
 | 
					 | 
				
			||||||
[ t ] [ V int-regs 3 3 get live-in? ] unit-test
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
[ f ] [ V int-regs 0 3 get live-out? ] unit-test
 | 
					 | 
				
			||||||
[ f ] [ V int-regs 1 3 get live-out? ] unit-test
 | 
					 | 
				
			||||||
[ f ] [ V int-regs 2 3 get live-out? ] unit-test
 | 
					 | 
				
			||||||
[ f ] [ V int-regs 3 3 get live-out? ] unit-test
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
V{ } 0 test-bb
 | 
					V{ } 0 test-bb
 | 
				
			||||||
V{ } 1 test-bb
 | 
					V{ } 1 test-bb
 | 
				
			||||||
V{ } 2 test-bb
 | 
					V{ } 2 test-bb
 | 
				
			||||||
V{ } 3 test-bb
 | 
					V{ } 3 test-bb
 | 
				
			||||||
V int-regs 2
 | 
					V{
 | 
				
			||||||
    2 get V int-regs 0 2array
 | 
					    T{ ##phi f V int-regs 2 H{ { 2 V int-regs 0 } { 3 V int-regs 1 } } }
 | 
				
			||||||
    3 get V int-regs 1 2array
 | 
					} 4 test-bb
 | 
				
			||||||
2array \ ##phi new-insn 1vector
 | 
					 | 
				
			||||||
4 test-bb
 | 
					 | 
				
			||||||
test-diamond
 | 
					test-diamond
 | 
				
			||||||
 | 
					
 | 
				
			||||||
cfg new 1 get >>entry 5 set
 | 
					[ ] [ test-liveness ] unit-test
 | 
				
			||||||
 | 
					 | 
				
			||||||
[ ] [ 5 get compute-predecessors drop ] unit-test
 | 
					 | 
				
			||||||
[ ] [ 5 get precompute-liveness ] unit-test
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ t ] [ V int-regs 0 1 get live-in? ] unit-test
 | 
					[ t ] [ V int-regs 0 1 get live-in? ] unit-test
 | 
				
			||||||
[ t ] [ V int-regs 1 1 get live-in? ] unit-test
 | 
					[ t ] [ V int-regs 1 1 get live-in? ] unit-test
 | 
				
			||||||
| 
						 | 
					@ -109,7 +110,7 @@ cfg new 1 get >>entry 5 set
 | 
				
			||||||
[ f ] [ V int-regs 1 2 get live-in? ] unit-test
 | 
					[ f ] [ V int-regs 1 2 get live-in? ] unit-test
 | 
				
			||||||
[ f ] [ V int-regs 2 2 get live-in? ] unit-test
 | 
					[ f ] [ V int-regs 2 2 get live-in? ] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ t ] [ V int-regs 0 2 get live-out? ] unit-test
 | 
					[ f ] [ V int-regs 0 2 get live-out? ] unit-test
 | 
				
			||||||
[ f ] [ V int-regs 1 2 get live-out? ] unit-test
 | 
					[ f ] [ V int-regs 1 2 get live-out? ] unit-test
 | 
				
			||||||
[ f ] [ V int-regs 2 2 get live-out? ] unit-test
 | 
					[ f ] [ V int-regs 2 2 get live-out? ] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -118,7 +119,7 @@ cfg new 1 get >>entry 5 set
 | 
				
			||||||
[ f ] [ V int-regs 2 3 get live-in? ] unit-test
 | 
					[ f ] [ V int-regs 2 3 get live-in? ] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ f ] [ V int-regs 0 3 get live-out? ] unit-test
 | 
					[ f ] [ V int-regs 0 3 get live-out? ] unit-test
 | 
				
			||||||
[ t ] [ V int-regs 1 3 get live-out? ] unit-test
 | 
					[ f ] [ V int-regs 1 3 get live-out? ] unit-test
 | 
				
			||||||
[ f ] [ V int-regs 2 3 get live-out? ] unit-test
 | 
					[ f ] [ V int-regs 2 3 get live-out? ] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ f ] [ V int-regs 0 4 get live-in? ] unit-test
 | 
					[ f ] [ V int-regs 0 4 get live-in? ] unit-test
 | 
				
			||||||
| 
						 | 
					@ -130,7 +131,9 @@ cfg new 1 get >>entry 5 set
 | 
				
			||||||
[ f ] [ V int-regs 2 4 get live-out? ] unit-test
 | 
					[ f ] [ V int-regs 2 4 get live-out? ] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
! This is the CFG in Figure 3 from the paper
 | 
					! This is the CFG in Figure 3 from the paper
 | 
				
			||||||
 | 
					V{ } 0 test-bb
 | 
				
			||||||
V{ } 1 test-bb
 | 
					V{ } 1 test-bb
 | 
				
			||||||
 | 
					0 1 edge
 | 
				
			||||||
V{ } 2 test-bb
 | 
					V{ } 2 test-bb
 | 
				
			||||||
1 2 edge
 | 
					1 2 edge
 | 
				
			||||||
V{
 | 
					V{
 | 
				
			||||||
| 
						 | 
					@ -162,9 +165,7 @@ V{ } 7 test-bb
 | 
				
			||||||
10 8 edge
 | 
					10 8 edge
 | 
				
			||||||
7 2 edge
 | 
					7 2 edge
 | 
				
			||||||
 | 
					
 | 
				
			||||||
cfg new 1 get >>entry 0 set
 | 
					[ ] [ test-liveness ] unit-test
 | 
				
			||||||
[ ] [ 0 get compute-predecessors drop ] unit-test
 | 
					 | 
				
			||||||
[ ] [ 0 get precompute-liveness ] unit-test
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ t ] [ 1 get R_q 1 11 [a,b] [ get ] map unique = ] unit-test
 | 
					[ t ] [ 1 get R_q 1 11 [a,b] [ get ] map unique = ] unit-test
 | 
				
			||||||
[ t ] [ 2 get R_q 2 11 [a,b] [ get ] map unique = ] unit-test
 | 
					[ t ] [ 2 get R_q 2 11 [a,b] [ get ] map unique = ] unit-test
 | 
				
			||||||
| 
						 | 
					@ -202,8 +203,6 @@ cfg new 1 get >>entry 0 set
 | 
				
			||||||
[ f ] [ 10 get back-edge-target? ] unit-test
 | 
					[ f ] [ 10 get back-edge-target? ] unit-test
 | 
				
			||||||
[ f ] [ 11 get back-edge-target? ] unit-test
 | 
					[ f ] [ 11 get back-edge-target? ] unit-test
 | 
				
			||||||
 | 
					
 | 
				
			||||||
[ f ] [ 1 11 [a,b] [ get phi-outs get at ] any? ] unit-test
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
[ f ] [ V int-regs 0 1 get live-in? ] unit-test
 | 
					[ f ] [ V int-regs 0 1 get live-in? ] unit-test
 | 
				
			||||||
[ f ] [ V int-regs 1 1 get live-in? ] unit-test
 | 
					[ f ] [ V int-regs 1 1 get live-in? ] unit-test
 | 
				
			||||||
[ f ] [ V int-regs 2 1 get live-in? ] unit-test
 | 
					[ f ] [ V int-regs 2 1 get live-in? ] unit-test
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -21,10 +21,6 @@ SYMBOL: R_q-sets
 | 
				
			||||||
! Targets of back edges
 | 
					! Targets of back edges
 | 
				
			||||||
SYMBOL: back-edge-targets
 | 
					SYMBOL: back-edge-targets
 | 
				
			||||||
 | 
					
 | 
				
			||||||
! hashtable of nodes => sets of vregs, where the vregs are inputs
 | 
					 | 
				
			||||||
! to phi nodes in a successor node
 | 
					 | 
				
			||||||
SYMBOL: phi-outs
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
: T_q ( q -- T_q )
 | 
					: T_q ( q -- T_q )
 | 
				
			||||||
    T_q-sets get at ;
 | 
					    T_q-sets get at ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -34,9 +30,6 @@ SYMBOL: phi-outs
 | 
				
			||||||
: back-edge-target? ( block -- ? )
 | 
					: back-edge-target? ( block -- ? )
 | 
				
			||||||
    back-edge-targets get key? ;
 | 
					    back-edge-targets get key? ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: phi-out? ( vreg node -- ? )
 | 
					 | 
				
			||||||
    phi-outs get at key? ;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
: next-R_q ( q -- R_q )
 | 
					: next-R_q ( q -- R_q )
 | 
				
			||||||
    [ ] [ successors>> ] [ number>> ] tri
 | 
					    [ ] [ successors>> ] [ number>> ] tri
 | 
				
			||||||
    '[ number>> _ >= ] filter
 | 
					    '[ number>> _ >= ] filter
 | 
				
			||||||
| 
						 | 
					@ -52,27 +45,14 @@ SYMBOL: phi-outs
 | 
				
			||||||
        [ back-edge-targets get conjoin ] [ drop ] if
 | 
					        [ back-edge-targets get conjoin ] [ drop ] if
 | 
				
			||||||
    ] each ;
 | 
					    ] each ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: set-phi-out ( block vreg -- )
 | 
					 | 
				
			||||||
    swap phi-outs get [ drop H{ } clone ] cache conjoin ;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
: set-phi-outs ( q -- )
 | 
					 | 
				
			||||||
    instructions>> [
 | 
					 | 
				
			||||||
        dup ##phi? [
 | 
					 | 
				
			||||||
            inputs>> [ set-phi-out ] assoc-each
 | 
					 | 
				
			||||||
        ] [ drop ] if
 | 
					 | 
				
			||||||
    ] each ;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
: init-R_q ( -- )
 | 
					: init-R_q ( -- )
 | 
				
			||||||
    H{ } clone R_q-sets set
 | 
					    H{ } clone R_q-sets set
 | 
				
			||||||
    H{ } clone back-edge-targets set
 | 
					    H{ } clone back-edge-targets set ;
 | 
				
			||||||
    H{ } clone phi-outs set ;
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
: compute-R_q ( cfg -- )
 | 
					: compute-R_q ( cfg -- )
 | 
				
			||||||
    init-R_q
 | 
					    init-R_q
 | 
				
			||||||
    post-order [
 | 
					    post-order [
 | 
				
			||||||
        [ set-R_q ]
 | 
					        [ set-R_q ] [ set-back-edges ] bi
 | 
				
			||||||
        [ set-back-edges ]
 | 
					 | 
				
			||||||
        [ set-phi-outs ] tri
 | 
					 | 
				
			||||||
    ] each ;
 | 
					    ] each ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
! This algorithm for computing T_q uses equation (1)
 | 
					! This algorithm for computing T_q uses equation (1)
 | 
				
			||||||
| 
						 | 
					@ -97,32 +77,10 @@ SYMBOL: phi-outs
 | 
				
			||||||
    H{ } T_q-sets set
 | 
					    H{ } T_q-sets set
 | 
				
			||||||
    [ next-T_q drop ] each-basic-block ;
 | 
					    [ next-T_q drop ] each-basic-block ;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
:: compute-phi-uses ( cfg -- )
 | 
					 | 
				
			||||||
    ! Here, a phi node uses its argument in the block that it comes from.
 | 
					 | 
				
			||||||
    H{ } clone :> use
 | 
					 | 
				
			||||||
    cfg [| block |
 | 
					 | 
				
			||||||
        block instructions>> [
 | 
					 | 
				
			||||||
            dup ##phi?
 | 
					 | 
				
			||||||
            [ inputs>> [ use conjoin-at ] assoc-each ]
 | 
					 | 
				
			||||||
            [ uses-vregs [ block swap use conjoin-at ] each ]
 | 
					 | 
				
			||||||
            if
 | 
					 | 
				
			||||||
        ] each
 | 
					 | 
				
			||||||
    ] each-basic-block
 | 
					 | 
				
			||||||
    use [ keys ] assoc-map uses set ;
 | 
					 | 
				
			||||||
 | 
					 | 
				
			||||||
PRIVATE>
 | 
					PRIVATE>
 | 
				
			||||||
 | 
					
 | 
				
			||||||
: precompute-liveness ( cfg -- )
 | 
					: precompute-liveness ( cfg -- )
 | 
				
			||||||
    ! The first three of these depend only on the graph
 | 
					    [ compute-R_q ] [ compute-T_q ] bi ;
 | 
				
			||||||
    ! structure of the CFG, and don't need to be recomputed
 | 
					 | 
				
			||||||
    ! if that doesn't change
 | 
					 | 
				
			||||||
    {
 | 
					 | 
				
			||||||
        [ compute-R_q ]
 | 
					 | 
				
			||||||
        [ compute-T_q ]
 | 
					 | 
				
			||||||
        [ compute-dominance ]
 | 
					 | 
				
			||||||
        [ compute-defs ]
 | 
					 | 
				
			||||||
        [ compute-phi-uses ]
 | 
					 | 
				
			||||||
    } cleave ;
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
<PRIVATE
 | 
					<PRIVATE
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					@ -166,7 +124,6 @@ PRIVATE>
 | 
				
			||||||
    [let | def [ vreg def-of ] |
 | 
					    [let | def [ vreg def-of ] |
 | 
				
			||||||
        {
 | 
					        {
 | 
				
			||||||
            { [ node def eq? ] [ vreg uses-of def only? not ] }
 | 
					            { [ node def eq? ] [ vreg uses-of def only? not ] }
 | 
				
			||||||
            { [ vreg node phi-out? ] [ t ] }
 | 
					 | 
				
			||||||
            { [ def node strictly-dominates? ] [ vreg node (live-out?) ] }
 | 
					            { [ def node strictly-dominates? ] [ vreg node (live-out?) ] }
 | 
				
			||||||
            [ f ]
 | 
					            [ f ]
 | 
				
			||||||
        } cond
 | 
					        } cond
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue