| 
									
										
										
										
											2008-10-22 19:37:47 -04:00
										 |  |  | ! Copyright (C) 2008 Slava Pestov. | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							| 
									
										
										
										
											2008-11-06 07:27:27 -05:00
										 |  |  | USING: accessors kernel math layouts make sequences combinators | 
					
						
							| 
									
										
										
										
											2008-10-22 19:39:41 -04:00
										 |  |  | cpu.architecture namespaces compiler.cfg | 
					
						
							|  |  |  | compiler.cfg.instructions ;
 | 
					
						
							| 
									
										
										
										
											2008-10-22 19:37:47 -04:00
										 |  |  | IN: compiler.cfg.utilities | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-11-06 07:27:27 -05:00
										 |  |  | : value-info-small-fixnum? ( value-info -- ? )
 | 
					
						
							|  |  |  |     literal>> { | 
					
						
							|  |  |  |         { [ dup fixnum? ] [ tag-fixnum small-enough? ] } | 
					
						
							|  |  |  |         [ drop f ] | 
					
						
							|  |  |  |     } cond ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-10-22 19:37:47 -04:00
										 |  |  | : value-info-small-tagged? ( value-info -- ? )
 | 
					
						
							| 
									
										
										
										
											2008-11-06 07:27:27 -05:00
										 |  |  |     dup literal?>> [ | 
					
						
							|  |  |  |         literal>> { | 
					
						
							|  |  |  |             { [ dup fixnum? ] [ tag-fixnum small-enough? ] } | 
					
						
							|  |  |  |             { [ dup not ] [ drop t ] } | 
					
						
							|  |  |  |             [ drop f ] | 
					
						
							|  |  |  |         } cond
 | 
					
						
							|  |  |  |     ] [ drop f ] if ;
 | 
					
						
							| 
									
										
										
										
											2008-10-22 19:37:47 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : set-basic-block ( basic-block -- )
 | 
					
						
							|  |  |  |     [ basic-block set ] [ instructions>> building set ] bi ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : begin-basic-block ( -- )
 | 
					
						
							|  |  |  |     <basic-block> basic-block get [ | 
					
						
							|  |  |  |         dupd successors>> push
 | 
					
						
							|  |  |  |     ] when*
 | 
					
						
							|  |  |  |     set-basic-block ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : end-basic-block ( -- )
 | 
					
						
							|  |  |  |     building off
 | 
					
						
							|  |  |  |     basic-block off ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-11-28 07:36:30 -05:00
										 |  |  | : stop-iterating ( -- next ) end-basic-block f ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-10-22 19:37:47 -04:00
										 |  |  | : emit-primitive ( node -- )
 | 
					
						
							| 
									
										
										
										
											2008-11-03 00:09:31 -05:00
										 |  |  |     word>> ##call ##branch begin-basic-block ;
 |