Vm-dev April 2016

vm-dev@lists.squeakfoundation.org

35 participants
202 discussions

Re: [Vm-dev] VM Maker: VMMaker.oscog-nice.1765.mcz
by Eliot Miranda 07 Apr '16

07 Apr '16

Hi Nicolas, when I run the simulator (specifically a 32-bit Spur StackInterpreter) I get a missing case in CArray>>#coerceTo:sim: for #'unsigned int *'. Adding code that looks sensible to implement this (see attached) I end up with a VM that does not proceed out of SmallInteger>>startUp: (which is trying to compute the size of maxInt and minInt). This implies that large integer arithmetic is broken and not answering a large integer for (1 << (SmallInteger maxVal highBit - 1)) + (1 << (SmallInteger maxVal highBit - 1)). Clément is visiting me from France for three weeks to work on Sista and we need a functional simulator to be productive. Can you try and fix the simulator and perhaps keep things stable for the next three weeks? I know it's difficult, but Clément and I have very little opportunity to work together (and we pay for the travel out of pocket). Please don't take this personally; we really appreciate your work, and it's not like I haven't broken things badly and often in the past. On Tue, Apr 5, 2016 at 3:29 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.1765.mcz > > ==================== Summary ==================== > > Name: VMMaker.oscog-nice.1765 > Author: nice > Time: 6 April 2016, 12:28:15.115 am > UUID: 7a029a58-3e12-425a-aaa7-13b94d1ddee7 > Ancestors: VMMaker.oscog-nice.1764 > > Ah, yet another simulator species that need support for > byteSwapped32IfBigEndian: (resp. 64) > > =============== Diff against VMMaker.oscog-nice.1764 =============== > > Item was added: > + ----- Method: StackInterpreterSimulatorLSB>>byteSwapped32IfBigEndian: > (in category 'memory access') ----- > + byteSwapped32IfBigEndian: w > + ^w bitAnd: 16rFFFFFFFF! > > Item was added: > + ----- Method: StackInterpreterSimulatorLSB>>byteSwapped64IfBigEndian: > (in category 'memory access') ----- > + byteSwapped64IfBigEndian: w > + ^w bitAnd: 16rFFFFFFFFFFFFFFFF! > > -- _,,,^..^,,,_ best, Eliot

1 2

VM Maker: BytecodeSets.spur-eem.45.mcz
by commits＠source.squeak.org 07 Apr '16

07 Apr '16

Eliot Miranda uploaded a new version of BytecodeSets to project VM Maker: http://source.squeak.org/VMMaker/BytecodeSets.spur-eem.45.mcz ==================== Summary ==================== Name: BytecodeSets.spur-eem.45 Author: eem Time: 6 April 2016, 3:40:50.448174 pm UUID: 1c9b78b4-91f4-4098-9ecf-b5c514b36518 Ancestors: BytecodeSets.spur-eem.44 Setters for receiver & method in FullBlockClosure (for testing) =============== Diff against BytecodeSets.spur-eem.44 =============== Item was added: + ----- Method: FullBlockClosure>>compiledBlock: (in category 'accessing') ----- + compiledBlock: aCompiledMethod + "To be able to inherit from BlockClosure" + startpc := aCompiledMethod! Item was added: + ----- Method: FullBlockClosure>>receiver: (in category 'accessing') ----- + receiver: anObject + receiver := anObject!

1 0

Re: [Vm-dev] VM Maker: VMMaker.oscog-nice.1765.mcz
by Nicolas Cellier 06 Apr '16

06 Apr '16

Oops sorry, this one was un-necessary, I only send this message to the objectMemory, not to the interpreter. Could some admin delete this one? 2016-04-06 0:29 GMT+02:00 <commits(a)source.squeak.org>: > > Nicolas Cellier uploaded a new version of VMMaker to project VM Maker: > http://source.squeak.org/VMMaker/VMMaker.oscog-nice.1765.mcz > > ==================== Summary ==================== > > Name: VMMaker.oscog-nice.1765 > Author: nice > Time: 6 April 2016, 12:28:15.115 am > UUID: 7a029a58-3e12-425a-aaa7-13b94d1ddee7 > Ancestors: VMMaker.oscog-nice.1764 > > Ah, yet another simulator species that need support for > byteSwapped32IfBigEndian: (resp. 64) > > =============== Diff against VMMaker.oscog-nice.1764 =============== > > Item was added: > + ----- Method: StackInterpreterSimulatorLSB>>byteSwapped32IfBigEndian: > (in category 'memory access') ----- > + byteSwapped32IfBigEndian: w > + ^w bitAnd: 16rFFFFFFFF! > > Item was added: > + ----- Method: StackInterpreterSimulatorLSB>>byteSwapped64IfBigEndian: > (in category 'memory access') ----- > + byteSwapped64IfBigEndian: w > + ^w bitAnd: 16rFFFFFFFFFFFFFFFF! > >

2 2

VM Maker: BytecodeSets.spur-eem.44.mcz
by commits＠source.squeak.org 06 Apr '16

06 Apr '16

Eliot Miranda uploaded a new version of BytecodeSets to project VM Maker: http://source.squeak.org/VMMaker/BytecodeSets.spur-eem.44.mcz ==================== Summary ==================== Name: BytecodeSets.spur-eem.44 Author: eem Time: 6 April 2016, 10:39:43.483037 am UUID: 4cc949a7-cd27-473b-83eb-8cd523ec4927 Ancestors: BytecodeSets.spur-cb.43 Add a generic nonExtensionBytecodeAt:in: to BytecodeEncoder class. Add missing sizePushNClosureTemps:. Add doNop default for InstructionClient. Fix typos in EncoderForSistaV1 comment and reserve blockCopy:'s special selector for #~~. =============== Diff against BytecodeSets.spur-cb.43 =============== Item was removed: - ----- Method: BytecodeEncoder class>>nonExtensionBytecodeAt:in: (in category '*BytecodeSets-instruction stream support') ----- - nonExtensionBytecodeAt: pc in: method - "Answer the actual bytecode at pc in method, skipping past any preceeding extensions." - | thePC bytecode | - thePC := pc. - [self isExtension: (bytecode := method at: thePC)] whileTrue: - [thePC := thePC + (self bytecodeSize: bytecode)]. - ^bytecode! Item was removed: - ----- Method: BytecodeEncoder>>sizePushNClosureTemps: (in category '*BytecodeSets-opcode sizing') ----- - sizePushNClosureTemps: numTemps - ^self sizeOpcodeSelector: #genPushNClosureTemps: withArguments: {numTemps}! Item was changed: BytecodeEncoder subclass: #EncoderForSistaV1 (excessive size, no diff calculated) Item was added: + ----- Method: InstructionClient>>doNop (in category '*BytecodeSets-instruction decoding') ----- + doNop + "Do nothing" + + !

1 0

VM Maker: VMMaker.oscog-cb.1774.mcz
by commits＠source.squeak.org 06 Apr '16

06 Apr '16

ClementBera uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-cb.1774.mcz ==================== Summary ==================== Name: VMMaker.oscog-cb.1774 Author: cb Time: 6 April 2016, 10:28:43.581 am UUID: f4e5d06c-ff8a-4732-b3e4-724e85e421ae Ancestors: VMMaker.oscog-eem.1773 more full closure support. =============== Diff against VMMaker.oscog-eem.1773 =============== Item was changed: ----- Method: InterpreterPrimitives>>primitiveClosureValue (in category 'control primitives') ----- primitiveClosureValue | blockClosure numArgs closureMethod outerContext | blockClosure := self stackValue: argumentCount. numArgs := self argumentCountOfClosure: blockClosure. argumentCount = numArgs ifFalse: [^self primitiveFail]. + (self is: blockClosure instanceOf: (objectMemory splObj: ClassBlockClosure) compactClassIndex: ClassBlockClosureCompactIndex) + ifTrue: + [ "Somewhat paranoiac checks we need while debugging that we may be able to discard + in a robust system." + outerContext := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: blockClosure. + (objectMemory isContext: outerContext) ifFalse: + [^self primitiveFail]. + closureMethod := objectMemory fetchPointer: MethodIndex ofObject: outerContext. + "Check if the closure's method is actually a CompiledMethod." + (objectMemory isOopCompiledMethod: closureMethod) ifFalse: + [^self primitiveFail]. - "Somewhat paranoiac checks we need while debugging that we may be able to discard - in a robust system." - outerContext := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: blockClosure. - (objectMemory isContext: outerContext) ifFalse: - [^self primitiveFail]. - closureMethod := objectMemory fetchPointer: MethodIndex ofObject: outerContext. - "Check if the closure's method is actually a CompiledMethod." - (objectMemory isOopCompiledMethod: closureMethod) ifFalse: - [^self primitiveFail]. + "Note we use activateNewMethod, not executeNewMethod, to avoid + quickCheckForInterrupts. Don't check until we have a full activation." + self activateNewClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: true ] + ifFalse: + [ closureMethod := objectMemory fetchPointer: FullClosureCompiledBlockIndex ofObject: blockClosure. + (objectMemory isOopCompiledMethod: closureMethod) + ifFalse: [ ^ self primitiveFail ]. + "Note we use activateNewMethod, not executeNewMethod, to avoid + quickCheckForInterrupts. Don't check until we have a full activation." + self activateNewFullClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: true ]! - "Note we use activateNewMethod, not executeNewMethod, to avoid - quickCheckForInterrupts. Don't check until we have a full activation." - self activateNewClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: true! Item was added: + ----- Method: StackInterpreter>>activateNewFullClosureMethod:numArgs:mayContextSwitch: (in category 'control primitives') ----- + activateNewFullClosureMethod: blockClosure numArgs: numArgs mayContextSwitch: mayContextSwitch + "Similar to activateNewMethod but for Closure and newMethod." + | numCopied outerContext theMethod methodHeader numTemps | + <inline: true> + outerContext := objectMemory fetchPointer: ClosureOuterContextIndex ofObject: blockClosure. + numCopied := self copiedValueCountOfFullClosure: blockClosure. + + theMethod := objectMemory followField: FullClosureCompiledBlockIndex ofObject: blockClosure. + self push: instructionPointer. + self push: framePointer. + framePointer := stackPointer. + self push: theMethod. + self push: (self encodeFrameFieldHasContext: false isBlock: true numArgs: numArgs). + self push: objectMemory nilObject. "FxThisContext field" + self push: (objectMemory followField: FullClosureReceiverIndex ofObject: blockClosure). + + "Copy the copied values..." + 0 to: numCopied - 1 do: + [:i| + self push: (objectMemory + fetchPointer: i + FullClosureFirstCopiedValueIndex + ofObject: blockClosure)]. + + self assert: (self frameIsBlockActivation: framePointer). + self assert: (self frameHasContext: framePointer) not. + + methodHeader := objectMemory methodHeaderOf: newMethod. + numTemps := self temporaryCountOfMethodHeader: methodHeader. + + numArgs + numCopied + 1 to: numTemps do: [ :i | self push: objectMemory nilObject]. + + instructionPointer := (self initialPCForHeader: methodHeader method: newMethod) - 1. + + self setMethod: theMethod. + + "Now check for stack overflow or an event (interrupt, must scavenge, etc)" + stackPointer < stackLimit ifTrue: + [self handleStackOverflowOrEventAllowContextSwitch: mayContextSwitch]! Item was added: + ----- Method: StackInterpreter>>copiedValueCountOfFullClosure: (in category 'internal interpreter access') ----- + copiedValueCountOfFullClosure: closurePointer + <api> "for Cogit" + ^(objectMemory numSlotsOf: closurePointer) - FullClosureFirstCopiedValueIndex!

1 0

VM Maker: VMMaker.oscog-eem.1773.mcz
by commits＠source.squeak.org 06 Apr '16

06 Apr '16

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1773.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.1773 Author: eem Time: 6 April 2016, 10:23:32.090149 am UUID: 7ff9cf9c-6983-47fc-96f1-c3f11eda1376 Ancestors: VMMaker.oscog-cb.1772 Cogit: Follow selectors in the openPICList post Spur become. Move the compare constant convenience up. =============== Diff against VMMaker.oscog-cb.1772 =============== Item was added: + ----- Method: CogMethodZone>>followForwardedLiteralsInOpenPICList (in category 'jit - api') ----- + followForwardedLiteralsInOpenPICList + <option: #SpurObjectMemory> + | openPIC | + <var: #openPIC type: #'CogMethod *'> + openPIC := openPICList. + [openPIC notNil] whileTrue: + [cogit followForwardedLiteralsIn: openPIC. + openPIC := self cCoerceSimple: openPIC nextOpenPIC to: #'CogMethod *'.]! Item was changed: ----- Method: Cogit>>cogitPostGCAction: (in category 'jit - api') ----- cogitPostGCAction: gcMode <api> (gcMode = GCModeFull and: [objectRepresentation allYoungObjectsAgeInFullGC]) ifTrue: [methodZone voidYoungReferrersPostTenureAll]. + self cppIf: SPURVM ifTrue: + [gcMode = GCModeBecome ifTrue: + [methodZone followForwardedLiteralsInOpenPICList]]. "Post-GC update every full method's objectHeader to whatever it needs to be" self assert: self allMethodsHaveCorrectHeader. "The youngReferrers should be correct after a GC since that is the point at which it is pruned. But at other times false positives or free methods on the list are acceptable." self assert: ((gcMode noMask: GCModeFull+GCModeNewSpace) or: [methodZone kosherYoungReferrers])! Item was added: + ----- Method: SimpleStackBasedCogit>>genCompConstant:R: (in category 'bytecode generator support') ----- + genCompConstant: constant R: register + <inline: true> + ^ (objectRepresentation shouldAnnotateObjectReference: constant) + ifTrue: [ self annotate: (self CmpCw: constant R: register) objRef: constant ] + ifFalse: [ self CmpCq: constant R: register ] + ! Item was removed: - ----- Method: StackToRegisterMappingCogit>>genCompConstant:R: (in category 'bytecode generator support') ----- - genCompConstant: constant R: register - <inline: true> - ^ (objectRepresentation shouldAnnotateObjectReference: constant) - ifTrue: [ self annotate: (self CmpCw: constant R: register) objRef: constant ] - ifFalse: [ self CmpCq: constant R: register ] - !

