From bab9ebed18d507c045c1596654ca322382c40771 Mon Sep 17 00:00:00 2001 From: Justine Tunney Date: Tue, 23 Nov 2021 05:09:13 -0800 Subject: [PATCH] Do nothing on undefined variable (now 446 bytes) The only exception is NIL which has been added to the main Eval(). This change also inlines the ABC Garbage Collector for more speed. --- sectorlisp.S | 127 +++++++++++++++++++++++---------------------------- 1 file changed, 57 insertions(+), 70 deletions(-) diff --git a/sectorlisp.S b/sectorlisp.S index e6e095a..bfbfbef 100644 --- a/sectorlisp.S +++ b/sectorlisp.S @@ -36,23 +36,17 @@ kCdr: .asciz "CDR" # ordering matters kCons: .asciz "CONS" # ordering matters kEq: .asciz "EQ" # needs to be last -begin: xor %bx,%bx # we use the tiny memory model - push %cs # that means ss = ds = es = cs +begin: push %cs # that means ss = ds = es = cs pop %ds # noting ljmp set cs to 0x7c00 push %cs # that's the bios load address pop %es # therefore NULL points to NUL push %cs # terminated NIL string above! - #cli # disables hardware interrupts - pop %ss # disable nonmaskable ones too - mov %bx,%sp # use highest address as stack - #sti # reenable hardware interrupts - #cld # normalize the direction flag - inc %bx - inc %bx + pop %ss # errata exists but don't care + xor %sp,%sp # use highest address as stack + mov $2,%bx main: mov $0x8000,%cx # dl (g_look) is zero or cr call GetToken call GetObject - xor %dx,%dx call Eval xchg %ax,%si call PrintObject @@ -66,7 +60,7 @@ GetToken: # GetToken():al, dl is g_look cmp $' ',%al jbe 2f stosb - xchg %ax,%si + xchg %ax,%bp 2: call GetChar # exchanges dx and ax cmp $' ',%al jbe 1b @@ -75,7 +69,7 @@ GetToken: # GetToken():al, dl is g_look cmp $')',%dl # dl = g_look ja 1b 3: movb %bh,(%di) # bh is zero - xchg %si,%ax + xchg %bp,%ax ret .PutObject: # .PutObject(c:al,x:si) @@ -109,7 +103,8 @@ GetObject: # called just after GetToken cmpb $'(',%al je GetList .Intern: - xor %di,%di # di = g_str + mov %cx,%si + xor %di,%di xor %al,%al 0: push %di # save 1 1: cmpsb @@ -118,7 +113,7 @@ GetObject: # called just after GetToken scasb jne 1b jmp 5f -2: pop %si # drop 1 +2: pop %bp # drop 1 mov %cx,%si 3: scasb jne 3b @@ -169,17 +164,14 @@ Evlis: test %di,%di # Evlis(m:di,a:dx):ax # jmp xCons xCons: pop %di # restore 2 -Cons: xchg %ax,%si # Cons(m:di,a:ax):ax - xchg %di,%ax - mov %cx,%di - stosw - xchg %si,%ax - stosw - xchg %di,%cx +Cons: xchg %di,%cx # Cons(m:di,a:ax):ax + mov %cx,(%di) + mov %ax,(%bx,%di) + lea 4(%di),%cx 1: xchg %di,%ax ret -Gc: cmp %dx,%di # Gc(x:di,mark:dx,aj:bp):ax +Gc: cmp %dx,%di # Gc(x:di,A:dx,B:si):ax jb 1b # we assume immutable cells push (%bx,%di) # mark prevents negative gc mov (%di),%di @@ -189,7 +181,8 @@ Gc: cmp %dx,%di # Gc(x:di,mark:dx,aj:bp):ax call Gc pop %di call Cons - sub %bp,%ax # subtract adjustment + sub %si,%ax # ax -= C - B + add %dx,%ax ret GetList:call GetToken @@ -200,24 +193,21 @@ GetList:call GetToken call GetList jmp xCons -Evaluate: # Evaluate(e:ax,a:dx):ax - test %ax,%ax # Implementation of Eval - jns Assoc # lookup val if atom - xchg %ax,%si # di = e - lodsw # ax = Car(e) - cmp $kQuote,%ax # maybe CONS - mov (%si),%di # di = Cdr(e) - je Car - cmp $kCond,%ax - je Evcon -.Ldflt2:push %ax # save 2 - call Evlis # preserves dx - xchg %ax,%si - pop %ax # restore 2 +.dflt1: push %si # save x + call Eval + pop %si # restore x # jmp Apply Apply: test %ax,%ax # Apply(fn:ax,x:si:a:dx):ax - js .lamb # jump if atom + jns .switch # jump if atom + xchg %ax,%di # di = fn +.lambda:mov (%bx,%di),%di # di = Cdr(fn) + push %di # save 1 + mov (%di),%di # di = Cadr(fn) + call Pairlis + xchg %ax,%dx + pop %di # restore 1 + jmp .EvCadr .switch:cmp $kEq,%ax # eq is last builtin atom ja .dflt1 # ah is zero if not above mov (%si),%di # di = Car(x) @@ -231,14 +221,6 @@ Apply: test %ax,%ax # Apply(fn:ax,x:si:a:dx):ax jns .retT .retF: xor %ax,%ax # ax = nil ret -.lamb: xchg %ax,%di # di = fn -.lambda:mov (%bx,%di),%di # di = Cdr(fn) - push %di # save 1 - mov (%di),%di # di = Cadr(fn) - call Pairlis - xchg %ax,%dx - pop %di # restore 1 - jmp .EvCadr .ifCons:cmp $kCons,%al mov (%bx,%si),%si # si = Cdr(x) lodsw # si = Cadr(x) @@ -247,24 +229,18 @@ Apply: test %ax,%ax # Apply(fn:ax,x:si:a:dx):ax jne .retF .retT: mov $kT,%ax ret -.dflt1: push %si # save x - call Eval - pop %si # restore x - jmp Apply Cadr: mov (%bx,%di),%di # contents of decrement 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 +2: ret -Assoc: mov %dx,%di # Assoc(x:ax,y:dx):ax - test %dx,%dx # nil test - jz .retF # return nil if end of list - mov (%bx,%di),%dx # we assume Eval() saved dx - mov (%di),%di +Assoc: mov %dx,%si # Assoc(x:ax,y:dx):ax +1: mov (%si),%di + mov (%bx,%si),%si scasw - jne Assoc + jne 1b jmp Car 1: mov (%bx,%di),%di # di = Cdr(c) @@ -279,22 +255,33 @@ Evcon: push %di # save c .EvCadr:call Cadr # ax = Cadar(c) # jmp Eval -Eval: push %dx # Eval(e:ax,a:dx):ax w/ gc - push %cx # w/ ABC garbage collector - call Evaluate # discards non-result cons - pop %dx - push %cx - mov %cx,%bp - sub %dx,%bp +Eval: test %ax,%ax # Eval(e:ax,a:dx):ax + jz 1f + jns Assoc # lookup val if atom + xchg %ax,%si # di = e + lodsw # ax = Car(e) + cmp $kQuote,%ax # maybe CONS + mov (%si),%di # di = Cdr(e) + je Car + cmp $kCond,%ax + je Evcon # ABC Garbage Collector + push %dx # save a + push %cx # save A + push %ax + call Evlis + xchg %ax,%si + pop %ax + call Apply + pop %dx # restore A + mov %cx,%si # si = B xchg %ax,%di call Gc - pop %si - mov %dx,%di - sub %si,%cx + mov %dx,%di # di = A + sub %si,%cx # cx = C - B rep movsb - mov %di,%cx - pop %dx - ret + mov %di,%cx # cx = A + (C - B) + pop %dx # restore a +1: ret .sig: .fill 510 - (. - _start), 1, 0xce .word 0xAA55