Packages December 2014

packages@lists.squeakfoundation.org

1 participants
153 discussions

The Trunk: Monticello-eem.606.mcz
by commits＠source.squeak.org 06 Dec '14

06 Dec '14

Eliot Miranda uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-eem.606.mcz ==================== Summary ==================== Name: Monticello-eem.606 Author: eem Time: 6 December 2014, 12:53:02.345 pm UUID: a82ff1d4-aae4-466c-8d74-5fb75ace18a4 Ancestors: Monticello-dtl.605 Include the old list of changes in the screed provided at the end of the save dialog. This text is useful when writing detailed check-in comments. Categorise the save dialog methods. =============== Diff against Monticello-dtl.605 =============== Item was changed: + ----- Method: MCSaveVersionDialog>>buttonSpecs (in category 'ui') ----- - ----- Method: MCSaveVersionDialog>>buttonSpecs (in category 'as yet unclassified') ----- buttonSpecs ^ #((Accept accept 'accept version name and log message') (Cancel cancel 'cancel saving version') ) ! Item was changed: + ----- Method: MCSaveVersionDialog>>defaultExtent (in category 'ui') ----- - ----- Method: MCSaveVersionDialog>>defaultExtent (in category 'as yet unclassified') ----- defaultExtent ^ 700@600! Item was changed: + ----- Method: MCSaveVersionDialog>>defaultLabel (in category 'ui') ----- - ----- Method: MCSaveVersionDialog>>defaultLabel (in category 'as yet unclassified') ----- defaultLabel ^ 'Edit Version Name and Message:'! Item was changed: + ----- Method: MCSaveVersionDialog>>list (in category 'accessing') ----- - ----- Method: MCSaveVersionDialog>>list (in category 'as yet unclassified') ----- list ^ self items collect: [:ea | (self ignore includes: ea) ifFalse: [ea summary] ifTrue: [Text string: '( ', ea summary, ' )' attribute: TextEmphasis struckOut ]]! Item was changed: + ----- Method: MCSaveVersionDialog>>logMessage (in category 'accessing') ----- - ----- Method: MCSaveVersionDialog>>logMessage (in category 'as yet unclassified') ----- logMessage ^ message ifNil: ['empty log message']! Item was changed: + ----- Method: MCSaveVersionDialog>>logMessage: (in category 'accessing') ----- - ----- Method: MCSaveVersionDialog>>logMessage: (in category 'as yet unclassified') ----- logMessage: aString message := aString. self changed: #logMessage! Item was changed: + ----- Method: MCSaveVersionDialog>>methodListKey:from: (in category 'menus') ----- - ----- Method: MCSaveVersionDialog>>methodListKey:from: (in category 'as yet unclassified') ----- methodListKey: aKeystroke from: aListMorph aKeystroke caseOf: { [$I] -> [self ignoreSelection]. } otherwise: [super methodListKey: aKeystroke from: aListMorph ]! Item was changed: + ----- Method: MCSaveVersionDialog>>methodListMenu: (in category 'accessing') ----- - ----- Method: MCSaveVersionDialog>>methodListMenu: (in category 'as yet unclassified') ----- methodListMenu: aMenu aMenu addList:#( ('ignore (I)' ignoreSelection 'Do not include this change when saving') -). super methodListMenu: aMenu. ^aMenu! Item was changed: + ----- Method: MCSaveVersionDialog>>representsSameBrowseeAs: (in category 'ui') ----- - ----- Method: MCSaveVersionDialog>>representsSameBrowseeAs: (in category 'as yet unclassified') ----- representsSameBrowseeAs: anotherModel ^ self class = anotherModel class and: [ self versionName = anotherModel versionName ]! Item was changed: + ----- Method: MCSaveVersionDialog>>updateItems (in category 'ui') ----- - ----- Method: MCSaveVersionDialog>>updateItems (in category 'as yet unclassified') ----- updateItems " update our items using the patchBlock " self patch: patchBlock value! Item was changed: + ----- Method: MCSaveVersionDialog>>versionName (in category 'accessing') ----- - ----- Method: MCSaveVersionDialog>>versionName (in category 'as yet unclassified') ----- versionName ^ name! Item was changed: + ----- Method: MCSaveVersionDialog>>versionName: (in category 'accessing') ----- - ----- Method: MCSaveVersionDialog>>versionName: (in category 'as yet unclassified') ----- versionName: aString name := aString. self changed: #versionName! Item was changed: + ----- Method: MCSaveVersionDialog>>widgetSpecs (in category 'ui') ----- - ----- Method: MCSaveVersionDialog>>widgetSpecs (in category 'as yet unclassified') ----- widgetSpecs ^ #( ((listMorph:selection:menu:keystroke: list selection methodListMenu: methodListKey:from:) (0 0 0.5 0.6) ) ((textMorph: versionName) (0.5 0 1 0) (0 0 0 30)) ((textMorph: logMessage) (0.5 0 1 0.6) (0 30 0 -30)) ((buttonRow) (0.5 0.6 1 0.6) (0 -30 0 0)) ((textMorph: text) (0 0.6 1 1) (0 0 0 0)) )! Item was changed: ----- Method: MCWorkingCopy>>patchMessageSuggestion (in category 'operations') ----- patchMessageSuggestion ^ String streamContents: [:strm | strm nextPutAll: self patchMessageDefault; cr;cr; nextPutAll: self patchMessageChangesDelimiter; cr; + nextPutAll: self patchMessageAncestry; cr; cr; + nextPutAll: self patchMessageChanges]! - nextPutAll: self patchMessageAncestry]!

1 0

The Trunk: Monticello-eem.606.mcz
by commits＠source.squeak.org 06 Dec '14

06 Dec '14

1 0

The Trunk: Tools-eem.530.mcz
by commits＠source.squeak.org 06 Dec '14

06 Dec '14

Eliot Miranda uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-eem.530.mcz ==================== Summary ==================== Name: Tools-eem.530 Author: eem Time: 6 December 2014, 12:46:32.373 pm UUID: 360aa978-7b45-44b7-917e-37a00a467589 Ancestors: Tools-eem.529 Don't make the assumption that Smalltalk at: answers a class. Hence fix scanning a source file that includes a definition for TextConstants. Fix runUntil to not return. Add an inspect key item to the DictionaryInspector. =============== Diff against Tools-eem.529 =============== Item was changed: ----- Method: ChangeList>>scanCategory:class:meta:stamp: (in category 'scanning') ----- scanCategory: category class: class meta: meta stamp: stamp | itemPosition method selector | [itemPosition := file position. method := file nextChunk. file skipStyleChunk. method size > 0] "done when double terminators" whileTrue: [self addItem: (ChangeRecord new file: file position: itemPosition type: #method class: class category: category meta: meta stamp: stamp) text: 'method: ' , class , (meta ifTrue: [' class '] ifFalse: [' ']) + , ((selector := ((Smalltalk classNamed: class) ifNil: [Object]) newParser parseSelector: method) isNil - , ((selector := (Smalltalk at: class ifAbsent: [Object]) newParser parseSelector: method) isNil ifTrue: ['unparsableSelector'] ifFalse: [selector]) , (stamp isEmpty ifTrue: [''] ifFalse: ['; ' , stamp])]! Item was changed: ----- Method: Debugger>>runUntil (in category 'code pane menu') ----- runUntil "Step until an expression evaluates to other than false, reporting an error if it doesn't evaluate to true. Remember the expression in an inst var. If shift is pressed when the expression is supplied, don't update the UI. If shift is pressed while stepping, stop stepping. Using a user interrupt to break out would be more natural but Squeak currently doesn't provide a UserInterrupt expection. It should do." | expression receiver context method value lastUpdate updateUI breakOnShift | expression := UIManager default request: 'run until expression is true (shift to disable ui update; shift to break).' initialAnswer: (untilExpression ifNil: 'boolean expression'). (expression isNil or: [expression isEmpty]) ifTrue: [^self]. updateUI := breakOnShift := Sensor shiftPressed not. untilExpression := expression. context := self selectedContext. receiver := context receiver. method := receiver class evaluatorClass new compiledMethodFor: untilExpression in: context to: receiver notifying: nil ifFail: [^ #failedDoit]. lastUpdate := Time millisecondClockValue. Cursor execute showWhile: [[self selectedContext == context + and: [context willReturn not + and: [(value := receiver with: context executeMethod: method) == false]]] whileTrue: - and: [(value := receiver with: context executeMethod: method) == false]] whileTrue: [interruptedProcess completeStep: self selectedContext. self selectedContext == context ifTrue: [self resetContext: interruptedProcess stepToSendOrReturn changeContents: false]. Time millisecondClockValue - lastUpdate > 50 ifTrue: [updateUI ifTrue: [self changed: #contentsSelection. World displayWorldSafely]. breakOnShift ifTrue: [Sensor shiftPressed ifTrue: [self changed: #contentsSelection. self updateInspectors. ^self]] ifFalse: [Sensor shiftPressed ifFalse: [breakOnShift := true]]. lastUpdate := Time millisecondClockValue]]]. self changed: #contentsSelection. self updateInspectors. (value ~~ false and: [value ~~ true]) ifTrue: [UIManager default inform: 'expression ', (untilExpression contractTo: 40), ' answered ', (value printString contractTo: 20), '!!!!']! Item was changed: ----- Method: DictionaryInspector>>fieldListMenu: (in category 'menu') ----- fieldListMenu: aMenu ^ aMenu labels: 'inspect + inspect key copy name references objects pointing to this value senders of this key refresh view add key rename key remove basic inspect' lines: #(6 9) + selections: #(inspectSelection inspectKey copyName selectionReferences objectReferencesToSelection sendersOfSelectedKey refreshView addEntry renameEntry removeSelection inspectBasic) - selections: #(inspectSelection copyName selectionReferences objectReferencesToSelection sendersOfSelectedKey refreshView addEntry renameEntry removeSelection inspectBasic) ! Item was added: + ----- Method: DictionaryInspector>>inspectKey (in category 'menu commands') ----- + inspectKey + "Create and schedule an Inspector on the receiver's model's currently selected key." + + selectionIndex >= self numberOfFixedFields ifTrue: + [(keyArray at: selectionIndex - self numberOfFixedFields) inspect]!

1 0

The Trunk: Tools-eem.530.mcz
by commits＠source.squeak.org 06 Dec '14

06 Dec '14

1 0

The Trunk: Tools-eem.530.mcz
by commits＠source.squeak.org 06 Dec '14

06 Dec '14

1 0

The Trunk: Kernel.spur-eem.889.mcz
by commits＠source.squeak.org 01 Dec '14

01 Dec '14

