Miroirs/waforth
1
0
Fork 0
mirror of https://github.com/remko/waforth synced 2025-01-14 08:01:34 +01:00
Code Issues Projects Releases Packages Wiki Activity

Prepare for DOES>

Browse source
This commit is contained in:
Remko Tronçon 2019-03-10 11:37:47 +01:00
parent 17504b31e4
commit f7a1ab2aa2
2 changed files with 49 additions and 35 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

77
src/waforth.wat
View file

@ -393,6 +393,12 @@
(i32.load (i32.add (get_global $latest) (i32.const 4)))
(i32.const !fData)))
;; Store the code pointer already
;; The code hasn't been loaded yet, but since nothing can affect the next table
;; index, we can assume the index will be correct. This allows semicolon to be
;; agnostic about whether it is compiling a word or a DOES>.
(i32.store (call $body (get_global $latest)) (get_global $nextTableIndex))
(set_global $cp (i32.const !moduleBodyBase))
(set_global $currentLocal (i32.const -1))
(set_global $lastLocal (i32.const -1))
@ -435,46 +441,49 @@
(i32.const !moduleHeaderTableInitialSizeBase)
(call $leb128-4p (i32.add (get_global $nextTableIndex) (i32.const 1))))
;; Write a name section
(set_local $nameLength (i32.and (i32.load8_u (i32.add (get_global $latest) (i32.const 4)))
(i32.const !lengthMask)))
(i32.store8 (get_global $cp) (i32.const 0))
(i32.store8 (i32.add (get_global $cp) (i32.const 1))
(i32.add (i32.const 13) (i32.mul (i32.const 2) (get_local $nameLength))))
(i32.store8 (i32.add (get_global $cp) (i32.const 2)) (i32.const 0x04))
(i32.store8 (i32.add (get_global $cp) (i32.const 3)) (i32.const 0x6e))
(i32.store8 (i32.add (get_global $cp) (i32.const 4)) (i32.const 0x61))
(i32.store8 (i32.add (get_global $cp) (i32.const 5)) (i32.const 0x6d))
(i32.store8 (i32.add (get_global $cp) (i32.const 6)) (i32.const 0x65))
(set_global $cp (i32.add (get_global $cp) (i32.const 7)))
;; Write a name section (if we're ending the code for the current dictionary entry)
(if (i32.eq (i32.load (call $body (get_global $latest)))
(get_global $nextTableIndex))
(then
(set_local $nameLength (i32.and (i32.load8_u (i32.add (get_global $latest) (i32.const 4)))
(i32.const !lengthMask)))
(i32.store8 (get_global $cp) (i32.const 0))
(i32.store8 (i32.add (get_global $cp) (i32.const 1))
(i32.add (i32.const 13) (i32.mul (i32.const 2) (get_local $nameLength))))
(i32.store8 (i32.add (get_global $cp) (i32.const 2)) (i32.const 0x04))
(i32.store8 (i32.add (get_global $cp) (i32.const 3)) (i32.const 0x6e))
(i32.store8 (i32.add (get_global $cp) (i32.const 4)) (i32.const 0x61))
(i32.store8 (i32.add (get_global $cp) (i32.const 5)) (i32.const 0x6d))
(i32.store8 (i32.add (get_global $cp) (i32.const 6)) (i32.const 0x65))
(set_global $cp (i32.add (get_global $cp) (i32.const 7)))
(i32.store8 (get_global $cp) (i32.const 0x00))
(i32.store8 (i32.add (get_global $cp) (i32.const 1))
(i32.add (i32.const 1) (get_local $nameLength)))
(i32.store8 (i32.add (get_global $cp) (i32.const 2)) (get_local $nameLength))
(set_global $cp (i32.add (get_global $cp) (i32.const 3)))
(call $memmove (get_global $cp)
(i32.add (get_global $latest) (i32.const 5))
(get_local $nameLength))
(set_global $cp (i32.add (get_global $cp) (get_local $nameLength)))
(i32.store8 (get_global $cp) (i32.const 0x00))
(i32.store8 (i32.add (get_global $cp) (i32.const 1))
(i32.add (i32.const 1) (get_local $nameLength)))
(i32.store8 (i32.add (get_global $cp) (i32.const 2)) (get_local $nameLength))
(set_global $cp (i32.add (get_global $cp) (i32.const 3)))
(call $memmove (get_global $cp)
(i32.add (get_global $latest) (i32.const 5))
(get_local $nameLength))
(set_global $cp (i32.add (get_global $cp) (get_local $nameLength)))
(i32.store8 (get_global $cp) (i32.const 0x01))
(i32.store8 (i32.add (get_global $cp) (i32.const 1))
(i32.add (i32.const 3) (get_local $nameLength)))
(i32.store8 (i32.add (get_global $cp) (i32.const 2)) (i32.const 0x01))
(i32.store8 (i32.add (get_global $cp) (i32.const 3)) (i32.const 0x00))
(i32.store8 (i32.add (get_global $cp) (i32.const 4)) (get_local $nameLength))
(set_global $cp (i32.add (get_global $cp) (i32.const 5)))
(call $memmove (get_global $cp)
(i32.add (get_global $latest) (i32.const 5))
(get_local $nameLength))
(set_global $cp (i32.add (get_global $cp) (get_local $nameLength)))
(i32.store8 (get_global $cp) (i32.const 0x01))
(i32.store8 (i32.add (get_global $cp) (i32.const 1))
(i32.add (i32.const 3) (get_local $nameLength)))
(i32.store8 (i32.add (get_global $cp) (i32.const 2)) (i32.const 0x01))
(i32.store8 (i32.add (get_global $cp) (i32.const 3)) (i32.const 0x00))
(i32.store8 (i32.add (get_global $cp) (i32.const 4)) (get_local $nameLength))
(set_global $cp (i32.add (get_global $cp) (i32.const 5)))
(call $memmove (get_global $cp)
(i32.add (get_global $latest) (i32.const 5))
(get_local $nameLength))
(set_global $cp (i32.add (get_global $cp) (get_local $nameLength)))))
;; Load the code and store the index
;; Load the code
(call $shell_load (i32.const !moduleHeaderBase)
(i32.sub (get_global $cp) (i32.const !moduleHeaderBase))
(get_global $nextTableIndex))
(i32.store (call $body (get_global $latest)) (get_global $nextTableIndex))
(set_global $nextTableIndex (i32.add (get_global $nextTableIndex) (i32.const 1)))
(call $hidden)

7
tests/tests.js
View file

@ -1213,7 +1213,12 @@ function loadTests(wasmModule) {
// describe.only("DOES>", () => {
// it("should work", () => {
// run(": ID CREATE 1 , DOES> @");
// run(": ID CREATE 23 , DOES> @ ;");
// run("CREATE boo");
// run("boo boo 44");
// expect(stack[0]).to.eql(23);
// expect(stack[1]).to.eql(23);
// expect(stack[2]).to.eql(44);
// });
// });