[PATCH] modify FileDescriptor to store a File instead of only a String

This is another relatively large part, and the only one to touch
the VM.  It stores Files if possible into FileDescriptor, which is
needed to lose support for magic file names and still allow FileSegments
to retrieve the source code.

In order to do so, the fileIn primitive is grown from three to four
arguments, accepting both a file name and a file object.  The latter
is used to store in the FileSegments, the former is used to print
error messages.

---
 kernel/FileDescr.st   |   53 +++++++++++++++++++++++++++++++++++----------
 kernel/FileSegment.st |    7 ++++-
 kernel/Stream.st      |   21 ++++++++++++++++++
 kernel/VFS.st         |    2 +-
 kernel/VFSZip.st      |   24 +++++++++++++++++++-
 libgst/dict.c         |    2 +-
 libgst/input.c        |   57 ++++++++++++++++++++++--------------------------
 libgst/input.h        |    7 +-----
 libgst/prims.def      |   13 ++++++-----
 9 files changed, 126 insertions(+), 60 deletions(-)

diff --git a/kernel/FileDescr.st b/kernel/FileDescr.st
index 85f0a93..b22a271 100644
--- a/kernel/FileDescr.st
+++ b/kernel/FileDescr.st
@@ -33,7 +33,7 @@
 
 
 ByteStream subclass: FileDescriptor [
-    | fd name isPipe atEnd peek |
+    | fd file isPipe atEnd peek |
     
     <category: 'Streams-Files'>
     <comment: 'My instances are what conventional programmers think of as files.
@@ -167,9 +167,10 @@ do arbitrary processing on the files.'>
  <category: 'instance creation'>
  ^(self basicNew)
     fileOp: 0
- with: fileName
+ with: fileName asString
  with: fileMode
  ifFail: [SystemExceptions.FileError signal: 'could not open ' , fileName];
+    setFile: (File name: fileName);
     initialize;
     yourself
     ]
@@ -186,9 +187,10 @@ do arbitrary processing on the files.'>
  <category: 'instance creation'>
  ^(self basicNew)
     fileOp: 0
- with: fileName
+ with: fileName asString
  with: fileMode
  ifFail: [^aBlock value];
+    setFile: (File name: fileName);
     initialize;
     yourself
     ]
@@ -611,24 +613,30 @@ do arbitrary processing on the files.'>
  ^fd
     ]
 
+    file [
+ "Return the name of the file"
+
+ <category: 'accessing'>
+ ^file
+    ]
+
     name [
  "Return the name of the file"
 
  <category: 'accessing'>
- ^name
+ file isNil ifTrue: [^'descriptor #', fd printString ].
+ ^file displayString
     ]
 
     printOn: aStream [
  "Print a representation of the receiver on aStream"
 
  <category: 'printing'>
- | text |
- text := name isNil
-    ifTrue: ['File descriptor #' , file printString]
-    ifFalse: [(self isPipe ifTrue: ['Pipe on '] ifFalse: ['File ']) , name].
  aStream
     nextPut: $<;
-    nextPutAll: text;
+    nextPutAll: (self isPipe ifTrue: ['Pipe'] ifFalse: [self class name]);
+    nextPutAll: ' on ';
+    nextPutAll: self name;
     nextPut: $>
     ]
 
@@ -711,9 +719,9 @@ do arbitrary processing on the files.'>
  [SystemExceptions.FileError signal: 'cannot do that to a pipe or socket.']
     ]
 
-    setName: aString [
+    setFile: aString [
  <category: 'private'>
- name := aString
+ file := aString
     ]
 
     setFD: anInteger [
@@ -776,7 +784,7 @@ do arbitrary processing on the files.'>
  "Answer myself, or an alternate stream coerced for reading."
  <category: 'initialize-release'>
  ^(access bitAnd: 1) = 0
-    ifTrue: [self class open: self name mode: FileStream read]
+    ifTrue: [self file readStream]
     ifFalse: [self]
     ]
 
@@ -933,6 +941,27 @@ do arbitrary processing on the files.'>
  ^cur - position
     ]
 
+    fileIn [
+        "File in the contents of the receiver.
+         During a file in operation, global variables (starting with an
+         uppercase letter) that are not declared don't yield an `unknown
+         variable' error. Instead, they are defined as nil in the `Undeclared'
+         dictionary (a global variable residing in Smalltalk).
+         As soon as you add the variable to a namespace (for example by creating
+         a class) the Association will be removed from Undeclared and reused
+         in the namespace, so that the old references will automagically point
+         to the new value."
+
+        <category: 'built ins'>
+        | pos |
+ self isPipe ifTrue: [ ^super fileIn ].
+        ^self
+            fileInLine: 1
+            file: self file full
+            fileName: self name
+            at: self position
+    ]
+
     fileOp: ioFuncIndex [
  "Private - Used to limit the number of primitives used by FileStreams"
 
diff --git a/kernel/FileSegment.st b/kernel/FileSegment.st
index 230f19d..55c5b5b 100644
--- a/kernel/FileSegment.st
+++ b/kernel/FileSegment.st
@@ -123,14 +123,17 @@ Smalltalk-80 kernel; I am specific to the GNU Smalltalk implementation.'>
  "Answer the File object for the file containing the segment"
 
  <category: 'basic'>
- ^Directory kernel / file
+ | f |
+ f := file asFile.
+ f isRelative ifTrue: [ f := Directory kernel / file ].
+ ^f
     ]
 
     fileName [
  "Answer the name of the file containing the segment"
 
  <category: 'basic'>
- ^self file name
+ ^file asString
     ]
 
     filePos [
diff --git a/kernel/Stream.st b/kernel/Stream.st
index d7f9fec..3097a84 100644
--- a/kernel/Stream.st
+++ b/kernel/Stream.st
@@ -569,6 +569,27 @@ provide for writing collections sequentially.'>
     at: pos
     ]
 
+    fileInLine: lineNum file: aFile at: charPosInt [
+ "Private - Much like a preprocessor #line directive; it is used internally
+ by #fileIn, and explicitly by the Emacs Smalltalk mode."
+
+ <category: 'built ins'>
+ ^self
+    fileInLine: 1
+    file: aFile full
+    fileName: aFile displayString
+    at: charPosInt
+    ]
+
+    fileInLine: lineNum file: aFile fileName: aString at: charPosInt [
+ "Private - Much like a preprocessor #line directive; it is used internally
+ by #fileIn, and explicitly by the Emacs Smalltalk mode."
+
+ <category: 'private'>
+ <primitive: VMpr_Stream_fileInLine>
+ self primitiveFailed
+    ]
+
     fileInLine: lineNum fileName: aString at: charPosInt [
  "Private - Much like a preprocessor #line directive; it is used internally
  by #fileIn, and explicitly by the Emacs Smalltalk mode."
diff --git a/kernel/VFS.st b/kernel/VFS.st
index 71b0b02..e767a46 100644
--- a/kernel/VFS.st
+++ b/kernel/VFS.st
@@ -1616,7 +1616,7 @@ ArchiveMemberHandler subclass: TmpFileArchiveMemberHandler [
     mode: mode
     ifFail: [^aBlock value].
  mode == FileStream read ifFalse: [fileStream addDependent: self].
- fileStream setName: self fullName.
+ fileStream setFile: (File on: self).
  ^fileStream
     ]
 
diff --git a/kernel/VFSZip.st b/kernel/VFSZip.st
index a77eb41..94a980a 100644
--- a/kernel/VFSZip.st
+++ b/kernel/VFSZip.st
@@ -200,7 +200,7 @@ class for stored ZIP archive members, which are optimized.'>
     ifFail: [^aBlock value].
  file skip: self offset + 26.
  file skip: file nextUshort + file nextUshort.
- file setName: self fullName.
+ file setFile: (File on: self).
  ^LimitedStream
     on: file
     from: file position
@@ -334,6 +334,28 @@ Stream subclass: LimitedStream [
  <category: 'accessing'>
  offset := anInteger
     ]
+
+    fileIn [
+        "File in the contents of the receiver.
+         During a file in operation, global variables (starting with an
+         uppercase letter) that are not declared don't yield an `unknown
+         variable' error. Instead, they are defined as nil in the `Undeclared'
+         dictionary (a global variable residing in Smalltalk).
+         As soon as you add the variable to a namespace (for example by creating
+         a class) the Association will be removed from Undeclared and reused
+         in the namespace, so that the old references will automagically point
+         to the new value."
+
+        <category: 'built ins'>
+        | pos |
+        stream isPipe ifTrue: [ ^super fileIn ].
+        ^self
+            fileInLine: 1
+            file: stream file full
+            fileName: stream name
+            at: self position
+    ]
+
 ]
 
 ]
diff --git a/libgst/dict.c b/libgst/dict.c
index 9b7df2a..2f9e91f 100644
--- a/libgst/dict.c
+++ b/libgst/dict.c
@@ -617,7 +617,7 @@ static const class_definition class_info[] = {
 
   {&_gst_file_descriptor_class, &_gst_byte_stream_class,
    ISP_FIXED, true, 5,
-   "FileDescriptor", "fd name isPipe atEnd peek", "AllOpenFiles", NULL },
+   "FileDescriptor", "fd file isPipe atEnd peek", "AllOpenFiles", NULL },
 
   {&_gst_file_stream_class, &_gst_file_descriptor_class,
    ISP_FIXED, true, 2,
diff --git a/libgst/input.c b/libgst/input.c
index 256fbf6..cf400f9 100644
--- a/libgst/input.c
+++ b/libgst/input.c
@@ -60,7 +60,7 @@
 typedef struct gst_file_segment
 {
   OBJ_HEADER;
-  OOP fileName;
+  OOP fileOOP;
   OOP startPos;
   OOP length;
 }
@@ -104,7 +104,7 @@ typedef struct input_stream
   int column;
   const char *prompt;
 
-  OOP fileNameOOP; /* the full path name for file */
+  OOP fileOOP; /* the object stored in FileSegments */
   const char *fileName;
   off_t fileOffset;
 
@@ -126,6 +126,10 @@ typedef struct input_stream
 /* The internal interface used by _gst_next_char.  */
 static int my_getc (input_stream stream);
 
+/* Return the File object or a file name for the topmost stream in the stack
+   if it is of type STREAM_FILE; nil otherwise.  */
+static OOP get_cur_file (void);
+
 /* Print a line indicator in front of an error message.  */
 static void line_stamp (int line);
 
@@ -214,9 +218,7 @@ _gst_pop_stream (mst_Boolean closeIt)
 
   stream = in_stream;
   in_stream = in_stream->prevStream;
-
-  if (!IS_NIL (stream->fileNameOOP))
-    _gst_unregister_oop (stream->fileNameOOP);
+  _gst_unregister_oop (stream->fileOOP);
 
   switch (stream->type)
     {
@@ -336,7 +338,7 @@ push_new_stream (stream_type type)
   newStream->type = type;
   newStream->fileName = NULL;
   newStream->prompt = NULL;
-  newStream->fileNameOOP = _gst_nil_oop;
+  newStream->fileOOP = _gst_nil_oop;
   newStream->prevStream = in_stream;
   in_stream = newStream;
   return (newStream);
@@ -345,19 +347,19 @@ push_new_stream (stream_type type)
 
 void
 _gst_set_stream_info (int line,
+      OOP fileOOP,
       OOP fileNameOOP,
       int fileOffset)
 {
   in_stream->line = line;
   in_stream->column = 0;
-  if (!IS_NIL (fileNameOOP))
-    {
-      in_stream->fileName = _gst_to_cstring (fileNameOOP);
-      _gst_register_oop (in_stream->fileNameOOP);
-    }
 
-  in_stream->fileNameOOP = fileNameOOP;
+  _gst_register_oop (fileOOP);
+  in_stream->fileOOP = fileOOP;
   in_stream->fileOffset = fileOffset;
+
+  if (!IS_NIL (fileNameOOP))
+    in_stream->fileName = _gst_to_cstring (fileNameOOP);
 }
 
 void
@@ -489,18 +491,18 @@ _gst_get_source_string (off_t startPos, off_t endPos)
 
   if (startPos != -1 && !_gst_get_cur_stream_prompt ())
     {
-      OOP fileName;
+      OOP fileOOP;
       gst_file_segment fileSegment;
       inc_ptr incPtr;
 
       incPtr = INC_SAVE_POINTER ();
-      fileName = _gst_get_cur_file_name ();
-      INC_ADD_OOP (fileName);
+      fileOOP = get_cur_file ();
+      INC_ADD_OOP (fileOOP);
 
       fileSegment = (gst_file_segment) new_instance (_gst_file_segment_class,
                                                      &result);
 
-      fileSegment->fileName = fileName;
+      fileSegment->fileOOP = fileOOP;
       fileSegment->startPos = from_c_int_64 (startPos);
       fileSegment->length = from_c_int_64 (endPos - startPos);
 
@@ -548,15 +550,15 @@ _gst_get_source_string (off_t startPos, off_t endPos)
 }
 
 OOP
-_gst_get_cur_file_name (void)
+get_cur_file (void)
 {
-  char *fullFileName;
+  const char *fullFileName;
 
   if (!in_stream)
     return _gst_nil_oop;
 
-  if (!IS_NIL (in_stream->fileNameOOP))
-    return in_stream->fileNameOOP;
+  if (!IS_NIL (in_stream->fileOOP))
+    return in_stream->fileOOP;
 
   if (in_stream->type != STREAM_FILE)
     return (_gst_nil_oop);
@@ -567,9 +569,9 @@ _gst_get_cur_file_name (void)
     fullFileName =
       _gst_get_full_file_name (in_stream->fileName);
 
-  in_stream->fileNameOOP = _gst_string_new (fullFileName);
-  _gst_register_oop (in_stream->fileNameOOP);
-  return (in_stream->fileNameOOP);
+  in_stream->fileOOP = _gst_string_new (fullFileName);
+  _gst_register_oop (in_stream->fileOOP);
+  return (in_stream->fileOOP);
 }
 
 
@@ -700,14 +702,7 @@ line_stamp (int line)
   if (_gst_report_errors)
     {
       if (in_stream)
- {
-  if (in_stream->fileName)
-    fprintf (stderr, "%s:", in_stream->fileName);
-  else if (!IS_NIL (in_stream->fileNameOOP))
-    fprintf (stderr, "%#O:", in_stream->fileNameOOP);
-
-  fprintf (stderr, "%d: ", line);
- }
+ fprintf (stderr, "%s:%d: ", in_stream->fileName, line);
       else
  fprintf (stderr, "gst: ");
     }
diff --git a/libgst/input.h b/libgst/input.h
index 5e31156..a5cf821 100644
--- a/libgst/input.h
+++ b/libgst/input.h
@@ -115,6 +115,7 @@ extern void _gst_pop_stream (mst_Boolean closeIt)
    a subsection of a real file via a temporary file what the real
    source of the text is.  */
 extern void _gst_set_stream_info (int line,
+  OOP fileOOP,
   OOP fileNameOOP,
   int fileOffset)
   ATTRIBUTE_HIDDEN;
@@ -174,12 +175,6 @@ extern stream_type _gst_get_cur_stream_type (void)
   ATTRIBUTE_PURE
   ATTRIBUTE_HIDDEN;
 
-/* Return the name of the topmost stream in the stack if it is of type
-   STREAM_FILE; nil otherwise.  */
-extern OOP _gst_get_cur_file_name (void)
-  ATTRIBUTE_PURE
-  ATTRIBUTE_HIDDEN;
-
 /* Returns an OOP containing the string of the topmost stream if it is
    a STREAM_STRING, STREAM_OOP or STREAM_READLINE, or if it has a filename;
    nil otherwise.  */
diff --git a/libgst/prims.def b/libgst/prims.def
index 714c028..f13e0bd 100644
--- a/libgst/prims.def
+++ b/libgst/prims.def
@@ -5099,8 +5099,9 @@ primitive VMpr_Object_makeWeak [succeed,fail]
 
 primitive VMpr_Stream_fileInLine [succeed,fail]
 {
+  OOP oop4 = POP_OOP ();
   OOP oop3 = POP_OOP ();
-  OOP oop2 = POP_OOP ();
+  OOP oop2 = (numArgs == 4 ? POP_OOP () : oop3);
   OOP oop1 = POP_OOP ();
   OOP streamOOP = STACKTOP ();
   enum undeclared_strategy old;
@@ -5109,16 +5110,16 @@ primitive VMpr_Stream_fileInLine [succeed,fail]
     PRIM_FAILED;
 
   if (IS_INT (oop1)
-      && (IS_NIL (oop2)
-  || (IS_CLASS (oop2, _gst_string_class) && IS_INT (oop3))))
+      && (IS_NIL (oop3)
+  || (IS_CLASS (oop3, _gst_string_class) && IS_INT (oop4))))
     {
       intptr_t arg1;
-      intptr_t arg3;
+      intptr_t arg4;
       arg1 = TO_INT (oop1);
-      arg3 = TO_INT (oop3);
+      arg4 = TO_INT (oop4);
 
       _gst_push_stream_oop (streamOOP);
-      _gst_set_stream_info (arg1, oop2, arg3);
+      _gst_set_stream_info (arg1, oop2, oop3, arg4);
       old = _gst_set_undeclared (UNDECLARED_GLOBALS);
       parse_stream_with_protection (false);
       _gst_set_undeclared (old);
--
1.5.3.4.910.gc5122-dirty



_______________________________________________
help-smalltalk mailing list
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk