simon/post-scarcity
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Tactical commit whilst converting to URL_FILE

Browse source
This commit is contained in:
Simon Brooke 2019-01-24 18:59:01 +00:00
parent f8c20ab3b1
commit a355a28ffa
23 changed files with 700 additions and 88 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
.gitignore vendored
View file

@ -32,3 +32,5 @@ log*
utils_src/readprintwc/out
*.dump
*.bak

2
Makefile
View file

@ -16,7 +16,7 @@ INDENT_FLAGS := -nbad -bap -nbc -br -brf -brs -c33 -cd33 -ncdb -ce -ci4 -cli4 \
-npsl -nsc -nsob -nss -nut -prs -l79 -ts2
CPPFLAGS ?= $(INC_FLAGS) -MMD -MP -g -DDEBUG
LDFLAGS := -lm
LDFLAGS := -lm -lcurl
all: $(TARGET)

10
src/arith/integer.c
View file

@ -314,7 +314,6 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
*/
struct cons_pointer integer_to_string_add_digit( int digit, int digits,
struct cons_pointer tail ) {
digits++;
wint_t character = btowc( hex_digits[digit] );
return ( digits % 3 == 0 ) ?
make_string( L',', make_string( character,
@ -352,10 +351,7 @@ struct cons_pointer integer_to_string( struct cons_pointer int_pointer,
while ( accumulator > 0 || !nilp( integer.payload.integer.more ) ) {
if ( !nilp( integer.payload.integer.more ) ) {
integer = pointer2cell( integer.payload.integer.more );
accumulator += integer.payload.integer.value == 0 ?
MAX_INTEGER :
( llabs( integer.payload.integer.value ) *
( MAX_INTEGER + 1 ) );
accumulator += integer.payload.integer.value;
debug_print
( L"integer_to_string: crossing cell boundary, accumulator is: ",
DEBUG_IO );
@ -369,10 +365,12 @@ struct cons_pointer integer_to_string( struct cons_pointer int_pointer,
L"integer_to_string: digit is %ld, hexadecimal is %c, accumulator is: ",
offset, hex_digits[offset] );
debug_print_128bit( accumulator, DEBUG_IO );
debug_print( L"; result is: ", DEBUG_IO);
debug_print_object( result, DEBUG_IO);
debug_println( DEBUG_IO );
result =
integer_to_string_add_digit( offset, digits++, result );
integer_to_string_add_digit( offset, ++digits, result );
accumulator = accumulator / base;
} while ( accumulator > base );
}

15
src/init.c
View file

@ -9,6 +9,7 @@
* Licensed under GPL version 2.0, or, at your option, any later version.
*/
#include <locale.h>
#include <stdbool.h>
#include <stdio.h>
#include <stdlib.h>
@ -81,6 +82,8 @@ int main( int argc, char *argv[] ) {
bool dump_at_end = false;
bool show_prompt = false;
setlocale(LC_ALL, "");
while ( ( option = getopt( argc, argv, "cpdv:" ) ) != -1 ) {
switch ( option ) {
case 'c':
@ -123,14 +126,14 @@ int main( int argc, char *argv[] ) {
* standard input, output, error and sink streams
* attempt to set wide character acceptance on all streams
*/
FILE *sink = fopen( "/dev/null", "w" );
URL_FILE *sink = url_fopen( "/dev/null", "w" );
fwide( stdin, 1 );
fwide( stdout, 1 );
fwide( stderr, 1 );
fwide( sink, 1 );
bind_value( L"*in*", make_read_stream( stdin ) );
bind_value( L"*out*", make_write_stream( stdout ) );
bind_value( L"*log*", make_write_stream( stderr ) );
bind_value( L"*in*", make_read_stream( file_to_url_file(stdin) ) );
bind_value( L"*out*", make_write_stream( file_to_url_file(stdout) ) );
bind_value( L"*log*", make_write_stream( file_to_url_file(stderr) ) );
bind_value( L"*sink*", make_write_stream( sink ) );
/*
@ -180,9 +183,9 @@ int main( int argc, char *argv[] ) {
*/
bind_special( L"cond", &lisp_cond );
bind_special( L"lambda", &lisp_lambda );
// bind_special( L"λ", &lisp_lambda );
bind_special( L"\u03bb", &lisp_lambda ); // λ
bind_special( L"nlambda", &lisp_nlambda );
// bind_special( L"nλ", &lisp_nlambda );
bind_special( L"n\u03bb", &lisp_nlambda );
bind_special( L"progn", &lisp_progn );
bind_special( L"quote", &lisp_quote );
bind_special( L"set!", &lisp_set_shriek );

543
src/io/fopen.c Normal file
View file

@ -0,0 +1,543 @@
/*
* fopen.c
*
* adapted from https://curl.haxx.se/libcurl/c/fopen.html.
*
* Copyright (c) 2003, 2017 Simtec Electronics
* Some portions (c) 2017 Simon Brooke <simon@journeyman.cc>
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
* 3. The name of the author may not be used to endorse or promote products
* derived from this software without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
* IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
* OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
* IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
* INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
* NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
* THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*
* This example requires libcurl 7.9.7 or later.
*/
#include <stdio.h>
#include <string.h>
#ifndef WIN32
# include <sys/time.h>
#endif
#include <stdlib.h>
#include <errno.h>
#include <curl/curl.h>
/*
* wide characters
*/
#include <wchar.h>
#include <wctype.h>
#include "fopen.h"
/* we use a global one for convenience */
static CURLM *multi_handle;
/* curl calls this routine to get more data */
static size_t write_callback(char *buffer,
size_t size,
size_t nitems,
void *userp)
{
char *newbuff;
size_t rembuff;
URL_FILE *url = (URL_FILE *)userp;
size *= nitems;
rembuff = url->buffer_len - url->buffer_pos; /* remaining space in buffer */
if(size > rembuff) {
/* not enough space in buffer */
newbuff = realloc(url->buffer, url->buffer_len + (size - rembuff));
if(newbuff == NULL) {
fprintf(stderr, "callback buffer grow failed\n");
size = rembuff;
}
else {
/* realloc succeeded increase buffer size*/
url->buffer_len += size - rembuff;
url->buffer = newbuff;
}
}
memcpy(&url->buffer[url->buffer_pos], buffer, size);
url->buffer_pos += size;
return size;
}
/* use to attempt to fill the read buffer up to requested number of bytes */
static int fill_buffer(URL_FILE *file, size_t want)
{
fd_set fdread;
fd_set fdwrite;
fd_set fdexcep;
struct timeval timeout;
int rc;
CURLMcode mc; /* curl_multi_fdset() return code */
/* only attempt to fill buffer if transactions still running and buffer
* doesn't exceed required size already
*/
if((!file->still_running) || (file->buffer_pos > want))
return 0;
/* attempt to fill buffer */
do {
int maxfd = -1;
long curl_timeo = -1;
FD_ZERO(&fdread);
FD_ZERO(&fdwrite);
FD_ZERO(&fdexcep);
/* set a suitable timeout to fail on */
timeout.tv_sec = 60; /* 1 minute */
timeout.tv_usec = 0;
curl_multi_timeout(multi_handle, &curl_timeo);
if(curl_timeo >= 0) {
timeout.tv_sec = curl_timeo / 1000;
if(timeout.tv_sec > 1)
timeout.tv_sec = 1;
else
timeout.tv_usec = (curl_timeo % 1000) * 1000;
}
/* get file descriptors from the transfers */
mc = curl_multi_fdset(multi_handle, &fdread, &fdwrite, &fdexcep, &maxfd);
if(mc != CURLM_OK) {
fprintf(stderr, "curl_multi_fdset() failed, code %d.\n", mc);
break;
}
/* On success the value of maxfd is guaranteed to be >= -1. We call
select(maxfd + 1, ...); specially in case of (maxfd == -1) there are
no fds ready yet so we call select(0, ...) --or Sleep() on Windows--
to sleep 100ms, which is the minimum suggested value in the
curl_multi_fdset() doc. */
if(maxfd == -1) {
#ifdef _WIN32
Sleep(100);
rc = 0;
#else
/* Portable sleep for platforms other than Windows. */
struct timeval wait = { 0, 100 * 1000 }; /* 100ms */
rc = select(0, NULL, NULL, NULL, &wait);
#endif
}
else {
/* Note that on some platforms 'timeout' may be modified by select().
If you need access to the original value save a copy beforehand. */
rc = select(maxfd + 1, &fdread, &fdwrite, &fdexcep, &timeout);
}
switch(rc) {
case -1:
/* select error */
break;
case 0:
default:
/* timeout or readable/writable sockets */
curl_multi_perform(multi_handle, &file->still_running);
break;
}
} while(file->still_running && (file->buffer_pos < want));
return 1;
}
/* use to remove want bytes from the front of a files buffer */
static int use_buffer(URL_FILE *file, size_t want)
{
/* sort out buffer */
if((file->buffer_pos - want) <= 0) {
/* ditch buffer - write will recreate */
free(file->buffer);
file->buffer = NULL;
file->buffer_pos = 0;
file->buffer_len = 0;
}
else {
/* move rest down make it available for later */
memmove(file->buffer,
&file->buffer[want],
(file->buffer_pos - want));
file->buffer_pos -= want;
}
return 0;
}
URL_FILE *url_fopen(const char *url, const char *operation)
{
/* this code could check for URLs or types in the 'url' and
basically use the real fopen() for standard files */
URL_FILE *file;
(void)operation;
file = calloc(1, sizeof(URL_FILE));
if(!file)
return NULL;
file->handle.file = fopen(url, operation);
if(file->handle.file)
file->type = CFTYPE_FILE; /* marked as URL */
else {
file->type = CFTYPE_CURL; /* marked as URL */
file->handle.curl = curl_easy_init();
curl_easy_setopt(file->handle.curl, CURLOPT_URL, url);
curl_easy_setopt(file->handle.curl, CURLOPT_WRITEDATA, file);
curl_easy_setopt(file->handle.curl, CURLOPT_VERBOSE, 0L);
curl_easy_setopt(file->handle.curl, CURLOPT_WRITEFUNCTION, write_callback);
if(!multi_handle)
multi_handle = curl_multi_init();
curl_multi_add_handle(multi_handle, file->handle.curl);
/* lets start the fetch */
curl_multi_perform(multi_handle, &file->still_running);
if((file->buffer_pos == 0) && (!file->still_running)) {
/* if still_running is 0 now, we should return NULL */
/* make sure the easy handle is not in the multi handle anymore */
curl_multi_remove_handle(multi_handle, file->handle.curl);
/* cleanup */
curl_easy_cleanup(file->handle.curl);
free(file);
file = NULL;
}
}
return file;
}
int url_fclose(URL_FILE *file)
{
int ret = 0;/* default is good return */
switch(file->type) {
case CFTYPE_FILE:
ret = fclose(file->handle.file); /* passthrough */
break;
case CFTYPE_CURL:
/* make sure the easy handle is not in the multi handle anymore */
curl_multi_remove_handle(multi_handle, file->handle.curl);
/* cleanup */
curl_easy_cleanup(file->handle.curl);
break;
default: /* unknown or supported type - oh dear */
ret = EOF;
errno = EBADF;
break;
}
free(file->buffer);/* free any allocated buffer space */
free(file);
return ret;
}
int url_feof(URL_FILE *file)
{
int ret = 0;
switch(file->type) {
case CFTYPE_FILE:
ret = feof(file->handle.file);
break;
case CFTYPE_CURL:
if((file->buffer_pos == 0) && (!file->still_running))
ret = 1;
break;
default: /* unknown or supported type - oh dear */
ret = -1;
errno = EBADF;
break;
}
return ret;
}
size_t url_fread(void *ptr, size_t size, size_t nmemb, URL_FILE *file)
{
size_t want;
switch(file->type) {
case CFTYPE_FILE:
want = fread(ptr, size, nmemb, file->handle.file);
break;
case CFTYPE_CURL:
want = nmemb * size;
fill_buffer(file, want);
/* check if there's data in the buffer - if not fill_buffer()
* either errored or EOF */
if(!file->buffer_pos)
return 0;
/* ensure only available data is considered */
if(file->buffer_pos < want)
want = file->buffer_pos;
/* xfer data to caller */
memcpy(ptr, file->buffer, want);
use_buffer(file, want);
want = want / size; /* number of items */
break;
default: /* unknown or supported type - oh dear */
want = 0;
errno = EBADF;
break;
}
return want;
}
char *url_fgets(char *ptr, size_t size, URL_FILE *file)
{
size_t want = size - 1;/* always need to leave room for zero termination */
size_t loop;
switch(file->type) {
case CFTYPE_FILE:
ptr = fgets(ptr, (int)size, file->handle.file);
break;
case CFTYPE_CURL:
fill_buffer(file, want);
/* check if there's data in the buffer - if not fill either errored or
* EOF */
if(!file->buffer_pos)
return NULL;
/* ensure only available data is considered */
if(file->buffer_pos < want)
want = file->buffer_pos;
/*buffer contains data */
/* look for newline or eof */
for(loop = 0; loop < want; loop++) {
if(file->buffer[loop] == '\n') {
want = loop + 1;/* include newline */
break;
}
}
/* xfer data to caller */
memcpy(ptr, file->buffer, want);
ptr[want] = 0;/* always null terminate */
use_buffer(file, want);
break;
default: /* unknown or supported type - oh dear */
ptr = NULL;
errno = EBADF;
break;
}
return ptr;/*success */
}
void url_rewind(URL_FILE *file)
{
switch(file->type) {
case CFTYPE_FILE:
rewind(file->handle.file); /* passthrough */
break;
case CFTYPE_CURL:
/* halt transaction */
curl_multi_remove_handle(multi_handle, file->handle.curl);
/* restart */
curl_multi_add_handle(multi_handle, file->handle.curl);
/* ditch buffer - write will recreate - resets stream pos*/
free(file->buffer);
file->buffer = NULL;
file->buffer_pos = 0;
file->buffer_len = 0;
break;
default: /* unknown or supported type - oh dear */
break;
}
}
/**
* given this file handle f, return a new url_file handle wrapping it.
*
* @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));
if ( result != NULL) {
result->type = CFTYPE_FILE,
result->handle.file = f;
}
return result;
}
wint_t url_fgetwc(URL_FILE *file) {
wint_t result = 0;
switch(file->type) {
case CFTYPE_FILE:
fwide( file->handle.file, 1 ); /* wide characters */
result = fgetc(file->handle.file); /* passthrough */
break;
case CFTYPE_CURL:
url_fread(&result, sizeof(wint_t), 1, file);
break;
}
return result;
}
/* #define FGETSFILE "fgets.test" */
/* #define FREADFILE "fread.test" */
/* #define REWINDFILE "rewind.test" */
/* /\* Small main program to retrieve from a url using fgets and fread saving the */
/* * output to two test files (note the fgets method will corrupt binary files if */
/* * they contain 0 chars *\/ */
/* int main(int argc, char *argv[]) */
/* { */
/* URL_FILE *handle; */
/* FILE *outf; */
/* size_t nread; */
/* char buffer[256]; */
/* const char *url; */
/* if(argc < 2) */
/* url = "http://192.168.7.3/testfile";/\* default to testurl *\/ */
/* else */
/* url = argv[1];/\* use passed url *\/ */
/* /\* copy from url line by line with fgets *\/ */
/* outf = fopen(FGETSFILE, "wb+"); */
/* if(!outf) { */
/* perror("couldn't open fgets output file\n"); */
/* return 1; */
/* } */
/* handle = url_fopen(url, "r"); */
/* if(!handle) { */
/* printf("couldn't url_fopen() %s\n", url); */
/* fclose(outf); */
/* return 2; */
/* } */
/* while(!url_feof(handle)) { */
/* url_fgets(buffer, sizeof(buffer), handle); */
/* fwrite(buffer, 1, strlen(buffer), outf); */
/* } */
/* url_fclose(handle); */
/* fclose(outf); */
/* /\* Copy from url with fread *\/ */
/* outf = fopen(FREADFILE, "wb+"); */
/* if(!outf) { */
/* perror("couldn't open fread output file\n"); */
/* return 1; */
/* } */
/* handle = url_fopen("testfile", "r"); */
/* if(!handle) { */
/* printf("couldn't url_fopen() testfile\n"); */
/* fclose(outf); */
/* return 2; */
/* } */
/* do { */
/* nread = url_fread(buffer, 1, sizeof(buffer), handle); */
/* fwrite(buffer, 1, nread, outf); */
/* } while(nread); */
/* url_fclose(handle); */
/* fclose(outf); */
/* /\* Test rewind *\/ */
/* outf = fopen(REWINDFILE, "wb+"); */
/* if(!outf) { */
/* perror("couldn't open fread output file\n"); */
/* return 1; */
/* } */
/* handle = url_fopen("testfile", "r"); */
/* if(!handle) { */
/* printf("couldn't url_fopen() testfile\n"); */
/* fclose(outf); */
/* return 2; */
/* } */
/* nread = url_fread(buffer, 1, sizeof(buffer), handle); */
/* fwrite(buffer, 1, nread, outf); */
/* url_rewind(handle); */
/* buffer[0]='\n'; */
/* fwrite(buffer, 1, 1, outf); */
/* nread = url_fread(buffer, 1, sizeof(buffer), handle); */
/* fwrite(buffer, 1, nread, outf); */
/* url_fclose(handle); */
/* fclose(outf); */
/* return 0;/\* all done *\/ */
/* } */

72
src/io/fopen.h Normal file
View file

@ -0,0 +1,72 @@
/*
* fopen.h
*
* adapted from https://curl.haxx.se/libcurl/c/fopen.html.
*
* Copyright (c) 2003, 2017 Simtec Electronics
* Some portions (c) 2017 Simon Brooke <simon@journeyman.cc>
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
* 3. The name of the author may not be used to endorse or promote products
* derived from this software without specific prior written permission.
*
* THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
* IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
* OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
* IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
* INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
* NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
* THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*
* This example requires libcurl 7.9.7 or later.
*/
#ifndef __fopen_h
#define __fopen_h
enum fcurl_type_e {
CFTYPE_NONE = 0,
CFTYPE_FILE = 1,
CFTYPE_CURL = 2
};
struct fcurl_data
{
enum fcurl_type_e type; /* type of handle */
union {
CURL *curl;
FILE *file;
} handle; /* handle */
char *buffer; /* buffer to store cached data*/
size_t buffer_len; /* currently allocated buffers length */
size_t buffer_pos; /* end of data in buffer*/
int still_running; /* Is background url fetch still in progress */
};
typedef struct fcurl_data URL_FILE;
/* exported functions */
URL_FILE *url_fopen(const char *url, const char *operation);
int url_fclose(URL_FILE *file);
int url_feof(URL_FILE *file);
size_t url_fread(void *ptr, size_t size, size_t nmemb, URL_FILE *file);
char *url_fgets(char *ptr, size_t size, URL_FILE *file);
void url_rewind(URL_FILE *file);
wint_t url_fgetwc(URL_FILE *file);
URL_FILE * file_to_url_file( FILE* f);
#endif

2
src/memory/conspage.c
View file

@ -115,7 +115,7 @@ void make_cons_page( ) {
/**
* dump the allocated pages to this `output` stream.
*/
void dump_pages( FILE * output ) {
void dump_pages( URL_FILE * output ) {
for ( int i = 0; i < initialised_cons_pages; i++ ) {
fwprintf( output, L"\nDUMPING PAGE %d\n", i );

2
src/memory/conspage.h
View file

@ -47,6 +47,6 @@ struct cons_pointer allocate_cell( char *tag );
void initialise_cons_pages( );
void dump_pages( FILE * output );
void dump_pages( URL_FILE * output );
#endif

6
src/memory/consspaceobject.c
View file

@ -95,8 +95,6 @@ struct cons_pointer make_exception( struct cons_pointer message,
struct cons_pointer pointer = allocate_cell( EXCEPTIONTAG );
struct cons_space_object *cell = &pointer2cell( pointer );
// inc_ref( pointer ); /* this is a hack; I don't know why it's necessary to do this, but if I don't the cell gets freed */
inc_ref( message );
inc_ref( frame_pointer );
cell->payload.exception.message = message;
@ -235,7 +233,7 @@ make_special( struct cons_pointer src, struct cons_pointer ( *executable )
* Construct a cell which points to a stream open for reading.
* @param input the C stream to wrap.
*/
struct cons_pointer make_read_stream( FILE * input ) {
struct cons_pointer make_read_stream( URL_FILE * input ) {
struct cons_pointer pointer = allocate_cell( READTAG );
struct cons_space_object *cell = &pointer2cell( pointer );
@ -248,7 +246,7 @@ struct cons_pointer make_read_stream( FILE * input ) {
* Construct a cell which points to a stream open for writing.
* @param output the C stream to wrap.
*/
struct cons_pointer make_write_stream( FILE * output ) {
struct cons_pointer make_write_stream( URL_FILE * output ) {
struct cons_pointer pointer = allocate_cell( WRITETAG );
struct cons_space_object *cell = &pointer2cell( pointer );

9
src/memory/consspaceobject.h
View file

@ -16,6 +16,9 @@
*/
#include <wchar.h>
#include <wctype.h>
#include <curl/curl.h>
#include "fopen.h"
#ifndef __consspaceobject_h
#define __consspaceobject_h
@ -488,7 +491,7 @@ struct special_payload {
*/
struct stream_payload {
/** the stream to read from or write to. */
FILE *stream;
URL_FILE *stream;
};
/**
@ -636,9 +639,9 @@ struct cons_pointer make_string( wint_t c, struct cons_pointer tail );
struct cons_pointer make_symbol( wint_t c, struct cons_pointer tail );
struct cons_pointer make_read_stream( FILE * input );
struct cons_pointer make_read_stream( URL_FILE * input );
struct cons_pointer make_write_stream( FILE * output );
struct cons_pointer make_write_stream( URL_FILE * output );
struct cons_pointer c_string_to_lisp_string( wchar_t *string );

8
src/memory/dump.c
View file

@ -26,7 +26,7 @@
#include "vectorspace.h"
void dump_string_cell( FILE * output, wchar_t *prefix,
void dump_string_cell( URL_FILE * output, wchar_t *prefix,
struct cons_pointer pointer ) {
struct cons_space_object cell = pointer2cell( pointer );
if ( cell.payload.string.character == 0 ) {
@ -52,7 +52,7 @@ void dump_string_cell( FILE * output, wchar_t *prefix,
/**
* dump the object at this cons_pointer to this output stream.
*/
void dump_object( FILE * output, struct cons_pointer pointer ) {
void dump_object( URL_FILE * output, struct cons_pointer pointer ) {
struct cons_space_object cell = pointer2cell( pointer );
fwprintf( output,
L"\t%4.4s (%d) at page %d, offset %d count %u\n",
@ -89,7 +89,7 @@ void dump_object( FILE * output, struct cons_pointer pointer ) {
}
break;
case LAMBDATV:
fwprintf( output, L"\t\tLambda cell;\n\t\t args: " );
fwprintf( output, L"\t\t\u03bb cell;\n\t\t args: " );
print( output, cell.payload.lambda.args );
fwprintf( output, L";\n\t\t\tbody: " );
print( output, cell.payload.lambda.body );
@ -98,7 +98,7 @@ void dump_object( FILE * output, struct cons_pointer pointer ) {
case NILTV:
break;
case NLAMBDATV:
fwprintf( output, L"\t\tNlambda cell; \n\t\targs: " );
fwprintf( output, L"\t\tn\u03bb cell; \n\t\targs: " );
print( output, cell.payload.lambda.args );
fwprintf( output, L";\n\t\t\tbody: " );
print( output, cell.payload.lambda.body );

2
src/memory/dump.h
View file

@ -20,6 +20,6 @@
#define __dump_h
void dump_object( FILE * output, struct cons_pointer pointer );
void dump_object( URL_FILE * output, struct cons_pointer pointer );
#endif

4
src/memory/stack.c
View file

@ -241,7 +241,7 @@ void free_stack_frame( struct stack_frame *frame ) {
* @param output the stream
* @param frame_pointer the pointer to the frame
*/
void dump_frame( FILE * output, struct cons_pointer frame_pointer ) {
void dump_frame( URL_FILE * output, struct cons_pointer frame_pointer ) {
struct stack_frame *frame = get_stack_frame( frame_pointer );
if ( frame != NULL ) {
@ -265,7 +265,7 @@ void dump_frame( FILE * output, struct cons_pointer frame_pointer ) {
}
}
void dump_stack_trace( FILE * output, struct cons_pointer pointer ) {
void dump_stack_trace( URL_FILE * output, struct cons_pointer pointer ) {
if ( exceptionp( pointer ) ) {
print( output, pointer2cell( pointer ).payload.exception.message );
fputws( L"\n", output );

4
src/memory/stack.h
View file

@ -47,9 +47,9 @@ struct cons_pointer make_stack_frame( struct cons_pointer previous,
void free_stack_frame( struct stack_frame *frame );
void dump_frame( FILE * output, struct cons_pointer pointer );
void dump_frame( URL_FILE * output, struct cons_pointer pointer );
void dump_stack_trace( FILE * output, struct cons_pointer frame_pointer );
void dump_stack_trace( URL_FILE * output, struct cons_pointer frame_pointer );
struct cons_pointer fetch_arg( struct stack_frame *frame, unsigned int n );

8
src/ops/io.c Normal file
View file

@ -0,0 +1,8 @@
/*
* io.c
*
* Communication between PSSE and the outside world, via libcurl.
*
* (c) 2017 Simon Brooke <simon@journeyman.cc>
* Licensed under GPL version 2.0, or, at your option, any later version.
*/

8
src/ops/lispops.c
View file

@ -839,7 +839,7 @@ lisp_read( struct stack_frame *frame, struct cons_pointer frame_pointer,
#ifdef DEBUG
debug_print( L"entering lisp_read\n", DEBUG_IO );
#endif
FILE *input = stdin;
URL_FILE *input = stdin;
struct cons_pointer in_stream = readp( frame->arg[0] ) ?
frame->arg[0] : get_default_stream( true, env );
@ -922,7 +922,7 @@ lisp_print( struct stack_frame *frame, struct cons_pointer frame_pointer,
struct cons_pointer env ) {
debug_print( L"Entering print\n", DEBUG_IO );
struct cons_pointer result = NIL;
FILE *output = stdout;
URL_FILE *output = stdout;
struct cons_pointer out_stream = writep( frame->arg[1] ) ?
frame->arg[1] : get_default_stream( false, env );
@ -1148,7 +1148,7 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
struct cons_pointer input = get_default_stream( true, env );
struct cons_pointer output = get_default_stream( false, env );
FILE *os = pointer2cell( output ).payload.stream.stream;
URL_FILE *os = pointer2cell( output ).payload.stream.stream;
struct cons_pointer prompt_name = c_string_to_lisp_symbol( L"*prompt*" );
struct cons_pointer old_oblist = oblist;
struct cons_pointer new_env = env;
@ -1282,7 +1282,7 @@ struct cons_pointer lisp_inspect( struct stack_frame *frame,
struct cons_pointer frame_pointer,
struct cons_pointer env ) {
debug_print( L"Entering print\n", DEBUG_IO );
FILE *output = stdout;
URL_FILE *output = stdout;
struct cons_pointer out_stream = writep( frame->arg[1] ) ?
frame->arg[1] : get_default_stream( false, env );

12
src/ops/print.c
View file

@ -34,7 +34,7 @@ int print_use_colours = 0;
* onto this `output`; if `pointer` does not indicate a string or symbol,
* don't print anything but just return.
*/
void print_string_contents( FILE * output, struct cons_pointer pointer ) {
void print_string_contents( URL_FILE * output, struct cons_pointer pointer ) {
while ( stringp( pointer ) || symbolp( pointer ) ) {
struct cons_space_object *cell = &pointer2cell( pointer );
wchar_t c = cell->payload.string.character;
@ -51,7 +51,7 @@ void print_string_contents( FILE * output, struct cons_pointer pointer ) {
* the stream at this `output`, prepending and appending double quote
* characters.
*/
void print_string( FILE * output, struct cons_pointer pointer ) {
void print_string( URL_FILE * output, struct cons_pointer pointer ) {
fputwc( btowc( '"' ), output );
print_string_contents( output, pointer );
fputwc( btowc( '"' ), output );
@ -63,7 +63,7 @@ void print_string( FILE * output, struct cons_pointer pointer ) {
* a space character.
*/
void
print_list_contents( FILE * output, struct cons_pointer pointer,
print_list_contents( URL_FILE * output, struct cons_pointer pointer,
bool initial_space ) {
struct cons_space_object *cell = &pointer2cell( pointer );
@ -84,7 +84,7 @@ print_list_contents( FILE * output, struct cons_pointer pointer,
}
}
void print_list( FILE * output, struct cons_pointer pointer ) {
void print_list( URL_FILE * output, struct cons_pointer pointer ) {
if ( print_use_colours ) {
fwprintf( output, L"%s(%s", "\x1B[31m", "\x1B[39m" );
} else {
@ -104,7 +104,7 @@ void print_list( FILE * output, struct cons_pointer pointer ) {
* Print the cons-space object indicated by `pointer` to the stream indicated
* by `output`.
*/
struct cons_pointer print( FILE * output, struct cons_pointer pointer ) {
struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) {
struct cons_space_object cell = pointer2cell( pointer );
char *buffer;
@ -225,6 +225,6 @@ struct cons_pointer print( FILE * output, struct cons_pointer pointer ) {
return pointer;
}
void println( FILE * output ) {
void println( URL_FILE * output ) {
fputws( L"\n", output );
}

4
src/ops/print.h
View file

@ -14,8 +14,8 @@
#ifndef __print_h
#define __print_h
struct cons_pointer print( FILE * output, struct cons_pointer pointer );
void println( FILE * output );
struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer );
void println( URL_FILE * output );
extern int print_use_colours;
#endif

23
src/ops/read.c
View file

@ -38,13 +38,13 @@
struct cons_pointer read_number( struct stack_frame *frame,
struct cons_pointer frame_pointer,
FILE * input, wint_t initial,
URL_FILE * input, wint_t initial,
bool seen_period );
struct cons_pointer read_list( struct stack_frame *frame,
struct cons_pointer frame_pointer, FILE * input,
struct cons_pointer frame_pointer, URL_FILE * input,
wint_t initial );
struct cons_pointer read_string( FILE * input, wint_t initial );
struct cons_pointer read_symbol( FILE * input, wint_t initial );
struct cons_pointer read_string( URL_FILE * input, wint_t initial );
struct cons_pointer read_symbol( URL_FILE * input, wint_t initial );
/**
* quote reader macro in C (!)
@ -61,7 +61,7 @@ struct cons_pointer c_quote( struct cons_pointer arg ) {
*/
struct cons_pointer read_continuation( struct stack_frame *frame,
struct cons_pointer frame_pointer,
FILE * input, wint_t initial ) {
URL_FILE * input, wint_t initial ) {
debug_print( L"entering read_continuation\n", DEBUG_IO );
struct cons_pointer result = NIL;
@ -129,6 +129,7 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
}
}
break;
//case ':': reserved for keywords and paths
default:
if ( iswdigit( c ) ) {
result =
@ -158,7 +159,7 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
*/
struct cons_pointer read_number( struct stack_frame *frame,
struct cons_pointer frame_pointer,
FILE * input,
URL_FILE * input,
wint_t initial, bool seen_period ) {
debug_print( L"entering read_number\n", DEBUG_IO );
@ -267,7 +268,7 @@ struct cons_pointer read_number( struct stack_frame *frame,
*/
struct cons_pointer read_list( struct stack_frame *frame,
struct cons_pointer frame_pointer,
FILE * input, wint_t initial ) {
URL_FILE * input, wint_t initial ) {
struct cons_pointer result = NIL;
if ( initial != ')' ) {
debug_printf( DEBUG_IO,
@ -293,7 +294,7 @@ struct cons_pointer read_list( struct stack_frame *frame,
* so delimited in which case it may not contain whitespace (unless escaped)
* but may contain a double quote character (probably not a good idea!)
*/
struct cons_pointer read_string( FILE * input, wint_t initial ) {
struct cons_pointer read_string( URL_FILE * input, wint_t initial ) {
struct cons_pointer cdr = NIL;
struct cons_pointer result;
switch ( initial ) {
@ -315,7 +316,7 @@ struct cons_pointer read_string( FILE * input, wint_t initial ) {
return result;
}
struct cons_pointer read_symbol( FILE * input, wint_t initial ) {
struct cons_pointer read_symbol( URL_FILE * input, wint_t initial ) {
struct cons_pointer cdr = NIL;
struct cons_pointer result;
switch ( initial ) {
@ -331,7 +332,7 @@ struct cons_pointer read_symbol( FILE * input, wint_t initial ) {
break;
case ')':
/*
* symbols may not include right-parenthesis
* symbols may not include right-parenthesis;
*/
result = NIL;
/*
@ -367,6 +368,6 @@ struct cons_pointer read_symbol( FILE * input, wint_t initial ) {
struct cons_pointer read( struct
stack_frame
*frame, struct cons_pointer frame_pointer,
FILE * input ) {
URL_FILE * input ) {
return read_continuation( frame, frame_pointer, input, fgetwc( input ) );
}

2
src/ops/read.h
View file

@ -15,6 +15,6 @@
* read the next object on this input stream and return a cons_pointer to it.
*/
struct cons_pointer read( struct stack_frame *frame,
struct cons_pointer frame_pointer, FILE * input );
struct cons_pointer frame_pointer, URL_FILE * input );
#endif

38
unit-tests/bignum-print.sh
View file

@ -18,17 +18,6 @@ else
exit 1
fi
echo -n "checking no bignum was created: "
grep -v 'BIGNUM!' psse.log > /dev/null
if [ $? -eq "0" ]
then
echo "OK"
else
echo "Fail"
exit 1
fi
#####################################################################
# right on the boundary
@ -48,17 +37,6 @@ else
exit 1
fi
echo -n "checking no bignum was created: "
grep -v 'BIGNUM!' psse.log > /dev/null
if [ $? -eq "0" ]
then
echo "OK"
else
echo "Fail"
exit 1
fi
#####################################################################
# definitely a bignum
@ -79,16 +57,10 @@ else
fi
echo -n "checking a bignum was created: "
grep 'BIGNUM!' psse.log > /dev/null
if [ $? -eq "0" ]
then
echo "OK"
else
echo "Fail"
exit 1
fi
# Currently failing from here on, but it's failing in read because of
# the multiply bug. We know printing blows up at the 3 cell boundary
# because `lisp/scratchpad2.lisp` constructs a 3 cell bignum by
# repeated addition.
#####################################################################
# Just on the three cell boundary
expected='1329227995784915872903807060280344576'
@ -103,7 +75,7 @@ if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
echo "Fail: expected '${expected}', \n got '${actual}'"
exit 1
fi

0
unit-tests/string-cons.sh Normal file → Executable file
View file

12
unit-tests/wide-character.sh Executable file
View file

@ -0,0 +1,12 @@
#!/bin/bash
expected='"λάμ(β)δα"'
actual=`echo $expected | target/psse | tail -1`
if [ "${expected}" = "${actual}" ]
then
echo "OK"
else
echo "Fail: expected '${expected}', got '${actual}'"
exit 1
fi