Browse Source

Reduce sectorlisp to 836 bytes

Justine Tunney 4 years ago
parent
commit
8a29ec3b23
3 changed files with 41 additions and 41 deletions
  1. 1 1
      lisp.c
  2. 1 3
      lisp.lisp
  3. 39 37
      sectorlisp.S

+ 1 - 1
lisp.c

@@ -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);
 }
 }
 
 

+ 1 - 3
lisp.lisp

@@ -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))

+ 39 - 37
sectorlisp.S

@@ -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
-	push	%ax			# save
+	pop	%di				# restore
+	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
-	push	%ax			# save
+	pop	%di				# restore
+	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
-	mov	%bp,%si
-	call	Arg1
-	and	$-2,%ax
-	xchg	%ax,%di
-	mov	2(%di),%ax
-	pop	%bp
+	push	$2
+	jmp	EvalCarCdr
+EvalUndefined:
+	mov	$UNDEFINED,%ax
+9:	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
-	call	Arg1
+//	𝑠𝑙𝑖𝑑𝑒
+EvalCar:
+	push	$0
+//	𝑠𝑙𝑖𝑑𝑒
+EvalCarCdr:
+	call	Arg1ds
 	and	$-2,%ax
 	and	$-2,%ax
 	xchg	%ax,%di
 	xchg	%ax,%di
-	mov	(%di),%ax
-	jmp	9f
-EvalAtom:
-	mov	%bp,%si
-	mov	%dx,%di
-	call	Arg1
-	test	$1,%al
-3:	mov	$ATOM_T,%ax
-	je	9f
-	xor	%ax,%ax
-	jmp	9f
+	pop	%bx
+	mov	(%bx,%di),%ax
+	jmp	9b
 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