Eliot Miranda uploaded a new version of Kernel to project The Trunk:
http://source.squeak.org/trunk/Kernel-eem.1106.mcz
==================== Summary ====================
Name: Kernel-eem.1106
Author: eem
Time: 26 May 2017, 10:46:24.565361 pm
UUID: 50900779-04ef-43b2-8b95-6db258fbc8fe
Ancestors: Kernel-pre.1105
Several small fixes harvested from Terf.
Comment behavior>>startUp:.
Make sure that missing method chunks are still output as chunks.
Fix EventSensor>>flushNonKbdEvents to do just that and not flush key changes.
Provide an accessor for Float's Sqrt2 class var.
Guard against setting the comment of a metaclass.
Fix the comments of the 64-bit mixed integer primitives.
Nuke an unused variable in highestPriority: and guard against a possible bounds violation.
Fix the comment in SmallInteger>>bitAnd:.
=============== Diff against Kernel-pre.1105 ===============
Item was changed:
----- Method: Behavior>>startUp: (in category 'system startup') -----
startUp: resuming
+ "This message is sent to registered classes when the system is coming up.
+ resuming will be true if a snapshot is being resumed. resuming will be false
+ if the system is merely reinitializing after writing a snapshot."
- "This message is sent to registered classes when the system is coming up."
^self startUp!
Item was changed:
----- Method: Categorizer>>printString (in category 'printing') -----
printString
+ ^self fullPrintString!
- ^ String streamContents: [ :stream | self printOn: stream ].!
Item was changed:
----- Method: ClassDescription>>copy:from:classified: (in category 'copying') -----
copy: sel from: class classified: cat
"Install the method associated with the first arugment, sel, a message
selector, found in the method dictionary of the second argument, class,
as one of the receiver's methods. Classify the message under the third
argument, cat."
- | code category |
"Useful when modifying an existing class"
+ (class sourceCodeAt: sel ifAbsent: []) ifNotNil:
+ [:code| | method category |
+ method := class compiledMethodAt: sel.
+ category := cat == nil
+ ifTrue: [class organization categoryOfElement: sel]
+ ifFalse: [cat].
+ ((self methodDict includesKey: sel)
+ and: [code asString ~= (self sourceCodeAt: sel) asString]) ifTrue:
+ [self error: self name , ' ' , sel , ' will be redefined if you proceed.'].
+ self compile: code classified: category withStamp: method timeStamp notifying: nil]!
- code := class sourceMethodAt: sel.
- code == nil
- ifFalse:
- [cat == nil
- ifTrue: [category := class organization categoryOfElement: sel]
- ifFalse: [category := cat].
- (self methodDict includesKey: sel)
- ifTrue: [code asString = (self sourceMethodAt: sel) asString
- ifFalse: [self error: self name
- , ' '
- , sel
- , ' will be redefined if you proceed.']].
- self compile: code classified: category]!
Item was changed:
----- Method: ClassDescription>>printMethodChunk:withPreamble:on:moveSource:toFile: (in category 'fileIn/Out') -----
printMethodChunk: selector withPreamble: doPreamble on: outStream
moveSource: moveSource toFile: fileIndex
"Copy the source code for the method associated with selector onto the fileStream. If moveSource true, then also set the source code pointer of the method."
| preamble method oldPos newPos sourceFile endPos |
doPreamble
ifTrue: [preamble := self name , ' methodsFor: ' ,
(self organization categoryOfElement: selector) asString printString]
ifFalse: [preamble := ''].
method := self methodDict at: selector ifAbsent:
[outStream nextPutAll: selector; cr.
+ outStream tab; nextChunkPut: '** ERROR!! THIS SCRIPT IS MISSING ** ' translated; cr; cr.
- outStream tab; nextPutAll: '** ERROR!! THIS SCRIPT IS MISSING ** ' translated; cr; cr.
outStream nextPutAll: ' '.
^ outStream].
((method fileIndex = 0
or: [(SourceFiles at: method fileIndex) == nil])
or: [(oldPos := method filePosition) = 0])
ifTrue:
["The source code is not accessible. We must decompile..."
preamble size > 0 ifTrue: [outStream cr; nextPut: $!!; nextChunkPut: preamble; cr].
outStream nextChunkPut: method decompileString]
ifFalse:
[sourceFile := SourceFiles at: method fileIndex.
preamble size > 0
ifTrue: "Copy the preamble"
[outStream copyPreamble: preamble from: sourceFile at: oldPos]
ifFalse:
[sourceFile position: oldPos].
"Copy the method chunk"
newPos := outStream position.
outStream copyMethodChunkFrom: sourceFile.
sourceFile skipSeparators. "The following chunk may have ]style["
sourceFile peek == $] ifTrue: [
outStream cr; copyMethodChunkFrom: sourceFile].
moveSource ifTrue: "Set the new method source pointer"
[endPos := outStream position.
method checkOKToAdd: endPos - newPos at: newPos.
method setSourcePosition: newPos inFile: fileIndex]].
preamble size > 0 ifTrue: [outStream nextChunkPut: ' '].
^ outStream cr!
Item was added:
+ ----- Method: ClassOrganizer>>classComment: (in category 'accessing') -----
+ classComment: aString
+ "Guards against setting the comment in a metaclass which is invalid"
+ subject isMeta ifTrue:[^self error: 'Cannot set metaclass comments'].
+ ^super classComment: aString!
Item was added:
+ ----- Method: ClassOrganizer>>classComment:stamp: (in category 'accessing') -----
+ classComment: aString stamp: aStamp
+ "Guards against setting the comment in a metaclass which is invalid"
+ subject isMeta ifTrue:[^self error: 'Cannot set metaclass comments'].
+ ^super classComment: aString stamp: aStamp!
Item was changed:
----- Method: EventSensor>>flushNonKbdEvents (in category 'private') -----
flushNonKbdEvents
+ "We do NOT use 'isKeybdEvent: ' here,
+ as that would have us flush key press-release events,
+ which is not appropriate when flushing non-keyboard events."
+ self eventQueue ifNotNil:
+ [:queue |
+ queue flushAllSuchThat: [:buf | (self isAnyKbdEvent: buf) not]]!
-
- self eventQueue ifNotNil: [:queue |
- queue flushAllSuchThat: [:buf | (self isKbdEvent: buf) not]].!
Item was added:
+ ----- Method: EventSensor>>isAnyKbdEvent: (in category 'private') -----
+ isAnyKbdEvent: buf
+ ^(buf at: 1) = EventTypeKeyboard!
Item was added:
+ ----- Method: Float class>>sqrt2 (in category 'constants') -----
+ sqrt2
+
+ ^ Sqrt2!
Item was changed:
----- Method: LargePositiveInteger>>* (in category 'arithmetic') -----
* anInteger
"Primitive. Multiply the receiver by the argument and answer with an
+ Integer result. Fail if either the argument or the result is not in 64 bit range.
+ Optional. See Object documentation whatIsAPrimitive."
- Integer result. Fail if either the argument or the result is not a
- SmallInteger or a LargePositiveInteger less than 2-to-the-30th (1073741824). Optional. See
- Object documentation whatIsAPrimitive. "
<primitive: 29>
^super * anInteger!
Item was changed:
----- Method: LargePositiveInteger>>+ (in category 'arithmetic') -----
+ anInteger
"Primitive. Add the receiver to the argument and answer with an
+ Integer result. Fail if either the argument or the result is not in 64 bit range.
+ Optional. See Object documentation whatIsAPrimitive."
- Integer result. Fail if either the argument or the result is not a
- SmallInteger or a LargePositiveInteger less than 2-to-the-30th (1073741824). Optional. See
- Object documentation whatIsAPrimitive."
<primitive: 21>
^super + anInteger!
Item was changed:
----- Method: LargePositiveInteger>>- (in category 'arithmetic') -----
- anInteger
"Primitive. Subtract the argument from the receiver and answer with an
+ Integer result. Fail if either the argument or the result is not in 64 bit range.
+ Optional. See Object documentation whatIsAPrimitive."
- Integer result. Fail if either the argument or the result is not a
- SmallInteger or a LargePositiveInteger less than 2-to-the-30th (1073741824). Optional. See
- Object documentation whatIsAPrimitive."
<primitive: 22>
^super - anInteger!
Item was changed:
----- Method: LargePositiveInteger>>/ (in category 'arithmetic') -----
/ anInteger
"Primitive. Divide the receiver by the argument and answer with the
+ result if the division is exact. Fail if the result is not a whole integer.
+ Fail if the argument is 0. Fail if either the argument or the result is not in 64 bit range.
+ Optional. See Object documentation whatIsAPrimitive."
- result if the division is exact. Fail if the result is not a whole integer.
- Fail if the argument is 0. Fail if either the argument or the result is not
- a SmallInteger or a LargePositiveInteger less than 2-to-the-30th (1073741824). Optional. See
- Object documentation whatIsAPrimitive. "
<primitive: 30>
^super / anInteger!
Item was changed:
----- Method: LargePositiveInteger>>// (in category 'arithmetic') -----
// anInteger
"Primitive. Divide the receiver by the argument and return the result.
+ Round the result down towards negative infinity to make it a whole
+ integer. Fail if the argument is 0. Fail if either the argument or the
+ result is not in 64 bit range.
+ Optional. See Object documentation whatIsAPrimitive."
- Round the result down towards negative infinity to make it a whole
- integer. Fail if the argument is 0. Fail if either the argument or the
- result is not a SmallInteger or a LargePositiveInteger less than 2-to-the-30th (1073741824).
- Optional. See Object documentation whatIsAPrimitive. "
<primitive: 32>
^super // anInteger!
Item was changed:
----- Method: LargePositiveInteger>>< (in category 'comparing') -----
< anInteger
+ "Primitive. Compare the receiver with the argument and answer if the
+ receiver is less than the argument. Fail if either the argument or the
+ result is not in 64 bit range.
+ Optional. See Object documentation whatIsAPrimitive."
- "Primitive. Compare the receiver with the argument and answer true if
- the receiver is less than the argument. Otherwise answer false. Fail if the
- argument is not a SmallInteger or a LargePositiveInteger less than 2-to-the-30th (1073741824).
- Optional. See Object documentation whatIsAPrimitive."
<primitive: 23>
^super < anInteger!
Item was changed:
----- Method: LargePositiveInteger>><= (in category 'comparing') -----
<= anInteger
+ "Primitive. Compare the receiver with the argument and answer if the
+ receiver is less than or equal to the argument. Fail if the argument is
+ not a SmallInteger or a LargePositiveInteger in the 64 bit range.
+ Optional. See Object documentation whatIsAPrimitive."
- "Primitive. Compare the receiver with the argument and answer true if
- the receiver is less than or equal to the argument. Otherwise answer false.
- Fail if the argument is not a SmallInteger or a LargePositiveInteger less
- than 2-to-the-30th (1073741824). Optional. See Object documentation whatIsAPrimitive."
<primitive: 25>
^super <= anInteger!
Item was changed:
----- Method: LargePositiveInteger>>> (in category 'comparing') -----
> anInteger
+ "Primitive. Compare the receiver with the argument and answer if the
+ receiver is greater than the argument. Fail if the argument is
+ not a SmallInteger or a LargePositiveInteger in the 64 bit range.
+ Optional. See Object documentation whatIsAPrimitive."
- "Primitive. Compare the receiver with the argument and answer true if
- the receiver is greater than the argument. Otherwise answer false. Fail if
- the argument is not a SmallInteger or a LargePositiveInteger less than
- 2-to-the-30th (1073741824). Optional. See Object documentation whatIsAPrimitive."
<primitive: 24>
^super > anInteger!
Item was changed:
----- Method: LargePositiveInteger>>>= (in category 'comparing') -----
>= anInteger
+ "Primitive. Compare the receiver with the argument and answer if the
+ receiver is greater than or equal to the argument. Fail if the argument
+ is not a SmallInteger or a LargePositiveInteger in the 64 bit range.
+ Optional. See Object documentation whatIsAPrimitive."
- "Primitive. Compare the receiver with the argument and answer true if
- the receiver is greater than or equal to the argument. Otherwise answer
- false. Fail if the argument is not a SmallInteger or a LargePositiveInteger
- less than 2-to-the-30th (1073741824). Optional. See Object documentation whatIsAPrimitive."
<primitive: 26>
^super >= anInteger!
Item was changed:
----- Method: LargePositiveInteger>>\\ (in category 'arithmetic') -----
\\ aNumber
"Primitive. Take the receiver modulo the argument. The result is the
+ remainder rounded towards negative infinity, of the receiver divided
+ by the argument. Fail if the argument is 0. Fail if either the argument
+ or the result is not a SmallInteger or a LargePositiveInteger in the 64 bit range.
+ Optional. See Object documentation whatIsAPrimitive."
- remainder rounded towards negative infinity, of the receiver divided
- by the argument. Fail if the argument is 0. Fail if either the argument
- or the result is not a SmallInteger or a LargePositiveInteger less than
- 2-to-the-30th (1073741824). Optional. See Object documentation whatIsAPrimitive."
<primitive: 31>
aNumber isInteger
ifTrue:
[| neg qr q r |
neg := self negative == aNumber negative == false.
qr := self digitDiv: aNumber neg: neg.
q := qr first normalize.
r := qr last normalize.
^(q negative
ifTrue: [r isZero not]
ifFalse: [q isZero and: [neg]])
ifTrue: [r + aNumber]
ifFalse: [r]].
^super \\ aNumber
!
Item was changed:
----- Method: LargePositiveInteger>>quo: (in category 'arithmetic') -----
quo: anInteger
+ "Primitive. Divide the receiver by the argument and answer the result.
+ Round the result down towards zero to make it a whole integer. Fail if
+ the argument is 0. Fail if either the argument or the result is not a
+ SmallInteger or a LargePositiveInteger in the 64 bit range.
+ Optional. See Object documentation whatIsAPrimitive."
- "Primitive. Divide the receiver by the argument and return the result.
- Round the result down towards zero to make it a whole integer. Fail if
- the argument is 0. Fail if either the argument or the result is not a
- SmallInteger or a LargePositiveInteger less than 2-to-the-30th (1073741824). Optional. See
- Object documentation whatIsAPrimitive."
<primitive: 33>
^super quo: anInteger!
Item was changed:
----- Method: LargePositiveInteger>>rem: (in category 'arithmetic') -----
rem: aNumber
+ "Remainder defined in terms of quo:. See super rem:. Fail if
+ the argument is 0. Fail if either the argument or the result is not a
+ SmallInteger or a LargePositiveInteger in the 64 bit range.
+ Optional. See Object documentation whatIsAPrimitive."
- "Remainder defined in terms of quo:. See super rem:.
- This is defined only to speed up case of large integers."
<primitive: 20>
aNumber isInteger
ifTrue:
[| ng rem |
ng := self negative == aNumber negative == false.
rem := (self digitDiv: aNumber neg: ng) at: 2.
^ rem normalize].
^super rem: aNumber!
Item was added:
+ ----- Method: LargePositiveInteger>>~= (in category 'comparing') -----
+ ~= anInteger
+ "Primitive. Compare the receiver with the argument and answer if the
+ receiver is equal to the argument. Fail if the receiver or argument is not
+ an integer in the 64 bit range.
+ Optional. See Object documentation whatIsAPrimitive."
+
+ <primitive: 28>
+ ^super ~= anInteger!
Item was changed:
----- Method: ProcessorScheduler>>highestPriority: (in category 'accessing') -----
highestPriority: newHighestPriority
"Change the number of priority levels currently available for use."
+ | newProcessLists |
- | continue newProcessLists |
(quiescentProcessLists size > newHighestPriority
and: [self anyProcessesAbove: newHighestPriority])
ifTrue: [self error: 'There are processes with priority higher than '
,newHighestPriority printString].
newProcessLists := Array new: newHighestPriority.
1 to: ((quiescentProcessLists size) min: (newProcessLists size)) do:
[:priority | newProcessLists at: priority put: (quiescentProcessLists at: priority)].
+ (quiescentProcessLists size max: 1) to: newProcessLists size do:
- quiescentProcessLists size to: newProcessLists size do:
[:priority | newProcessLists at: priority put: LinkedList new].
quiescentProcessLists := newProcessLists!
Item was changed:
----- Method: SmallInteger>>bitAnd: (in category 'bit manipulation') -----
bitAnd: arg
+ "Primitive. Answer an Integer whose bits are the logical AND of the
+ receiver's bits and those of the argument, arg.
+ Numbers are interpreted as having 2's-complement representation.
+ Essential. See Object documentation whatIsAPrimitive."
- "Primitive. Answer an Integer whose bits are the logical OR of the
- receiver's bits and those of the argument, arg.
- Numbers are interpreted as having 2's-complement representation.
- Essential. See Object documentation whatIsAPrimitive."
<primitive: 14>
+ self >= 0 ifTrue: [^arg bitAnd: self].
+ ^arg < 0
- self >= 0 ifTrue: [^ arg bitAnd: self].
- ^ arg < 0
ifTrue: [(arg bitInvert bitOr: self bitInvert) bitInvert]
ifFalse: [arg bitClear: self bitInvert]!
Eliot Miranda uploaded a new version of Files to project The Trunk:
http://source.squeak.org/trunk/Files-eem.171.mcz
==================== Summary ====================
Name: Files-eem.171
Author: eem
Time: 25 May 2017, 3:35:29.716969 pm
UUID: dbf98ee2-b593-4ede-b2de-0a188c125144
Ancestors: Files-nice.170
Fix case sensitivity in nextNameFor:extension:. Harvested from Terf.
=============== Diff against Files-nice.170 ===============
Item was changed:
----- Method: FileDirectory>>nextNameFor:extension: (in category 'file name utilities') -----
nextNameFor: baseFileName extension: extension
"Assumes a file name includes a version number encoded as '.' followed by digits
preceding the file extension. Increment the version number and answer the new file name.
If a version number is not found, set the version to 1 and answer a new file name"
| files splits version |
files := self fileNamesMatching: (baseFileName,'*', self class dot, extension).
splits := files
collect: [:file | self splitNameVersionExtensionFor: file]
+ thenSelect:
+ [:split |
+ self isCaseSensitive
+ ifTrue:[(split at: 1) = baseFileName]
+ ifFalse:[(split at: 1) match: baseFileName]].
+ version := splits isEmpty
+ ifTrue: [1]
+ ifFalse: [((splits detectMax: [ :each | each at: 2 ]) at: 2) + 1].
- thenSelect: [:split | (split at: 1) = baseFileName].
- splits isEmpty
- ifTrue: [version := 1]
- ifFalse: [version := ((splits detectMax: [ :each | each at: 2 ]) at: 2) + 1].
^ (baseFileName, '.', version asString, self class dot, extension) asFileName!
Eliot Miranda uploaded a new version of EToys to project The Trunk:
http://source.squeak.org/trunk/EToys-eem.299.mcz
==================== Summary ====================
Name: EToys-eem.299
Author: eem
Time: 25 May 2017, 3:33:43.83519 pm
UUID: df231eba-abab-41c8-b8ad-3234acf71771
Ancestors: EToys-ul.298
forgetDoIts is no longer necessary.
=============== Diff against EToys-ul.298 ===============
Item was changed:
----- Method: DialectParser class>>test (in category 'as yet unclassified') -----
test "DialectParser test"
"PrettyPrints the source for every method in the system in the alternative syntax, and then compiles that source and verifies that it generates identical code. No changes are actually made to the system. At the time of this writing, only two methods caused complaints (reported in Transcript and displayed in browse window after running):
BalloonEngineSimulation circleCosTable and
BalloonEngineSimulation circleSinTable.
These are not errors, but merely a case of Floats embedded in literal arrays, and thus not specially checked for roundoff errors.
Note that if an error or interruption occurs during execution of this method, the alternativeSyntax preference will be left on.
NOTE: Some methods may not compare properly until the system has been recompiled once. Do this by executing...
Smalltalk recompileAllFrom: 'AARDVAARK'.
"
| newCodeString methodNode oldMethod newMethod badOnes n heading |
Preferences enable: #printAlternateSyntax.
badOnes := OrderedCollection new.
Transcript clear.
- Smalltalk forgetDoIts.
'Formatting and recompiling all classes...'
displayProgressAt: Sensor cursorPoint
from: 0 to: CompiledMethod instanceCount
during: [:bar | n := 0.
Smalltalk allClassesDo: "{MethodNode} do:" "<- to check one class"
[:nonMeta | "Transcript cr; show: nonMeta name."
{nonMeta. nonMeta class} do:
[:cls |
cls selectors do:
[:selector | (n := n+1) \\ 100 = 0 ifTrue: [bar value: n].
newCodeString := (cls compilerClass new)
format: (cls sourceCodeAt: selector)
in: cls notifying: nil decorated: Preferences colorWhenPrettyPrinting.
heading := cls organization categoryOfElement: selector.
methodNode := cls compilerClass new
compile: newCodeString
in: cls notifying: (SyntaxError new category: heading)
ifFail: [].
newMethod := methodNode generate: CompiledMethodTrailer empty.
oldMethod := cls compiledMethodAt: selector.
"Transcript cr; show: cls name , ' ' , selector."
oldMethod = newMethod ifFalse:
[Transcript cr; show: '***' , cls name , ' ' , selector.
oldMethod size = newMethod size ifFalse:
[Transcript show: ' difft size'].
oldMethod header = newMethod header ifFalse:
[Transcript show: ' difft header'].
oldMethod literals = newMethod literals ifFalse:
[Transcript show: ' difft literals'].
Transcript endEntry.
badOnes add: cls name , ' ' , selector]]]].
].
self systemNavigation browseMessageList: badOnes sort name: 'Formatter Discrepancies'.
Preferences disable: #printAlternateSyntax.
!
Item was changed:
----- Method: SystemDictionary>>abandonTempNames (in category '*Etoys-Squeakland-shrinking') -----
abandonTempNames
"Replaces every method by a copy with no source pointer or
encoded temp names."
"Smalltalk abandonTempNames"
| oldMethods newMethods n m |
+ self garbageCollect.
- self forgetDoIts; garbageCollect.
oldMethods := OrderedCollection new.
newMethods := OrderedCollection new.
n := 0.
'Removing temp names to save space...'
displayProgressAt: Sensor cursorPoint
from: 0
to: CompiledMethod instanceCount
during: [:bar | self systemNavigation
allBehaviorsDo: [:cl | cl selectors
do: [:sel |
bar value: (n := n + 1).
m := cl compiledMethodAt: sel.
oldMethods addLast: m.
newMethods
addLast: (m copyWithTrailerBytes: #(0 ))]]].
oldMethods asArray elementsExchangeIdentityWith: newMethods asArray.
SmalltalkImage current closeSourceFiles.
self flag: #shouldUseAEnsureBlockToBeSureThatTheFileIsClosed.
"sd: 17 April 2003"
Preferences disable: #warnIfNoChangesFile.
Preferences disable: #warnIfNoSourcesFile!
On 5/23/17, Hari Balaraman via Cuis-dev <cuis-dev(a)cuis-smalltalk.org> wrote:
> Congratulations ! Go Juan!
+1
Hannes
> Hari
>
>> On May 23, 2017, at 11:47 AM, Juan Vuletich via Cuis-dev
>> <cuis-dev(a)cuis-smalltalk.org> wrote:
>>
>> Hi Folks,
>>
>> Satellogic was featured today at Nature News!
>> http://www.nature.com/news/earth-observing-companies-push-for-more-advanced…
>>
>> I helped design and build the hyperspectral cameras in our satellites
>> Fresco and Batata. And I wrote the geometric and spectral processing
>> software for that image. This is not completely off topic, though: The
>> geometric software (image rectification and correction), the most complex
>> part of the processing, was written by me in Cuis Smalltalk, and runs in a
>> Cuis Smalltalk + OpenCL application.
>>
>> Please share my joy today!
>>
>> --
>> Juan Vuletich
>> www.cuis-smalltalk.org
>> https://github.com/Cuis-Smalltalk/Cuis-Smalltalk-Dev
>> @JuanVuletich
>>
>>
>>
>> _______________________________________________
>> Cuis-dev mailing list
>> Cuis-dev(a)cuis-smalltalk.org
>> http://cuis-smalltalk.org/mailman/listinfo/cuis-dev_cuis-smalltalk.org
>
> _______________________________________________
> Cuis-dev mailing list
> Cuis-dev(a)cuis-smalltalk.org
> http://cuis-smalltalk.org/mailman/listinfo/cuis-dev_cuis-smalltalk.org
>