blob: dabb3900892feb06b2887bd97901a5fb0859e7af (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
\ #if (FICL_WANT_OOP)
\ ** 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$
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 ( 2:this -- count ) my=[ .count get ] ;
: set-count ( count 2:this -- ) my=[ .count set ] ;
: ?empty ( 2:this -- flag ) --> get-count 0= ;
: get-buflen ( 2:this -- len ) my=[ .buflen get ] ;
: set-buflen ( len 2:this -- ) my=[ .buflen set ] ;
: get-buf ( 2:this -- ptr ) my=[ .buf get-ptr ] ;
: set-buf { ptr len 2:this -- }
ptr this my=[ .buf set-ptr ]
len this my=> set-buflen
;
\ set buffer to null and buflen to zero
: clr-buf ( 2:this -- )
0 0 2over my=> set-buf
0 -rot my=> set-count
;
\ free the buffer if there is one, set buf pointer to null
: free-buf { 2:this -- }
this my=> get-buf
?dup if
free
abort" c-string free failed"
this my=> clr-buf
endif
;
\ guarantee buffer is large enough to hold size chars
: size-buf { size 2:this -- }
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
my=> 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 2:this -- }
u this --> size-buf
u this --> set-count
c-addr this --> get-buf u move
;
: get { 2:this -- c-addr u }
this --> get-buf
this --> get-count
;
\ append string to existing one
: cat { c-addr u 2:this -- }
this --> get-count u + dup >r
this --> size-buf
c-addr this --> get-buf this --> get-count + u move
r> this --> set-count
;
: type { 2:this -- }
this --> ?empty if ." (empty) " exit endif
this --> .buf --> get-ptr
this --> .count --> get
type
;
: compare ( 2string 2:this -- n )
--> get
2swap
--> get
2swap compare
;
: hashcode ( 2:this -- hashcode )
--> get hash
;
\ destructor method (overrides object --> free)
: free ( 2:this -- ) 2dup --> free-buf object => free ;
end-class
c-string subclass c-hashstring
c-2byte obj: .hashcode
: set-hashcode { 2:this -- }
this --> super --> hashcode
this --> .hashcode --> set
;
: get-hashcode ( 2:this -- hashcode )
--> .hashcode --> get
;
: set ( c-addr u 2:this -- )
2swap 2over --> super --> set
--> set-hashcode
;
: cat ( c-addr u 2:this -- )
2swap 2over --> super --> cat
--> set-hashcode
;
end-class
previous definitions
\ #endif
|
