--- /dev/null
+THE CONCATENATIVE LANGUAGE FACTOR
+
+* Introduction
+
+Factor supports various data types; atomic types include numbers of various kinds, strings of characters, and booleans. Compound data types include lists consisting of cons cells, vectors, and string buffers.
+
+Factor encourages programming in a functional style where new objects are returned and input parameters remain unmodified, but does not enforce this. No manifest type declarations are necessary, and all data types use exactly one slot each on the stack (unlike, say, FORTH).
+
+The internal representation of a Factor program is a linked list. Linked lists that are to be executed are referred to as ``quotations.'' The interpreter iterates the list, executing words, and pushing all other types of objects on the data stack. A word is a unique data type because it can be executed. Words come in two varieties: primitive and compound. Primitive words have an implementation coded in the host langauge (C or Java). Compound words are executed by invoking the interpreter recursively on their definition, which is also a linked list.
+
+* Control flow
+
+Control flow rests on two basic concepts: recursion, and branching. Words with compound definitions may refer to themselves, and there is exactly one primitive for performing conditional execution:
+
+ 1 10 < [ "10 is less than 1." print ] [ "whoa!" print ] ifte
+ ==> 10 is less than 1.
+
+Here is an example of a word that uses these two concepts:
+
+: contains? ( element list -- remainder )
+ #! If the proper list contains the element, push the
+ #! remainder of the list, starting from the cell whose car
+ #! is elem. Otherwise push f.
+ dup [
+ 2dup car = [ nip ] [ cdr contains? ] ifte
+ ] [
+ 2drop f
+ ] ifte ;
+
+An example:
+
+ 3 [ 1 2 3 4 ] contains?
+ ==> [ 3 4 ]
+ 5 [ 1 2 3 4 ] contains?
+ ==> f
+
+It recurses down the list, until it reaches the end, in which case the outer ifte's 'false' branch is executed.
+
+A quick overview of the words used here:
+
+Shuffle words:
+
+dup ( x -- x x )
+nip ( x y -- y )
+2dup ( x y -- x y x y )
+2drop ( x y -- )
+
+Linked list deconstruction:
+
+car ( [ x | y ] -- x )
+cdr ( [ x | y ] -- y ) - push the "tail" of a list.
+
+Equality:
+
+= ( x y -- ? )
+
+More complicated control flow constructs, such as loops and higher order functions, are usually built with the help of another primitive that simply executes a quotation at the top of the stack, removing it from the stack:
+
+ [ 2 2 + . ] call
+ ==> 4
+
+Here is an example of a word that applies a quotation to each element of a list. Note that it uses 'call' to execute the given quotation:
+
+: each ( list quotation -- )
+ #! Push each element of a proper list in turn, and apply a
+ #! quotation to each element.
+ #!
+ #! In order to compile, the quotation must consume one more
+ #! value than it produces.
+ over [
+ >r uncons r> tuck >r >r call r> r> each
+ ] [
+ 2drop
+ ] ifte ;
+
+An example:
+
+ [ 1 2 3 4 ] [ dup * . ] each
+ ==> 1
+ 4
+ 9
+ 16
+
+A quick overview of the words used here:
+
+Printing top of stack:
+
+. ( x -- ) print top of stack in a form that is valid Factor syntax.
+
+Shuffle words:
+
+over ( x y -- x y x )
+tuck ( x y -- y x y )
+>r ( x -- r:x ) - move top of data stack to/from 'extra hand'.
+r> ( r:x -- x )
+
+Writing >r foo r> is analogous to [ foo ] in Joy. Occurrences of >r and r> must be balanced within a single word definition.
+
+Linked list deconstruction:
+
+uncons ( [ x | y ] -- x y )
+
+* Variables
+
+* Continuations
+
+* Reflection
+
+upgraded_arithmetic_type -> need a trick\r
+automatic to_bignum, to_fixnum for primitives:\r
+ - upgrading only\r
+generic >fixnum, >bignum in library\r
+ - downgrading\r
+don't crash on bad prim #\r
+fixnum/string pseudo-type for error reporting\r
+to_c_string allots too much\r
+primitive_index_of & index == string->capacity\r
+\r
+ bignums:\r
\r
- cached 0/-1/1 should be cross compiled in image\r
- bignum cross compiling\r
- move some s48_ functions into bignum.c\r
- remove unused functions\r
-- clean up type coercions in arithmetic.c\r
-- add a socket timeout\r
\r
+- add a socket timeout\r
- >lower, >upper for strings\r
- telnetd should use multitasking\r
- accept multi-line input in listener\r
\r
+ docs:\r
\r
-- USE: arithmetic in numbers game\r
+- USE: math in numbers game\r
- numbers section\r
- examples of assoc usage\r
- unparse examples, and difference from prettyprint\r
: profiling-disabled-error ( obj -- )
drop "Recompile with the EXTRA_CALL_INFO flag." print ;
+: negative-array-size-error ( obj -- )
+ "Cannot allocate array with negative size " write . ;
+
: kernel-error. ( obj n -- str )
{
expired-port-error
float-format-error
signal-error
profiling-disabled-error
+ negative-array-size-error
} vector-nth execute ;
: kernel-error? ( obj -- ? )
IN: scratchpad
USE: errors
USE: kernel
+USE: math
USE: namespaces
USE: parser
USE: stack
USE: strings
USE: test
+USE: vectors
! Various things that broke CFactor at various times.
! This should run without issue (and tests nothing useful)
[ drop ] [ drop ] catch
[ drop ] [ drop ] catch
] keep-datastack
+
+"hello" str>sbuf "x" set
+[ -5 "x" get set-sbuf-length ] [ drop ] catch
+"x" get sbuf>str drop
+
+10 <vector> "x" set
+[ -2 "x" get set-vector-length ] [ drop ] catch
+"x" get clone drop
+
+10 [ [ -1000000 <vector> ] [ drop ] catch ] times
+
+10 [ [ -1000000 <sbuf> ] [ drop ] catch ] times
IN: scratchpad
USE: combinators
+USE: errors
USE: kernel
+USE: logic
USE: math
USE: namespaces
USE: stack
"buf" get sbuf>str
] unit-test
] when
+
+[ f ] [ [ 0 10 "hello" substring ] [ not ] catch ] unit-test
}
}
-ARRAY* fixnum_to_bignum(CELL n)
-{
- return s48_long_to_bignum(untag_fixnum_fast(n));
-}
-
-RATIO* fixnum_to_ratio(CELL n)
-{
- return ratio(n,tag_fixnum(1));
-}
-
-FLOAT* fixnum_to_float(CELL n)
-{
- return make_float((double)untag_fixnum_fast(n));
-}
-
-FIXNUM bignum_to_fixnum(CELL tagged)
-{
- return (FIXNUM)s48_bignum_to_long(
- (ARRAY*)UNTAG(tagged));
-}
-
-RATIO* bignum_to_ratio(CELL n)
-{
- return ratio(n,tag_fixnum(1));
-}
-
-FLOAT* bignum_to_float(CELL tagged)
-{
- return make_float(s48_bignum_to_double(
- (ARRAY*)UNTAG(tagged)));
-}
-
-FLOAT* ratio_to_float(CELL tagged)
-{
- RATIO* r = (RATIO*)UNTAG(tagged);
- return (FLOAT*)UNTAG(divfloat(r->numerator,r->denominator));
-}
-
bool realp(CELL tagged)
{
switch(type_of(tagged))
}
}
-bool numberp(CELL tagged)
-{
- return realp(tagged) || type_of(tagged) == COMPLEX_TYPE;
-}
-
void primitive_numberp(void)
{
- drepl(tag_boolean(numberp(dpeek())));
+ CELL tagged = dpeek();
+ drepl(tag_boolean(realp(tagged) || type_of(tagged) == COMPLEX_TYPE));
}
bool zerop(CELL tagged)
#include "factor.h"
CELL upgraded_arithmetic_type(CELL type1, CELL type2);
-ARRAY* fixnum_to_bignum(CELL n);
-RATIO* fixnum_to_ratio(CELL n);
-FLOAT* fixnum_to_float(CELL n);
-FIXNUM bignum_to_fixnum(CELL tagged);
-RATIO* bignum_to_ratio(CELL n);
-FLOAT* bignum_to_float(CELL n);
-FLOAT* ratio_to_float(CELL n);
CELL tag_fixnum_or_bignum(FIXNUM x);
switch(upgraded_arithmetic_type(type_of(x),type_of(y))) \
{ \
case FIXNUM_TYPE: \
- return OP##_fixnum(x,y); \
+ return OP##_fixnum(untag_fixnum_fast(x),untag_fixnum_fast(y)); \
case BIGNUM_TYPE: \
return OP##_bignum(to_bignum(x),to_bignum(y)); \
case RATIO_TYPE: \
switch(type_of(x)) \
{ \
case FIXNUM_TYPE: \
- return OP##_fixnum(x,y); \
+ return OP##_fixnum(untag_fixnum_fast(x),y); \
case BIGNUM_TYPE: \
- return OP##_bignum(to_bignum(x),y); \
+ return OP##_bignum((ARRAY*)UNTAG(x),y); \
default: \
type_error(INTEGER_TYPE,x); \
return F; \
switch(type_of(x)) \
{ \
case FIXNUM_TYPE: \
- return OP##_fixnum(x); \
+ return OP##_fixnum(untag_fixnum_fast(x)); \
case RATIO_TYPE: \
return OP##_ratio((RATIO*)UNTAG(x)); \
case COMPLEX_TYPE: \
}
bool realp(CELL tagged);
-bool numberp(CELL tagged);
void primitive_numberp(void);
bool zerop(CELL tagged);
#include "factor.h"
/* untagged */
-ARRAY* allot_array(CELL type, CELL capacity)
+ARRAY* allot_array(CELL type, FIXNUM capacity)
{
- ARRAY* array = allot_object(type,sizeof(ARRAY) + capacity * CELLS);
+ ARRAY* array;
+ if(capacity < 0)
+ general_error(ERROR_NEGATIVE_ARRAY_SIZE,tag_fixnum(capacity));
+ array = allot_object(type,sizeof(ARRAY) + capacity * CELLS);
array->capacity = capacity;
return array;
}
/* untagged */
-ARRAY* array(CELL capacity, CELL fill)
+ARRAY* array(FIXNUM capacity, CELL fill)
{
int i;
return array;
}
-ARRAY* grow_array(ARRAY* array, CELL capacity, CELL fill)
+ARRAY* grow_array(ARRAY* array, FIXNUM capacity, CELL fill)
{
/* later on, do an optimization: if end of array is here, just grow */
int i;
return new_array;
}
-ARRAY* shrink_array(ARRAY* array, CELL capacity)
+ARRAY* shrink_array(ARRAY* array, FIXNUM capacity)
{
ARRAY* new_array = allot_array(untag_header(array->header),capacity);
memcpy(new_array + 1,array + 1,capacity * CELLS);
return (ARRAY*)UNTAG(tagged);
}
-ARRAY* allot_array(CELL type, CELL capacity);
-ARRAY* array(CELL capacity, CELL fill);
-ARRAY* grow_array(ARRAY* array, CELL capacity, CELL fill);
-ARRAY* shrink_array(ARRAY* array, CELL capacity);
+ARRAY* allot_array(CELL type, FIXNUM capacity);
+ARRAY* array(FIXNUM capacity, CELL fill);
+ARRAY* grow_array(ARRAY* array, FIXNUM capacity, CELL fill);
+ARRAY* shrink_array(ARRAY* array, FIXNUM capacity);
-#define AREF(array,index) ((CELL)array + sizeof(ARRAY) + index * CELLS)
+#define AREF(array,index) ((CELL)(array) + sizeof(ARRAY) + (index) * CELLS)
#define ASIZE(pointer) align8(sizeof(ARRAY) + \
- ((ARRAY*)pointer)->capacity * CELLS)
+ ((ARRAY*)(pointer))->capacity * CELLS)
/* untagged & unchecked */
INLINE CELL array_nth(ARRAY* array, CELL index)
switch(type_of(tagged))
{
case FIXNUM_TYPE:
- return fixnum_to_bignum(tagged);
+ return s48_long_to_bignum(untag_fixnum_fast(tagged));
case BIGNUM_TYPE:
return (ARRAY*)UNTAG(tagged);
case RATIO_TYPE:
#define ERROR_FLOAT_FORMAT (9<<3)
#define ERROR_SIGNAL (10<<3)
#define ERROR_PROFILING_DISABLED (11<<3)
+#define ERROR_NEGATIVE_ARRAY_SIZE (12<<3)
void fatal_error(char* msg, CELL tagged);
void critical_error(char* msg, CELL tagged);
#include "error.h"
#include "gc.h"
#include "types.h"
-#include "array.h"
#include "word.h"
#include "run.h"
#include "fixnum.h"
+#include "array.h"
#include "s48_bignumint.h"
#include "s48_bignum.h"
#include "bignum.h"
case FIXNUM_TYPE:
return untag_fixnum_fast(tagged);
case BIGNUM_TYPE:
- return bignum_to_fixnum(tagged);
+ return (FIXNUM)s48_bignum_to_long((ARRAY*)UNTAG(tagged));
case RATIO_TYPE:
r = (RATIO*)UNTAG(tagged);
return to_fixnum(divint(r->numerator,r->denominator));
drepl(tag_fixnum(to_fixnum(dpeek())));
}
-CELL number_eq_fixnum(CELL x, CELL y)
+CELL number_eq_fixnum(FIXNUM x, FIXNUM y)
{
return tag_boolean(x == y);
}
-CELL add_fixnum(CELL x, CELL y)
+CELL add_fixnum(FIXNUM x, FIXNUM y)
{
- return tag_fixnum_or_bignum(untag_fixnum_fast(x)
- + untag_fixnum_fast(y));
+ return tag_fixnum_or_bignum(x + y);
}
-CELL subtract_fixnum(CELL x, CELL y)
+CELL subtract_fixnum(FIXNUM x, FIXNUM y)
{
- return tag_fixnum_or_bignum(untag_fixnum_fast(x)
- - untag_fixnum_fast(y));
+ return tag_fixnum_or_bignum(x - y);
}
-CELL multiply_fixnum(CELL _x, CELL _y)
+CELL multiply_fixnum(FIXNUM x, FIXNUM y)
{
- FIXNUM x = untag_fixnum_fast(_x);
- FIXNUM y = untag_fixnum_fast(_y);
long long result = (long long)x * (long long)y;
if(result < FIXNUM_MIN || result > FIXNUM_MAX)
- {
- return tag_object(s48_bignum_multiply(
- s48_long_to_bignum(x),
- s48_long_to_bignum(y)));
- }
+ return tag_object(s48_long_long_to_bignum(result));
else
return tag_fixnum(result);
}
-CELL divint_fixnum(CELL x, CELL y)
+CELL divint_fixnum(FIXNUM x, FIXNUM y)
{
- /* division takes common factor of 8 out. */
- /* we have to do SIGNED division here */
- return tag_fixnum_or_bignum((FIXNUM)x / (FIXNUM)y);
+ return tag_fixnum_or_bignum(x / y);
}
-CELL divfloat_fixnum(CELL x, CELL y)
+CELL divfloat_fixnum(FIXNUM x, FIXNUM y)
{
- /* division takes common factor of 8 out. */
- /* we have to do SIGNED division here */
- FIXNUM _x = (FIXNUM)x;
- FIXNUM _y = (FIXNUM)y;
- return tag_object(make_float((double)_x / (double)_y));
+ return tag_object(make_float((double)x / (double)y));
}
-CELL divmod_fixnum(CELL _x, CELL _y)
+CELL divmod_fixnum(FIXNUM x, FIXNUM y)
{
- FIXNUM x = untag_fixnum_fast(_x);
- FIXNUM y = untag_fixnum_fast(_y);
dpush(tag_fixnum_or_bignum(x / y));
return tag_fixnum_or_bignum(x % y);
}
-CELL mod_fixnum(CELL _x, CELL _y)
+CELL mod_fixnum(FIXNUM x, FIXNUM y)
{
- FIXNUM x = untag_fixnum_fast(_x);
- FIXNUM y = untag_fixnum_fast(_y);
return tag_fixnum(x % y);
}
}
}
-CELL divide_fixnum(CELL x, CELL y)
+CELL divide_fixnum(FIXNUM x, FIXNUM y)
{
- FIXNUM _x = untag_fixnum_fast(x);
- FIXNUM _y = untag_fixnum_fast(y);
FIXNUM gcd;
- if(_y == 0)
+ if(y == 0)
raise(SIGFPE);
- else if(_y < 0)
+ else if(y < 0)
{
- _x = -_x;
- _y = -_y;
+ x = -x;
+ y = -y;
}
- gcd = gcd_fixnum(_x,_y);
+ gcd = gcd_fixnum(x,y);
if(gcd != 1)
{
- _x /= gcd;
- _y /= gcd;
+ x /= gcd;
+ y /= gcd;
}
- if(_y == 1)
- return tag_fixnum_or_bignum(_x);
+ if(y == 1)
+ return tag_fixnum_or_bignum(x);
else
{
return tag_ratio(ratio(
- tag_fixnum_or_bignum(_x),
- tag_fixnum_or_bignum(_y)));
+ tag_fixnum_or_bignum(x),
+ tag_fixnum_or_bignum(y)));
}
}
-CELL and_fixnum(CELL x, CELL y)
+CELL and_fixnum(FIXNUM x, FIXNUM y)
{
return x & y;
}
-CELL or_fixnum(CELL x, CELL y)
+CELL or_fixnum(FIXNUM x, FIXNUM y)
{
return x | y;
}
-CELL xor_fixnum(CELL x, CELL y)
+CELL xor_fixnum(FIXNUM x, FIXNUM y)
{
return x ^ y;
}
-CELL shift_fixnum(CELL _x, FIXNUM y)
+CELL shift_fixnum(FIXNUM x, FIXNUM y)
{
- FIXNUM x = untag_fixnum_fast(_x);
if(y > -CELLS * 8 && y < CELLS * 8)
{
long long result = (y < 0
s48_long_to_bignum(x),y));
}
-CELL less_fixnum(CELL x, CELL y)
+CELL less_fixnum(FIXNUM x, FIXNUM y)
{
- return tag_boolean((FIXNUM)x < (FIXNUM)y);
+ return tag_boolean(x < y);
}
-CELL lesseq_fixnum(CELL x, CELL y)
+CELL lesseq_fixnum(FIXNUM x, FIXNUM y)
{
- return tag_boolean((FIXNUM)x <= (FIXNUM)y);
+ return tag_boolean(x <= y);
}
-CELL greater_fixnum(CELL x, CELL y)
+CELL greater_fixnum(FIXNUM x, FIXNUM y)
{
- return tag_boolean((FIXNUM)x > (FIXNUM)y);
+ return tag_boolean(x > y);
}
-CELL greatereq_fixnum(CELL x, CELL y)
+CELL greatereq_fixnum(FIXNUM x, FIXNUM y)
{
- return tag_boolean((FIXNUM)x >= (FIXNUM)y);
+ return tag_boolean(x >= y);
}
-CELL not_fixnum(CELL n)
+CELL not_fixnum(FIXNUM x)
{
- return RETAG(UNTAG(~n),FIXNUM_TYPE);
+ return tag_fixnum(~x);
}
FIXNUM to_fixnum(CELL tagged);
void primitive_to_fixnum(void);
-CELL number_eq_fixnum(CELL x, CELL y);
-CELL add_fixnum(CELL x, CELL y);
-CELL subtract_fixnum(CELL x, CELL y);
-CELL multiply_fixnum(CELL x, CELL y);
+CELL number_eq_fixnum(FIXNUM x, FIXNUM y);
+CELL add_fixnum(FIXNUM x, FIXNUM y);
+CELL subtract_fixnum(FIXNUM x, FIXNUM y);
+CELL multiply_fixnum(FIXNUM x, FIXNUM y);
FIXNUM gcd_fixnum(FIXNUM x, FIXNUM y);
-CELL divide_fixnum(CELL x, CELL y);
-CELL divint_fixnum(CELL x, CELL y);
-CELL divfloat_fixnum(CELL x, CELL y);
-CELL divmod_fixnum(CELL x, CELL y);
-CELL mod_fixnum(CELL x, CELL y);
-CELL and_fixnum(CELL x, CELL y);
-CELL or_fixnum(CELL x, CELL y);
-CELL xor_fixnum(CELL x, CELL y);
-CELL shift_fixnum(CELL x, FIXNUM y);
-CELL less_fixnum(CELL x, CELL y);
-CELL lesseq_fixnum(CELL x, CELL y);
-CELL greater_fixnum(CELL x, CELL y);
-CELL greatereq_fixnum(CELL x, CELL y);
-CELL not_fixnum(CELL n);
+CELL divide_fixnum(FIXNUM x, FIXNUM y);
+CELL divint_fixnum(FIXNUM x, FIXNUM y);
+CELL divfloat_fixnum(FIXNUM x, FIXNUM y);
+CELL divmod_fixnum(FIXNUM x, FIXNUM y);
+CELL mod_fixnum(FIXNUM x, FIXNUM y);
+CELL and_fixnum(FIXNUM x, FIXNUM y);
+CELL or_fixnum(FIXNUM x, FIXNUM y);
+CELL xor_fixnum(FIXNUM x, FIXNUM y);
+CELL shift_fixnum(FIXNUM x, FIXNUM y);
+CELL less_fixnum(FIXNUM x, FIXNUM y);
+CELL lesseq_fixnum(FIXNUM x, FIXNUM y);
+CELL greater_fixnum(FIXNUM x, FIXNUM y);
+CELL greatereq_fixnum(FIXNUM x, FIXNUM y);
+CELL not_fixnum(FIXNUM n);
FLOAT* to_float(CELL tagged)
{
+ RATIO* r;
+
switch(type_of(tagged))
{
case FIXNUM_TYPE:
- return fixnum_to_float(tagged);
+ return make_float((double)untag_fixnum_fast(tagged));
case BIGNUM_TYPE:
- return bignum_to_float(tagged);
+ return make_float(s48_bignum_to_double((ARRAY*)UNTAG(tagged)));
case RATIO_TYPE:
- return ratio_to_float(tagged);
+ r = (RATIO*)UNTAG(tagged);
+ return (FLOAT*)UNTAG(divfloat(r->numerator,r->denominator));
case FLOAT_TYPE:
return (FLOAT*)UNTAG(tagged);
default:
space when a bignum's length is reduced from its original value. */
#define BIGNUM_REDUCE_LENGTH(target, source, length) \
target = shrink_array(source, length + 1)
-extern ARRAY* shrink_array(ARRAY* array, CELL capacity);
+/* extern ARRAY* shrink_array(ARRAY* array, CELL capacity); */
/* BIGNUM_DEALLOCATE is called when disposing of bignums which are
created as intermediate temporaries; Scheme doesn't need this. */
{
SBUF* sbuf = untag_sbuf(dpop());
FIXNUM length = to_fixnum(dpop());
- sbuf->top = length;
if(length < 0)
range_error(tag_object(sbuf),length,sbuf->top);
- else if(length > sbuf->string->capacity)
+ sbuf->top = length;
+ if(length > sbuf->string->capacity)
sbuf->string = grow_string(sbuf->string,length,F);
}
dpush(string_nth(sbuf->string,index));
}
-void sbuf_ensure_capacity(SBUF* sbuf, int top)
+void sbuf_ensure_capacity(SBUF* sbuf, FIXNUM top)
{
STRING* string = sbuf->string;
CELL capacity = string->capacity;
void primitive_sbuf_length(void);
void primitive_set_sbuf_length(void);
void primitive_sbuf_nth(void);
-void sbuf_ensure_capacity(SBUF* sbuf, int top);
+void sbuf_ensure_capacity(SBUF* sbuf, FIXNUM top);
void set_sbuf_nth(SBUF* sbuf, CELL index, CHAR value);
void primitive_set_sbuf_nth(void);
void sbuf_append_string(SBUF* sbuf, STRING* string);
#include "factor.h"
/* untagged */
-STRING* allot_string(CELL capacity)
+STRING* allot_string(FIXNUM capacity)
{
- STRING* string = allot_object(STRING_TYPE,
+ STRING* string;
+ if(capacity < 0)
+ general_error(ERROR_NEGATIVE_ARRAY_SIZE,tag_fixnum(capacity));
+ string = allot_object(STRING_TYPE,
sizeof(STRING) + capacity * CHARS);
string->capacity = capacity;
return string;
}
/* untagged */
-STRING* string(CELL capacity, CELL fill)
+STRING* string(FIXNUM capacity, CELL fill)
{
CELL i;
return string;
}
-STRING* grow_string(STRING* string, CELL capacity, CHAR fill)
+STRING* grow_string(STRING* string, FIXNUM capacity, CHAR fill)
{
/* later on, do an optimization: if end of array is here, just grow */
CELL i;
CELL index_of_ch(CELL index, STRING* string, CELL ch)
{
- if(index < 0)
- range_error(tag_object(string),index,string->capacity);
-
while(index < string->capacity)
{
if(string_nth(string,index) == ch)
if(start < 0)
range_error(tag_object(string),start,string->capacity);
- if(end < start)
+ if(end < start || end > string->capacity)
range_error(tag_object(string),end,string->capacity);
result = allot_string(end - start);
return (STRING*)UNTAG(tagged);
}
-STRING* allot_string(CELL capacity);
-STRING* string(CELL capacity, CELL fill);
+STRING* allot_string(FIXNUM capacity);
+STRING* string(FIXNUM capacity, CELL fill);
void hash_string(STRING* str);
-STRING* grow_string(STRING* string, CELL capacity, CHAR fill);
+STRING* grow_string(STRING* string, FIXNUM capacity, CHAR fill);
char* to_c_string(STRING* s);
STRING* from_c_string(const char* c_string);
switch(untag_header(get(pointer)))
{
case WORD_TYPE:
- return align8(sizeof(WORD));
+ size = sizeof(WORD);
+ break;
case F_TYPE:
case T_TYPE:
size = CELLS * 2;
{
VECTOR* vector = untag_vector(dpop());
FIXNUM length = to_fixnum(dpop());
- vector->top = length;
if(length < 0)
range_error(tag_object(vector),length,vector->top);
- else if(length > vector->array->capacity)
+ vector->top = length;
+ if(length > vector->array->capacity)
vector->array = grow_array(vector->array,length,F);
}
projects / factor.git / commitdiff