Sfoglia il codice sorgente

Shave another sixteen bytes (now 426 bytes)

The flag bit is now removed from atoms in favor of the sign bit.
That let us remove shifts. It also means NIL can be zero, which
freed up the %cx register. Using %cx to call Eval saved 2 bytes.
Saved six bytes removing bss memset as it's not needed anymore.
Justine Tunney 3 anni fa
parent
commit
814c61aeae
2 ha cambiato i file con 52 aggiunte e 76 eliminazioni
  1. 1 1
      Makefile
  2. 51 75
      sectorlisp.S

+ 1 - 1
Makefile

@@ -19,7 +19,7 @@ lisp.o: lisp.c bestline.h
 bestline.o: bestline.c bestline.h
 bestline.o: bestline.c bestline.h
 
 
 sectorlisp.o: sectorlisp.S
 sectorlisp.o: sectorlisp.S
-	$(AS) -g -mtune=i386 -o $@ $<
+	$(AS) -g -o $@ $<
 
 
 sectorlisp.bin.dbg: sectorlisp.o
 sectorlisp.bin.dbg: sectorlisp.o
 	$(LD) -oformat:binary -Ttext=0x0000 -o $@ $<
 	$(LD) -oformat:binary -Ttext=0x0000 -o $@ $<

+ 51 - 75
sectorlisp.S

@@ -22,21 +22,9 @@
 // LISP meta-circular evaluator in a MBR
 // LISP meta-circular evaluator in a MBR
 // Compatible with the original hardware
 // Compatible with the original hardware
 
 
-.set ATOM_NIL,		(kNil-kNil)<<1|1
-.set ATOM_QUOTE,	(kQuote-kNil)<<1|1
-.set ATOM_COND,		(kCond-kNil)<<1|1
-.set ATOM_ATOM,		(kAtom-kNil)<<1|1
-.set ATOM_CAR,		(kCar-kNil)<<1|1
-.set ATOM_CDR,		(kCdr-kNil)<<1|1
-.set ATOM_EQ,		(kEq-kNil)<<1|1
-.set ATOM_CONS,		(kCons-kNil)<<1|1
-.set ATOM_T,		(kT-kNil)<<1|1
-
-.set g_str,		0x0
 .set g_token,		%bp
 .set g_token,		%bp
 .set g_mem,		%bp
 .set g_mem,		%bp
-.set ZERO,		%ch
-.set ONE,		%cx
+.set ZERO,		%bh
 .set TWO,		%bx
 .set TWO,		%bx
 
 
 .section .text,"ax",@progbits
 .section .text,"ax",@progbits
@@ -49,8 +37,8 @@
 .type	kCdr,@object
 .type	kCdr,@object
 .type	kCons,@object
 .type	kCons,@object
 .type	kEq,@object
 .type	kEq,@object
-.type	begin,@function
 .type	start,@function
 .type	start,@function
+.type	begin,@function
 .globl	_start
 .globl	_start
 .code16
 .code16
 
 
@@ -58,37 +46,34 @@ _start:
 kNil:	.asciz	"NIL"				# dec %si ; dec %cx ; dec %sp
 kNil:	.asciz	"NIL"				# dec %si ; dec %cx ; dec %sp
 kT:	.asciz	"T"				# add %dl,(%si) boot A:\ DL=0
 kT:	.asciz	"T"				# add %dl,(%si) boot A:\ DL=0
 start:	ljmp	$0x7c00>>4,$begin		# cs = 0x7c00 is boot address
 start:	ljmp	$0x7c00>>4,$begin		# cs = 0x7c00 is boot address
-	.asciz	""				# x86 prog part of intern tab
+	.asciz	""
 kQuote:	.asciz	"QUOTE"
 kQuote:	.asciz	"QUOTE"
 kCond:	.asciz	"COND"
 kCond:	.asciz	"COND"
-kAtom:	.asciz	"ATOM"
-kCar:	.asciz	"CAR"
-kCdr:	.asciz	"CDR"
-kCons:	.asciz	"CONS"
+kAtom:	.asciz	"ATOM"				# ordering matters
+kCar:	.asciz	"CAR"				# ordering matters
+kCdr:	.asciz	"CDR"				# ordering matters
+kCons:	.asciz	"CONS"				# ordering matters
 kEq:	.asciz	"EQ"				# needs to be last
 kEq:	.asciz	"EQ"				# needs to be last
