[Vm-dev] VM Maker: VMMaker.oscog-eem.1417.mcz

[commits at source.squeak.org]

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

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

Name: VMMaker.oscog-eem.1417
Author: eem
Time: 14 July 2015, 3:14:42.397 pm
UUID: 5220753e-35a2-46e9-89ad-f7e65d93073b
Ancestors: VMMaker.oscog-tpr.1416

Change the type of the event buffer from int[8] to long[8].  Provide simulation support for accessing it in the object memories.  Fix a slip in ioGetNextEvent:

=============== Diff against VMMaker.oscog-tpr.1416 ===============

Item was changed:
+ ----- Method: CogARMCompiler>>initialize (in category 'generate machine code') -----
- ----- Method: CogARMCompiler>>initialize (in category 'initialization') -----
  initialize
+ 	"This method intializes the Smalltalk instance.  The C instance is merely a struct and doesn't need initialization."
- 	"This method intializes the Smalltalk instance. The C instance is
- 	merely a struct and doesn't need initialization."
  	<doNotGenerate>
+ 	operands := CArrayAccessor on: (Array new: NumOperands).
+ 	machineCode := CArrayAccessor on: (Array new: self machineCodeWords)!
- 	operands := CArrayAccessor
- 				on: (Array new: NumOperands).
- 	machineCode := CArrayAccessor
- 				on: (Array new: self machineCodeWords)
- !

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveGetNextEvent (in category 'I/O primitives') -----
  primitiveGetNextEvent
  	"Primitive. Return the next input event from the VM event queue."
  	| evtBuf arg value eventTypeIs |
+ 	<var: #evtBuf declareC:'long evtBuf[8] = { 0, 0, 0, 0, 0, 0, 0, 0 }'>
+ 	self cCode: [] inSmalltalk: [evtBuf := objectMemory newInputEventAccessorOfSize: 8].
- 	<var: #evtBuf declareC:'int evtBuf[8] = { 0, 0, 0, 0, 0, 0, 0, 0 }'>
- 	self cCode:'' inSmalltalk:[evtBuf := CArrayAccessor on: (IntegerArray new: 8)].
  	arg := self stackTop.
+ 	((objectMemory isArray: arg) and:[(objectMemory slotSizeOf: arg) = 8]) ifFalse:
+ 		[^self primitiveFailFor: PrimErrBadArgument].
- 	((objectMemory isArray: arg) and:[(objectMemory slotSizeOf: arg) = 8])  ifFalse:[^self primitiveFail].
  
  	self ioGetNextEvent: (self cCoerce: evtBuf to: 'sqInputEvent*').
+ 	self successful ifFalse:
+ 		[^nil].
- 	self successful ifFalse:[^nil].
  
  	"Event type"
  	eventTypeIs := evtBuf at: 0.
  	self storeInteger: 0 ofObject: arg withValue: (evtBuf at: 0).
+ 	self successful ifFalse:
+ 		[^nil].
- 	self successful ifFalse:[^nil].
  
- 	"Event is Complex, assume evtBuf is populated correctly and return"
  	eventTypeIs = 6 
