mirrors/cosmopolitan
1
0
Fork 0
mirror of https://github.com/jart/cosmopolitan.git synced 2025-07-27 21:10:29 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Make terminal ui binaries work well everywhere

Browse source 
Here's some screenshots of an emulator tui program that was compiled on
Linux, then scp'd it to Windows, Mac, and FreeBSD.

https://justine.storage.googleapis.com/blinkenlights-cmdexe.png
https://justine.storage.googleapis.com/blinkenlights-imac.png
https://justine.storage.googleapis.com/blinkenlights-freebsd.png
https://justine.storage.googleapis.com/blinkenlights-lisp.png

How is this even possible that we have a nontrivial ui binary that just
works on Mac, Windows, Linux, and BSD? Surely a first ever achievement.

Fixed many bugs. Bootstrapped John McCarthy's metacircular evaluator on
bare metal in half the size of Altair BASIC (about 2.5kb) and ran it in
emulator for fun and profit.
This commit is contained in:
Justine Tunney 2020-10-10 21:18:53 -07:00
parent 680daf1210
commit 9e3e985ae5
276 changed files with 7026 additions and 3790 deletions
Download patch file Download diff file Expand all files Collapse all files

10
tool/build/emubin/emubin.mk
View file

@ -11,7 +11,8 @@ TOOL_BUILD_EMUBIN_BINS = \
o/$(MODE)/tool/build/emubin/prime.bin \
o/$(MODE)/tool/build/emubin/prime.bin.dbg \
o/$(MODE)/tool/build/emubin/pi.bin \
o/$(MODE)/tool/build/emubin/pi.bin.dbg
o/$(MODE)/tool/build/emubin/pi.bin.dbg \
o/$(MODE)/tool/build/emubin/linmap.elf
TOOL_BUILD_EMUBIN_A = o/$(MODE)/tool/build/emubin/emubin.a
TOOL_BUILD_EMUBIN_FILES := $(wildcard tool/build/emubin/*)
@ -50,6 +51,13 @@ o/$(MODE)/tool/build/emubin/%.bin.dbg: \
$(TOOL_BUILD_EMUBIN_A).pkg
@$(ELFLINK) -e emucrt -z max-page-size=0x10
o/$(MODE)/tool/build/emubin/%.elf: \
$(TOOL_BUILD_EMUBIN_DEPS) \
$(TOOL_BUILD_EMUBIN_A) \
o/$(MODE)/tool/build/emubin/%.o \
$(ELF)
@$(ELFLINK)
o/dbg/tool/build/emubin/lisp.real.com.dbg: \
$(TOOL_BUILD_EMUBIN_DEPS) \
$(TOOL_BUILD_EMUBIN_A) \

32
tool/build/emubin/linmap.c Normal file
View file

@ -0,0 +1,32 @@
/*-*- 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 │
│ │
│ This program is free software; you can redistribute it and/or modify │
│ it under the terms of the GNU General Public License as published by │
│ the Free Software Foundation; version 2 of the License. │
│ │
│ This program is distributed in the hope that it will be useful, but │
│ WITHOUT ANY WARRANTY; without even the implied warranty of │
│ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU │
│ General Public License for more details. │
│ │
│ You should have received a copy of the GNU General Public License │
│ along with this program; if not, write to the Free Software │
│ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA │
│ 02110-1301 USA │
╚─────────────────────────────────────────────────────────────────────────────*/
#include "libc/linux/exit.h"
#include "libc/linux/fstat.h"
#include "libc/linux/mmap.h"
#include "libc/linux/open.h"
struct stat st;
void _start(void) {
long fd = LinuxOpen("/etc/passwd", 0, 0);
LinuxFstat(fd, &st);
LinuxMmap((void *)0x000000000000, st.st_size, 1, 2, fd, 0);
LinuxExit(0);
}

583
tool/build/emubin/lisp.c
View file

@ -16,237 +16,20 @@
│ TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR │
│ PERFORMANCE OF THIS SOFTWARE. │
╚─────────────────────────────────────────────────────────────────────────────*/
#include "tool/build/emubin/lisp.h"
#define TRACE 0
#define ERRORS 1
#define LONG long
#define WORD short
#define WORDS 8192
#define TRACE 0 // print eval input output
#define RETRO 1 // auto capitalize input
#define ERRORS 1 // print messages or undefined behavior
#define DELETE 1 // allow backspace to rub out symbol
#define QUOTES 1 // allow 'X shorthand (QUOTE X)
#define MUTABLE 0 // allow setting globals
#define PROMPT 1 // show repl prompt
#define WORD short
#define WORDS 8192
/*───────────────────────────────────────────────────────────────────────────│─╗
│ The LISP Challenge § Impure x86_64 Linux 8086 PC BIOS System Integration ─╬─│┼
╚────────────────────────────────────────────────────────────────────────────│*/
#define TYPE(x) /* a.k.a. x&1 */ \
({ \
char IsAtom; \
asm("test%z1\t$1,%1" : "=@ccnz"(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; \
})
#define REAL_READ_(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; \
})
/* #ifdef __REAL_MODE__ */
#define REAL_READ(BASE, INDEX, DISP) /* a.k.a. b[i] */ \
(sizeof(*(BASE)) == 1 ? REAL_READ_("=Q", BASE, INDEX, DISP) \
: REAL_READ_("=r", BASE, INDEX, DISP))
/* #else */
/* #define REAL_READ(BASE, INDEX, DISP) BASE[INDEX + DISP] */
/* #endif */
#define REAL_READ_ARRAY_FIELD_(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; \
})
/* #ifdef __REAL_MODE__ */
#define REAL_READ_ARRAY_FIELD(OBJECT, MEMBER, INDEX, DISP) /* o->m[i] */ \
(sizeof(*(OBJECT->MEMBER)) == 1 \
? REAL_READ_ARRAY_FIELD_("=Q", OBJECT, MEMBER, INDEX, DISP) \
: REAL_READ_ARRAY_FIELD_("=r", OBJECT, MEMBER, INDEX, DISP))
/* #else */
/* #define REAL_READ_ARRAY_FIELD(o, m, i, d) o->m[i + d] */
/* #endif */
#define REAL_WRITE_ARRAY_FIELD_(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)
/* #ifdef __REAL_MODE__ */
#define REAL_WRITE_ARRAY_FIELD(OBJECT, MEMBER, INDEX, DISP, VALUE) \
do { \
__typeof(*(OBJECT->MEMBER)) Reg; \
switch (sizeof(*(OBJECT->MEMBER))) { \
case 1: \
REAL_WRITE_ARRAY_FIELD_("Q", OBJECT, MEMBER, INDEX, DISP, VALUE); \
break; \
default: \
REAL_WRITE_ARRAY_FIELD_("ri", OBJECT, MEMBER, INDEX, DISP, VALUE); \
break; \
} \
} while (0)
/* #else */
/* #define REAL_WRITE_ARRAY_FIELD(o, m, i, d, v) o->m[i + d] = v */
/* #endif */
long jb[8];
int setjmp(void *) __attribute__((__returns_twice__));
int longjmp(void *, int) __attribute__((__noreturn__));
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, 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__
int rc;
int c[14];
asm volatile("syscall"
: "=a"(rc)
: "0"(0x10), "D"(0), "S"(0x5401), "d"(c)
: "rcx", "r11", "memory");
c[0] &= ~0b0000010111111000; // INPCK|ISTRIP|PARMRK|INLCR|IGNCR|ICRNL|IXON
c[2] &= ~0b0000000100110000; // CSIZE|PARENB
c[2] |= 0b00000000000110000; // CS8
c[3] &= ~0b1000000001011010; // ECHONL|ECHO|ECHOE|IEXTEN|ICANON
asm volatile("syscall"
: "=a"(rc)
: "0"(0x10), "D"(0), "S"(0x5402), "d"(c)
: "rcx", "r11", "memory");
#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;
asm volatile("syscall"
: "=a"(rc)
: "0"(1), "D"(1), "S"(&buf), "d"(1)
: "rcx", "r11", "memory");
#endif
}
static void PrintString(char *s) {
char c;
for (;;) {
if (!(c = REAL_READ(s, 0, 0))) break;
PrintChar(c);
++s;
}
}
static int XlatChar(LONG c) {
if (c == 0x7F) return '\b';
if (c >= 'a') {
asm volatile("" ::: "memory");
if (c <= 'z') c -= 'a' - 'A';
}
return c;
}
static int EchoChar(LONG c) {
if (c != '\b') {
PrintChar(c);
if (c == '\r') {
PrintChar('\n');
}
}
return c;
}
__attribute__((__noinline__)) static noinline int ReadChar(void) {
int c;
#ifdef __REAL_MODE__
asm volatile("int\t$0x16" : "=a"(c) : "0"(0) : "memory");
#else
static int buf;
asm volatile("syscall"
: "=a"(c)
: "0"(0), "D"(0), "S"(&buf), "d"(1)
: "rcx", "r11", "memory");
c = buf;
#endif
return EchoChar(XlatChar(c));
}
/*───────────────────────────────────────────────────────────────────────────│─╗
│ The LISP Challenge § Pure Original LISP Machine ─╬─│┼
│ The LISP Challenge § LISP Machine ─╬─│┼
╚────────────────────────────────────────────────────────────────────────────│*/
#define ATOM 0
@ -261,10 +44,8 @@ __attribute__((__noinline__)) static noinline int ReadChar(void) {
#define ATOM_CAR 50
#define ATOM_CDR 58
#define ATOM_CONS 66
#define ATOM_LABEL 76
#define ATOM_LAMBDA 88
#define ATOM_SET 102
#define ATOM_DEFUN 110
#define ATOM_LAMBDA 76
#define ATOM_SET 90
#define Quote(x) List(ATOM_QUOTE, x)
#define List(x, y) Cons(x, Cons(y, NIL))
@ -279,9 +60,6 @@ __attribute__((__noinline__)) static noinline int ReadChar(void) {
#define VALUE(x) ((x) >> 1)
#define PTR(i) ((i) << 1 | CONS)
#define ARRAYLEN(A) \
((sizeof(A) / sizeof(*(A))) / ((unsigned)!(sizeof(A) % sizeof(*(A)))))
struct Lisp {
WORD mem[WORDS];
unsigned char syntax[256];
@ -289,25 +67,24 @@ struct Lisp {
WORD globals;
WORD index;
char token[128];
long jb[8];
char str[WORDS];
};
_Static_assert(sizeof(struct Lisp) <= 0x7c00 - 0x600,
"LISP Machine too large for real mode");
_Alignas(char) const char kSymbols[] = "\
NIL\0T\0QUOTE\0ATOM\0EQ\0COND\0CAR\0CDR\0CONS\0LABEL\0LAMBDA\0SET\0DEFUN\0";
_Alignas(WORD) const WORD kGlobals[] = {
[0] = PTR(2), // ((T . T) (NIL . NIL))
[1] = PTR(4), //
[2] = ATOM_T, // (T . T)
[3] = ATOM_T, //
[4] = PTR(6), // ((NIL . NIL))
[5] = NIL, //
[6] = NIL, // (NIL . NIL)
[7] = NIL, //
};
_Alignas(char) const char kSymbols[] = "NIL\0"
"T\0"
"QUOTE\0"
"ATOM\0"
"EQ\0"
"COND\0"
"CAR\0"
"CDR\0"
"CONS\0"
"LAMBDA\0"
"SET\0";
#ifdef __REAL_MODE__
static struct Lisp *const q;
@ -315,56 +92,55 @@ static struct Lisp *const q;
static struct Lisp q[1];
#endif
static void Print(LONG);
static void Print(long);
static WORD GetList(void);
static WORD GetObject(void);
static void PrintObject(LONG);
static WORD Eval(LONG, LONG);
static void PrintObject(long);
static WORD Eval(long, long);
static void SetupSyntax(void) {
q->syntax[' '] = ' ';
q->syntax['\t'] = ' ';
q->syntax['\r'] = ' ';
q->syntax['\n'] = ' ';
q->syntax['('] = '(';
q->syntax[')'] = ')';
q->syntax['.'] = '.';
q->syntax['\''] = '\'';
unsigned char *syntax = q->syntax;
asm("" : "+bSD"(syntax));
syntax[' '] = ' ';
syntax['\r'] = ' ';
syntax['\n'] = ' ';
syntax['('] = '(';
syntax[')'] = ')';
syntax['.'] = '.';
#if QUOTES
syntax['\''] = '\'';
#endif
}
static inline WORD Car(LONG x) {
return REAL_READ_ARRAY_FIELD(q, mem, VALUE(x), 0);
static inline WORD Car(long x) {
return PEEK_ARRAY(q, mem, VALUE(x), 0);
}
static inline WORD Cdr(LONG x) {
return REAL_READ_ARRAY_FIELD(q, mem, VALUE(x), 1);
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) {
#if TRACE
PrintString("CONS->");
Print(car);
PrintString(" ");
Print(cdr);
#endif
int i, cell;
i = q->index;
REAL_WRITE_ARRAY_FIELD(q, mem, i, 0, car);
REAL_WRITE_ARRAY_FIELD(q, mem, i, 1, cdr);
POKE_ARRAY(q, mem, i, 0, car);
POKE_ARRAY(q, mem, i, 1, cdr);
q->index = i + 2;
cell = OBJECT(CONS, i);
#if TRACE
PrintString("CONS<-");
Print(cell);
#endif
return cell;
}
static void SetupBuiltins(void) {
CopyMemory(q->str, kSymbols, sizeof(kSymbols));
CopyMemory(q->mem, kGlobals, sizeof(kGlobals));
q->index = ARRAYLEN(kGlobals);
q->mem[0] = PTR(2);
q->globals = PTR(0);
q->index = 4;
}
static char *StpCpy(char *d, char *s) {
@ -383,7 +159,7 @@ WORD Intern(char *s) {
c = LODS(z);
while (c) {
for (j = 0;; ++j) {
if (c != REAL_READ(s, j, 0)) {
if (c != PEEK(s, j, 0)) {
break;
}
if (!c) {
@ -400,7 +176,33 @@ WORD Intern(char *s) {
}
forceinline unsigned char XlatSyntax(unsigned char b) {
return REAL_READ_ARRAY_FIELD(q, syntax, b, 0);
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) {
@ -409,20 +211,20 @@ static void GetToken(void) {
b = q->look;
t = q->token;
while (XlatSyntax(b) == ' ') {
b = ReadChar();
b = GetChar();
}
if (XlatSyntax(b)) {
STOS(t, b);
b = ReadChar();
b = GetChar();
} else {
while (b && !XlatSyntax(b)) {
if (b != '\b') {
if (!DELETE || b != '\b') {
STOS(t, b);
} else if (t > q->token) {
PrintString("\b \b");
if (t > q->token) --t;
}
b = ReadChar();
b = GetChar();
}
}
STOS(t, 0);
@ -447,12 +249,14 @@ static WORD GetList(void) {
switch (*q->token & 0xFF) {
default:
return AddList(GetObject());
case '\'':
return AddList(GetQuote());
case ')':
return NIL;
case '.':
return ConsumeObject();
#if QUOTES
case '\'':
return AddList(GetQuote());
#endif
}
}
@ -460,15 +264,17 @@ static WORD GetObject(void) {
switch (*q->token & 0xFF) {
default:
return Intern(q->token);
case '\'':
return GetQuote();
case '(':
return GetList();
#if QUOTES
case '\'':
return GetQuote();
#endif
}
}
static WORD ReadObject(void) {
q->look = ReadChar();
q->look = GetChar();
GetToken();
return GetObject();
}
@ -477,11 +283,18 @@ static WORD Read(void) {
return ReadObject();
}
static void PrintAtom(LONG x) {
static void PrintAtom(long x) {
PrintString(q->str + VALUE(x));
}
static void PrintList(LONG 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))) {
@ -491,12 +304,13 @@ static void PrintList(LONG x) {
} else {
PrintString(" . ");
PrintObject(x);
break;
}
}
PrintChar(')');
}
static void PrintObject(LONG x) {
static void PrintObject(long x) {
if (TYPE(x) == ATOM) {
PrintAtom(x);
} else {
@ -504,19 +318,13 @@ static void PrintObject(LONG x) {
}
}
static void Print(LONG i) {
static void Print(long i) {
PrintObject(i);
PrintString("\r\n");
}
__attribute__((__noreturn__)) static void Reset(void) {
longjmp(jb, 1);
}
__attribute__((__noreturn__)) static void OnUndefined(LONG x) {
PrintString("UNDEF! ");
Print(x);
Reset();
longjmp(q->jb, 1);
}
__attribute__((__noreturn__)) static void OnArity(void) {
@ -524,145 +332,69 @@ __attribute__((__noreturn__)) static void OnArity(void) {
Reset();
}
__attribute__((__noreturn__)) static void OnUndefined(long x) {
PrintString("UNDEF! ");
Print(x);
Reset();
}
#if !ERRORS
#define OnUndefined(x) __builtin_unreachable()
#define OnArity() __builtin_unreachable()
#define OnUndefined(x) __builtin_unreachable()
#endif
/*───────────────────────────────────────────────────────────────────────────│─╗
│ The LISP Challenge § Bootstrap John McCarthy's Metacircular Evaluator ─╬─│┼
╚────────────────────────────────────────────────────────────────────────────│*/
static WORD Atom(LONG x) {
static WORD Atom(long x) {
return BOOL(TYPE(x) == ATOM);
}
static WORD Null(LONG x) {
static WORD Null(long x) {
return BOOL(!x);
}
static WORD Eq(LONG x, LONG y) {
return BOOL(x == y); /* undefined if !Atom(x)||!Atom(y) */
static WORD Eq(long x, long y) {
return BOOL(x == y);
}
static WORD Assoc(LONG x, LONG y) {
if (Null(y)) OnUndefined(x);
if (Eq(Caar(y), x)) return Cdar(y);
return Assoc(x, Cdr(y));
static WORD Arg1(long e, long a) {
return Eval(Cadr(e), a);
}
static WORD Append(LONG x, LONG y) {
#if TRACE
PrintString("APPEND->");
Print(x);
PrintString(" ");
Print(y);
#endif
if (!Null(x)) {
x = Cons(Car(x), Append(Cdr(x), y));
} else {
x = y;
}
#if TRACE
PrintString("APPEND<-");
Print(x);
#endif
return x;
static WORD Arg2(long e, long a) {
return Eval(Caddr(e), a);
}
/**
* Gives list of pairs of corresponding elements of the lists x and y.
* E.g. pair[(A,B,C);(X,(Y,Z),U)] = ((A.X),(B.(Y,Z)),(C.U))
* @note recoded to make lists in dot notation
* @note it's zip() basically
*/
static WORD Pair_(LONG x, LONG y) {
static WORD Append(long x, long y) {
return Null(x) ? y : Cons(Car(x), Append(Cdr(x), y));
}
static WORD Evcon(long c, long a) {
return Eval(Caar(c), a) ? Eval(Cadar(c), a) : Evcon(Cdr(c), a);
}
static WORD Evlis(long m, long a) {
return m ? Cons(Eval(Car(m), a), Evlis(Cdr(m), a)) : NIL;
}
static WORD Assoc(long x, long y) {
if (!y) OnUndefined(x);
return Eq(Caar(y), x) ? Cdar(y) : Assoc(x, Cdr(y));
}
static WORD Pair(long x, long y) {
if (Null(x) && Null(y)) {
return NIL;
} else if (TYPE(x) == CONS && TYPE(y) == CONS) {
return Cons(Cons(Car(x), Car(y)), Pair_(Cdr(x), Cdr(y)));
} else if (!Atom(x) && !Atom(y)) {
return Cons(Cons(Car(x), Car(y)), Pair(Cdr(x), Cdr(y)));
} else {
OnArity();
}
}
static WORD Pair(LONG x, LONG y) {
#if TRACE
PrintString("PAIR->");
Print(x);
PrintString(" ");
Print(y);
#endif
x = Pair_(x, y);
#if TRACE
PrintString("PAIR<-");
Print(x);
#endif
return x;
}
static WORD Appq(long m) {
if (m) {
return Cons(List(ATOM_QUOTE, Car(m)), Appq(Cdr(m)));
} else {
return NIL;
}
}
static WORD Apply(long f, long a) {
return Eval(Cons(f, Appq(a)), NIL);
}
static WORD Evcon(LONG c, LONG a) {
if (Eval(Caar(c), a)) {
return Eval(Cadar(c), a);
} else {
return Evcon(Cdr(c), a);
}
}
static WORD Evlis_(LONG m, LONG a) {
if (m) {
return Cons(Eval(Car(m), a), Evlis_(Cdr(m), a));
} else {
return NIL;
}
}
static WORD Evlis(LONG m, LONG a) {
#if TRACE
PrintString("EVLIS->");
Print(m);
PrintString(" ");
Print(a);
#endif
m = Evlis_(m, a);
#if TRACE
PrintString("EVLIS<-");
Print(m);
#endif
return m;
}
static WORD Set(LONG e) {
WORD name, value;
name = Car(e);
value = Cadr(e);
q->globals = Cons(Cons(name, value), q->globals);
return value;
}
static WORD Defun(LONG e) {
WORD name, args, body, lamb;
name = Car(e);
args = Cadr(e);
body = Caddr(e);
lamb = Cons(ATOM_LAMBDA, List(args, body));
q->globals = Cons(Cons(name, lamb), q->globals);
return name;
}
static WORD Evaluate(LONG e, LONG a) {
static WORD Evaluate(long e, long a) {
if (Atom(e)) {
return Assoc(e, a);
} else if (Atom(Car(e))) {
@ -670,26 +402,24 @@ static WORD Evaluate(LONG e, LONG a) {
case ATOM_QUOTE:
return Cadr(e);
case ATOM_ATOM:
return Atom(Eval(Cadr(e), a));
return Atom(Arg1(e, a));
case ATOM_EQ:
return Eq(Eval(Cadr(e), a), Eval(Caddr(e), a));
return Eq(Arg1(e, a), Arg2(e, a));
case ATOM_COND:
return Evcon(Cdr(e), a);
case ATOM_CAR:
return Car(Eval(Cadr(e), a));
return Car(Arg1(e, a));
case ATOM_CDR:
return Cdr(Eval(Cadr(e), a));
return Cdr(Arg1(e, a));
case ATOM_CONS:
return Cons(Eval(Cadr(e), a), Eval(Caddr(e), a));
case ATOM_DEFUN:
return Defun(Cdr(e));
return Cons(Arg1(e, a), Arg2(e, a));
#if MUTABLE
case ATOM_SET:
return Set(Cdr(e));
return Cdar(Set(a, Cons(Arg1(e, a), Arg2(e, a)), Cons(Car(a), Cdr(a))));
#endif
default:
return Eval(Cons(Assoc(Car(e), a), Evlis(Cdr(e), a)), a);
}
} else if (Eq(Caar(e), ATOM_LABEL)) {
return Eval(Cons(Caddar(e), Cdr(e)), Cons(Cons(Cadar(e), Car(e)), a));
} else if (Eq(Caar(e), ATOM_LAMBDA)) {
return Eval(Caddar(e), Append(Pair(Cadar(e), Evlis(Cdr(e), a)), a));
} else {
@ -697,7 +427,8 @@ static WORD Evaluate(LONG e, LONG a) {
}
}
static WORD Eval(LONG e, LONG a) {
static WORD Eval(long e, long a) {
WORD r;
#if TRACE
PrintString("->");
Print(e);
@ -717,9 +448,13 @@ static WORD Eval(LONG e, LONG a) {
╚────────────────────────────────────────────────────────────────────────────│*/
void Repl(void) {
setjmp(jb);
#if ERRORS
setjmp(q->jb);
#endif
for (;;) {
#if PROMPT
PrintString("* ");
#endif
Print(Eval(Read(), q->globals));
}
}
@ -728,8 +463,10 @@ 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;
}

182
tool/build/emubin/lisp.h Normal file
View file

@ -0,0 +1,182 @@
/*───────────────────────────────────────────────────────────────────────────│─╗
│ The LISP Challenge § Hardware Integration w/ x86_64 Linux & 8086 PC BIOS ─╬─│┼
╚────────────────────────────────────────────────────────────────────────────│*/
#define CompilerBarrier() asm volatile("" ::: "memory");
#define TYPE(x) /* a.k.a. x&1 */ \
({ \
char IsAtom; \
asm("test%z1\t$1,%1" : "=@ccnz"(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; \
})
#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)
int setjmp(void *) __attribute__((__returns_twice__));
int longjmp(void *, int) __attribute__((__noreturn__));
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, 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__
int rc;
int c[14];
asm volatile("syscall"
: "=a"(rc)
: "0"(0x10), "D"(0), "S"(0x5401), "d"(c)
: "rcx", "r11", "memory");
c[0] &= ~0b0000010111111000; // INPCK|ISTRIP|PARMRK|INLCR|IGNCR|ICRNL|IXON
c[2] &= ~0b0000000100110000; // CSIZE|PARENB
c[2] |= 0b00000000000110000; // CS8
c[3] &= ~0b1000000001011010; // ECHONL|ECHO|ECHOE|IEXTEN|ICANON
asm volatile("syscall"
: "=a"(rc)
: "0"(0x10), "D"(0), "S"(0x5402), "d"(c)
: "rcx", "r11", "memory");
#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;
asm volatile("syscall"
: "=a"(rc)
: "0"(1), "D"(1), "S"(&buf), "d"(1)
: "rcx", "r11", "memory");
#endif
}
static int ReadChar(void) {
int c;
#ifdef __REAL_MODE__
asm volatile("int\t$0x16" : "=a"(c) : "0"(0) : "memory");
#else
static int buf;
asm volatile("syscall"
: "=a"(c)
: "0"(0), "D"(0), "S"(&buf), "d"(1)
: "rcx", "r11", "memory");
c = buf;
#endif
return c;
}

3
tool/build/emubin/lisp.lds
View file

@ -23,12 +23,13 @@ ENTRY(_start)
SECTIONS {
.text 0x7c00 - 0x600 : {
*(.start)
*(.start .start.*)
rodata = .;
*(.rodata .rodata.*)
. = 0x1fe;
SHORT(0xaa55);
*(.text .text.*)
BYTE(0x90);
_etext = .;
. = ALIGN(512);
}

40
tool/build/emubin/lisp.lisp
View file

@ -1,12 +1,30 @@
(DEFUN FF (X)
(COND ((ATOM X) X)
((QUOTE T) (FF (CAR X)))))
(FF '(A B C))
;; (SET 'APPLY '(LAMBDA (E ARGS)
;; ((LAMBDA (APPQ)
;; (CONS ))
;; '(LAMBDA (M)
;; (COND ((EQ M 'NIL) 'NIL)
;; ('T (CONS (QUOTE (CAR M))
;; (APPQ (CONS 'QUOTE (CDR M))))))))))
;; (SET 'LIST '(LAMBDA (X Y) (CONS X (CONS Y 'NIL))))
;; (SET 'AND '(LAMBDA (P Q) (COND ((EQ P 'T) Q) ('T 'F))))
;; (SET 'OR '(LAMBDA (P Q) (COND ((EQ P 'T) 'T) ('T Q))))
;; (SET 'NOT '(LAMBDA (P) (COND ((EQ P 'F) 'T) ('T 'T))))
;; (SET 'IMPLIES '(LAMBDA (P Q) (COND ((EQ P 'T) Q) ('T 'T))))
((LABEL FF
(LAMBDA (X)
(COND ((ATOM X)
X)
((QUOTE T)
(FF (CAR X))))))
(QUOTE ((A B) C)))
((LAMBDA (CALL MKQUOT NULL AND APPEND KEYS VALS E A)
(CALL (CONS (CONS (QUOTE LAMBDA) (CONS (KEYS (QUOTE A)) (CONS E NIL))) (VALS (QUOTE A)))))
(QUOTE (LAMBDA (X) (X)))
(QUOTE (LAMBDA (X) (CONS (QUOTE QUOTE) (CONS X NIL))))
(QUOTE (LAMBDA (P Q) (COND ((EQ P (QUOTE T)) Q) ((QUOTE T) (QUOTE F)))))
(QUOTE (LAMBDA (X) (AND (QUOTE (ATOM X)) (QUOTE (EQ X NIL)))))
(QUOTE (LAMBDA (X Y) (COND ((EQ X NIL) Y) ((QUOTE T) (CONS (CAR X) (APPEND (QUOTE (CDR X)) (QUOTE Y)))))))
(QUOTE (LAMBDA (A) (COND ((EQ A NIL) NIL) ((QUOTE T) (CONS (CAR (CAR A)) (KEYS (QUOTE (CDR A))))))))
(QUOTE (LAMBDA (A) (COND ((EQ A NIL) NIL) ((QUOTE T) (CONS (MKQUOT (QUOTE (CDR (CAR A)))) (VALS (QUOTE (CDR A))))))))
(QUOTE (AND (QUOTE A) (QUOTE C)))
(CONS (CONS (QUOTE A) (QUOTE B)) (CONS (CONS (QUOTE C) (QUOTE D)) NIL)))
((LAMBDA (FF X) (FF 'X))
'(LAMBDA (X)
(COND ((ATOM X) X)
((QUOTE T) (FF '(CAR X)))))
'((A) B C))

51
tool/build/emubin/lispstart.S
View file

@ -17,11 +17,15 @@
│ Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA │
│ 02110-1301 USA │
╚─────────────────────────────────────────────────────────────────────────────*/
.code16
.section .start,"ax",@progbits
.code16
.section .start,"ax",@progbits
_start: jmp 1f
1: ljmp $0x600>>4,$_begin
.type _start,@function
.size _start,.-_start
.globl _start
_begin: push %cs
pop %ds
push %cs
@ -42,26 +46,24 @@ _begin: push %cs
mov $v_sectors+0x0200,%ax
int $0x13
xor %bp,%bp
sub $6,%sp
call main
nop
.type _start,@function
.size _start,.-_start
.globl _start
.globl v_sectors
.globl main
jmp main
.type _begin,@function
.size _begin,.-_begin
.section .start.setjmp,"ax",@progbits
setjmp: mov %sp,%ax
stosw # sp
stosw
xchg %ax,%si
movsw %ss:(%si),(%di) # ip
movsw %ss:(%si),(%di)
mov %bp,%ax
stosw # bp
ret
stosw
ret $6
.type setjmp,@function
.size setjmp,.-setjmp
.globl setjmp
.previous
.section .start.longjmp,"ax",@progbits
longjmp:
mov (%di),%sp
mov 2(%di),%dx
@ -72,23 +74,4 @@ longjmp:
.type longjmp,@function
.size longjmp,.-longjmp
.globl longjmp
.globl q.syntax
.type q.syntax,@function
.globl q.look
.type q.look,@function
.globl q.globals
.type q.globals,@function
.globl q.index
.type q.index,@function
.globl q.token
.type q.token,@function
.globl q.str
.type q.str,@function
.globl boot
.type boot,@function
.globl bss
.type bss,@function
.globl rodata
.type rodata,@function
.previous

0
tool/build/emubin/spiral.real.c → tool/build/emubin/spiral.c
View file