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

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

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

Name: VMMaker.oscog-eem.2875
Author: eem
Time: 10 November 2020, 1:38:57.951349 pm
UUID: fbdf45b1-d757-4183-a2bd-1ebc595763e9
Ancestors: VMMaker.oscog-eem.2874

COGMTVM/interpreters: make sure the VM shuts down correctly, including terminating all threads/processes in the MT simulation, the SocketPlgin, etc.  Fix the mapping of Processes (which are emulating threads) to integers by adding Process>>asUnsignedInteger.  Hence CogThreadManager>>ioCurrentOSThread to answer Processor activeProcess.  In simulation make sure the VM calls ioShutdownAllModules.

InterpreterPlugin: Add the stackBooleanValue: from the 3D-ICC plugins.

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

Item was changed:
  ----- Method: AsynchFilePlugin>>shutdownModule (in category 'initialize-release') -----
  shutdownModule
  "Initialise the module"
  <export: true>
+ ^self asyncFileShutdown!
- ^self cCode: 'asyncFileShutdown()' inSmalltalk:[true]!

Item was changed:
  ----- Method: CoInterpreterMT>>ownVMFromUnidentifiedThread (in category 'vm scheduling') -----
  ownVMFromUnidentifiedThread
  "Attempt to take ownership from a thread that as yet doesn't know its index.
  This supports callbacks where the callback could originate from any thread.
 
  Answer 0 if the owning thread is known to the VM.
  Answer 1 if the owning thread is unknown to the VM and now owns the VM.
  Answer -1 if the owning thread is unknown to the VM and fails to own the VM.
  Answer -2 if the owning thread is unknown to the VM and there is no foreign callback process installed."
  | count threadIndex vmThread |
  <var: #vmThread type: #'CogVMThread *'>
  <inline: false>
  (threadIndex := cogThreadManager ioGetThreadLocalThreadIndex) ~= 0 ifTrue:
  [ "this is a callback from a known thread"
  (cogThreadManager vmOwnerIs: threadIndex) ifTrue: "the VM has not been disowned"
  [self assert: (disowningVMThread isNil or: [disowningVMThread = self currentVMThread]).
  disowningVMThread := nil.
  self currentVMThread state: CTMAssignableOrInVM.
  ^VMAlreadyOwnedHenceDoNotDisown].
  ^self ownVM: threadIndex].
  foreignCallbackPriority = 0 ifTrue:
  [^-2].
  count := 0.
  "If the current thread doesn't have an index it's new to the vm
  and we need to allocate a new threadInfo, failing if we can't.
  We also need a process in the foreignCallbackProcessSlot upon
  which to run the thread's eventual callback."
