[Help-smalltalk] Re: [PATCH] Store source code in .star files uncompressed

[Paolo Bonzini]

Paolo Bonzini wrote:
> 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

The patch...

Paolo

2007-07-23  Paolo Bonzini  <address@hidden>

        * 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 address@hidden/smalltalk--devo--2.2--patch-492 to compare with
* comparing to address@hidden/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 ]
     ]