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

Compare commits

base: simon:develop
Branches Tags
simon:master
simon:develop
simon:feature/all-integers-are-bignums
..
compare: simon:master
Branches Tags
simon:develop
simon:master
simon:feature/all-integers-are-bignums

No commits in common. "develop" and "master" have entirely different histories.
develop ... master

11 changed files with 223 additions and 260 deletions
Show stats Expand all files Collapse all files

11
src/arith/integer.c
View file

@ -100,12 +100,13 @@ __int128_t cell_value( struct cons_pointer c, char op, bool is_first_cell ) {
__int128_t int128_to_integer( __int128_t val,
struct cons_pointer less_significant,
struct cons_pointer new ) {
struct cons_pointer cursor = NIL;
__int128_t carry = 0;
if ( MAX_INTEGER >= val ) {
carry = 0;
} else {
carry = val >> INTEGER_BIT_SHIFT;
carry = val >> 60;
debug_printf( DEBUG_ARITH,
L"int128_to_integer: 64 bit overflow; setting carry to %ld\n",
( int64_t ) carry );
@ -135,7 +136,7 @@ struct cons_pointer make_integer_128( __int128_t val,
less_significant =
make_integer( ( long int ) val & MAX_INTEGER,
less_significant );
val = val >> INTEGER_BIT_SHIFT;
val = val >> 60;
}
} while ( nilp( result ) );
@ -289,7 +290,7 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
/* if xj exceeds one digit, break it into the digit dj and
* the carry */
carry = xj >> INTEGER_BIT_SHIFT;
carry = xj >> 60;
struct cons_pointer dj = make_integer( xj & MAX_INTEGER, NIL );
/* destructively modify ri by appending dj */
@ -319,7 +320,7 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
}
/**
* don't use; private to integer_to_string, and somewhat dodgy.
* don't use; private to integer_to_string, and somewaht dodgy.
*/
struct cons_pointer integer_to_string_add_digit( int digit, int digits,
struct cons_pointer tail ) {
@ -360,7 +361,7 @@ struct cons_pointer integer_to_string( struct cons_pointer int_pointer,
while ( accumulator > 0 || !nilp( next ) ) {
if ( accumulator < MAX_INTEGER && !nilp( next ) ) {
accumulator +=
( pointer2cell( next ).payload.integer.value << INTEGER_BIT_SHIFT );
( pointer2cell( next ).payload.integer.value << 60 );
next = pointer2cell( next ).payload.integer.more;
}
int offset = ( int ) ( accumulator % base );

10
src/arith/peano.h
View file

@ -13,18 +13,10 @@
#define PEANO_H
/**
* The maximum value we will allow in an integer cell: one less than 2^60:
* (let ((s (make-string-output-stream)))
* (format s "0x0~XL" (- (expt 2 60) 1))
* (string-downcase (get-output-stream-string s)))
* "0x0fffffffffffffffl"
*
* So left shifting and right shifting by 60 bits is correct.
* The maximum value we will allow in an integer cell.
*/
#define MAX_INTEGER ((__int128_t)0x0fffffffffffffffL)
#define INTEGER_BIT_SHIFT (60)
bool zerop( struct cons_pointer arg );
struct cons_pointer negative( struct cons_pointer arg );

1
src/init.c
View file

@ -9,7 +9,6 @@
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#include <getopt.h>
#include <locale.h>
#include <stdbool.h>
#include <stdio.h>

2
src/io/print.h
View file

@ -11,8 +11,6 @@
#include <ctype.h>
#include <stdio.h>
#include "io/fopen.h"
#ifndef __print_h
#define __print_h

6
src/memory/conspage.c
View file

@ -238,7 +238,7 @@ struct cons_pointer allocate_cell( uint32_t tag ) {
total_cells_allocated++;
debug_printf( DEBUG_ALLOC,
L"Allocated cell of type '%4.4s' at %d, %d \n", cell->tag.bytes,
L"Allocated cell of type '%4.4s' at %d, %d \n", tag,
result.page, result.offset );
} else {
debug_printf( DEBUG_ALLOC, L"WARNING: Allocating non-free cell!" );
@ -267,6 +267,6 @@ void initialise_cons_pages( ) {
void summarise_allocation( ) {
fwprintf( stderr,
L"Allocation summary: allocated %lld; deallocated %lld; not deallocated %lld.\n",
total_cells_allocated, total_cells_freed, total_cells_allocated - total_cells_freed );
L"Allocation summary: allocated %lld; deallocated %lld.\n",
total_cells_allocated, total_cells_freed );
}

425
src/memory/consspaceobject.c
View file

@ -9,9 +9,9 @@
*/
#include <stdint.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <stdio.h>
/*
* wide characters
*/
@ -19,13 +19,13 @@
#include <wctype.h>
#include "authorise.h"
#include "debug.h"
#include "io/print.h"
#include "memory/conspage.h"
#include "memory/consspaceobject.h"
#include "debug.h"
#include "ops/intern.h"
#include "io/print.h"
#include "memory/stack.h"
#include "memory/vectorspace.h"
#include "ops/intern.h"
/**
* True if the value of the tag on the cell at this `pointer` is this `value`,
@ -33,22 +33,22 @@
* vectorspace object indicated by the cell is this `value`, else false.
*/
bool check_tag( struct cons_pointer pointer, uint32_t value ) {
bool result = false;
bool result = false;
struct cons_space_object cell = pointer2cell( pointer );
result = cell.tag.value == value;
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 ( result == false ) {
if ( cell.tag.value == VECTORPOINTTV ) {
struct vector_space_object *vec = pointer_to_vso( pointer );
if ( vec != NULL ) {
result = vec->header.tag.value == value;
}
if ( vec != NULL ) {
result = vec->header.tag.value == value;
}
}
}
}
return result;
return result;
}
/**
@ -56,17 +56,17 @@ bool check_tag( struct cons_pointer pointer, uint32_t value ) {
*
* You can't roll over the reference count. Once it hits the maximum
* value you cannot increment further.
*
*
* Returns the `pointer`.
*/
struct cons_pointer inc_ref( struct cons_pointer pointer ) {
struct cons_space_object *cell = &pointer2cell( pointer );
struct cons_space_object *cell = &pointer2cell( pointer );
if ( cell->count < MAXREFERENCE ) {
cell->count++;
}
if ( cell->count < MAXREFERENCE ) {
cell->count++;
}
return pointer;
return pointer;
}
/**
@ -74,46 +74,49 @@ struct cons_pointer inc_ref( struct cons_pointer pointer ) {
*
* If a count has reached MAXREFERENCE it cannot be decremented.
* If a count is decremented to zero the cell should be freed.
*
*
* Returns the `pointer`, or, if the cell has been freed, NIL.
*/
struct cons_pointer dec_ref( struct cons_pointer pointer ) {
struct cons_space_object *cell = &pointer2cell( pointer );
struct cons_space_object *cell = &pointer2cell( pointer );
if ( cell->count > 0 ) {
cell->count--;
if ( cell->count > 0 ) {
cell->count--;
if ( cell->count == 0 ) {
free_cell( pointer );
pointer = NIL;
if ( cell->count == 0 ) {
free_cell( pointer );
pointer = NIL;
}
}
}
return pointer;
return pointer;
}
/**
* Get the Lisp type of the single argument.
* @param pointer a pointer to the object whose type is requested.
* @return As a Lisp string, the tag of the object which is at that pointer.
*/
struct cons_pointer c_type( struct cons_pointer pointer ) {
struct cons_pointer result = NIL;
struct cons_space_object cell = pointer2cell( pointer );
struct cons_pointer result = NIL;
struct cons_space_object cell = pointer2cell( pointer );
if ( strncmp( (char *)&cell.tag.bytes, VECTORPOINTTAG, TAGLENGTH ) == 0 ) {
struct vector_space_object *vec = pointer_to_vso( pointer );
if ( strncmp( ( char * ) &cell.tag.bytes, VECTORPOINTTAG, TAGLENGTH ) ==
0 ) {
struct vector_space_object *vec = pointer_to_vso( pointer );
for ( int i = TAGLENGTH - 1; i >= 0; i-- ) {
result = make_string( (wchar_t)vec->header.tag.bytes[i], result );
for ( int i = TAGLENGTH - 1; i >= 0; i-- ) {
result =
make_string( ( wchar_t ) vec->header.tag.bytes[i], result );
}
} else {
for ( int i = TAGLENGTH - 1; i >= 0; i-- ) {
result = make_string( ( wchar_t ) cell.tag.bytes[i], result );
}
}
} else {
for ( int i = TAGLENGTH - 1; i >= 0; i-- ) {
result = make_string( (wchar_t)cell.tag.bytes[i], result );
}
}
return result;
return result;
}
/**
@ -121,13 +124,13 @@ struct cons_pointer c_type( struct cons_pointer pointer ) {
* authorised to read it, does not error but returns nil.
*/
struct cons_pointer c_car( struct cons_pointer arg ) {
struct cons_pointer result = NIL;
struct cons_pointer result = NIL;
if ( truep( authorised( arg, NIL ) ) && consp( arg ) ) {
result = pointer2cell( arg ).payload.cons.car;
}
if ( truep( authorised( arg, NIL ) ) && consp( arg ) ) {
result = pointer2cell( arg ).payload.cons.car;
}
return result;
return result;
}
/**
@ -135,98 +138,96 @@ struct cons_pointer c_car( struct cons_pointer arg ) {
* not authorised to read it,does not error but returns nil.
*/
struct cons_pointer c_cdr( struct cons_pointer arg ) {
struct cons_pointer result = NIL;
struct cons_pointer result = NIL;
if ( truep( authorised( arg, NIL ) ) ) {
struct cons_space_object *cell = &pointer2cell( arg );
if ( truep( authorised( arg, NIL ) ) ) {
struct cons_space_object *cell = &pointer2cell( arg );
switch ( cell->tag.value ) {
case CONSTV:
result = cell->payload.cons.cdr;
break;
case KEYTV:
case STRINGTV:
case SYMBOLTV:
result = cell->payload.string.cdr;
break;
switch ( cell->tag.value ) {
case CONSTV:
result = cell->payload.cons.cdr;
break;
case KEYTV:
case STRINGTV:
case SYMBOLTV:
result = cell->payload.string.cdr;
break;
}
}
}
return result;
return result;
}
/**
* Implementation of `length` in C. If arg is not a cons, does not error but
* returns 0.
* Implementation of `length` in C. If arg is not a cons, does not error but returns 0.
*/
int c_length( struct cons_pointer arg ) {
int result = 0;
int result = 0;
for ( struct cons_pointer c = arg; !nilp( c ); c = c_cdr( c ) ) {
result++;
}
for ( struct cons_pointer c = arg; !nilp( c ); c = c_cdr( c ) ) {
result++;
}
return result;
return result;
}
/**
* Construct a cons cell from this pair of pointers.
*/
struct cons_pointer make_cons( struct cons_pointer car,
struct cons_pointer cdr ) {
struct cons_pointer pointer = NIL;
struct cons_pointer pointer = NIL;
pointer = allocate_cell( CONSTV );
pointer = allocate_cell( CONSTV );
struct cons_space_object *cell = &pointer2cell( pointer );
struct cons_space_object *cell = &pointer2cell( pointer );
inc_ref( car );
inc_ref( cdr );
cell->payload.cons.car = car;
cell->payload.cons.cdr = cdr;
inc_ref( car );
inc_ref( cdr );
cell->payload.cons.car = car;
cell->payload.cons.cdr = cdr;
return pointer;
return pointer;
}
/**
* Construct an exception cell.
* @param message should be a lisp string describing the problem, but actually
* any cons pointer will do;
* @param frame_pointer should be the pointer to the frame in which the
* exception occurred.
* @param message should be a lisp string describing the problem, but actually any cons pointer will do;
* @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( EXCEPTIONTV );
struct cons_space_object *cell = &pointer2cell( pointer );
struct cons_pointer result = NIL;
struct cons_pointer pointer = allocate_cell( EXCEPTIONTV );
struct cons_space_object *cell = &pointer2cell( pointer );
inc_ref( message );
inc_ref( frame_pointer );
cell->payload.exception.payload = message;
cell->payload.exception.frame = frame_pointer;
inc_ref( message );
inc_ref( frame_pointer );
cell->payload.exception.payload = message;
cell->payload.exception.frame = frame_pointer;
result = pointer;
result = pointer;
return result;
return result;
}
/**
* Construct a cell which points to an executable Lisp function.
*/
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( FUNCTIONTV );
struct cons_space_object *cell = &pointer2cell( pointer );
inc_ref( meta );
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( FUNCTIONTV );
struct cons_space_object *cell = &pointer2cell( pointer );
inc_ref( meta );
cell->payload.function.meta = meta;
cell->payload.function.executable = executable;
cell->payload.function.meta = meta;
cell->payload.function.executable = executable;
return pointer;
return pointer;
}
/**
@ -234,18 +235,17 @@ struct cons_pointer make_function(
*/
struct cons_pointer make_lambda( struct cons_pointer args,
struct cons_pointer body ) {
struct cons_pointer pointer = allocate_cell( LAMBDATV );
struct cons_space_object *cell = &pointer2cell( pointer );
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 */
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( args );
inc_ref( body );
cell->payload.lambda.args = args;
cell->payload.lambda.body = body;
inc_ref( args );
inc_ref( body );
cell->payload.lambda.args = args;
cell->payload.lambda.body = body;
return pointer;
return pointer;
}
/**
@ -254,48 +254,48 @@ 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( NLAMBDATV );
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 */
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 */
struct cons_space_object *cell = &pointer2cell( pointer );
inc_ref( args );
inc_ref( body );
cell->payload.lambda.args = args;
cell->payload.lambda.body = body;
struct cons_space_object *cell = &pointer2cell( pointer );
inc_ref( args );
inc_ref( body );
cell->payload.lambda.args = args;
cell->payload.lambda.body = body;
return pointer;
return pointer;
}
/**
* Return a hash value for this string like thing.
*
*
* What's important here is that two strings with the same characters in the
* same order should have the same hash value, even if one was created using
* `"foobar"` and the other by `(append "foo" "bar")`. I *think* this function
* has that property. I doubt that it's the most efficient hash function to
* `"foobar"` and the other by `(append "foo" "bar")`. I *think* this function
* has that property. I doubt that it's the most efficient hash function to
* have that property.
*
*
* returns 0 for things which are not string like.
*/
uint32_t calculate_hash( wint_t c, struct cons_pointer ptr ) {
struct cons_space_object *cell = &pointer2cell( ptr );
uint32_t result = 0;
struct cons_space_object *cell = &pointer2cell( ptr );
uint32_t result = 0;
switch ( cell->tag.value ) {
case KEYTV:
case STRINGTV:
case SYMBOLTV:
if ( nilp( cell->payload.string.cdr ) ) {
result = (uint32_t)c;
} else {
result = ( (uint32_t)c * cell->payload.string.hash ) & 0xffffffff;
}
break;
}
switch ( cell->tag.value ) {
case KEYTV:
case STRINGTV:
case SYMBOLTV:
if ( nilp( cell->payload.string.cdr ) ) {
result = ( uint32_t ) c;
} else {
result = ( ( uint32_t ) c *
cell->payload.string.hash ) & 0xffffffff;
}
break;
}
return result;
return result;
}
/**
@ -304,31 +304,31 @@ uint32_t calculate_hash( wint_t c, struct cons_pointer ptr ) {
* has one character and a pointer to the next; in the last cell the
* pointer to next is NIL.
*/
struct cons_pointer make_string_like_thing( wint_t c, struct cons_pointer tail,
uint32_t tag ) {
struct cons_pointer pointer = NIL;
struct cons_pointer
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, NILTV ) ) {
pointer = allocate_cell( tag );
struct cons_space_object *cell = &pointer2cell( pointer );
if ( check_tag( tail, tag ) || check_tag( tail, NILTV ) ) {
pointer = allocate_cell( tag );
struct cons_space_object *cell = &pointer2cell( pointer );
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
* strings are quite massively off. Fix is probably
* cell->payload.string.cdr = tail */
cell->payload.string.cdr.offset = tail.offset;
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
* strings are quite massively off. Fix is probably
* cell->payload.string.cdr = tail */
cell->payload.string.cdr.offset = tail.offset;
cell->payload.string.hash = calculate_hash( c, tail );
} else {
// \todo should throw an exception!
debug_printf( DEBUG_ALLOC,
L"Warning: only NIL and %4.4s can be prepended to %4.4s\n",
tag, tag );
}
cell->payload.string.hash = calculate_hash( c, tail );
} else {
// \todo should throw an exception!
debug_printf( DEBUG_ALLOC,
L"Warning: only NIL and %4.4s can be prepended to %4.4s\n",
tag, tag );
}
return pointer;
return pointer;
}
/**
@ -340,7 +340,7 @@ struct cons_pointer make_string_like_thing( wint_t c, struct cons_pointer tail,
* @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, STRINGTV );
return make_string_like_thing( c, tail, STRINGTV );
}
/**
@ -353,45 +353,36 @@ 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,
uint32_t tag ) {
struct cons_pointer result;
if ( tag == SYMBOLTV || tag == KEYTV ) {
result = make_string_like_thing( c, tail, tag );
struct cons_pointer result = make_string_like_thing( c, tail, tag );
if ( tag == KEYTV ) {
struct cons_pointer r = internedp( result, oblist );
struct cons_pointer r = internedp( result, oblist );
if ( nilp( r ) ) {
intern( result, oblist );
} else {
result = r;
}
if ( nilp( r ) ) {
intern( result, oblist );
} else {
result = r;
}
}
} else {
result = make_exception(
c_string_to_lisp_string( L"Unexpected tag when making symbol or key." ),
NIL);
}
return result;
return result;
}
/**
* Construct a cell which points to an executable Lisp special form.
*/
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( SPECIALTV );
struct cons_space_object *cell = &pointer2cell( pointer );
inc_ref( meta );
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( SPECIALTV );
struct cons_space_object *cell = &pointer2cell( pointer );
inc_ref( meta );
cell->payload.special.meta = meta;
cell->payload.special.executable = executable;
cell->payload.special.meta = meta;
cell->payload.special.executable = executable;
return pointer;
return pointer;
}
/**
@ -400,15 +391,15 @@ struct cons_pointer make_special(
* @param metadata a pointer to an associaton containing metadata on the stream.
* @return a pointer to the new read stream.
*/
struct cons_pointer make_read_stream( URL_FILE *input,
struct cons_pointer make_read_stream( URL_FILE * input,
struct cons_pointer metadata ) {
struct cons_pointer pointer = allocate_cell( READTV );
struct cons_space_object *cell = &pointer2cell( pointer );
struct cons_pointer pointer = allocate_cell( READTV );
struct cons_space_object *cell = &pointer2cell( pointer );
cell->payload.stream.stream = input;
cell->payload.stream.meta = metadata;
cell->payload.stream.stream = input;
cell->payload.stream.meta = metadata;
return pointer;
return pointer;
}
/**
@ -417,59 +408,59 @@ struct cons_pointer make_read_stream( URL_FILE *input,
* @param metadata a pointer to an associaton containing metadata on the stream.
* @return a pointer to the new read stream.
*/
struct cons_pointer make_write_stream( URL_FILE *output,
struct cons_pointer make_write_stream( URL_FILE * output,
struct cons_pointer metadata ) {
struct cons_pointer pointer = allocate_cell( WRITETV );
struct cons_space_object *cell = &pointer2cell( pointer );
struct cons_pointer pointer = allocate_cell( WRITETV );
struct cons_space_object *cell = &pointer2cell( pointer );
cell->payload.stream.stream = output;
cell->payload.stream.meta = metadata;
cell->payload.stream.stream = output;
cell->payload.stream.meta = metadata;
return pointer;
return pointer;
}
/**
* Return a lisp keyword representation of this wide character string. In
* keywords, I am accepting only lower case characters and numbers.
* Return a lisp keyword representation of this wide character string. In keywords,
* I am accepting only lower case characters and numbers.
*/
struct cons_pointer c_string_to_lisp_keyword( wchar_t *symbol ) {
struct cons_pointer result = NIL;
struct cons_pointer result = NIL;
for ( int i = wcslen( symbol ) - 1; i >= 0; i-- ) {
wchar_t c = towlower( symbol[i] );
for ( int i = wcslen( symbol ) - 1; i >= 0; i-- ) {
wchar_t c = towlower( symbol[i] );
if ( iswalnum( c ) || c == L'-' ) {
result = make_keyword( c, result );
if ( iswalnum( c ) || c == L'-' ) {
result = make_keyword( c, result );
}
}
}
return result;
return result;
}
/**
* Return a lisp string representation of this wide character string.
*/
struct cons_pointer c_string_to_lisp_string( wchar_t *string ) {
struct cons_pointer result = NIL;
struct cons_pointer result = NIL;
for ( int i = wcslen( string ) - 1; i >= 0; i-- ) {
if ( iswprint( string[i] ) && string[i] != '"' ) {
result = make_string( string[i], result );
for ( int i = wcslen( string ) - 1; i >= 0; i-- ) {
if ( iswprint( string[i] ) && string[i] != '"' ) {
result = make_string( string[i], result );
}
}
}
return result;
return result;
}
/**
* Return a lisp symbol representation of this wide character string.
*/
struct cons_pointer c_string_to_lisp_symbol( wchar_t *symbol ) {
struct cons_pointer result = NIL;
struct cons_pointer result = NIL;
for ( int i = wcslen( symbol ); i > 0; i-- ) {
result = make_symbol( symbol[i - 1], result );
}
for ( int i = wcslen( symbol ); i > 0; i-- ) {
result = make_symbol( symbol[i - 1], result );
}
return result;
return result;
}

2
src/memory/consspaceobject.h
View file

@ -478,8 +478,6 @@ struct free_payload {
* 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.
*
* \todo Why is this 60, and not 64 bits?
*/
struct integer_payload {
/** the value of the payload (i.e. 60 bits) of this cell. */

7
src/memory/vectorspace.c
View file

@ -84,11 +84,10 @@ struct cons_pointer make_vso( uint32_t tag, uint64_t payload_size ) {
if ( vso != NULL ) {
memset( vso, 0, padded );
vso->header.tag.value = tag;
debug_printf( DEBUG_ALLOC,
L"make_vso: written tag '%4.4s' into vso at %p\n",
vso->header.tag.bytes, vso );
L"make_vso: about to write tag '%4.4s' into vso at %p\n",
tag, vso );
vso->header.tag.value = tag;
result = make_vec_pointer( vso, tag );
debug_dump_object( result, DEBUG_ALLOC );
vso->header.vecp = result;

3
src/ops/lispops.c
View file

@ -681,8 +681,6 @@ bool end_of_stringp( struct cons_pointer arg ) {
* returns a cell constructed from a and b. If a is of type string but its
* cdr is nill, and b is of type string, then returns a new string cell;
* otherwise returns a new cons cell.
*
* Thus: `(cons "a" "bcd") -> "abcd"`, but `(cons "ab" "cd") -> ("ab" . "cd")`
*
* * (cons a b)
*
@ -702,6 +700,7 @@ lisp_cons( struct stack_frame *frame, struct cons_pointer frame_pointer,
return NIL;
} else if ( stringp( car ) && stringp( cdr ) &&
end_of_stringp( c_cdr( car ) ) ) {
// \todo check that car is of length 1
result =
make_string( pointer2cell( car ).payload.string.character, cdr );
} else {

2
src/version.h
View file

@ -8,4 +8,4 @@
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#define VERSION "0.0.6-SNAPSHOT"
#define VERSION "0.0.5"

14
unit-tests/memory.sh
View file

@ -1,14 +0,0 @@
#!/bin/bash
actual=`echo "" | target/psse 2>&1 | tail -2`
alloc=`echo $actual | sed 's/[[:punct:]]/ /g' | awk '{print $4}'`
dealloc=`echo $actual | sed 's/[[:punct:]]/ /g' | awk '{print $6}'`
if [ "${alloc}" = "${dealloc}" ]
then
echo "OK"
else
echo "Fail: expected '${alloc}', got '${dealloc}'"
exit 1
fi