mirror of
https://github.com/samsonjs/sectorlisp.git
synced 2026-03-25 09:05:48 +00:00
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.
This commit is contained in:
Justine Tunney
parent
532b92688e
commit
49c538778a
1 changed files with 57 additions and 50 deletions
107
sectorlisp.S
107
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
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue