Packages April 2017

packages@lists.squeakfoundation.org

1 participants
121 discussions

The Trunk: Files-nice.170.mcz
by commits＠source.squeak.org 26 Apr '17

26 Apr '17

Nicolas Cellier uploaded a new version of Files to project The Trunk: http://source.squeak.org/trunk/Files-nice.170.mcz ==================== Summary ==================== Name: Files-nice.170 Author: nice Time: 26 April 2017, 11:01:48.184504 pm UUID: 16f1903f-4a56-4f35-b737-dbb16a9022ae Ancestors: Files-ul.169 Classify a few 'as yet unclassified' methods =============== Diff against Files-ul.169 =============== Item was changed: + ----- Method: DosFileDirectory>>checkName:fixErrors: (in category 'file name utilities') ----- - ----- Method: DosFileDirectory>>checkName:fixErrors: (in category 'as yet unclassified') ----- checkName: aFileName fixErrors: fixing "Check if the file name contains any invalid characters" | fName badChars hasBadChars | fName := super checkName: aFileName fixErrors: fixing. badChars := #( $: $< $> $| $/ $\ $? $* $") asSet. hasBadChars := fName includesAnyOf: badChars. (hasBadChars and:[fixing not]) ifTrue:[^self error:'Invalid file name']. hasBadChars ifFalse:[^ fName]. ^ fName collect: [:char | (badChars includes: char) ifTrue:[$#] ifFalse:[char]]! Item was changed: + ----- Method: DosFileDirectory>>setPathName: (in category 'private') ----- - ----- Method: DosFileDirectory>>setPathName: (in category 'as yet unclassified') ----- setPathName: pathString "Ensure pathString is absolute - relative directories aren't supported on all platforms." (pathString isEmpty or: [pathString first = $\ or: [pathString size >= 2 and: [pathString second = $: and: [pathString first isLetter]]]]) ifTrue: [^ super setPathName: pathString]. self error: 'Fully qualified path expected'! Item was changed: + ----- Method: InvalidDirectoryError>>defaultAction (in category 'handling') ----- - ----- Method: InvalidDirectoryError>>defaultAction (in category 'exceptionDescription') ----- defaultAction "Return an empty list as the default action of signaling the occurance of an invalid directory." ^#()! Item was changed: + ----- Method: MacFileDirectory>>fullNameFor: (in category 'file name utilities') ----- - ----- Method: MacFileDirectory>>fullNameFor: (in category 'as yet unclassified') ----- fullNameFor: fileName "Return a corrected, fully-qualified name for the given file name. If the given name is already a full path (i.e., it contains a delimiter character), assume it is already a fully-qualified name. Otherwise, prefix it with the path to this directory. In either case, correct the local part of the file name." "Details: Note that path relative to a directory, such as '../../foo' are disallowed by this algorithm. Also note that this method is tolerent of a nil argument -- is simply returns nil in this case." "Fix by hmm: for a file in the root directory of a volume on MacOS, the filePath (name of the directory) is not recognizable as an absolute path anymore (it has no delimiters). Therefore, the original fileName is tested for absoluteness, and the filePath is only made absolute if the original fileName was not absolute" | correctedLocalName prefix | fileName isEmptyOrNil ifTrue: [^ fileName]. DirectoryClass splitName: fileName to: [:filePath :localName | correctedLocalName := localName isEmpty ifFalse: [self checkName: localName fixErrors: true] ifTrue: [localName]. prefix := (DirectoryClass isAbsolute: fileName) ifTrue: [filePath] ifFalse: [self fullPathFor: filePath]]. prefix isEmpty ifTrue: [^correctedLocalName]. prefix last = self pathNameDelimiter ifTrue:[^ prefix, correctedLocalName] ifFalse:[^ prefix, self slash, correctedLocalName]!

1 0

The Trunk: EToys-nice.296.mcz
by commits＠source.squeak.org 26 Apr '17

26 Apr '17

Nicolas Cellier uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-nice.296.mcz ==================== Summary ==================== Name: EToys-nice.296 Author: nice Time: 26 April 2017, 10:58:40.211195 pm UUID: 5d6e88cb-95d4-4aea-87f1-3e8e97c96a1b Ancestors: EToys-ul.295 Favour usage of the regular #findLastOccurrenceOfString:startingAt: over the (un-)deprecated #findLastOccuranceOfString:startingAt: =============== Diff against EToys-ul.295 =============== Item was changed: ----- Method: FileList>>removeVersionNumberFromFileName (in category '*Etoys-Squeakland-file menu action') ----- removeVersionNumberFromFileName "The selected filename has a version number in it. Rename the file such that the version number is removed." | localName fullName dotPosition beforeDot earlierDotPosition within newLocalName | fullName := directory fullNameFor: fileName. localName := FileDirectory localNameFor: fullName. dotPosition := localName findLastOccuranceOfString: FileDirectory dot startingAt: 1. dotPosition > 0 ifTrue: [beforeDot := localName copyFrom: 1 to: dotPosition - 1. + earlierDotPosition := beforeDot findLastOccurrenceOfString: FileDirectory dot startingAt: 1. - earlierDotPosition := beforeDot findLastOccuranceOfString: FileDirectory dot startingAt: 1. earlierDotPosition > 0 ifTrue: [within := beforeDot copyFrom: (earlierDotPosition + 1) to: beforeDot size. (within size > 0 and: [within isAllDigits]) ifTrue: ["whew" newLocalName := (localName copyFrom: 1 to: (earlierDotPosition - 1)), (localName copyFrom: dotPosition to: localName size). (directory fileNames includes: newLocalName) ifTrue: [(self confirm: ('do you want to clobber the existing' translated, ' ', newLocalName, '?') orCancel: [^ self]) ifFalse: [^ self]. directory deleteFileNamed: localName]. directory rename: localName toBe: newLocalName. self updateFileList]]]. !

1 0

The Trunk: Collections-nice.752.mcz
by commits＠source.squeak.org 26 Apr '17

26 Apr '17

