#lang scheme/base

;; Target code registry.

;; During instantiation of a Forth module, postponed code can be
;; registered for later compilation/assembly.

(require "tools.ss"
         "target.ss")
(provide code-register-postponed!
         code-compile!
         code-print
         code-pointers
         code-pointers-set!
         code->binary
         code-clear!)



;; To keep track of possible multiple instances.
;; (printf "Instantiating target code repository.\n")

;; ACCUMULATION

;; Stack used during the 'forth-begin form.
(define *postponed-macro-stack* '()) ;; stack used for postponed word collection.
(define (code-register-postponed! code) (push! *postponed-macro-stack* code))


;(define (compile!)
;  (set! *cfg* (append (compile (code-postponed-pop-stack)) *cfg*))
;  (set! *inlined-macro-stack* '()))

;; COMPILATION

;; Stacks used to gather compiled and possibly assembled code.
(define *postponed* '())
(define *cfg* '())

;; Assembly state.
(define *pointers* '((code 0) (data 0)))
(define (code-pointers) *pointers*)
(define (code-pointers-set! p) (set! *pointers* p))

(define (code-compile! compile assemble!)
  (let ((cfg (compile *postponed-macro-stack*)))
    (let-values (((_ pointers) (assemble! cfg *pointers*)))
      (set! *pointers* pointers)
      (set! *cfg* (append cfg *cfg*))
      (set! *postponed* (append *postponed-macro-stack* *postponed*)) ;; save original macros
      (set! *postponed-macro-stack* '()))))

(define (code-print [cfg *cfg*])
  (for-each print-target-word (reverse cfg)))


;; QUERY
(define (code->binary [chain-list *cfg*])
  (map
   (lambda (c) (binchunk-split c 0 8))
   (or (target-chains->bin chain-list)
       (error 'code->binary))))


(define (code-clear!)
  (set! *postponed-macro-stack* '()) 
  (set! *postponed* '())
  (set! *cfg* '()))