Refactor metacompiler

Makefile

@@ -12,7 +12,7 @@ sysdir ?= $(sharedir)/lbForth
 TFORTH = $(TARGET)-forth
 TDIR = targets/$(TARGET)
 TSTAMP = $(TARGET)-$(OS)-stamp
-META = $(TDIR)/meta.fth
+META = $(TDIR)/build.fth
 FORTH = $(TDIR)/run.sh ./forth
 DEPS = src/kernel.fth src/dictionary.fth $(TDIR)/nucleus.fth
 PARAMS = params.fth jump.fth threading.fth target.fth

doc/build.md

@@ -0,0 +1,22 @@
+This describes how lbForth is normally built.
+
+- To build a target, load its build.fth file.  Every target should
+  have one.
+
+- build.fth sets up some information about the target, and loads the
+  generic compile.fth.
+
+- compile.fth loads the generic metacompiler framework.
+
+  - The generic metacompiler loads a library for accessing a target image.
+
+  - And creates vocabularies for metacompiling words.
+
+- compile.fth proceeds to add metacompiling words that target lbForth.
+
+- And a target assembler.
+
+- It then loads kernel.fth and cold.fth to build a target image.
+
+- Finally, forward references are resolved, and the image is saved to
+  disk.

lib/aout.fth

@@ -5,6 +5,7 @@ require lib/common.fth
 also forth
 base @
 octal
+: h] ] ;
 previous
 
 ( Constants )
@@ -19,7 +20,7 @@ decimal
 
 ( Data types )
 
-: dp!   dp [ also forth ] ! [ previous ] ;
+: dp!   dp [ also forth h] ! [ previous h] ;
 
 : w, ( x -- ) dup c, 8 rshift c, ;
 : w! ( x a -- ) here >r dp! w, r> dp! ;

lib/elf.fth

@@ -52,7 +52,7 @@ hex
 
 ( Data types )
 
-[defined] t-little-endian [if]
+h-[defined] t-little-endian [if]
    t-little-endian [if]
       1 constant endian
       : h, ( x -- )   dup c,  8 rshift c, ;

lib/meta.fth

@@ -35,193 +35,69 @@
 
 require search.fth
 
-vocabulary compiler
-
 vocabulary t-words
+defer t-compile,
+defer t-literal
 defer t,
