Merge branch 'develop'

.gitignore

@@ -12,3 +12,9 @@ nbproject/
 src/\.#*
 
 *.log
+
+\.idea/
+
+post-scarcity\.iml
+
+doc/

Makefile

@@ -3,9 +3,12 @@ TARGET ?= target/psse
 SRC_DIRS ?= ./src
 
 SRCS := $(shell find $(SRC_DIRS) -name *.cpp -or -name *.c -or -name *.s)
+HDRS := $(shell find $(SRC_DIRS) -name *.h)
 OBJS := $(addsuffix .o,$(basename $(SRCS)))
 DEPS := $(OBJS:.o=.d)
 
+TESTS := $(shell find unit-tests -name *.sh)
+
 INC_DIRS := $(shell find $(SRC_DIRS) -type d)
 INC_FLAGS := $(addprefix -I,$(INC_DIRS))
 INDENT_FLAGS := -kr -br -brf -brs -ce -cdw -npsl -nut -prs -l79 -ts2
@@ -18,10 +21,13 @@ LDFLAGS := -lm
 $(TARGET): $(OBJS) Makefile
 	$(CC) $(LDFLAGS) $(OBJS) -DVERSION=$(VERSION) -o $@ $(LDFLAGS) $(LOADLIBES) $(LDLIBS)
 
