From 6cc29c22fa1c83422b1727dba5a0c5ad2f87cf99 Mon Sep 17 00:00:00 2001
From: Helmut Eller <eller.helmut@gmail.com>
Date: Wed, 21 Dec 2016 11:14:31 +0100
Subject: [PATCH] Define backward compatible version of WORD

* fth/system.fth (TOUPPER, UPCASE): New helpers.
(WORD, WORD-SAVE-AREA): New.
---
 fth/system.fth | 23 +++++++++++++++++++++++
 1 file changed, 23 insertions(+)

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
 ;
-- 
2.20.1