1 0

MIDI Plugins [was [squeak-dev] The Trunk: Sound-mt.53.mcz]
by Eliot Miranda 06 Apr '16

06 Apr '16

Hi All (including some persons I know know MIDI in bcc), with Marcel working on MIDI I'm reminded that MIDI needs some love on Linux and Mac. My understanding is that there exists an alternative to the libasound code on Linux. It would be lovely to have this properly integrated into the svn tree. My understanding is that the Mac MIDI plugin is using Carbon APIs, and hence we don't even have a MIDI plugin for the 64-bit Spur VM on Mac (the Mac Cog VMs all switched over to Cocoa precisely because there is only marginal support for 64-bit apps under Carbon). So it would be great to have the Mac MIDI supoort updated to use newer APIs and to have it work in both 32-bit and 64-bit VMs. I'm asking for volunteers; please help. On Wed, Apr 6, 2016 at 9:25 AM, <commits(a)source.squeak.org> wrote: > Marcel Taeumel uploaded a new version of Sound to project The Trunk: > http://source.squeak.org/trunk/Sound-mt.53.mcz > > ==================== Summary ==================== > > Name: Sound-mt.53 > Author: mt > Time: 6 April 2016, 6:25:53.027926 pm > UUID: 7e1b7e43-e9c2-2a41-90c2-d545cd195582 > Ancestors: Sound-mt.52 > > Disable usage of MIDI device if it does not work. > > =============== Diff against Sound-mt.52 =============== > > Item was changed: > ----- Method: MIDISound>>play (in category 'as yet unclassified') ----- > play > "The base class ScorePlayer has two interfaces: a sound and a > sound player. Choose the right interface depending on whether MIDI support > is present." > > SimpleMIDIPort useMIDIDeviceForOutput ifTrue: [ > [self openMIDIPort] > on: Error > do: [ > SimpleMIDIPort askForDefault. > + [self openMIDIPort] > + on: Error > + do: [ > + self inform: 'Use of MIDI > device is not working. Using custom synthesis.\Go to preferences to change > again.' withCRs. > + SimpleMIDIPort > useMIDIDeviceForOutput: false]]]. > - self openMIDIPort]]. > > self reset; resumePlaying.! > > > -- _,,,^..^,,,_ best, Eliot

4 4

VM Maker: VMMaker.oscog-cb.1772.mcz
by commits＠source.squeak.org 06 Apr '16

06 Apr '16

ClementBera uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-cb.1772.mcz ==================== Summary ==================== Name: VMMaker.oscog-cb.1772 Author: cb Time: 6 April 2016, 10:01:10.859 am UUID: 506063d2-bc8d-49df-806f-6fd35f262345 Ancestors: VMMaker.oscog-nice.1771 Fixed minor details related to full closures. =============== Diff against VMMaker.oscog-nice.1771 =============== Item was changed: ----- Method: StackInterpreter>>fullClosureIn:numArgs:numCopiedValues:compiledBlock: (in category 'control primitives') ----- fullClosureIn: context numArgs: numArgs numCopiedValues: numCopied compiledBlock: compiledBlock | newClosure | <inline: true> - self assert: ClassFullBlockClosureCompactIndex ~= 0. ClassFullBlockClosureCompactIndex ~= 0 ifTrue: [newClosure := objectMemory eeInstantiateSmallClassIndex: ClassFullBlockClosureCompactIndex format: objectMemory indexablePointersFormat numSlots: ClosureFirstCopiedValueIndex + numCopied] ifFalse: [newClosure := objectMemory eeInstantiateSmallClass: (objectMemory splObj: ClassFullBlockClosure) numSlots: FullClosureFirstCopiedValueIndex + numCopied]. "Assume: have just allocated a new closure; it must be young. Thus, can use unchecked stores." objectMemory storePointerUnchecked: ClosureOuterContextIndex ofObject: newClosure withValue: context; storePointerUnchecked: FullClosureCompiledBlockIndex ofObject: newClosure withValue: compiledBlock; storePointerUnchecked: ClosureNumArgsIndex ofObject: newClosure withValue: (objectMemory integerObjectOf: numArgs). ^newClosure! Item was added: + ----- Method: StackInterpreter>>pushFullClosureNumArgs:copiedValues:compiledBlock:receiverIsOnStack: (in category 'stack bytecodes') ----- + pushFullClosureNumArgs: numArgs copiedValues: numCopiedArg compiledBlock: compiledBlock receiverIsOnStack: receiverIsOnStack + "The compiler has pushed the values to be copied, if any. The receiver has been pushed on stack before if specified. + Create a Closure with space for the copiedValues and pop numCopied values off the stack into the closure. + Sets outerContext, compiledBlock, numArgs and receiver as specified.." + <inline: true> + | numCopied newClosure context startIndex | + "No need to record the pushed copied values in the outerContext." + context := self ensureFrameIsMarried: localFP SP: localSP + (numCopiedArg * objectMemory bytesPerOop). + newClosure := self + fullClosureIn: context + numArgs: numArgs + numCopiedValues: numCopiedArg + compiledBlock: compiledBlock. + receiverIsOnStack + ifFalse: + [ startIndex := FullClosureFirstCopiedValueIndex. + objectMemory storePointerUnchecked: FullClosureReceiverIndex + ofObject: newClosure + withValue: self receiver. + numCopied := numCopiedArg ] + ifTrue: + [ startIndex := FullClosureReceiverIndex. + numCopied := numCopiedArg + 1 ]. + numCopied > 0 ifTrue: + [0 to: numCopied - 1 do: + [ :i | + "Assume: have just allocated a new BlockClosure; it must be young. + Thus, can use unchecked stores." + objectMemory storePointerUnchecked: i + startIndex + ofObject: newClosure + withValue: (self internalStackValue: numCopied - i - 1)]. + self internalPop: numCopied]. + self fetchNextBytecode. + self internalPush: newClosure!

1 0

VM Maker: VMMaker.oscog-nice.1771.mcz
by commits＠source.squeak.org 06 Apr '16

06 Apr '16