Nicolas Cellier uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-nice.752.mcz ==================== Summary ==================== Name: Collections-nice.752 Author: nice Time: 26 April 2017, 10:54:03.973466 pm UUID: d3620c7a-7ead-43fb-93ee-21dce320c7eb Ancestors: Collections-ul.751 Classify a few 'as yet unclassified' methods =============== Diff against Collections-ul.751 =============== Item was changed: + ----- Method: EndOfStream>>defaultAction (in category 'handling') ----- - ----- Method: EndOfStream>>defaultAction (in category 'exceptionDescription') ----- defaultAction "Answer ReadStream>>next default reply." ^ nil! Item was changed: + ----- Method: LimitedWriteStream>>nextPutAll: (in category 'writing') ----- - ----- Method: LimitedWriteStream>>nextPutAll: (in category 'as yet unclassified') ----- nextPutAll: aCollection | newEnd | collection class == aCollection class ifFalse: [^ super nextPutAll: aCollection ]. newEnd := position + aCollection size. newEnd > limit ifTrue: [ super nextPutAll: (aCollection copyFrom: 1 to: (limit - position max: 0)). limitBlock value. ^aCollection ]. newEnd > writeLimit ifTrue: [ self growTo: newEnd + 10 ]. collection replaceFrom: position+1 to: newEnd with: aCollection startingAt: 1. position := newEnd. ^aCollection! Item was changed: + ----- Method: LimitedWriteStream>>pastEndPut: (in category 'private') ----- - ----- Method: LimitedWriteStream>>pastEndPut: (in category 'as yet unclassified') ----- pastEndPut: anObject collection size >= limit ifTrue: [limitBlock value]. "Exceptional return" ^ super pastEndPut: anObject! Item was changed: + ----- Method: LimitedWriteStream>>setLimit:limitBlock: (in category 'initialize-release') ----- - ----- Method: LimitedWriteStream>>setLimit:limitBlock: (in category 'as yet unclassified') ----- setLimit: sizeLimit limitBlock: aBlock "Limit the numer of elements this stream will write..." limit := sizeLimit. "Execute this (typically ^ contents) when that limit is exceded" limitBlock := aBlock! Item was changed: + ----- Method: PluggableTextAttribute>>writeScanOn: (in category 'fileIn/fileOut') ----- - ----- Method: PluggableTextAttribute>>writeScanOn: (in category 'as yet unclassified') ----- writeScanOn: aStream "Impossible for this kind of attribute" ^ self shouldNotImplement ! Item was changed: + ----- Method: RWBinaryOrTextStream>>setFileTypeToObject (in category 'properties-setting') ----- - ----- Method: RWBinaryOrTextStream>>setFileTypeToObject (in category 'as yet unclassified') ----- setFileTypeToObject "do nothing. We don't have a file type"! Item was changed: + ----- Method: TextAction>>analyze: (in category 'initialize-release') ----- - ----- Method: TextAction>>analyze: (in category 'as yet unclassified') ----- analyze: aString "Analyze the selected text to find both the parameter to store and the text to emphesize (may be different from original selection). Does not return self!!. May be multiline or of the form: 3+4 <3+4> Click Here<3+4> <3+4>Click Here " "Obtain the showing text and the instructions" | b1 b2 singleLine trim param show | b1 := aString indexOf: $<. b2 := aString indexOf: $>. singleLine := aString lineCount = 0. (singleLine or: [(b1 < b2) & (b1 > 0)]) ifFalse: ["only one part" param := self validate: aString. param ifNil: [ ^{ nil. nil } ]. ^ Array with: param with: (param size = 0 ifFalse: [param])]. "Two parts" trim := aString withBlanksTrimmed. (trim at: 1) == $< ifTrue: [(trim last) == $> ifTrue: ["only instructions" param := self validate: (aString copyFrom: b1+1 to: b2-1). show := param size = 0 ifFalse: [param]] ifFalse: ["at the front" param := self validate: (aString copyFrom: b1+1 to: b2-1). show := param size = 0 ifFalse: [aString copyFrom: b2+1 to: aString size]]] ifFalse: [(trim last) == $> ifTrue: ["at the end" param := self validate: (aString copyFrom: b1+1 to: b2-1). show := param size = 0 ifFalse: [aString copyFrom: 1 to: b1-1]] ifFalse: ["Arbitrary string. Let the compiler handle the complete string" param := self validate: aString. param ifNil: [ ^{ nil. nil }]. show := (param size = 0 ifFalse: [param])]]. ^ Array with: param with: show ! Item was changed: + ----- Method: TextAction>>emphasizeScanner: (in category 'accessing') ----- - ----- Method: TextAction>>emphasizeScanner: (in category 'as yet unclassified') ----- emphasizeScanner: scanner "Set the emphasis for text display" Purple ifNil: [Purple := self userInterfaceTheme color ifNil: [Color r: 0.4 g: 0.0 b: 1]]. scanner textColor: Purple.! Item was changed: + ----- Method: TextAction>>info (in category 'accessing') ----- - ----- Method: TextAction>>info (in category 'as yet unclassified') ----- info ^ 'no hidden info'! Item was changed: + ----- Method: TextAction>>validate: (in category 'initialize-release') ----- - ----- Method: TextAction>>validate: (in category 'as yet unclassified') ----- validate: aString "any format is OK with me" ^ aString! Item was changed: + ----- Method: TextAlignment>>dominates: (in category 'testing') ----- - ----- Method: TextAlignment>>dominates: (in category 'as yet unclassified') ----- dominates: other "There can be only one..." ^self class == other class! Item was changed: + ----- Method: TextAlignment>>emphasizeScanner: (in category 'accessing') ----- - ----- Method: TextAlignment>>emphasizeScanner: (in category 'as yet unclassified') ----- emphasizeScanner: scanner "Set the emphasist for text scanning" scanner setAlignment: alignment.! Item was changed: + ----- Method: TextAlignment>>shouldFormBlocks (in category 'testing') ----- - ----- Method: TextAlignment>>shouldFormBlocks (in category 'as yet unclassified') ----- shouldFormBlocks ^ true! Item was changed: + ----- Method: TextAttribute>>anchoredMorph (in category 'accessing') ----- - ----- Method: TextAttribute>>anchoredMorph (in category 'as yet unclassified') ----- anchoredMorph "If one hides here, return it" ^nil! Item was changed: + ----- Method: TextAttribute>>dominates: (in category 'testing') ----- - ----- Method: TextAttribute>>dominates: (in category 'as yet unclassified') ----- dominates: another "Subclasses may override condense multiple attributes" ^ false! Item was changed: + ----- Method: TextAttribute>>emphasisCode (in category 'accessing') ----- - ----- Method: TextAttribute>>emphasisCode (in category 'as yet unclassified') ----- emphasisCode "Subclasses may override to add bold, italic, etc" ^ 0! Item was changed: + ----- Method: TextAttribute>>emphasizeScanner: (in category 'accessing') ----- - ----- Method: TextAttribute>>emphasizeScanner: (in category 'as yet unclassified') ----- emphasizeScanner: scanner "Subclasses may override to set, eg, font, color, etc"! Item was changed: + ----- Method: TextAttribute>>forFontInStyle:do: (in category 'private') ----- - ----- Method: TextAttribute>>forFontInStyle:do: (in category 'as yet unclassified') ----- forFontInStyle: aTextStyle do: aBlock "No action is the default. Overridden by font specs"! Item was changed: + ----- Method: TextAttribute>>mayActOnClick (in category 'testing') ----- - ----- Method: TextAttribute>>mayActOnClick (in category 'as yet unclassified') ----- mayActOnClick "Subclasses may override to provide, eg, hot-spot actions" ^ false! Item was changed: + ----- Method: TextAttribute>>mayBeExtended (in category 'testing') ----- - ----- Method: TextAttribute>>mayBeExtended (in category 'as yet unclassified') ----- mayBeExtended "A quality that may be overridden by subclasses, such as TextAnchors, that really only apply to a single character" ^ true! Item was changed: + ----- Method: TextAttribute>>menu (in category 'accessing') ----- - ----- Method: TextAttribute>>menu (in category 'as yet unclassified') ----- menu ^nil! Item was changed: + ----- Method: TextAttribute>>oldEmphasisCode: (in category 'accessing') ----- - ----- Method: TextAttribute>>oldEmphasisCode: (in category 'as yet unclassified') ----- oldEmphasisCode: default "Allows running thorugh possibly multiple attributes and getting the emphasis out of any that has an emphasis (font number)" ^ default! Item was changed: + ----- Method: TextAttribute>>reset (in category 'initialize-release') ----- - ----- Method: TextAttribute>>reset (in category 'as yet unclassified') ----- reset "Allow subclasses to prepare themselves for merging attributes"! Item was changed: + ----- Method: TextAttribute>>set (in category 'accessing') ----- - ----- Method: TextAttribute>>set (in category 'as yet unclassified') ----- set "Respond true to include this attribute (as opposed to, eg, a bold emphasizer that is clearing the property" ^ true! Item was changed: + ----- Method: TextDoIt>>actOnClickFor: (in category 'event handling') ----- - ----- Method: TextDoIt>>actOnClickFor: (in category 'as yet unclassified') ----- actOnClickFor: anObject "Note: evalString gets evaluated IN THE CONTEXT OF anObject -- meaning that self and all instVars are accessible" Compiler evaluate: evalString for: anObject. ^ true ! Item was changed: + ----- Method: TextDoIt>>analyze: (in category 'initialize-release') ----- - ----- Method: TextDoIt>>analyze: (in category 'as yet unclassified') ----- analyze: aString | list | list := super analyze: aString. evalString := (list at: 1) asString. ^ list at: 2! Item was changed: + ----- Method: TextDoIt>>emphasizeScanner: (in category 'accessing') ----- - ----- Method: TextDoIt>>emphasizeScanner: (in category 'as yet unclassified') ----- emphasizeScanner: scanner scanner addEmphasis: 4! Item was changed: + ----- Method: TextDoIt>>info (in category 'accessing') ----- - ----- Method: TextDoIt>>info (in category 'as yet unclassified') ----- info ^ evalString! Item was changed: + ----- Method: TextEmphasis>>dominates: (in category 'testing') ----- - ----- Method: TextEmphasis>>dominates: (in category 'as yet unclassified') ----- dominates: other (emphasisCode = 0 and: [other dominatedByCmd0]) ifTrue: [^ true]. ^ (other class == self class) and: [emphasisCode = other emphasisCode]! Item was changed: + ----- Method: TextEmphasis>>emphasizeScanner: (in category 'accessing') ----- - ----- Method: TextEmphasis>>emphasizeScanner: (in category 'as yet unclassified') ----- emphasizeScanner: scanner "Set the emphasist for text scanning" scanner addEmphasis: emphasisCode! Item was changed: + ----- Method: TextFontChange>>dominates: (in category 'testing') ----- - ----- Method: TextFontChange>>dominates: (in category 'as yet unclassified') ----- dominates: other ^ other isKindOf: TextFontChange! Item was changed: + ----- Method: TextFontChange>>emphasizeScanner: (in category 'accessing') ----- - ----- Method: TextFontChange>>emphasizeScanner: (in category 'as yet unclassified') ----- emphasizeScanner: scanner "Set the font for text display" scanner setFont: fontNumber! Item was changed: + ----- Method: TextFontChange>>forFontInStyle:do: (in category 'private') ----- - ----- Method: TextFontChange>>forFontInStyle:do: (in category 'as yet unclassified') ----- forFontInStyle: aTextStyle do: aBlock aBlock value: (aTextStyle fontAt: fontNumber)! Item was changed: + ----- Method: TextFontReference>>forFontInStyle:do: (in category 'private') ----- - ----- Method: TextFontReference>>forFontInStyle:do: (in category 'as yet unclassified') ----- forFontInStyle: aTextStyle do: aBlock aBlock value: font! Item was changed: + ----- Method: TextIndent>>amount (in category 'accessing') ----- - ----- Method: TextIndent>>amount (in category 'access') ----- amount "number of tab spaces to indent by" ^amount! Item was changed: + ----- Method: TextIndent>>amount: (in category 'accessing') ----- - ----- Method: TextIndent>>amount: (in category 'access') ----- amount: anInteger "change the number of tabs to indent by" amount := anInteger! Item was changed: + ----- Method: TextIndent>>shouldFormBlocks (in category 'testing') ----- - ----- Method: TextIndent>>shouldFormBlocks (in category 'nil') ----- shouldFormBlocks ^ true! Item was changed: + ----- Method: TextStream>>applyAttribute:beginningAt: (in category 'private') ----- - ----- Method: TextStream>>applyAttribute:beginningAt: (in category 'as yet unclassified') ----- applyAttribute: att beginningAt: startPos collection addAttribute: att from: startPos to: self position! Item was changed: + ----- Method: TextStream>>nextPutAll: (in category 'writing') ----- - ----- Method: TextStream>>nextPutAll: (in category 'as yet unclassified') ----- nextPutAll: aCollection "Optimized access to get around Text at:Put: overhead" | n | n := aCollection size. position + n > writeLimit ifTrue: [self growTo: position + n + 10]. collection replaceFrom: position+1 to: position + n with: aCollection startingAt: 1. position := position + n. ^aCollection! Item was changed: + ----- Method: TextStream>>withAttribute:do: (in category 'private') ----- - ----- Method: TextStream>>withAttribute:do: (in category 'as yet unclassified') ----- withAttribute: att do: strmBlock | pos1 val | pos1 := self position. val := strmBlock value. collection addAttribute: att from: pos1+1 to: self position. ^ val! Item was changed: + ----- Method: TextStream>>withAttributes:do: (in category 'private') ----- - ----- Method: TextStream>>withAttributes:do: (in category 'as yet unclassified') ----- withAttributes: attributes do: streamBlock | pos1 val | pos1 := self position. val := streamBlock value. attributes do: [:attribute | collection addAttribute: attribute from: pos1 + 1 to: self position]. ^ val! Item was changed: + ----- Method: TextURL>>analyze: (in category 'initialize-release') ----- - ----- Method: TextURL>>analyze: (in category 'as yet unclassified') ----- analyze: aString | list | list := super analyze: aString. (UIManager default request: 'URL to open' translated initialAnswer: (list at: 1)) in: [:answer | answer ifEmpty: [url := list at: 1] ifNotEmpty: [url := answer]]. ^ list at: 2! Item was changed: + ----- Method: TranscriptStream>>characterLimit (in category 'accessing') ----- - ----- Method: TranscriptStream>>characterLimit (in category 'access') ----- characterLimit "Tell the views how much to retain on screen" ^ 20000! Item was changed: + ----- Method: WordArrayForSegment>>restoreEndianness (in category 'objects from disk') ----- - ----- Method: WordArrayForSegment>>restoreEndianness (in category 'as yet unclassified') ----- restoreEndianness "This word object was just read in from a stream. Do not correct the Endianness because the load primitive will reverse bytes as needed." "^ self" ! Item was changed: + ----- Method: WordArrayForSegment>>writeOn: (in category 'objects from disk') ----- - ----- Method: WordArrayForSegment>>writeOn: (in category 'as yet unclassified') ----- writeOn: aByteStream "Write quickly and disregard the endianness of the words. Store the array of bits onto the argument, aStream. (leading byte ~= 16r80) identifies this as raw bits (uncompressed)." aByteStream nextInt32Put: self size. "4 bytes" aByteStream nextPutAll: self !

