[Vm-dev] VM Maker: VMMaker.oscog-nice.1823.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Apr 20 00:09:56 UTC 2016


Nicolas Cellier uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-nice.1823.mcz

==================== Summary ====================

Name: VMMaker.oscog-nice.1823
Author: nice
Time: 20 April 2016, 2:07:36.545 am
UUID: e93f8c0f-a7f9-409d-ac57-f8ae88bb4342
Ancestors: VMMaker.oscog-eem.1822, VMMaker.oscog-nice.1813

Merge the LargeIntegersPlugin acceleration for type checking (VMMaker.oscog-nice.1813).

Add the missing simulation hooks for Spur.

These changes require svn sources for platforms/Cross/vm/sqVirtualMemory.[ch] rev 3673

=============== Diff against VMMaker.oscog-eem.1822 ===============

Item was changed:
  ----- Method: FFIPlugin>>ffiPushUnsignedLongLongOop: (in category 'callout support') -----
  ffiPushUnsignedLongLongOop: oop
  	"Push a longlong type (e.g., a 64bit integer).
  	Note: Coercions from float are *not* supported."
  	| lowWord highWord length ptr |
  	<var: #ptr type:'unsigned char *'>
  	oop == interpreterProxy nilObject 
  		ifTrue:[^self ffiPushUnsignedLong: 0 Long: 0.]. "@@: check this"
  	oop == interpreterProxy falseObject 
  		ifTrue:[^self ffiPushUnsignedLong: 0 Long: 0].
  	oop == interpreterProxy trueObject 
  		ifTrue:[^self ffiPushUnsignedLong: 0 Long: 1].
  	(interpreterProxy isIntegerObject: oop) ifTrue:[
  		lowWord := interpreterProxy integerValueOf: oop.
  		lowWord < 0 ifTrue:[^self ffiFail: FFIErrorCoercionFailed].
  		highWord := 0.
  	] ifFalse:[
+ 		(interpreterProxy isLargePositiveIntegerObject: oop)
- 		(interpreterProxy fetchClassOf: oop) = interpreterProxy classLargePositiveInteger
  			ifFalse:[^interpreterProxy primitiveFail].
  		(interpreterProxy isBytes: oop) ifFalse:[^self ffiFail: FFIErrorCoercionFailed].
  		length := interpreterProxy byteSizeOf: oop.
  		length > 8 ifTrue:[^self ffiFail: FFIErrorCoercionFailed].
  		lowWord := highWord := 0.
  		ptr := interpreterProxy firstIndexableField: oop.
  		0 to: (length min: 4)-1 do:[:i|
  			lowWord := lowWord + ((ptr at: i) << (i*8))].
  		0 to: (length-5) do:[:i|
  			highWord := highWord + ((ptr at: i+4) << (i*8))].
  	].
  	^self ffiPushUnsignedLong: lowWord Long: highWord.!

