[squeak-dev] The Trunk: System-fbs.648.mcz

commits at source.squeak.org commits at source.squeak.org
Sat Dec 28 22:21:50 UTC 2013


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

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

Name: System-fbs.648
Author: fbs
Time: 28 December 2013, 10:20:54.933 pm
UUID: 18ce54b4-61ee-c247-924d-9c202cbf4a32
Ancestors: System-nice.647

Move all of Collections' file in/out logic to System, where the other file in/out logic lives (in System-Object Storage and friends).

=============== Diff against System-nice.647 ===============

Item was added:
+ ----- Method: Array>>objectForDataStream: (in category '*System-Object Storage-file in/out') -----
+ objectForDataStream: refStrm
+ 	| dp |
+ 	"I am about to be written on an object file.  If I am one of two shared global arrays, write a proxy instead."
+ 
+ self == (TextConstants at: #DefaultTabsArray) ifTrue: [
+ 	dp := DiskProxy global: #TextConstants selector: #at: args: #(DefaultTabsArray).
+ 	refStrm replace: self with: dp.
+ 	^ dp].
+ self == (TextConstants at: #DefaultMarginTabsArray) ifTrue: [
+ 	dp := DiskProxy global: #TextConstants selector: #at: args: #(DefaultMarginTabsArray).
+ 	refStrm replace: self with: dp.
+ 	^ dp].
+ ^ super objectForDataStream: refStrm!

Item was added:
+ ----- Method: Association>>objectForDataStream: (in category '*System-Object Storage-objects from disk') -----
+ objectForDataStream: refStrm
+ 	| dp |
+ 	"I am about to be written on an object file.  If I am a known global, write a proxy that will hook up with the same resource in the destination system."
+ 
+ 	^ (Smalltalk globals associationAt: key ifAbsent: [nil]) == self 
+ 		ifTrue: [dp := DiskProxy global: #Smalltalk selector: #associationOrUndeclaredAt: 
+ 							args: (Array with: key).
+ 			refStrm replace: self with: dp.
+ 			dp]
+ 		ifFalse: [self]!

Item was added:
+ ----- Method: PositionableStream>>backChunk (in category '*System-Changes-fileIn/Out') -----
+ backChunk
+ 	"Answer the contents of the receiver back to the previous terminator character.  Doubled terminators indicate an embedded terminator character."
+ 
+ 	| output character |
+ 	output := WriteStream on: (String new: 1000).
+ 	self back. "oldBack compatibility"
+ 	[ (character := self back) == nil ] whileFalse: [
+ 		character == $!! ifTrue: [
+ 			self back == $!! ifFalse: [ 
+ 				self skip: 2. "oldBack compatibility"
+ 				^output contents reversed ] ].
+ 		output nextPut: character].
+ 	self skip: 1. "oldBack compatibility"
+ 	^output contents reversed!

Item was added:
+ ----- Method: PositionableStream>>basicNextChunk (in category '*System-Changes-fileIn/Out') -----
+ basicNextChunk
+ 	"Answer the contents of the receiver, up to the next terminator character. Doubled terminators indicate an embedded terminator character."
+ 	| terminator out ch |
+ 	terminator := $!!.
+ 	out := WriteStream on: (String new: 1000).
+ 	self skipSeparators.
+ 	[(ch := self next) == nil] whileFalse: [
+ 		(ch == terminator) ifTrue: [
+ 			self peek == terminator ifTrue: [
+ 				self next.  "skip doubled terminator"
+ 			] ifFalse: [
+ 				^ out contents  "terminator is not doubled; we're done!!"
+ 			].
+ 		].
+ 		out nextPut: ch.
+ 	].
+ 	^ out contents!

Item was added:
+ ----- Method: PositionableStream>>checkForPreamble: (in category '*System-Changes-fileIn/Out') -----
+ checkForPreamble: chunk
+ 	((chunk beginsWith: '"Change Set:') and: [ChangeSet current preambleString == nil])
+ 		ifTrue: [ChangeSet current preambleString: chunk].
+ 	((chunk beginsWith: '"Postscript:') and: [ChangeSet current postscriptString == nil])
+ 		ifTrue: [ChangeSet current postscriptString: chunk].
+ 							
+ !

