1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
\ tag: misc useful functions
\
\ Misc useful functions
\
\ Copyright (C) 2003 Samuel Rydh
\
\ See the file "COPYING" for further information about
\ the copyright and warranty status of this work.
\
\ compare c-string with (str len) pair
: comp0 ( cstr str len -- 0|-1|1 )
3dup
comp ?dup if >r 3drop r> exit then
nip + c@ 0<> if 1 else 0 then
;
\ returns 0 if the strings match
: strcmp ( str1 len1 str2 len2 -- 0|1 )
rot over <> if 3drop 1 exit then
comp if 1 else 0 then
;
: strchr ( str len char -- where|0 )
>r
begin
1- dup 0>=
while
( str len )
over c@ r@ = if r> 2drop exit then
swap 1+ swap
repeat
r> 3drop 0
;
: cstrlen ( cstr -- len )
dup
begin dup c@ while 1+ repeat
swap -
;
: strdup ( str len -- newstr len )
dup if
dup >r
dup alloc-mem dup >r swap move
r> r>
else
2drop 0 0
then
;
: dict-strdup ( str len -- dict-addr len )
dup here swap allot null-align
swap 2dup >r >r move r> r>
;
\ -----------------------------------------------------
\ string copy and cat variants
\ -----------------------------------------------------
: tmpstrcat ( addr2 len2 addr1 len1 tmpbuf -- buf len1+len2 tmpbuf+l1+l2 )
\ save return arguments
dup 2 pick + 4 pick + >r ( R: buf+l1+l2 )
over 4 pick + >r
dup >r
\ copy...
2dup + >r
swap move r> swap move
r> r> r>
;
: tmpstrcpy ( addr1 len1 tmpbuf -- tmpbuf len1 tmpbuf+len1 )
swap 2dup >r >r move
r> r> 2dup +
;
\ -----------------------------------------------------
\ number to string conversion
\ -----------------------------------------------------
: numtostr ( num buf -- buf len )
swap rdepth -rot
( rdepth buf num )
begin
base @ u/mod swap
\ dup 0< if base @ + then
dup a < if ascii 0 else ascii a a - then + >r
?dup 0=
until
rdepth rot - 0
( buf len cnt )
begin
r> over 4 pick + c!
1+ 2dup <=
until
drop
;
: tohexstr ( num buf -- buf len )
base @ hex -rot numtostr rot base !
;
: toudecstr ( num buf -- buf len )
base @ decimal -rot numtostr rot base !
;
: todecstr ( num buf -- buf len )
over 0< if
swap negate over ascii - over c! 1+
( buf num buf+1 )
toudecstr 1+ nip
else
toudecstr
then
;
\ -----------------------------------------------------
\ string to number conversion
\ -----------------------------------------------------
: parse-hex ( str len -- value )
base @ hex -rot $number if 0 then swap base !
;
\ -----------------------------------------------------
\ miscellaneous functions
\ -----------------------------------------------------
: rot13 ( c - c )
dup upc [char] A [char] M between if d# 13 + exit then
dup upc [char] N [char] Z between if d# 13 - then
;
: rot13-str ( str len -- newstr len )
strdup 2dup bounds ?do i c@ rot13 i c! loop
;
|
