Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.3317.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.3317
Author: eem
Time: 6 April 2023, 4:28:40.041964 pm
UUID: 83cf1144-5826-4eca-81ac-c7406191c347
Ancestors: VMMaker.oscog-eem.3316
Fix simulated snapshotting and image preening, which was broken by the introduction of the null-pointer trap (VMMaker.oscog-eem.3103). Tom Beckmann, thanks for tracking this down!
Have the ImageSegment storage primitive fail with an error code for bar arguemnts detected at teh outermost level. Include more failure cases in SpurMemoryManager>>#storeImageSegmentInto:outPointers:roots:'s comment.
=============== Diff against VMMaker.oscog-eem.3316 ===============
Item was changed:
----- Method: InterpreterPrimitives>>primitiveStoreImageSegment (in category 'image segment in/out') -----
primitiveStoreImageSegment
"This primitive is called from Squeak as...
<imageSegment> storeSegmentFor: arrayOfRoots into: aWordArray outPointers: anArray."
"This primitive will store a binary image segment (in the same format as the Squeak image file) of the receiver and every object in its proper tree of subParts (ie, that is not refered to from anywhere else outside the tree). All pointers from within the tree to objects outside the tree will be copied into the array of outpointers. In their place in the image segment will be an oop equal to the offset in the outPointer array (the first would be 4). but with the high bit set."
"The primitive expects the array and wordArray to be more than adequately long. In this case it returns normally, and truncates the two arrays to exactly the right size. To simplify truncation, both incoming arrays are required to be 256 bytes or more long (ie with 3-word headers). If either array is too small, the primitive will fail, but in no other case.
During operation of the primitive, it is necessary to convert from both internal and external oops to their mapped values. To make this fast, the headers of the original objects in question are replaced by the mapped values (and this is noted by adding the forbidden XX header type). Tables are kept of both kinds of oops, as well as of the original headers for restoration.
To be specific, there are two similar two-part tables, the outpointer array, and one in the upper fifth of the segmentWordArray. Each grows oops from the bottom up, and preserved headers from halfway up.
In case of either success or failure, the headers must be restored. In the event of primitive failure, the table of outpointers must also be nilled out (since the garbage in the high half will not have been discarded."
| outPointerArray segmentWordArray arrayOfRoots ecode |
outPointerArray := self stackTop.
segmentWordArray := self stackValue: 1.
arrayOfRoots := self stackValue: 2.
"Essential type checks"
((objectMemory isArray: arrayOfRoots) "Must be indexable pointers"
and: [(objectMemory isArray: outPointerArray) "Must be indexable pointers"
and: [objectMemory isWords: segmentWordArray]]) "Must be indexable words"
+ ifFalse: [^self primitiveFailFor: PrimErrBadArgument].
- ifFalse: [^self primitiveFail].
ecode := objectMemory storeImageSegmentInto: segmentWordArray outPointers: outPointerArray roots: arrayOfRoots.
(objectMemory hasSpurMemoryManagerAPI
and: [ecode = PrimErrNeedCompaction]) ifTrue:
[objectMemory fullGC.
outPointerArray := self stackTop.
segmentWordArray := self stackValue: 1.
arrayOfRoots := self stackValue: 2.
ecode := objectMemory storeImageSegmentInto: segmentWordArray outPointers: outPointerArray roots: arrayOfRoots].
ecode = PrimNoErr
ifTrue: [self pop: 3] "...leaving the receiver on the stack as return value"
ifFalse: [self primitiveFailFor: ecode]!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>memoryOffset (in category 'simulation only') -----
+ memoryOffset
+ ^0!
Item was added:
+ ----- Method: Spur32BitMMLESimulator>>memoryOffset (in category 'Cog JIT support') -----
+ memoryOffset
+ "The first word of memory is unused in order to implement a null pointer trap."
+ ^4!
Item was added:
+ ----- Method: Spur64BitMMLESimulator>>memoryOffset (in category 'Cog JIT support') -----
+ memoryOffset
+ "The first word of memory is unused in order to implement a null pointer trap."
+ ^4!
Item was added:
+ ----- Method: Spur64BitMMLESimulatorFor64Bits>>memoryOffset (in category 'Cog JIT support') -----
+ memoryOffset
+ "The first word of memory is unused in order to implement a null pointer trap."
+ ^8!
Item was changed:
----- Method: SpurMemoryManager>>allocatePinnedSlots: (in category 'sista support') -----
allocatePinnedSlots: nSlots
<api>
| obj |
obj := self allocateSlotsForPinningInOldSpace: nSlots
bytes: (self objectBytesForSlots: nSlots)
format: self wordIndexableFormat
+ classIndex: self wordSizeClassIndexPun.
- classIndex: self wordSizeClassIndexPun.
obj ifNotNil:
+ [self assert: (self isPinned: obj).
+ self fillObj: obj numSlots: nSlots with: 0].
- [self fillObj: obj numSlots: nSlots with: 0].
^obj!
Item was changed:
----- Method: SpurMemoryManager>>storeImageSegmentInto:outPointers:roots: (in category 'image segment in/out') -----
storeImageSegmentInto: segmentWordArrayArg outPointers: outPointerArrayArg roots: arrayOfRootsArg
"This primitive is called from Squeak as...
<imageSegment> storeSegmentFor: arrayOfRoots into: aWordArray outPointers: anArray.
This primitive will store a binary image segment (in the same format as objects in the heap) of the
set of objects in arrayOfObjects. All pointers from within the set to objects outside the set will be
copied into the array of outPointers. In their place in the image segment will be an oop equal to the
offset in the outPointer array (the first would be 8), but with the high bit set.
Since Spur has a class table the load primitive must insert classes that have instances into the
class table. This primitive marks such classes using the isRemembered bit, which isn't meaningful
as a remembered bit in the segment.
The primitive expects the segmentWordArray and outPointerArray to be more than adequately long.
In this case it returns normally, and truncates the two arrays to exactly the right size.
The primitive can fail for the following reasons with the specified failure codes:
+ PrimErrGenericFailure: the segmentWordArray is too small for the version stamp
+ PrimErrWritePastObject: the segmentWordArray is too small to contain the reachable objects
+ PrimErrBadIndex: the outPointerArray is too small
+ PrimErrNoMemory: there is insufficient free space to store the array answered by objectsReachableFromRoots:,
+ or the savedFirstFields and savedOutHashes arrays.
+ PrimErrNeedCompaction: a GC is needed to make room for the array answered by objectsReachableFromRoots:
+ PrimErrLimitExceeded: there is no room in the hash field to store out pointer indices or class references,
+ or the outPointerArray is larger than the max value of the hash field.
+ PrimErrNoModification: the segmentWordArrayArg or outPointerArrayArg are immutable
+ PrimErrObjectIsPinned: the segmentWordArrayArg or outPointerArrayArg are pinned"
- PrimErrGenericError: the segmentWordArray is too small for the version stamp
- PrimErrWritePastObject: the segmentWordArray is too small to contain the reachable objects
- PrimErrBadIndex: the outPointerArray is too small
- PrimErrNoMemory: additional allocations failed
- PrimErrLimitExceeded: there is no room in the hash field to store out pointer indices or class references."
<inline: false>
| segmentWordArray outPointerArray arrayOfRoots
arrayOfObjects savedFirstFields savedOutHashes segStart segAddr endSeg outIndex numClassesInSegment |
<var: 'segAddr' type: #usqInt>
((self isObjImmutable: segmentWordArrayArg)
or: [self isObjImmutable: outPointerArrayArg]) ifTrue:
[^PrimErrNoModification].
"Since segmentWordArrayArg & outPointerArrayArg may get shortened, they can't be pinned."
((self isPinned: segmentWordArrayArg)
or: [self isPinned: outPointerArrayArg]) ifTrue:
[^PrimErrObjectIsPinned].
(self numSlotsOf: outPointerArrayArg) > self maxIdentityHash ifTrue:
[^PrimErrLimitExceeded].
self runLeakCheckerFor: GCCheckImageSegment.
"First scavenge to collect any new space garbage that refers to the graph."
self scavengingGC.
segmentWordArray := self updatePostScavenge: segmentWordArrayArg.
outPointerArray := self updatePostScavenge: outPointerArrayArg.
arrayOfRoots := self updatePostScavenge: arrayOfRootsArg.
self deny: (self forwardersIn: outPointerArray).
self deny: (self forwardersIn: arrayOfRoots).
"Now compute the transitive closure, collecting the sequence of objects to be stored in the arrayOfObjects array.
Included in arrayOfObjects are the arrayOfRoots and all its contents. All objects have been unmarked."
arrayOfObjects := self objectsReachableFromRoots: arrayOfRoots.
arrayOfObjects ifNil:
[^PrimErrNoMemory halt].
"If objectsReachableFromRoots: answers an integer there is not enough continuous free space in which to allocate the
reachable objects. If there is sufficient free space then answer an error code to prompt a compacting GC and a retry."
(self isIntegerObject: arrayOfObjects) ifTrue:
[totalFreeOldSpace - self allocationUnit >= (self integerValueOf: arrayOfObjects) ifTrue:
[^PrimErrNeedCompaction].
^PrimErrNoMemory halt].
self assert: self allObjectsUnmarked. "work to be done when the incremental GC is written"
self deny: (self forwardersIn: arrayOfObjects).
"Both to expand the max size of segment and to reduce the length of the
load-time pass that adds classes to the class table, move classes to the
front of arrayOfObjects, leaving the root array as the first element."
numClassesInSegment := self moveClassesForwardsIn: arrayOfObjects.
"The scheme is to copy the objects into segmentWordArray, and then map the oops in segmentWordArray.
Therefore the primitive needs to both map efficiently originals to copies in segmentWordArray and
be able to undo any side-effects if the primitive fails because either segmentWordArray or outPointerArray
is too small. The mapping is done by having the objects to be stored in arrayOfObjects refer to their mapped
locations through their first field, just like a forwarding pointer, but without becoming a forwarder, saving their
first field in savedFirstFields, and the objects in outPointerArray pointing to their locations in the outPointerArray
through their identityHashes, saved in savedOutHashes.
Since arrayOfObjects and its savedFirstFields, and outPointerArray and its saved hashes, can be enumerated
side-by-side, the hashes can be restored to the originals. So the first field of the heap object corresponding to
an object in arrayOfObjects is set to its location in segmentWordArray, and the hash of an object in outPointerArray
is set to its index in outPointerArray plus the top hash bit. Classes in arrayOfObjects have their marked bit set.
Oops in objects in segmentWordArray are therefore mapped by accessing the original oop, and following its first
field. Class indices in segmentWordArray are mapped by fetching the original class, and testing its marked bit.
If marked, the first field is followed to access the class copy in the segment. Out pointers (objects and classes,
which are unmarked), the object's identityHash is set (eek!!!!) to its index in the outPointerArray. So savedOutHashes
parallels the outPointerArray. The saved hash array is initialized with an out-of-range hash value so that the first
unused entry can be identified."
savedFirstFields := self noInlineAllocateSlots: (self numSlotsOf: arrayOfObjects)
format: self wordIndexableFormat
classIndex: self wordSizeClassIndexPun.
savedOutHashes := self noInlineAllocateSlots: (self numSlotsForBytes: (self numSlotsOf: outPointerArray) * 4)
format: self firstLongFormat
classIndex: self thirtyTwoBitLongsClassIndexPun.
(savedFirstFields isNil or: [savedOutHashes isNil]) ifTrue:
[self freeObject: arrayOfObjects.
(savedFirstFields notNil and: [self isInOldSpace: savedFirstFields]) ifTrue:
[self freeObject: savedFirstFields].
(savedOutHashes notNil and: [self isInOldSpace: savedOutHashes]) ifTrue:
[self freeObject: savedOutHashes].
^PrimErrNoMemory halt].
self fillObj: savedFirstFields numSlots: (self numSlotsOf: savedFirstFields) with: 0.
self fillObj: savedOutHashes numSlots: (self numSlotsOf: savedOutHashes) with: self savedOutHashFillValue.
segAddr := segmentWordArray + self baseHeaderSize.
endSeg := self addressAfter: segmentWordArray.
"Write a version number for byte order and version check."
segAddr >= endSeg ifTrue: [^PrimErrGenericFailure].
self long32At: segAddr put: self imageSegmentVersion.
self long32At: segAddr + 4 put: self imageSegmentVersion.
segStart := segAddr := segAddr + self allocationUnit.
self assert: arrayOfRoots = (self fetchPointer: 0 ofObject: arrayOfObjects).
"Copy all reachable objects to the segment, setting the marked bit for all objects (clones) in the segment,
and the remembered bit for all classes (clones) in the segment."
0 to: (self numSlotsOf: arrayOfObjects) - 1 do:
[:i| | newSegAddrOrError objOop |
"Check that classes in the segment are addressable. Since the top bit of the hash field is used to tag
classes external to the segment, the segment offset must not inadvertently set this bit. This limit still
allows for a million or more classes."
(i = numClassesInSegment
and: [segAddr - segStart / self allocationUnit + self lastClassIndexPun >= TopHashBit]) ifTrue:
[^self return: PrimErrLimitExceeded
restoringObjectsIn: arrayOfObjects upTo: i savedFirstFields: savedFirstFields].
objOop := self fetchPointer: i ofObject: arrayOfObjects.
self deny: ((self isImmediate: objOop) or: [self isForwarded: objOop]).
newSegAddrOrError := self copyObj: objOop
toAddr: segAddr
stopAt: endSeg
savedFirstFields: savedFirstFields
index: i.
(self oop: newSegAddrOrError isLessThan: segStart) ifTrue:
[^self return: newSegAddrOrError
restoringObjectsIn: arrayOfObjects upTo: i savedFirstFields: savedFirstFields].
segAddr := newSegAddrOrError].
"Check that it can be safely shortened."
(endSeg ~= segAddr
and: [endSeg - segAddr < (self baseHeaderSize + self bytesPerOop)]) ifTrue:
[^self return: PrimErrWritePastObject
restoringObjectsIn: arrayOfObjects upTo: -1 savedFirstFields: savedFirstFields].
"Now scan, adding out pointers to the outPointersArray; all objects in arrayOfObjects
have their first field pointing to the corresponding copy in segmentWordArray."
(outIndex := self mapOopsFrom: segStart
to: segAddr
outPointers: outPointerArray
outHashes: savedOutHashes) < 0 ifTrue: "no room in outPointers; fail"
[^self return: PrimErrBadIndex
restoringObjectsIn: arrayOfObjects savedFirstFields: savedFirstFields
and: outPointerArray savedHashes: savedOutHashes].
"We're done. Shorten the results, restore hashes and return."
self shorten: segmentWordArray toIndexableSize: segAddr - (segmentWordArray + self baseHeaderSize) / 4.
self shorten: outPointerArray toIndexableSize: outIndex.
^self return: PrimNoErr
restoringObjectsIn: arrayOfObjects savedFirstFields: savedFirstFields
and: outPointerArray savedHashes: savedOutHashes!
Item was changed:
----- Method: SpurSegmentManager>>writeSegment:nextSegment:toFile: (in category 'snapshot') -----
writeSegment: segment nextSegment: nextSegment toFile: aBinaryStream
"Write the segment contents, the size of and the distance to the next segment to aBinaryStream."
<var: 'segment' type: #'SpurSegmentInfo *'>
<var: 'nextSegment' type: #'SpurSegmentInfo *'>
<var: 'aBinaryStream' type: #sqImageFile>
| pier1 pier2 firstSavedBridgeWord secondSavedBridgeWord nWritten |
<var: 'firstSavedBridgeWord' type: #usqLong>
<var: 'secondSavedBridgeWord' type: #usqLong>
pier1 := segment segLimit - manager bridgeSize.
pier2 := pier1 + manager baseHeaderSize.
self assert: (self isValidSegmentBridge: (self bridgeFor: segment)).
self assert: (manager startOfObject: (self bridgeFor: segment)) = pier1.
"Temporarily change the bridge to bridge to the next non-empty segment.
The first double word of the bridge includes the bridge size in slots, and
hence specifies the distance to the next segment. The following double
word is replaced by the size of the next segment, or 0 if there isn't one."
firstSavedBridgeWord := manager long64At: pier1.
secondSavedBridgeWord := manager long64At: pier2.
self bridgeFrom: segment to: nextSegment.
manager
long64At: pier2
put: (nextSegment ifNil: [0] ifNotNil: [nextSegment segSize]).
nWritten := self cCode:
[self
sq: segment segStart asVoidPointer
Image: 1
File: segment segSize
Write: aBinaryStream]
inSmalltalk:
[| bytesPerElement |
bytesPerElement := manager memory bytesPerElement.
aBinaryStream
next: segment segSize / bytesPerElement
putAll: manager memory
+ startingAt: segment segStart - manager memoryOffset / bytesPerElement + 1.
- startingAt: segment segStart / bytesPerElement + 1.
segment segSize].
manager
long64At: pier1 put: firstSavedBridgeWord;
long64At: pier2 put: secondSavedBridgeWord.
^nWritten!
Item was changed:
----- Method: StackInterpreter>>writeImageFileIOSimulation (in category 'image save/restore') -----
writeImageFileIOSimulation
"Write the image header and heap contents to imageFile for snapshot.
c.f. writeImageFileIO. The game below is to maintain 64-bit alignment
for all putLong:toFile: occurrences."
<doNotGenerate>
| headerSize file |
headerSize := objectMemory wordSize * 16.
(file := FileStream fileNamed: self imageName) ifNil:
[self primitiveFail.
^nil].
[file binary.
self putWord32: self imageFormatVersion toFile: file.
self putWord32: headerSize toFile: file.
{
objectMemory imageSizeToWrite.
objectMemory baseAddressOfImage.
objectMemory specialObjectsOop.
objectMemory lastHash.
self ioScreenSize.
self getImageHeaderFlags
}
do: [:long | self putLong: long toFile: file].
self putWord32: (extraVMMemory ifNil: [0]) toFile: file.
{ desiredNumStackPages. self unknownShortOrCodeSizeInKs } do:
[:short| self putShort: short toFile: file].
self putWord32: desiredEdenBytes toFile: file.
{ maxExtSemTabSizeSet ifTrue: [self ioGetMaxExtSemTableSize] ifFalse: [0]. 0 } do:
[:short| self putShort: short toFile: file].
objectMemory hasSpurMemoryManagerAPI
ifTrue:
[| bytesWritten |
self putLong: objectMemory firstSegmentBytes toFile: file.
self putLong: objectMemory bytesLeftInOldSpace toFile: file.
2 timesRepeat: [self putLong: 0 toFile: file] "Pad the rest of the header.".
objectMemory wordSize = 8 ifTrue:
[3 timesRepeat: [self putLong: 0 toFile: file]].
self assert: file position = headerSize.
bytesWritten := objectMemory writeImageSegmentsToFile: file.
self assert: bytesWritten = objectMemory imageSizeToWrite]
ifFalse:
["Pad the rest of the header."
4 timesRepeat: [self putLong: 0 toFile: file].
objectMemory wordSize = 8 ifTrue:
[3 timesRepeat: [self putLong: 0 toFile: file]].
self assert: file position = headerSize.
"Write the object memory."
file
next: objectMemory imageSizeToWrite // objectMemory memory bytesPerElement
putAll: objectMemory memory
+ startingAt: objectMemory baseAddressOfImage - objectMemory memoryOffset // objectMemory memory bytesPerElement].
- startingAt: objectMemory baseAddressOfImage // objectMemory memory bytesPerElement].
file truncate: file position.
self success: true]
ensure: [file ifNotNil: [file close]]!
Hi folks,
Thanks for the updated information Dave.
I try to put together the involved files:
* sqUnixExtendedClipboard.c
<https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/2736b5e94d8965888a…>
in the repo
* sqUnix.c -> do we have function from the forked OLPC's VM version to
fetch from there? I took a look at it[1] but I did not see
sqPastboardClear for example in there sources files. Should it no be
defined somewhere else in the OLPC's VM because Vanessa wrote us the
plugin was working ?
* ClipboardExtendedPlugin.c, its header writes it is autogenerated in
2008. I forgot where I took that file...
Thanks
Hilaire
[1]
http://squeakvm.org/svn/squeak/branches/olpc/platforms/unix/vm-display-X11/…
Le 04/04/2023 à 00:33, David T. Lewis a écrit :
> The original file from OLPC that Juan identified is now committed
> in the opensmalltalk-vm repository at:
>
> https://github.com/OpenSmalltalk/opensmalltalk-vm/commit/2736b5e94d8965888a…
>
> This is identical to the original source file from OLPC, so you can
> see the differences directly in github now. There is no need to go
> back to the squeakvm.org SVN source base, they are the same.
--
GNU Dr. Geo
http://drgeo.euhttp://blog.drgeo.eu
Hi,
I want to copy to the OS clipboard DrGeo sketch as SVG image.
The clipboard in the image is only for text. I read about Extented
Clipboard (Mac OSX) plugin to manage other type of data. I was told the
plugin also existed for Linux at some time (when Sophie was developed).
Is it possible to retrieve it?
Thanks
Hilaire
--
GNU Dr. Geo
http://drgeo.euhttp://blog.drgeo.eu
