| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | ! Copyright (C) 2003, 2007 Slava Pestov. | 
					
						
							|  |  |  | ! See http://factorcode.org/license.txt for BSD license. | 
					
						
							|  |  |  | USING: kernel math sequences ;
 | 
					
						
							|  |  |  | IN: io.binary | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-03-08 03:51:26 -05:00
										 |  |  | : le> ( seq -- x ) B{ } like byte-array>bignum >integer ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | : be> ( seq -- x ) <reversed> le> ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : mask-byte ( x -- y ) HEX: ff bitand ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : nth-byte ( x n -- b ) -8 * shift mask-byte ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2009-08-02 19:18:31 -04:00
										 |  |  | : >le ( x n -- byte-array ) iota [ nth-byte ] with B{ } map-as ;
 | 
					
						
							| 
									
										
										
										
											2009-10-28 15:40:15 -04:00
										 |  |  | : >be ( x n -- byte-array ) >le reverse! ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : d>w/w ( d -- w1 w2 )
 | 
					
						
							| 
									
										
										
										
											2009-02-02 00:47:36 -05:00
										 |  |  |     [ HEX: ffffffff bitand ] | 
					
						
							|  |  |  |     [ -32 shift HEX: ffffffff bitand ] bi ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : w>h/h ( w -- h1 h2 )
 | 
					
						
							| 
									
										
										
										
											2009-02-02 00:47:36 -05:00
										 |  |  |     [ HEX: ffff bitand ] | 
					
						
							|  |  |  |     [ -16 shift HEX: ffff bitand ] bi ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : h>b/b ( h -- b1 b2 )
 | 
					
						
							| 
									
										
										
										
											2009-02-02 00:47:36 -05:00
										 |  |  |     [ mask-byte ] | 
					
						
							|  |  |  |     [ -8 shift mask-byte ] bi ;
 | 
					
						
							| 
									
										
										
										
											2009-07-23 16:54:57 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : signed-le> ( bytes -- x )
 | 
					
						
							|  |  |  |     [ le> ] [ length 8 * 1 - 2^ 1 - ] bi
 | 
					
						
							|  |  |  |     2dup > [ bitnot bitor ] [ drop ] if ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : signed-be> ( bytes -- x )
 | 
					
						
							|  |  |  |     <reversed> signed-le> ;
 |