From 94d40c7e5521898acd394ca7a3e30cf20065ee5c Mon Sep 17 00:00:00 2001 From: ken Date: Mon, 5 Mar 2018 18:47:41 -0800 Subject: [PATCH] cleanup, compilation semantics --- forth.forth | 104 +++++++++++++++++++++++++++++++++++++--------------- forth.js | 88 +++++++++++++++++++++----------------------- forth.wat | 28 +++++++++++--- 3 files changed, 138 insertions(+), 82 deletions(-) diff --git a/forth.forth b/forth.forth index 63da4a7..fb04e4d 100644 --- a/forth.forth +++ b/forth.forth @@ -10,13 +10,14 @@ \ \ You should have received a copy of the GNU General Public License \ along with this program. If not, see . + +\ word EXECUTE 12 define 16500 execute WORD 16500 29 execute word DEFINE 29 29 execute -\ word EXECUTE 12 define word RINIT 3 define word NOOP 13 define word MODE 14336 define -word EXECUTE-MODE 16680 define +word EXECUTE-WORD 16680 define word EXECUTE-NUM 16720 define word INTERPRET 16400 define word KEY 5 define @@ -37,6 +38,8 @@ word !CHANNEL 35 define word !HERE 36 define word HERE 28 define +word STACKTRACE 46 define + word ; 1 define word JZ: 14 define word JNZ: 15 define @@ -61,42 +64,83 @@ word 2DROP 32 define word SWAP 26 define word ROT 31 define +\ ' "TICK" returns address of word's execution semantics word ' here define word word find , word find find , word ; find , +\ : "COLON" sets execution semantics word : here define +word : here define-does ' word , ' here , ' define , ' ; , -' : dup define-does -: IWRITE-MODE ' dup , ' JNZ: , here 12 + , ' 2drop , ' ; , +\ :> "DOES" sets compilation semantics +word :> here define-does +: :> ' word , ' here , ' define-does , ' ; , + +\ ::> "COLON DOES" sets execution and compilation semantics +word ::> here define-does +word ::> here define +' word , ' 2dup , ' here , ' define-does , ' here , ' define , ' ; , + +\ write the execution semantics of a word to memory +: MEMORIZE-WORD ' dup , ' JNZ: , here 12 + , ' 2drop , ' ; , ' 2dup , ' find , ' dup , ' JZ: , here 16 + , ' , , ' 2drop , ' ; , -' drop , ' LIT , ' LIT , ' , , ' EXECUTE-NUM , ' , , ' ; , - -: i ' LIT , ' MODE , ' LIT , ' IWRITE-MODE , ' ! , ' ; , - -\i -\: e LIT MODE LIT EXECUTE-MODE ! ; -\: :> word find here define-does ; -\' :> \dup \define-does -\: FINISH-" DROP STRING-END ; -\: " STRING-START \: KLOOP KEY 34 =? JNZ: FINISH-" STRING-PUT JMP: KLOOP -\:> " " swap lit lit , , lit lit , , ; -\: IF JZ: \here \8 \+ \, ; word 2drop ; -\:> IF \: DOIF LIT JZ: , HERE DUP , ; -\: ELSE ; -\:> ELSE \: DOELSE LIT JMP: , HERE DUP , SWAP HERE ! ; -\: THEN ; -\:> THEN \: DOTHEN HERE ! ; -\: COMPILE-MODE dup -\doif 2dup find dup - \doif dup find-does dup - \doif swap drop rot 2drop execute ; - \dothen drop , 2drop ; +' drop , ' lit , ' lit , ' , , ' execute-num , ' , , ' ; , + +\ change interpreter semantics to "memorize-word" +: memorizing ' lit , ' mode , ' lit , ' memorize-word , ' ! , ' ; , + +\ memorize the compiler +\memorizing +\: executing lit mode lit execute-word ! ; +\: FINISH-" drop string-end ; +\: " string-start \: KLOOP key 34 =? JNZ: finish-" string-put JMP: KLOOP +\: DO" \:> " " swap lit lit , , lit lit , , ; +\: DOIF \:> IF lit JZ: , here dup , ; +\: DOELSE \:> ELSE lit JMP: , here dup , swap here ! ; +\: DOTHEN \:> THEN here ! ; +\: COMPILE-WORD dup +\doif 2dup find-does dup + \doif rot 2drop execute ; + \dothen drop 2dup find dup + \doif , 2drop ; \dothen drop lit lit , execute-num , ; -\dothen 2drop ; -\: c LIT MODE LIT COMPILE-MODE ! ; -\: DO" -\e +\dothen 2drop \do" Compilation Error: null word" .s bye +\: compiling lit mode lit compile-word ! ; + +\ compile the rest of the compiler +\compiling + +\ ; "RET" compilation semantics: ends a function and returns to executing mode +:> ; lit \' ; \, , lit \' ; \, , executing \' ; \, + +\ ;; "SEMIRET" compilation semantics: simply writes a return instruction +:> ;; lit \' ; \, , ; + +\ <: "OVERLOAD COLON" extend previous execution semantics of word +::> <: \compiling word 2dup find dup if here swap , define else drop here define +then compiling ; + +\ <:> "OVERLOAD COLON DOES" extend previous compilation semantics of word +::> <:> \compiling word 2dup find-does dup if here swap , define-does else drop +here define-does then compiling ; + +\ execution semantics of COLON, DOES, and COLON DOES now extended to +\ automatically switch to compilation mode +<: : compiling ; +<: :> compiling ; +<: ::> compiling ; + +\ Multi-line comments +::> ( key 41 =? swap -1 =? swap drop + if ;; then JMP: \' ( \, ; + +\ Set the number conversion base +: BASE 14348 swap ! ; + +( + End of bootstrap process + beyond this point, all hope is lost +) " watForth-32 Interactive CLI: " .s diff --git a/forth.js b/forth.js index 57aac39..9c0e58d 100644 --- a/forth.js +++ b/forth.js @@ -16,59 +16,74 @@ const initialize = Promise.all([ fetch('forth.wasm', {credentials: 'include', headers:{'content-type':'application/wasm'}}).then(re => re.arrayBuffer()) ]) window.onload = () => { - const simstack = [] - const rstack = [] - + /* Initialize Views */ let forthdiv = document.getElementById("forth") if (forthdiv === null) { forthdiv = document.createElement("div") - forthdiv.setAttribute("style","height:100%;margin:auto;width:100%;overflow-x:hidden;") + forthdiv.setAttribute("style","height:100%;margin:auto;width:100%;max-width:640px;overflow-x:hidden;") document.body.appendChild(forthdiv) } const outframe = document.createElement("div") - outframe.setAttribute("style", "background-color:black;padding-left:6px;padding-right:6px;color:chartreuse;height:256px;resize:vertical;display:flex;align-items:flex-end;flex-flow:row") + outframe.setAttribute("style", "background-color:black;padding-left:6px;padding-right:6px;color:chartreuse;height:268px;resize:vertical;display:flex;align-items:flex-end;flex-flow:row;") const stackview = document.createElement("pre") stackview.setAttribute("style", "white-space:pre-wrap;flex:0 0 8%;") outframe.appendChild(stackview) const txtoutput = document.createElement("pre") - txtoutput.setAttribute("style", "white-space:pre-wrap;overflow-y:scroll;flex:1 0 342px;") + txtoutput.setAttribute("style", "white-space:pre-wrap;max-height:256px;overflow-y:scroll;flex:1 0 342px;") outframe.appendChild(txtoutput) - const rstackview = document.createElement("pre") + /* const rstackview = document.createElement("pre") rstackview.setAttribute("style", "white-space:pre-wrap;flex:0 1 8%;") - outframe.appendChild(rstackview) + outframe.appendChild(rstackview) */ const memview = document.createElement("pre") - memview.setAttribute("style", "white-space:pre-wrap;flex:0 0 8%;") + memview.setAttribute("style", "padding-left: 8px; white-space:pre-wrap;flex:0 0 88px;") outframe.appendChild(memview) const txtinput = document.createElement("textarea") txtinput.setAttribute("autofocus", "true") txtinput.setAttribute("wrap", "hard") - txtinput.setAttribute("style", "resize:none;white-space:pre;margin-left:8%;width:60%;") - txtinput.oninput = () => txtinput.rows = (txtinput.value.match(/[\n]/g) || [1]).length + 1; + txtinput.setAttribute("style", "resize:none;white-space:pre;margin-left:8%;width:75%;") + txtinput.oninput = () => txtinput.setAttribute("rows", ((txtinput.value.match(/[\n]/g) || [1]).length + 1).toString()); txtinput.oninput() forthdiv.appendChild(outframe) forthdiv.appendChild(txtinput) + + /* Initialize State */ + const simstack = [] + const rstack = [] let wasmMem let forth + const dictionary = { EXECUTE: 12 } + const doesDictionary = {} + + /* Environment functions */ const output = { print: (string) => txtoutput.textContent += `\\\ => ${string} \n` } + const wasmString = (addr, u) => + String.fromCharCode.apply( + null, + new Uint16Array(wasmMem.buffer, addr, u >> 1) + ) const updateViews = () => { - stackview.textContent = simstack.join('\n') - rstackview.textContent = rstack.join('\n') + const base = new DataView(wasmMem.buffer, 14348 /* base */, 4).getUint32(0,true) + stackview.textContent = simstack.map((v) => v.toString(base)).join('\n') + // rstackview.textContent = rstack.join('\n') let cnt = 0; - const maxBytes = 12 + const maxBytes = 64 let here = new DataView(wasmMem.buffer, 14340 /* here */, 4).getUint32(0,true) memview.textContent = Array.from(new Uint8Array(wasmMem.buffer, here - maxBytes, maxBytes), (v) => { cnt++; v = ('0' + (v & 0xFF).toString(16)).slice(-2) if (cnt === maxBytes) return v + if ((cnt % 16) === 0) + return `${v}\n=> ${(here -maxBytes + cnt).toString(base)}\n` if ((cnt % 4) === 0) - return v + '\n==\n' - return v + '\n' + return `${v}\n` + return `${v} ` }).join('') outframe.scrollTop = outframe.scrollHeight } + /* Input capture */ let stdin = "" txtinput.addEventListener('keydown', (event) => { @@ -93,6 +108,7 @@ window.onload = () => { event.stopPropagation() forth() updateViews() + txtoutput.scrollTop = txtoutput.scrollHeight } break case "Backspace": @@ -117,10 +133,8 @@ window.onload = () => { new Uint16Array(wasmMem.buffer, readAddr, maxBytes >> 1) )) }] - const dictionary = { - EXECUTE: 12 - } - const doesDictionary = {} + + /* System runtime */ const wasmImport = { env: { pop: () => simstack.pop(), @@ -143,7 +157,7 @@ window.onload = () => { //"textEntry" or any third party protocols like activitypub console.log(`fetch ${channel} ${reqAddr}`) }, - sys_echo: (val) => output.print(`${val} `), + sys_echo: (val, base) => output.print(`${val.toString(base)} `), sys_echochar: (val) => output.print(String.fromCharCode(val)), sys_reflect: (addr) => { console.log(`reflect: ${addr}: ${ @@ -151,34 +165,14 @@ window.onload = () => { .getUint32(0,true) }`) }, - vocab_get: (addr, u) => { - const word = String.fromCharCode.apply( - null, - new Uint16Array(wasmMem.buffer, addr, u >> 1) - ) - const answer = dictionary[word.toUpperCase()] - if (answer === undefined) - return 0 - return answer - }, - vocab_set: (addr, u, num) => { - const word = String.fromCharCode.apply( - null, - new Uint16Array(wasmMem.buffer, addr, u >> 1) - ) - dictionary[word.toUpperCase()] = num - return 0 - }, - does_get: (u) => doesDictionary[u] || 0, - does_set: (u, v) => doesDictionary[u] = v, + vocab_get: (addr, u) => dictionary[wasmString(addr, u).toUpperCase()] || 0, + vocab_set: (addr, u, v) => dictionary[wasmString(addr, u).toUpperCase()] = v, + does_get: (addr, u) => doesDictionary[wasmString(addr, u).toUpperCase()] || 0, + does_set: (addr, u, v) => doesDictionary[wasmString(addr, u).toUpperCase()] = v, is_whitespace: (key) => /\s/.test(String.fromCharCode(key)), - sys_stack: () => console.log(`[${simstack}]`), + sys_stack: () => console.log(`[${simstack}][${rstack}]`), sys_parsenum: (addr, u, base) => { - const word = String.fromCharCode.apply( - null, - new Uint16Array(wasmMem.buffer, addr, u >> 1) - ) - const answer = Number.parseInt(word, base) + const answer = Number.parseInt(wasmString(addr, u), base) if (Number.isNaN(answer)) return -1 new DataView(wasmMem.buffer, addr, 4).setUint32(0,answer,true) diff --git a/forth.wat b/forth.wat index 61cbb22..666cc81 100644 --- a/forth.wat +++ b/forth.wat @@ -28,13 +28,13 @@ (import "env" "sys_fetch" (func $sys_fetch (param i32 i32) (result i32))) (import "env" "sys_listen" (func $sys_listen (param i32) (result i32))) (import "env" "sys_write" (func $sys_write (param i32 i32 i32) (result i32))) - (import "env" "sys_echo" (func $sys_echo (param i32))) + (import "env" "sys_echo" (func $sys_echo (param i32 i32))) (import "env" "sys_echochar" (func $sys_echochar (param i32))) (import "env" "sys_reflect" (func $sys_reflect (param i32))) (import "env" "vocab_get" (func $vocab_get (param i32 i32) (result i32))) (import "env" "vocab_set" (func $vocab_set (param i32 i32 i32))) - (import "env" "does_get" (func $does_get (param i32) (result i32))) - (import "env" "does_set" (func $does_set (param i32 i32))) + (import "env" "does_get" (func $does_get (param i32 i32) (result i32))) + (import "env" "does_set" (func $does_set (param i32 i32 i32))) (import "env" "is_whitespace" (func $is_whitespace (param i32) (result i32))) (import "env" "sys_parsenum" (func $sys_parsenum (param i32 i32 i32) (result i32))) (import "env" "sys_stack" (func $sys_stack)) @@ -177,9 +177,14 @@ i32.const 14340 i32.load set_local $here + (; Load "start" into esi, then restore "start" to "quit" ;) i32.const 14344 i32.load set_local $esi + i32.const 14344 + i32.const 16384 + i32.store + (; "start" will be a normal quit, unless cirumvented in this run ;) get_global $inbuf_data set_local $inbuf_head i32.const 14352 @@ -215,7 +220,7 @@ block $words block $here block $dictset block $dup2 block $rot block $drop2 block $comma block $subtract block $keychan block $sethere block $eqbool block $echostring block $strstart block $strput block $strend block $fetchinc - block $setinc block $finddoes block $definedoes + block $setinc block $finddoes block $definedoes block $stacktrace get_local $eax br_table $op0 $ret (;2;)$lit $rinit (;4;)$word $key (;6;)$dup $plus (;8;)$jmp $emit (;10;)$fetch $set (;12;)$execute $noop (;14;)$jz $jnz @@ -224,16 +229,27 @@ (;28;)$here $dictset (;30;)$dup2 $rot (;32;)$drop2 $comma (;34;)$subtract $keychan (;36;)$sethere $eqbool (;38;)$echostring $strstart (;40;)$strput $strend (;42;)$fetchinc $setinc (;44;)$finddoes $definedoes - (;46;)$default + (;46;)$stacktrace $default + end ;; stacktrace + call $sys_stack + get_local $esi + call $sys_reflect + br $next end ;; definedoes + call $pop + call $rpush call $pop set_local $eax call $pop get_local $eax + call $rpop call $does_set br $next end ;; finddoes call $pop + set_local $eax + call $pop + get_local $eax call $does_get call $push br $next @@ -662,6 +678,8 @@ br $next end ;; emit (.) call $pop + i32.const 14348 + i32.load call $sys_echo br $next end ;; noop2 -- 2.18.0