1 (; This program is free software: you can redistribute it and/or modify
2 it under the terms of the GNU General Public License as published by
3 the Free Software Foundation, either version 3 of the License, or
4 (at your option) any later version.
6 This program is distributed in the hope that it will be useful,
7 but WITHOUT ANY WARRANTY; without even the implied warranty of
8 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
9 GNU General Public License for more details.
11 You should have received a copy of the GNU General Public License
12 along with this program. If not, see <http://www.gnu.org/licenses/>. ;)
14 (type $FUNCSIGi (func (result i32)))
15 (type $FUNCSIGii (func (param i32)))
16 (type $FUNCSIGiii (func))
17 (type $FUNCSIGiv (func (param i32 i32) (result i32)))
18 (type $FUNCSIGv (func (param i32) (result i32)))
19 (type $FUNCSIGvi (func (param i32 i32 i32) (result i32)))
20 (type $FUNCSIGvii (func (param i32 i32)))
21 (type $FUNCSIGviii (func (param i32 i32 i32)))
22 (import "env" "pop" (func $pop (result i32)))
23 (import "env" "push" (func $push (param i32)))
24 (import "env" "rinit" (func $rinit))
25 (import "env" "rpop" (func $rpop (result i32)))
26 (import "env" "rpush" (func $rpush (param i32)))
27 (import "env" "sys_read" (func $sys_read (param i32 i32 i32) (result i32)))
28 (import "env" "sys_write" (func $sys_write (param i32 i32 i32)))
29 (import "env" "sys_send" (func $sys_send (param i32 i32 i32)))
30 (import "env" "sys_open" (func $sys_open (result i32)))
31 (import "env" "sys_close" (func $sys_close (param i32)))
32 (import "env" "sys_fetch" (func $sys_fetch (param i32 i32 i32) (result i32)))
33 (import "env" "sys_connect" (func $sys_connect (param i32 i32) (result i32)))
34 (import "env" "sys_echo" (func $sys_echo (param i32)))
35 (import "env" "sys_log" (func $sys_log (param i32 i32)))
36 (import "env" "sys_reflect" (func $sys_reflect (param i32)))
37 (import "env" "vocab_get" (func $vocab_get (param i32 i32) (result i32)))
38 (import "env" "vocab_set" (func $vocab_set (param i32 i32 i32)))
39 (import "env" "does_get" (func $does_get (param i32 i32) (result i32)))
40 (import "env" "does_set" (func $does_set (param i32 i32 i32)))
41 (import "env" "is_whitespace" (func $is_whitespace (param i32) (result i32)))
42 (import "env" "sys_parsenum" (func $sys_parsenum (param i32 i32) (result i32)))
43 (import "env" "sys_stack" (func $sys_stack))
44 (import "env" "sys_words" (func $sys_words))
45 (table (;0;) 0 anyfunc)
47 (; String Belt ;) ;; 0x0000 Size: 8192
48 (global $wordbelt_base i32 (i32.const 8192) ) ;; 0x2000 Size: 4096
49 (global $wordbelt_bound i32 (i32.const 12288)) ;; 0x3000
50 (global $stdin_base i32 (i32.const 12288)) ;; 0x3000 Size: 2048
51 (global $kvars i32 (i32.const 14336)) ;; 0x3800 Size: 2048
52 (global $mode_p i32 (i32.const 14336))
53 (global $here_p i32 (i32.const 14340))
54 (global $start_p i32 (i32.const 14344))
55 (global $base_p i32 (i32.const 14348))
56 (global $stringbelt_tail_p i32 (i32.const 14352))
57 (global $stringbelt_head_p i32 (i32.const 14356))
58 (global $wordbelt_tail_p i32 (i32.const 14360))
59 (global $wordbelt_head_p i32 (i32.const 14364))
60 (data (i32.const 14336) "\28\41\00\00") ;; MODE
61 (data (i32.const 14340) "\04\5e\00\00") ;; HERE
62 (data (i32.const 14344) "\00\40\00\00") ;; START (16384) (Quit)
63 (data (i32.const 14348) "\0a\00\00\00") ;; BASE
64 (data (i32.const 14352) "\00\00\00\00") ;; STRINGBELT_TAIL
65 (data (i32.const 14356) "\00\00\00\00") ;; STRINGBELT_HEAD
66 (data (i32.const 14360) "\00\20\00\00") ;; WORDBELT_TAIL
67 (data (i32.const 14364) "\00\20\00\00") ;; WORDBELT_HEAD
69 (global $quit_p i32 (i32.const 16384)) ;; 0x4000
70 (data (i32.const 16384) "\03\00\00\00") ;; RINIT xt
71 (global $quit_ret_p i32 (i32.const 16388))
72 (data (i32.const 16388) "\10\40\00\00") ;; INTERPRET xt
73 (data (i32.const 16392) "\12\00\00\00") ;; JMP xt
74 (data (i32.const 16396) "\00\40\00\00") ;; quit location (16384)
76 (data (i32.const 16400) "\74\40\00\00") ;; WORD xt (16500)
77 (data (i32.const 16404) "\0d\00\00\00") ;; (data (i32.const 16404) "\1e\00\00\00") ;; 2DUP
78 (data (i32.const 16408) "\0d\00\00\00") ;; (data (i32.const 16408) "\04\00\00\00") ;; SYS-LOG
79 (data (i32.const 16412) "\06\00\00\00") ;; DUP
80 (data (i32.const 16416) "\0e\00\00\00") ;; JZ:
81 (data (i32.const 16420) "\40\40\00\00") ;; INTERP-END addr (16444)
82 (data (i32.const 16424) "\02\00\00\00") ;; LIT xt
83 (data (i32.const 16428) "\00\38\00\00") ;; MODE addr (14336)
84 (data (i32.const 16432) "\0a\00\00\00") ;; @ (fetch) xt
85 (data (i32.const 16436) "\0c\00\00\00") ;; EXECUTE xt
86 (data (i32.const 16440) "\0d\00\00\00") ;; NOOP xt
87 (data (i32.const 16444) "\01\00\00\00") ;; RET
88 (data (i32.const 16448) "\10\00\00\00") ;; DROP <-- INTERP-END
89 (data (i32.const 16452) "\10\00\00\00") ;; DROP
90 (global $holy_bye i32 (i32.const 16456))
91 (data (i32.const 16456) "\19\00\00\00") ;; BYE <-- the Holy BYE
93 (data (i32.const 16500) "\14\00\00\00") ;; WORDSTART
94 (data (i32.const 16504) "\05\00\00\00") ;; KEY <-- KEYLOOP
95 (data (i32.const 16508) "\06\00\00\00") ;; DUP
96 (data (i32.const 16512) "\18\00\00\00") ;; J-1: 18
97 (data (i32.const 16516) "\f0\40\00\00") ;; addr of WORDEND
98 (data (i32.const 16520) "\11\00\00\00") ;; WS?
99 (data (i32.const 16524) "\0f\00\00\00") ;; JNZ:
100 (data (i32.const 16528) "\bc\40\00\00") ;; addr of KEYDROP
101 (data (i32.const 16532) "\02\00\00\00") ;; LIT
102 (data (i32.const 16536) "\5c\00\00\00") ;; 92 (\ character)
103 (data (i32.const 16540) "\25\00\00\00") ;; =?
104 (data (i32.const 16544) "\0e\00\00\00") ;; JZ:
105 (data (i32.const 16548) "\e4\40\00\00") ;; addr of DOCHAR
106 (data (i32.const 16552) "\10\00\00\00") ;; DROP
107 (data (i32.const 16556) "\94\41\00\00") ;; DO-BACKSLASH (continue using this wbuf we started)
108 (data (i32.const 16560) "\0d\00\00\00") ;; NOOP
109 (data (i32.const 16564) "\12\00\00\00") ;; JMP:
110 (data (i32.const 16568) "\74\40\00\00") ;; addr of KEYLOOP-1 (get a new wbuf, call to wbuf+1 ate ours)
111 (data (i32.const 16572) "\10\00\00\00") ;; DROP <-- KEYDROP
112 (data (i32.const 16576) "\12\00\00\00") ;; JMP:
113 (data (i32.const 16580) "\78\40\00\00") ;; addr of KEYLOOP
114 (data (i32.const 16584) "\05\00\00\00") ;; KEY <-- WORDLOOP
115 (data (i32.const 16588) "\11\00\00\00") ;; WS? <-- WORDLOOP_REENTRY
116 (data (i32.const 16592) "\0f\00\00\00") ;; JNZ:
117 (data (i32.const 16596) "\f0\40\00\00") ;; addr of WORDEND
118 (data (i32.const 16600) "\06\00\00\00") ;; DUP
119 (data (i32.const 16604) "\18\00\00\00") ;; J-1:
120 (data (i32.const 16608) "\f0\40\00\00") ;; addr of WORDEND
121 (data (i32.const 16612) "\13\00\00\00") ;; WORDPUTC <-- DOCHAR
122 (data (i32.const 16616) "\12\00\00\00") ;; JMP:
123 (data (i32.const 16620) "\c8\40\00\00") ;; addr of WORDLOOP
124 (data (i32.const 16624) "\10\00\00\00") ;; DROP <-- WORDEND
125 (data (i32.const 16628) "\17\00\00\00") ;; WORDFINISH
126 (data (i32.const 16632) "\01\00\00\00") ;; 2DUP //RET
127 (data (i32.const 16636) "\04\00\00\00") ;; .S
128 (data (i32.const 16640) "\01\00\00\00") ;; RET
130 (data (i32.const 16680) "\1e\00\00\00") ;; 2DUP
131 (data (i32.const 16684) "\15\00\00\00") ;; DICT_GET
132 (data (i32.const 16688) "\06\00\00\00") ;; DUP
133 (data (i32.const 16692) "\0e\00\00\00") ;; JZ:
134 (data (i32.const 16696) "\4c\41\00\00") ;; donum -1 (16716)
135 (data (i32.const 16700) "\1f\00\00\00") ;; ROT
136 (data (i32.const 16704) "\20\00\00\00") ;; 2DROP
137 (data (i32.const 16708) "\0c\00\00\00") ;; EXECUTE
138 (data (i32.const 16712) "\01\00\00\00") ;; RET
139 (data (i32.const 16716) "\10\00\00\00") ;; DROP (xt from dictionary)
140 (data (i32.const 16720) "\16\00\00\00") ;; NUMBER <-- donum, pushes NUM, UNPARSED
141 (data (i32.const 16724) "\06\00\00\00") ;; DUP
142 (data (i32.const 16728) "\0f\00\00\00") ;; JNZ:
143 (data (i32.const 16732) "\68\41\00\00") ;; donum_err (16744)
144 (data (i32.const 16736) "\10\00\00\00") ;; DROP
145 (data (i32.const 16740) "\01\00\00\00") ;; RET
146 (data (i32.const 16744) "\20\00\00\00") ;; 2DROP <-- donum_err
147 (data (i32.const 16748) "\02\00\00\00") ;; LIT
148 (data (i32.const 16752) "\00\00\00\00") ;; 0
149 (data (i32.const 16756) "\02\00\00\00") ;; LIT
150 (data (i32.const 16760) "\04\30\00\00") ;; INBUFSIZE LOCATION
151 (data (i32.const 16764) "\0b\00\00\00") ;; !
152 (data (i32.const 16768) "\19\00\00\00") ;; BYE
153 (data (i32.const 16772) "\00\00\00\00") ;;
154 (data (i32.const 16776) "\00\00\00\00") ;;
155 (data (i32.const 16780) "\00\00\00\00") ;;
156 (data (i32.const 16784) "\00\00\00\00") ;;
158 (data (i32.const 16788) "\05\00\00\00") ;; KEY
159 (data (i32.const 16792) "\11\00\00\00") ;; WS?
160 (data (i32.const 16796) "\0f\00\00\00") ;; JNZ:
161 (data (i32.const 16800) "\c8\41\00\00") ;; addr of DO_COMMENT_REENTRY
162 (data (i32.const 16804) "\cc\40\00\00") ;; WORDLOOP_REENTRY (call)
163 (data (i32.const 16808) "\28\41\00\00") ;; EXECUTE-MODE
164 (data (i32.const 16812) "\01\00\00\00") ;; RET
166 (data (i32.const 16828) "\18\00\00\00") ;; j-1: <-- keypump
167 (data (i32.const 16832) "\e0\41\00\00") ;; addr of DC_END
168 (data (i32.const 16836) "\05\00\00\00") ;; KEY <-- DO_COMMENT
169 (data (i32.const 16840) "\02\00\00\00") ;; LIT <-- DO_COMMENT_REENTRY
170 (data (i32.const 16844) "\0a\00\00\00") ;; 10 (line feed)
171 (data (i32.const 16848) "\25\00\00\00") ;; =?
172 (data (i32.const 16852) "\0e\00\00\00") ;; JZ:
173 (data (i32.const 16856) "\bc\41\00\00") ;; addr of keypump
174 (data (i32.const 16860) "\10\00\00\00") ;; DROP
175 (data (i32.const 16864) "\01\00\00\00") ;; RET <-- DC_END
177 (; 1 FLAGS: AWAITER | RUNNING ]LSB ;)
179 (; 1 AWAITER CHANNEL ;)
181 (; 8 START | START-DEFAULT ;)
182 (; 16 BUFFER ADDRESSES: BASE, TAIL, HEAD, BOUND ;)
183 (global $channel_table_p i32 (i32.const 16900))
184 (global $channel_entry_size i32 (i32.const 28))
185 (global $channel_max i32 (i32.const 255))
186 (data (i32.const 16900) "\00\00\00\01") ;; STDIN (COUT: 1)
187 (data (i32.const 16904) "\00\40\00\00") ;; STDIN-START (QUIT)
188 (data (i32.const 16908) "\00\40\00\00") ;; STDIN-START-DEFAULT
189 (data (i32.const 16912) "\00\30\00\00") ;; STDIN-BUFFER-BASE
190 (data (i32.const 16916) "\00\30\00\00") ;; STDIN-BUFFER-TAIL
191 (data (i32.const 16920) "\00\30\00\00") ;; STDIN-BUFFER-HEAD
192 (data (i32.const 16924) "\00\38\00\00") ;; STDIN-BUFFER-BOUND
193 (data (i32.const 16928) "\00\00\00\00") ;; STDOUT
194 (data (i32.const 16932) "\00\00\00\00") ;; STDOUT (TODO: error handler)
195 (data (i32.const 16936) "\00\00\00\00") ;; STDOUT
196 (data (i32.const 16940) "\00\00\00\00") ;; STDOUT
197 (data (i32.const 16944) "\00\00\00\00") ;; STDOUT
198 (data (i32.const 16948) "\00\00\00\00") ;; STDOUT
199 (data (i32.const 16952) "\00\00\00\00") ;; STDOUT
200 (data (i32.const 16956) "\00\00\00\00") ;; STDERR (null)
201 (data (i32.const 16960) "\00\00\00\00") ;; STDERR (TODO: error handler)
202 (; 16900 + ((4 * 7)=>28 * 256)=>7168 = 24068 | 0x5e04 === HERE ;)
203 (export "memory" (memory $0))
204 (func $lit_rstack (param $here i32) (param $start i32) (param $dstart i32) (result i32)
205 (local $eax i32) (local $ecx i32)
221 (; push channel default start ;)
251 i32.const 52 ;; rpush_op
282 (func $close_channel (param $channel_p i32)
292 get_global $channel_table_p
293 get_global $channel_entry_size
304 i32.store ;; restore awaiter's "start" to original
307 i32.store8 ;; clear target thread's flags
308 (; set stdin tail and head to base ;)
324 (func $forth_min (param $i1 i32) (param $i2 i32) (result i32)
336 (export "main" (func $main))
337 (func $main (param $event_channel i32) (result i32)
341 get_local $event_channel
345 (func $interpret (param $channel_in i32) (result i32)
349 (local $inbuf_base i32)
350 (local $inbuf_tail i32)
351 (local $inbuf_head i32)
352 (local $inbuf_bound i32)
353 (local $stringbelt_tail i32)
354 (local $stringbelt_head i32)
355 (local $wordbelt_tail i32)
356 (local $wordbelt_head i32)
357 (local $channel_out i32)
359 (; channel in setup ;)
360 get_global $channel_table_p
361 get_global $channel_entry_size
362 get_global $channel_max
363 get_local $channel_in
369 (; exit if the event is for a channel that is already running ;)
375 i32.eqz ;; (FLAGS & 1) => running, return 0
386 i32.store8 ;; set running flag
391 set_local $channel_out
403 set_local $inbuf_base
408 set_local $inbuf_tail
413 set_local $inbuf_head
418 set_local $inbuf_bound
419 (; /channel in setup ;)
423 get_global $stringbelt_tail_p
425 set_local $stringbelt_tail
426 get_global $stringbelt_head_p
428 set_local $stringbelt_head
429 get_global $wordbelt_tail_p
431 set_local $wordbelt_tail
432 get_global $wordbelt_head_p
434 set_local $wordbelt_head
447 block $default block $op0 block $ret block $lit block $rinit
448 block $logword block $key block $dup block $plus block $noop2 block $emit
449 block $fetch block $set block $execute block $noop block $jz block $jnz
450 block $drop block $wsbool block $jmp block $wordputc block $wordstart
451 block $dictget block $parsenum block $wordfinish block $jneg1 block $swap
452 block $words block $here block $dictset block $dup2 block $rot block $drop2
453 block $comma block $subtract block $inchan block $sethere block $eqbool
454 block $echostring block $strstart block $strput block $strend block $fetchinc
455 block $setinc block $finddoes block $definedoes block $stacktrace block $webfetch
456 block $outchan block $read block $openchannel block $rpush_op block $fetch8_u
459 br_table $op0 $ret (;2;)$lit $rinit (;4;)$logword $key (;6;)$dup $plus
460 (;8;)$jmp $emit (;10;)$fetch $set (;12;)$execute $noop (;14;)$jz $jnz
461 (;16;)$drop $wsbool (;18;)$jmp $wordputc (;20;)$wordstart $dictget
462 (;22;)$parsenum $wordfinish (;24;)$jneg1 $bye (;26;)$swap $words
463 (;28;)$here $dictset (;30;)$dup2 $rot (;32;)$drop2 $comma
464 (;34;)$subtract $inchan (;36;)$sethere $eqbool (;38;)$echostring $strstart
465 (;40;)$strput $strend (;42;)$fetchinc $setinc (;44;)$finddoes $definedoes
466 (;46;)$stacktrace $webfetch (;48;)$outchan $read (;50;)$awaiting $openchannel
467 (;52;)$rpush_op $fetch8_u (;54;)$negrot $default
490 (; Get addr of channel block ;)
491 get_global $channel_table_p
492 get_global $channel_entry_size
495 call $rpush ;;save to rstack
499 (; Set Out-Channel to 1 by default ;)
502 i32.add ;; out channel
505 (; leave a copy of channel_p on stack ;)
507 (; Get addr of ch-start and ch-default-start ;)
510 i32.add ;; addr of channel start
514 i32.add ;; addr of channel default start
515 (; Store the user-provided address in both ;)
521 (; go bo buf-base (channel_p + 12), put HERE in it ;)
543 (; set buf-bound = here += 512 ;)
549 (; return channel number ;)
554 get_local $channel_in
555 call $pop ;; location to write
563 set_local $channel_out
570 call $pop ;; callback
624 get_local $stringbelt_tail
625 get_local $stringbelt_head
626 get_local $stringbelt_tail
630 tee_local $eax (; n bytes ;)
632 (; align to 32-bit ;)
633 get_local $stringbelt_head
638 set_local $stringbelt_head
640 get_local $stringbelt_tail
649 get_local $stringbelt_head
650 get_global $wordbelt_base
654 tee_local $stringbelt_head
655 get_local $stringbelt_tail
658 get_local $stringbelt_head
661 set_local $stringbelt_head
662 get_local $stringbelt_tail
665 set_local $stringbelt_tail
666 loop $copystringtostart
667 get_local $stringbelt_head
668 get_local $stringbelt_tail
671 get_local $stringbelt_head
674 set_local $stringbelt_head
675 get_local $stringbelt_tail
678 tee_local $stringbelt_tail
679 get_global $wordbelt_base
681 br_if $copystringtostart
684 set_local $stringbelt_tail
686 get_local $stringbelt_head
689 get_local $stringbelt_head
692 set_local $stringbelt_head
696 get_local $stringbelt_head
697 get_global $wordbelt_base
703 set_local $stringbelt_head
705 get_local $stringbelt_head
706 get_local $stringbelt_head
707 tee_local $stringbelt_tail
712 set_local $stringbelt_head
715 get_local $channel_out
744 set_local $channel_in
840 get_local $wordbelt_head
841 get_local $wordbelt_tail
843 set_local $eax (; n bytes ;)
844 (; align to 32-bit ;)
845 get_local $wordbelt_head
850 set_local $wordbelt_head
852 get_local $wordbelt_tail
879 get_local $wordbelt_head
880 get_global $wordbelt_bound
885 get_global $wordbelt_base
886 set_local $wordbelt_head
888 get_local $wordbelt_head
889 set_local $wordbelt_tail
893 get_local $wordbelt_head
894 get_global $wordbelt_bound
897 get_global $wordbelt_base
898 set_local $wordbelt_head
899 loop $copywordtostart
900 get_local $wordbelt_head
901 get_local $wordbelt_tail
904 get_local $wordbelt_head
907 set_local $wordbelt_head
908 get_local $wordbelt_tail
911 tee_local $wordbelt_tail
912 get_global $wordbelt_bound
914 br_if $copywordtostart
916 get_global $wordbelt_base
917 set_local $wordbelt_tail
919 get_local $wordbelt_head
922 get_local $wordbelt_head
925 set_local $wordbelt_head
1019 get_local $inbuf_head
1020 get_local $inbuf_tail
1024 get_local $channel_out
1028 (; if current channel's default start is QUIT ;)
1029 get_global $channel_table_p
1030 get_global $channel_entry_size
1031 get_local $channel_in
1041 get_local $inbuf_head
1045 get_local $inbuf_head
1048 get_local $inbuf_head
1051 set_local $inbuf_head
1054 get_local $channel_in
1055 get_local $inbuf_base
1056 get_local $inbuf_bound
1057 get_local $inbuf_base
1061 get_local $inbuf_base
1063 set_local $inbuf_tail
1064 get_local $inbuf_base
1065 set_local $inbuf_head
1073 get_local $wordbelt_head
1074 get_local $wordbelt_tail
1090 end ;; rinit (unused)
1092 get_global $holy_bye
1122 (; set provided channel's waiter to this channel ;)
1123 get_global $channel_table_p
1124 get_global $channel_entry_size
1131 get_local $channel_in
1133 (; set awaiter flag ;)
1141 (; channel status save ;)
1142 get_global $channel_table_p
1143 get_global $channel_entry_size
1144 get_local $channel_in
1148 (; set buffer base ;)
1151 get_local $inbuf_base
1153 (; set buffer tail ;)
1157 get_local $inbuf_tail
1159 (; set buffer head ;)
1163 get_local $inbuf_head
1165 (; set buffer bound ;)
1169 get_local $inbuf_bound
1172 (; set buffer buffer start ;)
1178 (; backup return stack here, returning to esi ;)
1189 set_local $inbuf_base ;; temporary bool "await-exit"
1194 get_global $channel_table_p
1195 get_global $channel_entry_size
1196 get_local $channel_in
1202 get_local $channel_out
1208 get_global $stringbelt_tail_p
1209 get_local $stringbelt_tail
1211 get_global $stringbelt_head_p
1212 get_local $stringbelt_head
1214 get_global $wordbelt_tail_p
1215 get_local $wordbelt_tail
1217 get_global $wordbelt_head_p
1218 get_local $wordbelt_head
1222 get_local $inbuf_base
1224 i32.eq ;; halt if awaiting
1231 i32.eqz ;; (FLAGS & 2) => awaiter, run it
1239 get_global $channel_table_p
1240 get_global $channel_entry_size
1249 i32.store8 ;; toggle off runflag
1252 get_local $channel_in
1256 get_local $channel_in