cdo/wipforth
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix bugs from round 1 of debugging

Browse Source 
There were several issues I ran into immediately:

- The cold start was pointing to the dictionary entry of QUIT instead
  of the CFA
- The RSP needed to be set before calling QUIT, as DOCOL uses the
  return stack
- I'd forgotten LITs before values in a couple of places
- I'd not accounted for LITs in several branch offsets
- A few dictionary links were wrong
This commit is contained in:
Camden Dixie O'Brien
2026-02-27 18:35:17 +00:00
parent 74ff0b037c
commit 83022925f7
1 changed files with 51 additions and 49 deletions
Download Patch File Download Diff File Expand all files Collapse all files

98
wipforth.wat
View File

@@ -1047,7 +1047,7 @@
"\ff\ff\ff\ff")
(data (i32.const 0x053c)
"\82\05\00\00"
"\28\05\00\00"
"\05FALSE\00\00"
"\01\00\00\00"
"\00\00\00\00")
@@ -1068,13 +1068,13 @@
"\64\05\00\00"
"\04HERE\00\00\00"
"\02\00\00\00"
"\a4\0b\00\00")
"\a8\0b\00\00")
(data (i32.const 0x058c)
"\78\05\00\00"
"\06LATEST\00"
"\02\00\00\00"
"\78\0b\00\00")
"\7c\0b\00\00")
(data (i32.const 0x05a0)
"\8c\05\00\00"
@@ -1146,28 +1146,28 @@
;; 0 \ Initial length
;;
;; KEY \ Get byte from input
;; TUCK SPACE? 0BRANCH [56] \ Check if whitespace
;; TUCK SPACE? 0BRANCH [60] \ Check if whitespace
;; TUCK WORDBUF + C! \ Append byte to WORDBUF
;; 1+ \ Increment length
;; DUP 32 >= 0BRANCH [8] EXIT \ Exit if at max length
;; BRANCH [-68] \ Loop back to KEY
;; BRANCH [-72] \ Loop back to KEY
;;
;; \ Byte is whitespace
;; SWAP DROP
;; DUP 0<> 0BRANCH [-92] \ Loop back to KEY if zero length
;; DUP 0<> 0BRANCH [-96] \ Loop back to KEY if zero length
;; ;
(data (i32.const 0x0668)
"\00\60\00\00"
"\00\06\00\00"
"\04WORD\00\00\00"
"\00\00\00\00"
"\18\04\00\00" ;; LIT
"\00\00\00\00" ;; 0
"\84\07\00\00" ;; KEY
"\84\04\00\00" ;; KEY
"\f0\05\00\00" ;; TUCK
"\0c\06\00\00" ;; SPACE?
"\b4\04\00\00" ;; 0BRANCH
"\38\00\00\00" ;; 56
"\3c\00\00\00" ;; 60
"\f0\05\00\00" ;; TUCK
"\ac\05\00\00" ;; WORDBUF
"\c0\02\00\00" ;; +
@@ -1178,16 +1178,16 @@
"\20\00\00\00" ;; 32
"\38\03\00\00" ;; >=
"\b4\04\00\00" ;; 0BRANCH
"\08\00\00\00" ;; 56
"\08\00\00\00" ;; 8
"\0c\04\00\00" ;; EXIT
"\a4\04\00\00" ;; BRANCH
"\bc\ff\ff\ff" ;; -68
"\b8\ff\ff\ff" ;; -72
"\28\02\00\00" ;; SWAP
"\18\02\00\00" ;; DROP
"\08\02\00\00" ;; DUP
"\5c\03\00\00" ;; 0<>
"\b4\04\00\00" ;; 0BRANCH
"\a4\ff\ff\ff" ;; -92
"\a0\ff\ff\ff" ;; -96
"\0c\04\00\00") ;; EXIT
;; => 0x80 bytes
@@ -1255,7 +1255,7 @@
;; LATEST @ \ Initial entry
;;
;; TUCK NAME-LEN \ Get name length
;; OVER <> 0BRANCH [48] \ Check for length mismatch
;; OVER <> 0BRANCH [52] \ Check for length mismatch
;; OVER 5 + \ Get name address
;; OVER SWAP WORDBUF STRING= \ Check if name matches
;; 0BRANCH [12]
@@ -1264,7 +1264,7 @@
;; \ Name doesn't match
;; OVER @ 0= 0BRANCH [12] \ Check for nil link
;; DROP EXIT
;; SWAP @ BRANCH [-108] \ Follow link and loop
;; SWAP @ BRANCH [-112] \ Follow link and loop
;; ;
(data (i32.const 0x078c)
@@ -1278,7 +1278,7 @@
"\54\02\00\00" ;; OVER
"\08\03\00\00" ;; <>
"\b4\04\00\00" ;; 0BRANCH
"\30\00\00\00" ;; 48
"\30\00\00\00" ;; 52
"\54\02\00\00" ;; OVER
"\18\04\00\00" ;; LIT
"\05\00\00\00" ;; 5
@@ -1301,7 +1301,7 @@
"\28\02\00\00" ;; SWAP
"\cc\03\00\00" ;; @
"\a4\04\00\00" ;; BRANCH
"\94\ff\ff\ff" ;; -108
"\90\ff\ff\ff" ;; -112
"\0c\04\00\00") ;; EXIT
;; => 0x90 bytes
@@ -1310,7 +1310,7 @@
;; DUP NAME-LEN \ Get name length
;; 5 + + \ Increment address to end of name
;; DUP 3 AND 0BRANCH [16] \ Check if aligned
;; 1+ BRANCH [-28] \ Increment address, loop to alignment check
;; 1+ BRANCH [-32] \ Increment address, loop to alignment check
;; ;
(data (i32.const 0x081c)
@@ -1331,26 +1331,26 @@
"\10\00\00\00" ;; 16
"\90\02\00\00" ;; 1+
"\a4\04\00\00" ;; BRANCH
"\e4\ff\ff\ff" ;; -28
"\e0\ff\ff\ff" ;; -32
"\0c\04\00\00") ;; EXIT
;; => 0x50 bytes
;; : DIGIT ( byte -- value )
;; DUP DUP 48 >= SWAP 57 <= AND \ Test if 0-9
;; 0BRANCH [20] \ Jump to A-Z test if not
;; 0BRANCH [24] \ Jump to A-Z test if not
;; 48 - \ Get digit value
;; BRANCH [52] \ Go to range check
;; BRANCH [64] \ Go to range check
;;
;; DUP DUP 65 >= SWAP 90 <= AND \ Test if A-Z
;; 0BRANCH [56] \ Jump to invalid digit if not
;; 0BRANCH [60] \ Jump to invalid digit if not
;; 45 - \ Get digit value
;;
;; DUP DUP 0>= SWAP BASE @ < AND \ Test if 0 <= value < BASE
;; 0BRANCH [8] \ Jump to invalid digit if not
;; EXIT
;;
;; DROP -1 \ Return -1 for an invalid digit
;; DROP TRUE \ Return -1 for an invalid digit
;; ;
(data (i32.const 0x086c)
@@ -1368,23 +1368,24 @@
"\2c\03\00\00" ;; <=
"\8c\03\00\00" ;; AND
"\b4\04\00\00" ;; 0BRANCH
"\14\00\00\00" ;; 20
"\18\00\00\00" ;; 24
"\18\04\00\00" ;; LIT
"\30\00\00\00" ;; 48
"\cc\02\00\00" ;; -
"\a4\04\00\00" ;; BRANCH
"\34\00\00\00" ;; 52
"\40\00\00\00" ;; 64
"\08\02\00\00" ;; DUP
"\08\02\00\00" ;; DUP
"\18\04\00\00" ;; LIT
"\41\00\00\00" ;; 65
"\38\03\00\00" ;; >=
"\28\02\00\00" ;; SWAP
"\18\04\00\00" ;; LIT
"\5a\00\00\00" ;; 90
"\2c\03\00\00" ;; <=
"\8c\03\00\00" ;; AND
"\b4\04\00\00" ;; 0BRANCH
"\38\00\00\00" ;; 56
"\3c\00\00\00" ;; 60
"\18\04\00\00" ;; LIT
"\2d\00\00\00" ;; 45
"\cc\02\00\00" ;; -
@@ -1400,14 +1401,14 @@
"\08\00\00\00" ;; 8
"\0c\04\00\00" ;; EXIT
"\18\02\00\00" ;; DROP
"\ff\ff\ff\ff" ;; -1
"\34\05\00\00" ;; TRUE
"\0c\04\00\00") ;; EXIT
;; => 0xc4 bytes
;; => 0xc8 bytes
;; : NEGATE INVERT 1+ ;
(data (i32.const 0x0930)
(data (i32.const 0x0934)
"\6c\08\00\00"
"\06NEGATE\00"
"\00\00\00\00"
@@ -1454,8 +1455,8 @@
;; TRUE \ Exit with success
;; ;
(data (i32.const 0x094c)
"\30\09\00\00"
(data (i32.const 0x0950)
"\34\09\00\00"
"\07NUMBER?"
"\00\00\00\00"
"\ac\05\00\00" ;; WORDBUF
@@ -1514,7 +1515,7 @@
"\28\02\00\00" ;; SWAP
"\b4\04\00\00" ;; 0BRANCH
"\08\00\00\00" ;; 8
"\3c\09\00\00" ;; NEGATE
"\40\09\00\00" ;; NEGATE
"\34\05\00\00" ;; TRUE
"\0c\04\00\00") ;; EXIT
@@ -1522,8 +1523,8 @@
;; : , HERE @ ! 4 HERE +! ;
(data (i32.const 0x0a48)
"\4c\09\00\00"
(data (i32.const 0x0a4c)
"\50\09\00\00"
"\01,\00\00"
"\00\00\00\00"
"\84\05\00\00" ;; HERE
@@ -1539,8 +1540,8 @@
;; : IMMEDIATE? 4+ @ 128 AND 0BRANCH [12] TRUE EXIT FALSE ;
(data (i32.const 0x0a74)
"\48\0a\00\00"
(data (i32.const 0x0a78)
"\4c\0a\00\00"
"\0aIMMEDIATE?\00"
"\00\00\00\00"
"\a8\02\00\00" ;; 4+
@@ -1585,8 +1586,8 @@
;; DROP 1 ERROR !
;; ;
(data (i32.const 0x0ab4)
"\74\0a\00\00"
(data (i32.const 0x0ab8)
"\78\0a\00\00"
"\09INTERPRET\00\00"
"\00\00\00\00"
"\74\06\00\00" ;; WORD
@@ -1598,7 +1599,7 @@
"\28\02\00\00" ;; SWAP
"\18\02\00\00" ;; DROP
"\08\02\00\00" ;; DUP
"\84\0a\00\00" ;; IMMEDIATE?
"\88\0a\00\00" ;; IMMEDIATE?
"\b4\03\00\00" ;; INVERT
"\b4\04\00\00" ;; 0BRANCH
"\20\00\00\00" ;; 32
@@ -1607,14 +1608,14 @@
"\b4\04\00\00" ;; 0BRANCH
"\10\00\00\00" ;; 16
"\28\08\00\00" ;; >CFA
"\50\0a\00\00" ;; ,
"\54\0a\00\00" ;; ,
"\0c\04\00\00" ;; EXIT
"\28\08\00\00" ;; >CFA
"\24\04\00\00" ;; >R
"\0c\04\00\00" ;; EXIT
"\18\02\00\00" ;; DROP
"\08\02\00\00" ;; DUP
"\58\09\00\00" ;; NUMBER?
"\5c\09\00\00" ;; NUMBER?
"\b4\04\00\00" ;; 0BRANCH
"\2c\00\00\00" ;; 44
"\28\02\00\00" ;; SWAP
@@ -1623,9 +1624,9 @@
"\cc\03\00\00" ;; @
"\b4\04\00\00" ;; 0BRANCH
"\10\00\00\00" ;; 16
"\18\04\00\00" ;; LIT-CFA
"\50\0a\00\00" ;; ,
"\50\0a\00\00" ;; ,
"\00\05\00\00" ;; LIT-CFA
"\54\0a\00\00" ;; ,
"\54\0a\00\00" ;; ,
"\0c\04\00\00" ;; EXIT
"\18\02\00\00" ;; DROP
"\18\04\00\00" ;; LIT
@@ -1638,13 +1639,13 @@
;; : QUIT R0 RSP! INTERPRET BRANCH [-8] ;
(data (i32.const 0x0b78)
"\b4\0a\00\00"
(data (i32.const 0x0b7c)
"\b8\0a\00\00"
"\04QUIT\00\00\00"
"\00\00\00\00"
"\10\05\00\00" ;; R0
"\50\04\00\00" ;; RSP!
"\c4\0a\00\00" ;; INTERPRET
"\c8\0a\00\00" ;; INTERPRET
"\a4\04\00\00" ;; BRANCH
"\f8\ff\ff\ff" ;; -8
"\0c\04\00\00") ;; EXIT
@@ -1653,7 +1654,7 @@
;; Cold start
(data (i32.const 0x0ba0) "\78\0b\00\00") ;; QUIT
(data (i32.const 0x0ba4) "\88\0b\00\00") ;; QUIT
;; The trampoline is a workaround for WebAssembly's lack of indirect
;; jumps and code addresses. Instead of jumping into the next
@@ -1672,7 +1673,8 @@
end)
(func (export "reset")
i32.const 0x10000 global.set $rsp ;; Set the return stack pointer
i32.const 0xf000 global.set $sp ;; Set the stack pointer
i32.const 0x0ba0 global.set $ip ;; Set the IP to the cold start
i32.const 0x0ba4 global.set $ip ;; Set the IP to the cold start
call $next
call $trampoline))