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

Major refactoring. Major problems!

Browse source 
On the right path but it doesn't work yet.
This commit is contained in:
Simon Brooke 2018-12-26 20:30:14 +00:00
parent ae8ba67ed7
commit 9937f344dc
20 changed files with 695 additions and 506 deletions
Download patch file Download diff file Expand all files Collapse all files

120
src/memory/consspaceobject.c
View file

@ -63,98 +63,6 @@ void dec_ref( struct cons_pointer pointer ) {
}
}
void dump_string_cell( FILE * output, wchar_t *prefix,
struct cons_pointer pointer ) {
struct cons_space_object cell = pointer2cell( pointer );
if ( cell.payload.string.character == 0 ) {
fwprintf( output,
L"\t\t%ls cell: termination; next at page %d offset %d, count %u\n",
prefix,
cell.payload.string.cdr.page, cell.payload.string.cdr.offset,
cell.count );
} else {
fwprintf( output,
L"\t\t%ls cell: character '%lc' (%d) next at page %d offset %d, count %u\n",
prefix,
( wint_t ) cell.payload.string.character,
cell.payload.string.character,
cell.payload.string.cdr.page,
cell.payload.string.cdr.offset, cell.count );
fwprintf( output, L"\t\t value: " );
print( output, pointer );
fwprintf( output, L"\n" );
}
}
/**
* dump the object at this cons_pointer to this output stream.
*/
void dump_object( FILE * output, struct cons_pointer pointer ) {
struct cons_space_object cell = pointer2cell( pointer );
fwprintf( output,
L"\t%c%c%c%c (%d) at page %d, offset %d count %u\n",
cell.tag.bytes[0],
cell.tag.bytes[1],
cell.tag.bytes[2],
cell.tag.bytes[3],
cell.tag.value, pointer.page, pointer.offset, cell.count );
switch ( cell.tag.value ) {
case CONSTV:
fwprintf( output,
L"\t\tCons cell: car at page %d offset %d, cdr at page %d offset %d, count %u\n",
cell.payload.cons.car.page,
cell.payload.cons.car.offset,
cell.payload.cons.cdr.page,
cell.payload.cons.cdr.offset, cell.count );
break;
case EXCEPTIONTV:
fwprintf( output, L"\t\tException cell: " );
print( output, cell.payload.exception.message );
fwprintf( output, L"\n" );
for ( struct stack_frame * frame = cell.payload.exception.frame;
frame != NULL; frame = frame->previous ) {
dump_frame( output, frame );
}
break;
case FREETV:
fwprintf( output, L"\t\tFree cell: next at page %d offset %d\n",
cell.payload.cons.cdr.page,
cell.payload.cons.cdr.offset );
break;
case INTEGERTV:
fwprintf( output,
L"\t\tInteger cell: value %ld, count %u\n",
cell.payload.integer.value, cell.count );
break;
case LAMBDATV:
fwprintf( output, L"\t\tLambda cell; args: " );
print( output, cell.payload.lambda.args );
fwprintf( output, L";\n\t\t\tbody: " );
print( output, cell.payload.lambda.body );
break;
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 );
break;
case READTV:
fwprintf( output, L"\t\tInput stream\n" );
case REALTV:
fwprintf( output, L"\t\tReal cell: value %Lf, count %u\n",
cell.payload.real.value, cell.count );
break;
case STRINGTV:
dump_string_cell( output, L"String", pointer );
break;
case SYMBOLTV:
dump_string_cell( output, L"Symbol", pointer );
break;
}
}
/**
* Construct a cons cell from this pair of pointers.
@ -178,20 +86,24 @@ struct cons_pointer make_cons( struct cons_pointer car,
/**
* Construct an exception cell.
* @param message should be a lisp string describing the problem, but actually any cons pointer will do;
* @param frame should be the frame in which the exception occurred.
* @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 stack_frame *frame ) {
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 );
cell->payload.exception.message = message;
cell->payload.exception.frame = frame;
inc_ref( message );
inc_ref( frame_pointer);
cell->payload.exception.message = message;
cell->payload.exception.frame = frame_pointer;
return pointer;
result = pointer;
return result;
}
@ -200,7 +112,8 @@ 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 stack_frame *,
struct cons_pointer, struct cons_pointer ) ) {
struct cons_pointer pointer = allocate_cell( FUNCTIONTAG );
struct cons_space_object *cell = &pointer2cell( pointer );
@ -298,7 +211,8 @@ 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 env ) ) {
( struct stack_frame * frame,
struct cons_pointer, struct cons_pointer env ) ) {
struct cons_pointer pointer = allocate_cell( SPECIALTAG );
struct cons_space_object *cell = &pointer2cell( pointer );

36
src/memory/consspaceobject.h
View file

@ -278,13 +278,14 @@ struct cons_pointer {
* here to avoid circularity. TODO: refactor.
*/
struct stack_frame {
struct stack_frame *previous; /* the previous frame */
struct cons_pointer previous; /* the previous frame */
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 */
int args;
};
/**
@ -311,7 +312,7 @@ struct cons_payload {
*/
struct exception_payload {
struct cons_pointer message;
struct stack_frame *frame;
struct cons_pointer frame;
};
/**
@ -326,6 +327,7 @@ struct exception_payload {
struct function_payload {
struct cons_pointer source;
struct cons_pointer ( *executable ) ( struct stack_frame *,
struct cons_pointer,
struct cons_pointer );
};
@ -379,13 +381,11 @@ struct real_payload {
* 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).
*
* NOTE that this means that special forms do not appear on the lisp stack,
* which may be confusing. TODO: think about this.
*/
struct special_payload {
struct cons_pointer source;
struct cons_pointer ( *executable ) ( struct stack_frame *,
struct cons_pointer,
struct cons_pointer );
};
@ -421,7 +421,8 @@ struct vectorp_payload {
* tag. */
uint32_t value; /* the tag considered as a number */
} tag;
uint64_t address; /* the address of the actual vector space
struct vector_space_object * address;
/* the address of the actual vector space
* object (TODO: will change when I actually
* implement vector space) */
};
@ -514,20 +515,11 @@ void inc_ref( struct cons_pointer pointer );
*/
void dec_ref( struct cons_pointer pointer );
/**
* dump the object at this cons_pointer to this output stream.
*/
void dump_object( FILE * output, struct cons_pointer pointer );
struct cons_pointer make_cons( struct cons_pointer car,
struct cons_pointer cdr );
/**
* Construct an exception cell.
* @param message should be a lisp string describing the problem, but actually any cons pointer will do;
* @param frame should be the frame in which the exception occurred.
*/
struct cons_pointer make_exception( struct cons_pointer message,
struct stack_frame *frame );
struct cons_pointer frame_pointer );
/**
* Construct a cell which points to an executable Lisp special form.
@ -535,6 +527,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 ) );
/**
@ -550,20 +543,13 @@ struct cons_pointer make_lambda( struct cons_pointer args,
struct cons_pointer make_nlambda( struct cons_pointer args,
struct cons_pointer body );
/**
* Construct a ratio frame from these two pointers, expected to be integers
* or (later) bignums, in the context of this stack_frame.
*/
struct cons_pointer make_ratio( struct stack_frame *frame,
struct cons_pointer dividend,
struct cons_pointer divisor );
/**
* 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 ) );
/**

120
src/memory/dump.c Normal file
View file

@ -0,0 +1,120 @@
/*
* dump.c
*
* Dump representations of both cons space and vector space objects.
*
*
* (c) 2018 Simon Brooke <simon@journeyman.cc>
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#include <stdint.h>
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
/*
* wide characters
*/
#include <wchar.h>
#include <wctype.h>
#include "conspage.h"
#include "consspaceobject.h"
#include "print.h"
#include "stack.h"
#include "vectorspace.h"
void dump_string_cell( FILE * output, wchar_t *prefix,
struct cons_pointer pointer ) {
struct cons_space_object cell = pointer2cell( pointer );
if ( cell.payload.string.character == 0 ) {
fwprintf( output,
L"\t\t%ls cell: termination; next at page %d offset %d, count %u\n",
prefix,
cell.payload.string.cdr.page, cell.payload.string.cdr.offset,
cell.count );
} else {
fwprintf( output,
L"\t\t%ls cell: character '%lc' (%d) next at page %d offset %d, count %u\n",
prefix,
( wint_t ) cell.payload.string.character,
cell.payload.string.character,
cell.payload.string.cdr.page,
cell.payload.string.cdr.offset, cell.count );
fwprintf( output, L"\t\t value: " );
print( output, pointer );
fwprintf( output, L"\n" );
}
}
/**
* dump the object at this cons_pointer to this output stream.
*/
void dump_object( FILE * output, struct cons_pointer pointer ) {
struct cons_space_object cell = pointer2cell( pointer );
fwprintf( output,
L"\t%c%c%c%c (%d) at page %d, offset %d count %u\n",
cell.tag.bytes[0],
cell.tag.bytes[1],
cell.tag.bytes[2],
cell.tag.bytes[3],
cell.tag.value, pointer.page, pointer.offset, cell.count );
switch ( cell.tag.value ) {
case CONSTV:
fwprintf( output,
L"\t\tCons cell: car at page %d offset %d, cdr at page %d offset %d, count %u\n",
cell.payload.cons.car.page,
cell.payload.cons.car.offset,
cell.payload.cons.cdr.page,
cell.payload.cons.cdr.offset, cell.count );
break;
case EXCEPTIONTV:
fwprintf( output, L"\t\tException cell: " );
dump_stack_trace( output, pointer);
break;
case FREETV:
fwprintf( output, L"\t\tFree cell: next at page %d offset %d\n",
cell.payload.cons.cdr.page,
cell.payload.cons.cdr.offset );
break;
case INTEGERTV:
fwprintf( output,
L"\t\tInteger cell: value %ld, count %u\n",
cell.payload.integer.value, cell.count );
break;
case LAMBDATV:
fwprintf( output, L"\t\tLambda cell; args: " );
print( output, cell.payload.lambda.args );
fwprintf( output, L";\n\t\t\tbody: " );
print( output, cell.payload.lambda.body );
break;
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 );
break;
case READTV:
fwprintf( output, L"\t\tInput stream\n" );
case REALTV:
fwprintf( output, L"\t\tReal cell: value %Lf, count %u\n",
cell.payload.real.value, cell.count );
break;
case STRINGTV:
dump_string_cell( output, L"String", pointer );
break;
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;
}
}

