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 2021-11-16 06:54:47 -08:00
parent 532b92688e
commit 49c538778a

View file

@ -22,20 +22,20 @@
// LISP meta-circular evaluator in a MBR // LISP meta-circular evaluator in a MBR
.set ONE, %bp .set ONE, %bp
.set NIL, 1 .set ATOM_NIL, (kNil-kSymbols)<<1|1
.set ATOM_T, 9 .set ATOM_QUOTE, (kQuote-kSymbols)<<1|1
.set ATOM_QUOTE, 23 .set ATOM_COND, (kCond-kSymbols)<<1|1
.set ATOM_COND, 35 .set ATOM_ATOM, (kAtom-kSymbols)<<1|1
.set ATOM_ATOM, 45 .set ATOM_CAR, (kCar-kSymbols)<<1|1
.set ATOM_CAR, 55 .set ATOM_CDR, (kCdr-kSymbols)<<1|1
.set ATOM_CDR, 63 .set ATOM_EQ, (kEq-kSymbols)<<1|1
.set ATOM_CONS, 71 .set ATOM_CONS, (kCons-kSymbols)<<1|1
.set ATOM_EQ, 81 .set ATOM_T, (kT-kSymbols)<<1|1
.set g_token, 0x7800
.set g_str, 0x0 .set g_str, 0x0
.set g_mem, 0x8000 .set g_token, 0x7800
.set boot, 0x7c00 .set boot, 0x7c00
.set g_mem, 0x8000
//////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////
// Currently requires i386+ in real mode // Currently requires i386+ in real mode
@ -43,32 +43,41 @@
// Quoth xed -r -isa-set -i sectorlisp.o // Quoth xed -r -isa-set -i sectorlisp.o
.section .text,"ax",@progbits .section .text,"ax",@progbits
.type kSymbols,@object
.type _begin,@function
.globl _start .globl _start
.code16 .code16
_start: _start:
.type kSymbols,@object;
kSymbols: kSymbols:
.ascii "NIL\0T\0" kNil: .asciz "NIL" # dec %si ; dec %cx ; dec %sp
.type .init,@function kT: .asciz "T" # add %dl,(%si) boot A:\ DL=0
.init: ljmp $0x7c00>>4,$_begin ljmp $0x7c00>>4,$_begin # cs = 0x7c00 is boot address
.ascii "QUOTE\0COND\0ATOM\0CAR\0CDR\0CONS\0EQ\0" .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 _begin: mov $g_mem,%cx
mov %cx,%fs # fs = &g_mem mov %cx,%fs # fs = &g_mem
xor %ax,%ax
mov %cx,%di mov %cx,%di
push %cs # memory model cs=ds=es = 0x7c0 push %cs # memory model ds=es=ss=cs
push %cs
push %cs
pop %ds pop %ds
push %cs
pop %es pop %es
cld xor %ax,%ax
rep stosb # clears our bss memory cld # clear direction flag
pop %ss rep stosb # memset(0x8000,0,0x8000)
mov %cx,%sp 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 inc %ax
xchg %ax,ONE # mov $NIL,ONE xchg %ax,ONE # bp = 1
main: mov $'\n',%dl main: mov $'\n',%dl
call GetToken call GetToken
call GetObject call GetObject
@ -80,7 +89,7 @@ main: mov $'\n',%dl
jmp main jmp main
GetToken: # GetToken():al, dl is g_look GetToken: # GetToken():al, dl is g_look
mov %fs,%di # mov $g_token,%di mov %fs,%di # di = g_token
mov %di,%si mov %di,%si
1: mov %dl,%al 1: mov %dl,%al
cmp $' ',%al cmp $' ',%al
@ -138,7 +147,7 @@ GetObject: # called just after GetToken
cmpb $'(',%al cmpb $'(',%al
je GetList je GetList
.Intern: .Intern:
xor %di,%di # mov $g_str,%di xor %di,%di # di = g_str
xor %al,%al xor %al,%al
0: push %di # save 1 0: push %di # save 1
1: cmpsb 1: cmpsb
@ -148,7 +157,7 @@ GetObject: # called just after GetToken
jne 1b jne 1b
jmp 5f jmp 5f
2: pop %si # drop 1 2: pop %si # drop 1
mov %fs,%si # mov $g_token,%si mov %fs,%si # si = g_token
3: scasb 3: scasb
jne 3b jne 3b
cmp (%di),%al cmp (%di),%al
@ -159,7 +168,7 @@ 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 $-g_str,%ax
add %ax,%ax # ax = 2 * ax add %ax,%ax # ax = 2 * ax
inc %ax # + 1 inc %ax # + 1
.ret: ret .ret: ret
@ -170,13 +179,11 @@ GetChar:
# ah is bios scancode # ah is bios scancode
# al is ascii character # al is ascii character
PutChar: PutChar:
# push %bx # don't clobber di,si,cx,dx
# push %bp # original ibm pc scroll up bug # push %bp # original ibm pc scroll up bug
xor %bx,%bx # normal mda/cga style page zero xor %bx,%bx # normal mda/cga style page zero
mov $0x0e,%ah # teletype output al cp437 mov $0x0e,%ah # teletype output al cp437
int $0x10 # vidya service int $0x10 # vidya service
# pop %bp # preserves al # pop %bp # preserves al
# pop %bx
cmp $'\r',%al # don't clobber stuff cmp $'\r',%al # don't clobber stuff
jne .ret jne .ret
mov $'\n',%al mov $'\n',%al
@ -250,12 +257,12 @@ Evcon: push %di # save c
# jmp Eval # jmp Eval
Eval: test $1,%al # Eval(e:ax,a:dx):ax Eval: test $1,%al # Eval(e:ax,a:dx):ax
jnz Assoc jnz Assoc # lookup val if atom
xchg %ax,%di # di = e xchg %ax,%si # di = e
mov (%di),%ax # ax = Car(e) lodsw # ax = Car(e)
cmp $ATOM_QUOTE,%ax # maybe CONS cmp $ATOM_QUOTE,%ax # maybe CONS
mov 2(%di),%di # di = Cdr(e) mov (%si),%di # di = Cdr(e)
je .retA je Car
cmp $ATOM_COND,%ax cmp $ATOM_COND,%ax
je Evcon je Evcon
.Ldflt2:push %ax # save 2 .Ldflt2:push %ax # save 2
@ -282,18 +289,18 @@ 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 .switch:cmp $ATOM_EQ,%ax # eq is last builtin atom
ja .dflt1 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 $ATOM_CAR,%al
je .retA je Car
.ifCdr: cmp $ATOM_CDR,%al .ifCdr: cmp $ATOM_CDR,%al
je .retD je Cdr
.ifAtom:cmp $ATOM_ATOM,%al .ifAtom:cmp $ATOM_ATOM,%al
jne .ifCons jne .ifCons
test ONE,%di test ONE,%di
jnz .retT jnz .retT
.retF: mov ONE,%ax # ax = NIL .retF: mov ONE,%ax # ax = ATOM_NIL
ret ret
.dflt1: push %si # save x .dflt1: push %si # save x
push %dx # save a push %dx # save a
@ -303,18 +310,18 @@ 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
.byte 0x3C # mask next byte .byte 0x3C # cmp §scasw,%al (nop next byte)
.retD: scasw Cdr: scasw # increments our data index by 2
.retA: mov (%di),%ax # contents of address register Car: mov (%di),%ax # contents of address register!!
ret 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 Assoc: cmp ONE,%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)
cmp %ax,(%bx) # (%bx) = Caar(y) cmp %ax,(%bx) # (%bx) = Caar(y)
jne 1b jne .Assoc
mov 2(%bx),%ax # ax = Cdar(y) mov 2(%bx),%ax # ax = Cdar(y)
ret ret