From 69a09c646d603fa45e50727e2bc67b36be76b450 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sat, 25 May 2019 12:59:49 +0100
Subject: [PATCH 001/148] bcpl: Basic infrastructure for a new port.

---
 Makefile            | 3 ++-
 impls/bcpl/Makefile | 4 ++++
 impls/bcpl/run      | 2 ++
 3 files changed, 8 insertions(+), 1 deletion(-)
 create mode 100644 impls/bcpl/Makefile
 create mode 100755 impls/bcpl/run

diff --git a/Makefile b/Makefile
index c42c5ca62f..18a546bf04 100644
--- a/Makefile
+++ b/Makefile
@@ -89,7 +89,7 @@ DOCKERIZE =
 # Implementation specific settings
 #
 
-IMPLS = ada ada.2 awk bash basic bbc-basic c chuck clojure coffee common-lisp cpp crystal cs d dart \
+IMPLS = ada ada.2 awk bash basic bbc-basic bcpl c chuck clojure coffee common-lisp cpp crystal cs d dart \
 	elisp elixir elm erlang es6 factor fantom forth fsharp go groovy gnu-smalltalk \
 	guile haskell haxe hy io java js jq julia kotlin livescript logo lua make mal \
 	matlab miniMAL nasm nim objc objpascal ocaml perl perl6 php picolisp pike plpgsql \
@@ -191,6 +191,7 @@ awk_STEP_TO_PROG =           impls/awk/$($(1)).awk
 bash_STEP_TO_PROG =          impls/bash/$($(1)).sh
 basic_STEP_TO_PROG =         $(basic_STEP_TO_PROG_$(basic_MODE))
 bbc-basic_STEP_TO_PROG =     impls/bbc-basic/$($(1)).bas
+bcpl_STEP_TO_PROG =          impls/bcpl/$($(1))
 c_STEP_TO_PROG =             impls/c/$($(1))
 chuck_STEP_TO_PROG =         impls/chuck/$($(1)).ck
 clojure_STEP_TO_PROG =       $(clojure_STEP_TO_PROG_$(clojure_MODE))
diff --git a/impls/bcpl/Makefile b/impls/bcpl/Makefile
new file mode 100644
index 0000000000..26d59481ad
--- /dev/null
+++ b/impls/bcpl/Makefile
@@ -0,0 +1,4 @@
+all: step0_repl
+
+%: %.b
+	cintsys -c "bcpl $< to $@"
diff --git a/impls/bcpl/run b/impls/bcpl/run
new file mode 100755
index 0000000000..08a4f4911f
--- /dev/null
+++ b/impls/bcpl/run
@@ -0,0 +1,2 @@
+#!/bin/bash
+exec cintsys -- "$(dirname $0)/${STEP:-stepA_mal}" "${@}"

From ff2ae72ecc3391fc8b872ab01380a39bfd3ea6e5 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sun, 26 May 2019 00:47:09 +0100
Subject: [PATCH 002/148] runtest: Even grottier change to not be fooled by
 Cintsys prompt.

Cintsys annoyingly prints its own prompt even when you've given it a
command to execute, and that prompt ends with '>', causing runtest to
think it's the mal prompt.  This gets runtest one prompt out of sync
with reality, with the expected poor consequences.
---
 runtest.py | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/runtest.py b/runtest.py
index 2d32e85aae..0787b56bf7 100755
--- a/runtest.py
+++ b/runtest.py
@@ -245,7 +245,7 @@ def assert_prompt(runner, prompts, timeout):
 
 # Wait for the initial prompt
 try:
-    assert_prompt(r, ['[^\s()<>]+> '], args.start_timeout)
+    assert_prompt(r, ['[^\s()<>\d]+> '], args.start_timeout)
 except:
     _, exc, _ = sys.exc_info()
     log("\nException: %s" % repr(exc))
@@ -256,7 +256,7 @@ def assert_prompt(runner, prompts, timeout):
 if args.pre_eval:
     sys.stdout.write("RUNNING pre-eval: %s" % args.pre_eval)
     r.writeline(args.pre_eval)
-    assert_prompt(r, ['[^\s()<>]+> '], args.test_timeout)
+    assert_prompt(r, ['[^\s()<>\d]+> '], args.test_timeout)
 
 test_cnt = 0
 pass_cnt = 0
@@ -293,7 +293,7 @@ class TestTimeout(Exception):
     r.writeline(t.form)
     try:
         test_cnt += 1
-        res = r.read_to_prompt(['\r\n[^\s()<>]+> ', '\n[^\s()<>]+> '],
+        res = r.read_to_prompt(['\r\n[^\s()<>\d]+> ', '\n[^\s()<>\d]+> '],
                                 timeout=args.test_timeout)
         #print "%s,%s,%s" % (idx, repr(p.before), repr(p.after))
         if (res == None):

From b49408c48b8387da00be676a4d733c7e388484fe Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sun, 26 May 2019 00:48:31 +0100
Subject: [PATCH 003/148] bcpl: Rough implementation of step 0.

---
 impls/bcpl/Makefile     |  7 ++++++-
 impls/bcpl/README.md    | 16 ++++++++++++++++
 impls/bcpl/malhdr.h     |  1 +
 impls/bcpl/readline.b   | 14 ++++++++++++++
 impls/bcpl/step0_repl.b | 27 +++++++++++++++++++++++++++
 5 files changed, 64 insertions(+), 1 deletion(-)
 create mode 100644 impls/bcpl/README.md
 create mode 100644 impls/bcpl/malhdr.h
 create mode 100644 impls/bcpl/readline.b
 create mode 100644 impls/bcpl/step0_repl.b

diff --git a/impls/bcpl/Makefile b/impls/bcpl/Makefile
index 26d59481ad..21ce5a1380 100644
--- a/impls/bcpl/Makefile
+++ b/impls/bcpl/Makefile
@@ -1,4 +1,9 @@
 all: step0_repl
 
-%: %.b
+%: %.b malhdr.h
 	cintsys -c "bcpl $< to $@"
+
+step0_repl: readline.b
+
+clean:
+	rm step0_repl
diff --git a/impls/bcpl/README.md b/impls/bcpl/README.md
new file mode 100644
index 0000000000..6d03c7364d
--- /dev/null
+++ b/impls/bcpl/README.md
@@ -0,0 +1,16 @@
+* Mal in BCPL
+
+This implementation expects to be built using the Cintcode BCPL compiler.
+
+It uses several features that are not mentioned, or are
+described as extensions by _BCPL - the language and its compiler_,
+including:
+ * The infixed byte operator `%`
+ * Using `{` and `}` as section brackets
+ * Using lower case and `_` in variable names
+
+BCPL does support separate compilation, but running
+separately-compiled modules in Cintsys seems to be ill-supported,
+requiring use of the run-time dynamic loading mechanism, `loadseg`.
+The examples in the manual all use `GET` to textually include library
+source code in the main program, so mal does the same.
diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
new file mode 100644
index 0000000000..334c061df4
--- /dev/null
+++ b/impls/bcpl/malhdr.h
@@ -0,0 +1 @@
+GLOBAL { readline: ug }
diff --git a/impls/bcpl/readline.b b/impls/bcpl/readline.b
new file mode 100644
index 0000000000..847c1cd486
--- /dev/null
+++ b/impls/bcpl/readline.b
@@ -0,0 +1,14 @@
+GET "libhdr"
+GET "malhdr"
+
+LET readline(prompt, buf) BE
+{ LET p = 1
+  LET ch = 0
+  writes(prompt)
+  deplete(cos)
+  { ch := rdch()
+    buf%p := ch
+    p := p + 1
+  } REPEATUNTIL ch = '*n'
+  buf%0 := p - 1
+}
diff --git a/impls/bcpl/step0_repl.b b/impls/bcpl/step0_repl.b
new file mode 100644
index 0000000000..25ee6c7b61
--- /dev/null
+++ b/impls/bcpl/step0_repl.b
@@ -0,0 +1,27 @@
+GET "libhdr"
+GET "malhdr"
+
+GET "readline.b"
+
+LET READ(x) = x
+
+LET EVAL(x) = x
+
+LET PRINT(x) = x
+
+LET rep(x) = PRINT(EVAL(READ(x)))
+
+LET repl() BE
+{ LET line = VEC 256 / bytesperword
+  { readline("user> ", line)
+    writes(rep(line))
+  } REPEAT
+}
+
+LET start() = VALOF
+{ LET ch = 0
+  ch := rdch() REPEATUNTIL ch = '*n' // Consume command-line args
+  wrch('*n') // Terminate prompt printed by Cintsys
+  repl()
+  RESULTIS 0
+}

From 0333096565e0d324cf51a26f44d70441998546ba Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 28 May 2019 23:00:50 +0100
Subject: [PATCH 004/148] bcpl: Add a mal string type and use it in step 0.

From experience, I know that 255-byte strings aren't long enough.  Mal
strings therefor use a whole word to represent their lengths, and I'm
using them from the start.
---
 impls/bcpl/Makefile     |  2 +-
 impls/bcpl/malhdr.h     | 16 +++++++++++++++-
 impls/bcpl/readline.b   | 16 ++++++++++++----
 impls/bcpl/step0_repl.b |  7 ++++---
 impls/bcpl/types.b      | 19 +++++++++++++++++++
 5 files changed, 51 insertions(+), 9 deletions(-)
 create mode 100644 impls/bcpl/types.b

diff --git a/impls/bcpl/Makefile b/impls/bcpl/Makefile
index 21ce5a1380..fd03dfb05b 100644
--- a/impls/bcpl/Makefile
+++ b/impls/bcpl/Makefile
@@ -3,7 +3,7 @@ all: step0_repl
 %: %.b malhdr.h
 	cintsys -c "bcpl $< to $@"
 
-step0_repl: readline.b
+step0_repl: readline.b types.b
 
 clean:
 	rm step0_repl
diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index 334c061df4..62d98bd870 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -1 +1,15 @@
-GLOBAL { readline: ug }
+GLOBAL { readline: ug; alloc_str; str_bcpl2mal }
+
+MANIFEST
+{
+  // The first word of any mal value indicates its type and suchlike.
+  // The "supertype" indicates the meaning of the other words of the
+  // value.  The "type" distinguishes mal types with the same supertype
+  // (for instance functions and macros).
+  type = SLCT 8; supertype = SLCT 4
+
+  // Strings.  Unlike conventional BCPL strings, these have an entire word
+  // to store the length.  For compatibility with library routines, the
+  // first byte of the string is also the length if it will fit.
+  t_str = #x00; str_len = 1; str_data = 2
+}
diff --git a/impls/bcpl/readline.b b/impls/bcpl/readline.b
index 847c1cd486..59f9ee1968 100644
--- a/impls/bcpl/readline.b
+++ b/impls/bcpl/readline.b
@@ -1,14 +1,22 @@
 GET "libhdr"
 GET "malhdr"
 
-LET readline(prompt, buf) BE
-{ LET p = 1
+MANIFEST
+{ buflen = (1 << bitsperbyte) - 1 }
+
+// readline returns a newly-allocated mal string.
+// 'prompt' is a mal string,
+LET readline(prompt) = VALOF
+{ LET buf = VEC 1 + buflen / bytesperword
+  LET p = 1
   LET ch = 0
-  writes(prompt)
+  writes(@prompt!str_data)
   deplete(cos)
-  { ch := rdch()
+  { IF p > buflen THEN { writes("Input line too long"); FINISH }
+    ch := rdch()
     buf%p := ch
     p := p + 1
   } REPEATUNTIL ch = '*n'
   buf%0 := p - 1
+  RESULTIS str_bcpl2mal(buf)
 }
diff --git a/impls/bcpl/step0_repl.b b/impls/bcpl/step0_repl.b
index 25ee6c7b61..731c856631 100644
--- a/impls/bcpl/step0_repl.b
+++ b/impls/bcpl/step0_repl.b
@@ -2,6 +2,7 @@ GET "libhdr"
 GET "malhdr"
 
 GET "readline.b"
+GET "types.b"
 
 LET READ(x) = x
 
@@ -12,9 +13,9 @@ LET PRINT(x) = x
 LET rep(x) = PRINT(EVAL(READ(x)))
 
 LET repl() BE
-{ LET line = VEC 256 / bytesperword
-  { readline("user> ", line)
-    writes(rep(line))
+{ LET prompt = str_bcpl2mal("user> ")
+  { LET line = readline(prompt)
+    writes(@rep(line)!str_data)
   } REPEAT
 }
 
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
new file mode 100644
index 0000000000..01fdc68872
--- /dev/null
+++ b/impls/bcpl/types.b
@@ -0,0 +1,19 @@
+GET "libhdr"
+GET "malhdr"
+
+LET alloc_str(len) = VALOF
+{ LET result = getvec(str_data + 1 + len / bytesperword)
+  !result := 0
+  type OF result := t_str
+  result!str_len := 0
+  (result+str_data)%0 := 0
+  RESULTIS result
+}
+
+LET str_bcpl2mal(bcplstr) = VALOF
+{ LET result = alloc_str(bcplstr%0)
+  result!str_len := bcplstr%0
+  FOR i = 0 TO bcplstr%0 / bytesperword DO
+    result!(str_data + i) := bcplstr!i
+  RESULTIS result
+}

From 27c7e732b361a2d39790dfb87129a7eada4ca200 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Wed, 29 May 2019 21:37:52 +0100
Subject: [PATCH 005/148] bcpl: Add a nil type and value, and use them in step
 0.

The readline function now returns nil if it hits EOF, though it appears
that Cintsys stops ^D from generating it.
---
 impls/bcpl/malhdr.h     | 9 +++++++--
 impls/bcpl/readline.b   | 1 +
 impls/bcpl/step0_repl.b | 2 ++
 impls/bcpl/types.b      | 3 +++
 4 files changed, 13 insertions(+), 2 deletions(-)

diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index 62d98bd870..73e7d71b3b 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -1,4 +1,5 @@
-GLOBAL { readline: ug; alloc_str; str_bcpl2mal }
+GLOBAL { readline: ug
+         init_types; nil; alloc_str; str_bcpl2mal }
 
 MANIFEST
 {
@@ -8,8 +9,12 @@ MANIFEST
   // (for instance functions and macros).
   type = SLCT 8; supertype = SLCT 4
 
+  // Nil. There is a single nil value initialised by init_types(), but
+  // it's a valid pointer so it can safely be dereferenced.
+  t_nil = #x00
+
   // Strings.  Unlike conventional BCPL strings, these have an entire word
   // to store the length.  For compatibility with library routines, the
   // first byte of the string is also the length if it will fit.
-  t_str = #x00; str_len = 1; str_data = 2
+  t_str = #x01; str_len = 1; str_data = 2
 }
diff --git a/impls/bcpl/readline.b b/impls/bcpl/readline.b
index 59f9ee1968..3875f6db87 100644
--- a/impls/bcpl/readline.b
+++ b/impls/bcpl/readline.b
@@ -14,6 +14,7 @@ LET readline(prompt) = VALOF
   deplete(cos)
   { IF p > buflen THEN { writes("Input line too long"); FINISH }
     ch := rdch()
+    IF ch = endstreamch THEN RESULTIS nil
     buf%p := ch
     p := p + 1
   } REPEATUNTIL ch = '*n'
diff --git a/impls/bcpl/step0_repl.b b/impls/bcpl/step0_repl.b
index 731c856631..06ec58fbdc 100644
--- a/impls/bcpl/step0_repl.b
+++ b/impls/bcpl/step0_repl.b
@@ -15,12 +15,14 @@ LET rep(x) = PRINT(EVAL(READ(x)))
 LET repl() BE
 { LET prompt = str_bcpl2mal("user> ")
   { LET line = readline(prompt)
+    IF line = nil THEN BREAK
     writes(@rep(line)!str_data)
   } REPEAT
 }
 
 LET start() = VALOF
 { LET ch = 0
+  init_types()
   ch := rdch() REPEATUNTIL ch = '*n' // Consume command-line args
   wrch('*n') // Terminate prompt printed by Cintsys
   repl()
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index 01fdc68872..aebf1b28d1 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -1,6 +1,9 @@
 GET "libhdr"
 GET "malhdr"
 
+LET init_types() BE
+  nil := TABLE 0
+
 LET alloc_str(len) = VALOF
 { LET result = getvec(str_data + 1 + len / bytesperword)
   !result := 0

From b868b1da33483ecac909767bd7fd740ca34d0169 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Wed, 29 May 2019 22:12:19 +0100
Subject: [PATCH 006/148] bcpl: Minimal definition of lists.

---
 impls/bcpl/malhdr.h | 8 ++++++--
 impls/bcpl/types.b  | 5 ++++-
 2 files changed, 10 insertions(+), 3 deletions(-)

diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index 73e7d71b3b..64eccfbca8 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -1,5 +1,5 @@
 GLOBAL { readline: ug
-         init_types; nil; alloc_str; str_bcpl2mal }
+         init_types; nil; empty; alloc_str; str_bcpl2mal }
 
 MANIFEST
 {
@@ -13,8 +13,12 @@ MANIFEST
   // it's a valid pointer so it can safely be dereferenced.
   t_nil = #x00
 
+  // Lists.  These are implemented as a linked list.  The empty list,
+  // like nil, is a special value.
+  t_lst = #x01; lst_first = 1; lst_rest = 2
+
   // Strings.  Unlike conventional BCPL strings, these have an entire word
   // to store the length.  For compatibility with library routines, the
   // first byte of the string is also the length if it will fit.
-  t_str = #x01; str_len = 1; str_data = 2
+  t_str = #x02; str_len = 1; str_data = 2
 }
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index aebf1b28d1..5db90341a5 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -2,7 +2,10 @@ GET "libhdr"
 GET "malhdr"
 
 LET init_types() BE
-  nil := TABLE 0
+{ nil := TABLE t_nil
+  empty := TABLE t_lst, ?, ?
+  empty!lst_first, empty!lst_rest := nil, empty
+}
 
 LET alloc_str(len) = VALOF
 { LET result = getvec(str_data + 1 + len / bytesperword)

From 9e9fb41231b5d40909a5fda815f52f2761d6a12a Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Wed, 29 May 2019 22:31:46 +0100
Subject: [PATCH 007/148] bcpl: Add .DELETE_ON_ERROR to Makefile.

The BCPL compiler tends to generate partial output on error: this makes
sure such partial output is deleted.
---
 impls/bcpl/Makefile | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/impls/bcpl/Makefile b/impls/bcpl/Makefile
index fd03dfb05b..93ca50c403 100644
--- a/impls/bcpl/Makefile
+++ b/impls/bcpl/Makefile
@@ -3,6 +3,8 @@ all: step0_repl
 %: %.b malhdr.h
 	cintsys -c "bcpl $< to $@"
 
+.DELETE_ON_ERROR:
+
 step0_repl: readline.b types.b
 
 clean:

From d8f66236c8e280561898cd2f9762ddcae37a94ba Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sun, 2 Jun 2019 14:36:13 +0100
Subject: [PATCH 008/148] bcpl: Beginnings of step 1: printer and tokenizer
 mostly done.

Currently, the repl tokenizes the input and then just prints the list of
tokens, which is good enough for testing the tokenizer.
---
 impls/bcpl/Makefile           |  5 ++-
 impls/bcpl/malhdr.h           |  8 +++-
 impls/bcpl/reader.b           | 76 +++++++++++++++++++++++++++++++++++
 impls/bcpl/step1_read_print.b | 33 +++++++++++++++
 impls/bcpl/types.b            | 14 +++++++
 5 files changed, 132 insertions(+), 4 deletions(-)
 create mode 100644 impls/bcpl/reader.b
 create mode 100644 impls/bcpl/step1_read_print.b

diff --git a/impls/bcpl/Makefile b/impls/bcpl/Makefile
index 93ca50c403..962b5f895d 100644
--- a/impls/bcpl/Makefile
+++ b/impls/bcpl/Makefile
@@ -1,4 +1,4 @@
-all: step0_repl
+all: step0_repl step1_read_print
 
 %: %.b malhdr.h
 	cintsys -c "bcpl $< to $@"
@@ -6,6 +6,7 @@ all: step0_repl
 .DELETE_ON_ERROR:
 
 step0_repl: readline.b types.b
+step1_read_print: reader.b readline.b types.b
 
 clean:
-	rm step0_repl
+	rm step0_repl step1_read_print
diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index 64eccfbca8..93d56cabc9 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -1,5 +1,8 @@
 GLOBAL { readline: ug
-         init_types; nil; empty; alloc_str; str_bcpl2mal }
+         pr_str
+         read_str
+         init_types; nil; empty; cons; str_setlen; alloc_str; str_bcpl2mal
+}
 
 MANIFEST
 {
@@ -15,10 +18,11 @@ MANIFEST
 
   // Lists.  These are implemented as a linked list.  The empty list,
   // like nil, is a special value.
-  t_lst = #x01; lst_first = 1; lst_rest = 2
+  t_lst = #x01; lst_first = 1; lst_rest = 2; lst_sz = 3
 
   // Strings.  Unlike conventional BCPL strings, these have an entire word
   // to store the length.  For compatibility with library routines, the
   // first byte of the string is also the length if it will fit.
   t_str = #x02; str_len = 1; str_data = 2
+  maxbcplstrlen = (1 << (BITSPERBCPLWORD / bytesperword)) - 1
 }
diff --git a/impls/bcpl/reader.b b/impls/bcpl/reader.b
new file mode 100644
index 0000000000..326280ced7
--- /dev/null
+++ b/impls/bcpl/reader.b
@@ -0,0 +1,76 @@
+GET "libhdr"
+GET "malhdr"
+
+LET reader_peek(toklistp) = (!toklistp)!lst_first
+
+LET reader_next(toklistp) = VALOF
+{ LET tok = reader_peek(toklistp)
+  !toklistp := (!toklistp)!lst_rest
+  RESULTIS tok
+}
+
+LET newsubstr(s, start, end) = VALOF
+{ LET len = end - start
+  LET ss = alloc_str(len)
+  FOR i = 1 TO len DO
+    (ss + str_data) % i := (s + str_data) % (start + i - 1)
+  str_setlen(ss, len)
+  RESULTIS ss
+}
+
+LET tokenize(s) = VALOF
+{ LET tokens, tail = empty, empty
+  LET sd = s + str_data
+  LET tokstart, token = ?, ?
+  FOR p = 1 TO s!str_len DO
+  { SWITCHON sd%p INTO
+    { CASE ' ': CASE '*t': CASE '*n': CASE ',': LOOP // Inter-token whitespace
+      CASE '~': // Maybe ~@
+        IF p < s!str_len & sd%(p+1) = '@' THEN
+	{ tokstart := p
+	  p := p + 1
+	  ENDCASE
+	}
+      CASE '[': CASE ']': CASE '{': CASE '}': CASE '(': CASE ')': CASE '*'':
+      CASE '`': CASE '^': CASE '@': // Single-character token
+        tokstart := p
+        ENDCASE
+      CASE ';': // Comment
+        p := p + 1 REPEATUNTIL p > s!str_len | sd%p = '*n'
+        LOOP
+      CASE '*"': // String
+        tokstart := p
+        p := p + 1
+        UNTIL  p > s!str_len | sd%p = '*"' DO
+          p := p + (sd%p = '\' -> 2, 1)
+        ENDCASE     
+      DEFAULT: // Symbol or number
+        tokstart := p
+        UNTIL p > s!str_len DO
+        { SWITCHON sd%p INTO
+          { CASE ' ': CASE '*t': CASE '*n': CASE ',':
+            CASE '[': CASE ']': CASE '{': CASE '}': CASE '(': CASE ')':
+            CASE '*'': CASE '`': CASE '~': CASE '^': CASE '@': CASE '*"':
+            CASE ';':
+              p := p - 1; BREAK
+          }
+          p := p + 1
+        }
+        ENDCASE
+    }
+    // At this point, tokstart points to the first character of the token,
+    // and p points to the last character.
+    token := newsubstr(s, tokstart, p + 1)
+    TEST tokens = empty THEN
+    { tokens := cons(token, empty)
+      tail := tokens
+    } ELSE
+    { tail!lst_rest := cons(token, empty)
+      tail := tail!lst_rest
+    }
+  }
+  RESULTIS tokens
+}
+
+// LET read_str(s) = read_form(tokenize(s))
+LET read_str(s) = tokenize(s)
diff --git a/impls/bcpl/step1_read_print.b b/impls/bcpl/step1_read_print.b
new file mode 100644
index 0000000000..7b5d0431bf
--- /dev/null
+++ b/impls/bcpl/step1_read_print.b
@@ -0,0 +1,33 @@
+GET "libhdr"
+GET "malhdr"
+
+GET "printer.b"
+GET "reader.b"
+GET "readline.b"
+GET "types.b"
+
+LET READ(x) = read_str(x)
+
+LET EVAL(x) = x
+
+LET PRINT(x) = pr_str(x)
+
+LET rep(x) = PRINT(EVAL(READ(x)))
+
+LET repl() BE
+{ LET prompt = str_bcpl2mal("user> ")
+  { LET line = readline(prompt)
+    IF line = nil THEN BREAK
+    writes(@rep(line)!str_data)
+    newline()
+  } REPEAT
+}
+
+LET start() = VALOF
+{ LET ch = 0
+  init_types()
+  ch := rdch() REPEATUNTIL ch = '*n' // Consume command-line args
+  wrch('*n') // Terminate prompt printed by Cintsys
+  repl()
+  RESULTIS 0
+}
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index 5db90341a5..38d17810b6 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -7,6 +7,20 @@ LET init_types() BE
   empty!lst_first, empty!lst_rest := nil, empty
 }
 
+LET cons(first, rest) = VALOF {
+  LET result = getvec(lst_sz)
+  !result := 0
+  type OF result := t_lst
+  result!lst_first := first
+  result!lst_rest := rest
+  RESULTIS result
+}
+
+LET str_setlen(str, len) BE
+{ str!str_len := len
+  (str + str_data) % 0 := len <= maxbcplstrlen -> len, maxbcplstrlen
+}
+
 LET alloc_str(len) = VALOF
 { LET result = getvec(str_data + 1 + len / bytesperword)
   !result := 0

From e16e262743440cd78e795a3aacbab2caa924a99a Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sun, 2 Jun 2019 22:48:50 +0100
Subject: [PATCH 009/148] bcpl: Fix SLCT expressions.

The BCPL book says that SLCT x is equivalent to SLCT x:0:0, but the
current compiler and its documentation make it equivalent to SLCT 0:0:x.
The code assumed that the book was correct, but now makes no such
assumption.
---
 impls/bcpl/malhdr.h | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index 93d56cabc9..f441a0e5a3 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -10,7 +10,7 @@ MANIFEST
   // The "supertype" indicates the meaning of the other words of the
   // value.  The "type" distinguishes mal types with the same supertype
   // (for instance functions and macros).
-  type = SLCT 8; supertype = SLCT 4
+  type = SLCT 8:0:0; supertype = SLCT 4:0:0
 
   // Nil. There is a single nil value initialised by init_types(), but
   // it's a valid pointer so it can safely be dereferenced.

From 697d9ccd44dfeedf425d1c31810ad12dc5aba278 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sun, 2 Jun 2019 23:41:29 +0100
Subject: [PATCH 010/148] bcpl: Minimum viable reader.

While it passes the tests, this is actually slightly less than minimal
in that it reads numbers as symbols.  Still, it seems to be otherwise
functional.
---
 impls/bcpl/Makefile |  2 +-
 impls/bcpl/malhdr.h |  7 ++++++-
 impls/bcpl/reader.b | 43 ++++++++++++++++++++++++++++++++++++-------
 impls/bcpl/types.b  | 10 ++++++++++
 4 files changed, 53 insertions(+), 9 deletions(-)

diff --git a/impls/bcpl/Makefile b/impls/bcpl/Makefile
index 962b5f895d..c14ee33b39 100644
--- a/impls/bcpl/Makefile
+++ b/impls/bcpl/Makefile
@@ -6,7 +6,7 @@ all: step0_repl step1_read_print
 .DELETE_ON_ERROR:
 
 step0_repl: readline.b types.b
-step1_read_print: reader.b readline.b types.b
+step1_read_print: printer.b reader.b readline.b types.b
 
 clean:
 	rm step0_repl step1_read_print
diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index f441a0e5a3..40443969ff 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -1,7 +1,8 @@
 GLOBAL { readline: ug
          pr_str
          read_str
-         init_types; nil; empty; cons; str_setlen; alloc_str; str_bcpl2mal
+         init_types; nil; empty; cons
+	 str_setlen; alloc_str; str_bcpl2mal; as_sym
 }
 
 MANIFEST
@@ -24,5 +25,9 @@ MANIFEST
   // to store the length.  For compatibility with library routines, the
   // first byte of the string is also the length if it will fit.
   t_str = #x02; str_len = 1; str_data = 2
+
+  // Symbols.  Symbols are like strings, but with a different type.
+  t_sym = #x12
+
   maxbcplstrlen = (1 << (BITSPERBCPLWORD / bytesperword)) - 1
 }
diff --git a/impls/bcpl/reader.b b/impls/bcpl/reader.b
index 326280ced7..246f972548 100644
--- a/impls/bcpl/reader.b
+++ b/impls/bcpl/reader.b
@@ -1,11 +1,14 @@
 GET "libhdr"
 GET "malhdr"
 
-LET reader_peek(toklistp) = (!toklistp)!lst_first
+// A Reader is just a pointer to a (variable) pointer to the head of
+// a list of strings.
 
-LET reader_next(toklistp) = VALOF
-{ LET tok = reader_peek(toklistp)
-  !toklistp := (!toklistp)!lst_rest
+LET reader_peek(rdr) = (!rdr)!lst_first
+
+LET reader_next(rdr) = VALOF
+{ LET tok = reader_peek(rdr)
+  !rdr := (!rdr)!lst_rest
   RESULTIS tok
 }
 
@@ -41,7 +44,7 @@ LET tokenize(s) = VALOF
       CASE '*"': // String
         tokstart := p
         p := p + 1
-        UNTIL  p > s!str_len | sd%p = '*"' DO
+        UNTIL p > s!str_len | sd%p = '*"' DO
           p := p + (sd%p = '\' -> 2, 1)
         ENDCASE     
       DEFAULT: // Symbol or number
@@ -72,5 +75,31 @@ LET tokenize(s) = VALOF
   RESULTIS tokens
 }
 
-// LET read_str(s) = read_form(tokenize(s))
-LET read_str(s) = tokenize(s)
+LET read_atom(rdr) = as_sym(reader_next(rdr))
+
+LET read_list(rdr) = VALOF
+{ reader_next(rdr) // Skip leading '('
+  RESULTIS read_list_tail(rdr)
+}
+
+AND read_list_tail(rdr) = VALOF
+  TEST (reader_peek(rdr) + str_data)%1 = ')' THEN
+  { reader_next(rdr)
+    RESULTIS empty
+  } ELSE {
+    LET first = read_form(rdr)
+    LET rest = read_list_tail(rdr)
+    RESULTIS cons(first, rest)
+  }
+
+AND read_form(rdr) = VALOF
+  SWITCHON (reader_peek(rdr) + str_data)%1 INTO
+  { CASE '(': RESULTIS read_list(rdr)
+    DEFAULT: RESULTIS read_atom(rdr)
+  }
+
+LET read_str(s) = VALOF
+{ LET tokens = tokenize(s)
+  LET rdr = @tokens
+  RESULTIS read_form(rdr)
+}
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index 38d17810b6..eb0939c3e2 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -30,6 +30,16 @@ LET alloc_str(len) = VALOF
   RESULTIS result
 }
 
+LET as_sym(val) = VALOF
+{ LET sym = ?
+  IF type OF val = t_sym THEN RESULTIS val
+  sym := alloc_str(val!str_len)
+  type OF sym := t_sym
+  FOR i = 1 TO str_data + val!str_len / bytesperword DO
+    sym!i := val!i
+  RESULTIS sym
+}
+
 LET str_bcpl2mal(bcplstr) = VALOF
 { LET result = alloc_str(bcplstr%0)
   result!str_len := bcplstr%0

From 6be477c957f4e9db346113ce63c8f290ac52b866 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Mon, 3 Jun 2019 23:11:08 +0100
Subject: [PATCH 011/148] bcpl: Support for reading of strings and integers.

No printing of integers yet, though.
---
 impls/bcpl/README.md |  9 +++++--
 impls/bcpl/malhdr.h  |  8 ++++--
 impls/bcpl/reader.b  | 61 +++++++++++++++++++++++++++++++++++++++++++-
 impls/bcpl/types.b   | 12 +++++++--
 4 files changed, 83 insertions(+), 7 deletions(-)

diff --git a/impls/bcpl/README.md b/impls/bcpl/README.md
index 6d03c7364d..5db3b16214 100644
--- a/impls/bcpl/README.md
+++ b/impls/bcpl/README.md
@@ -1,6 +1,8 @@
 * Mal in BCPL
 
-This implementation expects to be built using the Cintcode BCPL compiler.
+This implementation expects to be built using the Cintcode BCPL
+compiler.  It may require modifications to work with other BCPL
+compilers.
 
 It uses several features that are not mentioned, or are
 described as extensions by _BCPL - the language and its compiler_,
@@ -8,9 +10,12 @@ including:
  * The infixed byte operator `%`
  * Using `{` and `}` as section brackets
  * Using lower case and `_` in variable names
+ * Using `?` to indicate an uninitialised value
 
 BCPL does support separate compilation, but running
 separately-compiled modules in Cintsys seems to be ill-supported,
 requiring use of the run-time dynamic loading mechanism, `loadseg`.
 The examples in the manual all use `GET` to textually include library
-source code in the main program, so mal does the same.
+source code in the main program, so mal does the same.  Nonetheless,
+in an environment with separate compilation it should be possible to
+remove all these `GET` directives and compile each `.b` file separately.
\ No newline at end of file
diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index 40443969ff..f969828fdd 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -2,6 +2,7 @@ GLOBAL { readline: ug
          pr_str
          read_str
          init_types; nil; empty; cons
+	 alloc_int
 	 str_setlen; alloc_str; str_bcpl2mal; as_sym
 }
 
@@ -21,13 +22,16 @@ MANIFEST
   // like nil, is a special value.
   t_lst = #x01; lst_first = 1; lst_rest = 2; lst_sz = 3
 
+  // Integers.
+  t_int = #x02; int_value = 1; int_sz = 2
+					       
   // Strings.  Unlike conventional BCPL strings, these have an entire word
   // to store the length.  For compatibility with library routines, the
   // first byte of the string is also the length if it will fit.
-  t_str = #x02; str_len = 1; str_data = 2
+  t_str = #x03; str_len = 1; str_data = 2
 
   // Symbols.  Symbols are like strings, but with a different type.
-  t_sym = #x12
+  t_sym = #x13
 
   maxbcplstrlen = (1 << (BITSPERBCPLWORD / bytesperword)) - 1
 }
diff --git a/impls/bcpl/reader.b b/impls/bcpl/reader.b
index 246f972548..3be420884b 100644
--- a/impls/bcpl/reader.b
+++ b/impls/bcpl/reader.b
@@ -75,7 +75,66 @@ LET tokenize(s) = VALOF
   RESULTIS tokens
 }
 
-LET read_atom(rdr) = as_sym(reader_next(rdr))
+// This is for reading into a string, as opposed to read_str, which is
+// for reading from a string.
+LET read_string(token) = VALOF
+{ LET i, o, out = 2, 0, ?
+  WHILE i < token!str_len DO
+  { IF (token + str_data)%i = '\' THEN i := i + 1
+    i, o := i + 1, o + 1
+  }
+  // UNLESS i = token!str_len & (token + str_data)%i = '*"' DO
+  //   throw(str_bcpl2mal("unbalanced quotes"))
+  out := alloc_str(o)
+  i, o := 2,  1
+  WHILE i < token!str_len DO
+  { LET ch = (token + str_data)%i
+    IF ch = '\' THEN
+    { i := i + 1
+      ch := (token + str_data)%i
+      IF ch = 'n' THEN ch := '*n'
+    }
+    (out + str_data)%o := ch
+    i, o := i + 1, o + 1
+  }
+  str_setlen(out, o - 1)
+  RESULTIS out
+}
+
+LET read_number_maybe(token) = VALOF
+{ LET sd, start, negative, acc = token + str_data, 1, FALSE, 0
+  IF sd%1 = '-' THEN
+  { IF token!str_len = 1 THEN RESULTIS nil
+    negative := TRUE
+    start := 2
+  }
+  FOR i = start TO token!str_len DO
+  { acc := acc * 10
+    SWITCHON sd%i INTO
+    { CASE '0': ENDCASE
+      CASE '1': acc := acc + 1; ENDCASE
+      CASE '2': acc := acc + 2; ENDCASE
+      CASE '3': acc := acc + 3; ENDCASE
+      CASE '4': acc := acc + 4; ENDCASE
+      CASE '5': acc := acc + 5; ENDCASE
+      CASE '6': acc := acc + 6; ENDCASE
+      CASE '7': acc := acc + 7; ENDCASE
+      CASE '8': acc := acc + 8; ENDCASE
+      CASE '9': acc := acc + 9; ENDCASE
+      DEFAULT: RESULTIS nil
+    }
+  }
+  IF negative THEN acc := -acc
+  RESULTIS alloc_int(acc)
+}
+
+LET read_atom(rdr) = VALOF
+{ LET token, maybenum = reader_next(rdr), ?
+  IF (token + str_data)%1 = '*"' THEN RESULTIS read_string(token)
+  maybenum := read_number_maybe(token)
+  UNLESS maybenum = nil RESULTIS maybenum
+  RESULTIS as_sym(token)
+}
 
 LET read_list(rdr) = VALOF
 { reader_next(rdr) // Skip leading '('
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index eb0939c3e2..6caeeb5401 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -7,8 +7,8 @@ LET init_types() BE
   empty!lst_first, empty!lst_rest := nil, empty
 }
 
-LET cons(first, rest) = VALOF {
-  LET result = getvec(lst_sz)
+LET cons(first, rest) = VALOF
+{ LET result = getvec(lst_sz)
   !result := 0
   type OF result := t_lst
   result!lst_first := first
@@ -16,6 +16,14 @@ LET cons(first, rest) = VALOF {
   RESULTIS result
 }
 
+LET alloc_int(value) = VALOF
+{ LET result = getvec(int_sz)
+  !result := 0
+  type OF result := t_int
+  result!int_value := value
+  RESULTIS result
+}
+
 LET str_setlen(str, len) BE
 { str!str_len := len
   (str + str_data) % 0 := len <= maxbcplstrlen -> len, maxbcplstrlen

From fbbb9f1177c8c39fd138a77fefee41c70ff087a9 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Wed, 5 Jun 2019 12:37:16 +0100
Subject: [PATCH 012/148] bcpl: Simplify tokenizing SWITCHON.

The variable "tokstart" was being set to the same value in every
branch of the SWITCHON statement (except those where it was never
used), so it may as well be hoisted out of the SWITCHON.  This also
allows the code handling '~@' to be simplified.
---
 impls/bcpl/reader.b | 12 +++---------
 1 file changed, 3 insertions(+), 9 deletions(-)

diff --git a/impls/bcpl/reader.b b/impls/bcpl/reader.b
index 3be420884b..ee86d983a3 100644
--- a/impls/bcpl/reader.b
+++ b/impls/bcpl/reader.b
@@ -26,29 +26,23 @@ LET tokenize(s) = VALOF
   LET sd = s + str_data
   LET tokstart, token = ?, ?
   FOR p = 1 TO s!str_len DO
-  { SWITCHON sd%p INTO
+  { tokstart := p
+    SWITCHON sd%p INTO
     { CASE ' ': CASE '*t': CASE '*n': CASE ',': LOOP // Inter-token whitespace
       CASE '~': // Maybe ~@
-        IF p < s!str_len & sd%(p+1) = '@' THEN
-	{ tokstart := p
-	  p := p + 1
-	  ENDCASE
-	}
+        IF p < s!str_len & sd%(p+1) = '@' THEN p := p + 1 // FALLTHROUGH
       CASE '[': CASE ']': CASE '{': CASE '}': CASE '(': CASE ')': CASE '*'':
       CASE '`': CASE '^': CASE '@': // Single-character token
-        tokstart := p
         ENDCASE
       CASE ';': // Comment
         p := p + 1 REPEATUNTIL p > s!str_len | sd%p = '*n'
         LOOP
       CASE '*"': // String
-        tokstart := p
         p := p + 1
         UNTIL p > s!str_len | sd%p = '*"' DO
           p := p + (sd%p = '\' -> 2, 1)
         ENDCASE     
       DEFAULT: // Symbol or number
-        tokstart := p
         UNTIL p > s!str_len DO
         { SWITCHON sd%p INTO
           { CASE ' ': CASE '*t': CASE '*n': CASE ',':

From 3980c87a157ba50192fa168dff307c63da402b4b Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Wed, 5 Jun 2019 12:39:43 +0100
Subject: [PATCH 013/148] bcpl: Helpful comment at the top of the big
 tokenize() SWITCHON.

---
 impls/bcpl/reader.b | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/impls/bcpl/reader.b b/impls/bcpl/reader.b
index ee86d983a3..bcc55dbad4 100644
--- a/impls/bcpl/reader.b
+++ b/impls/bcpl/reader.b
@@ -27,6 +27,8 @@ LET tokenize(s) = VALOF
   LET tokstart, token = ?, ?
   FOR p = 1 TO s!str_len DO
   { tokstart := p
+    // Within this SWITCHON command, use LOOP to ignore input, or ENDCASE to
+    // emit a token.
     SWITCHON sd%p INTO
     { CASE ' ': CASE '*t': CASE '*n': CASE ',': LOOP // Inter-token whitespace
       CASE '~': // Maybe ~@

From 2e05ad92a05102293d20af556f8b67dff7dea19e Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Wed, 5 Jun 2019 12:43:27 +0100
Subject: [PATCH 014/148] bcpl: Simplify string tokenizer.

The code is now obviously similar to the comment-skipping code just
above it.
---
 impls/bcpl/reader.b | 4 +---
 1 file changed, 1 insertion(+), 3 deletions(-)

diff --git a/impls/bcpl/reader.b b/impls/bcpl/reader.b
index bcc55dbad4..e269ca64dd 100644
--- a/impls/bcpl/reader.b
+++ b/impls/bcpl/reader.b
@@ -40,9 +40,7 @@ LET tokenize(s) = VALOF
         p := p + 1 REPEATUNTIL p > s!str_len | sd%p = '*n'
         LOOP
       CASE '*"': // String
-        p := p + 1
-        UNTIL p > s!str_len | sd%p = '*"' DO
-          p := p + (sd%p = '\' -> 2, 1)
+        p := p + (sd%p = '\' -> 2, 1) REPEATUNTIL p > s!str_len | sd%p = '*"'
         ENDCASE     
       DEFAULT: // Symbol or number
         UNTIL p > s!str_len DO

From 809ae6391ee389338442bd96a8a1d496af4d56f1 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Thu, 6 Jun 2019 16:22:01 +0200
Subject: [PATCH 015/148] bcpl: Add support for printing integers.

Actually, this commit seems to add all support for printing, since I
left out printer.b heretofore.
---
 impls/bcpl/printer.b | 104 +++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 104 insertions(+)
 create mode 100644 impls/bcpl/printer.b

diff --git a/impls/bcpl/printer.b b/impls/bcpl/printer.b
new file mode 100644
index 0000000000..967a7a0663
--- /dev/null
+++ b/impls/bcpl/printer.b
@@ -0,0 +1,104 @@
+GET "libhdr"
+GET "malhdr"
+
+// The general structure of printing routines is:
+// print_thing(..., buf, pos, count_only)
+// buf is a buffer accumulating the output (only if count_only is FALSE)
+// pos is the output offset within that buffer
+// if count_only is FALSE, then routine will write result to buf
+// in any case, pos is new output offset.
+
+// Print a BCPL-format (constant) string.
+LET print_const(str, buf, pos, count_only) = VALOF
+{ UNLESS count_only DO
+    FOR i = 1 TO str%0 DO
+      buf%(pos + i - 1) := str%i
+  RESULTIS pos + str%0
+}
+
+// Print a single character
+LET print_char(chr, buf, pos, count_only) = VALOF
+{ UNLESS count_only DO buf%pos := chr
+  RESULTIS pos + 1
+}
+
+// Print a mal integer
+LET print_int(int, buf, pos, count_only) = VALOF
+{ LET val = int!int_value
+  LET len, negative = 0, FALSE
+  IF val = 0 RESULTIS print_char('0', buf, pos, count_only)
+  IF val < 0 THEN
+  { val := -val // XXX This doesnt work for the most negative integer
+    len := len + 1
+    negative := TRUE
+  }
+  WHILE val > 0 DO
+  { val := val / 10
+    len := len + 1
+  }
+  IF count_only RESULTIS pos + len
+  val := negative -> -int!int_value, int!int_value
+  pos := pos + len - 1
+  WHILE val > 0 DO
+  { buf%pos :=
+        (TABLE '0', '1', '2', '3', '4', '5', '6', '7', '8', '9')!(val REM 10)
+    val := val / 10
+    pos := pos - 1
+  }
+  IF negative THEN
+  { buf%pos := '-'
+    pos := pos - 1
+  }
+  RESULTIS pos + len + 1
+}
+
+// Print a mal string
+LET print_str(str, buf, pos, count_only) = VALOF
+{ pos := print_char('*"', buf, pos, count_only)
+  FOR i = 1 TO str!str_len DO
+  { LET ch = (str + str_data)%i
+    SWITCHON ch INTO
+    { CASE '*n': ch := 'n'
+      CASE '\': CASE '*"': pos := print_char('\', buf, pos, count_only)
+    }
+    pos := print_char(ch, buf, pos, count_only)
+  }
+  RESULTIS print_char('*"', buf, pos, count_only)
+}
+
+LET print_sym(sym, buf, pos, count_only) = VALOF
+{ UNLESS count_only DO
+    FOR i = 1 TO sym!str_len DO
+      buf%(pos + i - 1) := (sym + str_data)%i
+  RESULTIS pos + sym!str_len
+}
+
+LET print_lst(lst, buf, pos, count_only) = VALOF
+{ pos := print_char('(', buf, pos, count_only)
+  UNLESS lst = empty DO
+  { pos := print_form(lst!lst_first, buf, pos, count_only)
+    lst := lst!lst_rest
+    IF lst = empty BREAK
+    pos := print_char(' ', buf, pos, count_only)
+  } REPEAT
+  RESULTIS print_char(')', buf, pos, count_only)
+}
+
+AND print_form(val, buf, pos, count_only) = VALOF
+  SWITCHON type OF val INTO
+  {
+    CASE t_nil: RESULTIS print_const("nil", buf, pos, count_only)
+    CASE t_lst: RESULTIS print_lst(val, buf, pos, count_only)
+    CASE t_int: RESULTIS print_int(val, buf, pos, count_only)
+    CASE t_str: RESULTIS print_str(val, buf, pos, count_only)
+    CASE t_sym: RESULTIS print_sym(val, buf, pos, count_only)
+    DEFAULT: RESULTIS print_const("<unprintable>", buf, pos, count_only)
+  }
+
+LET pr_str(x) = VALOF
+{ LET count = print_form(x, 0, 0, TRUE)
+  LET out = alloc_str(count)
+  print_form(x, out + str_data, 1, FALSE)
+  str_setlen(out, count)
+  RESULTIS out
+}

From 90f64be21a35ee0a652c1c7210bd4333484b86ae Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Thu, 6 Jun 2019 22:07:44 +0200
Subject: [PATCH 016/148] bcpl: Support for throwing exceptions and trapping
 them in the REPL.

---
 impls/bcpl/malhdr.h           | 2 ++
 impls/bcpl/reader.b           | 5 +++--
 impls/bcpl/step1_read_print.b | 7 +++++++
 impls/bcpl/types.b            | 5 +++++
 4 files changed, 17 insertions(+), 2 deletions(-)

diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index f969828fdd..9757078bf3 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -4,6 +4,8 @@ GLOBAL { readline: ug
          init_types; nil; empty; cons
 	 alloc_int
 	 str_setlen; alloc_str; str_bcpl2mal; as_sym
+	 throw
+	 catch_level; catch_label; last_exception
 }
 
 MANIFEST
diff --git a/impls/bcpl/reader.b b/impls/bcpl/reader.b
index e269ca64dd..a9973114f7 100644
--- a/impls/bcpl/reader.b
+++ b/impls/bcpl/reader.b
@@ -77,8 +77,8 @@ LET read_string(token) = VALOF
   { IF (token + str_data)%i = '\' THEN i := i + 1
     i, o := i + 1, o + 1
   }
-  // UNLESS i = token!str_len & (token + str_data)%i = '*"' DO
-  //   throw(str_bcpl2mal("unbalanced quotes"))
+  UNLESS i = token!str_len & (token + str_data)%i = '*"' DO
+    throw(str_bcpl2mal("unbalanced quotes"))
   out := alloc_str(o)
   i, o := 2,  1
   WHILE i < token!str_len DO
@@ -148,6 +148,7 @@ AND read_list_tail(rdr) = VALOF
 AND read_form(rdr) = VALOF
   SWITCHON (reader_peek(rdr) + str_data)%1 INTO
   { CASE '(': RESULTIS read_list(rdr)
+    CASE ')': throw(str_bcpl2mal("unbalanced parentheses"))
     DEFAULT: RESULTIS read_atom(rdr)
   }
 
diff --git a/impls/bcpl/step1_read_print.b b/impls/bcpl/step1_read_print.b
index 7b5d0431bf..1557f00598 100644
--- a/impls/bcpl/step1_read_print.b
+++ b/impls/bcpl/step1_read_print.b
@@ -16,6 +16,13 @@ LET rep(x) = PRINT(EVAL(READ(x)))
 
 LET repl() BE
 { LET prompt = str_bcpl2mal("user> ")
+  catch_level, catch_label := level(), uncaught
+  IF FALSE THEN
+  { uncaught:
+    writes("Uncaught exception: ")
+    writes(@(pr_str(last_exception)!str_data))
+    newline()
+  }
   { LET line = readline(prompt)
     IF line = nil THEN BREAK
     writes(@rep(line)!str_data)
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index 6caeeb5401..df05fd60e5 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -55,3 +55,8 @@ LET str_bcpl2mal(bcplstr) = VALOF
     result!(str_data + i) := bcplstr!i
   RESULTIS result
 }
+
+LET throw(val) BE
+{ last_exception := val
+  longjump(catch_level, catch_label)
+}

From dc8ce27b8712c6a53f56627b1475c3d9329ef337 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Thu, 6 Jun 2019 22:50:37 +0200
Subject: [PATCH 017/148] bcpl: Slightly better handling of EOF in reader.

---
 impls/bcpl/reader.b | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/impls/bcpl/reader.b b/impls/bcpl/reader.b
index a9973114f7..f3444ea5b0 100644
--- a/impls/bcpl/reader.b
+++ b/impls/bcpl/reader.b
@@ -146,11 +146,15 @@ AND read_list_tail(rdr) = VALOF
   }
 
 AND read_form(rdr) = VALOF
-  SWITCHON (reader_peek(rdr) + str_data)%1 INTO
+{ LET token = reader_peek(rdr)
+  UNLESS type OF token = t_str DO
+    throw(str_bcpl2mal("unexpected end of input"))
+  SWITCHON (token + str_data)%1 INTO
   { CASE '(': RESULTIS read_list(rdr)
     CASE ')': throw(str_bcpl2mal("unbalanced parentheses"))
     DEFAULT: RESULTIS read_atom(rdr)
   }
+}
 
 LET read_str(s) = VALOF
 { LET tokens = tokenize(s)

From ab3034bfb74844473267bd9901fec7e37273cfb0 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 11 Jun 2019 12:44:31 +0200
Subject: [PATCH 018/148] bcpl: Add a vector type with reading and printing
 machinery.

Vectors are stored as vectors, so they're more space-efficient than
lists, but the 'rest' and 'cons' functions will be expensive.
---
 impls/bcpl/malhdr.h     |  5 +++
 impls/bcpl/printer.b    | 10 ++++++
 impls/bcpl/reader.b     | 18 +++++++++++
 impls/bcpl/step2_eval.b | 69 +++++++++++++++++++++++++++++++++++++++++
 impls/bcpl/types.b      |  8 +++++
 5 files changed, 110 insertions(+)
 create mode 100644 impls/bcpl/step2_eval.b

diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index 9757078bf3..c9294dd0be 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -4,6 +4,7 @@ GLOBAL { readline: ug
          init_types; nil; empty; cons
 	 alloc_int
 	 str_setlen; alloc_str; str_bcpl2mal; as_sym
+	 alloc_vec
 	 throw
 	 catch_level; catch_label; last_exception
 }
@@ -36,4 +37,8 @@ MANIFEST
   t_sym = #x13
 
   maxbcplstrlen = (1 << (BITSPERBCPLWORD / bytesperword)) - 1
+
+  // Vectors.  Structured like strings except that the data consists of
+  // pointers rather than packed characters.
+  t_vec = #x04; vec_len = 1; vec_data = 2
 }
diff --git a/impls/bcpl/printer.b b/impls/bcpl/printer.b
index 967a7a0663..5c21ee71fe 100644
--- a/impls/bcpl/printer.b
+++ b/impls/bcpl/printer.b
@@ -84,11 +84,21 @@ LET print_lst(lst, buf, pos, count_only) = VALOF
   RESULTIS print_char(')', buf, pos, count_only)
 }
 
+AND print_vec(vec, buf, pos, count_only) = VALOF
+{ pos := print_char('[', buf, pos, count_only)
+  FOR i = vec_data TO vec_data + vec!vec_len - 1 DO
+  { UNLESS i = vec_data DO pos := print_char(' ', buf, pos, count_only)
+    pos := print_form(vec!i, buf, pos, count_only)
+  }
+  RESULTIS print_char(']', buf, pos, count_only)
+}
+
 AND print_form(val, buf, pos, count_only) = VALOF
   SWITCHON type OF val INTO
   {
     CASE t_nil: RESULTIS print_const("nil", buf, pos, count_only)
     CASE t_lst: RESULTIS print_lst(val, buf, pos, count_only)
+    CASE t_vec: RESULTIS print_vec(val, buf, pos, count_only)
     CASE t_int: RESULTIS print_int(val, buf, pos, count_only)
     CASE t_str: RESULTIS print_str(val, buf, pos, count_only)
     CASE t_sym: RESULTIS print_sym(val, buf, pos, count_only)
diff --git a/impls/bcpl/reader.b b/impls/bcpl/reader.b
index f3444ea5b0..b8d1a8ab81 100644
--- a/impls/bcpl/reader.b
+++ b/impls/bcpl/reader.b
@@ -145,6 +145,22 @@ AND read_list_tail(rdr) = VALOF
     RESULTIS cons(first, rest)
   }
 
+AND read_vec(rdr) = VALOF
+{ reader_next(rdr) // Skip leading '['
+  RESULTIS read_vec_tail(rdr, 0)
+}
+
+AND read_vec_tail(rdr, len) = VALOF
+  TEST (reader_peek(rdr) + str_data)%1 = ']' THEN
+  { reader_next(rdr)
+    RESULTIS alloc_vec(len)
+  } ELSE {
+    LET first = read_form(rdr)
+    LET vec = read_vec_tail(rdr, len + 1)
+    (vec + vec_data)!len := first
+    RESULTIS vec
+  }
+
 AND read_form(rdr) = VALOF
 { LET token = reader_peek(rdr)
   UNLESS type OF token = t_str DO
@@ -152,6 +168,8 @@ AND read_form(rdr) = VALOF
   SWITCHON (token + str_data)%1 INTO
   { CASE '(': RESULTIS read_list(rdr)
     CASE ')': throw(str_bcpl2mal("unbalanced parentheses"))
+    CASE '[': RESULTIS read_vec(rdr)
+    CASE ']': throw(str_bcpl2mal("unbalanced brackets"))
     DEFAULT: RESULTIS read_atom(rdr)
   }
 }
diff --git a/impls/bcpl/step2_eval.b b/impls/bcpl/step2_eval.b
new file mode 100644
index 0000000000..999231e126
--- /dev/null
+++ b/impls/bcpl/step2_eval.b
@@ -0,0 +1,69 @@
+GET "libhdr"
+GET "malhdr"
+
+GET "printer.b"
+GET "reader.b"
+GET "readline.b"
+GET "types.b"
+
+LET READ(x) = read_str(x)
+
+LET eval_ast(ast, env) = VALOF
+  SWITCHON type OF ast INTO
+  { CASE t_sym: RESULTIS env(ast)
+    CASE t_lst:
+      TEST ast = empty THEN RESULTIS empty
+      ELSE RESULTIS cons(EVAL(ast!lst_first), eval_ast(ast!lst_rest))
+    DEFAULT: RESULTIS ast
+  }
+
+AND EVAL(ast) = VALOF
+  UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env)
+  IF ast = empty RESULTIS ast
+  ast := eval_ast(ast, env)
+  
+  
+
+LET PRINT(x) = pr_str(x)
+
+LET add(a, b)      = alloc_int(a!int_value + b!int_value)
+LET subtract(a, b) = alloc_int(a!int_value - b!int_value)
+LET multiply(a, b) = alloc_int(a!int_value * b!int_value)
+LET divide(a, b)   = alloc_int(a!int_value / b!int_value)
+
+LET repl_env(key) = VALOF
+{ IF key!str_len = 1 SWITCHON (key + str_data)%1 INTO
+  { CASE '+': RESULTIS add
+    CASE '-': RESULTIS subtract
+    CASE '**': RESULTIS multiply
+    CASE '/': RESULTIS divide
+  }
+  throw(str_bcpl2mal("unknown function"))
+}
+
+LET rep(x) = PRINT(EVAL(READ(x), repl_env))
+
+LET repl() BE
+{ LET prompt = str_bcpl2mal("user> ")
+  catch_level, catch_label := level(), uncaught
+  IF FALSE THEN
+  { uncaught:
+    writes("Uncaught exception: ")
+    writes(@(pr_str(last_exception)!str_data))
+    newline()
+  }
+  { LET line = readline(prompt)
+    IF line = nil THEN BREAK
+    writes(@rep(line)!str_data)
+    newline()
+  } REPEAT
+}
+
+LET start() = VALOF
+{ LET ch = 0
+  init_types()
+  ch := rdch() REPEATUNTIL ch = '*n' // Consume command-line args
+  wrch('*n') // Terminate prompt printed by Cintsys
+  repl()
+  RESULTIS 0
+}
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index df05fd60e5..92357efbff 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -56,6 +56,14 @@ LET str_bcpl2mal(bcplstr) = VALOF
   RESULTIS result
 }
 
+LET alloc_vec(len) = VALOF
+{ LET result = getvec(vec_data + len)
+  !result := 0
+  type OF result := t_vec
+  result!vec_len := len
+  RESULTIS result
+}
+
 LET throw(val) BE
 { last_exception := val
   longjump(catch_level, catch_label)

From a58d7a6760560804a322c24a3cc0fed4b5b77ded Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 11 Jun 2019 13:03:20 +0200
Subject: [PATCH 019/148] bcpl: Add support for reader macros.

---
 impls/bcpl/reader.b | 13 +++++++++++++
 1 file changed, 13 insertions(+)

diff --git a/impls/bcpl/reader.b b/impls/bcpl/reader.b
index b8d1a8ab81..b3d38df74a 100644
--- a/impls/bcpl/reader.b
+++ b/impls/bcpl/reader.b
@@ -161,6 +161,13 @@ AND read_vec_tail(rdr, len) = VALOF
     RESULTIS vec
   }
 
+AND read_macro(rdr, name) = VALOF
+{ LET first, rest = as_sym(str_bcpl2mal(name)), ?
+  reader_next(rdr) // skip macro character
+  rest := cons(read_form(rdr), empty)
+  RESULTIS cons(first, rest)
+}
+
 AND read_form(rdr) = VALOF
 { LET token = reader_peek(rdr)
   UNLESS type OF token = t_str DO
@@ -170,6 +177,12 @@ AND read_form(rdr) = VALOF
     CASE ')': throw(str_bcpl2mal("unbalanced parentheses"))
     CASE '[': RESULTIS read_vec(rdr)
     CASE ']': throw(str_bcpl2mal("unbalanced brackets"))
+    CASE '*'': RESULTIS read_macro(rdr, "quote")
+    CASE '`': RESULTIS read_macro(rdr, "quasiquote")
+    CASE '~':
+      IF token!str_len = 2 THEN RESULTIS read_macro(rdr, "splice-unquote")
+      RESULTIS read_macro(rdr, "unquote")
+    CASE '@': RESULTIS read_macro(rdr, "deref")
     DEFAULT: RESULTIS read_atom(rdr)
   }
 }

From 510e71cd77a85aa51a8afbab76b8e35c316fff54 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 11 Jun 2019 16:01:45 +0200
Subject: [PATCH 020/148] bcpl: Step 2 completed (apart from hash-maps).

---
 impls/bcpl/Makefile     |  3 ++-
 impls/bcpl/step2_eval.b | 37 ++++++++++++++++++++++++++++---------
 impls/bcpl/types.b      | 14 ++++++++++++++
 3 files changed, 44 insertions(+), 10 deletions(-)

diff --git a/impls/bcpl/Makefile b/impls/bcpl/Makefile
index c14ee33b39..a937fdaa4d 100644
--- a/impls/bcpl/Makefile
+++ b/impls/bcpl/Makefile
@@ -1,4 +1,4 @@
-all: step0_repl step1_read_print
+all: step0_repl step1_read_print step2_eval
 
 %: %.b malhdr.h
 	cintsys -c "bcpl $< to $@"
@@ -7,6 +7,7 @@ all: step0_repl step1_read_print
 
 step0_repl: readline.b types.b
 step1_read_print: printer.b reader.b readline.b types.b
+step2_eval: printer.b reader.b readline.b types.b
 
 clean:
 	rm step0_repl step1_read_print
diff --git a/impls/bcpl/step2_eval.b b/impls/bcpl/step2_eval.b
index 999231e126..5ff7e7a9ce 100644
--- a/impls/bcpl/step2_eval.b
+++ b/impls/bcpl/step2_eval.b
@@ -13,23 +13,41 @@ LET eval_ast(ast, env) = VALOF
   { CASE t_sym: RESULTIS env(ast)
     CASE t_lst:
       TEST ast = empty THEN RESULTIS empty
-      ELSE RESULTIS cons(EVAL(ast!lst_first), eval_ast(ast!lst_rest))
+      ELSE RESULTIS cons(EVAL(ast!lst_first, env), eval_ast(ast!lst_rest, env))
+    CASE t_vec:
+      { LET new = alloc_vec(ast!vec_len)
+        FOR i = 0 TO ast!vec_len - 1 DO
+	  (new + vec_data)!i := EVAL((ast + vec_data)!i, env)
+	RESULTIS new
+      }
     DEFAULT: RESULTIS ast
   }
 
-AND EVAL(ast) = VALOF
-  UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env)
+AND EVAL(ast, env) = VALOF
+{ UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env)
   IF ast = empty RESULTIS ast
   ast := eval_ast(ast, env)
-  
-  
+  { LET fn, a, b = ast!lst_first, nth(ast, 1), nth(ast, 2)
+    UNLESS type OF fn = t_cfn DO throw(str_bcpl2mal("not a function"))
+    RESULTIS (fn!cfn_fn)(a, b)
+  }
+}
 
 LET PRINT(x) = pr_str(x)
 
-LET add(a, b)      = alloc_int(a!int_value + b!int_value)
-LET subtract(a, b) = alloc_int(a!int_value - b!int_value)
-LET multiply(a, b) = alloc_int(a!int_value * b!int_value)
-LET divide(a, b)   = alloc_int(a!int_value / b!int_value)
+LET add_fn(a, b)      = alloc_int(a!int_value + b!int_value)
+LET subtract_fn(a, b) = alloc_int(a!int_value - b!int_value)
+LET multiply_fn(a, b) = alloc_int(a!int_value * b!int_value)
+LET divide_fn(a, b)   = alloc_int(a!int_value / b!int_value)
+
+STATIC { add; subtract; multiply; divide }
+
+LET init_core() BE
+{ add      := alloc_cfn(add_fn)
+  subtract := alloc_cfn(subtract_fn)
+  multiply := alloc_cfn(multiply_fn)
+  divide   := alloc_cfn(divide_fn)
+}
 
 LET repl_env(key) = VALOF
 { IF key!str_len = 1 SWITCHON (key + str_data)%1 INTO
@@ -62,6 +80,7 @@ LET repl() BE
 LET start() = VALOF
 { LET ch = 0
   init_types()
+  init_core()
   ch := rdch() REPEATUNTIL ch = '*n' // Consume command-line args
   wrch('*n') // Terminate prompt printed by Cintsys
   repl()
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index 92357efbff..3ed48d0115 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -16,6 +16,12 @@ LET cons(first, rest) = VALOF
   RESULTIS result
 }
 
+LET nth(lst, n) = VALOF
+{ UNTIL n = 0 DO lst, n := lst!lst_rest, n - 1
+  IF lst = empty THEN throw(str_bcpl2mal("subscript out of range"))
+  RESULTIS lst!lst_first
+}
+
 LET alloc_int(value) = VALOF
 { LET result = getvec(int_sz)
   !result := 0
@@ -64,6 +70,14 @@ LET alloc_vec(len) = VALOF
   RESULTIS result
 }
 
+LET alloc_cfn(fn) = VALOF
+{ LET result = getvec(cfn_sz)
+  !result := 0
+  type OF result := t_cfn
+  result!cfn_fn := fn
+  RESULTIS result
+}
+
 LET throw(val) BE
 { last_exception := val
   longjump(catch_level, catch_label)

From 6862de8fdc5b80db3b7b7e4f0744ce0799599ebb Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 11 Jun 2019 19:29:30 +0200
Subject: [PATCH 021/148] bcpl: Re-organise type codes to add a "compound"
 flag.

I think this will be useful for hash-maps, since life is easier if
only scalar types can be hash-map keys.
---
 impls/bcpl/malhdr.h | 22 ++++++++++++++--------
 1 file changed, 14 insertions(+), 8 deletions(-)

diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index c9294dd0be..1dea5cda04 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -1,12 +1,14 @@
 GLOBAL { readline: ug
          pr_str
          read_str
-         init_types; nil; empty; cons
+         init_types; nil; empty; cons; nth
 	 alloc_int
 	 str_setlen; alloc_str; str_bcpl2mal; as_sym
 	 alloc_vec
+	 alloc_cfn
 	 throw
 	 catch_level; catch_label; last_exception
+	 init_core
 }
 
 MANIFEST
@@ -14,8 +16,9 @@ MANIFEST
   // The first word of any mal value indicates its type and suchlike.
   // The "supertype" indicates the meaning of the other words of the
   // value.  The "type" distinguishes mal types with the same supertype
-  // (for instance functions and macros).
-  type = SLCT 8:0:0; supertype = SLCT 4:0:0
+  // (for instance functions and macros).  The compoundflag is set on
+  // compund types (ones containing references to other values).
+  compoundflag = SLCT 1:7:0; supertype = SLCT 4:4:0; type = SLCT 8:0:0
 
   // Nil. There is a single nil value initialised by init_types(), but
   // it's a valid pointer so it can safely be dereferenced.
@@ -23,22 +26,25 @@ MANIFEST
 
   // Lists.  These are implemented as a linked list.  The empty list,
   // like nil, is a special value.
-  t_lst = #x01; lst_first = 1; lst_rest = 2; lst_sz = 3
+  t_lst = #x80; lst_first = 1; lst_rest = 2; lst_sz = 3
 
   // Integers.
-  t_int = #x02; int_value = 1; int_sz = 2
+  t_int = #x10; int_value = 1; int_sz = 2
 					       
   // Strings.  Unlike conventional BCPL strings, these have an entire word
   // to store the length.  For compatibility with library routines, the
   // first byte of the string is also the length if it will fit.
-  t_str = #x03; str_len = 1; str_data = 2
+  t_str = #x20; str_len = 1; str_data = 2
 
   // Symbols.  Symbols are like strings, but with a different type.
-  t_sym = #x13
+  t_sym = #x21
 
   maxbcplstrlen = (1 << (BITSPERBCPLWORD / bytesperword)) - 1
 
   // Vectors.  Structured like strings except that the data consists of
   // pointers rather than packed characters.
-  t_vec = #x04; vec_len = 1; vec_data = 2
+  t_vec = #x90; vec_len = 1; vec_data = 2
+
+  // Core functions.  Assumed to take two integer arguments.
+  t_cfn = #x30; cfn_fn = 1; cfn_sz = 2
 }

From 4e55e794ec0a7dd6063949402967a4732fdb88f6 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Fri, 14 Jun 2019 18:23:42 +0100
Subject: [PATCH 022/148] bcpl: Implementation of hash-maps.  As yet completely
 untested.

---
 impls/bcpl/malhdr.h |  10 ++++
 impls/bcpl/types.b  | 131 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 141 insertions(+)

diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index 1dea5cda04..0f042378c2 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -6,6 +6,7 @@ GLOBAL { readline: ug
 	 str_setlen; alloc_str; str_bcpl2mal; as_sym
 	 alloc_vec
 	 alloc_cfn
+	 empty_hashmap
 	 throw
 	 catch_level; catch_label; last_exception
 	 init_core
@@ -47,4 +48,13 @@ MANIFEST
 
   // Core functions.  Assumed to take two integer arguments.
   t_cfn = #x30; cfn_fn = 1; cfn_sz = 2
+
+  // Hash-maps.  These are implemented as crit-bit trees.  There are three
+  // types of node: internal nodes point to two other nodes and encode a
+  // bit offset in the spare bits of the first word.  External nodes
+  // point to a key and a value.  Empty nodes describe an empty hash-map.
+  t_hmi = #xa0; hmi_left = 1; hmi_right = 2; hmi_sz = 3
+  hmi_critbit = SLCT 0:8:0; hmi_maxcritbit = (1 << BITSPERBCPLWORD - 8) - 1
+  t_hmx = #xa1; hmx_key = 1; hmx_value = 2; hmx_sz = 3
+  t_hm0 = #xb0; hm0_sz = 1
 }
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index 3ed48d0115..bc7430cf68 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -5,6 +5,7 @@ LET init_types() BE
 { nil := TABLE t_nil
   empty := TABLE t_lst, ?, ?
   empty!lst_first, empty!lst_rest := nil, empty
+  empty_hashmap := TABLE t_hm0
 }
 
 LET cons(first, rest) = VALOF
@@ -62,6 +63,24 @@ LET str_bcpl2mal(bcplstr) = VALOF
   RESULTIS result
 }
 
+LET equal(a, b) = VALOF
+{ LET len = ?
+  UNLESS type OF a = type OF b RESULTIS FALSE
+  len := VALOF SWITCHON supertype OF a INTO
+  { CASE t_nil: RESULTIS 1
+    CASE t_int: RESULTIS int_sz
+    CASE t_str: RESULTIS str_data + 1 + a!str_len / bytesperword
+    CASE t_cfn: RESULTIS cfn_sz
+    DEFAULT: throw(str_bcpl2mal("incomparable value"))
+  }
+  // This is guaranteed not to walk off the end of b because any two mal
+  // values with different lengths will differ before the point where
+  // either of them ends.
+  FOR i = 0 TO len - 1 DO
+    UNLESS a!i = b!i RESULTIS FALSE
+  RESULTIS TRUE
+}
+
 LET alloc_vec(len) = VALOF
 { LET result = getvec(vec_data + len)
   !result := 0
@@ -78,6 +97,118 @@ LET alloc_cfn(fn) = VALOF
   RESULTIS result
 }
 
+LET alloc_hmx(key, value) = VALOF
+{ LET result = getvec(hmx_sz)
+  !result := 0
+  type OF result := t_hmx
+  result!hmx_key, result!hmx_value := key, value
+  RESULTIS result
+}
+
+LET alloc_hmi(critbit, left, right) = VALOF
+{ LET result = getvec(hmi_sz)
+  !result := 0
+  type OF result := t_hmi
+  hmi_critbit OF result := critbit
+  result!hmi_left, result!hmi_right := left, right
+  RESULTIS result
+}
+
+LET key_bit(key, bit) = VALOF
+{ LET offset, shift = bit / BITSPERBCPLWORD, bit REM BITSPERBCPLWORD
+  RESULTIS key!offset >> shift & 1
+}
+
+LET key_bitdiff(key1, key2) = VALOF
+{ LET bit = 0
+  WHILE key_bit(key1, bit) = key_bit(key2, bit) DO bit := bit + 1
+  RESULTIS bit
+}
+
+// hm_find finds the nearest entry in a non-empty hash-map to
+// the key requested, and returns the entire entry.
+LET hm_find(map, key) = VALOF
+{ WHILE type OF map = t_hmi DO
+    TEST key_bit(key, hmi_critbit OF map) THEN
+      map := map!hmi_right
+    ELSE
+      map := map!hmi_left
+  RESULTIS map
+}
+
+// Replace a known-present key in a non-empty hashmap.
+LET hm_replace(map, key, value) = VALOF
+{ LET left, right = ?, ?
+  IF type OF map = t_hmx RESULTIS alloc_hmx(key, value)
+  TEST key_bit(key, hmi_critbit OF map) THEN
+  { left := map!hmi_left
+    right := hm_replace(map!hmi_right, key, value)
+  } ELSE
+  { left := hm_replace(map!hmi_left, key, value)
+    right := map!hmi_right
+  }
+  RESULTIS alloc_hmi(hmi_critbit OF map, left, right)
+}
+
+// Add a known-absent key into a non-empty hashmap.  It's known that the
+// first bit where it differs from any existing key is 'bit'.
+LET hm_insert(map, bit, key, value) = VALOF
+{ LET left, right = ?, ?
+  IF type OF map = t_hmi & hmi_critbit OF map < bit THEN
+  { TEST key_bit(key,  hmi_critbit OF map) THEN
+    { left  := hmi_left OF map
+      right := hm_insert(hmi_right OF map, bit, key, value)
+    } ELSE
+    { left  := hm_insert(hmi_left OF map, bit, key, value)
+      right := hmi_right OF map
+    }
+    RESULTIS alloc_hmi(hmi_critbit OF map, left, right)
+  }
+  TEST key_bit(key, bit) THEN
+    left, right := map, alloc_hmx(key, value)
+  ELSE
+    right, left := map, alloc_hmx(key, value)
+  RESULTIS alloc_hmi(bit, left, right)
+}
+
+LET hm_set(map, key, value) = VALOF
+{ LET bit, nearest = ?, ?
+  IF map = empty_hashmap RESULTIS alloc_hmx(key, value)
+  nearest := hm_find(map, key)
+  IF equal(nearest, key) THEN RESULTIS hm_replace(map, key, value)
+  bit := key_bitdiff(key, nearest)
+  RESULTIS hm_insert(map, bit, key, value)
+}
+
+LET hm_remove(map, key) = VALOF
+{ IF map = empty_hashmap RESULTIS map
+  IF type OF map = t_hmx THEN
+    RESULTIS equal(map!hmx_key, key) -> empty_hashmap, map
+  TEST key_bit(key, hmi_critbit OF map) THEN
+  { LET child = hm_remove(map!hmi_right, key)
+    IF child = empty_hashmap RESULTIS map!hmi_left
+    RESULTIS alloc_hmi(hmi_critbit OF map, map!hmi_left, child)
+  } ELSE
+  { LET child = hm_remove(map!hmi_left, key)
+    IF child = empty_hashmap RESULTIS map!hmi_right
+    RESULTIS alloc_hmi(hmi_critbit OF map, child, hmi_right)
+  }
+}
+
+LET hm_get(map, key) = VALOF
+{ IF map = empty_hashmap RESULTIS nil
+  map := hm_find(map, key)
+  IF equal(map!hmx_key, key) RESULTIS map!hmx_value
+  RESULTIS nil
+}
+
+LET hm_contains(map, key) = VALOF
+{ IF map = empty_hashmap RESULTIS FALSE
+  map := hm_find(map, key)
+  IF equal(map!hmx_key, key) RESULTIS TRUE
+  RESULTIS FALSE
+}
+
 LET throw(val) BE
 { last_exception := val
   longjump(catch_level, catch_label)

From 25bada0c3685a96f42de64dbb15ff0dc4b7c1680 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Thu, 4 Jul 2019 23:14:20 +0100
Subject: [PATCH 023/148] bcpl: 90% of step 3.

The error message for not finding something in an environment is wrong,
and we segfault when evaluating a vector.
---
 impls/bcpl/Makefile    |   1 +
 impls/bcpl/env.b       |  27 +++++++++++
 impls/bcpl/malhdr.h    |  21 ++++----
 impls/bcpl/step3_env.b | 108 +++++++++++++++++++++++++++++++++++++++++
 impls/bcpl/types.b     |   8 +--
 5 files changed, 152 insertions(+), 13 deletions(-)
 create mode 100644 impls/bcpl/env.b
 create mode 100644 impls/bcpl/step3_env.b

diff --git a/impls/bcpl/Makefile b/impls/bcpl/Makefile
index a937fdaa4d..6b82081cb4 100644
--- a/impls/bcpl/Makefile
+++ b/impls/bcpl/Makefile
@@ -8,6 +8,7 @@ all: step0_repl step1_read_print step2_eval
 step0_repl: readline.b types.b
 step1_read_print: printer.b reader.b readline.b types.b
 step2_eval: printer.b reader.b readline.b types.b
+step3_env: env.b printer.b reader.b readline.b types.b
 
 clean:
 	rm step0_repl step1_read_print
diff --git a/impls/bcpl/env.b b/impls/bcpl/env.b
new file mode 100644
index 0000000000..97eaa1a71b
--- /dev/null
+++ b/impls/bcpl/env.b
@@ -0,0 +1,27 @@
+GET "libhdr"
+GET "malhdr"
+
+MANIFEST
+{ env_outer = 0; env_data; env_sz }
+
+LET env_new(outer) = VALOF
+{ LET env = getvec(env_sz)
+  env!env_outer := outer
+  env!env_data := empty_hashmap
+  RESULTIS env
+}
+
+LET env_set(env, key, value) BE
+  env!env_data := hm_set(env!env_data, key, value)
+
+LET env_find(env, key) = VALOF
+{ IF hm_contains(env!env_data, key) THEN RESULTIS env
+  UNLESS env!env_outer = nil RESULTIS env_find(env!env_outer, key)
+  RESULTIS nil
+}
+
+LET env_get(env, key) = VALOF
+{ env := env_find(env, key)
+  IF env = nil THEN throw(str_bcpl2mal("not found"))
+  RESULTIS hm_get(env!env_data, key)
+}
diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index 0f042378c2..289d8e432f 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -4,6 +4,7 @@ GLOBAL { readline: ug
          init_types; nil; empty; cons; nth
 	 alloc_int
 	 str_setlen; alloc_str; str_bcpl2mal; as_sym
+	 hm_set; hm_contains; hm_get
 	 alloc_vec
 	 alloc_cfn
 	 empty_hashmap
@@ -19,7 +20,7 @@ MANIFEST
   // value.  The "type" distinguishes mal types with the same supertype
   // (for instance functions and macros).  The compoundflag is set on
   // compund types (ones containing references to other values).
-  compoundflag = SLCT 1:7:0; supertype = SLCT 4:4:0; type = SLCT 8:0:0
+  compoundflag = SLCT 1:7:0; supertype = SLCT 4:0:0; type = SLCT 8:0:0
 
   // Nil. There is a single nil value initialised by init_types(), but
   // it's a valid pointer so it can safely be dereferenced.
@@ -27,34 +28,34 @@ MANIFEST
 
   // Lists.  These are implemented as a linked list.  The empty list,
   // like nil, is a special value.
-  t_lst = #x80; lst_first = 1; lst_rest = 2; lst_sz = 3
+  t_lst = #x08; lst_first = 1; lst_rest = 2; lst_sz = 3
 
   // Integers.
-  t_int = #x10; int_value = 1; int_sz = 2
+  t_int = #x01; int_value = 1; int_sz = 2
 					       
   // Strings.  Unlike conventional BCPL strings, these have an entire word
   // to store the length.  For compatibility with library routines, the
   // first byte of the string is also the length if it will fit.
-  t_str = #x20; str_len = 1; str_data = 2
+  t_str = #x02; str_len = 1; str_data = 2
 
   // Symbols.  Symbols are like strings, but with a different type.
-  t_sym = #x21
+  t_sym = #x12
 
   maxbcplstrlen = (1 << (BITSPERBCPLWORD / bytesperword)) - 1
 
   // Vectors.  Structured like strings except that the data consists of
   // pointers rather than packed characters.
-  t_vec = #x90; vec_len = 1; vec_data = 2
+  t_vec = #x09; vec_len = 1; vec_data = 2
 
   // Core functions.  Assumed to take two integer arguments.
-  t_cfn = #x30; cfn_fn = 1; cfn_sz = 2
+  t_cfn = #x03; cfn_fn = 1; cfn_sz = 2
 
   // Hash-maps.  These are implemented as crit-bit trees.  There are three
   // types of node: internal nodes point to two other nodes and encode a
   // bit offset in the spare bits of the first word.  External nodes
   // point to a key and a value.  Empty nodes describe an empty hash-map.
-  t_hmi = #xa0; hmi_left = 1; hmi_right = 2; hmi_sz = 3
+  t_hmi = #x0a; hmi_left = 1; hmi_right = 2; hmi_sz = 3
   hmi_critbit = SLCT 0:8:0; hmi_maxcritbit = (1 << BITSPERBCPLWORD - 8) - 1
-  t_hmx = #xa1; hmx_key = 1; hmx_value = 2; hmx_sz = 3
-  t_hm0 = #xb0; hm0_sz = 1
+  t_hmx = #x1a; hmx_key = 1; hmx_value = 2; hmx_sz = 3
+  t_hm0 = #x0b; hm0_sz = 1
 }
diff --git a/impls/bcpl/step3_env.b b/impls/bcpl/step3_env.b
new file mode 100644
index 0000000000..e554c1ed54
--- /dev/null
+++ b/impls/bcpl/step3_env.b
@@ -0,0 +1,108 @@
+GET "libhdr"
+GET "malhdr"
+
+GET "env.b"
+GET "printer.b"
+GET "reader.b"
+GET "readline.b"
+GET "types.b"
+
+LET READ(x) = read_str(x)
+
+// Helper function for EVAL.
+LET is_sym(a, b) = VALOF
+{ UNLESS type OF a = t_sym RESULTIS FALSE
+  UNLESS a!str_len = b%0 RESULTIS FALSE
+  FOR i = 0 TO a!str_len / bytesperword DO
+    UNLESS (a+str_data)!i = b!i RESULTIS FALSE
+  RESULTIS TRUE
+}
+
+LET eval_ast(ast, env) = VALOF
+  SWITCHON type OF ast INTO
+  { CASE t_sym: RESULTIS env_get(env, ast)
+    CASE t_lst:
+      TEST ast = empty THEN RESULTIS empty
+      ELSE RESULTIS cons(EVAL(ast!lst_first, env), eval_ast(ast!lst_rest, env))
+    CASE t_vec:
+      { LET new = alloc_vec(ast!vec_len)
+        FOR i = 0 TO ast!vec_len - 1 DO
+	  (new + vec_data)!i := EVAL((ast + vec_data)!i, env)
+	RESULTIS new
+      }
+    DEFAULT: RESULTIS ast
+  }
+
+AND EVAL(ast, env) = VALOF
+{ UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env)
+  IF ast = empty RESULTIS ast
+  { LET fn = ast!lst_first
+    IF is_sym(fn, "def!") THEN
+    { LET val = EVAL(nth(ast, 2), env)
+      env_set(env, nth(ast, 1), val, env)
+      RESULTIS val
+    }
+    IF is_sym(fn, "let**") THEN
+    { LET newenv, bindings = env_new(env), nth(ast, 1)
+      UNTIL bindings = empty DO
+      { env_set(newenv, bindings!lst_first, EVAL(nth(bindings, 1), newenv))
+        bindings := bindings!lst_rest!lst_rest
+      }
+      RESULTIS EVAL(nth(ast, 2), newenv)
+    }
+  }
+  ast := eval_ast(ast, env)
+  { LET fn, a, b = ast!lst_first, nth(ast, 1), nth(ast, 2)
+    UNLESS type OF fn = t_cfn DO throw(str_bcpl2mal("not a function"))
+    RESULTIS (fn!cfn_fn)(a, b)
+  }
+}
+
+LET PRINT(x) = pr_str(x)
+
+LET add_fn(a, b)      = alloc_int(a!int_value + b!int_value)
+LET subtract_fn(a, b) = alloc_int(a!int_value - b!int_value)
+LET multiply_fn(a, b) = alloc_int(a!int_value * b!int_value)
+LET divide_fn(a, b)   = alloc_int(a!int_value / b!int_value)
+
+STATIC { add; subtract; multiply; divide }
+
+LET init_core() BE
+{ add      := alloc_cfn(add_fn)
+  subtract := alloc_cfn(subtract_fn)
+  multiply := alloc_cfn(multiply_fn)
+  divide   := alloc_cfn(divide_fn)
+}
+
+LET rep(x, env) = PRINT(EVAL(READ(x), env))
+
+LET repl() BE
+{ LET prompt = str_bcpl2mal("user> ")
+  LET repl_env = env_new(nil)
+  env_set(repl_env, as_sym(str_bcpl2mal("+")), add)
+  env_set(repl_env, as_sym(str_bcpl2mal("-")), subtract)
+  env_set(repl_env, as_sym(str_bcpl2mal("**")), multiply)
+  env_set(repl_env, as_sym(str_bcpl2mal("/")), divide)
+  catch_level, catch_label := level(), uncaught
+  IF FALSE THEN
+  { uncaught:
+    writes("Uncaught exception: ")
+    writes(@(pr_str(last_exception)!str_data))
+    newline()
+  }
+  { LET line = readline(prompt)
+    IF line = nil THEN BREAK
+    writes(@rep(line, repl_env)!str_data)
+    newline()
+  } REPEAT
+}
+
+LET start() = VALOF
+{ LET ch = 0
+  init_types()
+  init_core()
+  ch := rdch() REPEATUNTIL ch = '*n' // Consume command-line args
+  wrch('*n') // Terminate prompt printed by Cintsys
+  repl()
+  RESULTIS 0
+}
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index bc7430cf68..59d36c9f05 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -37,8 +37,10 @@ LET str_setlen(str, len) BE
 }
 
 LET alloc_str(len) = VALOF
-{ LET result = getvec(str_data + 1 + len / bytesperword)
+{ LET words = str_data + 1 + len / bytesperword
+  LET result = getvec(words)
   !result := 0
+  result!(words - 1) := 0 // Make sure the unused part word at the end is 0.
   type OF result := t_str
   result!str_len := 0
   (result+str_data)%0 := 0
@@ -175,8 +177,8 @@ LET hm_set(map, key, value) = VALOF
 { LET bit, nearest = ?, ?
   IF map = empty_hashmap RESULTIS alloc_hmx(key, value)
   nearest := hm_find(map, key)
-  IF equal(nearest, key) THEN RESULTIS hm_replace(map, key, value)
-  bit := key_bitdiff(key, nearest)
+  IF equal(nearest!hmx_key, key) THEN RESULTIS hm_replace(map, key, value)
+  bit := key_bitdiff(key, nearest!hmx_key)
   RESULTIS hm_insert(map, bit, key, value)
 }
 

From 023825bb5f88e2ce48971e2fc1a32d07ef3af23f Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sat, 6 Jul 2019 22:29:51 +0100
Subject: [PATCH 024/148] bcpl: Support vectors as bindings in 'let*'.

---
 impls/bcpl/malhdr.h    |  2 +-
 impls/bcpl/step3_env.b |  2 +-
 impls/bcpl/types.b     | 13 +++++++++++++
 3 files changed, 15 insertions(+), 2 deletions(-)

diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index 289d8e432f..053dbb55cb 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -1,7 +1,7 @@
 GLOBAL { readline: ug
          pr_str
          read_str
-         init_types; nil; empty; cons; nth
+         init_types; nil; empty; cons; nth; as_lst
 	 alloc_int
 	 str_setlen; alloc_str; str_bcpl2mal; as_sym
 	 hm_set; hm_contains; hm_get
diff --git a/impls/bcpl/step3_env.b b/impls/bcpl/step3_env.b
index e554c1ed54..4cc856677f 100644
--- a/impls/bcpl/step3_env.b
+++ b/impls/bcpl/step3_env.b
@@ -43,7 +43,7 @@ AND EVAL(ast, env) = VALOF
       RESULTIS val
     }
     IF is_sym(fn, "let**") THEN
-    { LET newenv, bindings = env_new(env), nth(ast, 1)
+    { LET newenv, bindings = env_new(env), as_lst(nth(ast, 1))
       UNTIL bindings = empty DO
       { env_set(newenv, bindings!lst_first, EVAL(nth(bindings, 1), newenv))
         bindings := bindings!lst_rest!lst_rest
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index 59d36c9f05..cbf656ee1b 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -23,6 +23,19 @@ LET nth(lst, n) = VALOF
   RESULTIS lst!lst_first
 }
 
+LET as_lst(x) = VALOF SWITCHON type OF x INTO
+{ CASE t_lst: RESULTIS x
+  CASE t_vec:
+    { LET l = empty
+      FOR i = x!vec_len - 1 TO 0 BY -1 DO
+        l := cons((x+vec_data)!i, l)
+      RESULTIS l
+    }
+  DEFAULT:
+    throw(str_bcpl2mal("cannot convert to list"))
+}
+  
+
 LET alloc_int(value) = VALOF
 { LET result = getvec(int_sz)
   !result := 0

From f5846da639536f2da5112e1cee2adc84f42b05e8 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sun, 7 Jul 2019 10:07:35 +0100
Subject: [PATCH 025/148] bcpl: Support for reading and printing hash-maps.

---
 impls/bcpl/printer.b | 25 +++++++++++++++++++++++++
 impls/bcpl/reader.b  | 16 ++++++++++++++++
 2 files changed, 41 insertions(+)

diff --git a/impls/bcpl/printer.b b/impls/bcpl/printer.b
index 5c21ee71fe..7a851e4aa6 100644
--- a/impls/bcpl/printer.b
+++ b/impls/bcpl/printer.b
@@ -93,12 +93,37 @@ AND print_vec(vec, buf, pos, count_only) = VALOF
   RESULTIS print_char(']', buf, pos, count_only)
 }
 
+AND print_hmx_internal(map, buf, pos, count_only) = VALOF
+{ pos := print_form(map!hmx_key, buf, pos, count_only)
+  pos := print_char(' ', buf, pos, count_only)
+  RESULTIS print_form(map!hmx_value, buf, pos, count_only)
+}
+
+AND print_hmi_internal(map, buf, pos, count_only) = VALOF
+{ pos := print_hm_internal(map!hmi_left, buf, pos, count_only)
+  pos := print_char(' ', buf, pos, count_only)
+  RESULTIS print_hm_internal(map!hmi_right, buf, pos, count_only)
+}
+
+AND print_hm_internal(map, buf, pos, count_only) =
+  type OF map = t_hmi -> print_hmi_internal(map, buf, pos, count_only),
+                         print_hmx_internal(map, buf, pos, count_only)
+
+AND print_hm(map, buf, pos, count_only) = VALOF
+{ pos := print_char('{', buf, pos, count_only)
+  pos := print_hm_internal(map, buf, pos, count_only)
+  RESULTIS print_char('}', buf, pos, count_only)
+}
+
 AND print_form(val, buf, pos, count_only) = VALOF
   SWITCHON type OF val INTO
   {
     CASE t_nil: RESULTIS print_const("nil", buf, pos, count_only)
     CASE t_lst: RESULTIS print_lst(val, buf, pos, count_only)
     CASE t_vec: RESULTIS print_vec(val, buf, pos, count_only)
+    CASE t_hm0: RESULTIS print_const("{}", buf, pos, count_only)
+    CASE t_hmi:
+    CASE t_hmx: RESULTIS print_hm (val, buf, pos, count_only)
     CASE t_int: RESULTIS print_int(val, buf, pos, count_only)
     CASE t_str: RESULTIS print_str(val, buf, pos, count_only)
     CASE t_sym: RESULTIS print_sym(val, buf, pos, count_only)
diff --git a/impls/bcpl/reader.b b/impls/bcpl/reader.b
index b3d38df74a..7d4596b5f0 100644
--- a/impls/bcpl/reader.b
+++ b/impls/bcpl/reader.b
@@ -161,6 +161,20 @@ AND read_vec_tail(rdr, len) = VALOF
     RESULTIS vec
   }
 
+AND read_hm(rdr) = VALOF
+{ LET map = empty_hashmap
+  reader_next(rdr) // Skip leading '{'
+  { LET key, value = ?, ?
+    IF (reader_peek(rdr) + str_data)%1 = '}' THEN { reader_next(rdr); BREAK }
+    key := read_form(rdr)
+    IF (reader_peek(rdr) + str_data)%1 = '}' THEN
+      throw(str_bcpl2mal("odd number of elements in literal hash-map"))
+    value := read_form(rdr)
+    map := hm_set(map, key, value)
+  } REPEAT
+  RESULTIS map
+}
+
 AND read_macro(rdr, name) = VALOF
 { LET first, rest = as_sym(str_bcpl2mal(name)), ?
   reader_next(rdr) // skip macro character
@@ -177,6 +191,8 @@ AND read_form(rdr) = VALOF
     CASE ')': throw(str_bcpl2mal("unbalanced parentheses"))
     CASE '[': RESULTIS read_vec(rdr)
     CASE ']': throw(str_bcpl2mal("unbalanced brackets"))
+    CASE '{': RESULTIS read_hm(rdr)
+    CASE '}': throw(str_bcpl2mal("unbalanced braces"))
     CASE '*'': RESULTIS read_macro(rdr, "quote")
     CASE '`': RESULTIS read_macro(rdr, "quasiquote")
     CASE '~':

From 53f3591a6a2a6328f6c05f90a1fcbf1a6ba66f40 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sun, 7 Jul 2019 22:20:29 +0100
Subject: [PATCH 026/148] bcpl: Sort hash-map keys slightly more sensibly.

---
 impls/bcpl/types.b | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index cbf656ee1b..06a54ad464 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -131,7 +131,7 @@ LET alloc_hmi(critbit, left, right) = VALOF
 
 LET key_bit(key, bit) = VALOF
 { LET offset, shift = bit / BITSPERBCPLWORD, bit REM BITSPERBCPLWORD
-  RESULTIS key!offset >> shift & 1
+  RESULTIS key!offset >> (BITSPERBCPLWORD - 1 - shift) & 1
 }
 
 LET key_bitdiff(key1, key2) = VALOF

From 294b1974b1e0d9d7c965655f9ca3773f4871d66a Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 9 Jul 2019 00:10:34 +0100
Subject: [PATCH 027/148] bcpl: Minor cleanups and tightening of hash-map code.

---
 impls/bcpl/types.b | 37 +++++++++++++------------------------
 1 file changed, 13 insertions(+), 24 deletions(-)

diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index 06a54ad464..c1dd803e65 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -144,10 +144,7 @@ LET key_bitdiff(key1, key2) = VALOF
 // the key requested, and returns the entire entry.
 LET hm_find(map, key) = VALOF
 { WHILE type OF map = t_hmi DO
-    TEST key_bit(key, hmi_critbit OF map) THEN
-      map := map!hmi_right
-    ELSE
-      map := map!hmi_left
+    map := key_bit(key, hmi_critbit OF map) -> map!hmi_right, map!hmi_left
   RESULTIS map
 }
 
@@ -155,13 +152,11 @@ LET hm_find(map, key) = VALOF
 LET hm_replace(map, key, value) = VALOF
 { LET left, right = ?, ?
   IF type OF map = t_hmx RESULTIS alloc_hmx(key, value)
+  left, right := map!hmi_left, map!hmi_right
   TEST key_bit(key, hmi_critbit OF map) THEN
-  { left := map!hmi_left
     right := hm_replace(map!hmi_right, key, value)
-  } ELSE
-  { left := hm_replace(map!hmi_left, key, value)
-    right := map!hmi_right
-  }
+  ELSE
+    left := hm_replace(map!hmi_left, key, value)
   RESULTIS alloc_hmi(hmi_critbit OF map, left, right)
 }
 
@@ -170,19 +165,15 @@ LET hm_replace(map, key, value) = VALOF
 LET hm_insert(map, bit, key, value) = VALOF
 { LET left, right = ?, ?
   IF type OF map = t_hmi & hmi_critbit OF map < bit THEN
-  { TEST key_bit(key,  hmi_critbit OF map) THEN
-    { left  := hmi_left OF map
-      right := hm_insert(hmi_right OF map, bit, key, value)
-    } ELSE
-    { left  := hm_insert(hmi_left OF map, bit, key, value)
-      right := hmi_right OF map
-    }
+  { left, right := map!hmi_left, map!hmi_right
+    TEST key_bit(key,  hmi_critbit OF map) THEN
+      right := hm_insert(map!hmi_right, bit, key, value)
+    ELSE
+      left  := hm_insert(map!hmi_left, bit, key, value)
     RESULTIS alloc_hmi(hmi_critbit OF map, left, right)
   }
-  TEST key_bit(key, bit) THEN
-    left, right := map, alloc_hmx(key, value)
-  ELSE
-    right, left := map, alloc_hmx(key, value)
+  TEST key_bit(key, bit) THEN left, right := map, alloc_hmx(key, value)
+                         ELSE right, left := map, alloc_hmx(key, value)
   RESULTIS alloc_hmi(bit, left, right)
 }
 
@@ -213,15 +204,13 @@ LET hm_remove(map, key) = VALOF
 LET hm_get(map, key) = VALOF
 { IF map = empty_hashmap RESULTIS nil
   map := hm_find(map, key)
-  IF equal(map!hmx_key, key) RESULTIS map!hmx_value
-  RESULTIS nil
+  RESULTIS equal(map!hmx_key, key) -> map!hmx_value, nil
 }
 
 LET hm_contains(map, key) = VALOF
 { IF map = empty_hashmap RESULTIS FALSE
   map := hm_find(map, key)
-  IF equal(map!hmx_key, key) RESULTIS TRUE
-  RESULTIS FALSE
+  RESULTIS equal(map!hmx_key, key)
 }
 
 LET throw(val) BE

From 295f2768469d22507acaa7fce1369f7de71be4c8 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 9 Jul 2019 00:17:18 +0100
Subject: [PATCH 028/148] bcpl: with-meta support for reader.

---
 impls/bcpl/reader.b | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/impls/bcpl/reader.b b/impls/bcpl/reader.b
index 7d4596b5f0..b555c2297b 100644
--- a/impls/bcpl/reader.b
+++ b/impls/bcpl/reader.b
@@ -182,6 +182,14 @@ AND read_macro(rdr, name) = VALOF
   RESULTIS cons(first, rest)
 }
 
+AND read_with_meta(rdr) = VALOF
+{ LET rest = ?
+  reader_next(rdr) // skip '^'
+  rest := cons(read_form(rdr), empty)
+  rest := cons(read_form(rdr), rest)
+  RESULTIS cons(as_sym(str_bcpl2mal("with-meta")), rest)
+}
+
 AND read_form(rdr) = VALOF
 { LET token = reader_peek(rdr)
   UNLESS type OF token = t_str DO
@@ -199,6 +207,7 @@ AND read_form(rdr) = VALOF
       IF token!str_len = 2 THEN RESULTIS read_macro(rdr, "splice-unquote")
       RESULTIS read_macro(rdr, "unquote")
     CASE '@': RESULTIS read_macro(rdr, "deref")
+    CASE '^': RESULTIS read_with_meta(rdr)
     DEFAULT: RESULTIS read_atom(rdr)
   }
 }

From 5861d8dbce8f49945acdb2738ae89c251ce398eb Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 9 Jul 2019 00:39:53 +0100
Subject: [PATCH 029/148] bcpl: Support for evaluating hash-maps.

---
 impls/bcpl/step2_eval.b | 5 +++++
 impls/bcpl/step3_env.b  | 5 +++++
 2 files changed, 10 insertions(+)

diff --git a/impls/bcpl/step2_eval.b b/impls/bcpl/step2_eval.b
index 5ff7e7a9ce..fe0a310c4b 100644
--- a/impls/bcpl/step2_eval.b
+++ b/impls/bcpl/step2_eval.b
@@ -20,6 +20,11 @@ LET eval_ast(ast, env) = VALOF
 	  (new + vec_data)!i := EVAL((ast + vec_data)!i, env)
 	RESULTIS new
       }
+    CASE t_hmx:
+      RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env))
+    CASE t_hmi:
+      RESULTIS alloc_hmi(hmi_critbit OF ast, eval_ast(ast!hmi_left, env),
+                                             eval_ast(ast!hmi_right, env))
     DEFAULT: RESULTIS ast
   }
 
diff --git a/impls/bcpl/step3_env.b b/impls/bcpl/step3_env.b
index 4cc856677f..5ee2978b8d 100644
--- a/impls/bcpl/step3_env.b
+++ b/impls/bcpl/step3_env.b
@@ -30,6 +30,11 @@ LET eval_ast(ast, env) = VALOF
 	  (new + vec_data)!i := EVAL((ast + vec_data)!i, env)
 	RESULTIS new
       }
+    CASE t_hmx:
+      RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env))
+    CASE t_hmi:
+      RESULTIS alloc_hmi(hmi_critbit OF ast, eval_ast(ast!hmi_left, env),
+                                             eval_ast(ast!hmi_right, env))
     DEFAULT: RESULTIS ast
   }
 

From 92362cb476bdd7f99054b72750eddd8242a84e29 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 9 Jul 2019 00:46:30 +0100
Subject: [PATCH 030/148] bcpl: Better naming of hash-map-printing functions.

---
 impls/bcpl/printer.b | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/impls/bcpl/printer.b b/impls/bcpl/printer.b
index 7a851e4aa6..6d4ee78b2a 100644
--- a/impls/bcpl/printer.b
+++ b/impls/bcpl/printer.b
@@ -93,25 +93,25 @@ AND print_vec(vec, buf, pos, count_only) = VALOF
   RESULTIS print_char(']', buf, pos, count_only)
 }
 
-AND print_hmx_internal(map, buf, pos, count_only) = VALOF
+AND print_hmx_contents(map, buf, pos, count_only) = VALOF
 { pos := print_form(map!hmx_key, buf, pos, count_only)
   pos := print_char(' ', buf, pos, count_only)
   RESULTIS print_form(map!hmx_value, buf, pos, count_only)
 }
 
-AND print_hmi_internal(map, buf, pos, count_only) = VALOF
-{ pos := print_hm_internal(map!hmi_left, buf, pos, count_only)
+AND print_hmi_contents(map, buf, pos, count_only) = VALOF
+{ pos := print_hm_contents(map!hmi_left, buf, pos, count_only)
   pos := print_char(' ', buf, pos, count_only)
-  RESULTIS print_hm_internal(map!hmi_right, buf, pos, count_only)
+  RESULTIS print_hm_contents(map!hmi_right, buf, pos, count_only)
 }
 
-AND print_hm_internal(map, buf, pos, count_only) =
-  type OF map = t_hmi -> print_hmi_internal(map, buf, pos, count_only),
-                         print_hmx_internal(map, buf, pos, count_only)
+AND print_hm_contents(map, buf, pos, count_only) =
+  type OF map = t_hmi -> print_hmi_contents(map, buf, pos, count_only),
+                         print_hmx_contents(map, buf, pos, count_only)
 
 AND print_hm(map, buf, pos, count_only) = VALOF
 { pos := print_char('{', buf, pos, count_only)
-  pos := print_hm_internal(map, buf, pos, count_only)
+  pos := print_hm_contents(map, buf, pos, count_only)
   RESULTIS print_char('}', buf, pos, count_only)
 }
 

From 6934c973b54602fb1bfdad9d1000ed73a27d19a1 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 9 Jul 2019 11:16:31 +0100
Subject: [PATCH 031/148] bcpl: Add symbol name to the "not found" error
 message to satisfy tests.

In the process, add a slightly general routine for formatting error
messages.
---
 impls/bcpl/env.b     |  2 +-
 impls/bcpl/malhdr.h  |  2 +-
 impls/bcpl/printer.b | 20 ++++++++++++++++++++
 3 files changed, 22 insertions(+), 2 deletions(-)

diff --git a/impls/bcpl/env.b b/impls/bcpl/env.b
index 97eaa1a71b..7668814ca9 100644
--- a/impls/bcpl/env.b
+++ b/impls/bcpl/env.b
@@ -22,6 +22,6 @@ LET env_find(env, key) = VALOF
 
 LET env_get(env, key) = VALOF
 { env := env_find(env, key)
-  IF env = nil THEN throw(str_bcpl2mal("not found"))
+  IF env = nil THEN throwf("symbol %v not found", key)
   RESULTIS hm_get(env!env_data, key)
 }
diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index 053dbb55cb..567f141041 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -1,5 +1,5 @@
 GLOBAL { readline: ug
-         pr_str
+         pr_str; throwf
          read_str
          init_types; nil; empty; cons; nth; as_lst
 	 alloc_int
diff --git a/impls/bcpl/printer.b b/impls/bcpl/printer.b
index 6d4ee78b2a..ba4999587c 100644
--- a/impls/bcpl/printer.b
+++ b/impls/bcpl/printer.b
@@ -137,3 +137,23 @@ LET pr_str(x) = VALOF
   str_setlen(out, count)
   RESULTIS out
 }
+
+LET print_f(msg, buf, pos, count_only, A) = VALOF
+{ FOR i = 1 TO msg%0 DO
+  { IF msg%i = '%' & i < msg%0 THEN SWITCHON msg%(i + 1) INTO
+      { CASE 'v':
+          pos := print_form(A, buf, pos, count_only)
+	  i := i + 1; LOOP
+      }
+    pos := print_char(msg%i, buf, pos, count_only)
+  }
+  RESULTIS pos
+}
+
+LET throwf(msg, A) BE
+{ LET count = print_f(msg, 0, 0, TRUE, A)
+  LET out = alloc_str(count)
+  print_f(msg, out+str_data, 1, FALSE, A)
+  str_setlen(out, count)
+  throw(out)
+}
\ No newline at end of file

From 8bd49132f3579536a019ec2519e8fdfad6418d3b Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 9 Jul 2019 11:22:51 +0100
Subject: [PATCH 032/148] bcpl: Use throwf() for all exceptions generated by
 mal.

This requires a tiny dummy throwf() implementation in step 0, since
th real throwf() requires the printer.
---
 impls/bcpl/step0_repl.b | 3 +++
 impls/bcpl/step2_eval.b | 2 +-
 impls/bcpl/step3_env.b  | 2 +-
 impls/bcpl/types.b      | 6 +++---
 4 files changed, 8 insertions(+), 5 deletions(-)

diff --git a/impls/bcpl/step0_repl.b b/impls/bcpl/step0_repl.b
index 06ec58fbdc..e67d323e4a 100644
--- a/impls/bcpl/step0_repl.b
+++ b/impls/bcpl/step0_repl.b
@@ -28,3 +28,6 @@ LET start() = VALOF
   repl()
   RESULTIS 0
 }
+
+// Dummy version of throwf() because step 0 doesn't include printer.b
+LET throwf(msg, A) BE throw(str_bcpl2mal(msg))
diff --git a/impls/bcpl/step2_eval.b b/impls/bcpl/step2_eval.b
index fe0a310c4b..e94e0f0b53 100644
--- a/impls/bcpl/step2_eval.b
+++ b/impls/bcpl/step2_eval.b
@@ -33,7 +33,7 @@ AND EVAL(ast, env) = VALOF
   IF ast = empty RESULTIS ast
   ast := eval_ast(ast, env)
   { LET fn, a, b = ast!lst_first, nth(ast, 1), nth(ast, 2)
-    UNLESS type OF fn = t_cfn DO throw(str_bcpl2mal("not a function"))
+    UNLESS type OF fn = t_cfn DO throwf("not a function")
     RESULTIS (fn!cfn_fn)(a, b)
   }
 }
diff --git a/impls/bcpl/step3_env.b b/impls/bcpl/step3_env.b
index 5ee2978b8d..1abab5d20a 100644
--- a/impls/bcpl/step3_env.b
+++ b/impls/bcpl/step3_env.b
@@ -58,7 +58,7 @@ AND EVAL(ast, env) = VALOF
   }
   ast := eval_ast(ast, env)
   { LET fn, a, b = ast!lst_first, nth(ast, 1), nth(ast, 2)
-    UNLESS type OF fn = t_cfn DO throw(str_bcpl2mal("not a function"))
+    UNLESS type OF fn = t_cfn DO throwf("not a function")
     RESULTIS (fn!cfn_fn)(a, b)
   }
 }
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index c1dd803e65..6f70f3d7e7 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -19,7 +19,7 @@ LET cons(first, rest) = VALOF
 
 LET nth(lst, n) = VALOF
 { UNTIL n = 0 DO lst, n := lst!lst_rest, n - 1
-  IF lst = empty THEN throw(str_bcpl2mal("subscript out of range"))
+  IF lst = empty THEN throwf("subscript out of range")
   RESULTIS lst!lst_first
 }
 
@@ -32,7 +32,7 @@ LET as_lst(x) = VALOF SWITCHON type OF x INTO
       RESULTIS l
     }
   DEFAULT:
-    throw(str_bcpl2mal("cannot convert to list"))
+    throwf("cannot convert to list")
 }
   
 
@@ -86,7 +86,7 @@ LET equal(a, b) = VALOF
     CASE t_int: RESULTIS int_sz
     CASE t_str: RESULTIS str_data + 1 + a!str_len / bytesperword
     CASE t_cfn: RESULTIS cfn_sz
-    DEFAULT: throw(str_bcpl2mal("incomparable value"))
+    DEFAULT: throwf("incomparable value")
   }
   // This is guaranteed not to walk off the end of b because any two mal
   // values with different lengths will differ before the point where

From 03acbd3bcdc8a8f5c43a6436341c951a68b3a72a Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 9 Jul 2019 11:40:08 +0100
Subject: [PATCH 033/148] bcpl: Start of step 4: Add 'binds' and 'exprs'
 arguments to env_new().

---
 impls/bcpl/env.b       | 12 ++++++++----
 impls/bcpl/step3_env.b |  4 ++--
 2 files changed, 10 insertions(+), 6 deletions(-)

diff --git a/impls/bcpl/env.b b/impls/bcpl/env.b
index 7668814ca9..99a23347bd 100644
--- a/impls/bcpl/env.b
+++ b/impls/bcpl/env.b
@@ -4,16 +4,20 @@ GET "malhdr"
 MANIFEST
 { env_outer = 0; env_data; env_sz }
 
-LET env_new(outer) = VALOF
+LET env_set(env, key, value) BE
+  env!env_data := hm_set(env!env_data, key, value)
+
+LET env_new(outer, binds, exprs) = VALOF
 { LET env = getvec(env_sz)
   env!env_outer := outer
   env!env_data := empty_hashmap
+  UNTIL binds = empty | exprs = empty DO
+  { env_set(env, binds!lst_first, exprs!lst_first)
+    binds, exprs := binds!lst_rest, exprs!lst_rest
+  }
   RESULTIS env
 }
 
-LET env_set(env, key, value) BE
-  env!env_data := hm_set(env!env_data, key, value)
-
 LET env_find(env, key) = VALOF
 { IF hm_contains(env!env_data, key) THEN RESULTIS env
   UNLESS env!env_outer = nil RESULTIS env_find(env!env_outer, key)
diff --git a/impls/bcpl/step3_env.b b/impls/bcpl/step3_env.b
index 1abab5d20a..5e59245a42 100644
--- a/impls/bcpl/step3_env.b
+++ b/impls/bcpl/step3_env.b
@@ -48,7 +48,7 @@ AND EVAL(ast, env) = VALOF
       RESULTIS val
     }
     IF is_sym(fn, "let**") THEN
-    { LET newenv, bindings = env_new(env), as_lst(nth(ast, 1))
+    { LET newenv, bindings = env_new(env, empty, empty), as_lst(nth(ast, 1))
       UNTIL bindings = empty DO
       { env_set(newenv, bindings!lst_first, EVAL(nth(bindings, 1), newenv))
         bindings := bindings!lst_rest!lst_rest
@@ -83,7 +83,7 @@ LET rep(x, env) = PRINT(EVAL(READ(x), env))
 
 LET repl() BE
 { LET prompt = str_bcpl2mal("user> ")
-  LET repl_env = env_new(nil)
+  LET repl_env = env_new(nil, empty, empty)
   env_set(repl_env, as_sym(str_bcpl2mal("+")), add)
   env_set(repl_env, as_sym(str_bcpl2mal("-")), subtract)
   env_set(repl_env, as_sym(str_bcpl2mal("**")), multiply)

From 76fc3eb957a7a28cbe84c5462e4d4f3998b1cf85 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 9 Jul 2019 20:49:17 +0100
Subject: [PATCH 034/148] bcpl: Add main file and Makefile machinery for step
 4.

---
 impls/bcpl/Makefile         |   5 +-
 impls/bcpl/step4_if_fn_do.b | 113 ++++++++++++++++++++++++++++++++++++
 2 files changed, 116 insertions(+), 2 deletions(-)
 create mode 100644 impls/bcpl/step4_if_fn_do.b

diff --git a/impls/bcpl/Makefile b/impls/bcpl/Makefile
index 6b82081cb4..46f74328d7 100644
--- a/impls/bcpl/Makefile
+++ b/impls/bcpl/Makefile
@@ -1,4 +1,4 @@
-all: step0_repl step1_read_print step2_eval
+all: step0_repl step1_read_print step2_eval step3_env step4_if_fn_do
 
 %: %.b malhdr.h
 	cintsys -c "bcpl $< to $@"
@@ -9,6 +9,7 @@ step0_repl: readline.b types.b
 step1_read_print: printer.b reader.b readline.b types.b
 step2_eval: printer.b reader.b readline.b types.b
 step3_env: env.b printer.b reader.b readline.b types.b
+step4_if_fn_do: env.b printer.b reader.b readline.b types.b
 
 clean:
-	rm step0_repl step1_read_print
+	rm step0_repl step1_read_print step2_eval step3_env step4_if_fn_do
diff --git a/impls/bcpl/step4_if_fn_do.b b/impls/bcpl/step4_if_fn_do.b
new file mode 100644
index 0000000000..5e59245a42
--- /dev/null
+++ b/impls/bcpl/step4_if_fn_do.b
@@ -0,0 +1,113 @@
+GET "libhdr"
+GET "malhdr"
+
+GET "env.b"
+GET "printer.b"
+GET "reader.b"
+GET "readline.b"
+GET "types.b"
+
+LET READ(x) = read_str(x)
+
+// Helper function for EVAL.
+LET is_sym(a, b) = VALOF
+{ UNLESS type OF a = t_sym RESULTIS FALSE
+  UNLESS a!str_len = b%0 RESULTIS FALSE
+  FOR i = 0 TO a!str_len / bytesperword DO
+    UNLESS (a+str_data)!i = b!i RESULTIS FALSE
+  RESULTIS TRUE
+}
+
+LET eval_ast(ast, env) = VALOF
+  SWITCHON type OF ast INTO
+  { CASE t_sym: RESULTIS env_get(env, ast)
+    CASE t_lst:
+      TEST ast = empty THEN RESULTIS empty
+      ELSE RESULTIS cons(EVAL(ast!lst_first, env), eval_ast(ast!lst_rest, env))
+    CASE t_vec:
+      { LET new = alloc_vec(ast!vec_len)
+        FOR i = 0 TO ast!vec_len - 1 DO
+	  (new + vec_data)!i := EVAL((ast + vec_data)!i, env)
+	RESULTIS new
+      }
+    CASE t_hmx:
+      RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env))
+    CASE t_hmi:
+      RESULTIS alloc_hmi(hmi_critbit OF ast, eval_ast(ast!hmi_left, env),
+                                             eval_ast(ast!hmi_right, env))
+    DEFAULT: RESULTIS ast
+  }
+
+AND EVAL(ast, env) = VALOF
+{ UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env)
+  IF ast = empty RESULTIS ast
+  { LET fn = ast!lst_first
+    IF is_sym(fn, "def!") THEN
+    { LET val = EVAL(nth(ast, 2), env)
+      env_set(env, nth(ast, 1), val, env)
+      RESULTIS val
+    }
+    IF is_sym(fn, "let**") THEN
+    { LET newenv, bindings = env_new(env, empty, empty), as_lst(nth(ast, 1))
+      UNTIL bindings = empty DO
+      { env_set(newenv, bindings!lst_first, EVAL(nth(bindings, 1), newenv))
+        bindings := bindings!lst_rest!lst_rest
+      }
+      RESULTIS EVAL(nth(ast, 2), newenv)
+    }
+  }
+  ast := eval_ast(ast, env)
+  { LET fn, a, b = ast!lst_first, nth(ast, 1), nth(ast, 2)
+    UNLESS type OF fn = t_cfn DO throwf("not a function")
+    RESULTIS (fn!cfn_fn)(a, b)
+  }
+}
+
+LET PRINT(x) = pr_str(x)
+
+LET add_fn(a, b)      = alloc_int(a!int_value + b!int_value)
+LET subtract_fn(a, b) = alloc_int(a!int_value - b!int_value)
+LET multiply_fn(a, b) = alloc_int(a!int_value * b!int_value)
+LET divide_fn(a, b)   = alloc_int(a!int_value / b!int_value)
+
+STATIC { add; subtract; multiply; divide }
+
+LET init_core() BE
+{ add      := alloc_cfn(add_fn)
+  subtract := alloc_cfn(subtract_fn)
+  multiply := alloc_cfn(multiply_fn)
+  divide   := alloc_cfn(divide_fn)
+}
+
+LET rep(x, env) = PRINT(EVAL(READ(x), env))
+
+LET repl() BE
+{ LET prompt = str_bcpl2mal("user> ")
+  LET repl_env = env_new(nil, empty, empty)
+  env_set(repl_env, as_sym(str_bcpl2mal("+")), add)
+  env_set(repl_env, as_sym(str_bcpl2mal("-")), subtract)
+  env_set(repl_env, as_sym(str_bcpl2mal("**")), multiply)
+  env_set(repl_env, as_sym(str_bcpl2mal("/")), divide)
+  catch_level, catch_label := level(), uncaught
+  IF FALSE THEN
+  { uncaught:
+    writes("Uncaught exception: ")
+    writes(@(pr_str(last_exception)!str_data))
+    newline()
+  }
+  { LET line = readline(prompt)
+    IF line = nil THEN BREAK
+    writes(@rep(line, repl_env)!str_data)
+    newline()
+  } REPEAT
+}
+
+LET start() = VALOF
+{ LET ch = 0
+  init_types()
+  init_core()
+  ch := rdch() REPEATUNTIL ch = '*n' // Consume command-line args
+  wrch('*n') // Terminate prompt printed by Cintsys
+  repl()
+  RESULTIS 0
+}

From 5f8b28a52abefad59a08790cd9b405302650c675 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 9 Jul 2019 20:49:58 +0100
Subject: [PATCH 035/148] bcpl: Add print syntax for functions.

---
 impls/bcpl/printer.b | 1 +
 1 file changed, 1 insertion(+)

diff --git a/impls/bcpl/printer.b b/impls/bcpl/printer.b
index ba4999587c..236498c082 100644
--- a/impls/bcpl/printer.b
+++ b/impls/bcpl/printer.b
@@ -127,6 +127,7 @@ AND print_form(val, buf, pos, count_only) = VALOF
     CASE t_int: RESULTIS print_int(val, buf, pos, count_only)
     CASE t_str: RESULTIS print_str(val, buf, pos, count_only)
     CASE t_sym: RESULTIS print_sym(val, buf, pos, count_only)
+    CASE t_cfn: RESULTIS print_const("#<function>", buf, pos, count_only)
     DEFAULT: RESULTIS print_const("<unprintable>", buf, pos, count_only)
   }
 

From d064c01a79dc0f0892905ad88601314f4dc4471e Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Wed, 10 Jul 2019 12:50:53 +0100
Subject: [PATCH 036/148] bcpl: Add boolean type and read/print of nil, true,
 and false.

---
 impls/bcpl/malhdr.h         | 11 +++++++----
 impls/bcpl/printer.b        |  2 ++
 impls/bcpl/reader.b         |  3 +++
 impls/bcpl/step3_env.b      |  5 +----
 impls/bcpl/step4_if_fn_do.b |  5 +----
 impls/bcpl/types.b          |  9 +++++++++
 6 files changed, 23 insertions(+), 12 deletions(-)

diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index 567f141041..95ad7ee8fb 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -1,13 +1,13 @@
 GLOBAL { readline: ug
          pr_str; throwf
          read_str
-         init_types; nil; empty; cons; nth; as_lst
+         init_types; nil; empty; empty_hashmap; mtrue; mfalse
+	 cons; nth; as_lst
 	 alloc_int
-	 str_setlen; alloc_str; str_bcpl2mal; as_sym
+	 str_setlen; alloc_str; str_bcpl2mal; as_sym; str_eq_const
 	 hm_set; hm_contains; hm_get
 	 alloc_vec
 	 alloc_cfn
-	 empty_hashmap
 	 throw
 	 catch_level; catch_label; last_exception
 	 init_core
@@ -32,7 +32,10 @@ MANIFEST
 
   // Integers.
   t_int = #x01; int_value = 1; int_sz = 2
-					       
+
+  // Booleans.
+  t_boo = #x11
+
   // Strings.  Unlike conventional BCPL strings, these have an entire word
   // to store the length.  For compatibility with library routines, the
   // first byte of the string is also the length if it will fit.
diff --git a/impls/bcpl/printer.b b/impls/bcpl/printer.b
index 236498c082..849c168e77 100644
--- a/impls/bcpl/printer.b
+++ b/impls/bcpl/printer.b
@@ -119,6 +119,8 @@ AND print_form(val, buf, pos, count_only) = VALOF
   SWITCHON type OF val INTO
   {
     CASE t_nil: RESULTIS print_const("nil", buf, pos, count_only)
+    CASE t_boo: RESULTIS print_const(val!int_value -> "true", "false",
+                                     buf, pos, count_only)
     CASE t_lst: RESULTIS print_lst(val, buf, pos, count_only)
     CASE t_vec: RESULTIS print_vec(val, buf, pos, count_only)
     CASE t_hm0: RESULTIS print_const("{}", buf, pos, count_only)
diff --git a/impls/bcpl/reader.b b/impls/bcpl/reader.b
index b555c2297b..d6194d09eb 100644
--- a/impls/bcpl/reader.b
+++ b/impls/bcpl/reader.b
@@ -127,6 +127,9 @@ LET read_atom(rdr) = VALOF
   IF (token + str_data)%1 = '*"' THEN RESULTIS read_string(token)
   maybenum := read_number_maybe(token)
   UNLESS maybenum = nil RESULTIS maybenum
+  IF str_eq_const(token, "nil")   RESULTIS nil
+  IF str_eq_const(token, "true")  RESULTIS mtrue
+  IF str_eq_const(token, "false") RESULTIS mfalse
   RESULTIS as_sym(token)
 }
 
diff --git a/impls/bcpl/step3_env.b b/impls/bcpl/step3_env.b
index 5e59245a42..7399cfcd45 100644
--- a/impls/bcpl/step3_env.b
+++ b/impls/bcpl/step3_env.b
@@ -12,10 +12,7 @@ LET READ(x) = read_str(x)
 // Helper function for EVAL.
 LET is_sym(a, b) = VALOF
 { UNLESS type OF a = t_sym RESULTIS FALSE
-  UNLESS a!str_len = b%0 RESULTIS FALSE
-  FOR i = 0 TO a!str_len / bytesperword DO
-    UNLESS (a+str_data)!i = b!i RESULTIS FALSE
-  RESULTIS TRUE
+  RESULTIS str_eq_const(a, b)
 }
 
 LET eval_ast(ast, env) = VALOF
diff --git a/impls/bcpl/step4_if_fn_do.b b/impls/bcpl/step4_if_fn_do.b
index 5e59245a42..7399cfcd45 100644
--- a/impls/bcpl/step4_if_fn_do.b
+++ b/impls/bcpl/step4_if_fn_do.b
@@ -12,10 +12,7 @@ LET READ(x) = read_str(x)
 // Helper function for EVAL.
 LET is_sym(a, b) = VALOF
 { UNLESS type OF a = t_sym RESULTIS FALSE
-  UNLESS a!str_len = b%0 RESULTIS FALSE
-  FOR i = 0 TO a!str_len / bytesperword DO
-    UNLESS (a+str_data)!i = b!i RESULTIS FALSE
-  RESULTIS TRUE
+  RESULTIS str_eq_const(a, b)
 }
 
 LET eval_ast(ast, env) = VALOF
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index 6f70f3d7e7..0337f17216 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -6,6 +6,8 @@ LET init_types() BE
   empty := TABLE t_lst, ?, ?
   empty!lst_first, empty!lst_rest := nil, empty
   empty_hashmap := TABLE t_hm0
+  mtrue  := TABLE t_boo, TRUE
+  mfalse := TABLE t_boo, FALSE
 }
 
 LET cons(first, rest) = VALOF
@@ -78,6 +80,13 @@ LET str_bcpl2mal(bcplstr) = VALOF
   RESULTIS result
 }
 
+LET str_eq_const(val, bcplstr) = VALOF
+{ UNLESS val!str_len = bcplstr%0 RESULTIS FALSE
+  FOR i = 0 TO bcplstr%0 / bytesperword DO
+    UNLESS val!(str_data + i) = bcplstr!i RESULTIS FALSE
+  RESULTIS TRUE
+}
+
 LET equal(a, b) = VALOF
 { LET len = ?
   UNLESS type OF a = type OF b RESULTIS FALSE

From e6ef0750a5b578776077297185fbc3853fdca1d5 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Wed, 10 Jul 2019 23:41:21 +0100
Subject: [PATCH 037/148] bcpl: Implement 'if' and 'do'.

---
 impls/bcpl/step4_if_fn_do.b | 11 +++++++++++
 1 file changed, 11 insertions(+)

diff --git a/impls/bcpl/step4_if_fn_do.b b/impls/bcpl/step4_if_fn_do.b
index 7399cfcd45..cbcba44c51 100644
--- a/impls/bcpl/step4_if_fn_do.b
+++ b/impls/bcpl/step4_if_fn_do.b
@@ -52,6 +52,17 @@ AND EVAL(ast, env) = VALOF
       }
       RESULTIS EVAL(nth(ast, 2), newenv)
     }
+    IF is_sym(fn, "do") THEN
+    { LET tail = ast!lst_rest
+      tail := eval_ast(tail, env)
+      UNTIL tail!lst_rest = empty DO tail := tail!lst_rest
+      RESULTIS tail!lst_first
+    }
+    IF is_sym(fn, "if") THEN
+    { LET cond, tail = EVAL(nth(ast, 1), env), ast!lst_rest!lst_rest
+      IF cond = nil | cond = mfalse THEN tail := tail!lst_rest
+      RESULTIS EVAL(tail!lst_first, env)
+    }
   }
   ast := eval_ast(ast, env)
   { LET fn, a, b = ast!lst_first, nth(ast, 1), nth(ast, 2)

From 152e131b58149f74afdc88a3676ff69614581f61 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Thu, 11 Jul 2019 21:32:40 +0100
Subject: [PATCH 038/148] bcpl: Start of function redesign.

A function will have a code pointer, and then other data as determined
by that code.  The existing functions are all implemented using a
wrapper, arith(), that expects to find a pointer to a two-argument
function in the next field.
---
 impls/bcpl/malhdr.h         |  9 ++++++---
 impls/bcpl/printer.b        |  2 +-
 impls/bcpl/step2_eval.b     | 29 ++++++++++++++++++-----------
 impls/bcpl/step3_env.b      | 29 ++++++++++++++++++-----------
 impls/bcpl/step4_if_fn_do.b | 29 ++++++++++++++++++-----------
 impls/bcpl/types.b          | 10 +++++-----
 6 files changed, 66 insertions(+), 42 deletions(-)

diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index 95ad7ee8fb..eca604a469 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -7,7 +7,7 @@ GLOBAL { readline: ug
 	 str_setlen; alloc_str; str_bcpl2mal; as_sym; str_eq_const
 	 hm_set; hm_contains; hm_get
 	 alloc_vec
-	 alloc_cfn
+	 alloc_fun
 	 throw
 	 catch_level; catch_label; last_exception
 	 init_core
@@ -50,8 +50,11 @@ MANIFEST
   // pointers rather than packed characters.
   t_vec = #x09; vec_len = 1; vec_data = 2
 
-  // Core functions.  Assumed to take two integer arguments.
-  t_cfn = #x03; cfn_fn = 1; cfn_sz = 2
+  // Functions.  Contains a function which gets passed a pointer to
+  // this structure and can do what it likes with it.
+  t_fun = #x03; fun_code = 1
+  // arith() expects the next word to be a function.
+  fun_wrapped = 2
 
   // Hash-maps.  These are implemented as crit-bit trees.  There are three
   // types of node: internal nodes point to two other nodes and encode a
diff --git a/impls/bcpl/printer.b b/impls/bcpl/printer.b
index 849c168e77..3360ee9297 100644
--- a/impls/bcpl/printer.b
+++ b/impls/bcpl/printer.b
@@ -129,7 +129,7 @@ AND print_form(val, buf, pos, count_only) = VALOF
     CASE t_int: RESULTIS print_int(val, buf, pos, count_only)
     CASE t_str: RESULTIS print_str(val, buf, pos, count_only)
     CASE t_sym: RESULTIS print_sym(val, buf, pos, count_only)
-    CASE t_cfn: RESULTIS print_const("#<function>", buf, pos, count_only)
+    CASE t_fun: RESULTIS print_const("#<function>", buf, pos, count_only)
     DEFAULT: RESULTIS print_const("<unprintable>", buf, pos, count_only)
   }
 
diff --git a/impls/bcpl/step2_eval.b b/impls/bcpl/step2_eval.b
index e94e0f0b53..2d969e0f45 100644
--- a/impls/bcpl/step2_eval.b
+++ b/impls/bcpl/step2_eval.b
@@ -32,26 +32,33 @@ AND EVAL(ast, env) = VALOF
 { UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env)
   IF ast = empty RESULTIS ast
   ast := eval_ast(ast, env)
-  { LET fn, a, b = ast!lst_first, nth(ast, 1), nth(ast, 2)
-    UNLESS type OF fn = t_cfn DO throwf("not a function")
-    RESULTIS (fn!cfn_fn)(a, b)
+  { LET fn, args = ast!lst_first, ast!lst_rest
+    UNLESS type OF fn = t_fun DO throwf("not a function")
+    RESULTIS (fn!fun_code)(fn, args)
   }
 }
 
 LET PRINT(x) = pr_str(x)
 
-LET add_fn(a, b)      = alloc_int(a!int_value + b!int_value)
-LET subtract_fn(a, b) = alloc_int(a!int_value - b!int_value)
-LET multiply_fn(a, b) = alloc_int(a!int_value * b!int_value)
-LET divide_fn(a, b)   = alloc_int(a!int_value / b!int_value)
+LET arith(fn, args) = VALOF
+{ LET a, b = args!lst_first, args!lst_rest!lst_first
+  UNLESS type OF a = type OF b = t_int DO
+    throwf("bad arguments for arithmetic function")
+  RESULTIS alloc_int((fn!fun_wrapped)(a!int_value, b!int_value))
+}
+
+LET add_fn(a, b)      = a + b
+LET subtract_fn(a, b) = a - b
+LET multiply_fn(a, b) = a * b
+LET divide_fn(a, b)   = a / b
 
 STATIC { add; subtract; multiply; divide }
 
 LET init_core() BE
-{ add      := alloc_cfn(add_fn)
-  subtract := alloc_cfn(subtract_fn)
-  multiply := alloc_cfn(multiply_fn)
-  divide   := alloc_cfn(divide_fn)
+{ add      := alloc_fun(arith, add_fn)
+  subtract := alloc_fun(arith, subtract_fn)
+  multiply := alloc_fun(arith, multiply_fn)
+  divide   := alloc_fun(arith, divide_fn)
 }
 
 LET repl_env(key) = VALOF
diff --git a/impls/bcpl/step3_env.b b/impls/bcpl/step3_env.b
index 7399cfcd45..53846b10cd 100644
--- a/impls/bcpl/step3_env.b
+++ b/impls/bcpl/step3_env.b
@@ -54,26 +54,33 @@ AND EVAL(ast, env) = VALOF
     }
   }
   ast := eval_ast(ast, env)
-  { LET fn, a, b = ast!lst_first, nth(ast, 1), nth(ast, 2)
-    UNLESS type OF fn = t_cfn DO throwf("not a function")
-    RESULTIS (fn!cfn_fn)(a, b)
+  { LET fn, args = ast!lst_first, ast!lst_rest
+    UNLESS type OF fn = t_fun DO throwf("not a function")
+    RESULTIS (fn!fun_code)(fn, args)
   }
 }
 
 LET PRINT(x) = pr_str(x)
 
-LET add_fn(a, b)      = alloc_int(a!int_value + b!int_value)
-LET subtract_fn(a, b) = alloc_int(a!int_value - b!int_value)
-LET multiply_fn(a, b) = alloc_int(a!int_value * b!int_value)
-LET divide_fn(a, b)   = alloc_int(a!int_value / b!int_value)
+LET arith(fn, args) = VALOF
+{ LET a, b = args!lst_first, args!lst_rest!lst_first
+  UNLESS type OF a = type OF b = t_int DO
+    throwf("bad arguments for arithmetic function")
+  RESULTIS alloc_int((fn!fun_wrapped)(a!int_value, b!int_value))
+}
+
+LET add_fn(a, b)      = a + b
+LET subtract_fn(a, b) = a - b
+LET multiply_fn(a, b) = a * b
+LET divide_fn(a, b)   = a / b
 
 STATIC { add; subtract; multiply; divide }
 
 LET init_core() BE
-{ add      := alloc_cfn(add_fn)
-  subtract := alloc_cfn(subtract_fn)
-  multiply := alloc_cfn(multiply_fn)
-  divide   := alloc_cfn(divide_fn)
+{ add      := alloc_fun(arith, add_fn)
+  subtract := alloc_fun(arith, subtract_fn)
+  multiply := alloc_fun(arith, multiply_fn)
+  divide   := alloc_fun(arith, divide_fn)
 }
 
 LET rep(x, env) = PRINT(EVAL(READ(x), env))
diff --git a/impls/bcpl/step4_if_fn_do.b b/impls/bcpl/step4_if_fn_do.b
index cbcba44c51..f63bde6c6d 100644
--- a/impls/bcpl/step4_if_fn_do.b
+++ b/impls/bcpl/step4_if_fn_do.b
@@ -65,26 +65,33 @@ AND EVAL(ast, env) = VALOF
     }
   }
   ast := eval_ast(ast, env)
-  { LET fn, a, b = ast!lst_first, nth(ast, 1), nth(ast, 2)
-    UNLESS type OF fn = t_cfn DO throwf("not a function")
-    RESULTIS (fn!cfn_fn)(a, b)
+  { LET fn, args = ast!lst_first, ast!lst_rest
+    UNLESS type OF fn = t_fun DO throwf("not a function")
+    RESULTIS (fn!fun_code)(fn, args)
   }
 }
 
 LET PRINT(x) = pr_str(x)
 
-LET add_fn(a, b)      = alloc_int(a!int_value + b!int_value)
-LET subtract_fn(a, b) = alloc_int(a!int_value - b!int_value)
-LET multiply_fn(a, b) = alloc_int(a!int_value * b!int_value)
-LET divide_fn(a, b)   = alloc_int(a!int_value / b!int_value)
+LET arith(fn, args) = VALOF
+{ LET a, b = args!lst_first, args!lst_rest!lst_first
+  UNLESS type OF a = type OF b = t_int DO
+    throwf("bad arguments for arithmetic function")
+  RESULTIS alloc_int((fn!fun_wrapped)(a!int_value, b!int_value))
+}
+
+LET add_fn(a, b)      = a + b
+LET subtract_fn(a, b) = a - b
+LET multiply_fn(a, b) = a * b
+LET divide_fn(a, b)   = a / b
 
 STATIC { add; subtract; multiply; divide }
 
 LET init_core() BE
-{ add      := alloc_cfn(add_fn)
-  subtract := alloc_cfn(subtract_fn)
-  multiply := alloc_cfn(multiply_fn)
-  divide   := alloc_cfn(divide_fn)
+{ add      := alloc_fun(arith, add_fn)
+  subtract := alloc_fun(arith, subtract_fn)
+  multiply := alloc_fun(arith, multiply_fn)
+  divide   := alloc_fun(arith, divide_fn)
 }
 
 LET rep(x, env) = PRINT(EVAL(READ(x), env))
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index 0337f17216..af88d991c1 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -94,7 +94,6 @@ LET equal(a, b) = VALOF
   { CASE t_nil: RESULTIS 1
     CASE t_int: RESULTIS int_sz
     CASE t_str: RESULTIS str_data + 1 + a!str_len / bytesperword
-    CASE t_cfn: RESULTIS cfn_sz
     DEFAULT: throwf("incomparable value")
   }
   // This is guaranteed not to walk off the end of b because any two mal
@@ -113,11 +112,12 @@ LET alloc_vec(len) = VALOF
   RESULTIS result
 }
 
-LET alloc_cfn(fn) = VALOF
-{ LET result = getvec(cfn_sz)
+LET alloc_fun(fn, wrapped) = VALOF
+{ LET result = getvec(3)
   !result := 0
-  type OF result := t_cfn
-  result!cfn_fn := fn
+  type OF result := t_fun
+  result!fun_code := fn
+  result!fun_wrapped := wrapped
   RESULTIS result
 }
 

From 02be8e804ceca1f701af7d68cc57cf069530cde6 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Fri, 12 Jul 2019 22:36:53 +0100
Subject: [PATCH 039/148] bcpl: Implement 'fn*'.

Probably not working, though.
---
 impls/bcpl/step4_if_fn_do.b | 13 +++++++++++++
 1 file changed, 13 insertions(+)

diff --git a/impls/bcpl/step4_if_fn_do.b b/impls/bcpl/step4_if_fn_do.b
index f63bde6c6d..b209288ff1 100644
--- a/impls/bcpl/step4_if_fn_do.b
+++ b/impls/bcpl/step4_if_fn_do.b
@@ -63,6 +63,19 @@ AND EVAL(ast, env) = VALOF
       IF cond = nil | cond = mfalse THEN tail := tail!lst_rest
       RESULTIS EVAL(tail!lst_first, env)
     }
+    IF is_sym(fn, "fn**") THEN
+    { MANIFEST { fun_binds = 2; fun_body = 3; fun_env = 4; fun_sz = 5 }
+      LET call(fun, args) =
+          EVAL(fun!fun_body, env_new(fun!fun_env, fun!fun_binds, args))
+      LET result = getvec(fun_sz)
+      !result := 0
+      type OF result := t_fun
+      result!fun_code := call
+      result!fun_binds := nth(ast, 1)
+      result!fun_body := nth(ast, 2)
+      result!fun_env := env
+      RESULTIS result
+    }
   }
   ast := eval_ast(ast, env)
   { LET fn, args = ast!lst_first, ast!lst_rest

From 8be3d76108f324cefbce34e7464e879ba76a9a1d Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Fri, 12 Jul 2019 23:25:48 +0100
Subject: [PATCH 040/148] bcpl: More function reworking: arithmetic functions
 no longer special.

---
 impls/bcpl/malhdr.h         |  2 --
 impls/bcpl/step2_eval.b     | 31 +++++++++++++++----------------
 impls/bcpl/step3_env.b      | 31 +++++++++++++++----------------
 impls/bcpl/step4_if_fn_do.b | 36 ++++++++++++++++--------------------
 impls/bcpl/types.b          |  5 ++---
 5 files changed, 48 insertions(+), 57 deletions(-)

diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index eca604a469..7b3fccbc3b 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -53,8 +53,6 @@ MANIFEST
   // Functions.  Contains a function which gets passed a pointer to
   // this structure and can do what it likes with it.
   t_fun = #x03; fun_code = 1
-  // arith() expects the next word to be a function.
-  fun_wrapped = 2
 
   // Hash-maps.  These are implemented as crit-bit trees.  There are three
   // types of node: internal nodes point to two other nodes and encode a
diff --git a/impls/bcpl/step2_eval.b b/impls/bcpl/step2_eval.b
index 2d969e0f45..16fbd28ffa 100644
--- a/impls/bcpl/step2_eval.b
+++ b/impls/bcpl/step2_eval.b
@@ -40,25 +40,24 @@ AND EVAL(ast, env) = VALOF
 
 LET PRINT(x) = pr_str(x)
 
-LET arith(fn, args) = VALOF
-{ LET a, b = args!lst_first, args!lst_rest!lst_first
-  UNLESS type OF a = type OF b = t_int DO
-    throwf("bad arguments for arithmetic function")
-  RESULTIS alloc_int((fn!fun_wrapped)(a!int_value, b!int_value))
-}
-
-LET add_fn(a, b)      = a + b
-LET subtract_fn(a, b) = a - b
-LET multiply_fn(a, b) = a * b
-LET divide_fn(a, b)   = a / b
-
 STATIC { add; subtract; multiply; divide }
 
 LET init_core() BE
-{ add      := alloc_fun(arith, add_fn)
-  subtract := alloc_fun(arith, subtract_fn)
-  multiply := alloc_fun(arith, multiply_fn)
-  divide   := alloc_fun(arith, divide_fn)
+{ MANIFEST { fun_wrapped = 2; fun_sz = 3 }
+  LET arith(fn, args) = VALOF
+  { LET a, b = args!lst_first, args!lst_rest!lst_first
+    UNLESS type OF a = type OF b = t_int DO
+      throwf("bad arguments for arithmetic function")
+    RESULTIS alloc_int((fn!fun_wrapped)(a!int_value, b!int_value))
+  }
+  LET add_fn(a, b)      = a + b
+  LET subtract_fn(a, b) = a - b
+  LET multiply_fn(a, b) = a * b
+  LET divide_fn(a, b)   = a / b
+  add      := alloc_fun(arith, fun_sz); add!fun_wrapped := add_fn
+  subtract := alloc_fun(arith, fun_sz); subtract!fun_wrapped := subtract_fn
+  multiply := alloc_fun(arith, fun_sz); multiply!fun_wrapped := multiply_fn
+  divide   := alloc_fun(arith, fun_sz); divide!fun_wrapped := divide_fn
 }
 
 LET repl_env(key) = VALOF
diff --git a/impls/bcpl/step3_env.b b/impls/bcpl/step3_env.b
index 53846b10cd..5d3f4762dd 100644
--- a/impls/bcpl/step3_env.b
+++ b/impls/bcpl/step3_env.b
@@ -62,25 +62,24 @@ AND EVAL(ast, env) = VALOF
 
 LET PRINT(x) = pr_str(x)
 
-LET arith(fn, args) = VALOF
-{ LET a, b = args!lst_first, args!lst_rest!lst_first
-  UNLESS type OF a = type OF b = t_int DO
-    throwf("bad arguments for arithmetic function")
-  RESULTIS alloc_int((fn!fun_wrapped)(a!int_value, b!int_value))
-}
-
-LET add_fn(a, b)      = a + b
-LET subtract_fn(a, b) = a - b
-LET multiply_fn(a, b) = a * b
-LET divide_fn(a, b)   = a / b
-
 STATIC { add; subtract; multiply; divide }
 
 LET init_core() BE
-{ add      := alloc_fun(arith, add_fn)
-  subtract := alloc_fun(arith, subtract_fn)
-  multiply := alloc_fun(arith, multiply_fn)
-  divide   := alloc_fun(arith, divide_fn)
+{ MANIFEST { fun_wrapped = 2; fun_sz = 3 }
+  LET arith(fn, args) = VALOF
+  { LET a, b = args!lst_first, args!lst_rest!lst_first
+    UNLESS type OF a = type OF b = t_int DO
+      throwf("bad arguments for arithmetic function")
+    RESULTIS alloc_int((fn!fun_wrapped)(a!int_value, b!int_value))
+  }
+  LET add_fn(a, b)      = a + b
+  LET subtract_fn(a, b) = a - b
+  LET multiply_fn(a, b) = a * b
+  LET divide_fn(a, b)   = a / b
+  add      := alloc_fun(arith, fun_sz); add!fun_wrapped := add_fn
+  subtract := alloc_fun(arith, fun_sz); subtract!fun_wrapped := subtract_fn
+  multiply := alloc_fun(arith, fun_sz); multiply!fun_wrapped := multiply_fn
+  divide   := alloc_fun(arith, fun_sz); divide!fun_wrapped := divide_fn
 }
 
 LET rep(x, env) = PRINT(EVAL(READ(x), env))
diff --git a/impls/bcpl/step4_if_fn_do.b b/impls/bcpl/step4_if_fn_do.b
index b209288ff1..b1c0553150 100644
--- a/impls/bcpl/step4_if_fn_do.b
+++ b/impls/bcpl/step4_if_fn_do.b
@@ -67,10 +67,7 @@ AND EVAL(ast, env) = VALOF
     { MANIFEST { fun_binds = 2; fun_body = 3; fun_env = 4; fun_sz = 5 }
       LET call(fun, args) =
           EVAL(fun!fun_body, env_new(fun!fun_env, fun!fun_binds, args))
-      LET result = getvec(fun_sz)
-      !result := 0
-      type OF result := t_fun
-      result!fun_code := call
+      LET result = alloc_fun(call, fun_sz)
       result!fun_binds := nth(ast, 1)
       result!fun_body := nth(ast, 2)
       result!fun_env := env
@@ -86,25 +83,24 @@ AND EVAL(ast, env) = VALOF
 
 LET PRINT(x) = pr_str(x)
 
-LET arith(fn, args) = VALOF
-{ LET a, b = args!lst_first, args!lst_rest!lst_first
-  UNLESS type OF a = type OF b = t_int DO
-    throwf("bad arguments for arithmetic function")
-  RESULTIS alloc_int((fn!fun_wrapped)(a!int_value, b!int_value))
-}
-
-LET add_fn(a, b)      = a + b
-LET subtract_fn(a, b) = a - b
-LET multiply_fn(a, b) = a * b
-LET divide_fn(a, b)   = a / b
-
 STATIC { add; subtract; multiply; divide }
 
 LET init_core() BE
-{ add      := alloc_fun(arith, add_fn)
-  subtract := alloc_fun(arith, subtract_fn)
-  multiply := alloc_fun(arith, multiply_fn)
-  divide   := alloc_fun(arith, divide_fn)
+{ MANIFEST { fun_wrapped = 2; fun_sz = 3 }
+  LET arith(fn, args) = VALOF
+  { LET a, b = args!lst_first, args!lst_rest!lst_first
+    UNLESS type OF a = type OF b = t_int DO
+      throwf("bad arguments for arithmetic function")
+    RESULTIS alloc_int((fn!fun_wrapped)(a!int_value, b!int_value))
+  }
+  LET add_fn(a, b)      = a + b
+  LET subtract_fn(a, b) = a - b
+  LET multiply_fn(a, b) = a * b
+  LET divide_fn(a, b)   = a / b
+  add      := alloc_fun(arith, fun_sz); add!fun_wrapped := add_fn
+  subtract := alloc_fun(arith, fun_sz); subtract!fun_wrapped := subtract_fn
+  multiply := alloc_fun(arith, fun_sz); multiply!fun_wrapped := multiply_fn
+  divide   := alloc_fun(arith, fun_sz); divide!fun_wrapped := divide_fn
 }
 
 LET rep(x, env) = PRINT(EVAL(READ(x), env))
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index af88d991c1..d0c5cf7cbf 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -112,12 +112,11 @@ LET alloc_vec(len) = VALOF
   RESULTIS result
 }
 
-LET alloc_fun(fn, wrapped) = VALOF
-{ LET result = getvec(3)
+LET alloc_fun(fn, sz) = VALOF
+{ LET result = getvec(sz)
   !result := 0
   type OF result := t_fun
   result!fun_code := fn
-  result!fun_wrapped := wrapped
   RESULTIS result
 }
 

From 1d13bb182cf944013ad265f113e06023c9b8dd63 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sat, 13 Jul 2019 00:08:38 +0100
Subject: [PATCH 041/148] bcpl: Improve "incomparable value" error message.

---
 impls/bcpl/types.b | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index d0c5cf7cbf..3b13808dd2 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -94,7 +94,7 @@ LET equal(a, b) = VALOF
   { CASE t_nil: RESULTIS 1
     CASE t_int: RESULTIS int_sz
     CASE t_str: RESULTIS str_data + 1 + a!str_len / bytesperword
-    DEFAULT: throwf("incomparable value")
+    DEFAULT: throwf("incomparable value: %v", a)
   }
   // This is guaranteed not to walk off the end of b because any two mal
   // values with different lengths will differ before the point where

From 0ddf31ba92ecbdfacace684166cac73fc1d42a6f Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sat, 13 Jul 2019 00:19:27 +0100
Subject: [PATCH 042/148] bcpl: Split off core.b and make alloc_fun() more
 user-friendly.

---
 impls/bcpl/Makefile         |  2 +-
 impls/bcpl/core.b           | 27 +++++++++++++++++++++++++++
 impls/bcpl/malhdr.h         |  5 +++--
 impls/bcpl/step2_eval.b     |  8 ++++----
 impls/bcpl/step3_env.b      |  8 ++++----
 impls/bcpl/step4_if_fn_do.b | 36 +++++-------------------------------
 impls/bcpl/types.b          |  5 ++++-
 7 files changed, 48 insertions(+), 43 deletions(-)
 create mode 100644 impls/bcpl/core.b

diff --git a/impls/bcpl/Makefile b/impls/bcpl/Makefile
index 46f74328d7..d101c34a54 100644
--- a/impls/bcpl/Makefile
+++ b/impls/bcpl/Makefile
@@ -9,7 +9,7 @@ step0_repl: readline.b types.b
 step1_read_print: printer.b reader.b readline.b types.b
 step2_eval: printer.b reader.b readline.b types.b
 step3_env: env.b printer.b reader.b readline.b types.b
-step4_if_fn_do: env.b printer.b reader.b readline.b types.b
+step4_if_fn_do: core.b env.b printer.b reader.b readline.b types.b
 
 clean:
 	rm step0_repl step1_read_print step2_eval step3_env step4_if_fn_do
diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
new file mode 100644
index 0000000000..931c223b96
--- /dev/null
+++ b/impls/bcpl/core.b
@@ -0,0 +1,27 @@
+GET "libhdr"
+GET "malhdr"
+
+LET core_env() = VALOF
+{ LET env = env_new(nil, empty, empty)
+  LET env_set_const(env, name, value) BE
+    env_set(env, as_sym(str_bcpl2mal(name)), value)
+
+  { MANIFEST { fun_wrapped = fun_data; fun_sz }
+    LET arith(fn, args) = VALOF
+    { LET a, b = args!lst_first, args!lst_rest!lst_first
+      UNLESS type OF a = type OF b = t_int DO
+        throwf("bad arguments for arithmetic function")
+      RESULTIS alloc_int((fn!fun_wrapped)(a!int_value, b!int_value))
+    }
+    LET add_fn(a, b)      = a + b
+    LET subtract_fn(a, b) = a - b
+    LET multiply_fn(a, b) = a * b
+    LET divide_fn(a, b)   = a / b
+    env_set_const(env, "+", alloc_fun(arith, fun_sz, add_fn))
+    env_set_const(env, "-", alloc_fun(arith, fun_sz, subtract_fn))
+    env_set_const(env, "**", alloc_fun(arith, fun_sz, multiply_fn))
+    env_set_const(env, "/", alloc_fun(arith, fun_sz, divide_fn))
+  }
+
+  RESULTIS env
+}
diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index 7b3fccbc3b..24e08528bf 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -9,8 +9,9 @@ GLOBAL { readline: ug
 	 alloc_vec
 	 alloc_fun
 	 throw
+	 env_new; env_set
 	 catch_level; catch_label; last_exception
-	 init_core
+	 core_env
 }
 
 MANIFEST
@@ -52,7 +53,7 @@ MANIFEST
 
   // Functions.  Contains a function which gets passed a pointer to
   // this structure and can do what it likes with it.
-  t_fun = #x03; fun_code = 1
+  t_fun = #x03; fun_code = 1; fun_data = 2
 
   // Hash-maps.  These are implemented as crit-bit trees.  There are three
   // types of node: internal nodes point to two other nodes and encode a
diff --git a/impls/bcpl/step2_eval.b b/impls/bcpl/step2_eval.b
index 16fbd28ffa..a309cdafe4 100644
--- a/impls/bcpl/step2_eval.b
+++ b/impls/bcpl/step2_eval.b
@@ -54,10 +54,10 @@ LET init_core() BE
   LET subtract_fn(a, b) = a - b
   LET multiply_fn(a, b) = a * b
   LET divide_fn(a, b)   = a / b
-  add      := alloc_fun(arith, fun_sz); add!fun_wrapped := add_fn
-  subtract := alloc_fun(arith, fun_sz); subtract!fun_wrapped := subtract_fn
-  multiply := alloc_fun(arith, fun_sz); multiply!fun_wrapped := multiply_fn
-  divide   := alloc_fun(arith, fun_sz); divide!fun_wrapped := divide_fn
+  add      := alloc_fun(arith, fun_sz, add_fn)
+  subtract := alloc_fun(arith, fun_sz, subtract_fn)
+  multiply := alloc_fun(arith, fun_sz, multiply_fn)
+  divide   := alloc_fun(arith, fun_sz, divide_fn)
 }
 
 LET repl_env(key) = VALOF
diff --git a/impls/bcpl/step3_env.b b/impls/bcpl/step3_env.b
index 5d3f4762dd..962260880a 100644
--- a/impls/bcpl/step3_env.b
+++ b/impls/bcpl/step3_env.b
@@ -76,10 +76,10 @@ LET init_core() BE
   LET subtract_fn(a, b) = a - b
   LET multiply_fn(a, b) = a * b
   LET divide_fn(a, b)   = a / b
-  add      := alloc_fun(arith, fun_sz); add!fun_wrapped := add_fn
-  subtract := alloc_fun(arith, fun_sz); subtract!fun_wrapped := subtract_fn
-  multiply := alloc_fun(arith, fun_sz); multiply!fun_wrapped := multiply_fn
-  divide   := alloc_fun(arith, fun_sz); divide!fun_wrapped := divide_fn
+  add      := alloc_fun(arith, fun_sz, add_fn)
+  subtract := alloc_fun(arith, fun_sz, subtract_fn)
+  multiply := alloc_fun(arith, fun_sz, multiply_fn)
+  divide   := alloc_fun(arith, fun_sz, divide_fn)
 }
 
 LET rep(x, env) = PRINT(EVAL(READ(x), env))
diff --git a/impls/bcpl/step4_if_fn_do.b b/impls/bcpl/step4_if_fn_do.b
index b1c0553150..ef5e6df026 100644
--- a/impls/bcpl/step4_if_fn_do.b
+++ b/impls/bcpl/step4_if_fn_do.b
@@ -1,6 +1,7 @@
 GET "libhdr"
 GET "malhdr"
 
+GET "core.b"
 GET "env.b"
 GET "printer.b"
 GET "reader.b"
@@ -64,13 +65,10 @@ AND EVAL(ast, env) = VALOF
       RESULTIS EVAL(tail!lst_first, env)
     }
     IF is_sym(fn, "fn**") THEN
-    { MANIFEST { fun_binds = 2; fun_body = 3; fun_env = 4; fun_sz = 5 }
+    { MANIFEST { fun_binds = fun_data; fun_body; fun_env; fun_sz }
       LET call(fun, args) =
           EVAL(fun!fun_body, env_new(fun!fun_env, fun!fun_binds, args))
-      LET result = alloc_fun(call, fun_sz)
-      result!fun_binds := nth(ast, 1)
-      result!fun_body := nth(ast, 2)
-      result!fun_env := env
+      LET result = alloc_fun(call, fun_sz, nth(ast, 1), nth(ast, 2), env)
       RESULTIS result
     }
   }
@@ -83,36 +81,13 @@ AND EVAL(ast, env) = VALOF
 
 LET PRINT(x) = pr_str(x)
 
-STATIC { add; subtract; multiply; divide }
-
-LET init_core() BE
-{ MANIFEST { fun_wrapped = 2; fun_sz = 3 }
-  LET arith(fn, args) = VALOF
-  { LET a, b = args!lst_first, args!lst_rest!lst_first
-    UNLESS type OF a = type OF b = t_int DO
-      throwf("bad arguments for arithmetic function")
-    RESULTIS alloc_int((fn!fun_wrapped)(a!int_value, b!int_value))
-  }
-  LET add_fn(a, b)      = a + b
-  LET subtract_fn(a, b) = a - b
-  LET multiply_fn(a, b) = a * b
-  LET divide_fn(a, b)   = a / b
-  add      := alloc_fun(arith, fun_sz); add!fun_wrapped := add_fn
-  subtract := alloc_fun(arith, fun_sz); subtract!fun_wrapped := subtract_fn
-  multiply := alloc_fun(arith, fun_sz); multiply!fun_wrapped := multiply_fn
-  divide   := alloc_fun(arith, fun_sz); divide!fun_wrapped := divide_fn
-}
-
 LET rep(x, env) = PRINT(EVAL(READ(x), env))
 
 LET repl() BE
 { LET prompt = str_bcpl2mal("user> ")
-  LET repl_env = env_new(nil, empty, empty)
-  env_set(repl_env, as_sym(str_bcpl2mal("+")), add)
-  env_set(repl_env, as_sym(str_bcpl2mal("-")), subtract)
-  env_set(repl_env, as_sym(str_bcpl2mal("**")), multiply)
-  env_set(repl_env, as_sym(str_bcpl2mal("/")), divide)
+  LET repl_env = ?
   catch_level, catch_label := level(), uncaught
+  repl_env := core_env()
   IF FALSE THEN
   { uncaught:
     writes("Uncaught exception: ")
@@ -129,7 +104,6 @@ LET repl() BE
 LET start() = VALOF
 { LET ch = 0
   init_types()
-  init_core()
   ch := rdch() REPEATUNTIL ch = '*n' // Consume command-line args
   wrch('*n') // Terminate prompt printed by Cintsys
   repl()
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index 3b13808dd2..5e7df644e2 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -112,11 +112,14 @@ LET alloc_vec(len) = VALOF
   RESULTIS result
 }
 
-LET alloc_fun(fn, sz) = VALOF
+LET alloc_fun(fn, sz, A, B, C) = VALOF
 { LET result = getvec(sz)
+  LET p = @A
   !result := 0
   type OF result := t_fun
   result!fun_code := fn
+  FOR i = 0 TO sz - fun_data - 1
+    result!(fun_data + i) := p!i
   RESULTIS result
 }
 

From 885b69e96649dc4506060836908c530c4d2968f0 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sat, 13 Jul 2019 00:45:10 +0100
Subject: [PATCH 043/148] bcpl: Explicitly test for division by zero.

Since BCPL has no exception handling, it has no built-in way to trap
division by zero.  The Cintcode implementation just drops into the
debugger.  Since that's unfriendly, extend the implementation of '/' to
detect when its second argument is zero.
---
 impls/bcpl/core.b       | 6 +++++-
 impls/bcpl/step2_eval.b | 5 ++++-
 impls/bcpl/step3_env.b  | 5 ++++-
 3 files changed, 13 insertions(+), 3 deletions(-)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index 931c223b96..083817ba56 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -16,7 +16,11 @@ LET core_env() = VALOF
     LET add_fn(a, b)      = a + b
     LET subtract_fn(a, b) = a - b
     LET multiply_fn(a, b) = a * b
-    LET divide_fn(a, b)   = a / b
+    LET divide_fn(a, b)   = VALOF
+    { IF b = 0 THEN throwf("division by zero")
+      RESULTIS a / b
+    }
+
     env_set_const(env, "+", alloc_fun(arith, fun_sz, add_fn))
     env_set_const(env, "-", alloc_fun(arith, fun_sz, subtract_fn))
     env_set_const(env, "**", alloc_fun(arith, fun_sz, multiply_fn))
diff --git a/impls/bcpl/step2_eval.b b/impls/bcpl/step2_eval.b
index a309cdafe4..c6d0156be7 100644
--- a/impls/bcpl/step2_eval.b
+++ b/impls/bcpl/step2_eval.b
@@ -53,7 +53,10 @@ LET init_core() BE
   LET add_fn(a, b)      = a + b
   LET subtract_fn(a, b) = a - b
   LET multiply_fn(a, b) = a * b
-  LET divide_fn(a, b)   = a / b
+  LET divide_fn(a, b)   = VALOF
+  { IF b = 0 THEN throwf("division by zero")
+    RESULTIS a / b
+  }
   add      := alloc_fun(arith, fun_sz, add_fn)
   subtract := alloc_fun(arith, fun_sz, subtract_fn)
   multiply := alloc_fun(arith, fun_sz, multiply_fn)
diff --git a/impls/bcpl/step3_env.b b/impls/bcpl/step3_env.b
index 962260880a..4892299349 100644
--- a/impls/bcpl/step3_env.b
+++ b/impls/bcpl/step3_env.b
@@ -75,7 +75,10 @@ LET init_core() BE
   LET add_fn(a, b)      = a + b
   LET subtract_fn(a, b) = a - b
   LET multiply_fn(a, b) = a * b
-  LET divide_fn(a, b)   = a / b
+  LET divide_fn(a, b)   = VALOF
+  { IF b = 0 THEN throwf("division by zero")
+    RESULTIS a / b
+  }
   add      := alloc_fun(arith, fun_sz, add_fn)
   subtract := alloc_fun(arith, fun_sz, subtract_fn)
   multiply := alloc_fun(arith, fun_sz, multiply_fn)

From 025c51bd1f7cb1c10445d6df40443b6b77994ff3 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sat, 13 Jul 2019 09:43:25 +0100
Subject: [PATCH 044/148] bcpl: Tighten and comment core_env(), and propagate
 changes to earlier steps.

---
 impls/bcpl/core.b       | 47 +++++++++++++++++++++++++++++------------
 impls/bcpl/step2_eval.b | 34 +++++++++++++++--------------
 impls/bcpl/step3_env.b  | 35 ++++++++++++++++--------------
 3 files changed, 70 insertions(+), 46 deletions(-)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index 083817ba56..72e1d2e59e 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -1,30 +1,49 @@
 GET "libhdr"
 GET "malhdr"
 
+// The Guide would have the file simply declare a data structure
+// specifying the mal core namespace, with the step files constructing
+// repl_env based on it.  This is not really appropriate in BCPL,
+// though.  BCPL has almost no facilities for defining static data.
+// There is TABLE, but that's restricted to compile-time constants.
+// Pointers in BCPL are not compile-time constants, so a TABLE cannot
+// contain any strings, or pointers to routines, or pointers to other
+// TABLEs.  This means that core.ns would have to be defined by
+// a function constructing it, but if we are going to do that, we may
+// as well have the function construct an entire environment instead.
+
 LET core_env() = VALOF
 { LET env = env_new(nil, empty, empty)
-  LET env_set_const(env, name, value) BE
-    env_set(env, as_sym(str_bcpl2mal(name)), value)
+  LET def(env, name, value) BE env_set(env, as_sym(str_bcpl2mal(name)), value)
+
+  // A common form of core function is a wrapped function, where one
+  // function does the actual work while another (the wrapper) handles
+  // conversion between mal and BCPL conventions.  The wrapper
+  // functions tend to be more complicated, but they can be shared
+  // between many wrapped functions.
+  MANIFEST { wf_wrapped = fun_data; wf_sz }
 
-  { MANIFEST { fun_wrapped = fun_data; fun_sz }
-    LET arith(fn, args) = VALOF
+  // Arithmetic functions
+  { LET arith(fn, args) = VALOF
     { LET a, b = args!lst_first, args!lst_rest!lst_first
       UNLESS type OF a = type OF b = t_int DO
-        throwf("bad arguments for arithmetic function")
-      RESULTIS alloc_int((fn!fun_wrapped)(a!int_value, b!int_value))
+        throwf("bad arguments for arithmetic function: %v", args)
+      RESULTIS alloc_int((fn!wf_wrapped)(a!int_value, b!int_value))
     }
-    LET add_fn(a, b)      = a + b
-    LET subtract_fn(a, b) = a - b
-    LET multiply_fn(a, b) = a * b
-    LET divide_fn(a, b)   = VALOF
+    LET arith_fun(fn) = alloc_fun(arith, wf_sz, fn)
+
+    LET add(a, b) = a + b
+    LET sub(a, b) = a - b
+    LET mul(a, b) = a * b
+    LET div(a, b) = VALOF
     { IF b = 0 THEN throwf("division by zero")
       RESULTIS a / b
     }
 
-    env_set_const(env, "+", alloc_fun(arith, fun_sz, add_fn))
-    env_set_const(env, "-", alloc_fun(arith, fun_sz, subtract_fn))
-    env_set_const(env, "**", alloc_fun(arith, fun_sz, multiply_fn))
-    env_set_const(env, "/", alloc_fun(arith, fun_sz, divide_fn))
+    def(env, "+",  arith_fun(add))
+    def(env, "-",  arith_fun(sub))
+    def(env, "**", arith_fun(mul))
+    def(env, "/",  arith_fun(div))
   }
 
   RESULTIS env
diff --git a/impls/bcpl/step2_eval.b b/impls/bcpl/step2_eval.b
index c6d0156be7..f1fcef4748 100644
--- a/impls/bcpl/step2_eval.b
+++ b/impls/bcpl/step2_eval.b
@@ -40,35 +40,37 @@ AND EVAL(ast, env) = VALOF
 
 LET PRINT(x) = pr_str(x)
 
-STATIC { add; subtract; multiply; divide }
+STATIC { add_fun; sub_fun; mul_fun; div_fun }
 
 LET init_core() BE
-{ MANIFEST { fun_wrapped = 2; fun_sz = 3 }
+{ MANIFEST { wf_wrapped = 2; wf_sz = 3 }
   LET arith(fn, args) = VALOF
   { LET a, b = args!lst_first, args!lst_rest!lst_first
     UNLESS type OF a = type OF b = t_int DO
-      throwf("bad arguments for arithmetic function")
-    RESULTIS alloc_int((fn!fun_wrapped)(a!int_value, b!int_value))
+      throwf("bad arguments for arithmetic function: %v", args)
+    RESULTIS alloc_int((fn!wf_wrapped)(a!int_value, b!int_value))
   }
-  LET add_fn(a, b)      = a + b
-  LET subtract_fn(a, b) = a - b
-  LET multiply_fn(a, b) = a * b
-  LET divide_fn(a, b)   = VALOF
+  LET arith_fun(fn) = alloc_fun(arith, wf_sz, fn)
+
+  LET add(a, b) = a + b
+  LET sub(a, b) = a - b
+  LET mul(a, b) = a * b
+  LET div(a, b) = VALOF
   { IF b = 0 THEN throwf("division by zero")
     RESULTIS a / b
   }
-  add      := alloc_fun(arith, fun_sz, add_fn)
-  subtract := alloc_fun(arith, fun_sz, subtract_fn)
-  multiply := alloc_fun(arith, fun_sz, multiply_fn)
-  divide   := alloc_fun(arith, fun_sz, divide_fn)
+  add_fun := arith_fun(add)
+  sub_fun := arith_fun(sub)
+  mul_fun := arith_fun(mul)
+  div_fun := arith_fun(div)
 }
 
 LET repl_env(key) = VALOF
 { IF key!str_len = 1 SWITCHON (key + str_data)%1 INTO
-  { CASE '+': RESULTIS add
-    CASE '-': RESULTIS subtract
-    CASE '**': RESULTIS multiply
-    CASE '/': RESULTIS divide
+  { CASE '+':  RESULTIS add_fun
+    CASE '-':  RESULTIS sub_fun
+    CASE '**': RESULTIS mul_fun
+    CASE '/':  RESULTIS div_fun
   }
   throw(str_bcpl2mal("unknown function"))
 }
diff --git a/impls/bcpl/step3_env.b b/impls/bcpl/step3_env.b
index 4892299349..d0ad250676 100644
--- a/impls/bcpl/step3_env.b
+++ b/impls/bcpl/step3_env.b
@@ -62,27 +62,29 @@ AND EVAL(ast, env) = VALOF
 
 LET PRINT(x) = pr_str(x)
 
-STATIC { add; subtract; multiply; divide }
+STATIC { add_fun; sub_fun; mul_fun; div_fun }
 
 LET init_core() BE
-{ MANIFEST { fun_wrapped = 2; fun_sz = 3 }
+{ MANIFEST { wf_wrapped = 2; wf_sz = 3 }
   LET arith(fn, args) = VALOF
   { LET a, b = args!lst_first, args!lst_rest!lst_first
     UNLESS type OF a = type OF b = t_int DO
-      throwf("bad arguments for arithmetic function")
-    RESULTIS alloc_int((fn!fun_wrapped)(a!int_value, b!int_value))
+      throwf("bad arguments for arithmetic function: %v", args)
+    RESULTIS alloc_int((fn!wf_wrapped)(a!int_value, b!int_value))
   }
-  LET add_fn(a, b)      = a + b
-  LET subtract_fn(a, b) = a - b
-  LET multiply_fn(a, b) = a * b
-  LET divide_fn(a, b)   = VALOF
+  LET arith_fun(fn) = alloc_fun(arith, wf_sz, fn)
+
+  LET add(a, b) = a + b
+  LET sub(a, b) = a - b
+  LET mul(a, b) = a * b
+  LET div(a, b) = VALOF
   { IF b = 0 THEN throwf("division by zero")
     RESULTIS a / b
   }
-  add      := alloc_fun(arith, fun_sz, add_fn)
-  subtract := alloc_fun(arith, fun_sz, subtract_fn)
-  multiply := alloc_fun(arith, fun_sz, multiply_fn)
-  divide   := alloc_fun(arith, fun_sz, divide_fn)
+  add_fun := arith_fun(add)
+  sub_fun := arith_fun(sub)
+  mul_fun := arith_fun(mul)
+  div_fun := arith_fun(div)
 }
 
 LET rep(x, env) = PRINT(EVAL(READ(x), env))
@@ -90,10 +92,11 @@ LET rep(x, env) = PRINT(EVAL(READ(x), env))
 LET repl() BE
 { LET prompt = str_bcpl2mal("user> ")
   LET repl_env = env_new(nil, empty, empty)
-  env_set(repl_env, as_sym(str_bcpl2mal("+")), add)
-  env_set(repl_env, as_sym(str_bcpl2mal("-")), subtract)
-  env_set(repl_env, as_sym(str_bcpl2mal("**")), multiply)
-  env_set(repl_env, as_sym(str_bcpl2mal("/")), divide)
+  LET def(env, name, value) BE env_set(env, as_sym(str_bcpl2mal(name)), value)
+  def(repl_env, "+",  add_fun)
+  def(repl_env, "-",  sub_fun)
+  def(repl_env, "**", mul_fun)
+  def(repl_env, "/",  div_fun)
   catch_level, catch_label := level(), uncaught
   IF FALSE THEN
   { uncaught:

From 8aa2b733ccd901398c8f86e457ead8cb4fae6f6b Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sat, 13 Jul 2019 11:15:10 +0100
Subject: [PATCH 045/148] bcpl: Minimal implementation of 'prn'.

---
 impls/bcpl/core.b | 10 ++++++++++
 1 file changed, 10 insertions(+)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index 72e1d2e59e..67a85c0be2 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -46,5 +46,15 @@ LET core_env() = VALOF
     def(env, "/",  arith_fun(div))
   }
 
+  // Printing functions
+  { LET bare_fun(fn) = alloc_fun(fn, fun_data)
+    LET prn(fn, args) = VALOF
+    { writes(@(pr_str(args!lst_first)!str_data))
+      newline()
+      RESULTIS nil
+    }
+    def(env, "prn", bare_fun(prn))
+  }
+
   RESULTIS env
 }

From 39d00aa4a8563c034b0a21eab5ce86779f2526da Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sat, 13 Jul 2019 11:38:22 +0100
Subject: [PATCH 046/148] bcpl: Implement 'list' function.

---
 impls/bcpl/core.b | 10 +++++++---
 1 file changed, 7 insertions(+), 3 deletions(-)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index 67a85c0be2..d6987bf51d 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -15,7 +15,8 @@ GET "malhdr"
 LET core_env() = VALOF
 { LET env = env_new(nil, empty, empty)
   LET def(env, name, value) BE env_set(env, as_sym(str_bcpl2mal(name)), value)
-
+  LET bare_fun(fn) = alloc_fun(fn, fun_data)
+   
   // A common form of core function is a wrapped function, where one
   // function does the actual work while another (the wrapper) handles
   // conversion between mal and BCPL conventions.  The wrapper
@@ -47,8 +48,7 @@ LET core_env() = VALOF
   }
 
   // Printing functions
-  { LET bare_fun(fn) = alloc_fun(fn, fun_data)
-    LET prn(fn, args) = VALOF
+  { LET prn(fn, args) = VALOF
     { writes(@(pr_str(args!lst_first)!str_data))
       newline()
       RESULTIS nil
@@ -56,5 +56,9 @@ LET core_env() = VALOF
     def(env, "prn", bare_fun(prn))
   }
 
+  // Constructors
+  { LET list(fn, args) = args
+    def (env, "list", bare_fun(list))
+  }
   RESULTIS env
 }

From 8fdff0a5e813a994ae9e2405e948e5c17b3c6714 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sat, 13 Jul 2019 11:46:04 +0100
Subject: [PATCH 047/148] bcpl: Implement 'list?' and 'empty?'.

---
 impls/bcpl/core.b | 11 +++++++++++
 1 file changed, 11 insertions(+)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index d6987bf51d..534b60eb9a 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -47,6 +47,17 @@ LET core_env() = VALOF
     def(env, "/",  arith_fun(div))
   }
 
+  // Predicates
+  { LET pred(fn, args) = (fn!wf_wrapped)(args!lst_first) -> mtrue, mfalse
+    LET pred_fun(fn) = alloc_fun(pred, wf_sz, fn)
+
+    LET listp(val) = type OF val = t_lst
+    LET emptyp(val) = val = empty
+
+    def(env, "list?", pred_fun(listp))
+    def(env, "empty?", pred_fun(emptyp))
+  }
+
   // Printing functions
   { LET prn(fn, args) = VALOF
     { writes(@(pr_str(args!lst_first)!str_data))

From 0a07e60adba0d6a786429e6eda971b88c0c69a39 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sat, 13 Jul 2019 11:52:18 +0100
Subject: [PATCH 048/148] bcpl: Implement 'count' function.

---
 impls/bcpl/core.b | 15 +++++++++++++++
 1 file changed, 15 insertions(+)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index 534b60eb9a..deaf0942c2 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -58,6 +58,21 @@ LET core_env() = VALOF
     def(env, "empty?", pred_fun(emptyp))
   }
 
+  // Miscellaneous list functions
+  { LET count(fn, args) = VALOF
+    { LET list, n = args!lst_first, 0
+      IF list = nil RESULTIS alloc_int(0)
+      UNLESS type OF list = t_lst DO
+        throwf("invalid argument to count: %v", list)
+      UNTIL list = empty DO
+      { n := n + 1
+        list := list!lst_rest
+      }
+      RESULTIS alloc_int(n)
+    }
+    def(env, "count", bare_fun(count))
+  }
+
   // Printing functions
   { LET prn(fn, args) = VALOF
     { writes(@(pr_str(args!lst_first)!str_data))

From dd7ab9c979d93b2fad670be0a00d3842b804e634 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sat, 13 Jul 2019 12:24:40 +0100
Subject: [PATCH 049/148] bcpl: Implement '=' function, extending equal() to
 cover lists.

---
 impls/bcpl/core.b   |  9 +++++++++
 impls/bcpl/malhdr.h |  1 +
 impls/bcpl/types.b  | 10 ++++++++++
 3 files changed, 20 insertions(+)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index deaf0942c2..9a628cc5ec 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -58,6 +58,15 @@ LET core_env() = VALOF
     def(env, "empty?", pred_fun(emptyp))
   }
 
+  // Comparisons
+  { LET equalp(fn, args) = VALOF
+    { LET a, b = args!lst_first, args!lst_rest!lst_first
+      RESULTIS equal(a, b) -> mtrue, mfalse
+    }
+
+    def(env, "=", bare_fun(equalp))
+  }
+
   // Miscellaneous list functions
   { LET count(fn, args) = VALOF
     { LET list, n = args!lst_first, 0
diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index 24e08528bf..ad07a3dc09 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -2,6 +2,7 @@ GLOBAL { readline: ug
          pr_str; throwf
          read_str
          init_types; nil; empty; empty_hashmap; mtrue; mfalse
+	 equal
 	 cons; nth; as_lst
 	 alloc_int
 	 str_setlen; alloc_str; str_bcpl2mal; as_sym; str_eq_const
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index 5e7df644e2..68e2796377 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -90,6 +90,9 @@ LET str_eq_const(val, bcplstr) = VALOF
 LET equal(a, b) = VALOF
 { LET len = ?
   UNLESS type OF a = type OF b RESULTIS FALSE
+  SWITCHON supertype OF a INTO
+  { CASE t_lst: RESULTIS equal_lst(a, b)
+  }
   len := VALOF SWITCHON supertype OF a INTO
   { CASE t_nil: RESULTIS 1
     CASE t_int: RESULTIS int_sz
@@ -104,6 +107,13 @@ LET equal(a, b) = VALOF
   RESULTIS TRUE
 }
 
+AND equal_lst(a, b) = VALOF
+{ IF a = b = empty RESULTIS TRUE
+  IF a = empty | b = empty RESULTIS FALSE
+  UNLESS equal(a!lst_first, b!lst_first) RESULTIS FALSE
+  RESULTIS equal_lst(a!lst_rest, b!lst_rest)
+}
+
 LET alloc_vec(len) = VALOF
 { LET result = getvec(vec_data + len)
   !result := 0

From e49299786527e527418d3faa17d06a2030292aef Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sat, 13 Jul 2019 12:28:52 +0100
Subject: [PATCH 050/148] bcpl: Correct value of compoundflag; mark functions
 as compound.

---
 impls/bcpl/malhdr.h | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index ad07a3dc09..daa95aa947 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -22,7 +22,7 @@ MANIFEST
   // value.  The "type" distinguishes mal types with the same supertype
   // (for instance functions and macros).  The compoundflag is set on
   // compund types (ones containing references to other values).
-  compoundflag = SLCT 1:7:0; supertype = SLCT 4:0:0; type = SLCT 8:0:0
+  compoundflag = SLCT 1:3:0; supertype = SLCT 4:0:0; type = SLCT 8:0:0
 
   // Nil. There is a single nil value initialised by init_types(), but
   // it's a valid pointer so it can safely be dereferenced.
@@ -54,7 +54,7 @@ MANIFEST
 
   // Functions.  Contains a function which gets passed a pointer to
   // this structure and can do what it likes with it.
-  t_fun = #x03; fun_code = 1; fun_data = 2
+  t_fun = #x0f; fun_code = 1; fun_data = 2
 
   // Hash-maps.  These are implemented as crit-bit trees.  There are three
   // types of node: internal nodes point to two other nodes and encode a

From f18990c24fd610a4e0951a0f078a503c4b645d9c Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sat, 13 Jul 2019 12:45:18 +0100
Subject: [PATCH 051/148] bcpl: Refuse compound values as hash-map keys.

---
 impls/bcpl/types.b | 10 +++++++---
 1 file changed, 7 insertions(+), 3 deletions(-)

diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index 68e2796377..d1eb1c388e 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -200,6 +200,7 @@ LET hm_insert(map, bit, key, value) = VALOF
 
 LET hm_set(map, key, value) = VALOF
 { LET bit, nearest = ?, ?
+  IF compoundflag OF key THEN throwf("invalid hash-map key: %v", key)
   IF map = empty_hashmap RESULTIS alloc_hmx(key, value)
   nearest := hm_find(map, key)
   IF equal(nearest!hmx_key, key) THEN RESULTIS hm_replace(map, key, value)
@@ -208,7 +209,8 @@ LET hm_set(map, key, value) = VALOF
 }
 
 LET hm_remove(map, key) = VALOF
-{ IF map = empty_hashmap RESULTIS map
+{ IF compoundflag OF key THEN throwf("invalid hash-map key: %v", key)
+  IF map = empty_hashmap RESULTIS map
   IF type OF map = t_hmx THEN
     RESULTIS equal(map!hmx_key, key) -> empty_hashmap, map
   TEST key_bit(key, hmi_critbit OF map) THEN
@@ -223,13 +225,15 @@ LET hm_remove(map, key) = VALOF
 }
 
 LET hm_get(map, key) = VALOF
-{ IF map = empty_hashmap RESULTIS nil
+{ IF compoundflag OF key THEN throwf("invalid hash-map key: %v", key)
+  IF map = empty_hashmap RESULTIS nil
   map := hm_find(map, key)
   RESULTIS equal(map!hmx_key, key) -> map!hmx_value, nil
 }
 
 LET hm_contains(map, key) = VALOF
-{ IF map = empty_hashmap RESULTIS FALSE
+{ IF compoundflag OF key THEN throwf("invalid hash-map key: %v", key)
+  IF map = empty_hashmap RESULTIS FALSE
   map := hm_find(map, key)
   RESULTIS equal(map!hmx_key, key)
 }

From ab55168c1c857a4fffc20621c02653382d33779d Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sat, 13 Jul 2019 14:12:34 +0100
Subject: [PATCH 052/148] bcpl: Implement integer comparison functions.

---
 impls/bcpl/core.b | 18 +++++++++++++++++-
 1 file changed, 17 insertions(+), 1 deletion(-)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index 9a628cc5ec..1f392ab232 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -63,8 +63,24 @@ LET core_env() = VALOF
     { LET a, b = args!lst_first, args!lst_rest!lst_first
       RESULTIS equal(a, b) -> mtrue, mfalse
     }
+    LET cmp(fn, args) = VALOF
+    { LET a, b = args!lst_first, args!lst_rest!lst_first
+      UNLESS type OF a = type OF b = t_int DO
+        throwf("bad arguments for arithmetic function: %v", args)
+      RESULTIS  (fn!wf_wrapped)(a!int_value, b!int_value) -> mtrue, mfalse
+    }
+    LET cmp_fun(fn) = alloc_fun(cmp, wf_sz, fn)
 
-    def(env, "=", bare_fun(equalp))
+    LET lt(a, b) = a < b
+    LET le(a, b) = a <= b
+    LET gt(a, b) = a > b
+    LET ge(a, b) = a >= b
+    
+    def(env, "=",  bare_fun(equalp))
+    def(env, "<",  cmp_fun(lt))
+    def(env, "<=", cmp_fun(le))
+    def(env, ">",  cmp_fun(gt))
+    def(env, ">=", cmp_fun(ge))
   }
 
   // Miscellaneous list functions

From e05830d3919b82c6252050bc95b14629d2f0c9a3 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sat, 13 Jul 2019 14:45:53 +0100
Subject: [PATCH 053/148] bcpl: Support '&' in argument lists.

---
 impls/bcpl/env.b | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/impls/bcpl/env.b b/impls/bcpl/env.b
index 99a23347bd..bca89afb38 100644
--- a/impls/bcpl/env.b
+++ b/impls/bcpl/env.b
@@ -11,8 +11,12 @@ LET env_new(outer, binds, exprs) = VALOF
 { LET env = getvec(env_sz)
   env!env_outer := outer
   env!env_data := empty_hashmap
-  UNTIL binds = empty | exprs = empty DO
-  { env_set(env, binds!lst_first, exprs!lst_first)
+  UNTIL binds = empty DO
+  { IF str_eq_const(binds!lst_first, "&") THEN
+    { env_set(env, nth(binds, 1), exprs)
+      BREAK
+    }
+    env_set(env, binds!lst_first, exprs!lst_first)
     binds, exprs := binds!lst_rest, exprs!lst_rest
   }
   RESULTIS env

From beb3e7800ec22d58028826811f90de3e38854620 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sat, 13 Jul 2019 14:50:34 +0100
Subject: [PATCH 054/148] bcpl: Define 'not' function.

---
 impls/bcpl/step4_if_fn_do.b | 1 +
 1 file changed, 1 insertion(+)

diff --git a/impls/bcpl/step4_if_fn_do.b b/impls/bcpl/step4_if_fn_do.b
index ef5e6df026..cfa8ea19a1 100644
--- a/impls/bcpl/step4_if_fn_do.b
+++ b/impls/bcpl/step4_if_fn_do.b
@@ -88,6 +88,7 @@ LET repl() BE
   LET repl_env = ?
   catch_level, catch_label := level(), uncaught
   repl_env := core_env()
+  rep(str_bcpl2mal("(def! not (fn** (a) (if a false true)))"), repl_env)
   IF FALSE THEN
   { uncaught:
     writes("Uncaught exception: ")

From 5a81ddb75e745cd5884d971cbd6ca4085b6294b7 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 16 Jul 2019 22:55:45 +0100
Subject: [PATCH 055/148] bcpl: Make '=' work for comparing vectors.

It won't believe that a list can equal a vector, though.
---
 impls/bcpl/types.b | 8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index d1eb1c388e..cc020f7ee1 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -92,6 +92,7 @@ LET equal(a, b) = VALOF
   UNLESS type OF a = type OF b RESULTIS FALSE
   SWITCHON supertype OF a INTO
   { CASE t_lst: RESULTIS equal_lst(a, b)
+    CASE t_vec: RESULTIS equal_vec(a, b)
   }
   len := VALOF SWITCHON supertype OF a INTO
   { CASE t_nil: RESULTIS 1
@@ -114,6 +115,13 @@ AND equal_lst(a, b) = VALOF
   RESULTIS equal_lst(a!lst_rest, b!lst_rest)
 }
 
+AND equal_vec(a, b) = VALOF
+{ UNLESS a!vec_len = b!vec_len RESULTIS FALSE
+  FOR i = 0 TO a!vec_len - 1 DO
+    UNLESS equal((a + vec_data)!i, (b + vec_data)!i) RESULTIS FALSE
+  RESULTIS TRUE
+}
+
 LET alloc_vec(len) = VALOF
 { LET result = getvec(vec_data + len)
   !result := 0

From 27fcee5046470f9482c69815ba092640c7d39318 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 16 Jul 2019 23:05:32 +0100
Subject: [PATCH 056/148] bcpl: Extend 'count' to handle vectors.

---
 impls/bcpl/core.b | 18 ++++++++++--------
 1 file changed, 10 insertions(+), 8 deletions(-)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index 1f392ab232..f0d5fd8aa7 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -85,15 +85,17 @@ LET core_env() = VALOF
 
   // Miscellaneous list functions
   { LET count(fn, args) = VALOF
-    { LET list, n = args!lst_first, 0
-      IF list = nil RESULTIS alloc_int(0)
-      UNLESS type OF list = t_lst DO
-        throwf("invalid argument to count: %v", list)
-      UNTIL list = empty DO
-      { n := n + 1
-        list := list!lst_rest
+    { LET arg = args!lst_first
+      SWITCHON supertype OF arg INTO
+      { CASE t_nil: RESULTIS alloc_int(0)
+        CASE t_lst:
+        { LET n = 0
+          UNTIL arg = empty DO n, arg := n + 1, arg!lst_rest
+	  RESULTIS alloc_int(n)
+	}
+        CASE t_vec: RESULTIS alloc_int(arg!vec_len)
+	DEFAULT: throwf("invalid argument to count: %v", arg)
       }
-      RESULTIS alloc_int(n)
     }
     def(env, "count", bare_fun(count))
   }

From 58f3178babaf95854a59f66b048e7c175ffebe6a Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 16 Jul 2019 23:10:44 +0100
Subject: [PATCH 057/148] bcpl: Permit vector parameter lists in 'fn*'.

---
 impls/bcpl/step4_if_fn_do.b | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/impls/bcpl/step4_if_fn_do.b b/impls/bcpl/step4_if_fn_do.b
index cfa8ea19a1..8e878a7049 100644
--- a/impls/bcpl/step4_if_fn_do.b
+++ b/impls/bcpl/step4_if_fn_do.b
@@ -68,7 +68,8 @@ AND EVAL(ast, env) = VALOF
     { MANIFEST { fun_binds = fun_data; fun_body; fun_env; fun_sz }
       LET call(fun, args) =
           EVAL(fun!fun_body, env_new(fun!fun_env, fun!fun_binds, args))
-      LET result = alloc_fun(call, fun_sz, nth(ast, 1), nth(ast, 2), env)
+      LET result = alloc_fun(call, fun_sz,
+                             as_lst(nth(ast, 1)), nth(ast, 2), env)
       RESULTIS result
     }
   }

From 7ae396503139693b4e83a4ad9bfe8964c9000474 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Wed, 17 Jul 2019 21:04:24 +0100
Subject: [PATCH 058/148] bcpl: Extend 'empty?' to cover vectors.

---
 impls/bcpl/core.b | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index f0d5fd8aa7..2a3f9ecbfb 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -52,7 +52,10 @@ LET core_env() = VALOF
     LET pred_fun(fn) = alloc_fun(pred, wf_sz, fn)
 
     LET listp(val) = type OF val = t_lst
-    LET emptyp(val) = val = empty
+    // The '->' here is to make sure that | and & are in truth-value
+    // context.
+    LET emptyp(val) = val =
+      empty | supertype OF val = t_vec & val!vec_len = 0 -> TRUE, FALSE
 
     def(env, "list?", pred_fun(listp))
     def(env, "empty?", pred_fun(emptyp))

From 534dcc5a604913bf3c3ea8447bfcb5214cd09f82 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Wed, 17 Jul 2019 23:07:55 +0100
Subject: [PATCH 059/148] bcpl: Make '=' work when one argument is a list and
 on a vector.

The code is ugly, though, and won't support hashmaps nicely.
---
 impls/bcpl/types.b | 19 ++++++++++++++-----
 1 file changed, 14 insertions(+), 5 deletions(-)

diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index cc020f7ee1..6fe206f758 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -87,13 +87,9 @@ LET str_eq_const(val, bcplstr) = VALOF
   RESULTIS TRUE
 }
 
-LET equal(a, b) = VALOF
+LET equal_scalar(a, b) = VALOF
 { LET len = ?
   UNLESS type OF a = type OF b RESULTIS FALSE
-  SWITCHON supertype OF a INTO
-  { CASE t_lst: RESULTIS equal_lst(a, b)
-    CASE t_vec: RESULTIS equal_vec(a, b)
-  }
   len := VALOF SWITCHON supertype OF a INTO
   { CASE t_nil: RESULTIS 1
     CASE t_int: RESULTIS int_sz
@@ -108,6 +104,19 @@ LET equal(a, b) = VALOF
   RESULTIS TRUE
 }
 
+LET equal(a, b) = VALOF SWITCHON supertype OF a INTO
+  { CASE t_lst:
+      IF supertype OF b = t_lst | supertype OF b = t_vec THEN
+        RESULTIS equal_lst(a, as_lst(b))
+      RESULTIS FALSE
+    CASE t_vec:
+      IF supertype OF b = t_lst RESULTIS equal_lst(as_lst(a), b)
+      IF supertype OF b = t_vec RESULTIS equal_vec(a, b)
+      RESULTIS FALSE
+    DEFAULT:
+      RESULTIS equal_scalar(a, b)
+  }
+  
 AND equal_lst(a, b) = VALOF
 { IF a = b = empty RESULTIS TRUE
   IF a = empty | b = empty RESULTIS FALSE

From 17a0ef9abfb3e7a38f2f66200bcd47ce88091314 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Wed, 17 Jul 2019 23:26:45 +0100
Subject: [PATCH 060/148] bcpl: Split out list/vector comparision into its own
 function.

Now equal() handles comparisons between matching types, and bales out
to equal_mixed for the weird cases where differently-typed values can
be equal.
---
 impls/bcpl/types.b | 29 +++++++++++++++++------------
 1 file changed, 17 insertions(+), 12 deletions(-)

diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index 6fe206f758..9e0d7c8a2a 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -104,19 +104,24 @@ LET equal_scalar(a, b) = VALOF
   RESULTIS TRUE
 }
 
-LET equal(a, b) = VALOF SWITCHON supertype OF a INTO
-  { CASE t_lst:
-      IF supertype OF b = t_lst | supertype OF b = t_vec THEN
-        RESULTIS equal_lst(a, as_lst(b))
-      RESULTIS FALSE
-    CASE t_vec:
-      IF supertype OF b = t_lst RESULTIS equal_lst(as_lst(a), b)
-      IF supertype OF b = t_vec RESULTIS equal_vec(a, b)
-      RESULTIS FALSE
-    DEFAULT:
-      RESULTIS equal_scalar(a, b)
+LET equal(a, b) = VALOF
+{ UNLESS type OF a = type OF b RESULTIS equal_mixed(a, b)
+  SWITCHON type OF a INTO
+  { CASE t_lst: RESULTIS equal_lst(a, b)
+    CASE t_vec: RESULTIS equal_vec(a, b)
+    DEFAULT:    RESULTIS equal_scalar(a, b)
   }
-  
+}
+
+AND equal_mixed(a, b) = VALOF
+{ // Mostly, values of different types are unequal.  However mal has a
+  // special rule that a vector and a list are equal if they have the same
+  // contents.
+  IF type OF a = t_lst & type OF b = t_vec RESULTIS equal_lst(a, as_lst(b))
+  IF type OF a = t_vec & type OF b = t_lst RESULTIS equal_lst(as_lst(a), b)
+  RESULTIS FALSE
+}
+
 AND equal_lst(a, b) = VALOF
 { IF a = b = empty RESULTIS TRUE
   IF a = empty | b = empty RESULTIS FALSE

From 4568327fce9f738ded908fdc1696881c64b95414 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Wed, 17 Jul 2019 23:41:44 +0100
Subject: [PATCH 061/148] bcpl: More efficient list/vector comparison.

It's rather memory-inefficient to compare a list and a vector by first
converting the vector into a list.  Better to have a dedicated
comparison function that knows how to walk them both at once.
---
 impls/bcpl/types.b | 13 +++++++++++--
 1 file changed, 11 insertions(+), 2 deletions(-)

diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index 9e0d7c8a2a..8a2cb9b1f0 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -117,8 +117,8 @@ AND equal_mixed(a, b) = VALOF
 { // Mostly, values of different types are unequal.  However mal has a
   // special rule that a vector and a list are equal if they have the same
   // contents.
-  IF type OF a = t_lst & type OF b = t_vec RESULTIS equal_lst(a, as_lst(b))
-  IF type OF a = t_vec & type OF b = t_lst RESULTIS equal_lst(as_lst(a), b)
+  IF type OF a = t_lst & type OF b = t_vec RESULTIS equal_lstvec(a, b)
+  IF type OF a = t_vec & type OF b = t_lst RESULTIS equal_lstvec(b, a)
   RESULTIS FALSE
 }
 
@@ -136,6 +136,15 @@ AND equal_vec(a, b) = VALOF
   RESULTIS TRUE
 }
 
+AND equal_lstvec(l, v) = VALOF
+{ FOR i = 0 TO v!vec_len - 1 DO
+  { IF l = empty RESULTIS FALSE
+    UNLESS equal(l!lst_first, (v + vec_data)!i) RESULTIS FALSE
+    l := l!lst_rest
+  }
+  RESULTIS l = empty
+}
+
 LET alloc_vec(len) = VALOF
 { LET result = getvec(vec_data + len)
   !result := 0

From 78543b2fd157f87e8a6d1024dacd735e8c807d1d Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Wed, 17 Jul 2019 23:44:25 +0100
Subject: [PATCH 062/148] bcpl: Replace (tail) recursion in equal_lst with a
 loop.

---
 impls/bcpl/types.b | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index 8a2cb9b1f0..fc468e2456 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -126,8 +126,8 @@ AND equal_lst(a, b) = VALOF
 { IF a = b = empty RESULTIS TRUE
   IF a = empty | b = empty RESULTIS FALSE
   UNLESS equal(a!lst_first, b!lst_first) RESULTIS FALSE
-  RESULTIS equal_lst(a!lst_rest, b!lst_rest)
-}
+  a, b := a!lst_rest, b!lst_rest
+} REPEAT
 
 AND equal_vec(a, b) = VALOF
 { UNLESS a!vec_len = b!vec_len RESULTIS FALSE

From f602398744dd6b035eb92ba81f24953b19b39f4e Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Thu, 18 Jul 2019 00:01:36 +0100
Subject: [PATCH 063/148] bcpl: Support for keywords.

---
 impls/bcpl/malhdr.h  |  5 +++--
 impls/bcpl/printer.b |  6 ++++++
 impls/bcpl/reader.b  |  7 +++++--
 impls/bcpl/types.b   | 19 ++++++++++++++++---
 4 files changed, 30 insertions(+), 7 deletions(-)

diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index daa95aa947..fc888dc895 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -5,7 +5,7 @@ GLOBAL { readline: ug
 	 equal
 	 cons; nth; as_lst
 	 alloc_int
-	 str_setlen; alloc_str; str_bcpl2mal; as_sym; str_eq_const
+	 str_setlen; alloc_str; str_bcpl2mal; as_sym; as_kwd; str_eq_const
 	 hm_set; hm_contains; hm_get
 	 alloc_vec
 	 alloc_fun
@@ -43,8 +43,9 @@ MANIFEST
   // first byte of the string is also the length if it will fit.
   t_str = #x02; str_len = 1; str_data = 2
 
-  // Symbols.  Symbols are like strings, but with a different type.
+  // Symbols and keywords.  Like strings, but with different types.
   t_sym = #x12
+  t_kwd = #x22
 
   maxbcplstrlen = (1 << (BITSPERBCPLWORD / bytesperword)) - 1
 
diff --git a/impls/bcpl/printer.b b/impls/bcpl/printer.b
index 3360ee9297..135af3f1a2 100644
--- a/impls/bcpl/printer.b
+++ b/impls/bcpl/printer.b
@@ -73,6 +73,11 @@ LET print_sym(sym, buf, pos, count_only) = VALOF
   RESULTIS pos + sym!str_len
 }
 
+LET print_kwd(kwd, buf, pos, count_only) = VALOF
+{ pos := print_char(':', buf, pos, count_only)
+  RESULTIS print_sym(kwd, buf, pos, count_only)
+}
+
 LET print_lst(lst, buf, pos, count_only) = VALOF
 { pos := print_char('(', buf, pos, count_only)
   UNLESS lst = empty DO
@@ -129,6 +134,7 @@ AND print_form(val, buf, pos, count_only) = VALOF
     CASE t_int: RESULTIS print_int(val, buf, pos, count_only)
     CASE t_str: RESULTIS print_str(val, buf, pos, count_only)
     CASE t_sym: RESULTIS print_sym(val, buf, pos, count_only)
+    CASE t_kwd: RESULTIS print_kwd(val, buf, pos, count_only)
     CASE t_fun: RESULTIS print_const("#<function>", buf, pos, count_only)
     DEFAULT: RESULTIS print_const("<unprintable>", buf, pos, count_only)
   }
diff --git a/impls/bcpl/reader.b b/impls/bcpl/reader.b
index d6194d09eb..01a458917b 100644
--- a/impls/bcpl/reader.b
+++ b/impls/bcpl/reader.b
@@ -41,8 +41,8 @@ LET tokenize(s) = VALOF
         LOOP
       CASE '*"': // String
         p := p + (sd%p = '\' -> 2, 1) REPEATUNTIL p > s!str_len | sd%p = '*"'
-        ENDCASE     
-      DEFAULT: // Symbol or number
+        ENDCASE
+      DEFAULT: // Symbol, keyword, or number
         UNTIL p > s!str_len DO
         { SWITCHON sd%p INTO
           { CASE ' ': CASE '*t': CASE '*n': CASE ',':
@@ -95,6 +95,8 @@ LET read_string(token) = VALOF
   RESULTIS out
 }
 
+LET read_keyword(token) = as_kwd(newsubstr(token, 2, token!str_len + 1))
+
 LET read_number_maybe(token) = VALOF
 { LET sd, start, negative, acc = token + str_data, 1, FALSE, 0
   IF sd%1 = '-' THEN
@@ -125,6 +127,7 @@ LET read_number_maybe(token) = VALOF
 LET read_atom(rdr) = VALOF
 { LET token, maybenum = reader_next(rdr), ?
   IF (token + str_data)%1 = '*"' THEN RESULTIS read_string(token)
+  IF (token + str_data)%1 = ':' THEN RESULTIS read_keyword(token)
   maybenum := read_number_maybe(token)
   UNLESS maybenum = nil RESULTIS maybenum
   IF str_eq_const(token, "nil")   RESULTIS nil
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index fc468e2456..c53ee66200 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -62,16 +62,29 @@ LET alloc_str(len) = VALOF
   RESULTIS result
 }
 
+LET str_dup(val) = VALOF
+{ LET new = alloc_str(val!str_len)
+  FOR i = 1 TO str_data + val!str_len / bytesperword DO
+    new!i := val!i
+  RESULTIS new
+}
+
 LET as_sym(val) = VALOF
 { LET sym = ?
   IF type OF val = t_sym THEN RESULTIS val
-  sym := alloc_str(val!str_len)
+  sym := str_dup(val)
   type OF sym := t_sym
-  FOR i = 1 TO str_data + val!str_len / bytesperword DO
-    sym!i := val!i
   RESULTIS sym
 }
 
+LET as_kwd(val) = VALOF
+{ LET kwd = ?
+  IF type OF val = t_kwd THEN RESULTIS val
+  kwd := str_dup(val)
+  type OF kwd := t_kwd
+  RESULTIS kwd
+}
+
 LET str_bcpl2mal(bcplstr) = VALOF
 { LET result = alloc_str(bcplstr%0)
   result!str_len := bcplstr%0

From 9b18b17e9c6175ff10ddbaa7ea742f5862ffab62 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Thu, 18 Jul 2019 23:59:59 +0100
Subject: [PATCH 064/148] bcpl: Be more careful about truth values.

The BCPL book says that conditional commands like IF are only defined
to work properly if passed TRUE or FALSE.  This means that the result
of OF is generally not safe to pass straight to IF, and must be
compared first.
---
 impls/bcpl/types.b | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index c53ee66200..b5b01c2dfb 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -244,7 +244,7 @@ LET hm_insert(map, bit, key, value) = VALOF
 
 LET hm_set(map, key, value) = VALOF
 { LET bit, nearest = ?, ?
-  IF compoundflag OF key THEN throwf("invalid hash-map key: %v", key)
+  IF compoundflag OF key = 1 THEN throwf("invalid hash-map key: %v", key)
   IF map = empty_hashmap RESULTIS alloc_hmx(key, value)
   nearest := hm_find(map, key)
   IF equal(nearest!hmx_key, key) THEN RESULTIS hm_replace(map, key, value)
@@ -253,7 +253,7 @@ LET hm_set(map, key, value) = VALOF
 }
 
 LET hm_remove(map, key) = VALOF
-{ IF compoundflag OF key THEN throwf("invalid hash-map key: %v", key)
+{ IF compoundflag OF key = 1 THEN throwf("invalid hash-map key: %v", key)
   IF map = empty_hashmap RESULTIS map
   IF type OF map = t_hmx THEN
     RESULTIS equal(map!hmx_key, key) -> empty_hashmap, map
@@ -269,14 +269,14 @@ LET hm_remove(map, key) = VALOF
 }
 
 LET hm_get(map, key) = VALOF
-{ IF compoundflag OF key THEN throwf("invalid hash-map key: %v", key)
+{ IF compoundflag OF key = 1 THEN throwf("invalid hash-map key: %v", key)
   IF map = empty_hashmap RESULTIS nil
   map := hm_find(map, key)
   RESULTIS equal(map!hmx_key, key) -> map!hmx_value, nil
 }
 
 LET hm_contains(map, key) = VALOF
-{ IF compoundflag OF key THEN throwf("invalid hash-map key: %v", key)
+{ IF compoundflag OF key = 1 THEN throwf("invalid hash-map key: %v", key)
   IF map = empty_hashmap RESULTIS FALSE
   map := hm_find(map, key)
   RESULTIS equal(map!hmx_key, key)

From 18d72acb62a3daeb31df676d6171f490603f2e4e Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Fri, 19 Jul 2019 00:00:20 +0100
Subject: [PATCH 065/148] bcpl: Add 'pr-str' core function.

---
 impls/bcpl/core.b    |  6 ++++--
 impls/bcpl/malhdr.h  |  2 +-
 impls/bcpl/printer.b | 20 +++++++++++++++++---
 3 files changed, 22 insertions(+), 6 deletions(-)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index 2a3f9ecbfb..50b0cd0589 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -104,11 +104,13 @@ LET core_env() = VALOF
   }
 
   // Printing functions
-  { LET prn(fn, args) = VALOF
-    { writes(@(pr_str(args!lst_first)!str_data))
+  { LET prstr(fn, args) = pr_multi(args)
+    LET prn(fn, args) = VALOF
+    { writes(@(pr_multi(args)!str_data))
       newline()
       RESULTIS nil
     }
+    def(env, "pr-str", bare_fun(prstr))
     def(env, "prn", bare_fun(prn))
   }
 
diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index fc888dc895..4ece2dc968 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -1,5 +1,5 @@
 GLOBAL { readline: ug
-         pr_str; throwf
+         pr_str; pr_multi; throwf
          read_str
          init_types; nil; empty; empty_hashmap; mtrue; mfalse
 	 equal
diff --git a/impls/bcpl/printer.b b/impls/bcpl/printer.b
index 135af3f1a2..38fab3a1af 100644
--- a/impls/bcpl/printer.b
+++ b/impls/bcpl/printer.b
@@ -139,14 +139,28 @@ AND print_form(val, buf, pos, count_only) = VALOF
     DEFAULT: RESULTIS print_const("<unprintable>", buf, pos, count_only)
   }
 
-LET pr_str(x) = VALOF
-{ LET count = print_form(x, 0, 0, TRUE)
+LET print_multi(lst, buf, pos, count_only) = VALOF
+{ UNLESS lst = empty DO
+  { pos := print_form(lst!lst_first, buf, pos, count_only)
+    lst := lst!lst_rest
+    IF lst = empty BREAK
+    pos := print_char(' ', buf, pos, count_only)
+  } REPEAT
+  RESULTIS pos
+}
+
+LET pr(x, printer) = VALOF
+{ LET count = printer(x, 0, 0, TRUE)
   LET out = alloc_str(count)
-  print_form(x, out + str_data, 1, FALSE)
+  printer(x, out + str_data, 1, FALSE)
   str_setlen(out, count)
   RESULTIS out
 }
 
+LET pr_str(x) = pr(x, print_form)
+
+LET pr_multi(x) = pr(x, print_multi)
+
 LET print_f(msg, buf, pos, count_only, A) = VALOF
 { FOR i = 1 TO msg%0 DO
   { IF msg%i = '%' & i < msg%0 THEN SWITCHON msg%(i + 1) INTO

From 92b8e6c89559f9e9ad6e1ab814bea3e93a3c9ea7 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 23 Jul 2019 17:46:20 +0100
Subject: [PATCH 066/148] bcpl: Printing system rework.  Now printer context is
 in a vector.

Rather than passing the buffer, position, and count-only flag in
arguments to each function of the printing system, stuff them into a
vector and pass around a pointer to this.  This should make adding
additional context (primarily the print-readably flag) easier.
---
 impls/bcpl/printer.b | 179 ++++++++++++++++++++++---------------------
 1 file changed, 90 insertions(+), 89 deletions(-)

diff --git a/impls/bcpl/printer.b b/impls/bcpl/printer.b
index 38fab3a1af..5cb4a294c8 100644
--- a/impls/bcpl/printer.b
+++ b/impls/bcpl/printer.b
@@ -8,25 +8,27 @@ GET "malhdr"
 // if count_only is FALSE, then routine will write result to buf
 // in any case, pos is new output offset.
 
+MANIFEST { pc_pos = 0; pc_buf; pc_count_only; pc_sz }
+
 // Print a BCPL-format (constant) string.
-LET print_const(str, buf, pos, count_only) = VALOF
-{ UNLESS count_only DO
+LET print_const(pc, str) BE
+{ UNLESS pc!pc_count_only DO
     FOR i = 1 TO str%0 DO
-      buf%(pos + i - 1) := str%i
-  RESULTIS pos + str%0
+      pc!pc_buf%(pc!pc_pos + i - 1) := str%i
+  pc!pc_pos := pc!pc_pos + str%0
 }
 
 // Print a single character
-LET print_char(chr, buf, pos, count_only) = VALOF
-{ UNLESS count_only DO buf%pos := chr
-  RESULTIS pos + 1
+LET print_char(pc, chr) BE
+{ UNLESS pc!pc_count_only DO pc!pc_buf%(pc!pc_pos) := chr
+  pc!pc_pos := pc!pc_pos + 1
 }
 
 // Print a mal integer
-LET print_int(int, buf, pos, count_only) = VALOF
+LET print_int(pc, int) BE
 { LET val = int!int_value
   LET len, negative = 0, FALSE
-  IF val = 0 RESULTIS print_char('0', buf, pos, count_only)
+  IF val = 0 THEN { print_char(pc, '0'); RETURN }
   IF val < 0 THEN
   { val := -val // XXX This doesnt work for the most negative integer
     len := len + 1
@@ -36,147 +38,146 @@ LET print_int(int, buf, pos, count_only) = VALOF
   { val := val / 10
     len := len + 1
   }
-  IF count_only RESULTIS pos + len
+  IF pc!pc_count_only THEN { pc!pc_pos := pc!pc_pos + len; RETURN }
   val := negative -> -int!int_value, int!int_value
-  pos := pos + len - 1
+  pc!pc_pos := pc!pc_pos + len - 1
   WHILE val > 0 DO
-  { buf%pos :=
+  { pc!pc_buf%(pc!pc_pos) :=
         (TABLE '0', '1', '2', '3', '4', '5', '6', '7', '8', '9')!(val REM 10)
     val := val / 10
-    pos := pos - 1
+    pc!pc_pos := pc!pc_pos - 1
   }
   IF negative THEN
-  { buf%pos := '-'
-    pos := pos - 1
+  { pc!pc_buf%(pc!pc_pos) := '-'
+    pc!pc_pos := pc!pc_pos - 1
   }
-  RESULTIS pos + len + 1
+  pc!pc_pos := pc!pc_pos + len + 1
 }
 
 // Print a mal string
-LET print_str(str, buf, pos, count_only) = VALOF
-{ pos := print_char('*"', buf, pos, count_only)
+LET print_str(pc, str) BE
+{ print_char(pc, '*"')
   FOR i = 1 TO str!str_len DO
   { LET ch = (str + str_data)%i
     SWITCHON ch INTO
     { CASE '*n': ch := 'n'
-      CASE '\': CASE '*"': pos := print_char('\', buf, pos, count_only)
+      CASE '\': CASE '*"': print_char(pc, '\')
     }
-    pos := print_char(ch, buf, pos, count_only)
+    print_char(pc, ch)
   }
-  RESULTIS print_char('*"', buf, pos, count_only)
+  print_char(pc, '*"')
 }
 
-LET print_sym(sym, buf, pos, count_only) = VALOF
-{ UNLESS count_only DO
+LET print_sym(pc, sym) BE
+{ UNLESS pc!pc_count_only DO
     FOR i = 1 TO sym!str_len DO
-      buf%(pos + i - 1) := (sym + str_data)%i
-  RESULTIS pos + sym!str_len
+      pc!pc_buf%(pc!pc_pos + i - 1) := (sym + str_data)%i
+  pc!pc_pos := pc!pc_pos + sym!str_len
 }
 
-LET print_kwd(kwd, buf, pos, count_only) = VALOF
-{ pos := print_char(':', buf, pos, count_only)
-  RESULTIS print_sym(kwd, buf, pos, count_only)
+LET print_kwd(pc, kwd) BE
+{ print_char(pc, ':')
+  print_sym(pc, kwd)
 }
 
-LET print_lst(lst, buf, pos, count_only) = VALOF
-{ pos := print_char('(', buf, pos, count_only)
+LET print_lst(pc, lst) BE
+{ print_char(pc, '(')
   UNLESS lst = empty DO
-  { pos := print_form(lst!lst_first, buf, pos, count_only)
+  { print_form(pc, lst!lst_first)
     lst := lst!lst_rest
     IF lst = empty BREAK
-    pos := print_char(' ', buf, pos, count_only)
+    print_char(pc, ' ')
   } REPEAT
-  RESULTIS print_char(')', buf, pos, count_only)
+  print_char(pc, ')')
 }
 
-AND print_vec(vec, buf, pos, count_only) = VALOF
-{ pos := print_char('[', buf, pos, count_only)
+AND print_vec(pc, vec) BE
+{ print_char(pc, '[')
   FOR i = vec_data TO vec_data + vec!vec_len - 1 DO
-  { UNLESS i = vec_data DO pos := print_char(' ', buf, pos, count_only)
-    pos := print_form(vec!i, buf, pos, count_only)
+  { UNLESS i = vec_data DO print_char(pc, ' ')
+    print_form(pc, vec!i)
   }
-  RESULTIS print_char(']', buf, pos, count_only)
+  print_char(pc, ']')
 }
 
-AND print_hmx_contents(map, buf, pos, count_only) = VALOF
-{ pos := print_form(map!hmx_key, buf, pos, count_only)
-  pos := print_char(' ', buf, pos, count_only)
-  RESULTIS print_form(map!hmx_value, buf, pos, count_only)
+AND print_hmx_contents(pc, map) BE
+{ print_form(pc, map!hmx_key)
+  print_char(pc, ' ')
+  print_form(pc, map!hmx_value)
 }
 
-AND print_hmi_contents(map, buf, pos, count_only) = VALOF
-{ pos := print_hm_contents(map!hmi_left, buf, pos, count_only)
-  pos := print_char(' ', buf, pos, count_only)
-  RESULTIS print_hm_contents(map!hmi_right, buf, pos, count_only)
+AND print_hmi_contents(pc, map) BE
+{ print_hm_contents(pc, map!hmi_left)
+  print_char(pc, ' ')
+  print_hm_contents(pc, map!hmi_right)
 }
 
-AND print_hm_contents(map, buf, pos, count_only) =
-  type OF map = t_hmi -> print_hmi_contents(map, buf, pos, count_only),
-                         print_hmx_contents(map, buf, pos, count_only)
+AND print_hm_contents(pc, map) BE
+  TEST type OF map = t_hmi THEN print_hmi_contents(pc, map)
+                           ELSE print_hmx_contents(pc, map)
 
-AND print_hm(map, buf, pos, count_only) = VALOF
-{ pos := print_char('{', buf, pos, count_only)
-  pos := print_hm_contents(map, buf, pos, count_only)
-  RESULTIS print_char('}', buf, pos, count_only)
+AND print_hm(pc, map) BE
+{ print_char(pc, '{')
+  print_hm_contents(pc, map)
+  print_char(pc, '}')
 }
 
-AND print_form(val, buf, pos, count_only) = VALOF
+AND print_form(pc, val) BE
   SWITCHON type OF val INTO
   {
-    CASE t_nil: RESULTIS print_const("nil", buf, pos, count_only)
-    CASE t_boo: RESULTIS print_const(val!int_value -> "true", "false",
-                                     buf, pos, count_only)
-    CASE t_lst: RESULTIS print_lst(val, buf, pos, count_only)
-    CASE t_vec: RESULTIS print_vec(val, buf, pos, count_only)
-    CASE t_hm0: RESULTIS print_const("{}", buf, pos, count_only)
+    CASE t_nil: print_const(pc, "nil"); ENDCASE
+    CASE t_boo: print_const(pc, val!int_value -> "true", "false"); ENDCASE
+    CASE t_lst: print_lst(pc, val); ENDCASE
+    CASE t_vec: print_vec(pc, val); ENDCASE
+    CASE t_hm0: print_const(pc, "{}"); ENDCASE
     CASE t_hmi:
-    CASE t_hmx: RESULTIS print_hm (val, buf, pos, count_only)
-    CASE t_int: RESULTIS print_int(val, buf, pos, count_only)
-    CASE t_str: RESULTIS print_str(val, buf, pos, count_only)
-    CASE t_sym: RESULTIS print_sym(val, buf, pos, count_only)
-    CASE t_kwd: RESULTIS print_kwd(val, buf, pos, count_only)
-    CASE t_fun: RESULTIS print_const("#<function>", buf, pos, count_only)
-    DEFAULT: RESULTIS print_const("<unprintable>", buf, pos, count_only)
+    CASE t_hmx: print_hm (pc, val); ENDCASE
+    CASE t_int: print_int(pc, val); ENDCASE
+    CASE t_str: print_str(pc, val); ENDCASE
+    CASE t_sym: print_sym(pc, val); ENDCASE
+    CASE t_kwd: print_kwd(pc, val); ENDCASE
+    CASE t_fun: print_const(pc, "#<function>"); ENDCASE
+    DEFAULT: print_const(pc, "<unprintable>"); ENDCASE
   }
 
-LET print_multi(lst, buf, pos, count_only) = VALOF
+LET print_multi(pc, lst) BE
 { UNLESS lst = empty DO
-  { pos := print_form(lst!lst_first, buf, pos, count_only)
+  { print_form(pc, lst!lst_first)
     lst := lst!lst_rest
     IF lst = empty BREAK
-    pos := print_char(' ', buf, pos, count_only)
+    print_char(pc, ' ')
   } REPEAT
-  RESULTIS pos
 }
 
-LET pr(x, printer) = VALOF
-{ LET count = printer(x, 0, 0, TRUE)
-  LET out = alloc_str(count)
-  printer(x, out + str_data, 1, FALSE)
-  str_setlen(out, count)
+LET pr(printer, x, A) = VALOF
+{ LET pc = VEC pc_sz
+  LET out = ?
+  pc!pc_pos := 0
+  pc!pc_count_only := TRUE
+  printer(pc, x, A)
+
+  out := alloc_str(pc!pc_pos)
+  pc!pc_buf := out + str_data
+  pc!pc_pos := 1
+  pc!pc_count_only := FALSE
+  printer(pc, x, A)
+  str_setlen(out, pc!pc_pos - 1)
   RESULTIS out
 }
 
-LET pr_str(x) = pr(x, print_form)
+LET pr_str(x) = pr(print_form, x)
 
-LET pr_multi(x) = pr(x, print_multi)
+LET pr_multi(x) = pr(print_multi, x)
 
-LET print_f(msg, buf, pos, count_only, A) = VALOF
+LET print_f(pc, msg, A) BE
 { FOR i = 1 TO msg%0 DO
   { IF msg%i = '%' & i < msg%0 THEN SWITCHON msg%(i + 1) INTO
       { CASE 'v':
-          pos := print_form(A, buf, pos, count_only)
+          print_form(pc, A)
 	  i := i + 1; LOOP
       }
-    pos := print_char(msg%i, buf, pos, count_only)
+    print_char(pc, msg%i)
   }
-  RESULTIS pos
 }
 
-LET throwf(msg, A) BE
-{ LET count = print_f(msg, 0, 0, TRUE, A)
-  LET out = alloc_str(count)
-  print_f(msg, out+str_data, 1, FALSE, A)
-  str_setlen(out, count)
-  throw(out)
-}
\ No newline at end of file
+LET throwf(msg, A) BE throw(pr(print_f, msg, A))

From c0edf254dee74f1693687cbed907bbfab3b51977 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 23 Jul 2019 18:50:20 +0100
Subject: [PATCH 067/148] bcpl: Add 'str' and 'println' core functions.

---
 impls/bcpl/core.b    | 12 ++++++++++--
 impls/bcpl/printer.b | 16 +++++++++-------
 2 files changed, 19 insertions(+), 9 deletions(-)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index 50b0cd0589..4808a98604 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -104,14 +104,22 @@ LET core_env() = VALOF
   }
 
   // Printing functions
-  { LET prstr(fn, args) = pr_multi(args)
+  { LET prstr(fn, args) = pr_multi(args, TRUE, TRUE)
+    LET str(fn, args) = pr_multi(args, FALSE, FALSE)
     LET prn(fn, args) = VALOF
-    { writes(@(pr_multi(args)!str_data))
+    { writes(@(pr_multi(args, TRUE, TRUE)!str_data))
+      newline()
+      RESULTIS nil
+    }
+    LET println(fn, args) = VALOF
+    { writes(@(pr_multi(args, FALSE, TRUE)!str_data))
       newline()
       RESULTIS nil
     }
     def(env, "pr-str", bare_fun(prstr))
+    def(env, "str", bare_fun(str))
     def(env, "prn", bare_fun(prn))
+    def(env, "println", bare_fun(println))
   }
 
   // Constructors
diff --git a/impls/bcpl/printer.b b/impls/bcpl/printer.b
index 5cb4a294c8..0ad927a7f6 100644
--- a/impls/bcpl/printer.b
+++ b/impls/bcpl/printer.b
@@ -8,7 +8,7 @@ GET "malhdr"
 // if count_only is FALSE, then routine will write result to buf
 // in any case, pos is new output offset.
 
-MANIFEST { pc_pos = 0; pc_buf; pc_count_only; pc_sz }
+MANIFEST { pc_pos = 0; pc_buf; pc_count_only; pc_print_readably; pc_sz }
 
 // Print a BCPL-format (constant) string.
 LET print_const(pc, str) BE
@@ -133,27 +133,28 @@ AND print_form(pc, val) BE
     CASE t_hmi:
     CASE t_hmx: print_hm (pc, val); ENDCASE
     CASE t_int: print_int(pc, val); ENDCASE
-    CASE t_str: print_str(pc, val); ENDCASE
+    CASE t_str: IF pc!pc_print_readably THEN { print_str(pc, val); ENDCASE }
     CASE t_sym: print_sym(pc, val); ENDCASE
     CASE t_kwd: print_kwd(pc, val); ENDCASE
     CASE t_fun: print_const(pc, "#<function>"); ENDCASE
     DEFAULT: print_const(pc, "<unprintable>"); ENDCASE
   }
 
-LET print_multi(pc, lst) BE
+LET print_multi(pc, lst, space) BE
 { UNLESS lst = empty DO
   { print_form(pc, lst!lst_first)
     lst := lst!lst_rest
     IF lst = empty BREAK
-    print_char(pc, ' ')
+    IF space THEN print_char(pc, ' ')
   } REPEAT
 }
 
-LET pr(printer, x, A) = VALOF
+LET pr(printer, x, print_readably, A) = VALOF
 { LET pc = VEC pc_sz
   LET out = ?
   pc!pc_pos := 0
   pc!pc_count_only := TRUE
+  pc!pc_print_readably := print_readably
   printer(pc, x, A)
 
   out := alloc_str(pc!pc_pos)
@@ -165,9 +166,10 @@ LET pr(printer, x, A) = VALOF
   RESULTIS out
 }
 
-LET pr_str(x) = pr(print_form, x)
+LET pr_str(x) = pr(print_form, x, TRUE)
 
-LET pr_multi(x) = pr(print_multi, x)
+LET pr_multi(x, print_readably, space) =
+  pr(print_multi, x, print_readably, space)
 
 LET print_f(pc, msg, A) BE
 { FOR i = 1 TO msg%0 DO

From 999859c9ae7744876b4f14cb407505f316d971b4 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 23 Jul 2019 19:03:20 +0100
Subject: [PATCH 068/148] bcpl: Tail-call optimisation for 'let*', 'do', and
 'if'.

---
 impls/bcpl/step5_tco.b | 118 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 118 insertions(+)
 create mode 100644 impls/bcpl/step5_tco.b

diff --git a/impls/bcpl/step5_tco.b b/impls/bcpl/step5_tco.b
new file mode 100644
index 0000000000..c5ee29295e
--- /dev/null
+++ b/impls/bcpl/step5_tco.b
@@ -0,0 +1,118 @@
+GET "libhdr"
+GET "malhdr"
+
+GET "core.b"
+GET "env.b"
+GET "printer.b"
+GET "reader.b"
+GET "readline.b"
+GET "types.b"
+
+LET READ(x) = read_str(x)
+
+// Helper function for EVAL.
+LET is_sym(a, b) = VALOF
+{ UNLESS type OF a = t_sym RESULTIS FALSE
+  RESULTIS str_eq_const(a, b)
+}
+
+LET eval_ast(ast, env) = VALOF
+  SWITCHON type OF ast INTO
+  { CASE t_sym: RESULTIS env_get(env, ast)
+    CASE t_lst:
+      TEST ast = empty THEN RESULTIS empty
+      ELSE RESULTIS cons(EVAL(ast!lst_first, env), eval_ast(ast!lst_rest, env))
+    CASE t_vec:
+      { LET new = alloc_vec(ast!vec_len)
+        FOR i = 0 TO ast!vec_len - 1 DO
+	  (new + vec_data)!i := EVAL((ast + vec_data)!i, env)
+	RESULTIS new
+      }
+    CASE t_hmx:
+      RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env))
+    CASE t_hmi:
+      RESULTIS alloc_hmi(hmi_critbit OF ast, eval_ast(ast!hmi_left, env),
+                                             eval_ast(ast!hmi_right, env))
+    DEFAULT: RESULTIS ast
+  }
+
+AND EVAL(ast, env) = VALOF
+{ UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env)
+  IF ast = empty RESULTIS ast
+  { LET fn = ast!lst_first
+    IF is_sym(fn, "def!") THEN
+    { LET val = EVAL(nth(ast, 2), env)
+      env_set(env, nth(ast, 1), val, env)
+      RESULTIS val
+    }
+    IF is_sym(fn, "let**") THEN
+    { LET newenv, bindings = env_new(env, empty, empty), as_lst(nth(ast, 1))
+      UNTIL bindings = empty DO
+      { env_set(newenv, bindings!lst_first, EVAL(nth(bindings, 1), newenv))
+        bindings := bindings!lst_rest!lst_rest
+      }
+      ast, env := nth(ast, 2), newenv
+      LOOP // TCO
+    }
+    IF is_sym(fn, "do") THEN
+    { LET tail = ast!lst_rest
+      UNTIL tail!lst_rest = empty DO
+      { EVAL(tail!lst_first, env)
+        tail := tail!lst_rest
+      }
+      ast := tail!lst_first
+      LOOP // TCO
+    }
+    IF is_sym(fn, "if") THEN
+    { LET cond, tail = EVAL(nth(ast, 1), env), ast!lst_rest!lst_rest
+      IF cond = nil | cond = mfalse THEN tail := tail!lst_rest
+      ast := tail!lst_first
+      LOOP // TCO
+    }
+    IF is_sym(fn, "fn**") THEN
+    { MANIFEST { fun_binds = fun_data; fun_body; fun_env; fun_sz }
+      LET call(fun, args) =
+          EVAL(fun!fun_body, env_new(fun!fun_env, fun!fun_binds, args))
+      LET result = alloc_fun(call, fun_sz,
+                             as_lst(nth(ast, 1)), nth(ast, 2), env)
+      RESULTIS result
+    }
+  }
+  ast := eval_ast(ast, env)
+  { LET fn, args = ast!lst_first, ast!lst_rest
+    UNLESS type OF fn = t_fun DO throwf("not a function")
+    RESULTIS (fn!fun_code)(fn, args)
+  }
+} REPEAT
+
+LET PRINT(x) = pr_str(x)
+
+LET rep(x, env) = PRINT(EVAL(READ(x), env))
+
+LET repl() BE
+{ LET prompt = str_bcpl2mal("user> ")
+  LET repl_env = ?
+  catch_level, catch_label := level(), uncaught
+  repl_env := core_env()
+  rep(str_bcpl2mal("(def! not (fn** (a) (if a false true)))"), repl_env)
+  IF FALSE THEN
+  { uncaught:
+    writes("Uncaught exception: ")
+    writes(@(pr_str(last_exception)!str_data))
+    newline()
+  }
+  { LET line = readline(prompt)
+    IF line = nil THEN BREAK
+    writes(@rep(line, repl_env)!str_data)
+    newline()
+  } REPEAT
+}
+
+LET start() = VALOF
+{ LET ch = 0
+  init_types()
+  ch := rdch() REPEATUNTIL ch = '*n' // Consume command-line args
+  wrch('*n') // Terminate prompt printed by Cintsys
+  repl()
+  RESULTIS 0
+}

From 9deddf3caa34bebc61a3b9b4df3f0c9b9535d20c Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Thu, 19 Sep 2019 22:56:45 +0100
Subject: [PATCH 069/148] bcpl: Beginnings of garbage collector

I've added the gc_marked flag to mal values (but not environments)
and also a pointer to make a list of allocated objects.
---
 impls/bcpl/malhdr.h     | 22 ++++++++++++++--------
 impls/bcpl/step2_eval.b |  2 +-
 impls/bcpl/step3_env.b  |  2 +-
 impls/bcpl/types.b      | 34 ++++++++++++++++++++++------------
 4 files changed, 38 insertions(+), 22 deletions(-)

diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index 4ece2dc968..fee1c0f1ed 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -23,17 +23,23 @@ MANIFEST
   // (for instance functions and macros).  The compoundflag is set on
   // compund types (ones containing references to other values).
   compoundflag = SLCT 1:3:0; supertype = SLCT 4:0:0; type = SLCT 8:0:0
+  gc_marked = SLCT 9:0:0
+
+  // The second work of each value is a pointer to the next element
+  // of the global object list.
+  nextptr = 1
 
   // Nil. There is a single nil value initialised by init_types(), but
   // it's a valid pointer so it can safely be dereferenced.
   t_nil = #x00
+  nil_sz = 2
 
   // Lists.  These are implemented as a linked list.  The empty list,
   // like nil, is a special value.
-  t_lst = #x08; lst_first = 1; lst_rest = 2; lst_sz = 3
+  t_lst = #x08; lst_first = 2; lst_rest = 3; lst_sz = 4
 
   // Integers.
-  t_int = #x01; int_value = 1; int_sz = 2
+  t_int = #x01; int_value = 2; int_sz = 3
 
   // Booleans.
   t_boo = #x11
@@ -41,7 +47,7 @@ MANIFEST
   // Strings.  Unlike conventional BCPL strings, these have an entire word
   // to store the length.  For compatibility with library routines, the
   // first byte of the string is also the length if it will fit.
-  t_str = #x02; str_len = 1; str_data = 2
+  t_str = #x02; str_len = 2; str_data = 3
 
   // Symbols and keywords.  Like strings, but with different types.
   t_sym = #x12
@@ -51,18 +57,18 @@ MANIFEST
 
   // Vectors.  Structured like strings except that the data consists of
   // pointers rather than packed characters.
-  t_vec = #x09; vec_len = 1; vec_data = 2
+  t_vec = #x09; vec_len = 2; vec_data = 3
 
   // Functions.  Contains a function which gets passed a pointer to
   // this structure and can do what it likes with it.
-  t_fun = #x0f; fun_code = 1; fun_data = 2
+  t_fun = #x0f; fun_code = 2; fun_data = 3
 
   // Hash-maps.  These are implemented as crit-bit trees.  There are three
   // types of node: internal nodes point to two other nodes and encode a
   // bit offset in the spare bits of the first word.  External nodes
   // point to a key and a value.  Empty nodes describe an empty hash-map.
-  t_hmi = #x0a; hmi_left = 1; hmi_right = 2; hmi_sz = 3
+  t_hmi = #x0a; hmi_left = 2; hmi_right = 3; hmi_sz = 4
   hmi_critbit = SLCT 0:8:0; hmi_maxcritbit = (1 << BITSPERBCPLWORD - 8) - 1
-  t_hmx = #x1a; hmx_key = 1; hmx_value = 2; hmx_sz = 3
-  t_hm0 = #x0b; hm0_sz = 1
+  t_hmx = #x1a; hmx_key = 2; hmx_value = 3; hmx_sz = 4
+  t_hm0 = #x0b; hm0_sz = 2
 }
diff --git a/impls/bcpl/step2_eval.b b/impls/bcpl/step2_eval.b
index f1fcef4748..ff8b97101c 100644
--- a/impls/bcpl/step2_eval.b
+++ b/impls/bcpl/step2_eval.b
@@ -43,7 +43,7 @@ LET PRINT(x) = pr_str(x)
 STATIC { add_fun; sub_fun; mul_fun; div_fun }
 
 LET init_core() BE
-{ MANIFEST { wf_wrapped = 2; wf_sz = 3 }
+{ MANIFEST { wf_wrapped = fun_data; wf_sz = fun_data + 1 }
   LET arith(fn, args) = VALOF
   { LET a, b = args!lst_first, args!lst_rest!lst_first
     UNLESS type OF a = type OF b = t_int DO
diff --git a/impls/bcpl/step3_env.b b/impls/bcpl/step3_env.b
index d0ad250676..547a6e5ce6 100644
--- a/impls/bcpl/step3_env.b
+++ b/impls/bcpl/step3_env.b
@@ -65,7 +65,7 @@ LET PRINT(x) = pr_str(x)
 STATIC { add_fun; sub_fun; mul_fun; div_fun }
 
 LET init_core() BE
-{ MANIFEST { wf_wrapped = 2; wf_sz = 3 }
+{ MANIFEST { wf_wrapped = fun_data; wf_sz = fun_data + 1 }
   LET arith(fn, args) = VALOF
   { LET a, b = args!lst_first, args!lst_rest!lst_first
     UNLESS type OF a = type OF b = t_int DO
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index b5b01c2dfb..94278c922d 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -2,16 +2,26 @@ GET "libhdr"
 GET "malhdr"
 
 LET init_types() BE
-{ nil := TABLE t_nil
-  empty := TABLE t_lst, ?, ?
+{ // These objects are statically-allocated and hence special.
+  // nil acts as the head and tail of the global object list.
+  nil := TABLE t_nil, ?
+  nil!nextptr := nil
+  empty := TABLE t_lst, ?, ?, ?
   empty!lst_first, empty!lst_rest := nil, empty
-  empty_hashmap := TABLE t_hm0
-  mtrue  := TABLE t_boo, TRUE
-  mfalse := TABLE t_boo, FALSE
+  empty_hashmap := TABLE t_hm0, ?
+  mtrue  := TABLE t_boo, ?, TRUE
+  mfalse := TABLE t_boo, ?, FALSE
+}
+
+LET alloc_val(size) = VALOF
+{ LET result = getvec(size)
+  result!nextptr := nil!nextptr
+  nil!nextptr := result
+  RESULTIS result
 }
 
 LET cons(first, rest) = VALOF
-{ LET result = getvec(lst_sz)
+{ LET result = alloc_val(lst_sz)
   !result := 0
   type OF result := t_lst
   result!lst_first := first
@@ -39,7 +49,7 @@ LET as_lst(x) = VALOF SWITCHON type OF x INTO
   
 
 LET alloc_int(value) = VALOF
-{ LET result = getvec(int_sz)
+{ LET result = alloc_val(int_sz)
   !result := 0
   type OF result := t_int
   result!int_value := value
@@ -53,7 +63,7 @@ LET str_setlen(str, len) BE
 
 LET alloc_str(len) = VALOF
 { LET words = str_data + 1 + len / bytesperword
-  LET result = getvec(words)
+  LET result = alloc_val(words)
   !result := 0
   result!(words - 1) := 0 // Make sure the unused part word at the end is 0.
   type OF result := t_str
@@ -159,7 +169,7 @@ AND equal_lstvec(l, v) = VALOF
 }
 
 LET alloc_vec(len) = VALOF
-{ LET result = getvec(vec_data + len)
+{ LET result = alloc_val(vec_data + len)
   !result := 0
   type OF result := t_vec
   result!vec_len := len
@@ -167,7 +177,7 @@ LET alloc_vec(len) = VALOF
 }
 
 LET alloc_fun(fn, sz, A, B, C) = VALOF
-{ LET result = getvec(sz)
+{ LET result = alloc_val(sz)
   LET p = @A
   !result := 0
   type OF result := t_fun
@@ -178,7 +188,7 @@ LET alloc_fun(fn, sz, A, B, C) = VALOF
 }
 
 LET alloc_hmx(key, value) = VALOF
-{ LET result = getvec(hmx_sz)
+{ LET result = alloc_val(hmx_sz)
   !result := 0
   type OF result := t_hmx
   result!hmx_key, result!hmx_value := key, value
@@ -186,7 +196,7 @@ LET alloc_hmx(key, value) = VALOF
 }
 
 LET alloc_hmi(critbit, left, right) = VALOF
-{ LET result = getvec(hmi_sz)
+{ LET result = alloc_val(hmi_sz)
   !result := 0
   type OF result := t_hmi
   hmi_critbit OF result := critbit

From 4561cdd1b58fa453fc5a2bcb13e817f3278b73f7 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sun, 26 Apr 2020 13:14:18 +0100
Subject: [PATCH 070/148] bcpl: Move the global object chain to the start of
 each object

Putting it in the middle makes comparisons unnecessarily complicated,
because it means that equivalent scalars have a differing word in the
middle.  Now they don't.
---
 impls/bcpl/malhdr.h | 14 +++++++-------
 impls/bcpl/types.b  | 14 ++++++++------
 2 files changed, 15 insertions(+), 13 deletions(-)

diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index fee1c0f1ed..ad8ed684cc 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -17,17 +17,17 @@ GLOBAL { readline: ug
 
 MANIFEST
 {
-  // The first word of any mal value indicates its type and suchlike.
+  // The first word of each value is a pointer to the next element
+  // of the global object list.
+  nextptr = 0
+
+  // The second word of any mal value indicates its type and suchlike.
   // The "supertype" indicates the meaning of the other words of the
   // value.  The "type" distinguishes mal types with the same supertype
   // (for instance functions and macros).  The compoundflag is set on
   // compund types (ones containing references to other values).
-  compoundflag = SLCT 1:3:0; supertype = SLCT 4:0:0; type = SLCT 8:0:0
-  gc_marked = SLCT 9:0:0
-
-  // The second work of each value is a pointer to the next element
-  // of the global object list.
-  nextptr = 1
+  compoundflag = SLCT 1:3:1; supertype = SLCT 4:0:1; type = SLCT 8:0:1
+  gc_marked = SLCT 9:0:1
 
   // Nil. There is a single nil value initialised by init_types(), but
   // it's a valid pointer so it can safely be dereferenced.
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index 94278c922d..35e99719e9 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -4,13 +4,13 @@ GET "malhdr"
 LET init_types() BE
 { // These objects are statically-allocated and hence special.
   // nil acts as the head and tail of the global object list.
-  nil := TABLE t_nil, ?
+  nil := TABLE ?, t_nil
   nil!nextptr := nil
-  empty := TABLE t_lst, ?, ?, ?
+  empty := TABLE ?, t_lst, ?, ?
   empty!lst_first, empty!lst_rest := nil, empty
-  empty_hashmap := TABLE t_hm0, ?
-  mtrue  := TABLE t_boo, ?, TRUE
-  mfalse := TABLE t_boo, ?, FALSE
+  empty_hashmap := TABLE ?, t_hm0
+  mtrue  := TABLE ?, t_boo, TRUE
+  mfalse := TABLE ?, t_boo, FALSE
 }
 
 LET alloc_val(size) = VALOF
@@ -122,7 +122,7 @@ LET equal_scalar(a, b) = VALOF
   // This is guaranteed not to walk off the end of b because any two mal
   // values with different lengths will differ before the point where
   // either of them ends.
-  FOR i = 0 TO len - 1 DO
+  FOR i = 1 TO len - 1 DO
     UNLESS a!i = b!i RESULTIS FALSE
   RESULTIS TRUE
 }
@@ -206,6 +206,8 @@ LET alloc_hmi(critbit, left, right) = VALOF
 
 LET key_bit(key, bit) = VALOF
 { LET offset, shift = bit / BITSPERBCPLWORD, bit REM BITSPERBCPLWORD
+  // Skip over the first word because it's not part of the value.
+  offset := offset + 1
   RESULTIS key!offset >> (BITSPERBCPLWORD - 1 - shift) & 1
 }
 

From d63e60a81ea741daef10cb7fe987642dc4d12029 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sun, 26 Apr 2020 13:16:12 +0100
Subject: [PATCH 071/148] bcpl: Add a debugging routine for dumping a hashmap

This should make debugging any future hashmap weirdness easier.
---
 impls/bcpl/types.b | 29 +++++++++++++++++++++++++++++
 1 file changed, 29 insertions(+)

diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index 35e99719e9..af23b52fc7 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -217,6 +217,35 @@ LET key_bitdiff(key1, key2) = VALOF
   RESULTIS bit
 }
 
+LET hm_pfx(pfx) BE
+  WHILE pfx > 0 DO
+  { writes(" ")
+    pfx := pfx - 1
+  }
+
+LET hm_dumpi(map, pfx, lastbit) BE
+{ hm_pfx(pfx)
+  TEST type OF map = t_hmi THEN
+  { writef("bit %n*n", hmi_critbit OF map)
+    hm_dumpi(map!hmi_left, pfx + 1,  hmi_critbit OF map)
+    hm_dumpi(map!hmi_right, pfx + 1,  hmi_critbit OF map)
+  }
+  ELSE
+  { LET p = map!hmx_key + 1
+    WHILE lastbit > 0 DO
+    { writef("%8x ", !p)
+      p := p + 1
+      lastbit := lastbit - BITSPERBCPLWORD
+    }
+    writes("*n")
+  }
+}
+
+LET hm_dump(map) BE
+{ TEST type OF map = t_hm0 THEN writes("[empty]*n")
+                           ELSE hm_dumpi(map, 0, 0)
+}
+
 // hm_find finds the nearest entry in a non-empty hash-map to
 // the key requested, and returns the entire entry.
 LET hm_find(map, key) = VALOF

From 87f1da052d888fdc09eb8e00fef9aa5d0837aede Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Mon, 27 Apr 2020 21:34:01 +0100
Subject: [PATCH 072/148] bcpl: Implement step 1 of my new garbage-collector
 guide

The REPL in step 1 now frees objects in each loop.
---
 impls/bcpl/malhdr.h           |  3 ++-
 impls/bcpl/step1_read_print.b |  7 ++++---
 impls/bcpl/types.b            | 18 +++++++++++-------
 3 files changed, 17 insertions(+), 11 deletions(-)

diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index ad8ed684cc..4b50fbe8d0 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -2,6 +2,7 @@ GLOBAL { readline: ug
          pr_str; pr_multi; throwf
          read_str
          init_types; nil; empty; empty_hashmap; mtrue; mfalse
+	 gc_sweep
 	 equal
 	 cons; nth; as_lst
 	 alloc_int
@@ -68,7 +69,7 @@ MANIFEST
   // bit offset in the spare bits of the first word.  External nodes
   // point to a key and a value.  Empty nodes describe an empty hash-map.
   t_hmi = #x0a; hmi_left = 2; hmi_right = 3; hmi_sz = 4
-  hmi_critbit = SLCT 0:8:0; hmi_maxcritbit = (1 << BITSPERBCPLWORD - 8) - 1
+  hmi_critbit = SLCT 0:8:1; hmi_maxcritbit = (1 << BITSPERBCPLWORD - 8) - 1
   t_hmx = #x1a; hmx_key = 2; hmx_value = 3; hmx_sz = 4
   t_hm0 = #x0b; hm0_sz = 2
 }
diff --git a/impls/bcpl/step1_read_print.b b/impls/bcpl/step1_read_print.b
index 1557f00598..1c4bd16ea2 100644
--- a/impls/bcpl/step1_read_print.b
+++ b/impls/bcpl/step1_read_print.b
@@ -15,18 +15,19 @@ LET PRINT(x) = pr_str(x)
 LET rep(x) = PRINT(EVAL(READ(x)))
 
 LET repl() BE
-{ LET prompt = str_bcpl2mal("user> ")
-  catch_level, catch_label := level(), uncaught
+{ catch_level, catch_label := level(), uncaught
   IF FALSE THEN
   { uncaught:
     writes("Uncaught exception: ")
     writes(@(pr_str(last_exception)!str_data))
     newline()
   }
-  { LET line = readline(prompt)
+  { LET prompt = str_bcpl2mal("user> ")
+    LET line = readline(prompt)
     IF line = nil THEN BREAK
     writes(@rep(line)!str_data)
     newline()
+    gc_sweep()
   } REPEAT
 }
 
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index af23b52fc7..7305ebc607 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -15,14 +15,24 @@ LET init_types() BE
 
 LET alloc_val(size) = VALOF
 { LET result = getvec(size)
+  result!1 := 0 // Make sure type word is all zeroes.
   result!nextptr := nil!nextptr
   nil!nextptr := result
+  // writef("ALLOC: <- %8x*n", result)
   RESULTIS result
 }
 
+LET gc_sweep() BE
+{ UNTIL nil!nextptr = nil DO
+  { LET val = nil!nextptr
+    nil!nextptr := val!nextptr
+    // writef("FREE : -> %8x (%8x)*n", val, val!1)
+    freevec(val)
+  }
+}
+
 LET cons(first, rest) = VALOF
 { LET result = alloc_val(lst_sz)
-  !result := 0
   type OF result := t_lst
   result!lst_first := first
   result!lst_rest := rest
@@ -50,7 +60,6 @@ LET as_lst(x) = VALOF SWITCHON type OF x INTO
 
 LET alloc_int(value) = VALOF
 { LET result = alloc_val(int_sz)
-  !result := 0
   type OF result := t_int
   result!int_value := value
   RESULTIS result
@@ -64,7 +73,6 @@ LET str_setlen(str, len) BE
 LET alloc_str(len) = VALOF
 { LET words = str_data + 1 + len / bytesperword
   LET result = alloc_val(words)
-  !result := 0
   result!(words - 1) := 0 // Make sure the unused part word at the end is 0.
   type OF result := t_str
   result!str_len := 0
@@ -170,7 +178,6 @@ AND equal_lstvec(l, v) = VALOF
 
 LET alloc_vec(len) = VALOF
 { LET result = alloc_val(vec_data + len)
-  !result := 0
   type OF result := t_vec
   result!vec_len := len
   RESULTIS result
@@ -179,7 +186,6 @@ LET alloc_vec(len) = VALOF
 LET alloc_fun(fn, sz, A, B, C) = VALOF
 { LET result = alloc_val(sz)
   LET p = @A
-  !result := 0
   type OF result := t_fun
   result!fun_code := fn
   FOR i = 0 TO sz - fun_data - 1
@@ -189,7 +195,6 @@ LET alloc_fun(fn, sz, A, B, C) = VALOF
 
 LET alloc_hmx(key, value) = VALOF
 { LET result = alloc_val(hmx_sz)
-  !result := 0
   type OF result := t_hmx
   result!hmx_key, result!hmx_value := key, value
   RESULTIS result
@@ -197,7 +202,6 @@ LET alloc_hmx(key, value) = VALOF
 
 LET alloc_hmi(critbit, left, right) = VALOF
 { LET result = alloc_val(hmi_sz)
-  !result := 0
   type OF result := t_hmi
   hmi_critbit OF result := critbit
   result!hmi_left, result!hmi_right := left, right

From 211aec635e2d3c43d951a656b5b6cbeea534ca5d Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 28 Apr 2020 21:04:40 +0100
Subject: [PATCH 073/148] bcpl: Convert step 2 to use a hash-map as "env"

This makes it closer to the guide and makes adding GC to it easier.  It
doesn't make the code any more complex.
---
 impls/bcpl/step2_eval.b | 23 +++++++++++------------
 1 file changed, 11 insertions(+), 12 deletions(-)

diff --git a/impls/bcpl/step2_eval.b b/impls/bcpl/step2_eval.b
index ff8b97101c..784f518c7d 100644
--- a/impls/bcpl/step2_eval.b
+++ b/impls/bcpl/step2_eval.b
@@ -10,7 +10,11 @@ LET READ(x) = read_str(x)
 
 LET eval_ast(ast, env) = VALOF
   SWITCHON type OF ast INTO
-  { CASE t_sym: RESULTIS env(ast)
+  { CASE t_sym:
+      { LET result = hm_get(env, ast)
+        IF result = nil THEN throw(str_bcpl2mal("unknown function"))
+	RESULTIS result
+      }
     CASE t_lst:
       TEST ast = empty THEN RESULTIS empty
       ELSE RESULTIS cons(EVAL(ast!lst_first, env), eval_ast(ast!lst_rest, env))
@@ -40,7 +44,7 @@ AND EVAL(ast, env) = VALOF
 
 LET PRINT(x) = pr_str(x)
 
-STATIC { add_fun; sub_fun; mul_fun; div_fun }
+STATIC { add_fun; sub_fun; mul_fun; div_fun; repl_env }
 
 LET init_core() BE
 { MANIFEST { wf_wrapped = fun_data; wf_sz = fun_data + 1 }
@@ -65,20 +69,15 @@ LET init_core() BE
   div_fun := arith_fun(div)
 }
 
-LET repl_env(key) = VALOF
-{ IF key!str_len = 1 SWITCHON (key + str_data)%1 INTO
-  { CASE '+':  RESULTIS add_fun
-    CASE '-':  RESULTIS sub_fun
-    CASE '**': RESULTIS mul_fun
-    CASE '/':  RESULTIS div_fun
-  }
-  throw(str_bcpl2mal("unknown function"))
-}
-
 LET rep(x) = PRINT(EVAL(READ(x), repl_env))
 
 LET repl() BE
 { LET prompt = str_bcpl2mal("user> ")
+  repl_env := empty_hashmap
+  repl_env := hm_set(repl_env, as_sym(str_bcpl2mal("+")), add_fun)
+  repl_env := hm_set(repl_env, as_sym(str_bcpl2mal("-")), sub_fun)
+  repl_env := hm_set(repl_env, as_sym(str_bcpl2mal("**")), mul_fun)
+  repl_env := hm_set(repl_env, as_sym(str_bcpl2mal("/")), div_fun)
   catch_level, catch_label := level(), uncaught
   IF FALSE THEN
   { uncaught:

From 4cca6197d5cd368d8fdd4ec1c5217c365a3e3059 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 28 Apr 2020 21:52:24 +0100
Subject: [PATCH 074/148] bcpl: Adjust steps to align better

This includes making repl_env STATIC and extending the "def" local
function back into step 2.
---
 impls/bcpl/step2_eval.b     | 10 ++++++----
 impls/bcpl/step3_env.b      | 18 +++++++++---------
 impls/bcpl/step4_if_fn_do.b |  9 +++++----
 impls/bcpl/step5_tco.b      |  9 +++++----
 4 files changed, 25 insertions(+), 21 deletions(-)

diff --git a/impls/bcpl/step2_eval.b b/impls/bcpl/step2_eval.b
index 784f518c7d..77f50e1d35 100644
--- a/impls/bcpl/step2_eval.b
+++ b/impls/bcpl/step2_eval.b
@@ -73,11 +73,13 @@ LET rep(x) = PRINT(EVAL(READ(x), repl_env))
 
 LET repl() BE
 { LET prompt = str_bcpl2mal("user> ")
+  LET def(name, value) BE
+    repl_env := hm_set(repl_env, as_sym(str_bcpl2mal(name)), value)
   repl_env := empty_hashmap
-  repl_env := hm_set(repl_env, as_sym(str_bcpl2mal("+")), add_fun)
-  repl_env := hm_set(repl_env, as_sym(str_bcpl2mal("-")), sub_fun)
-  repl_env := hm_set(repl_env, as_sym(str_bcpl2mal("**")), mul_fun)
-  repl_env := hm_set(repl_env, as_sym(str_bcpl2mal("/")), div_fun)
+  def("+",  add_fun)
+  def("-",  sub_fun)
+  def("**", mul_fun)
+  def("/",  div_fun)
   catch_level, catch_label := level(), uncaught
   IF FALSE THEN
   { uncaught:
diff --git a/impls/bcpl/step3_env.b b/impls/bcpl/step3_env.b
index 547a6e5ce6..4839681254 100644
--- a/impls/bcpl/step3_env.b
+++ b/impls/bcpl/step3_env.b
@@ -62,7 +62,7 @@ AND EVAL(ast, env) = VALOF
 
 LET PRINT(x) = pr_str(x)
 
-STATIC { add_fun; sub_fun; mul_fun; div_fun }
+STATIC { add_fun; sub_fun; mul_fun; div_fun; repl_env }
 
 LET init_core() BE
 { MANIFEST { wf_wrapped = fun_data; wf_sz = fun_data + 1 }
@@ -87,16 +87,16 @@ LET init_core() BE
   div_fun := arith_fun(div)
 }
 
-LET rep(x, env) = PRINT(EVAL(READ(x), env))
+LET rep(x) = PRINT(EVAL(READ(x), repl_env))
 
 LET repl() BE
 { LET prompt = str_bcpl2mal("user> ")
-  LET repl_env = env_new(nil, empty, empty)
-  LET def(env, name, value) BE env_set(env, as_sym(str_bcpl2mal(name)), value)
-  def(repl_env, "+",  add_fun)
-  def(repl_env, "-",  sub_fun)
-  def(repl_env, "**", mul_fun)
-  def(repl_env, "/",  div_fun)
+  LET def(name, value) BE env_set(repl_env, as_sym(str_bcpl2mal(name)), value)
+  repl_env := env_new(nil, empty, empty)
+  def("+",  add_fun)
+  def("-",  sub_fun)
+  def("**", mul_fun)
+  def("/",  div_fun)
   catch_level, catch_label := level(), uncaught
   IF FALSE THEN
   { uncaught:
@@ -106,7 +106,7 @@ LET repl() BE
   }
   { LET line = readline(prompt)
     IF line = nil THEN BREAK
-    writes(@rep(line, repl_env)!str_data)
+    writes(@rep(line)!str_data)
     newline()
   } REPEAT
 }
diff --git a/impls/bcpl/step4_if_fn_do.b b/impls/bcpl/step4_if_fn_do.b
index 8e878a7049..fbc1132a32 100644
--- a/impls/bcpl/step4_if_fn_do.b
+++ b/impls/bcpl/step4_if_fn_do.b
@@ -82,14 +82,15 @@ AND EVAL(ast, env) = VALOF
 
 LET PRINT(x) = pr_str(x)
 
-LET rep(x, env) = PRINT(EVAL(READ(x), env))
+STATIC { repl_env }
+
+LET rep(x) = PRINT(EVAL(READ(x), repl_env))
 
 LET repl() BE
 { LET prompt = str_bcpl2mal("user> ")
-  LET repl_env = ?
-  catch_level, catch_label := level(), uncaught
   repl_env := core_env()
   rep(str_bcpl2mal("(def! not (fn** (a) (if a false true)))"), repl_env)
+  catch_level, catch_label := level(), uncaught
   IF FALSE THEN
   { uncaught:
     writes("Uncaught exception: ")
@@ -98,7 +99,7 @@ LET repl() BE
   }
   { LET line = readline(prompt)
     IF line = nil THEN BREAK
-    writes(@rep(line, repl_env)!str_data)
+    writes(@rep(line)!str_data)
     newline()
   } REPEAT
 }
diff --git a/impls/bcpl/step5_tco.b b/impls/bcpl/step5_tco.b
index c5ee29295e..8f390fab9b 100644
--- a/impls/bcpl/step5_tco.b
+++ b/impls/bcpl/step5_tco.b
@@ -87,14 +87,15 @@ AND EVAL(ast, env) = VALOF
 
 LET PRINT(x) = pr_str(x)
 
-LET rep(x, env) = PRINT(EVAL(READ(x), env))
+STATIC { repl_env }
+
+LET rep(x) = PRINT(EVAL(READ(x), repl_env))
 
 LET repl() BE
 { LET prompt = str_bcpl2mal("user> ")
-  LET repl_env = ?
-  catch_level, catch_label := level(), uncaught
   repl_env := core_env()
   rep(str_bcpl2mal("(def! not (fn** (a) (if a false true)))"), repl_env)
+  catch_level, catch_label := level(), uncaught
   IF FALSE THEN
   { uncaught:
     writes("Uncaught exception: ")
@@ -103,7 +104,7 @@ LET repl() BE
   }
   { LET line = readline(prompt)
     IF line = nil THEN BREAK
-    writes(@rep(line, repl_env)!str_data)
+    writes(@rep(line)!str_data)
     newline()
   } REPEAT
 }

From 3a963749e90a5efb9d3823a6ef662f3ee34e6a4f Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Wed, 29 Apr 2020 21:57:34 +0100
Subject: [PATCH 075/148] bcpl: Garbage collector up to step 2

This includes fixing the fact that I accidentally had the gc_marked flag
overlapping the crit-bit field of hash-map internal nodes.
---
 impls/bcpl/malhdr.h     |  6 +++---
 impls/bcpl/step2_eval.b |  8 +++++---
 impls/bcpl/types.b      | 34 +++++++++++++++++++++++++++++-----
 3 files changed, 37 insertions(+), 11 deletions(-)

diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index 4b50fbe8d0..2636db5d50 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -2,7 +2,7 @@ GLOBAL { readline: ug
          pr_str; pr_multi; throwf
          read_str
          init_types; nil; empty; empty_hashmap; mtrue; mfalse
-	 gc_sweep
+	 gc_mark; gc_sweep
 	 equal
 	 cons; nth; as_lst
 	 alloc_int
@@ -28,7 +28,7 @@ MANIFEST
   // (for instance functions and macros).  The compoundflag is set on
   // compund types (ones containing references to other values).
   compoundflag = SLCT 1:3:1; supertype = SLCT 4:0:1; type = SLCT 8:0:1
-  gc_marked = SLCT 9:0:1
+  gc_marked = SLCT 1:8:1
 
   // Nil. There is a single nil value initialised by init_types(), but
   // it's a valid pointer so it can safely be dereferenced.
@@ -69,7 +69,7 @@ MANIFEST
   // bit offset in the spare bits of the first word.  External nodes
   // point to a key and a value.  Empty nodes describe an empty hash-map.
   t_hmi = #x0a; hmi_left = 2; hmi_right = 3; hmi_sz = 4
-  hmi_critbit = SLCT 0:8:1; hmi_maxcritbit = (1 << BITSPERBCPLWORD - 8) - 1
+  hmi_critbit = SLCT 0:9:1; hmi_maxcritbit = (1 << BITSPERBCPLWORD - 9) - 1
   t_hmx = #x1a; hmx_key = 2; hmx_value = 3; hmx_sz = 4
   t_hm0 = #x0b; hm0_sz = 2
 }
diff --git a/impls/bcpl/step2_eval.b b/impls/bcpl/step2_eval.b
index 77f50e1d35..c12531cf42 100644
--- a/impls/bcpl/step2_eval.b
+++ b/impls/bcpl/step2_eval.b
@@ -72,8 +72,7 @@ LET init_core() BE
 LET rep(x) = PRINT(EVAL(READ(x), repl_env))
 
 LET repl() BE
-{ LET prompt = str_bcpl2mal("user> ")
-  LET def(name, value) BE
+{ LET def(name, value) BE
     repl_env := hm_set(repl_env, as_sym(str_bcpl2mal(name)), value)
   repl_env := empty_hashmap
   def("+",  add_fun)
@@ -87,10 +86,13 @@ LET repl() BE
     writes(@(pr_str(last_exception)!str_data))
     newline()
   }
-  { LET line = readline(prompt)
+  { LET prompt = str_bcpl2mal("user> ")
+    LET line = readline(prompt)
     IF line = nil THEN BREAK
     writes(@rep(line)!str_data)
     newline()
+    gc_mark(repl_env)
+    gc_sweep()
   } REPEAT
 }
 
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index 7305ebc607..18034373ee 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -22,12 +22,36 @@ LET alloc_val(size) = VALOF
   RESULTIS result
 }
 
+LET gc_mark(x) BE
+{ IF gc_marked OF x = 1 THEN RETURN
+  // writef("MARK : -- %8x (%8x)*n", x, x!1)
+  gc_marked OF x := 1
+  // Note manual tail-call elimination here so that marking a long
+  // list doesn't cause a stack overflow.  Other large data structures
+  // still could, though.
+  SWITCHON supertype OF x INTO
+  { CASE t_lst: gc_mark(x!lst_first); x := x!lst_rest; LOOP
+    CASE t_vec: FOR i = 0 TO x!vec_len - 1 DO
+                  gc_mark((x+vec_data)!i)
+		ENDCASE
+    CASE t_hmi: gc_mark(x!hmi_left); x := x!hmi_right; LOOP
+  }
+  RETURN
+} REPEAT
+
 LET gc_sweep() BE
-{ UNTIL nil!nextptr = nil DO
-  { LET val = nil!nextptr
-    nil!nextptr := val!nextptr
-    // writef("FREE : -> %8x (%8x)*n", val, val!1)
-    freevec(val)
+{ LET last, this = nil, nil!nextptr
+  UNTIL this = nil DO
+  { TEST gc_marked OF this THEN
+    { gc_marked OF this := 0
+      last, this := this, this!nextptr
+    } ELSE
+    { LET tmp = this
+      this := this!nextptr
+      // writef("FREE : -> %8x (%8x)*n", tmp, tmp!1)
+      freevec(tmp)
+      last!nextptr := this
+    }
   }
 }
 

From 9f1dab11143bb3981744bcf0cba64072015a5143 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Thu, 30 Apr 2020 20:14:35 +0100
Subject: [PATCH 076/148] bcpl: Convert environments into a type of mal object

This should make it easier for the GC to handle them.
---
 impls/bcpl/env.b    | 6 ++----
 impls/bcpl/malhdr.h | 5 +++++
 2 files changed, 7 insertions(+), 4 deletions(-)

diff --git a/impls/bcpl/env.b b/impls/bcpl/env.b
index bca89afb38..f605009782 100644
--- a/impls/bcpl/env.b
+++ b/impls/bcpl/env.b
@@ -1,14 +1,12 @@
 GET "libhdr"
 GET "malhdr"
 
-MANIFEST
-{ env_outer = 0; env_data; env_sz }
-
 LET env_set(env, key, value) BE
   env!env_data := hm_set(env!env_data, key, value)
 
 LET env_new(outer, binds, exprs) = VALOF
-{ LET env = getvec(env_sz)
+{ LET env = alloc_val(env_sz)
+  type OF env := t_env
   env!env_outer := outer
   env!env_data := empty_hashmap
   UNTIL binds = empty DO
diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index 2636db5d50..d553261ccd 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -3,6 +3,7 @@ GLOBAL { readline: ug
          read_str
          init_types; nil; empty; empty_hashmap; mtrue; mfalse
 	 gc_mark; gc_sweep
+	 alloc_val
 	 equal
 	 cons; nth; as_lst
 	 alloc_int
@@ -56,6 +57,10 @@ MANIFEST
 
   maxbcplstrlen = (1 << (BITSPERBCPLWORD / bytesperword)) - 1
 
+  // Environments.  While technically these don't have to be a mal type,
+  // it makes the garbage collector simpler if they are.
+  t_env = #x0e; env_outer = 2; env_data = 3; env_sz = 4
+
   // Vectors.  Structured like strings except that the data consists of
   // pointers rather than packed characters.
   t_vec = #x09; vec_len = 2; vec_data = 3

From cc0e685dbac20af047164d3b1686408f1a4ccb28 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Thu, 30 Apr 2020 20:22:13 +0100
Subject: [PATCH 077/148] bcpl: Add garbage-collection to step 3

---
 impls/bcpl/step3_env.b | 8 +++++---
 impls/bcpl/types.b     | 1 +
 2 files changed, 6 insertions(+), 3 deletions(-)

diff --git a/impls/bcpl/step3_env.b b/impls/bcpl/step3_env.b
index 4839681254..5f6503fd64 100644
--- a/impls/bcpl/step3_env.b
+++ b/impls/bcpl/step3_env.b
@@ -90,8 +90,7 @@ LET init_core() BE
 LET rep(x) = PRINT(EVAL(READ(x), repl_env))
 
 LET repl() BE
-{ LET prompt = str_bcpl2mal("user> ")
-  LET def(name, value) BE env_set(repl_env, as_sym(str_bcpl2mal(name)), value)
+{ LET def(name, value) BE env_set(repl_env, as_sym(str_bcpl2mal(name)), value)
   repl_env := env_new(nil, empty, empty)
   def("+",  add_fun)
   def("-",  sub_fun)
@@ -104,10 +103,13 @@ LET repl() BE
     writes(@(pr_str(last_exception)!str_data))
     newline()
   }
-  { LET line = readline(prompt)
+  { LET prompt = str_bcpl2mal("user> ")
+    LET line = readline(prompt)
     IF line = nil THEN BREAK
     writes(@rep(line)!str_data)
     newline()
+    gc_mark(repl_env)
+    gc_sweep()
   } REPEAT
 }
 
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index 18034373ee..121cae24c9 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -35,6 +35,7 @@ LET gc_mark(x) BE
                   gc_mark((x+vec_data)!i)
 		ENDCASE
     CASE t_hmi: gc_mark(x!hmi_left); x := x!hmi_right; LOOP
+    CASE t_env: gc_mark(x!env_data); x := x!env_outer; LOOP
   }
   RETURN
 } REPEAT

From d6624e74749e73da1bd24838dcd805cebdac868c Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sat, 2 May 2020 10:13:13 +0100
Subject: [PATCH 078/148] bcpl: Extend garbage-collection to user-defined
 functions

This adds a field, fun_ntracked, that indicates how many of the fields
of a user-defined function are tracked pointers.  This gets set when the
function is created and inspected by gc_mark(), but can be otherwise
ignored.  At the moment it's always 0 (for core functions) or 3 (for
functions defined using fn*).
---
 impls/bcpl/malhdr.h         | 4 +++-
 impls/bcpl/step4_if_fn_do.b | 1 +
 impls/bcpl/types.b          | 3 +++
 3 files changed, 7 insertions(+), 1 deletion(-)

diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index d553261ccd..c8903b771b 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -66,8 +66,10 @@ MANIFEST
   t_vec = #x09; vec_len = 2; vec_data = 3
 
   // Functions.  Contains a function which gets passed a pointer to
-  // this structure and can do what it likes with it.
+  // this structure and can do what it likes with it.  fun_ntracked
+  // is the number of tracked pointers at the start of fun_data.
   t_fun = #x0f; fun_code = 2; fun_data = 3
+  fun_ntracked = SLCT 0:9:1
 
   // Hash-maps.  These are implemented as crit-bit trees.  There are three
   // types of node: internal nodes point to two other nodes and encode a
diff --git a/impls/bcpl/step4_if_fn_do.b b/impls/bcpl/step4_if_fn_do.b
index fbc1132a32..4d4d3c23da 100644
--- a/impls/bcpl/step4_if_fn_do.b
+++ b/impls/bcpl/step4_if_fn_do.b
@@ -70,6 +70,7 @@ AND EVAL(ast, env) = VALOF
           EVAL(fun!fun_body, env_new(fun!fun_env, fun!fun_binds, args))
       LET result = alloc_fun(call, fun_sz,
                              as_lst(nth(ast, 1)), nth(ast, 2), env)
+      fun_ntracked OF result := 3
       RESULTIS result
     }
   }
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index 121cae24c9..a1fc2d7835 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -36,6 +36,9 @@ LET gc_mark(x) BE
 		ENDCASE
     CASE t_hmi: gc_mark(x!hmi_left); x := x!hmi_right; LOOP
     CASE t_env: gc_mark(x!env_data); x := x!env_outer; LOOP
+    CASE t_fun: FOR i = 0 TO (fun_ntracked OF x) - 1 DO
+                  gc_mark((x+fun_data)!i)
+		ENDCASE
   }
   RETURN
 } REPEAT

From e7399e90e2f1d06523b4ff4474422976b60a1c02 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sat, 2 May 2020 10:15:42 +0100
Subject: [PATCH 079/148] bcpl: Enable once-per-rep garbage-collection in step
 4

Proper GC for step 4 requires a lot more work, but this demonstrates
that GC of user-defined functions works.
---
 impls/bcpl/step4_if_fn_do.b | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/impls/bcpl/step4_if_fn_do.b b/impls/bcpl/step4_if_fn_do.b
index 4d4d3c23da..f99dd2388d 100644
--- a/impls/bcpl/step4_if_fn_do.b
+++ b/impls/bcpl/step4_if_fn_do.b
@@ -88,8 +88,7 @@ STATIC { repl_env }
 LET rep(x) = PRINT(EVAL(READ(x), repl_env))
 
 LET repl() BE
-{ LET prompt = str_bcpl2mal("user> ")
-  repl_env := core_env()
+{ repl_env := core_env()
   rep(str_bcpl2mal("(def! not (fn** (a) (if a false true)))"), repl_env)
   catch_level, catch_label := level(), uncaught
   IF FALSE THEN
@@ -98,10 +97,13 @@ LET repl() BE
     writes(@(pr_str(last_exception)!str_data))
     newline()
   }
-  { LET line = readline(prompt)
+  { LET prompt = str_bcpl2mal("user> ")
+    LET line = readline(prompt)
     IF line = nil THEN BREAK
     writes(@rep(line)!str_data)
     newline()
+    gc_mark(repl_env)
+    gc_sweep()
   } REPEAT
 }
 

From 702ec23bbfb256ab96c3585830b0f37cf695edc6 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sat, 2 May 2020 11:21:08 +0100
Subject: [PATCH 080/148] bcpl: Add gc_root parameter to EVAL and eval_ast

Not added to all call sites yet.
---
 impls/bcpl/step4_if_fn_do.b | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/impls/bcpl/step4_if_fn_do.b b/impls/bcpl/step4_if_fn_do.b
index f99dd2388d..efae553a03 100644
--- a/impls/bcpl/step4_if_fn_do.b
+++ b/impls/bcpl/step4_if_fn_do.b
@@ -16,7 +16,7 @@ LET is_sym(a, b) = VALOF
   RESULTIS str_eq_const(a, b)
 }
 
-LET eval_ast(ast, env) = VALOF
+LET eval_ast(ast, env, gc_root) = VALOF
   SWITCHON type OF ast INTO
   { CASE t_sym: RESULTIS env_get(env, ast)
     CASE t_lst:
@@ -36,7 +36,7 @@ LET eval_ast(ast, env) = VALOF
     DEFAULT: RESULTIS ast
   }
 
-AND EVAL(ast, env) = VALOF
+AND EVAL(ast, env, gc_root) = VALOF
 { UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env)
   IF ast = empty RESULTIS ast
   { LET fn = ast!lst_first
@@ -85,7 +85,7 @@ LET PRINT(x) = pr_str(x)
 
 STATIC { repl_env }
 
-LET rep(x) = PRINT(EVAL(READ(x), repl_env))
+LET rep(x) = PRINT(EVAL(READ(x), repl_env, nil))
 
 LET repl() BE
 { repl_env := core_env()

From bc17c7dee16f5a25f8b7066ab35ed23a21d7b2b0 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sat, 2 May 2020 15:08:30 +0100
Subject: [PATCH 081/148] bcpl: GC step 4 except for user-defined functions

This also involves some minor improvements to vectors.  They're now
initialised to all nil and there's a special function to allocate a
3-element vector.
---
 impls/bcpl/malhdr.h         |  2 +-
 impls/bcpl/step4_if_fn_do.b | 38 ++++++++++++++++++++++++-------------
 impls/bcpl/types.b          |  9 +++++++++
 3 files changed, 35 insertions(+), 14 deletions(-)

diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index c8903b771b..e95bdd87b5 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -9,7 +9,7 @@ GLOBAL { readline: ug
 	 alloc_int
 	 str_setlen; alloc_str; str_bcpl2mal; as_sym; as_kwd; str_eq_const
 	 hm_set; hm_contains; hm_get
-	 alloc_vec
+	 alloc_vec; alloc_vec3
 	 alloc_fun
 	 throw
 	 env_new; env_set
diff --git a/impls/bcpl/step4_if_fn_do.b b/impls/bcpl/step4_if_fn_do.b
index efae553a03..092f83e617 100644
--- a/impls/bcpl/step4_if_fn_do.b
+++ b/impls/bcpl/step4_if_fn_do.b
@@ -21,48 +21,60 @@ LET eval_ast(ast, env, gc_root) = VALOF
   { CASE t_sym: RESULTIS env_get(env, ast)
     CASE t_lst:
       TEST ast = empty THEN RESULTIS empty
-      ELSE RESULTIS cons(EVAL(ast!lst_first, env), eval_ast(ast!lst_rest, env))
+      ELSE
+      { LET first = EVAL(ast!lst_first, env, gc_root)
+        LET rest = eval_ast(ast!lst_rest, env, cons(first, gc_root))
+        RESULTIS cons(first, rest)
+      }                 
     CASE t_vec:
       { LET new = alloc_vec(ast!vec_len)
+        LET gc_inner_root = cons(new, gc_root)
         FOR i = 0 TO ast!vec_len - 1 DO
-	  (new + vec_data)!i := EVAL((ast + vec_data)!i, env)
+	  (new + vec_data)!i := EVAL((ast + vec_data)!i, env, gc_inner_root)
 	RESULTIS new
       }
     CASE t_hmx:
-      RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env))
+      RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_root))
     CASE t_hmi:
-      RESULTIS alloc_hmi(hmi_critbit OF ast, eval_ast(ast!hmi_left, env),
-                                             eval_ast(ast!hmi_right, env))
+      { LET left  = eval_ast(ast!hmi_left,  env, gc_root)
+	LET right = eval_ast(ast!hmi_right, env, cons(left, gc_root))
+	RESULTIS alloc_hmi(hmi_critbit OF ast, left, right)
+      }
     DEFAULT: RESULTIS ast
   }
 
 AND EVAL(ast, env, gc_root) = VALOF
-{ UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env)
+{ LET gc_inner_root = alloc_vec3(ast, env, gc_root)
+  gc_mark(gc_inner_root)
+  gc_sweep()
+  UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env, gc_inner_root)
   IF ast = empty RESULTIS ast
   { LET fn = ast!lst_first
     IF is_sym(fn, "def!") THEN
-    { LET val = EVAL(nth(ast, 2), env)
+    { LET val = EVAL(nth(ast, 2), env, gc_inner_root)
       env_set(env, nth(ast, 1), val, env)
       RESULTIS val
     }
     IF is_sym(fn, "let**") THEN
     { LET newenv, bindings = env_new(env, empty, empty), as_lst(nth(ast, 1))
       UNTIL bindings = empty DO
-      { env_set(newenv, bindings!lst_first, EVAL(nth(bindings, 1), newenv))
+      { env_set(newenv, bindings!lst_first,
+                EVAL(nth(bindings, 1), newenv, gc_inner_root))
         bindings := bindings!lst_rest!lst_rest
       }
-      RESULTIS EVAL(nth(ast, 2), newenv)
+      RESULTIS EVAL(nth(ast, 2), newenv, gc_inner_root)
     }
     IF is_sym(fn, "do") THEN
     { LET tail = ast!lst_rest
-      tail := eval_ast(tail, env)
+      tail := eval_ast(tail, env, gc_inner_root)
       UNTIL tail!lst_rest = empty DO tail := tail!lst_rest
       RESULTIS tail!lst_first
     }
     IF is_sym(fn, "if") THEN
-    { LET cond, tail = EVAL(nth(ast, 1), env), ast!lst_rest!lst_rest
+    { LET cond = EVAL(nth(ast, 1), env, gc_inner_root)
+      LET tail = ast!lst_rest!lst_rest
       IF cond = nil | cond = mfalse THEN tail := tail!lst_rest
-      RESULTIS EVAL(tail!lst_first, env)
+      RESULTIS EVAL(tail!lst_first, env, gc_inner_root)
     }
     IF is_sym(fn, "fn**") THEN
     { MANIFEST { fun_binds = fun_data; fun_body; fun_env; fun_sz }
@@ -74,7 +86,7 @@ AND EVAL(ast, env, gc_root) = VALOF
       RESULTIS result
     }
   }
-  ast := eval_ast(ast, env)
+  ast := eval_ast(ast, env, gc_inner_root)
   { LET fn, args = ast!lst_first, ast!lst_rest
     UNLESS type OF fn = t_fun DO throwf("not a function")
     RESULTIS (fn!fun_code)(fn, args)
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index a1fc2d7835..bd64288a66 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -208,6 +208,15 @@ LET alloc_vec(len) = VALOF
 { LET result = alloc_val(vec_data + len)
   type OF result := t_vec
   result!vec_len := len
+  FOR i = 0 TO len - 1 DO
+    (result + vec_data)!i := nil
+  RESULTIS result
+}
+
+LET alloc_vec3(A, B, C) = VALOF
+{ LET result = alloc_vec(3)
+  FOR i = 0 TO 2 DO
+    (result + vec_data)!i := (@A)!i
   RESULTIS result
 }
 

From bb3e0b24278bff2f867ae4e2acf4158b57b1b8bb Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sat, 2 May 2020 15:10:25 +0100
Subject: [PATCH 082/148] bcpl: Minor enhancements to hm_dump

---
 impls/bcpl/malhdr.h | 2 +-
 impls/bcpl/types.b  | 5 +++--
 2 files changed, 4 insertions(+), 3 deletions(-)

diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index e95bdd87b5..952c3c041b 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -8,7 +8,7 @@ GLOBAL { readline: ug
 	 cons; nth; as_lst
 	 alloc_int
 	 str_setlen; alloc_str; str_bcpl2mal; as_sym; as_kwd; str_eq_const
-	 hm_set; hm_contains; hm_get
+	 hm_set; hm_contains; hm_get; hm_dump
 	 alloc_vec; alloc_vec3
 	 alloc_fun
 	 throw
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index bd64288a66..fd5b5253a7 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -267,14 +267,15 @@ LET hm_pfx(pfx) BE
 LET hm_dumpi(map, pfx, lastbit) BE
 { hm_pfx(pfx)
   TEST type OF map = t_hmi THEN
-  { writef("bit %n*n", hmi_critbit OF map)
+  { writef("%8x: bit %n*n", map, hmi_critbit OF map)
     hm_dumpi(map!hmi_left, pfx + 1,  hmi_critbit OF map)
     hm_dumpi(map!hmi_right, pfx + 1,  hmi_critbit OF map)
   }
   ELSE
   { LET p = map!hmx_key + 1
+    writef("%8x:", map)
     WHILE lastbit > 0 DO
-    { writef("%8x ", !p)
+    { writef(" %8x", !p)
       p := p + 1
       lastbit := lastbit - BITSPERBCPLWORD
     }

From f2d73e4698a00768d858f1c315503a9873d5654e Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sun, 3 May 2020 14:58:43 +0100
Subject: [PATCH 083/148] bcpl: Finish off GC for step 4

Conveniently, BCPL ignores spurious trailing arguments in function
calls, so we can just pass gc_root to all core functions and most of
them can ignore it.
---
 impls/bcpl/step4_if_fn_do.b | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/impls/bcpl/step4_if_fn_do.b b/impls/bcpl/step4_if_fn_do.b
index 092f83e617..5404d0a877 100644
--- a/impls/bcpl/step4_if_fn_do.b
+++ b/impls/bcpl/step4_if_fn_do.b
@@ -78,8 +78,8 @@ AND EVAL(ast, env, gc_root) = VALOF
     }
     IF is_sym(fn, "fn**") THEN
     { MANIFEST { fun_binds = fun_data; fun_body; fun_env; fun_sz }
-      LET call(fun, args) =
-          EVAL(fun!fun_body, env_new(fun!fun_env, fun!fun_binds, args))
+      LET call(fun, args, gc_root) =
+          EVAL(fun!fun_body, env_new(fun!fun_env, fun!fun_binds, args), gc_root)
       LET result = alloc_fun(call, fun_sz,
                              as_lst(nth(ast, 1)), nth(ast, 2), env)
       fun_ntracked OF result := 3
@@ -89,7 +89,7 @@ AND EVAL(ast, env, gc_root) = VALOF
   ast := eval_ast(ast, env, gc_inner_root)
   { LET fn, args = ast!lst_first, ast!lst_rest
     UNLESS type OF fn = t_fun DO throwf("not a function")
-    RESULTIS (fn!fun_code)(fn, args)
+    RESULTIS (fn!fun_code)(fn, args, gc_root)
   }
 }
 

From a8095682570b8d3ebc171327c65d5eb1cf7b6c05 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sun, 3 May 2020 15:28:49 +0100
Subject: [PATCH 084/148] bcpl: Add GC to the bit of step 5 that's already
 implemented

Also propagate a couple of changes back to step 4.
---
 impls/bcpl/step4_if_fn_do.b |  4 +--
 impls/bcpl/step5_tco.b      | 53 ++++++++++++++++++++++++-------------
 2 files changed, 36 insertions(+), 21 deletions(-)

diff --git a/impls/bcpl/step4_if_fn_do.b b/impls/bcpl/step4_if_fn_do.b
index 5404d0a877..7ddef7ad23 100644
--- a/impls/bcpl/step4_if_fn_do.b
+++ b/impls/bcpl/step4_if_fn_do.b
@@ -25,7 +25,7 @@ LET eval_ast(ast, env, gc_root) = VALOF
       { LET first = EVAL(ast!lst_first, env, gc_root)
         LET rest = eval_ast(ast!lst_rest, env, cons(first, gc_root))
         RESULTIS cons(first, rest)
-      }                 
+      }
     CASE t_vec:
       { LET new = alloc_vec(ast!vec_len)
         LET gc_inner_root = cons(new, gc_root)
@@ -74,7 +74,7 @@ AND EVAL(ast, env, gc_root) = VALOF
     { LET cond = EVAL(nth(ast, 1), env, gc_inner_root)
       LET tail = ast!lst_rest!lst_rest
       IF cond = nil | cond = mfalse THEN tail := tail!lst_rest
-      RESULTIS EVAL(tail!lst_first, env, gc_inner_root)
+      RESULTIS EVAL(tail!lst_first, env, gc_root)
     }
     IF is_sym(fn, "fn**") THEN
     { MANIFEST { fun_binds = fun_data; fun_body; fun_env; fun_sz }
diff --git a/impls/bcpl/step5_tco.b b/impls/bcpl/step5_tco.b
index 8f390fab9b..1f0dbf64ad 100644
--- a/impls/bcpl/step5_tco.b
+++ b/impls/bcpl/step5_tco.b
@@ -16,39 +16,50 @@ LET is_sym(a, b) = VALOF
   RESULTIS str_eq_const(a, b)
 }
 
-LET eval_ast(ast, env) = VALOF
+LET eval_ast(ast, env, gc_root) = VALOF
   SWITCHON type OF ast INTO
   { CASE t_sym: RESULTIS env_get(env, ast)
     CASE t_lst:
       TEST ast = empty THEN RESULTIS empty
-      ELSE RESULTIS cons(EVAL(ast!lst_first, env), eval_ast(ast!lst_rest, env))
+      ELSE
+      { LET first = EVAL(ast!lst_first, env, gc_root)
+        LET rest = eval_ast(ast!lst_rest, env, cons(first, gc_root))
+        RESULTIS cons(first, rest)
+      }
     CASE t_vec:
       { LET new = alloc_vec(ast!vec_len)
+        LET gc_inner_root = cons(new, gc_root)
         FOR i = 0 TO ast!vec_len - 1 DO
-	  (new + vec_data)!i := EVAL((ast + vec_data)!i, env)
+	  (new + vec_data)!i := EVAL((ast + vec_data)!i, env, gc_inner_root)
 	RESULTIS new
       }
     CASE t_hmx:
-      RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env))
+      RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_root))
     CASE t_hmi:
-      RESULTIS alloc_hmi(hmi_critbit OF ast, eval_ast(ast!hmi_left, env),
-                                             eval_ast(ast!hmi_right, env))
+      { LET left  = eval_ast(ast!hmi_left,  env, gc_root)
+	LET right = eval_ast(ast!hmi_right, env, cons(left, gc_root))
+	RESULTIS alloc_hmi(hmi_critbit OF ast, left, right)
+      }
     DEFAULT: RESULTIS ast
   }
 
-AND EVAL(ast, env) = VALOF
-{ UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env)
+AND EVAL(ast, env, gc_root) = VALOF
+{ LET gc_inner_root = alloc_vec3(ast, env, gc_root)
+  gc_mark(gc_inner_root)
+  gc_sweep()
+  UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env)
   IF ast = empty RESULTIS ast
   { LET fn = ast!lst_first
     IF is_sym(fn, "def!") THEN
-    { LET val = EVAL(nth(ast, 2), env)
+    { LET val = EVAL(nth(ast, 2), env, gc_inner_root)
       env_set(env, nth(ast, 1), val, env)
       RESULTIS val
     }
     IF is_sym(fn, "let**") THEN
     { LET newenv, bindings = env_new(env, empty, empty), as_lst(nth(ast, 1))
       UNTIL bindings = empty DO
-      { env_set(newenv, bindings!lst_first, EVAL(nth(bindings, 1), newenv))
+      { env_set(newenv, bindings!lst_first,
+                EVAL(nth(bindings, 1), newenv, gc_inner_root))
         bindings := bindings!lst_rest!lst_rest
       }
       ast, env := nth(ast, 2), newenv
@@ -57,28 +68,30 @@ AND EVAL(ast, env) = VALOF
     IF is_sym(fn, "do") THEN
     { LET tail = ast!lst_rest
       UNTIL tail!lst_rest = empty DO
-      { EVAL(tail!lst_first, env)
+      { EVAL(tail!lst_first, env, gc_inner_root)
         tail := tail!lst_rest
       }
       ast := tail!lst_first
       LOOP // TCO
     }
     IF is_sym(fn, "if") THEN
-    { LET cond, tail = EVAL(nth(ast, 1), env), ast!lst_rest!lst_rest
+    { LET cond = EVAL(nth(ast, 1), env, gc_inner_root)
+      LET tail = ast!lst_rest!lst_rest
       IF cond = nil | cond = mfalse THEN tail := tail!lst_rest
       ast := tail!lst_first
       LOOP // TCO
     }
     IF is_sym(fn, "fn**") THEN
     { MANIFEST { fun_binds = fun_data; fun_body; fun_env; fun_sz }
-      LET call(fun, args) =
-          EVAL(fun!fun_body, env_new(fun!fun_env, fun!fun_binds, args))
+      LET call(fun, args, gc_root) =
+          EVAL(fun!fun_body, env_new(fun!fun_env, fun!fun_binds, args), gc_root)
       LET result = alloc_fun(call, fun_sz,
                              as_lst(nth(ast, 1)), nth(ast, 2), env)
+      fun_ntracked OF result := 3
       RESULTIS result
     }
   }
-  ast := eval_ast(ast, env)
+  ast := eval_ast(ast, env, gc_inner_root)
   { LET fn, args = ast!lst_first, ast!lst_rest
     UNLESS type OF fn = t_fun DO throwf("not a function")
     RESULTIS (fn!fun_code)(fn, args)
@@ -89,11 +102,10 @@ LET PRINT(x) = pr_str(x)
 
 STATIC { repl_env }
 
-LET rep(x) = PRINT(EVAL(READ(x), repl_env))
+LET rep(x) = PRINT(EVAL(READ(x), repl_env)), nil
 
 LET repl() BE
-{ LET prompt = str_bcpl2mal("user> ")
-  repl_env := core_env()
+{ repl_env := core_env()
   rep(str_bcpl2mal("(def! not (fn** (a) (if a false true)))"), repl_env)
   catch_level, catch_label := level(), uncaught
   IF FALSE THEN
@@ -102,10 +114,13 @@ LET repl() BE
     writes(@(pr_str(last_exception)!str_data))
     newline()
   }
-  { LET line = readline(prompt)
+  { LET prompt = str_bcpl2mal("user> ")
+    LET line = readline(prompt)
     IF line = nil THEN BREAK
     writes(@rep(line)!str_data)
     newline()
+    gc_mark(repl_env)
+    gc_sweep()
   } REPEAT
 }
 

From 1d574737dc707f0f3b7dc04a645b13241aa58147 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Wed, 6 May 2020 22:59:41 +0100
Subject: [PATCH 085/148] bcpl: Update to match the latest GC guide

---
 impls/bcpl/malhdr.h           |  2 +-
 impls/bcpl/step1_read_print.b |  2 +-
 impls/bcpl/step2_eval.b       |  3 +--
 impls/bcpl/step3_env.b        |  3 +--
 impls/bcpl/step4_if_fn_do.b   | 27 +++++++++++++++------------
 impls/bcpl/types.b            | 11 ++++++++---
 6 files changed, 27 insertions(+), 21 deletions(-)

diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index 952c3c041b..b2908a1d99 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -2,7 +2,7 @@ GLOBAL { readline: ug
          pr_str; pr_multi; throwf
          read_str
          init_types; nil; empty; empty_hashmap; mtrue; mfalse
-	 gc_mark; gc_sweep
+	 gc
 	 alloc_val
 	 equal
 	 cons; nth; as_lst
diff --git a/impls/bcpl/step1_read_print.b b/impls/bcpl/step1_read_print.b
index 1c4bd16ea2..e35c207618 100644
--- a/impls/bcpl/step1_read_print.b
+++ b/impls/bcpl/step1_read_print.b
@@ -27,7 +27,7 @@ LET repl() BE
     IF line = nil THEN BREAK
     writes(@rep(line)!str_data)
     newline()
-    gc_sweep()
+    gc(nil)
   } REPEAT
 }
 
diff --git a/impls/bcpl/step2_eval.b b/impls/bcpl/step2_eval.b
index c12531cf42..dd6dd08176 100644
--- a/impls/bcpl/step2_eval.b
+++ b/impls/bcpl/step2_eval.b
@@ -91,8 +91,7 @@ LET repl() BE
     IF line = nil THEN BREAK
     writes(@rep(line)!str_data)
     newline()
-    gc_mark(repl_env)
-    gc_sweep()
+    gc(repl_env)
   } REPEAT
 }
 
diff --git a/impls/bcpl/step3_env.b b/impls/bcpl/step3_env.b
index 5f6503fd64..88bf42462f 100644
--- a/impls/bcpl/step3_env.b
+++ b/impls/bcpl/step3_env.b
@@ -108,8 +108,7 @@ LET repl() BE
     IF line = nil THEN BREAK
     writes(@rep(line)!str_data)
     newline()
-    gc_mark(repl_env)
-    gc_sweep()
+    gc(repl_env)
   } REPEAT
 }
 
diff --git a/impls/bcpl/step4_if_fn_do.b b/impls/bcpl/step4_if_fn_do.b
index 7ddef7ad23..05a9980852 100644
--- a/impls/bcpl/step4_if_fn_do.b
+++ b/impls/bcpl/step4_if_fn_do.b
@@ -22,32 +22,35 @@ LET eval_ast(ast, env, gc_root) = VALOF
     CASE t_lst:
       TEST ast = empty THEN RESULTIS empty
       ELSE
-      { LET first = EVAL(ast!lst_first, env, gc_root)
+      { LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
+        LET first = EVAL(ast!lst_first, env, gc_inner_root)
         LET rest = eval_ast(ast!lst_rest, env, cons(first, gc_root))
         RESULTIS cons(first, rest)
       }
     CASE t_vec:
       { LET new = alloc_vec(ast!vec_len)
-        LET gc_inner_root = cons(new, gc_root)
+        LET gc_inner_root = alloc_vecn(4, new, ast, env, gc_root)
         FOR i = 0 TO ast!vec_len - 1 DO
 	  (new + vec_data)!i := EVAL((ast + vec_data)!i, env, gc_inner_root)
 	RESULTIS new
       }
     CASE t_hmx:
-      RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_root))
+      { LET gc_inner_root = cons(ast, gc_root)
+        RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_root))
+      }
     CASE t_hmi:
-      { LET left  = eval_ast(ast!hmi_left,  env, gc_root)
-	LET right = eval_ast(ast!hmi_right, env, cons(left, gc_root))
+      { LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
+        LET left  = eval_ast(ast!hmi_left,  env, gc_inner_root)
+	LET right = eval_ast(ast!hmi_right, env, cons(left, gc_inner_root))
 	RESULTIS alloc_hmi(hmi_critbit OF ast, left, right)
       }
     DEFAULT: RESULTIS ast
   }
 
 AND EVAL(ast, env, gc_root) = VALOF
-{ LET gc_inner_root = alloc_vec3(ast, env, gc_root)
-  gc_mark(gc_inner_root)
-  gc_sweep()
-  UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env, gc_inner_root)
+{ LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
+  gc(gc_inner_root)
+  UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env, gc_root)
   IF ast = empty RESULTIS ast
   { LET fn = ast!lst_first
     IF is_sym(fn, "def!") THEN
@@ -62,11 +65,11 @@ AND EVAL(ast, env, gc_root) = VALOF
                 EVAL(nth(bindings, 1), newenv, gc_inner_root))
         bindings := bindings!lst_rest!lst_rest
       }
-      RESULTIS EVAL(nth(ast, 2), newenv, gc_inner_root)
+      RESULTIS EVAL(nth(ast, 2), newenv, gc_root)
     }
     IF is_sym(fn, "do") THEN
     { LET tail = ast!lst_rest
-      tail := eval_ast(tail, env, gc_inner_root)
+      tail := eval_ast(tail, env, gc_root)
       UNTIL tail!lst_rest = empty DO tail := tail!lst_rest
       RESULTIS tail!lst_first
     }
@@ -86,7 +89,7 @@ AND EVAL(ast, env, gc_root) = VALOF
       RESULTIS result
     }
   }
-  ast := eval_ast(ast, env, gc_inner_root)
+  ast := eval_ast(ast, env, gc_root)
   { LET fn, args = ast!lst_first, ast!lst_rest
     UNLESS type OF fn = t_fun DO throwf("not a function")
     RESULTIS (fn!fun_code)(fn, args, gc_root)
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index fd5b5253a7..36c06af725 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -59,6 +59,11 @@ LET gc_sweep() BE
   }
 }
 
+LET gc(x) BE
+{ gc_mark(x)
+  gc_sweep()
+}
+
 LET cons(first, rest) = VALOF
 { LET result = alloc_val(lst_sz)
   type OF result := t_lst
@@ -213,9 +218,9 @@ LET alloc_vec(len) = VALOF
   RESULTIS result
 }
 
-LET alloc_vec3(A, B, C) = VALOF
-{ LET result = alloc_vec(3)
-  FOR i = 0 TO 2 DO
+LET alloc_vecn(n, A, B, C, D) = VALOF
+{ LET result = alloc_vec(n)
+  FOR i = 0 TO n - 1 DO
     (result + vec_data)!i := (@A)!i
   RESULTIS result
 }

From 85c020f4c451b96aa6f6491b9a0bb86dd09df57c Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Fri, 8 May 2020 16:35:00 +0100
Subject: [PATCH 086/148] bcpl: Step 5 complete, with garbage collection

---
 impls/bcpl/Makefile    |  1 +
 impls/bcpl/malhdr.h    |  6 +++++-
 impls/bcpl/printer.b   |  3 ++-
 impls/bcpl/step5_tco.b | 17 +++++++++++------
 4 files changed, 19 insertions(+), 8 deletions(-)

diff --git a/impls/bcpl/Makefile b/impls/bcpl/Makefile
index d101c34a54..4a842ec419 100644
--- a/impls/bcpl/Makefile
+++ b/impls/bcpl/Makefile
@@ -10,6 +10,7 @@ step1_read_print: printer.b reader.b readline.b types.b
 step2_eval: printer.b reader.b readline.b types.b
 step3_env: env.b printer.b reader.b readline.b types.b
 step4_if_fn_do: core.b env.b printer.b reader.b readline.b types.b
+step5_tco: core.b env.b printer.b reader.b readline.b types.b
 
 clean:
 	rm step0_repl step1_read_print step2_eval step3_env step4_if_fn_do
diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index b2908a1d99..9924fc0860 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -9,7 +9,7 @@ GLOBAL { readline: ug
 	 alloc_int
 	 str_setlen; alloc_str; str_bcpl2mal; as_sym; as_kwd; str_eq_const
 	 hm_set; hm_contains; hm_get; hm_dump
-	 alloc_vec; alloc_vec3
+	 alloc_vec; alloc_vecn
 	 alloc_fun
 	 throw
 	 env_new; env_set
@@ -71,6 +71,10 @@ MANIFEST
   t_fun = #x0f; fun_code = 2; fun_data = 3
   fun_ntracked = SLCT 0:9:1
 
+  // Functions defined in mal.  These are returned by fn* and are
+  // handled specially by the tail-call optimisation in EVAL.
+  t_mfn = #x1f
+				
   // Hash-maps.  These are implemented as crit-bit trees.  There are three
   // types of node: internal nodes point to two other nodes and encode a
   // bit offset in the spare bits of the first word.  External nodes
diff --git a/impls/bcpl/printer.b b/impls/bcpl/printer.b
index 0ad927a7f6..70d2f64b4d 100644
--- a/impls/bcpl/printer.b
+++ b/impls/bcpl/printer.b
@@ -136,7 +136,8 @@ AND print_form(pc, val) BE
     CASE t_str: IF pc!pc_print_readably THEN { print_str(pc, val); ENDCASE }
     CASE t_sym: print_sym(pc, val); ENDCASE
     CASE t_kwd: print_kwd(pc, val); ENDCASE
-    CASE t_fun: print_const(pc, "#<function>"); ENDCASE
+    CASE t_fun:
+    CASE t_mfn: print_const(pc, "#<function>"); ENDCASE
     DEFAULT: print_const(pc, "<unprintable>"); ENDCASE
   }
 
diff --git a/impls/bcpl/step5_tco.b b/impls/bcpl/step5_tco.b
index 1f0dbf64ad..04a442641d 100644
--- a/impls/bcpl/step5_tco.b
+++ b/impls/bcpl/step5_tco.b
@@ -44,7 +44,8 @@ LET eval_ast(ast, env, gc_root) = VALOF
   }
 
 AND EVAL(ast, env, gc_root) = VALOF
-{ LET gc_inner_root = alloc_vec3(ast, env, gc_root)
+{ MANIFEST { fun_binds = fun_data; fun_body; fun_env; fun_sz }
+  LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
   gc_mark(gc_inner_root)
   gc_sweep()
   UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env)
@@ -82,19 +83,23 @@ AND EVAL(ast, env, gc_root) = VALOF
       LOOP // TCO
     }
     IF is_sym(fn, "fn**") THEN
-    { MANIFEST { fun_binds = fun_data; fun_body; fun_env; fun_sz }
-      LET call(fun, args, gc_root) =
+    { LET call(fun, args, gc_root) =
           EVAL(fun!fun_body, env_new(fun!fun_env, fun!fun_binds, args), gc_root)
       LET result = alloc_fun(call, fun_sz,
                              as_lst(nth(ast, 1)), nth(ast, 2), env)
       fun_ntracked OF result := 3
+      type OF result := t_mfn
       RESULTIS result
     }
   }
   ast := eval_ast(ast, env, gc_inner_root)
   { LET fn, args = ast!lst_first, ast!lst_rest
-    UNLESS type OF fn = t_fun DO throwf("not a function")
-    RESULTIS (fn!fun_code)(fn, args)
+    UNLESS supertype OF fn = t_fun DO throwf("not a function")
+    IF type OF fn = t_mfn THEN
+    { ast, env := fn!fun_body, env_new(fn!fun_env, fn!fun_binds, args)
+      LOOP // TCO
+    }
+    RESULTIS (fn!fun_code)(fn, args, gc_root)
   }
 } REPEAT
 
@@ -102,7 +107,7 @@ LET PRINT(x) = pr_str(x)
 
 STATIC { repl_env }
 
-LET rep(x) = PRINT(EVAL(READ(x), repl_env)), nil
+LET rep(x) = PRINT(EVAL(READ(x), repl_env), nil)
 
 LET repl() BE
 { repl_env := core_env()

From 7b45507f0dc7d2187d4b235e825c562badabf1a6 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Fri, 8 May 2020 16:50:33 +0100
Subject: [PATCH 087/148] bcpl: Start of step 6, implementin read-string

---
 impls/bcpl/Makefile     |   1 +
 impls/bcpl/core.b       |   9 +++
 impls/bcpl/step6_file.b | 139 ++++++++++++++++++++++++++++++++++++++++
 3 files changed, 149 insertions(+)
 create mode 100644 impls/bcpl/step6_file.b

diff --git a/impls/bcpl/Makefile b/impls/bcpl/Makefile
index 4a842ec419..cfe77473cc 100644
--- a/impls/bcpl/Makefile
+++ b/impls/bcpl/Makefile
@@ -11,6 +11,7 @@ step2_eval: printer.b reader.b readline.b types.b
 step3_env: env.b printer.b reader.b readline.b types.b
 step4_if_fn_do: core.b env.b printer.b reader.b readline.b types.b
 step5_tco: core.b env.b printer.b reader.b readline.b types.b
+step6_file: core.b env.b printer.b reader.b readline.b types.b
 
 clean:
 	rm step0_repl step1_read_print step2_eval step3_env step4_if_fn_do
diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index 4808a98604..82433ad734 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -103,6 +103,15 @@ LET core_env() = VALOF
     def(env, "count", bare_fun(count))
   }
 
+  // Reading function
+  { LET read_string(fn, args) = VALOF
+    { UNLESS type OF (args!lst_first) = t_str DO
+        throwf("invalid argument to read-string: %v", args!lst_first)
+      RESULTIS read_str(args!lst_first)
+    }
+    def(env, "read-string", bare_fun(read_string))
+  }
+
   // Printing functions
   { LET prstr(fn, args) = pr_multi(args, TRUE, TRUE)
     LET str(fn, args) = pr_multi(args, FALSE, FALSE)
diff --git a/impls/bcpl/step6_file.b b/impls/bcpl/step6_file.b
new file mode 100644
index 0000000000..04a442641d
--- /dev/null
+++ b/impls/bcpl/step6_file.b
@@ -0,0 +1,139 @@
+GET "libhdr"
+GET "malhdr"
+
+GET "core.b"
+GET "env.b"
+GET "printer.b"
+GET "reader.b"
+GET "readline.b"
+GET "types.b"
+
+LET READ(x) = read_str(x)
+
+// Helper function for EVAL.
+LET is_sym(a, b) = VALOF
+{ UNLESS type OF a = t_sym RESULTIS FALSE
+  RESULTIS str_eq_const(a, b)
+}
+
+LET eval_ast(ast, env, gc_root) = VALOF
+  SWITCHON type OF ast INTO
+  { CASE t_sym: RESULTIS env_get(env, ast)
+    CASE t_lst:
+      TEST ast = empty THEN RESULTIS empty
+      ELSE
+      { LET first = EVAL(ast!lst_first, env, gc_root)
+        LET rest = eval_ast(ast!lst_rest, env, cons(first, gc_root))
+        RESULTIS cons(first, rest)
+      }
+    CASE t_vec:
+      { LET new = alloc_vec(ast!vec_len)
+        LET gc_inner_root = cons(new, gc_root)
+        FOR i = 0 TO ast!vec_len - 1 DO
+	  (new + vec_data)!i := EVAL((ast + vec_data)!i, env, gc_inner_root)
+	RESULTIS new
+      }
+    CASE t_hmx:
+      RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_root))
+    CASE t_hmi:
+      { LET left  = eval_ast(ast!hmi_left,  env, gc_root)
+	LET right = eval_ast(ast!hmi_right, env, cons(left, gc_root))
+	RESULTIS alloc_hmi(hmi_critbit OF ast, left, right)
+      }
+    DEFAULT: RESULTIS ast
+  }
+
+AND EVAL(ast, env, gc_root) = VALOF
+{ MANIFEST { fun_binds = fun_data; fun_body; fun_env; fun_sz }
+  LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
+  gc_mark(gc_inner_root)
+  gc_sweep()
+  UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env)
+  IF ast = empty RESULTIS ast
+  { LET fn = ast!lst_first
+    IF is_sym(fn, "def!") THEN
+    { LET val = EVAL(nth(ast, 2), env, gc_inner_root)
+      env_set(env, nth(ast, 1), val, env)
+      RESULTIS val
+    }
+    IF is_sym(fn, "let**") THEN
+    { LET newenv, bindings = env_new(env, empty, empty), as_lst(nth(ast, 1))
+      UNTIL bindings = empty DO
+      { env_set(newenv, bindings!lst_first,
+                EVAL(nth(bindings, 1), newenv, gc_inner_root))
+        bindings := bindings!lst_rest!lst_rest
+      }
+      ast, env := nth(ast, 2), newenv
+      LOOP // TCO
+    }
+    IF is_sym(fn, "do") THEN
+    { LET tail = ast!lst_rest
+      UNTIL tail!lst_rest = empty DO
+      { EVAL(tail!lst_first, env, gc_inner_root)
+        tail := tail!lst_rest
+      }
+      ast := tail!lst_first
+      LOOP // TCO
+    }
+    IF is_sym(fn, "if") THEN
+    { LET cond = EVAL(nth(ast, 1), env, gc_inner_root)
+      LET tail = ast!lst_rest!lst_rest
+      IF cond = nil | cond = mfalse THEN tail := tail!lst_rest
+      ast := tail!lst_first
+      LOOP // TCO
+    }
+    IF is_sym(fn, "fn**") THEN
+    { LET call(fun, args, gc_root) =
+          EVAL(fun!fun_body, env_new(fun!fun_env, fun!fun_binds, args), gc_root)
+      LET result = alloc_fun(call, fun_sz,
+                             as_lst(nth(ast, 1)), nth(ast, 2), env)
+      fun_ntracked OF result := 3
+      type OF result := t_mfn
+      RESULTIS result
+    }
+  }
+  ast := eval_ast(ast, env, gc_inner_root)
+  { LET fn, args = ast!lst_first, ast!lst_rest
+    UNLESS supertype OF fn = t_fun DO throwf("not a function")
+    IF type OF fn = t_mfn THEN
+    { ast, env := fn!fun_body, env_new(fn!fun_env, fn!fun_binds, args)
+      LOOP // TCO
+    }
+    RESULTIS (fn!fun_code)(fn, args, gc_root)
+  }
+} REPEAT
+
+LET PRINT(x) = pr_str(x)
+
+STATIC { repl_env }
+
+LET rep(x) = PRINT(EVAL(READ(x), repl_env), nil)
+
+LET repl() BE
+{ repl_env := core_env()
+  rep(str_bcpl2mal("(def! not (fn** (a) (if a false true)))"), repl_env)
+  catch_level, catch_label := level(), uncaught
+  IF FALSE THEN
+  { uncaught:
+    writes("Uncaught exception: ")
+    writes(@(pr_str(last_exception)!str_data))
+    newline()
+  }
+  { LET prompt = str_bcpl2mal("user> ")
+    LET line = readline(prompt)
+    IF line = nil THEN BREAK
+    writes(@rep(line)!str_data)
+    newline()
+    gc_mark(repl_env)
+    gc_sweep()
+  } REPEAT
+}
+
+LET start() = VALOF
+{ LET ch = 0
+  init_types()
+  ch := rdch() REPEATUNTIL ch = '*n' // Consume command-line args
+  wrch('*n') // Terminate prompt printed by Cintsys
+  repl()
+  RESULTIS 0
+}

From be4176e0921bdf7ee043431a658bc9cb0870591e Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Fri, 8 May 2020 18:21:16 +0100
Subject: [PATCH 088/148] bcpl: Fix embarrasing throwf bug causing occasional
 crashes

---
 impls/bcpl/printer.b | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/impls/bcpl/printer.b b/impls/bcpl/printer.b
index 70d2f64b4d..43efa6abf2 100644
--- a/impls/bcpl/printer.b
+++ b/impls/bcpl/printer.b
@@ -183,4 +183,4 @@ LET print_f(pc, msg, A) BE
   }
 }
 
-LET throwf(msg, A) BE throw(pr(print_f, msg, A))
+LET throwf(msg, A) BE throw(pr(print_f, msg, FALSE, A))

From 70a471ead76eab531f153897ce97e1ebde30a365 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Fri, 8 May 2020 18:46:24 +0100
Subject: [PATCH 089/148] bcpl: Implement "slurp" function

---
 impls/bcpl/core.b | 34 ++++++++++++++++++++++++++++++++++
 1 file changed, 34 insertions(+)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index 82433ad734..8df10ea95b 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -131,6 +131,40 @@ LET core_env() = VALOF
     def(env, "println", bare_fun(println))
   }
 
+  // File-access function
+  { LET slurp(fn, args) = VALOF
+    { LET scb = ?
+      LET oldcis = cis
+      LET dest, dest_size, ptr = ?, 1024, 1
+      UNLESS type OF (args!lst_first) = t_str DO
+        throwf("invalid argument to slurp: %v", args!lst_first)
+      scb := findinput(@(args!lst_first!str_data))
+      IF scb = 0 THEN
+        throwf("couldn't open %v for input", args!lst_first)
+      // rdch() only reads from the current input stream, cis.
+      cis := scb
+      dest := alloc_str(dest_size)
+      { LET c = rdch()
+        IF c = endstreamch BREAK
+	IF ptr >= dest_size THEN
+	{ LET tmp = ?
+	  dest_size := dest_size * 2
+	  tmp := alloc_str(dest_size)
+	  FOR i = 1 TO str_data + dest_size / bytesperword DO
+            tmp!i := dest!i
+          dest := tmp
+	}
+	(dest + str_data)%ptr := c
+	ptr := ptr + 1
+      } REPEAT
+      str_setlen(dest, ptr - 1)
+      cis := oldcis
+      endstream(scb)
+      RESULTIS dest
+    }
+    def(env, "slurp", bare_fun(slurp))
+  }
+
   // Constructors
   { LET list(fn, args) = args
     def (env, "list", bare_fun(list))

From cc874b4242629caf357b6fef9c1d051cddefb910 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Fri, 8 May 2020 20:34:36 +0100
Subject: [PATCH 090/148] bcpl: Implement the "eval" builtin

---
 impls/bcpl/step6_file.b | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/impls/bcpl/step6_file.b b/impls/bcpl/step6_file.b
index 04a442641d..4cdf6f35ac 100644
--- a/impls/bcpl/step6_file.b
+++ b/impls/bcpl/step6_file.b
@@ -110,7 +110,9 @@ STATIC { repl_env }
 LET rep(x) = PRINT(EVAL(READ(x), repl_env), nil)
 
 LET repl() BE
-{ repl_env := core_env()
+{ LET mal_eval(fn, args, gc_root) = EVAL(args!lst_first, repl_env, gc_root)
+  repl_env := core_env()
+  env_set(repl_env, as_sym(str_bcpl2mal("eval")), alloc_fun(mal_eval, fun_data))
   rep(str_bcpl2mal("(def! not (fn** (a) (if a false true)))"), repl_env)
   catch_level, catch_label := level(), uncaught
   IF FALSE THEN

From cef1b5fc9f67633782d2ddd25abfc35f76a184e4 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Fri, 8 May 2020 21:41:09 +0100
Subject: [PATCH 091/148] bcpl: Add load-file

---
 impls/bcpl/step6_file.b | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/impls/bcpl/step6_file.b b/impls/bcpl/step6_file.b
index 4cdf6f35ac..0a16eb01f4 100644
--- a/impls/bcpl/step6_file.b
+++ b/impls/bcpl/step6_file.b
@@ -114,6 +114,8 @@ LET repl() BE
   repl_env := core_env()
   env_set(repl_env, as_sym(str_bcpl2mal("eval")), alloc_fun(mal_eval, fun_data))
   rep(str_bcpl2mal("(def! not (fn** (a) (if a false true)))"), repl_env)
+  rep(str_bcpl2mal("(def! load-file (fn** (f) (eval (read-string *
+                    *(str *"(do *" (slurp f) *"*nnil)*")))))"), repl_env)
   catch_level, catch_label := level(), uncaught
   IF FALSE THEN
   { uncaught:

From 2c5c28b7031bae5dff72e5ded69c2eb3e0f8a1ce Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Fri, 8 May 2020 23:48:22 +0100
Subject: [PATCH 092/148] bcpl: Atoms, with the exception of swap!

---
 impls/bcpl/core.b    | 21 +++++++++++++++++++++
 impls/bcpl/malhdr.h  | 12 ++++++++----
 impls/bcpl/printer.b |  7 +++++++
 impls/bcpl/types.b   |  8 ++++++++
 4 files changed, 44 insertions(+), 4 deletions(-)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index 8df10ea95b..8a106c4d5d 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -56,9 +56,11 @@ LET core_env() = VALOF
     // context.
     LET emptyp(val) = val =
       empty | supertype OF val = t_vec & val!vec_len = 0 -> TRUE, FALSE
+    LET atomp(val) = type OF val = t_atm
 
     def(env, "list?", pred_fun(listp))
     def(env, "empty?", pred_fun(emptyp))
+    def(env, "atom?", pred_fun(atomp))
   }
 
   // Comparisons
@@ -169,5 +171,24 @@ LET core_env() = VALOF
   { LET list(fn, args) = args
     def (env, "list", bare_fun(list))
   }
+
+  // Atom functions
+  { LET atom(fn, args) = alloc_atm(args!lst_first)
+    LET deref(fn, args) = VALOF
+    { UNLESS type OF (args!lst_first) = t_atm DO
+        throwf("invalid argument to deref: %v", args!lst_first)
+      RESULTIS args!lst_first!atm_value
+    }
+    LET reset(fn, args) = VALOF
+    { UNLESS type OF (args!lst_first) = t_atm DO
+        throwf("invalid argument to deref: %v", args!lst_first)
+      args!lst_first!atm_value := args!lst_rest!lst_first
+      RESULTIS args!lst_rest!lst_first
+    }
+    
+    def(env, "atom", bare_fun(atom))
+    def(env, "deref", bare_fun(deref))
+    def(env, "reset!", bare_fun(reset))
+  }
   RESULTIS env
 }
diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index 9924fc0860..74859a26b2 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -11,6 +11,7 @@ GLOBAL { readline: ug
 	 hm_set; hm_contains; hm_get; hm_dump
 	 alloc_vec; alloc_vecn
 	 alloc_fun
+	 alloc_atm
 	 throw
 	 env_new; env_set
 	 catch_level; catch_label; last_exception
@@ -74,13 +75,16 @@ MANIFEST
   // Functions defined in mal.  These are returned by fn* and are
   // handled specially by the tail-call optimisation in EVAL.
   t_mfn = #x1f
-				
+			
   // Hash-maps.  These are implemented as crit-bit trees.  There are three
   // types of node: internal nodes point to two other nodes and encode a
   // bit offset in the spare bits of the first word.  External nodes
   // point to a key and a value.  Empty nodes describe an empty hash-map.
-  t_hmi = #x0a; hmi_left = 2; hmi_right = 3; hmi_sz = 4
+  t_hmi = #x0b; hmi_left = 2; hmi_right = 3; hmi_sz = 4
   hmi_critbit = SLCT 0:9:1; hmi_maxcritbit = (1 << BITSPERBCPLWORD - 9) - 1
-  t_hmx = #x1a; hmx_key = 2; hmx_value = 3; hmx_sz = 4
-  t_hm0 = #x0b; hm0_sz = 2
+  t_hmx = #x1b; hmx_key = 2; hmx_value = 3; hmx_sz = 4
+  t_hm0 = #x0c; hm0_sz = 2
+
+  // Atoms.
+  t_atm = #x0a; atm_value = 2; atm_sz = 3
 }
diff --git a/impls/bcpl/printer.b b/impls/bcpl/printer.b
index 43efa6abf2..8ac7518868 100644
--- a/impls/bcpl/printer.b
+++ b/impls/bcpl/printer.b
@@ -122,6 +122,12 @@ AND print_hm(pc, map) BE
   print_char(pc, '}')
 }
 
+AND print_atm(pc, atm) BE
+{ print_const(pc, "(atom ")
+  print_form(pc, atm!atm_value)
+  print_char(pc, ')')
+}
+
 AND print_form(pc, val) BE
   SWITCHON type OF val INTO
   {
@@ -138,6 +144,7 @@ AND print_form(pc, val) BE
     CASE t_kwd: print_kwd(pc, val); ENDCASE
     CASE t_fun:
     CASE t_mfn: print_const(pc, "#<function>"); ENDCASE
+    CASE t_atm: print_atm(pc, val); ENDCASE
     DEFAULT: print_const(pc, "<unprintable>"); ENDCASE
   }
 
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index 36c06af725..4429f10f97 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -39,6 +39,7 @@ LET gc_mark(x) BE
     CASE t_fun: FOR i = 0 TO (fun_ntracked OF x) - 1 DO
                   gc_mark((x+fun_data)!i)
 		ENDCASE
+    CASE t_atm: x := x!atm_value; LOOP
   }
   RETURN
 } REPEAT
@@ -370,6 +371,13 @@ LET hm_contains(map, key) = VALOF
   RESULTIS equal(map!hmx_key, key)
 }
 
+LET alloc_atm(value) = VALOF
+{ LET result = alloc_val(atm_sz)
+  type OF result := t_atm
+  result!atm_value := value
+  RESULTIS result
+}
+
 LET throw(val) BE
 { last_exception := val
   longjump(catch_level, catch_label)

From 9e8b7c2b5509601a313138cbeddf1e55e61c2acf Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sat, 9 May 2020 00:27:43 +0100
Subject: [PATCH 093/148] bcpl: swap! function

---
 impls/bcpl/core.b | 15 +++++++++++++--
 1 file changed, 13 insertions(+), 2 deletions(-)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index 8a106c4d5d..e9d1d99d83 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -181,14 +181,25 @@ LET core_env() = VALOF
     }
     LET reset(fn, args) = VALOF
     { UNLESS type OF (args!lst_first) = t_atm DO
-        throwf("invalid argument to deref: %v", args!lst_first)
+        throwf("invalid argument to reset!: %v", args!lst_first)
       args!lst_first!atm_value := args!lst_rest!lst_first
       RESULTIS args!lst_rest!lst_first
     }
-    
+    LET swap(fn, args, gc_root) = VALOF
+    { LET atm, fn = args!lst_first, args!lst_rest!lst_first
+      LET gc_inner_root = cons(atm, gc_root)
+      UNLESS type OF atm = t_atm & supertype OF fn = t_fun DO
+        throwf("invalid arguments to swap!: %v", args)
+      atm!atm_value :=
+        (fn!fun_code)(fn, cons(atm!atm_value, args!lst_rest!lst_rest),
+		      gc_inner_root)
+      RESULTIS atm!atm_value
+    }
+
     def(env, "atom", bare_fun(atom))
     def(env, "deref", bare_fun(deref))
     def(env, "reset!", bare_fun(reset))
+    def(env, "swap!", bare_fun(swap))
   }
   RESULTIS env
 }

From 8dfe88691fb85c9439230209ab977cdb50654cd8 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sun, 10 May 2020 13:51:13 +0100
Subject: [PATCH 094/148] bcpl: Extract newsubstr() from reader.b and call it
 str_substr()

It will be useful outside the reader (specifically for splitting
command-line arguments).
---
 impls/bcpl/malhdr.h |  3 ++-
 impls/bcpl/reader.b | 13 ++-----------
 impls/bcpl/types.b  |  9 +++++++++
 3 files changed, 13 insertions(+), 12 deletions(-)

diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index 74859a26b2..d32e44335d 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -7,7 +7,8 @@ GLOBAL { readline: ug
 	 equal
 	 cons; nth; as_lst
 	 alloc_int
-	 str_setlen; alloc_str; str_bcpl2mal; as_sym; as_kwd; str_eq_const
+	 str_setlen; alloc_str; str_substr; str_bcpl2mal
+	 as_sym; as_kwd; str_eq_const
 	 hm_set; hm_contains; hm_get; hm_dump
 	 alloc_vec; alloc_vecn
 	 alloc_fun
diff --git a/impls/bcpl/reader.b b/impls/bcpl/reader.b
index 01a458917b..4316f8a3ba 100644
--- a/impls/bcpl/reader.b
+++ b/impls/bcpl/reader.b
@@ -12,15 +12,6 @@ LET reader_next(rdr) = VALOF
   RESULTIS tok
 }
 
-LET newsubstr(s, start, end) = VALOF
-{ LET len = end - start
-  LET ss = alloc_str(len)
-  FOR i = 1 TO len DO
-    (ss + str_data) % i := (s + str_data) % (start + i - 1)
-  str_setlen(ss, len)
-  RESULTIS ss
-}
-
 LET tokenize(s) = VALOF
 { LET tokens, tail = empty, empty
   LET sd = s + str_data
@@ -57,7 +48,7 @@ LET tokenize(s) = VALOF
     }
     // At this point, tokstart points to the first character of the token,
     // and p points to the last character.
-    token := newsubstr(s, tokstart, p + 1)
+    token := str_substr(s, tokstart, p + 1)
     TEST tokens = empty THEN
     { tokens := cons(token, empty)
       tail := tokens
@@ -95,7 +86,7 @@ LET read_string(token) = VALOF
   RESULTIS out
 }
 
-LET read_keyword(token) = as_kwd(newsubstr(token, 2, token!str_len + 1))
+LET read_keyword(token) = as_kwd(str_substr(token, 2, token!str_len + 1))
 
 LET read_number_maybe(token) = VALOF
 { LET sd, start, negative, acc = token + str_data, 1, FALSE, 0
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index 4429f10f97..f5f4c0bd68 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -121,6 +121,15 @@ LET str_dup(val) = VALOF
   RESULTIS new
 }
 
+LET str_substr(s, start, end) = VALOF
+{ LET len = end - start
+  LET ss = alloc_str(len)
+  FOR i = 1 TO len DO
+    (ss + str_data) % i := (s + str_data) % (start + i - 1)
+  str_setlen(ss, len)
+  RESULTIS ss
+}
+
 LET as_sym(val) = VALOF
 { LET sym = ?
   IF type OF val = t_sym THEN RESULTIS val

From 0c8024721743ce5db7172b5068492554c6f502e2 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sun, 10 May 2020 14:02:23 +0100
Subject: [PATCH 095/148] bcpl: Skeleton of *ARGV* support

This reads the command line, and then decides it's empty without
actually examining it.
---
 impls/bcpl/step6_file.b | 17 ++++++++++++-----
 1 file changed, 12 insertions(+), 5 deletions(-)

diff --git a/impls/bcpl/step6_file.b b/impls/bcpl/step6_file.b
index 0a16eb01f4..aae8f0864c 100644
--- a/impls/bcpl/step6_file.b
+++ b/impls/bcpl/step6_file.b
@@ -109,10 +109,11 @@ STATIC { repl_env }
 
 LET rep(x) = PRINT(EVAL(READ(x), repl_env), nil)
 
-LET repl() BE
+LET repl(argv) BE
 { LET mal_eval(fn, args, gc_root) = EVAL(args!lst_first, repl_env, gc_root)
   repl_env := core_env()
   env_set(repl_env, as_sym(str_bcpl2mal("eval")), alloc_fun(mal_eval, fun_data))
+  env_set(repl_env, as_sym(str_bcpl2mal("**ARGV**")), argv)
   rep(str_bcpl2mal("(def! not (fn** (a) (if a false true)))"), repl_env)
   rep(str_bcpl2mal("(def! load-file (fn** (f) (eval (read-string *
                     *(str *"(do *" (slurp f) *"*nnil)*")))))"), repl_env)
@@ -133,11 +134,17 @@ LET repl() BE
   } REPEAT
 }
 
+LET read_argv() = VALOF
+{ LET command_line = readline(str_bcpl2mal(""))
+  // writes("command_line: ")
+  // writes(pr_str(command_line) + str_data)
+  RESULTIS empty
+}
+ 
+
 LET start() = VALOF
-{ LET ch = 0
-  init_types()
-  ch := rdch() REPEATUNTIL ch = '*n' // Consume command-line args
+{ init_types()
   wrch('*n') // Terminate prompt printed by Cintsys
-  repl()
+  repl(read_argv())
   RESULTIS 0
 }

From cb014f4869b7dcceb221c6e9620ccc4b9a27a17a Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sun, 10 May 2020 16:59:11 +0100
Subject: [PATCH 096/148] bcpl: Avoid a buffer over-read in the reader

---
 impls/bcpl/reader.b | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/impls/bcpl/reader.b b/impls/bcpl/reader.b
index 4316f8a3ba..7a50df267c 100644
--- a/impls/bcpl/reader.b
+++ b/impls/bcpl/reader.b
@@ -34,15 +34,15 @@ LET tokenize(s) = VALOF
         p := p + (sd%p = '\' -> 2, 1) REPEATUNTIL p > s!str_len | sd%p = '*"'
         ENDCASE
       DEFAULT: // Symbol, keyword, or number
-        UNTIL p > s!str_len DO
-        { SWITCHON sd%p INTO
+        WHILE p < s!str_len DO
+        { p := p + 1
+	  SWITCHON sd%p INTO
           { CASE ' ': CASE '*t': CASE '*n': CASE ',':
             CASE '[': CASE ']': CASE '{': CASE '}': CASE '(': CASE ')':
             CASE '*'': CASE '`': CASE '~': CASE '^': CASE '@': CASE '*"':
             CASE ';':
               p := p - 1; BREAK
           }
-          p := p + 1
         }
         ENDCASE
     }

From 3197800c51675f34291de50af3342325bbe84490 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sun, 10 May 2020 17:08:50 +0100
Subject: [PATCH 097/148] bcpl: Pass gc_root properly into eval_ast

---
 impls/bcpl/step5_tco.b  | 2 +-
 impls/bcpl/step6_file.b | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/impls/bcpl/step5_tco.b b/impls/bcpl/step5_tco.b
index 04a442641d..b38e3a48fb 100644
--- a/impls/bcpl/step5_tco.b
+++ b/impls/bcpl/step5_tco.b
@@ -48,7 +48,7 @@ AND EVAL(ast, env, gc_root) = VALOF
   LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
   gc_mark(gc_inner_root)
   gc_sweep()
-  UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env)
+  UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env, gc_root)
   IF ast = empty RESULTIS ast
   { LET fn = ast!lst_first
     IF is_sym(fn, "def!") THEN
diff --git a/impls/bcpl/step6_file.b b/impls/bcpl/step6_file.b
index aae8f0864c..d7d02f6496 100644
--- a/impls/bcpl/step6_file.b
+++ b/impls/bcpl/step6_file.b
@@ -48,7 +48,7 @@ AND EVAL(ast, env, gc_root) = VALOF
   LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
   gc_mark(gc_inner_root)
   gc_sweep()
-  UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env)
+  UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env, gc_root)
   IF ast = empty RESULTIS ast
   { LET fn = ast!lst_first
     IF is_sym(fn, "def!") THEN

From 2c3568e18ae4cd8b51c6562390ba82556b363003 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Wed, 13 May 2020 22:32:05 +0100
Subject: [PATCH 098/148] bcpl: Don't pass repl_env to rep(); it doesn't use it

---
 impls/bcpl/step4_if_fn_do.b | 2 +-
 impls/bcpl/step5_tco.b      | 2 +-
 impls/bcpl/step6_file.b     | 4 ++--
 3 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/impls/bcpl/step4_if_fn_do.b b/impls/bcpl/step4_if_fn_do.b
index 05a9980852..2339fcec35 100644
--- a/impls/bcpl/step4_if_fn_do.b
+++ b/impls/bcpl/step4_if_fn_do.b
@@ -104,7 +104,7 @@ LET rep(x) = PRINT(EVAL(READ(x), repl_env, nil))
 
 LET repl() BE
 { repl_env := core_env()
-  rep(str_bcpl2mal("(def! not (fn** (a) (if a false true)))"), repl_env)
+  rep(str_bcpl2mal("(def! not (fn** (a) (if a false true)))"))
   catch_level, catch_label := level(), uncaught
   IF FALSE THEN
   { uncaught:
diff --git a/impls/bcpl/step5_tco.b b/impls/bcpl/step5_tco.b
index b38e3a48fb..e88bf0504d 100644
--- a/impls/bcpl/step5_tco.b
+++ b/impls/bcpl/step5_tco.b
@@ -111,7 +111,7 @@ LET rep(x) = PRINT(EVAL(READ(x), repl_env), nil)
 
 LET repl() BE
 { repl_env := core_env()
-  rep(str_bcpl2mal("(def! not (fn** (a) (if a false true)))"), repl_env)
+  rep(str_bcpl2mal("(def! not (fn** (a) (if a false true)))"))
   catch_level, catch_label := level(), uncaught
   IF FALSE THEN
   { uncaught:
diff --git a/impls/bcpl/step6_file.b b/impls/bcpl/step6_file.b
index d7d02f6496..dd5a3430cf 100644
--- a/impls/bcpl/step6_file.b
+++ b/impls/bcpl/step6_file.b
@@ -114,9 +114,9 @@ LET repl(argv) BE
   repl_env := core_env()
   env_set(repl_env, as_sym(str_bcpl2mal("eval")), alloc_fun(mal_eval, fun_data))
   env_set(repl_env, as_sym(str_bcpl2mal("**ARGV**")), argv)
-  rep(str_bcpl2mal("(def! not (fn** (a) (if a false true)))"), repl_env)
+  rep(str_bcpl2mal("(def! not (fn** (a) (if a false true)))"))
   rep(str_bcpl2mal("(def! load-file (fn** (f) (eval (read-string *
-                    *(str *"(do *" (slurp f) *"*nnil)*")))))"), repl_env)
+                    *(str *"(do *" (slurp f) *"*nnil)*")))))"))
   catch_level, catch_label := level(), uncaught
   IF FALSE THEN
   { uncaught:

From b7d44812e301160fea53b6f433946dcc417dd9d3 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Wed, 13 May 2020 22:35:32 +0100
Subject: [PATCH 099/148] bcpl: argv handling in step 6

This works almost acceptably, but Cintsys insists on printing a
banner, and the argv test objects to that.
---
 impls/bcpl/step6_file.b | 60 +++++++++++++++++++++++++++++++++++------
 1 file changed, 52 insertions(+), 8 deletions(-)

diff --git a/impls/bcpl/step6_file.b b/impls/bcpl/step6_file.b
index dd5a3430cf..48c00a0a64 100644
--- a/impls/bcpl/step6_file.b
+++ b/impls/bcpl/step6_file.b
@@ -113,10 +113,22 @@ LET repl(argv) BE
 { LET mal_eval(fn, args, gc_root) = EVAL(args!lst_first, repl_env, gc_root)
   repl_env := core_env()
   env_set(repl_env, as_sym(str_bcpl2mal("eval")), alloc_fun(mal_eval, fun_data))
-  env_set(repl_env, as_sym(str_bcpl2mal("**ARGV**")), argv)
-  rep(str_bcpl2mal("(def! not (fn** (a) (if a false true)))"))
+  env_set(repl_env, as_sym(str_bcpl2mal("**FILE**")), argv!lst_first)
+  env_set(repl_env, as_sym(str_bcpl2mal("**ARGV**")), argv!lst_rest)
+  rep(str_bcpl2mal("(def! not (fn** (a) (if a false true)))"), repl_env)
   rep(str_bcpl2mal("(def! load-file (fn** (f) (eval (read-string *
-                    *(str *"(do *" (slurp f) *"*nnil)*")))))"))
+                    *(str *"(do *" (slurp f) *"*nnil)*")))))"), repl_env)
+  UNLESS argv = empty DO
+  {
+    catch_level, catch_label := level(), uncaught_exit
+    rep(str_bcpl2mal("(load-file **FILE**)"))
+    sys(Sys_quit, 0)
+    uncaught_exit:
+    writes("Uncaught exception: ")
+    writes(@(pr_str(last_exception)!str_data))
+    newline()
+    sys(Sys_quit, 1)
+  }
   catch_level, catch_label := level(), uncaught
   IF FALSE THEN
   { uncaught:
@@ -134,13 +146,45 @@ LET repl(argv) BE
   } REPEAT
 }
 
+// This is a cut-down version of the reader's tokenize function.
+
+// Cintsys passes us the entire command line as a single string and doesn't
+// quote values in any way, so we can't reliably reconstruct arguments with
+// whitespace in them.
 LET read_argv() = VALOF
-{ LET command_line = readline(str_bcpl2mal(""))
-  // writes("command_line: ")
-  // writes(pr_str(command_line) + str_data)
-  RESULTIS empty
+{ LET s = readline(str_bcpl2mal(""))
+  LET tokens, tail = empty, empty
+  LET sd = s + str_data
+  LET tokstart, token = ?, ?
+  FOR p = 1 TO s!str_len DO
+  { tokstart := p
+    // Within this SWITCHON command, use LOOP to ignore input, or ENDCASE to
+    // emit a token.
+    SWITCHON sd%p INTO
+    { CASE ' ': CASE '*t': CASE '*n': LOOP // Inter-token whitespace
+      DEFAULT: // Word
+        WHILE p < s!str_len DO
+        { p := p + 1
+	  SWITCHON sd%p INTO
+          { CASE ' ': CASE '*t': CASE '*n':
+              p := p - 1; BREAK
+          }
+        }
+        ENDCASE
+    }
+    // At this point, tokstart points to the first character of the token,
+    // and p points to the last character.
+    token := str_substr(s, tokstart, p + 1)
+    TEST tokens = empty THEN
+    { tokens := cons(token, empty)
+      tail := tokens
+    } ELSE
+    { tail!lst_rest := cons(token, empty)
+      tail := tail!lst_rest
+    }
+  }
+  RESULTIS tokens
 }
- 
 
 LET start() = VALOF
 { init_types()

From 401cb2cedb13e08217f2010d70dc528d7fd8172d Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Fri, 15 May 2020 23:37:22 +0100
Subject: [PATCH 100/148] bcpl: Start step 7

---
 impls/bcpl/Makefile      |   1 +
 impls/bcpl/step7_quote.b | 194 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 195 insertions(+)
 create mode 100644 impls/bcpl/step7_quote.b

diff --git a/impls/bcpl/Makefile b/impls/bcpl/Makefile
index cfe77473cc..94d647b804 100644
--- a/impls/bcpl/Makefile
+++ b/impls/bcpl/Makefile
@@ -12,6 +12,7 @@ step3_env: env.b printer.b reader.b readline.b types.b
 step4_if_fn_do: core.b env.b printer.b reader.b readline.b types.b
 step5_tco: core.b env.b printer.b reader.b readline.b types.b
 step6_file: core.b env.b printer.b reader.b readline.b types.b
+step7_quote: core.b env.b printer.b reader.b readline.b types.b
 
 clean:
 	rm step0_repl step1_read_print step2_eval step3_env step4_if_fn_do
diff --git a/impls/bcpl/step7_quote.b b/impls/bcpl/step7_quote.b
new file mode 100644
index 0000000000..48c00a0a64
--- /dev/null
+++ b/impls/bcpl/step7_quote.b
@@ -0,0 +1,194 @@
+GET "libhdr"
+GET "malhdr"
+
+GET "core.b"
+GET "env.b"
+GET "printer.b"
+GET "reader.b"
+GET "readline.b"
+GET "types.b"
+
+LET READ(x) = read_str(x)
+
+// Helper function for EVAL.
+LET is_sym(a, b) = VALOF
+{ UNLESS type OF a = t_sym RESULTIS FALSE
+  RESULTIS str_eq_const(a, b)
+}
+
+LET eval_ast(ast, env, gc_root) = VALOF
+  SWITCHON type OF ast INTO
+  { CASE t_sym: RESULTIS env_get(env, ast)
+    CASE t_lst:
+      TEST ast = empty THEN RESULTIS empty
+      ELSE
+      { LET first = EVAL(ast!lst_first, env, gc_root)
+        LET rest = eval_ast(ast!lst_rest, env, cons(first, gc_root))
+        RESULTIS cons(first, rest)
+      }
+    CASE t_vec:
+      { LET new = alloc_vec(ast!vec_len)
+        LET gc_inner_root = cons(new, gc_root)
+        FOR i = 0 TO ast!vec_len - 1 DO
+	  (new + vec_data)!i := EVAL((ast + vec_data)!i, env, gc_inner_root)
+	RESULTIS new
+      }
+    CASE t_hmx:
+      RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_root))
+    CASE t_hmi:
+      { LET left  = eval_ast(ast!hmi_left,  env, gc_root)
+	LET right = eval_ast(ast!hmi_right, env, cons(left, gc_root))
+	RESULTIS alloc_hmi(hmi_critbit OF ast, left, right)
+      }
+    DEFAULT: RESULTIS ast
+  }
+
+AND EVAL(ast, env, gc_root) = VALOF
+{ MANIFEST { fun_binds = fun_data; fun_body; fun_env; fun_sz }
+  LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
+  gc_mark(gc_inner_root)
+  gc_sweep()
+  UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env, gc_root)
+  IF ast = empty RESULTIS ast
+  { LET fn = ast!lst_first
+    IF is_sym(fn, "def!") THEN
+    { LET val = EVAL(nth(ast, 2), env, gc_inner_root)
+      env_set(env, nth(ast, 1), val, env)
+      RESULTIS val
+    }
+    IF is_sym(fn, "let**") THEN
+    { LET newenv, bindings = env_new(env, empty, empty), as_lst(nth(ast, 1))
+      UNTIL bindings = empty DO
+      { env_set(newenv, bindings!lst_first,
+                EVAL(nth(bindings, 1), newenv, gc_inner_root))
+        bindings := bindings!lst_rest!lst_rest
+      }
+      ast, env := nth(ast, 2), newenv
+      LOOP // TCO
+    }
+    IF is_sym(fn, "do") THEN
+    { LET tail = ast!lst_rest
+      UNTIL tail!lst_rest = empty DO
+      { EVAL(tail!lst_first, env, gc_inner_root)
+        tail := tail!lst_rest
+      }
+      ast := tail!lst_first
+      LOOP // TCO
+    }
+    IF is_sym(fn, "if") THEN
+    { LET cond = EVAL(nth(ast, 1), env, gc_inner_root)
+      LET tail = ast!lst_rest!lst_rest
+      IF cond = nil | cond = mfalse THEN tail := tail!lst_rest
+      ast := tail!lst_first
+      LOOP // TCO
+    }
+    IF is_sym(fn, "fn**") THEN
+    { LET call(fun, args, gc_root) =
+          EVAL(fun!fun_body, env_new(fun!fun_env, fun!fun_binds, args), gc_root)
+      LET result = alloc_fun(call, fun_sz,
+                             as_lst(nth(ast, 1)), nth(ast, 2), env)
+      fun_ntracked OF result := 3
+      type OF result := t_mfn
+      RESULTIS result
+    }
+  }
+  ast := eval_ast(ast, env, gc_inner_root)
+  { LET fn, args = ast!lst_first, ast!lst_rest
+    UNLESS supertype OF fn = t_fun DO throwf("not a function")
+    IF type OF fn = t_mfn THEN
+    { ast, env := fn!fun_body, env_new(fn!fun_env, fn!fun_binds, args)
+      LOOP // TCO
+    }
+    RESULTIS (fn!fun_code)(fn, args, gc_root)
+  }
+} REPEAT
+
+LET PRINT(x) = pr_str(x)
+
+STATIC { repl_env }
+
+LET rep(x) = PRINT(EVAL(READ(x), repl_env), nil)
+
+LET repl(argv) BE
+{ LET mal_eval(fn, args, gc_root) = EVAL(args!lst_first, repl_env, gc_root)
+  repl_env := core_env()
+  env_set(repl_env, as_sym(str_bcpl2mal("eval")), alloc_fun(mal_eval, fun_data))
+  env_set(repl_env, as_sym(str_bcpl2mal("**FILE**")), argv!lst_first)
+  env_set(repl_env, as_sym(str_bcpl2mal("**ARGV**")), argv!lst_rest)
+  rep(str_bcpl2mal("(def! not (fn** (a) (if a false true)))"), repl_env)
+  rep(str_bcpl2mal("(def! load-file (fn** (f) (eval (read-string *
+                    *(str *"(do *" (slurp f) *"*nnil)*")))))"), repl_env)
+  UNLESS argv = empty DO
+  {
+    catch_level, catch_label := level(), uncaught_exit
+    rep(str_bcpl2mal("(load-file **FILE**)"))
+    sys(Sys_quit, 0)
+    uncaught_exit:
+    writes("Uncaught exception: ")
+    writes(@(pr_str(last_exception)!str_data))
+    newline()
+    sys(Sys_quit, 1)
+  }
+  catch_level, catch_label := level(), uncaught
+  IF FALSE THEN
+  { uncaught:
+    writes("Uncaught exception: ")
+    writes(@(pr_str(last_exception)!str_data))
+    newline()
+  }
+  { LET prompt = str_bcpl2mal("user> ")
+    LET line = readline(prompt)
+    IF line = nil THEN BREAK
+    writes(@rep(line)!str_data)
+    newline()
+    gc_mark(repl_env)
+    gc_sweep()
+  } REPEAT
+}
+
+// This is a cut-down version of the reader's tokenize function.
+
+// Cintsys passes us the entire command line as a single string and doesn't
+// quote values in any way, so we can't reliably reconstruct arguments with
+// whitespace in them.
+LET read_argv() = VALOF
+{ LET s = readline(str_bcpl2mal(""))
+  LET tokens, tail = empty, empty
+  LET sd = s + str_data
+  LET tokstart, token = ?, ?
+  FOR p = 1 TO s!str_len DO
+  { tokstart := p
+    // Within this SWITCHON command, use LOOP to ignore input, or ENDCASE to
+    // emit a token.
+    SWITCHON sd%p INTO
+    { CASE ' ': CASE '*t': CASE '*n': LOOP // Inter-token whitespace
+      DEFAULT: // Word
+        WHILE p < s!str_len DO
+        { p := p + 1
+	  SWITCHON sd%p INTO
+          { CASE ' ': CASE '*t': CASE '*n':
+              p := p - 1; BREAK
+          }
+        }
+        ENDCASE
+    }
+    // At this point, tokstart points to the first character of the token,
+    // and p points to the last character.
+    token := str_substr(s, tokstart, p + 1)
+    TEST tokens = empty THEN
+    { tokens := cons(token, empty)
+      tail := tokens
+    } ELSE
+    { tail!lst_rest := cons(token, empty)
+      tail := tail!lst_rest
+    }
+  }
+  RESULTIS tokens
+}
+
+LET start() = VALOF
+{ init_types()
+  wrch('*n') // Terminate prompt printed by Cintsys
+  repl(read_argv())
+  RESULTIS 0
+}

From 1e19232acf76588849761e7d3e098045d19ebf41 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Fri, 15 May 2020 23:59:25 +0100
Subject: [PATCH 101/148] bcpl: Add "cons" core function

---
 impls/bcpl/core.b | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index e9d1d99d83..4fc7658dba 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -89,7 +89,10 @@ LET core_env() = VALOF
   }
 
   // Miscellaneous list functions
-  { LET count(fn, args) = VALOF
+  { LET core_cons(fn, args) =
+      cons(args!lst_first, as_lst(args!lst_rest!lst_first))
+    
+    LET count(fn, args) = VALOF
     { LET arg = args!lst_first
       SWITCHON supertype OF arg INTO
       { CASE t_nil: RESULTIS alloc_int(0)
@@ -102,6 +105,7 @@ LET core_env() = VALOF
 	DEFAULT: throwf("invalid argument to count: %v", arg)
       }
     }
+    def(env, "cons", bare_fun(core_cons))
     def(env, "count", bare_fun(count))
   }
 

From f2c9a5f7dec35e46b136352bf7036edb84736095 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sat, 16 May 2020 10:54:54 +0100
Subject: [PATCH 102/148] bcpl: Add "concat" core function

---
 impls/bcpl/core.b | 17 ++++++++++++++++-
 1 file changed, 16 insertions(+), 1 deletion(-)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index 4fc7658dba..03599c9623 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -91,7 +91,21 @@ LET core_env() = VALOF
   // Miscellaneous list functions
   { LET core_cons(fn, args) =
       cons(args!lst_first, as_lst(args!lst_rest!lst_first))
-    
+    LET concat(fn, args) = VALOF
+    { LET head, tailp = empty, @head
+      IF args = empty RESULTIS empty
+      UNTIL args!lst_rest = empty DO
+      { LET this = as_lst(args!lst_first)
+        UNTIL this = empty DO
+	{ !tailp := cons(this!lst_first, empty)
+	  tailp := @(!tailp)!lst_rest
+	  this := this!lst_rest
+	}
+	args := args!lst_rest
+      }
+      !tailp := as_lst(args!lst_first)
+      RESULTIS head
+    }
     LET count(fn, args) = VALOF
     { LET arg = args!lst_first
       SWITCHON supertype OF arg INTO
@@ -106,6 +120,7 @@ LET core_env() = VALOF
       }
     }
     def(env, "cons", bare_fun(core_cons))
+    def(env, "concat", bare_fun(concat))
     def(env, "count", bare_fun(count))
   }
 

From 3228d7f701d9600568bbd55908b3d7ff901b218c Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sat, 16 May 2020 10:58:14 +0100
Subject: [PATCH 103/148] bcpl: Add "quote" form

---
 impls/bcpl/step7_quote.b | 1 +
 1 file changed, 1 insertion(+)

diff --git a/impls/bcpl/step7_quote.b b/impls/bcpl/step7_quote.b
index 48c00a0a64..bcb426649d 100644
--- a/impls/bcpl/step7_quote.b
+++ b/impls/bcpl/step7_quote.b
@@ -66,6 +66,7 @@ AND EVAL(ast, env, gc_root) = VALOF
       ast, env := nth(ast, 2), newenv
       LOOP // TCO
     }
+    IF is_sym(fn, "quote") RESULTIS ast!lst_rest!lst_first
     IF is_sym(fn, "do") THEN
     { LET tail = ast!lst_rest
       UNTIL tail!lst_rest = empty DO

From 80c19f2708e7f2fe1334dc39b3abbc669de63ed7 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sat, 16 May 2020 11:05:55 +0100
Subject: [PATCH 104/148] bcpl: Use the trick I used in concat to simplify
 tokenizer

---
 impls/bcpl/reader.b      | 11 +++--------
 impls/bcpl/step6_file.b  | 11 +++--------
 impls/bcpl/step7_quote.b | 11 +++--------
 3 files changed, 9 insertions(+), 24 deletions(-)

diff --git a/impls/bcpl/reader.b b/impls/bcpl/reader.b
index 7a50df267c..03b0960cd6 100644
--- a/impls/bcpl/reader.b
+++ b/impls/bcpl/reader.b
@@ -13,7 +13,7 @@ LET reader_next(rdr) = VALOF
 }
 
 LET tokenize(s) = VALOF
-{ LET tokens, tail = empty, empty
+{ LET tokens, tailp = empty, @tokens
   LET sd = s + str_data
   LET tokstart, token = ?, ?
   FOR p = 1 TO s!str_len DO
@@ -49,13 +49,8 @@ LET tokenize(s) = VALOF
     // At this point, tokstart points to the first character of the token,
     // and p points to the last character.
     token := str_substr(s, tokstart, p + 1)
-    TEST tokens = empty THEN
-    { tokens := cons(token, empty)
-      tail := tokens
-    } ELSE
-    { tail!lst_rest := cons(token, empty)
-      tail := tail!lst_rest
-    }
+    !tailp := cons(token, empty)
+    tailp := @(!tailp)!lst_rest
   }
   RESULTIS tokens
 }
diff --git a/impls/bcpl/step6_file.b b/impls/bcpl/step6_file.b
index 48c00a0a64..6544e31fe3 100644
--- a/impls/bcpl/step6_file.b
+++ b/impls/bcpl/step6_file.b
@@ -153,7 +153,7 @@ LET repl(argv) BE
 // whitespace in them.
 LET read_argv() = VALOF
 { LET s = readline(str_bcpl2mal(""))
-  LET tokens, tail = empty, empty
+  LET tokens, tailp = empty, @tokens
   LET sd = s + str_data
   LET tokstart, token = ?, ?
   FOR p = 1 TO s!str_len DO
@@ -175,13 +175,8 @@ LET read_argv() = VALOF
     // At this point, tokstart points to the first character of the token,
     // and p points to the last character.
     token := str_substr(s, tokstart, p + 1)
-    TEST tokens = empty THEN
-    { tokens := cons(token, empty)
-      tail := tokens
-    } ELSE
-    { tail!lst_rest := cons(token, empty)
-      tail := tail!lst_rest
-    }
+    !tailp := cons(token, empty)
+    tailp := @(!tailp)!lst_rest
   }
   RESULTIS tokens
 }
diff --git a/impls/bcpl/step7_quote.b b/impls/bcpl/step7_quote.b
index bcb426649d..429830f6f9 100644
--- a/impls/bcpl/step7_quote.b
+++ b/impls/bcpl/step7_quote.b
@@ -154,7 +154,7 @@ LET repl(argv) BE
 // whitespace in them.
 LET read_argv() = VALOF
 { LET s = readline(str_bcpl2mal(""))
-  LET tokens, tail = empty, empty
+  LET tokens, tailp = empty, @tokens
   LET sd = s + str_data
   LET tokstart, token = ?, ?
   FOR p = 1 TO s!str_len DO
@@ -176,13 +176,8 @@ LET read_argv() = VALOF
     // At this point, tokstart points to the first character of the token,
     // and p points to the last character.
     token := str_substr(s, tokstart, p + 1)
-    TEST tokens = empty THEN
-    { tokens := cons(token, empty)
-      tail := tokens
-    } ELSE
-    { tail!lst_rest := cons(token, empty)
-      tail := tail!lst_rest
-    }
+    !tailp := cons(token, empty)
+    tailp := @(!tailp)!lst_rest
   }
   RESULTIS tokens
 }

From e04bdffe6a32c55eab6bca0cbe0a4a4b7b2a39c3 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sat, 16 May 2020 11:27:03 +0100
Subject: [PATCH 105/148] bcpl: Implement quasiquote; step 7 complete

---
 impls/bcpl/step7_quote.b | 21 +++++++++++++++++++++
 1 file changed, 21 insertions(+)

diff --git a/impls/bcpl/step7_quote.b b/impls/bcpl/step7_quote.b
index 429830f6f9..14d82615d6 100644
--- a/impls/bcpl/step7_quote.b
+++ b/impls/bcpl/step7_quote.b
@@ -16,6 +16,23 @@ LET is_sym(a, b) = VALOF
   RESULTIS str_eq_const(a, b)
 }
 
+LET is_pair(ast) =
+  type OF ast = t_lst & ast ~= empty | type OF ast = t_vec & ast!vec_len > 0
+
+LET quasiquote(ast) = VALOF
+{ UNLESS is_pair(ast)
+    RESULTIS cons(as_sym(str_bcpl2mal("quote")), cons(ast, empty))
+  ast := as_lst(ast)
+  IF is_sym(ast!lst_first, "unquote") RESULTIS ast!lst_rest!lst_first
+  IF is_pair(ast!lst_first) & is_sym(ast!lst_first!lst_first, "splice-unquote")
+    RESULTIS cons(as_sym(str_bcpl2mal("concat")),
+                  cons(ast!lst_first!lst_rest!lst_first,
+		       cons(quasiquote(ast!lst_rest), empty)))
+  RESULTIS cons(as_sym(str_bcpl2mal("cons")),
+                cons(quasiquote(ast!lst_first),
+		     cons(quasiquote(ast!lst_rest), empty)))
+}
+
 LET eval_ast(ast, env, gc_root) = VALOF
   SWITCHON type OF ast INTO
   { CASE t_sym: RESULTIS env_get(env, ast)
@@ -67,6 +84,10 @@ AND EVAL(ast, env, gc_root) = VALOF
       LOOP // TCO
     }
     IF is_sym(fn, "quote") RESULTIS ast!lst_rest!lst_first
+    IF is_sym(fn, "quasiquote") THEN
+    { ast := quasiquote(ast!lst_rest!lst_first)
+      LOOP // TCO
+    }
     IF is_sym(fn, "do") THEN
     { LET tail = ast!lst_rest
       UNTIL tail!lst_rest = empty DO

From 63cba0f5e7a2c2e8b8efb75c497ee63ff1fbcb29 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Sat, 16 May 2020 15:51:37 +0100
Subject: [PATCH 106/148] bcpl: Start step 8

---
 impls/bcpl/Makefile       |   7 +-
 impls/bcpl/step8_macros.b | 211 ++++++++++++++++++++++++++++++++++++++
 2 files changed, 216 insertions(+), 2 deletions(-)
 create mode 100644 impls/bcpl/step8_macros.b

diff --git a/impls/bcpl/Makefile b/impls/bcpl/Makefile
index 94d647b804..97a060ef33 100644
--- a/impls/bcpl/Makefile
+++ b/impls/bcpl/Makefile
@@ -1,4 +1,5 @@
-all: step0_repl step1_read_print step2_eval step3_env step4_if_fn_do
+all: step0_repl step1_read_print step2_eval step3_env step4_if_fn_do \
+     step5_tco step6_file step7_quote step8_macros
 
 %: %.b malhdr.h
 	cintsys -c "bcpl $< to $@"
@@ -13,6 +14,8 @@ step4_if_fn_do: core.b env.b printer.b reader.b readline.b types.b
 step5_tco: core.b env.b printer.b reader.b readline.b types.b
 step6_file: core.b env.b printer.b reader.b readline.b types.b
 step7_quote: core.b env.b printer.b reader.b readline.b types.b
+step8_macros: core.b env.b printer.b reader.b readline.b types.b
 
 clean:
-	rm step0_repl step1_read_print step2_eval step3_env step4_if_fn_do
+	rm step0_repl step1_read_print step2_eval step3_env step4_if_fn_do \
+	   step5_tco step6_file step7_quote step8_macros
diff --git a/impls/bcpl/step8_macros.b b/impls/bcpl/step8_macros.b
new file mode 100644
index 0000000000..14d82615d6
--- /dev/null
+++ b/impls/bcpl/step8_macros.b
@@ -0,0 +1,211 @@
+GET "libhdr"
+GET "malhdr"
+
+GET "core.b"
+GET "env.b"
+GET "printer.b"
+GET "reader.b"
+GET "readline.b"
+GET "types.b"
+
+LET READ(x) = read_str(x)
+
+// Helper function for EVAL.
+LET is_sym(a, b) = VALOF
+{ UNLESS type OF a = t_sym RESULTIS FALSE
+  RESULTIS str_eq_const(a, b)
+}
+
+LET is_pair(ast) =
+  type OF ast = t_lst & ast ~= empty | type OF ast = t_vec & ast!vec_len > 0
+
+LET quasiquote(ast) = VALOF
+{ UNLESS is_pair(ast)
+    RESULTIS cons(as_sym(str_bcpl2mal("quote")), cons(ast, empty))
+  ast := as_lst(ast)
+  IF is_sym(ast!lst_first, "unquote") RESULTIS ast!lst_rest!lst_first
+  IF is_pair(ast!lst_first) & is_sym(ast!lst_first!lst_first, "splice-unquote")
+    RESULTIS cons(as_sym(str_bcpl2mal("concat")),
+                  cons(ast!lst_first!lst_rest!lst_first,
+		       cons(quasiquote(ast!lst_rest), empty)))
+  RESULTIS cons(as_sym(str_bcpl2mal("cons")),
+                cons(quasiquote(ast!lst_first),
+		     cons(quasiquote(ast!lst_rest), empty)))
+}
+
+LET eval_ast(ast, env, gc_root) = VALOF
+  SWITCHON type OF ast INTO
+  { CASE t_sym: RESULTIS env_get(env, ast)
+    CASE t_lst:
+      TEST ast = empty THEN RESULTIS empty
+      ELSE
+      { LET first = EVAL(ast!lst_first, env, gc_root)
+        LET rest = eval_ast(ast!lst_rest, env, cons(first, gc_root))
+        RESULTIS cons(first, rest)
+      }
+    CASE t_vec:
+      { LET new = alloc_vec(ast!vec_len)
+        LET gc_inner_root = cons(new, gc_root)
+        FOR i = 0 TO ast!vec_len - 1 DO
+	  (new + vec_data)!i := EVAL((ast + vec_data)!i, env, gc_inner_root)
+	RESULTIS new
+      }
+    CASE t_hmx:
+      RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_root))
+    CASE t_hmi:
+      { LET left  = eval_ast(ast!hmi_left,  env, gc_root)
+	LET right = eval_ast(ast!hmi_right, env, cons(left, gc_root))
+	RESULTIS alloc_hmi(hmi_critbit OF ast, left, right)
+      }
+    DEFAULT: RESULTIS ast
+  }
+
+AND EVAL(ast, env, gc_root) = VALOF
+{ MANIFEST { fun_binds = fun_data; fun_body; fun_env; fun_sz }
+  LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
+  gc_mark(gc_inner_root)
+  gc_sweep()
+  UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env, gc_root)
+  IF ast = empty RESULTIS ast
+  { LET fn = ast!lst_first
+    IF is_sym(fn, "def!") THEN
+    { LET val = EVAL(nth(ast, 2), env, gc_inner_root)
+      env_set(env, nth(ast, 1), val, env)
+      RESULTIS val
+    }
+    IF is_sym(fn, "let**") THEN
+    { LET newenv, bindings = env_new(env, empty, empty), as_lst(nth(ast, 1))
+      UNTIL bindings = empty DO
+      { env_set(newenv, bindings!lst_first,
+                EVAL(nth(bindings, 1), newenv, gc_inner_root))
+        bindings := bindings!lst_rest!lst_rest
+      }
+      ast, env := nth(ast, 2), newenv
+      LOOP // TCO
+    }
+    IF is_sym(fn, "quote") RESULTIS ast!lst_rest!lst_first
+    IF is_sym(fn, "quasiquote") THEN
+    { ast := quasiquote(ast!lst_rest!lst_first)
+      LOOP // TCO
+    }
+    IF is_sym(fn, "do") THEN
+    { LET tail = ast!lst_rest
+      UNTIL tail!lst_rest = empty DO
+      { EVAL(tail!lst_first, env, gc_inner_root)
+        tail := tail!lst_rest
+      }
+      ast := tail!lst_first
+      LOOP // TCO
+    }
+    IF is_sym(fn, "if") THEN
+    { LET cond = EVAL(nth(ast, 1), env, gc_inner_root)
+      LET tail = ast!lst_rest!lst_rest
+      IF cond = nil | cond = mfalse THEN tail := tail!lst_rest
+      ast := tail!lst_first
+      LOOP // TCO
+    }
+    IF is_sym(fn, "fn**") THEN
+    { LET call(fun, args, gc_root) =
+          EVAL(fun!fun_body, env_new(fun!fun_env, fun!fun_binds, args), gc_root)
+      LET result = alloc_fun(call, fun_sz,
+                             as_lst(nth(ast, 1)), nth(ast, 2), env)
+      fun_ntracked OF result := 3
+      type OF result := t_mfn
+      RESULTIS result
+    }
+  }
+  ast := eval_ast(ast, env, gc_inner_root)
+  { LET fn, args = ast!lst_first, ast!lst_rest
+    UNLESS supertype OF fn = t_fun DO throwf("not a function")
+    IF type OF fn = t_mfn THEN
+    { ast, env := fn!fun_body, env_new(fn!fun_env, fn!fun_binds, args)
+      LOOP // TCO
+    }
+    RESULTIS (fn!fun_code)(fn, args, gc_root)
+  }
+} REPEAT
+
+LET PRINT(x) = pr_str(x)
+
+STATIC { repl_env }
+
+LET rep(x) = PRINT(EVAL(READ(x), repl_env), nil)
+
+LET repl(argv) BE
+{ LET mal_eval(fn, args, gc_root) = EVAL(args!lst_first, repl_env, gc_root)
+  repl_env := core_env()
+  env_set(repl_env, as_sym(str_bcpl2mal("eval")), alloc_fun(mal_eval, fun_data))
+  env_set(repl_env, as_sym(str_bcpl2mal("**FILE**")), argv!lst_first)
+  env_set(repl_env, as_sym(str_bcpl2mal("**ARGV**")), argv!lst_rest)
+  rep(str_bcpl2mal("(def! not (fn** (a) (if a false true)))"), repl_env)
+  rep(str_bcpl2mal("(def! load-file (fn** (f) (eval (read-string *
+                    *(str *"(do *" (slurp f) *"*nnil)*")))))"), repl_env)
+  UNLESS argv = empty DO
+  {
+    catch_level, catch_label := level(), uncaught_exit
+    rep(str_bcpl2mal("(load-file **FILE**)"))
+    sys(Sys_quit, 0)
+    uncaught_exit:
+    writes("Uncaught exception: ")
+    writes(@(pr_str(last_exception)!str_data))
+    newline()
+    sys(Sys_quit, 1)
+  }
+  catch_level, catch_label := level(), uncaught
+  IF FALSE THEN
+  { uncaught:
+    writes("Uncaught exception: ")
+    writes(@(pr_str(last_exception)!str_data))
+    newline()
+  }
+  { LET prompt = str_bcpl2mal("user> ")
+    LET line = readline(prompt)
+    IF line = nil THEN BREAK
+    writes(@rep(line)!str_data)
+    newline()
+    gc_mark(repl_env)
+    gc_sweep()
+  } REPEAT
+}
+
+// This is a cut-down version of the reader's tokenize function.
+
+// Cintsys passes us the entire command line as a single string and doesn't
+// quote values in any way, so we can't reliably reconstruct arguments with
+// whitespace in them.
+LET read_argv() = VALOF
+{ LET s = readline(str_bcpl2mal(""))
+  LET tokens, tailp = empty, @tokens
+  LET sd = s + str_data
+  LET tokstart, token = ?, ?
+  FOR p = 1 TO s!str_len DO
+  { tokstart := p
+    // Within this SWITCHON command, use LOOP to ignore input, or ENDCASE to
+    // emit a token.
+    SWITCHON sd%p INTO
+    { CASE ' ': CASE '*t': CASE '*n': LOOP // Inter-token whitespace
+      DEFAULT: // Word
+        WHILE p < s!str_len DO
+        { p := p + 1
+	  SWITCHON sd%p INTO
+          { CASE ' ': CASE '*t': CASE '*n':
+              p := p - 1; BREAK
+          }
+        }
+        ENDCASE
+    }
+    // At this point, tokstart points to the first character of the token,
+    // and p points to the last character.
+    token := str_substr(s, tokstart, p + 1)
+    !tailp := cons(token, empty)
+    tailp := @(!tailp)!lst_rest
+  }
+  RESULTIS tokens
+}
+
+LET start() = VALOF
+{ init_types()
+  wrch('*n') // Terminate prompt printed by Cintsys
+  repl(read_argv())
+  RESULTIS 0
+}

From 791e7f10d4cd3bc1758cad52293e545c72cf0d9b Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Mon, 18 May 2020 22:41:11 +0100
Subject: [PATCH 107/148] bcpl: Set up exception handler earlier

It's nice to catch exceptions thrown by the startup calls to rep(), for
those cases where you've really broken things.  From step 6 onwards we
already have an exception handler that simply prints a message and
exits, so enable that before calling rep().  If we go into the REPL
(i.e. no file is supplied), it then gets replaced by an exception
handler that returns to the REPL.
---
 impls/bcpl/step6_file.b   | 2 +-
 impls/bcpl/step7_quote.b  | 2 +-
 impls/bcpl/step8_macros.b | 2 +-
 3 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/impls/bcpl/step6_file.b b/impls/bcpl/step6_file.b
index 6544e31fe3..a4f6d62da9 100644
--- a/impls/bcpl/step6_file.b
+++ b/impls/bcpl/step6_file.b
@@ -111,6 +111,7 @@ LET rep(x) = PRINT(EVAL(READ(x), repl_env), nil)
 
 LET repl(argv) BE
 { LET mal_eval(fn, args, gc_root) = EVAL(args!lst_first, repl_env, gc_root)
+  catch_level, catch_label := level(), uncaught_exit
   repl_env := core_env()
   env_set(repl_env, as_sym(str_bcpl2mal("eval")), alloc_fun(mal_eval, fun_data))
   env_set(repl_env, as_sym(str_bcpl2mal("**FILE**")), argv!lst_first)
@@ -120,7 +121,6 @@ LET repl(argv) BE
                     *(str *"(do *" (slurp f) *"*nnil)*")))))"), repl_env)
   UNLESS argv = empty DO
   {
-    catch_level, catch_label := level(), uncaught_exit
     rep(str_bcpl2mal("(load-file **FILE**)"))
     sys(Sys_quit, 0)
     uncaught_exit:
diff --git a/impls/bcpl/step7_quote.b b/impls/bcpl/step7_quote.b
index 14d82615d6..9220234247 100644
--- a/impls/bcpl/step7_quote.b
+++ b/impls/bcpl/step7_quote.b
@@ -133,6 +133,7 @@ LET rep(x) = PRINT(EVAL(READ(x), repl_env), nil)
 
 LET repl(argv) BE
 { LET mal_eval(fn, args, gc_root) = EVAL(args!lst_first, repl_env, gc_root)
+  catch_level, catch_label := level(), uncaught_exit
   repl_env := core_env()
   env_set(repl_env, as_sym(str_bcpl2mal("eval")), alloc_fun(mal_eval, fun_data))
   env_set(repl_env, as_sym(str_bcpl2mal("**FILE**")), argv!lst_first)
@@ -142,7 +143,6 @@ LET repl(argv) BE
                     *(str *"(do *" (slurp f) *"*nnil)*")))))"), repl_env)
   UNLESS argv = empty DO
   {
-    catch_level, catch_label := level(), uncaught_exit
     rep(str_bcpl2mal("(load-file **FILE**)"))
     sys(Sys_quit, 0)
     uncaught_exit:
diff --git a/impls/bcpl/step8_macros.b b/impls/bcpl/step8_macros.b
index 14d82615d6..9220234247 100644
--- a/impls/bcpl/step8_macros.b
+++ b/impls/bcpl/step8_macros.b
@@ -133,6 +133,7 @@ LET rep(x) = PRINT(EVAL(READ(x), repl_env), nil)
 
 LET repl(argv) BE
 { LET mal_eval(fn, args, gc_root) = EVAL(args!lst_first, repl_env, gc_root)
+  catch_level, catch_label := level(), uncaught_exit
   repl_env := core_env()
   env_set(repl_env, as_sym(str_bcpl2mal("eval")), alloc_fun(mal_eval, fun_data))
   env_set(repl_env, as_sym(str_bcpl2mal("**FILE**")), argv!lst_first)
@@ -142,7 +143,6 @@ LET repl(argv) BE
                     *(str *"(do *" (slurp f) *"*nnil)*")))))"), repl_env)
   UNLESS argv = empty DO
   {
-    catch_level, catch_label := level(), uncaught_exit
     rep(str_bcpl2mal("(load-file **FILE**)"))
     sys(Sys_quit, 0)
     uncaught_exit:

From 7c91c049b038242cd550ec3e4279d5274cc01011 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Mon, 18 May 2020 22:43:16 +0100
Subject: [PATCH 108/148] bcpl: Working macros for step 8

---
 impls/bcpl/malhdr.h       |  3 ++-
 impls/bcpl/step8_macros.b | 26 ++++++++++++++++++++++++++
 2 files changed, 28 insertions(+), 1 deletion(-)

diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index d32e44335d..0917363fca 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -71,11 +71,12 @@ MANIFEST
   // this structure and can do what it likes with it.  fun_ntracked
   // is the number of tracked pointers at the start of fun_data.
   t_fun = #x0f; fun_code = 2; fun_data = 3
-  fun_ntracked = SLCT 0:9:1
+  fun_ntracked = SLCT 2:9:1
 
   // Functions defined in mal.  These are returned by fn* and are
   // handled specially by the tail-call optimisation in EVAL.
   t_mfn = #x1f
+  mfn_ismacro = SLCT 1:11:1
 			
   // Hash-maps.  These are implemented as crit-bit trees.  There are three
   // types of node: internal nodes point to two other nodes and encode a
diff --git a/impls/bcpl/step8_macros.b b/impls/bcpl/step8_macros.b
index 9220234247..6ae015b7b8 100644
--- a/impls/bcpl/step8_macros.b
+++ b/impls/bcpl/step8_macros.b
@@ -33,6 +33,22 @@ LET quasiquote(ast) = VALOF
 		     cons(quasiquote(ast!lst_rest), empty)))
 }
 
+LET is_macro_call(ast, env) = VALOF
+{ LET fn = ?
+  UNLESS type OF ast = t_lst & type OF (ast!lst_first) = t_sym &
+         env_find(env, ast!lst_first) ~= nil RESULTIS FALSE
+  fn := env_get(env, ast!lst_first)
+  RESULTIS type OF fn = t_mfn & mfn_ismacro OF fn ~= 0
+}
+
+LET macroexpand(ast, env, gc_root) = VALOF
+{ WHILE is_macro_call(ast, env) DO
+  { LET fn = env_get(env, ast!lst_first)
+    ast := (fn!fun_code)(fn, ast!lst_rest, gc_root)
+  }
+  RESULTIS ast
+}
+
 LET eval_ast(ast, env, gc_root) = VALOF
   SWITCHON type OF ast INTO
   { CASE t_sym: RESULTIS env_get(env, ast)
@@ -66,6 +82,8 @@ AND EVAL(ast, env, gc_root) = VALOF
   gc_mark(gc_inner_root)
   gc_sweep()
   UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env, gc_root)
+  ast := macroexpand(ast, env, gc_inner_root)
+  UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env, gc_root)
   IF ast = empty RESULTIS ast
   { LET fn = ast!lst_first
     IF is_sym(fn, "def!") THEN
@@ -88,6 +106,14 @@ AND EVAL(ast, env, gc_root) = VALOF
     { ast := quasiquote(ast!lst_rest!lst_first)
       LOOP // TCO
     }
+    IF is_sym(fn, "defmacro!") THEN
+    { LET val = EVAL(nth(ast, 2), env, gc_inner_root)
+      IF type OF val = t_mfn THEN mfn_ismacro OF val := 1
+      env_set(env, nth(ast, 1), val, env)
+      RESULTIS val
+    }
+    IF is_sym(fn, "macroexpand") THEN
+      RESULTIS macroexpand(ast!lst_rest!lst_first, env, gc_root)
     IF is_sym(fn, "do") THEN
     { LET tail = ast!lst_rest
       UNTIL tail!lst_rest = empty DO

From 8c3982963dbf0dbcd7b97b286198ca7b42ec0670 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Mon, 18 May 2020 23:04:02 +0100
Subject: [PATCH 109/148] bcpl: nth, first, and rest core functions

---
 impls/bcpl/core.b  | 20 ++++++++++++++++++++
 impls/bcpl/types.b |  1 +
 2 files changed, 21 insertions(+)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index 03599c9623..035bef1c35 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -119,9 +119,29 @@ LET core_env() = VALOF
 	DEFAULT: throwf("invalid argument to count: %v", arg)
       }
     }
+    LET core_nth(fn, args) = VALOF
+    { LET seq, n = args!lst_first, args!lst_rest!lst_first
+      UNLESS type OF n = t_int DO throwf("subscript not an integer")
+      n := n!int_value
+      IF type OF seq = t_lst RESULTIS nth(seq, n)
+      IF type OF seq = t_vec THEN
+      { IF n >= seq!vec_len THEN throwf("subscript out of range")
+        RESULTIS (seq+vec_data)!n
+      }
+      throwf("nth applied to non-sequence")
+    }
+    LET first(fn, args) = VALOF
+    { LET seq = args!lst_first
+      IF type OF seq = t_vec & seq!vec_len > 0 RESULTIS seq!vec_data
+      RESULTIS as_lst(seq)!lst_first
+    }
+    LET rest(fn, args) = as_lst(args!lst_first)!lst_rest
     def(env, "cons", bare_fun(core_cons))
     def(env, "concat", bare_fun(concat))
     def(env, "count", bare_fun(count))
+    def(env, "nth", bare_fun(core_nth))
+    def(env, "first", bare_fun(first))
+    def(env, "rest", bare_fun(rest))
   }
 
   // Reading function
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index f5f4c0bd68..bff0673f8c 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -81,6 +81,7 @@ LET nth(lst, n) = VALOF
 
 LET as_lst(x) = VALOF SWITCHON type OF x INTO
 { CASE t_lst: RESULTIS x
+  CASE t_nil: RESULTIS empty
   CASE t_vec:
     { LET l = empty
       FOR i = x!vec_len - 1 TO 0 BY -1 DO

From 290e0c402927c4164b9e66da9a251be3967156b2 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Mon, 18 May 2020 23:18:06 +0100
Subject: [PATCH 110/148] bcpl: Make sure to preserve the temporary binding
 list in let*

When let* is called with a vector binding list, we create a temporary
list to hold it.  This list needs to be protected from
garbage-collection while we evaluate the bindings.  Also protect the new
environment though that's arguably unnecessary.
---
 impls/bcpl/step4_if_fn_do.b | 1 +
 impls/bcpl/step5_tco.b      | 1 +
 impls/bcpl/step6_file.b     | 1 +
 impls/bcpl/step7_quote.b    | 1 +
 impls/bcpl/step8_macros.b   | 1 +
 5 files changed, 5 insertions(+)

diff --git a/impls/bcpl/step4_if_fn_do.b b/impls/bcpl/step4_if_fn_do.b
index 2339fcec35..60297e257f 100644
--- a/impls/bcpl/step4_if_fn_do.b
+++ b/impls/bcpl/step4_if_fn_do.b
@@ -60,6 +60,7 @@ AND EVAL(ast, env, gc_root) = VALOF
     }
     IF is_sym(fn, "let**") THEN
     { LET newenv, bindings = env_new(env, empty, empty), as_lst(nth(ast, 1))
+      gc_inner_root := alloc_vecn(3, newenv, bindings, gc_inner_root)
       UNTIL bindings = empty DO
       { env_set(newenv, bindings!lst_first,
                 EVAL(nth(bindings, 1), newenv, gc_inner_root))
diff --git a/impls/bcpl/step5_tco.b b/impls/bcpl/step5_tco.b
index e88bf0504d..a7f2b0cbd6 100644
--- a/impls/bcpl/step5_tco.b
+++ b/impls/bcpl/step5_tco.b
@@ -58,6 +58,7 @@ AND EVAL(ast, env, gc_root) = VALOF
     }
     IF is_sym(fn, "let**") THEN
     { LET newenv, bindings = env_new(env, empty, empty), as_lst(nth(ast, 1))
+      gc_inner_root := alloc_vecn(3, newenv, bindings, gc_inner_root)
       UNTIL bindings = empty DO
       { env_set(newenv, bindings!lst_first,
                 EVAL(nth(bindings, 1), newenv, gc_inner_root))
diff --git a/impls/bcpl/step6_file.b b/impls/bcpl/step6_file.b
index a4f6d62da9..85027924a7 100644
--- a/impls/bcpl/step6_file.b
+++ b/impls/bcpl/step6_file.b
@@ -58,6 +58,7 @@ AND EVAL(ast, env, gc_root) = VALOF
     }
     IF is_sym(fn, "let**") THEN
     { LET newenv, bindings = env_new(env, empty, empty), as_lst(nth(ast, 1))
+      gc_inner_root := alloc_vecn(3, newenv, bindings, gc_inner_root)
       UNTIL bindings = empty DO
       { env_set(newenv, bindings!lst_first,
                 EVAL(nth(bindings, 1), newenv, gc_inner_root))
diff --git a/impls/bcpl/step7_quote.b b/impls/bcpl/step7_quote.b
index 9220234247..69b337cb38 100644
--- a/impls/bcpl/step7_quote.b
+++ b/impls/bcpl/step7_quote.b
@@ -75,6 +75,7 @@ AND EVAL(ast, env, gc_root) = VALOF
     }
     IF is_sym(fn, "let**") THEN
     { LET newenv, bindings = env_new(env, empty, empty), as_lst(nth(ast, 1))
+      gc_inner_root := alloc_vecn(3, newenv, bindings, gc_inner_root)
       UNTIL bindings = empty DO
       { env_set(newenv, bindings!lst_first,
                 EVAL(nth(bindings, 1), newenv, gc_inner_root))
diff --git a/impls/bcpl/step8_macros.b b/impls/bcpl/step8_macros.b
index 6ae015b7b8..3c61d1166d 100644
--- a/impls/bcpl/step8_macros.b
+++ b/impls/bcpl/step8_macros.b
@@ -93,6 +93,7 @@ AND EVAL(ast, env, gc_root) = VALOF
     }
     IF is_sym(fn, "let**") THEN
     { LET newenv, bindings = env_new(env, empty, empty), as_lst(nth(ast, 1))
+      gc_inner_root := alloc_vecn(3, newenv, bindings, gc_inner_root)
       UNTIL bindings = empty DO
       { env_set(newenv, bindings!lst_first,
                 EVAL(nth(bindings, 1), newenv, gc_inner_root))

From b7b361b5728754c2c19d00fe0e06a9ff204577b7 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Mon, 18 May 2020 23:19:50 +0100
Subject: [PATCH 111/148] bcpl: Add "cond" macro; step 8 completed

---
 impls/bcpl/step8_macros.b | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/impls/bcpl/step8_macros.b b/impls/bcpl/step8_macros.b
index 3c61d1166d..e98390de78 100644
--- a/impls/bcpl/step8_macros.b
+++ b/impls/bcpl/step8_macros.b
@@ -168,6 +168,10 @@ LET repl(argv) BE
   rep(str_bcpl2mal("(def! not (fn** (a) (if a false true)))"), repl_env)
   rep(str_bcpl2mal("(def! load-file (fn** (f) (eval (read-string *
                     *(str *"(do *" (slurp f) *"*nnil)*")))))"), repl_env)
+  rep(str_bcpl2mal("(defmacro! cond (fn** (& xs) (if (> (count xs) 0) *
+                    *(list 'if (first xs) (if (> (count xs) 1) (nth xs 1) *
+                    *(throw *"odd number of forms to cond*")) *
+                    *(cons 'cond (rest (rest xs)))))))"), repl_env)
   UNLESS argv = empty DO
   {
     rep(str_bcpl2mal("(load-file **FILE**)"))

From 2e28281f66f89fbe48dcd2b8c3a0818856a4df2b Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 19 May 2020 09:32:35 +0100
Subject: [PATCH 112/148] bcpl: Set up for step 9

---
 impls/bcpl/Makefile    |   5 +-
 impls/bcpl/step9_try.b | 242 +++++++++++++++++++++++++++++++++++++++++
 2 files changed, 245 insertions(+), 2 deletions(-)
 create mode 100644 impls/bcpl/step9_try.b

diff --git a/impls/bcpl/Makefile b/impls/bcpl/Makefile
index 97a060ef33..e8b8357fbf 100644
--- a/impls/bcpl/Makefile
+++ b/impls/bcpl/Makefile
@@ -1,5 +1,5 @@
 all: step0_repl step1_read_print step2_eval step3_env step4_if_fn_do \
-     step5_tco step6_file step7_quote step8_macros
+     step5_tco step6_file step7_quote step8_macros step9_try
 
 %: %.b malhdr.h
 	cintsys -c "bcpl $< to $@"
@@ -15,7 +15,8 @@ step5_tco: core.b env.b printer.b reader.b readline.b types.b
 step6_file: core.b env.b printer.b reader.b readline.b types.b
 step7_quote: core.b env.b printer.b reader.b readline.b types.b
 step8_macros: core.b env.b printer.b reader.b readline.b types.b
+step9_try: core.b env.b printer.b reader.b readline.b types.b
 
 clean:
 	rm step0_repl step1_read_print step2_eval step3_env step4_if_fn_do \
-	   step5_tco step6_file step7_quote step8_macros
+	   step5_tco step6_file step7_quote step8_macros step9_try
diff --git a/impls/bcpl/step9_try.b b/impls/bcpl/step9_try.b
new file mode 100644
index 0000000000..e98390de78
--- /dev/null
+++ b/impls/bcpl/step9_try.b
@@ -0,0 +1,242 @@
+GET "libhdr"
+GET "malhdr"
+
+GET "core.b"
+GET "env.b"
+GET "printer.b"
+GET "reader.b"
+GET "readline.b"
+GET "types.b"
+
+LET READ(x) = read_str(x)
+
+// Helper function for EVAL.
+LET is_sym(a, b) = VALOF
+{ UNLESS type OF a = t_sym RESULTIS FALSE
+  RESULTIS str_eq_const(a, b)
+}
+
+LET is_pair(ast) =
+  type OF ast = t_lst & ast ~= empty | type OF ast = t_vec & ast!vec_len > 0
+
+LET quasiquote(ast) = VALOF
+{ UNLESS is_pair(ast)
+    RESULTIS cons(as_sym(str_bcpl2mal("quote")), cons(ast, empty))
+  ast := as_lst(ast)
+  IF is_sym(ast!lst_first, "unquote") RESULTIS ast!lst_rest!lst_first
+  IF is_pair(ast!lst_first) & is_sym(ast!lst_first!lst_first, "splice-unquote")
+    RESULTIS cons(as_sym(str_bcpl2mal("concat")),
+                  cons(ast!lst_first!lst_rest!lst_first,
+		       cons(quasiquote(ast!lst_rest), empty)))
+  RESULTIS cons(as_sym(str_bcpl2mal("cons")),
+                cons(quasiquote(ast!lst_first),
+		     cons(quasiquote(ast!lst_rest), empty)))
+}
+
+LET is_macro_call(ast, env) = VALOF
+{ LET fn = ?
+  UNLESS type OF ast = t_lst & type OF (ast!lst_first) = t_sym &
+         env_find(env, ast!lst_first) ~= nil RESULTIS FALSE
+  fn := env_get(env, ast!lst_first)
+  RESULTIS type OF fn = t_mfn & mfn_ismacro OF fn ~= 0
+}
+
+LET macroexpand(ast, env, gc_root) = VALOF
+{ WHILE is_macro_call(ast, env) DO
+  { LET fn = env_get(env, ast!lst_first)
+    ast := (fn!fun_code)(fn, ast!lst_rest, gc_root)
+  }
+  RESULTIS ast
+}
+
+LET eval_ast(ast, env, gc_root) = VALOF
+  SWITCHON type OF ast INTO
+  { CASE t_sym: RESULTIS env_get(env, ast)
+    CASE t_lst:
+      TEST ast = empty THEN RESULTIS empty
+      ELSE
+      { LET first = EVAL(ast!lst_first, env, gc_root)
+        LET rest = eval_ast(ast!lst_rest, env, cons(first, gc_root))
+        RESULTIS cons(first, rest)
+      }
+    CASE t_vec:
+      { LET new = alloc_vec(ast!vec_len)
+        LET gc_inner_root = cons(new, gc_root)
+        FOR i = 0 TO ast!vec_len - 1 DO
+	  (new + vec_data)!i := EVAL((ast + vec_data)!i, env, gc_inner_root)
+	RESULTIS new
+      }
+    CASE t_hmx:
+      RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_root))
+    CASE t_hmi:
+      { LET left  = eval_ast(ast!hmi_left,  env, gc_root)
+	LET right = eval_ast(ast!hmi_right, env, cons(left, gc_root))
+	RESULTIS alloc_hmi(hmi_critbit OF ast, left, right)
+      }
+    DEFAULT: RESULTIS ast
+  }
+
+AND EVAL(ast, env, gc_root) = VALOF
+{ MANIFEST { fun_binds = fun_data; fun_body; fun_env; fun_sz }
+  LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
+  gc_mark(gc_inner_root)
+  gc_sweep()
+  UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env, gc_root)
+  ast := macroexpand(ast, env, gc_inner_root)
+  UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env, gc_root)
+  IF ast = empty RESULTIS ast
+  { LET fn = ast!lst_first
+    IF is_sym(fn, "def!") THEN
+    { LET val = EVAL(nth(ast, 2), env, gc_inner_root)
+      env_set(env, nth(ast, 1), val, env)
+      RESULTIS val
+    }
+    IF is_sym(fn, "let**") THEN
+    { LET newenv, bindings = env_new(env, empty, empty), as_lst(nth(ast, 1))
+      gc_inner_root := alloc_vecn(3, newenv, bindings, gc_inner_root)
+      UNTIL bindings = empty DO
+      { env_set(newenv, bindings!lst_first,
+                EVAL(nth(bindings, 1), newenv, gc_inner_root))
+        bindings := bindings!lst_rest!lst_rest
+      }
+      ast, env := nth(ast, 2), newenv
+      LOOP // TCO
+    }
+    IF is_sym(fn, "quote") RESULTIS ast!lst_rest!lst_first
+    IF is_sym(fn, "quasiquote") THEN
+    { ast := quasiquote(ast!lst_rest!lst_first)
+      LOOP // TCO
+    }
+    IF is_sym(fn, "defmacro!") THEN
+    { LET val = EVAL(nth(ast, 2), env, gc_inner_root)
+      IF type OF val = t_mfn THEN mfn_ismacro OF val := 1
+      env_set(env, nth(ast, 1), val, env)
+      RESULTIS val
+    }
+    IF is_sym(fn, "macroexpand") THEN
+      RESULTIS macroexpand(ast!lst_rest!lst_first, env, gc_root)
+    IF is_sym(fn, "do") THEN
+    { LET tail = ast!lst_rest
+      UNTIL tail!lst_rest = empty DO
+      { EVAL(tail!lst_first, env, gc_inner_root)
+        tail := tail!lst_rest
+      }
+      ast := tail!lst_first
+      LOOP // TCO
+    }
+    IF is_sym(fn, "if") THEN
+    { LET cond = EVAL(nth(ast, 1), env, gc_inner_root)
+      LET tail = ast!lst_rest!lst_rest
+      IF cond = nil | cond = mfalse THEN tail := tail!lst_rest
+      ast := tail!lst_first
+      LOOP // TCO
+    }
+    IF is_sym(fn, "fn**") THEN
+    { LET call(fun, args, gc_root) =
+          EVAL(fun!fun_body, env_new(fun!fun_env, fun!fun_binds, args), gc_root)
+      LET result = alloc_fun(call, fun_sz,
+                             as_lst(nth(ast, 1)), nth(ast, 2), env)
+      fun_ntracked OF result := 3
+      type OF result := t_mfn
+      RESULTIS result
+    }
+  }
+  ast := eval_ast(ast, env, gc_inner_root)
+  { LET fn, args = ast!lst_first, ast!lst_rest
+    UNLESS supertype OF fn = t_fun DO throwf("not a function")
+    IF type OF fn = t_mfn THEN
+    { ast, env := fn!fun_body, env_new(fn!fun_env, fn!fun_binds, args)
+      LOOP // TCO
+    }
+    RESULTIS (fn!fun_code)(fn, args, gc_root)
+  }
+} REPEAT
+
+LET PRINT(x) = pr_str(x)
+
+STATIC { repl_env }
+
+LET rep(x) = PRINT(EVAL(READ(x), repl_env), nil)
+
+LET repl(argv) BE
+{ LET mal_eval(fn, args, gc_root) = EVAL(args!lst_first, repl_env, gc_root)
+  catch_level, catch_label := level(), uncaught_exit
+  repl_env := core_env()
+  env_set(repl_env, as_sym(str_bcpl2mal("eval")), alloc_fun(mal_eval, fun_data))
+  env_set(repl_env, as_sym(str_bcpl2mal("**FILE**")), argv!lst_first)
+  env_set(repl_env, as_sym(str_bcpl2mal("**ARGV**")), argv!lst_rest)
+  rep(str_bcpl2mal("(def! not (fn** (a) (if a false true)))"), repl_env)
+  rep(str_bcpl2mal("(def! load-file (fn** (f) (eval (read-string *
+                    *(str *"(do *" (slurp f) *"*nnil)*")))))"), repl_env)
+  rep(str_bcpl2mal("(defmacro! cond (fn** (& xs) (if (> (count xs) 0) *
+                    *(list 'if (first xs) (if (> (count xs) 1) (nth xs 1) *
+                    *(throw *"odd number of forms to cond*")) *
+                    *(cons 'cond (rest (rest xs)))))))"), repl_env)
+  UNLESS argv = empty DO
+  {
+    rep(str_bcpl2mal("(load-file **FILE**)"))
+    sys(Sys_quit, 0)
+    uncaught_exit:
+    writes("Uncaught exception: ")
+    writes(@(pr_str(last_exception)!str_data))
+    newline()
+    sys(Sys_quit, 1)
+  }
+  catch_level, catch_label := level(), uncaught
+  IF FALSE THEN
+  { uncaught:
+    writes("Uncaught exception: ")
+    writes(@(pr_str(last_exception)!str_data))
+    newline()
+  }
+  { LET prompt = str_bcpl2mal("user> ")
+    LET line = readline(prompt)
+    IF line = nil THEN BREAK
+    writes(@rep(line)!str_data)
+    newline()
+    gc_mark(repl_env)
+    gc_sweep()
+  } REPEAT
+}
+
+// This is a cut-down version of the reader's tokenize function.
+
+// Cintsys passes us the entire command line as a single string and doesn't
+// quote values in any way, so we can't reliably reconstruct arguments with
+// whitespace in them.
+LET read_argv() = VALOF
+{ LET s = readline(str_bcpl2mal(""))
+  LET tokens, tailp = empty, @tokens
+  LET sd = s + str_data
+  LET tokstart, token = ?, ?
+  FOR p = 1 TO s!str_len DO
+  { tokstart := p
+    // Within this SWITCHON command, use LOOP to ignore input, or ENDCASE to
+    // emit a token.
+    SWITCHON sd%p INTO
+    { CASE ' ': CASE '*t': CASE '*n': LOOP // Inter-token whitespace
+      DEFAULT: // Word
+        WHILE p < s!str_len DO
+        { p := p + 1
+	  SWITCHON sd%p INTO
+          { CASE ' ': CASE '*t': CASE '*n':
+              p := p - 1; BREAK
+          }
+        }
+        ENDCASE
+    }
+    // At this point, tokstart points to the first character of the token,
+    // and p points to the last character.
+    token := str_substr(s, tokstart, p + 1)
+    !tailp := cons(token, empty)
+    tailp := @(!tailp)!lst_rest
+  }
+  RESULTIS tokens
+}
+
+LET start() = VALOF
+{ init_types()
+  wrch('*n') // Terminate prompt printed by Cintsys
+  repl(read_argv())
+  RESULTIS 0
+}

From c3ca3d1678476d486ce57dbb255bb517eea3c7d8 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 19 May 2020 09:40:26 +0100
Subject: [PATCH 113/148] bcpl: Make dependencies more compact in Makefile

All the steps from 4 onwards use the same files, so they can have a
single rule for their dependencies.
---
 impls/bcpl/Makefile | 11 +++--------
 1 file changed, 3 insertions(+), 8 deletions(-)

diff --git a/impls/bcpl/Makefile b/impls/bcpl/Makefile
index e8b8357fbf..f89fd14e51 100644
--- a/impls/bcpl/Makefile
+++ b/impls/bcpl/Makefile
@@ -7,15 +7,10 @@ all: step0_repl step1_read_print step2_eval step3_env step4_if_fn_do \
 .DELETE_ON_ERROR:
 
 step0_repl: readline.b types.b
-step1_read_print: printer.b reader.b readline.b types.b
-step2_eval: printer.b reader.b readline.b types.b
+step1_read_print step2_eval: printer.b reader.b readline.b types.b
 step3_env: env.b printer.b reader.b readline.b types.b
-step4_if_fn_do: core.b env.b printer.b reader.b readline.b types.b
-step5_tco: core.b env.b printer.b reader.b readline.b types.b
-step6_file: core.b env.b printer.b reader.b readline.b types.b
-step7_quote: core.b env.b printer.b reader.b readline.b types.b
-step8_macros: core.b env.b printer.b reader.b readline.b types.b
-step9_try: core.b env.b printer.b reader.b readline.b types.b
+step4_if_fn_do step5_tco step6_file step7_quote step8_macros step9_try: \
+  core.b env.b printer.b reader.b readline.b types.b
 
 clean:
 	rm step0_repl step1_read_print step2_eval step3_env step4_if_fn_do \

From d03776870b666d4ac2c21cea88f37b6e6ccfc9c4 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 19 May 2020 10:12:51 +0100
Subject: [PATCH 114/148] bcpl: Use "rm -f" for "make clean"

---
 impls/bcpl/Makefile | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/impls/bcpl/Makefile b/impls/bcpl/Makefile
index f89fd14e51..3b61a868b9 100644
--- a/impls/bcpl/Makefile
+++ b/impls/bcpl/Makefile
@@ -13,5 +13,5 @@ step4_if_fn_do step5_tco step6_file step7_quote step8_macros step9_try: \
   core.b env.b printer.b reader.b readline.b types.b
 
 clean:
-	rm step0_repl step1_read_print step2_eval step3_env step4_if_fn_do \
-	   step5_tco step6_file step7_quote step8_macros step9_try
+	rm -f step0_repl step1_read_print step2_eval step3_env step4_if_fn_do \
+	      step5_tco step6_file step7_quote step8_macros step9_try

From e66c8d76a80025cedb3e8fa18e195c8e968af93c Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 19 May 2020 10:14:00 +0100
Subject: [PATCH 115/148] bcpl: Functional try*/catch*

---
 impls/bcpl/core.b      |  5 +++++
 impls/bcpl/env.b       |  2 +-
 impls/bcpl/step9_try.b | 16 ++++++++++++++++
 3 files changed, 22 insertions(+), 1 deletion(-)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index 035bef1c35..d4da269f66 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -240,5 +240,10 @@ LET core_env() = VALOF
     def(env, "reset!", bare_fun(reset))
     def(env, "swap!", bare_fun(swap))
   }
+
+  // Control-flow functions
+  { LET core_throw(fn, args) = throw(args!lst_first)
+    def(env, "throw", bare_fun(core_throw))
+  }
   RESULTIS env
 }
diff --git a/impls/bcpl/env.b b/impls/bcpl/env.b
index f605009782..0a6ed13719 100644
--- a/impls/bcpl/env.b
+++ b/impls/bcpl/env.b
@@ -28,6 +28,6 @@ LET env_find(env, key) = VALOF
 
 LET env_get(env, key) = VALOF
 { env := env_find(env, key)
-  IF env = nil THEN throwf("symbol %v not found", key)
+  IF env = nil THEN throwf("'%v' not found", key)
   RESULTIS hm_get(env!env_data, key)
 }
diff --git a/impls/bcpl/step9_try.b b/impls/bcpl/step9_try.b
index e98390de78..f101ef3c2c 100644
--- a/impls/bcpl/step9_try.b
+++ b/impls/bcpl/step9_try.b
@@ -115,6 +115,22 @@ AND EVAL(ast, env, gc_root) = VALOF
     }
     IF is_sym(fn, "macroexpand") THEN
       RESULTIS macroexpand(ast!lst_rest!lst_first, env, gc_root)
+    IF is_sym(fn, "try**") THEN
+    { LET old_catch_level, old_catch_label = catch_level, catch_label
+      LET result, catcher = ?, ?
+      catch_level, catch_label := level(), catch
+      result := EVAL(ast!lst_rest!lst_first, env, gc_inner_root)
+      catch_level, catch_label := old_catch_level, old_catch_label
+      RESULTIS result
+     catch:
+      catch_level, catch_label := old_catch_level, old_catch_label
+      catcher := ast!lst_rest!lst_rest!lst_first
+      IF catcher = nil THEN throw(last_exception)
+      env := env_new(env, empty, empty)
+      env_set(env, nth(catcher, 1), last_exception)
+      ast := nth(catcher, 2)
+      LOOP // TCO
+    }
     IF is_sym(fn, "do") THEN
     { LET tail = ast!lst_rest
       UNTIL tail!lst_rest = empty DO

From e69e2c997879bac4d1d87d94f70355427ee0508b Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 19 May 2020 20:32:41 +0100
Subject: [PATCH 116/148] bcpl: Core "apply" function

---
 impls/bcpl/core.b | 12 ++++++++++++
 1 file changed, 12 insertions(+)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index d4da269f66..c6703ba3ed 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -243,7 +243,19 @@ LET core_env() = VALOF
 
   // Control-flow functions
   { LET core_throw(fn, args) = throw(args!lst_first)
+    LET apply(fn, args, gc_root) = VALOF {
+      LET inner_fn, head, tailp = args!lst_first, empty, @head
+      args := args!lst_rest
+      UNTIL args!lst_rest = empty DO
+      { !tailp := cons(args!lst_first, empty)
+        tailp := @(!tailp)!lst_rest
+	args := args!lst_rest
+      }
+      !tailp := as_lst(args!lst_first)
+      RESULTIS (inner_fn!fun_code)(inner_fn, head, gc_root)
+    }
     def(env, "throw", bare_fun(core_throw))
+    def(env, "apply", bare_fun(apply))
   }
   RESULTIS env
 }

From 3bf9263fe6efdc30408ce3b742894fd6154e5119 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 19 May 2020 21:44:54 +0100
Subject: [PATCH 117/148] bcpl: "map" core function

---
 impls/bcpl/core.b | 13 +++++++++++++
 1 file changed, 13 insertions(+)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index c6703ba3ed..ce1fc18f09 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -254,8 +254,21 @@ LET core_env() = VALOF
       !tailp := as_lst(args!lst_first)
       RESULTIS (inner_fn!fun_code)(inner_fn, head, gc_root)
     }
+    LET map(fn, args, gc_root) = VALOF
+    { LET inner_fn, seq = args!lst_first, as_lst(args!lst_rest!lst_first)
+      LET dummy_head, tail = cons(nil, empty), dummy_head
+      LET gc_inner_root = alloc_vecn(4, seq, dummy_head, inner_fn, gc_root)
+      UNTIL seq = empty DO
+      { tail!lst_rest :=
+          cons((inner_fn!fun_code)(inner_fn, cons(seq!lst_first, nil),
+                                   gc_inner_root), empty)
+        tail, seq := tail!lst_rest, seq!lst_rest
+      }
+      RESULTIS dummy_head!lst_rest
+    }
     def(env, "throw", bare_fun(core_throw))
     def(env, "apply", bare_fun(apply))
+    def(env, "map", bare_fun(map))
   }
   RESULTIS env
 }

From 75dfd991be85e5831d1e58111c2bb2de3052281b Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 19 May 2020 22:13:18 +0100
Subject: [PATCH 118/148] bcpl: A bunch of single-argument predicates

---
 impls/bcpl/core.b | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index ce1fc18f09..874cce241b 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -57,10 +57,26 @@ LET core_env() = VALOF
     LET emptyp(val) = val =
       empty | supertype OF val = t_vec & val!vec_len = 0 -> TRUE, FALSE
     LET atomp(val) = type OF val = t_atm
+    LET nilp(val) = val = nil
+    LET truep(val) = val = mtrue
+    LET falsep(val) = val = mfalse
+    LET symbolp(val) = type OF val = t_sym
+    LET keywordp(val) = type OF val = t_kwd
+    LET vectorp(val) = type OF val = t_vec
+    LET sequentialp(val) = type OF val = t_lst | type OF val = t_vec
+    LET mapp(val) = type OF val = t_hm0 | supertype OF val = t_hmi
 
     def(env, "list?", pred_fun(listp))
     def(env, "empty?", pred_fun(emptyp))
     def(env, "atom?", pred_fun(atomp))
+    def(env, "nil?", pred_fun(nilp))
+    def(env, "true?", pred_fun(truep))
+    def(env, "false?", pred_fun(falsep))
+    def(env, "symbol?", pred_fun(symbolp))
+    def(env, "keyword?", pred_fun(keywordp))
+    def(env, "vector?", pred_fun(vectorp))
+    def(env, "sequential?", pred_fun(sequentialp))
+    def(env, "map?", pred_fun(mapp))
   }
 
   // Comparisons

From 0ed037b6b332680bab7e0bc1e581a192a9e4cf7c Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 19 May 2020 22:41:43 +0100
Subject: [PATCH 119/148] bcpl: "symbol" and "keyword" conversion functions

---
 impls/bcpl/core.b | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index 874cce241b..ac72cf9973 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -224,7 +224,14 @@ LET core_env() = VALOF
 
   // Constructors
   { LET list(fn, args) = args
-    def (env, "list", bare_fun(list))
+    LET str_conv(fn, args) = VALOF
+    { UNLESS supertype OF (args!lst_first) = t_str DO
+        throwf("Cannot treat %v as a string", args!lst_first)
+      RESULTIS (fn!wf_wrapped)(args!lst_first)
+    }
+    def(env, "list", bare_fun(list))
+    def(env, "symbol", alloc_fun(str_conv, wf_sz, as_sym))
+    def(env, "keyword", alloc_fun(str_conv, wf_sz, as_kwd))
   }
 
   // Atom functions

From d58328c4b32d767315d3357de99046cbca32ac71 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 19 May 2020 22:48:09 +0100
Subject: [PATCH 120/148] bcpl: Add "vector" core function

---
 impls/bcpl/core.b | 11 +++++++++++
 1 file changed, 11 insertions(+)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index ac72cf9973..457944f9a5 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -229,9 +229,20 @@ LET core_env() = VALOF
         throwf("Cannot treat %v as a string", args!lst_first)
       RESULTIS (fn!wf_wrapped)(args!lst_first)
     }
+    LET vector(fn, args) = VALOF
+    { LET vec = ?
+      LET ptr, n = args, 0
+      UNTIL ptr = empty DO
+        n, ptr := n + 1, ptr!lst_rest
+      vec := alloc_vec(n)
+      FOR i = 0 TO n - 1 DO
+        (vec+vec_data)!i, args := args!lst_first, args!lst_rest
+      RESULTIS vec
+    }
     def(env, "list", bare_fun(list))
     def(env, "symbol", alloc_fun(str_conv, wf_sz, as_sym))
     def(env, "keyword", alloc_fun(str_conv, wf_sz, as_kwd))
+    def(env, "vector", bare_fun(vector))
   }
 
   // Atom functions

From 89cbe0271cbe15efcf98620aca73568079f0c836 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 19 May 2020 22:54:55 +0100
Subject: [PATCH 121/148] bcpl: "hash-map" core function

---
 impls/bcpl/core.b | 9 +++++++++
 1 file changed, 9 insertions(+)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index 457944f9a5..76caaf0d2c 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -239,10 +239,19 @@ LET core_env() = VALOF
         (vec+vec_data)!i, args := args!lst_first, args!lst_rest
       RESULTIS vec
     }
+    LET hash_map(fn, args) = VALOF
+    { LET hm = empty_hashmap
+      UNTIL args = empty DO
+      { hm := hm_set(hm, args!lst_first, args!lst_rest!lst_first)
+        args := args!lst_rest!lst_rest
+      }
+      RESULTIS hm
+    }
     def(env, "list", bare_fun(list))
     def(env, "symbol", alloc_fun(str_conv, wf_sz, as_sym))
     def(env, "keyword", alloc_fun(str_conv, wf_sz, as_kwd))
     def(env, "vector", bare_fun(vector))
+    def(env, "hash-map", bare_fun(hash_map))
   }
 
   // Atom functions

From c02fa92e0bf147b47795ad9bcbd4aa80ecad7542 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 19 May 2020 23:12:53 +0100
Subject: [PATCH 122/148] bcpl: "assoc", "dissoc", and "get" core functions

---
 impls/bcpl/core.b   | 37 +++++++++++++++++++++++++++++++------
 impls/bcpl/malhdr.h |  2 +-
 2 files changed, 32 insertions(+), 7 deletions(-)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index 76caaf0d2c..17656aaa12 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -239,19 +239,44 @@ LET core_env() = VALOF
         (vec+vec_data)!i, args := args!lst_first, args!lst_rest
       RESULTIS vec
     }
-    LET hash_map(fn, args) = VALOF
-    { LET hm = empty_hashmap
+    def(env, "list", bare_fun(list))
+    def(env, "symbol", alloc_fun(str_conv, wf_sz, as_sym))
+    def(env, "keyword", alloc_fun(str_conv, wf_sz, as_kwd))
+    def(env, "vector", bare_fun(vector))
+  }
+
+  // Hash-map functions
+  { LET assert_hashmap(hm) = VALOF
+    { UNLESS hm = empty_hashmap | supertype OF hm = t_hmi DO
+        throwf("Not a hash-map: %v", hm)
+      RESULTIS hm
+    }
+    LET assoc(fn, args) = VALOF
+    { LET hm = assert_hashmap(args!lst_first)
+      args := args!lst_rest
       UNTIL args = empty DO
       { hm := hm_set(hm, args!lst_first, args!lst_rest!lst_first)
         args := args!lst_rest!lst_rest
       }
       RESULTIS hm
     }
-    def(env, "list", bare_fun(list))
-    def(env, "symbol", alloc_fun(str_conv, wf_sz, as_sym))
-    def(env, "keyword", alloc_fun(str_conv, wf_sz, as_kwd))
-    def(env, "vector", bare_fun(vector))
+    LET hash_map(fn, args) = assoc(fn, cons(empty_hashmap, args))
+    LET dissoc(fn, args) = VALOF
+    { LET hm = assert_hashmap(args!lst_first)
+      args := args!lst_rest
+      UNTIL args = empty DO
+        hm, args := hm_remove(hm, args!lst_first), args!lst_rest
+      RESULTIS hm
+    }
+    LET get(fn, args) = VALOF
+    { LET hm = assert_hashmap(args!lst_first)
+      RESULTIS hm_get(hm, args!lst_rest!lst_first)
+    }
+
     def(env, "hash-map", bare_fun(hash_map))
+    def(env, "assoc", bare_fun(assoc))
+    def(env, "dissoc", bare_fun(dissoc))
+    def(env, "get", bare_fun(get))
   }
 
   // Atom functions
diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index 0917363fca..f6c9f21426 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -9,7 +9,7 @@ GLOBAL { readline: ug
 	 alloc_int
 	 str_setlen; alloc_str; str_substr; str_bcpl2mal
 	 as_sym; as_kwd; str_eq_const
-	 hm_set; hm_contains; hm_get; hm_dump
+	 hm_set; hm_contains; hm_remove; hm_get; hm_dump
 	 alloc_vec; alloc_vecn
 	 alloc_fun
 	 alloc_atm

From a685f3dcf16792653fc49a2271a43bc370172133 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Tue, 19 May 2020 23:26:07 +0100
Subject: [PATCH 123/148] bcpl: "contains?" core function

---
 impls/bcpl/core.b | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index 17656aaa12..f8860831d8 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -268,15 +268,17 @@ LET core_env() = VALOF
         hm, args := hm_remove(hm, args!lst_first), args!lst_rest
       RESULTIS hm
     }
-    LET get(fn, args) = VALOF
-    { LET hm = assert_hashmap(args!lst_first)
-      RESULTIS hm_get(hm, args!lst_rest!lst_first)
-    }
+    LET get(fn, args) =
+      hm_get(assert_hashmap(args!lst_first), args!lst_rest!lst_first)
+    LET containsp(fn, args) =
+      hm_contains(assert_hashmap(args!lst_first), args!lst_rest!lst_first) ->
+        mtrue, mfalse
 
     def(env, "hash-map", bare_fun(hash_map))
     def(env, "assoc", bare_fun(assoc))
     def(env, "dissoc", bare_fun(dissoc))
     def(env, "get", bare_fun(get))
+    def(env, "contains?", bare_fun(containsp))
   }
 
   // Atom functions

From df676e6583e74e4833cd72afd0d4f8b9f31aaf3e Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Mon, 25 May 2020 12:15:03 +0100
Subject: [PATCH 124/148] bcpl: Add "keys" and "vals" core functions

---
 impls/bcpl/core.b | 15 ++++++++++++++-
 1 file changed, 14 insertions(+), 1 deletion(-)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index f8860831d8..0f494bda56 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -273,12 +273,25 @@ LET core_env() = VALOF
     LET containsp(fn, args) =
       hm_contains(assert_hashmap(args!lst_first), args!lst_rest!lst_first) ->
         mtrue, mfalse
-
+    LET fields(fn, args, field) = VALOF
+    { LET hm = assert_hashmap(args!lst_first)
+      LET fields1(hm, field, acc) = VALOF
+      { IF type OF hm = t_hmx RESULTIS cons(hm!field, acc)
+        acc := fields1(hm!hmi_right, field, acc)
+        RESULTIS fields1(hm!hmi_left, field, acc)
+      }
+      IF type OF hm = t_hm0 RESULTIS empty
+      RESULTIS fields1(hm, field, empty)
+    }
+    LET keys(fn, args) = fields(fn, args, hmx_key)
+    LET vals(fn, args) = fields(fn, args, hmx_value)
     def(env, "hash-map", bare_fun(hash_map))
     def(env, "assoc", bare_fun(assoc))
     def(env, "dissoc", bare_fun(dissoc))
     def(env, "get", bare_fun(get))
     def(env, "contains?", bare_fun(containsp))
+    def(env, "keys", bare_fun(keys))
+    def(env, "vals", bare_fun(vals))
   }
 
   // Atom functions

From 35f4f3248ce9562507b0f30d012d44daab1d49ef Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Mon, 25 May 2020 12:20:23 +0100
Subject: [PATCH 125/148] Rename assert_hashmap to as_hashmap and add
 conversion from nil

All mandatory step 9 tests now pass, though we seem to have a
regression or two.
---
 impls/bcpl/core.b | 15 ++++++++-------
 1 file changed, 8 insertions(+), 7 deletions(-)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index 0f494bda56..dad78a4c04 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -246,13 +246,14 @@ LET core_env() = VALOF
   }
 
   // Hash-map functions
-  { LET assert_hashmap(hm) = VALOF
-    { UNLESS hm = empty_hashmap | supertype OF hm = t_hmi DO
+  { LET as_hashmap(hm) = VALOF
+    { IF hm = nil THEN hm := empty_hashmap
+      UNLESS hm = empty_hashmap | supertype OF hm = t_hmi DO
         throwf("Not a hash-map: %v", hm)
       RESULTIS hm
     }
     LET assoc(fn, args) = VALOF
-    { LET hm = assert_hashmap(args!lst_first)
+    { LET hm = as_hashmap(args!lst_first)
       args := args!lst_rest
       UNTIL args = empty DO
       { hm := hm_set(hm, args!lst_first, args!lst_rest!lst_first)
@@ -262,19 +263,19 @@ LET core_env() = VALOF
     }
     LET hash_map(fn, args) = assoc(fn, cons(empty_hashmap, args))
     LET dissoc(fn, args) = VALOF
-    { LET hm = assert_hashmap(args!lst_first)
+    { LET hm = as_hashmap(args!lst_first)
       args := args!lst_rest
       UNTIL args = empty DO
         hm, args := hm_remove(hm, args!lst_first), args!lst_rest
       RESULTIS hm
     }
     LET get(fn, args) =
-      hm_get(assert_hashmap(args!lst_first), args!lst_rest!lst_first)
+      hm_get(as_hashmap(args!lst_first), args!lst_rest!lst_first)
     LET containsp(fn, args) =
-      hm_contains(assert_hashmap(args!lst_first), args!lst_rest!lst_first) ->
+      hm_contains(as_hashmap(args!lst_first), args!lst_rest!lst_first) ->
         mtrue, mfalse
     LET fields(fn, args, field) = VALOF
-    { LET hm = assert_hashmap(args!lst_first)
+    { LET hm = as_hashmap(args!lst_first)
       LET fields1(hm, field, acc) = VALOF
       { IF type OF hm = t_hmx RESULTIS cons(hm!field, acc)
         acc := fields1(hm!hmi_right, field, acc)

From 66e1cb85c03f2fc959fb0e1c2fd6253d736de3e0 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Mon, 25 May 2020 12:50:07 +0100
Subject: [PATCH 126/148] bcpl: Initialise step A

---
 impls/bcpl/Makefile    |   7 +-
 impls/bcpl/stepA_mal.b | 258 +++++++++++++++++++++++++++++++++++++++++
 2 files changed, 262 insertions(+), 3 deletions(-)
 create mode 100644 impls/bcpl/stepA_mal.b

diff --git a/impls/bcpl/Makefile b/impls/bcpl/Makefile
index 3b61a868b9..cb6ecdde85 100644
--- a/impls/bcpl/Makefile
+++ b/impls/bcpl/Makefile
@@ -1,5 +1,5 @@
 all: step0_repl step1_read_print step2_eval step3_env step4_if_fn_do \
-     step5_tco step6_file step7_quote step8_macros step9_try
+     step5_tco step6_file step7_quote step8_macros step9_try stepA_mal
 
 %: %.b malhdr.h
 	cintsys -c "bcpl $< to $@"
@@ -9,9 +9,10 @@ all: step0_repl step1_read_print step2_eval step3_env step4_if_fn_do \
 step0_repl: readline.b types.b
 step1_read_print step2_eval: printer.b reader.b readline.b types.b
 step3_env: env.b printer.b reader.b readline.b types.b
-step4_if_fn_do step5_tco step6_file step7_quote step8_macros step9_try: \
+step4_if_fn_do step5_tco step6_file step7_quote step8_macros step9_try \
+  stepA_mal: \
   core.b env.b printer.b reader.b readline.b types.b
 
 clean:
 	rm -f step0_repl step1_read_print step2_eval step3_env step4_if_fn_do \
-	      step5_tco step6_file step7_quote step8_macros step9_try
+	      step5_tco step6_file step7_quote step8_macros step9_try stepA_mal
diff --git a/impls/bcpl/stepA_mal.b b/impls/bcpl/stepA_mal.b
new file mode 100644
index 0000000000..f101ef3c2c
--- /dev/null
+++ b/impls/bcpl/stepA_mal.b
@@ -0,0 +1,258 @@
+GET "libhdr"
+GET "malhdr"
+
+GET "core.b"
+GET "env.b"
+GET "printer.b"
+GET "reader.b"
+GET "readline.b"
+GET "types.b"
+
+LET READ(x) = read_str(x)
+
+// Helper function for EVAL.
+LET is_sym(a, b) = VALOF
+{ UNLESS type OF a = t_sym RESULTIS FALSE
+  RESULTIS str_eq_const(a, b)
+}
+
+LET is_pair(ast) =
+  type OF ast = t_lst & ast ~= empty | type OF ast = t_vec & ast!vec_len > 0
+
+LET quasiquote(ast) = VALOF
+{ UNLESS is_pair(ast)
+    RESULTIS cons(as_sym(str_bcpl2mal("quote")), cons(ast, empty))
+  ast := as_lst(ast)
+  IF is_sym(ast!lst_first, "unquote") RESULTIS ast!lst_rest!lst_first
+  IF is_pair(ast!lst_first) & is_sym(ast!lst_first!lst_first, "splice-unquote")
+    RESULTIS cons(as_sym(str_bcpl2mal("concat")),
+                  cons(ast!lst_first!lst_rest!lst_first,
+		       cons(quasiquote(ast!lst_rest), empty)))
+  RESULTIS cons(as_sym(str_bcpl2mal("cons")),
+                cons(quasiquote(ast!lst_first),
+		     cons(quasiquote(ast!lst_rest), empty)))
+}
+
+LET is_macro_call(ast, env) = VALOF
+{ LET fn = ?
+  UNLESS type OF ast = t_lst & type OF (ast!lst_first) = t_sym &
+         env_find(env, ast!lst_first) ~= nil RESULTIS FALSE
+  fn := env_get(env, ast!lst_first)
+  RESULTIS type OF fn = t_mfn & mfn_ismacro OF fn ~= 0
+}
+
+LET macroexpand(ast, env, gc_root) = VALOF
+{ WHILE is_macro_call(ast, env) DO
+  { LET fn = env_get(env, ast!lst_first)
+    ast := (fn!fun_code)(fn, ast!lst_rest, gc_root)
+  }
+  RESULTIS ast
+}
+
+LET eval_ast(ast, env, gc_root) = VALOF
+  SWITCHON type OF ast INTO
+  { CASE t_sym: RESULTIS env_get(env, ast)
+    CASE t_lst:
+      TEST ast = empty THEN RESULTIS empty
+      ELSE
+      { LET first = EVAL(ast!lst_first, env, gc_root)
+        LET rest = eval_ast(ast!lst_rest, env, cons(first, gc_root))
+        RESULTIS cons(first, rest)
+      }
+    CASE t_vec:
+      { LET new = alloc_vec(ast!vec_len)
+        LET gc_inner_root = cons(new, gc_root)
+        FOR i = 0 TO ast!vec_len - 1 DO
+	  (new + vec_data)!i := EVAL((ast + vec_data)!i, env, gc_inner_root)
+	RESULTIS new
+      }
+    CASE t_hmx:
+      RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_root))
+    CASE t_hmi:
+      { LET left  = eval_ast(ast!hmi_left,  env, gc_root)
+	LET right = eval_ast(ast!hmi_right, env, cons(left, gc_root))
+	RESULTIS alloc_hmi(hmi_critbit OF ast, left, right)
+      }
+    DEFAULT: RESULTIS ast
+  }
+
+AND EVAL(ast, env, gc_root) = VALOF
+{ MANIFEST { fun_binds = fun_data; fun_body; fun_env; fun_sz }
+  LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
+  gc_mark(gc_inner_root)
+  gc_sweep()
+  UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env, gc_root)
+  ast := macroexpand(ast, env, gc_inner_root)
+  UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env, gc_root)
+  IF ast = empty RESULTIS ast
+  { LET fn = ast!lst_first
+    IF is_sym(fn, "def!") THEN
+    { LET val = EVAL(nth(ast, 2), env, gc_inner_root)
+      env_set(env, nth(ast, 1), val, env)
+      RESULTIS val
+    }
+    IF is_sym(fn, "let**") THEN
+    { LET newenv, bindings = env_new(env, empty, empty), as_lst(nth(ast, 1))
+      gc_inner_root := alloc_vecn(3, newenv, bindings, gc_inner_root)
+      UNTIL bindings = empty DO
+      { env_set(newenv, bindings!lst_first,
+                EVAL(nth(bindings, 1), newenv, gc_inner_root))
+        bindings := bindings!lst_rest!lst_rest
+      }
+      ast, env := nth(ast, 2), newenv
+      LOOP // TCO
+    }
+    IF is_sym(fn, "quote") RESULTIS ast!lst_rest!lst_first
+    IF is_sym(fn, "quasiquote") THEN
+    { ast := quasiquote(ast!lst_rest!lst_first)
+      LOOP // TCO
+    }
+    IF is_sym(fn, "defmacro!") THEN
+    { LET val = EVAL(nth(ast, 2), env, gc_inner_root)
+      IF type OF val = t_mfn THEN mfn_ismacro OF val := 1
+      env_set(env, nth(ast, 1), val, env)
+      RESULTIS val
+    }
+    IF is_sym(fn, "macroexpand") THEN
+      RESULTIS macroexpand(ast!lst_rest!lst_first, env, gc_root)
+    IF is_sym(fn, "try**") THEN
+    { LET old_catch_level, old_catch_label = catch_level, catch_label
+      LET result, catcher = ?, ?
+      catch_level, catch_label := level(), catch
+      result := EVAL(ast!lst_rest!lst_first, env, gc_inner_root)
+      catch_level, catch_label := old_catch_level, old_catch_label
+      RESULTIS result
+     catch:
+      catch_level, catch_label := old_catch_level, old_catch_label
+      catcher := ast!lst_rest!lst_rest!lst_first
+      IF catcher = nil THEN throw(last_exception)
+      env := env_new(env, empty, empty)
+      env_set(env, nth(catcher, 1), last_exception)
+      ast := nth(catcher, 2)
+      LOOP // TCO
+    }
+    IF is_sym(fn, "do") THEN
+    { LET tail = ast!lst_rest
+      UNTIL tail!lst_rest = empty DO
+      { EVAL(tail!lst_first, env, gc_inner_root)
+        tail := tail!lst_rest
+      }
+      ast := tail!lst_first
+      LOOP // TCO
+    }
+    IF is_sym(fn, "if") THEN
+    { LET cond = EVAL(nth(ast, 1), env, gc_inner_root)
+      LET tail = ast!lst_rest!lst_rest
+      IF cond = nil | cond = mfalse THEN tail := tail!lst_rest
+      ast := tail!lst_first
+      LOOP // TCO
+    }
+    IF is_sym(fn, "fn**") THEN
+    { LET call(fun, args, gc_root) =
+          EVAL(fun!fun_body, env_new(fun!fun_env, fun!fun_binds, args), gc_root)
+      LET result = alloc_fun(call, fun_sz,
+                             as_lst(nth(ast, 1)), nth(ast, 2), env)
+      fun_ntracked OF result := 3
+      type OF result := t_mfn
+      RESULTIS result
+    }
+  }
+  ast := eval_ast(ast, env, gc_inner_root)
+  { LET fn, args = ast!lst_first, ast!lst_rest
+    UNLESS supertype OF fn = t_fun DO throwf("not a function")
+    IF type OF fn = t_mfn THEN
+    { ast, env := fn!fun_body, env_new(fn!fun_env, fn!fun_binds, args)
+      LOOP // TCO
+    }
+    RESULTIS (fn!fun_code)(fn, args, gc_root)
+  }
+} REPEAT
+
+LET PRINT(x) = pr_str(x)
+
+STATIC { repl_env }
+
+LET rep(x) = PRINT(EVAL(READ(x), repl_env), nil)
+
+LET repl(argv) BE
+{ LET mal_eval(fn, args, gc_root) = EVAL(args!lst_first, repl_env, gc_root)
+  catch_level, catch_label := level(), uncaught_exit
+  repl_env := core_env()
+  env_set(repl_env, as_sym(str_bcpl2mal("eval")), alloc_fun(mal_eval, fun_data))
+  env_set(repl_env, as_sym(str_bcpl2mal("**FILE**")), argv!lst_first)
+  env_set(repl_env, as_sym(str_bcpl2mal("**ARGV**")), argv!lst_rest)
+  rep(str_bcpl2mal("(def! not (fn** (a) (if a false true)))"), repl_env)
+  rep(str_bcpl2mal("(def! load-file (fn** (f) (eval (read-string *
+                    *(str *"(do *" (slurp f) *"*nnil)*")))))"), repl_env)
+  rep(str_bcpl2mal("(defmacro! cond (fn** (& xs) (if (> (count xs) 0) *
+                    *(list 'if (first xs) (if (> (count xs) 1) (nth xs 1) *
+                    *(throw *"odd number of forms to cond*")) *
+                    *(cons 'cond (rest (rest xs)))))))"), repl_env)
+  UNLESS argv = empty DO
+  {
+    rep(str_bcpl2mal("(load-file **FILE**)"))
+    sys(Sys_quit, 0)
+    uncaught_exit:
+    writes("Uncaught exception: ")
+    writes(@(pr_str(last_exception)!str_data))
+    newline()
+    sys(Sys_quit, 1)
+  }
+  catch_level, catch_label := level(), uncaught
+  IF FALSE THEN
+  { uncaught:
+    writes("Uncaught exception: ")
+    writes(@(pr_str(last_exception)!str_data))
+    newline()
+  }
+  { LET prompt = str_bcpl2mal("user> ")
+    LET line = readline(prompt)
+    IF line = nil THEN BREAK
+    writes(@rep(line)!str_data)
+    newline()
+    gc_mark(repl_env)
+    gc_sweep()
+  } REPEAT
+}
+
+// This is a cut-down version of the reader's tokenize function.
+
+// Cintsys passes us the entire command line as a single string and doesn't
+// quote values in any way, so we can't reliably reconstruct arguments with
+// whitespace in them.
+LET read_argv() = VALOF
+{ LET s = readline(str_bcpl2mal(""))
+  LET tokens, tailp = empty, @tokens
+  LET sd = s + str_data
+  LET tokstart, token = ?, ?
+  FOR p = 1 TO s!str_len DO
+  { tokstart := p
+    // Within this SWITCHON command, use LOOP to ignore input, or ENDCASE to
+    // emit a token.
+    SWITCHON sd%p INTO
+    { CASE ' ': CASE '*t': CASE '*n': LOOP // Inter-token whitespace
+      DEFAULT: // Word
+        WHILE p < s!str_len DO
+        { p := p + 1
+	  SWITCHON sd%p INTO
+          { CASE ' ': CASE '*t': CASE '*n':
+              p := p - 1; BREAK
+          }
+        }
+        ENDCASE
+    }
+    // At this point, tokstart points to the first character of the token,
+    // and p points to the last character.
+    token := str_substr(s, tokstart, p + 1)
+    !tailp := cons(token, empty)
+    tailp := @(!tailp)!lst_rest
+  }
+  RESULTIS tokens
+}
+
+LET start() = VALOF
+{ init_types()
+  wrch('*n') // Terminate prompt printed by Cintsys
+  repl(read_argv())
+  RESULTIS 0
+}

From cd5e6d41f07f8f585c7b8e03cc3a9750f08f87bf Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Mon, 25 May 2020 12:59:01 +0100
Subject: [PATCH 127/148] bcpl: Complete the set of string conversions with
 as_str()

Since all three are basically the same function, re-implement them in
terms of a single parameterised function.
---
 impls/bcpl/malhdr.h |  2 +-
 impls/bcpl/types.b  | 21 ++++++++-------------
 2 files changed, 9 insertions(+), 14 deletions(-)

diff --git a/impls/bcpl/malhdr.h b/impls/bcpl/malhdr.h
index f6c9f21426..c282d06d01 100644
--- a/impls/bcpl/malhdr.h
+++ b/impls/bcpl/malhdr.h
@@ -8,7 +8,7 @@ GLOBAL { readline: ug
 	 cons; nth; as_lst
 	 alloc_int
 	 str_setlen; alloc_str; str_substr; str_bcpl2mal
-	 as_sym; as_kwd; str_eq_const
+	 as_str; as_sym; as_kwd; str_eq_const
 	 hm_set; hm_contains; hm_remove; hm_get; hm_dump
 	 alloc_vec; alloc_vecn
 	 alloc_fun
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index bff0673f8c..6a9be70ddc 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -131,21 +131,16 @@ LET str_substr(s, start, end) = VALOF
   RESULTIS ss
 }
 
-LET as_sym(val) = VALOF
-{ LET sym = ?
-  IF type OF val = t_sym THEN RESULTIS val
-  sym := str_dup(val)
-  type OF sym := t_sym
-  RESULTIS sym
+LET as_strtype(val, want_type) = VALOF
+{ IF type OF val = want_type THEN RESULTIS val
+  val := str_dup(val)
+  type OF val := want_type
+  RESULTIS val
 }
 
-LET as_kwd(val) = VALOF
-{ LET kwd = ?
-  IF type OF val = t_kwd THEN RESULTIS val
-  kwd := str_dup(val)
-  type OF kwd := t_kwd
-  RESULTIS kwd
-}
+LET as_str(val) = as_strtype(val, t_str)
+LET as_sym(val) = as_strtype(val, t_sym)
+LET as_kwd(val) = as_strtype(val, t_kwd)
 
 LET str_bcpl2mal(bcplstr) = VALOF
 { LET result = alloc_str(bcplstr%0)

From c4652a8c5e141a4e2aa9baf497fa4abdb5d88680 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Mon, 25 May 2020 13:00:24 +0100
Subject: [PATCH 128/148] bcpl: Add "readline" core function

---
 impls/bcpl/core.b | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index dad78a4c04..1dc49b2a58 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -188,7 +188,7 @@ LET core_env() = VALOF
     def(env, "println", bare_fun(println))
   }
 
-  // File-access function
+  // Input/output functions
   { LET slurp(fn, args) = VALOF
     { LET scb = ?
       LET oldcis = cis
@@ -219,7 +219,9 @@ LET core_env() = VALOF
       endstream(scb)
       RESULTIS dest
     }
+    LET core_readline(fn, args) = readline(as_str(args!lst_first))
     def(env, "slurp", bare_fun(slurp))
+    def(env, "readline", bare_fun(core_readline))
   }
 
   // Constructors

From 97310c9893f6c5830f310c1044bffc28852ee097 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Mon, 25 May 2020 13:52:39 +0100
Subject: [PATCH 129/148] bcpl: Improved hash-map dumper

It now records values, because I needed that to find a stupid bug.
---
 impls/bcpl/types.b | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index 6a9be70ddc..0cb877e396 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -290,7 +290,7 @@ LET hm_dumpi(map, pfx, lastbit) BE
       p := p + 1
       lastbit := lastbit - BITSPERBCPLWORD
     }
-    writes("*n")
+    writef(" v: %8x*n", map!hmx_value)
   }
 }
 

From 90a981c18591a21cbee5da4a3b6ef3772eca987d Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Mon, 25 May 2020 13:53:52 +0100
Subject: [PATCH 130/148] bcpl: Add *host-language* and startup banner

---
 impls/bcpl/stepA_mal.b | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/impls/bcpl/stepA_mal.b b/impls/bcpl/stepA_mal.b
index f101ef3c2c..00b6881aa0 100644
--- a/impls/bcpl/stepA_mal.b
+++ b/impls/bcpl/stepA_mal.b
@@ -181,6 +181,8 @@ LET repl(argv) BE
   env_set(repl_env, as_sym(str_bcpl2mal("eval")), alloc_fun(mal_eval, fun_data))
   env_set(repl_env, as_sym(str_bcpl2mal("**FILE**")), argv!lst_first)
   env_set(repl_env, as_sym(str_bcpl2mal("**ARGV**")), argv!lst_rest)
+  env_set(repl_env, as_sym(str_bcpl2mal("**host-language**")),
+          str_bcpl2mal("BCPL"))
   rep(str_bcpl2mal("(def! not (fn** (a) (if a false true)))"), repl_env)
   rep(str_bcpl2mal("(def! load-file (fn** (f) (eval (read-string *
                     *(str *"(do *" (slurp f) *"*nnil)*")))))"), repl_env)
@@ -198,6 +200,7 @@ LET repl(argv) BE
     newline()
     sys(Sys_quit, 1)
   }
+  rep(str_bcpl2mal("(println (str *"Mal [*" **host-language** *"]*"))"))
   catch_level, catch_label := level(), uncaught
   IF FALSE THEN
   { uncaught:

From 8c5b260ebb6bea8d250c8d823e95fffcc80b8341 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Mon, 25 May 2020 14:10:03 +0100
Subject: [PATCH 131/148] bcpl: Add remaining type predicates

---
 impls/bcpl/core.b | 8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index 1dc49b2a58..814df13fff 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -60,11 +60,15 @@ LET core_env() = VALOF
     LET nilp(val) = val = nil
     LET truep(val) = val = mtrue
     LET falsep(val) = val = mfalse
+    LET numberp(val) = type OF val = t_int
+    LET stringp(val) = type OF val = t_str
     LET symbolp(val) = type OF val = t_sym
     LET keywordp(val) = type OF val = t_kwd
     LET vectorp(val) = type OF val = t_vec
     LET sequentialp(val) = type OF val = t_lst | type OF val = t_vec
     LET mapp(val) = type OF val = t_hm0 | supertype OF val = t_hmi
+    LET macrop(val) = type OF val = t_mfn & mfn_ismacro OF val = 1
+    LET fnp(val) = supertype OF val = t_fun & ~macrop(val)
 
     def(env, "list?", pred_fun(listp))
     def(env, "empty?", pred_fun(emptyp))
@@ -72,11 +76,15 @@ LET core_env() = VALOF
     def(env, "nil?", pred_fun(nilp))
     def(env, "true?", pred_fun(truep))
     def(env, "false?", pred_fun(falsep))
+    def(env, "number?", pred_fun(numberp))
+    def(env, "string?", pred_fun(stringp))
     def(env, "symbol?", pred_fun(symbolp))
     def(env, "keyword?", pred_fun(keywordp))
     def(env, "vector?", pred_fun(vectorp))
     def(env, "sequential?", pred_fun(sequentialp))
     def(env, "map?", pred_fun(mapp))
+    def(env, "fn?", pred_fun(fnp))
+    def(env, "macro?", pred_fun(macrop))
   }
 
   // Comparisons

From a99915a19e4c7001e5557135791e1b0406e1b017 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Mon, 25 May 2020 14:45:26 +0100
Subject: [PATCH 132/148] bcpl: Add "conj" core function

---
 impls/bcpl/core.b | 23 +++++++++++++++++++++++
 1 file changed, 23 insertions(+)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index 814df13fff..518571787d 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -160,12 +160,35 @@ LET core_env() = VALOF
       RESULTIS as_lst(seq)!lst_first
     }
     LET rest(fn, args) = as_lst(args!lst_first)!lst_rest
+    LET conj(fn, args) = VALOF
+    { LET seq = args!lst_first
+      args := args!lst_rest
+      IF type OF seq = t_lst THEN
+      { UNTIL args = empty DO
+          seq, args := cons(args!lst_first, seq), args!lst_rest
+	RESULTIS seq
+      }
+      IF type OF seq = t_vec THEN
+      { LET vec = ?
+        LET n, ptr = seq!vec_len, args
+        UNTIL ptr = empty DO
+	  n, ptr := n + 1, ptr!lst_rest
+	vec := alloc_vec(n)
+	FOR i = 0 TO seq!vec_len - 1 DO
+	  (vec+vec_data)!i := (seq+vec_data)!i
+	FOR i = seq!vec_len TO n - 1 DO
+	  (vec+vec_data)!i, args := args!lst_first, args!lst_rest
+	RESULTIS vec
+      }
+      throwf("conj applied to non-sequence")
+    }	
     def(env, "cons", bare_fun(core_cons))
     def(env, "concat", bare_fun(concat))
     def(env, "count", bare_fun(count))
     def(env, "nth", bare_fun(core_nth))
     def(env, "first", bare_fun(first))
     def(env, "rest", bare_fun(rest))
+    def(env, "conj", bare_fun(conj))
   }
 
   // Reading function

From 654eb9c1d124c5f1d8e323e0c9f7535cd4a20325 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Mon, 25 May 2020 15:02:32 +0100
Subject: [PATCH 133/148] bcpl: Add "seq" core function

---
 impls/bcpl/core.b | 21 ++++++++++++++++++++-
 1 file changed, 20 insertions(+), 1 deletion(-)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index 518571787d..801ab01a5d 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -181,7 +181,25 @@ LET core_env() = VALOF
 	RESULTIS vec
       }
       throwf("conj applied to non-sequence")
-    }	
+    }
+    LET seq(fn, args) = VALOF
+    { LET arg = args!lst_first
+      IF arg = empty | arg = nil RESULTIS nil
+      IF type OF arg = t_lst RESULTIS arg
+      IF type OF arg = t_vec RESULTIS arg!vec_len = 0 -> nil, as_lst(arg)
+      IF supertype OF arg = t_str THEN
+      { LET l = empty
+        IF arg!str_len = 0 RESULTIS nil
+        FOR i = arg!str_len TO 1 BY -1 DO
+	{ LET s = alloc_str(1)
+	  (s+str_data)%1 := (arg+str_data)%i
+	  str_setlen(s, 1)
+	  l := cons(s, l)
+	}
+	RESULTIS l
+      }
+      throwf("invalid argument to seq")
+    }
     def(env, "cons", bare_fun(core_cons))
     def(env, "concat", bare_fun(concat))
     def(env, "count", bare_fun(count))
@@ -189,6 +207,7 @@ LET core_env() = VALOF
     def(env, "first", bare_fun(first))
     def(env, "rest", bare_fun(rest))
     def(env, "conj", bare_fun(conj))
+    def(env, "seq", bare_fun(seq))
   }
 
   // Reading function

From 9ee46c05dc6281a3ac7211a1da113d4c112d3ad1 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Mon, 25 May 2020 15:05:29 +0100
Subject: [PATCH 134/148] bcpl: Prefer to detect empty hashmaps with "=
 empty_hashmap"

This is faster and slightly more obvious than checking the type.
---
 impls/bcpl/core.b  | 4 ++--
 impls/bcpl/types.b | 2 +-
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index 801ab01a5d..08b2379900 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -66,7 +66,7 @@ LET core_env() = VALOF
     LET keywordp(val) = type OF val = t_kwd
     LET vectorp(val) = type OF val = t_vec
     LET sequentialp(val) = type OF val = t_lst | type OF val = t_vec
-    LET mapp(val) = type OF val = t_hm0 | supertype OF val = t_hmi
+    LET mapp(val) = val = empty_hashmap | supertype OF val = t_hmi
     LET macrop(val) = type OF val = t_mfn & mfn_ismacro OF val = 1
     LET fnp(val) = supertype OF val = t_fun & ~macrop(val)
 
@@ -333,7 +333,7 @@ LET core_env() = VALOF
         acc := fields1(hm!hmi_right, field, acc)
         RESULTIS fields1(hm!hmi_left, field, acc)
       }
-      IF type OF hm = t_hm0 RESULTIS empty
+      IF hm = empty_hashmap RESULTIS empty
       RESULTIS fields1(hm, field, empty)
     }
     LET keys(fn, args) = fields(fn, args, hmx_key)
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index 0cb877e396..d7e9c791af 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -295,7 +295,7 @@ LET hm_dumpi(map, pfx, lastbit) BE
 }
 
 LET hm_dump(map) BE
-{ TEST type OF map = t_hm0 THEN writes("[empty]*n")
+{ TEST map = empty_hashmap THEN writes("[empty]*n")
                            ELSE hm_dumpi(map, 0, 0)
 }
 

From 59fa59e74113500193d4836d7f62c70c6a428dcf Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Mon, 25 May 2020 15:18:30 +0100
Subject: [PATCH 135/148] bcpl: Add "time-ms" core function

---
 impls/bcpl/core.b | 10 ++++++++++
 1 file changed, 10 insertions(+)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index 08b2379900..ec62ec31a7 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -270,8 +270,18 @@ LET core_env() = VALOF
       RESULTIS dest
     }
     LET core_readline(fn, args) = readline(as_str(args!lst_first))
+    LET time_ms(fn, args) = VALOF
+    { LET datv = VEC 3
+      datstamp(datv)
+      // On systems with big enough words, return milliseconds since epoch.
+      IF BITSPERBCPLWORD >= 44 THEN
+        RESULTIS alloc_int(datv!0 * 86400000 + datv!1)
+      // Otherwise, return millisends since start of day.
+      RESULTIS alloc_int(datv!1)
+    }
     def(env, "slurp", bare_fun(slurp))
     def(env, "readline", bare_fun(core_readline))
+    def(env, "time-ms", bare_fun(time_ms))
   }
 
   // Constructors

From c0ae9185e82f788e77c54509971b5b50d9f8e40c Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Mon, 25 May 2020 15:34:08 +0100
Subject: [PATCH 136/148] bcpl: Re-implement readline() to be more like slurp

This is a little easier to read, supports >256-char input lines, and
doesn't return the trailing newline.  The latter is required by the
tests.
---
 impls/bcpl/readline.b | 28 ++++++++++++++++++----------
 1 file changed, 18 insertions(+), 10 deletions(-)

diff --git a/impls/bcpl/readline.b b/impls/bcpl/readline.b
index 3875f6db87..135556294b 100644
--- a/impls/bcpl/readline.b
+++ b/impls/bcpl/readline.b
@@ -7,17 +7,25 @@ MANIFEST
 // readline returns a newly-allocated mal string.
 // 'prompt' is a mal string,
 LET readline(prompt) = VALOF
-{ LET buf = VEC 1 + buflen / bytesperword
-  LET p = 1
+{ LET dest, dest_size, ptr = ?, 1024, 1
   LET ch = 0
   writes(@prompt!str_data)
   deplete(cos)
-  { IF p > buflen THEN { writes("Input line too long"); FINISH }
-    ch := rdch()
-    IF ch = endstreamch THEN RESULTIS nil
-    buf%p := ch
-    p := p + 1
-  } REPEATUNTIL ch = '*n'
-  buf%0 := p - 1
-  RESULTIS str_bcpl2mal(buf)
+  dest := alloc_str(dest_size)
+  { LET c = rdch()
+    IF c = endstreamch RESULTIS nil
+    IF c = '*n' BREAK
+    IF ptr >= dest_size THEN
+    { LET tmp = ?
+      dest_size := dest_size * 2
+      tmp := alloc_str(dest_size)
+      FOR i = 1 TO str_data + dest_size / bytesperword DO
+        tmp!i := dest!i
+      dest := tmp
+    }
+    (dest + str_data)%ptr := c
+    ptr := ptr + 1
+  } REPEAT
+  str_setlen(dest, ptr - 1)
+  RESULTIS dest
 }

From 50830691291ab2d189a980125e229e2f94917a0f Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Mon, 25 May 2020 15:40:32 +0100
Subject: [PATCH 137/148] bcpl: Add unimplemented stubs of "meta" and
 "with-meta"

---
 impls/bcpl/core.b | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/impls/bcpl/core.b b/impls/bcpl/core.b
index ec62ec31a7..01034b933a 100644
--- a/impls/bcpl/core.b
+++ b/impls/bcpl/core.b
@@ -416,5 +416,11 @@ LET core_env() = VALOF
     def(env, "apply", bare_fun(apply))
     def(env, "map", bare_fun(map))
   }
+
+  // Unimplemented stubs
+  { LET not_implemented() BE throwf("not implemented")
+    def(env, "meta", bare_fun(not_implemented))
+    def(env, "with-meta", bare_fun(not_implemented))
+  }
   RESULTIS env
 }

From 4fcff5e7ddd9691d24658f7625187f2757495fc6 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Mon, 25 May 2020 16:11:55 +0100
Subject: [PATCH 138/148] bcpl: Replace calls to gc_mark() and gc_sweep() with
 calls to gc()

---
 impls/bcpl/step4_if_fn_do.b | 3 +--
 impls/bcpl/step5_tco.b      | 6 ++----
 impls/bcpl/step6_file.b     | 6 ++----
 impls/bcpl/step7_quote.b    | 6 ++----
 impls/bcpl/step8_macros.b   | 6 ++----
 impls/bcpl/step9_try.b      | 6 ++----
 impls/bcpl/stepA_mal.b      | 6 ++----
 7 files changed, 13 insertions(+), 26 deletions(-)

diff --git a/impls/bcpl/step4_if_fn_do.b b/impls/bcpl/step4_if_fn_do.b
index 60297e257f..72b9b0c3e2 100644
--- a/impls/bcpl/step4_if_fn_do.b
+++ b/impls/bcpl/step4_if_fn_do.b
@@ -118,8 +118,7 @@ LET repl() BE
     IF line = nil THEN BREAK
     writes(@rep(line)!str_data)
     newline()
-    gc_mark(repl_env)
-    gc_sweep()
+    gc(repl_env)
   } REPEAT
 }
 
diff --git a/impls/bcpl/step5_tco.b b/impls/bcpl/step5_tco.b
index a7f2b0cbd6..41f53e827e 100644
--- a/impls/bcpl/step5_tco.b
+++ b/impls/bcpl/step5_tco.b
@@ -46,8 +46,7 @@ LET eval_ast(ast, env, gc_root) = VALOF
 AND EVAL(ast, env, gc_root) = VALOF
 { MANIFEST { fun_binds = fun_data; fun_body; fun_env; fun_sz }
   LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
-  gc_mark(gc_inner_root)
-  gc_sweep()
+  gc(gc_inner_root)
   UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env, gc_root)
   IF ast = empty RESULTIS ast
   { LET fn = ast!lst_first
@@ -125,8 +124,7 @@ LET repl() BE
     IF line = nil THEN BREAK
     writes(@rep(line)!str_data)
     newline()
-    gc_mark(repl_env)
-    gc_sweep()
+    gc(repl_env)
   } REPEAT
 }
 
diff --git a/impls/bcpl/step6_file.b b/impls/bcpl/step6_file.b
index 85027924a7..39f45a4be8 100644
--- a/impls/bcpl/step6_file.b
+++ b/impls/bcpl/step6_file.b
@@ -46,8 +46,7 @@ LET eval_ast(ast, env, gc_root) = VALOF
 AND EVAL(ast, env, gc_root) = VALOF
 { MANIFEST { fun_binds = fun_data; fun_body; fun_env; fun_sz }
   LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
-  gc_mark(gc_inner_root)
-  gc_sweep()
+  gc(gc_inner_root)
   UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env, gc_root)
   IF ast = empty RESULTIS ast
   { LET fn = ast!lst_first
@@ -142,8 +141,7 @@ LET repl(argv) BE
     IF line = nil THEN BREAK
     writes(@rep(line)!str_data)
     newline()
-    gc_mark(repl_env)
-    gc_sweep()
+    gc(repl_env)
   } REPEAT
 }
 
diff --git a/impls/bcpl/step7_quote.b b/impls/bcpl/step7_quote.b
index 69b337cb38..20741c76f9 100644
--- a/impls/bcpl/step7_quote.b
+++ b/impls/bcpl/step7_quote.b
@@ -63,8 +63,7 @@ LET eval_ast(ast, env, gc_root) = VALOF
 AND EVAL(ast, env, gc_root) = VALOF
 { MANIFEST { fun_binds = fun_data; fun_body; fun_env; fun_sz }
   LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
-  gc_mark(gc_inner_root)
-  gc_sweep()
+  gc(gc_inner_root)
   UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env, gc_root)
   IF ast = empty RESULTIS ast
   { LET fn = ast!lst_first
@@ -164,8 +163,7 @@ LET repl(argv) BE
     IF line = nil THEN BREAK
     writes(@rep(line)!str_data)
     newline()
-    gc_mark(repl_env)
-    gc_sweep()
+    gc(repl_env)
   } REPEAT
 }
 
diff --git a/impls/bcpl/step8_macros.b b/impls/bcpl/step8_macros.b
index e98390de78..f41db248fa 100644
--- a/impls/bcpl/step8_macros.b
+++ b/impls/bcpl/step8_macros.b
@@ -79,8 +79,7 @@ LET eval_ast(ast, env, gc_root) = VALOF
 AND EVAL(ast, env, gc_root) = VALOF
 { MANIFEST { fun_binds = fun_data; fun_body; fun_env; fun_sz }
   LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
-  gc_mark(gc_inner_root)
-  gc_sweep()
+  gc(gc_inner_root)
   UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env, gc_root)
   ast := macroexpand(ast, env, gc_inner_root)
   UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env, gc_root)
@@ -194,8 +193,7 @@ LET repl(argv) BE
     IF line = nil THEN BREAK
     writes(@rep(line)!str_data)
     newline()
-    gc_mark(repl_env)
-    gc_sweep()
+    gc(repl_env)
   } REPEAT
 }
 
diff --git a/impls/bcpl/step9_try.b b/impls/bcpl/step9_try.b
index f101ef3c2c..2ef3ca61b3 100644
--- a/impls/bcpl/step9_try.b
+++ b/impls/bcpl/step9_try.b
@@ -79,8 +79,7 @@ LET eval_ast(ast, env, gc_root) = VALOF
 AND EVAL(ast, env, gc_root) = VALOF
 { MANIFEST { fun_binds = fun_data; fun_body; fun_env; fun_sz }
   LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
-  gc_mark(gc_inner_root)
-  gc_sweep()
+  gc(gc_inner_root)
   UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env, gc_root)
   ast := macroexpand(ast, env, gc_inner_root)
   UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env, gc_root)
@@ -210,8 +209,7 @@ LET repl(argv) BE
     IF line = nil THEN BREAK
     writes(@rep(line)!str_data)
     newline()
-    gc_mark(repl_env)
-    gc_sweep()
+    gc(repl_env)
   } REPEAT
 }
 
diff --git a/impls/bcpl/stepA_mal.b b/impls/bcpl/stepA_mal.b
index 00b6881aa0..8faf79b418 100644
--- a/impls/bcpl/stepA_mal.b
+++ b/impls/bcpl/stepA_mal.b
@@ -79,8 +79,7 @@ LET eval_ast(ast, env, gc_root) = VALOF
 AND EVAL(ast, env, gc_root) = VALOF
 { MANIFEST { fun_binds = fun_data; fun_body; fun_env; fun_sz }
   LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
-  gc_mark(gc_inner_root)
-  gc_sweep()
+  gc(gc_inner_root)
   UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env, gc_root)
   ast := macroexpand(ast, env, gc_inner_root)
   UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env, gc_root)
@@ -213,8 +212,7 @@ LET repl(argv) BE
     IF line = nil THEN BREAK
     writes(@rep(line)!str_data)
     newline()
-    gc_mark(repl_env)
-    gc_sweep()
+    gc(repl_env)
   } REPEAT
 }
 

From 3981b4b6cc06aac3213a685996d41fb81c3e8df8 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Mon, 25 May 2020 18:50:16 +0100
Subject: [PATCH 139/148] bcpl: Propagate some important GC changes through all
 the steps

The changes had somehow ended up only in step 4, which meant all the
later steps were broken.
---
 impls/bcpl/step5_tco.b    | 18 +++++++++++-------
 impls/bcpl/step6_file.b   | 18 +++++++++++-------
 impls/bcpl/step7_quote.b  | 18 +++++++++++-------
 impls/bcpl/step8_macros.b | 18 +++++++++++-------
 impls/bcpl/step9_try.b    | 18 +++++++++++-------
 impls/bcpl/stepA_mal.b    | 18 +++++++++++-------
 6 files changed, 66 insertions(+), 42 deletions(-)

diff --git a/impls/bcpl/step5_tco.b b/impls/bcpl/step5_tco.b
index 41f53e827e..22c8f682ec 100644
--- a/impls/bcpl/step5_tco.b
+++ b/impls/bcpl/step5_tco.b
@@ -22,22 +22,26 @@ LET eval_ast(ast, env, gc_root) = VALOF
     CASE t_lst:
       TEST ast = empty THEN RESULTIS empty
       ELSE
-      { LET first = EVAL(ast!lst_first, env, gc_root)
+      { LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
+        LET first = EVAL(ast!lst_first, env, gc_inner_root)
         LET rest = eval_ast(ast!lst_rest, env, cons(first, gc_root))
         RESULTIS cons(first, rest)
       }
     CASE t_vec:
       { LET new = alloc_vec(ast!vec_len)
-        LET gc_inner_root = cons(new, gc_root)
+        LET gc_inner_root = alloc_vecn(4, new, ast, env, gc_root)
         FOR i = 0 TO ast!vec_len - 1 DO
 	  (new + vec_data)!i := EVAL((ast + vec_data)!i, env, gc_inner_root)
 	RESULTIS new
       }
     CASE t_hmx:
-      RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_root))
+      { LET gc_inner_root = cons(ast, gc_root)
+        RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_root))
+      }
     CASE t_hmi:
-      { LET left  = eval_ast(ast!hmi_left,  env, gc_root)
-	LET right = eval_ast(ast!hmi_right, env, cons(left, gc_root))
+      { LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
+        LET left  = eval_ast(ast!hmi_left,  env, gc_inner_root)
+	LET right = eval_ast(ast!hmi_right, env, cons(left, gc_inner_root))
 	RESULTIS alloc_hmi(hmi_critbit OF ast, left, right)
       }
     DEFAULT: RESULTIS ast
@@ -92,7 +96,7 @@ AND EVAL(ast, env, gc_root) = VALOF
       RESULTIS result
     }
   }
-  ast := eval_ast(ast, env, gc_inner_root)
+  ast := eval_ast(ast, env, gc_root)
   { LET fn, args = ast!lst_first, ast!lst_rest
     UNLESS supertype OF fn = t_fun DO throwf("not a function")
     IF type OF fn = t_mfn THEN
@@ -107,7 +111,7 @@ LET PRINT(x) = pr_str(x)
 
 STATIC { repl_env }
 
-LET rep(x) = PRINT(EVAL(READ(x), repl_env), nil)
+LET rep(x) = PRINT(EVAL(READ(x), repl_env, nil))
 
 LET repl() BE
 { repl_env := core_env()
diff --git a/impls/bcpl/step6_file.b b/impls/bcpl/step6_file.b
index 39f45a4be8..e747df43d9 100644
--- a/impls/bcpl/step6_file.b
+++ b/impls/bcpl/step6_file.b
@@ -22,22 +22,26 @@ LET eval_ast(ast, env, gc_root) = VALOF
     CASE t_lst:
       TEST ast = empty THEN RESULTIS empty
       ELSE
-      { LET first = EVAL(ast!lst_first, env, gc_root)
+      { LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
+        LET first = EVAL(ast!lst_first, env, gc_inner_root)
         LET rest = eval_ast(ast!lst_rest, env, cons(first, gc_root))
         RESULTIS cons(first, rest)
       }
     CASE t_vec:
       { LET new = alloc_vec(ast!vec_len)
-        LET gc_inner_root = cons(new, gc_root)
+        LET gc_inner_root = alloc_vecn(4, new, ast, env, gc_root)
         FOR i = 0 TO ast!vec_len - 1 DO
 	  (new + vec_data)!i := EVAL((ast + vec_data)!i, env, gc_inner_root)
 	RESULTIS new
       }
     CASE t_hmx:
-      RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_root))
+      { LET gc_inner_root = cons(ast, gc_root)
+        RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_root))
+      }
     CASE t_hmi:
-      { LET left  = eval_ast(ast!hmi_left,  env, gc_root)
-	LET right = eval_ast(ast!hmi_right, env, cons(left, gc_root))
+      { LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
+        LET left  = eval_ast(ast!hmi_left,  env, gc_inner_root)
+	LET right = eval_ast(ast!hmi_right, env, cons(left, gc_inner_root))
 	RESULTIS alloc_hmi(hmi_critbit OF ast, left, right)
       }
     DEFAULT: RESULTIS ast
@@ -92,7 +96,7 @@ AND EVAL(ast, env, gc_root) = VALOF
       RESULTIS result
     }
   }
-  ast := eval_ast(ast, env, gc_inner_root)
+  ast := eval_ast(ast, env, gc_root)
   { LET fn, args = ast!lst_first, ast!lst_rest
     UNLESS supertype OF fn = t_fun DO throwf("not a function")
     IF type OF fn = t_mfn THEN
@@ -107,7 +111,7 @@ LET PRINT(x) = pr_str(x)
 
 STATIC { repl_env }
 
-LET rep(x) = PRINT(EVAL(READ(x), repl_env), nil)
+LET rep(x) = PRINT(EVAL(READ(x), repl_env, nil))
 
 LET repl(argv) BE
 { LET mal_eval(fn, args, gc_root) = EVAL(args!lst_first, repl_env, gc_root)
diff --git a/impls/bcpl/step7_quote.b b/impls/bcpl/step7_quote.b
index 20741c76f9..1b647743a1 100644
--- a/impls/bcpl/step7_quote.b
+++ b/impls/bcpl/step7_quote.b
@@ -39,22 +39,26 @@ LET eval_ast(ast, env, gc_root) = VALOF
     CASE t_lst:
       TEST ast = empty THEN RESULTIS empty
       ELSE
-      { LET first = EVAL(ast!lst_first, env, gc_root)
+      { LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
+        LET first = EVAL(ast!lst_first, env, gc_inner_root)
         LET rest = eval_ast(ast!lst_rest, env, cons(first, gc_root))
         RESULTIS cons(first, rest)
       }
     CASE t_vec:
       { LET new = alloc_vec(ast!vec_len)
-        LET gc_inner_root = cons(new, gc_root)
+        LET gc_inner_root = alloc_vecn(4, new, ast, env, gc_root)
         FOR i = 0 TO ast!vec_len - 1 DO
 	  (new + vec_data)!i := EVAL((ast + vec_data)!i, env, gc_inner_root)
 	RESULTIS new
       }
     CASE t_hmx:
-      RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_root))
+      { LET gc_inner_root = cons(ast, gc_root)
+        RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_root))
+      }
     CASE t_hmi:
-      { LET left  = eval_ast(ast!hmi_left,  env, gc_root)
-	LET right = eval_ast(ast!hmi_right, env, cons(left, gc_root))
+      { LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
+        LET left  = eval_ast(ast!hmi_left,  env, gc_inner_root)
+	LET right = eval_ast(ast!hmi_right, env, cons(left, gc_inner_root))
 	RESULTIS alloc_hmi(hmi_critbit OF ast, left, right)
       }
     DEFAULT: RESULTIS ast
@@ -114,7 +118,7 @@ AND EVAL(ast, env, gc_root) = VALOF
       RESULTIS result
     }
   }
-  ast := eval_ast(ast, env, gc_inner_root)
+  ast := eval_ast(ast, env, gc_root)
   { LET fn, args = ast!lst_first, ast!lst_rest
     UNLESS supertype OF fn = t_fun DO throwf("not a function")
     IF type OF fn = t_mfn THEN
@@ -129,7 +133,7 @@ LET PRINT(x) = pr_str(x)
 
 STATIC { repl_env }
 
-LET rep(x) = PRINT(EVAL(READ(x), repl_env), nil)
+LET rep(x) = PRINT(EVAL(READ(x), repl_env, nil))
 
 LET repl(argv) BE
 { LET mal_eval(fn, args, gc_root) = EVAL(args!lst_first, repl_env, gc_root)
diff --git a/impls/bcpl/step8_macros.b b/impls/bcpl/step8_macros.b
index f41db248fa..fb60f5bb1d 100644
--- a/impls/bcpl/step8_macros.b
+++ b/impls/bcpl/step8_macros.b
@@ -55,22 +55,26 @@ LET eval_ast(ast, env, gc_root) = VALOF
     CASE t_lst:
       TEST ast = empty THEN RESULTIS empty
       ELSE
-      { LET first = EVAL(ast!lst_first, env, gc_root)
+      { LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
+        LET first = EVAL(ast!lst_first, env, gc_inner_root)
         LET rest = eval_ast(ast!lst_rest, env, cons(first, gc_root))
         RESULTIS cons(first, rest)
       }
     CASE t_vec:
       { LET new = alloc_vec(ast!vec_len)
-        LET gc_inner_root = cons(new, gc_root)
+        LET gc_inner_root = alloc_vecn(4, new, ast, env, gc_root)
         FOR i = 0 TO ast!vec_len - 1 DO
 	  (new + vec_data)!i := EVAL((ast + vec_data)!i, env, gc_inner_root)
 	RESULTIS new
       }
     CASE t_hmx:
-      RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_root))
+      { LET gc_inner_root = cons(ast, gc_root)
+        RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_root))
+      }
     CASE t_hmi:
-      { LET left  = eval_ast(ast!hmi_left,  env, gc_root)
-	LET right = eval_ast(ast!hmi_right, env, cons(left, gc_root))
+      { LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
+        LET left  = eval_ast(ast!hmi_left,  env, gc_inner_root)
+	LET right = eval_ast(ast!hmi_right, env, cons(left, gc_inner_root))
 	RESULTIS alloc_hmi(hmi_critbit OF ast, left, right)
       }
     DEFAULT: RESULTIS ast
@@ -140,7 +144,7 @@ AND EVAL(ast, env, gc_root) = VALOF
       RESULTIS result
     }
   }
-  ast := eval_ast(ast, env, gc_inner_root)
+  ast := eval_ast(ast, env, gc_root)
   { LET fn, args = ast!lst_first, ast!lst_rest
     UNLESS supertype OF fn = t_fun DO throwf("not a function")
     IF type OF fn = t_mfn THEN
@@ -155,7 +159,7 @@ LET PRINT(x) = pr_str(x)
 
 STATIC { repl_env }
 
-LET rep(x) = PRINT(EVAL(READ(x), repl_env), nil)
+LET rep(x) = PRINT(EVAL(READ(x), repl_env, nil))
 
 LET repl(argv) BE
 { LET mal_eval(fn, args, gc_root) = EVAL(args!lst_first, repl_env, gc_root)
diff --git a/impls/bcpl/step9_try.b b/impls/bcpl/step9_try.b
index 2ef3ca61b3..56360aebb2 100644
--- a/impls/bcpl/step9_try.b
+++ b/impls/bcpl/step9_try.b
@@ -55,22 +55,26 @@ LET eval_ast(ast, env, gc_root) = VALOF
     CASE t_lst:
       TEST ast = empty THEN RESULTIS empty
       ELSE
-      { LET first = EVAL(ast!lst_first, env, gc_root)
+      { LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
+        LET first = EVAL(ast!lst_first, env, gc_inner_root)
         LET rest = eval_ast(ast!lst_rest, env, cons(first, gc_root))
         RESULTIS cons(first, rest)
       }
     CASE t_vec:
       { LET new = alloc_vec(ast!vec_len)
-        LET gc_inner_root = cons(new, gc_root)
+        LET gc_inner_root = alloc_vecn(4, new, ast, env, gc_root)
         FOR i = 0 TO ast!vec_len - 1 DO
 	  (new + vec_data)!i := EVAL((ast + vec_data)!i, env, gc_inner_root)
 	RESULTIS new
       }
     CASE t_hmx:
-      RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_root))
+      { LET gc_inner_root = cons(ast, gc_root)
+        RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_root))
+      }
     CASE t_hmi:
-      { LET left  = eval_ast(ast!hmi_left,  env, gc_root)
-	LET right = eval_ast(ast!hmi_right, env, cons(left, gc_root))
+      { LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
+        LET left  = eval_ast(ast!hmi_left,  env, gc_inner_root)
+	LET right = eval_ast(ast!hmi_right, env, cons(left, gc_inner_root))
 	RESULTIS alloc_hmi(hmi_critbit OF ast, left, right)
       }
     DEFAULT: RESULTIS ast
@@ -156,7 +160,7 @@ AND EVAL(ast, env, gc_root) = VALOF
       RESULTIS result
     }
   }
-  ast := eval_ast(ast, env, gc_inner_root)
+  ast := eval_ast(ast, env, gc_root)
   { LET fn, args = ast!lst_first, ast!lst_rest
     UNLESS supertype OF fn = t_fun DO throwf("not a function")
     IF type OF fn = t_mfn THEN
@@ -171,7 +175,7 @@ LET PRINT(x) = pr_str(x)
 
 STATIC { repl_env }
 
-LET rep(x) = PRINT(EVAL(READ(x), repl_env), nil)
+LET rep(x) = PRINT(EVAL(READ(x), repl_env, nil))
 
 LET repl(argv) BE
 { LET mal_eval(fn, args, gc_root) = EVAL(args!lst_first, repl_env, gc_root)
diff --git a/impls/bcpl/stepA_mal.b b/impls/bcpl/stepA_mal.b
index 8faf79b418..634e3a9007 100644
--- a/impls/bcpl/stepA_mal.b
+++ b/impls/bcpl/stepA_mal.b
@@ -55,22 +55,26 @@ LET eval_ast(ast, env, gc_root) = VALOF
     CASE t_lst:
       TEST ast = empty THEN RESULTIS empty
       ELSE
-      { LET first = EVAL(ast!lst_first, env, gc_root)
+      { LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
+        LET first = EVAL(ast!lst_first, env, gc_inner_root)
         LET rest = eval_ast(ast!lst_rest, env, cons(first, gc_root))
         RESULTIS cons(first, rest)
       }
     CASE t_vec:
       { LET new = alloc_vec(ast!vec_len)
-        LET gc_inner_root = cons(new, gc_root)
+        LET gc_inner_root = alloc_vecn(4, new, ast, env, gc_root)
         FOR i = 0 TO ast!vec_len - 1 DO
 	  (new + vec_data)!i := EVAL((ast + vec_data)!i, env, gc_inner_root)
 	RESULTIS new
       }
     CASE t_hmx:
-      RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_root))
+      { LET gc_inner_root = cons(ast, gc_root)
+        RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_root))
+      }
     CASE t_hmi:
-      { LET left  = eval_ast(ast!hmi_left,  env, gc_root)
-	LET right = eval_ast(ast!hmi_right, env, cons(left, gc_root))
+      { LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
+        LET left  = eval_ast(ast!hmi_left,  env, gc_inner_root)
+	LET right = eval_ast(ast!hmi_right, env, cons(left, gc_inner_root))
 	RESULTIS alloc_hmi(hmi_critbit OF ast, left, right)
       }
     DEFAULT: RESULTIS ast
@@ -156,7 +160,7 @@ AND EVAL(ast, env, gc_root) = VALOF
       RESULTIS result
     }
   }
-  ast := eval_ast(ast, env, gc_inner_root)
+  ast := eval_ast(ast, env, gc_root)
   { LET fn, args = ast!lst_first, ast!lst_rest
     UNLESS supertype OF fn = t_fun DO throwf("not a function")
     IF type OF fn = t_mfn THEN
@@ -171,7 +175,7 @@ LET PRINT(x) = pr_str(x)
 
 STATIC { repl_env }
 
-LET rep(x) = PRINT(EVAL(READ(x), repl_env), nil)
+LET rep(x) = PRINT(EVAL(READ(x), repl_env, nil))
 
 LET repl(argv) BE
 { LET mal_eval(fn, args, gc_root) = EVAL(args!lst_first, repl_env, gc_root)

From 8e739fde32b3b70c56abe5b294d17590577a6d65 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Mon, 25 May 2020 19:01:19 +0100
Subject: [PATCH 140/148] bcpl: Fix a gc_root in eval_ast

I accidentally passed gc_root when I meant gc_inner_root.
---
 impls/bcpl/step4_if_fn_do.b | 2 +-
 impls/bcpl/step5_tco.b      | 2 +-
 impls/bcpl/step6_file.b     | 2 +-
 impls/bcpl/step7_quote.b    | 2 +-
 impls/bcpl/step8_macros.b   | 2 +-
 impls/bcpl/step9_try.b      | 2 +-
 impls/bcpl/stepA_mal.b      | 2 +-
 7 files changed, 7 insertions(+), 7 deletions(-)

diff --git a/impls/bcpl/step4_if_fn_do.b b/impls/bcpl/step4_if_fn_do.b
index 72b9b0c3e2..73d093ad97 100644
--- a/impls/bcpl/step4_if_fn_do.b
+++ b/impls/bcpl/step4_if_fn_do.b
@@ -36,7 +36,7 @@ LET eval_ast(ast, env, gc_root) = VALOF
       }
     CASE t_hmx:
       { LET gc_inner_root = cons(ast, gc_root)
-        RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_root))
+        RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_inner_root))
       }
     CASE t_hmi:
       { LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
diff --git a/impls/bcpl/step5_tco.b b/impls/bcpl/step5_tco.b
index 22c8f682ec..34fc7b9851 100644
--- a/impls/bcpl/step5_tco.b
+++ b/impls/bcpl/step5_tco.b
@@ -36,7 +36,7 @@ LET eval_ast(ast, env, gc_root) = VALOF
       }
     CASE t_hmx:
       { LET gc_inner_root = cons(ast, gc_root)
-        RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_root))
+        RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_inner_root))
       }
     CASE t_hmi:
       { LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
diff --git a/impls/bcpl/step6_file.b b/impls/bcpl/step6_file.b
index e747df43d9..548e80f9dc 100644
--- a/impls/bcpl/step6_file.b
+++ b/impls/bcpl/step6_file.b
@@ -36,7 +36,7 @@ LET eval_ast(ast, env, gc_root) = VALOF
       }
     CASE t_hmx:
       { LET gc_inner_root = cons(ast, gc_root)
-        RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_root))
+        RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_inner_root))
       }
     CASE t_hmi:
       { LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
diff --git a/impls/bcpl/step7_quote.b b/impls/bcpl/step7_quote.b
index 1b647743a1..ecd4d56516 100644
--- a/impls/bcpl/step7_quote.b
+++ b/impls/bcpl/step7_quote.b
@@ -53,7 +53,7 @@ LET eval_ast(ast, env, gc_root) = VALOF
       }
     CASE t_hmx:
       { LET gc_inner_root = cons(ast, gc_root)
-        RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_root))
+        RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_inner_root))
       }
     CASE t_hmi:
       { LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
diff --git a/impls/bcpl/step8_macros.b b/impls/bcpl/step8_macros.b
index fb60f5bb1d..80aa49350c 100644
--- a/impls/bcpl/step8_macros.b
+++ b/impls/bcpl/step8_macros.b
@@ -69,7 +69,7 @@ LET eval_ast(ast, env, gc_root) = VALOF
       }
     CASE t_hmx:
       { LET gc_inner_root = cons(ast, gc_root)
-        RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_root))
+        RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_inner_root))
       }
     CASE t_hmi:
       { LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
diff --git a/impls/bcpl/step9_try.b b/impls/bcpl/step9_try.b
index 56360aebb2..1d52b3d33a 100644
--- a/impls/bcpl/step9_try.b
+++ b/impls/bcpl/step9_try.b
@@ -69,7 +69,7 @@ LET eval_ast(ast, env, gc_root) = VALOF
       }
     CASE t_hmx:
       { LET gc_inner_root = cons(ast, gc_root)
-        RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_root))
+        RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_inner_root))
       }
     CASE t_hmi:
       { LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)
diff --git a/impls/bcpl/stepA_mal.b b/impls/bcpl/stepA_mal.b
index 634e3a9007..59c0272c5e 100644
--- a/impls/bcpl/stepA_mal.b
+++ b/impls/bcpl/stepA_mal.b
@@ -69,7 +69,7 @@ LET eval_ast(ast, env, gc_root) = VALOF
       }
     CASE t_hmx:
       { LET gc_inner_root = cons(ast, gc_root)
-        RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_root))
+        RESULTIS alloc_hmx(ast!hmx_key, EVAL(ast!hmx_value, env, gc_inner_root))
       }
     CASE t_hmi:
       { LET gc_inner_root = alloc_vecn(3, ast, env, gc_root)

From 1a2500261138a177904ec1b3af1ce50a643c3927 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Wed, 27 May 2020 11:28:18 +0100
Subject: [PATCH 141/148] bcpl: Update gc_inner_root after macro expansion

Macro expansion can change the expression currently being evaluated
(that's the point of it, after all), and so it's important that the new
expression be protected against garbage collection.  Forgetting this
leads to subtle problems when the expression gets evaluated.
---
 impls/bcpl/step8_macros.b | 1 +
 impls/bcpl/step9_try.b    | 1 +
 impls/bcpl/stepA_mal.b    | 1 +
 3 files changed, 3 insertions(+)

diff --git a/impls/bcpl/step8_macros.b b/impls/bcpl/step8_macros.b
index 80aa49350c..9a51f160ac 100644
--- a/impls/bcpl/step8_macros.b
+++ b/impls/bcpl/step8_macros.b
@@ -86,6 +86,7 @@ AND EVAL(ast, env, gc_root) = VALOF
   gc(gc_inner_root)
   UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env, gc_root)
   ast := macroexpand(ast, env, gc_inner_root)
+  (gc_inner_root+vec_data)!0 := ast // In case it has changed.
   UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env, gc_root)
   IF ast = empty RESULTIS ast
   { LET fn = ast!lst_first
diff --git a/impls/bcpl/step9_try.b b/impls/bcpl/step9_try.b
index 1d52b3d33a..6a62d4ab25 100644
--- a/impls/bcpl/step9_try.b
+++ b/impls/bcpl/step9_try.b
@@ -86,6 +86,7 @@ AND EVAL(ast, env, gc_root) = VALOF
   gc(gc_inner_root)
   UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env, gc_root)
   ast := macroexpand(ast, env, gc_inner_root)
+  (gc_inner_root+vec_data)!0 := ast // In case it has changed.
   UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env, gc_root)
   IF ast = empty RESULTIS ast
   { LET fn = ast!lst_first
diff --git a/impls/bcpl/stepA_mal.b b/impls/bcpl/stepA_mal.b
index 59c0272c5e..119a7dea5e 100644
--- a/impls/bcpl/stepA_mal.b
+++ b/impls/bcpl/stepA_mal.b
@@ -86,6 +86,7 @@ AND EVAL(ast, env, gc_root) = VALOF
   gc(gc_inner_root)
   UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env, gc_root)
   ast := macroexpand(ast, env, gc_inner_root)
+  (gc_inner_root+vec_data)!0 := ast // In case it has changed.
   UNLESS type OF ast = t_lst RESULTIS eval_ast(ast, env, gc_root)
   IF ast = empty RESULTIS ast
   { LET fn = ast!lst_first

From 6f8d4096229937646b1313a454d66a112f1bcbd0 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Wed, 27 May 2020 11:59:40 +0100
Subject: [PATCH 142/148] bcpl: Fix step 0 to print a newline after output

---
 impls/bcpl/step0_repl.b | 1 +
 1 file changed, 1 insertion(+)

diff --git a/impls/bcpl/step0_repl.b b/impls/bcpl/step0_repl.b
index e67d323e4a..95e58d5e23 100644
--- a/impls/bcpl/step0_repl.b
+++ b/impls/bcpl/step0_repl.b
@@ -17,6 +17,7 @@ LET repl() BE
   { LET line = readline(prompt)
     IF line = nil THEN BREAK
     writes(@rep(line)!str_data)
+    newline()
   } REPEAT
 }
 

From 410f584aa3e70b0312dbd7b75a20e90e123f42ac Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Wed, 27 May 2020 13:01:27 +0100
Subject: [PATCH 143/148] bcpl: Lengthen test timeout

At the moment it gets exceeded on step 5, because the garbage collector
runs far too often.
---
 Makefile | 1 +
 1 file changed, 1 insertion(+)

diff --git a/Makefile b/Makefile
index 18a546bf04..efe207e0e8 100644
--- a/Makefile
+++ b/Makefile
@@ -144,6 +144,7 @@ dist_EXCLUDES += guile io julia matlab swift
 
 # Extra options to pass to runtest.py
 bbc-basic_TEST_OPTS = --test-timeout 60
+bcpl_TEST_OPTS = --test-timeout 120
 guile_TEST_OPTS = --test-timeout 120
 io_TEST_OPTS = --test-timeout 120
 logo_TEST_OPTS = --start-timeout 60 --test-timeout 120

From c4174c46d9ac175cc1641359bbc200731215c47f Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Wed, 27 May 2020 13:52:53 +0100
Subject: [PATCH 144/148] bcpl: Garbage-collect less often for speed.

A mark-and-sweep garbage-collector has an overhead each run of the
number of live objects, so running too often is expensive.  The
garbage-collector now only runs if the number of objects allocated since
the last run exceeds the number that were live at the end of the last
run.  This is a fairly common heuristic and improves performance
markedly.

Consequently, remove the test timeout adjustment.  It's more than fast
enough now.
---
 Makefile           |  1 -
 impls/bcpl/types.b | 14 ++++++++++++--
 2 files changed, 12 insertions(+), 3 deletions(-)

diff --git a/Makefile b/Makefile
index efe207e0e8..18a546bf04 100644
--- a/Makefile
+++ b/Makefile
@@ -144,7 +144,6 @@ dist_EXCLUDES += guile io julia matlab swift
 
 # Extra options to pass to runtest.py
 bbc-basic_TEST_OPTS = --test-timeout 60
-bcpl_TEST_OPTS = --test-timeout 120
 guile_TEST_OPTS = --test-timeout 120
 io_TEST_OPTS = --test-timeout 120
 logo_TEST_OPTS = --start-timeout 60 --test-timeout 120
diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index d7e9c791af..425efaab74 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -13,11 +13,14 @@ LET init_types() BE
   mfalse := TABLE ?, t_boo, FALSE
 }
 
+STATIC { new_objects = 0; old_objects = 0 }
+
 LET alloc_val(size) = VALOF
 { LET result = getvec(size)
   result!1 := 0 // Make sure type word is all zeroes.
   result!nextptr := nil!nextptr
   nil!nextptr := result
+  new_objects := new_objects + 1
   // writef("ALLOC: <- %8x*n", result)
   RESULTIS result
 }
@@ -46,9 +49,11 @@ LET gc_mark(x) BE
 
 LET gc_sweep() BE
 { LET last, this = nil, nil!nextptr
+  old_objects := 0
   UNTIL this = nil DO
   { TEST gc_marked OF this THEN
     { gc_marked OF this := 0
+      old_objects := old_objects + 1
       last, this := this, this!nextptr
     } ELSE
     { LET tmp = this
@@ -61,8 +66,13 @@ LET gc_sweep() BE
 }
 
 LET gc(x) BE
-{ gc_mark(x)
-  gc_sweep()
+{ IF new_objects > old_objects THEN
+  { // writef("Starting GC: ctr = %0d; last = %0d*n", alloc_ctr, alloc_last)
+    gc_mark(x)
+    gc_sweep()
+    new_objects := 0
+    // writef("GC done: last = %0d*n", alloc_last)
+  }
 }
 
 LET cons(first, rest) = VALOF

From 8c2dcf980820074f166adb1ac2b46cdeb5f192b8 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Wed, 27 May 2020 16:11:01 +0100
Subject: [PATCH 145/148] bcpl: Exit properly on error when loading file

Using sys(Sys_quit, 1) is a bad idea because it causes the Cintsys
runtime to drop into a debugger.  Replace it with sys(Sys_quit, 0),
which does at least exit if not with the exit status we'd like.
---
 impls/bcpl/step6_file.b   | 2 +-
 impls/bcpl/step7_quote.b  | 2 +-
 impls/bcpl/step8_macros.b | 2 +-
 impls/bcpl/step9_try.b    | 2 +-
 impls/bcpl/stepA_mal.b    | 2 +-
 5 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/impls/bcpl/step6_file.b b/impls/bcpl/step6_file.b
index 548e80f9dc..1cd8536473 100644
--- a/impls/bcpl/step6_file.b
+++ b/impls/bcpl/step6_file.b
@@ -131,7 +131,7 @@ LET repl(argv) BE
     writes("Uncaught exception: ")
     writes(@(pr_str(last_exception)!str_data))
     newline()
-    sys(Sys_quit, 1)
+    sys(Sys_quit, 0)
   }
   catch_level, catch_label := level(), uncaught
   IF FALSE THEN
diff --git a/impls/bcpl/step7_quote.b b/impls/bcpl/step7_quote.b
index ecd4d56516..dc72a168b4 100644
--- a/impls/bcpl/step7_quote.b
+++ b/impls/bcpl/step7_quote.b
@@ -153,7 +153,7 @@ LET repl(argv) BE
     writes("Uncaught exception: ")
     writes(@(pr_str(last_exception)!str_data))
     newline()
-    sys(Sys_quit, 1)
+    sys(Sys_quit, 0)
   }
   catch_level, catch_label := level(), uncaught
   IF FALSE THEN
diff --git a/impls/bcpl/step8_macros.b b/impls/bcpl/step8_macros.b
index 9a51f160ac..5c09311359 100644
--- a/impls/bcpl/step8_macros.b
+++ b/impls/bcpl/step8_macros.b
@@ -184,7 +184,7 @@ LET repl(argv) BE
     writes("Uncaught exception: ")
     writes(@(pr_str(last_exception)!str_data))
     newline()
-    sys(Sys_quit, 1)
+    sys(Sys_quit, 0)
   }
   catch_level, catch_label := level(), uncaught
   IF FALSE THEN
diff --git a/impls/bcpl/step9_try.b b/impls/bcpl/step9_try.b
index 6a62d4ab25..3e7d1eea7a 100644
--- a/impls/bcpl/step9_try.b
+++ b/impls/bcpl/step9_try.b
@@ -200,7 +200,7 @@ LET repl(argv) BE
     writes("Uncaught exception: ")
     writes(@(pr_str(last_exception)!str_data))
     newline()
-    sys(Sys_quit, 1)
+    sys(Sys_quit, 0)
   }
   catch_level, catch_label := level(), uncaught
   IF FALSE THEN
diff --git a/impls/bcpl/stepA_mal.b b/impls/bcpl/stepA_mal.b
index 119a7dea5e..c256403555 100644
--- a/impls/bcpl/stepA_mal.b
+++ b/impls/bcpl/stepA_mal.b
@@ -202,7 +202,7 @@ LET repl(argv) BE
     writes("Uncaught exception: ")
     writes(@(pr_str(last_exception)!str_data))
     newline()
-    sys(Sys_quit, 1)
+    sys(Sys_quit, 0)
   }
   rep(str_bcpl2mal("(println (str *"Mal [*" **host-language** *"]*"))"))
   catch_level, catch_label := level(), uncaught

From e7b35a6e53d7471fb30019453a82391e35dbf090 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Wed, 27 May 2020 16:12:39 +0100
Subject: [PATCH 146/148] bcpl: Equality tests for hash-maps

---
 impls/bcpl/types.b | 11 +++++++++++
 1 file changed, 11 insertions(+)

diff --git a/impls/bcpl/types.b b/impls/bcpl/types.b
index 425efaab74..91c3e562c8 100644
--- a/impls/bcpl/types.b
+++ b/impls/bcpl/types.b
@@ -174,6 +174,7 @@ LET equal_scalar(a, b) = VALOF
   { CASE t_nil: RESULTIS 1
     CASE t_int: RESULTIS int_sz
     CASE t_str: RESULTIS str_data + 1 + a!str_len / bytesperword
+    CASE t_hm0: RESULTIS hm0_sz
     DEFAULT: throwf("incomparable value: %v", a)
   }
   // This is guaranteed not to walk off the end of b because any two mal
@@ -189,6 +190,8 @@ LET equal(a, b) = VALOF
   SWITCHON type OF a INTO
   { CASE t_lst: RESULTIS equal_lst(a, b)
     CASE t_vec: RESULTIS equal_vec(a, b)
+    CASE t_hmi: RESULTIS equal_hmi(a, b)
+    CASE t_hmx: RESULTIS equal_hmx(a, b)
     DEFAULT:    RESULTIS equal_scalar(a, b)
   }
 }
@@ -225,6 +228,14 @@ AND equal_lstvec(l, v) = VALOF
   RESULTIS l = empty
 }
 
+// No need to compare the critical bit between nodes, since it's completely
+// determined by the leaf nodes, which we will reach eventually.
+AND equal_hmi(a, b) = equal(a!hmi_left, b!hmi_left) &
+                      equal(a!hmi_right, b!hmi_right)
+
+AND equal_hmx(a, b) = equal(a!hmx_key, b!hmx_key) &
+                      equal(a!hmx_value, b!hmx_value)
+
 LET alloc_vec(len) = VALOF
 { LET result = alloc_val(vec_data + len)
   type OF result := t_vec

From c319955a41c13932f7e07e1c9dd489f9cd20a769 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Wed, 27 May 2020 16:13:05 +0100
Subject: [PATCH 147/148] bcpl: Add Dockerfile and Travis matrix entry

---
 .travis.yml           |  1 +
 impls/bcpl/Dockerfile | 38 ++++++++++++++++++++++++++++++++++++++
 2 files changed, 39 insertions(+)
 create mode 100644 impls/bcpl/Dockerfile

diff --git a/.travis.yml b/.travis.yml
index 382779ac78..5a8ec99517 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -12,6 +12,7 @@ matrix:
     - {env: IMPL=basic basic_MODE=cbm NO_SELF_HOST=1,    services: [docker]} # step4 OOM
     - {env: IMPL=basic basic_MODE=qbasic NO_SELF_HOST=1, services: [docker]} # step4 OOM
     - {env: IMPL=bbc-basic,                   services: [docker]}
+    - {env: IMPL=bcpl,                        services: [docker]}
     - {env: IMPL=c,                           services: [docker]}
     - {env: IMPL=cpp,                         services: [docker]}
     - {env: IMPL=coffee,                      services: [docker]}
diff --git a/impls/bcpl/Dockerfile b/impls/bcpl/Dockerfile
new file mode 100644
index 0000000000..cf9c772e2b
--- /dev/null
+++ b/impls/bcpl/Dockerfile
@@ -0,0 +1,38 @@
+FROM ubuntu:18.04
+MAINTAINER Joel Martin <github@martintribe.org>
+
+##########################################################
+# General requirements for testing or common across many
+# implementations
+##########################################################
+
+RUN apt-get -y update
+
+# Required for running tests
+RUN apt-get -y install make python
+
+# Some typical implementation and test requirements
+RUN apt-get -y install curl libreadline-dev libedit-dev
+
+RUN mkdir -p /mal
+WORKDIR /mal
+
+##########################################################
+# Specific implementation requirements
+##########################################################
+
+RUN apt-get -y install gcc mesa-common-dev libglu1-mesa-dev freeglut3-dev
+
+RUN cd /usr/local && \
+    curl -o bcpl.tgz https://www.cl.cam.ac.uk/~mr10/BCPL/bcpl.tgz && \
+    tar zxf bcpl.tgz && chmod -R a+rX BCPL
+
+ENV PATH /usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:\
+/usr/local/BCPL/cintcode/bin
+ENV BCPLROOT /usr/local/BCPL/cintcode
+ENV BCPLPATH /usr/local/BCPL/cintcode/cin
+ENV BCPLHDRS /usr/local/BCPL/cintcode/g
+ENV BCPLSCRIPTS /usr/local/BCPL/cintcode/s
+
+RUN cd /usr/local/BCPL/cintcode && make clean && make
+

From 59f9ca99bbde7d8de0961adb46b68cd9b96cc478 Mon Sep 17 00:00:00 2001
From: Ben Harris <bjh21@bjh21.me.uk>
Date: Fri, 29 May 2020 23:46:15 +0100
Subject: [PATCH 148/148] bcpl: Remove downloaded tgz to reduce Docker image
 size

---
 impls/bcpl/Dockerfile | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/impls/bcpl/Dockerfile b/impls/bcpl/Dockerfile
index cf9c772e2b..89bf588e6b 100644
--- a/impls/bcpl/Dockerfile
+++ b/impls/bcpl/Dockerfile
@@ -25,7 +25,7 @@ RUN apt-get -y install gcc mesa-common-dev libglu1-mesa-dev freeglut3-dev
 
 RUN cd /usr/local && \
     curl -o bcpl.tgz https://www.cl.cam.ac.uk/~mr10/BCPL/bcpl.tgz && \
-    tar zxf bcpl.tgz && chmod -R a+rX BCPL
+    tar zxf bcpl.tgz && chmod -R a+rX BCPL && rm bcpl.tgz
 
 ENV PATH /usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:\
 /usr/local/BCPL/cintcode/bin