simon/post-scarcity
1
0
Fork 0
Code Issues 1 Pull requests Projects Releases Packages Wiki Activity Actions

Mostly fixing and standardising documentation.

Browse source
This commit is contained in:
Simon Brooke 2019-01-20 19:44:56 +00:00
parent 0f8bc990f2
commit 22fa7314d6
24 changed files with 770 additions and 503 deletions
Download patch file Download diff file Expand all files Collapse all files

130
src/memory/conspage.c
View file

@ -45,9 +45,12 @@ struct cons_pointer freelist = NIL;
struct cons_page *conspages[NCONSPAGES];
/**
* Make a cons page whose serial number (i.e. index in the conspages directory) is pageno.
* Initialise all cells and prepend each to the freelist; if pageno is zero, do not prepend
* cells 0 and 1 to the freelist but initialise them as NIL and T respectively.
* Make a cons page. Initialise all cells and prepend each to the freelist;
* if `initialised_cons_pages` is zero, do not prepend cells 0 and 1 to the
* freelist but initialise them as NIL and T respectively.
* \todo we ought to handle cons space exhaustion more gracefully than just
* crashing; should probably return an exception instead, although obviously
* that exception would have to have been pre-built.
*/
void make_cons_page( ) {
struct cons_page *result = malloc( sizeof( struct cons_page ) );
@ -110,7 +113,7 @@ void make_cons_page( ) {
}
/**
* dump the allocated pages to this output stream.
* dump the allocated pages to this `output` stream.
*/
void dump_pages( FILE * output ) {
for ( int i = 0; i < initialised_cons_pages; i++ ) {
@ -125,8 +128,9 @@ void dump_pages( FILE * output ) {
}
/**
* Frees the cell at the specified pointer. Dangerous, primitive, low
* level.
* Frees the cell at the specified `pointer`; for all the types of cons-space
* object which point to other cons-space objects, cascade the decrement.
* Dangerous, primitive, low level.
*
* @pointer the cell to free
*/
@ -136,63 +140,62 @@ void free_cell( struct cons_pointer pointer ) {
debug_printf( DEBUG_ALLOC, L"Freeing cell " );
debug_dump_object( pointer, DEBUG_ALLOC );
switch ( cell->tag.value ) {
/* for all the types of cons-space object which point to other
* cons-space objects, cascade the decrement. */
case CONSTV:
dec_ref( cell->payload.cons.car );
dec_ref( cell->payload.cons.cdr );
break;
case EXCEPTIONTV:
dec_ref( cell->payload.exception.message );
dec_ref( cell->payload.exception.frame );
break;
case FUNCTIONTV:
dec_ref( cell->payload.function.source );
break;
case INTEGERTV:
dec_ref( cell->payload.integer.more );
break;
case LAMBDATV:
case NLAMBDATV:
dec_ref( cell->payload.lambda.args );
dec_ref( cell->payload.lambda.body );
break;
case RATIOTV:
dec_ref( cell->payload.ratio.dividend );
dec_ref( cell->payload.ratio.divisor );
break;
case SPECIALTV:
dec_ref( cell->payload.special.source );
break;
case STRINGTV:
case SYMBOLTV:
dec_ref( cell->payload.string.cdr );
break;
case VECTORPOINTTV:
/* for vector space pointers, free the actual vector-space
* object. Dangerous! */
debug_printf( DEBUG_ALLOC,
L"About to free vector-space object at 0x%lx\n",
cell->payload.vectorp.address );
struct vector_space_object *vso = cell->payload.vectorp.address;
switch ( vso->header.tag.value ) {
case STACKFRAMETV:
free_stack_frame( get_stack_frame( pointer ) );
break;
}
free( ( void * ) cell->payload.vectorp.address );
debug_printf( DEBUG_ALLOC,
L"Freed vector-space object at 0x%lx\n",
cell->payload.vectorp.address );
break;
}
if ( !check_tag( pointer, FREETAG ) ) {
if ( cell->count == 0 ) {
switch ( cell->tag.value ) {
case CONSTV:
dec_ref( cell->payload.cons.car );
dec_ref( cell->payload.cons.cdr );
break;
case EXCEPTIONTV:
dec_ref( cell->payload.exception.message );
dec_ref( cell->payload.exception.frame );
break;
case FUNCTIONTV:
dec_ref( cell->payload.function.source );
break;
case INTEGERTV:
dec_ref( cell->payload.integer.more );
break;
case LAMBDATV:
case NLAMBDATV:
dec_ref( cell->payload.lambda.args );
dec_ref( cell->payload.lambda.body );
break;
case RATIOTV:
dec_ref( cell->payload.ratio.dividend );
dec_ref( cell->payload.ratio.divisor );
break;
case SPECIALTV:
dec_ref( cell->payload.special.source );
break;
case STRINGTV:
case SYMBOLTV:
dec_ref( cell->payload.string.cdr );
break;
case VECTORPOINTTV:
/* for vector space pointers, free the actual vector-space
* object. Dangerous! */
debug_printf( DEBUG_ALLOC,
L"About to free vector-space object at 0x%lx\n",
cell->payload.vectorp.address );
struct vector_space_object *vso =
cell->payload.vectorp.address;
switch ( vso->header.tag.value ) {
case STACKFRAMETV:
free_stack_frame( get_stack_frame( pointer ) );
break;
}
free( ( void * ) cell->payload.vectorp.address );
debug_printf( DEBUG_ALLOC,
L"Freed vector-space object at 0x%lx\n",
cell->payload.vectorp.address );
break;
}
strncpy( &cell->tag.bytes[0], FREETAG, TAGLENGTH );
cell->payload.free.car = NIL;
cell->payload.free.cdr = freelist;
@ -210,11 +213,14 @@ void free_cell( struct cons_pointer pointer ) {
}
/**
* Allocates a cell with the specified tag. Dangerous, primitive, low
* Allocates a cell with the specified `tag`. Dangerous, primitive, low
* level.
*
* @param tag the tag of the cell to allocate - must be a valid cons space tag.
* @return the cons pointer which refers to the cell allocated.
* \todo handle the case where another cons_page cannot be allocated;
* 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 result = freelist;

26
src/memory/conspage.h
View file

@ -37,42 +37,16 @@ struct cons_page {
struct cons_space_object cell[CONSPAGESIZE];
};
/**
* The (global) pointer to the (global) freelist. Not sure whether this ultimately
* belongs in this file.
*/
extern struct cons_pointer freelist;
/**
* An array of pointers to cons pages.
*/
extern struct cons_page *conspages[NCONSPAGES];
/**
* Frees the cell at the specified pointer. Dangerous, primitive, low
* level.
*
* @pointer the cell to free
*/
void free_cell( struct cons_pointer pointer );
/**
* Allocates a cell with the specified tag. Dangerous, primitive, low
* level.
*
* @param tag the tag of the cell to allocate - must be a valid cons space tag.
* @return the cons pointer which refers to the cell allocated.
*/
struct cons_pointer allocate_cell( char *tag );
/**
* initialise the cons page system; to be called exactly once during startup.
*/
void initialise_cons_pages( );
/**
* dump the allocated pages to this output stream.
*/
void dump_pages( FILE * output );
#endif

26
src/memory/consspaceobject.c
View file

@ -25,9 +25,9 @@
#include "stack.h"
/**
* Check that the tag on the cell at this pointer is this tag
* True if the tag on the cell at this `pointer` is this `tag`, else false.
*/
int check_tag( struct cons_pointer pointer, char *tag ) {
bool check_tag( struct cons_pointer pointer, char *tag ) {
struct cons_space_object cell = pointer2cell( pointer );
return strncmp( &cell.tag.bytes[0], tag, TAGLENGTH ) == 0;
}
@ -178,12 +178,12 @@ make_string_like_thing( wint_t c, struct cons_pointer tail, char *tag ) {
inc_ref( tail );
cell->payload.string.character = c;
cell->payload.string.cdr.page = tail.page;
/* TODO: There's a problem here. Sometimes the offsets on
/* \todo There's a problem here. Sometimes the offsets on
* strings are quite massively off. Fix is probably
* cell->payload.string.cdr = tsil */
cell->payload.string.cdr.offset = tail.offset;
} else {
// TODO: should throw an exception!
// \todo should throw an exception!
debug_printf( DEBUG_ALLOC,
L"Warning: only NIL and %s can be prepended to %s\n",
tag, tag );
@ -193,17 +193,23 @@ make_string_like_thing( wint_t c, struct cons_pointer tail, char *tag ) {
}
/**
* Construct a string from this character and
* this tail. A string is implemented as a flat list of cells each of which
* has one character and a pointer to the next; in the last cell the
* pointer to next is NIL.
* Construct a string from the character `c` and this `tail`. A string is
* implemented as a flat list of cells each of which has one character and a
* pointer to the next; in the last cell the pointer to next is NIL.
*
* @param c the character to add (prepend);
* @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 );
}
/**
* Construct a symbol from this character and this tail.
* Construct a symbol from the character `c` and this `tail`. A symbol is
* internally identical to a string except for having a different tag.
*
* @param c the character to add (prepend);
* @param tail the symbol which is being built.
*/
struct cons_pointer make_symbol( wint_t c, struct cons_pointer tail ) {
return make_string_like_thing( c, tail, SYMBOLTAG );
@ -239,7 +245,7 @@ struct cons_pointer make_read_stream( FILE * input ) {
}
/**
* Construct a cell which points to a stream open for writeing.
* Construct a cell which points to a stream open for writing.
* @param output the C stream to wrap.
*/
struct cons_pointer make_write_stream( FILE * output ) {

359
src/memory/consspaceobject.h
View file

@ -1,4 +1,4 @@
/**
/*
* consspaceobject.h
*
* Declarations common to all cons space objects.
@ -25,113 +25,189 @@
*/
#define TAGLENGTH 4
/**
* tag values, all of which must be 4 bytes. Must not collide with vector space tag values
/*
* tag values, all of which must be 4 bytes. Must not collide with vector space
* tag values
*/
/**
* An ordinary cons cell: 1397641027
* An ordinary cons cell:
*/
#define CONSTAG "CONS"
/**
* The string `CONS`, considered as an `unsigned int`.
*/
#define CONSTV 1397641027
/**
* An exception.
*/
#define EXCEPTIONTAG "EXEP"
/**
* The string `EXEP`, considered as an `unsigned int`.
*/
#define EXCEPTIONTV 1346721861
/**
* An unallocated cell on the free list - should never be encountered by a Lisp
* function. 1162170950
* function.
*/
#define FREETAG "FREE"
/**
* The string `FREE`, considered as an `unsigned int`.
*/
#define FREETV 1162170950
/**
* An ordinary Lisp function - one whose arguments are pre-evaluated and passed as
* a stack frame. 1129207110
* An ordinary Lisp function - one whose arguments are pre-evaluated.
* \see LAMBDATAG for interpretable functions.
* \see SPECIALTAG for functions whose arguments are not pre-evaluated.
*/
#define FUNCTIONTAG "FUNC"
#define FUNCTIONTV 1129207110
/**
* An integer number. 1381256777
* The string `FUNC`, considered as an `unsigned int`.
*/
#define FUNCTIONTV 1129207110
/**
* An integer number (bignums are integers).
*/
#define INTEGERTAG "INTR"
/**
* The string `INTR`, considered as an `unsigned int`.
*/
#define INTEGERTV 1381256777
/**
* A lambda cell.
* A lambda cell. Lambdas are the interpretable (source) versions of functions.
* \see FUNCTIONTAG.
*/
#define LAMBDATAG "LMDA"
/**
* The string `LMDA`, considered as an `unsigned int`.
*/
#define LAMBDATV 1094995276
/**
* The special cons cell at address {0,0} whose car and cdr both point to itself.
* 541870414
* The special cons cell at address {0,0} whose car and cdr both point to
* itself.
*/
#define NILTAG "NIL "
/**
* The string `NIL `, considered as an `unsigned int`.
*/
#define NILTV 541870414
/**
* An nlambda cell.
* An nlambda cell. NLambdas are the interpretable (source) versions of special
* forms. \see SPECIALTAG.
*/
#define NLAMBDATAG "NLMD"
/**
* The string `NLMD`, considered as an `unsigned int`.
*/
#define NLAMBDATV 1145916494
/**
* A rational number, stored as pointers two integers representing dividend
* and divisor respectively.
*/
#define RATIOTAG "RTIO"
/**
* The string `RTIO`, considered as an `unsigned int`.
*/
#define RATIOTV 1330205778
/**
* An open read stream.
*/
#define READTAG "READ"
/**
* The string `READ`, considered as an `unsigned int`.
*/
#define READTV 1145128274
/**
* A real number.
* A real number, represented internally as an IEEE 754-2008 `binary64`.
*/
#define REALTAG "REAL"
/**
* The string `REAL`, considered as an `unsigned int`.
*/
#define REALTV 1279346002
/**
* A ratio.
*/
#define RATIOTAG "RTIO"
#define RATIOTV 1330205778
/**
* A special form - one whose arguments are not pre-evaluated but passed as a
* s-expression. 1296453715
* A special form - one whose arguments are not pre-evaluated but passed as
* provided.
* \see NLAMBDATAG.
*/
#define SPECIALTAG "SPFM"
/**
* The string `SPFM`, considered as an `unsigned int`.
*/
#define SPECIALTV 1296453715
/**
* A string of characters, organised as a linked list. 1196577875
* A string of characters, organised as a linked list.
*/
#define STRINGTAG "STRG"
/**
* The string `STRG`, considered as an `unsigned int`.
*/
#define STRINGTV 1196577875
/**
* A symbol is just like a string except not self-evaluating. 1112365395
* A symbol is just like a string except not self-evaluating.
*/
#define SYMBOLTAG "SYMB"
/**
* The string `SYMB`, considered as an `unsigned int`.
*/
#define SYMBOLTV 1112365395
/**
* The special cons cell at address {0,1} which is canonically different from NIL.
* 1163219540
* The special cons cell at address {0,1} which is canonically different
* from NIL.
*/
#define TRUETAG "TRUE"
/**
* The string `TRUE`, considered as an `unsigned int`.
*/
#define TRUETV 1163219540
/**
* A pointer to an object in vector space.
*/
#define VECTORPOINTTAG "VECP"
/**
* The string `VECP`, considered as an `unsigned int`.
*/
#define VECTORPOINTTV 1346585942
/**
* An open write stream.
*/
#define WRITETAG "WRIT"
/**
* The string `WRIT`, considered as an `unsigned int`.
*/
#define WRITETV 1414091351
/**
@ -154,96 +230,103 @@
*/
#define tag2uint(tag) ((uint32_t)*tag)
/**
* given a cons_pointer as argument, return the cell.
*/
#define pointer2cell(pointer) ((conspages[pointer.page]->cell[pointer.offset]))
/**
* true if conspointer points to the special cell NIL, else false
* 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))
/**
* true if conspointer points to a cons cell, else false
* true if `conspoint` points to a cons cell, else false
*/
#define consp(conspoint) (check_tag(conspoint,CONSTAG))
/**
* true if conspointer points to an exception, else false
* true if `conspoint` points to an exception, else false
*/
#define exceptionp(conspoint) (check_tag(conspoint,EXCEPTIONTAG))
/**
* true if conspointer points to a function cell, else false
* true if `conspoint` points to a function cell, else false
*/
#define functionp(conspoint) (check_tag(conspoint,FUNCTIONTAG))
/**
* true if conspointer points to a special Lambda cell, else false
* true if `conspoint` points to a special Lambda cell, else false
*/
#define lambdap(conspoint) (check_tag(conspoint,LAMBDATAG))
/**
* true if conspointer points to a special form cell, else false
* true if `conspoint` points to a special form cell, else false
*/
#define specialp(conspoint) (check_tag(conspoint,SPECIALTAG))
/**
* true if conspointer points to a string cell, else false
* true if `conspoint` points to a string cell, else false
*/
#define stringp(conspoint) (check_tag(conspoint,STRINGTAG))
/**
* true if conspointer points to a symbol cell, else false
* true if `conspoint` points to a symbol cell, else false
*/
#define symbolp(conspoint) (check_tag(conspoint,SYMBOLTAG))
/**
* true if conspointer points to an integer cell, else false
* true if `conspoint` points to an integer cell, else false
*/
#define integerp(conspoint) (check_tag(conspoint,INTEGERTAG))
/**
* true if conspointer points to a rational number cell, else false
* true if `conspoint` points to a rational number cell, else false
*/
#define ratiop(conspoint) (check_tag(conspoint,RATIOTAG))
/**
* true if conspointer points to a read stream cell, else false
* true if `conspoint` points to a read stream cell, else false
*/
#define readp(conspoint) (check_tag(conspoint,READTAG))
/**
* true if conspointer points to a real number cell, else false
* true if `conspoint` points to a real number cell, else false
*/
#define realp(conspoint) (check_tag(conspoint,REALTAG))
/**
* true if conspointer points to some sort of a number cell,
* 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)||check_tag(conspoint,BIGNUMTAG))
/**
* 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))
/**
* true if thr conspointer points to a vector pointer.
* true if `conspoint` points to a vector pointer, else false.
*/
#define vectorpointp(conspoint) (check_tag(conspoint,VECTORPOINTTAG))
/**
* true if conspointer points to a write stream cell, else false.
* true if `conspoint` points to a write stream cell, else false.
*/
#define writep(conspoint) (check_tag(conspoint,WRITETAG))
/**
* true if conspointer points to a true cell, else false
* 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) (checktag(conspoint,TRUETAG))
/**
* true if conspoint points to something that is truthy, i.e.
* true if `conspoint` points to something that is truthy, i.e.
* anything but NIL.
*/
#define truep(conspoint) (!checktag(conspoint,NILTAG))
@ -265,16 +348,18 @@ struct cons_pointer {
/**
* A stack frame. Yes, I know it isn't a cons-space object, but it's defined
* here to avoid circularity. TODO: refactor.
* here to avoid circularity. \todo refactor.
*/
struct stack_frame {
struct cons_pointer previous; /* the previous frame */
/** the previous frame. */
struct cons_pointer previous;
/** first 8 arument bindings. */
struct cons_pointer arg[args_in_frame];
/*
* first 8 arument bindings
*/
struct cons_pointer more; /* list of any further argument bindings */
struct cons_pointer function; /* the function to be called */
/** list of any further argument bindings. */
struct cons_pointer more;
/** the function to be called. */
struct cons_pointer function;
/** the number of arguments provided. */
int args;
};
@ -282,7 +367,9 @@ struct stack_frame {
* payload of a cons cell.
*/
struct cons_payload {
/** Contents of the Address Register, naturally. */
struct cons_pointer car;
/** Contents of the Decrement Register, naturally. */
struct cons_pointer cdr;
};
@ -291,7 +378,9 @@ struct cons_payload {
* Message should be a Lisp string; frame should be a pointer to an (unfreed) stack frame.
*/
struct exception_payload {
/** The message: should be a Lisp string but in practice anything printable will do. */
struct cons_pointer message;
/** pointer to the (unfreed) stack frame in which the exception was thrown. */
struct cons_pointer frame;
};
@ -305,7 +394,17 @@ struct exception_payload {
* result).
*/
struct function_payload {
/**
* pointer to the source from which the function was compiled, or NIL
* if it is a primitive.
*/
struct cons_pointer source;
/** pointer to a function which takes a cons pointer (representing
* its argument list) and a cons pointer (representing its environment) and a
* stack frame (representing the previous stack frame) as arguments and returns
* a cons pointer (representing its result).
* \todo check this documentation is current!
*/
struct cons_pointer ( *executable ) ( struct stack_frame *,
struct cons_pointer,
struct cons_pointer );
@ -321,28 +420,37 @@ struct free_payload {
};
/**
* payload of an integer cell. For the time being just a signed integer;
* later might be a signed 128 bit integer, or might have some flag to point to an
* optional bignum object.
* payload of an integer cell. An integer is in principle a sequence of cells;
* only 60 bits (+ sign bit) are actually used in each cell. If the value
* exceeds 60 bits, the least significant 60 bits are stored in the first cell
* in the chain, the next 60 in the next cell, and so on. Only the value of the
* first cell in any chain should be negative.
*/
struct integer_payload {
/** the value of the payload (i.e. 60 bits) of this cell. */
int64_t value;
/** the next (more significant) cell in the chain, ir `NIL` if there are no
* more. */
struct cons_pointer more;
};
/**
* payload for lambda and nlambda cells
* payload for lambda and nlambda cells.
*/
struct lambda_payload {
/** the arument list */
struct cons_pointer args;
/** the body of the function to be applied to the arguments. */
struct cons_pointer body;
};
/**
* payload for ratio cells. Both dividend and divisor must point to integer (or, later, bignum) cells.
* payload for ratio cells. Both `dividend` and `divisor` must point to integer cells.
*/
struct ratio_payload {
/** a pointer to an integer representing the dividend */
struct cons_pointer dividend;
/** a pointer to an integer representing the divisor. */
struct cons_pointer divisor;
};
@ -351,20 +459,25 @@ struct ratio_payload {
* precision, but I'm not sure of the detail.
*/
struct real_payload {
/** the value of the number */
long double value;
};
/**
* Payload of a special form cell.
* source points to the source from which the function was compiled, or NIL
* if it is a primitive.
* executable points to a function which takes a cons pointer (representing
* its argument list) and a cons pointer (representing its environment) and a
* stack frame (representing the previous stack frame) as arguments and returns
* a cons pointer (representing its result).
* Payload of a special form cell. Currently identical to the payload of a
* function cell.
* \see function_payload
*/
struct special_payload {
/**
* pointer to the source from which the special form was compiled, or NIL
* if it is a primitive.
*/
struct cons_pointer source;
/** pointer to a function which takes a cons pointer (representing
* its argument list) and a cons pointer (representing its environment) and a
* stack frame (representing the previous stack frame) as arguments and returns
* a cons pointer (representing its result). */
struct cons_pointer ( *executable ) ( struct stack_frame *,
struct cons_pointer,
struct cons_pointer );
@ -374,6 +487,7 @@ struct special_payload {
* payload of a read or write stream cell.
*/
struct stream_payload {
/** the stream to read from or write to. */
FILE *stream;
};
@ -384,8 +498,11 @@ struct stream_payload {
* payload of a string cell.
*/
struct string_payload {
wint_t character; /* the actual character stored in this cell */
uint32_t padding; /* unused padding to word-align the cdr */
/** the actual character stored in this cell */
wint_t character;
/** unused padding to word-align the cdr */
uint32_t padding;
/** the remainder of the string following this character. */
struct cons_pointer cdr;
};
@ -393,19 +510,21 @@ struct string_payload {
* payload of a vector pointer cell.
*/
struct vectorp_payload {
/** the tag of the vector-space object. NOTE that the vector space object
* should itself have the identical tag. */
union {
char bytes[TAGLENGTH]; /* the tag (type) of the
* vector-space object this cell
* points to, considered as bytes.
* NOTE that the vector space object
* should itself have the identical
* tag. */
uint32_t value; /* the tag considered as a number */
/** the tag (type) of the vector-space object this cell
* points to, considered as bytes. */
char bytes[TAGLENGTH];
/** the tag considered as a number */
uint32_t value;
} tag;
void *address;
/* the address of the actual vector space
* object (TODO: will change when I actually
/** unused padding to word-align the address */
uint32_t padding;
/** the address of the actual vector space
* object (\todo will change when I actually
* implement vector space) */
void *address;
};
/**
@ -413,87 +532,80 @@ struct vectorp_payload {
*/
struct cons_space_object {
union {
char bytes[TAGLENGTH]; /* the tag (type) of this cell,
* considered as bytes */
uint32_t value; /* the tag considered as a number */
/** the tag (type) of this cell,
* considered as bytes */
char bytes[TAGLENGTH];
/** the tag considered as a number */
uint32_t value;
} tag;
uint32_t count; /* the count of the number of references to
* this cell */
struct cons_pointer access; /* cons pointer to the access control list of
* this cell */
/** the count of the number of references to this cell */
uint32_t count;
/** cons pointer to the access control list of this cell */
struct cons_pointer access;
union {
/*
/**
* if tag == CONSTAG
*/
struct cons_payload cons;
/*
/**
* if tag == EXCEPTIONTAG
*/
struct exception_payload exception;
/*
/**
* if tag == FREETAG
*/
struct free_payload free;
/*
/**
* if tag == FUNCTIONTAG
*/
struct function_payload function;
/*
/**
* if tag == INTEGERTAG
*/
struct integer_payload integer;
/*
/**
* if tag == LAMBDATAG or NLAMBDATAG
*/
struct lambda_payload lambda;
/*
/**
* if tag == NILTAG; we'll treat the special cell NIL as just a cons
*/
struct cons_payload nil;
/*
/**
* if tag == RATIOTAG
*/
struct ratio_payload ratio;
/*
/**
* if tag == READTAG || tag == WRITETAG
*/
struct stream_payload stream;
/*
/**
* if tag == REALTAG
*/
struct real_payload real;
/*
/**
* if tag == SPECIALTAG
*/
struct special_payload special;
/*
/**
* if tag == STRINGTAG || tag == SYMBOLTAG
*/
struct string_payload string;
/*
/**
* if tag == TRUETAG; we'll treat the special cell T as just a cons
*/
struct cons_payload t;
/*
/**
* if tag == VECTORPTAG
*/
struct vectorp_payload vectorp;
} payload;
};
/**
* Check that the tag on the cell at this pointer is this tag
*/
int check_tag( struct cons_pointer pointer, char *tag );
bool check_tag( struct cons_pointer pointer, char *tag );
/**
* increment the reference count of the object at this cons pointer
*/
void inc_ref( struct cons_pointer pointer );
/**
* decrement the reference count of the object at this cons pointer
*/
void dec_ref( struct cons_pointer pointer );
struct cons_pointer make_cons( struct cons_pointer car,
@ -502,71 +614,34 @@ struct cons_pointer make_cons( struct cons_pointer car,
struct cons_pointer make_exception( struct cons_pointer message,
struct cons_pointer frame_pointer );
/**
* Construct a cell which points to an executable Lisp special form.
*/
struct cons_pointer make_function( struct cons_pointer src,
struct cons_pointer ( *executable )
( struct stack_frame *,
struct cons_pointer,
struct cons_pointer ) );
/**
* Construct a lambda (interpretable source) cell
*/
struct cons_pointer make_lambda( struct cons_pointer args,
struct cons_pointer body );
/**
* Construct an nlambda (interpretable source) cell; to a
* lambda as a special form is to a function.
*/
struct cons_pointer make_nlambda( struct cons_pointer args,
struct cons_pointer body );
/**
* Construct a cell which points to an executable Lisp special form.
*/
struct cons_pointer make_special( struct cons_pointer src,
struct cons_pointer ( *executable )
( struct stack_frame *,
struct cons_pointer,
struct cons_pointer ) );
/**
* Construct a string from this character and this tail. A string is
* implemented as a flat list of cells each of which has one character and a
* pointer to the next; in the last cell the pointer to next is NIL.
*/
struct cons_pointer make_string( wint_t c, struct cons_pointer tail );
/**
* Construct a symbol from this character and this tail. A symbol is identical
* to a string except for having a different tag.
*/
struct cons_pointer make_symbol( wint_t c, struct cons_pointer tail );
/**
* Construct a cell which points to a stream open for reading.
* @param input the C stream to wrap.
*/
struct cons_pointer make_read_stream( FILE * input );
/**
* Construct a cell which points to a stream open for writeing.
* @param output the C stream to wrap.
*/
struct cons_pointer make_write_stream( FILE * output );
/**
* Return a lisp string representation of this old skool ASCII string.
*/
struct cons_pointer c_string_to_lisp_string( wchar_t *string );
/**
* Return a lisp symbol representation of this old skool ASCII string.
*/
struct cons_pointer c_string_to_lisp_symbol( wchar_t *symbol );
#endif

1
src/memory/dump.c
View file

@ -151,4 +151,3 @@ void dump_object( FILE * output, struct cons_pointer pointer ) {
break;
}
}

5
src/memory/dump.h
View file

@ -1,4 +1,4 @@
/**
/*
* dump.h
*
* Dump representations of both cons space and vector space objects.
@ -20,9 +20,6 @@
#define __dump_h
/**
* dump the object at this cons_pointer to this output stream.
*/
void dump_object( FILE * output, struct cons_pointer pointer );
#endif

25
src/memory/stack.c
View file

@ -26,14 +26,22 @@
#include "stack.h"
#include "vectorspace.h"
/**
* set a register in a stack frame. Alwaye use this to do so,
* because that way we can be sure the inc_ref happens!
*/
void set_reg( struct stack_frame *frame, int reg, struct cons_pointer value ) {
debug_printf( DEBUG_STACK, L"Setting register %d to ", reg );
debug_print_object( value, DEBUG_STACK );
debug_println( DEBUG_STACK );
frame->arg[reg++] = value;
dec_ref(frame->arg[reg]); /* if there was anything in that slot
* previously other than NIL, we need to decrement it;
* NIL won't be decremented as it is locked. */
frame->arg[reg] = value;
inc_ref( value );
if ( reg > frame->args ) {
frame->args = reg;
if ( reg == frame->args ) {
frame->args++;
}
}
@ -71,15 +79,10 @@ struct cons_pointer make_empty_frame( struct cons_pointer previous ) {
debug_dump_object( result, DEBUG_ALLOC );
// debug_printf( DEBUG_STACK,
// L"make_empty_frame: got vector_space_object with size %lu, tag %4.4s\n",
// pointer_to_vso( result )->header.size,
// &pointer_to_vso( result )->header.tag.bytes );
if ( !nilp( result ) ) {
struct stack_frame *frame = get_stack_frame( result );
/*
* TODO: later, pop a frame off a free-list of stack frames
* \todo later, pop a frame off a free-list of stack frames
*/
frame->previous = previous;
@ -131,7 +134,7 @@ struct cons_pointer make_stack_frame( struct cons_pointer previous,
struct cons_space_object cell = pointer2cell( args );
/*
* TODO: if we were running on real massively parallel hardware,
* \todo if we were running on real massively parallel hardware,
* each arg except the first should be handed off to another
* processor to be evaled in parallel; but see notes here:
* https://github.com/simon-brooke/post-scarcity/wiki/parallelism
@ -220,7 +223,7 @@ struct cons_pointer make_special_frame( struct cons_pointer previous,
*/
void free_stack_frame( struct stack_frame *frame ) {
/*
* TODO: later, push it back on the stack-frame freelist
* \todo later, push it back on the stack-frame freelist
*/
debug_print( L"Entering free_stack_frame\n", DEBUG_ALLOC );
for ( int i = 0; i < args_in_frame; i++ ) {

8
src/memory/stack.h
View file

@ -35,12 +35,6 @@
*/
#define stackframep(vso)(((struct vector_space_object *)vso)->header.tag.value == STACKFRAMETV)
/**
* set a register in a stack frame. Alwaye use this macro to do so,
• because that way we can be sure the inc_ref happens!
*/
//#define set_reg(frame,register,value){frame->arg[register]=value; inc_ref(value);}
void set_reg( struct stack_frame *frame, int reg, struct cons_pointer value );
struct stack_frame *get_stack_frame( struct cons_pointer pointer );
@ -65,7 +59,7 @@ struct cons_pointer make_special_frame( struct cons_pointer previous,
/*
* struct stack_frame is defined in consspaceobject.h to break circularity
* TODO: refactor.
* \todo refactor.
*/
#endif

31
src/memory/vectorspace.c
View file

@ -26,19 +26,28 @@
/**
* make a cons-space object which points to the vector space object
* Make a cons_space_object which points to the vector_space_object
* with this `tag` at this `address`.
* NOTE that `tag` should be the vector-space tag of the particular type of
* vector-space object, NOT `VECTORPOINTTAG`.
*
* @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`.
*
* @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 ) {
struct cons_pointer make_vec_pointer( struct vector_space_object *address, char *tag ) {
debug_print( L"Entered make_vec_pointer\n", DEBUG_ALLOC );
struct cons_pointer pointer = allocate_cell( VECTORPOINTTAG );
struct cons_space_object *cell = &pointer2cell( pointer );
debug_printf( DEBUG_ALLOC,
L"make_vec_pointer: tag written, about to set pointer address to %p\n",
address );
cell->payload.vectorp.address = address;
strncpy(&cell->payload.vectorp.tag.bytes[0], tag, TAGLENGTH);
debug_printf( DEBUG_ALLOC,
L"make_vec_pointer: all good, returning pointer to %p\n",
cell->payload.vectorp.address );
@ -49,11 +58,15 @@ struct cons_pointer make_vec_pointer( struct vector_space_object *address ) {
}
/**
* allocate a vector space object with this `payload_size` and `tag`,
* Allocate a vector space object with this `payload_size` and `tag`,
* and return a `cons_pointer` which points to an object whigh points to it.
* NOTE that `tag` should be the vector-space tag of the particular type of
* vector-space object, NOT `VECTORPOINTTAG`.
* Returns NIL if the vector could not be allocated due to memory exhaustion.
*
* @tag the vector-space tag of the particular type of vector-space object,
* NOT `VECTORPOINTTAG`.
* @payload_size the size of the payload required, in bytes.
*
* @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 ) {
debug_print( L"Entered make_vso\n", DEBUG_ALLOC );
@ -72,7 +85,7 @@ struct cons_pointer make_vso( char *tag, uint64_t payload_size ) {
L"make_vso: about to write tag '%s' into vso at %p\n",
tag, vso );
strncpy( &vso->header.tag.bytes[0], tag, TAGLENGTH );
result = make_vec_pointer( vso );
result = make_vec_pointer( vso, tag );
debug_dump_object( result, DEBUG_ALLOC );
vso->header.vecp = result;
// memcpy(vso->header.vecp, result, sizeof(struct cons_pointer));

46
src/memory/vectorspace.h
View file

@ -40,32 +40,48 @@
#define VECTORTAG "VECT"
#define VECTORTV 0
/**
* given a pointer to a vector space object, return the object.
*/
#define pointer_to_vso(pointer)((vectorpointp(pointer)? (struct vector_space_object *) pointer2cell(pointer).payload.vectorp.address : (struct vector_space_object *) NULL))
#define vso_get_vecp(vso)((vso->header.vecp))
/**
* given a vector space object, return its canonical pointer.
*/
#define vso_get_vecp(vso)((((vector_space_object)vso)->header.vecp))
struct cons_pointer make_vso( char *tag, uint64_t payload_size );
/**
* the header which forms the start of every vector space object.
*/
struct vector_space_header {
/** the tag (type) of this vector-space object. */
union {
char bytes[TAGLENGTH]; /* the tag (type) of the
* vector-space object this cell
* points to, considered as bytes.
* NOTE that the vector space object
* should itself have the identical
* tag. */
uint32_t value; /* the tag considered as a number */
/** the tag considered as bytes. */
char bytes[TAGLENGTH];
/** the tag considered as a number */
uint32_t value;
} tag;
struct cons_pointer vecp; /* back pointer to the vector pointer
* which uniquely points to this vso */
uint64_t size; /* the size of my payload, in bytes */
/** back pointer to the vector pointer which uniquely points to this vso */
struct cons_pointer vecp;
/** the size of my payload, in bytes */
uint64_t size;
};
/** a vector_space_object is just a vector_space_header followed by a
* lump of bytes; what we deem to be in there is a function of the tag,
* and at this stage we don't have a good picture of what these may be.
*
* \see stack_frame for an example payload;
* \see make_empty_frame for an example of how to initialise and use one.
*/
struct vector_space_object {
/** the header of this object */
struct vector_space_header header;
char payload; /* we'll malloc `size` bytes for payload,
* `payload` is just the first of these.
* TODO: this is almost certainly not
* idiomatic C. */
/** we'll malloc `size` bytes for payload, `payload` is just the first of these.
* \todo this is almost certainly not idiomatic C. */
char payload;
};
#endif