[Vm-dev] VM Maker: VMMaker.oscog-eem.602.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Feb 4 18:05:57 UTC 2014
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.602.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.602
Author: eem
Time: 4 February 2014, 10:02:08.88 am
UUID: aa08ab50-de50-4af2-9572-cdf179427de2
Ancestors: VMMaker.oscog-dtl.601
Refactor InterpreterPrimitives>>primitiveAllObjects to move
creation and enumeration into objectMemory.
Improve ObjectMemory>>allObjects by using fact that allocated
object is always last object in heap.
Implement SpurMemoryManager>>allObjects.
For this, implement small/largeObjectBytesForSlots:
and hence move allocateSlots:format:classIndex: et al up into
SpurMemoryManager.
Fix bug in simulator to find and compute the accessorDepth of
named primitives in InterpreterPrimitives. Hence refactor
code generator creation for Cogit and Interpreter into
methods that allow the interpreter to be passed in as a parameter
and class initialization avoided.
Fix bad bug in Spur>>firstIndexableField: that shifted by wordSize
instead of shiftForWord. Change some uses of wordSize to
bytesPerSlot.
=============== Diff against VMMaker.oscog-dtl.601 ===============
Item was changed:
----- Method: InterpreterPrimitives>>primitiveAllObjects (in category 'object access primitives') -----
primitiveAllObjects
+ "Answer an array of all objects that exist when the primitive
+ is called, excluding those that may be garbage collected as
+ a side effect of allocating the result array."
- "Answer an array of all objects that exist when the primitive is called, excluding those
- that may be garbage collected as a side effect of allocating the result array. The array
- will contain at least one trailing integer zero that serves as a marker for end of valid
- object references. Additional trailing zeros represent objects that were garbage
- collected during execution of this primitive. Sender is responsible for ignoring all
- trailing zero marker objects in the result array."
<export: true>
+ | result |
+ result := objectMemory allObjects.
+ result = 0 ifTrue:
- | count obj resultArray newCount |
- self pop: argumentCount+1.
- "Count the currently accessible objects"
- count := 0.
- obj := objectMemory firstAccessibleObject.
- [obj = nil] whileFalse:
- [count := count + 1.
- obj := objectMemory accessibleObjectAfter: obj].
- "Allocate result array, may cause GC"
- resultArray := objectMemory instantiateClass: objectMemory classArray indexableSize: count.
- resultArray = nil ifTrue:
[^self primitiveFailFor: PrimErrNoMemory].
+ self pop: argumentCount+1 thenPush: result!
- "Store all objects in result array, excluding any reference to the result array
- itself, as may happen if garbage collection occurred during allocation of the array."
- newCount := 0.
- obj := objectMemory firstAccessibleObject.
- [obj = nil or: [newCount >= count]] whileFalse:
- [obj == resultArray
- ifFalse: [newCount := newCount + 1.
- self stObject: resultArray at: newCount put: obj ].
- obj := objectMemory accessibleObjectAfter: obj].
- "If GC occurred during result array allocation, truncate unused portion of result array"
- newCount < count
- ifTrue: [self shorten: resultArray toIndexableSize: newCount].
- self push: resultArray!
Item was added:
+ ----- Method: ObjectMemory>>allObjects (in category 'primitive support') -----
+ allObjects
+ "Attempt to answer an array of all objects, excluding those that may
+ be garbage collected as a side effect of allocating the result array.
+ If no memory is available answer 0."
+ | count obj resultArray newCount |
+ "Count the currently accessible objects"
+ count := 0.
+ self allObjectsDo:
+ [count := count + 1].
+ "Allocate result array, may cause GC"
+ resultArray := self instantiateClass: self classArray indexableSize: count.
+ resultArray = nil ifTrue:
+ [^0].
+ "Store all objects in result array, excluding any reference to the result array itself,
+ as may happen if garbage collection occurred during allocation of the array. No store
+ check is necessary; the result array will be the last object in memory and hence new."
+ newCount := 0.
+ obj := self firstObject.
+ [obj < resultArray] whileTrue:
+ [(self isFreeObject: obj) ifFalse:
+ [newCount := newCount + 1.
+ self storePointerUnchecked: newCount ofObject: resultArray withValue: obj].
+ obj := self objectAfter: obj].
+ "If GC occurred during result array allocation, truncate unused portion of result array"
+ newCount < count ifTrue:
+ [self shorten: resultArray toIndexableSize: newCount].
+ ^resultArray!
Item was changed:
----- Method: Spur32BitMMLECoSimulator>>firstIndexableField: (in category 'object format') -----
firstIndexableField: objOop
"NOTE: overridden from SpurMemoryManager to add coercion to CArray, so please duplicate any changes.
There are only two important cases, both for objects with named inst vars, i.e. formats 2,3 & 5.
The first indexable field for formats 2 & 5 is the slot count (by convention, even though that's off the end
of the object). For 3 we must go to the class."
| fmt classFormat |
<returnTypeC: #'void *'>
fmt := self formatOf: objOop.
fmt <= self lastPointerFormat ifTrue: "pointer; may need to delve into the class format word"
[(fmt between: self indexablePointersFormat and: self weakArrayFormat) ifTrue:
[classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop).
^self cCoerce: (self pointerForOop: objOop
+ self baseHeaderSize
+ + ((self fixedFieldsOfClassFormat: classFormat) << self shiftForWord))
- + ((self fixedFieldsOfClassFormat: classFormat) << self wordSize))
to: #'oop *'].
^self cCoerce: (self pointerForOop: objOop
+ self baseHeaderSize
+ + ((self numSlotsOf: objOop) << self shiftForWord))
- + ((self numSlotsOf: objOop) << self wordSize))
to: #'oop *'].
"All bit objects, and indeed CompiledMethod, though this is a non-no, start at 0"
self assert: (fmt >= self sixtyFourBitIndexableFormat and: [fmt < self firstCompiledMethodFormat]).
^self
cCoerce: (self pointerForOop: objOop + self baseHeaderSize)
to: (fmt < self firstByteFormat
ifTrue:
[fmt = self sixtyFourBitIndexableFormat
ifTrue: ["64 bit field objects" #'long long *']
ifFalse:
[fmt < self firstShortFormat
ifTrue: ["32 bit field objects" #'int *']
ifFalse: ["16-bit field objects" #'short *']]]
ifFalse: ["byte objects (including CompiledMethod" #'char *'])!
Item was changed:
----- Method: Spur32BitMMLESimulator>>firstIndexableField: (in category 'object format') -----
firstIndexableField: objOop
"NOTE: overridden from SpurMemoryManager to add coercion to CArray, so please duplicate any changes.
There are only two important cases, both for objects with named inst vars, i.e. formats 2,3 & 5.
The first indexable field for formats 2 & 5 is the slot count (by convention, even though that's off the end
of the object). For 3 we must go to the class."
| fmt classFormat |
<returnTypeC: #'void *'>
fmt := self formatOf: objOop.
fmt <= self lastPointerFormat ifTrue: "pointer; may need to delve into the class format word"
[(fmt between: self indexablePointersFormat and: self weakArrayFormat) ifTrue:
[classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop).
^self cCoerce: (self pointerForOop: objOop
+ self baseHeaderSize
+ + ((self fixedFieldsOfClassFormat: classFormat) << self shiftForWord))
- + ((self fixedFieldsOfClassFormat: classFormat) << self wordSize))
to: #'oop *'].
^self cCoerce: (self pointerForOop: objOop
+ self baseHeaderSize
+ + ((self numSlotsOf: objOop) << self shiftForWord))
- + ((self numSlotsOf: objOop) << self wordSize))
to: #'oop *'].
"All bit objects, and indeed CompiledMethod, though this is a non-no, start at 0"
self assert: (fmt >= self sixtyFourBitIndexableFormat and: [fmt < self firstCompiledMethodFormat]).
^self
cCoerce: (self pointerForOop: objOop + self baseHeaderSize)
to: (fmt < self firstByteFormat
ifTrue:
[fmt = self sixtyFourBitIndexableFormat
ifTrue: ["64 bit field objects" #'long long *']
ifFalse:
[fmt < self firstShortFormat
ifTrue: ["32 bit field objects" #'int *']
ifFalse: ["16-bit field objects" #'short *']]]
ifFalse: ["byte objects (including CompiledMethod" #'char *'])!
Item was removed:
- ----- Method: Spur32BitMemoryManager>>allocateNewSpaceSlots:format:classIndex: (in category 'allocation') -----
- allocateNewSpaceSlots: numSlots format: formatField classIndex: classIndex
- "Allocate an object with numSlots in newSpace. This is for the `ee' execution engine allocations,
- and must be satisfied. If no memory is available, abort. If the allocation pushes freeStart past
- scavengeThreshold and a scavenge is not already scheduled, schedule a scavenge."
- | numBytes newObj |
- "Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow),
- 16 bytes otherwise (num slots in preceeding word).
- Objects always have at least one slot, for the forwarding pointer,
- and are multiples of 8 bytes in length."
- numSlots >= self numSlotsMask
- ifTrue:
- [newObj := freeStart + self baseHeaderSize.
- numBytes := self baseHeaderSize + self baseHeaderSize "double header"
- + (numSlots + (numSlots bitAnd: 1) * self bytesPerSlot)] "roundTo allocationUnit"
- ifFalse:
- [newObj := freeStart.
- numBytes := self baseHeaderSize "single header"
- + (numSlots <= 1
- ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer"
- ifFalse: [numSlots + (numSlots bitAnd: 1) * self bytesPerSlot])]. "roundTo allocationUnit"
- freeStart + numBytes > scavengeThreshold ifTrue:
- [needGCFlag ifFalse: [self scheduleScavenge].
- freeStart + numBytes > scavenger eden limit ifTrue:
- [self error: 'no room in eden for allocateNewSpaceSlots:format:classIndex:'.
- ^0]].
- numSlots >= self numSlotsMask
- ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
- [self flag: #endianness.
- self longAt: freeStart put: numSlots.
- self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift.
- self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)]
- ifFalse:
- [self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)].
- self assert: numBytes \\ self allocationUnit = 0.
- self assert: newObj \\ self allocationUnit = 0.
- freeStart := freeStart + numBytes.
- ^newObj!
Item was removed:
- ----- Method: Spur32BitMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') -----
- allocateSlots: numSlots format: formatField classIndex: classIndex
- "Allocate an object with numSlots space. If there is room beneath scavengeThreshold
- allocate in newSpace, otherwise alocate in oldSpace. If there is not room in newSpace
- and a scavenge is not already scheduled, schedule a scavenge."
- <inline: true>
- | numBytes newObj |
- "Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow),
- 16 bytes otherwise (num slots in preceeding word).
- Objects always have at least one slot, for the forwarding pointer,
- and are multiples of 8 bytes in length."
- numSlots >= self numSlotsMask
- ifTrue:
- [newObj := freeStart + self baseHeaderSize.
- numBytes := self baseHeaderSize + self baseHeaderSize "double header"
- + (numSlots + (numSlots bitAnd: 1) * self bytesPerSlot)] "roundTo allocationUnit"
- ifFalse:
- [newObj := freeStart.
- numBytes := self baseHeaderSize "single header"
- + (numSlots <= 1
- ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer"
- ifFalse: [numSlots + (numSlots bitAnd: 1) * self bytesPerSlot])]. "roundTo allocationUnit"
- freeStart + numBytes > scavengeThreshold ifTrue:
- [needGCFlag ifFalse: [self scheduleScavenge].
- ^self allocateSlotsInOldSpace: numSlots bytes: numBytes format: formatField classIndex: classIndex].
- numSlots >= self numSlotsMask
- ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
- [self flag: #endianness.
- self longAt: freeStart put: numSlots.
- self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift.
- self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)]
- ifFalse:
- [self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)].
- self assert: numBytes \\ self allocationUnit = 0.
- self assert: newObj \\ self allocationUnit = 0.
- freeStart := freeStart + numBytes.
- ^newObj!
Item was changed:
----- Method: Spur32BitMemoryManager>>fillObj:numSlots:with: (in category 'instantiation') -----
fillObj: objOop numSlots: numSlots with: fillValue
<inline: true>
+ self assert: (self oop: objOop + self baseHeaderSize + (numSlots * self bytesPerSlot) - 1
- self assert: (self oop: objOop + self baseHeaderSize + (numSlots * self bytesPerOop) - 1
isLessThan: (self addressAfter: objOop)).
objOop + self baseHeaderSize
+ to: objOop + self baseHeaderSize + (numSlots * self bytesPerSlot) - 1
- to: objOop + self baseHeaderSize + (numSlots * self wordSize) - 1
by: self allocationUnit
do: [:p|
self longAt: p put: fillValue;
longAt: p + 4 put: fillValue]!
Item was changed:
----- Method: Spur32BitMemoryManager>>initFreeChunkWithBytes:at: (in category 'free space') -----
initFreeChunkWithBytes: numBytes at: address
<var: #numBytes type: #usqLong>
| numSlots |
"must have room for a header (single or double) plus the next free pointer"
self assert: (numBytes \\ self allocationUnit = 0
+ and: [numBytes >= (self baseHeaderSize + self bytesPerSlot)]).
- and: [numBytes >= (self baseHeaderSize + self wordSize)]).
self flag: #endianness.
"double header"
numBytes >= ((self numSlotsMask << self shiftForWord) + self baseHeaderSize) ifTrue:
[numSlots := numBytes - self baseHeaderSize - self baseHeaderSize >> self shiftForWord.
self longAt: address put: numSlots;
longAt: address + 4 put: self numSlotsMask << self numSlotsHalfShift;
longAt: address + 8 put: 0; "0's classIndex; 0 = classIndex of free chunks"
longAt: address + 12 put: self numSlotsMask << self numSlotsHalfShift.
^address + 8].
"single header"
numSlots := numBytes - self baseHeaderSize >> self shiftForWord.
self assert: numSlots < self numSlotsMask.
self longAt: address put: 0; "0's classIndex; 0 = classIndex of free chunks"
longAt: address + 4 put: numSlots << self numSlotsHalfShift.
^address!
Item was added:
+ ----- Method: Spur32BitMemoryManager>>largeObjectBytesForSlots: (in category 'allocation') -----
+ largeObjectBytesForSlots: numSlots
+ "Answer the total number of bytes in an object with an overflow header, including header bytes."
+ ^self baseHeaderSize + self baseHeaderSize "double header"
+ + (numSlots + (numSlots bitAnd: 1) * self bytesPerSlot) "roundTo allocationUnit"!
Item was added:
+ ----- Method: Spur32BitMemoryManager>>smallObjectBytesForSlots: (in category 'allocation') -----
+ smallObjectBytesForSlots: numSlots
+ "Answer the total number of bytes in an object without an overflow header, including header bytes."
+ ^self baseHeaderSize "single header"
+ + (numSlots <= 1
+ ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer"
+ ifFalse: [numSlots + (numSlots bitAnd: 1) * self bytesPerSlot]) "round up to allocationUnit"!
Item was removed:
- ----- Method: Spur64BitMemoryManager>>allocateNewSpaceSlots:format:classIndex: (in category 'allocation') -----
- allocateNewSpaceSlots: numSlots format: formatField classIndex: classIndex
- "Allocate an object with numSlots in newSpace. This is for the `ee' execution engine allocations,
- and must be satisfied. If no memory is available, abort. If the allocation pushes freeStart past
- scavengeThreshold and a scavenge is not already scheduled, schedule a scavenge."
- | numBytes newObj |
- "Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow),
- 16 bytes otherwise (num slots in preceeding word).
- Objects always have at least one slot, for the forwarding pointer,
- and are multiples of 8 bytes in length."
- numSlots >= self numSlotsMask
- ifTrue:
- [numSlots > 16rffffffff ifTrue:
- [^nil].
- newObj := freeStart + self baseHeaderSize.
- numBytes := (self baseHeaderSize + self baseHeaderSize) "double header"
- + (numSlots * self bytesPerSlot)]
- ifFalse:
- [newObj := freeStart.
- numBytes := self baseHeaderSize "single header"
- + (numSlots < 1
- ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer"
- ifFalse: [numSlots * self bytesPerSlot])].
-
- freeStart + numBytes > scavengeThreshold ifTrue:
- [needGCFlag ifFalse: [self scheduleScavenge].
- freeStart + numBytes > scavenger eden limit ifTrue:
- [self error: 'no room in eden for allocateNewSpaceSlots:format:classIndex:'.
- ^0]].
- numSlots >= self numSlotsMask
- ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
- [self flag: #endianness.
- self longAt: freeStart put: numSlots.
- self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift.
- self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)]
- ifFalse:
- [self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)].
- self assert: numBytes \\ self allocationUnit = 0.
- self assert: newObj \\ self allocationUnit = 0.
- freeStart := freeStart + numBytes.
- ^newObj!
Item was removed:
- ----- Method: Spur64BitMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') -----
- allocateSlots: numSlots format: formatField classIndex: classIndex
- "Allocate an object with numSlots space. If there is room beneath scavengeThreshold
- allocate in newSpace, otherwise alocate in oldSpace. If there is not room in newSpace
- and a scavenge is not already scheduled, schedule a scavenge."
- <inline: true>
- | numBytes newObj |
- "Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow),
- 16 bytes otherwise (num slots in preceeding word).
- Objects always have at least one slot, for the forwarding pointer,
- and are multiples of 8 bytes in length."
- numSlots >= self numSlotsMask
- ifTrue:
- [numSlots > 16rffffffff ifTrue:
- [^nil].
- newObj := freeStart + self baseHeaderSize.
- numBytes := (self baseHeaderSize + self baseHeaderSize) "double header"
- + (numSlots * self bytesPerSlot)]
- ifFalse:
- [newObj := freeStart.
- numBytes := self baseHeaderSize "single header"
- + (numSlots < 1
- ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer"
- ifFalse: [numSlots * self bytesPerSlot])].
-
- freeStart + numBytes > scavengeThreshold ifTrue:
- [needGCFlag ifFalse: [self scheduleScavenge].
- ^self allocateSlotsInOldSpace: numSlots bytes: numBytes format: formatField classIndex: classIndex].
- numSlots >= self numSlotsMask
- ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
- [self flag: #endianness.
- self longAt: freeStart put: numSlots.
- self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift.
- self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)]
- ifFalse:
- [self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)].
- self assert: numBytes \\ self allocationUnit = 0.
- self assert: newObj \\ self allocationUnit = 0.
- freeStart := freeStart + numBytes.
- ^newObj!
Item was changed:
----- Method: Spur64BitMemoryManager>>allocateSlotsInOldSpace:bytes:format:classIndex: (in category 'allocation') -----
allocateSlotsInOldSpace: numSlots bytes: totalBytes format: formatField classIndex: classIndex
"Answer the oop of a chunk of space in oldSpace with numSlots slots. The header
will have been filled-in but not the contents."
<inline: false>
| chunk |
chunk := self allocateOldSpaceChunkOfBytes: totalBytes.
+ self checkFreeSpace.
chunk ifNil:
[^nil].
numSlots >= self numSlotsMask ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
[self longAt: chunk
put: numSlots + (self numSlotsMask << self numSlotsFullShift).
self longAt: chunk + self baseHeaderSize
put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex).
self assert: (lastSubdividedFreeChunk = 0 or: [(self addressAfter: chunk + self baseHeaderSize) = lastSubdividedFreeChunk]).
^chunk + self baseHeaderSize].
self longAt: chunk
put: (self headerForSlots: numSlots format: formatField classIndex: classIndex).
self assert: (lastSubdividedFreeChunk = 0 or: [(self addressAfter: chunk) = lastSubdividedFreeChunk]).
^chunk!
Item was changed:
----- Method: Spur64BitMemoryManager>>fillObj:numSlots:with: (in category 'instantiation') -----
fillObj: objOop numSlots: numSlots with: fillValue
<inline: true>
+ self assert: (self oop: objOop + self baseHeaderSize + (numSlots * self bytesPerSlot) - 1
- self assert: (self oop: objOop + self baseHeaderSize + (numSlots * self bytesPerOop) - 1
isLessThan: (self addressAfter: objOop)).
objOop + self baseHeaderSize
+ to: objOop + self baseHeaderSize + (numSlots * self bytesPerSlot) - 1
- to: objOop + self baseHeaderSize + (numSlots * self bytesPerOop) - 1
by: self allocationUnit
do: [:p| self longAt: p put: fillValue]!
Item was changed:
----- Method: Spur64BitMemoryManager>>initFreeChunkWithBytes:at: (in category 'free space') -----
initFreeChunkWithBytes: numBytes at: address
<var: #numBytes type: #usqLong>
| numSlots |
"must have room for a header (single or double) plus the next free pointer"
self assert: (numBytes \\ self allocationUnit = 0
+ and: [numBytes >= (self baseHeaderSize + self bytesPerSlot)]).
- and: [numBytes >= (self baseHeaderSize + self wordSize)]).
"double header"
numBytes >= ((self numSlotsMask << self shiftForWord) + self baseHeaderSize) ifTrue:
[numSlots := numBytes - self baseHeaderSize - self baseHeaderSize >> self shiftForWord.
self longAt: address put: self numSlotsMask << self numSlotsFullShift + numSlots;
longAt: address + 8 put: self numSlotsMask << self numSlotsFullShift. "0's classIndex; 0 = classIndex of free chunks"
^address + 8].
"single header"
numSlots := numBytes - self baseHeaderSize >> self shiftForWord.
self assert: numSlots < self numSlotsMask.
self longAt: address put: numSlots << self numSlotsFullShift. "0's classIndex; 0 = classIndex of free chunks"
^address!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>largeObjectBytesForSlots: (in category 'allocation') -----
+ largeObjectBytesForSlots: numSlots
+ "Answer the total number of bytes in an object with an overflow header, including header bytes."
+ ^self baseHeaderSize + self baseHeaderSize "double header"
+ + (numSlots * self bytesPerSlot) "no rounding; bytesPerSlot = allocationUnit"!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>smallObjectBytesForSlots: (in category 'allocation') -----
+ smallObjectBytesForSlots: numSlots
+ "Answer the total number of bytes in an object without an overflow header, including header bytes."
+ ^self baseHeaderSize "single header"
+ + (numSlots < 1
+ ifTrue: [self allocationUnit] "at least one slot for the forwarding pointer"
+ ifFalse: [numSlots * self bytesPerSlot])!
Item was changed:
----- Method: SpurMemoryManager>>addFreeSubTree: (in category 'free space') -----
addFreeSubTree: freeTree
"Add a freeChunk sub tree back into the large free chunk tree.
This is for allocateOldSpaceChunkOf[Exactly]Bytes:[suchThat:]."
| bytesInArg treeNode bytesInNode subNode |
"N.B. *can't* use numSlotsOfAny: because of rounding up of odd slots
and/or step in size at 1032 bytes in 32-bits or 2048 bytes in 64-bits."
self assert: (self isFreeObject: freeTree).
bytesInArg := self bytesInObject: freeTree.
+ self assert: bytesInArg / (self allocationUnit / self bytesPerSlot) >= self numFreeLists.
- self assert: bytesInArg / (self allocationUnit / self wordSize) >= self numFreeLists.
treeNode := freeLists at: 0.
self assert: treeNode ~= 0.
[bytesInNode := self bytesInObject: treeNode.
self assert: bytesInArg ~= bytesInNode.
bytesInNode > bytesInArg
ifTrue:
[subNode := self fetchPointer: self freeChunkSmallerIndex ofFreeChunk: treeNode.
subNode = 0 ifTrue:
[self storePointer: self freeChunkSmallerIndex ofFreeChunk: treeNode withValue: freeTree.
self storePointer: self freeChunkParentIndex ofFreeChunk: freeTree withValue: treeNode.
^self]]
ifFalse:
[subNode := self fetchPointer: self freeChunkLargerIndex ofFreeChunk: treeNode.
subNode = 0 ifTrue:
[self storePointer: self freeChunkLargerIndex ofFreeChunk: treeNode withValue: freeTree.
self storePointer: self freeChunkParentIndex ofFreeChunk: freeTree withValue: treeNode.
^self]].
treeNode := subNode] repeat!
Item was changed:
----- Method: SpurMemoryManager>>allHeapEntitiesDo: (in category 'object enumeration') -----
allHeapEntitiesDo: aBlock
+ "N.B. e.g. allObjects relies on the old/new order here."
<inline: true>
+ self allOldSpaceEntitiesDo: aBlock.
+ self allNewSpaceEntitiesDo: aBlock!
- self allNewSpaceEntitiesDo: aBlock.
- self allOldSpaceEntitiesDo: aBlock!
Item was added:
+ ----- Method: SpurMemoryManager>>allObjects (in category 'primitive support') -----
+ allObjects
+ "Attempt to answer an array of all objects, excluding those that may
+ be garbage collected as a side effect of allocating the result array.
+ If no memory is available answer 0."
+ | freeChunk ptr start limit count bytes |
+ self markObjects. "don't want to revive objects unnecessarily."
+ freeChunk := self allocateLargestFreeChunk.
+ ptr := start := freeChunk + self baseHeaderSize.
+ limit := self addressAfter: freeChunk.
+ count := 0.
+ self allHeapEntitiesDo:
+ [:obj| "continue enumerating even if no room so as to unmark all objects."
+ (self isMarked: obj) ifTrue:
+ [(self isNormalObject: obj)
+ ifTrue:
+ [self setIsMarkedOf: obj to: false.
+ count := count + 1.
+ ptr < limit ifTrue:
+ [self longAt: ptr put: obj.
+ ptr := ptr + self bytesPerSlot]]
+ ifFalse:
+ [(self isSegmentBridge: obj) ifFalse:
+ [self setIsMarkedOf: obj to: false]]]].
+ self assert: self allObjectsUnmarked.
+ self assert: count >= self numSlotsMask.
+ (count > (ptr - start / self bytesPerSlot) "not enough room"
+ or: [limit ~= ptr and: [limit - ptr <= self allocationUnit]]) ifTrue: "can't split a single word"
+ [self freeObject: freeChunk.
+ ^0].
+ bytes := self largeObjectBytesForSlots: count.
+ start := self startOfObject: freeChunk.
+ self freeChunkWithBytes: limit - start - bytes at: start + bytes.
+ self setOverflowNumSlotsOf: freeChunk to: count.
+ self setClassIndexOf: freeChunk to: ClassArrayCompactIndex.
+ self setFormatOf: freeChunk to: self arrayFormat.
+ self possibleRootStoreInto: freeChunk.
+ ^freeChunk
+
+ !
Item was changed:
----- Method: SpurMemoryManager>>allUnscannedEphemeronsAreActive (in category 'weakness and ephemerality') -----
allUnscannedEphemeronsAreActive
+ unscannedEphemerons start to: unscannedEphemerons top - self bytesPerSlot do:
- unscannedEphemerons start to: unscannedEphemerons top - self wordSize do:
[:p| | key |
key := self keyOfEphemeron: (self longAt: p).
((self isImmediate: key) or: [self isMarked: key]) ifTrue:
[^false]].
^true!
Item was changed:
----- Method: SpurMemoryManager>>allocateBytes:classIndex: (in category 'allocation') -----
allocateBytes: numBytes classIndex: classIndex
"Allocate an object of numBytes. Answer nil if no available memory.
classIndex must be that of a byte class (e.g. ByteString).
The object is *NOT FILLED*."
self assert: (coInterpreter addressCouldBeClassObj: (self classAtIndex: classIndex)).
self assert: (self instSpecOfClass: (self classAtIndex: classIndex)) = self firstByteFormat.
^self
+ allocateSlots: (numBytes + self bytesPerSlot - 1 // self bytesPerSlot)
+ format: self firstByteFormat + (self bytesPerSlot - numBytes bitAnd: self bytesPerSlot - 1)
- allocateSlots: (numBytes + self wordSize - 1 // self wordSize)
- format: self firstByteFormat + (self wordSize - numBytes bitAnd: self wordSize - 1)
classIndex: classIndex!
Item was added:
+ ----- Method: SpurMemoryManager>>allocateLargestFreeChunk (in category 'free space') -----
+ allocateLargestFreeChunk
+ "Answer the largest free chunk in the free lists."
+ ^self findLargestFreeChunk ifNotNil:
+ [:freeChunk| | next |
+ "This will be the node, not a list element. Answer a list element in preference."
+ next := self fetchPointer: self freeChunkNextIndex ofFreeChunk: freeChunk.
+ next ~= 0 ifTrue:
+ [self storePointer: self freeChunkNextIndex
+ ofFreeChunk: freeChunk
+ withValue: (self fetchPointer: self freeChunkNextIndex ofFreeChunk: next).
+ ^next].
+ self unlinkSolitaryFreeTreeNode: freeChunk.
+ freeChunk]!
Item was changed:
----- Method: SpurMemoryManager>>allocateNewSpaceSlots:format:classIndex: (in category 'allocation') -----
allocateNewSpaceSlots: numSlots format: formatField classIndex: classIndex
"Allocate an object with numSlots in newSpace. This is for the `ee' execution engine allocations,
and must be satisfied. If no memory is available, abort. If the allocation pushes freeStart past
scavengeThreshold and a scavenge is not already scheduled, schedule a scavenge."
+ | numBytes newObj |
+ "Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow),
+ 16 bytes otherwise (num slots in preceeding word).
+ Objects always have at least one slot, for the forwarding pointer,
+ and are multiples of 8 bytes in length."
+ numSlots >= self numSlotsMask
+ ifTrue:
+ [(self wordSize >= 8 and: [numSlots > 16rffffffff]) ifTrue:
+ [^nil]. "overflow size must fit in 32-bits"
+ newObj := freeStart + self baseHeaderSize.
+ numBytes := self largeObjectBytesForSlots: numSlots]
+ ifFalse:
+ [newObj := freeStart.
+ numBytes := self smallObjectBytesForSlots: numSlots].
+
+ freeStart + numBytes > scavengeThreshold ifTrue:
+ [needGCFlag ifFalse: [self scheduleScavenge].
+ freeStart + numBytes > scavenger eden limit ifTrue:
+ [self error: 'no room in eden for allocateNewSpaceSlots:format:classIndex:'.
+ ^0]].
+ numSlots >= self numSlotsMask
+ ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
+ [self flag: #endianness.
+ self longAt: freeStart put: numSlots.
+ self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift.
+ self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)]
+ ifFalse:
+ [self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)].
+ self assert: numBytes \\ self allocationUnit = 0.
+ self assert: newObj \\ self allocationUnit = 0.
+ freeStart := freeStart + numBytes.
+ ^newObj!
- self subclassResponsibility!
Item was changed:
----- Method: SpurMemoryManager>>allocateSlots:format:classIndex: (in category 'allocation') -----
allocateSlots: numSlots format: formatField classIndex: classIndex
"Allocate an object with numSlots space. If there is room beneath scavengeThreshold
allocate in newSpace, otherwise alocate in oldSpace. If there is not room in newSpace
and a scavenge is not already scheduled, schedule a scavenge."
+ <inline: true>
+ | numBytes newObj |
+ "Object headers are 8 bytes in length if the slot size fits in the num slots field (max implies overflow),
+ 16 bytes otherwise (num slots in preceeding word).
+ Objects always have at least one slot, for the forwarding pointer,
+ and are multiples of 8 bytes in length."
+ numSlots >= self numSlotsMask
+ ifTrue:
+ [(self wordSize >= 8 and: [numSlots > 16rffffffff]) ifTrue:
+ [^nil]. "overflow size must fit in 32-bits"
+ newObj := freeStart + self baseHeaderSize.
+ numBytes := self largeObjectBytesForSlots: numSlots]
+ ifFalse:
+ [newObj := freeStart.
+ numBytes := self smallObjectBytesForSlots: numSlots].
+
+ freeStart + numBytes > scavengeThreshold ifTrue:
+ [needGCFlag ifFalse: [self scheduleScavenge].
+ ^self allocateSlotsInOldSpace: numSlots bytes: numBytes format: formatField classIndex: classIndex].
+ numSlots >= self numSlotsMask
+ ifTrue: "for header parsing we put a saturated slot count in the prepended overflow size word"
+ [self flag: #endianness.
+ self longAt: freeStart put: numSlots.
+ self longAt: freeStart + 4 put: self numSlotsMask << self numSlotsHalfShift.
+ self longLongAt: newObj put: (self headerForSlots: self numSlotsMask format: formatField classIndex: classIndex)]
+ ifFalse:
+ [self longLongAt: newObj put: (self headerForSlots: numSlots format: formatField classIndex: classIndex)].
+ self assert: numBytes \\ self allocationUnit = 0.
+ self assert: newObj \\ self allocationUnit = 0.
+ freeStart := freeStart + numBytes.
+ ^newObj!
- self subclassResponsibility!
Item was changed:
----- Method: SpurMemoryManager>>firstIndexableField: (in category 'object format') -----
firstIndexableField: objOop
"NOTE: overridden in various simulator subclasses to add coercion to CArray, so please duplicate any changes.
There are only two important cases, both for objects with named inst vars, i.e. formats 2,3 & 5.
The first indexable field for formats 2 & 5 is the slot count (by convention, even though that's off the end
of the object). For 3 we must go to the class."
| fmt classFormat |
<returnTypeC: #'void *'>
fmt := self formatOf: objOop.
fmt <= self weakArrayFormat ifTrue:
[fmt = self arrayFormat ifTrue: "array starts at 0."
[^self pointerForOop: objOop + self baseHeaderSize].
fmt >= self indexablePointersFormat ifTrue: "indexable with inst vars; need to delve into the class format word"
[classFormat := self formatOfClass: (self fetchClassOfNonImm: objOop).
^self pointerForOop: objOop
+ self baseHeaderSize
+ + ((self fixedFieldsOfClassFormat: classFormat) << self shiftForWord)].
- + ((self fixedFieldsOfClassFormat: classFormat) << self wordSize)].
"otherwise not indexable"
^0].
"All bit objects, and indeed CompiledMethod, though this is a non-no, start at 0"
(fmt >= self sixtyFourBitIndexableFormat
and: [fmt < self firstCompiledMethodFormat]) ifTrue:
[^self pointerForOop: objOop + self baseHeaderSize].
"otherwise not indexable"
^0!
Item was changed:
----- Method: SpurMemoryManager>>initializeUnscannedEphemerons (in category 'gc - global') -----
initializeUnscannedEphemerons
"Initialize unscannedEphemerons to use the largest free chunk
or unused eden space, which ever is the larger."
| largestFree sizeOfUnusedEden |
largestFree := self findLargestFreeChunk.
sizeOfUnusedEden := scavenger eden limit - freeStart.
(largestFree notNil
and: [(self numSlotsOfAny: largestFree) > (sizeOfUnusedEden / self wordSize)])
ifTrue:
[unscannedEphemerons
+ start: largestFree
+ + self baseHeaderSize
+ + (self freeChunkLargerIndex + 1 * self wordSize);
- start: largestFree + self baseHeaderSize;
limit: (self addressAfter: largestFree)]
ifFalse:
[unscannedEphemerons
start: freeStart;
limit: scavenger eden limit].
unscannedEphemerons top: unscannedEphemerons start!
Item was added:
+ ----- Method: SpurMemoryManager>>largeObjectBytesForSlots: (in category 'allocation') -----
+ largeObjectBytesForSlots: numSlots
+ "Answer the total number of bytes in an object with an overflow header, including header bytes."
+ ^self subclassResponsibility!
Item was changed:
+ ----- Method: SpurMemoryManager>>objectBytesForSlots: (in category 'allocation') -----
- ----- Method: SpurMemoryManager>>objectBytesForSlots: (in category 'object enumeration') -----
objectBytesForSlots: numSlots
"Answer the total number of bytes in an object with the given
number of slots, including header and possible overflow size header."
self subclassResponsibility!
Item was added:
+ ----- Method: SpurMemoryManager>>roundBytesToAllocationUnit: (in category 'allocation') -----
+ roundBytesToAllocationUnit: bytes
+ ^bytes + (self allocationUnit - 1) bitClear: self allocationUnit - 1!
Item was added:
+ ----- Method: SpurMemoryManager>>setOverflowNumSlotsOf:to: (in category 'free space') -----
+ setOverflowNumSlotsOf: objOop to: numSlots
+ self flag: #endian.
+ self long32At: objOop - self baseHeaderSize put: numSlots!
Item was added:
+ ----- Method: SpurMemoryManager>>smallObjectBytesForSlots: (in category 'allocation') -----
+ smallObjectBytesForSlots: numSlots
+ "Answer the total number of bytes in an object without an overflow header, including header bytes."
+ ^self subclassResponsibility!
Item was changed:
----- Method: StackInterpreter>>tryLoadNewPlugin:pluginEntries: (in category 'primitive support') -----
tryLoadNewPlugin: pluginString pluginEntries: pluginEntries
"Load the plugin and if on Spur, populate pluginEntries with the prmitives in the plugin."
<doNotGenerate>
| plugin plugins simulatorClasses |
self transcript cr; show: 'Looking for module ', pluginString.
"Defeat loading of the FloatArrayPlugin & Matrix2x3Plugin since complications with 32-bit
float support prevent simulation. If you feel up to tackling this start by implementing
cCoerce: value to: cType
^cType = 'float'
ifTrue: [value asIEEE32BitWord]
ifFalse: [value]
in FloatArrayPlugin & Matrix2x3Plugin and then address the issues in the BalloonEnginePlugin.
See http://forum.world.st/Simulating-the-BalloonEnginePlugin-FloatArrayPlugin-amp-Matrix2x3Plugin-primitives-td4734673.html"
(#('FloatArrayPlugin' 'Matrix2x3Plugin') includes: pluginString) ifTrue:
[self transcript show: ' ... defeated'. ^nil].
pluginString isEmpty
ifTrue:
[plugin := self]
ifFalse:
[plugins := InterpreterPlugin allSubclasses select: [:psc| psc moduleName asString = pluginString asString].
simulatorClasses := (plugins
select: [:psc| psc simulatorClass notNil]
thenCollect: [:psc| psc simulatorClass]) asSet.
simulatorClasses isEmpty ifTrue: [self transcript show: ' ... not found'. ^nil].
simulatorClasses size > 1 ifTrue: [^self error: 'This won''t work...'].
plugins size > 1 ifTrue:
[self transcript show: '...multiple plugin classes; choosing ', plugins last name].
plugin := simulatorClasses anyOne newFor: plugins last. "hopefully lowest in the hierarchy..."
plugin setInterpreter: objectMemory. "Ignore return value from setInterpreter"
(plugin respondsTo: #initialiseModule) ifTrue:
[plugin initialiseModule ifFalse:
[self transcript show: ' ... initialiser failed'. ^nil]]]. "module initialiser failed"
self transcript show: ' ... loaded'.
objectMemory hasSpurMemoryManagerAPI ifTrue:
[| realPlugin cg |
self transcript show: '...computing accessor depths'.
+ plugin class isPluginClass
+ ifTrue:
+ [realPlugin := plugin class withAllSuperclasses detect: [:class| class shouldBeTranslated].
+ cg := realPlugin buildCodeGeneratorUpTo: realPlugin]
+ ifFalse:
+ [cg := VMMaker new
+ buildCodeGeneratorForInterpreter: StackInterpreter
+ includeAPIMethods: false
+ initializeClasses: false].
- realPlugin := plugin class withAllSuperclasses detect: [:class| class shouldBeTranslated].
- cg := realPlugin buildCodeGeneratorUpTo: realPlugin.
cg exportedPrimitiveNames do:
[:primName| | fnSymbol |
fnSymbol := primName asSymbol.
pluginEntries addLast: {plugin.
fnSymbol.
[plugin perform: fnSymbol. self].
cg accessorDepthForSelector: fnSymbol}].
self transcript show: '...done'].
^pluginString asString -> plugin!
Item was changed:
----- Method: StackInterpreterSimulator>>initialize (in category 'initialization') -----
initialize
"Initialize the StackInterpreterSimulator when running the interpreter
inside Smalltalk. The primary responsibility of this method is to allocate
Smalltalk Arrays for variables that will be declared as statically-allocated
global arrays in the translated code."
bootstrapping := false.
objectMemory ifNil:
[objectMemory := self class 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.
gcSemaphoreIndex := 0.
externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
externalPrimitiveTableFirstFreeIndex := 0.
primitiveTable := self class primitiveTable copy.
+ objectMemory hasSpurMemoryManagerAPI
+ ifTrue:
+ [primitiveAccessorDepthTable := self class primitiveAccessorDepthTable.
+ pluginList := {}]
+ ifFalse:
+ [pluginList := {'' -> self }].
- primitiveAccessorDepthTable := objectMemory hasSpurMemoryManagerAPI ifTrue:
- [self class primitiveAccessorDepthTable].
- pluginList := {'' -> self }.
mappedPluginEntries := OrderedCollection new.
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 := 'Display has not yet been installed' asDisplayText form.
suppressHeartbeatFlag := false.
systemAttributes := Dictionary new.
extSemTabSize := 256.
disableBooleanCheat := false!
Item was changed:
----- Method: VMMaker>>buildCodeGeneratorForCogit (in category 'generate sources') -----
buildCodeGeneratorForCogit
"Answer the code generator for translating the cogit."
+ ^self
+ buildCodeGeneratorForCogit: self cogitClass
+ includeAPIMethods: true
+ initializeClasses: true!
- ^self buildCodeGeneratorForCogit: true!
Item was removed:
- ----- Method: VMMaker>>buildCodeGeneratorForCogit: (in category 'generate sources') -----
- buildCodeGeneratorForCogit: getAPIMethods
- "Answer the code generator for translating the cogit."
-
- | cg cogitClass cogitClasses apicg |
- cg := self createCogitCodeGenerator.
-
- cg vmClass: (cogitClass := self cogitClass).
- { cogitClass. self interpreterClass. self interpreterClass objectMemoryClass } do:
- [:cgc|
- (cgc respondsTo: #initializeWithOptions:)
- ifTrue: [cgc initializeWithOptions: optionsDictionary]
- ifFalse: [cgc initialize]].
-
- cogitClasses := OrderedCollection new.
- [cogitClasses addFirst: cogitClass.
- cogitClass ~~ Cogit
- and: [cogitClass inheritsFrom: Cogit]] whileTrue:
- [cogitClass := cogitClass superclass].
- cogitClasses addFirst: VMClass.
- cogitClasses addAllLast: ((self cogitClass ancilliaryClasses: optionsDictionary) reject: [:class| class isStructClass]).
- cogitClasses do: [:cgc| cg addClass: cgc].
- cg addStructClasses: (cg structClassesForTranslationClasses: cogitClasses).
-
- getAPIMethods ifTrue:
- [apicg := self buildCodeGeneratorForInterpreter: false.
- cg apiMethods: apicg selectAPIMethods].
-
- ^cg!
Item was added:
+ ----- Method: VMMaker>>buildCodeGeneratorForCogit:includeAPIMethods:initializeClasses: (in category 'generate sources') -----
+ buildCodeGeneratorForCogit: cogitClass includeAPIMethods: getAPIMethods initializeClasses: initializeClasses
+ "Answer the code generator for translating the cogit."
+
+ | cg aClass cogitClasses apicg |
+ cg := self createCogitCodeGenerator.
+
+ cg vmClass: cogitClass.
+ initializeClasses ifTrue:
+ [{ cogitClass. self interpreterClass. self interpreterClass objectMemoryClass } do:
+ [:cgc|
+ (cgc respondsTo: #initializeWithOptions:)
+ ifTrue: [cgc initializeWithOptions: optionsDictionary]
+ ifFalse: [cgc initialize]]].
+
+ cogitClasses := OrderedCollection new.
+ aClass := cogitClass.
+ [cogitClasses addFirst: aClass.
+ aClass ~~ Cogit
+ and: [aClass inheritsFrom: Cogit]] whileTrue:
+ [aClass := cogitClass superclass].
+ cogitClasses addFirst: VMClass.
+ cogitClasses addAllLast: ((cogitClass ancilliaryClasses: optionsDictionary) reject: [:class| class isStructClass]).
+ cogitClasses do: [:cgc| cg addClass: cgc].
+ cg addStructClasses: (cg structClassesForTranslationClasses: cogitClasses).
+
+ getAPIMethods ifTrue:
+ [apicg := self
+ buildCodeGeneratorForInterpreter: self interpreterClass
+ includeAPIMethods: false
+ initializeClasses: false.
+ cg apiMethods: apicg selectAPIMethods].
+
+ ^cg!
Item was changed:
----- Method: VMMaker>>buildCodeGeneratorForInterpreter (in category 'generate sources') -----
buildCodeGeneratorForInterpreter
"Answer the code generator for translating the interpreter."
+ ^self
+ buildCodeGeneratorForInterpreter: self interpreterClass
+ includeAPIMethods: true
+ initializeClasses: true!
- ^self buildCodeGeneratorForInterpreter: true!
Item was removed:
- ----- Method: VMMaker>>buildCodeGeneratorForInterpreter: (in category 'generate sources') -----
- buildCodeGeneratorForInterpreter: getAPIMethods
- "Answer the code generator for translating the interpreter."
-
- | cg interpreterClass interpreterClasses apicg |
- interpreterClasses := OrderedCollection new.
-
- interpreterClass := self interpreterClass.
- interpreterClass initializeWithOptions: optionsDictionary.
-
- (cg := self createCodeGenerator) vmClass: interpreterClass.
-
- [interpreterClass ~~ VMClass] whileTrue:
- [interpreterClasses addFirst: interpreterClass.
- interpreterClass := interpreterClass superclass].
-
- cg vmClass objectMemoryClass ifNotNil:
- [:objectMemoryClass|
- interpreterClass := objectMemoryClass.
- [interpreterClass ~~ VMClass] whileTrue:
- [interpreterClasses addFirst: interpreterClass.
- interpreterClass := interpreterClass superclass]].
-
- interpreterClasses addFirst: VMClass.
- interpreterClasses addAllLast: (cg nonStructClassesForTranslationClasses: interpreterClasses).
-
- interpreterClasses do:
- [:ic|
- (ic respondsTo: #initializeWithOptions:)
- ifTrue: [ic initializeWithOptions: optionsDictionary]
- ifFalse: [ic initialize]].
- (cg structClassesForTranslationClasses: interpreterClasses) do:
- [:structClass| structClass initialize].
-
- cg addStructClasses: (cg structClassesForTranslationClasses: interpreterClasses).
-
- interpreterClasses do: [:ic| cg addClass: ic].
-
- (getAPIMethods
- and: [self interpreterClass needsCogit]) ifTrue:
- [apicg := self buildCodeGeneratorForCogit: false.
- cg apiMethods: apicg selectAPIMethods].
-
- ^cg!
Item was added:
+ ----- Method: VMMaker>>buildCodeGeneratorForInterpreter:includeAPIMethods:initializeClasses: (in category 'generate sources') -----
+ buildCodeGeneratorForInterpreter: interpreterClass includeAPIMethods: getAPIMethods initializeClasses: initializeClasses
+ "Answer the code generator for translating the interpreter."
+
+ | cg theClass interpreterClasses apicg |
+ interpreterClasses := OrderedCollection new.
+
+ initializeClasses ifTrue:
+ [interpreterClass initializeWithOptions: optionsDictionary].
+
+ (cg := self createCodeGenerator) vmClass: interpreterClass.
+
+ theClass := interpreterClass.
+ [theClass ~~ VMClass] whileTrue:
+ [interpreterClasses addFirst: theClass.
+ theClass := theClass superclass].
+
+ cg vmClass objectMemoryClass ifNotNil:
+ [:objectMemoryClass|
+ theClass := objectMemoryClass.
+ [theClass ~~ VMClass] whileTrue:
+ [interpreterClasses addFirst: theClass.
+ theClass := theClass superclass]].
+
+ interpreterClasses addFirst: VMClass.
+ interpreterClasses addAllLast: (cg nonStructClassesForTranslationClasses: interpreterClasses).
+
+ initializeClasses ifTrue:
+ [interpreterClasses do:
+ [:ic|
+ (ic respondsTo: #initializeWithOptions:)
+ ifTrue: [ic initializeWithOptions: optionsDictionary]
+ ifFalse: [ic initialize]].
+ (cg structClassesForTranslationClasses: interpreterClasses) do:
+ [:structClass| structClass initialize]].
+
+ cg addStructClasses: (cg structClassesForTranslationClasses: interpreterClasses).
+
+ interpreterClasses do: [:ic| cg addClass: ic].
+
+ (getAPIMethods
+ and: [self interpreterClass needsCogit]) ifTrue:
+ [apicg := self
+ buildCodeGeneratorForCogit: self cogitClass
+ includeAPIMethods: false
+ initializeClasses: false.
+ cg apiMethods: apicg selectAPIMethods].
+
+ ^cg!
More information about the Vm-dev
mailing list