Nicolas Cellier uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-nice.1771.mcz ==================== Summary ==================== Name: VMMaker.oscog-nice.1771 Author: nice Time: 6 April 2016, 5:06:23.182 am UUID: 36fe278a-84bd-4899-a882-833a4edf8696 Ancestors: VMMaker.oscog-cb.1770 Upgrade LargeIntegersPlugin to v2.0 LargeInteger primitives now deal with 32-bits digits. At image side, LargeInteger digits are still 8-bit wide. This enables fallback code to work in absence of the plugin. Subtle code: 1) Large integers still have byteLength calculated as short as possible this is to avoid having null highest 8-bit digit at image side 2) For this reason largeInt:growTo: takes a byte-length parameter and we need to restore byteSizeOfCSI: and byteSizeOfLargeInt: 3) For multiply, the result is allocated with just enough bytes for example 13 bytes*11 bytes->24 bytes->6 digits If we would round to digits, that would be: 4 digits*3 digits->7 digits for this reason, an additional parameter (resLen) has been added to cDigitMultiply and care is taken to not write a (null) carry past this result length 4) For hypothetical big-endian machines, bytes are swapped on the fly at each fetch/store from/to memory (see cDigitOf:at: / cDigitOf:at:put:) This is achieved thru byteSwapped32IfBigEndian: which translates to a C macro SQ_SWAP_4_BYTES_IF_BIGENDIAN (defined in SVN platforms/Cross/vm/sqMemoryAccess.h) But this is necessary only for arithmetic ops (+ - * / < > ...) For bit ops or copy, there is no need to swap bytes, so direct access to pointer is used. 5) Due to SmartSyntaxInterpreterPlugin, byteSwapped32IfBigEndian: has to be send to self, not to interpreterProxy, otherwise the C function is generated even if we specified <doNotGenerate> in InterpreterProxy... For simulation purposes, this message delegates to InterpreterProxy>>byteSwapped32IfBigEndian: (this time <doNotGenerate> is taken into account in LargeIntegersPlugin) InterpreterProxy should have a knowledge of simulator objectMemory endianness, and we should be able to simulate big endian VM. But it currently does not, so we can only simulate little endian until we fix it. Other than that I renamed a few messages cDigitOfCSI:at: -> digitOfCSI:at: cDigitLengthOfCSI: -> digitSizeOfCSI: This was to have a better symetry with digitOfLargeInt:at: digitSizeOfLargeInt: For the future, some operations could be further optimized: - on Spur VM, objects are 8 byte aligned. If we can make sure that every byte up to byteLenght + 7 // 8 is correctly filled with zero, then we can implement some of the primitives with 64-bits digit (for example comparison and bit-ops) - the copy of digits could be perform with mem:cp:y: - in normalizePositive: / normalizeNegative: it should be possible to shorten a LargeInteger from longByteLen to shortByteLen without reallocating and copying, if ever (shortByteLen + 3 // 4) = (longByteLen + 3 // 4) in V3, and (shortByteLen + 7 // 8) = (longByteLen + 7 // 8) in Spur. I demonstrated this sometimes ago (see http://smallissimo.blogspot.fr/2013/04/still-hacking-largeintegerplugins-in…) OK, this commit message is a bit longer than usual, and maybe this prose should be saved elsewhere, but at least it now exists. =============== Diff against VMMaker.oscog-cb.1770 =============== Item was added: + ----- Method: InterpreterProxy>>byteSwapped32IfBigEndian: (in category 'other') ----- + byteSwapped32IfBigEndian: anInteger + "Note: for simulation only. + This message is not generated in C but replaced with a macro" + <doNotGenerate> + self vmEndianness = 1 ifTrue: [^anInteger byteSwap32]. + ^anInteger! Item was added: + ----- Method: InterpreterProxy>>byteSwapped64IfBigEndian: (in category 'other') ----- + byteSwapped64IfBigEndian: anInteger + "Note: for simulation only. + This message is not generated in C but replaced with a macro" + <doNotGenerate> + self vmEndianness = 1 ifTrue: [^anInteger byteSwap64]. + ^anInteger! Item was changed: SmartSyntaxInterpreterPlugin subclass: #LargeIntegersPlugin instanceVariableNames: 'andOpIndex orOpIndex xorOpIndex' classVariableNames: '' poolDictionaries: '' category: 'VMMaker-Plugins'! + !LargeIntegersPlugin commentStamp: 'nice 4/5/2016 22:27' prior: 0! - !LargeIntegersPlugin commentStamp: 'sr 6/14/2004 14:04' prior: 0! LargeIntegersPlugin provides functions for speeding up LargeInteger arithmetics. Usually it is part of your installation as 'LargeIntegers' plugin (a C-compiled binary). Correctly installed? ---------------------- Probably you are just working with it. To be really sure try 100 factorial. "to force plugin loading" SmalltalkImage current listLoadedModules. Then you should see 'LargeIntegers' somewhere in the output strings. If this should not be the case, you probably have a problem. Variables ----------- Inst vars: andOpIndex C constant orOpIndex C constant xorOpIndex C constant Used like an enum, in ST one would use symbols instead. Class vars: none History -------- + v2.0 + + Rewrite primitives to use 32-bits digits instead of 8-bits digits. This can fasten many operation up to 2x and multiplication up to 7x. + Since Large Integers are still variable byte object, care is taken to allocate just enough bytes to contain integer value (not necessarily a multiple of 4 bytes). + Primitives will use the extra bytes beyond necessary bytes up to next multiple of 4, so it's mandatory that those extra bytes be correctly set to zero + At image side, digits are still 8-bits so that fallback code involve only SmallInteger. + + Primitives assume that byte ordering (endianness) is allways little endian, because LargeIntegers remain regular byte Objects. + On (hypothetic) big endian machines, conversion is performed at fetch/store time thru usage of dedicated macro. + v1.5 - no code change at all compared to v1.4 - made to outsource testing code (LargeIntegersPluginTest) introduced in earlier versions - updated class comment: reference to LargeIntegersPluginTest removed v1.4 - no semantic change compared to v1.3 - >>cHighBit: improved (could be faster now) - fix: class comment - improved class comment - >>flag: introduced to allow #flag: messages (does nothing) - new: class>>buildCodeGeneratorUpTo: as hook for switching debugMode (default is not to change anything) - removed: class>>new (obsolete) - minor cleanup of source code layout v1.3 - fix: >>primDigitDiv:negative: now checks if its Integer args are normalized; without this change the plugin crashes, if a division by zero through a non normalized - filled with zero bytes - arg occurs. This can happen through printing by the inspector windows after changing the bytes of a LargeInteger manually. v1.2 - fix: >>anyBitOfBytes: aBytesOop from: start to: stopArg v1.1 - >>primGetModuleName for checking the version of the plugin; - >>primDigitBitShiftMagnitude and >>primAnyBitFrom:to: for supporting - not installing!! - unification of shift semantics of negative Integers; v1.0 - speeds up digitDiv:neg: at about 20%. In >>cCoreDigitDivDiv:len:rem:len:quo:len: the 'nibble' arithmetic is removed. ! Item was changed: ----- Method: LargeIntegersPlugin class>>version (in category 'translation') ----- version "Answer the receiver's version info as String." + ^ 'v2.0'! - ^ 'v1.5'! Item was changed: ----- Method: LargeIntegersPlugin>>anyBitOfLargeInt:from:to: (in category 'util') ----- + anyBitOfLargeInt: anOop from: start to: stopArg + "Argument has to be a Large Integer!!" - anyBitOfLargeInt: aBytesOop from: start to: stopArg - "Argument has to be aBytesOop!!" "Tests for any magnitude bits in the interval from start to stopArg." + | magnitude stop firstDigitIx lastDigitIx firstMask lastMask | + <var: #digit type: #'unsigned int'> + <var: #firstMask type: #'unsigned int'> + <var: #lastMask type: #'unsigned int'> + <var: #firstDigitIx type: #usqInt> + <var: #lastDigitIx type: #usqInt> + <var: #ix type: #usqInt> - | magnitude rightShift leftShift stop firstByteIx lastByteIx | self + debugCode: [self msg: 'anyBitOfLargeInt: anOop from: start to: stopArg']. - debugCode: [self msg: 'anyBitOfLargeInt: aBytesOop from: start to: stopArg']. start < 1 | (stopArg < 1) ifTrue: [^ interpreterProxy primitiveFail]. + magnitude := anOop. + stop := stopArg min: (self highBitOfLargeInt: magnitude). - magnitude := aBytesOop. - stop := stopArg - min: (self highBitOfLargeInt: magnitude). start > stop ifTrue: [^ false]. + firstDigitIx := start - 1 // 32 + 1. + lastDigitIx := stop - 1 // 32 + 1. + firstMask := 16rFFFFFFFF asUnsignedLong << (start - 1 bitAnd: 31). "Note asUnsignedLong required to avoid ULLL suffix bug" + lastMask := 16rFFFFFFFF >> (31 - (stop - 1 bitAnd: 31)). + firstDigitIx = lastDigitIx + ifTrue: [| digit | + digit := self unsafeDigitOfLargeInt: magnitude at: firstDigitIx. + ^ (digit bitAnd: (firstMask bitAnd: lastMask)) - firstByteIx := start - 1 // 8 + 1. - lastByteIx := stop - 1 // 8 + 1. - rightShift := (start - 1 \\ 8). - leftShift := 7 - (stop - 1 \\ 8). - firstByteIx = lastByteIx - ifTrue: [| digit mask | - mask := (255 << rightShift) bitAnd: (255 >> leftShift). - digit := self digitOfLargeInt: magnitude at: firstByteIx. - ^ (digit bitAnd: mask) ~= 0]. + ((self unsafeDigitOfLargeInt: magnitude at: firstDigitIx) bitAnd: firstMask) - ((self digitOfLargeInt: magnitude at: firstByteIx) - >> rightShift) ~= 0 ifTrue: [^ true]. + firstDigitIx + 1 + to: lastDigitIx - 1 + do: [:ix | (self unsafeDigitOfLargeInt: magnitude at: ix) - firstByteIx + 1 - to: lastByteIx - 1 - do: [:ix | (self digitOfLargeInt: magnitude at: ix) ~= 0 ifTrue: [^ true]]. + ((self unsafeDigitOfLargeInt: magnitude at: lastDigitIx) bitAnd: lastMask) - (((self digitOfLargeInt: magnitude at: lastByteIx) - << leftShift) - bitAnd: 255) ~= 0 ifTrue: [^ true]. ^ false! Item was added: + ----- Method: LargeIntegersPlugin>>byteSizeOfCSI: (in category 'util') ----- + byteSizeOfCSI: csi + "Answer the number of bytes required to represent the value of a C-SmallInteger." + csi >= 0 ifTrue: + [csi < 256 ifTrue: + [^1]. + csi < 65536 ifTrue: + [^2]. + csi < 16777216 ifTrue: + [^3]. + self cppIf: interpreterProxy bytesPerOop = 4 + ifTrue: + [^4] + ifFalse: + [csi < 4294967296 ifTrue: + [^4]. + csi < 1099511627776 ifTrue: + [^5]. + csi < 281474976710656 ifTrue: + [^6]. + csi < 72057594037927936 ifTrue: + [^7]. + ^8]]. + csi > -256 ifTrue: + [^1]. + csi > -65536 ifTrue: + [^2]. + csi > -16777216 ifTrue: + [^3]. + self cppIf: interpreterProxy bytesPerOop = 4 + ifTrue: + [^4] + ifFalse: + [csi > -4294967296 ifTrue: + [^4]. + csi > -1099511627776 ifTrue: + [^5]. + csi > -281474976710656 ifTrue: + [^6]. + csi > -72057594037927936 ifTrue: + [^7]. + ^8]! Item was added: + ----- Method: LargeIntegersPlugin>>byteSizeOfLargeInt: (in category 'util') ----- + byteSizeOfLargeInt: bytesOop + "Answer the number of bytes required to represent a LargeInteger. + Precondition: bytesOop is not a small integer." + ^ interpreterProxy slotSizeOf: bytesOop! Item was added: + ----- Method: LargeIntegersPlugin>>byteSwapped32IfBigEndian: (in category 'C core util') ----- + byteSwapped32IfBigEndian: anInteger + "This is only for simulation purposes" + <doNotGenerate> + ^interpreterProxy byteSwapped32IfBigEndian: anInteger! Item was added: + ----- Method: LargeIntegersPlugin>>byteSwapped64IfBigEndian: (in category 'C core util') ----- + byteSwapped64IfBigEndian: anInteger + "This is only for simulation purposes" + <doNotGenerate> + ^interpreterProxy byteSwapped64IfBigEndian: anInteger! Item was removed: - ----- Method: LargeIntegersPlugin>>cCopyIntVal:toBytes: (in category 'C core util') ----- - cCopyIntVal: val toBytes: bytes - | pByte | - <var: #pByte type: #'unsigned char *'> - pByte := interpreterProxy firstIndexableField: bytes. - 1 to: (self cDigitLengthOfCSI: val) - do: [:ix | pByte at: ix - 1 put: (self cDigitOfCSI: val at: ix)]! Item was changed: ----- Method: LargeIntegersPlugin>>cDigitAdd:len:with:len:into: (in category 'C core') ----- + cDigitAdd: pWordShort len: shortLen with: pWordLong len: longLen into: pWordRes + "pWordRes len = longLen; returns over.." + | accum | + <returnTypeC: #'unsigned int'> + <var: #pWordShort type: #'unsigned int *'> + <var: #pWordLong type: #'unsigned int *'> + <var: #pWordRes type: #'unsigned int *'> + <var: #accum type: #'unsigned long long'> - cDigitAdd: pByteShort len: shortLen with: pByteLong len: longLen into: pByteRes - "pByteRes len = longLen; returns over.." - | accum limit | - <returnTypeC: #'unsigned char'> - <var: #pByteShort type: #'unsigned char *'> - <var: #pByteLong type: #'unsigned char *'> - <var: #pByteRes type: #'unsigned char *'> - <var: #accum type: #'unsigned int'> accum := 0. + 0 to: shortLen - 1 do: - limit := shortLen - 1. - 0 to: limit do: [:i | + accum := (accum >> 32) + + (self cDigitOf: pWordShort at: i) + + (self cDigitOf: pWordLong at: i). + self cDigitOf: pWordRes at: i put: (accum bitAnd: 16rFFFFFFFF)]. + shortLen to: longLen - 1 do: - accum := (accum >> 8) - + (pByteShort at: i) + (pByteLong at: i). - pByteRes at: i put: (accum bitAnd: 255)]. - limit := longLen - 1. - shortLen to: limit do: [:i | + accum := (accum >> 32) + + (self cDigitOf: pWordLong at: i). + self cDigitOf: pWordRes at: i put: (accum bitAnd: 16rFFFFFFFF)]. + ^ accum >> 32! - accum := (accum >> 8) - + (pByteLong at: i). - pByteRes at: i put: (accum bitAnd: 255)]. - ^ accum >> 8! Item was changed: ----- Method: LargeIntegersPlugin>>cDigitCompare:with:len: (in category 'C core') ----- cDigitCompare: pFirst with: pSecond len: len "Precondition: pFirst len = pSecond len." | secondDigit ix firstDigit | + <var: #pFirst type: #'unsigned int *'> + <var: #pSecond type: #'unsigned int *'> - <var: #pFirst type: #'unsigned char *'> - <var: #pSecond type: #'unsigned char *'> <var: #firstDigit type: #'unsigned int'> <var: #secondDigit type: #'unsigned int'> ix := len - 1. [ix >= 0] whileTrue: [(secondDigit := pSecond at: ix) ~= (firstDigit := pFirst at: ix) + ifTrue: [(self byteSwapped32IfBigEndian: secondDigit) < (self byteSwapped32IfBigEndian: firstDigit) - ifTrue: [secondDigit < firstDigit ifTrue: [^ 1] ifFalse: [^ -1]]. ix := ix - 1]. ^ 0! Item was changed: ----- Method: LargeIntegersPlugin>>cDigitCopyFrom:to:len: (in category 'C core util') ----- cDigitCopyFrom: pFrom to: pTo len: len + <var: #pFrom type: #'unsigned int *'> + <var: #pTo type: #'unsigned int *'> - | limit | - <returnTypeC: #'int'> - <var: #pFrom type: #'unsigned char *'> - <var: #pTo type: #'unsigned char *'> self cCode: '' inSmalltalk: [ (interpreterProxy isKindOf: InterpreterSimulator) ifTrue: [ "called from InterpreterSimulator" + 0 to: (len - 1) * 4 do: [:i | - limit := len - 1. - 0 to: limit do: [:i | interpreterProxy byteAt: pTo + i put: (interpreterProxy byteAt: pFrom + i) ]. ^ 0 ]. ]. + "Note: don't care about endianness here, copy operation is endian neutral" + 0 to: len - 1 do: [:i | pTo at: i put: (pFrom at: i)]. + ^ 0! - limit := len - 1. - 0 to: limit do: [:i | pTo at: i put: (pFrom at: i)]. - ^ 0 - ! Item was changed: ----- Method: LargeIntegersPlugin>>cDigitDiv:len:rem:len:quo:len: (in category 'C core') ----- cDigitDiv: pDiv len: divLen rem: pRem len: remLen quo: pQuo len: quoLen + | dl ql dh dnh j t hi lo r3 l a b cond q r1r2 mul | + <var: #pDiv type: #'unsigned int *'> + <var: #pRem type: #'unsigned int *'> + <var: #pQuo type: #'unsigned int *'> - | dl ql dh dnh j t hi lo r3 l a cond q r1r2 mul b | - <var: #pDiv type: #'unsigned char *'> - <var: #pRem type: #'unsigned char *'> - <var: #pQuo type: #'unsigned char *'> <var: #dh type: #'unsigned int'> <var: #dnh type: #'unsigned int'> <var: #r3 type: #'unsigned int'> + <var: #q type: #'unsigned long long'> + <var: #a type: #'unsigned long long'> + <var: #b type: #'unsigned long long'> + <var: #t type: #'unsigned long long'> + <var: #mul type: #'unsigned long long'> + <var: #hi type: #'unsigned long long'> + <var: #lo type: #'unsigned long long'> + <var: #r1r2 type: #'unsigned long long'> - <var: #q type: #'unsigned int'> - <var: #a type: #'unsigned int'> - <var: #b type: #'unsigned int'> - <var: #t type: #'unsigned int'> - <var: #mul type: #'unsigned int'> - <var: #hi type: #'unsigned int'> - <var: #lo type: #'unsigned int'> - <var: #r1r2 type: #'unsigned int'> dl := divLen - 1. "Last actual byte of data (ST ix)" ql := quoLen. + dh := self cDigitOf: pDiv at: dl - 1. - dh := pDiv at: dl - 1. dl = 1 ifTrue: [dnh := 0] + ifFalse: [dnh := self cDigitOf: pDiv at: dl - 2]. - ifFalse: [dnh := pDiv at: dl - 2]. 1 to: ql do: [:k | "maintain quo*arg+rem=self" + "Estimate rem/div by dividing the leading two unint32 of rem by dh." + "The estimate is q = qhi*16r100000000+qlo, where qhi and qlo are uint32." - "Estimate rem/div by dividing the leading two digits of rem by dh." - "The estimate is q = qhi*16r100+qlo, where qhi and qlo are unsigned char." j := remLen + 1 - k. "r1 := rem digitAt: j." + (self cDigitOf: pRem at: j - 1) - (pRem at: j - 1) = dh + ifTrue: [q := 16rFFFFFFFF] - ifTrue: [q := 16rFF] ifFalse: + ["Compute q = (r1,r2)//dh, t = (r1,r2)\\dh. + Note that r1,r2 are uint64, not uint32." - ["Compute q = (r1,r2)//dh, t = (r1,r2)\\dh." "r2 := (rem digitAt: j - 2)." + r1r2 := self cDigitOf: pRem at: j - 1. + r1r2 := (r1r2 << 32) + (self cDigitOf: pRem at: j - 2). - r1r2 := pRem at: j - 1. - r1r2 := (r1r2 << 8) + (pRem at: j - 2). t := r1r2 \\ dh. q := r1r2 // dh. "Next compute (hi,lo) := q*dnh" mul := q * dnh. + hi := mul >> 32. + lo := mul bitAnd: 16rFFFFFFFF. - hi := mul >> 8. - lo := mul bitAnd: 16rFF. "Correct overestimate of q. Max of 2 iterations through loop -- see Knuth vol. 2" j < 3 ifTrue: [r3 := 0] + ifFalse: [r3 := self cDigitOf: pRem at: j - 3]. - ifFalse: [r3 := pRem at: j - 3]. [(t < hi or: [t = hi and: [r3 < lo]]) ifTrue: ["i.e. (t,r3) < (hi,lo)" q := q - 1. hi = 0 "since hi is unsigned we must have this guard" ifTrue: [cond := false] ifFalse: [lo < dnh ifTrue: [hi := hi - 1. + lo := lo + 16r100000000 - dnh] - lo := lo + 16r100 - dnh] ifFalse: [lo := lo - dnh]. cond := hi >= dh]] ifFalse: [cond := false]. cond] whileTrue: [hi := hi - dh]]. "Subtract q*div from rem" l := j - dl. a := 0. 1 to: divLen do: [:i | + hi := (self cDigitOf: pDiv at: i - 1) * (q >> 32). + lo := (self cDigitOf: pDiv at: i - 1) * (q bitAnd: 16rFFFFFFFF). + b := (self cDigitOf: pRem at: l - 1) - a - (lo bitAnd: 16rFFFFFFFF). + self cDigitOf: pRem at: l - 1 put: (b bitAnd: 16rFFFFFFFF). + "simulate arithmetic shift (preserving sign of b)" + b := b >> 32 bitOr: (0 - (b >> 63) bitAnd: 16rFFFFFFFF00000000). + a := hi + (lo >> 32) - b. - hi := (pDiv at: i - 1) * (q >> 8). - lo := (pDiv at: i - 1) * (q bitAnd: 16rFF). - b := (pRem at: l - 1) - a - (lo bitAnd: 16rFF). - pRem at: l - 1 put: (b bitAnd: 16rFF). - "BEWARE: signed shift is implementation defined in C..." - b := b signedBitShift: -8. - "This is a possible replacement to simulate arithmetic shift (preserving sign of b)" - "b := b >> 8 bitOr: (0 - (b >> ((interpreterProxy sizeof: b)*8""CHAR_BIT""-1)) << 8)." - a := hi + (lo >> 8) - b. l := l + 1]. a > 0 ifTrue: ["Add div back into rem, decrease q by 1" q := q - 1. l := j - dl. a := 0. 1 to: divLen do: [:i | + a := (a >> 32) + + (self cDigitOf: pRem at: l - 1) + (self cDigitOf: pDiv at: i - 1). + self cDigitOf: pRem at: l - 1 put: (a bitAnd: 16rFFFFFFFF). - a := (a >> 8) - + (pRem at: l - 1) + (pDiv at: i - 1). - pRem at: l - 1 put: (a bitAnd: 16rFF). l := l + 1]]. + self cDigitOf: pQuo at: quoLen - k put: q]. - pQuo at: quoLen - k put: q]. ^0! Item was changed: ----- Method: LargeIntegersPlugin>>cDigitHighBit:len: (in category 'C core util') ----- + cDigitHighBit: pUint32 len: len - cDigitHighBit: pByte len: len "Answer the index (in bits) of the high order bit of the receiver, or zero if the receiver is zero. This method is allowed (and needed) for + LargeNegativeIntegers as well, since Squeak's LargeIntegers are sign/magnitude. + Work with 32 bits digits." - LargeNegativeIntegers as well, since Squeak's LargeIntegers are - sign/magnitude." | realLength lastDigit | + <var: #pUint32 type: #'unsigned int *'> - <var: #pByte type: #'unsigned char *'> <var: #lastDigit type: #'unsigned int'> realLength := len. + [realLength = 0 ifTrue: [^0]. + (lastDigit := self cDigitOf: pUint32 at: (realLength := realLength - 1)) = 0] + whileTrue. + ^ (self cHighBit32: lastDigit) + (32 * realLength)! - [(lastDigit := pByte at: realLength - 1) = 0] - whileTrue: [(realLength := realLength - 1) = 0 ifTrue: [^ 0]]. - ^ (self cHighBit: lastDigit) + (8 * (realLength - 1))! Item was removed: - ----- Method: LargeIntegersPlugin>>cDigitLengthOfCSI: (in category 'C core util') ----- - cDigitLengthOfCSI: csi - "Answer the number of bytes required to represent the value of a CSmallInteger." - csi >= 0 ifTrue: - [csi < 256 ifTrue: - [^1]. - csi < 65536 ifTrue: - [^2]. - csi < 16777216 ifTrue: - [^3]. - self cppIf: interpreterProxy bytesPerOop = 4 - ifTrue: - [^4] - ifFalse: - [csi < 4294967296 ifTrue: - [^4]. - csi < 1099511627776 ifTrue: - [^5]. - csi < 281474976710656 ifTrue: - [^6]. - csi < 72057594037927936 ifTrue: - [^7]. - ^8]]. - csi > -256 ifTrue: - [^1]. - csi > -65536 ifTrue: - [^2]. - csi > -16777216 ifTrue: - [^3]. - self cppIf: interpreterProxy bytesPerOop = 4 - ifTrue: - [^4] - ifFalse: - [csi > -4294967296 ifTrue: - [^4]. - csi > -1099511627776 ifTrue: - [^5]. - csi > -281474976710656 ifTrue: - [^6]. - csi > -72057594037927936 ifTrue: - [^7]. - ^8]! Item was changed: ----- Method: LargeIntegersPlugin>>cDigitLshift:from:len:to:len: (in category 'C core') ----- cDigitLshift: shiftCount from: pFrom len: lenFrom to: pTo len: lenTo "C indexed!!" | digitShift bitShift carry limit digit rshift | + <var: #pTo type: #'unsigned int *'> + <var: #pFrom type: #'unsigned int *'> - <var: #pTo type: #'unsigned char *'> - <var: #pFrom type: #'unsigned char *'> <var: #carry type: #'unsigned int'> <var: #digit type: #'unsigned int'> + digitShift := shiftCount // 32. + bitShift := shiftCount \\ 32. - digitShift := shiftCount // 8. - bitShift := shiftCount \\ 8. limit := digitShift - 1. + "Note: 0 is endian neutral, use direct access" 0 to: limit do: [:i | pTo at: i put: 0]. bitShift = 0 ifTrue: ["Fast version for digit-aligned shifts" "C indexed!!" ^ self cDigitReplace: pTo from: digitShift to: lenTo - 1 with: pFrom startingAt: 0]. + "This implementation use at most 31 bits of carry. + bitAnd: 16rFFFFFFFF is only for simulator, useless in C" + rshift := 32 - bitShift. - "This implementation use at most 15 bits of carry. - bitAnd: 16rFF is only for simulator, useless in C" - rshift := 8 - bitShift. carry := 0. limit := lenFrom - 1. 0 to: limit do: [:i | + digit := self cDigitOf: pFrom at: i. + self cDigitOf: pTo at: i + digitShift put: ((carry bitOr: digit << bitShift) bitAnd: 16rFFFFFFFF). - digit := pFrom at: i. - pTo at: i + digitShift put: ((carry bitOr: digit << bitShift) bitAnd: 16rFF). carry := digit >> rshift]. + carry = 0 ifFalse: [self cDigitOf: pTo at: lenTo - 1 put: carry]. + ^0! - carry = 0 ifFalse: [pTo at: lenTo - 1 put: carry]. - ^0 - ! Item was changed: ----- Method: LargeIntegersPlugin>>cDigitMontgomery:len:times:len:modulo:len:mInvModB:into: (in category 'C core') ----- + cDigitMontgomery: pFirst - cDigitMontgomery: pBytesFirst len: firstLen + times: pSecond - times: pBytesSecond len: secondLen + modulo: pThird - modulo: pBytesThird len: thirdLen mInvModB: mInv + into: pRes - into: pBytesRes + | u limit1 limit2 limit3 accum accum2 accum3 lastDigit | + <var: #pFirst type: #'unsigned int *'> + <var: #pSecond type: #'unsigned int *'> + <var: #pThird type: #'unsigned int *'> + <var: #mInv type: #'unsigned int'> + <var: #pRes type: #'unsigned int *'> + <var: #accum type: #'unsigned long long'> + <var: #accum2 type: #'unsigned long long'> + <var: #accum3 type: #'unsigned long long'> + <var: #u type: #'unsigned long long '> + <var: #lastDigit type: #'unsigned int '> - | u limit1 limit2 limit3 accum lastByte | - <var: #pBytesFirst type: #'unsigned char *'> - <var: #pBytesSecond type: #'unsigned char *'> - <var: #pBytesThird type: #'unsigned char *'> - <var: #pBytesRes type: #'unsigned char *'> - <var: #accum type: #'unsigned int'> - <var: #u type: #'unsigned char'> - <var: #lastByte type: #'unsigned char'> limit1 := firstLen - 1. limit2 := secondLen - 1. limit3 := thirdLen - 1. + lastDigit := 0. - lastByte := 0. 0 to: limit1 do: [:i | + accum3 := self cDigitOf: pFirst at: i. + accum3 := accum3*(self cDigitOf: pSecond at: 0) + (self cDigitOf: pRes at: 0). + u := accum3 * mInv bitAnd: 16rFFFFFFFF. + accum2 := u * (self cDigitOf: pThird at: 0). + accum := (accum2 bitAnd: 16rFFFFFFFF) + (accum3 bitAnd: 16rFFFFFFFF). + accum := (accum >> 32) + (accum2 >> 32) + (accum3 >> 32). - accum := (pBytesRes at: 0) + ((pBytesFirst at: i)*(pBytesSecond at: 0)). - u := accum * mInv bitAnd: 255. - accum := accum + (u * (pBytesThird at: 0)). 1 to: limit2 do: [:k | + accum3 := self cDigitOf: pFirst at: i. + accum3 := accum3*(self cDigitOf: pSecond at: k) + (self cDigitOf: pRes at: k). + accum2 := u * (self cDigitOf: pThird at: k). + accum := accum + (accum2 bitAnd: 16rFFFFFFFF) + (accum3 bitAnd: 16rFFFFFFFF). + self cDigitOf: pRes at: k-1 put: (accum bitAnd: 16rFFFFFFFF). + accum := (accum >> 32) + (accum2 >> 32) + (accum3 >> 32)]. - accum := (accum >> 8) + (pBytesRes at: k) + ((pBytesFirst at: i)*(pBytesSecond at: k)) + (u * (pBytesThird at: k)). - pBytesRes at: k-1 put: (accum bitAnd: 255)]. secondLen to: limit3 do: [:k | + accum2 := u * (self cDigitOf: pThird at: k). + accum := accum + (self cDigitOf: pRes at: k) + (accum2 bitAnd: 16rFFFFFFFF). + self cDigitOf: pRes at: k-1 put: (accum bitAnd: 16rFFFFFFFF). + accum := (accum >> 32) + (accum2 >> 32)]. + accum := accum + lastDigit. + self cDigitOf: pRes at: limit3 put: (accum bitAnd: 16rFFFFFFFF). + lastDigit := accum >> 32]. - accum := (accum >> 8) + (pBytesRes at: k) + (u * (pBytesThird at: k)). - pBytesRes at: k-1 put: (accum bitAnd: 255)]. - accum := (accum >> 8) + lastByte. - pBytesRes at: limit3 put: (accum bitAnd: 255). - lastByte := accum >> 8]. firstLen to: limit3 do: [:i | + accum := (self cDigitOf: pRes at: 0). + u := accum * mInv bitAnd: 16rFFFFFFFF. + accum := accum + (u * (self cDigitOf: pThird at: 0)). + accum := accum >> 32. - accum := (pBytesRes at: 0). - u := accum * mInv bitAnd: 255. - accum := accum + (u * (pBytesThird at: 0)). 1 to: limit3 do: [:k | + accum2 := u * (self cDigitOf: pThird at: k). + accum := accum + (self cDigitOf: pRes at: k) + (accum2 bitAnd: 16rFFFFFFFF). + self cDigitOf: pRes at: k-1 put: (accum bitAnd: 16rFFFFFFFF). + accum := (accum >> 32) + (accum2 >> 32)]. + accum := accum + lastDigit. + self cDigitOf: pRes at: limit3 put: (accum bitAnd: 16rFFFFFFFF). + lastDigit := accum >> 32]. + (lastDigit = 0 and: [(self cDigitCompare: pThird with: pRes len: thirdLen) = 1]) ifFalse: [ + "self cDigitSub: pThird len: thirdLen with: pRes len: thirdLen into: pRes" - accum := (accum >> 8) + (pBytesRes at: k) + (u * (pBytesThird at: k)). - pBytesRes at: k-1 put: (accum bitAnd: 255)]. - accum := (accum >> 8) + lastByte. - pBytesRes at: limit3 put: (accum bitAnd: 255). - lastByte := accum >> 8]. - (lastByte = 0 and: [(self cDigitCompare: pBytesThird with: pBytesRes len: thirdLen) = 1]) ifFalse: [ - "self cDigitSub: pBytesThird len: thirdLen with: pBytesRes len: thirdLen into: pBytesRes" accum := 0. 0 to: limit3 do: [:i | + accum := accum + (self cDigitOf: pRes at: i) - (self cDigitOf: pThird at: i). + self cDigitOf: pRes at: i put: (accum bitAnd: 16rFFFFFFFF). + accum := 0 - (accum >> 63)]]. + ^0! - accum := accum + (pBytesRes at: i) - (pBytesThird at: i). - pBytesRes at: i put: (self cCode: [accum] inSmalltalk: [accum bitAnd: 255]). - accum := accum signedBitShift: -8]].! Item was removed: - ----- Method: LargeIntegersPlugin>>cDigitMultiply:len:with:len:into: (in category 'C core') ----- - cDigitMultiply: pByteShort len: shortLen with: pByteLong len: longLen into: pByteRes - | limitLong digit k carry limitShort ab | - <returnTypeC: #'unsigned char'> - <var: #pByteShort type: #'unsigned char *'> - <var: #pByteLong type: #'unsigned char *'> - <var: #pByteRes type: #'unsigned char *'> - <var: #digit type: #'unsigned int'> - <var: #carry type: #'unsigned int'> - <var: #ab type: #'unsigned int'> - (shortLen = 1 and: [(pByteShort at: 0) - = 0]) - ifTrue: [^ 0]. - (longLen = 1 and: [(pByteLong at: 0) - = 0]) - ifTrue: [^ 0]. - "prod starts out all zero" - limitShort := shortLen - 1. - limitLong := longLen - 1. - 0 to: limitShort do: [:i | (digit := pByteShort at: i) ~= 0 - ifTrue: - [k := i. - carry := 0. - "Loop invariant: 0<=carry<=0377, k=i+j-1 (ST)" - "-> Loop invariant: 0<=carry<=0377, k=i+j (C) (?)" - 0 to: limitLong do: - [:j | - ab := (pByteLong at: j). - ab := ab * digit + carry + (pByteRes at: k). - carry := ab >> 8. - pByteRes at: k put: (ab bitAnd: 16rFF). - k := k + 1]. - pByteRes at: k put: carry]]. - ^ 0! Item was added: + ----- Method: LargeIntegersPlugin>>cDigitMultiply:len:with:len:into:len: (in category 'C core') ----- + cDigitMultiply: pWordShort len: shortLen with: pWordLong len: longLen into: pWordRes len: resLen + | limitLong digit k carry limitShort ab | + <returnTypeC: #'unsigned int'> + <var: #pWordShort type: #'unsigned int *'> + <var: #pWordLong type: #'unsigned int *'> + <var: #pWordRes type: #'unsigned int *'> + <var: #digit type: #'unsigned int'> + <var: #carry type: #'unsigned int'> + <var: #ab type: #'unsigned long long'> + (shortLen = 1 and: [(pWordShort at: 0) = 0]) + ifTrue: [^ 0]. + (longLen = 1 and: [(pWordLong at: 0) = 0]) + ifTrue: [^ 0]. + "prod starts out all zero" + limitShort := shortLen - 1. + limitLong := longLen - 1. + 0 to: limitShort do: [:i | (digit := self cDigitOf: pWordShort at: i) ~= 0 + ifTrue: + [k := i. + carry := 0. + "Loop invariant: 0<=carry<=16rFFFFFFFF, k=i+j-1 (ST)" + "-> Loop invariant: 0<=carry<=16rFFFFFFFF, k=i+j (C) (?)" + 0 to: limitLong do: + [:j | + ab := (self cDigitOf: pWordLong at: j). + ab := ab * digit + carry + (self cDigitOf: pWordRes at: k). + carry := ab >> 32. + self cDigitOf: pWordRes at: k put: (ab bitAnd: 16rFFFFFFFF). + k := k + 1]. + k < resLen ifTrue: [self cDigitOf: pWordRes at: k put: carry]]]. + ^ 0! Item was added: + ----- Method: LargeIntegersPlugin>>cDigitOf:at: (in category 'C core util') ----- + cDigitOf: cPointer at: zeroBasedDigitIndex + <inline: true> + <returnTypeC: #'unsigned int'> + <var: 'cPointer' type: #'unsigned int *'> + ^self byteSwapped32IfBigEndian: (cPointer at: zeroBasedDigitIndex)! Item was added: + ----- Method: LargeIntegersPlugin>>cDigitOf:at:put: (in category 'C core util') ----- + cDigitOf: cPointer at: zeroBasedDigitIndex put: aValue + <inline: true> + <returnTypeC: #'unsigned int'> + <var: 'cPointer' type: #'unsigned int *'> + <var: 'aValue' type: #'unsigned int'> + ^cPointer at: zeroBasedDigitIndex put: (self byteSwapped32IfBigEndian: aValue)! Item was removed: - ----- Method: LargeIntegersPlugin>>cDigitOfCSI:at: (in category 'C core util') ----- - cDigitOfCSI: csi at: ix - "Answer the value of an indexable field in the receiver. - LargePositiveInteger uses bytes of base two number, and each is a - 'digit' base 256." - "ST indexed!!" - ^self - cCode: [(csi < 0 - ifTrue: [0 - csi] - ifFalse: [csi]) >> (ix - 1 * 8) bitAnd: 255] - inSmalltalk: [csi digitAt: ix]! Item was changed: ----- Method: LargeIntegersPlugin>>cDigitOp:short:len:long:len:into: (in category 'C core') ----- + cDigitOp: opIndex short: pWordShort len: shortLen long: pWordLong len: longLen into: pWordRes + "pWordRes len = longLen. + NOTE: we don't bother with endianness here, those bit opes are endian-neutral" - cDigitOp: opIndex short: pByteShort len: shortLen long: pByteLong len: longLen into: pByteRes - "pByteRes len = longLen." | limit | + <var: #pWordShort type: #'unsigned int *'> + <var: #pWordLong type: #'unsigned int *'> + <var: #pWordRes type: #'unsigned int *'> - <var: #pByteShort type: #'unsigned char *'> - <var: #pByteLong type: #'unsigned char *'> - <var: #pByteRes type: #'unsigned char *'> limit := shortLen - 1. opIndex = andOpIndex ifTrue: + [0 to: limit do: [:i | pWordRes at: i put: ((pWordShort at: i) + bitAnd: (pWordLong at: i))]. - [0 to: limit do: [:i | pByteRes at: i put: ((pByteShort at: i) - bitAnd: (pByteLong at: i))]. limit := longLen - 1. + shortLen to: limit do: [:i | pWordRes at: i put: 0]. - shortLen to: limit do: [:i | pByteRes at: i put: 0]. ^ 0]. opIndex = orOpIndex ifTrue: + [0 to: limit do: [:i | pWordRes at: i put: ((pWordShort at: i) + bitOr: (pWordLong at: i))]. - [0 to: limit do: [:i | pByteRes at: i put: ((pByteShort at: i) - bitOr: (pByteLong at: i))]. limit := longLen - 1. + shortLen to: limit do: [:i | pWordRes at: i put: (pWordLong at: i)]. - shortLen to: limit do: [:i | pByteRes at: i put: (pByteLong at: i)]. ^ 0]. opIndex = xorOpIndex ifTrue: + [0 to: limit do: [:i | pWordRes at: i put: ((pWordShort at: i) + bitXor: (pWordLong at: i))]. - [0 to: limit do: [:i | pByteRes at: i put: ((pByteShort at: i) - bitXor: (pByteLong at: i))]. limit := longLen - 1. + shortLen to: limit do: [:i | pWordRes at: i put: (pWordLong at: i)]. - shortLen to: limit do: [:i | pByteRes at: i put: (pByteLong at: i)]. ^ 0]. ^ interpreterProxy primitiveFail! Item was changed: ----- Method: LargeIntegersPlugin>>cDigitReplace:from:to:with:startingAt: (in category 'C core util') ----- cDigitReplace: pTo from: start to: stop with: pFrom startingAt: repStart "C indexed!!" + <var: #pTo type: #'unsigned int *'> + <var: #pFrom type: #'unsigned int *'> - <returnTypeC: #'int'> - <var: #pTo type: #'unsigned char *'> - <var: #pFrom type: #'unsigned char *'> ^ self cDigitCopyFrom: pFrom + repStart to: pTo + start len: stop - start + 1! Item was changed: ----- Method: LargeIntegersPlugin>>cDigitRshift:from:len:to:len: (in category 'C core') ----- + cDigitRshift: shiftCount from: pFrom len: lenFrom to: pTo len: lenTo + | carry digit digitShift bitShift leftShift limit start | + <var: #pTo type: #'unsigned int *'> + <var: #pFrom type: #'unsigned int *'> - cDigitRshift: shiftCount from: pFrom len: fromLen to: pTo len: toLen - | digit bitShift carry digitShift leftShift limit start | - <var: #pTo type: #'unsigned char *'> - <var: #pFrom type: #'unsigned char *'> <var: #carry type: #'unsigned int'> <var: #digit type: #'unsigned int'> + digitShift := shiftCount // 32. + bitShift := shiftCount \\ 32. + bitShift = 0 ifTrue: ["Fast version for digit-aligned shifts" - digitShift := shiftCount // 8. - bitShift := shiftCount \\ 8. - bitShift = 0 ifTrue: ["Fast version for byte-aligned shifts" "C indexed!!" ^self cDigitReplace: pTo from: 0 + to: lenTo - 1 - to: toLen - 1 with: pFrom startingAt: digitShift]. + "This implementation use at most 31 bits of carry. + bitAnd: 16rFFFFFFFF is only for simulator, useless in C" + leftShift := 32 - bitShift. + carry := (self cDigitOf: pFrom at: digitShift) >> bitShift. - "This implementation use at most 16 bits of x" - leftShift := 8 - bitShift. - carry := (pFrom at: digitShift) >> bitShift. start := digitShift + 1. + limit := lenFrom - 1. - limit := fromLen - 1. start to: limit do: [:j | + digit := self cDigitOf: pFrom at: j. + self cDigitOf: pTo at: j - start put: ((carry bitOr: digit << leftShift) bitAnd: 16rFFFFFFFF). - digit := pFrom at: j. - pTo at: j - start put: ((carry bitOr: digit << leftShift) bitAnd: 16rFF). carry := digit >> bitShift]. + carry = 0 ifFalse: [self cDigitOf: pTo at: lenTo - 1 put: carry]. - carry = 0 ifFalse: [pTo at: toLen - 1 put: carry]. ^0! Item was changed: ----- Method: LargeIntegersPlugin>>cDigitSub:len:with:len:into: (in category 'C core') ----- + cDigitSub: pWordSmall + len: smallLen + with: pWordLarge + len: largeLen + into: pWordRes - cDigitSub: pByteSmall len: smallLen with: pByteLarge len: largeLen into: pByteRes | z | + <var: #pWordSmall type: #'unsigned int *'> + <var: #pWordLarge type: #'unsigned int *'> + <var: #pWordRes type: #'unsigned int *'> + <var: #z type: #'unsigned long long'> - <var: #pByteSmall type: #'unsigned char *'> - <var: #pByteLarge type: #'unsigned char *'> - <var: #pByteRes type: #'unsigned char *'> - <var: #z type: #'unsigned int'> + z := 0. - z := 0. "Loop invariant is -1<=z<=1" 0 to: smallLen - 1 do: [:i | + z := z + (self cDigitOf: pWordLarge at: i) - (self cDigitOf: pWordSmall at: i). + self cDigitOf: pWordRes at: i put: (z bitAnd: 16rFFFFFFFF). + z := 0 - (z >> 63)]. - z := z + (pByteLarge at: i) - (pByteSmall at: i). - pByteRes at: i put: (self cCode: [z] inSmalltalk: [z bitAnd: 255]). - z := z signedBitShift: -8]. smallLen to: largeLen - 1 do: [:i | + z := z + (self cDigitOf: pWordLarge at: i) . + self cDigitOf: pWordRes at: i put: (z bitAnd: 16rFFFFFFFF). + z := 0 - (z >> 63)]. + ^0! - z := z + (pByteLarge at: i) . - pByteRes at: i put: (self cCode: [z] inSmalltalk: [z bitAnd: 255]). - z := z signedBitShift: -8]. - ! Item was added: + ----- Method: LargeIntegersPlugin>>cHighBit32: (in category 'C core util') ----- + cHighBit32: anUnsignedInt32 + "Answer the index of the high order bit of the argument, or zero if the + argument is zero." + | shifted bitNo | + + <var: #anUnsignedInt32 type: #'unsigned int'> + <var: #shifted type: #'unsigned int'> + shifted := anUnsignedInt32. + bitNo := 0. + shifted < (1 << 16) + ifFalse: [shifted := shifted >> 16. + bitNo := bitNo + 16]. + shifted < (1 << 8) + ifFalse: [shifted := shifted >> 8. + bitNo := bitNo + 8]. + shifted < (1 << 4) + ifFalse: [shifted := shifted >> 4. + bitNo := bitNo + 4]. + shifted < (1 << 2) + ifFalse: [shifted := shifted >> 2. + bitNo := bitNo + 2]. + shifted < (1 << 1) + ifFalse: [shifted := shifted >> 1. + bitNo := bitNo + 1]. + "shifted 0 or 1 now" + ^ bitNo + shifted! Item was removed: - ----- Method: LargeIntegersPlugin>>cHighBit: (in category 'C core util') ----- - cHighBit: uint - "Answer the index of the high order bit of the argument, or zero if the - argument is zero." - "For 64 bit uints there could be added a 32-shift." - | shifted bitNo | - <var: #uint type: #'unsigned int'> - <var: #shifted type: #'unsigned int'> - shifted := uint. - bitNo := 0. - shifted < (1 << 16) - ifFalse: [shifted := shifted bitShift: -16. - bitNo := bitNo + 16]. - shifted < (1 << 8) - ifFalse: [shifted := shifted bitShift: -8. - bitNo := bitNo + 8]. - shifted < (1 << 4) - ifFalse: [shifted := shifted bitShift: -4. - bitNo := bitNo + 4]. - shifted < (1 << 2) - ifFalse: [shifted := shifted bitShift: -2. - bitNo := bitNo + 2]. - shifted < (1 << 1) - ifFalse: [shifted := shifted bitShift: -1. - bitNo := bitNo + 1]. - "shifted 0 or 1 now" - ^ bitNo + shifted! Item was changed: ----- Method: LargeIntegersPlugin>>createLargeFromSmallInteger: (in category 'oop util') ----- createLargeFromSmallInteger: anOop "anOop has to be a SmallInteger!!" + | val res pDigit byteSize digitSize | + <var: #pDigit type: #'unsigned int *'> - | val class size res pByte byte | - <var: #pByte type: #'unsigned char *'> val := interpreterProxy integerValueOf: anOop. + byteSize := self byteSizeOfCSI: val. + res := self createLargeIntegerNeg: val < 0 byteLength: byteSize. + pDigit := interpreterProxy firstIndexableField: res. + digitSize := byteSize + 3 // 4. + 1 to: digitSize do: [:ix | self cDigitOf: pDigit at: ix - 1 put: (self digitOfCSI: val at: ix)]. + ^ res! - val < 0 - ifTrue: [class := interpreterProxy classLargeNegativeInteger] - ifFalse: [class := interpreterProxy classLargePositiveInteger]. - size := self cDigitLengthOfCSI: val. - res := interpreterProxy instantiateClass: class indexableSize: size. - pByte := interpreterProxy firstIndexableField: res. - 1 to: size do: [:ix | - byte := self cDigitOfCSI: val at: ix. - pByte at: ix - 1 put: byte]. - ^res! Item was added: + ----- Method: LargeIntegersPlugin>>createLargeIntegerNeg:byteLength: (in category 'util') ----- + createLargeIntegerNeg: neg byteLength: byteLength + <inline: true> + ^interpreterProxy + instantiateClass: (neg + ifTrue: [interpreterProxy classLargeNegativeInteger] + ifFalse: [interpreterProxy classLargePositiveInteger]) + indexableSize: byteLength! Item was added: + ----- Method: LargeIntegersPlugin>>createLargeIntegerNeg:digitLength: (in category 'util') ----- + createLargeIntegerNeg: neg digitLength: digitLength + <inline: true> + ^self + createLargeIntegerNeg: neg byteLength: digitLength * 4! Item was changed: ----- Method: LargeIntegersPlugin>>digit:Lshift: (in category 'oop functions') ----- + digit: anOop Lshift: shiftCount + "Attention: this method invalidates all oop's!! Only newOop is valid at return." - digit: aBytesOop Lshift: shiftCount - "Attention: this method invalidates all oop's!! Only newBytes is valid at return." "Does not normalize." + | newOop highBit newDigitLen newByteLen oldDigitLen | + oldDigitLen := self digitSizeOfLargeInt: anOop. + (highBit := self cDigitHighBit: (interpreterProxy firstIndexableField: anOop) + len: oldDigitLen) = 0 ifTrue: [^ interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: anOop) indexableSize: 1]. + newByteLen := highBit + shiftCount + 7 // 8. + self remapOop: anOop in: [newOop := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: anOop) + indexableSize: newByteLen]. + newDigitLen := newByteLen + 3 // 4. - | newBytes highBit newLen oldLen | - oldLen := self digitSizeOfLargeInt: aBytesOop. - (highBit := self cDigitHighBit: (interpreterProxy firstIndexableField: aBytesOop) - len: oldLen) = 0 ifTrue: [^ 0 asOop: SmallInteger]. - newLen := highBit + shiftCount + 7 // 8. - self remapOop: aBytesOop in: [newBytes := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesOop) - indexableSize: newLen]. self cDigitLshift: shiftCount + from: (interpreterProxy firstIndexableField: anOop) + len: oldDigitLen + to: (interpreterProxy firstIndexableField: newOop) + len: newDigitLen. + ^ newOop! - from: (interpreterProxy firstIndexableField: aBytesOop) - len: oldLen - to: (interpreterProxy firstIndexableField: newBytes) - len: newLen. - ^ newBytes! Item was changed: ----- Method: LargeIntegersPlugin>>digit:Rshift:lookfirst: (in category 'oop functions') ----- + digit: anOop Rshift: shiftCount lookfirst: a - digit: aBytesOop Rshift: shiftCount lookfirst: a "Attention: this method invalidates all oop's!! Only newBytes is valid at return." + "Shift right 32*digitShift+bitShift bits, 0<=bitShift<32. - "Shift right shiftCount bits, 0<=shiftCount. Discard all digits beyond a, and all zeroes at or below a." "Does not normalize." + | newByteLen newOop oldBitLen newBitLen oldDigitLen newDigitLen | + oldBitLen := self cDigitHighBit: (interpreterProxy firstIndexableField: anOop) len: a. + oldDigitLen := oldBitLen + 31 // 32. - | newByteLen newOop oldBitLen newBitLen oldDigitLen | - oldBitLen := self cDigitHighBit: (interpreterProxy firstIndexableField: aBytesOop) len: a. - oldDigitLen := oldBitLen + 7 // 8. newBitLen := oldBitLen - shiftCount. newBitLen <= 0 ifTrue: ["All bits lost" ^ interpreterProxy + instantiateClass: (interpreterProxy fetchClassOf: anOop) - instantiateClass: (interpreterProxy fetchClassOf: aBytesOop) indexableSize: 0]. newByteLen := newBitLen + 7 // 8. + newDigitLen := newByteLen + 3 // 4. + self remapOop: anOop in: [newOop := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: anOop) - self remapOop: aBytesOop in: [newOop := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesOop) indexableSize: newByteLen]. self cDigitRshift: shiftCount + from: (interpreterProxy firstIndexableField: anOop) - from: (interpreterProxy firstIndexableField: aBytesOop) len: oldDigitLen to: (interpreterProxy firstIndexableField: newOop) + len: newDigitLen. - len: newByteLen. ^ newOop! Item was changed: ----- Method: LargeIntegersPlugin>>digitAddLarge:with: (in category 'oop functions') ----- digitAddLarge: firstInteger with: secondInteger "Does not need to normalize!!" + | over firstDigitLen secondDigitLen shortInt shortDigitLen longInt longDigitLen sum newSum neg | + <var: #over type: #'unsigned int'> + firstDigitLen := self digitSizeOfLargeInt: firstInteger. + secondDigitLen := self digitSizeOfLargeInt: secondInteger. + neg := (interpreterProxy fetchClassOf: firstInteger) + = interpreterProxy classLargeNegativeInteger. + firstDigitLen <= secondDigitLen - | over firstLen secondLen shortInt shortLen longInt longLen sum newSum resClass | - <var: #over type: #'unsigned char'> - firstLen := self digitSizeOfLargeInt: firstInteger. - secondLen := self digitSizeOfLargeInt: secondInteger. - resClass := interpreterProxy fetchClassOf: firstInteger. - firstLen <= secondLen ifTrue: [shortInt := firstInteger. + shortDigitLen := firstDigitLen. - shortLen := firstLen. longInt := secondInteger. + longDigitLen := secondDigitLen] - longLen := secondLen] ifFalse: [shortInt := secondInteger. + shortDigitLen := secondDigitLen. - shortLen := secondLen. longInt := firstInteger. + longDigitLen := firstDigitLen]. - longLen := firstLen]. " sum := Integer new: len neg: firstInteger negative." + self remapOop: #(shortInt longInt ) in: [sum := self createLargeIntegerNeg: neg digitLength: longDigitLen]. - self remapOop: #(shortInt longInt ) in: [sum := interpreterProxy instantiateClass: resClass indexableSize: longLen]. over := self cDigitAdd: (interpreterProxy firstIndexableField: shortInt) + len: shortDigitLen - len: shortLen with: (interpreterProxy firstIndexableField: longInt) + len: longDigitLen - len: longLen into: (interpreterProxy firstIndexableField: sum). over > 0 ifTrue: ["sum := sum growby: 1." + self remapOop: sum in: [newSum := self createLargeIntegerNeg: neg byteLength: longDigitLen * 4 + 1]. - self remapOop: sum in: [newSum := interpreterProxy instantiateClass: resClass indexableSize: longLen + 1]. self cDigitCopyFrom: (interpreterProxy firstIndexableField: sum) to: (interpreterProxy firstIndexableField: newSum) + len: longDigitLen. - len: longLen. sum := newSum. "C index!!" + self cDigitOf: (self cCoerce: (interpreterProxy firstIndexableField: sum) to: 'unsigned int *') + at: longDigitLen put: over] + ifFalse: + [sum := neg + ifTrue: [self normalizeNegative: sum] + ifFalse: [self normalizePositive: sum]]. - (self cCoerce: (interpreterProxy firstIndexableField: sum) - to: 'unsigned char *') - at: longLen put: over]. ^ sum! Item was changed: ----- Method: LargeIntegersPlugin>>digitBitLogic:with:opIndex: (in category 'oop functions') ----- digitBitLogic: firstInteger with: secondInteger opIndex: opIx "Bit logic here is only implemented for positive integers or Zero; if rec or arg is negative, it fails." | firstLarge secondLarge firstLen secondLen shortLen shortLarge longLen longLarge result | (interpreterProxy isIntegerObject: firstInteger) ifTrue: [(interpreterProxy integerValueOf: firstInteger) < 0 ifTrue: [^ interpreterProxy primitiveFail]. "convert it to a not normalized LargeInteger" self remapOop: secondInteger in: [firstLarge := self createLargeFromSmallInteger: firstInteger]] ifFalse: [(interpreterProxy fetchClassOf: firstInteger) = interpreterProxy classLargeNegativeInteger ifTrue: [^ interpreterProxy primitiveFail]. firstLarge := firstInteger]. (interpreterProxy isIntegerObject: secondInteger) ifTrue: [(interpreterProxy integerValueOf: secondInteger) < 0 ifTrue: [^ interpreterProxy primitiveFail]. "convert it to a not normalized LargeInteger" self remapOop: firstLarge in: [secondLarge := self createLargeFromSmallInteger: secondInteger]] ifFalse: [(interpreterProxy fetchClassOf: secondInteger) = interpreterProxy classLargeNegativeInteger ifTrue: [^ interpreterProxy primitiveFail]. secondLarge := secondInteger]. + firstLen := self byteSizeOfLargeInt: firstLarge. + secondLen := self byteSizeOfLargeInt: secondLarge. - firstLen := self digitSizeOfLargeInt: firstLarge. - secondLen := self digitSizeOfLargeInt: secondLarge. firstLen < secondLen ifTrue: [shortLen := firstLen. shortLarge := firstLarge. longLen := secondLen. longLarge := secondLarge] ifFalse: [shortLen := secondLen. shortLarge := secondLarge. longLen := firstLen. longLarge := firstLarge]. self remapOop: #(shortLarge longLarge ) in: [result := interpreterProxy instantiateClass: interpreterProxy classLargePositiveInteger indexableSize: longLen]. self cDigitOp: opIx short: (interpreterProxy firstIndexableField: shortLarge) + len: shortLen + 3 // 4 - len: shortLen long: (interpreterProxy firstIndexableField: longLarge) + len: longLen + 3 // 4 - len: longLen into: (interpreterProxy firstIndexableField: result). interpreterProxy failed ifTrue: [^ 0]. ^ self normalizePositive: result! Item was changed: ----- Method: LargeIntegersPlugin>>digitCompareLarge:with: (in category 'oop functions') ----- digitCompareLarge: firstInteger with: secondInteger "Compare the magnitude of firstInteger with that of secondInteger. Return a code of 1, 0, -1 for firstInteger >, = , < secondInteger" + | firstDigitLen secondDigitLen | + firstDigitLen := self digitSizeOfLargeInt: firstInteger. + secondDigitLen := self digitSizeOfLargeInt: secondInteger. + secondDigitLen ~= firstDigitLen + ifTrue: [secondDigitLen > firstDigitLen - | firstLen secondLen | - firstLen := self digitSizeOfLargeInt: firstInteger. - secondLen := self digitSizeOfLargeInt: secondInteger. - secondLen ~= firstLen - ifTrue: [secondLen > firstLen ifTrue: [^ -1 asOop: SmallInteger] ifFalse: [^ 1 asOop: SmallInteger]]. ^ (self cDigitCompare: (interpreterProxy firstIndexableField: firstInteger) with: (interpreterProxy firstIndexableField: secondInteger) + len: firstDigitLen) - len: firstLen) asOop: SmallInteger! Item was changed: ----- Method: LargeIntegersPlugin>>digitDivLarge:with:negative: (in category 'oop functions') ----- digitDivLarge: firstInteger with: secondInteger negative: neg "Does not normalize." "Division by zero has to be checked in caller." + | firstDigitLen secondDigitLen quoDigitLen d div rem quo result | + firstDigitLen := self digitSizeOfLargeInt: firstInteger. + secondDigitLen := self digitSizeOfLargeInt: secondInteger. + quoDigitLen := firstDigitLen - secondDigitLen + 1. + quoDigitLen <= 0 - | firstLen secondLen resultClass l d div rem quo result | - firstLen := self digitSizeOfLargeInt: firstInteger. - secondLen := self digitSizeOfLargeInt: secondInteger. - neg - ifTrue: [resultClass := interpreterProxy classLargeNegativeInteger] - ifFalse: [resultClass := interpreterProxy classLargePositiveInteger]. - l := firstLen - secondLen + 1. - l <= 0 ifTrue: [self remapOop: firstInteger in: [result := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2]. result stAt: 1 put: (0 asOop: SmallInteger). result stAt: 2 put: firstInteger. ^ result]. "set rem and div to copies of firstInteger and secondInteger, respectively. However, to facilitate use of Knuth's algorithm, multiply rem and div by 2 (that is, shift) + until the high word of div is >=16r80000000" + d := 32 - (self cHighBit32: (self unsafeDigitOfLargeInt: secondInteger at: secondDigitLen)). - until the high byte of div is >=128" - d := 8 - (self cHighBit: (self unsafeDigitOf: secondInteger at: secondLen)). self remapOop: firstInteger in: [div := self digit: secondInteger Lshift: d. + div := self largeInt: div growTo: (self digitSizeOfLargeInt: div) + 1 * 4]. - div := self largeIntOrInt: div growTo: (self digitLength: div) - + 1]. self remapOop: div in: [rem := self digit: firstInteger Lshift: d. + (self digitSizeOfLargeInt: rem) = firstDigitLen + ifTrue: [rem := self largeInt: rem growTo: firstDigitLen + 1 * 4]]. + self remapOop: #(div rem ) in: [quo := self createLargeIntegerNeg: neg digitLength: quoDigitLen]. - (self digitLength: rem) - = firstLen ifTrue: [rem := self largeIntOrInt: rem growTo: firstLen + 1]]. - self remapOop: #(div rem ) in: [quo := interpreterProxy instantiateClass: resultClass indexableSize: l]. self cDigitDiv: (interpreterProxy firstIndexableField: div) + len: (self digitSizeOfLargeInt: div) - len: (self digitLength: div) rem: (interpreterProxy firstIndexableField: rem) + len: (self digitSizeOfLargeInt: rem) - len: (self digitLength: rem) quo: (interpreterProxy firstIndexableField: quo) + len: (self digitSizeOfLargeInt: quo). - len: (self digitLength: quo). self remapOop: #(quo ) in: [rem := self digit: rem Rshift: d + lookfirst: (self digitSizeOfLargeInt: div) - lookfirst: (self digitLength: div) - 1]. "^ Array with: quo with: rem" self remapOop: #(quo rem ) in: [result := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2]. result stAt: 1 put: quo. result stAt: 2 put: rem. ^ result! Item was removed: - ----- Method: LargeIntegersPlugin>>digitLength: (in category 'util') ----- - digitLength: oop - (interpreterProxy isIntegerObject: oop) - ifTrue: [^ self cDigitLengthOfCSI: (interpreterProxy integerValueOf: oop)] - ifFalse: [^ self digitSizeOfLargeInt: oop]! Item was removed: - ----- Method: LargeIntegersPlugin>>digitLengthOfNonImmediate: (in category 'util') ----- - digitLengthOfNonImmediate: oop - <inline: true> - ^self digitSizeOfLargeInt: oop! Item was changed: ----- Method: LargeIntegersPlugin>>digitMontgomery:times:modulo:mInvModB: (in category 'oop functions') ----- digitMontgomery: firstLarge times: secondLarge modulo: thirdLarge mInvModB: mInv + <var: #mInv type: #'unsigned int'> - | firstLen secondLen thirdLen prod | firstLen := self digitSizeOfLargeInt: firstLarge. secondLen := self digitSizeOfLargeInt: secondLarge. thirdLen := self digitSizeOfLargeInt: thirdLarge. firstLen <= thirdLen ifFalse: [^interpreterProxy primitiveFail]. secondLen <= thirdLen ifFalse: [^interpreterProxy primitiveFail]. + self remapOop: #(firstLarge secondLarge thirdLarge) in: [prod := interpreterProxy instantiateClass: interpreterProxy classLargePositiveInteger indexableSize: thirdLen * 4]. - (mInv >= 0 and: [mInv <= 255]) ifFalse: [^interpreterProxy primitiveFail]. - self remapOop: #(firstLarge secondLarge thirdLarge) in: [prod := interpreterProxy instantiateClass: interpreterProxy classLargePositiveInteger indexableSize: thirdLen]. self cDigitMontgomery: (interpreterProxy firstIndexableField: firstLarge) len: firstLen times: (interpreterProxy firstIndexableField: secondLarge) len: secondLen modulo: (interpreterProxy firstIndexableField: thirdLarge) len: thirdLen mInvModB: mInv into: (interpreterProxy firstIndexableField: prod). ^self normalizePositive: prod! Item was changed: ----- Method: LargeIntegersPlugin>>digitMultiplyLarge:with:negative: (in category 'oop functions') ----- digitMultiplyLarge: firstInteger with: secondInteger negative: neg "Normalizes." + | firstLen secondLen shortInt shortLen longInt longLen prod | + firstLen := self byteSizeOfLargeInt: firstInteger. + secondLen := self byteSizeOfLargeInt: secondInteger. - | firstLen secondLen shortInt shortLen longInt longLen prod resultClass | - firstLen := self digitSizeOfLargeInt: firstInteger. - secondLen := self digitSizeOfLargeInt: secondInteger. firstLen <= secondLen ifTrue: [shortInt := firstInteger. shortLen := firstLen. longInt := secondInteger. longLen := secondLen] ifFalse: [shortInt := secondInteger. shortLen := secondLen. longInt := firstInteger. longLen := firstLen]. + self remapOop: #(shortInt longInt ) in: [prod := self createLargeIntegerNeg: neg byteLength: longLen + shortLen]. - neg - ifTrue: [resultClass := interpreterProxy classLargeNegativeInteger] - ifFalse: [resultClass := interpreterProxy classLargePositiveInteger]. - self remapOop: #(shortInt longInt ) in: [prod := interpreterProxy instantiateClass: resultClass indexableSize: longLen + shortLen]. self cDigitMultiply: (interpreterProxy firstIndexableField: shortInt) + len: shortLen + 3 // 4 - len: shortLen with: (interpreterProxy firstIndexableField: longInt) + len: longLen + 3 // 4 + into: (interpreterProxy firstIndexableField: prod) + len: longLen + shortLen + 3 // 4. + ^neg + ifTrue: [self normalizeNegative: prod] + ifFalse: [self normalizePositive: prod]! - len: longLen - into: (interpreterProxy firstIndexableField: prod). - ^ self normalize: prod! Item was added: + ----- Method: LargeIntegersPlugin>>digitOfCSI:at: (in category 'util') ----- + digitOfCSI: csi at: ix + "Answer the value of a 32 bits digit in a C-SmallInteger." + "ST indexed!!" + ^(csi < 0 + ifTrue: [0 - csi] + ifFalse: [csi]) >> (ix - 1 * 32)! Item was changed: ----- Method: LargeIntegersPlugin>>digitOfLargeInt:at: (in category 'util') ----- digitOfLargeInt: aBytesOop at: ix "Argument has to be aLargeInteger!!" ix > (self digitSizeOfLargeInt: aBytesOop) ifTrue: [^ 0] + ifFalse: [^ self unsafeDigitOfLargeInt: aBytesOop at: ix]! - ifFalse: [^ self unsafeDigitOf: aBytesOop at: ix]! Item was added: + ----- Method: LargeIntegersPlugin>>digitSizeOfCSI: (in category 'util') ----- + digitSizeOfCSI: csi + "Answer the number of 32-bits fields of a C-SmallInteger. This value is + the same as the largest legal subscript." + ^(interpreterProxy maxSmallInteger <= 16r3FFFFFFF) + ifTrue: [1] + ifFalse: [csi > 16rFFFFFFFF asLong "asLong is not really needed here, but avoid generating a warning in 32bits, and harmless in 64bits" + ifTrue: [2] + ifFalse: [csi < -16rFFFFFFFF + ifTrue: [2] + ifFalse: [1]]]! Item was changed: ----- Method: LargeIntegersPlugin>>digitSizeOfLargeInt: (in category 'util') ----- + digitSizeOfLargeInt: anOop + "answer number of 32 bits digits of a Large Integer" + <inline: true> + ^(self byteSizeOfLargeInt: anOop) + 3 // 4! - digitSizeOfLargeInt: bytesOop - "Precondition: bytesOop is not anInteger and a bytes object." - ^ interpreterProxy slotSizeOf: bytesOop! Item was changed: ----- Method: LargeIntegersPlugin>>digitSubLarge:with: (in category 'oop functions') ----- digitSubLarge: firstInteger with: secondInteger "Normalizes." + | firstDigitLen secondDigitLen larger largeDigitLen smaller smallerDigitLen neg resDigitLen res firstNeg | - | firstLen secondLen larger largerLen smaller smallerLen neg resLen res firstNeg | firstNeg := (interpreterProxy fetchClassOf: firstInteger) = interpreterProxy classLargeNegativeInteger. + firstDigitLen := self digitSizeOfLargeInt: firstInteger. + secondDigitLen := self digitSizeOfLargeInt: secondInteger. + firstDigitLen = secondDigitLen ifTrue: + [[firstDigitLen > 1 + and: [(self unsafeDigitOfLargeInt: firstInteger at: firstDigitLen) = (self unsafeDigitOfLargeInt: secondInteger at: firstDigitLen)]] + whileTrue: [firstDigitLen := firstDigitLen - 1]. + secondDigitLen := firstDigitLen]. + (firstDigitLen < secondDigitLen + or: [firstDigitLen = secondDigitLen + and: [(self unsafeDigitOfLargeInt: firstInteger at: firstDigitLen) < (self unsafeDigitOfLargeInt: secondInteger at: firstDigitLen)]]) - firstLen := self digitSizeOfLargeInt: firstInteger. - secondLen := self digitSizeOfLargeInt: secondInteger. - firstLen = secondLen ifTrue: - [[firstLen > 1 - and: [(self digitOfLargeInt: firstInteger at: firstLen) = (self digitOfLargeInt: secondInteger at: firstLen)]] - whileTrue: [firstLen := firstLen - 1]. - secondLen := firstLen]. - (firstLen < secondLen - or: [firstLen = secondLen - and: [(self digitOfLargeInt: firstInteger at: firstLen) < (self digitOfLargeInt: secondInteger at: firstLen)]]) ifTrue: [larger := secondInteger. + largeDigitLen := secondDigitLen. - largerLen := secondLen. smaller := firstInteger. + smallerDigitLen := firstDigitLen. - smallerLen := firstLen. neg := firstNeg == false] ifFalse: [larger := firstInteger. + largeDigitLen := firstDigitLen. - largerLen := firstLen. smaller := secondInteger. + smallerDigitLen := secondDigitLen. - smallerLen := secondLen. neg := firstNeg]. + resDigitLen := largeDigitLen. - resLen := largerLen. self remapOop: #(smaller larger) + in: [res := self createLargeIntegerNeg: neg digitLength: resDigitLen]. - in: [res := interpreterProxy - instantiateClass: (neg - ifTrue: [interpreterProxy classLargeNegativeInteger] - ifFalse: [interpreterProxy classLargePositiveInteger]) - indexableSize: resLen]. self cDigitSub: (interpreterProxy firstIndexableField: smaller) + len: smallerDigitLen - len: smallerLen with: (interpreterProxy firstIndexableField: larger) + len: largeDigitLen - len: largerLen into: (interpreterProxy firstIndexableField: res). ^neg ifTrue: [self normalizeNegative: res] ifFalse: [self normalizePositive: res]! Item was changed: ----- Method: LargeIntegersPlugin>>highBitOfLargeInt: (in category 'util') ----- + highBitOfLargeInt: anOop + <inline: true> + ^ self + cDigitHighBit: (interpreterProxy firstIndexableField: anOop) + len: (self digitSizeOfLargeInt: anOop)! - highBitOfLargeInt: aBytesOop - ^ self cDigitHighBit: (interpreterProxy firstIndexableField: aBytesOop) - len: (self digitSizeOfLargeInt: aBytesOop)! Item was changed: ----- Method: LargeIntegersPlugin>>isNormalized: (in category 'oop functions') ----- isNormalized: anInteger + | len maxVal minVal sLen val class positive | + <var: #val type: #'unsigned long'> + <var: #minVal type: #'unsigned long'> + (interpreterProxy isIntegerObject: anInteger) + ifTrue: [^ true]. - | len class positive pointer | - <var: #pointer type: #'unsigned char *'> - (interpreterProxy isIntegerObject: anInteger) ifTrue: - [^true]. class := interpreterProxy fetchClassOf: anInteger. (positive := class = interpreterProxy classLargePositiveInteger) ifFalse: [class = interpreterProxy classLargeNegativeInteger ifFalse: [interpreterProxy primitiveFailFor: PrimErrBadArgument. ^false]]. - pointer := interpreterProxy cCoerce: (interpreterProxy firstIndexableField: anInteger) to: #'unsigned char *'. "Check for leading zero of LargeInteger" + len := self byteSizeOfLargeInt: anInteger. + len = 0 ifTrue: + [^ false]. + (self unsafeByteOfLargeInt: anInteger at: len) = 0 ifTrue: + [^ false]. - len := self digitLengthOfNonImmediate: anInteger. - (len = 0 or: [(pointer at: len - 1) = 0]) ifTrue: - [^false]. "no leading zero, now check if anInteger is in SmallInteger range or not" + sLen := interpreterProxy maxSmallInteger > 16r3FFFFFFF + ifTrue: [8] + ifFalse: [4]. "maximal digitLength of aSmallInteger" + len > sLen ifTrue: + [^ true]. + len < sLen ifTrue: + [^ false]. + "len = sLen" + ^positive + ifTrue: [maxVal := interpreterProxy maxSmallInteger. "SmallInteger maxVal" + "all bytes of maxVal but the highest one are just FF's" + (self digitOfCSI: anInteger at: sLen // 4) + > (self digitOfCSI: maxVal at: sLen // 4)] + ifFalse: [val := self unsafeDigitOfLargeInt: anInteger at: len // 4. + sLen > 4 ifTrue: [val := val << 32 + (self unsafeDigitOfLargeInt: anInteger at: 1)]. + minVal := 0 - interpreterProxy minSmallInteger. + val > minVal]! - len ~= interpreterProxy bytesPerOop ifTrue: - [^len > interpreterProxy bytesPerOop]. - positive ifTrue: "all bytes of but the highest one are just FF's" - [^(pointer at: interpreterProxy bytesPerOop - 1) - > (self cDigitOfCSI: interpreterProxy maxSmallInteger at: interpreterProxy bytesPerOop)]. - "all bytes of but the highest one are just 00's" - (pointer at: interpreterProxy bytesPerOop - 1) - < (self cDigitOfCSI: interpreterProxy minSmallInteger at: interpreterProxy bytesPerOop) ifTrue: - [^false]. - "if just one digit differs, then anInteger < minval (the corresponding digit byte is greater!!) - and therefore a LargeNegativeInteger" - 0 to: interpreterProxy bytesPerOop - 1 do: - [:ix | - (pointer at: ix) = (self cDigitOfCSI: interpreterProxy minSmallInteger at: ix + 1) ifFalse: - [^true]]. - ^false! Item was changed: ----- Method: LargeIntegersPlugin>>largeInt:growTo: (in category 'oop util') ----- + largeInt: aBytesObject growTo: newByteLen - largeInt: aBytesObject growTo: newLen "Attention: this method invalidates all oop's!! Only newBytes is valid at return." "Does not normalize." + | newBytes oldDigitLen newDigitLen copyLen | - | newBytes oldLen copyLen | self remapOop: aBytesObject in: [newBytes := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesObject) + indexableSize: newByteLen]. + newDigitLen := newByteLen + 3 // 4. + oldDigitLen := self digitSizeOfLargeInt: aBytesObject. + oldDigitLen < newDigitLen + ifTrue: [copyLen := oldDigitLen] + ifFalse: [copyLen := newDigitLen]. - indexableSize: newLen]. - oldLen := self digitSizeOfLargeInt: aBytesObject. - oldLen < newLen - ifTrue: [copyLen := oldLen] - ifFalse: [copyLen := newLen]. self cDigitCopyFrom: (interpreterProxy firstIndexableField: aBytesObject) to: (interpreterProxy firstIndexableField: newBytes) len: copyLen. ^ newBytes! Item was removed: - ----- Method: LargeIntegersPlugin>>largeIntOrInt:growTo: (in category 'oop util') ----- - largeIntOrInt: oop growTo: len - "Attention: this method invalidates all oop's!! Only newBytes is valid at return." - | newBytes val class | - (interpreterProxy isIntegerObject: oop) - ifTrue: - [val := interpreterProxy integerValueOf: oop. - val < 0 - ifTrue: [class := interpreterProxy classLargeNegativeInteger] - ifFalse: [class := interpreterProxy classLargePositiveInteger]. - newBytes := interpreterProxy instantiateClass: class indexableSize: len. - self cCopyIntVal: val toBytes: newBytes] - ifFalse: [newBytes := self largeInt: oop growTo: len]. - ^ newBytes! Item was changed: ----- Method: LargeIntegersPlugin>>normalizeNegative: (in category 'oop functions') ----- normalizeNegative: aLargeNegativeInteger "Check for leading zeroes and return shortened copy if so." "First establish len = significant length." + | val val2 sLen digitLen byteLen oldByteLen minVal | + <var: #val type: #'unsigned long'> + <var: #val2 type: #'unsigned long'> + <var: #minVal type: #'unsigned long'> + digitLen := self digitSizeOfLargeInt: aLargeNegativeInteger. + [digitLen ~= 0 and: [(self unsafeDigitOfLargeInt: aLargeNegativeInteger at: digitLen) = 0]] + whileTrue: [digitLen := digitLen - 1]. + digitLen = 0 ifTrue: [^ 0 asOop: SmallInteger]. - | sLen val len oldLen pointer | - len := oldLen := self digitLengthOfNonImmediate: aLargeNegativeInteger. - pointer := interpreterProxy - cCoerce: (interpreterProxy firstIndexableField: aLargeNegativeInteger) - to: #'unsigned char *'. - [len > 0 and: [(pointer at: len - 1) = 0]] whileTrue: - [len := len - 1]. - len = 0 ifTrue: [^ 0 asOop: SmallInteger]. - "Now check if in SmallInteger range" + val := self unsafeDigitOfLargeInt: aLargeNegativeInteger at: digitLen. sLen := interpreterProxy minSmallInteger < -16r40000000 + ifTrue: [2] + ifFalse: [1]. "SmallInteger minVal digitLength" + digitLen <= sLen + ifTrue: + [minVal := 0 - interpreterProxy minSmallInteger. + val2 := val. + digitLen > 1 ifTrue: [val2 := val2 << 32 + (self unsafeDigitOfLargeInt: aLargeNegativeInteger at: 1)]. + val2 <= minVal + ifTrue: [^0 - val2 asOop: SmallInteger]]. - ifTrue: [8] - ifFalse: [4]. "SmallInteger digitLength" - len <= sLen ifTrue: - [(len < sLen - or: [(pointer at: sLen - 1) - < (self cDigitOfCSI: interpreterProxy minSmallInteger at: sLen)]) ifTrue: "interpreterProxy minSmallInteger lastDigit" - ["If high digit less, then can be small" - val := 0 - (pointer at: (len := len - 1)). - len - 1 to: 0 by: -1 do: - [:i | val := val * 256 - (pointer at: i)]. - ^val asOop: SmallInteger]. - 1 to: sLen do: - [:i | | byte | "If all digits same, then = minSmallInteger (sr: minSmallInteger digits 1 to sLen - 1 are 0)" - byte := i > len ifTrue: [0] ifFalse: [pointer at: i - 1]. - byte ~= (self cDigitOfCSI: interpreterProxy minSmallInteger at: i) ifTrue: "Not so; return self shortened" - [len < oldLen ifTrue: "^ self growto: len" - [^self largeInt: aLargeNegativeInteger growTo: len]. - ^aLargeNegativeInteger]]. - ^interpreterProxy minSmallInteger asOop: SmallInteger]. "Return self, or a shortened copy" + byteLen := digitLen * 4. + val <= 16rFFFF + ifTrue: [byteLen := byteLen - 2] + ifFalse: [val := val >> 16]. + val <= 16rFF + ifTrue: [byteLen := byteLen - 1]. + oldByteLen := self byteSizeOfLargeInt: aLargeNegativeInteger. + byteLen < oldByteLen + ifTrue: [^ self largeInt: aLargeNegativeInteger growTo: byteLen] + ifFalse: [^ aLargeNegativeInteger]! - len < oldLen ifTrue: "^ self growto: len" - [^self largeInt: aLargeNegativeInteger growTo: len]. - ^aLargeNegativeInteger! Item was changed: ----- Method: LargeIntegersPlugin>>normalizePositive: (in category 'oop functions') ----- normalizePositive: aLargePositiveInteger "Check for leading zeroes and return shortened copy if so." "First establish len = significant length." + | val val2 sLen digitLen byteLen oldByteLen maxVal | + <var: #val type: #'unsigned long'> + <var: #val2 type: #'unsigned long'> + <var: #maxVal type: #'unsigned long'> + digitLen := self digitSizeOfLargeInt: aLargePositiveInteger. + [digitLen ~= 0 and: [(self unsafeDigitOfLargeInt: aLargePositiveInteger at: digitLen) = 0]] + whileTrue: [digitLen := digitLen - 1]. + digitLen = 0 ifTrue: [^ 0 asOop: SmallInteger]. - | sLen val len oldLen pointer | - <var: #pointer type: #'unsigned char *'> - len := oldLen := self digitLengthOfNonImmediate: aLargePositiveInteger. - pointer := interpreterProxy - cCoerce: (interpreterProxy firstIndexableField: aLargePositiveInteger) - to: #'unsigned char *'. - [len > 0 and: [(pointer at: len - 1) = 0]] whileTrue: - [len := len - 1]. - len = 0 ifTrue: [^ 0 asOop: SmallInteger]. - "Now check if in SmallInteger range" + val := self unsafeDigitOfLargeInt: aLargePositiveInteger at: digitLen. + sLen := interpreterProxy maxSmallInteger > 16r3FFFFFFF + ifTrue: [2] + ifFalse: [1]. "SmallInteger maxVal digitLength" + digitLen <= sLen + ifTrue: + [maxVal := interpreterProxy maxSmallInteger. + val2 := val. + digitLen > 1 ifTrue: [val2 := val2 << 32 + (self unsafeDigitOfLargeInt: aLargePositiveInteger at: 1)]. + val2 <= maxVal + ifTrue: [^val2 asOop: SmallInteger]]. - sLen := interpreterProxy maxSmallInteger > 16r3FFFFFFF "SmallInteger maxVal digitLength." - ifTrue: [8] - ifFalse: [4]. - len <= sLen ifTrue: - [(len < sLen - or: [(pointer at: sLen - 1) <= (self cDigitOfCSI: interpreterProxy maxSmallInteger at: sLen)]) ifTrue: - ["If so, return its SmallInt value" - val := pointer at: (len := len - 1). - len - 1 to: 0 by: -1 do: - [:i | val := val * 256 + (pointer at: i)]. - ^val asOop: SmallInteger]]. "Return self, or a shortened copy" + byteLen := digitLen * 4. + val <= 16rFFFF + ifTrue: [byteLen := byteLen - 2] + ifFalse: [val := val >> 16]. + val <= 16rFF + ifTrue: [byteLen := byteLen - 1]. + oldByteLen := self byteSizeOfLargeInt: aLargePositiveInteger. + byteLen < oldByteLen + ifTrue: [^ self largeInt: aLargePositiveInteger growTo: byteLen] + ifFalse: [^ aLargePositiveInteger]! - len < oldLen ifTrue: "^ self growto: len" - [^self largeInt: aLargePositiveInteger growTo: len]. - ^aLargePositiveInteger! Item was changed: ----- Method: LargeIntegersPlugin>>primMontgomeryDigitLength (in category 'Integer primitives') ----- primMontgomeryDigitLength self debugCode: [self msg: 'primMontgomeryDigitLength']. self primitive: 'primMontgomeryDigitLength' parameters: #() receiver: #Integer. + ^interpreterProxy integerObjectOf: 32! - ^interpreterProxy integerObjectOf: 8! Item was changed: ----- Method: LargeIntegersPlugin>>primMontgomeryTimes:modulo:mInvModB: (in category 'Integer primitives') ----- + primMontgomeryTimes: secondOperandInteger modulo: thirdModuloInteger mInvModB: mInverseInteger + | firstLarge secondLarge firstInteger thirdLarge mInv | + <var: #mInv type: #'unsigned int'> - primMontgomeryTimes: secondOperandInteger modulo: thirdModuloInteger mInvModB: smallInverseInteger - | firstLarge secondLarge firstInteger thirdLarge | self debugCode: [self msg: 'montgomeryTimes: secondOperandInteger modulo: thirdModuloInteger mInvModB: smallInverseInteger']. firstInteger := self primitive: 'primMontgomeryTimesModulo' + parameters: #(Integer Integer Integer ) - parameters: #(Integer Integer SmallInteger ) receiver: #Integer. + mInv := interpreterProxy positive32BitValueOf: mInverseInteger. (interpreterProxy isIntegerObject: firstInteger) ifTrue: ["convert it to a not normalized LargeInteger" self remapOop: #(secondOperandInteger thirdModuloInteger) in: [firstLarge := self createLargeFromSmallInteger: firstInteger]] ifFalse: [firstLarge := firstInteger]. (interpreterProxy isIntegerObject: secondOperandInteger) ifTrue: ["convert it to a not normalized LargeInteger" self remapOop: #(firstLarge thirdModuloInteger) in: [secondLarge := self createLargeFromSmallInteger: secondOperandInteger]] ifFalse: [secondLarge := secondOperandInteger]. (interpreterProxy isIntegerObject: thirdModuloInteger) ifTrue: ["convert it to a not normalized LargeInteger" self remapOop: #(firstLarge secondLarge) in: [thirdLarge := self createLargeFromSmallInteger: thirdModuloInteger]] ifFalse: [thirdLarge := thirdModuloInteger]. + ^ self digitMontgomery: firstLarge times: secondLarge modulo: thirdLarge mInvModB: mInv! - ^ self digitMontgomery: firstLarge times: secondLarge modulo: thirdLarge mInvModB: smallInverseInteger! Item was added: + ----- Method: LargeIntegersPlugin>>unsafeByteOfLargeInt:at: (in category 'util') ----- + unsafeByteOfLargeInt: bytesObj at: ix + "Argument bytesObj must not be aSmallInteger!!" + <inline: true> + <returnTypeC: #'unsigned char'> + ^(interpreterProxy cCoerce: (interpreterProxy firstIndexableField: bytesObj) to: #'unsigned char *') at: ix - 1! Item was removed: - ----- Method: LargeIntegersPlugin>>unsafeDigitOf:at: (in category 'util') ----- - unsafeDigitOf: bytesObj at: ix - "Argument bytesObj must not be aSmallInteger!!" - <inline: true> - ^(interpreterProxy cCoerce: (interpreterProxy firstIndexableField: bytesObj) to: #'unsigned char *') at: ix - 1! Item was added: + ----- Method: LargeIntegersPlugin>>unsafeDigitOfLargeInt:at: (in category 'util') ----- + unsafeDigitOfLargeInt: anOop at: ix + "Argument must not be aSmallInteger!!" + <inline: true> + <returnTypeC: #'unsigned int'> + ^self cDigitOf: (interpreterProxy cCoerce: (interpreterProxy firstIndexableField: anOop) to: #'unsigned int *') at: ix - 1!

1 0

InterpreterProxy and big-endian simulation
by Nicolas Cellier 06 Apr '16

06 Apr '16

Hi, I now need to use byteSwapped32IfBigEndian: in LargeIntegersPlugin in order to support 32bits digit on hypothetical bigEndian machines. This message will be replaced with a macro during C code generation, so it's only a problem for simulation. My first idea was to delegate to interpreterProxy. Alas, the interpreterProxy is not associated to an objectMemory (or more exactly a simulator of objectMemory) I'm not very satisfied with InterpreterProxy>>vmEndianness It will use the image endianness instead of the simulator endianness... With this, I would be able to simulate littleEndian (most VM/Images are), but I won't be able to simulate bigEndian... Augmenting InterpreterProxy with proper knowledge of ObjectMemory simulator is above my skills... There are 18 class refs, and it does not seems like it has been designed for such support. Alternatively, I could implement byteSwapped32IfBigEndian: in LargeIntegersPlugin. There even is a simulator inst. var. in smart plugins. Alas, this simulator inst. var. is filled with a SmartSyntaxPluginSimulator which also is completely unware of objectMemory... Any idea how I could support big-endian simulation properly?

2 2

← Newer
1
...
14
15
16
17
18
19
20
21
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 April 2016