|
@@ -21,7 +21,6 @@
|
|
|
|
|
|
// LISP meta-circular evaluator in a MBR
|
|
// LISP meta-circular evaluator in a MBR
|
|
|
|
|
|
-.set ONE, %bp
|
|
|
|
.set ATOM_NIL, (kNil-kSymbols)<<1|1
|
|
.set ATOM_NIL, (kNil-kSymbols)<<1|1
|
|
.set ATOM_QUOTE, (kQuote-kSymbols)<<1|1
|
|
.set ATOM_QUOTE, (kQuote-kSymbols)<<1|1
|
|
.set ATOM_COND, (kCond-kSymbols)<<1|1
|
|
.set ATOM_COND, (kCond-kSymbols)<<1|1
|
|
@@ -33,9 +32,11 @@
|
|
.set ATOM_T, (kT-kSymbols)<<1|1
|
|
.set ATOM_T, (kT-kSymbols)<<1|1
|
|
|
|
|
|
.set g_str, 0x0
|
|
.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
|
|
// Currently requires i386+ in real mode
|
|
@@ -61,13 +62,13 @@ kCar: .asciz "CAR"
|
|
kCdr: .asciz "CDR"
|
|
kCdr: .asciz "CDR"
|
|
kCons: .asciz "CONS"
|
|
kCons: .asciz "CONS"
|
|
kEq: .asciz "EQ" # needs to be last
|
|
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
|
|
pop %ds
|
|
push %cs
|
|
push %cs
|
|
pop %es
|
|
pop %es
|
|
|
|
+ mov $0x8000,%cx
|
|
|
|
+ mov %cx,g_mem
|
|
|
|
+ mov %cx,%di
|
|
xor %ax,%ax
|
|
xor %ax,%ax
|
|
cld # clear direction flag
|
|
cld # clear direction flag
|
|
rep stosb # memset(0x8000,0,0x8000)
|
|
rep stosb # memset(0x8000,0,0x8000)
|
|
@@ -76,12 +77,13 @@ _begin: mov $g_mem,%cx
|
|
pop %ss # disable nonmaskable interrupts
|
|
pop %ss # disable nonmaskable interrupts
|
|
mov %ax,%sp # use null pointer as our stack
|
|
mov %ax,%sp # use null pointer as our stack
|
|
# sti # enable interrupts
|
|
# sti # enable interrupts
|
|
- inc %ax
|
|
|
|
- xchg %ax,ONE # bp = 1
|
|
|
|
|
|
+ inc ONE # ++cx
|
|
|
|
+ mov ONE,TWO
|
|
|
|
+ inc TWO
|
|
main: mov $'\n',%dl
|
|
main: mov $'\n',%dl
|
|
call GetToken
|
|
call GetToken
|
|
call GetObject
|
|
call GetObject
|
|
- mov ONE,%dx
|
|
|
|
|
|
+ mov ONE,%dx # dx = NIL
|
|
call Eval
|
|
call Eval
|
|
call PrintObject
|
|
call PrintObject
|
|
mov $'\r',%al
|
|
mov $'\r',%al
|
|
@@ -89,14 +91,14 @@ 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 # di = g_token
|
|
|
|
|
|
+ mov g_token,%di
|
|
mov %di,%si
|
|
mov %di,%si
|
|
1: mov %dl,%al
|
|
1: mov %dl,%al
|
|
cmp $' ',%al
|
|
cmp $' ',%al
|
|
jbe 2f
|
|
jbe 2f
|
|
stosb
|
|
stosb
|
|
- xchg %ax,%cx
|
|
|
|
-2: call GetChar # bh = 0 after PutChar
|
|
|
|
|
|
+ xchg %ax,%si
|
|
|
|
+2: call GetChar
|
|
xchg %ax,%dx # dl = g_look
|
|
xchg %ax,%dx # dl = g_look
|
|
cmp $' ',%al
|
|
cmp $' ',%al
|
|
jbe 1b
|
|
jbe 1b
|
|
@@ -104,8 +106,8 @@ GetToken: # GetToken():al, dl is g_look
|
|
jbe 3f
|
|
jbe 3f
|
|
cmp $')',%dl
|
|
cmp $')',%dl
|
|
ja 1b
|
|
ja 1b
|
|
-3: movb %bh,(%di)
|
|
|
|
- xchg %cx,%ax
|
|
|
|
|
|
+3: movb ZERO,(%di)
|
|
|
|
+ xchg %si,%ax
|
|
ret
|
|
ret
|
|
|
|
|
|
.PutObject: # .PutObject(c:al,x:di)
|
|
.PutObject: # .PutObject(c:al,x:di)
|
|
@@ -128,7 +130,7 @@ PrintObject: # PrintObject(x:ax)
|
|
jmp .PrintString
|
|
jmp .PrintString
|
|
.PrintList:
|
|
.PrintList:
|
|
mov $'(',%al
|
|
mov $'(',%al
|
|
-2: push 2(%di) # save 1 Cdr(x)
|
|
|
|
|
|
+2: push (TWO,%di) # save 1 Cdr(x)
|
|
mov (%di),%di # di = Car(x)
|
|
mov (%di),%di # di = Car(x)
|
|
call .PutObject
|
|
call .PutObject
|
|
pop %ax # restore 1
|
|
pop %ax # restore 1
|
|
@@ -157,7 +159,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 # si = g_token
|
|
|
|
|
|
+ mov g_token,%si
|
|
3: scasb
|
|
3: scasb
|
|
jne 3b
|
|
jne 3b
|
|
cmp (%di),%al
|
|
cmp (%di),%al
|
|
@@ -180,7 +182,6 @@ GetChar:
|
|
# al is ascii character
|
|
# al is ascii character
|
|
PutChar:
|
|
PutChar:
|
|
# 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
|
|
|
|
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
|
|
@@ -193,17 +194,15 @@ PutChar:
|
|
|
|
|
|
Pairlis:cmp ONE,%di # Pairlis(x:di,y:si,a:dx):ax
|
|
Pairlis:cmp ONE,%di # Pairlis(x:di,y:si,a:dx):ax
|
|
je 1f # it's zip() basically
|
|
je 1f # it's zip() basically
|
|
- push 2(%di) # save 1 Cdr(x)
|
|
|
|
|
|
+ push (TWO,%di) # save 1 Cdr(x)
|
|
lodsw
|
|
lodsw
|
|
push (%si) # save 2 Cdr(y)
|
|
push (%si) # save 2 Cdr(y)
|
|
mov (%di),%di
|
|
mov (%di),%di
|
|
- xchg %ax,%si
|
|
|
|
call Cons # preserves dx
|
|
call Cons # preserves dx
|
|
pop %si # restore 2
|
|
pop %si # restore 2
|
|
pop %di # restore 1
|
|
pop %di # restore 1
|
|
push %ax # save 3
|
|
push %ax # save 3
|
|
call Pairlis
|
|
call Pairlis
|
|
- xchg %ax,%si
|
|
|
|
pop %di # restore 3
|
|
pop %di # restore 3
|
|
jmp Cons # can be inlined here
|
|
jmp Cons # can be inlined here
|
|
1: xchg %dx,%ax
|
|
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
|
|
Evlis: cmp ONE,%di # Evlis(m:di,a:dx):ax
|
|
je 1f
|
|
je 1f
|
|
- push 2(%di) # save 1 Cdr(m)
|
|
|
|
|
|
+ push (TWO,%di) # save 1 Cdr(m)
|
|
mov (%di),%ax
|
|
mov (%di),%ax
|
|
push %dx # save a
|
|
push %dx # save a
|
|
call Eval
|
|
call Eval
|
|
@@ -220,17 +219,14 @@ Evlis: cmp ONE,%di # Evlis(m:di,a:dx):ax
|
|
push %ax # save 2
|
|
push %ax # save 2
|
|
call Evlis
|
|
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
|
|
stosw
|
|
xchg %si,%ax
|
|
xchg %si,%ax
|
|
stosw
|
|
stosw
|
|
- xchg %di,%ax
|
|
|
|
- mov %fs,%di
|
|
|
|
- mov %ax,%fs
|
|
|
|
|
|
+ xchg %di,g_mem
|
|
1: xchg %di,%ax
|
|
1: xchg %di,%ax
|
|
ret
|
|
ret
|
|
|
|
|
|
@@ -242,10 +238,10 @@ GetList:call GetToken
|
|
call GetList
|
|
call GetList
|
|
jmp xCons
|
|
jmp xCons
|
|
|
|
|
|
-1: mov 2(%di),%di # di = Cdr(c)
|
|
|
|
|
|
+1: mov (TWO,%di),%di # di = Cdr(c)
|
|
Evcon: push %di # save 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
|
|
push %dx # save a
|
|
call Eval
|
|
call Eval
|
|
pop %dx # restore a
|
|
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
|
|
Apply: test $1,%al # Apply(fn:ax,x:si:a:dx):ax
|
|
jnz .switch
|
|
jnz .switch
|
|
xchg %ax,%di # di = fn
|
|
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
|
|
push %di # save 1
|
|
mov (%di),%di # di = Cadr(fn)
|
|
mov (%di),%di # di = Cadr(fn)
|
|
call Pairlis
|
|
call Pairlis
|
|
xchg %ax,%dx
|
|
xchg %ax,%dx
|
|
pop %di # restore 1
|
|
pop %di # restore 1
|
|
jmp .EvCadr
|
|
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
|
|
je Cons
|
|
-.isEq: cmp %di,%si
|
|
|
|
|
|
+.isEq: cmp %di,%ax
|
|
jne .retF
|
|
jne .retF
|
|
.retT: mov $ATOM_T,%al # ax = ATOM_T
|
|
.retT: mov $ATOM_T,%al # ax = ATOM_T
|
|
ret
|
|
ret
|
|
@@ -309,20 +305,20 @@ Apply: test $1,%al # Apply(fn:ax,x:si:a:dx):ax
|
|
pop %si # restore x
|
|
pop %si # restore x
|
|
jmp Apply
|
|
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)
|
|
.byte 0x3C # cmp §scasw,%al (nop next byte)
|
|
Cdr: scasw # increments our data index by 2
|
|
Cdr: scasw # increments our data index by 2
|
|
Car: mov (%di),%ax # contents of address register!!
|
|
Car: mov (%di),%ax # contents of address register!!
|
|
ret
|
|
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
|
|
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)
|
|
|
|
- cmp %ax,(%bx) # (%bx) = Caar(y)
|
|
|
|
|
|
+ mov (%si),%di # bx = Car(y)
|
|
|
|
+ cmp %ax,(%di) # (%di) = Caar(y)
|
|
jne .Assoc
|
|
jne .Assoc
|
|
- mov 2(%bx),%ax # ax = Cdar(y)
|
|
|
|
|
|
+ mov (TWO,%di),%ax # ax = Cdar(y)
|
|
ret
|
|
ret
|
|
|
|
|
|
.type .sig,@object;
|
|
.type .sig,@object;
|