[Vm-dev] VM Maker: Cog-eem.276.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Sep 15 23:17:51 UTC 2015


Eliot Miranda uploaded a new version of Cog to project VM Maker:
http://source.squeak.org/VMMaker/Cog-eem.276.mcz

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

Name: Cog-eem.276
Author: eem
Time: 15 September 2015, 4:17:10.249 pm
UUID: 275e1449-aee4-4bc6-9cb9-ebd2448d3dd7
Ancestors: Cog-eem.275

Eliminate some compiler warnings in the generated processor plugins.  Don't use self cCode: 'memcpy(...' when mem:cp:y: is available.

=============== Diff against Cog-eem.275 ===============

Item was changed:
  ----- Method: BochsPlugin>>forceStopOnInterrupt (in category 'interruption') -----
  forceStopOnInterrupt
+ 	<returnTypeC: #void>
  	interpreterProxy getInterruptPending ifTrue:
  		[self forceStopRunning]!

Item was changed:
  ----- Method: BochsPlugin>>primitiveDisassembleAt:InMemory: (in category 'primitives') -----
  "cpuAlien <BochsIA32|X86Alien>" primitiveDisassembleAt: address "<Integer>" InMemory: memory "<Bitmap|ByteArray|WordArray>"
  	"Return an Array of the instruction length and its decompilation as a string for the instruction at address in memory."
  	| cpuAlien cpu instrLenOrErr resultObj log logLen logObj logObjData |
  	<var: #cpu type: #'void *'>
+ 	<var: #log type: #'char *'>
+ 	<var: #logLen type: #long>
+ 	<var: #logObjData type: #'char *'>
  	cpuAlien := self primitive: #primitiveDisassembleAtInMemory
  					parameters: #(Unsigned WordsOrBytes)
  					receiver: #Oop.
+ 	(cpu := self cCoerceSimple: (self startOfData: cpuAlien) to: #'void *') = 0 ifTrue:
- 	(cpu := self startOfData: cpuAlien) = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
  	instrLenOrErr := self disassembleFor: cpu
  						At: address
  						In: memory
  						Size: (interpreterProxy byteSizeOf: memory cPtrAsOop).
  	instrLenOrErr < 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrInappropriate].
  	log := self getlog: (self cCode: [self addressOf: logLen] inSmalltalk: [logLen := 0]).
  	resultObj := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2.
  	resultObj = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  
  	"Easier keeping the damn thing on the stack than using pushRemappableOop:/popRemappableOop.
  	 Where is topRemappableOop when you need it?"
  	interpreterProxy pushRemappableOop: resultObj.
  	logObj := interpreterProxy
  				instantiateClass: interpreterProxy classString
  				indexableSize: logLen.
  	interpreterProxy failed ifTrue:
  		[interpreterProxy popRemappableOop.
  		 ^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  	logObjData := interpreterProxy arrayValueOf: logObj.
+ 	self mem: logObjData cp: log y: logLen.
- 	self cCode: 'memcpy(logObjData, log, logLen)' inSmalltalk: [logObjData. log].
  	resultObj := interpreterProxy popRemappableOop.
  	interpreterProxy
  		storePointer: 0
  		ofObject: resultObj
  		withValue: (interpreterProxy integerObjectOf: instrLenOrErr).
  	interpreterProxy storePointer: 1 ofObject: resultObj withValue: logObj.
  
  	^resultObj!

Item was changed:
  ----- Method: BochsPlugin>>primitiveErrorAndLog (in category 'primitives') -----
  primitiveErrorAndLog
  	| log logLen resultObj logObj logObjData |
  	<var: #log type: #'char *'>
+ 	<var: #logLen type: #long>
  	<var: #logObjData type: #'char *'>
  	self primitive: #primitiveErrorAndLog parameters: #().
  
  	log := self getlog: (self cCode: [self addressOf: logLen] inSmalltalk: [logLen := 0]).
  	resultObj := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2.
  	resultObj = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  
  	interpreterProxy
  		storePointer: 0
  		ofObject: resultObj
  		withValue: (interpreterProxy integerObjectOf: self errorAcorn).
  
  	logLen > 0 ifTrue:
  		[interpreterProxy pushRemappableOop: resultObj.
  		logObj := interpreterProxy
  					instantiateClass: interpreterProxy classString
  					indexableSize: logLen.
  		interpreterProxy failed ifTrue:
  			[interpreterProxy popRemappableOop.
  			 ^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  
  		resultObj := interpreterProxy popRemappableOop.
  		logObjData := interpreterProxy arrayValueOf: logObj.
+ 		self mem: logObjData cp: log y: logLen.
- 		self cCode: 'memcpy(logObjData, log, logLen)' inSmalltalk: [logObjData. log].
  		interpreterProxy storePointer: 1 ofObject: resultObj withValue: logObj].
  	interpreterProxy pop: 1 thenPush: resultObj!

Item was changed:
  ----- Method: BochsPlugin>>primitiveFlushICacheFrom:To: (in category 'primitives') -----
  "cpuAlien <BochsIA32|X86Alien>" primitiveFlushICacheFrom: startAddress "<Integer>" To: endAddress "<Integer>"
  	"Flush the icache in the requested range"
  	| cpuAlien cpu |
+ 	<var: #cpu type: #'void *'>
- 	<var: #cpu type: 'void *'>
  	cpuAlien := self primitive: #primitiveFlushICacheFromTo
  					parameters: #(Unsigned Unsigned)
  					receiver: #Oop.
+ 	(cpu := self cCoerceSimple: (self startOfData: cpuAlien) to: #'void *') = 0 ifTrue:
- 	(cpu := self startOfData: cpuAlien) = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
  	self flushICache: cpu From: startAddress To: endAddress!

Item was changed:
  ----- Method: BochsPlugin>>primitiveNewCPU (in category 'primitives') -----
  primitiveNewCPU
  	| cpu |
+ 	<var: #cpu type: #'void *'>
- 	<var: #cpu type: 'void *'>
  	self primitive: #primitiveNewCPU parameters: #().
  
+ 	cpu := self newCPU.
- 	cpu := self cCode: 'newCPU()' inSmalltalk: [0].
  	cpu = 0 ifTrue:
  		[^interpreterProxy primitiveFail].
  	interpreterProxy
  		pop: 1
  		thenPush: (interpreterProxy positiveMachineIntegerFor:
  										(self cCoerceSimple: cpu
  											to: 'unsigned long'))!

Item was changed:
  ----- Method: BochsPlugin>>primitiveResetCPU (in category 'primitives') -----
  primitiveResetCPU
  	| cpuAlien cpu maybeErr |
+ 	<var: #cpu type: #'void *'>
- 	<var: #cpu type: 'void *'>
  	cpuAlien := self primitive: #primitiveResetCPU parameters: #() receiver: #Oop.
+ 	(cpu := self cCoerceSimple: (self startOfData: cpuAlien) to: #'void *') = 0 ifTrue:
- 	(cpu := self startOfData: cpuAlien) = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
  	maybeErr := self resetCPU: cpu.
  	maybeErr ~= 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrInappropriate].
  	^cpuAlien!

Item was changed:
  ----- Method: BochsPlugin>>primitiveRunInMemory:minimumAddress:maximumAddress:readOnlyBelow: (in category 'primitives') -----
  "cpuAlien <BochsIA32|X86Alien>" primitiveRunInMemory: memory "<Bitmap|ByteArray|WordArray>" minimumAddress: minAddress "<Integer>" maximumAddress: maxAddress "<Integer>" readOnlyBelow: minWriteMaxExecAddress "<Integer>"
  	"Run the cpu using the first argument as the memory and the following arguments defining valid addresses, running until it halts or hits an exception."
  	| cpuAlien cpu memorySize maybeErr |
  	<var: #cpu type: #'void *'>
  	cpuAlien := self primitive: #primitiveRunInMemoryMinAddressMaxAddressReadWrite
  					parameters: #(WordsOrBytes Unsigned Unsigned Unsigned)
  					receiver: #Oop.
+ 	(cpu := self cCoerceSimple: (self startOfData: cpuAlien) to: #'void *') = 0 ifTrue:
- 	(cpu := self startOfData: cpuAlien) = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
  	prevInterruptCheckChain := interpreterProxy setInterruptCheckChain: #forceStopOnInterrupt asSymbol.
  	prevInterruptCheckChain = #forceStopOnInterrupt asSymbol ifTrue:
  		[prevInterruptCheckChain = 0].
  	memorySize := interpreterProxy byteSizeOf: memory cPtrAsOop.
  	maybeErr := self runCPU: cpu
  					In: memory
  					Size: (memorySize min: maxAddress)
  					MinAddressRead: minAddress
  					Write: minWriteMaxExecAddress.
  	interpreterProxy setInterruptCheckChain: prevInterruptCheckChain.
  	maybeErr ~= 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrInappropriate].
  	^cpuAlien!

Item was changed:
  ----- Method: BochsPlugin>>primitiveRunInMemory:minimumAddress:readOnlyBelow: (in category 'primitives') -----
  "cpuAlien <BochsIA32|X86Alien>" primitiveRunInMemory: memory "<Bitmap|ByteArray|WordArray>" minimumAddress: minAddress "<Integer>" readOnlyBelow: minWriteMaxExecAddress "<Integer>"
  	"Run the cpu using the first argument as the memory and the following arguments defining valid addresses, running until it halts or hits an exception."
  	| cpuAlien cpu maybeErr |
  	<var: #cpu type: #'void *'>
  	cpuAlien := self primitive: #primitiveRunInMemoryMinimumAddressReadWrite
  					parameters: #(WordsOrBytes Unsigned Unsigned)
  					receiver: #Oop.
+ 	(cpu := self cCoerceSimple: (self startOfData: cpuAlien) to: #'void *') = 0 ifTrue:
- 	(cpu := self startOfData: cpuAlien) = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
  	prevInterruptCheckChain := interpreterProxy setInterruptCheckChain: #forceStopOnInterrupt asSymbol.
  	prevInterruptCheckChain = #forceStopOnInterrupt asSymbol ifTrue:
  		[prevInterruptCheckChain = 0].
  	maybeErr := self runCPU: cpu
  					In: memory
  					Size: (interpreterProxy byteSizeOf: memory cPtrAsOop)
  					MinAddressRead: minAddress
  					Write: minWriteMaxExecAddress.
  	interpreterProxy setInterruptCheckChain: prevInterruptCheckChain.
  	maybeErr ~= 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrInappropriate].
  	^cpuAlien!

Item was changed:
  ----- Method: BochsPlugin>>primitiveSingleStepInMemory:minimumAddress:maximumAddress:readOnlyBelow: (in category 'primitives') -----
  "cpuAlien <BochsIA32|X86Alien>" primitiveSingleStepInMemory: memory "<Bitmap|ByteArray|WordArray>" minimumAddress: minAddress "<Integer>" maximumAddress: maxAddress "<Integer>" readOnlyBelow: minWriteMaxExecAddress "<Integer>"
  	"Single-step the cpu using the first argument as the memory and the following arguments defining valid addresses."
  	| cpuAlien cpu memorySize maybeErr |
  	<var: #cpu type: #'void *'>
  	cpuAlien := self primitive: #primitiveSingleStepInMemoryMinAddressMaxAddressReadWrite
  					parameters: #(WordsOrBytes Unsigned Unsigned Unsigned)
  					receiver: #Oop.
+ 	(cpu := self cCoerceSimple: (self startOfData: cpuAlien) to: #'void *') = 0 ifTrue:
- 	(cpu := self startOfData: cpuAlien) = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
  	memorySize := interpreterProxy byteSizeOf: memory cPtrAsOop.
  	maybeErr := self singleStepCPU: cpu
  					In: memory
  					Size: (memorySize min: maxAddress)
  					MinAddressRead: minAddress
  					Write: minWriteMaxExecAddress.
  	maybeErr ~= 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrInappropriate].
  	^cpuAlien!

Item was changed:
  ----- Method: BochsPlugin>>primitiveSingleStepInMemory:minimumAddress:readOnlyBelow: (in category 'primitives') -----
  "cpuAlien <BochsIA32|X86Alien>" primitiveSingleStepInMemory: memory "<Bitmap|ByteArray|WordArray>" minimumAddress: minAddress "<Integer>"  readOnlyBelow: minWriteMaxExecAddress "<Integer>"
  	"Single-step the cpu using the first argument as the memory and the following arguments defining valid addresses."
  	| cpuAlien cpu maybeErr |
  	<var: #cpu type: #'void *'>
  	cpuAlien := self primitive: #primitiveSingleStepInMemoryMinimumAddressReadWrite
  					parameters: #(WordsOrBytes Unsigned Unsigned)
  					receiver: #Oop.
+ 	(cpu := self cCoerceSimple: (self startOfData: cpuAlien) to: #'void *') = 0 ifTrue:
- 	(cpu := self startOfData: cpuAlien) = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
  	maybeErr := self singleStepCPU: cpu
  					In: memory
  					Size: (interpreterProxy byteSizeOf: memory cPtrAsOop)
  					MinAddressRead: minAddress
  					Write: minWriteMaxExecAddress.
  	maybeErr ~= 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrInappropriate].
  	^cpuAlien!

Item was changed:
  ----- Method: GdbARMPlugin>>forceStopOnInterrupt (in category 'interruption') -----
  forceStopOnInterrupt
+ 	<returnTypeC: #void>
  	interpreterProxy getInterruptPending ifTrue:
  		[self forceStopRunning]!

Item was changed:
  ----- Method: GdbARMPlugin>>primitiveDisassembleAt:InMemory: (in category 'primitives') -----
  "cpuAlien <GdbARMAlien>" primitiveDisassembleAt: address "<Integer>" InMemory: memory "<Bitmap|ByteArray|WordArray>"
  	"Return an Array of the instruction length and its decompilation as a string for the instruction at address in memory."
  	| cpuAlien cpu instrLenOrErr resultObj log logLen logObj logObjData |
  	<var: #cpu type: #'void *'>
  	cpuAlien := self primitive: #primitiveDisassembleAtInMemory
  					parameters: #(Unsigned WordsOrBytes)
  					receiver: #Oop.
  	(cpu := self startOfData: cpuAlien) = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
  	instrLenOrErr := self disassembleFor: cpu
  						At: address
  						In: memory
  						Size: (interpreterProxy byteSizeOf: memory cPtrAsOop).
  	instrLenOrErr < 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrInappropriate].
  	log := self getlog: (self cCode: [self addressOf: logLen] inSmalltalk: [logLen := 0]).
  	resultObj := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2.
  	resultObj = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  
  	"Easier keeping the damn thing on the stack than using pushRemappableOop:/popRemappableOop.
  	 Where is topRemappableOop when you need it?"
  	interpreterProxy pushRemappableOop: resultObj.
  	logObj := interpreterProxy
  				instantiateClass: interpreterProxy classString
  				indexableSize: logLen.
  	interpreterProxy failed ifTrue:
  		[interpreterProxy popRemappableOop.
  		 ^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  	logObjData := interpreterProxy arrayValueOf: logObj.
+ 	self mem: logObjData cp: log y: logLen.
- 	self cCode: 'memcpy(logObjData, log, logLen)' inSmalltalk: [logObjData. log].
  	resultObj := interpreterProxy popRemappableOop.
  	interpreterProxy
  		storePointer: 0
  		ofObject: resultObj
  		withValue: (interpreterProxy integerObjectOf: instrLenOrErr).
  	interpreterProxy storePointer: 1 ofObject: resultObj withValue: logObj.
  
  	^resultObj!

Item was changed:
  ----- Method: GdbARMPlugin>>primitiveErrorAndLog (in category 'primitives') -----
  primitiveErrorAndLog
  	| log logLen resultObj logObj logObjData |
  	<var: #log type: #'char *'>
  	<var: #logObjData type: #'char *'>
  	self primitive: #primitiveErrorAndLog parameters: #().
  
  	log := self getlog: (self cCode: [self addressOf: logLen] inSmalltalk: [logLen := 0]).
  	resultObj := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 2.
  	resultObj = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  
  	interpreterProxy
  		storePointer: 0
  		ofObject: resultObj
  		withValue: (interpreterProxy integerObjectOf: self errorAcorn).
  
  	logLen > 0 ifTrue:
  		[interpreterProxy pushRemappableOop: resultObj.
  		logObj := interpreterProxy
  					instantiateClass: interpreterProxy classString
  					indexableSize: logLen.
  		interpreterProxy failed ifTrue:
  			[interpreterProxy popRemappableOop.
  			 ^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  
  		resultObj := interpreterProxy popRemappableOop.
  		logObjData := interpreterProxy arrayValueOf: logObj.
+ 		self mem: logObjData cp: log y: logLen.
- 		self cCode: 'memcpy(logObjData, log, logLen)' inSmalltalk: [logObjData. log].
  		interpreterProxy storePointer: 1 ofObject: resultObj withValue: logObj].
  	interpreterProxy pop: 1 thenPush: resultObj!



More information about the Vm-dev mailing list