sjs/sectorlisp
1
0
Fork 0
mirror of https://github.com/samsonjs/sectorlisp.git synced 2026-04-27 14:57:41 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Make C impl match latest asm tactics

Browse source 
The C code now has garbage collection. It now uses negative memory
for storing cons cells. Function arguments have been inlined since
undefined evaluation order shouldn't matter since it is immutable.
Compiler warnings have been turned off so we can use traditional C
This commit is contained in:
Justine Tunney 2021-11-22 16:36:35 -08:00
parent 2f57156c34
commit c549796f78
3 changed files with 208 additions and 349 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
Makefile
View file

@ -1,3 +1,6 @@
CFLAGS = -w -Os
LDFLAGS = -s
CLEANFILES = \ CLEANFILES = \
lisp \ lisp \
lisp.o \ lisp.o \

401
lisp.c
View file

@ -20,232 +20,141 @@
#ifndef __COSMOPOLITAN__ #ifndef __COSMOPOLITAN__
#include <ctype.h> #include <ctype.h>
#include <stdio.h>
#include <stdlib.h> #include <stdlib.h>
#include <string.h> #include <string.h>
#include <unistd.h> #include <locale.h>
#include <limits.h>
#endif #endif
#define QUOTES 1 /* allow 'X shorthand for (QUOTE X) */
#define FUNDEF 1 /* be friendly w/undefined behavior */
#define TRACE 0 /* prints Eval() arguments / result */
/*───────────────────────────────────────────────────────────────────────────│─╗ /*───────────────────────────────────────────────────────────────────────────│─╗
│ The LISP Challenge § LISP Machine ─╬─│┼ │ The LISP Challenge § LISP Machine ─╬─│┼
╚────────────────────────────────────────────────────────────────────────────│*/ ╚────────────────────────────────────────────────────────────────────────────│*/
#define ATOM 1 #define kT 4
#define CONS 0 #define kQuote 6
#define kCond 12
#define kAtom 17
#define kCar 22
#define kCdr 26
#define kCons 30
#define kEq 35
#define ISATOM(x) ((x)&1) #define M (RAM + sizeof(RAM) / sizeof(RAM[0]) / 2)
#define VALUE(x) ((x)>>1) #define S "NIL\0T\0QUOTE\0COND\0ATOM\0CAR\0CDR\0CONS\0EQ"
#define OBJECT(t,v) ((v)<<1|(t))
#define NIL OBJECT(ATOM,0) int cx; /* stores negative memory use */
#define ATOM_T OBJECT(ATOM,4) int dx; /* stores lookahead character */
#define ATOM_QUOTE OBJECT(ATOM,6) int RAM[0100000]; /* your own ibm7090 */
#define ATOM_COND OBJECT(ATOM,12)
#define ATOM_ATOM OBJECT(ATOM,17)
#define ATOM_CAR OBJECT(ATOM,22)
#define ATOM_CDR OBJECT(ATOM,26)
#define ATOM_CONS OBJECT(ATOM,30)
#define ATOM_EQ OBJECT(ATOM,35)
#define ATOM_LAMBDA OBJECT(ATOM,38)
#define UNDEFINED OBJECT(ATOM,45)
const char kSymbols[] = Car(x) {
"NIL\0" return M[x];
"T\0"
"QUOTE\0"
"COND\0"
"ATOM\0"
"CAR\0"
"CDR\0"
"CONS\0"
"EQ\0"
"LAMBDA\0"
#if FUNDEF
"*UNDEFINED"
#endif
;
int g_look;
int g_index;
char g_token[128];
int g_mem[8192];
char g_str[8192];
int GetList(void);
int GetObject(void);
void PrintObject(int);
int Eval(int, int);
void SetupBuiltins(void) {
memmove(g_str, kSymbols, sizeof(kSymbols));
} }
int Car(int x) { Cdr(x) {
return g_mem[VALUE(x) + 0]; return M[x + 1];
} }
int Cdr(int x) { Cons(car, cdr) {
return g_mem[VALUE(x) + 1]; M[--cx] = cdr;
M[--cx] = car;
return cx;
} }
int Cons(int car, int cdr) { Gc(x, m, k) {
int i, cell; return x < m ? Cons(Gc(Car(x), m, k),
i = g_index; Gc(Cdr(x), m, k)) + k : x;
g_mem[i + 0] = car;
g_mem[i + 1] = cdr;
g_index = i + 2;
cell = OBJECT(CONS, i);
return cell;
} }
char *StpCpy(char *d, char *s) { Intern() {
char c; int i, j, x;
do { for (i = 0; (x = M[i++]);) {
c = *s++;
*d++ = c;
} while (c);
return d;
}
int Intern(char *s) {
int j, cx;
char c, *z, *t;
z = g_str;
c = *z++;
while (c) {
for (j = 0;; ++j) { for (j = 0;; ++j) {
if (c != s[j]) { if (x != RAM[j]) break;
break; if (!x) return i - j - 1;
x = M[i++];
} }
if (!c) { while (x)
return OBJECT(ATOM, z - g_str - j - 1); x = M[i++];
} }
c = *z++; j = 0;
} x = --i;
while (c) c = *z++; while ((M[i++] = RAM[j++]));
c = *z++; return x;
}
--z;
StpCpy(z, s);
return OBJECT(ATOM, z - g_str);
} }
void PrintChar(unsigned char b) { GetChar() {
if (write(1, &b, 1) == -1) exit(1); int c, t;
}
void PrintString(const char *s) {
char c;
for (;;) {
if (!(c = s[0])) break;
PrintChar(c);
++s;
}
}
int GetChar(void) {
int b;
static char *l, *p; static char *l, *p;
if (l || (l = p = bestlineWithHistory("* ", "sectorlisp"))) { if (l || (l = p = bestlineWithHistory("* ", "sectorlisp"))) {
if (*p) { if (*p) {
b = *p++ & 255; c = *p++ & 255;
} else { } else {
free(l); free(l);
l = p = 0; l = p = 0;
b = '\n'; c = '\n';
} }
return b; t = dx;
dx = c;
return t;
} else { } else {
PrintString("\n"); PrintChar('\n');
exit(0); exit(0);
} }
} }
void GetToken(void) { PrintChar(b) {
int al; fputwc(b, stdout);
char *di;
di = g_token;
do {
if (g_look > ' ') {
*di++ = g_look;
}
al = g_look;
g_look = GetChar();
} while (al <= ' ' || (al > ')' && g_look > ')'));
*di++ = 0;
} }
int ConsumeObject(void) { GetToken() {
GetToken(); int c, i = 0;
return GetObject(); do if ((c = GetChar()) > ' ') RAM[i++] = c;
while (c <= ' ' || (c > ')' && dx > ')'));
RAM[i] = 0;
return c;
} }
int List(int x, int y) { AddList(x) {
return Cons(x, Cons(y, NIL));
}
int Quote(int x) {
return List(ATOM_QUOTE, x);
}
int GetQuote(void) {
return Quote(ConsumeObject());
}
int AddList(int x) {
return Cons(x, GetList()); return Cons(x, GetList());
} }
int GetList(void) { GetList() {
GetToken(); int c = GetToken();
#if QUOTES if (c == ')') return 0;
if (*g_token == '\'') return AddList(GetQuote()); return AddList(GetObject(c));
#endif
if (*g_token == ')') return NIL;
return AddList(GetObject());
} }
int GetObject(void) { GetObject(c) {
#if QUOTES if (c == '(') return GetList();
if (*g_token == '\'') return GetQuote(); return Intern();
#endif
if (*g_token == '(') return GetList();
return Intern(g_token);
} }
int ReadObject(void) { ReadObject() {
g_look = GetChar(); return GetObject(GetToken());
GetToken();
return GetObject();
} }
int Read(void) { Read() {
return ReadObject(); return ReadObject();
} }
void PrintAtom(int x) { PrintAtom(x) {
PrintString(g_str + VALUE(x)); int c;
for (;;) {
if (!(c = M[x++])) break;
PrintChar(c);
}
} }
void PrintList(int x) { PrintList(x) {
#if QUOTES
if (Car(x) == ATOM_QUOTE) {
PrintChar('\'');
PrintObject(Car(Cdr(x)));
return;
}
#endif
PrintChar('('); PrintChar('(');
PrintObject(Car(x)); PrintObject(Car(x));
while ((x = Cdr(x)) != NIL) { while ((x = Cdr(x)) != 0) {
if (!ISATOM(x)) { if (x < 0) {
PrintChar(' '); PrintChar(' ');
PrintObject(Car(x)); PrintObject(Car(x));
} else { } else {
PrintString("∙"); PrintChar(L'∙');
PrintObject(x); PrintObject(x);
break; break;
} }
@ -253,130 +162,92 @@ void PrintList(int x) {
PrintChar(')'); PrintChar(')');
} }
void PrintObject(int x) { PrintObject(x) {
if (ISATOM(x)) { if (x < 0) {
PrintAtom(x);
} else {
PrintList(x); PrintList(x);
} else {
PrintAtom(x);
} }
} }
void Print(int i) { Print(e) {
PrintObject(i); PrintObject(e);
PrintString("\n"); PrintChar('\n');
} }
/*───────────────────────────────────────────────────────────────────────────│─╗ /*───────────────────────────────────────────────────────────────────────────│─╗
│ The LISP Challenge § Bootstrap John McCarthy's Metacircular Evaluator ─╬─│┼ │ The LISP Challenge § Bootstrap John McCarthy's Metacircular Evaluator ─╬─│┼
╚────────────────────────────────────────────────────────────────────────────│*/ ╚────────────────────────────────────────────────────────────────────────────│*/
int Assoc(int x, int y) { Pairlis(x, y, a) {
if (y == NIL) return NIL; if (!x) return a;
if (x == Car(Car(y))) return Cdr(Car(y)); return Cons(Cons(Car(x), Car(y)),
return Assoc(x, Cdr(y)); Pairlis(Cdr(x), Cdr(y), a));
} }
int Evcon(int c, int a) { Evlis(m, a) {
if (Eval(Car(Car(c)), a) != NIL) { if (!m) return 0;
return Cons(Eval(Car(m), a),
Evlis(Cdr(m), a));
}
Apply(f, x, a) {
if (f < 0) return Eval(Car(Cdr(Cdr(f))), Pairlis(Car(Cdr(f)), x, a));
if (f > kEq) return Apply(Eval(f, a), x, a);
if (f == kEq) return Car(x) == Car(Cdr(x)) ? kT : 0;
if (f == kCons) return Cons(Car(x), Car(Cdr(x)));
if (f == kAtom) return Car(x) < 0 ? 0 : kT;
if (f == kCar) return Car(Car(x));
if (f == kCdr) return Cdr(Car(x));
}
Evaluate(e, a) {
if (e < 0) {
if (Car(e) == kQuote) return Car(Cdr(e));
if (Car(e) == kCond) return Evcon(Cdr(e), a);
return Apply(Car(e), Evlis(Cdr(e), a), a);
}
return Assoc(e, a);
}
Evcon(c, a) {
if (Eval(Car(Car(c)), a)) {
return Eval(Car(Cdr(Car(c))), a); return Eval(Car(Cdr(Car(c))), a);
} else { } else {
return Evcon(Cdr(c), a); return Evcon(Cdr(c), a);
} }
} }
int Pairlis(int x, int y, int a) { Assoc(x, y) {
int di, si; /* it's zip() basically */ if (!y) return 0;
if (x == NIL) return a; if (x == Car(Car(y))) return Cdr(Car(y));
di = Cons(Car(x), Car(y)); return Assoc(x, Cdr(y));
si = Pairlis(Cdr(x), Cdr(y), a);
return Cons(di, si); /* Tail-Modulo-Cons */
} }
int Evlis(int m, int a) { Eval(e, a) {
int di, si; int A, B, C;
if (m == NIL) return NIL; A = cx;
di = Eval(Car(m), a); e = Evaluate(e, a);
si = Evlis(Cdr(m), a); B = cx;
return Cons(di, si); e = Gc(e, A, A - B);
} C = cx;
while (C < B)
int Apply(int fn, int x, int a) { M[--A] = M[--B];
int t1, si, ax; cx = A;
if (ISATOM(fn)) { return e;
switch (fn) {
#if FUNDEF
case NIL:
return UNDEFINED;
#endif
case ATOM_CAR:
return Car(Car(x));
case ATOM_CDR:
return Cdr(Car(x));
case ATOM_ATOM:
return ISATOM(Car(x)) ? ATOM_T : NIL;
case ATOM_CONS:
return Cons(Car(x), Car(Cdr(x)));
case ATOM_EQ:
return Car(x) == Car(Cdr(x)) ? ATOM_T : NIL;
default:
return Apply(Eval(fn, a), x, a);
}
}
if (Car(fn) == ATOM_LAMBDA) {
t1 = Cdr(fn);
si = Pairlis(Car(t1), x, a);
ax = Car(Cdr(t1));
return Eval(ax, si);
}
return UNDEFINED;
}
int Evaluate(int e, int a) {
int ax;
if (ISATOM(e))
return Assoc(e, a);
ax = Car(e);
if (ISATOM(ax)) {
if (ax == ATOM_QUOTE)
return Car(Cdr(e));
if (ax == ATOM_COND)
return Evcon(Cdr(e), a);
}
return Apply(ax, Evlis(Cdr(e), a), a);
}
int Eval(int e, int a) {
int ax;
#if TRACE
PrintString("> ");
PrintObject(e);
PrintString("\r\n ");
PrintObject(a);
PrintString("\r\n");
#endif
ax = Evaluate(e, a);
#if TRACE
PrintString("< ");
PrintObject(ax);
PrintString("\r\n");
#endif
return ax;
} }
/*───────────────────────────────────────────────────────────────────────────│─╗ /*───────────────────────────────────────────────────────────────────────────│─╗
│ The LISP Challenge § User Interface ─╬─│┼ │ The LISP Challenge § User Interface ─╬─│┼
╚────────────────────────────────────────────────────────────────────────────│*/ ╚────────────────────────────────────────────────────────────────────────────│*/
void Repl(void) { main() {
int i;
setlocale(LC_ALL, "");
bestlineSetXlatCallback(bestlineUppercase);
for(i = 0; i < sizeof(S); ++i) M[i] = S[i];
for (;;) { for (;;) {
Print(Eval(Read(), NIL)); cx = 0;
Print(Eval(Read(), 0));
} }
} }
int main(int argc, char *argv[]) {
SetupBuiltins();
bestlineSetXlatCallback(bestlineUppercase);
PrintString("THE LISP CHALLENGE V1\r\n"
"VISIT GITHUB.COM/JART\r\n");
Repl();
}

153
sectorlisp.S
View file

@ -22,28 +22,9 @@
// LISP meta-circular evaluator in a MBR // LISP meta-circular evaluator in a MBR
// Compatible with the original hardware // Compatible with the original hardware
.set g_mem, %cx .code16
.set g_token, %cx .globl _start
.set ZERO, %bh _start: .asciz "NIL" # dec %si ; dec %cx ; dec %sp
.set TWO, %bx
.section .text,"ax",@progbits
.type kNil,@object
.type kT,@object
.type kQuote,@object
.type kCond,@object
.type kAtom,@object
.type kCar,@object
.type kCdr,@object
.type kCons,@object
.type kEq,@object
.type start,@function
.type begin,@function
.globl _start
.code16
_start:
kNil: .asciz "NIL" # dec %si ; dec %cx ; dec %sp
kT: .asciz "T" # add %dl,(%si) boot A:\ DL=0 kT: .asciz "T" # add %dl,(%si) boot A:\ DL=0
start: ljmp $0x7c00>>4,$begin # cs = 0x7c00 is boot address start: ljmp $0x7c00>>4,$begin # cs = 0x7c00 is boot address
.asciz "" .asciz ""
@ -55,20 +36,20 @@ kCdr: .asciz "CDR" # ordering matters
kCons: .asciz "CONS" # ordering matters kCons: .asciz "CONS" # ordering matters
kEq: .asciz "EQ" # needs to be last kEq: .asciz "EQ" # needs to be last
begin: xor TWO,TWO begin: xor %bx,%bx # we use the tiny memory model
push %cs # memory model ds=es=ss=cs push %cs # that means ss = ds = es = cs
pop %ds pop %ds # noting ljmp set cs to 0x7c00
push %cs push %cs # that's the bios load address
pop %es pop %es # therefore NULL points to NUL
push %cs push %cs # terminated NIL string above!
cli # disable interrupts cli # disables hardware interrupts
pop %ss # disable nonmaskable interrupts pop %ss # disable nonmaskable ones too
mov TWO,%sp # use null pointer as our stack mov %bx,%sp # use highest address as stack
sti # enable interrupts sti # reenable hardware interrupts
cld # direction forward cld # normalize the direction flag
inc TWO inc %bx
inc TWO inc %bx
main: mov $0x8000,g_mem # dl (g_look) is zero or cr main: mov $0x8000,%cx # dl (g_look) is zero or cr
call GetToken call GetToken
call GetObject call GetObject
xor %dx,%dx xor %dx,%dx
@ -80,7 +61,7 @@ main: mov $0x8000,g_mem # dl (g_look) is zero or cr
jmp main jmp main
GetToken: # GetToken():al, dl is g_look GetToken: # GetToken():al, dl is g_look
mov g_token,%di mov %cx,%di
1: mov %dl,%al 1: mov %dl,%al
cmp $' ',%al cmp $' ',%al
jbe 2f jbe 2f
@ -93,7 +74,7 @@ GetToken: # GetToken():al, dl is g_look
jbe 3f jbe 3f
cmp $')',%dl # dl = g_look cmp $')',%dl # dl = g_look
ja 1b ja 1b
3: movb ZERO,(%di) 3: movb %bh,(%di) # bh is zero
xchg %si,%ax xchg %si,%ax
ret ret
@ -104,7 +85,7 @@ PrintObject: # PrintObject(x:si)
jns .PrintAtom # jump if cons jns .PrintAtom # jump if cons
.PrintList: .PrintList:
mov $'(',%al mov $'(',%al
2: push (TWO,%si) 2: push (%bx,%si)
mov (%si),%si mov (%si),%si
call .PutObject call .PutObject
mov $' ',%al mov $' ',%al
@ -138,7 +119,7 @@ GetObject: # called just after GetToken
jne 1b jne 1b
jmp 5f jmp 5f
2: pop %si # drop 1 2: pop %si # drop 1
mov g_token,%si mov %cx,%si
3: scasb 3: scasb
jne 3b jne 3b
cmp (%di),%al cmp (%di),%al
@ -151,15 +132,12 @@ GetObject: # called just after GetToken
5: pop %ax # restore 1 5: pop %ax # restore 1
.ret: ret .ret: ret
GetChar: # GetChar→al:dl GetChar:xor %ax,%ax # GetChar→al:dl
xor %ax,%ax # get keystroke int $0x16 # get keystroke
int $0x16 # keyboard service PutChar:mov $0x0e,%ah # prints CP-437
# ah is bios scancode
# al is ascii character
PutChar:mov $0x0e,%ah # teletype output al cp437
int $0x10 # vidya service int $0x10 # vidya service
cmp $'\r',%al # don't clobber cmp $'\r',%al # don't clobber
jne 1f # xchg dx,ax and ret jne 1f # look xchg ret
mov $'\n',%al mov $'\n',%al
jmp PutChar jmp PutChar
@ -167,7 +145,7 @@ PutChar:mov $0x0e,%ah # teletype output al cp437
Pairlis:test %di,%di # Pairlis(x:di,y:si,a:dx):ax Pairlis:test %di,%di # Pairlis(x:di,y:si,a:dx):ax
jz 1f # jump if nil jz 1f # jump if nil
push (TWO,%di) # save 1 Cdr(x) push (%bx,%di) # save 1 Cdr(x)
lodsw lodsw
push (%si) # save 2 Cdr(y) push (%si) # save 2 Cdr(y)
mov (%di),%di mov (%di),%di
@ -182,7 +160,7 @@ Pairlis:test %di,%di # Pairlis(x:di,y:si,a:dx):ax
Evlis: test %di,%di # Evlis(m:di,a:dx):ax Evlis: test %di,%di # Evlis(m:di,a:dx):ax
jz 1f # jump if nil jz 1f # jump if nil
push (TWO,%di) # save 1 Cdr(m) push (%bx,%di) # save 1 Cdr(m)
mov (%di),%ax mov (%di),%ax
call Eval call Eval
pop %di # restore 1 pop %di # restore 1
@ -193,17 +171,17 @@ Evlis: test %di,%di # Evlis(m:di,a:dx):ax
xCons: pop %di # restore 2 xCons: pop %di # restore 2
Cons: xchg %ax,%si # Cons(m:di,a:ax):ax Cons: xchg %ax,%si # Cons(m:di,a:ax):ax
xchg %di,%ax xchg %di,%ax
mov g_mem,%di mov %cx,%di
stosw stosw
xchg %si,%ax xchg %si,%ax
stosw stosw
xchg %di,g_mem xchg %di,%cx
1: xchg %di,%ax 1: xchg %di,%ax
ret ret
Gc: cmp %dx,%di # Gc(x:di,mark:dx,aj:bp):ax Gc: cmp %dx,%di # Gc(x:di,mark:dx,aj:bp):ax
jb 1b # we assume immutable cells jb 1b # we assume immutable cells
push (TWO,%di) # mark prevents negative gc push (%bx,%di) # mark prevents negative gc
mov (%di),%di mov (%di),%di
call Gc call Gc
pop %di pop %di
@ -218,11 +196,12 @@ GetList:call GetToken
cmpb $')',%al cmpb $')',%al
je .retF je .retF
call GetObject call GetObject
push %ax # save 1 push %ax # popped by xCons
call GetList call GetList
jmp xCons jmp xCons
.Eval: test %ax,%ax # Eval(e:ax,a:dx):ax w/o gc Evaluate: # Evaluate(e:ax,a:dx):ax
test %ax,%ax # Implementation of Eval
jns Assoc # lookup val if atom jns Assoc # lookup val if atom
xchg %ax,%si # di = e xchg %ax,%si # di = e
lodsw # ax = Car(e) lodsw # ax = Car(e)
@ -238,23 +217,7 @@ GetList:call GetToken
# jmp Apply # jmp Apply
Apply: test %ax,%ax # Apply(fn:ax,x:si:a:dx):ax Apply: test %ax,%ax # Apply(fn:ax,x:si:a:dx):ax
jns .switch # jump if atom js .lamb # jump if atom
xchg %ax,%di # di = fn
.lambda:mov (TWO,%di),%di # di = Cdr(fn)
push %di # save 1
mov (%di),%di # di = Cadr(fn)
call Pairlis
xchg %ax,%dx
pop %di # restore 1
jmp .EvCadr
.ifCons:cmp $kCons,%al
mov (TWO,%si),%si # si = Cdr(x)
lodsw # si = Cadr(x)
je Cons
.isEq: cmp %di,%ax # we know for certain it's eq
jne .retF
.retT: mov $kT,%ax
ret
.switch:cmp $kEq,%ax # eq is last builtin atom .switch:cmp $kEq,%ax # eq is last builtin atom
ja .dflt1 # ah is zero if not above ja .dflt1 # ah is zero if not above
mov (%si),%di # di = Car(x) mov (%si),%di # di = Car(x)
@ -268,12 +231,28 @@ Apply: test %ax,%ax # Apply(fn:ax,x:si:a:dx):ax
jns .retT jns .retT
.retF: xor %ax,%ax # ax = nil .retF: xor %ax,%ax # ax = nil
ret ret
.lamb: xchg %ax,%di # di = fn
.lambda:mov (%bx,%di),%di # di = Cdr(fn)
push %di # save 1
mov (%di),%di # di = Cadr(fn)
call Pairlis
xchg %ax,%dx
pop %di # restore 1
jmp .EvCadr
.ifCons:cmp $kCons,%al
mov (%bx,%si),%si # si = Cdr(x)
lodsw # si = Cadr(x)
je Cons
.isEq: cmp %di,%ax # we know for certain it's eq
jne .retF
.retT: mov $kT,%ax
ret
.dflt1: push %si # save x .dflt1: push %si # save x
call Eval call Eval
pop %si # restore x pop %si # restore x
jmp Apply jmp Apply
Cadr: mov (TWO,%di),%di # contents of decrement register Cadr: mov (%bx,%di),%di # contents of decrement register
.byte 0x3C # cmp §scasw,%al (nop next byte) .byte 0x3C # cmp §scasw,%al (nop next byte)
Cdr: scasw # increments our data index by 2 Cdr: scasw # increments our data index by 2
Car: mov (%di),%ax # contents of address register!! Car: mov (%di),%ax # contents of address register!!
@ -282,13 +261,13 @@ Car: mov (%di),%ax # contents of address register!!
Assoc: mov %dx,%di # Assoc(x:ax,y:dx):ax Assoc: mov %dx,%di # Assoc(x:ax,y:dx):ax
test %dx,%dx # nil test test %dx,%dx # nil test
jz .retF # return nil if end of list jz .retF # return nil if end of list
mov (TWO,%di),%dx # we assume Eval() saved dx mov (%bx,%di),%dx # we assume Eval() saved dx
mov (%di),%di mov (%di),%di
scasw scasw
jne Assoc jne Assoc
jmp Car jmp Car
1: mov (TWO,%di),%di # di = Cdr(c) 1: mov (%bx,%di),%di # di = Cdr(c)
Evcon: push %di # save c Evcon: push %di # save c
mov (%di),%si # di = Car(c) mov (%di),%si # di = Car(c)
lodsw # ax = Caar(c) lodsw # ax = Caar(c)
@ -301,23 +280,29 @@ Evcon: push %di # save c
# jmp Eval # jmp Eval
Eval: push %dx # Eval(e:ax,a:dx):ax w/ gc Eval: push %dx # Eval(e:ax,a:dx):ax w/ gc
push g_mem # with garbage collections push %cx # w/ ABC garbage collector
call .Eval # discards non-result cons call Evaluate # discards non-result cons
pop %dx pop %dx
push g_mem push %cx
mov g_mem,%bp mov %cx,%bp
sub %dx,%bp sub %dx,%bp
xchg %ax,%di xchg %ax,%di
call Gc call Gc
pop %si pop %si
mov %dx,%di mov %dx,%di
sub %si,%cx # cx = g_mem - si sub %si,%cx
rep movsb rep movsb
mov %di,g_mem mov %di,%cx
pop %dx pop %dx
ret ret
.type .sig,@object .sig: .fill 510 - (. - _start), 1, 0xce
.sig: .word 0xAA55
.fill 510 - (. - _start), 1, 0xce .type .sig,@object
.word 0xAA55 .type kQuote,@object
.type kCond,@object
.type kAtom,@object
.type kCar,@object
.type kCdr,@object
.type kCons,@object
.type kEq,@object