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

commits at source.squeak.org commits at source.squeak.org
Thu Sep 20 19:09:21 UTC 2018


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

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

Name: VMMaker.oscog-eem.2444
Author: eem
Time: 20 September 2018, 12:08:29.869065 pm
UUID: 426a03e8-1520-44fa-864a-99bc5302d545
Ancestors: VMMaker.oscog-eem.2443

Eliminate cCode: usage in the B3DAcceleratorPlugin and HostWindowPlugin usign the new "var args" style.  Rewrite mem:mo:ve: et al in the new style.

Fix TMethod>>statementsFor:varName: for Pharo.

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

Item was changed:
  ----- Method: B3DAcceleratorPlugin>>primitiveClearDepthBuffer (in category 'primitives-renderer') -----
  primitiveClearDepthBuffer
+ 	| handle |
- 	| result handle |
  	<export: true>
+ 	interpreterProxy methodArgumentCount = 1 ifFalse:
+ 		[^interpreterProxy primitiveFail].
- 	interpreterProxy methodArgumentCount = 1
- 		ifFalse:[^interpreterProxy primitiveFail].
  	handle := interpreterProxy stackIntegerValue: 0.
+ 	interpreterProxy failed ifFalse:
+ 		[(self b3dxClearDepthBuffer: handle)
+ 			ifTrue: [interpreterProxy pop: 1] "pop args; return rcvr"
+ 			ifFalse:[interpreterProxy primitiveFail]]!
- 	interpreterProxy failed ifTrue:[^nil].
- 	result := self cCode:'b3dxClearDepthBuffer(handle)'.
- 	result ifFalse:[^interpreterProxy primitiveFail].
- 	^interpreterProxy pop: 1. "pop args; return rcvr"!

Item was changed:
  ----- Method: B3DAcceleratorPlugin>>primitiveClearViewport (in category 'primitives-renderer') -----
  primitiveClearViewport
+ 	| handle pv rgba |
- 	| result handle pv rgba |
  	<export: true>
+ 	interpreterProxy methodArgumentCount = 3 ifFalse:
+ 		[^interpreterProxy primitiveFail].
- 	interpreterProxy methodArgumentCount = 3
- 		ifFalse:[^interpreterProxy primitiveFail].
  	pv := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0).
  	rgba := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 1).
  	handle := interpreterProxy stackIntegerValue: 2.
  	interpreterProxy failed ifTrue:[^nil].
+ 	(self b3dxClearViewport: handle _: rgba _: pv)
+ 		ifTrue: [interpreterProxy pop: 3] "pop args; return rcvr"
+ 		ifFalse:[interpreterProxy primitiveFail]!
- 	result := self cCode:'b3dxClearViewport(handle, rgba, pv)'.
- 	result ifFalse:[^interpreterProxy primitiveFail].
- 	^interpreterProxy pop: 3. "pop args; return rcvr"!

Item was changed:
  ----- Method: B3DAcceleratorPlugin>>primitiveCreateRenderer (in category 'primitives-renderer') -----
  primitiveCreateRenderer
  	"NOTE: This primitive is obsolete but should be supported for older images"
  	| h w y x result allowHardware allowSoftware |
  	<export: true>
+ 	interpreterProxy methodArgumentCount = 6 ifFalse:
+ 		[^interpreterProxy primitiveFail].
- 	interpreterProxy methodArgumentCount = 6
- 		ifFalse:[^interpreterProxy primitiveFail].
  	h := interpreterProxy stackIntegerValue: 0.
  	w := interpreterProxy stackIntegerValue: 1.
  	y := interpreterProxy stackIntegerValue: 2.
  	x := interpreterProxy stackIntegerValue: 3.
  	allowHardware := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 4).
  	allowSoftware := interpreterProxy booleanValueOf: (interpreterProxy stackValue: 5).
+ 	interpreterProxy failed ifFalse:
+ 		[(self b3dxCreateRenderer: allowSoftware _: allowHardware _: x _: y _: w _: h) >= 0
+ 			ifTrue: [interpreterProxy methodReturnInteger: result]
+ 			ifFalse: [interpreterProxy primitiveFail]]!
- 	interpreterProxy failed ifTrue:[^nil].
- 	result := self cCode:'b3dxCreateRenderer(allowSoftware, allowHardware, x, y, w, h)'.
- 	result < 0 ifTrue:[^interpreterProxy primitiveFail].
- 	interpreterProxy pop: 7.
- 	^interpreterProxy pushInteger: result.!

Item was changed:
  ----- Method: B3DAcceleratorPlugin>>primitiveCreateRendererFlags (in category 'primitives-renderer') -----
  primitiveCreateRendererFlags
  	| flags h w y x result  |
  	<export: true>
+ 	interpreterProxy methodArgumentCount = 5 ifFalse:
+ 		[^interpreterProxy primitiveFail].
- 	interpreterProxy methodArgumentCount = 5
- 		ifFalse:[^interpreterProxy primitiveFail].
  	h := interpreterProxy stackIntegerValue: 0.
  	w := interpreterProxy stackIntegerValue: 1.
  	y := interpreterProxy stackIntegerValue: 2.
  	x := interpreterProxy stackIntegerValue: 3.
  	flags := interpreterProxy stackIntegerValue: 4.
+ 	interpreterProxy failed ifFalse:
+ 		[(self b3dxCreateRendererFlags: x _: y _: w _: h _: flags) >= 0
+ 			ifTrue: [interpreterProxy methodReturnInteger: result]
+ 			ifFalse: [interpreterProxy primitiveFail]]!
- 	interpreterProxy failed ifTrue:[^nil].
- 	result := self cCode:'b3dxCreateRendererFlags(x, y, w, h, flags)'.
- 	result < 0 ifTrue:[^interpreterProxy primitiveFail].
- 	interpreterProxy pop: 6.
- 	^interpreterProxy pushInteger: result.!

Item was changed:
  ----- Method: B3DAcceleratorPlugin>>primitiveGetIntProperty (in category 'primitives-renderer') -----
  primitiveGetIntProperty
  	| handle prop result |
  	<export: true>
+ 	interpreterProxy methodArgumentCount = 2 ifFalse:
+ 		[^interpreterProxy primitiveFail].
- 	<inline: false>
- 	interpreterProxy methodArgumentCount = 2
- 		ifFalse:[^interpreterProxy primitiveFail].
  	prop := interpreterProxy stackIntegerValue: 0.
  	handle := interpreterProxy stackIntegerValue: 1.
+ 	result := self b3dxGetIntProperty: handle _: prop.
+ 	interpreterProxy methodReturnInteger: result!
- 	result := self cCode:'b3dxGetIntProperty(handle, prop)'.
- 	interpreterProxy pop: 3. "args+rcvr"
- 	^interpreterProxy pushInteger: result!

Item was changed:
  ----- Method: B3DAcceleratorPlugin>>primitiveSetBufferRect (in category 'primitives-renderer') -----
  primitiveSetBufferRect
  	"Primitive. Set the buffer rectangle (e.g., the pixel area on screen) to use for this renderer.
  	The viewport is positioned within the buffer rectangle."
+ 	| h w y x handle |
- 	| h w y x result handle |
  	<export: true>
+ 	interpreterProxy methodArgumentCount = 5 ifFalse:
+ 		[^interpreterProxy primitiveFail].
- 	interpreterProxy methodArgumentCount = 5
- 		ifFalse:[^interpreterProxy primitiveFail].
  	h := interpreterProxy stackIntegerValue: 0.
  	w := interpreterProxy stackIntegerValue: 1.
  	y := interpreterProxy stackIntegerValue: 2.
  	x := interpreterProxy stackIntegerValue: 3.
  	handle := interpreterProxy stackIntegerValue: 4.
+ 	interpreterProxy failed ifFalse:
+ 		[(self b3dxSetBufferRect: handle _: x _: y _: w _: h)
+ 			ifTrue: [interpreterProxy pop: 5] "pop args; return rcvr"
+ 			ifFalse:[interpreterProxy primitiveFail]]!
- 	interpreterProxy failed ifTrue:[^nil].
- 	result := self cCode:'b3dxSetBufferRect(handle, x, y, w, h)'.
- 	result ifFalse:[^interpreterProxy primitiveFail].
- 	^interpreterProxy pop: 5. "pop args; return rcvr"!

Item was changed:
  ----- Method: B3DAcceleratorPlugin>>primitiveSetFog (in category 'primitives-renderer') -----
  primitiveSetFog
+ 	| handle rgba density fogType stop start |
- 	| result handle rgba density fogType stop start |
  	<export: true>
+ 	<var: #density type: #double>
+ 	<var: #start type: #double>
+ 	<var: #stop type: #double>
+ 	interpreterProxy methodArgumentCount = 6 ifFalse:
+ 		[^interpreterProxy primitiveFail].
- 	<var: #density type:'double'>
- 	<var: #start type: 'double'>
- 	<var: #stop type: 'double'>
- 	interpreterProxy methodArgumentCount = 6
- 		ifFalse:[^interpreterProxy primitiveFail].
  	rgba := interpreterProxy positive32BitValueOf: (interpreterProxy stackValue: 0).
  	stop := interpreterProxy floatValueOf: (interpreterProxy stackValue: 1).
  	start := interpreterProxy floatValueOf: (interpreterProxy stackValue: 2).
  	density := interpreterProxy floatValueOf: (interpreterProxy stackValue: 3).
  	fogType := interpreterProxy stackIntegerValue: 4.
  	handle := interpreterProxy stackIntegerValue: 5.
+ 	interpreterProxy failed ifFalse:
+ 		[(self b3dxSetFog: handle _: fogType _: density _: start _: stop _: rgba)
+ 			ifTrue: [interpreterProxy pop: 6] "pop args; return rcvr"
+ 			ifFalse:[interpreterProxy primitiveFail]]!
- 	interpreterProxy failed ifTrue:[^nil].
- 	result := self cCode:'b3dxSetFog(handle, fogType, density, start, stop, rgba)'.
- 	result ifFalse:[^interpreterProxy primitiveFail].
- 	^interpreterProxy pop: 6. "pop args; return rcvr"!

Item was changed:
  ----- Method: B3DAcceleratorPlugin>>primitiveSetIntProperty (in category 'primitives-renderer') -----
  primitiveSetIntProperty
+ 	| handle prop value |
- 	| handle prop result value |
  	<export: true>
+ 	interpreterProxy methodArgumentCount = 3 ifFalse:
+ 		[^interpreterProxy primitiveFail].
- 	<inline: false>
- 	interpreterProxy methodArgumentCount = 3
- 		ifFalse:[^interpreterProxy primitiveFail].
  	value := interpreterProxy stackIntegerValue: 0.
  	prop := interpreterProxy stackIntegerValue: 1.
  	handle := interpreterProxy stackIntegerValue: 2.
+ 	(self b3dxSetIntProperty: handle _: prop _: value)
+ 		ifTrue: [interpreterProxy pop: 3] "args; return rcvr"
+ 		ifFalse: [interpreterProxy primitiveFail]
- 	result := self cCode:'b3dxSetIntProperty(handle, prop, value)'.
- 	result ifFalse:[^interpreterProxy primitiveFail].
- 	^interpreterProxy pop: 3. "args; return rcvr"
  !

Item was changed:
  ----- Method: B3DAcceleratorPlugin>>primitiveSetTransform (in category 'primitives-renderer') -----
  primitiveSetTransform
  	"Transform an entire vertex buffer using the supplied modelview and projection matrix."
  	| projectionMatrix modelViewMatrix handle |
  	<export: true>
+ 	<var: #projectionMatrix type: #'float *'>
+ 	<var: #modelViewMatrix type: #'float *'>
- 	<inline: false>
- 	<var: #projectionMatrix declareC:'float *projectionMatrix'>
- 	<var: #modelViewMatrix declareC:'float *modelViewMatrix'>
  
+ 	interpreterProxy methodArgumentCount = 3 ifFalse:
+ 		[^interpreterProxy primitiveFail].
- 	interpreterProxy methodArgumentCount = 3
- 		ifFalse:[^interpreterProxy primitiveFail].
- 
  	projectionMatrix := self stackMatrix: 0.
  	modelViewMatrix := self stackMatrix: 1.
  	handle := interpreterProxy stackIntegerValue: 2.
+ 	interpreterProxy failed ifFalse:
+ 		[self b3dxSetTransform: handle _: modelViewMatrix _: projectionMatrix.
+ 		 interpreterProxy pop: 3] "Leave rcvr on stack"!
- 	interpreterProxy failed ifTrue:[^nil].
- 	self cCode: 'b3dxSetTransform(handle, modelViewMatrix, projectionMatrix)'.
- 	^interpreterProxy pop: 3. "Leave rcvr on stack"!

Item was changed:
  ----- Method: B3DAcceleratorPlugin>>primitiveSetVerboseLevel (in category 'primitives-renderer') -----
  primitiveSetVerboseLevel
  	| result level |
  	<export: true>
+ 	interpreterProxy methodArgumentCount = 1 ifFalse:
+ 		[^interpreterProxy primitiveFail].
- 	<inline: false>
- 	interpreterProxy methodArgumentCount = 1
- 		ifFalse:[^interpreterProxy primitiveFail].
  	level := interpreterProxy stackIntegerValue: 0.
+ 	result := self b3dxSetVerboseLevel: level.
+ 	interpreterProxy methodReturnInteger: result!
- 	result := self cCode:'b3dxSetVerboseLevel(level)'.
- 	interpreterProxy pop: 2. "args+rcvr"
- 	^interpreterProxy pushInteger: result!

Item was changed:
  ----- Method: B3DAcceleratorPlugin>>primitiveSetViewport (in category 'primitives-renderer') -----
  primitiveSetViewport
+ 	| h w y x handle |
- 	| h w y x result handle |
  	<export: true>
+ 	interpreterProxy methodArgumentCount = 5 ifFalse:
+ 		[^interpreterProxy primitiveFail].
- 	interpreterProxy methodArgumentCount = 5
- 		ifFalse:[^interpreterProxy primitiveFail].
  	h := interpreterProxy stackIntegerValue: 0.
  	w := interpreterProxy stackIntegerValue: 1.
  	y := interpreterProxy stackIntegerValue: 2.
  	x := interpreterProxy stackIntegerValue: 3.
  	handle := interpreterProxy stackIntegerValue: 4.
+ 	interpreterProxy failed ifFalse:
+ 		[(self b3dxSetViewport: handle _: x _: y _: w _: h)
+ 			ifTrue: [interpreterProxy pop: 5] "pop args; return rcvr"
+ 			ifFalse:[interpreterProxy primitiveFail]]!
- 	interpreterProxy failed ifTrue:[^nil].
- 	result := self cCode:'b3dxSetViewport(handle, x, y, w, h)'.
- 	result ifFalse:[^interpreterProxy primitiveFail].
- 	^interpreterProxy pop: 5. "pop args; return rcvr"!

Item was changed:
  ----- Method: CoInterpreter>>callbackEnter: (in category 'callback support') -----
  callbackEnter: callbackID
  	"Re-enter the interpreter for executing a callback"
  	| currentCStackPointer currentCFramePointer savedReenterInterpreter
  	  wasInMachineCode calledFromMachineCode |
  	<volatile>
  	<export: true>
  	<var: #currentCStackPointer type: #'void *'>
  	<var: #currentCFramePointer type: #'void *'>
  	<var: #callbackID type: #'sqInt *'>
  	<var: #savedReenterInterpreter type: #'jmp_buf'>
  
  	"For now, do not allow a callback unless we're in a primitiveResponse"
  	(self asserta: primitiveFunctionPointer ~= 0) ifFalse:
  		[^false].
  
  	self assert: primFailCode = 0.
  
  	"Check if we've exceeded the callback depth"
  	(self asserta: jmpDepth < MaxJumpBuf) ifFalse:
  		[^false].
  	jmpDepth := jmpDepth + 1.
  
  	wasInMachineCode := self isMachineCodeFrame: framePointer.
  	calledFromMachineCode := instructionPointer <= objectMemory startOfMemory.
  
  	"Suspend the currently active process"
  	suspendedCallbacks at: jmpDepth put: self activeProcess.
  	"We need to preserve newMethod explicitly since it is not activated yet
  	and therefore no context has been created for it. If the caller primitive
  	for any reason decides to fail we need to make sure we execute the correct
  	method and not the one 'last used' in the call back"
  	suspendedMethods at: jmpDepth put: newMethod.
  	self flag: 'need to debug this properly.  Conceptually it is the right thing to do but it crashes in practice'.
  	false
  		ifTrue:
  			["Signal external semaphores since a signalSemaphoreWithIndex: request may
  			  have been issued immediately prior to this callback before the VM has any
  			  chance to do a signalExternalSemaphores in checkForEventsMayContextSwitch:"
  			 self signalExternalSemaphores.
  			 "If no process is awakened by signalExternalSemaphores then transfer
  			  to the highest priority runnable one."
  			 (suspendedCallbacks at: jmpDepth) = self activeProcess ifTrue:
  				[self transferTo: self wakeHighestPriority from: CSCallbackLeave]]
  		ifFalse:
  			[self transferTo: self wakeHighestPriority from: CSCallbackLeave].
  
  	"Typically, invoking the callback means that some semaphore has been 
  	signaled to indicate the callback. Force an interrupt check as soon as possible."
  	self forceInterruptCheck.
  
  	"Save the previous CStackPointers and interpreter entry jmp_buf."
  	currentCStackPointer := cogit getCStackPointer.
  	currentCFramePointer := cogit getCFramePointer.
