Add source code comments for colon words
This commit is contained in:
155
wipforth.wat
155
wipforth.wat
@@ -1089,6 +1089,161 @@
|
||||
"\02\00\00\00"
|
||||
"\00\00\00\00")
|
||||
|
||||
;; And now, it's time for some hand-compiled colon words. It
|
||||
;; probably would have made more sense to write most of these
|
||||
;; directly in WAT, but I think this is way cooler.
|
||||
|
||||
;; : TUCK DUP -ROT ;
|
||||
|
||||
;; : SPACE? ( byte -- bool )
|
||||
;; DUP 9 = SWAP \ Compare to horizontal tab
|
||||
;; DUP 10 = SWAP \ Compare to line-feed
|
||||
;; DUP 13 = SWAP \ Compare to carriage return
|
||||
;; 32 = \ Compare to space
|
||||
;; OR OR OR \ Or all results together
|
||||
;; ;
|
||||
|
||||
;; : WORD ( -- len )
|
||||
;; 0 \ Initial length
|
||||
;;
|
||||
;; KEY \ Get byte from input
|
||||
;; TUCK SPACE? 0BRANCH [56] \ 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
|
||||
;;
|
||||
;; \ Byte is whitespace
|
||||
;; SWAP DROP
|
||||
;; DUP 0<> 0BRANCH [-92] \ Loop back to KEY if zero length
|
||||
;; ;
|
||||
|
||||
;; : STRING= ( len str1 str2 -- bool )
|
||||
;; 2DUP C@ SWAP C@ \ Load a byte from each address
|
||||
;; = 0BRANCH [48] \ Check for byte mismatch
|
||||
;; 1+ -ROT 1+ -ROT 1- \ Increment addresses, decrement length
|
||||
;; DUP 0BRANCH [32] \ Check for zero remaining bytes
|
||||
;; -ROT BRANCH [-68] \ Loop
|
||||
;;
|
||||
;; 2DROP DROP FALSE EXIT \ Strings not equal
|
||||
;; 2DROP DROP TRUE \ Strings equal
|
||||
;; ;
|
||||
|
||||
;; : NAME-LEN 4+ C@ 31 AND ;
|
||||
|
||||
;; : FIND ( len -- entry )
|
||||
;; LATEST @ \ Initial entry
|
||||
;;
|
||||
;; TUCK NAME-LEN \ Get name length
|
||||
;; OVER <> 0BRANCH [48] \ Check for length mismatch
|
||||
;; OVER 5 + \ Get name address
|
||||
;; OVER SWAP WORDBUF STRING= \ Check if name matches
|
||||
;; 0BRANCH [12]
|
||||
;; DROP EXIT
|
||||
;;
|
||||
;; \ Name doesn't match
|
||||
;; OVER @ 0= 0BRANCH [12] \ Check for nil link
|
||||
;; DROP EXIT
|
||||
;; SWAP @ BRANCH [-108] \ Follow link and loop
|
||||
;; ;
|
||||
|
||||
;; : >CFA ( entry -- cfa )
|
||||
;; 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
|
||||
;; ;
|
||||
|
||||
;; : DIGIT ( byte -- value )
|
||||
;; DUP DUP 48 >= SWAP 57 <= AND \ Test if 0-9
|
||||
;; 0BRANCH [20] \ Jump to A-Z test if not
|
||||
;; 48 - \ Get digit value
|
||||
;; BRANCH [52] \ Go to range check
|
||||
;;
|
||||
;; DUP DUP 65 >= SWAP 90 <= AND \ Test if A-Z
|
||||
;; 0BRANCH [56] \ 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
|
||||
;; ;
|
||||
|
||||
;; : NEGATE INVERT 1+ ;
|
||||
|
||||
;; : NUMBER? ( len -- value TRUE | FALSE )
|
||||
;; WORDBUF \ Initial address
|
||||
;;
|
||||
;; C@ 45 = 0BRANCH [56] \ Check for minus sign
|
||||
;; SWAP 1- \ Decrement length
|
||||
;; DUP 0BRANCH [24] \ Check if any characters remain
|
||||
;; TRUE -ROT \ Set negate flag true
|
||||
;; SWAP BRANCH [24] \ Jump to setting initial value
|
||||
;;
|
||||
;; \ No characters after minus, exit with failure
|
||||
;; 2DROP FALSE EXIT
|
||||
;;
|
||||
;; \ No leading minus, set negate flag false
|
||||
;; FALSE -ROT
|
||||
;;
|
||||
;; \ Set initial value
|
||||
;; 0
|
||||
;;
|
||||
;; \ Main loop
|
||||
;; OVER C@ DIGIT \ Get byte's digit value
|
||||
;; DUP 0>= 0BRANCH [68] \ Check if digit valid
|
||||
;;
|
||||
;; SWAP BASE @ * + \ Incorporate digit
|
||||
;; SWAP 1+ \ Increment address
|
||||
;; ROT 1- \ Decrement length
|
||||
;; DUP 0BRANCH [40] \ Go to end if length zero
|
||||
;; -ROT SWAP BRANCH [-88] \ Loop if characters remain
|
||||
;;
|
||||
;; \ Invalid digit
|
||||
;; 2DROP 2DROP DROP FALSE EXIT \ Exit with failure
|
||||
;;
|
||||
;; \ Reached end of word
|
||||
;; 2DROP \ Discard pointer and length
|
||||
;; SWAP 0BRANCH [8] NEGATE \ Negate if -ve flag set
|
||||
;; TRUE \ Exit with success
|
||||
;; ;
|
||||
|
||||
;; : , HERE @ ! 4 HERE +! ;
|
||||
|
||||
;; : IMMEDIATE? 4+ @ 128 AND 0BRANCH [12] TRUE EXIT FALSE ;
|
||||
|
||||
;; : INTERPRET
|
||||
;; WORD \ Read a word
|
||||
;; DUP FIND \ Look it up
|
||||
;; DUP 0BRANCH [72] \ Branch to number handling if not found
|
||||
;; SWAP DROP \ Discard word length
|
||||
;;
|
||||
;; \ Handle word
|
||||
;; DUP IMMEDIATE? \ Check if the word is immediate
|
||||
;; INVERT 0BRANCH [32] \ Jump straight to executing if so
|
||||
;; STATE @ 0BRANCH [16] \ Check state
|
||||
;; >CFA , EXIT \ Compile word
|
||||
;; >CFA >R EXIT \ Execute word
|
||||
;;
|
||||
;; \ Handle number
|
||||
;; DROP \ Discard nil entry
|
||||
;; DUP NUMBER? 0BRANCH [44] \ Convert to number
|
||||
;; SWAP DROP \ Discard word length
|
||||
;; STATE @ 0BRANCH [16] \ Check state
|
||||
;; LIT-CFA , , \ If compiling, append LIT and the value
|
||||
;; EXIT
|
||||
;;
|
||||
;; \ Word was not found and also not a number. Ideally we'd print the
|
||||
;; \ word that wasn't found here but I haven't implemented such things
|
||||
;; \ yet so for now we'll just discard the word's length, set ERROR to
|
||||
;; \ 1 and exit.
|
||||
;; DROP 1 ERROR !
|
||||
;; ;
|
||||
|
||||
;; : QUIT R0 RSP! INTERPRET BRANCH [-8] ;
|
||||
|
||||
;; The trampoline is a workaround for WebAssembly's lack of indirect
|
||||
;; jumps and code addresses. Instead of jumping into the next
|
||||
;; codeword, NEXT sets the $fn global to the function index of the
|
||||
|
||||
Reference in New Issue
Block a user