-format:
-	indent $(INDENT_FLAGS) $(SRCS) src/*.h
+doc: $(SRCS) Makefile
+	doxygen
 
-test:
+format: $(SRCS) $(HDRS) Makefile
+	indent $(INDENT_FLAGS) $(SRCS) $(HDRS)
+
+test: $(OBJS) $(TESTS) Makefile
 	bash ./unit-tests.sh
 
 .PHONY: clean

notes/connection-machine.txt

@@ -0,0 +1,22 @@
+This document describes my understanding of the connection machine CM-1, and the differences between CM-1 and the architecture I'm starting to envisage.
+
+I'm working from figure 1.8 on page 21, and chapter 4.
+
+CM-1 comprises 64k processor nodes each with 4096 bits(?) of memory. The topology is I think that each processor has six proximal neighbours.
+
+Physically there are 16 processors to a (custom) chip. Each chip has, in addition to the 16 processors arranged in a 4x4 grid, a single router. The processors on a single chip are each connected to their neighbours, so those in the middle of the chip connect to four neighbours, those on the edge three, and those on corners 2; I'm guessing edge processors connect to neighbouring chips, but I haven't yet found that explicitly. There's also a 'cube pin' which is something to do with topology, but there seems to be just one of these per chip rather than the two per processor that would be needed for six-way interconnect?
+
+There are 4096 routers "connected by 24576 bidirectional wires" (page 78). Thus each *router* is directly connected to 6 others - the routers form a spherey-torusy thing, even if the individual processors don't.
+
+There are 4, 4k x 8 bit(?), memory chips associated with each processor chip, and 32 copies of this grouping of five chips (512 processors) per board, called a module. 16 modules are plugged into each backplane, and two backplanes form a 'rack'. Each rack thus has 16k processors, and 4 racks comprise the machine. Total heat dissipation is 12 Kw!
+
+The 4096 bits of memory do not store program, they only store data; so unlike other Lisp systems (and unlike what I'm envisaging), programs are not data.
+
+Instead, there is single a privileged node known as the 'host'. The host is not a node in the array; it's a physically separate machine with a conventional von Neumann architecture. The host broadcasts instructions to all processors; at every clock tick, each processor is performing the same instruction as every other. The clock speed is a surprisingly sedate 4MHz
+
+Each processor has 8 1 bit state flags and 2 1 bit registers. Each instruction causes it to read two bits from local memory, 1 flag, perform an operation on them, and write 1 bit back to memory and on flag. Thus the speed of the machine is actually 1.3 million instructions per second, not 4 million. Each instruction is 53 bits wide, comprising 12 bits each 'A' and 'B' address, 4 bits each read,  write and condition flags, (addressing 16 flags? but I thought he said there were only eight? - no, on page 74 he says 8, but on page 77 he says 16, and lists them), 1 bit condition sense, 8 bits 'memory truth table' (which I think is the op code determining which operation to use to modify memory), 8 bits 'flag truth table (similar, but for flags), 2 bits 'NEWS', which select which of four proximal neighbours to dispatch the result to.
+
+The 'condition flag' and 'condition sense' elements determine whether the processor should execute the instruction at all. If the flag identified by the condition flag address has the same value as the condition sense bit, then the instruction is executed; else it's treated as no-op.
+
+The reason the processors are so small is cost. Hillis preferred more, simpler processors than fewer, more complex ones.
+

notes/psh-architecture.txt

@@ -0,0 +1,50 @@
+The address space hinted at by using 64 bit cons-space and a 64 bit vector space containing objects each of whose length may be up to 1.4e20 bytes (2^64 of 64 bit words) is so large that a completely populated post-scarcity hardware machine can probably never be built. But that doesn't mean I'm wrong to specify such an address space: if we can make this architecture work for machines that can't (yet, anyway) be built, it will work for machines that can; and, changing the size of the pointers, which one might wish to do for storage economy, can be done with a few edits to consspaceobject.h.
+
+But, for the moment, let's discuss a potential 32 bit psh machine, and how it mght be built.
+
+## Pass one: a literal implementation
+
+Let's say a processing node comprises a two core 32 bit processor, such as an ARM, 4GB of RAM, and a custom router chip. On each node, core zero is theactual processing node, and core one handles communications. We arrange these on a printed circuit board that is 4 nodes by 4 nodes. Each node is connected to the nodes in front, behind, left and right by tracks on the board, and by pins to the nodes on the boards above and below. On the edges of the board, the tracks which have no 'next neighbour' lead to some sort of reasonably high speed bidirectional serial connection - I'm imagining optical fibre (or possibly pairs of optical fibre, one for each direction). These boards are assembled in stacks of four, and the 'up' pins on the top board and the 'down' pins (or sockets) on the bottom board connect to similar high speed serial connectors.
+
+This unit of 4 boards - 64 compute nodes - now forms both a logical and a physical cube. Let's call this cube module a crystal. Connect left to right, top to bottom and back to front, and you have a hypercube. But take another identical crystal, place it along side, connect the right of crystal A to the left of crystal B and the right of B to the left of A, leaving the tops and bottoms and lefts and rights of those crystals still connected to themselves, and you have a larger cuboid with more compute power and address space but slightly lower path efficiency. Continue in this manner until you have four layers of four crystals, and you have a compute unit of 4096 nodes. So the basic 4x4x4 building block - the 'crystal' - is a good place to start, and it is in some measure affordable to build - low numbers of thousands of pounds, even for a prototype.
+
+I imagine you could get away with a two layer board - you might need more, I'm no expert in these things, but the data tracks between nodes can all go on one layer, and then you can have a raster bus on the other layer which carries power, backup data, and common signals (if needed).
+
+So, each node has 4Gb of memory (or more, or less - 4Gb here is just illustrative). How is that memory organised? It could be treated as a heap, or it could be treated as four separate pages, but it must store four logical blocks of data: its own curated conspage, from which other nodes can request copies of objects; its own private housekeeping data (which can also be a conspage, but from which other nodes can't request copies); its cache of copies of data copied from other nodes; and its heap.
+
+Note that a crystal of 64 nodes each with 4Gb or RAM has a total memory of 256Gb, which easily fits onto a single current generation hard disk or SSD module. So I'm envisaging that either the nodes take turns to back up their memory to backing store all the time during normal operation. They (obviously) don't need to backup their cache, since they don't curate it.
+
+What does this cost? About £15 per processor chip, plus £30 for memory, plus the router, which is custom but probably still in tens of pounds, plus a share of the cost of the board; probably under £100 per node, or £6500 for the 'crystal'.
+
+## Pass two: a virtual implementation
+
+OK, OK, this cobe is a pretty concept, but let's get real. Using one core of each of 64 chips makes the architecture very concrete, but it's not necessarily efficient, either computationally or financially.
+
+64 core ARM chips already exist:
+
+1. [Qualcom Hydra](https://eltechs.com/hydra-is-the-name-of-qualcomms-64-core-arm-server-processor/) - 64 of 64 bit cores;
+2. [https://www.nextplatform.com/2016/09/01/details-emerge-chinas-64-core-arm-chip/) - frustratingly this does not say whether cores are 32 or 64 bit.
+
+There are other interesting chips which aren't strictly 64 core:
+
+1. [Cavium ThunderX](https://www.servethehome.com/exclusive-first-cavium-thunderx-dual-48-core-96-core-total-arm-benchmarks)/ - ARM; 96 cores, each 64 bit, in pairs of two, shipping now;
+2. [Sparc M8](https://www.servethehome.com/oracle-sparc-m8-released-32-cores-256-threads-5-0ghz/) - 32 of 64 bit cores each capable of 8 concurrent threads; shipping now.
+
+### Implementing the virtual hypercube
+
+Of course, these chips are not designed as hypercubes. We can't route our own network of physical connections into the chips, so our communications channels have to be virtual. But we can implement a communications channel as a pair of buffers, an 'upstream' buffer writable by the lower-numbered processor and readable by the higher, and a 'downstream' buffer writable by the higher numbered processor and readable by the lower. Each buffer should be at least big enough to write a whole cons page object into, optionally including a cryptographic signature if that is implemented. Each pair of buffers also needs at least four bits of flags, in order to be able, for each direction, to be able to signal
+
+0. Idle - the processor at the receiving end is idle and can accept work;
+1. Busy writing - the processor at the sending end is writing data to the buffer, which is not yet complete;
+2. Ready to read - the processor at the sending end has written data to the buffer, and it is complete;
+3. Read - the processor at the receiving end has read the current contents of the buffer.
+
+Thus I think it takes at least six clock ticks to write the buffer (set busy-writing, copy four 64 bit words into the buffer, set ready-to-read) and five to read it out - again, more if the messages are cryptographically signed - for an eleven clock tick transfer (the buffers may be allocated in main memory, but in practice they will always live in L2 cache). That's probably cheaper than making a stack frame. All communications channels within the 'crystal' cost exactly the same.
+
+But note! As in the virtual design, a single thread cannot at the same time execute user program and listen to communications from neighbours. So a node has to be able to run two threads. Whether that's two threads on a single core, or two cores per node, is a detail. But it makes the ThunderX and Spark M8 designs look particularly interesting.
+
+But note that there's one huge advantage that this single-chip virtual crystal has over the literal design: all cores access the same memory pool. Consequently, vector space objects never have to be passed hop, hop, hop across the communications network, all can be accessed directly; and to pass a list, all you have to pass is its first cons cell. So any S-Expression can be passed from any node to any of its 6 proximal neighbours in one hop.
+
+There are downsides to this, too. While communication inside the crystal is easier and quicker, communication between crystals becomes a lot more complex and I don't yet even have an idea how it might work. Also, contention on the main address bus, with 64 processors all trying to write to and read from the same memory at the same time, is likely to be horrendous, leading to much lower speed than the solution where each node has its own memory.
+
+On a cost side, you probably fit this all onto one printed circuit board as against the 4 of the 'literal' design; the single processor chip is likely to cost around £400; and the memory will probably be a little cheaper than on the literal design; and you don't need the custom routers, or the connection hardware, or the optical transcievers. So the cost probably looks more like £5,000.

src/conspage.c

@@ -1,4 +1,4 @@
-/**
+/*
  * conspage.c
  *
  * Setup and tear down cons pages, and (FOR NOW) do primitive 

src/consspaceobject.c

@@ -1,4 +1,4 @@
-/**
+/*
  *  consspaceobject.c
  *
  *  Structures common to all cons space objects.
@@ -98,7 +98,8 @@ void dump_object( FILE * output, struct cons_pointer pointer ) {
         break;
     case STRINGTV:
         fwprintf( output,
-                  L"\t\tString cell: character '%1c' (%1d) next at page %2d offset %3d, count %u\n",
+                  L"\t\tString cell: character '%c' (%d) next at page %d offset %d, count %u\n",
+                  cell.payload.string.character,
                   cell.payload.string.character,
                   cell.payload.string.cdr.page,
                   cell.payload.string.cdr.offset, cell.count );
@@ -108,7 +109,8 @@ void dump_object( FILE * output, struct cons_pointer pointer ) {
         break;
     case SYMBOLTV:
         fwprintf( output,
-                  L"\t\tSymbol cell: character '%1c' (%1d) next at page %2d offset %3d, count %u\n",
+                  L"\t\tSymbol cell: character '%c' (%d) next at page %d offset %d, count %u\n",
+                  cell.payload.string.character,
                   cell.payload.string.character,
                   cell.payload.string.cdr.page,
                   cell.payload.string.cdr.offset, cell.count );

src/equal.c

@@ -1,4 +1,4 @@
-/**
+/*
  * equal.c
  *
  * Checks for shallow and deep equality
@@ -37,6 +37,16 @@ bool same_type( struct cons_pointer a, struct cons_pointer b ) {
 
 }
 
+/**
+ * Some strings will be null terminated and some will be NIL terminated... ooops!
+ * @param string the string to test
+ * @return true if it's the end of a string.
+ */
+bool end_of_string( struct cons_pointer string ) {
+    return nilp( string ) ||
+        pointer2cell( string ).payload.string.character == '\0';
+}
+
 /**
  * Deep, and thus expensive, equality: true if these two objects have
  * identical structure, else false.
@@ -64,8 +74,10 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
             result =
                 cell_a->payload.string.character ==
                 cell_b->payload.string.character
-                && equal( cell_a->payload.string.cdr,
-                          cell_b->payload.string.cdr );
+                && ( equal( cell_a->payload.string.cdr,
+                            cell_b->payload.string.cdr )
+                     || ( end_of_string( cell_a->payload.string.cdr )
+                          && end_of_string( cell_b->payload.string.cdr ) ) );
             break;
         case INTEGERTV:
         case REALTV:
@@ -90,7 +102,7 @@ bool equal( struct cons_pointer a, struct cons_pointer b ) {
         /*
          * there's only supposed ever to be one T and one NIL cell, so each
          * should be caught by eq; equality of vector-space objects is a whole 
-         * other ball game so we won't deal with it now (and indeedmay never). 
+         * other ball game so we won't deal with it now (and indeed may never). 
          * I'm not certain what equality means for read and write streams, so
          * I'll ignore them, too, for now.
          */

