sjs/sectorlisp
1
0
Fork 0
mirror of https://github.com/samsonjs/sectorlisp.git synced 2026-04-27 14:57:41 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

shave some bytes

Browse source
This commit is contained in:
Peter Ferrie 2021-11-02 12:14:10 -07:00
parent 1f066da3a1
commit adb7310d57
2 changed files with 30 additions and 38 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

BIN
bin/sectorlisp.bin
View file

Binary file not shown.

68
sectorlisp.S
View file

@ -52,7 +52,8 @@ _begin: push %cs # memory model cs=ds=es = 0x600
pop %ds pop %ds
pop %es pop %es
pop %ss pop %ss
mov $0x7c00-0x600,%cx mov $kSymbols,%si
mov %si,%cx
mov %cx,%sp mov %cx,%sp
cld cld
xor %ax,%ax xor %ax,%ax
@ -60,8 +61,7 @@ _begin: push %cs # memory model cs=ds=es = 0x600
xor %di,%di xor %di,%di
rep stosb # clears our bss memory rep stosb # clears our bss memory
main: mov $g_str,%di main: mov $g_str,%di
mov $kSymbols,%si mov $37,%cl
mov $37,%cx
rep movsb rep movsb
0: mov $'\n',%dl 0: mov $'\n',%dl
call GetToken call GetToken
@ -75,6 +75,7 @@ main: mov $g_str,%di
GetToken: # GetToken():al, dl is g_look GetToken: # GetToken():al, dl is g_look
mov $g_token,%di mov $g_token,%di
mov %di,%si
1: mov %dl,%al 1: mov %dl,%al
cmp $' ',%al cmp $' ',%al
jbe 2f jbe 2f
@ -95,7 +96,6 @@ GetToken: # GetToken():al, dl is g_look
GetObject: # called just after GetToken GetObject: # called just after GetToken
cmpb $'(',%al cmpb $'(',%al
je GetList je GetList
mov $g_token,%si
.Intern: .Intern:
mov $g_str,%di mov $g_str,%di
xor %al,%al xor %al,%al
@ -200,14 +200,13 @@ xCons: xchg %ax,%si
# jmp Cons # jmp Cons
Cons: xchg %di,%ax Cons: xchg %di,%ax
mov %fs,%di mov %fs,%di
push %di
stosw stosw
xchg %si,%ax xchg %si,%ax
stosw stosw
mov %di,%fs xchg %di,%ax
pop %ax mov %fs,%di
ret mov %ax,%fs
1: xchg %di,%ax xchg %di,%ax
ret ret
Pairlis:cmp $NIL,%di # Pairlis(x:di,y:si,a:dx):ax Pairlis:cmp $NIL,%di # Pairlis(x:di,y:si,a:dx):ax
@ -235,10 +234,9 @@ Evcon: push %di # save c
pop %dx # restore a pop %dx # restore a
pop %di # restore c pop %di # restore c
cmp $NIL,%ax cmp $NIL,%ax
jne 2f cmove 2(%di),%di # di = Cdr(c)
mov 2(%di),%di # di = Cdr(c) jz Evcon
jmp Evcon mov (%di),%di # di = Car(c)
2: mov (%di),%di # di = Car(c)
.EvCadr:call Cadr # ax = Cadar(c) .EvCadr:call Cadr # ax = Cadar(c)
# jmp Eval # jmp Eval
@ -247,8 +245,8 @@ Eval: test $1,%al # Eval(e:ax,a:dx):ax
xchg %ax,%di # di = e xchg %ax,%di # di = e
mov (%di),%ax # ax = Car(e) mov (%di),%ax # ax = Car(e)
cmp $ATOM_QUOTE,%ax # maybe CONS cmp $ATOM_QUOTE,%ax # maybe CONS
je Cadr
mov 2(%di),%di # di = Cdr(e) mov 2(%di),%di # di = Cdr(e)
je .retA
cmp $ATOM_COND,%ax cmp $ATOM_COND,%ax
je Evcon je Evcon
.Ldflt2:push %ax # save 2 .Ldflt2:push %ax # save 2
@ -267,23 +265,6 @@ 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
.switch:cmp $ATOM_EQ,%ax
ja .dflt1
mov (%si),%di # di = Car(x)
.ifCar: cmp $ATOM_CAR,%al
jne .ifCdr
mov (%di),%ax
ret
.ifCdr: cmp $ATOM_CDR,%al
jne .ifAtom
mov 2(%di),%ax
ret
.ifAtom:cmp $ATOM_ATOM,%al
jne .ifCons
test $1,%di
jnz .retT
.retF: mov $NIL,%ax # ax = NIL
ret
.ifCons:mov 2(%si),%si # si = Cdr(x) .ifCons:mov 2(%si),%si # si = Cdr(x)
mov (%si),%si # si = Cadr(x) mov (%si),%si # si = Cadr(x)
cmp $ATOM_CONS,%al cmp $ATOM_CONS,%al
@ -292,6 +273,20 @@ Apply: test $1,%al # Apply(fn:ax,x:si:a:dx):ax
jne .retF jne .retF
.retT: mov $ATOM_T,%al # ax = ATOM_T .retT: mov $ATOM_T,%al # ax = ATOM_T
ret ret
.switch:cmp $ATOM_EQ,%ax
ja .dflt1
mov (%si),%di # di = Car(x)
.ifCar: cmp $ATOM_CAR,%al
je .retA
.ifCdr: cmp $ATOM_CDR,%al
cmove 2(%di),%ax
je .retD
.ifAtom:cmp $ATOM_ATOM,%al
jne .ifCons
test $1,%di
jnz .retT
.retF: mov $NIL,%ax # ax = NIL
.retD: ret
.dflt1: push %si # save x .dflt1: push %si # save x
push %dx # save a push %dx # save a
call Eval call Eval
@ -300,19 +295,16 @@ Apply: test $1,%al # Apply(fn:ax,x:si:a:dx):ax
jmp Apply jmp Apply
Cadr: mov 2(%di),%di # contents of decrement register Cadr: mov 2(%di),%di # contents of decrement register
mov (%di),%ax # contents of address register .retA: mov (%di),%ax # contents of address register
ret ret
assoc1: mov 2(%si),%dx # dx = Cdr(y)
# jmp Assoc
Assoc: cmp $NIL,%dx # Assoc(x:ax,y:dx):ax Assoc: cmp $NIL,%dx # Assoc(x:ax,y:dx):ax
mov %dx,%si mov %dx,%si
je .retF je .retF
mov (%si),%bx # bx = Car(y) mov (%si),%bx # bx = Car(y)
mov (%bx),%cx # cx = Caar(y) cmp %ax,(%bx) # (%bx) = Caar(y)
cmp %cx,%ax cmovne 2(%si),%dx # dx = Cdr(y)
jne assoc1 jne Assoc
mov 2(%bx),%ax # ax = Cdar(y) mov 2(%bx),%ax # ax = Cdar(y)
ret ret