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     ! 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.