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