54 lines
1.5 KiB
Forth
Executable File
54 lines
1.5 KiB
Forth
Executable File
\ heapstr.fs -- Manage character strings in heap memory
|
|
\ 2016 David Meyer <papa@sdf.org> +JMJ
|
|
|
|
: c$type ( c-str -- ) count type ;
|
|
|
|
: $alloc ( a-str u -- c-heap )
|
|
\g Allocate heap space for counted version of string A-STR,U
|
|
dup 1+ chars allocate if ( a-str u c-heap)
|
|
>r 2drop r> -1 \ Returns string length -1 for alloc. error
|
|
else
|
|
2dup c! dup >r 1 chars + swap cmove r>
|
|
then
|
|
;
|
|
|
|
: c$alloc ( c-str -- c-heap )
|
|
\g Allocate heap space for counted string for C-STR
|
|
count dup 1+ chars allocate if ( a-str u c-heap)
|
|
>r 2drop r> 0 \ Returns 0 c-pointer for alloc. error
|
|
else
|
|
2dup c!
|
|
dup >r 1 chars + swap cmove r>
|
|
then
|
|
;
|
|
|
|
: $catcpy { a-str1 u1 a-str2 u2 a-cat ucat -- }
|
|
\g Copy characters from STR1 and STR2 to pre-allocated CAT
|
|
a-str1 a-cat u1 cmove
|
|
a-str2 a-cat u1 chars + u2 cmove
|
|
;
|
|
|
|
: c$cat ( c-str1 c-str2 -- c-cat )
|
|
\g Concatenate two counted strings in heap, preserve original strings
|
|
count dup >r rot count dup >r 2swap ( a-str1 u1 a-str2 u2 R: u2 u1 )
|
|
r> r> + dup 1+ chars allocate if ( a-str1 u1 a-str2 u2 ucat c-cat )
|
|
clearstack 0 \ Returns 0 c-pointer for alloc. error
|
|
else
|
|
tuck c! ( a-str1 u1 a-str2 u2 c-cat )
|
|
dup >r count $catcpy r>
|
|
then
|
|
;
|
|
|
|
: c$catx ( c-str1 c-str2 ux -- c-cat )
|
|
\g Concatenate two counted strings in heap, recycle original strings according to UX: 0 -- recycle STR1 and STR2, 1 -- recycle STR1 only, 2 -- recycle STR2 only
|
|
>r 2dup c$cat r> ( c-str1 c-str2 c-cat ux )
|
|
dup 2 = if
|
|
drop swap free drop nip
|
|
else dup 1 = if
|
|
drop nip swap free drop
|
|
else 0= if
|
|
swap free drop
|
|
swap free drop
|
|
then then then
|
|
;
|