149 lines
3.7 KiB
Forth
149 lines
3.7 KiB
Forth
\ ** 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
|
|
\
|
|
\ $FreeBSD$
|
|
|
|
.( 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
|
|
|