Vm-dev March 2016

vm-dev@lists.squeakfoundation.org

33 participants
139 discussions

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

28 Mar '16

Nicolas Cellier uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-nice.1745.mcz ==================== Summary ==================== Name: VMMaker.oscog-nice.1745 Author: nice Time: 28 March 2016, 1:25:06.191 am UUID: 6db43a18-29d3-4ec4-a5de-9ce41c448089 Ancestors: VMMaker.oscog-nice.1744 Fix generation of abs now that SQABS and SQLABS macros have been committed. Beware: sending abs to an unsigned int will re-interpret the int as signed and will generate C compiler warnings. This is currently required to let the cog/stack VM work. =============== Diff against VMMaker.oscog-nice.1744 =============== Item was added: + ----- Method: CCodeGenerator>>generateAbs:on:indent: (in category 'C translation') ----- + generateAbs: msgNode on: aStream indent: level + "Generate the C code for this message onto the given stream." + + | type strippedType absFun | + type := self typeFor: msgNode receiver in: currentMethod. + strippedType := (type beginsWith: 'unsigned ') + ifTrue: [type allButFirst: 'unsigned ' size] + ifFalse: [(type beginsWith: 'u') + ifTrue: [type allButFirst: 1] + ifFalse: [type]]. + absFun := (#('long long' '__int64' 'int64_t') anySatisfy: [:t| strippedType beginsWith: t]) ifTrue: [#llabs] + ifFalse: [(strippedType beginsWith: #sqInt) ifTrue: [#SQABS] + ifFalse: [(strippedType beginsWith: #sqLong) ifTrue: [#SQLABS] + ifFalse: [(#('float' 'double') anySatisfy: [:t| strippedType beginsWith: t]) ifTrue: [#fabs] + ifFalse: [#abs]]]]. + + aStream nextPutAll: absFun. + aStream nextPut: $(. + self emitCExpression: msgNode receiver on: aStream. + aStream nextPut: $).! Item was changed: ----- Method: CCodeGenerator>>initializeCTranslationDictionary (in category 'C translation support') ----- initializeCTranslationDictionary "Initialize the dictionary mapping message names to actions for C code generation." | pairs | translationDict := Dictionary new: 200. pairs := #( #& #generateAnd:on:indent: #| #generateOr:on:indent: + #abs #generateAbs:on:indent: #and: #generateSequentialAnd:on:indent: #or: #generateSequentialOr:on:indent: #not #generateNot:on:indent: #+ #generatePlus:on:indent: #- #generateMinus:on:indent: #negated #generateNegated:on:indent: #* #generateTimes:on:indent: #/ #generateDivide:on:indent: #// #generateDivide:on:indent: #\\ #generateModulo:on:indent: #<< #generateShiftLeft:on:indent: #>> #generateShiftRight:on:indent: #>>> #generateSignedShiftRight:on:indent: #min: #generateMin:on:indent: #max: #generateMax:on:indent: #between:and: #generateBetweenAnd:on:indent: #bitAnd: #generateBitAnd:on:indent: #bitOr: #generateBitOr:on:indent: #bitXor: #generateBitXor:on:indent: #bitShift: #generateBitShift:on:indent: #signedBitShift: #generateSignedBitShift:on:indent: #bitInvert32 #generateBitInvert:on:indent: #bitInvert64 #generateBitInvert:on:indent: #bitClear: #generateBitClear:on:indent: #truncateTo: #generateTruncateTo:on:indent: #rounded #generateRounded:on:indent: #< #generateLessThan:on:indent: #<= #generateLessThanOrEqual:on:indent: #= #generateEqual:on:indent: #> #generateGreaterThan:on:indent: #>= #generateGreaterThanOrEqual:on:indent: #~= #generateNotEqual:on:indent: #== #generateEqual:on:indent: #~~ #generateNotEqual:on:indent: #isNil #generateIsNil:on:indent: #notNil #generateNotNil:on:indent: #whileTrue: #generateWhileTrue:on:indent: #whileFalse: #generateWhileFalse:on:indent: #whileTrue #generateDoWhileTrue:on:indent: #whileFalse #generateDoWhileFalse:on:indent: #to:do: #generateToDo:on:indent: #to:by:do: #generateToByDo:on:indent: #repeat #generateRepeat:on:indent: #timesRepeat: #generateTimesRepeat:on:indent: #ifTrue: #generateIfTrue:on:indent: #ifFalse: #generateIfFalse:on:indent: #ifTrue:ifFalse: #generateIfTrueIfFalse:on:indent: #ifFalse:ifTrue: #generateIfFalseIfTrue:on:indent: #ifNotNil: #generateIfNotNil:on:indent: #ifNil: #generateIfNil:on:indent: #ifNotNil:ifNil: #generateIfNotNilIfNil:on:indent: #ifNil:ifNotNil: #generateIfNilIfNotNil:on:indent: #at: #generateAt:on:indent: #at:put: #generateAtPut:on:indent: #basicAt: #generateAt:on:indent: #basicAt:put: #generateAtPut:on:indent: #integerValueOf: #generateIntegerValueOf:on:indent: #integerObjectOf: #generateIntegerObjectOf:on:indent: #isIntegerObject: #generateIsIntegerObject:on:indent: #cCode: #generateInlineCCode:on:indent: #cCode:inSmalltalk: #generateInlineCCode:on:indent: #cPreprocessorDirective: #generateInlineCPreprocessorDirective:on:indent: #cppIf:ifTrue:ifFalse: #generateInlineCppIfElse:on:indent: #cppIf:ifTrue: #generateInlineCppIfElse:on:indent: #cCoerce:to: #generateCCoercion:on:indent: #cCoerceSimple:to: #generateCCoercion:on:indent: #addressOf: #generateAddressOf:on:indent: #addressOf:put: #generateAddressOf:on:indent: #asAddress:put: #generateAsAddress:on:indent: #signedIntFromLong64 #generateSignedIntFromLong64:on:indent: #signedIntFromLong #generateSignedIntFromLong:on:indent: #signedIntFromShort #generateSignedIntFromShort:on:indent: #signedIntToLong64 #generateSignedIntToLong64:on:indent: #signedIntToLong #generateSignedIntToLong:on:indent: #signedIntToShort #generateSignedIntToShort:on:indent: #preIncrement #generatePreIncrement:on:indent: #preDecrement #generatePreDecrement:on:indent: #inline: #generateInlineDirective:on:indent: #asFloat #generateAsFloat:on:indent: #asInteger #generateAsInteger:on:indent: #asUnsignedInteger #generateAsUnsignedInteger:on:indent: #asLong #generateAsLong:on:indent: #asUnsignedLong #generateAsUnsignedLong:on:indent: #asUnsignedLongLong #generateAsUnsignedLongLong:on:indent: #asVoidPointer #generateAsVoidPointer:on:indent: #asSymbol #generateAsSymbol:on:indent: #flag: #generateFlag:on:indent: #anyMask: #generateBitAnd:on:indent: #allMask: #generateAllMask:on:indent: #noMask: #generateNoMask:on:indent: #raisedTo: #generateRaisedTo:on:indent: #touch: #generateTouch:on:indent: #bytesPerOop #generateBytesPerOop:on:indent: #bytesPerWord #generateBytesPerWord:on:indent: #wordSize #generateBytesPerWord:on:indent: #baseHeaderSize #generateBaseHeaderSize:on:indent: #minSmallInteger #generateSmallIntegerConstant:on:indent: #maxSmallInteger #generateSmallIntegerConstant:on:indent: #sharedCodeNamed:inCase: #generateSharedCodeDirective:on:indent: #perform: #generatePerform:on:indent: #perform:with: #generatePerform:on:indent: #perform:with:with: #generatePerform:on:indent: #perform:with:with:with: #generatePerform:on:indent: #perform:with:with:with:with: #generatePerform:on:indent: #perform:with:with:with:with:with: #generatePerform:on:indent: #value #generateValue:on:indent: #value: #generateValue:on:indent: #value:value: #generateValue:on:indent: #value:value:value: #generateValue:on:indent: #value:value:value:value: #generateValue:on:indent: #deny: #generateDeny:on:indent: #shouldNotImplement #generateSmalltalkMetaError:on:indent: #shouldBeImplemented #generateSmalltalkMetaError:on:indent: #subclassResponsibility #generateSmalltalkMetaError:on:indent: ). 1 to: pairs size by: 2 do: [:i | translationDict at: (pairs at: i) put: (pairs at: i + 1)]. pairs := #( #ifTrue: #generateIfTrueAsArgument:on:indent: #ifFalse: #generateIfFalseAsArgument:on:indent: #ifTrue:ifFalse: #generateIfTrueIfFalseAsArgument:on:indent: #ifFalse:ifTrue: #generateIfFalseIfTrueAsArgument:on:indent: #ifNotNil: #generateIfNotNilAsArgument:on:indent: #ifNil: #generateIfNilAsArgument:on:indent: #ifNotNil:ifNil: #generateIfNotNilIfNilAsArgument:on:indent: #ifNil:ifNotNil: #generateIfNilIfNotNilAsArgument:on:indent: #cCode: #generateInlineCCodeAsArgument:on:indent: #cCode:inSmalltalk: #generateInlineCCodeAsArgument:on:indent: #cppIf:ifTrue:ifFalse: #generateInlineCppIfElseAsArgument:on:indent: #cppIf:ifTrue: #generateInlineCppIfElseAsArgument:on:indent: #value #generateValueAsArgument:on:indent: #value: #generateValueAsArgument:on:indent: #value:value: #generateValueAsArgument:on:indent: ). asArgumentTranslationDict := Dictionary new: 8. 1 to: pairs size by: 2 do: [:i | asArgumentTranslationDict at: (pairs at: i) put: (pairs at: i + 1)]. !

1 0

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

28 Mar '16

Nicolas Cellier uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-nice.1744.mcz ==================== Summary ==================== Name: VMMaker.oscog-nice.1744 Author: nice Time: 28 March 2016, 12:30:43.777 am UUID: f0299599-4f32-422e-b4de-edbd3f35c594 Ancestors: VMMaker.oscog-nice.1743 Correct the LargeInteger division bug I've just introduced by declaring some variable unsigned. Note: the easiest correction would be to restore the signed declaration of hi/lo. Indeed, signed variable are going to work because we don't fear that (unsigned char)*(unsigned char) would overflow MAX_INT (it uses at most 16 bits, and we have 31). I keep those variable unsigned though because it ain't gonna scale with 32 bit limbs... (unsigned int)*(unsigned int) might overflow (signed long long). =============== Diff against VMMaker.oscog-nice.1743 =============== 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 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 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 := pDiv at: dl - 1. dl = 1 ifTrue: [dnh := 0] ifFalse: [dnh := pDiv at: dl - 2]. 1 to: ql do: [:k | "maintain quo*arg+rem=self" "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." (pRem at: j - 1) = dh ifTrue: [q := 16rFF] ifFalse: ["Compute q = (r1,r2)//dh, t = (r1,r2)\\dh." "r2 := (rem digitAt: 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 >> 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 := 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] - lo < dnh - ifTrue: - [hi := hi - 1. - lo := lo + 16r100 - dnh] ifFalse: + [lo < dnh + ifTrue: + [hi := hi - 1. + lo := lo + 16r100 - dnh] + ifFalse: + [lo := lo - dnh]. + cond := hi >= dh]] - [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 := (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 >> 8) + (pRem at: l - 1) + (pDiv at: i - 1). pRem at: l - 1 put: (a bitAnd: 16rFF). l := l + 1]]. pQuo at: quoLen - k put: q]. ^0!

1 0

[commit][3653] add SQABS and SQLABS macros for taking absolute values of sqInt and sqLong
by commits＠squeakvm.org 26 Mar '16

26 Mar '16

Revision: 3653 Author: nice Date: 2016-03-26 15:24:44 -0700 (Sat, 26 Mar 2016) Log Message: ----------- add SQABS and SQLABS macros for taking absolute values of sqInt and sqLong Modified Paths: -------------- branches/Cog/platforms/Cross/vm/sqMemoryAccess.h Modified: branches/Cog/platforms/Cross/vm/sqMemoryAccess.h =================================================================== --- branches/Cog/platforms/Cross/vm/sqMemoryAccess.h 2016-03-26 02:06:14 UTC (rev 3652) +++ branches/Cog/platforms/Cross/vm/sqMemoryAccess.h 2016-03-26 22:24:44 UTC (rev 3653) @@ -41,26 +41,32 @@ #if defined(SQ_IMAGE32) typedef int sqInt; typedef unsigned int usqInt; +# define SQABS abs #elif defined(SQ_HOST64) typedef long sqInt; typedef unsigned long usqInt; +# define SQABS labs #elif (SIZEOF_LONG_LONG != 8) # error long long integers are not 64-bits wide? #else typedef long long sqInt; typedef unsigned long long usqInt; +# define SQABS llabs #endif #if !defined(sqLong) # if SIZEOF_VOID_P == 8 # define sqLong long # define usqLong unsigned long +# define SQLABS labs # elif _MSC_VER # define sqLong __int64 # define usqLong unsigned __int64 +# define SQLABS llabs # else # define sqLong long long # define usqLong unsigned long long +# define SQLABS llabs # endif #endif /* !defined(sqLong) */

1 0

32bits squeak.stack.spur failures
by Nicolas Cellier 26 Mar '16

26 Mar '16

Hi, this question is mainly for Eliot I guess... I have regular failures with a 32 bits squeak.stack.spur The VM crashes in garbage collect when running all tests. When i simulate, I've got an assert: failure in Spur32BitMMLESimulator>>is: oop onObjStack: objStack | index nextPage | self assert: (self numSlotsOfAny: objStack) = ObjStackPageSlots. 0 = 4092 fails... Does it mean the image got corrupted?

2 3

Re: [Pharo-dev] Proxy DNU vs CannotInterpret. (Ghost related)
by Eliot Miranda 26 Mar '16

26 Mar '16

Hi Stef, On Mon, Feb 15, 2016 at 8:18 AM, stepharo <stepharo(a)free.fr> wrote: > Hi eliot > > I think that the difference is really what guillermo explained. > With DNU you can only trapped methods that are not defined while if you > want to implement true proxy you do not want holes. > I think that also with DNU proxy there were some limits realyed to classe > but I do not remember. > As far as the VM goes, there is /one/ minor issue with special selector #== and #class (*). But the real issue is that ProtoObject implements far too much protocol. If one creates a class that inherits from nil all it needs to do is implement doersNotUnderstand: and it will catch every message (*). For this to work the debugger and basic inspectors must use the mirror primitives otherwise there will be infinite recursion of MNUs. Now the issue with special selector #== and #class is that these bytecodes are specified as no lookup. So if one uses bytecodes 182 (#==) or 199 (#class) these operate without sending messages and will compare the object or answer the object's class without sending #doesNotUnderstand:. In the VW VM I added a flag so one could turn this behaviour off, and that's certainly easy to do in our VM. Another approach is to have the bytecode compiler not send these. But given our VM it is certainly possible to use doesNotUnderstand: proxies, using a much slimmer class than ProtoObject. In fact a good project would be to try and shrink ProtoObject until it provides the minimum, which would be a #doesNotUnderstand: method that raises an error that reminds the programmer that they need to implement their own doesNotUnderstand: handler in subclasses of ProtoObject. > > Stef > > Le 15/2/16 16:06, Eliot Miranda a écrit : > > Hi Denis, > > On Feb 15, 2016, at 6:53 AM, Denis Kudriashov < <dionisiydk(a)gmail.com> > dionisiydk(a)gmail.com> wrote: > > > 2016-02-15 15:32 GMT+01:00 Mariano Martinez Peck < <marianopeck(a)gmail.com> > marianopeck(a)gmail.com>: > >> As far as I can remember (this was about 4 years ago) The use of >> #cannotInterpret: was the only way to be able to intercept everything >> without breaking the system. Subclassing from ProtoObject make your proxy >> to understand some messages. Subclassing from nil was technically possible, >> but I found out the system would simply crash as it didn't know at all how >> to handle other subclasses of nil. Even with the debugging support I added >> as you can read in the paper. Maybe things have changed. >> >> If subclassing from nil does not break the system and you can still >> inspect, debug proxies, then sure, you can give a try to Ghost using #dnu >> rather than #cannotInterpret:. In fact, I would like to have a dnu-based >> approeach that is as reliable as it was #cannotInterpret: in the sense of >> how much I can intercept. With #cannotInterpret I could trap EVERYTHING >> (everything but #==) and then decide what to do. Subclassing from nil would >> get you there too if you make it work. >> > > Actually I already implemented it many yeas ago for Mocketry. But > subclassing from nil works correctly only in VW. I got problems when > porting it to Squeak (at that time). > Now I want to give DNU another chance. It will simplify logic very much. > It will remove strange hierarchy of proxies which is needed for trick but > raises many questions. > > > There is no reason in principle why Squeak/Pharo should not be able to use > MNU proxies in the same way as VW. The key is to use the mirror > primitives in basic inspectors that are used to inspect the proxies and > in the debugger to simulate code. Without the mirror primitives many > sends to a proxy are likely to create an infinite recursion. As yet we > don't have a robust low space handler that catches infinite recursion so > debugging can be frustrating. But we can work on this. IMO the MNU > approach is to be preferred. > > > -- _,,,^..^,,,_ best, Eliot

6 9

[commit][3652] Fix signatures in the unix MIDI plugins.
by commits＠squeakvm.org 26 Mar '16

26 Mar '16

Revision: 3652 Author: eliot Date: 2016-03-25 19:06:14 -0700 (Fri, 25 Mar 2016) Log Message: ----------- Fix signatures in the unix MIDI plugins. Modified Paths: -------------- trunk/platforms/unix/plugins/MIDIPlugin/sqUnixMIDIALSA.inc trunk/platforms/unix/plugins/MIDIPlugin/sqUnixMIDINone.inc Modified: trunk/platforms/unix/plugins/MIDIPlugin/sqUnixMIDIALSA.inc =================================================================== --- trunk/platforms/unix/plugins/MIDIPlugin/sqUnixMIDIALSA.inc 2016-03-24 01:31:07 UTC (rev 3651) +++ trunk/platforms/unix/plugins/MIDIPlugin/sqUnixMIDIALSA.inc 2016-03-26 02:06:14 UTC (rev 3652) @@ -219,7 +219,7 @@ address. Copy at most length characters, and return the number of characters copied. Fail if there is no port of the given number. */ -int sqMIDIGetPortName(int portNum, int namePtr, int length) +int sqMIDIGetPortName(int portNum, char * namePtr, int length) { static char *userName[] = { "out", "in" }; @@ -404,7 +404,7 @@ than five bytes, since there must be enough room for the timestamp plus at least one data byte. */ -int sqMIDIPortReadInto(int portNum, int count, int bufferPtr) +int sqMIDIPortReadInto(int portNum, int count, char * bufferPtr) { debugf(("sqMIDIPortRead\n")); success(false); @@ -418,7 +418,7 @@ timestamped output queue, such as this one, always send the data immediately; see sqMIDIHasBuffer. */ -int sqMIDIPortWriteFromAt(int portNum, int count, int bufferPtr, int time) +int sqMIDIPortWriteFromAt(int portNum, int count, char * bufferPtr, int time) { if (portNum == 0) { Modified: trunk/platforms/unix/plugins/MIDIPlugin/sqUnixMIDINone.inc =================================================================== --- trunk/platforms/unix/plugins/MIDIPlugin/sqUnixMIDINone.inc 2016-03-24 01:31:07 UTC (rev 3651) +++ trunk/platforms/unix/plugins/MIDIPlugin/sqUnixMIDINone.inc 2016-03-26 02:06:14 UTC (rev 3652) @@ -81,7 +81,7 @@ /* Copy the name of the given MIDI port into the string at the given address. Copy at most length characters, and return the number of characters copied. Fail if there is no port of the given number.*/ -int sqMIDIGetPortName(int portNum, int namePtr, int length) +int sqMIDIGetPortName(int portNum, char * namePtr, int length) { success(false); return 0; @@ -125,7 +125,7 @@ available. Fail if the buffer is shorter than five bytes, since there must be enough room for the timestamp plus at least one data byte. */ -int sqMIDIPortReadInto(int portNum, int count, int bufferPtr) +int sqMIDIPortReadInto(int portNum, int count, char * bufferPtr) { success(false); return 0; @@ -137,7 +137,7 @@ zero, then send the data immediately. Implementations that do not support a timestamped output queue, such as this one, always send the data immediately; see sqMIDIHasBuffer. */ -int sqMIDIPortWriteFromAt(int portNum, int count, int bufferPtr, int time) +int sqMIDIPortWriteFromAt(int portNum, int count, char * bufferPtr, int time) { success(false); return 0;

1 0

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

26 Mar '16

Nicolas Cellier uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-nice.1743.mcz ==================== Summary ==================== Name: VMMaker.oscog-nice.1743 Author: nice Time: 26 March 2016, 1:38:58.425 am UUID: c4607394-3c0a-4984-87b6-06e1e25e744e Ancestors: VMMaker.oscog-nice.1742 Finish 1st round of LargeIntegers refactoring - simplify the left and right shift - use as much unsigned arithmetic as possible - homogenize type declaration within the plugin - remove unused digitOf:at: =============== Diff against VMMaker.oscog-nice.1742 =============== Item was changed: ----- Method: LargeIntegersPlugin>>cCopyIntVal:toBytes: (in category 'C core util') ----- cCopyIntVal: val toBytes: bytes | pByte | + <var: #pByte type: #'unsigned char *'> - <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: 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'> - <returnTypeC: 'unsigned char'> - <var: #pByteShort type: 'unsigned char * '> - <var: #pByteLong type: 'unsigned char * '> - <var: #pByteRes type: 'unsigned char * '> accum := 0. limit := shortLen - 1. 0 to: limit do: [:i | + accum := (accum >> 8) - accum := (accum bitShift: -8) + (pByteShort at: i) + (pByteLong at: i). pByteRes at: i put: (accum bitAnd: 255)]. limit := longLen - 1. shortLen to: limit do: [:i | + accum := (accum >> 8) - accum := (accum bitShift: -8) + (pByteLong at: i). pByteRes at: i put: (accum bitAnd: 255)]. + ^ accum >> 8! - ^ accum bitShift: -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 char *'> + <var: #pSecond type: #'unsigned char *'> + <var: #firstDigit type: #'unsigned int'> + <var: #secondDigit type: #'unsigned int'> - <var: #pFirst type: 'unsigned char * '> - <var: #pSecond type: 'unsigned char * '> ix := len - 1. [ix >= 0] whileTrue: [(secondDigit := pSecond at: ix) ~= (firstDigit := pFirst at: ix) 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 | limit | + <returnTypeC: #'int'> + <var: #pFrom type: #'unsigned char *'> + <var: #pTo type: #'unsigned char *'> - <returnTypeC: 'int'> - <var: #pFrom type: 'unsigned char * '> - <var: #pTo type: 'unsigned char * '> self cCode: '' inSmalltalk: [ (interpreterProxy isKindOf: InterpreterSimulator) ifTrue: [ "called from InterpreterSimulator" limit := len - 1. 0 to: limit do: [:i | interpreterProxy byteAt: pTo + i put: (interpreterProxy byteAt: pFrom + 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 cond q r1r2 mul b | - | dl ql dh dnh j t hi lo r3 l a cond q r1r2 mul | <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 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 := pDiv at: dl - 1. + dl = 1 + ifTrue: [dnh := 0] + ifFalse: [dnh := pDiv at: dl - 2]. - dnh := dl = 1 - ifTrue: [0] - ifFalse: [pDiv at: dl - 2]. 1 to: ql do: [:k | "maintain quo*arg+rem=self" + "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." - "Estimate rem/div by dividing the leading two bytes of rem by dh." - "The estimate is q = qhi*16+qlo, where qhi and qlo are nibbles." - "Nibbles are kicked off!! We use full 16 bits now, because we are in - the year 2000 ;-) [sr]" j := remLen + 1 - k. "r1 := rem digitAt: j." + (pRem at: j - 1) + = dh + ifTrue: [q := 16rFF] - (pRem at: j - 1) = dh - ifTrue: [q := 255] ifFalse: + ["Compute q = (r1,r2)//dh, t = (r1,r2)\\dh." - ["Compute q = (r1,r2)//dh, t = (r1,r2)\\dh. - Note that r1,r2 are bytes, not nibbles. - Be careful not to generate intermediate results exceeding 13 - bits." "r2 := (rem digitAt: j - 2)." + r1r2 := pRem at: j - 1. + r1r2 := (r1r2 << 8) + (pRem at: j - 2). - r1r2 := ((pRem at: j - 1) bitShift: 8) + (pRem at: j - 2). t := r1r2 \\ dh. q := r1r2 // dh. "Next compute (hi,lo) := q*dnh" mul := q * dnh. + hi := mul >> 8. + lo := mul bitAnd: 16rFF. - hi := mul bitShift: -8. - lo := mul bitAnd: 255. "Correct overestimate of q. Max of 2 iterations through loop -- see Knuth vol. 2" j < 3 ifTrue: [r3 := 0] ifFalse: [r3 := pRem at: j - 3]. [(t < hi or: [t = hi and: [r3 < lo]]) ifTrue: ["i.e. (t,r3) < (hi,lo)" q := q - 1. + lo < dnh - lo := lo - dnh. - lo < 0 ifTrue: [hi := hi - 1. + lo := lo + 16r100 - dnh] + ifFalse: + [lo := lo - dnh]. - lo := lo + 256]. 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 := (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. - hi := (pDiv at: i - 1) * (q bitShift: -8). - lo := a + (pRem at: l - 1) - ((pDiv at: i - 1) * (q bitAnd: 255)). - pRem at: l - 1 put: (self cCode: [lo] inSmalltalk: [lo bitAnd: 255]). - a := (lo signedBitShift: -8) - hi. 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 >> 8) + + (pRem at: l - 1) + (pDiv at: i - 1). + pRem at: l - 1 put: (a bitAnd: 16rFF). + l := l + 1]]. + pQuo at: quoLen - k put: q]. + ^0! - 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 bitShift: -8) + (pRem at: l - 1) + (pDiv at: i - 1). - pRem at: l - 1 put: (self cCode: [a] inSmalltalk: [a bitAnd: 255]). - l := l + 1]]. - pQuo at: quoLen - k put: q]! Item was changed: ----- Method: LargeIntegersPlugin>>cDigitHighBit:len: (in category 'C core util') ----- 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." | realLength lastDigit | + <var: #pByte type: #'unsigned char *'> + <var: #lastDigit type: #'unsigned int'> - <var: #pByte type: 'unsigned char * '> realLength := len. [(lastDigit := pByte at: realLength - 1) = 0] whileTrue: [(realLength := realLength - 1) = 0 ifTrue: [^ 0]]. ^ (self cHighBit: lastDigit) + (8 * (realLength - 1))! 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 char *'> + <var: #pFrom type: #'unsigned char *'> + <var: #carry type: #'unsigned int'> + <var: #digit type: #'unsigned int'> + digitShift := shiftCount // 8. - | byteShift bitShift carry limit digit lastIx | - <returnTypeC: 'int'> - <var: #pTo type: 'unsigned char * '> - <var: #pFrom type: 'unsigned char * '> - byteShift := shiftCount // 8. bitShift := shiftCount \\ 8. + + limit := digitShift - 1. + 0 to: limit do: [:i | pTo at: i put: 0]. + + bitShift = 0 ifTrue: ["Fast version for digit-aligned shifts" - bitShift = 0 ifTrue: ["Fast version for byte-aligned shifts" "C indexed!!" ^ self cDigitReplace: pTo + from: digitShift - from: byteShift to: lenTo - 1 with: pFrom startingAt: 0]. "This implementation use at most 15 bits of carry. + bitAnd: 16rFF is only for simulator, useless in C" + rshift := 8 - bitShift. - bitAnd: 255 is only for simulator, useless in C" carry := 0. + limit := lenFrom - 1. - limit := byteShift - 1. - 0 to: limit do: [:i | pTo at: i put: 0]. - limit := lenTo - byteShift - 2. - self sqAssert: limit < lenFrom. 0 to: limit do: [:i | digit := pFrom at: i. + pTo at: i + digitShift put: ((carry bitOr: digit << bitShift) bitAnd: 16rFF). + carry := digit >> rshift]. + carry = 0 ifFalse: [pTo at: lenTo - 1 put: carry]. + ^0 + ! - carry := (carry >> 8) bitOr: (digit << bitShift). - pTo at: i + byteShift put: (carry bitAnd: 255)]. - lastIx := limit + 1. - lastIx > (lenFrom - 1) - ifTrue: [digit := 0] - ifFalse: [digit := pFrom at: lastIx]. - carry := (carry >> 8) bitOr: (digit << bitShift). - pTo at: lastIx + byteShift put: (carry "bitAnd: 255"). - carry := carry >> 8. - self sqAssert: carry = 0! Item was changed: ----- Method: LargeIntegersPlugin>>cDigitMontgomery:len:times:len:modulo:len:mInvModB:into: (in category 'C core') ----- cDigitMontgomery: pBytesFirst len: firstLen times: pBytesSecond len: secondLen modulo: pBytesThird len: thirdLen mInvModB: mInv into: pBytesRes | 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: #accum type: #usqInt> <var: #u type: #'unsigned char'> <var: #lastByte type: #'unsigned char'> limit1 := firstLen - 1. limit2 := secondLen - 1. limit3 := thirdLen - 1. lastByte := 0. 0 to: limit1 do: [:i | 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 | 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 | 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 := (pBytesRes at: 0). u := accum * mInv bitAnd: 255. accum := accum + (u * (pBytesThird at: 0)). 1 to: limit3 do: [:k | 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 + (pBytesRes at: i) - (pBytesThird at: i). pBytesRes at: i put: (self cCode: [accum] inSmalltalk: [accum bitAnd: 255]). accum := accum signedBitShift: -8]].! Item was changed: ----- 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'> - <returnTypeC: 'unsigned char'> - <var: #pByteShort type: 'unsigned char * '> - <var: #pByteLong type: 'unsigned char * '> - <var: #pByteRes type: 'unsigned char * '> (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) (?)" - limitLong := longLen - 1. 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). - ab := (pByteLong at: j) - * digit + carry + (pByteRes at: k). - carry := ab bitShift: -8. - pByteRes at: k put: (ab bitAnd: 255). k := k + 1]. pByteRes at: k put: carry]]. ^ 0! Item was changed: ----- Method: LargeIntegersPlugin>>cDigitOp:short:len:long:len:into: (in category 'C core') ----- cDigitOp: opIndex short: pByteShort len: shortLen long: pByteLong len: longLen into: pByteRes "pByteRes len = longLen." | limit | + <var: #pByteShort type: #'unsigned char *'> + <var: #pByteLong type: #'unsigned char *'> + <var: #pByteRes type: #'unsigned char *'> - <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 | pByteRes at: i put: ((pByteShort at: i) bitAnd: (pByteLong at: i))]. limit := longLen - 1. shortLen to: limit do: [:i | pByteRes at: i put: 0]. ^ 0]. opIndex = orOpIndex ifTrue: [0 to: limit do: [:i | pByteRes at: i put: ((pByteShort at: i) bitOr: (pByteLong at: i))]. limit := longLen - 1. shortLen to: limit do: [:i | pByteRes at: i put: (pByteLong at: i)]. ^ 0]. opIndex = xorOpIndex ifTrue: [0 to: limit do: [:i | pByteRes at: i put: ((pByteShort at: i) bitXor: (pByteLong at: i))]. limit := longLen - 1. 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!!" + <returnTypeC: #'int'> + <var: #pTo type: #'unsigned char *'> + <var: #pFrom type: #'unsigned char *'> - <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: 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'> - <var: #pTo type: 'unsigned char * '> - <var: #pFrom type: 'unsigned char * '> - <var: #carry type: 'unsigned int '> - <var: #digit type: 'unsigned int '> digitShift := shiftCount // 8. bitShift := shiftCount \\ 8. bitShift = 0 ifTrue: ["Fast version for byte-aligned shifts" "C indexed!!" ^self cDigitReplace: pTo from: 0 to: toLen - 1 with: pFrom startingAt: digitShift]. "This implementation use at most 16 bits of x" leftShift := 8 - bitShift. carry := (pFrom at: digitShift) >> bitShift. start := digitShift + 1. limit := fromLen - 1. start to: limit do: [:j | digit := pFrom at: j. pTo at: j - start put: ((carry bitOr: digit << leftShift) bitAnd: 16rFF). carry := digit >> bitShift]. carry = 0 ifFalse: [pTo at: toLen - 1 put: carry]. ^0! Item was removed: - ----- Method: LargeIntegersPlugin>>cDigitRshiftCount:n:f:bytes:from:len:to:len: (in category 'C core') ----- - cDigitRshiftCount: count n: n f: f bytes: b from: pFrom len: fromLen to: pTo len: toLen - | x digit | - <var: #pTo type: 'unsigned char * '> - <var: #pFrom type: 'unsigned char * '> - self sqAssert: b < fromLen. - n = 0 ifTrue: ["Fast version for byte-aligned shifts" - "C indexed!!" - ^self - cDigitReplace: pTo - from: 0 - to: toLen - 1 - with: pFrom - startingAt: b]. - - "This implementation use at most 16 bits of x" - x := (pFrom at: b) << f. - self sqAssert: count - 1 < fromLen. - b + 1 to: count - 1 do: - [:j | - digit := pFrom at: j. - x := (x >> 8) bitOr: (digit << f). - pTo at: j - b - 1 put: (x bitAnd: 255)]. - count = fromLen - ifTrue: [digit := 0] - ifFalse: [digit := pFrom at: count]. - x := (x >> 8) bitOr: (digit << f). - pTo at: count - b - 1 put: (x "bitAnd: 255")! Item was changed: ----- 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'> - - <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 class size res pByte byte | + <var: #pByte type: #'unsigned char *'> - <var: #pByte type: 'unsigned char * '> val := interpreterProxy integerValueOf: anOop. 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 removed: - ----- Method: LargeIntegersPlugin>>digit:Rshift:bytes:lookfirst: (in category 'oop functions') ----- - digit: aBytesOop Rshift: anInteger bytes: b lookfirst: a - "Attention: this method invalidates all oop's!! Only newBytes is valid at return." - "Shift right 8*b+anInteger bits, 0<=n<8. - Discard all digits beyond a, and all zeroes at or below a." - "Does not normalize." - | x f digit i oldLen newLen newBytes | - x := 0. - f := 8 - anInteger. - i := a. - digit := self digitOfLargeInt: aBytesOop at: i. - [((digit >> anInteger) - bitOr: x) - = 0 and: [i ~= 1]] - whileTrue: - [x := digit << f. - "Can't exceed 8 bits" - i := i - 1. - digit := self digitOfLargeInt: aBytesOop at: i]. - i <= b ifTrue: [^ interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesOop) - indexableSize: 0"Integer new: 0 neg: self negative"]. - "All bits lost" - oldLen := self digitSizeOfLargeInt: aBytesOop. - newLen := i - b. - self remapOop: aBytesOop in: [newBytes := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesOop) - indexableSize: newLen]. - "r := Integer new: i - b neg: self negative." - " count := i. - " - self - cDigitRshiftCount: i - n: anInteger - f: f - bytes: b - from: (interpreterProxy firstIndexableField: aBytesOop) - len: oldLen - to: (interpreterProxy firstIndexableField: newBytes) - len: newLen. - ^ newBytes! Item was added: + ----- Method: LargeIntegersPlugin>>digit:Rshift:lookfirst: (in category 'oop functions') ----- + digit: aBytesOop Rshift: shiftCount lookfirst: a + "Attention: this method invalidates all oop's!! Only newBytes is valid at return." + "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 | + 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: aBytesOop) + indexableSize: 0]. + newByteLen := newBitLen + 7 // 8. + self remapOop: aBytesOop in: [newOop := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesOop) + indexableSize: newByteLen]. + self + cDigitRshift: shiftCount + from: (interpreterProxy firstIndexableField: aBytesOop) + len: oldDigitLen + to: (interpreterProxy firstIndexableField: newOop) + len: newByteLen. + ^ newOop! Item was changed: ----- Method: LargeIntegersPlugin>>digitAddLarge:with: (in category 'oop functions') ----- digitAddLarge: firstInteger with: secondInteger "Does not need to normalize!!" | over firstLen secondLen shortInt shortLen longInt longLen sum newSum resClass | + <var: #over type: #'unsigned char'> - <var: #over type: 'unsigned char '> firstLen := self digitSizeOfLargeInt: firstInteger. secondLen := self digitSizeOfLargeInt: secondInteger. resClass := interpreterProxy fetchClassOf: firstInteger. firstLen <= secondLen ifTrue: [shortInt := firstInteger. shortLen := firstLen. longInt := secondInteger. longLen := secondLen] ifFalse: [shortInt := secondInteger. shortLen := secondLen. longInt := firstInteger. longLen := firstLen]. " sum := Integer new: len neg: firstInteger negative." self remapOop: #(shortInt longInt ) in: [sum := interpreterProxy instantiateClass: resClass indexableSize: longLen]. over := self cDigitAdd: (interpreterProxy firstIndexableField: shortInt) len: shortLen with: (interpreterProxy firstIndexableField: longInt) len: longLen into: (interpreterProxy firstIndexableField: sum). over > 0 ifTrue: ["sum := sum growby: 1." self remapOop: sum in: [newSum := interpreterProxy instantiateClass: resClass indexableSize: longLen + 1]. self cDigitCopyFrom: (interpreterProxy firstIndexableField: sum) to: (interpreterProxy firstIndexableField: newSum) len: longLen. sum := newSum. "C index!!" (self cCoerce: (interpreterProxy firstIndexableField: sum) to: 'unsigned char *') at: longLen put: over]. ^ sum! 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." | 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 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 largeIntOrInt: div growTo: (self digitLength: div) + 1]. self remapOop: div in: [rem := self digit: firstInteger Lshift: d. (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 digitLength: div) rem: (interpreterProxy firstIndexableField: rem) len: (self digitLength: rem) quo: (interpreterProxy firstIndexableField: quo) len: (self digitLength: quo). self remapOop: #(quo ) in: [rem := self digit: rem Rshift: d - bytes: 0 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>>digitOf:at: (in category 'util') ----- - digitOf: oop at: ix - (interpreterProxy isIntegerObject: oop) ifTrue: - [ix < 1 ifTrue: [interpreterProxy primitiveFail. ^0]. - ix > interpreterProxy bytesPerOop ifTrue: [^0]. - ^self cDigitOfCSI: (interpreterProxy integerValueOf: oop) at: ix]. - ^self digitOfLargeInt: oop at: ix! Item was changed: ----- Method: LargeIntegersPlugin>>primDigit:bitShift: (in category 'development primitives') ----- primDigit: anInteger bitShift: shiftCount | rShift aLarge | self debugCode: [self msg: 'primDigit: anInteger bitShift: shiftCount']. self primitive: '_primDigitBitShift' parameters: #(Integer SmallInteger ) receiver: #Oop. (interpreterProxy isIntegerObject: anInteger) ifTrue: ["convert it to a not normalized LargeInteger" aLarge := self createLargeFromSmallInteger: anInteger] ifFalse: [aLarge := anInteger]. shiftCount >= 0 ifTrue: [^ self digit: aLarge Lshift: shiftCount] ifFalse: [rShift := 0 - shiftCount. ^ self normalize: (self digit: aLarge + Rshift: rShift - Rshift: (rShift bitAnd: 7) - bytes: (rShift bitShift: -3) lookfirst: (self digitSizeOfLargeInt: aLarge))]! Item was changed: ----- Method: LargeIntegersPlugin>>primDigitBitShift: (in category 'obsolete') ----- primDigitBitShift: shiftCount | rShift aLarge anInteger | self debugCode: [self msg: 'primDigitBitShift: shiftCount']. anInteger := self primitive: 'primDigitBitShift' parameters: #(SmallInteger ) receiver: #Integer. (interpreterProxy isIntegerObject: anInteger) ifTrue: ["convert it to a not normalized LargeInteger" aLarge := self createLargeFromSmallInteger: anInteger] ifFalse: [aLarge := anInteger]. shiftCount >= 0 ifTrue: [^ self digit: aLarge Lshift: shiftCount] ifFalse: [rShift := 0 - shiftCount. ^ self normalize: (self digit: aLarge + Rshift: rShift - Rshift: (rShift bitAnd: 7) - bytes: (rShift bitShift: -3) lookfirst: (self digitSizeOfLargeInt: aLarge))]! Item was changed: ----- Method: LargeIntegersPlugin>>primDigitBitShiftMagnitude: (in category 'Integer primitives') ----- primDigitBitShiftMagnitude: shiftCount | rShift aLarge anInteger | self debugCode: [self msg: 'primDigitBitShiftMagnitude: shiftCount']. anInteger := self primitive: 'primDigitBitShiftMagnitude' parameters: #(#SmallInteger ) receiver: #Integer. (interpreterProxy isIntegerObject: anInteger) ifTrue: ["convert it to a not normalized LargeInteger" aLarge := self createLargeFromSmallInteger: anInteger] ifFalse: [aLarge := anInteger]. shiftCount >= 0 ifTrue: [^ self digit: aLarge Lshift: shiftCount] ifFalse: [rShift := 0 - shiftCount. ^ self normalize: (self digit: aLarge + Rshift: rShift - Rshift: (rShift bitAnd: 7) - bytes: (rShift bitShift: -3) lookfirst: (self digitSizeOfLargeInt: aLarge))]!

1 0

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

26 Mar '16

Nicolas Cellier uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-nice.1742.mcz ==================== Summary ==================== Name: VMMaker.oscog-nice.1742 Author: nice Time: 26 March 2016, 12:08:11.776 am UUID: 12c26a42-336a-4a56-a44f-a9a97fc3d43e Ancestors: VMMaker.oscog-cb.1741 Refactor LargeIntegers in order to prepare the avent of digits larger than 8 bits. Most of these refactorings are already applied in classic interpreter VMMaker branch. Half message were named #bytesOp, the other #digitOp... Homogenize all message names as #digitOp. Also homogenize C core message names #cCoreBytes #cCoreDigit #cBytes -> #cDigit... Rename the rest of #bytes message (whose purpose is to operate on bytesObjects) -> #largeInt (whose effective use is to operate on largeIntegerObjects). This makes the intention a bit clearer. Remove unused #negative: Remove debugging stub #think =============== Diff against VMMaker.oscog-cb.1741 =============== Item was removed: - ----- Method: LargeIntegersPlugin>>anyBitOfBytes:from:to: (in category 'util') ----- - anyBitOfBytes: aBytesOop from: start to: stopArg - "Argument has to be aBytesOop!!" - "Tests for any magnitude bits in the interval from start to stopArg." - | magnitude rightShift leftShift stop firstByteIx lastByteIx | - self - debugCode: [self msg: 'anyBitOfBytes: aBytesOop from: start to: stopArg']. - start < 1 | (stopArg < 1) - ifTrue: [^ interpreterProxy primitiveFail]. - magnitude := aBytesOop. - stop := stopArg - min: (self highBitOfBytes: magnitude). - start > stop - ifTrue: [^ false]. - 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 digitOfBytes: magnitude at: firstByteIx. - ^ (digit bitAnd: mask) - ~= 0]. - ((self digitOfBytes: magnitude at: firstByteIx) - >> rightShift) - ~= 0 - ifTrue: [^ true]. - firstByteIx + 1 - to: lastByteIx - 1 - do: [:ix | (self digitOfBytes: magnitude at: ix) - ~= 0 - ifTrue: [^ true]]. - (((self digitOfBytes: magnitude at: lastByteIx) - << leftShift) - bitAnd: 255) - ~= 0 - ifTrue: [^ true]. - ^ false! Item was added: + ----- Method: LargeIntegersPlugin>>anyBitOfLargeInt:from:to: (in category 'util') ----- + anyBitOfLargeInt: aBytesOop from: start to: stopArg + "Argument has to be aBytesOop!!" + "Tests for any magnitude bits in the interval from start to stopArg." + | magnitude rightShift leftShift stop firstByteIx lastByteIx | + self + debugCode: [self msg: 'anyBitOfLargeInt: aBytesOop from: start to: stopArg']. + start < 1 | (stopArg < 1) + ifTrue: [^ interpreterProxy primitiveFail]. + magnitude := aBytesOop. + stop := stopArg + min: (self highBitOfLargeInt: magnitude). + start > stop + ifTrue: [^ false]. + 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 digitOfLargeInt: magnitude at: firstByteIx) + >> rightShift) + ~= 0 + ifTrue: [^ true]. + firstByteIx + 1 + to: lastByteIx - 1 + do: [:ix | (self digitOfLargeInt: magnitude at: ix) + ~= 0 + ifTrue: [^ true]]. + (((self digitOfLargeInt: magnitude at: lastByteIx) + << leftShift) + bitAnd: 255) + ~= 0 + ifTrue: [^ true]. + ^ false! Item was removed: - ----- Method: LargeIntegersPlugin>>byteSizeOfBytes: (in category 'util') ----- - byteSizeOfBytes: bytesOop - "Precondition: bytesOop is not anInteger and a bytes object." - "Function #byteSizeOf: is used by the interpreter, be careful with name - clashes..." - ^ interpreterProxy slotSizeOf: bytesOop! Item was removed: - ----- Method: LargeIntegersPlugin>>bytes:Lshift: (in category 'oop functions') ----- - bytes: aBytesOop Lshift: shiftCount - "Attention: this method invalidates all oop's!! Only newBytes is valid at return." - "Does not normalize." - | newBytes highBit newLen oldLen | - oldLen := self byteSizeOfBytes: aBytesOop. - (highBit := self cBytesHighBit: (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 - cBytesLshift: shiftCount - from: (interpreterProxy firstIndexableField: aBytesOop) - len: oldLen - to: (interpreterProxy firstIndexableField: newBytes) - len: newLen. - ^ newBytes! Item was removed: - ----- Method: LargeIntegersPlugin>>bytes:Rshift:bytes:lookfirst: (in category 'oop functions') ----- - bytes: aBytesOop Rshift: anInteger bytes: b lookfirst: a - "Attention: this method invalidates all oop's!! Only newBytes is valid at return." - "Shift right 8*b+anInteger bits, 0<=n<8. - Discard all digits beyond a, and all zeroes at or below a." - "Does not normalize." - | x f digit i oldLen newLen newBytes | - x := 0. - f := 8 - anInteger. - i := a. - digit := self digitOfBytes: aBytesOop at: i. - [((digit >> anInteger) - bitOr: x) - = 0 and: [i ~= 1]] - whileTrue: - [x := digit << f. - "Can't exceed 8 bits" - i := i - 1. - digit := self digitOfBytes: aBytesOop at: i]. - i <= b ifTrue: [^ interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesOop) - indexableSize: 0"Integer new: 0 neg: self negative"]. - "All bits lost" - oldLen := self byteSizeOfBytes: aBytesOop. - newLen := i - b. - self remapOop: aBytesOop in: [newBytes := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesOop) - indexableSize: newLen]. - "r := Integer new: i - b neg: self negative." - " count := i. - " - self - cCoreBytesRshiftCount: i - n: anInteger - f: f - bytes: b - from: (interpreterProxy firstIndexableField: aBytesOop) - len: oldLen - to: (interpreterProxy firstIndexableField: newBytes) - len: newLen. - ^ newBytes! Item was removed: - ----- Method: LargeIntegersPlugin>>bytes:growTo: (in category 'oop util') ----- - bytes: aBytesObject growTo: newLen - "Attention: this method invalidates all oop's!! Only newBytes is valid at return." - "Does not normalize." - | newBytes oldLen copyLen | - self remapOop: aBytesObject in: [newBytes := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesObject) - indexableSize: newLen]. - oldLen := self byteSizeOfBytes: aBytesObject. - oldLen < newLen - ifTrue: [copyLen := oldLen] - ifFalse: [copyLen := newLen]. - self - cBytesCopyFrom: (interpreterProxy firstIndexableField: aBytesObject) - to: (interpreterProxy firstIndexableField: newBytes) - len: copyLen. - ^ newBytes! Item was removed: - ----- Method: LargeIntegersPlugin>>bytesOrInt:growTo: (in category 'oop util') ----- - bytesOrInt: 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 bytes: oop growTo: len]. - ^ newBytes! Item was removed: - ----- Method: LargeIntegersPlugin>>cByteOp:short:len:long:len:into: (in category 'C core') ----- - cByteOp: opIndex short: pByteShort len: shortLen long: pByteLong len: longLen into: pByteRes - "pByteRes len = longLen." - | limit | - <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 | pByteRes at: i put: ((pByteShort at: i) - bitAnd: (pByteLong at: i))]. - limit := longLen - 1. - shortLen to: limit do: [:i | pByteRes at: i put: 0]. - ^ 0]. - opIndex = orOpIndex - ifTrue: - [0 to: limit do: [:i | pByteRes at: i put: ((pByteShort at: i) - bitOr: (pByteLong at: i))]. - limit := longLen - 1. - shortLen to: limit do: [:i | pByteRes at: i put: (pByteLong at: i)]. - ^ 0]. - opIndex = xorOpIndex - ifTrue: - [0 to: limit do: [:i | pByteRes at: i put: ((pByteShort at: i) - bitXor: (pByteLong at: i))]. - limit := longLen - 1. - shortLen to: limit do: [:i | pByteRes at: i put: (pByteLong at: i)]. - ^ 0]. - ^ interpreterProxy primitiveFail! Item was removed: - ----- Method: LargeIntegersPlugin>>cBytesCopyFrom:to:len: (in category 'C core util') ----- - cBytesCopyFrom: pFrom to: pTo len: len - | limit | - <returnTypeC: 'int'> - <var: #pFrom type: 'unsigned char * '> - <var: #pTo type: 'unsigned char * '> - - self cCode: '' inSmalltalk: [ - (interpreterProxy isKindOf: InterpreterSimulator) ifTrue: [ - "called from InterpreterSimulator" - limit := len - 1. - 0 to: limit do: [:i | - interpreterProxy byteAt: pTo + i - put: (interpreterProxy byteAt: pFrom + i) - ]. - ^ 0 - ]. - ]. - limit := len - 1. - 0 to: limit do: [:i | pTo at: i put: (pFrom at: i)]. - ^ 0! Item was removed: - ----- Method: LargeIntegersPlugin>>cBytesHighBit:len: (in category 'C core util') ----- - cBytesHighBit: 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." - | realLength lastDigit | - <var: #pByte type: 'unsigned char * '> - realLength := len. - [(lastDigit := pByte at: realLength - 1) = 0] - whileTrue: [(realLength := realLength - 1) = 0 ifTrue: [^ 0]]. - ^ (self cHighBit: lastDigit) + (8 * (realLength - 1))! Item was removed: - ----- Method: LargeIntegersPlugin>>cBytesLshift:from:len:to:len: (in category 'C core') ----- - cBytesLshift: shiftCount from: pFrom len: lenFrom to: pTo len: lenTo - "C indexed!!" - | byteShift bitShift carry limit digit lastIx | - <returnTypeC: 'int'> - <var: #pTo type: 'unsigned char * '> - <var: #pFrom type: 'unsigned char * '> - byteShift := shiftCount // 8. - bitShift := shiftCount \\ 8. - bitShift = 0 ifTrue: ["Fast version for byte-aligned shifts" - "C indexed!!" - ^ self - cBytesReplace: pTo - from: byteShift - to: lenTo - 1 - with: pFrom - startingAt: 0]. - - "This implementation use at most 15 bits of carry. - bitAnd: 255 is only for simulator, useless in C" - carry := 0. - limit := byteShift - 1. - 0 to: limit do: [:i | pTo at: i put: 0]. - limit := lenTo - byteShift - 2. - self sqAssert: limit < lenFrom. - 0 to: limit do: - [:i | - digit := pFrom at: i. - carry := (carry >> 8) bitOr: (digit << bitShift). - pTo at: i + byteShift put: (carry bitAnd: 255)]. - lastIx := limit + 1. - lastIx > (lenFrom - 1) - ifTrue: [digit := 0] - ifFalse: [digit := pFrom at: lastIx]. - carry := (carry >> 8) bitOr: (digit << bitShift). - pTo at: lastIx + byteShift put: (carry "bitAnd: 255"). - carry := carry >> 8. - self sqAssert: carry = 0! Item was removed: - ----- Method: LargeIntegersPlugin>>cBytesReplace:from:to:with:startingAt: (in category 'C core util') ----- - cBytesReplace: pTo from: start to: stop with: pFrom startingAt: repStart - "C indexed!!" - <returnTypeC: 'int'> - <var: #pTo type: 'unsigned char * '> - <var: #pFrom type: 'unsigned char * '> - ^ self - cBytesCopyFrom: pFrom + repStart - to: pTo + start - len: stop - start + 1! Item was removed: - ----- Method: LargeIntegersPlugin>>cCoreBytesRshiftCount:n:f:bytes:from:len:to:len: (in category 'C core') ----- - cCoreBytesRshiftCount: count n: n f: f bytes: b from: pFrom len: fromLen to: pTo len: toLen - | x digit | - <var: #pTo type: 'unsigned char * '> - <var: #pFrom type: 'unsigned char * '> - self sqAssert: b < fromLen. - n = 0 ifTrue: ["Fast version for byte-aligned shifts" - "C indexed!!" - ^self - cBytesReplace: pTo - from: 0 - to: toLen - 1 - with: pFrom - startingAt: b]. - - "This implementation use at most 16 bits of x" - x := (pFrom at: b) << f. - self sqAssert: count - 1 < fromLen. - b + 1 to: count - 1 do: - [:j | - digit := pFrom at: j. - x := (x >> 8) bitOr: (digit << f). - pTo at: j - b - 1 put: (x bitAnd: 255)]. - count = fromLen - ifTrue: [digit := 0] - ifFalse: [digit := pFrom at: count]. - x := (x >> 8) bitOr: (digit << f). - pTo at: count - b - 1 put: (x "bitAnd: 255")! Item was removed: - ----- Method: LargeIntegersPlugin>>cCoreDigitDivDiv:len:rem:len:quo:len: (in category 'C core') ----- - cCoreDigitDivDiv: pDiv len: divLen rem: pRem len: remLen quo: pQuo len: quoLen - | dl ql dh dnh j t hi lo r3 l a cond q r1r2 mul | - <var: #pDiv type: #'unsigned char *'> - <var: #pRem type: #'unsigned char *'> - <var: #pQuo type: #'unsigned char *'> - dl := divLen - 1. - "Last actual byte of data (ST ix)" - ql := quoLen. - dh := pDiv at: dl - 1. - dnh := dl = 1 - ifTrue: [0] - ifFalse: [pDiv at: dl - 2]. - 1 to: ql do: - [:k | - "maintain quo*arg+rem=self" - "Estimate rem/div by dividing the leading two bytes of rem by dh." - "The estimate is q = qhi*16+qlo, where qhi and qlo are nibbles." - "Nibbles are kicked off!! We use full 16 bits now, because we are in - the year 2000 ;-) [sr]" - j := remLen + 1 - k. - "r1 := rem digitAt: j." - (pRem at: j - 1) = dh - ifTrue: [q := 255] - ifFalse: - ["Compute q = (r1,r2)//dh, t = (r1,r2)\\dh. - Note that r1,r2 are bytes, not nibbles. - Be careful not to generate intermediate results exceeding 13 - bits." - "r2 := (rem digitAt: j - 2)." - r1r2 := ((pRem at: j - 1) bitShift: 8) + (pRem at: j - 2). - t := r1r2 \\ dh. - q := r1r2 // dh. - "Next compute (hi,lo) := q*dnh" - mul := q * dnh. - hi := mul bitShift: -8. - lo := mul bitAnd: 255. - "Correct overestimate of q. - Max of 2 iterations through loop -- see Knuth vol. 2" - j < 3 - ifTrue: [r3 := 0] - ifFalse: [r3 := pRem at: j - 3]. - - [(t < hi - or: [t = hi and: [r3 < lo]]) - ifTrue: - ["i.e. (t,r3) < (hi,lo)" - q := q - 1. - lo := lo - dnh. - lo < 0 - ifTrue: - [hi := hi - 1. - lo := lo + 256]. - 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 := (pDiv at: i - 1) * (q bitShift: -8). - lo := a + (pRem at: l - 1) - ((pDiv at: i - 1) * (q bitAnd: 255)). - pRem at: l - 1 put: (self cCode: [lo] inSmalltalk: [lo bitAnd: 255]). - a := (lo signedBitShift: -8) - hi. - 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 bitShift: -8) + (pRem at: l - 1) + (pDiv at: i - 1). - pRem at: l - 1 put: (self cCode: [a] inSmalltalk: [a bitAnd: 255]). - l := l + 1]]. - pQuo at: quoLen - k put: q]! Item was added: + ----- Method: LargeIntegersPlugin>>cDigitCopyFrom:to:len: (in category 'C core util') ----- + cDigitCopyFrom: pFrom to: pTo len: len + | limit | + <returnTypeC: 'int'> + <var: #pFrom type: 'unsigned char * '> + <var: #pTo type: 'unsigned char * '> + + self cCode: '' inSmalltalk: [ + (interpreterProxy isKindOf: InterpreterSimulator) ifTrue: [ + "called from InterpreterSimulator" + limit := len - 1. + 0 to: limit do: [:i | + interpreterProxy byteAt: pTo + i + put: (interpreterProxy byteAt: pFrom + i) + ]. + ^ 0 + ]. + ]. + limit := len - 1. + 0 to: limit do: [:i | pTo at: i put: (pFrom at: i)]. + ^ 0 + ! Item was added: + ----- 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 cond q r1r2 mul | + <var: #pDiv type: #'unsigned char *'> + <var: #pRem type: #'unsigned char *'> + <var: #pQuo type: #'unsigned char *'> + dl := divLen - 1. + "Last actual byte of data (ST ix)" + ql := quoLen. + dh := pDiv at: dl - 1. + dnh := dl = 1 + ifTrue: [0] + ifFalse: [pDiv at: dl - 2]. + 1 to: ql do: + [:k | + "maintain quo*arg+rem=self" + "Estimate rem/div by dividing the leading two bytes of rem by dh." + "The estimate is q = qhi*16+qlo, where qhi and qlo are nibbles." + "Nibbles are kicked off!! We use full 16 bits now, because we are in + the year 2000 ;-) [sr]" + j := remLen + 1 - k. + "r1 := rem digitAt: j." + (pRem at: j - 1) = dh + ifTrue: [q := 255] + ifFalse: + ["Compute q = (r1,r2)//dh, t = (r1,r2)\\dh. + Note that r1,r2 are bytes, not nibbles. + Be careful not to generate intermediate results exceeding 13 + bits." + "r2 := (rem digitAt: j - 2)." + r1r2 := ((pRem at: j - 1) bitShift: 8) + (pRem at: j - 2). + t := r1r2 \\ dh. + q := r1r2 // dh. + "Next compute (hi,lo) := q*dnh" + mul := q * dnh. + hi := mul bitShift: -8. + lo := mul bitAnd: 255. + "Correct overestimate of q. + Max of 2 iterations through loop -- see Knuth vol. 2" + j < 3 + ifTrue: [r3 := 0] + ifFalse: [r3 := pRem at: j - 3]. + + [(t < hi + or: [t = hi and: [r3 < lo]]) + ifTrue: + ["i.e. (t,r3) < (hi,lo)" + q := q - 1. + lo := lo - dnh. + lo < 0 + ifTrue: + [hi := hi - 1. + lo := lo + 256]. + 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 := (pDiv at: i - 1) * (q bitShift: -8). + lo := a + (pRem at: l - 1) - ((pDiv at: i - 1) * (q bitAnd: 255)). + pRem at: l - 1 put: (self cCode: [lo] inSmalltalk: [lo bitAnd: 255]). + a := (lo signedBitShift: -8) - hi. + 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 bitShift: -8) + (pRem at: l - 1) + (pDiv at: i - 1). + pRem at: l - 1 put: (self cCode: [a] inSmalltalk: [a bitAnd: 255]). + l := l + 1]]. + pQuo at: quoLen - k put: q]! Item was added: + ----- Method: LargeIntegersPlugin>>cDigitHighBit:len: (in category 'C core util') ----- + 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." + | realLength lastDigit | + <var: #pByte type: 'unsigned char * '> + realLength := len. + [(lastDigit := pByte at: realLength - 1) = 0] + whileTrue: [(realLength := realLength - 1) = 0 ifTrue: [^ 0]]. + ^ (self cHighBit: lastDigit) + (8 * (realLength - 1))! Item was added: + ----- Method: LargeIntegersPlugin>>cDigitLshift:from:len:to:len: (in category 'C core') ----- + cDigitLshift: shiftCount from: pFrom len: lenFrom to: pTo len: lenTo + "C indexed!!" + | byteShift bitShift carry limit digit lastIx | + <returnTypeC: 'int'> + <var: #pTo type: 'unsigned char * '> + <var: #pFrom type: 'unsigned char * '> + byteShift := shiftCount // 8. + bitShift := shiftCount \\ 8. + bitShift = 0 ifTrue: ["Fast version for byte-aligned shifts" + "C indexed!!" + ^ self + cDigitReplace: pTo + from: byteShift + to: lenTo - 1 + with: pFrom + startingAt: 0]. + + "This implementation use at most 15 bits of carry. + bitAnd: 255 is only for simulator, useless in C" + carry := 0. + limit := byteShift - 1. + 0 to: limit do: [:i | pTo at: i put: 0]. + limit := lenTo - byteShift - 2. + self sqAssert: limit < lenFrom. + 0 to: limit do: + [:i | + digit := pFrom at: i. + carry := (carry >> 8) bitOr: (digit << bitShift). + pTo at: i + byteShift put: (carry bitAnd: 255)]. + lastIx := limit + 1. + lastIx > (lenFrom - 1) + ifTrue: [digit := 0] + ifFalse: [digit := pFrom at: lastIx]. + carry := (carry >> 8) bitOr: (digit << bitShift). + pTo at: lastIx + byteShift put: (carry "bitAnd: 255"). + carry := carry >> 8. + self sqAssert: carry = 0! Item was added: + ----- Method: LargeIntegersPlugin>>cDigitMontgomery:len:times:len:modulo:len:mInvModB:into: (in category 'C core') ----- + cDigitMontgomery: pBytesFirst + len: firstLen + times: pBytesSecond + len: secondLen + modulo: pBytesThird + len: thirdLen + mInvModB: mInv + into: pBytesRes + + | 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: #usqInt> + <var: #u type: #'unsigned char'> + <var: #lastByte type: #'unsigned char'> + limit1 := firstLen - 1. + limit2 := secondLen - 1. + limit3 := thirdLen - 1. + lastByte := 0. + 0 to: limit1 do: + [:i | + 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 | + 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 | + 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 := (pBytesRes at: 0). + u := accum * mInv bitAnd: 255. + accum := accum + (u * (pBytesThird at: 0)). + 1 to: limit3 do: [:k | + 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 + (pBytesRes at: i) - (pBytesThird at: i). + pBytesRes at: i put: (self cCode: [accum] inSmalltalk: [accum bitAnd: 255]). + accum := accum signedBitShift: -8]].! Item was added: + ----- Method: LargeIntegersPlugin>>cDigitOp:short:len:long:len:into: (in category 'C core') ----- + cDigitOp: opIndex short: pByteShort len: shortLen long: pByteLong len: longLen into: pByteRes + "pByteRes len = longLen." + | limit | + <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 | pByteRes at: i put: ((pByteShort at: i) + bitAnd: (pByteLong at: i))]. + limit := longLen - 1. + shortLen to: limit do: [:i | pByteRes at: i put: 0]. + ^ 0]. + opIndex = orOpIndex + ifTrue: + [0 to: limit do: [:i | pByteRes at: i put: ((pByteShort at: i) + bitOr: (pByteLong at: i))]. + limit := longLen - 1. + shortLen to: limit do: [:i | pByteRes at: i put: (pByteLong at: i)]. + ^ 0]. + opIndex = xorOpIndex + ifTrue: + [0 to: limit do: [:i | pByteRes at: i put: ((pByteShort at: i) + bitXor: (pByteLong at: i))]. + limit := longLen - 1. + shortLen to: limit do: [:i | pByteRes at: i put: (pByteLong at: i)]. + ^ 0]. + ^ interpreterProxy primitiveFail! Item was added: + ----- Method: LargeIntegersPlugin>>cDigitReplace:from:to:with:startingAt: (in category 'C core util') ----- + cDigitReplace: pTo from: start to: stop with: pFrom startingAt: repStart + "C indexed!!" + <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 added: + ----- Method: LargeIntegersPlugin>>cDigitRshift:from:len:to:len: (in category 'C core') ----- + 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 // 8. + bitShift := shiftCount \\ 8. + bitShift = 0 ifTrue: ["Fast version for byte-aligned shifts" + "C indexed!!" + ^self + cDigitReplace: pTo + from: 0 + to: toLen - 1 + with: pFrom + startingAt: digitShift]. + + "This implementation use at most 16 bits of x" + leftShift := 8 - bitShift. + carry := (pFrom at: digitShift) >> bitShift. + start := digitShift + 1. + limit := fromLen - 1. + start to: limit do: + [:j | + digit := pFrom at: j. + pTo at: j - start put: ((carry bitOr: digit << leftShift) bitAnd: 16rFF). + carry := digit >> bitShift]. + carry = 0 ifFalse: [pTo at: toLen - 1 put: carry]. + ^0! Item was added: + ----- Method: LargeIntegersPlugin>>cDigitRshiftCount:n:f:bytes:from:len:to:len: (in category 'C core') ----- + cDigitRshiftCount: count n: n f: f bytes: b from: pFrom len: fromLen to: pTo len: toLen + | x digit | + <var: #pTo type: 'unsigned char * '> + <var: #pFrom type: 'unsigned char * '> + self sqAssert: b < fromLen. + n = 0 ifTrue: ["Fast version for byte-aligned shifts" + "C indexed!!" + ^self + cDigitReplace: pTo + from: 0 + to: toLen - 1 + with: pFrom + startingAt: b]. + + "This implementation use at most 16 bits of x" + x := (pFrom at: b) << f. + self sqAssert: count - 1 < fromLen. + b + 1 to: count - 1 do: + [:j | + digit := pFrom at: j. + x := (x >> 8) bitOr: (digit << f). + pTo at: j - b - 1 put: (x bitAnd: 255)]. + count = fromLen + ifTrue: [digit := 0] + ifFalse: [digit := pFrom at: count]. + x := (x >> 8) bitOr: (digit << f). + pTo at: count - b - 1 put: (x "bitAnd: 255")! Item was removed: - ----- Method: LargeIntegersPlugin>>cdigitMontgomery:len:times:len:modulo:len:mInvModB:into: (in category 'C core') ----- - cdigitMontgomery: pBytesFirst - len: firstLen - times: pBytesSecond - len: secondLen - modulo: pBytesThird - len: thirdLen - mInvModB: mInv - into: pBytesRes - - | 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: #usqInt> - <var: #u type: #'unsigned char'> - <var: #lastByte type: #'unsigned char'> - limit1 := firstLen - 1. - limit2 := secondLen - 1. - limit3 := thirdLen - 1. - lastByte := 0. - 0 to: limit1 do: - [:i | - 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 | - 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 | - 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 := (pBytesRes at: 0). - u := accum * mInv bitAnd: 255. - accum := accum + (u * (pBytesThird at: 0)). - 1 to: limit3 do: [:k | - 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 + (pBytesRes at: i) - (pBytesThird at: i). - pBytesRes at: i put: (self cCode: [accum] inSmalltalk: [accum bitAnd: 255]). - accum := accum signedBitShift: -8]].! Item was added: + ----- Method: LargeIntegersPlugin>>digit:Lshift: (in category 'oop functions') ----- + digit: aBytesOop Lshift: shiftCount + "Attention: this method invalidates all oop's!! Only newBytes is valid at return." + "Does not normalize." + | 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: aBytesOop) + len: oldLen + to: (interpreterProxy firstIndexableField: newBytes) + len: newLen. + ^ newBytes! Item was added: + ----- Method: LargeIntegersPlugin>>digit:Rshift:bytes:lookfirst: (in category 'oop functions') ----- + digit: aBytesOop Rshift: anInteger bytes: b lookfirst: a + "Attention: this method invalidates all oop's!! Only newBytes is valid at return." + "Shift right 8*b+anInteger bits, 0<=n<8. + Discard all digits beyond a, and all zeroes at or below a." + "Does not normalize." + | x f digit i oldLen newLen newBytes | + x := 0. + f := 8 - anInteger. + i := a. + digit := self digitOfLargeInt: aBytesOop at: i. + [((digit >> anInteger) + bitOr: x) + = 0 and: [i ~= 1]] + whileTrue: + [x := digit << f. + "Can't exceed 8 bits" + i := i - 1. + digit := self digitOfLargeInt: aBytesOop at: i]. + i <= b ifTrue: [^ interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesOop) + indexableSize: 0"Integer new: 0 neg: self negative"]. + "All bits lost" + oldLen := self digitSizeOfLargeInt: aBytesOop. + newLen := i - b. + self remapOop: aBytesOop in: [newBytes := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesOop) + indexableSize: newLen]. + "r := Integer new: i - b neg: self negative." + " count := i. + " + self + cDigitRshiftCount: i + n: anInteger + f: f + bytes: b + from: (interpreterProxy firstIndexableField: aBytesOop) + len: oldLen + to: (interpreterProxy firstIndexableField: newBytes) + len: newLen. + ^ newBytes! Item was changed: ----- Method: LargeIntegersPlugin>>digitAddLarge:with: (in category 'oop functions') ----- digitAddLarge: firstInteger with: secondInteger "Does not need to normalize!!" | over firstLen secondLen shortInt shortLen longInt longLen sum newSum resClass | <var: #over type: 'unsigned char '> + firstLen := self digitSizeOfLargeInt: firstInteger. + secondLen := self digitSizeOfLargeInt: secondInteger. - firstLen := self byteSizeOfBytes: firstInteger. - secondLen := self byteSizeOfBytes: secondInteger. resClass := interpreterProxy fetchClassOf: firstInteger. firstLen <= secondLen ifTrue: [shortInt := firstInteger. shortLen := firstLen. longInt := secondInteger. longLen := secondLen] ifFalse: [shortInt := secondInteger. shortLen := secondLen. longInt := firstInteger. longLen := firstLen]. " sum := Integer new: len neg: firstInteger negative." self remapOop: #(shortInt longInt ) in: [sum := interpreterProxy instantiateClass: resClass indexableSize: longLen]. over := self cDigitAdd: (interpreterProxy firstIndexableField: shortInt) len: shortLen with: (interpreterProxy firstIndexableField: longInt) len: longLen into: (interpreterProxy firstIndexableField: sum). over > 0 ifTrue: ["sum := sum growby: 1." self remapOop: sum in: [newSum := interpreterProxy instantiateClass: resClass indexableSize: longLen + 1]. self + cDigitCopyFrom: (interpreterProxy firstIndexableField: sum) - cBytesCopyFrom: (interpreterProxy firstIndexableField: sum) to: (interpreterProxy firstIndexableField: newSum) len: longLen. sum := newSum. "C index!!" (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 digitSizeOfLargeInt: firstLarge. + secondLen := self digitSizeOfLargeInt: secondLarge. - firstLen := self byteSizeOfBytes: firstLarge. - secondLen := self byteSizeOfBytes: 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 - cByteOp: opIx short: (interpreterProxy firstIndexableField: shortLarge) len: shortLen long: (interpreterProxy firstIndexableField: longLarge) 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" | firstLen secondLen | + firstLen := self digitSizeOfLargeInt: firstInteger. + secondLen := self digitSizeOfLargeInt: secondInteger. - firstLen := self byteSizeOfBytes: firstInteger. - secondLen := self byteSizeOfBytes: secondInteger. secondLen ~= firstLen ifTrue: [secondLen > firstLen ifTrue: [^ -1 asOop: SmallInteger] ifFalse: [^ 1 asOop: SmallInteger]]. ^ (self cDigitCompare: (interpreterProxy firstIndexableField: firstInteger) with: (interpreterProxy firstIndexableField: secondInteger) 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." | firstLen secondLen resultClass l d div rem quo result | + firstLen := self digitSizeOfLargeInt: firstInteger. + secondLen := self digitSizeOfLargeInt: secondInteger. - firstLen := self byteSizeOfBytes: firstInteger. - secondLen := self byteSizeOfBytes: 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 byte of div is >=128" + d := 8 - (self cHighBit: (self unsafeDigitOf: secondInteger at: secondLen)). - d := 8 - (self cHighBit: (self unsafeByteOf: secondInteger at: secondLen)). self remapOop: firstInteger in: + [div := self digit: secondInteger Lshift: d. + div := self largeIntOrInt: div growTo: (self digitLength: div) - [div := self bytes: secondInteger Lshift: d. - div := self bytesOrInt: div growTo: (self digitLength: div) + 1]. self remapOop: div in: + [rem := self digit: firstInteger Lshift: d. - [rem := self bytes: firstInteger Lshift: d. (self digitLength: rem) + = firstLen ifTrue: [rem := self largeIntOrInt: rem growTo: firstLen + 1]]. - = firstLen ifTrue: [rem := self bytesOrInt: rem growTo: firstLen + 1]]. self remapOop: #(div rem ) in: [quo := interpreterProxy instantiateClass: resultClass indexableSize: l]. self + cDigitDiv: (interpreterProxy firstIndexableField: div) - cCoreDigitDivDiv: (interpreterProxy firstIndexableField: div) len: (self digitLength: div) rem: (interpreterProxy firstIndexableField: rem) len: (self digitLength: rem) quo: (interpreterProxy firstIndexableField: quo) len: (self digitLength: quo). self remapOop: #(quo ) in: [rem := self + digit: rem - bytes: rem Rshift: d bytes: 0 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 changed: ----- Method: LargeIntegersPlugin>>digitLength: (in category 'util') ----- digitLength: oop (interpreterProxy isIntegerObject: oop) ifTrue: [^ self cDigitLengthOfCSI: (interpreterProxy integerValueOf: oop)] + ifFalse: [^ self digitSizeOfLargeInt: oop]! - ifFalse: [^ self byteSizeOfBytes: oop]! Item was changed: ----- Method: LargeIntegersPlugin>>digitLengthOfNonImmediate: (in category 'util') ----- digitLengthOfNonImmediate: oop <inline: true> + ^self digitSizeOfLargeInt: oop! - ^self byteSizeOfBytes: oop! Item was changed: ----- Method: LargeIntegersPlugin>>digitMontgomery:times:modulo:mInvModB: (in category 'oop functions') ----- digitMontgomery: firstLarge times: secondLarge modulo: thirdLarge mInvModB: mInv | firstLen secondLen thirdLen prod | + firstLen := self digitSizeOfLargeInt: firstLarge. + secondLen := self digitSizeOfLargeInt: secondLarge. + thirdLen := self digitSizeOfLargeInt: thirdLarge. - firstLen := self byteSizeOfBytes: firstLarge. - secondLen := self byteSizeOfBytes: secondLarge. - thirdLen := self byteSizeOfBytes: thirdLarge. firstLen <= thirdLen ifFalse: [^interpreterProxy primitiveFail]. secondLen <= thirdLen ifFalse: [^interpreterProxy primitiveFail]. (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) - 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 resultClass | + firstLen := self digitSizeOfLargeInt: firstInteger. + secondLen := self digitSizeOfLargeInt: secondInteger. - firstLen := self byteSizeOfBytes: firstInteger. - secondLen := self byteSizeOfBytes: secondInteger. firstLen <= secondLen ifTrue: [shortInt := firstInteger. shortLen := firstLen. longInt := secondInteger. longLen := secondLen] ifFalse: [shortInt := secondInteger. shortLen := secondLen. longInt := firstInteger. longLen := firstLen]. 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 with: (interpreterProxy firstIndexableField: longInt) len: longLen into: (interpreterProxy firstIndexableField: prod). ^ self normalize: prod! Item was changed: ----- Method: LargeIntegersPlugin>>digitOf:at: (in category 'util') ----- digitOf: oop at: ix (interpreterProxy isIntegerObject: oop) ifTrue: [ix < 1 ifTrue: [interpreterProxy primitiveFail. ^0]. ix > interpreterProxy bytesPerOop ifTrue: [^0]. ^self cDigitOfCSI: (interpreterProxy integerValueOf: oop) at: ix]. + ^self digitOfLargeInt: oop at: ix! - ^self digitOfBytes: oop at: ix! Item was removed: - ----- Method: LargeIntegersPlugin>>digitOfBytes:at: (in category 'util') ----- - digitOfBytes: aBytesOop at: ix - "Argument has to be aLargeInteger!!" - ix > (self byteSizeOfBytes: aBytesOop) - ifTrue: [^ 0] - ifFalse: [^ self unsafeByteOf: aBytesOop at: ix]! Item was added: + ----- Method: LargeIntegersPlugin>>digitOfLargeInt:at: (in category 'util') ----- + digitOfLargeInt: aBytesOop at: ix + "Argument has to be aLargeInteger!!" + ix > (self digitSizeOfLargeInt: aBytesOop) + ifTrue: [^ 0] + ifFalse: [^ self unsafeDigitOf: aBytesOop at: ix]! Item was added: + ----- Method: LargeIntegersPlugin>>digitSizeOfLargeInt: (in category 'util') ----- + 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." | firstLen secondLen larger largerLen smaller smallerLen neg resLen res firstNeg | firstNeg := (interpreterProxy fetchClassOf: firstInteger) = interpreterProxy classLargeNegativeInteger. + firstLen := self digitSizeOfLargeInt: firstInteger. + secondLen := self digitSizeOfLargeInt: secondInteger. - firstLen := self byteSizeOfBytes: firstInteger. - secondLen := self byteSizeOfBytes: secondInteger. firstLen = secondLen ifTrue: [[firstLen > 1 + and: [(self digitOfLargeInt: firstInteger at: firstLen) = (self digitOfLargeInt: secondInteger at: firstLen)]] - and: [(self digitOfBytes: firstInteger at: firstLen) = (self digitOfBytes: 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)]]) - and: [(self digitOfBytes: firstInteger at: firstLen) < (self digitOfBytes: secondInteger at: firstLen)]]) ifTrue: [larger := secondInteger. largerLen := secondLen. smaller := firstInteger. smallerLen := firstLen. neg := firstNeg == false] ifFalse: [larger := firstInteger. largerLen := firstLen. smaller := secondInteger. smallerLen := secondLen. neg := firstNeg]. resLen := largerLen. self remapOop: #(smaller larger) in: [res := interpreterProxy instantiateClass: (neg ifTrue: [interpreterProxy classLargeNegativeInteger] ifFalse: [interpreterProxy classLargePositiveInteger]) indexableSize: resLen]. self cDigitSub: (interpreterProxy firstIndexableField: smaller) len: smallerLen with: (interpreterProxy firstIndexableField: larger) len: largerLen into: (interpreterProxy firstIndexableField: res). ^neg ifTrue: [self normalizeNegative: res] ifFalse: [self normalizePositive: res]! Item was removed: - ----- Method: LargeIntegersPlugin>>highBitOfBytes: (in category 'util') ----- - highBitOfBytes: aBytesOop - ^ self cBytesHighBit: (interpreterProxy firstIndexableField: aBytesOop) - len: (self byteSizeOfBytes: aBytesOop)! Item was added: + ----- Method: LargeIntegersPlugin>>highBitOfLargeInt: (in category 'util') ----- + highBitOfLargeInt: aBytesOop + ^ self cDigitHighBit: (interpreterProxy firstIndexableField: aBytesOop) + len: (self digitSizeOfLargeInt: aBytesOop)! Item was added: + ----- Method: LargeIntegersPlugin>>largeInt:growTo: (in category 'oop util') ----- + largeInt: aBytesObject growTo: newLen + "Attention: this method invalidates all oop's!! Only newBytes is valid at return." + "Does not normalize." + | newBytes oldLen copyLen | + self remapOop: aBytesObject in: [newBytes := interpreterProxy instantiateClass: (interpreterProxy fetchClassOf: aBytesObject) + 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 added: + ----- 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 removed: - ----- Method: LargeIntegersPlugin>>negative: (in category 'util') ----- - negative: aLarge - ^ (interpreterProxy fetchClassOf: aLarge) - = interpreterProxy classLargeNegativeInteger! Item was changed: ----- Method: LargeIntegersPlugin>>normalizeNegative: (in category 'oop functions') ----- normalizeNegative: aLargeNegativeInteger "Check for leading zeroes and return shortened copy if so." "First establish len = significant length." | sLen val len oldLen pointer | len := oldLen := self digitLengthOfNonImmediate: aLargeNegativeInteger. pointer := interpreterProxy cCoerce: (interpreterProxy firstIndexableField: aLargeNegativeInteger) to: #'unsigned char *'. [len > 0 and: [(pointer at: len - 1) = 0]] whileTrue: [len := len - 1]. len = 0 ifTrue: [^ 0 asOop: SmallInteger]. "Now check if in SmallInteger range" sLen := interpreterProxy minSmallInteger < -16r40000000 ifTrue: [8] ifFalse: [4]. "SmallInteger digitLength" len <= sLen ifTrue: [(len < sLen or: [(pointer at: sLen - 1) < (self cDigitOfCSI: interpreterProxy minSmallInteger at: sLen)]) ifTrue: "interpreterProxy minSmallInteger lastDigit" ["If high digit less, then can be small" val := 0 - (pointer at: (len := len - 1)). len - 1 to: 0 by: -1 do: [:i | val := val * 256 - (pointer at: i)]. ^val asOop: SmallInteger]. 1 to: sLen do: [:i | | byte | "If all digits same, then = minSmallInteger (sr: minSmallInteger digits 1 to sLen - 1 are 0)" byte := i > len ifTrue: [0] ifFalse: [pointer at: i - 1]. byte ~= (self cDigitOfCSI: interpreterProxy minSmallInteger at: i) ifTrue: "Not so; return self shortened" [len < oldLen ifTrue: "^ self growto: len" + [^self largeInt: aLargeNegativeInteger growTo: len]. - [^self bytes: aLargeNegativeInteger growTo: len]. ^aLargeNegativeInteger]]. ^interpreterProxy minSmallInteger asOop: SmallInteger]. "Return self, or a shortened copy" len < oldLen ifTrue: "^ self growto: len" + [^self largeInt: aLargeNegativeInteger growTo: len]. - [^self bytes: 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." | 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" 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" len < oldLen ifTrue: "^ self growto: len" + [^self largeInt: aLargePositiveInteger growTo: len]. - [^self bytes: aLargePositiveInteger growTo: len]. ^aLargePositiveInteger! Item was changed: ----- Method: LargeIntegersPlugin>>primAnyBitFrom:to: (in category 'Integer primitives') ----- primAnyBitFrom: from to: to | integer large | self debugCode: [self msg: 'primAnyBitFrom: from to: to']. integer := self primitive: 'primAnyBitFromTo' parameters: #(#SmallInteger #SmallInteger ) receiver: #Integer. (interpreterProxy isIntegerObject: integer) ifTrue: ["convert it to a not normalized LargeInteger" large := self createLargeFromSmallInteger: integer] ifFalse: [large := integer]. ^ (self + anyBitOfLargeInt: large - anyBitOfBytes: large from: from to: to) asOop: Boolean! Item was changed: ----- Method: LargeIntegersPlugin>>primDigit:bitShift: (in category 'development primitives') ----- primDigit: anInteger bitShift: shiftCount | rShift aLarge | self debugCode: [self msg: 'primDigit: anInteger bitShift: shiftCount']. self primitive: '_primDigitBitShift' parameters: #(Integer SmallInteger ) receiver: #Oop. (interpreterProxy isIntegerObject: anInteger) ifTrue: ["convert it to a not normalized LargeInteger" aLarge := self createLargeFromSmallInteger: anInteger] ifFalse: [aLarge := anInteger]. shiftCount >= 0 + ifTrue: [^ self digit: aLarge Lshift: shiftCount] - ifTrue: [^ self bytes: aLarge Lshift: shiftCount] ifFalse: [rShift := 0 - shiftCount. ^ self normalize: (self + digit: aLarge - bytes: aLarge Rshift: (rShift bitAnd: 7) bytes: (rShift bitShift: -3) + lookfirst: (self digitSizeOfLargeInt: aLarge))]! - lookfirst: (self byteSizeOfBytes: aLarge))]! Item was changed: ----- Method: LargeIntegersPlugin>>primDigitBitShift: (in category 'obsolete') ----- primDigitBitShift: shiftCount | rShift aLarge anInteger | self debugCode: [self msg: 'primDigitBitShift: shiftCount']. anInteger := self primitive: 'primDigitBitShift' parameters: #(SmallInteger ) receiver: #Integer. (interpreterProxy isIntegerObject: anInteger) ifTrue: ["convert it to a not normalized LargeInteger" aLarge := self createLargeFromSmallInteger: anInteger] ifFalse: [aLarge := anInteger]. shiftCount >= 0 + ifTrue: [^ self digit: aLarge Lshift: shiftCount] - ifTrue: [^ self bytes: aLarge Lshift: shiftCount] ifFalse: [rShift := 0 - shiftCount. ^ self normalize: (self + digit: aLarge - bytes: aLarge Rshift: (rShift bitAnd: 7) bytes: (rShift bitShift: -3) + lookfirst: (self digitSizeOfLargeInt: aLarge))]! - lookfirst: (self byteSizeOfBytes: aLarge))]! Item was changed: ----- Method: LargeIntegersPlugin>>primDigitBitShiftMagnitude: (in category 'Integer primitives') ----- primDigitBitShiftMagnitude: shiftCount | rShift aLarge anInteger | self debugCode: [self msg: 'primDigitBitShiftMagnitude: shiftCount']. anInteger := self primitive: 'primDigitBitShiftMagnitude' parameters: #(#SmallInteger ) receiver: #Integer. (interpreterProxy isIntegerObject: anInteger) ifTrue: ["convert it to a not normalized LargeInteger" aLarge := self createLargeFromSmallInteger: anInteger] ifFalse: [aLarge := anInteger]. shiftCount >= 0 + ifTrue: [^ self digit: aLarge Lshift: shiftCount] - ifTrue: [^ self bytes: aLarge Lshift: shiftCount] ifFalse: [rShift := 0 - shiftCount. ^ self normalize: (self + digit: aLarge - bytes: aLarge Rshift: (rShift bitAnd: 7) bytes: (rShift bitShift: -3) + lookfirst: (self digitSizeOfLargeInt: aLarge))]! - lookfirst: (self byteSizeOfBytes: aLarge))]! Item was added: + ----- Method: LargeIntegersPlugin>>primMontgomeryDigitLength (in category 'Integer primitives') ----- + primMontgomeryDigitLength + self debugCode: [self msg: 'primMontgomeryDigitLength']. + self + primitive: 'primMontgomeryDigitLength' + parameters: #() + receiver: #Integer. + ^interpreterProxy integerObjectOf: 8! Item was removed: - ----- Method: LargeIntegersPlugin>>think (in category 'debugging') ----- - think - "Flag for marking methods for later thinking." - self debugCode: [self msg: '#think should not be called']. - ^nil! Item was removed: - ----- Method: LargeIntegersPlugin>>unsafeByteOf:at: (in category 'util') ----- - unsafeByteOf: 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>>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!

1 0

abs() generation problem
by Nicolas Cellier 25 Mar '16

25 Mar '16

Hi, abs(sqInt) is a problem on 64bits system. Because sqInt is a long, this should be labs(sqInt). Well, as long as we only use 32 bits out of the 64, AND restrict ourself to little endian, this wrong code apparently works. But it's so fragile: #cat > test_abs.c <<END #include <stdio.h> int main() { long long x=(1LL << 33) - 1; long long y = abs(x); printf("x=%lld abs(x)=%lld\n",x,y); } END #clang test_abs.c test_abs.c:4:17: warning: implicitly declaring library function 'abs' with type 'int (int)' [-Wimplicit-function-declaration] long long y = abs(x); ^ test_abs.c:4:17: note: include the header <stdlib.h> or explicitly provide a declaration for 'abs' test_abs.c:4:17: warning: absolute value function 'abs' given an argument of type 'long long' but has parameter of type 'int' which may cause truncation of value [-Wabsolute-value] long long y = abs(x); ^ test_abs.c:4:17: note: use function 'llabs' instead long long y = abs(x); ^~~ llabs test_abs.c:4:17: note: include the header <stdlib.h> or explicitly provide a declaration for 'llabs' #./a.out x=8589934591 abs(x)=1 So we can think of adding a #generateAbs:on:indent: and handle the #typeFor:in: BUT: sqInt is either defined as int or long depending on the target: #if defined(SQ_IMAGE32) typedef int sqInt; typedef unsigned int usqInt; #elif defined(SQ_HOST64) typedef long sqInt; typedef unsigned long usqInt; #elif (SIZEOF_LONG_LONG != 8) # error long long integers are not 64-bits wide? #else typedef long long sqInt; typedef unsigned long long usqInt; #endif Here, I propose 3 solutions: 1) since sqInt=int=long in 32bits spur, and sqInt=long in 64bits spur we can cheat: sqLong 'long long' int64_t __int64 -> #llabs sqInt long -> #lasb int int32_t __int32 -> #abs it's not straight and may still generate compiler warnings, which should be avoided 2) testing the wordSize, and branching in the generator: is64bitsVM := vmClass notNil and: [vmClass objectMemoryClass wordSize = 8]. Ah no, we currently generate single source for src/plugins in 32 and 64bits flavour, that ain't gonna work, or we should differentiate the plugin generation 3) generate a macro SQABS for sqInt and define it in sqMemoryAccess.h, same of sqLong sqInt -> SQABS sqLong -> SQLABS The correct solution is 3), but I have no commit right to svn, so someone should do it. I'm attaching my own sqMemoryAccess.h copy, but please note that it has other improvments like - avoiding un-strict pointer aliasing via memcpy for fetching/storing float (except swapper in BIGENDIAN branch) - providing some native unsigned memory access ---------------------------------------------- Now what about unsigned types? #cat > test_abs.c <<END #include <stdio.h> int main() { unsigned int x=-1; printf("abs(x)=%d\n",abs(x)); return 0; } END #test_abs.c:4:24: warning: implicitly declaring library function 'abs' with type 'int (int)' [-Wimplicit-function-declaration] printf("abs(x)=%d\n",abs(x)); ^ test_abs.c:4:24: note: include the header <stdlib.h> or explicitly provide a declaration for 'abs' test_abs.c:4:24: warning: taking the absolute value of unsigned type 'unsigned int' has no effect [-Wabsolute-value] printf("abs(x)=%d\n",abs(x)); ^ test_abs.c:4:24: note: remove the call to 'abs' since unsigned values cannot be negative printf("abs(x)=%d\n",abs(x)); ^~~ #./a.out abs(x)=1 clang first tells that there is no point of taking absolute value of an unsigned int, an unsigned is allways positive. BUT, then it re-interprets the unsigned as signed, and the program return +1. It would return -1 if abs were really a no-op. So there are several alternatives for the generator here: - 1) suppress the generation of abs for an unsigned BEWARE, this will change behaviour vs current state of VMMaker - 2) force a signed cast to remove the warning we just enforce current state of VMMaker but tell the compiler to shut up - 3) do nothing and leave the problem for later... the compiler will spit more errors I'm attaching solution 3), have programmed 2) in my own branch. 1) is dangerous because of 2 things : - unwanted promotion to unsigned type in C - simply put a sizeof(...) in the expression and it turns unsigned... - limited confidence about how slang inlining is handling the implicit type conversions... Currently there is at least 1 abs(unsigned) which is generated in shrinkObjectMemory : ../../spurstack64src/vm/gcc3x-interp.c:50178:12: warning: taking the absolute value of unsigned type 'unsigned long' has no effect [-Wabsolute-value] && ((SQABS((((seg->segSize)) - shrinkage))) < delta1)) { This is because shrinkage is declared usqInt... There would be yet another solution - 4) raise an exception and let the dear VMMaker user handle the ambiguity That's my favourite, but It's only a comment in attachment, I don't want to break yet another Jenkins job ;) We should force the correct cast where there is ambiguity. If we do not, the exception could be proceedable and would proceed to solution 3) - (we do not shut up the compiler and give another chance to someone to understand and correct slang source...) Eliot, David, Tim, others, what do you think ?

5 4

Small problem after upgrading to Xcode Version 7.3 (7D175)
by Nicolas Cellier 24 Mar '16

24 Mar '16

Hi, I now get this error message: clang -x objective-c -MT build/vm/SqueakOSXAppDelegate.o -MMD -MP -MF deps/SqueakOSXAppDelegate.Td -Wall -Wno-missing-field-initializers -Wno-missing-prototypes -Wno-missing-braces -Wparentheses -Wswitch -Wno-unused-function -Wno-unused-label -Wno-unused-parameter -Wunused-variable -Wunused-value -Wno-empty-body -Wno-uninitialized -Wno-unknown-pragmas -Wno-shadow -Wno-four-char-constants -Wno-conversion -Wno-constant-conversion -Wno-int-conversion -Wno-bool-conversion -Wno-enum-conversion -Wno-sign-conversion -Wno-shorten-64-to-32 -Wpointer-sign -Wno-newline-eof -Wno-trigraphs -Wdeprecated-declarations -g -Os -DDEBUGVM=0 -DNDEBUG=1 -DUSE_GLOBAL_STRUCT=0 -DNO_ISNAN=1 -DUSE_INLINE_MEMORY_ACCESSORS -D'TZ="CET"' -D'VM_LABEL(foo)=0' -DSQUEAK_BUILTIN_PLUGIN -DBUILD_FOR_OSX=1 -arch x86_64 -mmacosx-version-min=10.6 -msse4.2 -fvisibility=hidden -fwrapv -fmacro-backtrace-limit=0 -fdiagnostics-show-note-include-stack -fmessage-length=0 -fpascal-strings -fasm-blocks -fstrict-aliasing -isysroot /Applications/Xcode.app/Contents/Developer/Platforms/MacOSX.platform/Developer/SDKs/MacOSX10.11.sdk -include ../../platforms/iOS/vm/SqueakPureObjc_Prefix.pch -I. -I../../spurstack64src/vm -I../../platforms/iOS/vm/Common -I../../platforms/iOS/vm/Common/Classes -I../../platforms/iOS/vm/OSX -I../../platforms/unix/vm -I../../platforms/Cross/vm -I../../platforms/Cross/plugins/FilePlugin -I../../platforms/Cross/plugins/HostWindowPlugin -I../../platforms/Cross/plugins/SoundPlugin -I../../platforms/iOS/plugins/FilePlugin -I../../platforms/iOS/plugins/HostWindowPlugin -I../../platforms/iOS/plugins/SoundPlugin -c ../../platforms/iOS/vm/OSX/SqueakOSXAppDelegate.m -o build/vm/SqueakOSXAppDelegate.o In file included from ../../platforms/iOS/vm/OSX/SqueakOSXAppDelegate.m:39: ../../platforms/iOS/vm/OSX/SqueakOSXAppDelegate.h:48:22: error: cannot create __weak reference because the current deployment target does not support weak references NSWindow *__weak window; ^ clang --version Apple LLVM version 7.3.0 (clang-703.0.29) Target: x86_64-apple-darwin15.4.0 Thread model: posix InstalledDir: /Applications/Xcode.app/Contents/Developer/Toolchains/XcodeDefault.xctoolchain/usr/bin Changing the ../common/Makefile.flags to TARGET_VERSION_MIN:=10.7 instead of: TARGET_VERSION_MIN:=10.6 Did it for me... No idea how/why the code did previously compile, but I wanted to let you know.

2 1

← Newer
1
2
3
4
5
6
7
8
...
14
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev March 2016