| 
									
										
										
										
											2010-04-27 10:51:00 -04:00
										 |  |  | ! Copyright (C) 2008, 2010 Slava Pestov. | 
					
						
							| 
									
										
										
										
											2008-07-20 05:24:37 -04:00
										 |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							| 
									
										
										
										
											2015-11-02 12:40:13 -05:00
										 |  |  | USING: accessors compiler.cfg.stack-frame kernel layouts math | 
					
						
							|  |  |  | namespaces vectors ;
 | 
					
						
							| 
									
										
										
										
											2008-07-20 05:24:37 -04:00
										 |  |  | IN: compiler.cfg | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | TUPLE: basic-block < identity-tuple | 
					
						
							| 
									
										
										
										
											2015-04-13 17:22:41 -04:00
										 |  |  |     number
 | 
					
						
							|  |  |  |     { instructions vector } | 
					
						
							|  |  |  |     { successors vector } | 
					
						
							|  |  |  |     { predecessors vector } | 
					
						
							| 
									
										
										
										
											2016-05-02 19:16:50 -04:00
										 |  |  |     { kill-block? boolean } | 
					
						
							| 
									
										
										
										
											2016-09-07 19:58:30 -04:00
										 |  |  |     height | 
					
						
							| 
									
										
										
										
											2016-08-29 06:07:47 -04:00
										 |  |  |     replaces | 
					
						
							|  |  |  |     peeks | 
					
						
							|  |  |  |     kills ;
 | 
					
						
							| 
									
										
										
										
											2008-07-20 05:24:37 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-05-27 19:58:01 -04:00
										 |  |  | : <basic-block> ( -- bb )
 | 
					
						
							| 
									
										
										
										
											2008-07-20 05:24:37 -04:00
										 |  |  |     basic-block new
 | 
					
						
							|  |  |  |         V{ } clone >>instructions | 
					
						
							| 
									
										
										
										
											2008-10-22 19:38:30 -04:00
										 |  |  |         V{ } clone >>successors | 
					
						
							| 
									
										
										
										
											2009-11-10 22:06:36 -05:00
										 |  |  |         V{ } clone >>predecessors ;
 | 
					
						
							| 
									
										
										
										
											2008-07-20 05:24:37 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2015-04-12 23:27:09 -04:00
										 |  |  | TUPLE: cfg | 
					
						
							|  |  |  |     { entry basic-block } | 
					
						
							|  |  |  |     word | 
					
						
							|  |  |  |     label | 
					
						
							|  |  |  |     stack-frame | 
					
						
							|  |  |  |     frame-pointer? | 
					
						
							|  |  |  |     post-order linear-order | 
					
						
							|  |  |  |     predecessors-valid? dominance-valid? loops-valid? ;
 | 
					
						
							| 
									
										
										
										
											2008-11-03 00:09:31 -05:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2015-03-24 12:38:42 -04:00
										 |  |  | : <cfg> ( word label entry -- cfg )
 | 
					
						
							| 
									
										
										
										
											2009-08-07 18:44:50 -04:00
										 |  |  |     cfg new
 | 
					
						
							| 
									
										
										
										
											2015-03-24 12:38:42 -04:00
										 |  |  |         swap >>entry | 
					
						
							| 
									
										
										
										
											2009-08-07 18:44:50 -04:00
										 |  |  |         swap >>label | 
					
						
							| 
									
										
										
										
											2015-04-12 23:27:09 -04:00
										 |  |  |         swap >>word | 
					
						
							| 
									
										
										
										
											2015-11-02 12:40:13 -05:00
										 |  |  |         stack-frame new cell >>spill-area-align >>stack-frame ;
 | 
					
						
							| 
									
										
										
										
											2008-11-03 00:09:31 -05:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-12-10 10:14:08 -05:00
										 |  |  | : cfg-changed ( cfg -- )
 | 
					
						
							| 
									
										
										
										
											2009-08-08 21:02:56 -04:00
										 |  |  |     f >>post-order | 
					
						
							|  |  |  |     f >>linear-order | 
					
						
							|  |  |  |     f >>dominance-valid? | 
					
						
							| 
									
										
										
										
											2014-12-10 10:14:08 -05:00
										 |  |  |     f >>loops-valid? drop ; inline
 | 
					
						
							| 
									
										
										
										
											2009-08-08 21:02:56 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2014-12-10 10:14:08 -05:00
										 |  |  | : predecessors-changed ( cfg -- )
 | 
					
						
							|  |  |  |     f >>predecessors-valid? drop ;
 | 
					
						
							| 
									
										
										
										
											2009-08-08 21:02:56 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2010-03-09 02:38:10 -05:00
										 |  |  | : with-cfg ( ..a cfg quot: ( ..a cfg -- ..b ) -- ..b )
 | 
					
						
							| 
									
										
										
										
											2009-08-08 21:02:56 -04:00
										 |  |  |     [ dup cfg ] dip with-variable ; inline
 | 
					
						
							| 
									
										
										
										
											2015-11-02 12:40:13 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | : local-allot-offset ( n -- offset )
 | 
					
						
							|  |  |  |     cfg get stack-frame>> allot-area-base>> + ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : spill-offset ( n -- offset )
 | 
					
						
							|  |  |  |     cfg get stack-frame>> spill-area-base>> + ;
 |