Item was added:
+ ----- Method: PositionableStream>>command: (in category '*System-Changes-fileIn/Out') -----
+ command: aString
+ 	"Overridden by HtmlFileStream to append commands directly without translation.  4/5/96 tk"
+ 	"We ignore any HTML commands.  Do nothing"!

Item was added:
+ ----- Method: PositionableStream>>copyMethodChunkFrom: (in category '*System-Changes-fileIn/Out') -----
+ copyMethodChunkFrom: aStream
+ 	"Copy the next chunk from aStream (must be different from the receiver)."
+ 	| chunk |
+ 	chunk := aStream nextChunkText.
+ 	chunk runs values size = 1 "Optimize for unembellished text"
+ 		ifTrue: [self nextChunkPut: chunk asString]
+ 		ifFalse: [self nextChunkPutWithStyle: chunk]!

Item was added:
+ ----- Method: PositionableStream>>copyMethodChunkFrom:at: (in category '*System-Changes-fileIn/Out') -----
+ copyMethodChunkFrom: aStream at: pos
+ 	"Copy the next chunk from aStream (must be different from the receiver)."
+ 	| chunk |
+ 	aStream position: pos.
+ 	chunk := aStream nextChunkText.
+ 	chunk runs values size = 1 "Optimize for unembellished text"
+ 		ifTrue: [self nextChunkPut: chunk asString]
+ 		ifFalse: [self nextChunkPutWithStyle: chunk]!

