Redone fixes to unit tests which I know I did this afternoon, so I've messed

up git somehow.

.gitignore

@@ -1,7 +1,7 @@
 
-*.d
+**/*.d
 
-*.o
+**/*.o
 
 target/
 
@@ -46,3 +46,12 @@ core
 .kdev4/
 
 post-scarcity.kdev4
+
+\.calva/
+\.clj-kondo/
+\.lsp/
+\.portal/
+\.settings/
+\.zig-cache/
+sq/
+tmp/

Doxyfile

@@ -162,7 +162,7 @@ FULL_PATH_NAMES        = YES
 # will be relative from the directory where doxygen is started.
 # This tag requires that the tag FULL_PATH_NAMES is set to YES.
 
-STRIP_FROM_PATH        = src/
+STRIP_FROM_PATH      = ../../
 
 # The STRIP_FROM_INC_PATH tag can be used to strip a user-defined part of the
 # path mentioned in the documentation of a class, which tells the reader which

Makefile

@@ -11,6 +11,8 @@ TESTS := $(shell find unit-tests -name *.sh)
 INC_DIRS := $(shell find $(SRC_DIRS) -type d)
 INC_FLAGS := $(addprefix -I,$(INC_DIRS))
 
+TMP_DIR ?= ./tmp
+
 INDENT_FLAGS := -nbad -bap -nbc -br -brf -brs -c33 -cd33 -ncdb -ce -ci4 -cli4 \
 -d0 -di1 -nfc1 -i4 -ip0 -l75 -lp -npcs \
 -npsl -nsc -nsob -nss -nut -prs -l79 -ts2
@@ -41,7 +43,7 @@ test: $(TESTS) Makefile $(TARGET)
 
 .PHONY: clean
 clean:
-	$(RM) $(TARGET) $(OBJS) $(DEPS) $(SRC_DIRS)/*~ $(SRC_DIRS)/*/*~ *~ core
+	$(RM) $(TARGET) $(OBJS) $(DEPS) $(SRC_DIRS)/*~ $(SRC_DIRS)/*/*~ $(TMP_DIR)/* *~ core
 
 repl:
 	$(TARGET) -p 2> psse.log

docs/Home.md

@@ -6,6 +6,10 @@ Work towards the implementation of a software system like that described in [Pos
 
 *Originally most of this documentation was on a wiki attached to the [GitHub project](https://github.com/simon-brooke/post-scarcity); when that was transferred to [my own foregejo instance](https://git.journeyman.cc/simon/post-scarcity) the wiki was copied. However, it's more convenient to keep documentation in the project with the source files, and version controlled in the same Git repository. So while both wikis still exist, they should no longer be considered canonical. The canonical version is in `/docs`, and is incorporated by [Doxygen](https://www.doxygen.nl/) into the generated documentation — which is generated into `/doc` using the command `make doc`.*
 
+## State of Play
+
+You can read about the current [state of play](md_home_2simon_2workspace_2post-scarcity_2docs_2state-of-play.html).
+
 ## AWFUL WARNING 1
 
 This does not work. It isn't likely to work any time soon. If you want to learn Lisp, don't start here; try Clojure, Scheme or Common Lisp (in which case I recommend Steel Bank Common Lisp). If you want to learn how Lisp works, still don't start here. This isn't ever going to be anything like a conventional Lisp environment.

docs/state-of-play.md

@@ -0,0 +1,366 @@
+# State of Play
+
+## 20260214
+
+### Memory leaks
+
+The amount I'm leaking memory is now down by an order of magnitude, but the problem is not fixed. 
+Better, not good enough. And although I'm aware of the amount to which Lisp objects are not being
+reclaimed, there may also be transient C objects — cheifly strings — which are also
+not being freed. This is an ongoing process. 
+
+But you'll remember that a week ago my base case was:
+
+> Allocation summary: allocated 19986; deallocated 245; not deallocated 19741.
+
+Now it's 
+
+> Allocation summary: allocated 1188; deallocated 10; not deallocated 1178.
+
+That is better.
+
+### Unit tests
+
+The unit test system got into a mess because the bignum tests are failing. But because I know
+some tests are failing, and the bignum problem feels so intractable that I don't want to 
+tackle it, I've been ignoring the fact that tests are failing; which means I've
+missed regressions — until I started to get an 'Attempt to take value of unbound symbol' 
+exception for `nil`, which is extremely serious and broke a lot of things.
+
+That arose out of work on the 'generalised key/value stores' feature, logged under 
+[#20260203](20260203), below. However, because I wasn't paying attention to failing tests, it
+took me a week to find and fix it.
+
+But I've fixed that one. And I've put a lot of work into [cleaning up the unit tests](https://git.journeyman.cc/simon/post-scarcity/commit/222368bf640a0b79d57322878dee42ed58b47bd6).
+There is more work to do on this.
+
+### Documentation
+
+I'm also gradually working through cleaning up documentation.
+
+### Regressions
+
+Meantime we have some regressions which are serious, and must be resolved.
+
+#### equals
+
+The core function `equals` is now failing, at least for integers. Also.
+
+```lisp
+(= 0.75 3/4)
+```
+
+fails because I've never implemented a method for it, which I ought.
+
+#### cond
+
+The current unit test for `cond` and that for `recursion` both fail but *I think* this is because `equals` is failing.
+
+#### rational arithmetic
+
+I have a horrible new regression in rational arithmetic which looks as though something is being freed when it shouldn't be.
+
+#### All tests failing as at 20260214
+
+As follows:
+
+1. unit-tests/bignum-expt.sh => (expt 2 61): Fail: expected '2305843009213693952', got ''
+2. unit-tests/bignum-expt.sh => (expt 2 64): Fail: expected '18446744073709551616', got ''
+3. unit-tests/bignum-expt.sh => (expt 2 65): Fail: expected '36893488147419103232', got ''
+4. unit-tests/bignum-print.sh => unit-tests/bignum-print.sh => printing 576460752303423488: Fail: expected '576460752303423488', got '0'
+5. unit-tests/bignum-print.sh => printing 1152921504606846976: Fail: expected '1152921504606846976', got '0'
+6. unit-tests/bignum-print.sh => printing 1152921504606846977: Fail: expected '1152921504606846977', got '1'
+7. unit-tests/bignum-print.sh => printing 1329227995784915872903807060280344576: Fail: expected '1329227995784915872903807060280344576', \n           got '0'
+8. unit-tests/bignum.sh => unit-tests/bignum.sh => Fail: expected '1,152,921,504,606,846,976', got '0'
+9. unit-tests/bignum-subtract.sh => unit-tests/bignum-subtract.sh => subtracting 1 from 1152921504606846976: Fail: expected '1152921504606846975', got '4294967295'
+10. unit-tests/bignum-subtract.sh => subtracting 1 from 1152921504606846977: Fail: expected '1152921504606846976', got '0'
+11. unit-tests/bignum-subtract.sh => subtracting 1 from 1152921504606846978: Fail: expected '1152921504606846977', got '1'
+12. unit-tests/bignum-subtract.sh => subtracting 1152921504606846977 from 1: Fail: expected '-1152921504606846976', got '0'
+13. unit-tests/bignum-subtract.sh => subtracting 10000000000000000000 from 20000000000000000000: Fail: expected '10000000000000000000', got '2313682944'
+14. unit-tests/cond.sh => unit-tests/cond.sh: cond with one clause... Fail: expected '5', got 'nil'
+15. unit-tests/memory.sh => Fail: expected '1188', got '10'
+16. unit-tests/ratio-addition.sh => Fail: expected '1/4', got 'Error: Unrecognised tag value 4539730 ( REE)'
+17. unit-tests/recursion.sh => Fail: expected 'nil 3,628,800', got ''
+
+### New master version
+
+I haven't done a 'release' of Post Scarcity since September 2021, because I've 
+been so despondent about the bignum problem. But actually a lot of this *is*
+usable, and it's at least sufficiently intereting that other people might want
+to play with it, and possibly even might fix some bugs.
+
+So I'm currently planning to release a new master before the end of this month,
+and publicise it.
+
+## 20260204
+
+### Testing what is leaking memory
+
+#### Analysis
+
+If you just start up and immediately abort the current build of psse, you get:
+
+> Allocation summary: allocated 19986; deallocated 245; not deallocated 19741.
+
+Allocation summaries from the current unit tests give the following ranges of values:
+
+|                 | Min   | Max   |      |
+| --------------- | ----- | ----- | ---- |
+| Allocated       | 19991 | 39009 |      |
+| Deallocated     |   238 |  1952 |      |
+| Not deallocated | 19741 | 37057 |      |
+
+The numbers go up broadly in sinc with one another — that is to say, broadly, as the number allocated rises, so do both the numbers deallocated and the numbers not deallocated. But not exactly.
+
+#### Strategy: what doesn't get cleaned up?
+
+Write a test wrapper which reads a file of forms, one per line, from standard input, and passes each in turn to a fresh invocation of psse, reporting the form and the allocation summary.
+
+```bash
+#1/bin/bash
+
+while IFS= read -r form; do
+    allocation=`echo ${form} | ../../target/psse 2>&1 | grep Allocation`
+    echo "* ${allocation}: ${form}"
+done
+```
+
+So, from this:
+
+* Allocation summary: allocated 19986; deallocated 245; not deallocated 19741.: 
+* Allocation summary: allocated 19990; deallocated 249; not deallocated 19741.: ()
+* Allocation summary: allocated 20019; deallocated 253; not deallocated 19766.: nil
+
+Allocating an empty list allocates four additional cells, all of which are deallocated. Allocating 'nil' allocates a further **29** cells, 25 of which are not deallocated. WTF?
+
+Following further work I have this, showing the difference added to the base case of cells allocated, cells deallocated, and, most critically, cells not deallocated.
+
+From this we see that reading and printing `nil` allocates an additional 33 cells, of which eight are not cleaned up. That's startling, and worrying.
+
+But the next row shows us that reading and printing an empty list costs only four cells, each of which is cleaned up. Further down the table we see that an empty map is also correctly cleaned up. Where we're leaking memory is in reading (or printing, although I doubt this) symbols, either atoms, numbers, or keywords (I haven't yet tried strings, but I expect they're similar.)
+
+| **Case**                          | **Delta Allocated** | **Delta Deallocated** | **Delta Not Deallocated** |
+| --------------------------------- | ------------------- | --------------------- | ------------------------- |
+| **Basecase**                      | 0                   | 0                     | 0                         |
+| **nil**                           | 33                  | 8                     | 25                        |
+| **()**                            | 4                   | 4                     | 0                         |
+| **(quote ())**                    | 39                  | 2                     | 37                        |
+| **(list )**                       | 37                  | 12                    | 25                        |
+| **(list 1)**                      | 47                  | 14                    | 33                        |
+| **(list 1 1)**                    | 57                  | 16                    | 41                        |
+| **(list 1 1 1)**                  | 67                  | 18                    | 49                        |
+| **(list 1 2 3)**                  | 67                  | 18                    | 49                        |
+| **(+)**                           | 36                  | 10                    | 26                        |
+| **(+ 1)**                         | 44                  | 12                    | 32                        |
+| **(+ 1 1)**                       | 53                  | 14                    | 39                        |
+| **(+ 1 1 1)**                     | 62                  | 16                    | 46                        |
+| **(+ 1 2 3)**                     | 62                  | 16                    | 46                        |
+| **(list 'a 'a 'a)**               | 151                 | 33                    | 118                       |
+| **(list 'a 'b 'c)**               | 151                 | 33                    | 118                       |
+| **(list :a :b :c)**               | 121                 | 15                    | 106                       |
+| **(list :alpha :bravo :charlie)** | 485                 | 15                    | 470                       |
+| **{}**                            | 6                   | 6                     | 0                         |
+| **{:z 0}**                        | 43                  | 10                    | 33                        |
+| **{:zero 0}**                     | 121                 | 10                    | 111                       |
+| **{:z 0 :o 1}**                   | 80                  | 11                    | 69                        |
+| **{:zero 0 :one 1}**              | 210                 | 14                    | 196                       |
+| **{:z 0 :o 1 :t 2}**              | 117                 | 12                    | 105                       |
+
+Looking at the entries, we see that
+
+1. each number read costs ten allocations, of which only two are successfully deallocated;
+2. the symbol `list` costs 33 cells, of which 25 are not deallocated, whereas the symbol `+` costs only one cell fewer, and an additional cell is not deallocated. So it doesn't seem that cell allocation scales with the length of the symbol;
+3. Keyword allocation does scale with the length of the keyword, apparently, since `(list :a :b :c)` allocates 121 and deallocates 15, while `(list :alpha :bravo :charlie)` allocates 485 and deallocates the same 15;
+4. The fact that both those two deallocate 15, and a addition of three numbers `(+ 1 2 3)` or `(+ 1 1 1)` deallocates 16 suggest to me that the list structure is being fully reclaimed but atoms are not being. 
+5. The atom `'a` costs more to read than the keyword `:a` because the reader macro is expanding `'a` to `(quote a)` behind the scenes.
+
+### The integer allocation bug
+
+Looking at what happens when we read a single digit  number, we get the following:
+
+```
+2
+Entering make_integer
+Allocated cell of type 'INTR' at 19, 507 
+make_integer: returning
+        INTR (1381256777) at page 19, offset 507 count 0
+                Integer cell: value 0, count 0
+Entering make_integer
+Allocated cell of type 'INTR' at 19, 508 
+make_integer: returning
+        INTR (1381256777) at page 19, offset 508 count 0
+                Integer cell: value 10, count 0
+Entering make_integer
+Allocated cell of type 'INTR' at 19, 509 
+make_integer: returning
+        INTR (1381256777) at page 19, offset 509 count 0
+                Integer cell: value 2, count 0
+Entering make_integer
+Allocated cell of type 'INTR' at 19, 510 
+make_integer: returning
+        INTR (1381256777) at page 19, offset 510 count 0
+                Integer cell: value 0, count 0
+Entering make_integer
+Allocated cell of type 'INTR' at 19, 506 
+make_integer: returning
+        INTR (1381256777) at page 19, offset 506 count 0
+                Integer cell: value 0, count 0
+Entering make_integer
+Allocated cell of type 'INTR' at 19, 505 
+make_integer: returning
+        INTR (1381256777) at page 19, offset 505 count 0
+                Integer cell: value 0, count 0
+Entering make_integer
+Allocated cell of type 'INTR' at 19, 504 
+make_integer: returning
+        INTR (1381256777) at page 19, offset 504 count 0
+                Integer cell: value 0, count 0
+
+Allocated cell of type 'STRG' at 19, 503 
+Freeing cell    STRG (1196577875) at page 19, offset 503 count 0
+                String cell: character '2' (50) with hash 0; next at page 0 offset 0, count 0
+                 value: "2"
+Freeing cell    INTR (1381256777) at page 19, offset 504 count 0
+                Integer cell: value 2, count 0
+2
+Allocated cell of type 'SYMB' at 19, 504 
+Allocated cell of type 'SYMB' at 19, 503 
+Allocated cell of type 'SYMB' at 19, 502 
+Allocated cell of type 'SYMB' at 19, 501 
+Freeing cell    SYMB (1112365395) at page 19, offset 501 count 0
+                Symbol cell: character '*' (42) with hash 485100; next at page 19 offset 502, count 0
+                 value: *in*
+Freeing cell    SYMB (1112365395) at page 19, offset 502 count 0
+                Symbol cell: character 'i' (105) with hash 11550; next at page 19 offset 503, count 0
+                 value: in*
+Freeing cell    SYMB (1112365395) at page 19, offset 503 count 0
+                Symbol cell: character 'n' (110) with hash 110; next at page 19 offset 504, count 0
+                 value: n*
+Freeing cell    SYMB (1112365395) at page 19, offset 504 count 0
+                Symbol cell: character '*' (42) with hash 0; next at page 0 offset 0, count 0
+                 value: *
+```
+
+Many things are worrying here.
+
+1. The only thing being freed here is the symbol to which the read stream is bound — and I didn't see where that got allocated, but we shouldn't be allocating and tearing down a symbol for every read! This implies that when I create a string with `c_string_to_lisp_string`, I need to make damn sure that that string is deallocated as soon as I'm done with it — and wherever I'm dealing with symbols which will be referred to repeatedly in `C` code, I need either
+   1.  to bind a global on the C side of the world, which will become messy;
+   2. or else write a hash function which returns, for a `C` string, the same value that the standard hashing function will return for the lexically equivalent `Lisp` string, so that I can search hashmap structures from C without having to allocate and deallocate a fresh copy of the `Lisp` string;
+   3. In reading numbers, I'm generating a fresh instance of `Lisp zero` and `Lisp ten`, each time `read_integer` is called, and I'm not deallocating them.
+   4. I am correctly deallocating the number I did read, though!
+
+## 20260203
+
+I'm consciously avoiding the bignum issue for now. My current thinking is that if the C code only handles 64 bit integers, and bignums have to be done in Lisp code, that's perfectly fine with me.
+
+### Hashmaps, assoc lists, and generalised key/value stores
+
+I now have the oblist working as a hashmap, and also hybrid assoc lists which incorporate hashmaps working. I don't 100% have consistent methods for reading stores which may be plain old assoc lists, new hybrid assoc lists, or hashmaps working but it isn't far off. This also takes me streets further towards doing hierarchies of hashmaps, allowing my namespace idea to work — and hybrid assoc lists provide a very sound basis for building environment structures.
+
+Currently all hashmaps are mutable, and my doctrine is that that is fixable when access control lists are actually implemented. 
+
+#### assoc
+
+The function `(assoc store key) => value` should be the standard way of getting a value out of a store.  
+
+#### put!
+
+The function `(put! store key value) => store` should become the standard way of setting a value in a store (of course, if the store is an assoc list or an immutable map, a new store will be returned which holds the additional key/value binding).
+
+### State of unit tests
+
+Currently:
+
+> Tested 45, passed 39, failed 6
+
+But the failures are as follows:
+```
+unit-tests/bignum-add.sh => checking a bignum was created: Fail
+unit-tests/bignum-add.sh => adding 1152921504606846977 to 1: Fail: expected 't', got 'nil'
+unit-tests/bignum-add.sh => adding 1 to 1152921504606846977: Fail: expected 't', got 'nil'
+unit-tests/bignum-add.sh => adding 1152921504606846977 to 1152921504606846977: Fail: expected 't', got 'nil'
+unit-tests/bignum-add.sh => adding 10000000000000000000 to 10000000000000000000: Fail: expected 't', got 'nil'
+unit-tests/bignum-add.sh => adding 1 to 1329227995784915872903807060280344576: Fail: expected 't', got 'nil'
+unit-tests/bignum-add.sh => adding 1 to 3064991081731777716716694054300618367237478244367204352: Fail: expected 't', got 'nil'
+unit-tests/bignum-expt.sh => (expt 2 60): Fail: expected '1152921504606846976', got '1'
+unit-tests/bignum-expt.sh => (expt 2 61): Fail: expected '2305843009213693952', got '2'
+unit-tests/bignum-expt.sh => (expt 2 64): Fail: expected '18446744073709551616', got '16'
+unit-tests/bignum-expt.sh => (expt 2 65): Fail: expected '36893488147419103232', got '32'
+unit-tests/bignum-print.sh => printing 1152921504606846976: Fail: expected '1152921504606846976', got '1'
+unit-tests/bignum-print.sh => printing 1152921504606846977: Fail: expected '1152921504606846977', got '2'
+unit-tests/bignum-print.sh => printing 1329227995784915872903807060280344576: Fail: expected '1329227995784915872903807060280344576', \n           got '1151321504605245376'
+unit-tests/bignum.sh => unit-tests/bignum.sh => Fail: expected '1,152,921,504,606,846,976', got '1'
+unit-tests/bignum-subtract.sh => unit-tests/bignum-subtract.sh => subtracting 1 from 1152921504606846976: Fail: expected '1152921504606846975', got '0'
+unit-tests/bignum-subtract.sh => subtracting 1 from 1152921504606846977: Fail: expected '1152921504606846976', got '1'
+unit-tests/bignum-subtract.sh => subtracting 1 from 1152921504606846978: Fail: expected '1152921504606846977', got '2'
+unit-tests/bignum-subtract.sh => subtracting 1152921504606846977 from 1: Fail: expected '-1152921504606846976', got '1'
+unit-tests/bignum-subtract.sh => subtracting 10000000000000000000 from 20000000000000000000: Fail: expected '10000000000000000000', got '-376293541461622793'
+unit-tests/memory.sh
+```
+
+In other words, all failures are in bignum arithmetic **except** that I still have a major memory leak due to not decrefing somewhere where I ought to.
+
+### Zig
+
+I've also experimented with autotranslating my C into Zig, but this failed. Although I don't think C is the right language for implementing my base Lisp in, it's what I've got; and until I can get some form of autotranslate to bootstrap me into some more modern systems language, I think I need to stick with it.
+
+## 20250704
+
+Right, I'm getting second and subsequent integer cells with negative values, which should not happen. This is probably the cause of (at least some of) the bignum problems. I need to find out why. This is (probably) fixable.
+
+```lisp
+:: (inspect 10000000000000000000)
+
+        INTR (1381256777) at page 3, offset 873 count 2
+                Integer cell: value 776627963145224192, count 2
+                BIGNUM! More at:
+        INTR (1381256777) at page 3, offset 872 count 1
+                Integer cell: value -8, count 1
+```
+
+Also, `print` is printing bignums wrong on ploughwright, but less wrong on mason, which implies a code difference. Investigate.
+
+## 20250314
+
+Thinking further about this, I think at least part of the problem is that I'm storing bignums as cons-space objects, which means that the integer representation I can store has to fit into the size of a cons pointer, which is 64 bits. Which means that to store integers larger than 64 bits I need chains of these objects.
+
+If I stored bignums in vector space, this problem would go away (especially as I have not implemented vector space yet). 
+
+However, having bignums in vector space would cause a churn of non-standard-sized objects in vector space, which would mean much more frequent garbage collection, which has to be mark-and-sweep because unequal-sized objects, otherwise you get heap fragmentation.
+
+So maybe I just have to put more work into debugging my cons-space bignums.
+
+Bother, bother.
+
+There are no perfect solutions.
+
+However however, it's only the node that's short on vector space which has to pause to do a mark and sweep. It doesn't interrupt any other node, because their reference to the object will remain the same, even if it is the 'home node' of the object which is sweeping. So all the node has to do is set its busy flag, do GC, and clear its busy flag, The rest of the system can just be carrying on as normal.
+
+So... maybe mark and sweep isn't the big deal I think it is?
+
+## 20250313
+
+OK, the 60 bit integer cell happens in `int128_to_integer` in `arith/integer.c`. It seems to be being done consistently; but there is no obvious reason. `MAX_INTEGER` is defined in `arith/peano.h`. I've changed both to use 63 bits, and this makes no change to the number of unit tests that fail.
+
+With this change, `(fact 21)`, which was previously printing nothing, now prints a value, `11,891,611,015,076,642,816`. However, this value is definitively wrong, should be `51,090,942,171,709,440,000`. But, I hadn't fixed the shift in `integer_to_string`; have now... still no change in number of failed tests...
+
+But `(fact 21)` gives a different wrong value, `4,974,081,987,435,560,960`. Factorial values returned by `fact` are correct (agree with SBCL running the same code) up to `(fact 20)`, with both 60 bit integer cells and 63 bit integer cells giving correct values.
+
+Uhhhmmm... but I'd missed two other places where I'd had the number of significant bits as a numeric literal. Fixed those and now `(fact 21)` does not return a printable answer at all, although the internal representation is definitely wrong. So we may be seeing why I chose 60 bits.
+
+Bother.
+
+## 20250312
+
+Printing of bignums definitely doesn't work; I'm not persuaded that reading of bignums works right either, and there are probably problems with bignum arithmetic too.
+
+The internal memory representation of a number rolls over from one cell to two cells at 1152921504606846976, and I'm not at all certain why it does because this is neither 2<sup>63</sup> nor 2<sup>64</sup>.
+
+|                |                      |      |
+| -------------- | -------------------- | ---- |
+| 2<sup>62</sup> | 4611686018427387904  |      |
+| 2<sup>63</sup> | 9223372036854775808  |      |
+| 2<sup>64</sup> | 18446744073709551616 |      |
+| Mystery number | 1152921504606846976  |      |
+
+In fact, our mystery number turns out (by inspection) to be 2<sup>60</sup>. But **why**?

lisp/fact.lisp

@@ -4,4 +4,6 @@
       (cond ((= n 1) 1)
         (t (* n (fact (- n 1)))))))
 
-(fact 1000)
+; (fact 1000)
+
+

lisp/slurp.lisp

@@ -1 +1 @@
-(slurp (set! f (open "http://www.journeyman.cc/")))
+(slurp (open "http://www.journeyman.cc/"))

post-scarcity.cbp

@@ -1,157 +0,0 @@
-<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
-<CodeBlocks_project_file>
-	<FileVersion major="1" minor="6" />
-	<Project>
-		<Option title="post-scarcity" />
-		<Option makefile_is_custom="1" />
-		<Option pch_mode="2" />
-		<Option compiler="gcc" />
-		<Build>
-			<Target title="Debug">
-				<Option output="bin/Debug/post-scarcity" prefix_auto="1" extension_auto="1" />
-				<Option object_output="obj/Debug/" />
-				<Option type="1" />
-				<Option compiler="gcc" />
-				<Compiler>
-					<Add option="-g" />
-				</Compiler>
-			</Target>
-			<Target title="Release">
-				<Option output="bin/Release/post-scarcity" prefix_auto="1" extension_auto="1" />
-				<Option object_output="obj/Release/" />
-				<Option type="1" />
-				<Option compiler="gcc" />
-				<Compiler>
-					<Add option="-O2" />
-				</Compiler>
-				<Linker>
-					<Add option="-s" />
-				</Linker>
-			</Target>
-		</Build>
-		<Compiler>
-			<Add option="-Wall" />
-		</Compiler>
-		<Unit filename="Makefile" />
-		<Unit filename="src/arith/integer.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="src/arith/integer.h" />
-		<Unit filename="src/arith/peano.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="src/arith/peano.h" />
-		<Unit filename="src/arith/ratio.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="src/arith/ratio.h" />
-		<Unit filename="src/arith/real.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="src/arith/real.h" />
-		<Unit filename="src/authorise.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="src/authorise.h" />
-		<Unit filename="src/debug.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="src/debug.h" />
-		<Unit filename="src/init.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="src/io/fopen.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="src/io/fopen.h" />
-		<Unit filename="src/io/io.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="src/io/io.h" />
-		<Unit filename="src/io/print.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="src/io/print.h" />
-		<Unit filename="src/io/read.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="src/io/read.h" />
-		<Unit filename="src/memory/conspage.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="src/memory/conspage.h" />
-		<Unit filename="src/memory/consspaceobject.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="src/memory/consspaceobject.h" />
-		<Unit filename="src/memory/cursor.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="src/memory/cursor.h" />
-		<Unit filename="src/memory/dump.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="src/memory/dump.h" />
-		<Unit filename="src/memory/hashmap.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="src/memory/hashmap.h" />
-		<Unit filename="src/memory/lookup3.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="src/memory/lookup3.h" />
-		<Unit filename="src/memory/stack.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="src/memory/stack.h" />
-		<Unit filename="src/memory/vectorspace.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="src/memory/vectorspace.h" />
-		<Unit filename="src/ops/equal.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="src/ops/equal.h" />
-		<Unit filename="src/ops/intern.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="src/ops/intern.h" />
-		<Unit filename="src/ops/lispops.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="src/ops/lispops.h" />
-		<Unit filename="src/ops/loop.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="src/ops/loop.h" />
-		<Unit filename="src/ops/meta.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="src/ops/meta.h" />
-		<Unit filename="src/repl.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="src/repl.h" />
-		<Unit filename="src/time/psse_time.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="src/time/psse_time.h" />
-		<Unit filename="src/utils.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="src/utils.h" />
-		<Unit filename="src/version.h" />
-		<Unit filename="utils_src/debugflags/debugflags.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="utils_src/readprintwc/readprintwc.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Unit filename="utils_src/tagvalcalc/tagvalcalc.c">
-			<Option compilerVar="CC" />
-		</Unit>
-		<Extensions>
-			<lib_finder disable_auto="1" />
-		</Extensions>
-	</Project>
-</CodeBlocks_project_file>

post-scarcity.cscope_file_list

@@ -1,58 +0,0 @@
-"/home/simon/workspace/post-scarcity/utils_src/readprintwc/readprintwc.c"
-"/home/simon/workspace/post-scarcity/src/memory/vectorspace.c"
-"/home/simon/workspace/post-scarcity/src/arith/peano.c"
-"/home/simon/workspace/post-scarcity/src/init.c"
-"/home/simon/workspace/post-scarcity/src/utils.h"
-"/home/simon/workspace/post-scarcity/src/ops/intern.h"
-"/home/simon/workspace/post-scarcity/src/arith/ratio.h"
-"/home/simon/workspace/post-scarcity/src/io/io.c"
-"/home/simon/workspace/post-scarcity/src/memory/conspage.h"
-"/home/simon/workspace/post-scarcity/src/time/psse_time.h"
-"/home/simon/workspace/post-scarcity/src/memory/cursor.h"
-"/home/simon/workspace/post-scarcity/src/memory/dump.h"
-"/home/simon/workspace/post-scarcity/src/ops/intern.c"
-"/home/simon/workspace/post-scarcity/src/memory/lookup3.c"
-"/home/simon/workspace/post-scarcity/src/io/fopen.h"
-"/home/simon/workspace/post-scarcity/src/version.h"
-"/home/simon/workspace/post-scarcity/src/memory/consspaceobject.h"
-"/home/simon/workspace/post-scarcity/src/ops/meta.h"
-"/home/simon/workspace/post-scarcity/src/arith/real.c"
-"/home/simon/workspace/post-scarcity/src/ops/loop.c"
-"/home/simon/workspace/post-scarcity/src/arith/integer.h"
-"/home/simon/workspace/post-scarcity/src/time/psse_time.c"
-"/home/simon/workspace/post-scarcity/src/memory/vectorspace.h"
-"/home/simon/workspace/post-scarcity/src/memory/hashmap.c"
-"/home/simon/workspace/post-scarcity/src/io/read.c"
-"/home/simon/workspace/post-scarcity/src/ops/lispops.h"
-"/home/simon/workspace/post-scarcity/src/ops/loop.h"
-"/home/simon/workspace/post-scarcity/src/memory/stack.h"
-"/home/simon/workspace/post-scarcity/utils_src/tagvalcalc/tagvalcalc.c"
-"/home/simon/workspace/post-scarcity/src/debug.c"
-"/home/simon/workspace/post-scarcity/src/io/read.h"
-"/home/simon/workspace/post-scarcity/src/ops/meta.c"
-"/home/simon/workspace/post-scarcity/src/memory/dump.c"
-"/home/simon/workspace/post-scarcity/src/repl.c"
-"/home/simon/workspace/post-scarcity/src/io/print.c"
-"/home/simon/workspace/post-scarcity/src/memory/hashmap.h"
-"/home/simon/workspace/post-scarcity/src/utils.c"
-"/home/simon/workspace/post-scarcity/src/io/io.h"
-"/home/simon/workspace/post-scarcity/src/memory/stack.c"
-"/home/simon/workspace/post-scarcity/utils_src/debugflags/debugflags.c"
-"/home/simon/workspace/post-scarcity/src/memory/consspaceobject.c"
-"/home/simon/workspace/post-scarcity/src/memory/conspage.c"
-"/home/simon/workspace/post-scarcity/src/memory/cursor.c"
-"/home/simon/workspace/post-scarcity/src/arith/ratio.c"
-"/home/simon/workspace/post-scarcity/Makefile"
-"/home/simon/workspace/post-scarcity/src/arith/peano.h"
-"/home/simon/workspace/post-scarcity/src/memory/lookup3.h"
-"/home/simon/workspace/post-scarcity/src/arith/real.h"
-"/home/simon/workspace/post-scarcity/src/ops/equal.c"
-"/home/simon/workspace/post-scarcity/src/ops/lispops.c"
-"/home/simon/workspace/post-scarcity/src/authorise.h"
-"/home/simon/workspace/post-scarcity/src/io/print.h"
-"/home/simon/workspace/post-scarcity/src/authorise.c"
-"/home/simon/workspace/post-scarcity/src/debug.h"
-"/home/simon/workspace/post-scarcity/src/arith/integer.c"
-"/home/simon/workspace/post-scarcity/src/ops/equal.h"
-"/home/simon/workspace/post-scarcity/src/repl.h"
-"/home/simon/workspace/post-scarcity/src/io/fopen.c"

post-scarcity.layout

@@ -1,15 +0,0 @@
-<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
-<CodeBlocks_layout_file>
-	<FileVersion major="1" minor="0" />
-	<ActiveTarget name="Debug" />
-	<File name="Makefile" open="1" top="0" tabpos="1" split="0" active="1" splitpos="0" zoom_1="0" zoom_2="0">
-		<Cursor>
-			<Cursor1 position="642" topLine="5" />
-		</Cursor>
-	</File>
-	<File name="src/arith/integer.c" open="1" top="1" tabpos="2" split="0" active="1" splitpos="0" zoom_1="0" zoom_2="0">
-		<Cursor>
-			<Cursor1 position="3454" topLine="156" />
-		</Cursor>
-	</File>
-</CodeBlocks_layout_file>

src/arith/integer.c

@@ -19,12 +19,13 @@
 #include <wchar.h>
 #include <wctype.h>
 
+#include "arith/integer.h"
+#include "arith/peano.h"
+#include "debug.h"
 #include "memory/conspage.h"
 #include "memory/consspaceobject.h"
-#include "debug.h"
 #include "ops/equal.h"
 #include "ops/lispops.h"
-#include "arith/peano.h"
 
 /**
  * hexadecimal digits for printing numbers.
@@ -34,19 +35,33 @@ const char *hex_digits = "0123456789ABCDEF";
 /*
  * Doctrine from here on in is that ALL integers are bignums, it's just
  * that integers less than 61 bits are bignums of one cell only.
+ * that integers less than 61 bits are bignums of one cell only. 
+ * TODO: why do I not have confidence to make this 64 bits?
  */
 
