diff --git a/bin/sectorlisp.bin b/bin/sectorlisp.bin index ba247c7..dfe39cd 100755 Binary files a/bin/sectorlisp.bin and b/bin/sectorlisp.bin differ diff --git a/sectorlisp.S b/sectorlisp.S index 3b1305e..e666117 100644 --- a/sectorlisp.S +++ b/sectorlisp.S @@ -30,6 +30,8 @@ start: ljmp $0x7c00>>4,$begin # cs = 0x7c00 is boot address .asciz "" # interned strings kQuote: .asciz "QUOTE" # builtin for eval kCond: .asciz "COND" # builtin for eval +kRead: .asciz "READ" # builtin to apply +kPrint: .asciz "PRINT" # builtin to apply kCar: .asciz "CAR" # builtin to apply kCdr: .asciz "CDR" # ordering matters kCons: .asciz "CONS" # must be 3rd last @@ -52,11 +54,10 @@ begin: mov $0x8000,%sp # uses higher address as stack mov $2,%bx main: mov %sp,%cx mov $'\r',%al - call PutChar # Call first to initialize %dx - call GetToken - call GetObject + call PutChar # call first to initialize %dx + call Read call Eval - xchg %ax,%si + xchg %si,%ax call PrintObject jmp main @@ -93,6 +94,11 @@ GetToken: # GetToken():al, dl is g_look 4: mov $')',%al jmp PutChar +.ifPrint: + xchg %di,%si # Print(x:si) + test %di,%di + jnz PrintObject # print newline for empty args + mov $'\r',%al .PutObject: # .PutObject(c:al,x:si) .PrintString: # nul-terminated in si call PutChar # preserves si @@ -105,6 +111,10 @@ PrintObject: # PrintObject(x:si) jnz .PrintString # -> ret ret +.ifRead:mov %bp,%dx # get cached character +Read: call GetToken +# jmp GetObject + GetObject: # called just after GetToken cmp $'(',%al je GetList @@ -134,6 +144,7 @@ Intern: push %cx # Intern(cx,di): ax GetChar:xor %ax,%ax # GetChar→al:dl int $0x16 # get keystroke + mov %ax,%bp # used for READ PutChar:mov $0x0e,%ah # prints CP-437 int $0x10 # vidya service cmp $'\r',%al # don't clobber @@ -163,6 +174,27 @@ Cons: xchg %di,%cx # Cons(m:di,a:ax):ax .RetDi: xchg %di,%ax ret +Builtin:cmp $kAtom,%ax # atom: last builtin atom + ja .resolv # ah is zero if not above + mov (%si),%di # di = Car(x) + je .ifAtom + cmp $kPrint,%al + je .ifPrint + cmp $kRead,%al + je .ifRead + cmp $kCons,%al + jae .ifCons +.ifCar: cmp $kCar,%al + je Car +.ifCdr: jmp Cdr +.ifCons:mov (%bx,%si),%si # si = Cdr(x) + lodsw # si = Cadr(x) + je Cons +.isEq: xor %di,%ax + jne .retF +.retT: mov $kT,%al + ret + GetList:call GetToken cmp $')',%al je .retF @@ -189,7 +221,7 @@ Gc: cmp %dx,%di # Gc(x:di,A:dx,B:si):ax call Assoc # do (fn si) → ((λ ...) si) pop %si Apply: test %ax,%ax # Apply(fn:ax,x:si:a:dx):ax - jns .switch # jump if atom + jns Builtin # jump if atom xchg %ax,%di # di = fn .lambda:mov (%bx,%di),%di # di = Cdr(fn) push %di # for .EvCadr @@ -207,22 +239,6 @@ Pairlis:test %di,%di # Pairlis(x:di,y:si,a:dx):dx xchg %ax,%dx # a = new list pop %di # grab Cdr(x) jmp Pairlis -.switch:cmp $kAtom,%ax # atom: last builtin atom - ja .resolv # ah is zero if not above - mov (%si),%di # di = Car(x) - je .ifAtom - cmp $kCons,%al - jae .ifCons -.ifCar: cmp $kCar,%al - je Car -.ifCdr: jmp Cdr -.ifCons:mov (%bx,%si),%si # si = Cdr(x) - lodsw # si = Cadr(x) - je Cons -.isEq: xor %di,%ax - jne .retF -.retT: mov $kT,%al - ret .ifAtom:test %di,%di # test if atom jns .retT .retF: xor %ax,%ax # ax = nil @@ -233,7 +249,7 @@ Assoc: mov %dx,%si # Assoc(x:ax,y:dx):ax mov (%bx,%si),%si scasw jne 1b - .byte 0xA9 # shifted ip; read as test, cmp + .byte 0xA9 # shifted ip; reads as test, cmp 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 @@ -287,6 +303,8 @@ Eval: test %ax,%ax # Eval(e:ax,a:dx):ax 2: .type .sig,@object .type kQuote,@object .type kCond,@object + .type kRead,@object + .type kPrint,@object .type kAtom,@object .type kCar,@object .type kCdr,@object diff --git a/test/Makefile b/test/Makefile index 5884708..78fd3fd 100644 --- a/test/Makefile +++ b/test/Makefile @@ -1,5 +1,7 @@ test1: test1.lisp qemu.sh tcat sh qemu.sh test1.lisp +test2: test2.lisp qemu.sh tcat + sh qemu.sh test2.lisp eval10: eval10.lisp qemu.sh tcat sh qemu.sh eval10.lisp eval15: eval15.lisp qemu.sh tcat diff --git a/test/test2.lisp b/test/test2.lisp new file mode 100644 index 0000000..02c3aaa --- /dev/null +++ b/test/test2.lisp @@ -0,0 +1,42 @@ +(READ)AAA +(READ)(1 (2 3) 4) +(READ) + + AAA +(READ) + + (1 (2 3) 4) +(CAR (READ))(1 (2 3) 4) +(CDR (READ))(1 (2 3) 4) +(CONS (READ) (CONS (QUOTE A) NIL))B +(CONS (READ) (CONS (QUOTE A) NIL))(1 (2 3) 4) +(ATOM (READ))A +(ATOM (READ))(1 2) +(EQ (QUOTE A) (READ))A +(EQ (QUOTE B) (READ))A +(PRINT (QUOTE A)) +(PRINT (QUOTE (1 2))) +((LAMBDA () ()) + (PRINT (QUOTE A)) + (PRINT (QUOTE B)) + (PRINT) + (PRINT (QUOTE C)) + (PRINT (QUOTE (1 2 3))) + (PRINT)) +(PRINT (READ))AAA +(PRINT (READ))(1 (2 3) 4) +(PRINT) +(PRINT (PRINT)) +(PRINT (PRINT (QUOTE A))) +((LAMBDA (LOOP) (LOOP LOOP)) + (QUOTE (LAMBDA (LOOP) + ((LAMBDA () ()) + (PRINT (QUOTE >)) + (PRINT (CONS (QUOTE INPUT) (CONS (READ) NIL))) + (PRINT) + (LOOP LOOP))))) +A +B +C +(1 2) +(1 (2 3) 4)