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

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

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

Name: VMMaker.oscog-eem.2863
Author: eem
Time: 29 October 2020, 6:11:02.270516 pm
UUID: b8007876-9c01-49e1-90da-6b2059369a5c
Ancestors: VMMaker.oscog-eem.2862

Cogit: Make sure stackLimit is the first clustered variable, ticky because it has a pseudonym.
Implement flag setting in compare-and-swaps that do so (X64).
Correct the range of valid pcs in simulateLeafCallOf:.
Remember to pass the argument to ceTryLockVMOwner.
Simplify the FakeStdinStream crap, providing line-oriented input.

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

Item was changed:
  ----- Method: CoInterpreter class>>clusteredVariableNames (in category 'translation') -----
  clusteredVariableNames
  "Insist that these variables are present early in the list of variables, and in this order,
  so that e.g. they are conveniently accessed via the VarBaseReg if it is available."
+ ^#(stackLimitFromMachineCode "ensures zero offset in simulation" stackLimit "stackLimit is e.g. lowest using the clang toolchain on MacOS X"
+ stackPointer framePointer CStackPointer CFramePointer CReturnAddress
+ scavengeThreshold freeStart needGCFlag specialObjectsOop
- ^#(stackPointer framePointer CStackPointer CFramePointer CReturnAddress
- stackLimit scavengeThreshold freeStart needGCFlag specialObjectsOop
  primFailCode newMethod instructionPointer argumentCount nextProfileTick
  nativeSP nativeStackPointer shadowCallStackPointer)!

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 ifNotNil:
- disowningVMThread notNil ifTrue:
  [vmThread = disowningVMThread ifTrue:
  [self cCode: ''
  inSmalltalk:
  [| range |
  range := self cStackRangeForThreadIndex: threadIndex.
  self assert: (range includes: CStackPointer).
  self assert: (range includes: CFramePointer)].
  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.
  vmThread newMethodOrNull: nil.
  self cCode: ''
  inSmalltalk:
  [| range |
  range := self cStackRangeForThreadIndex: threadIndex.
  self assert: (range includes: vmThread cStackPointer).
  self assert: (range includes: vmThread cFramePointer)].
  self setCFramePointer: vmThread cFramePointer setCStackPointer: vmThread cStackPointer.
  self assert: newMethod ~~ nil.
  cogit recordEventTrace ifTrue:
  [self recordTrace: TraceOwnVM thing: ConstTwo source: 0].
  ^threadIndexAndFlags bitAnd: OwnVMForeignThreadFlag!

Item was changed:
  ----- Method: CogThreadManager>>acquireVMFor: (in category 'public api') -----
  acquireVMFor: threadIndex
  "Attempt to acquire the VM, eventually blocking until it becomes available.
  Spin until the maxWaitingPriority has been updated if it is lower than this thread's priority."
  <returnTypeC: #'CogVMThread *'>
  | vmThread |
  <var: #vmThread type: #'CogVMThread *'>
  self assert: threadIndex = self ioGetThreadLocalThreadIndex.
  vmThread := self vmThreadAt: threadIndex.
  self assert: (vmThread state = CTMUnavailable
  or: [vmThread state = CTMWantingOwnership]).
  (cogit tryLockVMOwner: threadIndex) ifFalse:
  [vmThread state: CTMWantingOwnership.
+ [cogit tryLockVMOwner: threadIndex] whileFalse:
- [cogit tryLockVMToIndex: threadIndex] whileFalse:
  [[coInterpreter getMaxWaitingPriority < vmThread priority] whileTrue:
  [coInterpreter waitingPriorityIsAtLeast: vmThread priority].
  vmOwner ~= threadIndex ifTrue:
  [self ioWaitOnOSSemaphore: (self addressOf: vmThread osSemaphore)]]].
  vmOSThread := vmThread osThread.
  vmThread state: CTMAssignableOrInVM.
  ^vmThread!

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

Item was changed:
  ----- Method: CogThreadManager>>vmOwnerFromMachineCode: (in category 'simulation') -----
  vmOwnerFromMachineCode: aValue
+ <doNotGenerate>
+ self assert: (aValue between: 0 and: numThreads).
  vmOwner := aValue!

Item was changed:
  ----- 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].
+ processor setFlagsForCompareAndSwap: variableValue = aCompareAndSwapSimulationTrap expectedValue.
  accessor := aCompareAndSwapSimulationTrap registerAccessor.
  processor
  perform: accessor
  with: (processor convertIntegerToInternal: variableValue).
  processor pc: aCompareAndSwapSimulationTrap nextpc.
  aCompareAndSwapSimulationTrap resume: processor!

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: self class guardPageSize 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."
  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]]].
  processor pc = bogusRetPC ifTrue:
  [self recordInstruction: {'(simulated (real) return to '. processor pc. ')'}].
  processor cResultRegister]
  ensure:
  [processor sp: priorSP.
  processor pc: priorPC.
  priorLR ifNotNil: [:lr| processor lr: lr]]!

