Stefan,
Some changes I did.
I am adding you to a dropbox folder where I've put my sim image.
You can put yours in there as well.
There is also the issue of FileSystem :-)
Phil
On Thu, Feb 13, 2014 at 11:01 AM, Stefan Marr <[email protected]>wrote:
> Hi Ron:
>
> On 13 Feb 2014, at 10:38, Ron Teitelbaum <[email protected]> wrote:
>
> >> I think the bigger question is whether you actually want to adopt those
> > things.
> >
> > That the vm stays in sync should be a core requirement for our
> communities.
>
> I am with you on that Ron. But I need a technical solution to manage those
> things.
> Good intensions are one thing, but how do we do that?
>
> Examples: [https://github.com/pharo-project/pharo-vm/pull/18/commits]
>
> primitiveUpdateGZipCrc32
> - self cCode:'' inSmalltalk:[zipCrcTable := CArrayAccessor on:
> GZipWriteStream crcTable].
> + self cCode:'' inSmalltalk:[zipCrcTable := CArrayAccessor on: CRC
> crc32Table].
>
> primitiveGetAttribute
>
> - attribute := Smalltalk getSystemAttribute: attr.
> + attribute := Smalltalk vm getSystemAttribute: attr.
>
> CogVMSimulator>> initialize
> - 'Display has not yet been installed' asDisplayText form.
> + 'Display has not yet been installed' asMorph imageForm.
>
>
> ioRelinquishProcessorForMicroseconds
> - Processor activeProcess == Project uiProcess ifTrue:
> + Processor activeProcess == UIManager default uiProcess ifTrue:
>
>
> And so far, I only fixed trivial things. Still need to figure out what is
> going wrong with more recent Pharo images.
>
> Best regards
> Stefan
>
> --
> Stefan Marr
> INRIA Lille - Nord Europe
> http://stefan-marr.de/research/
>
>
>
>
>
'From Pharo2.0 of 7 March 2013 [Latest update: #20628] on 13 February 2014 at
11:27:20 am'!
!VMClass methodsFor: 'simulation support' stamp: 'PhilippeBack 11/27/2013
21:28'!
doOrDefer: aBlock
<doNotGenerate>
"Either evaluate aBlock immediately if in the uiProcess or defer aBlock
as a UI message"
Processor activeProcess == UIManager default uiProcess
ifTrue: [aBlock value]
ifFalse: [WorldState addDeferredUIMessage: aBlock]! !
!ByteString methodsFor: 'comparing' stamp: 'MrVMMaker 11/27/2013 16:54'!
findSubstring: key in: body startingAt: start matchTable: matchTable
"Answer the index in the string body at which the substring key first
occurs, at or beyond start. The match is determined using matchTable, which
can be used to effect, eg, case-insensitive matches. If no match is found,
zero will be returned.
The algorithm below is not optimum -- it is intended to be translated
to C which will go so fast that it wont matter."
| index |
<primitive: 'primitiveFindSubstring' module: 'MiscPrimitivePlugin'>
<var: #key declareC: 'unsigned char *key'>
<var: #body declareC: 'unsigned char *body'>
<var: #matchTable declareC: 'unsigned char *matchTable'>
key size = 0 ifTrue: [^ 0].
start to: body size - key size + 1 do:
[:startIndex |
index := 1.
[(matchTable at: (body at: startIndex+index-1)
asciiValue + 1)
= (matchTable at: (key at: index) asciiValue +
1)]
whileTrue:
[index = key size ifTrue: [^ startIndex].
index := index+1]].
^ 0
! !
!StackInterpreterSimulator methodsFor: 'UI' stamp: 'PhilippeBack 11/27/2013
21:24'!
openAsMorph
"Open a morphic view on this simulation."
| window localImageName |
"localImageName := FileSystem workingDirectory localNameFor: imageName."
window := (SystemWindow labelled: 'Simulation of ', imageName) model:
self.
window addMorph: (displayView := ImageMorph new image: displayForm)
frame: (0@0 corner: [email protected]).
transcript := Transcript.
window addMorph: (PluggableTextMorph
on: transcript text:
nil accept: nil
readSelection: nil
menu: #codePaneMenu:shifted:)
frame: ([email protected] corner: 0.7@1).
window addMorph: (PluggableTextMorph on: self
text: #byteCountText accept: nil
readSelection: nil menu:
#utilitiesMenu:) hideScrollBarsIndefinitely
frame: ([email protected] corner: 1@1).
window openInWorldExtent: (self desiredDisplayExtent
+ (2 * window
borderWidth)
+ (0@window
labelHeight)
* (1@(1/0.8)))
rounded! !
!StackInterpreterSimulator methodsFor: 'initialization' stamp: 'PhilippeBack
11/27/2013 22:00'!
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."
| objectMemoryClass |
"initialize class variables"
objectMemory ifNotNil:
[^self halt].
objectMemoryClass := self class objectMemoryClass.
objectMemoryClass initBytesPerWord: objectMemoryClass bytesPerWord.
objectMemoryClass initialize.
StackInterpreter initialize.
super initialize.
objectMemory := objectMemoryClass simulatorClass new.
objectMemory coInterpreter: self.
"Note: we must initialize ConstMinusOne differently for simulation,
due to the fact that the simulator works only with +ve 32-bit
values"
ConstMinusOne := objectMemory integerObjectOf: -1.
methodCache := Array new: MethodCacheSize.
atCache := Array new: AtCacheTotalSize.
self flushMethodCache.
self flushAtCache.
gcSemaphoreIndex := 0.
externalSemaphoreSignalRequests := externalSemaphoreSignalResponses :=
#().
externalPrimitiveTable := CArrayAccessor on: (Array new:
MaxExternalPrimitiveTableSize).
externalPrimitiveTableFirstFreeIndex := 0.
primitiveTable := self class primitiveTable copy.
pluginList := #().
mappedPluginEntries := #().
desiredNumStackPages := desiredEdenBytes := 0.
"This is initialized on loading the image, but convenient for testing
stack page values..."
numStackPages := self defaultNumStackPages.
startMicroseconds := Time totalSeconds * 1000000.
"initialize InterpreterSimulator variables used for debugging"
byteCount := 0.
sendCount := 0.
quitBlock := [^ self].
traceOn := true.
printSends := printReturns := printFrameAtEachStep :=
printBytecodeAtEachStep := false.
myBitBlt := BitBltSimulator new setInterpreter: self.
transcript := Transcript.
displayForm := (ImageMorph fromString: 'Display has not yet been
installed') form.
suppressHeartbeatFlag := false.
extSemTabSize := 256.
disableBooleanCheat := false! !
!StackInterpreterSimulator methodsFor: 'initialization' stamp: 'PhilippeBack
11/27/2013 21:04'!
openOn: fileName extraMemory: extraBytes
"InterpreterSimulator new openOn: 'clone.im' extraMemory: 100000"
| f version headerSize count oldBaseAddr bytesToShift swapBytes
hdrNumStackPages hdrEdenBytes headerFlags |
"open image file and read the header"
["begin ensure block..."
f := FileStream readOnlyFileNamed: fileName.
imageName := f fullName.
f binary.
version := self nextLongFrom: f. "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 nextLongFrom: f swap: swapBytes.
objectMemory setEndOfMemory: (self nextLongFrom: f swap: swapBytes).
"first unused location in heap"
oldBaseAddr := self nextLongFrom: f swap: swapBytes. "object memory
base address of image"
objectMemory specialObjectsOop: (self nextLongFrom: f swap: swapBytes).
objectMemory lastHash: (self nextLongFrom: f swap: swapBytes). "Should
be loaded from, and saved to the image header"
savedWindowSize := self nextLongFrom: f swap: swapBytes.
headerFlags := self nextLongFrom: f swap: swapBytes.
self setImageHeaderFlagsFrom: headerFlags.
extraVMMemory := self nextLongFrom: f swap: swapBytes.
hdrNumStackPages := self nextShortFrom: 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.
stackPages := self stackPagesClass new. "Temporary for
computeStackZoneSize"
"pad to word boundary. This slot can be used for anything else that
will fit in 16 bits.
Preserve it to be polite to images run on Cog."
theUnknownShort := self getShortFromFile: f swap: swapBytes.
hdrEdenBytes := self nextLongFrom: f swap: swapBytes.
objectMemory edenBytes: (hdrEdenBytes = 0
ifTrue: [objectMemory
defaultEdenBytes]
ifFalse:
[hdrEdenBytes]).
desiredEdenBytes := hdrEdenBytes.
"allocate interpreter memory"
objectMemory setMemoryLimit: objectMemory endOfMemory + extraBytes +
objectMemory edenBytes + self interpreterAllocationReserveBytes.
"read in the image in bulk, then swap the bytes if necessary"
f position: headerSize.
objectMemory memory: (Bitmap new: objectMemory memoryLimit // 4).
count := f readInto: objectMemory memory startingAt: 1 count:
objectMemory endOfMemory // 4.
count ~= (objectMemory endOfMemory // 4) ifTrue: [self halt].
]
ensure: [f close].
self ensureImageFormatIsUpToDate: swapBytes.
objectMemory initialize.
bytesToShift := objectMemory startOfMemory - oldBaseAddr. "adjust
pointers for zero base address"
UIManager default informUser: 'Relocating object pointers...'
during: [self initializeInterpreter:
bytesToShift].
! !
!StackInterpreterSimulator methodsFor: 'other primitives' stamp: 'PhilippeBack
11/27/2013 21:29'!
primitiveGetAttribute
"Fetch the system attribute with the given integer ID. The result is a
string, which will be empty if the attribute is not defined."
| attr s attribute |
attr := self stackIntegerValue: 0.
self successful ifTrue: [
attribute := Smalltalk vm getSystemAttribute: attr.
attribute ifNil: [ ^self primitiveFail ].
s := objectMemory instantiateClass: (objectMemory splObj:
ClassByteString) indexableSize: attribute size.
1 to: attribute size do: [ :i |
objectMemory storeByte: i-1 ofObject: s withValue:
(attribute at: i) asciiValue].
self pop: 2. "rcvr, attr"
self push: s]! !
!StackInterpreterSimulator methodsFor: 'I/O primitive support' stamp:
'PhilippeBack 11/27/2013 21:29'!
ioRelinquishProcessorForMicroseconds: microseconds
"In the simulator give an indication that we're idling and check for
input."
Display reverse: (0@0 extent: 16@16).
Sensor peekEvent ifNotNil:
[self forceInterruptCheck].
Processor activeProcess == UIManager default uiProcess ifTrue:
[World doOneCycle].
microseconds >= 1000
ifTrue: [(Delay forMilliseconds: microseconds + 999 // 1000)
wait]
ifFalse: [Processor yield]! !
