ref: ca455597fd9acdc4f1b86e1cb62ee294a4c3bde9
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-cell obj: .count c-cell obj: .buflen c-ptr obj: .buf 32 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 this c-string => .buf c-ptr => set-ptr len this 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 -- } this c-string => get-buf ?dup if free abort" c-string free failed" this 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 this --> 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 this --> get-buflen 0= if size allocate abort" out of memory" size this --> set-buf size this --> set-buflen exit endif size this --> get-buflen > if this --> get-buf size resize abort" out of memory" size this --> set-buf endif ; : set { c-addr u 2this -- } u this --> size-buf u this --> set-count c-addr this --> get-buf u move ; : get { 2this -- c-addr u } this --> get-buf this --> get-count ; \ append string to existing one : cat { c-addr u 2this -- } this --> get-count u + dup >r this --> size-buf c-addr this --> get-buf this --> get-count + u move r> this --> set-count ; : type { 2this -- } this --> ?empty if ." (empty) " exit endif this --> .buf --> get-ptr this --> .count --> get type ; : compare ( 2string 2this -- n ) --> get 2swap --> get 2swap compare ; : hashcode ( 2this -- hashcode ) --> get hash ; \ destructor method (overrides object --> free) : free ( 2this -- ) 2dup --> free-buf object => free ; end-class c-string subclass c-hashstring c-2byte obj: .hashcode : set-hashcode { 2this -- } this --> super --> hashcode this --> .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