Add garbage collection (now 470 bytes)

This GC wraps Eval() to create a copy of the result, and then
memcpy's it backwards to the position where the g_mem pointer
resided at the beginning of Eval() thereby discarding all the
cons cells that got created which weren't part of the result.
Overlap (or negative GC) isn't possible because we don't copy
cells beneath the low water mark.

As it turns out 44 bytes is all you need to implement garbage
collection when your language guarantees that data structures
can't have cycles, due to the lack of mutability.
This commit is contained in:
Justine Tunney 2021-11-21 09:06:01 -08:00
parent 1acabfcc6a
commit 5a33a6b97a

View file

@ -22,8 +22,8 @@
// LISP meta-circular evaluator in a MBR // LISP meta-circular evaluator in a MBR
// Compatible with the original hardware // Compatible with the original hardware
.set g_token, %bp .set g_mem, %cx
.set g_mem, %bp .set g_token, %cx
.set ZERO, %bh .set ZERO, %bh
.set TWO, %bx .set TWO, %bx
@ -67,13 +67,12 @@ begin: xor %ax,%ax
sti # enable interrupts sti # enable interrupts
cld # direction forward cld # direction forward
mov $2,TWO mov $2,TWO
mov $Eval,%cx
mov $0x8000,g_mem
main: mov $'\n',%dl main: mov $'\n',%dl
mov $0x8000,g_mem
call GetToken call GetToken
call GetObject call GetObject
xor %dx,%dx xor %dx,%dx
call *%cx # call Eval call Eval
xchg %ax,%di xchg %ax,%di
call PrintObject call PrintObject
mov $'\r',%al mov $'\r',%al
@ -162,14 +161,12 @@ GetChar:
# ah is bios scancode # ah is bios scancode
# al is ascii character # al is ascii character
PutChar: PutChar:
push %bp # original ibm pc scroll up bug
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 cmp $'\r',%al # don't clobber
cmp $'\r',%al # don't clobber stuff
jne .ret jne .ret
mov $'\n',%al mov $'\n',%al
jmp PutChar # bx volatile jmp PutChar
//////////////////////////////////////////////////////////////////////////////// ////////////////////////////////////////////////////////////////////////////////
@ -192,9 +189,7 @@ Evlis: test %di,%di # Evlis(m:di,a:dx):ax
jz 1f # jump if nil jz 1f # jump if nil
push (TWO,%di) # save 1 Cdr(m) push (TWO,%di) # save 1 Cdr(m)
mov (%di),%ax mov (%di),%ax
push %dx # save a call Eval
call *%cx # call Eval
pop %dx # restore a
pop %di # restore 1 pop %di # restore 1
push %ax # save 2 push %ax # save 2
call Evlis call Evlis
@ -210,6 +205,19 @@ Cons: xchg %ax,%si # Cons(m:di,a:ax):ax
1: xchg %di,%ax 1: xchg %di,%ax
ret ret
Gc: cmp %dx,%di # Gc(x:di,mark:dx,aj:bp):ax
jb 1b # we assume immutable cells
push (TWO,%di) # mark prevents negative gc
mov (%di),%di
call Gc
pop %di
push %ax
call Gc
pop %di
call Cons
sub %bp,%ax # subtract adjustment
ret
GetList:call GetToken GetList:call GetToken
cmpb $')',%al cmpb $')',%al
je .retF je .retF
@ -218,21 +226,7 @@ GetList:call GetToken
call GetList call GetList
jmp xCons jmp xCons
1: mov (TWO,%di),%di # di = Cdr(c) .Eval: test %ax,%ax # Eval(e:ax,a:dx):ax w/o gc
Evcon: push %di # save c
mov (%di),%si # di = Car(c)
lodsw # ax = Caar(c)
push %dx # save a
call *%cx # call Eval
pop %dx # restore a
pop %di # restore c
test %ax,%ax # nil test
jz 1b
mov (%di),%di # di = Car(c)
.EvCadr:call Cadr # ax = Cadar(c)
# jmp Eval
Eval: test %ax,%ax # Eval(e:ax,a:dx):ax
jns Assoc # lookup val if atom jns Assoc # lookup val if atom
xchg %ax,%si # di = e xchg %ax,%si # di = e
lodsw # ax = Car(e) lodsw # ax = Car(e)
@ -279,9 +273,7 @@ Apply: test %ax,%ax # Apply(fn:ax,x:si:a:dx):ax
.retF: xor %ax,%ax # ax = nil .retF: xor %ax,%ax # ax = nil
ret ret
.dflt1: push %si # save x .dflt1: push %si # save x
push %dx # save a call Eval
call *%cx # call Eval
pop %dx # restore a
pop %si # restore x pop %si # restore x
jmp Apply jmp Apply
@ -301,7 +293,37 @@ Assoc: mov %dx,%si # Assoc(x:ax,y:dx):ax
mov (TWO,%di),%ax # ax = Cdar(y) mov (TWO,%di),%ax # ax = Cdar(y)
ret ret
.type .sig,@object; 1: mov (TWO,%di),%di # di = Cdr(c)
Evcon: push %di # save c
mov (%di),%si # di = Car(c)
lodsw # ax = Caar(c)
call Eval
pop %di # restore c
test %ax,%ax # nil test
jz 1b
mov (%di),%di # di = Car(c)
.EvCadr:call Cadr # ax = Cadar(c)
# jmp Eval
Eval: push %dx # Eval(e:ax,a:dx):ax w/ gc
push g_mem # with garbage collections
call .Eval # discards non-result cons
pop %dx
push g_mem
mov g_mem,%bp
sub %dx,%bp
xchg %ax,%di
call Gc
pop %si
mov %dx,%di
mov g_mem,%cx
sub %si,%cx
rep movsb
mov %di,g_mem
pop %dx
ret
.type .sig,@object
.sig: .sig:
.fill 510 - (. - _start), 1, 0xce .fill 510 - (. - _start), 1, 0xce
.word 0xAA55 .word 0xAA55