A bit of work on time, but it doesn't actually work yet.

src/arith/integer.c

@@ -12,12 +12,6 @@
 #include <math.h>
 #include <stdio.h>
 #include <stdlib.h>
-/* 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 <safe_iop.h>
 /*
  * wide characters
  */

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 );

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 );
 }

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"<Special form>" );
             break;
+        case TIMETV:
+            print_string(output, time_to_string( pointer));
+            break;
         case TRUETV:
             url_fwprintf( output, L"t" );
             break;

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
          */

src/time/time.c

@@ -0,0 +1,98 @@
+/*
+ * time.h
+ *
+ * Bare bones of PSSE time. See issue #16.
+ *
+ * (c) 2019 Simon Brooke <simon@journeyman.cc>
+ * Licensed under GPL version 2.0, or, at your option, any later version.
+ */
+
+#include <stdlib.h>
+#include <time.h>
+/*
+ * wide characters
+ */
+#include <wchar.h>
+#include <wctype.h>
+
+#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));
+}

src/time/time.h

@@ -0,0 +1,20 @@
+/*
+ * time.h
+ *
+ * Bare bones of PSSE time. See issue #16.
+ *
+ * (c) 2019 Simon Brooke <simon@journeyman.cc>
+ * 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

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];
 }