Item was changed:
  ----- Method: IA32ABIPlugin>>primAlienReplace (in category 'primitives-accessing') -----
  primAlienReplace
  	"Copy some number of bytes from some source object starting at the index
  	 into the receiver destination object  from startIndex to stopIndex .  The  source
  	 and destination may be Aliens or byte-indexable objects.  The primitive wll have either
  	of the following signatures:
  	<Alien | indexableByteSubclass | indexableWordSubclass>
  		primReplaceFrom: start <Integer>
  		to: stop <Integer>
  		with: replacement <Alien | indexableByteSubclass | indexableWordSubclass | Integer>
  		startingAt: repStart <Integer> ^<self>
  		<primitive: 'primitiveAlienReplace' error: errorCode module: 'IA32ABI'>
  	<Anywhere>
  		primReplaceIn: dest <Alien | indexableByteSubclass | indexableWordSubclass>
  		from: start <Integer>
  		to: stop <Integer>
  		with: replacement <Alien | indexableByteSubclass | indexableWordSubclass | Integer>
  		startingAt: repStart <Integer> ^<self>
  		<primitive: 'primitiveAlienReplace' error: errorCode module: 'IA32ABI'>
  	"
  	| array start stop repl replStart dest src totalLength count |
  	<export: true>
  	array := interpreterProxy stackValue: 4.
  	start := interpreterProxy stackIntegerValue: 3.
  	stop := interpreterProxy stackIntegerValue: 2.
  	repl := interpreterProxy stackValue: 1.
  	replStart := interpreterProxy stackIntegerValue: 0.
  
  	(interpreterProxy failed
  	 or: [(interpreterProxy isWordsOrBytes: array) not]) ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  
  	(self isAlien: array)
  		ifTrue:
  			[totalLength := self sizeField: array.
  			 dest := (self startOfData: array withSize: totalLength) + start - 1.
  			 totalLength = 0 "no bounds checks for zero-sized (pointer) Aliens"
  				ifTrue: [totalLength := stop]
  				ifFalse: [totalLength := totalLength abs]]
  		ifFalse:
  			[totalLength := interpreterProxy byteSizeOf: array.
  			 dest := (self startOfByteData: array) + start - 1].
  	(start >= 1 and: [start - 1 <= stop and: [stop <= totalLength]])
  		ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
  
  	(interpreterProxy isIntegerObject: repl)
  		ifTrue:
  			[(interpreterProxy integerValueOf: repl) <= 0 ifTrue:
  				[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  			src := (interpreterProxy integerValueOf: repl) + replStart - 1]
  		ifFalse:
+ 			[(interpreterProxy isLargePositiveIntegerObject: repl)
- 			[(interpreterProxy fetchClassOf: repl) ==  interpreterProxy classLargePositiveInteger
  				ifTrue:
  					[src := (interpreterProxy positive32BitValueOf: repl) + replStart - 1.
  					 interpreterProxy failed ifTrue:
  						[^interpreterProxy primitiveFailFor: PrimErrBadArgument]]
  				ifFalse:
  					[(self isAlien: repl)
  						ifTrue:
  							[totalLength := self sizeField: repl.
  							 src := (self startOfData: repl withSize: totalLength) + replStart - 1.
  							 totalLength = 0 "no bounds checks for zero-sized (pointer) Aliens"
  								ifTrue: [totalLength := stop - start + replStart]
  								ifFalse: [totalLength := totalLength abs]]
  						ifFalse:
  							[(interpreterProxy isWordsOrBytes: repl) ifFalse:
  								[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  							 totalLength := interpreterProxy byteSizeOf: repl.
  							 src := (self startOfByteData: repl) + replStart - 1].
  					(replStart >= 1 and: [stop - start + replStart <= totalLength]) ifFalse:
  						[^interpreterProxy primitiveFailFor: PrimErrBadIndex]]].
  
  	(interpreterProxy isOopImmutable: array) ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrNoModification].
  
  	count := stop - start + 1.
  	self cCode: 'memmove((void *)dest,(void *)src,count)'
  		inSmalltalk:
  			[count := count + src + dest. "squash unused var compiler warnings"
  			 self error: 'not implemented'].
  
  	interpreterProxy pop: interpreterProxy methodArgumentCount!

Item was added:
+ ----- Method: Integer class>>ccg:prolog:expr:index: (in category '*VMMaker-plugin generation') -----
+ ccg: cg prolog: aBlock expr: aString index: anInteger
+ 
+ 	^cg ccgLoad: aBlock expr: aString asKindOfIntegerFrom: anInteger!

Item was added:
+ ----- Method: Interpreter>>isKindOfInteger: (in category 'plugin primitive support') -----
+ isKindOfInteger: oop
+ 	"Answer true if the oop is kind of Integer (Small or Large)."
+ 	<api>
+ 	<inline: true>
+ 	^(self isIntegerObject: oop)
+ 		or: [self isLargeIntegerInstance: oop]!

Item was added:
+ ----- Method: Interpreter>>isLargeIntegerObject: (in category 'plugin primitive support') -----
+ isLargeIntegerObject: oop
+ 	^(self isLargeIntegerInstance: oop)!

Item was added:
+ ----- Method: Interpreter>>isLargeNegativeIntegerObject: (in category 'plugin primitive support') -----
+ isLargeNegativeIntegerObject: oop
+ 	^(self isInstanceOfClassLargeNegativeInteger: oop)!

Item was added:
+ ----- Method: Interpreter>>isLargePositiveIntegerObject: (in category 'plugin primitive support') -----
+ isLargePositiveIntegerObject: oop
+ 	^(self isInstanceOfClassLargePositiveInteger: oop)!

Item was removed:
- ----- Method: InterpreterPrimitives>>isInstanceOfClassLargeNegativeInteger: (in category 'primitive support') -----
- isInstanceOfClassLargeNegativeInteger: oop
- 	<inline: true>
- 	"N.B.  Because Slang always inlines is:instanceOf:compactClassIndex:
- 	 (because is:instanceOf:compactClassIndex: has an inline: pragma) the
- 	 phrase (objectMemory splObj: ClassLargeNegativeInteger) is expanded
- 	 in-place and is _not_ evaluated if oop has a non-zero CompactClassIndex."
- 	^objectMemory
- 		is: oop
- 		instanceOf: (objectMemory splObj: ClassLargeNegativeInteger) 
- 		compactClassIndex: ClassLargeNegativeIntegerCompactIndex!

Item was removed:
- ----- Method: InterpreterPrimitives>>isInstanceOfClassLargePositiveInteger: (in category 'primitive support') -----
- isInstanceOfClassLargePositiveInteger: oop
- 	<inline: true>
- 	"N.B.  Because Slang always inlines is:instanceOf:compactClassIndex:
- 	 (because is:instanceOf:compactClassIndex: has an inline: pragma) the
- 	 phrase (objectMemory splObj: ClassLargePositiveInteger) is expanded
- 	 in-place and is _not_ evaluated if oop has a non-zero CompactClassIndex."
- 	^objectMemory
- 		is: oop
- 		instanceOf: (objectMemory splObj: ClassLargePositiveInteger) 
- 		compactClassIndex: ClassLargePositiveIntegerCompactIndex!

Item was added:
+ ----- Method: InterpreterProxy>>isKindOfInteger: (in category 'testing') -----
+ isKindOfInteger: objectOrientedPointer
+ 	^objectOrientedPointer isInteger!

Item was added:
+ ----- Method: InterpreterProxy>>isLargeIntegerObject: (in category 'testing') -----
+ isLargeIntegerObject: objectOrientedPointer
+ 	^objectOrientedPointer isKindOf: LargePositiveInteger!

Item was added:
+ ----- Method: InterpreterProxy>>isLargeNegativeIntegerObject: (in category 'testing') -----
+ isLargeNegativeIntegerObject: objectOrientedPointer
+ 	^objectOrientedPointer isMemberOf: LargeNegativeInteger!

Item was added:
+ ----- Method: InterpreterProxy>>isLargePositiveIntegerObject: (in category 'testing') -----
+ isLargePositiveIntegerObject: objectOrientedPointer
+ 	^objectOrientedPointer isMemberOf: LargePositiveInteger!

Item was changed:
  ----- Method: LargeIntegersPlugin>>digitAddLarge:with: (in category 'oop functions') -----
  digitAddLarge: firstInteger with: secondInteger 
  	"Does not need to normalize!!"
  	| over firstDigitLen secondDigitLen shortInt shortDigitLen longInt longDigitLen sum newSum neg |
  	<var: #over type: #'unsigned int'>
  	firstDigitLen := self digitSizeOfLargeInt: firstInteger.
  	secondDigitLen := self digitSizeOfLargeInt: secondInteger.
+ 	neg := interpreterProxy isLargeNegativeIntegerObject: firstInteger.
- 	neg := (interpreterProxy fetchClassOf: firstInteger)
- 		= interpreterProxy classLargeNegativeInteger.
  	firstDigitLen <= secondDigitLen
  		ifTrue: 
  			[shortInt := firstInteger.
  			shortDigitLen := firstDigitLen.
  			longInt := secondInteger.
  			longDigitLen := secondDigitLen]
  		ifFalse: 
  			[shortInt := secondInteger.
  			shortDigitLen := secondDigitLen.
  			longInt := firstInteger.
  			longDigitLen := firstDigitLen].
  	"	sum := Integer new: len neg: firstInteger negative."
  	self remapOop: #(shortInt longInt ) in: [sum := self createLargeIntegerNeg: neg digitLength: longDigitLen].
  	over := self
  				cDigitAdd: (self pointerToFirstDigitOfLargeInt: shortInt)
  				len: shortDigitLen
  				with: (self pointerToFirstDigitOfLargeInt: longInt)
  				len: longDigitLen
  				into: (self pointerToFirstDigitOfLargeInt: sum).
  	over > 0
  		ifTrue: 
  			["sum := sum growby: 1."
  			self remapOop: sum in: [newSum := self createLargeIntegerNeg: neg byteLength: longDigitLen * 4 + 1].
  			self
  				cDigitCopyFrom: (self pointerToFirstDigitOfLargeInt: sum)
  				to: (self pointerToFirstDigitOfLargeInt: newSum)
  				len: longDigitLen.
  			sum := newSum.
  			"C index!!"
  			self cDigitOf: (self pointerToFirstDigitOfLargeInt: sum)
  				at: longDigitLen put: over]
  		ifFalse:
  			[sum := neg 
  				ifTrue: [self normalizeNegative: sum]
  				ifFalse: [self normalizePositive: sum]].
  	^ 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 isLargePositiveIntegerObject: firstInteger) ifFalse: [^ interpreterProxy primitiveFail].
- 			[(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 isLargePositiveIntegerObject: secondInteger) ifFalse: [^ interpreterProxy primitiveFail].
- 			[(interpreterProxy fetchClassOf: secondInteger)
- 				= interpreterProxy classLargeNegativeInteger ifTrue: [^ interpreterProxy primitiveFail].
  			secondLarge := secondInteger].
  	firstLen := self byteSizeOfLargeInt: firstLarge.
  	secondLen := self byteSizeOfLargeInt: secondLarge.
  	firstLen < secondLen
  		ifTrue: 
  			[shortLen := firstLen.
  			shortLarge := firstLarge.
  			longLen := secondLen.
  			longLarge := secondLarge]
  		ifFalse: 
  			[shortLen := secondLen.
  			shortLarge := secondLarge.
  			longLen := firstLen.
  			longLarge := firstLarge].
  	self remapOop: #(shortLarge longLarge ) in: [result := interpreterProxy instantiateClass: interpreterProxy classLargePositiveInteger indexableSize: longLen].
  	self
  		cDigitOp: opIx
  		short: (self pointerToFirstDigitOfLargeInt: shortLarge)
  		len: shortLen + 3 // 4
  		long: (self pointerToFirstDigitOfLargeInt: longLarge)
  		len: longLen + 3 // 4
  		into: (self pointerToFirstDigitOfLargeInt: result).
  	interpreterProxy failed ifTrue: [^ 0].
  	^ self normalizePositive: result!

Item was changed:
  ----- Method: LargeIntegersPlugin>>digitSubLarge:with: (in category 'oop functions') -----
  digitSubLarge: firstInteger with: secondInteger 
  	"Normalizes."
  	| firstDigitLen secondDigitLen larger largeDigitLen smaller smallerDigitLen neg resDigitLen res firstNeg |
+ 	firstNeg := interpreterProxy isLargeNegativeIntegerObject: firstInteger.
- 	firstNeg := (interpreterProxy fetchClassOf: firstInteger)
- 				= interpreterProxy classLargeNegativeInteger.
  	firstDigitLen := self digitSizeOfLargeInt: firstInteger.
  	secondDigitLen := self digitSizeOfLargeInt: secondInteger.
  	firstDigitLen = secondDigitLen ifTrue: 
  		[[firstDigitLen > 1
  		  and: [(self unsafeDigitOfLargeInt: firstInteger at: firstDigitLen) = (self unsafeDigitOfLargeInt: secondInteger at: firstDigitLen)]]
  			whileTrue: [firstDigitLen := firstDigitLen - 1].
  		secondDigitLen := firstDigitLen].
  	(firstDigitLen < secondDigitLen
  	 or: [firstDigitLen = secondDigitLen
  		 and: [(self unsafeDigitOfLargeInt: firstInteger at: firstDigitLen) < (self unsafeDigitOfLargeInt: secondInteger at: firstDigitLen)]])
  		ifTrue: 
  			[larger := secondInteger.
  			largeDigitLen := secondDigitLen.
  			smaller := firstInteger.
  			smallerDigitLen := firstDigitLen.
  			neg := firstNeg == false]
  		ifFalse: 
  			[larger := firstInteger.
  			largeDigitLen := firstDigitLen.
  			smaller := secondInteger.
  			smallerDigitLen := secondDigitLen.
  			neg := firstNeg].
  	resDigitLen := largeDigitLen.
  	self remapOop: #(smaller larger)
  		in: [res := self createLargeIntegerNeg: neg digitLength: resDigitLen].
  	self
  		cDigitSub: (self pointerToFirstDigitOfLargeInt: smaller)
  		len: smallerDigitLen
  		with: (self pointerToFirstDigitOfLargeInt: larger)
  		len: largeDigitLen
  		into: (self pointerToFirstDigitOfLargeInt: res).
  	^neg 
  		ifTrue: [self normalizeNegative: res]
  		ifFalse: [self normalizePositive: res]!

Item was changed:
  ----- Method: LargeIntegersPlugin>>isNormalized: (in category 'oop functions') -----
+ isNormalized: aLargeInteger 
+ 	| len |
- isNormalized: anInteger 
- 	| len maxVal minVal sLen val class positive |
- 	<var: #val type: #'unsigned long'>
- 	<var: #minVal type: #'unsigned long'>
- 	(interpreterProxy isIntegerObject: anInteger)
- 		ifTrue: [^ true].
- 	class := interpreterProxy fetchClassOf: anInteger.
- 	(positive := class = interpreterProxy classLargePositiveInteger) ifFalse:
- 		[class = interpreterProxy classLargeNegativeInteger ifFalse:
- 			[interpreterProxy primitiveFailFor: PrimErrBadArgument.
- 			 ^false]].
  	"Check for leading zero of LargeInteger"
+ 	len := self byteSizeOfLargeInt: aLargeInteger.
- 	len := self byteSizeOfLargeInt: anInteger.
  	len = 0 ifTrue:
  		[^ false].
+ 	(self unsafeByteOfLargeInt: aLargeInteger at: len) = 0 ifTrue:
- 	(self unsafeByteOfLargeInt: anInteger at: len) = 0 ifTrue:
  		[^ false].
+ 	^true!
- 	"no leading zero, now check if anInteger is in SmallInteger range or not"
- 	sLen := interpreterProxy maxSmallInteger > 16r3FFFFFFF
- 				ifTrue: [8]
- 				ifFalse: [4].
- 	"maximal digitLength of aSmallInteger"
- 	len > sLen ifTrue:
- 		[^ true].
- 	len < sLen ifTrue:
- 		[^ false].
- 	"len = sLen"
- 	^positive
- 		ifTrue: [maxVal := interpreterProxy maxSmallInteger. "SmallInteger maxVal"
- 				"all bytes of maxVal but the highest one are just FF's"
- 				 (self digitOfCSI: anInteger at: sLen // 4)
- 					> (self digitOfCSI: maxVal at: sLen // 4)]
- 		ifFalse: [val := self unsafeDigitOfLargeInt: anInteger at: len // 4.
- 				sLen > 4 ifTrue: [val := val << 32 + (self unsafeDigitOfLargeInt: anInteger at: 1)].
- 				minVal := 0 - interpreterProxy minSmallInteger.
- 				val > minVal]!

Item was changed:
  ----- Method: LargeIntegersPlugin>>normalize: (in category 'oop functions') -----
  normalize: aLargeInteger 
  	"Check for leading zeroes and return shortened copy if so."
  	self debugCode: [self msg: 'normalize: aLargeInteger'].
+ 	(interpreterProxy isLargePositiveIntegerObject: aLargeInteger)
- 	(interpreterProxy fetchClassOf: aLargeInteger)
- 		= interpreterProxy classLargePositiveInteger
  		ifTrue: [^ self normalizePositive: aLargeInteger]
  		ifFalse: [^ self normalizeNegative: aLargeInteger]!

Item was changed:
  ----- Method: LargeIntegersPlugin>>primDigitDiv:negative: (in category 'Integer primitives') -----
  primDigitDiv: secondInteger negative: neg 
  	"Answer the result of dividing firstInteger by secondInteger. 
  	Fail if parameters are not integers, not normalized or secondInteger is 
  	zero. "
  	| firstAsLargeInteger secondAsLargeInteger firstInteger |
  	self debugCode: [self msg: 'primDigitDiv: secondInteger negative: neg'].
  	firstInteger := self
  				primitive: 'primDigitDivNegative'
  				parameters: #(#Integer #Boolean )
  				receiver: #Integer.
- 	"Avoid crashes in case of getting unnormalized args."
- 	(self isNormalized: firstInteger)
- 		ifFalse: [self
- 				debugCode: [self msg: 'ERROR in primDigitDiv: secondInteger negative: neg'.
- 					self msg: '------> receiver *not* normalized!!'].
- 			^ interpreterProxy primitiveFail].
- 	(self isNormalized: secondInteger)
- 		ifFalse: [self
- 				debugCode: [self msg: 'ERROR in primDigitDiv: secondInteger negative: neg'.
- 					self msg: '------> argument *not* normalized!!'].
- 			^ interpreterProxy primitiveFail].
  	"Coerce SmallIntegers to corresponding (not normalized) large integers  
  	and check for zerodivide."
  	(interpreterProxy isIntegerObject: firstInteger)
  		ifTrue: ["convert to LargeInteger"
  			self
  				remapOop: secondInteger
  				in: [firstAsLargeInteger := self createLargeFromSmallInteger: firstInteger]]
+ 		ifFalse:
+ 			["Avoid crashes in case of getting unnormalized args."
+ 			(self isNormalized: firstInteger)
+ 				ifFalse:
+ 					[self debugCode:
+ 						[self msg: 'ERROR in primDigitDiv: secondInteger negative: neg'.
+ 						self msg: '------> receiver *not* normalized!!'].
+ 					^ interpreterProxy primitiveFail].
+ 			firstAsLargeInteger := firstInteger].
- 		ifFalse: [firstAsLargeInteger := firstInteger].
  	(interpreterProxy isIntegerObject: secondInteger)
  		ifTrue: ["check for zerodivide and convert to LargeInteger"
  			(interpreterProxy integerValueOf: secondInteger)
  					= 0
  				ifTrue: [^ interpreterProxy primitiveFail].
  			self
  				remapOop: firstAsLargeInteger
  				in: [secondAsLargeInteger := self createLargeFromSmallInteger: secondInteger]]
+ 		ifFalse:
+ 			["Avoid crashes in case of getting unnormalized args."
+ 			(self isNormalized: secondInteger)
+ 				ifFalse:
+ 					[self debugCode:
+ 						[self msg: 'ERROR in primDigitDiv: secondInteger negative: neg'.
+ 						self msg: '------> argument *not* normalized!!'].
+ 					^ interpreterProxy primitiveFail].
+ 			secondAsLargeInteger := secondInteger].
- 		ifFalse: [secondAsLargeInteger := secondInteger].
  	^ self
  		digitDivLarge: firstAsLargeInteger
  		with: secondAsLargeInteger
  		negative: neg!

Item was added:
+ ----- Method: LargeNegativeInteger class>>ccg:prolog:expr:index: (in category '*VMMaker-plugin generation') -----
+ ccg: cg prolog: aBlock expr: aString index: anInteger
+ 
+ 	^cg ccgLoad: aBlock expr: aString asMemberOfLargeNegativeIntegerFrom: anInteger!

Item was added:
+ ----- Method: LargePositiveInteger class>>ccg:prolog:expr:index: (in category '*VMMaker-plugin generation') -----
+ ccg: cg prolog: aBlock expr: aString index: anInteger
+ 
+ 	^cg ccgLoad: aBlock expr: aString asMemberOfLargePositiveIntegerFrom: anInteger!

Item was added:
+ ----- Method: NewCoObjectMemorySimulator>>isKindOfInteger: (in category 'simulation only') -----
+ isKindOfInteger: offset
+ 	^coInterpreter isKindOfInteger: offset!

Item was added:
+ ----- Method: NewCoObjectMemorySimulator>>isLargeIntegerObject: (in category 'simulation only') -----
+ isLargeIntegerObject: offset
+ 	^coInterpreter isLargeIntegerObject: offset!

Item was added:
+ ----- Method: NewCoObjectMemorySimulator>>isLargeNegativeIntegerObject: (in category 'simulation only') -----
+ isLargeNegativeIntegerObject: offset
+ 	^coInterpreter isLargeNegativeIntegerObject: offset!

Item was added:
+ ----- Method: NewCoObjectMemorySimulator>>isLargePositiveIntegerObject: (in category 'simulation only') -----
+ isLargePositiveIntegerObject: offset
+ 	^coInterpreter isLargePositiveIntegerObject: offset!

Item was added:
+ ----- Method: NewObjectMemorySimulator>>isKindOfInteger: (in category 'simulation only') -----
+ isKindOfInteger: offset
+ 	^coInterpreter isKindOfInteger: offset!

Item was added:
+ ----- Method: NewObjectMemorySimulator>>isLargeIntegerObject: (in category 'simulation only') -----
+ isLargeIntegerObject: offset
+ 	^coInterpreter isLargeIntegerObject: offset!

Item was added:
+ ----- Method: NewObjectMemorySimulator>>isLargeNegativeIntegerObject: (in category 'simulation only') -----
+ isLargeNegativeIntegerObject: offset
+ 	^coInterpreter isLargeNegativeIntegerObject: offset!

Item was added:
+ ----- Method: NewObjectMemorySimulator>>isLargePositiveIntegerObject: (in category 'simulation only') -----
+ isLargePositiveIntegerObject: offset
+ 	^coInterpreter isLargePositiveIntegerObject: offset!

Item was changed:
  ----- Method: ObjectMemory>>cCoerceSimple:to: (in category 'simulation support') -----
  cCoerceSimple: value to: cTypeString
  	<doNotGenerate>
  	^cTypeString caseOf:
+ 	   {	[#'char *']			->	[value].
+ 		[#'unsigned int']	->	[value]. }!
- 	   {	[#'char *']	->	[value] }!

Item was added:
+ ----- Method: ObjectMemory>>isInstanceOfClassLargeNegativeInteger: (in category 'interpreter access') -----
+ isInstanceOfClassLargeNegativeInteger: oop
+ 	<inline: true>
+ 	"N.B.  Because Slang always inlines is:instanceOf:compactClassIndex:
+ 	 (because is:instanceOf:compactClassIndex: has an inline: pragma) the
+ 	 phrase (objectMemory splObj: ClassLargeNegativeInteger) is expanded
+ 	 in-place and is _not_ evaluated if oop has a non-zero CompactClassIndex."
+ 	^self
+ 		is: oop
+ 		instanceOf: (self splObj: ClassLargeNegativeInteger) 
+ 		compactClassIndex: ClassLargeNegativeIntegerCompactIndex!

Item was added:
+ ----- Method: ObjectMemory>>isInstanceOfClassLargePositiveInteger: (in category 'interpreter access') -----
+ isInstanceOfClassLargePositiveInteger: oop
+ 	<inline: true>
+ 	"N.B.  Because Slang always inlines is:instanceOf:compactClassIndex:
+ 	 (because is:instanceOf:compactClassIndex: has an inline: pragma) the
+ 	 phrase (objectMemory splObj: ClassLargePositiveInteger) is expanded
+ 	 in-place and is _not_ evaluated if oop has a non-zero CompactClassIndex."
+ 	^self
+ 		is: oop
+ 		instanceOf: (self splObj: ClassLargePositiveInteger) 
+ 		compactClassIndex: ClassLargePositiveIntegerCompactIndex!

Item was added:
+ ----- Method: ObjectMemory>>isLargeIntegerInstance: (in category 'interpreter access') -----
+ isLargeIntegerInstance: oop
+ 	<inline: true>
+ 	^(self isInstanceOfClassLargePositiveInteger: oop)
+ 		or: [self isInstanceOfClassLargeNegativeInteger: oop]!

Item was added:
+ ----- Method: SmartSyntaxPluginCodeGenerator>>ccgLoad:expr:asKindOfIntegerFrom: (in category 'coercing') -----
+ ccgLoad: aBlock expr: aString asKindOfIntegerFrom: anInteger 
+ 
+ 	^String streamContents: [:aStream | aStream
+ 		nextPutAll: 'interpreterProxy success: (interpreterProxy isKindOfInteger: (interpreterProxy stackValue: ';
+ 		nextPutAll: anInteger asString;
+ 		nextPutAll: ')).';
+ 		crtab;
+ 		nextPutAll: (self 
+ 						ccgLoad: aBlock 
+ 						expr: aString 
+ 						asRawOopFrom: anInteger)]!

Item was added:
+ ----- Method: SmartSyntaxPluginCodeGenerator>>ccgLoad:expr:asMemberOfLargeNegativeIntegerFrom: (in category 'coercing') -----
+ ccgLoad: aBlock expr: aString asMemberOfLargeNegativeIntegerFrom: anInteger 
+ 
+ 	^String streamContents: [:aStream | aStream
+ 		nextPutAll: 'interpreterProxy success: (interpreterProxy isLargeNegativeIntegerObject: (interpreterProxy stackValue: ';
+ 		nextPutAll: anInteger asString;
+ 		nextPutAll: ')).';
+ 		crtab;
+ 		nextPutAll: (self 
+ 						ccgLoad: aBlock 
+ 						expr: aString 
+ 						asRawOopFrom: anInteger)]!

Item was added:
+ ----- Method: SmartSyntaxPluginCodeGenerator>>ccgLoad:expr:asMemberOfLargePositiveIntegerFrom: (in category 'coercing') -----
+ ccgLoad: aBlock expr: aString asMemberOfLargePositiveIntegerFrom: anInteger 
+ 
+ 	^String streamContents: [:aStream | aStream
+ 		nextPutAll: 'interpreterProxy success: (interpreterProxy isLargePositiveIntegerObject: (interpreterProxy stackValue: ';
+ 		nextPutAll: anInteger asString;
+ 		nextPutAll: ')).';
+ 		crtab;
+ 		nextPutAll: (self 
+ 						ccgLoad: aBlock 
+ 						expr: aString 
+ 						asRawOopFrom: anInteger)]!

Item was added:
+ ----- Method: SmartSyntaxPluginSimulator>>ccgLoad:expr:asKindOfIntegerFrom: (in category 'simulation') -----
+ ccgLoad: forProlog expr: failBlock asKindOfIntegerFrom: argIndexOrNil 
+ 	^[:oop|
+ 	   interpreterProxy success: (interpreterProxy isKindOfInteger: oop).
+ 	   oop]!

Item was added:
+ ----- Method: SmartSyntaxPluginSimulator>>ccgLoad:expr:asMemberOfLargeNegativeIntegerFrom: (in category 'simulation') -----
+ ccgLoad: forProlog expr: failBlock asMemberOfLargeNegativeIntegerFrom: argIndexOrNil 
+ 	^[:oop|
+ 	   interpreterProxy success: (interpreterProxy isLargeNegativeIntegerObject: oop).
+ 	   oop]!

Item was added:
+ ----- Method: SmartSyntaxPluginSimulator>>ccgLoad:expr:asMemberOfLargePositiveIntegerFrom: (in category 'simulation') -----
+ ccgLoad: forProlog expr: failBlock asMemberOfLargePositiveIntegerFrom: argIndexOrNil 
+ 	^[:oop|
+ 	   interpreterProxy success: (interpreterProxy isLargePositiveIntegerObject: oop).
+ 	   oop]!

Item was added:
+ ----- Method: SpurMemoryManager>>isInstanceOfClassLargeNegativeInteger: (in category 'interpreter access') -----
+ isInstanceOfClassLargeNegativeInteger: oop
+ 	"Answer if the oop is a large negative integer instance."
+ 	^(self isNonImmediate: oop) and: [(self classIndexOf: oop) = ClassLargeNegativeIntegerCompactIndex]!

Item was added:
+ ----- Method: SpurMemoryManager>>isInstanceOfClassLargePositiveInteger: (in category 'interpreter access') -----
+ isInstanceOfClassLargePositiveInteger: oop
+ 	"Answer if the oop is a large positive integer instance."
+ 	^(self isNonImmediate: oop) and: [(self classIndexOf: oop) = ClassLargePositiveIntegerCompactIndex]!

Item was added:
+ ----- Method: SpurMemoryManager>>isKindOfInteger: (in category 'simulation only') -----
+ isKindOfInteger: oop
+ 	<doNotGenerate>
+ 	^coInterpreter isKindOfInteger: oop!

Item was added:
+ ----- Method: SpurMemoryManager>>isLargeIntegerInstance: (in category 'interpreter access') -----
+ isLargeIntegerInstance: oop
+ 	"Answer if the oop is a large positive or negative integer instance."
+ 	^(self isNonImmediate: oop) and: [((self classIndexOf: oop) - ClassLargeNegativeIntegerCompactIndex) asUnsignedInteger <= 1]!

Item was added:
+ ----- Method: SpurMemoryManager>>isLargeNegativeIntegerObject: (in category 'simulation only') -----
+ isLargeNegativeIntegerObject: oop
+ 	<doNotGenerate>
+ 	^coInterpreter isLargeNegativeIntegerObject: oop!

Item was added:
+ ----- Method: SpurMemoryManager>>isLargePositiveIntegerObject: (in category 'simulation only') -----
+ isLargePositiveIntegerObject: oop
+ 	<doNotGenerate>
+ 	^coInterpreter isLargePositiveIntegerObject: oop!

Item was added:
+ ----- Method: StackInterpreter>>isKindOfInteger: (in category 'internal interpreter access') -----
+ isKindOfInteger: oop
+ 	"Answer true if the oop is kind of Integer (Small or Large)."
+ 	<api>
+ 	<inline: true>
+ 	^(objectMemory isIntegerObject: oop)
+ 		or: [objectMemory isLargeIntegerInstance: oop]!

Item was added:
+ ----- Method: StackInterpreter>>isLargeIntegerObject: (in category 'internal interpreter access') -----
+ isLargeIntegerObject: oop
+ 	<api>
+ 	<inline: true>
+ 	^objectMemory isLargeIntegerInstance: oop!

Item was added:
+ ----- Method: StackInterpreter>>isLargeNegativeIntegerObject: (in category 'internal interpreter access') -----
+ isLargeNegativeIntegerObject: oop
+ 	<api>
+ 	<inline: true>
+ 	^objectMemory isInstanceOfClassLargeNegativeInteger: oop!

Item was added:
+ ----- Method: StackInterpreter>>isLargePositiveIntegerObject: (in category 'internal interpreter access') -----
+ isLargePositiveIntegerObject: oop
+ 	<api>
+ 	<inline: true>
+ 	^objectMemory isInstanceOfClassLargePositiveInteger: oop!

Item was changed:
  ----- Method: StackInterpreter>>printStringOf: (in category 'debug printing') -----
  printStringOf: oop
  	| fmt len cnt max i |
  	<inline: false>
  	(objectMemory isImmediate: oop) ifTrue:
  		[^self].
  	(objectMemory addressCouldBeObj: oop) ifFalse:
  		[^self].
  	fmt := objectMemory formatOf: oop.
  	fmt < objectMemory firstByteFormat ifTrue: [^self].
  
  	cnt := (max := 128) min: (len := objectMemory lengthOf: oop).
  	i := 0.
  
  	((objectMemory is: oop
  		  instanceOf: (objectMemory splObj: ClassByteArray)
  		  compactClassIndex: classByteArrayCompactIndex)
+ 	or: [(objectMemory isLargeIntegerInstance: oop)])
- 	or: [(self isInstanceOfClassLargePositiveInteger: oop)
- 	or: [(self isInstanceOfClassLargeNegativeInteger: oop)]])
  		ifTrue:
  			[[i < cnt] whileTrue:
  				[self printHex: (objectMemory fetchByte: i ofObject: oop).
  				 i := i + 1]]
  		ifFalse:
  			[[i < cnt] whileTrue:
  				[self cCode:
  						[(objectMemory fetchByte: i ofObject: oop) = 13 "Character cr asInteger" ifTrue:
  							[self print: '<CR>'.
  							 i + 1 < len ifTrue:
  								[self print: '...'].
  							 ^self]].
  				 self printChar: (objectMemory fetchByte: i ofObject: oop).
  				 i := i + 1]].
  	len > max ifTrue:
  		[self print: '...'].
  	self flush!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>ffiIntegerValueOf: (in category 'callout support') -----
  ffiIntegerValueOf: oop
  	"Support for generic callout. Answer an integer value that is coerced as C would do."
  	<inline: true>
  	"Cheat with a tag test"
  	(oop anyMask: BytesPerWord - 1)
  		ifTrue:
  			[(interpreterProxy isIntegerObject: oop) ifTrue:
  				[^interpreterProxy integerValueOf: oop].
  			self cppIf: SPURVM
  				ifTrue:
  					[(interpreterProxy isCharacterObject: oop) ifTrue: "Immediate in Spur"
  						[^interpreterProxy characterValueOf: oop].
  					 (interpreterProxy isFloatObject: oop) ifTrue: "Immediate in 64-bit Spur"
  						[^interpreterProxy floatValueOf: oop]]]
  		ifFalse:
  			[self cppIf: SPURVM
  				ifTrue: "No non-immediate characters in Spur"
  					[]
  				ifFalse:
  					[(interpreterProxy isCharacterObject: oop) ifTrue:
  						[^interpreterProxy characterValueOf: oop]].
  			 (interpreterProxy isFloatObject: oop) ifTrue:
  				[^interpreterProxy floatValueOf: oop].
  			 oop = interpreterProxy nilObject ifTrue: [^0]. "@@: should we really allow this????"
  			 oop = interpreterProxy falseObject ifTrue: [^0].
  			 oop = interpreterProxy trueObject ifTrue: [^1].
+ 			 (interpreterProxy isLargePositiveIntegerObject: oop) ifTrue:
- 			 (interpreterProxy fetchClassOf: oop) = interpreterProxy classLargePositiveInteger ifTrue:
  				[self cppIf: BytesPerWord = 8 "Use cppIf: to get the return type of the function right.  Should be sqInt on 32-bits."
  					ifTrue: [^interpreterProxy positive64BitValueOf: oop]
  					ifFalse: [^interpreterProxy positive32BitValueOf: oop]]].
  	^interpreterProxy signedMachineIntegerValueOf: oop "<- will fail if not integer"!



More information about the Vm-dev mailing list