+ 		ifTrue: "Event is Complex, assume evtBuf is populated correctly and return"
+ 			[1 to: 7 do: [:i |
- 		ifTrue: [ 
- 			1 to: 7 do: [:i |
  				value := evtBuf at: i.
  				self storePointer: i ofObject: arg withValue: value]]
+ 		ifFalse:
+ 			["Event time stamp"
+ 			self storeInteger: 1 ofObject: arg withValue: ((evtBuf at: 1) bitAnd: MillisecondClockMask).
+ 			self successful ifFalse:
+ 				[^nil].	
- 	ifFalse: [
- 		"Event time stamp"
- 		self storeInteger: 1 ofObject: arg withValue: ((evtBuf at: 1) bitAnd: MillisecondClockMask).
- 		self successful ifFalse:[^nil].	
  
+ 			"Event arguments"
+ 			2 to: 7 do:[:i|
+ 				value := evtBuf at: i.
+ 				(objectMemory isIntegerValue: value)
+ 					ifTrue:[self storeInteger: i ofObject: arg withValue: value]
+ 					ifFalse:
+ 						[value := self positiveMachineIntegerFor: value.
+ 						objectMemory storePointer: i ofObject: arg withValue: value]]].
- 		"Event arguments"
- 		2 to: 7 do:[:i|
- 			value := evtBuf at: i.
- 			(objectMemory isIntegerValue: value)
- 				ifTrue:[self storeInteger: i ofObject: arg withValue: value]
- 				ifFalse:[
- 					value := self positive32BitIntegerFor: value.
- 					objectMemory storePointer: i ofObject: arg withValue: value] ] ].
  
+ 	self successful ifTrue: [self pop: 1]!
- 	self successful ifFalse:[^nil].
- 	self pop: 1!

Item was added:
+ ----- Method: ObjectMemory>>newInputEventAccessorOfSize: (in category 'simulation') -----
+ newInputEventAccessorOfSize: numElements
+ 	<doNotGenerate>
+ 	^CArrayAccessor on: (IntegerArray new: 8)!

Item was added:
+ ----- Method: Spur32BitMemoryManager>>newInputEventAccessorOfSize: (in category 'simulation') -----
+ newInputEventAccessorOfSize: numElements
+ 	<doNotGenerate>
+ 	^CArrayAccessor on: (IntegerArray new: 8)!

Item was added:
+ ----- Method: Spur64BitMemoryManager>>newInputEventAccessorOfSize: (in category 'simulation') -----
+ newInputEventAccessorOfSize: numElements
+ 	<doNotGenerate>
+ 	self flag: #endianness.
+ 	^(CPluggableAccessor on: (IntegerArray new: 16))
+ 		atBlock: [:obj :idx| (obj at: idx - 1 * 2) + ((obj at: idx - 1 * 2 + 1) << 32)]
+ 		atPutBlock: [:obj :idx :val|
+ 					obj at: idx - 1 * 2 put: (val bitAnd: 16rFFFFFFFF).
+ 					obj at: idx - 1 * 2 + 1 put: val >> 32.
+ 					val]!

Item was changed:
  ----- Method: StackInterpreter>>doSignalSemaphoreWithIndex: (in category 'process primitive support') -----
  doSignalSemaphoreWithIndex: index
  	"Signal the external semaphore with the given index.  Answer if a context switch
  	 occurs as a result.  Do not bounds check.  This has been done in the caller."
  	<api>
  	| xArray sema |
  	xArray := objectMemory splObj: ExternalObjectsArray.
+ 	self assert: (objectMemory isArray: xArray).
  	sema := objectMemory fetchPointer: index - 1 ofObject: xArray. "Note: semaphore indices are 1-based"
  	self assert: (objectMemory isOopForwarded: sema) not.
  	^(objectMemory isSemaphoreOop: sema)
  	  and: [self synchronousSignal: sema]!

Item was changed:
  ----- Method: StackInterpreterSimulator>>ioGetNextEvent: (in category 'I/O primitives') -----
  ioGetNextEvent: evtBuf
+ 	| evt |
- 	| evt  |
  	"StackInterpreterSimulatorMorphicModel browse"
+ 	eventQueue ifNil:
- 	eventQueue isNil ifTrue: 
  		[^self primitiveFail].
+ 	eventQueue isEmpty ifFalse:
+ 		[evt :=  eventQueue next.
+ 		 1 to: evt size do:
+ 			[:i| (evt at: i) ifNotNil: [:val| evtBuf at: (i - 1) put: val]]]!
- 	eventQueue isEmpty
- 		ifFalse:
- 			[	evt :=  eventQueue next.
- 			      1 to: (evt size) do: [:i | ((evt at: i) isNil) ifFalse: [evtBuf at: (i - 1) put: (evt at: i)]]].
- 	 self success: true.
- !