\
\ You should have received a copy of the GNU General Public License
\ along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+\ 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
word !HERE 36 define
word HERE 28 define
+word STACKTRACE 46 define
+
word ; 1 define
word JZ: 14 define
word JNZ: 15 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
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) => {
event.stopPropagation()
forth()
updateViews()
+ txtoutput.scrollTop = txtoutput.scrollHeight
}
break
case "Backspace":
new Uint16Array(wasmMem.buffer, readAddr, maxBytes >> 1)
))
}]
- const dictionary = {
- EXECUTE: 12
- }
- const doesDictionary = {}
+
+ /* System runtime */
const wasmImport = {
env: {
pop: () => simstack.pop(),
//"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}: ${
.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)
(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))
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
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
(;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
br $next
end ;; emit (.)
call $pop
+ i32.const 14348
+ i32.load
call $sys_echo
br $next
end ;; noop2
projects / watForth.git / commitdiff