77 lines
1.1 KiB
Scheme
77 lines
1.1 KiB
Scheme
;; Note that this is scheme syntax wrapping asm for a stack machine
|
|
(variable scan 0)
|
|
(variable free 0)
|
|
(variable eom 1024)
|
|
;; These need to be initialized later
|
|
(variable root 0)
|
|
(variable the-cars 0)
|
|
(variable the-cdrs 0)
|
|
(variable new-cars 0)
|
|
(variable new-cdrs 0)
|
|
|
|
|
|
(push main)
|
|
(jmp)
|
|
|
|
alloc
|
|
;; Test if free will go beyond eom
|
|
(push free)
|
|
(@)
|
|
(dup) ; ( -- free free)
|
|
(push 8)
|
|
(+)
|
|
(dup) ; ( -- free free+8 free+8)
|
|
(push eom)
|
|
(@)
|
|
(<) ; ( -- free free+8 (free+8 < eom))
|
|
(branch alloc-do-gc)
|
|
;; write free+8 to free
|
|
(push 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-start
|
|
; Move scan & free back to 0
|
|
(push 0)
|
|
(push free)
|
|
(!)
|
|
(push 0)
|
|
(push scan)
|
|
(!)
|
|
; Push the first cons to relocate (root)
|
|
(push root)
|
|
(@)
|
|
; Call the relocation routine
|
|
(push gc-loop)
|
|
(call)
|
|
; Swap new and old cars and cdrs
|
|
(push new-cars)
|
|
(@)
|
|
(push the-cars)
|
|
(@)
|
|
(push new-cars)
|
|
(!)
|
|
(push the-cars)
|
|
(!)
|
|
(push new-cdrs)
|
|
(@)
|
|
(push the-cdrs)
|
|
(@)
|
|
(push new-cdrs)
|
|
(!)
|
|
(push the-cdrs)
|
|
(!)
|
|
; return to allocation
|
|
(return)
|