| 
									
										
										
										
											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 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2013-11-24 12:57:40 -05:00
										 |  |  | : le> ( seq -- x ) 0 [ 8 * shift + ] reduce-index ;
 | 
					
						
							| 
									
										
										
										
											2013-03-21 20:39:34 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2011-10-12 00:13:30 -04:00
										 |  |  | : be> ( seq -- x ) 0 [ [ 8 shift ] dip + ] reduce ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2011-11-23 21:49:33 -05:00
										 |  |  | : mask-byte ( x -- y ) 0xff bitand ; inline
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : nth-byte ( x n -- b ) -8 * shift mask-byte ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2013-03-21 20:39:34 -04:00
										 |  |  | <PRIVATE
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : map-bytes ( x seq -- byte-array )
 | 
					
						
							|  |  |  |     [ nth-byte ] with B{ } map-as ; inline
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | PRIVATE>
 | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2017-06-01 17:59:35 -04:00
										 |  |  | : >le ( x n -- byte-array ) <iota> map-bytes ;
 | 
					
						
							| 
									
										
										
										
											2013-03-21 20:39:34 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2017-06-01 17:59:35 -04:00
										 |  |  | : >be ( x n -- byte-array ) <iota> <reversed> map-bytes ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : d>w/w ( d -- w1 w2 )
 | 
					
						
							| 
									
										
										
										
											2013-03-21 20:39:34 -04:00
										 |  |  |     [ 0xffffffff bitand ] [ -32 shift 0xffffffff bitand ] bi ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : w>h/h ( w -- h1 h2 )
 | 
					
						
							| 
									
										
										
										
											2013-03-21 20:39:34 -04:00
										 |  |  |     [ 0xffff bitand ] [ -16 shift 0xffff bitand ] bi ;
 | 
					
						
							| 
									
										
										
										
											2007-09-20 18:09:08 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : h>b/b ( h -- b1 b2 )
 | 
					
						
							| 
									
										
										
										
											2013-03-21 20:39:34 -04:00
										 |  |  |     [ mask-byte ] [ -8 shift mask-byte ] bi ;
 | 
					
						
							| 
									
										
										
										
											2009-07-23 16:54:57 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2013-11-24 12:57:40 -05:00
										 |  |  | <PRIVATE
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : signed> ( x seq -- n )
 | 
					
						
							| 
									
										
										
										
											2013-11-24 15:01:21 -05:00
										 |  |  |     length 8 * 2dup 1 - bit? [ 2^ - ] [ drop ] if ; inline
 | 
					
						
							| 
									
										
										
										
											2013-11-24 12:57:40 -05:00
										 |  |  | 
 | 
					
						
							|  |  |  | PRIVATE>
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | : signed-le> ( bytes -- x ) [ le> ] [ signed> ] bi ;
 | 
					
						
							| 
									
										
										
										
											2009-07-23 16:54:57 -04:00
										 |  |  | 
 | 
					
						
							| 
									
										
										
										
											2013-11-24 12:57:40 -05:00
										 |  |  | : signed-be> ( bytes -- x ) [ be> ] [ signed> ] bi ;
 |