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