Fix some stuff in cpu/ppc, fix bootstrap bug
							parent
							
								
									3e1afe89a3
								
							
						
					
					
						commit
						e7cd1e2ce2
					
				|  | @ -57,6 +57,10 @@ cell 8 = [ | ||||||
| 
 | 
 | ||||||
| [ "ALIEN: 1234" ] [ 1234 <alien> unparse ] unit-test | [ "ALIEN: 1234" ] [ 1234 <alien> unparse ] unit-test | ||||||
| 
 | 
 | ||||||
|  | [ ] [ 0 B{ 1 2 3 } <displaced-alien> drop ] unit-test | ||||||
|  | [ ] [ 0 F{ 1 2 3 } <displaced-alien> drop ] unit-test | ||||||
|  | [ ] [ 0 ?{ t f t } <displaced-alien> drop ] unit-test | ||||||
|  | 
 | ||||||
| [ 0 B{ 1 2 3 } <displaced-alien> alien-address ] unit-test-fails | [ 0 B{ 1 2 3 } <displaced-alien> alien-address ] unit-test-fails | ||||||
| 
 | 
 | ||||||
| [ 1 1 <displaced-alien> ] unit-test-fails | [ 1 1 <displaced-alien> ] unit-test-fails | ||||||
|  |  | ||||||
|  | @ -79,8 +79,7 @@ M: ppc-backend %box-float ( dst src -- ) | ||||||
|     ] with-scope ; |     ] with-scope ; | ||||||
| 
 | 
 | ||||||
| M: ppc-backend %box-alien ( dst src -- ) | M: ppc-backend %box-alien ( dst src -- ) | ||||||
|     "f" define-label |     { "end" "f" } [ define-label ] each | ||||||
|     "end" define-label |  | ||||||
|     0 over v>operand 0 CMPI |     0 over v>operand 0 CMPI | ||||||
|     "f" get BEQ |     "f" get BEQ | ||||||
|     alien 4 cells %allot |     alien 4 cells %allot | ||||||
|  |  | ||||||
|  | @ -690,8 +690,8 @@ define-alien-integer-intrinsics | ||||||
|             { unboxed-c-ptr "alien" simple-c-ptr } |             { unboxed-c-ptr "alien" simple-c-ptr } | ||||||
|             { f "offset" fixnum } |             { f "offset" fixnum } | ||||||
|         } } |         } } | ||||||
|         { +scratch+ { { float "output" } } } |         { +scratch+ { { float "value" } } } | ||||||
|         { +output+ { "output" } } |         { +output+ { "value" } } | ||||||
|         { +clobber+ { "offset" } } |         { +clobber+ { "offset" } } | ||||||
|     } ; |     } ; | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
|  | @ -114,7 +114,7 @@ M: cached live-loc? cached-loc live-loc? ; | ||||||
| M: cached (lazy-load) >r cached-vreg r> (lazy-load) ; | M: cached (lazy-load) >r cached-vreg r> (lazy-load) ; | ||||||
| M: cached lazy-store | M: cached lazy-store | ||||||
|     2dup cached-loc = |     2dup cached-loc = | ||||||
|     [ 2drop f ] [ "live-locs" get at %move ] if ; |     [ 2drop ] [ "live-locs" get at %move ] if ; | ||||||
| M: cached minimal-ds-loc* cached-loc minimal-ds-loc* ; | M: cached minimal-ds-loc* cached-loc minimal-ds-loc* ; | ||||||
| 
 | 
 | ||||||
| INSTANCE: cached value | INSTANCE: cached value | ||||||
|  |  | ||||||
							
								
								
									
										19
									
								
								vm/alien.c
								
								
								
								
							
							
						
						
									
										19
									
								
								vm/alien.c
								
								
								
								
							|  | @ -78,13 +78,26 @@ void box_alien(void *ptr) | ||||||
| DEFINE_PRIMITIVE(displaced_alien) | DEFINE_PRIMITIVE(displaced_alien) | ||||||
| { | { | ||||||
| 	CELL alien = dpop(); | 	CELL alien = dpop(); | ||||||
| 	if(type_of(alien) != F_TYPE && type_of(alien) != ALIEN_TYPE) |  | ||||||
| 		type_error(ALIEN_TYPE,alien); |  | ||||||
| 	CELL displacement = to_cell(dpop()); | 	CELL displacement = to_cell(dpop()); | ||||||
|  | 
 | ||||||
| 	if(alien == F && displacement == 0) | 	if(alien == F && displacement == 0) | ||||||
| 		dpush(F); | 		dpush(F); | ||||||
| 	else | 	else | ||||||
| 		dpush(allot_alien(alien,displacement)); | 	{ | ||||||
|  | 		switch(type_of(alien)) | ||||||
|  | 		{ | ||||||
|  | 		case BYTE_ARRAY_TYPE: | ||||||
|  | 		case BIT_ARRAY_TYPE: | ||||||
|  | 		case FLOAT_ARRAY_TYPE: | ||||||
|  | 		case ALIEN_TYPE: | ||||||
|  | 		case F_TYPE: | ||||||
|  | 			dpush(allot_alien(alien,displacement)); | ||||||
|  | 			break; | ||||||
|  | 		default: | ||||||
|  | 			type_error(ALIEN_TYPE,alien); | ||||||
|  | 			break; | ||||||
|  | 		} | ||||||
|  | 	} | ||||||
| } | } | ||||||
| 
 | 
 | ||||||
| /* address of an object representing a C pointer. Explicitly throw an error
 | /* address of an object representing a C pointer. Explicitly throw an error
 | ||||||
|  |  | ||||||
		Loading…
	
		Reference in New Issue