[Vm-dev] VM Maker: VMMaker.oscog-eem.2875.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Nov 10 21:39:05 UTC 2020
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!
More information about the Vm-dev
mailing list