VM Maker: VMMaker.oscog-eem.2800.mcz

 
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!