Item was added:
+ ----- Method: PositionableStream>>copyPreamble:from:at: (in category '*System-Changes-fileIn/Out') -----
+ copyPreamble: preamble from: aStream at: pos 
+ 	"Look for a changeStamp for this method by peeking backward.
+ 	Write a method preamble, with that stamp if found."
+ 	| terminator last50 stamp i |
+ 	terminator := $!!.
+ 
+ 	"Look back to find stamp in old preamble, such as...
+ 	Polygon methodsFor: 'private' stamp: 'di 6/25/97 21:42' prior: 34957598!! "
+ 	aStream position: pos.
+ 	aStream backChunk.	"to beginning of method"
+ 	last50 := aStream backChunk.	"to get preamble"
+ 	aStream position: pos.
+ 	stamp := String new.
+ 	(i := last50 
+ 		findLastOccurrenceOfString: 'stamp:'
+ 		startingAt: 1) > 0 ifTrue: 
+ 		[ stamp := (last50 
+ 			copyFrom: i + 8
+ 			to: last50 size) copyUpTo: $' ].
+ 
+ 	"Write the new preamble, with old stamp if any."
+ 	self
+ 		cr;
+ 		nextPut: terminator.
+ 	self nextChunkPut: (String streamContents: 
+ 			[ :strm | 
+ 			strm nextPutAll: preamble.
+ 			stamp size > 0 ifTrue: 
+ 				[ strm
+ 					nextPutAll: ' stamp: ';
+ 					print: stamp ] ]).
+ 	self cr!

Item was added:
+ ----- Method: PositionableStream>>decodeString:andRuns: (in category '*System-Changes-fileIn/Out') -----
+ decodeString: string andRuns: runsRaw
+ 
+ 	| strm runLength runValues newString index |
+ 	strm := runsRaw readStream.
+ 	(strm peekFor: $( ) ifFalse: [^ nil].
+ 	runLength := OrderedCollection new.
+ 	[strm skipSeparators.
+ 	 strm peekFor: $)] whileFalse: 
+ 		[runLength add: (Number readFrom: strm)].
+ 
+ 	runValues := OrderedCollection new.
+ 	[strm atEnd not] whileTrue: 
+ 		[runValues add: (Number readFrom: strm).
+ 		strm next.].
+ 
+ 	newString := WideString new: string size.
+ 	index := 1.
+ 	runLength with: runValues do: [:length :leadingChar |
+ 		index to: index + length - 1 do: [:pos |
+ 			newString at: pos put: (Character leadingChar: leadingChar code: (string at: pos) charCode).
+ 		].
+ 		index := index + length.
+ 	].
+ 
+ 	^ newString.
+ !

Item was added:
+ ----- Method: PositionableStream>>decodeStyle:version: (in category '*System-Changes-fileIn/Out') -----
+ decodeStyle: runsObjData version: styleVersion
+ 	"Decode the runs array from the ReferenceStream it is stored in."
+ 	"Verify that the class mentioned have the same inst vars as we have now"
+ 
+ 	| structureInfo |
+ 	styleVersion = RemoteString currentTextAttVersion ifTrue: [
+ 		"Matches our classes, no need for checking"
+ 		^ (ReferenceStream on: runsObjData) next].
+ 	structureInfo := RemoteString structureAt: styleVersion.	"or nil"
+ 		"See SmartRefStream instVarInfo: for dfn"
+ 	^ SmartRefStream read: runsObjData withClasses: structureInfo!

Item was added:
+ ----- Method: PositionableStream>>fileIn (in category '*System-Changes-fileIn/Out') -----
+ fileIn
+ 	"This is special for reading expressions from text that has been formatted 
+ 	with exclamation delimitors. The expressions are read and passed to the 
+ 	Compiler. Answer the result of compilation."
+ 
+ 	^ self fileInAnnouncing: 'Reading ' , self name!

Item was added:
+ ----- Method: PositionableStream>>fileInAnnouncing: (in category '*System-Changes-fileIn/Out') -----
+ fileInAnnouncing: announcement 
+ 	"This is special for reading expressions from text that has been formatted 
+ 	with exclamation delimitors. The expressions are read and passed to the 
+ 	Compiler. Answer the result of compilation.  Put up a progress report with
+      the given announcement as the title."
+ 
+ 	| val |
+ 	announcement 
+ 		displayProgressFrom: 0
+ 		to: self size
+ 		during: 
+ 			[:bar | 
+ 			[self atEnd] whileFalse: 
+ 					[bar value: self position.
+ 					self skipSeparators.
+ 					
+ 					[ | chunk |
+ 					val := (self peekFor: $!!) 
+ 								ifTrue: [(Compiler evaluate: self nextChunk logged: false) scanFrom: self]
+ 								ifFalse: 
+ 									[chunk := self nextChunk.
+ 									self checkForPreamble: chunk.
+ 									Compiler evaluate: chunk logged: true]] 
+ 							on: InMidstOfFileinNotification
+ 							do: [:ex | ex resume: true].
+ 					self skipStyleChunk].
+ 			self close].
+ 	"Note:  The main purpose of this banner is to flush the changes file."
+ 	Smalltalk logChange: '----End fileIn of ' , self name , '----'.
+ 	self flag: #ThisMethodShouldNotBeThere.	"sd"
+ 	^val!

Item was added:
+ ----- Method: PositionableStream>>fileInFor:announcing: (in category '*System-Changes-fileIn/Out') -----
+ fileInFor: client announcing: announcement
+ 	"This is special for reading expressions from text that has been formatted 
+ 	with exclamation delimitors. The expressions are read and passed to the 
+ 	Compiler. Answer the result of compilation.  Put up a progress report with
+      the given announcement as the title.
+ 	Does NOT handle preambles or postscripts specially."
+ 	| val |
+ 	announcement
+ 		displayProgressFrom: 0
+ 		to: self size
+ 		during:
+ 		[:bar |
+ 		[self atEnd]
+ 			whileFalse: 
+ 				[bar value: self position.
+ 				self skipSeparators.
+ 				[ | chunk |
+ 				val := (self peekFor: $!!) ifTrue: [
+ 						(Compiler evaluate: self nextChunk for: client logged: false) scanFrom: self
+ 					] ifFalse: [
+ 						chunk := self nextChunk.
+ 						self checkForPreamble: chunk.
+ 						Compiler evaluate: chunk for: client logged: true ].
+ 				] on: InMidstOfFileinNotification
+ 				  do: [ :ex | ex resume: true].
+ 				self atEnd ifFalse: [ self skipStyleChunk ]].
+ 		self close].
+ 	"Note:  The main purpose of this banner is to flush the changes file."
+ 	Smalltalk logChange: '----End fileIn of ' , self name , '----'.
+ 	^ val!

Item was added:
+ ----- Method: PositionableStream>>fileInSilentlyAnnouncing: (in category '*System-Changes-fileIn/Out') -----
+ fileInSilentlyAnnouncing: announcement 
+ 	"This is special for reading expressions from text that has been formatted 
+ 	with exclamation delimitors. The expressions are read and passed to the 
+ 	Compiler. Answer the result of compilation.  Put up a progress report with
+      the given announcement as the title."
+ 
+ 	| val chunk |
+ 	[self atEnd] whileFalse: 
+ 			[self skipSeparators.
+ 			
+ 			[val := (self peekFor: $!!) 
+ 						ifTrue: [(Compiler evaluate: self nextChunk logged: false) scanFrom: self]
+ 						ifFalse: 
+ 							[chunk := self nextChunk.
+ 							self checkForPreamble: chunk.
+ 							Compiler evaluate: chunk logged: true]] 
+ 					on: InMidstOfFileinNotification
+ 					do: [:ex | ex resume: true].
+ 			self skipStyleChunk].
+ 	self close.
+ 	"Note:  The main purpose of this banner is to flush the changes file."
+ 	Smalltalk  logChange: '----End fileIn of ' , self name , '----'.
+ 	self flag: #ThisMethodShouldNotBeThere.	"sd"
+ 	SystemNavigation new allBehaviorsDo: 
+ 			[:cl | 
+ 			cl
+ 				removeSelectorSimply: #DoIt;
+ 				removeSelectorSimply: #DoItIn:].
+ 	^val!

Item was added:
+ ----- Method: PositionableStream>>header (in category '*System-Changes-fileIn/Out') -----
+ header
+ 	"If the stream requires a standard header, override this message.  See HtmlFileStream"!

Item was added:
+ ----- Method: PositionableStream>>nextChunk (in category '*System-Changes-fileIn/Out') -----
+ nextChunk
+ 	"Answer the contents of the receiver, up to the next terminator character. Doubled terminators indicate an embedded terminator character."
+ 	| terminator out ch |
+ 	terminator := $!!.
+ 	out := WriteStream on: (String new: 1000).
+ 	self skipSeparators.
+ 	[(ch := self next) == nil] whileFalse: [
+ 		(ch == terminator) ifTrue: [
+ 			self peek == terminator ifTrue: [
+ 				self next.  "skip doubled terminator"
+ 			] ifFalse: [
+ 				^ self parseLangTagFor: out contents  "terminator is not doubled; we're done!!"
+ 			].
+ 		].
+ 		out nextPut: ch.
+ 	].
+ 	^ self parseLangTagFor: out contents.
+ !

Item was added:
+ ----- Method: PositionableStream>>nextChunkText (in category '*System-Changes-fileIn/Out') -----
+ nextChunkText
+ 	"Deliver the next chunk as a Text.  Decode the following ]style[ chunk if present.  Position at start of next real chunk."
+ 	| string runs peek pos |
+ 	"Read the plain text"
+ 	string := self nextChunk.
+ 	
+ 	"Test for ]style[ tag"
+ 	pos := self position.
+ 	peek := self skipSeparatorsAndPeekNext.
+ 	peek = $] ifFalse: [self position: pos. ^ string asText].  "no tag"
+ 	(self upTo: $[) = ']style' ifFalse: [self position: pos. ^ string asText].  "different tag"
+ 
+ 	"Read and decode the style chunk"
+ 	runs := RunArray scanFrom: self basicNextChunk readStream.
+ 
+ 	^ Text basicNew setString: string setRunsChecking: runs.
+ !

Item was added:
+ ----- Method: PositionableStream>>parseLangTagFor: (in category '*System-Changes-fileIn/Out') -----
+ parseLangTagFor: aString
+ 
+ 	| string peek runsRaw pos |
+ 	string := aString.
+ 	"Test for ]lang[ tag"
+ 	pos := self position.
+ 	peek := self skipSeparatorsAndPeekNext.
+ 	peek = $] ifFalse: [self position: pos. ^ string].  "no tag"
+ 	(self upTo: $[) = ']lang' ifTrue: [
+ 		runsRaw := self basicNextChunk.
+ 		string := self decodeString: aString andRuns: runsRaw
+ 	] ifFalse: [
+ 		self position: pos
+ 	].
+ 	^ string.
+ !

Item was added:
+ ----- Method: PositionableStream>>skipSeparatorsAndPeekNext (in category '*System-Changes-fileIn/Out') -----
+ skipSeparatorsAndPeekNext
+ 	"A special function to make nextChunk fast"
+ 	| peek |
+ 	[self atEnd]
+ 		whileFalse:
+ 		[(peek := self next) isSeparator
+ 			ifFalse: [self position: self position-1. ^ peek]]!

Item was added:
+ ----- Method: PositionableStream>>skipStyleChunk (in category '*System-Changes-fileIn/Out') -----
+ skipStyleChunk
+ 	"Get to the start of the next chunk that is not a style for the previous chunk"
+ 
+ 	| pos |
+ 	pos := self position.
+ 	self skipSeparators.
+ 	self peek == $] 
+ 		ifTrue: [(self upTo: $[) = ']text' 	"old -- no longer needed"
+ 				"now positioned past the open bracket"
+ 			ifFalse: [self nextChunk]]	"absorb ]style[ and its whole chunk"
+ 				
+ 		ifFalse: [self position: pos]	"leave untouched"
+ !

Item was added:
+ ----- Method: PositionableStream>>trailer (in category '*System-Changes-fileIn/Out') -----
+ trailer
+ 	"If the stream requires a standard trailer, override this message.  See HtmlFileStream"!

Item was added:
+ ----- Method: PositionableStream>>unCommand (in category '*System-Changes-fileIn/Out') -----
+ unCommand
+ 	"If this read stream is at a <, then skip up to just after the next >.  For removing html commands."
+ 	| char |
+ 	[self peek = $<] whileTrue: ["begin a block"
+ 		[self atEnd == false and: [self next ~= $>]] whileTrue.
+ 		"absorb characters"
+ 		].
+  !

Item was added:
+ ----- Method: PositionableStream>>verbatim: (in category '*System-Changes-fileIn/Out') -----
+ verbatim: aString
+ 	"Do not attempt to translate the characters.  Use to override nextPutAll:"
+ 	^ self nextPutAll: aString!

Item was added:
+ ----- Method: ReadWriteStream>>fileInObjectAndCode (in category '*System-Object Storage-fileIn/Out') -----
+ fileInObjectAndCode
+ 	"This file may contain:
+ 1) a fileIn of code  
+ 2) just an object in SmartReferenceStream format 
+ 3) both code and an object.
+ 	File it in and return the object.  Note that self must be a FileStream or RWBinaryOrTextStream.  Maybe ReadWriteStream incorporate RWBinaryOrTextStream?"
+ 	| refStream object |
+ 	self text.
+ 	self peek asciiValue = 4
+ 		ifTrue: [  "pure object file"
+ 			refStream := SmartRefStream on: self.
+ 			object := refStream nextAndClose]
+ 		ifFalse: [  "objects mixed with a fileIn"
+ 			self fileIn.  "reads code and objects, then closes the file"
+ 			object := SmartRefStream scannedObject].	"set by side effect of one of the chunks"
+ 	SmartRefStream scannedObject: nil.  "clear scannedObject"
+ 	^ object!