+ /*
+  * A small_int_cache array of pointers to the integers 0...23,
+  * used only by functions `acquire_integer(int64) => cons_pointer` and
+  * `release_integer(cons_pointer) => NULL` which, if the value desired is
+  * in the cache, supplies it from the cache, and, otherwise, calls 
+  * make_integer() and dec_ref() respectively. 
+  */
+
+#define SMALL_INT_LIMIT 24
+bool small_int_cache_initialised = false;
+struct cons_pointer small_int_cache[SMALL_INT_LIMIT];
+
  /**
- * Low level integer arithmetic, do not use elsewhere.
+  * Low level integer arithmetic, do not use elsewhere.
- *
+  *
- * @param c a pointer to a cell, assumed to be an integer cell;
+  * @param c a pointer to a cell, assumed to be an integer cell;
- * @param op a character representing the operation: expectedto be either
+  * @param op a character representing the operation: expected to be either
- * '+' or '*'; behaviour with other values is undefined.
+  * '+' or '*'; behaviour with other values is undefined.
- * @param is_first_cell true if this is the first cell in a bignum
+  * @param is_first_cell true if this is the first cell in a bignum
- * chain, else false.
+  * chain, else false.
- * \see multiply_integers
+  * \see multiply_integers
- * \see add_integers
+  * \see add_integers
- */
+  */
 __int128_t cell_value( struct cons_pointer c, char op, bool is_first_cell ) {
     long int val = nilp( c ) ? 0 : pointer2cell( c ).payload.integer.value;
 
@@ -75,10 +90,11 @@ struct cons_pointer make_integer( int64_t value, struct cons_pointer more ) {
     struct cons_pointer result = NIL;
     debug_print( L"Entering make_integer\n", DEBUG_ALLOC );
 
-    if ( integerp(more) && (pointer2cell( more ).payload.integer.value < 0))
+    if ( integerp( more )
-    {
+         && ( pointer2cell( more ).payload.integer.value < 0 ) ) {
-        printf("WARNING: negative value %" PRId64 " passed as `more` to `make_integer`\n", 
+        printf( "WARNING: negative value %" PRId64
-            pointer2cell( more ).payload.integer.value);
+                " passed as `more` to `make_integer`\n",
+                pointer2cell( more ).payload.integer.value );
     }
 
     if ( integerp( more ) || nilp( more ) ) {
@@ -94,11 +110,79 @@ struct cons_pointer make_integer( int64_t value, struct cons_pointer more ) {
 }
 
 /**
- * Overwrite the value field of the integer indicated by `new` with
+ * @brief Supply small valued integers from the small integer cache, if available.
+ *
+ * The pattern here is intended to be that, at least within this file, instead of
+ * calling make_integer when an integer is required and dec_ref when it's no longer 
+ * required, we call acquire_integer and release_integer respectively, in order to
+ * reduce allocation churn.
+ *
+ * In the initial implementation, acquire_integer supplies the integer from the 
+ * small integer cache if available, else calls make_integer. Later, more 
+ * sophisticated caching of integers which are currently in play may be enabled.
+ * 
+ * @param value the value of the integer desired.
+ * @param more if this value is a bignum, the rest (less significant bits) of the
+ * value.
+ * @return struct cons_pointer a pointer to the integer acquired.
+ */
+struct cons_pointer acquire_integer( int64_t value, struct cons_pointer more ) {
+    struct cons_pointer result;
+
+    if ( !nilp( more ) || value < 0 || value >= SMALL_INT_LIMIT ) {
+        debug_print
+            ( L"acquire_integer passing to make_integer (outside small int range)\n",
+              DEBUG_ALLOC );
+        result = make_integer( value, more );
+    } else {
+        if ( !small_int_cache_initialised ) {
+            for ( int64_t i = 0; i < SMALL_INT_LIMIT; i++ ) {
+                small_int_cache[i] = make_integer( i, NIL );
+                pointer2cell( small_int_cache[i] ).count = UINT32_MAX;  // lock it in so it can't be GC'd
+            }
+            small_int_cache_initialised = true;
+            debug_print( L"small_int_cache initialised.\n", DEBUG_ALLOC );
+        }
+
+        debug_printf( DEBUG_ALLOC, L"acquire_integer: returning %" PRId64 "\n",
+                      value );
+        result = small_int_cache[value];
+    }
+    return result;
+}
+
+/**
+ * @brief if the value of p is less than the size of the small integer cache
+ * (and thus it was presumably supplied from there), suppress dec_ref.
+ *
+ * **NOTE THAT** at this stage it's still safe to dec_ref an arbitrary integer,
+ * because those in the cache are locked and can't be dec_refed.
+ * 
+ * @param p a pointer, expected to be to an integer.
+ */
+void release_integer( struct cons_pointer p ) {
+    struct cons_space_object o = pointer2cell( p );
+    if ( !integerp( p ) ||      // what I've been passed isn't an integer;
+         !nilp( o.payload.integer.more ) || // or it's a bignum;
+         o.payload.integer.value >= SMALL_INT_LIMIT ||  // or it's bigger than the small int cache limit;
+         !eq( p, small_int_cache[o.payload.integer.value] ) // or it's simply not the copy in the cache...
+         ) {
+        dec_ref( p );
+    } else {
+        debug_printf( DEBUG_ALLOC, L"release_integer: releasing %" PRId64 "\n",
+                      o.payload.integer.value );
+    }
+}
+
+
+/**
+ * @brief Overwrite the value field of the integer indicated by `new` with
  * the least significant INTEGER_BITS bits of `val`, and return the
  * more significant bits (if any) right-shifted by INTEGER_BITS places.
- * Destructive, primitive, do not use in any context except primitive 
+ * 
- * operations on integers.
+ * Destructive, primitive, DO NOT USE in any context except primitive 
+ * operations on integers. The value passed as `new` MUST be constructed
+ * with `make_integer`, NOT acquired with `acquire_integer`.
  *
  * @param val the value to represent;
  * @param less_significant the less significant words of this bignum, if any,
@@ -122,7 +206,7 @@ __int128_t int128_to_integer( __int128_t val,
     }
 
     struct cons_space_object *newc = &pointer2cell( new );
-    newc->payload.integer.value = (int64_t)val;
+    newc->payload.integer.value = ( int64_t ) val;
 
     if ( integerp( less_significant ) ) {
         struct cons_space_object *lsc = &pointer2cell( less_significant );
@@ -133,25 +217,6 @@ __int128_t int128_to_integer( __int128_t val,
     return carry;
 }
 
-struct cons_pointer make_integer_128( __int128_t val,
-                                      struct cons_pointer less_significant ) {
-    struct cons_pointer result = NIL;
-
-    do {
-        if ( MAX_INTEGER >= val ) {
-            result = make_integer( ( long int ) val, less_significant );
-        } else {
-            less_significant =
-                make_integer( ( long int ) val & MAX_INTEGER,
-                              less_significant );
-            val = val * INT_CELL_BASE;
-        }
-
-    } while ( nilp( result ) );
-
-    return result;
-}
-
 /**
  * Return a pointer to an integer representing the sum of the integers
  * pointed to by `a` and `b`. If either isn't an integer, will return nil.
@@ -180,7 +245,7 @@ struct cons_pointer add_integers( struct cons_pointer a,
         while ( !nilp( a ) || !nilp( b ) || carry != 0 ) {
             __int128_t av = cell_value( a, '+', is_first_cell );
             __int128_t bv = cell_value( b, '+', is_first_cell );
-            __int128_t rv = av + bv + carry;
+            __int128_t rv = ( av + bv ) + carry;
 
             debug_print( L"add_integers: av = ", DEBUG_ARITH );
             debug_print_128bit( av, DEBUG_ARITH );
@@ -192,17 +257,23 @@ struct cons_pointer add_integers( struct cons_pointer a,
             debug_print_128bit( rv, DEBUG_ARITH );
             debug_print( L"\n", DEBUG_ARITH );
 
-            struct cons_pointer new = make_integer( 0, NIL );
+            if ( carry == 0 && ( rv >= 0 || rv < SMALL_INT_LIMIT ) ) {
-            carry = int128_to_integer( rv, cursor, new );
+                result =
-            cursor = new;
+                    acquire_integer( ( int64_t ) ( rv & 0xffffffff ), NIL );
+                break;
+            } else {
+                struct cons_pointer new = make_integer( 0, NIL );
+                carry = int128_to_integer( rv, cursor, new );
+                cursor = new;
 
-            if ( nilp( result ) ) {
+                if ( nilp( result ) ) {
-                result = cursor;
+                    result = cursor;
+                }
+
+                a = pointer2cell( a ).payload.integer.more;
+                b = pointer2cell( b ).payload.integer.more;
+                is_first_cell = false;
             }
-
-            a = pointer2cell( a ).payload.integer.more;
-            b = pointer2cell( b ).payload.integer.more;
-            is_first_cell = false;
         }
     }
 
@@ -213,32 +284,45 @@ struct cons_pointer add_integers( struct cons_pointer a,
     return result;
 }
 
+// TODO: I have really no idea what I was trying to do here, or why it could possibly be a good idea.
 struct cons_pointer base_partial( int depth ) {
     struct cons_pointer result = NIL;
 
+    debug_printf( DEBUG_ARITH, L"base_partial: depth = %d\n", depth );
+
     for ( int i = 0; i < depth; i++ ) {
-        result = make_integer( 0, result );
+        result = acquire_integer( 0, result );
     }
 
     return result;
 }
 
 /**
- * destructively modify this `partial` by appending this `digit`.
+ * @brief Return a copy of this `partial` with this `digit` appended.
+ *
+ * @param partial the more significant bits of a possible bignum.
+ * @param digit the less significant bits of that possible bignum. NOTE: the
+ * name `digit` is technically correct but possibly misleading, because the
+ * numbering system here is base INT_CELL_BASE, currently x0fffffffffffffffL
  */
-struct cons_pointer append_digit( struct cons_pointer partial,
+struct cons_pointer append_cell( struct cons_pointer partial,
-                                  struct cons_pointer digit ) {
+                                 struct cons_pointer digit ) {
-    struct cons_pointer c = partial;
+    struct cons_space_object cell = pointer2cell( partial );
+    // TODO: I should recursively copy the whole bignum chain, because
+    // we're still destructively modifying the end of it.
+    struct cons_pointer c = make_integer( cell.payload.integer.value,
+                                          cell.payload.integer.more );
     struct cons_pointer result = partial;
 
     if ( nilp( partial ) ) {
         result = digit;
     } else {
+        // find the last digit in the chain...
         while ( !nilp( pointer2cell( c ).payload.integer.more ) ) {
             c = pointer2cell( c ).payload.integer.more;
         }
 
-        ( &pointer2cell( c ) )->payload.integer.more = digit;
+        ( pointer2cell( c ) ).payload.integer.more = digit;
     }
     return result;
 }
@@ -258,7 +342,7 @@ struct cons_pointer append_digit( struct cons_pointer partial,
  */
 struct cons_pointer multiply_integers( struct cons_pointer a,
                                        struct cons_pointer b ) {
-    struct cons_pointer result = make_integer( 0, NIL );
+    struct cons_pointer result = acquire_integer( 0, NIL );
     bool neg = is_negative( a ) != is_negative( b );
     bool is_first_b = true;
     int i = 0;
@@ -299,16 +383,19 @@ struct cons_pointer multiply_integers( struct cons_pointer a,
                 /* if xj exceeds one digit, break it into the digit dj and
                  * the carry */
                 carry = xj >> INTEGER_BIT_SHIFT;
-                struct cons_pointer dj = make_integer( xj & MAX_INTEGER, NIL );
+                struct cons_pointer dj =
+                    acquire_integer( xj & MAX_INTEGER, NIL );
 
-                /* destructively modify ri by appending dj */
+                replace_integer_p( ri, append_cell( ri, dj ) );
-                ri = append_digit( ri, dj );
+                // struct cons_pointer new_ri = append_cell( ri, dj );
+                // release_integer( ri); 
+                // ri = new_ri;
             }                   /* end for bj */
 
-            /* if carry is not equal to zero, append it as a final digit
+            /* if carry is not equal to zero, append it as a final cell
              * to ri */
             if ( carry != 0 ) {
-                ri = append_digit( ri, make_integer( carry, NIL ) );
+                replace_integer_i( ri, carry )
             }
 
             /* add ri to result */
@@ -333,13 +420,24 @@ 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 ) {
     wint_t character = btowc( hex_digits[digit] );
-    return ( digits % 3 == 0 ) ?
+    debug_printf( DEBUG_IO,
-        make_string( L',', make_string( character,
+                  L"integer_to_string_add_digit: digit is %d, digits is %d; returning: ",
-                                        tail ) ) :
+                  digit, digits );
+    struct cons_pointer r =
+        ( digits % 3 == 0 ) ? make_string( L',', make_string( character,
+                                                              tail ) ) :
         make_string( character, tail );
+
+    debug_print_object( r, DEBUG_IO );
+    debug_println( DEBUG_IO );
+
+    return r;
 }
 
 /**
+ * @brief return a string representation of this integer, which may be a
+ * bignum.
+ *
  * The general principle of printing a bignum is that you print the least
  * significant digit in whatever base you're dealing with, divide through
  * by the base, print the next, and carry on until you've none left.
@@ -349,6 +447,9 @@ struct cons_pointer integer_to_string_add_digit( int digit, int digits,
  * object to the next. 64 bit integers don't align with decimal numbers, so
  * when we get to the last digit from one integer cell, we have potentially
  * to be looking to the next. H'mmmm.
+ *
+ * @param int_pointer cons_pointer to the integer to print,
+ * @param base the base to print it in.
  */
 struct cons_pointer integer_to_string( struct cons_pointer int_pointer,
                                        int base ) {
@@ -369,7 +470,8 @@ struct cons_pointer integer_to_string( struct cons_pointer int_pointer,
             while ( accumulator > 0 || !nilp( next ) ) {
                 if ( accumulator < MAX_INTEGER && !nilp( next ) ) {
                     accumulator +=
-                        ( pointer2cell( next ).payload.integer.value % INT_CELL_BASE );
+                        ( pointer2cell( next ).payload.integer.value %
+                          INT_CELL_BASE );
                     next = pointer2cell( next ).payload.integer.more;
                 }
                 int offset = ( int ) ( accumulator % base );

src/arith/integer.h

@@ -14,8 +14,15 @@
 #include <stdbool.h>
 #include <stdint.h>
 
+#define replace_integer_i(p,i) {struct cons_pointer __p = acquire_integer(i,NIL); release_integer(p); p = __p;}
+#define replace_integer_p(p,q) {struct cons_pointer __p = p; release_integer( p);  p = q;}
+
 struct cons_pointer make_integer( int64_t value, struct cons_pointer more );
 
+struct cons_pointer acquire_integer( int64_t value, struct cons_pointer more );
+
+void release_integer( struct cons_pointer p );
+
 struct cons_pointer add_integers( struct cons_pointer a,
                                   struct cons_pointer b );
 

src/arith/peano.h

@@ -7,11 +7,12 @@
  * Licensed under GPL version 2.0, or, at your option, any later version.
  */
 
-#include "consspaceobject.h"
 
 #ifndef PEANO_H
 #define PEANO_H
 
+#include "memory/consspaceobject.h"
+
 /**
  * The maximum value we will allow in an integer cell: one less than 2^60:
  * (let ((s (make-string-output-stream)))

src/arith/ratio.c

@@ -45,31 +45,36 @@ int64_t least_common_multiple( int64_t m, int64_t n ) {
 
 struct cons_pointer simplify_ratio( struct cons_pointer pointer ) {
     struct cons_pointer result = pointer;
-    struct cons_space_object cell = pointer2cell( pointer );
-    struct cons_space_object dividend =
-        pointer2cell( cell.payload.ratio.dividend );
-    struct cons_space_object divisor =
-        pointer2cell( cell.payload.ratio.divisor );
 
-    if ( divisor.payload.integer.value == 1 ) {
+    if ( ratiop( pointer ) ) {
-        result = pointer2cell( pointer ).payload.ratio.dividend;
+        struct cons_space_object cell = pointer2cell( pointer );
-    } else {
+        struct cons_space_object dividend =
-        if ( ratiop( pointer ) ) {
+            pointer2cell( cell.payload.ratio.dividend );
+        struct cons_space_object divisor =
+            pointer2cell( cell.payload.ratio.divisor );
+
+        if ( divisor.payload.integer.value == 1 ) {
+            result = pointer2cell( pointer ).payload.ratio.dividend;
+        } else {
             int64_t ddrv = dividend.payload.integer.value,
                 drrv = divisor.payload.integer.value,
                 gcd = greatest_common_divisor( ddrv, drrv );
 
             if ( gcd > 1 ) {
                 if ( drrv / gcd == 1 ) {
-                    result = make_integer( ddrv / gcd, NIL );
+                    result = acquire_integer( ddrv / gcd, NIL );
                 } else {
+                    debug_printf( DEBUG_ARITH,
+                                  L"simplify_ratio: %ld/%ld => %ld/%ld\n",
+                                  ddrv, drrv, ddrv / gcd, drrv / gcd );
                     result =
-                        make_ratio( make_integer( ddrv / gcd, NIL ),
+                        make_ratio( acquire_integer( ddrv / gcd, NIL ),
-                                    make_integer( drrv / gcd, NIL ) );
+                                    acquire_integer( drrv / gcd, NIL ) );
                 }
             }
         }
     }
+    // TODO: else throw exception?
 
     return result;
 
@@ -110,23 +115,28 @@ struct cons_pointer add_ratio_ratio( struct cons_pointer arg1,
                       m1, m2 );
 
         if ( dr1v == dr2v ) {
-            r = make_ratio( make_integer( dd1v + dd2v, NIL ),
+            r = make_ratio( acquire_integer( dd1v + dd2v, NIL ),
                             cell1.payload.ratio.divisor );
         } else {
-            struct cons_pointer dd1vm = make_integer( dd1v * m1, NIL ),
+            struct cons_pointer dd1vm = acquire_integer( dd1v * m1, NIL ),
-                dr1vm = make_integer( dr1v * m1, NIL ),
+                dr1vm = acquire_integer( dr1v * m1, NIL ),
-                dd2vm = make_integer( dd2v * m2, NIL ),
+                dd2vm = acquire_integer( dd2v * m2, NIL ),
-                dr2vm = make_integer( dr2v * m2, NIL ),
+                dr2vm = acquire_integer( dr2v * m2, NIL ),
                 r1 = make_ratio( dd1vm, dr1vm ),
                 r2 = make_ratio( dd2vm, dr2vm );
 
             r = add_ratio_ratio( r1, r2 );
 
+            if ( !eq( r, r1 ) ) {
+                dec_ref( r1 );
+            }
+            if ( !eq( r, r2 ) ) {
+                dec_ref( r2 );
+            }
+
             /* because the references on dd1vm, dr1vm, dd2vm and dr2vm were
              * never incremented except when making r1 and r2, decrementing
              * r1 and r2 should be enought to garbage collect them. */
-            dec_ref( r1 );
-            dec_ref( r2 );
         }
 
         result = simplify_ratio( r );
@@ -162,12 +172,12 @@ struct cons_pointer add_integer_ratio( struct cons_pointer intarg,
 
     if ( integerp( intarg ) && ratiop( ratarg ) ) {
         // TODO: not longer works
-        struct cons_pointer one = make_integer( 1, NIL ),
+        struct cons_pointer one = acquire_integer( 1, NIL ),
             ratio = make_ratio( intarg, one );
 
         result = add_ratio_ratio( ratio, ratarg );
 
-        dec_ref( one );
+        release_integer( one );
         dec_ref( ratio );
     } else {
         result =
@@ -231,11 +241,14 @@ struct cons_pointer multiply_ratio_ratio( struct
             pointer2cell( cell2.payload.ratio.divisor ).payload.integer.value,
             ddrv = dd1v * dd2v, drrv = dr1v * dr2v;
 
-        struct cons_pointer unsimplified =
+        struct cons_pointer dividend = acquire_integer( ddrv, NIL );
-            make_ratio( make_integer( ddrv, NIL ),
+        struct cons_pointer divisor = acquire_integer( drrv, NIL );
-                        make_integer( drrv, NIL ) );
+        struct cons_pointer unsimplified = make_ratio( dividend, divisor );
         result = simplify_ratio( unsimplified );
 
+        release_integer( dividend );
+        release_integer( divisor );
+
         if ( !eq( unsimplified, result ) ) {
             dec_ref( unsimplified );
         }
@@ -261,12 +274,11 @@ struct cons_pointer multiply_integer_ratio( struct cons_pointer intarg,
 
     if ( integerp( intarg ) && ratiop( ratarg ) ) {
         // TODO: no longer works; fix
-        struct cons_pointer one = make_integer( 1, NIL ),
+        struct cons_pointer one = acquire_integer( 1, NIL ),
             ratio = make_ratio( intarg, one );
         result = multiply_ratio_ratio( ratio, ratarg );
 
-        dec_ref( one );
+        release_integer( one );
-        dec_ref( ratio );
     } else {
         result =
             throw_exception( c_string_to_lisp_string
@@ -307,23 +319,32 @@ struct cons_pointer make_ratio( struct cons_pointer dividend,
     if ( integerp( dividend ) && integerp( divisor ) ) {
         inc_ref( dividend );
         inc_ref( divisor );
-        result = allocate_cell( RATIOTV );
+        struct cons_pointer unsimplified = allocate_cell( RATIOTV );
-        struct cons_space_object *cell = &pointer2cell( result );
+        struct cons_space_object *cell = &pointer2cell( unsimplified );
         cell->payload.ratio.dividend = dividend;
         cell->payload.ratio.divisor = divisor;
+
+        result = simplify_ratio( unsimplified );
+        if ( !eq( result, unsimplified ) ) {
+            dec_ref( unsimplified );
+        }
     } else {
         result =
             throw_exception( c_string_to_lisp_string
                              ( L"Dividend and divisor of a ratio must be integers" ),
                              NIL );
     }
+    // debug_print( L"make_ratio returning:\n", DEBUG_ARITH);
     debug_dump_object( result, DEBUG_ARITH );
 
     return result;
 }
 
 /**
- * True if a and be are identical ratios, else false.
+ * True if a and be are identical rationals, else false.
+ *
+ * TODO: we need ways of checking whether rationals are equal
+ * to floats and to integers.
  */
 bool equal_ratio_ratio( struct cons_pointer a, struct cons_pointer b ) {
     bool result = false;

src/debug.c

@@ -1,4 +1,4 @@
-/**
+/*
  * debug.c
  *
  * Better debug log messages.
@@ -25,13 +25,17 @@
 #include "io/print.h"
 
 /**
- * the controlling flags for `debug_print`; set in `init.c`, q.v.
+ * @brief the controlling flags for `debug_print`; set in `init.c`, q.v.
+ *
+ * Interpreted as a set o binary flags. The values are controlled by macros 
+ * with names 'DEBUG_[A_Z]*' in `debug.h`, q.v.
  */
 int verbosity = 0;
 
 /**
- * print this debug `message` to stderr, if `verbosity` matches `level`.
+ * @brief print this debug `message` to stderr, if `verbosity` matches `level`.
- * `verbosity is a set of flags, see debug_print.h; so you can
+ *
+ * `verbosity` is a set of flags, see debug_print.h; so you can
  * turn debugging on for only one part of the system.
  */
 void debug_print( wchar_t *message, int level ) {
@@ -44,6 +48,11 @@ void debug_print( wchar_t *message, int level ) {
 }
 
 /**
+ * @brief print a 128 bit integer value to stderr, if `verbosity` matches `level`.
+ *
+ * `verbosity` is a set of flags, see debug_print.h; so you can
+ * turn debugging on for only one part of the system.
+ *
  * stolen from https://stackoverflow.com/questions/11656241/how-to-print-uint128-t-number-using-gcc
  */
 void debug_print_128bit( __int128_t n, int level ) {
@@ -68,8 +77,9 @@ void debug_print_128bit( __int128_t n, int level ) {
 }
 
 /**
- * print a line feed to stderr, if `verbosity` matches `level`.
+ * @brief print a line feed to stderr, if `verbosity` matches `level`.
- * `verbosity is a set of flags, see debug_print.h; so you can
+ *
+ * `verbosity` is a set of flags, see debug_print.h; so you can
  * turn debugging on for only one part of the system.
  */
 void debug_println( int level ) {
@@ -83,8 +93,10 @@ void debug_println( int level ) {
 
 
 /**
- * `wprintf` adapted for the debug logging system. Print to stderr only
+ * @brief `wprintf` adapted for the debug logging system. 
- * `verbosity` matches `level`. All other arguments as for `wprintf`.
+ *
+ * Print to stderr only if `verbosity` matches `level`. All other arguments
+ * as for `wprintf`.
  */
 void debug_printf( int level, wchar_t *format, ... ) {
 #ifdef DEBUG
@@ -98,8 +110,10 @@ void debug_printf( int level, wchar_t *format, ... ) {
 }
 
 /**
- * print the object indicated by this `pointer` to stderr, if `verbosity`
+ * @brief print the object indicated by this `pointer` to stderr, if `verbosity`
- * matches `level`.`verbosity is a set of flags, see debug_print.h; so you can
+ * matches `level`.
+ *
+ * `verbosity` is a set of flags, see debug_print.h; so you can
  * turn debugging on for only one part of the system.
  */
 void debug_print_object( struct cons_pointer pointer, int level ) {
@@ -114,7 +128,10 @@ void debug_print_object( struct cons_pointer pointer, int level ) {
 }
 
 /**
- * Like `dump_object`, q.v., but protected by the verbosity mechanism.
+ * @brief Like `dump_object`, q.v., but protected by the verbosity mechanism.
+ *
+ * `verbosity` is a set of flags, see debug_print.h; so you can
+ * turn debugging on for only one part of the system.
  */
 void debug_dump_object( struct cons_pointer pointer, int level ) {
 #ifdef DEBUG

src/debug.h

@@ -1,4 +1,4 @@
-/**
+/*
  * debug.h
  *
  * Better debug log messages.
@@ -13,14 +13,67 @@
 #ifndef __debug_print_h
 #define __debug_print_h
 
+/**
+ * @brief Print messages debugging memory allocation. 
+ *
+ * Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
+ */
 #define DEBUG_ALLOC 1
+
+/**
+ * @brief Print messages debugging arithmetic operations.
+ * 
+ * Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
+ */
 #define DEBUG_ARITH 2
+
+/**
+ * @brief Print messages debugging symbol binding.
+ * 
+ * Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
+ */
 #define DEBUG_BIND 4
+
+/**
+ * @brief Print messages debugging bootstrapping and teardown.
+ * 
+ * Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
+ */
 #define DEBUG_BOOTSTRAP 8
+
+/**
+ * @brief Print messages debugging evaluation.
+ * 
+ * Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
+ */
 #define DEBUG_EVAL 16
+
+/**
+ * @brief Print messages debugging input/output operations.
+ * 
+ * Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
+ */
 #define DEBUG_IO 32
+
+/**
+ * @brief Print messages debugging lambda functions (interpretation).
+ * 
+ * Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
+ */
 #define DEBUG_LAMBDA 64
+
+/**
+ * @brief Print messages debugging the read eval print loop.
+ * 
+ * Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
+ */
 #define DEBUG_REPL 128
+
+/**
+ * @brief Print messages debugging stack operations.
+ * 
+ * Flag interpretation for the value of `verbosity`, defined in `debug.c`, q.v.
+ */
 #define DEBUG_STACK 256
 
 extern int verbosity;

src/init.c

@@ -28,6 +28,7 @@
 #include "memory/hashmap.h"
 #include "ops/intern.h"
 #include "io/io.h"
+#include "io/fopen.h"
 #include "ops/lispops.h"
 #include "ops/meta.h"
 #include "arith/peano.h"
@@ -36,6 +37,54 @@
 #include "io/fopen.h"
 #include "time/psse_time.h"
 
+/**
+ * @brief If `pointer` is an exception, display that exception to stderr, 
+ * decrement that exception, and return NIL; else return the pointer.
+ * 
+ * @param pointer a cons pointer.
+ * @param location_descriptor a description of where the pointer was caught.
+ * @return struct cons_pointer 
+ */
+struct cons_pointer check_exception( struct cons_pointer pointer,
+                                     char *location_descriptor ) {
+    struct cons_pointer result = NIL;
+
+    struct cons_space_object *object = &pointer2cell( pointer );
+
+    if ( exceptionp( pointer ) ) {
+        fprintf( stderr, "ERROR: Exception at %s: ", location_descriptor );
+        URL_FILE *ustderr = file_to_url_file( stderr );
+        fwide( stderr, 1 );
+        print( ustderr, object->payload.exception.payload );
+        free( ustderr );
+
+        dec_ref( pointer );
+    } else {
+        result = pointer;
+    }
+
+    return result;
+}
+
+struct cons_pointer init_name_symbol = NIL;
+struct cons_pointer init_primitive_symbol = NIL;
+
+void maybe_bind_init_symbols(  ) {
+    if ( nilp( init_name_symbol ) ) {
+        init_name_symbol = c_string_to_lisp_keyword( L"name" );
+    }
+    if ( nilp( init_primitive_symbol ) ) {
+        init_primitive_symbol = c_string_to_lisp_keyword( L"primitive" );
+    }
+    if ( nilp( privileged_symbol_nil ) ) {
+        privileged_symbol_nil = c_string_to_lisp_symbol( L"nil" );
+    }
+}
+
+void free_init_symbols(  ) {
+    dec_ref( init_name_symbol );
+    dec_ref( init_primitive_symbol );
+}
 
 /**
  * Bind this compiled `executable` function, as a Lisp function, to
@@ -44,46 +93,79 @@
  * the name on the source pointer. Would make stack frames potentially
  * more readable and aid debugging generally.
  */
-void bind_function( wchar_t *name, struct cons_pointer ( *executable )
+struct cons_pointer bind_function( wchar_t *name,
-                     ( struct stack_frame *,
+                                   struct cons_pointer ( *executable )
-                       struct cons_pointer, struct cons_pointer ) ) {
+                                    ( struct stack_frame *,
+                                      struct cons_pointer,
+                                      struct cons_pointer ) ) {
     struct cons_pointer n = c_string_to_lisp_symbol( name );
     struct cons_pointer meta =
-        make_cons( make_cons( c_string_to_lisp_keyword( L"primitive" ), TRUE ),
+        make_cons( make_cons( init_primitive_symbol, TRUE ),
-                   make_cons( make_cons( c_string_to_lisp_keyword( L"name" ),
+                   make_cons( make_cons( init_name_symbol, n ),
-                                         n ),
                               NIL ) );
 
-    deep_bind( n, make_function( meta, executable ) );
+    struct cons_pointer r =
+        check_exception( deep_bind( n, make_function( meta, executable ) ),
+                         "bind_function" );
+
+    dec_ref( n );
+
+    return r;
 }
 
 /**
  * Bind this compiled `executable` function, as a Lisp special form, to
  * this `name` in the `oblist`.
  */
-void bind_special( wchar_t *name, struct cons_pointer ( *executable )
+struct cons_pointer bind_special( wchar_t *name,
-                    ( struct stack_frame *,
+                                  struct cons_pointer ( *executable )
-                      struct cons_pointer, struct cons_pointer ) ) {
+                                   ( struct stack_frame *, struct cons_pointer,
+                                     struct cons_pointer ) ) {
     struct cons_pointer n = c_string_to_lisp_symbol( name );
-    struct cons_pointer meta =
-        make_cons( make_cons( c_string_to_lisp_keyword( L"primitive" ), TRUE ),
-                   make_cons( make_cons( c_string_to_lisp_keyword( L"name" ),
-                                         n ),
-                              NIL ) );
 
-    deep_bind( n, make_special( meta, executable ) );
+    struct cons_pointer meta =
+        make_cons( make_cons( init_primitive_symbol, TRUE ),
+                   make_cons( make_cons( init_name_symbol, n ), NIL ) );
+
+    struct cons_pointer r =
+        check_exception( deep_bind( n, make_special( meta, executable ) ),
+                         "bind_special" );
+
+    dec_ref( n );
+
+    return r;
+}
+
+/**
+ * Bind this `value` to this `symbol` in the `oblist`.
+ */
+struct cons_pointer
+bind_symbol_value( struct cons_pointer symbol, struct cons_pointer value,
+                   bool lock ) {
+    struct cons_pointer r = check_exception( deep_bind( symbol, value ),
+                                             "bind_symbol_value" );
+
+    if ( lock && !exceptionp( r ) ) {
+        struct cons_space_object *cell = &pointer2cell( r );
+
+        cell->count = UINT32_MAX;
+    }
+
+    return r;
 }
 
 /**
  * Bind this `value` to this `name` in the `oblist`.
  */
-void bind_value( wchar_t *name, struct cons_pointer value ) {
+struct cons_pointer bind_value( wchar_t *name, struct cons_pointer value,
-    struct cons_pointer n = c_string_to_lisp_symbol( name );
+                                bool lock ) {
-    inc_ref( n );
+    struct cons_pointer p = c_string_to_lisp_symbol( name );
 
-    deep_bind( n, value );
+    struct cons_pointer r = bind_symbol_value( p, value, lock );
 
-    dec_ref( n );
+    dec_ref( p );
+
+    return r;
 }
 
 void print_banner(  ) {
@@ -96,7 +178,7 @@ void print_banner(  ) {
  * 
  * @stream the stream to print to.
  */
-void print_options( FILE * stream ) {
+void print_options( FILE *stream ) {
     fwprintf( stream, L"Expected options are:\n" );
     fwprintf( stream,
               L"\t-d\tDump memory to standard out at end of run (copious!);\n" );
@@ -124,6 +206,7 @@ int main( int argc, char *argv[] ) {
     int option;
     bool dump_at_end = false;
     bool show_prompt = false;
+    char *infilename = NULL;
 
     setlocale( LC_ALL, "" );
     if ( io_init(  ) != 0 ) {
@@ -131,7 +214,7 @@ int main( int argc, char *argv[] ) {
         exit( 1 );
     }
 
-    while ( ( option = getopt( argc, argv, "phdv:" ) ) != -1 ) {
+    while ( ( option = getopt( argc, argv, "phdv:i:" ) ) != -1 ) {
         switch ( option ) {
             case 'd':
                 dump_at_end = true;
@@ -141,6 +224,9 @@ int main( int argc, char *argv[] ) {
                 print_options( stdout );
                 exit( 0 );
                 break;
+            case 'i':
+                infilename = optarg;
+                break;
             case 'p':
                 show_prompt = true;
                 break;
@@ -155,21 +241,15 @@ int main( int argc, char *argv[] ) {
         }
     }
 
+    initialise_cons_pages(  );
+
+    maybe_bind_init_symbols(  );
+
+
     if ( show_prompt ) {
         print_banner(  );
     }
 
-    initialise_cons_pages(  );
-
-//     TODO: oblist-as-hashmap (which is what we ultimately need) is failing hooribly.
-//     What actually goes wrong is: 
-//     1. the hashmap is created; 
-//     2. everything bound in init seems to get initialised properly;
-//     3. the REPL starts up;
-//     4. Anything typed into the REPL (except ctrl-D) results in immediate segfault.
-//     5. If ctrl-D is the first thing typed into the REPL, shutdown proceeds normally.
-//     Hypothesis: binding stuff into a hashmap oblist either isn't happening or 
-//      is wrking ok, but retrieving from a hashmap oblist is failing.
     debug_print( L"About to initialise oblist\n", DEBUG_BOOTSTRAP );
 
     oblist = make_hashmap( 32, NIL, TRUE );
@@ -179,8 +259,8 @@ int main( int argc, char *argv[] ) {
     /*
      * privileged variables (keywords)
      */
-    bind_value( L"nil", NIL );
+    bind_symbol_value( privileged_symbol_nil, NIL, true );
-    bind_value( L"t", TRUE );
+    bind_value( L"t", TRUE, true );
 
     /*
      * standard input, output, error and sink streams
@@ -191,40 +271,50 @@ int main( int argc, char *argv[] ) {
     fwide( stdout, 1 );
     fwide( stderr, 1 );
     fwide( sink->handle.file, 1 );
-    bind_value( L"*in*", make_read_stream( file_to_url_file( stdin ),
+
-                                           make_cons( make_cons
+    FILE *infile = infilename == NULL ? stdin : fopen( infilename, "r" );
-                                                      ( c_string_to_lisp_keyword
+
-                                                        ( L"url" ),
+
-                                                        c_string_to_lisp_string
+    lisp_io_in =
-                                                        ( L"system:standard input" ) ),
+        bind_value( C_IO_IN,
-                                                      NIL ) ) );
+                    make_read_stream( file_to_url_file( infile ),
-    bind_value( L"*out*",
+                                      make_cons( make_cons
-                make_write_stream( file_to_url_file( stdout ),
+                                                 ( c_string_to_lisp_keyword
+                                                   ( L"url" ),
+                                                   c_string_to_lisp_string
+                                                   ( L"system:standard input" ) ),
+                                                 NIL ) ), false );
+    lisp_io_out =
+        bind_value( C_IO_OUT,
+                    make_write_stream( file_to_url_file( stdout ),
+                                       make_cons( make_cons
+                                                  ( c_string_to_lisp_keyword
+                                                    ( L"url" ),
+                                                    c_string_to_lisp_string
+                                                    ( L"system:standard output]" ) ),
+                                                  NIL ) ), false );
+    bind_value( L"*log*",
+                make_write_stream( file_to_url_file( stderr ),
                                    make_cons( make_cons
                                               ( c_string_to_lisp_keyword
                                                 ( L"url" ),
                                                 c_string_to_lisp_string
-                                                ( L"system:standard output]" ) ),
+                                                ( L"system:standard log" ) ),
-                                              NIL ) ) );
+                                              NIL ) ), false );
-    bind_value( L"*log*", make_write_stream( file_to_url_file( stderr ),
+    bind_value( L"*sink*",
-                                             make_cons( make_cons
+                make_write_stream( sink,
-                                                        ( c_string_to_lisp_keyword
+                                   make_cons( make_cons
-                                                          ( L"url" ),
+                                              ( c_string_to_lisp_keyword
-                                                          c_string_to_lisp_string
+                                                ( L"url" ),
-                                                          ( L"system:standard log" ) ),
+                                                c_string_to_lisp_string
-                                                        NIL ) ) );
+                                                ( L"system:standard sink" ) ),
-    bind_value( L"*sink*", make_write_stream( sink,
+                                              NIL ) ), false );
-                                              make_cons( make_cons
-                                                         ( c_string_to_lisp_keyword
-                                                           ( L"url" ),
-                                                           c_string_to_lisp_string
-                                                           ( L"system:standard sink" ) ),
-                                                         NIL ) ) );
     /*
      * the default prompt
      */
-    bind_value( L"*prompt*",
+    prompt_name = bind_value( L"*prompt*",
-                show_prompt ? c_string_to_lisp_symbol( L":: " ) : NIL );
+                              show_prompt ? c_string_to_lisp_symbol( L":: " ) :
+                              NIL, false );
     /*
      * primitive function operations
      */
@@ -291,13 +381,15 @@ int main( int argc, char *argv[] ) {
 
     repl( show_prompt );
 
-    debug_print( L"Freeing oblist\n", DEBUG_BOOTSTRAP );
-    dec_ref( oblist );
     debug_dump_object( oblist, DEBUG_BOOTSTRAP );
     if ( dump_at_end ) {
         dump_pages( file_to_url_file( stdout ) );
     }
 
+    debug_print( L"Freeing oblist\n", DEBUG_BOOTSTRAP );
+    dec_ref( oblist );
+    free_init_symbols(  );
+
     summarise_allocation(  );
     curl_global_cleanup(  );
     return ( 0 );

src/io/fopen.c

@@ -99,7 +99,7 @@ static size_t write_callback( char *buffer,
 }
 
 /* use to attempt to fill the read buffer up to requested number of bytes */
-static int fill_buffer( URL_FILE * file, size_t want ) {
+static int fill_buffer( URL_FILE *file, size_t want ) {
     fd_set fdread;
     fd_set fdwrite;
     fd_set fdexcep;
@@ -181,7 +181,7 @@ static int fill_buffer( URL_FILE * file, size_t want ) {
 }
 
 /* use to remove want bytes from the front of a files buffer */
-static int use_buffer( URL_FILE * file, size_t want ) {
+static int use_buffer( URL_FILE *file, size_t want ) {
     /* sort out buffer */
     if ( ( file->buffer_pos - want ) <= 0 ) {
         /* ditch buffer - write will recreate */
@@ -255,7 +255,7 @@ URL_FILE *url_fopen( const char *url, const char *operation ) {
     return file;
 }
 
-int url_fclose( URL_FILE * file ) {
+int url_fclose( URL_FILE *file ) {
     int ret = 0;                /* default is good return */
 
     switch ( file->type ) {
@@ -283,7 +283,7 @@ int url_fclose( URL_FILE * file ) {
     return ret;
 }
 
-int url_feof( URL_FILE * file ) {
+int url_feof( URL_FILE *file ) {
     int ret = 0;
 
     switch ( file->type ) {
@@ -304,7 +304,7 @@ int url_feof( URL_FILE * file ) {
     return ret;
 }
 
-size_t url_fread( void *ptr, size_t size, size_t nmemb, URL_FILE * file ) {
+size_t url_fread( void *ptr, size_t size, size_t nmemb, URL_FILE *file ) {
     size_t want;
 
     switch ( file->type ) {
@@ -343,7 +343,7 @@ size_t url_fread( void *ptr, size_t size, size_t nmemb, URL_FILE * file ) {
     return want;
 }
 
-char *url_fgets( char *ptr, size_t size, URL_FILE * file ) {
+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;
 
@@ -390,7 +390,7 @@ char *url_fgets( char *ptr, size_t size, URL_FILE * file ) {
     return ptr;                 /*success */
 }
 
-void url_rewind( URL_FILE * file ) {
+void url_rewind( URL_FILE *file ) {
     switch ( file->type ) {
         case CFTYPE_FILE:
             rewind( file->handle.file );  /* passthrough */

src/io/io.c

@@ -28,11 +28,12 @@
 
 #include <curl/curl.h>
 
-#include "memory/conspage.h"
+#include "arith/integer.h"
-#include "memory/consspaceobject.h"
 #include "debug.h"
 #include "io/fopen.h"
-#include "arith/integer.h"
+#include "io/io.h"
+#include "memory/conspage.h"
+#include "memory/consspaceobject.h"
 #include "ops/intern.h"
 #include "ops/lispops.h"
 #include "utils.h"
@@ -44,6 +45,16 @@
  */
 CURLSH *io_share;
 
+/**
+ * @brief bound to the Lisp string representing C_IO_IN in initialisation.
+ */
+struct cons_pointer lisp_io_in = NIL;
+/**
+ * @brief bound to the Lisp string representing C_IO_OUT in initialisation.
+ */
+struct cons_pointer lisp_io_out = NIL;
+
+
 /**
  * Allow a one-character unget facility. This may not be enough - we may need
  * to allocate a buffer.
@@ -120,7 +131,7 @@ char *lisp_string_to_c_string( struct cons_pointer s ) {
  * @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 *file_to_url_file( FILE *f ) {
     URL_FILE *result = ( URL_FILE * ) malloc( sizeof( URL_FILE ) );
 
     if ( result != NULL ) {
@@ -137,7 +148,7 @@ URL_FILE *file_to_url_file( FILE * f ) {
  * @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 url_fgetwc( URL_FILE *input ) {
     wint_t result = -1;
 
     if ( ungotten != 0 ) {
@@ -206,7 +217,7 @@ wint_t url_fgetwc( URL_FILE * input ) {
     return result;
 }
 
-wint_t url_ungetwc( wint_t wc, URL_FILE * input ) {
+wint_t url_ungetwc( wint_t wc, URL_FILE *input ) {
     wint_t result = -1;
 
     switch ( input->type ) {
@@ -273,7 +284,7 @@ struct cons_pointer add_meta_string( struct cons_pointer meta, wchar_t *key,
 }
 
 struct cons_pointer add_meta_time( struct cons_pointer meta, wchar_t *key,
-                                   time_t * value ) {
+                                   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];
@@ -399,15 +410,10 @@ void collect_meta( struct cons_pointer stream, char *url ) {
  */
 struct cons_pointer get_default_stream( bool inputp, struct cons_pointer env ) {
     struct cons_pointer result = NIL;
-    struct cons_pointer stream_name =
+    struct cons_pointer stream_name = inputp ? lisp_io_in : lisp_io_out;
-        c_string_to_lisp_symbol( inputp ? L"*in*" : L"*out*" );
-
-    inc_ref( stream_name );
 
     result = c_assoc( stream_name, env );
 
-    dec_ref( stream_name );
-
     return result;
 }
 
@@ -419,7 +425,7 @@ struct cons_pointer get_default_stream( bool inputp, struct cons_pointer env ) {
  * to append, or error if the URL is faulty or indicates an unavailable
  * resource.
  *
- * * (read-char stream)
+ * * (open url)
  *
  * @param frame my stack_frame.
  * @param frame_pointer a pointer to my stack_frame.
@@ -502,8 +508,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
     if ( readp( frame->arg[0] ) ) {
         result =
             make_string( url_fgetwc
-                         ( pointer2cell( frame->arg[0] ).payload.stream.
+                         ( pointer2cell( frame->arg[0] ).payload.
-                           stream ), NIL );
+                           stream.stream ), NIL );
     }
 
     return result;
@@ -513,6 +519,8 @@ lisp_read_char( struct stack_frame *frame, struct cons_pointer frame_pointer,
  * Function: return a string representing all characters from the stream
  * indicated by arg 0; further arguments are ignored.
  *
+ * TODO: it should be possible to optionally pass a string URL to this function,
+ *
  * * (slurp stream)
  *
  * @param frame my stack_frame.

src/io/io.h

@@ -11,12 +11,18 @@
 #ifndef __psse_io_h
 #define __psse_io_h
 #include <curl/curl.h>
-#include "consspaceobject.h"
+#include "memory/consspaceobject.h"
 
 extern CURLSH *io_share;
 
 int io_init(  );
 
+#define C_IO_IN L"*in*"
+#define C_IO_OUT L"*out*"
+
+extern struct cons_pointer lisp_io_in;
+extern struct cons_pointer lisp_io_out;
+
 URL_FILE *file_to_url_file( FILE * f );
 wint_t url_fgetwc( URL_FILE * input );
 wint_t url_ungetwc( wint_t wc, URL_FILE * input );

src/io/print.c

@@ -32,7 +32,7 @@
  * onto this `output`; if `pointer` does not indicate a string or symbol,
  * don't print anything but just return.
  */
-void print_string_contents( URL_FILE * output, struct cons_pointer pointer ) {
+void print_string_contents( URL_FILE *output, struct cons_pointer pointer ) {
     while ( stringp( pointer ) || symbolp( pointer ) || keywordp( pointer ) ) {
         struct cons_space_object *cell = &pointer2cell( pointer );
         wchar_t c = cell->payload.string.character;
@@ -49,7 +49,7 @@ void print_string_contents( URL_FILE * output, struct cons_pointer pointer ) {
  * the stream at this `output`, prepending and appending double quote
  * characters.
  */
-void print_string( URL_FILE * output, struct cons_pointer pointer ) {
+void print_string( URL_FILE *output, struct cons_pointer pointer ) {
     url_fputwc( btowc( '"' ), output );
     print_string_contents( output, pointer );
     url_fputwc( btowc( '"' ), output );
@@ -61,7 +61,7 @@ void print_string( URL_FILE * output, struct cons_pointer pointer ) {
  * a space character.
  */
 void
-print_list_contents( URL_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 );
 
@@ -82,13 +82,13 @@ print_list_contents( URL_FILE * output, struct cons_pointer pointer,
     }
 }
 
-void print_list( URL_FILE * output, struct cons_pointer pointer ) {
+void print_list( URL_FILE *output, struct cons_pointer pointer ) {
     url_fputws( L"(", output );
     print_list_contents( output, pointer, false );
     url_fputws( L")", output );
 }
 
-void print_map( URL_FILE * output, struct cons_pointer map ) {
+void print_map( URL_FILE *output, struct cons_pointer map ) {
     if ( hashmapp( map ) ) {
         struct vector_space_object *vso = pointer_to_vso( map );
 
@@ -110,7 +110,7 @@ void print_map( URL_FILE * output, struct cons_pointer map ) {
     }
 }
 
-void print_vso( URL_FILE * output, struct cons_pointer pointer ) {
+void print_vso( URL_FILE *output, struct cons_pointer pointer ) {
     struct vector_space_object *vso = pointer_to_vso( pointer );
     switch ( vso->header.tag.value ) {
         case HASHTV:
@@ -126,7 +126,7 @@ void print_vso( URL_FILE * output, struct cons_pointer pointer ) {
 /**
  * stolen from https://stackoverflow.com/questions/11656241/how-to-print-uint128-t-number-using-gcc
  */
-void print_128bit( URL_FILE * output, __int128_t n ) {
+void print_128bit( URL_FILE *output, __int128_t n ) {
     if ( n == 0 ) {
         fwprintf( stderr, L"0" );
     } else {
@@ -148,7 +148,7 @@ void print_128bit( URL_FILE * output, __int128_t n ) {
  * Print the cons-space object indicated by `pointer` to the stream indicated
  * by `output`.
  */
-struct cons_pointer print( URL_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;
 
@@ -169,12 +169,10 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) {
             print( output, cell.payload.function.meta );
             url_fputwc( L'>', output );
             break;
-        case INTEGERTV:{
+        case INTEGERTV:
-                struct cons_pointer s = integer_to_string( pointer, 10 );
+            struct cons_pointer s = integer_to_string( pointer, 10 );
-                inc_ref( s );
+            print_string_contents( output, s );
-                print_string_contents( output, s );
+            dec_ref( s );
-                dec_ref( s );
-            }
             break;
         case KEYTV:
             url_fputws( L":", output );
@@ -186,7 +184,6 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) {
                     make_cons( c_string_to_lisp_symbol( L"\u03bb" ),
                                make_cons( cell.payload.lambda.args,
                                           cell.payload.lambda.body ) );
-                inc_ref( to_print );
 
                 print( output, to_print );
 
@@ -203,7 +200,6 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) {
                     make_cons( c_string_to_lisp_symbol( L"n\u03bb" ),
                                make_cons( cell.payload.lambda.args,
                                           cell.payload.lambda.body ) );
-                inc_ref( to_print );
 
                 print( output, to_print );
 
@@ -276,6 +272,6 @@ struct cons_pointer print( URL_FILE * output, struct cons_pointer pointer ) {
     return pointer;
 }
 
-void println( URL_FILE * output ) {
+void println( URL_FILE *output ) {
     url_fputws( L"\n", output );
 }

src/io/read.c

@@ -83,14 +83,14 @@ struct cons_pointer c_quote( struct cons_pointer arg ) {
  * 3. one or more symbols separated by slashes; or
  * 4. keywords (with leading colons) interspersed with symbols (prefixed by slashes).
  */
-struct cons_pointer read_path( URL_FILE * input, wint_t initial,
+struct cons_pointer read_path( URL_FILE *input, wint_t initial,
                                struct cons_pointer q ) {
     bool done = false;
     struct cons_pointer prefix = NIL;
 
     switch ( initial ) {
         case '/':
-            prefix = c_string_to_lisp_symbol( L"oblist" );
+            prefix = make_cons( c_string_to_lisp_symbol( L"oblist" ), NIL);
             break;
         case '$':
         case LSESSION:
@@ -155,7 +155,7 @@ struct cons_pointer read_path( URL_FILE * input, wint_t initial,
 struct cons_pointer read_continuation( struct stack_frame *frame,
                                        struct cons_pointer frame_pointer,
                                        struct cons_pointer env,
-                                       URL_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;
 
@@ -287,14 +287,14 @@ struct cons_pointer read_continuation( struct stack_frame *frame,
  */
 struct cons_pointer read_number( struct stack_frame *frame,
                                  struct cons_pointer frame_pointer,
-                                 URL_FILE * input,
+                                 URL_FILE *input,
                                  wint_t initial, bool seen_period ) {
     debug_print( L"entering read_number\n", DEBUG_IO );
 
-    struct cons_pointer result = make_integer( 0, NIL );
+    struct cons_pointer result = acquire_integer( 0, NIL );
     /* \todo we really need to be getting `base` from a privileged Lisp name -
      * and it should be the same privileged name we use when writing numbers */
-    struct cons_pointer base = make_integer( 10, NIL );
+    struct cons_pointer base = acquire_integer( 10, NIL );
     struct cons_pointer dividend = NIL;
     int places_of_decimals = 0;
     wint_t c;
@@ -308,7 +308,8 @@ struct cons_pointer read_number( struct stack_frame *frame,
                   initial );
 
     for ( c = initial; iswdigit( c )
-          || c == LPERIOD || c == LSLASH || c == LCOMMA; c = url_fgetwc( input ) ) {
+          || c == LPERIOD || c == LSLASH || c == LCOMMA;
+          c = url_fgetwc( input ) ) {
         switch ( c ) {
             case LPERIOD:
                 if ( seen_period || !nilp( dividend ) ) {
@@ -331,7 +332,10 @@ struct cons_pointer read_number( struct stack_frame *frame,
                                  DEBUG_IO );
                     dividend = result;
 
-                    result = make_integer( 0, NIL );
+                    result = acquire_integer( 0, NIL );
+                    // If I do replace_integer_p here instead of acquire_integer, 
+                    // and thus reclaim the garbage, I get a regression. Dom't yet
+                    // know why.    
                 }
                 break;
             case LCOMMA:
@@ -339,8 +343,8 @@ struct cons_pointer read_number( struct stack_frame *frame,
                 break;
             default:
                 result = add_integers( multiply_integers( result, base ),
-                                       make_integer( ( int ) c - ( int ) '0',
+                                       acquire_integer( ( int ) c -
-                                                     NIL ) );
+                                                        ( int ) '0', NIL ) );
 
                 debug_printf( DEBUG_IO,
                               L"read_number: added character %c, result now ",
@@ -362,11 +366,11 @@ struct cons_pointer read_number( struct stack_frame *frame,
     if ( seen_period ) {
         debug_print( L"read_number: converting result to real\n", DEBUG_IO );
         struct cons_pointer div = make_ratio( result,
-                                              make_integer( powl
+                                              acquire_integer( powl
-                                                            ( to_long_double
+                                                               ( to_long_double
-                                                              ( base ),
+                                                                 ( base ),
-                                                              places_of_decimals ),
+                                                                 places_of_decimals ),
-                                                            NIL ) );
+                                                               NIL ) );
         inc_ref( div );
 
         result = make_real( to_long_double( div ) );
@@ -397,7 +401,7 @@ struct cons_pointer read_number( struct stack_frame *frame,
 struct cons_pointer read_list( struct stack_frame *frame,
                                struct cons_pointer frame_pointer,
                                struct cons_pointer env,
-                               URL_FILE * input, wint_t initial ) {
+                               URL_FILE *input, wint_t initial ) {
     struct cons_pointer result = NIL;
     wint_t c;
 
@@ -437,7 +441,7 @@ struct cons_pointer read_list( struct stack_frame *frame,
 struct cons_pointer read_map( struct stack_frame *frame,
                               struct cons_pointer frame_pointer,
                               struct cons_pointer env,
-                              URL_FILE * input, wint_t initial ) {
+                              URL_FILE *input, wint_t initial ) {
     // set write ACL to true whilst creating to prevent GC churn
     struct cons_pointer result =
         make_hashmap( DFLT_HASHMAP_BUCKETS, NIL, TRUE );
@@ -477,7 +481,7 @@ struct cons_pointer read_map( 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( URL_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 ) {
@@ -500,7 +504,7 @@ struct cons_pointer read_string( URL_FILE * input, wint_t initial ) {
     return result;
 }
 
-struct cons_pointer read_symbol_or_key( URL_FILE * input, uint32_t tag,
+struct cons_pointer read_symbol_or_key( URL_FILE *input, uint32_t tag,
                                         wint_t initial ) {
     struct cons_pointer cdr = NIL;
     struct cons_pointer result;
@@ -555,7 +559,7 @@ struct cons_pointer read_symbol_or_key( URL_FILE * input, uint32_t tag,
 struct cons_pointer read( struct
                           stack_frame
                           *frame, struct cons_pointer frame_pointer,
-                          struct cons_pointer env, URL_FILE * input ) {
+                          struct cons_pointer env, URL_FILE *input ) {
     return read_continuation( frame, frame_pointer, env, input,
                               url_fgetwc( input ) );
 }

src/memory/conspage.c

@@ -121,7 +121,7 @@ void make_cons_page(  ) {
 /**
  * dump the allocated pages to this `output` stream.
  */
-void dump_pages( URL_FILE * output ) {
+void dump_pages( URL_FILE *output ) {
     for ( int i = 0; i < initialised_cons_pages; i++ ) {
         url_fwprintf( output, L"\nDUMPING PAGE %d\n", i );
 
@@ -187,6 +187,9 @@ void free_cell( struct cons_pointer pointer ) {
                 case VECTORPOINTTV:
                     free_vso( pointer );
                     break;
+                default:
+                    fprintf( stderr, "WARNING: Freeing object of type %s!",
+                             ( char * ) &( cell->tag.bytes ) );
             }
 
             strncpy( &cell->tag.bytes[0], FREETAG, TAGLENGTH );
@@ -231,15 +234,15 @@ struct cons_pointer allocate_cell( uint32_t tag ) {
 
             cell->tag.value = tag;
 
-            cell->count = 0;
+            cell->count = 1;
             cell->payload.cons.car = NIL;
             cell->payload.cons.cdr = NIL;
 
             total_cells_allocated++;
 
             debug_printf( DEBUG_ALLOC,
-                          L"Allocated cell of type '%4.4s' at %d, %d \n", cell->tag.bytes,
+                          L"Allocated cell of type '%4.4s' at %d, %d \n",
-                          result.page, result.offset );
+                          cell->tag.bytes, result.page, result.offset );
         } else {
             debug_printf( DEBUG_ALLOC, L"WARNING: Allocating non-free cell!" );
         }
@@ -268,5 +271,6 @@ void initialise_cons_pages(  ) {
 void summarise_allocation(  ) {
     fwprintf( stderr,
               L"Allocation summary: allocated %lld; deallocated %lld; not deallocated %lld.\n",
-              total_cells_allocated, total_cells_freed, total_cells_allocated - total_cells_freed );
+              total_cells_allocated, total_cells_freed,
+              total_cells_allocated - total_cells_freed );
 }

src/memory/consspaceobject.c

@@ -33,22 +33,22 @@
  * vectorspace object indicated by the cell is this `value`, else false.
  */
 bool check_tag( struct cons_pointer pointer, uint32_t value ) {
-  bool result = false;
+    bool result = false;
 
-  struct cons_space_object cell = pointer2cell( pointer );
+    struct cons_space_object cell = pointer2cell( pointer );
-  result = cell.tag.value == value;
+    result = cell.tag.value == value;
 
-  if ( result == false ) {
+    if ( result == false ) {
-    if ( cell.tag.value == VECTORPOINTTV ) {
+        if ( cell.tag.value == VECTORPOINTTV ) {
-      struct vector_space_object *vec = pointer_to_vso( pointer );
+            struct vector_space_object *vec = pointer_to_vso( pointer );
 
-      if ( vec != NULL ) {
+            if ( vec != NULL ) {
-        result = vec->header.tag.value == value;
+                result = vec->header.tag.value == value;
-      }
+            }
+        }
     }
-  }
 
-  return result;
+    return result;
 }
 
 /**
@@ -60,13 +60,13 @@ bool check_tag( struct cons_pointer pointer, uint32_t value ) {
  * Returns the `pointer`.
  */
 struct cons_pointer inc_ref( struct cons_pointer pointer ) {
-  struct cons_space_object *cell = &pointer2cell( pointer );
+    struct cons_space_object *cell = &pointer2cell( pointer );
 
-  if ( cell->count < MAXREFERENCE ) {
+    if ( cell->count < MAXREFERENCE ) {
-    cell->count++;
+        cell->count++;
-  }
+    }
 
-  return pointer;
+    return pointer;
 }
 
 /**
@@ -78,18 +78,18 @@ struct cons_pointer inc_ref( struct cons_pointer pointer ) {
  * Returns the `pointer`, or, if the cell has been freed, NIL.
  */
 struct cons_pointer dec_ref( struct cons_pointer pointer ) {
-  struct cons_space_object *cell = &pointer2cell( pointer );
+    struct cons_space_object *cell = &pointer2cell( pointer );
 
-  if ( cell->count > 0 ) {
+    if ( cell->count > 0 && cell->count != UINT32_MAX ) {
-    cell->count--;
+        cell->count--;
 
-    if ( cell->count == 0 ) {
+        if ( cell->count == 0 ) {
-      free_cell( pointer );
+            free_cell( pointer );
-      pointer = NIL;
+            pointer = NIL;
+        }
     }
-  }
 
-  return pointer;
+    return pointer;
 }
 
 /**
@@ -98,22 +98,24 @@ struct cons_pointer dec_ref( struct cons_pointer pointer ) {
  * @return As a Lisp string, the tag of the object which is at that pointer.
  */
 struct cons_pointer c_type( struct cons_pointer pointer ) {
-  struct cons_pointer result = NIL;
+    struct cons_pointer result = NIL;
-  struct cons_space_object cell = pointer2cell( pointer );
+    struct cons_space_object cell = pointer2cell( pointer );
 
-  if ( strncmp( (char *)&cell.tag.bytes, VECTORPOINTTAG, TAGLENGTH ) == 0 ) {
+    if ( strncmp( ( char * ) &cell.tag.bytes, VECTORPOINTTAG, TAGLENGTH ) ==
-    struct vector_space_object *vec = pointer_to_vso( pointer );
+         0 ) {
+        struct vector_space_object *vec = pointer_to_vso( pointer );
 
-    for ( int i = TAGLENGTH - 1; i >= 0; i-- ) {
+        for ( int i = TAGLENGTH - 1; i >= 0; i-- ) {
-      result = make_string( (wchar_t)vec->header.tag.bytes[i], result );
+            result =
+                make_string( ( wchar_t ) vec->header.tag.bytes[i], result );
+        }
+    } else {
+        for ( int i = TAGLENGTH - 1; i >= 0; i-- ) {
+            result = make_string( ( wchar_t ) cell.tag.bytes[i], result );
+        }
     }
-  } else {
-    for ( int i = TAGLENGTH - 1; i >= 0; i-- ) {
-      result = make_string( (wchar_t)cell.tag.bytes[i], result );
-    }
-  }
 
-  return result;
+    return result;
 }
 
 /**
@@ -121,13 +123,13 @@ struct cons_pointer c_type( struct cons_pointer pointer ) {
  * authorised to read it, does not error but returns nil.
  */
 struct cons_pointer c_car( struct cons_pointer arg ) {
-  struct cons_pointer result = NIL;
+    struct cons_pointer result = NIL;
 
-  if ( truep( authorised( arg, NIL ) ) && consp( arg ) ) {
+    if ( truep( authorised( arg, NIL ) ) && consp( arg ) ) {
-    result = pointer2cell( arg ).payload.cons.car;
+        result = pointer2cell( arg ).payload.cons.car;
-  }
+    }
 
-  return result;
+    return result;
 }
 
 /**
@@ -135,24 +137,24 @@ struct cons_pointer c_car( struct cons_pointer arg ) {
  * not authorised to read it,does not error but returns nil.
  */
 struct cons_pointer c_cdr( struct cons_pointer arg ) {
-  struct cons_pointer result = NIL;
+    struct cons_pointer result = NIL;
 
-  if ( truep( authorised( arg, NIL ) ) ) {
+    if ( truep( authorised( arg, NIL ) ) ) {
-    struct cons_space_object *cell = &pointer2cell( arg );
+        struct cons_space_object *cell = &pointer2cell( arg );
 
-    switch ( cell->tag.value ) {
+        switch ( cell->tag.value ) {
-      case CONSTV:
+            case CONSTV:
-        result = cell->payload.cons.cdr;
+                result = cell->payload.cons.cdr;
-        break;
+                break;
-      case KEYTV:
+            case KEYTV:
-      case STRINGTV:
+            case STRINGTV:
-      case SYMBOLTV:
+            case SYMBOLTV:
-        result = cell->payload.string.cdr;
+                result = cell->payload.string.cdr;
-        break;
+                break;
+        }
     }
-  }
 
-  return result;
+    return result;
 }
 
 /**
@@ -160,13 +162,13 @@ struct cons_pointer c_cdr( struct cons_pointer arg ) {
  * returns 0.
  */
 int c_length( struct cons_pointer arg ) {
-  int result = 0;
+    int result = 0;
 
-  for ( struct cons_pointer c = arg; !nilp( c ); c = c_cdr( c ) ) {
+    for ( struct cons_pointer c = arg; !nilp( c ); c = c_cdr( c ) ) {
-    result++;
+        result++;
-  }
+    }
 
-  return result;
+    return result;
 }
 
 /**
@@ -174,18 +176,18 @@ int c_length( struct cons_pointer arg ) {
  */
 struct cons_pointer make_cons( struct cons_pointer car,
                                struct cons_pointer cdr ) {
-  struct cons_pointer pointer = NIL;
+    struct cons_pointer pointer = NIL;
 
-  pointer = allocate_cell( CONSTV );
+    pointer = allocate_cell( CONSTV );
 
-  struct cons_space_object *cell = &pointer2cell( pointer );
+    struct cons_space_object *cell = &pointer2cell( pointer );
 
-  inc_ref( car );
+    inc_ref( car );
-  inc_ref( cdr );
+    inc_ref( cdr );
-  cell->payload.cons.car = car;
+    cell->payload.cons.car = car;
-  cell->payload.cons.cdr = cdr;
+    cell->payload.cons.cdr = cdr;
 
-  return pointer;
+    return pointer;
 }
 
 /**
@@ -197,36 +199,39 @@ struct cons_pointer make_cons( struct cons_pointer car,
  */
 struct cons_pointer make_exception( struct cons_pointer message,
                                     struct cons_pointer frame_pointer ) {
-  struct cons_pointer result = NIL;
+    struct cons_pointer result = NIL;
-  struct cons_pointer pointer = allocate_cell( EXCEPTIONTV );
+    struct cons_pointer pointer = allocate_cell( EXCEPTIONTV );
-  struct cons_space_object *cell = &pointer2cell( pointer );
+    struct cons_space_object *cell = &pointer2cell( pointer );
 
-  inc_ref( message );
+    inc_ref( frame_pointer );
-  inc_ref( frame_pointer );
+    cell->payload.exception.payload = message;
-  cell->payload.exception.payload = message;
+    cell->payload.exception.frame = frame_pointer;
-  cell->payload.exception.frame = frame_pointer;
 
-  result = pointer;
+    result = pointer;
 
-  return result;
+    return result;
 }
 
 /**
  * Construct a cell which points to an executable Lisp function.
  */
-struct cons_pointer make_function(
+struct cons_pointer make_function( struct cons_pointer meta,
-    struct cons_pointer meta,
+                                   struct cons_pointer ( *executable ) ( struct
-    struct cons_pointer ( *executable )( struct stack_frame *,
+                                                                         stack_frame
-                                         struct cons_pointer,
+                                                                         *,
-                                         struct cons_pointer ) ) {
+                                                                         struct
-  struct cons_pointer pointer = allocate_cell( FUNCTIONTV );
+                                                                         cons_pointer,
-  struct cons_space_object *cell = &pointer2cell( pointer );
+                                                                         struct
-  inc_ref( meta );
+                                                                         cons_pointer ) ) 
+{
+    struct cons_pointer pointer = allocate_cell( FUNCTIONTV );
+    struct cons_space_object *cell = &pointer2cell( pointer );
+    inc_ref( meta );
 
-  cell->payload.function.meta = meta;
+    cell->payload.function.meta = meta;
-  cell->payload.function.executable = executable;
+    cell->payload.function.executable = executable;
 
-  return pointer;
+    return pointer;
 }
 
 /**
@@ -234,18 +239,15 @@ struct cons_pointer make_function(
  */
 struct cons_pointer make_lambda( struct cons_pointer args,
                                  struct cons_pointer body ) {
-  struct cons_pointer pointer = allocate_cell( LAMBDATV );
+    struct cons_pointer pointer = allocate_cell( LAMBDATV );
-  struct cons_space_object *cell = &pointer2cell( pointer );
+    struct cons_space_object *cell = &pointer2cell( pointer );
 
-  inc_ref( pointer ); /* this is a hack; I don't know why it's necessary to do
+    inc_ref( args );
-                         this, but if I don't the cell gets freed */
+    inc_ref( body );
+    cell->payload.lambda.args = args;
+    cell->payload.lambda.body = body;
 
-  inc_ref( args );
+    return pointer;
-  inc_ref( body );
-  cell->payload.lambda.args = args;
-  cell->payload.lambda.body = body;
-
-  return pointer;
 }
 
 /**
@@ -254,18 +256,15 @@ struct cons_pointer make_lambda( struct cons_pointer args,
  */
 struct cons_pointer make_nlambda( struct cons_pointer args,
                                   struct cons_pointer body ) {
-  struct cons_pointer pointer = allocate_cell( NLAMBDATV );
+    struct cons_pointer pointer = allocate_cell( NLAMBDATV );
 
-  inc_ref( pointer ); /* this is a hack; I don't know why it's necessary to do
+    struct cons_space_object *cell = &pointer2cell( pointer );
-                         this, but if I don't the cell gets freed */
+    inc_ref( args );
+    inc_ref( body );
+    cell->payload.lambda.args = args;
+    cell->payload.lambda.body = body;
 
-  struct cons_space_object *cell = &pointer2cell( pointer );
+    return pointer;
-  inc_ref( args );
-  inc_ref( body );
-  cell->payload.lambda.args = args;
-  cell->payload.lambda.body = body;
-
-  return pointer;
 }
 
 /**
@@ -280,22 +279,24 @@ struct cons_pointer make_nlambda( struct cons_pointer args,
  * returns 0 for things which are not string like.
  */
 uint32_t calculate_hash( wint_t c, struct cons_pointer ptr ) {
-  struct cons_space_object *cell = &pointer2cell( ptr );
+    struct cons_space_object *cell = &pointer2cell( ptr );
-  uint32_t result = 0;
+    uint32_t result = 0;
 
-  switch ( cell->tag.value ) {
+    switch ( cell->tag.value ) {
-    case KEYTV:
+        case KEYTV:
-    case STRINGTV:
+        case STRINGTV:
-    case SYMBOLTV:
+        case SYMBOLTV:
-      if ( nilp( cell->payload.string.cdr ) ) {
+            if ( nilp( cell->payload.string.cdr ) ) {
-        result = (uint32_t)c;
+                result = ( uint32_t ) c;
-      } else {
+            } else {
-        result = ( (uint32_t)c * cell->payload.string.hash ) & 0xffffffff;
+                result =
-      }
+                    ( ( uint32_t ) c *
-      break;
+                      cell->payload.string.hash ) & 0xffffffff;
-  }
+            }
+            break;
+    }
 
-  return result;
+    return result;
 }
 
 /**
@@ -306,29 +307,24 @@ uint32_t calculate_hash( wint_t c, struct cons_pointer ptr ) {
  */
 struct cons_pointer make_string_like_thing( wint_t c, struct cons_pointer tail,
                                             uint32_t tag ) {
-  struct cons_pointer pointer = NIL;
+    struct cons_pointer pointer = NIL;
 
-  if ( check_tag( tail, tag ) || check_tag( tail, NILTV ) ) {
+    if ( check_tag( tail, tag ) || check_tag( tail, NILTV ) ) {
-    pointer = allocate_cell( tag );
+        pointer = allocate_cell( tag );
-    struct cons_space_object *cell = &pointer2cell( pointer );
+        struct cons_space_object *cell = &pointer2cell( pointer );
 
-    inc_ref( tail );
+        cell->payload.string.character = c;
-    cell->payload.string.character = c;
+        cell->payload.string.cdr = tail;
-    cell->payload.string.cdr.page = tail.page;
-    /* \todo There's a problem here. Sometimes the offsets on
-     * strings are quite massively off. Fix is probably
-     * cell->payload.string.cdr = tail */
-    cell->payload.string.cdr.offset = tail.offset;
 
-    cell->payload.string.hash = calculate_hash( c, tail );
+        cell->payload.string.hash = calculate_hash( c, tail );
-  } else {
+    } else {
-    // \todo should throw an exception!
+        // \todo should throw an exception!
-    debug_printf( DEBUG_ALLOC,
+        debug_printf( DEBUG_ALLOC,
-                  L"Warning: only NIL and %4.4s can be prepended to %4.4s\n",
+                      L"Warning: only NIL and %4.4s can be prepended to %4.4s\n",
-                  tag, tag );
+                      tag, tag );
-  }
+    }
 
-  return pointer;
+    return pointer;
 }
 
 /**
@@ -340,7 +336,7 @@ struct cons_pointer make_string_like_thing( wint_t c, struct cons_pointer tail,
  * @param tail the string which is being built.
  */
 struct cons_pointer make_string( wint_t c, struct cons_pointer tail ) {
-  return make_string_like_thing( c, tail, STRINGTV );
+    return make_string_like_thing( c, tail, STRINGTV );
 }
 
 /**
@@ -353,45 +349,51 @@ struct cons_pointer make_string( wint_t c, struct cons_pointer tail ) {
  */
 struct cons_pointer make_symbol_or_key( wint_t c, struct cons_pointer tail,
                                         uint32_t tag ) {
-  struct cons_pointer result;
+    struct cons_pointer result;
 
-  if ( tag == SYMBOLTV || tag == KEYTV ) {
+    if ( tag == SYMBOLTV || tag == KEYTV ) {
-    result = make_string_like_thing( c, tail, tag );
+        result = make_string_like_thing( c, tail, tag );
 
-    if ( tag == KEYTV ) {
+        if ( tag == KEYTV ) {
-      struct cons_pointer r = internedp( result, oblist );
+            struct cons_pointer r = internedp( result, oblist );
 
-      if ( nilp( r ) ) {
+            if ( nilp( r ) ) {
-        intern( result, oblist );
+                intern( result, oblist );
-      } else {
+            } else {
-        result = r;
+                result = r;
-      }
+            }
+        }
+    } else {
+        result =
+            make_exception( c_string_to_lisp_string
+                            ( L"Unexpected tag when making symbol or key." ),
+                            NIL );
     }
-  } else {
-    result = make_exception(
-        c_string_to_lisp_string( L"Unexpected tag when making symbol or key." ), 
-        NIL);
-  }
 
-  return result;
+    return result;
 }
 
 /**
  * Construct a cell which points to an executable Lisp special form.
  */
-struct cons_pointer make_special(
+struct cons_pointer make_special( struct cons_pointer meta,
-    struct cons_pointer meta,
+                                  struct cons_pointer ( *executable ) ( struct
-    struct cons_pointer ( *executable )( struct stack_frame *frame,
+                                                                        stack_frame
-                                         struct cons_pointer,
+                                                                        *frame,
-                                         struct cons_pointer env ) ) {
+                                                                        struct
-  struct cons_pointer pointer = allocate_cell( SPECIALTV );
+                                                                        cons_pointer,
-  struct cons_space_object *cell = &pointer2cell( pointer );
+                                                                        struct
-  inc_ref( meta );
+                                                                        cons_pointer
+                                                                        env ) ) 
+{
+    struct cons_pointer pointer = allocate_cell( SPECIALTV );
+    struct cons_space_object *cell = &pointer2cell( pointer );
+    inc_ref( meta );
 
-  cell->payload.special.meta = meta;
+    cell->payload.special.meta = meta;
-  cell->payload.special.executable = executable;
+    cell->payload.special.executable = executable;
 
-  return pointer;
+    return pointer;
 }
 
 /**
@@ -402,13 +404,13 @@ struct cons_pointer make_special(
  */
 struct cons_pointer make_read_stream( URL_FILE *input,
                                       struct cons_pointer metadata ) {
-  struct cons_pointer pointer = allocate_cell( READTV );
+    struct cons_pointer pointer = allocate_cell( READTV );
-  struct cons_space_object *cell = &pointer2cell( pointer );
+    struct cons_space_object *cell = &pointer2cell( pointer );
 
-  cell->payload.stream.stream = input;
+    cell->payload.stream.stream = input;
-  cell->payload.stream.meta = metadata;
+    cell->payload.stream.meta = metadata;
 
-  return pointer;
+    return pointer;
 }
 
 /**
@@ -419,13 +421,13 @@ struct cons_pointer make_read_stream( URL_FILE *input,
  */
 struct cons_pointer make_write_stream( URL_FILE *output,
                                        struct cons_pointer metadata ) {
-  struct cons_pointer pointer = allocate_cell( WRITETV );
+    struct cons_pointer pointer = allocate_cell( WRITETV );
-  struct cons_space_object *cell = &pointer2cell( pointer );
+    struct cons_space_object *cell = &pointer2cell( pointer );
 
-  cell->payload.stream.stream = output;
+    cell->payload.stream.stream = output;
-  cell->payload.stream.meta = metadata;
+    cell->payload.stream.meta = metadata;
 
-  return pointer;
+    return pointer;
 }
 
 /**
@@ -433,43 +435,43 @@ struct cons_pointer make_write_stream( URL_FILE *output,
  * keywords, I am accepting only lower case characters and numbers.
  */
 struct cons_pointer c_string_to_lisp_keyword( wchar_t *symbol ) {
-  struct cons_pointer result = NIL;
+    struct cons_pointer result = NIL;
 
-  for ( int i = wcslen( symbol ) - 1; i >= 0; i-- ) {
+    for ( int i = wcslen( symbol ) - 1; i >= 0; i-- ) {
-    wchar_t c = towlower( symbol[i] );
+        wchar_t c = towlower( symbol[i] );
 
-    if ( iswalnum( c ) || c == L'-' ) {
+        if ( iswalnum( c ) || c == L'-' ) {
-      result = make_keyword( c, result );
+            result = make_keyword( c, result );
+        }
     }
-  }
 
-  return result;
+    return result;
 }
 
 /**
  * Return a lisp string representation of this wide character string.
  */
 struct cons_pointer c_string_to_lisp_string( wchar_t *string ) {
-  struct cons_pointer result = NIL;
+    struct cons_pointer result = NIL;
 
-  for ( int i = wcslen( string ) - 1; i >= 0; i-- ) {
+    for ( int i = wcslen( string ) - 1; i >= 0; i-- ) {
-    if ( iswprint( string[i] ) && string[i] != '"' ) {
+        if ( iswprint( string[i] ) && string[i] != '"' ) {
-      result = make_string( string[i], result );
+            result = make_string( string[i], result );
+        }
     }
-  }
 
-  return result;
+    return result;
 }
 
 /**
  * Return a lisp symbol representation of this wide character string.
  */
 struct cons_pointer c_string_to_lisp_symbol( wchar_t *symbol ) {
-  struct cons_pointer result = NIL;
+    struct cons_pointer result = NIL;
 
-  for ( int i = wcslen( symbol ); i > 0; i-- ) {
+    for ( int i = wcslen( symbol ); i > 0; i-- ) {
-    result = make_symbol( symbol[i - 1], result );
+        result = make_symbol( symbol[i - 1], result );
-  }
+    }
 
-  return result;
+    return result;
 }

src/memory/dump.c

@@ -29,7 +29,7 @@
 #include "memory/vectorspace.h"
 
 
-void dump_string_cell( URL_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 ) {
@@ -56,7 +56,7 @@ void dump_string_cell( URL_FILE * output, wchar_t *prefix,
 /**
  * dump the object at this cons_pointer to this output stream.
  */
-void dump_object( URL_FILE * output, struct cons_pointer pointer ) {
+void dump_object( URL_FILE *output, struct cons_pointer pointer ) {
     struct cons_space_object cell = pointer2cell( pointer );
     url_fwprintf( output, L"\t%4.4s (%d) at page %d, offset %d count %u\n",
                   cell.tag.bytes, cell.tag.value, pointer.page, pointer.offset,
@@ -114,10 +114,10 @@ void dump_object( URL_FILE * output, struct cons_pointer pointer ) {
         case RATIOTV:
             url_fwprintf( output,
                           L"\t\tRational cell: value %ld/%ld, count %u\n",
-                          pointer2cell( cell.payload.ratio.dividend ).payload.
+                          pointer2cell( cell.payload.ratio.dividend ).
-                          integer.value,
+                          payload.integer.value,
-                          pointer2cell( cell.payload.ratio.divisor ).payload.
+                          pointer2cell( cell.payload.ratio.divisor ).
-                          integer.value, cell.count );
+                          payload.integer.value, cell.count );
             break;
         case READTV:
             url_fputws( L"\t\tInput stream; metadata: ", output );

src/memory/hashmap.c

@@ -54,12 +54,12 @@ struct cons_pointer lisp_make_hashmap( struct stack_frame *frame,
         }
     }
     if ( frame->args > 1 ) {
-        if ( functionp( frame->arg[1])) {
+        if ( functionp( frame->arg[1] ) ) {
-        hash_fn = frame->arg[1];
+            hash_fn = frame->arg[1];
-        } else if ( nilp(frame->arg[1])){
+        } else if ( nilp( frame->arg[1] ) ) {
             /* that's allowed */
         } else {
-           result =
+            result =
                 make_exception( c_string_to_lisp_string
                                 ( L"Second arg to `hashmap`, if passed, must "
                                   L"be a function or `nil`.`" ), NIL );
@@ -87,16 +87,12 @@ struct cons_pointer lisp_make_hashmap( struct stack_frame *frame,
                                         &( map->payload ) )->n_buckets;
 
                 map->payload.hashmap.buckets[bucket_no] =
-                    inc_ref( make_cons( make_cons( key, val ),
+                    make_cons( make_cons( key, val ),
-                                        map->payload.hashmap.
+                               map->payload.hashmap.buckets[bucket_no] );
-                                        buckets[bucket_no] ) );
             }
         }
     }
 
-    // TODO: I am not sure this is right! We do not inc_ref a string when
-    // we make it.
-    inc_ref(result);
     return result;
 }
 
@@ -117,10 +113,7 @@ struct cons_pointer lisp_hashmap_put( struct stack_frame *frame,
     struct cons_pointer val = frame->arg[2];
 
     struct cons_pointer result = hashmap_put( mapp, key, val );
-    struct cons_space_object *cell = &pointer2cell( result);
+    struct cons_space_object *cell = &pointer2cell( result );
-    // if (cell->count <= 1) {
-    //     inc_ref( result); // TODO: I DO NOT BELIEVE this is the right place! 
-    // }
     return result;
 
     // TODO: else clone and return clone.
@@ -142,7 +135,7 @@ struct cons_pointer lisp_hashmap_keys( struct stack_frame *frame,
     return hashmap_keys( frame->arg[0] );
 }
 
-void dump_map( URL_FILE * output, struct cons_pointer pointer ) {
+void dump_map( URL_FILE *output, struct cons_pointer pointer ) {
     struct hashmap_payload *payload =
         &pointer_to_vso( pointer )->payload.hashmap;
     url_fwprintf( output, L"Hashmap with %d buckets:\n", payload->n_buckets );

src/memory/lookup3.c

@@ -170,7 +170,7 @@ and these came close:
  hashlittle() has to dance around fitting the key bytes into registers.
 --------------------------------------------------------------------
 */
-uint32_t hashword( const uint32_t * k,  /* the key, an array of uint32_t values */
+uint32_t hashword( const uint32_t *k, /* the key, an array of uint32_t values */
                    size_t length, /* the length of the key, in uint32_ts */
                    uint32_t initval ) { /* the previous hash, or an arbitrary value */
     uint32_t a, b, c;
@@ -213,10 +213,10 @@ both be initialized with seeds.  If you pass in (*pb)==0, the output
 (*pc) will be the same as the return value from hashword().
 --------------------------------------------------------------------
 */
-void hashword2( const uint32_t * k, /* the key, an array of uint32_t values */
+void hashword2( const uint32_t *k,  /* the key, an array of uint32_t values */
                 size_t length,  /* the length of the key, in uint32_ts */
-                uint32_t * pc,  /* IN: seed OUT: primary hash value */
+                uint32_t *pc,   /* IN: seed OUT: primary hash value */
-                uint32_t * pb ) { /* IN: more seed OUT: secondary hash value */
+                uint32_t *pb ) {  /* IN: more seed OUT: secondary hash value */
     uint32_t a, b, c;
 
     /* Set up the internal state */
@@ -538,8 +538,8 @@ uint32_t hashlittle( const void *key, size_t length, uint32_t initval ) {
  */
 void hashlittle2( const void *key,  /* the key to hash */
                   size_t length,  /* length of the key */
-                  uint32_t * pc,  /* IN: primary initval, OUT: primary hash */
+                  uint32_t *pc, /* IN: primary initval, OUT: primary hash */
-                  uint32_t * pb ) { /* IN: secondary initval, OUT: secondary hash */
+                  uint32_t *pb ) {  /* IN: secondary initval, OUT: secondary hash */
     uint32_t a, b, c;           /* internal state */
     union {
         const void *ptr;

src/memory/stack.c

@@ -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( URL_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( URL_FILE * output, struct cons_pointer frame_pointer ) {
     }
 }
 
-void dump_stack_trace( URL_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.payload );
         url_fputws( L"\n", output );

src/memory/vectorspace.c

@@ -85,7 +85,7 @@ struct cons_pointer make_vso( uint32_t tag, uint64_t payload_size ) {
 
     if ( vso != NULL ) {
         memset( vso, 0, padded );
-                vso->header.tag.value = tag;
+        vso->header.tag.value = tag;
 
         debug_printf( DEBUG_ALLOC,
                       L"make_vso: written tag '%4.4s' into vso at %p\n",

src/ops/intern.c

@@ -36,7 +36,7 @@
 // #include "print.h"
 
 /**
- * The global object list/or, to put it differently, the root namespace.
+ * @brief The global object list/or, to put it differently, the root namespace.
  * What is added to this during system setup is 'global', that is,
  * visible to all sessions/threads. What is added during a session/thread is local to
  * that session/thread (because shallow binding). There must be some way for a user to
@@ -47,6 +47,12 @@
  */
 struct cons_pointer oblist = NIL;
 
+/**
+ * @brief the symbol `NIL`, which is special!
+ * 
+ */
+struct cons_pointer privileged_symbol_nil = NIL;
+
 /**
  * Return a hash value for the structure indicated by `ptr` such that if
  * `x`,`y` are two separate structures whose print representation is the same
@@ -163,7 +169,6 @@ struct cons_pointer hashmap_keys( struct cons_pointer mapp ) {
                   !nilp( c ); c = c_cdr( c ) ) {
                 result = make_cons( c_car( c_car( c ) ), result );
             }
-
         }
     }
 
@@ -186,20 +191,20 @@ struct cons_pointer hashmap_put_all( struct cons_pointer mapp,
                   pair = c_car( assoc ) ) {
                 /* TODO: this is really hammering the memory management system, because
                  * it will make a new lone for every key/value pair added. Fix. */
-                if (consp( pair)) {
+                if ( consp( pair ) ) {
                     mapp = hashmap_put( mapp, c_car( pair ), c_cdr( pair ) );
-                } else if (hashmapp( pair)) {
+                } else if ( hashmapp( pair ) ) {
-                    hashmap_put_all( mapp, pair);
+                    hashmap_put_all( mapp, pair );
                 } else {
-                    hashmap_put( mapp, pair, TRUE);
+                    hashmap_put( mapp, pair, TRUE );
                 }
-                assoc = c_cdr( assoc);
+                assoc = c_cdr( assoc );
             }
-        } else if (hashmapp( assoc)) {
+        } else if ( hashmapp( assoc ) ) {
-            for (struct cons_pointer keys = hashmap_keys( assoc); !nilp( keys);
+            for ( struct cons_pointer keys = hashmap_keys( assoc );
-                keys = c_cdr( keys)) {
+                  !nilp( keys ); keys = c_cdr( keys ) ) {
-                struct cons_pointer key = c_car( keys);
+                struct cons_pointer key = c_car( keys );
-                hashmap_put( mapp, key, hashmap_get( assoc, key));
+                hashmap_put( mapp, key, hashmap_get( assoc, key ) );
             }
         }
     }
@@ -241,7 +246,8 @@ struct cons_pointer clone_hashmap( struct cons_pointer ptr ) {
                 result =
                     make_hashmap( from_pl.n_buckets, from_pl.hash_fn,
                                   from_pl.write_acl );
-                struct vector_space_object const *to = pointer_to_vso( result );
+                struct vector_space_object const *to =
+                    pointer_to_vso( result );
                 struct hashmap_payload to_pl = to->payload.hashmap;
 
                 for ( int i = 0; i < to_pl.n_buckets; i++ ) {
@@ -252,14 +258,16 @@ struct cons_pointer clone_hashmap( struct cons_pointer ptr ) {
         }
     } else {
         result =
-                make_exception( c_string_to_lisp_string
+            make_exception( c_string_to_lisp_string
-                                ( L"Arg to `clone_hashmap` must "
+                            ( L"Arg to `clone_hashmap` must "
-                                  L"be a readable hashmap.`" ), NIL );
+                              L"be a readable hashmap.`" ), NIL );
     }
 
     return result;
 }
 
+// (keys set let quote read equal *out* *log* oblist cons source cond close meta mapcar negative? open subtract eval nλ *in* *sink* cdr set! reverse slurp try assoc eq add list time car t *prompt* absolute append apply divide exception get-hash hashmap inspect metadata multiply print put! put-all! read-char repl throw type + * - / = lambda λ nlambda progn)
+
 /**
  * Implementation of interned? in C. The final implementation if interned? will
  * deal with stores which can be association lists or hashtables or hybrids of
@@ -292,8 +300,10 @@ internedp( struct cons_pointer key, struct cons_pointer store ) {
         //     if ( equal( key, entry.payload.cons.car ) ) {
         //         result = entry.payload.cons.car;
         //     }
-        if (!nilp( c_assoc( store, key))) {
+        if ( !nilp( c_assoc( key, store ) ) ) {
             result = key;
+        } else if ( equal( key, privileged_symbol_nil ) ) {
+            result = privileged_symbol_nil;
         }
     } else {
         debug_print( L"`", DEBUG_BIND );
@@ -340,18 +350,24 @@ struct cons_pointer c_assoc( struct cons_pointer key,
                         result = hashmap_get( entry_ptr, key );
                         break;
                     default:
-                        throw_exception( c_string_to_lisp_string
+                        throw_exception( c_append
-                                         ( L"Store entry is of unknown type" ),
+                                         ( c_string_to_lisp_string
-                                         NIL );
+                                           ( L"Store entry is of unknown type: " ),
+                                           c_type( entry_ptr ) ), NIL );
                 }
             }
         }
     } else if ( hashmapp( store ) ) {
         result = hashmap_get( store, key );
     } else if ( !nilp( store ) ) {
+        debug_print( L"c_assoc; store is of unknown type `", DEBUG_BIND );
+        debug_print_object( c_type( store ), DEBUG_BIND );
+        debug_print( L"`\n", DEBUG_BIND );
         result =
-            throw_exception( c_string_to_lisp_string
+            throw_exception( c_append
-                             ( L"Store is of unknown type" ), NIL );
+                             ( c_string_to_lisp_string
+                               ( L"Store is of unknown type: " ),
+                               c_type( store ) ), NIL );
     }
 
     debug_print( L"c_assoc returning ", DEBUG_BIND );
@@ -405,14 +421,14 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
     debug_dump_object( store, DEBUG_BIND );
     debug_println( DEBUG_BIND );
 
-    debug_printf( DEBUG_BIND, L"set: store is %s\n`", lisp_string_to_c_string( c_type( store)) );
+    debug_printf( DEBUG_BIND, L"set: store is %s\n`",
-    if (nilp( value)) {
+                  lisp_string_to_c_string( c_type( store ) ) );
+    if ( nilp( value ) ) {
         result = store;
-    }
+    } else if ( nilp( store ) || consp( store ) ) {
-    else if ( nilp( store ) || consp( store ) ) {
         result = make_cons( make_cons( key, value ), store );
     } else if ( hashmapp( store ) ) {
-        debug_print( L"set: storing in hashmap\n", DEBUG_BIND);
+        debug_print( L"set: storing in hashmap\n", DEBUG_BIND );
         result = hashmap_put( store, key, value );
     }
 
@@ -424,9 +440,8 @@ struct cons_pointer set( struct cons_pointer key, struct cons_pointer value,
 }
 
 /**
- * Binds this key to this value in the global oblist, but doesn't affect the
+ * @brief Binds this key to this value in the global oblist.
- * current environment. May not be useful except in bootstrapping (and even
+
- * there it may not be especially useful).
  */
 struct cons_pointer
 deep_bind( struct cons_pointer key, struct cons_pointer value ) {
@@ -448,10 +463,10 @@ deep_bind( struct cons_pointer key, struct cons_pointer value ) {
     }
 
     debug_print( L"deep_bind returning ", DEBUG_BIND );
-    debug_print_object( oblist, DEBUG_BIND );
+    debug_print_object( key, DEBUG_BIND );
     debug_println( DEBUG_BIND );
 
-    return oblist;
+    return key;
 }
 
 /**

src/ops/intern.h

@@ -20,6 +20,8 @@
 #ifndef __intern_h
 #define __intern_h
 
+extern struct cons_pointer privileged_symbol_nil;
+
 extern struct cons_pointer oblist;
 
 uint32_t get_hash( struct cons_pointer ptr );

src/ops/lispops.c

@@ -38,6 +38,13 @@
 #include "memory/stack.h"
 #include "memory/vectorspace.h"
 
+/**
+ * @brief the name of the symbol to which the prompt is bound;
+ * 
+ * Set in init to `*prompt*`
+ */
+struct cons_pointer prompt_name;
+
 /*
  * also to create in this section:
  * struct cons_pointer lisp_let( struct cons_pointer args, struct cons_pointer env,
@@ -46,7 +53,6 @@
  * and others I haven't thought of yet.
  */
 
-
 /**
  * Useful building block; evaluate this single form in the context of this
  * parent stack frame and this environment.
@@ -440,9 +446,10 @@ c_apply( struct stack_frame *frame, struct cons_pointer frame_pointer,
                         result = next_pointer;
                     } else {
                         result =
-                            ( *fn_cell.payload.special.
+                            ( *fn_cell.payload.
-                              executable ) ( get_stack_frame( next_pointer ),
+                              special.executable ) ( get_stack_frame
-                                             next_pointer, env );
+                                                     ( next_pointer ),
+                                                     next_pointer, env );
                         debug_print( L"Special form returning: ", DEBUG_EVAL );
                         debug_print_object( result, DEBUG_EVAL );
                         debug_println( DEBUG_EVAL );
@@ -1239,7 +1246,8 @@ lisp_exception( struct stack_frame *frame, struct cons_pointer frame_pointer,
                 struct cons_pointer env ) {
     struct cons_pointer message = frame->arg[0];
     return exceptionp( message ) ? message : throw_exception( message,
-                                                              frame->previous );
+                                                              frame->
+                                                              previous );
 }
 
 /**
@@ -1259,25 +1267,25 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
                                struct cons_pointer env ) {
     struct cons_pointer expr = NIL;
 
-    debug_printf(DEBUG_REPL, L"Entering new inner REPL\n");
+    debug_printf( DEBUG_REPL, L"Entering new inner REPL\n" );
 
     struct cons_pointer input = get_default_stream( true, env );
     struct cons_pointer output = get_default_stream( false, env );
-    struct cons_pointer prompt_name = c_string_to_lisp_symbol( L"*prompt*" );
+//    struct cons_pointer prompt_name = c_string_to_lisp_symbol( L"*prompt*" );
     struct cons_pointer old_oblist = oblist;
     struct cons_pointer new_env = env;
 
-    inc_ref( env );
+    if ( truep( frame->arg[0] ) ) {
-
+        new_env = set( prompt_name, frame->arg[0], new_env );
-    if (truep(frame->arg[0])) {
-        new_env = set( prompt_name, frame->arg[0], new_env);
     }
-    if (readp(frame->arg[1])) {
+    if ( readp( frame->arg[1] ) ) {
-        new_env = set( c_string_to_lisp_symbol(L"*in*"), frame->arg[1], new_env);
+        new_env =
+            set( c_string_to_lisp_symbol( L"*in*" ), frame->arg[1], new_env );
         input = frame->arg[1];
     }
-    if (readp(frame->arg[2])) {
+    if ( readp( frame->arg[2] ) ) {
-        new_env = set( c_string_to_lisp_symbol(L"*out*"), frame->arg[2], new_env);
+        new_env =
+            set( c_string_to_lisp_symbol( L"*out*" ), frame->arg[2], new_env );
         output = frame->arg[2];
     }
 
@@ -1332,7 +1340,6 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
 
         expr = lisp_read( get_stack_frame( frame_pointer ), frame_pointer,
                           new_env );
-        inc_ref( expr );
 
         if ( exceptionp( expr )
              && url_feof( pointer2cell( input ).payload.stream.stream ) ) {
@@ -1350,9 +1357,9 @@ struct cons_pointer lisp_repl( struct stack_frame *frame,
     dec_ref( input );
     dec_ref( output );
     dec_ref( prompt_name );
-    dec_ref( env );
+    dec_ref( new_env );
 
-    debug_printf(DEBUG_REPL, L"Leaving inner repl\n");
+    debug_printf( DEBUG_REPL, L"Leaving inner repl\n" );
 
     return expr;
 }
@@ -1423,13 +1430,14 @@ struct cons_pointer c_append( struct cons_pointer l1, struct cons_pointer l2 ) {
             if ( pointer2cell( l1 ).tag.value == pointer2cell( l2 ).tag.value ) {
                 if ( nilp( c_cdr( l1 ) ) ) {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).payload.
+                        make_string_like_thing( ( pointer2cell( l1 ).
-                                                  string.character ), l2,
+                                                  payload.string.character ),
+                                                l2,
                                                 pointer2cell( l1 ).tag.value );
                 } else {
                     return
-                        make_string_like_thing( ( pointer2cell( l1 ).payload.
+                        make_string_like_thing( ( pointer2cell( l1 ).
-                                                  string.character ),
+                                                  payload.string.character ),
                                                 c_append( c_cdr( l1 ), l2 ),
                                                 pointer2cell( l1 ).tag.value );
                 }
@@ -1558,43 +1566,35 @@ struct cons_pointer lisp_let( struct stack_frame *frame,
 
 }
 
-// /**
+// struct cons_pointer c_concat( struct cons_pointer a, struct cons_pointer b) {
-//  * Function; print the internal representation of the object indicated by `frame->arg[0]` to the
+//     struct cons_pointer result = b;
-//  * (optional, defaults to the value of `*out*` in the environment) stream indicated by `frame->arg[1]`.
-//  *
-//  * * (inspect expression)
-//  * * (inspect expression <write-stream>)
-//  *
-//  * @param frame my stack frame.
-//  * @param frame_pointer a pointer to my stack_frame.
-//  * @param env the environment.
-//  * @return the value of the first argument - `expression`.
-//  */
-// 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 );
-//     URL_FILE *output;
-//     struct cons_pointer out_stream = writep( frame->arg[1] ) ?
-//         frame->arg[1] : get_default_stream( false, env );
 
-//     if ( writep( out_stream ) ) {
+//     if ( nilp( b.tag.value)) {
-//         debug_print( L"lisp_print: setting output stream\n", DEBUG_IO );
+//         result = make_cons( a, b);
-//         debug_dump_object( out_stream, DEBUG_IO );
-//         output = pointer2cell( out_stream ).payload.stream.stream;
-//         inc_ref( out_stream );
 //     } else {
-//         output = file_to_url_file( stdout );
+//         if ( ! nilp( a)) {
+//             if (a.tag.value == b.tag.value) {
+
+//                 struct cons_pointer tail = c_concat( c_cdr( a), b);
+
+//                 switch ( a.tag.value) {
+//                     case CONSTV:
+//                         result = make_cons( c_car( a), tail);
+//                         break;
+//                     case KEYTV:
+//                     case STRINGTV:
+//                     case SYMBOLTV:
+//                         result = make_string_like_thing()
+
+//                 }
+
+//             } else {
+//                 // throw an exception
+//             }
+//         }
 //     }
 
-//     dump_object( output, frame->arg[0] );
-//     url_fputws( L"\n", output );
 
-//     if ( writep( out_stream ) ) {
-//         dec_ref( out_stream );
-//     } else {
-//         free( output );
-//     }
 
-//     return frame->arg[0];
+//     return result;
 // }

src/ops/lispops.h

@@ -22,6 +22,8 @@
 #ifndef __psse_lispops_h
 #define __psse_lispops_h
 
+extern struct cons_pointer prompt_name;
+
 /*
  * utilities
  */

src/repl.c

@@ -23,15 +23,15 @@
  * 
  * @param dummy 
  */
-void int_handler(int dummy) {
+void int_handler( int dummy ) {
-    wprintf(L"TODO: handle ctrl-C in a more interesting way\n");
+    wprintf( L"TODO: handle ctrl-C in a more interesting way\n" );
 }
 
 /**
  * The read/eval/print loop.
  */
 void repl(  ) {
-    signal(SIGINT, int_handler);
+    signal( SIGINT, int_handler );
     debug_print( L"Entered repl\n", DEBUG_REPL );
 
     struct cons_pointer env =
@@ -41,8 +41,6 @@ void repl(  ) {
     struct cons_pointer frame_pointer = make_stack_frame( NIL, NIL, env );
 
     if ( !nilp( frame_pointer ) ) {
-        inc_ref( frame_pointer );
-
         lisp_repl( get_stack_frame( frame_pointer ), frame_pointer, env );
 
         dec_ref( frame_pointer );

state-of-play.md

@@ -1,115 +0,0 @@
-# State of Play
-
-## 20260203
-
-I'm consciously avoiding the bignum issue for now. My current thinking is that if the C code only handles 64 bit integers, and bignums have to be done in Lisp code, that's perfectly fine with me.
-
-### Hashmaps, assoc lists, and generalised key/value stores
-
-I now have the oblist working as a hashmap, and also hybrid assoc lists which incorporate hashmaps working. I don't 100% have consistent methods for reading stores which may be plain old assoc lists, new hybrid assoc lists, or hashmaps working but it isn't far off. This also takes me streets further towards doing hierarchies of hashmaps, allowing my namespace idea to work — and hybrid assoc lists provide a very sound basis for building environment structures.
-
-Currently all hashmaps are mutable, and my doctrine is that that is fixable when access control lists are actually implemented. 
-
-#### assoc
-
-The function `(assoc store key) => value` should be the standard way of getting a value out of a store.  
-
-#### put!
-
-The function `(put! store key value) => store` should become the standard way of setting a value in a store (of course, if the store is an assoc list or an immutable map, a new store will be returned which holds the additional key/value binding).
-
-### State of unit tests
-
-Currently:
-
-> Tested 45, passed 39, failed 6
-
-But the failures are as follows:
-```
-unit-tests/bignum-add.sh => checking a bignum was created: Fail
-unit-tests/bignum-add.sh => adding 1152921504606846977 to 1: Fail: expected 't', got 'nil'
-unit-tests/bignum-add.sh => adding 1 to 1152921504606846977: Fail: expected 't', got 'nil'
-unit-tests/bignum-add.sh => adding 1152921504606846977 to 1152921504606846977: Fail: expected 't', got 'nil'
-unit-tests/bignum-add.sh => adding 10000000000000000000 to 10000000000000000000: Fail: expected 't', got 'nil'
-unit-tests/bignum-add.sh => adding 1 to 1329227995784915872903807060280344576: Fail: expected 't', got 'nil'
-unit-tests/bignum-add.sh => adding 1 to 3064991081731777716716694054300618367237478244367204352: Fail: expected 't', got 'nil'
-unit-tests/bignum-expt.sh => (expt 2 60): Fail: expected '1152921504606846976', got '1'
-unit-tests/bignum-expt.sh => (expt 2 61): Fail: expected '2305843009213693952', got '2'
-unit-tests/bignum-expt.sh => (expt 2 64): Fail: expected '18446744073709551616', got '16'
-unit-tests/bignum-expt.sh => (expt 2 65): Fail: expected '36893488147419103232', got '32'
-unit-tests/bignum-print.sh => printing 1152921504606846976: Fail: expected '1152921504606846976', got '1'
-unit-tests/bignum-print.sh => printing 1152921504606846977: Fail: expected '1152921504606846977', got '2'
-unit-tests/bignum-print.sh => printing 1329227995784915872903807060280344576: Fail: expected '1329227995784915872903807060280344576', \n           got '1151321504605245376'
-unit-tests/bignum.sh => unit-tests/bignum.sh => Fail: expected '1,152,921,504,606,846,976', got '1'
-unit-tests/bignum-subtract.sh => unit-tests/bignum-subtract.sh => subtracting 1 from 1152921504606846976: Fail: expected '1152921504606846975', got '0'
-unit-tests/bignum-subtract.sh => subtracting 1 from 1152921504606846977: Fail: expected '1152921504606846976', got '1'
-unit-tests/bignum-subtract.sh => subtracting 1 from 1152921504606846978: Fail: expected '1152921504606846977', got '2'
-unit-tests/bignum-subtract.sh => subtracting 1152921504606846977 from 1: Fail: expected '-1152921504606846976', got '1'
-unit-tests/bignum-subtract.sh => subtracting 10000000000000000000 from 20000000000000000000: Fail: expected '10000000000000000000', got '-376293541461622793'
-unit-tests/memory.sh
-```
-
-In other words, all failures are in bignum arithmetic **except** that I still have a major memory leak due to not decrefing somewhere where I ought to.
-
-### Zig
-
-## 20250704
-
-Right, I'm getting second and subsequent integer cells with negative values, which should not happen. This is probably the cause of (at least some of) the bignum problems. I need to find out why. This is (probably) fixable.
-
-```lisp
-:: (inspect 10000000000000000000)
-
-        INTR (1381256777) at page 3, offset 873 count 2
-                Integer cell: value 776627963145224192, count 2
-                BIGNUM! More at:
-        INTR (1381256777) at page 3, offset 872 count 1
-                Integer cell: value -8, count 1
-```
-
-Also, `print` is printing bignums wrong on ploughwright, but less wrong on mason, which implies a code difference. Investigate.
-
-## 20250314
-
-Thinking further about this, I think at least part of the problem is that I'm storing bignums as cons-space objects, which means that the integer representation I can store has to fit into the size of a cons pointer, which is 64 bits. Which means that to store integers larger than 64 bits I need chains of these objects.
-
-If I stored bignums in vector space, this problem would go away (especially as I have not implemented vector space yet). 
-
-However, having bignums in vector space would cause a churn of non-standard-sized objects in vector space, which would mean much more frequent garbage collection, which has to be mark-and-sweep because unequal-sized objects, otherwise you get heap fragmentation.
-
-So maybe I just have to put more work into debugging my cons-space bignums.
-
-Bother, bother.
-
-There are no perfect solutions.
-
-However however, it's only the node that's short on vector space which has to pause to do a mark and sweep. It doesn't interrupt any other node, because their reference to the object will remain the same, even if it is the 'home node' of the object which is sweeping. So all the node has to do is set its busy flag, do GC, and clear its busy flag, The rest of the system can just be carrying on as normal.
-
-So... maybe mark and sweep isn't the big deal I think it is?
-
-## 20250313
-
-OK, the 60 bit integer cell happens in `int128_to_integer` in `arith/integer.c`. It seems to be being done consistently; but there is no obvious reason. `MAX_INTEGER` is defined in `arith/peano.h`. I've changed both to use 63 bits, and this makes no change to the number of unit tests that fail.
-
-With this change, `(fact 21)`, which was previously printing nothing, now prints a value, `11,891,611,015,076,642,816`. However, this value is definitively wrong, should be `51,090,942,171,709,440,000`. But, I hadn't fixed the shift in `integer_to_string`; have now... still no change in number of failed tests...
-
-But `(fact 21)` gives a different wrong value, `4,974,081,987,435,560,960`. Factorial values returned by `fact` are correct (agree with SBCL running the same code) up to `(fact 20)`, with both 60 bit integer cells and 63 bit integer cells giving correct values.
-
-Uhhhmmm... but I'd missed two other places where I'd had the number of significant bits as a numeric literal. Fixed those and now `(fact 21)` does not return a printable answer at all, although the internal representation is definitely wrong. So we may be seeing why I chose 60 bits.
-
-Bother.
-
-## 20250312
-
-Printing of bignums definitely doesn't work; I'm not persuaded that reading of bignums works right either, and there are probably problems with bignum arithmetic too.
-
-The internal memory representation of a number rolls over from one cell to two cells at 1152921504606846976, and I'm not at all certain why it does because this is neither 2<sup>63</sup> nor 2<sup>64</sup>.
-
-|                |                      |      |
-| -------------- | -------------------- | ---- |
-| 2<sup>62</sup> | 4611686018427387904  |      |
-| 2<sup>63</sup> | 9223372036854775808  |      |
-| 2<sup>64</sup> | 18446744073709551616 |      |
-| Mystery number | 1152921504606846976  |      |
-
-In fact, our mystery number turns out (by inspection) to be 2<sup>60</sup>. But **why**?

unit-tests/add.sh

@@ -1,79 +1,92 @@
 #!/bin/bash
 
+result=0;
+
+echo -n "$0: Add two small integers... "
+
 expected='5'
-actual=`echo "(add 2 3)" | target/psse | tail -1`
+actual=`echo "(add 2 3)" | target/psse 2>/dev/null | sed -r '/^\s*$/d' | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=`echo "${result} + 1" | bc`
 fi
 
+echo -n "$0: Add float to integer... "
+
 expected='5.5'
-actual=`echo "(add 2.5 3)" | target/psse | tail -1`
+actual=`echo "(add 2.5 3)" | target/psse 2>/dev/null | sed -r '/^\s*$/d' | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
-    exit 0
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=`echo "${result} + 1" | bc`
 fi
 
+echo -n "$0: Add two rationals... "
+
 expected='1/4'
-actual=`echo "(+ 3/14 1/28)" | target/psse | tail -1`
+actual=`echo "(+ 3/14 1/28)" | target/psse 2>/dev/null | sed -r '/^\s*$/d' | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=`echo "${result} + 1" | bc`
 fi
 
+echo -n "$0: Add an integer to a rational... "
+
 # (+ integer ratio) should be ratio
 expected='25/4'
-actual=`echo "(+ 6 1/4)" | target/psse | tail -1`
+actual=`echo "(+ 6 1/4)" | target/psse  2>/dev/null | sed -r '/^\s*$/d' | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=`echo "${result} + 1" | bc`
 fi
 
+echo -n "$0: Add a rational to an integer... "
+
 # (+ ratio integer) should be ratio
 expected='25/4'
-actual=`echo "(+ 1/4 6)" | target/psse | tail -1`
+actual=`echo "(+ 1/4 6)" | target/psse 2>/dev/null | sed -r '/^\s*$/d' | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=`echo "${result} + 1" | bc`
 fi
 
+echo -n "$0: Add a real to a rational... "
+
 # (+ real ratio) should be real
 # for this test, trailing zeros can be ignored
 expected='6.25'
 actual=`echo "(+ 6.000000001 1/4)" |\
   target/psse 2> /dev/null |\
-  sed 's/0*$//' |\
+  sed -r '/^\s*$/d' |\
-  head -2 |\
+  sed 's/0*$//' 
-  tail -1`
 
 outcome=`echo "sqrt((${expected} - ${actual})^2) < 0.0000001" | bc`
 
-if [ "${outcome}" = "1" ]
+if [ "${outcome}" -eq "1" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=`echo "${result} + 1" | bc `
 fi
 
+exit ${result}

unit-tests/allocation-tests/allocation-tester.sh

@@ -0,0 +1,22 @@
+#1/bin/bash
+
+echo "Case, Summary, Allocated, Deallocated, Not deallocated, Delta Allocated, Delta Deallocated, Delta Not Deallocated"
+basecase=`echo '' | ../../target/psse 2>&1 | grep Allocation | tr -d  '[:punct:]'`
+bca=`echo ${basecase} | awk '{print $4}'`
+bcd=`echo ${basecase} | awk '{print $6}'`
+bcn=`echo ${basecase} | awk '{print $9}'`
+
+echo "\"Basecase\", \"${basecase}\", ${bca}, ${bcd}, ${bcn}"
+
+while IFS= read -r form; do
+    allocation=`echo ${form} | ../../target/psse 2>&1 | grep Allocation | tr -d  '[:punct:]'`
+    tca=`echo ${allocation} | awk '{print $4}'`
+    tcd=`echo ${allocation} | awk '{print $6}'`
+    tcn=`echo ${allocation} | awk '{print $9}'`
+
+    dca=`echo "${tca} - ${bca}" | bc`
+    dcd=`echo "${tcd} - ${bcd}" | bc`
+    dcn=`echo "${tcn} - ${bcn}" | bc`
+
+    echo "\"${form}\", \"${allocation}\", ${tca}, ${tcd}, ${tcn}, ${dca}, ${dcd}, ${dcn}" 
+done

unit-tests/allocation-tests/allocation-tests.csv

@@ -0,0 +1,28 @@
+Case, Summary, Allocated, Deallocated, Not deallocated, Delta Allocated, Delta Deallocated, Delta Not Deallocated
+"Basecase", "Allocation summary allocated 19986 deallocated 245 not deallocated 19741", 19986, 245, 19741
+"", "Allocation summary allocated 19986 deallocated 245 not deallocated 19741", 19986, 245, 19741, 0, 0, 0
+"nil", "Allocation summary allocated 20019 deallocated 253 not deallocated 19766", 20019, 253, 19766, 33, 8, 25
+"()", "Allocation summary allocated 19990 deallocated 249 not deallocated 19741", 19990, 249, 19741, 4, 4, 0
+"(quote ())", "Allocation summary allocated 20025 deallocated 247 not deallocated 19778", 20025, 247, 19778, 39, 2, 37
+"(list)", "Allocation summary allocated 20023 deallocated 257 not deallocated 19766", 20023, 257, 19766, 37, 12, 25
+"(list )", "Allocation summary allocated 20023 deallocated 257 not deallocated 19766", 20023, 257, 19766, 37, 12, 25
+"(list 1)", "Allocation summary allocated 20033 deallocated 259 not deallocated 19774", 20033, 259, 19774, 47, 14, 33
+"(list 1 1)", "Allocation summary allocated 20043 deallocated 261 not deallocated 19782", 20043, 261, 19782, 57, 16, 41
+"(list 1 1 1)", "Allocation summary allocated 20053 deallocated 263 not deallocated 19790", 20053, 263, 19790, 67, 18, 49
+"(list 1 2 3)", "Allocation summary allocated 20053 deallocated 263 not deallocated 19790", 20053, 263, 19790, 67, 18, 49
+"(+)", "Allocation summary allocated 20022 deallocated 255 not deallocated 19767", 20022, 255, 19767, 36, 10, 26
+"(+ 1)", "Allocation summary allocated 20030 deallocated 257 not deallocated 19773", 20030, 257, 19773, 44, 12, 32
+"(+ 1 1)", "Allocation summary allocated 20039 deallocated 259 not deallocated 19780", 20039, 259, 19780, 53, 14, 39
+"(+ 1 1 1)", "Allocation summary allocated 20048 deallocated 261 not deallocated 19787", 20048, 261, 19787, 62, 16, 46
+"(+ 1 2 3)", "Allocation summary allocated 20048 deallocated 261 not deallocated 19787", 20048, 261, 19787, 62, 16, 46
+"(list 'a 'a 'a)", "Allocation summary allocated 20137 deallocated 278 not deallocated 19859", 20137, 278, 19859, 151, 33, 118
+"(list 'a 'b 'c)", "Allocation summary allocated 20137 deallocated 278 not deallocated 19859", 20137, 278, 19859, 151, 33, 118
+"(list :a :b :c)", "Allocation summary allocated 20107 deallocated 260 not deallocated 19847", 20107, 260, 19847, 121, 15, 106
+"(list :alpha :bravo :charlie)", "Allocation summary allocated 20471 deallocated 260 not deallocated 20211", 20471, 260, 20211, 485, 15, 470
+"{}", "Allocation summary allocated 19992 deallocated 251 not deallocated 19741", 19992, 251, 19741, 6, 6, 0
+"{:z 0}", "Allocation summary allocated 20029 deallocated 255 not deallocated 19774", 20029, 255, 19774, 43, 10, 33
+"{:zero 0}", "Allocation summary allocated 20107 deallocated 255 not deallocated 19852", 20107, 255, 19852, 121, 10, 111
+"{:z 0 :o 1}", "Allocation summary allocated 20066 deallocated 256 not deallocated 19810", 20066, 256, 19810, 80, 11, 69
+"{:zero 0 :one 1}", "Allocation summary allocated 20196 deallocated 259 not deallocated 19937", 20196, 259, 19937, 210, 14, 196
+"{:z 0 :o 1 :t 2}", "Allocation summary allocated 20103 deallocated 257 not deallocated 19846", 20103, 257, 19846, 117, 12, 105
+"{:zero 0 :one 1 :two 2 :three 3 :four 4 :five five :six 6 :seven 7 :eight 8 :nine 9}", "Allocation summary allocated 21164 deallocated 286 not deallocated 20878", 21164, 286, 20878, 1178, 41, 1137

unit-tests/allocation-tests/test-forms

@@ -0,0 +1,28 @@
+
+nil
+()
+(quote ())
+(list)
+(list )
+(list 1)
+(list 1 1)
+(list 1 1 1)
+(list 1 2 3)
+(+)
+(+ 1)
+(+ 1 1)
+(+ 1 1 1)
+(+ 1 2 3)
+(list 'a 'a 'a)
+(list 'a 'b 'c)
+(list :a :b :c)
+(list :aa :bb :cc)
+(list :aaa :bbb :ccc)
+(list :alpha :bravo :charlie)
+{}
+{:z 0}
+{:zero 0}
+{:z 0 :o 1}
+{:zero 0 :one 1}
+{:z 0 :o 1 :t 2}
+{:zero 0 :one 1 :two 2 :three 3 :four 4 :five five :six 6 :seven 7 :eight 8 :nine 9}

unit-tests/append.sh

@@ -1,24 +1,44 @@
 #!/bin/bash
 
+return=0;
+
+echo -n "$0: Append two lists... "
+
 expected='(a b c d e f)'
-actual=`echo "(append '(a b c) '(d e f))" | target/psse | tail -1`
+actual=`echo "(append '(a b c) '(d e f))" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=`echo "${return} + 1" | bc`
 fi
 
+echo -n "$0: Append two strings... "
+
 expected='"hellodere"'
-actual=`echo '(append "hello" "dere")' | target/psse | tail -1`
+actual=`echo '(append "hello" "dere")' | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=`echo "${return} + 1" | bc`
 fi
 
+echo -n "$0: Append keyword to string should error... "
+
+expected='Exception:'
+actual=`echo '(append "hello" :dere)' | target/psse 2>/dev/null | sed -r '/^\s*$/d' | awk '{print $1}'`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    return=`echo "${return} + 1" | bc`
+fi
+
+exit ${return}

unit-tests/apply.sh

@@ -1,13 +1,29 @@
 #!/bin/bash
 
+result=1
+
+echo -n "$0: Apply function to one argument... "
 expected='1'
-actual=`echo "(apply 'add '(1))"| target/psse | tail -1`
+actual=`echo "(apply 'add '(1))"| target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
-    exit 0
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    result=`echo "${result} + 1" | bc`
 fi
+
+echo -n "$0: Apply function to multiple arguments... "
+expected='3'
+actual=`echo "(apply 'add '(1 2))"| target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '${expected}', got '${actual}'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+exit ${result}

unit-tests/bignum-add.sh

@@ -9,7 +9,7 @@ a=1152921504606846975
 b=1
 c=`echo "$a + $b" | bc`
 expected='t'
-output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log`
+output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
 
 actual=`echo $output |\
   tail -1`
@@ -20,17 +20,17 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
-echo -n "checking no bignum was created: "
+echo -n "$0: checking no bignum was created: "
-grep -v 'BIGNUM!' psse.log > /dev/null
+grep -v 'BIGNUM!' tmp/psse.log > /dev/null
 if [ $? -eq "0" ]
 then
     echo "OK"
 else
     echo "Fail"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 #####################################################################
@@ -40,7 +40,7 @@ a='1152921504606846976'
 b=1
 c=`echo "$a + $b" | bc`
 expected='t'
-output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log`
+output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
 
 actual=`echo $output |\
   tail -1 |\
@@ -52,17 +52,17 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 echo -n "$0 => checking a bignum was created: "
-grep 'BIGNUM!' psse.log > /dev/null
+grep 'BIGNUM!' tmp/psse.log > /dev/null
 if [ $? -eq "0" ]
 then
     echo "OK"
 else
     echo "Fail"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 
@@ -73,7 +73,7 @@ a='1152921504606846977'
 b=1
 c=`echo "$a + $b" | bc`
 expected='t'
-output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log`
+output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
 
 actual=`echo $output |\
   tail -1 |\
@@ -85,17 +85,17 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 echo -n "$0 => checking a bignum was created: "
-grep 'BIGNUM!' psse.log > /dev/null
+grep 'BIGNUM!' tmp/psse.log > /dev/null
 if [ $? -eq "0" ]
 then
     echo "OK"
 else
     echo "Fail"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 #####################################################################
@@ -106,7 +106,7 @@ a=1
 b=1152921504606846977
 c=`echo "$a + $b" | bc`
 expected='t'
-output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log`
+output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
 
 actual=`echo $output |\
   tail -1 |\
@@ -118,17 +118,17 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
-echo -n "checking a bignum was created: "
+echo -n "$0 => checking a bignum was created: "
-grep 'BIGNUM!' psse.log > /dev/null
+grep 'BIGNUM!' tmp/psse.log > /dev/null
 if [ $? -eq "0" ]
 then
     echo "OK"
 else
     echo "Fail"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 
@@ -139,7 +139,7 @@ a=1152921504606846977
 c=`echo "$a + $a" | bc`
 echo -n "$0 => adding $a to $a: "
 expected='t'
-output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log`
+output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
 
 actual=`echo $output |\
   tail -1 |\
@@ -150,7 +150,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 #####################################################################
@@ -160,7 +160,7 @@ a=1152921504606846977
 c=`echo "$a * 5" | bc`
 echo -n "$0 => adding $a, $a $a, $a, $a: "
 expected='t'
-output=`echo "(= (+ $a $a $a $a $a) $c)" | target/psse -v 2 2>psse.log`
+output=`echo "(= (+ $a $a $a $a $a) $c)" | target/psse -v 2 2>tmp/psse.log`
 
 actual=`echo $output |\
   tail -1 |\
@@ -171,7 +171,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 
@@ -183,7 +183,7 @@ a=10000000000000000000
 b=10000000000000000000
 c=`echo "$a + $b" | bc`
 expected='t'
-output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log`
+output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
 
 actual=`echo $output |\
   tail -1 |\
@@ -195,17 +195,17 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 echo -n "$0 => checking a bignum was created: "
-grep 'BIGNUM!' psse.log > /dev/null
+grep 'BIGNUM!' tmp/psse.log > /dev/null
 if [ $? -eq "0" ]
 then
     echo "OK"
 else
     echo "Fail"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 
@@ -216,7 +216,7 @@ a=1
 b=1329227995784915872903807060280344576
 c=`echo "$a + $b" | bc`
 expected='t'
-output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log`
+output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
 
 actual=`echo $output |\
   tail -1 |\
@@ -228,17 +228,17 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 echo -n "$0 => checking a bignum was created: "
-grep 'BIGNUM!' psse.log > /dev/null
+grep 'BIGNUM!' tmp/psse.log > /dev/null
 if [ $? -eq "0" ]
 then
     echo "OK"
 else
     echo "Fail"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 
@@ -250,7 +250,7 @@ a=1
 b=3064991081731777716716694054300618367237478244367204352
 c=`echo "$a + $b" | bc`
 expected='t'
-output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>psse.log`
+output=`echo "(= (+ $a $b) $c)" | target/psse -v 2 2>tmp/psse.log`
 
 actual=`echo $output |\
   tail -1 |\
@@ -262,17 +262,17 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 echo -n "$0 => checking a bignum was created: "
-grep 'BIGNUM!' psse.log > /dev/null
+grep 'BIGNUM!' tmp/psse.log > /dev/null
 if [ $? -eq "0" ]
 then
     echo "OK"
 else
     echo "Fail"
-    return=1
+    return=`echo "${return} + 1" | bc`
 fi
 
 exit ${return}

unit-tests/bignum-subtract.sh

@@ -1,6 +1,6 @@
 #!/bin/bash
 
-return=0
+result=0
 
 #####################################################################
 # subtract a smallnum from a smallnum to produce a smallnum
@@ -20,17 +20,17 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    return=1
+    result=`echo "${result} + 1" | bc`
 fi
 
-echo -n "checking no bignum was created: "
+echo -n "$0 => checking no bignum was created: "
 grep -v 'BIGNUM!' psse.log > /dev/null
 if [ $? -eq "0" ]
 then
     echo "OK"
 else
     echo "Fail"
-    return=1
+    result=`echo "${result} + 1" | bc`
 fi
 
 #####################################################################
@@ -51,7 +51,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    return=1
+    result=`echo "${result} + 1" | bc`
 fi
 
 #####################################################################
@@ -71,7 +71,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    return=1
+    result=`echo "${result} + 1" | bc`
 fi
 
 
@@ -93,7 +93,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    return=1
+    result=`echo "${result} + 1" | bc`
 fi
 
 #####################################################################
@@ -113,7 +113,7 @@ then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    return=1
+    result=`echo "${result} + 1" | bc`
 fi
 
-exit ${return}
+exit ${result}

unit-tests/complex-list.sh

@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='(1 2 3 ("Fred") nil 77,354)'
-actual=`echo "'(1 2 3 (\"Fred\") () 77354)" | target/psse | tail -1`
+actual=`echo "'(1 2 3 (\"Fred\") () 77354)" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then

unit-tests/cond.sh

@@ -2,26 +2,30 @@
 
 result=0
 
+echo -n "$0: cond with one clause... "
+
 expected='5'
-actual=`echo "(cond ((equal 2 2) 5))" | target/psse | tail -1`
+actual=`echo "(cond ((equal 2 2) 5))" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
   echo "OK"
 else
   echo "Fail: expected '${expected}', got '${actual}'"
-  result=1
+  result=`echo "${result} + 1" | bc`
 fi
 
+echo -n "$0: cond with two clauses... "
+
 expected='"should"'
-actual=`echo "(cond ((equal 2 3) \"shouldn't\")(t \"should\"))" | target/psse | tail -1`
+actual=`echo "(cond ((equal 2 3) \"shouldn't\")(t \"should\"))" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
  else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
 exit ${result}

unit-tests/empty-list.sh

@@ -7,7 +7,7 @@
 #
 
 expected=nil
-actual=`echo "'()" | target/psse | tail -1`
+actual=`echo "'()" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then

unit-tests/empty-string.sh

@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected="\"\""
-actual=`echo '""' | target/psse | tail -1`
+actual=`echo '""' | target/psse 2>/dev/null | tail -1`
 
 if [ "$expected" = "$actual" ]
 then

unit-tests/eval-integer.sh

@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='5'
-actual=`echo "(eval 5)" | target/psse | tail -1`
+actual=`echo "(eval 5)" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then

unit-tests/eval-quote-sexpr.sh

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

unit-tests/eval-quote-symbol.sh

@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='<Special form: ((:primitive . t) (:name . cond))>'
-actual=`echo "(eval 'cond)" | target/psse | tail -1`
+actual=`echo "(eval 'cond)" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then

unit-tests/eval-real.sh

@@ -3,7 +3,7 @@
 # for this test, trailing zeros can be ignored
 expected='5.05'
 actual=`echo "(eval 5.05)" |\
-  target/psse 2> /dev/null |\
+  target/psse 2>/dev/null |\
   sed 's/0*$//' |\
   tail -1`
 

unit-tests/eval-string.sh

@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='"5"'
-actual=`echo '(eval "5")' | target/psse | tail -1`
+actual=`echo '(eval "5")' | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then

unit-tests/fred.sh

@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='"Fred"'
-actual=`echo ${expected} | target/psse | tail -1`
+actual=`echo ${expected} | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then

unit-tests/integer.sh

@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='354'
-actual=`echo ${expected} | target/psse | tail -1`
+actual=`echo ${expected} | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then

unit-tests/interpreter.sh

@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='6'
-actual=`echo "(apply '(lambda (x y z) (/ (* y z) x)) '(2 3 4))" | target/psse | tail -1`
+actual=`echo "(apply '(lambda (x y z) (/ (* y z) x)) '(2 3 4))" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then

unit-tests/let.sh

@@ -2,26 +2,28 @@
 
 result=0
 
+echo -n "$0: let with two bindings, one form in body..."
 expected='11'
-actual=`echo "(let ((a . 5)(b . 6)) (+ a b))" | target/psse | tail -1`
+actual=`echo "(let ((a . 5)(b . 6)) (+ a b))" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '$expected', got '$actual'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
+echo -n "$0: let with two bindings, two forms in body..."
 expected='1'
-actual=`echo "(let ((a . 5)(b . 6)) (+ a b) (- b a))" | target/psse | tail -1`
+actual=`echo "(let ((a . 5)(b . 6)) (+ a b) (- b a))" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '$expected', got '$actual'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
 exit ${result}

unit-tests/list-test,sh

@@ -1,42 +0,0 @@
-#!/bin/bash
-
-result=0
-
-expected="(0 1 2 3 4 5 6 7 8 9 a b c d e f)"
-
-actual=`echo "(list 0 1 2 3 4 5 6 7 8 9 'a 'b 'c 'd 'e 'f)" | target/psse | tail -1`
-
-if [ "${expected}" = "${actual}" ]
-then
-    echo "OK"
-else
-    echo "Fail: expected '$expected', got '$actual'"
-    result=1
-fi
-
-expected="(0 1 2 3 4)"
-
-actual=`echo "(list 0 1 2 3 4)" | target/psse | tail -1`
-
-if [ "${expected}" = "${actual}" ]
-then
-    echo "OK"
-else
-    echo "Fail: expected '$expected', got '$actual'"
-    result=1
-fi
-
-expected="(0 1 2 3 4 5 6 7)"
-
-actual=`echo "(list 0 1 2 3 4 5 6 7)" | target/psse | tail -1`
-
-if [ "${expected}" = "${actual}" ]
-then
-    echo "OK"
-    exit 0
-else
-    echo "Fail: expected '$expected', got '$actual'"
-    result=1
-fi
-
-exit ${result}

unit-tests/list-test.sh

@@ -0,0 +1,47 @@
+#!/bin/bash
+
+result=0
+
+echo -n "$0: flat list with 16 elements... "
+expected="(0 1 2 3 4 5 6 7 8 9 a b c d e f)"
+
+actual=`echo "(list 0 1 2 3 4 5 6 7 8 9 'a 'b 'c 'd 'e 'f)" |\
+    target/psse 2>/dev/null |\
+    tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '$expected', got '$actual'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: flat list with 5 elements... "
+expected="(0 1 2 3 4)"
+
+actual=`echo "(list 0 1 2 3 4)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+else
+    echo "Fail: expected '$expected', got '$actual'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+echo -n "$0: flat list with 8 elements... "
+expected="(0 1 2 3 4 5 6 7)"
+
+actual=`echo "(list 0 1 2 3 4 5 6 7)" | target/psse 2>/dev/null | tail -1`
+
+if [ "${expected}" = "${actual}" ]
+then
+    echo "OK"
+    exit 0
+else
+    echo "Fail: expected '$expected', got '$actual'"
+    result=`echo "${result} + 1" | bc`
+fi
+
+exit ${result}

unit-tests/many-args.sh

@@ -1,28 +1,30 @@
 #!/bin/bash
 
-result=1
+result=0
+
+echo -n "$0: plus with fifteen arguments... "
 
 expected="120"
-actual=`echo "(+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)" | target/psse | tail -1`
+actual=`echo "(+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
-# check that all the args are actually being evaluated...
+echo -n "$0: check that all the args are actually being evaluated... "
 expected="120"
-actual=`echo "(+ (+ 0 1) (+ 0 2) (+ 0 3) (+ 0 4) (+ 0 5) (+ 0 6) (+ 0 7) (+ 0 8) (+ 0 9) (+ 0 10) (+ 0 11) (+ 0 12) (+ 0 13) (+ 0 14 ) (+ 0 15))" | target/psse | tail -1`
+actual=`echo "(+ (+ 0 1) (+ 0 2) (+ 0 3) (+ 0 4) (+ 0 5) (+ 0 6) (+ 0 7) (+ 0 8) (+ 0 9) (+ 0 10) (+ 0 11) (+ 0 12) (+ 0 13) (+ 0 14 ) (+ 0 15))" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
-return ${result}
+exit ${result}

unit-tests/map.sh

@@ -5,9 +5,9 @@ result=0
 #####################################################################
 # Create an empty map using map notation
 expected='{}'
-actual=`echo "$expected" | target/psse | tail -1`
+actual=`echo "$expected" | target/psse 2>/dev/null | tail -1`
 
-echo -n "Empty map using compact map notation: "
+echo -n "$0: Empty map using compact map notation... "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
@@ -19,7 +19,7 @@ fi
 #####################################################################
 # Create an empty map using make-map
 expected='{}'
-actual=`echo "(hashmap)" | target/psse | tail -1`
+actual=`echo "(hashmap)" | target/psse 2>/dev/null | tail -1`
 
 echo -n "Empty map using (make-map): "
 if [ "${expected}" = "${actual}" ]
@@ -35,9 +35,9 @@ fi
 # significant at this stage, but in the long term should be sorted
 # alphanumerically
 expected='{:one 1, :two 2, :three 3}'
-actual=`echo "{:one 1 :two 2 :three 3}" | target/psse | tail -1`
+actual=`echo "{:one 1 :two 2 :three 3}" | target/psse 2>/dev/null | tail -1`
 
-echo -n "Map using map notation: "
+echo -n "$0: Map using map notation... "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
@@ -51,9 +51,10 @@ fi
 # significant at this stage, but in the long term should be sorted
 # alphanumerically
 expected='{:one 1, :two 2, :three 3}'
-actual=`echo "(hashmap nil nil '((:one . 1)(:two . 2)(:three . 3)))" | target/psse | tail -1`
+actual=`echo "(hashmap nil nil '((:one . 1)(:two . 2)(:three . 3)))" |\
+    target/psse 2>/dev/null | tail -1`
 
-echo -n "Map using (hashmap): "
+echo -n "$0: Map using (hashmap) with arguments... "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
@@ -65,9 +66,9 @@ fi
 #####################################################################
 # Keyword in function position
 expected='2'
-actual=`echo "(:two {:one 1 :two 2 :three 3})" | target/psse | tail -1`
+actual=`echo "(:two {:one 1 :two 2 :three 3})" | target/psse 2>/dev/null | tail -1`
 
-echo -n "Keyword in function position: "
+echo -n "$0: Keyword in function position... "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
@@ -80,9 +81,9 @@ fi
 #####################################################################
 # Map in function position
 expected='2'
-actual=`echo "({:one 1 :two 2 :three 3} :two)" | target/psse | tail -1`
+actual=`echo "({:one 1 :two 2 :three 3} :two)" | target/psse 2>/dev/null | tail -1`
 
-echo -n "Map in function position: "
+echo -n "$0: Map in function position... "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"

unit-tests/multiply.sh

@@ -2,26 +2,30 @@
 
 result=0
 
+echo -n "$0: multiply two integers... "
+
 expected='6'
-actual=`echo "(multiply 2 3)" | target/psse | tail -1`
+actual=`echo "(multiply 2 3)" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
+echo -n "$0: multiply a real by an integer... "
+
 expected='7.5'
-actual=`echo "(multiply 2.5 3)" | target/psse | tail -1`
+actual=`echo "(multiply 2.5 3)" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
 exit ${result}

unit-tests/nil.sh

@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected=nil
-actual=`echo 'nil' | target/psse | tail -1`
+actual=`echo 'nil' | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then

unit-tests/nlambda.sh

@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='a'
-actual=`echo "((nlambda (x) x) a)" | target/psse | tail -1`
+actual=`echo "((nlambda (x) x) a)" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then

unit-tests/path-notation.sh

@@ -4,30 +4,30 @@ result=0
 
 #####################################################################
 # Create a path from root using compact path notation
-expected='(-> oblist :users :simon :functions (quote assoc))'
+echo -n "$0: Create a path from root using compact path notation... "
-actual=`echo "'/:users:simon:functions/assoc" | target/psse | tail -1`
+expected='(-> (oblist) :users :simon :functions (quote assoc))'
+actual=`echo "'/:users:simon:functions/assoc" | target/psse 2>&1 | tail -1`
 
-echo -n "Path from root (oblist) using compact notation: "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
 #####################################################################
 # Create a path from the current session using compact path notation
+echo -n "$0: Create a path from the current session using compact path notation... "
 expected='(-> session :input-stream)'
-actual=`echo "'$:input-stream" | target/psse | tail -1`
+actual=`echo "'$:input-stream" | target/psse 2>/dev/null | tail -1`
 
-echo -n "Path from current session using compact notation: "
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
 exit ${result}

unit-tests/progn.sh

@@ -2,26 +2,28 @@
 
 result=0
 
+echo -n "$0: progn with one form... "
 expected='5'
-actual=`echo "(progn (add 2 3))" | target/psse | tail -1`
+actual=`echo "(progn (add 2 3))" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
+echo -n "$0: progn with two forms... "
 expected='"foo"'
-actual=`echo "(progn (add 2.5 3) \"foo\")" | target/psse | tail -1`
+actual=`echo "(progn (add 2.5 3) \"foo\")" | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
 exit ${result}

unit-tests/quote.sh

@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='Fred'
-actual=`echo "'Fred" | target/psse | tail -1`
+actual=`echo "'Fred" | target/psse 2>&1 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then

unit-tests/quoted-list.sh

@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='(123 (4 (5 nil)) Fred)'
-actual=`echo "'(123 (4 (5 ())) Fred)" | target/psse | tail -1`
+actual=`echo "'(123 (4 (5 ())) Fred)" | target/psse 2>&1 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then

unit-tests/ratio-addition.sh

@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='1/4'
-actual=`echo "(+ 3/14 1/28)" | target/psse | tail -1`
+actual=`echo "(+ 3/14 1/28)" | target/psse 2>&1 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then

unit-tests/reverse.sh

@@ -2,30 +2,33 @@
 
 result=0
 
+echo -n "$0: reverse a string... "
 expected='"god yzal eht revo depmuj xof nworb kciuq ehT"'
-actual=`echo '(reverse "The quick brown fox jumped over the lazy dog")' | target/psse | tail -1`
+actual=`echo '(reverse "The quick brown fox jumped over the lazy dog")' | target/psse 2>&1 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
+echo -n "$0: reverse a list... "
 expected='(1,024 512 256 128 64 32 16 8 4 2)'
-actual=`echo "(reverse '(2 4 8 16 32 64 128 256 512 1024))" | target/psse | tail -1`
+actual=`echo "(reverse '(2 4 8 16 32 64 128 256 512 1024))" | target/psse 2>&1 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
+echo -n "$0: reverse a symbol... "
 expected='esrever'
-actual=`echo "(reverse 'reverse)" | target/psse | tail -1`
+actual=`echo "(reverse 'reverse)" | target/psse 2>&1 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
@@ -33,8 +36,8 @@ then
     exit 0
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
-echo ${result}
+exit ${result}
 

unit-tests/simple-list.sh

@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected="(1 2 3)"
-actual=`echo "'(1 2 3)" | target/psse | tail -1`
+actual=`echo "'(1 2 3)" | target/psse 2>&1 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then

unit-tests/slurp.sh

@@ -1,9 +1,9 @@
 #!/bin/bash
 
-tmp=hi.$$
+tmp=tmp/hi.$$
 echo "Hello, there." > ${tmp}
 expected='"Hello, there.'
-actual=`echo "(slurp (open \"${tmp}\"))" | target/psse | tail -2 | head -1`
+actual=`echo "(slurp (open \"${tmp}\"))" | target/psse 2>&1 | tail -2 | head -1`
 
 if [ "${expected}" = "${actual}" ]
 then

unit-tests/string-cons.sh

@@ -2,28 +2,28 @@
 
 result=0
 
-# We should be able to cons a single character string onto the front of a string
+echo -n "$0: We should be able to cons a single character string onto the front of a string... "
 expected='"Test"'
-actual=`echo '(cons "T" "est")' | target/psse | tail -1`
+actual=`echo '(cons "T" "est")' | target/psse 2>/dev/null | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
-# But if the first argument has more than one character, we should get a dotted pair
+echo -n "$0: But if the first argument has more than one character, we should get a dotted pair... "
 expected='("Test" . "pass")'
-actual=`echo '(cons "Test" "pass")' | target/psse | tail -1`
+actual=`echo '(cons "Test" "pass")' | target/psse 2>&1 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    result=1
+    result=`echo "${result} + 1" | bc`
 fi
 
 exit ${result}

unit-tests/string-with-spaces.sh

@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='"Strings should be able to include spaces (and other stuff)!"'
-actual=`echo ${expected} | target/psse | tail -1`
+actual=`echo ${expected} | target/psse 2>&1 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then

unit-tests/try.sh

@@ -1,45 +1,54 @@
 #!/bin/bash
 
+result=0
+
+echo -n "$0: if the body of a try errors, the last form in the catch block is returned... "
 expected=':foo'
-actual=`echo "(try ((+ 2 (/ 1 'a))) (:foo))" | target/psse | tail -1`
+actual=`echo "(try ((+ 2 (/ 1 'a))) (:foo))" | target/psse 2>&1 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=`echo "${return} + 1" | bc`
 fi
 
+echo -n "$0: if the body of a try errors, the last form in the catch block is evaluated... "
+
 expected='4'
-actual=`echo "(try ((+ 2 (/ 1 'a))) ((+ 2 2)))" | target/psse | tail -1`
+actual=`echo "(try ((+ 2 (/ 1 'a))) ((+ 2 2)))" | target/psse 2>&1 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=`echo "${return} + 1" | bc`
 fi
 
+echo -n "$0: body and catch block can optionally be marked with keywords... "
 expected='8'
-actual=`echo "(try (:body (+ 2 (/ 1 'a))) (:catch (* 2 2 2)))" | target/psse | tail -1`
+actual=`echo "(try (:body (+ 2 (/ 1 'a))) (:catch (* 2 2 2)))" | target/psse 2>&1 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=`echo "${return} + 1" | bc`
 fi
 
-expected=''
+echo -n "$0: the exception is bound to the symbol \`*exception*\` in the catch environment... "
-actual=`echo "(try (:body (+ 2 (/ 1 'a))) (:catch *exception*))" | target/psse | tail -1`
+expected='Exception: "Cannot divide: not a number"'
+actual=`echo "(try (:body (+ 2 (/ 1 'a))) (:catch *exception*))" | target/psse 2>&1 | grep Exception`
 
 if [ "${expected}" = "${actual}" ]
 then
     echo "OK"
 else
     echo "Fail: expected '${expected}', got '${actual}'"
-    exit 1
+    return=`echo "${return} + 1" | bc`
 fi
+
+exit ${result}

unit-tests/varargs.sh

@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='(1 2 3 4 5 6 7 8 9 10)'
-actual=`echo "(set! list (lambda l l))(list 1 2 3 4 5 6 7 8 9 10)" |target/psse | tail -1`
+actual=`echo "(set! list (lambda l l))(list 1 2 3 4 5 6 7 8 9 10)" | target/psse 2>&1 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then

unit-tests/wide-character.sh

@@ -1,7 +1,7 @@
 #!/bin/bash
 
 expected='"λάμ(β)δα"'
-actual=`echo $expected | target/psse | tail -1`
+actual=`echo $expected | target/psse 2>&1 | tail -1`
 
 if [ "${expected}" = "${actual}" ]
 then