Item was changed:
  ----- Method: Cogit>>tryLockVMOwner: (in category 'multi-threading') -----
  tryLockVMOwner: value
  <api>
  "ceTryLockVMOwner does an atomic compare-and-swap of the lock
  with the argument and zero, setting the lock to value if it was zero.
  It answers non-zero if the lock was zero."
  <cmacro: '(value) ceTryLockVMOwner(value)'>
+ processor abiMarshallArg0: value.
  ^(self simulateLeafCallOf: ceTryLockVMOwner) ~= 0!

Item was added:
+ ----- Method: FakeStdinStream>>sqFile:Read:Into:At: (in category 'accessing') -----
+ sqFile: file Read: count Into: byteArrayIndexArg At: startIndex
+ "Simulate the read primitive by answering a line of input"
+ | inputLine n |
+ position >= readLimit ifTrue:
+ [simulator isThreadedVM ifTrue:
+ [simulator forceInterruptCheckFromHeartbeat].
+ inputLine := FillInTheBlankMorph
+ request: 'Input please!!'
+ initialAnswer: ''
+ centerAt: ActiveHand cursorPoint
+ inWorld: ActiveWorld
+ onCancelReturn: nil
+ acceptOnCR: true.
+ inputLine ifNil: [self atEnd: true. ^0].
+ 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].
+ n := count min: readLimit - position.
+ simulator
+ strncpy: byteArrayIndexArg + startIndex
+ _: (collection copyFrom: position + 1 to: position + n)
+ _: n.
+ position := position + n.
+ ^n!

Item was changed:
  ----- Method: FilePluginSimulator>>sqFile:Read:Into:At: (in category 'simulation') -----
+ sqFile: file Read: count Into: byteArrayIndexArg At: startIndex
+ | byteArrayIndex |
+ file isFakeStdinStream ifTrue:
+ [^file sqFile: file Read: count Into: byteArrayIndexArg At: startIndex].
- sqFile: file Read: countArg Into: byteArrayIndexArg At: startIndex
- | byteArrayIndex count |
- count := file isFakeStdinStream
- ifTrue: [1]
- ifFalse: [countArg].
  byteArrayIndex := byteArrayIndexArg asInteger. "Coerces CArray et al correctly"
  [[startIndex to: startIndex + count - 1 do:
  [ :i |
+ interpreterProxy byteAt: byteArrayIndex + i put: (file next ifNil: [^i - startIndex] ifNotNil: [:charOrByte| charOrByte asInteger])]]
- file atEnd ifTrue: [^i - startIndex].
- interpreterProxy
- byteAt: byteArrayIndex + i
- put: (file next ifNil: [file isFakeStdinStream ifTrue: [^0]] ifNotNil: [:c| c asInteger])]]
  on: Error
  do: [:ex|
  (file isStream and: [file isTranscriptStream]) ifFalse:
  [ex pass].
  ^0]]
  ensure: [self recordStateOf: file].
  ^count!