Eliot Miranda uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel.spur-eem.889.mcz ==================== Summary ==================== Name: Kernel.spur-eem.889 Author: eem Time: 1 December 2014, 2:43:06.775 pm UUID: af61270d-52e8-41ac-a425-732d7ece81a5 Ancestors: Kernel-eem.889, Kernel.spur-eem.888 Kernel-eem.889 patched for Spur by SpurBootstrapMonticelloPackagePatcher Cog-eem.226 Provide a plausible definition of CompiledMethod>>copyFrom: that at least works with compiled methods and e.g. Array. =============== Diff against Kernel-eem.889 =============== Item was changed: ----- Method: Behavior>>allInstances (in category 'accessing instances and variables') ----- + allInstances + "Answer all instances of the receiver." + <primitive: 177> + "The primitive can fail because memory is low. If so, fall back on the old + enumeration code, which gives the system a chance to GC and/or grow. + Because aBlock might change the class of inst (for example, using become:), + it is essential to compute next before aBlock value: inst." + | inst insts next | + insts := WriteStream on: (Array new: 64). + inst := self someInstance. + [inst == nil] whileFalse: + [next := inst nextInstance. + (inst == insts or: [inst == insts originalContents]) ifFalse: [insts nextPut: inst]. + inst := next]. + ^insts contents! - allInstances - "Answer a collection of all current instances of the receiver." - - | all | - all := OrderedCollection new. - self allInstancesDo: [:x | x == all ifFalse: [all add: x]]. - ^ all asArray - ! Item was changed: ----- Method: Behavior>>allInstancesDo: (in category 'enumerating') ----- + allInstancesDo: aBlock + "Evaluate aBlock with each of the current instances of the receiver." + | instances inst next | + instances := self allInstancesOrNil. + instances ifNotNil: + [instances do: aBlock. + ^self]. + "allInstancesOrNil can fail because memory is low. If so, fall back on the old + enumeration code. Because aBlock might change the class of inst (for example, + using become:), it is essential to compute next before aBlock value: inst." - allInstancesDo: aBlock - "Evaluate the argument, aBlock, for each of the current instances of the - receiver. - - Because aBlock might change the class of inst (for example, using become:), - it is essential to compute next before aBlock value: inst." - | inst next | inst := self someInstance. + [inst == nil] whileFalse: + [next := inst nextInstance. + aBlock value: inst. + inst := next]! - [inst == nil] - whileFalse: - [ - next := inst nextInstance. - aBlock value: inst. - inst := next]! Item was added: + ----- Method: Behavior>>allInstancesOrNil (in category 'enumerating') ----- + allInstancesOrNil + "Answer all instances of the receiver, or nil if the primitive + fails, which it may be due to being out of memory." + <primitive: 177> + ^nil! Item was changed: ----- Method: Behavior>>basicNew (in category 'instance creation') ----- basicNew "Primitive. Answer an instance of the receiver (which is a class) with no + indexable variables. Fail if the class is indexable. Essential. See Object + documentation whatIsAPrimitive. + + If the primitive fails because space is low then the scavenger will run + before the method is activated. Check that space was low and retry + via handleFailingBasicNew if so." - indexable variables. Fail if the class is indexable. Essential. See Object - documentation whatIsAPrimitive." + <primitive: 70 error: ec> + ec == #'insufficient object memory' ifTrue: + [^self handleFailingBasicNew]. + self isVariable ifTrue: [^self basicNew: 0]. + self primitiveFailed! - <primitive: 70> - self isVariable ifTrue: [ ^ self basicNew: 0 ]. - "space must be low" - OutOfMemory signal. - ^ self basicNew "retry if user proceeds" - ! Item was changed: ----- Method: Behavior>>basicNew: (in category 'instance creation') ----- + basicNew: sizeRequested + "Primitive. Answer an instance of this class with the number of indexable + variables specified by the argument, sizeRequested. Fail if this class is not + indexable or if the argument is not a positive Integer, or if there is not + enough memory available. Essential. See Object documentation whatIsAPrimitive. + + If the primitive fails because space is low then the scavenger will run before the + method is activated. Check args and retry via handleFailingBasicNew: if they're OK." - basicNew: sizeRequested - "Primitive. Answer an instance of this class with the number - of indexable variables specified by the argument, sizeRequested. - Fail if this class is not indexable or if the argument is not a - positive Integer, or if there is not enough memory available. - Essential. See Object documentation whatIsAPrimitive." + <primitive: 71 error: ec> + ec == #'insufficient object memory' ifTrue: + [^self handleFailingBasicNew: sizeRequested]. - <primitive: 71> self isVariable ifFalse: [self error: self printString, ' cannot have variable sized instances']. - (sizeRequested isInteger and: [sizeRequested >= 0]) ifTrue: - ["arg okay; space must be low." - OutOfMemory signal. - ^ self basicNew: sizeRequested "retry if user proceeds"]. self primitiveFailed! Item was added: + ----- Method: Behavior>>byteSizeOfInstance (in category 'accessing instances and variables') ----- + byteSizeOfInstance + "Answer the total memory size of an instance of the receiver." + + <primitive: 181 error: ec> + self isVariable ifTrue: + [^self byteSizeOfInstanceOfSize: 0]. + self primitiveFailed! Item was added: + ----- Method: Behavior>>byteSizeOfInstanceOfSize: (in category 'accessing instances and variables') ----- + byteSizeOfInstanceOfSize: basicSize + "Answer the total memory size of an instance of the receiver + with the given number of indexable instance variables." + + <primitive: 181 error: ec> + self isVariable + ifTrue: "If the primitive overflowed answer a close approximation" + [(basicSize isInteger + and: [basicSize >= 16r1000000]) ifTrue: + [^2 * (self byteSizeOfInstanceOfSize: basicSize + 1 // 2) + - (self byteSizeOfInstanceOfSize: 0)]] + ifFalse: + [basicSize = 0 ifTrue: + [^self byteSizeOfInstance]]. + self primitiveFailed! Item was added: + ----- Method: Behavior>>elementSize (in category 'accessing instances and variables') ----- + elementSize + "Answer the size in bytes of an element in the receiver. The formats are + 0 = 0 sized objects (UndefinedObject True False et al) + 1 = non-indexable objects with inst vars (Point et al) + 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) + 4 = weak indexable objects with inst vars (WeakArray et al) + 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) + 6 = unused + 7 = immediates (SmallInteger, Character) + 8 = unused + 9 = 64-bit indexable + 10-11 = 32-bit indexable (Bitmap) + 12-15 = 16-bit indexable + 16-23 = 8-bit indexable + 24-31 = compiled methods (CompiledMethod)" + | instSpec | + instSpec := self instSpec. + instSpec < 9 ifTrue: [^Smalltalk wordSize]. + instSpec >= 16 ifTrue: [^1]. + instSpec >= 12 ifTrue: [^2]. + instSpec >= 10 ifTrue: [^4]. + ^8! Item was added: + ----- Method: Behavior>>handleFailingBasicNew (in category 'private') ----- + handleFailingBasicNew + "handleFailingBasicNew gets sent after basicNew has failed and allowed + a scavenging garbage collection to occur. The scavenging collection + will have happened as the VM is activating the (failing) basicNew. If + handleFailingBasicNew fails then the scavenge failed to reclaim sufficient + space and a global garbage collection is required. Retry after garbage + collecting and growing memory if necessary. + + Primitive. Answer an instance of this class with the number of indexable + variables specified by the argument, sizeRequested. Fail if this class is not + indexable or if the argument is not a positive Integer, or if there is not + enough memory available. Essential. See Object documentation whatIsAPrimitive." + + <primitive: 70> + Smalltalk garbageCollect < 1048576 ifTrue: + [Smalltalk growMemoryByAtLeast: 1048576]. + ^self handleFailingFailingBasicNew "retry after global garbage collect"! Item was added: + ----- Method: Behavior>>handleFailingBasicNew: (in category 'private') ----- + handleFailingBasicNew: sizeRequested + "handleFailingBasicNew: gets sent after basicNew: has failed and allowed + a scavenging garbage collection to occur. The scavenging collection + will have happened as the VM is activating the (failing) basicNew:. If + handleFailingBasicNew: fails then the scavenge failed to reclaim sufficient + space and a global garbage collection is required. Retry after garbage + collecting and growing memory if necessary. + + Primitive. Answer an instance of this class with the number of indexable + variables specified by the argument, sizeRequested. Fail if this class is not + indexable or if the argument is not a positive Integer, or if there is not + enough memory available. Essential. See Object documentation whatIsAPrimitive." + + <primitive: 71> + | bytesRequested | + bytesRequested := self byteSizeOfInstanceOfSize: sizeRequested. + Smalltalk garbageCollect < bytesRequested ifTrue: + [Smalltalk growMemoryByAtLeast: bytesRequested]. + "retry after global garbage collect and possible grow" + ^self handleFailingFailingBasicNew: sizeRequested! Item was added: + ----- Method: Behavior>>handleFailingFailingBasicNew (in category 'private') ----- + handleFailingFailingBasicNew + "This basicNew gets sent after handleFailingBasicNew: has done a full + garbage collection and possibly grown memory. If this basicNew fails + then the system really is low on space, so raise the OutOfMemory signal. + + Primitive. Answer an instance of this class with the number of indexable + variables specified by the argument, sizeRequested. Fail if this class is not + indexable or if the argument is not a positive Integer, or if there is not + enough memory available. Essential. See Object documentation whatIsAPrimitive." + + <primitive: 70> + "space must be low" + OutOfMemory signal. + ^self basicNew "retry if user proceeds"! Item was added: + ----- Method: Behavior>>handleFailingFailingBasicNew: (in category 'private') ----- + handleFailingFailingBasicNew: sizeRequested + "This basicNew: gets sent after handleFailingBasicNew: has done a full + garbage collection and possibly grown memory. If this basicNew: fails + then the system really is low on space, so raise the OutOfMemory signal. + + Primitive. Answer an instance of this class with the number of indexable + variables specified by the argument, sizeRequested. Fail if this class is not + indexable or if the argument is not a positive Integer, or if there is not + enough memory available. Essential. See Object documentation whatIsAPrimitive." + + <primitive: 71> + "space must be low." + OutOfMemory signal. + ^self basicNew: sizeRequested "retry if user proceeds"! Item was added: + ----- Method: Behavior>>identityHash (in category 'comparing') ----- + identityHash + "Answer a SmallInteger whose value is related to the receiver's identity. + Behavior implements identityHash to allow the VM to use an object representation which + does not include a direct reference to an object's class in an object. If the VM is using + this implementation then classes are held in a class table and instances contain the index + of their class in the table. A class's class table index is its identityHash so that an instance + can be created without searching the table for a class's index. The VM uses this primitive + to enter the class into the class table, assigning its identityHash with an as yet unused + class table index. If this primitive fails it means that the class table is full. In Spur as of + 2014 there are 22 bits of classTable index and 22 bits of identityHash per object. + + Primitive. Essential. Do not override. See Object documentation whatIsAPrimitive." + + <primitive: 175> + self primitiveFailed! Item was changed: ----- Method: Behavior>>indexIfCompact (in category 'private') ----- indexIfCompact + "Backward compatibility with the Squeak V3 object format. + Spur does not have a distinction between compact and non-compact classes." + ^0! - "If these 5 bits are non-zero, then instances of this class - will be compact. It is crucial that there be an entry in - Smalltalk compactClassesArray for any class so optimized. - See the msgs becomeCompact and becomeUncompact." - ^ (format bitShift: -11) bitAnd: 16r1F - " - Smalltalk compactClassesArray doWithIndex: - [:c :i | c == nil ifFalse: - [c indexIfCompact = i ifFalse: [self halt]]] - "! Item was changed: ----- Method: Behavior>>instSize (in category 'testing') ----- instSize "Answer the number of named instance variables + (as opposed to indexed variables) of the receiver. + Above Cog Spur the class format is + <5 bits inst spec><16 bits inst size>" + ^format bitAnd: 16rFFFF! - (as opposed to indexed variables) of the receiver." - - self flag: #instSizeChange. "Smalltalk browseAllCallsOn: #instSizeChange" - " - NOTE: This code supports the backward-compatible extension to 8 bits of instSize. - When we revise the image format, it should become... - ^ ((format bitShift: -1) bitAnd: 16rFF) - 1 - Note also that every other method in this category will require - 2 bits more of right shift after the change. - " - ^ ((format bitShift: -10) bitAnd: 16rC0) + ((format bitShift: -1) bitAnd: 16r3F) - 1! Item was changed: ----- Method: Behavior>>instSpec (in category 'testing') ----- instSpec + "Answer the instance specification part of the format that defines what kind of object + an instance of the receiver is. The formats are + 0 = 0 sized objects (UndefinedObject True False et al) + 1 = non-indexable objects with inst vars (Point et al) + 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) + 4 = weak indexable objects with inst vars (WeakArray et al) + 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) + 6 = unused + 7 = immediates (SmallInteger, Character) + 8 = unused + 9 = 64-bit indexable + 10-11 = 32-bit indexable (Bitmap) + 12-15 = 16-bit indexable + 16-23 = 8-bit indexable + 24-31 = compiled methods (CompiledMethod)" + ^(format bitShift: -16) bitAnd: 16r1F! - ^ (format bitShift: -7) bitAnd: 16rF! Item was changed: ----- Method: Behavior>>isBits (in category 'testing') ----- isBits + "Answer whether the receiver contains just bits (not pointers). + Above Cog Spur the class format is + <5 bits inst spec><16 bits inst size> + where the 5-bit inst spec is + 0 = 0 sized objects (UndefinedObject True False et al) + 1 = non-indexable objects with inst vars (Point et al) + 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) + 4 = weak indexable objects with inst vars (WeakArray et al) + 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) + 6 = unused + 7 = immediates (SmallInteger, Character) + 8 = unused + 9 = 64-bit indexable + 10-11 = 32-bit indexable (Bitmap) + 12-15 = 16-bit indexable + 16-23 = 8-bit indexable + 24-31 = compiled methods (CompiledMethod)" + ^self instSpec >= 7! - "Answer whether the receiver contains just bits (not pointers)." - - ^ self instSpec >= 6! Item was changed: ----- Method: Behavior>>isBytes (in category 'testing') ----- isBytes + "Answer whether the receiver has 8-bit instance variables. + Above Cog Spur the class format is + <5 bits inst spec><16 bits inst size> + where the 5-bit inst spec is + 0 = 0 sized objects (UndefinedObject True False et al) + 1 = non-indexable objects with inst vars (Point et al) + 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) + 4 = weak indexable objects with inst vars (WeakArray et al) + 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) + 6 = unused + 7 = immediates (SmallInteger, Character) + 8 = unused + 9 = 64-bit indexable + 10-11 = 32-bit indexable (Bitmap) + 12-15 = 16-bit indexable + 16-23 = 8-bit indexable + 24-31 = compiled methods (CompiledMethod)" + ^self instSpec >= 16! - "Answer whether the receiver has 8-bit instance variables." - - ^ self instSpec >= 8! Item was added: + ----- Method: Behavior>>isCompiledMethodClass (in category 'as yet unclassified') ----- + isCompiledMethodClass + "Answer whether the receiver has compiled method instances that mix pointers and bytes." + ^self instSpec >= 24! Item was added: + ----- Method: Behavior>>isEphemeronClass (in category 'testing') ----- + isEphemeronClass + "Answer whether the receiver has ephemeral instance variables. The garbage collector will + fire (queue for finalization) any ephemeron whose first instance variable is not referenced + other than from the transitive closure of references from ephemerons. Hence referring to + an object from the first inst var of an ephemeron will cause the ephemeron to fire when + the rest of the system does not refer to the object and that object is ready to be collected. + Since references from the remaining inst vars of an ephemeron will not prevent the ephemeron + from firing, ephemerons may act as the associations in weak dictionaries such that the value + (e.g. properties attached to the key) will not prevent firing when the key is no longer referenced + other than from ephemerons. Ephemerons can therefore be used to implement instance-based + pre-mortem finalization." + ^self instSpec = 5! Item was added: + ----- Method: Behavior>>isImmediateClass (in category 'testing') ----- + isImmediateClass + "Answer whether the receiver has immediate instances. Immediate instances + store their value in their object pointer, not in an object body. Hence immediates + take no space and are immutable. The immediates are distinguished by tag bits + in the pointer. They include SmallIntegers and Characters. Hence in the 32-bit + system SmallIntegers are 31-bit signed integers and Characters are 30-bit + unsigned character codes." + ^self instSpec = 7! Item was changed: ----- Method: Behavior>>isVariable (in category 'testing') ----- isVariable + "Answer whether the receiver has indexable variables. + Above Cog Spur the class format is + <5 bits inst spec><16 bits inst size> + where the 5-bit inst spec is + 0 = 0 sized objects (UndefinedObject True False et al) + 1 = non-indexable objects with inst vars (Point et al) + 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) + 4 = weak indexable objects with inst vars (WeakArray et al) + 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) + 6 = unused + 7 = immediates (SmallInteger, Character) + 8 = unused + 9 = 64-bit indexable + 10-11 = 32-bit indexable (Bitmap) + 12-15 = 16-bit indexable + 16-23 = 8-bit indexable + 24-31 = compiled methods (CompiledMethod)" + | instSpec | + instSpec := self instSpec. + ^instSpec >= 2 and: [instSpec <= 4 or: [instSpec >= 9]]! - "Answer whether the receiver has indexable variables." - - ^ self instSpec >= 2! Item was changed: ----- Method: Behavior>>kindOfSubclass (in category 'testing class hierarchy') ----- kindOfSubclass + "Answer a String that is the keyword that describes the receiver's kind of subclass, + either a regular subclass, a variableSubclass, a variableByteSubclass, + a variableWordSubclass, a weakSubclass, an ephemeronSubclass or an immediateSubclass. + c.f. typeOfClass" + ^self isVariable + ifTrue: + [self isBits + ifTrue: + [self isBytes + ifTrue: [' variableByteSubclass: '] + ifFalse: [' variableWordSubclass: ']] + ifFalse: + [self isWeak + ifTrue: [' weakSubclass: '] + ifFalse: [' variableSubclass: ']]] + ifFalse: + [self isImmediateClass + ifTrue: [' immediateSubclass: '] + ifFalse: + [self isEphemeronClass + ifTrue: [' ephemeronSubclass: '] + ifFalse: [' subclass: ']]]! - "Answer a String that is the keyword that describes the receiver's kind - of subclass, either a regular subclass, a variableSubclass, a - variableByteSubclass, a variableWordSubclass, or a weakSubclass." - self isWeak - ifTrue: [^ ' weakSubclass: ']. - ^ self isVariable - ifTrue: [self isBits - ifTrue: [self isBytes - ifTrue: [ ' variableByteSubclass: '] - ifFalse: [ ' variableWordSubclass: ']] - ifFalse: [ ' variableSubclass: ']] - ifFalse: [ ' subclass: ']! Item was changed: ----- Method: Behavior>>shouldNotBeRedefined (in category 'testing') ----- shouldNotBeRedefined + "Answer if the receiver should not be redefined. + The assumption is that classes in Smalltalk specialObjects and + instance-specific Behaviors should not be redefined" - "Return true if the receiver should not be redefined. - The assumption is that compact classes, - classes in Smalltalk specialObjects and - Behaviors should not be redefined" + ^(Smalltalk specialObjectsArray + identityIndexOf: self + ifAbsent: [(self isKindOf: self) ifTrue: [1] ifFalse: [0]]) ~= 0! - ^(Smalltalk compactClassesArray includes: self) - or:[(Smalltalk specialObjectsArray includes: self) - or:[self isKindOf: self]]! Item was changed: ----- Method: Behavior>>typeOfClass (in category 'accessing') ----- typeOfClass + "Answer a symbol uniquely describing the type of the receiver. c.f. kindOfSubclass" + self isBytes ifTrue: + [^self instSpec = CompiledMethod instSpec + ifTrue: [#compiledMethod] "Very special!!" + ifFalse: [#bytes]]. + (self isWords and: [self isPointers not]) ifTrue: + [^self instSpec = SmallInteger instSpec + ifTrue: [#immediate] "Very special!!" + ifFalse: [#words]]. + self isWeak ifTrue: [^#weak]. + self isVariable ifTrue: [^#variable]. + self isEphemeronClass ifTrue: [^#ephemeron]. + ^#normal! - "Answer a symbol uniquely describing the type of the receiver" - self instSpec = CompiledMethod instSpec ifTrue:[^#compiledMethod]. "Very special!!" - self isBytes ifTrue:[^#bytes]. - (self isWords and:[self isPointers not]) ifTrue:[^#words]. - self isWeak ifTrue:[^#weak]. - self isVariable ifTrue:[^#variable]. - ^#normal.! Item was changed: ----- Method: BlockClosure>>simulateValueWithArguments:caller: (in category 'system simulation') ----- simulateValueWithArguments: anArray caller: aContext + "Simulate the valueWithArguments: primitive. Fail if anArray is not an array of the right arity." | newContext sz | - (anArray class ~~ Array - or: [numArgs ~= anArray size]) ifTrue: - [^ContextPart primitiveFailTokenFor: nil]. newContext := (MethodContext newForMethod: outerContext method) setSender: aContext receiver: outerContext receiver method: outerContext method closure: self startpc: startpc. + ((newContext objectClass: anArray) ~~ Array + or: [numArgs ~= anArray size]) ifTrue: + [^ContextPart primitiveFailTokenFor: nil]. sz := self basicSize. newContext stackp: sz + numArgs. 1 to: numArgs do: [:i| newContext at: i put: (anArray at: i)]. 1 to: sz do: [:i| newContext at: i + numArgs put: (self at: i)]. ^newContext! Item was added: + Float variableWordSubclass: #BoxedFloat64 + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel-Numbers'! + + !BoxedFloat64 commentStamp: 'eem 11/25/2014 07:54' prior: 0! + My instances hold 64-bit Floats in heap objects. This is the only representation on 32-bit systems. But on 64-bit systems SmallFloat64 holds a subset of the full 64-bit double-precision range in immediate objects.! Item was added: + ----- Method: BoxedFloat64 class>>basicNew (in category 'instance creation') ----- + basicNew + ^self basicNew: 2! Item was added: + ----- Method: BoxedFloat64 class>>basicNew: (in category 'instance creation') ----- + basicNew: sizeRequested + "Primitive. Answer an instance of this class with the number + of indexable variables specified by the argument, sizeRequested. + Fail if this class is not indexable or if the argument is not a + positive Integer, or if there is not enough memory available. + Essential. See Object documentation whatIsAPrimitive." + + <primitive: 71> + sizeRequested isInteger ifTrue: + [^sizeRequested = 2 + ifTrue: "arg okay; space must be low." + [OutOfMemory signal. + self basicNew: sizeRequested] "retry if user proceeds" + ifFalse: + [self error: 'a Float shall always have two slots']]. + self primitiveFailed! Item was added: + ----- Method: BoxedFloat64>>* (in category 'arithmetic') ----- + * aNumber + "Primitive. Answer the result of multiplying the receiver by aNumber. + Fail if the argument is not a Float. Essential. See Object documentation + whatIsAPrimitive." + + <primitive: 49> + ^ aNumber adaptToFloat: self andSend: #*! Item was added: + ----- Method: BoxedFloat64>>+ (in category 'arithmetic') ----- + + aNumber + "Primitive. Answer the sum of the receiver and aNumber. Essential. + Fail if the argument is not a Float. See Object documentation + whatIsAPrimitive." + + <primitive: 41> + ^ aNumber adaptToFloat: self andSend: #+! Item was added: + ----- Method: BoxedFloat64>>- (in category 'arithmetic') ----- + - aNumber + "Primitive. Answer the difference between the receiver and aNumber. + Fail if the argument is not a Float. Essential. See Object documentation + whatIsAPrimitive." + + <primitive: 42> + ^ aNumber adaptToFloat: self andSend: #-! Item was added: + ----- Method: BoxedFloat64>>/ (in category 'arithmetic') ----- + / aNumber + "Primitive. Answer the result of dividing receiver by aNumber. + Fail if the argument is not a Float. Essential. See Object documentation + whatIsAPrimitive." + + <primitive: 50> + aNumber isZero ifTrue: [^(ZeroDivide dividend: self) signal]. + ^ aNumber adaptToFloat: self andSend: #/! Item was added: + ----- Method: BoxedFloat64>>< (in category 'comparing') ----- + < aNumber + "Primitive. Compare the receiver with the argument and return true + if the receiver is less than the argument. Otherwise return false. + Fail if the argument is not a Float. Essential. See Object documentation + whatIsAPrimitive." + + <primitive: 43> + ^ aNumber adaptToFloat: self andCompare: #<! Item was added: + ----- Method: BoxedFloat64>><= (in category 'comparing') ----- + <= aNumber + "Primitive. Compare the receiver with the argument and return true + if the receiver is less than or equal to the argument. Otherwise return + false. Fail if the argument is not a Float. Optional. See Object + documentation whatIsAPrimitive." + + <primitive: 45> + ^ aNumber adaptToFloat: self andCompare: #<=! Item was added: + ----- Method: BoxedFloat64>>= (in category 'comparing') ----- + = aNumber + "Primitive. Compare the receiver with the argument and return true + if the receiver is equal to the argument. Otherwise return false. + Fail if the argument is not a Float. Essential. See Object documentation + whatIsAPrimitive." + + <primitive: 47> + aNumber isNumber ifFalse: [^ false]. + ^ aNumber adaptToFloat: self andCompare: #=! Item was added: + ----- Method: BoxedFloat64>>> (in category 'comparing') ----- + > aNumber + "Primitive. Compare the receiver with the argument and return true + if the receiver is greater than the argument. Otherwise return false. + Fail if the argument is not a Float. Essential. See Object documentation + whatIsAPrimitive." + + <primitive: 44> + ^ aNumber adaptToFloat: self andCompare: #>! Item was added: + ----- Method: BoxedFloat64>>>= (in category 'comparing') ----- + >= aNumber + "Primitive. Compare the receiver with the argument and return true + if the receiver is greater than or equal to the argument. Otherwise return + false. Fail if the argument is not a Float. Optional. See Object documentation + whatIsAPrimitive. " + + <primitive: 46> + ^ aNumber adaptToFloat: self andCompare: #>=! Item was added: + ----- Method: BoxedFloat64>>arcTan (in category 'mathematical functions') ----- + arcTan + "Answer the angle in radians. + Optional. See Object documentation whatIsAPrimitive." + + | theta eps step sinTheta cosTheta | + <primitive: 57> + + "Newton-Raphson" + self < 0.0 ifTrue: [ ^ 0.0 - (0.0 - self) arcTan ]. + + "first guess" + theta := (self * Halfpi) / (self + 1.0). + + "iterate" + eps := Halfpi * Epsilon. + step := theta. + [(step * step) > eps] whileTrue: [ + sinTheta := theta sin. + cosTheta := theta cos. + step := (sinTheta * cosTheta) - (self * cosTheta * cosTheta). + theta := theta - step]. + ^ theta! Item was added: + ----- Method: BoxedFloat64>>exp (in category 'mathematical functions') ----- + exp + "Answer E raised to the receiver power. + Optional. See Object documentation whatIsAPrimitive." + + | base fract correction delta div | + <primitive: 59> + + "Taylor series" + "check the special cases" + self < 0.0 ifTrue: [^ (self negated exp) reciprocal]. + self = 0.0 ifTrue: [^ 1]. + self abs > MaxValLn ifTrue: [self error: 'exp overflow']. + + "get first approximation by raising e to integer power" + base := E raisedToInteger: (self truncated). + + "now compute the correction with a short Taylor series" + "fract will be 0..1, so correction will be 1..E" + "in the worst case, convergance time is logarithmic with 1/Epsilon" + fract := self fractionPart. + fract = 0.0 ifTrue: [ ^ base ]. "no correction required" + + correction := 1.0 + fract. + delta := fract * fract / 2.0. + div := 2.0. + [delta > Epsilon] whileTrue: [ + correction := correction + delta. + div := div + 1.0. + delta := delta * fract / div]. + correction := correction + delta. + ^ base * correction! Item was added: + ----- Method: BoxedFloat64>>exponent (in category 'truncation and round off') ----- + exponent + "Primitive. Consider the receiver to be represented as a power of two + multiplied by a mantissa (between one and two). Answer with the + SmallInteger to whose power two is raised. Optional. See Object + documentation whatIsAPrimitive." + + <primitive: 53> + ^self exponentFromBitPattern! Item was added: + ----- Method: BoxedFloat64>>fractionPart (in category 'truncation and round off') ----- + fractionPart + "Primitive. Answer a Float whose value is the difference between the + receiver and the receiver's asInteger value. Optional. See Object + documentation whatIsAPrimitive." + + <primitive: 52> + ^self - self truncated asFloat! Item was added: + ----- Method: BoxedFloat64>>ln (in category 'mathematical functions') ----- + ln + "Answer the natural logarithm of the receiver. + Optional. See Object documentation whatIsAPrimitive." + + | expt n mant x div pow delta sum eps | + <primitive: 58> + + "Taylor series" + self <= 0.0 ifTrue: [DomainError signal: 'ln is only defined for x > 0.0']. + + "get a rough estimate from binary exponent" + expt := self exponent. + n := Ln2 * expt. + mant := self timesTwoPower: 0 - expt. + + "compute fine correction from mantinssa in Taylor series" + "mant is in the range [0..2]" + "we unroll the loop to avoid use of abs" + x := mant - 1.0. + div := 1.0. + pow := delta := sum := x. + x := x negated. "x <= 0" + eps := Epsilon * (n abs + 1.0). + [delta > eps] whileTrue: [ + "pass one: delta is positive" + div := div + 1.0. + pow := pow * x. + delta := pow / div. + sum := sum + delta. + "pass two: delta is negative" + div := div + 1.0. + pow := pow * x. + delta := pow / div. + sum := sum + delta]. + + ^ n + sum + + "2.718284 ln 1.0"! Item was added: + ----- Method: BoxedFloat64>>sin (in category 'mathematical functions') ----- + sin + "Answer the sine of the receiver taken as an angle in radians. + Optional. See Object documentation whatIsAPrimitive." + + | sum delta self2 i | + <primitive: 56> + + "Taylor series" + "normalize to the range [0..Pi/2]" + self < 0.0 ifTrue: [^ (0.0 - ((0.0 - self) sin))]. + self > Twopi ifTrue: [^ (self \\ Twopi) sin]. + self > Pi ifTrue: [^ (0.0 - (self - Pi) sin)]. + self > Halfpi ifTrue: [^ (Pi - self) sin]. + + "unroll loop to avoid use of abs" + sum := delta := self. + self2 := 0.0 - (self * self). + i := 2.0. + [delta > Epsilon] whileTrue: [ + "once" + delta := (delta * self2) / (i * (i + 1.0)). + i := i + 2.0. + sum := sum + delta. + "twice" + delta := (delta * self2) / (i * (i + 1.0)). + i := i + 2.0. + sum := sum + delta]. + ^ sum! Item was added: + ----- Method: BoxedFloat64>>sqrt (in category 'mathematical functions') ----- + sqrt + "Answer the square root of the receiver. + Optional. See Object documentation whatIsAPrimitive." + | exp guess eps delta | + <primitive: 55> + #Numeric. + "Changed 200/01/19 For ANSI <number> support." + "Newton-Raphson" + self <= 0.0 + ifTrue: [self = 0.0 + ifTrue: [^ 0.0] + ifFalse: ["v Chg" + ^ DomainError signal: 'sqrt undefined for number less than zero.']]. + "first guess is half the exponent" + exp := self exponent // 2. + guess := self timesTwoPower: 0 - exp. + "get eps value" + eps := guess * Epsilon. + eps := eps * eps. + delta := self - (guess * guess) / (guess * 2.0). + [delta * delta > eps] + whileTrue: + [guess := guess + delta. + delta := self - (guess * guess) / (guess * 2.0)]. + ^ guess! Item was added: + ----- Method: BoxedFloat64>>timesTwoPower: (in category 'mathematical functions') ----- + timesTwoPower: anInteger + "Primitive. Answer with the receiver multiplied by 2.0 raised + to the power of the argument. + Optional. See Object documentation whatIsAPrimitive." + + <primitive: 54> + + anInteger < -29 ifTrue: [^ self * (2.0 raisedToInteger: anInteger)]. + anInteger < 0 ifTrue: [^ self / (1 bitShift: (0 - anInteger)) asFloat]. + anInteger < 30 ifTrue: [^ self * (1 bitShift: anInteger) asFloat]. + ^ self * (2.0 raisedToInteger: anInteger)! Item was added: + ----- Method: BoxedFloat64>>truncated (in category 'truncation and round off') ----- + truncated + "Answer with a SmallInteger equal to the value of the receiver without + its fractional part. The primitive fails if the truncated value cannot be + represented as a SmallInteger. In that case, the code below will compute + a LargeInteger truncated value. + Essential. See Object documentation whatIsAPrimitive. " + + <primitive: 51> + self isFinite ifFalse: [self error: 'Cannot truncate this number']. + + self abs < 2.0e16 + ifTrue: ["Fastest way when it may not be an integer" + | di df q r | + di := 1 + (SmallInteger maxVal bitShift: -1). + df := di asFloat. + q := self quo: df. + r := self - (q asFloat * df). + ^q * di + r truncated] + ifFalse: [^ self asTrueFraction. "Extract all bits of the mantissa and shift if necess"] + + + + ! Item was added: + ----- Method: BoxedFloat64>>~= (in category 'comparing') ----- + ~= aNumber + "Primitive. Compare the receiver with the argument and return true + if the receiver is not equal to the argument. Otherwise return false. + Fail if the argument is not a Float. Optional. See Object documentation + whatIsAPrimitive." + + <primitive: 48> + ^super ~= aNumber! Item was added: + ----- Method: Class>>immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') ----- + immediateSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat + "This is the standard initialization message for creating a new + immediate class as a subclass of an existing class (the receiver)." + ^ClassBuilder new + superclass: self + immediateSubclass: t + instanceVariableNames: f + classVariableNames: d + poolDictionaries: s + category: cat! Item was changed: ----- Method: ClassBuilder>>computeFormat:instSize:forSuper:ccIndex: (in category 'class format') ----- computeFormat: type instSize: newInstSize forSuper: newSuper ccIndex: ccIndex "Compute the new format for making oldClass a subclass of newSuper. + Answer the format or nil if there is any problem." - Return the format or nil if there is any problem." | instSize isVar isWords isPointers isWeak | type == #compiledMethod ifTrue: + [newInstSize > 0 ifTrue: + [self error: 'A compiled method class cannot have named instance variables'. + ^nil]. + ^CompiledMethod format]. - [^(CompiledMethod format - bitClear: (16r1F bitShift: 11)) - bitOr: (ccIndex bitShift: 11)]. instSize := newInstSize + (newSuper ifNil:[0] ifNotNil:[newSuper instSize]). + instSize > 65535 ifTrue: - instSize > 254 ifTrue: [self error: 'Class has too many instance variables (', instSize printString,')'. ^nil]. type == #normal ifTrue:[isVar := isWeak := false. isWords := isPointers := true]. type == #bytes ifTrue:[isVar := true. isWords := isPointers := isWeak := false]. type == #words ifTrue:[isVar := isWords := true. isPointers := isWeak := false]. type == #variable ifTrue:[isVar := isPointers := isWords := true. isWeak := false]. type == #weak ifTrue:[isVar := isWeak := isWords := isPointers := true]. + type == #ephemeron ifTrue:[isVar := false. isWeak := isWords := isPointers := true]. + type == #immediate ifTrue:[isVar := isWeak := isPointers := false. isWords := true]. + (isPointers not and: [instSize > 0]) ifTrue: + [self error: 'A non-pointer class cannot have named instance variables'. - (isPointers not and:[instSize > 0]) ifTrue: - [self error:'A non-pointer class cannot have instance variables'. ^nil]. + ^self format: instSize variable: isVar words: isWords pointers: isPointers weak: isWeak! - ^(self format: instSize - variable: isVar - words: isWords - pointers: isPointers - weak: isWeak) + (ccIndex bitShift: 11).! Item was changed: ----- Method: ClassBuilder>>format:variable:words:pointers:weak: (in category 'class format') ----- + format: nInstVars variable: isVar words: is32BitWords pointers: isPointers weak: isWeak + "Compute the format for the given instance specfication. + Above Cog Spur the class format is + <5 bits inst spec><16 bits inst size> + where the 5-bit inst spec is + 0 = 0 sized objects (UndefinedObject True False et al) + 1 = non-indexable objects with inst vars (Point et al) + 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) + 4 = weak indexable objects with inst vars (WeakArray et al) + 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) + 6 = unused + 7 = immediates (SmallInteger, Character) + 8 = unused + 9 = reserved for 64-bit indexable + 10-11 = 32-bit indexable (Bitmap) + 12-15 = 16-bit indexable + 16-23 = 8-bit indexable + 24-31 = compiled methods (CompiledMethod)" + | instSpec | - format: nInstVars variable: isVar words: isWords pointers: isPointers weak: isWeak - "Compute the format for the given instance specfication." - | cClass instSpec sizeHiBits fmt | - self flag: #instSizeChange. - " - Smalltalk browseAllCallsOn: #instSizeChange. - Smalltalk browseAllImplementorsOf: #fixedFieldsOf:. - Smalltalk browseAllImplementorsOf: #instantiateClass:indexableSize:. - " - " - NOTE: This code supports the backward-compatible extension to 8 bits of instSize. - For now the format word is... - <2 bits=instSize//64><5 bits=cClass><4 bits=instSpec><6 bits=instSize\\64><1 bit=0> - But when we revise the image format, it should become... - <5 bits=cClass><4 bits=instSpec><8 bits=instSize><1 bit=0> - " - sizeHiBits := (nInstVars+1) // 64. - cClass := 0. "for now" instSpec := isWeak + ifTrue: + [isVar + ifTrue: [4] + ifFalse: [5]] + ifFalse: + [isPointers + ifTrue: + [isVar + ifTrue: [nInstVars > 0 ifTrue: [3] ifFalse: [2]] + ifFalse: [nInstVars > 0 ifTrue: [1] ifFalse: [0]]] + ifFalse: + [isVar + ifTrue: [is32BitWords ifTrue: [10] ifFalse: [16]] + ifFalse: [7]]]. + ^(instSpec bitShift: 16) + nInstVars! - ifTrue:[4] - ifFalse:[isPointers - ifTrue: [isVar - ifTrue: [nInstVars>0 ifTrue: [3] ifFalse: [2]] - ifFalse: [nInstVars>0 ifTrue: [1] ifFalse: [0]]] - ifFalse: [isWords ifTrue: [6] ifFalse: [8]]]. - fmt := sizeHiBits. - fmt := (fmt bitShift: 5) + cClass. - fmt := (fmt bitShift: 4) + instSpec. - fmt := (fmt bitShift: 6) + ((nInstVars+1)\\64). "+1 since prim size field includes header" - fmt := (fmt bitShift: 1). "This shift plus integer bit lets wordSize work like byteSize" - ^fmt! Item was added: + ----- Method: ClassBuilder>>superclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') ----- + superclass: aClass + immediateSubclass: t instanceVariableNames: f + classVariableNames: d poolDictionaries: s category: cat + "This is the standard initialization message for creating a + new immediate class as a subclass of an existing class." + | env | + aClass instSize > 0 + ifTrue: [^self error: 'cannot make an immediate subclass of a class with named fields']. + aClass isVariable + ifTrue: [^self error: 'cannot make an immediate subclass of a class with indexed instance variables']. + aClass isPointers + ifFalse: [^self error: 'cannot make an immediate subclass of a class without pointer fields']. + "Cope with pre-environment and environment versions. Simplify asap." + env := (Smalltalk classNamed: #EnvironmentRequest) + ifNil: [aClass environment] + ifNotNil: [:erc| erc signal ifNil: [aClass environment]]. + ^self + name: t + inEnvironment: env + subclassOf: aClass + type: #immediate + instanceVariableNames: f + classVariableNames: d + poolDictionaries: s + category: cat! Item was changed: ----- Method: ClassBuilder>>update:to: (in category 'class mutation') ----- update: oldClass to: newClass + "Convert oldClass, all its instances and possibly its meta class into newClass, + instances of newClass and possibly its meta class. The process is surprisingly + simple in its implementation and surprisingly complex in its nuances and potentially + bad side effects. + We can rely on two assumptions (which are critical): + #1: The method #updateInstancesFrom: will not create any lasting pointers to + 'old' instances ('old' is quote on quote since #updateInstancesFrom: will do + a become of the old vs. the new instances and therefore it will not create + pointers to *new* instances before the #become: which are *old* afterwards) + #2: The non-preemptive execution of the critical piece of code guarantees that + nobody can get a hold by 'other means' (such as process interruption and + reflection) on the old instances. + Given the above two, we know that after #updateInstancesFrom: there are no pointers + to any old instances. After the forwarding become there will be no pointers to the old + class or meta class either. + Andreas Raab, 2/27/2003 23:42" - "Convert oldClass, all its instances and possibly its meta class into newClass, instances of newClass and possibly its meta class. The process is surprisingly simple in its implementation and surprisingly complex in its nuances and potentially bad side effects. - We can rely on two assumptions (which are critical): - #1: The method #updateInstancesFrom: will not create any lasting pointers to 'old' instances ('old' is quote on quote since #updateInstancesFrom: will do a become of the old vs. the new instances and therefore it will not create pointers to *new* instances before the #become: which are *old* afterwards) - #2: The non-preemptive execution of the critical piece of code guarantees that nobody can get a hold by 'other means' (such as process interruption and reflection) on the old instances. - Given the above two, we know that after #updateInstancesFrom: there are no pointer to any old instances. After the forwarding become there will be no pointers to the old class or meta class either. Meaning that if we throw in a nice fat GC at the end of the critical block, everything will be gone (but see the comment right there). There's no need to worry. - " | meta | meta := oldClass isMeta. "Note: Everything from here on will run without the ability to get interrupted to prevent any other process to create new instances of the old class." + ["Note: The following removal may look somewhat obscure and needs an explanation. + When we mutate the class hierarchy we create new classes for any existing subclass. + So it may look as if we don't have to remove the old class from its superclass. However, + at the top of the hierarchy (the first class we reshape) that superclass itself is not newly + created so therefore it will hold both the oldClass and newClass in its (obsolete or not) + subclasses. Since the #become: below will transparently replace the pointers to oldClass + with newClass the superclass would have newClass in its subclasses TWICE. With rather + unclear effects if we consider that we may convert the meta-class hierarchy itself (which + is derived from the non-meta class hierarchy). + Due to this problem ALL classes are removed from their superclass just prior to converting + them. Here, breaking the superclass/subclass invariant really doesn't matter since we will + effectively remove the oldClass (becomeForward:) just a few lines below." - [ - "Note: The following removal may look somewhat obscure and needs an explanation. When we mutate the class hierarchy we create new classes for any existing subclass. So it may look as if we don't have to remove the old class from its superclass. However, at the top of the hierarchy (the first class we reshape) that superclass itself is not newly created so therefore it will hold both the oldClass and newClass in its (obsolete or not) subclasses. Since the #become: below will transparently replace the pointers to oldClass with newClass the superclass would have newClass in its subclasses TWICE. With rather unclear effects if we consider that we may convert the meta-class hierarchy itself (which is derived from the non-meta class hierarchy). - Due to this problem ALL classes are removed from their superclass just prior to converting them. Here, breaking the superclass/subclass invariant really doesn't matter since we will effectively remove the oldClass (become+GC) just a few lines below." oldClass superclass removeSubclass: oldClass. oldClass superclass removeObsoleteSubclass: oldClass. "make sure that the VM cache is clean" oldClass methodDict do: [:cm | cm flushCache]. "Convert the instances of oldClass into instances of newClass" newClass updateInstancesFrom: oldClass. meta ifTrue: [oldClass becomeForward: newClass. oldClass updateMethodBindingsTo: oldClass binding] ifFalse: [{oldClass. oldClass class} elementsForwardIdentityTo: {newClass. newClass class}. oldClass updateMethodBindingsTo: oldClass binding. oldClass class updateMethodBindingsTo: oldClass class binding]. + "eem 5/31/2014 07:22 At this point there used to be a garbage collect whose purpose was + to ensure no old instances existed after the becomeForward:. Without the GC it was possible + to resurrect old instances using e.g. allInstancesDo:. This was because the becomeForward: + updated references from the old objects to new objects but didn't destroy the old objects. + But as of late 2013/early 2014 becomeForward: has been modified to free all the old objects."] + valueUnpreemptively! - Smalltalk garbageCollect. - - "Warning: Read this before you even think about removing the GC. Yes, it slows us down. Quite heavily if you have a large image. However, there's no good and simple alternative here, since unfortunately, #become: does change class pointers. What happens is that after the above become all of the instances of the old class will have a class pointer identifying them as instances of newClass. If we get our hands on any of these instances we will break immediately since their expected instance layout (that of its class, e.g., newClass) will not match their actual instance layout (that of oldClass). And getting your hands on any of those instances is really simple - just reshaping one class two times in rapid succession will do it. Reflection techniques, interrupts, etc. will only add to this problem. In the case of Metaclass things get even worse since when we recompile the entire class hierarchy we will recompile both, Metaclass and its instances (and some of its instances will have the old and some the new layout). - - The only easy solution to this problem would be to 'fix up' the class pointers of the old instances to point to the old class (using primitiveChangeClassTo:). But this won't work either - as we do a one-way become we would have to search the entire object memory for the oldClass and couldn't even clearly identify it unless we give it some 'special token' which sounds quite error-prone. If you really need to get rid of the GC here are some alternatives: - - On the image level, one could create a copy of the oldClass before becoming it into the new class and, after becoming it, 'fix up' the old instances. That would certainly work but it sounds quite complex, as we need to make sure we're not breaking any of the superclass/subclass meta/non-meta class variants. - - Alternatively, fix up #becomeForward on the VM-level to 'dump the source objects' of #become. This would be quite doable (just 'convert' them into a well known special class such as bitmap) yet it has problems if (accidentally or not) one of the objects in #become: appears on 'both sides of the fence' (right now, this will work ... in a way ... even though the consequences are unclear). - - Another alternative is to provide a dedicated primitive for this (instead of using it implicitly in become) which would allow us to dump all the existing instances right here. This is equivalent to a more general primitiveChangeClassTo: and might be worthwhile but it would likely have to keep in mind the differences between bits and pointer thingies etc. - - Since all of the alternatives seem rather complex and magical compared to a straight-forward GC it seems best to stick with the GC solution for now. If someone has a real need to fix this problem, that person will likely be motivated enough to check out the alternatives. Personally I'd probably go for #1 (copy the old class and remap the instances to it) since it's a solution that could be easily reverted from within the image if there's any problem with it." - - ] valueUnpreemptively. - ! Item was changed: ByteArray variableByteSubclass: #CompiledMethod instanceVariableNames: '' classVariableNames: 'LargeFrame PrimaryBytecodeSetEncoderClass SecondaryBytecodeSetEncoderClass SmallFrame' poolDictionaries: '' category: 'Kernel-Methods'! + !CompiledMethod commentStamp: 'eem 8/12/2014 14:45' prior: 0! + CompiledMethod instances are methods suitable for interpretation by the virtual machine. Instances of CompiledMethod and its subclasses are the only objects in the system that have both indexable pointer fields and indexable 8-bit integer fields. The first part of a CompiledMethod is pointers, the second part is bytes. CompiledMethod inherits from ByteArray to avoid duplicating some of ByteArray's methods, not because a CompiledMethod is-a ByteArray. - !CompiledMethod commentStamp: 'eem 5/12/2014 18:02' prior: 0! - My instances are methods suitable for interpretation by the virtual machine. This is the only class in the system whose instances have both indexable pointer fields and indexable 8-bit integer fields. The first part of a CompiledMethod is pointers, the second part is bytes. I'm a subclass of ByteArray to avoid duplicating some of ByteArray's methods, not because a CompiledMethod is-a ByteArray. Class variables: SmallFrame - the number of stack slots in a small frame Context LargeFrame - the number of stack slots in a large frame Context PrimaryBytecodeSetEncoderClass - the encoder class that defines the primary instruction set SecondaryBytecodeSetEncoderClass - the encoder class that defines the secondary instruction set The current format of a CompiledMethod is as follows: header (4 or 8 bytes, SmallInteger) + literals (4 or 8 bytes each, Object, see "The last literal..." below) - literals (4 or 8 bytes each, Object) bytecodes (variable, bytes) trailer (variable, bytes) + The header is a 31-bit signed integer (a SmallInteger) in the following format: - The header is a 31-bit signed integer (a SmallInteger) with one of the two following formats, selected by the sign bit: - sign bit 0, header >= 0: - (index 0) 9 bits: main part of primitive number (#primitive) - (index 9) 8 bits: number of literals (#numLiterals) - (index 17) 1 bit: whether a large frame size is needed (#frameSize) - (index 18) 6 bits: number of temporary variables (#numTemps) - (index 24) 4 bits: number of arguments to the method (#numArgs) - (index 28) 1 bit: high-bit of primitive number (#primitive) - (index 29) 1 bit: flag bit, ignored by the VM (#flag) - (index 30/63) sign bit: 0 selects the Primary instruction set (#signFlag) - sign bit 1, header < 0: (index 0) 16 bits: number of literals (#numLiterals) (index 16) 1 bit: has primitive + (index 17) 1 bit: whether a large frame size is needed (#frameSize => either SmallFrame or LargeFrame) - (index 17) 1 bit: whether a large frame size is needed (#frameSize) (index 18) 6 bits: number of temporary variables (#numTemps) (index 24) 4 bits: number of arguments to the method (#numArgs) + (index 28) 2 bits: reserved for an access modifier (00-unused, 01-private, 10-protected, 11-public), although accessors for bit 29 exist (see #flag). + (index 30/63) sign bit: 1 selects the Secondary instruction set (e.g. NewsqueakV4, 0 selects the primary instruction set, e.g. SqueakV3PlusClosures) (#signFlag) - (index 28) 2 bits: reserved for an access modifier (00-unused, 01-private, 10-protected, 11-public) - (index 30/63) sign bit: 1 selects the Secondary instruction set (e.g. NewsqueakV4) (#signFlag) - i.e. the Secondary Bytecode Set expands the number of literals to 65535 by assuming a CallPrimitive bytecode. + If the method has a primitive then the first bytecode of the method must be a callPrimitive: bytecode that encodes the primitive index. + + The trailer is an encoding of an instance of CompiledMethodTrailer. It is typically used to encode the index into the source files array of the method's source, but may be used to encode other values, e.g. tempNames, source as a string, etc. See the class CompiledMethodTrailer. + + The last literal in a CompiledMethod must be its methodClassAssociation, a binding whose value is the class the method is installed in. The methodClassAssociation is used to implement super sends. If a method contains no super send then its methodClassAssociation may be left nil (as would be the case for example of methods providing a pool of inst var accessors). By convention the penultimate literal of a method is either its selector or an instance of AdditionalMethodState. AdditionalMethodState holds any pragmas and properties of a method, but may also be used to add instance variables to a method, albeit ones held in the method's AdditionalMethodState. Subclasses of CompiledMethod that want to add state should subclass AdditionalMethodState to add the state they want, and implement methodPropertiesClass on the class side of the CompiledMethod subclass to answer the specialized subclass of AdditionalMethodState.! - The trailer is an encoding of an instance of CompiledMethodTrailer. It is typically used to encode the index into the source files array of the method's source, but may be used to encode other values, e.g. tempNames, source as a string, etc. See the class CompiledMethodTrailer.! Item was added: + ----- Method: CompiledMethod class>>handleFailingFailingNewMethod:header: (in category 'private') ----- + handleFailingFailingNewMethod: numberOfBytes header: headerWord + "This newMethod:header: gets sent after handleFailingBasicNew: has done a full + garbage collection and possibly grown memory. If this basicNew: fails then the + system really is low on space, so raise the OutOfMemory signal. + + Primitive. Answer an instance of this class with the number of indexable variables + specified by the argument, headerWord, and the number of bytecodes specified + by numberOfBytes. Fail if this if the arguments are not Integers, or if numberOfBytes + is negative, or if the receiver is not a CompiledMethod class, or if there is not enough + memory available. Essential. See Object documentation whatIsAPrimitive." + + <primitive: 79> + "space must be low." + OutOfMemory signal. + "retry if user proceeds" + ^self newMethod: numberOfBytes header: headerWord! Item was added: + ----- Method: CompiledMethod class>>handleFailingNewMethod:header: (in category 'private') ----- + handleFailingNewMethod: numberOfBytes header: headerWord + "This newMethod:header: gets sent after newMethod:header: has failed + and allowed a scavenging garbage collection to occur. The scavenging + collection will have happened as the VM is activating the (failing) basicNew:. + If handleFailingBasicNew: fails then the scavenge failed to reclaim sufficient + space and a global garbage collection is required. Retry after garbage + collecting and growing memory if necessary. + + Primitive. Answer an instance of this class with the number of indexable variables + specified by the argument, headerWord, and the number of bytecodes specified + by numberOfBytes. Fail if this if the arguments are not Integers, or if numberOfBytes + is negative, or if the receiver is not a CompiledMethod class, or if there is not enough + memory available. Essential. See Object documentation whatIsAPrimitive." + + <primitive: 79> + | bytesRequested | + bytesRequested := (headerWord bitAnd: 16rFFFF) + 1 * Smalltalk wordSize + numberOfBytes + 16. + Smalltalk garbageCollect < bytesRequested ifTrue: + [Smalltalk growMemoryByAtLeast: bytesRequested]. + "retry after global garbage collect and possible grow" + ^self handleFailingFailingNewMethod: numberOfBytes header: headerWord! Item was added: + ----- Method: CompiledMethod class>>installPrimaryBytecodeSet: (in category 'class initialization') ----- + installPrimaryBytecodeSet: aBytecodeEncoderSubclass + PrimaryBytecodeSetEncoderClass == aBytecodeEncoderSubclass ifTrue: + [^self]. + (aBytecodeEncoderSubclass inheritsFrom: BytecodeEncoder) ifFalse: + [self error: 'A bytecode set encoder is expected to be a subclass of BytecodeEncoder']. + (self allSubInstances + detect: [:m| m header >= 0 and: [m encoderClass ~~ aBytecodeEncoderSubclass]] + ifNone: []) ifNotNil: + [Warning signal: 'There are existing CompiledMethods with a different encoderClass.']. + PrimaryBytecodeSetEncoderClass := aBytecodeEncoderSubclass! Item was added: + ----- Method: CompiledMethod class>>installSecondaryBytecodeSet: (in category 'class initialization') ----- + installSecondaryBytecodeSet: aBytecodeEncoderSubclass + PrimaryBytecodeSetEncoderClass == aBytecodeEncoderSubclass ifTrue: + [^self]. + (aBytecodeEncoderSubclass inheritsFrom: BytecodeEncoder) ifFalse: + [self error: 'A bytecode set encoder is expected to be a subclass of BytecodeEncoder']. + (self allSubInstances + detect: [:m| m header < 0 and: [m encoderClass ~~ aBytecodeEncoderSubclass]] + ifNone: []) ifNotNil: + [Warning signal: 'There are existing CompiledMethods with a different encoderClass.']. + SecondaryBytecodeSetEncoderClass := aBytecodeEncoderSubclass! Item was changed: ----- Method: CompiledMethod class>>newBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive: (in category 'instance creation') ----- newBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex "Answer an instance of me. The header is specified by the message arguments. The remaining parts are not as yet determined." + | method pc | + nArgs > 15 ifTrue: + [^self error: 'Cannot compile -- too many arguments']. - | largeBit primBits | nTemps > 63 ifTrue: + [^self error: 'Cannot compile -- too many temporary variables']. + nLits > 65535 ifTrue: + [^self error: 'Cannot compile -- too many literals']. - [^ self error: 'Cannot compile -- too many temporary variables']. - nLits > 255 ifTrue: - [^ self error: 'Cannot compile -- too many literals']. - largeBit := (nTemps + stackSize) > SmallFrame ifTrue: [1] ifFalse: [0]. - primBits := primitiveIndex <= 16r1FF - ifTrue: [primitiveIndex] - ifFalse: ["For now the high bit of primitive no. is in the 29th bit of header" - primitiveIndex > 16r3FF ifTrue: [self error: 'prim num too large']. - (primitiveIndex bitAnd: 16r1FF) + ((primitiveIndex bitAnd: 16r200) bitShift: 19)]. + method := trailer + createMethod: numberOfBytes + class: self + header: (nArgs bitShift: 24) + + (nTemps bitShift: 18) + + ((nTemps + stackSize) > SmallFrame ifTrue: [1 bitShift: 17] ifFalse: [0]) + + nLits + + (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0]). + primitiveIndex > 0 ifTrue: + [pc := method initialPC. + method + at: pc + 0 put: method encoderClass callPrimitiveCode; + at: pc + 1 put: (primitiveIndex bitAnd: 16rFF); + at: pc + 2 put: (primitiveIndex bitShift: -8)]. + ^method! - ^trailer - createMethod: numberOfBytes - class: self - header: (nArgs bitShift: 24) + - (nTemps bitShift: 18) + - (largeBit bitShift: 17) + - (nLits bitShift: 9) + - primBits! Item was changed: ----- Method: CompiledMethod class>>newBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive:flag: (in category 'instance creation') ----- newBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex flag: flag "Answer an instance of me. The header is specified by the message arguments. The remaining parts are not as yet determined." + | method pc | + nArgs > 15 ifTrue: + [^self error: 'Cannot compile -- too many arguments']. - | largeBit primBits flagBit | nTemps > 63 ifTrue: + [^self error: 'Cannot compile -- too many temporary variables']. + nLits > 65535 ifTrue: + [^self error: 'Cannot compile -- too many literals']. - [^ self error: 'Cannot compile -- too many temporary variables']. - nLits > 255 ifTrue: - [^ self error: 'Cannot compile -- too many literals']. - largeBit := (nTemps + stackSize) > SmallFrame ifTrue: [1] ifFalse: [0]. + method := trailer + createMethod: numberOfBytes + class: self + header: (nArgs bitShift: 24) + + (nTemps bitShift: 18) + + ((nTemps + stackSize) > SmallFrame ifTrue: [1 bitShift: 17] ifFalse: [0]) + + nLits + + (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0]) + + (flag ifTrue: [1 bitShift: 29] ifFalse: [0]). + primitiveIndex > 0 ifTrue: + [pc := method initialPC. + method + at: pc + 0 put: method encoderClass callPrimitiveCode; + at: pc + 1 put: (primitiveIndex bitAnd: 16rFF); + at: pc + 2 put: (primitiveIndex bitShift: -8)]. + ^method! - "For now the high bit of the primitive no. is in a high bit of the header" - primBits := (primitiveIndex bitAnd: 16r1FF) + ((primitiveIndex bitAnd: 16r200) bitShift: 19). - - flagBit := flag ifTrue: [ 1 ] ifFalse: [ 0 ]. - - ^trailer - createMethod: numberOfBytes - class: self - header: (nArgs bitShift: 24) + - (nTemps bitShift: 18) + - (largeBit bitShift: 17) + - (nLits bitShift: 9) + - primBits + - (flagBit bitShift: 29)! Item was changed: ----- Method: CompiledMethod class>>newMethod:header: (in category 'instance creation') ----- + newMethod: numberOfBytes header: headerWord - newMethod: numberOfBytes header: headerWord "Primitive. Answer an instance of me. The number of literals (and other + information) is specified by the headerWord (see my class comment). + The first argument specifies the number of fields for bytecodes in the + method. Fail if either argument is not a SmallInteger, or if numberOfBytes + is negative, or if memory is low. Once the header of a method is set by + this primitive, it cannot be changed to change the number of literals. + Essential. See Object documentation whatIsAPrimitive." - information) is specified the headerWord. The first argument specifies - the number of fields for bytecodes in the method. Fail if either - argument is not a SmallInteger, or if numberOfBytes is negative. Once - the header of a method is set by this primitive, it cannot be changed in - any way. Essential. See Object documentation whatIsAPrimitive." + <primitive: 79 error: ec> + ec == #'insufficient object memory' ifTrue: + [^self handleFailingNewMethod: numberOfBytes header: headerWord]. - <primitive: 79> - (numberOfBytes isInteger and: - [headerWord isInteger and: - [numberOfBytes >= 0]]) ifTrue: [ - "args okay; space must be low" - OutOfMemory signal. - "retry if user proceeds" - ^ self newMethod: numberOfBytes header: headerWord - ]. ^self primitiveFailed! Item was changed: ----- Method: CompiledMethod class>>toReturnConstant:trailerBytes: (in category 'instance creation') ----- toReturnConstant: index trailerBytes: trailer "Answer an instance of me that is a quick return of the constant indexed in (true false nil -1 0 1 2)." + ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256 + index! - ^ self newBytes: 0 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256 + index - ! Item was changed: ----- Method: CompiledMethod class>>toReturnField:trailerBytes: (in category 'instance creation') ----- toReturnField: field trailerBytes: trailer "Answer an instance of me that is a quick return of the instance variable indexed by the argument, field." + ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 264 + field! - ^ self newBytes: 0 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 264 + field - ! Item was changed: ----- Method: CompiledMethod class>>toReturnSelfTrailerBytes: (in category 'instance creation') ----- toReturnSelfTrailerBytes: trailer "Answer an instance of me that is a quick return of the instance (^self)." + ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256! - ^ self newBytes: 0 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256 - ! Item was added: + ----- Method: CompiledMethod>>bytecodeSetName (in category 'accessing') ----- + bytecodeSetName + ^self encoderClass name copyReplaceAll: 'EncoderFor' with: ''! Item was changed: ----- Method: CompiledMethod>>headerDescription (in category 'literals') ----- headerDescription + "Answer a description containing the information about the form of the + receiver and the form of the context needed to run the receiver." - "Answer a description containing the information about the form of the - receiver and the form of the context needed to run the receiver." + ^(ByteString new: 128) writeStream + print: self header; cr; + nextPutAll: '"primitive: '; print: self primitive; cr; + nextPutAll: ' numArgs: '; print: self numArgs; cr; + nextPutAll: ' numTemps: '; print: self numTemps; cr; + nextPutAll: ' numLiterals: '; print: self numLiterals; cr; + nextPutAll: ' frameSize: '; print: self frameSize; cr; + nextPutAll: ' bytecodeSet: '; nextPutAll: self bytecodeSetName; + nextPut: $"; cr; + contents! - | s | - s := '' writeStream. - self header printOn: s. - s cr; nextPutAll: '"primitive: '. - self primitive printOn: s. - s cr; nextPutAll: ' numArgs: '. - self numArgs printOn: s. - s cr; nextPutAll: ' numTemps: '. - self numTemps printOn: s. - s cr; nextPutAll: ' numLiterals: '. - self numLiterals printOn: s. - s cr; nextPutAll: ' frameSize: '. - self frameSize printOn: s. - s cr; nextPutAll: ' isClosureCompiled: '. - self isBlueBookCompiled not printOn: s. - s nextPut: $"; cr. - ^ s contents! Item was changed: ----- Method: CompiledMethod>>numLiterals (in category 'accessing') ----- numLiterals "Answer the number of literals used by the receiver." + ^self header bitAnd: 65535! - | header | - ^(header := self header) < 0 - ifTrue: [header bitAnd: 65535] - ifFalse: [(header bitShift: -9) bitAnd: 16rFF]! Item was changed: ----- Method: CompiledMethod>>primitive (in category 'accessing') ----- primitive "Answer the primitive index associated with the receiver. + Zero indicates that this is not a primitive method." + | initialPC | + ^(self header anyMask: 65536) "Is the hasPrimitive? flag set?" + ifTrue: [(self at: (initialPC := self initialPC) + 1) + ((self at: initialPC + 2) bitShift: 8)] + ifFalse: [0]! - Zero indicates that this is not a primitive method. - In the original header format we currently allow 10 bits of primitive index, but they are - in two places for backward compatibility. In the new format the primitive index is in the - last two bytes of a three byte callPrimitive: bytecode. The time to unpack is negligible, - since the derived primitive function pointer full index is stored in the method cache." - | header initialPC | - ^(header := self header) < 0 - ifTrue: - [(header anyMask: 65536) "Is the hasPrimitive? flag set?" - ifTrue: [(self at: (initialPC := self initialPC) + 1) + ((self at: initialPC + 2) bitShift: 8)] - ifFalse: [0]] - ifFalse: - [(header bitAnd: 16r1FF) + ((header bitShift: -19) bitAnd: 16r200)]! Item was changed: ----- Method: ContextPart>>activateReturn:value: (in category 'private') ----- activateReturn: aContext value: value "Activate 'aContext return: value' in place of self, so execution will return to aContext's sender" + ^MethodContext + sender: self - ^ self - activateMethod: ContextPart theReturnMethod - withArgs: {value} receiver: aContext + method: MethodContext theReturnMethod + arguments: {value}! - class: aContext class! Item was changed: ----- Method: ContextPart>>doPrimitive:method:receiver:args: (in category 'private') ----- doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments + "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and + arguments are given as arguments to this message. If successful, push result and return + resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes + execution needs to be intercepted and simulated to avoid execution running away." - "Simulate a primitive method whose index is primitiveIndex. The - simulated receiver and arguments are given as arguments to this message. - If successful, push result and return resuming context, else ^ PrimitiveFailToken. - Any primitive which provokes execution needs to be intercepted and simulated - to avoid execution running away." | value | "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents the debugger from entering various run-away activities such as spawning a new process, etc. Injudicious use results in the debugger not being able to debug + interesting code, such as the debugger itself. hence use primitive 19 with care :-)" - interesting code, such as the debugger itself. hence use primtiive 19 with care :-)" "SystemNavigation new browseAllSelect: [:m| m primitive = 19]" primitiveIndex = 19 ifTrue: [ToolSet debugContext: self label:'Code simulation error' contents: nil]. + ((primitiveIndex between: 201 and: 222) + and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue: + [((primitiveIndex between: 201 and: 205) "BlockClosure>>value[:value:...]" + or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]" + [^receiver simulateValueWithArguments: arguments caller: self]. + primitiveIndex = 206 ifTrue: "BlockClosure>>valueWithArguments:" + [^receiver simulateValueWithArguments: arguments first caller: self]]. - "ContextPart>>blockCopy:; simulated to get startpc right" - (primitiveIndex = 80 and: [(self objectClass: receiver) includesBehavior: ContextPart]) - ifTrue: [^self push: ((BlockContext newForMethod: receiver method) - home: receiver home - startpc: pc + 2 - nargs: (arguments at: 1))]. - (primitiveIndex = 81 and: [(self objectClass: receiver) == BlockContext]) "BlockContext>>value[:value:...]" - ifTrue: [^receiver pushArgs: arguments from: self]. - (primitiveIndex = 82 and: [(self objectClass: receiver) == BlockContext]) "BlockContext>>valueWithArguments:" - ifTrue: [^receiver pushArgs: arguments first from: self]. - primitiveIndex = 83 "afr 9/11/1998 19:50" "Object>>perform:[with:...]" - ifTrue: [^self send: arguments first - to: receiver - with: arguments allButFirst - super: false]. - primitiveIndex = 84 "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" - ifTrue: [^self send: arguments first - to: receiver - with: (arguments at: 2) - startClass: nil]. - primitiveIndex = 100 "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" - ifTrue: [^self send: arguments first - to: receiver - with: (arguments at: 2) - startClass: (arguments at: 3)]. + primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]" + [^self send: arguments first to: receiver with: arguments allButFirst super: false]. + primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" + [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (self objectClass: receiver)]. + primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" + [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (arguments at: 3)]. + "Mutex>>primitiveEnterCriticalSection Mutex>>primitiveTestAndSetOwnershipOfCriticalSection" (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue: [| active effective | active := Processor activeProcess. effective := active effectiveProcess. "active == effective" value := primitiveIndex = 186 ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective] ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective]. + ^(self isPrimFailToken: value) - ^((self objectClass: value) == Array - and: [value size = 2 - and: [value first == PrimitiveFailToken]]) ifTrue: [value] ifFalse: [self push: value]]. + primitiveIndex = 188 ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:" - ((primitiveIndex = 188 or: [primitiveIndex = 189]) "eem 10/6/2014 16:14 Object>>with:*executeMethod:" - and: [arguments last isQuick not]) ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:" [^MethodContext sender: self receiver: receiver + method: (arguments at: 2) + arguments: (arguments at: 1)]. - method: arguments last - arguments: (primitiveIndex = 188 - ifTrue: [arguments at: 1] - ifFalse: [arguments allButLast])]. "Closure primitives" (primitiveIndex = 200 and: [self == receiver]) ifTrue: "ContextPart>>closureCopy:copiedValues:; simulated to get startpc right" [^self push: (BlockClosure outerContext: receiver startpc: pc + 2 numArgs: arguments first copiedValues: arguments last)]. - ((primitiveIndex between: 201 and: 205) "BlockClosure>>value[:value:...]" - or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]" - [^receiver simulateValueWithArguments: arguments caller: self]. - primitiveIndex = 206 ifTrue: "BlockClosure>>valueWithArguments:" - [^receiver simulateValueWithArguments: arguments first caller: self]. primitiveIndex = 118 ifTrue: "tryPrimitive:withArgs:; avoid recursing in the VM" [(arguments size = 2 and: [arguments first isInteger and: [(self objectClass: arguments last) == Array]]) ifFalse: [^ContextPart primitiveFailTokenFor: nil]. ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last]. value := primitiveIndex = 120 "FFI method" ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments] ifFalse: [primitiveIndex = 117 "named primitives" ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] + ifFalse: [receiver tryPrimitive: primitiveIndex withArgs: arguments]]. + + ^(self isPrimFailToken: value) - ifFalse: - [receiver tryPrimitive: primitiveIndex withArgs: arguments]]. - ^((self objectClass: value) == Array - and: [value size = 2 - and: [value first == PrimitiveFailToken]]) ifTrue: [value] ifFalse: [self push: value]! Item was added: + ----- Method: ContextPart>>isPrimFailToken: (in category 'private') ----- + isPrimFailToken: anObject + ^(self objectClass: anObject) == Array + and: [anObject size = 2 + and: [anObject first == PrimitiveFailToken]]! Item was added: + ----- Method: ContextPart>>send:to:with:lookupIn: (in category 'controlling') ----- + send: selector to: rcvr with: arguments lookupIn: lookupClass + "Simulate the action of sending a message with selector and arguments + to rcvr. The argument, lookupClass, is the class in which to lookup the + message. This is the receiver's class for normal messages, but for super + messages it will be some specific class related to the source method." + + | meth primIndex val ctxt | + (meth := lookupClass lookupSelector: selector) ifNil: + [^self send: #doesNotUnderstand: + to: rcvr + with: {Message selector: selector arguments: arguments} + lookupIn: lookupClass]. + (primIndex := meth primitive) > 0 ifTrue: + [val := self doPrimitive: primIndex method: meth receiver: rcvr args: arguments. + (self isPrimFailToken: val) ifFalse: + [^val]]. + (selector == #doesNotUnderstand: and: [lookupClass == ProtoObject]) ifTrue: + [^self error: 'Simulated message ', arguments first selector, ' not understood']. + ctxt := MethodContext sender: self receiver: rcvr method: meth arguments: arguments. + primIndex > 0 ifTrue: + [ctxt failPrimitiveWith: val]. + ^ctxt! Item was changed: ----- Method: ContextPart>>send:to:with:super: (in category 'controlling') ----- + send: selector to: rcvr with: arguments super: superFlag + "Simulate the action of sending a message with selector arguments + to rcvr. The argument, superFlag, tells whether the receiver of the + message was specified with 'super' in the source method." - send: selector to: rcvr with: args super: superFlag - "Simulate the action of sending a message with selector, selector, and - arguments, args, to receiver. The argument, superFlag, tells whether the - receiver of the message was specified with 'super' in the source method." + ^self send: selector + to: rcvr + with: arguments + lookupIn: (superFlag + ifTrue: [self method methodClassAssociation value superclass] + ifFalse: [self objectClass: rcvr])! - | class meth val ctxt | - class := superFlag - ifTrue: [self method methodClassAssociation value superclass] - ifFalse: [self objectClass: rcvr]. - meth := class lookupSelector: selector. - meth == nil ifTrue: - [^self - send: #doesNotUnderstand: - to: rcvr - with: (Array with: (Message selector: selector arguments: args)) - super: superFlag]. - val := self tryPrimitiveFor: meth receiver: rcvr args: args. - ((self objectClass: val) == Array - and: [val size = 2 - and: [val first == PrimitiveFailToken]]) ifFalse: - [^val]. - (selector == #doesNotUnderstand: - and: [class == ProtoObject]) ifTrue: - [^self error: 'Simulated message ' , (args at: 1) selector, ' not understood']. - ctxt := self activateMethod: meth withArgs: args receiver: rcvr class: class. - ((self objectClass: val) == Array - and: [val size = 2 - and: [val first == PrimitiveFailToken - and: [val last notNil - and: [(ctxt method at: ctxt pc) = 129 "long store temp"]]]]) ifTrue: - [ctxt at: ctxt stackPtr put: val last]. - ^ctxt! Item was changed: ----- Method: ContextPart>>tryNamedPrimitiveIn:for:withArgs: (in category 'private') ----- tryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments + "Invoke the named primitive for aCompiledMethod, answering its result, or, + if the primiitve fails, answering the error code." - | selector theMethod spec receiverClass | <primitive: 218 error: ec> ec ifNotNil: ["If ec is an integer other than -1 there was a problem with primitive 218, not with the external primitive itself. -1 indicates a generic failure (where ec should be nil) but ec = nil means primitive 218 is not implemented. So interpret -1 to mean the external primitive failed with a nil error code." ec isInteger ifTrue: [ec = -1 ifTrue: [ec := nil] + ifFalse: [self primitiveFailed]]]. + ^self class primitiveFailTokenFor: ec! - ifFalse: [self primitiveFailed]]. - ^{PrimitiveFailToken. ec}]. - "Assume a nil error code implies the primitive is not implemented and fall back on the old code." - "Hack. Attempt to execute the named primitive from the given compiled method" - arguments size > 8 ifTrue: - [^{PrimitiveFailToken. nil}]. - selector := #( - tryNamedPrimitive - tryNamedPrimitive: - tryNamedPrimitive:with: - tryNamedPrimitive:with:with: - tryNamedPrimitive:with:with:with: - tryNamedPrimitive:with:with:with:with: - tryNamedPrimitive:with:with:with:with:with: - tryNamedPrimitive:with:with:with:with:with:with: - tryNamedPrimitive:with:with:with:with:with:with:with:) at: arguments size+1. - receiverClass := self objectClass: aReceiver. - theMethod := receiverClass lookupSelector: selector. - theMethod == nil ifTrue: - [^{PrimitiveFailToken. nil}]. - spec := theMethod literalAt: 1. - spec replaceFrom: 1 to: spec size with: (aCompiledMethod literalAt: 1) startingAt: 1. - Smalltalk unbindExternalPrimitives. - ^self object: aReceiver perform: selector withArguments: arguments inClass: receiverClass! Item was changed: + Number subclass: #Float - Number variableWordSubclass: #Float instanceVariableNames: '' classVariableNames: 'E Epsilon Halfpi Infinity Ln10 Ln2 MaxVal MaxValLn MinValLogBase2 NaN NegativeInfinity NegativeZero Pi RadiansPerDegree Sqrt2 ThreePi Twopi' poolDictionaries: '' category: 'Kernel-Numbers'! !Float commentStamp: '<historical>' prior: 0! My instances represent IEEE-754 floating-point double-precision numbers. They have about 16 digits of accuracy and their range is between plus and minus 10^307. Some valid examples are: 8.0 13.3 0.3 2.5e6 1.27e-30 1.27e-31 -12.987654e12 Mainly: no embedded blanks, little e for tens power, and a digit on both sides of the decimal point. It is actually possible to specify a radix for Squeak Float constants. This is great for teaching about numbers, but may be confusing to the average reader: 3r20.2 --> 6.66666666666667 8r20.2 --> 16.25 If you don't have access to the definition of IEEE-754, you can figure out what is going on by printing various simple values in Float hex. It may help you to know that the basic format is... sign 1 bit exponent 11 bits with bias of 1023 (16r3FF) to produce an exponent in the range -1023 .. +1024 - 16r000: significand = 0: Float zero significand ~= 0: Denormalized number (exp = -1024, no hidden '1' bit) - 16r7FF: significand = 0: Infinity significand ~= 0: Not A Number (NaN) representation mantissa 53 bits, but only 52 are stored (20 in the first word, 32 in the second). This is because a normalized mantissa, by definition, has a 1 to the right of its floating point, and IEEE-754 omits this redundant bit to gain an extra bit of precision instead. People talk about the mantissa without its leading one as the FRACTION, and with its leading 1 as the SIGNFICAND. The single-precision format is... sign 1 bit exponent 8 bits, with bias of 127, to represent -126 to +127 - 0x0 and 0xFF reserved for Float zero (mantissa is ignored) - 16r7F reserved for Float underflow/overflow (mantissa is ignored) mantissa 24 bits, but only 23 are stored This format is used in FloatArray (qv), and much can be learned from the conversion routines, Float asIEEE32BitWord, and Float class fromIEEE32Bit:. Thanks to Rich Harmon for asking many questions and to Tim Olson, Bruce Cohen, Rick Zaccone and others for the answers that I have collected here.! Item was changed: ----- Method: Float class>>basicNew (in category 'instance creation') ----- basicNew + ^BoxedFloat64 basicNew: 2! - ^self basicNew: 2! Item was changed: ----- Method: Float class>>basicNew: (in category 'instance creation') ----- basicNew: anInteger + ^BoxedFloat64 basicNew: 2! - anInteger = 2 ifFalse: [^self error: 'a Float shall always have two slots']. - ^super basicNew: 2! Item was changed: ----- Method: Float class>>fromIEEE32Bit: (in category 'instance creation') ----- fromIEEE32Bit: word + "Convert the given 32 bit word (which is supposed to be a positive 32-bit value) from + a 32 bit IEEE floating point representation into an actual Squeak float object (being + 64 bits wide). Should only be used for conversion in FloatArrays or likewise objects." - "Convert the given 32 bit word (which is supposed to be a positive 32bit value) from a 32bit IEEE floating point representation into an actual Squeak float object (being 64bit wide). Should only be used for conversion in FloatArrays or likewise objects." + | sign mantissa exponent delta | + word <= 0 ifTrue: + [^word negative + ifTrue: [self error: 'Cannot deal with negative numbers'] + ifFalse: [self zero]]. - | sign mantissa exponent newFloat delta | - word negative ifTrue: [^ self error:'Cannot deal with negative numbers']. - word = 0 ifTrue: [^ Float zero]. sign := word bitAnd: 16r80000000. + word = sign ifTrue: + [^self negativeZero]. - word = sign ifTrue: [^self negativeZero]. exponent := ((word bitShift: -23) bitAnd: 16rFF) - 127. mantissa := word bitAnd: 16r7FFFFF. + exponent = 128 ifTrue: "Either NAN or INF" + [^mantissa = 0 + ifTrue: + [sign = 0 + ifTrue: [self infinity] + ifFalse: [self negativeInfinity]] + ifFalse: [self nan]]. - exponent = 128 ifTrue:["Either NAN or INF" - mantissa = 0 ifFalse:[^ Float nan]. - sign = 0 - ifTrue:[^ Float infinity] - ifFalse:[^ Float negativeInfinity]]. + exponent = -127 ifTrue: - exponent = -127 ifTrue: [ "gradual underflow (denormalized number) + Remove first bit of mantissa and adjust exponent" + [delta := mantissa highBit. + mantissa := (mantissa bitShift: 1) bitAnd: (1 bitShift: delta) - 1. + exponent := exponent + delta - 23]. - Remove first bit of mantissa and adjust exponent" - delta := mantissa highBit. - mantissa := (mantissa bitShift: 1) bitAnd: (1 bitShift: delta) - 1. - exponent := exponent + delta - 23]. "Create new float" + ^(self basicNew: 2) + basicAt: 1 put: ((sign bitOr: (1023 + exponent bitShift: 20)) bitOr: (mantissa bitShift: -3)); + basicAt: 2 put: ((mantissa bitAnd: 7) bitShift: 29); + * 1.0 "reduce to SmallFloat64 if possible"! - newFloat := self new: 2. - newFloat basicAt: 1 put: ((sign bitOr: (1023 + exponent bitShift: 20)) bitOr: (mantissa bitShift: -3)). - newFloat basicAt: 2 put: ((mantissa bitAnd: 7) bitShift: 29). - ^newFloat! Item was removed: - ----- Method: Float>>* (in category 'arithmetic') ----- - * aNumber - "Primitive. Answer the result of multiplying the receiver by aNumber. - Fail if the argument is not a Float. Essential. See Object documentation - whatIsAPrimitive." - - <primitive: 49> - ^ aNumber adaptToFloat: self andSend: #*! Item was removed: - ----- Method: Float>>+ (in category 'arithmetic') ----- - + aNumber - "Primitive. Answer the sum of the receiver and aNumber. Essential. - Fail if the argument is not a Float. See Object documentation - whatIsAPrimitive." - - <primitive: 41> - ^ aNumber adaptToFloat: self andSend: #+! Item was removed: - ----- Method: Float>>- (in category 'arithmetic') ----- - - aNumber - "Primitive. Answer the difference between the receiver and aNumber. - Fail if the argument is not a Float. Essential. See Object documentation - whatIsAPrimitive." - - <primitive: 42> - ^ aNumber adaptToFloat: self andSend: #-! Item was removed: - ----- Method: Float>>/ (in category 'arithmetic') ----- - / aNumber - "Primitive. Answer the result of dividing receiver by aNumber. - Fail if the argument is not a Float. Essential. See Object documentation - whatIsAPrimitive." - - <primitive: 50> - aNumber isZero ifTrue: [^(ZeroDivide dividend: self) signal]. - ^ aNumber adaptToFloat: self andSend: #/! Item was removed: - ----- Method: Float>>< (in category 'comparing') ----- - < aNumber - "Primitive. Compare the receiver with the argument and return true - if the receiver is less than the argument. Otherwise return false. - Fail if the argument is not a Float. Essential. See Object documentation - whatIsAPrimitive." - - <primitive: 43> - ^ aNumber adaptToFloat: self andCompare: #<! Item was removed: - ----- Method: Float>><= (in category 'comparing') ----- - <= aNumber - "Primitive. Compare the receiver with the argument and return true - if the receiver is less than or equal to the argument. Otherwise return - false. Fail if the argument is not a Float. Optional. See Object - documentation whatIsAPrimitive." - - <primitive: 45> - ^ aNumber adaptToFloat: self andCompare: #<=! Item was removed: - ----- Method: Float>>= (in category 'comparing') ----- - = aNumber - "Primitive. Compare the receiver with the argument and return true - if the receiver is equal to the argument. Otherwise return false. - Fail if the argument is not a Float. Essential. See Object documentation - whatIsAPrimitive." - - <primitive: 47> - aNumber isNumber ifFalse: [^ false]. - ^ aNumber adaptToFloat: self andCompare: #=! Item was removed: - ----- Method: Float>>> (in category 'comparing') ----- - > aNumber - "Primitive. Compare the receiver with the argument and return true - if the receiver is greater than the argument. Otherwise return false. - Fail if the argument is not a Float. Essential. See Object documentation - whatIsAPrimitive." - - <primitive: 44> - ^ aNumber adaptToFloat: self andCompare: #>! Item was removed: - ----- Method: Float>>>= (in category 'comparing') ----- - >= aNumber - "Primitive. Compare the receiver with the argument and return true - if the receiver is greater than or equal to the argument. Otherwise return - false. Fail if the argument is not a Float. Optional. See Object documentation - whatIsAPrimitive. " - - <primitive: 46> - ^ aNumber adaptToFloat: self andCompare: #>=! Item was removed: - ----- Method: Float>>arcTan (in category 'mathematical functions') ----- - arcTan - "Answer the angle in radians. - Optional. See Object documentation whatIsAPrimitive." - - | theta eps step sinTheta cosTheta | - <primitive: 57> - - "Newton-Raphson" - self < 0.0 ifTrue: [ ^ 0.0 - (0.0 - self) arcTan ]. - - "first guess" - theta := (self * Halfpi) / (self + 1.0). - - "iterate" - eps := Halfpi * Epsilon. - step := theta. - [(step * step) > eps] whileTrue: [ - sinTheta := theta sin. - cosTheta := theta cos. - step := (sinTheta * cosTheta) - (self * cosTheta * cosTheta). - theta := theta - step]. - ^ theta! Item was removed: - ----- Method: Float>>exp (in category 'mathematical functions') ----- - exp - "Answer E raised to the receiver power. - Optional. See Object documentation whatIsAPrimitive." - - | base fract correction delta div | - <primitive: 59> - - "Taylor series" - "check the special cases" - self < 0.0 ifTrue: [^ (self negated exp) reciprocal]. - self = 0.0 ifTrue: [^ 1]. - self abs > MaxValLn ifTrue: [self error: 'exp overflow']. - - "get first approximation by raising e to integer power" - base := E raisedToInteger: (self truncated). - - "now compute the correction with a short Taylor series" - "fract will be 0..1, so correction will be 1..E" - "in the worst case, convergance time is logarithmic with 1/Epsilon" - fract := self fractionPart. - fract = 0.0 ifTrue: [ ^ base ]. "no correction required" - - correction := 1.0 + fract. - delta := fract * fract / 2.0. - div := 2.0. - [delta > Epsilon] whileTrue: [ - correction := correction + delta. - div := div + 1.0. - delta := delta * fract / div]. - correction := correction + delta. - ^ base * correction! Item was removed: - ----- Method: Float>>exponent (in category 'truncation and round off') ----- - exponent - "Primitive. Consider the receiver to be represented as a power of two - multiplied by a mantissa (between one and two). Answer with the - SmallInteger to whose power two is raised. Optional. See Object - documentation whatIsAPrimitive." - - <primitive: 53> - ^self exponentFromBitPattern! Item was removed: - ----- Method: Float>>fractionPart (in category 'truncation and round off') ----- - fractionPart - "Primitive. Answer a Float whose value is the difference between the - receiver and the receiver's asInteger value. Optional. See Object - documentation whatIsAPrimitive." - - <primitive: 52> - ^self - self truncated asFloat! Item was removed: - ----- Method: Float>>ln (in category 'mathematical functions') ----- - ln - "Answer the natural logarithm of the receiver. - Optional. See Object documentation whatIsAPrimitive." - - | expt n mant x div pow delta sum eps | - <primitive: 58> - - "Taylor series" - self <= 0.0 ifTrue: [DomainError signal: 'ln is only defined for x > 0.0']. - - "get a rough estimate from binary exponent" - expt := self exponent. - n := Ln2 * expt. - mant := self timesTwoPower: 0 - expt. - - "compute fine correction from mantinssa in Taylor series" - "mant is in the range [0..2]" - "we unroll the loop to avoid use of abs" - x := mant - 1.0. - div := 1.0. - pow := delta := sum := x. - x := x negated. "x <= 0" - eps := Epsilon * (n abs + 1.0). - [delta > eps] whileTrue: [ - "pass one: delta is positive" - div := div + 1.0. - pow := pow * x. - delta := pow / div. - sum := sum + delta. - "pass two: delta is negative" - div := div + 1.0. - pow := pow * x. - delta := pow / div. - sum := sum + delta]. - - ^ n + sum - - "2.718284 ln 1.0"! Item was removed: - ----- Method: Float>>sin (in category 'mathematical functions') ----- - sin - "Answer the sine of the receiver taken as an angle in radians. - Optional. See Object documentation whatIsAPrimitive." - - | sum delta self2 i | - <primitive: 56> - - "Taylor series" - "normalize to the range [0..Pi/2]" - self < 0.0 ifTrue: [^ (0.0 - ((0.0 - self) sin))]. - self > Twopi ifTrue: [^ (self \\ Twopi) sin]. - self > Pi ifTrue: [^ (0.0 - (self - Pi) sin)]. - self > Halfpi ifTrue: [^ (Pi - self) sin]. - - "unroll loop to avoid use of abs" - sum := delta := self. - self2 := 0.0 - (self * self). - i := 2.0. - [delta > Epsilon] whileTrue: [ - "once" - delta := (delta * self2) / (i * (i + 1.0)). - i := i + 2.0. - sum := sum + delta. - "twice" - delta := (delta * self2) / (i * (i + 1.0)). - i := i + 2.0. - sum := sum + delta]. - ^ sum! Item was removed: - ----- Method: Float>>sqrt (in category 'mathematical functions') ----- - sqrt - "Answer the square root of the receiver. - Optional. See Object documentation whatIsAPrimitive." - | exp guess eps delta | - <primitive: 55> - #Numeric. - "Changed 200/01/19 For ANSI <number> support." - "Newton-Raphson" - self <= 0.0 - ifTrue: [self = 0.0 - ifTrue: [^ 0.0] - ifFalse: ["v Chg" - ^ DomainError signal: 'sqrt undefined for number less than zero.']]. - "first guess is half the exponent" - exp := self exponent // 2. - guess := self timesTwoPower: 0 - exp. - "get eps value" - eps := guess * Epsilon. - eps := eps * eps. - delta := self - (guess * guess) / (guess * 2.0). - [delta * delta > eps] - whileTrue: - [guess := guess + delta. - delta := self - (guess * guess) / (guess * 2.0)]. - ^ guess! Item was removed: - ----- Method: Float>>timesTwoPower: (in category 'mathematical functions') ----- - timesTwoPower: anInteger - "Primitive. Answer with the receiver multiplied by 2.0 raised - to the power of the argument. - Optional. See Object documentation whatIsAPrimitive." - - <primitive: 54> - - anInteger < -29 ifTrue: [^ self * (2.0 raisedToInteger: anInteger)]. - anInteger < 0 ifTrue: [^ self / (1 bitShift: (0 - anInteger)) asFloat]. - anInteger < 30 ifTrue: [^ self * (1 bitShift: anInteger) asFloat]. - ^ self * (2.0 raisedToInteger: anInteger)! Item was removed: - ----- Method: Float>>truncated (in category 'truncation and round off') ----- - truncated - "Answer with a SmallInteger equal to the value of the receiver without - its fractional part. The primitive fails if the truncated value cannot be - represented as a SmallInteger. In that case, the code below will compute - a LargeInteger truncated value. - Essential. See Object documentation whatIsAPrimitive. " - - <primitive: 51> - self isFinite ifFalse: [self error: 'Cannot truncate this number']. - - self abs < 2.0e16 - ifTrue: ["Fastest way when it may not be an integer" - | di df q r | - di := 1 + (SmallInteger maxVal bitShift: -1). - df := di asFloat. - q := self quo: df. - r := self - (q asFloat * df). - ^q * di + r truncated] - ifFalse: [^ self asTrueFraction. "Extract all bits of the mantissa and shift if necess"] - - - - ! Item was removed: - ----- Method: Float>>~= (in category 'comparing') ----- - ~= aNumber - "Primitive. Compare the receiver with the argument and return true - if the receiver is not equal to the argument. Otherwise return false. - Fail if the argument is not a Float. Optional. See Object documentation - whatIsAPrimitive." - - <primitive: 48> - ^super ~= aNumber! Item was added: + ----- Method: InstructionClient>>callPrimitive: (in category 'instruction decoding') ----- + callPrimitive: pimIndex + "V3PlusClosures: 139 10001011 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256) + NewsqueakV4: 249 11111001 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256) + SistaV1: 248 11111000 iiiiiiii mjjjjjjj Call Primitive #iiiiiiii + ( jjjjjjj * 256) + m=1 means inlined primitive, no hard return after execution."! Item was added: + ----- Method: InstructionPrinter>>callPrimitive: (in category 'instruction decoding') ----- + callPrimitive: index + "Print the callPrimitive." + + self print: 'callPrimtive: ' , index printString! Item was changed: ----- Method: InstructionStream>>interpretV3ClosuresExtension:in:for: (in category 'decoding - private - v3 plus closures') ----- interpretV3ClosuresExtension: offset in: method for: client | type offset2 byte2 byte3 byte4 | offset <= 6 ifTrue: ["Extended op codes 128-134" byte2 := method at: pc. pc := pc + 1. offset <= 2 ifTrue: ["128-130: extended pushes and pops" type := byte2 // 64. offset2 := byte2 \\ 64. offset = 0 ifTrue: [type = 0 ifTrue: [^client pushReceiverVariable: offset2]. type = 1 ifTrue: [^client pushTemporaryVariable: offset2]. type = 2 ifTrue: [^client pushConstant: (method literalAt: offset2 + 1)]. type = 3 ifTrue: [^client pushLiteralVariable: (method literalAt: offset2 + 1)]]. offset = 1 ifTrue: [type = 0 ifTrue: [^client storeIntoReceiverVariable: offset2]. type = 1 ifTrue: [^client storeIntoTemporaryVariable: offset2]. type = 2 ifTrue: [self error: 'illegalStore']. type = 3 ifTrue: [^client storeIntoLiteralVariable: (method literalAt: offset2 + 1)]]. offset = 2 ifTrue: [type = 0 ifTrue: [^client popIntoReceiverVariable: offset2]. type = 1 ifTrue: [^client popIntoTemporaryVariable: offset2]. type = 2 ifTrue: [self error: 'illegalStore']. type = 3 ifTrue: [^client popIntoLiteralVariable: (method literalAt: offset2 + 1)]]]. "131-134: extended sends" offset = 3 ifTrue: "Single extended send" [^client send: (method literalAt: byte2 \\ 32 + 1) super: false numArgs: byte2 // 32]. offset = 4 ifTrue: "Double extended do-anything" [byte3 := method at: pc. pc := pc + 1. type := byte2 // 32. type = 0 ifTrue: [^client send: (method literalAt: byte3 + 1) super: false numArgs: byte2 \\ 32]. type = 1 ifTrue: [^client send: (method literalAt: byte3 + 1) super: true numArgs: byte2 \\ 32]. type = 2 ifTrue: [^client pushReceiverVariable: byte3]. type = 3 ifTrue: [^client pushConstant: (method literalAt: byte3 + 1)]. type = 4 ifTrue: [^client pushLiteralVariable: (method literalAt: byte3 + 1)]. type = 5 ifTrue: [^client storeIntoReceiverVariable: byte3]. type = 6 ifTrue: [^client popIntoReceiverVariable: byte3]. type = 7 ifTrue: [^client storeIntoLiteralVariable: (method literalAt: byte3 + 1)]]. offset = 5 ifTrue: "Single extended send to super" [^client send: (method literalAt: byte2 \\ 32 + 1) super: true numArgs: byte2 // 32]. offset = 6 ifTrue: "Second extended send" [^client send: (method literalAt: byte2 \\ 64 + 1) super: false numArgs: byte2 // 64]]. offset = 7 ifTrue: [^client doPop]. offset = 8 ifTrue: [^client doDup]. offset = 9 ifTrue: [^client pushActiveContext]. byte2 := method at: pc. pc := pc + 1. offset = 10 ifTrue: [^byte2 < 128 ifTrue: [client pushNewArrayOfSize: byte2] ifFalse: [client pushConsArrayWithElements: byte2 - 128]]. - offset = 11 ifTrue: [^self unusedBytecode: client at: pc - 1]. byte3 := method at: pc. pc := pc + 1. + offset = 11 ifTrue: [^client callPrimitive: byte2 + (byte3 bitShift: 8)]. offset = 12 ifTrue: [^client pushRemoteTemp: byte2 inVectorAt: byte3]. offset = 13 ifTrue: [^client storeIntoRemoteTemp: byte2 inVectorAt: byte3]. offset = 14 ifTrue: [^client popIntoRemoteTemp: byte2 inVectorAt: byte3]. "offset = 15" byte4 := method at: pc. pc := pc + 1. ^client pushClosureCopyNumCopiedValues: (byte2 bitShift: -4) numArgs: (byte2 bitAnd: 16rF) blockSize: (byte3 * 256) + byte4! Item was changed: ----- Method: Integer class>>initialize (in category 'class initialization') ----- + initialize + "Integer initialize" + self initializeLowBitPerByteTable! - initialize "Integer initialize" - "Ensure we have the right compact class index" - - "LPI has been a compact class forever - just ensure basic correctness" - (LargePositiveInteger indexIfCompact = 5) ifFalse:[ - (Smalltalk compactClassesArray at: 5) - ifNil:[LargePositiveInteger becomeCompactSimplyAt: 5] - ifNotNil:[self error: 'Unexpected compact class setup']]. - - "Cog requires LNI to be compact at 4 (replacing PseudoContext)" - (LargeNegativeInteger indexIfCompact = 4) ifFalse:[ - "PseudoContext will likely get removed at some point so write this test - without introducing a hard dependency" - (Smalltalk compactClassesArray at: 4) name == #PseudoContext - ifTrue:[Smalltalk compactClassesArray at: 4 put: nil]. - (Smalltalk compactClassesArray at: 4) - ifNil:[LargeNegativeInteger becomeCompactSimplyAt: 4] - ifNotNil:[self error: 'Unexpected compact class setup']]. - - self initializeLowBitPerByteTable - ! Item was added: + ----- Method: MethodContext class>>allInstances (in category 'enumerating') ----- + allInstances + "Answer all instances of the receiver." + <primitive: 177> + "The primitive can fail because memory is low. If so, fall back on the old + enumeration code, which gives the system a chance to GC and/or grow. + Because aBlock might change the class of inst (for example, using become:), + it is essential to compute next before aBlock value: inst. + Only count until thisContext since this context has been created only to + compute the existing instances." + | inst insts next | + insts := WriteStream on: (Array new: 64). + inst := self someInstance. + [inst == thisContext or: [inst == nil]] whileFalse: + [next := inst nextInstance. + insts nextPut: inst. + inst := next]. + ^insts contents! Item was changed: ----- Method: MethodContext class>>allInstancesDo: (in category 'private') ----- allInstancesDo: aBlock + "Evaluate aBlock with each of the current instances of the receiver." + | instances inst next | + instances := self allInstancesOrNil. + instances ifNotNil: + [instances do: aBlock. + ^self]. + "allInstancesOrNil can fail because memory is low. If so, fall back on the old + enumeration code. Because aBlock might change the class of inst (for example, + using become:), it is essential to compute next before aBlock value: inst. + Only count until thisContext since evaluation of aBlock will create new contexts." - "Only count until thisContext since evaluation of aBlock will create new contexts." - | inst next | inst := self someInstance. + [inst == thisContext or: [inst == nil]] whileFalse: + [next := inst nextInstance. + aBlock value: inst. + inst := next]! - [inst == thisContext] whileFalse:[ - next := inst nextInstance. - aBlock value: inst. - inst := next] - ! Item was added: + ----- Method: MethodContext>>failPrimitiveWith: (in category 'system simulation') ----- + failPrimitiveWith: maybePrimFailToken + "The receiver is a freshly-created context on a primitive method. Skip the callPrimitive: + bytecode and store the primitive fail code if there is one and the method consumes it." + self skipCallPrimitive. + ((self isPrimFailToken: maybePrimFailToken) + and: [method encoderClass isStoreAt: pc in: method]) ifTrue: + [self at: stackp put: maybePrimFailToken last]! Item was changed: ----- 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! - - <primitive: 148> - self primitiveFailed! Item was changed: ----- Method: ProtoObject>>scaledIdentityHash (in category 'comparing') ----- scaledIdentityHash "For identityHash values returned by primitive 75, answer + such values times 2^8. Otherwise, match the existing + identityHash implementation" - such values times 2^18. Otherwise, match the existing - identityHash implementation" + ^self identityHash * 256 "bitShift: 8"! - ^self identityHash * 262144 "bitShift: 18"! Item was added: ==== ERROR === Error: Unrecognized class type 1 December 2014 10:44:46.887 pm VM: unix - a SmalltalkImage Image: Squeak3.11alpha [latest update: #8824] SecurityManager state: Restricted: false FileAccess: true SocketAccess: true Working Dir /home/squeaksource Trusted Dir /home/squeaksource/secure Untrusted Dir /home/squeaksource/My Squeak MCClassDefinition(Object)>>error: Receiver: a MCClassDefinition(SmallFloat64) Arguments and temporary variables: aString: 'Unrecognized class type' Receiver's instance variables: name: #SmallFloat64 superclassName: #Float variables: an OrderedCollection() category: 'Kernel-Numbers' type: #immediate comment: 'My instances represent 64-bit Floats whose exponent fits in 8 bits as...etc... commentStamp: 'eem 11/25/2014 07:54' traitComposition: nil classTraitComposition: nil MCClassDefinition>>kindOfSubclass Receiver: a MCClassDefinition(SmallFloat64) Arguments and temporary variables: Receiver's instance variables: name: #SmallFloat64 superclassName: #Float variables: an OrderedCollection() category: 'Kernel-Numbers' type: #immediate comment: 'My instances represent 64-bit Floats whose exponent fits in 8 bits as...etc... commentStamp: 'eem 11/25/2014 07:54' traitComposition: nil classTraitComposition: nil MCClassDefinition>>printDefinitionOn: Receiver: a MCClassDefinition(SmallFloat64) Arguments and temporary variables: stream: a WriteStream Receiver's instance variables: name: #SmallFloat64 superclassName: #Float variables: an OrderedCollection() category: 'Kernel-Numbers' type: #immediate comment: 'My instances represent 64-bit Floats whose exponent fits in 8 bits as...etc... commentStamp: 'eem 11/25/2014 07:54' traitComposition: nil classTraitComposition: nil [] in MCDiffyTextWriter(MCStWriter)>>writeClassDefinition: Receiver: a MCDiffyTextWriter Arguments and temporary variables: definition: a WriteStream s: a MCClassDefinition(SmallFloat64) Receiver's instance variables: stream: a WriteStream initStream: nil --- The full stack --- MCClassDefinition(Object)>>error: MCClassDefinition>>kindOfSubclass MCClassDefinition>>printDefinitionOn: [] in MCDiffyTextWriter(MCStWriter)>>writeClassDefinition: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - String class(SequenceableCollection class)>>new:streamContents: String class(SequenceableCollection class)>>streamContents: MCDiffyTextWriter(MCTextWriter)>>chunkContents: MCDiffyTextWriter(MCStWriter)>>writeClassDefinition: MCDiffyTextWriter(MCStWriter)>>visitClassDefinition: MCClassDefinition>>accept: [] in MCDiffyTextWriter(MCTextWriter)>>visitInFork: String class(SequenceableCollection class)>>new:streamContents: String class(SequenceableCollection class)>>streamContents: MCDiffyTextWriter(MCTextWriter)>>visitInFork: MCDiffyTextWriter>>writePatchFrom:to: MCDiffyTextWriter>>writeAddition: [] in MCDiffyTextWriter>>writePatch: SortedCollection(OrderedCollection)>>do: MCDiffyTextWriter>>writePatch: SSDiffyTextWriter>>writePatch: [] in SSDiffyTextWriter>>writeVersion:for: BlockClosure>>on:do: SSDiffyTextWriter>>writeVersion:for: [] in SSEMailSubscription>>versionAdded:to: BlockClosure>>on:do: SSEMailSubscription>>versionAdded:to: [] in [] in SSProject>>versionAdded: [] in BlockClosure>>newProcess

