[Vm-dev] VM Maker: VMMaker.oscog-eem.1087.mcz
Henrik Johansen
henrik.s.johansen at veloxit.no
Thu Mar 12 13:07:08 UTC 2015
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 at 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)])
> - 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]
> 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]!
>
> 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)])
> - and: [theIP < (methodObj + (objectMemory numBytesOf: methodObj) + objectMemory baseHeaderSize - 1)])
> l: ln.
> prevFrameWasCogged := false].
> theIP := (stackPages longAt: theFP + FoxCallerSavedIP) asUnsignedInteger.
> (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
> [theFP := callerFP].
> self assert: theIP = cogit ceBaseFrameReturnPC l: ln.
> ^true!
>
> 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 + ((self cCoerce: (objectMemory fetchByte: i ofObject: oop) to: #sqLong) << (i*8))].
> ^value!
>
> 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.
> - [sz := objectMemory numBytesOf: s.
> self clipboardWrite: sz From: s + objectMemory baseHeaderSize At: 0.
> self pop: 1]]
> 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]!
>
> 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) +
> - ((objectMemory fetchByte: 3 ofObject: oop) << 24).
> 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].
> + self primitiveFail.
> + ^0].
> - ^self primitiveFail].
> ^negative
> ifTrue: [0 - value]
> ifFalse: [value]!
>
> 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 |
> - value := value + ((self cCoerce: (objectMemory fetchByte: i ofObject: oop) to: #sqLong) << (i*8))].
> "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].
> + self primitiveFail.
> + ^0].
> - ^self primitiveFail].
> ^negative
> ifTrue:[0 - value]
> ifFalse:[value]!
>
> 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)
> - + ((objectMemory fetchByte: 7 ofObject: oop) << 56)]
> ifFalse:
> + [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
> - interpreterProxy bytesPerOop = 4
> ifTrue:
> [^4]
> ifFalse:
> [csi < 4294967296 ifTrue:
> [^4].
> csi < 1099511627776 ifTrue:
> [^5].
> csi < 281474976710656 ifTrue:
> [^6].
> csi < 72057594037927936 ifTrue:
> [^7].
> ^8]].
> csi > -256 ifTrue:
> [^1].
> csi > -65536 ifTrue:
> [^2].
> csi > -16777216 ifTrue:
> [^3].
> + 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].
> - [^ true].
> class := interpreterProxy fetchClassOf: anInteger.
> (positive := class = interpreterProxy classLargePositiveInteger) ifFalse:
> [class = interpreterProxy classLargeNegativeInteger ifFalse:
> [interpreterProxy primitiveFailFor: PrimErrBadArgument.
> ^false]].
> + 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:
> - [^ false].
> "no leading zero, now check if anInteger is in SmallInteger range or not"
> - 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]]
> - whileTrue: [len := len - 1].
> len = 0 ifTrue: [^ 0 asOop: SmallInteger].
> +
> "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]]].
> - ^ minVal asOop: SmallInteger].
> "Return self, or a shortened copy"
> + 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]]
> - whileTrue: [len := len - 1].
> len = 0 ifTrue: [^ 0 asOop: SmallInteger].
> +
> "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)].
> - ^ val asOop: SmallInteger].
> "Return self, or a shortened copy"
> + 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!
>
More information about the Vm-dev
mailing list