#lang scheme/base
(require
scheme/control
"forth/forth-tx.ss"
"tools.ss"
(for-syntax scheme/base
"tools.ss"))
(require/provide
"coma/macro.ss"
"coma/comma-unit.ss" "coma/code-unit.ss" "control/control-unit.ss" "comp/compiler-unit.ss" "pic18/pic18-unit.ss" "pic18/pic18-control-unit.ss"
"comp/postprocess.ss"
"coma/macro-forth.ss" "pic18/forth.ss"
"forth/forth-lex.ss"
"asm.ss"
"pic18/asm.ss"
"pic18/sig.ss"
"code.ss"
)
(provide (all-defined-out))
(define/invoke
(stack^
stack-extra^
memory-extra^
ram^
comma^
code^
jump^
cjump^
control^
cfg^
rstack^
org^
machine^
instantiate^
pic18-assembler^
pic18-extra^
pic18-postproc^)
(pic18@ pic18-control@ comma@ code@ compiler@ control@))
(define-syntax-rule (postproc name)
(macro->postprocess (ns (macro) name)
))
(define (pic18-compile->cfg inline-macros)
(words->cfg!
(compile-words inline-macros) (compose
(postproc opti-save)
(postproc pseudo)
)))
(define pic18-debug (make-parameter #f))
(define (compile!)
(code-compile!
(lambda (in)
(let ((cfg (pic18-compile->cfg in)))
(when (pic18-debug)
(code-print cfg))
cfg))
assemble!))
(define-forth-parser forth-begin (code-register-postponed!
wrap-macro
wrap-word
wrap-variable))
(define-syntax (pic18-begin stx)
(syntax-case stx ()
((_ . code)
#`(begin
(forth-begin
path #,(build-path (home) "pic18") . code)
(compile!)))))
(define-syntax-rule (pic18-module-begin . words)
(#%plain-module-begin
(pic18-begin |{| provide forth-load/compile |}| . words)))
(define-syntax-rule (forth-compile str)
(forth-lex-string/cps pic18-begin str))
(define-syntax-rule (forth-load/compile str)
(forth-begin load str))
(require "comp/state.ss")
(define-dasm-collection dasm-collection)