Miroirs/waforth
1
0
Fork 0
mirror of https://github.com/remko/waforth synced 2024-11-16 07:47:30 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

fix: add missing then blocks (#62)
Some checks failed
Build (master) / build (push) Has been cancelled
Details
Build Standalone / build-standalone (macos-latest) (push) Has been cancelled
Details
Build Standalone / build-standalone (ubuntu-latest) (push) Has been cancelled
Details
Build Standalone / build-standalone (windows-latest) (push) Has been cancelled
Details
Build VS Code Extension / build (push) Has been cancelled
Details
Build waforthc / build-waforthc (macos-latest) (push) Has been cancelled
Details
Build waforthc / build-waforthc (ubuntu-20.04) (push) Has been cancelled
Details
Build (master) / deploy-pages (push) Has been cancelled
Details
Build (master) / deploy-aws (push) Has been cancelled
Details

Browse source
This commit is contained in:
Chris Guimarães 2024-07-15 19:26:22 +01:00 committed by GitHub
parent 9239e69425
commit c97cb99faa
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
1 changed files with 206 additions and 217 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

47
src/waforth.wat
View file

@ -32,7 +32,6 @@
;; Generic signal to shell
(import "shell" "call" (func $shell_call))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Interpreter
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -68,11 +67,11 @@
;; Check for stack underflow
(if (i32.lt_s (local.get $tos) (i32.const 0x10000 (; = STACK_BASE ;)))
(call $fail (i32.const 0x20085 (; = str("stack empty") ;))))
(then (call $fail (i32.const 0x20085 (; = str("stack empty") ;)))))
;; Show prompt, depending on STATE
(if (i32.eqz (local.get $silent))
(call $ctype
(then (call $ctype
(block $endCase (result i32)
(block $caseDefault
(block $caseOK
@ -81,7 +80,7 @@
(i32.load (i32.const 0x209a0 (; = body(STATE) ;)))))
(i32.const 0x2009c (; = str("compiled\n") ;)) (br $endCase))
(i32.const 0x20091 (; = str("ok\n") ;)) (br $endCase))
(i32.const 0x20095 (; = str("error\n") ;)))))
(i32.const 0x20095 (; = str("error\n") ;))))))
(local.get $tos)
(br $loop)))
@ -92,7 +91,6 @@
;; End of input was reached
(global.set $error (i32.const 0x4 (; = ERR_EOI ;))))
;; Interpret the string in the input buffer word by word, until
;; the end of the input buffer is reached.
;;
@ -192,7 +190,6 @@
(i32.store (i32.const 0x209a0 (; = body(STATE) ;)) (i32.const 0))
(unreachable))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Function table
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -229,7 +226,6 @@
;; as second parameter.
(type $dataWord (func (param i32) (param i32) (result i32)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Data
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -278,7 +274,6 @@
"\60\02\7f\7f\01\7f" ;; (func (param i32) (param i32) (result i32))
"\60\01\7f\02\7F\7f" ;; (func (param i32) (result i32) (result i32))
"\02" "\20" ;; Import section
"\02" ;; #Entries
"\03\65\6E\76" "\05\74\61\62\6C\65" ;; 'env' . 'table'
@ -323,7 +318,6 @@
;; MODULE_HEADER_TABLE_INITIAL_SIZE_BASE := 0x102c (MODULE_HEADER_BASE + 0x2c (; = MODULE_HEADER_TABLE_INITIAL_SIZE_OFFSET ;))
;; MODULE_HEADER_FUNCTION_TYPE_BASE := 0x1041 (MODULE_HEADER_BASE + 0x41 (; = MODULE_HEADER_FUNCTION_TYPE_OFFSET ;))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Constant strings
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -340,7 +334,6 @@
(data (i32.const 0x20095) "\06" "error\n")
(data (i32.const 0x2009c) "\09" "compiled\n")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Built-in words
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -609,7 +602,7 @@
(local $bbtos i32)
(local $divisor i32)
(if (i32.eqz (local.tee $divisor (i32.load (local.tee $btos (i32.sub (local.get $tos) (i32.const 4))))))
(call $fail (i32.const 0x2000f (; = str("division by 0") ;))))
(then (call $fail (i32.const 0x2000f (; = str("division by 0") ;)))))
(i32.store (local.tee $bbtos (i32.sub (local.get $tos) (i32.const 8)))
(i32.div_s (i32.load (local.get $bbtos)) (local.get $divisor)))
(local.get $btos))
@ -1244,7 +1237,7 @@
(local $nameLen i32)
(local.set $nameAddr (local.set $nameLen (call $parseName)))
(if (i32.eqz (local.get $nameLen))
(call $fail (i32.const 0x2001d (; = str("incomplete input") ;))))
(then (call $fail (i32.const 0x2001d (; = str("incomplete input") ;)))))
(call $create
(local.get $nameAddr)
(local.get $nameLen)
@ -1267,7 +1260,7 @@
(local $nameLen i32)
(local.set $nameAddr (local.set $nameLen (call $parseName)))
(if (i32.eqz (local.get $nameLen))
(call $fail (i32.const 0x2001d (; = str("incomplete input") ;))))
(then (call $fail (i32.const 0x2001d (; = str("incomplete input") ;)))))
(call $create
(local.get $nameAddr)
(local.get $nameLen)
@ -1658,7 +1651,7 @@
(local $oldLatest i32)
(local.set $nameAddr (local.set $nameLen (call $parseName)))
(if (i32.eqz (local.get $nameLen))
(call $fail (i32.const 0x2001d (; = str("incomplete input") ;))))
(then (call $fail (i32.const 0x2001d (; = str("incomplete input") ;)))))
(local.set $oldHere (global.get $here))
(local.set $oldLatest (global.get $latest))
(call $create
@ -2413,7 +2406,6 @@
(data (i32.const 0x20b14) "\08\0b\02\00" "\01" "] " "\c3\00\00\00")
(elem (i32.const 0xc3) $right-bracket)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Interpreter state
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -2451,7 +2443,6 @@
;; ERR_BYE := 0x5 (BYE called)
(global $error (mut i32) (i32.const 0x0))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Compiler functions
;;
@ -2468,7 +2459,7 @@
(local $nameLen i32)
(local.set $nameAddr (local.set $nameLen (call $parseName)))
(if (i32.eqz (local.get $nameLen))
(call $fail (i32.const 0x2001d (; = str("incomplete input") ;))))
(then (call $fail (i32.const 0x2001d (; = str("incomplete input") ;)))))
(call $create
(local.get $nameAddr)
(local.get $nameLen)
@ -2857,7 +2848,6 @@
;; Compilation pointer
(global $cp (mut i32) (i32.const 0x105e (; = MODULE_BODY_BASE ;)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Word helper functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -2917,16 +2907,16 @@
(local $end1 i32)
(local $end2 i32)
(if (i32.eqz (local.get $len1))
(return (i32.const 0)))
(then (return (i32.const 0))))
(if (i32.ne (local.get $len1) (local.get $len2))
(return (i32.const 0)))
(then (return (i32.const 0))))
(local.set $end1 (i32.add (local.get $addr1) (local.get $len1)))
(local.set $end2 (i32.add (local.get $addr2) (local.get $len2)))
(loop $loop (result i32)
(if (i32.eq (local.get $addr1) (local.get $end1))
(return (i32.const 1)))
(then (return (i32.const 1))))
(if (i32.ne (i32.load8_s (local.get $addr1)) (i32.load8_s (local.get $addr2)))
(return (i32.const 0)))
(then (return (i32.const 0))))
(local.set $addr1 (i32.add (local.get $addr1) (i32.const 1)))
(local.set $addr2 (i32.add (local.get $addr2)(i32.const 1)))
(br $loop)))
@ -3016,7 +3006,7 @@
(func $ensureCompiling (param $tos i32) (result i32)
(local.get $tos)
(if (param i32) (result i32) (i32.eqz (i32.load (i32.const 0x209a0 (; = body(STATE) ;))))
(call $fail (i32.const 0x2002e (; = str("word not supported in interpret mode") ;)))))
(then (call $fail (i32.const 0x2002e (; = str("word not supported in interpret mode") ;))))))
;; LEB128 with fixed 4 bytes (with padding bytes)
;; This means we can only represent 28 bits, which should be plenty.
@ -3154,7 +3144,7 @@
(local $restcount i32)
(local $value i32)
(if (i32.eqz (local.get $len))
(return (i32.const -1) (i32.const -1)))
(then (return (i32.const -1) (i32.const -1))))
(call $number (i64.const 0) (local.get $addr) (local.get $len))
(local.set $restcount)
(drop)
@ -3189,16 +3179,16 @@
(block $endLoop
(loop $loop
(if (i32.lt_s (local.get $char) (i32.const 0x30 (; = '0' ;) ))
(br $endLoop))
(then (br $endLoop)))
(if (i32.le_s (local.get $char) (i32.const 0x39 (; = '9' ;) ))
(then
(local.set $n (i32.sub (local.get $char) (i32.const 48))))
(else
(if (i32.lt_s (local.get $char) (i32.const 0x41 (; = 'A' ;) ))
(br $endLoop))
(then (br $endLoop)))
(local.set $n (i32.sub (local.get $char) (i32.const 55)))))
(if (i32.ge_s (local.get $n) (local.get $base))
(br $endLoop))
(then (br $endLoop)))
(local.set $value
(i64.add
(i64.mul (local.get $value) (i64.extend_i32_u (local.get $base)))
@ -3250,7 +3240,7 @@
(func $find! (param $addr i32) (param $len i32) (result i32) (result i32)
(local $r i32)
(if (i32.eqz (local.tee $r (call $find (local.get $addr) (local.get $len))))
(call $failUndefinedWord (local.get $addr) (local.get $len)))
(then (call $failUndefinedWord (local.get $addr) (local.get $len))))
(local.get $r))
(func $aligned (param $addr i32) (result i32)
@ -3267,7 +3257,6 @@
(else (call $U._ (local.get $v) (local.get $base))))
(call $shell_emit (call $numberToChar (local.get $m))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; API Functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;