Generally, changed working with tags as strings to as values.
This seems both cheaper and safer; what's not to like?
This commit is contained in:
parent
eadb125b83
commit
93d4bd14a0
5
Makefile
5
Makefile
|
|
@ -17,11 +17,12 @@ INDENT_FLAGS := -nbad -bap -nbc -br -brf -brs -c33 -cd33 -ncdb -ce -ci4 -cli4 \
|
|||
|
||||
CPPFLAGS ?= $(INC_FLAGS) -MMD -MP -g -DDEBUG
|
||||
LDFLAGS := -lm -lcurl
|
||||
DEBUGFLAGS := -g3
|
||||
|
||||
all: $(TARGET)
|
||||
|
||||
$(TARGET): $(OBJS) Makefile
|
||||
$(CC) $(LDFLAGS) $(OBJS) -o $@ $(LDFLAGS) $(LOADLIBES) $(LDLIBS)
|
||||
$(CC) $(DEBUGFLAGS) $(LDFLAGS) $(OBJS) -o $@ $(LDFLAGS) $(LOADLIBES) $(LDLIBS)
|
||||
|
||||
doc: $(SRCS) Makefile Doxyfile
|
||||
doxygen
|
||||
|
|
@ -38,7 +39,7 @@ test: $(OBJS) $(TESTS) Makefile
|
|||
|
||||
.PHONY: clean
|
||||
clean:
|
||||
$(RM) $(TARGET) $(OBJS) $(DEPS) $(SRC_DIRS)/*~ $(SRC_DIRS)/*/*~ *~
|
||||
$(RM) $(TARGET) $(OBJS) $(DEPS) $(SRC_DIRS)/*~ $(SRC_DIRS)/*/*~ *~ core
|
||||
|
||||
repl:
|
||||
$(TARGET) -p 2> psse.log
|
||||
|
|
|
|||
|
|
@ -46,11 +46,10 @@ struct cons_pointer make_integer( int64_t value, struct cons_pointer more ) {
|
|||
debug_print( L"Entering make_integer\n", DEBUG_ALLOC );
|
||||
|
||||
if ( integerp( more ) || nilp( more ) ) {
|
||||
result = allocate_cell( INTEGERTAG );
|
||||
result = allocate_cell( INTEGERTV );
|
||||
struct cons_space_object *cell = &pointer2cell( result );
|
||||
cell->payload.integer.value = value;
|
||||
cell->payload.integer.more = more;
|
||||
|
||||
}
|
||||
|
||||
debug_print( L"make_integer: returning\n", DEBUG_ALLOC );
|
||||
|
|
|
|||
|
|
@ -315,7 +315,7 @@ struct cons_pointer make_ratio( struct cons_pointer dividend,
|
|||
if ( integerp( dividend ) && integerp( divisor ) ) {
|
||||
inc_ref( dividend );
|
||||
inc_ref( divisor );
|
||||
result = allocate_cell( RATIOTAG );
|
||||
result = allocate_cell( RATIOTV );
|
||||
struct cons_space_object *cell = &pointer2cell( result );
|
||||
cell->payload.ratio.dividend = dividend;
|
||||
cell->payload.ratio.divisor = divisor;
|
||||
|
|
|
|||
|
|
@ -19,7 +19,7 @@
|
|||
* @return a real number cell wrapping this value.
|
||||
*/
|
||||
struct cons_pointer make_real( long double value ) {
|
||||
struct cons_pointer result = allocate_cell( REALTAG );
|
||||
struct cons_pointer result = allocate_cell( REALTV );
|
||||
struct cons_space_object *cell = &pointer2cell( result );
|
||||
cell->payload.real.value = value;
|
||||
|
||||
|
|
|
|||
|
|
@ -49,7 +49,7 @@ struct cons_pointer read_map( struct stack_frame *frame,
|
|||
struct cons_pointer frame_pointer,
|
||||
URL_FILE * input, wint_t initial );
|
||||
struct cons_pointer read_string( URL_FILE * input, wint_t initial );
|
||||
struct cons_pointer read_symbol_or_key( URL_FILE * input, char *tag,
|
||||
struct cons_pointer read_symbol_or_key( URL_FILE * input, uint32_t tag,
|
||||
wint_t initial );
|
||||
|
||||
/**
|
||||
|
|
@ -119,7 +119,7 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
|
|||
read_number( frame, frame_pointer, input, c,
|
||||
false );
|
||||
} else {
|
||||
result = read_symbol_or_key( input, SYMBOLTAG, c );
|
||||
result = read_symbol_or_key( input, SYMBOLTV, c );
|
||||
}
|
||||
}
|
||||
break;
|
||||
|
|
@ -139,20 +139,20 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
|
|||
debug_print( L"read_continuation: dotted pair; read cdr ",
|
||||
DEBUG_IO);
|
||||
} else {
|
||||
read_symbol_or_key( input, SYMBOLTAG, c );
|
||||
read_symbol_or_key( input, SYMBOLTV, c );
|
||||
}
|
||||
}
|
||||
break;
|
||||
case ':':
|
||||
result =
|
||||
read_symbol_or_key( input, KEYTAG, url_fgetwc( input ) );
|
||||
read_symbol_or_key( input, KEYTV, url_fgetwc( input ) );
|
||||
break;
|
||||
default:
|
||||
if ( iswdigit( c ) ) {
|
||||
result =
|
||||
read_number( frame, frame_pointer, input, c, false );
|
||||
} else if ( iswprint( c ) ) {
|
||||
result = read_symbol_or_key( input, SYMBOLTAG, c );
|
||||
result = read_symbol_or_key( input, SYMBOLTV, c );
|
||||
} else {
|
||||
result =
|
||||
throw_exception( make_cons( c_string_to_lisp_string
|
||||
|
|
@ -386,7 +386,7 @@ struct cons_pointer read_string( URL_FILE * input, wint_t initial ) {
|
|||
return result;
|
||||
}
|
||||
|
||||
struct cons_pointer read_symbol_or_key( URL_FILE * input, char *tag,
|
||||
struct cons_pointer read_symbol_or_key( URL_FILE * input, uint32_t tag,
|
||||
wint_t initial ) {
|
||||
struct cons_pointer cdr = NIL;
|
||||
struct cons_pointer result;
|
||||
|
|
|
|||
|
|
@ -140,7 +140,7 @@ void free_cell( struct cons_pointer pointer ) {
|
|||
debug_printf( DEBUG_ALLOC, L"Freeing cell " );
|
||||
debug_dump_object( pointer, DEBUG_ALLOC );
|
||||
|
||||
if ( !check_tag( pointer, FREETAG ) ) {
|
||||
if ( !check_tag( pointer, FREETV ) ) {
|
||||
if ( cell->count == 0 ) {
|
||||
switch ( cell->tag.value ) {
|
||||
case CONSTV:
|
||||
|
|
@ -209,7 +209,7 @@ void free_cell( struct cons_pointer pointer ) {
|
|||
* return an exception. Which, as we cannot create such an exception when
|
||||
* cons space is exhausted, means we must construct it at init time.
|
||||
*/
|
||||
struct cons_pointer allocate_cell( char *tag ) {
|
||||
struct cons_pointer allocate_cell( uint32_t tag ) {
|
||||
struct cons_pointer result = freelist;
|
||||
|
||||
|
||||
|
|
@ -222,7 +222,7 @@ struct cons_pointer allocate_cell( char *tag ) {
|
|||
if ( strncmp( &cell->tag.bytes[0], FREETAG, TAGLENGTH ) == 0 ) {
|
||||
freelist = cell->payload.free.cdr;
|
||||
|
||||
strncpy( &cell->tag.bytes[0], tag, TAGLENGTH );
|
||||
cell->tag.value = tag;
|
||||
|
||||
cell->count = 0;
|
||||
cell->payload.cons.car = NIL;
|
||||
|
|
|
|||
|
|
@ -55,7 +55,7 @@ extern struct cons_page *conspages[NCONSPAGES];
|
|||
|
||||
void free_cell( struct cons_pointer pointer );
|
||||
|
||||
struct cons_pointer allocate_cell( char *tag );
|
||||
struct cons_pointer allocate_cell( uint32_t tag );
|
||||
|
||||
void initialise_cons_pages( );
|
||||
|
||||
|
|
|
|||
|
|
@ -28,22 +28,22 @@
|
|||
#include "vectorspace.h"
|
||||
|
||||
/**
|
||||
* True if the tag on the cell at this `pointer` is this `tag`, or, if the tag
|
||||
* of the cell is `VECP`, if the tag of the vectorspace object indicated by the
|
||||
* cell is this `tag`, else false.
|
||||
* True if the value of the tag on the cell at this `pointer` is this `value`,
|
||||
* or, if the tag of the cell is `VECP`, if the value of the tag of the
|
||||
* vectorspace object indicated by the cell is this `value`, else false.
|
||||
*/
|
||||
bool check_tag( struct cons_pointer pointer, char *tag ) {
|
||||
bool check_tag( struct cons_pointer pointer, uint32_t value ) {
|
||||
bool result = false;
|
||||
struct cons_space_object cell = pointer2cell( pointer );
|
||||
|
||||
result = strncmp( &cell.tag.bytes[0], tag, TAGLENGTH ) == 0;
|
||||
struct cons_space_object cell = pointer2cell( pointer );
|
||||
result = cell.tag.value == value;
|
||||
|
||||
if ( result == false ) {
|
||||
if ( cell.tag.value == VECTORPOINTTV ) {
|
||||
struct vector_space_object *vec = pointer_to_vso( pointer );
|
||||
|
||||
if ( vec != NULL ) {
|
||||
result = strncmp( &(vec->header.tag.bytes[0]), tag, TAGLENGTH ) == 0;
|
||||
result = vec->header.tag.value == value;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -177,7 +177,7 @@ struct cons_pointer make_cons( struct cons_pointer car,
|
|||
struct cons_pointer cdr ) {
|
||||
struct cons_pointer pointer = NIL;
|
||||
|
||||
pointer = allocate_cell( CONSTAG );
|
||||
pointer = allocate_cell( CONSTV );
|
||||
|
||||
struct cons_space_object *cell = &pointer2cell( pointer );
|
||||
|
||||
|
|
@ -197,7 +197,7 @@ struct cons_pointer make_cons( struct cons_pointer car,
|
|||
struct cons_pointer make_exception( struct cons_pointer message,
|
||||
struct cons_pointer frame_pointer ) {
|
||||
struct cons_pointer result = NIL;
|
||||
struct cons_pointer pointer = allocate_cell( EXCEPTIONTAG );
|
||||
struct cons_pointer pointer = allocate_cell( EXCEPTIONTV );
|
||||
struct cons_space_object *cell = &pointer2cell( pointer );
|
||||
|
||||
inc_ref( message );
|
||||
|
|
@ -218,7 +218,7 @@ struct cons_pointer
|
|||
make_function( struct cons_pointer meta, struct cons_pointer ( *executable )
|
||||
( struct stack_frame *,
|
||||
struct cons_pointer, struct cons_pointer ) ) {
|
||||
struct cons_pointer pointer = allocate_cell( FUNCTIONTAG );
|
||||
struct cons_pointer pointer = allocate_cell( FUNCTIONTV );
|
||||
struct cons_space_object *cell = &pointer2cell( pointer );
|
||||
inc_ref( meta );
|
||||
|
||||
|
|
@ -233,7 +233,7 @@ make_function( struct cons_pointer meta, struct cons_pointer ( *executable )
|
|||
*/
|
||||
struct cons_pointer make_lambda( struct cons_pointer args,
|
||||
struct cons_pointer body ) {
|
||||
struct cons_pointer pointer = allocate_cell( LAMBDATAG );
|
||||
struct cons_pointer pointer = allocate_cell( LAMBDATV );
|
||||
struct cons_space_object *cell = &pointer2cell( pointer );
|
||||
|
||||
inc_ref( pointer ); /* this is a hack; I don't know why it's necessary to do this, but if I don't the cell gets freed */
|
||||
|
|
@ -252,7 +252,7 @@ struct cons_pointer make_lambda( struct cons_pointer args,
|
|||
*/
|
||||
struct cons_pointer make_nlambda( struct cons_pointer args,
|
||||
struct cons_pointer body ) {
|
||||
struct cons_pointer pointer = allocate_cell( NLAMBDATAG );
|
||||
struct cons_pointer pointer = allocate_cell( NLAMBDATV );
|
||||
|
||||
inc_ref( pointer ); /* this is a hack; I don't know why it's necessary to do this, but if I don't the cell gets freed */
|
||||
|
||||
|
|
@ -309,10 +309,10 @@ uint32_t calculate_hash(wint_t c, struct cons_pointer ptr)
|
|||
* pointer to next is NIL.
|
||||
*/
|
||||
struct cons_pointer
|
||||
make_string_like_thing( wint_t c, struct cons_pointer tail, char *tag ) {
|
||||
make_string_like_thing( wint_t c, struct cons_pointer tail, uint32_t tag ) {
|
||||
struct cons_pointer pointer = NIL;
|
||||
|
||||
if ( check_tag( tail, tag ) || check_tag( tail, NILTAG ) ) {
|
||||
if ( check_tag( tail, tag ) || check_tag( tail, NILTV ) ) {
|
||||
pointer = allocate_cell( tag );
|
||||
struct cons_space_object *cell = &pointer2cell( pointer );
|
||||
|
||||
|
|
@ -344,7 +344,7 @@ make_string_like_thing( wint_t c, struct cons_pointer tail, char *tag ) {
|
|||
* @param tail the string which is being built.
|
||||
*/
|
||||
struct cons_pointer make_string( wint_t c, struct cons_pointer tail ) {
|
||||
return make_string_like_thing( c, tail, STRINGTAG );
|
||||
return make_string_like_thing( c, tail, STRINGTV );
|
||||
}
|
||||
|
||||
/**
|
||||
|
|
@ -356,10 +356,10 @@ struct cons_pointer make_string( wint_t c, struct cons_pointer tail ) {
|
|||
* @param tag the tag to use: expected to be "SYMB" or "KEYW"
|
||||
*/
|
||||
struct cons_pointer make_symbol_or_key( wint_t c, struct cons_pointer tail,
|
||||
char *tag ) {
|
||||
uint32_t tag ) {
|
||||
struct cons_pointer result = make_string_like_thing( c, tail, tag );
|
||||
|
||||
if ( strncmp( tag, KEYTAG, 4 ) == 0 ) {
|
||||
if ( tag == KEYTV ) {
|
||||
struct cons_pointer r = internedp( result, oblist );
|
||||
|
||||
if ( nilp( r ) ) {
|
||||
|
|
@ -379,7 +379,7 @@ struct cons_pointer
|
|||
make_special( struct cons_pointer meta, struct cons_pointer ( *executable )
|
||||
( struct stack_frame * frame,
|
||||
struct cons_pointer, struct cons_pointer env ) ) {
|
||||
struct cons_pointer pointer = allocate_cell( SPECIALTAG );
|
||||
struct cons_pointer pointer = allocate_cell( SPECIALTV );
|
||||
struct cons_space_object *cell = &pointer2cell( pointer );
|
||||
inc_ref( meta );
|
||||
|
||||
|
|
@ -397,7 +397,7 @@ make_special( struct cons_pointer meta, struct cons_pointer ( *executable )
|
|||
*/
|
||||
struct cons_pointer make_read_stream( URL_FILE * input,
|
||||
struct cons_pointer metadata ) {
|
||||
struct cons_pointer pointer = allocate_cell( READTAG );
|
||||
struct cons_pointer pointer = allocate_cell( READTV );
|
||||
struct cons_space_object *cell = &pointer2cell( pointer );
|
||||
|
||||
cell->payload.stream.stream = input;
|
||||
|
|
@ -414,7 +414,7 @@ struct cons_pointer make_read_stream( URL_FILE * input,
|
|||
*/
|
||||
struct cons_pointer make_write_stream( URL_FILE * output,
|
||||
struct cons_pointer metadata ) {
|
||||
struct cons_pointer pointer = allocate_cell( WRITETAG );
|
||||
struct cons_pointer pointer = allocate_cell( WRITETV );
|
||||
struct cons_space_object *cell = &pointer2cell( pointer );
|
||||
|
||||
cell->payload.stream.stream = output;
|
||||
|
|
|
|||
|
|
@ -276,114 +276,114 @@
|
|||
* true if `conspoint` points to the special cell NIL, else false
|
||||
* (there should only be one of these so it's slightly redundant).
|
||||
*/
|
||||
#define nilp(conspoint) (check_tag(conspoint,NILTAG))
|
||||
#define nilp(conspoint) (check_tag(conspoint,NILTV))
|
||||
|
||||
/**
|
||||
* true if `conspoint` points to a cons cell, else false
|
||||
*/
|
||||
#define consp(conspoint) (check_tag(conspoint,CONSTAG))
|
||||
#define consp(conspoint) (check_tag(conspoint,CONSTV))
|
||||
|
||||
/**
|
||||
* true if `conspoint` points to an exception, else false
|
||||
*/
|
||||
#define exceptionp(conspoint) (check_tag(conspoint,EXCEPTIONTAG))
|
||||
#define exceptionp(conspoint) (check_tag(conspoint,EXCEPTIONTV))
|
||||
|
||||
/**
|
||||
* true if `conspoint` points to a function cell, else false
|
||||
*/
|
||||
#define functionp(conspoint) (check_tag(conspoint,FUNCTIONTAG))
|
||||
#define functionp(conspoint) (check_tag(conspoint,FUNCTIONTV))
|
||||
|
||||
/**
|
||||
* true if `conspoint` points to a keyword, else false
|
||||
*/
|
||||
#define keywordp(conspoint) (check_tag(conspoint,KEYTAG))
|
||||
#define keywordp(conspoint) (check_tag(conspoint,KEYTV))
|
||||
|
||||
/**
|
||||
* true if `conspoint` points to a Lambda binding cell, else false
|
||||
*/
|
||||
#define lambdap(conspoint) (check_tag(conspoint,LAMBDATAG))
|
||||
#define lambdap(conspoint) (check_tag(conspoint,LAMBDATV))
|
||||
|
||||
/**
|
||||
* true if `conspoint` points to a loop exit exception, else false.
|
||||
*/
|
||||
#define loopexitp(conspoint) (check_tag(conspoint,LOOPXTAG))
|
||||
#define loopexitp(conspoint) (check_tag(conspoint,LOOPXTV))
|
||||
|
||||
/**
|
||||
* true if `conspoint` points to a special form cell, else false
|
||||
*/
|
||||
#define specialp(conspoint) (check_tag(conspoint,SPECIALTAG))
|
||||
#define specialp(conspoint) (check_tag(conspoint,SPECIALTV))
|
||||
|
||||
/**
|
||||
* true if `conspoint` points to a string cell, else false
|
||||
*/
|
||||
#define stringp(conspoint) (check_tag(conspoint,STRINGTAG))
|
||||
#define stringp(conspoint) (check_tag(conspoint,STRINGTV))
|
||||
|
||||
/**
|
||||
* true if `conspoint` points to a symbol cell, else false
|
||||
*/
|
||||
#define symbolp(conspoint) (check_tag(conspoint,SYMBOLTAG))
|
||||
#define symbolp(conspoint) (check_tag(conspoint,SYMBOLTV))
|
||||
|
||||
/**
|
||||
* true if `conspoint` points to an integer cell, else false
|
||||
*/
|
||||
#define integerp(conspoint) (check_tag(conspoint,INTEGERTAG))
|
||||
#define integerp(conspoint) (check_tag(conspoint,INTEGERTV))
|
||||
|
||||
/**
|
||||
* true if `conspoint` points to a rational number cell, else false
|
||||
*/
|
||||
#define ratiop(conspoint) (check_tag(conspoint,RATIOTAG))
|
||||
#define ratiop(conspoint) (check_tag(conspoint,RATIOTV))
|
||||
|
||||
/**
|
||||
* true if `conspoint` points to a read stream cell, else false
|
||||
*/
|
||||
#define readp(conspoint) (check_tag(conspoint,READTAG))
|
||||
#define readp(conspoint) (check_tag(conspoint,READTV))
|
||||
|
||||
/**
|
||||
* true if `conspoint` points to a real number cell, else false
|
||||
*/
|
||||
#define realp(conspoint) (check_tag(conspoint,REALTAG))
|
||||
#define realp(conspoint) (check_tag(conspoint,REALTV))
|
||||
|
||||
/**
|
||||
* true if `conspoint` points to some sort of a number cell,
|
||||
* else false
|
||||
*/
|
||||
#define numberp(conspoint) (check_tag(conspoint,INTEGERTAG)||check_tag(conspoint,RATIOTAG)||check_tag(conspoint,REALTAG))
|
||||
#define numberp(conspoint) (check_tag(conspoint,INTEGERTV)||check_tag(conspoint,RATIOTV)||check_tag(conspoint,REALTV))
|
||||
|
||||
/**
|
||||
* true if `conspoint` points to a sequence (list, string or, later, vector),
|
||||
* else false.
|
||||
*/
|
||||
#define sequencep(conspoint) (check_tag(conspoint,CONSTAG)||check_tag(conspoint,STRINGTAG)||check_tag(conspoint,SYMBOLTAG))
|
||||
#define sequencep(conspoint) (check_tag(conspoint,CONSTV)||check_tag(conspoint,STRINGTV)||check_tag(conspoint,SYMBOLTV))
|
||||
|
||||
/**
|
||||
* true if `conspoint` points to a vector pointer, else false.
|
||||
*/
|
||||
#define vectorpointp(conspoint) (check_tag(conspoint,VECTORPOINTTAG))
|
||||
#define vectorpointp(conspoint) (check_tag(conspoint,VECTORPOINTTV))
|
||||
|
||||
/**
|
||||
* true if `conspoint` points to a write stream cell, else false.
|
||||
*/
|
||||
#define writep(conspoint) (check_tag(conspoint,WRITETAG))
|
||||
#define writep(conspoint) (check_tag(conspoint,WRITETV))
|
||||
|
||||
#define streamp(conspoint) (check_tag(conspoint,READTAG)||check_tag(conspoint,WRITETAG))
|
||||
#define streamp(conspoint) (check_tag(conspoint,READTV)||check_tag(conspoint,WRITETV))
|
||||
|
||||
/**
|
||||
* true if `conspoint` points to a true cell, else false
|
||||
* (there should only be one of these so it's slightly redundant).
|
||||
* Also note that anything that is not NIL is truthy.
|
||||
*/
|
||||
#define tp(conspoint) (check_tag(conspoint,TRUETAG))
|
||||
#define tp(conspoint) (check_tag(conspoint,TRUETV))
|
||||
|
||||
/**
|
||||
* true if `conspoint` points to a time cell, else false.
|
||||
*/
|
||||
#define timep(conspoint) (check_tag(conspoint,TIMETAG))
|
||||
#define timep(conspoint) (check_tag(conspoint,TIMETV))
|
||||
|
||||
/**
|
||||
* true if `conspoint` points to something that is truthy, i.e.
|
||||
* anything but NIL.
|
||||
*/
|
||||
#define truep(conspoint) (!check_tag(conspoint,NILTAG))
|
||||
#define truep(conspoint) (!check_tag(conspoint,NILTV))
|
||||
|
||||
/**
|
||||
* An indirect pointer to a cons cell
|
||||
|
|
@ -673,7 +673,7 @@ struct cons_space_object {
|
|||
} payload;
|
||||
};
|
||||
|
||||
bool check_tag( struct cons_pointer pointer, char *tag );
|
||||
bool check_tag( struct cons_pointer pointer, uint32_t value );
|
||||
|
||||
struct cons_pointer inc_ref( struct cons_pointer pointer );
|
||||
|
||||
|
|
@ -716,11 +716,11 @@ struct cons_pointer make_special( struct cons_pointer src,
|
|||
struct cons_pointer make_string( wint_t c, struct cons_pointer tail );
|
||||
|
||||
struct cons_pointer make_symbol_or_key( wint_t c, struct cons_pointer tail,
|
||||
char *tag );
|
||||
uint32_t tag );
|
||||
|
||||
#define make_symbol(c, t) (make_symbol_or_key( c, t, SYMBOLTAG))
|
||||
#define make_symbol(c, t) (make_symbol_or_key( c, t, SYMBOLTV))
|
||||
|
||||
#define make_keyword(c, t) (make_symbol_or_key( c, t, KEYTAG))
|
||||
#define make_keyword(c, t) (make_symbol_or_key( c, t, KEYTV))
|
||||
|
||||
struct cons_pointer make_read_stream( URL_FILE * input,
|
||||
struct cons_pointer metadata );
|
||||
|
|
|
|||
|
|
@ -78,17 +78,16 @@ void free_hashmap( struct cons_pointer pointer ) {
|
|||
|
||||
if ( hashmapp( pointer ) ) {
|
||||
struct vector_space_object *vso = cell->payload.vectorp.address;
|
||||
struct hashmap_payload payload = vso->payload.hashmap;
|
||||
|
||||
dec_ref( payload.hash_fn );
|
||||
dec_ref( payload.write_acl );
|
||||
dec_ref( vso->payload.hashmap.hash_fn );
|
||||
dec_ref( vso->payload.hashmap.write_acl );
|
||||
|
||||
for ( int i = 0; i < payload.n_buckets; i++ ) {
|
||||
if ( !nilp( payload.buckets[i] ) ) {
|
||||
for ( int i = 0; i < vso->payload.hashmap.n_buckets; i++ ) {
|
||||
if ( !nilp( vso->payload.hashmap.buckets[i] ) ) {
|
||||
debug_printf( DEBUG_ALLOC,
|
||||
L"Decrementing bucket [%d] of hashmap at 0x%lx\n", i,
|
||||
cell->payload.vectorp.address );
|
||||
dec_ref( payload.buckets[i] );
|
||||
dec_ref( vso->payload.hashmap.buckets[i] );
|
||||
}
|
||||
}
|
||||
} else {
|
||||
|
|
@ -114,7 +113,7 @@ struct cons_pointer make_hashmap( uint32_t n_buckets,
|
|||
struct cons_pointer hash_fn,
|
||||
struct cons_pointer write_acl ) {
|
||||
struct cons_pointer result =
|
||||
make_vso( HASHTAG, ( sizeof( struct cons_pointer ) * ( n_buckets + 1 ) ) +
|
||||
make_vso( HASHTV, ( sizeof( struct cons_pointer ) * ( n_buckets + 1 ) ) +
|
||||
( sizeof( uint32_t ) * 2 ) );
|
||||
|
||||
struct hashmap_payload *payload =
|
||||
|
|
|
|||
|
|
@ -75,7 +75,7 @@ struct stack_frame *get_stack_frame( struct cons_pointer pointer ) {
|
|||
struct cons_pointer make_empty_frame( struct cons_pointer previous ) {
|
||||
debug_print( L"Entering make_empty_frame\n", DEBUG_ALLOC );
|
||||
struct cons_pointer result =
|
||||
make_vso( STACKFRAMETAG, sizeof( struct stack_frame ) );
|
||||
make_vso( STACKFRAMETV, sizeof( struct stack_frame ) );
|
||||
|
||||
debug_dump_object( result, DEBUG_ALLOC );
|
||||
|
||||
|
|
|
|||
|
|
@ -33,15 +33,15 @@
|
|||
*
|
||||
* @address the address of the vector_space_object to point to.
|
||||
* @tag the vector-space tag of the particular type of vector-space object,
|
||||
* NOT `VECTORPOINTTAG`.
|
||||
* NOT `VECTORPOINTTV`.
|
||||
*
|
||||
* @return a cons_pointer to the object, or NIL if the object could not be
|
||||
* allocated due to memory exhaustion.
|
||||
*/
|
||||
struct cons_pointer make_vec_pointer( struct vector_space_object *address,
|
||||
char *tag ) {
|
||||
uint32_t tag ) {
|
||||
debug_print( L"Entered make_vec_pointer\n", DEBUG_ALLOC );
|
||||
struct cons_pointer pointer = allocate_cell( VECTORPOINTTAG );
|
||||
struct cons_pointer pointer = allocate_cell( VECTORPOINTTV );
|
||||
struct cons_space_object *cell = &pointer2cell( pointer );
|
||||
|
||||
debug_printf( DEBUG_ALLOC,
|
||||
|
|
@ -49,7 +49,7 @@ struct cons_pointer make_vec_pointer( struct vector_space_object *address,
|
|||
address );
|
||||
|
||||
cell->payload.vectorp.address = address;
|
||||
strncpy( &cell->payload.vectorp.tag.bytes[0], tag, TAGLENGTH );
|
||||
cell->payload.vectorp.tag.value = tag;
|
||||
|
||||
debug_printf( DEBUG_ALLOC,
|
||||
L"make_vec_pointer: all good, returning pointer to %p\n",
|
||||
|
|
@ -71,7 +71,7 @@ struct cons_pointer make_vec_pointer( struct vector_space_object *address,
|
|||
* @return a cons_pointer to the object, or NIL if the object could not be
|
||||
* allocated due to memory exhaustion.
|
||||
*/
|
||||
struct cons_pointer make_vso( char *tag, uint64_t payload_size ) {
|
||||
struct cons_pointer make_vso( uint32_t tag, uint64_t payload_size ) {
|
||||
debug_print( L"Entered make_vso\n", DEBUG_ALLOC );
|
||||
struct cons_pointer result = NIL;
|
||||
int64_t total_size = sizeof( struct vector_space_header ) + payload_size;
|
||||
|
|
@ -87,7 +87,7 @@ struct cons_pointer make_vso( char *tag, uint64_t payload_size ) {
|
|||
debug_printf( DEBUG_ALLOC,
|
||||
L"make_vso: about to write tag '%s' into vso at %p\n",
|
||||
tag, vso );
|
||||
strncpy( &vso->header.tag.bytes[0], tag, TAGLENGTH );
|
||||
vso->header.tag.value = tag;
|
||||
result = make_vec_pointer( vso, tag );
|
||||
debug_dump_object( result, DEBUG_ALLOC );
|
||||
vso->header.vecp = result;
|
||||
|
|
|
|||
|
|
@ -29,7 +29,7 @@
|
|||
#define HASHTAG "HASH"
|
||||
#define HASHTV 1213415752
|
||||
|
||||
#define hashmapp(conspoint)((check_tag(conspoint,HASHTAG)))
|
||||
#define hashmapp(conspoint)((check_tag(conspoint,HASHTV)))
|
||||
|
||||
/*
|
||||
* a namespace (i.e. a binding of names to values, implemented as a hashmap)
|
||||
|
|
@ -39,7 +39,7 @@
|
|||
#define NAMESPACETAG "NMSP"
|
||||
#define NAMESPACETV 1347636558
|
||||
|
||||
#define namespacep(conspoint)(check_tag(conspoint,NAMESPACETAG))
|
||||
#define namespacep(conspoint)(check_tag(conspoint,NAMESPACETV))
|
||||
|
||||
/*
|
||||
* a vector of cons pointers.
|
||||
|
|
@ -47,7 +47,7 @@
|
|||
#define VECTORTAG "VECT"
|
||||
#define VECTORTV 1413694806
|
||||
|
||||
#define vectorp(conspoint)(check_tag(conspoint,VECTORTAG))
|
||||
#define vectorp(conspoint)(check_tag(conspoint,VECTORTV))
|
||||
|
||||
/**
|
||||
* given a pointer to a vector space object, return the object.
|
||||
|
|
@ -59,7 +59,7 @@
|
|||
*/
|
||||
#define vso_get_vecp(vso)((((vector_space_object)vso)->header.vecp))
|
||||
|
||||
struct cons_pointer make_vso( char *tag, uint64_t payload_size );
|
||||
struct cons_pointer make_vso( uint32_t tag, uint64_t payload_size );
|
||||
|
||||
void free_vso(struct cons_pointer pointer);
|
||||
|
||||
|
|
|
|||
|
|
@ -920,7 +920,7 @@ struct cons_pointer c_reverse( struct cons_pointer arg ) {
|
|||
case SYMBOLTV:
|
||||
result =
|
||||
make_symbol_or_key( o.payload.string.character, result,
|
||||
SYMBOLTAG );
|
||||
SYMBOLTV );
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -56,7 +56,7 @@ unsigned __int128 unix_time_to_lisp_time( time_t t) {
|
|||
}
|
||||
|
||||
struct cons_pointer make_time( struct cons_pointer integer_or_nil) {
|
||||
struct cons_pointer pointer = allocate_cell( TIMETAG );
|
||||
struct cons_pointer pointer = allocate_cell( TIMETV );
|
||||
struct cons_space_object *cell = &pointer2cell( pointer );
|
||||
|
||||
if (integerp(integer_or_nil)) {
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
#!/bin/bash
|
||||
|
||||
expected='(lambda (l) l) (1 2 3 4 5 6 7 8 9 10)'
|
||||
expected='<Anonymous Function: (λ (l) l)> (1 2 3 4 5 6 7 8 9 10)'
|
||||
output=`target/psse 2>/dev/null <<EOF
|
||||
(set! list (lambda (l) l))
|
||||
(list '(1 2 3 4 5 6 7 8 9 10))
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@ fi
|
|||
#####################################################################
|
||||
# Create an empty map using make-map
|
||||
expected='{}'
|
||||
actual=`echo "(make-map)" | target/psse | tail -1`
|
||||
actual=`echo "(hashmap)" | target/psse | tail -1`
|
||||
|
||||
echo -n "Empty map using (make-map): "
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
|
|
@ -31,7 +31,7 @@ fi
|
|||
# Create a map using map notation: order of keys in output is not
|
||||
# significant at this stage, but in the long term should be sorted
|
||||
# alphanumerically
|
||||
expected='{:two 2, :one 1, :three 3}'
|
||||
expected='{:one 1, :two 2, :three 3}'
|
||||
actual=`echo "{:one 1 :two 2 :three 3}" | target/psse | tail -1`
|
||||
|
||||
echo -n "Map using map notation: "
|
||||
|
|
@ -47,10 +47,10 @@ fi
|
|||
# Create a map using make-map: order of keys in output is not
|
||||
# significant at this stage, but in the long term should be sorted
|
||||
# alphanumerically
|
||||
expected='{:two 2, :one 1, :three 3}'
|
||||
actual=`echo "(make-map '((:one . 1)(:two . 2)(:three . 3)))" | target/psse | tail -1`
|
||||
expected='{:one 1, :two 2, :three 3}'
|
||||
actual=`echo "(hashmap nil nil '((:one . 1)(:two . 2)(:three . 3)))" | target/psse | tail -1`
|
||||
|
||||
echo -n "Map using (make-map): "
|
||||
echo -n "Map using (hashmap): "
|
||||
if [ "${expected}" = "${actual}" ]
|
||||
then
|
||||
echo "OK"
|
||||
|
|
|
|||
Loading…
Reference in a new issue