Reduce sectorlisp to 836 bytes

This commit is contained in:
Justine Tunney 2021-02-04 01:18:34 -08:00
parent b64b27feb8
commit 8a29ec3b23
3 changed files with 41 additions and 41 deletions

2
lisp.c
View file

@ -331,7 +331,7 @@ static WORD Atom(long x) {
return BOOL(ISATOM(x)); return BOOL(ISATOM(x));
} }
WORD Eq(long x, long y) { static WORD Eq(long x, long y) {
return BOOL(x == y); return BOOL(x == y);
} }

View file

@ -23,7 +23,7 @@
;; ;;
;; Listed Projects ;; Listed Projects
;; ;;
;; - 948 bytes: https://github.com/jart/sectorlisp ;; - 836 bytes: https://github.com/jart/sectorlisp
;; - 13 kilobytes: https://t3x.org/klisp/ ;; - 13 kilobytes: https://t3x.org/klisp/
;; - 150 kilobytes: https://github.com/JeffBezanson/femtolisp ;; - 150 kilobytes: https://github.com/JeffBezanson/femtolisp
;; - Send pull request to be listed here ;; - Send pull request to be listed here
@ -108,8 +108,6 @@ NIL
((EQ (CAR E) (QUOTE CONS)) (CONS (EVAL (CAR (CDR E)) A) ((EQ (CAR E) (QUOTE CONS)) (CONS (EVAL (CAR (CDR E)) A)
(EVAL (CAR (CDR (CDR E))) A))) (EVAL (CAR (CDR (CDR E))) A)))
((EQ (CAR E) (QUOTE COND)) (EVCON (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) ((EQ (CAR E) (QUOTE LAMBDA)) E)
((QUOTE T) (EVAL (CONS (EVAL (CAR E) A) (CDR E)) A)))) ((QUOTE T) (EVAL (CONS (EVAL (CAR E) A) (CDR E)) A))))
((EQ (CAR (CAR E)) (QUOTE LAMBDA)) ((EQ (CAR (CAR E)) (QUOTE LAMBDA))

View file

@ -178,10 +178,10 @@ GetList:call GetToken
cmp $'.',%al cmp $'.',%al
je 1f je 1f
call GetObject call GetObject
push %ax # save push %ax # save
call GetList call GetList
xchg %ax,%si xchg %ax,%si
pop %di # restore pop %di # restore
jmp Cons jmp Cons
1: call GetToken 1: call GetToken
jmp GetObject jmp GetObject
@ -189,7 +189,7 @@ GetList:call GetToken
ret ret
EvalCons: EvalCons:
push %dx # save push %dx # save
mov 2(%bx),%bx mov 2(%bx),%bx
mov %bx,%di mov %bx,%di
call Cadr call Cadr
@ -197,10 +197,10 @@ EvalCons:
mov %bp,%si mov %bp,%si
call Eval call Eval
mov %bp,%si mov %bp,%si
pop %di # restore pop %di # restore
push %ax # save push %ax # save
call Arg1 call Arg1
pop %si # restore pop %si # restore
xchg %ax,%di xchg %ax,%di
pop %bp pop %bp
// jmp Cons // jmp Cons
@ -292,6 +292,9 @@ PutChar:push %bx # don't clobber bp,bx,di,si,cx
pop %bx pop %bx
ret ret
Arg1ds: mov %dx,%di
mov %bp,%si
// 𝑠𝑙𝑖𝑑𝑒
Arg1: call Cadr Arg1: call Cadr
xchg %ax,%di xchg %ax,%di
// jmp Eval // jmp Eval
@ -340,12 +343,15 @@ Eval: push %bp
je EvalUndefined je EvalUndefined
cmp $ATOM_QUOTE,%ax cmp $ATOM_QUOTE,%ax
jne EvalCall jne EvalCall
// 𝑠𝑙𝑖𝑑𝑒
EvalQuote:
xchg %dx,%di xchg %dx,%di
pop %bp pop %bp
jmp Cadr jmp Cadr
1: cmp $ATOM_EQ,%ax 1: cmp $ATOM_EQ,%ax
jne EvalCall jne EvalCall
push %dx // 𝑠𝑙𝑖𝑑𝑒
EvalEq: push %dx
mov 2(%bx),%bx mov 2(%bx),%bx
mov %bx,%di mov %bx,%di
call Cadr call Cadr
@ -353,20 +359,18 @@ Eval: push %bp
mov %bp,%si mov %bp,%si
call Eval call Eval
mov %bp,%si mov %bp,%si
pop %di # restore pop %di # restore
push %ax # save push %ax # save
call Arg1 call Arg1
pop %dx # restore pop %dx # restore
cmp %dx,%ax cmp %dx,%ax
jmp 3f jmp 3f
EvalCdr: EvalCdr:
mov %dx,%di push $2
mov %bp,%si jmp EvalCarCdr
call Arg1 EvalUndefined:
and $-2,%ax mov $UNDEFINED,%ax
xchg %ax,%di 9: pop %bp
mov 2(%di),%ax
pop %bp
ret ret
EvalCond: EvalCond:
mov 2(%bx),%bx mov 2(%bx),%bx
@ -388,39 +392,37 @@ EvalCond:
je EvalCons je EvalCons
cmp $ATOM_CAR,%ax cmp $ATOM_CAR,%ax
jne EvalCall jne EvalCall
mov %dx,%di // 𝑠𝑙𝑖𝑑𝑒
mov %bp,%si EvalCar:
call Arg1 push $0
// 𝑠𝑙𝑖𝑑𝑒
EvalCarCdr:
call Arg1ds
and $-2,%ax and $-2,%ax
xchg %ax,%di xchg %ax,%di
mov (%di),%ax pop %bx
jmp 9f mov (%bx,%di),%ax
EvalAtom: jmp 9b
mov %bp,%si
mov %dx,%di
call Arg1
test $1,%al
3: mov $ATOM_T,%ax
je 9f
xor %ax,%ax
jmp 9f
EvalCall: EvalCall:
mov 2(%bx),%cx push 2(%bx)
mov (%bx),%di mov (%bx),%di
mov %bp,%si mov %bp,%si
call Assoc call Assoc
xchg %cx,%si
xchg %ax,%di xchg %ax,%di
pop %si
call Cons call Cons
jmp 1f jmp 1f
EvalAtom:
call Arg1ds
test $1,%al
3: mov $ATOM_T,%ax
je 9b
xor %ax,%ax
jmp 9b
EvalCadrLoop: EvalCadrLoop:
call Cadr call Cadr
1: xchg %ax,%dx 1: xchg %ax,%dx
jmp 0b jmp 0b
EvalUndefined:
mov $UNDEFINED,%ax
9: pop %bp
ret
//////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////
.section .rodata,"a",@progbits .section .rodata,"a",@progbits