1 0

The Trunk: Compression-nice.53.mcz
by commits＠source.squeak.org 26 Apr '17

26 Apr '17

Nicolas Cellier uploaded a new version of Compression to project The Trunk: http://source.squeak.org/trunk/Compression-nice.53.mcz ==================== Summary ==================== Name: Compression-nice.53 Author: nice Time: 26 April 2017, 10:52:24.507244 pm UUID: e6d7cbdf-497f-42b3-8b4b-f18c1f62409f Ancestors: Compression-nice.52 Classify a few 'as yet unclassified' methods =============== Diff against Compression-nice.52 =============== Item was changed: + ----- Method: GZipSurrogateStream>>ascii (in category 'accessing') ----- - ----- Method: GZipSurrogateStream>>ascii (in category 'as yet unclassified') ----- ascii self bufferStream ascii! Item was changed: + ----- Method: GZipSurrogateStream>>binary (in category 'accessing') ----- - ----- Method: GZipSurrogateStream>>binary (in category 'as yet unclassified') ----- binary self bufferStream binary! Item was changed: + ----- Method: GZipSurrogateStream>>bufferStream (in category 'private') ----- - ----- Method: GZipSurrogateStream>>bufferStream (in category 'as yet unclassified') ----- bufferStream ^bufferStream ifNil: [bufferStream := RWBinaryOrTextStream on: (ByteArray new: 5000)]. ! Item was changed: + ----- Method: GZipSurrogateStream>>close (in category 'open/close') ----- - ----- Method: GZipSurrogateStream>>close (in category 'as yet unclassified') ----- close "we don't want to until user is really done" ! Item was changed: + ----- Method: GZipSurrogateStream>>closed (in category 'open/close') ----- - ----- Method: GZipSurrogateStream>>closed (in category 'as yet unclassified') ----- closed ^false! Item was changed: + ----- Method: GZipSurrogateStream>>command: (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>command: (in category 'as yet unclassified') ----- command: aString "Overridden by HtmlFileStream to append commands directly without translation. 4/5/96 tk" "We ignore any HTML commands. Do nothing"! Item was changed: + ----- Method: GZipSurrogateStream>>cr (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>cr (in category 'as yet unclassified') ----- cr self bufferStream cr! Item was changed: + ----- Method: GZipSurrogateStream>>fileOutClass:andObject: (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>fileOutClass:andObject: (in category 'as yet unclassified') ----- 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 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 ]. "Append the object's raw data" srefStream := SmartRefStream on: self. srefStream nextPut: theObject. "and all subobjects" srefStream close. "also closes me - well it thinks it does, anyway" ! Item was changed: + ----- Method: GZipSurrogateStream>>flushBuffer (in category 'private') ----- - ----- Method: GZipSurrogateStream>>flushBuffer (in category 'as yet unclassified') ----- flushBuffer | data | bufferStream ifNil: [^self]. data := bufferStream contents asByteArray. gZipStream nextPutAll: data. positionThusFar := positionThusFar + data size. bufferStream := nil. ! Item was changed: + ----- Method: GZipSurrogateStream>>header (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>header (in category 'as yet unclassified') ----- header "ignore"! Item was changed: + ----- Method: GZipSurrogateStream>>newFileNamed:inDirectory: (in category 'private') ----- - ----- Method: GZipSurrogateStream>>newFileNamed:inDirectory: (in category 'as yet unclassified') ----- newFileNamed: fName inDirectory: aDirectory positionThusFar := 0. zippedFileStream := aDirectory newFileNamed: fName. zippedFileStream binary; setFileTypeToObject. "Type and Creator not to be text, so can be enclosed in an email" gZipStream := GZipWriteStream on: zippedFileStream. ! Item was changed: + ----- Method: GZipSurrogateStream>>next (in category 'reading') ----- - ----- Method: GZipSurrogateStream>>next (in category 'as yet unclassified') ----- next ^self bufferStream next! Item was changed: + ----- Method: GZipSurrogateStream>>nextChunkPut: (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>nextChunkPut: (in category 'as yet unclassified') ----- nextChunkPut: aString self bufferStream nextChunkPut: aString! Item was changed: + ----- Method: GZipSurrogateStream>>nextInt32Put: (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>nextInt32Put: (in category 'as yet unclassified') ----- nextInt32Put: int32 ^self bufferStream nextInt32Put: int32 ! Item was changed: + ----- Method: GZipSurrogateStream>>nextNumber:put: (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>nextNumber:put: (in category 'as yet unclassified') ----- nextNumber: n put: v ^self bufferStream nextNumber: n put: v ! Item was changed: + ----- Method: GZipSurrogateStream>>nextPut: (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>nextPut: (in category 'as yet unclassified') ----- nextPut: aByte ^self bufferStream nextPut: aByte ! Item was changed: + ----- Method: GZipSurrogateStream>>nextPutAll: (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>nextPutAll: (in category 'as yet unclassified') ----- nextPutAll: aString ^aString writeOnGZIPByteStream: self ! Item was changed: + ----- Method: GZipSurrogateStream>>nextPutAllBytes: (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>nextPutAllBytes: (in category 'as yet unclassified') ----- nextPutAllBytes: aString ^self bufferStream nextPutAll: aString ! Item was changed: + ----- Method: GZipSurrogateStream>>nextPutAllWordArray: (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>nextPutAllWordArray: (in category 'as yet unclassified') ----- nextPutAllWordArray: aWordArray | ba hackwa hackba blt rowsAtATime sourceOrigin rowsRemaining | self flag: #bob. "do we need to be concerned by bytesPerElement??" ba := nil. rowsAtATime := 2000. "or 8000 bytes" hackwa := Form new hackBits: aWordArray. sourceOrigin := 0@0. [(rowsRemaining := hackwa height - sourceOrigin y) > 0] whileTrue: [ rowsAtATime := rowsAtATime min: rowsRemaining. (ba isNil or: [ba size ~= (rowsAtATime * 4)]) ifTrue: [ ba := ByteArray new: rowsAtATime * 4. hackba := Form new hackBits: ba. blt := (BitBlt toForm: hackba) sourceForm: hackwa. ]. blt combinationRule: Form over; sourceOrigin: sourceOrigin; destX: 0 destY: 0 width: 4 height: rowsAtATime; copyBits. self bufferStream nextPutAll: ba. self flushBuffer. sourceOrigin := sourceOrigin x @ (sourceOrigin y + rowsAtATime). ]. ! Item was changed: + ----- Method: GZipSurrogateStream>>nextStringPut: (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>nextStringPut: (in category 'as yet unclassified') ----- nextStringPut: s "Append the string, s, to the receiver. Only used by DataStream. Max size of 64*256*256*256." | length | (length := s size) < 192 ifTrue: [self nextPut: length] ifFalse: [self nextPut: (length digitAt: 4)+192. self nextPut: (length digitAt: 3). self nextPut: (length digitAt: 2). self nextPut: (length digitAt: 1)]. self nextPutAll: s. ^s! Item was changed: + ----- Method: GZipSurrogateStream>>nextWordsPutAll: (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>nextWordsPutAll: (in category 'as yet unclassified') ----- nextWordsPutAll: aCollection "Write the argument a word-like object in big endian format on the receiver. May be used to write other than plain word-like objects (such as ColorArray)." ^self nextPutAllWordArray: aCollection! Item was changed: + ----- Method: GZipSurrogateStream>>originalContents (in category 'reading') ----- - ----- Method: GZipSurrogateStream>>originalContents (in category 'as yet unclassified') ----- originalContents ^'' "used only to determine if we are byte-structured"! Item was changed: + ----- Method: GZipSurrogateStream>>padToEndWith: (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>padToEndWith: (in category 'as yet unclassified') ----- padToEndWith: aChar "We don't have pages, so we are at the end, and don't need to pad."! Item was changed: + ----- Method: GZipSurrogateStream>>position (in category 'positionning') ----- - ----- Method: GZipSurrogateStream>>position (in category 'as yet unclassified') ----- position ^self bufferStream position + positionThusFar! Item was changed: + ----- Method: GZipSurrogateStream>>reallyClose (in category 'open/close') ----- - ----- Method: GZipSurrogateStream>>reallyClose (in category 'as yet unclassified') ----- reallyClose self flushBuffer. gZipStream close. ! Item was changed: + ----- Method: GZipSurrogateStream>>reopen (in category 'open/close') ----- - ----- Method: GZipSurrogateStream>>reopen (in category 'as yet unclassified') ----- reopen "ignore"! Item was changed: + ----- Method: GZipSurrogateStream>>setFileTypeToObject (in category 'properties-setting') ----- - ----- Method: GZipSurrogateStream>>setFileTypeToObject (in category 'as yet unclassified') ----- setFileTypeToObject "ignore"! Item was changed: + ----- Method: GZipSurrogateStream>>setToEnd (in category 'positionning') ----- - ----- Method: GZipSurrogateStream>>setToEnd (in category 'as yet unclassified') ----- setToEnd "ignore"! Item was changed: + ----- Method: GZipSurrogateStream>>skip: (in category 'positionning') ----- - ----- Method: GZipSurrogateStream>>skip: (in category 'as yet unclassified') ----- skip: aNumber ^self bufferStream skip: aNumber ! Item was changed: + ----- Method: GZipSurrogateStream>>timeStamp (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>timeStamp (in category 'as yet unclassified') ----- timeStamp "Append the current time to the receiver as a String." self bufferStream nextChunkPut: "double string quotes and !!s" (String streamContents: [:s | Smalltalk timeStamp: s]) printString. self bufferStream cr! Item was changed: + ----- Method: GZipSurrogateStream>>trailer (in category 'writing') ----- - ----- Method: GZipSurrogateStream>>trailer (in category 'as yet unclassified') ----- trailer "ignore"!

