The Trunk: Files-fbs.126.mcz

Frank Shearar uploaded a new version of Files to project The Trunk:
http://source.squeak.org/trunk/Files-fbs.126.mcz

==================== Summary ====================

Name: Files-fbs.126
Author: fbs
Time: 18 July 2013, 5:31:21.168 pm
UUID: 6e23579c-91ac-4c44-bf19-ee0462f33428
Ancestors: Files-fbs.125

Move CompressedSourceStream to Compression, making Files (in conjunction with System-fbs.570) independent of Compression.

Move FileDirectory methods to System (corresponding to the other half of System-fbs.570) to finish breaking Files -> Compression.

=============== Diff against Files-fbs.125 ===============

Item was removed:
- ReadWriteStream subclass: #CompressedSourceStream
- instanceVariableNames: 'segmentFile segmentSize nSegments segmentTable segmentIndex dirty endOfFile'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Files-System'!
-
- !CompressedSourceStream commentStamp: 'nice 3/24/2010 07:36' prior: 0!
- I implement a file format that compresses segment by segment to allow incremental writing and browsing.  Note that the file can only be written at the end.
-
- Structure:
- segmentFile The actual compressed file.
- segmentSize This is the quantum of compression.  The virtual file is sliced up
- into segments of this size.
- nSegments The maximum number of segments to which this file can be grown.
- endOfFile The user's endOfFile pointer.
- segmentTable When a file is open, this table holds the physical file positions
- of the compressed segments.
- segmentIndex Index of the most recently accessed segment.
-
- Inherited from ReadWriteStream...
- collection The segment buffer, uncompressed
- position This is the position *local* to the current segment buffer
- readLimit ReadLimit for the current buffer
- writeLimit WriteLimit for the current buffer
-
- Great care must be exercised to distinguish between the position relative to the segment buffer and the full file position (and, or course, the segment file position ;-).
-
- The implementation defaults to a buffer size of 20k, and a max file size of 34MB (conveniently chosen to be greater than the current 33MB limit of source code pointers).  The format of the file is as follows:
- segmentSize 4 bytes
- nSegments 4 bytes
- endOfFile 4 bytes
- segmentTable 4 bytes * (nSegments+1)
- beginning of first compressed segment
-
- It is possible to override the default allocation by sending the message #segmentSize:nSegments: immediately after opening a new file for writing, as follows:
-
- bigFile := (CompressedSourceStream on: (FileStream newFileNamed: 'biggy.stc'))
- segmentSize: 50000 maxSize: 200000000
-
- The difference between segment table entries reveals the size of each compressed segment.  When a file is being written, it may lack the final segment, but any flush, position:, or close will force a dirty segment to be written.!

Item was removed:
- ----- Method: CompressedSourceStream class>>on: (in category 'as yet unclassified') -----
- on: aFile
- ^ self basicNew openOn: aFile!

Item was removed:
- ----- Method: CompressedSourceStream>>atEnd (in category 'access') -----
- atEnd
-
- position >= readLimit ifFalse: [^ false].  "more in segment"
- ^ self position >= endOfFile  "more in file"!

Item was removed:
- ----- Method: CompressedSourceStream>>binary (in category 'open/close') -----
- binary
- self error: 'Compressed source files are ascii to the user (though binary underneath)'!

Item was removed:
- ----- Method: CompressedSourceStream>>close (in category 'open/close') -----
- close
- self flush.
- segmentFile close!

Item was removed:
- ----- Method: CompressedSourceStream>>contentsOfEntireFile (in category 'access') -----
- contentsOfEntireFile
- | contents |
- self position: 0.
- contents := self next: self size.
- self close.
- ^ contents!

Item was removed:
- ----- Method: CompressedSourceStream>>fileID (in category 'private') -----
- fileID  "Only needed for OSProcess stuff"
- ^ segmentFile fileID
- !

Item was removed:
- ----- Method: CompressedSourceStream>>firstSegmentLoc (in category 'private') -----
- firstSegmentLoc
- "First segment follows 3 header words and segment table"
- ^ (3 + nSegments+1) * 4!

Item was removed:
- ----- Method: CompressedSourceStream>>flush (in category 'access') -----
- flush
- dirty ifTrue:
- ["Write buffer, compressed, to file, and also write the segment offset and eof"
- self writeSegment].!

