diff --git a/src/c/environment/environment.c b/src/c/environment/environment.c index 0fa4e0b..f80adc9 100644 --- a/src/c/environment/environment.c +++ b/src/c/environment/environment.c @@ -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 ); diff --git a/src/c/io/io.c b/src/c/io/io.c index cfeca65..35bd0b1 100644 --- a/src/c/io/io.c +++ b/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,14 +111,14 @@ 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) { - result->type = CFTYPE_FILE, result->handle.file = f; - } + if ( result != NULL ) { + result->type = CFTYPE_FILE, result->handle.file = f; + } - return result; + return result; } /** @@ -102,54 +126,75 @@ 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; + 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); - - debug_print( L"In initialise_default_streams; environment is: ", DEBUG_IO, 0); - debug_print_object(env, DEBUG_IO, 0); +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 ); - 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); - } + debug_print( L"In initialise_default_streams; environment is: ", DEBUG_IO, + 0 ); + debug_print_object( env, DEBUG_IO, 0 ); - debug_print( L"Leaving initialise_default_streams; environment is: ", DEBUG_IO, 0); - debug_print_object(env, DEBUG_IO, 0); + 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 ) ) ); - return env; + 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 ); + } + + 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,34 +206,34 @@ 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 *result = NULL; +char *lisp_string_to_c_string( struct pso_pointer s ) { + char *result = NULL; - if (stringp(s) || symbolp(s)) { - int len = 0; + if ( stringp( s ) || symbolp( s ) ) { + int len = 0; - for (struct pso_pointer c = s; !nilp(c); c = c_cdr(c)) { - len++; - } + for ( struct pso_pointer c = s; !nilp( c ); c = c_cdr( c ) ) { + 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)); + 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 pso_pointer c = s; !nilp(c); c = c_cdr(c)) { - buffer[i++] = pointer_to_object(c)->payload.string.character; - } + int i = 0; + 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; + return result; } /** @@ -197,93 +242,94 @@ 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 result = -1; +wint_t url_fgetwc( URL_FILE *input ) { + wint_t result = -1; - if (ungotten != 0) { - /* TODO: not thread safe */ - result = ungotten; - ungotten = 0; - } else { - switch (input->type) { - case CFTYPE_FILE: - fwide(input->handle.file, 1); /* wide characters */ - result = fgetwc(input->handle.file); /* passthrough */ - break; + if ( ungotten != 0 ) { + /* TODO: not thread safe */ + result = ungotten; + ungotten = 0; + } else { + switch ( input->type ) { + case CFTYPE_FILE: + 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; + 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]; - // TODO: risk of reading off cbuff? - 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, - * 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 <= 0xf7) { - 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; - } + 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, + 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, + * 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 <= 0xf7 ) { + 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; + } - if (count > 1) { - url_fgets((char *)&cbuff[1], count, input); - } - mbstowcs(wbuff, cbuff, - 2); //(char *)(&input->buffer[input->buffer_pos]), 1 ); - result = wbuff[0]; + if ( count > 1 ) { + url_fgets( ( char * ) &cbuff[1], count, input ); + } + mbstowcs( wbuff, cbuff, 2 ); //(char *)(&input->buffer[input->buffer_pos]), 1 ); + result = wbuff[0]; - free(wbuff); - free(cbuff); - } break; - case CFTYPE_NONE: - break; - } - } + free( wbuff ); + free( cbuff ); + } break; + case CFTYPE_NONE: + break; + } + } - debug_printf(DEBUG_IO, 0, L"url_fgetwc returning %d (%C)\n", result, - result); - return 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 result = -1; +wint_t url_ungetwc( wint_t wc, URL_FILE *input ) { + wint_t result = -1; - switch (input->type) { - case CFTYPE_FILE: - fwide(input->handle.file, 1); /* wide characters */ - result = ungetwc(wc, input->handle.file); /* passthrough */ - break; + switch ( input->type ) { + case CFTYPE_FILE: + fwide( input->handle.file, 1 ); /* wide characters */ + result = ungetwc( wc, input->handle.file ); /* passthrough */ + break; - case CFTYPE_CURL: { - ungotten = wc; - break; - case CFTYPE_NONE: - break; - } - } + case CFTYPE_CURL:{ + ungotten = wc; + break; + case CFTYPE_NONE: + break; + } + } - return result; + return result; } /** @@ -294,16 +340,17 @@ 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 result = nil; +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; + return result; } /** @@ -314,18 +361,20 @@ 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 result = nil; +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) { - result = t; - } - } - return result; + 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; + } + } + return result; } /** @@ -340,186 +389,191 @@ 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 result = 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 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) { - result = t; - } - } + 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; + } + } - return result; + 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) { - /* I don't yet have a concept of a date-time object, which is a - * bit of an oversight! */ - char datestring[256]; +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 + // TODO: reimplement - /* make a copy of the string that we can destructively change */ - // char *s = calloc( strlen( string ), sizeof( char ) ); + /* make a copy of the string that we can destructively change */ + // char *s = calloc( strlen( string ), sizeof( char ) ); - // strcpy( s, string ); + // strcpy( s, string ); - // if ( check_tag( cell, READTV) || - // check_tag( cell, WRITETV) ) { - // int offset = index_of( ':', s ); + // if ( check_tag( cell, READTV) || + // check_tag( cell, WRITETV) ) { + // int offset = index_of( ':', s ); - // if ( offset != -1 ) { - // s[offset] = ( char ) 0; - // char *name = trim( s ); - // char *value = trim( &s[++offset] ); - // wchar_t wname[strlen( name )]; + // if ( offset != -1 ) { + // s[offset] = ( char ) 0; + // char *name = trim( s ); + // char *value = trim( &s[++offset] ); + // wchar_t wname[strlen( name )]; - // mbstowcs( wname, name, strlen( name ) + 1 ); + // mbstowcs( wname, name, strlen( name ) + 1 ); - // cell->payload.stream.meta = - // add_meta_string( cell->payload.stream.meta, wname, value ); + // cell->payload.stream.meta = + // add_meta_string( cell->payload.stream.meta, wname, value ); - // debug_printf( DEBUG_IO, - // L"write_meta_callback: added header '%s': value - // '%s'\n", name, value ); - // } else if ( strncmp( "HTTP", s, 4 ) == 0 ) { - // int offset = index_of( ' ', s ); - // char *value = trim( &s[offset] ); + // debug_printf( DEBUG_IO, + // L"write_meta_callback: added header '%s': value + // '%s'\n", name, value ); + // } else if ( strncmp( "HTTP", s, 4 ) == 0 ) { + // int offset = index_of( ' ', s ); + // char *value = trim( &s[offset] ); - // cell->payload.stream.meta = - // add_meta_integer( add_meta_string - // ( cell->payload.stream.meta, L"status", - // value ), L"status-code", strtol( value, - // NULL, - // 10 ) ); + // cell->payload.stream.meta = + // add_meta_integer( add_meta_string + // ( cell->payload.stream.meta, L"status", + // value ), L"status-code", strtol( value, + // NULL, + // 10 ) ); - // debug_printf( DEBUG_IO, - // L"write_meta_callback: added header 'status': value - // '%s'\n", value ); - // } else { - // debug_printf( DEBUG_IO, - // L"write_meta_callback: header passed with no colon: - // '%s'\n", s ); - // } - // } else { - // debug_print - // ( L"Pointer passed to write_meta_callback did not point to a - // stream: ", - // DEBUG_IO ); - // debug_dump_object( stream, DEBUG_IO ); - // } + // debug_printf( DEBUG_IO, + // L"write_meta_callback: added header 'status': value + // '%s'\n", value ); + // } else { + // debug_printf( DEBUG_IO, + // L"write_meta_callback: header passed with no colon: + // '%s'\n", s ); + // } + // } else { + // debug_print + // ( L"Pointer passed to write_meta_callback did not point to a + // stream: ", + // DEBUG_IO ); + // debug_dump_object( stream, DEBUG_IO ); + // } - // free( s ); - return 0; // strlen( string ); + // free( s ); + 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; - struct pso_pointer meta = - add_meta_string(cell->payload.stream.meta, L"url", url); - struct stat statbuf; - int result = stat(url, &statbuf); - struct passwd *pwd; - struct group *grp; +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 ); + struct stat statbuf; + int result = stat( url, &statbuf ); + struct passwd *pwd; + struct group *grp; - 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); - } else { - meta = add_meta_integer(meta, L"owner", statbuf.st_uid); - } + 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 ); + } else { + 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); - } else { - meta = add_meta_integer(meta, L"group", statbuf.st_gid); - } + 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"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); - } - 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); - break; - } + 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 ); + break; + } - /* this is destructive change before the cell is released into the - * wild, and consequently permissible, just. */ - cell->payload.stream.meta = meta; + /* this is destructive change before the cell is released into the + * wild, and consequently permissible, just. */ + cell->payload.stream.meta = meta; } /** * 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 result = nil; - struct pso_pointer stream_name = inputp ? lisp_io_in : lisp_io_out; +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; + return result; } /** * @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 *result = NULL; +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; - } + result = obj->payload.stream.stream; + } - return result; + return result; } /** @@ -537,59 +591,59 @@ 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 result = 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 result = nil; - // if ( stringp( fetch_arg( frame, 0) ) ) { - // char *url = lisp_string_to_c_string( fetch_arg( frame, 0) ); + // if ( stringp( fetch_arg( frame, 0) ) ) { + // char *url = lisp_string_to_c_string( fetch_arg( frame, 0) ); - // if ( nilp( fetch_arg( frame, 1) ) ) { - // URL_FILE *stream = url_fopen( url, "r" ); + // if ( nilp( fetch_arg( frame, 1) ) ) { + // URL_FILE *stream = url_fopen( url, "r" ); - // debug_printf( DEBUG_IO, 0, - // L"lisp_open: stream @ %ld, stream type = %d, stream - // handle = %ld\n", ( long int ) &stream, ( int ) - // stream->type, ( long int ) stream->handle.file ); + // debug_printf( DEBUG_IO, 0, + // L"lisp_open: stream @ %ld, stream type = %d, stream + // handle = %ld\n", ( long int ) &stream, ( int ) + // stream->type, ( long int ) stream->handle.file ); - // switch ( stream->type ) { - // case CFTYPE_NONE: - // return - // make_exception( c_string_to_lisp_string - // ( L"Could not open stream" ), - // frame_pointer , nil ); - // break; - // case CFTYPE_FILE: - // if ( stream->handle.file == NULL ) { - // return - // make_exception( c_string_to_lisp_string - // ( L"Could not open file" ), - // frame_pointer , nil); - // } - // break; - // case CFTYPE_CURL: - // /* can't tell whether a URL is bad without reading it */ - // break; - // } + // switch ( stream->type ) { + // case CFTYPE_NONE: + // return + // make_exception( c_string_to_lisp_string + // ( L"Could not open stream" ), + // frame_pointer , nil ); + // break; + // case CFTYPE_FILE: + // if ( stream->handle.file == NULL ) { + // return + // make_exception( c_string_to_lisp_string + // ( L"Could not open file" ), + // frame_pointer , nil); + // } + // break; + // case CFTYPE_CURL: + // /* can't tell whether a URL is bad without reading it */ + // break; + // } - // result = make_read_stream( stream, nil ); - // } else { - // // TODO: anything more complex is a problem for another day. - // URL_FILE *stream = url_fopen( url, "w" ); - // result = make_write_stream( stream, nil ); - // } + // result = make_read_stream( stream, nil ); + // } else { + // // TODO: anything more complex is a problem for another day. + // URL_FILE *stream = url_fopen( url, "w" ); + // result = make_write_stream( stream, nil ); + // } - // if ( pointer_to_object( result )->payload.stream.stream == NULL ) { - // result = nil; - // } else { - // collect_meta( result, url ); - // } + // if ( pointer_to_object( result )->payload.stream.stream == NULL ) { + // result = nil; + // } else { + // collect_meta( result, url ); + // } - // free( url ); - // } + // free( url ); + // } - return result; + return result; } /** @@ -604,18 +658,19 @@ 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 result = 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 result = nil; - 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); - } + 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 ); + } - return result; + return result; } /** @@ -632,29 +687,29 @@ 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 result = 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 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); - result = cursor; + 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); - cell->payload.string.cdr = cursor; - } - } + struct pso2 *cell = pointer_to_object( cursor ); + cursor = make_string( ( wchar_t ) c, nil ); + cell->payload.string.cdr = cursor; + } + } - return result; + return result; } diff --git a/src/c/io/io.h b/src/c/io/io.h index 995f508..7b04d75 100644 --- a/src/c/io/io.h +++ b/src/c/io/io.h @@ -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 ); diff --git a/src/c/io/print.c b/src/c/io/print.c index da89685..f65d9aa 100644 --- a/src/c/io/print.c +++ b/src/c/io/print.c @@ -39,106 +39,107 @@ #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)) { - case KEYTV: - url_fputwc(L':', output); - break; - case STRINGTV: - url_fputwc(L'"', output); - break; - } +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 ); + break; + case STRINGTV: + 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 result = nil; +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)) - break; + if ( exceptionp( result ) ) + break; - switch (get_tag_value(object->payload.cons.cdr)) { - case NILTV: - break; - case CONSTV: - url_fputwc(L' ', output); - break; - default: - url_fputws(L" . ", output); - result = in_print(object->payload.cons.cdr, output); - } - } - } else { - // TODO: return exception - } + switch ( get_tag_value( object->payload.cons.cdr ) ) { + case NILTV: + break; + case CONSTV: + url_fputwc( L' ', output ); + break; + default: + url_fputws( L" . ", output ); + result = in_print( object->payload.cons.cdr, output ); + } + } + } else { + // TODO: return exception + } - return result; + return result; } -struct pso_pointer in_print(struct pso_pointer p, URL_FILE *output) { - struct pso2 *object = pointer_to_object(p); - struct pso_pointer result = nil; +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) { - case CHARACTERTV: - url_fputwc(object->payload.character.character, output); - break; - case CONSTV: - 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)); - break; - case KEYTV: - case STRINGTV: - case SYMBOLTV: - print_string_like_thing(p, output); - break; - case NILTV: - 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); - break; - case TRUETV: - url_fputwc(L't', output); - break; - default: - // TODO: return exception - } - } else { - // TODO: return exception - } + if ( object != NULL ) { + uint32_t v = get_tag_value( p ); + switch ( v ) { + case CHARACTERTV: + url_fputwc( object->payload.character.character, output ); + break; + case CONSTV: + 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 ) ); + break; + case KEYTV: + case STRINGTV: + case SYMBOLTV: + print_string_like_thing( p, output ); + break; + case NILTV: + 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 ); + break; + case TRUETV: + url_fputwc( L't', output ); + break; + default: + // TODO: return exception + } + } else { + // TODO: return exception + } - return result; + return result; } /** @@ -148,19 +149,19 @@ 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 result = p; - URL_FILE *output = writep(stream) - ? pointer_to_object(stream)->payload.stream.stream - : file_to_url_file(stdout); +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 ); - 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; + return result; } diff --git a/src/c/ops/repl.c b/src/c/ops/repl.c index 2bd0c44..09e34aa 100644 --- a/src/c/ops/repl.c +++ b/src/c/ops/repl.c @@ -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" @@ -57,18 +54,20 @@ void c_repl( ) { struct pso_pointer env = consp( oblist ) ? oblist : c_cons( oblist, nil ); 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 (!writep(output_stream)) { - debug_print(L"Invalid write stream: ", DEBUG_IO, 0); - debug_print_object(output_stream, DEBUG_IO, 0); - } - while ( readp( input_stream ) - && !url_feof( stream_get_url_file( input_stream ) ) ) { + 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 ) ) ) { /* bottom of stack */ struct pso_pointer frame_pointer = make_frame( 1, nil, input_stream ); diff --git a/src/c/ops/string_ops.c b/src/c/ops/string_ops.c index f565234..18c8d55 100644 --- a/src/c/ops/string_ops.c +++ b/src/c/ops/string_ops.c @@ -81,11 +81,11 @@ struct pso_pointer make_string_like_thing( wint_t c, struct pso_pointer tail, cell->payload.string.cdr = 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); + 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 ); } else { // \todo should throw an exception! struct pso2 *tobj = pointer_to_object( tail ); @@ -94,7 +94,7 @@ struct pso_pointer make_string_like_thing( wint_t c, struct pso_pointer tail, tag, tobj->header.tag.bytes.mnemonic ); } - + return pointer; } @@ -145,8 +145,8 @@ 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 ) ); + } } return 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 ); } } diff --git a/src/c/payloads/cons.c b/src/c/payloads/cons.c index 20e5284..0df03b5 100644 --- a/src/c/payloads/cons.c +++ b/src/c/payloads/cons.c @@ -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: diff --git a/src/c/psse.c b/src/c/psse.c index cd9b092..e49d614 100644 --- a/src/c/psse.c +++ b/src/c/psse.c @@ -12,21 +12,23 @@ * Licensed under GPL version 2.0, or, at your option, any later version. */ +#include #include #include #include -#include #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" @@ -39,7 +41,7 @@ void print_banner( ) { /** * Print command line options to this `stream`. - * + * * @stream the stream to print to. */ void print_options( FILE *stream ) { @@ -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 ); }