From: ken Date: Fri, 16 Mar 2018 20:19:47 +0000 (-0700) Subject: webpush hookup X-Git-Url: https://git.kengrimes.com/?p=watForth.git;a=commitdiff_plain;h=18b72639839461c074eb18fc2b58aa2a326485a1 webpush hookup --- diff --git a/.gitignore b/.gitignore index 0fb9098..d7620d4 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,3 @@ c/switch_split.* !c/switch_split.c *~ -forth.wasm diff --git a/forth.forth b/forth.forth index dce37c5..47224b9 100644 --- a/forth.forth +++ b/forth.forth @@ -57,6 +57,7 @@ word WS? 17 define word . 9 define word .S 38 define word @ 10 define +word @8_u 53 define word @+ 42 define word ! 11 define word !+ 43 define @@ -92,7 +93,7 @@ word ::> here define ' drop , ' lit , ' lit , ' , , ' execute-num , ' , , ' ; , \ change interpreter semantics to "memorize-word" -: memorizing ' lit , ' mode , ' lit , ' memorize-word , ' ! , ' ; , +::> MEMORIZING ' lit , ' mode , ' lit , ' memorize-word , ' ! , ' ; , \ memorize the compiler \memorizing @@ -139,15 +140,42 @@ here define-does then compiling ; \ Multi-line comments ::> ( key 41 =? swap -1 =? swap drop + if ;; then JMP: \' ( \, ; -\ Set the number conversion base -: BASE 14348 swap ! ; -: BASE10 10 base ; - ( End of bootstrap process beyond this point, all hope is lost ) +\ Set the number conversion base +: BASE 14348 swap ! ; +: BASE10 10 base ; + +\ TICK compilation semantics +:> ' lit lit , word find , ; +\ "TICK DOES" (get compilation semantics execution token) +: '> word find-does ; +:> '> word find-does , ; + +\ CHAR +: CHAR: word drop @8_u ; +:> CHAR: lit lit , ' char: execute , ; + +\ JSON Compiler +: JSON-CTRL-CHAR char: { =? if ;; then + char: } =? if ;; then + char: [ =? if ;; then ; +: JSON-PARSE-V ; +: JSON-PARSE-" ; +: JSON-PARSE-[ ; +: JSON-PARSE-{ ; +:> JSON-WORD wordstart key -1 =? if ;; then ws? ; + + +\ Include a remote file +: REQUIRE" ' quit channel-open dup \' " \, fetch channel-await ; + +\ Let's try it +REQUIRE" { \"url\": \"forth/test-watfor.forth\" }" + \ Print intro string " watForth-32 Interactive CLI: " .s diff --git a/forth.js b/forth.js index 0844bd0..d3a2f83 100644 --- a/forth.js +++ b/forth.js @@ -141,7 +141,9 @@ const wasmImport = { 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}][${rstack}]`), + sys_stack: () => { console.log(`[${simstack}][${rstack}]`) + console.log(new Uint32Array(wasmMem, 16900, 28)) + }, sys_parsenum: (addr, u) => { const answer = Number.parseInt(wasmString(addr, u), wasmBase()) if (Number.isNaN(answer)) @@ -222,7 +224,7 @@ window.onload = () => { txtinput.oninput() } else { - if (!/\s/.test(txtinput.value.slice(-1))) + if (txtinput.value.length && !/\s/.test(txtinput.value.slice(-1))) txtinput.value += " " event.preventDefault() event.stopPropagation() diff --git a/forth.wasm b/forth.wasm new file mode 100644 index 0000000..f04ed71 Binary files /dev/null and b/forth.wasm differ diff --git a/forth.wat b/forth.wat index 778681a..75c3009 100644 --- a/forth.wat +++ b/forth.wat @@ -87,7 +87,6 @@ (data (i32.const 16444) "\01\00\00\00") ;; RET (data (i32.const 16448) "\10\00\00\00") ;; DROP <-- INTERP-END (data (i32.const 16452) "\10\00\00\00") ;; DROP - ;; (data (i32.const 16456) "\01\00\00\00") ;; RET (global $holy_bye i32 (i32.const 16456)) (data (i32.const 16456) "\19\00\00\00") ;; BYE <-- the Holy BYE (; Word ;) @@ -113,7 +112,7 @@ (data (i32.const 16576) "\12\00\00\00") ;; JMP: (data (i32.const 16580) "\78\40\00\00") ;; addr of KEYLOOP (data (i32.const 16584) "\05\00\00\00") ;; KEY <-- WORDLOOP - (data (i32.const 16588) "\11\00\00\00") ;; WS? + (data (i32.const 16588) "\11\00\00\00") ;; WS? <-- WORDLOOP_REENTRY (data (i32.const 16592) "\0f\00\00\00") ;; JNZ: (data (i32.const 16596) "\f0\40\00\00") ;; addr of WORDEND (data (i32.const 16600) "\06\00\00\00") ;; DUP @@ -159,21 +158,21 @@ (data (i32.const 16788) "\05\00\00\00") ;; KEY (data (i32.const 16792) "\11\00\00\00") ;; WS? (data (i32.const 16796) "\0f\00\00\00") ;; JNZ: - (data (i32.const 16800) "\c8\41\00\00") ;; addr of keypump + 3 - (data (i32.const 16804) "\cc\40\00\00") ;; WORDLOOP + 1 + (data (i32.const 16800) "\c8\41\00\00") ;; addr of DO_COMMENT_REENTRY + (data (i32.const 16804) "\cc\40\00\00") ;; WORDLOOP_REENTRY (call) (data (i32.const 16808) "\28\41\00\00") ;; EXECUTE-MODE (data (i32.const 16812) "\01\00\00\00") ;; RET (; Do Comment ;) (data (i32.const 16828) "\18\00\00\00") ;; j-1: <-- keypump - (data (i32.const 16832) "\e0\41\00\00") ;; addr of end - (data (i32.const 16836) "\05\00\00\00") ;; KEY - (data (i32.const 16840) "\02\00\00\00") ;; LIT + (data (i32.const 16832) "\e0\41\00\00") ;; addr of DC_END + (data (i32.const 16836) "\05\00\00\00") ;; KEY <-- DO_COMMENT + (data (i32.const 16840) "\02\00\00\00") ;; LIT <-- DO_COMMENT_REENTRY (data (i32.const 16844) "\0a\00\00\00") ;; 10 (line feed) (data (i32.const 16848) "\25\00\00\00") ;; =? (data (i32.const 16852) "\0e\00\00\00") ;; JZ: (data (i32.const 16856) "\bc\41\00\00") ;; addr of keypump (data (i32.const 16860) "\10\00\00\00") ;; DROP - (data (i32.const 16864) "\01\00\00\00") ;; RET + (data (i32.const 16864) "\01\00\00\00") ;; RET <-- DC_END (; Channel Table ;) (; 1 FLAGS: AWAITER | RUNNING ]LSB ;) (; 1 reserved ;) @@ -202,7 +201,7 @@ (data (i32.const 16960) "\00\00\00\00") ;; STDERR (TODO: error handler) (; 16900 + ((4 * 7)=>28 * 256)=>7168 = 24068 | 0x5e04 === HERE ;) (export "memory" (memory $0)) - (func $lit_rstack (param $here i32) (param $start i32) (result i32) + (func $lit_rstack (param $here i32) (param $start i32) (param $dstart i32) (result i32) (local $eax i32) (local $ecx i32) i32.const 0 set_local $ecx @@ -219,6 +218,14 @@ i32.add set_local $ecx end + (; push channel default start ;) + get_local $here + get_local $dstart + i32.store + get_local $here + i32.const 4 + i32.add + set_local $here block $output_done block $output_loop get_local $ecx @@ -250,6 +257,14 @@ br $output_loop end end + get_local $here + i32.const 46 + i32.store + get_local $here + i32.const 4 + i32.add + set_local $here + get_local $here i32.const 18 ;; jmp i32.store @@ -265,6 +280,7 @@ return ) (func $close_channel (param $channel_p i32) + (local $eax i32) block $no_close get_local $channel_p i32.const 3 @@ -289,6 +305,21 @@ get_local $channel_p i32.const 0 i32.store8 ;; clear target thread's flags + (; set stdin tail and head to base ;) + get_local $channel_p + i32.const 16 + i32.add + get_local $channel_p + i32.const 20 + i32.add + get_local $channel_p + i32.const 12 + i32.add + i32.load + tee_local $eax + i32.store + get_local $eax + i32.store ) (func $forth_min (param $i1 i32) (param $i2 i32) (result i32) block $is_greater @@ -304,10 +335,10 @@ ) (export "main" (func $main)) (func $main (param $event_channel i32) (result i32) - get_local $event_channel call $rinit get_global $holy_bye call $rpush + get_local $event_channel call $interpret return ) @@ -325,17 +356,6 @@ (local $wordbelt_head i32) (local $channel_out i32) - i32.const 0 - set_local $eax - - loop $recurse_loop - block $close_yield_channel - get_local $eax - i32.eqz - br_if $close_yield_channel - get_local $eax - call $close_channel - end (; channel in setup ;) get_global $channel_table_p get_global $channel_entry_size @@ -345,6 +365,8 @@ i32.mul i32.add set_local $eax + + (; exit if the event is for a channel that is already running ;) block $check_run get_local $eax i32.load8_u @@ -355,6 +377,7 @@ i32.const 0 return end + get_local $eax get_local $eax i32.load8_u @@ -372,6 +395,7 @@ i32.add i32.load set_local $esi + get_local $eax i32.const 12 i32.add @@ -429,7 +453,7 @@ block $comma block $subtract block $inchan block $sethere block $eqbool block $echostring block $strstart block $strput block $strend block $fetchinc block $setinc block $finddoes block $definedoes block $stacktrace block $webfetch - block $outchan block $read block $openchannel block $rpush_op + block $outchan block $read block $openchannel block $rpush_op block $fetch8_u get_local $eax br_table $op0 $ret (;2;)$lit $rinit (;4;)$logword $key (;6;)$dup $plus (;8;)$jmp $emit (;10;)$fetch $set (;12;)$execute $noop (;14;)$jz $jnz @@ -439,7 +463,12 @@ (;34;)$subtract $inchan (;36;)$sethere $eqbool (;38;)$echostring $strstart (;40;)$strput $strend (;42;)$fetchinc $setinc (;44;)$finddoes $definedoes (;46;)$stacktrace $webfetch (;48;)$outchan $read (;50;)$awaiting $openchannel - (;52;)$rpush_op $default + (;52;)$rpush_op $fetch8_u $default + end ;; fetch8_u + call $pop + i32.load8_u + call $push + br $next end ;; rpush_op call $pop call $rpush @@ -993,7 +1022,7 @@ get_local $channel_in i32.mul i32.add - i32.const 4 + i32.const 8 i32.add i32.load get_global $quit_p @@ -1034,8 +1063,7 @@ block $pendingword get_local $wordbelt_head get_local $wordbelt_tail - i32.sub - i32.eqz + i32.eq br_if $pendingword i32.const 32 call $push @@ -1141,6 +1169,10 @@ (; backup return stack here, returning to esi ;) get_local $here get_local $esi + get_local $eax + i32.const 8 + i32.add + i32.load call $lit_rstack set_local $here @@ -1161,13 +1193,6 @@ get_local $channel_out i32.store8 - get_local $eax - get_local $eax - i32.load8_u - i32.const -1 - i32.and - i32.store8 (; toggle off running ;) - get_global $here_p get_local $here i32.store @@ -1184,29 +1209,44 @@ get_local $wordbelt_head i32.store - block $check_awaiter + block $await_exit get_local $inbuf_base i32.const -1 - i32.eq ;; don't check if "await-exit" is true - br_if $check_awaiter - get_local $eax - i32.load8_u - i32.const 2 - i32.and - i32.eqz ;; (FLAGS & 2) => awaiter, run it - br_if $check_awaiter - get_local $eax - i32.const 2 - i32.add - i32.load8_u + i32.eq ;; halt if awaiting + br_if $await_exit + block $no_awaiter + get_local $eax + i32.load8_u + i32.const 2 + i32.and + i32.eqz ;; (FLAGS & 2) => awaiter, run it + br_if $no_awaiter + get_local $eax + i32.const 2 + i32.add + i32.load8_u + tee_local $eax + call $push + get_global $channel_table_p + get_global $channel_entry_size + get_local $eax + i32.mul + i32.add + tee_local $eax + get_local $eax + i32.load8_u + i32.const 254 + i32.and + i32.store8 ;; toggle off runflag + call $pop + call $main + get_local $channel_in + call $close_channel + return + end get_local $channel_in - set_local $eax - set_local $channel_in - br $recurse_loop + call $close_channel end - end ;; recurse_loop - get_local $channel_in - call $close_channel i32.const 0 return )