From 2a00af296b3e8aff8092652b0350451c4f0be316 Mon Sep 17 00:00:00 2001 From: Justine Tunney Date: Wed, 24 Nov 2021 10:03:42 -0800 Subject: [PATCH] Create friendly version --- lisp.c | 30 ++++++++++++++++++-------- lisp.lisp | 12 +++++++++++ sectorlisp.S | 59 ++++++++++++++++++++++++++++++++++++++-------------- 3 files changed, 76 insertions(+), 25 deletions(-) diff --git a/lisp.c b/lisp.c index 0f9ab1e..5ce6c63 100644 --- a/lisp.c +++ b/lisp.c @@ -25,6 +25,7 @@ #include #include #include +#include #endif /*───────────────────────────────────────────────────────────────────────────│─╗ @@ -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; @@ -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]; } @@ -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)); } @@ -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); @@ -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); } } diff --git a/lisp.lisp b/lisp.lisp index 25a57ab..c7fc750 100644 --- a/lisp.lisp +++ b/lisp.lisp @@ -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))))) diff --git a/sectorlisp.S b/sectorlisp.S index 9fe50a2..2965775 100644 --- a/sectorlisp.S +++ b/sectorlisp.S @@ -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 @@ -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 @@ -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 @@ -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 @@ -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)