mirror of
https://github.com/samsonjs/sectorlisp.git
synced 2026-03-25 09:05:48 +00:00
Make improvements
This commit is contained in:
parent
c9ce1c54a0
commit
e54c840f49
5 changed files with 512 additions and 158 deletions
1
.gitignore
vendored
1
.gitignore
vendored
|
|
@ -1,4 +1,5 @@
|
|||
/lisp
|
||||
/hash
|
||||
/*.o
|
||||
/*.bin
|
||||
/*.bin.dbg
|
||||
|
|
|
|||
13
Makefile
13
Makefile
|
|
@ -1,9 +1,9 @@
|
|||
CFLAGS = -w -g
|
||||
CFLAGS = -w -g -O2
|
||||
|
||||
CLEANFILES = \
|
||||
lisp \
|
||||
lisp.o \
|
||||
lisp.o \
|
||||
hash \
|
||||
bestline.o \
|
||||
sectorlisp.o \
|
||||
sectorlisp.bin \
|
||||
|
|
@ -14,6 +14,7 @@ CLEANFILES = \
|
|||
|
||||
.PHONY: all
|
||||
all: lisp \
|
||||
hash \
|
||||
sectorlisp.bin \
|
||||
sectorlisp.bin.dbg \
|
||||
brainfuck.bin \
|
||||
|
|
@ -44,5 +45,13 @@ brainfuck.bin.dbg: brainfuck.o
|
|||
brainfuck.bin: brainfuck.bin.dbg
|
||||
objcopy -S -O binary brainfuck.bin.dbg brainfuck.bin
|
||||
|
||||
.PHONY: check
|
||||
check:
|
||||
./checkjumps.sh
|
||||
gcc -w -c -o /dev/null -xc lisp.js
|
||||
clang -w -c -o /dev/null -xc lisp.js
|
||||
gcc -Wall -Werror -c -o /dev/null hash.c
|
||||
clang -Wall -Werror -c -o /dev/null hash.c
|
||||
|
||||
%.o: %.js
|
||||
$(COMPILE.c) -xc $(OUTPUT_OPTION) $<
|
||||
|
|
|
|||
8
checkjumps.sh
Executable file
8
checkjumps.sh
Executable file
|
|
@ -0,0 +1,8 @@
|
|||
#!/bin/sh
|
||||
if objdump -Cwd -Mi8086 sectorlisp.o | cat -n |
|
||||
grep '[[:xdigit:]][[:xdigit:]] [[:xdigit:]][[:xdigit:]] [[:xdigit:]][[:xdigit:]][[:space:]]*j'; then
|
||||
echo need to shuffle code around >&2
|
||||
exit 1
|
||||
else
|
||||
echo all jump encodings are tiny >&2
|
||||
fi
|
||||
164
hash.c
Normal file
164
hash.c
Normal file
|
|
@ -0,0 +1,164 @@
|
|||
#ifndef __COSMOPOLITAN__
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#endif
|
||||
|
||||
#define word unsigned long
|
||||
#define dubs unsigned __int128
|
||||
|
||||
struct Bar {
|
||||
dubs r;
|
||||
word n;
|
||||
char k;
|
||||
};
|
||||
|
||||
static word Null;
|
||||
|
||||
static inline int IsTwoPow(word x) {
|
||||
return !(x & (x - 1));
|
||||
}
|
||||
|
||||
static inline int Bsf(word x) {
|
||||
#if defined(__GNUC__) && !defined(__STRICT_ANSI__)
|
||||
return __builtin_ctzll(x);
|
||||
#else
|
||||
uint32_t l, r;
|
||||
x &= -x;
|
||||
l = x | x >> 32;
|
||||
r = !!(x >> 32), r <<= 1;
|
||||
r += !!(l & 0xffff0000), r <<= 1;
|
||||
r += !!(l & 0xff00ff00), r <<= 1;
|
||||
r += !!(l & 0xf0f0f0f0), r <<= 1;
|
||||
r += !!(l & 0xcccccccc), r <<= 1;
|
||||
r += !!(l & 0xaaaaaaaa);
|
||||
return r;
|
||||
#endif
|
||||
}
|
||||
|
||||
static inline int Bsr(word x) {
|
||||
#if defined(__GNUC__) && !defined(__STRICT_ANSI__)
|
||||
return __builtin_clzll(x) ^ 63;
|
||||
#else
|
||||
static const char kDebruijn[64] = {
|
||||
0, 47, 1, 56, 48, 27, 2, 60, 57, 49, 41, 37, 28, 16, 3, 61,
|
||||
54, 58, 35, 52, 50, 42, 21, 44, 38, 32, 29, 23, 17, 11, 4, 62,
|
||||
46, 55, 26, 59, 40, 36, 15, 53, 34, 51, 20, 43, 31, 22, 10, 45,
|
||||
25, 39, 14, 33, 19, 30, 9, 24, 13, 18, 8, 12, 7, 6, 5, 63,
|
||||
};
|
||||
x |= x >> 1;
|
||||
x |= x >> 2;
|
||||
x |= x >> 4;
|
||||
x |= x >> 8;
|
||||
x |= x >> 16;
|
||||
x |= x >> 32;
|
||||
return kDebruijn[(x * 0x03f79d71b4cb0a89) >> 58];
|
||||
#endif
|
||||
}
|
||||
|
||||
static inline word Log(word x) {
|
||||
return --x ? Bsr(x) + 1 : 0;
|
||||
}
|
||||
|
||||
static struct Bar Bar(word n) {
|
||||
struct Bar m;
|
||||
m.r = 1;
|
||||
m.n = n;
|
||||
m.k = Log(n) << 1;
|
||||
m.r = (m.r << m.k) / n;
|
||||
return m;
|
||||
}
|
||||
|
||||
static word Mod(struct Bar m, dubs x) {
|
||||
dubs t;
|
||||
t = x - ((x * m.r) >> m.k) * m.n;
|
||||
if (t >= m.n) t -= m.n;
|
||||
return t;
|
||||
}
|
||||
|
||||
static word Mul(struct Bar m, word x, word y) {
|
||||
dubs t = x;
|
||||
return Mod(m, t * y);
|
||||
}
|
||||
|
||||
static word Pow(struct Bar m, word a, word n) {
|
||||
word p, r;
|
||||
for (p = a, r = 1; n; n >>= 1) {
|
||||
if (n & 1) r = Mul(m, r, p);
|
||||
p = Mul(m, p, p);
|
||||
}
|
||||
return r;
|
||||
}
|
||||
|
||||
static int W(struct Bar m, word a) {
|
||||
word x, y, s;
|
||||
s = Bsf(m.n >> 1) + 1;
|
||||
x = Pow(m, a, m.n >> s);
|
||||
for (y = 0; s; --s, x = y) {
|
||||
y = Mul(m, x, x);
|
||||
if (y == 1 && x != 1 && x != m.n - 1) {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
return y == 1;
|
||||
}
|
||||
|
||||
static int MillerTime(word n) {
|
||||
struct Bar m;
|
||||
if (n < 2) return 0;
|
||||
if (n <= 3) return 1;
|
||||
if (~n & 1) return 0;
|
||||
if (n % 3 == 0) return 0;
|
||||
m = Bar(n);
|
||||
if (n < 1373653) return W(m,2) && W(m,3);
|
||||
if (n < 9080191) return W(m,31) && W(m,73);
|
||||
if (n < 4759123141) return W(m,2) && W(m,7) && W(m,61);
|
||||
if (n < 1122004669633) return W(m,2) && W(m,13) && W(m,23) && W(m,1662803);
|
||||
if (n < 2152302898747) return W(m,2) && W(m,3) && W(m,5) && W(m,7) && W(m,11);
|
||||
if (n < 3474749660383) return W(m,2) && W(m,3) && W(m,5) && W(m,7) && W(m,11) && W(m,13);
|
||||
return W(m,2) && W(m,3) && W(m,5) && W(m,7) && W(m,11) && W(m,13) && W(m,17);
|
||||
}
|
||||
|
||||
static word Hash(word h, word x, word a, word b, word c) {
|
||||
return (((h + x) * a + b) >> c) & (Null / 2 - 1);
|
||||
}
|
||||
|
||||
static word Ok(word a, word b, word c) {
|
||||
return Hash(Hash(Hash(0, 'L', a, b, c), 'I', a, b, c), 'N', a, b, c) == 0 &&
|
||||
Hash(0, 'T', a, b, c) == 1 &&
|
||||
Hash(0, 'T', a, b, c) != Hash(0, 'U', a, b, c);
|
||||
}
|
||||
|
||||
static int Usage(const char *prog) {
|
||||
fprintf(stderr, "Usage: %s NULL\n", prog);
|
||||
fprintf(stderr, "Finds magic numbers for SectorLISP Hash()\n");
|
||||
return 1;
|
||||
}
|
||||
|
||||
int main(int argc, char *argv[]) {
|
||||
word a, b, c;
|
||||
if (argc > 1) {
|
||||
Null = strtoul(argv[1], 0, 0);
|
||||
if (Null < 128) {
|
||||
fprintf(stderr, "Error: Null is too small\n");
|
||||
return Usage(argv[0]);
|
||||
}
|
||||
if (!IsTwoPow(Null)) {
|
||||
fprintf(stderr, "Error: Null must be two power\n");
|
||||
return Usage(argv[0]);
|
||||
}
|
||||
} else {
|
||||
Null = 040000;
|
||||
}
|
||||
for (a = 2; a < Null; ++a) {
|
||||
if (!MillerTime(a)) continue;
|
||||
for (c = 0; c <= Bsr(Null / 2); ++c) {
|
||||
for (b = 0; b < Null; ++b) {
|
||||
if (Ok(a, b, c)) {
|
||||
printf("return (((h + x) * %lu + %lu) >> %lu) & %#lo;\n", a, b, c,
|
||||
Null / 2 - 1);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
484
lisp.js
484
lisp.js
|
|
@ -18,6 +18,7 @@ exit
|
|||
//
`
|
||||
#include "bestline.h"
|
||||
#ifndef __COSMOPOLITAN__
|
||||
#include <assert.h>
|
||||
#include <stdio.h>
|
||||
#include <locale.h>
|
||||
#include <setjmp.h>
|
||||
|
|
@ -30,9 +31,9 @@ var (*funcall)();
|
|||
jmp_buf undefined;
|
||||
//`
|
||||
|
||||
var cx, dx, depth, panic;
|
||||
var cHeap, cGets, cSets, cPrints;
|
||||
var kT, kEq, kCar, kCdr, kCond, kAtom, kCons, kQuote, kDefine;
|
||||
var ax, cx, dx, depth, panic, fail;
|
||||
var cHeap, cGets, cSets, cReads, cPrints;
|
||||
var kEq, kCar, kCdr, kCond, kAtom, kCons, kQuote, kDefine;
|
||||
|
||||
function Get(i) {
|
||||
++cGets;
|
||||
|
|
@ -61,52 +62,59 @@ function Cons(car, cdr) {
|
|||
return cx;
|
||||
}
|
||||
|
||||
function Hash(h, c) {
|
||||
return h + c * 2;
|
||||
function Probe(h, p) {
|
||||
return (h + p * p) & (Null / 2 - 1);
|
||||
}
|
||||
|
||||
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 Hash(h, x) {
|
||||
return (((h + x) * 3083 + 3191) >> 4) & (Null / 2 - 1);
|
||||
}
|
||||
|
||||
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 Intern(x, y, h, p) {
|
||||
if (x == Get(h) && y == Get(h + Null / 2)) return h;
|
||||
if (Get(h)) return Intern(x, y, Probe(h, p), p + 1);
|
||||
Set(h, x);
|
||||
Set(h + Null/2, y);
|
||||
return h;
|
||||
}
|
||||
|
||||
function ReadAtom() {
|
||||
var x, y;
|
||||
ax = y = 0;
|
||||
do x = ReadChar();
|
||||
while (x <= Ord(' '));
|
||||
if (x > Ord(')') && dx > Ord(')')) y = ReadAtom();
|
||||
return Intern(x, y, (ax = Hash(x, ax)), 1);
|
||||
}
|
||||
|
||||
function ReadList() {
|
||||
var x;
|
||||
var x, y;
|
||||
if ((x = Read()) > 0) {
|
||||
if (Get(x) == Ord(')')) return -0;
|
||||
if (Get(x) == Ord('.') && !Get(x + 1)) {
|
||||
x = Read();
|
||||
ReadList();
|
||||
return x;
|
||||
y = ReadList();
|
||||
if (!y) {
|
||||
return x;
|
||||
} else {
|
||||
Throw(y);
|
||||
}
|
||||
}
|
||||
}
|
||||
return Cons(x, ReadList());
|
||||
}
|
||||
|
||||
function ReadObject(t) {
|
||||
function Read() {
|
||||
var t;
|
||||
++cReads;
|
||||
t = ReadAtom();
|
||||
if (Get(t) != Ord('(')) return t;
|
||||
return ReadList();
|
||||
}
|
||||
|
||||
function Read() {
|
||||
return ReadObject(ReadAtom(0));
|
||||
}
|
||||
|
||||
function PrintAtom(x) {
|
||||
do PrintChar(Get(x));
|
||||
while ((x = Get(x + 1)));
|
||||
while ((x = Get(x + Null / 2)));
|
||||
}
|
||||
|
||||
function PrintList(x) {
|
||||
|
|
@ -144,17 +152,7 @@ function Print(x) {
|
|||
}
|
||||
|
||||
function List(x, y) {
|
||||
return Cons(x, Cons(y, 0));
|
||||
}
|
||||
|
||||
function Define(A, x, a) {
|
||||
return Gc(A, Cons(x, Remove(Car(x), a)));
|
||||
}
|
||||
|
||||
function Remove(x, y) {
|
||||
if (!y) return y;
|
||||
if (x == Car(Car(y))) return Cdr(y);
|
||||
return Cons(Car(y), Remove(x, Cdr(y)));
|
||||
return Cons(x, Cons(y, -0));
|
||||
}
|
||||
|
||||
function Gc(A, x) {
|
||||
|
|
@ -164,6 +162,19 @@ function Gc(A, x) {
|
|||
return cx = A, x;
|
||||
}
|
||||
|
||||
function Evcon(c, a) {
|
||||
if (c >= 0) Throw(kCond);
|
||||
if (Eval(Car(Car(c)), a)) {
|
||||
return Eval(Car(Cdr(Car(c))), a);
|
||||
} else {
|
||||
return Evcon(Cdr(c), a);
|
||||
}
|
||||
}
|
||||
|
||||
function Peel(x, a) {
|
||||
return a && x == Car(Car(a)) ? Cdr(a) : a;
|
||||
}
|
||||
|
||||
function Copy(x, m, k) {
|
||||
return x < m ? Cons(Copy(Car(x), m, k),
|
||||
Copy(Cdr(x), m, k)) + k : x;
|
||||
|
|
@ -176,33 +187,23 @@ function Evlis(m, a) {
|
|||
|
||||
function Pairlis(x, y, a) {
|
||||
return x ? Cons(Cons(Car(x), Car(y)),
|
||||
Pairlis(Cdr(x), Cdr(y), a)) : a;
|
||||
Pairlis(Cdr(x), Cdr(y),
|
||||
Peel(Car(x), 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(Cons(kCond, c));
|
||||
}
|
||||
if (!y) Throw(x);
|
||||
return x == Car(Car(y)) ? Cdr(Car(y)) : Assoc(x, Cdr(y));
|
||||
}
|
||||
|
||||
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 == kEq) return Car(x) == Car(Cdr(x));
|
||||
if (f == kAtom) return Car(x) >= 0;
|
||||
if (f == kCar) return Car(Car(x));
|
||||
if (f == kCdr) return Cdr(Car(x));
|
||||
return funcall(f, Assoc(f, a), x, a);
|
||||
return funcall(cx, f, Assoc(f, a), x, a);
|
||||
}
|
||||
|
||||
function Eval(e, a) {
|
||||
|
|
@ -213,19 +214,18 @@ function Eval(e, a) {
|
|||
return Apply(Car(e), Evlis(Cdr(e), a), a);
|
||||
}
|
||||
|
||||
function Funcall(f, l, x, a) {
|
||||
var A = cx;
|
||||
function Funcall(A, f, l, x, a) {
|
||||
return Gc(A, Apply(l, x, a));
|
||||
}
|
||||
|
||||
function Funtrace(f, l, x, a) {
|
||||
var y, i, A = cx;
|
||||
function Funtrace(A, f, l, x, a) {
|
||||
var y;
|
||||
Indent(depth);
|
||||
Print(f);
|
||||
Print(x);
|
||||
PrintChar(Ord('\n'));
|
||||
depth += 2;
|
||||
y = Funcall(f, l, x, a);
|
||||
y = Funcall(cx, f, l, x, a);
|
||||
depth -= 2;
|
||||
Indent(depth);
|
||||
Print(f);
|
||||
|
|
@ -245,9 +245,25 @@ function Indent(i) {
|
|||
}
|
||||
}
|
||||
|
||||
function Dump(a) {
|
||||
function DumpAlist(a) {
|
||||
PrintChar(Ord('('));
|
||||
PrintChar(Ord('\n'));
|
||||
for (;a ;a = Cdr(a)) {
|
||||
PrintChar(Ord('('));
|
||||
Print(Car(Car(a)));
|
||||
PrintChar(Ord(' '));
|
||||
PrintChar(Ord('.'));
|
||||
PrintChar(Ord(' '));
|
||||
Print(Cdr(Car(a)));
|
||||
PrintChar(Ord(')'));
|
||||
PrintChar(Ord('\n'));
|
||||
}
|
||||
PrintChar(Ord(')'));
|
||||
}
|
||||
|
||||
function DumpDefines(a) {
|
||||
if (a) {
|
||||
Dump(Cdr(a));
|
||||
DumpDefines(Cdr(a));
|
||||
PrintChar(Ord('('));
|
||||
Print(kDefine);
|
||||
PrintChar(Ord(' '));
|
||||
|
|
@ -262,16 +278,47 @@ function Dump(a) {
|
|||
}
|
||||
|
||||
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);
|
||||
Read();
|
||||
Read();
|
||||
kEq = Read();
|
||||
kCar = Read();
|
||||
kCdr = Read();
|
||||
kAtom = Read();
|
||||
kCond = Read();
|
||||
kCons = Read();
|
||||
kQuote = Read();
|
||||
kDefine = Read();
|
||||
}
|
||||
|
||||
function Crunch(e, B) {
|
||||
var x, y, i;
|
||||
if (e >= 0) return e;
|
||||
x = Crunch(Car(e), B);
|
||||
y = Crunch(Cdr(e), B);
|
||||
for (i = B - 2; i >= cx; i -= 2) {
|
||||
if (x == Car(i) &&
|
||||
y == Cdr(i)) {
|
||||
return i - B;
|
||||
}
|
||||
}
|
||||
return Cons(x, y) - B;
|
||||
}
|
||||
|
||||
function Compact(x) {
|
||||
var C, B = cx, A = 0;
|
||||
x = Crunch(x, B), C = cx;
|
||||
while (C < B) Set(--A, Get(--B));
|
||||
return cx = A, x;
|
||||
}
|
||||
|
||||
function Remove(x, y) {
|
||||
if (!y) return y;
|
||||
if (x == Car(Car(y))) return Cdr(y);
|
||||
return Cons(Car(y), Remove(x, Cdr(y)));
|
||||
}
|
||||
|
||||
function Define(x, a) {
|
||||
return Compact(Cons(x, Remove(Car(x), a)));
|
||||
}
|
||||
|
||||
//
`
|
||||
|
|
@ -283,6 +330,7 @@ Ord(c) {
|
|||
}
|
||||
|
||||
Throw(x) {
|
||||
if (fail < 255) ++fail;
|
||||
longjmp(undefined, ~x);
|
||||
}
|
||||
|
||||
|
|
@ -290,7 +338,7 @@ PrintChar(b) {
|
|||
fputwc(b, stdout);
|
||||
}
|
||||
|
||||
SaveMachine(a) {
|
||||
SaveAlist(a) {
|
||||
}
|
||||
|
||||
ReadChar() {
|
||||
|
|
@ -317,7 +365,7 @@ ReadChar() {
|
|||
dx = c;
|
||||
return t;
|
||||
} else {
|
||||
exit(0);
|
||||
exit(fail);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -344,8 +392,8 @@ main(argc, argv)
|
|||
if (!(x = setjmp(undefined))) {
|
||||
x = Read();
|
||||
if (x < 0 && Car(x) == kDefine) {
|
||||
a = Define(0, Cdr(x), a);
|
||||
SaveMachine(a);
|
||||
a = Define(Cdr(x), a);
|
||||
SaveAlist(a);
|
||||
continue;
|
||||
}
|
||||
x = Eval(x, a);
|
||||
|
|
@ -365,16 +413,13 @@ main(argc, argv)
|
|||
// JavaScript Specific Code for https://justine.lol/
|
||||
|
||||
var a, code, index, output, funcall, M, Null;
|
||||
var eInput, eOutput, eEval, eReset, eLoad, eTrace, ePrograms;
|
||||
var eOutput, eEval, eReset, eLoad, eTrace, ePrograms, eDump;
|
||||
var eGets, eSets, eMs, eAtoms, eCode, eHeap, eReads, eWrites, eClear;
|
||||
|
||||
function Throw(x) {
|
||||
throw x;
|
||||
}
|
||||
|
||||
function Ord(s) {
|
||||
return s.charCodeAt(0);
|
||||
}
|
||||
|
||||
function Reset() {
|
||||
var i;
|
||||
a = 0;
|
||||
|
|
@ -382,41 +427,91 @@ function Reset() {
|
|||
cHeap = 0;
|
||||
cGets = 0;
|
||||
cSets = 0;
|
||||
cReads = 0;
|
||||
cPrints = 0;
|
||||
Null = 16384;
|
||||
M = new Array(Null * 2);
|
||||
for (i = 0; i < M.length; ++i) {
|
||||
M[i] = 0; /* make json smaller */
|
||||
}
|
||||
// for (i = 0; i < M.length; ++i) {
|
||||
// M[i] = 0; /* make json smaller */
|
||||
// }
|
||||
Load("NIL T EQ CAR CDR ATOM COND CONS QUOTE DEFINE ");
|
||||
LoadBuiltins()
|
||||
}
|
||||
|
||||
function PrintChar(c) {
|
||||
function PrintU16(c) {
|
||||
output += String.fromCharCode(c);
|
||||
}
|
||||
|
||||
function ReadChar() {
|
||||
var ax;
|
||||
if (code.length) {
|
||||
ax = dx;
|
||||
if (index < code.length) {
|
||||
dx = code.charCodeAt(index++);
|
||||
} else {
|
||||
code = "";
|
||||
dx = 0;
|
||||
}
|
||||
return ax;
|
||||
function IsHighSurrogate(c) {
|
||||
return (0xfc00 & c) == 0xd800;
|
||||
}
|
||||
|
||||
function IsLowSurrogate(c) {
|
||||
return (0xfc00 & c) == 0xdc00;
|
||||
}
|
||||
|
||||
function GetHighSurrogate(c) {
|
||||
return ((c - 0x10000) >> 10) + 0xD800;
|
||||
}
|
||||
|
||||
function GetLowSurrogate(c) {
|
||||
return ((c - 0x10000) & 1023) + 0xDC00;
|
||||
}
|
||||
|
||||
function ComposeUtf16(c, d) {
|
||||
return ((c - 0xD800) << 10) + (d - 0xDC00) + 0x10000;
|
||||
}
|
||||
|
||||
function PrintChar(c) {
|
||||
if (c < 0x10000) {
|
||||
PrintU16(c);
|
||||
} else if (c < 0x110000) {
|
||||
PrintU16(GetHighSurrogate(c));
|
||||
PrintU16(GetLowSurrogate(c));
|
||||
} else {
|
||||
Throw(0);
|
||||
PrintU16(0xFFFD);
|
||||
}
|
||||
}
|
||||
|
||||
function GetMillis() {
|
||||
if (typeof performance != "undefined") {
|
||||
return performance.now();
|
||||
function Ord(s) {
|
||||
var c, d;
|
||||
c = s.charCodeAt(0);
|
||||
if (IsHighSurrogate(c)) {
|
||||
if (code.length > 1 && IsLowSurrogate((d = s.charCodeAt(1)))) {
|
||||
c = ComposeUtf16(c, d);
|
||||
} else {
|
||||
c = 0xFFFD;
|
||||
}
|
||||
} else if (IsLowSurrogate(c)) {
|
||||
c = 0xFFFD;
|
||||
}
|
||||
return c;
|
||||
}
|
||||
|
||||
function ReadChar() {
|
||||
var c, d, t;
|
||||
if (code.length) {
|
||||
if (index < code.length) {
|
||||
c = code.charCodeAt(index++);
|
||||
if (IsHighSurrogate(c)) {
|
||||
if (index < code.length &&
|
||||
IsLowSurrogate((d = code.charCodeAt(index)))) {
|
||||
c = ComposeUtf16(c, d), ++index;
|
||||
} else {
|
||||
c = 0xFFFD;
|
||||
}
|
||||
} else if (IsLowSurrogate(c)) {
|
||||
c = 0xFFFD;
|
||||
}
|
||||
} else {
|
||||
code = "";
|
||||
c = 0;
|
||||
}
|
||||
t = dx;
|
||||
dx = c;
|
||||
return t;
|
||||
} else {
|
||||
return 0;
|
||||
Throw(0);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -426,22 +521,22 @@ function Lisp() {
|
|||
cGets = 0;
|
||||
cSets = 0;
|
||||
cHeap = cx;
|
||||
cReads = 0;
|
||||
cPrints = 0;
|
||||
output = "";
|
||||
while (dx) {
|
||||
if (dx <= Ord(' ')) {
|
||||
ReadChar();
|
||||
} else {
|
||||
t = GetMillis();
|
||||
A = cx;
|
||||
try {
|
||||
x = Read();
|
||||
if (x < 0 && Car(x) == kDefine) {
|
||||
a = Define(0, Cdr(x), a);
|
||||
a = Define(Cdr(x), a);
|
||||
continue;
|
||||
}
|
||||
t = GetMillis();
|
||||
x = Eval(x, a);
|
||||
d += GetMillis() - t;
|
||||
} catch (z) {
|
||||
PrintChar(Ord('?'));
|
||||
x = z;
|
||||
|
|
@ -449,45 +544,69 @@ function Lisp() {
|
|||
Print(x);
|
||||
PrintChar(Ord('\n'));
|
||||
Gc(A, 0);
|
||||
d += GetMillis() - t;
|
||||
}
|
||||
}
|
||||
eOutput.innerText = output;
|
||||
SaveMachine(a);
|
||||
SaveAlist(a);
|
||||
SaveOutput();
|
||||
ReportUsage(d);
|
||||
}
|
||||
|
||||
function Load(s) {
|
||||
index = 0;
|
||||
dx = Ord(' ');
|
||||
code = s + "\n";
|
||||
dx = Ord(s);
|
||||
index = 1;
|
||||
}
|
||||
|
||||
function OnEval() {
|
||||
Load(eInput.value.toUpperCase());
|
||||
Load(g_editor.getValue());
|
||||
Lisp();
|
||||
SetStorage("input", g_editor.getValue());
|
||||
}
|
||||
|
||||
function OnReset() {
|
||||
function OnBeforeUnload() {
|
||||
SetStorage("input", g_editor.getValue());
|
||||
}
|
||||
|
||||
function OnDump() {
|
||||
var t;
|
||||
output = "";
|
||||
t = GetMillis();
|
||||
DumpDefines(a);
|
||||
eOutput.innerText = output;
|
||||
t = GetMillis() - t;
|
||||
SaveOutput();
|
||||
ReportUsage(t);
|
||||
}
|
||||
|
||||
function OnReset(e) {
|
||||
var t;
|
||||
output = "";
|
||||
t = GetMillis();
|
||||
try {
|
||||
Dump(a);
|
||||
if (!e.shiftKey) DumpDefines(a);
|
||||
eOutput.innerText = output;
|
||||
Reset();
|
||||
} catch (e) {
|
||||
/* ignored */
|
||||
}
|
||||
t = GetMillis() - t;
|
||||
localStorage.removeItem("sectorlisp.machine");
|
||||
RemoveStorage("alist");
|
||||
SaveOutput();
|
||||
ReportUsage(t);
|
||||
}
|
||||
|
||||
function OnClear() {
|
||||
output = "";
|
||||
eOutput.innerText = output;
|
||||
SaveOutput();
|
||||
ReportUsage(0);
|
||||
}
|
||||
|
||||
function OnTrace() {
|
||||
var t;
|
||||
Load(eInput.value);
|
||||
Load(g_editor.getValue());
|
||||
t = panic;
|
||||
depth = 0;
|
||||
panic = 10000;
|
||||
|
|
@ -498,39 +617,54 @@ function OnTrace() {
|
|||
}
|
||||
|
||||
function OnLoad() {
|
||||
ePrograms.classList.toggle("show");
|
||||
}
|
||||
|
||||
function OnWindowClick(event) {
|
||||
if (!event.target.matches("#load")) {
|
||||
ePrograms.classList.remove("show");
|
||||
if (ePrograms.className == "dropdown-content") {
|
||||
ePrograms.className = "dropdown-content show";
|
||||
} else {
|
||||
ePrograms.className = "dropdown-content";
|
||||
}
|
||||
}
|
||||
|
||||
function SaveMachine(a) {
|
||||
var machine;
|
||||
if (typeof localStorage != "undefined") {
|
||||
machine = [M, a, cx];
|
||||
localStorage.setItem("sectorlisp.machine", JSON.stringify(machine));
|
||||
function OnWindowClick(e) {
|
||||
if (e.target && !e.target.matches("#load")) {
|
||||
ePrograms.className = "dropdown-content";
|
||||
}
|
||||
}
|
||||
|
||||
function OnWindowKeyDown(e) {
|
||||
if (e.key == "Escape") {
|
||||
ePrograms.className = "dropdown-content";
|
||||
}
|
||||
}
|
||||
|
||||
function SaveAlist(a) {
|
||||
output = "";
|
||||
DumpAlist(a);
|
||||
SetStorage("alist", output);
|
||||
}
|
||||
|
||||
function RestoreMachine() {
|
||||
var machine;
|
||||
if (typeof localStorage != "undefined" &&
|
||||
(machine = JSON.parse(localStorage.getItem("sectorlisp.machine")))) {
|
||||
M = machine[0];
|
||||
a = machine[1];
|
||||
cx = machine[2];
|
||||
var v;
|
||||
if ((v = GetStorage("output"))) {
|
||||
eOutput.innerText = v;
|
||||
}
|
||||
if ((v = GetStorage("input"))) {
|
||||
g_editor.setValue(v);
|
||||
}
|
||||
if ((v = GetStorage("alist"))) {
|
||||
Reset();
|
||||
Load(v);
|
||||
a = Compact(Read());
|
||||
} else if ((v = JSON.parse(GetStorage("machine")))) {
|
||||
M = v[0];
|
||||
a = v[1];
|
||||
cx = v[2];
|
||||
cHeap = cx;
|
||||
}
|
||||
}
|
||||
|
||||
function SaveOutput() {
|
||||
if (typeof localStorage != "undefined") {
|
||||
localStorage.setItem("input", document.getElementById("input").value);
|
||||
localStorage.setItem("output", eOutput.innerText);
|
||||
}
|
||||
SetStorage("input", g_editor.getValue());
|
||||
SetStorage("output", eOutput.innerText);
|
||||
}
|
||||
|
||||
function FormatInt(i) {
|
||||
|
|
@ -541,19 +675,21 @@ function FormatDuration(d) {
|
|||
return d ? Math.round(d * 1000) / 1000 : 0;
|
||||
}
|
||||
|
||||
function ReportUsage(d) {
|
||||
var i, c, s;
|
||||
for (c = i = 0; i < Null; i += 2) {
|
||||
if (M[Null + i]) ++c;
|
||||
function ReportUsage(ms) {
|
||||
var i, atom, code, heap;
|
||||
code = -cx >> 1;
|
||||
heap = -cHeap >> 1;
|
||||
for (atom = i = 0; i < Null / 2; ++i) {
|
||||
if (M[Null + i]) ++atom;
|
||||
}
|
||||
document.getElementById("ops").innerText =
|
||||
FormatInt(cGets) + " gets / " +
|
||||
FormatInt(cSets) + " sets / " +
|
||||
FormatDuration(d) + " ms";
|
||||
document.getElementById("mem").innerText =
|
||||
FormatInt((-cx >> 1) + c) + " / " +
|
||||
FormatInt((-cHeap >> 1) + c) + " / " +
|
||||
FormatInt(Null) + " doublewords";
|
||||
if (eGets) eGets.innerText = FormatInt(cGets);
|
||||
if (eSets) eSets.innerText = FormatInt(cSets);
|
||||
if (eMs) eMs.innerText = FormatInt(ms);
|
||||
if (eAtoms) eAtoms.innerText = FormatInt(atom);
|
||||
if (eCode) eCode.innerText = FormatInt(code);
|
||||
if (eHeap) eHeap.innerText = FormatInt(heap - code);
|
||||
if (eReads) eReads.innerText = FormatInt(cReads);
|
||||
if (ePrints) ePrints.innerText = FormatInt(cPrints);
|
||||
}
|
||||
|
||||
function Discount(f) {
|
||||
|
|
@ -570,30 +706,66 @@ function Discount(f) {
|
|||
};
|
||||
}
|
||||
|
||||
function GetMillis() {
|
||||
if (typeof performance != "undefined") {
|
||||
return performance.now();
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
function GetStorage(k) {
|
||||
if (typeof localStorage != "undefined") {
|
||||
return localStorage.getItem(g_lisp + "." + k);
|
||||
} else {
|
||||
return null;
|
||||
}
|
||||
}
|
||||
|
||||
function RemoveStorage(k) {
|
||||
if (typeof localStorage != "undefined") {
|
||||
localStorage.removeItem(g_lisp + "." + k);
|
||||
}
|
||||
}
|
||||
|
||||
function SetStorage(k, v) {
|
||||
if (typeof localStorage != "undefined") {
|
||||
localStorage.setItem(g_lisp + "." + k, v);
|
||||
}
|
||||
}
|
||||
|
||||
function SetUp() {
|
||||
funcall = Funcall;
|
||||
Read = Discount(Read);
|
||||
Print = Discount(Print);
|
||||
Define = Discount(Define);
|
||||
eLoad = document.getElementById("load");
|
||||
eInput = document.getElementById("input");
|
||||
eReset = document.getElementById("reset");
|
||||
eTrace = document.getElementById("trace");
|
||||
eOutput = document.getElementById("output");
|
||||
eEval = document.getElementById("eval");
|
||||
eClear = document.getElementById("clear");
|
||||
eDump = document.getElementById("dump");
|
||||
ePrograms = document.getElementById("programs");
|
||||
window.onclick = OnWindowClick;
|
||||
eLoad.onclick = OnLoad;
|
||||
eReset.onclick = OnReset;
|
||||
eTrace.onclick = OnTrace;
|
||||
eEval.onclick = OnEval;
|
||||
Reset();
|
||||
RestoreMachine();
|
||||
ReportUsage();
|
||||
eGets = document.getElementById("cGets");
|
||||
eSets = document.getElementById("cSets");
|
||||
eMs = document.getElementById("cMs");
|
||||
eAtoms = document.getElementById("cAtoms");
|
||||
eCode = document.getElementById("cCode");
|
||||
eHeap = document.getElementById("cHeap");
|
||||
eReads = document.getElementById("cReads");
|
||||
ePrints = document.getElementById("cPrints");
|
||||
window.onkeydown = OnWindowKeyDown;
|
||||
if (window.onbeforeunload) window.onbeforeunload = OnBeforeUnload;
|
||||
if (ePrograms) window.onclick = OnWindowClick;
|
||||
if (eLoad) eLoad.onclick = OnLoad;
|
||||
if (eReset) eReset.onclick = OnReset;
|
||||
if (eTrace) eTrace.onclick = OnTrace;
|
||||
if (eEval) eEval.onclick = OnEval;
|
||||
if (eDump) eDump.onclick = OnDump;
|
||||
if (eClear) eClear.onclick = OnClear;
|
||||
}
|
||||
|
||||
SetUp();
|
||||
|
||||
//
`
|
||||
#endif
|
||||
//`
|
||||
|
|
|
|||
Loading…
Reference in a new issue