byteSizeOfBytes is mentioned in the commit comment, and referenced once in the source (LargeIntegerPlugin), but everywhere else it seems to be called numBytesOfBytes: (including the new method definition).
Would it mayhaps also be possible to refactor numBytesOf: into object type check + numBytesOfBytes call as well?
Cheers, Henry
On 12 Mar 2015, at 3:09 , commits@source.squeak.org wrote:
Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1087.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.1087 Author: eem Time: 11 March 2015, 8:09:01.528 pm UUID: ec6b2e65-73ca-4827-8af7-7b2dc7b0d581 Ancestors: VMMaker.oscog-eem.1086
Speed up normalize methods in LargeIntegersPlugin by cacheing result of firstIndexableField.
Simplify integer conversion routines by adding byteSizeOfBytes: which assumes argument is byte indexable (as LargeIntegers are). Fix some simulation regressions in the conversion routines. Make sure they consistently answer 0 on failure. Use 4-byte access where possible.
Remove use of popI nteger in AsFloat and integer comparison primitives (popStack idiom is inefficient since multiplke writes as opposed to the single write in the pop:thenPush: idiom).
Fix simulation regression in new primitiveMakePoint.
Revise SpurMemoryManager>> isClassOfNonImm:equalTo:compactClassIndex: for better dead code elimination.
=============== Diff against VMMaker.oscog-eem.1086 ===============
Item was changed: ----- Method: CArray>>coerceTo:sim: (in category 'converting') ----- coerceTo: cTypeString sim: interpreterSimulator
^cTypeString caseOf: {
['int'] -> [self ptrAddress].
['float *'] -> [self asCArrayAccessor asFloatAccessor].
['int *'] -> [self asCArrayAccessor asIntAccessor].
['char *'] -> [self shallowCopy unitSize: 1; yourself].
['unsigned char *'] -> [self shallowCopy unitSize: 1; yourself].
['unsigned'] -> [self ptrAddress].
['sqInt'] -> [self ptrAddress].
['usqInt'] -> [self ptrAddress] }!
['int'] -> [self ptrAddress].
['float *'] -> [self asCArrayAccessor asFloatAccessor].
['int *'] -> [self asCArrayAccessor asIntAccessor].
['char *'] -> [self shallowCopy unitSize: 1; yourself].
['unsigned'] -> [self ptrAddress].
['sqInt'] -> [self ptrAddress].
['usqInt'] -> [self ptrAddress] }!
Item was changed: ----- Method: CoInterpreter>>assertValidExecutionPointe:r:s:imbar:line: (in category 'debug support') ----- assertValidExecutionPointe: lip r: lifp s: lisp imbar: inInterpreter line: ln <var: #lip type: #usqInt> <var: #lifp type: #'char *'> <var: #lisp type: #'char *'> | methodField cogMethod theIP | <var: #cogMethod type: #'CogMethod *'> self assert: stackPage = stackPages mostRecentlyUsedPage l: ln. self assert: (stackPage addressIsInPage: lifp) l: ln. self assert: (self deferStackLimitSmashAround: #assertValidStackLimits: asSymbol with: ln). self assert: lisp < lifp l: ln. self assert: lifp > lisp l: ln. self assert: lisp >= (stackPage realStackLimit - self stackLimitOffset) l: ln. self assert: (lifp - lisp) / objectMemory bytesPerOop < LargeContextSlots l: ln. methodField := self frameMethodField: lifp. inInterpreter ifTrue: [self assert: (self isMachineCodeFrame: lifp) not l: ln. self assert: method = methodField l: ln. self cppIf: MULTIPLEBYTECODESETS ifTrue: [self assert: (self methodUsesAlternateBytecodeSet: method) = (bytecodeSetSelector = 256) l: ln]. (self asserta: (objectMemory cheapAddressCouldBeInHeap: methodField) l: ln) ifTrue: [theIP := lip = cogit ceReturnToInterpreterPC ifTrue: [self iframeSavedIP: lifp] ifFalse: [lip]. self assert: (theIP >= (methodField + (objectMemory lastPointerOf: methodField))
and: [theIP < (methodField + (objectMemory numBytesOfBytes: methodField) + objectMemory baseHeaderSize - 1)])
ifFalse: [self assert: (self isMachineCodeFrame: lifp) l: ln. ((self asserta: methodField asUnsignedInteger >= cogit minCogMethodAddress l: ln) and: [self asserta: methodField asUnsignedInteger < cogit maxCogMethodAddress l: ln]) ifTrue: [cogMethod := self mframeHomeMethod: lifp. self assert: (lip > (methodField + ((self mframeIsBlockActivation: lifp) ifTrue: [self sizeof: CogBlockMethod] ifFalse: [self sizeof: CogMethod])) and: [lip < (methodField + cogMethod blockSize)]) l: ln]. self assert: ((self mframeIsBlockActivation: lifp) or: [(self pushedReceiverOrClosureOfFrame: lifp) = (self mframeReceiver: lifp)]) l: ln]. (self isBaseFrame: lifp) ifTrue: [self assert: (self frameHasContext: lifp) l: ln. self assert: (self frameContext: lifp) = (stackPages longAt: stackPage baseAddress - objectMemory wordSize) l: ln]!and: [theIP < (methodField + (objectMemory numBytesOf: methodField) + objectMemory baseHeaderSize - 1)]) l: ln]. self assert: ((self iframeIsBlockActivation: lifp) or: [(self pushedReceiverOrClosureOfFrame: lifp) = (self iframeReceiver: lifp)]) l: ln]
Item was changed: ----- Method: CoInterpreter>>assertValidStackedInstructionPointersIn:line: (in category 'debug support') ----- assertValidStackedInstructionPointersIn: aStackPage line: ln "Check that the stacked instruction pointers in the given page are correct. Checks the interpreter sender/machine code callee contract." <var: #aStackPage type: #'StackPage *'> <var: #theFP type: #'char *'> <var: #callerFP type: #'char *'> <var: #theIP type: #usqInt> <var: #theMethod type: #'CogMethod *'> <inline: false> | prevFrameWasCogged theFP callerFP theMethod theIP methodObj | (self asserta: (stackPages isFree: aStackPage) not l: ln) ifFalse: [^false]. prevFrameWasCogged := false. "The top of stack of an inactive page is always the instructionPointer. The top of stack of the active page may be the instructionPointer if it has been pushed, which is indicated by a 0 instructionPointer." (stackPage = aStackPage and: [instructionPointer ~= 0]) ifTrue: [theIP := instructionPointer. theFP := framePointer] ifFalse: [theIP := (stackPages longAt: aStackPage headSP) asUnsignedInteger. theFP := aStackPage headFP. stackPage = aStackPage ifTrue: [self assert: framePointer = theFP l: ln]]. [(self isMachineCodeFrame: theFP) ifTrue: [theMethod := self mframeHomeMethod: theFP. self assert: (theIP = cogit ceCannotResumePC or: [theIP >= theMethod asUnsignedInteger and: [theIP < (theMethod asUnsignedInteger + theMethod blockSize)]]) l: ln. prevFrameWasCogged := true] ifFalse: "assert-check the interpreter frame." [methodObj := self iframeMethod: theFP. prevFrameWasCogged ifTrue: [self assert: theIP = cogit ceReturnToInterpreterPC l: ln]. theIP = cogit ceReturnToInterpreterPC ifTrue: [theIP := self iframeSavedIP: theFP]. self assert: (theIP >= (methodObj + (objectMemory lastPointerOf: methodObj))
and: [theIP < (methodObj + (objectMemory numBytesOfBytes: methodObj) + objectMemory baseHeaderSize - 1)])
theIP := (stackPages longAt: theFP + FoxCallerSavedIP) asUnsignedInteger. (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue: [theFP := callerFP]. self assert: theIP = cogit ceBaseFrameReturnPC l: ln. ^true!and: [theIP < (methodObj + (objectMemory numBytesOf: methodObj) + objectMemory baseHeaderSize - 1)]) l: ln. prevFrameWasCogged := false].
Item was changed: ----- Method: InterpreterPrimitives>>magnitude64BitIntegerFor:neg: (in category 'primitive support') ----- magnitude64BitIntegerFor: magnitude neg: isNegative "Return a Large Integer object for the given integer magnitude and sign" | newLargeInteger largeClass highWord sz isSmall smallVal | <var: 'magnitude' type: #usqLong> <var: 'highWord' type: #usqInt>
isSmall := isNegative ifTrue: [magnitude <= (objectMemory maxSmallInteger + 1)] ifFalse: [magnitude <= objectMemory maxSmallInteger]. isSmall ifTrue: [smallVal := self cCoerceSimple: magnitude to: #sqInt. isNegative ifTrue: [smallVal := 0 - smallVal]. ^objectMemory integerObjectOf: smallVal].
largeClass := isNegative ifTrue: [objectMemory classLargeNegativeInteger] ifFalse: [objectMemory classLargePositiveInteger]. objectMemory wordSize = 8 ifTrue: [sz := 8] ifFalse: [(highWord := magnitude >> 32) = 0 ifTrue: [sz := 4] ifFalse: [sz := 5. (highWord := highWord >> 8) = 0 ifFalse: [sz := sz + 1. (highWord := highWord >> 8) = 0 ifFalse: [sz := sz + 1. (highWord := highWord >> 8) = 0 ifFalse: [sz := sz + 1]]]]]. newLargeInteger := objectMemory instantiateClass: largeClass indexableSize: sz. self cppIf: VMBIGENDIAN ifTrue: [sz > 4 ifTrue: [objectMemory storeByte: 7 ofObject: newLargeInteger withValue: (magnitude >> 56 bitAnd: 16rFF); storeByte: 6 ofObject: newLargeInteger withValue: (magnitude >> 48 bitAnd: 16rFF); storeByte: 5 ofObject: newLargeInteger withValue: (magnitude >> 40 bitAnd: 16rFF); storeByte: 4 ofObject: newLargeInteger withValue: (magnitude >> 32 bitAnd: 16rFF)]. objectMemory storeByte: 3 ofObject: newLargeInteger withValue: (magnitude >> 24 bitAnd: 16rFF); storeByte: 2 ofObject: newLargeInteger withValue: (magnitude >> 16 bitAnd: 16rFF); storeByte: 1 ofObject: newLargeInteger withValue: (magnitude >> 8 bitAnd: 16rFF); storeByte: 0 ofObject: newLargeInteger withValue: (magnitude ">> 0" bitAnd: 16rFF)] ifFalse: [sz > 4 ifTrue: [objectMemory storeLong32: 1 ofObject: newLargeInteger withValue: magnitude >> 32].
objectMemory
storeLong32: 0
ofObject: newLargeInteger
withValue: (self cCode: [magnitude] inSmalltalk: [magnitude bitAnd: 16rFFFFFFFF])].
objectMemory storeLong32: 0 ofObject: newLargeInteger withValue: magnitude].
^newLargeInteger!
Item was changed: ----- Method: InterpreterPrimitives>>magnitude64BitValueOf: (in category 'primitive support') ----- magnitude64BitValueOf: oop "Convert the given object into an integer value.
- The object may be either a positive SmallInteger or an eight-byte LargeInteger."
The object may be either a positive SmallInteger or a eight-byte LargeInteger." | sz value ok smallIntValue | <returnTypeC: #usqLong> <var: #value type: #usqLong>
(objectMemory isIntegerObject: oop) ifTrue: [smallIntValue := (objectMemory integerValueOf: oop). smallIntValue < 0 ifTrue: [smallIntValue := 0 - smallIntValue]. ^self cCoerce: smallIntValue to: #usqLong].
(objectMemory isNonIntegerImmediate: oop) ifTrue:
[self primitiveFail.
^0].
[^self primitiveFail].
ok := objectMemory isClassOfNonImm: oop equalTo: (objectMemory splObj: ClassLargePositiveInteger) compactClassIndex: ClassLargePositiveIntegerCompactIndex. ok ifFalse: [ok := objectMemory isClassOfNonImm: oop equalTo: (objectMemory splObj: ClassLargeNegativeInteger) compactClassIndex: ClassLargeNegativeIntegerCompactIndex.
ok ifFalse:
[self primitiveFail.
^0]].
- sz := objectMemory numBytesOfBytes: oop.
ok ifFalse: [^self primitiveFail]].
- sz := objectMemory numBytesOf: oop. sz > (self sizeof: #sqLong) ifTrue:
[self primitiveFail.
^0].
[^self primitiveFail].
- value := objectMemory fetchByte: sz - 1 ofObject: oop.
- sz - 2 to: 0 by: -1 do:
[:i | value := value << 8 + (objectMemory fetchByte: i ofObject: oop)].
- value := 0.
- 0 to: sz - 1 do: [:i |
^value!value := value + ((self cCoerce: (objectMemory fetchByte: i ofObject: oop) to: #sqLong) << (i*8))].
Item was changed: ----- Method: InterpreterPrimitives>>positive32BitValueOf: (in category 'primitive support') ----- positive32BitValueOf: oop "Convert the given object into an integer value. The object may be either a positive SmallInteger or a four-byte LargePositiveInteger." <returnTypeC: #usqInt>
- | value ok sz |
- | value ok | (objectMemory isIntegerObject: oop) ifTrue: [value := objectMemory integerValueOf: oop.
value < 0 ifTrue: [self primitiveFail. value := 0].
^value].
value < 0 ifTrue: [self primitiveFail. value := 0].
^value].
(objectMemory isNonIntegerImmediate: oop) ifTrue: [self primitiveFail. ^0].
ok := objectMemory isClassOfNonImm: oop equalTo: (objectMemory splObj: ClassLargePositiveInteger) compactClassIndex: ClassLargePositiveIntegerCompactIndex.
- ok ifFalse:
- (ok and: [(objectMemory lengthOf: oop) = 4]) ifFalse: [self primitiveFail. ^0].
- sz := objectMemory numBytesOfBytes: oop.
- sz > 4 ifTrue:
[self primitiveFail.
^0].
- ^self cppIf: VMBIGENDIAN
ifTrue:
[ (objectMemory fetchByte: 0 ofObject: oop)
+ ((objectMemory fetchByte: 1 ofObject: oop) << 8)
+ ((objectMemory fetchByte: 2 ofObject: oop) << 16)
+ ((objectMemory fetchByte: 3 ofObject: oop) << 24)]
ifFalse:
[objectMemory fetchLong32: 0 ofObject: oop]!
- ^(objectMemory fetchByte: 0 ofObject: oop)
- ((objectMemory fetchByte: 1 ofObject: oop) << 8)
- ((objectMemory fetchByte: 2 ofObject: oop) << 16)
- ((objectMemory fetchByte: 3 ofObject: oop) << 24)!
Item was changed: ----- Method: InterpreterPrimitives>>positive64BitValueOf: (in category 'primitive support') ----- positive64BitValueOf: oop "Convert the given object into an integer value. The object may be either a positive SmallInteger or an eight-byte LargePositiveInteger."
<returnTypeC: #usqLong> | sz value ok | <var: #value type: #usqLong> (objectMemory isIntegerObject: oop) ifTrue: [(objectMemory integerValueOf: oop) < 0 ifTrue: [^self primitiveFail]. ^objectMemory integerValueOf: oop].
(objectMemory isNonIntegerImmediate: oop) ifTrue: [self primitiveFail. ^0].
ok := objectMemory isClassOfNonImm: oop equalTo: (objectMemory splObj: ClassLargePositiveInteger) compactClassIndex: ClassLargePositiveIntegerCompactIndex.
- ok ifFalse:
- (ok and: [(sz := objectMemory numBytesOf: oop) <= (self sizeof: #sqLong)]) ifFalse: [self primitiveFail. ^0].
sz := objectMemory numBytesOfBytes: oop.
sz > (self sizeof: #sqLong) ifTrue:
[self primitiveFail.
^0].
value := 0. 0 to: sz - 1 do: [:i | value := value + ((self cCoerce: (objectMemory fetchByte: i ofObject: oop) to: #usqLong) << (i*8))]. ^value!
Item was changed: ----- Method: InterpreterPrimitives>>positiveMachineIntegerValueOf: (in category 'primitive support') ----- positiveMachineIntegerValueOf: oop "Answer a value of an integer in address range, i.e up to the size of a machine word. The object may be either a positive SmallInteger or a LargePositiveInteger of size <= word size." <returnTypeC: #'unsigned long'> <inline: true> "only two callers & one is primitiveNewWithArg" | value bs ok | (objectMemory isIntegerObject: oop) ifTrue: [value := objectMemory integerValueOf: oop. value < 0 ifTrue: [^self primitiveFail]. ^value].
(objectMemory isNonIntegerImmediate: oop) ifTrue:
[self primitiveFail.
^0].
[^self primitiveFail].
ok := objectMemory isClassOfNonImm: oop equalTo: (objectMemory splObj: ClassLargePositiveInteger) compactClassIndex: ClassLargePositiveIntegerCompactIndex.
- ok ifFalse:
[self primitiveFail.
^0].
- bs := objectMemory numBytesOfBytes: oop.
- bs > (self sizeof: #'unsigned long') ifTrue:
[self primitiveFail.
^0].
(ok and: [(bs := objectMemory numBytesOf: oop) <= (self sizeof: #'unsigned long')]) ifFalse:
[^self primitiveFail].
((self sizeof: #'unsigned long') = 8 and: [bs > 4]) ifTrue:
[^self cppIf: VMBIGENDIAN
ifTrue:
[ (objectMemory fetchByte: 0 ofObject: oop)
+ ((objectMemory fetchByte: 1 ofObject: oop) << 8)
+ ((objectMemory fetchByte: 2 ofObject: oop) << 16)
+ ((objectMemory fetchByte: 3 ofObject: oop) << 24)
+ ((objectMemory fetchByte: 4 ofObject: oop) << 32)
+ ((objectMemory fetchByte: 5 ofObject: oop) << 40)
+ ((objectMemory fetchByte: 6 ofObject: oop) << 48)
+ ((objectMemory fetchByte: 7 ofObject: oop) << 56)]
ifFalse:
[objectMemory fetchLong64: 0 ofObject: oop]]
ifFalse:
[^self cppIf: VMBIGENDIAN
ifTrue:
[ (objectMemory fetchByte: 0 ofObject: oop)
+ ((objectMemory fetchByte: 1 ofObject: oop) << 8)
+ ((objectMemory fetchByte: 2 ofObject: oop) << 16)
+ ((objectMemory fetchByte: 3 ofObject: oop) << 24)]
ifFalse:
[objectMemory fetchLong32: 0 ofObject: oop]]!
[^ (objectMemory fetchByte: 0 ofObject: oop)
+ ((objectMemory fetchByte: 1 ofObject: oop) << 8)
+ ((objectMemory fetchByte: 2 ofObject: oop) << 16)
+ ((objectMemory fetchByte: 3 ofObject: oop) << 24)
+ ((objectMemory fetchByte: 4 ofObject: oop) << 32)
+ ((objectMemory fetchByte: 5 ofObject: oop) << 40)
+ ((objectMemory fetchByte: 6 ofObject: oop) << 48)
+ ((objectMemory fetchByte: 7 ofObject: oop) << 56)].
- ^ (objectMemory fetchByte: 0 ofObject: oop)
- ((objectMemory fetchByte: 1 ofObject: oop) << 8)
- ((objectMemory fetchByte: 2 ofObject: oop) << 16)
- ((objectMemory fetchByte: 3 ofObject: oop) << 24)!
Item was changed: ----- Method: InterpreterPrimitives>>primitiveAsFloat (in category 'arithmetic float primitives') ----- primitiveAsFloat
- "N.B. This will answer inexact results for integers with > 53 bits of magnitude."
- | rcvr |
- rcvr := self stackTop.
- self assert: (objectMemory isIntegerObject: rcvr).
- self pop: 1 thenPushFloat: (objectMemory integerValueOf: rcvr) asFloat!
- | arg |
- arg := self popInteger.
- self successful
ifTrue: [self pushFloat: arg asFloat]
ifFalse: [self unPop: 1]!
Item was changed: ----- Method: InterpreterPrimitives>>primitiveClipboardText (in category 'I/O primitives') ----- primitiveClipboardText "When called with a single string argument, post the string to the clipboard. When called with zero arguments, return a string containing the current clipboard contents." | s sz | argumentCount = 1 ifTrue: [s := self stackTop. (objectMemory isBytes: s) ifFalse: [^ self primitiveFail]. self successful ifTrue:
[sz := objectMemory numBytesOfBytes: s.
ifFalse: [sz := self clipboardSize. objectMemory hasSpurMemoryManagerAPI ifTrue: [s := objectMemory allocateBytes: sz classIndex: ClassByteStringCompactIndex. s ifNil: [^self primitiveFail]] ifFalse: [(objectMemory sufficientSpaceToAllocate: sz) ifFalse: [^self primitiveFail]. s := objectMemory instantiateClass: (objectMemory splObj: ClassByteString) indexableSize: sz]. self clipboardRead: sz Into: s + objectMemory baseHeaderSize At: 0. self pop: 1 thenPush: s]![sz := objectMemory numBytesOf: s. self clipboardWrite: sz From: s + objectMemory baseHeaderSize At: 0. self pop: 1]]
Item was changed: ----- Method: InterpreterPrimitives>>primitiveEqual (in category 'arithmetic integer primitives') ----- primitiveEqual | integerReceiver integerArgument result |
- integerArgument := self stackTop.
- integerReceiver := self stackValue: 1.
- (objectMemory areIntegers: integerReceiver and: integerArgument)
ifTrue: [self pop: 2 thenPushBool: integerReceiver = integerArgument]
ifFalse:
[result := objectMemory hasSixtyFourBitImmediates
ifTrue:
[(self signed64BitValueOf: integerReceiver)
= (self signed64BitValueOf: integerArgument)]
ifFalse:
[(self positiveMachineIntegerValueOf: integerReceiver)
= (self positiveMachineIntegerValueOf: integerArgument)].
self successful ifTrue:
[self pop: 2 thenPushBool: result]]!
- integerArgument := self popStack.
- integerReceiver := self popStack.
- result := self compare31or32Bits: integerReceiver equal: integerArgument.
- self checkBooleanResult: result!
Item was changed: ----- Method: InterpreterPrimitives>>primitiveGreaterOrEqual (in category 'arithmetic integer primitives') ----- primitiveGreaterOrEqual | integerReceiver integerArgument |
- integerArgument := self stackTop.
- integerReceiver := self stackValue: 1.
- (objectMemory areIntegers: integerReceiver and: integerArgument)
ifTrue: [self cCode: '' inSmalltalk:
[integerReceiver := objectMemory integerValueOf: integerReceiver.
integerArgument := objectMemory integerValueOf: integerArgument].
self pop: 2 thenPushBool: integerReceiver >= integerArgument]
ifFalse: [self primitiveFail]!
- integerArgument := self popInteger.
- integerReceiver := self popInteger.
- self checkBooleanResult: integerReceiver >= integerArgument!
Item was changed: ----- Method: InterpreterPrimitives>>primitiveGreaterThan (in category 'arithmetic integer primitives') ----- primitiveGreaterThan | integerReceiver integerArgument |
- integerArgument := self stackTop.
- integerReceiver := self stackValue: 1.
- (objectMemory areIntegers: integerReceiver and: integerArgument)
ifTrue: [self cCode: '' inSmalltalk:
[integerReceiver := objectMemory integerValueOf: integerReceiver.
integerArgument := objectMemory integerValueOf: integerArgument].
self pop: 2 thenPushBool: integerReceiver > integerArgument]
ifFalse: [self primitiveFail]!
- integerArgument := self popInteger.
- integerReceiver := self popInteger.
- self checkBooleanResult: integerReceiver > integerArgument!
Item was changed: ----- Method: InterpreterPrimitives>>primitiveLessOrEqual (in category 'arithmetic integer primitives') ----- primitiveLessOrEqual | integerReceiver integerArgument |
- integerArgument := self stackTop.
- integerReceiver := self stackValue: 1.
- (objectMemory areIntegers: integerReceiver and: integerArgument)
ifTrue: [self cCode: '' inSmalltalk:
[integerReceiver := objectMemory integerValueOf: integerReceiver.
integerArgument := objectMemory integerValueOf: integerArgument].
self pop: 2 thenPushBool: integerReceiver <= integerArgument]
ifFalse: [self primitiveFail]!
- integerArgument := self popInteger.
- integerReceiver := self popInteger.
- self checkBooleanResult: integerReceiver <= integerArgument!
Item was changed: ----- Method: InterpreterPrimitives>>primitiveLessThan (in category 'arithmetic integer primitives') ----- primitiveLessThan | integerReceiver integerArgument |
- integerArgument := self stackTop.
- integerReceiver := self stackValue: 1.
- (objectMemory areIntegers: integerReceiver and: integerArgument)
ifTrue: [self cCode: '' inSmalltalk:
[integerReceiver := objectMemory integerValueOf: integerReceiver.
integerArgument := objectMemory integerValueOf: integerArgument].
self pop: 2 thenPushBool: integerReceiver < integerArgument]
ifFalse: [self primitiveFail]!
- integerArgument := self popInteger.
- integerReceiver := self popInteger.
- self checkBooleanResult: integerReceiver < integerArgument!
Item was changed: ----- Method: InterpreterPrimitives>>primitiveMakePoint (in category 'arithmetic integer primitives') ----- primitiveMakePoint <inline: false> | rcvr pt | rcvr := self stackValue: 1.
- ((objectMemory isIntegerObject: rcvr) or: [objectMemory isFloatObject: rcvr]) ifFalse:
- ((self isIntegerObject: rcvr) or: [self isFloatObject: rcvr]) ifFalse: [^self primitiveFail]. pt := objectMemory eeInstantiateSmallClass: (objectMemory splObj: ClassPoint) numSlots: YIndex + 1. objectMemory storePointerUnchecked: XIndex ofObject: pt withValue: rcvr; storePointerUnchecked: YIndex ofObject: pt withValue: self stackTop. self pop: 2 thenPush: pt!
Item was changed: ----- Method: InterpreterPrimitives>>primitiveNotEqual (in category 'arithmetic integer primitives') ----- primitiveNotEqual | integerReceiver integerArgument result |
- integerArgument := self stackTop.
- integerReceiver := self stackValue: 1.
- (objectMemory areIntegers: integerReceiver and: integerArgument)
ifTrue: [self pop: 2 thenPushBool: integerReceiver ~= integerArgument]
ifFalse:
[result := objectMemory hasSixtyFourBitImmediates
ifTrue:
[(self signedMachineIntegerValueOf: integerReceiver)
~= (self signedMachineIntegerValueOf: integerArgument)]
ifFalse:
[(self positiveMachineIntegerValueOf: integerReceiver)
~= (self positiveMachineIntegerValueOf: integerArgument)].
self successful ifTrue:
[self pop: 2 thenPushBool: result]]!
- integerArgument := self popStack.
- integerReceiver := self popStack.
- result := (self compare31or32Bits: integerReceiver equal: integerArgument) not.
- self checkBooleanResult: result!
Item was changed: ----- Method: InterpreterPrimitives>>primitiveSignalAtBytesLeft (in category 'memory space primitives') ----- primitiveSignalAtBytesLeft
- "Set the low-water mark for free space. When the free space falls
below this level, the new and new: primitives fail and system attempts
to allocate space (e.g., to create a method context) cause the low-space
semaphore (if one is registered) to be signalled."
- "Set the low-water mark for free space. When the free space
- falls below this level, the new and new: primitives fail and
- system attempts to allocate space (e.g., to create a method
- context) cause the low-space semaphore (if one is
- registered) to be signalled." | bytes |
- bytes := self stackTop.
- ((objectMemory isIntegerObject: bytes)
and: [(bytes := objectMemory integerValueOf: bytes) >= 0])
ifTrue: [objectMemory lowSpaceThreshold: bytes. self pop: 1]
ifFalse: [self primitiveFailFor: PrimErrBadArgument]!
- bytes := self popInteger.
- self successful
ifTrue: [objectMemory lowSpaceThreshold: bytes]
ifFalse: [objectMemory lowSpaceThreshold: 0.
self unPop: 1]!
Item was changed: ----- Method: InterpreterPrimitives>>primitiveSlotAt (in category 'object access primitives') ----- primitiveSlotAt "Answer a slot in an object. This numbers all slots from 1, ignoring the distinction between named and indexed inst vars. In objects with both named and indexed inst vars, the named inst vars preceed the indexed ones. In non-object indexed objects (objects that contain bits, not object references) this primitive answers the raw integral value at each slot. e.g. for Strings it answers the character code, not the Character object at each slot." | index rcvr fmt numSlots | index := self stackTop. rcvr := self stackValue: 1. (objectMemory isIntegerObject: index) ifFalse: [^self primitiveFailFor: PrimErrBadArgument]. (objectMemory isImmediate: rcvr) ifTrue: [^self primitiveFailFor: PrimErrBadReceiver]. fmt := objectMemory formatOf: rcvr. index := (objectMemory integerValueOf: index) - 1.
fmt <= objectMemory lastPointerFormat ifTrue: [numSlots := objectMemory numSlotsOf: rcvr. (self asUnsigned: index) < numSlots ifTrue: [self pop: argumentCount + 1 thenPush: (objectMemory fetchPointer: index ofObject: rcvr). ^0]. ^self primitiveFailFor: PrimErrBadIndex].
fmt >= objectMemory firstByteFormat ifTrue: [fmt >= objectMemory firstCompiledMethodFormat ifTrue: [^self primitiveFailFor: PrimErrUnsupported].
numSlots := objectMemory numBytesOfBytes: rcvr.
numSlots := objectMemory numBytesOf: rcvr.
(self asUnsigned: index) < numSlots ifTrue: [self pop: argumentCount + 1 thenPushInteger: (objectMemory fetchByte: index ofObject: rcvr). ^0]. ^self primitiveFailFor: PrimErrBadIndex].
(objectMemory hasSpurMemoryManagerAPI and: [fmt >= objectMemory firstShortFormat]) ifTrue: [numSlots := objectMemory num16BitUnitsOf: rcvr. (self asUnsigned: index) < numSlots ifTrue: [self pop: argumentCount + 1 thenPushInteger: (objectMemory fetchShort16: index ofObject: rcvr). ^0]. ^self primitiveFailFor: PrimErrBadIndex].
fmt = objectMemory sixtyFourBitIndexableFormat ifTrue: [numSlots := objectMemory num64BitUnitsOf: rcvr. (self asUnsigned: index) < numSlots ifTrue: [self pop: argumentCount + 1 thenPush: (self positive64BitIntegerFor: (objectMemory fetchLong64: index ofObject: rcvr)). ^0]. ^self primitiveFailFor: PrimErrBadIndex].
fmt >= objectMemory firstLongFormat ifTrue: [numSlots := objectMemory num32BitUnitsOf: rcvr. (self asUnsigned: index) < numSlots ifTrue: [self pop: argumentCount + 1 thenPush: (objectMemory bytesPerOop = 8 ifTrue: [objectMemory integerObjectOf: (objectMemory fetchLong32: index ofObject: rcvr)] ifFalse: [self positive32BitIntegerFor: (objectMemory fetchLong32: index ofObject: rcvr)]). ^0]. ^self primitiveFailFor: PrimErrBadIndex].
^self primitiveFailFor: PrimErrBadReceiver!
Item was changed: ----- Method: InterpreterPrimitives>>primitiveSlotAtPut (in category 'object access primitives') ----- primitiveSlotAtPut "Assign a slot in an object. This numbers all slots from 1, ignoring the distinction between named and indexed inst vars. In objects with both named and indexed inst vars, the named inst vars preceed the indexed ones. In non-object indexed objects (objects that contain bits, not object references) this primitive assigns a raw integral value at each slot." | newValue index rcvr fmt numSlots value | newValue := self stackTop. index := self stackValue: 1. rcvr := self stackValue: 2. (objectMemory isIntegerObject: index) ifFalse: [^self primitiveFailFor: PrimErrBadArgument]. (objectMemory isImmediate: rcvr) ifTrue: [^self primitiveFailFor: PrimErrBadReceiver]. fmt := objectMemory formatOf: rcvr. index := (objectMemory integerValueOf: index) - 1.
fmt <= objectMemory lastPointerFormat ifTrue: [numSlots := objectMemory numSlotsOf: rcvr. (self asUnsigned: index) < numSlots ifTrue: [objectMemory storePointer: index ofObject: rcvr withValue: newValue. self pop: argumentCount + 1 thenPush: newValue. ^0]. ^self primitiveFailFor: PrimErrBadIndex].
value := self positiveMachineIntegerValueOf: newValue. self failed ifTrue: [primFailCode := PrimErrBadArgument. ^0].
fmt >= objectMemory firstByteFormat ifTrue: [fmt >= objectMemory firstCompiledMethodFormat ifTrue: [^self primitiveFailFor: PrimErrUnsupported]. (self asUnsigned: value) > 16rFF ifTrue: [^self primitiveFailFor: PrimErrBadArgument].
numSlots := objectMemory numBytesOfBytes: rcvr.
numSlots := objectMemory numBytesOf: rcvr.
(self asUnsigned: index) < numSlots ifTrue: [objectMemory storeByte: index ofObject: rcvr withValue: value. self pop: argumentCount + 1 thenPush: newValue. ^0]. ^self primitiveFailFor: PrimErrBadIndex].
(objectMemory hasSpurMemoryManagerAPI and: [fmt >= objectMemory firstShortFormat]) ifTrue: [(self asUnsigned: value) > 16rFFFF ifTrue: [^self primitiveFailFor: PrimErrBadArgument]. numSlots := objectMemory num16BitUnitsOf: rcvr. (self asUnsigned: index) < numSlots ifTrue: [objectMemory storeShort16: index ofObject: rcvr withValue: value. self pop: argumentCount + 1 thenPush: newValue. ^0]. ^self primitiveFailFor: PrimErrBadIndex].
(objectMemory bytesPerOop = 8 and: [fmt = objectMemory sixtyFourBitIndexableFormat]) ifTrue: [numSlots := objectMemory num64BitUnitsOf: rcvr. (self asUnsigned: index) < numSlots ifTrue: [objectMemory storeLong64: index ofObject: rcvr withValue: value. self pop: argumentCount + 1 thenPush: newValue. ^0]. ^self primitiveFailFor: PrimErrBadIndex].
fmt >= objectMemory firstLongFormat ifTrue: [(objectMemory wordSize > 4 and: [(self asUnsigned: value) > 16rFFFFFFFF]) ifTrue: [^self primitiveFailFor: PrimErrBadArgument]. numSlots := objectMemory num32BitUnitsOf: rcvr. (self asUnsigned: index) < numSlots ifTrue: [objectMemory storeLong32: index ofObject: rcvr withValue: value. self pop: argumentCount + 1 thenPush: newValue. ^0]. ^self primitiveFailFor: PrimErrBadIndex].
^self primitiveFailFor: PrimErrBadReceiver!
Item was changed: ----- Method: InterpreterPrimitives>>signed32BitValueOf: (in category 'primitive support') ----- signed32BitValueOf: oop "Convert the given object into an integer value. The object may be either a positive SmallInteger or a four-byte LargeInteger." | value negative ok | <inline: false> <returnTypeC: #int> <var: #value type: #int> (objectMemory isIntegerObject: oop) ifTrue: [^objectMemory integerValueOf: oop].
(objectMemory isNonIntegerImmediate: oop) ifTrue:
[self primitiveFail.
^0].
[^self primitiveFail].
ok := objectMemory isClassOfNonImm: oop equalTo: (objectMemory splObj: ClassLargePositiveInteger) compactClassIndex: ClassLargePositiveIntegerCompactIndex. ok ifTrue: [negative := false] ifFalse: [negative := true. ok := objectMemory isClassOfNonImm: oop equalTo: (objectMemory splObj: ClassLargeNegativeInteger) compactClassIndex: ClassLargeNegativeIntegerCompactIndex.
ok ifFalse:
[self primitiveFail.
^0]].
- (objectMemory numBytesOfBytes: oop) > 4 ifTrue:
ok ifFalse: [^self primitiveFail]].
- (objectMemory numBytesOf: oop) > 4 ifTrue: [^self primitiveFail].
- value := self cppIf: VMBIGENDIAN
ifTrue:
[ (objectMemory fetchByte: 0 ofObject: oop) +
((objectMemory fetchByte: 1 ofObject: oop) << 8) +
((objectMemory fetchByte: 2 ofObject: oop) << 16) +
((objectMemory fetchByte: 3 ofObject: oop) << 24)]
ifFalse:
[objectMemory fetchLong32: 0 ofObject: oop].
- value := (objectMemory fetchByte: 0 ofObject: oop) +
((objectMemory fetchByte: 1 ofObject: oop) << 8) +
((objectMemory fetchByte: 2 ofObject: oop) << 16) +
self cCode: [] inSmalltalk: [(value anyMask: 16r80000000) ifTrue: [value := value - 16r100000000]]. "Filter out values out of range for the signed interpretation such as 16rFFFFFFFF (positive w/ bit 32 set) and -16rFFFFFFFF (negative w/ bit 32 set). Since the sign is implicit in the class we require that the high bit of the magnitude is not set which is a simple test here. Note that we have to handle the most negative 32-bit value -2147483648 specially." value < 0 ifTrue: [self assert: (self sizeof: value) == 4. "Don't fail for -16r80000000/-2147483648 Alas the simple (negative and: [value - 1 > 0]) isn't adequate since in C the result of signed integer overflow is undefined and hence under optimization this may fail. The shift, however, is well-defined." (negative and: [0 = (self cCode: [value << 1] inSmalltalk: [value << 1 bitAnd: (1 << 32) - 1])]) ifTrue: [^value].((objectMemory fetchByte: 3 ofObject: oop) << 24).
self primitiveFail.
^0].
^negative ifTrue: [0 - value] ifFalse: [value]!^self primitiveFail].
Item was changed: ----- Method: InterpreterPrimitives>>signed64BitValueOf: (in category 'primitive support') ----- signed64BitValueOf: oop "Convert the given object into an integer value. The object may be either a positive SmallInteger or a eight-byte LargeInteger." | sz value negative ok | <inline: false> <returnTypeC: #sqLong> <var: #value type: #sqLong> (objectMemory isIntegerObject: oop) ifTrue: [^self cCoerce: (objectMemory integerValueOf: oop) to: #sqLong].
(objectMemory isNonIntegerImmediate: oop) ifTrue:
[self primitiveFail.
^0].
[^self primitiveFail].
ok := objectMemory isClassOfNonImm: oop equalTo: (objectMemory splObj: ClassLargePositiveInteger) compactClassIndex: ClassLargePositiveIntegerCompactIndex. ok ifTrue: [negative := false] ifFalse: [negative := true. ok := objectMemory isClassOfNonImm: oop equalTo: (objectMemory splObj: ClassLargeNegativeInteger) compactClassIndex: ClassLargeNegativeIntegerCompactIndex.
ok ifFalse:
[self primitiveFail.
^0]].
- sz := objectMemory numBytesOfBytes: oop.
ok ifFalse: [^self primitiveFail]].
- sz := objectMemory numBytesOf: oop. sz > (self sizeof: #sqLong) ifTrue:
[self primitiveFail.
^0].
[^self primitiveFail].
- self cppIf: VMBIGENDIAN
ifTrue:
[value := objectMemory fetchByte: sz - 1 ofObject: oop.
sz - 2 to: 0 by: -1 do: [:i |
value := value << 8 + (objectMemory fetchByte: i ofObject: oop)]]
ifFalse:
[value := sz > 4
ifTrue: [objectMemory fetchLong64: 0 ofObject: oop]
ifFalse: [objectMemory fetchLong32: 0 ofObject: oop]].
- value := 0.
- 0 to: sz - 1 do: [:i |
"Filter out values out of range for the signed interpretation such as 16rFFFFFFFF... (positive w/ bit 64 set) and -16rFFFFFFFF... (negative w/ bit 64 set). Since the sign is implicit in the class we require that the high bit of the magnitude is not set which is a simple test here. Note that we have to handle the most negative 64-bit value -9223372036854775808 specially." self cCode: [] inSmalltalk: [(value anyMask: 16r8000000000000000) ifTrue: [value := value - 16r10000000000000000]]. value < 0 ifTrue: [self cCode: [self assert: (self sizeof: value) == 8. self assert: (self sizeof: value << 1) == 8]. "Don't fail for -9223372036854775808/-16r8000000000000000. Alas the simple (negative and: [value - 1 > 0]) isn't adequate since in C the result of signed integer overflow is undefined and hence under optimization this may fail. The shift, however, is well-defined." (negative and: [0 = (self cCode: [value << 1] inSmalltalk: [value << 1 bitAnd: (1 << 64) - 1])]) ifTrue: [^value].value := value + ((self cCoerce: (objectMemory fetchByte: i ofObject: oop) to: #sqLong) << (i*8))].
self primitiveFail.
^0].
^negative ifTrue:[0 - value] ifFalse:[value]!^self primitiveFail].
Item was changed: ----- Method: InterpreterPrimitives>>signedMachineIntegerValueOf: (in category 'primitive support') ----- signedMachineIntegerValueOf: oop "Answer a signed value of an integer up to the size of a machine word. The object may be either a positive SmallInteger or a LargeInteger of size <= word size." <returnTypeC: #'long'> | negative ok bs value bits | <var: #value type: #long> (objectMemory isIntegerObject: oop) ifTrue: [^objectMemory integerValueOf: oop].
(objectMemory isNonIntegerImmediate: oop) ifTrue: [^self primitiveFail].
ok := objectMemory isClassOfNonImm: oop equalTo: (objectMemory splObj: ClassLargePositiveInteger) compactClassIndex: ClassLargePositiveIntegerCompactIndex. ok ifTrue: [negative := false] ifFalse: [negative := true. ok := objectMemory isClassOfNonImm: oop equalTo: (objectMemory splObj: ClassLargeNegativeInteger) compactClassIndex: ClassLargeNegativeIntegerCompactIndex. ok ifFalse: [^self primitiveFail]]. bs := objectMemory numBytesOf: oop. bs > (self sizeof: #'unsigned long') ifTrue: [^self primitiveFail].
((self sizeof: #'unsigned long') = 8
- and: [bs > 4]) ifTrue:
[value := self cppIf: VMBIGENDIAN
ifTrue:
[ (objectMemory fetchByte: 0 ofObject: oop)
+ ((objectMemory fetchByte: 1 ofObject: oop) << 8)
+ ((objectMemory fetchByte: 2 ofObject: oop) << 16)
+ ((objectMemory fetchByte: 3 ofObject: oop) << 24)
+ ((objectMemory fetchByte: 4 ofObject: oop) << 32)
+ ((objectMemory fetchByte: 5 ofObject: oop) << 40)
+ ((objectMemory fetchByte: 6 ofObject: oop) << 48)
+ ((objectMemory fetchByte: 7 ofObject: oop) << 56)]
ifFalse:
[objectMemory fetchLong64: 0 ofObject: oop]]
and: [bs > 4])
ifTrue:
[value := (objectMemory fetchByte: 0 ofObject: oop)
+ ((objectMemory fetchByte: 1 ofObject: oop) << 8)
+ ((objectMemory fetchByte: 2 ofObject: oop) << 16)
+ ((objectMemory fetchByte: 3 ofObject: oop) << 24)
+ ((objectMemory fetchByte: 4 ofObject: oop) << 32)
+ ((objectMemory fetchByte: 5 ofObject: oop) << 40)
+ ((objectMemory fetchByte: 6 ofObject: oop) << 48)
ifFalse:+ ((objectMemory fetchByte: 7 ofObject: oop) << 56)]
[value := self cppIf: VMBIGENDIAN
ifTrue:
[ (objectMemory fetchByte: 0 ofObject: oop)
+ ((objectMemory fetchByte: 1 ofObject: oop) << 8)
+ ((objectMemory fetchByte: 2 ofObject: oop) << 16)
+ ((objectMemory fetchByte: 3 ofObject: oop) << 24)]
ifFalse:
[objectMemory fetchLong32: 0 ofObject: oop]].
[value := (objectMemory fetchByte: 0 ofObject: oop)
+ ((objectMemory fetchByte: 1 ofObject: oop) << 8)
+ ((objectMemory fetchByte: 2 ofObject: oop) << 16)
+ ((objectMemory fetchByte: 3 ofObject: oop) << 24)].
self cCode: [] inSmalltalk: [bits := (self sizeof: #long) * 8. (value bitShift: 1 - bits) > 0 ifTrue: [value := value - (1 bitShift: bits)]]. value < 0 ifTrue: ["Don't fail for -16r80000000[00000000]. Alas the simple (negative and: [value - 1 > 0]) isn't adequate since in C the result of signed integer overflow is undefined and hence under optimization this may fail. The shift, however, is well-defined." (negative and: [0 = (self cCode: [value << 1] inSmalltalk: [value << 1 bitAnd: (1 << bits) - 1])]) ifTrue: [^value]. ^self primitiveFail]. ^negative ifTrue: [0 - value] ifFalse: [value]!
Item was changed: ----- Method: LargeIntegersPlugin>>cDigitLengthOfCSI: (in category 'C core util') ----- cDigitLengthOfCSI: csi "Answer the number of bytes required to represent the value of a CSmallInteger." csi >= 0 ifTrue: [csi < 256 ifTrue: [^1]. csi < 65536 ifTrue: [^2]. csi < 16777216 ifTrue: [^3].
self cppIf: interpreterProxy bytesPerOop = 4
csi > -256 ifTrue: [^1]. csi > -65536 ifTrue: [^2]. csi > -16777216 ifTrue: [^3].interpreterProxy bytesPerOop = 4 ifTrue: [^4] ifFalse: [csi < 4294967296 ifTrue: [^4]. csi < 1099511627776 ifTrue: [^5]. csi < 281474976710656 ifTrue: [^6]. csi < 72057594037927936 ifTrue: [^7]. ^8]].
- self cppIf: interpreterProxy bytesPerOop = 4
- interpreterProxy bytesPerOop = 4 ifTrue: [^4] ifFalse: [csi > -4294967296 ifTrue: [^4]. csi > -1099511627776 ifTrue: [^5]. csi > -281474976710656 ifTrue: [^6]. csi > -72057594037927936 ifTrue: [^7]. ^8]!
Item was changed: ----- Method: LargeIntegersPlugin>>cDigitOfCSI:at: (in category 'C core util') ----- cDigitOfCSI: csi at: ix "Answer the value of an indexable field in the receiver. LargePositiveInteger uses bytes of base two number, and each is a 'digit' base 256." "ST indexed!!"
- ix < 1 ifTrue: [interpreterProxy primitiveFail. ^0].
- ix > interpreterProxy bytesPerOop ifTrue: [^0]. ^self cCode: [(csi < 0 ifTrue: [0 - csi] ifFalse: [csi]) >> (ix - 1 * 8) bitAnd: 255] inSmalltalk: [csi digitAt: ix]!
Item was added:
- ----- Method: LargeIntegersPlugin>>digitLengthOfNonImmediate: (in category 'util') -----
- digitLengthOfNonImmediate: oop
- <inline: true>
- ^self byteSizeOfBytes: oop!
Item was changed: ----- Method: LargeIntegersPlugin>>digitOf:at: (in category 'util') ----- digitOf: oop at: ix
- (interpreterProxy isIntegerObject: oop) ifTrue:
[ix < 1 ifTrue: [interpreterProxy primitiveFail. ^0].
ix > interpreterProxy bytesPerOop ifTrue: [^0].
^self cDigitOfCSI: (interpreterProxy integerValueOf: oop) at: ix].
- ^self digitOfBytes: oop at: ix!
- (interpreterProxy isIntegerObject: oop)
ifTrue: [^ self cDigitOfCSI: (interpreterProxy integerValueOf: oop)
at: ix]
ifFalse: [^ self digitOfBytes: oop at: ix]!
Item was changed: ----- Method: LargeIntegersPlugin>>isNormalized: (in category 'oop functions') ----- isNormalized: anInteger
- | len class positive pointer |
- <var: #pointer type: #'unsigned char *'>
- | len maxVal minVal sLen class positive | (interpreterProxy isIntegerObject: anInteger) ifTrue:
[^true].
class := interpreterProxy fetchClassOf: anInteger. (positive := class = interpreterProxy classLargePositiveInteger) ifFalse: [class = interpreterProxy classLargeNegativeInteger ifFalse: [interpreterProxy primitiveFailFor: PrimErrBadArgument. ^false]].[^ true].
- pointer := interpreterProxy cCoerce: (interpreterProxy firstIndexableField: anInteger) to: #'unsigned char *'. "Check for leading zero of LargeInteger"
- len := self digitLengthOfNonImmediate: anInteger.
- (len = 0 or: [(pointer at: len - 1) = 0]) ifTrue:
[^false].
- len := self digitLength: anInteger.
- len = 0 ifTrue:
[^ false].
- (self unsafeByteOf: anInteger at: len) = 0 ifTrue:
"no leading zero, now check if anInteger is in SmallInteger range or not"[^ false].
- sLen := interpreterProxy bytesPerOop. "maximal digitLength of aSmallInteger"
- len ~= interpreterProxy bytesPerOop ifTrue:
[^len > interpreterProxy bytesPerOop].
- positive ifTrue: "all bytes of but the highest one are just FF's"
[^(pointer at: interpreterProxy bytesPerOop - 1)
> (self cDigitOfCSI: interpreterProxy maxSmallInteger at: interpreterProxy bytesPerOop)].
- "all bytes of but the highest one are just 00's"
- (pointer at: interpreterProxy bytesPerOop - 1)
< (self cDigitOfCSI: interpreterProxy minSmallInteger at: interpreterProxy bytesPerOop) ifTrue:
[^false].
- "if just one digit differs, then anInteger < minval (the corresponding digit byte is greater!!)
and therefore a LargeNegativeInteger"
- 0 to: interpreterProxy bytesPerOop - 1 do:
[:ix |
(pointer at: ix) = (self cDigitOfCSI: interpreterProxy minSmallInteger at: ix + 1) ifFalse:
[^true]].
- ^false!
- len > sLen ifTrue:
[^ true].
- len < sLen ifTrue:
[^ false].
- "len = sLen"
- positive
ifTrue: [maxVal := interpreterProxy maxSmallInteger. "SmallInteger maxVal"
"all bytes of maxVal but the highest one are just FF's"
^ (self unsafeByteOf: anInteger at: sLen)
> (self cDigitOfCSI: maxVal at: sLen)]
ifFalse: [minVal := interpreterProxy minSmallInteger. "SmallInteger minVal"
"all bytes of minVal but the highest one are just 00's"
(self unsafeByteOf: anInteger at: sLen) < (self cDigitOfCSI: minVal at: sLen) ifTrue:
[^ false].
"if just one digit differs, then anInteger < minval (the corresponding digit byte is greater!!)
and therefore a LargeNegativeInteger"
1
to: sLen
do: [:ix |
(self unsafeByteOf: anInteger at: ix) = (self cDigitOfCSI: minVal at: ix) ifFalse:
[^ true]]].
- ^ false!
Item was changed: ----- Method: LargeIntegersPlugin>>normalizeNegative: (in category 'oop functions') ----- normalizeNegative: aLargeNegativeInteger "Check for leading zeroes and return shortened copy if so." "First establish len = significant length."
- | sLen val len oldLen pointer |
- len := oldLen := self digitLengthOfNonImmediate: aLargeNegativeInteger.
- pointer := interpreterProxy
cCoerce: (interpreterProxy firstIndexableField: aLargeNegativeInteger)
to: #'unsigned char *'.
- [len > 0 and: [(pointer at: len - 1) = 0]] whileTrue:
[len := len - 1].
- | sLen val len oldLen minVal |
- len := oldLen := self digitLength: aLargeNegativeInteger.
- [len ~= 0 and: [(self unsafeByteOf: aLargeNegativeInteger at: len) = 0]]
len = 0 ifTrue: [^ 0 asOop: SmallInteger].whileTrue: [len := len - 1].
- "Now check if in SmallInteger range" sLen := interpreterProxy minSmallInteger < -16r40000000 ifTrue: [8]
ifFalse: [4]. "SmallInteger digitLength"
- len <= sLen ifTrue:
[(len < sLen
or: [(pointer at: sLen - 1)
< (self cDigitOfCSI: interpreterProxy minSmallInteger at: sLen)]) ifTrue: "interpreterProxy minSmallInteger lastDigit"
["If high digit less, then can be small"
val := 0 - (pointer at: (len := len - 1)).
len - 1 to: 0 by: -1 do:
[:i | val := val * 256 - (pointer at: i)].
^val asOop: SmallInteger].
1 to: sLen do:
[:i | | byte | "If all digits same, then = minSmallInteger (sr: minSmallInteger digits 1 to sLen - 1 are 0)"
byte := i > len ifTrue: [0] ifFalse: [pointer at: i - 1].
byte ~= (self cDigitOfCSI: interpreterProxy minSmallInteger at: i) ifTrue: "Not so; return self shortened"
[len < oldLen ifTrue: "^ self growto: len"
[^self bytes: aLargeNegativeInteger growTo: len].
^aLargeNegativeInteger]].
^interpreterProxy minSmallInteger asOop: SmallInteger].
ifFalse: [4]. "SmallInteger minVal digitLength"
- len <= sLen
ifTrue:
["SmallInteger minVal"
minVal := interpreterProxy minSmallInteger.
(len < sLen
or: [(self digitOfBytes: aLargeNegativeInteger at: sLen) < (self cDigitOfCSI: minVal at: sLen)
"minVal lastDigit"])
ifTrue:
["If high digit less, then can be small"
val := 0.
len to: 1 by: -1 do:
[:i | val := val * 256 - (self unsafeByteOf: aLargeNegativeInteger at: i)].
^ val asOop: SmallInteger].
1 to: sLen do: [:i | "If all digits same, then = minVal (sr: minVal digits 1 to 3 are 0)"
(self digitOfBytes: aLargeNegativeInteger at: i) = (self cDigitOfCSI: minVal at: i)
ifFalse: "Not so; return self shortened"
[len < oldLen
ifTrue: "^ self growto: len"
[^ self bytes: aLargeNegativeInteger growTo: len]
ifFalse: [^ aLargeNegativeInteger]]].
"Return self, or a shortened copy"^ minVal asOop: SmallInteger].
- len < oldLen ifTrue: "^ self growto: len"
[^self bytes: aLargeNegativeInteger growTo: len].
- ^aLargeNegativeInteger!
- len < oldLen
ifTrue: "^ self growto: len"
[^ self bytes: aLargeNegativeInteger growTo: len]
ifFalse: [^ aLargeNegativeInteger]!
Item was changed: ----- Method: LargeIntegersPlugin>>normalizePositive: (in category 'oop functions') ----- normalizePositive: aLargePositiveInteger "Check for leading zeroes and return shortened copy if so." "First establish len = significant length."
- | sLen val len oldLen pointer |
- <var: #pointer type: #'unsigned char *'>
- len := oldLen := self digitLengthOfNonImmediate: aLargePositiveInteger.
- pointer := interpreterProxy
cCoerce: (interpreterProxy firstIndexableField: aLargePositiveInteger)
to: #'unsigned char *'.
- [len > 0 and: [(pointer at: len - 1) = 0]] whileTrue:
[len := len - 1].
- | sLen val len oldLen |
- len := oldLen := self digitLength: aLargePositiveInteger.
- [len ~= 0 and: [(self unsafeByteOf: aLargePositiveInteger at: len)
= 0]]
len = 0 ifTrue: [^ 0 asOop: SmallInteger].whileTrue: [len := len - 1].
- "Now check if in SmallInteger range" sLen := interpreterProxy maxSmallInteger > 16r3FFFFFFF "SmallInteger maxVal digitLength." ifTrue: [8] ifFalse: [4]. (len <= sLen
and: [(pointer at: sLen - 1) <= (self cDigitOfCSI: interpreterProxy maxSmallInteger at: sLen)]) ifTrue:
["If so, return its SmallInt value"
val := pointer at: (len := len - 1).
len - 1 to: 0 by: -1 do:
[:i | val := val * 256 + (pointer at: i)].
^val asOop: SmallInteger].
and: [(self digitOfBytes: aLargePositiveInteger at: sLen)
<= (self cDigitOfCSI: interpreterProxy maxSmallInteger at: sLen)
"SmallInteger maxVal"])
ifTrue:
["If so, return its SmallInt value"
val := 0.
len
to: 1
by: -1
do: [:i | val := val * 256 + (self unsafeByteOf: aLargePositiveInteger at: i)].
"Return self, or a shortened copy"^ val asOop: SmallInteger].
- len < oldLen ifTrue: "^ self growto: len"
[^self bytes: aLargePositiveInteger growTo: len].
- ^aLargePositiveInteger!
- len < oldLen
ifTrue: ["^ self growto: len"
^ self bytes: aLargePositiveInteger growTo: len]
ifFalse: [^ aLargePositiveInteger]!
Item was changed: ----- Method: LargeIntegersPlugin>>unsafeByteOf:at: (in category 'util') -----
- unsafeByteOf: bytesObj at: ix
- "Argument bytesObj must not be aSmallInteger!!"
- unsafeByteOf: bytesOop at: ix
- "Argument bytesOop must not be aSmallInteger!!" <inline: true>
- ^(interpreterProxy cCoerce: (interpreterProxy firstIndexableField: bytesObj) to: #'unsigned char *') at: ix - 1!
- | pointer |
- <var: #pointer type: #'unsigned char *'>
- ^(pointer := interpreterProxy firstIndexableField: bytesOop) at: ix - 1!
Item was added:
- ----- Method: ObjectMemory>>numBytesOfBytes: (in category 'object access') -----
- numBytesOfBytes: objOop
- "Answer the number of indexable bytes in the given non-immediate byte-indexable object."
<api>
- | header sz fmt |
- header := self baseHeader: objOop.
- sz := (header bitAnd: TypeMask) = HeaderTypeSizeAndClass
ifTrue: [(self sizeHeader: objOop) bitAnd: AllButTypeMask]
ifFalse: [header bitAnd: SizeMask].
- fmt := self formatOfHeader: header.
- self assert: fmt >= self firstByteFormat.
- ^(sz - self baseHeaderSize) - (fmt bitAnd: 3)!
Item was changed: ----- Method: SpurMemoryManager>>isClassOfNonImm:equalTo:compactClassIndex: (in category 'object access') ----- isClassOfNonImm: oop equalTo: classOop compactClassIndex: knownClassIndex "Answer if the given (non-immediate) object is an instance of the given class that may have a knownClassIndex (if knownClassIndex is non-zero). This method is misnamed given SPur's architecture (where all objects have ``compact'' class indices) but is so-named for compatibility with ObjectMemory. N.B. Inlining and/or compiler optimization should result in classOop not being accessed if knownClassIndex is non-zero."
| ccIndex | <inline: true> self assert: (self isImmediate: oop) not.
ccIndex := self classIndexOf: oop.
- knownClassIndex ~= 0
ifTrue:
[^knownClassIndex = ccIndex]
ifFalse:
[^classOop = (self classAtIndex: ccIndex)]!
- knownClassIndex ~= 0 ifTrue:
[^knownClassIndex = ccIndex].
- ^classOop = (self classAtIndex: ccIndex)!
Item was added:
- ----- Method: SpurMemoryManager>>numBytesOfBytes: (in category 'object access') -----
- numBytesOfBytes: objOop
- "Answer the number of indexable bytes in the given non-immediate byte-indexable object."
- | fmt |
- <inline: true>
- fmt := self formatOf: objOop.
- self assert: fmt >= self firstByteFormat.
- ^(self numSlotsOf: objOop) << self shiftForWord - (fmt bitAnd: 7)!
Item was removed:
- ----- Method: StackInterpreter>>checkBooleanResult: (in category 'arithmetic primitive support') -----
- checkBooleanResult: result
- self successful
ifTrue: [self pushBool: result]
ifFalse: [self unPop: 2]!
Item was removed:
- ----- Method: StackInterpreter>>compare31or32Bits:equal: (in category 'arithmetic primitive support') -----
- compare31or32Bits: obj1 equal: obj2
- "May set success to false"
- "First compare two ST integers..."
- ((objectMemory isIntegerObject: obj1)
and: [objectMemory isIntegerObject: obj2])
ifTrue: [^ obj1 = obj2].
- "Now compare, assuming positive integers, but setting fail if not"
- ^ (self positive32BitValueOf: obj1) = (self positive32BitValueOf: obj2)!
Item was removed:
- ----- Method: StackInterpreter>>popInteger (in category 'internal interpreter access') -----
- popInteger
- "returns 0 if the stackTop was not an integer value, plus sets successFlag false"
- | integerPointer |
- integerPointer := self popStack.
- ^self checkedIntegerValueOf: integerPointer!
Item was changed: ----- Method: StackInterpreter>>validInstructionPointer:inMethod:framePointer: (in category 'debug support') ----- validInstructionPointer: theInstrPointer inMethod: aMethod framePointer: fp <var: #theInstrPointer type: #usqInt> <var: #aMethod type: #usqInt> <var: #fp type: #'char *'> "Note that we accept anInstrPointer pointing to a callPrimitiveBytecode at the start of a method that contains a primitive. This because methods like Context(Part)>>reset have to be updated to skip the callPrimtiive bytecode otherwise." "-1 for pre-increment in fetchNextBytecode" ^theInstrPointer >= (aMethod + (objectMemory lastPointerOf: aMethod) + objectMemory bytesPerOop - 1)
and: [theInstrPointer < (aMethod + (objectMemory numBytesOfBytes: aMethod) + objectMemory baseHeaderSize - 1)]!
and: [theInstrPointer < (aMethod + (objectMemory numBytesOf: aMethod) + objectMemory baseHeaderSize - 1)]!
Item was changed: ----- Method: StackInterpreterPrimitives>>primitiveSlotAt (in category 'object access primitives') ----- primitiveSlotAt "Answer a slot in an object. This numbers all slots from 1, ignoring the distinction between named and indexed inst vars. In objects with both named and indexed inst vars, the named inst vars preceed the indexed ones. In non-object indexed objects (objects that contain bits, not object references) this primitive answers the raw integral value at each slot. e.g. for Strings it answers the character code, not the Character object at each slot." | index rcvr fmt numSlots | index := self stackTop. rcvr := self stackValue: 1. (objectMemory isIntegerObject: index) ifFalse: [^self primitiveFailFor: PrimErrBadArgument]. (objectMemory isImmediate: rcvr) ifTrue: [^self primitiveFailFor: PrimErrBadReceiver]. fmt := objectMemory formatOf: rcvr. index := (objectMemory integerValueOf: index) - 1.
fmt <= objectMemory lastPointerFormat ifTrue: [numSlots := objectMemory numSlotsOf: rcvr. (self asUnsigned: index) < numSlots ifTrue: [| value numLiveSlots | (objectMemory isContextNonImm: rcvr) ifTrue: [self externalWriteBackHeadFramePointers. numLiveSlots := (self stackPointerForMaybeMarriedContext: rcvr) + CtxtTempFrameStart. value := (self asUnsigned: index) < numLiveSlots ifTrue: [self externalInstVar: index ofContext: rcvr] ifFalse: [objectMemory nilObject]] ifFalse: [value := objectMemory fetchPointer: index ofObject: rcvr]. self pop: argumentCount + 1 thenPush: value. ^0]. ^self primitiveFailFor: PrimErrBadIndex].
fmt >= objectMemory firstByteFormat ifTrue: [fmt >= objectMemory firstCompiledMethodFormat ifTrue: [^self primitiveFailFor: PrimErrUnsupported].
numSlots := objectMemory numBytesOfBytes: rcvr.
numSlots := objectMemory numBytesOf: rcvr.
(self asUnsigned: index) < numSlots ifTrue: [self pop: argumentCount + 1 thenPushInteger: (objectMemory fetchByte: index ofObject: rcvr). ^0]. ^self primitiveFailFor: PrimErrBadIndex].
(objectMemory hasSpurMemoryManagerAPI and: [fmt >= objectMemory firstShortFormat]) ifTrue: [numSlots := objectMemory num16BitUnitsOf: rcvr. (self asUnsigned: index) < numSlots ifTrue: [self pop: argumentCount + 1 thenPushInteger: (objectMemory fetchShort16: index ofObject: rcvr). ^0]. ^self primitiveFailFor: PrimErrBadIndex].
fmt = objectMemory sixtyFourBitIndexableFormat ifTrue: [numSlots := objectMemory num64BitUnitsOf: rcvr. (self asUnsigned: index) < numSlots ifTrue: [self pop: argumentCount + 1 thenPush: (self positive64BitIntegerFor: (objectMemory fetchLong64: index ofObject: rcvr)). ^0]. ^self primitiveFailFor: PrimErrBadIndex].
fmt >= objectMemory firstLongFormat ifTrue: [numSlots := objectMemory num32BitUnitsOf: rcvr. (self asUnsigned: index) < numSlots ifTrue: [self pop: argumentCount + 1 thenPush: (self positive32BitIntegerFor: (objectMemory fetchLong32: index ofObject: rcvr)). ^0]. ^self primitiveFailFor: PrimErrBadIndex].
^self primitiveFailFor: PrimErrBadReceiver!
Item was changed: ----- Method: StackInterpreterPrimitives>>primitiveSlotAtPut (in category 'object access primitives') ----- primitiveSlotAtPut "Assign a slot in an object. This numbers all slots from 1, ignoring the distinction between named and indexed inst vars. In objects with both named and indexed inst vars, the named inst vars preceed the indexed ones. In non-object indexed objects (objects that contain bits, not object references) this primitive assigns a raw integral value at each slot." | newValue index rcvr fmt numSlots value | newValue := self stackTop. index := self stackValue: 1. rcvr := self stackValue: 2. (objectMemory isIntegerObject: index) ifFalse: [^self primitiveFailFor: PrimErrBadArgument]. (objectMemory isImmediate: rcvr) ifTrue: [^self primitiveFailFor: PrimErrBadReceiver]. fmt := objectMemory formatOf: rcvr. index := (objectMemory integerValueOf: index) - 1.
fmt <= objectMemory lastPointerFormat ifTrue: [numSlots := objectMemory numSlotsOf: rcvr. (self asUnsigned: index) < numSlots ifTrue: [(objectMemory isContextNonImm: rcvr) ifTrue: [self externalInstVar: index ofContext: rcvr put: newValue] ifFalse: [objectMemory storePointer: index ofObject: rcvr withValue: newValue]. self pop: argumentCount + 1 thenPush: newValue. ^0]. ^self primitiveFailFor: PrimErrBadIndex].
value := self positiveMachineIntegerValueOf: newValue. self failed ifTrue: [primFailCode := PrimErrBadArgument. ^0].
fmt >= objectMemory firstByteFormat ifTrue: [fmt >= objectMemory firstCompiledMethodFormat ifTrue: [^self primitiveFailFor: PrimErrUnsupported]. (self asUnsigned: value) > 16rFF ifTrue: [^self primitiveFailFor: PrimErrBadArgument].
numSlots := objectMemory numBytesOfBytes: rcvr.
numSlots := objectMemory numBytesOf: rcvr.
(self asUnsigned: index) < numSlots ifTrue: [objectMemory storeByte: index ofObject: rcvr withValue: value. self pop: argumentCount + 1 thenPush: newValue. ^0]. ^self primitiveFailFor: PrimErrBadIndex].
(objectMemory hasSpurMemoryManagerAPI and: [fmt >= objectMemory firstShortFormat]) ifTrue: [(self asUnsigned: value) > 16rFFFF ifTrue: [^self primitiveFailFor: PrimErrBadArgument]. numSlots := objectMemory num16BitUnitsOf: rcvr. (self asUnsigned: index) < numSlots ifTrue: [objectMemory storeShort16: index ofObject: rcvr withValue: value. self pop: argumentCount + 1 thenPush: newValue. ^0]. ^self primitiveFailFor: PrimErrBadIndex].
(objectMemory bytesPerOop = 8 and: [fmt = objectMemory sixtyFourBitIndexableFormat]) ifTrue: [numSlots := objectMemory num64BitUnitsOf: rcvr. (self asUnsigned: index) < numSlots ifTrue: [objectMemory storeLong64: index ofObject: rcvr withValue: value. self pop: argumentCount + 1 thenPush: newValue. ^0]. ^self primitiveFailFor: PrimErrBadIndex].
fmt >= objectMemory firstLongFormat ifTrue: [(objectMemory wordSize > 4 and: [(self asUnsigned: value) > 16rFFFFFFFF]) ifTrue: [^self primitiveFailFor: PrimErrBadArgument]. numSlots := objectMemory num32BitUnitsOf: rcvr. (self asUnsigned: index) < numSlots ifTrue: [objectMemory storeLong32: index ofObject: rcvr withValue: value. self pop: argumentCount + 1 thenPush: newValue. ^0]. ^self primitiveFailFor: PrimErrBadIndex].
^self primitiveFailFor: PrimErrBadReceiver!
On 12 Mar 2015, at 2:07 , Henrik Johansen henrik.s.johansen@veloxit.no wrote:
byteSizeOfBytes is mentioned in the commit comment, and referenced once in the source (LargeIntegerPlugin), but everywhere else it seems to be called numBytesOfBytes: (including the new method definition).
Cheers, Henry
Ah, I guess byteSizeOfBytes was added to the LargeIntegersPlugin in a previous commit I didn't read through... Which means there's nothing wrong technically, only the question why/ remark that its (if I've understood correctly) mirroring InterpreterPlugin implementation was given a different name.
Cheers, Henry
vm-dev@lists.squeakfoundation.org