Browse Source

Shave another byte and improve asm readability

This changes fixes an issue where clearing the bss could overlap
the stack memory used in the early initialization code.

This change fixes a regression caused by an earlier commit with
nul terminators. Builtins are now automatically numbered.

Comments have been added and labels have been redefined to add
further clarity to how the assembly works. The most beautiful of
which is the code that merges Cadr, Cdr, and Car into one func.
Justine Tunney 3 years ago
parent
commit
49c538778a
1 changed files with 57 additions and 50 deletions
  1. 57 50
      sectorlisp.S

+ 57 - 50
sectorlisp.S

@@ -22,20 +22,20 @@
 // LISP meta-circular evaluator in a MBR
 
 .set ONE,		%bp
-.set NIL,		1
-.set ATOM_T,		9
-.set ATOM_QUOTE,	23
-.set ATOM_COND,		35
-.set ATOM_ATOM,		45
-.set ATOM_CAR,		55
-.set ATOM_CDR,		63
-.set ATOM_CONS,		71
-.set ATOM_EQ,		81
+.set ATOM_NIL,		(kNil-kSymbols)<<1|1
+.set ATOM_QUOTE,	(kQuote-kSymbols)<<1|1
+.set ATOM_COND,		(kCond-kSymbols)<<1|1
+.set ATOM_ATOM,		(kAtom-kSymbols)<<1|1
+.set ATOM_CAR,		(kCar-kSymbols)<<1|1
+.set ATOM_CDR,		(kCdr-kSymbols)<<1|1
+.set ATOM_EQ,		(kEq-kSymbols)<<1|1
+.set ATOM_CONS,		(kCons-kSymbols)<<1|1
+.set ATOM_T,		(kT-kSymbols)<<1|1
 
-.set g_token,	0x7800
-.set g_str,	0x0
-.set g_mem,	0x8000
-.set boot,	0x7c00
+.set g_str,		0x0
+.set g_token,		0x7800
+.set boot,		0x7c00
+.set g_mem,		0x8000
 
 ////////////////////////////////////////////////////////////////////////////////
 // Currently requires i386+ in real mode
@@ -43,32 +43,41 @@
 // Quoth xed -r -isa-set -i sectorlisp.o
 
 .section .text,"ax",@progbits
+.type	kSymbols,@object
+.type	_begin,@function
 .globl	_start
 .code16
 
-_start:	
-.type kSymbols,@object;
+_start:
 kSymbols:
-	.ascii "NIL\0T\0"
-.type .init,@function
-.init:	ljmp	$0x7c00>>4,$_begin
-	.ascii "QUOTE\0COND\0ATOM\0CAR\0CDR\0CONS\0EQ\0"
-
+kNil:	.asciz	"NIL"				# dec %si ; dec %cx ; dec %sp
+kT:	.asciz	"T"				# add %dl,(%si) boot A:\ DL=0
+	ljmp	$0x7c00>>4,$_begin		# cs = 0x7c00 is boot address
+	.asciz	""				# x86 prog part of intern tab
+kQuote:	.asciz	"QUOTE"
+kCond:	.asciz	"COND"
+kAtom:	.asciz	"ATOM"
+kCar:	.asciz	"CAR"
+kCdr:	.asciz	"CDR"
+kCons:	.asciz	"CONS"
+kEq:	.asciz	"EQ"				# needs to be last
 _begin:	mov	$g_mem,%cx
 	mov	%cx,%fs				# fs = &g_mem
-	xor	%ax,%ax
 	mov	%cx,%di
-	push	%cs				# memory model cs=ds=es = 0x7c0
-	push	%cs
-	push	%cs
+	push	%cs				# memory model ds=es=ss=cs
 	pop	%ds
+	push	%cs
 	pop	%es
-	cld
-	rep stosb				# clears our bss memory
-	pop	%ss
-	mov	%cx,%sp
+	xor	%ax,%ax
+	cld					# clear direction flag
+	rep stosb				# memset(0x8000,0,0x8000)
+	push	%ds				# cx is now zero
+#	cli					# disable interrupts
+	pop	%ss				# disable nonmaskable interrupts
+	mov	%ax,%sp				# use null pointer as our stack
+#	sti					# enable interrupts
 	inc	%ax
-	xchg	%ax,ONE				# mov $NIL,ONE
+	xchg	%ax,ONE				# bp = 1
 main:	mov	$'\n',%dl
 	call	GetToken
 	call	GetObject
@@ -80,7 +89,7 @@ main:	mov	$'\n',%dl
 	jmp	main
 
 GetToken:					# GetToken():al, dl is g_look
-	mov	%fs,%di				# mov $g_token,%di
+	mov	%fs,%di				# di = g_token
 	mov	%di,%si
 1:	mov	%dl,%al
 	cmp	$' ',%al