1 0

The Trunk: Kernel.spur-eem.889.mcz
by commits＠source.squeak.org 01 Dec '14

01 Dec '14

1 0

The Trunk: Kernel.spur-eem.889.mcz
by commits＠source.squeak.org 01 Dec '14

01 Dec '14

1 0

The Trunk: Kernel.spur-eem.888.mcz
by commits＠source.squeak.org 01 Dec '14

01 Dec '14

Eliot Miranda uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel.spur-eem.888.mcz ==================== Summary ==================== Name: Kernel.spur-eem.888 Author: eem Time: 1 December 2014, 2:43:04.57 pm UUID: db92138a-054c-4a9f-8261-06c3b2ca0d94 Ancestors: Kernel-eem.888, Kernel.spur-eem.887 Kernel-eem.888 patched for Spur by SpurBootstrapMonticelloPackagePatcher Cog-eem.226 Fix CompiledMethod class newFrom: =============== Diff against Kernel-eem.888 =============== Item was changed: ----- Method: Behavior>>allInstances (in category 'accessing instances and variables') ----- + allInstances + "Answer all instances of the receiver." + <primitive: 177> + "The primitive can fail because memory is low. If so, fall back on the old + enumeration code, which gives the system a chance to GC and/or grow. + Because aBlock might change the class of inst (for example, using become:), + it is essential to compute next before aBlock value: inst." + | inst insts next | + insts := WriteStream on: (Array new: 64). + inst := self someInstance. + [inst == nil] whileFalse: + [next := inst nextInstance. + (inst == insts or: [inst == insts originalContents]) ifFalse: [insts nextPut: inst]. + inst := next]. + ^insts contents! - allInstances - "Answer a collection of all current instances of the receiver." - - | all | - all := OrderedCollection new. - self allInstancesDo: [:x | x == all ifFalse: [all add: x]]. - ^ all asArray - ! Item was changed: ----- Method: Behavior>>allInstancesDo: (in category 'enumerating') ----- + allInstancesDo: aBlock + "Evaluate aBlock with each of the current instances of the receiver." + | instances inst next | + instances := self allInstancesOrNil. + instances ifNotNil: + [instances do: aBlock. + ^self]. + "allInstancesOrNil can fail because memory is low. If so, fall back on the old + enumeration code. Because aBlock might change the class of inst (for example, + using become:), it is essential to compute next before aBlock value: inst." - allInstancesDo: aBlock - "Evaluate the argument, aBlock, for each of the current instances of the - receiver. - - Because aBlock might change the class of inst (for example, using become:), - it is essential to compute next before aBlock value: inst." - | inst next | inst := self someInstance. + [inst == nil] whileFalse: + [next := inst nextInstance. + aBlock value: inst. + inst := next]! - [inst == nil] - whileFalse: - [ - next := inst nextInstance. - aBlock value: inst. - inst := next]! Item was added: + ----- Method: Behavior>>allInstancesOrNil (in category 'enumerating') ----- + allInstancesOrNil + "Answer all instances of the receiver, or nil if the primitive + fails, which it may be due to being out of memory." + <primitive: 177> + ^nil! Item was changed: ----- Method: Behavior>>basicNew (in category 'instance creation') ----- basicNew "Primitive. Answer an instance of the receiver (which is a class) with no + indexable variables. Fail if the class is indexable. Essential. See Object + documentation whatIsAPrimitive. + + If the primitive fails because space is low then the scavenger will run + before the method is activated. Check that space was low and retry + via handleFailingBasicNew if so." - indexable variables. Fail if the class is indexable. Essential. See Object - documentation whatIsAPrimitive." + <primitive: 70 error: ec> + ec == #'insufficient object memory' ifTrue: + [^self handleFailingBasicNew]. + self isVariable ifTrue: [^self basicNew: 0]. + self primitiveFailed! - <primitive: 70> - self isVariable ifTrue: [ ^ self basicNew: 0 ]. - "space must be low" - OutOfMemory signal. - ^ self basicNew "retry if user proceeds" - ! Item was changed: ----- Method: Behavior>>basicNew: (in category 'instance creation') ----- + basicNew: sizeRequested + "Primitive. Answer an instance of this class with the number of indexable + variables specified by the argument, sizeRequested. Fail if this class is not + indexable or if the argument is not a positive Integer, or if there is not + enough memory available. Essential. See Object documentation whatIsAPrimitive. + + If the primitive fails because space is low then the scavenger will run before the + method is activated. Check args and retry via handleFailingBasicNew: if they're OK." - basicNew: sizeRequested - "Primitive. Answer an instance of this class with the number - of indexable variables specified by the argument, sizeRequested. - Fail if this class is not indexable or if the argument is not a - positive Integer, or if there is not enough memory available. - Essential. See Object documentation whatIsAPrimitive." + <primitive: 71 error: ec> + ec == #'insufficient object memory' ifTrue: + [^self handleFailingBasicNew: sizeRequested]. - <primitive: 71> self isVariable ifFalse: [self error: self printString, ' cannot have variable sized instances']. - (sizeRequested isInteger and: [sizeRequested >= 0]) ifTrue: - ["arg okay; space must be low." - OutOfMemory signal. - ^ self basicNew: sizeRequested "retry if user proceeds"]. self primitiveFailed! Item was added: + ----- Method: Behavior>>byteSizeOfInstance (in category 'accessing instances and variables') ----- + byteSizeOfInstance + "Answer the total memory size of an instance of the receiver." + + <primitive: 181 error: ec> + self isVariable ifTrue: + [^self byteSizeOfInstanceOfSize: 0]. + self primitiveFailed! Item was added: + ----- Method: Behavior>>byteSizeOfInstanceOfSize: (in category 'accessing instances and variables') ----- + byteSizeOfInstanceOfSize: basicSize + "Answer the total memory size of an instance of the receiver + with the given number of indexable instance variables." + + <primitive: 181 error: ec> + self isVariable + ifTrue: "If the primitive overflowed answer a close approximation" + [(basicSize isInteger + and: [basicSize >= 16r1000000]) ifTrue: + [^2 * (self byteSizeOfInstanceOfSize: basicSize + 1 // 2) + - (self byteSizeOfInstanceOfSize: 0)]] + ifFalse: + [basicSize = 0 ifTrue: + [^self byteSizeOfInstance]]. + self primitiveFailed! Item was added: + ----- Method: Behavior>>elementSize (in category 'accessing instances and variables') ----- + elementSize + "Answer the size in bytes of an element in the receiver. The formats are + 0 = 0 sized objects (UndefinedObject True False et al) + 1 = non-indexable objects with inst vars (Point et al) + 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) + 4 = weak indexable objects with inst vars (WeakArray et al) + 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) + 6 = unused + 7 = immediates (SmallInteger, Character) + 8 = unused + 9 = 64-bit indexable + 10-11 = 32-bit indexable (Bitmap) + 12-15 = 16-bit indexable + 16-23 = 8-bit indexable + 24-31 = compiled methods (CompiledMethod)" + | instSpec | + instSpec := self instSpec. + instSpec < 9 ifTrue: [^Smalltalk wordSize]. + instSpec >= 16 ifTrue: [^1]. + instSpec >= 12 ifTrue: [^2]. + instSpec >= 10 ifTrue: [^4]. + ^8! Item was added: + ----- Method: Behavior>>handleFailingBasicNew (in category 'private') ----- + handleFailingBasicNew + "handleFailingBasicNew gets sent after basicNew has failed and allowed + a scavenging garbage collection to occur. The scavenging collection + will have happened as the VM is activating the (failing) basicNew. If + handleFailingBasicNew fails then the scavenge failed to reclaim sufficient + space and a global garbage collection is required. Retry after garbage + collecting and growing memory if necessary. + + Primitive. Answer an instance of this class with the number of indexable + variables specified by the argument, sizeRequested. Fail if this class is not + indexable or if the argument is not a positive Integer, or if there is not + enough memory available. Essential. See Object documentation whatIsAPrimitive." + + <primitive: 70> + Smalltalk garbageCollect < 1048576 ifTrue: + [Smalltalk growMemoryByAtLeast: 1048576]. + ^self handleFailingFailingBasicNew "retry after global garbage collect"! Item was added: + ----- Method: Behavior>>handleFailingBasicNew: (in category 'private') ----- + handleFailingBasicNew: sizeRequested + "handleFailingBasicNew: gets sent after basicNew: has failed and allowed + a scavenging garbage collection to occur. The scavenging collection + will have happened as the VM is activating the (failing) basicNew:. If + handleFailingBasicNew: fails then the scavenge failed to reclaim sufficient + space and a global garbage collection is required. Retry after garbage + collecting and growing memory if necessary. + + Primitive. Answer an instance of this class with the number of indexable + variables specified by the argument, sizeRequested. Fail if this class is not + indexable or if the argument is not a positive Integer, or if there is not + enough memory available. Essential. See Object documentation whatIsAPrimitive." + + <primitive: 71> + | bytesRequested | + bytesRequested := self byteSizeOfInstanceOfSize: sizeRequested. + Smalltalk garbageCollect < bytesRequested ifTrue: + [Smalltalk growMemoryByAtLeast: bytesRequested]. + "retry after global garbage collect and possible grow" + ^self handleFailingFailingBasicNew: sizeRequested! Item was added: + ----- Method: Behavior>>handleFailingFailingBasicNew (in category 'private') ----- + handleFailingFailingBasicNew + "This basicNew gets sent after handleFailingBasicNew: has done a full + garbage collection and possibly grown memory. If this basicNew fails + then the system really is low on space, so raise the OutOfMemory signal. + + Primitive. Answer an instance of this class with the number of indexable + variables specified by the argument, sizeRequested. Fail if this class is not + indexable or if the argument is not a positive Integer, or if there is not + enough memory available. Essential. See Object documentation whatIsAPrimitive." + + <primitive: 70> + "space must be low" + OutOfMemory signal. + ^self basicNew "retry if user proceeds"! Item was added: + ----- Method: Behavior>>handleFailingFailingBasicNew: (in category 'private') ----- + handleFailingFailingBasicNew: sizeRequested + "This basicNew: gets sent after handleFailingBasicNew: has done a full + garbage collection and possibly grown memory. If this basicNew: fails + then the system really is low on space, so raise the OutOfMemory signal. + + Primitive. Answer an instance of this class with the number of indexable + variables specified by the argument, sizeRequested. Fail if this class is not + indexable or if the argument is not a positive Integer, or if there is not + enough memory available. Essential. See Object documentation whatIsAPrimitive." + + <primitive: 71> + "space must be low." + OutOfMemory signal. + ^self basicNew: sizeRequested "retry if user proceeds"! Item was added: + ----- Method: Behavior>>identityHash (in category 'comparing') ----- + identityHash + "Answer a SmallInteger whose value is related to the receiver's identity. + Behavior implements identityHash to allow the VM to use an object representation which + does not include a direct reference to an object's class in an object. If the VM is using + this implementation then classes are held in a class table and instances contain the index + of their class in the table. A class's class table index is its identityHash so that an instance + can be created without searching the table for a class's index. The VM uses this primitive + to enter the class into the class table, assigning its identityHash with an as yet unused + class table index. If this primitive fails it means that the class table is full. In Spur as of + 2014 there are 22 bits of classTable index and 22 bits of identityHash per object. + + Primitive. Essential. Do not override. See Object documentation whatIsAPrimitive." + + <primitive: 175> + self primitiveFailed! Item was changed: ----- Method: Behavior>>indexIfCompact (in category 'private') ----- indexIfCompact + "Backward compatibility with the Squeak V3 object format. + Spur does not have a distinction between compact and non-compact classes." + ^0! - "If these 5 bits are non-zero, then instances of this class - will be compact. It is crucial that there be an entry in - Smalltalk compactClassesArray for any class so optimized. - See the msgs becomeCompact and becomeUncompact." - ^ (format bitShift: -11) bitAnd: 16r1F - " - Smalltalk compactClassesArray doWithIndex: - [:c :i | c == nil ifFalse: - [c indexIfCompact = i ifFalse: [self halt]]] - "! Item was changed: ----- Method: Behavior>>instSize (in category 'testing') ----- instSize "Answer the number of named instance variables + (as opposed to indexed variables) of the receiver. + Above Cog Spur the class format is + <5 bits inst spec><16 bits inst size>" + ^format bitAnd: 16rFFFF! - (as opposed to indexed variables) of the receiver." - - self flag: #instSizeChange. "Smalltalk browseAllCallsOn: #instSizeChange" - " - NOTE: This code supports the backward-compatible extension to 8 bits of instSize. - When we revise the image format, it should become... - ^ ((format bitShift: -1) bitAnd: 16rFF) - 1 - Note also that every other method in this category will require - 2 bits more of right shift after the change. - " - ^ ((format bitShift: -10) bitAnd: 16rC0) + ((format bitShift: -1) bitAnd: 16r3F) - 1! Item was changed: ----- Method: Behavior>>instSpec (in category 'testing') ----- instSpec + "Answer the instance specification part of the format that defines what kind of object + an instance of the receiver is. The formats are + 0 = 0 sized objects (UndefinedObject True False et al) + 1 = non-indexable objects with inst vars (Point et al) + 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) + 4 = weak indexable objects with inst vars (WeakArray et al) + 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) + 6 = unused + 7 = immediates (SmallInteger, Character) + 8 = unused + 9 = 64-bit indexable + 10-11 = 32-bit indexable (Bitmap) + 12-15 = 16-bit indexable + 16-23 = 8-bit indexable + 24-31 = compiled methods (CompiledMethod)" + ^(format bitShift: -16) bitAnd: 16r1F! - ^ (format bitShift: -7) bitAnd: 16rF! Item was changed: ----- Method: Behavior>>isBits (in category 'testing') ----- isBits + "Answer whether the receiver contains just bits (not pointers). + Above Cog Spur the class format is + <5 bits inst spec><16 bits inst size> + where the 5-bit inst spec is + 0 = 0 sized objects (UndefinedObject True False et al) + 1 = non-indexable objects with inst vars (Point et al) + 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) + 4 = weak indexable objects with inst vars (WeakArray et al) + 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) + 6 = unused + 7 = immediates (SmallInteger, Character) + 8 = unused + 9 = 64-bit indexable + 10-11 = 32-bit indexable (Bitmap) + 12-15 = 16-bit indexable + 16-23 = 8-bit indexable + 24-31 = compiled methods (CompiledMethod)" + ^self instSpec >= 7! - "Answer whether the receiver contains just bits (not pointers)." - - ^ self instSpec >= 6! Item was changed: ----- Method: Behavior>>isBytes (in category 'testing') ----- isBytes + "Answer whether the receiver has 8-bit instance variables. + Above Cog Spur the class format is + <5 bits inst spec><16 bits inst size> + where the 5-bit inst spec is + 0 = 0 sized objects (UndefinedObject True False et al) + 1 = non-indexable objects with inst vars (Point et al) + 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) + 4 = weak indexable objects with inst vars (WeakArray et al) + 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) + 6 = unused + 7 = immediates (SmallInteger, Character) + 8 = unused + 9 = 64-bit indexable + 10-11 = 32-bit indexable (Bitmap) + 12-15 = 16-bit indexable + 16-23 = 8-bit indexable + 24-31 = compiled methods (CompiledMethod)" + ^self instSpec >= 16! - "Answer whether the receiver has 8-bit instance variables." - - ^ self instSpec >= 8! Item was added: + ----- Method: Behavior>>isCompiledMethodClass (in category 'as yet unclassified') ----- + isCompiledMethodClass + "Answer whether the receiver has compiled method instances that mix pointers and bytes." + ^self instSpec >= 24! Item was added: + ----- Method: Behavior>>isEphemeronClass (in category 'testing') ----- + isEphemeronClass + "Answer whether the receiver has ephemeral instance variables. The garbage collector will + fire (queue for finalization) any ephemeron whose first instance variable is not referenced + other than from the transitive closure of references from ephemerons. Hence referring to + an object from the first inst var of an ephemeron will cause the ephemeron to fire when + the rest of the system does not refer to the object and that object is ready to be collected. + Since references from the remaining inst vars of an ephemeron will not prevent the ephemeron + from firing, ephemerons may act as the associations in weak dictionaries such that the value + (e.g. properties attached to the key) will not prevent firing when the key is no longer referenced + other than from ephemerons. Ephemerons can therefore be used to implement instance-based + pre-mortem finalization." + ^self instSpec = 5! Item was added: + ----- Method: Behavior>>isImmediateClass (in category 'testing') ----- + isImmediateClass + "Answer whether the receiver has immediate instances. Immediate instances + store their value in their object pointer, not in an object body. Hence immediates + take no space and are immutable. The immediates are distinguished by tag bits + in the pointer. They include SmallIntegers and Characters. Hence in the 32-bit + system SmallIntegers are 31-bit signed integers and Characters are 30-bit + unsigned character codes." + ^self instSpec = 7! Item was changed: ----- Method: Behavior>>isVariable (in category 'testing') ----- isVariable + "Answer whether the receiver has indexable variables. + Above Cog Spur the class format is + <5 bits inst spec><16 bits inst size> + where the 5-bit inst spec is + 0 = 0 sized objects (UndefinedObject True False et al) + 1 = non-indexable objects with inst vars (Point et al) + 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) + 4 = weak indexable objects with inst vars (WeakArray et al) + 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) + 6 = unused + 7 = immediates (SmallInteger, Character) + 8 = unused + 9 = 64-bit indexable + 10-11 = 32-bit indexable (Bitmap) + 12-15 = 16-bit indexable + 16-23 = 8-bit indexable + 24-31 = compiled methods (CompiledMethod)" + | instSpec | + instSpec := self instSpec. + ^instSpec >= 2 and: [instSpec <= 4 or: [instSpec >= 9]]! - "Answer whether the receiver has indexable variables." - - ^ self instSpec >= 2! Item was changed: ----- Method: Behavior>>kindOfSubclass (in category 'testing class hierarchy') ----- kindOfSubclass + "Answer a String that is the keyword that describes the receiver's kind of subclass, + either a regular subclass, a variableSubclass, a variableByteSubclass, + a variableWordSubclass, a weakSubclass, an ephemeronSubclass or an immediateSubclass. + c.f. typeOfClass" + ^self isVariable + ifTrue: + [self isBits + ifTrue: + [self isBytes + ifTrue: [' variableByteSubclass: '] + ifFalse: [' variableWordSubclass: ']] + ifFalse: + [self isWeak + ifTrue: [' weakSubclass: '] + ifFalse: [' variableSubclass: ']]] + ifFalse: + [self isImmediateClass + ifTrue: [' immediateSubclass: '] + ifFalse: + [self isEphemeronClass + ifTrue: [' ephemeronSubclass: '] + ifFalse: [' subclass: ']]]! - "Answer a String that is the keyword that describes the receiver's kind - of subclass, either a regular subclass, a variableSubclass, a - variableByteSubclass, a variableWordSubclass, or a weakSubclass." - self isWeak - ifTrue: [^ ' weakSubclass: ']. - ^ self isVariable - ifTrue: [self isBits - ifTrue: [self isBytes - ifTrue: [ ' variableByteSubclass: '] - ifFalse: [ ' variableWordSubclass: ']] - ifFalse: [ ' variableSubclass: ']] - ifFalse: [ ' subclass: ']! Item was changed: ----- Method: Behavior>>shouldNotBeRedefined (in category 'testing') ----- shouldNotBeRedefined + "Answer if the receiver should not be redefined. + The assumption is that classes in Smalltalk specialObjects and + instance-specific Behaviors should not be redefined" - "Return true if the receiver should not be redefined. - The assumption is that compact classes, - classes in Smalltalk specialObjects and - Behaviors should not be redefined" + ^(Smalltalk specialObjectsArray + identityIndexOf: self + ifAbsent: [(self isKindOf: self) ifTrue: [1] ifFalse: [0]]) ~= 0! - ^(Smalltalk compactClassesArray includes: self) - or:[(Smalltalk specialObjectsArray includes: self) - or:[self isKindOf: self]]! Item was changed: ----- Method: Behavior>>typeOfClass (in category 'accessing') ----- typeOfClass + "Answer a symbol uniquely describing the type of the receiver. c.f. kindOfSubclass" + self isBytes ifTrue: + [^self instSpec = CompiledMethod instSpec + ifTrue: [#compiledMethod] "Very special!!" + ifFalse: [#bytes]]. + (self isWords and: [self isPointers not]) ifTrue: + [^self instSpec = SmallInteger instSpec + ifTrue: [#immediate] "Very special!!" + ifFalse: [#words]]. + self isWeak ifTrue: [^#weak]. + self isVariable ifTrue: [^#variable]. + self isEphemeronClass ifTrue: [^#ephemeron]. + ^#normal! - "Answer a symbol uniquely describing the type of the receiver" - self instSpec = CompiledMethod instSpec ifTrue:[^#compiledMethod]. "Very special!!" - self isBytes ifTrue:[^#bytes]. - (self isWords and:[self isPointers not]) ifTrue:[^#words]. - self isWeak ifTrue:[^#weak]. - self isVariable ifTrue:[^#variable]. - ^#normal.! Item was changed: ----- Method: BlockClosure>>simulateValueWithArguments:caller: (in category 'system simulation') ----- simulateValueWithArguments: anArray caller: aContext + "Simulate the valueWithArguments: primitive. Fail if anArray is not an array of the right arity." | newContext sz | - (anArray class ~~ Array - or: [numArgs ~= anArray size]) ifTrue: - [^ContextPart primitiveFailTokenFor: nil]. newContext := (MethodContext newForMethod: outerContext method) setSender: aContext receiver: outerContext receiver method: outerContext method closure: self startpc: startpc. + ((newContext objectClass: anArray) ~~ Array + or: [numArgs ~= anArray size]) ifTrue: + [^ContextPart primitiveFailTokenFor: nil]. sz := self basicSize. newContext stackp: sz + numArgs. 1 to: numArgs do: [:i| newContext at: i put: (anArray at: i)]. 1 to: sz do: [:i| newContext at: i + numArgs put: (self at: i)]. ^newContext! Item was added: + Float variableWordSubclass: #BoxedFloat64 + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Kernel-Numbers'! + + !BoxedFloat64 commentStamp: 'eem 11/25/2014 07:54' prior: 0! + My instances hold 64-bit Floats in heap objects. This is the only representation on 32-bit systems. But on 64-bit systems SmallFloat64 holds a subset of the full 64-bit double-precision range in immediate objects.! Item was added: + ----- Method: BoxedFloat64 class>>basicNew (in category 'instance creation') ----- + basicNew + ^self basicNew: 2! Item was added: + ----- Method: BoxedFloat64 class>>basicNew: (in category 'instance creation') ----- + basicNew: sizeRequested + "Primitive. Answer an instance of this class with the number + of indexable variables specified by the argument, sizeRequested. + Fail if this class is not indexable or if the argument is not a + positive Integer, or if there is not enough memory available. + Essential. See Object documentation whatIsAPrimitive." + + <primitive: 71> + sizeRequested isInteger ifTrue: + [^sizeRequested = 2 + ifTrue: "arg okay; space must be low." + [OutOfMemory signal. + self basicNew: sizeRequested] "retry if user proceeds" + ifFalse: + [self error: 'a Float shall always have two slots']]. + self primitiveFailed! Item was added: + ----- Method: BoxedFloat64>>* (in category 'arithmetic') ----- + * aNumber + "Primitive. Answer the result of multiplying the receiver by aNumber. + Fail if the argument is not a Float. Essential. See Object documentation + whatIsAPrimitive." + + <primitive: 49> + ^ aNumber adaptToFloat: self andSend: #*! Item was added: + ----- Method: BoxedFloat64>>+ (in category 'arithmetic') ----- + + aNumber + "Primitive. Answer the sum of the receiver and aNumber. Essential. + Fail if the argument is not a Float. See Object documentation + whatIsAPrimitive." + + <primitive: 41> + ^ aNumber adaptToFloat: self andSend: #+! Item was added: + ----- Method: BoxedFloat64>>- (in category 'arithmetic') ----- + - aNumber + "Primitive. Answer the difference between the receiver and aNumber. + Fail if the argument is not a Float. Essential. See Object documentation + whatIsAPrimitive." + + <primitive: 42> + ^ aNumber adaptToFloat: self andSend: #-! Item was added: + ----- Method: BoxedFloat64>>/ (in category 'arithmetic') ----- + / aNumber + "Primitive. Answer the result of dividing receiver by aNumber. + Fail if the argument is not a Float. Essential. See Object documentation + whatIsAPrimitive." + + <primitive: 50> + aNumber isZero ifTrue: [^(ZeroDivide dividend: self) signal]. + ^ aNumber adaptToFloat: self andSend: #/! Item was added: + ----- Method: BoxedFloat64>>< (in category 'comparing') ----- + < aNumber + "Primitive. Compare the receiver with the argument and return true + if the receiver is less than the argument. Otherwise return false. + Fail if the argument is not a Float. Essential. See Object documentation + whatIsAPrimitive." + + <primitive: 43> + ^ aNumber adaptToFloat: self andCompare: #<! Item was added: + ----- Method: BoxedFloat64>><= (in category 'comparing') ----- + <= aNumber + "Primitive. Compare the receiver with the argument and return true + if the receiver is less than or equal to the argument. Otherwise return + false. Fail if the argument is not a Float. Optional. See Object + documentation whatIsAPrimitive." + + <primitive: 45> + ^ aNumber adaptToFloat: self andCompare: #<=! Item was added: + ----- Method: BoxedFloat64>>= (in category 'comparing') ----- + = aNumber + "Primitive. Compare the receiver with the argument and return true + if the receiver is equal to the argument. Otherwise return false. + Fail if the argument is not a Float. Essential. See Object documentation + whatIsAPrimitive." + + <primitive: 47> + aNumber isNumber ifFalse: [^ false]. + ^ aNumber adaptToFloat: self andCompare: #=! Item was added: + ----- Method: BoxedFloat64>>> (in category 'comparing') ----- + > aNumber + "Primitive. Compare the receiver with the argument and return true + if the receiver is greater than the argument. Otherwise return false. + Fail if the argument is not a Float. Essential. See Object documentation + whatIsAPrimitive." + + <primitive: 44> + ^ aNumber adaptToFloat: self andCompare: #>! Item was added: + ----- Method: BoxedFloat64>>>= (in category 'comparing') ----- + >= aNumber + "Primitive. Compare the receiver with the argument and return true + if the receiver is greater than or equal to the argument. Otherwise return + false. Fail if the argument is not a Float. Optional. See Object documentation + whatIsAPrimitive. " + + <primitive: 46> + ^ aNumber adaptToFloat: self andCompare: #>=! Item was added: + ----- Method: BoxedFloat64>>arcTan (in category 'mathematical functions') ----- + arcTan + "Answer the angle in radians. + Optional. See Object documentation whatIsAPrimitive." + + | theta eps step sinTheta cosTheta | + <primitive: 57> + + "Newton-Raphson" + self < 0.0 ifTrue: [ ^ 0.0 - (0.0 - self) arcTan ]. + + "first guess" + theta := (self * Halfpi) / (self + 1.0). + + "iterate" + eps := Halfpi * Epsilon. + step := theta. + [(step * step) > eps] whileTrue: [ + sinTheta := theta sin. + cosTheta := theta cos. + step := (sinTheta * cosTheta) - (self * cosTheta * cosTheta). + theta := theta - step]. + ^ theta! Item was added: + ----- Method: BoxedFloat64>>exp (in category 'mathematical functions') ----- + exp + "Answer E raised to the receiver power. + Optional. See Object documentation whatIsAPrimitive." + + | base fract correction delta div | + <primitive: 59> + + "Taylor series" + "check the special cases" + self < 0.0 ifTrue: [^ (self negated exp) reciprocal]. + self = 0.0 ifTrue: [^ 1]. + self abs > MaxValLn ifTrue: [self error: 'exp overflow']. + + "get first approximation by raising e to integer power" + base := E raisedToInteger: (self truncated). + + "now compute the correction with a short Taylor series" + "fract will be 0..1, so correction will be 1..E" + "in the worst case, convergance time is logarithmic with 1/Epsilon" + fract := self fractionPart. + fract = 0.0 ifTrue: [ ^ base ]. "no correction required" + + correction := 1.0 + fract. + delta := fract * fract / 2.0. + div := 2.0. + [delta > Epsilon] whileTrue: [ + correction := correction + delta. + div := div + 1.0. + delta := delta * fract / div]. + correction := correction + delta. + ^ base * correction! Item was added: + ----- Method: BoxedFloat64>>exponent (in category 'truncation and round off') ----- + exponent + "Primitive. Consider the receiver to be represented as a power of two + multiplied by a mantissa (between one and two). Answer with the + SmallInteger to whose power two is raised. Optional. See Object + documentation whatIsAPrimitive." + + <primitive: 53> + ^self exponentFromBitPattern! Item was added: + ----- Method: BoxedFloat64>>fractionPart (in category 'truncation and round off') ----- + fractionPart + "Primitive. Answer a Float whose value is the difference between the + receiver and the receiver's asInteger value. Optional. See Object + documentation whatIsAPrimitive." + + <primitive: 52> + ^self - self truncated asFloat! Item was added: + ----- Method: BoxedFloat64>>ln (in category 'mathematical functions') ----- + ln + "Answer the natural logarithm of the receiver. + Optional. See Object documentation whatIsAPrimitive." + + | expt n mant x div pow delta sum eps | + <primitive: 58> + + "Taylor series" + self <= 0.0 ifTrue: [DomainError signal: 'ln is only defined for x > 0.0']. + + "get a rough estimate from binary exponent" + expt := self exponent. + n := Ln2 * expt. + mant := self timesTwoPower: 0 - expt. + + "compute fine correction from mantinssa in Taylor series" + "mant is in the range [0..2]" + "we unroll the loop to avoid use of abs" + x := mant - 1.0. + div := 1.0. + pow := delta := sum := x. + x := x negated. "x <= 0" + eps := Epsilon * (n abs + 1.0). + [delta > eps] whileTrue: [ + "pass one: delta is positive" + div := div + 1.0. + pow := pow * x. + delta := pow / div. + sum := sum + delta. + "pass two: delta is negative" + div := div + 1.0. + pow := pow * x. + delta := pow / div. + sum := sum + delta]. + + ^ n + sum + + "2.718284 ln 1.0"! Item was added: + ----- Method: BoxedFloat64>>sin (in category 'mathematical functions') ----- + sin + "Answer the sine of the receiver taken as an angle in radians. + Optional. See Object documentation whatIsAPrimitive." + + | sum delta self2 i | + <primitive: 56> + + "Taylor series" + "normalize to the range [0..Pi/2]" + self < 0.0 ifTrue: [^ (0.0 - ((0.0 - self) sin))]. + self > Twopi ifTrue: [^ (self \\ Twopi) sin]. + self > Pi ifTrue: [^ (0.0 - (self - Pi) sin)]. + self > Halfpi ifTrue: [^ (Pi - self) sin]. + + "unroll loop to avoid use of abs" + sum := delta := self. + self2 := 0.0 - (self * self). + i := 2.0. + [delta > Epsilon] whileTrue: [ + "once" + delta := (delta * self2) / (i * (i + 1.0)). + i := i + 2.0. + sum := sum + delta. + "twice" + delta := (delta * self2) / (i * (i + 1.0)). + i := i + 2.0. + sum := sum + delta]. + ^ sum! Item was added: + ----- Method: BoxedFloat64>>sqrt (in category 'mathematical functions') ----- + sqrt + "Answer the square root of the receiver. + Optional. See Object documentation whatIsAPrimitive." + | exp guess eps delta | + <primitive: 55> + #Numeric. + "Changed 200/01/19 For ANSI <number> support." + "Newton-Raphson" + self <= 0.0 + ifTrue: [self = 0.0 + ifTrue: [^ 0.0] + ifFalse: ["v Chg" + ^ DomainError signal: 'sqrt undefined for number less than zero.']]. + "first guess is half the exponent" + exp := self exponent // 2. + guess := self timesTwoPower: 0 - exp. + "get eps value" + eps := guess * Epsilon. + eps := eps * eps. + delta := self - (guess * guess) / (guess * 2.0). + [delta * delta > eps] + whileTrue: + [guess := guess + delta. + delta := self - (guess * guess) / (guess * 2.0)]. + ^ guess! Item was added: + ----- Method: BoxedFloat64>>timesTwoPower: (in category 'mathematical functions') ----- + timesTwoPower: anInteger + "Primitive. Answer with the receiver multiplied by 2.0 raised + to the power of the argument. + Optional. See Object documentation whatIsAPrimitive." + + <primitive: 54> + + anInteger < -29 ifTrue: [^ self * (2.0 raisedToInteger: anInteger)]. + anInteger < 0 ifTrue: [^ self / (1 bitShift: (0 - anInteger)) asFloat]. + anInteger < 30 ifTrue: [^ self * (1 bitShift: anInteger) asFloat]. + ^ self * (2.0 raisedToInteger: anInteger)! Item was added: + ----- Method: BoxedFloat64>>truncated (in category 'truncation and round off') ----- + truncated + "Answer with a SmallInteger equal to the value of the receiver without + its fractional part. The primitive fails if the truncated value cannot be + represented as a SmallInteger. In that case, the code below will compute + a LargeInteger truncated value. + Essential. See Object documentation whatIsAPrimitive. " + + <primitive: 51> + self isFinite ifFalse: [self error: 'Cannot truncate this number']. + + self abs < 2.0e16 + ifTrue: ["Fastest way when it may not be an integer" + | di df q r | + di := 1 + (SmallInteger maxVal bitShift: -1). + df := di asFloat. + q := self quo: df. + r := self - (q asFloat * df). + ^q * di + r truncated] + ifFalse: [^ self asTrueFraction. "Extract all bits of the mantissa and shift if necess"] + + + + ! Item was added: + ----- Method: BoxedFloat64>>~= (in category 'comparing') ----- + ~= aNumber + "Primitive. Compare the receiver with the argument and return true + if the receiver is not equal to the argument. Otherwise return false. + Fail if the argument is not a Float. Optional. See Object documentation + whatIsAPrimitive." + + <primitive: 48> + ^super ~= aNumber! Item was added: + ----- Method: Class>>immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'subclass creation') ----- + immediateSubclass: t instanceVariableNames: f classVariableNames: d poolDictionaries: s category: cat + "This is the standard initialization message for creating a new + immediate class as a subclass of an existing class (the receiver)." + ^ClassBuilder new + superclass: self + immediateSubclass: t + instanceVariableNames: f + classVariableNames: d + poolDictionaries: s + category: cat! Item was changed: ----- Method: ClassBuilder>>computeFormat:instSize:forSuper:ccIndex: (in category 'class format') ----- computeFormat: type instSize: newInstSize forSuper: newSuper ccIndex: ccIndex "Compute the new format for making oldClass a subclass of newSuper. + Answer the format or nil if there is any problem." - Return the format or nil if there is any problem." | instSize isVar isWords isPointers isWeak | type == #compiledMethod ifTrue: + [newInstSize > 0 ifTrue: + [self error: 'A compiled method class cannot have named instance variables'. + ^nil]. + ^CompiledMethod format]. - [^(CompiledMethod format - bitClear: (16r1F bitShift: 11)) - bitOr: (ccIndex bitShift: 11)]. instSize := newInstSize + (newSuper ifNil:[0] ifNotNil:[newSuper instSize]). + instSize > 65535 ifTrue: - instSize > 254 ifTrue: [self error: 'Class has too many instance variables (', instSize printString,')'. ^nil]. type == #normal ifTrue:[isVar := isWeak := false. isWords := isPointers := true]. type == #bytes ifTrue:[isVar := true. isWords := isPointers := isWeak := false]. type == #words ifTrue:[isVar := isWords := true. isPointers := isWeak := false]. type == #variable ifTrue:[isVar := isPointers := isWords := true. isWeak := false]. type == #weak ifTrue:[isVar := isWeak := isWords := isPointers := true]. + type == #ephemeron ifTrue:[isVar := false. isWeak := isWords := isPointers := true]. + type == #immediate ifTrue:[isVar := isWeak := isPointers := false. isWords := true]. + (isPointers not and: [instSize > 0]) ifTrue: + [self error: 'A non-pointer class cannot have named instance variables'. - (isPointers not and:[instSize > 0]) ifTrue: - [self error:'A non-pointer class cannot have instance variables'. ^nil]. + ^self format: instSize variable: isVar words: isWords pointers: isPointers weak: isWeak! - ^(self format: instSize - variable: isVar - words: isWords - pointers: isPointers - weak: isWeak) + (ccIndex bitShift: 11).! Item was changed: ----- Method: ClassBuilder>>format:variable:words:pointers:weak: (in category 'class format') ----- + format: nInstVars variable: isVar words: is32BitWords pointers: isPointers weak: isWeak + "Compute the format for the given instance specfication. + Above Cog Spur the class format is + <5 bits inst spec><16 bits inst size> + where the 5-bit inst spec is + 0 = 0 sized objects (UndefinedObject True False et al) + 1 = non-indexable objects with inst vars (Point et al) + 2 = indexable objects with no inst vars (Array et al) + 3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al) + 4 = weak indexable objects with inst vars (WeakArray et al) + 5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron) + 6 = unused + 7 = immediates (SmallInteger, Character) + 8 = unused + 9 = reserved for 64-bit indexable + 10-11 = 32-bit indexable (Bitmap) + 12-15 = 16-bit indexable + 16-23 = 8-bit indexable + 24-31 = compiled methods (CompiledMethod)" + | instSpec | - format: nInstVars variable: isVar words: isWords pointers: isPointers weak: isWeak - "Compute the format for the given instance specfication." - | cClass instSpec sizeHiBits fmt | - self flag: #instSizeChange. - " - Smalltalk browseAllCallsOn: #instSizeChange. - Smalltalk browseAllImplementorsOf: #fixedFieldsOf:. - Smalltalk browseAllImplementorsOf: #instantiateClass:indexableSize:. - " - " - NOTE: This code supports the backward-compatible extension to 8 bits of instSize. - For now the format word is... - <2 bits=instSize//64><5 bits=cClass><4 bits=instSpec><6 bits=instSize\\64><1 bit=0> - But when we revise the image format, it should become... - <5 bits=cClass><4 bits=instSpec><8 bits=instSize><1 bit=0> - " - sizeHiBits := (nInstVars+1) // 64. - cClass := 0. "for now" instSpec := isWeak + ifTrue: + [isVar + ifTrue: [4] + ifFalse: [5]] + ifFalse: + [isPointers + ifTrue: + [isVar + ifTrue: [nInstVars > 0 ifTrue: [3] ifFalse: [2]] + ifFalse: [nInstVars > 0 ifTrue: [1] ifFalse: [0]]] + ifFalse: + [isVar + ifTrue: [is32BitWords ifTrue: [10] ifFalse: [16]] + ifFalse: [7]]]. + ^(instSpec bitShift: 16) + nInstVars! - ifTrue:[4] - ifFalse:[isPointers - ifTrue: [isVar - ifTrue: [nInstVars>0 ifTrue: [3] ifFalse: [2]] - ifFalse: [nInstVars>0 ifTrue: [1] ifFalse: [0]]] - ifFalse: [isWords ifTrue: [6] ifFalse: [8]]]. - fmt := sizeHiBits. - fmt := (fmt bitShift: 5) + cClass. - fmt := (fmt bitShift: 4) + instSpec. - fmt := (fmt bitShift: 6) + ((nInstVars+1)\\64). "+1 since prim size field includes header" - fmt := (fmt bitShift: 1). "This shift plus integer bit lets wordSize work like byteSize" - ^fmt! Item was added: + ----- Method: ClassBuilder>>superclass:immediateSubclass:instanceVariableNames:classVariableNames:poolDictionaries:category: (in category 'public') ----- + superclass: aClass + immediateSubclass: t instanceVariableNames: f + classVariableNames: d poolDictionaries: s category: cat + "This is the standard initialization message for creating a + new immediate class as a subclass of an existing class." + | env | + aClass instSize > 0 + ifTrue: [^self error: 'cannot make an immediate subclass of a class with named fields']. + aClass isVariable + ifTrue: [^self error: 'cannot make an immediate subclass of a class with indexed instance variables']. + aClass isPointers + ifFalse: [^self error: 'cannot make an immediate subclass of a class without pointer fields']. + "Cope with pre-environment and environment versions. Simplify asap." + env := (Smalltalk classNamed: #EnvironmentRequest) + ifNil: [aClass environment] + ifNotNil: [:erc| erc signal ifNil: [aClass environment]]. + ^self + name: t + inEnvironment: env + subclassOf: aClass + type: #immediate + instanceVariableNames: f + classVariableNames: d + poolDictionaries: s + category: cat! Item was changed: ----- Method: ClassBuilder>>update:to: (in category 'class mutation') ----- update: oldClass to: newClass + "Convert oldClass, all its instances and possibly its meta class into newClass, + instances of newClass and possibly its meta class. The process is surprisingly + simple in its implementation and surprisingly complex in its nuances and potentially + bad side effects. + We can rely on two assumptions (which are critical): + #1: The method #updateInstancesFrom: will not create any lasting pointers to + 'old' instances ('old' is quote on quote since #updateInstancesFrom: will do + a become of the old vs. the new instances and therefore it will not create + pointers to *new* instances before the #become: which are *old* afterwards) + #2: The non-preemptive execution of the critical piece of code guarantees that + nobody can get a hold by 'other means' (such as process interruption and + reflection) on the old instances. + Given the above two, we know that after #updateInstancesFrom: there are no pointers + to any old instances. After the forwarding become there will be no pointers to the old + class or meta class either. + Andreas Raab, 2/27/2003 23:42" - "Convert oldClass, all its instances and possibly its meta class into newClass, instances of newClass and possibly its meta class. The process is surprisingly simple in its implementation and surprisingly complex in its nuances and potentially bad side effects. - We can rely on two assumptions (which are critical): - #1: The method #updateInstancesFrom: will not create any lasting pointers to 'old' instances ('old' is quote on quote since #updateInstancesFrom: will do a become of the old vs. the new instances and therefore it will not create pointers to *new* instances before the #become: which are *old* afterwards) - #2: The non-preemptive execution of the critical piece of code guarantees that nobody can get a hold by 'other means' (such as process interruption and reflection) on the old instances. - Given the above two, we know that after #updateInstancesFrom: there are no pointer to any old instances. After the forwarding become there will be no pointers to the old class or meta class either. Meaning that if we throw in a nice fat GC at the end of the critical block, everything will be gone (but see the comment right there). There's no need to worry. - " | meta | meta := oldClass isMeta. "Note: Everything from here on will run without the ability to get interrupted to prevent any other process to create new instances of the old class." + ["Note: The following removal may look somewhat obscure and needs an explanation. + When we mutate the class hierarchy we create new classes for any existing subclass. + So it may look as if we don't have to remove the old class from its superclass. However, + at the top of the hierarchy (the first class we reshape) that superclass itself is not newly + created so therefore it will hold both the oldClass and newClass in its (obsolete or not) + subclasses. Since the #become: below will transparently replace the pointers to oldClass + with newClass the superclass would have newClass in its subclasses TWICE. With rather + unclear effects if we consider that we may convert the meta-class hierarchy itself (which + is derived from the non-meta class hierarchy). + Due to this problem ALL classes are removed from their superclass just prior to converting + them. Here, breaking the superclass/subclass invariant really doesn't matter since we will + effectively remove the oldClass (becomeForward:) just a few lines below." - [ - "Note: The following removal may look somewhat obscure and needs an explanation. When we mutate the class hierarchy we create new classes for any existing subclass. So it may look as if we don't have to remove the old class from its superclass. However, at the top of the hierarchy (the first class we reshape) that superclass itself is not newly created so therefore it will hold both the oldClass and newClass in its (obsolete or not) subclasses. Since the #become: below will transparently replace the pointers to oldClass with newClass the superclass would have newClass in its subclasses TWICE. With rather unclear effects if we consider that we may convert the meta-class hierarchy itself (which is derived from the non-meta class hierarchy). - Due to this problem ALL classes are removed from their superclass just prior to converting them. Here, breaking the superclass/subclass invariant really doesn't matter since we will effectively remove the oldClass (become+GC) just a few lines below." oldClass superclass removeSubclass: oldClass. oldClass superclass removeObsoleteSubclass: oldClass. "make sure that the VM cache is clean" oldClass methodDict do: [:cm | cm flushCache]. "Convert the instances of oldClass into instances of newClass" newClass updateInstancesFrom: oldClass. meta ifTrue: [oldClass becomeForward: newClass. oldClass updateMethodBindingsTo: oldClass binding] ifFalse: [{oldClass. oldClass class} elementsForwardIdentityTo: {newClass. newClass class}. oldClass updateMethodBindingsTo: oldClass binding. oldClass class updateMethodBindingsTo: oldClass class binding]. + "eem 5/31/2014 07:22 At this point there used to be a garbage collect whose purpose was + to ensure no old instances existed after the becomeForward:. Without the GC it was possible + to resurrect old instances using e.g. allInstancesDo:. This was because the becomeForward: + updated references from the old objects to new objects but didn't destroy the old objects. + But as of late 2013/early 2014 becomeForward: has been modified to free all the old objects."] + valueUnpreemptively! - Smalltalk garbageCollect. - - "Warning: Read this before you even think about removing the GC. Yes, it slows us down. Quite heavily if you have a large image. However, there's no good and simple alternative here, since unfortunately, #become: does change class pointers. What happens is that after the above become all of the instances of the old class will have a class pointer identifying them as instances of newClass. If we get our hands on any of these instances we will break immediately since their expected instance layout (that of its class, e.g., newClass) will not match their actual instance layout (that of oldClass). And getting your hands on any of those instances is really simple - just reshaping one class two times in rapid succession will do it. Reflection techniques, interrupts, etc. will only add to this problem. In the case of Metaclass things get even worse since when we recompile the entire class hierarchy we will recompile both, Metaclass and its instances (and some of its instances will have the old and some the new layout). - - The only easy solution to this problem would be to 'fix up' the class pointers of the old instances to point to the old class (using primitiveChangeClassTo:). But this won't work either - as we do a one-way become we would have to search the entire object memory for the oldClass and couldn't even clearly identify it unless we give it some 'special token' which sounds quite error-prone. If you really need to get rid of the GC here are some alternatives: - - On the image level, one could create a copy of the oldClass before becoming it into the new class and, after becoming it, 'fix up' the old instances. That would certainly work but it sounds quite complex, as we need to make sure we're not breaking any of the superclass/subclass meta/non-meta class variants. - - Alternatively, fix up #becomeForward on the VM-level to 'dump the source objects' of #become. This would be quite doable (just 'convert' them into a well known special class such as bitmap) yet it has problems if (accidentally or not) one of the objects in #become: appears on 'both sides of the fence' (right now, this will work ... in a way ... even though the consequences are unclear). - - Another alternative is to provide a dedicated primitive for this (instead of using it implicitly in become) which would allow us to dump all the existing instances right here. This is equivalent to a more general primitiveChangeClassTo: and might be worthwhile but it would likely have to keep in mind the differences between bits and pointer thingies etc. - - Since all of the alternatives seem rather complex and magical compared to a straight-forward GC it seems best to stick with the GC solution for now. If someone has a real need to fix this problem, that person will likely be motivated enough to check out the alternatives. Personally I'd probably go for #1 (copy the old class and remap the instances to it) since it's a solution that could be easily reverted from within the image if there's any problem with it." - - ] valueUnpreemptively. - ! Item was changed: ByteArray variableByteSubclass: #CompiledMethod instanceVariableNames: '' classVariableNames: 'LargeFrame PrimaryBytecodeSetEncoderClass SecondaryBytecodeSetEncoderClass SmallFrame' poolDictionaries: '' category: 'Kernel-Methods'! + !CompiledMethod commentStamp: 'eem 8/12/2014 14:45' prior: 0! + CompiledMethod instances are methods suitable for interpretation by the virtual machine. Instances of CompiledMethod and its subclasses are the only objects in the system that have both indexable pointer fields and indexable 8-bit integer fields. The first part of a CompiledMethod is pointers, the second part is bytes. CompiledMethod inherits from ByteArray to avoid duplicating some of ByteArray's methods, not because a CompiledMethod is-a ByteArray. - !CompiledMethod commentStamp: 'eem 5/12/2014 18:02' prior: 0! - My instances are methods suitable for interpretation by the virtual machine. This is the only class in the system whose instances have both indexable pointer fields and indexable 8-bit integer fields. The first part of a CompiledMethod is pointers, the second part is bytes. I'm a subclass of ByteArray to avoid duplicating some of ByteArray's methods, not because a CompiledMethod is-a ByteArray. Class variables: SmallFrame - the number of stack slots in a small frame Context LargeFrame - the number of stack slots in a large frame Context PrimaryBytecodeSetEncoderClass - the encoder class that defines the primary instruction set SecondaryBytecodeSetEncoderClass - the encoder class that defines the secondary instruction set The current format of a CompiledMethod is as follows: header (4 or 8 bytes, SmallInteger) + literals (4 or 8 bytes each, Object, see "The last literal..." below) - literals (4 or 8 bytes each, Object) bytecodes (variable, bytes) trailer (variable, bytes) + The header is a 31-bit signed integer (a SmallInteger) in the following format: - The header is a 31-bit signed integer (a SmallInteger) with one of the two following formats, selected by the sign bit: - sign bit 0, header >= 0: - (index 0) 9 bits: main part of primitive number (#primitive) - (index 9) 8 bits: number of literals (#numLiterals) - (index 17) 1 bit: whether a large frame size is needed (#frameSize) - (index 18) 6 bits: number of temporary variables (#numTemps) - (index 24) 4 bits: number of arguments to the method (#numArgs) - (index 28) 1 bit: high-bit of primitive number (#primitive) - (index 29) 1 bit: flag bit, ignored by the VM (#flag) - (index 30/63) sign bit: 0 selects the Primary instruction set (#signFlag) - sign bit 1, header < 0: (index 0) 16 bits: number of literals (#numLiterals) (index 16) 1 bit: has primitive + (index 17) 1 bit: whether a large frame size is needed (#frameSize => either SmallFrame or LargeFrame) - (index 17) 1 bit: whether a large frame size is needed (#frameSize) (index 18) 6 bits: number of temporary variables (#numTemps) (index 24) 4 bits: number of arguments to the method (#numArgs) + (index 28) 2 bits: reserved for an access modifier (00-unused, 01-private, 10-protected, 11-public), although accessors for bit 29 exist (see #flag). + (index 30/63) sign bit: 1 selects the Secondary instruction set (e.g. NewsqueakV4, 0 selects the primary instruction set, e.g. SqueakV3PlusClosures) (#signFlag) - (index 28) 2 bits: reserved for an access modifier (00-unused, 01-private, 10-protected, 11-public) - (index 30/63) sign bit: 1 selects the Secondary instruction set (e.g. NewsqueakV4) (#signFlag) - i.e. the Secondary Bytecode Set expands the number of literals to 65535 by assuming a CallPrimitive bytecode. + If the method has a primitive then the first bytecode of the method must be a callPrimitive: bytecode that encodes the primitive index. + + The trailer is an encoding of an instance of CompiledMethodTrailer. It is typically used to encode the index into the source files array of the method's source, but may be used to encode other values, e.g. tempNames, source as a string, etc. See the class CompiledMethodTrailer. + + The last literal in a CompiledMethod must be its methodClassAssociation, a binding whose value is the class the method is installed in. The methodClassAssociation is used to implement super sends. If a method contains no super send then its methodClassAssociation may be left nil (as would be the case for example of methods providing a pool of inst var accessors). By convention the penultimate literal of a method is either its selector or an instance of AdditionalMethodState. AdditionalMethodState holds any pragmas and properties of a method, but may also be used to add instance variables to a method, albeit ones held in the method's AdditionalMethodState. Subclasses of CompiledMethod that want to add state should subclass AdditionalMethodState to add the state they want, and implement methodPropertiesClass on the class side of the CompiledMethod subclass to answer the specialized subclass of AdditionalMethodState.! - The trailer is an encoding of an instance of CompiledMethodTrailer. It is typically used to encode the index into the source files array of the method's source, but may be used to encode other values, e.g. tempNames, source as a string, etc. See the class CompiledMethodTrailer.! Item was added: + ----- Method: CompiledMethod class>>handleFailingFailingNewMethod:header: (in category 'private') ----- + handleFailingFailingNewMethod: numberOfBytes header: headerWord + "This newMethod:header: gets sent after handleFailingBasicNew: has done a full + garbage collection and possibly grown memory. If this basicNew: fails then the + system really is low on space, so raise the OutOfMemory signal. + + Primitive. Answer an instance of this class with the number of indexable variables + specified by the argument, headerWord, and the number of bytecodes specified + by numberOfBytes. Fail if this if the arguments are not Integers, or if numberOfBytes + is negative, or if the receiver is not a CompiledMethod class, or if there is not enough + memory available. Essential. See Object documentation whatIsAPrimitive." + + <primitive: 79> + "space must be low." + OutOfMemory signal. + "retry if user proceeds" + ^self newMethod: numberOfBytes header: headerWord! Item was added: + ----- Method: CompiledMethod class>>handleFailingNewMethod:header: (in category 'private') ----- + handleFailingNewMethod: numberOfBytes header: headerWord + "This newMethod:header: gets sent after newMethod:header: has failed + and allowed a scavenging garbage collection to occur. The scavenging + collection will have happened as the VM is activating the (failing) basicNew:. + If handleFailingBasicNew: fails then the scavenge failed to reclaim sufficient + space and a global garbage collection is required. Retry after garbage + collecting and growing memory if necessary. + + Primitive. Answer an instance of this class with the number of indexable variables + specified by the argument, headerWord, and the number of bytecodes specified + by numberOfBytes. Fail if this if the arguments are not Integers, or if numberOfBytes + is negative, or if the receiver is not a CompiledMethod class, or if there is not enough + memory available. Essential. See Object documentation whatIsAPrimitive." + + <primitive: 79> + | bytesRequested | + bytesRequested := (headerWord bitAnd: 16rFFFF) + 1 * Smalltalk wordSize + numberOfBytes + 16. + Smalltalk garbageCollect < bytesRequested ifTrue: + [Smalltalk growMemoryByAtLeast: bytesRequested]. + "retry after global garbage collect and possible grow" + ^self handleFailingFailingNewMethod: numberOfBytes header: headerWord! Item was added: + ----- Method: CompiledMethod class>>installPrimaryBytecodeSet: (in category 'class initialization') ----- + installPrimaryBytecodeSet: aBytecodeEncoderSubclass + PrimaryBytecodeSetEncoderClass == aBytecodeEncoderSubclass ifTrue: + [^self]. + (aBytecodeEncoderSubclass inheritsFrom: BytecodeEncoder) ifFalse: + [self error: 'A bytecode set encoder is expected to be a subclass of BytecodeEncoder']. + (self allSubInstances + detect: [:m| m header >= 0 and: [m encoderClass ~~ aBytecodeEncoderSubclass]] + ifNone: []) ifNotNil: + [Warning signal: 'There are existing CompiledMethods with a different encoderClass.']. + PrimaryBytecodeSetEncoderClass := aBytecodeEncoderSubclass! Item was added: + ----- Method: CompiledMethod class>>installSecondaryBytecodeSet: (in category 'class initialization') ----- + installSecondaryBytecodeSet: aBytecodeEncoderSubclass + PrimaryBytecodeSetEncoderClass == aBytecodeEncoderSubclass ifTrue: + [^self]. + (aBytecodeEncoderSubclass inheritsFrom: BytecodeEncoder) ifFalse: + [self error: 'A bytecode set encoder is expected to be a subclass of BytecodeEncoder']. + (self allSubInstances + detect: [:m| m header < 0 and: [m encoderClass ~~ aBytecodeEncoderSubclass]] + ifNone: []) ifNotNil: + [Warning signal: 'There are existing CompiledMethods with a different encoderClass.']. + SecondaryBytecodeSetEncoderClass := aBytecodeEncoderSubclass! Item was changed: ----- Method: CompiledMethod class>>newBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive: (in category 'instance creation') ----- newBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex "Answer an instance of me. The header is specified by the message arguments. The remaining parts are not as yet determined." + | method pc | + nArgs > 15 ifTrue: + [^self error: 'Cannot compile -- too many arguments']. - | largeBit primBits | nTemps > 63 ifTrue: + [^self error: 'Cannot compile -- too many temporary variables']. + nLits > 65535 ifTrue: + [^self error: 'Cannot compile -- too many literals']. - [^ self error: 'Cannot compile -- too many temporary variables']. - nLits > 255 ifTrue: - [^ self error: 'Cannot compile -- too many literals']. - largeBit := (nTemps + stackSize) > SmallFrame ifTrue: [1] ifFalse: [0]. - primBits := primitiveIndex <= 16r1FF - ifTrue: [primitiveIndex] - ifFalse: ["For now the high bit of primitive no. is in the 29th bit of header" - primitiveIndex > 16r3FF ifTrue: [self error: 'prim num too large']. - (primitiveIndex bitAnd: 16r1FF) + ((primitiveIndex bitAnd: 16r200) bitShift: 19)]. + method := trailer + createMethod: numberOfBytes + class: self + header: (nArgs bitShift: 24) + + (nTemps bitShift: 18) + + ((nTemps + stackSize) > SmallFrame ifTrue: [1 bitShift: 17] ifFalse: [0]) + + nLits + + (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0]). + primitiveIndex > 0 ifTrue: + [pc := method initialPC. + method + at: pc + 0 put: method encoderClass callPrimitiveCode; + at: pc + 1 put: (primitiveIndex bitAnd: 16rFF); + at: pc + 2 put: (primitiveIndex bitShift: -8)]. + ^method! - ^trailer - createMethod: numberOfBytes - class: self - header: (nArgs bitShift: 24) + - (nTemps bitShift: 18) + - (largeBit bitShift: 17) + - (nLits bitShift: 9) + - primBits! Item was changed: ----- Method: CompiledMethod class>>newBytes:trailerBytes:nArgs:nTemps:nStack:nLits:primitive:flag: (in category 'instance creation') ----- newBytes: numberOfBytes trailerBytes: trailer nArgs: nArgs nTemps: nTemps nStack: stackSize nLits: nLits primitive: primitiveIndex flag: flag "Answer an instance of me. The header is specified by the message arguments. The remaining parts are not as yet determined." + | method pc | + nArgs > 15 ifTrue: + [^self error: 'Cannot compile -- too many arguments']. - | largeBit primBits flagBit | nTemps > 63 ifTrue: + [^self error: 'Cannot compile -- too many temporary variables']. + nLits > 65535 ifTrue: + [^self error: 'Cannot compile -- too many literals']. - [^ self error: 'Cannot compile -- too many temporary variables']. - nLits > 255 ifTrue: - [^ self error: 'Cannot compile -- too many literals']. - largeBit := (nTemps + stackSize) > SmallFrame ifTrue: [1] ifFalse: [0]. + method := trailer + createMethod: numberOfBytes + class: self + header: (nArgs bitShift: 24) + + (nTemps bitShift: 18) + + ((nTemps + stackSize) > SmallFrame ifTrue: [1 bitShift: 17] ifFalse: [0]) + + nLits + + (primitiveIndex > 0 ifTrue: [1 bitShift: 16] ifFalse: [0]) + + (flag ifTrue: [1 bitShift: 29] ifFalse: [0]). + primitiveIndex > 0 ifTrue: + [pc := method initialPC. + method + at: pc + 0 put: method encoderClass callPrimitiveCode; + at: pc + 1 put: (primitiveIndex bitAnd: 16rFF); + at: pc + 2 put: (primitiveIndex bitShift: -8)]. + ^method! - "For now the high bit of the primitive no. is in a high bit of the header" - primBits := (primitiveIndex bitAnd: 16r1FF) + ((primitiveIndex bitAnd: 16r200) bitShift: 19). - - flagBit := flag ifTrue: [ 1 ] ifFalse: [ 0 ]. - - ^trailer - createMethod: numberOfBytes - class: self - header: (nArgs bitShift: 24) + - (nTemps bitShift: 18) + - (largeBit bitShift: 17) + - (nLits bitShift: 9) + - primBits + - (flagBit bitShift: 29)! Item was changed: ----- Method: CompiledMethod class>>newMethod:header: (in category 'instance creation') ----- + newMethod: numberOfBytes header: headerWord - newMethod: numberOfBytes header: headerWord "Primitive. Answer an instance of me. The number of literals (and other + information) is specified by the headerWord (see my class comment). + The first argument specifies the number of fields for bytecodes in the + method. Fail if either argument is not a SmallInteger, or if numberOfBytes + is negative, or if memory is low. Once the header of a method is set by + this primitive, it cannot be changed to change the number of literals. + Essential. See Object documentation whatIsAPrimitive." - information) is specified the headerWord. The first argument specifies - the number of fields for bytecodes in the method. Fail if either - argument is not a SmallInteger, or if numberOfBytes is negative. Once - the header of a method is set by this primitive, it cannot be changed in - any way. Essential. See Object documentation whatIsAPrimitive." + <primitive: 79 error: ec> + ec == #'insufficient object memory' ifTrue: + [^self handleFailingNewMethod: numberOfBytes header: headerWord]. - <primitive: 79> - (numberOfBytes isInteger and: - [headerWord isInteger and: - [numberOfBytes >= 0]]) ifTrue: [ - "args okay; space must be low" - OutOfMemory signal. - "retry if user proceeds" - ^ self newMethod: numberOfBytes header: headerWord - ]. ^self primitiveFailed! Item was changed: ----- Method: CompiledMethod class>>toReturnConstant:trailerBytes: (in category 'instance creation') ----- toReturnConstant: index trailerBytes: trailer "Answer an instance of me that is a quick return of the constant indexed in (true false nil -1 0 1 2)." + ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256 + index! - ^ self newBytes: 0 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256 + index - ! Item was changed: ----- Method: CompiledMethod class>>toReturnField:trailerBytes: (in category 'instance creation') ----- toReturnField: field trailerBytes: trailer "Answer an instance of me that is a quick return of the instance variable indexed by the argument, field." + ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 264 + field! - ^ self newBytes: 0 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 264 + field - ! Item was changed: ----- Method: CompiledMethod class>>toReturnSelfTrailerBytes: (in category 'instance creation') ----- toReturnSelfTrailerBytes: trailer "Answer an instance of me that is a quick return of the instance (^self)." + ^self newBytes: 3 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256! - ^ self newBytes: 0 trailerBytes: trailer nArgs: 0 nTemps: 0 nStack: 0 nLits: 2 primitive: 256 - ! Item was added: + ----- Method: CompiledMethod>>bytecodeSetName (in category 'accessing') ----- + bytecodeSetName + ^self encoderClass name copyReplaceAll: 'EncoderFor' with: ''! Item was changed: ----- Method: CompiledMethod>>headerDescription (in category 'literals') ----- headerDescription + "Answer a description containing the information about the form of the + receiver and the form of the context needed to run the receiver." - "Answer a description containing the information about the form of the - receiver and the form of the context needed to run the receiver." + ^(ByteString new: 128) writeStream + print: self header; cr; + nextPutAll: '"primitive: '; print: self primitive; cr; + nextPutAll: ' numArgs: '; print: self numArgs; cr; + nextPutAll: ' numTemps: '; print: self numTemps; cr; + nextPutAll: ' numLiterals: '; print: self numLiterals; cr; + nextPutAll: ' frameSize: '; print: self frameSize; cr; + nextPutAll: ' bytecodeSet: '; nextPutAll: self bytecodeSetName; + nextPut: $"; cr; + contents! - | s | - s := '' writeStream. - self header printOn: s. - s cr; nextPutAll: '"primitive: '. - self primitive printOn: s. - s cr; nextPutAll: ' numArgs: '. - self numArgs printOn: s. - s cr; nextPutAll: ' numTemps: '. - self numTemps printOn: s. - s cr; nextPutAll: ' numLiterals: '. - self numLiterals printOn: s. - s cr; nextPutAll: ' frameSize: '. - self frameSize printOn: s. - s cr; nextPutAll: ' isClosureCompiled: '. - self isBlueBookCompiled not printOn: s. - s nextPut: $"; cr. - ^ s contents! Item was changed: ----- Method: CompiledMethod>>numLiterals (in category 'accessing') ----- numLiterals "Answer the number of literals used by the receiver." + ^self header bitAnd: 65535! - | header | - ^(header := self header) < 0 - ifTrue: [header bitAnd: 65535] - ifFalse: [(header bitShift: -9) bitAnd: 16rFF]! Item was changed: ----- Method: CompiledMethod>>primitive (in category 'accessing') ----- primitive "Answer the primitive index associated with the receiver. + Zero indicates that this is not a primitive method." + | initialPC | + ^(self header anyMask: 65536) "Is the hasPrimitive? flag set?" + ifTrue: [(self at: (initialPC := self initialPC) + 1) + ((self at: initialPC + 2) bitShift: 8)] + ifFalse: [0]! - Zero indicates that this is not a primitive method. - In the original header format we currently allow 10 bits of primitive index, but they are - in two places for backward compatibility. In the new format the primitive index is in the - last two bytes of a three byte callPrimitive: bytecode. The time to unpack is negligible, - since the derived primitive function pointer full index is stored in the method cache." - | header initialPC | - ^(header := self header) < 0 - ifTrue: - [(header anyMask: 65536) "Is the hasPrimitive? flag set?" - ifTrue: [(self at: (initialPC := self initialPC) + 1) + ((self at: initialPC + 2) bitShift: 8)] - ifFalse: [0]] - ifFalse: - [(header bitAnd: 16r1FF) + ((header bitShift: -19) bitAnd: 16r200)]! Item was changed: ----- Method: ContextPart>>activateReturn:value: (in category 'private') ----- activateReturn: aContext value: value "Activate 'aContext return: value' in place of self, so execution will return to aContext's sender" + ^MethodContext + sender: self - ^ self - activateMethod: ContextPart theReturnMethod - withArgs: {value} receiver: aContext + method: MethodContext theReturnMethod + arguments: {value}! - class: aContext class! Item was changed: ----- Method: ContextPart>>doPrimitive:method:receiver:args: (in category 'private') ----- doPrimitive: primitiveIndex method: meth receiver: receiver args: arguments + "Simulate a primitive method whose index is primitiveIndex. The simulated receiver and + arguments are given as arguments to this message. If successful, push result and return + resuming context, else ^ {errCode, PrimitiveFailToken}. Any primitive which provokes + execution needs to be intercepted and simulated to avoid execution running away." - "Simulate a primitive method whose index is primitiveIndex. The - simulated receiver and arguments are given as arguments to this message. - If successful, push result and return resuming context, else ^ PrimitiveFailToken. - Any primitive which provokes execution needs to be intercepted and simulated - to avoid execution running away." | value | "Judicious use of primitive 19 (a null primitive that doesn't do anything) prevents the debugger from entering various run-away activities such as spawning a new process, etc. Injudicious use results in the debugger not being able to debug + interesting code, such as the debugger itself. hence use primitive 19 with care :-)" - interesting code, such as the debugger itself. hence use primtiive 19 with care :-)" "SystemNavigation new browseAllSelect: [:m| m primitive = 19]" primitiveIndex = 19 ifTrue: [ToolSet debugContext: self label:'Code simulation error' contents: nil]. + ((primitiveIndex between: 201 and: 222) + and: [(self objectClass: receiver) includesBehavior: BlockClosure]) ifTrue: + [((primitiveIndex between: 201 and: 205) "BlockClosure>>value[:value:...]" + or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]" + [^receiver simulateValueWithArguments: arguments caller: self]. + primitiveIndex = 206 ifTrue: "BlockClosure>>valueWithArguments:" + [^receiver simulateValueWithArguments: arguments first caller: self]]. - "ContextPart>>blockCopy:; simulated to get startpc right" - (primitiveIndex = 80 and: [(self objectClass: receiver) includesBehavior: ContextPart]) - ifTrue: [^self push: ((BlockContext newForMethod: receiver method) - home: receiver home - startpc: pc + 2 - nargs: (arguments at: 1))]. - (primitiveIndex = 81 and: [(self objectClass: receiver) == BlockContext]) "BlockContext>>value[:value:...]" - ifTrue: [^receiver pushArgs: arguments from: self]. - (primitiveIndex = 82 and: [(self objectClass: receiver) == BlockContext]) "BlockContext>>valueWithArguments:" - ifTrue: [^receiver pushArgs: arguments first from: self]. - primitiveIndex = 83 "afr 9/11/1998 19:50" "Object>>perform:[with:...]" - ifTrue: [^self send: arguments first - to: receiver - with: arguments allButFirst - super: false]. - primitiveIndex = 84 "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" - ifTrue: [^self send: arguments first - to: receiver - with: (arguments at: 2) - startClass: nil]. - primitiveIndex = 100 "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" - ifTrue: [^self send: arguments first - to: receiver - with: (arguments at: 2) - startClass: (arguments at: 3)]. + primitiveIndex = 83 ifTrue: "afr 9/11/1998 19:50" "Object>>perform:[with:...]" + [^self send: arguments first to: receiver with: arguments allButFirst super: false]. + primitiveIndex = 84 ifTrue: "afr 9/11/1998 19:50 & eem 8/18/2009 17:04" "Object>>perform:withArguments:" + [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (self objectClass: receiver)]. + primitiveIndex = 100 ifTrue: "eem 8/18/2009 16:57" "Object>>perform:withArguments:inSuperclass:" + [^self send: arguments first to: receiver with: (arguments at: 2) lookupIn: (arguments at: 3)]. + "Mutex>>primitiveEnterCriticalSection Mutex>>primitiveTestAndSetOwnershipOfCriticalSection" (primitiveIndex = 186 or: [primitiveIndex = 187]) ifTrue: [| active effective | active := Processor activeProcess. effective := active effectiveProcess. "active == effective" value := primitiveIndex = 186 ifTrue: [receiver primitiveEnterCriticalSectionOnBehalfOf: effective] ifFalse: [receiver primitiveTestAndSetOwnershipOfCriticalSectionOnBehalfOf: effective]. + ^(self isPrimFailToken: value) - ^((self objectClass: value) == Array - and: [value size = 2 - and: [value first == PrimitiveFailToken]]) ifTrue: [value] ifFalse: [self push: value]]. + primitiveIndex = 188 ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:" - ((primitiveIndex = 188 or: [primitiveIndex = 189]) "eem 10/6/2014 16:14 Object>>with:*executeMethod:" - and: [arguments last isQuick not]) ifTrue: "eem 5/27/2008 11:10 Object>>withArgs:executeMethod:" [^MethodContext sender: self receiver: receiver + method: (arguments at: 2) + arguments: (arguments at: 1)]. - method: arguments last - arguments: (primitiveIndex = 188 - ifTrue: [arguments at: 1] - ifFalse: [arguments allButLast])]. "Closure primitives" (primitiveIndex = 200 and: [self == receiver]) ifTrue: "ContextPart>>closureCopy:copiedValues:; simulated to get startpc right" [^self push: (BlockClosure outerContext: receiver startpc: pc + 2 numArgs: arguments first copiedValues: arguments last)]. - ((primitiveIndex between: 201 and: 205) "BlockClosure>>value[:value:...]" - or: [primitiveIndex between: 221 and: 222]) ifTrue: "BlockClosure>>valueNoContextSwitch[:]" - [^receiver simulateValueWithArguments: arguments caller: self]. - primitiveIndex = 206 ifTrue: "BlockClosure>>valueWithArguments:" - [^receiver simulateValueWithArguments: arguments first caller: self]. primitiveIndex = 118 ifTrue: "tryPrimitive:withArgs:; avoid recursing in the VM" [(arguments size = 2 and: [arguments first isInteger and: [(self objectClass: arguments last) == Array]]) ifFalse: [^ContextPart primitiveFailTokenFor: nil]. ^self doPrimitive: arguments first method: meth receiver: receiver args: arguments last]. value := primitiveIndex = 120 "FFI method" ifTrue: [(meth literalAt: 1) tryInvokeWithArguments: arguments] ifFalse: [primitiveIndex = 117 "named primitives" ifTrue: [self tryNamedPrimitiveIn: meth for: receiver withArgs: arguments] + ifFalse: [receiver tryPrimitive: primitiveIndex withArgs: arguments]]. + + ^(self isPrimFailToken: value) - ifFalse: - [receiver tryPrimitive: primitiveIndex withArgs: arguments]]. - ^((self objectClass: value) == Array - and: [value size = 2 - and: [value first == PrimitiveFailToken]]) ifTrue: [value] ifFalse: [self push: value]! Item was added: + ----- Method: ContextPart>>isPrimFailToken: (in category 'private') ----- + isPrimFailToken: anObject + ^(self objectClass: anObject) == Array + and: [anObject size = 2 + and: [anObject first == PrimitiveFailToken]]! Item was added: + ----- Method: ContextPart>>send:to:with:lookupIn: (in category 'controlling') ----- + send: selector to: rcvr with: arguments lookupIn: lookupClass + "Simulate the action of sending a message with selector and arguments + to rcvr. The argument, lookupClass, is the class in which to lookup the + message. This is the receiver's class for normal messages, but for super + messages it will be some specific class related to the source method." + + | meth primIndex val ctxt | + (meth := lookupClass lookupSelector: selector) ifNil: + [^self send: #doesNotUnderstand: + to: rcvr + with: {Message selector: selector arguments: arguments} + lookupIn: lookupClass]. + (primIndex := meth primitive) > 0 ifTrue: + [val := self doPrimitive: primIndex method: meth receiver: rcvr args: arguments. + (self isPrimFailToken: val) ifFalse: + [^val]]. + (selector == #doesNotUnderstand: and: [lookupClass == ProtoObject]) ifTrue: + [^self error: 'Simulated message ', arguments first selector, ' not understood']. + ctxt := MethodContext sender: self receiver: rcvr method: meth arguments: arguments. + primIndex > 0 ifTrue: + [ctxt failPrimitiveWith: val]. + ^ctxt! Item was changed: ----- Method: ContextPart>>send:to:with:super: (in category 'controlling') ----- + send: selector to: rcvr with: arguments super: superFlag + "Simulate the action of sending a message with selector arguments + to rcvr. The argument, superFlag, tells whether the receiver of the + message was specified with 'super' in the source method." - send: selector to: rcvr with: args super: superFlag - "Simulate the action of sending a message with selector, selector, and - arguments, args, to receiver. The argument, superFlag, tells whether the - receiver of the message was specified with 'super' in the source method." + ^self send: selector + to: rcvr + with: arguments + lookupIn: (superFlag + ifTrue: [self method methodClassAssociation value superclass] + ifFalse: [self objectClass: rcvr])! - | class meth val ctxt | - class := superFlag - ifTrue: [self method methodClassAssociation value superclass] - ifFalse: [self objectClass: rcvr]. - meth := class lookupSelector: selector. - meth == nil ifTrue: - [^self - send: #doesNotUnderstand: - to: rcvr - with: (Array with: (Message selector: selector arguments: args)) - super: superFlag]. - val := self tryPrimitiveFor: meth receiver: rcvr args: args. - ((self objectClass: val) == Array - and: [val size = 2 - and: [val first == PrimitiveFailToken]]) ifFalse: - [^val]. - (selector == #doesNotUnderstand: - and: [class == ProtoObject]) ifTrue: - [^self error: 'Simulated message ' , (args at: 1) selector, ' not understood']. - ctxt := self activateMethod: meth withArgs: args receiver: rcvr class: class. - ((self objectClass: val) == Array - and: [val size = 2 - and: [val first == PrimitiveFailToken - and: [val last notNil - and: [(ctxt method at: ctxt pc) = 129 "long store temp"]]]]) ifTrue: - [ctxt at: ctxt stackPtr put: val last]. - ^ctxt! Item was changed: ----- Method: ContextPart>>tryNamedPrimitiveIn:for:withArgs: (in category 'private') ----- tryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments + "Invoke the named primitive for aCompiledMethod, answering its result, or, + if the primiitve fails, answering the error code." - | selector theMethod spec receiverClass | <primitive: 218 error: ec> ec ifNotNil: ["If ec is an integer other than -1 there was a problem with primitive 218, not with the external primitive itself. -1 indicates a generic failure (where ec should be nil) but ec = nil means primitive 218 is not implemented. So interpret -1 to mean the external primitive failed with a nil error code." ec isInteger ifTrue: [ec = -1 ifTrue: [ec := nil] + ifFalse: [self primitiveFailed]]]. + ^self class primitiveFailTokenFor: ec! - ifFalse: [self primitiveFailed]]. - ^{PrimitiveFailToken. ec}]. - "Assume a nil error code implies the primitive is not implemented and fall back on the old code." - "Hack. Attempt to execute the named primitive from the given compiled method" - arguments size > 8 ifTrue: - [^{PrimitiveFailToken. nil}]. - selector := #( - tryNamedPrimitive - tryNamedPrimitive: - tryNamedPrimitive:with: - tryNamedPrimitive:with:with: - tryNamedPrimitive:with:with:with: - tryNamedPrimitive:with:with:with:with: - tryNamedPrimitive:with:with:with:with:with: - tryNamedPrimitive:with:with:with:with:with:with: - tryNamedPrimitive:with:with:with:with:with:with:with:) at: arguments size+1. - receiverClass := self objectClass: aReceiver. - theMethod := receiverClass lookupSelector: selector. - theMethod == nil ifTrue: - [^{PrimitiveFailToken. nil}]. - spec := theMethod literalAt: 1. - spec replaceFrom: 1 to: spec size with: (aCompiledMethod literalAt: 1) startingAt: 1. - Smalltalk unbindExternalPrimitives. - ^self object: aReceiver perform: selector withArguments: arguments inClass: receiverClass! Item was changed: + Number subclass: #Float - Number variableWordSubclass: #Float instanceVariableNames: '' classVariableNames: 'E Epsilon Halfpi Infinity Ln10 Ln2 MaxVal MaxValLn MinValLogBase2 NaN NegativeInfinity NegativeZero Pi RadiansPerDegree Sqrt2 ThreePi Twopi' poolDictionaries: '' category: 'Kernel-Numbers'! !Float commentStamp: '<historical>' prior: 0! My instances represent IEEE-754 floating-point double-precision numbers. They have about 16 digits of accuracy and their range is between plus and minus 10^307. Some valid examples are: 8.0 13.3 0.3 2.5e6 1.27e-30 1.27e-31 -12.987654e12 Mainly: no embedded blanks, little e for tens power, and a digit on both sides of the decimal point. It is actually possible to specify a radix for Squeak Float constants. This is great for teaching about numbers, but may be confusing to the average reader: 3r20.2 --> 6.66666666666667 8r20.2 --> 16.25 If you don't have access to the definition of IEEE-754, you can figure out what is going on by printing various simple values in Float hex. It may help you to know that the basic format is... sign 1 bit exponent 11 bits with bias of 1023 (16r3FF) to produce an exponent in the range -1023 .. +1024 - 16r000: significand = 0: Float zero significand ~= 0: Denormalized number (exp = -1024, no hidden '1' bit) - 16r7FF: significand = 0: Infinity significand ~= 0: Not A Number (NaN) representation mantissa 53 bits, but only 52 are stored (20 in the first word, 32 in the second). This is because a normalized mantissa, by definition, has a 1 to the right of its floating point, and IEEE-754 omits this redundant bit to gain an extra bit of precision instead. People talk about the mantissa without its leading one as the FRACTION, and with its leading 1 as the SIGNFICAND. The single-precision format is... sign 1 bit exponent 8 bits, with bias of 127, to represent -126 to +127 - 0x0 and 0xFF reserved for Float zero (mantissa is ignored) - 16r7F reserved for Float underflow/overflow (mantissa is ignored) mantissa 24 bits, but only 23 are stored This format is used in FloatArray (qv), and much can be learned from the conversion routines, Float asIEEE32BitWord, and Float class fromIEEE32Bit:. Thanks to Rich Harmon for asking many questions and to Tim Olson, Bruce Cohen, Rick Zaccone and others for the answers that I have collected here.! Item was changed: ----- Method: Float class>>basicNew (in category 'instance creation') ----- basicNew + ^BoxedFloat64 basicNew: 2! - ^self basicNew: 2! Item was changed: ----- Method: Float class>>basicNew: (in category 'instance creation') ----- basicNew: anInteger + ^BoxedFloat64 basicNew: 2! - anInteger = 2 ifFalse: [^self error: 'a Float shall always have two slots']. - ^super basicNew: 2! Item was changed: ----- Method: Float class>>fromIEEE32Bit: (in category 'instance creation') ----- fromIEEE32Bit: word + "Convert the given 32 bit word (which is supposed to be a positive 32-bit value) from + a 32 bit IEEE floating point representation into an actual Squeak float object (being + 64 bits wide). Should only be used for conversion in FloatArrays or likewise objects." - "Convert the given 32 bit word (which is supposed to be a positive 32bit value) from a 32bit IEEE floating point representation into an actual Squeak float object (being 64bit wide). Should only be used for conversion in FloatArrays or likewise objects." + | sign mantissa exponent delta | + word <= 0 ifTrue: + [^word negative + ifTrue: [self error: 'Cannot deal with negative numbers'] + ifFalse: [self zero]]. - | sign mantissa exponent newFloat delta | - word negative ifTrue: [^ self error:'Cannot deal with negative numbers']. - word = 0 ifTrue: [^ Float zero]. sign := word bitAnd: 16r80000000. + word = sign ifTrue: + [^self negativeZero]. - word = sign ifTrue: [^self negativeZero]. exponent := ((word bitShift: -23) bitAnd: 16rFF) - 127. mantissa := word bitAnd: 16r7FFFFF. + exponent = 128 ifTrue: "Either NAN or INF" + [^mantissa = 0 + ifTrue: + [sign = 0 + ifTrue: [self infinity] + ifFalse: [self negativeInfinity]] + ifFalse: [self nan]]. - exponent = 128 ifTrue:["Either NAN or INF" - mantissa = 0 ifFalse:[^ Float nan]. - sign = 0 - ifTrue:[^ Float infinity] - ifFalse:[^ Float negativeInfinity]]. + exponent = -127 ifTrue: - exponent = -127 ifTrue: [ "gradual underflow (denormalized number) + Remove first bit of mantissa and adjust exponent" + [delta := mantissa highBit. + mantissa := (mantissa bitShift: 1) bitAnd: (1 bitShift: delta) - 1. + exponent := exponent + delta - 23]. - Remove first bit of mantissa and adjust exponent" - delta := mantissa highBit. - mantissa := (mantissa bitShift: 1) bitAnd: (1 bitShift: delta) - 1. - exponent := exponent + delta - 23]. "Create new float" + ^(self basicNew: 2) + basicAt: 1 put: ((sign bitOr: (1023 + exponent bitShift: 20)) bitOr: (mantissa bitShift: -3)); + basicAt: 2 put: ((mantissa bitAnd: 7) bitShift: 29); + * 1.0 "reduce to SmallFloat64 if possible"! - newFloat := self new: 2. - newFloat basicAt: 1 put: ((sign bitOr: (1023 + exponent bitShift: 20)) bitOr: (mantissa bitShift: -3)). - newFloat basicAt: 2 put: ((mantissa bitAnd: 7) bitShift: 29). - ^newFloat! Item was removed: - ----- Method: Float>>* (in category 'arithmetic') ----- - * aNumber - "Primitive. Answer the result of multiplying the receiver by aNumber. - Fail if the argument is not a Float. Essential. See Object documentation - whatIsAPrimitive." - - <primitive: 49> - ^ aNumber adaptToFloat: self andSend: #*! Item was removed: - ----- Method: Float>>+ (in category 'arithmetic') ----- - + aNumber - "Primitive. Answer the sum of the receiver and aNumber. Essential. - Fail if the argument is not a Float. See Object documentation - whatIsAPrimitive." - - <primitive: 41> - ^ aNumber adaptToFloat: self andSend: #+! Item was removed: - ----- Method: Float>>- (in category 'arithmetic') ----- - - aNumber - "Primitive. Answer the difference between the receiver and aNumber. - Fail if the argument is not a Float. Essential. See Object documentation - whatIsAPrimitive." - - <primitive: 42> - ^ aNumber adaptToFloat: self andSend: #-! Item was removed: - ----- Method: Float>>/ (in category 'arithmetic') ----- - / aNumber - "Primitive. Answer the result of dividing receiver by aNumber. - Fail if the argument is not a Float. Essential. See Object documentation - whatIsAPrimitive." - - <primitive: 50> - aNumber isZero ifTrue: [^(ZeroDivide dividend: self) signal]. - ^ aNumber adaptToFloat: self andSend: #/! Item was removed: - ----- Method: Float>>< (in category 'comparing') ----- - < aNumber - "Primitive. Compare the receiver with the argument and return true - if the receiver is less than the argument. Otherwise return false. - Fail if the argument is not a Float. Essential. See Object documentation - whatIsAPrimitive." - - <primitive: 43> - ^ aNumber adaptToFloat: self andCompare: #<! Item was removed: - ----- Method: Float>><= (in category 'comparing') ----- - <= aNumber - "Primitive. Compare the receiver with the argument and return true - if the receiver is less than or equal to the argument. Otherwise return - false. Fail if the argument is not a Float. Optional. See Object - documentation whatIsAPrimitive." - - <primitive: 45> - ^ aNumber adaptToFloat: self andCompare: #<=! Item was removed: - ----- Method: Float>>= (in category 'comparing') ----- - = aNumber - "Primitive. Compare the receiver with the argument and return true - if the receiver is equal to the argument. Otherwise return false. - Fail if the argument is not a Float. Essential. See Object documentation - whatIsAPrimitive." - - <primitive: 47> - aNumber isNumber ifFalse: [^ false]. - ^ aNumber adaptToFloat: self andCompare: #=! Item was removed: - ----- Method: Float>>> (in category 'comparing') ----- - > aNumber - "Primitive. Compare the receiver with the argument and return true - if the receiver is greater than the argument. Otherwise return false. - Fail if the argument is not a Float. Essential. See Object documentation - whatIsAPrimitive." - - <primitive: 44> - ^ aNumber adaptToFloat: self andCompare: #>! Item was removed: - ----- Method: Float>>>= (in category 'comparing') ----- - >= aNumber - "Primitive. Compare the receiver with the argument and return true - if the receiver is greater than or equal to the argument. Otherwise return - false. Fail if the argument is not a Float. Optional. See Object documentation - whatIsAPrimitive. " - - <primitive: 46> - ^ aNumber adaptToFloat: self andCompare: #>=! Item was removed: - ----- Method: Float>>arcTan (in category 'mathematical functions') ----- - arcTan - "Answer the angle in radians. - Optional. See Object documentation whatIsAPrimitive." - - | theta eps step sinTheta cosTheta | - <primitive: 57> - - "Newton-Raphson" - self < 0.0 ifTrue: [ ^ 0.0 - (0.0 - self) arcTan ]. - - "first guess" - theta := (self * Halfpi) / (self + 1.0). - - "iterate" - eps := Halfpi * Epsilon. - step := theta. - [(step * step) > eps] whileTrue: [ - sinTheta := theta sin. - cosTheta := theta cos. - step := (sinTheta * cosTheta) - (self * cosTheta * cosTheta). - theta := theta - step]. - ^ theta! Item was removed: - ----- Method: Float>>exp (in category 'mathematical functions') ----- - exp - "Answer E raised to the receiver power. - Optional. See Object documentation whatIsAPrimitive." - - | base fract correction delta div | - <primitive: 59> - - "Taylor series" - "check the special cases" - self < 0.0 ifTrue: [^ (self negated exp) reciprocal]. - self = 0.0 ifTrue: [^ 1]. - self abs > MaxValLn ifTrue: [self error: 'exp overflow']. - - "get first approximation by raising e to integer power" - base := E raisedToInteger: (self truncated). - - "now compute the correction with a short Taylor series" - "fract will be 0..1, so correction will be 1..E" - "in the worst case, convergance time is logarithmic with 1/Epsilon" - fract := self fractionPart. - fract = 0.0 ifTrue: [ ^ base ]. "no correction required" - - correction := 1.0 + fract. - delta := fract * fract / 2.0. - div := 2.0. - [delta > Epsilon] whileTrue: [ - correction := correction + delta. - div := div + 1.0. - delta := delta * fract / div]. - correction := correction + delta. - ^ base * correction! Item was removed: - ----- Method: Float>>exponent (in category 'truncation and round off') ----- - exponent - "Primitive. Consider the receiver to be represented as a power of two - multiplied by a mantissa (between one and two). Answer with the - SmallInteger to whose power two is raised. Optional. See Object - documentation whatIsAPrimitive." - - <primitive: 53> - ^self exponentFromBitPattern! Item was removed: - ----- Method: Float>>fractionPart (in category 'truncation and round off') ----- - fractionPart - "Primitive. Answer a Float whose value is the difference between the - receiver and the receiver's asInteger value. Optional. See Object - documentation whatIsAPrimitive." - - <primitive: 52> - ^self - self truncated asFloat! Item was removed: - ----- Method: Float>>ln (in category 'mathematical functions') ----- - ln - "Answer the natural logarithm of the receiver. - Optional. See Object documentation whatIsAPrimitive." - - | expt n mant x div pow delta sum eps | - <primitive: 58> - - "Taylor series" - self <= 0.0 ifTrue: [DomainError signal: 'ln is only defined for x > 0.0']. - - "get a rough estimate from binary exponent" - expt := self exponent. - n := Ln2 * expt. - mant := self timesTwoPower: 0 - expt. - - "compute fine correction from mantinssa in Taylor series" - "mant is in the range [0..2]" - "we unroll the loop to avoid use of abs" - x := mant - 1.0. - div := 1.0. - pow := delta := sum := x. - x := x negated. "x <= 0" - eps := Epsilon * (n abs + 1.0). - [delta > eps] whileTrue: [ - "pass one: delta is positive" - div := div + 1.0. - pow := pow * x. - delta := pow / div. - sum := sum + delta. - "pass two: delta is negative" - div := div + 1.0. - pow := pow * x. - delta := pow / div. - sum := sum + delta]. - - ^ n + sum - - "2.718284 ln 1.0"! Item was removed: - ----- Method: Float>>sin (in category 'mathematical functions') ----- - sin - "Answer the sine of the receiver taken as an angle in radians. - Optional. See Object documentation whatIsAPrimitive." - - | sum delta self2 i | - <primitive: 56> - - "Taylor series" - "normalize to the range [0..Pi/2]" - self < 0.0 ifTrue: [^ (0.0 - ((0.0 - self) sin))]. - self > Twopi ifTrue: [^ (self \\ Twopi) sin]. - self > Pi ifTrue: [^ (0.0 - (self - Pi) sin)]. - self > Halfpi ifTrue: [^ (Pi - self) sin]. - - "unroll loop to avoid use of abs" - sum := delta := self. - self2 := 0.0 - (self * self). - i := 2.0. - [delta > Epsilon] whileTrue: [ - "once" - delta := (delta * self2) / (i * (i + 1.0)). - i := i + 2.0. - sum := sum + delta. - "twice" - delta := (delta * self2) / (i * (i + 1.0)). - i := i + 2.0. - sum := sum + delta]. - ^ sum! Item was removed: - ----- Method: Float>>sqrt (in category 'mathematical functions') ----- - sqrt - "Answer the square root of the receiver. - Optional. See Object documentation whatIsAPrimitive." - | exp guess eps delta | - <primitive: 55> - #Numeric. - "Changed 200/01/19 For ANSI <number> support." - "Newton-Raphson" - self <= 0.0 - ifTrue: [self = 0.0 - ifTrue: [^ 0.0] - ifFalse: ["v Chg" - ^ DomainError signal: 'sqrt undefined for number less than zero.']]. - "first guess is half the exponent" - exp := self exponent // 2. - guess := self timesTwoPower: 0 - exp. - "get eps value" - eps := guess * Epsilon. - eps := eps * eps. - delta := self - (guess * guess) / (guess * 2.0). - [delta * delta > eps] - whileTrue: - [guess := guess + delta. - delta := self - (guess * guess) / (guess * 2.0)]. - ^ guess! Item was removed: - ----- Method: Float>>timesTwoPower: (in category 'mathematical functions') ----- - timesTwoPower: anInteger - "Primitive. Answer with the receiver multiplied by 2.0 raised - to the power of the argument. - Optional. See Object documentation whatIsAPrimitive." - - <primitive: 54> - - anInteger < -29 ifTrue: [^ self * (2.0 raisedToInteger: anInteger)]. - anInteger < 0 ifTrue: [^ self / (1 bitShift: (0 - anInteger)) asFloat]. - anInteger < 30 ifTrue: [^ self * (1 bitShift: anInteger) asFloat]. - ^ self * (2.0 raisedToInteger: anInteger)! Item was removed: - ----- Method: Float>>truncated (in category 'truncation and round off') ----- - truncated - "Answer with a SmallInteger equal to the value of the receiver without - its fractional part. The primitive fails if the truncated value cannot be - represented as a SmallInteger. In that case, the code below will compute - a LargeInteger truncated value. - Essential. See Object documentation whatIsAPrimitive. " - - <primitive: 51> - self isFinite ifFalse: [self error: 'Cannot truncate this number']. - - self abs < 2.0e16 - ifTrue: ["Fastest way when it may not be an integer" - | di df q r | - di := 1 + (SmallInteger maxVal bitShift: -1). - df := di asFloat. - q := self quo: df. - r := self - (q asFloat * df). - ^q * di + r truncated] - ifFalse: [^ self asTrueFraction. "Extract all bits of the mantissa and shift if necess"] - - - - ! Item was removed: - ----- Method: Float>>~= (in category 'comparing') ----- - ~= aNumber - "Primitive. Compare the receiver with the argument and return true - if the receiver is not equal to the argument. Otherwise return false. - Fail if the argument is not a Float. Optional. See Object documentation - whatIsAPrimitive." - - <primitive: 48> - ^super ~= aNumber! Item was added: + ----- Method: InstructionClient>>callPrimitive: (in category 'instruction decoding') ----- + callPrimitive: pimIndex + "V3PlusClosures: 139 10001011 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256) + NewsqueakV4: 249 11111001 iiiiiiii jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256) + SistaV1: 248 11111000 iiiiiiii mjjjjjjj Call Primitive #iiiiiiii + ( jjjjjjj * 256) + m=1 means inlined primitive, no hard return after execution."! Item was added: + ----- Method: InstructionPrinter>>callPrimitive: (in category 'instruction decoding') ----- + callPrimitive: index + "Print the callPrimitive." + + self print: 'callPrimtive: ' , index printString! Item was changed: ----- Method: InstructionStream>>interpretV3ClosuresExtension:in:for: (in category 'decoding - private - v3 plus closures') ----- interpretV3ClosuresExtension: offset in: method for: client | type offset2 byte2 byte3 byte4 | offset <= 6 ifTrue: ["Extended op codes 128-134" byte2 := method at: pc. pc := pc + 1. offset <= 2 ifTrue: ["128-130: extended pushes and pops" type := byte2 // 64. offset2 := byte2 \\ 64. offset = 0 ifTrue: [type = 0 ifTrue: [^client pushReceiverVariable: offset2]. type = 1 ifTrue: [^client pushTemporaryVariable: offset2]. type = 2 ifTrue: [^client pushConstant: (method literalAt: offset2 + 1)]. type = 3 ifTrue: [^client pushLiteralVariable: (method literalAt: offset2 + 1)]]. offset = 1 ifTrue: [type = 0 ifTrue: [^client storeIntoReceiverVariable: offset2]. type = 1 ifTrue: [^client storeIntoTemporaryVariable: offset2]. type = 2 ifTrue: [self error: 'illegalStore']. type = 3 ifTrue: [^client storeIntoLiteralVariable: (method literalAt: offset2 + 1)]]. offset = 2 ifTrue: [type = 0 ifTrue: [^client popIntoReceiverVariable: offset2]. type = 1 ifTrue: [^client popIntoTemporaryVariable: offset2]. type = 2 ifTrue: [self error: 'illegalStore']. type = 3 ifTrue: [^client popIntoLiteralVariable: (method literalAt: offset2 + 1)]]]. "131-134: extended sends" offset = 3 ifTrue: "Single extended send" [^client send: (method literalAt: byte2 \\ 32 + 1) super: false numArgs: byte2 // 32]. offset = 4 ifTrue: "Double extended do-anything" [byte3 := method at: pc. pc := pc + 1. type := byte2 // 32. type = 0 ifTrue: [^client send: (method literalAt: byte3 + 1) super: false numArgs: byte2 \\ 32]. type = 1 ifTrue: [^client send: (method literalAt: byte3 + 1) super: true numArgs: byte2 \\ 32]. type = 2 ifTrue: [^client pushReceiverVariable: byte3]. type = 3 ifTrue: [^client pushConstant: (method literalAt: byte3 + 1)]. type = 4 ifTrue: [^client pushLiteralVariable: (method literalAt: byte3 + 1)]. type = 5 ifTrue: [^client storeIntoReceiverVariable: byte3]. type = 6 ifTrue: [^client popIntoReceiverVariable: byte3]. type = 7 ifTrue: [^client storeIntoLiteralVariable: (method literalAt: byte3 + 1)]]. offset = 5 ifTrue: "Single extended send to super" [^client send: (method literalAt: byte2 \\ 32 + 1) super: true numArgs: byte2 // 32]. offset = 6 ifTrue: "Second extended send" [^client send: (method literalAt: byte2 \\ 64 + 1) super: false numArgs: byte2 // 64]]. offset = 7 ifTrue: [^client doPop]. offset = 8 ifTrue: [^client doDup]. offset = 9 ifTrue: [^client pushActiveContext]. byte2 := method at: pc. pc := pc + 1. offset = 10 ifTrue: [^byte2 < 128 ifTrue: [client pushNewArrayOfSize: byte2] ifFalse: [client pushConsArrayWithElements: byte2 - 128]]. - offset = 11 ifTrue: [^self unusedBytecode: client at: pc - 1]. byte3 := method at: pc. pc := pc + 1. + offset = 11 ifTrue: [^client callPrimitive: byte2 + (byte3 bitShift: 8)]. offset = 12 ifTrue: [^client pushRemoteTemp: byte2 inVectorAt: byte3]. offset = 13 ifTrue: [^client storeIntoRemoteTemp: byte2 inVectorAt: byte3]. offset = 14 ifTrue: [^client popIntoRemoteTemp: byte2 inVectorAt: byte3]. "offset = 15" byte4 := method at: pc. pc := pc + 1. ^client pushClosureCopyNumCopiedValues: (byte2 bitShift: -4) numArgs: (byte2 bitAnd: 16rF) blockSize: (byte3 * 256) + byte4! Item was changed: ----- Method: Integer class>>initialize (in category 'class initialization') ----- + initialize + "Integer initialize" + self initializeLowBitPerByteTable! - initialize "Integer initialize" - "Ensure we have the right compact class index" - - "LPI has been a compact class forever - just ensure basic correctness" - (LargePositiveInteger indexIfCompact = 5) ifFalse:[ - (Smalltalk compactClassesArray at: 5) - ifNil:[LargePositiveInteger becomeCompactSimplyAt: 5] - ifNotNil:[self error: 'Unexpected compact class setup']]. - - "Cog requires LNI to be compact at 4 (replacing PseudoContext)" - (LargeNegativeInteger indexIfCompact = 4) ifFalse:[ - "PseudoContext will likely get removed at some point so write this test - without introducing a hard dependency" - (Smalltalk compactClassesArray at: 4) name == #PseudoContext - ifTrue:[Smalltalk compactClassesArray at: 4 put: nil]. - (Smalltalk compactClassesArray at: 4) - ifNil:[LargeNegativeInteger becomeCompactSimplyAt: 4] - ifNotNil:[self error: 'Unexpected compact class setup']]. - - self initializeLowBitPerByteTable - ! Item was added: + ----- Method: MethodContext class>>allInstances (in category 'enumerating') ----- + allInstances + "Answer all instances of the receiver." + <primitive: 177> + "The primitive can fail because memory is low. If so, fall back on the old + enumeration code, which gives the system a chance to GC and/or grow. + Because aBlock might change the class of inst (for example, using become:), + it is essential to compute next before aBlock value: inst. + Only count until thisContext since this context has been created only to + compute the existing instances." + | inst insts next | + insts := WriteStream on: (Array new: 64). + inst := self someInstance. + [inst == thisContext or: [inst == nil]] whileFalse: + [next := inst nextInstance. + insts nextPut: inst. + inst := next]. + ^insts contents! Item was changed: ----- Method: MethodContext class>>allInstancesDo: (in category 'private') ----- allInstancesDo: aBlock + "Evaluate aBlock with each of the current instances of the receiver." + | instances inst next | + instances := self allInstancesOrNil. + instances ifNotNil: + [instances do: aBlock. + ^self]. + "allInstancesOrNil can fail because memory is low. If so, fall back on the old + enumeration code. Because aBlock might change the class of inst (for example, + using become:), it is essential to compute next before aBlock value: inst. + Only count until thisContext since evaluation of aBlock will create new contexts." - "Only count until thisContext since evaluation of aBlock will create new contexts." - | inst next | inst := self someInstance. + [inst == thisContext or: [inst == nil]] whileFalse: + [next := inst nextInstance. + aBlock value: inst. + inst := next]! - [inst == thisContext] whileFalse:[ - next := inst nextInstance. - aBlock value: inst. - inst := next] - ! Item was added: + ----- Method: MethodContext>>failPrimitiveWith: (in category 'system simulation') ----- + failPrimitiveWith: maybePrimFailToken + "The receiver is a freshly-created context on a primitive method. Skip the callPrimitive: + bytecode and store the primitive fail code if there is one and the method consumes it." + self skipCallPrimitive. + ((self isPrimFailToken: maybePrimFailToken) + and: [method encoderClass isStoreAt: pc in: method]) ifTrue: + [self at: stackp put: maybePrimFailToken last]! Item was changed: ----- 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! - - <primitive: 148> - self primitiveFailed! Item was changed: ----- Method: ProtoObject>>scaledIdentityHash (in category 'comparing') ----- scaledIdentityHash "For identityHash values returned by primitive 75, answer + such values times 2^8. Otherwise, match the existing + identityHash implementation" - such values times 2^18. Otherwise, match the existing - identityHash implementation" + ^self identityHash * 256 "bitShift: 8"! - ^self identityHash * 262144 "bitShift: 18"! Item was added: ==== ERROR === Error: Unrecognized class type 1 December 2014 10:44:32.876 pm VM: unix - a SmalltalkImage Image: Squeak3.11alpha [latest update: #8824] SecurityManager state: Restricted: false FileAccess: true SocketAccess: true Working Dir /home/squeaksource Trusted Dir /home/squeaksource/secure Untrusted Dir /home/squeaksource/My Squeak MCClassDefinition(Object)>>error: Receiver: a MCClassDefinition(SmallFloat64) Arguments and temporary variables: aString: 'Unrecognized class type' Receiver's instance variables: name: #SmallFloat64 superclassName: #Float variables: an OrderedCollection() category: 'Kernel-Numbers' type: #immediate comment: 'My instances represent 64-bit Floats whose exponent fits in 8 bits as...etc... commentStamp: 'eem 11/25/2014 07:54' traitComposition: nil classTraitComposition: nil MCClassDefinition>>kindOfSubclass Receiver: a MCClassDefinition(SmallFloat64) Arguments and temporary variables: Receiver's instance variables: name: #SmallFloat64 superclassName: #Float variables: an OrderedCollection() category: 'Kernel-Numbers' type: #immediate comment: 'My instances represent 64-bit Floats whose exponent fits in 8 bits as...etc... commentStamp: 'eem 11/25/2014 07:54' traitComposition: nil classTraitComposition: nil MCClassDefinition>>printDefinitionOn: Receiver: a MCClassDefinition(SmallFloat64) Arguments and temporary variables: stream: a WriteStream Receiver's instance variables: name: #SmallFloat64 superclassName: #Float variables: an OrderedCollection() category: 'Kernel-Numbers' type: #immediate comment: 'My instances represent 64-bit Floats whose exponent fits in 8 bits as...etc... commentStamp: 'eem 11/25/2014 07:54' traitComposition: nil classTraitComposition: nil [] in MCDiffyTextWriter(MCStWriter)>>writeClassDefinition: Receiver: a MCDiffyTextWriter Arguments and temporary variables: definition: a WriteStream s: a MCClassDefinition(SmallFloat64) Receiver's instance variables: stream: a WriteStream initStream: nil --- The full stack --- MCClassDefinition(Object)>>error: MCClassDefinition>>kindOfSubclass MCClassDefinition>>printDefinitionOn: [] in MCDiffyTextWriter(MCStWriter)>>writeClassDefinition: - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - String class(SequenceableCollection class)>>new:streamContents: String class(SequenceableCollection class)>>streamContents: MCDiffyTextWriter(MCTextWriter)>>chunkContents: MCDiffyTextWriter(MCStWriter)>>writeClassDefinition: MCDiffyTextWriter(MCStWriter)>>visitClassDefinition: MCClassDefinition>>accept: [] in MCDiffyTextWriter(MCTextWriter)>>visitInFork: String class(SequenceableCollection class)>>new:streamContents: String class(SequenceableCollection class)>>streamContents: MCDiffyTextWriter(MCTextWriter)>>visitInFork: MCDiffyTextWriter>>writePatchFrom:to: MCDiffyTextWriter>>writeAddition: [] in MCDiffyTextWriter>>writePatch: SortedCollection(OrderedCollection)>>do: MCDiffyTextWriter>>writePatch: SSDiffyTextWriter>>writePatch: [] in SSDiffyTextWriter>>writeVersion:for: BlockClosure>>on:do: SSDiffyTextWriter>>writeVersion:for: [] in SSEMailSubscription>>versionAdded:to: BlockClosure>>on:do: SSEMailSubscription>>versionAdded:to: [] in [] in SSProject>>versionAdded: [] in BlockClosure>>newProcess

1 0

The Trunk: Kernel.spur-eem.888.mcz
by commits＠source.squeak.org 01 Dec '14

01 Dec '14

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages December 2014