-: t-word ( a u xt -- ) -rot "create , does> @ t, ;
+: t-word ( a u xt -- ) -rot "create , does> @ t-compile, ;
 : fatal   cr source type cr bye ;
 : ?undef   0= if ." Undefined!" fatal then ;
 : t-search   ['] t-words search-wordlist ;
 : defined?   t-search if drop -1 else 0 then ;
 : "' ( u a -- xt ) t-search ?undef >body @ ;
-: t'   parse-name "' ;
-: t-compile   parse-name postpone sliteral postpone "' postpone t, ; immediate
-: t-[compile]   also compiler ' previous compile, ; immediate
-: t-literal   t-compile (literal) t, ;
-: t-constant   create , does> @ t-literal ;
 
 : already-defined?   >in @ >r parse-name defined? r> >in ! ;
 : trailing-semicolon?   source 1- + c@ [char] ; = ;
 : ignore-definition   begin trailing-semicolon? postpone \ until ;
 
+: h-number   [ action-of number ] literal is number ;
+
 variable leaves
 : 0leaves   0 leaves ! ;
 : leaves@   leaves @ ;
 
 vocabulary meta
+vocabulary compiler
+
+: target   only forth also meta also t-words definitions previous ;
+
 only forth also meta definitions
+: host   only forth definitions ;
+
 include lib/image.fth
+target-image
 
 0 value latest
 
 ' , is t,
+' t, is t-compile,
 
-s" " searched
-s" src/" searched
-include params.fth
-: >link   next-offset + ;
-: >code   code-offset + ;
-: >body   body-offset + ;
-
-\ Does target have a DOES> field?
-[defined] does-offset constant has-does?
-
-\ Start of code in a CODE word.  Can be overridden by the target.
-[undefined] code@ [if] : code@ >body ; [then]
-
-0 value 'docol
-0 value 'dovar
-0 value 'docon
-0 value 'dodef
-0 value 'dodoes
-
-: code,   , ;
-
-: link, ( nt -- ) latest ,  to latest ;
-: reveal ;
-
-include target.fth
-
-: header, ( a u -- ) 2dup align here over >xt + t-word header, ;
-: ?code, ( -- ) here cell+ , ;
-
-: host   only forth definitions host-image ;
-
-include asm.fth
 include lib/xforward.fth
 
-only forth definitions also meta
-: target   only forth also meta also t-words definitions previous target-image ;
-
-target
-load-address org
-exe-header
-
-include nucleus.fth
-
-host also meta definitions
-
-: >mark   here 0 , ;
-: <mark   here ;
-: >resolve   here swap ! ;
-: <resolve   , ;
+: compile   parse-name postpone sliteral postpone "' postpone , ; compile-only
+: [compile]   also compiler ' previous compile, ; compile-only
+: (t-literal)   compile (literal) , ;
+also forth
+' (t-literal) is t-literal
+: t-constant   create , does> @ t-literal ;
+previous
 
-: h-number   [ action-of number ] literal is number ;
 : ?number,   if 2drop undef fatal else drop t-literal 2drop then ;
 : number, ( a u -- ) 0 0 2over >number nip ?number, ;
 : t-number   ['] number, is number ;
+: '   parse-name "' ;
 
-target-image
-t' docol code@ to 'docol
-t' dovar code@ to 'dovar
-t' docon code@ to 'docon
-t' dodef code@ to 'dodef
-t' dodoes code@ to 'dodoes
-
-: h: : ;
-
-h: '   t' ;
-h: ]   only forward-refs also t-words also compiler  t-number ;
-h: :   parse-name header, docol, ] ;
-h: create   parse-name header, dovar, ;
-h: variable   create cell allot ;
-h: defer   parse-name header, dodef, t-compile abort ;
-h: constant   parse-name header, docon, , ;
-h: value   constant ;
-h: immediate   latest >nfa dup c@ negate swap c! ;
-h: to   ' >body ! ;
-h: is   ' >body ! ;
-h: [defined]   parse-name defined? ;
-h: [undefined]   [defined] 0= ;
-
-h: ?:   already-defined? if ignore-definition else : then ;
-
-only forth also meta also compiler definitions previous
-
-h: \   postpone \ ;
-h: (   postpone ( ;
-h: [if]   postpone [if] ;
-h: [else]   postpone [else] ;
-h: [then]   postpone [then] ;
-
-h: [   target h-number ;
-h: ;   t-compile exit t-[compile] [ ;
-
-h: [']   ' t-literal ;
-h: [char]   char t-literal ;
-h: literal   t-literal ;
-h: compile   ' t-literal t-compile , ;
-h: [compile]   ' , ;
-h: does>   t-compile (does>) ;
-
-cell-size t-constant cell
-next-offset t-constant TO_NEXT
-code-offset t-constant TO_CODE
-body-offset t-constant TO_BODY
-has-does? [if] does-offset t-constant TO_DOES [then]
-
-'docol t-constant 'docol   
-'dovar t-constant 'dovar   
-'docon t-constant 'docon   
-'dodef t-constant 'dodef   
-'dodoes t-constant 'dodoes   
-
-h: s"   t-compile (sliteral) parse" dup , ", ;
-h: ."   t-[compile] s" t-compile type ;
-
-h: if   t-compile 0branch >mark ;
-h: ahead   t-compile branch >mark ;
-h: then   >resolve ;
-
-h: begin   <mark ;
-h: again   t-compile branch <resolve ;
-h: until   t-compile 0branch <resolve ;
-
-h: else   t-[compile] ahead swap t-[compile] then ;
-h: while    t-[compile] if swap ;
-h: repeat   t-[compile] again t-[compile]  then ;
-
-h: to   ' >body t-literal t-compile ! ;
-h: is   t-[compile] to ;
-
-h: do   0leaves  t-compile 2>r  t-[compile] begin ;
-h: loop   t-compile (loop) t-[compile] until  here leaves@ chains!  t-compile 2rdrop ;
-h: leave   t-compile branch  leaves chain, ;
-
-h: abort"   t-[compile] if t-[compile] s" t-compile cr t-compile type
-   t-compile cr t-compile abort t-[compile] then ;
-
-\ only forth :noname 2dup type space (parsed) ; is parsed
-target
-
-include kernel.fth
-include cold.fth
-
-only forth also meta also t-words resolve-all-forward-refs
-
-only forth also meta
-exe-end
-
-save-target bye
-
-host also meta
-
-cr .( Target size: ) t-size .
-cr .( Target used: ) target here host also meta >host t-image host - .
-cr .( Host unused: ) unused .
-cr .( Target words: ) also t-words words only forth
-cr .( Forward refs: ) also meta also forward-refs words
-cr
-
-target-region hex dump bye
+: ]   only forward-refs also t-words also compiler  t-number ;
+
+: [defined]   parse-name defined? ;
+: [undefined]   [defined] 0= ;
+
+only forth also compiler definitions
+: [   target h-number ;
+: \   postpone \ ;
+: (   postpone ( ;
+: [if]   postpone [if] ;
+: [else]   postpone [else] ;
+: [then]   postpone [then] ;
+
+also meta host