From 49c538778a29881f33a8ddf21d07df889c0ee2bf Mon Sep 17 00:00:00 2001 From: Justine Tunney Date: Tue, 16 Nov 2021 06:54:47 -0800 Subject: [PATCH] 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. --- sectorlisp.S | 107 +++++++++++++++++++++++++++------------------------ 1 file changed, 57 insertions(+), 50 deletions(-) diff --git a/sectorlisp.S b/sectorlisp.S index 5fec6bd..891bc0d 100644 --- a/sectorlisp.S +++ b/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