diff --git a/sectorlisp.S b/sectorlisp.S index 891bc0d..a076734 100644 --- a/sectorlisp.S +++ b/sectorlisp.S @@ -21,7 +21,6 @@ // LISP meta-circular evaluator in a MBR -.set ONE, %bp .set ATOM_NIL, (kNil-kSymbols)<<1|1 .set ATOM_QUOTE, (kQuote-kSymbols)<<1|1 .set ATOM_COND, (kCond-kSymbols)<<1|1 @@ -33,9 +32,11 @@ .set ATOM_T, (kT-kSymbols)<<1|1 .set g_str, 0x0 -.set g_token, 0x7800 -.set boot, 0x7c00 -.set g_mem, 0x8000 +.set g_token, %bp +.set g_mem, %bp +.set ZERO, %ch +.set ONE, %cx +.set TWO, %bx //////////////////////////////////////////////////////////////////////////////// // Currently requires i386+ in real mode @@ -61,13 +62,13 @@ 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 - mov %cx,%di - push %cs # memory model ds=es=ss=cs +_begin: push %cs # memory model ds=es=ss=cs pop %ds push %cs pop %es + mov $0x8000,%cx + mov %cx,g_mem + mov %cx,%di xor %ax,%ax cld # clear direction flag rep stosb # memset(0x8000,0,0x8000) @@ -76,12 +77,13 @@ _begin: mov $g_mem,%cx pop %ss # disable nonmaskable interrupts mov %ax,%sp # use null pointer as our stack # sti # enable interrupts - inc %ax - xchg %ax,ONE # bp = 1 + inc ONE # ++cx + mov ONE,TWO + inc TWO main: mov $'\n',%dl call GetToken call GetObject - mov ONE,%dx + mov ONE,%dx # dx = NIL call Eval call PrintObject mov $'\r',%al @@ -89,14 +91,14 @@ main: mov $'\n',%dl jmp main GetToken: # GetToken():al, dl is g_look - mov %fs,%di # di = g_token + mov g_token,%di mov %di,%si 1: mov %dl,%al cmp $' ',%al jbe 2f stosb - xchg %ax,%cx -2: call GetChar # bh = 0 after PutChar + xchg %ax,%si +2: call GetChar xchg %ax,%dx # dl = g_look cmp $' ',%al jbe 1b @@ -104,8 +106,8 @@ GetToken: # GetToken():al, dl is g_look jbe 3f cmp $')',%dl ja 1b -3: movb %bh,(%di) - xchg %cx,%ax +3: movb ZERO,(%di) + xchg %si,%ax ret .PutObject: # .PutObject(c:al,x:di) @@ -128,7 +130,7 @@ PrintObject: # PrintObject(x:ax) jmp .PrintString .PrintList: mov $'(',%al -2: push 2(%di) # save 1 Cdr(x) +2: push (TWO,%di) # save 1 Cdr(x) mov (%di),%di # di = Car(x) call .PutObject pop %ax # restore 1 @@ -157,7 +159,7 @@ GetObject: # called just after GetToken jne 1b jmp 5f 2: pop %si # drop 1 - mov %fs,%si # si = g_token + mov g_token,%si 3: scasb jne 3b cmp (%di),%al @@ -180,7 +182,6 @@ GetChar: # al is ascii character PutChar: # 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 @@ -193,17 +194,15 @@ PutChar: Pairlis:cmp ONE,%di # Pairlis(x:di,y:si,a:dx):ax je 1f # it's zip() basically - push 2(%di) # save 1 Cdr(x) + push (TWO,%di) # save 1 Cdr(x) lodsw push (%si) # save 2 Cdr(y) mov (%di),%di - xchg %ax,%si call Cons # preserves dx pop %si # restore 2 pop %di # restore 1 push %ax # save 3 call Pairlis - xchg %ax,%si pop %di # restore 3 jmp Cons # can be inlined here 1: xchg %dx,%ax @@ -211,7 +210,7 @@ Pairlis:cmp ONE,%di # Pairlis(x:di,y:si,a:dx):ax Evlis: cmp ONE,%di # Evlis(m:di,a:dx):ax je 1f - push 2(%di) # save 1 Cdr(m) + push (TWO,%di) # save 1 Cdr(m) mov (%di),%ax push %dx # save a call Eval @@ -220,17 +219,14 @@ Evlis: cmp ONE,%di # Evlis(m:di,a:dx):ax push %ax # save 2 call Evlis -xCons: xchg %ax,%si - pop %di # restore 2 -# jmp Cons -Cons: xchg %di,%ax - mov %fs,%di +xCons: pop %di # restore 2 +Cons: xchg %ax,%si # Cons(m:di,a:ax):ax + xchg %di,%ax + mov g_mem,%di stosw xchg %si,%ax stosw - xchg %di,%ax - mov %fs,%di - mov %ax,%fs + xchg %di,g_mem 1: xchg %di,%ax ret @@ -242,10 +238,10 @@ GetList:call GetToken call GetList jmp xCons -1: mov 2(%di),%di # di = Cdr(c) +1: mov (TWO,%di),%di # di = Cdr(c) Evcon: push %di # save c - mov (%di),%di # di = Car(c) - mov (%di),%ax # ax = Caar(c) + mov (%di),%si # di = Car(c) + lodsw # ax = Caar(c) push %dx # save a call Eval pop %dx # restore a @@ -274,18 +270,18 @@ Eval: test $1,%al # Eval(e:ax,a:dx):ax Apply: test $1,%al # Apply(fn:ax,x:si:a:dx):ax jnz .switch xchg %ax,%di # di = fn -.lambda:mov 2(%di),%di # di = Cdr(fn) +.lambda:mov (TWO,%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:mov 2(%si),%si # si = Cdr(x) - mov (%si),%si # si = Cadr(x) - cmp $ATOM_CONS,%al +.ifCons:cmp $ATOM_CONS,%al + mov (TWO,%si),%si # si = Cdr(x) + lodsw # si = Cadr(x) je Cons -.isEq: cmp %di,%si +.isEq: cmp %di,%ax jne .retF .retT: mov $ATOM_T,%al # ax = ATOM_T ret @@ -309,20 +305,20 @@ Apply: test $1,%al # Apply(fn:ax,x:si:a:dx):ax pop %si # restore x jmp Apply -Cadr: mov 2(%di),%di # contents of decrement register +Cadr: mov (TWO,%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 -.Assoc: mov 2(%si),%dx # dx = Cdr(y) +.Assoc: mov (TWO,%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) + mov (%si),%di # bx = Car(y) + cmp %ax,(%di) # (%di) = Caar(y) jne .Assoc - mov 2(%bx),%ax # ax = Cdar(y) + mov (TWO,%di),%ax # ax = Cdar(y) ret .type .sig,@object;