Initial import

.gitignore

@@ -0,0 +1,4 @@
+/lisp
+/*.o
+/*.bin
+/*.bin.dbg

Makefile

@@ -0,0 +1,66 @@
+CFLAGS	?= -g
+CFLAGS	+= -fno-pie
+LDFLAGS	+= -no-pie  # -s -static -N
+
+REALFLAGS =				\
+	-Os				\
+	-D__REAL_MODE__			\
+	-wrapper ./realify.sh		\
+	-ffixed-r8			\
+	-ffixed-r9			\
+	-ffixed-r10			\
+	-ffixed-r11			\
+	-ffixed-r12			\
+	-ffixed-r13			\
+	-ffixed-r14			\
+	-ffixed-r15			\
+	-mno-red-zone			\
+	-fcall-used-rbx			\
+	-fno-jump-tables		\
+	-fno-shrink-wrap		\
+	-fno-schedule-insns2		\
+	-flive-range-shrinkage		\
+	-fno-omit-frame-pointer		\
+	-momit-leaf-frame-pointer	\
+	-mpreferred-stack-boundary=3	\
+	-fno-delete-null-pointer-checks
+
+CLEANFILES =				\
+	lisp				\
+	lisp.o				\
+	lisp.real.o			\
+	sectorlisp.o			\
+	start.o				\
+	lisp.bin			\
+	sectorlisp.bin			\
+	lisp.bin.dbg			\
+	sectorlisp.bin.dbg
+
+lisp:	lisp.o
+
+.PHONY:	all
+all:	lisp				\
+	lisp.bin			\
+	lisp.bin.dbg			\
+	sectorlisp.bin			\
+	sectorlisp.bin.dbg
+
+.PHONY:	clean
+clean:;	$(RM) $(CLEANFILES)
+
+lisp.bin.dbg: start.o lisp.real.o lisp.lds
+sectorlisp.bin.dbg: start.o sectorlisp.o lisp.lds
+
+start.o: start.S
+lisp.o: lisp.c lisp.h
+lisp.real.o: lisp.c lisp.h
+sectorlisp.o: sectorlisp.S
+
+%.real.o: %.c
+	$(CC) $(CPPFLAGS) $(CFLAGS) $(REALFLAGS) -c -o $@ $<
+
+%.bin.dbg:
+	$(LD) $(LDFLAGS) -static -o $@ $(patsubst %.lds,-T %.lds,$^)
+
+%.bin: %.bin.dbg
+	objcopy -SO binary $< $@

NOTICE

@@ -0,0 +1,14 @@
+Copyright 2020 Justine Alexandra Roberts Tunney
+
+Permission to use, copy, modify, and/or distribute this software for
+any purpose with or without fee is hereby granted, provided that the
+above copyright notice and this permission notice appear in all copies.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
+WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
+AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL
+DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR
+PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER
+TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
+PERFORMANCE OF THIS SOFTWARE.

README.md

@@ -0,0 +1,48 @@
+# sectorlisp
+
+sectorlisp is an effort to bootstrap John McCarthy's meta-circular
+evaluator on bare metal from a 512-byte boot sector.
+
+![Yo dawg, I heard you like LISP so I put a LISP in your LISP so you can eval while you eval](bin/yodawg.png)
+
+## Motivations
+
+Much of the information about LISP online tends to focus on
+[wild macros](http://www.paulgraham.com/onlisp.html),
+[JIT compilation](http://pixielang.org/), or its merits as
+[a better XML](http://www.defmacro.org/ramblings/lisp.html)
+as well as [a better JSON](https://stopa.io/post/265). However
+there's been comparatively little focus on the
+[primary materials](https://people.cs.umass.edu/~emery/classes/cmpsci691st/readings/PL/LISP.pdf)
+from the 1950's which emphasize the radically simple nature of
+LISP, as best evidenced by the meta-circular evaluator above.
+
+<p align="center">
+  <img alt="Binary Footprint Comparison"
+       width="750" height="348" src="bin/footprint.png">
+</p>
+
+This project aims to promote the radical simplicity of the essential
+elements of LISP's original design, by building the tiniest LISP machine
+possible. With a binary footprint less than one kilobyte, that's capable
+of running natively without dependencies on modern PCs, sectorlisp might
+be the tiniest self-hosting LISP interpreter to date. 
+
+We're still far off however from reaching our goal, which is to have
+sectorilsp be small enough to fit in the master boot record of a floppy
+disk, like [sectorforth](https://github.com/cesarblum/sectorforth). If
+you can help this project reach its goal, please send us a pull request!
+
+## Demo
+
+<p align="center">
+  <a href="https://youtu.be/hvTHZ6E0Abo">
+    <img alt="booting sectorlisp in emulator"
+         width="960" height="540" src="bin/sectorlisp.gif"></a>
+</p>
+
+The video above demonstrates how to boot sectorlisp in the blinkenlights
+emulator, to bootstrap the meta-circular evaluator, which evaluates a
+program for finding the first element in a tree.
+
+You can [watch the full demo on YouTube](https://youtu.be/hvTHZ6E0Abo).

lisp.c

@@ -0,0 +1,452 @@
+/*-*- mode:c;indent-tabs-mode:nil;c-basic-offset:2;tab-width:8;coding:utf-8 -*-│
+│vi: set net ft=c ts=2 sts=2 sw=2 fenc=utf-8                                :vi│
+╞══════════════════════════════════════════════════════════════════════════════╡
+│ Copyright 2020 Justine Alexandra Roberts Tunney                              │
+│                                                                              │
+│ Permission to use, copy, modify, and/or distribute this software for         │
+│ any purpose with or without fee is hereby granted, provided that the         │
+│ above copyright notice and this permission notice appear in all copies.      │
+│                                                                              │
+│ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL                │
+│ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED                │
+│ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE             │
+│ AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL         │
+│ DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR        │
+│ PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER               │
+│ TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR             │
+│ PERFORMANCE OF THIS SOFTWARE.                                                │
+╚─────────────────────────────────────────────────────────────────────────────*/
+#include "lisp.h"
+
+#define TRACE  0  // print eval input output
+#define RETRO  1  // auto capitalize input
+#define DELETE 1  // allow backspace to rub out symbol
+#define QUOTES 1  // allow 'X shorthand (QUOTE X)
+#define PROMPT 1  // show repl prompt
+#define WORD   short
+#define WORDS  8192
+
+/*───────────────────────────────────────────────────────────────────────────│─╗
+│ The LISP Challenge § LISP Machine                                        ─╬─│┼
+╚────────────────────────────────────────────────────────────────────────────│*/
+
+#define ATOM 0
+#define CONS 1
+
+#define NIL         0
+#define UNDEFINED   8
+#define ATOM_T      30
+#define ATOM_QUOTE  34
+#define ATOM_ATOM   46
+#define ATOM_EQ     56
+#define ATOM_COND   62
+#define ATOM_CAR    72
+#define ATOM_CDR    80
+#define ATOM_CONS   88
+#define ATOM_LAMBDA 98
+
+#define BOOL(x)  ((x) ? ATOM_T : NIL)
+#define VALUE(x) ((x) >> 1)
+#define PTR(i)   ((i) << 1 | CONS)
+
+struct Lisp {
+  WORD mem[WORDS];
+  unsigned char syntax[256];
+  WORD look;
+  WORD globals;
+  WORD index;
+  char token[128];
+  char str[WORDS];
+};
+
+_Static_assert(sizeof(struct Lisp) <= 0x7c00 - 0x600,
+               "LISP Machine too large for real mode");
+
+_Alignas(char) const char kSymbols[] = "NIL\0"
+                                       "*UNDEFINED\0"
+                                       "T\0"
+                                       "QUOTE\0"
+                                       "ATOM\0"
+                                       "EQ\0"
+                                       "COND\0"
+                                       "CAR\0"
+                                       "CDR\0"
+                                       "CONS\0"
+                                       "LAMBDA\0";
+
+#ifdef __REAL_MODE__
+static struct Lisp *const q;
+#else
+static struct Lisp q[1];
+#endif
+
+static void Print(long);
+static WORD GetList(void);
+static WORD GetObject(void);
+static void PrintObject(long);
+static WORD Eval(long, long);
+
+static void SetupSyntax(void) {
+  unsigned char *syntax = q->syntax;
+  asm("" : "+bSD"(syntax));
+  syntax[' '] = ' ';
+  syntax['\r'] = ' ';
+  syntax['\n'] = ' ';
+  syntax['('] = '(';
+  syntax[')'] = ')';
+  syntax['.'] = '.';
+#if QUOTES
+  syntax['\''] = '\'';
+#endif
+}
+
+static void SetupBuiltins(void) {
+  CopyMemory(q->str, kSymbols, sizeof(kSymbols));
+}
+
+static inline WORD Car(long x) {
+  return PEEK_ARRAY(q, mem, VALUE(x), 0);
+}
+
+static inline WORD Cdr(long x) {
+  return PEEK_ARRAY(q, mem, VALUE(x), 1);
+}
+
+static WORD Set(long i, long k, long v) {
+  POKE_ARRAY(q, mem, VALUE(i), 0, k);
+  POKE_ARRAY(q, mem, VALUE(i), 1, v);
+  return i;
+}
+
+static WORD Cons(WORD car, WORD cdr) {
+  int i, cell;
+  i = q->index;
+  POKE_ARRAY(q, mem, i, 0, car);
+  POKE_ARRAY(q, mem, i, 1, cdr);
+  q->index = i + 2;
+  cell = OBJECT(CONS, i);
+  return cell;
+}
+
+static char *StpCpy(char *d, char *s) {
+  char c;
+  do {
+    c = LODS(s);  // a.k.a. c = *s++
+    STOS(d, c);   // a.k.a. *d++ = c
+  } while (c);
+  return d;
+}
+
+static WORD Intern(char *s) {
+  int j, cx;
+  char c, *z, *t;
+  z = q->str;
+  c = LODS(z);
+  while (c) {
+    for (j = 0;; ++j) {
+      if (c != PEEK(s, j, 0)) {
+        break;
+      }
+      if (!c) {
+        return OBJECT(ATOM, z - q->str - j - 1);
+      }
+      c = LODS(z);
+    }
+    while (c) c = LODS(z);
+    c = LODS(z);
+  }
+  --z;
+  StpCpy(z, s);
+  return OBJECT(ATOM, SUB((long)z, q->str));
+}
+
+static unsigned char XlatSyntax(unsigned char b) {
+  return PEEK_ARRAY(q, syntax, b, 0);
+}
+
+static void PrintString(char *s) {
+  char c;
+  for (;;) {
+    if (!(c = PEEK(s, 0, 0))) break;
+    PrintChar(c);
+    ++s;
+  }
+}
+
+static int GetChar(void) {
+  int c;
+  c = ReadChar();
+#if RETRO
+  if (c >= 'a') {
+    CompilerBarrier();
+    if (c <= 'z') c -= 'a' - 'A';
+  }
+#endif
+#if DELETE
+  if (c == '\b') return c;
+#endif
+  PrintChar(c);
+  if (c == '\r') PrintChar('\n');
+  return c;
+}
+
+static void GetToken(void) {
+  char *t;
+  unsigned char b, x;
+  b = q->look;
+  t = q->token;
+  for (;;) {
+    x = XlatSyntax(b);
+    if (x != ' ') break;
+    b = GetChar();
+  }
+  if (x) {
+    STOS(t, b);
+    b = GetChar();
+  } else {
+    while (b && !x) {
+      if (!DELETE || b != '\b') {
+        STOS(t, b);
+      } else if (t > q->token) {
+        PrintString("\b \b");
+        if (t > q->token) --t;
+      }
+      b = GetChar();
+      x = XlatSyntax(b);
+    }
+  }
+  STOS(t, 0);
+  q->look = b;
+}
+
+static WORD ConsumeObject(void) {
+  GetToken();
+  return GetObject();
+}
+
+static WORD Cadr(long x) {
+  return Car(Cdr(x));  // ((A B C D) (E F G) H I) → (E F G)
+}
+
+static WORD List(long x, long y) {
+  return Cons(x, Cons(y, NIL));
+}
+
+static WORD Quote(long x) {
+  return List(ATOM_QUOTE, x);
+}
+
+static WORD GetQuote(void) {
+  return Quote(ConsumeObject());
+}
+
+static WORD AddList(WORD x) {
+  return Cons(x, GetList());
+}
+
+static WORD GetList(void) {
+  GetToken();
+  switch (*q->token & 0xFF) {
+    default:
+      return AddList(GetObject());
+    case ')':
+      return NIL;
+    case '.':
+      return ConsumeObject();
+#if QUOTES
+    case '\'':
+      return AddList(GetQuote());
+#endif
+  }
+}
+
+static WORD GetObject(void) {
+  switch (*q->token & 0xFF) {
+    default:
+      return Intern(q->token);
+    case '(':
+      return GetList();
+#if QUOTES
+    case '\'':
+      return GetQuote();
+#endif
+  }
+}
+
+static WORD ReadObject(void) {
+  q->look = GetChar();
+  GetToken();
+  return GetObject();
+}
+
+static WORD Read(void) {
+  return ReadObject();
+}
+
+static void PrintAtom(long x) {
+  PrintString(q->str + VALUE(x));
+}
+
+static void PrintList(long x) {
+#if QUOTES
+  if (Car(x) == ATOM_QUOTE) {
+    PrintChar('\'');
+    PrintObject(Cadr(x));
+    return;
+  }
+#endif
+  PrintChar('(');
+  PrintObject(Car(x));
+  while ((x = Cdr(x))) {
+    if (!ISATOM(x)) {
+      PrintChar(' ');
+      PrintObject(Car(x));
+    } else {
+      PrintString(" . ");
+      PrintObject(x);
+      break;
+    }
+  }
+  PrintChar(')');
+}
+
+static void PrintObject(long x) {
+  if (ISATOM(x)) {
+    PrintAtom(x);
+  } else {
+    PrintList(x);
+  }
+}
+
+static void Print(long i) {
+  PrintObject(i);
+  PrintString("\r\n");
+}
+
+/*───────────────────────────────────────────────────────────────────────────│─╗
+│ The LISP Challenge § Bootstrap John McCarthy's Metacircular Evaluator    ─╬─│┼
+╚────────────────────────────────────────────────────────────────────────────│*/
+
+static WORD Atom(long x) {
+  return BOOL(ISATOM(x));
+}
+
+WORD Eq(long x, long y) {
+  return BOOL(x == y);
+}
+
+static WORD Caar(long x) {
+  return Car(Car(x));  // ((A B C D) (E F G) H I) → A
+}
+
+static WORD Cdar(long x) {
+  return Cdr(Car(x));  // ((A B C D) (E F G) H I) → (B C D)
+}
+
+static WORD Cadar(long x) {
+  return Cadr(Car(x));  // ((A B C D) (E F G) H I) → B
+}
+
+static WORD Caddr(long x) {
+  return Cadr(Cdr(x));  // ((A B C D) (E F G) H I) → H
+}
+
+static WORD Caddar(long x) {
+  return Caddr(Car(x));  // ((A B C D) (E F G) H I) → C
+}
+
+static WORD Arg1(long e, long a) {
+  return Eval(Cadr(e), a);
+}
+
+static WORD Arg2(long e, long a) {
+  return Eval(Caddr(e), a);
+}
+
+static WORD Append(long x, long y) {
+  return x ? Cons(Car(x), Append(Cdr(x), y)) : y;
+}
+
+static WORD Evcon(long c, long a) {
+  return Eval(Caar(c), a) ? Eval(Cadar(c), a) : Evcon(Cdr(c), a);
+}
+
+static WORD Bind(long v, long a, long e) { // evlis + pair w/ dot notation
+  return v ? Cons(Cons(Car(v), Eval(Car(a), e)), Bind(Cdr(v), Cdr(a), e)) : e;
+}
+
+static WORD Assoc(long x, long y) {
+  return y ? Eq(Caar(y), x) ? Cdar(y) : Assoc(x, Cdr(y)) : NIL;
+}
+
+static WORD Evaluate(long e, long a) {
+  if (Atom(e)) {
+    return Assoc(e, a);
+  } else if (Atom(Car(e))) {
+    switch (Car(e)) {
+      case NIL:
+        return UNDEFINED;
+      case ATOM_QUOTE:
+        return Cadr(e);
+      case ATOM_ATOM:
+        return Atom(Arg1(e, a));
+      case ATOM_EQ:
+        return Eq(Arg1(e, a), Arg2(e, a));
+      case ATOM_COND:
+        return Evcon(Cdr(e), a);
+      case ATOM_CAR:
+        return Car(Arg1(e, a));
+      case ATOM_CDR:
+        return Cdr(Arg1(e, a));
+      case ATOM_CONS:
+        return Cons(Arg1(e, a), Arg2(e, a));
+      default:
+        return Eval(Cons(Assoc(Car(e), a), Cdr(e)), a);
+    }
+  } else if (Eq(Caar(e), ATOM_LAMBDA)) {
+    return Eval(Caddar(e), Bind(Cadar(e), Cdr(e), a));
+  } else {
+    return UNDEFINED;
+  }
+}
+
+static WORD Eval(long e, long a) {
+  WORD r;
+#if TRACE
+  PrintString("->");
+  Print(e);
+  PrintString("  ");
+  Print(a);
+#endif
+  e = Evaluate(e, a);
+#if TRACE
+  PrintString("<-");
+  Print(e);
+#endif
+  return e;
+}
+
+/*───────────────────────────────────────────────────────────────────────────│─╗
+│ The LISP Challenge § User Interface                                      ─╬─│┼
+╚────────────────────────────────────────────────────────────────────────────│*/
+
+void Repl(void) {
+  for (;;) {
+#if PROMPT
+    PrintString("* ");
+#endif
+    Print(Eval(Read(), q->globals));
+  }
+}
+
+int main(int argc, char *argv[]) {
+  RawMode();
+  SetupSyntax();
+  SetupBuiltins();
+#if PROMPT
+  PrintString("THE LISP CHALLENGE V1\r\n"
+              "VISIT GITHUB.COM/JART\r\n");
+#endif
+  Repl();
+  return 0;
+}

