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

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

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

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

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

Name: VMMaker.oscog-eem.2860
Author: eem
Time: 28 October 2020, 11:58:42.592939 pm
UUID: 3836e239-6ba6-476a-a9bc-69f0c0f0098f
Ancestors: VMMaker.oscog-eem.2859

CoInterpreterMT: Get rid of vmOwnerLock; what a bogus idea.  Just use CAS on vmOwner as God (DS) intended.
Cogit: Switch over to double-dispathcing for ProcessorSimulationTrap, adding handleCompareAndSwapSimulationTrap:.  Get rid of the (dis)ownVM: nonsense in FakeStdinStream>>nextm, moving it to FilePlugin>>primitiveFileReadPinningAndDisowning, whjere it belongs, having that method also pin/unpin around the read.

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

Item was added:
+ ----- Method: CoInterpreterMT>>vmOwnerAddress (in category 'simulation') -----
+ vmOwnerAddress
+ <doNotGenerate>
+ ^cogThreadManager vmOwnerAddress!

Item was removed:
- ----- Method: CoInterpreterMT>>vmOwnerLockAddress (in category 'cog jit support') -----
- vmOwnerLockAddress
- <doNotGenerate>
- ^cogThreadManager
- ifNotNil: [:ctm| ctm vmOwnerLockAddress]
- ifNil: [0]!

Item was changed:
  CogClass subclass: #CogThreadManager
(excessive size, no diff calculated)

Item was changed:
  ----- Method: CogThreadManager>>initialize (in category 'initialize-release') -----
  initialize
  <doNotGenerate>
+ vmOwner := numThreads := numThreadsIncrement := 0.
- vmOwner := vmOwnerLock := numThreads := numThreadsIncrement := 0.
  memoryIsScarce := false.
  "N.B.  Do not initialize threadLocalStorage; leave this to ioInitThreadLocalThreadIndices"!

