ref: 778af2c25383b3571a79951e4ada36b15d4c0ff8
dir: /softwords/string.fr/
\ ** ficl/softwords/string.fr \ A useful dynamic string class \ John Sadler 14 Sep 1998 \ \ ** C - S T R I N G \ counted string, buffer sized dynamically \ Creation example: \ c-string --> new str \ s" arf arf!!" str --> set \ s" woof woof woof " str --> cat \ str --> type cr \ .( loading ficl string class ) cr also oop definitions object subclass c-string c-4byte obj: .count c-4byte obj: .buflen c-ptr obj: .buf 64 constant min-buf : get-count ( 2this -- count ) c-string => .count c-4byte => get ; : set-count ( count 2this -- ) c-string => .count c-4byte => set ; : ?empty ( 2this -- flag ) --> get-count 0= ; : get-buflen ( 2this -- len ) c-string => .buflen c-4byte => get ; : set-buflen ( len 2this -- ) c-string => .buflen c-4byte => set ; : get-buf ( 2this -- ptr ) c-string => .buf c-ptr => get-ptr ; : set-buf { ptr len 2this -- } ptr 2this c-string => .buf c-ptr => set-ptr len 2this c-string => set-buflen ; \ set buffer to null and buflen to zero : clr-buf ( 2this -- ) 0 0 2over c-string => set-buf 0 -rot c-string => set-count ; \ free the buffer if there is one, set buf pointer to null : free-buf { 2this -- } 2this c-string => get-buf ?dup if free abort" c-string free failed" 2this c-string => clr-buf endif ; \ guarantee buffer is large enough to hold size chars : size-buf { size 2this -- } size 0< abort" need positive size for size-buf" size 0= if 2this --> free-buf exit endif \ force buflen to be a positive multiple of min-buf chars c-string => min-buf size over / 1+ * chars to size \ if buffer is null, allocate one, else resize it 2this --> get-buflen 0= if size allocate abort" out of memory" size 2this --> set-buf size 2this --> set-buflen exit endif size 2this --> get-buflen > if 2this --> get-buf size resize abort" out of memory" size 2this --> set-buf endif ; : set { c-addr u 2this -- } u 2this --> size-buf u 2this --> set-count c-addr 2this --> get-buf u move ; : get { 2this -- c-addr u } 2this --> get-buf 2this --> get-count ; \ append string to existing one : cat { c-addr u 2this -- } 2this --> get-count u + dup >r 2this --> size-buf c-addr 2this --> get-buf 2this --> get-count + u move r> 2this --> set-count ; : type { 2this -- } 2this --> ?empty if ." (empty) " exit endif 2this --> .buf --> get-ptr 2this --> .count --> get type ; : compare ( 2string 2this -- n ) c-string => get 2swap c-string => get 2swap compare ; : hashcode ( 2this -- hashcode ) c-string => get hash ; \ destructor method (overrides object --> free) : free ( 2this -- ) 2dup c-string => free-buf object => free ; end-class c-string subclass c-hashstring c-2byte obj: .hashcode : set-hashcode { 2this -- } 2this --> super --> hashcode 2this --> .hashcode --> set ; : get-hashcode ( 2this -- hashcode ) --> .hashcode --> get ; : set ( c-addr u 2this -- ) 2swap 2over --> super --> set --> set-hashcode ; : cat ( c-addr u 2this -- ) 2swap 2over --> super --> cat --> set-hashcode ; end-class previous definitions