qemu/roms/openbios/forth/lib/string.fs

   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 ;