@@ -138,7 +147,7 @@ GetObject:					# called just after GetToken
 	cmpb	$'(',%al
 	je	GetList
 .Intern:
-	xor	%di,%di				# mov $g_str,%di
+	xor	%di,%di				# di = g_str
 	xor	%al,%al
 0:	push	%di				# save 1
 1:	cmpsb
@@ -148,7 +157,7 @@ GetObject:					# called just after GetToken
 	jne	1b
 	jmp	5f
 2:	pop	%si				# drop 1
-	mov	%fs,%si				# mov $g_token,%si
+	mov	%fs,%si				# si = g_token
 3:	scasb
 	jne	3b
 	cmp	(%di),%al
@@ -159,7 +168,7 @@ GetObject:					# called just after GetToken
 	scasb
 	jnz	4b
 5:	pop	%ax				# restore 1
-#	add	$-g_str,%ax
+//	add	$-g_str,%ax
 	add	%ax,%ax				# ax = 2 * ax
 	inc	%ax				# + 1
 .ret:	ret
@@ -170,13 +179,11 @@ GetChar:
 						# ah is bios scancode
 						# al is ascii character
 PutChar:
-#	push	%bx				# don't clobber di,si,cx,dx
 #	push	%bp				# original ibm pc scroll up bug
 	xor	%bx,%bx				# normal mda/cga style page zero
 	mov	$0x0e,%ah			# teletype output al cp437
 	int	$0x10				# vidya service
 #	pop	%bp				# preserves al
-#	pop	%bx
 	cmp	$'\r',%al			# don't clobber stuff
 	jne	.ret
 	mov	$'\n',%al
@@ -250,12 +257,12 @@ Evcon:	push	%di				# save c
 #	jmp	Eval
 
 Eval:	test	$1,%al				# Eval(e:ax,a:dx):ax
-	jnz	Assoc
-	xchg	%ax,%di				# di = e
-	mov	(%di),%ax			# ax = Car(e)
+	jnz	Assoc				# lookup val if atom
+	xchg	%ax,%si				# di = e
+	lodsw					# ax = Car(e)
 	cmp	$ATOM_QUOTE,%ax			# maybe CONS
-	mov	2(%di),%di			# di = Cdr(e)
-	je	.retA
+	mov	(%si),%di			# di = Cdr(e)
+	je	Car
 	cmp	$ATOM_COND,%ax
 	je	Evcon
 .Ldflt2:push	%ax				# save 2
@@ -282,18 +289,18 @@ Apply:	test	$1,%al				# Apply(fn:ax,x:si:a:dx):ax
 	jne	.retF
 .retT:	mov	$ATOM_T,%al			# ax = ATOM_T
 	ret
-.switch:cmp	$ATOM_EQ,%ax
-	ja	.dflt1
+.switch:cmp	$ATOM_EQ,%ax			# eq is last builtin atom
+	ja	.dflt1				# ah is zero if not above
 	mov	(%si),%di			# di = Car(x)
 .ifCar:	cmp	$ATOM_CAR,%al
-	je	.retA
+	je	Car
 .ifCdr:	cmp	$ATOM_CDR,%al
-	je	.retD
+	je	Cdr
 .ifAtom:cmp	$ATOM_ATOM,%al
 	jne	.ifCons
 	test	ONE,%di
 	jnz	.retT
-.retF:	mov	ONE,%ax				# ax = NIL
+.retF:	mov	ONE,%ax				# ax = ATOM_NIL
 	ret
 .dflt1:	push	%si				# save x
 	push	%dx				# save a
@@ -303,18 +310,18 @@ Apply:	test	$1,%al				# Apply(fn:ax,x:si:a:dx):ax
 	jmp	Apply
 
 Cadr:	mov	2(%di),%di			# contents of decrement register
-	.byte	0x3C				# mask next byte
-.retD:	scasw
-.retA:	mov	(%di),%ax			# contents of address register
+	.byte	0x3C				# cmp §scasw,%al (nop next byte)
+Cdr:	scasw					# increments our data index by 2
+Car:	mov	(%di),%ax			# contents of address register!!
 	ret
 
-1:	mov	2(%si),%dx			# dx = Cdr(y)
+.Assoc:	mov	2(%si),%dx			# dx = Cdr(y)
 Assoc:	cmp	ONE,%dx				# Assoc(x:ax,y:dx):ax
 	mov	%dx,%si
 	je	.retF
 	mov	(%si),%bx			# bx = Car(y)
 	cmp	%ax,(%bx)			# (%bx) = Caar(y)
-	jne	1b
+	jne	.Assoc
 	mov	2(%bx),%ax			# ax = Cdar(y)
 	ret