#lang plait
(define code-memory (make-vector 2048 0))
(define code-ptr 0)
(define data-ptr 0)
(define k-reg 0)
(define v-reg 0)
(define env-reg 0)
(define env2-reg 0)
(define result-reg 0)
(define PC 0)
(define-syntax-rule (display* thing ...)
(begin (display thing) ...))
(define trace-level (make-parameter 0))
(define-syntax-rule (store! register expr)
(let ([value expr])
(begin
(when (> (parameter-ref trace-level) 1)
(display* (symbol->string (quote register))
" <- " (to-string value) "\n"))
(set! register value))))
(define (reset!)
(begin
(store! code-ptr 0)
(store! data-ptr 0)
(store! v-reg 0)
(store! PC 0)
(store! k-reg 0)
(store! env-reg 0)
(store! result-reg 0)
(void)))
(define (vector-set-elements! vec offset data)
(when (not (empty? data))
(vector-set! vec offset (first data))
(vector-set-elements! vec
(add1 offset) (rest data))))
(define (mallocf data)
(let* ([old data-ptr]
[new (+ old (length data))])
(begin
(when (>= new (vector-length data-memory))
(error 'malloc "out of memory"))
(vector-set-elements! data-memory old data)
(store! data-ptr new)
old)))
(define-syntax-rule (malloc tag data ...)
(mallocf (list tag data ...)))
(define (code-mallocf data)
(let* ([old code-ptr]
[new (+ old (length data))])
(begin
(when (>= new (vector-length code-memory))
(error 'malloc "out of memory"))
(vector-set-elements! code-memory old data)
(store! code-ptr new)
old)))
(define-syntax-rule (code-malloc tag data ...)
(code-mallocf (list tag data ...)))
;; ref : number number -> number
(define (ref n d)
(vector-ref data-memory (+ n d)))
(define (code-ref n d)
(vector-ref code-memory (+ n d)))
;; Code
(define tag:Num 8)
(define tag:Add 9)
(define tag:Sub 10)
(define tag:Id 11)
(define tag:Lam 12)
(define tag:Call 13)
(define tag:If0 14)
;; Values
(define tag:NumV 15)
(define tag:ClosureV 16)
(define tag:Bind 17)
(define tag:Moved 18)
(define MEMORY-SIZE 128)
(define data-memory (make-vector MEMORY-SIZE 0))
(reset!)
(test (malloc tag:Add 3 4) 0)
(test (ref 0 1) 3)
(test (ref 0 2) 4)