Reduce sectorlisp from 948 to 856 bytes

Makefile

@@ -51,10 +51,10 @@ clean:;	$(RM) $(CLEANFILES)
 lisp.bin.dbg: start.o lisp.real.o lisp.lds
 sectorlisp.bin.dbg: start.o sectorlisp.o lisp.lds
 
-start.o: start.S
-lisp.o: lisp.c lisp.h
-lisp.real.o: lisp.c lisp.h
-sectorlisp.o: sectorlisp.S
+start.o: start.S Makefile
+lisp.o: lisp.c lisp.h Makefile
+lisp.real.o: lisp.c lisp.h Makefile
+sectorlisp.o: sectorlisp.S Makefile
 
 %.real.o: %.c
 	$(CC) $(CPPFLAGS) $(CFLAGS) $(REALFLAGS) -c -o $@ $<

README.md

@@ -29,7 +29,7 @@ of running natively without dependencies on modern PCs, sectorlisp might
 be the tiniest self-hosting LISP interpreter to date. 
 
 We're still far off however from reaching our goal, which is to have
-sectorilsp be small enough to fit in the master boot record of a floppy
+sectorlisp be small enough to fit in the master boot record of a floppy
 disk, like [sectorforth](https://github.com/cesarblum/sectorforth). If
 you can help this project reach its goal, please send us a pull request!
 

lisp.lds

@@ -4,12 +4,12 @@ SECTIONS {
 
   .text 0x7c00 - 0x600 : {
     *(.start)
+    *(.text.startup)
     rodata = .;
     *(.rodata .rodata.*)
     . = 0x1fe;
     SHORT(0xaa55);
     *(.text .text.*)
-    /*BYTE(0x90);*/
     _etext = .;
     . = ALIGN(512);
   }
@@ -21,6 +21,7 @@ SECTIONS {
   }
 
   /DISCARD/ : {
+    *(.yoink)
     *(.*)
   }
 }

lisp.lisp

@@ -40,6 +40,7 @@ NIL
 ;; CONS CELL
 ;; BUILDING BLOCK OF DATA STRUCTURES
 (CONS NIL NIL)
+(CONS (QUOTE X) (QUOTE Y))
 
 ;; REFLECTION
 ;; EVERYTHING IS AN ATOM OR NOT AN ATOM

sectorlisp.S

@@ -35,22 +35,18 @@
 #define ATOM_CONS	88
 #define ATOM_LAMBDA	98
 
-#define SYNTAX		0x4000
-#define LOOK		0x4100
-#define GLOBALS		0x4102
-#define INDEX		0x4104
-#define TOKEN		0x4106
-#define STR		0x41c8
+#define STR 0x4186
 
 ////////////////////////////////////////////////////////////////////////////////
 .section .start,"ax",@progbits
 .globl	main
 .code16
 
-main:	mov	$SYNTAX,%bx
-	movb	$32,32(%bx)
-	movb	$32,13(%bx)
-	movb	$32,10(%bx)
+main:	mov	$q.syntax,%bx
+	mov	$32,%al
+	mov	%al,32(%bx)
+	mov	%al,13(%bx)
+	mov	%al,10(%bx)
 	movw	$10536,40(%bx)
 	movb	$46,46(%bx)
 	mov	$STR,%di
@@ -58,58 +54,41 @@ main:	mov	$SYNTAX,%bx
 	mov	$57,%cx
 	rep movsb
 0:	call	GetChar
-	mov	%ax,LOOK
+	mov	%ax,q.look
 	call	GetToken
 	call	GetObject
 	xchg	%ax,%di
-	mov	GLOBALS,%si
+	mov	q.globals,%si
 	call	Eval
 	xchg	%ax,%di
 	call	PrintObject
-	mov	$kCrlf,%di
+	mov	$kCrlf,%si
 	call	PrintString
 	jmp	0b
 
-PutChar:push	%bx
-	push	%bp				# original ibm pc scroll up bug
-	mov	$0x0007,%bx			# normal mda/cga style page zero
-	xchg	%di,%ax				# character to display
-	mov	$0x0E,%ah			# teletype output
-	int	$0x10				# vidya service
-	pop	%bp				# result dil→al
-	pop	%bx
-	ret
-
 GetChar:xor	%ax,%ax				# get keystroke
 	int	$0x16				# keyboard service
 	xor	%ah,%ah				# ah is bios scancode
 	push	%ax				# al is ascii character
-	xchg	%ax,%di				# result is ax
-	call	PutChar
-	cmp	$'\r,%al
+	call	PutChar				# ax will have result
+	cmp	$'\r,%al			# don't clobber stuff
 	jne	1f
-	mov	$'\n,%di
+	mov	$'\n,%al
 	call	PutChar
 1:	pop	%ax
 	ret
 
-PrintString:
-	mov	%di,%dx
-0:	mov	%dx,%di
-	mov	(%di),%al
-	test	%al,%al
-	je	1f
-	xchg	%ax,%di
-	call	PutChar
-	inc	%dx
-	jmp	0b
-1:	ret
+Cadr:	and	$-2,%di				# (object >> 1) * sizeof(word)
+	mov	2(%di),%di			# contents of decrement register
+	and	$-2,%di				# contents of address register
+	mov	(%di),%ax
+	ret
 
 GetToken:
 	xor	%bx,%bx
-	mov	$SYNTAX,%si
-	mov	LOOK,%ax
-	mov	$TOKEN,%cx
+	mov	$q.syntax,%si
+	mov	q.look,%ax
+	mov	$q.token,%di
 0:	mov	%al,%bl
 	mov	(%bx,%si),%dl
 	mov	%dl,%bl
@@ -119,24 +98,19 @@ GetToken:
 	jmp	0b
 1:	test	%dl,%dl
 	je	3f
-	xchg	%cx,%di
 	stosb
-	xchg	%di,%cx
 	call	GetChar
 	jmp	4f
 2:	test	%bl,%bl
 	jne	4f
-	xchg	%cx,%di
 	stosb
-	xchg	%di,%cx
 	call	GetChar
 	mov	%ax,%bx
 	mov	(%bx,%si),%bl
 3:	test	%al,%al
 	jne	2b
-4:	mov	%cx,%di
-	movb	$0,(%di)
-	mov	%al,LOOK
+4:	movb	$0,(%di)
+	mov	%al,q.look
 	ret
 
 Assoc:	xchg	%si,%bx
@@ -158,24 +132,56 @@ Assoc:	xchg	%si,%bx
 	ret
 
 GetObject:
-	cmpb	$40,TOKEN
-	je	1f
-	mov	$TOKEN,%di
-	jmp	Intern
-1:	#jmp	GetList
+	cmpb	$40,q.token
+	je	GetList
+	mov	$q.token,%di
 /	𝑠𝑙𝑖𝑑𝑒
 
+Intern:	mov	%di,%bx
+	mov	$STR,%si
+0:	lodsb
+	test	%al,%al
+	je	4f
+	xor	%dx,%dx
+1:	mov	%dx,%di
+	mov	(%bx,%di),%cl
+	cmp	%cl,%al
+	jne	3f
+	inc	%dx
+	test	%al,%al
+	jne	2f
+	sub	%di,%si
+	lea	-STR-1(%si),%ax
+	jmp	6f
+2:	lodsb
+	jmp	1b
+3:	test	%al,%al
+	jz	0b
+	lodsb
+	jmp	3b
+4:	lea	-1(%si),%di
+	push	%di
+	mov	%bx,%si
+0:	lodsb
+	stosb
+	test	%al,%al
+	jnz	0b
+	pop	%ax
+	sub	$STR,%ax
+6:	shl	%ax
+	ret
+
 GetList:call	GetToken
-	mov	TOKEN,%al
+	mov	q.token,%al
 	cmp	$'),%al
 	je	2f
 	cmp	$'.,%al
 	je	1f
 	call	GetObject
-	push	%ax
+	push	%ax			# save
 	call	GetList
 	xchg	%ax,%si
-	pop	%di
+	pop	%di			# restore
 	jmp	Cons
 1:	call	GetToken
 	jmp	GetObject
@@ -187,7 +193,7 @@ EvalCons:
 	mov	2(%bx),%bx
 	mov	%bx,%di
 	call	Cadr
-	mov	%ax,%di
+	xchg	%ax,%di
 	mov	%bp,%si
 	call	Eval
 	mov	%bp,%si
@@ -200,7 +206,7 @@ EvalCons:
 /	jmp	Cons
 /	𝑠𝑙𝑖𝑑𝑒
 
-Cons:	mov	$INDEX,%bx
+Cons:	mov	$q.index,%bx
 	mov	(%bx),%ax
 	addw	$2,(%bx)
 	shl	%ax
@@ -213,92 +219,83 @@ Cons:	mov	$INDEX,%bx
 Bind:	test	%di,%di
 	je	1f
 	push	%bp
-	mov	%sp,%bp
-	push	%dx
-	push	%dx
-	xchg	%si,%bx
-	and	$-2,%bx
+	and	$-2,%si
 	and	$-2,%di
-	mov	%di,-4(%bp)
-	mov	2(%bx),%si
+	mov	%di,%bp
+	push	%dx				# save no. 1
+	push	%si				# save no. 2
+	mov	2(%si),%si
 	mov	2(%di),%di
-	push	%bx				# save no. 1
 	call	Bind
-	pop	%bx				# rest no. 1
-	push	%ax				# save no. 2
-	mov	(%bx),%bx
-	mov	%bx,%di
-	mov	-2(%bp),%si
+	pop	%si				# rest no. 2
+	mov	(%si),%di
+	pop	%si				# rest no. 1
+	push	%ax				# save no. 3
 	call	Eval
-	mov	-4(%bp),%di
-	mov	(%di),%di
+	mov	%ds:(%bp),%di
 	xchg	%ax,%si
 	call	Cons
-	pop	%si				# rest no. 2
+	pop	%si				# rest no. 3
 	xchg	%ax,%di
-	leave
+	pop	%bp
 	jmp	Cons
 1:	xchg	%dx,%ax
 	ret
 
-EvalCdr:
-	mov	%dx,%di
-	mov	%bp,%si
-	call	Arg1
-	and	$-2,%ax
-	mov	%ax,%di
-	mov	2(%di),%ax
-	pop	%bp
-	ret
+PrintString:					# nul-terminated in si
+0:	lodsb					# don't clobber bp, bx
+	test	%al,%al
+	je	1f
+	call	PutChar
+	jmp	0b
+1:	ret
 
 ////////////////////////////////////////////////////////////////////////////////
 .text
 
-Cadr:	and	$-2,%di				# (object >> 1) * sizeof(word)
-	mov	2(%di),%di			# contents of decrement register
-	and	$-2,%di				# contents of address register
-	mov	(%di),%ax
-	ret
-
-Arg1:	call	Cadr
-	xchg	%ax,%di
-	jmp	Eval
-
 PrintObject:
-	push	%bp
-	mov	%di,%bp
 	test	$1,%di
-	setz	%al
+	jnz	1f
 	shr	%di
-	test	%al,%al
-	je	1f
-	add	$STR,%di
-	pop	%bp
+	lea	STR(%di),%si
 	jmp	PrintString
-1:	mov	$40,%di
+1:	push	%bx
+	mov	%di,%bx
+	mov	$40,%al
 	call	PutChar
-2:	mov	%bp,%bx
-	and	$-2,%bx
+2:	and	$-2,%bx
 	mov	(%bx),%di
 	call	PrintObject
-	mov	%bp,%bx
-	and	$-2,%bx
 	mov	2(%bx),%bx
-	mov	%bx,%bp
 	test	%bx,%bx
-	je	4f
+	jz	4f
 	test	$1,%bl
-	je	3f
-	mov	$0x20,%di
+	jz	3f
+	mov	$0x20,%al
 	call	PutChar
 	jmp	2b
-3:	mov	$kDot,%di
+3:	mov	$kDot,%si
 	call	PrintString
-	mov	%bp,%di
+	mov	%bx,%di
 	call	PrintObject
-4:	mov	$41,%di
-	pop	%bp
-	jmp	PutChar
+4:	pop	%bx
+	mov	$41,%al
+/	jmp	PutChar
+/	𝑠𝑙𝑖𝑑𝑒
+
+PutChar:push	%bx				# don't clobber bp,bx,di,si,cx
+	push	%bp				# original ibm pc scroll up bug
+	mov	$7,%bx				# normal mda/cga style page zero
+	mov	$0x0e,%ah			# teletype output al cp437
+	int	$0x10				# vidya service
+	pop	%bp				# preserves al
+	pop	%bx
+	ret
+
+Arg1:	call	Cadr
+	xchg	%ax,%di
+/	jmp	Eval
+/	𝑠𝑙𝑖𝑑𝑒
 
 Eval:	push	%bp
 	mov	%di,%dx
@@ -314,27 +311,24 @@ Eval:	push	%bp
 	mov	(%bx),%ax
 	test	$1,%al
 	je	1f
-	mov	(%bx),%ax
-	and	$-2,%ax
-	mov	%ax,%di
-	mov	(%di),%ax
-	cmp	$ATOM_LAMBDA,%ax
+	mov	(%bx),%di
+	and	$-2,%di
+	cmp	$ATOM_LAMBDA,(%di)
 	jne	EvalUndefined
 	mov	2(%bx),%si
 	mov	(%bx),%di
 	push	%bx
 	call	Cadr
-	mov	%si,%si
-	mov	%ax,%di
+	xchg	%ax,%di
 	mov	%bp,%dx
 	call	Bind
-	mov	%ax,%bp
+	xchg	%ax,%bp
 	pop	%bx
 	mov	(%bx),%bx
 	mov	%bx,%di
 	and	$-2,%di
 	mov	2(%di),%di
-	jmp	8f
+	jmp	EvalCadrLoop
 1:	mov	(%bx),%ax
 	cmp	$ATOM_COND,%ax
 	je	EvalCond
@@ -355,7 +349,7 @@ Eval:	push	%bp
 	mov	2(%bx),%bx
 	mov	%bx,%di
 	call	Cadr
-	mov	%ax,%di
+	xchg	%ax,%di
 	mov	%bp,%si
 	call	Eval
 	mov	%bp,%si
@@ -365,14 +359,37 @@ Eval:	push	%bp
 	pop	%dx			# restore
 	cmp	%dx,%ax
 	jmp	3f
+EvalCdr:
+	mov	%dx,%di
+	mov	%bp,%si
+	call	Arg1
+	and	$-2,%ax
+	xchg	%ax,%di
+	mov	2(%di),%ax
+	pop	%bp
+	ret
+EvalCond:
+	mov	2(%bx),%bx
+	and	$-2,%bx
+	mov	(%bx),%di
+	and	$-2,%di
+	mov	(%di),%di
+	mov	%bp,%si
+	push	%bx				# save
+	call	Eval
+	pop	%bx				# restore
+	test	%ax,%ax
+	je	EvalCond
+	mov	(%bx),%di
+	jmp	EvalCadrLoop
 2:	cmp	$ATOM_CDR,%ax
 	je	EvalCdr
 	cmp	$ATOM_CONS,%ax
 	je	EvalCons
 	cmp	$ATOM_CAR,%ax
 	jne	EvalCall
-	mov	%bp,%si
 	mov	%dx,%di
+	mov	%bp,%si
 	call	Arg1
 	and	$-2,%ax
 	xchg	%ax,%di
@@ -387,78 +404,24 @@ EvalAtom:
 	je	9f
 	xor	%ax,%ax
 	jmp	9f
-EvalCond:
-	mov	2(%bx),%bx
-	mov	%bx,%bx
-	and	$-2,%bx
-	mov	(%bx),%di
-	push	%bx			# save
-	and	$-2,%di
-	mov	(%di),%di
-	mov	%bp,%si
-	call	Eval
-	test	%ax,%ax
-	pop	%bx			# restore
-	je	EvalCond
-	mov	(%bx),%bx
-	mov	%bx,%di
-	jmp	8f
 EvalCall:
 	mov	2(%bx),%cx
-	mov	(%bx),%bx
-	mov	%bx,%di
+	mov	(%bx),%di
 	mov	%bp,%si
 	call	Assoc
-	mov	%cx,%si
-	mov	%ax,%di
+	xchg	%cx,%si
+	xchg	%ax,%di
 	call	Cons
 	jmp	1f
-8:	call	Cadr
-1:	mov	%ax,%dx
+EvalCadrLoop:
+	call	Cadr
+1:	xchg	%ax,%dx
 	jmp	0b
 EvalUndefined:
 	mov	$UNDEFINED,%ax
 9:	pop	%bp
 	ret
 
-Intern:	push	%bp
-	xchg	%di,%bx
-	mov	$STR,%si
-0:	lodsb
-	test	%al,%al
-	je	4f
-	xor	%dx,%dx
-1:	mov	%dx,%bp
-	mov	%dx,%di
-	mov	(%bx,%di),%cl
-	cmp	%cl,%al
-	jne	3f
-	inc	%dx
-	test	%al,%al
-	jne	2f
-	mov	%bp,%cx
-	sub	%cx,%si
-	lea	-STR-1(%si),%ax
-	jmp	6f
-2:	lodsb
-	jmp	1b
-3:	test	%al,%al
-	je	0b
-	lodsb
-	jmp	3b
-4:	lea	-1(%si),%dx
-	mov	%dx,%di
-	xchg	%bx,%si
-0:	lodsb
-	stosb
-	test	%al,%al
-	jnz	0b
-	xchg	%dx,%ax
-	sub	$STR,%ax
-6:	shl	%ax
-	pop	%bp
-	ret
-
 ////////////////////////////////////////////////////////////////////////////////
 .section .rodata,"a",@progbits
 

start.S

@@ -42,4 +42,7 @@ _begin:	push	%cs				# memory model cs=ds=es = 0x600
 	xor	%dh,%dh				# drive dl head zero
 	mov	$0x0200+v_sectors,%ax		# read sectors
 	int	$0x13				# disk service
-	jmp	main
+/	𝑠𝑙𝑖𝑑𝑒
+
+	.section .yoink
+	nop	main