diff --git a/lisp.js b/lisp.js new file mode 100755 index 0000000..9eb026e --- /dev/null +++ b/lisp.js @@ -0,0 +1,403 @@ +/*bin/echo '#-*- indent-tabs-mode:nil;js-indent-level:2;coding:utf-8 -*- + + SectorLISP v2.o (ISC License) + Copyright 2021 Justine Tunney + + This file implements SectorLISP as a C / JavaScript polyglot and + includes friendly branch features such as the undefined behavior + exceptions handlers, optimized interning, and global definitions + +(aset standard-display-table #x2029 [?¶]) ;; emacs protip '>/dev/null +curl -so bestline.c -z bestline.c https://justine.lol/sectorlisp2/bestline.c +curl -so bestline.h -z bestline.h https://justine.lol/sectorlisp2/bestline.h +[ lisp.js -nt lisp ] && cc -w -xc lisp.js bestline.c -o lisp +exec ./lisp "$@" +exit +*/ + +//
` +#include "bestline.h" +#ifndef __COSMOPOLITAN__ +#include +#include +#include +#endif +#define var int +#define function +#define Null 0100000 +var M[Null * 2]; +jmp_buf undefined; +//` + +var cx, dx, kT, kEq, kCar, kCdr, kCond, kAtom, kCons, kQuote, kDefine; + +function Set(i, x) { + M[Null + i] = x; +} + +function Get(i) { + return M[Null + i]; +} + +function Car(x) { + if (x < 0) { + return Get(x); + } else { + Throw(x); + } +} + +function Cdr(x) { + if (x < 0) { + return Get(x + 1); + } else { + Throw(x + 1); + } +} + +function Cons(car, cdr) { + Set(--cx, cdr); + Set(--cx, car); + return cx; +} + +function Hash(h, c) { + return h + c * 2; +} + +function Intern(x, y, i) { + i &= Null - 1; + if (x == Get(i) && y == Get(i + 1)) return i; + if (Get(i)) return Intern(x, y, i + 2); + Set(i, x); + Set(i + 1, y); + return i; +} + +function ReadAtom(h) { + var c = ReadChar(); + if (c <= Ord(' ')) return ReadAtom(h); + return Intern(c, c > Ord(')') && dx > Ord(')') ? + ReadAtom(Hash(h, c)) : 0, + Hash(h, c) - Hash(0, Ord('N'))); +} + +function PrintAtom(x) { + do PrintChar(Get(x)); + while ((x = Get(x + 1))); +} + +function AddList(x) { + return Cons(x, ReadList()); +} + +function ReadList() { + var t = ReadAtom(0); + if (Get(t) == Ord(')')) return -0; + return AddList(ReadObject(t)); +} + +function ReadObject(t) { + if (Get(t) != Ord('(')) return t; + return ReadList(); +} + +function PrintList(x) { + PrintChar(Ord('(')); + if (x < 0) { + PrintObject(Car(x)); + while ((x = Cdr(x))) { + if (x < 0) { + PrintChar(Ord(' ')); + PrintObject(Car(x)); + } else { + PrintChar(0x2219); + PrintObject(x); + break; + } + } + } + PrintChar(Ord(')')); +} + +function PrintObject(x) { + if (1./x < 0) { + PrintList(x); + } else { + PrintAtom(x); + } +} + +function Print(e) { + PrintObject(e); + PrintChar(Ord('\n')); +} + +function Read() { + return ReadObject(ReadAtom(0)); +} + +function Define(a) { + var x = Read(); + return Cons(Cons(x, Read()), a); +} + +function Gc(A, x) { + var C, B = cx; + x = Copy(x, A, A - B), C = cx; + while (C < B) Set(--A, Get(--B)); + cx = A; + return x; +} + +function Copy(x, m, k) { + return x < m ? Cons(Copy(Car(x), m, k), + Copy(Cdr(x), m, k)) + k : x; +} + +function Evlis(m, a) { + return m ? Cons(Eval(Car(m), a), + Evlis(Cdr(m), a)) : 0; +} + +function Pairlis(x, y, a) { + return x ? Cons(Cons(Car(x), Car(y)), + Pairlis(Cdr(x), Cdr(y), a)) : a; +} + +function Assoc(x, y) { + if (y >= 0) Throw(x); + if (x == Car(Car(y))) return Cdr(Car(y)); + return Assoc(x, Cdr(y)); +} + +function Evcon(c, a) { + if (Eval(Car(Car(c)), a)) { + return Eval(Car(Cdr(Car(c))), a); + } else if (Cdr(c)) { + return Evcon(Cdr(c), a); + } else { + Throw(c); + } +} + +function Apply(f, x, a) { + if (f < 0) return Eval(Car(Cdr(Cdr(f))), Pairlis(Car(Cdr(f)), x, a)); + if (f == kEq) return Car(x) == Car(Cdr(x)) ? kT : 0; + if (f == kCons) return Cons(Car(x), Car(Cdr(x))); + if (f == kAtom) return Car(x) < 0 ? 0 : kT; + if (f == kCar) return Car(Car(x)); + if (f == kCdr) return Cdr(Car(x)); + return Apply(Assoc(f, a), x, a); +} + +function Eval(e, a) { + var A = cx; + if (!e) return e; + if (e > 0) return Assoc(e, a); + if (Car(e) == kQuote) return Car(Cdr(e)); + if (Car(e) == kCond) { + e = Evcon(Cdr(e), a); + } else { + e = Apply(Car(e), Evlis(Cdr(e), a), a); + } + return Gc(A, e); +} + +function LoadBuiltins() { + ReadAtom(0); + kT = ReadAtom(0); + kEq = ReadAtom(0); + kCar = ReadAtom(0); + kCdr = ReadAtom(0); + kAtom = ReadAtom(0); + kCond = ReadAtom(0); + kCons = ReadAtom(0); + kQuote = ReadAtom(0); + kDefine = ReadAtom(0); +} + +//
` +//////////////////////////////////////////////////////////////////////////////// +// ANSI POSIX C Specific Code + +Ord(c) { + return c; +} + +Throw(x) { + longjmp(undefined, ~x); +} + +PrintChar(b) { + fputwc(b, stdout); +} + +ReadChar() { + int b, c, t; + static char *freeme; + static char *line = "NIL T EQ CAR CDR ATOM COND CONS QUOTE DEFINE "; + if (line || (line = freeme = bestlineWithHistory("* ", "sectorlisp"))) { + if (*line) { + c = *line++ & 0377; + if (c >= 0300) { + for (b = 0200; c & b; b >>= 1) c ^= b; + while ((*line & 0300) == 0200) { + c <<= 6; + c |= *line++ & 0177; + } + } + } else { + free(freeme); + freeme = 0; + line = 0; + c = '\n'; + } + t = dx; + dx = c; + return t; + } else { + PrintChar('\n'); + exit(0); + } +} + +main() { + var x, a, A; + setlocale(LC_ALL, ""); + bestlineSetXlatCallback(bestlineUppercase); + LoadBuiltins(); + for (a = 0;;) { + A = cx; + if (!(x = setjmp(undefined))) { + x = Read(); + if (x == kDefine) { + a = Gc(A, Define(a)); + continue; + } + x = Eval(x, a); + } else { + x = ~x; + PrintChar('?'); + } + Print(x); + Gc(A, 0); + } +} + +#if 0 +//` +//////////////////////////////////////////////////////////////////////////////// +// JavaScript Specific Code for https://justine.lol/ + +var a, code, index, M, Null; +var eInput, eOutput, eSubmit, eClear, eLoad, ePrograms; + +function Throw(x) { + throw x; +} + +function Ord(s) { + return s.charCodeAt(0); +} + +function PrintChar(c) { + eOutput.innerText += String.fromCharCode(c); + SaveOutput(); +} + +function ReadChar() { + var ax; + if (code.length) { + ax = dx; + if (index < code.length) { + dx = code.charCodeAt(index++); + } else { + code = ""; + dx = 0; + } + return ax; + } else { + Throw(0); + } +} + +function Lisp() { + var x, A; + while (dx) { + if (dx <= Ord(' ')) { + ReadChar(); + } else { + A = cx; + try { + x = Read(); + if (x == kDefine) { + a = Gc(A, Define(a)); + continue; + } + x = Eval(x, a); + } catch (x) { + PrintChar(Ord('?')); + } + Print(x); + Gc(A, 0); + } + } +} + +function Load(s) { + code = s + "\n"; + dx = Ord(s); + index = 1; +} + +function OnSubmit() { + Load(eInput.value); + Lisp(); +} + +function OnClear() { + eOutput.innerText = ""; + SaveOutput(); +} + +function OnLoad() { + ePrograms.classList.toggle("show"); +} + +function OnWindowClick(event) { + if (!event.target.matches('#load')) { + ePrograms.classList.remove("show"); + } +} + +function SaveOutput() { + if (typeof localStorage != 'undefined') { + localStorage.setItem('output', eOutput.innerText); + } +} + +function SetUp() { + a = 0; + cx = 0; + Null = 0100000; + M = new Array(Null * 2); + Load("NIL T EQ CAR CDR ATOM COND CONS QUOTE DEFINE "); + LoadBuiltins() + eLoad = document.getElementById('load'); + eInput = document.getElementById('input'); + eClear = document.getElementById('clear'); + eOutput = document.getElementById('output'); + eSubmit = document.getElementById('submit'); + ePrograms = document.getElementById("programs"); + window.onclick = OnWindowClick; + eSubmit.onclick = OnSubmit; + eClear.onclick = OnClear; + eLoad.onclick = OnLoad; +} + +SetUp(); + +//
` +#endif +//` diff --git a/sectorlisp.S b/sectorlisp.S index ca497c6..c2b2373 100644 --- a/sectorlisp.S +++ b/sectorlisp.S @@ -24,7 +24,7 @@ .code16 .set a,-2-2 - .globl _start # LISP: VERITAS NUMQUAM PERIT + .globl _start _start: .asciz "NIL" # dec %si ; dec %cx ; dec %sp kT: .asciz "T" # add %dl,(%si) boot A:\ DL=0 start: ljmp $0x7c00>>4,$begin # cs = 0x7c00 is boot address