UNB/ CS/ David Bremner/ teaching/ cs4613/ lectures/ lecture17/ malloc-ex.rkt
#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)