lisp.h

@@ -0,0 +1,180 @@
+#ifndef SECTORLISP_H_
+#define SECTORLISP_H_
+#include <unistd.h>
+#include <termios.h>
+#include <sys/ioctl.h>
+
+/*───────────────────────────────────────────────────────────────────────────│─╗
+│ The LISP Challenge § Richard Stallman Math 55 Systems Integration Code   ─╬─│┼
+╚────────────────────────────────────────────────────────────────────────────│*/
+
+#define CompilerBarrier() asm volatile("" ::: "memory")
+
+#define ISATOM(x) /* a.k.a. !(x&1) */                        \
+  ({                                                         \
+    _Bool IsAtom;                                            \
+    asm("test%z1\t$1,%1" : "=@ccz"(IsAtom) : "Qm"((char)x)); \
+    IsAtom;                                                  \
+  })
+
+#define OBJECT(t, v) /* a.k.a. v<<1|t */ \
+  ({                                     \
+    __typeof(v) Val = (v);               \
+    asm("shl\t%0" : "+r"(Val));          \
+    Val | (t);                           \
+  })
+
+#define SUB(x, y) /* a.k.a. x-y */           \
+  ({                                         \
+    __typeof(x) Reg = (x);                   \
+    asm("sub\t%1,%0" : "+rm"(Reg) : "g"(y)); \
+    Reg;                                     \
+  })
+
+#define STOS(di, c) asm("stos%z1" : "+D"(di), "=m"(*(di)) : "a"(c))
+#define LODS(si)                                     \
+  ({                                                 \
+    typeof(*(si)) c;                                 \
+    asm("lods%z2" : "+S"(si), "=a"(c) : "m"(*(si))); \
+    c;                                               \
+  })
+
+static inline void *SetMemory(void *di, int al, unsigned long cx) {
+  asm("rep stosb"
+      : "=D"(di), "=c"(cx), "=m"(*(char(*)[cx])di)
+      : "0"(di), "1"(cx), "a"(al));
+  return di;
+}
+
+static inline void *CopyMemory(void *di, const void *si, unsigned long cx) {
+  asm("rep movsb"
+      : "=D"(di), "=S"(si), "=c"(cx), "=m"(*(char(*)[cx])di)
+      : "0"(di), "1"(si), "2"(cx));
+  return di;
+}
+
+static void RawMode(void) {
+#ifndef __REAL_MODE__
+  struct termios t;
+  if (ioctl(1, TCGETS, &t) != -1) {
+    t.c_cc[VMIN] = 1;
+    t.c_cc[VTIME] = 1;
+    t.c_iflag &= ~(INPCK | ISTRIP | PARMRK | INLCR | IGNCR | ICRNL | IXON);
+    t.c_lflag &= ~(IEXTEN | ICANON | ECHO | ECHONL);
+    t.c_cflag &= ~(CSIZE | PARENB);
+    t.c_oflag &= ~OPOST;
+    t.c_cflag |= CS8;
+    t.c_iflag |= IUTF8;
+    ioctl(1, TCSETS, &t);
+  }
+#endif
+}
+
+__attribute__((__noinline__)) static void PrintChar(long c) {
+#ifdef __REAL_MODE__
+  asm volatile("mov\t$0x0E,%%ah\n\t"
+               "int\t$0x10"
+               : /* no outputs */
+               : "a"(c), "b"(7)
+               : "memory");
+#else
+  static short buf;
+  int rc;
+  buf = c;
+  write(1, &buf, 1);
+#endif
+}
+
+static int ReadChar(void) {
+  int c;
+#ifdef __REAL_MODE__
+  asm volatile("int\t$0x16" : "=a"(c) : "0"(0) : "memory");
+  c &= 0xff;
+#else
+  static int buf;
+  read(0, &buf, 1);
+  c = buf;
+#endif
+  return c;
+}
+
+#define PEEK_(REG, BASE, INDEX, DISP)                                    \
+  ({                                                                     \
+    __typeof(*(BASE)) Reg;                                               \
+    if (__builtin_constant_p(INDEX) && !(INDEX)) {                       \
+      asm("mov\t%c2(%1),%0"                                              \
+          : REG(Reg)                                                     \
+          : "bDS"(BASE), "i"((DISP) * sizeof(*(BASE))),                  \
+            "m"(BASE[(INDEX) + (DISP)]));                                \
+    } else {                                                             \
+      asm("mov\t%c3(%1,%2),%0"                                           \
+          : REG(Reg)                                                     \
+          : "b"(BASE), "DS"((long)(INDEX) * sizeof(*(BASE))),            \
+            "i"((DISP) * sizeof(*(BASE))), "m"(BASE[(INDEX) + (DISP)])); \
+    }                                                                    \
+    Reg;                                                                 \
+  })
+
+#define PEEK(BASE, INDEX, DISP) /* a.k.a. b[i] */        \
+  (sizeof(*(BASE)) == 1 ? PEEK_("=Q", BASE, INDEX, DISP) \
+                        : PEEK_("=r", BASE, INDEX, DISP))
+
+#define PEEK_ARRAY_(REG, OBJECT, MEMBER, INDEX, DISP)                     \
+  ({                                                                      \
+    __typeof(*(OBJECT->MEMBER)) Reg;                                      \
+    if (!(OBJECT)) {                                                      \
+      asm("mov\t%c2(%1),%0"                                               \
+          : REG(Reg)                                                      \
+          : "bDS"((long)(INDEX) * sizeof(*(OBJECT->MEMBER))),             \
+            "i"(__builtin_offsetof(__typeof(*(OBJECT)), MEMBER) +         \
+                sizeof(*(OBJECT->MEMBER)) * (DISP)),                      \
+            "m"(OBJECT->MEMBER));                                         \
+    } else {                                                              \
+      asm("mov\t%c3(%1,%2),%0"                                            \
+          : REG(Reg)                                                      \
+          : "b"(OBJECT), "DS"((long)(INDEX) * sizeof(*(OBJECT->MEMBER))), \
+            "i"(__builtin_offsetof(__typeof(*(OBJECT)), MEMBER) +         \
+                sizeof(*(OBJECT->MEMBER)) * (DISP)),                      \
+            "m"(OBJECT->MEMBER));                                         \
+    }                                                                     \
+    Reg;                                                                  \
+  })
+
+#define PEEK_ARRAY(OBJECT, MEMBER, INDEX, DISP) /* o->m[i] */ \
+  (sizeof(*(OBJECT->MEMBER)) == 1                             \
+       ? PEEK_ARRAY_("=Q", OBJECT, MEMBER, INDEX, DISP)       \
+       : PEEK_ARRAY_("=r", OBJECT, MEMBER, INDEX, DISP))
+
+#define POKE_ARRAY_(REG, OBJECT, MEMBER, INDEX, DISP, VALUE)        \
+  do {                                                              \
+    if (!(OBJECT)) {                                                \
+      asm("mov\t%1,%c3(%2)"                                         \
+          : "=m"(OBJECT->MEMBER)                                    \
+          : REG((__typeof(*(OBJECT->MEMBER)))(VALUE)),              \
+            "bDS"((long)(INDEX) * sizeof(*(OBJECT->MEMBER))),       \
+            "i"(__builtin_offsetof(__typeof(*(OBJECT)), MEMBER) +   \
+                sizeof(*(OBJECT->MEMBER)) * (DISP)));               \
+    } else {                                                        \
+      asm("mov\t%1,%c4(%2,%3)"                                      \
+          : "=m"(OBJECT->MEMBER)                                    \
+          : REG((__typeof(*(OBJECT->MEMBER)))(VALUE)), "b"(OBJECT), \
+            "DS"((long)(INDEX) * sizeof(*(OBJECT->MEMBER))),        \
+            "i"(__builtin_offsetof(__typeof(*(OBJECT)), MEMBER) +   \
+                sizeof(*(OBJECT->MEMBER)) * (DISP)));               \
+    }                                                               \
+  } while (0)
+
+#define POKE_ARRAY(OBJECT, MEMBER, INDEX, DISP, VALUE) /* o->m[i]=v */ \
+  do {                                                                 \
+    __typeof(*(OBJECT->MEMBER)) Reg;                                   \
+    switch (sizeof(*(OBJECT->MEMBER))) {                               \
+      case 1:                                                          \
+        POKE_ARRAY_("Q", OBJECT, MEMBER, INDEX, DISP, VALUE);          \
+        break;                                                         \
+      default:                                                         \
+        POKE_ARRAY_("r", OBJECT, MEMBER, INDEX, DISP, VALUE);          \
+        break;                                                         \
+    }                                                                  \
+  } while (0)
+
+#endif /* SECTORLISP_H_ */