+ 	self memcpy: savedReenterInterpreter asVoidPointer
+ 		_: reenterInterpreter
+ 		_: (self sizeof: #'jmp_buf').
- 	self mem: savedReenterInterpreter asVoidPointer
- 		cp: reenterInterpreter
- 		y: (self sizeof: #'jmp_buf').
  	cogit assertCStackWellAligned.
  	(self setjmp: (jmpBuf at: jmpDepth)) = 0 ifTrue: "Fill in callbackID"
  		[callbackID at: 0 put: jmpDepth.
  		 self enterSmalltalkExecutive.
  		 self assert: false "NOTREACHED"].
  
  	"Restore the previous CStackPointers and interpreter entry jmp_buf."
  	cogit setCStackPointer: currentCStackPointer.
  	cogit setCFramePointer: currentCFramePointer.
+ 	self memcpy: reenterInterpreter
+ 		_: (self cCoerceSimple: savedReenterInterpreter to: #'void *')
+ 		_: (self sizeof: #'jmp_buf').
- 	self mem: reenterInterpreter
- 		cp: (self cCoerceSimple: savedReenterInterpreter to: #'void *')
- 		y: (self sizeof: #'jmp_buf').
  
  	"Transfer back to the previous process so that caller can push result"
  	self putToSleep: self activeProcess yieldingIf: preemptionYields.
  	self transferTo: (suspendedCallbacks at: jmpDepth) from: CSCallbackLeave.
  	newMethod := suspendedMethods at: jmpDepth.	"see comment above"
  	argumentCount := self argumentCountOf: newMethod.
  	self assert: wasInMachineCode = (self isMachineCodeFrame: framePointer).
  	calledFromMachineCode
  		ifTrue:
  			[instructionPointer asUnsignedInteger >= objectMemory startOfMemory ifTrue:
  				[self iframeSavedIP: framePointer put: instructionPointer.
  				 instructionPointer := cogit ceReturnToInterpreterPC]]
  		ifFalse:
  			["Even if the context was flushed to the heap and rebuilt in transferTo:from:
  			  above it will remain an interpreted frame because the context's pc would
  			  remain a bytecode pc.  So the instructionPointer must also be a bytecode pc."
  			 self assert: (self isMachineCodeFrame: framePointer) not.
  			 self assert: instructionPointer > objectMemory startOfMemory].
  	self assert: primFailCode = 0.
  	jmpDepth := jmpDepth-1.
  	^true!

Item was changed:
  ----- Method: CoInterpreter>>restoreCStackStateForCallbackContext: (in category 'callback support') -----
  restoreCStackStateForCallbackContext: vmCallbackContext
  	<var: #vmCallbackContext type: #'VMCallbackContext *'>
  	cogit
  		setCStackPointer: vmCallbackContext savedCStackPointer;
  		setCFramePointer: vmCallbackContext savedCFramePointer.
+ 	self memcpy: reenterInterpreter
+ 		_: vmCallbackContext savedReenterInterpreter asVoidPointer
+ 		_: (self sizeof: #'jmp_buf')!
- 	self mem: reenterInterpreter
- 		cp: vmCallbackContext savedReenterInterpreter asVoidPointer
- 		y: (self sizeof: #'jmp_buf')!

Item was changed:
  ----- Method: CoInterpreterMT>>ownVM: (in category 'vm scheduling') -----
  ownVM: threadIndexAndFlags
  	<api>
  	<inline: false>
  	"This is the entry-point for plugins and primitives that wish to reacquire the VM after having
  	 released it via disownVM or callbacks that want to acquire it without knowing their ownership
  	 status.  This call will block until the VM is owned by the current thread or an error occurs.
  	 The argument should be the value answered by disownVM, or 0 for callbacks that don't know
  	 if they have disowned or not.  This is both an optimization to avoid having to query thread-
  	 local storage for the current thread's index (since it can easily keep it in some local variable),
  	 and a record of when an unbound process becomes affined to a thread for the dynamic
  	 extent of some operation.
  
  	 Answer 0 if the current thread is known to the VM.
  	 Answer 1 if the current thread is unknown to the VM and takes ownership.
  	 Answer -1 if the current thread is unknown to the VM and fails to take ownership."
  	| threadIndex flags vmThread myProc activeProc sched |
  	<var: #vmThread type: #'CogVMThread *'>
  	threadIndexAndFlags = 0 ifTrue:
  		[^self ownVMFromUnidentifiedThread].
  	threadIndex := threadIndexAndFlags bitAnd: ThreadIdMask.
  	flags := threadIndexAndFlags >> DisownFlagsShift.
  	(flags anyMask: DisownVMForProcessorRelinquish) ifTrue:
  		[relinquishing := false.
  		 self sqLowLevelMFence].
  	(threadIndexAndFlags anyMask: LockGUIThreadFlag) ifTrue:
  		[self assert: (noThreadingOfGUIThread and: [self inGUIThread]).
  		 self assert: disowningVMThread = nil.
  		 (flags anyMask: DisownVMLockOutFullGC) ifTrue:
  			[objectMemory decrementFullGCLock].
  		 cogit recordEventTrace ifTrue:
  			[self recordTrace: TraceOwnVM thing: ConstZero source: 0].
  		 ^0].
  
  	vmThread := cogThreadManager acquireVMFor: threadIndex.
  	disownCount := disownCount - 1.
  
  	(flags anyMask: DisownVMLockOutFullGC) ifTrue:
  		[objectMemory decrementFullGCLock].
  	disowningVMThread notNil ifTrue:
  		[vmThread = disowningVMThread ifTrue:
  			[self cCode: ''
  				inSmalltalk:
  					[| range |
  					 range := self cStackRangeForThreadIndex: threadIndex.
  					 self assert: (range includes: cogit getCStackPointer).
  					 self assert: (range includes: cogit getCFramePointer)].
  			 self assert: self successful.
  			 self assert: (objectMemory fetchPointer: MyListIndex ofObject: self activeProcess) = objectMemory nilObject.
  			 disowningVMThread := nil.
  			 cogit recordEventTrace ifTrue:
  				[self recordTrace: TraceOwnVM thing: ConstOne source: 0].
  			 ^0].  "if not preempted we're done."
  		self preemptDisowningThread].
  	"We've been preempted; we must restore state and update the threadId
  	 in our process, and may have to put the active process to sleep."
  	sched := self schedulerPointer.
  	activeProc := objectMemory fetchPointer: ActiveProcessIndex ofObject: sched.
  	(threadIndexAndFlags anyMask: OwnVMForeignThreadFlag)
  		ifTrue:
  			[self assert: foreignCallbackProcessSlot == ForeignCallbackProcess.
  			 myProc := objectMemory splObj: foreignCallbackProcessSlot.
  			self assert: myProc ~= objectMemory nilObject.
  			objectMemory splObj: foreignCallbackProcessSlot put: objectMemory nilObject]
  		ifFalse: [myProc := cogThreadManager popAWOLProcess: vmThread].
  	self assert: activeProc ~= myProc.
  	(activeProc ~= objectMemory nilObject
  	 and: [(objectMemory fetchPointer: MyListIndex ofObject: activeProc) = objectMemory nilObject]) ifTrue:
  		[self putToSleep: activeProc yieldingIf: preemptionYields].
  	self assert: (objectMemory fetchPointer: MyListIndex ofObject: myProc) = (objectMemory splObj: ProcessInExternalCodeTag).
  	objectMemory
  		storePointer: ActiveProcessIndex ofObject: sched withValue: myProc;
  		storePointerUnchecked: MyListIndex ofObject: myProc withValue: objectMemory nilObject.
  	"Only unaffine if the process was affined at this level and did not become bound in the interim."
  	((threadIndexAndFlags anyMask: ProcessUnaffinedOnDisown)
  	 and: [(self isBoundProcess: myProc) not]) ifTrue:
  		[self setOwnerIndexOfProcess: myProc to: 0 bind: false].
  	self initPrimCall.
  	self externalSetStackPageAndPointersForSuspendedContextOfProcess: myProc.
  	"If this primitive is called from machine code maintain the invariant that the return pc
  	 of an interpreter callee calling a machine code caller is ceReturnToInterpreterPC."
  	(vmThread inMachineCode
  	 and: [instructionPointer >= objectMemory startOfMemory]) ifTrue:
  		[self iframeSavedIP: framePointer put: instructionPointer.
  		 instructionPointer := cogit ceReturnToInterpreterPC].
  	newMethod := vmThread newMethodOrNull.
  	argumentCount := vmThread argumentCount.
  	self cCode:
+ 			[self memcpy: reenterInterpreter
+ 				_: vmThread reenterInterpreter
+ 				_: (self sizeof: #'jmp_buf')]
- 			[self mem: reenterInterpreter
- 				cp: vmThread reenterInterpreter
- 				y: (self sizeof: #'jmp_buf')]
  		inSmalltalk:
  			[reenterInterpreter := vmThread reenterInterpreter].
  	vmThread newMethodOrNull: nil.
  	self cCode: ''
  		inSmalltalk:
  			[| range |
  			 range := self cStackRangeForThreadIndex: threadIndex.
  			 self assert: (range includes: vmThread cStackPointer).
  			 self assert: (range includes: vmThread cFramePointer)].
  	cogit setCStackPointer: vmThread cStackPointer.
  	cogit setCFramePointer: vmThread cFramePointer.
  	self assert: newMethod ~~ nil.
  	cogit recordEventTrace ifTrue:
  		[self recordTrace: TraceOwnVM thing: ConstTwo source: 0].
  	^threadIndexAndFlags bitAnd: OwnVMForeignThreadFlag!

Item was changed:
  ----- Method: CoInterpreterMT>>preemptDisowningThread (in category 'vm scheduling') -----
  preemptDisowningThread
  	"Set the relevant state for disowningVMThread so that it can resume after
  	 being preempted and set disowningVMThread to nil to indicate preemption.
  
  	 N.B.  This should only be sent from checkPreemptionOfDisowningThread.
  
  	 There are essentially four things to do.
  	 a)	save the VM's notion of the current C stack pointers; these are pointers
  		into a thread's stack and must be saved and restored in thread switch.
  	 b)	save the VM's notion of the current Smalltalk execution point.  This is
  		simply the suspend half of a process switch that saves the current context
  		in the current process.
  	 c)	add the process to the thread's set of AWOL processes so that the scheduler
  		won't try to run the process while the thread has disowned the VM.
  	 d)	save the in-primitive VM state, newMethod and argumentCount
  
  	 ownVM: will restore the VM context as of disownVM: from the above when it
  	 finds it has been preempted."
  
  	| activeProc activeContext preemptedThread |
  	<var: #preemptedThread type: #'CogVMThread *'>
  	<inline: false>
  	self assert: disowningVMThread notNil.
  	self assert: (disowningVMThread state = CTMUnavailable
  				or: [disowningVMThread state = CTMWantingOwnership]).
  	self cCode: ''
  		inSmalltalk:
  			[| range |
  			 range := self cStackRangeForThreadIndex: disowningVMThread index.
  			 self assert: (range includes: cogit getCStackPointer).
  			 self assert: (range includes: cogit getCFramePointer)].
  	cogit recordEventTrace ifTrue:
  		[self recordTrace: TracePreemptDisowningThread
  			thing: (objectMemory integerObjectOf: disowningVMThread index)
  			source: 0].
  	disowningVMThread cStackPointer: cogit getCStackPointer.
  	disowningVMThread cFramePointer: cogit getCFramePointer.
  	activeProc := self activeProcess.
  	self assert: (objectMemory fetchPointer: MyListIndex ofObject: activeProc) = objectMemory nilObject.
  	objectMemory
  		storePointer: MyListIndex
  		ofObject: activeProc
  		withValue: (objectMemory splObj: ProcessInExternalCodeTag).
  	"The instructionPointer must be pushed because the convention for inactive stack pages is that the
  	 instructionPointer is top of stack.  We need to know if this primitive is called from machine code
  	 because the invariant that the return pc of an interpreter callee calling a machine code caller is
  	 ceReturnToInterpreterPC must be maintained."
  	self push: instructionPointer.
  	self externalWriteBackHeadFramePointers.
  	activeContext := self ensureFrameIsMarried: framePointer SP: stackPointer.
  	objectMemory
  		storePointer: SuspendedContextIndex
  		ofObject: activeProc
  		withValue: activeContext.
  	"Since pushing the awol process may realloc disowningVMThread we need to reassign.
  	 But since we're going to nil disowningVMThread anyway we can assign to a local."
  	preemptedThread := cogThreadManager pushAWOLProcess: activeProc on: disowningVMThread.
  	disowningVMThread := nil.
  	preemptedThread priority: (self quickFetchInteger: PriorityIndex ofObject: activeProc).
  	(self ownerIndexOfProcess: activeProc) = 0
  		ifTrue: [self setOwnerIndexOfProcess: activeProc to: preemptedThread index bind: false]
  		ifFalse: [self assert: (self ownerIndexOfProcess: activeProc) = preemptedThread index].
  	preemptedThread
  		newMethodOrNull: newMethod;
  		argumentCount: argumentCount;
  		inMachineCode: instructionPointer asUnsignedInteger <= objectMemory startOfMemory.
  	self cCode:
+ 			[self memcpy: preemptedThread reenterInterpreter
+ 				_: reenterInterpreter
+ 				_: (self sizeof: #'jmp_buf')]
- 			[self mem: preemptedThread reenterInterpreter
- 				cp: reenterInterpreter
- 				y: (self sizeof: #'jmp_buf')]
  		inSmalltalk:
  			[preemptedThread reenterInterpreter: reenterInterpreter]!

Item was changed:
  ----- Method: CoInterpreterMT>>primitiveRelinquishProcessor (in category 'I/O primitives') -----
  primitiveRelinquishProcessor
  	"Relinquish the processor for up to the given number of microseconds.
  	 The exact behavior of this primitive is platform dependent.
  	 Override to check for waiting threads."
  
  	| microSecs threadIndexAndFlags currentCStackPointer currentCFramePointer savedReenterInterpreter |
  	<var: #currentCStackPointer type: #'void *'>
  	<var: #currentCFramePointer type: #'void *'>
  	<var: #savedReenterInterpreter type: #'jmp_buf'>
  	microSecs := self stackTop.
  	(objectMemory isIntegerObject: microSecs) ifFalse:
  		[^self primitiveFail].
  	self assert: (objectMemory fetchPointer: MyListIndex ofObject: self activeProcess) = objectMemory nilObject.
  	self assert: relinquishing not.
  	"DO NOT allow relinquishing the processor while we are profiling since this
  	 may skew the time base for our measures (it may reduce processor speed etc).
  	 Instead we go full speed, therefore measuring the precise time we spend in the
  	 inner idle loop as a busy loop."
  	nextProfileTick = 0 ifTrue:
  		"Presumably we have nothing to do; this primitive is typically called from the
  		 background process. So we should /not/ try and activate any threads in the
  		 pool; they will waste cycles finding there is no runnable process, and will
  		 cause a VM abort if no runnable process is found.  But we /do/ want to allow
  		 FFI calls that have completed, or callbacks a chance to get into the VM; they
  		 do have something to do.  DisownVMForProcessorRelinquish indicates this."
  		[currentCStackPointer := cogit getCStackPointer.
  		 currentCFramePointer := cogit getCFramePointer.
  		 self cCode:
+ 			[self memcpy: savedReenterInterpreter asVoidPointer
+ 				_: reenterInterpreter
+ 				_: (self sizeof: #'jmp_buf')].
- 			[self mem: savedReenterInterpreter asVoidPointer
- 				cp: reenterInterpreter
- 				y: (self sizeof: #'jmp_buf')].
  		 threadIndexAndFlags := self disownVM: DisownVMForProcessorRelinquish.
  		 self assert: relinquishing.
  		 self ioRelinquishProcessorForMicroseconds: (objectMemory integerValueOf: microSecs).
  		 self assert: relinquishing.
  		 self ownVM: threadIndexAndFlags.
  		 self assert: relinquishing not.
  		 self assert: cogThreadManager currentVMThread state = CTMAssignableOrInVM.
  		 self assert: currentCStackPointer = cogit getCStackPointer.
  		 self assert: currentCFramePointer = cogit getCFramePointer.
  		 self cCode:
  			[self assert: (self mem: (self cCoerceSimple: savedReenterInterpreter to: #'void *')
  						cm: reenterInterpreter
  						p: (self sizeof: #'jmp_buf')) = 0]].
  	self assert: (objectMemory fetchPointer: MyListIndex ofObject: self activeProcess) = objectMemory nilObject.
  	self pop: 1  "microSecs; leave rcvr on stack"!

Item was changed:
  ----- Method: CoInterpreterMT>>returnToSchedulingLoopAndReleaseVMOrWakeThread:source: (in category 'process primitive support') -----
  returnToSchedulingLoopAndReleaseVMOrWakeThread: vmThread source: source
  	| savedReenterInterpreter |
  	<var: #savedReenterInterpreter type: #'jmp_buf'>
  	<var: #vmThread type: #'CogVMThread *'>
  	<inline: false>
  	self cCode:
  			[self flag: 'this is just for debugging.  Note the current C stack pointers'.
  			 cogThreadManager currentVMThread
  				cStackPointer: cogit getCStackPointer;
  				cFramePointer: cogit getCFramePointer]
  		inSmalltalk:
  			[| range |
  			 range := self cStackRangeForThreadIndex: cogThreadManager getVMOwner.
  			 self assert: (range includes: cogit getCStackPointer).
  			 self assert: (range includes: cogit getCFramePointer)].
  	"We must use a copy of reenterInterpreter since we're giving up the VM to another vmThread."
  	self cCode:
+ 			[self memcpy: savedReenterInterpreter asVoidPointer
+ 				_: reenterInterpreter
+ 				_: (self sizeof: #'jmp_buf')]
- 			[self mem: savedReenterInterpreter asVoidPointer
- 				cp: reenterInterpreter
- 				y: (self sizeof: #'jmp_buf')]
  		inSmalltalk:
  			[savedReenterInterpreter := reenterInterpreter].
  	self recordThreadSwitchTo: (vmThread ifNotNil: [vmThread index] ifNil: [0]) source: source.
  	vmThread
  		ifNotNil: [cogThreadManager wakeVMThreadFor: vmThread index]
  		ifNil: [cogThreadManager releaseVM].
  	"2 implies returning to the threadSchedulingLoop."
  	self siglong: savedReenterInterpreter jmp: ReturnToThreadSchedulingLoop!

Item was changed:
  ----- Method: CogMethodZone>>compactCompiledCode (in category 'compaction') -----
  compactCompiledCode
  	| objectHeaderValue source dest bytes |
  	<var: #source type: #'CogMethod *'>
  	<var: #dest type: #'CogMethod *'>
  	compactionInProgress := true.
  	objectHeaderValue := objectMemory nullHeaderForMachineCodeMethod.
  	source := coInterpreter cCoerceSimple: baseAddress to: #'CogMethod *'.
  	self voidOpenPICList. "The list will be rebuilt with the current live set"
  	methodCount := 0.
  	NewspeakVM ifTrue: [unpairedMethodList := nil].
  	[source < self limitZony
  	 and: [source cmType ~= CMFree]] whileTrue:
  		[self assert: (cogit cogMethodDoesntLookKosher: source) = 0.
  		 source objectHeader: objectHeaderValue.
  		 source cmUsageCount > 0 ifTrue:
  			[source cmUsageCount: source cmUsageCount // 2].
  		 NewspeakVM ifTrue:
  				[(source cmType = CMMethod
  				  and: [(coInterpreter rawHeaderOf: source methodObject) asInteger ~= source asInteger]) ifTrue:
  					[source nextMethodOrIRCs: unpairedMethodList.
  					 unpairedMethodList := source asUnsignedInteger]].
  		 SistaVM ifTrue:
  			[self clearSavedPICUsageCount: source].
  		 source cmType = CMOpenPIC ifTrue:
  			[self addToOpenPICList: source].
  		 methodCount := methodCount + 1.
  		 source := self methodAfter: source].
  	source >= self limitZony ifTrue:
  		[^self halt: 'no free methods; cannot compact.'].
  	dest := source.
  	[source < self limitZony] whileTrue:
  		[self assert: (cogit maybeFreeCogMethodDoesntLookKosher: source) = 0.
  		 bytes := source blockSize.
  		 source cmType ~= CMFree ifTrue:
  			[methodCount := methodCount + 1.
+ 			 objectMemory memmove: dest _: source _: bytes.
- 			 objectMemory mem: dest mo: source ve: bytes.
  			 dest objectHeader: objectHeaderValue.
  			 dest cmType = CMMethod
  				ifTrue:
  					["For non-Newspeak there should be a one-to-one mapping between bytecoded and
  					  cog methods.  For Newspeak not necessarily, but only for anonymous accessors."
  					"Only update the original method's header if it is referring to this CogMethod."
  					 (coInterpreter rawHeaderOf: dest methodObject) asInteger = source asInteger
  						ifTrue:
  							[coInterpreter rawHeaderOf: dest methodObject put: dest asInteger]
  						ifFalse:
  							[self assert: (cogit noAssertMethodClassAssociationOf: dest methodObject) = objectMemory nilObject.
  							 NewspeakVM ifTrue:
  								[dest nextMethodOrIRCs: unpairedMethodList.
  								 unpairedMethodList := dest asUnsignedInteger]]]
  				ifFalse:
  					[SistaVM ifTrue:
  						[self clearSavedPICUsageCount: dest].
  					 dest cmType = CMOpenPIC ifTrue:
  						[self addToOpenPICList: dest]].
  			 dest cmUsageCount > 0 ifTrue:
  				[dest cmUsageCount: dest cmUsageCount // 2].
  			 dest := coInterpreter
  								cCoerceSimple: dest asUnsignedInteger + bytes
  								to: #'CogMethod *'].
  		 source := coInterpreter
  							cCoerceSimple: source asUnsignedInteger + bytes
  							to: #'CogMethod *'].
  	mzFreeStart := dest asUnsignedInteger.
  	methodBytesFreedSinceLastCompaction := 0.
  	compactionInProgress := false!

Item was changed:
  ----- Method: CogVMSimulator>>ioLoadFunction:From: (in category 'plugin support') -----
  ioLoadFunction: functionString From: pluginString
  	"Load and return the requested function from a module"
  	| firstTime plugin fnSymbol |
  	firstTime := false.
  	fnSymbol := functionString asSymbol.
  	transcript
  		cr;
  		show: '(', byteCount printString, ') Looking for ', functionString, ' in ',
  				(pluginString isEmpty ifTrue:['vm'] ifFalse:[pluginString]).
  	(breakSelector notNil
  	 and: [pluginString size = breakSelector size
+ 	 and: [(self strncmp: pluginString _: breakSelector _: pluginString size) = 0
+ 		or: [(self strncmp: functionString _: breakSelector _: functionString size) = 0]]]) ifTrue:
- 	 and: [(self str: pluginString n: breakSelector cmp: pluginString size) = 0
- 		or: [(self str: functionString n: breakSelector cmp: functionString size) = 0]]]) ifTrue:
  		[self halt: functionString].
  	plugin := pluginList 
  				detect:[:any| any key = pluginString asString]
  				ifNone:
  					[firstTime := true.
  					self loadNewPlugin: pluginString].
  	plugin ifNil:
  		[firstTime ifTrue: [transcript cr; show: 'Failed ... primitive not in plugin'].
  		 ^0].
  	plugin := plugin value.
  	mappedPluginEntries doWithIndex:
  		[:pluginAndName :index|
  		((pluginAndName at: 1) == plugin 
  		and:[(pluginAndName at: 2) == fnSymbol]) ifTrue:
  			[^index]].
  	(plugin respondsTo: fnSymbol) ifFalse:
  		[firstTime ifTrue: [transcript cr; show: 'Failed ... primitive not in plugin'].
  		 ^0].
  	mappedPluginEntries addLast: (Array
  									with: plugin
  									with: fnSymbol
  									with: [plugin perform: fnSymbol. self]).
  	"Transcript show: ' ... okay'."
  	transcript cr.
  	^ mappedPluginEntries size!

Item was changed:
  ----- Method: CogVMSimulator>>ioLoadFunction:From:AccessorDepthInto: (in category 'plugin support') -----
  ioLoadFunction: functionString From: pluginString AccessorDepthInto: accessorDepthPtr
  	"Load and return the requested function from a module.
  	 Assign the accessor depth through accessorDepthPtr.
  	 N.B. The actual code lives in platforms/Cross/vm/sqNamedPrims.h"
  	| firstTime plugin fnSymbol |
  	firstTime := false.
  	fnSymbol := functionString asSymbol.
  	transcript
  		cr;
  		show: '(', byteCount printString, ') Looking for ', functionString, ' in ',
  				(pluginString isEmpty ifTrue:['vm'] ifFalse:[pluginString]).
  	(breakSelector notNil
  	 and: [pluginString size = breakSelector size
+ 	 and: [(self strncmp: pluginString _: breakSelector _: pluginString size) = 0
+ 		or: [(self strncmp: functionString _: breakSelector _: functionString size) = 0]]]) ifTrue:
- 	 and: [(self str: pluginString n: breakSelector cmp: pluginString size) = 0
- 		or: [(self str: functionString n: breakSelector cmp: functionString size) = 0]]]) ifTrue:
  		[self halt: functionString].
  	plugin := pluginList 
  				detect: [:any| any key = pluginString asString]
  				ifNone:
  					[firstTime := true.
  					 self loadNewPlugin: pluginString].
  	plugin ifNil:
  		[firstTime ifTrue: [transcript cr; show: 'Failed ... primitive not in plugin'].
  		 ^0].
  	plugin := plugin value.
  	mappedPluginEntries doWithIndex:
  		[:pluginAndName :index|
  		 ((pluginAndName at: 1) == plugin 
  		  and:[(pluginAndName at: 2) == fnSymbol]) ifTrue:
  			[firstTime ifTrue: [transcript show: ' ... okay'; cr].
  			 accessorDepthPtr at: 0 put: (pluginAndName at: 4).
  			 ^index]].
  	firstTime ifTrue: [transcript cr; show: 'Failed ... primitive not in plugin'].
  	transcript cr.
  	^0!

Item was changed:
  ----- Method: CogVMSimulator>>loadNewPlugin: (in category 'plugin support') -----
  loadNewPlugin: pluginString
  	(breakSelector notNil
+ 	 and: [(self strncmp: pluginString _: breakSelector _: pluginString size) = 0]) ifTrue:
- 	 and: [(self str: pluginString n: breakSelector cmp: pluginString size) = 0]) ifTrue:
  		[self halt: pluginString].
  	^(self tryLoadNewPlugin: pluginString pluginEntries: mappedPluginEntries) ifNotNil:
  		[:entry|
  		 pluginList := pluginList copyWith: entry.
  		 entry]!

Item was changed:
  ----- Method: CogVMSimulator>>utilitiesMenu: (in category 'UI') -----
  utilitiesMenu: aMenuMorph
  	aMenuMorph
  		add: 'toggle transcript' action: #toggleTranscript;
  		add: 'clone VM' action: #cloneSimulationWindow;
  		addLine;
  		add: 'print ext head frame' action: #printExternalHeadFrame;
  		add: 'print int head frame' action: #printHeadFrame;
  		add: 'print mc/cog head frame' action: [self printFrame: cogit processor fp WithSP: cogit processor sp];
  		add: 'short print ext head frame & callers' action: [self shortPrintFrameAndCallers: framePointer];
  		add: 'short print int head frame & callers' action: [self shortPrintFrameAndCallers: localFP];
  		add: 'short print mc/cog head frame & callers' action: [self shortPrintFrameAndCallers: cogit processor fp];
  		add: 'long print ext head frame & callers' action: [self printFrameAndCallers: framePointer SP: stackPointer];
  		add: 'long print int head frame & callers' action: [self printFrameAndCallers: localFP SP: localSP];
  		add: 'long print mc/cog head frame & callers' action: [self printFrameAndCallers: cogit processor fp SP: cogit processor sp];
  		add: 'print frame...' action: [(self promptHex: 'print frame') ifNotNil: [:fp| self printFrame: fp]];
  		add: 'print call stack' action: #printCallStack;
  		add: 'print stack call stack' action: #printStackCallStack;
  		add: 'print stack call stack of...' action: [(self promptHex: 'frame') ifNotNil: [:fp| self printStackCallStackOf: fp]];
  		add: 'print call stack of...' action: [(self promptHex: 'context or process oop') ifNotNil: [:obj| self printCallStackOf: obj]];
  		add: 'print call stack of frame...' action: [(self promptHex: 'frame') ifNotNil: [:fp| self printCallStackFP: fp]];
  		add: 'print all stacks' action: #printAllStacks;
  		add: 'write back local ptrs' action: [stackPointer := localSP. framePointer := localFP. instructionPointer := localIP.
  											self writeBackHeadFramePointers];
  		add: 'write back mc ptrs' action: [stackPointer := cogit processor sp. framePointer := cogit processor fp. instructionPointer := cogit processor pc.
  											self externalWriteBackHeadFramePointers];
  		addLine;
  		add: 'print rump C stack' action: [objectMemory printMemoryFrom: cogit processor sp to: cogit getCStackPointer];
  		add: 'print registers' action: [cogit processor printRegistersOn: transcript];
  		add: 'print register map' action: [cogit printRegisterMapOn: transcript];
  		add: 'disassemble method/trampoline...' action: [(self promptHex: 'pc') ifNotNil: [:pc| cogit disassembleCodeAt: pc]];
  		add: 'disassemble method/trampoline at pc' action:
  			[cogit disassembleCodeAt: (((cogit codeEntryFor: cogit processor pc) isNil
  										  and: [(cogit methodZone methodFor: cogit processor pc) = 0])
  											ifTrue: [instructionPointer]
  											ifFalse: [cogit processor pc])];
  		add: 'disassemble ext head frame method' action: [cogit disassembleMethod: (self frameMethod: framePointer)];
  		add: 'print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self printOop: oop]];
  		add: 'long print oop...' action: [(self promptHex: 'print oop') ifNotNil: [:oop| self longPrintOop: oop]];
  		add: 'print context...' action: [(self promptHex: 'print context') ifNotNil: [:oop| self printContext: oop]];
  		add: 'symbolic method...' action: [(self promptHex: 'method bytecodes') ifNotNil: [:oop| self symbolicMethod: oop]];
  		addLine;
  		add: 'inspect object memory' target: objectMemory action: #inspect;
  		add: 'run leak checker' action: [Cursor execute showWhile: [self runLeakChecker]];
  		add: 'inspect cointerpreter' action: #inspect;
  		add: 'inspect cogit' target: cogit action: #inspect;
  		add: 'inspect method zone' target: cogit methodZone action: #inspect.
  	self isThreadedVM ifTrue:
  		[aMenuMorph add: 'inspect thread manager' target: self threadManager action: #inspect].
  	aMenuMorph
  		addLine;
  		add: 'print cog methods' target: cogMethodZone action: #printCogMethods;
  		add: 'print cog methods with prim...' action:
  			[(self promptNum: 'prim index') ifNotNil: [:pix| cogMethodZone printCogMethodsWithPrimitive: pix]];
  		add: 'print cog methods with selector...' action:
  			[|s| s := UIManager default request: 'selector'.
  			s notEmpty ifTrue:
  				[s = 'nil' ifTrue: [s := nil].
  				 cogMethodZone methodsDo:
  					[:m|
  					(s ifNil: [m selector = objectMemory nilObject]
  					 ifNotNil: [(objectMemory numBytesOf: m selector) = s size
+ 							and: [(self strncmp: s
+ 											_: (m selector + objectMemory baseHeaderSize)
+ 											_: (objectMemory numBytesOf: m selector)) = 0]]) ifTrue:
- 							and: [(self str: s
- 									n: (m selector + objectMemory baseHeaderSize)
- 									cmp: (objectMemory numBytesOf: m selector)) = 0]]) ifTrue:
  						[cogit printCogMethod: m]]]];
  		add: 'print cog methods with method...' action:
  			[(self promptHex: 'method') ifNotNil: [:methodOop| cogMethodZone printCogMethodsWithMethod: methodOop]];
  		add: 'print cog method for...' action: [(self promptHex: 'pc') ifNotNil: [:pc| cogit printCogMethodFor: pc]];
  		add: 'print cog method header for...' action: [(self promptHex: 'pc') ifNotNil: [:pc| cogit printCogMethodHeaderFor: pc]];
  		add: 'print trampoline table' target: cogit action: #printTrampolineTable;
  		add: 'print prim trace log' action: #dumpPrimTraceLog;
  		add: 'report recent instructions' target: cogit action: #reportLastNInstructions;
  		add: (cogit printRegisters
  				ifTrue: ['no print registers each instruction']
  				ifFalse: ['print registers each instruction'])
  			action: [cogit printRegisters: cogit printRegisters not];
  		add: (cogit printInstructions
  				ifTrue: ['no print instructions each instruction']
  				ifFalse: ['print instructions each instruction'])
  			action: [cogit printInstructions: cogit printInstructions not];
  		addLine;
  		add: (cogit singleStep
  				ifTrue: ['no single step']
  				ifFalse: ['single step'])
  			action: [cogit singleStep: cogit singleStep not];
  		add: 'click step' action: [cogit setClickStepBreakBlock];
  		add: 'set break pc', cogit breakPC menuPrompt, '...-ve to disable or remove' action: [cogit promptForBreakPC];
  		add: 'set break count...' action: [|s| s := UIManager default request: 'break count (dec)'.
  											s notEmpty ifTrue: [breakCount := Integer readFrom: s readStream]];
  		add: 'set break selector...' action: [|s| s := UIManager default request: 'break selector (MNU:foo for MNU)'.
  											s notEmpty ifTrue:
  												[(s size > 4 and: [s beginsWith: 'MNU:'])
  													ifTrue: [self setBreakMNUSelector: (s allButFirst: 4)]
  													ifFalse: [self setBreakSelector: s]]];
  		add: 'set break block...' action: [|s| s := UIManager default request: 'break block' initialAnswer: '[:theCogit| false]'.
  											s notEmpty ifTrue: [self setBreakBlockFromString: s]];
  		add: 'set cogit break method...' action: [(self promptHex: 'cogit breakMethod') ifNotNil: [:bm| cogit setBreakMethod: bm]];
  		add: (printBytecodeAtEachStep
  				ifTrue: ['no print bytecode each bytecode']
  				ifFalse: ['print bytecode each bytecode'])
  			action: [self ensureDebugAtEachStepBlock.
  					printBytecodeAtEachStep := printBytecodeAtEachStep not];
  		add: (printFrameAtEachStep
  				ifTrue: ['no print frame each bytecode']
  				ifFalse: ['print frame each bytecode'])
  			action: [self ensureDebugAtEachStepBlock.
  					printFrameAtEachStep := printFrameAtEachStep not].
  	^aMenuMorph!

Item was changed:
  ----- Method: Cogit>>cogMNUPICSelector:receiver:methodOperand:numArgs: (in category 'in-line cacheing') -----
  cogMNUPICSelector: selector receiver: rcvr methodOperand: methodOperand numArgs: numArgs
  	<api>
  	"Attempt to create a one-case PIC for an MNU.
  	 The tag for the case is at the send site and so doesn't need to be generated."
  	<returnTypeC: #'CogMethod *'>
  	| startAddress |
  	((objectMemory isYoung: selector)
  	 or: [(objectRepresentation inlineCacheTagForInstance: rcvr) = self picAbortDiscriminatorValue]) ifTrue:
  		[^0].
  	coInterpreter
  		compilationBreak: selector
  		point: (objectMemory numBytesOf: selector)
  		isMNUCase: true.
  	self assert: endCPICCase0 notNil.
  	"get memory in the code zone for the CPIC; if that fails we return an error code for the sender to use to work out how to blow up"
  	startAddress := methodZone allocate: closedPICSize.
  	startAddress = 0 ifTrue:
  		[coInterpreter callForCogCompiledCodeCompaction.
  		 ^0].
  
  	"memcpy the prototype across to our allocated space; because anything else would be silly"
  	objectMemory
+ 		memcpy: (self cCoerceSimple: startAddress to: #'CogMethod *')
+ 		_: (self cCoerceSimple: cPICPrototype to: #'CogMethod *')
+ 		_: closedPICSize.
- 		mem: (self cCoerceSimple: startAddress to: #'CogMethod *')
- 		cp: (self cCoerceSimple: cPICPrototype to: #'CogMethod *')
- 		y: closedPICSize.
  	
  	self configureMNUCPIC: (self cCoerceSimple: startAddress to: #'CogMethod *')
  		methodOperand: methodOperand
  		numArgs: numArgs
  		delta: startAddress - cPICPrototype.
  
  	^self
  		fillInCPICHeader: (self cCoerceSimple: startAddress to: #'CogMethod *')
  		numArgs: numArgs
  		numCases: 1
  		hasMNUCase: true
  		selector: selector !

Item was changed:
  ----- Method: Cogit>>cogPICSelector:numArgs:Case0Method:Case1Method:tag:isMNUCase: (in category 'in-line cacheing') -----
  cogPICSelector: selector numArgs: numArgs Case0Method: case0CogMethod Case1Method: case1MethodOrNil tag: case1Tag isMNUCase: isMNUCase
  	"Attempt to create a two-case PIC for case0CogMethod and  case1Method,case1Tag.
  	 The tag for case0CogMethod is at the send site and so doesn't need to be generated.
  	 case1Method may be any of
  		- a Cog method; link to its unchecked entry-point
  		- a CompiledMethod; link to ceInterpretMethodFromPIC:
  		- a CompiledMethod; link to ceMNUFromPICMNUMethod:receiver:"
  	<var: #case0CogMethod type: #'CogMethod *'>
  	<returnTypeC: #'CogMethod *'>
  	| startAddress |
  	(objectMemory isYoung: selector) ifTrue:
  		[^self cCoerceSimple: YoungSelectorInPIC to: #'CogMethod *'].
  	coInterpreter
  		compilationBreak: selector
  		point: (objectMemory numBytesOf: selector)
  		isMNUCase: isMNUCase.
  	
  	"get memory in the code zone for the CPIC; if that fails we return an error code for the sender to use to work out how to blow up"
  	startAddress := methodZone allocate: closedPICSize.
  	startAddress = 0 ifTrue:
  		[^self cCoerceSimple: InsufficientCodeSpace to: #'CogMethod *'].
  
  	"memcpy the prototype across to our allocated space; because anything else would be silly"
  	objectMemory
+ 		memcpy: (self cCoerceSimple: startAddress to: #'CogMethod *')
+ 		_: (self cCoerceSimple: cPICPrototype to: #'CogMethod *')
+ 		_: closedPICSize.
- 		mem: (self cCoerceSimple: startAddress to: #'CogMethod *')
- 		cp: (self cCoerceSimple: cPICPrototype to: #'CogMethod *')
- 		y: closedPICSize.
  	
  	self configureCPIC: (self cCoerceSimple: startAddress to: #'CogMethod *')
  		Case0: case0CogMethod
  		Case1Method: case1MethodOrNil
  		tag: case1Tag
  		isMNUCase: isMNUCase
  		numArgs: numArgs
  		delta: startAddress - cPICPrototype .
  
  	^self
  		fillInCPICHeader: (self cCoerceSimple: startAddress to: #'CogMethod *')
  		numArgs: numArgs
  		numCases: 2
  		hasMNUCase: isMNUCase
  		selector: selector !

Item was changed:
  ----- Method: FFIPlugin>>primitiveFFIDoubleAt (in category 'primitives') -----
  primitiveFFIDoubleAt
  	"Return a (signed or unsigned) n byte integer from the given byte offset."
  	| byteOffset rcvr addr floatValue |
  	<export: true>
  	<inline: false>
  	<var: #floatValue type: #double>
  	byteOffset := interpreterProxy stackIntegerValue: 0.
  	rcvr := interpreterProxy stackObjectValue: 1.
  	interpreterProxy failed ifTrue:[^0].
  	addr := self ffiAddressOf: rcvr startingAt: byteOffset size: 8.
  	interpreterProxy failed ifTrue:[^0].
+ 	self memcpy: (self addressOf: floatValue) _: addr _: (self sizeof: floatValue).
- 	self mem: (self addressOf: floatValue) cp: addr y: (self sizeof: floatValue).
  	interpreterProxy pop: 2.
  	^interpreterProxy pushFloat: floatValue
  !

Item was changed:
  ----- Method: FFIPlugin>>primitiveFFIDoubleAtPut (in category 'primitives') -----
  primitiveFFIDoubleAtPut
  	"Return a (signed or unsigned) n byte integer from the given byte offset."
  	| byteOffset rcvr addr floatValue floatOop |
  	<export: true>
  	<inline: false>
  	<var: #floatValue type: #double>
  	floatOop := interpreterProxy stackValue: 0.
  	(interpreterProxy isIntegerObject: floatOop)
  		ifTrue:[floatValue := self cCoerce: (interpreterProxy integerValueOf: floatOop) to:'double']
  		ifFalse:[floatValue := self cCoerce: (interpreterProxy floatValueOf: floatOop) to:'double'].
  	byteOffset := interpreterProxy stackIntegerValue: 1.
  	rcvr := interpreterProxy stackObjectValue: 2.
  	interpreterProxy failed ifTrue:[^0].
  	addr := self ffiAddressOf: rcvr startingAt: byteOffset size: 8.
  	interpreterProxy failed ifTrue:[^0].
+ 	self memcpy: addr _: (self addressOf: floatValue) _: (self sizeof: floatValue).
- 	self mem: addr cp: (self addressOf: floatValue) y: (self sizeof: floatValue).
  	interpreterProxy pop: 3.
  	^interpreterProxy push: floatOop!

Item was changed:
  ----- Method: FFIPlugin>>primitiveFFIFloatAt (in category 'primitives') -----
  primitiveFFIFloatAt
  	"Return a (signed or unsigned) n byte integer from the given byte offset."
  	| byteOffset rcvr addr floatValue |
  	<export: true>
  	<inline: false>
  	<var: #floatValue type: #float>
  	byteOffset := interpreterProxy stackIntegerValue: 0.
  	rcvr := interpreterProxy stackObjectValue: 1.
  	interpreterProxy failed ifTrue:[^0].
  	addr := self ffiAddressOf: rcvr startingAt: byteOffset size: 4.
  	interpreterProxy failed ifTrue:[^0].
+ 	self memcpy: (self addressOf: floatValue) _: addr _: (self sizeof: floatValue).
- 	self mem: (self addressOf: floatValue) cp: addr y: (self sizeof: floatValue).
  	interpreterProxy pop: 2.
  	^interpreterProxy pushFloat: floatValue!

Item was changed:
  ----- Method: FFIPlugin>>primitiveFFIFloatAtPut (in category 'primitives') -----
  primitiveFFIFloatAtPut
  	"Return a (signed or unsigned) n byte integer from the given byte offset."
  	| byteOffset rcvr addr floatValue floatOop |
  	<export: true>
  	<inline: false>
  	<var: #floatValue type: #float>
  	floatOop := interpreterProxy stackValue: 0.
  	(interpreterProxy isIntegerObject: floatOop)
  		ifTrue:[floatValue := self cCoerce: (interpreterProxy integerValueOf: floatOop) to:'float']
  		ifFalse:[floatValue := self cCoerce: (interpreterProxy floatValueOf: floatOop) to:'float'].
  	byteOffset := interpreterProxy stackIntegerValue: 1.
  	rcvr := interpreterProxy stackObjectValue: 2.
  	interpreterProxy failed ifTrue:[^0].
  	addr := self ffiAddressOf: rcvr startingAt: byteOffset size: 4.
  	interpreterProxy failed ifTrue:[^0].
+ 	self memcpy: addr _: (self addressOf: floatValue) _: (self sizeof: floatValue).
- 	self mem: addr cp: (self addressOf: floatValue) y: (self sizeof: floatValue).
  	interpreterProxy pop: 3.
  	^interpreterProxy push: floatOop!

Item was changed:
  ----- Method: FilePlugin>>primitiveFileStdioHandles (in category 'file primitives') -----
  primitiveFileStdioHandles
  	"Answer an Array of file handles for standard in, standard out and standard error,
  	 with nil in entries that are unvailable, e.g. because the platform does not provide
  	 standard error, etc.  Fail if an error occurs determining the stdio handles,
  	 if the security plugin denies access or if memory runs out."
  	| fileRecords result validMask |
  	<export: true>
  	<var: 'fileRecords' declareC: 'SQFile fileRecords[3]'>
  	sHFAfn ~= 0 ifTrue:
  		[(self cCode: ' ((sqInt (*)(void))sHFAfn)()' inSmalltalk: [true]) ifFalse:
  			[^interpreterProxy primitiveFailFor: PrimErrUnsupported]].
  	self cCode: '' inSmalltalk: [fileRecords := Array new: 3].
  	validMask := self sqFileStdioHandlesInto: fileRecords.
  	validMask < 0 ifTrue:
  		[^interpreterProxy primitiveFailForOSError: validMask].
  	result := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: 3.
  	result = nil ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  	interpreterProxy pushRemappableOop: result.
  	0 to: 2 do:
  		[:index|
  		(validMask bitAnd: (1 << index)) ~= 0 ifTrue:
  			[result := interpreterProxy instantiateClass: interpreterProxy classByteArray indexableSize: self fileRecordSize.
  			 result = nil ifTrue:
  				[interpreterProxy popRemappableOop.
  				^interpreterProxy primitiveFailFor: PrimErrNoMemory].
  			 interpreterProxy storePointer: index ofObject: interpreterProxy topRemappableOop withValue: result.
  			 self
  				cCode:
+ 					[self memcpy: (interpreterProxy firstIndexableField: result)
+ 						_: (self addressOf: (fileRecords at: index))
+ 						_: self fileRecordSize]
- 					[self mem: (interpreterProxy firstIndexableField: result)
- 						cp: (self addressOf: (fileRecords at: index))
- 						y: self fileRecordSize]
  				inSmalltalk:
  					[(interpreterProxy firstIndexableField: result)
  						unitSize: interpreterProxy wordSize;
  						at: 0 put: (fileRecords at: index + 1)]]].
  	 "In the non-Spur threaded VM ensure the handles are old, so that sqFileReadIntoAt is unaffected
  	  by incremental GCs.  See platforms/Cross/plugins/FilePlugin/sqFilePluginBasicPrims.c.  The Spur
  	  VM uses pinning, so it doesn't need the GC."
  	self cppIf: COGMTVM
  		ifTrue: [self cppIf: SPURVM
  					ifTrue: []
  					ifFalse: [interpreterProxy fullGC]].
  	result := interpreterProxy popRemappableOop.
  	interpreterProxy methodReturnValue: result!

Item was changed:
  ----- Method: HostWindowPlugin>>primitiveHostWindowIcon:path: (in category 'system primitives') -----
  primitiveHostWindowIcon: id path: pathString
  	"Set the icon of the window by fetching the logo in given path. Fail if the windowIndex is invalid or the platform routine returns -1 to indicate failure"
  	| res pathLength |
  	self primitive: 'primitiveHostWindowIcon'
  		parameters: #(SmallInteger ByteArray).
  	pathLength := interpreterProxy slotSizeOf: pathString cPtrAsOop.
+ 	res := self ioSetIconOfWindow: id _: pathString _: pathLength.
- 	res := self cCode: 'ioSetIconOfWindow(id, pathString, pathLength)'.
  	res = 0 ifTrue: [^ self ].
  	res = -1 ifTrue: [^ interpreterProxy primitiveFailFor: PrimErrBadArgument ].
  	"As the GetLastError function can return 0, but it is still an error, 1 is added to all the GetLastError error codes."
  	^ interpreterProxy primitiveFail!

Item was changed:
  ----- Method: HostWindowPlugin>>primitiveHostWindowTitle:string: (in category 'system primitives') -----
  primitiveHostWindowTitle: id string: titleString
  	"Set the title bar label of the window. Fail if the windowIndex is invalid or the platform routine returns -1 to indicate failure"
+ 	| titleLength |
- 	| res titleLength |
  	self primitive: 'primitiveHostWindowTitle'
  		parameters: #(SmallInteger String).
  	titleLength := interpreterProxy slotSizeOf: titleString cPtrAsOop.
+ 	(self ioSetTitleOfWindow: id _: titleString _: titleLength) = -1 ifTrue:
+ 		[interpreterProxy primitiveFail]!
- 	res := self cCode: 'ioSetTitleOfWindow(id, titleString, titleLength)'.
- 	res = -1
- 		ifTrue: [interpreterProxy primitiveFail]!

Item was changed:
  ----- Method: HostWindowPlugin>>primitiveShowHostWindow:bits:width:height:depth:left:right:top:bottom: (in category 'system primitives') -----
  primitiveShowHostWindow: windowIndex bits: dispBits width: w height: h depth: d
  left: left right: right top: top bottom: bottom
  "Host window analogue of DisplayScreen> primShowRectLeft:right:top:bottom:
  (Interpreter>primitiveShowDisplayRect) which takes the window index, bitmap
  details and the rectangle bounds. Fail if the windowIndex is invalid or the
  platform routine returns false to indicate failure"
- 	|ok|
  	self primitive: 'primitiveShowHostWindowRect'
  		parameters: #(SmallInteger WordArray SmallInteger SmallInteger SmallInteger
  SmallInteger SmallInteger SmallInteger SmallInteger).
  
  	"Tell the vm to copy pixel's from dispBits to the screen - this is just
  ioShowDisplay with the extra parameter of the windowIndex integer"
+ 	(self ioShowDisplayOnWindow: dispBits _: w _: h _: d _: left _: right _: top _: bottom _: windowIndex) ifFalse:
+ 		[interpreterProxy primitiveFail]!
- 	ok := self cCode: 'ioShowDisplayOnWindow(dispBits, w, h, d, left, right, top,
- bottom, windowIndex)'.
- 	ok ifFalse:[interpreterProxy primitiveFail]!

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 isKindOfInteger: repl)
  		ifTrue:
  			[src := (interpreterProxy positiveMachineIntegerValueOf: 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 memmove: dest asVoidPointer _: src asVoidPointer _: count.
- 	self mem: dest asVoidPointer mo: src asVoidPointer ve: count.
  
  	interpreterProxy pop: interpreterProxy methodArgumentCount!

Item was changed:
  ----- Method: IA32ABIPlugin>>primDoubleAt (in category 'primitives-accessing') -----
  primDoubleAt
  	"Answer the 64-bit double starting at the given byte offset (little endian)."
  	"<Alien> doubleAt: index <Integer> ^<Float>
  		<primitive: 'primDoubleAt' error: errorCode module: 'IA32ABI'>"
  	| byteOffset rcvr startAddr addr floatValue |
  	<export: true>
  	<var: #floatValue type: #double>
  
  	byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 0) - 1.
  	rcvr := interpreterProxy stackObjectValue: 1.
  	interpreterProxy failed ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	(self index: byteOffset length: 8 inRange: rcvr) ifFalse:
  		[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
  	(startAddr := self startOfData: rcvr) = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
  	addr := startAddr + byteOffset.
+ 	self memcpy: (self addressOf: floatValue) _: addr _: (self sizeof: floatValue).
- 	self mem: (self addressOf: floatValue) cp: addr y: (self sizeof: floatValue).
  	interpreterProxy pop: 2.
  	^interpreterProxy pushFloat: floatValue!

Item was changed:
  ----- Method: IA32ABIPlugin>>primDoubleAtPut (in category 'primitives-accessing') -----
  primDoubleAtPut
  	"Store a double into 64 bits starting at the given byte offset (little endian)."
  	"<Alien> doubleAt: index <Integer> put: value <Float | Integer> ^<Float | Integer>
  		<primitive: 'primDoubleAtPut' error: errorCode module: 'IA32ABI'>"
  	| byteOffset rcvr startAddr addr valueOop floatValue |
  	<export: true>
  	<var: #floatValue type: #double>
  
  	valueOop := interpreterProxy stackValue: 0.
  	(interpreterProxy isIntegerObject: valueOop)
  		ifTrue:[floatValue := self cCoerce: (interpreterProxy integerValueOf: valueOop) to: #double]
  		ifFalse:[floatValue := self cCoerce: (interpreterProxy floatValueOf: valueOop) to: #double].
  	byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 1) - 1.
  	rcvr := interpreterProxy stackObjectValue: 2.
  	interpreterProxy failed ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	(self index: byteOffset length: 8 inRange: rcvr) ifFalse:
  		[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
  	(interpreterProxy isOopImmutable: rcvr) ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrNoModification].
  	(startAddr := self startOfData: rcvr) = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
  	addr := startAddr + byteOffset.
+ 	self memcpy: addr _: (self addressOf: floatValue) _: (self sizeof: floatValue).
- 	self mem: addr cp: (self addressOf: floatValue) y: (self sizeof: floatValue).
  	interpreterProxy methodReturnValue: valueOop!

Item was changed:
  ----- Method: IA32ABIPlugin>>primFloatAt (in category 'primitives-accessing') -----
  primFloatAt
  	"Answer the 32-bit float starting at the given byte offset (little endian)."
  	"<Alien> floatAt: index <Integer> ^<Float>
  		<primitive: 'primFloatAt' error: errorCode module: 'IA32ABI'>"
  	| byteOffset rcvr startAddr addr floatValue |
  	<export: true>
  	<var: #floatValue type: #float>
  
  	byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 0) - 1.
  	rcvr := interpreterProxy stackObjectValue: 1.
  	interpreterProxy failed ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	(self index: byteOffset length: 4 inRange: rcvr) ifFalse:
  		[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
  	(startAddr := self startOfData: rcvr) = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
  	addr := startAddr + byteOffset.
+ 	self memcpy: (self addressOf: floatValue) _: addr _: (self sizeof: floatValue).
- 	self mem: (self addressOf: floatValue) cp: addr y: (self sizeof: floatValue).
  	interpreterProxy pop: 2.
  	^interpreterProxy pushFloat: floatValue!

Item was changed:
  ----- Method: IA32ABIPlugin>>primFloatAtPut (in category 'primitives-accessing') -----
  primFloatAtPut
  	"Store a float into 32 bits starting at the given byte offset (little endian)."
  	"<Alien> floatAt: index <Integer> put: value <Float | Integer> ^<Float | Integer>
  		<primitive: 'primFloatAtPut' error: errorCode module: 'IA32ABI'>"
  	| byteOffset rcvr startAddr addr valueOop floatValue |
  	<export: true>
  	<var: #floatValue type: #float>
  
  	valueOop := interpreterProxy stackValue: 0.
  	(interpreterProxy isIntegerObject: valueOop)
  		ifTrue:[floatValue := self cCoerce: (interpreterProxy integerValueOf: valueOop) to: #double]
  		ifFalse:[floatValue := self cCoerce: (interpreterProxy floatValueOf: valueOop) to: #double].
  	byteOffset := (interpreterProxy stackPositiveMachineIntegerValue: 1) - 1.
  	rcvr := interpreterProxy stackObjectValue: 2.
  	interpreterProxy failed ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	(self index: byteOffset length: 4 inRange: rcvr) ifFalse:
  		[^interpreterProxy primitiveFailFor: PrimErrBadIndex].
  	(interpreterProxy isOopImmutable: rcvr) ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrNoModification].
  	(startAddr := self startOfData: rcvr) = 0 ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadReceiver].
  	addr := startAddr + byteOffset.
+ 	self memcpy: addr _: (self addressOf: floatValue) _: (self sizeof: floatValue).
- 	self mem: addr cp: (self addressOf: floatValue) y: (self sizeof: floatValue).
  	interpreterProxy methodReturnValue: valueOop!

Item was changed:
  ----- Method: IA32ABIPlugin>>primReturnFromContextThrough (in category 'primitives-callbacks') -----
  primReturnFromContextThrough
  	"Return a result from a callback to the callback's callee.  The primitive
  	 has a signature of either of the forms:
  		result <FFICallbackResult> primReturnFromContext: callbackContext <MethodContext> through: jmpBuf <Integer>
  		result <FFICallbackResult> primSignal: aSemaphore <Semaphore> andReturnFromContext: callbackContext <MethodContext> through: jmpBuf <Integer>
  			<primitive: 'primReturnFromContextThrough' error: errorCode module: 'IA32ABI'>.
  	 If of the second form answer true if this is not the most recent callback, and signal aSemaphore
  	 if it is, so as to implement LIFO ordering of callbacks."
  	<export: true>
  	<legacy>
  	| mac vmCallbackContext vmCallbackReturnValue isMostRecent |
  	<var: #vmCallbackContext type: #'VMCallbackContext *'>
  	<var: #vmCallbackReturnValue type: #'VMCallbackReturnValue *'>
  	vmCallbackContext := self cCoerceSimple: (interpreterProxy positiveMachineIntegerValueOf: (interpreterProxy stackValue: 0))
  								to: #'VMCallbackContext *'.
  	(interpreterProxy failed or: [vmCallbackContext = 0]) ifTrue:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  
  	(mac := interpreterProxy methodArgumentCount) = 3 ifTrue:
  		[isMostRecent := vmCallbackContext = self getMostRecentCallbackContext.
  		isMostRecent ifFalse:
  			[interpreterProxy methodReturnValue: interpreterProxy trueObject.
  			^nil].
  		(interpreterProxy fetchClassOf: (interpreterProxy stackValue: 2)) = interpreterProxy classSemaphore
  			ifFalse: [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  		[interpreterProxy signalNoResume: (interpreterProxy stackValue: 2)] whileFalse].
  	vmCallbackReturnValue := self cCoerceSimple: (self startOfData: (interpreterProxy stackValue: mac))
  									to: #'VMCallbackReturnValue *'.
  	self cCode: "C needs a typedef for structs to be assigned, but that implies a struct class for just one assignment."
+ 		[self memcpy: (self addressOf: vmCallbackContext rvs)
+ 			_: (self addressOf: vmCallbackReturnValue crvrvs)
+ 			_: (self sizeof: vmCallbackContext rvs)]
- 		[self mem: (self addressOf: vmCallbackContext rvs)
- 			cp: (self addressOf: vmCallbackReturnValue crvrvs)
- 			y: (self sizeof: vmCallbackContext rvs)]
  		inSmalltalk: [vmCallbackContext rvs: vmCallbackReturnValue crvrvs].
  	(interpreterProxy
  		returnAs: (interpreterProxy integerObjectOf: vmCallbackReturnValue type + 1)
  		ThroughCallback: vmCallbackContext
  		Context: (interpreterProxy stackValue: 1)) ifFalse:
  			[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	"NOTREACHED"!

Item was removed:
- ----- Method: InterpreterPlugin>>st:rn:cpy: (in category 'simulation support') -----
- st: aString rn: bString cpy: n
- 	<doNotGenerate>
- 	^interpreterProxy st: aString rn: bString cpy: n!

Item was added:
+ ----- Method: InterpreterPlugin>>strncpy:_:_: (in category 'simulation support') -----
+ strncpy: aString _: bString _: n
+ 	<doNotGenerate>
+ 	^interpreterProxy strncpy: aString _: bString _: n!

Item was changed:
  ----- Method: InterpreterPrimitives>>cStringOrNullFor: (in category 'primitive support') -----
  cStringOrNullFor: oop
  	"Answer either a malloced string with the null-terminated contents of oop if oop is a string,
  	 or the null pointer if oop is nil, or fail.  It is the client's responsibility to free the string later."
  	<api>
  	<returnTypeC: #'char *'>
  	<inline: false>
  	| isString len cString |
  	<var: 'cString' type: #'char *'>
  	isString := self isInstanceOfClassByteString: oop.
  	isString ifFalse:
  		[oop ~= objectMemory nilObject ifTrue:
  			[self primitiveFailFor: PrimErrBadArgument].
  		 ^0].
  	len := objectMemory lengthOf: oop.
  	len = 0 ifTrue:
  		[^0].
  	cString := self malloc: len + 1.
  	cString ifNil:
  		[self primitiveFailFor: PrimErrNoCMemory.
  		 ^0].
+ 	self memcpy: cString _: (objectMemory firstIndexableField: oop) _: len.
- 	self mem: cString cp: (objectMemory firstIndexableField: oop) y: len.
  	cString at: (self cCode: [len] inSmalltalk: [len + 1]) put: 0.
  	^cString!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveCopyObject (in category 'object access primitives') -----
  primitiveCopyObject
  	"Primitive. Copy the state of the receiver from the argument. 
  		Fail if receiver and argument are of a different class.
  		Fail if the receiver or argument are contexts (because of context-to-stack mapping).
  		Fail if receiver and argument have different lengths (for indexable objects).
  		Fail if the objects are not in a fit state to be copied (e.g. married contexts and Cogged methods)"
  	| rcvr arg length |
  	self methodArgumentCount >= 1 ifFalse:
  		[^self primitiveFailFor: PrimErrBadNumArgs].
  	arg := self stackTop.
  	rcvr := self stackValue: 1.
  	(objectMemory isImmediate: rcvr) ifTrue:
  		[^self primitiveFailFor: PrimErrBadReceiver].
  	(objectMemory isImmediate: arg) ifTrue:
  		[^self primitiveFailFor: PrimErrBadArgument].
  
  	(objectMemory fetchClassTagOfNonImm: rcvr)
  		~= (objectMemory fetchClassTagOfNonImm: arg) ifTrue:
  		[^self primitiveFailFor: PrimErrBadArgument].
  
  	(objectMemory isWordsOrBytesNonImm: rcvr)
  		ifTrue:
  			[length := objectMemory numBytesOf: rcvr.
  			((objectMemory formatOf: rcvr) = (objectMemory formatOf: arg)
  			  and: [length = (objectMemory numBytesOf: arg)]) ifFalse:
  				[^self primitiveFailFor: PrimErrBadArgument].
+ 			 self memcpy: (rcvr + objectMemory baseHeaderSize) asVoidPointer
+ 				_: (arg + objectMemory baseHeaderSize) asVoidPointer
+ 				_: length]
- 			 self mem: (rcvr + objectMemory baseHeaderSize) asVoidPointer
- 				cp: (arg + objectMemory baseHeaderSize) asVoidPointer
- 				y: length]
  		ifFalse:
  			[(self isAppropriateForCopyObject: rcvr) ifFalse:
  				[^self primitiveFailFor: PrimErrBadReceiver].
  			 length := objectMemory numSlotsOf: rcvr.
  			 ((self isAppropriateForCopyObject: arg)
  			  and: [length = (objectMemory lengthOf: arg)]) ifFalse:
  				[^self primitiveFailFor: PrimErrBadArgument].
  			 0 to: length - 1 do:
  				[:i|
  				objectMemory
  					storePointer: i
  					ofObject: rcvr
  					withValue: (objectMemory fetchPointer: i ofObject: arg)]].
  
  	"Note: The above could be faster for young receivers but I don't think it'll matter"
  	self pop: self methodArgumentCount "pop arg; answer receiver"!

Item was changed:
  ----- Method: LargeIntegersPlugin>>primGetModuleName (in category 'control & support primitives') -----
  primGetModuleName
  	"If calling this primitive fails, then C module does not exist."
  	| strLen strOop |
  	self debugCode: [self msg: 'primGetModuleName'].
  	self
  		primitive: 'primGetModuleName'
  		parameters: #()
  		receiver: #Oop.
  	strLen := self strlen: self getModuleName.
  	strOop := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: strLen.
+ 	self strncpy: (interpreterProxy firstIndexableField: strOop)
+ 		_: self getModuleName
+ 		_: strLen.
- 	self st: (interpreterProxy firstIndexableField: strOop)
- 		rn: self getModuleName
- 		cpy: strLen.
  	^strOop!

Item was changed:
  ----- Method: MIDIPlugin>>primitiveMIDIGetPortName: (in category 'primitives') -----
  primitiveMIDIGetPortName: portNum
  	| portName sz nameObj |
  	<var: #portName declareC: 'char portName[256]'>
  	self primitive: 'primitiveMIDIGetPortName' parameters: #(SmallInteger).
  
  	sz := self sqMIDIGet: portNum Port: portName Name: 255.
  	nameObj := interpreterProxy instantiateClass: interpreterProxy classString indexableSize: sz.
  	interpreterProxy failed ifTrue: [^nil].
+ 	self memcpy: (nameObj asValue: String) _: portName _: sz.
- 	self mem: (nameObj asValue: String) cp: portName y: sz.
  	^nameObj!

Item was changed:
  ----- Method: NewObjectMemory>>findString: (in category 'debug support') -----
  findString: aCString
  	"Print the oops of all string-like things that have the same characters as aCString"
  	<api>
  	<var: #aCString type: #'char *'>
  	| cssz obj sz |
  	cssz := self strlen: aCString.
  	obj := self firstObject.
  	[self oop: obj isLessThan: freeStart] whileTrue:
  		[(self isFreeObject: obj)
  			ifTrue:
  				[sz := self sizeOfFree: obj]
  			ifFalse:
  				[((self isBytesNonImm: obj)
  				  and: [(self lengthOf: obj) = cssz
+ 				  and: [(self strncmp: aCString _: (self pointerForOop: obj + self baseHeaderSize) _: cssz) = 0]]) ifTrue:
- 				  and: [(self str: aCString n: (self pointerForOop: obj + self baseHeaderSize) cmp: cssz) = 0]]) ifTrue:
  					[coInterpreter printHex: obj; space; printOopShort: obj; cr].
  				 sz := self sizeBitsOf: obj].
  		 obj := self oopFromChunk: obj + sz]!

Item was changed:
  ----- Method: NewObjectMemory>>findStringBeginningWith: (in category 'debug support') -----
  findStringBeginningWith: aCString
  	"Print the oops of all string-like things that start with the same characters as aCString"
  	<api>
  	<var: #aCString type: #'char *'>
  	| cssz obj sz |
  	cssz := self strlen: aCString.
  	obj := self firstObject.
  	[self oop: obj isLessThan: freeStart] whileTrue:
  		[(self isFreeObject: obj)
  			ifTrue:
  				[sz := self sizeOfFree: obj]
  			ifFalse:
  				[((self isBytesNonImm: obj)
  				  and: [(self lengthOf: obj) >= cssz
+ 				  and: [(self strncmp: aCString _: (self pointerForOop: obj + self baseHeaderSize) _: cssz) = 0]]) ifTrue:
- 				  and: [(self str: aCString n: (self pointerForOop: obj + self baseHeaderSize) cmp: cssz) = 0]]) ifTrue:
  					[coInterpreter printHex: obj; space; printNum: (self lengthOf: obj); space; printOopShort: obj; cr].
  				 sz := self sizeBitsOf: obj].
  		 obj := self oopFromChunk: obj + sz]!

Item was changed:
  ----- Method: ObjectMemory>>stringForCString: (in category 'primitive support') -----
  stringForCString: aCString
  	"Answer a new String copied from a null-terminated C string,
  	 or nil if out of memory.
  	 Caution: This may invoke the garbage collector."
  	<api>
  	<var: 'aCString' type: 'const char *'>
  	<inline: false>
  	| len newString |
  	len := self strlen: aCString.
  	newString := self instantiateClass: (self splObj: ClassByteString) indexableSize: len.
  	newString ifNotNil:
+ 		[self strncpy: (self cCoerceSimple: newString + self baseHeaderSize to: #'char *')
+ 			_: aCString
+ 			_: len]. "(char *)strncpy()"
- 		[self st: (self cCoerceSimple: newString + self baseHeaderSize to: #'char *')
- 			rn: aCString
- 			cpy: len]. "(char *)strncpy()"
  	^newString!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>copySimStackToFixup: (in category 'bytecode generator support') -----
  copySimStackToFixup: fixup
  	<var: #fixup type: #'BytecodeFixup *'>
  	<inline: true>
+ 	self cCode: [self memcpy: fixup mergeSimStack _: simStack _: simStackPtr + 1 * (self sizeof: CogSimStackEntry)]
- 	self cCode: [self mem: fixup mergeSimStack cp: simStack y: simStackPtr + 1 * (self sizeof: CogSimStackEntry)]
  		inSmalltalk: [0 to: simStackPtr do:
  						[:i|
  						fixup mergeSimStack at: i put: (simStack at: i) copy]]!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>copySimStackToScratch: (in category 'bytecode generator support') -----
  copySimStackToScratch: spillBase
  	<inline: true>
  	self assert: (spillBase > methodOrBlockNumTemps
  				or: [self maybeCompilingFirstPassOfBlockWithInitialPushNil and: [spillBase > methodOrBlockNumArgs]]).
  	scratchBytecodePC = bytecodePC ifTrue:
  		[^self].
  	scratchBytecodePC := bytecodePC.
+ 	self cCode: [self memcpy: scratchSimStack _: simStack _: self simStackSlots * (self sizeof: CogSimStackEntry)]
- 	self cCode: [self mem: scratchSimStack cp: simStack y: self simStackSlots * (self sizeof: CogSimStackEntry)]
  		inSmalltalk: [0 to: simStackPtr do:
  						[:i|
  						scratchSimStack at: i put: (simStack at: i) copy]].
  	scratchSpillBase := spillBase!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>restoreSimStackFromScratch (in category 'bytecode generator support') -----
  restoreSimStackFromScratch
  	<inline: true>
+ 	self cCode: [self memcpy: simStack _: scratchSimStack _: self simStackSlots * (self sizeof: CogSimStackEntry)]
- 	self cCode: [self mem: simStack cp: scratchSimStack y: self simStackSlots * (self sizeof: CogSimStackEntry)]
  		inSmalltalk: [0 to: simStackPtr do:
  						[:i|
  						simStack at: i put: (scratchSimStack at: i) copy]].
  	simSpillBase := scratchSpillBase!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>setMergeSimStackOf: (in category 'bytecode generator support') -----
  setMergeSimStackOf: fixup
  	<var: #fixup type: #'BytecodeFixup *'>
  	fixup mergeSimStack
  		ifNil:
  			[self assert: nextFixup <= numFixups.
  			 self cCode: [fixup mergeSimStack: mergeSimStacksBase + (nextFixup * self simStackSlots * (self sizeof: CogSimStackEntry))].
  			 nextFixup := nextFixup + 1]
  		ifNotNil:
  			[self assert: fixup simStackPtr = simStackPtr.
  			 0 to: simStackPtr do:
  				[:i|
  				self assert: ((self simStackAt: i) isSameEntryAs: (self addressOf: (fixup mergeSimStack at: i))).
  				(self simStackAt: i) liveRegister ~= (self addressOf: (fixup mergeSimStack at: i)) liveRegister ifTrue:
  					[(self simStackAt: i) liveRegister: NoReg]]].
  	fixup simStackPtr: simStackPtr.
+ 	self cCode: [self memcpy: fixup mergeSimStack _: simStack _: self simStackSlots * (self sizeof: CogSimStackEntry)]
- 	self cCode: [self mem: fixup mergeSimStack cp: simStack y: self simStackSlots * (self sizeof: CogSimStackEntry)]
  		inSmalltalk: [fixup mergeSimStack: self copySimStack]!

Item was changed:
  ----- Method: SimulatorHarnessForTests>>findSymbol: (in category 'utilities') -----
  findSymbol: aString
  	"Find the Symbol equal to aString in oldHeap."
  	| om size symbolClassTag |
  	symbolClassTag := (om := simulator objectMemory) rawClassTagForClass: self symbolClass.
  	size := aString size.
  	om allObjectsDo:
  		[:obj|
  		(symbolClassTag = (om fetchClassTagOfNonImm: obj)
  		 and: [(om numBytesOf: obj) = size
  		 and: ["(om fetchByte: 0 ofObject: obj) asCharacter == $C ifTrue:
  				[simulator printOopShort: obj; halt]."
+ 			(om strncmp: aString _: obj + om baseHeaderSize _: size) = 0]]) ifTrue:
- 			(om str: aString n: obj + om baseHeaderSize cmp: size) = 0]]) ifTrue:
  			[^obj]].
  	^nil!

Item was changed:
  ----- Method: SocketPluginSimulator>>sqResolverStartName:Lookup: (in category 'simulation') -----
  sqResolverStartName: aCArray Lookup: size
  	"For now don't simulate the implicit semaphore."
  	| hostName |
+ 	hostName := self strncpy: (String new: size) _: aCArray _: size.
- 	hostName := self st: (String new: size) rn: aCArray cpy: size.
  	addressForName := NetNameResolver addressForName: hostName timeout: 30.
  	resolverSemaphoreIndex ifNotNil:
  		[resolverStatus := ResolverReady.
  		 interpreterProxy signalSemaphoreWithIndex: resolverSemaphoreIndex]!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>isSmallFloatValue: (in category 'interpreter access') -----
  isSmallFloatValue: aFloat
  	<inline: true>
  	<var: #rawFloat type: #usqLong>
  	<var: #aFloat type: #double>
  	| exponent rawFloat |
  	self
+ 		cCode: [self memcpy: (self addressOf: rawFloat) _: (self addressOf: aFloat) _: (self sizeof: rawFloat)]
- 		cCode: [self mem: (self addressOf: rawFloat) cp: (self addressOf: aFloat) y: (self sizeof: rawFloat)]
  		inSmalltalk: [rawFloat := (aFloat at: 1) << 32 + (aFloat at: 2)].
  	exponent := rawFloat >> self smallFloatMantissaBits bitAnd: 16r7FF.
  	^exponent > self smallFloatExponentOffset
  	 	ifTrue: [exponent <= (255 + self smallFloatExponentOffset)]
  		ifFalse:
  			[(rawFloat bitAnd: (1 << self smallFloatMantissaBits - 1)) = 0
  				ifTrue: [exponent = 0]
  				ifFalse: [exponent = self smallFloatExponentOffset]]!

Item was removed:
- ----- Method: Spur64BitMemoryManager>>mem:mo:ve: (in category 'simulation only') -----
- mem: destAddress mo: sourceAddress ve: bytes
- 	<doNotGenerate>
- 	| dst src  |
- 	dst := destAddress asInteger.
- 	src := sourceAddress asInteger.
- 	"Emulate the c library memmove function"
- 	self assert: bytes \\ 4 = 0.
- 	destAddress > sourceAddress
- 		ifTrue:
- 			[bytes - 4 to: 0 by: -4 do:
- 				[:i| self long32At: dst + i put: (self long32At: src + i)]]
- 		ifFalse:
- 			[0 to: bytes - 4 by: 4 do:
- 				[:i| self long32At: dst + i put: (self long32At: src + i)]]!

Item was added:
+ ----- Method: Spur64BitMemoryManager>>memmove:_:_: (in category 'simulation only') -----
+ memmove: destAddress _: sourceAddress _: bytes
+ 	<doNotGenerate>
+ 	| dst src  |
+ 	dst := destAddress asInteger.
+ 	src := sourceAddress asInteger.
+ 	"Emulate the c library memmove function"
+ 	self assert: bytes \\ 4 = 0.
+ 	destAddress > sourceAddress
+ 		ifTrue:
+ 			[bytes - 4 to: 0 by: -4 do:
+ 				[:i| self long32At: dst + i put: (self long32At: src + i)]]
+ 		ifFalse:
+ 			[0 to: bytes - 4 by: 4 do:
+ 				[:i| self long32At: dst + i put: (self long32At: src + i)]]!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>smallFloatObjectOf: (in category 'interpreter access') -----
  smallFloatObjectOf: aFloat
  	"Encode the argument, aFloat in the SmallFloat range, as a tagged small float.
  	 See section 61-bit Immediate Floats in the SpurMemoryManager class comment.
  
  	 Encode:				[1s][     11 exponent     ][52mantissa] 
  	 rot sign:				[     11 exponent     ][52mantissa][1s] 
  	 sub exponent offset:	[ 000 ][8expsubset][52 mantissa][1s] 
  	 shift:					[8expsubset][52 mantissa][1s][ 000 ] 
  	 or/add tags:			[8expsubset][52mantissa][1s][3tags]"
  	<inline: true>
  	<returnTypeC: #sqInt>
  	<var: #aFloat type: #double>
  	| rawFloat rot |
  	<var: #rawFloat type: #usqLong>
  	<var: #rot type: #usqLong>
  	self assert: (self isSmallFloatValue: aFloat).
  	self
+ 		cCode: [self memcpy: (self addressOf: rawFloat) _: (self addressOf: aFloat) _: (self sizeof: rawFloat)]
- 		cCode: [self mem: (self addressOf: rawFloat) cp: (self addressOf: aFloat) y: (self sizeof: rawFloat)]
  		inSmalltalk: [rawFloat := (aFloat at: 1) << 32 + (aFloat at: 2)].
  	rot := self rotateLeft: rawFloat.
  	rot > 1 ifTrue: "a.k.a. ~= +/-0.0"
  		[rot := rot - (self smallFloatExponentOffset << (self smallFloatMantissaBits + 1)).
  		 self assert: rot > 0].
  	^self cCode: [rot << self numTagBits + self smallFloatTag]
  		inSmalltalk: [((rot << self numTagBits) bitAnd: 16rFFFFFFFFFFFFFFFF) + self smallFloatTag]!

Item was changed:
  ----- Method: Spur64BitMemoryManager>>smallFloatValueOf: (in category 'interpreter access') -----
  smallFloatValueOf: oop
  	"Answer the C double precision floating point value of the argument, a SmallFloat.
  	 See section 61-bit Immediate Floats in the SpurMemoryManager class comment.
  							msb                                              lsb 
  	 Decode:				[8expsubset][52mantissa][1s][3tags] 
  	 shift away tags:		[ 000 ][8expsubset][52mantissa][1s] 
  	 add exponent offset:	[     11 exponent     ][52mantissa][1s] 
  	 rot sign:				[1s][     11 exponent     ][52mantissa]"
  	| bits value |
  	<returnTypeC: #double>
  	<var: #value type: #double>
  	<var: #bits type: #usqLong>
  	bits := self smallFloatBitsOf: oop.
  	self cCode:
+ 			[self memcpy: (self addressOf: value) _: (self addressOf: bits) _: (self sizeof: value).
- 			[self mem: (self addressOf: value) cp: (self addressOf: bits) y: (self sizeof: value).
  			^value]
  		inSmalltalk:
  			[^(Float new: 2)
  				at: 1 put: bits >> 32;
  				at: 2 put: (bits bitAnd: 16rFFFFFFFF);
  				* 1.0 "reduce to SmallFloat64 if possible"]!

Item was changed:
  ----- Method: SpurGenerationScavenger>>copyToFutureSpace:bytes: (in category 'scavenger') -----
  copyToFutureSpace: survivor bytes: bytesInObject
  	"Copy survivor to futureSpace.  Assume it will fit (checked by sender).
  	 Answer the new oop of the object (it may have an overflow size field)."
  	<inline: true>
  	| startOfSurvivor newStart |
  	statSurvivorCount := statSurvivorCount + 1. "we hope writes are cheap..."
  	self assert: futureSurvivorStart + bytesInObject <= futureSpace limit.
  	startOfSurvivor := manager startOfObject: survivor.
  	newStart := futureSurvivorStart.
  	futureSurvivorStart := futureSurvivorStart + bytesInObject.
+ 	manager memcpy: newStart asVoidPointer _: startOfSurvivor asVoidPointer _: bytesInObject.
- 	manager mem: newStart asVoidPointer cp: startOfSurvivor asVoidPointer y: bytesInObject.
  	tenureCriterion = TenureToShrinkRT ifTrue:
  		[manager rtRefCountOf: newStart + (survivor - startOfSurvivor) put: 0].
  	^newStart + (survivor - startOfSurvivor)!

Item was changed:
  ----- Method: SpurGenerationScavenger>>copyToOldSpace:bytes:format: (in category 'scavenger') -----
  copyToOldSpace: survivor bytes: bytesInObject format: formatOfSurvivor
  	"Copy survivor to oldSpace.  Answer the new oop of the object."
  	<inline: #never> "Should be too infrequent to lower icache density of copyAndForward:"
  	| nTenures startOfSurvivor newStart newOop |
  	self assert: (formatOfSurvivor = (manager formatOf: survivor)
  				and: [((manager isMarked: survivor) not or: [tenureCriterion = MarkOnTenure])
  				and: [tenureCriterion = TenureToShrinkRT
  					or: [(manager isPinned: survivor) not
  						and: [(manager isRemembered: survivor) not]]]]).
  	nTenures := statTenures.
  	startOfSurvivor := manager startOfObject: survivor.
  	newStart := manager allocateOldSpaceChunkOfBytes: bytesInObject.
  	newStart ifNil:
  		[manager growOldSpaceByAtLeast: 0. "grow by growHeadroom"
  		 newStart := manager allocateOldSpaceChunkOfBytes: bytesInObject.
  		 newStart ifNil:
  			[self error: 'out of memory']].
  	"manager checkFreeSpace."
+ 	manager memcpy: newStart asVoidPointer _: startOfSurvivor asVoidPointer _: bytesInObject.
- 	manager mem: newStart asVoidPointer cp: startOfSurvivor asVoidPointer y: bytesInObject.
  	newOop := newStart + (survivor - startOfSurvivor).
  	tenureCriterion >= (TenureToShrinkRT min: MarkOnTenure) ifTrue:
  		[tenureCriterion = TenureToShrinkRT ifTrue:
  			[manager rtRefCountOf: newOop put: 0].
  		 tenureCriterion = MarkOnTenure ifTrue:
  			[manager setIsMarkedOf: newOop to: true]].
  	statTenures := nTenures + 1.
  	(manager isAnyPointerFormat: formatOfSurvivor) ifTrue:
  		["A very quick and dirty scan to find young referents.  If we misidentify bytes
  		  in a CompiledMethod as young we don't care; it's unlikely, and a subsequent
  		  scan of the rt will filter the object out.  But it's good to filter here because
  		  otherwise an attempt to shrink the RT may simply fill it up with new objects,
  		  and here the data is likely in the cache."
  		 manager baseHeaderSize to: bytesInObject - (survivor - startOfSurvivor) - manager wordSize by: manager wordSize do:
  			[:p| | field |
  			field := manager longAt: survivor + p.
  			(manager isReallyYoung: field) ifTrue:
  				[self remember: newOop.
  				 ^newOop]]].
  	^newOop!

Item was changed:
  ----- Method: SpurMemoryManager>>copyObj:toAddr:stopAt:savedFirstFields:index: (in category 'image segment in/out') -----
  copyObj: objOop toAddr: segAddr stopAt: endSeg savedFirstFields: savedFirstFields index: i
  	"This is part of storeImageSegmentInto:outPointers:roots:.
  	 Copy objOop into the segment beginning at segAddr, and forward it to the copy,
  	 saving its first field in savedFirstField, and setting its marked bit to indicate it has
  	 been copied.  If it is a class in the class table, set the copy's hash to 0 for reassignment
  	 on load, and mark it as a class by setting its isRemembered bit.
  	 Answer the next segmentAddr if successful.  Answer an appropriate error code if not"
  
  	"Copy the object..."
  	| bodySize copy hash |
  	<inline: false>
  	self deny: (self isCopiedIntoSegment: objOop).
  	bodySize := self bytesInObject: objOop.
  	(self oop: segAddr + bodySize isGreaterThanOrEqualTo: endSeg) ifTrue:
  		[^PrimErrWritePastObject halt].
+ 	self memcpy: segAddr asVoidPointer _: (self startOfObject: objOop) asVoidPointer _: bodySize.
- 	self mem: segAddr asVoidPointer cp: (self startOfObject: objOop) asVoidPointer y: bodySize.
  	copy := self objectStartingAt: segAddr.
  
  	"Clear remembered, mark bits of all headers copied into the segment (except classes)"
  	self
  		setIsRememberedOf: copy to: false;
  		setIsMarkedOf: copy to: false.
  
  	"Make any objects with hidden dynamic state (contexts, methods) look like normal objects."
  	self ifAProxy: objOop updateCopy: copy.
  
  	"If the object is a class, zero its identityHash (which is its classIndex) and set its
  	 isRemembered bit.  It will be assigned a new hash and entered into the table on load."
  	hash := self rawHashBitsOf: objOop.
  	(hash > self lastClassIndexPun and: [(self classOrNilAtIndex: hash) = objOop]) ifTrue:
  		[self setHashBitsOf: copy to: 0.
  		 self setIsRememberedOf: copy to: true].
  
  	"Now forward the object to its copy in the segment."
  	self storePointerUnchecked: i ofObject: savedFirstFields withValue: (self fetchPointer: 0 ofObject: objOop);
  		storePointerUnchecked: 0 ofObject: objOop withValue: copy;
  		markAsCopiedIntoSegment: objOop.
  
  	"Answer the new end of segment"
  	^segAddr + bodySize!

Item was changed:
  ----- Method: SpurMemoryManager>>ensureHasOverflowHeader:forwardIfCloned: (in category 'image segment in/out') -----
  ensureHasOverflowHeader: arrayArg forwardIfCloned: forwardIfCloned
  	"If arrayArg is too short to be truncated, clone it so that the clone is long enough.
  	 Answer nil if it can't be cloned."
  	<inline: false>
  	(self hasOverflowHeader: arrayArg) ifTrue:
  		[^arrayArg].
  	^(self
  		allocateSlots: self numSlotsMask + 1
  		format: (self formatOf: arrayArg)
  		classIndex: (self classIndexOf: arrayArg)) ifNotNil:
  			[:clonedArray|
+ 			 self memcpy: clonedArray + self baseHeaderSize
+ 				 _: arrayArg + self baseHeaderSize
+ 				 _: (self numSlotsOf: arrayArg) * self bytesPerOop.
- 			 self mem: clonedArray + self baseHeaderSize
- 				 cp: arrayArg + self baseHeaderSize
- 				 y: (self numSlotsOf: arrayArg) * self bytesPerOop.
  			 (self isRemembered: arrayArg) ifTrue:
  				[scavenger remember:  clonedArray].
  			 forwardIfCloned ifTrue:
  				[self forward: arrayArg to: clonedArray].
  			 clonedArray]!

Item was changed:
  ----- Method: SpurMemoryManager>>findString: (in category 'debug support') -----
  findString: aCString
  	"Print the oops of all string-like things that have the same characters as aCString"
  	<api>
  	<var: #aCString type: #'char *'>
  	| cssz |
  	cssz := self strlen: aCString.
  	self allObjectsDo:
  		[:obj|
  		 ((self isBytesNonImm: obj)
  		  and: [(self lengthOf: obj) = cssz
+ 		  and: [(self strncmp: aCString _: (self pointerForOop: obj + self baseHeaderSize) _: cssz) = 0]]) ifTrue:
- 		  and: [(self str: aCString n: (self pointerForOop: obj + self baseHeaderSize) cmp: cssz) = 0]]) ifTrue:
  			[coInterpreter printHex: obj; space; printOopShort: obj; cr]]!

Item was changed:
  ----- Method: SpurMemoryManager>>findStringBeginningWith: (in category 'debug support') -----
  findStringBeginningWith: aCString
  	"Print the oops of all string-like things that start with the same characters as aCString"
  	<api>
  	<var: #aCString type: #'char *'>
  	| cssz |
  	cssz := self strlen: aCString.
  	self allObjectsDo:
  		[:obj|
  		 ((self isBytesNonImm: obj)
  		  and: [(self lengthOf: obj) >= cssz
+ 		  and: [(self strncmp: aCString _: (self pointerForOop: obj + self baseHeaderSize) _: cssz) = 0]]) ifTrue:
- 		  and: [(self str: aCString n: (self pointerForOop: obj + self baseHeaderSize) cmp: cssz) = 0]]) ifTrue:
  				[coInterpreter printHex: obj; space; printNum: (self lengthOf: obj); space; printOopShort: obj; cr]]!

Item was removed:
- ----- Method: SpurMemoryManager>>mem:cp:y: (in category 'simulation') -----
- mem: destAddress cp: sourceAddress y: bytes
- 	"For SpurGenerationScavenger>>copyToFutureSpace:bytes:. N.B. If ranges overlap, must use memmove."
- 	<doNotGenerate>
- 	self deny: ((destAddress <= sourceAddress and: [destAddress asInteger + bytes > sourceAddress])
- 				or: [sourceAddress <= destAddress and: [sourceAddress asInteger + bytes > destAddress]]).
- 	^self mem: destAddress mo: sourceAddress ve: bytes!

Item was added:
+ ----- Method: SpurMemoryManager>>memcpy:_:_: (in category 'simulation') -----
+ memcpy: destAddress _: sourceAddress _: bytes
+ 	"For SpurGenerationScavenger>>copyToFutureSpace:bytes:. N.B. If ranges overlap, must use memmove."
+ 	<doNotGenerate>
+ 	self deny: ((destAddress <= sourceAddress and: [destAddress asInteger + bytes > sourceAddress])
+ 				or: [sourceAddress <= destAddress and: [sourceAddress asInteger + bytes > destAddress]]).
+ 	^self memmove: destAddress _: sourceAddress _: bytes!

Item was changed:
  ----- Method: SpurMemoryManager>>stringForCString: (in category 'primitive support') -----
  stringForCString: aCString
  	"Answer a new String copied from a null-terminated C string,
  	 or nil if out of memory."
  	<api>
  	<var: 'aCString' type: 'const char *'>
  	<inline: false>
  	| len newString |
  	len := self strlen: aCString.
  	newString := self
  					allocateSlots: (self numSlotsForBytes: len)
  					format: (self byteFormatForNumBytes: len)
  					classIndex: ClassByteStringCompactIndex.
  	newString ifNotNil:
+ 		[self strncpy: (self cCoerceSimple: newString + self baseHeaderSize to: #'char *')
+ 			_: aCString
+ 			_: len]. "(char *)strncpy()"
- 		[self st: (self cCoerceSimple: newString + self baseHeaderSize to: #'char *')
- 			rn: aCString
- 			cpy: len]. "(char *)strncpy()"
  	^newString!

Item was changed:
  ----- Method: SpurPlanningCompactor>>copyAndUnmarkObject:to:bytes:firstField: (in category 'compaction') -----
  copyAndUnmarkObject: o to: toFinger bytes: bytes firstField: firstField
  	"Copy the object to toFinger, clearing its mark bit both in the target and the corpse,
  	 and restoring its firstField, which was overwritten with a forwarding pointer."
  	<inline: true>
  	| numSlots destObj start |
  	manager setIsMarkedOf: o to: false.
  	numSlots := manager rawNumSlotsOf: o.
  	destObj := (manager objectWithRawSlotsHasOverflowHeader: numSlots)
  					ifTrue: [toFinger + manager baseHeaderSize]
  					ifFalse: [toFinger].
  	start := manager startOfObject: o given: numSlots.
  	"memmove must be used since the ranges may overlap."
  	manager
+ 		memmove: toFinger asVoidPointer _: start asVoidPointer _: bytes;
- 		mem: toFinger asVoidPointer mo: start asVoidPointer ve: bytes;
  		storePointerUnchecked: 0 ofObject: destObj withValue: firstField!

Item was changed:
  ----- Method: SpurSelectiveCompactor>>compactSegment:freeStart: (in category 'compaction') -----
  compactSegment: segInfo freeStart: initialFreeStart
  	<var: 'segInfo' type: #'SpurSegmentInfo *'>
  	| currentEntity fillStart bytesToCopy bridge copy |
  	fillStart := initialFreeStart.
  	bridge := manager segmentManager bridgeFor: segInfo.
  	currentEntity := manager objectStartingAt: segInfo segStart.
  	[self oop: currentEntity isLessThan: bridge] whileTrue:
  		[(manager isFreeObject: currentEntity)
  			ifTrue: 
  				["To avoid confusing too much Spur (especially the leak/free checks), we mark the free chunk as a word object."
  				 manager detachFreeObject: currentEntity.
  				 manager set: currentEntity classIndexTo: manager wordSizeClassIndexPun formatTo: manager wordIndexableFormat]
  			ifFalse: 
  				["Copy the object in segmentToFill and replace it by a forwarder."
  				 self assert: (manager isPinned: currentEntity) not. 
  				 bytesToCopy := manager bytesInObject: currentEntity.
+ 				 manager memcpy: fillStart asVoidPointer _: (manager startOfObject: currentEntity) asVoidPointer _: bytesToCopy.
- 				 manager mem: fillStart asVoidPointer cp: (manager startOfObject: currentEntity) asVoidPointer y: bytesToCopy.
  				 copy := manager objectStartingAt: fillStart.
  				 (manager isRemembered: copy) ifTrue: 
  					["copy has the remembered bit set, but is not in the remembered table."
  					 manager setIsRememberedOf: copy to: false.
  					 scavenger remember: copy].
  				 manager forward: currentEntity to: (manager objectStartingAt: fillStart).
  				 fillStart := fillStart + bytesToCopy.
  				 self assert: (self oop: fillStart isLessThan: (segmentToFill segLimit - manager bridgeSize))].
  		 currentEntity := manager objectAfter: currentEntity limit: manager endOfMemory].
  	self assert: currentEntity = bridge.
  	^ fillStart!

Item was changed:
  ----- Method: StackInterpreter>>callbackEnter: (in category 'callback support') -----
  callbackEnter: callbackID
  	"Re-enter the interpreter to execute a (non-ALien,non-FFI) callback (as used by the Python bridge)."
  	<volatile>
  	<export: true>
  	<var: #callbackID type: #'sqInt *'>
  	| savedReenterInterpreter |
  	<var: #savedReenterInterpreter type: #'jmp_buf'>
  
  	"For now, do not allow a callback unless we're in a primitiveResponse"
  	(self asserta: primitiveFunctionPointer ~= 0) ifFalse:
  		[^false].
  
  	self assert: primFailCode = 0.
  
  	"Check if we've exceeded the callback depth"
  	(self asserta: jmpDepth < MaxJumpBuf) ifFalse:
  		[^false].
  	jmpDepth := jmpDepth + 1.
  
  	"Suspend the currently active process"
  	suspendedCallbacks at: jmpDepth put: self activeProcess.
  	"We need to preserve newMethod explicitly since it is not activated yet
  	and therefore no context has been created for it. If the caller primitive
  	for any reason decides to fail we need to make sure we execute the correct
  	method and not the one 'last used' in the call back"
  	suspendedMethods at: jmpDepth put: newMethod.
  	"Signal external semaphores since a signalSemaphoreWithIndex: request may
  	 have been issued immediately prior to this callback before the VM has any
  	 chance to do a signalExternalSemaphores in checkForEventsMayContextSwitch:"
  	self signalExternalSemaphores.
  	"If no process is awakened by signalExternalSemaphores then transfer
  	 to the highest priority runnable one."
  	(suspendedCallbacks at: jmpDepth) = self activeProcess ifTrue:
  		[self transferTo: self wakeHighestPriority].
  
  	"Typically, invoking the callback means that some semaphore has been 
  	signaled to indicate the callback. Force an interrupt check as soon as possible."
  	self forceInterruptCheck.
  
  	"Save the previous interpreter entry jmp_buf."
+ 	self memcpy: savedReenterInterpreter asVoidPointer
+ 		_: reenterInterpreter
+ 		_: (self sizeof: #'jmp_buf').
- 	self mem: savedReenterInterpreter asVoidPointer
- 		cp: reenterInterpreter
- 		y: (self sizeof: #'jmp_buf').
  	(self setjmp: (jmpBuf at: jmpDepth)) = 0 ifTrue: "Fill in callbackID"
  		[callbackID at: 0 put: jmpDepth.
  		 self enterSmalltalkExecutive.
  		 self assert: false "NOTREACHED"].
  
  	"Restore the previous interpreter entry jmp_buf."
+ 	self memcpy: reenterInterpreter
+ 		_: (self cCoerceSimple: savedReenterInterpreter to: #'void *')
+ 		_: (self sizeof: #'jmp_buf').
- 	self mem: reenterInterpreter
- 		cp: (self cCoerceSimple: savedReenterInterpreter to: #'void *')
- 		y: (self sizeof: #'jmp_buf').
  
  	"Transfer back to the previous process so that caller can push result"
  	self putToSleep: self activeProcess yieldingIf: preemptionYields.
  	self transferTo: (suspendedCallbacks at: jmpDepth).
  	newMethod := suspendedMethods at: jmpDepth.	"see comment above"
  	argumentCount := self argumentCountOf: newMethod.
  	self assert: primFailCode = 0.
  	jmpDepth := jmpDepth - 1.
  	^true!

Item was changed:
  ----- Method: StackInterpreter>>initializeExtraClassInstVarIndices (in category 'initialization') -----
  initializeExtraClassInstVarIndices
  	"Initialize metaclassNumSlots and thisClassIndex which are used in debug printing, and
  	 classNameIndex which is used not only for debug printing but for is:KindOf: & is:MemberOf:
  	 via classNameOf:is: (evil but a reality we have to accept)."
  	| classArrayObj classArrayClass |
  	classArrayObj := objectMemory splObj: ClassArray.
  	classArrayClass := objectMemory fetchClassOfNonImm: classArrayObj.
  	metaclassNumSlots := objectMemory numSlotsOf: classArrayClass.	"determine actual Metaclass instSize"
  	thisClassIndex := 5. "default"
  	InstanceSpecificationIndex + 1 to: (objectMemory lengthOf: classArrayClass) do:
  		[:i|
  		(objectMemory fetchPointer: i - 1 ofObject: classArrayClass) = classArrayObj ifTrue:
  			[thisClassIndex := i - 1]].
  	classNameIndex := 6. "default"
  	InstanceSpecificationIndex + 1 to: (objectMemory lengthOf: classArrayObj) do:
  		[:i| | oop |
  		oop := objectMemory fetchPointer: i - 1 ofObject: classArrayObj.
  		((objectMemory isBytes: oop)
  		and: [(objectMemory lengthOf: oop) = 5
+ 		and: [(objectMemory strncmp: 'Array' _: (objectMemory firstFixedField: oop) _: 5) = 0]]) ifTrue:
- 		and: [(objectMemory str: 'Array' n: (objectMemory firstFixedField: oop) cmp: 5) = 0]]) ifTrue:
  			[classNameIndex := i - 1]]!

Item was changed:
  ----- Method: StackInterpreter>>lowcode_mem:cp:y: (in category 'inline primitive support') -----
  lowcode_mem: destAddress cp: sourceAddress y: bytes
  	"This method is a workaround a GCC bug.
  	In Windows memcpy is putting too much register pressure on GCC when used by Lowcode instructions"
  	<inline: #never>
  	<option: #LowcodeVM>
  	<var: #destAddress type: #'void*'>
  	<var: #sourceAddress type: #'void*'>
  	<var: #bytes type: #'sqInt'>
  	
  	"Using memmove instead of memcpy to avoid crashing GCC in Windows."
+ 	self memmove: destAddress _: sourceAddress _: bytes!
- 	self mem: destAddress mo: sourceAddress ve: bytes!

Item was changed:
  ----- Method: StackInterpreter>>printOopShortInner: (in category 'debug printing') -----
  printOopShortInner: oop
  	| classOop name nameLen |
  	<var: #name type: #'char *'>
  	<inline: true>
  	(objectMemory isImmediate: oop) ifTrue:
  		[(objectMemory isImmediateCharacter: oop) ifTrue:
  			[^self
  				printChar: $$;
  				printChar: (objectMemory characterValueOf: oop);
  				printChar: $(;
  				printHexnp: (objectMemory characterValueOf: oop);
  				printChar: $)].
  		 (objectMemory isIntegerObject: oop) ifTrue:
  			[^self
  				printNum: (objectMemory integerValueOf: oop);
  				printChar: $(;
  				printHexnp: (objectMemory integerValueOf: oop);
  				printChar: $)].
  		 (objectMemory isImmediateFloat: oop) ifTrue:
  			[^self
  				printFloat: (objectMemory dbgFloatValueOf: oop);
  				printChar: $(;
  				printHexnp: oop;
  				printChar: $)].
  		 ^self print: 'unknown immediate '; printHexnp: oop].
  	(objectMemory addressCouldBeObj: oop) ifFalse:
  		[^self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
  						ifTrue: [' is misaligned']
  						ifFalse: [self whereIs: oop])].
  	(objectMemory isFreeObject: oop) ifTrue:
  		[^self print: ' is a free chunk'].
  	(objectMemory isForwarded: oop) ifTrue:
  		[^self print: ' is a forwarder to '; printHexnp: (objectMemory followForwarded: oop)].
  	(self isFloatObject: oop) ifTrue:
  		[^self printFloat: (objectMemory dbgFloatValueOf: oop)].
  	classOop := objectMemory fetchClassOfNonImm: oop.
  	(objectMemory addressCouldBeObj: classOop) ifFalse:
  		[^self print: 'a ??'].
  	(objectMemory numSlotsOf: classOop) = metaclassNumSlots ifTrue:
  		[^self printNameOfClass: oop count: 5].
  	oop = objectMemory nilObject ifTrue: [^self print: 'nil'].
  	oop = objectMemory trueObject ifTrue: [^self print: 'true'].
  	oop = objectMemory falseObject ifTrue: [^self print: 'false'].
  	nameLen := self lengthOfNameOfClass: classOop.
  	nameLen = 0 ifTrue: [^self print: 'a ??'].
  	name := self nameOfClass: classOop.
  	nameLen = 10 ifTrue:
+ 		[(self strncmp: name _: 'ByteString' _: 10) = 0 "strncmp is weird" ifTrue:
- 		[(self str: name n: 'ByteString' cmp: 10) = 0 "strncmp is weird" ifTrue:
  			[^self printChar: $'; printStringOf: oop; printChar: $'].
+ 		 (self strncmp: name _: 'ByteSymbol' _: 10) = 0 "strncmp is weird" ifTrue:
- 		 (self str: name n: 'ByteSymbol' cmp: 10) = 0 "strncmp is weird" ifTrue:
  			[self printChar: $#; printStringOf: oop. ^self]].
+ 	(nameLen = 9 and: [(self strncmp: name _: 'Character' _: 9) = 0]) ifTrue:
- 	(nameLen = 9 and: [(self str: name n: 'Character' cmp: 9) = 0]) ifTrue:
  		[^self printChar: $$; printChar: (objectMemory integerValueOf: (objectMemory fetchPointer: 0 ofObject: oop))].
  	self print: 'a(n) '.
  	self
  		cCode: [0 to: nameLen - 1 do: [:i| self printChar: (name at: i)]]
  		inSmalltalk:
  			[name isString
  				ifTrue: [self print: name]
  				ifFalse: [0 to: nameLen - 1 do: [:i| self printChar: (name at: i)]]].
  	"Try to spot association-like things; they're all subclasses of LookupKey"
  	((objectMemory isPointersNonImm: oop)
  	 and: [(objectMemory instanceSizeOf: classOop) = (ValueIndex + 1)
  	 and: [(objectMemory isBytes: (objectMemory fetchPointer: KeyIndex ofObject: oop))]]) ifTrue:
  		[| classLookupKey |
  		 classLookupKey := objectMemory fetchClassOfNonImm: (objectMemory splObj: SchedulerAssociation).
  		 [classLookupKey = objectMemory nilObject ifTrue:
  			[^self].
  		  (objectMemory instanceSizeOf: classLookupKey) = (KeyIndex + 1)] whileFalse:
  			[classLookupKey := self superclassOf: classLookupKey].
  		 (self includesBehavior: classOop ThatOf: classLookupKey) ifTrue:
  			[self space;
  				printOopShort: (objectMemory fetchPointer: KeyIndex ofObject: oop);
  				print: ' -> ';
  				printHexnp: (objectMemory fetchPointer: ValueIndex ofObject: oop)]]!

Item was changed:
  ----- Method: StackInterpreter>>restoreCStackStateForCallbackContext: (in category 'callback support') -----
  restoreCStackStateForCallbackContext: vmCallbackContext
  	<var: #vmCallbackContext type: #'VMCallbackContext *'>
+ 	self memcpy: reenterInterpreter
+ 		_: vmCallbackContext savedReenterInterpreter asVoidPointer
+ 		_: (self sizeof: #'jmp_buf')!
- 	self mem: reenterInterpreter
- 		cp: vmCallbackContext savedReenterInterpreter asVoidPointer
- 		y: (self sizeof: #'jmp_buf')!

Item was changed:
  ----- Method: StackInterpreter>>saveCStackStateForCallbackContext: (in category 'callback support') -----
  saveCStackStateForCallbackContext: vmCallbackContext
  	<var: #vmCallbackContext type: #'VMCallbackContext *'>
+ 	self memcpy: vmCallbackContext savedReenterInterpreter asVoidPointer
+ 		_: reenterInterpreter
+ 		_: (self sizeof: #'jmp_buf')!
- 	self mem: vmCallbackContext savedReenterInterpreter asVoidPointer
- 		cp: reenterInterpreter
- 		y: (self sizeof: #'jmp_buf')!

Item was changed:
  ----- Method: StackInterpreterSimulator>>ioLoadFunction:From: (in category 'plugin support') -----
  ioLoadFunction: functionString From: pluginString
  	"Load and return the requested function from a module"
  	| plugin fnSymbol |
  	fnSymbol := functionString asSymbol.
  	transcript
  		cr;
  		show: '(', byteCount printString, ') Looking for ', functionString, ' in ',
  				(pluginString isEmpty ifTrue:['vm'] ifFalse:[pluginString]).
  	(breakSelector notNil
  	 and: [pluginString size = breakSelector size
+ 	 and: [(self strncmp: pluginString _: breakSelector _: pluginString size) = 0
+ 		or: [(self strncmp: functionString _: breakSelector _: functionString size) = 0]]]) ifTrue:
- 	 and: [(self str: pluginString n: breakSelector cmp: pluginString size) = 0
- 		or: [(self str: functionString n: breakSelector cmp: functionString size) = 0]]]) ifTrue:
  		[self halt: functionString].
  	plugin := pluginList 
  				detect:[:any| any key = pluginString asString]
  				ifNone:[self loadNewPlugin: pluginString].
  	plugin ifNil:[
  		"Transcript cr; show:'Failed ... no plugin found'." ^ 0].
  	plugin := plugin value.
  	mappedPluginEntries doWithIndex:[:pluginAndName :index|
  		((pluginAndName at: 1) == plugin 
  			and:[(pluginAndName at: 2) == fnSymbol]) ifTrue:[
  				"Transcript show:' ... okay'." ^ index]].
  	(plugin respondsTo: fnSymbol) ifFalse:[
  		"Transcript cr; show:'Failed ... primitive not in plugin'." ^ 0].
  	mappedPluginEntries := mappedPluginEntries copyWith: (Array with: plugin with: fnSymbol).
  	"Transcript show:' ... okay'."
  	^ mappedPluginEntries size!

Item was changed:
  ----- Method: StackInterpreterSimulator>>ioLoadFunction:From:AccessorDepthInto: (in category 'plugin support') -----
  ioLoadFunction: functionString From: pluginString AccessorDepthInto: accessorDepthPtr
  	"Load and return the requested function from a module.
  	 Assign the accessor depth through accessorDepthPtr.
  	 N.B. The actual code lives in platforms/Cross/vm/sqNamedPrims.h"
  	| firstTime plugin fnSymbol |
  	firstTime := false.
  	fnSymbol := functionString asSymbol.
  	transcript
  		cr;
  		show: '(', byteCount printString, ') Looking for ', functionString, ' in ',
  				(pluginString isEmpty ifTrue:['vm'] ifFalse:[pluginString]).
  	(breakSelector notNil
  	 and: [pluginString size = breakSelector size
+ 	 and: [(self strncmp: pluginString _: breakSelector _: pluginString size) = 0
+ 		or: [(self strncmp: functionString _: breakSelector _: functionString size) = 0]]]) ifTrue:
- 	 and: [(self str: pluginString n: breakSelector cmp: pluginString size) = 0
- 		or: [(self str: functionString n: breakSelector cmp: functionString size) = 0]]]) ifTrue:
  		[self halt: functionString].
  	plugin := pluginList 
  				detect: [:any| any key = pluginString asString]
  				ifNone:
  					[firstTime := true.
  					 self loadNewPlugin: pluginString].
  	plugin ifNil:
  		[firstTime ifTrue: [transcript cr; show: 'Failed ... primitive not in plugin'].
  		 ^0].
  	plugin := plugin value.
  	mappedPluginEntries doWithIndex:
  		[:pluginAndName :index|
  		 ((pluginAndName at: 1) == plugin 
  		  and:[(pluginAndName at: 2) == fnSymbol]) ifTrue:
  			[firstTime ifTrue: [transcript show: ' ... okay'; cr].
  			 accessorDepthPtr at: 0 put: (pluginAndName at: 4).
  			 ^index]].
  	firstTime ifTrue: [transcript cr; show: 'Failed ... primitive not in plugin'].
  	transcript cr.
  	^0!

Item was changed:
  ----- Method: StackInterpreterSimulator>>loadNewPlugin: (in category 'plugin support') -----
  loadNewPlugin: pluginString
  	breakSelector ifNotNil:
+ 		[(self strncmp: pluginString _: breakSelector _: pluginString size) = 0 ifTrue:
- 		[(self str: pluginString n: breakSelector cmp: pluginString size) = 0 ifTrue:
  			[self halt: pluginString]].
  	^(self tryLoadNewPlugin: pluginString pluginEntries: mappedPluginEntries) ifNotNil:
  		[:entry|
  		 pluginList := pluginList copyWith: entry.
  		 entry]!

Item was changed:
  ----- Method: TMethod>>statementsFor:varName: (in category 'primitive compilation') -----
  statementsFor: sourceText varName: varName
  	"Return the parse tree for the given expression. The result is the statements list of the method parsed from the given source text."
  	"Details: Various variables are declared as locals to avoid Undeclared warnings from the parser."
  
  	| s |
  	s := WriteStream on: String new.
  	s nextPutAll: 'temp'; cr; crtab.
  	self printTempsAndVar: varName on: s.
  	s nextPutAll: sourceText.
+ 	^ (([ | compiler |
+ 		compiler := Smalltalk compiler class: Object.
+ 	   (compiler parse: s contents)
+ 			compilationContext: compiler compilationContext;
+ 			yourself] "Pharo"
- 	^ (([Smalltalk compiler parse: s contents] "Pharo"
  			on: MessageNotUnderstood
  			do: [:ex|
  				ex message selector == #compiler ifFalse:
  					[ex pass].
  				Compiler new parse: s contents in: Object notifying: nil]) "Squeak"
  			asTranslationMethodOfClass: self class)
  				removeFinalSelfReturnIn: nil;
+ 				statements!
- 				statements
- !

Item was changed:
  ----- Method: TStmtListNode>>addReadBeforeAssignedIn:to:assignments:in: (in category 'utilities') -----
  addReadBeforeAssignedIn: variables to: readBeforeAssigned assignments: assigned in: aCodeGen
  	"Add any variables in variables that are read before written to readBeforeAssigned.
  	 Add unconditional assignments to assigned.  For convenience answer assigned."
  	self
  		nodesWithParentsDo:
  			[:node :parent|
  			(node isAssignment
  			 and: [variables includes: node variable name]) ifTrue:
  				[assigned add: node variable name].
  			(node isVariable
  			 and: [(variables includes: node name)
  			 and: [(assigned includes: node name) not
  			 and: [(#(nil pointer) includes: (node structTargetKindIn: aCodeGen))
  			 and: [(parent notNil and: [parent isAssignment and: [parent variable == node]]) not]]]]) ifTrue:
  				[node name = 'theCalloutState' ifTrue:
  					[self halt].
  				 readBeforeAssigned add: node name]]
  		unless:
  			[:node :parent| | conditionalAssignments mayHaveSideEffects |
  			node isSend
  				ifTrue:
  					["First deal with implicit assignments..."
  					node isValueExpansion ifTrue:
  						[assigned addAll: node receiver args].
+ 					(#(#'memcpy:_:_:' #'memmove:_:_:') includes: node selector) ifTrue:
- 					(#(mem:cp:y: mem:mo:ve:) includes: node selector) ifTrue:
  						[assigned add: (node args first detect: [:subnode| subnode isVariable]) name].
  					(#(to:do: to:by:do:) includes: node selector) ifTrue:
  						[assigned addAll: (node args at: node selector numArgs) args.
  						 mayHaveSideEffects := node args size = 4. "See TMethod>>prepareMethodIn:"
  						 mayHaveSideEffects ifTrue:
  							[assigned add: node args last name]].
  					"Then deal with read-before-written in the arms of conditionals..."
  					(#(ifTrue: ifFalse: ifNil: ifNotNil:) intersection: node selector keywords) notEmpty
  						ifTrue:
  							["First find assignments in the expression..."
  							 (TStmtListNode new setStatements: {node receiver}; yourself)
  								addReadBeforeAssignedIn: variables
  								to: readBeforeAssigned
  								assignments: assigned
  								in: aCodeGen.
  							 "Now find read-before-written in each arm, and collect the assignments to spot those assigned in both arms"
  							 conditionalAssignments :=
  								node args
  									collect:
  										[:block|
  										block isStmtList ifTrue:
  											[block
  												addReadBeforeAssignedIn: variables
  												to: readBeforeAssigned
  												assignments: assigned copy
  												in: aCodeGen]]
  									thenSelect: [:each| each notNil].
  							 "add to assigned those variables written to in both arms"
  							 conditionalAssignments size = 2 ifTrue:
  								[conditionalAssignments := conditionalAssignments collect: [:set| set difference: assigned].
  								 assigned addAll: (conditionalAssignments first intersection: conditionalAssignments last)].
  							 true]
  						ifFalse:
  							[false]]
  				ifFalse:
  					[false]].
  	^assigned!

Item was changed:
  ----- Method: ThreadedARMFFIPlugin>>ffiPushStructure:ofSize:typeSpec:ofLength:in: (in category 'marshalling') -----
  ffiPushStructure: pointer ofSize: structSize typeSpec: argSpec ofLength: argSpecSize in: calloutState
  	<var: #pointer type: #'void *'>
  	<var: #argSpec type: #'sqInt *'>
  	<var: #calloutState type: #'CalloutState *'>
  	<inline: true>
  	| availableRegisterSpace stackPartSize roundedSize |
  
  	availableRegisterSpace := (NumIntRegArgs - calloutState integerRegisterIndex) * 4.
  	stackPartSize := structSize.
  	availableRegisterSpace > 0
  		ifTrue: 
  			[structSize <= availableRegisterSpace
  				ifTrue:
  					["all in registers"
  					 stackPartSize := 0.
  					 self 
+ 						memcpy: (self cCoerceSimple: (self addressOf: (calloutState integerRegisters at: calloutState integerRegisterIndex)) to: 'void *') 
+ 						_: pointer 
+ 						_: structSize.
- 						mem: (self cCoerceSimple: (self addressOf: (calloutState integerRegisters at: calloutState integerRegisterIndex)) to: 'void *') 
- 						cp: pointer 
- 						y: structSize.
  					 calloutState integerRegisterIndex: calloutState integerRegisterIndex + (structSize + 3 bitShift: -2) ]
  				ifFalse:
  					["If no previous co-processor candidate arg has already been pushed on the stack, then split the struct between registers and stack.
  					  Otherwise push entire struct on stack."
  					 calloutState currentArg = calloutState argVector
  						ifTrue: 
  					 		[stackPartSize := structSize - availableRegisterSpace.
  					 		self 
+ 								memcpy: (self cCoerceSimple: (self addressOf: (calloutState integerRegisters at: calloutState integerRegisterIndex)) to: 'void *') 
+ 								_: pointer 
+ 								_: availableRegisterSpace]
- 								mem: (self cCoerceSimple: (self addressOf: (calloutState integerRegisters at: calloutState integerRegisterIndex)) to: 'void *') 
- 								cp: pointer 
- 								y: availableRegisterSpace]
  						ifFalse:
  							[availableRegisterSpace := 0].
  					calloutState integerRegisterIndex: NumIntRegArgs]].
  
  	stackPartSize > 0
  		ifTrue: 
  			[roundedSize := stackPartSize + 3 bitClear: 3.
  			 calloutState currentArg + roundedSize > calloutState limit ifTrue:
  				 [^FFIErrorCallFrameTooBig].
+ 			 self memcpy: calloutState currentArg _: (self addressOf: ((self cCoerceSimple: pointer to: 'char *') at: availableRegisterSpace)) _: stackPartSize.
- 			 self mem: calloutState currentArg cp: (self addressOf: ((self cCoerceSimple: pointer to: 'char *') at: availableRegisterSpace)) y: stackPartSize.
  			 calloutState currentArg: calloutState currentArg + roundedSize].
  	^0!

Item was changed:
  ----- Method: ThreadedARMFFIPlugin>>ffiReturnStruct:ofType:in: (in category 'callout support') -----
  ffiReturnStruct: longLongRet ofType: ffiRetType in: calloutState
  	<var: #longLongRet type: #usqLong>
  	<var: #calloutState type: #'CalloutState *'>
  	"Create a structure return value from an external function call.  The value has been stored in
  	 alloca'ed space pointed to by the calloutState or in the return value."
  	| retOop retClass oop |
  	<inline: true>
  	retClass := interpreterProxy fetchPointer: 1 ofObject: ffiRetType.
  	retOop := interpreterProxy instantiateClass: retClass indexableSize: 0.
  	self remapOop: retOop
  		in: [oop := interpreterProxy 
  					instantiateClass: interpreterProxy classByteArray 
  					indexableSize: calloutState structReturnSize].
+ 	self memcpy: (interpreterProxy firstIndexableField: oop)
+ 		_: ((self returnStructInRegisters: calloutState structReturnSize)
- 	self mem: (interpreterProxy firstIndexableField: oop)
- 		cp: ((self returnStructInRegisters: calloutState structReturnSize)
  				ifTrue: [self addressOf: longLongRet]
  				ifFalse: [calloutState limit])
+ 		 _: calloutState structReturnSize.
- 		 y: calloutState structReturnSize.
  	interpreterProxy storePointer: 0 ofObject: retOop withValue: oop.
  	^retOop!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>ffiPushString:OfLength:in: (in category 'marshalling') -----
  ffiPushString: pointer OfLength: length in: calloutState
  	<var: #pointer type: #'char *'>
  	<var: #calloutState type: #'CalloutState *'>
  	| copy |
  	<var: #copy type: #'char *'>
  	<inline: true>
  	calloutState stringArgIndex >= MaxNumArgs ifTrue:
  		[^PrimErrBadNumArgs negated].
  	copy := self malloc: length + 1.
  	copy isNil ifTrue:
  		[^PrimErrNoCMemory negated].
+ 	self memcpy: copy _: pointer _: length.
- 	self mem: copy cp: pointer y: length.
  	copy at: length put: 0.
  	calloutState stringArgs at: calloutState stringArgIndex put: copy.
  	calloutState stringArgIndex: calloutState stringArgIndex + 1.
  	^self ffiPushPointer: copy in: calloutState!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>primitiveFFIDoubleAt (in category 'primitives') -----
  primitiveFFIDoubleAt
  	"Return a (signed or unsigned) n byte integer from the given byte offset."
  	| byteOffset rcvr addr floatValue |
  	<export: true>
  	<inline: false>
  	<var: #floatValue type: #double>
  	byteOffset := interpreterProxy stackIntegerValue: 0.
  	rcvr := interpreterProxy stackObjectValue: 1.
  	interpreterProxy failed ifTrue:[^0].
  	addr := self ffiAddressOf: rcvr startingAt: byteOffset size: 8.
  	addr = 0 ifTrue: [^interpreterProxy primitiveFail].
+ 	self memcpy: (self addressOf: floatValue) _: addr _: (self sizeof: floatValue).
- 	self mem: (self addressOf: floatValue) cp: addr y: (self sizeof: floatValue).
  	interpreterProxy pop: 2.
  	^interpreterProxy pushFloat: floatValue
  !

Item was changed:
  ----- Method: ThreadedFFIPlugin>>primitiveFFIDoubleAtPut (in category 'primitives') -----
  primitiveFFIDoubleAtPut
  	"Return a (signed or unsigned) n byte integer from the given byte offset."
  	| byteOffset rcvr addr floatValue floatOop |
  	<export: true>
  	<inline: false>
  	<var: #floatValue type: #double>
  	floatOop := interpreterProxy stackValue: 0.
  	(interpreterProxy isIntegerObject: floatOop)
  		ifTrue:[floatValue := self cCoerce: (interpreterProxy integerValueOf: floatOop) to:'double']
  		ifFalse:[floatValue := self cCoerce: (interpreterProxy floatValueOf: floatOop) to:'double'].
  	byteOffset := interpreterProxy stackIntegerValue: 1.
  	rcvr := interpreterProxy stackObjectValue: 2.
  	interpreterProxy failed ifTrue:[^0].
  	addr := self ffiAddressOf: rcvr startingAt: byteOffset size: 8.
  	addr = 0 ifTrue: [^interpreterProxy primitiveFail].
+ 	self memcpy: addr _: (self addressOf: floatValue) _: (self sizeof: floatValue).
- 	self mem: addr cp: (self addressOf: floatValue) y: (self sizeof: floatValue).
  	^interpreterProxy pop: 3 thenPush: floatOop!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>primitiveFFIFloatAt (in category 'primitives') -----
  primitiveFFIFloatAt
  	"Return a (signed or unsigned) n byte integer from the given byte offset."
  	| byteOffset rcvr addr floatValue |
  	<export: true>
  	<inline: false>
  	<var: #floatValue type: #float>
  	byteOffset := interpreterProxy stackIntegerValue: 0.
  	rcvr := interpreterProxy stackObjectValue: 1.
  	interpreterProxy failed ifTrue:[^0].
  	addr := self ffiAddressOf: rcvr startingAt: byteOffset size: 4.
  	addr = 0 ifTrue: [^interpreterProxy primitiveFail].
+ 	self memcpy: (self addressOf: floatValue) _: addr _: (self sizeof: floatValue).
- 	self mem: (self addressOf: floatValue) cp: addr y: (self sizeof: floatValue).
  	interpreterProxy pop: 2.
  	^interpreterProxy pushFloat: floatValue!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>primitiveFFIFloatAtPut (in category 'primitives') -----
  primitiveFFIFloatAtPut
  	"Return a (signed or unsigned) n byte integer from the given byte offset."
  	| byteOffset rcvr addr floatValue floatOop |
  	<export: true>
  	<inline: false>
  	<var: #floatValue type: #float>
  	floatOop := interpreterProxy stackValue: 0.
  	(interpreterProxy isIntegerObject: floatOop)
  		ifTrue:[floatValue := self cCoerce: (interpreterProxy integerValueOf: floatOop) to:'float']
  		ifFalse:[floatValue := self cCoerce: (interpreterProxy floatValueOf: floatOop) to:'float'].
  	byteOffset := interpreterProxy stackIntegerValue: 1.
  	rcvr := interpreterProxy stackObjectValue: 2.
  	interpreterProxy failed ifTrue:[^0].
  	addr := self ffiAddressOf: rcvr startingAt: byteOffset size: 4.
  	addr = 0 ifTrue: [^interpreterProxy primitiveFail].
+ 	self memcpy: addr _: (self addressOf: floatValue) _: (self sizeof: floatValue).
- 	self mem: addr cp: (self addressOf: floatValue) y: (self sizeof: floatValue).
  	^interpreterProxy pop: 3 thenPush: floatOop!

Item was changed:
  ----- Method: ThreadedIA32FFIPlugin>>ffiPushStructure:ofSize:typeSpec:ofLength:in: (in category 'marshalling') -----
  ffiPushStructure: pointer ofSize: structSize typeSpec: argSpec ofLength: argSpecSize in: calloutState
  	<var: #pointer type: #'void *'>
  	<var: #argSpec type: #'sqInt *'>
  	<var: #calloutState type: #'CalloutState *'>
  	<inline: true>
  	| roundedSize |
  	roundedSize := structSize + 3 bitClear: 3.
  	calloutState currentArg + roundedSize > calloutState limit ifTrue:
  		[^FFIErrorCallFrameTooBig].
+ 	self memcpy: calloutState currentArg _: pointer _: structSize.
- 	self mem: calloutState currentArg cp: pointer y: structSize.
  	calloutState currentArg: calloutState currentArg + roundedSize.
  	^0!

Item was changed:
  ----- Method: ThreadedIA32FFIPlugin>>ffiReturnStruct:ofType:in: (in category 'callout support') -----
  ffiReturnStruct: longLongRet ofType: ffiRetType in: calloutState
  	<var: #longLongRet type: #usqLong>
  	<var: #calloutState type: #'CalloutState *'>
  	"Create a structure return value from an external function call.  The value as been stored in
  	 alloca'ed space pointed to by the calloutState."
  	| retOop retClass oop |
  	<inline: true>
  	retClass := interpreterProxy fetchPointer: 1 ofObject: ffiRetType.
  	retOop := interpreterProxy instantiateClass: retClass indexableSize: 0.
  	self remapOop: retOop
  		in: [oop := interpreterProxy 
  					instantiateClass: interpreterProxy classByteArray 
  					indexableSize: calloutState structReturnSize].
+ 	self memcpy: (interpreterProxy firstIndexableField: oop)
+ 		_: ((self returnStructInRegisters: calloutState structReturnSize)
- 	self mem: (interpreterProxy firstIndexableField: oop)
- 		cp: ((self returnStructInRegisters: calloutState structReturnSize)
  				ifTrue: [(self addressOf: longLongRet) asVoidPointer]
  				ifFalse: [calloutState limit])
+ 		 _: calloutState structReturnSize.
- 		 y: calloutState structReturnSize.
  	interpreterProxy storePointer: 0 ofObject: retOop withValue: oop.
  	^retOop!

Item was changed:
  ----- Method: ThreadedX64SysVFFIPlugin>>ffiPushStructure:ofSize:typeSpec:ofLength:in: (in category 'marshalling') -----
  ffiPushStructure: pointer ofSize: structSize typeSpec: argSpec ofLength: argSpecSize in: calloutState
  	<var: #pointer type: #'void *'>
  	<var: #argSpec type: #'sqInt *'>
  	<var: #calloutState type: #'CalloutState *'>
  	<inline: true>
  	| roundedSize doubleType floatType numDoubleRegisters numIntegerRegisters passField0InXmmReg passField1InXmmReg |
  	structSize <= 16 ifTrue:
  		["See sec 3.2.3 of http://people.freebsd.org/~obrien/amd64-elf-abi.pdf. (dravft version 0.90).
  		  All of the folowing are passed in registers:
  			typedef struct { long a; } s0;
  			typedef struct { double a; } s1;
  			typedef struct { long a; double b; } s2;
  			typedef struct { int a; int b; double c; } s2a;
  			typedef struct { short a; short b; short c; short d; double e; } s2b;
  			typedef struct { long a; float b; } s2f;
  			typedef struct { long a; float b; float c; } s2g;
  		  but not ones like this:
  			typedef struct { int a; float b; int c; float d; } s2h;"
  		 doubleType := FFITypeDoubleFloat << FFIAtomicTypeShift + FFITypeDoubleFloat.
  		 floatType := FFITypeDoubleFloat << FFIAtomicTypeShift + FFITypeSingleFloat.
  		 passField0InXmmReg := doubleType = ((self cCoerce: argSpec to: #'int *') at: 1) "0th field is struct type and size"
  								or: [floatType = ((self cCoerce: argSpec to: #'int *') at: 1)
  									and: [floatType = ((self cCoerce: argSpec to: #'int *') at: 2)]].
  		 structSize <= 8
  			ifTrue:
  				[numDoubleRegisters := passField0InXmmReg ifTrue: [1] ifFalse: [0].
  				 numIntegerRegisters := 1 - numDoubleRegisters]
  			ifFalse:
  				[passField1InXmmReg := doubleType = ((self cCoerce: argSpec to: #'int *') at: argSpecSize - 1) "Nth field is last field of struct"
  										or: [floatType = ((self cCoerce: argSpec to: #'int *') at: argSpecSize - 2)
  											and: [floatType = ((self cCoerce: argSpec to: #'int *') at: argSpecSize - 1)]].
  				 numDoubleRegisters := (passField0InXmmReg ifTrue: [1] ifFalse: [0]) + (passField1InXmmReg ifTrue: [1] ifFalse: [0]).
  				 numIntegerRegisters := 2 - numDoubleRegisters].
  		 (calloutState floatRegisterIndex + numDoubleRegisters <= NumFloatRegArgs
  		  and: [calloutState integerRegisterIndex + numIntegerRegisters <= NumIntRegArgs]) ifTrue:
  			[passField0InXmmReg
  				ifTrue: [self ffiPushDoubleFloat: ((self cCoerceSimple: pointer to: #'double *') at: 0) in: calloutState]
  				ifFalse: [self ffiPushSignedLongLong: ((self cCoerceSimple: pointer to: #'long long *') at: 0) in: calloutState].
  			 structSize > 8 ifTrue:
  				[passField1InXmmReg
  					ifTrue: [self ffiPushDoubleFloat: ((self cCoerceSimple: pointer to: #'double *') at: 1) in: calloutState]
  					ifFalse: [self ffiPushSignedLongLong: ((self cCoerceSimple: pointer to: #'long long *') at: 1) in: calloutState]].
  			 ^0]].
  
  	roundedSize := structSize + 7 bitClear: 7.
  	calloutState currentArg + roundedSize > calloutState limit ifTrue:
  		 [^FFIErrorCallFrameTooBig].
+ 	self memcpy: calloutState currentArg _: (self cCoerceSimple: pointer to: 'char *') _: structSize.
- 	self mem: calloutState currentArg cp: (self cCoerceSimple: pointer to: 'char *') y: structSize.
  	calloutState currentArg: calloutState currentArg + roundedSize.
  	^0!

Item was changed:
  ----- Method: ThreadedX64SysVFFIPlugin>>ffiReturnStruct:ofType:in: (in category 'callout support') -----
  ffiReturnStruct: sixteenByteRet ofType: ffiRetType in: calloutState
  	<var: #sixteenByteRet type: #SixteenByteReturn>
  	<var: #calloutState type: #'CalloutState *'>
  	"Create a structure return value from an external function call.  The value has been stored in
  	 alloca'ed space pointed to by the calloutState or in the return value."
  	| retOop retClass oop |
  	<inline: true>
  	retClass := interpreterProxy fetchPointer: 1 ofObject: ffiRetType.
  	retOop := interpreterProxy instantiateClass: retClass indexableSize: 0.
  	self remapOop: retOop
  		in: [oop := interpreterProxy 
  					instantiateClass: interpreterProxy classByteArray 
  					indexableSize: calloutState structReturnSize].
+ 	self memcpy: (interpreterProxy firstIndexableField: oop)
+ 		_: ((self returnStructInRegisters: calloutState structReturnSize)
- 	self mem: (interpreterProxy firstIndexableField: oop)
- 		cp: ((self returnStructInRegisters: calloutState structReturnSize)
  				ifTrue: [(self addressOf: sixteenByteRet) asVoidPointer]
  				ifFalse: [calloutState limit])
+ 		 _: calloutState structReturnSize.
- 		 y: calloutState structReturnSize.
  	interpreterProxy storePointer: 0 ofObject: retOop withValue: oop.
  	^retOop!

Item was changed:
  ----- Method: ThreadedX64Win64FFIPlugin>>ffiPushStructure:ofSize:typeSpec:ofLength:in: (in category 'marshalling') -----
  ffiPushStructure: pointer ofSize: structSize typeSpec: argSpec ofLength: argSpecSize in: calloutState
  	<var: #pointer type: #'void *'>
  	<var: #argSpec type: #'sqInt *'>
  	<var: #calloutState type: #'CalloutState *'>
  	<var: #arg type: #usqLong>
  	<inline: true>
  	structSize <= 0 ifTrue:
  		[^FFIErrorStructSize].
  	(structSize <= WordSize
  	 and: [(structSize bitAnd: structSize - 1) = 0 "a.k.a. structSize isPowerOfTwo"]) ifTrue:
  		[| arg |
+ 		self memcpy: (self addressOf: arg) _: pointer _: structSize.
- 		self mem: (self addressOf: arg) cp: pointer y: structSize.
  		^self ffiPushUnsignedLongLong: arg in: calloutState].
  
  	"For now just push the pointer; we should copy the struct to the outgoing stack frame!!!!"
  	self flag: 'quick hack'.
  	^self ffiPushPointer: pointer in: calloutState!

Item was changed:
  ----- Method: ThreadedX64Win64FFIPlugin>>ffiReturnStruct:ofType:in: (in category 'callout support') -----
  ffiReturnStruct: intRet ofType: ffiRetType in: calloutState
  	<var: #intRet type: #usqLong>
  	<var: #calloutState type: #'CalloutState *'>
  	"Create a structure return value from an external function call.  The value has been stored in
  	 alloca'ed space pointed to by the calloutState or in the return value."
  	| retOop retClass oop |
  	<inline: true>
  	retClass := interpreterProxy fetchPointer: 1 ofObject: ffiRetType.
  	retOop := interpreterProxy instantiateClass: retClass indexableSize: 0.
  	self remapOop: retOop
  		in: [oop := interpreterProxy 
  					instantiateClass: interpreterProxy classByteArray 
  					indexableSize: calloutState structReturnSize].
+ 	self memcpy: (interpreterProxy firstIndexableField: oop)
+ 		_: ((self returnStructInRegisters: calloutState structReturnSize)
- 	self mem: (interpreterProxy firstIndexableField: oop)
- 		cp: ((self returnStructInRegisters: calloutState structReturnSize)
  				ifTrue: [self addressOf: intRet]
  				ifFalse: [calloutState limit])
+ 		 _: calloutState structReturnSize.
- 		 y: calloutState structReturnSize.
  	interpreterProxy storePointer: 0 ofObject: retOop withValue: oop.
  	^retOop!

Item was changed:
  ----- Method: VMClass>>asString: (in category 'C library simulation') -----
  asString: aStringOrStringIndex
  	"aStringOrStringIndex is either a string or an address in the heap.
  	 Create a String of the requested length form the bytes in the
  	 heap starting at stringIndex."
  	<doNotGenerate>
  	| sz |
  	aStringOrStringIndex isString ifTrue:
  		[^aStringOrStringIndex].
  	sz := self strlen: aStringOrStringIndex.
+ 	^self strncpy: (ByteString new: sz) _: aStringOrStringIndex _: sz!
- 	^self st: (ByteString new: sz) rn: aStringOrStringIndex cpy: sz!

Item was changed:
  ----- Method: VMClass>>asString:size: (in category 'C library simulation') -----
  asString: stringIndex size: stringSize
  	"stringIndex is an address in the heap.  Create a String of the requested length
  	form the bytes in the heap starting at stringIndex."
  	<doNotGenerate>
+ 	^self strncpy: (ByteString new: stringSize) _: stringIndex _: stringSize!
- 	^self st: (ByteString new: stringSize) rn: stringIndex cpy: stringSize!

Item was removed:
- ----- Method: VMClass>>mem:cp:y: (in category 'C library simulation') -----
- mem: dString cp: sString y: bytes
- 	<doNotGenerate>
- 	"implementation of memcpy(3). N.B. If ranges overlap, must use memmove."
- 	(dString isString or: [sString isString]) ifFalse:
- 		[| destAddress sourceAddress |
- 		 dString class == ByteArray ifTrue:
- 			[ByteString adoptInstance: dString.
- 			 ^[self mem: dString cp: sString y: bytes] ensure:
- 				[ByteArray adoptInstance: dString]].
- 		 destAddress := dString asInteger.
- 		 sourceAddress := sString asInteger.
- 		 self deny: ((destAddress <= sourceAddress and: [destAddress + bytes > sourceAddress])
- 					or: [sourceAddress <= destAddress and: [sourceAddress + bytes > destAddress]])].
- 	dString isString
- 		ifTrue:
- 			[1 to: bytes do:
- 				[:i| | v |
- 				v := sString isString
- 						ifTrue: [sString at: i]
- 						ifFalse: [Character value: (self byteAt: sString + i - 1)].
- 				dString at: i put: v]]
- 		ifFalse:
- 			[1 to: bytes do:
- 				[:i| | v |
- 				v := sString isString
- 						ifTrue: [(sString at: i) asInteger]
- 						ifFalse: [self byteAt: sString + i - 1].
- 				self byteAt: dString + i - 1 put: v]].
- 	^dString!

Item was removed:
- ----- Method: VMClass>>mem:mo:ve: (in category 'C library simulation') -----
- mem: destAddress mo: sourceAddress ve: bytes
- 	<doNotGenerate>
- 	| dst src  |
- 	dst := destAddress asInteger.
- 	src := sourceAddress asInteger.
- 	"Emulate the c library memmove function"
- 	self assert: bytes \\ 4 = 0.
- 	destAddress > sourceAddress
- 		ifTrue:
- 			[bytes - 4 to: 0 by: -4 do:
- 				[:i| self longAt: dst + i put: (self longAt: src + i)]]
- 		ifFalse:
- 			[0 to: bytes - 4 by: 4 do:
- 				[:i| self longAt: dst + i put: (self longAt: src + i)]]!

Item was added:
+ ----- Method: VMClass>>memcpy:_:_: (in category 'C library simulation') -----
+ memcpy: dString _: sString _: bytes
+ 	<doNotGenerate>
+ 	"implementation of memcpy(3). N.B. If ranges overlap, must use memmove."
+ 	(dString isString or: [sString isString]) ifFalse:
+ 		[| destAddress sourceAddress |
+ 		 dString class == ByteArray ifTrue:
+ 			[ByteString adoptInstance: dString.
+ 			 ^[self memcpy: dString _: sString _: bytes] ensure:
+ 				[ByteArray adoptInstance: dString]].
+ 		 destAddress := dString asInteger.
+ 		 sourceAddress := sString asInteger.
+ 		 self deny: ((destAddress <= sourceAddress and: [destAddress + bytes > sourceAddress])
+ 					or: [sourceAddress <= destAddress and: [sourceAddress + bytes > destAddress]])].
+ 	dString isString
+ 		ifTrue:
+ 			[1 to: bytes do:
+ 				[:i| | v |
+ 				v := sString isString
+ 						ifTrue: [sString at: i]
+ 						ifFalse: [Character value: (self byteAt: sString + i - 1)].
+ 				dString at: i put: v]]
+ 		ifFalse:
+ 			[1 to: bytes do:
+ 				[:i| | v |
+ 				v := sString isString
+ 						ifTrue: [(sString at: i) asInteger]
+ 						ifFalse: [self byteAt: sString + i - 1].
+ 				self byteAt: dString + i - 1 put: v]].
+ 	^dString!

Item was added:
+ ----- Method: VMClass>>memmove:_:_: (in category 'C library simulation') -----
+ memmove: destAddress _: sourceAddress _: bytes
+ 	<doNotGenerate>
+ 	| dst src  |
+ 	dst := destAddress asInteger.
+ 	src := sourceAddress asInteger.
+ 	"Emulate the c library memmove function"
+ 	self assert: bytes \\ 4 = 0.
+ 	destAddress > sourceAddress
+ 		ifTrue:
+ 			[bytes - 4 to: 0 by: -4 do:
+ 				[:i| self longAt: dst + i put: (self longAt: src + i)]]
+ 		ifFalse:
+ 			[0 to: bytes - 4 by: 4 do:
+ 				[:i| self longAt: dst + i put: (self longAt: src + i)]]!

Item was removed:
- ----- Method: VMClass>>st:rn:cpy: (in category 'C library simulation') -----
- st: aString rn: bString cpy: n
- 	<doNotGenerate>
- 	"implementation of strncpy(3)"
- 	aString isString
- 		ifTrue:
- 			[1 to: n do:
- 				[:i| | v |
- 				v := bString isString
- 						ifTrue: [bString at: i]
- 						ifFalse: [Character value: (self byteAt: bString + i - 1)].
- 				aString at: i put: v.
- 				v asInteger = 0 ifTrue: [^aString]]]
- 		ifFalse:
- 			[1 to: n do:
- 				[:i| | v |
- 				v := bString isString
- 						ifTrue: [(bString at: i) asInteger]
- 						ifFalse: [self byteAt: bString + i - 1].
- 				self byteAt: aString + i - 1 put: v.
- 				v = 0 ifTrue: [^aString]]].
- 	^aString!

Item was removed:
- ----- Method: VMClass>>str:cat: (in category 'C library simulation') -----
- str: aString cat: bString
- 	<doNotGenerate>
- 	"implementation of strcat(3)"
- 	^(self asString: aString), (self asString: bString)!

Item was removed:
- ----- Method: VMClass>>str:n:cmp: (in category 'C library simulation') -----
- str: aString n: bString cmp: n
- 	<doNotGenerate>
- 	"implementation of strncmp(3)"
- 	bString isString ifTrue:
- 		[1 to: n do:
- 			[:i|
- 			 (aString at: i) asCharacter ~= (bString at: i) ifTrue:
- 				[^i]].
- 		 ^0].
- 	1 to: n do:
- 		[:i| | v |
- 		v := (aString at: i) asInteger - (self byteAt: bString + i - 1).
- 		v ~= 0 ifTrue: [^v]].
- 	^0!

Item was added:
+ ----- Method: VMClass>>strcat:_: (in category 'C library simulation') -----
+ strcat: aString _: bString
+ 	<doNotGenerate>
+ 	"implementation of strcat(3)"
+ 	^(self asString: aString), (self asString: bString)!

Item was changed:
  ----- Method: VMClass>>stretch:cat: (in category 'C library extensions') -----
  stretch: s1 cat: s2
  	<var: 's1' type: #'char *'>
  	<var: 's2' type: #'char *'>
  	| ns |
  	<var: 'ns' type: #'char *'>
  	^self
  		cCode:
  			[ns := self malloc: (self strlen: s1) + (self strlen: s2) + 2.
+ 			 self strcpy: ns _: s1.
+ 			 self strcat: ns  _: s2]
+ 		inSmalltalk: [self strcat: s1  _: s2]!
- 			self str: ns cpy: s1.
- 			self str: ns cat: s2]
- 		inSmalltalk: [self str: s1 cat: s2]!

Item was added:
+ ----- Method: VMClass>>strncmp:_:_: (in category 'C library simulation') -----
+ strncmp: aString _: bString _: n
+ 	<doNotGenerate>
+ 	"implementation of strncmp(3)"
+ 	bString isString ifTrue:
+ 		[1 to: n do:
+ 			[:i|
+ 			 (aString at: i) asCharacter ~= (bString at: i) ifTrue:
+ 				[^i]].
+ 		 ^0].
+ 	1 to: n do:
+ 		[:i| | v |
+ 		v := (aString at: i) asInteger - (self byteAt: bString + i - 1).
+ 		v ~= 0 ifTrue: [^v]].
+ 	^0!

Item was added:
+ ----- Method: VMClass>>strncpy:_:_: (in category 'C library simulation') -----
+ strncpy: aString _: bString _: n
+ 	<doNotGenerate>
+ 	"implementation of strncpy(3)"
+ 	aString isString
+ 		ifTrue:
+ 			[1 to: n do:
+ 				[:i| | v |
+ 				v := bString isString
+ 						ifTrue: [bString at: i]
+ 						ifFalse: [Character value: (self byteAt: bString + i - 1)].
+ 				aString at: i put: v.
+ 				v asInteger = 0 ifTrue: [^aString]]]
+ 		ifFalse:
+ 			[1 to: n do:
+ 				[:i| | v |
+ 				v := bString isString
+ 						ifTrue: [(bString at: i) asInteger]
+ 						ifFalse: [self byteAt: bString + i - 1].
+ 				self byteAt: aString + i - 1 put: v.
+ 				v = 0 ifTrue: [^aString]]].
+ 	^aString!

Item was changed:
  ----- Method: VMProfileLinuxSupportPlugin>>primitiveDLSymInLibrary (in category 'primitives') -----
  primitiveDLSymInLibrary
  	"Answer the address of the symbol whose name is the first argument
  	 in the library whose name is the second argument, or nil if none."
  	| nameObj symName libName lib sz addr ok |
  	<export: true>
  	<var: #symName type: #'char *'>
  	<var: #libName type: #'char *'>
  	<var: #lib type: #'void *'>
  	<var: #addr type: #'void *'>
  	nameObj := interpreterProxy stackValue: 0.
  	(interpreterProxy isBytes: nameObj) ifFalse:
  		[^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	sz := interpreterProxy byteSizeOf: nameObj.
  	libName := self malloc: sz+1.
+ 	self strncpy: libName _: (interpreterProxy firstIndexableField: nameObj) _: sz.
- 	self st: libName rn: (interpreterProxy firstIndexableField: nameObj) cpy: sz.
  	libName at: sz put: 0.
  	nameObj := interpreterProxy stackValue: 1.
  	(interpreterProxy isBytes: nameObj) ifFalse:
  		[self free: libName.
  		 ^interpreterProxy primitiveFailFor: PrimErrBadArgument].
  	sz := interpreterProxy byteSizeOf: nameObj.
  	symName := self malloc: sz+1.
+ 	self strncpy: symName _: (interpreterProxy firstIndexableField: nameObj) _: sz.
- 	self st: symName rn: (interpreterProxy firstIndexableField: nameObj) cpy: sz.
  	symName at: sz put: 0.
  	lib := self dl: libName open: (#'RTLD_LAZY' bitOr: #'RTLD_NODELETE').
  	lib ifNil:
  		[self free: libName; free: symName.
  		 ^interpreterProxy primitiveFailFor: PrimErrInappropriate].
  	self dlerror. "clear dlerror"
  	addr := self dl: lib sym: symName.
  	ok := self dlerror isNil.
  	self free: symName.
  	self free: libName.
  	self dlclose: lib.
  	ok ifFalse:
  		[^interpreterProxy primitiveFailFor: PrimErrNotFound].
  	^interpreterProxy methodReturnValue: (interpreterProxy positiveMachineIntegerFor: addr asUnsignedIntegerPtr)!

Item was changed:
  ----- Method: VMProfileLinuxSupportPlugin>>reap:module:names: (in category 'iteration callbacks') -----
  reap: info module: size names: ignored
  	<returnTypeC: #int>
  	| elfModuleName len moduleNameObj GetAttributeString |
  	<var: #info type: #'struct dl_phdr_info *'>
  	<var: 'elfModuleName' type: #'const char *'>
  	<var: #GetAttributeString declareC: 'extern char *GetAttributeString(sqInt)'>
  	<var: #size type: #'size_t'>
  	<var: #ignored type: #'void *'>
  	self touch: GetAttributeString.
  	elfModuleName := self cCode: 'numModules ? info->dlpi_name : GetAttributeString(0)'.
  	(elfModuleName isNil
  	 or: [(len := self strlen: elfModuleName) = 0]) ifTrue:
  		[^0]. "skip the fake linux-gate.so.1"
  	moduleNameObj := interpreterProxy
  							instantiateClass: interpreterProxy classString
  							indexableSize: len.
  	moduleNameObj = 0 ifTrue:
  		[primErr := PrimErrNoMemory.
  		 ^1]. "stop iteration"
+ 	self strncpy: (interpreterProxy arrayValueOf: moduleNameObj)
+ 		_: elfModuleName
+ 		_: len. "(char *)strncpy()"
- 	self st: (interpreterProxy arrayValueOf: moduleNameObj)
- 		rn: elfModuleName
- 		cpy: len. "(char *)strncpy()"
  	interpreterProxy
  		storePointer: numModules
  		ofObject: interpreterProxy topRemappableOop
  		withValue: moduleNameObj.
  	numModules := numModules + 1.
  	^0!

Item was changed:
  ----- Method: VMProfileLinuxSupportPlugin>>reap:module:symlinks: (in category 'iteration callbacks') -----
  reap: info module: size symlinks: ignored
  	"like reap:module:names:, but follows symlinks"
  	<returnTypeC: #int>
  	| elfModuleName len moduleNameObj GetAttributeString symLinkBuf |
  	<var: #info type: #'struct dl_phdr_info *'>
  	<var: 'elfModuleName' type: #'const char *'>
  	<var: #GetAttributeString declareC: 'extern char *GetAttributeString(sqInt)'>
  	<var: #symLinkBuf declareC: 'char symLinkBuf[PATH_MAX]'>
  	<var: #size type: #'size_t'>
  	<var: #ignored type: #'void *'>
  	self touch: GetAttributeString.
  	elfModuleName := self cCode: 'numModules ? info->dlpi_name : GetAttributeString(0)'.
  	(elfModuleName isNil
  	 or: [(len := self strlen: elfModuleName) = 0]) ifTrue:
  		[^0]. "skip the fake linux-gate.so.1"
  	moduleNameObj := interpreterProxy
  							instantiateClass: interpreterProxy classString
  							indexableSize: len.
  	moduleNameObj = 0 ifTrue:
  		[primErr := PrimErrNoMemory.
  		 ^1]. "stop iteration"
+ 	self strncpy: (interpreterProxy arrayValueOf: moduleNameObj)
+ 		_: elfModuleName
+ 		_: len. "(char *)strncpy()"
- 	self st: (interpreterProxy arrayValueOf: moduleNameObj)
- 		rn: elfModuleName
- 		cpy: len. "(char *)strncpy()"
  	interpreterProxy
  		storePointer: numModules
  		ofObject: interpreterProxy topRemappableOop
  		withValue: moduleNameObj.
  	"now dereference the symlink, if it exists"
  	self str: symLinkBuf cpy: elfModuleName.
  	(len := self read: elfModuleName li: symLinkBuf nk: #'PATH_MAX') > 0
  		ifTrue:
  			[moduleNameObj := interpreterProxy
  									instantiateClass: interpreterProxy classString
  									indexableSize: len.
  			 moduleNameObj = 0 ifTrue:
  				[primErr := PrimErrNoMemory.
  				 ^1]. "stop iteration"
+ 			 self strncpy: (interpreterProxy arrayValueOf: moduleNameObj)
+ 				_: symLinkBuf
+ 				_: len. "(char *)strncpy()"
- 			 self st: (interpreterProxy arrayValueOf: moduleNameObj)
- 				rn: symLinkBuf
- 				cpy: len. "(char *)strncpy()"
  			 interpreterProxy
  				storePointer: numModules + 1
  				ofObject: interpreterProxy topRemappableOop
  				withValue: moduleNameObj]
  		ifFalse:
  			[interpreterProxy
  				storePointer: numModules + 1
  				ofObject: interpreterProxy topRemappableOop
  				withValue: interpreterProxy nilObject].
  	numModules := numModules + 2.
  	^0!

Item was changed:
  ----- Method: VMProfileMacSupportPlugin>>primitiveExecutableModulesAndOffsets (in category 'primitives') -----
  primitiveExecutableModulesAndOffsets
  	"Answer an Array of quads for executable modules (the VM executable
  	 and loaded libraries).  Each quad is the module's name, its vm address
  	 relocation in memory, the (unrelocated) start address, and the size."
  	| nimages resultObj name valueObj nameObjData slide start size |
  	<export: true>
  	<var: #name type: 'const char *'>
  	<var: #nameObjData type: #'char *'>
  	<var: #h type: 'const struct mach_header *'>
  	<var: #h64 type: 'const struct mach_header_64 *'>
  	<var: #s64 type: 'const struct section_64 *'>
  	<var: #s type: 'const struct section *'>
  	<var: #start type: 'usqIntptr_t'>
  	<var: #slide type: 'usqIntptr_t'>
  	<var: #size type: 'usqIntptr_t'>
  	self cppIf: #'MAC_OS_X_VERSION_MIN_REQUIRED' <= #'MAC_OS_X_VERSION_10_4'
  		ifTrue: "_dyld_present was deprecated in 10.5"
  			[(self cCode: '_dyld_present()' inSmalltalk: false) ifFalse:
  				[^interpreterProxy primitiveFail]].
  	nimages := self cCode: '_dyld_image_count()' inSmalltalk: 0.
  	resultObj := interpreterProxy instantiateClass: interpreterProxy classArray indexableSize: nimages * 4.
  	resultObj = 0 ifTrue:
  		[^interpreterProxy primitiveFail].
  
  	interpreterProxy pushRemappableOop: resultObj.
  	0 to: nimages - 1 do:
  		[:i|
  		start := size := -1. "impossible start & size"
  		name := self cCode: '_dyld_get_image_name(i)' inSmalltalk: 0.
  		slide   := self cCode: '_dyld_get_image_vmaddr_slide(i)' inSmalltalk: 0.
  		self cppIf: #'__x86_64__'
  			ifTrue:
  				[(self cCode: '(const struct mach_header_64 *)_dyld_get_image_header(i)' inSmalltalk: nil) ifNotNil:
  					[:h64|
  					 (self cCode: 'getsectbynamefromheader_64(h64,SEG_TEXT,SECT_TEXT)' inSmalltalk: nil) ifNotNil:
  						[:s64|
  						 start := self cCode: 's64->addr' inSmalltalk: 0.
  						 size := self cCode: 's64->size' inSmalltalk: 0]]]
  			ifFalse:
  				[(self cCode: '_dyld_get_image_header(i)' inSmalltalk: nil) ifNotNil:
  					[:h|
  					 (self cCode: 'getsectbynamefromheader(h,SEG_TEXT,SECT_TEXT)' inSmalltalk: nil) ifNotNil:
  						[:s|
  						 start := self cCode: 's->addr' inSmalltalk: 0.
  						 size := self cCode: 's->size' inSmalltalk: 0]]].
  
  		valueObj := interpreterProxy
  						instantiateClass: interpreterProxy classString
  						indexableSize: (self strlen: name).
  		interpreterProxy failed ifTrue:
  			[interpreterProxy popRemappableOop.
  			 ^interpreterProxy primitiveFail].
  		interpreterProxy storePointer: i * 4 ofObject: interpreterProxy topRemappableOop withValue: valueObj.
  		nameObjData := interpreterProxy arrayValueOf: valueObj.
+ 		self memcpy: nameObjData _: name _: (self strlen: name).
- 		self mem: nameObjData cp: name y: (self strlen: name).
  
  		valueObj := interpreterProxy signedMachineIntegerFor: slide.
  		interpreterProxy failed ifTrue:
  			[interpreterProxy popRemappableOop.
  			 ^interpreterProxy primitiveFail].
  		interpreterProxy storePointer: i * 4 + 1 ofObject: interpreterProxy topRemappableOop withValue: valueObj.
  
  		valueObj := interpreterProxy positiveMachineIntegerFor: start.
  		interpreterProxy failed ifTrue:
  			[interpreterProxy popRemappableOop.
  			 ^interpreterProxy primitiveFail].
  		interpreterProxy storePointer: i * 4 + 2 ofObject: interpreterProxy topRemappableOop withValue: valueObj.
  
  		valueObj := interpreterProxy positiveMachineIntegerFor: size.
  		interpreterProxy failed ifTrue:
  			[interpreterProxy popRemappableOop.
  			 ^interpreterProxy primitiveFail].
  		interpreterProxy storePointer: i * 4 + 3 ofObject: interpreterProxy topRemappableOop withValue: valueObj].
  
  	resultObj := interpreterProxy popRemappableOop.
  	^interpreterProxy pop: 1 thenPush: resultObj!



More information about the Vm-dev mailing list