29
src/memory/dump.h Normal file
View file

@ -0,0 +1,29 @@
/**
* dump.h
*
* Dump representations of both cons space and vector space objects.
*
* (c) 2018 Simon Brooke <simon@journeyman.cc>
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#include <stdbool.h>
#include <stdint.h>
#include <stdio.h>
/*
* wide characters
*/
#include <wchar.h>
#include <wctype.h>
#ifndef __dump_h
#define __dump_h
/**
* dump the object at this cons_pointer to this output stream.
*/
void dump_object( FILE * output, struct cons_pointer pointer );
#endif

169
src/memory/stack.c
View file

@ -11,9 +11,6 @@
* with freelists to a more general 'equal sized object pages', so that
* allocating/freeing stack frames can be more efficient.
*
* Stack frames are not yet a first class object; they have no VECP pointer
* in cons space.
*
* (c) 2017 Simon Brooke <simon@journeyman.cc>
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
@ -25,87 +22,128 @@
#include "lispops.h"
#include "print.h"
#include "stack.h"
#include "vectorspace.h"
/**
* 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;
if (vectorpointp(pointer) && stackframep(vso))
{
result = (struct stack_frame *) &(vso->payload);
}
return result;
}
/**
* Make an empty stack frame, and return it.
* @param previous the current top-of-stack;
* @param env the environment in which evaluation happens.
* @return the new frame.
* @return the new frame, or NULL if memory is exhausted.
*/
struct stack_frame *make_empty_frame( struct stack_frame *previous,
struct cons_pointer env ) {
struct stack_frame *result = malloc( sizeof( struct stack_frame ) );
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
*/
result->previous = previous;
frame->previous = previous;
inc_ref(previous);
/*
* clearing the frame with memset would probably be slightly quicker, but
* this is clear.
*/
result->more = NIL;
result->function = NIL;
frame->more = NIL;
frame->function = NIL;
frame->args = 0;
for ( int i = 0; i < args_in_frame; i++ ) {
set_reg( result, i, NIL );
set_reg( frame, i, NIL );
}
}
return result;
}
/**
* Allocate a new stack frame with its previous pointer set to this value,
* its arguments set up from these args, evaluated in this env.
* @param previous the current top-of-stack;
* @args the arguments to load into this frame;
* @param env the environment in which evaluation happens.
* @return the new frame.
* @return the new frame, or an exception if one occurred while building it.
*/
struct stack_frame *make_stack_frame( struct stack_frame *previous,
struct cons_pointer args,
struct cons_pointer env,
struct cons_pointer *exception ) {
struct stack_frame *result = make_empty_frame( previous, env );
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 );
for ( int i = 0; i < args_in_frame && consp( args ); i++ ) {
/* iterate down the arg list filling in the arg slots in the
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 );
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 stack_frame *arg_frame = make_empty_frame( result, env );
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 );
struct cons_pointer val = lisp_eval( arg_frame, env );
struct cons_pointer val = lisp_eval( arg_frame, arg_frame_pointer, env );
if ( exceptionp( val ) ) {
exception = &val;
break;
result = val;
break;
} else {
set_reg( result, i, val );
set_reg( frame, frame->args, val );
}
free_stack_frame( arg_frame );
dec_ref(arg_frame_pointer);
args = cell.payload.cons.cdr;
}
}
if ( consp( args ) ) {
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( previous, args, env );
result->more = more;
struct cons_pointer more = eval_forms( get_stack_frame(previous), previous, args, env );
frame->more = more;
inc_ref( more );
}
}
dump_frame( stderr, result );
return result;
#ifdef DEBUG
dump_frame( stderr, result );
#endif
}
}
return result;
}
/**
@ -116,25 +154,39 @@ struct stack_frame *make_stack_frame( struct stack_frame *previous,
* @param env the execution environment;
* @return a new special frame.
*/
struct stack_frame *make_special_frame( struct stack_frame *previous,
struct cons_pointer make_special_frame( struct cons_pointer previous,
struct cons_pointer args,
struct cons_pointer env ) {
struct stack_frame *result = make_empty_frame( previous, env );
struct cons_pointer result = make_empty_frame( previous );
for ( int i = 0; i < args_in_frame && !nilp( args ); i++ ) {
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 && !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 );
set_reg( result, i, cell.payload.cons.car );
set_reg( frame, frame->args, cell.payload.cons.car );
args = cell.payload.cons.cdr;
}
if ( consp( args ) ) {
result->more = args;
if (!exceptionp(result)) {
if ( consp( args ) ) {
frame->more = args;
inc_ref( args );
}
#ifdef DEBUG
dump_frame( stderr, result );
#endif
}
}
return result;
}
@ -160,26 +212,41 @@ void free_stack_frame( struct stack_frame *frame ) {
/**
* Dump a stackframe to this stream for debugging
* @param output the stream
* @param frame the frame
* @param frame_pointer the pointer to the frame
*/
void dump_frame( FILE * output, struct stack_frame *frame ) {
fputws( L"Dumping stack frame\n", output );
for ( int arg = 0; arg < args_in_frame; arg++ ) {
struct cons_space_object cell = pointer2cell( frame->arg[arg] );
void dump_frame( FILE * output, struct cons_pointer frame_pointer ) {
struct stack_frame *frame = get_stack_frame(frame_pointer);
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 );
if (frame != NULL) {
for ( int arg = 0; arg < frame->args; arg++ ) {
struct cons_space_object cell = pointer2cell( frame->arg[arg] );
print( output, frame->arg[arg] );
fputws( L"\n", output );
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 );
}
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;
}
}
}
/**
* Fetch a pointer to the value of the local variable at this index.

48
src/memory/stack.h
View file

@ -24,46 +24,40 @@
#ifndef __stack_h
#define __stack_h
/**
* macros for the tag of a stack frame.
*/
#define STACKFRAMETAG "STAK"
#define STACKFRAMETV 1262572627
/**
* is this vector-space object a stack frame?
*/
#define stackframep(vso)(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)
struct stack_frame * get_stack_frame(struct cons_pointer pointer);
/**
* Make an empty stack frame, and return it.
* @param previous the current top-of-stack;
* @param env the environment in which evaluation happens.
* @return the new frame.
*/
struct stack_frame *make_empty_frame( struct stack_frame *previous,
struct cons_pointer env );
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 stack_frame *make_stack_frame( struct stack_frame *previous,
struct cons_pointer args,
struct cons_pointer env,
struct cons_pointer *exception );
void free_stack_frame( struct stack_frame *frame );
/**
* Dump a stackframe to this stream for debugging
* @param output the stream
* @param frame the frame
*/
void dump_frame( FILE * output, struct stack_frame *frame );
void dump_frame( FILE * output, struct cons_pointer pointer );
void dump_stack_trace(FILE * output, struct cons_pointer frame_pointer);
struct cons_pointer fetch_arg( struct stack_frame *frame, unsigned int n );
/**
* A 'special' frame is exactly like a normal stack frame except that the
* arguments are unevaluated.
* @param previous the previous stack frame;
* @param args a list of the arguments to be stored in this stack frame;
* @param env the execution environment;
* @return a new special frame.
*/
struct stack_frame *make_special_frame( struct stack_frame *previous,
struct cons_pointer make_special_frame( struct cons_pointer previous,
struct cons_pointer args,
struct cons_pointer env );

26
src/memory/vectorspace.c
View file

@ -8,6 +8,7 @@
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#include <math.h>
#include <stdint.h>
#include <stdlib.h>
#include <string.h>
@ -29,7 +30,7 @@
* 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, uint64_t address ) {
struct cons_pointer make_vec_pointer( char * tag, struct vector_space_object * address ) {
struct cons_pointer pointer = allocate_cell( VECTORPOINTTAG );
struct cons_space_object cell = pointer2cell( pointer );
@ -44,26 +45,33 @@ struct cons_pointer make_vec_pointer( char *tag, uint64_t address ) {
* 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.
*/
struct cons_pointer make_vso( char *tag, int64_t payload_size ) {
struct cons_pointer make_vso( char *tag, uint64_t payload_size ) {
struct cons_pointer result = NIL;
int64_t total_size = sizeof( struct vector_space_header ) + payload_size;
struct vector_space_header *vso = malloc( total_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);
struct vector_space_object *vso = malloc( padded );
if ( vso != NULL ) {
strncpy( &vso->tag.bytes[0], tag, TAGLENGTH );
vso->vecp = make_vec_pointer( tag, ( uint64_t ) vso );
vso->size = payload_size;
strncpy( &vso->header.tag.bytes[0], tag, TAGLENGTH );
vso->header.vecp = make_vec_pointer( tag, vso );
vso->header.size = payload_size;
#ifdef DEBUG
fwprintf( stderr,
L"Allocated vector-space object of type %s, total size %ld, payload size %ld\n",
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);
}
#endif
result = vso->vecp;
result = vso->header.vecp;
}
return result;
}

16
src/memory/vectorspace.h
View file

@ -34,20 +34,16 @@
#define NAMESPACETAG "NMSP"
#define NAMESPACETV 0
/*
* a stack frame.
*/
#define STACKFRAMETAG "STAK"
#define STACKFRAMETV
/*
* a vector of cons pointers.
*/
#define VECTORTAG "VECT"
#define VECTORTV 0
#define pointer_to_vso(pointer)(vectorpointp(pointer)? pointer2cell(pointer).payload.vectorp.address : 0)
#define pointer_to_vso(pointer)((vectorpointp(pointer)? pointer2cell(pointer).payload.vectorp.address : NULL))
#define vso_get_vecp(vso)((vso->header.vecp))
struct cons_pointer make_vso( char *tag, int64_t payload_size );
struct cons_pointer make_vso( char *tag, uint64_t payload_size );
struct vector_space_header {
union {
@ -62,8 +58,10 @@ struct vector_space_header {
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 */
char mark; /* mark bit for marking/sweeping the
* heap (not in this version) */
};
struct vector_space_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