X-Git-Url: http://git.subgeniuskitty.com/pforth/.git/blobdiff_plain/40c6f87ff261cacf78377241c8746da1aaa504c5..6cc29c22fa1c83422b1727dba5a0c5ad2f87cf99:/fth/system.fth?ds=inline

diff --git a/fth/system.fth b/fth/system.fth
index b74c812..71b778e 100644
--- a/fth/system.fth
+++ b/fth/system.fth
@@ -596,6 +596,29 @@ ustack 0stackp
         char [compile] literal
 ; immediate
 
+: TOUPPER ( char -- char' )
+	dup [char] a >=
+	IF
+		dup [char] z <= IF [ char A char a - ] literal + THEN
+	THEN
+;
+
+: UPCASE ( c-addr u -- )
+	over + swap ?do
+		i c@ toupper i c!
+	loop
+;
+
+create WORD-SAVE-AREA 257 allot
+
+\ This version performs case-conversion for backward compatibility.
+: WORD ( char -- addr )
+	parse-word
+	word-save-area place
+	word-save-area count upcase
+	word-save-area
+;
+
 : $TYPE  ( $string -- )
         count type
 ;