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,13 +85,14 @@ 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_object( result, 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 );
|
||||
|
||||
environment_initialised = true;
|
||||
debug_print(L"Environment after binding `t`: ", DEBUG_BOOTSTRAP, 0);
|
||||
debug_print_object( result, DEBUG_BOOTSTRAP, 0);
|
||||
debug_print( L"Environment after binding `t`: ", DEBUG_BOOTSTRAP, 0 );
|
||||
debug_print_object( result, DEBUG_BOOTSTRAP, 0 );
|
||||
|
||||
debug_print( L"\nEnvironment initialised successfully.\n",
|
||||
DEBUG_BOOTSTRAP, 0 );
|
||||
|
|
|
|||
389
src/c/io/io.c
389
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.
|
||||
|
|
@ -87,10 +111,10 @@ wint_t ungotten = 0;
|
|||
* @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) {
|
||||
if ( result != NULL ) {
|
||||
result->type = CFTYPE_FILE, result->handle.file = f;
|
||||
}
|
||||
|
||||
|
|
@ -102,52 +126,73 @@ URL_FILE *file_to_url_file(FILE *f) {
|
|||
*
|
||||
* @return 0 on success; any other value means failure.
|
||||
*/
|
||||
int initialise_io() {
|
||||
int result = curl_global_init(CURL_GLOBAL_SSL);
|
||||
int initialise_io( ) {
|
||||
int result = curl_global_init( CURL_GLOBAL_SSL );
|
||||
|
||||
io_share = curl_share_init();
|
||||
io_share = curl_share_init( );
|
||||
|
||||
if (result == 0) {
|
||||
curl_share_setopt(io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_CONNECT);
|
||||
curl_share_setopt(io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_COOKIE);
|
||||
curl_share_setopt(io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_DNS);
|
||||
curl_share_setopt(io_share, CURLSHOPT_SHARE,
|
||||
CURL_LOCK_DATA_SSL_SESSION);
|
||||
curl_share_setopt(io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_PSL);
|
||||
if ( result == 0 ) {
|
||||
curl_share_setopt( io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_CONNECT );
|
||||
curl_share_setopt( io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_COOKIE );
|
||||
curl_share_setopt( io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_DNS );
|
||||
curl_share_setopt( io_share, CURLSHOPT_SHARE,
|
||||
CURL_LOCK_DATA_SSL_SESSION );
|
||||
curl_share_setopt( io_share, CURLSHOPT_SHARE, CURL_LOCK_DATA_PSL );
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
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);
|
||||
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_object(env, 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);
|
||||
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_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 ) ) {
|
||||
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);
|
||||
debug_print_object(env, 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;
|
||||
}
|
||||
|
|
@ -161,32 +206,32 @@ struct pso_pointer initialise_default_streams(struct pso_pointer env) {
|
|||
* @param s the lisp string or symbol;
|
||||
* @return the c string.
|
||||
*/
|
||||
char *lisp_string_to_c_string(struct pso_pointer s) {
|
||||
char *lisp_string_to_c_string( struct pso_pointer s ) {
|
||||
char *result = NULL;
|
||||
|
||||
if (stringp(s) || symbolp(s)) {
|
||||
if ( stringp( s ) || symbolp( s ) ) {
|
||||
int len = 0;
|
||||
|
||||
for (struct pso_pointer c = s; !nilp(c); c = c_cdr(c)) {
|
||||
for ( struct pso_pointer c = s; !nilp( c ); c = c_cdr( c ) ) {
|
||||
len++;
|
||||
}
|
||||
|
||||
wchar_t *buffer = calloc(len + 1, sizeof(wchar_t));
|
||||
wchar_t *buffer = calloc( len + 1, sizeof( wchar_t ) );
|
||||
/* worst case, one wide char = four utf bytes */
|
||||
result = calloc((len * 4) + 1, sizeof(char));
|
||||
result = calloc( ( len * 4 ) + 1, sizeof( char ) );
|
||||
|
||||
int i = 0;
|
||||
for (struct pso_pointer c = s; !nilp(c); c = c_cdr(c)) {
|
||||
buffer[i++] = pointer_to_object(c)->payload.string.character;
|
||||
for ( struct pso_pointer c = s; !nilp( c ); c = c_cdr( c ) ) {
|
||||
buffer[i++] = pointer_to_object( c )->payload.string.character;
|
||||
}
|
||||
|
||||
wcstombs(result, buffer, len);
|
||||
free(buffer);
|
||||
wcstombs( result, buffer, len );
|
||||
free( buffer );
|
||||
}
|
||||
|
||||
debug_print(L"lisp_string_to_c_string( ", DEBUG_IO, 0);
|
||||
debug_print_object(s, DEBUG_IO, 0);
|
||||
debug_printf(DEBUG_IO, 0, L") => '%s'\n", result);
|
||||
debug_print( L"lisp_string_to_c_string( ", DEBUG_IO, 0 );
|
||||
debug_print_object( s, DEBUG_IO, 0 );
|
||||
debug_printf( DEBUG_IO, 0, L") => '%s'\n", result );
|
||||
|
||||
return result;
|
||||
}
|
||||
|
|
@ -197,35 +242,37 @@ char *lisp_string_to_c_string(struct pso_pointer s) {
|
|||
* @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 url_fgetwc( URL_FILE *input ) {
|
||||
wint_t result = -1;
|
||||
|
||||
if (ungotten != 0) {
|
||||
if ( ungotten != 0 ) {
|
||||
/* TODO: not thread safe */
|
||||
result = ungotten;
|
||||
ungotten = 0;
|
||||
} else {
|
||||
switch (input->type) {
|
||||
switch ( input->type ) {
|
||||
case CFTYPE_FILE:
|
||||
fwide(input->handle.file, 1); /* wide characters */
|
||||
result = fgetwc(input->handle.file); /* passthrough */
|
||||
fwide( input->handle.file, 1 ); /* wide characters */
|
||||
result = fgetwc( input->handle.file ); /* passthrough */
|
||||
break;
|
||||
|
||||
case CFTYPE_CURL: {
|
||||
char *cbuff = calloc(sizeof(wchar_t) + 2, sizeof(char));
|
||||
wchar_t *wbuff = calloc(2, sizeof(wchar_t));
|
||||
case CFTYPE_CURL:{
|
||||
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);
|
||||
url_fgets(cbuff, 2, input);
|
||||
debug_print(L"url_fgetwc: back from url_fgets\n", DEBUG_IO, 0);
|
||||
int c = (int)cbuff[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 );
|
||||
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);
|
||||
cbuff, c, c & 0xf7 );
|
||||
/* The value of each individual byte indicates its UTF-8 function,
|
||||
* as follows:
|
||||
*
|
||||
|
|
@ -236,46 +283,45 @@ wint_t url_fgetwc(URL_FILE *input) {
|
|||
* sequence. F0 to FF hex (240 to 255): first byte of a four-byte
|
||||
* sequence.
|
||||
*/
|
||||
if (c <= 0xf7) {
|
||||
if ( c <= 0xf7 ) {
|
||||
count = 1;
|
||||
} else if (c >= 0xc2 && c <= 0xdf) {
|
||||
} else if ( c >= 0xc2 && c <= 0xdf ) {
|
||||
count = 2;
|
||||
} else if (c >= 0xe0 && c <= 0xef) {
|
||||
} else if ( c >= 0xe0 && c <= 0xef ) {
|
||||
count = 3;
|
||||
} else if (c >= 0xf0 && c <= 0xff) {
|
||||
} else if ( c >= 0xf0 && c <= 0xff ) {
|
||||
count = 4;
|
||||
}
|
||||
|
||||
if (count > 1) {
|
||||
url_fgets((char *)&cbuff[1], count, 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);
|
||||
free(cbuff);
|
||||
free( wbuff );
|
||||
free( cbuff );
|
||||
} break;
|
||||
case CFTYPE_NONE:
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
debug_printf(DEBUG_IO, 0, L"url_fgetwc returning %d (%C)\n", result,
|
||||
result);
|
||||
debug_printf( DEBUG_IO, 0, L"url_fgetwc returning %d (%C)\n", result,
|
||||
result );
|
||||
return result;
|
||||
}
|
||||
|
||||
wint_t url_ungetwc(wint_t wc, URL_FILE *input) {
|
||||
wint_t url_ungetwc( wint_t wc, URL_FILE *input ) {
|
||||
wint_t result = -1;
|
||||
|
||||
switch (input->type) {
|
||||
switch ( input->type ) {
|
||||
case CFTYPE_FILE:
|
||||
fwide(input->handle.file, 1); /* wide characters */
|
||||
result = ungetwc(wc, input->handle.file); /* passthrough */
|
||||
fwide( input->handle.file, 1 ); /* wide characters */
|
||||
result = ungetwc( wc, input->handle.file ); /* passthrough */
|
||||
break;
|
||||
|
||||
case CFTYPE_CURL: {
|
||||
case CFTYPE_CURL:{
|
||||
ungotten = wc;
|
||||
break;
|
||||
case CFTYPE_NONE:
|
||||
|
|
@ -294,13 +340,14 @@ wint_t url_ungetwc(wint_t wc, URL_FILE *input) {
|
|||
*
|
||||
* @return a pointer to a character object on success, or `nil` on failure.
|
||||
*/
|
||||
struct pso_pointer get_character(struct pso_pointer read_stream) {
|
||||
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)
|
||||
->payload.stream.stream));
|
||||
if ( readp( read_stream ) ) {
|
||||
result =
|
||||
make_character( url_fgetwc
|
||||
( pointer_to_object_of_size_class( read_stream, 2 )
|
||||
->payload.stream.stream ) );
|
||||
}
|
||||
|
||||
return result;
|
||||
|
|
@ -314,14 +361,16 @@ struct pso_pointer get_character(struct pso_pointer read_stream) {
|
|||
*
|
||||
* @return `t` on success, else `nil`.
|
||||
*/
|
||||
struct pso_pointer push_back_character(struct pso_pointer c,
|
||||
struct pso_pointer r) {
|
||||
struct pso_pointer push_back_character( struct pso_pointer c,
|
||||
struct pso_pointer r ) {
|
||||
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 ( characterp( c ) && readp( r ) ) {
|
||||
if ( url_ungetwc( ( wint_t )
|
||||
( pointer_to_object( c )->payload.character.
|
||||
character ),
|
||||
pointer_to_object( r )->payload.stream.stream ) >=
|
||||
0 ) {
|
||||
result = t;
|
||||
}
|
||||
}
|
||||
|
|
@ -340,14 +389,14 @@ struct pso_pointer push_back_character(struct pso_pointer c,
|
|||
* @param env my environment.
|
||||
* @return T if the stream was successfully closed, else nil.
|
||||
*/
|
||||
struct pso_pointer lisp_close(struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env) {
|
||||
struct pso4 *frame = pointer_to_pso4(frame_pointer);
|
||||
struct pso_pointer lisp_close( struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env ) {
|
||||
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
||||
struct pso_pointer result = nil;
|
||||
|
||||
if (readp(fetch_arg(frame, 0)) || writep(fetch_arg(frame, 0))) {
|
||||
if (url_fclose(pointer_to_object(fetch_arg(frame, 0))
|
||||
->payload.stream.stream) == 0) {
|
||||
if ( readp( fetch_arg( frame, 0 ) ) || writep( fetch_arg( frame, 0 ) ) ) {
|
||||
if ( url_fclose( pointer_to_object( fetch_arg( frame, 0 ) )
|
||||
->payload.stream.stream ) == 0 ) {
|
||||
result = t;
|
||||
}
|
||||
}
|
||||
|
|
@ -355,42 +404,45 @@ struct pso_pointer lisp_close(struct pso_pointer frame_pointer,
|
|||
return result;
|
||||
}
|
||||
|
||||
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)),
|
||||
meta);
|
||||
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 ) ),
|
||||
meta );
|
||||
}
|
||||
|
||||
struct pso_pointer add_meta_string(struct pso_pointer meta, wchar_t *key,
|
||||
char *value) {
|
||||
value = trim(value);
|
||||
wchar_t buffer[strlen(value) + 1];
|
||||
mbstowcs(buffer, value, strlen(value) + 1);
|
||||
struct pso_pointer add_meta_string( struct pso_pointer meta, wchar_t *key,
|
||||
char *value ) {
|
||||
value = trim( value );
|
||||
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,
|
||||
time_t *value) {
|
||||
struct pso_pointer add_meta_time( struct pso_pointer meta, wchar_t *key,
|
||||
time_t *value ) {
|
||||
/* I don't yet have a concept of a date-time object, which is a
|
||||
* bit of an oversight! */
|
||||
char datestring[256];
|
||||
|
||||
strftime(datestring, sizeof(datestring), nl_langinfo(D_T_FMT),
|
||||
localtime(value));
|
||||
strftime( datestring, sizeof( datestring ), nl_langinfo( D_T_FMT ),
|
||||
localtime( value ) );
|
||||
|
||||
return add_meta_string(meta, key, datestring);
|
||||
return add_meta_string( meta, key, datestring );
|
||||
}
|
||||
|
||||
/**
|
||||
* Callback to assemble metadata for a URL stream. This is naughty because
|
||||
* it modifies data, but it's really the only way to create metadata.
|
||||
*/
|
||||
static size_t write_meta_callback(char *string, size_t size, size_t nmemb,
|
||||
struct pso_pointer stream) {
|
||||
struct pso2 *cell = pointer_to_object(stream);
|
||||
static size_t write_meta_callback( char *string, size_t size, size_t nmemb,
|
||||
struct pso_pointer stream ) {
|
||||
struct pso2 *cell = pointer_to_object( stream );
|
||||
|
||||
// TODO: reimplement
|
||||
|
||||
|
|
@ -448,43 +500,45 @@ static size_t write_meta_callback(char *string, size_t size, size_t nmemb,
|
|||
return 0; // strlen( string );
|
||||
}
|
||||
|
||||
void collect_meta(struct pso_pointer stream, char *url) {
|
||||
struct pso2 *cell = pointer_to_object(stream);
|
||||
URL_FILE *s = pointer_to_object(stream)->payload.stream.stream;
|
||||
void collect_meta( struct pso_pointer stream, char *url ) {
|
||||
struct pso2 *cell = pointer_to_object( stream );
|
||||
URL_FILE *s = pointer_to_object( stream )->payload.stream.stream;
|
||||
struct pso_pointer meta =
|
||||
add_meta_string(cell->payload.stream.meta, L"url", url);
|
||||
add_meta_string( cell->payload.stream.meta, L"url", url );
|
||||
struct stat statbuf;
|
||||
int result = stat(url, &statbuf);
|
||||
int result = stat( url, &statbuf );
|
||||
struct passwd *pwd;
|
||||
struct group *grp;
|
||||
|
||||
switch (s->type) {
|
||||
switch ( s->type ) {
|
||||
case CFTYPE_NONE:
|
||||
break;
|
||||
case CFTYPE_FILE:
|
||||
if (result == 0) {
|
||||
if ((pwd = getpwuid(statbuf.st_uid)) != NULL) {
|
||||
meta = add_meta_string(meta, L"owner", pwd->pw_name);
|
||||
if ( result == 0 ) {
|
||||
if ( ( pwd = getpwuid( statbuf.st_uid ) ) != NULL ) {
|
||||
meta = add_meta_string( meta, L"owner", pwd->pw_name );
|
||||
} else {
|
||||
meta = add_meta_integer(meta, L"owner", statbuf.st_uid);
|
||||
meta = add_meta_integer( meta, L"owner", statbuf.st_uid );
|
||||
}
|
||||
|
||||
if ((grp = getgrgid(statbuf.st_gid)) != NULL) {
|
||||
meta = add_meta_string(meta, L"group", grp->gr_name);
|
||||
if ( ( grp = getgrgid( statbuf.st_gid ) ) != NULL ) {
|
||||
meta = add_meta_string( meta, L"group", grp->gr_name );
|
||||
} else {
|
||||
meta = add_meta_integer(meta, L"group", statbuf.st_gid);
|
||||
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);
|
||||
meta = add_meta_time( meta, L"modified", &statbuf.st_mtime );
|
||||
}
|
||||
break;
|
||||
case CFTYPE_CURL:
|
||||
curl_easy_setopt(s->handle.curl, CURLOPT_VERBOSE, 1L);
|
||||
curl_easy_setopt(s->handle.curl, CURLOPT_HEADERFUNCTION,
|
||||
write_meta_callback);
|
||||
curl_easy_setopt(s->handle.curl, CURLOPT_HEADERDATA, stream);
|
||||
curl_easy_setopt( s->handle.curl, CURLOPT_VERBOSE, 1L );
|
||||
curl_easy_setopt( s->handle.curl, CURLOPT_HEADERFUNCTION,
|
||||
write_meta_callback );
|
||||
curl_easy_setopt( s->handle.curl, CURLOPT_HEADERDATA, stream );
|
||||
break;
|
||||
}
|
||||
|
||||
|
|
@ -497,11 +551,11 @@ void collect_meta(struct pso_pointer stream, char *url) {
|
|||
* Resutn the current default input, or of `inputp` is false, output stream from
|
||||
* this `env`ironment.
|
||||
*/
|
||||
struct pso_pointer get_default_stream(bool inputp, struct pso_pointer env) {
|
||||
struct pso_pointer get_default_stream( bool inputp, struct pso_pointer env ) {
|
||||
struct pso_pointer result = nil;
|
||||
struct pso_pointer stream_name = inputp ? lisp_io_in : lisp_io_out;
|
||||
|
||||
result = c_assoc(stream_name, env);
|
||||
result = c_assoc( stream_name, env );
|
||||
|
||||
return result;
|
||||
}
|
||||
|
|
@ -510,11 +564,11 @@ struct pso_pointer get_default_stream(bool inputp, struct pso_pointer env) {
|
|||
* @brief if `s` points to either an input or an output stream, return the
|
||||
* URL_FILE pointer underlying that stream, else NULL.
|
||||
*/
|
||||
URL_FILE *stream_get_url_file(struct pso_pointer s) {
|
||||
URL_FILE *stream_get_url_file( struct pso_pointer s ) {
|
||||
URL_FILE *result = NULL;
|
||||
|
||||
if (readp(s) || writep(s)) {
|
||||
struct pso2 *obj = pointer_to_object(s);
|
||||
if ( readp( s ) || writep( s ) ) {
|
||||
struct pso2 *obj = pointer_to_object( s );
|
||||
|
||||
result = obj->payload.stream.stream;
|
||||
}
|
||||
|
|
@ -537,9 +591,9 @@ URL_FILE *stream_get_url_file(struct pso_pointer s) {
|
|||
* @return a string of one character, namely the next available character
|
||||
* on my stream, if any, else nil.
|
||||
*/
|
||||
struct pso_pointer lisp_open(struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env) {
|
||||
struct pso4 *frame = pointer_to_pso4(frame_pointer);
|
||||
struct pso_pointer lisp_open( struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env ) {
|
||||
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
||||
struct pso_pointer result = nil;
|
||||
|
||||
// if ( stringp( fetch_arg( frame, 0) ) ) {
|
||||
|
|
@ -604,15 +658,16 @@ struct pso_pointer lisp_open(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 lisp_read_char(struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env) {
|
||||
struct pso4 *frame = pointer_to_pso4(frame_pointer);
|
||||
struct pso_pointer lisp_read_char( struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env ) {
|
||||
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)) {
|
||||
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;
|
||||
|
|
@ -632,26 +687,26 @@ struct pso_pointer lisp_read_char(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 lisp_slurp(struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env) {
|
||||
struct pso4 *frame = pointer_to_pso4(frame_pointer);
|
||||
struct pso_pointer lisp_slurp( struct pso_pointer frame_pointer,
|
||||
struct pso_pointer env ) {
|
||||
struct pso4 *frame = pointer_to_pso4( frame_pointer );
|
||||
struct pso_pointer result = nil;
|
||||
|
||||
if (readp(fetch_arg(frame, 0))) {
|
||||
URL_FILE *stream = stream_get_url_file(fetch_arg(frame, 0));
|
||||
struct pso_pointer cursor = make_string(url_fgetwc(stream), nil);
|
||||
if ( readp( fetch_arg( frame, 0 ) ) ) {
|
||||
URL_FILE *stream = stream_get_url_file( fetch_arg( frame, 0 ) );
|
||||
struct pso_pointer cursor = make_string( url_fgetwc( stream ), nil );
|
||||
result = cursor;
|
||||
|
||||
for (wint_t c = url_fgetwc(stream); !url_feof(stream) && c != 0;
|
||||
c = url_fgetwc(stream)) {
|
||||
debug_print(L"slurp: cursor is: ", DEBUG_IO, 0);
|
||||
debug_dump_object(cursor, DEBUG_IO, 0);
|
||||
debug_print(L"; result is: ", DEBUG_IO, 0);
|
||||
debug_dump_object(result, DEBUG_IO, 0);
|
||||
debug_println(DEBUG_IO);
|
||||
for ( wint_t c = url_fgetwc( stream ); !url_feof( stream ) && c != 0;
|
||||
c = url_fgetwc( stream ) ) {
|
||||
debug_print( L"slurp: cursor is: ", DEBUG_IO, 0 );
|
||||
debug_dump_object( cursor, DEBUG_IO, 0 );
|
||||
debug_print( L"; result is: ", DEBUG_IO, 0 );
|
||||
debug_dump_object( result, DEBUG_IO, 0 );
|
||||
debug_println( DEBUG_IO );
|
||||
|
||||
struct pso2 *cell = pointer_to_object(cursor);
|
||||
cursor = make_string((wchar_t)c, nil);
|
||||
struct pso2 *cell = pointer_to_object( cursor );
|
||||
cursor = make_string( ( wchar_t ) c, nil );
|
||||
cell->payload.string.cdr = cursor;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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 );
|
||||
|
|
|
|||
|
|
@ -39,53 +39,53 @@
|
|||
|
||||
#include "ops/truth.h"
|
||||
|
||||
struct pso_pointer in_print(struct pso_pointer p, URL_FILE *output);
|
||||
struct pso_pointer in_print( struct pso_pointer p, URL_FILE * output );
|
||||
|
||||
struct pso_pointer print_string_like_thing(struct pso_pointer p,
|
||||
URL_FILE *output) {
|
||||
switch (get_tag_value(p)) {
|
||||
struct pso_pointer print_string_like_thing( struct pso_pointer p,
|
||||
URL_FILE *output ) {
|
||||
switch ( get_tag_value( p ) ) {
|
||||
case KEYTV:
|
||||
url_fputwc(L':', output);
|
||||
url_fputwc( L':', output );
|
||||
break;
|
||||
case STRINGTV:
|
||||
url_fputwc(L'"', output);
|
||||
url_fputwc( L'"', output );
|
||||
break;
|
||||
}
|
||||
|
||||
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);
|
||||
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 );
|
||||
}
|
||||
}
|
||||
|
||||
if (stringp(p)) {
|
||||
url_fputwc(L'"', output);
|
||||
if ( stringp( p ) ) {
|
||||
url_fputwc( L'"', output );
|
||||
}
|
||||
}
|
||||
|
||||
struct pso_pointer print_list_content(struct pso_pointer p, URL_FILE *output) {
|
||||
struct pso_pointer print_list_content( struct pso_pointer p, URL_FILE *output ) {
|
||||
struct pso_pointer result = nil;
|
||||
|
||||
if (consp(p)) {
|
||||
for (; consp(p); p = c_cdr(p)) {
|
||||
struct pso2 *object = pointer_to_object(p);
|
||||
if ( consp( p ) ) {
|
||||
for ( ; consp( p ); p = c_cdr( p ) ) {
|
||||
struct pso2 *object = pointer_to_object( p );
|
||||
|
||||
result = in_print(object->payload.cons.car, output);
|
||||
result = in_print( object->payload.cons.car, output );
|
||||
|
||||
if (exceptionp(result))
|
||||
if ( exceptionp( result ) )
|
||||
break;
|
||||
|
||||
switch (get_tag_value(object->payload.cons.cdr)) {
|
||||
switch ( get_tag_value( object->payload.cons.cdr ) ) {
|
||||
case NILTV:
|
||||
break;
|
||||
case CONSTV:
|
||||
url_fputwc(L' ', output);
|
||||
url_fputwc( L' ', output );
|
||||
break;
|
||||
default:
|
||||
url_fputws(L" . ", output);
|
||||
result = in_print(object->payload.cons.cdr, output);
|
||||
url_fputws( L" . ", output );
|
||||
result = in_print( object->payload.cons.cdr, output );
|
||||
}
|
||||
}
|
||||
} else {
|
||||
|
|
@ -95,41 +95,42 @@ struct pso_pointer print_list_content(struct pso_pointer p, URL_FILE *output) {
|
|||
return result;
|
||||
}
|
||||
|
||||
struct pso_pointer in_print(struct pso_pointer p, URL_FILE *output) {
|
||||
struct pso2 *object = pointer_to_object(p);
|
||||
struct pso_pointer in_print( struct pso_pointer p, URL_FILE *output ) {
|
||||
struct pso2 *object = pointer_to_object( p );
|
||||
struct pso_pointer result = nil;
|
||||
|
||||
if (object != NULL) {
|
||||
uint32_t v = get_tag_value(p);
|
||||
switch (v) {
|
||||
if ( object != NULL ) {
|
||||
uint32_t v = get_tag_value( p );
|
||||
switch ( v ) {
|
||||
case CHARACTERTV:
|
||||
url_fputwc(object->payload.character.character, output);
|
||||
url_fputwc( object->payload.character.character, output );
|
||||
break;
|
||||
case CONSTV:
|
||||
url_fputwc(L'(', output);
|
||||
result = print_list_content(p, output);
|
||||
url_fputwc(L')', output);
|
||||
url_fputwc( L'(', output );
|
||||
result = print_list_content( p, output );
|
||||
url_fputwc( L')', output );
|
||||
break;
|
||||
case INTEGERTV:
|
||||
url_fwprintf(output, L"%d",
|
||||
(int64_t)(object->payload.integer.value));
|
||||
url_fwprintf( output, L"%d",
|
||||
( int64_t ) ( object->payload.integer.value ) );
|
||||
break;
|
||||
case KEYTV:
|
||||
case STRINGTV:
|
||||
case SYMBOLTV:
|
||||
print_string_like_thing(p, output);
|
||||
print_string_like_thing( p, output );
|
||||
break;
|
||||
case NILTV:
|
||||
url_fputws(L"nil", output);
|
||||
url_fputws( L"nil", output );
|
||||
break;
|
||||
case READTV:
|
||||
case WRITETV:
|
||||
url_fwprintf(output, L"<%s stream: ", v == READTV ? "read" : "write");
|
||||
in_print(object->payload.stream.meta, output);
|
||||
url_fputwc(L'>', output);
|
||||
url_fwprintf( output, L"<%s stream: ",
|
||||
v == READTV ? "read" : "write" );
|
||||
in_print( object->payload.stream.meta, output );
|
||||
url_fputwc( L'>', output );
|
||||
break;
|
||||
case TRUETV:
|
||||
url_fputwc(L't', output);
|
||||
url_fputwc( L't', output );
|
||||
break;
|
||||
default:
|
||||
// TODO: return exception
|
||||
|
|
@ -148,18 +149,18 @@ struct pso_pointer in_print(struct pso_pointer p, URL_FILE *output) {
|
|||
* @param stream if a pointer to an open write stream, print to there.
|
||||
* @return struct pso_pointer `nil`, or an exception if some erroe occurred.
|
||||
*/
|
||||
struct pso_pointer c_print(struct pso_pointer p, struct pso_pointer stream) {
|
||||
struct pso_pointer c_print( struct pso_pointer p, struct pso_pointer stream ) {
|
||||
struct pso_pointer result = p;
|
||||
URL_FILE *output = writep(stream)
|
||||
? pointer_to_object(stream)->payload.stream.stream
|
||||
: file_to_url_file(stdout);
|
||||
URL_FILE *output = writep( stream )
|
||||
? pointer_to_object( stream )->payload.stream.stream
|
||||
: file_to_url_file( stdout );
|
||||
|
||||
if (writep(stream)) {
|
||||
inc_ref(stream);
|
||||
if ( writep( stream ) ) {
|
||||
inc_ref( stream );
|
||||
|
||||
result = in_print(p, output);
|
||||
result = in_print( p, output );
|
||||
|
||||
dec_ref(stream);
|
||||
dec_ref( stream );
|
||||
}
|
||||
|
||||
return result;
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
||||
|
|
@ -58,17 +55,19 @@ void c_repl( ) {
|
|||
struct pso_pointer input_stream = c_assoc( lisp_io_in, env );
|
||||
struct pso_pointer output_stream = c_assoc( lisp_io_out, env );
|
||||
|
||||
if (!readp(input_stream)) {
|
||||
debug_print(L"Invalid read stream: ", DEBUG_IO, 0);
|
||||
debug_print_object(input_stream, DEBUG_IO, 0);
|
||||
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);
|
||||
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 );
|
||||
|
||||
|
|
|
|||
|
|
@ -83,9 +83,9 @@ struct pso_pointer make_string_like_thing( wint_t c, struct pso_pointer tail,
|
|||
cell->payload.string.hash = calculate_hash( c, tail );
|
||||
debug_printf( DEBUG_ALLOC, 0,
|
||||
L"Building string-like-thing of type %3.3s: ",
|
||||
cell->header.tag.bytes.mnemonic);
|
||||
debug_print_object(pointer, DEBUG_ALLOC, 0);
|
||||
debug_println(DEBUG_ALLOC);
|
||||
cell->header.tag.bytes.mnemonic );
|
||||
debug_print_object( pointer, DEBUG_ALLOC, 0 );
|
||||
debug_println( DEBUG_ALLOC );
|
||||
} else {
|
||||
// \todo should throw an exception!
|
||||
struct pso2 *tobj = pointer_to_object( tail );
|
||||
|
|
@ -145,7 +145,7 @@ struct pso_pointer c_string_to_lisp_string( wchar_t *string ) {
|
|||
if ( string[i] != '"' ) {
|
||||
result = make_string( string[i], result );
|
||||
} else {
|
||||
result = make_string( L'\\', make_string( string[i], result));
|
||||
result = make_string( L'\\', make_string( string[i], result ) );
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -163,7 +163,7 @@ struct pso_pointer c_string_to_lisp_symbol( wchar_t *symbol ) {
|
|||
for ( int i = wcslen( symbol ) - 1; i >= 0; i-- ) {
|
||||
wchar_t c = towlower( symbol[i] );
|
||||
|
||||
if ( iswalpha( c ) || c == L'-' || c == L'*') {
|
||||
if ( iswalpha( c ) || c == L'-' || c == L'*' ) {
|
||||
result = make_symbol( c, result );
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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