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

[commits at source.squeak.org]

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

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

Name: VMMaker.oscog-eem.2800
Author: eem
Time: 6 September 2020, 4:58:47.598839 pm
UUID: a6116113-df13-435d-968d-e9b111676754
Ancestors: VMMaker.oscog-eem.2799

Use shared code for string results.
Use storePointerUnchecked: storeInteger: in a few appropriate places.

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

Item was changed:
  ----- Method: CogVMSimulator>>startInContextSuchThat: (in category 'simulation only') -----
  startInContextSuchThat: aBlock
  	"Change the active process's suspendedContext to its sender, which short-cuts the
  	 initialization of the system.  This can be a short-cut to running code, e.g. when doing
  		Smalltalk saveAs.
  		Compiler recompileAll
  	 via e.g.
  		vm startInContextSuchThat: [:ctxt| (vm stringOf: (vm penultimateLiteralOf: (vm methodForContext: ctxt))) = 'DoIt']"
  	<doNotGenerate>
  	| context activeProc |
  	activeProc := self activeProcess.
  	context := objectMemory fetchPointer: SuspendedContextIndex ofObject: activeProc.
  	[context = objectMemory nilObject ifTrue:
  		[^self error: 'no context found'].
  	 aBlock value: context] whileFalse:
  		[context := objectMemory fetchPointer: SenderIndex ofObject: context].
  	objectMemory storePointer: SuspendedContextIndex ofObject: activeProc withValue: context.
  	"Now push a dummy return value."
  	objectMemory
+ 		storePointerUnchecked: (self fetchStackPointerOf: context) + CtxtTempFrameStart
- 		storePointer: (self fetchStackPointerOf: context) + CtxtTempFrameStart
  		ofObject: context
  		withValue: objectMemory nilObject.
  	self storeInteger: StackPointerIndex
  		ofObject: context
  		withValue: (self fetchStackPointerOf: context) + 1!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveGetWindowLabel (in category 'I/O primitives') -----
  primitiveGetWindowLabel
  	"Primitive. Answer the OS window's label"
- 	| ptr sz labelOop |
- 	<var: 'ptr' type: 'char*'>
  	<export: true>
+ 	self methodReturnString: self ioGetWindowLabel!
- 	ptr := self ioGetWindowLabel.
- 	ptr == nil ifTrue:[^self success: false].
- 	sz := self strlen: ptr.
- 	labelOop := objectMemory instantiateClass: objectMemory classString indexableSize: sz.
- 	0 to: sz-1 do:[:i| objectMemory storeByte: i ofObject: labelOop withValue: (ptr at: i)].
- 	self pop: argumentCount+1 thenPush: labelOop!

Item was changed:
  ----- Method: StackInterpreterSimulator>>startInContextSuchThat: (in category 'simulation only') -----
  startInContextSuchThat: aBlock
  	"Change the active process's suspendedContext to its sender, which short-cuts the
  	 initialization of the system.  This can be a short-cut to running code, e.g. when doing
  		Smalltalk saveAs.
  		Compiler recompileAll
  	 via e.g.
  		vm startInContextSuchThat: [:ctxt| (vm stringOf: (vm penultimateLiteralOf: (vm methodForContext: ctxt))) = 'DoIt']"
  	<doNotGenerate>
  	| context activeProc |
  	activeProc := self activeProcess.
  	context := objectMemory fetchPointer: SuspendedContextIndex ofObject: activeProc.
  	[context = objectMemory nilObject ifTrue:
  		[self error: 'no context found'].
  	 aBlock value: context] whileFalse:
  		[context := objectMemory fetchPointer: SenderIndex ofObject: context].
  	objectMemory storePointer: SuspendedContextIndex ofObject: activeProc withValue: context.
  	"Now push a dummy return value."
  	objectMemory
+ 		storePointerUnchecked: (self fetchStackPointerOf: context) + CtxtTempFrameStart
- 		storePointer: (self fetchStackPointerOf: context) + CtxtTempFrameStart
  		ofObject: context
  		withValue: objectMemory nilObject.
  	self storeInteger: StackPointerIndex
  		ofObject: context
  		withValue: (self fetchStackPointerOf: context) + 1!

Item was changed:
  ----- Method: StackInterpreterSimulator>>startInSender (in category 'simulation only') -----
  startInSender
  	"Change the active process's suspendedContext to its sender, which short-cuts the
  	 initialization of the system.  This can be a short-cut to running code, e.g. when doing
  		Smalltalk saveAs.
  		Compiler recompileAll"
  	
  	| activeContext activeProc senderContext |
  	activeProc := self activeProcess.
  	activeContext := objectMemory fetchPointer: SuspendedContextIndex ofObject: activeProc.
  	senderContext := objectMemory fetchPointer: SenderIndex ofObject: activeContext.
  	objectMemory storePointer: SuspendedContextIndex ofObject: activeProc withValue: senderContext.
  	"Now push a dummy return value."
  	objectMemory
+ 		storePointerUnchecked: (self fetchStackPointerOf: senderContext) + CtxtTempFrameStart
- 		storePointer: (self fetchStackPointerOf: senderContext) + CtxtTempFrameStart
  		ofObject: senderContext
  		withValue: objectMemory nilObject.
  	self storeInteger: StackPointerIndex
  		ofObject: senderContext
  		withValue: (self fetchStackPointerOf: senderContext) + 1!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>ffiLoadCalloutAddress: (in category 'symbol loading') -----
  ffiLoadCalloutAddress: lit
  	"Load the address of the foreign function from the given object"
  	| addressPtr address ptr |
  	<var: #ptr type: #'sqIntptr_t *'>
  	"Lookup the address"
  	addressPtr := interpreterProxy fetchPointer: 0 ofObject: lit.
  	"Make sure it's an external handle"
  	address := self ffiContentsOfHandle: addressPtr errCode: FFIErrorBadAddress.
  	interpreterProxy failed ifTrue:
  		[^0].
  	address = 0 ifTrue:"Go look it up in the module"
  		[self externalFunctionHasStackSizeSlot ifTrue:
+ 			[interpreterProxy storeInteger: ExternalFunctionStackSizeIndex ofObject: lit withValue: -1].
- 			[interpreterProxy
- 				storePointer: ExternalFunctionStackSizeIndex
- 				ofObject: lit
- 				withValue: (interpreterProxy integerObjectOf: -1)].
  		(interpreterProxy slotSizeOf: lit) < 5 ifTrue:
  			[^self ffiFail: FFIErrorNoModule].
  		address := self ffiLoadCalloutAddressFrom: lit.
  		interpreterProxy failed ifTrue:
  			[^0].
  		"Store back the address"
  		ptr := interpreterProxy firstIndexableField: addressPtr.
  		ptr at: 0 put: address].
  	^address!