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
|
\ 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 !
;
|