Item was added:
+ ----- Method: ReadWriteStream>>fileNameEndsWith: (in category '*System-Object Storage-fileIn/Out') -----
+ fileNameEndsWith: aString
+ 	"See comment in FileStream fileNameEndsWith:"
+ 
+ 	^false!

Item was added:
+ ----- Method: ReadWriteStream>>fileOutChangeSet:andObject: (in category '*System-Object Storage-fileIn/Out') -----
+ fileOutChangeSet: aChangeSetOrNil andObject: theObject
+ 	"Write a file that has both the source code for the named class and an object as bits.  Any instance-specific object will get its class written automatically."
+ 
+ 	"An experimental version to fileout a changeSet first so that a project can contain its own classes"
+ 
+ 
+ 	self setFileTypeToObject.
+ 		"Type and Creator not to be text, so can attach correctly to an email msg"
+ 	self header; timeStamp.
+ 
+ 	aChangeSetOrNil ifNotNil: [
+ 		aChangeSetOrNil fileOutPreambleOn: self.
+ 		aChangeSetOrNil fileOutOn: self.
+ 		aChangeSetOrNil fileOutPostscriptOn: self.
+ 	].
+ 	self trailer.	"Does nothing for normal files.  HTML streams will have trouble with object data"
+ 
+ 	"Append the object's raw data"
+ 	(SmartRefStream on: self)
+ 		nextPut: theObject;  "and all subobjects"
+ 		close.		"also closes me"
+ !

