blob: 20aef32da99a0bd88317e9741e530f9df75fa1ca (
plain)
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
|
: safe-type ( str-addr str-len -- )
dup 256 > if
drop 256 type ." ...<lots more>"
else
type
endif ;
\ === mutable string buffer === /
\ string buffer that maintains an allocation larger than the current
\ string size. When appending would cause the string size exceed the
\ current allocation, resize is used to double the allocation. The
\ current allocation is not stored anywhere, but computed based on
\ current string size or str-base-size, whichever is larger.
64 constant str-base-size
: new-str ( -- addr length )
str-base-size allocate throw 0 ;
: round-up ( n -- n )
2
begin
1 lshift 2dup <
until
nip ;
: str-append { buf-addr buf-str-len str-addr str-len }
buf-str-len str-len +
{ new-len }
new-len str-base-size >= if
buf-str-len new-len xor buf-str-len > if
buf-addr new-len round-up resize throw
to buf-addr
endif
endif
str-addr buf-addr buf-str-len + str-len cmove
buf-addr new-len ;
\ define a-space, to append a space char to a string
bl c,
here constant space-str
: a-space space-str 1 str-append ;
: str-append-char ( buf-addr buf-str-len char -- buf-addr buf-str-len )
pad ! pad 1 str-append ;
\ from gforth docs, there named 'my-.'
: int>str ( num -- str-addr str-len )
\ handling negatives.. behaves like Standard .
s>d \ convert to signed double
swap over dabs \ leave sign byte followed by unsigned double
<<# \ start conversion
#s \ convert all digits
rot sign \ get at sign byte, append "-" if needed
#> \ complete conversion
#>> ; \ release hold area
defer MalString.
: ...str
new-str
begin
2swap
over 0 <>
while
str-append
repeat
2drop MalString. ;
nil value exception-object
: ...throw-str
...str to exception-object
1 throw ;
|
