code cleanups in cfactor

TODO.FACTOR.txt

@@ -22,12 +22,23 @@
 - fix up the min thumb size hack
 - frame gap
 
-+ compiler/ffi:
++ fii:
 
+- replace alien-address, local-alien? primitives with colon defs
+- auto-generate box/unbox, and alien accessors
 - box/unbox_signed/unsigned_8
-- [ [ dup call ] dup call ] infer hangs
 - ffi unicode strings: null char security hole
 - utf16 string boxing
+- value type structs
+- out parameters
+- bitfields in C structs
+- SDL_Rect** type
+- struct membres that are not *
+- FFI float types
+
++ compiler/ffi:
+
+- [ [ dup call ] dup call ] infer hangs
 - more accurate types for various words
 - declarations
 - type inference fails with some assembler words;
@@ -39,12 +50,6 @@
 - the invalid recursion form case needs to be fixed, for inlines too
 - #jump-f #jump-f-label
 - re-introduce #target-label => #target optimization
-- value type structs
-- out parameters
-- bitfields in C structs
-- SDL_Rect** type
-- struct membres that are not *
-- FFI float types
 
 + kernel:
 

native/bignum.c

@@ -25,7 +25,7 @@ CELL to_cell(CELL x)
 			return -1;
 		}
 		else
-			return s48_bignum_to_long(untag_bignum(x));
+			return s48_bignum_to_long(untag_bignum_fast(x));
 	default:
 		type_error(BIGNUM_TYPE,x);
 		return 0;
@@ -65,19 +65,18 @@ void primitive_to_bignum(void)
 	drepl(tag_bignum(to_bignum(dpeek())));
 }
 
-void primitive_bignum_eq(void)
-{
-	F_ARRAY* y = to_bignum(dpop());
-	F_ARRAY* x = to_bignum(dpop());
-	box_boolean(s48_bignum_equal_p(x,y));
-}
-
 #define GC_AND_POP_BIGNUMS(x,y) \
 	F_ARRAY *x, *y; \
 	maybe_garbage_collection(); \
 	y = untag_bignum_fast(dpop()); \
 	x = untag_bignum_fast(dpop());
 
+void primitive_bignum_eq(void)
+{
+	GC_AND_POP_BIGNUMS(x,y);
+	box_boolean(s48_bignum_equal_p(x,y));
+}
+
 void primitive_bignum_add(void)
 {
 	GC_AND_POP_BIGNUMS(x,y);
@@ -205,7 +204,7 @@ void primitive_bignum_not(void)
 {
 	maybe_garbage_collection();
 	drepl(tag_bignum(s48_bignum_bitwise_not(
-		untag_bignum(dpeek()))));
+		untag_bignum_fast(dpeek()))));
 }
 
 void copy_bignum_constants(void)

native/bignum.h

@@ -7,19 +7,11 @@ INLINE F_ARRAY* untag_bignum_fast(CELL tagged)
 	return (F_ARRAY*)UNTAG(tagged);
 }
 
-INLINE F_ARRAY* untag_bignum(CELL tagged)
-{
-	type_check(BIGNUM_TYPE,tagged);
-	return untag_bignum_fast(tagged);
-}
-
 INLINE CELL tag_bignum(F_ARRAY* bignum)
 {
 	return RETAG(bignum,BIGNUM_TYPE);
 }
 
-CELL to_cell(CELL x);
-
 CELL to_cell(CELL x);
 F_ARRAY* to_bignum(CELL tagged);
 void primitive_to_bignum(void);

native/boolean.h

@@ -3,10 +3,5 @@ INLINE CELL tag_boolean(CELL untagged)
 	return (untagged == false ? F : T);
 }
 
-INLINE bool untag_boolean(CELL tagged)
-{
-	return (tagged == F ? false : true);
-}
-
 DLLEXPORT void box_boolean(bool value);
 DLLEXPORT bool unbox_boolean(void);

native/complex.c

@@ -3,14 +3,14 @@
 void primitive_from_rect(void)
 {
 	CELL real, imaginary;
-	F_COMPLEX* complex;
+	F_CONS* complex;
 
 	maybe_garbage_collection();
 
 	imaginary = dpop();
 	real = dpop();
-	complex = allot(sizeof(F_COMPLEX));
-	complex->real = real;
-	complex->imaginary = imaginary;
-	dpush(tag_complex(complex));
+	complex = allot(sizeof(F_CONS));
+	complex->car = real;
+	complex->cdr = imaginary;
+	dpush(RETAG(complex,COMPLEX_TYPE));
 }

native/complex.h

@@ -1,11 +1 @@
-typedef struct {
-	CELL real;
-	CELL imaginary;
-} F_COMPLEX;
-
-INLINE CELL tag_complex(F_COMPLEX* complex)
-{
-	return RETAG(complex,COMPLEX_TYPE);
-}
-
 void primitive_from_rect(void);

native/cons.h

@@ -16,14 +16,4 @@ INLINE CELL tag_cons(F_CONS* cons)
 
 CELL cons(CELL car, CELL cdr);
 
-INLINE CELL car(CELL cons)
-{
-	return untag_cons(cons)->car;
-}
-
-INLINE CELL cdr(CELL cons)
-{
-	return untag_cons(cons)->cdr;
-}
-
 void primitive_cons(void);

native/float.h

@@ -15,12 +15,6 @@ INLINE double untag_float_fast(CELL tagged)
 	return ((F_FLOAT*)UNTAG(tagged))->n;
 }
 
-INLINE double untag_float(CELL tagged)
-{
-	type_check(FLOAT_TYPE,tagged);
-	return untag_float_fast(tagged);
-}
-
 INLINE CELL tag_float(double flo)
 {
 	return RETAG(make_float(flo),FLOAT_TYPE);

native/ratio.c

@@ -14,5 +14,5 @@ void primitive_from_fraction(void)
 	ratio = allot(sizeof(F_RATIO));
 	ratio->numerator = numerator;
 	ratio->denominator = denominator;
-	dpush(tag_ratio(ratio));
+	dpush(RETAG(ratio,RATIO_TYPE));
 }

native/ratio.h

@@ -3,9 +3,4 @@ typedef struct {
 	CELL denominator;
 } F_RATIO;
 
-INLINE CELL tag_ratio(F_RATIO* ratio)
-{
-	return RETAG(ratio,RATIO_TYPE);
-}
-
 void primitive_from_fraction(void);

native/run.c

@@ -100,7 +100,7 @@ void primitive_ifte(void)
 	CELL f = dpop();
 	CELL t = dpop();
 	CELL cond = dpop();
-	call(untag_boolean(cond) ? t : f);
+	call(cond == F ? f : t);
 }
 
 void primitive_getenv(void)

native/types.c

@@ -22,7 +22,7 @@ CELL object_size(CELL pointer)
 		size = sizeof(F_FLOAT);
 		break;
 	case COMPLEX_TYPE:
-		size = sizeof(F_COMPLEX);
+		size = sizeof(F_CONS);
 		break;
 	case OBJECT_TYPE:
 		size = untagged_object_size(UNTAG(pointer));

native/word.c

@@ -39,6 +39,8 @@ void primitive_word_compiledp(void)
 
 void fixup_word(F_WORD* word)
 {
+	/* If this is a compiled word, relocate the code pointer. Otherwise,
+	reset it based on the primitive number of the word. */
 	if(word->xt >= code_relocation_base
 		&& word->xt < code_relocation_base
 		- compiling.base + compiling.limit)