src/init.c

@@ -1,4 +1,4 @@
-/**
+/*
  * init.c
  *
  * Start up and initialise the environement - just enough to get working
@@ -78,28 +78,30 @@ int main( int argc, char *argv[] ) {
     /*
      * primitive function operations
      */
+    bind_function( "add", &lisp_add );
+    bind_function( "apply", &lisp_apply );
     bind_function( "assoc", &lisp_assoc );
     bind_function( "car", &lisp_car );
     bind_function( "cdr", &lisp_cdr );
     bind_function( "cons", &lisp_cons );
     bind_function( "eq", &lisp_eq );
     bind_function( "equal", &lisp_equal );
+    bind_function( "eval", &lisp_eval );
+    bind_function( "multiply", &lisp_multiply );
     bind_function( "read", &lisp_read );
     bind_function( "print", &lisp_print );
+    bind_function( "progn", &lisp_progn );
+    bind_function( "subtract", &lisp_subtract );
     bind_function( "type", &lisp_type );
 
-    bind_function( "add", &lisp_add );
     bind_function( "+", &lisp_add );
-    bind_function( "multiply", &lisp_multiply );
     bind_function( "*", &lisp_multiply );
-    bind_function( "subtract", &lisp_subtract );
     bind_function( "-", &lisp_subtract );
