[PATCH] Store source code in .star files uncompressed

As suggested by Stephen Compall a while ago, we now do not compress .st
and .xml files anymore in a .star file.  Then, we can just open a "view"
of the underlying .zip file if it was stored and not compressed.  This
is faster by a good percentage (140ms vs. 80ms, counting 40ms for
startup on my machine...).

Thanks to the "virtual files" feature it is then possible to feed these
views into other VFSHandlers, like this:

(FileStream popen: 'zcat' dir: 'r+')
     nextPutAll: (FileStream
                     open: 'Complex.star#uzip/package.xml#gz' mode: 'r');
     shutdown;
     contents

Paolo


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

Paolo Bonzini wrote: The patch...

Paolo

2007-07-23  Paolo Bonzini  <[hidden email]>

        * kernel/VFS.st: Add StoredZipMember and LimitedStream to provide
        faster access to uncompressed files.  Move ZipFileHandler to the
        Kernel namespace.
        * scripts/Package.st: Do not compress .st and .xml files.


* looking for [hidden email]--2004b/smalltalk--devo--2.2--patch-492 to compare with
* comparing to [hidden email]--2004b/smalltalk--devo--2.2--patch-492
M  scripts/Package.st
M  kernel/VFS.st

* modified files

--- orig/kernel/VFS.st
+++ mod/kernel/VFS.st
@@ -99,16 +99,6 @@ resides entirely in ArchiveFileHandler b
 will still ask the archive to get directory information
 on them, to extract them to a real file, and so on.'!
 
-ArchiveFileHandler subclass: #ZipFileHandler
-       instanceVariableNames: ''
-       classVariableNames: ''
-       poolDictionaries: ''
-       category: 'Streams-Files'
-!
-
-ZipFileHandler comment: 'ZipFileHandler transparently extracts
-files from a ZIP archive.'!
-
 VFSHandler subclass: #ArchiveMemberHandler
        instanceVariableNames: 'parent name mode size stCtime stMtime stAtime'
        classVariableNames: ''
@@ -1369,6 +1359,37 @@ realFileName
     realFileName := (self parent extractMember: self).
     ^realFileName! !
 
+Namespace current: Kernel!
+
+VFS.ArchiveFileHandler subclass: #ZipFileHandler
+       instanceVariableNames: ''
+       classVariableNames: ''
+       poolDictionaries: ''
+       category: 'Streams-Files'
+!
+
+ZipFileHandler comment: 'ZipFileHandler transparently extracts
+files from a ZIP archive.'!
+
+VFS.ArchiveMemberHandler subclass: #StoredZipMember
+       instanceVariableNames: 'offset'
+       classVariableNames: ''
+       poolDictionaries: ''
+       category: 'Streams-Files'
+!
+
+StoredZipMember comment: 'ArchiveMemberHandler is the handler
+class for stored ZIP archive members, which are optimized.'!
+
+Stream subclass: #LimitedStream
+       instanceVariableNames: 'stream offset limit'
+       classVariableNames: ''
+       poolDictionaries: ''
+       category: 'Streams-Files'
+!
+
+LimitedStream comment: 'I provide a view of a part of a substream.'!
+
 !ZipFileHandler class methodsFor: 'registering'!
 
 priority
@@ -1441,7 +1462,7 @@ files
     "Extract the directory listing from the archive"
 
     ^Generator on: [ :gen |
- | f cd mode path date method dataSize fileSize fnsize extra comment attr ofs |
+ | f cd data path date method dataSize fileSize fnsize extra comment attr ofs |
  f := self open: FileStream read ifFail: [
     self error: 'cannot open file for input' ].
         cd := ByteStream on: (self centralDirectoryOf: f).
@@ -1451,24 +1472,132 @@ files
         [ cd atEnd ] whileFalse: [
     cd skip: 10.
     method := cd nextUshort.
-    cd skip: 8.
-    dataSize := cd nextUlong.
-    fileSize := cd nextUlong.
+    data := method = 0
+ ifTrue: [ Array new: 5 ]
+ ifFalse: [ Array new: 4 ].
+
+    data at: 3 put: date.
+
+    cd skip: 12.
+    data at: 2 put: cd nextUlong.
     fnsize := cd nextUshort.
     extra := cd nextUshort.
     comment := cd nextUshort.
     cd skip: 4.
     attr := cd nextUlong.
     ofs := cd nextUlong.
-    path := cd next: fnsize.
+
+    data at: 1 put: (cd next: fnsize).
     cd skip: extra + comment.
 
-    mode := (attr bitAnd: 16) = 16.
-    gen yield: { path. fileSize. date. mode } ] ]! !
-
+    data at: 4 put: (attr bitAnd: 16) = 16.
+    method = 0 ifTrue: [
+ data at: 5 put: (StoredZipMember new
+    name: (data at: 1);
+    parent: self;
+    offset: ofs;
+    yourself) ].
+
+    gen yield: data ] ]! !
+
+!StoredZipMember methodsFor: 'accessing'!
+
+offset
+    ^offset!
+
+offset: anInteger
+    offset := anInteger!
+
+!StoredZipMember methodsFor: 'opening'!
+
+open: class mode: mode ifFail: aBlock
+    | file |
+    file := self parent open: class mode: mode ifFail: [ ^aBlock value ].
+    file skip: self offset + 26.
+    file skip: file nextUshort + file nextUshort.
+    file setName: self fullName.
+    ^LimitedStream on: file from: file position to: file position + self size - 1! !
+
+!LimitedStream class methodsFor: 'instance creation'!
+
+on: aStream from: start to: end
+    ^self new
+ stream: aStream;
+ offset: start;
+ limit: end + 1;
+ yourself!
+
+!LimitedStream methodsFor: 'stream operations'!
+
+atEnd
+    ^stream position >= limit or: [ stream atEnd ]!
+
+isPositionable
+    ^true!
 
+next
+    self atEnd ifTrue: [ ^self pastEnd ].
+    ^stream next!
+
+nextHunk
+    ^stream next: (1024 min: limit - stream position)!
+
+peek
+    self atEnd ifTrue: [ ^nil ].
+    ^stream peek!
+
+peekFor: aCharacter
+    self atEnd ifTrue: [ ^false ].
+    ^stream peek!
+
+position
+    ^stream position - offset!
+
+position: anInteger
+    (anInteger between: 0 and: limit - offset)
+        ifTrue: [ stream position: offset + anInteger ]
+        ifFalse: [ SystemExceptions.IndexOutOfRange signalOn: self withIndex: anInteger ]!
+
+setToEnd
+    stream position: limit!
+
+size
+    ^limit - offset!
+
+skip: anInteger
+    self position: anInteger + self position! !
+
+!LimitedStream methodsFor: 'printing'!
+
+printOn: aStream
+    aStream
+ print: stream;
+ nextPut: $[;
+ print: offset;
+ nextPut: $:;
+ print: limit;
+ nextPut: $]! !
+
+!LimitedStream methodsFor: 'accessing'!
+
+name
+    ^stream name!
+
+species
+    ^stream species!
+
+stream: aStream
+    stream := aStream!
+
+limit: anInteger
+    limit := anInteger!
+
+offset: anInteger
+    offset := anInteger! !
+
 
-RealFileHandler initialize!
-DecodedFileHandler initialize!
-VFSHandler initialize!
 Namespace current: Smalltalk!
+
+VFS.RealFileHandler initialize!
+VFS.DecodedFileHandler initialize!
+VFS.VFSHandler initialize!


--- orig/scripts/Package.st
+++ mod/scripts/Package.st
@@ -135,12 +135,12 @@ File extend [
     emitZipDir: dir [
  | saveDir |
  self emitRemove.
- ('cd %1 && %2 -qr %3 .' % { dir. Command zip. self }) displayNl.
+ ('cd %1 && %2 -n .st:.xml -qr %3 .' % { dir. Command zip. self }) displayNl.
         saveDir := Directory working.
  Command
     execute: [
         Directory working: dir name.
- Smalltalk system: '%1 -qr %2 .' % { Command zip. self }
+ Smalltalk system: '%1 -n .st:.xml -qr %2 .' % { Command zip. self }
     ]
     ensure: [ Directory working: saveDir ]
     ]




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