1 \ tag: misc useful functions
3 \ Misc useful functions
5 \ Copyright (C) 2003 Samuel Rydh
7 \ See the file "COPYING" for further information about
8 \ the copyright and warranty status of this work.
11 \ compare c-string with (str len) pair
12 : comp0 ( cstr str len -- 0|-1|1 )
14 comp ?dup if >r 3drop r> exit then
15 nip + c@ 0<> if 1 else 0 then
18 \ returns 0 if the strings match
19 : strcmp ( str1 len1 str2 len2 -- 0|1 )
20 rot over <> if 3drop 1 exit then
24 : strchr ( str len char -- where|0 )
30 over c@ r@ = if r> 2drop exit then
36 : cstrlen ( cstr -- len )
38 begin dup c@ while 1+ repeat
42 : strdup ( str len -- newstr len )
45 dup alloc-mem dup >r swap move
52 : dict-strdup ( str len -- dict-addr len )
53 dup here swap allot null-align
54 swap 2dup >r >r move r> r>
57 \ -----------------------------------------------------
58 \ string copy and cat variants
59 \ -----------------------------------------------------
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 )
68 swap move r> swap move
72 : tmpstrcpy ( addr1 len1 tmpbuf -- tmpbuf len1 tmpbuf+len1 )
79 \ -----------------------------------------------------
80 \ number to string conversion
81 \ -----------------------------------------------------
83 : numtostr ( num buf -- buf len )
88 \ dup 0< if base @ + then
89 dup a < if ascii 0 else ascii a a - then + >r
102 : tohexstr ( num buf -- buf len )
103 base @ hex -rot numtostr rot base !
106 : toudecstr ( num buf -- buf len )
107 base @ decimal -rot numtostr rot base !
110 : todecstr ( num buf -- buf len )
112 swap negate over ascii - over c! 1+
121 \ -----------------------------------------------------
122 \ string to number conversion
123 \ -----------------------------------------------------
125 : parse-hex ( str len -- value )
126 base @ hex -rot $number if 0 then swap base !
130 \ -----------------------------------------------------
131 \ miscellaneous functions
132 \ -----------------------------------------------------
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
139 : rot13-str ( str len -- newstr len )
140 strdup 2dup bounds ?do i c@ rot13 i c! loop