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

Horribly broken, may have to rethink.

Browse source
This commit is contained in:
Simon Brooke 2018-12-26 21:10:24 +00:00
parent 9937f344dc
commit 3d5c27cb10
19 changed files with 568 additions and 413 deletions
Download patch file Download diff file Expand all files Collapse all files

26
src/memory/consspaceobject.c
View file

@ -89,21 +89,21 @@ struct cons_pointer make_cons( struct cons_pointer car,
* @param frame_pointer should be the pointer to the frame in which the exception occurred.
*/
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_space_object *cell = &pointer2cell( pointer );
struct cons_pointer frame_pointer ) {
struct cons_pointer result = NIL;
struct cons_pointer pointer = allocate_cell( EXCEPTIONTAG );
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 */
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 */
inc_ref( message );
inc_ref( frame_pointer);
cell->payload.exception.message = message;
cell->payload.exception.frame = frame_pointer;
inc_ref( message );
inc_ref( frame_pointer );
cell->payload.exception.message = message;
cell->payload.exception.frame = frame_pointer;
result = pointer;
result = pointer;
return result;
return result;
}
@ -113,7 +113,7 @@ struct cons_pointer make_exception( struct cons_pointer message,
struct cons_pointer
make_function( struct cons_pointer src, struct cons_pointer ( *executable )
( struct stack_frame *,
struct cons_pointer, struct cons_pointer ) ) {
struct cons_pointer, struct cons_pointer ) ) {
struct cons_pointer pointer = allocate_cell( FUNCTIONTAG );
struct cons_space_object *cell = &pointer2cell( pointer );
@ -212,7 +212,7 @@ struct cons_pointer make_symbol( wint_t c, struct cons_pointer tail ) {
struct cons_pointer
make_special( struct cons_pointer src, struct cons_pointer ( *executable )
( struct stack_frame * frame,
struct cons_pointer, struct cons_pointer env ) ) {
struct cons_pointer, struct cons_pointer env ) ) {
struct cons_pointer pointer = allocate_cell( SPECIALTAG );
struct cons_space_object *cell = &pointer2cell( pointer );

8
src/memory/consspaceobject.h
View file

@ -421,10 +421,10 @@ struct vectorp_payload {
* tag. */
uint32_t value; /* the tag considered as a number */
} tag;
struct vector_space_object * address;
/* the address of the actual vector space
* object (TODO: will change when I actually
* implement vector space) */
struct vector_space_object *address;
/* the address of the actual vector space
* object (TODO: will change when I actually
* implement vector space) */
};
/**

23
src/memory/dump.c
View file

@ -72,7 +72,7 @@ void dump_object( FILE * output, struct cons_pointer pointer ) {
break;
case EXCEPTIONTV:
fwprintf( output, L"\t\tException cell: " );
dump_stack_trace( output, pointer);
dump_stack_trace( output, pointer );
break;
case FREETV:
fwprintf( output, L"\t\tFree cell: next at page %d offset %d\n",
@ -93,10 +93,10 @@ void dump_object( FILE * output, struct cons_pointer pointer ) {
case RATIOTV:
fwprintf( output,
L"\t\tRational cell: value %ld/%ld, count %u\n",
pointer2cell( cell.payload.ratio.dividend ).payload.
integer.value,
pointer2cell( cell.payload.ratio.divisor ).payload.
integer.value, cell.count );
pointer2cell( cell.payload.ratio.dividend ).
payload.integer.value,
pointer2cell( cell.payload.ratio.divisor ).
payload.integer.value, cell.count );
break;
case READTV:
fwprintf( output, L"\t\tInput stream\n" );
@ -110,11 +110,12 @@ void dump_object( FILE * output, struct cons_pointer pointer ) {
case SYMBOLTV:
dump_string_cell( output, L"Symbol", pointer );
break;
case VECTORPOINTTV: {
struct vector_space_object * vso = cell.payload.vectorp.address;
fwprintf( output, L"\t\tVector space object of type %4.4s, payload size %d bytes\n",
vso->header.tag, vso->header.size);
}
break;
case VECTORPOINTTV:{
struct vector_space_object *vso = cell.payload.vectorp.address;
fwprintf( output,
L"\t\tVector space object of type %4.4s, payload size %d bytes\n",
vso->header.tag, vso->header.size );
}
break;
}
}

282
src/memory/stack.c
View file

@ -28,17 +28,26 @@
* get the actual stackframe object from this `pointer`, or NULL if
* `pointer` is not a stackframe pointer.
*/
struct stack_frame * get_stack_frame(struct cons_pointer pointer) {
struct stack_frame * result = NULL;
struct vector_space_object * vso =
pointer2cell(pointer).payload.vectorp.address;
struct stack_frame *get_stack_frame( struct cons_pointer pointer ) {
struct stack_frame *result = NULL;
fputws
( L"get_stack_frame: about to get a pointer to the vector space object\n",
stderr );
struct vector_space_object *vso =
pointer2cell( pointer ).payload.vectorp.address;
fputws( L"get_stack_frame: got a pointer, about to test it\n", stderr );
if (vectorpointp(pointer) && stackframep(vso))
{
result = (struct stack_frame *) &(vso->payload);
}
if ( vectorpointp( pointer ) ) { // && stackframep(vso)){
fputws( L"get_stack_frame: pointer is good, about to set the result\n",
stderr );
return result;
result = ( struct stack_frame * ) &( vso->payload );
fputws( L"get_stack_frame: all good, returning\n", stderr );
} else {
fputws( L"get_stack_frame: fail, returning NULL\n", stderr );
}
return result;
}
/**
@ -48,28 +57,38 @@ struct stack_frame * get_stack_frame(struct cons_pointer pointer) {
* @return the new frame, or NULL if memory is exhausted.
*/
struct cons_pointer make_empty_frame( struct cons_pointer previous ) {
struct cons_pointer result = make_vso(STACKFRAMETAG, sizeof(struct stack_frame));
if (!nilp(result)) {
struct stack_frame *frame = get_stack_frame(result);
/*
* TODO: later, pop a frame off a free-list of stack frames
*/
fputws( L"Entering make_empty_frame\n", stderr );
struct cons_pointer result =
make_vso( STACKFRAMETAG, sizeof( struct stack_frame ) );
if ( !nilp( result ) ) {
fputws( L"make_empty_frame: about to call get_stack_frame\n", stderr );
struct stack_frame *frame = get_stack_frame( result );
/*
* TODO: later, pop a frame off a free-list of stack frames
*/
frame->previous = previous;
inc_ref(previous);
fwprintf( stderr,
L"make_empty_frame: about to set previous to %4.4s\n",
pointer2cell( previous ).tag );
frame->previous = previous;
fputws( L"make_empty_frame: about to call inc_ref\n", stderr );
inc_ref( previous );
/*
* clearing the frame with memset would probably be slightly quicker, but
* this is clear.
*/
frame->more = NIL;
frame->function = NIL;
frame->args = 0;
/*
* clearing the frame with memset would probably be slightly quicker, but
* this is clear.
*/
frame->more = NIL;
frame->function = NIL;
frame->args = 0;
for ( int i = 0; i < args_in_frame; i++ ) {
set_reg( frame, i, NIL );
fputws( L"make_empty_frame: about to initialise arg registers\n",
stderr );
for ( int i = 0; i < args_in_frame; i++ ) {
set_reg( frame, i, NIL );
}
}
}
fputws( L"Leaving make_empty_frame\n", stderr );
return result;
}
@ -83,67 +102,76 @@ struct cons_pointer make_empty_frame( struct cons_pointer previous ) {
* @return the new frame, or an exception if one occurred while building it.
*/
struct cons_pointer make_stack_frame( struct cons_pointer previous,
struct cons_pointer args,
struct cons_pointer env ) {
struct cons_pointer result = make_empty_frame( previous );
struct cons_pointer args,
struct cons_pointer env ) {
fputws( L"Entering make_stack_frame\n", stderr );
struct cons_pointer result = make_empty_frame( previous );
if (nilp(result))
{
/* i.e. out of memory */
result = make_exception(c_string_to_lisp_string( "Memory exhausted."), previous);
} else {
struct stack_frame * frame = get_stack_frame(result);
if ( nilp( result ) ) {
/* i.e. out of memory */
result =
make_exception( c_string_to_lisp_string( "Memory exhausted." ),
previous );
} else {
struct stack_frame *frame = get_stack_frame( result );
for ( frame->args = 0; frame->args < args_in_frame && consp( args ); frame->args++ ) {
/* iterate down the arg list filling in the arg slots in the
* frame. When there are no more slots, if there are still args,
* stash them on more */
struct cons_space_object cell = pointer2cell( args );
for ( frame->args = 0; frame->args < args_in_frame && consp( args );
frame->args++ ) {
/* iterate down the arg list filling in the arg slots in the
* frame. When there are no more slots, if there are still args,
* stash them on more */
struct cons_space_object cell = pointer2cell( args );
/*
* 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
*/
struct cons_pointer arg_frame_pointer = make_empty_frame( result);
inc_ref(arg_frame_pointer);
/*
* 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
*/
struct cons_pointer arg_frame_pointer = make_empty_frame( result );
inc_ref( arg_frame_pointer );
if(nilp(arg_frame_pointer)) {
result = make_exception(c_string_to_lisp_string( "Memory exhausted."), previous);
break;
} else {
struct stack_frame *arg_frame = get_stack_frame( arg_frame_pointer );
set_reg( arg_frame, 0, cell.payload.cons.car );
if ( nilp( arg_frame_pointer ) ) {
result =
make_exception( c_string_to_lisp_string
( "Memory exhausted." ), previous );
break;
} else {
struct stack_frame *arg_frame =
get_stack_frame( arg_frame_pointer );
set_reg( arg_frame, 0, cell.payload.cons.car );
struct cons_pointer val = lisp_eval( arg_frame, arg_frame_pointer, env );
if ( exceptionp( val ) ) {
result = val;
break;
} else {
set_reg( frame, frame->args, val );
struct cons_pointer val =
lisp_eval( arg_frame, arg_frame_pointer, env );
if ( exceptionp( val ) ) {
result = val;
break;
} else {
set_reg( frame, frame->args, val );
}
dec_ref( arg_frame_pointer );
args = cell.payload.cons.cdr;
}
}
dec_ref(arg_frame_pointer);
args = cell.payload.cons.cdr;
}
}
if (!exceptionp(result)) {
if ( consp( args ) ) {
/* if we still have args, eval them and stick the values on `more` */
struct cons_pointer more = eval_forms( get_stack_frame(previous), previous, args, env );
frame->more = more;
inc_ref( more );
}
if ( !exceptionp( result ) ) {
if ( consp( args ) ) {
/* if we still have args, eval them and stick the values on `more` */
struct cons_pointer more =
eval_forms( get_stack_frame( previous ), previous, args,
env );
frame->more = more;
inc_ref( more );
}
#ifdef DEBUG
dump_frame( stderr, result );
dump_frame( stderr, result );
#endif
}
}
}
fputws( L"Leaving make_stack_frame\n", stderr );
return result;
return result;
}
/**
@ -157,36 +185,40 @@ struct cons_pointer make_stack_frame( struct cons_pointer previous,
struct cons_pointer make_special_frame( struct cons_pointer previous,
struct cons_pointer args,
struct cons_pointer env ) {
struct cons_pointer result = make_empty_frame( previous );
fputws( L"Entering make_special_frame\n", stderr );
if (nilp(result))
{
/* i.e. out of memory */
result = make_exception(c_string_to_lisp_string( "Memory exhausted."), previous);
} else {
struct stack_frame * frame = get_stack_frame(result);
struct cons_pointer result = make_empty_frame( previous );
for ( frame->args = 0; frame->args < args_in_frame && !nilp( args ); frame->args++ ) {
/* iterate down the arg list filling in the arg slots in the
* frame. When there are no more slots, if there are still args,
* stash them on more */
struct cons_space_object cell = pointer2cell( args );
if ( nilp( result ) ) {
/* i.e. out of memory */
result =
make_exception( c_string_to_lisp_string( "Memory exhausted." ),
previous );
} else {
struct stack_frame *frame = get_stack_frame( result );
set_reg( frame, frame->args, cell.payload.cons.car );
for ( frame->args = 0; frame->args < args_in_frame && !nilp( args );
frame->args++ ) {
/* iterate down the arg list filling in the arg slots in the
* frame. When there are no more slots, if there are still args,
* stash them on more */
struct cons_space_object cell = pointer2cell( args );
args = cell.payload.cons.cdr;
}
if (!exceptionp(result)) {
if ( consp( args ) ) {
frame->more = args;
inc_ref( args );
}
set_reg( frame, frame->args, cell.payload.cons.car );
args = cell.payload.cons.cdr;
}
if ( !exceptionp( result ) ) {
if ( consp( args ) ) {
frame->more = args;
inc_ref( args );
}
#ifdef DEBUG
dump_frame( stderr, result );
dump_frame( stderr, result );
#endif
}
}
}
fputws( L"Leaving make_special_frame\n", stderr );
return result;
}
@ -215,37 +247,39 @@ void free_stack_frame( struct stack_frame *frame ) {
* @param frame_pointer the pointer to the frame
*/
void dump_frame( FILE * output, struct cons_pointer frame_pointer ) {
struct stack_frame *frame = get_stack_frame(frame_pointer);
struct stack_frame *frame = get_stack_frame( frame_pointer );
if (frame != NULL) {
for ( int arg = 0; arg < frame->args; arg++ ) {
struct cons_space_object cell = pointer2cell( frame->arg[arg] );
if ( frame != NULL ) {
for ( int arg = 0; arg < frame->args; arg++ ) {
struct cons_space_object cell = pointer2cell( frame->arg[arg] );
fwprintf( output, L"Arg %d:\t%c%c%c%c\tcount: %10u\tvalue: ", arg,
cell.tag.bytes[0],
cell.tag.bytes[1], cell.tag.bytes[2], cell.tag.bytes[3],
cell.count );
fwprintf( output, L"Arg %d:\t%c%c%c%c\tcount: %10u\tvalue: ", arg,
cell.tag.bytes[0],
cell.tag.bytes[1], cell.tag.bytes[2], cell.tag.bytes[3],
cell.count );
print( output, frame->arg[arg] );
fputws( L"\n", output );
print( output, frame->arg[arg] );
fputws( L"\n", output );
}
fputws( L"More: \t", output );
print( output, frame->more );
fputws( L"\n", output );
}
fputws( L"More: \t", output );
print( output, frame->more );
fputws( L"\n", output );
}
}
void dump_stack_trace(FILE * output, struct cons_pointer pointer) {
if (exceptionp(pointer)) {
print( output, pointer2cell(pointer).payload.exception.message );
fwprintf( output, L"\n" );
dump_stack_trace(output, pointer2cell(pointer).payload.exception.frame);
} else {
while (vectorpointp(pointer) && stackframep(pointer_to_vso(pointer))) {
dump_frame( output, pointer);
pointer = get_stack_frame(pointer)->previous;
void dump_stack_trace( FILE * output, struct cons_pointer pointer ) {
if ( exceptionp( pointer ) ) {
print( output, pointer2cell( pointer ).payload.exception.message );
fwprintf( output, L"\n" );
dump_stack_trace( output,
pointer2cell( pointer ).payload.exception.frame );
} else {
while ( vectorpointp( pointer )
&& stackframep( pointer_to_vso( pointer ) ) ) {
dump_frame( output, pointer );
pointer = get_stack_frame( pointer )->previous;
}
}
}
}
/**

8
src/memory/stack.h
View file

@ -41,19 +41,19 @@
*/
#define set_reg(frame,register,value)frame->arg[register]=value; inc_ref(value)
struct stack_frame * get_stack_frame(struct cons_pointer pointer);
struct stack_frame *get_stack_frame( struct cons_pointer pointer );
struct cons_pointer make_empty_frame( struct cons_pointer previous );
struct cons_pointer make_stack_frame( struct cons_pointer previous,
struct cons_pointer args,
struct cons_pointer env );
struct cons_pointer args,
struct cons_pointer env );
void free_stack_frame( struct stack_frame *frame );
void dump_frame( FILE * output, struct cons_pointer pointer );
void dump_stack_trace(FILE * output, struct cons_pointer frame_pointer);
void dump_stack_trace( FILE * output, struct cons_pointer frame_pointer );
struct cons_pointer fetch_arg( struct stack_frame *frame, unsigned int n );

26
src/memory/vectorspace.c
View file

@ -30,12 +30,19 @@
* NOTE that `tag` should be the vector-space tag of the particular type of
* vector-space object, NOT `VECTORPOINTTAG`.
*/
struct cons_pointer make_vec_pointer( char * tag, struct vector_space_object * address ) {
struct cons_pointer make_vec_pointer( char *tag,
struct vector_space_object *address ) {
fputws( L"Entered make_vec_pointer\n", stderr );
struct cons_pointer pointer = allocate_cell( VECTORPOINTTAG );
struct cons_space_object cell = pointer2cell( pointer );
fwprintf( stderr,
L"make_vec_pointer: allocated cell, about to write tag '%s'\n",
tag );
strncpy( &cell.payload.vectorp.tag.bytes[0], tag, 4 );
fputws( L"make_vec_pointer: tag written, about to set pointer address\n",
stderr );
cell.payload.vectorp.address = address;
fputws( L"make_vec_pointer: all good, returning\n", stderr );
return pointer;
}
@ -48,15 +55,18 @@ struct cons_pointer make_vec_pointer( char * tag, struct vector_space_object * a
* Returns NIL if the vector could not be allocated due to memory exhaustion.
*/
struct cons_pointer make_vso( char *tag, uint64_t payload_size ) {
fputws( L"Entered make_vso\n", stderr );
struct cons_pointer result = NIL;
int64_t total_size = sizeof( struct vector_space_header ) + payload_size;
/* Pad size to 64 bit words. This is intended to promote access efficiancy
* on 64 bit machines but may just be voodoo coding */
uint64_t padded = ceil((total_size * 8.0) / 8.0);
uint64_t padded = ceil( ( total_size * 8.0 ) / 8.0 );
fputws( L"make_vso: about to malloc\n", stderr );
struct vector_space_object *vso = malloc( padded );
if ( vso != NULL ) {
fwprintf( stderr, L"make_vso: about to write tag '%s'\n", tag );
strncpy( &vso->header.tag.bytes[0], tag, TAGLENGTH );
vso->header.vecp = make_vec_pointer( tag, vso );
vso->header.size = payload_size;
@ -65,13 +75,15 @@ struct cons_pointer make_vso( char *tag, uint64_t payload_size ) {
fwprintf( stderr,
L"Allocated vector-space object of type %4.4s, total size %ld, payload size %ld\n",
tag, total_size, payload_size );
if (padded != total_size){
fwprintf(stderr, L"\t\tPadded from %d to %d\n",
total_size, padded);
}
if ( padded != total_size ) {
fwprintf( stderr, L"\t\tPadded from %d to %d\n",
total_size, padded );
}
#endif
result = vso->header.vecp;
}
fputws( L"make_vso: all good, returning\n", stderr );
return result;
}

2
src/memory/vectorspace.h
View file

@ -61,7 +61,7 @@ struct vector_space_header {
};
struct vector_space_object {
struct vector_space_header header;
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