diff options
Diffstat (limited to 'files.e')
| -rw-r--r-- | files.e | 161 |
1 files changed, 161 insertions, 0 deletions
diff --git a/files.e b/files.e new file mode 100644 index 0000000..5bafd9a --- /dev/null +++ b/files.e @@ -0,0 +1,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 } { interpret } while + + main-input-buffer buffer-file-descriptor @ sys-close drop + ~ Ignore a failed close. + + main-input-buffer pop-input-buffer 0 ; + |