diff --git a/Makefile b/Makefile index 416c19d..25ba5df 100644 --- a/Makefile +++ b/Makefile @@ -51,10 +51,10 @@ clean:; $(RM) $(CLEANFILES) lisp.bin.dbg: start.o lisp.real.o lisp.lds sectorlisp.bin.dbg: start.o sectorlisp.o lisp.lds -start.o: start.S -lisp.o: lisp.c lisp.h -lisp.real.o: lisp.c lisp.h -sectorlisp.o: sectorlisp.S +start.o: start.S Makefile +lisp.o: lisp.c lisp.h Makefile +lisp.real.o: lisp.c lisp.h Makefile +sectorlisp.o: sectorlisp.S Makefile %.real.o: %.c $(CC) $(CPPFLAGS) $(CFLAGS) $(REALFLAGS) -c -o $@ $< diff --git a/README.md b/README.md index 8735a31..acbbc72 100644 --- a/README.md +++ b/README.md @@ -29,7 +29,7 @@ of running natively without dependencies on modern PCs, sectorlisp might be the tiniest self-hosting LISP interpreter to date. We're still far off however from reaching our goal, which is to have -sectorilsp be small enough to fit in the master boot record of a floppy +sectorlisp be small enough to fit in the master boot record of a floppy disk, like [sectorforth](https://github.com/cesarblum/sectorforth). If you can help this project reach its goal, please send us a pull request! diff --git a/bin/footprint.png b/bin/footprint.png index f63aa3c..60b3bd7 100644 Binary files a/bin/footprint.png and b/bin/footprint.png differ diff --git a/bin/sectorlisp.bin b/bin/sectorlisp.bin index c9c6cde..73575e6 100755 Binary files a/bin/sectorlisp.bin and b/bin/sectorlisp.bin differ diff --git a/lisp.lds b/lisp.lds index 622addd..8c0d4ee 100644 --- a/lisp.lds +++ b/lisp.lds @@ -4,12 +4,12 @@ SECTIONS { .text 0x7c00 - 0x600 : { *(.start) + *(.text.startup) rodata = .; *(.rodata .rodata.*) . = 0x1fe; SHORT(0xaa55); *(.text .text.*) - /*BYTE(0x90);*/ _etext = .; . = ALIGN(512); } @@ -21,6 +21,7 @@ SECTIONS { } /DISCARD/ : { + *(.yoink) *(.*) } } diff --git a/lisp.lisp b/lisp.lisp index e25df93..a7ed288 100644 --- a/lisp.lisp +++ b/lisp.lisp @@ -40,6 +40,7 @@ NIL ;; CONS CELL ;; BUILDING BLOCK OF DATA STRUCTURES (CONS NIL NIL) +(CONS (QUOTE X) (QUOTE Y)) ;; REFLECTION ;; EVERYTHING IS AN ATOM OR NOT AN ATOM diff --git a/sectorlisp.S b/sectorlisp.S index 40921aa..dfda895 100644 --- a/sectorlisp.S +++ b/sectorlisp.S @@ -35,22 +35,18 @@ #define ATOM_CONS 88 #define ATOM_LAMBDA 98 -#define SYNTAX 0x4000 -#define LOOK 0x4100 -#define GLOBALS 0x4102 -#define INDEX 0x4104 -#define TOKEN 0x4106 -#define STR 0x41c8 +#define STR 0x4186 //////////////////////////////////////////////////////////////////////////////// .section .start,"ax",@progbits .globl main .code16 -main: mov $SYNTAX,%bx - movb $32,32(%bx) - movb $32,13(%bx) - movb $32,10(%bx) +main: mov $q.syntax,%bx + mov $32,%al + mov %al,32(%bx) + mov %al,13(%bx) + mov %al,10(%bx) movw $10536,40(%bx) movb $46,46(%bx) mov $STR,%di @@ -58,58 +54,41 @@ main: mov $SYNTAX,%bx mov $57,%cx rep movsb 0: call GetChar - mov %ax,LOOK + mov %ax,q.look call GetToken call GetObject xchg %ax,%di - mov GLOBALS,%si + mov q.globals,%si call Eval xchg %ax,%di call PrintObject - mov $kCrlf,%di + mov $kCrlf,%si call PrintString jmp 0b -PutChar:push %bx - push %bp # original ibm pc scroll up bug - mov $0x0007,%bx # normal mda/cga style page zero - xchg %di,%ax # character to display - mov $0x0E,%ah # teletype output - int $0x10 # vidya service - pop %bp # result dilβ†’al - pop %bx - ret - GetChar:xor %ax,%ax # get keystroke int $0x16 # keyboard service xor %ah,%ah # ah is bios scancode push %ax # al is ascii character - xchg %ax,%di # result is ax - call PutChar - cmp $'\r,%al + call PutChar # ax will have result + cmp $'\r,%al # don't clobber stuff jne 1f - mov $'\n,%di + mov $'\n,%al call PutChar 1: pop %ax ret -PrintString: - mov %di,%dx -0: mov %dx,%di - mov (%di),%al - test %al,%al - je 1f - xchg %ax,%di - call PutChar - inc %dx - jmp 0b -1: ret +Cadr: and $-2,%di # (object >> 1) * sizeof(word) + mov 2(%di),%di # contents of decrement register + and $-2,%di # contents of address register + mov (%di),%ax + ret GetToken: xor %bx,%bx - mov $SYNTAX,%si - mov LOOK,%ax - mov $TOKEN,%cx + mov $q.syntax,%si + mov q.look,%ax + mov $q.token,%di 0: mov %al,%bl mov (%bx,%si),%dl mov %dl,%bl @@ -119,24 +98,19 @@ GetToken: jmp 0b 1: test %dl,%dl je 3f - xchg %cx,%di stosb - xchg %di,%cx call GetChar jmp 4f 2: test %bl,%bl jne 4f - xchg %cx,%di stosb - xchg %di,%cx call GetChar mov %ax,%bx mov (%bx,%si),%bl 3: test %al,%al jne 2b -4: mov %cx,%di - movb $0,(%di) - mov %al,LOOK +4: movb $0,(%di) + mov %al,q.look ret Assoc: xchg %si,%bx @@ -158,24 +132,56 @@ Assoc: xchg %si,%bx ret GetObject: - cmpb $40,TOKEN - je 1f - mov $TOKEN,%di - jmp Intern -1: #jmp GetList + cmpb $40,q.token + je GetList + mov $q.token,%di / 𝑠𝑙𝑖𝑑𝑒 +Intern: mov %di,%bx + mov $STR,%si +0: lodsb + test %al,%al + je 4f + xor %dx,%dx +1: mov %dx,%di + mov (%bx,%di),%cl + cmp %cl,%al + jne 3f + inc %dx + test %al,%al + jne 2f + sub %di,%si + lea -STR-1(%si),%ax + jmp 6f +2: lodsb + jmp 1b +3: test %al,%al + jz 0b + lodsb + jmp 3b +4: lea -1(%si),%di + push %di + mov %bx,%si +0: lodsb + stosb + test %al,%al + jnz 0b + pop %ax + sub $STR,%ax +6: shl %ax + ret + GetList:call GetToken - mov TOKEN,%al + mov q.token,%al cmp $'),%al je 2f cmp $'.,%al je 1f call GetObject - push %ax + push %ax # save call GetList xchg %ax,%si - pop %di + pop %di # restore jmp Cons 1: call GetToken jmp GetObject @@ -187,7 +193,7 @@ EvalCons: mov 2(%bx),%bx mov %bx,%di call Cadr - mov %ax,%di + xchg %ax,%di mov %bp,%si call Eval mov %bp,%si @@ -200,7 +206,7 @@ EvalCons: / jmp Cons / 𝑠𝑙𝑖𝑑𝑒 -Cons: mov $INDEX,%bx +Cons: mov $q.index,%bx mov (%bx),%ax addw $2,(%bx) shl %ax @@ -213,92 +219,83 @@ Cons: mov $INDEX,%bx Bind: test %di,%di je 1f push %bp - mov %sp,%bp - push %dx - push %dx - xchg %si,%bx - and $-2,%bx + and $-2,%si and $-2,%di - mov %di,-4(%bp) - mov 2(%bx),%si + mov %di,%bp + push %dx # save no. 1 + push %si # save no. 2 + mov 2(%si),%si mov 2(%di),%di - push %bx # save no. 1 call Bind - pop %bx # rest no. 1 - push %ax # save no. 2 - mov (%bx),%bx - mov %bx,%di - mov -2(%bp),%si + pop %si # rest no. 2 + mov (%si),%di + pop %si # rest no. 1 + push %ax # save no. 3 call Eval - mov -4(%bp),%di - mov (%di),%di + mov %ds:(%bp),%di xchg %ax,%si call Cons - pop %si # rest no. 2 + pop %si # rest no. 3 xchg %ax,%di - leave + pop %bp jmp Cons 1: xchg %dx,%ax ret -EvalCdr: - mov %dx,%di - mov %bp,%si - call Arg1 - and $-2,%ax - mov %ax,%di - mov 2(%di),%ax - pop %bp - ret +PrintString: # nul-terminated in si +0: lodsb # don't clobber bp, bx + test %al,%al + je 1f + call PutChar + jmp 0b +1: ret //////////////////////////////////////////////////////////////////////////////// .text -Cadr: and $-2,%di # (object >> 1) * sizeof(word) - mov 2(%di),%di # contents of decrement register - and $-2,%di # contents of address register - mov (%di),%ax +PrintObject: + test $1,%di + jnz 1f + shr %di + lea STR(%di),%si + jmp PrintString +1: push %bx + mov %di,%bx + mov $40,%al + call PutChar +2: and $-2,%bx + mov (%bx),%di + call PrintObject + mov 2(%bx),%bx + test %bx,%bx + jz 4f + test $1,%bl + jz 3f + mov $0x20,%al + call PutChar + jmp 2b +3: mov $kDot,%si + call PrintString + mov %bx,%di + call PrintObject +4: pop %bx + mov $41,%al +/ jmp PutChar +/ 𝑠𝑙𝑖𝑑𝑒 + +PutChar:push %bx # don't clobber bp,bx,di,si,cx + push %bp # original ibm pc scroll up bug + mov $7,%bx # normal mda/cga style page zero + mov $0x0e,%ah # teletype output al cp437 + int $0x10 # vidya service + pop %bp # preserves al + pop %bx ret Arg1: call Cadr xchg %ax,%di - jmp Eval - -PrintObject: - push %bp - mov %di,%bp - test $1,%di - setz %al - shr %di - test %al,%al - je 1f - add $STR,%di - pop %bp - jmp PrintString -1: mov $40,%di - call PutChar -2: mov %bp,%bx - and $-2,%bx - mov (%bx),%di - call PrintObject - mov %bp,%bx - and $-2,%bx - mov 2(%bx),%bx - mov %bx,%bp - test %bx,%bx - je 4f - test $1,%bl - je 3f - mov $0x20,%di - call PutChar - jmp 2b -3: mov $kDot,%di - call PrintString - mov %bp,%di - call PrintObject -4: mov $41,%di - pop %bp - jmp PutChar +/ jmp Eval +/ 𝑠𝑙𝑖𝑑𝑒 Eval: push %bp mov %di,%dx @@ -314,27 +311,24 @@ Eval: push %bp mov (%bx),%ax test $1,%al je 1f - mov (%bx),%ax - and $-2,%ax - mov %ax,%di - mov (%di),%ax - cmp $ATOM_LAMBDA,%ax + mov (%bx),%di + and $-2,%di + cmp $ATOM_LAMBDA,(%di) jne EvalUndefined mov 2(%bx),%si mov (%bx),%di push %bx call Cadr - mov %si,%si - mov %ax,%di + xchg %ax,%di mov %bp,%dx call Bind - mov %ax,%bp + xchg %ax,%bp pop %bx mov (%bx),%bx mov %bx,%di and $-2,%di mov 2(%di),%di - jmp 8f + jmp EvalCadrLoop 1: mov (%bx),%ax cmp $ATOM_COND,%ax je EvalCond @@ -355,7 +349,7 @@ Eval: push %bp mov 2(%bx),%bx mov %bx,%di call Cadr - mov %ax,%di + xchg %ax,%di mov %bp,%si call Eval mov %bp,%si @@ -365,14 +359,37 @@ Eval: push %bp pop %dx # restore cmp %dx,%ax jmp 3f +EvalCdr: + mov %dx,%di + mov %bp,%si + call Arg1 + and $-2,%ax + xchg %ax,%di + mov 2(%di),%ax + pop %bp + ret +EvalCond: + mov 2(%bx),%bx + and $-2,%bx + mov (%bx),%di + and $-2,%di + mov (%di),%di + mov %bp,%si + push %bx # save + call Eval + pop %bx # restore + test %ax,%ax + je EvalCond + mov (%bx),%di + jmp EvalCadrLoop 2: cmp $ATOM_CDR,%ax je EvalCdr cmp $ATOM_CONS,%ax je EvalCons cmp $ATOM_CAR,%ax jne EvalCall - mov %bp,%si mov %dx,%di + mov %bp,%si call Arg1 and $-2,%ax xchg %ax,%di @@ -387,78 +404,24 @@ EvalAtom: je 9f xor %ax,%ax jmp 9f -EvalCond: - mov 2(%bx),%bx - mov %bx,%bx - and $-2,%bx - mov (%bx),%di - push %bx # save - and $-2,%di - mov (%di),%di - mov %bp,%si - call Eval - test %ax,%ax - pop %bx # restore - je EvalCond - mov (%bx),%bx - mov %bx,%di - jmp 8f EvalCall: mov 2(%bx),%cx - mov (%bx),%bx - mov %bx,%di + mov (%bx),%di mov %bp,%si call Assoc - mov %cx,%si - mov %ax,%di + xchg %cx,%si + xchg %ax,%di call Cons jmp 1f -8: call Cadr -1: mov %ax,%dx +EvalCadrLoop: + call Cadr +1: xchg %ax,%dx jmp 0b EvalUndefined: mov $UNDEFINED,%ax 9: pop %bp ret -Intern: push %bp - xchg %di,%bx - mov $STR,%si -0: lodsb - test %al,%al - je 4f - xor %dx,%dx -1: mov %dx,%bp - mov %dx,%di - mov (%bx,%di),%cl - cmp %cl,%al - jne 3f - inc %dx - test %al,%al - jne 2f - mov %bp,%cx - sub %cx,%si - lea -STR-1(%si),%ax - jmp 6f -2: lodsb - jmp 1b -3: test %al,%al - je 0b - lodsb - jmp 3b -4: lea -1(%si),%dx - mov %dx,%di - xchg %bx,%si -0: lodsb - stosb - test %al,%al - jnz 0b - xchg %dx,%ax - sub $STR,%ax -6: shl %ax - pop %bp - ret - //////////////////////////////////////////////////////////////////////////////// .section .rodata,"a",@progbits diff --git a/start.S b/start.S index 0376be3..d2719eb 100644 --- a/start.S +++ b/start.S @@ -42,4 +42,7 @@ _begin: push %cs # memory model cs=ds=es = 0x600 xor %dh,%dh # drive dl head zero mov $0x0200+v_sectors,%ax # read sectors int $0x13 # disk service - jmp main +/ 𝑠𝑙𝑖𝑑𝑒 + + .section .yoink + nop main