Setting up medatata works...
And the `inspect` function correctly shows it. However, the `metadata` function segfaults.
This commit is contained in:
parent
10098a83bf
commit
eb394d153f
16 changed files with 866 additions and 580 deletions
|
|
@ -152,7 +152,7 @@ void free_cell( struct cons_pointer pointer ) {
|
|||
dec_ref( cell->payload.exception.frame );
|
||||
break;
|
||||
case FUNCTIONTV:
|
||||
dec_ref( cell->payload.function.source );
|
||||
dec_ref( cell->payload.function.meta );
|
||||
break;
|
||||
case INTEGERTV:
|
||||
dec_ref( cell->payload.integer.more );
|
||||
|
|
@ -168,10 +168,11 @@ void free_cell( struct cons_pointer pointer ) {
|
|||
break;
|
||||
case READTV:
|
||||
case WRITETV:
|
||||
url_fclose( cell->payload.stream.stream);
|
||||
dec_ref(cell->payload.stream.meta);
|
||||
url_fclose( cell->payload.stream.stream );
|
||||
break;
|
||||
case SPECIALTV:
|
||||
dec_ref( cell->payload.special.source );
|
||||
dec_ref( cell->payload.special.meta );
|
||||
break;
|
||||
case STRINGTV:
|
||||
case SYMBOLTV:
|
||||
|
|
|
|||
|
|
@ -1,7 +1,19 @@
|
|||
#include "consspaceobject.h"
|
||||
/*
|
||||
* conspage.h
|
||||
*
|
||||
* Setup and tear down cons pages, and (FOR NOW) do primitive
|
||||
* allocation/deallocation of cells.
|
||||
* NOTE THAT before we go multi-threaded, these functions must be
|
||||
* aggressively
|
||||
* thread safe.
|
||||
*
|
||||
* (c) 2017 Simon Brooke <simon@journeyman.cc>
|
||||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
#ifndef __psse_conspage_h
|
||||
#define __psse_conspage_h
|
||||
|
||||
#ifndef __conspage_h
|
||||
#define __conspage_h
|
||||
#include "consspaceobject.h"
|
||||
|
||||
/**
|
||||
* the number of cons cells on a cons page. The maximum value this can
|
||||
|
|
|
|||
|
|
@ -21,6 +21,7 @@
|
|||
#include "conspage.h"
|
||||
#include "consspaceobject.h"
|
||||
#include "debug.h"
|
||||
#include "intern.h"
|
||||
#include "print.h"
|
||||
#include "stack.h"
|
||||
|
||||
|
|
@ -65,6 +66,48 @@ void dec_ref( struct cons_pointer 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 );
|
||||
|
||||
for ( int i = TAGLENGTH - 1; i >= 0; i-- ) {
|
||||
result = make_string( ( wchar_t ) cell.tag.bytes[i], result );
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
/**
|
||||
* Implementation of car in C. If arg is not a cons, does not error but returns nil.
|
||||
*/
|
||||
struct cons_pointer c_car( struct cons_pointer arg ) {
|
||||
struct cons_pointer result = NIL;
|
||||
|
||||
if ( consp( arg ) ) {
|
||||
result = pointer2cell( arg ).payload.cons.car;
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
/**
|
||||
* Implementation of cdr in C. If arg is not a cons, does not error but returns nil.
|
||||
*/
|
||||
struct cons_pointer c_cdr( struct cons_pointer arg ) {
|
||||
struct cons_pointer result = NIL;
|
||||
|
||||
if ( consp( arg ) || stringp( arg ) || symbolp( arg ) ) {
|
||||
result = pointer2cell( arg ).payload.cons.cdr;
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
/**
|
||||
* Construct a cons cell from this pair of pointers.
|
||||
*/
|
||||
|
|
@ -107,16 +150,17 @@ struct cons_pointer make_exception( struct cons_pointer message,
|
|||
|
||||
|
||||
/**
|
||||
* Construct a cell which points to an executable Lisp special form.
|
||||
* Construct a cell which points to an executable Lisp function.
|
||||
*/
|
||||
struct cons_pointer
|
||||
make_function( struct cons_pointer src, struct cons_pointer ( *executable )
|
||||
make_function( struct cons_pointer meta, struct cons_pointer ( *executable )
|
||||
( struct stack_frame *,
|
||||
struct cons_pointer, struct cons_pointer ) ) {
|
||||
struct cons_pointer pointer = allocate_cell( FUNCTIONTAG );
|
||||
struct cons_space_object *cell = &pointer2cell( pointer );
|
||||
inc_ref( meta);
|
||||
|
||||
cell->payload.function.source = src;
|
||||
cell->payload.function.meta = meta;
|
||||
cell->payload.function.executable = executable;
|
||||
|
||||
return pointer;
|
||||
|
|
@ -203,27 +247,42 @@ struct cons_pointer make_string( wint_t c, struct cons_pointer 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.
|
||||
* Construct a symbol or keyword from the character `c` and this `tail`.
|
||||
* Each 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.
|
||||
* @param tag the tag to use: expected to be "SYMB" or "KEYW"
|
||||
*/
|
||||
struct cons_pointer make_symbol( wint_t c, struct cons_pointer tail ) {
|
||||
return make_string_like_thing( c, tail, SYMBOLTAG );
|
||||
struct cons_pointer make_symbol_or_key( wint_t c, struct cons_pointer tail,
|
||||
char *tag ) {
|
||||
struct cons_pointer result = make_string_like_thing( c, tail, tag );
|
||||
|
||||
if ( strncmp( tag, KEYTAG, 4 ) == 0 ) {
|
||||
struct cons_pointer r = internedp( result, oblist );
|
||||
|
||||
if ( nilp(r)) {
|
||||
intern(result, oblist);
|
||||
} else {
|
||||
result = r;
|
||||
}
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
/**
|
||||
* Construct a cell which points to an executable Lisp special form.
|
||||
*/
|
||||
struct cons_pointer
|
||||
make_special( struct cons_pointer src, struct cons_pointer ( *executable )
|
||||
make_special( struct cons_pointer meta, struct cons_pointer ( *executable )
|
||||
( struct stack_frame * frame,
|
||||
struct cons_pointer, struct cons_pointer env ) ) {
|
||||
struct cons_pointer pointer = allocate_cell( SPECIALTAG );
|
||||
struct cons_space_object *cell = &pointer2cell( pointer );
|
||||
inc_ref( meta);
|
||||
|
||||
cell->payload.special.source = src;
|
||||
cell->payload.special.meta = meta;
|
||||
cell->payload.special.executable = executable;
|
||||
|
||||
return pointer;
|
||||
|
|
@ -232,12 +291,16 @@ make_special( struct cons_pointer src, struct cons_pointer ( *executable )
|
|||
/**
|
||||
* Construct a cell which points to a stream open for reading.
|
||||
* @param input the C stream to wrap.
|
||||
* @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( READTAG );
|
||||
struct cons_space_object *cell = &pointer2cell( pointer );
|
||||
|
||||
cell->payload.stream.stream = input;
|
||||
cell->payload.stream.meta = metadata;
|
||||
|
||||
return pointer;
|
||||
}
|
||||
|
|
@ -245,16 +308,33 @@ struct cons_pointer make_read_stream( URL_FILE * input ) {
|
|||
/**
|
||||
* Construct a cell which points to a stream open for writing.
|
||||
* @param output the C stream to wrap.
|
||||
* @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( WRITETAG );
|
||||
struct cons_space_object *cell = &pointer2cell( pointer );
|
||||
|
||||
cell->payload.stream.stream = output;
|
||||
cell->payload.stream.meta = metadata;
|
||||
|
||||
return pointer;
|
||||
}
|
||||
|
||||
/**
|
||||
* Return a lisp keyword representation of this wide character string.
|
||||
*/
|
||||
struct cons_pointer c_string_to_lisp_keyword( wchar_t *symbol ) {
|
||||
struct cons_pointer result = NIL;
|
||||
|
||||
for ( int i = wcslen( symbol ); i > 0; i-- ) {
|
||||
result = make_keyword( symbol[i - 1], result );
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
/**
|
||||
* Return a lisp string representation of this wide character string.
|
||||
*/
|
||||
|
|
|
|||
|
|
@ -8,6 +8,9 @@
|
|||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
|
||||
#ifndef __psse_consspaceobject_h
|
||||
#define __psse_consspaceobject_h
|
||||
|
||||
#include <stdbool.h>
|
||||
#include <stdint.h>
|
||||
#include <stdio.h>
|
||||
|
|
@ -19,8 +22,6 @@
|
|||
|
||||
#include "fopen.h"
|
||||
|
||||
#ifndef __consspaceobject_h
|
||||
#define __consspaceobject_h
|
||||
|
||||
/**
|
||||
* The length of a tag, in bytes.
|
||||
|
|
@ -39,6 +40,7 @@
|
|||
|
||||
/**
|
||||
* The string `CONS`, considered as an `unsigned int`.
|
||||
* @todo tag values should be collected into an enum.
|
||||
*/
|
||||
#define CONSTV 1397641027
|
||||
|
||||
|
|
@ -85,6 +87,16 @@
|
|||
*/
|
||||
#define INTEGERTV 1381256777
|
||||
|
||||
/**
|
||||
* A keyword - an interned, self-evaluating string.
|
||||
*/
|
||||
#define KEYTAG "KEYW"
|
||||
|
||||
/**
|
||||
* The string `KEYW`, considered as an `unsigned int`.
|
||||
*/
|
||||
#define KEYTV 1465468235
|
||||
|
||||
/**
|
||||
* A lambda cell. Lambdas are the interpretable (source) versions of functions.
|
||||
* \see FUNCTIONTAG.
|
||||
|
|
@ -258,6 +270,11 @@
|
|||
*/
|
||||
#define functionp(conspoint) (check_tag(conspoint,FUNCTIONTAG))
|
||||
|
||||
/**
|
||||
* true if `conspoint` points to a keyword, else false
|
||||
*/
|
||||
#define keywordp(conspoint) (check_tag(conspoint,KEYTAG))
|
||||
|
||||
/**
|
||||
* true if `conspoint` points to a special Lambda cell, else false
|
||||
*/
|
||||
|
|
@ -320,6 +337,8 @@
|
|||
*/
|
||||
#define writep(conspoint) (check_tag(conspoint,WRITETAG))
|
||||
|
||||
#define streamp(conspoint) (check_tag(conspoint,READTAG)||check_tag(conspoint,WRITETAG))
|
||||
|
||||
/**
|
||||
* true if `conspoint` points to a true cell, else false
|
||||
* (there should only be one of these so it's slightly redundant).
|
||||
|
|
@ -397,10 +416,9 @@ struct exception_payload {
|
|||
*/
|
||||
struct function_payload {
|
||||
/**
|
||||
* pointer to the source from which the function was compiled, or NIL
|
||||
* if it is a primitive.
|
||||
* pointer to metadata (e.g. the source from which the function was compiled).
|
||||
*/
|
||||
struct cons_pointer source;
|
||||
struct cons_pointer meta;
|
||||
/** 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
|
||||
|
|
@ -475,7 +493,7 @@ 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;
|
||||
struct cons_pointer meta;
|
||||
/** 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
|
||||
|
|
@ -500,8 +518,9 @@ struct stream_payload {
|
|||
/**
|
||||
* payload of a string cell. At least at first, only one UTF character will
|
||||
* be stored in each cell. The doctrine that 'a symbol is just a string'
|
||||
* didn't work; however, the payload of a symbol cell is identical to the
|
||||
* payload of a string cell.
|
||||
* didn't work; however, the payload of a symbol or keyword cell is identical
|
||||
* to the payload of a string cell, except that a keyword may store a hash
|
||||
* of its own value in the padding.
|
||||
*/
|
||||
struct string_payload {
|
||||
/** the actual character stored in this cell */
|
||||
|
|
@ -614,6 +633,12 @@ void inc_ref( struct cons_pointer pointer );
|
|||
|
||||
void dec_ref( struct cons_pointer pointer );
|
||||
|
||||
struct cons_pointer c_type( struct cons_pointer pointer );
|
||||
|
||||
struct cons_pointer c_car( struct cons_pointer arg );
|
||||
|
||||
struct cons_pointer c_cdr( struct cons_pointer arg );
|
||||
|
||||
struct cons_pointer make_cons( struct cons_pointer car,
|
||||
struct cons_pointer cdr );
|
||||
|
||||
|
|
@ -626,6 +651,8 @@ struct cons_pointer make_function( struct cons_pointer src,
|
|||
struct cons_pointer,
|
||||
struct cons_pointer ) );
|
||||
|
||||
struct cons_pointer c_string_to_lisp_keyword( wchar_t *symbol );
|
||||
|
||||
struct cons_pointer make_lambda( struct cons_pointer args,
|
||||
struct cons_pointer body );
|
||||
|
||||
|
|
@ -640,11 +667,18 @@ struct cons_pointer make_special( struct cons_pointer src,
|
|||
|
||||
struct cons_pointer make_string( wint_t c, struct cons_pointer tail );
|
||||
|
||||
struct cons_pointer make_symbol( wint_t c, struct cons_pointer tail );
|
||||
struct cons_pointer make_symbol_or_key( wint_t c, struct cons_pointer tail,
|
||||
char *tag );
|
||||
|
||||
struct cons_pointer make_read_stream( URL_FILE * input );
|
||||
#define make_symbol(c, t) (make_symbol_or_key( c, t, SYMBOLTAG))
|
||||
|
||||
struct cons_pointer make_write_stream( URL_FILE * output );
|
||||
#define make_keyword(c, t) (make_symbol_or_key( c, t, KEYTAG))
|
||||
|
||||
struct cons_pointer make_read_stream( URL_FILE * input,
|
||||
struct cons_pointer metadata );
|
||||
|
||||
struct cons_pointer make_write_stream( URL_FILE * output,
|
||||
struct cons_pointer metadata );
|
||||
|
||||
struct cons_pointer c_string_to_lisp_string( wchar_t *string );
|
||||
|
||||
|
|
|
|||
|
|
@ -108,13 +108,15 @@ void dump_object( URL_FILE * output, struct cons_pointer pointer ) {
|
|||
case RATIOTV:
|
||||
url_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:
|
||||
url_fwprintf( output, L"\t\tInput stream\n" );
|
||||
url_fputws( L"\t\tInput stream; metadata: ", output );
|
||||
print(output, cell.payload.stream.meta);
|
||||
url_fputws( L"\n", output );
|
||||
break;
|
||||
case REALTV:
|
||||
url_fwprintf( output, L"\t\tReal cell: value %Lf, count %u\n",
|
||||
|
|
@ -148,7 +150,9 @@ void dump_object( URL_FILE * output, struct cons_pointer pointer ) {
|
|||
}
|
||||
break;
|
||||
case WRITETV:
|
||||
url_fwprintf( output, L"\t\tOutput stream\n" );
|
||||
url_fputws( L"\t\tOutput stream; metadata: ", output );
|
||||
print(output, cell.payload.stream.meta);
|
||||
url_fputws( L"\n", output );
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue