Fixed, working.

This commit is contained in:
Simon Brooke 2019-01-29 22:36:20 +00:00
parent eb394d153f
commit f9bcac10e7
14 changed files with 159 additions and 155 deletions

View file

@ -44,10 +44,9 @@ void bind_function( wchar_t *name, struct cons_pointer ( *executable )
( struct stack_frame *, ( struct stack_frame *,
struct cons_pointer, struct cons_pointer ) ) { struct cons_pointer, struct cons_pointer ) ) {
struct cons_pointer n = c_string_to_lisp_symbol( name ); struct cons_pointer n = c_string_to_lisp_symbol( name );
struct cons_pointer meta = make_cons( struct cons_pointer meta =
make_cons(c_string_to_lisp_keyword(L"primitive"), TRUE), make_cons( make_cons( c_string_to_lisp_keyword( L"primitive" ), TRUE ),
make_cons( make_cons( make_cons( make_cons( c_string_to_lisp_keyword( L"name" ),
c_string_to_lisp_keyword(L"name"),
n ), n ),
NIL ) ); NIL ) );
@ -62,10 +61,9 @@ void bind_special( wchar_t *name, struct cons_pointer ( *executable )
( struct stack_frame *, ( struct stack_frame *,
struct cons_pointer, struct cons_pointer ) ) { struct cons_pointer, struct cons_pointer ) ) {
struct cons_pointer n = c_string_to_lisp_symbol( name ); struct cons_pointer n = c_string_to_lisp_symbol( name );
struct cons_pointer meta = make_cons( struct cons_pointer meta =
make_cons(c_string_to_lisp_keyword(L"primitive"), TRUE), make_cons( make_cons( c_string_to_lisp_keyword( L"primitive" ), TRUE ),
make_cons( make_cons( make_cons( make_cons( c_string_to_lisp_keyword( L"name" ),
c_string_to_lisp_keyword(L"name"),
n ), n ),
NIL ) ); NIL ) );

View file

@ -55,7 +55,8 @@ int io_init() {
curl_share_setopt( io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_CONNECT ); curl_share_setopt( io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_CONNECT );
curl_share_setopt( io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_COOKIE ); curl_share_setopt( io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_COOKIE );
curl_share_setopt( io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_DNS ); curl_share_setopt( io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_DNS );
curl_share_setopt(io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_SSL_SESSION ); curl_share_setopt( io_share, CURLSHOPT_SHARE,
CURL_LOCK_DATA_SSL_SESSION );
curl_share_setopt( io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_PSL ); curl_share_setopt( io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_PSL );
} }
@ -254,7 +255,8 @@ int index_of( char c, char * s) {
char *trim( char *s ) { char *trim( char *s ) {
int i; int i;
for (i = strlen(s); (isblank(s[i]) || iscntrl(s[i])) && i > -1; i--) { for ( i = strlen( s ); ( isblank( s[i] ) || iscntrl( s[i] ) ) && i > -1;
i-- ) {
s[i] = ( char ) 0; s[i] = ( char ) 0;
} }
for ( i = 0; isblank( s[i] ) && s[i] != 0; i++ ); for ( i = 0; isblank( s[i] ) && s[i] != 0; i++ );
@ -266,8 +268,8 @@ char * trim(char *s) {
* Callback to assemble metadata for a URL stream. This is naughty because * Callback to assemble metadata for a URL stream. This is naughty because
* it modifies data, but it's really the only way to create metadata. * it modifies data, but it's really the only way to create metadata.
*/ */
static size_t write_meta_callback(void *ptr, size_t size, size_t nmemb, struct cons_pointer stream) static size_t write_meta_callback( void *ptr, size_t size, size_t nmemb,
{ struct cons_pointer stream ) {
struct cons_space_object *cell = &pointer2cell( stream ); struct cons_space_object *cell = &pointer2cell( stream );
if ( strncmp( &cell->tag.bytes[0], READTAG, 4 ) || if ( strncmp( &cell->tag.bytes[0], READTAG, 4 ) ||
@ -285,16 +287,20 @@ static size_t write_meta_callback(void *ptr, size_t size, size_t nmemb, struct c
mbstowcs( wname, name, strlen( name ) ); mbstowcs( wname, name, strlen( name ) );
mbstowcs( wvalue, value, strlen( value ) ); mbstowcs( wvalue, value, strlen( value ) );
cell->payload.stream.meta = make_cons( cell->payload.stream.meta =
make_cons( make_cons( make_cons
c_string_to_lisp_keyword( wname), ( c_string_to_lisp_keyword( wname ),
c_string_to_lisp_string( wvalue ) ), c_string_to_lisp_string( wvalue ) ),
cell->payload.stream.meta ); cell->payload.stream.meta );
debug_printf( DEBUG_IO, L"write_meta_callback: added header '%s': value '%s'\n", name, value); debug_printf( DEBUG_IO,
L"write_meta_callback: added header '%s': value '%s'\n",
name, value );
} }
} else { } else {
debug_print( L"Pointer passed to write_meta_callback did not point to a stream: ", DEBUG_IO); debug_print
( L"Pointer passed to write_meta_callback did not point to a stream: ",
DEBUG_IO );
debug_dump_object( stream, DEBUG_IO ); debug_dump_object( stream, DEBUG_IO );
} }
@ -315,7 +321,8 @@ void collect_meta( struct cons_pointer stream, struct cons_pointer url ) {
case CFTYPE_CURL: case CFTYPE_CURL:
curl_easy_setopt( s->handle.curl, CURLOPT_VERBOSE, 1L ); curl_easy_setopt( s->handle.curl, CURLOPT_VERBOSE, 1L );
curl_easy_setopt( s->handle.curl, CURLOPT_HEADER, 1L ); curl_easy_setopt( s->handle.curl, CURLOPT_HEADER, 1L );
curl_easy_setopt( s->handle.curl, CURLOPT_HEADERFUNCTION, write_meta_callback); curl_easy_setopt( s->handle.curl, CURLOPT_HEADERFUNCTION,
write_meta_callback );
curl_easy_setopt( s->handle.curl, CURLOPT_HEADERDATA, stream ); curl_easy_setopt( s->handle.curl, CURLOPT_HEADERDATA, stream );
break; break;
} }
@ -344,8 +351,7 @@ struct cons_pointer
if ( stringp( frame->arg[0] ) ) { if ( stringp( frame->arg[0] ) ) {
struct cons_pointer meta = struct cons_pointer meta =
make_cons( make_cons( make_cons( make_cons( c_string_to_lisp_keyword( L"url" ),
c_string_to_lisp_keyword( L"url" ),
frame->arg[0] ), frame->arg[0] ),
NIL ); NIL );
@ -392,8 +398,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
if ( readp( frame->arg[0] ) ) { if ( readp( frame->arg[0] ) ) {
result = result =
make_string( url_fgetwc make_string( url_fgetwc
( pointer2cell( frame->arg[0] ).payload. ( pointer2cell( frame->arg[0] ).payload.stream.
stream.stream ), NIL ); stream ), NIL );
} }
return result; return result;

View file

@ -355,8 +355,8 @@ struct cons_pointer read_symbol_or_key( URL_FILE * input, char *tag,
make_symbol_or_key( initial, make_symbol_or_key( initial,
read_symbol_or_key( input, read_symbol_or_key( input,
tag, tag,
url_fgetwc( input ) ), url_fgetwc
tag ); ( input ) ), tag );
} else { } else {
result = NIL; result = NIL;
/* /*

View file

@ -108,10 +108,10 @@ void dump_object( URL_FILE * output, struct cons_pointer pointer ) {
case RATIOTV: case RATIOTV:
url_fwprintf( output, url_fwprintf( output,
L"\t\tRational cell: value %ld/%ld, count %u\n", L"\t\tRational cell: value %ld/%ld, count %u\n",
pointer2cell( cell.payload.ratio.dividend ).payload. pointer2cell( cell.payload.ratio.dividend ).
integer.value, payload.integer.value,
pointer2cell( cell.payload.ratio.divisor ).payload. pointer2cell( cell.payload.ratio.divisor ).
integer.value, cell.count ); payload.integer.value, cell.count );
break; break;
case READTV: case READTV:
url_fputws( L"\t\tInput stream; metadata: ", output ); url_fputws( L"\t\tInput stream; metadata: ", output );

View file

@ -352,9 +352,8 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
result = next_pointer; result = next_pointer;
} else { } else {
result = result =
( *fn_cell.payload. ( *fn_cell.payload.special.
special.executable ) ( get_stack_frame executable ) ( get_stack_frame( next_pointer ),
( next_pointer ),
next_pointer, env ); next_pointer, env );
debug_print( L"Special form returning: ", DEBUG_EVAL ); debug_print( L"Special form returning: ", DEBUG_EVAL );
debug_print_object( result, DEBUG_EVAL ); debug_print_object( result, DEBUG_EVAL );
@ -842,7 +841,9 @@ struct cons_pointer c_reverse( struct cons_pointer arg ) {
result = make_string( o.payload.string.character, result ); result = make_string( o.payload.string.character, result );
break; break;
case SYMBOLTV: case SYMBOLTV:
result = make_symbol_or_key( o.payload.string.character, result, SYMBOLTAG ); result =
make_symbol_or_key( o.payload.string.character, result,
SYMBOLTAG );
break; break;
} }
} }

View file

@ -17,7 +17,8 @@
* *
* @return a pointer to the metadata of my first argument, or nil if none. * @return a pointer to the metadata of my first argument, or nil if none.
*/ */
struct cons_pointer lisp_metadata( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer lisp_metadata( struct stack_frame *frame,
struct cons_pointer frame_pointer,
struct cons_pointer env ) { struct cons_pointer env ) {
debug_print( L"lisp_metadata: entered\n", DEBUG_EVAL ); debug_print( L"lisp_metadata: entered\n", DEBUG_EVAL );
debug_dump_object( frame->arg[0], DEBUG_EVAL ); debug_dump_object( frame->arg[0], DEBUG_EVAL );
@ -33,15 +34,12 @@ struct cons_pointer lisp_metadata( struct stack_frame *frame, struct cons_pointe
break; break;
case READTV: case READTV:
case WRITETV: case WRITETV:
result = cell.payload.special.meta; result = cell.payload.stream.meta;
break; break;
} }
return make_cons( return make_cons( make_cons( c_string_to_lisp_keyword( L"type" ),
make_cons( c_type( frame->arg[0] ) ), result );
c_string_to_lisp_keyword( L"type"),
c_type(frame->arg[0])),
result);
// return result; // return result;
} }

View file

@ -11,7 +11,8 @@
#define __psse_meta_h #define __psse_meta_h
struct cons_pointer lisp_metadata( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer lisp_metadata( struct stack_frame *frame,
struct cons_pointer frame_pointer,
struct cons_pointer env ); struct cons_pointer env );
#endif #endif