1 - Forth Interest Group

: UP-STRING (au--)
0 DO DUP C@ UP-CHAR OVER C! CHAR+ LOOP DROP
SEE UP-STRING CR
The third time the file is included:
ANEW Up-Char-Test-Run
1 Up-Char-Test +! CR . ( Test# ) Up-Char-Test CR
CREATE upper-case-map
256 CHARS ALLOT
( Initialize the map to change characters into themselves. )
:: 256 0 DO I upper-case-map I CHARS + C! LOOP ;;
( Replace the lower-case letters with upper-case. )
:: [ CHAR] a 26 BOUNDS DO
I BL XOR upper-case-map I CHARS + C! LOOP
. . , ,
( Convert to upper-case by 'addr + C@' inline. )
: UP-CHAR S" CHARS upper-case-map + C@ " EVALUATE ; IMMEDIATE
: DOWN-CHAR BL XOR UP-CHAR BL XOR ;
( Convert string to upper-case. )
: UP-STRING (au--1
0 DO DUP C@ UP-CHAR OVER C! CHAR+ LOOP DROP
SEE UP-STRING CR
Source Listing
1 LACKING Up-Char-Test VARIABLE Up-Char-Test 0 Up-Char-Test !
3 ANEW Up-Char-Test-Run
/ 5 1 Up-Char-Test +! CR . ( Test# ) Up-Char-Test CR
I
I
7 Up-Char-Test @ 1 = [ IF]
: BETWEEN 1+ WITHIN ; ( x min max -- flag )
11 : UP-CHAR ( c -- C ) DUP [ CHAR] a &CHAR] z BETWEEN BL AND XOR ;
13 SEE WITHIN SEE BETWEEN SEE UP-CHAR
1 15 [ ELSE]
I
17 Up-Char-Test @ 2 = [ IF]
I
19 ( Eliminate nesting UP-CHAR BETWEEN WITHIN )
2 0 : UP-CHAR (c--C)
2 1 S" DUP [ CHAR] a - 26 U< BL AND XOR " EVALUATE
22 ; IMMEDIATE
Continued on page 27 /
Forth Dimensions XlWl 29