Vm-dev March 2016

vm-dev@lists.squeakfoundation.org

33 participants
139 discussions

About my short term goals
by Nicolas Cellier 20 Mar '16

20 Mar '16

Hi, I feel like I did not explain my short term goals. This lack of explanation may let my recent commit be viewed as gratuitous breakage. They are not. What I'm after is: - reduce the number of C Undefined Behaviours that we depend upon my own vm brand can be compiled without the -fwrapv workaround, it's doable. - eliminate ever more C compiler warnings Eliot did really a great job these last two years maybe we're not yet ready to compile with -Wall -Werror, but we are approaching - simplify the slang source when possible - connect the 32 bits limbs trick for accelerating large integer arithmetic About this last point, I'm now thinking about a different strategy for the hypothetical BIG-ENDIAN machines: swap bytes while fetching/storing limbs instead of using native order tricks. It's more robust and not really expensive nowadays. This way, the code that would fetch largeInteger bytes would still work unchanged. Also no need to hack ImageSegment and image version number. I'm thinking of using the approach of this kind of references: http://www.boost.org/doc/libs/1_60_0/boost/endian/detail/intrinsic.hpp https://blogs.oracle.com/DanX/entry/optimizing_byte_swapping_for_fun http://hardwarebug.org/2010/01/14/beware-the-builtins http://stackoverflow.com/questions/105252/how-do-i-convert-between-big-endi… So, once again, apologies for the hiccups, there might be a few more, even if I'll try my best to take it seriously and carefully, it's currently too expensive to guaranty non regression. With a single dev branch, it's more than expensive, it's impossible. Until we come with a more modern architecture, please don't consider that each and every monticello commit is OK to take as is. Eliot has short release cycles, and he does generally commit on .SVN repository when there is a MC version ready with enough added value and enough stability. That's not at each and every MC version. It's far from perfect, and maybe won't scale once a few more people add noise. But in the interim, my advice is to synch the production on .SVN release and associated MC version, not on MC. Running tests for the two are different jobs, that's a way to mitigate the fact that we have a single branch. cheers

3 2

Re: [Vm-dev] VM Maker: VMMaker.oscog-nice.1733.mcz
by Esteban Lorenzano 20 Mar '16

20 Mar '16

