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
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
|
~ ~~~~~~~~~~~~~~~~~~~~~~~
~ ~~ File manipulation ~~
~ ~~~~~~~~~~~~~~~~~~~~~~~
~
~ This file has high-level features for working with files and the
~ filesystem. There's a tension as to what belongs here vs. what belongs in
~ language/dynamic/input.e or language/static/output.e, and it's likely there
~ will be some refactoring as the boundaries become clear.
~ (output point, filename -- output point)
: pack-file-contents
dup 0 0 sys-open
~ (output point, filename, open result code or file descriptor)
dup 0 > {
." Couldn't open " swap emitstring space
." because " space . ." ." newline
2 ndrop exit
} if
~ (output point, filename, file descriptor)
{
dup 3 pick 1024 sys-read
~ (output point, filename, file descriptor, read result code or length)
dup 0 > {
over sys-close drop
~ Ignore a failed close.
." Error while reading from " 3roll emitstring
." because " space . ." ." newline
drop exit
} if
dup 0 = {
over sys-close drop
~ Ignore a failed close.
3 ndrop exit
} if
4 roll + 3unroll
} forever ;
~ TODO probably make this more similar to pack-file-contents
~ (delimiter pointer, buffer size -- buffer address)
: read-to-buffer
dup allocate dup dup
~ (buffer size, buffer address, word start, output point)
{ key
~ Exit if it's a zero byte.
dup not {
~ Make sure to pack the zero to serve as a null terminator.
pack8
drop drop swap drop swap drop exit } if
~ If it's a space character, we need to check if we just consumed the
~ magic word, and do some handling to reset the word tracking.
dup is-space
{ ~ (buffer size, buffer address, word start, output point, key)
~ Tuck the key out of the way until we've done some stuff.
3unroll
~ Add a null terminator so we can use stringcmp
dup 0 swap 8!
~ Check for the magic word.
over 6 pick stringcmp 0 =
{ ~ It's magic, so exit.
~ Make sure to pack a zero to serve as a null terminator.
0 pack8
drop drop drop swap drop swap drop exit }
{ ~ It's not magic, so reset the word start. Of course whitespace is
~ not a word but this will help us keep track of things.
3roll pack8
swap drop dup } if-else }
{ ~ (buffer size, buffer address, word start, output point, key)
~ Tuck the key out of the way again.
3unroll
~ Check if the word just started and the previous character is space.
2dup = dup { drop dup @ is-space } if
{ ~ If so, this is the actual first character of the word.
drop swap pack8 dup }
{ ~ If not, leave the word start alone.
3roll pack8 } if-else } if-else } forever ;
~ In logical terms, this modifies an input buffer metadata structure
~ in-place to push a new, zeroed one into the start of the linked list formed
~ through the next-source field.
~
~ In physical terms, it works by allocating a new structure, copying the
~ fields of the existing one into it, and zeroing the existing one. That's
~ necessary because otherwise we'd need a mutable handle (a pointer to a
~ pointer) to update the start of the list, and there's no way to do that with
~ the main-input-buffer variable working the way it presently does.
~
~ (input buffer metadata pointer --)
: push-input-buffer
allocate-input-buffer-metadata
~ (original metadata pointer, new metadata pointer)
2dup 8 8 * memcopy
~ (original metadata pointer, new metadata pointer)
swap dup zero-input-buffer-metadata
input-buffer-next-source ! ;
~ This does the inverse of push-input-buffer. In the event that the
~ next-source field is null, it zeroes the buffer.
~
~ Note, however, that it doesn't deallocate the memory, because that's not
~ how memory allocation on the log works. If necessary, it can be deallocated
~ with "forget", though as usual that requires careful planning.
~
~ (input buffer metadata pointer --)
: pop-input-buffer
dup input-buffer-next-source @
~ (original metadata pointer, next source metadata pointer)
dup { swap 8 8 * memcopy }
{ drop zero-input-buffer-metadata } if-else ;
: default-buffer-size 1024 ;
~ (input buffer metadata pointer, file descriptor --)
: attach-input-buffer-to-file-descriptor
over buffer-file-descriptor !
~ (metadata pointer)
default-buffer-size allocate dup 2 pick buffer-physical-start !
~ (metadata pointer, buffer pointer)
over buffer-logical-start !
~ (metadata pointer)
default-buffer-size over buffer-physical-length !
0 over buffer-logical-length !
x' refill-input-buffer-from-stream
swap input-buffer-refill ! ;
~ Zero indicates success, nonzero indicates failure.
~
~ (filename -- *, success)
: include
dup 0 0 sys-open
dup 0 > {
." Couldn't open " swap emitstring space
." because " space . ." ." newline
drop 1 exit
} if
~ (filename, file descriptor)
~ Notice that we deferred this allocation until after we know that opening
~ the file succeeded. We can't leave it any longer than this;
~ push-input-buffer will allocate memory, which will overwrite the scratch
~ space.
swap allocate-string-if-temporary swap
main-input-buffer dup push-input-buffer
swap attach-input-buffer-to-file-descriptor
main-input-buffer buffer-filename !
~ We don't know what the code we're including will do to the stack, so we
~ have make sure there's no information of our own on the stack before
~ running it. At this point, that's the case.
{ peek -1 != } { interpret } while
main-input-buffer buffer-file-descriptor @ sys-close drop
~ Ignore a failed close.
main-input-buffer pop-input-buffer 0 ;
~ (-- filename pointer or 0)
: current-input-file-name
main-input-buffer buffer-filename @ ;
: open-file-for-reading
~ (filename -- metadata pointer or 0)
dup 0 0 sys-open
dup 0 > {
." Couldn't open " swap emitstring space
." because " space . ." ." newline
drop 0 exit
} if
~ (filename, file descriptor)
~ As with include, we deferred this allocation until after successful open.
swap allocate-string-if-temporary swap
allocate-input-buffer-metadata dup zero-input-buffer-metadata
~ (filename, file descriptor)
dup 3unroll swap attach-input-buffer-to-file-descriptor ;
~ Note that this doesn't clear data that's already in the buffer.
~
~ (metadata pointer --)
: close-file
dup buffer-file-descriptor @ sys-close drop
~ Ignore a failed close.
buffer-file-descriptor -1 swap ! ;
|