[squeak-dev] The Trunk: Files-fbs.126.mcz

commits at source.squeak.org commits at source.squeak.org
Thu Jul 18 18:10:51 UTC 2013


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.
- !



More information about the Squeak-dev mailing list