Skip to content

Commit

Permalink
Create friendly version
Browse files Browse the repository at this point in the history
  • Loading branch information
jart committed Nov 24, 2021
1 parent 17bd5be commit 2a00af2
Show file tree
Hide file tree
Showing 3 changed files with 76 additions and 25 deletions.
30 changes: 21 additions & 9 deletions lisp.c
Expand Up @@ -25,6 +25,7 @@
#include <string.h>
#include <locale.h>
#include <limits.h>
#include <setjmp.h>
#endif

/*───────────────────────────────────────────────────────────────────────────│─╗
Expand All @@ -46,6 +47,7 @@
int cx; /* stores negative memory use */
int dx; /* stores lookahead character */
int RAM[0100000]; /* your own ibm7090 */
jmp_buf undefined;

Intern() {
int i, j, x;
Expand Down Expand Up @@ -157,10 +159,12 @@ Print(e) {
╚────────────────────────────────────────────────────────────────────────────│*/

Car(x) {
if (x >= 0) longjmp(undefined, x);
return M[x];
}

Cdr(x) {
if (x >= 0) longjmp(undefined, x);
return M[x + 1];
}

Expand All @@ -186,7 +190,7 @@ Pairlis(x, y, a) {
}

Assoc(x, y) {
if (!y) return 0;
if (y >= 0) longjmp(undefined, x);
if (x == Car(Car(y))) return Cdr(Car(y));
return Assoc(x, Cdr(y));
}
Expand All @@ -207,14 +211,14 @@ Apply(f, x, a) {
if (f == kAtom) return Car(x) < 0 ? 0 : kT;
if (f == kCar) return Car(Car(x));
if (f == kCdr) return Cdr(Car(x));
longjmp(undefined, f);
}

Eval(e, a) {
int A, B, C;
if (e >= 0)
return Assoc(e, a);
if (Car(e) == kQuote)
return Car(Cdr(e));
if (!e) return 0;
if (e > 0) return Assoc(e, a);
if (Car(e) == kQuote) return Car(Cdr(e));
A = cx;
if (Car(e) == kCond) {
e = Evcon(Cdr(e), a);
Expand All @@ -235,12 +239,20 @@ Eval(e, a) {
╚────────────────────────────────────────────────────────────────────────────│*/

main() {
int i;
int x, a = 0;
setlocale(LC_ALL, "");
bestlineSetXlatCallback(bestlineUppercase);
for(i = 0; i < sizeof(S); ++i) M[i] = S[i];
for(x = 0; x < sizeof(S); ++x) M[x] = S[x];
for (;;) {
cx = 0;
Print(Eval(Read(), 0));
if (!(x = setjmp(undefined))) {
x = Eval(Read(), a);
if (x < 0) {
a = Cons(x, a);
}
} else {
if (x == 1) x = 0;
PrintChar('?');
}
Print(x);
}
}
12 changes: 12 additions & 0 deletions lisp.lisp
Expand Up @@ -120,3 +120,15 @@ NIL
((EQ (CAR E) (QUOTE COND)) (EVCON (CDR E) A))
((QUOTE T) (APPLY (CAR E) (EVLIS (CDR E) A) A))))
((QUOTE T) (APPLY (CAR E) (EVLIS (CDR E) A) A))))))

(CONS (QUOTE NOT)
(QUOTE (LAMBDA (X)
(COND (X (QUOTE F))
((QUOTE T) (QUOTE T))))))

((LAMBDA (X E C)
(CONS (QUOTE LAMBDA) (CONS NIL (CONS (CAR (CDR C)) NIL))))
(QUOTE T)
(QUOTE (LAMBDA (F) (F)))
(QUOTE (COND (X (QUOTE F))
((QUOTE T) (QUOTE T)))))
59 changes: 43 additions & 16 deletions sectorlisp.S
Expand Up @@ -23,6 +23,8 @@
// Compatible with the original hardware

.code16
.set save,-10
.set look,start+2
.globl _start
_start: .asciz "NIL" # dec %si ; dec %cx ; dec %sp
kT: .asciz "T" # add %dl,(%si) boot A:\ DL=0
Expand All @@ -36,37 +38,53 @@ kCdr: .asciz "CDR" # ordering matters
kCons: .asciz "CONS" # ordering matters
kEq: .asciz "EQ" # needs to be last

begin: push %cs # that means ss = ds = es = cs
begin: mov $2,%bx
mov $0x8000,%cx
main: cli
push %cs # that means ss = ds = es = cs
pop %ds # noting ljmp set cs to 0x7c00
push %cs # that's the bios load address
pop %es # therefore NULL points to NUL
push %cs # terminated NIL string above!
pop %ss # errata exists but don't care
xor %sp,%sp # use highest address as stack
mov $2,%bx
main: mov $0x8000,%cx # dl (g_look) is zero or cr
sti
call GetToken
call GetObject
mov %dx,save
call Eval
xchg %ax,%si
test %ax,%ax
jns Print
push %ax
xchg %ax,%di
xchg %dx,%ax
call Cons
xchg %ax,%dx
pop %ax
Print: xchg %ax,%si
call PrintObject
mov $'\r',%al
call PutChar
jmp main

GetToken: # GetToken():al, dl is g_look
GetToken: # GetToken():al
mov %cx,%di
1: mov %dl,%al
1: mov look,%al
cmp $' ',%al
jbe 2f
stosb
xchg %ax,%si
2: call GetChar # exchanges dx and ax
cmp $'\b',%al
jne 4f
dec %di
jmp 2b
4: xchg %ax,look
cmp $' ',%al
jbe 1b
cmp $')',%al
jbe 3f
cmp $')',%dl # dl = g_look
cmpb $')',look
ja 1b
3: mov %bh,(%di) # bh is zero
xchg %si,%ax
Expand Down Expand Up @@ -123,14 +141,21 @@ Intern: push %cx # Intern(cx,di): ax
jmp 1b
2: rep movsb # memcpy(di,si,cx)
9: pop %cx
ret
3: ret

Undef: push %ax
mov $'?',%al
call PutChar
pop %ax
mov save,%dx
jmp Print

GetChar:xor %ax,%ax # GetChar→al:dl
int $0x16 # get keystroke
PutChar:mov $0x0e,%ah # prints CP-437
int $0x10 # vidya service
cmp $'\r',%al # don't clobber
jne 1f # look xchg ret
jne 3b # look xchg ret
mov $'\n',%al
jmp PutChar

Expand Down Expand Up @@ -183,6 +208,15 @@ Gc: cmp %dx,%di # Gc(x:di,A:dx,B:si):ax
add %dx,%ax
ret

Assoc: mov %dx,%si # Assoc(x:ax,y:dx):ax
1: test %si,%si
jns Undef
mov (%si),%di
mov (%bx,%si),%si
scasw
jne 1b
jmp Car

GetList:call GetToken
cmp $')',%al
je .retF
Expand Down Expand Up @@ -234,13 +268,6 @@ Cdr: scasw # increments our data index by 2
Car: mov (%di),%ax # contents of address register!!
2: ret

Assoc: mov %dx,%si # Assoc(x:ax,y:dx):ax
1: mov (%si),%di
mov (%bx,%si),%si
scasw
jne 1b
jmp Car

1: mov (%bx,%di),%di # di = Cdr(c)
Evcon: push %di # save c
mov (%di),%si # di = Car(c)
Expand Down

0 comments on commit 2a00af2

Please sign in to comment.