-    bind_function( "apply", &lisp_apply );
 
     /*
      * primitive special forms
      */
-    bind_special( "eval", &lisp_eval );
+    bind_special( "cond", &lisp_cond );
     bind_special( "quote", &lisp_quote );
 
 

src/integer.c

@@ -1,4 +1,4 @@
-/**
+/*
  * integer.c
  *
  * functions for integer cells.

src/intern.c

@@ -1,4 +1,4 @@
-/**
+/*
  * intern.c
  *
  * For now this implements an oblist and shallow binding; local environments can
@@ -19,9 +19,11 @@
 
 #include <stdbool.h>
 
-#include "equal.h"
 #include "conspage.h"
 #include "consspaceobject.h"
+#include "equal.h"
+#include "lispops.h"
+#include "print.h"
 
 /**
  * The object list. What is added to this during system setup is 'global', that is, 
@@ -47,15 +49,29 @@ struct cons_pointer
 internedp( struct cons_pointer key, struct cons_pointer store ) {
     struct cons_pointer result = NIL;
 
-    for ( struct cons_pointer next = store;
-          nilp( result ) && consp( next );
-          next = pointer2cell( next ).payload.cons.cdr ) {
-        struct cons_space_object entry =
-            pointer2cell( pointer2cell( next ).payload.cons.car );
+    if ( symbolp( key ) ) {
+        for ( struct cons_pointer next = store;
+              nilp( result ) && consp( next );
+              next = pointer2cell( next ).payload.cons.cdr ) {
+            struct cons_space_object entry =
+                pointer2cell( pointer2cell( next ).payload.cons.car );
 
-        if ( equal( key, entry.payload.cons.car ) ) {
-            result = entry.payload.cons.car;
+            fputws( L"Internedp: checking whether `", stderr );
+            print( stderr, key );
+            fputws( L"` equals `", stderr );
+            print( stderr, entry.payload.cons.car );
+            fputws( L"`\n", stderr );
+
+            if ( equal( key, entry.payload.cons.car ) ) {
+                result = entry.payload.cons.car;
+            }
         }
+    } else {
+        fputws( L"`", stderr );
+        print( stderr, key );
+        fputws( L"` is a ", stderr );
+        print( stderr, c_type( key ) );
+        fputws( L", not a SYMB", stderr );
     }
 
     return result;

src/lispops.c

@@ -1,4 +1,4 @@
-/**
+/*
  * lispops.c
  *
  * List processing operations.
@@ -36,8 +36,6 @@
 
 /*
  * also to create in this section:
- * struct cons_pointer lisp_cond( struct cons_pointer args, struct cons_pointer env,
- struct stack_frame* frame);
  * struct cons_pointer lisp_let( struct cons_pointer args, struct cons_pointer env,
  struct stack_frame* frame);
  * struct cons_pointer lisp_mapcar( struct cons_pointer args, struct cons_pointer env,
@@ -73,6 +71,32 @@ struct cons_pointer c_cdr( struct cons_pointer arg ) {
 }
 
 
+/**
+ * Useful building block; evaluate this single form in the context of this
+ * parent stack frame and this environment.
+ * @param parent the parent stack frame.
+ * @param form the form to be evaluated.
+ * @param env the evaluation environment.
+ * @return the result of evaluating the form.
+ */
+struct cons_pointer eval_form( struct stack_frame *parent,
+                               struct cons_pointer form,
+                               struct cons_pointer env ) {
+    fputws( L"eval_form: ", stderr );
+    print( stderr, form );
+    fputws( L"\n", stderr );
+
+    struct cons_pointer result = NIL;
+    struct stack_frame *next = make_empty_frame( parent, env );
+    next->arg[0] = form;
+    inc_ref( next->arg[0] );
+    result = lisp_eval( next, env );
+    free_stack_frame( next );
+
+    return result;
+}
+
+
 /**
  * Internal guts of apply.
  * @param frame the stack frame, expected to have only one argument, a list
@@ -131,10 +155,29 @@ c_apply( struct stack_frame *frame, struct cons_pointer env ) {
     return result;
 }
 
+
+/**
+ * Get the Lisp type of the single argument.
+ * @param pointer a pointer to the object whose type is requested.
+ * @return As a Lisp string, the tag of the object which is at that pointer.
+ */
+struct cons_pointer c_type( struct cons_pointer pointer ) {
+    char *buffer = malloc( TAGLENGTH + 1 );
+    memset( buffer, 0, TAGLENGTH + 1 );
+    struct cons_space_object cell = pointer2cell( pointer );
+    strncpy( buffer, cell.tag.bytes, TAGLENGTH );
+
+    struct cons_pointer result = c_string_to_lisp_string( buffer );
+    free( buffer );
+
+    return result;
+}
+
+
 /**
  * (eval s_expr)
  *
- * Special form.
+ * function.
  * If s_expr is a number, NIL, or T, returns s_expr.
  * If s_expr is an unprotected string, returns the value that s_expr is bound
  * to in the evaluation environment (env).
@@ -366,24 +409,83 @@ lisp_print( struct stack_frame *frame, struct cons_pointer env ) {
 
 
 /**
- * Get the Lisp type of the single argument.
+ * Function: Get the Lisp type of the single argument.
  * @param frame My stack frame.
  * @param env My environment (ignored).
  * @return As a Lisp string, the tag of the object which is the argument.
  */
 struct cons_pointer
 lisp_type( struct stack_frame *frame, struct cons_pointer env ) {
-    char *buffer = malloc( TAGLENGTH + 1 );
-    memset( buffer, 0, TAGLENGTH + 1 );
-    struct cons_space_object cell = pointer2cell( frame->arg[0] );
-    strncpy( buffer, cell.tag.bytes, TAGLENGTH );
+    return c_type( frame->arg[0] );
+}
 
