diff --git a/src/arith/integer.c b/src/arith/integer.c index 1195c53..48992ca 100644 --- a/src/arith/integer.c +++ b/src/arith/integer.c @@ -12,12 +12,6 @@ #include #include #include -/* safe_iop, as available in the Ubuntu repository, is this one: - * https://code.google.com/archive/p/safe-iop/wikis/README.wiki - * which is installed as `libsafe-iop-dev`. There is an alternate - * implementation here: https://github.com/redpig/safe-iop/ - * which shares the same version number but is not compatible. */ -#include /* * wide characters */ diff --git a/src/init.c b/src/init.c index 47ba772..06494e9 100644 --- a/src/init.c +++ b/src/init.c @@ -30,6 +30,7 @@ #include "peano.h" #include "print.h" #include "repl.h" +#include "time.h" // extern char *optarg; /* defined in unistd.h */ @@ -212,6 +213,7 @@ int main( int argc, char *argv[] ) { bind_function( L"source", &lisp_source ); bind_function( L"subtract", &lisp_subtract ); bind_function( L"throw", &lisp_exception ); + bind_function( L"time", &lisp_time ); bind_function( L"type", &lisp_type ); bind_function( L"+", &lisp_add ); bind_function( L"*", &lisp_multiply ); diff --git a/src/io/io.c b/src/io/io.c index dd41190..b82c6ba 100644 --- a/src/io/io.c +++ b/src/io/io.c @@ -266,16 +266,8 @@ struct cons_pointer add_meta_string( struct cons_pointer meta, wchar_t *key, char *value ) { value = trim( value); wchar_t buffer[strlen( value ) + 1]; - /* \todo something goes wrong here: I sometimes get junk characters on the - * end of the string. */ mbstowcs( buffer, value, strlen( value ) + 1 ); - /* hack: get rid of 32766 as a junk character, to see whether there are - * others. - for (int i = 0; i < wcslen( buffer); i++) { - if (buffer[i] == (wchar_t)32766) buffer[i] = (wchar_t)0; - } */ - return make_cons( make_cons( c_string_to_lisp_keyword( key ), c_string_to_lisp_string( buffer ) ), meta ); } diff --git a/src/io/print.c b/src/io/print.c index 854c63a..fb0d8a1 100644 --- a/src/io/print.c +++ b/src/io/print.c @@ -22,6 +22,7 @@ #include "integer.h" #include "stack.h" #include "print.h" +#include "time.h" /** * Whether or not we colorise output. @@ -210,6 +211,9 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) { case SPECIALTV: url_fwprintf( output, L"" ); break; + case TIMETV: + print_string(output, time_to_string( pointer)); + break; case TRUETV: url_fwprintf( output, L"t" ); break; diff --git a/src/memory/consspaceobject.h b/src/memory/consspaceobject.h index 1bbbcd1..91ba3c3 100644 --- a/src/memory/consspaceobject.h +++ b/src/memory/consspaceobject.h @@ -193,6 +193,16 @@ */ #define SYMBOLTV 1112365395 +/** + * A time stamp. + */ +#define TIMETAG "TIME" + +/** + * The string `TIME`, considered as an `unsigned int`. + */ +#define TIMETV 1162692948 + /** * The special cons cell at address {0,1} which is canonically different * from NIL. @@ -344,13 +354,18 @@ * (there should only be one of these so it's slightly redundant). * Also note that anything that is not NIL is truthy. */ -#define tp(conspoint) (checktag(conspoint,TRUETAG)) +#define tp(conspoint) (check_tag(conspoint,TRUETAG)) + +/** + * true if `conspoint` points to a time cell, else false. + */ +#define timep(conspoint) (check_tag(conspoint,TIMETAG)) /** * true if `conspoint` points to something that is truthy, i.e. * anything but NIL. */ -#define truep(conspoint) (!checktag(conspoint,NILTAG)) +#define truep(conspoint) (!check_tag(conspoint,NILTAG)) /** * An indirect pointer to a cons cell @@ -531,6 +546,15 @@ struct string_payload { struct cons_pointer cdr; }; +/** + * The payload of a time cell: an unsigned 128 bit value representing micro- + * seconds since the estimated date of the Big Bang (actually, for + * convenience, 14Bn years before 1st Jan 1970 (the UNIX epoch)) + */ +struct time_payload { + unsigned __int128 value; +}; + /** * payload of a vector pointer cell. */ @@ -616,6 +640,10 @@ struct cons_space_object { * if tag == STRINGTAG || tag == SYMBOLTAG */ struct string_payload string; + /** + * if tag == TIMETAG + */ + struct time_payload time; /** * if tag == TRUETAG; we'll treat the special cell T as just a cons */ diff --git a/src/time/time.c b/src/time/time.c new file mode 100644 index 0000000..146f296 --- /dev/null +++ b/src/time/time.c @@ -0,0 +1,98 @@ +/* + * time.h + * + * Bare bones of PSSE time. See issue #16. + * + * (c) 2019 Simon Brooke + * Licensed under GPL version 2.0, or, at your option, any later version. + */ + +#include +#include +/* + * wide characters + */ +#include +#include + +#include "conspage.h" +#include "consspaceobject.h" +#include "integer.h" +#include "time.h" +#define _GNU_SOURCE + +#define seconds_per_year 31557600L + +/** + * PSSE Lisp epoch is 14 Bn years, or 441,806,400,000,000,000 seconds, before + * the UNIX epoch; the value in microseconds will break the C reader. + */ +unsigned __int128 epoch_offset = ((__int128)(seconds_per_year * 1000000000L) * + (__int128)(14L * 1000000000L)); + +/** + * Return the UNIX time value which represents this time, if it falls within + * the period representable in UNIX time, or zero otherwise. + */ +long int lisp_time_to_unix_time(struct cons_pointer t) { + long int result = 0; + + if (timep( t)) { + unsigned __int128 value = pointer2cell(t).payload.time.value; + + if (value > epoch_offset) { // \todo && value < UNIX time rollover + result = ((value - epoch_offset) / 1000000000); + } + } + + return result; +} + +unsigned __int128 unix_time_to_lisp_time( time_t t) { + unsigned __int128 result = epoch_offset + (t * 1000000000); + + return result; +} + +struct cons_pointer make_time( struct cons_pointer integer_or_nil) { + struct cons_pointer pointer = allocate_cell( TIMETAG ); + struct cons_space_object *cell = &pointer2cell( pointer ); + + if (integerp(integer_or_nil)) { + cell->payload.time.value = pointer2cell(integer_or_nil).payload.integer.value; + // \todo: if integer is a bignum, deal with it. + } else { + cell->payload.time.value = unix_time_to_lisp_time( time(NULL)); + } + + return pointer; +} + +/** + * Function; return a time representation of the first argument in the frame; + * further arguments are ignored. + * + * * (time integer_or_nil) + * + * @param frame my stack_frame. + * @param frame_pointer a pointer to my stack_frame. + * @param env my environment. + * @return a lisp time; if `integer_or_nil` is an integer, return a time which + * is that number of microseconds after the notional big bang; else the current + * time. + */ +struct cons_pointer lisp_time( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ) { + return make_time( frame->arg[0]); +} + +/** + * This is temporary, for bootstrapping. + */ +struct cons_pointer time_to_string( struct cons_pointer pointer) { + long int t = lisp_time_to_unix_time(pointer); + + return c_string_to_lisp_string( t == 0 ? + L"Not yet implemented: cannot print times outside UNIX time\n" : + ctime(&t)); +} diff --git a/src/time/time.h b/src/time/time.h new file mode 100644 index 0000000..661decf --- /dev/null +++ b/src/time/time.h @@ -0,0 +1,20 @@ +/* + * time.h + * + * Bare bones of PSSE time. See issue #16. + * + * (c) 2019 Simon Brooke + * Licensed under GPL version 2.0, or, at your option, any later version. + */ + +#ifndef __psse_time_h +#define __psse_time_h + +#define _GNU_SOURCE +#include "consspaceobject.h" + +struct cons_pointer lisp_time( struct stack_frame *frame, struct cons_pointer frame_pointer, + struct cons_pointer env ); +struct cons_pointer time_to_string( struct cons_pointer pointer); + +#endif diff --git a/src/utils.c b/src/utils.c index 5b22516..ea3919f 100644 --- a/src/utils.c +++ b/src/utils.c @@ -27,7 +27,7 @@ char *trim( char *s ) { i-- ) { s[i] = '\0'; } - for ( i = 0; ( isblank( s[i] ) || iscntrl( s[i] ) ) && s[i] != '\0'; i++ ); + for ( i = 0; s[i] != '\0' && ( isblank( s[i] ) || iscntrl( s[i] ) ); i++ ); return ( char * ) &s[i]; }