1 0

The Trunk: Tests-eem.377.mcz
by commits＠source.squeak.org 26 Apr '17

26 Apr '17

Eliot Miranda uploaded a new version of Tests to project The Trunk: http://source.squeak.org/trunk/Tests-eem.377.mcz ==================== Summary ==================== Name: Tests-eem.377 Author: eem Time: 25 April 2017, 7:20:24.185589 pm UUID: d7a0fa71-5267-4d5a-aafd-26d75bed7a33 Ancestors: Tests-eem.376 Add a test for the fixed evaluation order in inlined to:[by:]do: (with thanks to John Brant). =============== Diff against Tests-eem.376 =============== Item was changed: ----- Method: CompilerTest>>testEvaluationOfInlinedToDo (in category 'testing') ----- testEvaluationOfInlinedToDo "Whether inlined or not, #to:do: should return the same value" | inlinedResult notInlinedResult | inlinedResult := Compiler new evaluate: '1+1 to: 0 do: [:i | ]' in: nil to: nil notifying: nil ifFail: [^ #failedDoit]. notInlinedResult := Compiler new evaluate: '| aBlock | aBlock := [:i | ]. 1+1 to: 0 do: aBlock' in: nil to: nil notifying: nil ifFail: [^ #failedDoit]. + self assert: inlinedResult = notInlinedResult. + inlinedResult := Compiler new + evaluate: '| stream results | + stream := ReadStream on: #(2 1). + results := OrderedCollection new. + stream next to: stream next do: [ :i | results add: i ]. + results' + in: nil + to: nil + notifying: nil + ifFail: [^ #failedDoit]. + self assert: inlinedResult isEmpty. + inlinedResult := Compiler new + evaluate: '| stream results | + stream := ReadStream on: #(1 2). + results := OrderedCollection new. + stream next to: stream next do: [ :i | results add: i ]. + results' + in: nil + to: nil + notifying: nil + ifFail: [^ #failedDoit]. + self assert: inlinedResult asArray = #(1 2)! - self assert: inlinedResult = notInlinedResult!

1 0

The Trunk: Compiler-eem.353.mcz
by commits＠source.squeak.org 26 Apr '17

26 Apr '17

