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