Hi Nico, somewhere between this and VMMaker.oscog-dtl.1730 all PharoVMs become unusable :( are you aware of this? maybe I’m forgetting something in my builds? cheers, Esteban > On 17 Mar 2016, at 22:49, commits(a)source.squeak.org wrote: > > > Nicolas Cellier uploaded a new version of VMMaker to project VM Maker: > http://source.squeak.org/VMMaker/VMMaker.oscog-nice.1733.mcz > > ==================== Summary ==================== > > Name: VMMaker.oscog-nice.1733 > Author: nice > Time: 17 March 2016, 11:45:52.436 pm > UUID: cc4513ea-67e5-4b41-b7bd-2fc790ac0102 > Ancestors: VMMaker.oscog-nice.1732 > > Oups (Oops) forgot the <doNotGenerate> for simulated #stSizeOf: version. > > =============== Diff against VMMaker.oscog-nice.1732 =============== > > Item was changed: > ----- Method: SpurMemoryManager>>stSizeOf: (in category 'object access') ----- > stSizeOf: oop > "Return the number of indexable fields in the receiver" > + <doNotGenerate> > ^oop basicSize! >

5 18

VM Maker: VMMaker.oscog-nice.1736.mcz
by commits＠source.squeak.org 19 Mar '16

19 Mar '16

Nicolas Cellier uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-nice.1736.mcz ==================== Summary ==================== Name: VMMaker.oscog-nice.1736 Author: nice Time: 19 March 2016, 3:41:39.741 pm UUID: 193c2046-4773-44ea-9455-a138be7b0992 Ancestors: VMMaker.oscog-nice.1735 Fix another bug of 1732.nice commit which broke primitiveBitAnd and primitiveBitOr The symptom is this one at least in stack spur 64bits: (-1 bitAnd: -1) -> -1 "correct" (-1 perform: 1bitAnd: with: -1) -> 16r1FFFFFFF 'huh?" it's -1 asUnsignedInteger >> 3... The first one is working Ok because it's using bytecodePrimBitAnd which is very simple and correct. here is the mistake I introduced a #usqInt type hint in slang. At the time I did it, it was to reduce the number of signed mismatch warnings which are a plague. Yes but: integerArgument := self positiveMachineIntegerValueOf: integerArgument. Ouch, the return value is supposed to be unsigned. While the parameter has to be signed in order to have the isIntegerObject: bit tricks working once inlined by slang... So reusing the variable name for two different things was not a good idea finally (it rarely is). This doesn't happen in my own branch because I've carefully rewritten the shift logic to use exclusively well defined unsigned behavior, but my changes are too aggressive, and I'd like to introduce them gradually to give a chance of reviewing them. ------------------ While at it, use cCorceSimple:to: 'unsigned int' when fetching integerValueOf rather than asUnsignedInteger. The reason is that the first will never do sign extension, while the second would in 64bits. OK, the 64bits spur cannot take this path, because a 32bit int would be a SmallInteger, but I prefer to throw good basis, this will avoid having to ask myelf about the same problem again in a couple of years... I would much prefer to have a fetchUnsigned32/64, but we'll see that another time. =============== Diff against VMMaker.oscog-nice.1735 =============== 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]. 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]. ((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: + [self cCoerceSimple: (objectMemory fetchLong32: 0 ofObject: oop) to: #'unsigned int']]! - [objectMemory fetchLong32: 0 ofObject: oop]]! Item was changed: ----- Method: InterpreterPrimitives>>primitiveBitAnd (in category 'arithmetic integer primitives') ----- primitiveBitAnd <inline: false> + <var: 'integerArgumentValue' type: #usqInt> + <var: 'intergerReceiverValue' type: #usqInt> + | integerReceiver integerArgument integerArgumentValue integerReceiverValue | - <var: 'integerArgument' type: #usqInt> - <var: 'intergerReceiver' type: #usqInt> - | integerReceiver integerArgument | integerArgument := self stackTop. integerReceiver := self stackValue: 1. "Comment out the short-cut. Either the inline interpreter bytecode or the JIT primitive will handle this case. ((objectMemory isIntegerObject: integerArgument) and: [objectMemory isIntegerObject: integerReceiver]) ifTrue: [self pop: 2 thenPush: (integerArgument bitAnd: integerReceiver)] ifFalse: [" + integerArgumentValue := self positiveMachineIntegerValueOf: integerArgument. + integerReceiverValue := self positiveMachineIntegerValueOf: integerReceiver. - integerArgument := self positiveMachineIntegerValueOf: integerArgument. - integerReceiver := self positiveMachineIntegerValueOf: integerReceiver. self successful ifTrue: + [self pop: 2 thenPush: (self positiveMachineIntegerFor: (integerArgumentValue bitAnd: integerReceiverValue))] - [self pop: 2 thenPush: (self positiveMachineIntegerFor: (integerArgument bitAnd: integerReceiver))] ifFalse: []"]"! Item was changed: ----- Method: InterpreterPrimitives>>primitiveBitOr (in category 'arithmetic integer primitives') ----- primitiveBitOr <inline: false> + <var: 'integerArgumentValue' type: #usqInt> + <var: 'intergerReceiverValue' type: #usqInt> + | integerReceiver integerArgument integerArgumentValue integerReceiverValue | - <var: 'integerArgument' type: #usqInt> - <var: 'intergerReceiver' type: #usqInt> - | integerReceiver integerArgument | integerArgument := self stackTop. integerReceiver := self stackValue: 1. "Comment out the short-cut. Either the inline interpreter bytecode or the JIT primitive will handle this case. ((objectMemory isIntegerObject: integerArgument) and: [objectMemory isIntegerObject: integerReceiver]) ifTrue: [self pop: 2 thenPush: (integerArgument bitOr: integerReceiver)] ifFalse: [" + integerArgumentValue := self positiveMachineIntegerValueOf: integerArgument. + integerReceiverValue := self positiveMachineIntegerValueOf: integerReceiver. - integerArgument := self positiveMachineIntegerValueOf: integerArgument. - integerReceiver := self positiveMachineIntegerValueOf: integerReceiver. self successful ifTrue: + [self pop: 2 thenPush: (self positiveMachineIntegerFor: (integerArgumentValue bitOr: integerReceiverValue))] - [self pop: 2 thenPush: (self positiveMachineIntegerFor: (integerArgument bitOr: integerReceiver))] ifFalse: []"]"! Item was changed: ----- Method: InterpreterPrimitives>>primitiveBitXor (in category 'arithmetic integer primitives') ----- primitiveBitXor <inline: false> + <var: 'integerArgumentValue' type: #usqInt> + <var: 'intergerReceiverValue' type: #usqInt> + | integerReceiver integerArgument integerArgumentValue integerReceiverValue | - | integerReceiver integerArgument | integerArgument := self stackTop. integerReceiver := self stackValue: 1. ((objectMemory isIntegerObject: integerArgument) and: [objectMemory isIntegerObject: integerReceiver]) ifTrue: "xoring will leave the tag bits zero, whether the tag is 1 or zero, so add it back in." [self pop: 2 thenPush: (integerArgument bitXor: integerReceiver) + objectMemory smallIntegerTag] ifFalse: + [integerArgumentValue := self positiveMachineIntegerValueOf: integerArgument. + integerReceiverValue := self positiveMachineIntegerValueOf: integerReceiver. - [integerArgument := self positiveMachineIntegerValueOf: integerArgument. - integerReceiver := self positiveMachineIntegerValueOf: integerReceiver. self successful ifTrue: + [self pop: 2 thenPush: (self positiveMachineIntegerFor: (integerArgumentValue bitXor: integerReceiverValue))]]! - [self pop: 2 thenPush: (self positiveMachineIntegerFor: (integerArgument bitXor: integerReceiver))]]! 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 magnitude | <inline: false> <returnTypeC: #sqLong> <var: #value type: #sqLong> <var: #magnitude type: #usqLong> (objectMemory isIntegerObject: oop) ifTrue: [^self cCoerce: (objectMemory integerValueOf: oop) to: #sqLong]. (objectMemory isNonIntegerImmediate: oop) ifTrue: [self primitiveFail. ^0]. 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. sz > (self sizeof: #sqLong) ifTrue: [self primitiveFail. ^0]. self cppIf: VMBIGENDIAN ifTrue: [magnitude := objectMemory fetchByte: sz - 1 ofObject: oop. sz - 2 to: 0 by: -1 do: [:i | magnitude := magnitude << 8 + (objectMemory fetchByte: i ofObject: oop)]] ifFalse: [magnitude := sz > 4 ifTrue: [objectMemory fetchLong64: 0 ofObject: oop] + ifFalse: [self cCoerceSimple: (objectMemory fetchLong32: 0 ofObject: oop) to: #'unsigned int']]. - ifFalse: [(objectMemory fetchLong32: 0 ofObject: oop) asUnsignedInteger]]. (negative ifTrue: [magnitude > 16r8000000000000000] ifFalse: [magnitude >= 16r8000000000000000]) ifTrue: [self primitiveFail. ^0]. negative ifTrue: [value := 0 - magnitude] ifFalse: [value := magnitude]. ^value!

1 0

VM Maker: VMMaker.oscog-nice.1735.mcz
by commits＠source.squeak.org 18 Mar '16

18 Mar '16

Nicolas Cellier uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-nice.1735.mcz ==================== Summary ==================== Name: VMMaker.oscog-nice.1735 Author: nice Time: 18 March 2016, 11:56:29.175 pm UUID: 498f1478-029f-42dc-8290-20203333af22 Ancestors: VMMaker.oscog-nice.1733 Workaround spurious breakage caused by nice.1732 Slang inliner does inline this call: sqInt shifted = 0xFFFFFFFFU; shifted = positive32BitIntegerFor(shifted); into: sqInt shifted = 0xFFFFFFFFU; if( shifted <= MaxSmallInteger) { shifted = (shifted << 1) | 1; ...snip... shifted interpreted as signed integer is negative. MaxSmallInteger is a signed integer constant, so the if test is TRUE. and a negative SmallInteger is created (with value -1) instead of a LargePositiveInteger as it should have been. The intention is to interpret shifted as an unsigned integer, but since we did not help SLANG with a hint, slang did produce a signed (sqInt) by default. =============== Diff against VMMaker.oscog-nice.1733 =============== Item was changed: ----- Method: StackInterpreter>>maybeInlinePositive32BitIntegerFor: (in category 'primitive support') ----- maybeInlinePositive32BitIntegerFor: integerValue "N.B. will *not* cause a GC. integerValue is interpreted as POSITIVE, e.g. as the result of Bitmap>at:." <notOption: #Spur64BitMemoryManager> <var: 'integerValue' type: #'unsigned int'> | newLargeInteger | self deny: objectMemory hasSixtyFourBitImmediates. + "force coercion because slang inliner sometimes incorrectly pass a signed int without converting to unsigned" + (self cCoerceSimple: integerValue to: #'unsigned int') <= objectMemory maxSmallInteger - integerValue <= objectMemory maxSmallInteger ifTrue: [^ objectMemory integerObjectOf: integerValue]. newLargeInteger := objectMemory eeInstantiateSmallClassIndex: ClassLargePositiveIntegerCompactIndex format: (objectMemory byteFormatForNumBytes: 4) numSlots: 1. self cppIf: VMBIGENDIAN ifTrue: [objectMemory storeByte: 3 ofObject: newLargeInteger withValue: (integerValue >> 24 bitAnd: 16rFF); storeByte: 2 ofObject: newLargeInteger withValue: (integerValue >> 16 bitAnd: 16rFF); storeByte: 1 ofObject: newLargeInteger withValue: (integerValue >> 8 bitAnd: 16rFF); storeByte: 0 ofObject: newLargeInteger withValue: (integerValue ">> 0" bitAnd: 16rFF)] ifFalse: [objectMemory storeLong32: 0 ofObject: newLargeInteger withValue: integerValue]. ^newLargeInteger!

1 0

Re: [Vm-dev] VM Maker: VMMaker.oscog-nice.1732.mcz
by Eliot Miranda 18 Mar '16

18 Mar '16

Hi Nicolas, On Thu, Mar 17, 2016 at 3:24 PM, <commits(a)source.squeak.org> wrote: > > Nicolas Cellier uploaded a new version of VMMaker to project VM Maker: > http://source.squeak.org/VMMaker/VMMaker.oscog-nice.1732.mcz > > ==================== Summary ==================== > > Name: VMMaker.oscog-nice.1732 > Author: nice > Time: 17 March 2016, 11:22:07.715 pm > UUID: ea9dd158-4847-464e-9642-9786252797dc > Ancestors: VMMaker.oscog-nice.1731 > > Use little endian accelerators too for fetching 32 & 64 bits large > integers value (like the ones used for storing value). > > Dramatically simplify fetching of signedInteger values by using an > intermediate unsigned magnitude. > > Declare the positive32/64BitIntegerFor: and > maybeInlinePositive32BitIntegerFor: parameter as unsigned since it is > interpreted as positive. > > Use asUnsignedInteger in isIntegerValue: tests, integerObjectOf: and > rotatedFloatBitsOf: in order to ban potential UB. > > Simplify bit operations using > positiveMachineIntegerValueOf:/positiveMachineIntegerFor: rather than doing > 32/64 bits dissertation. > > Fetch magnitude of positive large ints into an unsigned for large int bit > ops. > In the following ----- Method: StackInterpreter>>maybeInlinePositive32BitIntegerFor: (in category 'primitive support') ----- maybeInlinePositive32BitIntegerFor: integerValue "N.B. will *not* cause a GC. integerValue is interpreted as POSITIVE, e.g. as the result of Bitmap>at:." <notOption: #Spur64BitMemoryManager> + <var: 'integerValue' type: #'unsigned int'> | newLargeInteger | self deny: objectMemory hasSixtyFourBitImmediates. + integerValue <= objectMemory maxSmallInteger + ifTrue: [^ objectMemory integerObjectOf: integerValue]. - (integerValue asInteger >= 0 - and: [objectMemory isIntegerValue: integerValue]) ifTrue: - [^objectMemory integerObjectOf: integerValue]. shouldn't we compare against minSmallInteger as well, because e.g. -16r80000000 could overflow SmallInteger and answer 0? P.S. Lovely seeing this code getting some good loving. > > =============== Diff against VMMaker.oscog-nice.1731 =============== > > 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 storeLong64: 0 > ofObject: newLargeInteger withValue: magnitude] > + ifFalse: [objectMemory storeLong32: 0 > ofObject: newLargeInteger withValue: (self cCode: [magnitude] inSmalltalk: > [magnitude bitAnd: 16rFFFFFFFF])]]. > - [sz > 4 ifTrue: > - [objectMemory storeLong32: 1 ofObject: > newLargeInteger withValue: magnitude >> 32]. > - objectMemory > - storeLong32: 0 > - ofObject: newLargeInteger > - withValue: (self cCode: [magnitude] > inSmalltalk: [magnitude bitAnd: 16rFFFFFFFF])]. > > ^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." > | 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]. > > 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. > sz > (self sizeof: #sqLong) ifTrue: > [self primitiveFail. > ^0]. > > + 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: > + [sz > 4 > + ifTrue: [value := self cCoerceSimple: > (objectMemory fetchLong64: 0 ofObject: oop) to: #usqLong] > + ifFalse: [value := self cCoerceSimple: > (objectMemory fetchLong32: 0 ofObject: oop) to: #'unsigned int'].]. > - value := objectMemory fetchByte: sz - 1 ofObject: oop. > - sz - 2 to: 0 by: -1 do: > - [:i | value := value << 8 + (objectMemory fetchByte: i > ofObject: oop)]. > ^value! > > 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: > [self primitiveFail. > ^0]. > sz := objectMemory numBytesOfBytes: oop. > sz > (self sizeof: #sqLong) ifTrue: > [self primitiveFail. > ^0]. > > + self cppIf: VMBIGENDIAN > + ifTrue: > + [value := 0. > + 0 to: sz - 1 do: [:i | > + value := value + ((self cCoerce: > (objectMemory fetchByte: i ofObject: oop) to: #usqLong) << (i*8))]] > + ifFalse: > + [sz > 4 > + ifTrue: [value := self cCoerceSimple: > (objectMemory fetchLong64: 0 ofObject: oop) to: #usqLong] > + ifFalse: [value := self cCoerceSimple: > (objectMemory fetchLong32: 0 ofObject: oop) to: #'unsigned int'].]. > - 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>>primitiveBitAnd (in category > 'arithmetic integer primitives') ----- > primitiveBitAnd > <inline: false> > + <var: 'integerArgument' type: #usqInt> > + <var: 'intergerReceiver' type: #usqInt> > | integerReceiver integerArgument | > integerArgument := self stackTop. > integerReceiver := self stackValue: 1. > "Comment out the short-cut. Either the inline interpreter > bytecode or the JIT primitive will handle this case. > ((objectMemory isIntegerObject: integerArgument) > and: [objectMemory isIntegerObject: integerReceiver]) > ifTrue: [self pop: 2 thenPush: (integerArgument bitAnd: > integerReceiver)] > ifFalse: > + [" > + integerArgument := self > positiveMachineIntegerValueOf: integerArgument. > + integerReceiver := self > positiveMachineIntegerValueOf: integerReceiver. > + self successful ifTrue: > + [self pop: 2 thenPush: (self > positiveMachineIntegerFor: (integerArgument bitAnd: integerReceiver))] > - ["objectMemory wordSize = 8 > - ifTrue: > - [integerArgument := self > positive64BitValueOf: integerArgument. > - integerReceiver := self > positive64BitValueOf: integerReceiver. > - self successful ifTrue: > - [self pop: 2 thenPush: > (self positive64BitIntegerFor: (integerArgument bitAnd: integerReceiver))]] > ifFalse: > + []"]"! > - [integerArgument := self > positive32BitValueOf: integerArgument. > - integerReceiver := self > positive32BitValueOf: integerReceiver. > - self successful ifTrue: > - [self pop: 2 thenPush: > (self positive32BitIntegerFor: (integerArgument bitAnd: > integerReceiver))]]"]"! > > Item was changed: > ----- Method: InterpreterPrimitives>>primitiveBitAndLargeIntegers (in > category 'arithmetic largeint primitives') ----- > primitiveBitAndLargeIntegers > "Primitive logical operations for large integers in 64 bit range" > | integerRcvr integerArg oopResult | > <export: true> > + <var: 'integerRcvr' type: 'usqLong'> > + <var: 'integerArg' type: 'usqLong'> > - <var: 'integerRcvr' type: 'sqLong'> > - <var: 'integerArg' type: 'sqLong'> > > integerArg := self positive64BitValueOf: (self stackValue: 0). > integerRcvr := self positive64BitValueOf: (self stackValue: 1). > self successful ifFalse:[^nil]. > > oopResult := self positive64BitIntegerFor: (integerRcvr bitAnd: > integerArg). > self successful ifTrue:[self pop: 2 thenPush: oopResult]! > > Item was changed: > ----- Method: InterpreterPrimitives>>primitiveBitOr (in category > 'arithmetic integer primitives') ----- > primitiveBitOr > <inline: false> > + <var: 'integerArgument' type: #usqInt> > + <var: 'intergerReceiver' type: #usqInt> > | integerReceiver integerArgument | > integerArgument := self stackTop. > integerReceiver := self stackValue: 1. > "Comment out the short-cut. Either the inline interpreter > bytecode or the JIT primitive will handle this case. > ((objectMemory isIntegerObject: integerArgument) > and: [objectMemory isIntegerObject: integerReceiver]) > ifTrue: [self pop: 2 thenPush: (integerArgument bitOr: > integerReceiver)] > ifFalse: > + [" > + integerArgument := self > positiveMachineIntegerValueOf: integerArgument. > + integerReceiver := self > positiveMachineIntegerValueOf: integerReceiver. > + self successful ifTrue: > + [self pop: 2 thenPush: (self > positiveMachineIntegerFor: (integerArgument bitOr: integerReceiver))] > - ["objectMemory wordSize = 8 > - ifTrue: > - [integerArgument := self > positive64BitValueOf: integerArgument. > - integerReceiver := self > positive64BitValueOf: integerReceiver. > - self successful ifTrue: > - [self pop: 2 thenPush: > (self positive64BitIntegerFor: (integerArgument bitOr: integerReceiver))]] > ifFalse: > + []"]"! > - [integerArgument := self > positive32BitValueOf: integerArgument. > - integerReceiver := self > positive32BitValueOf: integerReceiver. > - self successful ifTrue: > - [self pop: 2 thenPush: > (self positive32BitIntegerFor: (integerArgument bitOr: > integerReceiver))]]"]"! > > Item was changed: > ----- Method: InterpreterPrimitives>>primitiveBitOrLargeIntegers (in > category 'arithmetic largeint primitives') ----- > primitiveBitOrLargeIntegers > "Primitive logical operations for large integers in 64 bit range" > | integerRcvr integerArg oopResult | > <export: true> > + <var: 'integerRcvr' type: 'usqLong'> > + <var: 'integerArg' type: 'usqLong'> > - <var: 'integerRcvr' type: 'sqLong'> > - <var: 'integerArg' type: 'sqLong'> > > integerArg := self positive64BitValueOf: (self stackValue: 0). > integerRcvr := self positive64BitValueOf: (self stackValue: 1). > self successful ifFalse:[^nil]. > > oopResult := self positive64BitIntegerFor: (integerRcvr bitOr: > integerArg). > self successful ifTrue:[self pop: 2 thenPush: oopResult]! > > Item was changed: > ----- Method: InterpreterPrimitives>>primitiveBitXor (in category > 'arithmetic integer primitives') ----- > primitiveBitXor > <inline: false> > | integerReceiver integerArgument | > integerArgument := self stackTop. > integerReceiver := self stackValue: 1. > ((objectMemory isIntegerObject: integerArgument) > and: [objectMemory isIntegerObject: integerReceiver]) > ifTrue: "xoring will leave the tag bits zero, whether the > tag is 1 or zero, so add it back in." > [self pop: 2 thenPush: (integerArgument bitXor: > integerReceiver) + objectMemory smallIntegerTag] > ifFalse: > + [integerArgument := self > positiveMachineIntegerValueOf: integerArgument. > + integerReceiver := self > positiveMachineIntegerValueOf: integerReceiver. > + self successful ifTrue: > + [self pop: 2 thenPush: (self > positiveMachineIntegerFor: (integerArgument bitXor: integerReceiver))]]! > - [objectMemory wordSize = 8 > - ifTrue: > - [integerArgument := self > positive64BitValueOf: integerArgument. > - integerReceiver := self > positive64BitValueOf: integerReceiver. > - self successful ifTrue: > - [self pop: 2 thenPush: > (self positive64BitIntegerFor: (integerArgument bitXor: integerReceiver))]] > - ifFalse: > - [integerArgument := self > positive32BitValueOf: integerArgument. > - integerReceiver := self > positive32BitValueOf: integerReceiver. > - self successful ifTrue: > - [self pop: 2 thenPush: > (self positive32BitIntegerFor: (integerArgument bitXor: > integerReceiver))]]]! > > Item was changed: > ----- Method: InterpreterPrimitives>>primitiveBitXorLargeIntegers (in > category 'arithmetic largeint primitives') ----- > primitiveBitXorLargeIntegers > "Primitive logical operations for large integers in 64 bit range" > | integerRcvr integerArg oopResult | > <export: true> > + <var: 'integerRcvr' type: 'usqLong'> > + <var: 'integerArg' type: 'usqLong'> > - <var: 'integerRcvr' type: 'sqLong'> > - <var: 'integerArg' type: 'sqLong'> > > integerArg := self positive64BitValueOf: (self stackValue: 0). > integerRcvr := self positive64BitValueOf: (self stackValue: 1). > self successful ifFalse:[^nil]. > > oopResult := self positive64BitIntegerFor: (integerRcvr bitXor: > integerArg). > self successful ifTrue:[self pop: 2 thenPush: oopResult]! > > 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 magnitude | > - | value negative ok | > <inline: false> > <returnTypeC: #int> > <var: #value type: #int> > + <var: #magnitude type: #'unsigned int'> > <var: #value64 type: #long> > (objectMemory isIntegerObject: oop) ifTrue: > [objectMemory wordSize = 4 > ifTrue: > [^objectMemory integerValueOf: oop] > ifFalse: "Must fail for SmallIntegers with > digitLength > 4" > [| value64 | > value64 := objectMemory integerValueOf: > oop. > (self cCode: [(self cCoerceSimple: > value64 to: #int) ~= value64] > inSmalltalk: [value64 >> > 31 ~= 0 and: [value64 >> 31 ~= -1]]) ifTrue: > [self primitiveFail. value64 := 0]. > ^value64]]. > > (objectMemory isNonIntegerImmediate: oop) ifTrue: > [self primitiveFail. > ^0]. > > 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: > [^self primitiveFail]. > > + magnitude := self cppIf: VMBIGENDIAN > - 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) asUnsignedInteger]. > + > + (negative > + ifTrue: [magnitude > 16r80000000] > + ifFalse: [magnitude >= 16r80000000]) > + ifTrue: > + [self primitiveFail. > + ^0]. > + negative > + ifTrue: [value := 0 - magnitude] > + ifFalse: [value := magnitude]. > + ^value! > - [objectMemory fetchLong32: 0 > ofObject: oop]. > - 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]. > - ^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 magnitude | > - | sz value negative ok | > <inline: false> > <returnTypeC: #sqLong> > <var: #value type: #sqLong> > + <var: #magnitude type: #usqLong> > (objectMemory isIntegerObject: oop) ifTrue: > [^self cCoerce: (objectMemory integerValueOf: oop) to: > #sqLong]. > > (objectMemory isNonIntegerImmediate: oop) ifTrue: > [self primitiveFail. > ^0]. > > 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. > sz > (self sizeof: #sqLong) ifTrue: > [self primitiveFail. > ^0]. > > self cppIf: VMBIGENDIAN > ifTrue: > + [magnitude := objectMemory fetchByte: sz - 1 > ofObject: oop. > - [value := objectMemory fetchByte: sz - 1 ofObject: > oop. > sz - 2 to: 0 by: -1 do: [:i | > + magnitude := magnitude << 8 + > (objectMemory fetchByte: i ofObject: oop)]] > - value := value << 8 + (objectMemory > fetchByte: i ofObject: oop)]] > ifFalse: > + [magnitude := sz > 4 > - [value := sz > 4 > ifTrue: [objectMemory > fetchLong64: 0 ofObject: oop] > ifFalse: [(objectMemory > fetchLong32: 0 ofObject: oop) asUnsignedInteger]]. > + > + (negative > + ifTrue: [magnitude > 16r8000000000000000] > + ifFalse: [magnitude >= 16r8000000000000000]) > + ifTrue: [self primitiveFail. > + ^0]. > + negative > + ifTrue: [value := 0 - magnitude] > + ifFalse: [value := magnitude]. > + ^value! > - "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]. > - ^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 limit magnitude | > - | negative ok bs value bits | > <var: #value type: #long> > + <var: #magnitude type: #usqInt> > + <var: #limit type: #usqInt> > (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: > + [magnitude := self cppIf: VMBIGENDIAN > - [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]] > ifFalse: > + [magnitude := self cppIf: VMBIGENDIAN > - [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) asUnsignedInteger]]. > + > + limit := 1 asUnsignedInteger << ((self sizeof: #usqInt) * 8 - 1). > + (negative > + ifTrue: [magnitude > limit] > + ifFalse: [magnitude >= limit]) > + ifTrue: [self primitiveFail. > + ^0]. > + negative > + ifTrue: [value := 0 - magnitude] > + ifFalse: [value := magnitude]. > + ^value! > - > - 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: InterpreterProxy>>positive32BitIntegerFor: (in category > 'converting') ----- > positive32BitIntegerFor: integerValue > + <var: 'integerValue' type: #'unsigned int'> > integerValue isInteger ifFalse:[self error:'Not an Integer > object']. > ^integerValue > 0 > ifTrue:[integerValue] > ifFalse:[ (1 bitShift: 32) + integerValue]! > > Item was changed: > ----- Method: InterpreterProxy>>positive64BitIntegerFor: (in category > 'converting') ----- > positive64BitIntegerFor: integerValue > <api> > <returnTypeC: #sqInt> "...because answering the 64-bit argument > causes the type inferencer to say this answers 64-bits." > + <var: 'integerValue' type: #usqLong> > - <var: 'integerValue' type: #sqLong> > integerValue isInteger ifFalse:[self error:'Not an Integer > object']. > ^integerValue > 0 > ifTrue:[integerValue] > ifFalse:[ (1 bitShift: 64) + integerValue]! > > Item was changed: > ----- Method: ObjectMemory>>isIntegerValue: (in category 'interpreter > access') ----- > isIntegerValue: intValue > "Answer if the given value can be represented as a Smalltalk > integer value. > In C, use a shift and XOR to set the sign bit if and only if the > top two bits of the given > value are the same, then test the sign bit. Note that the top two > bits are equal for > exactly those integers in the range that can be represented in > 31-bits or 63-bits." > <api> > ^self > + cCode: [(intValue asUnsignedInteger bitXor: (intValue > asUnsignedInteger << 1)) asInteger >= 0] > + inSmalltalk: [intValue >= self minSmallInteger and: > [intValue <= self maxSmallInteger]]! > - cCode: [(intValue bitXor: (intValue << 1)) asInteger >= 0] > - inSmalltalk: [intValue >= 16r-40000000 and: [intValue <= > 16r3FFFFFFF]]! > > Item was changed: > ----- Method: Spur32BitMemoryManager>>isIntegerValue: (in category > 'interpreter access') ----- > isIntegerValue: intValue > "Answer if the given value can be represented as a Smalltalk > integer value. > In C, use a shift and XOR to set the sign bit if and only if the > top two bits of the given > value are the same, then test the sign bit. Note that the top two > bits are equal for > exactly those integers in the range that can be represented in > 31-bits or 63-bits." > <api> > ^self > + cCode: [(intValue asUnsignedInteger bitXor: (intValue > asUnsignedInteger << 1)) asInteger >= 0] > + inSmalltalk: [intValue >= self minSmallInteger and: > [intValue <= self maxSmallInteger]]! > - cCode: [(intValue bitXor: (intValue << 1)) asInteger >= 0] > - inSmalltalk: [intValue >= 16r-40000000 and: [intValue <= > 16r3FFFFFFF]]! > > Item was changed: > ----- Method: Spur64BitMemoryManager>>integerObjectOf: (in category > 'immediates') ----- > integerObjectOf: value > "Convert the integer value, assumed to be in SmallInteger range, > into a tagged SmallInteger object. > In C, use a shift and an add to set the tag bit. > In Smalltalk we have to work harder because the simulator works > with strictly positive bit patterns." > <returnTypeC: #sqInt> > ^self > + cCode: [value asUnsignedInteger << self numTagBits + 1] > - cCode: [value << self numTagBits + 1] > inSmalltalk: [value << self numTagBits > + (value >= 0 > ifTrue: [1] > ifFalse: > [16r10000000000000001])]! > > Item was changed: > ----- Method: Spur64BitMemoryManager>>isIntegerValue: (in category > 'interpreter access') ----- > isIntegerValue: intValue > "Answer if the given value can be represented as a Smalltalk > integer value. > In 64-bits we use a 3 bit tag which leaves 61 bits for 2's > complement signed > integers. In C, use a shift add and mask to test if the top 4 > bits are all the same. > Since 16rFFFFFFFFFFFFFFFF >> 60 = 16rF the computation intValue > >> 60 + 1 bitAnd: 16rF > maps in-range -ve values to 0 and in-range +ve values to 1." > <api> > ^self > cCode: [(intValue >> 60 + 1 bitAnd: 16rF) <= 1] "N.B. > (16rFFFFFFFFFFFFFFFF >> 60) + 1 = 16" > + inSmalltalk: [intValue >= self minSmallInteger and: > [intValue <= self maxSmallInteger]]! > - inSmalltalk: [intValue >= -16r1000000000000000 and: > [intValue <= 16rFFFFFFFFFFFFFFF]]! > > Item was changed: > ----- Method: Spur64BitMemoryManager>>rotatedFloatBitsOf: (in category > 'interpreter access') ----- > rotatedFloatBitsOf: oop > "Answer the signed, but unadjusted value of a SmallFloat64, > suitable for use as a hash. > Keeping the exponent unadjusted keeps the value in the > SmallInteger range. > See section 61-bit Immediate Floats in the SpurMemoryManager > class comment. > msb > lsb > Decode: > [8expsubset][52mantissa][1s][3tags] > shift away tags & sign: [ 0000 > ][8expsubset][52mantissa] > add sign: [ ssss > ][8expsubset][52mantissa]" > self assert: (self isImmediateFloat: oop). > ^oop asUnsignedInteger >> (self numTagBits + 1) > + ((oop anyMask: self smallFloatSignBit) > + ifTrue: [-1 asUnsignedInteger << (64 - self numTagBits - > 1)] > - ifTrue: [-1 << (64 - self numTagBits - 1)] > ifFalse: [0])! > > Item was changed: > ----- Method: StackInterpreter>>maybeInlinePositive32BitIntegerFor: (in > category 'primitive support') ----- > maybeInlinePositive32BitIntegerFor: integerValue > "N.B. will *not* cause a GC. > integerValue is interpreted as POSITIVE, e.g. as the result of > Bitmap>at:." > <notOption: #Spur64BitMemoryManager> > + <var: 'integerValue' type: #'unsigned int'> > | newLargeInteger | > self deny: objectMemory hasSixtyFourBitImmediates. > + integerValue <= objectMemory maxSmallInteger > + ifTrue: [^ objectMemory integerObjectOf: integerValue]. > - (integerValue asInteger >= 0 > - and: [objectMemory isIntegerValue: integerValue]) ifTrue: > - [^objectMemory integerObjectOf: integerValue]. > newLargeInteger := objectMemory > > eeInstantiateSmallClassIndex: ClassLargePositiveIntegerCompactIndex > format: > (objectMemory byteFormatForNumBytes: 4) > numSlots: 1. > self cppIf: VMBIGENDIAN > ifTrue: > [objectMemory > storeByte: 3 ofObject: newLargeInteger > withValue: (integerValue >> 24 bitAnd: 16rFF); > storeByte: 2 ofObject: newLargeInteger > withValue: (integerValue >> 16 bitAnd: 16rFF); > storeByte: 1 ofObject: newLargeInteger > withValue: (integerValue >> 8 bitAnd: 16rFF); > storeByte: 0 ofObject: newLargeInteger > withValue: (integerValue ">> 0" bitAnd: 16rFF)] > ifFalse: > [objectMemory storeLong32: 0 ofObject: > newLargeInteger withValue: integerValue]. > ^newLargeInteger! > > Item was changed: > ----- Method: StackInterpreter>>positive32BitIntegerFor: (in category > 'primitive support') ----- > positive32BitIntegerFor: integerValue > "integerValue is interpreted as POSITIVE, e.g. as the result of > Bitmap>at:. > N.B. Returning in each arm separately enables Slang inlining. > /Don't/ return the ifTrue:ifFalse: unless Slang inlining of > conditionals is fixed." > <inline: true> > + <var: 'integerValue' type: #'unsigned int'> > objectMemory hasSixtyFourBitImmediates > ifTrue: > [^objectMemory integerObjectOf: (integerValue > bitAnd: 16rFFFFFFFF)] > ifFalse: > [^self maybeInlinePositive32BitIntegerFor: > integerValue]! > > Item was changed: > ----- Method: StackInterpreter>>positive64BitIntegerFor: (in category > 'primitive support') ----- > positive64BitIntegerFor: integerValue > <api> > + <var: 'integerValue' type: #usqLong> > + <var: 'highWord' type: #'unsigned int'> > - <var: 'integerValue' type: #sqLong> > "Answer a Large Positive Integer object for the given integer > value. N.B. will *not* cause a GC." > | newLargeInteger highWord sz | > objectMemory hasSixtyFourBitImmediates > ifTrue: > + [integerValue <= objectMemory maxSmallInteger > ifTrue: > - [(integerValue >= 0 and: [objectMemory > isIntegerValue: integerValue]) ifTrue: > [^objectMemory integerObjectOf: > integerValue]. > sz := 8] > ifFalse: > + [(highWord := integerValue >> 32) = 0 ifTrue: > - [(highWord := integerValue >>> 32) = 0 ifTrue: > [^self positive32BitIntegerFor: > integerValue]. > 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 > > eeInstantiateSmallClassIndex: ClassLargePositiveIntegerCompactIndex > format: > (objectMemory byteFormatForNumBytes: sz) > numSlots: 8 / > objectMemory bytesPerOop. > self cppIf: VMBIGENDIAN > ifTrue: > [objectMemory > storeByte: 7 ofObject: newLargeInteger > withValue: (integerValue >> 56 bitAnd: 16rFF); > storeByte: 6 ofObject: newLargeInteger > withValue: (integerValue >> 48 bitAnd: 16rFF); > storeByte: 5 ofObject: newLargeInteger > withValue: (integerValue >> 40 bitAnd: 16rFF); > storeByte: 4 ofObject: newLargeInteger > withValue: (integerValue >> 32 bitAnd: 16rFF); > storeByte: 3 ofObject: newLargeInteger > withValue: (integerValue >> 24 bitAnd: 16rFF); > storeByte: 2 ofObject: newLargeInteger > withValue: (integerValue >> 16 bitAnd: 16rFF); > storeByte: 1 ofObject: newLargeInteger > withValue: (integerValue >> 8 bitAnd: 16rFF); > storeByte: 0 ofObject: newLargeInteger > withValue: (integerValue ">> 0" bitAnd: 16rFF)] > ifFalse: > [objectMemory storeLong64: 0 ofObject: > newLargeInteger withValue: integerValue]. > ^newLargeInteger > ! > > Item was changed: > ----- Method: StackInterpreter>>signed64BitIntegerFor: (in category > 'primitive support') ----- > signed64BitIntegerFor: integerValue > <var: 'integerValue' type: #sqLong> > "Answer a Large Integer object for the given integer value. N.B. > will *not* cause a GC." > | newLargeInteger magnitude largeClass highWord sz | > <inline: false> > + <var: 'magnitude' type: #usqLong> > - <var: 'magnitude' type: #sqLong> > <var: 'highWord' type: #usqInt> > > - objectMemory wordSize = 8 ifTrue: > - [(objectMemory isIntegerValue: integerValue) ifTrue: > - [^objectMemory integerObjectOf: integerValue]. > - sz := 8]. > - > integerValue < 0 > + ifTrue:[ integerValue >= objectMemory > minSmallInteger ifTrue: [^objectMemory integerObjectOf: integerValue > asInteger]. > + largeClass := > ClassLargeNegativeIntegerCompactIndex. > + magnitude := 0 - (self cCoerceSimple: > integerValue to: #usqLong)] > + ifFalse:[ integerValue <= objectMemory > maxSmallInteger ifTrue: [^objectMemory integerObjectOf: integerValue > asInteger]. > + largeClass := > ClassLargePositiveIntegerCompactIndex. > - ifTrue:[ largeClass := > ClassLargeNegativeIntegerCompactIndex. > - magnitude := 0 - integerValue] > - ifFalse:[ largeClass := > ClassLargePositiveIntegerCompactIndex. > magnitude := integerValue]. > > + objectMemory wordSize = 8 > + ifTrue: [sz := 8] > + ifFalse: [ > - "Make sure to handle the most -ve value correctly. 0 - most -ve = > most -ve and most -ve - 1 > - is +ve. Alas the simple (negative or: [integerValue - 1 < 0]) > fails with contemporary gcc and icc > - versions with optimization and sometimes without. The shift > works on all, touch wood." > - > - objectMemory wordSize = 4 ifTrue: > - [(magnitude <= 16r7FFFFFFF > - and: [integerValue >= 0 > - or: [0 ~= (self cCode: [integerValue << 1] > - inSmalltalk: > [integerValue << 1 bitAnd: (1 << 64) - 1])]]) ifTrue: > - [^self signed32BitIntegerFor: > integerValue]. > - > (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 > > eeInstantiateSmallClassIndex: largeClass > format: > (objectMemory byteFormatForNumBytes: sz) > numSlots: sz + 3 > // objectMemory bytesPerOop. > 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 storeLong64: 0 > ofObject: newLargeInteger withValue: magnitude] > + ifFalse: [objectMemory storeLong32: 0 > ofObject: newLargeInteger withValue: (self cCode: [magnitude] inSmalltalk: > [magnitude bitAnd: 16rFFFFFFFF])]]. > - [sz > 4 ifTrue: > - [objectMemory storeLong32: 1 ofObject: > newLargeInteger withValue: magnitude >> 32. > - magnitude := magnitude bitAnd: > 16rFFFFFFFF]. > - objectMemory storeLong32: 0 ofObject: > newLargeInteger withValue: magnitude]. > ^newLargeInteger! > > -- _,,,^..^,,,_ best, Eliot

2 2

Re: [Vm-dev] VM Maker: VMMaker.oscog-dtl.1730.mcz
by Eliot Miranda 18 Mar '16

18 Mar '16

Hi David, On Wed, Mar 16, 2016 at 6:07 PM, <commits(a)source.squeak.org> wrote: > > David T. Lewis uploaded a new version of VMMaker to project VM Maker: > http://source.squeak.org/VMMaker/VMMaker.oscog-dtl.1730.mcz > > ==================== Summary ==================== > > Name: VMMaker.oscog-dtl.1730 > Author: dtl > Time: 16 March 2016, 9:06:26.74934 pm > UUID: ad4e53e1-bdbc-4cb9-b5fb-f1229ca4e19f > Ancestors: VMMaker.oscog-nice.1729 > > Allow primitiveUtcWithOffset to accept an optional parameter with an array > or object with two or more slots to store UTC posix microseconds and time > zone offset in seconds. Compatibility with VMM trunk. Note, consider > incorporating ioUtcWithOffset from SVN trunk to provide true atomic > primitive. > Feel free to move the code over. > > =============== Diff against VMMaker.oscog-nice.1729 =============== > > Item was changed: > ----- Method: InterpreterPrimitives>>primitiveUtcWithOffset (in category > 'system control primitives') ----- > primitiveUtcWithOffset > + "Answer an array with UTC microseconds since the Posix epoch and > the > + current seconds offset from GMT in the local time zone. An empty > two > + element array (or any object with two or more slots) may be > supplied > + as a parameter. > - "Answer an array with UTC microseconds since the Posix epoch and > - the current seconds offset from GMT in the local time zone. > This is a named (not numbered) primitive in the null module (ie > the VM)" > | epochDelta offset resultArray utcMicroseconds | > > <export: true> > <var: #epochDelta declareC: 'static usqLong epochDelta= > 2177452800000000ULL'> > <var: #utcMicroseconds type: #usqLong> > <var: #offset type: #sqLong> > + argumentCount > 1 ifTrue: [^self primitiveFailFor: > PrimErrBadNumArgs]. > self cCode: '' inSmalltalk: [epochDelta := 2177452800000000]. > utcMicroseconds := self ioUTCMicroseconds. > offset := self ioLocalMicroseconds - utcMicroseconds. > offset := offset / 1000000. > objectMemory pushRemappableOop: (self positive64BitIntegerFor: > utcMicroseconds - epochDelta). > + argumentCount > 0 > + ifTrue: [resultArray := self popStack. > + ((objectMemory isPointers: resultArray) > + and: [(objectMemory lengthOf: resultArray) > >= 2]) > + ifFalse: [^self primitiveFailFor: > PrimErrBadArgument]] > + ifFalse: [resultArray := objectMemory instantiateClass: > objectMemory classArray indexableSize: 2]. > - resultArray := objectMemory instantiateClass: objectMemory > classArray indexableSize: 2. > objectMemory storePointer: 0 ofObject: resultArray withValue: > objectMemory popRemappableOop. > objectMemory storePointerUnchecked: 1 ofObject: resultArray > withValue: (objectMemory integerObjectOf: offset). > self pop: 1 thenPush: resultArray > ! > > -- _,,,^..^,,,_ best, Eliot

2 3

Re: [Vm-dev] VM Maker: VMMaker.oscog-nice.1731.mcz
by Eliot Miranda 18 Mar '16

18 Mar '16

Hi Nicolas, the right form for that stSizeOf: implementation is stSizeOf: integerValue "hack around the CoInterpreter/ObjectMemory split refactoring" <doNotGenerate> ^coInterpreter stSizeOf: integerValue On Thu, Mar 17, 2016 at 2:35 PM, <commits(a)source.squeak.org> wrote: > > Nicolas Cellier uploaded a new version of VMMaker to project VM Maker: > http://source.squeak.org/VMMaker/VMMaker.oscog-nice.1731.mcz > > ==================== Summary ==================== > > Name: VMMaker.oscog-nice.1731 > Author: nice > Time: 17 March 2016, 10:33:40.804 pm > UUID: 5a57b844-0803-41bd-b772-73cf6c7dfb0a > Ancestors: VMMaker.oscog-dtl.1730 > > Fix a shift in BitBltSimulation. The shift must be signed but the > simulator incorrectly makes it unsigned leading to memory exhaustion error. > > Let FilePlugin>>primitiveDirectoryDelete primitiveFail rather than raising > a mustBeBoolean error. > > Fix 64bits simulation of long64At:put: that would fail for negative put > value. > > Provide a SpurMemoryManager stSizeOf: for simulation purpose (the message > is used by some plugins). > > Restore a more intention revealing literal in reverseDisplayFrom:to: > > =============== Diff against VMMaker.oscog-dtl.1730 =============== > > Item was changed: > ----- Method: BitBltSimulation>>rgbMapPixel:flags: (in category 'color > mapping') ----- > rgbMapPixel: sourcePixel flags: mapperFlags > "Perform the RGBA conversion for the given source pixel" > | val | > <inline: true> > + val := ((sourcePixel bitAnd: (cmMaskTable at: 0)) > bitShift: (cmShiftTable at: 0) signedIntFromLong). > + val := val bitOr: ((sourcePixel bitAnd: (cmMaskTable at: 1)) > bitShift: (cmShiftTable at: 1) signedIntFromLong). > + val := val bitOr: ((sourcePixel bitAnd: (cmMaskTable at: 2)) > bitShift: (cmShiftTable at: 2) signedIntFromLong). > + ^val bitOr: ((sourcePixel bitAnd: (cmMaskTable at: 3)) > bitShift: (cmShiftTable at: 3) signedIntFromLong). > - val := ((sourcePixel bitAnd: (cmMaskTable at: 0)) > bitShift: (cmShiftTable at: 0)). > - val := val bitOr: ((sourcePixel bitAnd: (cmMaskTable at: 1)) > bitShift: (cmShiftTable at: 1)). > - val := val bitOr: ((sourcePixel bitAnd: (cmMaskTable at: 2)) > bitShift: (cmShiftTable at: 2)). > - ^val bitOr: ((sourcePixel bitAnd: (cmMaskTable at: 3)) > bitShift: (cmShiftTable at: 3)). > ! > > Item was changed: > ----- Method: FilePlugin>>primitiveDirectoryDelete (in category > 'directory primitives') ----- > primitiveDirectoryDelete > > | dirName dirNameIndex dirNameSize okToDelete | > <var: #dirNameIndex type: 'char *'> > <export: true> > > dirName := interpreterProxy stackValue: 0. > (interpreterProxy isBytes: dirName) > ifFalse: [^interpreterProxy primitiveFail]. > dirNameIndex := interpreterProxy firstIndexableField: dirName. > dirNameSize := interpreterProxy byteSizeOf: dirName. > "If the security plugin can be loaded, use it to check for > permission. > If not, assume it's ok" > sCDPfn ~= 0 > + ifTrue: [okToDelete := self cCode: ' ((sqInt (*)(char *, > sqInt))sCDPfn)(dirNameIndex, dirNameSize)' inSmalltalk: [false]. > - ifTrue: [okToDelete := self cCode: ' ((sqInt (*)(char *, > sqInt))sCDPfn)(dirNameIndex, dirNameSize)'. > okToDelete > ifFalse: [^interpreterProxy > primitiveFail]]. > (self > cCode: 'dir_Delete(dirNameIndex, dirNameSize)' > inSmalltalk: [false]) > ifFalse: [^interpreterProxy primitiveFail]. > interpreterProxy pop: 1! > > Item was changed: > ----- Method: Spur64BitMMLESimulator>>long64At:put: (in category 'memory > access') ----- > long64At: byteAddress put: a64BitValue > byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError]. > self > long32At: byteAddress put: (a64BitValue bitAnd: > 16rffffffff); > + long32At: byteAddress + 4 put: (a64BitValue >> 32 bitAnd: > 16rffffffff). > - long32At: byteAddress + 4 put: a64BitValue >> 32. > ^a64BitValue! > > Item was added: > + ----- Method: SpurMemoryManager>>stSizeOf: (in category 'object access') > ----- > + stSizeOf: oop > + "Return the number of indexable fields in the receiver" > + ^oop basicSize! > > Item was changed: > ----- Method: StackInterpreter>>reverseDisplayFrom:to: (in category 'I/O > primitive support') ----- > reverseDisplayFrom: startIndex to: endIndex > "Reverse the given range of Display words (at different bit > depths, this will reverse different numbers of pixels). Used to > give feedback during VM activities such as garbage > collection when debugging. It is assumed that the given > word range falls entirely within the first line of the Display." > | displayObj displayBits w wordStartIndex wordEndIndex > primFailCodeValue | > displayObj := objectMemory splObj: TheDisplay. > ((objectMemory isPointers: displayObj) and: [(objectMemory > lengthOf: displayObj) >= 4]) ifFalse: [^ nil]. > w := objectMemory fetchPointer: 1 ofObject: displayObj. > displayBits := objectMemory fetchPointer: 0 ofObject: displayObj. > ((objectMemory isImmediate: displayBits) > or: [(objectMemory isNonIntegerObject: w) > or: [objectMemory isPointersNonImm: displayBits]]) ifTrue: [^ nil]. > wordStartIndex := startIndex * 4. > wordEndIndex := endIndex * 4 min: (objectMemory sizeBitsOf: > displayBits). > displayBits := displayBits + objectMemory baseHeaderSize. > displayBits + wordStartIndex to: displayBits + wordEndIndex by: 4 > do: > [:ptr | | reversed | > + reversed := (objectMemory long32At: ptr) bitXor: > 16rFFFFFFFF. > - reversed := (objectMemory long32At: ptr) bitXor: > 4294967295. > objectMemory long32At: ptr put: reversed]. > primFailCodeValue := primFailCode. > self initPrimCall. > self displayBitsOf: displayObj Left: 0 Top: 0 Right: (objectMemory > integerValueOf: w) Bottom: 1. > self ioForceDisplayUpdate. > primFailCode := primFailCodeValue! > > -- _,,,^..^,,,_ best, Eliot

2 1

VM Maker: VMMaker.oscog-nice.1733.mcz
by commits＠source.squeak.org 17 Mar '16

17 Mar '16

Nicolas Cellier uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-nice.1733.mcz ==================== Summary ==================== Name: VMMaker.oscog-nice.1733 Author: nice Time: 17 March 2016, 11:45:52.436 pm UUID: cc4513ea-67e5-4b41-b7bd-2fc790ac0102 Ancestors: VMMaker.oscog-nice.1732 Oups (Oops) forgot the <doNotGenerate> for simulated #stSizeOf: version. =============== Diff against VMMaker.oscog-nice.1732 =============== Item was changed: ----- Method: SpurMemoryManager>>stSizeOf: (in category 'object access') ----- stSizeOf: oop "Return the number of indexable fields in the receiver" + <doNotGenerate> ^oop basicSize!

1 0

VM Maker: VMMaker.oscog-nice.1732.mcz
by commits＠source.squeak.org 17 Mar '16

17 Mar '16

Nicolas Cellier uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-nice.1732.mcz ==================== Summary ==================== Name: VMMaker.oscog-nice.1732 Author: nice Time: 17 March 2016, 11:22:07.715 pm UUID: ea9dd158-4847-464e-9642-9786252797dc Ancestors: VMMaker.oscog-nice.1731 Use little endian accelerators too for fetching 32 & 64 bits large integers value (like the ones used for storing value). Dramatically simplify fetching of signedInteger values by using an intermediate unsigned magnitude. Declare the positive32/64BitIntegerFor: and maybeInlinePositive32BitIntegerFor: parameter as unsigned since it is interpreted as positive. Use asUnsignedInteger in isIntegerValue: tests, integerObjectOf: and rotatedFloatBitsOf: in order to ban potential UB. Simplify bit operations using positiveMachineIntegerValueOf:/positiveMachineIntegerFor: rather than doing 32/64 bits dissertation. Fetch magnitude of positive large ints into an unsigned for large int bit ops. =============== Diff against VMMaker.oscog-nice.1731 =============== 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 storeLong64: 0 ofObject: newLargeInteger withValue: magnitude] + ifFalse: [objectMemory storeLong32: 0 ofObject: newLargeInteger withValue: (self cCode: [magnitude] inSmalltalk: [magnitude bitAnd: 16rFFFFFFFF])]]. - [sz > 4 ifTrue: - [objectMemory storeLong32: 1 ofObject: newLargeInteger withValue: magnitude >> 32]. - objectMemory - storeLong32: 0 - ofObject: newLargeInteger - withValue: (self cCode: [magnitude] inSmalltalk: [magnitude bitAnd: 16rFFFFFFFF])]. ^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." | 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]. 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. sz > (self sizeof: #sqLong) ifTrue: [self primitiveFail. ^0]. + 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: + [sz > 4 + ifTrue: [value := self cCoerceSimple: (objectMemory fetchLong64: 0 ofObject: oop) to: #usqLong] + ifFalse: [value := self cCoerceSimple: (objectMemory fetchLong32: 0 ofObject: oop) to: #'unsigned int'].]. - value := objectMemory fetchByte: sz - 1 ofObject: oop. - sz - 2 to: 0 by: -1 do: - [:i | value := value << 8 + (objectMemory fetchByte: i ofObject: oop)]. ^value! 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: [self primitiveFail. ^0]. sz := objectMemory numBytesOfBytes: oop. sz > (self sizeof: #sqLong) ifTrue: [self primitiveFail. ^0]. + self cppIf: VMBIGENDIAN + ifTrue: + [value := 0. + 0 to: sz - 1 do: [:i | + value := value + ((self cCoerce: (objectMemory fetchByte: i ofObject: oop) to: #usqLong) << (i*8))]] + ifFalse: + [sz > 4 + ifTrue: [value := self cCoerceSimple: (objectMemory fetchLong64: 0 ofObject: oop) to: #usqLong] + ifFalse: [value := self cCoerceSimple: (objectMemory fetchLong32: 0 ofObject: oop) to: #'unsigned int'].]. - 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>>primitiveBitAnd (in category 'arithmetic integer primitives') ----- primitiveBitAnd <inline: false> + <var: 'integerArgument' type: #usqInt> + <var: 'intergerReceiver' type: #usqInt> | integerReceiver integerArgument | integerArgument := self stackTop. integerReceiver := self stackValue: 1. "Comment out the short-cut. Either the inline interpreter bytecode or the JIT primitive will handle this case. ((objectMemory isIntegerObject: integerArgument) and: [objectMemory isIntegerObject: integerReceiver]) ifTrue: [self pop: 2 thenPush: (integerArgument bitAnd: integerReceiver)] ifFalse: + [" + integerArgument := self positiveMachineIntegerValueOf: integerArgument. + integerReceiver := self positiveMachineIntegerValueOf: integerReceiver. + self successful ifTrue: + [self pop: 2 thenPush: (self positiveMachineIntegerFor: (integerArgument bitAnd: integerReceiver))] - ["objectMemory wordSize = 8 - ifTrue: - [integerArgument := self positive64BitValueOf: integerArgument. - integerReceiver := self positive64BitValueOf: integerReceiver. - self successful ifTrue: - [self pop: 2 thenPush: (self positive64BitIntegerFor: (integerArgument bitAnd: integerReceiver))]] ifFalse: + []"]"! - [integerArgument := self positive32BitValueOf: integerArgument. - integerReceiver := self positive32BitValueOf: integerReceiver. - self successful ifTrue: - [self pop: 2 thenPush: (self positive32BitIntegerFor: (integerArgument bitAnd: integerReceiver))]]"]"! Item was changed: ----- Method: InterpreterPrimitives>>primitiveBitAndLargeIntegers (in category 'arithmetic largeint primitives') ----- primitiveBitAndLargeIntegers "Primitive logical operations for large integers in 64 bit range" | integerRcvr integerArg oopResult | <export: true> + <var: 'integerRcvr' type: 'usqLong'> + <var: 'integerArg' type: 'usqLong'> - <var: 'integerRcvr' type: 'sqLong'> - <var: 'integerArg' type: 'sqLong'> integerArg := self positive64BitValueOf: (self stackValue: 0). integerRcvr := self positive64BitValueOf: (self stackValue: 1). self successful ifFalse:[^nil]. oopResult := self positive64BitIntegerFor: (integerRcvr bitAnd: integerArg). self successful ifTrue:[self pop: 2 thenPush: oopResult]! Item was changed: ----- Method: InterpreterPrimitives>>primitiveBitOr (in category 'arithmetic integer primitives') ----- primitiveBitOr <inline: false> + <var: 'integerArgument' type: #usqInt> + <var: 'intergerReceiver' type: #usqInt> | integerReceiver integerArgument | integerArgument := self stackTop. integerReceiver := self stackValue: 1. "Comment out the short-cut. Either the inline interpreter bytecode or the JIT primitive will handle this case. ((objectMemory isIntegerObject: integerArgument) and: [objectMemory isIntegerObject: integerReceiver]) ifTrue: [self pop: 2 thenPush: (integerArgument bitOr: integerReceiver)] ifFalse: + [" + integerArgument := self positiveMachineIntegerValueOf: integerArgument. + integerReceiver := self positiveMachineIntegerValueOf: integerReceiver. + self successful ifTrue: + [self pop: 2 thenPush: (self positiveMachineIntegerFor: (integerArgument bitOr: integerReceiver))] - ["objectMemory wordSize = 8 - ifTrue: - [integerArgument := self positive64BitValueOf: integerArgument. - integerReceiver := self positive64BitValueOf: integerReceiver. - self successful ifTrue: - [self pop: 2 thenPush: (self positive64BitIntegerFor: (integerArgument bitOr: integerReceiver))]] ifFalse: + []"]"! - [integerArgument := self positive32BitValueOf: integerArgument. - integerReceiver := self positive32BitValueOf: integerReceiver. - self successful ifTrue: - [self pop: 2 thenPush: (self positive32BitIntegerFor: (integerArgument bitOr: integerReceiver))]]"]"! Item was changed: ----- Method: InterpreterPrimitives>>primitiveBitOrLargeIntegers (in category 'arithmetic largeint primitives') ----- primitiveBitOrLargeIntegers "Primitive logical operations for large integers in 64 bit range" | integerRcvr integerArg oopResult | <export: true> + <var: 'integerRcvr' type: 'usqLong'> + <var: 'integerArg' type: 'usqLong'> - <var: 'integerRcvr' type: 'sqLong'> - <var: 'integerArg' type: 'sqLong'> integerArg := self positive64BitValueOf: (self stackValue: 0). integerRcvr := self positive64BitValueOf: (self stackValue: 1). self successful ifFalse:[^nil]. oopResult := self positive64BitIntegerFor: (integerRcvr bitOr: integerArg). self successful ifTrue:[self pop: 2 thenPush: oopResult]! Item was changed: ----- Method: InterpreterPrimitives>>primitiveBitXor (in category 'arithmetic integer primitives') ----- primitiveBitXor <inline: false> | integerReceiver integerArgument | integerArgument := self stackTop. integerReceiver := self stackValue: 1. ((objectMemory isIntegerObject: integerArgument) and: [objectMemory isIntegerObject: integerReceiver]) ifTrue: "xoring will leave the tag bits zero, whether the tag is 1 or zero, so add it back in." [self pop: 2 thenPush: (integerArgument bitXor: integerReceiver) + objectMemory smallIntegerTag] ifFalse: + [integerArgument := self positiveMachineIntegerValueOf: integerArgument. + integerReceiver := self positiveMachineIntegerValueOf: integerReceiver. + self successful ifTrue: + [self pop: 2 thenPush: (self positiveMachineIntegerFor: (integerArgument bitXor: integerReceiver))]]! - [objectMemory wordSize = 8 - ifTrue: - [integerArgument := self positive64BitValueOf: integerArgument. - integerReceiver := self positive64BitValueOf: integerReceiver. - self successful ifTrue: - [self pop: 2 thenPush: (self positive64BitIntegerFor: (integerArgument bitXor: integerReceiver))]] - ifFalse: - [integerArgument := self positive32BitValueOf: integerArgument. - integerReceiver := self positive32BitValueOf: integerReceiver. - self successful ifTrue: - [self pop: 2 thenPush: (self positive32BitIntegerFor: (integerArgument bitXor: integerReceiver))]]]! Item was changed: ----- Method: InterpreterPrimitives>>primitiveBitXorLargeIntegers (in category 'arithmetic largeint primitives') ----- primitiveBitXorLargeIntegers "Primitive logical operations for large integers in 64 bit range" | integerRcvr integerArg oopResult | <export: true> + <var: 'integerRcvr' type: 'usqLong'> + <var: 'integerArg' type: 'usqLong'> - <var: 'integerRcvr' type: 'sqLong'> - <var: 'integerArg' type: 'sqLong'> integerArg := self positive64BitValueOf: (self stackValue: 0). integerRcvr := self positive64BitValueOf: (self stackValue: 1). self successful ifFalse:[^nil]. oopResult := self positive64BitIntegerFor: (integerRcvr bitXor: integerArg). self successful ifTrue:[self pop: 2 thenPush: oopResult]! 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 magnitude | - | value negative ok | <inline: false> <returnTypeC: #int> <var: #value type: #int> + <var: #magnitude type: #'unsigned int'> <var: #value64 type: #long> (objectMemory isIntegerObject: oop) ifTrue: [objectMemory wordSize = 4 ifTrue: [^objectMemory integerValueOf: oop] ifFalse: "Must fail for SmallIntegers with digitLength > 4" [| value64 | value64 := objectMemory integerValueOf: oop. (self cCode: [(self cCoerceSimple: value64 to: #int) ~= value64] inSmalltalk: [value64 >> 31 ~= 0 and: [value64 >> 31 ~= -1]]) ifTrue: [self primitiveFail. value64 := 0]. ^value64]]. (objectMemory isNonIntegerImmediate: oop) ifTrue: [self primitiveFail. ^0]. 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: [^self primitiveFail]. + magnitude := self cppIf: VMBIGENDIAN - 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) asUnsignedInteger]. + + (negative + ifTrue: [magnitude > 16r80000000] + ifFalse: [magnitude >= 16r80000000]) + ifTrue: + [self primitiveFail. + ^0]. + negative + ifTrue: [value := 0 - magnitude] + ifFalse: [value := magnitude]. + ^value! - [objectMemory fetchLong32: 0 ofObject: oop]. - 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]. - ^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 magnitude | - | sz value negative ok | <inline: false> <returnTypeC: #sqLong> <var: #value type: #sqLong> + <var: #magnitude type: #usqLong> (objectMemory isIntegerObject: oop) ifTrue: [^self cCoerce: (objectMemory integerValueOf: oop) to: #sqLong]. (objectMemory isNonIntegerImmediate: oop) ifTrue: [self primitiveFail. ^0]. 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. sz > (self sizeof: #sqLong) ifTrue: [self primitiveFail. ^0]. self cppIf: VMBIGENDIAN ifTrue: + [magnitude := objectMemory fetchByte: sz - 1 ofObject: oop. - [value := objectMemory fetchByte: sz - 1 ofObject: oop. sz - 2 to: 0 by: -1 do: [:i | + magnitude := magnitude << 8 + (objectMemory fetchByte: i ofObject: oop)]] - value := value << 8 + (objectMemory fetchByte: i ofObject: oop)]] ifFalse: + [magnitude := sz > 4 - [value := sz > 4 ifTrue: [objectMemory fetchLong64: 0 ofObject: oop] ifFalse: [(objectMemory fetchLong32: 0 ofObject: oop) asUnsignedInteger]]. + + (negative + ifTrue: [magnitude > 16r8000000000000000] + ifFalse: [magnitude >= 16r8000000000000000]) + ifTrue: [self primitiveFail. + ^0]. + negative + ifTrue: [value := 0 - magnitude] + ifFalse: [value := magnitude]. + ^value! - "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]. - ^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 limit magnitude | - | negative ok bs value bits | <var: #value type: #long> + <var: #magnitude type: #usqInt> + <var: #limit type: #usqInt> (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: + [magnitude := self cppIf: VMBIGENDIAN - [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]] ifFalse: + [magnitude := self cppIf: VMBIGENDIAN - [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) asUnsignedInteger]]. + + limit := 1 asUnsignedInteger << ((self sizeof: #usqInt) * 8 - 1). + (negative + ifTrue: [magnitude > limit] + ifFalse: [magnitude >= limit]) + ifTrue: [self primitiveFail. + ^0]. + negative + ifTrue: [value := 0 - magnitude] + ifFalse: [value := magnitude]. + ^value! - - 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: InterpreterProxy>>positive32BitIntegerFor: (in category 'converting') ----- positive32BitIntegerFor: integerValue + <var: 'integerValue' type: #'unsigned int'> integerValue isInteger ifFalse:[self error:'Not an Integer object']. ^integerValue > 0 ifTrue:[integerValue] ifFalse:[ (1 bitShift: 32) + integerValue]! Item was changed: ----- Method: InterpreterProxy>>positive64BitIntegerFor: (in category 'converting') ----- positive64BitIntegerFor: integerValue <api> <returnTypeC: #sqInt> "...because answering the 64-bit argument causes the type inferencer to say this answers 64-bits." + <var: 'integerValue' type: #usqLong> - <var: 'integerValue' type: #sqLong> integerValue isInteger ifFalse:[self error:'Not an Integer object']. ^integerValue > 0 ifTrue:[integerValue] ifFalse:[ (1 bitShift: 64) + integerValue]! Item was changed: ----- Method: ObjectMemory>>isIntegerValue: (in category 'interpreter access') ----- isIntegerValue: intValue "Answer if the given value can be represented as a Smalltalk integer value. In C, use a shift and XOR to set the sign bit if and only if the top two bits of the given value are the same, then test the sign bit. Note that the top two bits are equal for exactly those integers in the range that can be represented in 31-bits or 63-bits." <api> ^self + cCode: [(intValue asUnsignedInteger bitXor: (intValue asUnsignedInteger << 1)) asInteger >= 0] + inSmalltalk: [intValue >= self minSmallInteger and: [intValue <= self maxSmallInteger]]! - cCode: [(intValue bitXor: (intValue << 1)) asInteger >= 0] - inSmalltalk: [intValue >= 16r-40000000 and: [intValue <= 16r3FFFFFFF]]! Item was changed: ----- Method: Spur32BitMemoryManager>>isIntegerValue: (in category 'interpreter access') ----- isIntegerValue: intValue "Answer if the given value can be represented as a Smalltalk integer value. In C, use a shift and XOR to set the sign bit if and only if the top two bits of the given value are the same, then test the sign bit. Note that the top two bits are equal for exactly those integers in the range that can be represented in 31-bits or 63-bits." <api> ^self + cCode: [(intValue asUnsignedInteger bitXor: (intValue asUnsignedInteger << 1)) asInteger >= 0] + inSmalltalk: [intValue >= self minSmallInteger and: [intValue <= self maxSmallInteger]]! - cCode: [(intValue bitXor: (intValue << 1)) asInteger >= 0] - inSmalltalk: [intValue >= 16r-40000000 and: [intValue <= 16r3FFFFFFF]]! Item was changed: ----- Method: Spur64BitMemoryManager>>integerObjectOf: (in category 'immediates') ----- integerObjectOf: value "Convert the integer value, assumed to be in SmallInteger range, into a tagged SmallInteger object. In C, use a shift and an add to set the tag bit. In Smalltalk we have to work harder because the simulator works with strictly positive bit patterns." <returnTypeC: #sqInt> ^self + cCode: [value asUnsignedInteger << self numTagBits + 1] - cCode: [value << self numTagBits + 1] inSmalltalk: [value << self numTagBits + (value >= 0 ifTrue: [1] ifFalse: [16r10000000000000001])]! Item was changed: ----- Method: Spur64BitMemoryManager>>isIntegerValue: (in category 'interpreter access') ----- isIntegerValue: intValue "Answer if the given value can be represented as a Smalltalk integer value. In 64-bits we use a 3 bit tag which leaves 61 bits for 2's complement signed integers. In C, use a shift add and mask to test if the top 4 bits are all the same. Since 16rFFFFFFFFFFFFFFFF >> 60 = 16rF the computation intValue >> 60 + 1 bitAnd: 16rF maps in-range -ve values to 0 and in-range +ve values to 1." <api> ^self cCode: [(intValue >> 60 + 1 bitAnd: 16rF) <= 1] "N.B. (16rFFFFFFFFFFFFFFFF >> 60) + 1 = 16" + inSmalltalk: [intValue >= self minSmallInteger and: [intValue <= self maxSmallInteger]]! - inSmalltalk: [intValue >= -16r1000000000000000 and: [intValue <= 16rFFFFFFFFFFFFFFF]]! Item was changed: ----- Method: Spur64BitMemoryManager>>rotatedFloatBitsOf: (in category 'interpreter access') ----- rotatedFloatBitsOf: oop "Answer the signed, but unadjusted value of a SmallFloat64, suitable for use as a hash. Keeping the exponent unadjusted keeps the value in the SmallInteger range. See section 61-bit Immediate Floats in the SpurMemoryManager class comment. msb lsb Decode: [8expsubset][52mantissa][1s][3tags] shift away tags & sign: [ 0000 ][8expsubset][52mantissa] add sign: [ ssss ][8expsubset][52mantissa]" self assert: (self isImmediateFloat: oop). ^oop asUnsignedInteger >> (self numTagBits + 1) + ((oop anyMask: self smallFloatSignBit) + ifTrue: [-1 asUnsignedInteger << (64 - self numTagBits - 1)] - ifTrue: [-1 << (64 - self numTagBits - 1)] ifFalse: [0])! Item was changed: ----- Method: StackInterpreter>>maybeInlinePositive32BitIntegerFor: (in category 'primitive support') ----- maybeInlinePositive32BitIntegerFor: integerValue "N.B. will *not* cause a GC. integerValue is interpreted as POSITIVE, e.g. as the result of Bitmap>at:." <notOption: #Spur64BitMemoryManager> + <var: 'integerValue' type: #'unsigned int'> | newLargeInteger | self deny: objectMemory hasSixtyFourBitImmediates. + integerValue <= objectMemory maxSmallInteger + ifTrue: [^ objectMemory integerObjectOf: integerValue]. - (integerValue asInteger >= 0 - and: [objectMemory isIntegerValue: integerValue]) ifTrue: - [^objectMemory integerObjectOf: integerValue]. newLargeInteger := objectMemory eeInstantiateSmallClassIndex: ClassLargePositiveIntegerCompactIndex format: (objectMemory byteFormatForNumBytes: 4) numSlots: 1. self cppIf: VMBIGENDIAN ifTrue: [objectMemory storeByte: 3 ofObject: newLargeInteger withValue: (integerValue >> 24 bitAnd: 16rFF); storeByte: 2 ofObject: newLargeInteger withValue: (integerValue >> 16 bitAnd: 16rFF); storeByte: 1 ofObject: newLargeInteger withValue: (integerValue >> 8 bitAnd: 16rFF); storeByte: 0 ofObject: newLargeInteger withValue: (integerValue ">> 0" bitAnd: 16rFF)] ifFalse: [objectMemory storeLong32: 0 ofObject: newLargeInteger withValue: integerValue]. ^newLargeInteger! Item was changed: ----- Method: StackInterpreter>>positive32BitIntegerFor: (in category 'primitive support') ----- positive32BitIntegerFor: integerValue "integerValue is interpreted as POSITIVE, e.g. as the result of Bitmap>at:. N.B. Returning in each arm separately enables Slang inlining. /Don't/ return the ifTrue:ifFalse: unless Slang inlining of conditionals is fixed." <inline: true> + <var: 'integerValue' type: #'unsigned int'> objectMemory hasSixtyFourBitImmediates ifTrue: [^objectMemory integerObjectOf: (integerValue bitAnd: 16rFFFFFFFF)] ifFalse: [^self maybeInlinePositive32BitIntegerFor: integerValue]! Item was changed: ----- Method: StackInterpreter>>positive64BitIntegerFor: (in category 'primitive support') ----- positive64BitIntegerFor: integerValue <api> + <var: 'integerValue' type: #usqLong> + <var: 'highWord' type: #'unsigned int'> - <var: 'integerValue' type: #sqLong> "Answer a Large Positive Integer object for the given integer value. N.B. will *not* cause a GC." | newLargeInteger highWord sz | objectMemory hasSixtyFourBitImmediates ifTrue: + [integerValue <= objectMemory maxSmallInteger ifTrue: - [(integerValue >= 0 and: [objectMemory isIntegerValue: integerValue]) ifTrue: [^objectMemory integerObjectOf: integerValue]. sz := 8] ifFalse: + [(highWord := integerValue >> 32) = 0 ifTrue: - [(highWord := integerValue >>> 32) = 0 ifTrue: [^self positive32BitIntegerFor: integerValue]. 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 eeInstantiateSmallClassIndex: ClassLargePositiveIntegerCompactIndex format: (objectMemory byteFormatForNumBytes: sz) numSlots: 8 / objectMemory bytesPerOop. self cppIf: VMBIGENDIAN ifTrue: [objectMemory storeByte: 7 ofObject: newLargeInteger withValue: (integerValue >> 56 bitAnd: 16rFF); storeByte: 6 ofObject: newLargeInteger withValue: (integerValue >> 48 bitAnd: 16rFF); storeByte: 5 ofObject: newLargeInteger withValue: (integerValue >> 40 bitAnd: 16rFF); storeByte: 4 ofObject: newLargeInteger withValue: (integerValue >> 32 bitAnd: 16rFF); storeByte: 3 ofObject: newLargeInteger withValue: (integerValue >> 24 bitAnd: 16rFF); storeByte: 2 ofObject: newLargeInteger withValue: (integerValue >> 16 bitAnd: 16rFF); storeByte: 1 ofObject: newLargeInteger withValue: (integerValue >> 8 bitAnd: 16rFF); storeByte: 0 ofObject: newLargeInteger withValue: (integerValue ">> 0" bitAnd: 16rFF)] ifFalse: [objectMemory storeLong64: 0 ofObject: newLargeInteger withValue: integerValue]. ^newLargeInteger ! Item was changed: ----- Method: StackInterpreter>>signed64BitIntegerFor: (in category 'primitive support') ----- signed64BitIntegerFor: integerValue <var: 'integerValue' type: #sqLong> "Answer a Large Integer object for the given integer value. N.B. will *not* cause a GC." | newLargeInteger magnitude largeClass highWord sz | <inline: false> + <var: 'magnitude' type: #usqLong> - <var: 'magnitude' type: #sqLong> <var: 'highWord' type: #usqInt> - objectMemory wordSize = 8 ifTrue: - [(objectMemory isIntegerValue: integerValue) ifTrue: - [^objectMemory integerObjectOf: integerValue]. - sz := 8]. - integerValue < 0 + ifTrue:[ integerValue >= objectMemory minSmallInteger ifTrue: [^objectMemory integerObjectOf: integerValue asInteger]. + largeClass := ClassLargeNegativeIntegerCompactIndex. + magnitude := 0 - (self cCoerceSimple: integerValue to: #usqLong)] + ifFalse:[ integerValue <= objectMemory maxSmallInteger ifTrue: [^objectMemory integerObjectOf: integerValue asInteger]. + largeClass := ClassLargePositiveIntegerCompactIndex. - ifTrue:[ largeClass := ClassLargeNegativeIntegerCompactIndex. - magnitude := 0 - integerValue] - ifFalse:[ largeClass := ClassLargePositiveIntegerCompactIndex. magnitude := integerValue]. + objectMemory wordSize = 8 + ifTrue: [sz := 8] + ifFalse: [ - "Make sure to handle the most -ve value correctly. 0 - most -ve = most -ve and most -ve - 1 - is +ve. Alas the simple (negative or: [integerValue - 1 < 0]) fails with contemporary gcc and icc - versions with optimization and sometimes without. The shift works on all, touch wood." - - objectMemory wordSize = 4 ifTrue: - [(magnitude <= 16r7FFFFFFF - and: [integerValue >= 0 - or: [0 ~= (self cCode: [integerValue << 1] - inSmalltalk: [integerValue << 1 bitAnd: (1 << 64) - 1])]]) ifTrue: - [^self signed32BitIntegerFor: integerValue]. - (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 eeInstantiateSmallClassIndex: largeClass format: (objectMemory byteFormatForNumBytes: sz) numSlots: sz + 3 // objectMemory bytesPerOop. 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 storeLong64: 0 ofObject: newLargeInteger withValue: magnitude] + ifFalse: [objectMemory storeLong32: 0 ofObject: newLargeInteger withValue: (self cCode: [magnitude] inSmalltalk: [magnitude bitAnd: 16rFFFFFFFF])]]. - [sz > 4 ifTrue: - [objectMemory storeLong32: 1 ofObject: newLargeInteger withValue: magnitude >> 32. - magnitude := magnitude bitAnd: 16rFFFFFFFF]. - objectMemory storeLong32: 0 ofObject: newLargeInteger withValue: magnitude]. ^newLargeInteger!

1 0

VM Maker: VMMaker.oscog-nice.1731.mcz
by commits＠source.squeak.org 17 Mar '16

17 Mar '16

Nicolas Cellier uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-nice.1731.mcz ==================== Summary ==================== Name: VMMaker.oscog-nice.1731 Author: nice Time: 17 March 2016, 10:33:40.804 pm UUID: 5a57b844-0803-41bd-b772-73cf6c7dfb0a Ancestors: VMMaker.oscog-dtl.1730 Fix a shift in BitBltSimulation. The shift must be signed but the simulator incorrectly makes it unsigned leading to memory exhaustion error. Let FilePlugin>>primitiveDirectoryDelete primitiveFail rather than raising a mustBeBoolean error. Fix 64bits simulation of long64At:put: that would fail for negative put value. Provide a SpurMemoryManager stSizeOf: for simulation purpose (the message is used by some plugins). Restore a more intention revealing literal in reverseDisplayFrom:to: =============== Diff against VMMaker.oscog-dtl.1730 =============== Item was changed: ----- Method: BitBltSimulation>>rgbMapPixel:flags: (in category 'color mapping') ----- rgbMapPixel: sourcePixel flags: mapperFlags "Perform the RGBA conversion for the given source pixel" | val | <inline: true> + val := ((sourcePixel bitAnd: (cmMaskTable at: 0)) bitShift: (cmShiftTable at: 0) signedIntFromLong). + val := val bitOr: ((sourcePixel bitAnd: (cmMaskTable at: 1)) bitShift: (cmShiftTable at: 1) signedIntFromLong). + val := val bitOr: ((sourcePixel bitAnd: (cmMaskTable at: 2)) bitShift: (cmShiftTable at: 2) signedIntFromLong). + ^val bitOr: ((sourcePixel bitAnd: (cmMaskTable at: 3)) bitShift: (cmShiftTable at: 3) signedIntFromLong). - val := ((sourcePixel bitAnd: (cmMaskTable at: 0)) bitShift: (cmShiftTable at: 0)). - val := val bitOr: ((sourcePixel bitAnd: (cmMaskTable at: 1)) bitShift: (cmShiftTable at: 1)). - val := val bitOr: ((sourcePixel bitAnd: (cmMaskTable at: 2)) bitShift: (cmShiftTable at: 2)). - ^val bitOr: ((sourcePixel bitAnd: (cmMaskTable at: 3)) bitShift: (cmShiftTable at: 3)). ! Item was changed: ----- Method: FilePlugin>>primitiveDirectoryDelete (in category 'directory primitives') ----- primitiveDirectoryDelete | dirName dirNameIndex dirNameSize okToDelete | <var: #dirNameIndex type: 'char *'> <export: true> dirName := interpreterProxy stackValue: 0. (interpreterProxy isBytes: dirName) ifFalse: [^interpreterProxy primitiveFail]. dirNameIndex := interpreterProxy firstIndexableField: dirName. dirNameSize := interpreterProxy byteSizeOf: dirName. "If the security plugin can be loaded, use it to check for permission. If not, assume it's ok" sCDPfn ~= 0 + ifTrue: [okToDelete := self cCode: ' ((sqInt (*)(char *, sqInt))sCDPfn)(dirNameIndex, dirNameSize)' inSmalltalk: [false]. - ifTrue: [okToDelete := self cCode: ' ((sqInt (*)(char *, sqInt))sCDPfn)(dirNameIndex, dirNameSize)'. okToDelete ifFalse: [^interpreterProxy primitiveFail]]. (self cCode: 'dir_Delete(dirNameIndex, dirNameSize)' inSmalltalk: [false]) ifFalse: [^interpreterProxy primitiveFail]. interpreterProxy pop: 1! Item was changed: ----- Method: Spur64BitMMLESimulator>>long64At:put: (in category 'memory access') ----- long64At: byteAddress put: a64BitValue byteAddress \\ 8 ~= 0 ifTrue: [self unalignedAccessError]. self long32At: byteAddress put: (a64BitValue bitAnd: 16rffffffff); + long32At: byteAddress + 4 put: (a64BitValue >> 32 bitAnd: 16rffffffff). - long32At: byteAddress + 4 put: a64BitValue >> 32. ^a64BitValue! Item was added: + ----- Method: SpurMemoryManager>>stSizeOf: (in category 'object access') ----- + stSizeOf: oop + "Return the number of indexable fields in the receiver" + ^oop basicSize! Item was changed: ----- Method: StackInterpreter>>reverseDisplayFrom:to: (in category 'I/O primitive support') ----- reverseDisplayFrom: startIndex to: endIndex "Reverse the given range of Display words (at different bit depths, this will reverse different numbers of pixels). Used to give feedback during VM activities such as garbage collection when debugging. It is assumed that the given word range falls entirely within the first line of the Display." | displayObj displayBits w wordStartIndex wordEndIndex primFailCodeValue | displayObj := objectMemory splObj: TheDisplay. ((objectMemory isPointers: displayObj) and: [(objectMemory lengthOf: displayObj) >= 4]) ifFalse: [^ nil]. w := objectMemory fetchPointer: 1 ofObject: displayObj. displayBits := objectMemory fetchPointer: 0 ofObject: displayObj. ((objectMemory isImmediate: displayBits) or: [(objectMemory isNonIntegerObject: w) or: [objectMemory isPointersNonImm: displayBits]]) ifTrue: [^ nil]. wordStartIndex := startIndex * 4. wordEndIndex := endIndex * 4 min: (objectMemory sizeBitsOf: displayBits). displayBits := displayBits + objectMemory baseHeaderSize. displayBits + wordStartIndex to: displayBits + wordEndIndex by: 4 do: [:ptr | | reversed | + reversed := (objectMemory long32At: ptr) bitXor: 16rFFFFFFFF. - reversed := (objectMemory long32At: ptr) bitXor: 4294967295. objectMemory long32At: ptr put: reversed]. primFailCodeValue := primFailCode. self initPrimCall. self displayBitsOf: displayObj Left: 0 Top: 0 Right: (objectMemory integerValueOf: w) Bottom: 1. self ioForceDisplayUpdate. primFailCode := primFailCodeValue!

1 0

← Newer
1
...
4
5
6
7
8
9
10
...
14
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev March 2016