mirror of
https://github.com/jart/cosmopolitan.git
synced 2025-07-27 04:50:28 +00:00
Make terminal ui binaries work well everywhere
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:
parent
680daf1210
commit
9e3e985ae5
276 changed files with 7026 additions and 3790 deletions
|
@ -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
32
tool/build/emubin/linmap.c
Normal 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);
|
||||
}
|
|
@ -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
182
tool/build/emubin/lisp.h
Normal 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;
|
||||
}
|
|
@ -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);
|
||||
}
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue