Return to string.fs CVS log

Up to [Qemu by Fabrice Bellard] / qemu / roms / openbios / forth / lib

Annotation of qemu/roms/openbios/forth/lib/string.fs, revision 1.1.1.1

1.1       root        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: ;

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.