mirror of
https://github.com/samsonjs/sectorlisp.git
synced 2026-03-30 09:55:45 +00:00
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
parent
a8f04bc73f
commit
814c61aeae
2 changed files with 52 additions and 76 deletions
2
Makefile
2
Makefile
|
|
@ -19,7 +19,7 @@ lisp.o: lisp.c bestline.h
|
|||
bestline.o: bestline.c bestline.h
|
||||
|
||||
sectorlisp.o: sectorlisp.S
|
||||
$(AS) -g -mtune=i386 -o $@ $<
|
||||
$(AS) -g -o $@ $<
|
||||
|
||||
sectorlisp.bin.dbg: sectorlisp.o
|
||||
$(LD) -oformat:binary -Ttext=0x0000 -o $@ $<
|
||||
|
|
|
|||
126
sectorlisp.S
126
sectorlisp.S
|
|
@ -22,21 +22,9 @@
|
|||
// LISP meta-circular evaluator in a MBR
|
||||
// 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_mem, %bp
|
||||
.set ZERO, %ch
|
||||
.set ONE, %cx
|
||||
.set ZERO, %bh
|
||||
.set TWO, %bx
|
||||
|
||||
.section .text,"ax",@progbits
|
||||
|
|
@ -49,8 +37,8 @@
|
|||
.type kCdr,@object
|
||||
.type kCons,@object
|
||||
.type kEq,@object
|
||||
.type begin,@function
|
||||
.type start,@function
|
||||
.type begin,@function
|
||||
.globl _start
|
||||
.code16
|
||||
|
||||
|
|
@ -58,37 +46,34 @@ _start:
|
|||
kNil: .asciz "NIL" # dec %si ; dec %cx ; dec %sp
|
||||
kT: .asciz "T" # add %dl,(%si) boot A:\ DL=0
|
||||
start: ljmp $0x7c00>>4,$begin # cs = 0x7c00 is boot address
|
||||
.asciz "" # x86 prog part of intern tab
|
||||
.asciz ""
|
||||
kQuote: .asciz "QUOTE"
|
||||
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
|
||||
begin: push %cs # memory model ds=es=ss=cs
|
||||
|
||||
begin: xor %ax,%ax
|
||||
push %cs # memory model ds=es=ss=cs
|
||||
pop %ds
|
||||
push %cs
|
||||
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
|
||||
pop %ss # disable nonmaskable interrupts
|
||||
mov %ax,%sp # use null pointer as our stack
|
||||
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
|
||||
call GetToken
|
||||
call GetObject
|
||||
mov ONE,%dx # dx = NIL
|
||||
call Eval
|
||||
xor %dx,%dx
|
||||
call *%cx # call Eval
|
||||
xchg %ax,%di
|
||||
call PrintObject
|
||||
mov $'\r',%al
|
||||
call PutChar
|
||||
|
|
@ -116,19 +101,14 @@ GetToken: # GetToken():al, dl is g_look
|
|||
|
||||
.PutObject: # .PutObject(c:al,x: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:
|
||||
shr %di
|
||||
mov %di,%si # lea g_str(%di),%si
|
||||
.PrintString: # nul-terminated in si
|
||||
lodsb
|
||||
test %al,%al
|
||||
test %al,%al # test for nul terminator
|
||||
jz .ret # -> ret
|
||||
call PutChar
|
||||
jmp .PrintString
|
||||
|
|
@ -138,12 +118,11 @@ PrintObject: # PrintObject(x:ax)
|
|||
mov (%di),%di # di = Car(x)
|
||||
call .PutObject
|
||||
pop %ax # restore 1
|
||||
cmp ONE,%ax
|
||||
je 4f
|
||||
test $1,%al
|
||||
test %ax,%ax
|
||||
jz 4f # jump if nil
|
||||
xchg %ax,%di
|
||||
mov $' ',%al
|
||||
jz 2b
|
||||
js 2b # jump if cons
|
||||
mov $249,%al # bullet (A∙B)
|
||||
call .PutObject
|
||||
4: mov $')',%al
|
||||
|
|
@ -174,9 +153,6 @@ GetObject: # called just after GetToken
|
|||
scasb
|
||||
jnz 4b
|
||||
5: pop %ax # restore 1
|
||||
// add $-g_str,%ax
|
||||
add %ax,%ax # ax = 2 * ax
|
||||
inc %ax # + 1
|
||||
.ret: ret
|
||||
|
||||
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)
|
||||
lodsw
|
||||
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
|
||||
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)
|
||||
mov (%di),%ax
|
||||
push %dx # save a
|
||||
call Eval
|
||||
call *%cx # call Eval
|
||||
pop %dx # restore a
|
||||
pop %di # restore 1
|
||||
push %ax # save 2
|
||||
|
|
@ -247,23 +223,23 @@ Evcon: push %di # save c
|
|||
mov (%di),%si # di = Car(c)
|
||||
lodsw # ax = Caar(c)
|
||||
push %dx # save a
|
||||
call Eval
|
||||
call *%cx # call Eval
|
||||
pop %dx # restore a
|
||||
pop %di # restore c
|
||||
cmp ONE,%ax
|
||||
test %ax,%ax # nil test
|
||||
jz 1b
|
||||
mov (%di),%di # di = Car(c)
|
||||
.EvCadr:call Cadr # ax = Cadar(c)
|
||||
# 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
|
||||
lodsw # ax = Car(e)
|
||||
cmp $ATOM_QUOTE,%ax # maybe CONS
|
||||
cmp $kQuote,%ax # maybe CONS
|
||||
mov (%si),%di # di = Cdr(e)
|
||||
je Car
|
||||
cmp $ATOM_COND,%ax
|
||||
cmp $kCond,%ax
|
||||
je Evcon
|
||||
.Ldflt2:push %ax # save 2
|
||||
call Evlis # preserves dx
|
||||
|
|
@ -271,8 +247,8 @@ Eval: test $1,%al # Eval(e:ax,a:dx):ax
|
|||
pop %ax # restore 2
|
||||
# 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
|
||||
.lambda:mov (TWO,%di),%di # di = Cdr(fn)
|
||||
push %di # save 1
|
||||
|
|
@ -281,30 +257,30 @@ Apply: test $1,%al # Apply(fn:ax,x:si:a:dx):ax
|
|||
xchg %ax,%dx
|
||||
pop %di # restore 1
|
||||
jmp .EvCadr
|
||||
.ifCons:cmp $ATOM_CONS,%al
|
||||
.ifCons:cmp $kCons,%al
|
||||
mov (TWO,%si),%si # si = Cdr(x)
|
||||
lodsw # si = Cadr(x)
|
||||
je Cons
|
||||
.isEq: cmp %di,%ax
|
||||
.isEq: cmp %di,%ax # we know for certain it's eq
|
||||
jne .retF
|
||||
.retT: mov $ATOM_T,%al # ax = ATOM_T
|
||||
.retT: mov $kT,%ax
|
||||
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
|
||||
mov (%si),%di # di = Car(x)
|
||||
.ifCar: cmp $ATOM_CAR,%al
|
||||
.ifCar: cmp $kCar,%al
|
||||
je Car
|
||||
.ifCdr: cmp $ATOM_CDR,%al
|
||||
.ifCdr: cmp $kCdr,%al
|
||||
je Cdr
|
||||
.ifAtom:cmp $ATOM_ATOM,%al
|
||||
.ifAtom:cmp $kAtom,%al
|
||||
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
|
||||
.dflt1: push %si # save x
|
||||
push %dx # save a
|
||||
call Eval
|
||||
call *%cx # call Eval
|
||||
pop %dx # restore a
|
||||
pop %si # restore x
|
||||
jmp Apply
|
||||
|
|
@ -316,9 +292,9 @@ Car: mov (%di),%ax # contents of address register!!
|
|||
ret
|
||||
|
||||
.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)
|
||||
cmp %ax,(%di) # (%di) = Caar(y)
|
||||
jne .Assoc
|
||||
|
|
|
|||
Loading…
Reference in a new issue