Item was added:
+ ----- Method: CogThreadManager>>vmOwnerAddress (in category 'public api') -----
+ vmOwnerAddress
+ <api> "NB. For the JIT only, so it can generate the lock & unlock functions."
+ <returnTypeC: #usqInt>
+ ^self
+ cCode: [(self addressOf: vmOwner) asUnsignedInteger]
+ inSmalltalk: [cogit simulatedReadWriteVariableAddress: #vmOwnerFromMachineCode in: self]!

Item was added:
+ ----- Method: CogThreadManager>>vmOwnerFromMachineCode (in category 'simulation') -----
+ vmOwnerFromMachineCode
+ ^vmOwner!

Item was added:
+ ----- Method: CogThreadManager>>vmOwnerFromMachineCode: (in category 'simulation') -----
+ vmOwnerFromMachineCode: aValue
+ vmOwner := aValue!

Item was removed:
- ----- Method: CogThreadManager>>vmOwnerLockAddress (in category 'public api') -----
- vmOwnerLockAddress
- <api> "NB. For the JIT only, so it can generate the lock & unlock functions."
- <returnTypeC: #usqInt>
- ^self
- cCode: [(self addressOf: vmOwnerLock) asUnsignedInteger]
- inSmalltalk: [cogit simulatedVariableAddress: #vmOwnerLockFromMachineCode in: self]!

Item was removed:
- ----- Method: CogThreadManager>>vmOwnerLockFromMachineCode (in category 'simulation') -----
- vmOwnerLockFromMachineCode
- ^vmOwnerLock!

Item was removed:
- ----- Method: CogThreadManager>>vmOwnerLockFromMachineCode: (in category 'simulation') -----
- vmOwnerLockFromMachineCode: aValue
- vmOwnerLock := aValue!

Item was removed:
- ----- Method: CogVMSimulator>>vmOwnerLockAddress (in category 'multi-threading simulation switch') -----
- vmOwnerLockAddress
- "This method includes or excludes CoInterpreterMT methods as required.
- Auto-generated by CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate"
-
- ^self perform: #vmOwnerLockAddress
- withArguments: {}
- inSuperclass: (cogThreadManager ifNil: [CoInterpreterPrimitives] ifNotNil: [CoInterpreterMT])!

Item was changed:
  ----- Method: CogVMSimulator>>windowIsClosing (in category 'primitive support') -----
  windowIsClosing
  self threadManager ifNotNil:
  [:threadManager|
  threadManager guiProcess ifNotNil:
  [:guiProcess|
+ (guiProcess ~= Processor activeProcess
+ and: [guiProcess isInteger not]) ifTrue:
- guiProcess ~= Processor activeProcess ifTrue:
  [guiProcess
  signalException:
  (Notification new tag: #evaluateQuit; yourself)].
  Processor terminateActive]].
  quitBlock ifNotNil:
  [:effectiveQuitBlock|
  quitBlock := nil. "stop recursion on explicit window close."
  [effectiveQuitBlock value]
  on: BlockCannotReturn
  do: [:ex|]] "Cause return from #test, et al"!

Item was changed:
  ----- Method: Cogit>>generateVMOwnerLockFunctions (in category 'initialization') -----
  generateVMOwnerLockFunctions
  | startAddress |
  <inline: true>
  self cppIf: COGMTVM
  ifTrue:
  [self allocateOpcodes: backEnd numLowLevelLockOpcodes bytecodes: 0.
  self zeroOpcodeIndex.
  startAddress := methodZoneBase.
+ backEnd generateLowLevelTryLock: coInterpreter vmOwnerAddress.
- backEnd generateLowLevelTryLock: coInterpreter vmOwnerLockAddress.
  self outputInstructionsForGeneratedRuntimeAt: startAddress.
  self recordGeneratedRunTime: 'ceTryLockVMOwner' address: startAddress.
  ceTryLockVMOwner := self cCoerceSimple: startAddress to: #'usqIntptr_t (*)(void)'.
 
  self zeroOpcodeIndex.
  initialPC := 0.
  endPC := numAbstractOpcodes - 1.
  startAddress := methodZoneBase.
+ backEnd generateLowLevelUnlock: coInterpreter vmOwnerAddress.
- backEnd generateLowLevelUnlock: coInterpreter vmOwnerLockAddress.
  self outputInstructionsForGeneratedRuntimeAt: startAddress.
  self recordGeneratedRunTime: 'ceUnlockVMOwner' address: startAddress.
  ceUnlockVMOwner := self cCoerceSimple: startAddress to: #'void (*)(void)']!

Item was changed:
  ----- Method: Cogit>>handleCallOrJumpSimulationTrap: (in category 'simulation only') -----
  handleCallOrJumpSimulationTrap: aProcessorSimulationTrap
  <doNotGenerate>
  | evaluable function memory result savedFramePointer savedStackPointer savedArgumentCount retpc |
+
+ "This is a hack fix before we revise the simulators.  When a jump call is made, the next
+ pc is effectively the return address on the stack, not the instruction following the jump."
+ aProcessorSimulationTrap type == #jump ifTrue:
+ [processor hackFixNextPCOfJumpFor: aProcessorSimulationTrap using: objectMemory].
+
  evaluable := simulatedTrampolines
  at: aProcessorSimulationTrap address
  ifAbsent: [self errorProcessingSimulationTrap: aProcessorSimulationTrap
  in: simulatedTrampolines].
  function := evaluable isBlock
  ifTrue: ['aBlock; probably some plugin primitive']
  ifFalse:
  [evaluable receiver == backEnd ifTrue:
  [^self handleABICallOrJumpSimulationTrap: aProcessorSimulationTrap evaluable: evaluable].
  evaluable selector].
  memory := coInterpreter memory.
  function == #interpret ifTrue: "i.e. we're here via ceInvokeInterpret and should discard all state back to enterSmalltalkExecutiveImplementation"
  [processor
  simulateJumpCallOf: aProcessorSimulationTrap address
  memory: memory.
  self recordInstruction: {'(simulated jump call of '. aProcessorSimulationTrap address. '/'. function. ')'}.
  processor smashCallerSavedRegistersWithValuesFrom: 16r80000000 by: objectMemory wordSize in: memory.
  coInterpreter reenterInterpreter.
  "NOTREACHED"
  self halt].
  function ~~ #ceBaseFrameReturn: ifTrue:
  [coInterpreter assertValidExternalStackPointers].
  (backEnd wantsNearAddressFor: function) ifTrue:
  [^self perform: function with: aProcessorSimulationTrap].
  processor
  simulateCallOf: aProcessorSimulationTrap address
  nextpc: aProcessorSimulationTrap nextpc
  memory: memory.
  retpc := processor retpcIn: memory.
  self recordInstruction: {'(simulated call of '. aProcessorSimulationTrap address. '/'. function. ')'}.
  savedFramePointer := coInterpreter framePointer.
  savedStackPointer := coInterpreter stackPointer.
  savedArgumentCount := coInterpreter argumentCount.
  result := ["self halt: evaluable selector."
      clickConfirm ifTrue:
  [(self confirm: 'skip run-time call?') ifFalse:
  [clickConfirm := false. self halt]].
    evaluable valueWithArguments: (processor
  postCallArgumentsNumArgs: evaluable numArgs
  in: memory)]
  on: ReenterMachineCode
  do: [:ex| ex return: #continueNoReturn].
 
  coInterpreter assertValidExternalStackPointers.
  "Verify the stack layout assumption compileInterpreterPrimitive: makes, provided we've
  not called something that has built a frame, such as closure value or evaluate method, or
  switched frames, such as primitiveSignal, primitiveWait, primitiveResume, primitiveSuspend et al."
  (function beginsWith: 'primitive') ifTrue:
  [coInterpreter primFailCode = 0
  ifTrue: [(CogVMSimulator stackAlteringPrimitives includes: function) ifFalse:
  ["This is a rare case (e.g. in Scorch where a married context's sender is set to nil on trapTrpped and hence the stack layout is altered."
  (function == #primitiveSlotAtPut and: [objectMemory isContext: (coInterpreter frameReceiver: coInterpreter framePointer)]) ifFalse:
  [self assert: savedFramePointer = coInterpreter framePointer.
  self assert: savedStackPointer + (savedArgumentCount * objectMemory wordSize)
  = coInterpreter stackPointer]]]
  ifFalse:
  [self assert: savedFramePointer = coInterpreter framePointer.
  self assert: savedStackPointer = coInterpreter stackPointer]].
  result ~~ #continueNoReturn ifTrue:
  [self recordInstruction: {'(simulated return to '. processor retpcIn: memory. ')'}.
  processor simulateReturnIn: memory.
  self assert: processor pc = retpc.
  processor smashCallerSavedRegistersWithValuesFrom: 16r80000000 by: objectMemory wordSize in: memory].
  self assert: (result isInteger "an oop result"
  or: [result == coInterpreter
  or: [result == objectMemory
  or: [result == nil
  or: [result == #continueNoReturn]]]]).
  processor cResultRegister: (result
  ifNil: [0]
  ifNotNil: [result isInteger
  ifTrue: [result]
  ifFalse: [16rF00BA222]])!

Item was added:
+ ----- Method: Cogit>>handleCompareAndSwapSimulationTrap: (in category 'simulation only') -----
+ handleCompareAndSwapSimulationTrap: aCompareAndSwapSimulationTrap
+ | variableValue accessor |
+ variableValue := (simulatedVariableGetters
+ at: aCompareAndSwapSimulationTrap address
+ ifAbsent: [self errorProcessingSimulationTrap: aCompareAndSwapSimulationTrap
+ in: simulatedVariableGetters])
+ value asInteger.
+ variableValue = aCompareAndSwapSimulationTrap expectedValue ifTrue:
+ [(simulatedVariableSetters
+ at: aCompareAndSwapSimulationTrap address
+ ifAbsent: [self errorProcessingSimulationTrap: aCompareAndSwapSimulationTrap
+ in: simulatedVariableSetters]) value: aCompareAndSwapSimulationTrap storedValue].
+ accessor := aCompareAndSwapSimulationTrap registerAccessor.
+ processor
+ perform: accessor
+ with: (processor convertIntegerToInternal: variableValue).
+ processor pc: aCompareAndSwapSimulationTrap nextpc.
+ aCompareAndSwapSimulationTrap resume: processor!

Item was changed:
  ----- Method: Cogit>>handleReadSimulationTrap: (in category 'simulation only') -----
  handleReadSimulationTrap: aProcessorSimulationTrap
  <doNotGenerate>
  | variableValue accessor |
  variableValue := (simulatedVariableGetters
  at: aProcessorSimulationTrap address
  ifAbsent: [self errorProcessingSimulationTrap: aProcessorSimulationTrap
  in: simulatedVariableGetters])
  value asInteger.
  accessor := aProcessorSimulationTrap registerAccessor.
  processor
  perform: accessor
  with: (processor convertIntegerToInternal: variableValue).
  accessor ~~ #pc: ifTrue:
  [processor pc: aProcessorSimulationTrap nextpc.
  "In an enilopmart stackPointer is assigned to sp before framePointer.
   In a trampoline fp and sp are written to the interpreter variables immediately before
   assigning sp with CStackPointer and immediately there-after fp with CFramePointer.
   So set processorFrameValid appropriately when assigning fp.  This is for CogHeadFrameInspector"
  (processor accessorIsFramePointerSetter: accessor) ifTrue:
+ [processorFrameValid := aProcessorSimulationTrap address ~= (simulatedAddresses at: #getCFramePointer)]].
+ aProcessorSimulationTrap resume: processor!
- [processorFrameValid := aProcessorSimulationTrap address ~= (simulatedAddresses at: #getCFramePointer)]]!

Item was added:
+ ----- Method: Cogit>>handleReturnSimulationTrap: (in category 'simulation only') -----
+ handleReturnSimulationTrap: aProcessorSimulationTrap
+ <doNotGenerate>
+ | retpc |
+ retpc := processor leafRetpcIn: coInterpreter memory.
+ processor simulateLeafReturnIn: coInterpreter memory.
+ self recordInstruction: {'(simulated return to '. retpc. ')'}!

Item was changed:
  ----- Method: Cogit>>handleWriteSimulationTrap: (in category 'simulation only') -----
  handleWriteSimulationTrap: aProcessorSimulationTrap
  <doNotGenerate>
  | variableValue |
  (self addressIsInCodeZone: aProcessorSimulationTrap address) ifTrue:
  [self error: 'attempt to write to code space'].
  variableValue := processor perform: aProcessorSimulationTrap registerAccessor.
  (simulatedVariableSetters
  at: aProcessorSimulationTrap address
  ifAbsent: [self errorProcessingSimulationTrap: aProcessorSimulationTrap
  in: simulatedVariableSetters])
  value: variableValue.
+ processor pc: aProcessorSimulationTrap nextpc.
+ ^aProcessorSimulationTrap resume: processor!
- processor pc: aProcessorSimulationTrap nextpc!

Item was changed:
  ----- Method: Cogit>>simulateCogCodeAt: (in category 'simulation only') -----
  simulateCogCodeAt: address "<Integer>"
  <doNotGenerate>
  | stackZoneBase |
  stackZoneBase := coInterpreter stackZoneBase.
  processor pc: address.
  [[[singleStep
  ifTrue:
  [[processor sp < stackZoneBase ifTrue: [self halt].
   self recordProcessing.
   self maybeBreakAt: processor pc] value. "So that the Debugger's Over steps over all this"
   processor
  singleStepIn: coInterpreter memory
  minimumAddress: guardPageSize
  readOnlyBelow: methodZone zoneEnd]
  ifFalse:
  [processor
  runInMemory: coInterpreter memory
  minimumAddress: guardPageSize
  readOnlyBelow: methodZone zoneEnd].
    "((printRegisters or: [printInstructions]) and: [clickConfirm]) ifTrue:
  [(self confirm: 'continue?') ifFalse:
  [clickConfirm := false. self halt]]."
    true] whileTrue]
  on: ProcessorSimulationTrap
+ do: [:ex| ex applyTo: self].
- do: [:ex|
- ex type == #read ifTrue:
- [self handleReadSimulationTrap: ex. ex resume: processor].
- ex type == #write ifTrue:
- [self handleWriteSimulationTrap: ex. ex resume: processor].
- ex type == #jump ifTrue:
- [processor hackFixNextPCOfJumpFor: ex using: objectMemory].
- self handleCallOrJumpSimulationTrap: ex].
  true] whileTrue!

Item was changed:
  ----- Method: Cogit>>simulateLeafCallOf: (in category 'simulation only') -----
  simulateLeafCallOf: someFunction
  "Simulate execution of machine code that leaf-calls someFunction,
  answering the result returned by someFunction."
  "CogProcessorAlienInspector openFor: coInterpreter"
  <doNotGenerate>
  | priorSP priorPC priorLR spOnEntry bogusRetPC |
  self recordRegisters.
  priorSP := processor sp.
  priorPC := processor pc.
  priorLR := backEnd hasLinkRegister ifTrue: [processor lr].
  processor
  setFramePointer: coInterpreter getCFramePointer stackPointer: coInterpreter getCStackPointer;
  simulateLeafCallOf: someFunction
  nextpc: (bogusRetPC := 16rBADF00D5 roundTo: backEnd codeGranularity)
  memory: coInterpreter memory.
  spOnEntry := processor sp.
  self recordInstruction: {'(simulated call of '. someFunction. ')'}.
+ ^[[processor pc between: 0 and: methodZone zoneEnd] whileTrue:
- [[processor pc between: 0 and: methodZone zoneEnd] whileTrue:
  [[singleStep
  ifTrue: [self recordProcessing.
  self maybeBreakAt: processor pc.
  processor
  singleStepIn: coInterpreter memory
  minimumAddress: guardPageSize
  readOnlyBelow: methodZone zoneEnd]
  ifFalse: [processor
  runInMemory: coInterpreter memory
  minimumAddress: guardPageSize
  readOnlyBelow: methodZone zoneEnd]]
  on: ProcessorSimulationTrap, Error
+ do: [:ex|
+ "Again this is a hack for the processor simulators not properly simulating returns to bogus addresses.
+ In this case BochsX64Alien doesn't do the right thing."
- do: [:ex| | retpc |
  processor pc = bogusRetPC ifTrue:
  [self recordInstruction: {'(simulated (real) return to '. processor pc. ')'}.
  ^processor cResultRegister].
+ ex isProcessorSimulationTrap ifFalse:
+ [ex pass].
+ ex applyTo: self.
+ ex type == #return ifTrue:
+ [^processor cResultRegister]]].
- ex class == ProcessorSimulationTrap ifTrue:
- [ex type == #read ifTrue:
- [self handleReadSimulationTrap: ex. ex resume: processor].
- ex type == #write ifTrue:
- [self handleWriteSimulationTrap: ex. ex resume: processor].
- ex type == #return ifTrue:
- [retpc := processor leafRetpcIn: coInterpreter memory.
- self assert: retpc = bogusRetPC.
- processor simulateLeafReturnIn: coInterpreter memory.
- self recordInstruction: {'(simulated return to '. retpc. ')'}.
- ^processor cResultRegister]].
- ex pass]].
  processor pc = bogusRetPC ifTrue:
  [self recordInstruction: {'(simulated (real) return to '. processor pc. ')'}].
+ processor cResultRegister]
- ^processor cResultRegister]
  ensure:
  [processor sp: priorSP.
  processor pc: priorPC.
  priorLR ifNotNil: [:lr| processor lr: lr]]!

Item was changed:
  ----- Method: FakeStdinStream>>next (in category 'accessing') -----
  next
  "Answer the next object in the Stream represented by the receiver.
  If there are no more elements in the stream fill up the buffer by prompting for input"
+ | sem inputLine next |
- | sem threadIndex inputLine next |
  position >= readLimit ifTrue:
  [simulator isThreadedVM
  ifTrue:
+ [simulator forceInterruptCheckFromHeartbeat.
- ["(simulator cogit singleStep not
-  and: [UIManager confirm: 'Single step?']) ifTrue:
- [simulator cogit singleStep: true]."
- threadIndex := simulator disownVM: DisownVMLockOutFullGC.
- simulator forceInterruptCheckFromHeartbeat.
  sem := Semaphore new.
  WorldState addDeferredUIMessage:
  [inputLine := UIManager default request: 'Input please!!'.
  sem signal].
  sem wait]
  ifFalse: "simulate line-oriented input"
  [inputLine := ((Smalltalk classNamed: #FillInTheBlankMorph)
  ifNotNil: "Squeak"
  [:fITBM|
  fITBM
  request: 'Input please!!'
  initialAnswer: ''
  centerAt: ActiveHand cursorPoint
  inWorld: ActiveWorld
  onCancelReturn: nil
  acceptOnCR: true]
  ifNil: "Pharo; onCancelReturn: nil is the default here"
  [UIManager default
  request: 'Input please!!'
  initialAnswer: '']).
  inputLine ifNil: [self atEnd: true. ^nil]].
  collection size <= inputLine size ifTrue:
  [collection := collection species new: inputLine size + 1].
  collection
  replaceFrom: 1 to: inputLine size with: inputLine startingAt: 1;
  at: (readLimit := inputLine size + 1) put: Character lf.
+ position := 0].
- position := 0.
- simulator isThreadedVM ifTrue:
- [simulator ownVM: threadIndex]].
  next := collection at: (position := position + 1).
  ^next
 
 
  " This does it with workspaces:
  | ws r s |
  s := Semaphore new.
  ws := Workspace new contents: ''.
  ws acceptAction: [:t| r := t asString. s signal].
  [ws openLabel: 'Yo!!'; shouldStyle: false.
  (ws dependents detect: [:dep | dep isKindOf: PluggableTextMorph] ifNone: [nil]) ifNotNil:
  [:textMorph| textMorph acceptOnCR: true; hasUnacceptedEdits: true]] fork.
  Processor activeProcess ==  Project uiProcess
  ifTrue: [[r isNil] whileTrue: [World doOneCycle]]
  ifFalse: [s wait].
  ws topView delete.
  s wait. s signal.
  r"!

Item was changed:
  ----- Method: FilePlugin>>primitiveFileRead (in category 'file primitives') -----
  primitiveFileRead
  <export: true>
  self cppIf: SPURVM
+ ifTrue: [self cppIf: COGMTVM
+ ifTrue: [self primitiveFileReadPinningAndDisowning]
+ ifFalse: [self primitiveFileReadWithPinning]]
- ifTrue: [self primitiveFileReadWithPinning]
  ifFalse: [self primitiveFileReadWithoutPinning]!

Item was added:
+ ----- Method: FilePlugin>>primitiveFileReadPinningAndDisowning (in category 'file primitives') -----
+ primitiveFileReadPinningAndDisowning
+ "This version of primitiveFileRead is for garbage collectors that support pinning
+ and the multi-threaded VM.  It actually does the own/disown dance."
+ | count startIndex array file slotSize elementSize bytesRead threadIndexAndFlags wasPinned |
+ <inline: true>
+ <var: 'file' type: #'SQFile *'>
+ <var: 'count' type: #'size_t'>
+ <var: 'startIndex' type: #'size_t'>
+ <var: 'slotSize' type: #'size_t'>
+ <var: 'elementSize' type: #'size_t'>
+ count := interpreterProxy positiveMachineIntegerValueOf: (interpreterProxy stackValue: 0).
+ startIndex := interpreterProxy positiveMachineIntegerValueOf: (interpreterProxy stackValue: 1).
+   array := interpreterProxy stackValue: 2.
+ file := self fileValueOf: (interpreterProxy stackValue: 3).
+
+ (interpreterProxy failed
+ "buffer can be any indexable words or bytes object except CompiledMethod"
+ or: [(interpreterProxy isWordsOrBytes: array) not]) ifTrue:
+ [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+
+ slotSize := interpreterProxy slotSizeOf: array.
+ (startIndex >= 1 and: [startIndex + count - 1 <= slotSize]) ifFalse:
+ [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
+ (wasPinned := interpreterProxy isPinned: array) ifFalse:
+ [array := interpreterProxy pinObject: array].
+ threadIndexAndFlags := interpreterProxy disownVM: DisownVMForFFICall.
+ "Note: adjust startIndex for zero-origin byte indexing"
+ elementSize := slotSize = 0
+ ifTrue: [1]
+ ifFalse: [(interpreterProxy byteSizeOf: array) // slotSize].
+ bytesRead := self
+ sqFile: file
+ Read: count * elementSize
+ Into: (interpreterProxy cCoerce: (interpreterProxy firstIndexableField: array) to: #'char *')
+ At: startIndex - 1 * elementSize.
+ interpreterProxy ownVM: threadIndexAndFlags.
+ wasPinned ifFalse:
+ [interpreterProxy unpinObject: array].
+ interpreterProxy failed ifFalse:
+ [interpreterProxy methodReturnInteger: bytesRead // elementSize] "answer # of elements read"!