117 lines
1.7 KiB
Scheme
117 lines
1.7 KiB
Scheme
;; Note that this is scheme syntax wrapping asm for a stack machine
|
|
(variable eom 1024)
|
|
;; These need to be initialized with the runtime
|
|
(variable scan 0)
|
|
(variable free 0)
|
|
(variable old 0)
|
|
(variable new 0)
|
|
(variable root 0)
|
|
|
|
(push main)
|
|
(jmp)
|
|
|
|
alloc ;; ( -- p)
|
|
;; Test if free will go beyond eom
|
|
(ref free)
|
|
(dup) ; ( -- free free)
|
|
(push 8)
|
|
(+)
|
|
(dup) ; ( -- free free+8 free+8)
|
|
(ref eom)
|
|
(<) ; ( -- free free+8 (free+8 < eom))
|
|
(push alloc-do-gc)
|
|
(if)
|
|
;; write free+8 to free
|
|
(set! free)
|
|
;; return the old free, it is memory the program can use
|
|
(return)
|
|
alloc-do-gc
|
|
;; Empty the stack
|
|
(drop)
|
|
(drop)
|
|
;; Run garbage collection
|
|
(push gc-start)
|
|
(call)
|
|
;; Tail-call allocation
|
|
(push alloc)
|
|
(jmp)
|
|
|
|
gc-run ;; ( -- )
|
|
; Move scan & free to start of new memory
|
|
(ref new)
|
|
(dup)
|
|
(set! free)
|
|
(set! scan)
|
|
(ref root)
|
|
(push relocate-cons)
|
|
(call)
|
|
(push gc-loop)
|
|
(call)
|
|
; Flip old and new
|
|
(ref old)
|
|
(ref new)
|
|
(set! old)
|
|
(set! new)
|
|
(return)
|
|
|
|
relocate-cons ;; (o -- )
|
|
(dup)
|
|
(@)
|
|
(push relocate-reg)
|
|
(call)
|
|
(push 4)
|
|
(+)
|
|
(@)
|
|
(push relocate-reg)
|
|
|
|
relocate-reg ;; (r -- )
|
|
(dup)
|
|
(push cons?)
|
|
(call)
|
|
(push reg-relocated)
|
|
(if)
|
|
(dup)
|
|
(push eol?)
|
|
(call)
|
|
(not)
|
|
(push reg-relocated)
|
|
(if)
|
|
(dup)
|
|
(push broken-heart?)
|
|
(call)
|
|
(push copy-and-construct)
|
|
(if)
|
|
(dup) ;; Broken heart, copy updated address from cdr
|
|
(push 4)
|
|
(+)
|
|
(@) ;; Retrieve new address
|
|
(dup)
|
|
(!) ;; Write it here
|
|
(push reg-relocated)
|
|
(jmp)
|
|
copy-and-construct
|
|
(dup) ;; Wasn't a broken heart, move car to new memory
|
|
(@)
|
|
(push free)
|
|
(!)
|
|
(dup) ;; Push cdr to new memory
|
|
(push 4)
|
|
(+)
|
|
(@)
|
|
(push free)
|
|
(push 4)
|
|
(+)
|
|
(!)
|
|
(dup) ;; Construct the broken heart
|
|
(push install-broken-heart)
|
|
(call)
|
|
(ref free) ;; Move free pointer
|
|
(push 8)
|
|
(+)
|
|
(set! free)
|
|
reg-relocated
|
|
(drop)
|
|
(return)
|
|
main
|
|
;; TODO
|