From 32764e80297c4b73a51e127aee46073712a6d903 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 30 Mar 2005 01:34:29 +0000 Subject: [PATCH] code cleanups in cfactor --- TODO.FACTOR.txt | 21 +++++++++++++-------- native/bignum.c | 17 ++++++++--------- native/bignum.h | 8 -------- native/boolean.h | 5 ----- native/complex.c | 10 +++++----- native/complex.h | 10 ---------- native/cons.h | 10 ---------- native/float.h | 6 ------ native/ratio.c | 2 +- native/ratio.h | 5 ----- native/run.c | 2 +- native/types.c | 2 +- native/word.c | 2 ++ 13 files changed, 31 insertions(+), 69 deletions(-) diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt index e105e8c2e3..d7d06ce629 100644 --- a/TODO.FACTOR.txt +++ b/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: diff --git a/native/bignum.c b/native/bignum.c index b462423313..ec465373e3 100644 --- a/native/bignum.c +++ b/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) diff --git a/native/bignum.h b/native/bignum.h index 0896f7032e..c3b0f40637 100644 --- a/native/bignum.h +++ b/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); diff --git a/native/boolean.h b/native/boolean.h index 24452e8155..2e21573738 100644 --- a/native/boolean.h +++ b/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); diff --git a/native/complex.c b/native/complex.c index bf9c207057..abd86cd375 100644 --- a/native/complex.c +++ b/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)); } diff --git a/native/complex.h b/native/complex.h index 247b969659..fbebd2af19 100644 --- a/native/complex.h +++ b/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); diff --git a/native/cons.h b/native/cons.h index e3bc3fae2d..49a566da76 100644 --- a/native/cons.h +++ b/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); diff --git a/native/float.h b/native/float.h index 139fe3ca8e..d8ceae9092 100644 --- a/native/float.h +++ b/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); diff --git a/native/ratio.c b/native/ratio.c index 34ec3bf277..7875373cb6 100644 --- a/native/ratio.c +++ b/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)); } diff --git a/native/ratio.h b/native/ratio.h index 464a675d8d..44d9a9c314 100644 --- a/native/ratio.h +++ b/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); diff --git a/native/run.c b/native/run.c index eaa8ce4cc9..4b196f5336 100644 --- a/native/run.c +++ b/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) diff --git a/native/types.c b/native/types.c index 1f4245f4db..1ef6cd8a0b 100644 --- a/native/types.c +++ b/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)); diff --git a/native/word.c b/native/word.c index ad4d4f677b..0eabdb86b2 100644 --- a/native/word.c +++ b/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)