track the filename of an input buffer

this also includes some slightly better facilities for handling temporary strings

Change-Id: Idf5e6fd8ade675d7ceb73264d10895fe8da578d6
Force-Push: yes

3 files changed, 56 insertions, 10 deletions

diff --git a/language/dynamic/dynamic.e b/language/dynamic/dynamic.e
index 270e860..677a180 100644
--- a/language/dynamic/dynamic.e
+++ b/language/dynamic/dynamic.e
@@ -361,6 +361,29 @@
   dup dup stringlen 1+ + 8 packalign here ! ;
 
 
+~   Tests whether a string pointer is equal to the current value of "here".
+~ If it is, the string is in the temporary allocation space.
+~
+~   This is not a comprehensive test; there are other ways the string could be
+~ temporary, such as being part of a larger data structure which is temporary,
+~ or being a substring of a longer string, without itself being right at the
+~ start of the scratch space. However, the most common way to wind up with a
+~ temporary string is by using the string-literal syntax in immediate mode,
+~ and a string allocated that way will always pass this test.
+~
+~ (string pointer -- boolean)
+: is-temporary-string here @ = ;
+
+~   Calls allocate-string if and only if the string it's given passes
+~ is-temporary-string. This function is idempotent, since the string will no
+~ longer be at "here" after allocating it, so it's safe to call on a parameter
+~ you've received that you don't know where it came from.
+~
+~ (string pointer -- string pointer)
+: allocate-string-if-temporary
+  dup is-temporary-string { allocate-string } if ;
+
+
 ~   Allocate space by incrementing "here", and output a word entry header in
 ~ it. Also add it to the "latest" linked list. Use zero as the flag values;
 ~ accept a string pointer on the stack and use its contents as the name.
@@ -558,3 +581,10 @@
 ~ (value -- )
 : literal lit lit , , ;
 
+~   We also have the same thing but for string literals. This one is a bit
+~ more involved, and less often needed, but it saves trouble when it does come
+~ up.
+~
+~ (string pointer --)
+: literal-string lit litstring , here @ swap packstring 8 packalign here ! ;
+
diff --git a/language/dynamic/files.e b/language/dynamic/files.e
index 21d4096..4822c2f 100644
--- a/language/dynamic/files.e
+++ b/language/dynamic/files.e
@@ -100,7 +100,7 @@
 : push-input-buffer
   allocate-input-buffer-metadata
   ~ (original metadata pointer, new metadata pointer)
-  2dup 7 8 * memcopy
+  2dup 8 8 * memcopy
   ~ (original metadata pointer, new metadata pointer)
   swap dup zero-input-buffer-metadata
   input-buffer-next-source ! ;
@@ -117,7 +117,7 @@
 : pop-input-buffer
   dup input-buffer-next-source @
   ~ (original metadata pointer, next source metadata pointer)
-  dup { swap 7 8 * memcopy }
+  dup { swap 8 8 * memcopy }
       { drop zero-input-buffer-metadata } if-else ;
 
 
@@ -147,14 +147,22 @@
     ." because " space . ." ." newline
     drop 1 exit
   } if
-  ~ (file descriptor)
+  ~ (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 thaan 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 to discard the last of our information before running it.
-  drop
+  ~ 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
 
@@ -163,3 +171,8 @@
 
   main-input-buffer pop-input-buffer 0 ;
 
+
+~ (-- filename pointer or 0)
+: current-input-file-name
+  main-input-buffer buffer-filename @ ;
+
diff --git a/language/dynamic/input.e b/language/dynamic/input.e
index 9d73c16..ccff6ca 100644
--- a/language/dynamic/input.e
+++ b/language/dynamic/input.e
@@ -15,11 +15,13 @@
 : buffer-logical-length 3 8 * + ;
 ~ (pointer to buffer metadata -- pointer to buffer "file-descriptor" field)
 : buffer-file-descriptor 4 8 * + ;
+~ (pointer to buffer metadata -- pointer to buffer "filename" field)
+: buffer-filename 5 8 * + ;
 ~ (pointer to input buffer metadata -- pointer to input buffer "refill" field)
-: input-buffer-refill 5 8 * + ;
+: input-buffer-refill 6 8 * + ;
 ~ (pointer to input buffer metadata
 ~  -- pointer to input buffer "next-source" field)
-: input-buffer-next-source 6 8 * + ;
+: input-buffer-next-source 7 8 * + ;
 
 
 ~   Given an initialized buffer (input or otherwise), sets its logical-start
@@ -48,6 +50,7 @@
   dup buffer-logical-start 0 swap !
   dup buffer-logical-length 0 swap !
   dup buffer-file-descriptor -1 swap !
+  dup buffer-filename 0 swap !
   dup input-buffer-refill 0 swap !
   ~ Notice the absence of a dup this time.
   input-buffer-next-source 0 swap ! ;
@@ -58,7 +61,7 @@
 ~
 ~ (-- pointer to input buffer metadata)
 : allocate-input-buffer-metadata
-  7 8 * allocate
+  8 8 * allocate
   dup zero-input-buffer-metadata ;
 
 
@@ -67,10 +70,10 @@
 ~
 ~ (buffer capacity in bytes -- pointer to input buffer metadata)
 : allocate-input-buffer
-  dup 7 8 * + allocate
+  dup 8 8 * + allocate
   dup zero-input-buffer-metadata
   ~ (capacity in bytes, metadata pointer)
-  dup dup 7 8 * +
+  dup dup 8 8 * +
   ~ (capacity in bytes, metadata pointer, metadata pointer, physical start)
   swap buffer-physical-start !
   ~ (capacity in bytes, metadata pointer)