-begin:	push	%cs				# memory model ds=es=ss=cs
+
+begin:	xor	%ax,%ax
+	push	%cs				# memory model ds=es=ss=cs
 	pop	%ds
 	pop	%ds
 	push	%cs
 	push	%cs
 	pop	%es
 	pop	%es
-	mov	$0x8000,%cx
-	mov	%cx,g_mem
-	mov	%cx,%di
-	xor	%ax,%ax
-	cld					# clear direction flag
-	rep stosb				# memset(0x8000,0,0x8000)
-	push	%ds				# cx is now zero
+	push	%cs
 	cli					# disable interrupts
 	cli					# disable interrupts
 	pop	%ss				# disable nonmaskable interrupts
 	pop	%ss				# disable nonmaskable interrupts
 	mov	%ax,%sp				# use null pointer as our stack
 	mov	%ax,%sp				# use null pointer as our stack
 	sti					# enable interrupts
 	sti					# enable interrupts
-	inc	ONE				# ++cx
-	mov	ONE,TWO
-	inc	TWO
+	mov	$2,TWO
+	mov	$Eval,%cx
+	mov	$0x8000,g_mem
 main:	mov	$'\n',%dl
 main:	mov	$'\n',%dl
 	call	GetToken
 	call	GetToken
 	call	GetObject
 	call	GetObject
-	mov	ONE,%dx				# dx = NIL
-	call	Eval
+	xor	%dx,%dx
+	call	*%cx				# call Eval
+	xchg	%ax,%di
 	call	PrintObject
 	call	PrintObject
 	mov	$'\r',%al
 	mov	$'\r',%al
 	call	PutChar
 	call	PutChar
@@ -116,19 +101,14 @@ GetToken:					# GetToken():al, dl is g_look
 
 
 .PutObject:					# .PutObject(c:al,x:di)
 .PutObject:					# .PutObject(c:al,x:di)
 	call	PutChar				# preserves di
 	call	PutChar				# preserves di
-	xchg	%di,%ax
-#	jmp	PrintObject
-
-PrintObject:					# PrintObject(x:ax)
-	test	$1,%al
-	xchg	%ax,%di
-	jz	.PrintList
+PrintObject:					# PrintObject(x:di)
+	test	%di,%di				# set sf=1 if cons
+	js	.PrintList			# jump if cons
 .PrintAtom:
 .PrintAtom:
-	shr	%di
 	mov	%di,%si				# lea g_str(%di),%si
 	mov	%di,%si				# lea g_str(%di),%si
 .PrintString:					# nul-terminated in si
 .PrintString:					# nul-terminated in si
 	lodsb
 	lodsb
-	test	%al,%al
+	test	%al,%al				# test for nul terminator
 	jz	.ret				# -> ret
 	jz	.ret				# -> ret
 	call	PutChar
 	call	PutChar
 	jmp	.PrintString
 	jmp	.PrintString
@@ -138,12 +118,11 @@ PrintObject:					# PrintObject(x:ax)
 	mov	(%di),%di			# di = Car(x)
 	mov	(%di),%di			# di = Car(x)
 	call	.PutObject
 	call	.PutObject
 	pop	%ax				# restore 1
 	pop	%ax				# restore 1
-	cmp	ONE,%ax
-	je	4f
-	test	$1,%al
+	test	%ax,%ax
+	jz	4f				# jump if nil
 	xchg	%ax,%di
 	xchg	%ax,%di
 	mov	$' ',%al
 	mov	$' ',%al
-	jz	2b
+	js	2b				# jump if cons
 	mov	$249,%al			# bullet (A∙B)
 	mov	$249,%al			# bullet (A∙B)
 	call	.PutObject
 	call	.PutObject
 4:	mov	$')',%al
 4:	mov	$')',%al
@@ -174,9 +153,6 @@ GetObject:					# called just after GetToken
 	scasb
 	scasb
 	jnz	4b
 	jnz	4b
 5:	pop	%ax				# restore 1
 5:	pop	%ax				# restore 1
