forth.wat

   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.
   5
   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.
  10
  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/>. ;)
  13 (module
  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 $FUNCSIG$v  (func (param i32) (result i32)))
  19   (type $FUNCSIG$vi (func (param i32 i32) (result i32)))
  20   (import "env" "pop" (func $pop (result i32)))
  21   (import "env" "push" (func $push (param i32)))
  22   (import "env" "rinit" (func $rinit))
  23   (import "env" "rpop" (func $rpop (result i32)))
  24   (import "env" "rpush" (func $rpush (param i32)))
  25   (import "env" "sys_read" (func $sys_read (param i32 i32) (result i32)))
  26   (import "env" "sys_fetch" (func $sys_fetch (param i32 i32) (result i32)))
  27   (import "env" "sys_listen" (func $sys_listen (param i32) (result i32)))
  28   (import "env" "sys_write" (func $sys_write (param i32 i32 i32) (result i32)))
  29   (import "env" "sys_echo" (func $sys_echo (param i32)))
  30   (import "env" "sys_echochar" (func $sys_echochar (param i32)))
  31   (import "env" "sys_reflect" (func $sys_reflect (param i32)))
  32   (import "env" "vocab_get" (func $vocab_get (param i32 i32) (result i32)))
  33   (import "env" "vocab_set" (func $vocab_set (param i32 i32 i32) (result i32)))
  34   (import "env" "is_whitespace" (func $is_whitespace (param i32) (result i32)))
  35   (import "env" "sys_parsenum" (func $sys_parsenum (param i32 i32 i32) (result i32)))
  36   (import "env" "sys_stack" (func $sys_stack))
  37   (import "env" "sys_words" (func $sys_words))
  38   (table (;0;) 0 anyfunc)
  39   (memory $0 1)
  40   (; String Belt                       ;) ;; 0x0000 Size: 8192
  41   (global $wordbelt i32 (i32.const 8192)) ;; 0x2000 Size: 4096
  42   (global $inbuf i32 (i32.const 12288))   ;; 0x3000 Size: 2048
  43   (global $inbuf_size i32 (i32.const 12292))
  44   (global $inbuf_data i32 (i32.const 12296))
  45   (global $kvars i32 (i32.const 14336))   ;; 0x3800 Size: 2048
  46   (data (i32.const 12288) "\fc\07\00\00") ;; 2044 len
  47   (data (i32.const 14336) "\28\41\00\00") ;; MODE
  48   (data (i32.const 14340) "\04\42\00\00") ;; HERE
  49   (data (i32.const 14344) "\00\40\00\00") ;; START
  50   (data (i32.const 14348) "\0a\00\00\00") ;; BASE
  51   (data (i32.const 14352) "\00\00\00\00") ;; STRINGBELT_TAIL
  52   (data (i32.const 14356) "\00\00\00\00") ;; STRINGBELT_HEAD
  53   (data (i32.const 14360) "\00\20\00\00") ;; WORDBELT_TAIL
  54   (data (i32.const 14364) "\00\20\00\00") ;; WORDBELT_HEAD
  55   (data (i32.const 14368) "\00\00\00\00") ;; CHANNEL
  56   (; Quit ;)
  57   (data (i32.const 16384) "\03\00\00\00") ;; RINIT xt
  58   (data (i32.const 16388) "\10\40\00\00") ;; INTERPRET xt
  59   (data (i32.const 16392) "\12\00\00\00") ;; JMP xt
  60   (data (i32.const 16396) "\00\40\00\00") ;; quit location (16384)
  61   (; Interpret ;)
  62   (data (i32.const 16400) "\74\40\00\00") ;; WORD xt (16500)
  63   (data (i32.const 16404) "\06\00\00\00") ;; DUP
  64   (data (i32.const 16408) "\0e\00\00\00") ;; JZ:
  65   (data (i32.const 16412) "\38\40\00\00") ;; INTERP-END addr (16444)
  66   (data (i32.const 16416) "\02\00\00\00") ;; LIT xt
  67   (data (i32.const 16420) "\00\38\00\00") ;; MODE addr (14336)
  68   (data (i32.const 16424) "\0a\00\00\00") ;; @ (fetch) xt
  69   (data (i32.const 16428) "\0c\00\00\00") ;; EXECUTE xt
  70   (data (i32.const 16432) "\0d\00\00\00") ;; NOOP xt
  71   (data (i32.const 16436) "\01\00\00\00") ;; RET
  72   (data (i32.const 16440) "\10\00\00\00") ;; DROP  <-- INTERP-END
  73   (data (i32.const 16444) "\10\00\00\00") ;; DROP
  74   (data (i32.const 16448) "\19\00\00\00") ;; BYE
  75   (; Word ;)
  76   (data (i32.const 16500) "\14\00\00\00") ;; WORDSTART
  77   (data (i32.const 16504) "\05\00\00\00") ;; KEY  <-- KEYLOOP
  78   (data (i32.const 16508) "\06\00\00\00") ;; DUP
  79   (data (i32.const 16512) "\18\00\00\00") ;; J-1: 18
  80   (data (i32.const 16516) "\f0\40\00\00") ;; addr of WORDEND
  81   (data (i32.const 16520) "\11\00\00\00") ;; WS?
  82   (data (i32.const 16524) "\0f\00\00\00") ;; JNZ:
  83   (data (i32.const 16528) "\bc\40\00\00") ;; addr of KEYDROP
  84   (data (i32.const 16532) "\02\00\00\00") ;; LIT
  85   (data (i32.const 16536) "\5c\00\00\00") ;; 92 (\ character)
  86   (data (i32.const 16540) "\25\00\00\00") ;; =?
  87   (data (i32.const 16544) "\0e\00\00\00") ;; JZ:
  88   (data (i32.const 16548) "\e4\40\00\00") ;; addr of DOCHAR
  89   (data (i32.const 16552) "\10\00\00\00") ;; DROP
  90   (data (i32.const 16556) "\94\41\00\00") ;; DO-BACKSLASH (continue using this wbuf we started)
  91   (data (i32.const 16560) "\0d\00\00\00") ;; NOOP
  92   (data (i32.const 16564) "\12\00\00\00") ;; JMP:
  93   (data (i32.const 16568) "\74\40\00\00") ;; addr of KEYLOOP-1 (get a new wbuf, call to wbuf+1 ate ours)
  94   (data (i32.const 16572) "\10\00\00\00") ;; DROP <-- KEYDROP
  95   (data (i32.const 16576) "\12\00\00\00") ;; JMP:
  96   (data (i32.const 16580) "\78\40\00\00") ;; addr of KEYLOOP
  97   (data (i32.const 16584) "\05\00\00\00") ;; KEY <-- WORDLOOP
  98   (data (i32.const 16588) "\11\00\00\00") ;; WS?
  99   (data (i32.const 16592) "\0f\00\00\00") ;; JNZ:
 100   (data (i32.const 16596) "\f0\40\00\00") ;; addr of WORDEND
 101   (data (i32.const 16600) "\06\00\00\00") ;; DUP
 102   (data (i32.const 16604) "\18\00\00\00") ;; J-1:
 103   (data (i32.const 16608) "\f0\40\00\00") ;; addr of WORDEND
 104   (data (i32.const 16612) "\13\00\00\00") ;; WORDPUTC <-- DOCHAR
 105   (data (i32.const 16616) "\12\00\00\00") ;; JMP:
 106   (data (i32.const 16620) "\c8\40\00\00") ;; addr of WORDLOOP
 107   (data (i32.const 16624) "\10\00\00\00") ;; DROP <-- WORDEND
 108   (data (i32.const 16628) "\17\00\00\00") ;; WORDFINISH
 109   (data (i32.const 16632) "\01\00\00\00") ;; RET
 110   (; Exec Mode ;)
 111   (data (i32.const 16680) "\1e\00\00\00") ;; DUP2
 112   (data (i32.const 16684) "\15\00\00\00") ;; DICT_GET
 113   (data (i32.const 16688) "\06\00\00\00") ;; DUP
 114   (data (i32.const 16692) "\0e\00\00\00") ;; JZ:
 115   (data (i32.const 16696) "\4c\41\00\00") ;; donum -1 (16716)
 116   (data (i32.const 16700) "\1f\00\00\00") ;; ROT
 117   (data (i32.const 16704) "\20\00\00\00") ;; DROP2
 118   (data (i32.const 16708) "\0c\00\00\00") ;; EXECUTE
 119   (data (i32.const 16712) "\01\00\00\00") ;; RET
 120   (data (i32.const 16716) "\10\00\00\00") ;; DROP (xt from dictionary)
 121   (data (i32.const 16720) "\16\00\00\00") ;; NUMBER <-- donum, pushes NUM, UNPARSED
 122   (data (i32.const 16724) "\06\00\00\00") ;; DUP
 123   (data (i32.const 16728) "\0f\00\00\00") ;; JNZ:
 124   (data (i32.const 16732) "\68\41\00\00") ;; donum_err (16744)
 125   (data (i32.const 16736) "\10\00\00\00") ;; DROP
 126   (data (i32.const 16740) "\01\00\00\00") ;; RET
 127   (data (i32.const 16744) "\10\00\00\00") ;; PARSE_ERR <-- donum_err
 128   (data (i32.const 16748) "\10\00\00\00") ;; ( DROP DROP )
 129   (data (i32.const 16752) "\19\00\00\00") ;; BYE
 130   (; Do Backslash ;)
 131   (data (i32.const 16788) "\05\00\00\00") ;; KEY
 132   (data (i32.const 16792) "\02\00\00\00") ;; LIT
 133   (data (i32.const 16796) "\20\00\00\00") ;; 32 (space)
 134   (data (i32.const 16800) "\25\00\00\00") ;; =?
 135   (data (i32.const 16804) "\0f\00\00\00") ;; JNZ:
 136   (data (i32.const 16808) "\bc\41\00\00") ;; addr of keypump
 137   (data (i32.const 16812) "\cc\40\00\00") ;; WORDLOOP + 1
 138   (data (i32.const 16816) "\28\41\00\00") ;; EXECUTE-MODE
 139   (data (i32.const 16820) "\01\00\00\00") ;; RET
 140   (data (i32.const 16828) "\18\00\00\00") ;; j-1: <-- keypump
 141   (data (i32.const 16832) "\e0\41\00\00") ;; addr of end
 142   (data (i32.const 16836) "\05\00\00\00") ;; KEY
 143   (data (i32.const 16840) "\02\00\00\00") ;; LIT
 144   (data (i32.const 16844) "\0a\00\00\00") ;; 10 (line feed)
 145   (data (i32.const 16848) "\25\00\00\00") ;; =?
 146   (data (i32.const 16852) "\0e\00\00\00") ;; JZ:
 147   (data (i32.const 16856) "\bc\41\00\00") ;; addr of keypump
 148   (data (i32.const 16860) "\10\00\00\00") ;; DROP
 149   (data (i32.const 16864) "\01\00\00\00") ;; RET
 150
 151   (export "memory" (memory $0))
 152   (export "main" (func $main))
 153   (func $main (result i32)
 154     call $interpret
 155   )
 156   (func $interpret (result i32)
 157     (local $here i32)
 158     (local $eax i32)
 159     (local $esi i32)
 160     (local $inbuf_head i32)
 161     (local $stringbelt_tail i32)
 162     (local $stringbelt_head i32)
 163     (local $wordbelt_tail i32)
 164     (local $wordbelt_head i32)
 165     (local $channel i32)
 166     i32.const 14340
 167     i32.load
 168     set_local $here
 169     i32.const 14344
 170     i32.load
 171     set_local $esi
 172     get_global $inbuf_data
 173     set_local $inbuf_head
 174     i32.const 14352
 175     i32.load
 176     set_local $stringbelt_tail
 177     i32.const 14356
 178     i32.load
 179     set_local $stringbelt_head
 180     i32.const 14360
 181     i32.load
 182     set_local $wordbelt_tail
 183     i32.const 14364
 184     i32.load
 185     set_local $wordbelt_head
 186     i32.const 14368
 187     i32.load
 188     set_local $channel
 189     block $bye
 190     loop $next
 191         call $sys_stack
 192       get_local $esi
 193       call $sys_reflect
 194       get_local $esi
 195       get_local $esi
 196       i32.const 4
 197       i32.add
 198       set_local $esi
 199       i32.load
 200       set_local $eax
 201       loop $execloop
 202       block $default block $op0 block $ret block $lit block $rinit
 203       block $word block $key block $dup block $plus block $noop2 block $emit
 204       block $fetch block $set block $execute block $noop block $jz block $jnz
 205       block $drop block $wsbool block $jmp block $wordputc block $wordstart
 206       block $dictget block $parsenum block $wordfinish block $jneg1 block $swap
 207       block $words block $here block $dictset block $dup2 block $rot block $drop2
 208       block $comma block $subtract block $keychan block $sethere block $eqbool
 209       block $echostring
 210         get_local $eax
 211         br_table $op0 $ret (;2;)$lit $rinit (;4;)$word $key (;6;)$dup $plus
 212         (;8;)$jmp $emit (;10;)$fetch $set (;12;)$execute $noop (;14;)$jz $jnz
 213         (;16;)$drop $wsbool (;18;)$jmp $wordputc (;20;)$wordstart $dictget
 214         (;22;)$parsenum $wordfinish (;24;)$jneg1 $bye (;26;)$swap $words
 215         (;28;)$here $dictset (;30;)$dup2 $rot (;32;)$drop2 $comma
 216         (;34;)$subtract $keychan (;36;)$sethere $eqbool (;38;)$echostring $default
 217       end ;; echostring
 218         get_local $channel
 219         call $pop
 220         set_local $eax
 221         call $pop
 222         get_local $eax
 223         call $sys_write
 224         br $next
 225       end ;; eqbool
 226         block $equiv
 227           call $pop
 228           call $pop
 229           tee_local $eax
 230           i32.eq
 231           get_local $eax
 232           call $push
 233           br_if $equiv
 234           i32.const 0
 235           call $push
 236           br $next
 237         end
 238         i32.const 1
 239         call $push
 240         br $next
 241       end ;; sethere
 242         call $pop
 243         set_local $here
 244         br $next
 245       end ;; keychan
 246         call $pop
 247         set_local $channel
 248         br $next
 249       end ;; subtract
 250         call $pop
 251         set_local $eax
 252         call $pop
 253         get_local $eax
 254         i32.sub
 255         call $push
 256         br $next
 257       end ;; comma
 258         get_local $here
 259         call $pop
 260         i32.store
 261         get_local $here
 262         i32.const 4
 263         i32.add
 264         set_local $here
 265         br $next
 266       end ;; drop2
 267         call $pop
 268         call $pop
 269         drop
 270         drop
 271         br $next
 272       end ;; rot
 273         call $pop
 274         set_local $eax
 275         call $pop
 276         call $pop
 277         get_local $eax
 278         call $push
 279         call $push
 280         call $push
 281         br $next
 282       end ;; dup2
 283         get_local $esi
 284         call $rpush
 285         call $pop
 286         set_local $eax
 287         call $pop
 288         tee_local $esi
 289         call $push
 290         get_local $eax
 291         call $push
 292         get_local $esi
 293         call $push
 294         get_local $eax
 295         call $push
 296         call $rpop
 297         set_local $esi
 298         br $next
 299       end ;; dictset
 300         call $pop
 301         call $rpush
 302         call $pop
 303         set_local $eax
 304         call $pop
 305         get_local $eax
 306         call $rpop
 307         call $vocab_set
 308         drop
 309         br $next
 310       end ;; here
 311         get_local $here
 312         call $push
 313         br $next
 314       end ;; words
 315         call $sys_words
 316         br $next
 317       end ;; swap
 318         call $pop
 319         call $pop
 320         set_local $eax
 321         call $push
 322         get_local $eax
 323         call $push
 324         br $next
 325       end ;; jneg1
 326         block $jneg1if
 327           call $pop
 328           i32.const -1
 329           i32.eq
 330           br_if $jneg1if
 331           get_local $esi
 332           i32.const 4
 333           i32.add
 334           set_local $esi
 335           br $next
 336         end
 337         get_local $esi
 338         i32.load
 339         set_local $esi
 340         br $next
 341       end ;; wordfinish
 342         get_local $wordbelt_tail
 343         get_local $wordbelt_head
 344         get_local $wordbelt_tail
 345         i32.const 4
 346         i32.add
 347         i32.sub
 348         tee_local $eax (; n bytes ;)
 349         i32.store
 350         (; align to 32-bit ;)
 351         get_local $wordbelt_head
 352         i32.const 3
 353         i32.add
 354         i32.const 12284
 355         i32.and
 356         set_local $wordbelt_head
 357         (; /align ;)
 358         get_local $wordbelt_tail
 359         i32.const 4
 360         i32.add
 361         call $push
 362         get_local $eax
 363         call $push
 364         br $next
 365       end ;; parsenum
 366         call $pop
 367         call $rpush
 368         call $pop
 369         tee_local $eax
 370         call $rpop
 371         i32.const 14348 (; load BASE ;)
 372         i32.load
 373         call $sys_parsenum
 374         get_local $eax
 375         i32.load
 376         call $push
 377         call $push
 378         br $next
 379       end ;; dictget
 380         call $pop
 381         set_local $eax
 382         call $pop
 383         get_local $eax
 384         call $vocab_get
 385         call $push
 386         br $next
 387       end ;; wordstart
 388         block $wbhasspace
 389           get_local $wordbelt_head
 390           get_global $inbuf
 391           i32.const 8
 392           i32.sub
 393           i32.le_u
 394           br_if $wbhasspace
 395           get_global $wordbelt
 396           set_local $wordbelt_head
 397         end
 398         get_local $wordbelt_head
 399         get_local $wordbelt_head
 400         tee_local $wordbelt_tail
 401         i32.const 0
 402         i32.store
 403         i32.const 4
 404         i32.add
 405         set_local $wordbelt_head
 406         br $next
 407       end ;; wordputc
 408         block $wbhasspace2
 409           get_local $wordbelt_head
 410           get_global $inbuf
 411           i32.lt_u
 412           br_if $wbhasspace2
 413           get_global $wordbelt
 414           tee_local $wordbelt_head
 415           get_local $wordbelt_tail
 416           i32.load
 417           i32.store
 418           get_local $wordbelt_head
 419           i32.const 4
 420           i32.add
 421           set_local $wordbelt_head
 422           get_local $wordbelt_tail
 423           i32.const 4
 424           i32.add
 425           set_local $wordbelt_tail
 426           loop $copywordtostart
 427             get_local $wordbelt_head
 428             get_local $wordbelt_tail
 429             i32.load16_u
 430             i32.store16
 431             get_local $wordbelt_head
 432             i32.const 2
 433             i32.add
 434             set_local $wordbelt_head
 435             get_local $wordbelt_tail
 436             i32.const 2
 437             i32.add
 438             tee_local $wordbelt_tail
 439             get_global $inbuf
 440             i32.le_u
 441             br_if $copywordtostart
 442           end
 443           get_global $wordbelt
 444           set_local $wordbelt_tail
 445         end
 446         get_local $wordbelt_head
 447         call $pop
 448         i32.store16
 449         get_local $wordbelt_head
 450         i32.const 2
 451         i32.add
 452         set_local $wordbelt_head
 453         br $next
 454       end ;; jmp
 455         get_local $esi
 456         i32.load
 457         set_local $esi
 458         br $next
 459       end ;; wsbool
 460         call $pop
 461         tee_local $eax
 462         call $is_whitespace
 463         get_local $eax
 464         call $push
 465         call $push
 466         call $sys_stack
 467         br $next
 468       end ;; drop
 469         call $pop
 470         drop
 471         br $next
 472       end ;; jnz
 473         block $jnzif
 474           call $pop
 475           i32.eqz
 476           br_if $jnzif
 477           get_local $esi
 478           i32.load
 479           set_local $esi
 480           br $next
 481         end
 482         get_local $esi
 483         i32.const 4
 484         i32.add
 485         set_local $esi
 486         br $next
 487       end ;; jz
 488         block $jzif
 489           call $pop
 490           i32.eqz
 491           br_if $jzif
 492           get_local $esi
 493           i32.const 4
 494           i32.add
 495           set_local $esi
 496           br $next
 497         end
 498         get_local $esi
 499         i32.load
 500         set_local $esi
 501         br $next
 502       end ;; noop
 503         br $next
 504       end ;; execute
 505         call $pop
 506         tee_local $eax
 507         i32.const 256
 508         i32.lt_u
 509         br_if $execloop
 510         get_local $esi
 511         call $rpush
 512         get_local $eax
 513         set_local $esi
 514         br $next
 515       end ;; set
 516         call $pop
 517         set_local $eax
 518         call $pop
 519         get_local $eax
 520         i32.store
 521         br $next
 522       end ;; fetch
 523         call $pop
 524         i32.load
 525         call $push
 526         br $next
 527       end ;; emit (.)
 528         call $pop
 529         call $sys_echo
 530         br $next
 531       end ;; noop2
 532         br $next
 533       end ;; plus
 534         call $pop
 535         call $pop
 536         i32.add
 537         call $push
 538         br $next
 539       end ;; dup
 540         call $pop
 541         tee_local $eax
 542         get_local $eax
 543         call $push
 544         call $push
 545         br $next
 546       end ;; key
 547         loop $key_loop
 548           block $key_read
 549             get_global $inbuf_size
 550             i32.load
 551             get_local $inbuf_head
 552             get_global $inbuf_data
 553             i32.sub
 554             i32.le_u
 555             br_if $key_read
 556             get_local $inbuf_head
 557             i32.load16_u
 558             call $push
 559             get_local $inbuf_head
 560             i32.const 2
 561             i32.add
 562             set_local $inbuf_head
 563             br $next
 564           end ;; key_read
 565           get_local $channel
 566           get_global $inbuf
 567           call $sys_read
 568           block $nullread
 569             get_global $inbuf_size
 570             i32.load
 571             i32.eqz
 572             br_if $nullread
 573             br $key_loop
 574           end ;; nullread
 575           i32.const -1 ;; <- keyval sent if sz == 0
 576           call $push
 577           br $next
 578         end ;; key_loop
 579       end ;; word
 580         br $next
 581       end ;; rinit
 582         call $rinit
 583         br $next
 584       end ;; lit
 585         get_local $esi
 586         get_local $esi
 587         i32.const 4
 588         i32.add
 589         set_local $esi
 590         i32.load
 591         call $push
 592         br $next
 593       end ;; ret
 594         call $rpop
 595         set_local $esi
 596         br $next
 597       end ;; op0
 598         get_local $esi
 599         call $sys_reflect
 600         br $bye
 601       end ;; default
 602         get_local $esi
 603         call $rpush
 604         get_local $eax
 605         set_local $esi
 606         br $next
 607     end ;; execloop
 608     end ;; nextl
 609     end ;; bye
 610     i32.const 14340
 611     get_local $here
 612     i32.store
 613     i32.const 14352
 614     get_local $stringbelt_tail
 615     i32.store
 616     i32.const 14356
 617     get_local $stringbelt_head
 618     i32.store
 619     i32.const 14360
 620     get_local $wordbelt_tail
 621     i32.store
 622     i32.const 14364
 623     get_local $wordbelt_head
 624     i32.store
 625     i32.const 14368
 626     get_local $channel
 627     i32.store
 628     i32.const 0
 629   )
 630 )