diff options
| author | Keith Packard <keithp@keithp.com> | 2017-12-14 23:04:39 -0800 | 
|---|---|---|
| committer | Keith Packard <keithp@keithp.com> | 2017-12-14 23:04:39 -0800 | 
| commit | 32f6877288ea6b7eb1cae9a42fbe8e2c5dbb2f08 (patch) | |
| tree | 4e23989a62ae144b8cbf1d2fd135ca8a6bd743dc | |
| parent | 2e11cae044cd2c053049effd76df9c5adecb84d7 (diff) | |
altos/scheme: swap BIGINT and STRING types
This lets BIGINT be a primitive type, allowing it to use all 32 bits
for storage. This does make strings another byte longer, and also
slightly harder to deal with. It's a trade off.
Signed-off-by: Keith Packard <keithp@keithp.com>
| -rw-r--r-- | src/scheme/ao_scheme.h | 82 | ||||
| -rw-r--r-- | src/scheme/ao_scheme_atom.c | 40 | ||||
| -rw-r--r-- | src/scheme/ao_scheme_builtin.c | 55 | ||||
| -rw-r--r-- | src/scheme/ao_scheme_float.c | 4 | ||||
| -rw-r--r-- | src/scheme/ao_scheme_int.c | 17 | ||||
| -rw-r--r-- | src/scheme/ao_scheme_mem.c | 25 | ||||
| -rw-r--r-- | src/scheme/ao_scheme_poly.c | 16 | ||||
| -rw-r--r-- | src/scheme/ao_scheme_read.c | 4 | ||||
| -rw-r--r-- | src/scheme/ao_scheme_string.c | 110 | ||||
| -rw-r--r-- | src/scheme/ao_scheme_vector.c | 11 | 
10 files changed, 220 insertions, 144 deletions
| diff --git a/src/scheme/ao_scheme.h b/src/scheme/ao_scheme.h index ad80db2f..521ec105 100644 --- a/src/scheme/ao_scheme.h +++ b/src/scheme/ao_scheme.h @@ -23,6 +23,7 @@  #include <stdint.h>  #include <string.h> +#include <stdbool.h>  #define AO_SCHEME_BUILTIN_FEATURES  #include "ao_scheme_builtin.h"  #undef AO_SCHEME_BUILTIN_FEATURES @@ -93,7 +94,7 @@ extern uint8_t		ao_scheme_pool[AO_SCHEME_POOL + AO_SCHEME_POOL_EXTRA] __attribut  /* Primitive types */  #define AO_SCHEME_CONS		0  #define AO_SCHEME_INT		1 -#define AO_SCHEME_STRING	2 +#define AO_SCHEME_BIGINT	2  #define AO_SCHEME_OTHER		3  #define AO_SCHEME_TYPE_MASK	0x0003 @@ -109,17 +110,12 @@ extern uint8_t		ao_scheme_pool[AO_SCHEME_POOL + AO_SCHEME_POOL_EXTRA] __attribut  #define AO_SCHEME_LAMBDA	8  #define AO_SCHEME_STACK		9  #define AO_SCHEME_BOOL		10 -#ifdef AO_SCHEME_FEATURE_BIGINT -#define AO_SCHEME_BIGINT	11 -#define _AO_SCHEME_BIGINT	AO_SCHEME_BIGINT -#else -#define _AO_SCHEME_BIGINT	AO_SCHEME_BOOL -#endif +#define AO_SCHEME_STRING	11  #ifdef AO_SCHEME_FEATURE_FLOAT -#define AO_SCHEME_FLOAT		(_AO_SCHEME_BIGINT + 1) +#define AO_SCHEME_FLOAT		12  #define _AO_SCHEME_FLOAT	AO_SCHEME_FLOAT  #else -#define _AO_SCHEME_FLOAT	_AO_SCHEME_BIGINT +#define _AO_SCHEME_FLOAT	12  #endif  #ifdef AO_SCHEME_FEATURE_VECTOR  #define AO_SCHEME_VECTOR	13 @@ -180,6 +176,11 @@ struct ao_scheme_atom {  	char		name[];  }; +struct ao_scheme_string { +	uint8_t		type; +	char		val[]; +}; +  struct ao_scheme_val {  	ao_poly		atom;  	ao_poly		val; @@ -227,38 +228,16 @@ struct ao_scheme_vector {  #define AO_SCHEME_MAX_INT	((1 << (15 - AO_SCHEME_TYPE_SHIFT)) - 1)  #ifdef AO_SCHEME_FEATURE_BIGINT +  struct ao_scheme_bigint {  	uint32_t		value;  }; -#define AO_SCHEME_MIN_BIGINT	(-(1 << 24)) -#define AO_SCHEME_MAX_BIGINT	((1 << 24) - 1) - -#if __BYTE_ORDER == __LITTLE_ENDIAN +#define AO_SCHEME_MIN_BIGINT	INT32_MIN +#define AO_SCHEME_MAX_BIGINT	INT32_MAX -static inline uint32_t -ao_scheme_int_bigint(int32_t i) { -	return AO_SCHEME_BIGINT | (i << 8); -} -static inline int32_t -ao_scheme_bigint_int(uint32_t bi) { -	return (int32_t) bi >> 8; -} -#else -static inline uint32_t -ao_scheme_int_bigint(int32_t i) { -	return (uint32_t) (i & 0xffffff) | (AO_SCHEME_BIGINT << 24); -} -static inlint int32_t -ao_scheme_bigint_int(uint32_t bi) { -	return (int32_t) (bi << 8) >> 8; -} - -#endif	/* __BYTE_ORDER */  #endif	/* AO_SCHEME_FEATURE_BIGINT */ -#define AO_SCHEME_NOT_INTEGER	0x7fffffff -  /* Set on type when the frame escapes the lambda */  #define AO_SCHEME_FRAME_MARK	0x80  #define AO_SCHEME_FRAME_PRINT	0x40 @@ -475,20 +454,20 @@ ao_scheme_poly_bigint(ao_poly poly)  static inline ao_poly  ao_scheme_bigint_poly(struct ao_scheme_bigint *bi)  { -	return ao_scheme_poly(bi, AO_SCHEME_OTHER); +	return ao_scheme_poly(bi, AO_SCHEME_BIGINT);  }  #endif /* AO_SCHEME_FEATURE_BIGINT */ -static inline char * +static inline struct ao_scheme_string *  ao_scheme_poly_string(ao_poly poly)  {  	return ao_scheme_ref(poly);  }  static inline ao_poly -ao_scheme_string_poly(char *s) +ao_scheme_string_poly(struct ao_scheme_string *s)  { -	return ao_scheme_poly(s, AO_SCHEME_STRING); +	return ao_scheme_poly(s, AO_SCHEME_OTHER);  }  static inline struct ao_scheme_atom * @@ -599,9 +578,9 @@ ao_poly  ao_scheme_poly_fetch(int id);  void -ao_scheme_string_stash(int id, char *string); +ao_scheme_string_stash(int id, struct ao_scheme_string *string); -char * +struct ao_scheme_string *  ao_scheme_string_fetch(int id);  static inline void @@ -667,17 +646,23 @@ ao_scheme_cons_copy(struct ao_scheme_cons *cons);  /* string */  extern const struct ao_scheme_type ao_scheme_string_type; -char * -ao_scheme_string_copy(char *a); +struct ao_scheme_string * +ao_scheme_string_copy(struct ao_scheme_string *a); -char * -ao_scheme_string_cat(char *a, char *b); +struct ao_scheme_string * +ao_scheme_string_make(char *a); + +struct ao_scheme_string * +ao_scheme_atom_to_string(struct ao_scheme_atom *a); + +struct ao_scheme_string * +ao_scheme_string_cat(struct ao_scheme_string *a, struct ao_scheme_string *b);  ao_poly  ao_scheme_string_pack(struct ao_scheme_cons *cons);  ao_poly -ao_scheme_string_unpack(char *a); +ao_scheme_string_unpack(struct ao_scheme_string *a);  void  ao_scheme_string_write(ao_poly s); @@ -696,6 +681,9 @@ void  ao_scheme_atom_write(ao_poly a);  struct ao_scheme_atom * +ao_scheme_string_to_atom(struct ao_scheme_string *string); + +struct ao_scheme_atom *  ao_scheme_atom_intern(char *name);  ao_poly * @@ -716,7 +704,7 @@ ao_scheme_int_write(ao_poly i);  #ifdef AO_SCHEME_FEATURE_BIGINT  int32_t -ao_scheme_poly_integer(ao_poly p); +ao_scheme_poly_integer(ao_poly p, bool *fail);  ao_poly  ao_scheme_integer_poly(int32_t i); @@ -734,7 +722,7 @@ extern const struct ao_scheme_type	ao_scheme_bigint_type;  #else -#define ao_scheme_poly_integer ao_scheme_poly_int +#define ao_scheme_poly_integer(a,b) ao_scheme_poly_int(a)  #define ao_scheme_integer_poly ao_scheme_int_poly  static inline int diff --git a/src/scheme/ao_scheme_atom.c b/src/scheme/ao_scheme_atom.c index cb32b7fe..745c32fe 100644 --- a/src/scheme/ao_scheme_atom.c +++ b/src/scheme/ao_scheme_atom.c @@ -71,8 +71,8 @@ const struct ao_scheme_type ao_scheme_atom_type = {  struct ao_scheme_atom	*ao_scheme_atoms; -struct ao_scheme_atom * -ao_scheme_atom_intern(char *name) +static struct ao_scheme_atom * +ao_scheme_atom_find(char *name)  {  	struct ao_scheme_atom	*atom; @@ -86,15 +86,43 @@ ao_scheme_atom_intern(char *name)  			return atom;  	}  #endif -	ao_scheme_string_stash(0, name); -	atom = ao_scheme_alloc(name_size(name)); -	name = ao_scheme_string_fetch(0); +	return NULL; +} + +static void +ao_scheme_atom_init(struct ao_scheme_atom *atom, char *name) +{  	if (atom) {  		atom->type = AO_SCHEME_ATOM; +		strcpy(atom->name, name);  		atom->next = ao_scheme_atom_poly(ao_scheme_atoms);  		ao_scheme_atoms = atom; -		strcpy(atom->name, name);  	} +} + +struct ao_scheme_atom * +ao_scheme_string_to_atom(struct ao_scheme_string *string) +{ +	struct ao_scheme_atom	*atom = ao_scheme_atom_find(string->val); + +	if (atom) +		return atom; +	ao_scheme_string_stash(0, string); +	atom = ao_scheme_alloc(name_size(string->val)); +	string = ao_scheme_string_fetch(0); +	ao_scheme_atom_init(atom, string->val); +	return atom; +} + +struct ao_scheme_atom * +ao_scheme_atom_intern(char *name) +{ +	struct ao_scheme_atom	*atom = ao_scheme_atom_find(name); +	if (atom) +		return atom; + +	atom = ao_scheme_alloc(name_size(name)); +	ao_scheme_atom_init(atom, name);  	return atom;  } diff --git a/src/scheme/ao_scheme_builtin.c b/src/scheme/ao_scheme_builtin.c index b6788993..9a823f6a 100644 --- a/src/scheme/ao_scheme_builtin.c +++ b/src/scheme/ao_scheme_builtin.c @@ -130,10 +130,11 @@ ao_scheme_check_argt(ao_poly name, struct ao_scheme_cons *cons, int argc, int ty  static int32_t  ao_scheme_arg_int(ao_poly name, struct ao_scheme_cons *cons, int argc)  { -	ao_poly p = ao_scheme_arg(cons, argc); -	int32_t	i = ao_scheme_poly_integer(p); +	ao_poly 	p = ao_scheme_arg(cons, argc); +	bool		fail = false; +	int32_t		i = ao_scheme_poly_integer(p, &fail); -	if (i == AO_SCHEME_NOT_INTEGER) +	if (fail)  		(void) ao_scheme_error(AO_SCHEME_INVALID, "%v: arg %d invalid type %v", name, argc, p);  	return i;  } @@ -324,14 +325,14 @@ ao_scheme_math(struct ao_scheme_cons *orig_cons, enum ao_scheme_builtin_id op)  				switch (op) {  				case builtin_minus:  					if (ao_scheme_integer_typep(ct)) -						ret = ao_scheme_integer_poly(-ao_scheme_poly_integer(ret)); +						ret = ao_scheme_integer_poly(-ao_scheme_poly_integer(ret, NULL));  #ifdef AO_SCHEME_FEATURE_FLOAT  					else if (ct == AO_SCHEME_FLOAT)  						ret = ao_scheme_float_get(-ao_scheme_poly_number(ret));  #endif  					break;  				case builtin_divide: -					if (ao_scheme_integer_typep(ct) && ao_scheme_poly_integer(ret) == 1) { +					if (ao_scheme_poly_integer(ret, NULL) == 1) {  					} else {  #ifdef AO_SCHEME_FEATURE_FLOAT  						if (ao_scheme_number_typep(ct)) { @@ -349,8 +350,8 @@ ao_scheme_math(struct ao_scheme_cons *orig_cons, enum ao_scheme_builtin_id op)  			}  			cons = ao_scheme_cons_fetch(0);  		} else if (ao_scheme_integer_typep(rt) && ao_scheme_integer_typep(ct)) { -			int32_t	r = ao_scheme_poly_integer(ret); -			int32_t	c = ao_scheme_poly_integer(car); +			int32_t	r = ao_scheme_poly_integer(ret, NULL); +			int32_t	c = ao_scheme_poly_integer(car, NULL);  #ifdef AO_SCHEME_FEATURE_FLOAT  			int64_t t;  #endif @@ -519,8 +520,8 @@ ao_scheme_compare(struct ao_scheme_cons *cons, enum ao_scheme_builtin_id op)  			uint8_t	lt = ao_scheme_poly_type(left);  			uint8_t	rt = ao_scheme_poly_type(right);  			if (ao_scheme_integer_typep(lt) && ao_scheme_integer_typep(rt)) { -				int32_t l = ao_scheme_poly_integer(left); -				int32_t r = ao_scheme_poly_integer(right); +				int32_t l = ao_scheme_poly_integer(left, NULL); +				int32_t r = ao_scheme_poly_integer(right, NULL);  				switch (op) {  				case builtin_less: @@ -577,8 +578,8 @@ ao_scheme_compare(struct ao_scheme_cons *cons, enum ao_scheme_builtin_id op)  				}  #endif /* AO_SCHEME_FEATURE_FLOAT */  			} else if (lt == AO_SCHEME_STRING && rt == AO_SCHEME_STRING) { -				int c = strcmp(ao_scheme_poly_string(left), -					       ao_scheme_poly_string(right)); +				int c = strcmp(ao_scheme_poly_string(left)->val, +					       ao_scheme_poly_string(right)->val);  				switch (op) {  				case builtin_less:  					if (!(c < 0)) @@ -664,16 +665,16 @@ ao_scheme_do_string_to_list(struct ao_scheme_cons *cons)  ao_poly  ao_scheme_do_string_ref(struct ao_scheme_cons *cons)  { -	char *string; +	char	*string;  	int32_t ref;  	if (!ao_scheme_check_argc(_ao_scheme_atom_string2dref, cons, 2, 2))  		return AO_SCHEME_NIL;  	if (!ao_scheme_check_argt(_ao_scheme_atom_string2dref, cons, 0, AO_SCHEME_STRING, 0))  		return AO_SCHEME_NIL;  	ref = ao_scheme_arg_int(_ao_scheme_atom_string2dref, cons, 1); -	if (ref == AO_SCHEME_NOT_INTEGER) +	if (ao_scheme_exception)  		return AO_SCHEME_NIL; -	string = ao_scheme_poly_string(ao_scheme_arg(cons, 0)); +	string = ao_scheme_poly_string(ao_scheme_arg(cons, 0))->val;  	while (*string && ref) {  		++string;  		--ref; @@ -689,20 +690,20 @@ ao_scheme_do_string_ref(struct ao_scheme_cons *cons)  ao_poly  ao_scheme_do_string_length(struct ao_scheme_cons *cons)  { -	char *string; +	struct ao_scheme_string *string;  	if (!ao_scheme_check_argc(_ao_scheme_atom_string2dlength, cons, 1, 1))  		return AO_SCHEME_NIL;  	if (!ao_scheme_check_argt(_ao_scheme_atom_string2dlength, cons, 0, AO_SCHEME_STRING, 0))  		return AO_SCHEME_NIL;  	string = ao_scheme_poly_string(ao_scheme_arg(cons, 0)); -	return ao_scheme_integer_poly(strlen(string)); +	return ao_scheme_integer_poly(strlen(string->val));  }  ao_poly  ao_scheme_do_string_copy(struct ao_scheme_cons *cons)  { -	char *string; +	struct ao_scheme_string	*string;  	if (!ao_scheme_check_argc(_ao_scheme_atom_string2dcopy, cons, 1, 1))  		return AO_SCHEME_NIL; @@ -715,7 +716,7 @@ ao_scheme_do_string_copy(struct ao_scheme_cons *cons)  ao_poly  ao_scheme_do_string_set(struct ao_scheme_cons *cons)  { -	char *string; +	char	*string;  	int32_t ref;  	int32_t val; @@ -723,12 +724,12 @@ ao_scheme_do_string_set(struct ao_scheme_cons *cons)  		return AO_SCHEME_NIL;  	if (!ao_scheme_check_argt(_ao_scheme_atom_string2dset21, cons, 0, AO_SCHEME_STRING, 0))  		return AO_SCHEME_NIL; -	string = ao_scheme_poly_string(ao_scheme_arg(cons, 0)); +	string = ao_scheme_poly_string(ao_scheme_arg(cons, 0))->val;  	ref = ao_scheme_arg_int(_ao_scheme_atom_string2dset21, cons, 1); -	if (ref == AO_SCHEME_NOT_INTEGER) +	if (ao_scheme_exception)  		return AO_SCHEME_NIL;  	val = ao_scheme_arg_int(_ao_scheme_atom_string2dset21, cons, 2); -	if (val == AO_SCHEME_NOT_INTEGER) +	if (ao_scheme_exception)  		return AO_SCHEME_NIL;  	while (*string && ref) {  		++string; @@ -759,7 +760,7 @@ ao_scheme_do_led(struct ao_scheme_cons *cons)  	if (!ao_scheme_check_argc(_ao_scheme_atom_led, cons, 1, 1))  		return AO_SCHEME_NIL;  	led = ao_scheme_arg_int(_ao_scheme_atom_led, cons, 0); -	if (led == AO_SCHEME_NOT_INTEGER) +	if (ao_scheme_exception)  		return AO_SCHEME_NIL;  	led = ao_scheme_arg(cons, 0);  	ao_scheme_os_led(ao_scheme_poly_int(led)); @@ -774,7 +775,7 @@ ao_scheme_do_delay(struct ao_scheme_cons *cons)  	if (!ao_scheme_check_argc(_ao_scheme_atom_delay, cons, 1, 1))  		return AO_SCHEME_NIL;  	delay = ao_scheme_arg_int(_ao_scheme_atom_delay, cons, 0); -	if (delay == AO_SCHEME_NOT_INTEGER) +	if (ao_scheme_exception)  		return AO_SCHEME_NIL;  	ao_scheme_os_delay(delay);  	return delay; @@ -978,7 +979,7 @@ ao_scheme_do_symbol_to_string(struct ao_scheme_cons *cons)  		return AO_SCHEME_NIL;  	if (!ao_scheme_check_argt(_ao_scheme_atom_led, cons, 0, AO_SCHEME_ATOM, 0))  		return AO_SCHEME_NIL; -	return ao_scheme_string_poly(ao_scheme_string_copy(ao_scheme_poly_atom(ao_scheme_arg(cons, 0))->name)); +	return ao_scheme_string_poly(ao_scheme_atom_to_string(ao_scheme_poly_atom(ao_scheme_arg(cons, 0))));  }  ao_poly @@ -989,7 +990,7 @@ ao_scheme_do_string_to_symbol(struct ao_scheme_cons *cons)  	if (!ao_scheme_check_argt(_ao_scheme_atom_led, cons, 0, AO_SCHEME_STRING, 0))  		return AO_SCHEME_NIL; -	return ao_scheme_atom_poly(ao_scheme_atom_intern(ao_scheme_poly_string(ao_scheme_arg(cons, 0)))); +	return ao_scheme_atom_poly(ao_scheme_string_to_atom(ao_scheme_poly_string(ao_scheme_arg(cons, 0))));;  }  ao_poly @@ -1009,7 +1010,7 @@ ao_scheme_do_write_char(struct ao_scheme_cons *cons)  		return AO_SCHEME_NIL;  	if (!ao_scheme_check_argt(_ao_scheme_atom_led, cons, 0, AO_SCHEME_INT, 0))  		return AO_SCHEME_NIL; -	putchar(ao_scheme_poly_integer(ao_scheme_arg(cons, 0))); +	putchar(ao_scheme_poly_integer(ao_scheme_arg(cons, 0), NULL));  	return _ao_scheme_bool_true;  } @@ -1068,7 +1069,7 @@ ao_scheme_do_make_vector(struct ao_scheme_cons *cons)  	if (!ao_scheme_check_argc(_ao_scheme_atom_make2dvector, cons, 2, 2))  		return AO_SCHEME_NIL;  	k = ao_scheme_arg_int(_ao_scheme_atom_make2dvector, cons, 0); -	if (k == AO_SCHEME_NOT_INTEGER) +	if (ao_scheme_exception)  		return AO_SCHEME_NIL;  	return ao_scheme_vector_poly(ao_scheme_vector_alloc(k, ao_scheme_arg(cons, 1)));  } diff --git a/src/scheme/ao_scheme_float.c b/src/scheme/ao_scheme_float.c index c026c6fb..b75289d7 100644 --- a/src/scheme/ao_scheme_float.c +++ b/src/scheme/ao_scheme_float.c @@ -69,10 +69,10 @@ ao_scheme_poly_number(ao_poly p)  	switch (ao_scheme_poly_base_type(p)) {  	case AO_SCHEME_INT:  		return ao_scheme_poly_int(p); +	case AO_SCHEME_BIGINT: +		return ao_scheme_poly_bigint(p)->value;  	case AO_SCHEME_OTHER:  		switch (ao_scheme_other_type(ao_scheme_poly_other(p))) { -		case AO_SCHEME_BIGINT: -			return ao_scheme_bigint_int(ao_scheme_poly_bigint(p)->value);  		case AO_SCHEME_FLOAT:  			return ao_scheme_poly_float(p)->value;  		} diff --git a/src/scheme/ao_scheme_int.c b/src/scheme/ao_scheme_int.c index 43d6b8e1..4fcf4931 100644 --- a/src/scheme/ao_scheme_int.c +++ b/src/scheme/ao_scheme_int.c @@ -24,16 +24,19 @@ ao_scheme_int_write(ao_poly p)  #ifdef AO_SCHEME_FEATURE_BIGINT  int32_t -ao_scheme_poly_integer(ao_poly p) +ao_scheme_poly_integer(ao_poly p, bool *fail)  { +	if (fail) +		*fail = false;  	switch (ao_scheme_poly_base_type(p)) {  	case AO_SCHEME_INT:  		return ao_scheme_poly_int(p); -	case AO_SCHEME_OTHER: -		if (ao_scheme_other_type(ao_scheme_poly_other(p)) == AO_SCHEME_BIGINT) -			return ao_scheme_bigint_int(ao_scheme_poly_bigint(p)->value); +	case AO_SCHEME_BIGINT: +		return ao_scheme_poly_bigint(p)->value;  	} -	return AO_SCHEME_NOT_INTEGER; +	if (fail) +		*fail = true; +	return 0;  }  ao_poly @@ -44,7 +47,7 @@ ao_scheme_integer_poly(int32_t p)  	if (AO_SCHEME_MIN_INT <= p && p <= AO_SCHEME_MAX_INT)  		return ao_scheme_int_poly(p);  	bi = ao_scheme_alloc(sizeof (struct ao_scheme_bigint)); -	bi->value = ao_scheme_int_bigint(p); +	bi->value = p;  	return ao_scheme_bigint_poly(bi);  } @@ -77,6 +80,6 @@ ao_scheme_bigint_write(ao_poly p)  {  	struct ao_scheme_bigint	*bi = ao_scheme_poly_bigint(p); -	printf("%d", ao_scheme_bigint_int(bi->value)); +	printf("%d", bi->value);  }  #endif /* AO_SCHEME_FEATURE_BIGINT */ diff --git a/src/scheme/ao_scheme_mem.c b/src/scheme/ao_scheme_mem.c index afa06d54..e7e89b89 100644 --- a/src/scheme/ao_scheme_mem.c +++ b/src/scheme/ao_scheme_mem.c @@ -178,7 +178,7 @@ struct ao_scheme_root {  };  static struct ao_scheme_cons 	*save_cons[2]; -static char			*save_string[2]; +static struct ao_scheme_string	*save_string[2];  static struct ao_scheme_frame	*save_frame[1];  static ao_poly			save_poly[3]; @@ -488,7 +488,9 @@ dump_busy(void)  static const struct ao_scheme_type * const ao_scheme_types[AO_SCHEME_NUM_TYPE] = {  	[AO_SCHEME_CONS] = &ao_scheme_cons_type,  	[AO_SCHEME_INT] = NULL, -	[AO_SCHEME_STRING] = &ao_scheme_string_type, +#ifdef AO_SCHEME_FEATURE_BIGINT +	[AO_SCHEME_BIGINT] = &ao_scheme_bigint_type, +#endif  	[AO_SCHEME_OTHER] = (void *) 0x1,  	[AO_SCHEME_ATOM] = &ao_scheme_atom_type,  	[AO_SCHEME_BUILTIN] = &ao_scheme_builtin_type, @@ -497,9 +499,7 @@ static const struct ao_scheme_type * const ao_scheme_types[AO_SCHEME_NUM_TYPE] =  	[AO_SCHEME_LAMBDA] = &ao_scheme_lambda_type,  	[AO_SCHEME_STACK] = &ao_scheme_stack_type,  	[AO_SCHEME_BOOL] = &ao_scheme_bool_type, -#ifdef AO_SCHEME_FEATURE_BIGINT -	[AO_SCHEME_BIGINT] = &ao_scheme_bigint_type, -#endif +	[AO_SCHEME_STRING] = &ao_scheme_string_type,  #ifdef AO_SCHEME_FEATURE_FLOAT  	[AO_SCHEME_FLOAT] = &ao_scheme_float_type,  #endif @@ -533,6 +533,7 @@ uint64_t ao_scheme_loops[2];  #endif  int ao_scheme_last_top; +int ao_scheme_collect_counts;  int  ao_scheme_collect(uint8_t style) @@ -556,6 +557,14 @@ ao_scheme_collect(uint8_t style)  	if (ao_scheme_last_top == 0)  		style = AO_SCHEME_COLLECT_FULL; +	/* One in a while, just do a full collect */ + +	if (ao_scheme_collect_counts >= 128) +		style = AO_SCHEME_COLLECT_FULL; + +	if (style == AO_SCHEME_COLLECT_FULL) +		ao_scheme_collect_counts = 0; +  	/* Clear references to all caches */  	for (i = 0; i < (int) AO_SCHEME_CACHE; i++)  		*ao_scheme_cache[i] = NULL; @@ -984,16 +993,16 @@ ao_scheme_poly_fetch(int id)  }  void -ao_scheme_string_stash(int id, char *string) +ao_scheme_string_stash(int id, struct ao_scheme_string *string)  {  	assert(save_string[id] == NULL);  	save_string[id] = string;  } -char * +struct ao_scheme_string *  ao_scheme_string_fetch(int id)  { -	char *string = save_string[id]; +	struct ao_scheme_string *string = save_string[id];  	save_string[id] = NULL;  	return string;  } diff --git a/src/scheme/ao_scheme_poly.c b/src/scheme/ao_scheme_poly.c index 0bb427b9..2ea221ec 100644 --- a/src/scheme/ao_scheme_poly.c +++ b/src/scheme/ao_scheme_poly.c @@ -24,10 +24,12 @@ static const struct ao_scheme_funcs ao_scheme_funcs[AO_SCHEME_NUM_TYPE] = {  		.write = ao_scheme_cons_write,  		.display = ao_scheme_cons_display,  	}, -	[AO_SCHEME_STRING] = { -		.write = ao_scheme_string_write, -		.display = ao_scheme_string_display, +#ifdef AO_SCHEME_FEATURE_BIGINT +	[AO_SCHEME_BIGINT] = { +		.write = ao_scheme_bigint_write, +		.display = ao_scheme_bigint_write,  	}, +#endif  	[AO_SCHEME_INT] = {  		.write = ao_scheme_int_write,  		.display = ao_scheme_int_write, @@ -60,12 +62,10 @@ static const struct ao_scheme_funcs ao_scheme_funcs[AO_SCHEME_NUM_TYPE] = {  		.write = ao_scheme_bool_write,  		.display = ao_scheme_bool_write,  	}, -#ifdef AO_SCHEME_FEATURE_BIGINT -	[AO_SCHEME_BIGINT] = { -		.write = ao_scheme_bigint_write, -		.display = ao_scheme_bigint_write, +	[AO_SCHEME_STRING] = { +		.write = ao_scheme_string_write, +		.display = ao_scheme_string_display,  	}, -#endif  #ifdef AO_SCHEME_FEATURE_FLOAT  	[AO_SCHEME_FLOAT] = {  		.write = ao_scheme_float_write, diff --git a/src/scheme/ao_scheme_read.c b/src/scheme/ao_scheme_read.c index dce480ab..721211bc 100644 --- a/src/scheme/ao_scheme_read.c +++ b/src/scheme/ao_scheme_read.c @@ -555,7 +555,7 @@ ao_poly  ao_scheme_read(void)  {  	struct ao_scheme_atom	*atom; -	char			*string; +	struct ao_scheme_string	*string;  	int			read_state;  	ao_poly			v = AO_SCHEME_NIL; @@ -605,7 +605,7 @@ ao_scheme_read(void)  				v = _ao_scheme_bool_false;  			break;  		case STRING: -			string = ao_scheme_string_copy(token_string); +			string = ao_scheme_string_make(token_string);  			if (string)  				v = ao_scheme_string_poly(string);  			else diff --git a/src/scheme/ao_scheme_string.c b/src/scheme/ao_scheme_string.c index ada626c3..e18a8e85 100644 --- a/src/scheme/ao_scheme_string.c +++ b/src/scheme/ao_scheme_string.c @@ -24,9 +24,10 @@ static void string_mark(void *addr)  static int string_size(void *addr)  { +	struct ao_scheme_string	*string = addr;  	if (!addr)  		return 0; -	return strlen(addr) + 1; +	return strlen(string->val) + 2;  }  static void string_move(void *addr) @@ -41,71 +42,114 @@ const struct ao_scheme_type ao_scheme_string_type = {  	.name = "string",  }; -char * -ao_scheme_string_copy(char *a) +static struct ao_scheme_string * +ao_scheme_string_alloc(int len)  { -	int	alen = strlen(a); -	char	*r; +	struct ao_scheme_string	*s; + +	s = ao_scheme_alloc(len + 2); +	if (!s) +		return NULL; +	s->type = AO_SCHEME_STRING; +	return s; +} + +struct ao_scheme_string * +ao_scheme_string_copy(struct ao_scheme_string *a) +{ +	int			alen = strlen(a->val); +	struct ao_scheme_string	*r;  	ao_scheme_string_stash(0, a); -	r = ao_scheme_alloc(alen + 1); +	r = ao_scheme_string_alloc(alen);  	a = ao_scheme_string_fetch(0);  	if (!r)  		return NULL; -	strcpy(r, a); +	strcpy(r->val, a->val); +	return r; +} + +struct ao_scheme_string * +ao_scheme_string_make(char *a) +{ +	struct ao_scheme_string	*r; + +	r = ao_scheme_string_alloc(strlen(a)); +	if (!r) +		return NULL; +	strcpy(r->val, a); +	return r; +} + +struct ao_scheme_string * +ao_scheme_atom_to_string(struct ao_scheme_atom *a) +{ +	int			alen = strlen(a->name); +	struct ao_scheme_string	*r; + +	ao_scheme_poly_stash(0, ao_scheme_atom_poly(a)); +	r = ao_scheme_string_alloc(alen); +	a = ao_scheme_poly_atom(ao_scheme_poly_fetch(0)); +	if (!r) +		return NULL; +	strcpy(r->val, a->name);  	return r;  } -char * -ao_scheme_string_cat(char *a, char *b) +struct ao_scheme_string * +ao_scheme_string_cat(struct ao_scheme_string *a, struct ao_scheme_string *b)  { -	int	alen = strlen(a); -	int	blen = strlen(b); -	char 	*r; +	int				alen = strlen(a->val); +	int				blen = strlen(b->val); +	struct ao_scheme_string 	*r;  	ao_scheme_string_stash(0, a);  	ao_scheme_string_stash(1, b); -	r = ao_scheme_alloc(alen + blen + 1); +	r = ao_scheme_string_alloc(alen + blen);  	a = ao_scheme_string_fetch(0);  	b = ao_scheme_string_fetch(1);  	if (!r)  		return NULL; -	strcpy(r, a); -	strcpy(r+alen, b); +	strcpy(r->val, a->val); +	strcpy(r->val+alen, b->val);  	return r;  }  ao_poly  ao_scheme_string_pack(struct ao_scheme_cons *cons)  { -	char	*r; -	char	*s; -	int	len; +	struct ao_scheme_string	*r; +	char			*rval; +	int			len;  	len = ao_scheme_cons_length(cons);  	ao_scheme_cons_stash(0, cons); -	r = ao_scheme_alloc(len + 1); +	r = ao_scheme_string_alloc(len);  	cons = ao_scheme_cons_fetch(0); -	s = r; +	if (!r) +		return AO_SCHEME_NIL; +	rval = r->val;  	while (cons) { -		if (!ao_scheme_integer_typep(ao_scheme_poly_type(cons->car))) +		bool fail = false; +		ao_poly	car = cons->car; +		*rval++ = ao_scheme_poly_integer(car, &fail); +		if (fail)  			return ao_scheme_error(AO_SCHEME_INVALID, "non-int passed to pack"); -		*s++ = ao_scheme_poly_integer(cons->car); -		cons = ao_scheme_poly_cons(cons->cdr); +		cons = ao_scheme_cons_cdr(cons);  	} -	*s++ = 0; +	*rval++ = 0;  	return ao_scheme_string_poly(r);  }  ao_poly -ao_scheme_string_unpack(char *a) +ao_scheme_string_unpack(struct ao_scheme_string *a)  {  	struct ao_scheme_cons	*cons = NULL, *tail = NULL;  	int			c;  	int			i; -	for (i = 0; (c = a[i]); i++) { +	for (i = 0; (c = a->val[i]); i++) {  		struct ao_scheme_cons	*n;  		ao_scheme_cons_stash(0, cons);  		ao_scheme_cons_stash(1, tail); @@ -131,11 +175,12 @@ ao_scheme_string_unpack(char *a)  void  ao_scheme_string_write(ao_poly p)  { -	char	*s = ao_scheme_poly_string(p); -	char	c; +	struct ao_scheme_string	*s = ao_scheme_poly_string(p); +	char			*sval = s->val; +	char			c;  	putchar('"'); -	while ((c = *s++)) { +	while ((c = *sval++)) {  		switch (c) {  		case '\n':  			printf ("\\n"); @@ -160,9 +205,10 @@ ao_scheme_string_write(ao_poly p)  void  ao_scheme_string_display(ao_poly p)  { -	char	*s = ao_scheme_poly_string(p); -	char	c; +	struct ao_scheme_string	*s = ao_scheme_poly_string(p); +	char			*sval = s->val; +	char			c; -	while ((c = *s++)) +	while ((c = *sval++))  		putchar(c);  } diff --git a/src/scheme/ao_scheme_vector.c b/src/scheme/ao_scheme_vector.c index 0114c5a9..a4127f64 100644 --- a/src/scheme/ao_scheme_vector.c +++ b/src/scheme/ao_scheme_vector.c @@ -107,14 +107,15 @@ ao_scheme_vector_display(ao_poly v)  static int32_t  ao_scheme_vector_offset(struct ao_scheme_vector *vector, ao_poly i)  { -	int32_t	offset = ao_scheme_poly_integer(i); +	bool	fail; +	int32_t	offset = ao_scheme_poly_integer(i, &fail); -	if (offset == AO_SCHEME_NOT_INTEGER) +	if (fail)  		ao_scheme_error(AO_SCHEME_INVALID, "vector index %v not integer", i);  	if (offset < 0 || vector->length <= offset) {  		ao_scheme_error(AO_SCHEME_INVALID, "vector index %v out of range (max %d)",  				i, vector->length); -		offset = AO_SCHEME_NOT_INTEGER; +		offset = -1;  	}  	return offset;  } @@ -125,7 +126,7 @@ ao_scheme_vector_get(ao_poly v, ao_poly i)  	struct ao_scheme_vector	*vector = ao_scheme_poly_vector(v);  	int32_t			offset = ao_scheme_vector_offset(vector, i); -	if (offset == AO_SCHEME_NOT_INTEGER) +	if (offset < 0)  		return AO_SCHEME_NIL;  	return vector->vals[offset];  } @@ -136,7 +137,7 @@ ao_scheme_vector_set(ao_poly v, ao_poly i, ao_poly p)  	struct ao_scheme_vector	*vector = ao_scheme_poly_vector(v);  	int32_t			offset = ao_scheme_vector_offset(vector, i); -	if (offset == AO_SCHEME_NOT_INTEGER) +	if (offset < 0)  		return AO_SCHEME_NIL;  	return vector->vals[offset] = p;  } | 