-    struct cons_pointer result = c_string_to_lisp_string( buffer );
-    free( buffer );
+
+/**
+ * Function; evaluate the forms which are listed in my single argument
+ * sequentially and return the value of the last. This function is called 'do'
+ * in some dialects of Lisp.
+ *
+ * @param frame My stack frame.
+ * @param env My environment (ignored).
+ * @return the value of the last form on the sequence which is my single
+ * argument.
+ */
+struct cons_pointer
+lisp_progn( struct stack_frame *frame, struct cons_pointer env ) {
+    struct cons_pointer remaining = frame->arg[0];
+    struct cons_pointer result = NIL;
+
+    while ( consp( remaining ) ) {
+        struct cons_space_object cell = pointer2cell( remaining );
+        result = eval_form( frame, cell.payload.cons.car, env );
+
+        remaining = cell.payload.cons.cdr;
+    }
 
     return result;
 }
 
+/**
+ * Special form: conditional. Each arg is expected to be a list; if the first
+ * item in such a list evaluates to non-NIL, the remaining items in that list
+ * are evaluated in turn and the value of the last returned. If no arg (clause)
+ * has a first element which evaluates to non NIL, then NIL is returned.
+ * @param frame My stack frame.
+ * @param env My environment (ignored).
+ * @return the value of the last form of the first successful clause.
+ */
+struct cons_pointer
+lisp_cond( struct stack_frame *frame, struct cons_pointer env ) {
+    struct cons_pointer result = NIL;
+    bool done = false;
+
+    for ( int i = 0; i < args_in_frame && !done; i++ ) {
+        struct cons_pointer clause_pointer = frame->arg[i];
+        fputws( L"Cond clause: ", stderr );
+        print( stderr, clause_pointer );
+
+        if ( consp( clause_pointer ) ) {
+            struct cons_space_object cell = pointer2cell( clause_pointer );
+
+            if ( !nilp( eval_form( frame, cell.payload.cons.car, env ) ) ) {
+                struct stack_frame *next = make_empty_frame( frame, env );
+                next->arg[0] = cell.payload.cons.cdr;
+                inc_ref( next->arg[0] );
+                result = lisp_progn( next, env );
+                done = true;
+            }
+        } else if ( nilp( clause_pointer ) ) {
+            done = true;
+        } else {
+            lisp_throw( c_string_to_lisp_string
+                        ( "Arguments to `cond` must be lists" ), frame );
+        }
+    }
+    /* TODO: if there are more than 8 clauses we need to continue into the
+     * remainder */
+
+    return result;
+}
 
 /**
  * TODO: make this do something sensible somehow.

src/lispops.h

@@ -19,6 +19,17 @@
  * Licensed under GPL version 2.0, or, at your option, any later version.
  */
 