Item was added:
+ ----- Method: ReadWriteStream>>fileOutChanges (in category '*System-Object Storage-fileIn/Out') -----
+ fileOutChanges
+ 	"Append to the receiver a description of all class changes."
+ 	Cursor write showWhile:
+ 		[self header; timeStamp.
+ 		ChangeSet current fileOutOn: self.
+ 		self trailer; close]!

Item was added:
+ ----- Method: ReadWriteStream>>fileOutClass:andObject: (in category '*System-Object Storage-fileIn/Out') -----
+ fileOutClass: extraClass andObject: theObject
+ 	"Write a file that has both the source code for the named class and an object as bits.  Any instance-specific object will get its class written automatically."
+ 
+ 	| class srefStream |
+ 	self setFileTypeToObject.
+ 		"Type and Creator not to be text, so can attach correctly to an email msg"
+ 	self text.
+ 	self header; timeStamp.
+ 
+ 	extraClass ifNotNil: [
+ 		class := extraClass.	"A specific class the user wants written"
+ 		class sharedPools size > 0 ifTrue:
+ 			[class shouldFileOutPools
+ 				ifTrue: [class fileOutSharedPoolsOn: self]].
+ 		class fileOutOn: self moveSource: false toFile: 0].
+ 	self trailer.	"Does nothing for normal files.  HTML streams will have trouble with object data"
+ 	self binary.
+ 
+ 	"Append the object's raw data"
+ 	srefStream := SmartRefStream on: self.
+ 	srefStream nextPut: theObject.  "and all subobjects"
+ 	srefStream close.		"also closes me"
+ !

