Hot damn! When you see an obvious, stupid bug you created, you can't unsee it!
This commit is contained in:
parent
ca5671f613
commit
02a4bc3e28
8 changed files with 563 additions and 495 deletions
|
|
@ -85,7 +85,8 @@ struct pso_pointer initialise_environment( uint32_t node ) {
|
|||
}
|
||||
if ( !exceptionp( result ) ) {
|
||||
result = c_bind( c_string_to_lisp_symbol( L"nil" ), nil, nil );
|
||||
debug_print(L"Environment after binding `nil`: ", DEBUG_BOOTSTRAP, 0);
|
||||
debug_print( L"Environment after binding `nil`: ", DEBUG_BOOTSTRAP,
|
||||
0 );
|
||||
debug_print_object( result, DEBUG_BOOTSTRAP, 0 );
|
||||
result = c_bind( c_string_to_lisp_symbol( L"t" ), t, result );
|
||||
|
||||
|
|
|
|||
127
src/c/io/io.c
127
src/c/io/io.c
|
|
@ -70,11 +70,35 @@ CURLSH *io_share;
|
|||
* @brief bound to the Lisp symbol representing C_IO_IN in initialisation.
|
||||
*/
|
||||
struct pso_pointer lisp_io_in;
|
||||
|
||||
/**
|
||||
* nasty hack, do not use except in dire emergency: bound to the actual UN*X
|
||||
* stdin at startup.
|
||||
*/
|
||||
struct pso_pointer lisp_stdin;
|
||||
|
||||
/**
|
||||
* @brief bound to the Lisp symbol representing C_IO_OUT in initialisation.
|
||||
*/
|
||||
struct pso_pointer lisp_io_out;
|
||||
|
||||
/**
|
||||
* nasty hack, do not use except in dire emergency: bound to the actual UN*X
|
||||
* stdout at startup.
|
||||
*/
|
||||
struct pso_pointer lisp_stdout;
|
||||
|
||||
/**
|
||||
* @brief bound to the Lisp symbol representing C_IO_log in initialisation.
|
||||
*/
|
||||
struct pso_pointer lisp_io_log;
|
||||
|
||||
/**
|
||||
* nasty hack, do not use except in dire emergency: bound to the actual UN*X
|
||||
* stderr at startup.
|
||||
*/
|
||||
struct pso_pointer lisp_stderr;
|
||||
|
||||
/**
|
||||
* Allow a one-character unget facility. This may not be enough - we may need
|
||||
* to allocate a buffer.
|
||||
|
|
@ -122,31 +146,52 @@ int initialise_io() {
|
|||
struct pso_pointer initialise_default_streams( struct pso_pointer env ) {
|
||||
lisp_io_in = c_string_to_lisp_symbol( C_IO_IN );
|
||||
lisp_io_out = c_string_to_lisp_symbol( C_IO_OUT );
|
||||
lisp_io_log = c_string_to_lisp_symbol( C_IO_LOG );
|
||||
|
||||
debug_print( L"In initialise_default_streams; environment is: ", DEBUG_IO, 0);
|
||||
debug_print( L"In initialise_default_streams; environment is: ", DEBUG_IO,
|
||||
0 );
|
||||
debug_print_object( env, DEBUG_IO, 0 );
|
||||
|
||||
env = c_bind(
|
||||
lisp_io_in,
|
||||
lock_object(make_read_stream(
|
||||
file_to_url_file(stdin),
|
||||
c_cons(c_cons(c_string_to_lisp_keyword(L"url"),
|
||||
c_string_to_lisp_string(L"::system:standard-input")),
|
||||
nil))),
|
||||
env);
|
||||
lisp_stdin = lock_object( make_read_stream( file_to_url_file( stdin ),
|
||||
c_cons( c_cons
|
||||
( c_string_to_lisp_keyword
|
||||
( L"url" ),
|
||||
c_string_to_lisp_string
|
||||
( L"::system:standard-input" ) ),
|
||||
nil ) ) );
|
||||
|
||||
env = c_bind( lisp_io_in, lisp_stdin, env );
|
||||
|
||||
debug_print_object( env, DEBUG_IO, 0 );
|
||||
|
||||
if ( !nilp( env ) && !exceptionp( env ) ) {
|
||||
env = c_bind(lisp_io_out,
|
||||
lock_object(make_write_stream(
|
||||
file_to_url_file(stdout),
|
||||
c_cons(c_cons(c_string_to_lisp_keyword(L"url"),
|
||||
c_string_to_lisp_string(
|
||||
L"::system:standard-output")),
|
||||
nil))),
|
||||
env);
|
||||
lisp_stdout =
|
||||
lock_object( make_write_stream
|
||||
( file_to_url_file( stdout ),
|
||||
c_cons( c_cons
|
||||
( c_string_to_lisp_keyword( L"url" ),
|
||||
c_string_to_lisp_string
|
||||
( L"::system:standard-output" ) ),
|
||||
nil ) ) );
|
||||
|
||||
env = c_bind( lisp_io_out, lisp_stdout, env );
|
||||
}
|
||||
|
||||
debug_print( L"Leaving initialise_default_streams; environment is: ", DEBUG_IO, 0);
|
||||
if ( !nilp( env ) && !exceptionp( env ) ) {
|
||||
lisp_stderr =
|
||||
lock_object( make_write_stream
|
||||
( file_to_url_file( stderr ),
|
||||
c_cons( c_cons
|
||||
( c_string_to_lisp_keyword( L"url" ),
|
||||
c_string_to_lisp_string
|
||||
( L"::system:standard-output" ) ),
|
||||
nil ) ) );
|
||||
|
||||
env = c_bind( lisp_io_log, lisp_stderr, env );
|
||||
}
|
||||
|
||||
debug_print( L"Leaving initialise_default_streams; environment is: ",
|
||||
DEBUG_IO, 0 );
|
||||
debug_print_object( env, DEBUG_IO, 0 );
|
||||
|
||||
return env;
|
||||
|
|
@ -212,18 +257,20 @@ wint_t url_fgetwc(URL_FILE *input) {
|
|||
break;
|
||||
|
||||
case CFTYPE_CURL:{
|
||||
char *cbuff = calloc(sizeof(wchar_t) + 2, sizeof(char));
|
||||
char *cbuff =
|
||||
calloc( sizeof( wchar_t ) + 2, sizeof( char ) );
|
||||
wchar_t *wbuff = calloc( 2, sizeof( wchar_t ) );
|
||||
|
||||
size_t count = 0;
|
||||
|
||||
debug_print(L"url_fgetwc: about to call url_fgets\n", DEBUG_IO, 0);
|
||||
debug_print( L"url_fgetwc: about to call url_fgets\n",
|
||||
DEBUG_IO, 0 );
|
||||
url_fgets( cbuff, 2, input );
|
||||
debug_print(L"url_fgetwc: back from url_fgets\n", DEBUG_IO, 0);
|
||||
debug_print( L"url_fgetwc: back from url_fgets\n",
|
||||
DEBUG_IO, 0 );
|
||||
int c = ( int ) cbuff[0];
|
||||
// TODO: risk of reading off cbuff?
|
||||
debug_printf(
|
||||
DEBUG_IO, 0,
|
||||
debug_printf( DEBUG_IO, 0,
|
||||
L"url_fgetwc: cbuff is '%s'; (first) character = %d (%c)\n",
|
||||
cbuff, c, c & 0xf7 );
|
||||
/* The value of each individual byte indicates its UTF-8 function,
|
||||
|
|
@ -249,8 +296,7 @@ wint_t url_fgetwc(URL_FILE *input) {
|
|||
if ( count > 1 ) {
|
||||
url_fgets( ( char * ) &cbuff[1], count, input );
|
||||
}
|
||||
mbstowcs(wbuff, cbuff,
|
||||
2); //(char *)(&input->buffer[input->buffer_pos]), 1 );
|
||||
mbstowcs( wbuff, cbuff, 2 ); //(char *)(&input->buffer[input->buffer_pos]), 1 );
|
||||
result = wbuff[0];
|
||||
|
||||
free( wbuff );
|
||||
|
|
@ -298,8 +344,9 @@ struct pso_pointer get_character(struct pso_pointer read_stream) {
|
|||
struct pso_pointer result = nil;
|
||||
|
||||
if ( readp( read_stream ) ) {
|
||||
result = make_character(
|
||||
url_fgetwc(pointer_to_object_of_size_class(read_stream, 2)
|
||||
result =
|
||||
make_character( url_fgetwc
|
||||
( pointer_to_object_of_size_class( read_stream, 2 )
|
||||
->payload.stream.stream ) );
|
||||
}
|
||||
|
||||
|
|
@ -319,9 +366,11 @@ struct pso_pointer push_back_character(struct pso_pointer c,
|
|||
struct pso_pointer result = nil;
|
||||
|
||||
if ( characterp( c ) && readp( r ) ) {
|
||||
if (url_ungetwc(
|
||||
(wint_t)(pointer_to_object(c)->payload.character.character),
|
||||
pointer_to_object(r)->payload.stream.stream) >= 0) {
|
||||
if ( url_ungetwc( ( wint_t )
|
||||
( pointer_to_object( c )->payload.character.
|
||||
character ),
|
||||
pointer_to_object( r )->payload.stream.stream ) >=
|
||||
0 ) {
|
||||
result = t;
|
||||
}
|
||||
}
|
||||
|
|
@ -357,7 +406,9 @@ struct pso_pointer lisp_close(struct pso_pointer frame_pointer,
|
|||
|
||||
struct pso_pointer add_meta_integer( struct pso_pointer meta, wchar_t *key,
|
||||
long int value ) {
|
||||
return c_cons(c_cons(c_string_to_lisp_keyword(key), make_integer(value)),
|
||||
return
|
||||
c_cons( c_cons
|
||||
( c_string_to_lisp_keyword( key ), make_integer( value ) ),
|
||||
meta );
|
||||
}
|
||||
|
||||
|
|
@ -367,9 +418,10 @@ struct pso_pointer add_meta_string(struct pso_pointer meta, wchar_t *key,
|
|||
wchar_t buffer[strlen( value ) + 1];
|
||||
mbstowcs( buffer, value, strlen( value ) + 1 );
|
||||
|
||||
return c_cons(
|
||||
c_cons(c_string_to_lisp_keyword(key), c_string_to_lisp_string(buffer)),
|
||||
meta);
|
||||
return
|
||||
c_cons( c_cons
|
||||
( c_string_to_lisp_keyword( key ),
|
||||
c_string_to_lisp_string( buffer ) ), meta );
|
||||
}
|
||||
|
||||
struct pso_pointer add_meta_time( struct pso_pointer meta, wchar_t *key,
|
||||
|
|
@ -475,7 +527,9 @@ void collect_meta(struct pso_pointer stream, char *url) {
|
|||
meta = add_meta_integer( meta, L"group", statbuf.st_gid );
|
||||
}
|
||||
|
||||
meta = add_meta_integer(meta, L"size", (intmax_t)statbuf.st_size);
|
||||
meta =
|
||||
add_meta_integer( meta, L"size",
|
||||
( intmax_t ) statbuf.st_size );
|
||||
|
||||
meta = add_meta_time( meta, L"modified", &statbuf.st_mtime );
|
||||
}
|
||||
|
|
@ -612,7 +666,8 @@ struct pso_pointer lisp_read_char(struct pso_pointer frame_pointer,
|
|||
struct pso_pointer stream_pointer = fetch_arg( frame, 0 );
|
||||
if ( readp( stream_pointer ) ) {
|
||||
result =
|
||||
make_string(url_fgetwc(stream_get_url_file(stream_pointer)), nil);
|
||||
make_string( url_fgetwc( stream_get_url_file( stream_pointer ) ),
|
||||
nil );
|
||||
}
|
||||
|
||||
return result;
|
||||
|
|
|
|||
|
|
@ -23,9 +23,15 @@ struct pso_pointer initialise_default_streams( struct pso_pointer env );
|
|||
|
||||
#define C_IO_IN L"*in*"
|
||||
#define C_IO_OUT L"*out*"
|
||||
#define C_IO_LOG L"*log*"
|
||||
|
||||
extern struct pso_pointer lisp_io_in;
|
||||
extern struct pso_pointer lisp_io_out;
|
||||
extern struct pso_pointer lisp_io_log;
|
||||
|
||||
extern struct pso_pointer lisp_stdin;
|
||||
extern struct pso_pointer lisp_stdout;
|
||||
extern struct pso_pointer lisp_stderr;
|
||||
|
||||
URL_FILE *file_to_url_file( FILE * f );
|
||||
wint_t url_fgetwc( URL_FILE * input );
|
||||
|
|
|
|||
|
|
@ -55,8 +55,8 @@ struct pso_pointer print_string_like_thing(struct pso_pointer p,
|
|||
if ( keywordp( p ) || stringp( p ) || symbolp( p ) ) {
|
||||
for ( struct pso_pointer cursor = p; !nilp( cursor );
|
||||
cursor = pointer_to_object( cursor )->payload.string.cdr ) {
|
||||
url_fputwc(pointer_to_object(cursor)->payload.character.character,
|
||||
output);
|
||||
url_fputwc( pointer_to_object( cursor )->payload.character.
|
||||
character, output );
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -124,7 +124,8 @@ struct pso_pointer in_print(struct pso_pointer p, URL_FILE *output) {
|
|||
break;
|
||||
case READTV:
|
||||
case WRITETV:
|
||||
url_fwprintf(output, L"<%s stream: ", v == READTV ? "read" : "write");
|
||||
url_fwprintf( output, L"<%s stream: ",
|
||||
v == READTV ? "read" : "write" );
|
||||
in_print( object->payload.stream.meta, output );
|
||||
url_fputwc( L'>', output );
|
||||
break;
|
||||
|
|
|
|||
|
|
@ -24,9 +24,6 @@
|
|||
#include "memory/pointer.h"
|
||||
#include "memory/pso.h"
|
||||
#include "memory/pso2.h"
|
||||
#include "memory/pso2.h"
|
||||
#include "memory/pso2.h"
|
||||
#include "memory/pso2.h"
|
||||
#include "memory/pso4.h"
|
||||
#include "memory/tags.h"
|
||||
|
||||
|
|
@ -61,14 +58,16 @@ void c_repl( ) {
|
|||
if ( !readp( input_stream ) ) {
|
||||
debug_print( L"Invalid read stream: ", DEBUG_IO, 0 );
|
||||
debug_print_object( input_stream, DEBUG_IO, 0 );
|
||||
input_stream = lisp_stdin;
|
||||
}
|
||||
if ( !writep( output_stream ) ) {
|
||||
debug_print( L"Invalid write stream: ", DEBUG_IO, 0 );
|
||||
debug_print_object( output_stream, DEBUG_IO, 0 );
|
||||
output_stream = lisp_stdout;
|
||||
}
|
||||
|
||||
while ( readp( input_stream )
|
||||
&& !url_feof( stream_get_url_file( input_stream ) ) ) {
|
||||
while ( readp( input_stream ) &&
|
||||
!url_feof( stream_get_url_file( input_stream ) ) ) {
|
||||
/* bottom of stack */
|
||||
struct pso_pointer frame_pointer = make_frame( 1, nil, input_stream );
|
||||
|
||||
|
|
|
|||
|
|
@ -69,7 +69,7 @@ struct pso_pointer c_car( struct pso_pointer cons ) {
|
|||
*/
|
||||
struct pso_pointer c_cdr( struct pso_pointer p ) {
|
||||
struct pso_pointer result = nil;
|
||||
struct pso2 *object = pointer_to_object( result );
|
||||
struct pso2 *object = pointer_to_object( p );
|
||||
|
||||
switch ( get_tag_value( p ) ) {
|
||||
case CONSTV:
|
||||
|
|
|
|||
14
src/c/psse.c
14
src/c/psse.c
|
|
@ -12,21 +12,23 @@
|
|||
* Licensed under GPL version 2.0, or, at your option, any later version.
|
||||
*/
|
||||
|
||||
#include <signal.h>
|
||||
#include <stdbool.h>
|
||||
#include <stdio.h>
|
||||
#include <wchar.h>
|
||||
#include <signal.h>
|
||||
|
||||
#include "debug.h"
|
||||
#include "psse.h"
|
||||
#include "io/io.h"
|
||||
#include "psse.h"
|
||||
|
||||
#include "io/print.h"
|
||||
#include "memory/node.h"
|
||||
#include "memory/pso.h"
|
||||
#include "memory/tags.h"
|
||||
|
||||
#include "ops/repl.h"
|
||||
#include "ops/stack_ops.h"
|
||||
#include "ops/string_ops.h"
|
||||
#include "ops/truth.h"
|
||||
|
||||
#include "payloads/cons.h"
|
||||
|
|
@ -67,7 +69,6 @@ void print_options( FILE *stream ) {
|
|||
#endif
|
||||
}
|
||||
|
||||
|
||||
/**
|
||||
* main entry point; parse command line arguments, initialise the environment,
|
||||
* and enter the read-eval-print loop.
|
||||
|
|
@ -124,7 +125,12 @@ int main( int argc, char *argv[] ) {
|
|||
exit( 1 );
|
||||
}
|
||||
|
||||
c_repl( );
|
||||
c_print( c_cons( c_string_to_lisp_keyword( L"a" ),
|
||||
( c_cons( c_string_to_lisp_keyword( L"b" ),
|
||||
c_cons( c_string_to_lisp_keyword( L"c" ),
|
||||
nil ) ) ) ), lisp_stdout );
|
||||
|
||||
// c_repl();
|
||||
|
||||
exit( 0 );
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue