Bootstrapped VM doing file IO

[John Leuner]

This patch makes it possible to do a fileIn of a simple input file with
the bootstrapped VM.

Some caveats:

- I used the fopen / fread functions which take a FILE* pointer as a
handle. I did this because I was copying the Console read/write
functions.

I think this is potentially a bad thing because if someone were to
manipulate the handle they could easily corrupt the VM or bypass any
security system.

- I created a FileObject to dispatch the primitives on. There is
probably a better name/place for this.

- I haven't done any error checking, checks for partial reads/writes etc

- I'm not clear on how the positionable streams are intended to work, I
simply implemented the position methods as fseek/ftell.

- In all the places where I use (integer >> 1) I should probably be
using a macro

-- 
John Leuner <jewel at pixie.co.za>
-------------- next part --------------
? adiff
? backimg
? build.txt
? cache.fasl
? compiler.fasl
? foo.c
? foo.h
? foo.slate
? johnvm1.core
? myimage
? myimage1
? myimage2
? myimage3
? noot.txt
? object.fasl
? prims.fasl
? repl.fasl
? slate.core
? syntax.fasl
? tmp
? tmp2
? tmp3
? tmp4
? vm.c
? vm.h
Index: bootstrap/file.slate
===================================================================
RCS file: /var/lib/cvs/slate/slate/bootstrap/file.slate,v
retrieving revision 1.2
diff -u -r1.2 file.slate
--- bootstrap/file.slate	2 May 2004 19:28:04 -0000	1.2
+++ bootstrap/file.slate	24 May 2004 08:18:56 -0000
@@ -1,16 +1,47 @@
 prototypes addPrototype: #File derivedFrom: {ExternalResource}.
-File addDelegate: #handle valued: FileHandle.
-"This is the Lisp primitive object until the VM setup."
 
-f@(File traits) enable
-[].
+f@(File traits) size
+[ | savedpos fsize |
+ savedpos: f position.
+ FileObject seek: (f handle) offset: 0 whence: 2.
+ fsize: f position.
+ f position: savedpos.
+ fsize
+].
+
+f@(File traits) position
+[
+ FileObject tell: (f handle)
+].
 
-file@(File traits) close
+f@(File traits) position: pos
 [
-  file close: file handle
+ FileObject seek: (f handle) offset: pos whence: 0.
+ pos
 ].
 
-f@(File traits) openFor: handle@(FileHandle traits)
+f@(File traits) read: n from: handle startingAt: start into: array 
+[
+ FileObject read: n from: (f handle) startingAt: start into: array
+].
+
+file@(File traits) write: n to: handle startingAt: start from: array
+[
+ array at: 0 put: $w.
+ 1
+].
+
+f@(File traits) close
+"Close the resource connection. Override this and resend for derived objects."
+[
+  FileObject close: (f handle).
+  resend
+].
+
+f@(File traits) enable
+[].
+
+f@(File traits) openFor: handle
 [| newF |
   newF: f clone.
   newF handle: handle.
@@ -18,10 +49,11 @@
 ].
 
 f@(File traits) open: filename@(String traits)
