Commit | Line | Data |
---|---|---|
8e9db35f PB |
1 | \ @(#) strings.fth 98/01/26 1.2 |
2 | \ String support for PForth | |
3 | \ | |
4 | \ Copyright Phil Burk 1994 | |
5 | ||
6 | ANEW TASK-STRINGS.FTH | |
7 | ||
8 | : -TRAILING ( c-addr u1 -- c-addr u2 , strip trailing blanks ) | |
9 | dup 0> | |
10 | IF | |
11 | BEGIN | |
12 | 2dup 1- chars + c@ bl = | |
13 | over 0> and | |
14 | WHILE | |
15 | 1- | |
16 | REPEAT | |
17 | THEN | |
18 | ; | |
19 | ||
20 | \ Structure of string table | |
21 | : $ARRAY ( ) | |
22 | CREATE ( #strings #chars_max -- ) | |
23 | dup , | |
24 | 2+ * even-up allot | |
25 | DOES> ( index -- $addr ) | |
26 | dup @ ( get #chars ) | |
27 | rot * + cell+ | |
28 | ; | |
29 | ||
30 | \ Compare two strings | |
31 | : $= ( $1 $2 -- flag , true if equal ) | |
32 | -1 -rot | |
33 | dup c@ 1+ 0 | |
34 | DO dup c@ tolower | |
35 | 2 pick c@ tolower - | |
36 | IF rot drop 0 -rot LEAVE | |
37 | THEN | |
38 | 1+ swap 1+ swap | |
39 | LOOP 2drop | |
40 | ; | |
41 | ||
42 | : TEXT= ( addr1 addr2 count -- flag ) | |
43 | >r -1 -rot | |
44 | r> 0 | |
45 | ?DO dup c@ tolower | |
46 | 2 pick c@ tolower - | |
47 | IF rot drop 0 -rot LEAVE | |
48 | THEN | |
49 | 1+ swap 1+ swap | |
50 | LOOP 2drop | |
51 | ; | |
52 | ||
53 | : TEXT=? ( addr1 count addr2 -- flag , for JForth compatibility ) | |
54 | swap text= | |
55 | ; | |
56 | ||
57 | : $MATCH? ( $string1 $string2 -- flag , case INsensitive ) | |
58 | dup c@ 1+ text= | |
59 | ; | |
60 | ||
61 | ||
62 | : INDEX ( $string char -- false | address_char true , search for char in string ) | |
63 | >r >r 0 r> r> | |
64 | over c@ 1+ 1 | |
65 | DO over i + c@ over = | |
66 | IF rot drop | |
67 | over i + rot rot LEAVE | |
68 | THEN | |
69 | LOOP 2drop | |
70 | ?dup 0= 0= | |
71 | ; | |
72 | ||
73 | ||
74 | : $APPEND.CHAR ( $string char -- ) \ ugly stack diagram | |
75 | over count chars + c! | |
76 | dup c@ 1+ swap c! | |
77 | ; | |
78 | ||
79 | \ ---------------------------------------------- | |
80 | : ($ROM) ( index address -- $string ) | |
81 | ( -- index address ) | |
82 | swap 0 | |
83 | ?DO dup c@ 1+ + aligned | |
84 | LOOP | |
85 | ; | |
86 | ||
87 | : $ROM ( packed array of strings, unalterable ) | |
88 | CREATE ( <name> -- ) | |
89 | DOES> ( index -- $string ) ($rom) | |
90 | ; | |
91 | ||
92 | : TEXTROM ( packed array of strings, unalterable ) | |
93 | CREATE ( <name> -- ) | |
94 | DOES> ( index -- address count ) ($rom) count | |
95 | ; | |
96 | ||
97 | \ ----------------------------------------------- |