+/*
+ * utilities
+ */
+
+/**
+ * Get the Lisp type of the single argument.
+ * @param pointer a pointer to the object whose type is requested.
+ * @return As a Lisp string, the tag of the object which is at that pointer.
+ */
+struct cons_pointer c_type( struct cons_pointer pointer );
+
 /*
  * special forms 
  */
@@ -49,7 +60,7 @@ struct cons_pointer lisp_read( struct stack_frame *frame,
 struct cons_pointer lisp_print( struct stack_frame *frame,
                                 struct cons_pointer env );
 /**
- * Get the Lisp type of the single argument.
+ * Function: Get the Lisp type of the single argument.
  * @param frame My stack frame.
  * @param env My environment (ignored).
  * @return As a Lisp string, the tag of the object which is the argument.
@@ -57,6 +68,32 @@ struct cons_pointer lisp_print( struct stack_frame *frame,
 struct cons_pointer
 lisp_type( struct stack_frame *frame, struct cons_pointer env );
 
+
+/**
+ * Function; evaluate the forms which are listed in my single argument 
+ * sequentially and return the value of the last. This function is called 'do'
+ * in some dialects of Lisp.
+ * 
+ * @param frame My stack frame.
+ * @param env My environment (ignored).
+ * @return the value of the last form on the sequence which is my single 
+ * argument.
+ */
+struct cons_pointer
+lisp_progn( struct stack_frame *frame, struct cons_pointer env );
+
+/**
+ * Special form: conditional. Each arg is expected to be a list; if the first 
+ * item in such a list evaluates to non-NIL, the remaining items in that list 
+ * are evaluated in turn and the value of the last returned. If no arg (clause) 
+ * has a first element which evaluates to non NIL, then NIL is returned.
+ * @param frame My stack frame.
+ * @param env My environment (ignored).
+ * @return the value of the last form of the first successful clause.
+ */
+struct cons_pointer
+lisp_cond( struct stack_frame *frame, struct cons_pointer env );
+
 /*
  * neither, at this stage, really 
  */

src/peano.c

@@ -1,4 +1,4 @@
-/**
+/*
  * peano.c
  *
  * Basic peano arithmetic

src/print.c

@@ -1,9 +1,8 @@
-/**
+/*
  * print.c
  *
  * First pass at a printer, for bootstrapping.
  *
- *
  * (c) 2017 Simon Brooke <simon@journeyman.cc>
  * Licensed under GPL version 2.0, or, at your option, any later version.
  */

src/read.c

@@ -1,4 +1,4 @@
-/**
+/*
  * read.c
  *
  * First pass at a reader, for bootstrapping.

src/real.c

@@ -1,7 +1,10 @@
 /*
- * To change this license header, choose License Headers in Project Properties.
- * To change this template file, choose Tools | Templates
- * and open the template in the editor.
+ * real.c
+ *
+ * functions for real number cells.
+ *
+ * (c) 2017 Simon Brooke <simon@journeyman.cc>
+ * Licensed under GPL version 2.0, or, at your option, any later version.
  */
 
 #include "conspage.h"

src/repl.c

@@ -1,8 +1,12 @@
 /*
- * To change this license header, choose License Headers in Project Properties.
- * To change this template file, choose Tools | Templates
- * and open the template in the editor.
+ * repl.c
+ *
+ * the read/eval/print loop
+ *
+ * (c) 2017 Simon Brooke <simon@journeyman.cc>
+ * Licensed under GPL version 2.0, or, at your option, any later version.
  */
+
 #include <stdbool.h>
 #include <stdio.h>
 #include <wchar.h>

src/stack.c

@@ -1,4 +1,4 @@
-/**
+/*
  * stack.c
  *
  * The Lisp evaluation stack.
@@ -153,7 +153,12 @@ void free_stack_frame( struct stack_frame *frame ) {
 void dump_frame( FILE * output, struct stack_frame *frame ) {
     fputws( L"Dumping stack frame\n", output );
     for ( int arg = 0; arg < args_in_frame; arg++ ) {
-        fwprintf( output, L"Arg %d:", arg );
+        struct cons_space_object cell = pointer2cell( frame->arg[arg] );
+
+        fwprintf( output, L"Arg %d:\t%c%c%c%c\t", arg,
+                  cell.tag.bytes[0],
+                  cell.tag.bytes[1], cell.tag.bytes[2], cell.tag.bytes[3] );
+
         print( output, frame->arg[arg] );
         fputws( L"\n", output );
     }

unit-tests/add.sh

@@ -6,14 +6,13 @@ actual=`echo "(add 2 3)" | target/psse 2> /dev/null | head -2 | tail -1`
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
-    exit 0
 else
     echo "Fail: expected '${expected}', got '${actual}'"
     exit 1
 fi
 
-expected='5.5000'
-actual=`echo "(add 2.5 3)" | target/psse 2> /dev/null | head -1`
+expected='5.500000'
+actual=`echo "(add 2.5 3)" | target/psse 2> /dev/null | head -2 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then

unit-tests/cond.sh

@@ -0,0 +1,24 @@
+#!/bin/bash
+
+expected='5'
+actual=`echo "(cond ((equal 2 2) 5))" | target/psse 2> /dev/null | head -2 | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+  echo "OK"
+else
+  echo "Fail: expected '${expected}', got '${actual}'"
+  exit 1
+fi
+
+expected='"should"'
+actual=`echo "(cond ((equal 2 3) \"shouldn't\")(t \"should\"))" | target/psse 2> /dev/null | head -2 | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+    exit 0
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    exit 1
+fi

unit-tests/eval-integer.sh

@@ -0,0 +1,12 @@
+#!/bin/bash
+
+expected='5'
+actual=`echo "(eval 5)" | target/psse 2> /dev/null | head -2 | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    exit 1
+fi

unit-tests/eval-quote-sexpr.sh

@@ -0,0 +1,12 @@
+#!/bin/bash
+
+expected='5'
+actual=`echo "(eval '(add 2 3))" | target/psse 2> /dev/null | head -2 | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    exit 1
+fi

unit-tests/eval-quote-symbol.sh

@@ -0,0 +1,12 @@
+#!/bin/bash
+
+expected='(Special form)'
+actual=`echo "(eval 'cond)" | target/psse 2> /dev/null | head -2 | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    exit 1
+fi

unit-tests/eval-real.sh

@@ -0,0 +1,17 @@
+#!/bin/bash
+
+# for this test, trailing zeros can be ignored
+expected='5.05'
+actual=`echo "(eval 5.05)" |\
+  target/psse 2> /dev/null |\
+  sed 's/0*$//' |\
+  head -2 |\
+  tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    exit 1
+fi

unit-tests/eval-string.sh

@@ -0,0 +1,12 @@
+#!/bin/bash
+
+expected='"5"'
+actual=`echo '(eval "5")' | target/psse 2> /dev/null | head -2 | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    exit 1
+fi

unit-tests/multiply.sh

@@ -0,0 +1,24 @@
+#!/bin/bash
+
+expected='6'
+actual=`echo "(multiply 2 3)" | target/psse 2> /dev/null | head -2 | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    exit 1
+fi
+
+expected='7.500000'
+actual=`echo "(multiply 2.5 3)" | target/psse 2> /dev/null | head -2 | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+    exit 0
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    exit 1
+fi

unit-tests/progn.sh

@@ -0,0 +1,24 @@
+#!/bin/bash
+
+expected='5'
+actual=`echo "(progn '((add 2 3)))" | target/psse 2> /dev/null | head -2 | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    exit 1
+fi
+
+expected='"foo"'
+actual=`echo "(progn '((add 2.5 3) \"foo\"))" | target/psse 2> /dev/null | head -2 | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+    exit 0
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    exit 1
+fi