| 1\ #if (FICL_WANT_OOP)
|
1\ ** ficl/softwords/string.fr 2\ A useful dynamic string class 3\ John Sadler 14 Sep 1998 4\ 5\ ** C - S T R I N G 6\ counted string, buffer sized dynamically 7\ Creation example: 8\ c-string --> new str 9\ s" arf arf!!" str --> set 10\ s" woof woof woof " str --> cat 11\ str --> type cr 12\
| 2\ ** ficl/softwords/string.fr 3\ A useful dynamic string class 4\ John Sadler 14 Sep 1998 5\ 6\ ** C - S T R I N G 7\ counted string, buffer sized dynamically 8\ Creation example: 9\ c-string --> new str 10\ s" arf arf!!" str --> set 11\ s" woof woof woof " str --> cat 12\ str --> type cr 13\
|
13\ $FreeBSD: head/sys/boot/ficl/softwords/string.fr 61177 2000-06-02 13:49:09Z dcs $
| 14\ $FreeBSD: head/sys/boot/ficl/softwords/string.fr 76116 2001-04-29 02:36:36Z dcs $
|
14
| 15
|
15.( loading ficl string class ) cr
| |
16also oop definitions 17 18object subclass c-string
| 16also oop definitions 17 18object subclass c-string
|
19 c-4byte obj: .count 20 c-4byte obj: .buflen 21 c-ptr obj: .buf 22 64 constant min-buf
| 19 c-cell obj: .count 20 c-cell obj: .buflen 21 c-ptr obj: .buf 22 32 constant min-buf
|
23
| 23
|
24 : get-count ( 2this -- count ) c-string => .count c-4byte => get ; 25 : set-count ( count 2this -- ) c-string => .count c-4byte => set ;
| 24 : get-count ( 2:this -- count ) my=[ .count get ] ; 25 : set-count ( count 2:this -- ) my=[ .count set ] ;
|
26
| 26
|
27 : ?empty ( 2this -- flag ) --> get-count 0= ;
| 27 : ?empty ( 2:this -- flag ) --> get-count 0= ;
|
28
| 28
|
29 : get-buflen ( 2this -- len ) c-string => .buflen c-4byte => get ; 30 : set-buflen ( len 2this -- ) c-string => .buflen c-4byte => set ;
| 29 : get-buflen ( 2:this -- len ) my=[ .buflen get ] ; 30 : set-buflen ( len 2:this -- ) my=[ .buflen set ] ;
|
31
| 31
|
32 : get-buf ( 2this -- ptr ) c-string => .buf c-ptr => get-ptr ; 33 : set-buf { ptr len 2this -- } 34 ptr 2this c-string => .buf c-ptr => set-ptr 35 len 2this c-string => set-buflen
| 32 : get-buf ( 2:this -- ptr ) my=[ .buf get-ptr ] ; 33 : set-buf { ptr len 2:this -- } 34 ptr this my=[ .buf set-ptr ] 35 len this my=> set-buflen
|
36 ; 37 38 \ set buffer to null and buflen to zero
| 36 ; 37 38 \ set buffer to null and buflen to zero
|
39 : clr-buf ( 2this -- ) 40 0 0 2over c-string => set-buf 41 0 -rot c-string => set-count
| 39 : clr-buf ( 2:this -- ) 40 0 0 2over my=> set-buf 41 0 -rot my=> set-count
|
42 ; 43 44 \ free the buffer if there is one, set buf pointer to null
| 42 ; 43 44 \ free the buffer if there is one, set buf pointer to null
|
45 : free-buf { 2this -- } 46 2this c-string => get-buf 47 ?dup if 48 free 49 abort" c-string free failed" 50 2this c-string => clr-buf
| 45 : free-buf { 2:this -- } 46 this my=> get-buf 47 ?dup if 48 free 49 abort" c-string free failed" 50 this my=> clr-buf
|
51 endif 52 ; 53 54 \ guarantee buffer is large enough to hold size chars
| 51 endif 52 ; 53 54 \ guarantee buffer is large enough to hold size chars
|
55 : size-buf { size 2this -- }
| 55 : size-buf { size 2:this -- }
|
56 size 0< abort" need positive size for size-buf"
| 56 size 0< abort" need positive size for size-buf"
|
57 size 0= if 58 2this --> free-buf exit
| 57 size 0= if 58 this --> free-buf exit
|
59 endif 60 61 \ force buflen to be a positive multiple of min-buf chars
| 59 endif 60 61 \ force buflen to be a positive multiple of min-buf chars
|
62 c-string => min-buf size over / 1+ * chars to size
| 62 my=> min-buf size over / 1+ * chars to size
|
63 64 \ if buffer is null, allocate one, else resize it
| 63 64 \ if buffer is null, allocate one, else resize it
|
65 2this --> get-buflen 0=
| 65 this --> get-buflen 0=
|
66 if
| 66 if
|
67 size allocate
| 67 size allocate
|
68 abort" out of memory"
| 68 abort" out of memory"
|
69 size 2this --> set-buf 70 size 2this --> set-buflen
| 69 size this --> set-buf 70 size this --> set-buflen
|
71 exit 72 endif 73
| 71 exit 72 endif 73
|
74 size 2this --> get-buflen > if 75 2this --> get-buf size resize
| 74 size this --> get-buflen > if 75 this --> get-buf size resize
|
76 abort" out of memory"
| 76 abort" out of memory"
|
77 size 2this --> set-buf
| 77 size this --> set-buf
|
78 endif 79 ; 80
| 78 endif 79 ; 80
|
81 : set { c-addr u 2this -- } 82 u 2this --> size-buf 83 u 2this --> set-count 84 c-addr 2this --> get-buf u move
| 81 : set { c-addr u 2:this -- } 82 u this --> size-buf 83 u this --> set-count 84 c-addr this --> get-buf u move
|
85 ; 86
| 85 ; 86
|
87 : get { 2this -- c-addr u } 88 2this --> get-buf 89 2this --> get-count
| 87 : get { 2:this -- c-addr u } 88 this --> get-buf 89 this --> get-count
|
90 ; 91 92 \ append string to existing one
| 90 ; 91 92 \ append string to existing one
|
93 : cat { c-addr u 2this -- } 94 2this --> get-count u + dup >r 95 2this --> size-buf 96 c-addr 2this --> get-buf 2this --> get-count + u move 97 r> 2this --> set-count
| 93 : cat { c-addr u 2:this -- } 94 this --> get-count u + dup >r 95 this --> size-buf 96 c-addr this --> get-buf this --> get-count + u move 97 r> this --> set-count
|
98 ; 99
| 98 ; 99
|
100 : type { 2this -- } 101 2this --> ?empty if ." (empty) " exit endif 102 2this --> .buf --> get-ptr 103 2this --> .count --> get 104 type
| 100 : type { 2:this -- } 101 this --> ?empty if ." (empty) " exit endif 102 this --> .buf --> get-ptr 103 this --> .count --> get 104 type
|
105 ; 106
| 105 ; 106
|
107 : compare ( 2string 2this -- n ) 108 c-string => get 109 2swap 110 c-string => get
| 107 : compare ( 2string 2:this -- n ) 108 --> get 109 2swap 110 --> get
|
111 2swap compare 112 ; 113
| 111 2swap compare 112 ; 113
|
114 : hashcode ( 2this -- hashcode ) 115 c-string => get hash
| 114 : hashcode ( 2:this -- hashcode ) 115 --> get hash
|
116 ; 117
| 116 ; 117
|
118 \ destructor method (overrides object --> free) 119 : free ( 2this -- ) 2dup c-string => free-buf object => free ;
| 118 \ destructor method (overrides object --> free) 119 : free ( 2:this -- ) 2dup --> free-buf object => free ;
|
120 121end-class 122 123c-string subclass c-hashstring 124 c-2byte obj: .hashcode 125
| 120 121end-class 122 123c-string subclass c-hashstring 124 c-2byte obj: .hashcode 125
|
126 : set-hashcode { 2this -- } 127 2this --> super --> hashcode 128 2this --> .hashcode --> set
| 126 : set-hashcode { 2:this -- } 127 this --> super --> hashcode 128 this --> .hashcode --> set
|
129 ; 130
| 129 ; 130
|
131 : get-hashcode ( 2this -- hashcode )
| 131 : get-hashcode ( 2:this -- hashcode )
|
132 --> .hashcode --> get 133 ; 134
| 132 --> .hashcode --> get 133 ; 134
|
135 : set ( c-addr u 2this -- )
| 135 : set ( c-addr u 2:this -- )
|
136 2swap 2over --> super --> set 137 --> set-hashcode 138 ; 139
| 136 2swap 2over --> super --> set 137 --> set-hashcode 138 ; 139
|
140 : cat ( c-addr u 2this -- )
| 140 : cat ( c-addr u 2:this -- )
|
141 2swap 2over --> super --> cat 142 --> set-hashcode 143 ; 144 145end-class 146 147previous definitions
| 141 2swap 2over --> super --> cat 142 --> set-hashcode 143 ; 144 145end-class 146 147previous definitions
|
148
| 148\ #endif
|
| |