Item was added:
+ ----- Method: ReadWriteStream>>fileOutClass:andObject:blocking: (in category '*System-Object Storage-fileIn/Out') -----
+ fileOutClass: extraClass andObject: theObject blocking: anIdentDict
+ 	"Write a file that has both the source code for the named class and an object as bits.  Any instance-specific object will get its class written automatically.  Accept a list of objects to map to nil or some other object (blockers).  In addition to teh choices in each class's objectToStoreOnDataStream"
+ 
+ 	| class srefStream |
+ 	self setFileTypeToObject.
+ 		"Type and Creator not to be text, so can attach correctly to an email msg"
+ 	self header; timeStamp.
+ 
+ 	extraClass ifNotNil: [
+ 		class := extraClass.	"A specific class the user wants written"
+ 		class sharedPools size > 0 ifTrue:
+ 			[class shouldFileOutPools
+ 				ifTrue: [class fileOutSharedPoolsOn: self]].
+ 		class fileOutOn: self moveSource: false toFile: 0].
+ 	self trailer.	"Does nothing for normal files.  HTML streams will have trouble with object data"
+ 
+ 	"Append the object's raw data"
+ 	srefStream := SmartRefStream on: self.
+ 	srefStream blockers: anIdentDict.
+ 	srefStream nextPut: theObject.  "and all subobjects"
+ 	srefStream close.		"also closes me"
+ !

Item was added:
+ ----- Method: SmartRefStream>>abstractStringx0 (in category 'strings-conversion') -----
+ abstractStringx0
+ 
+ 	^ String!

Item was added:
+ ----- Method: SmartRefStream>>multiStringx0 (in category 'strings-conversion') -----
+ multiStringx0
+ 
+ 	^ WideString!

Item was added:
+ ----- Method: SmartRefStream>>multiSymbolx0 (in category 'strings-conversion') -----
+ multiSymbolx0
+ 
+ 	^ WideSymbol!



More information about the Squeak-dev mailing list