Eliot Miranda uploaded a new version of Compiler to project The Trunk: http://source.squeak.org/trunk/Compiler-eem.353.mcz ==================== Summary ==================== Name: Compiler-eem.353 Author: eem Time: 25 April 2017, 6:43:55.473745 pm UUID: 76c9fea6-d855-42cd-aeb5-9cb0753f6f9d Ancestors: Compiler-ul.352 Fix the order-of-evaluation bug with inlined to:[by:]do: loops. Fix the decompiler to correctly decompile the new ordering. Use isFoo methods instead of isMemberOf: in the new decompiler code. Nuke some obsolete decompilation methods. Make the postscript re3compile all senders of to:do: or to:by:do:. =============== Diff against Compiler-ul.352 =============== Item was changed: ----- Method: AssignmentNode>>toDoIncrement: (in category 'initialize-release') ----- toDoIncrement: var + ^(var = variable + and: [value isMessageNode]) ifTrue: + [value toDoIncrement: var]! - var = variable ifFalse: [^ nil]. - (value isMemberOf: MessageNode) - ifTrue: [^ value toDoIncrement: var] - ifFalse: [^ nil]! Item was changed: InstructionStream subclass: #Decompiler + instanceVariableNames: 'constructor method instVars tempVars constTable stack statements lastPc exit caseExits lastJumpPc lastReturnPc limit hasValue blockStackBase numLocalTemps blockStartsToTempVars tempVarCount lastJumpIfPcStack tempReadCounts' - instanceVariableNames: 'constructor method instVars tempVars constTable stack statements lastPc exit caseExits lastJumpPc lastReturnPc limit hasValue blockStackBase numLocalTemps blockStartsToTempVars tempVarCount lastJumpIfPcStack' classVariableNames: 'ArgumentFlag CascadeFlag CaseFlag IfNilFlag' poolDictionaries: '' category: 'Compiler-Kernel'! !Decompiler commentStamp: 'nice 2/3/2011 22:54' prior: 0! I decompile a method in three phases: Reverser: postfix byte codes -> prefix symbolic codes (nodes and atoms) Parser: prefix symbolic codes -> node tree (same as the compiler) Printer: node tree -> text (done by the nodes) instance vars: constructor <DecompilerConstructor> an auxiliary knowing how to generate Abstract Syntax Tree (node tree) method <CompiledMethod> the method being decompiled instVars <Array of: String> the instance variables of the class implementing method tempVars <String | (OrderedCollection of: String)> hold the names of temporary variables (if known) NOTE: POLYMORPHISM WILL BE RESOLVED IN #initSymbols: constTable <Collection of: ParseNode> parse node associated with byte encoded constants (nil true false 0 1 -1 etc...) stack <OrderedCollection of: (ParseNode | String | Integer) > multipurpose... statements <OrderedCollection of: ParseNode> the statements of the method being decompiled lastPc <Integer> exit <Integer> caseExits <OrderedCollection of: Integer> - stack of exit addresses that have been seen in the branches of caseOf:'s lastJumpPc <Integer> lastReturnPc <Integer> limit <Integer> hasValue <Boolean> blockStackBase <Integer> numLocaltemps <Integer | Symbol> - number of temps local to a block; also a flag indicating decompiling a block blockStartsToTempVars <Dictionary key: Integer value: (OrderedCollection of: String)> tempVarCount <Integer> number of temp vars used by the method lastJumpIfPcStack <OrderedCollection of: Integer> the value of program counter just before the last encountered conditional jumps! Item was removed: - ----- Method: Decompiler>>blockScopeRefersOnlyOnceToTemp: (in category 'private') ----- - blockScopeRefersOnlyOnceToTemp: offset - | nRefs byteCode extension scanner scan | - scanner := InstructionStream on: method. - nRefs := 0. - scan := offset <= 15 - ifTrue: - [byteCode := 16 + offset. - [:instr | - instr = byteCode ifTrue: - [nRefs := nRefs + 1]. - nRefs > 1]] - ifFalse: - [extension := 64 + offset. - [:instr | - (instr = 128 and: [scanner followingByte = extension]) ifTrue: - [nRefs := nRefs + 1]. - nRefs > 1]]. - self scanBlockScopeFor: pc from: method initialPC to: method endPC with: scan scanner: scanner. - ^nRefs = 1! Item was removed: - ----- Method: Decompiler>>convertToDoLoop (in category 'private') ----- - convertToDoLoop - "If statements contains the pattern - var := startExpr. - [var <= limit] whileTrue: [...statements... var := var + incConst] - then replace this by - startExpr to: limit by: incConst do: [:var | ...statements...]" - | leaveOnStack initStmt toDoStmt limitStmt | - leaveOnStack := false. - (stack notEmpty - and: [stack last isAssignmentNode]) - ifTrue: - [initStmt := stack last. - (toDoStmt := statements last toDoFromWhileWithInit: initStmt) ifNil: - [^self]. - stack removeLast. - statements removeLast; addLast: toDoStmt. - leaveOnStack := true] - ifFalse: - [statements size < 2 ifTrue: - [^self]. - initStmt := statements at: statements size-1. - (toDoStmt := statements last toDoFromWhileWithInit: initStmt) ifNil: - [^self]. - statements removeLast; removeLast; addLast: toDoStmt]. - initStmt variable scope: -1. "Flag arg as block temp" - - "Attempt further conversion of the pattern - limitVar := limitExpr. - startExpr to: limitVar by: incConst do: [:var | ...statements...] - to - startExpr to: limitExpr by: incConst do: [:var | ...statements...]. - The complication here is that limitVar := limitExpr's value may be used, in which case it'll - be statements last, or may not be used, in which case it'll be statements nextToLast." - statements size < 2 ifTrue: - [leaveOnStack ifTrue: - [stack addLast: statements removeLast]. - ^self]. - limitStmt := statements last. - ((limitStmt isMemberOf: AssignmentNode) - and: [limitStmt variable isTemp - and: [limitStmt variable == toDoStmt arguments first]]) ifFalse: - [limitStmt := statements at: statements size-1. - ((limitStmt isMemberOf: AssignmentNode) - and: [limitStmt variable isTemp - and: [limitStmt variable == toDoStmt arguments first]]) ifFalse: - [leaveOnStack ifTrue: - [stack addLast: statements removeLast]. - ^self]]. - - (self blockScopeRefersOnlyOnceToTemp: limitStmt variable fieldOffset) ifFalse: - [^self]. - toDoStmt arguments at: 1 put: limitStmt value. - limitStmt variable scope: -2. "Flag limit var so it won't print" - statements last == limitStmt - ifTrue: [statements removeLast] - ifFalse: [statements removeLast; removeLast; addLast: toDoStmt]! Item was added: + ----- Method: Decompiler>>convertToDoLoop: (in category 'private') ----- + convertToDoLoop: blockBodyTempCounts + "If statements contains the pattern + var := startExpr. + [var <= limit] whileTrue: [...statements... var := var + incConst] + or + var := startExpr. + limit := limitExpr. + [var <= limit] whileTrue: [...statements... var := var + incConst] + then replace this by + startExpr to: limit by: incConst do: [:var | ...statements...] + and answer true." + | whileStmt incrStmt initStmt limitStmt toDoStmt | + whileStmt := statements last. + incrStmt := whileStmt arguments first statements last. + incrStmt isAssignmentNode ifFalse: + [^false]. + (self startAndLimitFor: incrStmt variable from: stack into: + [:startExpr :limitExpr| initStmt := startExpr. limitStmt := limitExpr]) + ifTrue: + [| limitInStatements | + limitInStatements := limitStmt isNil + and: [statements size > 1 + and: [self startAndLimitFor: incrStmt variable from: { stack last. (statements last: 2) first } into: + [:startExpr :limitExpr| limitStmt := limitExpr]]]. + (toDoStmt := statements last toDoFromWhileWithCounts: blockBodyTempCounts init: initStmt limit: limitStmt) ifNil: + [^false]. + limitInStatements + ifTrue: + [stack + removeLast; + addLast: toDoStmt. + statements removeLast: 2] + ifFalse: + [stack + removeLast: (limitStmt ifNil: [1] ifNotNil: [2]); + addLast: toDoStmt. + statements removeLast]] + ifFalse: + [(self startAndLimitFor: incrStmt variable from: statements allButLast into: + [:startExpr :limitExpr| initStmt := startExpr. limitStmt := limitExpr]) ifFalse: + [^false]. + (toDoStmt := statements last toDoFromWhileWithCounts: blockBodyTempCounts init: initStmt limit: limitStmt) ifNil: + [^false]. + statements + removeLast: (limitStmt ifNil: [2] ifNotNil: [3]); + addLast: toDoStmt]. + self markTemp: initStmt variable asOutOfScope: -1. "Flag arg as out of scope" + initStmt variable beBlockArg. + limitStmt ifNotNil: + [self markTemp: limitStmt variable asOutOfScope: -2. + toDoStmt arguments at: 1 put: limitStmt value]. "Flag limit as hidden" + ^true! Item was changed: ----- Method: Decompiler>>initSymbols: (in category 'initialize-release') ----- initSymbols: aClass constructor method: method class: aClass literals: method literals. constTable := constructor codeConstants. instVars := Array new: aClass instSize. tempVarCount := method numTemps. "(tempVars isNil and: [method holdsTempNames]) ifTrue: [tempVars := method tempNamesString]." tempVars isString ifTrue: [blockStartsToTempVars := self mapFromBlockStartsIn: method toTempVarsFrom: tempVars constructor: constructor. tempVars := blockStartsToTempVars at: method initialPC] ifFalse: [| namedTemps | namedTemps := tempVars ifNil: [(1 to: tempVarCount) collect: [:i| 't', i printString]]. tempVars := (1 to: tempVarCount) collect: [:i | i <= namedTemps size ifTrue: [constructor codeTemp: i - 1 named: (namedTemps at: i)] ifFalse: [constructor codeTemp: i - 1]]]. 1 to: method numArgs do: [:i| + (tempVars at: i) beMethodArg]. + tempReadCounts := Dictionary new! - (tempVars at: i) beMethodArg]! Item was changed: ----- Method: Decompiler>>jump:if: (in category 'instruction decoding') ----- jump: dist if: condition | savePc sign elsePc elseStart end cond ifExpr thenBlock elseBlock + thenJump elseJump condHasValue isIfNil saveStack | - thenJump elseJump condHasValue isIfNil saveStack blockBody blockArgs | lastJumpIfPcStack addLast: lastPc. stack last == CascadeFlag ifTrue: [^ [self case: dist] ensure: [lastJumpIfPcStack removeLast]]. elsePc := lastPc. elseStart := pc + dist. end := limit. "Check for bfp-jmp to invert condition. Don't be fooled by a loop with a null body." sign := condition. savePc := pc. self interpretJump ifNotNil: [:elseDist| (elseDist >= 0 and: [elseStart = pc]) ifTrue: [sign := sign not. elseStart := pc + elseDist]]. pc := savePc. ifExpr := stack removeLast. (isIfNil := stack size > 0 and: [stack last == IfNilFlag]) ifTrue: [stack removeLast]. saveStack := stack. stack := OrderedCollection new. thenBlock := self blockTo: elseStart. condHasValue := hasValue or: [isIfNil]. "ensure jump is within block (in case thenExpr returns)" thenJump := exit <= end ifTrue: [exit] ifFalse: [elseStart]. "if jump goes back, then it's a loop" thenJump < elseStart ifTrue: + [| blockBody blockArgs savedReadCounts blockBodyReadCounts selector | + "Must be a while loop... - ["Must be a while loop... thenJump will jump to the beginning of the while expr. In the case of while's with a block in the condition, the while expr should include more than just + the last expression: find all the statements needed by searching for the node + with the relevant pc." - the last expression: find all the statements needed by re-decompiling." stack := saveStack. + savedReadCounts := tempReadCounts copy. pc := thenJump. blockBody := self statementsTo: elsePc. + blockBodyReadCounts := tempReadCounts. + savedReadCounts keysAndValuesDo: + [:temp :count| + blockBodyReadCounts at: temp put: (blockBodyReadCounts at: temp) - count]. + tempReadCounts := savedReadCounts. "discard unwanted statements from block" blockBody size - 1 timesRepeat: [statements removeLast]. blockArgs := thenBlock statements = constructor codeEmptyBlock statements ifTrue: [#()] ifFalse: [{ thenBlock }]. + selector := blockArgs isEmpty + ifTrue: [sign ifTrue: [#whileFalse] ifFalse: [#whileTrue]] + ifFalse: [sign ifTrue: [#whileFalse:] ifFalse: [#whileTrue:]]. statements addLast: (constructor codeMessage: (constructor codeBlock: blockBody returns: false) + selector: (constructor codeSelector: selector code: #macro) - selector: (constructor - codeSelector: (blockArgs isEmpty - ifTrue: - [sign - ifTrue: [#whileFalse] - ifFalse: [#whileTrue]] - ifFalse: - [sign - ifTrue: [#whileFalse:] - ifFalse: [#whileTrue:]]) - code: #macro) arguments: blockArgs). pc := elseStart. + selector == #whileTrue: ifTrue: + [self convertToDoLoop: blockBodyReadCounts]] - self convertToDoLoop] ifFalse: ["Must be a conditional..." elseBlock := self blockTo: thenJump. elseJump := exit. "if elseJump is backwards, it is not part of the elseExpr" elseJump < elsePc ifTrue: [pc := lastPc]. cond := isIfNil ifTrue: [constructor codeMessage: ifExpr ifNilReceiver selector: (constructor codeSelector: (sign ifTrue: [#ifNotNil:] ifFalse: [#ifNil:]) code: #macro) arguments: (Array with: thenBlock)] ifFalse: [constructor codeMessage: ifExpr selector: (constructor codeSelector: #ifTrue:ifFalse: code: #macro) arguments: (sign ifTrue: [{elseBlock. thenBlock}] ifFalse: [{thenBlock. elseBlock}])]. stack := saveStack. condHasValue ifTrue: [stack addLast: cond] ifFalse: [statements addLast: cond]]. lastJumpIfPcStack removeLast.! Item was added: + ----- Method: Decompiler>>markTemp:asOutOfScope: (in category 'private') ----- + markTemp: tempVarNode asOutOfScope: scopeFlag + tempVarNode scope: scopeFlag. + tempReadCounts removeKey: tempVarNode ifAbsent: []! Item was changed: ----- Method: Decompiler>>popIntoTemporaryVariable: (in category 'instruction decoding') ----- popIntoTemporaryVariable: offset | maybeTVTag tempVector start | maybeTVTag := stack last. ((maybeTVTag isMemberOf: Association) and: [maybeTVTag key == #pushNewArray]) ifTrue: [blockStartsToTempVars notNil "implies we were intialized with temp names." ifTrue: "Use the provided temps" [self assert: ((tempVector := tempVars at: offset + 1 ifAbsent: [ParseNode basicNew]) isTemp and: [tempVector isIndirectTempVector and: [tempVector remoteTemps size = maybeTVTag value size]])] ifFalse: "Synthesize some remote temps" [tempVector := maybeTVTag value. offset + 1 <= tempVars size ifTrue: [start := 2. tempVector at: 1 put: (tempVars at: offset + 1)] ifFalse: [tempVars := (Array new: offset + 1) replaceFrom: 1 to: tempVars size with: tempVars. start := 1]. start to: tempVector size do: [:i| tempVector at: i put: (constructor codeTemp: numLocalTemps + offset + i - 1 named: 't', (tempVarCount + i) printString)]. tempVars at: offset + 1 put: (constructor codeRemoteTemp: offset + 1 remoteTemps: tempVector)]. tempVarCount := tempVarCount + maybeTVTag value size. stack removeLast. ^self]. + stack addLast: (offset >= tempVars size + ifTrue: "Handle the case of chained LiteralVariableBinding assigments" + [stack at: (offset + 1 - tempVars size)] + ifFalse: "A regular argument or temporary" + [tempVars at: offset + 1]). + self doStore: statements! - self pushTemporaryVariable: offset; doStore: statements! Item was changed: ----- Method: Decompiler>>pushTemporaryVariable: (in category 'instruction decoding') ----- pushTemporaryVariable: offset + | node | + offset >= tempVars size + ifTrue: "Handle the case of chained LiteralVariableBinding assigments" + [self halt. + node := stack at: offset + 1 - tempVars size] + ifFalse: "A regular argument or temporary" + [node := tempVars at: offset + 1. + node isArg ifFalse: "count temp reads for the whileTrue: => to:do: transformation." + [tempReadCounts at: node put: (tempReadCounts at: node ifAbsent: [0]) + 1]]. + stack addLast: node! - - stack addLast: (offset >= tempVars size - ifTrue: - ["Handle the case of chained LiteralVariableBinding assigments" - stack at: (offset + 1 - tempVars size)] - ifFalse: - ["A regular argument or temporary" - tempVars at: offset + 1])! Item was removed: - ----- Method: Decompiler>>scanBlockScopeFor:from:to:with:scanner: (in category 'private') ----- - scanBlockScopeFor: refpc from: startpc to: endpc with: scan scanner: scanner - | bsl maybeBlockSize | - bsl := BlockStartLocator new. - scanner pc: startpc. - [scanner pc <= endpc] whileTrue: - [refpc = scanner pc ifTrue: - [scanner pc: startpc. - [scanner pc <= endpc] whileTrue: - [(scan value: scanner firstByte) ifTrue: - [^endpc]. - (maybeBlockSize := scanner interpretNextInstructionFor: bsl) isInteger ifTrue: - [scanner pc: scanner pc + maybeBlockSize]]. - ^self]. - (maybeBlockSize := scanner interpretNextInstructionFor: bsl) isInteger ifTrue: - [refpc <= (scanner pc + maybeBlockSize) - ifTrue: [^self scanBlockScopeFor: refpc from: scanner pc to: scanner pc + maybeBlockSize with: scan scanner: scanner] - ifFalse: [scanner pc: scanner pc + maybeBlockSize]]]! Item was added: + ----- Method: Decompiler>>startAndLimitFor:from:into: (in category 'private') ----- + startAndLimitFor: incrVar from: aStack into: binaryBlock + "If incrVar matches the increment of a whileLoop at the end of statements + evaluate binaryBlock with the init statement for incrVar and the init statement + for the block's limit, if any, and answer true. Otherwise answer false. Used to + help convert whileTrue: loops into to:[by:]do: loops." + | guard initExpr limitInit size | + ((size := aStack size) >= 1 + and: [(initExpr := aStack at: size) isAssignmentNode]) ifFalse: + [^false]. + initExpr variable == incrVar ifTrue: + [binaryBlock value: initExpr value: nil. + ^true]. + limitInit := initExpr. + (size >= 2 + and: [(initExpr := aStack at: size - 1) isAssignmentNode + and: [initExpr variable == incrVar + and: [(guard := statements last receiver) isBlockNode + and: [guard statements size = 1 + and: [(guard := guard statements first) isMessageNode + and: [guard receiver == incrVar + and: [guard arguments first == limitInit variable]]]]]]]) ifTrue: + [binaryBlock value: initExpr value: limitInit. + ^true]. + ^false! Item was changed: ----- Method: Decompiler>>statementsTo: (in category 'control') ----- statementsTo: end "Decompile the method from pc up to end and return an array of expressions. If at run time this block will leave a value on the stack, set hasValue to true. If the block ends with a jump or return, set exit to the destination of the jump, or the end of the method; otherwise, set exit = end. Leave pc = end." + | encoderClass blockPos stackPos | + encoderClass := method encoderClass. - | blockPos stackPos t | blockPos := statements size. stackPos := stack size. [pc < end] whileTrue: [lastPc := pc. limit := end. "for performs" + "If you want instrumentation replace the following statement with this one, + and edit the implementation: + self interpretNextInstructionFor: self" + encoderClass interpretNextInstructionFor: self in: self]. - self interpretNextInstructionFor: self]. "If there is an additional item on the stack, it will be the value of this block." (hasValue := stack size > stackPos) ifTrue: [statements addLast: stack removeLast]. lastJumpPc = lastPc ifFalse: [exit := pc]. ^self popTo: blockPos! Item was changed: ----- Method: Decompiler>>storeIntoTemporaryVariable: (in category 'instruction decoding') ----- storeIntoTemporaryVariable: offset + stack addLast: (offset >= tempVars size + ifTrue: "Handle the case of chained LiteralVariableBinding assigments" + [stack at: (offset + 1 - tempVars size)] + ifFalse: "A regular argument or temporary" + [tempVars at: offset + 1]). + self doStore: stack! - - self pushTemporaryVariable: offset; doStore: stack! Item was removed: - ----- Method: DecompilerConstructor>>codeArguments:block: (in category 'constructor') ----- - codeArguments: args block: block - - ^block arguments: args! Item was changed: ----- Method: MessageNode>>emitCodeForToDo:encoder:value: (in category 'code generation') ----- emitCodeForToDo: stack encoder: encoder value: forValue " var := rcvr. L1: [var <= arg1] Bfp(L2) [block body. var := var + inc] Jmp(L1) L2: " | loopSize initStmt limitInit test block incStmt blockSize | initStmt := arguments at: 4. limitInit := arguments at: 7. test := arguments at: 5. block := arguments at: 3. incStmt := arguments at: 6. blockSize := sizes at: 1. loopSize := sizes at: 2. - limitInit == nil - ifFalse: [limitInit emitCodeForEffect: stack encoder: encoder]. "This will return the receiver of to:do: which is the initial value of the loop" forValue + ifTrue: [initStmt emitCodeForValue: stack encoder: encoder] - ifTrue: [initStmt emitCodeForValue: stack encoder: encoder.] ifFalse: [initStmt emitCodeForEffect: stack encoder: encoder]. + limitInit ifNotNil: + [limitInit emitCodeForEffect: stack encoder: encoder]. test emitCodeForValue: stack encoder: encoder. self emitCodeForBranchOn: false dist: blockSize pop: stack encoder: encoder. pc := encoder methodStreamPosition. block emitCodeForEvaluatedEffect: stack encoder: encoder. incStmt emitCodeForEffect: stack encoder: encoder. + self emitCodeForJump: 0 - loopSize encoder: encoder! - self emitCodeForJump: 0 - loopSize encoder: encoder.! Item was added: + ----- Method: MessageNode>>toDoFromWhileWithCounts:init:limit: (in category 'decompiling') ----- + toDoFromWhileWithCounts: blockBodyTempCounts init: incrInit limit: limitInitOrNil + "If the receiver, a whileTrue: loop, represents a to:[by:]do: loop + then answer the replacement to:[by:]do:, otherwise answer nil." + | variable increment limit toDoBlock body test | + self assert: (selector key == #whileTrue: + and: [incrInit isAssignmentNode]). + (limitInitOrNil notNil "limit should not be referenced within the loop" + and: [(blockBodyTempCounts at: limitInitOrNil variable ifAbsent: [0]) ~= 1]) ifTrue: + [^nil]. + body := arguments last statements. + (variable := incrInit variable) isTemp ifFalse: + [^nil]. + (increment := body last toDoIncrement: variable) ifNil: + [^nil]. + receiver statements size ~= 1 ifTrue: + [^nil]. + test := receiver statements first. + "Note: test should really be checked that <= or >= comparison + jibes with the sign of the (constant) increment" + (test isMessageNode + and: [(limit := test toDoLimit: variable) notNil]) ifFalse: + [^nil]. + "The block must not overwrite the limit" + (limit isVariableNode and: [body anySatisfy: [:e | e isAssignmentNode and: [e variable = limit]]]) ifTrue: + [^nil]. + toDoBlock := BlockNode statements: body allButLast returns: false. + toDoBlock arguments: {variable}. + ^MessageNode new + receiver: incrInit value + selector: (SelectorNode new key: #to:by:do: code: #macro) + arguments: (Array with: limit with: increment with: toDoBlock) + precedence: precedence! Item was removed: - ----- Method: MessageNode>>toDoFromWhileWithInit: (in category 'macro transformations') ----- - toDoFromWhileWithInit: initStmt - "Return nil, or a to:do: expression equivalent to this whileTrue:" - | variable increment limit toDoBlock body test | - (selector key == #whileTrue: - and: [initStmt isAssignmentNode - and: [initStmt variable isTemp]]) ifFalse: - [^nil]. - body := arguments last statements. - variable := initStmt variable. - increment := body last toDoIncrement: variable. - (increment == nil - or: [receiver statements size ~= 1]) ifTrue: - [^nil]. - test := receiver statements first. - "Note: test chould really be checked that <= or >= comparison - jibes with the sign of the (constant) increment" - (test isMessageNode - and: [(limit := test toDoLimit: variable) notNil]) ifFalse: - [^nil]. - "The block must not overwrite the limit" - (limit isVariableNode and: [body anySatisfy: [:e | e isAssignmentNode and: [e variable = limit]]]) - ifTrue: [^nil]. - toDoBlock := BlockNode statements: body allButLast returns: false. - toDoBlock arguments: (Array with: variable). - variable scope: -1. - variable beBlockArg. - ^MessageNode new - receiver: initStmt value - selector: (SelectorNode new key: #to:by:do: code: #macro) - arguments: (Array with: limit with: increment with: toDoBlock) - precedence: precedence! Item was added: + ----- Method: MessageNode>>toDoFromWhileWithInit:withLimit: (in category 'decompiling') ----- + toDoFromWhileWithInit: incrInit withLimit: limitInitOrNil + "If the receiver, a whileTrue: loop, represents a to:[by:]do: loop + then answer the replacement to:[by:]do:, otherwise answer nil." + | variable increment limit toDoBlock body test | + self assert: (selector key == #whileTrue: + and: [incrInit isAssignmentNode]). + body := arguments last statements. + (variable := incrInit variable) isTemp ifFalse: + [^nil]. + (increment := body last toDoIncrement: variable) ifNil: + [^nil]. + receiver statements size ~= 1 ifTrue: + [^nil]. + test := receiver statements first. + "Note: test should really be checked that <= or >= comparison + jibes with the sign of the (constant) increment" + (test isMessageNode + and: [(limit := test toDoLimit: variable) notNil]) ifFalse: + [^nil]. + "The block must not overwrite the limit" + (limit isVariableNode and: [body anySatisfy: [:e | e isAssignmentNode and: [e variable = limit]]]) ifTrue: + [^nil]. + toDoBlock := BlockNode statements: body allButLast returns: false. + toDoBlock arguments: {variable}. + ^MessageNode new + receiver: incrInit value + selector: (SelectorNode new key: #to:by:do: code: #macro) + arguments: (Array with: limit with: increment with: toDoBlock) + precedence: precedence! Item was changed: ----- Method: MessageNode>>toDoIncrement: (in category 'testing') ----- toDoIncrement: variable + ^(receiver = variable + and: [selector key = #+ + and: [arguments first isConstantNumber]]) ifTrue: + [arguments first]! - (receiver = variable and: [selector key = #+]) - ifFalse: [^ nil]. - arguments first isConstantNumber - ifTrue: [^ arguments first] - ifFalse: [^ nil]! Item was changed: ----- Method: MessageNode>>toDoLimit: (in category 'testing') ----- toDoLimit: variable + ^(receiver = variable + and: [selector key = #<= or: [selector key = #>=]]) ifTrue: + [arguments first]! - (receiver = variable and: [selector key = #<= or: [selector key = #>=]]) - ifTrue: [^ arguments first] - ifFalse: [^ nil]! Item was changed: + (PackageInfo named: 'Compiler') postscript: '"below, add code to be run after the loading of this package" + "Make sure all methods using to:do: and to:by:do: are recompiled" - (PackageInfo named: 'Compiler') postscript: '"Make sure all affected methods are recompiled" UIManager default + informUser: ''Recompiling methods sending to:do: and to:by:do:'' - informUser: ''Recompiling affected methods'' during: [(self systemNavigation allMethodsSelect: + [:m| + #(to:do: to:by:do:) anySatisfy: [:l| m refersToLiteral: l]]) do: + [:mr| mr actualClass recompile: mr selector]]'! - [:m| | ebc | "All affected methods send one of these optimized selectors..." - (#(to:do: to:by:do: ifNotNil: ifNil:ifNotNil: ifNotNil:ifNil:) anySatisfy: [:l| m refersToLiteral: l]) - "but the textDomain properties confuse method comparison below..." - and: [(m propertyValueAt: #textDomain ifAbsent: nil) isNil - and: [m numTemps > m numArgs "and have non-argument temporaries in them..." - or: [(ebc := m embeddedBlockClosures) notEmpty - and: [ebc anySatisfy: [:bc| bc numTemps > bc numArgs]]]]]]) do: - [:mr| | old new | - old := mr compiledMethod. - "do a test recompile of the method..." - new := (mr actualClass compile: old getSource asString notifying: nil trailer: old trailer ifFail: nil) method. - "and if it changed, report it to the transcript and really recompile it..." - old ~= new ifTrue: - [Transcript cr. old printReferenceOn: Transcript. Transcript flush. - mr actualClass recompile: old selector]]]'!

