mirror of
https://github.com/jart/cosmopolitan.git
synced 2025-07-08 20:28:30 +00:00
Get binaries closer to running without an o/s
blinkenlights now does a pretty good job emulating what happens when binaries boot from BIOS into long mode. So it's been much easier to debug the bare metal process and wrinkle out many issues.
This commit is contained in:
Justine Tunney
parent
feed0d2b0e
commit
2d80bbc802
50 changed files with 974 additions and 1062 deletions
|
|
@ -58,36 +58,6 @@ o/$(MODE)/tool/build/emubin/%.elf: \
|
|||
$(ELF)
|
||||
@$(ELFLINK)
|
||||
|
||||
o/$(MODE)/tool/build/emubin/lisp.elf: \
|
||||
$(TOOL_BUILD_EMUBIN_DEPS) \
|
||||
$(TOOL_BUILD_EMUBIN_A) \
|
||||
o/$(MODE)/tool/build/emubin/lisp.o \
|
||||
o/$(MODE)/tool/build/emubin/lispelf.o \
|
||||
$(ELF)
|
||||
@$(ELFLINK)
|
||||
|
||||
o/dbg/tool/build/emubin/lisp.real.com.dbg: \
|
||||
$(TOOL_BUILD_EMUBIN_DEPS) \
|
||||
$(TOOL_BUILD_EMUBIN_A) \
|
||||
o/dbg/tool/build/emubin/lisp.real.o \
|
||||
$(CRT) \
|
||||
$(APE)
|
||||
-@$(APELINK)
|
||||
|
||||
o/$(MODE)/tool/build/emubin/lisp.bin.dbg: \
|
||||
$(TOOL_BUILD_EMUBIN_DEPS) \
|
||||
o/$(MODE)/tool/build/emubin/lisp.real.o \
|
||||
o/$(MODE)/tool/build/emubin/lispstart.o \
|
||||
tool/build/emubin/lisp.lds
|
||||
@$(ELFLINK) -z max-page-size=0x10
|
||||
|
||||
o/$(MODE)/tool/build/emubin/love.bin.dbg: \
|
||||
$(TOOL_BUILD_EMUBIN_DEPS) \
|
||||
o/$(MODE)/tool/build/emubin/love.o \
|
||||
o/$(MODE)/tool/build/emubin/lispstart.o \
|
||||
tool/build/emubin/lisp.lds
|
||||
@$(ELFLINK) -z max-page-size=0x10
|
||||
|
||||
o/tiny/tool/build/emubin/spiral.bin.dbg: \
|
||||
$(TOOL_BUILD_EMUBIN_DEPS) \
|
||||
o/tiny/tool/build/emubin/spiral.real.o
|
||||
|
|
|
|||
|
|
@ -1,460 +0,0 @@
|
|||
/*-*- 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 "tool/build/emubin/lisp.h"
|
||||
|
||||
#define TRACE 0 // print eval input output
|
||||
#define RETRO 0 // auto capitalize input
|
||||
#define DELETE 0 // allow backspace to rub out symbol
|
||||
#define QUOTES 0 // allow 'X shorthand (QUOTE X)
|
||||
#define PROMPT 0 // 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) {
|
||||
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 Pair(long x, long y) {
|
||||
if (Atom(x) || Atom(y)) {
|
||||
return NIL;
|
||||
} else {
|
||||
return Cons(Cons(Car(x), Car(y)), Pair(Cdr(x), Cdr(y)));
|
||||
}
|
||||
}
|
||||
|
||||
__attribute__((__noinline__)) 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;
|
||||
}
|
||||
|
|
@ -133,7 +133,7 @@ int main() {
|
|||
SetEs(0);
|
||||
memset((void *)(0x7c00 + 512), 0, 25 * 80);
|
||||
SetEs(0xb8000 >> 4);
|
||||
memset((void *)0, 0, 25 * 80 * 2);
|
||||
/* memset((void *)0, 0, 25 * 80 * 2); */
|
||||
spiral((void *)0, (void *)(0x7c00 + 512), g);
|
||||
}
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue