Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.453.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.453
Author: eem
Time: 11 October 2013, 5:19:39.495 pm
UUID: 1510990d-a971-41cc-8a66-bc65a160454a
Ancestors: VMMaker.oscog-eem.452
Oops. Some stragglers. Now gcc3x-interp.c is generated for
StackInterpreter + Spur.
=============== Diff against VMMaker.oscog-eem.452 ===============
Item was added:
+ ----- Method: Spur32BitMMLESimulator>>isNonIntegerObject: (in category 'object testing') -----
+ isNonIntegerObject: oop
+ "This list records the valid senders of isNonIntegerObject: as we replace uses of
+ isNonIntegerObject: by isNonImmediate: where appropriate."
+ (#( on:do: "from the dbeugger"
+ reverseDisplayFrom:to:
+ primitiveObjectAtPut
+ isCogMethodReference:) includes: thisContext sender method selector) ifFalse:
+ [self halt].
+ ^super isNonIntegerObject: oop!
Item was added:
+ ----- Method: SpurMemoryManager class>>additionalHeadersDo: (in category 'translation') -----
+ additionalHeadersDo: aBinaryBlock
+ "Evaluate aBinaryBlock with the names and contents of
+ any additional header files that need to be generated."!
Item was changed:
----- Method: SpurMemoryManager>>isNonIntegerObject: (in category 'object testing') -----
isNonIntegerObject: oop
- "This list records the valid senders of isNonIntegerObject: as we replace uses of
- isNonIntegerObject: by isNonImmediate: where appropriate."
- (#( on:do: "from the dbeugger"
- reverseDisplayFrom:to:
- primitiveObjectAtPut
- isCogMethodReference:) includes: thisContext sender method selector) ifFalse:
- [self halt].
^(oop bitAnd: 1) = 0!
On 11-10-2013, at 10:19 PM, commits(a)source.squeak.org wrote:
> Spur now loads an image and can evaluate 3+4 (needs Cog-eem.114 or later).
Yay! You're done!
tim
--
tim Rowledge; tim(a)rowledge.org; http://www.rowledge.org/tim
Fractured Idiom:- COGITO EGGO SUM - I think; therefore, I am a waffle
Eliot Miranda uploaded a new version of Cog to project VM Maker:
http://source.squeak.org/VMMaker/Cog-eem.113.mcz
==================== Summary ====================
Name: Cog-eem.113
Author: eem
Time: 11 October 2013, 10:09:35.348 am
UUID: 79cf1a1f-f091-4e6d-921f-610983da576e
Ancestors: Cog-eem.112
Set the display size in the saved transformed Spur image.
=============== Diff against Cog-eem.112 ===============
Item was changed:
Object subclass: #SpurBootstrap
instanceVariableNames: 'oldHeap newHeap oldHeapSize newHeapSize map reverseMap classToIndex oldInterpreter lastClassTablePage literalMap methodClasses installedPrototypes sizeSym rehashSym classMetaclass'
+ classVariableNames: 'ImageHeaderFlags ImageName ImageScreenSize TransformedImage'
- classVariableNames: 'ImageHeaderFlags ImageName TransformedImage'
poolDictionaries: 'VMObjectIndices'
category: 'Cog-Bootstrapping'!
!SpurBootstrap commentStamp: 'eem 9/11/2013 05:45' prior: 0!
SpurBootstrap bootstraps an image in SpurMemoryManager format from a Squeak V3 + closures format.
e.g.
(SpurBootstrap32 new on: '/Users/eliot/Cog/startreader.image')
transform;
launch
Bootstrap issues:
- should it implement a deterministic Symbol identityHash? This means set a Symbol's identityHash at instance creation time
based on its string hash so that e.g. MethodDIctionary instances have a deterministic order and don't need to be rehashed on load.
- should it collapse ContextPart and MethodContext down onto Context (and perhaps eliminate BlockContext)?
Instance Variables
classToIndex: <Dictionary>
lastClassTablePage: <Integer>
map: <Dictionary>
methodClasses: <Set>
newHeap: <SpurMemoryManager>
oldHeap: <NewObjectMemory>
oldInterpreter: <StackInterpreterSimulator>
reverseMap: <Dictionary>
symbolMap: <Dictionary>
classToIndex
- oldClass to new classIndex map
lastClassTablePage
- oop in newHeap of last classTable page. U<sed in validation to filter-out class table.
methodClasses
- cache of methodClassAssociations for classes in which modified methods are installed
map
- oldObject to newObject map
newHeap
- the output, bootstrapped image
oldHeap
- the input, image
oldInterpreter
- the interpreter associated with oldHeap, needed for a hack to grab WeakArray
reverseMap
- newObject to oldObject map
symbolMap
- symbol toi symbol oop in oldHeap, used to map prototype methdos to methods in oldHeap!
Item was changed:
----- Method: SpurBootstrap>>saveTransformedImage (in category 'development support') -----
saveTransformedImage
ImageHeaderFlags := oldInterpreter getImageHeaderFlags.
+ ImageScreenSize := oldInterpreter savedWindowSize.
ImageName := oldInterpreter imageName.
newHeap coInterpreter: nil.
(newHeap class allInstVarNames select: [:ivn| ivn beginsWith: 'stat']) do:
[:ivn| newHeap instVarNamed: ivn put: 0].
TransformedImage := newHeap veryDeepCopy!
Item was changed:
----- Method: SpurBootstrap>>writeSnapshotOfTransformedImage (in category 'testing') -----
writeSnapshotOfTransformedImage
"The bootstrapped image typically contains a few big free chunks and one huge free chunk.
Test snapshot writing and loading by turning the largest non-huge chunks into segment bridges
and saving."
| last heap sizes counts barriers sim |
heap := TransformedImage veryDeepCopy.
sim := StackInterpreterSimulator onObjectMemory: heap.
heap coInterpreter: sim.
sim initializeInterpreter: 0;
+ setImageHeaderFlagsFrom: ImageHeaderFlags;
+ setDisplayForm: (Form extent: ImageScreenSize >> 16 @ (ImageScreenSize bitAnd: 16rFFFF)).
- setImageHeaderFlagsFrom: ImageHeaderFlags.
heap allOldSpaceEntitiesDo: [:e| last := e].
self assert: (heap isFreeObject: last).
sizes := Bag new.
heap allObjectsInFreeTree: (heap freeLists at: 0) do:
[:f|
sizes add: (heap bytesInObject: f)].
counts := sizes sortedCounts.
self assert: counts last key = 1. "1 huge chunk"
self assert: ((counts at: counts size - 1) key > 2
and: [(counts at: counts size - 1) value > 1024]).
barriers := (1 to: (counts at: counts size - 1) key) collect:
[:ign| heap allocateOldSpaceChunkOfExactlyBytes: (counts at: counts size - 1) value].
barriers := barriers, {heap allocateOldSpaceChunkOfExactlyBytes: (heap bytesInObject: last)}.
heap setEndOfMemory: barriers last.
heap allOldSpaceEntitiesDo: [:e| last := e].
self assert: (heap addressAfter: last) = barriers last.
heap checkFreeSpace.
heap runLeakCheckerForFullGC: true.
heap segmentManager initializeFromFreeChunks: (barriers sort collect: [:b| heap objectStartingAt: b]).
heap checkFreeSpace.
heap runLeakCheckerForFullGC: true.
sim imageName: 'spur.image'.
sim writeImageFileIO!
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.450.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.450
Author: eem
Time: 11 October 2013, 9:48:56.883 am
UUID: 86e607b5-0e72-4bf7-bda3-064b59b40267
Ancestors: VMMaker.oscog-eem.449
Fix swizzling:
- search the segments in reverse order for the first segment whose
start is less than or equal to the oop.
- add an assert set in adjustSegmentSwizzlesBy: and cleared in
collapseSegmentsPostSwizzle that checks that swizzling is done
only while the swizzle info is valid (numSegments reflects the num
of segs in the image, not in the loaded system).
- swizzle the freeLists before collapseSegmentsPostSwizzle.
=============== Diff against VMMaker.oscog-eem.449 ===============
Item was added:
+ ----- Method: CObjectAccessor>>first (in category 'accessing') -----
+ first
+ ^self at: 0!
Item was changed:
----- Method: SpurMemoryManager>>initializeObjectMemory: (in category 'initialization') -----
initializeObjectMemory: bytesToShift
"Initialize object memory variables at startup time. Assume endOfMemory is initially set (by the image-reading code) to the end of the last object in the image. Initialization redefines endOfMemory to be the end of the object allocation area based on the total available memory, but reserving some space for forwarding blocks."
"Assume: image reader initializes the following variables:
memory
memoryLimit
specialObjectsOop
lastHash
"
<inline: false>
| freeListObj |
+ self halt.
segmentManager adjustSegmentSwizzlesBy: bytesToShift.
"image may be at a different address; adjust oops for new location"
self adjustAllOopsBy: bytesToShift.
segmentManager numSegments > 0 "false if Spur image bootstrap"
ifTrue: [specialObjectsOop := segmentManager swizzleObj: specialObjectsOop]
ifFalse: [self assert: bytesToShift = 0].
- segmentManager collapseSegmentsPostSwizzle.
-
"heavily used special objects"
nilObj := self splObj: NilObject.
falseObj := self splObj: FalseObject.
trueObj := self splObj: TrueObject.
"In Cog we insist that nil, true & false are next to each other (Cogit generates tighter
conditional branch code as a result). In addition, Spur places the free lists and
class table root page immediately following them."
self assert: nilObj = newSpaceLimit.
self assert: falseObj = (self objectAfter: nilObj).
self assert: trueObj = (self objectAfter: falseObj).
freeListObj := self objectAfter: trueObj.
self classTableRootObj: (self objectAfter: freeListObj).
self initializeFreeSpacePostLoad: freeListObj.
+
+ segmentManager collapseSegmentsPostSwizzle.
.
self initializeOldSpaceFirstFree: freeOldSpaceStart. "initializes endOfMemory, freeStart"
"lowSpaceThreshold := 0.
signalLowSpace := false.
remapBufferCount := 0.
tenuringThreshold := 2000. ""tenure all suriving objects if survivor count is over this threshold""
growHeadroom := 4*1024*1024. ""four megabytes of headroom when growing""
shrinkThreshold := 8*1024*1024. ""eight megabytes of free space before shrinking""
""garbage collection statistics""
statFullGCs := 0.
statFullGCUsecs := 0.
statIncrGCs := 0.
statIncrGCUsecs := 0.
statTenures := 0.
statRootTableOverflows := 0.
statGrowMemory := 0.
statShrinkMemory := 0.
forceTenureFlag := 0.
gcBiasToGrow := 0.
gcBiasToGrowGCLimit := 0.
extraRootCount := 0."!
Item was changed:
----- Method: SpurMemoryManager>>isValidFreeObject: (in category 'free space') -----
isValidFreeObject: objOop
| chunk |
+ ^(self addressCouldBeObj: objOop)
+ and: [(self isFreeObject: objOop)
- ^(self isFreeObject: objOop)
and: [((chunk := (self fetchPointer: self freeChunkNextIndex ofFreeChunk: objOop)) = 0
or: [self isFreeObject: chunk])
and: [(self bytesInObject: objOop) / self allocationUnit < self numFreeLists
or: [((chunk := (self fetchPointer: self freeChunkParentIndex ofFreeChunk: objOop)) = 0
or: [self isFreeObject: chunk])
and: [((chunk := (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: objOop)) = 0
or: [self isFreeObject: chunk])
and: [(chunk := (self fetchPointer: self freeChunkLargerIndex ofFreeChunk: objOop)) = 0
+ or: [self isFreeObject: chunk]]]]]]]!
- or: [self isFreeObject: chunk]]]]]]!
Item was changed:
----- Method: SpurMemoryManager>>unlinkFreeChunk:atIndex: (in category 'free space') -----
unlinkFreeChunk: chunk atIndex: index
+ "Unlink and answer a small chunk from one of the fixed size freeLists"
<inline: true>
self assert: ((self bytesInObject: chunk) = (index * self allocationUnit)
+ and: [index > 1 "a.k.a. (self bytesInObject: chunk) > self allocationUnit"
+ and: [(self startOfObject: chunk) = chunk]]).
- and: [index > 1 "a.k.a. (self bytesInObject: chunk) > self allocationUnit"]).
freeLists
at: index
put: (self
fetchPointer: self freeChunkNextIndex
ofFreeChunk: chunk).
^chunk!
Item was changed:
CogClass subclass: #SpurSegmentManager
+ instanceVariableNames: 'manager numSegments numSegInfos segments firstSegmentSize canSwizzle'
- instanceVariableNames: 'manager numSegments numSegInfos segments firstSegmentSize'
classVariableNames: ''
poolDictionaries: ''
category: 'VMMaker-SpurMemoryManager'!
!SpurSegmentManager commentStamp: 'eem 10/6/2013 10:32' prior: 0!
Instances of SpurSegmentManager manage oldSpace, which is organized as a sequence of segments. Segments can be obtained from the operating system and returned to the operating system when empty and shrinkage is required. Segments are kept invisible from the SpurMemoryManager by using "bridge" objects, "fake" pinned objects to bridge the gaps between segments. A pinned object header occupies the last 16 bytes of each segment, and the pinned object's size is the distance to the start of the next segment. So when the memory manager enumerates objects it skips over these bridges and memory appears linear. The constraint is that segments obtained from the operating system must be at a higher address than the first segment. The maximum size of large objects, being an overflow slot size, should be big enough to bridge the gaps, because in 32-bits the maximum size is 2^32 slots. In 64-bits the maximum size of large objects is 2^56 slots, or 2^59 bits, which we hope will suffice.
When an image is written to a snapshot file the second word of the header of the bridge at the end of each segment is replaced by the size of the following segment, the segments are written to the file, and the second word of each bridge is restored. Hence the length of each segment is derived from the bridge at the end of the preceeding segment. The length of the first segment is stored in the image header as firstSegmentBytes. The start of each segment is also derived from the bridge as a delta from the start of the previous segment. The start of The first segment is stored in the image header as startOfMemory.
On load all segments are read into one single segment, eliminating the bridge objects, and computing the swizzle distance for each segment, based on where the segments were in memory when the image file was written, and where the coallesced segment ends up on load. Then the segment is traversed, swizzling pointers by selecting the relevant swizzle for each oop's segment.
Instance Variables
numSegments: <Integer>
segments: <Array of SpurSegmentInfo>
manager: <SpurMemoryManager>
numSegments
- the number of segments
segments
- the start addresses, lengths and offsets to adjust oops on image load, for each segment
manager
- the SpurMemoryManager whose oldSpace is managed (simulation only).!
Item was changed:
----- Method: SpurSegmentManager>>adjustSegmentSwizzlesBy: (in category 'snapshot') -----
adjustSegmentSwizzlesBy: firstSegmentShift
"Adjust swizzles by firstSegmentShift."
<var: 'segInfo' type: 'SpurSegmentInfo *'>
| oldBaseAddr |
oldBaseAddr := manager memoryBaseForImageRead - firstSegmentShift.
0 to: numSegments - 1 do:
[:i| | segInfo |
segInfo := self addressOf: (segments at: i).
segInfo
start: segInfo start + oldBaseAddr;
+ swizzle: segInfo swizzle - oldBaseAddr].
+ canSwizzle := true!
- swizzle: segInfo swizzle - oldBaseAddr"+ firstSegmentShift"]!
Item was changed:
----- Method: SpurSegmentManager>>collapseSegmentsPostSwizzle (in category 'snapshot') -----
collapseSegmentsPostSwizzle
"The image has been loaded, old segments reconstructed, and the
loaded image swizzled into a single contiguous segment. Collapse
the segments intio one."
| bridge |
+ canSwizzle := false.
firstSegmentSize ifNil: "true when used by SpurBootstrap to transform an image"
[^self].
numSegments := 1.
(segments at: 0)
start: manager newSpaceLimit;
segSize: manager endOfMemory.
"finally plant a bridge at the end of the coallesced segment and cut back the
manager's ntion of the end of memory to immediately before the bridge."
bridge := manager endOfMemory - manager bridgeSize.
manager
initSegmentBridgeWithBytes: manager bridgeSize at: bridge;
setEndOfMemory: bridge!
Item was changed:
----- Method: SpurSegmentManager>>initialize (in category 'initialization') -----
initialize
+ numSegments := numSegInfos := 0.
+ canSwizzle := false!
- numSegments := numSegInfos := 0!
Item was changed:
----- Method: SpurSegmentManager>>swizzleObj: (in category 'snapshot') -----
swizzleObj: objOop
+ self assert: canSwizzle.
+ numSegments - 1 to: 1 by: -1 do:
- 1 to: numSegments - 1 do:
[:i|
+ objOop >= (segments at: i) start ifTrue:
+ [^objOop + (segments at: i) swizzle]].
+ ^objOop + (segments at: 0) swizzle!
- objOop < (segments at: i) start ifTrue:
- [^objOop + (segments at: i - 1) swizzle]].
- ^objOop + (segments at: numSegments - 1) swizzle!
The same image works fine using the interpreter on x86, and on various other VMs. Here's the drgeo.image, inside a zip renamed to .xo:
https://gforge.inria.fr/frs/download.php/30585/DrGeoII-12.04.xo
(original report below)
Any idea what might be wrong?
- Bert -
Begin forwarded message:
> From: "Daniel Drake [via Dr. Geo Forum]" <ml-node+s996172n4024197h7(a)n3.nabble.com>
> Subject: Running on OLPC XO-1.75 (ARM)
> Date: 8. Oktober 2013 23:41:32 MESZ
> To: bert <bert(a)freudenbergs.de>
>
> Hi,
>
> I am trying to run DrGeo on OLPC XO-1.75 using the Sugar activity provided.
>
> This fails to launch because the Sugar activity includes an x86 Squeak VM. I modified the launcher script to use the system-wide Squeak VM (we have 4.10.2.2614, also used for Scratch and Etoys) but without success.
>
> Now, I briefly see a window, then it crashes with:
> Segmentation fault
> -1799995044 UndefinedObject>?
> Segmentation fault
>
> Any ideas or things I can try? I guess the squeak VM we are running there is much newer than the one shipped in the Sugar activity - maybe there is a new drgeo image that I could try against the new VM?
>
> Thanks
> Daniel
>
>
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.449.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.449
Author: eem
Time: 10 October 2013, 5:44:25.893 pm
UUID: 6e6aa8be-c134-4a8b-9911-0e97fa4055cd
Ancestors: VMMaker.oscog-eem.448
Reimplement segmented loading to eliminate the bridges by reading
a segment at a time, instead of reading entire heap in one go and
freeing bridges after the fact.
Refactor image reading into ObjectMemory et al
>>readHeapFromImageFile:dataBytes:.
Make SpurMemoryManager>>setEndOfMemory: cut back
freeOldSpaceStart if required for the bootstrap snapshot.
Make printNameOfClass:count: et al cope with a nil classNameIndex
for pre-initialization debugging (i.e. of just swizzled images).
Bootstrapped image loads but doesn't launch. 6th element in
freeLists is invalid. Ho hum...
=============== Diff against VMMaker.oscog-eem.448 ===============
Item was changed:
----- Method: CoInterpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') -----
readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset
"Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory."
"Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command."
"This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!"
| swapBytes headerStart headerSize dataSize oldBaseAddr
minimumMemory heapSize bytesRead bytesToShift
hdrNumStackPages hdrEdenBytes hdrCogCodeSize headerFlags hdrMaxExtSemTabSize firstSegSize |
<var: #f type: 'sqImageFile '>
<var: #memStart type: 'usqInt'>
<var: #desiredHeapSize type: 'usqInt'>
<var: #headerStart type: 'squeakFileOffsetType '>
<var: #dataSize type: 'size_t '>
<var: #imageOffset type: 'squeakFileOffsetType '>
metaclassSizeBits := 6 * BytesPerWord. "guess (Metaclass instSize * BPW)"
swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
headerStart := (self sqImageFilePosition: f) - BytesPerWord. "record header start position"
headerSize := self getLongFromFile: f swap: swapBytes.
dataSize := self getLongFromFile: f swap: swapBytes.
oldBaseAddr := self getLongFromFile: f swap: swapBytes.
objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes).
objectMemory lastHash: (self getLongFromFile: f swap: swapBytes). "N.B. not used."
savedWindowSize := self getLongFromFile: f swap: swapBytes.
headerFlags := self getLongFromFile: f swap: swapBytes.
self setImageHeaderFlagsFrom: headerFlags.
extraVMMemory := self getLongFromFile: f swap: swapBytes. "N.B. not used."
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.
Can be set as a preference (Info.plist, VM.ini, command line etc).
If desiredNumStackPages is already non-zero then it has been
set as a preference. Ignore (but preserve) the header's default."
numStackPages := desiredNumStackPages ~= 0
ifTrue: [desiredNumStackPages]
ifFalse: [hdrNumStackPages = 0
ifTrue: [self defaultNumStackPages]
ifFalse: [hdrNumStackPages]].
desiredNumStackPages := hdrNumStackPages.
"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: [self defaultCogCodeSize]
ifFalse: [hdrCogCodeSize]].
hdrEdenBytes := self getLongFromFile: 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.
firstSegSize := self nextLongFrom: f swap: swapBytes.
objectMemory firstSegmentSize: firstSegSize.
"compare memory requirements with availability"
minimumMemory := cogCodeSize "no need to include the stackZone; this is alloca'ed"
+ dataSize
+ objectMemory newSpaceBytes
+ self interpreterAllocationReserveBytes.
heapSize := cogCodeSize "no need to include the stackZone; this is alloca'ed"
+ desiredHeapSize
"+ edenBytes" "don't include edenBytes; this is part of the heap and so part of desiredHeapSize"
+ self interpreterAllocationReserveBytes.
heapSize < minimumMemory ifTrue:
[self insufficientMemorySpecifiedError].
"allocate a contiguous block of memory for the Squeak heap and ancilliary data structures"
objectMemory memory: (self
allocateMemory: heapSize
minimum: minimumMemory
imageFile: f
headerSize: headerSize) asUnsignedInteger.
objectMemory memory = nil ifTrue: [self insufficientMemoryAvailableError].
heapBase := objectMemory memory + cogCodeSize.
self assert: objectMemory startOfMemory = heapBase.
objectMemory
setHeapBase: heapBase
memoryLimit: objectMemory memory + heapSize - 24 "decrease memoryLimit a tad for safety (?!!?!!? eem eem 10/9/2013 15:15)"
endOfMemory: heapBase + dataSize.
"position file after the header"
self sqImageFile: f Seek: headerStart + headerSize.
"read in the image in bulk, then swap the bytes if necessary"
+ bytesRead := objectMemory readHeapFromImageFile: f dataBytes: dataSize.
- bytesRead := self
- sq: (self pointerForOop: objectMemory memoryBaseForImageRead)
- Image: (self sizeof: #char)
- File: dataSize
- Read: f.
bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
self ensureImageFormatIsUpToDate: swapBytes.
"compute difference between old and new memory base addresses"
bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr.
self initializeInterpreter: bytesToShift. "adjusts all oops to new location"
self initializeCodeGenerator.
^dataSize!
Item was changed:
----- Method: CogVMSimulator>>openOn:extraMemory: (in category 'initialization') -----
openOn: fileName extraMemory: extraBytes
"CogVMSimulator new openOn: 'clone.im' extraMemory: 100000"
| f version headerSize count heapSize oldBaseAddr bytesToShift swapBytes hdrNumStackPages
hdrEdenBytes hdrCogCodeSize stackZoneSize methodCacheSize headerFlags primTraceLogSize firstSegSize hdrMaxExtSemTabSize |
"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 getLongFromFile: f swap: swapBytes.
heapSize := 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 getLongFromFile: 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: [self defaultCogCodeSize]
ifFalse: [hdrCogCodeSize]].
desiredCogCodeSize := hdrCogCodeSize.
self assert: f position = 40.
hdrEdenBytes := self getLongFromFile: 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 = 48.
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 * BytesPerWord.
primTraceLogSize := primTraceLog size * BytesPerWord.
"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 := cogCodeSize
+ stackZoneSize
+ methodCacheSize
+ primTraceLogSize
+ self rumpCStackSize.
objectMemory
setHeapBase: heapBase
memoryLimit: heapBase
+ heapSize
+ objectMemory newSpaceBytes
+ self interpreterAllocationReserveBytes
+ extraBytes
endOfMemory: heapBase + heapSize.
objectMemory initialize.
self assert: cogCodeSize \\ 4 = 0.
self assert: objectMemory memoryLimit \\ 4 = 0.
self assert: self rumpCStackSize \\ 4 = 0.
"read in the image in bulk, then swap the bytes if necessary"
f position: headerSize.
objectMemory memory: ((cogit processor endianness == #little
ifTrue: [LittleEndianBitmap]
ifFalse: [Bitmap]) new: objectMemory memoryLimit // 4).
+ count := objectMemory readHeapFromImageFile: f dataBytes: heapSize.
+ count ~= heapSize ifTrue: [self halt].
- count := f readInto: objectMemory memory
- startingAt: objectMemory memoryBaseForImageRead // 4 + 1
- count: heapSize // 4.
- count ~= (heapSize // 4) ifTrue: [self halt].
]
ensure: [f close].
self moveMethodCacheToMemoryAt: cogCodeSize + stackZoneSize.
self movePrimTraceLogToMemoryAt: cogCodeSize + stackZoneSize + methodCacheSize.
self ensureImageFormatIsUpToDate: swapBytes.
bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr. "adjust pointers for zero base address"
Utilities
informUser: 'Relocating object pointers...'
during: [self initializeInterpreter: bytesToShift].
self initializeCodeGenerator!
Item was added:
+ ----- Method: NewObjectMemorySimulator>>memoryBaseForImageRead (in category 'image save/restore') -----
+ memoryBaseForImageRead
+ "Answer the address to read the image into."
+ ^0!
Item was added:
+ ----- Method: ObjectMemory>>readHeapFromImageFile:dataBytes: (in category 'image save/restore') -----
+ readHeapFromImageFile: f dataBytes: numBytes
+ "Read numBytes of image data from f into memory at memoryBaseForImageRead.
+ Answer the number of bytes written."
+ ^self cCode:
+ [self
+ sq: (self pointerForOop: self memoryBaseForImageRead)
+ Image: (self sizeof: #char)
+ File: numBytes
+ Read: f]
+ inSmalltalk:
+ [(f readInto: memory
+ startingAt: self memoryBaseForImageRead // 4 + 1
+ count: numBytes // 4)
+ * 4]!
Item was changed:
+ ----- Method: SpurMemoryManager>>adjustAllOopsBy: (in category 'snapshot') -----
- ----- Method: SpurMemoryManager>>adjustAllOopsBy: (in category 'initialization') -----
adjustAllOopsBy: bytesToShift
"Adjust all oop references by the given number of bytes. This is
done just after reading in an image when the new base address
of the object heap is different from the base address in the image,
or when loading multiple segments that have been coallesced."
| obj |
(bytesToShift ~= 0
or: [segmentManager numSegments > 1]) ifTrue:
[self assert: self newSpaceIsEmpty.
obj := self objectStartingAt: newSpaceLimit.
[self oop: obj isLessThan: freeOldSpaceStart] whileTrue:
[(self isFreeObject: obj)
ifTrue: [self swizzleFieldsOfFreeChunk: obj]
ifFalse: [self swizzleFieldsOfObject: obj].
obj := self objectAfter: obj]]!
Item was changed:
----- Method: SpurMemoryManager>>allocateOldSpaceChunkOfExactlyBytes: (in category 'free space') -----
allocateOldSpaceChunkOfExactlyBytes: chunkBytes
"Answer a chunk of oldSpace from the free lists, if one of this size
is available, otherwise answer nil. N.B. the chunk is simply a pointer,
it has no valid header. The caller *must* fill in the header correctly."
| initialIndex node nodeBytes parent child smaller larger |
"for debugging:" "totalFreeOldSpace := self totalFreeListBytes"
initialIndex := chunkBytes / self allocationUnit.
initialIndex < self numFreeLists ifTrue:
[(1 << initialIndex <= freeListsMask
and: [(node := freeLists at: initialIndex) ~= 0]) ifTrue:
[self assert: node = (self startOfObject: node).
self assert: (self isValidFreeObject: node).
totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
^self unlinkFreeChunk: node atIndex: initialIndex].
^nil].
"Large chunk. Search the large chunk list.
Large chunk list organized as a tree, each node of which is a list of
chunks of the same size. Beneath the node are smaller and larger
blocks. When the search ends parent should hold the first chunk of
the same size as chunkBytes, or 0 if none."
node := 0.
child := freeLists at: 0.
[child ~= 0] whileTrue:
[| childBytes |
self assert: (self isValidFreeObject: child).
childBytes := self bytesInObject: child.
childBytes = chunkBytes
ifTrue: "size match; try to remove from list at node."
[node := self fetchPointer: self freeChunkNextIndex
ofFreeChunk: child.
node ~= 0 ifTrue:
[self assert: (self isValidFreeObject: node).
self storePointer: self freeChunkNextIndex
ofFreeChunk: child
withValue: (self fetchPointer: self freeChunkNextIndex
ofFreeChunk: node).
totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
^self startOfObject: node].
node := child.
nodeBytes := childBytes.
child := 0] "break out of loop to remove interior node"
ifFalse:
[childBytes < chunkBytes
ifTrue: "walk down the tree"
[child := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: child]
ifFalse:
[nodeBytes := childBytes.
child := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: child]]].
"if no chunk, there was no exact fit"
node = 0 ifTrue:
[^nil].
"self printFreeChunk: parent"
self assert: nodeBytes = chunkBytes.
self assert: (self bytesInObject: node) = chunkBytes.
"can't be a list; would have removed and returned it above."
self assert: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: node) = 0.
"no list; remove an interior node; reorder tree simply. two cases (which have mirrors, for four total):
case 1. interior node has one child, P = parent, N = node, S = subtree (mirrored for large vs small)
___ ___
| P | | P |
_/_ _/_
| N | => | S |
_/_
| S |
case 2: interior node has two children, , P = parent, N = node, L = smaller, left subtree, R = larger, right subtree.
add the left subtree to the bottom left of the right subtree (mirrored for large vs small)
___ ___
| P | | P |
_/_ _/_
| N | => | R |
_/_ _\_ _/_
| L | | R | | L |"
smaller := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: node.
larger := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: node.
parent := self fetchPointer: self freeChunkParentIndex ofFreeChunk: node.
parent = 0
ifTrue: "no parent; stitch the subnodes back into the root"
[smaller = 0
ifTrue:
[self storePointer: self freeChunkParentIndex ofFreeChunk: larger withValue: 0.
freeLists at: 0 put: larger]
ifFalse:
[self storePointer: self freeChunkParentIndex ofFreeChunk: smaller withValue: 0.
freeLists at: 0 put: smaller.
larger ~= 0 ifTrue:
[self addFreeSubTree: larger]]]
ifFalse: "parent; stitch back into appropriate side of parent."
[smaller = 0
ifTrue: [self storePointer: (node = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent)
ifTrue: [self freeChunkSmallerIndex]
ifFalse: [self freeChunkLargerIndex])
ofFreeChunk: parent
withValue: larger.
self storePointer: self freeChunkParentIndex
ofObject: larger
withValue: parent]
ifFalse:
[self storePointer: (node = (self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: parent)
ifTrue: [self freeChunkSmallerIndex]
ifFalse: [self freeChunkLargerIndex])
ofFreeChunk: parent
withValue: smaller.
self storePointer: self freeChunkParentIndex
ofObject: smaller
withValue: parent.
larger ~= 0 ifTrue:
[self addFreeSubTree: larger]]].
+ totalFreeOldSpace := totalFreeOldSpace - chunkBytes.
^self startOfObject: node!
Item was added:
+ ----- Method: SpurMemoryManager>>bridgeSize (in category 'segments') -----
+ bridgeSize
+ ^2 * self baseHeaderSize!
Item was added:
+ ----- Method: SpurMemoryManager>>initializeFreeSpacePostLoad: (in category 'snapshot') -----
+ initializeFreeSpacePostLoad: freeListObj
+ "Reinitialize the free list info. The freeLists object needs to be swizzled
+ because its neither a free, nor a pointer object. Free objects have already
+ been swizzled in adjustAllOopsBy:"
+
+ self assert: (self numSlotsOf: freeListObj) = self numFreeLists.
+ self assert: (self formatOf: freeListObj) = (self wordSize = 4
+ ifTrue: [self firstLongFormat]
+ ifFalse: [self sixtyFourBitIndexableFormat]).
+
+ segmentManager numSegments = 0 ifTrue: "true in Spur image bootstrap"
+ [^self].
+ self halt.
+ freeLists := self firstIndexableField: freeListObj.
+ 0 to: self numFreeLists - 1 do:
+ [:i|
+ (freeLists at: i) ~= 0 ifTrue:
+ [freeListsMask := freeListsMask bitOr: (1 << i).
+ segmentManager numSegments > 0 ifTrue:
+ [freeLists at: i put: (segmentManager swizzleObj: (freeLists at: i))]]].
+ totalFreeOldSpace := self totalFreeListBytes!
Item was changed:
----- Method: SpurMemoryManager>>initializeObjectMemory: (in category 'initialization') -----
initializeObjectMemory: bytesToShift
"Initialize object memory variables at startup time. Assume endOfMemory is initially set (by the image-reading code) to the end of the last object in the image. Initialization redefines endOfMemory to be the end of the object allocation area based on the total available memory, but reserving some space for forwarding blocks."
"Assume: image reader initializes the following variables:
memory
memoryLimit
specialObjectsOop
lastHash
"
<inline: false>
| freeListObj |
+ segmentManager adjustSegmentSwizzlesBy: bytesToShift.
- segmentManager parseSegmentsInNewlyLoadedImage: bytesToShift.
"image may be at a different address; adjust oops for new location"
self adjustAllOopsBy: bytesToShift.
segmentManager numSegments > 0 "false if Spur image bootstrap"
ifTrue: [specialObjectsOop := segmentManager swizzleObj: specialObjectsOop]
ifFalse: [self assert: bytesToShift = 0].
+ segmentManager collapseSegmentsPostSwizzle.
+
"heavily used special objects"
nilObj := self splObj: NilObject.
falseObj := self splObj: FalseObject.
trueObj := self splObj: TrueObject.
"In Cog we insist that nil, true & false are next to each other (Cogit generates tighter
conditional branch code as a result). In addition, Spur places the free lists and
class table root page immediately following them."
self assert: nilObj = newSpaceLimit.
self assert: falseObj = (self objectAfter: nilObj).
self assert: trueObj = (self objectAfter: falseObj).
freeListObj := self objectAfter: trueObj.
- self assert: (self numSlotsOf: freeListObj) = self numFreeLists.
- self assert: (self formatOf: freeListObj) = (self wordSize = 4
- ifTrue: [self firstLongFormat]
- ifFalse: [self sixtyFourBitIndexableFormat]).
- freeLists := self firstIndexableField: freeListObj.
- 0 to: self numFreeLists - 1 do:
- [:i|
- (freeLists at: i) ~= 0 ifTrue:
- [freeLists at: i put: (segmentManager swizzleObj: (freeLists at: i))]].
self classTableRootObj: (self objectAfter: freeListObj).
+ self initializeFreeSpacePostLoad: freeListObj.
.
- segmentManager collapseSegmentsPostSwizzle.
self initializeOldSpaceFirstFree: freeOldSpaceStart. "initializes endOfMemory, freeStart"
"lowSpaceThreshold := 0.
signalLowSpace := false.
remapBufferCount := 0.
tenuringThreshold := 2000. ""tenure all suriving objects if survivor count is over this threshold""
growHeadroom := 4*1024*1024. ""four megabytes of headroom when growing""
shrinkThreshold := 8*1024*1024. ""eight megabytes of free space before shrinking""
""garbage collection statistics""
statFullGCs := 0.
statFullGCUsecs := 0.
statIncrGCs := 0.
statIncrGCUsecs := 0.
statTenures := 0.
statRootTableOverflows := 0.
statGrowMemory := 0.
statShrinkMemory := 0.
forceTenureFlag := 0.
gcBiasToGrow := 0.
gcBiasToGrowGCLimit := 0.
extraRootCount := 0."!
Item was added:
+ ----- Method: SpurMemoryManager>>readHeapFromImageFile:dataBytes: (in category 'snapshot') -----
+ readHeapFromImageFile: f dataBytes: numBytes
+ "Read numBytes of image data from f into memory at memoryBaseForImageRead.
+ Answer the number of bytes written."
+ <doNotGenerate>
+ ^segmentManager readHeapFromImageFile: f dataBytes: numBytes!
Item was changed:
----- Method: SpurMemoryManager>>setEndOfMemory: (in category 'snapshot') -----
setEndOfMemory: newEndOfMemory
+ "Set by the segment manager after swizzling the image,
+ and by the SpurBootstrap on writing out the transformed image."
+ endOfMemory := newEndOfMemory.
+ freeOldSpaceStart > newEndOfMemory ifTrue:
+ [freeOldSpaceStart := newEndOfMemory]!
- "Set by the segment manager after swizzling the image."
- endOfMemory := newEndOfMemory!
Item was changed:
+ ----- Method: SpurMemoryManager>>swizzleFieldsOfFreeChunk: (in category 'snapshot') -----
- ----- Method: SpurMemoryManager>>swizzleFieldsOfFreeChunk: (in category 'initialization') -----
swizzleFieldsOfFreeChunk: chunk
<inline: true>
0 to: ((self bytesInObject: chunk) / self allocationUnit > self numFreeLists
ifTrue: [self freeChunkLargerIndex]
ifFalse: [self freeChunkNextIndex])
do: [:index| | field |
field := self fetchPointer: index ofFreeChunk: chunk.
field ~= 0 ifTrue:
[self storePointer: index
ofFreeChunk: chunk
withValue: (segmentManager swizzleObj: field)]]!
Item was changed:
+ ----- Method: SpurMemoryManager>>swizzleFieldsOfObject: (in category 'snapshot') -----
- ----- Method: SpurMemoryManager>>swizzleFieldsOfObject: (in category 'initialization') -----
swizzleFieldsOfObject: oop
| fieldAddr fieldOop |
<inline: true>
fieldAddr := oop + (self lastPointerOf: oop).
[self oop: fieldAddr isGreaterThanOrEqualTo: oop + self baseHeaderSize] whileTrue:
[fieldOop := self longAt: fieldAddr.
(self isNonImmediate: fieldOop) ifTrue:
[self longAt: fieldAddr put: (segmentManager swizzleObj: fieldOop)].
fieldAddr := fieldAddr - BytesPerOop]!
Item was changed:
----- Method: SpurMemoryManager>>totalFreeListBytes (in category 'free space') -----
totalFreeListBytes
| freeBytes bytesInObject obj |
freeBytes := 0.
1 to: self numFreeLists - 1 do:
[:i|
bytesInObject := i * self allocationUnit.
obj := freeLists at: i.
[obj ~= 0] whileTrue:
[freeBytes := freeBytes + bytesInObject.
- self assert: bytesInObject = (self bytesInObject: obj).
self assert: (self isValidFreeObject: obj).
+ self assert: bytesInObject = (self bytesInObject: obj).
obj := self fetchPointer: self freeChunkNextIndex ofFreeChunk: obj]].
^freeBytes + (self bytesInFreeTree: (freeLists at: 0))!
Item was changed:
CogClass subclass: #SpurSegmentManager
+ instanceVariableNames: 'manager numSegments numSegInfos segments firstSegmentSize'
- instanceVariableNames: 'manager numSegments segments firstSegmentSize numSegmentsAllocated'
classVariableNames: ''
poolDictionaries: ''
category: 'VMMaker-SpurMemoryManager'!
!SpurSegmentManager commentStamp: 'eem 10/6/2013 10:32' prior: 0!
Instances of SpurSegmentManager manage oldSpace, which is organized as a sequence of segments. Segments can be obtained from the operating system and returned to the operating system when empty and shrinkage is required. Segments are kept invisible from the SpurMemoryManager by using "bridge" objects, "fake" pinned objects to bridge the gaps between segments. A pinned object header occupies the last 16 bytes of each segment, and the pinned object's size is the distance to the start of the next segment. So when the memory manager enumerates objects it skips over these bridges and memory appears linear. The constraint is that segments obtained from the operating system must be at a higher address than the first segment. The maximum size of large objects, being an overflow slot size, should be big enough to bridge the gaps, because in 32-bits the maximum size is 2^32 slots. In 64-bits the maximum size of large objects is 2^56 slots, or 2^59 bits, which we hope will suffice.
When an image is written to a snapshot file the second word of the header of the bridge at the end of each segment is replaced by the size of the following segment, the segments are written to the file, and the second word of each bridge is restored. Hence the length of each segment is derived from the bridge at the end of the preceeding segment. The length of the first segment is stored in the image header as firstSegmentBytes. The start of each segment is also derived from the bridge as a delta from the start of the previous segment. The start of The first segment is stored in the image header as startOfMemory.
On load all segments are read into one single segment, eliminating the bridge objects, and computing the swizzle distance for each segment, based on where the segments were in memory when the image file was written, and where the coallesced segment ends up on load. Then the segment is traversed, swizzling pointers by selecting the relevant swizzle for each oop's segment.
Instance Variables
numSegments: <Integer>
segments: <Array of SpurSegmentInfo>
manager: <SpurMemoryManager>
numSegments
- the number of segments
segments
- the start addresses, lengths and offsets to adjust oops on image load, for each segment
manager
- the SpurMemoryManager whose oldSpace is managed (simulation only).!
Item was added:
+ ----- Method: SpurSegmentManager>>adjustSegmentSwizzlesBy: (in category 'snapshot') -----
+ adjustSegmentSwizzlesBy: firstSegmentShift
+ "Adjust swizzles by firstSegmentShift."
+ <var: 'segInfo' type: 'SpurSegmentInfo *'>
+ | oldBaseAddr |
+ oldBaseAddr := manager memoryBaseForImageRead - firstSegmentShift.
+ 0 to: numSegments - 1 do:
+ [:i| | segInfo |
+ segInfo := self addressOf: (segments at: i).
+ segInfo
+ start: segInfo start + oldBaseAddr;
+ swizzle: segInfo swizzle - oldBaseAddr"+ firstSegmentShift"]!
Item was added:
+ ----- Method: SpurSegmentManager>>allocateOrExtendSegmentInfos (in category 'private') -----
+ allocateOrExtendSegmentInfos
+ "Increase the number of allocated segInfos by 16."
+ | newNumSegs |
+ numSegInfos = 0 ifTrue:
+ [numSegInfos := 16.
+ segments := self
+ cCode: [self c: numSegInfos alloc: (self sizeof: SpurSegmentInfo)]
+ inSmalltalk: [CArrayAccessor on: ((1 to: numSegInfos) collect: [:i| SpurSegmentInfo new])].
+ ^self].
+ newNumSegs := numSegInfos + 16.
+ segments := self
+ cCode: [self re: newNumSegs * (self sizeof: SpurSegmentInfo) alloc: segments]
+ inSmalltalk: [CArrayAccessor on: segments object,
+ ((numSegInfos to: newNumSegs) collect: [:i| SpurSegmentInfo new])].
+ self cCode:
+ [segments = 0 ifTrue:
+ [self error: 'out of memory; cannot allocate more segments'].
+ self
+ me: segments + numSegInfos
+ ms: 0
+ et: newNumSegs - numSegInfos * (self sizeof: SpurSegmentInfo)].
+ numSegInfos := newNumSegs!
Item was changed:
----- Method: SpurSegmentManager>>collapseSegmentsPostSwizzle (in category 'snapshot') -----
collapseSegmentsPostSwizzle
"The image has been loaded, old segments reconstructed, and the
loaded image swizzled into a single contiguous segment. Collapse
+ the segments intio one."
- the segments, and free the old bridges."
| bridge |
firstSegmentSize ifNil: "true when used by SpurBootstrap to transform an image"
[^self].
- numSegmentsAllocated := numSegments.
- numSegments := 0.
- "segment sizes include the two-header-word bridge at the end of each segment."
- bridge := firstSegmentSize + manager newSpaceLimit - manager baseHeaderSize.
- 1 to: numSegmentsAllocated - 1 do:
- [:i|
- manager
- freeChunkWithBytes: 2 * manager baseHeaderSize
- at: bridge - manager baseHeaderSize.
- bridge := bridge + (segments at: i) segSize].
- "now bridge is pointing to last bridge in loaded image. free the bridge, add a
- bridge at the end of memory, and cut back end of memory to before the bridge."
- manager
- freeChunkWithBytes: 2 * manager baseHeaderSize
- at: bridge - manager baseHeaderSize.
- "now update the segment to reflect the coallesced segments"
numSegments := 1.
(segments at: 0)
start: manager newSpaceLimit;
segSize: manager endOfMemory.
"finally plant a bridge at the end of the coallesced segment and cut back the
manager's ntion of the end of memory to immediately before the bridge."
+ bridge := manager endOfMemory - manager bridgeSize.
- bridge := manager endOfMemory - (2 * manager baseHeaderSize).
manager
+ initSegmentBridgeWithBytes: manager bridgeSize at: bridge;
- initSegmentBridgeWithBytes: 2 * manager baseHeaderSize at: bridge;
setEndOfMemory: bridge!
Item was added:
+ ----- Method: SpurSegmentManager>>initialize (in category 'initialization') -----
+ initialize
+ numSegments := numSegInfos := 0!
Item was changed:
----- Method: SpurSegmentManager>>initializeFromFreeChunks: (in category 'simulation only') -----
initializeFromFreeChunks: freeChunks
"For testing, create a set of segments using the freeChunks as bridges."
numSegments := freeChunks size.
freeChunks do:
[:f|
manager initSegmentBridgeWithBytes: (manager bytesInObject: f) at: (manager startOfObject: f).
self assert: (manager isSegmentBridge: f)].
segments := (1 to: numSegments) collect:
[:i| | bridge start size |
bridge := freeChunks at: i.
start := i = 1
ifTrue: [manager newSpaceLimit]
ifFalse: [manager addressAfter: (freeChunks at: i - 1)].
size := bridge + manager baseHeaderSize - start.
SpurSegmentInfo new
start: start;
segSize: size;
yourself].
segments := CArrayAccessor on: segments.
+ freeChunks allButLast do:
- freeChunks do:
[:bridge| self assert: (manager isValidSegmentBridge: bridge)]!
Item was changed:
----- Method: SpurSegmentManager>>manager: (in category 'initialization') -----
manager: aSpurMemoryManager
+ manager := aSpurMemoryManager!
- manager := aSpurMemoryManager.
- numSegments ifNil:
- [numSegments := 0]!
Item was removed:
- ----- Method: SpurSegmentManager>>parseSegmentsInNewlyLoadedImage: (in category 'snapshot') -----
- parseSegmentsInNewlyLoadedImage: firstSegmentShift
- "Skip through the bridge objects, counting the number of segments.
- Then allocate the segment info and scan again, computing the swizzle
- ammounts for each segment."
- | bridge nextSegmentSize oldBase newBase segInfo bridgeSpan |
- <var: 'segInfo' type: 'SpurSegmentInfo *'>
- firstSegmentSize ifNil: "true when used by SpurBootstrap to transform an image"
- [^self].
-
- numSegments := 0.
- "segment sizes include the two-header-word bridge at the end of each segment."
- bridge := firstSegmentSize + manager newSpaceLimit - manager baseHeaderSize.
- [numSegments := numSegments + 1.
- nextSegmentSize := manager longLongAt: bridge.
- nextSegmentSize ~= 0] whileTrue:
- [bridge := bridge + nextSegmentSize].
- segments := self
- cCode: [self c: numSegments alloc: (self sizeof: SpurSegmentInfo)]
- inSmalltalk: [CArrayAccessor on: ((1 to: numSegments) collect: [:i| SpurSegmentInfo new])].
-
- numSegments := 0.
- oldBase := manager newSpaceLimit - firstSegmentShift.
- newBase := manager newSpaceLimit.
- nextSegmentSize := firstSegmentSize.
- bridge := firstSegmentSize + manager newSpaceLimit - manager baseHeaderSize.
- [segInfo := self addressOf: (segments at: numSegments).
- segInfo
- start: oldBase;
- segSize: nextSegmentSize;
- swizzle: newBase - oldBase.
- numSegments := numSegments + 1.
- bridgeSpan := manager bytesPerSlot * (manager rawOverflowSlotsOf: bridge).
- oldBase := oldBase + nextSegmentSize + bridgeSpan.
- newBase := newBase + nextSegmentSize.
- nextSegmentSize := manager longLongAt: bridge.
- nextSegmentSize ~= 0] whileTrue:
- [bridge := bridge + nextSegmentSize].
- "newBase should point just past the last bridge."
- self assert: (manager longLongAt: newBase - manager baseHeaderSize) = 0.
- "set freeOldSpaceStart now for adjustAllOopsBy:"
- manager setFreeOldSpaceStart: newBase!
Item was added:
+ ----- Method: SpurSegmentManager>>readHeapFrom:at:dataBytes: (in category 'private') -----
+ readHeapFrom: f at: location dataBytes: numBytes
+ "Read numBytes from f into mmory at location. Answer the number of bytes read."
+ ^self cCode:
+ [self
+ sq: (self pointerForOop: location)
+ Image: (self sizeof: #char)
+ File: numBytes
+ Read: f]
+ inSmalltalk:
+ [(f readInto: manager memory
+ startingAt: location // 4 + 1
+ count: numBytes // 4)
+ * 4]!
Item was added:
+ ----- Method: SpurSegmentManager>>readHeapFromImageFile:dataBytes: (in category 'snapshot') -----
+ readHeapFromImageFile: f dataBytes: numBytes
+ "Read numBytes of image data from f into memory at memoryBaseForImageRead.
+ Answer the number of bytes written. In addition, read each segment, build up the
+ segment info, while eliminating the bridge objects that end each segment and
+ give the size of the subsequent segment."
+ | bytesRead totalBytesRead bridge nextSegmentSize oldBase newBase segInfo bridgeSpan |
+ <var: 'segInfo' type: 'SpurSegmentInfo *'>
+ self allocateOrExtendSegmentInfos.
+
+ "segment sizes include the two-header-word bridge at the end of each segment."
+ numSegments := totalBytesRead := 0.
+ oldBase := 0. "N.B. still must be adjusted by oldBaseAddr."
+ newBase := manager newSpaceLimit.
+ nextSegmentSize := firstSegmentSize.
+ bridge := firstSegmentSize + manager newSpaceLimit - manager baseHeaderSize.
+ [segInfo := self addressOf: (segments at: numSegments).
+ segInfo
+ start: oldBase; "N.B. still must be adjusted by oldBaseAddr."
+ segSize: nextSegmentSize;
+ swizzle: newBase - oldBase. "N.B. still must be adjusted by oldBaseAddr."
+ bytesRead := self readHeapFrom: f at: newBase dataBytes: nextSegmentSize.
+ bytesRead > 0 ifTrue:
+ [totalBytesRead := totalBytesRead + bytesRead].
+ bytesRead ~= nextSegmentSize ifTrue:
+ [^totalBytesRead].
+ numSegments := numSegments + 1.
+ bridgeSpan := manager bytesPerSlot * (manager rawOverflowSlotsOf: bridge).
+ oldBase := oldBase + nextSegmentSize + bridgeSpan.
+ newBase := newBase + nextSegmentSize - manager bridgeSize.
+ nextSegmentSize := manager longLongAt: bridge.
+ nextSegmentSize ~= 0] whileTrue:
+ [bridge := bridge - manager bridgeSize + nextSegmentSize].
+ "newBase should point just past the last bridge. all others should have been eliminated."
+ self assert: newBase - manager newSpaceLimit
+ = (totalBytesRead - (numSegments * manager bridgeSize)).
+ "set freeOldSpaceStart now for adjustAllOopsBy:"
+ manager setFreeOldSpaceStart: newBase.
+ ^totalBytesRead!
Item was changed:
----- Method: SpurSegmentManager>>writeSegment:nextSegmentSize:toFile: (in category 'snapshot') -----
writeSegment: aSpurSegmentInfo nextSegmentSize: nextSegSize toFile: aBinaryStream
<var: 'aSpurSegmentInfo' type: 'SpurSegmentInfo *'>
<var: 'aBinaryStream' type: #'FILE *'>
| bridge savedHeader nWritten |
<var: 'savedHeader' type: #usqLong>
bridge := aSpurSegmentInfo start + aSpurSegmentInfo segSize - manager baseHeaderSize.
+ "last seg may be beyond endOfMemory/freeOldSpaceStart"
+ self assert: ((manager isValidSegmentBridge: bridge) or: [nextSegSize = 0]).
- self assert: (manager isValidSegmentBridge: bridge).
savedHeader := manager longLongAt: bridge.
manager longLongAt: bridge put: nextSegSize.
nWritten := self cCode:
[self
sq: aSpurSegmentInfo start
Image: 1
File: aSpurSegmentInfo segSize
Write: aBinaryStream]
inSmalltalk:
[aBinaryStream
next: aSpurSegmentInfo segSize / 4
putAll: manager memory
startingAt: aSpurSegmentInfo start / 4 + 1.
aSpurSegmentInfo segSize].
manager longLongAt: bridge put: savedHeader.
^nWritten!
Item was changed:
----- Method: StackInterpreter>>printNameOfClass:count: (in category 'debug printing') -----
printNameOfClass: classOop count: cnt
"Details: The count argument is used to avoid a possible infinite recursion if classOop is a corrupted object."
<inline: false>
+ classNameIndex ifNil:
+ [self print: '??nil cnidx??'.
+ ^self].
(classOop isNil or: [classOop = 0 or: [cnt <= 0]]) ifTrue: [^self print: 'bad class'].
((objectMemory sizeBitsOf: classOop) = metaclassSizeBits
and: [metaclassSizeBits > (thisClassIndex * BytesPerOop)]) "(Metaclass instSize * 4)"
ifTrue: [self printNameOfClass: (objectMemory fetchPointer: thisClassIndex ofObject: classOop) count: cnt - 1.
self print: ' class']
ifFalse: [self printStringOf: (objectMemory fetchPointer: classNameIndex ofObject: classOop)]!
Item was changed:
----- Method: StackInterpreter>>readImageFromFile:HeapSize:StartingAt: (in category 'image save/restore') -----
readImageFromFile: f HeapSize: desiredHeapSize StartingAt: imageOffset
"Read an image from the given file stream, allocating the given amount of memory to its object heap. Fail if the image has an unknown format or requires more than the given amount of memory."
"Details: This method detects when the image was stored on a machine with the opposite byte ordering from this machine and swaps the bytes automatically. Furthermore, it allows the header information to start 512 bytes into the file, since some file transfer programs for the Macintosh apparently prepend a Mac-specific header of this size. Note that this same 512 bytes of prefix area could also be used to store an exec command on Unix systems, allowing one to launch Smalltalk by invoking the image name as a command."
"This code is based on C code by Ian Piumarta and Smalltalk code by Tim Rowledge. Many thanks to both of you!!!!"
| swapBytes headerStart headerSize dataSize oldBaseAddr hdrNumStackPages
minimumMemory heapBase bytesRead bytesToShift heapSize hdrEdenBytes
headerFlags hdrMaxExtSemTabSize firstSegSize |
<var: #f type: 'sqImageFile '>
<var: #heapBase type: 'usqInt'>
<var: #desiredHeapSize type: 'usqInt'>
<var: #headerStart type: 'squeakFileOffsetType '>
<var: #dataSize type: 'size_t '>
<var: #imageOffset type: 'squeakFileOffsetType '>
metaclassSizeBits := 6 * BytesPerWord. "guess (Metaclass instSize * BPW)"
swapBytes := self checkImageVersionFrom: f startingAt: imageOffset.
headerStart := (self sqImageFilePosition: f) - BytesPerWord. "record header start position"
headerSize := self getLongFromFile: f swap: swapBytes.
dataSize := self getLongFromFile: f swap: swapBytes.
oldBaseAddr := self getLongFromFile: f swap: swapBytes.
objectMemory specialObjectsOop: (self getLongFromFile: f swap: swapBytes).
objectMemory lastHash: (self getLongFromFile: f swap: swapBytes). "N.B. not used."
savedWindowSize := self getLongFromFile: f swap: swapBytes.
headerFlags := self getLongFromFile: f swap: swapBytes.
self setImageHeaderFlagsFrom: headerFlags.
extraVMMemory := self getLongFromFile: 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.
Can be set as a preference (Info.plist, VM.ini, command line etc).
If desiredNumStackPages is already non-zero then it has been
set as a preference. Ignore (but preserve) the header's default."
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.
hdrEdenBytes := self getLongFromFile: 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.
firstSegSize := self nextLongFrom: f swap: swapBytes.
objectMemory firstSegmentSize: firstSegSize.
"decrease Squeak object heap to leave extra memory for the VM"
heapSize := self cCode: 'reserveExtraCHeapBytes(desiredHeapSize, extraVMMemory)'.
"compare memory requirements with availability".
minimumMemory := dataSize + objectMemory newSpaceBytes + self interpreterAllocationReserveBytes.
heapSize < minimumMemory ifTrue:
[self insufficientMemorySpecifiedError].
"allocate a contiguous block of memory for the Squeak heap"
objectMemory memory: (self
allocateMemory: heapSize
minimum: minimumMemory
imageFile: f
headerSize: headerSize) asUnsignedInteger.
objectMemory memory = nil ifTrue: [self insufficientMemoryAvailableError].
heapBase := objectMemory startOfMemory.
objectMemory
setHeapBase: heapBase
memoryLimit: (heapBase + heapSize) - 24 "decrease memoryLimit a tad for safety"
endOfMemory: heapBase + dataSize.
"position file after the header"
self sqImageFile: f Seek: headerStart + headerSize.
"read in the image in bulk, then swap the bytes if necessary"
+ bytesRead := objectMemory readHeapFromImageFile: f dataBytes: dataSize.
- bytesRead := self
- sq: (self pointerForOop: objectMemory memoryBaseForImageRead)
- Image: (self sizeof: #char)
- File: dataSize
- Read: f.
bytesRead ~= dataSize ifTrue: [self unableToReadImageError].
self ensureImageFormatIsUpToDate: swapBytes.
"compute difference between old and new memory base addresses"
bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr.
self initializeInterpreter: bytesToShift. "adjusts all oops to new location"
^dataSize!
Item was changed:
----- Method: StackInterpreterSimulator>>nameOfClass: (in category 'debug support') -----
nameOfClass: classOop
+ classNameIndex ifNil: [^'??nil cnidx??'].
(objectMemory sizeBitsOf: classOop) = metaclassSizeBits ifTrue:
[^(self nameOfClass:
(objectMemory fetchPointer: thisClassIndex ofObject: classOop)) , ' class'].
^self stringOf: (objectMemory fetchPointer: classNameIndex ofObject: classOop)!
Item was changed:
----- 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
hdrNumStackPages hdrEdenBytes headerFlags heapBase firstSegSize hdrMaxExtSemTabSize |
"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 getLongFromFile: 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 getLongFromFile: 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 = 40.
hdrEdenBytes := self getLongFromFile: 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 = 48.
firstSegSize := self getLongFromFile: f swap: swapBytes.
objectMemory firstSegmentSize: firstSegSize.
"allocate interpreter memory"
heapBase := objectMemory startOfMemory.
objectMemory
setHeapBase: heapBase
memoryLimit: heapBase + dataSize + extraBytes + objectMemory newSpaceBytes + self interpreterAllocationReserveBytes
endOfMemory: heapBase + dataSize.
objectMemory memory: (Bitmap new: objectMemory memoryLimit // 4).
"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].
- count := f readInto: objectMemory memory
- startingAt: objectMemory memoryBaseForImageRead // 4 + 1
- count: dataSize // 4.
- count ~= (dataSize // 4) ifTrue: [self halt].
]
ensure: [f close].
self ensureImageFormatIsUpToDate: swapBytes.
bytesToShift := objectMemory memoryBaseForImageRead - oldBaseAddr. "adjust pointers for zero base address"
Utilities informUser: 'Relocating object pointers...'
during: [self initializeInterpreter: bytesToShift].
!