#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. This is then used in instantiate.ss to
;; compile code to a code graph.

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

 )

(provide (all-defined-out))


;; 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))
 
 ((split)    (make-target-split #f))

;; 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: split
                                   terminate-chain
                                   ',(list 'org! address)
                                   >label label:))

 
)

;; EXIT

;; Semicolon either compiles local macro exit (mexit) within macro
;; instantiation, or the target's RETURN instruction.

(define-ns (macro) ";"  (ns (macro) semicolon))

;; A ';' 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'.

(define-ns (macro) ".," (ns (macro) primitive-exit))