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

Hard-code string offsets

Browse source
This commit is contained in:
Remko Tronçon 2019-11-06 22:52:55 +01:00
parent 3b2dff086e
commit fd3a69cb93
2 changed files with 24 additions and 43 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

61
src/waforth.wat
View file

@ -34,7 +34,7 @@
(define !preludeDataBase #x2000) (define !preludeDataBase #x2000)
(define !returnStackBase #x4000) (define !returnStackBase #x4000)
(define !stackBase #x10000) (define !stackBase #x10000)
(define !dictionaryBase #x20000) (define !dictionaryBase #x21000)
(define !memorySize (* 100 1024 1024)) (define !memorySize (* 100 1024 1024))
(define !moduleHeader (define !moduleHeader
@ -107,30 +107,11 @@
(define !pushDataAddressIndex 5) (define !pushDataAddressIndex 5)
(define !setLatestBodyIndex 6) (define !setLatestBodyIndex 6)
(define !compileCallIndex 7) (define !compileCallIndex 7)
(define !tableStartIndex 8) (define !tableStartIndex 16)
(define !dictionaryLatest 0) (define !dictionaryLatest 0)
(define !dictionaryTop !dictionaryBase) (define !dictionaryTop !dictionaryBase)
;; Built-in strings
(define !undefinedWordStr -1)
(define !divisionBy0Str -1)
(define !incompleteInputStr -1)
(define !missingClosingParenStr -1)
(define !missingClosingQuoteStr -1)
(define !wordNotInterpretable -1)
(define-syntax-rule (!def_string s addressVar)
(let ((base !dictionaryTop)
(size (* (ceiling (/ (+ (string-length s) 4) 4)) 4)))
(set! !dictionaryTop (+ !dictionaryTop size))
(set! addressVar base)
`((data
(i32.const ,(eval base))
,(integer->integer-bytes (string-length s) 1 #f #f)
,(eval s)))))
(define (!def_word name f (flags 0) (idx !tableStartIndex)) (define (!def_word name f (flags 0) (idx !tableStartIndex))
(let* ((base !dictionaryTop) (let* ((base !dictionaryTop)
(previous !dictionaryLatest) (previous !dictionaryLatest)
@ -189,13 +170,13 @@
;; Constant strings ;; Constant strings
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(!def_string "undefined word" !undefinedWordStr) (data (i32.const #x20000) "\u000eundefined word")
(!def_string "division by 0" !divisionBy0Str) (data (i32.const #x20014) "\u000ddivision by 0")
(!def_string "incomplete input" !incompleteInputStr) (data (i32.const #x20028) "\u0010incomplete input")
(!def_string "missing ')'" !missingClosingParenStr) (data (i32.const #x2003C) "\u000bmissing ')'")
(!def_string "missing \"" !missingClosingQuoteStr) (data (i32.const #x2004C) "\u0009missing \u0022")
(!def_string "word not supported in interpret mode" !wordNotInterpretable) (data (i32.const #x2005C) "\u0024word not supported in interpret mode")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Built-in words ;; Built-in words
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -211,7 +192,7 @@
;; 6.1.0070 ;; 6.1.0070
(func $tick (func $tick
(call $readWord (i32.const 0x20)) (call $readWord (i32.const 0x20))
(if (i32.eqz (i32.load8_u (i32.const !wordBase))) (call $fail (i32.const !incompleteInputStr))) (if (i32.eqz (i32.load8_u (i32.const !wordBase))) (call $fail (i32.const 0x20028))) ;; incomplete input
(call $find) (call $find)
(drop (call $pop))) (drop (call $pop)))
(!def_word "'" "$tick") (!def_word "'" "$tick")
@ -222,7 +203,7 @@
(block $endLoop (block $endLoop
(loop $loop (loop $loop
(if (i32.lt_s (tee_local $c (call $readChar)) (i32.const 0)) (if (i32.lt_s (tee_local $c (call $readChar)) (i32.const 0))
(call $fail (i32.const !missingClosingParenStr))) (call $fail (i32.const 0x2003C))) ;; missing ')'
(br_if $endLoop (i32.eq (get_local $c) (i32.const 41))) (br_if $endLoop (i32.eq (get_local $c) (i32.const 41)))
(br $loop)))) (br $loop))))
(!def_word "(" "$paren" !fImmediate) (!def_word "(" "$paren" !fImmediate)
@ -325,7 +306,7 @@
(local $bbtos i32) (local $bbtos i32)
(local $divisor i32) (local $divisor i32)
(if (i32.eqz (tee_local $divisor (i32.load (tee_local $btos (i32.sub (get_global $tos) (i32.const 4)))))) (if (i32.eqz (tee_local $divisor (i32.load (tee_local $btos (i32.sub (get_global $tos) (i32.const 4))))))
(call $fail (i32.const !divisionBy0Str))) (call $fail (i32.const 0x20014))) ;; division by 0
(i32.store (tee_local $bbtos (i32.sub (get_global $tos) (i32.const 8))) (i32.store (tee_local $bbtos (i32.sub (get_global $tos) (i32.const 8)))
(i32.div_s (i32.load (get_local $bbtos)) (get_local $divisor))) (i32.div_s (i32.load (get_local $bbtos)) (get_local $divisor)))
(set_global $tos (get_local $btos))) (set_global $tos (get_local $btos)))
@ -732,7 +713,7 @@
;; 6.1.0895 ;; 6.1.0895
(func $CHAR (func $CHAR
(call $readWord (i32.const 0x20)) (call $readWord (i32.const 0x20))
(if (i32.eqz (i32.load8_u (i32.const !wordBase))) (call $fail (i32.const !incompleteInputStr))) (if (i32.eqz (i32.load8_u (i32.const !wordBase))) (call $fail (i32.const 0x20028))) ;; incomplete input
(i32.store (i32.sub (get_global $tos) (i32.const 4)) (i32.store (i32.sub (get_global $tos) (i32.const 4))
(i32.load8_u (i32.const (!+ !wordBase 1))))) (i32.load8_u (i32.const (!+ !wordBase 1)))))
(!def_word "CHAR" "$CHAR") (!def_word "CHAR" "$CHAR")
@ -757,7 +738,7 @@
(set_global $here (i32.add (get_global $here) (i32.const 4))) (set_global $here (i32.add (get_global $here) (i32.const 4)))
(call $readWord (i32.const 0x20)) (call $readWord (i32.const 0x20))
(if (i32.eqz (i32.load8_u (i32.const !wordBase))) (call $fail (i32.const !incompleteInputStr))) (if (i32.eqz (i32.load8_u (i32.const !wordBase))) (call $fail (i32.const 0x20028))) ;; incomplete input
(drop (call $pop)) (drop (call $pop))
(i32.store8 (get_global $here) (tee_local $length (i32.load8_u (i32.const !wordBase)))) (i32.store8 (get_global $here) (tee_local $length (i32.load8_u (i32.const !wordBase))))
(set_global $here (i32.add (get_global $here) (i32.const 1))) (set_global $here (i32.add (get_global $here) (i32.const 1)))
@ -1102,9 +1083,9 @@
(local $findResult i32) (local $findResult i32)
(call $ensureCompiling) (call $ensureCompiling)
(call $readWord (i32.const 0x20)) (call $readWord (i32.const 0x20))
(if (i32.eqz (i32.load8_u (i32.const !wordBase))) (call $fail (i32.const !incompleteInputStr))) (if (i32.eqz (i32.load8_u (i32.const !wordBase))) (call $fail (i32.const 0x20028))) ;; incomplete input
(call $find) (call $find)
(if (i32.eqz (tee_local $findResult (call $pop))) (call $fail (i32.const !undefinedWordStr))) (if (i32.eqz (tee_local $findResult (call $pop))) (call $fail (i32.const 0x20000))) ;; undefined word
(set_local $findToken (call $pop)) (set_local $findToken (call $pop))
(if (i32.eq (get_local $findResult) (i32.const 1)) (if (i32.eq (get_local $findResult) (i32.const 1))
(then (call $compileCall (get_local $findToken))) (then (call $compileCall (get_local $findToken)))
@ -1180,7 +1161,7 @@
(block $endLoop (block $endLoop
(loop $loop (loop $loop
(if (i32.lt_s (tee_local $c (call $readChar)) (i32.const 0)) (if (i32.lt_s (tee_local $c (call $readChar)) (i32.const 0))
(call $fail (i32.const !missingClosingQuoteStr))) (call $fail (i32.const 0x2003C))) ;; missing closing quote
(br_if $endLoop (i32.eq (get_local $c) (i32.const 0x22))) (br_if $endLoop (i32.eq (get_local $c) (i32.const 0x22)))
(i32.store8 (get_global $here) (get_local $c)) (i32.store8 (get_global $here) (get_local $c))
(set_global $here (i32.add (get_global $here) (i32.const 1))) (set_global $here (i32.add (get_global $here) (i32.const 1)))
@ -1247,9 +1228,9 @@
;; 6.2.2295 ;; 6.2.2295
(func $TO (func $TO
(call $readWord (i32.const 0x20)) (call $readWord (i32.const 0x20))
(if (i32.eqz (i32.load8_u (i32.const !wordBase))) (call $fail (i32.const !incompleteInputStr))) (if (i32.eqz (i32.load8_u (i32.const !wordBase))) (call $fail (i32.const 0x20028))) ;; incomplete input
(call $find) (call $find)
(if (i32.eqz (call $pop)) (call $fail (i32.const !undefinedWordStr))) (if (i32.eqz (call $pop)) (call $fail (i32.const 0x20000))) ;; undefined word
(i32.store (i32.add (call $body (call $pop)) (i32.const 4)) (call $pop))) (i32.store (i32.add (call $body (call $pop)) (i32.const 4)) (call $pop)))
(!def_word "TO" "$TO") (!def_word "TO" "$TO")
@ -1608,7 +1589,7 @@ EOF
(call $compilePushConst (call $pop))))) (call $compilePushConst (call $pop)))))
;; We're not compiling. Leave the number on the stack. ;; We're not compiling. Leave the number on the stack.
(else ;; It's not a number. (else ;; It's not a number.
(call $fail (i32.const !undefinedWordStr))))) (call $fail (i32.const 0x20000))))) ;; undefined word
(else ;; Found the word. (else ;; Found the word.
;; Are we compiling or is it immediate? ;; Are we compiling or is it immediate?
(if (i32.or (i32.eqz (i32.load (i32.const !stateBase))) (if (i32.or (i32.eqz (i32.load (i32.const !stateBase)))
@ -1928,7 +1909,7 @@ EOF
(func $ensureCompiling (func $ensureCompiling
(if (i32.eqz (i32.load (i32.const !stateBase))) (if (i32.eqz (i32.load (i32.const !stateBase)))
(call $fail (i32.const !wordNotInterpretable)))) (call $fail (i32.const 0x2005C)))) ;; word not interpretable
;; Toggle the hidden flag ;; Toggle the hidden flag
(func $hidden (func $hidden

6
tests/tests.js
View file

@ -902,21 +902,21 @@ function loadTests(wasmModule, arrayToBase64) {
it("should find a word", () => { it("should find a word", () => {
loadString("DUP"); loadString("DUP");
run("FIND"); run("FIND");
expect(stack[0]).to.eql(131956); expect(stack[0]).to.eql(135920);
expect(stack[1]).to.eql(-1); expect(stack[1]).to.eql(-1);
}); });
it("should find a short word", () => { it("should find a short word", () => {
loadString("!"); loadString("!");
run("FIND"); run("FIND");
expect(stack[0]).to.eql(131204); expect(stack[0]).to.eql(135168);
expect(stack[1]).to.eql(-1); expect(stack[1]).to.eql(-1);
}); });
it("should find an immediate word", () => { it("should find an immediate word", () => {
loadString("+LOOP"); loadString("+LOOP");
run("FIND"); run("FIND");
expect(stack[0]).to.eql(131304); expect(stack[0]).to.eql(135268);
expect(stack[1]).to.eql(1); expect(stack[1]).to.eql(1);
}); });