lisp.lds

@@ -0,0 +1,35 @@
+ENTRY(_start)
+
+SECTIONS {
+
+  .text 0x7c00 - 0x600 : {
+    *(.start)
+    rodata = .;
+    *(.rodata .rodata.*)
+    . = 0x1fe;
+    SHORT(0xaa55);
+    *(.text .text.*)
+    /*BYTE(0x90);*/
+    _etext = .;
+    . = ALIGN(512);
+  }
+
+  .bss : {
+    bss = .;
+    *(.bss .bss.*)
+    *(COMMON)
+  }
+
+  /DISCARD/ : {
+    *(.*)
+  }
+}
+
+boot        = 0x7c00;
+q.syntax    = 8192*2;
+q.look      = 8192*2+256;
+q.globals   = 8192*2+256+2;
+q.index     = 8192*2+256+2+2;
+q.token     = 8192*2+256+2+2+2;
+q.str       = 8192*2+256+2+2+2+128;
+v_sectors   = SIZEOF(.text) / 512;

lisp.lisp

@@ -0,0 +1,116 @@
+;; (setq lisp-indent-function 'common-lisp-indent-function)
+;; (paredit-mode)
+
+;;                              ________
+;;                             /_  __/ /_  ___
+;;                              / / / __ \/ _ \
+;;                             / / / / / /  __/
+;;                            /_/ /_/ /_/\___/
+;;     __    _________ ____     ________          ____
+;;    / /   /  _/ ___// __ \   / ____/ /_  ____ _/ / /__  ____  ____ ____
+;;   / /    / / \__ \/ /_/ /  / /   / __ \/ __ `/ / / _ \/ __ \/ __ `/ _ \
+;;  / /____/ / ___/ / ____/  / /___/ / / / /_/ / / /  __/ / / / /_/ /  __/
+;; /_____/___//____/_/       \____/_/ /_/\__,_/_/_/\___/_/ /_/\__, /\___/
+;;                                                           /____/
+;;
+;; The LISP Challenge
+;;
+;; Pick your favorite programming language
+;; Implement the tiniest possible LISP machine that
+;; Bootstraps John Mccarthy'S metacircular evaluator below
+;; Winning is defined by lines of code for scripting languages
+;; Winning is defined by binary footprint for compiled languages
+;;
+;; Listed Projects
+;;
+;; - 948 bytes: https://github.com/jart/sectorlisp
+;; - 13 kilobytes: https://t3x.org/klisp/
+;; - 150 kilobytes: https://github.com/JeffBezanson/femtolisp
+;; - Send pull request to be listed here
+;;
+;; @see LISP From Nothing; Nils M. Holm; Lulu Press, Inc. 2020
+;; @see Recursive Functions of Symbolic Expressions and Their
+;;      Computation By Machine, Part I; John McCarthy, Massachusetts
+;;      Institute of Technology, Cambridge, Mass. April 1960
+
+;; NIL ATOM
+;; ABSENCE OF VALUE AND TRUTH
+NIL
+
+;; CONS CELL
+;; BUILDING BLOCK OF DATA STRUCTURES
+(CONS NIL NIL)
+
+;; REFLECTION
+;; EVERYTHING IS AN ATOM OR NOT AN ATOM
+(ATOM NIL)
+(ATOM (CONS NIL NIL))
+
+;; QUOTING
+;; CODE IS DATA AND DATA IS CODE
+(QUOTE (CONS NIL NIL))
+(CONS (QUOTE CONS) (CONS NIL (CONS NIL NIL)))
+
+;; LOGIC
+;; BY WAY OF STRING INTERNING
+(EQ (QUOTE A) (QUOTE A))
+(EQ (QUOTE T) (QUOTE F))
+
+;; FIND FIRST ATOM IN TREE
+;; CORRECT RESULT OF EXPRESSION IS `A`
+;; RECURSIVE CONDITIONAL FUNCTION BINDING
+((LAMBDA (FF X) (FF X))
+ (QUOTE (LAMBDA (X)
+          (COND ((ATOM X) X)
+                ((QUOTE T) (FF (CAR X))))))
+ (QUOTE ((A) B C)))
+
+;; LISP IMPLEMENTED IN LISP
+;; WITHOUT ANY SUBJECTIVE SYNTACTIC SUGAR
+;; RUNS "FIND FIRST ATOM IN TREE" PROGRAM
+;; CORRECT RESULT OF EXPRESSION IS STILL `A`
+;; REQUIRES CONS CAR CDR QUOTE ATOM EQ LAMBDA COND
+;; SIMPLIFIED BUG FIXED VERSION OF JOHN MCCARTHY PAPER
+((LAMBDA (ASSOC EVCON BIND APPEND EVAL)
+   (EVAL (QUOTE ((LAMBDA (FF X) (FF X))
+                 (QUOTE (LAMBDA (X)
+                          (COND ((ATOM X) X)
+                                ((QUOTE T) (FF (CAR X))))))
+                 (QUOTE ((A) B C))))
+         NIL))
+ (QUOTE (LAMBDA (X E)
+          (COND ((EQ E NIL) NIL)
+                ((EQ X (CAR (CAR E))) (CDR (CAR E)))
+                ((QUOTE T) (ASSOC X (CDR E))))))
+ (QUOTE (LAMBDA (C E)
+          (COND ((EVAL (CAR (CAR C)) E) (EVAL (CAR (CDR (CAR C))) E))
+                ((QUOTE T) (EVCON (CDR C) E)))))
+ (QUOTE (LAMBDA (V A E)
+          (COND ((EQ V NIL) E)
+                ((QUOTE T) (CONS (CONS (CAR V) (EVAL (CAR A) E))
+                                 (BIND (CDR V) (CDR A) E))))))
+ (QUOTE (LAMBDA (A B)
+          (COND ((EQ A NIL) B)
+                ((QUOTE T) (CONS (CAR A) (APPEND (CDR A) B))))))
+ (QUOTE (LAMBDA (E A)
+          (COND
+            ((ATOM E) (ASSOC E A))
+            ((ATOM (CAR E))
+             (COND
+               ((EQ (CAR E) NIL) (QUOTE *UNDEFINED))
+               ((EQ (CAR E) (QUOTE QUOTE)) (CAR (CDR E)))
+               ((EQ (CAR E) (QUOTE ATOM)) (ATOM (EVAL (CAR (CDR E)) A)))
+               ((EQ (CAR E) (QUOTE EQ)) (EQ (EVAL (CAR (CDR E)) A)
+                                            (EVAL (CAR (CDR (CDR E))) A)))
+               ((EQ (CAR E) (QUOTE CAR)) (CAR (EVAL (CAR (CDR E)) A)))
+               ((EQ (CAR E) (QUOTE CDR)) (CDR (EVAL (CAR (CDR E)) A)))
+               ((EQ (CAR E) (QUOTE CONS)) (CONS (EVAL (CAR (CDR E)) A)
+                                                (EVAL (CAR (CDR (CDR E))) A)))
+               ((EQ (CAR E) (QUOTE COND)) (EVCON (CDR E) A))
+               ((EQ (CAR E) (QUOTE LABEL)) (EVAL (CAR (CDR (CDR E)))
+                                                 (APPEND (CAR (CDR E)) A)))
+               ((EQ (CAR E) (QUOTE LAMBDA)) E)
+               ((QUOTE T) (EVAL (CONS (EVAL (CAR E) A) (CDR E)) A))))
+            ((EQ (CAR (CAR E)) (QUOTE LAMBDA))
+             (EVAL (CAR (CDR (CDR (CAR E))))
+                   (BIND (CAR (CDR (CAR E))) (CDR E) A)))))))

realify.sed

@@ -0,0 +1,177 @@
+#-*-mode:sed;indent-tabs-mode:t;tab-width:8;coding:utf-8-*-┐
+#───vi: et ft=sed ts=8 tw=8 fenc=utf-8 :vi─────────────────┘
+#
+# SYNOPSIS
+#
+#   sed -i -f realify.sed foo.s
+#
+# OVERVIEW
+#
+#   This converts ints and longs to shorts while preserving System V ABI
+#   x86_64 compatibility. This works better than gcc -m16 because we can
+#   avoid the ASZ and OSZ prefixes in most cases while also avoiding the
+#   legacy 32-bit calling conventions.
+
+# remove comments
+s/[ \t][ \t]*#.*//
+
+s/leave\(q\|\)/leavew/
+s/call\(q\|\)/callw/
+s/ret\(q\|\)/retw/
+s/popq\t%rbp/pop\t%bp/
+s/pushq\t%rbp/push\t%bp/
+s/pushq\t\(.*\)/sub\t$6,%sp\n\tpush\t\1/
+s/popq\t\(.*\)/pop\t\1\n\tadd\t$6,%sp/
+
+# # preserve hardcoded stack offsets
+# # bloats code size 13%
+# s/leave\(q\|\)/leavew\n\tadd\t$6,%sp/
+# s/call\(q\|\)\t/sub\t$6,%sp\n\tcallw\t/
+# s/ret\(q\|\)/retw\t$6/
+# s/pushq\t\(.*\)/sub\t$6,%sp\n\tpush\t\1/
+# s/popq\t\(.*\)/pop\t\1\n\tadd\t$6,%sp/
+
+s/, /,/g
+
+# 32-bitify
+s/rax/eax/g
+s/rbx/ebx/g
+s/rcx/ecx/g
+s/rdx/edx/g
+s/rbp/ebp/g
+s/rdi/edi/g
+s/rsi/esi/g
+s/rsp/esp/g
+
+# unextension
+s/movswl/mov/
+s/movzwl/mov/
+s/movslq/mov/
+s/movzlq/mov/
+s/movsbl/movsbw/
+
+# unsuffix
+s/^\(\t\(fild\|fist\|fistp\|fiadd\|fisub\|fisubr\|fimul\|fidiv\|fidivr\|ficom\)\)q\t/\1\t/
+s/^\(\t\(mov\|add\|adc\|cmp\|test\|lea\|sbb\|mul\|imul\|div\|idiv\|in\|out\|xor\|sub\|and\|or\|rol\|ror\|rcl\|rcr\|shl\|shr\|sal\|sar\|inc\|dec\|not\|neg\)\)l\t/\1w\t/
+s/^\(\t[a-z]*\)q\t/\1w\t/
+s/movsww/mov/
+
+# remove fluff
+s/mov\t%eax,%eax//
+s/mov\t%ebx,%ebx//
+s/mov\t%ecx,%ecx//
+s/mov\t%edx,%edx//
+s/mov\t%ebp,%ebp//
+s/mov\t%edi,%edi//
+s/mov\t%esi,%esi//
+s/mov\t%esp,%esp//
+
+# make pic absolute
+s/(%rip)//
+
+# legal real mode modrm
+s/(%ebx)/(%bx)/
+s/(%edi)/(%di)/
+s/(%esi)/(%si)/
+s/(%ebp)/(%bp)/
+s/(%ebx,%esi\(,1\|\))/(%bx,%si)/
+s/(%ebx,%edi\(,1\|\))/(%bx,%di)/
+s/(%ebp,%esi\(,1\|\))/(%bp,%si)/
+s/(%ebp,%edi\(,1\|\))/(%bp,%di)/
+
+# we need the asz prefix
+s/(%eax,%eax/(%EAX,%EAX/
+s/(%eax,%ebp/(%EAX,%EBP/
+s/(%eax,%ebx/(%EAX,%EBX/
+s/(%eax,%ecx/(%EAX,%ECX/
+s/(%eax,%edi/(%EAX,%EDI/
+s/(%eax,%edx/(%EAX,%EDX/
+s/(%eax,%esi/(%EAX,%ESI/
+s/(%ebp,%eax/(%EBP,%EAX/
+s/(%ebp,%ebp/(%EBP,%EBP/
+s/(%ebp,%ebx/(%EBP,%EBX/
+s/(%ebp,%ecx/(%EBP,%ECX/
+s/(%ebp,%edi/(%EBP,%EDI/
+s/(%ebp,%edx/(%EBP,%EDX/
+s/(%ebp,%esi/(%EBP,%ESI/
+s/(%ebx,%eax/(%EBX,%EAX/
+s/(%ebx,%ebp/(%EBX,%EBP/
+s/(%ebx,%ebx/(%EBX,%EBX/
+s/(%ebx,%ecx/(%EBX,%ECX/
+s/(%ebx,%edi/(%EBX,%EDI/
+s/(%ebx,%edx/(%EBX,%EDX/
+s/(%ebx,%esi/(%EBX,%ESI/
+s/(%ecx,%eax/(%ECX,%EAX/
+s/(%ecx,%ebp/(%ECX,%EBP/
+s/(%ecx,%ebx/(%ECX,%EBX/
+s/(%ecx,%ecx/(%ECX,%ECX/
+s/(%ecx,%edi/(%ECX,%EDI/
+s/(%ecx,%edx/(%ECX,%EDX/
+s/(%ecx,%esi/(%ECX,%ESI/
+s/(%edi,%eax/(%EDI,%EAX/
+s/(%edi,%ebp/(%EDI,%EBP/
+s/(%edi,%ebx/(%EDI,%EBX/
+s/(%edi,%ecx/(%EDI,%ECX/
+s/(%edi,%edi/(%EDI,%EDI/
+s/(%edi,%edx/(%EDI,%EDX/
+s/(%edi,%esi/(%EDI,%ESI/
+s/(%edx,%eax/(%EDX,%EAX/
+s/(%edx,%ebp/(%EDX,%EBP/
+s/(%edx,%ebx/(%EDX,%EBX/
+s/(%edx,%ecx/(%EDX,%ECX/
+s/(%edx,%edi/(%EDX,%EDI/
+s/(%edx,%edx/(%EDX,%EDX/
+s/(%edx,%esi/(%EDX,%ESI/
+s/(%esi,%eax/(%ESI,%EAX/
+s/(%esi,%ebp/(%ESI,%EBP/
+s/(%esi,%ebx/(%ESI,%EBX/
+s/(%esi,%ecx/(%ESI,%ECX/
+s/(%esi,%edi/(%ESI,%EDI/
+s/(%esi,%edx/(%ESI,%EDX/
+s/(%esi,%esi/(%ESI,%ESI/
+s/(%esp,%eax/(%ESP,%EAX/
+s/(%esp,%ebp/(%ESP,%EBP/
+s/(%esp,%ebx/(%ESP,%EBX/
+s/(%esp,%ecx/(%ESP,%ECX/
+s/(%esp,%edi/(%ESP,%EDI/
+s/(%esp,%edx/(%ESP,%EDX/
+s/(%esp,%esi/(%ESP,%ESI/
+s/(,%eax/(,%EAX/
+s/(,%ebx/(,%EBX/
+s/(,%ecx/(,%ECX/
+s/(,%edx/(,%EDX/
+s/(,%esi/(,%ESI/
+s/(,%edi/(,%EDI/
+s/(,%ebp/(,%EBP/
+s/(%eax)/(%EAX)/
+s/(%ecx)/(%ECX)/
+s/(%edx)/(%EDX)/
+s/(%esp)/(%ESP)/
+
+# 16bitify
+s/eax/ax/g
+s/ebx/bx/g
+s/ecx/cx/g
+s/edx/dx/g
+s/ebp/bp/g
+s/edi/di/g
+s/esi/si/g
+s/esp/sp/g
+
+# sigh :\
+# gcc needs a flag for not using rex byte regs. workaround:
+# - %dil can be avoided through copious use of STOS() macro
+# - %sil can be avoided through copious use of LODS() macro
+# - %bpl shouldn't be allocated due to -fno-omit-frame-pointer
+# - %spl shouldn't be allocated like ever
+# beyond that there's only a few cases where %dil and %sil
+# need some handcoded asm() macros to workaround, for example
+# if ARG1 is long and you say (ARG1 & 1) gcc will use %dil
+# so just kludge it using asm("and\t$1,%0" : "+Q"(ARG1))
+#s/dil/bl/g
+#s/sil/bh/g
+#s/spl/bl/g
+#s/bpl/bh/g
+
+# nope
+s/cltq//

realify.sh

@@ -0,0 +1,23 @@
+#!/bin/sh
+#
+# SYNOPSIS
+#
+#   gcc -g0 -Os -wrapper realify.sh -ffixed-r{8,9,1{0,1,2,4,5}}
+#
+# OVERVIEW
+#
+#   Reconfigures x86_64 compiler to emit 16-bit PC boot code.
+
+if [ "${1##*/}" = as ]; then
+  for x; do
+    if [ "${x##*.}" = s ]; then
+      {
+        printf "\t.code16gcc"
+        sed -f realify.sed "$x"
+      } >"$x".tmp
+      mv -f "$x".tmp "$x"
+    fi
+  done
+fi
+
+exec "$@"

sectorlisp.S

@@ -0,0 +1,479 @@
+/*-*- mode:unix-assembly; indent-tabs-mode:t; tab-width:8; coding:utf-8     -*-│
+│vi: set et ft=asm ts=8 tw=8 fenc=utf-8                                     :vi│
+╞══════════════════════════════════════════════════════════════════════════════╡
+│ Copyright 2020 Justine Alexandra Roberts Tunney                              │
+│                                                                              │
+│ Permission to use, copy, modify, and/or distribute this software for         │
+│ any purpose with or without fee is hereby granted, provided that the         │
+│ above copyright notice and this permission notice appear in all copies.      │
+│                                                                              │
+│ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL                │
+│ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED                │
+│ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE             │
+│ AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL         │
+│ DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR        │
+│ PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER               │
+│ TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR             │
+│ PERFORMANCE OF THIS SOFTWARE.                                                │
+╚─────────────────────────────────────────────────────────────────────────────*/
+
+/	@fileoverview lisp.c built for real mode with manual tuning
+/	binary footprint is approximately 960 bytes, about 40 bytes
+/	of it is overhead needed to load the second 512-byte sector
+/	so if we can find a way to reduce the code size another 400
+/	bytes we can bootstrap the metacircular evaluator in an mbr
+
+#define NIL		0
+#define UNDEFINED	8
+#define ATOM_T		30
+#define ATOM_QUOTE	34
+#define ATOM_ATOM	46
+#define ATOM_EQ		56
+#define ATOM_COND	62
+#define ATOM_CAR	72
+#define ATOM_CDR	80
+#define ATOM_CONS	88
+#define ATOM_LAMBDA	98
+
+#define SYNTAX		0x4000
+#define LOOK		0x4100
+#define GLOBALS		0x4102
+#define INDEX		0x4104
+#define TOKEN		0x4106
+#define STR		0x41c8
+
+////////////////////////////////////////////////////////////////////////////////
+.section .start,"ax",@progbits
+.globl	main
+.code16
+
+main:	mov	$SYNTAX,%bx
+	movb	$32,32(%bx)
+	movb	$32,13(%bx)
+	movb	$32,10(%bx)
+	movw	$10536,40(%bx)
+	movb	$46,46(%bx)
+	mov	$STR,%di
+	mov	$kSymbols,%si
+	mov	$57,%cx
+	rep movsb
+0:	call	GetChar
+	mov	%ax,LOOK
+	call	GetToken
+	call	GetObject
+	xchg	%ax,%di
+	mov	GLOBALS,%si
+	call	Eval
+	xchg	%ax,%di
+	call	PrintObject
+	mov	$kCrlf,%di
+	call	PrintString
+	jmp	0b
+
+PutChar:push	%bx
+	push	%bp				# original ibm pc scroll up bug
+	mov	$0x0007,%bx			# normal mda/cga style page zero
+	xchg	%di,%ax				# character to display
+	mov	$0x0E,%ah			# teletype output
+	int	$0x10				# vidya service
+	pop	%bp				# result dil→al
+	pop	%bx
+	ret
+
+GetChar:xor	%ax,%ax				# get keystroke
+	int	$0x16				# keyboard service
+	xor	%ah,%ah				# ah is bios scancode
+	push	%ax				# al is ascii character
+	xchg	%ax,%di				# result is ax
+	call	PutChar
+	cmp	$'\r,%al
+	jne	1f
+	mov	$'\n,%di
+	call	PutChar
+1:	pop	%ax
+	ret
+
+PrintString:
+	mov	%di,%dx
+0:	mov	%dx,%di
+	mov	(%di),%al
+	test	%al,%al
+	je	1f
+	xchg	%ax,%di
+	call	PutChar
+	inc	%dx
+	jmp	0b
+1:	ret
+
+GetToken:
+	xor	%bx,%bx
+	mov	$SYNTAX,%si
+	mov	LOOK,%ax
+	mov	$TOKEN,%cx
+0:	mov	%al,%bl
+	mov	(%bx,%si),%dl
+	mov	%dl,%bl
+	cmp	$0x20,%dl
+	jne	1f
+	call	GetChar
+	jmp	0b
+1:	test	%dl,%dl
+	je	3f
+	xchg	%cx,%di
+	stosb
+	xchg	%di,%cx
+	call	GetChar
+	jmp	4f
+2:	test	%bl,%bl
+	jne	4f
+	xchg	%cx,%di
+	stosb
+	xchg	%di,%cx
+	call	GetChar
+	mov	%ax,%bx
+	mov	(%bx,%si),%bl
+3:	test	%al,%al
+	jne	2b
+4:	mov	%cx,%di
+	movb	$0,(%di)
+	mov	%al,LOOK
+	ret
+
+Assoc:	xchg	%si,%bx
+0:	test	%bx,%bx
+	je	2f
+	and	$-2,%bx
+	mov	(%bx),%si
+	and	$-2,%si
+	mov	(%si),%ax
+	cmp	%di,%ax
+	jne	1f
+	mov	(%bx),%si
+	and	$-2,%si
+	mov	2(%si),%ax
+	ret
+1:	mov	2(%bx),%bx
+	jmp	0b
+2:	xor	%ax,%ax
+	ret
+
+GetObject:
+	cmpb	$40,TOKEN
+	je	1f
+	mov	$TOKEN,%di
+	jmp	Intern
+1:	#jmp	GetList
+/	𝑠𝑙𝑖𝑑𝑒
+
+GetList:call	GetToken
+	mov	TOKEN,%al
+	cmp	$'),%al
+	je	2f
+	cmp	$'.,%al
+	je	1f
+	call	GetObject
+	push	%ax
+	call	GetList
+	xchg	%ax,%si
+	pop	%di
+	jmp	Cons
+1:	call	GetToken
+	jmp	GetObject
+2:	xor	%ax,%ax
+	ret
+
+EvalCons:
+	push	%dx			# save
+	mov	2(%bx),%bx
+	mov	%bx,%di
+	call	Cadr
+	mov	%ax,%di
+	mov	%bp,%si
+	call	Eval
+	mov	%bp,%si
+	pop	%di			# restore
+	push	%ax			# save
+	call	Arg1
+	pop	%si			# restore
+	xchg	%ax,%di
+	pop	%bp
+/	jmp	Cons
+/	𝑠𝑙𝑖𝑑𝑒
+
+Cons:	mov	$INDEX,%bx
+	mov	(%bx),%ax
+	addw	$2,(%bx)
+	shl	%ax
+	mov	%ax,%bx
+	mov	%di,(%bx)
+	mov	%si,2(%bx)
+	or	$1,%ax
+	ret
+
+Bind:	test	%di,%di
+	je	1f
+	push	%bp
+	mov	%sp,%bp
+	push	%dx
+	push	%dx
+	xchg	%si,%bx
+	and	$-2,%bx
+	and	$-2,%di
+	mov	%di,-4(%bp)
+	mov	2(%bx),%si
+	mov	2(%di),%di
+	push	%bx				# save no. 1
+	call	Bind
+	pop	%bx				# rest no. 1
+	push	%ax				# save no. 2
+	mov	(%bx),%bx
+	mov	%bx,%di
+	mov	-2(%bp),%si
+	call	Eval
+	mov	-4(%bp),%di
+	mov	(%di),%di
+	xchg	%ax,%si
+	call	Cons
+	pop	%si				# rest no. 2
+	xchg	%ax,%di
+	leave
+	jmp	Cons
+1:	xchg	%dx,%ax
+	ret
+
+EvalCdr:
+	mov	%dx,%di
+	mov	%bp,%si
+	call	Arg1
+	and	$-2,%ax
+	mov	%ax,%di
+	mov	2(%di),%ax
+	pop	%bp
+	ret
+
+////////////////////////////////////////////////////////////////////////////////
+.text
+
+Cadr:	and	$-2,%di				# (object >> 1) * sizeof(word)
+	mov	2(%di),%di			# contents of decrement register
+	and	$-2,%di				# contents of address register
+	mov	(%di),%ax
+	ret
+
+Arg1:	call	Cadr
+	xchg	%ax,%di
+	jmp	Eval
+
+PrintObject:
+	push	%bp
+	mov	%di,%bp
+	test	$1,%di
+	setz	%al
+	shr	%di
+	test	%al,%al
+	je	1f
+	add	$STR,%di
+	pop	%bp
+	jmp	PrintString
+1:	mov	$40,%di
+	call	PutChar
+2:	mov	%bp,%bx
+	and	$-2,%bx
+	mov	(%bx),%di
+	call	PrintObject
+	mov	%bp,%bx
+	and	$-2,%bx
+	mov	2(%bx),%bx
+	mov	%bx,%bp
+	test	%bx,%bx
+	je	4f
+	test	$1,%bl
+	je	3f
+	mov	$0x20,%di
+	call	PutChar
+	jmp	2b
+3:	mov	$kDot,%di
+	call	PrintString
+	mov	%bp,%di
+	call	PrintObject
+4:	mov	$41,%di
+	pop	%bp
+	jmp	PutChar
+
+Eval:	push	%bp
+	mov	%di,%dx
+	mov	%si,%bp
+0:	test	$1,%dl
+	jne	1f
+	xchg	%bp,%si
+	xchg	%dx,%di
+	pop	%bp
+	jmp	Assoc
+1:	mov	%dx,%bx
+	and	$-2,%bx
+	mov	(%bx),%ax
+	test	$1,%al
+	je	1f
+	mov	(%bx),%ax
+	and	$-2,%ax
+	mov	%ax,%di
+	mov	(%di),%ax
+	cmp	$ATOM_LAMBDA,%ax
+	jne	EvalUndefined
+	mov	2(%bx),%si
+	mov	(%bx),%di
+	push	%bx
+	call	Cadr
+	mov	%si,%si
+	mov	%ax,%di
+	mov	%bp,%dx
+	call	Bind
+	mov	%ax,%bp
+	pop	%bx
+	mov	(%bx),%bx
+	mov	%bx,%di
+	and	$-2,%di
+	mov	2(%di),%di
+	jmp	8f
+1:	mov	(%bx),%ax
+	cmp	$ATOM_COND,%ax
+	je	EvalCond
+	jg	2f
+	cmp	$ATOM_ATOM,%ax
+	je	EvalAtom
+	jg	1f
+	test	%ax,%ax
+	je	EvalUndefined
+	cmp	$ATOM_QUOTE,%ax
+	jne	EvalCall
+	xchg	%dx,%di
+	pop	%bp
+	jmp	Cadr
+1:	cmp	$ATOM_EQ,%ax
+	jne	EvalCall
+	push	%dx
+	mov	2(%bx),%bx
+	mov	%bx,%di
+	call	Cadr
+	mov	%ax,%di
+	mov	%bp,%si
+	call	Eval
+	mov	%bp,%si
+	pop	%di			# restore
+	push	%ax			# save
+	call	Arg1
+	pop	%dx			# restore
+	cmp	%dx,%ax
+	jmp	3f
+2:	cmp	$ATOM_CDR,%ax
+	je	EvalCdr
+	cmp	$ATOM_CONS,%ax
+	je	EvalCons
+	cmp	$ATOM_CAR,%ax
+	jne	EvalCall
+	mov	%bp,%si
+	mov	%dx,%di
+	call	Arg1
+	and	$-2,%ax
+	xchg	%ax,%di
+	mov	(%di),%ax
+	jmp	9f
+EvalAtom:
+	mov	%bp,%si
+	mov	%dx,%di
+	call	Arg1
+	test	$1,%al
+3:	mov	$ATOM_T,%ax
+	je	9f
+	xor	%ax,%ax
+	jmp	9f
+EvalCond:
+	mov	2(%bx),%bx
+	mov	%bx,%bx
+	and	$-2,%bx
+	mov	(%bx),%di
+	push	%bx			# save
+	and	$-2,%di
+	mov	(%di),%di
+	mov	%bp,%si
+	call	Eval
+	test	%ax,%ax
+	pop	%bx			# restore
+	je	EvalCond
+	mov	(%bx),%bx
+	mov	%bx,%di
+	jmp	8f
+EvalCall:
+	mov	2(%bx),%cx
+	mov	(%bx),%bx
+	mov	%bx,%di
+	mov	%bp,%si
+	call	Assoc
+	mov	%cx,%si
+	mov	%ax,%di
+	call	Cons
+	jmp	1f
+8:	call	Cadr
+1:	mov	%ax,%dx
+	jmp	0b
+EvalUndefined:
+	mov	$UNDEFINED,%ax
+9:	pop	%bp
+	ret
+
+Intern:	push	%bp
+	xchg	%di,%bx
+	mov	$STR,%si
+0:	lodsb
+	test	%al,%al
+	je	4f
+	xor	%dx,%dx
+1:	mov	%dx,%bp
+	mov	%dx,%di
+	mov	(%bx,%di),%cl
+	cmp	%cl,%al
+	jne	3f
+	inc	%dx
+	test	%al,%al
+	jne	2f
+	mov	%bp,%cx
+	sub	%cx,%si
+	lea	-STR-1(%si),%ax
+	jmp	6f
+2:	lodsb
+	jmp	1b
+3:	test	%al,%al
+	je	0b
+	lodsb
+	jmp	3b
+4:	lea	-1(%si),%dx
+	mov	%dx,%di
+	xchg	%bx,%si
+0:	lodsb
+	stosb
+	test	%al,%al
+	jnz	0b
+	xchg	%dx,%ax
+	sub	$STR,%ax
+6:	shl	%ax
+	pop	%bp
+	ret
+
+////////////////////////////////////////////////////////////////////////////////
+.section .rodata,"a",@progbits
+
+kDot:	.string	" . "
+kCrlf:	.string	"\r\n"
+kSymbols:
+	.string	"NIL"
+	.string	"*UNDEFINED"
+	.string	"T"
+	.string	"QUOTE"
+	.string	"ATOM"
+	.string	"EQ"
+	.string	"COND"
+	.string	"CAR"
+	.string	"CDR"
+	.string	"CONS"
+	.string	"LAMBDA"
+	.string	""

start.S

@@ -0,0 +1,45 @@
+/*-*- mode:unix-assembly; indent-tabs-mode:t; tab-width:8; coding:utf-8     -*-│
+│vi: set et ft=asm ts=8 tw=8 fenc=utf-8                                     :vi│
+╞══════════════════════════════════════════════════════════════════════════════╡
+│ Copyright 2020 Justine Alexandra Roberts Tunney                              │
+│                                                                              │
+│ Permission to use, copy, modify, and/or distribute this software for         │
+│ any purpose with or without fee is hereby granted, provided that the         │
+│ above copyright notice and this permission notice appear in all copies.      │
+│                                                                              │
+│ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL                │
+│ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED                │
+│ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE             │
+│ AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL         │
+│ DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR        │
+│ PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER               │
+│ TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR             │
+│ PERFORMANCE OF THIS SOFTWARE.                                                │
+╚─────────────────────────────────────────────────────────────────────────────*/
+.section .start,"ax",@progbits
+.globl	_start
+.code16
+
+_start:	jmp	1f				# some bios scan for short jump
+1:	ljmp	$0x600>>4,$_begin		# end of bios data roundup page
+
+_begin:	push	%cs				# memory model cs=ds=es = 0x600
+	pop	%ds
+	push	%cs
+	pop	%es
+	mov	$0x70000>>4,%ax			# last 64k of first 480k memory
+	cli					# create stack in higher memory
+	mov	%ax,%ss				# carefully avoids i8086 errata
+	xor	%sp,%sp
+	sti
+	cld
+	xor	%ax,%ax
+	xor	%di,%di
+	mov	$0x7c00-0x600,%cx
+	rep stosb				# clears our bss memory
+	xchg	%di,%bx				# start buffer at 07c00
+	inc	%cx				# start at first sector
+	xor	%dh,%dh				# drive dl head zero
+	mov	$0x0200+v_sectors,%ax		# read sectors
+	int	$0x13				# disk service
+	jmp	main