1 0

The Trunk: Collections-ul.751.mcz
by commits＠source.squeak.org 25 Apr '17

25 Apr '17

Levente Uzonyi uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-ul.751.mcz ==================== Summary ==================== Name: Collections-ul.751 Author: ul Time: 25 April 2017, 6:55:32.620027 pm UUID: e526dee8-c2dc-4f9e-8b5d-96cd22f1e24b Ancestors: Collections-ul.750 - removed implementations of #clone =============== Diff against Collections-ul.750 =============== Item was removed: - ----- Method: Character>>clone (in category 'copying') ----- - clone - "Answer the receiver, because Characters are unique." - ^self! Item was removed: - ----- Method: Symbol>>clone (in category 'copying') ----- - clone - "Answer with the receiver, because Symbols are unique."!

1 0

The Trunk: Tools-ul.759.mcz
by commits＠source.squeak.org 25 Apr '17

25 Apr '17

Levente Uzonyi uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-ul.759.mcz ==================== Summary ==================== Name: Tools-ul.759 Author: ul Time: 25 April 2017, 6:41:37.45844 pm UUID: 826e191c-a2cc-4f12-b024-1001e76d745c Ancestors: Tools-ul.758 - removed reference to #clone from MethodFinder =============== Diff against Tools-ul.758 =============== Item was changed: ----- Method: MethodFinder>>initialize (in category 'initialize') ----- (excessive size, no diff calculated)

