initial commit
[freebsd-arm:freebsd-arm.git] / boot / ficl / softwords / string.fr
1 \ #if (FICL_WANT_OOP)
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 \
14 \ $FreeBSD$
15
16 also oop definitions
17
18 object subclass c-string
19     c-cell obj: .count
20     c-cell obj: .buflen
21     c-ptr  obj: .buf
22     32 constant min-buf
23
24     : get-count   ( 2:this -- count )  my=[ .count  get ] ;
25     : set-count   ( count 2:this -- )  my=[ .count  set ] ;
26
27     : ?empty   ( 2:this -- flag )  --> get-count 0= ;
28
29     : get-buflen   ( 2:this -- len )  my=[ .buflen  get ] ;
30     : set-buflen   ( len 2:this -- )  my=[ .buflen  set ] ;
31
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
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
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
55     : size-buf  { size 2:this -- }
56         size 0< abort" need positive size for size-buf"
57         size 0= if 
58             this --> free-buf exit
59         endif
60
61         \ force buflen to be a positive multiple of min-buf chars
62         my=> min-buf size over / 1+ * chars to size
63
64         \ if buffer is null, allocate one, else resize it
65         this --> get-buflen  0= 
66         if
67             size allocate 
68             abort" out of memory"
69             size this --> set-buf
70             size this --> set-buflen
71             exit
72         endif
73
74         size this --> get-buflen > if
75             this --> get-buf size resize
76             abort" out of memory"
77             size this --> set-buf
78         endif
79     ;
80
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
87     : get   { 2:this -- c-addr u }
88         this --> get-buf
89         this --> get-count
90     ;
91
92     \ append string to existing one
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
100     : type   { 2:this -- }
101             this --> ?empty if ." (empty) " exit endif
102         this --> .buf --> get-ptr 
103         this --> .count --> get 
104         type  
105     ;
106
107     : compare   ( 2string 2:this -- n )
108         --> get 
109         2swap 
110         --> get 
111         2swap compare
112     ;
113
114     : hashcode   ( 2:this -- hashcode )
115         --> get  hash
116     ;
117
118     \ destructor method (overrides object --> free) 
119     : free   ( 2:this -- )  2dup --> free-buf  object => free ;
120
121 end-class
122
123 c-string subclass c-hashstring
124     c-2byte obj: .hashcode
125
126     : set-hashcode   { 2:this -- }
127         this  --> super --> hashcode 
128         this  --> .hashcode --> set
129     ;
130
131     : get-hashcode   ( 2:this -- hashcode )
132         --> .hashcode --> get
133     ;
134
135     : set   ( c-addr u 2:this -- )
136         2swap 2over --> super --> set
137         --> set-hashcode
138     ;
139
140     : cat   ( c-addr u 2:this -- )
141         2swap 2over --> super --> cat
142         --> set-hashcode
143     ;
144
145 end-class
146
147 previous definitions
148 \ #endif