-//	add	$-g_str,%ax
-	add	%ax,%ax				# ax = 2 * ax
-	inc	%ax				# + 1
 .ret:	ret
 .ret:	ret
 
 
 GetChar:
 GetChar:
@@ -196,8 +172,8 @@ PutChar:
 
 
 ////////////////////////////////////////////////////////////////////////////////
 ////////////////////////////////////////////////////////////////////////////////
 
 
-Pairlis:cmp	ONE,%di				# Pairlis(x:di,y:si,a:dx):ax
-	je	1f				# it's zip() basically
+Pairlis:test	%di,%di				# Pairlis(x:di,y:si,a:dx):ax
+	jz	1f				# jump if nil
 	push	(TWO,%di)			# save 1 Cdr(x)
 	push	(TWO,%di)			# save 1 Cdr(x)
 	lodsw
 	lodsw
 	push	(%si)				# save 2 Cdr(y)
 	push	(%si)				# save 2 Cdr(y)
@@ -212,12 +188,12 @@ Pairlis:cmp	ONE,%di				# Pairlis(x:di,y:si,a:dx):ax
 1:	xchg	%dx,%ax
 1:	xchg	%dx,%ax
 	ret
 	ret
 
 
-Evlis:	cmp	ONE,%di				# Evlis(m:di,a:dx):ax
-	je	1f
+Evlis:	test	%di,%di				# Evlis(m:di,a:dx):ax
+	jz	1f				# jump if nil
 	push	(TWO,%di)			# save 1 Cdr(m)
 	push	(TWO,%di)			# save 1 Cdr(m)
 	mov	(%di),%ax
 	mov	(%di),%ax
 	push	%dx				# save a
 	push	%dx				# save a
-	call	Eval
+	call	*%cx				# call Eval
 	pop	%dx				# restore a
 	pop	%dx				# restore a
 	pop	%di				# restore 1
 	pop	%di				# restore 1
 	push	%ax				# save 2
 	push	%ax				# save 2
@@ -247,23 +223,23 @@ Evcon:	push	%di				# save c
 	mov	(%di),%si			# di = Car(c)
 	mov	(%di),%si			# di = Car(c)
 	lodsw					# ax = Caar(c)
 	lodsw					# ax = Caar(c)
 	push	%dx				# save a
 	push	%dx				# save a
-	call	Eval
+	call	*%cx				# call Eval
 	pop	%dx				# restore a
 	pop	%dx				# restore a
 	pop	%di				# restore c
 	pop	%di				# restore c
-	cmp	ONE,%ax
+	test	%ax,%ax				# nil test
 	jz	1b
 	jz	1b
 	mov	(%di),%di			# di = Car(c)
 	mov	(%di),%di			# di = Car(c)
 .EvCadr:call	Cadr				# ax = Cadar(c)
 .EvCadr:call	Cadr				# ax = Cadar(c)
 #	jmp	Eval
 #	jmp	Eval
 
 
-Eval:	test	$1,%al				# Eval(e:ax,a:dx):ax
-	jnz	Assoc				# lookup val if atom
+Eval:	test	%ax,%ax				# Eval(e:ax,a:dx):ax
+	jns	Assoc				# lookup val if atom
 	xchg	%ax,%si				# di = e
 	xchg	%ax,%si				# di = e
 	lodsw					# ax = Car(e)
 	lodsw					# ax = Car(e)
-	cmp	$ATOM_QUOTE,%ax			# maybe CONS
+	cmp	$kQuote,%ax			# maybe CONS
 	mov	(%si),%di			# di = Cdr(e)
 	mov	(%si),%di			# di = Cdr(e)
 	je	Car
 	je	Car
-	cmp	$ATOM_COND,%ax
+	cmp	$kCond,%ax
 	je	Evcon
 	je	Evcon
 .Ldflt2:push	%ax				# save 2
 .Ldflt2:push	%ax				# save 2
 	call	Evlis				# preserves dx
 	call	Evlis				# preserves dx
@@ -271,8 +247,8 @@ Eval:	test	$1,%al				# Eval(e:ax,a:dx):ax
 	pop	%ax				# restore 2
 	pop	%ax				# restore 2
 #	jmp	Apply
 #	jmp	Apply
 
 