1 0

The Trunk: KernelTests-ul.328.mcz
by commits＠source.squeak.org 25 Apr '17

25 Apr '17

Levente Uzonyi uploaded a new version of KernelTests to project The Trunk: http://source.squeak.org/trunk/KernelTests-ul.328.mcz ==================== Summary ==================== Name: KernelTests-ul.328 Author: ul Time: 25 April 2017, 6:40:43.285455 pm UUID: f80023f1-7ae7-443e-a43f-d0ca5d867f2d Ancestors: KernelTests-eem.327 - removed #testClone, since #clone had been deprecated =============== Diff against KernelTests-eem.327 =============== Item was removed: - ----- Method: UndefinedObjectTest>>testClone (in category 'tests - copying') ----- - testClone - - self assert: ( nil clone = nil).!

1 0

The Trunk: Kernel-ul.1099.mcz
by commits＠source.squeak.org 25 Apr '17

25 Apr '17

Levente Uzonyi uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-ul.1099.mcz ==================== Summary ==================== Name: Kernel-ul.1099 Author: ul Time: 25 April 2017, 6:40:04.569495 pm UUID: d06b7b82-b7b0-4896-ab30-7a5f85de7427 Ancestors: Kernel-ul.1098 - deprecated Object >> #clone - removed #clone from subclasses =============== Diff against Kernel-ul.1098 =============== Item was removed: - ----- Method: Boolean>>clone (in category 'copying') ----- - clone - "Receiver has two concrete subclasses, True and False. - Only one instance of each should be made, so return self."! Item was removed: - ----- Method: Object>>clone (in category 'copying') ----- - clone - "Answer a shallow copy of the receiver." - <primitive: 148 error: ec> - | class newObject | - ec == #'insufficient object memory' ifFalse: - [^self primitiveFailed]. - "If the primitive fails due to insufficient memory, instantiate via basicNew: to invoke - the garbage collector before retrying, and use copyFrom: to copy state." - newObject := (class := self class) isVariable - ifTrue: - [class isCompiledMethodClass - ifTrue: - [class newMethod: self basicSize - self initialPC + 1 header: self header] - ifFalse: - [class basicNew: self basicSize]] - ifFalse: - [class basicNew]. - ^newObject copyFrom: self! Item was removed: - ----- Method: SmallFloat64>>clone (in category 'copying') ----- - clone - "Answer the receiver, because SmallFloat64s are unique." - ^self! Item was removed: - ----- Method: SmallInteger>>clone (in category 'copying') ----- - clone - "Answer the receiver, because SmallIntegers are unique." - ^self! Item was removed: - ----- Method: UndefinedObject>>clone (in category 'copying') ----- - clone - "Only one instance of UndefinedObject should ever be made, so answer - with self."!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages April 2017