+ [[cogit tryLockVMOwnerTo: cogThreadManager ioCurrentOSThread asUnsignedInteger] whileFalse:
- [[cogit tryLockVMOwnerTo: cogThreadManager ioCurrentOSThread] whileFalse:
  [self waitingPriorityIsAtLeast: foreignCallbackPriority.
  cogThreadManager ioTransferTimeslice].
  (objectMemory splObj: foreignCallbackProcessSlot) ~= objectMemory nilObject] whileFalse:
  [cogThreadManager releaseVM.
  (count := count + 1) > 1000 ifTrue:
  [^-2].
  cogThreadManager ioMilliSleep: 1].
 
  vmThread := cogThreadManager unusedThreadInfo.
  "N.B.  Keep the VM locked anonymously so that we reserve the non-nil ForeignCallbackProcess
  for this thread, avoiding the race between competing foreign callbacks.  The acquireVMFor: in
  ownVM: will set the vmOwner to the actual index.  So only unlock on failure."
  vmThread ifNil:
  [cogThreadManager releaseVM.
  ^-1].
  cogThreadManager setVMOwner: vmThread index.
  vmThread
  state: CTMWantingOwnership;
  priority: foreignCallbackPriority.
  cogThreadManager registerVMThread: vmThread.
  ^self ownVM: vmThread index + OwnVMForeignThreadFlag!

Item was changed:
  ----- Method: CogThreadManager>>ioCurrentOSThread (in category 'simulation') -----
  ioCurrentOSThread
  <doNotGenerate>
  "See platforms/<plat>/vm/sqPlatformSpecific.h for the real definition."
+ ^Processor activeProcess!
- ^Processor activeProcess identityHash!

Item was changed:
  ----- Method: CogThreadManager>>ioNewOSSemaphore: (in category 'simulation') -----
  ioNewOSSemaphore: semaphorePointer "<BlockClosure>"
  <doNotGenerate>
  "See platforms/Cross/vm/sq.h for the real definition."
+ semaphorePointer at: 0 put: Semaphore new.
- semaphorePointer value: Semaphore new.
  ^0!

Item was changed:
  ----- Method: CogThreadManager>>populate:from:to: (in category 'thread set') -----
  populate: vmThreadPointers from: start to: finish
  "Populate vmThreadPointers with vmThreads over the given range."
  <var: #vmThreadPointers type: #'CogVMThread **'>
  | nThreads vmThreads |
  <var: #vmThreads type: #'CogVMThread *'>
  <var: #vmThread type: #'CogVMThread *'>
  <inline: true>
  nThreads := finish - start + 1.
+ vmThreads := self cCode: [self calloc: nThreads _: (self sizeof: CogVMThread)]
- vmThreads := self cCode: [self c: nThreads alloc: (self sizeof: CogVMThread)]
  inSmalltalk: [CArrayAccessor on: ((1 to: nThreads) collect: [:ign| CogVMThread new])].
+ vmThreads ifNil:
- vmThreads isNil ifTrue:
  [^false].
+ "Since 0 is not a valid index, in C we allocate one extra CogVMThread and use 1-relative indices."
+ self cCode: [start = 1 ifTrue: [vmThreadPointers at: 0 put: nil]]
- self cCode:
- [start = 1 ifTrue:
- [vmThreadPointers at: 0 put: nil]]
  inSmalltalk: [].
  start to: finish do:
  [:i| | vmThread |
  vmThread := self addressOf: (vmThreads at: i - start).
+ (self ioNewOSSemaphore: (self addressOf: vmThread osSemaphore put: [:sem| vmThread osSemaphore: sem])) ~= 0 ifTrue:
- (self ioNewOSSemaphore: (self cCode: [self addressOf: vmThread osSemaphore]
- inSmalltalk: [[:sem| vmThread osSemaphore: sem]])) ~= 0 ifTrue:
  [start to: i - 1 do:
  [:j|
  vmThread := self addressOf: (vmThreads at: j - start).
  self ioDestroyOSSemaphore: (self addressOf: vmThread osSemaphore)].
  self free: vmThreads.
  ^false].
  vmThreadPointers at: i put: vmThread.
  vmThread awolProcLength: AWOLProcessesIncrement.
  vmThread index: i].
  ^true!

Item was added:
+ ----- Method: CogThreadManager>>shutdownModule (in category 'simulation') -----
+ shutdownModule
+ <doNotGenerate>
+ | guiProcess |
+ threads ifNil: [^self].
+ (guiProcess := self guiProcess) ~= Processor activeProcess ifTrue:
+ [guiProcess
+ signalException:
+ (Notification new tag: #evaluateQuit; yourself).
+ Processor terminateActive].
+ threads do:
+ [:ea|
+ ea osThread ifNotNil:
+ [:aProcess|
+ (aProcess ~~ Processor activeProcess and: [aProcess ~~ guiProcess]) ifTrue:
+ [aProcess terminate]]]!

Item was changed:
+ ----- Method: CogVMSimulator>>close (in category 'initialize-release') -----
- ----- Method: CogVMSimulator>>close (in category 'initialization') -----
  close  "close any files that ST may have opened, etc"
  pluginList do: [:assoc| | plugin | plugin := assoc value. plugin ~~ self ifTrue: [plugin close]].
  "Ugh; at least some of this code belongs in the UI..."
  displayView ifNotNil:
  [displayView activeHand removeEventListener: self].
  ActiveHand removeEventListener: self.
  World submorphs do:
  [:submorph|
  (submorph model isVMObjectInspector
  and: [submorph model coInterpreter == self]) ifTrue:
  [submorph delete].
  (submorph model isDebugger
  and: [(submorph model interruptedProcess suspendedContext ifNotNil:
  [:sctxt|
  sctxt findContextSuchThat:
  [:ctxt|
  (ctxt receiver == cogit
  and: [ctxt selector == #simulateCogCodeAt:])
  or: [ctxt receiver == self
  and: [ctxt selector == #interpret]]]]) notNil]) ifTrue:
  [submorph model windowIsClosing.
  submorph delete]]!

Item was changed:
+ ----- Method: CogVMSimulator>>desiredCogCodeSize: (in category 'initialize-release') -----
- ----- Method: CogVMSimulator>>desiredCogCodeSize: (in category 'initialization') -----
  desiredCogCodeSize: anInteger
  desiredCogCodeSize := anInteger!

Item was changed:
+ ----- Method: CogVMSimulator>>desiredEdenBytes: (in category 'initialize-release') -----
- ----- Method: CogVMSimulator>>desiredEdenBytes: (in category 'initialization') -----
  desiredEdenBytes: anInteger
  desiredEdenBytes := anInteger!

Item was changed:
+ ----- Method: CogVMSimulator>>desiredNumStackPages: (in category 'initialize-release') -----
- ----- Method: CogVMSimulator>>desiredNumStackPages: (in category 'initialization') -----
  desiredNumStackPages: anInteger
  desiredNumStackPages := anInteger!

Item was changed:
+ ----- Method: CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate (in category 'initialize-release') -----
- ----- Method: CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate (in category 'initialization') -----
  ensureMultiThreadingOverridesAreUpToDate
  "Make sure the CoInterpreterMT switch methods are implemented.  These methods select
  between CoInterpreterMT's implementation or CoInterpreter's implementation depending
  on cogThreadManager being non-nil or nil respectively.  i.e. they allow us to use this one
  simulator class to simulate for both CoInterpreterMT and CoInterpreter."
  | thisClass me mtInterpreterClass |
  self cppIf: COGMTVM ifTrue: [  ] ifFalse: [ ^self ].
  thisClass := thisContext methodClass.
  mtInterpreterClass := thisClass superclass.
  me := thisClass name, '>>', thisContext method selector.
  "We want override switches for everything implemented by CoInterpreter
  and CoInterpreterMT that is either not implemented by CogVMSimulator
  or already implemented by CogVMSimulator as an override switch."
  (mtInterpreterClass selectors select:
  [:sel|
  (mtInterpreterClass superclass whichClassIncludesSelector: sel) notNil
  and: [(thisClass organization categoryOfElement: sel)
  ifNil: [true]
  ifNotNil: [:cat| cat == #'multi-threading simulation switch']]])
  do: [:sel| | argNames desiredSource |
  argNames := Parser new
  initPattern: (mtInterpreterClass sourceCodeAt: sel)
  return: [:pattern| pattern second].
  desiredSource := String streamContents:
  [:str|
  argNames isEmpty
  ifTrue: [str nextPutAll: sel]
  ifFalse:
  [sel keywords with: argNames do:
  [:kw :arg| str nextPutAll: kw; space; nextPutAll: arg; space].
  str skip: -1].
  str
  crtab;
  nextPutAll: '"This method includes or excludes ', mtInterpreterClass name, ' methods as required.';
  crtab;
  nextPutAll: ' Auto-generated by ', me, '"';
  cr;
  crtab;
  nextPutAll: '^self perform: ';
  store: sel;
  crtab: 2;
  nextPutAll: 'withArguments: {'.
  argNames
  do: [:arg| str nextPutAll: arg]
  separatedBy: [str nextPut: $.; space].
  str
  nextPut: $};
  crtab: 2;
  nextPutAll: 'inSuperclass: (cogThreadManager ifNil: [';
  print: mtInterpreterClass superclass;
  nextPutAll: '] ifNotNil: [';
  print: mtInterpreterClass;
  nextPutAll: '])'].
  desiredSource ~= (thisClass sourceCodeAt: sel ifAbsent: ['']) asString ifTrue:
  [((thisClass includesSelector: sel)
   and: [(thisClass compiledMethodAt: sel) messages includesAnyOf: #(halt halt:)])
  ifTrue: [self transcript cr; nextPutAll: 'WARNING, because of halts, not generating '; nextPutAll: desiredSource; cr; flush]
  ifFalse: [thisClass compile: desiredSource classified: #'multi-threading simulation switch']]].
  "Make sure obsolete CoInterpreterMT switch methods are deleted."
  ((thisContext methodClass organization listAtCategoryNamed: #'multi-threading simulation switch') select:
  [:sel| (mtInterpreterClass whichClassIncludesSelector: sel) isNil]) do:
  [:sel| thisClass removeSelector: sel]!

Item was changed:
+ ----- Method: CogVMSimulator>>initialEnterSmalltalkExecutive (in category 'initialize-release') -----
- ----- Method: CogVMSimulator>>initialEnterSmalltalkExecutive (in category 'initialization') -----
  initialEnterSmalltalkExecutive
  "Main entry-point into the interpreter at system start-up.
  Override to choose between the threaded and non-threaded versions and if threaded
  to ensure that the switch method overrides are up-to-date."
  self ensureMultiThreadingOverridesAreUpToDate.
  self assert: (cogit processor fp = CFramePointer and: [cogit processor sp = CStackPointer]).
  ^self perform: #initialEnterSmalltalkExecutive
  withArguments: {}
  inSuperclass: (cogThreadManager ifNil: [CoInterpreterPrimitives] ifNotNil: [CoInterpreterMT])!

Item was changed:
+ ----- Method: CogVMSimulator>>initialize (in category 'initialize-release') -----
- ----- Method: CogVMSimulator>>initialize (in category 'initialization') -----
  initialize
  "Initialize the CogVMSimulator when running the interpreter inside Smalltalk.  The
  primary responsibility of this method is to allocate Smalltalk Arrays for variables
  that will be declared as statically-allocated global arrays in the translated code."
  super initialize.
 
  transcript := Transcript.
 
  objectMemory ifNil:
  [objectMemory := self class objectMemoryClass simulatorClass new].
  cogit ifNil:
  [cogit := self class cogitClass new setInterpreter: self].
  objectMemory coInterpreter: self cogit: cogit.
 
  (cogit numRegArgs > 0
  and: [VMClass initializationOptions at: #CheckStackDepth ifAbsent: [true]]) ifTrue:
  [debugStackDepthDictionary := Dictionary new].
 
  cogThreadManager ifNotNil:
  [super initialize].
 
  self assert: ConstMinusOne = (objectMemory integerObjectOf: -1).
 
  cogMethodZone := cogit methodZone. "Because Slang can't remove intermediate implicit receivers (cogit methodZone foo doesn't reduce to foo())"
  enableCog := true.
 
  methodCache := Array new: MethodCacheSize.
  nsMethodCache := Array new: NSMethodCacheSize.
  atCache := nil.
  self flushMethodCache.
  cogCompiledCodeCompactionCalledFor := false.
  gcSemaphoreIndex := 0.
  externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
  externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
  externalPrimitiveTableFirstFreeIndex := 0.
  primitiveTable := self class primitiveTable copy.
  self initializePluginEntries.
  desiredNumStackPages := InitializationOptions at: #desiredNumStackPages ifAbsent: [0].
  desiredEdenBytes := InitializationOptions at: #desiredEdenBytes ifAbsent: [0].
  desiredCogCodeSize  := InitializationOptions at: #desiredCogCodeSize ifAbsent: [0].
  "This is initialized on loading the image, but convenient for testing stack page values..."
  numStackPages := self defaultNumStackPages.
  startMicroseconds := lastYieldMicroseconds := self ioUTCStartMicroseconds.
  maxLiteralCountForCompile := MaxLiteralCountForCompile.
  minBackwardJumpCountForCompile := MinBackwardJumpCountForCompile.
  flagInterpretedMethods := false.
 
  "initialize InterpreterSimulator variables used for debugging"
  byteCount := lastPollCount := sendCount := lookupCount := 0.
  quitBlock := [^self close].
  traceOn := true.
  printSends := printFrameAtEachStep := printBytecodeAtEachStep := false.
  myBitBlt := BitBltSimulator new setInterpreter: self.
  displayForm := fakeForm := 'Display has not yet been installed' asDisplayText form.
  suppressHeartbeatFlag := deferSmash := deferredSmash := false.
  systemAttributes := Dictionary new.
  primTraceLog := CArrayAccessor on: (Array new: 256 withAll: 0).
  primTraceLogIndex := 0.
  traceLog := CArrayAccessor on: (Array new: TraceBufferSize withAll: 0).
  traceLogIndex := 0.
  traceSources := TraceSources.
  statCodeCompactionCount := 0.
  statCodeCompactionUsecs := 0.
  extSemTabSize := 256!

Item was changed:
+ ----- Method: CogVMSimulator>>initializeThreadSupport (in category 'initialize-release') -----
- ----- Method: CogVMSimulator>>initializeThreadSupport (in category 'initialization') -----
  initializeThreadSupport
  "Do this post new if you want to simulate with thread support."
  cogThreadManager := CogThreadManager new setInterpreter: self cogit: cogit.
  cogit setThreadManager: cogThreadManager!

Item was changed:
  ----- Method: CogVMSimulator>>ioExit (in category 'primitive support') -----
  ioExit
+ self ioExitWithErrorCode: 0!
- self threadManager ifNotNil:
- [:threadManager|
- threadManager guiProcess ~= Processor activeProcess ifTrue:
- [threadManager guiProcess
- signalException:
- (Notification new tag: #evaluateQuit; yourself).
- Processor terminateActive]].
- quitBlock value  "Cause return from #test"!

Item was changed:
  ----- Method: CogVMSimulator>>ioExitWithErrorCode: (in category 'primitive support') -----
  ioExitWithErrorCode: ec
+ self ioShutdownAllModules.
+ self threadManager ifNotNil:
+ [:threadManager| threadManager shutdownModule].
+ quitBlock value  "Cause return from #test"!
- self ioExit!

Item was changed:
+ ----- Method: CogVMSimulator>>ioInitHeartbeat (in category 'initialize-release') -----
- ----- Method: CogVMSimulator>>ioInitHeartbeat (in category 'initialization') -----
  ioInitHeartbeat
  "No-op in the simulator.  We cause a poll every 1000 bytecodes instead."!

Item was added:
+ ----- Method: CogVMSimulator>>ioShutdownAllModules (in category 'initialize-release') -----
+ ioShutdownAllModules
+ pluginList do:
+ [:assoc| | pluginOrSelf |
+ ((pluginOrSelf := assoc value) ~~ self
+  and: [pluginOrSelf respondsTo: #shutdownModule]) ifTrue:
+ [pluginOrSelf shutdownModule]]!

Item was changed:
+ ----- Method: CogVMSimulator>>moveMethodCacheToMemoryAt: (in category 'initialize-release') -----
- ----- Method: CogVMSimulator>>moveMethodCacheToMemoryAt: (in category 'initialization') -----
  moveMethodCacheToMemoryAt: address
  | oldMethodCache |
  oldMethodCache := methodCache.
  "In the VM the methodCache is written as a normal array with 1-relative addressing.
  In C this works by allocating an extra element in the methodCache array (see
  class-side declareCVarsIn:).  In simulation simply position the start of the methodCache
  one word lower, achieving the same effect.  -1 because CArrayAccessor is 0-relative
  and adds 1 on accesses itself."
  methodCache := CMethodCacheAccessor new
  objectMemory: objectMemory
  at: address
  array: oldMethodCache
  functionPointerIndex: MethodCachePrimFunction
  entrySize: MethodCacheEntrySize.
  self assert: address - objectMemory wordSize = self methodCacheAddress.
  1 to: MethodCacheSize do:
  [:i|
  self assert: (methodCache at: i) = 0].
  methodCache at: 1 put: 16rC4EC4.
  self assert: (objectMemory longAt: address) = 16rC4EC4.
  1 to: MethodCacheSize do:
  [:i|
  methodCache at: i put: (oldMethodCache at: i)]!

Item was changed:
+ ----- Method: CogVMSimulator>>movePrimTraceLogToMemoryAt: (in category 'initialize-release') -----
- ----- Method: CogVMSimulator>>movePrimTraceLogToMemoryAt: (in category 'initialization') -----
  movePrimTraceLogToMemoryAt: address
  | oldTraceLog |
  oldTraceLog := primTraceLog.
  primTraceLog := CArrayOfLongsAccessor new
  objectMemory: objectMemory at: address.
  self assert: address = self primTraceLogAddress.
  0 to: PrimTraceLogSize - 1 do:
  [:i|
  self assert: (primTraceLog at: i) = 0].
  primTraceLog at: 0 put: 16rC4EC4.
  self assert: (objectMemory longAt: address) = 16rC4EC4.
  0 to: PrimTraceLogSize - 1 do:
  [:i|
  primTraceLog at: i put: (oldTraceLog at: i)]!

Item was changed:
+ ----- Method: CogVMSimulator>>nextShortFrom: (in category 'initialize-release') -----
- ----- Method: CogVMSimulator>>nextShortFrom: (in category 'initialization') -----
  nextShortFrom: aStream
  "Read a 16-bit quantity from the given (binary) stream."
  ^self subclassResponsibility!

Item was changed:
+ ----- Method: CogVMSimulator>>openOn:extraMemory: (in category 'initialize-release') -----
- ----- Method: CogVMSimulator>>openOn:extraMemory: (in category 'initialization') -----
  openOn: fileName extraMemory: extraBytes
  "CogVMSimulator new openOn: 'clone.im' extraMemory: 100000"
 
  | f version headerSize dataSize count oldBaseAddr bytesToShift swapBytes
   headerFlags firstSegSize heapSize
   hdrNumStackPages hdrEdenBytes hdrMaxExtSemTabSize hdrCogCodeSize
   stackZoneSize methodCacheSize primTraceLogSize allocationReserve |
  "open image file and read the header"
 
  (f := self openImageFileNamed: fileName) ifNil: [^self].
 
  "Set the image name and the first argument; there are
  no arguments during simulation unless set explicitly."
  systemAttributes at: 1 put: fileName.
 
  ["begin ensure block..."
  imageName := f fullName.
  f binary.
 
  version := self getWord32FromFile: f swap: false.  "current version: 16r1968 (=6504) vive la revolucion!!"
  (self readableFormat: version)
  ifTrue: [swapBytes := false]
  ifFalse: [(version := version byteSwap32) = self imageFormatVersion
  ifTrue: [swapBytes := true]
  ifFalse: [self error: 'incomaptible image format']].
  headerSize := self getWord32FromFile: f swap: swapBytes.
  dataSize := self getLongFromFile: f swap: swapBytes.  "length of heap in file"
  oldBaseAddr := self getLongFromFile: f swap: swapBytes.  "object memory base address of image"
  objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes).
  objectMemory lastHash: (self getLongFromFile: f swap: swapBytes).  "Should be loaded from, and saved to the image header"
 
  savedWindowSize := self getLongFromFile: f swap: swapBytes.
  headerFlags := self getLongFromFile: f swap: swapBytes.
  self setImageHeaderFlagsFrom: headerFlags.
  extraVMMemory := self getWord32FromFile: f swap: swapBytes.
  hdrNumStackPages := self getShortFromFile: f swap: swapBytes.
  "4 stack pages is small.  Should be able to run with as few as
  three. 4 should be comfortable but slow.  8 is a reasonable
  default. Can be changed via vmParameterAt: 43 put: n"
  numStackPages := desiredNumStackPages ~= 0
  ifTrue: [desiredNumStackPages]
  ifFalse: [hdrNumStackPages = 0
  ifTrue: [self defaultNumStackPages]
  ifFalse: [hdrNumStackPages]].
  desiredNumStackPages := hdrNumStackPages.
  stackZoneSize := self computeStackZoneSize.
  "This slot holds the size of the native method zone in 1k units. (pad to word boundary)."
  hdrCogCodeSize := (self getShortFromFile: f swap: swapBytes) * 1024.
  cogCodeSize := desiredCogCodeSize ~= 0
  ifTrue: [desiredCogCodeSize]
  ifFalse:
  [hdrCogCodeSize = 0
  ifTrue: [cogit defaultCogCodeSize]
  ifFalse: [hdrCogCodeSize]].
  desiredCogCodeSize := hdrCogCodeSize.
  self assert: f position = (objectMemory wordSize = 4 ifTrue: [40] ifFalse: [64]).
  hdrEdenBytes := self getWord32FromFile: f swap: swapBytes.
  objectMemory edenBytes: (desiredEdenBytes ~= 0
  ifTrue: [desiredEdenBytes]
  ifFalse:
  [hdrEdenBytes = 0
  ifTrue: [objectMemory defaultEdenBytes]
  ifFalse: [hdrEdenBytes]]).
  desiredEdenBytes := hdrEdenBytes.
  hdrMaxExtSemTabSize := self getShortFromFile: f swap: swapBytes.
  hdrMaxExtSemTabSize ~= 0 ifTrue:
  [self setMaxExtSemSizeTo: hdrMaxExtSemTabSize].
  "pad to word boundary.  This slot can be used for anything else that will fit in 16 bits.
  Preserve it to be polite to other VMs."
  the2ndUnknownShort := self getShortFromFile: f swap: swapBytes.
  self assert: f position = (objectMemory wordSize = 4 ifTrue: [48] ifFalse: [72]).
  firstSegSize := self getLongFromFile: f swap: swapBytes.
  objectMemory firstSegmentSize: firstSegSize.
  "For Open PICs to be able to probe the method cache during
  simulation the methodCache must be relocated to memory."
  methodCacheSize := methodCache size * objectMemory wordSize.
  primTraceLogSize := primTraceLog size * objectMemory wordSize.
 
  "To cope with modern OSs that disallow executing code in writable memory we dual-map
  the code zone, one mapping with read/write permissions and the other with read/execute
  permissions. In simulation all we can do is use memory, so if we're simulating dual mapping
  we use double the memory and simulate the memory sharing in the Cogit's backEnd."
  effectiveCogCodeSize := (InitializationOptions at: #DUAL_MAPPED_CODE_ZONE ifAbsent: [false])
  ifTrue: [cogCodeSize * 2]
  ifFalse: [cogCodeSize].
 
  "allocate interpreter memory. This list is in address order, low to high.
  In the actual VM the stack zone exists on the C stack."
  heapBase := (Cogit guardPageSize
  + effectiveCogCodeSize
  + stackZoneSize
  + methodCacheSize
  + primTraceLogSize
  + self rumpCStackSize) roundUpTo: objectMemory allocationUnit.
  "compare memory requirements with availability"
  allocationReserve := self interpreterAllocationReserveBytes.
  objectMemory hasSpurMemoryManagerAPI
  ifTrue:
  [| freeOldSpaceInImage headroom |
  freeOldSpaceInImage := self getLongFromFile: f swap: swapBytes.
  headroom := objectMemory
  initialHeadroom: extraVMMemory
  givenFreeOldSpaceInImage: freeOldSpaceInImage.
  heapSize := objectMemory roundUpHeapSize:
    dataSize
  + headroom
  + objectMemory newSpaceBytes
  + (headroom > allocationReserve
  ifTrue: [0]
  ifFalse: [allocationReserve])]
  ifFalse:
  [heapSize :=  dataSize
  + extraBytes
  + objectMemory newSpaceBytes
  + (extraBytes > allocationReserve
  ifTrue: [0]
  ifFalse: [allocationReserve])].
  heapBase := objectMemory
  setHeapBase: heapBase
  memoryLimit:  heapBase + heapSize
  endOfMemory: heapBase + dataSize.
 
  self assert: cogCodeSize \\ 4 = 0.
  self assert: objectMemory memoryLimit \\ 4 = 0.
  self assert: self rumpCStackSize \\ 4 = 0.
  objectMemory allocateMemoryOfSize: objectMemory memoryLimit.
  "read in the image in bulk, then swap the bytes if necessary"
  f position: headerSize.
  count := objectMemory readHeapFromImageFile: f dataBytes: dataSize.
  count ~= dataSize ifTrue: [self halt]]
  ensure: [f close].
  self moveMethodCacheToMemoryAt: objectMemory cogCodeBase + effectiveCogCodeSize + stackZoneSize.
  self movePrimTraceLogToMemoryAt: objectMemory cogCodeBase + effectiveCogCodeSize + stackZoneSize + methodCacheSize.
 
  self ensureImageFormatIsUpToDate: swapBytes.
 
  bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr.  "adjust pointers for zero base address"
  UIManager default
  informUser: 'Relocating object pointers...'
  during: [self initializeInterpreter: bytesToShift].
  self initializeCodeGenerator!

Item was changed:
  ----- Method: CogVMThread>>osThread: (in category 'accessing') -----
  osThread: anObject
  "Set the value of osThread"
+ self assert: (osThread isNil or: [osThread isKindOf: Process]).
-
  ^osThread := anObject!

Item was changed:
  ----- Method: FilePlugin>>shutdownModule (in category 'initialize-release') -----
  shutdownModule
  <export: true>
+ ^self sqFileShutdown!
- ^self cCode: 'sqFileShutdown()' inSmalltalk:[true]!

Item was added:
+ ----- Method: FilePluginSimulator>>sqFileShutdown (in category 'initialize-release') -----
+ sqFileShutdown
+ self close.
+ ^true!

Item was changed:
  ----- Method: HostWindowPlugin>>shutdownModule (in category 'initialize-release') -----
  shutdownModule
  "do any window related VM closing down work your platform requires."
  <export: true>
+ ^self ioCloseAllWindows!
- ^self cCode: 'ioCloseAllWindows()' inSmalltalk:[true]!

Item was added:
+ ----- Method: InterpreterPlugin>>stackBooleanValue: (in category 'API access') -----
+ stackBooleanValue: index
+ <inline: #always>
+ ^interpreterProxy booleanValueOf: (interpreterProxy stackValue: index)!

Item was changed:
  ----- Method: Mpeg3Plugin>>shutdownModule (in category 'support') -----
  shutdownModule
  <export: true>
  1 to: maximumNumberOfFilesToWatch do:
+ [:i |
+ ((mpegFiles at: i) ~= 0) ifTrue:
+ [self mpeg3_close: (mpegFiles at: i).
- [:i | ((mpegFiles at: i) ~= 0) ifTrue:
- [self cCode: 'mpeg3_close(mpegFiles[i])'.
  mpegFiles at: i put: 0]].
  ^true!

Item was added:
+ ----- Method: Process>>asUnsignedInteger (in category '*VMMaker-simulation') -----
+ asUnsignedInteger
+ "Processes are used to model OS threads in the COGMTVM.
+ But native threads are typically simply pointers which can hence be mapped to integers.
+ This is used in locking the VM from an unknown thread on callback.  Hence mimic the
+ ability to map a thread to an integer by answering the receiver's identityHash."
+ ^self identityHash!

Item was added:
+ ----- Method: SmartSyntaxPluginSimulator>>shutdownModule (in category 'initialize') -----
+ shutdownModule
+ ^(actualPlugin respondsTo: #shutdownModule)
+ ifTrue: [actualPlugin shutdownModule]
+ ifFalse: [true]!

Item was changed:
  ----- Method: SocketPlugin>>shutdownModule (in category 'initialize-release') -----
  shutdownModule
  <export: true>
+ ^self socketShutdown!
- ^self cCode: 'socketShutdown()' inSmalltalk:[true]!

Item was added:
+ ----- Method: SocketPluginSimulator>>socketShutdown (in category 'simulation') -----
+ socketShutdown
+ self close.
+ ^true!

Item was changed:
+ ----- Method: StackInterpreterSimulator>>close (in category 'initialize-release') -----
- ----- Method: StackInterpreterSimulator>>close (in category 'initialization') -----
  close  "close any files that ST may have opened, etc"
  pluginList do: [:assoc| | plugin | plugin := assoc value. plugin ~~ self ifTrue: [plugin close]].
  "Ugh; at least some of this code belongs in the UI..."
  displayView ifNotNil:
  [displayView activeHand removeEventListener: self].
  ActiveHand removeEventListener: self.
  World submorphs do:
  [:submorph|
  (submorph model isVMObjectInspector
  and: [submorph model coInterpreter == self]) ifTrue:
  [submorph delete].
  (submorph model isDebugger
  and: [(submorph model interruptedProcess suspendedContext ifNotNil:
  [:sctxt|
  sctxt findContextSuchThat:
  [:ctxt|
  ctxt receiver == self
  and: [ctxt selector == #run]]]) notNil]) ifTrue:
  [submorph model windowIsClosing.
  submorph delete]]!

Item was changed:
+ ----- Method: StackInterpreterSimulator>>desiredEdenBytes: (in category 'initialize-release') -----
- ----- Method: StackInterpreterSimulator>>desiredEdenBytes: (in category 'initialization') -----
  desiredEdenBytes: anInteger
  desiredEdenBytes := anInteger!

Item was changed:
+ ----- Method: StackInterpreterSimulator>>desiredNumStackPages: (in category 'initialize-release') -----
- ----- Method: StackInterpreterSimulator>>desiredNumStackPages: (in category 'initialization') -----
  desiredNumStackPages: anInteger
  desiredNumStackPages := anInteger!

Item was changed:
+ ----- Method: StackInterpreterSimulator>>initialize (in category 'initialize-release') -----
- ----- Method: StackInterpreterSimulator>>initialize (in category 'initialization') -----
  initialize
  "Initialize the StackInterpreterSimulator when running the interpreter
  inside Smalltalk. The primary responsibility of this method is to allocate
  Smalltalk Arrays for variables that will be declared as statically-allocated
  global arrays in the translated code."
  super initialize.
 
  bootstrapping := false.
  transcript := Transcript.
 
  objectMemory ifNil:
  [objectMemory := self class objectMemoryClass simulatorClass new].
  objectMemory coInterpreter: self.
 
  self assert: ConstMinusOne = (objectMemory integerObjectOf: -1).
 
  methodCache := Array new: MethodCacheSize.
  nsMethodCache := Array new: NSMethodCacheSize.
  atCache := Array new: AtCacheTotalSize.
  self flushMethodCache.
  gcSemaphoreIndex := 0.
  externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
  externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
  externalPrimitiveTableFirstFreeIndex := 0.
  primitiveTable := self class primitiveTable copy.
  self initializePluginEntries.
  desiredNumStackPages := desiredEdenBytes := 0.
  "This is initialized on loading the image, but convenient for testing stack page values..."
  numStackPages := self defaultNumStackPages.
  startMicroseconds := lastYieldMicroseconds := self ioUTCStartMicroseconds.
 
  "initialize InterpreterSimulator variables used for debugging"
  byteCount := sendCount := lookupCount := 0.
  quitBlock := [^self close].
  traceOn := true.
  printSends := printReturns := printFrameAtEachStep := printBytecodeAtEachStep := false.
  myBitBlt := BitBltSimulator new setInterpreter: self.
  displayForm := fakeForm := 'Display has not yet been installed' asDisplayText form.
  suppressHeartbeatFlag := false.
  systemAttributes := Dictionary new.
  extSemTabSize := 256.
  disableBooleanCheat := false.
  assertVEPAES := false. "a flag so the assertValidExecutionPointers can be disabled for simulation speed and enabled when necessary."!

Item was changed:
  ----- Method: StackInterpreterSimulator>>ioExit (in category 'primitive support') -----
  ioExit
+ self ioExitWithErrorCode: 0!
-
- quitBlock value  "Cause return from #test"!

Item was changed:
  ----- Method: StackInterpreterSimulator>>ioExitWithErrorCode: (in category 'primitive support') -----
  ioExitWithErrorCode: ec
+ self ioShutdownAllModules.
-
  quitBlock value  "Cause return from #test"!

Item was changed:
+ ----- Method: StackInterpreterSimulator>>ioInitHeartbeat (in category 'initialize-release') -----
- ----- Method: StackInterpreterSimulator>>ioInitHeartbeat (in category 'initialization') -----
  ioInitHeartbeat
  "No-op in the simulator.  We cause a poll every 1000 bytecodes instead."!

Item was added:
+ ----- Method: StackInterpreterSimulator>>ioShutdownAllModules (in category 'initialize-release') -----
+ ioShutdownAllModules
+ pluginList do:
+ [:assoc| | pluginOrSelf |
+ ((pluginOrSelf := assoc value) ~~ self
+  and: [pluginOrSelf respondsTo: #shutdownModule]) ifTrue:
+ [pluginOrSelf shutdownModule]]!

Item was changed:
+ ----- Method: StackInterpreterSimulator>>nextShortFrom: (in category 'initialize-release') -----
- ----- Method: StackInterpreterSimulator>>nextShortFrom: (in category 'initialization') -----
  nextShortFrom: aStream
  "Read a 16-bit quantity from the given (binary) stream."
  ^self subclassResponsibility!

Item was changed:
+ ----- Method: StackInterpreterSimulator>>openOn:extraMemory: (in category 'initialize-release') -----
- ----- Method: StackInterpreterSimulator>>openOn:extraMemory: (in category 'initialization') -----
  openOn: fileName extraMemory: extraBytes
  "StackInterpreterSimulator new openOn: 'clone.im' extraMemory: 100000"
 
  | f version headerSize dataSize count oldBaseAddr bytesToShift swapBytes
   headerFlags heapBase firstSegSize heapSize
   hdrNumStackPages hdrEdenBytes hdrMaxExtSemTabSize allocationReserve |
  "open image file and read the header"
 
  (f := self openImageFileNamed: fileName) ifNil: [^self].
 
  "Set the image name and the first argument; there are
  no arguments during simulation unless set explicitly."
  systemAttributes at: 1 put: fileName.
 
  ["begin ensure block..."
  imageName := f fullName.
  f binary.
 
  version := self getWord32FromFile: f swap: false.  "current version: 16r1968 (=6504) vive la revolucion!!"
  (self readableFormat: version)
  ifTrue: [swapBytes := false]
  ifFalse: [(version := objectMemory byteSwapped: version) = self imageFormatVersion
  ifTrue: [swapBytes := true]
  ifFalse: [self error: 'incomaptible image format']].
  headerSize := self getWord32FromFile: f swap: swapBytes.
  dataSize := self getLongFromFile: f swap: swapBytes.  "length of heap in file"
  oldBaseAddr := self getLongFromFile: f swap: swapBytes.  "object memory base address of image"
  objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes).
  objectMemory lastHash: (self getLongFromFile: f swap: swapBytes).  "Should be loaded from, and saved to the image header"
 
  savedWindowSize := self getLongFromFile: f swap: swapBytes.
  headerFlags := self getLongFromFile: f swap: swapBytes.
  self setImageHeaderFlagsFrom: headerFlags.
  extraVMMemory := self getWord32FromFile: f swap: swapBytes.
  hdrNumStackPages := self getShortFromFile: f swap: swapBytes.
  "4 stack pages is small.  Should be able to run with as few as
  three. 4 should be comfortable but slow.  8 is a reasonable
  default. Can be changed via vmParameterAt: 43 put: n"
  numStackPages := desiredNumStackPages ~= 0
  ifTrue: [desiredNumStackPages]
  ifFalse: [hdrNumStackPages = 0
  ifTrue: [self defaultNumStackPages]
  ifFalse: [hdrNumStackPages]].
  desiredNumStackPages := hdrNumStackPages.
  "pad to word boundary.  This slot can be used for anything else that will fit in 16 bits.
  It is used for the cog code size in Cog.  Preserve it to be polite to other VMs."
  theUnknownShort := self getShortFromFile: f swap: swapBytes.
  self assert: f position = (objectMemory wordSize = 4 ifTrue: [40] ifFalse: [64]).
  hdrEdenBytes := self getWord32FromFile: f swap: swapBytes.
  objectMemory edenBytes: (hdrEdenBytes = 0
  ifTrue: [objectMemory defaultEdenBytes]
  ifFalse: [hdrEdenBytes]).
  desiredEdenBytes := hdrEdenBytes.
  hdrMaxExtSemTabSize := self getShortFromFile: f swap: swapBytes.
  hdrMaxExtSemTabSize ~= 0 ifTrue:
  [self setMaxExtSemSizeTo: hdrMaxExtSemTabSize].
  "pad to word boundary.  This slot can be used for anything else that will fit in 16 bits.
  Preserve it to be polite to other VMs."
  the2ndUnknownShort := self getShortFromFile: f swap: swapBytes.
  self assert: f position = (objectMemory wordSize = 4 ifTrue: [48] ifFalse: [72]).
  firstSegSize := self getLongFromFile: f swap: swapBytes.
  objectMemory firstSegmentSize: firstSegSize.
  "compare memory requirements with availability"
  allocationReserve := self interpreterAllocationReserveBytes.
  objectMemory hasSpurMemoryManagerAPI
  ifTrue:
  [| freeOldSpaceInImage headroom |
  freeOldSpaceInImage := self getLongFromFile: f swap: swapBytes.
  headroom := objectMemory
  initialHeadroom: extraVMMemory
  givenFreeOldSpaceInImage: freeOldSpaceInImage.
  heapSize := objectMemory roundUpHeapSize:
    dataSize
  + headroom
  + objectMemory newSpaceBytes
  + (headroom > allocationReserve
  ifTrue: [0]
  ifFalse: [allocationReserve])]
  ifFalse:
  [heapSize :=  dataSize
  + extraBytes
  + objectMemory newSpaceBytes
  + (extraBytes > allocationReserve
  ifTrue: [0]
  ifFalse: [allocationReserve])].
  "allocate interpreter memory"
  heapBase := objectMemory startOfMemory.
  objectMemory
  setHeapBase: heapBase
  memoryLimit: heapBase + heapSize
  endOfMemory: heapBase + dataSize. "bogus for Spur"
  objectMemory allocateMemoryOfSize: objectMemory memoryLimit.
  "read in the image in bulk, then swap the bytes if necessary"
  f position: headerSize.
  count := objectMemory readHeapFromImageFile: f dataBytes: dataSize.
  count ~= dataSize ifTrue: [self halt]]
  ensure: [f close].
 
  self ensureImageFormatIsUpToDate: swapBytes.
 
  bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr.  "adjust pointers for zero base address"
  UIManager default
  informUser: 'Relocating object pointers...'
  during: [self initializeInterpreter: bytesToShift]!

Item was changed:
+ ----- Method: StackInterpreterSimulator>>startOfMemory (in category 'initialize-release') -----
- ----- Method: StackInterpreterSimulator>>startOfMemory (in category 'initialization') -----
  startOfMemory
  self shouldNotImplement!