From 6f39dae75f6cf57cdcaca643a9653ca692af2af5 Mon Sep 17 00:00:00 2001 From: Simon Brooke Date: Thu, 7 May 2026 21:07:16 +0100 Subject: [PATCH] Tactical commit only. Something is badly broken in `read`, although I think this version is better thwan the last one. --- src/c/io/read.c | 426 ++++++++++++++++++++++---------------------- src/c/memory/dump.c | 8 +- 2 files changed, 217 insertions(+), 217 deletions(-) diff --git a/src/c/io/read.c b/src/c/io/read.c index f17349d..ba95ae6 100644 --- a/src/c/io/read.c +++ b/src/c/io/read.c @@ -42,9 +42,9 @@ #include "ops/assoc.h" #include "ops/reverse.h" -#include "payloads/stack.h" #include "ops/string_ops.h" #include "ops/truth.h" +#include "payloads/stack.h" // TODO: what I've copied from 0.0.6 is *weirdly* over-complex for just now. // I think I'm going to essentially delete all this and start again. We need @@ -77,21 +77,21 @@ * 1. The read table currently in use; * 2. The character most recently read from that stream. */ -struct pso_pointer read_example( struct pso_pointer frame_pointer ) { - struct pso4 *frame = pointer_to_pso4( frame_pointer ); - struct pso_pointer stream = fetch_arg( frame, 0 ); - struct pso_pointer readtable = fetch_arg( frame, 1 ); - struct pso_pointer character = fetch_arg( frame, 2 ); - struct pso_pointer result = nil; +struct pso_pointer read_example(struct pso_pointer frame_pointer) { + struct pso4 *frame = pointer_to_pso4(frame_pointer); + struct pso_pointer stream = fetch_arg(frame, 0); + struct pso_pointer readtable = fetch_arg(frame, 1); + struct pso_pointer character = fetch_arg(frame, 2); + struct pso_pointer result = nil; - return result; + return result; } -struct pso_pointer make_eof_exception( struct pso_pointer frame_pointer ) { - return make_exception( make_frame( 1, frame_pointer, - c_string_to_lisp_string - ( frame_pointer, - L"Read: end of input while reading" ) ) ); +struct pso_pointer make_eof_exception(struct pso_pointer frame_pointer) { + return make_exception( + make_frame(1, frame_pointer, + c_string_to_lisp_string( + frame_pointer, L"Read: end of input while reading"))); } /** @@ -106,20 +106,20 @@ struct pso_pointer make_eof_exception( struct pso_pointer frame_pointer ) { * @return a string of one character, namely the next available character * on my stream, if any, else nil. */ -struct pso_pointer read_character( struct pso_pointer frame_pointer ) { - struct pso4 *frame = pointer_to_pso4( frame_pointer ); - struct pso_pointer result = nil; - struct pso_pointer stream_pointer = fetch_arg( frame, 0 ); - if ( readp( stream_pointer ) ) { - wint_t chr = url_fgetwc( stream_get_url_file( stream_pointer ) ); - result = make_character( frame_pointer, chr ); +struct pso_pointer read_character(struct pso_pointer frame_pointer) { + struct pso4 *frame = pointer_to_pso4(frame_pointer); + struct pso_pointer result = nil; + struct pso_pointer stream_pointer = fetch_arg(frame, 0); + if (readp(stream_pointer)) { + wint_t chr = url_fgetwc(stream_get_url_file(stream_pointer)); + result = make_character(frame_pointer, chr); #ifdef DEBUG - debug_printf( DEBUG_IO, 0, L"\nRead character %lc\n", chr ); + debug_printf(DEBUG_IO, 0, L"\nRead character %lc\n", chr); #endif - } + } - return result; + return result; } /** @@ -128,82 +128,75 @@ struct pso_pointer read_character( struct pso_pointer frame_pointer ) { * potentially the first such character. Returns the first non-space character * encountered, or an exception. */ -struct pso_pointer skip_whitespace( struct pso_pointer frame_pointer ) { - struct pso4 *frame = pointer_to_pso4( frame_pointer ); - struct pso_pointer stream = fetch_arg( frame, 0 ); - struct pso_pointer readtable = fetch_arg( frame, 1 ); - struct pso_pointer character = fetch_arg( frame, 2 ); - struct pso_pointer result = nil; +struct pso_pointer skip_whitespace(struct pso_pointer frame_pointer) { + struct pso4 *frame = pointer_to_pso4(frame_pointer); + struct pso_pointer stream = fetch_arg(frame, 0); + struct pso_pointer readtable = fetch_arg(frame, 1); + struct pso_pointer character = fetch_arg(frame, 2); + struct pso_pointer result = nil; + + do { + if (!characterp(character)) { + character = read_character(make_frame( 1, frame_pointer, stream)); + } + if (characterp(character)) { + wchar_t wc = pointer_to_object(character)->payload.character.character; + if (!iswspace(wc) && !iswcntrl(wc) && wc != L',') { + result = character; + } else if (exceptionp(character)){ + result = character; + } else { + character = nil; + } + } + } while (c_nilp(result)); - if ( characterp( character ) ) { - wchar_t wc = - pointer_to_object( character )->payload.character.character; - if ( !iswspace( wc ) && wc != L',' ) { - result = character; - } - } - - if ( c_nilp( result ) && readp( stream ) ) { - URL_FILE *input = pointer_to_object( stream )->payload.stream.stream; - - wint_t wc = url_fgetwc( input ); - while ( iswspace( wc ) || wc == L',' ) { - wc = url_fgetwc( input ); - } - result = - ( wc == - WEOF ) ? make_eof_exception( frame_pointer ) : - make_character( frame_pointer, wc ); - } - - return result; + return result; } -struct pso_pointer read_list( struct pso_pointer frame_pointer ) { - struct pso4 *frame = pointer_to_pso4( frame_pointer ); - struct pso_pointer stream = fetch_arg( frame, 0 ); - struct pso_pointer readtable = fetch_arg( frame, 1 ); - struct pso_pointer character = fetch_arg( frame, 2 ); - struct pso_pointer result = nil; +struct pso_pointer read_list(struct pso_pointer frame_pointer) { + struct pso4 *frame = pointer_to_pso4(frame_pointer); + struct pso_pointer stream = fetch_arg(frame, 0); + struct pso_pointer readtable = fetch_arg(frame, 1); + struct pso_pointer character = fetch_arg(frame, 2); + struct pso_pointer result = nil; - if ( !c_nilp( character ) && characterp( character ) && - pointer_to_object( character )->payload.character.character == - SYNTAX_LPAR ) { - // it's OK if an LPAR is passed in, but we don't want it now. - character = nil; - } - if ( !c_nilp( character ) ) { - // if anything other than LPAR is passed in as character, TODO: throw exception. - } + if (!c_nilp(character) && characterp(character) && + pointer_to_object(character)->payload.character.character == + SYNTAX_LPAR) { + // it's OK if an LPAR is passed in, but we don't want it now. + character = nil; + } + if (!c_nilp(character)) { + // if anything other than LPAR is passed in as character, TODO: throw + // exception. + } - while ( c_nilp( character ) || ( characterp( character ) && - pointer_to_object( character )-> - payload.character.character != - SYNTAX_RPAR ) ) { - character = - skip_whitespace( make_frame - ( 3, frame_pointer, stream, readtable, - character ) ); - struct pso_pointer r = - read( make_frame - ( 3, frame_pointer, stream, readtable, character ) ); + do { + character = skip_whitespace( + make_frame(3, frame_pointer, stream, readtable, character)); + struct pso_pointer r = + read(make_frame(3, frame_pointer, stream, readtable, character)); - if ( exceptionp( r ) ) { - result = r; - break; - } else { - result = make_cons( frame_pointer, r, result ); - character = - skip_whitespace( make_frame - ( 3, frame_pointer, stream, readtable, - character ) ); - } - } + if (exceptionp(r)) { + result = r; + break; + } else { + result = make_cons(frame_pointer, r, result); + character = skip_whitespace( + make_frame(3, frame_pointer, stream, readtable, character)); + struct pso2 *ch = pointer_to_object(character); - return consp( result ) ? c_reverse( frame_pointer, result ) : result; + debug_dump_object(character, DEBUG_IO, 2); + } + } while (c_nilp(character) || + (characterp(character) && + pointer_to_object(character)->payload.character.character != + SYNTAX_RPAR)); + + return consp(result) ? c_reverse(frame_pointer, result) : result; } - /** * @brief Read one integer from the stream and return it. * @@ -214,76 +207,78 @@ struct pso_pointer read_list( struct pso_pointer frame_pointer ) { * 1. The read table currently in use; * 2. The character most recently read from that stream. */ -struct pso_pointer read_number( struct pso_pointer frame_pointer ) { - struct pso4 *frame = pointer_to_pso4( frame_pointer ); - struct pso_pointer stream = fetch_arg( frame, 0 ); - struct pso_pointer readtable = fetch_arg( frame, 1 ); - struct pso_pointer character = fetch_arg( frame, 2 ); - struct pso_pointer result = nil; +struct pso_pointer read_number(struct pso_pointer frame_pointer) { + struct pso4 *frame = pointer_to_pso4(frame_pointer); + struct pso_pointer stream = fetch_arg(frame, 0); + struct pso_pointer readtable = fetch_arg(frame, 1); + struct pso_pointer character = fetch_arg(frame, 2); + struct pso_pointer result = nil; - int base = 10; - // TODO: should check for *read-base* in the environment - int64_t value = 0; + int base = 10; + // TODO: should check for *read-base* in the environment + int64_t value = 0; - if ( readp( stream ) ) { - if ( c_nilp( character ) ) { - character = - read_character( make_frame( 1, frame_pointer, stream ) ); - } - wchar_t c = c_nilp( character ) - ? 0 : pointer_to_object( character )->payload.character.character; + if (readp(stream)) { + if (c_nilp(character)) { + character = read_character(make_frame(1, frame_pointer, stream)); + } + wchar_t c = + c_nilp(character) + ? 0 + : pointer_to_object(character)->payload.character.character; - URL_FILE *input = pointer_to_object( stream )->payload.stream.stream; - for ( ; iswdigit( c ) || c == L','; c = url_fgetwc( input ) ) { - if ( iswdigit( c ) ) { - value = ( value * base ) + ( ( int ) c - ( int ) L'0' ); - } - } + URL_FILE *input = pointer_to_object(stream)->payload.stream.stream; + for (; iswdigit(c) || c == L','; c = url_fgetwc(input)) { + if (iswdigit(c)) { + value = (value * base) + ((int)c - (int)L'0'); + } + } - url_ungetwc( c, input ); - result = make_integer( frame_pointer, value ); - } // else exception? + url_ungetwc(c, input); + result = make_integer(frame_pointer, value); + } // else exception? #ifdef DEBUG - debug_printf( DEBUG_IO, 0, L"\nRead number %ld\n", value ); - debug_dump_object( result, DEBUG_IO, 1 ); + debug_printf(DEBUG_IO, 0, L"\nRead number %ld\n", value); + debug_dump_object(result, DEBUG_IO, 1); #endif - return result; + return result; } -struct pso_pointer read_symbol( struct pso_pointer frame_pointer ) { - struct pso4 *frame = pointer_to_pso4( frame_pointer ); - struct pso_pointer stream = fetch_arg( frame, 0 ); - struct pso_pointer readtable = fetch_arg( frame, 1 ); - struct pso_pointer character = fetch_arg( frame, 2 ); - struct pso_pointer result = nil; +struct pso_pointer read_symbol(struct pso_pointer frame_pointer) { + struct pso4 *frame = pointer_to_pso4(frame_pointer); + struct pso_pointer stream = fetch_arg(frame, 0); + struct pso_pointer readtable = fetch_arg(frame, 1); + struct pso_pointer character = fetch_arg(frame, 2); + struct pso_pointer result = nil; - if ( readp( stream ) ) { - if ( c_nilp( character ) ) { - character = - read_character( make_frame( 1, frame_pointer, stream ) ); - } + if (readp(stream)) { + if (c_nilp(character)) { + character = read_character(make_frame(1, frame_pointer, stream)); + } - wchar_t c = c_nilp( character ) - ? 0 : pointer_to_object( character )->payload.character.character; + wchar_t c = + c_nilp(character) + ? 0 + : pointer_to_object(character)->payload.character.character; - URL_FILE *input = pointer_to_object( stream )->payload.stream.stream; - for ( ; symbol_char_p( c ); c = url_fgetwc( input ) ) { - result = - make_string_like_thing( frame_pointer, c, result, SYMBOLTAG ); - } + URL_FILE *input = pointer_to_object(stream)->payload.stream.stream; + for (; symbol_char_p(c); c = url_fgetwc(input)) { + result = + make_string_like_thing(frame_pointer, c, result, SYMBOLTAG); + } - url_ungetwc( c, input ); - result = c_reverse( frame_pointer, result ); - } + url_ungetwc(c, input); + result = c_reverse(frame_pointer, result); + } #ifdef DEBUG - debug_print( L"\nRead symbol `", DEBUG_IO, 0 ); - debug_print_object( result, DEBUG_IO, 0 ); - debug_print( L"`\n\t", DEBUG_IO, 0 ); - debug_dump_object( result, DEBUG_IO, 1 ); + debug_print(L"\nRead symbol `", DEBUG_IO, 0); + debug_print_object(result, DEBUG_IO, 0); + debug_print(L"`\n\t", DEBUG_IO, 0); + debug_dump_object(result, DEBUG_IO, 1); #endif - return result; + return result; } /** @@ -297,86 +292,85 @@ struct pso_pointer read_symbol( struct pso_pointer frame_pointer ) { * 1. The read table currently in use; * 2. The character most recently read from that stream. */ -struct pso_pointer read( struct pso_pointer frame_pointer ) { - struct pso4 *frame = pointer_to_pso4( frame_pointer ); - struct pso_pointer stream = fetch_arg( frame, 0 ); - struct pso_pointer readtable = fetch_arg( frame, 1 ); - struct pso_pointer character = fetch_arg( frame, 2 ); +struct pso_pointer read(struct pso_pointer frame_pointer) { + struct pso4 *frame = pointer_to_pso4(frame_pointer); + struct pso_pointer stream = fetch_arg(frame, 0); + struct pso_pointer readtable = fetch_arg(frame, 1); + struct pso_pointer character = fetch_arg(frame, 2); - struct pso_pointer result = nil; + struct pso_pointer result = nil; - if ( c_nilp( stream ) ) { - stream = - make_read_stream( frame_pointer, file_to_url_file( stdin ), nil ); - } + if (c_nilp(stream)) { + stream = make_read_stream(frame_pointer, file_to_url_file(stdin), nil); + } - if ( c_nilp( readtable ) ) { - readtable = c_assoc( lisp_io_read_table, fetch_env( frame_pointer ) ); - } + if (c_nilp(readtable)) { + readtable = c_assoc(lisp_io_read_table, fetch_env(frame_pointer)); + } - if ( c_nilp( character ) ) { - character = skip_whitespace( make_frame( 1, frame_pointer, stream ) ); - } + if (c_nilp(character)) { + character = skip_whitespace(make_frame(1, frame_pointer, stream)); + } - struct pso_pointer readmacro = c_assoc( character, readtable ); + struct pso_pointer readmacro = c_assoc(character, readtable); - if ( !c_nilp( readmacro ) ) { - // invoke the read macro on the stream - } else if ( readp( stream ) && characterp( character ) ) { - wchar_t c = - pointer_to_object( character )->payload.character.character; - URL_FILE *input = pointer_to_object( stream )->payload.stream.stream; + if (!c_nilp(readmacro)) { + // invoke the read macro on the stream + } else if (readp(stream) && characterp(character)) { + wchar_t c = pointer_to_object(character)->payload.character.character; + URL_FILE *input = pointer_to_object(stream)->payload.stream.stream; - switch ( c ) { - case SYNTAX_SEMICOLON: - 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 SYNTAX_LPAR: - result = - read_list( make_frame( 3, stream, readtable, character ) ); - break; - case EOF: - result = make_eof_exception( frame_pointer ); - break; - default: - struct pso_pointer next = make_frame( 3, frame_pointer, stream, - readtable, - make_character - ( frame_pointer, c ) ); - inc_ref( next ); - if ( iswdigit( c ) ) { - result = push_local( frame_pointer, read_number( next ) ); - } else if ( symbol_char_p( c ) ) { - result = push_local( frame_pointer, read_symbol( next ) ); - } else { - // result = - // throw_exception( - // c_string_to_lisp_symbol( L"read" ), - // make_cons( - // c_string_to_lisp_string - // ( - // L"Unrecognised - // start of - // input - // character" - // ), - // make_string( - // c, NIL ) - // ), - // frame_pointer ); - } -// dec_ref( next ); - break; - } - } + switch (c) { + case SYNTAX_SEMICOLON: + 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 SYNTAX_LPAR: + result = read_list(make_frame(3, frame_pointer, stream, readtable, character)); + break; + case EOF: + result = make_eof_exception(frame_pointer); + break; + default: + struct pso_pointer next = + make_frame(3, frame_pointer, stream, readtable, + make_character(frame_pointer, c)); + inc_ref(next); + if (iswdigit(c)) { + result = push_local(frame_pointer, read_number(next)); + } else if (symbol_char_p(c)) { + result = push_local(frame_pointer, read_symbol(next)); + } else { + // result = + // throw_exception( + // c_string_to_lisp_symbol( L"read" + // ), + // make_cons( + // c_string_to_lisp_string + // ( + // L"Unrecognised + // start + // of + // input + // character" + // ), + // make_string( + // c, NIL + // ) + // ), + // frame_pointer ); + } + // dec_ref( next ); + break; + } + } #ifdef DEBUG - debug_print( L"Read expression: `", DEBUG_IO, 0 ); - debug_print_object( result, DEBUG_IO, 0 ); - debug_print( L"`\n", DEBUG_IO, 0 ); - debug_dump_object( result, DEBUG_IO, 1 ); + debug_print(L"Read expression: `", DEBUG_IO, 0); + debug_print_object(result, DEBUG_IO, 0); + debug_print(L"`\n", DEBUG_IO, 0); + debug_dump_object(result, DEBUG_IO, 1); #endif - return result; + return result; } diff --git a/src/c/memory/dump.c b/src/c/memory/dump.c index b4c1fd6..b86f011 100644 --- a/src/c/memory/dump.c +++ b/src/c/memory/dump.c @@ -197,7 +197,9 @@ struct pso_pointer dump_object( struct pso_pointer frame_pointer ) { // url_fputws( L"\n", output ); // fflush(stderr); - URL_FILE *output = pointer_to_object( stream )->payload.stream.stream; + URL_FILE *output = writep(stream) ? + pointer_to_object( stream )->payload.stream.stream : + file_to_url_file(stderr); if ( c_nilp( pointer ) ) { // the object at (node, 0, 0) ought to have been initialised, but may not @@ -214,6 +216,10 @@ struct pso_pointer dump_object( struct pso_pointer frame_pointer ) { pointer.offset, object->header.count ); switch ( get_tag_value( pointer ) ) { + case CHARACTERTV: { + wchar_t wc = pointer_to_object(pointer)->payload.character.character; + url_fwprintf(output, L"\t\tCharacter object: character `%lc` (%d)\n", wc, wc); + } break; case CONSTV: url_fwprintf( output, L"\t\tCons object: car at page %d offset %d, cdr at page %d "