Item was removed:
- ----- Method: CompressedSourceStream>>next (in category 'access') -----
- next
- <primitive: 65>
- position >= readLimit
- ifTrue: [^ (self next: 1) at: 1]
- ifFalse: [^ collection at: (position := position + 1)]!

Item was removed:
- ----- Method: CompressedSourceStream>>next: (in category 'access') -----
- next: n
- | str |
- n <= (readLimit - position) ifTrue:
- ["All characters are available in buffer"
- str := collection copyFrom: position + 1 to: position + n.
- position := position + n.
- ^ str].
-
- "Read limit could be segment boundary or real end of file"
- (readLimit + self segmentOffset) = endOfFile ifTrue:
- ["Real end of file -- just return what's available"
- ^ self next: readLimit - position].
-
- "Read rest of segment.  Then (after positioning) read what remains"
- str := self next: readLimit - position.
- self position: self position.
- ^ str , (self next: n - str size)
- !

Item was removed:
- ----- Method: CompressedSourceStream>>nextChunk (in category 'access') -----
- nextChunk
- self flag: #workAround. "all accessors should decode utf8"
- ^super nextChunk utf8ToSqueak!

Item was removed:
- ----- Method: CompressedSourceStream>>nextPut: (in category 'access') -----
- nextPut: char
- "Slow, but we don't often write, and then not a lot"
- self nextPutAll: char asString.
- ^ char!

Item was removed:
- ----- Method: CompressedSourceStream>>nextPutAll: (in category 'access') -----
- nextPutAll: str
- | n nInSeg |
- n := str size.
- n <= (writeLimit - position) ifTrue:
- ["All characters fit in buffer"
- collection replaceFrom: position + 1 to: position + n with: str.
- dirty := true.
- position := position + n.
- readLimit := readLimit max: position.
- endOfFile := endOfFile max: self position.
- ^ str].
-
- "Write what fits in segment.  Then (after positioning) write what remains"
- nInSeg := writeLimit - position.
- nInSeg = 0
- ifTrue: [self position: self position.
- self nextPutAll: str]
- ifFalse: [self nextPutAll: (str first: nInSeg).
- self position: self position.
- self nextPutAll: (str allButFirst: nInSeg)].
- ^str
-
- !

Item was removed:
- ----- Method: CompressedSourceStream>>openOn: (in category 'open/close') -----
- openOn: aFile
- "Open the receiver."
- segmentFile := aFile.
- segmentFile binary.
- segmentFile size > 0
- ifTrue:
- [self readHeaderInfo.  "If file exists, then read the parameters"]
- ifFalse:
- [self segmentSize: 20000 maxSize: 34000000.  "Otherwise write default values"]!

Item was removed:
- ----- Method: CompressedSourceStream>>openReadOnly (in category 'open/close') -----
- openReadOnly
-
- segmentFile openReadOnly!

Item was removed:
- ----- Method: CompressedSourceStream>>position (in category 'access') -----
- position
-
- ^ position + self segmentOffset!

