From 879497f303f908bd5d15a89f23e581e05f198cc0 Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Thu, 27 Apr 2017 10:10:44 +0200 Subject: [PATCH 1/5] Split off kernel-specific code from metacompiler. --- Makefile | 2 +- lib/meta.fth | 159 +++++--------------------- src/compile.fth | 109 ++++++++++++++++++ targets/arm/{meta.fth => build.fth} | 2 +- targets/asmjs/{meta.fth => build.fth} | 2 +- targets/asmjs/cold.fth | 12 +- targets/asmjs/nucleus.fth | 1 + targets/c/build.fth | 1 + targets/m68k/{meta.fth => build.fth} | 2 +- targets/pdp11/{meta.fth => build.fth} | 2 +- targets/riscv/{meta.fth => build.fth} | 2 +- targets/x86/{meta.fth => build.fth} | 2 +- 12 files changed, 154 insertions(+), 142 deletions(-) create mode 100644 src/compile.fth rename targets/arm/{meta.fth => build.fth} (82%) rename targets/asmjs/{meta.fth => build.fth} (84%) create mode 100644 targets/c/build.fth rename targets/m68k/{meta.fth => build.fth} (83%) rename targets/pdp11/{meta.fth => build.fth} (84%) rename targets/riscv/{meta.fth => build.fth} (82%) rename targets/x86/{meta.fth => build.fth} (82%) diff --git a/Makefile b/Makefile index 822fd3a..c742af9 100644 --- a/Makefile +++ b/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 diff --git a/lib/meta.fth b/lib/meta.fth index 6fb1299..f04dd15 100644 --- a/lib/meta.fth +++ b/lib/meta.fth @@ -35,8 +35,6 @@ require search.fth -vocabulary compiler - vocabulary t-words defer t, : t-word ( a u xt -- ) -rot "create , does> @ t, ; @@ -45,23 +43,27 @@ defer t, : 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 @@ -96,132 +98,31 @@ 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 , ; -: resolve here swap ! ; -: @ 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 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 diff --git a/src/compile.fth b/src/compile.fth new file mode 100644 index 0000000..79645e7 --- /dev/null +++ b/src/compile.fth @@ -0,0 +1,109 @@ +\ Metacompile the kernel. Copyright 2017 Lars Brinkhoff. + +include lib/meta.fth + +only forth also meta definitions +include asm.fth + +load-address org +exe-header + +include nucleus.fth + +host also meta definitions + +: >mark here 0 , ; +: resolve here swap ! ; +: nfa dup c@ negate swap c! ; +h: to ' >body ! ; +h: is ' >body ! ; + +h: ?: already-defined? if ignore-definition else : then ; + +only forth also meta also compiler definitions previous + +h: ; compile exit [compile] [ ; + +h: ['] ' t-literal ; +h: [char] char t-literal ; +h: literal t-literal ; +h: compile ' t-literal compile , ; +h: [compile] ' , ; +h: does> 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" compile (sliteral) parse" dup , ", ; +h: ." [compile] s" compile type ; + +h: if compile 0branch >mark ; +h: ahead compile branch >mark ; +h: then >resolve ; + +h: begin body t-literal compile ! ; +h: is [compile] to ; + +h: do 0leaves compile 2>r [compile] begin ; +h: loop compile (loop) [compile] until here leaves@ chains! compile 2rdrop ; +h: leave compile branch leaves chain, ; + +h: abort" [compile] if [compile] s" compile cr compile type + compile cr compile abort [compile] then ; + +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 diff --git a/targets/arm/meta.fth b/targets/arm/build.fth similarity index 82% rename from targets/arm/meta.fth rename to targets/arm/build.fth index 7fd2823..4a9c070 100644 --- a/targets/arm/meta.fth +++ b/targets/arm/build.fth @@ -2,4 +2,4 @@ 1 constant t-little-endian s" targets/arm/" searched -include lib/meta.fth +include src/compile.fth diff --git a/targets/asmjs/meta.fth b/targets/asmjs/build.fth similarity index 84% rename from targets/asmjs/meta.fth rename to targets/asmjs/build.fth index cb2df1b..ed3ed08 100644 --- a/targets/asmjs/meta.fth +++ b/targets/asmjs/build.fth @@ -3,4 +3,4 @@ 1 constant t-little-endian 1 constant t-asmjs s" targets/asmjs/" searched -include lib/meta.fth +include src/compile.fth diff --git a/targets/asmjs/cold.fth b/targets/asmjs/cold.fth index 0e4cf04..bba0f40 100644 --- a/targets/asmjs/cold.fth +++ b/targets/asmjs/cold.fth @@ -1,11 +1,11 @@ host -also meta t' latest0 previous constant 'latest0 -also meta t' turnkey previous constant 'turnkey -also meta t' limit previous constant 'limit -also meta t' sp0 previous constant 'sp0 -also meta t' rp0 previous constant 'rp0 -also meta t' dp0 previous constant 'dp0 +also meta ' latest0 previous constant 'latest0 +also meta ' turnkey previous constant 'turnkey +also meta ' limit previous constant 'limit +also meta ' sp0 previous constant 'sp0 +also meta ' rp0 previous constant 'rp0 +also meta ' dp0 previous constant 'dp0 : final ." HEAPU32[" 'latest0 . ." +28>>2] = " 'turnkey . ." ;" cr diff --git a/targets/asmjs/nucleus.fth b/targets/asmjs/nucleus.fth index 7a20de2..13bcd5f 100644 --- a/targets/asmjs/nucleus.fth +++ b/targets/asmjs/nucleus.fth @@ -4,6 +4,7 @@ include targets/asmjs/next.fth +target start-code "use strict"; diff --git a/targets/c/build.fth b/targets/c/build.fth new file mode 100644 index 0000000..772b666 --- /dev/null +++ b/targets/c/build.fth @@ -0,0 +1 @@ +include targets/c/meta.fth diff --git a/targets/m68k/meta.fth b/targets/m68k/build.fth similarity index 83% rename from targets/m68k/meta.fth rename to targets/m68k/build.fth index 5dbe489..2dfd9b8 100644 --- a/targets/m68k/meta.fth +++ b/targets/m68k/build.fth @@ -2,4 +2,4 @@ 0 constant t-little-endian s" targets/m68k/" searched -include lib/meta.fth +include src/compile.fth diff --git a/targets/pdp11/meta.fth b/targets/pdp11/build.fth similarity index 84% rename from targets/pdp11/meta.fth rename to targets/pdp11/build.fth index 58af7e1..d56dc67 100644 --- a/targets/pdp11/meta.fth +++ b/targets/pdp11/build.fth @@ -3,4 +3,4 @@ 1 constant t-little-endian 2 constant t-cell s" targets/pdp11/" searched -include lib/meta.fth +include src/compile.fth diff --git a/targets/riscv/meta.fth b/targets/riscv/build.fth similarity index 82% rename from targets/riscv/meta.fth rename to targets/riscv/build.fth index 40333e4..0192e1c 100644 --- a/targets/riscv/meta.fth +++ b/targets/riscv/build.fth @@ -2,4 +2,4 @@ 1 constant t-little-endian s" targets/riscv/" searched -include lib/meta.fth +include src/compile.fth diff --git a/targets/x86/meta.fth b/targets/x86/build.fth similarity index 82% rename from targets/x86/meta.fth rename to targets/x86/build.fth index 099ad48..17a1b0d 100644 --- a/targets/x86/meta.fth +++ b/targets/x86/build.fth @@ -2,4 +2,4 @@ 1 constant t-little-endian s" targets/x86/" searched -include lib/meta.fth +include src/compile.fth From 14bffee7282c24b57a70b2ed4be760aafe2e250b Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Sat, 29 Apr 2017 20:56:06 +0200 Subject: [PATCH 2/5] Move more things from metacompiler. --- lib/meta.fth | 29 ----------------------------- src/compile.fth | 36 ++++++++++++++++++++++++++++++++++-- 2 files changed, 34 insertions(+), 31 deletions(-) diff --git a/lib/meta.fth b/lib/meta.fth index f04dd15..d21d26e 100644 --- a/lib/meta.fth +++ b/lib/meta.fth @@ -69,35 +69,6 @@ target-image ' , is t, -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+ , ; - include lib/xforward.fth : compile parse-name postpone sliteral postpone "' postpone , ; compile-only diff --git a/src/compile.fth b/src/compile.fth index 79645e7..51696b4 100644 --- a/src/compile.fth +++ b/src/compile.fth @@ -2,7 +2,41 @@ include lib/meta.fth +only forth definitions + +: h: : ; +: h-[defined] postpone [defined] ; +: h-[undefined] postpone [undefined] ; + +also meta definitions + +s" " searched +s" src/" searched +include params.fth +: >link next-offset + ; +: >code code-offset + ; +: >body body-offset + ; + +h-[defined] does-offset constant has-does? +h-[undefined] code@ [if] : code@ >body ; [then] + only forth also meta definitions + +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+ , ; + include asm.fth load-address org @@ -23,8 +57,6 @@ host also meta definitions ' dodef code@ to 'dodef ' dodoes code@ to 'dodoes -: h: : ; - h: : parse-name header, docol, ] ; h: create parse-name header, dovar, ; h: variable create cell allot ; From 5f09e00035a54777f293a3ce08ea3a08e0dec26c Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Mon, 1 May 2017 21:25:14 +0200 Subject: [PATCH 3/5] fix --- lib/aout.fth | 3 ++- lib/elf.fth | 2 +- targets/riscv/asm.fth | 2 ++ test/test-elf.fth | 1 + test/test-pe.fth | 2 ++ test/test-save-image.fth | 1 + 6 files changed, 9 insertions(+), 2 deletions(-) diff --git a/lib/aout.fth b/lib/aout.fth index c4a684b..94c69cf 100644 --- a/lib/aout.fth +++ b/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! ; diff --git a/lib/elf.fth b/lib/elf.fth index 66a49bf..5cbdf26 100644 --- a/lib/elf.fth +++ b/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, ; diff --git a/targets/riscv/asm.fth b/targets/riscv/asm.fth index f8168bd..489813a 100644 --- a/targets/riscv/asm.fth +++ b/targets/riscv/asm.fth @@ -179,8 +179,10 @@ reg: x16 reg: x17 reg: x18 reg: x19 reg: x20 reg: x21 reg: x22 reg: x23 reg: x24 reg: x25 reg: x26 reg: x27 reg: x28 reg: x29 reg: x30 reg: x31 drop +also forth create tmp1 3 cells allot create tmp2 3 cells allot +previous \ Aliases. : nop, 0 # x0 x0 addi, ; diff --git a/test/test-elf.fth b/test/test-elf.fth index 4d626cd..a8ccc23 100644 --- a/test/test-elf.fth +++ b/test/test-elf.fth @@ -1,6 +1,7 @@ require search.fth 1 constant t-little-endian +: h-[defined] postpone [defined] ; vocabulary cross only forth also cross definitions diff --git a/test/test-pe.fth b/test/test-pe.fth index b55f171..34fe5ad 100644 --- a/test/test-pe.fth +++ b/test/test-pe.fth @@ -1,5 +1,7 @@ require search.fth +: h-[defined] postpone [defined] ; + vocabulary cross only forth also cross definitions 0 constant t-little-endian diff --git a/test/test-save-image.fth b/test/test-save-image.fth index 1630838..4d2f8ad 100644 --- a/test/test-save-image.fth +++ b/test/test-save-image.fth @@ -1,3 +1,4 @@ +: h-[defined] postpone [defined] ; include lib/save-image.fth : check ." Save-Image-OK" cr bye ; ' check is turnkey From 5681ecdc2207094b07e639c7795c3596bcecdee8 Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Fri, 12 May 2017 10:17:32 +0200 Subject: [PATCH 4/5] Document the metacompiling build process. --- doc/build.md | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) create mode 100644 doc/build.md diff --git a/doc/build.md b/doc/build.md new file mode 100644 index 0000000..eccd59d --- /dev/null +++ b/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. From a2e73bf032c2ff9dd029102190393f0373c0baee Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Mon, 22 May 2017 10:53:01 +0200 Subject: [PATCH 5/5] Hooks for compiler targets. --- lib/meta.fth | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/lib/meta.fth b/lib/meta.fth index d21d26e..b6e7353 100644 --- a/lib/meta.fth +++ b/lib/meta.fth @@ -36,8 +36,10 @@ require search.fth 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 ; @@ -68,13 +70,15 @@ target-image 0 value latest ' , is t, +' t, is t-compile, include lib/xforward.fth : compile parse-name postpone sliteral postpone "' postpone , ; compile-only : [compile] also compiler ' previous compile, ; compile-only -: t-literal compile (literal) , ; +: (t-literal) compile (literal) , ; also forth +' (t-literal) is t-literal : t-constant create , does> @ t-literal ; previous