mirror of
https://github.com/samsonjs/sectorlisp.git
synced 2026-03-25 09:05:48 +00:00
Reduce sectorlisp from 948 to 856 bytes
This commit is contained in:
Justine Tunney
parent
a561e031ae
commit
665668a7a0
8 changed files with 171 additions and 203 deletions
8
Makefile
8
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 $@ $<
|
||||
|
|
|
|||
|
|
@ -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!
|
||||
|
||||
|
|
|
|||
Binary file not shown.
|
Before Width: | Height: | Size: 11 KiB After Width: | Height: | Size: 11 KiB |
Binary file not shown.
3
lisp.lds
3
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)
|
||||
*(.*)
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
355
sectorlisp.S
355
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
|
||||
|
||||
|
|
|
|||
5
start.S
5
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
|
||||
|
|
|
|||
Loading…
Reference in a new issue