-Apply:	test	$1,%al				# Apply(fn:ax,x:si:a:dx):ax
-	jnz	.switch
+Apply:	test	%ax,%ax				# Apply(fn:ax,x:si:a:dx):ax
+	jns	.switch				# jump if atom
 	xchg	%ax,%di				# di = fn
 	xchg	%ax,%di				# di = fn
 .lambda:mov	(TWO,%di),%di			# di = Cdr(fn)
 .lambda:mov	(TWO,%di),%di			# di = Cdr(fn)
 	push	%di				# save 1
 	push	%di				# save 1
@@ -281,30 +257,30 @@ Apply:	test	$1,%al				# Apply(fn:ax,x:si:a:dx):ax
 	xchg	%ax,%dx
 	xchg	%ax,%dx
 	pop	%di				# restore 1
 	pop	%di				# restore 1
 	jmp	.EvCadr
 	jmp	.EvCadr
-.ifCons:cmp	$ATOM_CONS,%al
+.ifCons:cmp	$kCons,%al
 	mov	(TWO,%si),%si			# si = Cdr(x)
 	mov	(TWO,%si),%si			# si = Cdr(x)
 	lodsw					# si = Cadr(x)
 	lodsw					# si = Cadr(x)
 	je	Cons
 	je	Cons
-.isEq:	cmp	%di,%ax
+.isEq:	cmp	%di,%ax				# we know for certain it's eq
 	jne	.retF
 	jne	.retF
-.retT:	mov	$ATOM_T,%al			# ax = ATOM_T
+.retT:	mov	$kT,%ax
 	ret
 	ret
-.switch:cmp	$ATOM_EQ,%ax			# eq is last builtin atom
+.switch:cmp	$kEq,%ax			# eq is last builtin atom
 	ja	.dflt1				# ah is zero if not above
 	ja	.dflt1				# ah is zero if not above
 	mov	(%si),%di			# di = Car(x)
 	mov	(%si),%di			# di = Car(x)
-.ifCar:	cmp	$ATOM_CAR,%al
+.ifCar:	cmp	$kCar,%al
 	je	Car
 	je	Car
-.ifCdr:	cmp	$ATOM_CDR,%al
+.ifCdr:	cmp	$kCdr,%al
 	je	Cdr
 	je	Cdr
-.ifAtom:cmp	$ATOM_ATOM,%al
+.ifAtom:cmp	$kAtom,%al
 	jne	.ifCons
 	jne	.ifCons
-	test	ONE,%di
-	jnz	.retT
-.retF:	mov	ONE,%ax				# ax = ATOM_NIL
+	test	%di,%di				# test if atom
+	jns	.retT
+.retF:	xor	%ax,%ax				# ax = nil
 	ret
 	ret
 .dflt1:	push	%si				# save x
 .dflt1:	push	%si				# save x
 	push	%dx				# save a
 	push	%dx				# save a
-	call	Eval
+	call	*%cx				# call Eval
 	pop	%dx				# restore a
 	pop	%dx				# restore a
 	pop	%si				# restore x
 	pop	%si				# restore x
 	jmp	Apply
 	jmp	Apply
@@ -316,9 +292,9 @@ Car:	mov	(%di),%ax			# contents of address register!!
 	ret
 	ret
 
 
 .Assoc:	mov	(TWO,%si),%dx			# dx = Cdr(y)
 .Assoc:	mov	(TWO,%si),%dx			# dx = Cdr(y)
-Assoc:	cmp	ONE,%dx				# Assoc(x:ax,y:dx):ax
-	mov	%dx,%si
-	je	.retF
+Assoc:	mov	%dx,%si				# Assoc(x:ax,y:dx):ax
+	test	%dx,%dx				# nil test
+	jz	.retF
 	mov	(%si),%di			# bx = Car(y)
 	mov	(%si),%di			# bx = Car(y)
 	cmp	%ax,(%di)			# (%di) = Caar(y)
 	cmp	%ax,(%di)			# (%di) = Caar(y)
 	jne	.Assoc
 	jne	.Assoc