word . 9 define
word .S 38 define
word @ 10 define
+word @8_u 53 define
word @+ 42 define
word ! 11 define
word !+ 43 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
\ 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
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))
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()
(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 ;)
(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
(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 ;)
(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
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
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
return
)
(func $close_channel (param $channel_p i32)
+ (local $eax i32)
block $no_close
get_local $channel_p
i32.const 3
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
)
(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
)
(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
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
i32.const 0
return
end
+
get_local $eax
get_local $eax
i32.load8_u
i32.add
i32.load
set_local $esi
+
get_local $eax
i32.const 12
i32.add
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
(;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
get_local $channel_in
i32.mul
i32.add
- i32.const 4
+ i32.const 8
i32.add
i32.load
get_global $quit_p
block $pendingword
get_local $wordbelt_head
get_local $wordbelt_tail
- i32.sub
- i32.eqz
+ i32.eq
br_if $pendingword
i32.const 32
call $push
(; 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
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
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
)