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
|
~ ~~~~~~~~~~~~~~~~~~~~~~~
~ ~~ 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
~ input.e or 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 7 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 7 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 !
' refill-input-buffer-from-stream entry-to-execution-token
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
~ (file descriptor)
main-input-buffer dup push-input-buffer
swap attach-input-buffer-to-file-descriptor
{ peek -1 != } { interpret } while
main-input-buffer buffer-file-descriptor @ sys-close drop
~ Ignore a failed close.
main-input-buffer pop-input-buffer 0 ;
|