From 0e11adea1cfdafe97f4b0ebe5e8ce74e956132a5 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Sun, 27 Jan 2019 17:22:13 +0000 Subject: [PATCH] Compiles, most tests break --- src/arith/peano.c | 129 +++--- src/arith/peano.h | 14 +- src/arith/ratio.c | 16 +- src/debug.c | 9 +- src/init.c | 19 +- src/io/fopen.c | 832 ++++++++++++++++------------------- src/io/fopen.h | 55 +-- src/io/io.c | 177 ++++++++ src/io/io.h | 28 ++ src/memory/conspage.c | 2 +- src/memory/consspaceobject.h | 4 + src/memory/dump.c | 113 ++--- src/memory/stack.c | 24 +- src/memory/vectorspace.c | 5 +- src/ops/equal.c | 4 +- src/ops/intern.c | 8 +- src/ops/intern.h | 6 +- src/ops/io.c | 8 - src/ops/lispops.c | 56 ++- src/ops/print.c | 50 +-- src/ops/read.c | 54 ++- src/ops/read.h | 3 +- 22 files changed, 902 insertions(+), 714 deletions(-) create mode 100644 src/io/io.c create mode 100644 src/io/io.h delete mode 100644 src/ops/io.c diff --git a/src/arith/peano.c b/src/arith/peano.c index 7db638a..8e4cb43 100644 --- a/src/arith/peano.c +++ b/src/arith/peano.c @@ -43,13 +43,14 @@ bool zerop( struct cons_pointer arg ) { struct cons_space_object cell = pointer2cell( arg ); switch ( cell.tag.value ) { - case INTEGERTV: { + case INTEGERTV:{ do { - debug_print(L"zerop: ", DEBUG_ARITH); - debug_dump_object(arg, DEBUG_ARITH); - result = (pointer2cell( arg ).payload.integer.value == 0); - arg = pointer2cell(arg).payload.integer.more; - } while (result && integerp(arg)); + debug_print( L"zerop: ", DEBUG_ARITH ); + debug_dump_object( arg, DEBUG_ARITH ); + result = + ( pointer2cell( arg ).payload.integer.value == 0 ); + arg = pointer2cell( arg ).payload.integer.more; + } while ( result && integerp( arg ) ); } break; case RATIOTV: @@ -66,7 +67,7 @@ bool zerop( struct cons_pointer arg ) { /** * does this `arg` point to a negative number? */ -bool is_negative( struct cons_pointer arg) { +bool is_negative( struct cons_pointer arg ) { bool result = false; struct cons_space_object cell = pointer2cell( arg ); @@ -85,27 +86,31 @@ bool is_negative( struct cons_pointer arg) { return result; } -struct cons_pointer absolute( struct cons_pointer frame_pointer, struct cons_pointer arg) { - struct cons_pointer result = NIL; +struct cons_pointer absolute( struct cons_pointer frame_pointer, + struct cons_pointer arg ) { + struct cons_pointer result = NIL; struct cons_space_object cell = pointer2cell( arg ); - if ( is_negative( arg)) { - switch ( cell.tag.value ) { - case INTEGERTV: - result = make_integer(llabs(cell.payload.integer.value), cell.payload.integer.more); - break; - case RATIOTV: - result = make_ratio(frame_pointer, - absolute(frame_pointer, cell.payload.ratio.dividend), - cell.payload.ratio.divisor); - break; - case REALTV: - result = make_real( 0 - cell.payload.real.value ); - break; + if ( is_negative( arg ) ) { + switch ( cell.tag.value ) { + case INTEGERTV: + result = + make_integer( llabs( cell.payload.integer.value ), + cell.payload.integer.more ); + break; + case RATIOTV: + result = make_ratio( frame_pointer, + absolute( frame_pointer, + cell.payload.ratio.dividend ), + cell.payload.ratio.divisor ); + break; + case REALTV: + result = make_real( 0 - cell.payload.real.value ); + break; + } } - } - return result; + return result; } /** @@ -126,7 +131,7 @@ long double to_long_double( struct cons_pointer arg ) { switch ( cell.tag.value ) { case INTEGERTV: // obviously, this doesn't work for bignums - result = (long double)cell.payload.integer.value; + result = ( long double ) cell.payload.integer.value; // sadly, this doesn't work at all. // result += 1.0; // for (bool is_first = false; integerp(arg); is_first = true) { @@ -141,8 +146,8 @@ long double to_long_double( struct cons_pointer arg ) { // } break; case RATIOTV: - result = to_long_double(cell.payload.ratio.dividend) / - to_long_double(cell.payload.ratio.divisor); + result = to_long_double( cell.payload.ratio.dividend ) / + to_long_double( cell.payload.ratio.divisor ); break; case REALTV: result = cell.payload.real.value; @@ -203,9 +208,9 @@ int64_t to_long_int( struct cons_pointer arg ) { * argument, or NIL if it was not a number. */ struct cons_pointer lisp_absolute( struct stack_frame - *frame, struct cons_pointer frame_pointer, struct - cons_pointer env ) { - return absolute( frame_pointer, frame->arg[0]); + *frame, struct cons_pointer frame_pointer, struct + cons_pointer env ) { + return absolute( frame_pointer, frame->arg[0] ); } /** @@ -388,10 +393,12 @@ struct cons_pointer multiply_2( struct stack_frame *frame, to_long_double( arg2 ) ); break; default: - result = throw_exception( make_cons( - c_string_to_lisp_string( L"Cannot multiply: argument 2 is not a number: " ), - c_type(arg2)), - frame_pointer ); + result = + throw_exception( make_cons + ( c_string_to_lisp_string + ( L"Cannot multiply: argument 2 is not a number: " ), + c_type( arg2 ) ), + frame_pointer ); break; } break; @@ -415,11 +422,12 @@ struct cons_pointer multiply_2( struct stack_frame *frame, to_long_double( arg2 ) ); break; default: - result = throw_exception( - make_cons(c_string_to_lisp_string - ( L"Cannot multiply: argument 2 is not a number" ), - c_type(arg2)), - frame_pointer ); + result = + throw_exception( make_cons + ( c_string_to_lisp_string + ( L"Cannot multiply: argument 2 is not a number" ), + c_type( arg2 ) ), + frame_pointer ); } break; case REALTV: @@ -428,11 +436,10 @@ struct cons_pointer multiply_2( struct stack_frame *frame, to_long_double( arg2 ) ); break; default: - result = throw_exception( - make_cons(c_string_to_lisp_string - ( L"Cannot multiply: argument 1 is not a number" ), - c_type(arg1)), - frame_pointer ); + result = throw_exception( make_cons( c_string_to_lisp_string + ( L"Cannot multiply: argument 1 is not a number" ), + c_type( arg1 ) ), + frame_pointer ); break; } } @@ -460,30 +467,27 @@ struct cons_pointer lisp_multiply( struct struct cons_pointer result = make_integer( 1, NIL ); struct cons_pointer tmp; - for ( int i = 0; - i < args_in_frame - && !nilp( frame->arg[i] ) - && !exceptionp( result ); - i++ ) { - debug_print( L"lisp_multiply: accumulator = ",DEBUG_ARITH); - debug_print_object(result, DEBUG_ARITH); - debug_print( L"; arg = ", DEBUG_ARITH); - debug_print_object(frame->arg[i], DEBUG_ARITH); - debug_println( DEBUG_ARITH); + for ( int i = 0; i < args_in_frame && !nilp( frame->arg[i] ) + && !exceptionp( result ); i++ ) { + debug_print( L"lisp_multiply: accumulator = ", DEBUG_ARITH ); + debug_print_object( result, DEBUG_ARITH ); + debug_print( L"; arg = ", DEBUG_ARITH ); + debug_print_object( frame->arg[i], DEBUG_ARITH ); + debug_println( DEBUG_ARITH ); - multiply_one_arg(frame->arg[i]); + multiply_one_arg( frame->arg[i] ); } struct cons_pointer more = frame->more; while ( consp( more ) && !exceptionp( result ) ) { - multiply_one_arg(c_car( more )); + multiply_one_arg( c_car( more ) ); more = c_cdr( more ); } - debug_print( L"lisp_multiply returning: ",DEBUG_ARITH); - debug_print_object(result, DEBUG_ARITH); - debug_println(DEBUG_ARITH); + debug_print( L"lisp_multiply returning: ", DEBUG_ARITH ); + debug_print_object( result, DEBUG_ARITH ); + debug_println( DEBUG_ARITH ); return result; } @@ -538,9 +542,10 @@ struct cons_pointer negative( struct cons_pointer frame, * was not. */ struct cons_pointer lisp_is_negative( struct stack_frame - *frame, struct cons_pointer frame_pointer, struct - cons_pointer env ) { - return is_negative(frame->arg[0]) ? TRUE : NIL; + *frame, + struct cons_pointer frame_pointer, struct + cons_pointer env ) { + return is_negative( frame->arg[0] ) ? TRUE : NIL; } diff --git a/src/arith/peano.h b/src/arith/peano.h index 7164a24..7ad7662 100644 --- a/src/arith/peano.h +++ b/src/arith/peano.h @@ -22,23 +22,25 @@ bool zerop( struct cons_pointer arg ); struct cons_pointer negative( struct cons_pointer frame, struct cons_pointer arg ); -bool is_negative( struct cons_pointer arg); +bool is_negative( struct cons_pointer arg ); -struct cons_pointer absolute( struct cons_pointer frame_pointer, struct cons_pointer arg); +struct cons_pointer absolute( struct cons_pointer frame_pointer, + struct cons_pointer arg ); long double to_long_double( struct cons_pointer arg ); struct cons_pointer lisp_absolute( struct stack_frame - *frame, struct cons_pointer frame_pointer, struct - cons_pointer env ); + *frame, struct cons_pointer frame_pointer, struct + cons_pointer env ); struct cons_pointer lisp_add( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ); struct cons_pointer lisp_is_negative( struct stack_frame - *frame, struct cons_pointer frame_pointer, struct - cons_pointer env ); + *frame, + struct cons_pointer frame_pointer, struct + cons_pointer env ); struct cons_pointer lisp_multiply( struct stack_frame *frame, diff --git a/src/arith/ratio.c b/src/arith/ratio.c index 784e71e..65b09da 100644 --- a/src/arith/ratio.c +++ b/src/arith/ratio.c @@ -55,10 +55,10 @@ struct cons_pointer simplify_ratio( struct cons_pointer frame_pointer, if ( ratiop( arg ) ) { int64_t ddrv = - pointer2cell( pointer2cell( arg ).payload.ratio.dividend ).payload. - integer.value, drrv = - pointer2cell( pointer2cell( arg ).payload.ratio.divisor ).payload. - integer.value, gcd = greatest_common_divisor( ddrv, drrv ); + pointer2cell( pointer2cell( arg ).payload.ratio.dividend ). + payload.integer.value, drrv = + pointer2cell( pointer2cell( arg ).payload.ratio.divisor ). + payload.integer.value, gcd = greatest_common_divisor( ddrv, drrv ); if ( gcd > 1 ) { if ( drrv / gcd == 1 ) { @@ -199,10 +199,10 @@ struct cons_pointer divide_ratio_ratio( struct cons_pointer frame_pointer, struct cons_pointer arg1, struct cons_pointer arg2 ) { struct cons_pointer i = make_ratio( frame_pointer, - pointer2cell( arg2 ).payload.ratio. - divisor, - pointer2cell( arg2 ).payload.ratio. - dividend ), result = + pointer2cell( arg2 ).payload. + ratio.divisor, + pointer2cell( arg2 ).payload. + ratio.dividend ), result = multiply_ratio_ratio( frame_pointer, arg1, i ); dec_ref( i ); diff --git a/src/debug.c b/src/debug.c index d694827..14881f9 100644 --- a/src/debug.c +++ b/src/debug.c @@ -19,6 +19,7 @@ #include #include "consspaceobject.h" +#include "fopen.h" #include "debug.h" #include "dump.h" #include "print.h" @@ -104,8 +105,10 @@ void debug_printf( int level, wchar_t *format, ... ) { void debug_print_object( struct cons_pointer pointer, int level ) { #ifdef DEBUG if ( level & verbosity ) { + URL_FILE *ustderr = file_to_url_file( stderr ); fwide( stderr, 1 ); - print( stderr, pointer ); + print( ustderr, pointer ); + free( ustderr ); } #endif } @@ -116,8 +119,10 @@ void debug_print_object( struct cons_pointer pointer, int level ) { void debug_dump_object( struct cons_pointer pointer, int level ) { #ifdef DEBUG if ( level & verbosity ) { + URL_FILE *ustderr = file_to_url_file( stderr ); fwide( stderr, 1 ); - dump_object( stderr, pointer ); + dump_object( ustderr, pointer ); + free( ustderr ); } #endif } diff --git a/src/init.c b/src/init.c index 8f278bf..a45e685 100644 --- a/src/init.c +++ b/src/init.c @@ -21,6 +21,7 @@ #include "consspaceobject.h" #include "debug.h" #include "intern.h" +#include "io.h" #include "lispops.h" #include "peano.h" #include "print.h" @@ -82,7 +83,7 @@ int main( int argc, char *argv[] ) { bool dump_at_end = false; bool show_prompt = false; - setlocale(LC_ALL, ""); + setlocale( LC_ALL, "" ); while ( ( option = getopt( argc, argv, "cpdv:" ) ) != -1 ) { switch ( option ) { @@ -131,9 +132,9 @@ int main( int argc, char *argv[] ) { fwide( stdout, 1 ); fwide( stderr, 1 ); fwide( sink->handle.file, 1 ); - bind_value( L"*in*", make_read_stream( file_to_url_file(stdin) ) ); - bind_value( L"*out*", make_write_stream( file_to_url_file(stdout) ) ); - bind_value( L"*log*", make_write_stream( file_to_url_file(stderr) ) ); + bind_value( L"*in*", make_read_stream( file_to_url_file( stdin ) ) ); + bind_value( L"*out*", make_write_stream( file_to_url_file( stdout ) ) ); + bind_value( L"*log*", make_write_stream( file_to_url_file( stderr ) ) ); bind_value( L"*sink*", make_write_stream( sink ) ); /* @@ -151,6 +152,7 @@ int main( int argc, char *argv[] ) { bind_function( L"assoc", &lisp_assoc ); bind_function( L"car", &lisp_car ); bind_function( L"cdr", &lisp_cdr ); + bind_function( L"close", &lisp_close ); bind_function( L"cons", &lisp_cons ); bind_function( L"divide", &lisp_divide ); bind_function( L"eq", &lisp_eq ); @@ -159,12 +161,15 @@ int main( int argc, char *argv[] ) { bind_function( L"exception", &lisp_exception ); bind_function( L"inspect", &lisp_inspect ); bind_function( L"multiply", &lisp_multiply ); - bind_function( L"negative?", &lisp_is_negative); + bind_function( L"negative?", &lisp_is_negative ); bind_function( L"read", &lisp_read ); bind_function( L"repl", &lisp_repl ); bind_function( L"oblist", &lisp_oblist ); + bind_function( L"open", &lisp_open ); bind_function( L"print", &lisp_print ); bind_function( L"progn", &lisp_progn ); + bind_function( L"read", &lisp_read ); + bind_function( L"read_char", &lisp_read_char ); bind_function( L"reverse", &lisp_reverse ); bind_function( L"set", &lisp_set ); bind_function( L"source", &lisp_source ); @@ -183,7 +188,7 @@ int main( int argc, char *argv[] ) { */ bind_special( L"cond", &lisp_cond ); bind_special( L"lambda", &lisp_lambda ); - bind_special( L"\u03bb", &lisp_lambda ); // λ + bind_special( L"\u03bb", &lisp_lambda ); // λ bind_special( L"nlambda", &lisp_nlambda ); bind_special( L"n\u03bb", &lisp_nlambda ); bind_special( L"progn", &lisp_progn ); @@ -200,7 +205,7 @@ int main( int argc, char *argv[] ) { debug_dump_object( oblist, DEBUG_BOOTSTRAP ); if ( dump_at_end ) { - dump_pages( file_to_url_file(stdout) ); + dump_pages( file_to_url_file( stdout ) ); } return ( 0 ); diff --git a/src/io/fopen.c b/src/io/fopen.c index 14c95e8..499fada 100644 --- a/src/io/fopen.c +++ b/src/io/fopen.c @@ -6,6 +6,9 @@ * Modifications to read/write wide character streams by * Simon Brooke. * + * NOTE THAT: for my purposes, I'm only interested in wide characters, + * and I always read them one character at a time. + * * Copyright (c) 2003, 2017 Simtec Electronics * Some portions (c) 2019 Simon Brooke * @@ -34,14 +37,13 @@ * This example requires libcurl 7.9.7 or later. */ - +#include #include +#include #include #ifndef WIN32 -# include +#include #endif -#include -#include #include @@ -51,362 +53,376 @@ static CURLM *multi_handle; /* curl calls this routine to get more data */ -static size_t write_callback(char *buffer, - size_t size, - size_t nitems, - void *userp) -{ - char *newbuff; - size_t rembuff; +static size_t write_callback( char *buffer, + size_t size, size_t nitems, void *userp ) { + char *newbuff; + size_t rembuff; - URL_FILE *url = (URL_FILE *)userp; - size *= nitems; + URL_FILE *url = ( URL_FILE * ) userp; + size *= nitems; - rembuff = url->buffer_len - url->buffer_pos; /* remaining space in buffer */ + rembuff = url->buffer_len - url->buffer_pos; /* remaining space in buffer */ - if(size > rembuff) { - /* not enough space in buffer */ - newbuff = realloc(url->buffer, url->buffer_len + (size - rembuff)); - if(newbuff == NULL) { - fprintf(stderr, "callback buffer grow failed\n"); - size = rembuff; + if ( size > rembuff ) { + /* not enough space in buffer */ + newbuff = realloc( url->buffer, url->buffer_len + ( size - rembuff ) ); + if ( newbuff == NULL ) { + fprintf( stderr, "callback buffer grow failed\n" ); + size = rembuff; + } else { + /* realloc succeeded increase buffer size */ + url->buffer_len += size - rembuff; + url->buffer = newbuff; + } } - else { - /* realloc succeeded increase buffer size*/ - url->buffer_len += size - rembuff; - url->buffer = newbuff; - } - } - memcpy(&url->buffer[url->buffer_pos], buffer, size); - url->buffer_pos += size; + memcpy( &url->buffer[url->buffer_pos], buffer, size ); + url->buffer_pos += size; - return size; + return size; } /* use to attempt to fill the read buffer up to requested number of bytes */ -static int fill_buffer(URL_FILE *file, size_t want) -{ - fd_set fdread; - fd_set fdwrite; - fd_set fdexcep; - struct timeval timeout; - int rc; - CURLMcode mc; /* curl_multi_fdset() return code */ +static int fill_buffer( URL_FILE * file, size_t want ) { + fd_set fdread; + fd_set fdwrite; + fd_set fdexcep; + struct timeval timeout; + int rc; + CURLMcode mc; /* curl_multi_fdset() return code */ - /* only attempt to fill buffer if transactions still running and buffer - * doesn't exceed required size already - */ - if((!file->still_running) || (file->buffer_pos > want)) - return 0; + /* only attempt to fill buffer if transactions still running and buffer + * doesn't exceed required size already + */ + if ( ( !file->still_running ) || ( file->buffer_pos > want ) ) + return 0; - /* attempt to fill buffer */ - do { - int maxfd = -1; - long curl_timeo = -1; + /* attempt to fill buffer */ + do { + int maxfd = -1; + long curl_timeo = -1; - FD_ZERO(&fdread); - FD_ZERO(&fdwrite); - FD_ZERO(&fdexcep); + FD_ZERO( &fdread ); + FD_ZERO( &fdwrite ); + FD_ZERO( &fdexcep ); - /* set a suitable timeout to fail on */ - timeout.tv_sec = 60; /* 1 minute */ - timeout.tv_usec = 0; + /* set a suitable timeout to fail on */ + timeout.tv_sec = 60; /* 1 minute */ + timeout.tv_usec = 0; - curl_multi_timeout(multi_handle, &curl_timeo); - if(curl_timeo >= 0) { - timeout.tv_sec = curl_timeo / 1000; - if(timeout.tv_sec > 1) - timeout.tv_sec = 1; - else - timeout.tv_usec = (curl_timeo % 1000) * 1000; - } + curl_multi_timeout( multi_handle, &curl_timeo ); + if ( curl_timeo >= 0 ) { + timeout.tv_sec = curl_timeo / 1000; + if ( timeout.tv_sec > 1 ) + timeout.tv_sec = 1; + else + timeout.tv_usec = ( curl_timeo % 1000 ) * 1000; + } - /* get file descriptors from the transfers */ - mc = curl_multi_fdset(multi_handle, &fdread, &fdwrite, &fdexcep, &maxfd); + /* get file descriptors from the transfers */ + mc = curl_multi_fdset( multi_handle, &fdread, &fdwrite, &fdexcep, + &maxfd ); - if(mc != CURLM_OK) { - fprintf(stderr, "curl_multi_fdset() failed, code %d.\n", mc); - break; - } + if ( mc != CURLM_OK ) { + fprintf( stderr, "curl_multi_fdset() failed, code %d.\n", mc ); + break; + } - /* On success the value of maxfd is guaranteed to be >= -1. We call - select(maxfd + 1, ...); specially in case of (maxfd == -1) there are - no fds ready yet so we call select(0, ...) --or Sleep() on Windows-- - to sleep 100ms, which is the minimum suggested value in the - curl_multi_fdset() doc. */ + /* On success the value of maxfd is guaranteed to be >= -1. We call + select(maxfd + 1, ...); specially in case of (maxfd == -1) there are + no fds ready yet so we call select(0, ...) --or Sleep() on Windows-- + to sleep 100ms, which is the minimum suggested value in the + curl_multi_fdset() doc. */ - if(maxfd == -1) { + if ( maxfd == -1 ) { #ifdef _WIN32 - Sleep(100); - rc = 0; + Sleep( 100 ); + rc = 0; #else - /* Portable sleep for platforms other than Windows. */ - struct timeval wait = { 0, 100 * 1000 }; /* 100ms */ - rc = select(0, NULL, NULL, NULL, &wait); + /* Portable sleep for platforms other than Windows. */ + struct timeval wait = { 0, 100 * 1000 }; /* 100ms */ + rc = select( 0, NULL, NULL, NULL, &wait ); #endif - } - else { - /* Note that on some platforms 'timeout' may be modified by select(). - If you need access to the original value save a copy beforehand. */ - rc = select(maxfd + 1, &fdread, &fdwrite, &fdexcep, &timeout); - } + } else { + /* Note that on some platforms 'timeout' may be modified by select(). + If you need access to the original value save a copy beforehand. */ + rc = select( maxfd + 1, &fdread, &fdwrite, &fdexcep, &timeout ); + } - switch(rc) { - case -1: - /* select error */ - break; + switch ( rc ) { + case -1: + /* select error */ + break; - case 0: - default: - /* timeout or readable/writable sockets */ - curl_multi_perform(multi_handle, &file->still_running); - break; - } - } while(file->still_running && (file->buffer_pos < want)); - return 1; + case 0: + default: + /* timeout or readable/writable sockets */ + curl_multi_perform( multi_handle, &file->still_running ); + break; + } + } while ( file->still_running && ( file->buffer_pos < want ) ); + + return 1; } /* use to remove want bytes from the front of a files buffer */ -static int use_buffer(URL_FILE *file, size_t want) -{ - /* sort out buffer */ - if((file->buffer_pos - want) <= 0) { - /* ditch buffer - write will recreate */ - free(file->buffer); - file->buffer = NULL; - free(file->wide_buffer); - file->wide_buffer = NULL; - file->buffer_pos = 0; - file->buffer_len = 0; - file->wide_cursor = 0; - } - else { - /* move rest down make it available for later */ - memmove(file->buffer, - &file->buffer[want], - (file->buffer_pos - want)); +static int use_buffer( URL_FILE * file, size_t want ) { + /* sort out buffer */ + if ( ( file->buffer_pos - want ) <= 0 ) { + /* ditch buffer - write will recreate */ + free( file->buffer ); + file->buffer = NULL; + file->buffer_pos = 0; + file->buffer_len = 0; + } else { + /* move rest down make it available for later */ + memmove( file->buffer, + &file->buffer[want], ( file->buffer_pos - want ) ); - file->buffer_pos -= want; - // TODO: something to adjust the wide_cursor - } - return 0; -} - -URL_FILE *url_fopen(const char *url, const char *operation) -{ - /* this code could check for URLs or types in the 'url' and - basically use the real fopen() for standard files */ - - URL_FILE *file; - (void)operation; - - file = calloc(1, sizeof(URL_FILE)); - if(!file) - return NULL; - - file->handle.file = fopen(url, operation); - if(file->handle.file) - file->type = CFTYPE_FILE; /* marked as URL */ - - else { - file->type = CFTYPE_CURL; /* marked as URL */ - file->handle.curl = curl_easy_init(); - - curl_easy_setopt(file->handle.curl, CURLOPT_URL, url); - curl_easy_setopt(file->handle.curl, CURLOPT_WRITEDATA, file); - curl_easy_setopt(file->handle.curl, CURLOPT_VERBOSE, 0L); - curl_easy_setopt(file->handle.curl, CURLOPT_WRITEFUNCTION, write_callback); - - if(!multi_handle) - multi_handle = curl_multi_init(); - - curl_multi_add_handle(multi_handle, file->handle.curl); - - /* lets start the fetch */ - curl_multi_perform(multi_handle, &file->still_running); - - if((file->buffer_pos == 0) && (!file->still_running)) { - /* if still_running is 0 now, we should return NULL */ - - /* make sure the easy handle is not in the multi handle anymore */ - curl_multi_remove_handle(multi_handle, file->handle.curl); - - /* cleanup */ - curl_easy_cleanup(file->handle.curl); - - free(file); - - file = NULL; + file->buffer_pos -= want; } - } - return file; + return 0; } -int url_fclose(URL_FILE *file) -{ - int ret = 0;/* default is good return */ +/** + * consume one wide character on the buffer of this file. + * + * @param file the url or file from which the character is consumed. + */ +static int use_one_wide( URL_FILE * file ) { + int c = ( int ) file->buffer[file->buffer_pos]; + size_t count = 0; - switch(file->type) { - case CFTYPE_FILE: - ret = fclose(file->handle.file); /* passthrough */ - break; - - case CFTYPE_CURL: - /* make sure the easy handle is not in the multi handle anymore */ - curl_multi_remove_handle(multi_handle, file->handle.curl); - - /* cleanup */ - curl_easy_cleanup(file->handle.curl); - break; - - default: /* unknown or supported type - oh dear */ - ret = EOF; - errno = EBADF; - break; - } - - free(file->buffer);/* free any allocated buffer space */ - free(file); - - return ret; -} - -int url_feof(URL_FILE *file) -{ - int ret = 0; - - switch(file->type) { - case CFTYPE_FILE: - ret = feof(file->handle.file); - break; - - case CFTYPE_CURL: - if((file->buffer_pos == 0) && (!file->still_running)) - ret = 1; - break; - - default: /* unknown or supported type - oh dear */ - ret = -1; - errno = EBADF; - break; - } - return ret; -} - -size_t url_fread(void *ptr, size_t size, size_t nmemb, URL_FILE *file) -{ - size_t want; - - switch(file->type) { - case CFTYPE_FILE: - want = fread(ptr, size, nmemb, file->handle.file); - break; - - case CFTYPE_CURL: - want = nmemb * size; - - fill_buffer(file, want); - - /* check if there's data in the buffer - if not fill_buffer() - * either errored or EOF */ - if(!file->buffer_pos) - return 0; - - /* ensure only available data is considered */ - if(file->buffer_pos < want) - want = file->buffer_pos; - - /* xfer data to caller */ - memcpy(ptr, file->buffer, want); - - use_buffer(file, want); - - want = want / size; /* number of items */ - break; - - default: /* unknown or supported type - oh dear */ - want = 0; - errno = EBADF; - break; - - } - return want; -} - -char *url_fgets(char *ptr, size_t size, URL_FILE *file) -{ - size_t want = size - 1;/* always need to leave room for zero termination */ - size_t loop; - - switch(file->type) { - case CFTYPE_FILE: - ptr = fgets(ptr, (int)size, file->handle.file); - break; - - case CFTYPE_CURL: - fill_buffer(file, want); - - /* check if there's data in the buffer - if not fill either errored or - * EOF */ - if(!file->buffer_pos) - return NULL; - - /* ensure only available data is considered */ - if(file->buffer_pos < want) - want = file->buffer_pos; - - /*buffer contains data */ - /* look for newline or eof */ - for(loop = 0; loop < want; loop++) { - if(file->buffer[loop] == '\n') { - want = loop + 1;/* include newline */ - break; - } + /* The value of each individual byte indicates its UTF-8 function, as follows: + * + * 00 to 7F hex (0 to 127): first and only byte of a sequence. + * 80 to BF hex (128 to 191): continuing byte in a multi-byte sequence. + * C2 to DF hex (194 to 223): first byte of a two-byte sequence. + * E0 to EF hex (224 to 239): first byte of a three-byte sequence. + * F0 to FF hex (240 to 255): first byte of a four-byte sequence. + */ + if ( c <= '0x07' ) { + count = 1; + } else if ( c >= '0xc2' && c <= '0xdf' ) { + count = 2; + } else if ( c >= '0xe0' && c <= '0xef' ) { + count = 3; + } else if ( c >= '0xf0' && c <= '0xff' ) { + count = 4; } - /* xfer data to caller */ - memcpy(ptr, file->buffer, want); - ptr[want] = 0;/* always null terminate */ - - use_buffer(file, want); - - break; - - default: /* unknown or supported type - oh dear */ - ptr = NULL; - errno = EBADF; - break; - } - - return ptr;/*success */ + return use_buffer( file, c ); } -void url_rewind(URL_FILE *file) -{ - switch(file->type) { - case CFTYPE_FILE: - rewind(file->handle.file); /* passthrough */ - break; +URL_FILE *url_fopen( const char *url, const char *operation ) { + /* this code could check for URLs or types in the 'url' and + basically use the real fopen() for standard files */ - case CFTYPE_CURL: - /* halt transaction */ - curl_multi_remove_handle(multi_handle, file->handle.curl); + URL_FILE *file; + ( void ) operation; - /* restart */ - curl_multi_add_handle(multi_handle, file->handle.curl); + file = calloc( 1, sizeof( URL_FILE ) ); + if ( !file ) + return NULL; - /* ditch buffer - write will recreate - resets stream pos*/ - free(file->buffer); - file->buffer = NULL; - file->buffer_pos = 0; - file->buffer_len = 0; + file->handle.file = fopen( url, operation ); + if ( file->handle.file ) + file->type = CFTYPE_FILE; /* marked as URL */ - break; + else { + file->type = CFTYPE_CURL; /* marked as URL */ + file->handle.curl = curl_easy_init( ); - default: /* unknown or supported type - oh dear */ - break; - } + curl_easy_setopt( file->handle.curl, CURLOPT_URL, url ); + curl_easy_setopt( file->handle.curl, CURLOPT_WRITEDATA, file ); + curl_easy_setopt( file->handle.curl, CURLOPT_VERBOSE, 0L ); + curl_easy_setopt( file->handle.curl, CURLOPT_WRITEFUNCTION, + write_callback ); + + if ( !multi_handle ) + multi_handle = curl_multi_init( ); + + curl_multi_add_handle( multi_handle, file->handle.curl ); + + /* lets start the fetch */ + curl_multi_perform( multi_handle, &file->still_running ); + + if ( ( file->buffer_pos == 0 ) && ( !file->still_running ) ) { + /* if still_running is 0 now, we should return NULL */ + + /* make sure the easy handle is not in the multi handle anymore */ + curl_multi_remove_handle( multi_handle, file->handle.curl ); + + /* cleanup */ + curl_easy_cleanup( file->handle.curl ); + + free( file ); + + file = NULL; + } + } + return file; +} + +int url_fclose( URL_FILE * file ) { + int ret = 0; /* default is good return */ + + switch ( file->type ) { + case CFTYPE_FILE: + ret = fclose( file->handle.file ); /* passthrough */ + break; + + case CFTYPE_CURL: + /* make sure the easy handle is not in the multi handle anymore */ + curl_multi_remove_handle( multi_handle, file->handle.curl ); + + /* cleanup */ + curl_easy_cleanup( file->handle.curl ); + break; + + default: /* unknown or supported type - oh dear */ + ret = EOF; + errno = EBADF; + break; + } + + free( file->buffer ); /* free any allocated buffer space */ + free( file ); + + return ret; +} + +int url_feof( URL_FILE * file ) { + int ret = 0; + + switch ( file->type ) { + case CFTYPE_FILE: + ret = feof( file->handle.file ); + break; + + case CFTYPE_CURL: + if ( ( file->buffer_pos == 0 ) && ( !file->still_running ) ) + ret = 1; + break; + + default: /* unknown or supported type - oh dear */ + ret = -1; + errno = EBADF; + break; + } + return ret; +} + +size_t url_fread( void *ptr, size_t size, size_t nmemb, URL_FILE * file ) { + size_t want; + + switch ( file->type ) { + case CFTYPE_FILE: + want = fread( ptr, size, nmemb, file->handle.file ); + break; + + case CFTYPE_CURL: + want = nmemb * size; + + fill_buffer( file, want ); + + /* check if there's data in the buffer - if not fill_buffer() + * either errored or EOF */ + if ( !file->buffer_pos ) + return 0; + + /* ensure only available data is considered */ + if ( file->buffer_pos < want ) + want = file->buffer_pos; + + /* xfer data to caller */ + memcpy( ptr, file->buffer, want ); + + use_buffer( file, want ); + + want = want / size; /* number of items */ + break; + + default: /* unknown or supported type - oh dear */ + want = 0; + errno = EBADF; + break; + + } + return want; +} + +char *url_fgets( char *ptr, size_t size, URL_FILE * file ) { + size_t want = size - 1; /* always need to leave room for zero termination */ + size_t loop; + + switch ( file->type ) { + case CFTYPE_FILE: + ptr = fgets( ptr, ( int ) size, file->handle.file ); + break; + + case CFTYPE_CURL: + fill_buffer( file, want ); + + /* check if there's data in the buffer - if not fill either errored or + * EOF */ + if ( !file->buffer_pos ) + return NULL; + + /* ensure only available data is considered */ + if ( file->buffer_pos < want ) + want = file->buffer_pos; + + /*buffer contains data */ + /* look for newline or eof */ + for ( loop = 0; loop < want; loop++ ) { + if ( file->buffer[loop] == '\n' ) { + want = loop + 1; /* include newline */ + break; + } + } + + /* xfer data to caller */ + memcpy( ptr, file->buffer, want ); + ptr[want] = 0; /* always null terminate */ + + use_buffer( file, want ); + + break; + + default: /* unknown or supported type - oh dear */ + ptr = NULL; + errno = EBADF; + break; + } + + return ptr; /*success */ +} + +void url_rewind( URL_FILE * file ) { + switch ( file->type ) { + case CFTYPE_FILE: + rewind( file->handle.file ); /* passthrough */ + break; + + case CFTYPE_CURL: + /* halt transaction */ + curl_multi_remove_handle( multi_handle, file->handle.curl ); + + /* restart */ + curl_multi_add_handle( multi_handle, file->handle.curl ); + + /* ditch buffer - write will recreate - resets stream pos */ + free( file->buffer ); + file->buffer = NULL; + file->buffer_pos = 0; + file->buffer_len = 0; + + break; + + default: /* unknown or supported type - oh dear */ + break; + } } /** @@ -415,153 +431,79 @@ void url_rewind(URL_FILE *file) * @param f the file to be wrapped; * @return the new handle, or null if no such handle could be allocated. */ -URL_FILE * file_to_url_file( FILE* f) { - URL_FILE * result = (URL_FILE *)malloc(sizeof(URL_FILE)); +URL_FILE *file_to_url_file( FILE * f ) { + URL_FILE *result = ( URL_FILE * ) malloc( sizeof( URL_FILE ) ); - if ( result != NULL) { - result->type = CFTYPE_FILE, - result->handle.file = f; - } + if ( result != NULL ) { + result->type = CFTYPE_FILE, result->handle.file = f; + } - return result; + return result; } + /** * get one wide character from the buffer. * * @param file the stream to read from; * @return the next wide character on the stream, or zero if no more. */ -wint_t url_fgetwc(URL_FILE *input) { - wint_t result = 0; +wint_t url_fgetwc( URL_FILE * input ) { + wint_t result = -1; - switch(input->type) { - case CFTYPE_FILE: - fwide( input->handle.file, 1 ); /* wide characters */ - result = fgetc(input->handle.file); /* passthrough */ - break; + switch ( input->type ) { + case CFTYPE_FILE: + fwide( input->handle.file, 1 ); /* wide characters */ + result = fgetwc( input->handle.file ); /* passthrough */ + break; - case CFTYPE_CURL: - if (input.buffer_len != 0) { - if ( input.wide_buffer == NULL) { - /* not initialised */ - input.wide_buffer = calloc( input.buffer_len, sizeof(wint_t)); - } + case CFTYPE_CURL:{ + wchar_t *wbuff = calloc( 2, sizeof( wchar_t ) ); + char *cbuff = calloc( 5, sizeof( char ) ); - size_t len = wcslen(input.wide_buffer); - if (input.still_running || - len == 0 || - len >= input.wide_cursor) { - /* refresh the wide buffer */ - mbstowcs(input.wide_buffer, input.buffer, input.buffer_pos); - } + url_fread( cbuff, sizeof( char ), 4, input ); + mbstowcs( wbuff, cbuff, 1 ); + result = wbuff[0]; + use_one_wide( input ); - result = input.wide_buffer[input.wide_cursor] ++; - - /* do something to fread (advance) one utf character */ + free( cbuff ); + free( wbuff ); + } + break; + case CFTYPE_NONE: + break; } - break; - } - return result; + return result; } -/* #define FGETSFILE "fgets.test" */ -/* #define FREADFILE "fread.test" */ -/* #define REWINDFILE "rewind.test" */ +wint_t url_ungetwc( wint_t wc, URL_FILE * input ) { + wint_t result = -1; -/* /\* Small main program to retrieve from a url using fgets and fread saving the */ -/* * output to two test files (note the fgets method will corrupt binary files if */ -/* * they contain 0 chars *\/ */ -/* int main(int argc, char *argv[]) */ -/* { */ -/* URL_FILE *handle; */ -/* FILE *outf; */ + switch ( input->type ) { + case CFTYPE_FILE: + fwide( input->handle.file, 1 ); /* wide characters */ + result = fgetwc( input->handle.file ); /* passthrough */ + break; -/* size_t nread; */ -/* char buffer[256]; */ -/* const char *url; */ + case CFTYPE_CURL:{ + wchar_t *wbuff = calloc( 2, sizeof( wchar_t ) ); + char *cbuff = calloc( 5, sizeof( char ) ); -/* if(argc < 2) */ -/* url = "http://192.168.7.3/testfile";/\* default to testurl *\/ */ -/* else */ -/* url = argv[1];/\* use passed url *\/ */ + wbuff[0] = wc; + result = wcstombs( cbuff, wbuff, 1 ); -/* /\* copy from url line by line with fgets *\/ */ -/* outf = fopen(FGETSFILE, "wb+"); */ -/* if(!outf) { */ -/* perror("couldn't open fgets output file\n"); */ -/* return 1; */ -/* } */ + input->buffer_pos -= strlen( cbuff ); -/* handle = url_fopen(url, "r"); */ -/* if(!handle) { */ -/* printf("couldn't url_fopen() %s\n", url); */ -/* fclose(outf); */ -/* return 2; */ -/* } */ + free( cbuff ); + free( wbuff ); -/* while(!url_feof(handle)) { */ -/* url_fgets(buffer, sizeof(buffer), handle); */ -/* fwrite(buffer, 1, strlen(buffer), outf); */ -/* } */ + result = result > 0 ? wc : result; + break; + case CFTYPE_NONE: + break; + } + } -/* url_fclose(handle); */ - -/* fclose(outf); */ - - -/* /\* Copy from url with fread *\/ */ -/* outf = fopen(FREADFILE, "wb+"); */ -/* if(!outf) { */ -/* perror("couldn't open fread output file\n"); */ -/* return 1; */ -/* } */ - -/* handle = url_fopen("testfile", "r"); */ -/* if(!handle) { */ -/* printf("couldn't url_fopen() testfile\n"); */ -/* fclose(outf); */ -/* return 2; */ -/* } */ - -/* do { */ -/* nread = url_fread(buffer, 1, sizeof(buffer), handle); */ -/* fwrite(buffer, 1, nread, outf); */ -/* } while(nread); */ - -/* url_fclose(handle); */ - -/* fclose(outf); */ - - -/* /\* Test rewind *\/ */ -/* outf = fopen(REWINDFILE, "wb+"); */ -/* if(!outf) { */ -/* perror("couldn't open fread output file\n"); */ -/* return 1; */ -/* } */ - -/* handle = url_fopen("testfile", "r"); */ -/* if(!handle) { */ -/* printf("couldn't url_fopen() testfile\n"); */ -/* fclose(outf); */ -/* return 2; */ -/* } */ - -/* nread = url_fread(buffer, 1, sizeof(buffer), handle); */ -/* fwrite(buffer, 1, nread, outf); */ -/* url_rewind(handle); */ - -/* buffer[0]='\n'; */ -/* fwrite(buffer, 1, 1, outf); */ - -/* nread = url_fread(buffer, 1, sizeof(buffer), handle); */ -/* fwrite(buffer, 1, nread, outf); */ - -/* url_fclose(handle); */ - -/* fclose(outf); */ - -/* return 0;/\* all done *\/ */ -/* } */ + return result; +} diff --git a/src/io/fopen.h b/src/io/fopen.h index 83ea5a8..f952a65 100644 --- a/src/io/fopen.h +++ b/src/io/fopen.h @@ -7,6 +7,9 @@ * Modifications to read/write wide character streams by * Simon Brooke. * + * NOTE THAT: for my purposes, I'm only interested in wide characters, + * and I always read them one character at a time. + * * Copyright (c) 2003, 2017 Simtec Electronics * Some portions (c) 2019 Simon Brooke * @@ -44,41 +47,41 @@ #include #include +#define url_fwprintf(f, ...) ((f->type = CFTYPE_FILE) ? fwprintf( f->handle.file, __VA_ARGS__) : -1) +#define url_fputws(ws, f) ((f->type = CFTYPE_FILE) ? fputws(ws, f->handle.file) : 0) +#define url_fputwc(wc, f) ((f->type = CFTYPE_FILE) ? fputwc(wc, f->handle.file) : 0) + enum fcurl_type_e { - CFTYPE_NONE = 0, - CFTYPE_FILE = 1, - CFTYPE_CURL = 2 + CFTYPE_NONE = 0, + CFTYPE_FILE = 1, + CFTYPE_CURL = 2 }; -struct fcurl_data -{ - enum fcurl_type_e type; /* type of handle */ - union { - CURL *curl; - FILE *file; - } handle; /* handle */ +struct fcurl_data { + enum fcurl_type_e type; /* type of handle */ + union { + CURL *curl; + FILE *file; + } handle; /* handle */ - char *buffer; /* buffer to store cached data*/ - wchar_t *wide_buffer; /* wide character buffer */ - size_t buffer_len; /* currently allocated buffer's length */ - size_t buffer_pos; /* end of data in buffer*/ - size_t wide_cursor; /* cursor into the wide buffer */ - int still_running; /* Is background url fetch still in progress */ + char *buffer; /* buffer to store cached data */ + size_t buffer_len; /* currently allocated buffer's length */ + size_t buffer_pos; /* cursor into in buffer */ + int still_running; /* Is background url fetch still in progress */ }; typedef struct fcurl_data URL_FILE; /* exported functions */ -URL_FILE *url_fopen(const char *url, const char *operation); -int url_fclose(URL_FILE *file); -int url_feof(URL_FILE *file); -size_t url_fread(void *ptr, size_t size, size_t nmemb, URL_FILE *file); -char *url_fgets(char *ptr, size_t size, URL_FILE *file); -void url_rewind(URL_FILE *file); - -wint_t url_fgetwc(URL_FILE *file); -URL_FILE * file_to_url_file( FILE* f); - +URL_FILE *url_fopen( const char *url, const char *operation ); +int url_fclose( URL_FILE * file ); +int url_feof( URL_FILE * file ); +size_t url_fread( void *ptr, size_t size, size_t nmemb, URL_FILE * file ); +char *url_fgets( char *ptr, size_t size, URL_FILE * file ); +void url_rewind( URL_FILE * file ); +wint_t url_fgetwc( URL_FILE * file ); +wint_t url_ungetwc( wint_t wc, URL_FILE * input ); +URL_FILE *file_to_url_file( FILE * f ); #endif diff --git a/src/io/io.c b/src/io/io.c new file mode 100644 index 0000000..5d2c652 --- /dev/null +++ b/src/io/io.c @@ -0,0 +1,177 @@ +/* + * io.c + * + * Communication between PSSE and the outside world, via libcurl. + * + * (c) 2019 Simon Brooke + * Licensed under GPL version 2.0, or, at your option, any later version. + */ + +#include + +#include "conspage.h" +#include "consspaceobject.h" +#include "debug.h" +#include "fopen.h" +#include "lispops.h" + +/** + * Convert this lisp string-like-thing (also works for symbols, and, later + * keywords) into a UTF-8 string. NOTE that the returned value has been + * malloced and must be freed. TODO: candidate to moving into a utilities + * file. + * + * @param s the lisp string or symbol; + * @return the c string. + */ +char *lisp_string_to_c_string( struct cons_pointer s ) { + char *result = NULL; + + if ( stringp( s ) || symbolp( s ) ) { + int len = 0; + + for ( struct cons_pointer c = s; !nilp( c ); + c = pointer2cell( c ).payload.string.cdr ) { + len++; + } + + wchar_t *buffer = calloc( len + 1, sizeof( wchar_t ) ); + /* worst case, one wide char = four utf bytes */ + result = calloc( ( len * 4 ) + 1, sizeof( char ) ); + + int i = 0; + for ( struct cons_pointer c = s; !nilp( c ); + c = pointer2cell( c ).payload.string.cdr ) { + buffer[i++] = pointer2cell( c ).payload.string.character; + } + + wcstombs( result, buffer, len ); + free( buffer ); + } + + return result; +} + +/** + * Function, sort-of: close the file indicated by my first arg, and return + * nil. If the first arg is not a stream, does nothing. All other args are + * ignored. + * + * * (close stream) + * + * @param frame my stack_frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env my environment. + * @return T if the stream was successfully closed, else NIL. + */ +struct cons_pointer +lisp_close( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { + struct cons_pointer result = NIL; + + if ( readp( frame->arg[0] ) || writep( frame->arg[0] ) ) { + if ( url_fclose( pointer2cell( frame->arg[0] ).payload.stream.stream ) + == 0 ) { + result = TRUE; + } + } + + return result; +} + +/** + * Function: return a stream open on the URL indicated by the first argument; + * if a second argument is present and is non-nil, open it for reading. At + * present, further arguments are ignored and there is no mechanism to open + * to append, or error if the URL is faulty or indicates an unavailable + * resource. + * + * * (read-char stream) + * + * @param frame my stack_frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env my environment. + * @return a string of one character, namely the next available character + * on my stream, if any, else NIL. + */ +struct cons_pointer +lisp_open( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { + struct cons_pointer result = NIL; + + if ( stringp( frame->arg[0] ) ) { + char *url = lisp_string_to_c_string( frame->arg[0] ); + + if ( nilp( frame->arg[1] ) ) { + result = make_read_stream( url_fopen( url, "r" ) ); + } else { + // TODO: anything more complex is a problem for another day. + result = make_write_stream( url_fopen( url, "w" ) ); + } + + free( url ); + } + + return result; +} + +/** + * Function: return the next character from the stream indicated by arg 0; + * further arguments are ignored. + * + * * (read-char stream) + * + * @param frame my stack_frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env my environment. + * @return a string of one character, namely the next available character + * on my stream, if any, else NIL. + */ +struct cons_pointer +lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { + struct cons_pointer result = NIL; + + if ( readp( frame->arg[0] ) ) { + result = + make_string( url_fgetwc + ( pointer2cell( frame->arg[0] ).payload.stream. + stream ), NIL ); + } + + return result; +} + +/** + * Function: return a string representing all characters from the stream + * indicated by arg 0; further arguments are ignored. + * + * * (slurp stream) + * + * @param frame my stack_frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env my environment. + * @return a string of one character, namely the next available character + * on my stream, if any, else NIL. + */ +struct cons_pointer +lisp_slurp( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { + struct cons_pointer result = NIL; + struct cons_pointer cdr = NIL; + + if ( readp( frame->arg[0] ) ) { + URL_FILE *stream = pointer2cell( frame->arg[0] ).payload.stream.stream; + + for ( wint_t c = url_fgetwc( stream ); c != -1; + c = url_fgetwc( stream ) ) { + cdr = make_string( ( ( wchar_t ) c ), cdr ); + + if ( nilp( result ) ) { + result = cdr; + } + } + } + + return result; +} diff --git a/src/io/io.h b/src/io/io.h new file mode 100644 index 0000000..06dcaed --- /dev/null +++ b/src/io/io.h @@ -0,0 +1,28 @@ + +/* + * io.h + * + * Communication between PSSE and the outside world, via libcurl. + * + * (c) 2019 Simon Brooke + * Licensed under GPL version 2.0, or, at your option, any later version. + */ + +#ifndef __psse_io_h +#define __psse_io_h + +struct cons_pointer +lisp_close( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ); +struct cons_pointer +lisp_open( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ); +struct cons_pointer +lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ); +struct cons_pointer +lisp_slurp( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ); + + +#endif diff --git a/src/memory/conspage.c b/src/memory/conspage.c index 03034e4..7a1a0d8 100644 --- a/src/memory/conspage.c +++ b/src/memory/conspage.c @@ -117,7 +117,7 @@ void make_cons_page( ) { */ void dump_pages( URL_FILE * output ) { for ( int i = 0; i < initialised_cons_pages; i++ ) { - fwprintf( output, L"\nDUMPING PAGE %d\n", i ); + url_fwprintf( output, L"\nDUMPING PAGE %d\n", i ); for ( int j = 0; j < CONSPAGESIZE; j++ ) { dump_object( output, ( struct cons_pointer ) { diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h index b3f587c..6230e64 100644 --- a/src/memory/consspaceobject.h +++ b/src/memory/consspaceobject.h @@ -491,6 +491,10 @@ struct special_payload { struct stream_payload { /** the stream to read from or write to. */ URL_FILE *stream; + /** metadata on the stream (e.g. its file attributes if a file, its HTTP + * headers if a URL, etc). Expected to be an association, or nil. Not yet + * implemented. */ + struct cons_pointer meta; }; /** diff --git a/src/memory/dump.c b/src/memory/dump.c index cec0dfd..e99d306 100644 --- a/src/memory/dump.c +++ b/src/memory/dump.c @@ -30,22 +30,22 @@ void dump_string_cell( URL_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 ); + url_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: " ); + url_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 ); + url_fwprintf( output, L"\t\t value: " ); print( output, pointer ); - fwprintf( output, L"\n" ); + url_fwprintf( output, L"\n" ); } } @@ -54,70 +54,71 @@ void dump_string_cell( URL_FILE * output, wchar_t *prefix, */ void dump_object( URL_FILE * output, struct cons_pointer pointer ) { struct cons_space_object cell = pointer2cell( pointer ); - fwprintf( output, - L"\t%4.4s (%d) at page %d, offset %d count %u\n", - cell.tag.bytes, - cell.tag.value, pointer.page, pointer.offset, cell.count ); + url_fwprintf( output, + L"\t%4.4s (%d) at page %d, offset %d count %u\n", + cell.tag.bytes, + 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 :", - cell.payload.cons.car.page, - cell.payload.cons.car.offset, - cell.payload.cons.cdr.page, - cell.payload.cons.cdr.offset, cell.count ); + url_fwprintf( output, + L"\t\tCons cell: car at page %d offset %d, cdr at page %d offset %d, count %u :", + cell.payload.cons.car.page, + cell.payload.cons.car.offset, + cell.payload.cons.cdr.page, + cell.payload.cons.cdr.offset, cell.count ); print( output, pointer ); - fputws( L"\n", output ); + url_fputws( L"\n", output ); break; case EXCEPTIONTV: - fwprintf( output, L"\t\tException cell: " ); + url_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 ); + url_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 ); + url_fwprintf( output, + L"\t\tInteger cell: value %ld, count %u\n", + cell.payload.integer.value, cell.count ); if ( !nilp( cell.payload.integer.more ) ) { - fputws( L"\t\tBIGNUM! More at:\n", output ); + url_fputws( L"\t\tBIGNUM! More at:\n", output ); dump_object( output, cell.payload.integer.more ); } break; case LAMBDATV: - fwprintf( output, L"\t\t\u03bb cell;\n\t\t args: " ); + url_fwprintf( output, L"\t\t\u03bb cell;\n\t\t args: " ); print( output, cell.payload.lambda.args ); - fwprintf( output, L";\n\t\t\tbody: " ); + url_fwprintf( output, L";\n\t\t\tbody: " ); print( output, cell.payload.lambda.body ); - fputws( L"\n", output ); + url_fputws( L"\n", output ); break; case NILTV: break; case NLAMBDATV: - fwprintf( output, L"\t\tn\u03bb cell; \n\t\targs: " ); + url_fwprintf( output, L"\t\tn\u03bb cell; \n\t\targs: " ); print( output, cell.payload.lambda.args ); - fwprintf( output, L";\n\t\t\tbody: " ); + url_fwprintf( output, L";\n\t\t\tbody: " ); print( output, cell.payload.lambda.body ); - fputws( L"\n", output ); + url_fputws( L"\n", output ); 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 ); + 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 ); break; case READTV: - fwprintf( output, L"\t\tInput stream\n" ); + url_fwprintf( output, L"\t\tInput stream\n" ); break; case REALTV: - fwprintf( output, L"\t\tReal cell: value %Lf, count %u\n", - cell.payload.real.value, cell.count ); + url_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 ); @@ -128,14 +129,14 @@ void dump_object( URL_FILE * output, struct cons_pointer pointer ) { case TRUETV: break; case VECTORPOINTTV:{ - fwprintf( output, - L"\t\tPointer to vector-space object at %p\n", - cell.payload.vectorp.address ); + url_fwprintf( output, + L"\t\tPointer to vector-space object at %p\n", + cell.payload.vectorp.address ); struct vector_space_object *vso = cell.payload.vectorp.address; - fwprintf( output, - L"\t\tVector space object of type %4.4s (%d), payload size %d bytes\n", - &vso->header.tag.bytes, vso->header.tag.value, - vso->header.size ); + url_fwprintf( output, + L"\t\tVector space object of type %4.4s (%d), payload size %d bytes\n", + &vso->header.tag.bytes, vso->header.tag.value, + vso->header.size ); if ( stackframep( vso ) ) { dump_frame( output, pointer ); } @@ -147,7 +148,7 @@ void dump_object( URL_FILE * output, struct cons_pointer pointer ) { } break; case WRITETV: - fwprintf( output, L"\t\tOutput stream\n" ); + url_fwprintf( output, L"\t\tOutput stream\n" ); break; } } diff --git a/src/memory/stack.c b/src/memory/stack.c index b2585c7..3f4a271 100644 --- a/src/memory/stack.c +++ b/src/memory/stack.c @@ -34,9 +34,9 @@ void set_reg( struct stack_frame *frame, int reg, struct cons_pointer value ) { debug_printf( DEBUG_STACK, L"Setting register %d to ", reg ); debug_print_object( value, DEBUG_STACK ); debug_println( DEBUG_STACK ); - dec_ref(frame->arg[reg]); /* if there was anything in that slot - * previously other than NIL, we need to decrement it; - * NIL won't be decremented as it is locked. */ + dec_ref( frame->arg[reg] ); /* if there was anything in that slot + * previously other than NIL, we need to decrement it; + * NIL won't be decremented as it is locked. */ frame->arg[reg] = value; inc_ref( value ); @@ -245,22 +245,22 @@ void dump_frame( URL_FILE * output, struct cons_pointer frame_pointer ) { struct stack_frame *frame = get_stack_frame( frame_pointer ); if ( frame != NULL ) { - fwprintf( output, L"Stack frame with %d arguments:\n", frame->args ); + url_fwprintf( output, L"Stack frame with %d arguments:\n", + frame->args ); 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 ); + url_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 ); + url_fputws( L"\n", output ); } if ( !nilp( frame->more ) ) { - fputws( L"More: \t", output ); + url_fputws( L"More: \t", output ); print( output, frame->more ); - fputws( L"\n", output ); + url_fputws( L"\n", output ); } } } @@ -268,7 +268,7 @@ void dump_frame( URL_FILE * output, struct cons_pointer frame_pointer ) { void dump_stack_trace( URL_FILE * output, struct cons_pointer pointer ) { if ( exceptionp( pointer ) ) { print( output, pointer2cell( pointer ).payload.exception.message ); - fputws( L"\n", output ); + url_fputws( L"\n", output ); dump_stack_trace( output, pointer2cell( pointer ).payload.exception.frame ); } else { diff --git a/src/memory/vectorspace.c b/src/memory/vectorspace.c index 9d98a77..480effb 100644 --- a/src/memory/vectorspace.c +++ b/src/memory/vectorspace.c @@ -36,7 +36,8 @@ * @return a cons_pointer to the object, or NIL if the object could not be * allocated due to memory exhaustion. */ -struct cons_pointer make_vec_pointer( struct vector_space_object *address, char *tag ) { +struct cons_pointer make_vec_pointer( struct vector_space_object *address, + char *tag ) { debug_print( L"Entered make_vec_pointer\n", DEBUG_ALLOC ); struct cons_pointer pointer = allocate_cell( VECTORPOINTTAG ); struct cons_space_object *cell = &pointer2cell( pointer ); @@ -46,7 +47,7 @@ struct cons_pointer make_vec_pointer( struct vector_space_object *address, char address ); cell->payload.vectorp.address = address; - strncpy(&cell->payload.vectorp.tag.bytes[0], tag, TAGLENGTH); + strncpy( &cell->payload.vectorp.tag.bytes[0], tag, TAGLENGTH ); debug_printf( DEBUG_ALLOC, L"make_vec_pointer: all good, returning pointer to %p\n", diff --git a/src/ops/equal.c b/src/ops/equal.c index 0c01a81..2775218 100644 --- a/src/ops/equal.c +++ b/src/ops/equal.c @@ -80,8 +80,8 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) { && ( equal( cell_a->payload.string.cdr, cell_b->payload.string.cdr ) || ( end_of_string( cell_a->payload.string.cdr ) - && end_of_string( cell_b->payload.string. - cdr ) ) ); + && end_of_string( cell_b->payload. + string.cdr ) ) ); break; case INTEGERTV: result = diff --git a/src/ops/intern.c b/src/ops/intern.c index 1e32a36..87d116e 100644 --- a/src/ops/intern.c +++ b/src/ops/intern.c @@ -110,8 +110,8 @@ struct cons_pointer c_assoc( struct cons_pointer key, * with this key/value pair added to the front. */ struct cons_pointer -bind( struct cons_pointer key, struct cons_pointer value, - struct cons_pointer store ) { +set( struct cons_pointer key, struct cons_pointer value, + struct cons_pointer store ) { debug_print( L"Binding ", DEBUG_BIND ); debug_print_object( key, DEBUG_BIND ); debug_print( L" to ", DEBUG_BIND ); @@ -131,7 +131,7 @@ deep_bind( struct cons_pointer key, struct cons_pointer value ) { debug_print( L"Entering deep_bind\n", DEBUG_BIND ); struct cons_pointer old = oblist; - oblist = bind( key, value, oblist ); + oblist = set( key, value, oblist ); inc_ref( oblist ); dec_ref( old ); @@ -153,7 +153,7 @@ intern( struct cons_pointer key, struct cons_pointer environment ) { /* * not currently bound */ - result = bind( key, NIL, environment ); + result = set( key, NIL, environment ); } return result; diff --git a/src/ops/intern.h b/src/ops/intern.h index b261242..fa17563 100644 --- a/src/ops/intern.h +++ b/src/ops/intern.h @@ -28,9 +28,9 @@ struct cons_pointer c_assoc( struct cons_pointer key, struct cons_pointer internedp( struct cons_pointer key, struct cons_pointer environment ); -struct cons_pointer bind( struct cons_pointer key, - struct cons_pointer value, - struct cons_pointer store ); +struct cons_pointer set( struct cons_pointer key, + struct cons_pointer value, + struct cons_pointer store ); struct cons_pointer deep_bind( struct cons_pointer key, struct cons_pointer value ); diff --git a/src/ops/io.c b/src/ops/io.c deleted file mode 100644 index ccd0af5..0000000 --- a/src/ops/io.c +++ /dev/null @@ -1,8 +0,0 @@ -/* - * io.c - * - * Communication between PSSE and the outside world, via libcurl. - * - * (c) 2017 Simon Brooke - * Licensed under GPL version 2.0, or, at your option, any later version. - */ diff --git a/src/ops/lispops.c b/src/ops/lispops.c index 9448c55..4bfe6f0 100644 --- a/src/ops/lispops.c +++ b/src/ops/lispops.c @@ -29,6 +29,7 @@ #include "debug.h" #include "dump.h" #include "equal.h" +#include "fopen.h" #include "integer.h" #include "intern.h" #include "lispops.h" @@ -231,7 +232,7 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame, struct cons_pointer name = c_car( names ); struct cons_pointer val = frame->arg[i]; - new_env = bind( name, val, new_env ); + new_env = set( name, val, new_env ); log_binding( name, val ); names = c_cdr( names ); @@ -256,7 +257,7 @@ eval_lambda( struct cons_space_object cell, struct stack_frame *frame, } } - new_env = bind( names, vals, new_env ); + new_env = set( names, vals, new_env ); inc_ref( new_env ); } @@ -377,10 +378,9 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer, result = next_pointer; } else { result = - ( *fn_cell.payload. - special.executable ) ( get_stack_frame - ( next_pointer ), - next_pointer, env ); + ( *fn_cell.payload.special. + executable ) ( get_stack_frame( next_pointer ), + next_pointer, env ); debug_print( L"Special form returning: ", DEBUG_EVAL ); debug_print_object( result, DEBUG_EVAL ); debug_println( DEBUG_EVAL ); @@ -627,10 +627,10 @@ lisp_set_shriek( struct stack_frame *frame, struct cons_pointer frame_pointer, * @return true if `arg` represents an end of string, else false. * \todo candidate for moving to a memory/string.c file */ -bool end_of_stringp(struct cons_pointer arg) { - return nilp(arg) || - ( stringp( arg ) && - pointer2cell(arg).payload.string.character == (wint_t)'\0'); +bool end_of_stringp( struct cons_pointer arg ) { + return nilp( arg ) || + ( stringp( arg ) && + pointer2cell( arg ).payload.string.character == ( wint_t ) '\0' ); } /** @@ -656,8 +656,8 @@ lisp_cons( struct stack_frame *frame, struct cons_pointer frame_pointer, if ( nilp( car ) && nilp( cdr ) ) { return NIL; } else if ( stringp( car ) && stringp( cdr ) && - end_of_stringp( c_cdr( car)) ) { - // \todo check that car is of length 1 + end_of_stringp( c_cdr( car ) ) ) { + // \todo check that car is of length 1 result = make_string( pointer2cell( car ).payload.string.character, cdr ); } else { @@ -691,7 +691,8 @@ lisp_car( struct stack_frame *frame, struct cons_pointer frame_pointer, result = cell.payload.cons.car; break; case READTV: - result = make_string( fgetwc( cell.payload.stream.stream ), NIL ); + result = + make_string( url_fgetwc( cell.payload.stream.stream ), NIL ); break; case NILTV: break; @@ -734,7 +735,7 @@ lisp_cdr( struct stack_frame *frame, struct cons_pointer frame_pointer, result = cell.payload.cons.cdr; break; case READTV: - fgetwc( cell.payload.stream.stream ); + url_fgetwc( cell.payload.stream.stream ); result = frame->arg[0]; break; case STRINGTV: @@ -839,7 +840,8 @@ lisp_read( struct stack_frame *frame, struct cons_pointer frame_pointer, #ifdef DEBUG debug_print( L"entering lisp_read\n", DEBUG_IO ); #endif - URL_FILE *input = stdin; + URL_FILE *input; + struct cons_pointer in_stream = readp( frame->arg[0] ) ? frame->arg[0] : get_default_stream( true, env ); @@ -848,6 +850,8 @@ lisp_read( struct stack_frame *frame, struct cons_pointer frame_pointer, debug_dump_object( in_stream, DEBUG_IO ); input = pointer2cell( in_stream ).payload.stream.stream; inc_ref( in_stream ); + } else { + input = file_to_url_file( stdin ); } struct cons_pointer result = read( frame, frame_pointer, input ); @@ -856,8 +860,11 @@ lisp_read( struct stack_frame *frame, struct cons_pointer frame_pointer, if ( readp( in_stream ) ) { dec_ref( in_stream ); + } else { + free( input ); } + return result; } @@ -922,7 +929,7 @@ lisp_print( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { debug_print( L"Entering print\n", DEBUG_IO ); struct cons_pointer result = NIL; - URL_FILE *output = stdout; + URL_FILE *output; struct cons_pointer out_stream = writep( frame->arg[1] ) ? frame->arg[1] : get_default_stream( false, env ); @@ -931,6 +938,8 @@ lisp_print( struct stack_frame *frame, struct cons_pointer frame_pointer, debug_dump_object( out_stream, DEBUG_IO ); output = pointer2cell( out_stream ).payload.stream.stream; inc_ref( out_stream ); + } else { + output = file_to_url_file( stderr ); } debug_print( L"lisp_print: about to print\n", DEBUG_IO ); @@ -943,6 +952,8 @@ lisp_print( struct stack_frame *frame, struct cons_pointer frame_pointer, if ( writep( out_stream ) ) { dec_ref( out_stream ); + } else { + free( output ); } return result; @@ -1035,7 +1046,7 @@ lisp_progn( struct stack_frame *frame, struct cons_pointer frame_pointer, * @return the value of the last expression of the first successful `clause`. */ struct cons_pointer - lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer, +lisp_cond( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { struct cons_pointer result = NIL; bool done = false; @@ -1165,7 +1176,7 @@ struct cons_pointer lisp_repl( struct stack_frame *frame, * print as parent. */ while ( readp( input ) && writep( output ) - && !feof( pointer2cell( input ).payload.stream.stream ) ) { + && !url_feof( pointer2cell( input ).payload.stream.stream ) ) { /* OK, here's a really subtle problem: because lists are immutable, anything * bound in the oblist subsequent to this function being invoked isn't in the * environment. So, for example, changes to *prompt* or *log* made in the oblist @@ -1203,7 +1214,7 @@ struct cons_pointer lisp_repl( struct stack_frame *frame, inc_ref( expr ); if ( exceptionp( expr ) - && feof( pointer2cell( input ).payload.stream.stream ) ) { + && url_feof( pointer2cell( input ).payload.stream.stream ) ) { /* suppress printing end of stream exception */ break; } @@ -1282,7 +1293,7 @@ struct cons_pointer lisp_inspect( struct stack_frame *frame, struct cons_pointer frame_pointer, struct cons_pointer env ) { debug_print( L"Entering print\n", DEBUG_IO ); - URL_FILE *output = stdout; + URL_FILE *output; struct cons_pointer out_stream = writep( frame->arg[1] ) ? frame->arg[1] : get_default_stream( false, env ); @@ -1291,11 +1302,16 @@ struct cons_pointer lisp_inspect( struct stack_frame *frame, debug_dump_object( out_stream, DEBUG_IO ); output = pointer2cell( out_stream ).payload.stream.stream; inc_ref( out_stream ); + } else { + output = file_to_url_file( stdout ); } + dump_object( output, frame->arg[0] ); if ( writep( out_stream ) ) { dec_ref( out_stream ); + } else { + free( output ); } return frame->arg[0]; diff --git a/src/ops/print.c b/src/ops/print.c index d313960..8cb137e 100644 --- a/src/ops/print.c +++ b/src/ops/print.c @@ -40,7 +40,7 @@ void print_string_contents( URL_FILE * output, struct cons_pointer pointer ) { wchar_t c = cell->payload.string.character; if ( c != '\0' ) { - fputwc( c, output ); + url_fputwc( c, output ); } pointer = cell->payload.string.cdr; } @@ -52,9 +52,9 @@ void print_string_contents( URL_FILE * output, struct cons_pointer pointer ) { * characters. */ void print_string( URL_FILE * output, struct cons_pointer pointer ) { - fputwc( btowc( '"' ), output ); + url_fputwc( btowc( '"' ), output ); print_string_contents( output, pointer ); - fputwc( btowc( '"' ), output ); + url_fputwc( btowc( '"' ), output ); } /** @@ -70,7 +70,7 @@ print_list_contents( URL_FILE * output, struct cons_pointer pointer, switch ( cell->tag.value ) { case CONSTV: if ( initial_space ) { - fputwc( btowc( ' ' ), output ); + url_fputwc( btowc( ' ' ), output ); } print( output, cell->payload.cons.car ); @@ -79,23 +79,23 @@ print_list_contents( URL_FILE * output, struct cons_pointer pointer, case NILTV: break; default: - fwprintf( output, L" . " ); + url_fwprintf( output, L" . " ); print( output, pointer ); } } void print_list( URL_FILE * output, struct cons_pointer pointer ) { if ( print_use_colours ) { - fwprintf( output, L"%s(%s", "\x1B[31m", "\x1B[39m" ); + url_fwprintf( output, L"%s(%s", "\x1B[31m", "\x1B[39m" ); } else { - fputws( L"(", output ); + url_fputws( L"(", output ); }; print_list_contents( output, pointer, false ); if ( print_use_colours ) { - fwprintf( output, L"%s)%s", "\x1B[31m", "\x1B[39m" ); + url_fwprintf( output, L"%s)%s", "\x1B[31m", "\x1B[39m" ); } else { - fputws( L")", output ); + url_fputws( L")", output ); } } @@ -117,18 +117,18 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) { print_list( output, pointer ); break; case EXCEPTIONTV: - fwprintf( output, L"\n%sException: ", - print_use_colours ? "\x1B[31m" : "" ); + url_fwprintf( output, L"\n%sException: ", + print_use_colours ? "\x1B[31m" : "" ); dump_stack_trace( output, pointer ); break; case FUNCTIONTV: - fwprintf( output, L"" ); + url_fwprintf( output, L"" ); break; case INTEGERTV:{ struct cons_pointer s = integer_to_string( pointer, 10 ); inc_ref( s ); if ( print_use_colours ) { - fputws( L"\x1B[34m", output ); + url_fputws( L"\x1B[34m", output ); } print_string_contents( output, s ); dec_ref( s ); @@ -147,7 +147,7 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) { } break; case NILTV: - fwprintf( output, L"nil" ); + url_fwprintf( output, L"nil" ); break; case NLAMBDATV:{ struct cons_pointer to_print = @@ -163,11 +163,11 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) { break; case RATIOTV: print( output, cell.payload.ratio.dividend ); - fputws( L"/", output ); + url_fputws( L"/", output ); print( output, cell.payload.ratio.divisor ); break; case READTV: - fwprintf( output, L"" ); + url_fwprintf( output, L"" ); break; case REALTV: /* \todo using the C heap is a bad plan because it will fragment. @@ -183,31 +183,31 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) { } } if ( print_use_colours ) { - fputws( L"\x1B[34m", output ); + url_fputws( L"\x1B[34m", output ); } - fwprintf( output, L"%s", buffer ); + url_fwprintf( output, L"%s", buffer ); free( buffer ); break; case STRINGTV: if ( print_use_colours ) { - fputws( L"\x1B[36m", output ); + url_fputws( L"\x1B[36m", output ); } print_string( output, pointer ); break; case SYMBOLTV: if ( print_use_colours ) { - fputws( L"\x1B[1;33m", output ); + url_fputws( L"\x1B[1;33m", output ); } print_string_contents( output, pointer ); break; case SPECIALTV: - fwprintf( output, L"" ); + url_fwprintf( output, L"" ); break; case TRUETV: - fwprintf( output, L"t" ); + url_fwprintf( output, L"t" ); break; case WRITETV: - fwprintf( output, L"" ); + url_fwprintf( output, L"" ); break; default: fwprintf( stderr, @@ -219,12 +219,12 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) { } if ( print_use_colours ) { - fputws( L"\x1B[39m", output ); + url_fputws( L"\x1B[39m", output ); } return pointer; } void println( URL_FILE * output ) { - fputws( L"\n", output ); + url_fputws( L"\n", output ); } diff --git a/src/ops/read.c b/src/ops/read.c index d2f79c4..989aa67 100644 --- a/src/ops/read.c +++ b/src/ops/read.c @@ -41,8 +41,8 @@ struct cons_pointer read_number( struct stack_frame *frame, URL_FILE * input, wint_t initial, bool seen_period ); struct cons_pointer read_list( struct stack_frame *frame, - struct cons_pointer frame_pointer, URL_FILE * input, - wint_t initial ); + struct cons_pointer frame_pointer, + URL_FILE * input, wint_t initial ); struct cons_pointer read_string( URL_FILE * input, wint_t initial ); struct cons_pointer read_symbol( URL_FILE * input, wint_t initial ); @@ -68,16 +68,18 @@ struct cons_pointer read_continuation( struct stack_frame *frame, wint_t c; for ( c = initial; - c == '\0' || iswblank( c ) || iswcntrl( c ); c = fgetwc( input ) ); + c == '\0' || iswblank( c ) || iswcntrl( c ); + c = url_fgetwc( input ) ); - if ( feof( input ) ) { + if ( url_feof( input ) ) { result = throw_exception( c_string_to_lisp_string ( L"End of file while reading" ), frame_pointer ); } else { switch ( c ) { case ';': - for ( c = fgetwc( input ); c != '\n'; c = fgetwc( input ) ); + for ( c = url_fgetwc( input ); c != '\n'; + c = url_fgetwc( input ) ); /* skip all characters from semi-colon to the end of the line */ break; case EOF: @@ -89,18 +91,19 @@ struct cons_pointer read_continuation( struct stack_frame *frame, result = c_quote( read_continuation ( frame, frame_pointer, input, - fgetwc( input ) ) ); + url_fgetwc( input ) ) ); break; case '(': result = - read_list( frame, frame_pointer, input, fgetwc( input ) ); + read_list( frame, frame_pointer, input, + url_fgetwc( input ) ); break; case '"': - result = read_string( input, fgetwc( input ) ); + result = read_string( input, url_fgetwc( input ) ); break; case '-':{ - wint_t next = fgetwc( input ); - ungetwc( next, input ); + wint_t next = url_fgetwc( input ); + url_ungetwc( next, input ); if ( iswdigit( next ) ) { result = read_number( frame, frame_pointer, input, c, @@ -112,9 +115,9 @@ struct cons_pointer read_continuation( struct stack_frame *frame, break; case '.': { - wint_t next = fgetwc( input ); + wint_t next = url_fgetwc( input ); if ( iswdigit( next ) ) { - ungetwc( next, input ); + url_ungetwc( next, input ); result = read_number( frame, frame_pointer, input, c, true ); @@ -123,13 +126,13 @@ struct cons_pointer read_continuation( struct stack_frame *frame, * really need to backtrack up a level. */ result = read_continuation( frame, frame_pointer, input, - fgetwc( input ) ); + url_fgetwc( input ) ); } else { read_symbol( input, c ); } } break; - //case ':': reserved for keywords and paths + //case ':': reserved for keywords and paths default: if ( iswdigit( c ) ) { result = @@ -173,14 +176,14 @@ struct cons_pointer read_number( struct stack_frame *frame, bool neg = initial == btowc( '-' ); if ( neg ) { - initial = fgetwc( input ); + initial = url_fgetwc( input ); } debug_printf( DEBUG_IO, L"read_number starting '%c' (%d)\n", initial, initial ); for ( c = initial; iswdigit( c ) - || c == L'.' || c == L'/' || c == L','; c = fgetwc( input ) ) { + || c == L'.' || c == L'/' || c == L','; c = url_fgetwc( input ) ) { switch ( c ) { case L'.': if ( seen_period || !nilp( dividend ) ) { @@ -229,7 +232,7 @@ struct cons_pointer read_number( struct stack_frame *frame, /* * push back the character read which was not a digit */ - ungetwc( c, input ); + url_ungetwc( c, input ); if ( seen_period ) { debug_print( L"read_number: converting result to real\n", DEBUG_IO ); @@ -279,7 +282,7 @@ struct cons_pointer read_list( struct stack_frame *frame, result = make_cons( car, read_list( frame, frame_pointer, input, - fgetwc( input ) ) ); + url_fgetwc( input ) ) ); } else { debug_print( L"End of list detected\n", DEBUG_IO ); } @@ -309,7 +312,8 @@ struct cons_pointer read_string( URL_FILE * input, wint_t initial ) { break; default: result = - make_string( initial, read_string( input, fgetwc( input ) ) ); + make_string( initial, + read_string( input, url_fgetwc( input ) ) ); break; } @@ -328,7 +332,8 @@ struct cons_pointer read_symbol( URL_FILE * input, wint_t initial ) { * THIS IS NOT A GOOD IDEA, but is legal */ result = - make_symbol( initial, read_symbol( input, fgetwc( input ) ) ); + make_symbol( initial, + read_symbol( input, url_fgetwc( input ) ) ); break; case ')': /* @@ -338,20 +343,20 @@ struct cons_pointer read_symbol( URL_FILE * input, wint_t initial ) { /* * push back the character read */ - ungetwc( initial, input ); + url_ungetwc( initial, input ); break; default: if ( iswprint( initial ) && !iswblank( initial ) ) { result = make_symbol( initial, - read_symbol( input, fgetwc( input ) ) ); + read_symbol( input, url_fgetwc( input ) ) ); } else { result = NIL; /* * push back the character read */ - ungetwc( initial, input ); + url_ungetwc( initial, input ); } break; } @@ -369,5 +374,6 @@ struct cons_pointer read( struct stack_frame *frame, struct cons_pointer frame_pointer, URL_FILE * input ) { - return read_continuation( frame, frame_pointer, input, fgetwc( input ) ); + return read_continuation( frame, frame_pointer, input, + url_fgetwc( input ) ); } diff --git a/src/ops/read.h b/src/ops/read.h index a1674d6..64f36b0 100644 --- a/src/ops/read.h +++ b/src/ops/read.h @@ -15,6 +15,7 @@ * read the next object on this input stream and return a cons_pointer to it. */ struct cons_pointer read( struct stack_frame *frame, - struct cons_pointer frame_pointer, URL_FILE * input ); + struct cons_pointer frame_pointer, + URL_FILE * input ); #endif