#lang scheme/base

;; This extends the control.ss macro language (which implements
;; Forth-style control words on top of the pure macro language Coma)
;; with control flow marking exported by instantiate.ss

(require
 "instantiate.ss"        ;; redefines exit
 "../scat.ss"
 "../coma.ss"
 "../control.ss"         ;; control words without flow analysis

 )

(provide (all-defined-out))

;; UTIL

;; Patch core functionality in instantiate.ss
(compile-exit    (ns (macro) exit))
(compile-literal (lambda (x) (macro-prim: ',x literal)))
(compile-word    (lambda (x) (macro-prim: ',x compile)))

;; LABELS

(patterns
 (macro)

 ;; Redefine the stubs from control.ss to introduce labels used to
 ;; construct structured code graphs.
 
 ((sym)               ([qw (make-target-label)]))
 (([qw name] >label)  ([qw (make-target-label name)]))
 (([qw label] label:) (make-target-split label))

;; EXIT

 ((exit)              (macro: primitive-exit ,terminate-chain))

 ;; Semicolon either compiles local macro exit (mexit) within macro
 ;; instantiation, or the target's RETURN instruction. A semicolon
 ;; fallen over is an 'exit' that doesnt register end-of-word.  It
 ;; means the code after the exit is reachable. Mainly useful for jump
 ;; tables using 'route'.

 ((";")               (macro: ,semicolon))
 ((".,")              (macro: primitive-exit))

;; ORG

 ;; Since the compiler has no access to code addresses, handling an
 ;; address specification needs to be postponed to the assembly phase
 ;; in the form of a directive. This directive takes the place of a
 ;; symbolic target word name. (Semantically, it acts as one.)

 ;; There are 2 org variants: a temporary one, which manipulates the
 ;; current compiler chain/store state while compiling a chain.
 
 (([qw address] word-org-push) (macro: ,split-store
                                       ',(list 'org address)
                                       >label label:))
 
 ((org-pop)  (macro: ,terminate-chain
                     ,combine-store   ;; needs to be one chain
                     ,merge-store))   

 ;; .. and a permanent one which just sets the current assembly
 ;; address, and doesn't manipulate chains (all chunks will simply
 ;; follow after address is changed).

 (([qw address] word-org)  (macro: ,(make-target-split #f)
                                   ,terminate-chain
                                   ',(list 'org! address)
                                   >label label:))

 
)