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.
This commit is contained in:
Justine Tunney 2021-11-17 07:59:19 -08:00
parent a8f04bc73f
commit 814c61aeae
2 changed files with 52 additions and 76 deletions

View file

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

View file

@ -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 ZERO, %bh
.set ONE, %cx
.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" kAtom: .asciz "ATOM" # ordering matters
kCar: .asciz "CAR" kCar: .asciz "CAR" # ordering matters
kCdr: .asciz "CDR" kCdr: .asciz "CDR" # ordering matters
kCons: .asciz "CONS" 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 push %cs
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
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 $2,TWO
mov ONE,TWO mov $Eval,%cx
inc TWO 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 xor %dx,%dx
call Eval 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 PrintObject: # PrintObject(x:di)
# jmp PrintObject test %di,%di # set sf=1 if cons
js .PrintList # jump if cons
PrintObject: # PrintObject(x:ax)
test $1,%al
xchg %ax,%di
jz .PrintList
.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 test %ax,%ax
je 4f jz 4f # jump if nil
test $1,%al
xchg %ax,%di xchg %ax,%di
mov $' ',%al mov $' ',%al
jz 2b js 2b # jump if cons
mov $249,%al # bullet (AB) mov $249,%al # bullet (AB)
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 Pairlis:test %di,%di # Pairlis(x:di,y:si,a:dx):ax
je 1f # it's zip() basically 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 Evlis: test %di,%di # Evlis(m:di,a:dx):ax
je 1f 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 Eval: test %ax,%ax # Eval(e:ax,a:dx):ax
jnz Assoc # lookup val if atom 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 Apply: test %ax,%ax # Apply(fn:ax,x:si:a:dx):ax
jnz .switch 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 test %di,%di # test if atom
jnz .retT jns .retT
.retF: mov ONE,%ax # ax = ATOM_NIL .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 Assoc: mov %dx,%si # Assoc(x:ax,y:dx):ax
mov %dx,%si test %dx,%dx # nil test
je .retF 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