-[
-  (f handle newNamed: filename)
-    ifNil: [f noneExistsFor: filename]
-    ifNotNilDo: [| :handle | f openFor: handle]
+[ | newhandle |
+  newhandle: (FileObject open: (filename as: ByteArray)).
+  (newhandle = 0)
+    ifTrue: [f noneExistsFor: filename]
+    ifFalse: [ f openFor: newhandle]
 ].
 
 f@(File traits) openForInput: filename
Index: bootstrap/stream.slate
===================================================================
RCS file: /var/lib/cvs/slate/slate/bootstrap/stream.slate,v
retrieving revision 1.5
diff -u -r1.5 stream.slate
--- bootstrap/stream.slate	25 Apr 2004 07:53:43 -0000	1.5
+++ bootstrap/stream.slate	24 May 2004 08:18:59 -0000
@@ -77,7 +77,7 @@
 s@(ReadStream traits) next: n putInto: seq startingAt: start
 "Returns a partial copy if not all elements can be read into the other collection."
 [| obj |
-  0 below: n do: [| :index |
+  0 below: n do: [| :index | 
     (obj: s next) ifNil: [^ (seq copyFrom: 0 to: start + index)].
     seq at: start + index put: obj].
   n
Index: bootstrap/mobius/repl.slate
===================================================================
RCS file: /var/lib/cvs/slate/slate/bootstrap/mobius/repl.slate,v
retrieving revision 1.2
diff -u -r1.2 repl.slate
--- bootstrap/mobius/repl.slate	25 Apr 2004 07:53:43 -0000	1.2
+++ bootstrap/mobius/repl.slate	24 May 2004 08:18:59 -0000
@@ -5,6 +5,15 @@
 REPL addSlot: #lineCount valued: 0.
 REPL addSlot: #basePrompt valued: '> '.
 
+s@(String traits) fileIn
+[ | input aparser interp |
+" Console ; 'Filing in $'' ; s ; '$'.$\n'."
+ input: (File open: s).
+ aparser: ((Syntax Parser clone) newOn: (input reader)).
+ (lobby interpretHook: [ (aparser next) evaluateIn: lobby ]).
+ input close.
+].
+
 repl@(REPL traits) prompt
 [
   'Slate ' ; repl lineCount print ; repl basePrompt
Index: src/mobius/vm/bootstrap.slate
===================================================================
RCS file: /var/lib/cvs/slate/slate/src/mobius/vm/bootstrap.slate,v
retrieving revision 1.57
diff -u -r1.57 bootstrap.slate
--- src/mobius/vm/bootstrap.slate	29 Apr 2004 18:31:35 -0000	1.57
+++ src/mobius/vm/bootstrap.slate	24 May 2004 08:19:06 -0000
@@ -827,7 +827,11 @@
     
 gen@(VM Bootstrap Generator traits) generateUtilities
 [
-  gen addObjectNamed: #ConsoleObject valued: (gen cloneOf: gen OddballProto)
+  gen addObjectNamed: #ConsoleObject valued: gen newObject.
+  gen ConsoleObject makeDelegateNamed: #traits valued: gen OddballTraits. 
+
+  gen addObjectNamed: #FileObject valued: gen newObject.
+  gen FileObject makeDelegateNamed: #traits valued: gen OddballTraits. 
 ].
 
 gen@(VM Bootstrap Generator traits) generateLobby
@@ -864,6 +868,7 @@
   gen addAccessorFor: #globals on: gen LobbyObject.
   {
     #Console -> gen ConsoleObject.
+    #FileObject -> gen FileObject.
     #NoRole -> gen NoRoleObject.
     #Nil -> gen NilObject.
     #True -> gen TrueObject.
Index: src/mobius/vm/build.slate
===================================================================
RCS file: /var/lib/cvs/slate/slate/src/mobius/vm/build.slate,v
retrieving revision 1.51
diff -u -r1.51 build.slate
--- src/mobius/vm/build.slate	28 Apr 2004 03:20:01 -0000	1.51
+++ src/mobius/vm/build.slate	24 May 2004 08:19:06 -0000
@@ -178,6 +178,7 @@
      'bootstrap/external.slate'.
      'bootstrap/debugger.slate'.
      'bootstrap/print.slate'.
+     'bootstrap/file.slate'.
      'bootstrap/mobius/types.slate'.
      'bootstrap/mobius/syntax/syntax.slate'.
      'bootstrap/mobius/syntax/token.slate'.
Index: src/mobius/vm/prims.slate
===================================================================
RCS file: /var/lib/cvs/slate/slate/src/mobius/vm/prims.slate,v
retrieving revision 1.28
diff -u -r1.28 prims.slate
--- src/mobius/vm/prims.slate	2 May 2004 00:26:23 -0000	1.28
+++ src/mobius/vm/prims.slate	24 May 2004 08:19:08 -0000
@@ -574,6 +574,50 @@
   interpreter stackPush: CurrentMemory NilObject
 ] `pidginPrimitive.
 
+"file primitives"
+
+file at FileObject open: fname
+[| bytes!(Byte pointer) |
+  bytes: fname pointer arrayElements!(Byte pointer) cast.
+  interpreter stackPush: '(ObjectPointer) fopen((char*)bytes, "rw")' directly!UnsignedLongInt asObject.
+] `pidginPrimitive.
+
+file at FileObject close: handle
+[
+  interpreter stackPush: 'fclose((FILE*)(ObjectPointer_asSmallInt(handle)))' directly!UnsignedLongInt asObject.
+] `pidginPrimitive.
+
+Console ; 'doing read'.
+
+file at FileObject read: n from: handle startingAt: start into: array
+[ | bytes!(Byte pointer) |
+  bytes: array pointer arrayElements!(Byte pointer) cast.
+" (start ~= 0) ifTrue: [ file signal ]."
+  interpreter stackPush: 'fread(bytes, n >> 1, 1, (FILE*)(ObjectPointer_asSmallInt(handle)))' directly!UnsignedLongInt asObject.
+] `pidginPrimitive.
+
+Console ; 'doing write'.
+
+file at FileObject write: n to: handle startingAt: start from: array
+[ | bytes!(Byte pointer) |
+  bytes: array pointer arrayElements!(Byte pointer) cast.
+" (start ~= 0) ifTrue: [ file signal ]."
+  interpreter stackPush: 'fwrite(bytes, n >> 1, 1, (FILE*)(ObjectPointer_asSmallInt(handle)))' directly!UnsignedLongInt asObject.
+] `pidginPrimitive.
+
+Console ; 'doing rest'.
+
+file at FileObject seek: handle offset: n whence: w
+[
+  interpreter stackPush: 'fseek((FILE*)(ObjectPointer_asSmallInt(handle)), n >> 1, w >> 1)' directly!UnsignedLongInt asObject.
+] `pidginPrimitive.
+
+file at FileObject tell: handle
+[
+  interpreter stackPush: 'ftell((FILE*)(ObjectPointer_asSmallInt(handle)))' directly!UnsignedLongInt asObject.
+] `pidginPrimitive.
+
+
 interp at InterpreterTraits framePointerOf: selector
 [| i!(Interpreter pointer) frame lexicalContext!(LexicalContext pointer) method!(CompiledMethod pointer) |
   i: interp pointer!(Interpreter pointer) cast.