Item was removed:
- ----- Method: CompressedSourceStream>>position: (in category 'access') -----
- position: newPosition
- | compressedBuffer newSegmentIndex |
- newPosition > endOfFile ifTrue:
- [self error: 'Attempt to position beyond the end of file'].
- newSegmentIndex := (newPosition // segmentSize) + 1.
- newSegmentIndex ~= segmentIndex ifTrue:
- [self flush.
- segmentIndex := newSegmentIndex.
- newSegmentIndex > nSegments ifTrue:
- [self error: 'file size limit exceeded'].
- segmentFile position: (segmentTable at: segmentIndex).
- (segmentTable at: segmentIndex+1) = 0
- ifTrue:
- [newPosition ~= endOfFile ifTrue:
- [self error: 'Internal logic error'].
- collection size = segmentSize ifFalse:
- [self error: 'Internal logic error'].
- "just leave garbage beyond end of file"]
- ifFalse:
- [compressedBuffer := segmentFile next: ((segmentTable at: segmentIndex+1) - (segmentTable at: segmentIndex)).
- collection :=  (GZipReadStream on: compressedBuffer) upToEnd asString].
- readLimit := collection size min: endOfFile - self segmentOffset].
- position := newPosition \\ segmentSize.
- !

Item was removed:
- ----- Method: CompressedSourceStream>>readHeaderInfo (in category 'open/close') -----
- readHeaderInfo
- | valid a b |
- segmentFile position: 0.
- segmentSize := segmentFile nextNumber: 4.
- nSegments := segmentFile nextNumber: 4.
- endOfFile := segmentFile nextNumber: 4.
- segmentFile size < (nSegments+1 + 3 * 4) ifTrue: "Check for reasonable segment info"
- [self error: 'This file is not in valid compressed source format'].
- segmentTable := (1 to: nSegments+1) collect: [:x | segmentFile nextNumber: 4].
- segmentTable first ~= self firstSegmentLoc ifTrue:
- [self error: 'This file is not in valid compressed source format'].
- valid := true.
- 1 to: nSegments do:  "Check that segment offsets are ascending"
- [:i | a := segmentTable at: i.  b := segmentTable at: i+1.
- (a = 0 and: [b ~= 0]) ifTrue: [valid := false].
- (a ~= 0 and: [b ~= 0]) ifTrue: [b <= a ifTrue: [valid := false]]].
- valid ifFalse:
- [self error: 'This file is not in valid compressed source format'].
- dirty := false.
- self position: 0.!

Item was removed:
- ----- Method: CompressedSourceStream>>readOnlyCopy (in category 'open/close') -----
- readOnlyCopy
-
- ^ self class on: segmentFile readOnlyCopy!

Item was removed:
- ----- Method: CompressedSourceStream>>segmentOffset (in category 'private') -----
- segmentOffset
-
- ^ segmentIndex - 1 * segmentSize!

Item was removed:
- ----- Method: CompressedSourceStream>>segmentSize:maxSize: (in category 'private') -----
- segmentSize: segSize maxSize: maxSize
- "Note that this method can be called after the initial open, provided that no
- writing has yet taken place.  This is how to override the default segmentation."
- self size = 0 ifFalse: [self error: 'Cannot set parameters after the first write'].
- segmentFile position: 0.
- segmentFile nextNumber: 4 put: (segmentSize := segSize).
- segmentFile nextNumber: 4 put: (nSegments := maxSize // segSize + 2).
- segmentFile nextNumber: 4 put: (endOfFile := 0).
- segmentTable := Array new: nSegments+1 withAll: 0.
- segmentTable at: 1 put: self firstSegmentLoc.  "Loc of first segment, always."
- segmentTable do: [:i | segmentFile nextNumber: 4 put: i].
- segmentIndex := 1.
- collection := String new: segmentSize.
- writeLimit := segmentSize.
- readLimit := 0.
- position := 0.
- endOfFile := 0.
- self writeSegment.
- !

Item was removed:
- ----- Method: CompressedSourceStream>>size (in category 'access') -----
- size
- ^ endOfFile ifNil: [0]!

Item was removed:
- ----- Method: CompressedSourceStream>>test (in category 'open/close') -----
- test
- "FileDirectory default deleteFileNamed: 'test.stc'.
- (CompressedSourceStream on: (FileStream newFileNamed: 'test.stc')) fileOutChanges"
-
- "FileDirectory default deleteFileNamed: 'test2.stc'.
- ((CompressedSourceStream on: (FileStream newFileNamed: 'test2.stc'))
- segmentSize: 100 nSegments: 1000) fileOutChanges"
-
- "FileDirectory default deleteFileNamed: 'test3.st'.
- (FileStream newFileNamed: 'test3.st') fileOutChanges"
-
- "(CompressedSourceStream on: (FileStream oldFileNamed: 'test.stc')) contentsOfEntireFile"
- !

Item was removed:
- ----- Method: CompressedSourceStream>>writeSegment (in category 'private') -----
- writeSegment
- "The current segment must be the last in the file."
- | compressedSegment |
- segmentFile position: (segmentTable at: segmentIndex).
- compressedSegment := ByteArray streamContents:
- [:strm | (GZipWriteStream on: strm) nextPutAll: collection asByteArray; close].
- segmentFile nextPutAll: compressedSegment.
- segmentTable at: segmentIndex + 1 put: segmentFile position.
-
- segmentFile position: 2 * 4.
- segmentFile nextNumber: 4 put: endOfFile.
- segmentFile position: (segmentIndex + 3) * 4.
- segmentFile nextNumber: 4 put: (segmentTable at: segmentIndex + 1).
- dirty := false!

Item was removed:
- ----- Method: FileDirectory class>>openChanges:forImage: (in category 'system start up') -----
- openChanges: changesName forImage: imageName
- "find the changes file by looking in
- a) the directory derived from the image name
- b) the DefaultDirectory (which will normally be the directory derived from the image name or the SecurityManager's choice)
- If an old file is not found in either place, check for a read-only file in the same places. If that fails, return nil"
- | changes fd |
- "look for the changes file or an alias to it in the image directory"
- fd := FileDirectory on: (FileDirectory dirPathFor: imageName).
- (fd fileExists: changesName)
- ifTrue: [changes := fd oldFileNamed: changesName].
- changes ifNotNil:[^changes].
-
- "look for the changes in the default directory"
- fd := DefaultDirectory.
- (fd fileExists: changesName)
- ifTrue: [changes := fd oldFileNamed: changesName].
- changes ifNotNil:[^changes].
-
- "look for read-only changes in the image directory"
- fd := FileDirectory on: (FileDirectory dirPathFor: imageName).
- (fd fileExists: changesName)
- ifTrue: [changes := fd readOnlyFileNamed: changesName].
- changes ifNotNil:[^changes].
-
- "look for read-only changes in the default directory"
- fd := DefaultDirectory.
- (fd fileExists: changesName)
- ifTrue: [changes := fd readOnlyFileNamed: changesName].
- "this may be nil if the last try above failed to open a file"
- ^changes
- !

Item was removed:
- ----- Method: FileDirectory class>>openSources:andChanges:forImage: (in category 'system start up') -----
- openSources: sourcesName andChanges: changesName forImage: imageName
- "Open the changes and sources files and install them in SourceFiles. Inform the user of problems regarding write permissions or CR/CRLF mixups."
- "Note: SourcesName and imageName are full paths; changesName is a  
- local name."
- | sources changes msg wmsg |
- msg := 'Squeak cannot locate &fileRef.
-
- Please check that the file is named properly and is in the
- same directory as this image.'.
- wmsg := 'Squeak cannot write to &fileRef.
-
- Please check that you have write permission for this file.
-
- You won''t be able to save this image correctly until you fix this.'.
-
- sources := self openSources: sourcesName forImage: imageName.
- changes := self openChanges: changesName forImage: imageName.
-
- ((sources == nil or: [sources atEnd])
- and: [Preferences valueOfFlag: #warnIfNoSourcesFile])
- ifTrue: [SmalltalkImage current platformName = 'Mac OS'
- ifTrue: [msg := msg , '
- Make sure the sources file is not an Alias.'].
- self inform: (msg copyReplaceAll: '&fileRef' with: 'the sources file named ' , sourcesName)].
-
- (changes == nil
- and: [Preferences valueOfFlag: #warnIfNoChangesFile])
- ifTrue: [self inform: (msg copyReplaceAll: '&fileRef' with: 'the changes file named ' , changesName)].
-
- ((Preferences valueOfFlag: #warnIfNoChangesFile) and: [changes notNil])
- ifTrue: [changes isReadOnly
- ifTrue: [self inform: (wmsg copyReplaceAll: '&fileRef' with: 'the changes file named ' , changesName)].
-
- ((changes next: 200)
- includesSubString: String crlf)
- ifTrue: [self inform: 'The changes file named ' , changesName , '
- has been injured by an unpacking utility.  Crs were changed to CrLfs.
- Please set the preferences in your decompressing program to
- "do not convert text files" and unpack the system again.']].
-
- SourceFiles := Array with: sources with: changes!

Item was removed:
- ----- Method: FileDirectory class>>setDefaultDirectory: (in category 'system start up') -----
- setDefaultDirectory: directoryName
- "Initialize the default directory to the directory supplied. This method is called when the image starts up."
- | dirName |
- DirectoryClass := self activeDirectoryClass.
- dirName := (FilePath pathName: directoryName) asSqueakPathName.
- [dirName endsWith: self slash] whileTrue:[
- dirName := dirName copyFrom: 1 to: dirName size - self slash size.
- ].
- DefaultDirectory := self on: dirName.!

Item was removed:
- ----- Method: FileStream class>>fileIn: (in category 'file reader services') -----
- fileIn: fullName
- "File in the entire contents of the file specified by the name provided"
-
- | ff |
- fullName ifNil: [^ Beeper beep].
- ff := self readOnlyFileNamed: (GZipReadStream uncompressedFileName: fullName).
- ff fileIn.
- !