mirror of
https://github.com/jart/cosmopolitan.git
synced 2025-07-02 17:28:30 +00:00
Add minor improvements and cleanup
This commit is contained in:
Justine Tunney
parent
9e3e985ae5
commit
feed0d2b0e
163 changed files with 2286 additions and 2245 deletions
|
|
@ -58,6 +58,14 @@ 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) \
|
||||
|
|
@ -73,6 +81,13 @@ o/$(MODE)/tool/build/emubin/lisp.bin.dbg: \
|
|||
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
|
||||
|
|
|
|||
|
|
@ -18,15 +18,13 @@
|
|||
╚─────────────────────────────────────────────────────────────────────────────*/
|
||||
#include "tool/build/emubin/lisp.h"
|
||||
|
||||
#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
|
||||
#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 ─╬─│┼
|
||||
|
|
@ -36,25 +34,16 @@
|
|||
#define CONS 1
|
||||
|
||||
#define NIL 0
|
||||
#define ATOM_T 8
|
||||
#define ATOM_QUOTE 12
|
||||
#define ATOM_ATOM 24
|
||||
#define ATOM_EQ 34
|
||||
#define ATOM_COND 40
|
||||
#define ATOM_CAR 50
|
||||
#define ATOM_CDR 58
|
||||
#define ATOM_CONS 66
|
||||
#define ATOM_LAMBDA 76
|
||||
#define ATOM_SET 90
|
||||
|
||||
#define Quote(x) List(ATOM_QUOTE, x)
|
||||
#define List(x, y) Cons(x, Cons(y, NIL))
|
||||
#define Caar(x) Car(Car(x)) // ((A B C D) (E F G) H I) → A
|
||||
#define Cdar(x) Cdr(Car(x)) // ((A B C D) (E F G) H I) → (B C D)
|
||||
#define Cadar(x) Cadr(Car(x)) // ((A B C D) (E F G) H I) → B
|
||||
#define Caddar(x) Caddr(Car(x)) // ((A B C D) (E F G) H I) → C
|
||||
#define Cadr(x) Car(Cdr(x)) // ((A B C D) (E F G) H I) → (E F G)
|
||||
#define Caddr(x) Cadr(Cdr(x)) // ((A B C D) (E F G) H I) → H
|
||||
#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)
|
||||
|
|
@ -67,7 +56,6 @@ struct Lisp {
|
|||
WORD globals;
|
||||
WORD index;
|
||||
char token[128];
|
||||
long jb[8];
|
||||
char str[WORDS];
|
||||
};
|
||||
|
||||
|
|
@ -75,6 +63,7 @@ _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"
|
||||
|
|
@ -83,8 +72,7 @@ _Alignas(char) const char kSymbols[] = "NIL\0"
|
|||
"CAR\0"
|
||||
"CDR\0"
|
||||
"CONS\0"
|
||||
"LAMBDA\0"
|
||||
"SET\0";
|
||||
"LAMBDA\0";
|
||||
|
||||
#ifdef __REAL_MODE__
|
||||
static struct Lisp *const q;
|
||||
|
|
@ -112,6 +100,10 @@ static void SetupSyntax(void) {
|
|||
#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);
|
||||
}
|
||||
|
|
@ -136,23 +128,16 @@ static WORD Cons(WORD car, WORD cdr) {
|
|||
return cell;
|
||||
}
|
||||
|
||||
static void SetupBuiltins(void) {
|
||||
CopyMemory(q->str, kSymbols, sizeof(kSymbols));
|
||||
q->mem[0] = PTR(2);
|
||||
q->globals = PTR(0);
|
||||
q->index = 4;
|
||||
}
|
||||
|
||||
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; */
|
||||
c = LODS(s); // a.k.a. c = *s++
|
||||
STOS(d, c); // a.k.a. *d++ = c
|
||||
} while (c);
|
||||
return d;
|
||||
}
|
||||
|
||||
WORD Intern(char *s) {
|
||||
static WORD Intern(char *s) {
|
||||
int j, cx;
|
||||
char c, *z, *t;
|
||||
z = q->str;
|
||||
|
|
@ -175,7 +160,7 @@ WORD Intern(char *s) {
|
|||
return OBJECT(ATOM, SUB((long)z, q->str));
|
||||
}
|
||||
|
||||
forceinline unsigned char XlatSyntax(unsigned char b) {
|
||||
static unsigned char XlatSyntax(unsigned char b) {
|
||||
return PEEK_ARRAY(q, syntax, b, 0);
|
||||
}
|
||||
|
||||
|
|
@ -207,17 +192,19 @@ static int GetChar(void) {
|
|||
|
||||
static void GetToken(void) {
|
||||
char *t;
|
||||
unsigned char b;
|
||||
unsigned char b, x;
|
||||
b = q->look;
|
||||
t = q->token;
|
||||
while (XlatSyntax(b) == ' ') {
|
||||
for (;;) {
|
||||
x = XlatSyntax(b);
|
||||
if (x != ' ') break;
|
||||
b = GetChar();
|
||||
}
|
||||
if (XlatSyntax(b)) {
|
||||
if (x) {
|
||||
STOS(t, b);
|
||||
b = GetChar();
|
||||
} else {
|
||||
while (b && !XlatSyntax(b)) {
|
||||
while (b && !x) {
|
||||
if (!DELETE || b != '\b') {
|
||||
STOS(t, b);
|
||||
} else if (t > q->token) {
|
||||
|
|
@ -225,6 +212,7 @@ static void GetToken(void) {
|
|||
if (t > q->token) --t;
|
||||
}
|
||||
b = GetChar();
|
||||
x = XlatSyntax(b);
|
||||
}
|
||||
}
|
||||
STOS(t, 0);
|
||||
|
|
@ -236,6 +224,18 @@ static WORD ConsumeObject(void) {
|
|||
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());
|
||||
}
|
||||
|
|
@ -298,7 +298,7 @@ static void PrintList(long x) {
|
|||
PrintChar('(');
|
||||
PrintObject(Car(x));
|
||||
while ((x = Cdr(x))) {
|
||||
if (TYPE(x) == CONS) {
|
||||
if (!ISATOM(x)) {
|
||||
PrintChar(' ');
|
||||
PrintObject(Car(x));
|
||||
} else {
|
||||
|
|
@ -311,7 +311,7 @@ static void PrintList(long x) {
|
|||
}
|
||||
|
||||
static void PrintObject(long x) {
|
||||
if (TYPE(x) == ATOM) {
|
||||
if (ISATOM(x)) {
|
||||
PrintAtom(x);
|
||||
} else {
|
||||
PrintList(x);
|
||||
|
|
@ -323,42 +323,38 @@ static void Print(long i) {
|
|||
PrintString("\r\n");
|
||||
}
|
||||
|
||||
__attribute__((__noreturn__)) static void Reset(void) {
|
||||
longjmp(q->jb, 1);
|
||||
}
|
||||
|
||||
__attribute__((__noreturn__)) static void OnArity(void) {
|
||||
PrintString("ARITY!\n");
|
||||
Reset();
|
||||
}
|
||||
|
||||
__attribute__((__noreturn__)) static void OnUndefined(long x) {
|
||||
PrintString("UNDEF! ");
|
||||
Print(x);
|
||||
Reset();
|
||||
}
|
||||
|
||||
#if !ERRORS
|
||||
#define OnArity() __builtin_unreachable()
|
||||
#define OnUndefined(x) __builtin_unreachable()
|
||||
#endif
|
||||
|
||||
/*───────────────────────────────────────────────────────────────────────────│─╗
|
||||
│ The LISP Challenge § Bootstrap John McCarthy's Metacircular Evaluator ─╬─│┼
|
||||
╚────────────────────────────────────────────────────────────────────────────│*/
|
||||
|
||||
static WORD Atom(long x) {
|
||||
return BOOL(TYPE(x) == ATOM);
|
||||
return BOOL(ISATOM(x));
|
||||
}
|
||||
|
||||
static WORD Null(long x) {
|
||||
return BOOL(!x);
|
||||
}
|
||||
|
||||
static WORD Eq(long x, long y) {
|
||||
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);
|
||||
}
|
||||
|
|
@ -368,37 +364,36 @@ static WORD Arg2(long e, long a) {
|
|||
}
|
||||
|
||||
static WORD Append(long x, long y) {
|
||||
return Null(x) ? y : Cons(Car(x), Append(Cdr(x), 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 Evlis(long m, long a) {
|
||||
return m ? Cons(Eval(Car(m), a), Evlis(Cdr(m), a)) : NIL;
|
||||
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) {
|
||||
if (!y) OnUndefined(x);
|
||||
return Eq(Caar(y), x) ? Cdar(y) : Assoc(x, Cdr(y));
|
||||
return y ? Eq(Caar(y), x) ? Cdar(y) : Assoc(x, Cdr(y)) : NIL;
|
||||
}
|
||||
|
||||
static WORD Pair(long x, long y) {
|
||||
if (Null(x) && Null(y)) {
|
||||
if (Atom(x) || Atom(y)) {
|
||||
return NIL;
|
||||
} else if (!Atom(x) && !Atom(y)) {
|
||||
return Cons(Cons(Car(x), Car(y)), Pair(Cdr(x), Cdr(y)));
|
||||
} else {
|
||||
OnArity();
|
||||
return Cons(Cons(Car(x), Car(y)), Pair(Cdr(x), Cdr(y)));
|
||||
}
|
||||
}
|
||||
|
||||
static WORD Evaluate(long e, long a) {
|
||||
__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:
|
||||
|
|
@ -413,17 +408,13 @@ static WORD Evaluate(long e, long a) {
|
|||
return Cdr(Arg1(e, a));
|
||||
case ATOM_CONS:
|
||||
return Cons(Arg1(e, a), Arg2(e, a));
|
||||
#if MUTABLE
|
||||
case ATOM_SET:
|
||||
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);
|
||||
return Eval(Cons(Assoc(Car(e), a), Cdr(e)), a);
|
||||
}
|
||||
} else if (Eq(Caar(e), ATOM_LAMBDA)) {
|
||||
return Eval(Caddar(e), Append(Pair(Cadar(e), Evlis(Cdr(e), a)), a));
|
||||
return Eval(Caddar(e), Bind(Cadar(e), Cdr(e), a));
|
||||
} else {
|
||||
OnUndefined(Caar(e));
|
||||
return UNDEFINED;
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -448,9 +439,6 @@ static WORD Eval(long e, long a) {
|
|||
╚────────────────────────────────────────────────────────────────────────────│*/
|
||||
|
||||
void Repl(void) {
|
||||
#if ERRORS
|
||||
setjmp(q->jb);
|
||||
#endif
|
||||
for (;;) {
|
||||
#if PROMPT
|
||||
PrintString("* ");
|
||||
|
|
@ -460,7 +448,7 @@ void Repl(void) {
|
|||
}
|
||||
|
||||
int main(int argc, char *argv[]) {
|
||||
/* RawMode(); */
|
||||
RawMode();
|
||||
SetupSyntax();
|
||||
SetupBuiltins();
|
||||
#if PROMPT
|
||||
|
|
|
|||
|
|
@ -4,11 +4,11 @@
|
|||
|
||||
#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 ISATOM(x) /* a.k.a. !(x&1) */ \
|
||||
({ \
|
||||
_Bool IsAtom; \
|
||||
asm("test%z1\t$1,%1" : "=@ccz"(IsAtom) : "Qm"((char)x)); \
|
||||
IsAtom; \
|
||||
})
|
||||
|
||||
#define OBJECT(t, v) /* a.k.a. v<<1|t */ \
|
||||
|
|
@ -112,9 +112,6 @@
|
|||
} \
|
||||
} 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)
|
||||
|
|
@ -170,6 +167,7 @@ static int ReadChar(void) {
|
|||
int c;
|
||||
#ifdef __REAL_MODE__
|
||||
asm volatile("int\t$0x16" : "=a"(c) : "0"(0) : "memory");
|
||||
c &= 0xff;
|
||||
#else
|
||||
static int buf;
|
||||
asm volatile("syscall"
|
||||
|
|
|
|||
|
|
@ -29,7 +29,7 @@ SECTIONS {
|
|||
. = 0x1fe;
|
||||
SHORT(0xaa55);
|
||||
*(.text .text.*)
|
||||
BYTE(0x90);
|
||||
/*BYTE(0x90);*/
|
||||
_etext = .;
|
||||
. = ALIGN(512);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,30 +1,105 @@
|
|||
;; (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))))
|
||||
;; (setq lisp-indent-function 'common-lisp-indent-function)
|
||||
;; (paredit-mode)
|
||||
|
||||
((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)))
|
||||
;; ________
|
||||
;; /_ __/ /_ ___
|
||||
;; / / / __ \/ _ \
|
||||
;; / / / / / / __/
|
||||
;; /_/ /_/ /_/\___/
|
||||
;; __ _________ ____ ________ ____
|
||||
;; / / / _/ ___// __ \ / ____/ /_ ____ _/ / /__ ____ ____ ____
|
||||
;; / / / / \__ \/ /_/ / / / / __ \/ __ `/ / / _ \/ __ \/ __ `/ _ \
|
||||
;; / /____/ / ___/ / ____/ / /___/ / / / /_/ / / / __/ / / / /_/ / __/
|
||||
;; /_____/___//____/_/ \____/_/ /_/\__,_/_/_/\___/_/ /_/\__, /\___/
|
||||
;; /____/
|
||||
;;
|
||||
;; THE LISP CHALLENGE
|
||||
;;
|
||||
;; PICK YOUR FAVORITE PROGRAMMING LANGUAGE
|
||||
;; IMPLEMENT THE TINIEST POSSIBLE LISP MACHINE THAT
|
||||
;; BOOTSTRAPS JOHN MCCARTHY'S METACIRCULAR EVALUATOR
|
||||
;; WINNING IS DEFINED BY LINES OF CODE FOR SCRIPTING LANGUAGES
|
||||
;; WINNING IS DEFINED BY BINARY FOOTPRINT FOR COMPILED LANGUAGES
|
||||
;;
|
||||
;; @SEE LISP FROM NOTHING; NILS M. HOLM; LULU PRESS, INC. 2020
|
||||
;; @SEE RECURSIVE FUNCTIONS OF SYMBOLIC EXPRESSIONS AND THEIR
|
||||
;; COMPUTATION BY MACHINE, PART I; JOHN MCCARTHY, MASSACHUSETTS
|
||||
;; INSTITUTE OF TECHNOLOGY, CAMBRIDGE, MASS. APRIL 1960
|
||||
|
||||
((LAMBDA (FF X) (FF 'X))
|
||||
'(LAMBDA (X)
|
||||
(COND ((ATOM X) X)
|
||||
((QUOTE T) (FF '(CAR X)))))
|
||||
'((A) B C))
|
||||
;; NIL ATOM
|
||||
;; ABSENCE OF VALUE
|
||||
NIL
|
||||
|
||||
;; CONS CELL
|
||||
;; BUILDING BLOCK OF DATA STRUCTURES
|
||||
(CONS NIL NIL)
|
||||
|
||||
;; REFLECTION
|
||||
;; EVERYTHING IS AN ATOM OR NOT AN ATOM
|
||||
(ATOM NIL)
|
||||
(ATOM (CONS NIL NIL))
|
||||
|
||||
;; QUOTING
|
||||
;; CODE IS DATA AND DATA IS CODE
|
||||
(QUOTE (CONS NIL NIL))
|
||||
(CONS (QUOTE CONS) (CONS NIL (CONS NIL NIL)))
|
||||
|
||||
;; LOGIC
|
||||
;; LAW OF IDENTITY VIA STRING INTERNING
|
||||
(EQ (QUOTE A) (QUOTE A))
|
||||
|
||||
;; FIND FIRST ATOM IN TREE
|
||||
;; RECURSIVE CONDITIONAL FUNCTION BINDING
|
||||
((LAMBDA (FF X) (FF X))
|
||||
(QUOTE (LAMBDA (X)
|
||||
(COND ((ATOM X) X)
|
||||
((QUOTE T) (FF (CAR X))))))
|
||||
(QUOTE ((A) B C)))
|
||||
|
||||
;; LISP IMPLEMENTED IN LISP
|
||||
;; USED TO EVALUATE FIND FIRST ATOM IN TREE
|
||||
;; REQUIRES CONS CAR CDR QUOTE ATOM EQ LAMBDA COND
|
||||
;; FIXES BUGS FROM JOHN MCCARTHY PAPER AND MORE MINIMAL
|
||||
((LAMBDA (ASSOC EVCON BIND APPEND EVAL)
|
||||
(EVAL (QUOTE ((LAMBDA (FF X) (FF X))
|
||||
(QUOTE (LAMBDA (X)
|
||||
(COND ((ATOM X) X)
|
||||
((QUOTE T) (FF (CAR X))))))
|
||||
(QUOTE ((A) B C))))
|
||||
NIL))
|
||||
(QUOTE (LAMBDA (X E)
|
||||
(COND ((EQ E NIL) NIL)
|
||||
((EQ X (CAR (CAR E))) (CDR (CAR E)))
|
||||
((QUOTE T) (ASSOC X (CDR E))))))
|
||||
(QUOTE (LAMBDA (C E)
|
||||
(COND ((EVAL (CAR (CAR C)) E) (EVAL (CAR (CDR (CAR C))) E))
|
||||
((QUOTE T) (EVCON (CDR C) E)))))
|
||||
(QUOTE (LAMBDA (V A E)
|
||||
(COND ((EQ V NIL) E)
|
||||
((QUOTE T) (CONS (CONS (CAR V) (EVAL (CAR A) E))
|
||||
(BIND (CDR V) (CDR A) E))))))
|
||||
(QUOTE (LAMBDA (A B)
|
||||
(COND ((EQ A NIL) B)
|
||||
((QUOTE T) (CONS (CAR A) (APPEND (CDR A) B))))))
|
||||
(QUOTE (LAMBDA (E A)
|
||||
(COND
|
||||
((ATOM E) (ASSOC E A))
|
||||
((ATOM (CAR E))
|
||||
(COND
|
||||
((EQ (CAR E) NIL) (QUOTE *UNDEFINED))
|
||||
((EQ (CAR E) (QUOTE QUOTE)) (CAR (CDR E)))
|
||||
((EQ (CAR E) (QUOTE ATOM)) (ATOM (EVAL (CAR (CDR E)) A)))
|
||||
((EQ (CAR E) (QUOTE EQ)) (EQ (EVAL (CAR (CDR E)) A)
|
||||
(EVAL (CAR (CDR (CDR E))) A)))
|
||||
((EQ (CAR E) (QUOTE CAR)) (CAR (EVAL (CAR (CDR E)) A)))
|
||||
((EQ (CAR E) (QUOTE CDR)) (CDR (EVAL (CAR (CDR E)) A)))
|
||||
((EQ (CAR E) (QUOTE CONS)) (CONS (EVAL (CAR (CDR E)) A)
|
||||
(EVAL (CAR (CDR (CDR E))) A)))
|
||||
((EQ (CAR E) (QUOTE COND)) (EVCON (CDR E) A))
|
||||
((EQ (CAR E) (QUOTE LABEL)) (EVAL (CAR (CDR (CDR E)))
|
||||
(APPEND (CAR (CDR E)) A)))
|
||||
((EQ (CAR E) (QUOTE LAMBDA)) E)
|
||||
((QUOTE T) (EVAL (CONS (EVAL (CAR E) A) (CDR E)) A))))
|
||||
((EQ (CAR (CAR E)) (QUOTE LAMBDA))
|
||||
(EVAL (CAR (CDR (CDR (CAR E))))
|
||||
(BIND (CAR (CDR (CAR E))) (CDR E) A)))))))
|
||||
|
|
|
|||
23
tool/build/emubin/lispelf.S
Normal file
23
tool/build/emubin/lispelf.S
Normal file
|
|
@ -0,0 +1,23 @@
|
|||
/*-*- mode:unix-assembly; indent-tabs-mode:t; tab-width:8; coding:utf-8 -*-│
|
||||
│vi: set et ft=asm ts=8 tw=8 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/macros.h"
|
||||
|
||||
_start: jmp main
|
||||
.endfn _start,globl
|
||||
|
|
@ -49,29 +49,3 @@ _begin: push %cs
|
|||
jmp main
|
||||
.type _begin,@function
|
||||
.size _begin,.-_begin
|
||||
|
||||
.section .start.setjmp,"ax",@progbits
|
||||
setjmp: mov %sp,%ax
|
||||
stosw
|
||||
xchg %ax,%si
|
||||
movsw %ss:(%si),(%di)
|
||||
mov %bp,%ax
|
||||
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
|
||||
mov 4(%di),%bp
|
||||
pop %ax
|
||||
mov %si,%ax
|
||||
jmp *%dx
|
||||
.type longjmp,@function
|
||||
.size longjmp,.-longjmp
|
||||
.globl longjmp
|
||||
.previous
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue