[Vm-dev] VM Maker: VMMaker.oscog-eem.456.mcz
commits at source.squeak.org
commits at source.squeak.org
Tue Oct 15 01:35:41 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.456.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.456
Author: eem
Time: 14 October 2013, 6:31:58.393 pm
UUID: ac6bc9a3-b3f4-4576-9164-4d60eebd8544
Ancestors: VMMaker.oscog-eem.455
Fix bad bug with generation. Make sure vm classes are initialized
*before* adding pools in VMMaker>>buildCodeGeneratorForInterpreter:.
If not, BaseHeaderSize can have the wrong definition from a previous
generation, e.g. 8 from a Spur generation.
Also move initializeObjectHeaderConstants earlier in
ObjectMemory/SpurMemoryManager>>initializeWithOptions:, and
add some asserts to initializeObjectMemory: to try and catch the
mis-translation if it reoccurs (I know, horse has already bolted...).
Eliminate a couple of bogus nextLongFrom:swap:'s from
readImageFromFile:HeapSize:StartingAt:.
Make primitiveClipboardText, primitiveInvokeObjectAsMethod &
signed32BitIntegerFor: use Spur instantiation when available.
Make primitiveFullGC do an incrementalGC only in classic ObjectMemory.
Implement Spur[NBit]MemoryManager>>changeClassOf:to:
Add more missing protocol to SpurMemoryManager.
Add support for truncateTo: if arg is an integer power-of-two.
Add struct type support for addressOf:.
Make addMethodFor:selector: cope with a missing VMMaker (for
experimenting with TMethods).
Merge with VMMaker-tpr.326.
More isPointersNonInt: => isPointersNonImm:.
Slang:
Do a nicer job with empty ifTrue:ifFalse:'s in MessageNode>>
asTranslatorNodeIn:.
Now prepareMethodIn: uses nodesWithParentsDo: can do a neater
job transforming caseOf:'s & dispatchOn:'s into switch statements.
i.e. nuke replacements dict and dead transformSwitchExpression: call.
=============== Diff against VMMaker.oscog-eem.455 ===============
Item was changed:
----- Method: BitBltSimulation>>copyBits:Fallback: (in category 'setup') -----
copyBits: op Fallback: flags
"Recover from the fast path specialised code saying Help-I-cant-cope"
|done |
<static: false>
<returnTypeC: 'void'>
<inline: false>
<var: #op type: 'operation_t *'>
<var: #flags type:'unsigned int'>
self cppIf: #'ENABLE_FAST_BLT'
ifTrue:[
"recover values from the operation struct used by the fast ARM code"
self cCode:'
combinationRule = op->combinationRule;
noSource = op->noSource;
sourceBits = (sqInt) op->src.bits;
sourcePitch = op->src.pitch;
sourceDepth = op->src.depth;
sourceMSB = op->src.msb;
sx = op->src.x;
sy = op->src.y;
destBits = (sqInt) op->dest.bits;
destPitch = op->dest.pitch;
destDepth = op->dest.depth;
destMSB = op->dest.msb;
dx = op->dest.x;
dy = op->dest.y;
bbW = op->width;
bbH = op->height;
cmFlags = op->cmFlags;
cmShiftTable = (void *) op->cmShiftTable;
cmMaskTable = (void *) op->cmMaskTable;
cmMask = op->cmMask;
cmLookupTable = (void *) op->cmLookupTable;
noHalftone = op->noHalftone;
halftoneHeight = op->halftoneHeight;
halftoneBase = (sqInt) op->halftoneBase;
if (combinationRule == 30 || combinationRule == 31) {
sourceAlpha = op->opt.sourceAlpha;
}
if (combinationRule == 41) {
componentAlphaModeColor = op->opt.componentAlpha.componentAlphaModeColor;
componentAlphaModeAlpha = op->opt.componentAlpha.componentAlphaModeAlpha;
gammaLookupTable = (void *) op->opt.componentAlpha.gammaLookupTable;
ungammaLookupTable = (void *) op->opt.componentAlpha.ungammaLookupTable;
}'.
destPPW := 32 / destDepth.
cmBitsPerColor := 0.
cmMask = 16r1FF ifTrue: [cmBitsPerColor := 3].
cmMask = 16rFFF ifTrue: [cmBitsPerColor := 4].
+ cmMask = 16r7FFF ifTrue: [cmBitsPerColor := 5].
- cmMask = 16r3FFF ifTrue: [cmBitsPerColor := 5].
"Try a shortcut for stuff that should be run as quickly as possible"
done := self tryCopyingBitsQuickly.
done ifTrue:[^nil].
bitCount := 0.
"Choose and perform the actual copy loop."
self performCopyLoop]
!
Item was changed:
----- Method: CCodeGenerator>>addMethodFor:selector: (in category 'utilities') -----
addMethodFor: aClass selector: selector
"Add the given method to the code base and answer its translation
or nil if it shouldn't be translated."
| method tmethod |
selector == #initialize ifTrue:
[^nil].
method := aClass compiledMethodAt: selector.
(method pragmaAt: #doNotGenerate) ifNotNil:
[^nil].
"process optional methods by interpreting the argument to the option: pragma as either
a Cogit class name or a class variable name or a variable name in VMBasicConstants."
(method pragmaAt: #option:) ifNotNil:
+ [:pragma| | key |
- [:pragma| | key vmMaker |
key := pragma argumentAt: 1.
+ VMClass getVMMaker ifNotNil:
+ [:vmMaker|
+ ((Cogit withAllSubclasses anySatisfy: [:c| c name = key])
+ and: [vmMaker cogitClassName ~= key]) ifTrue:
+ [^nil].
+ (vmMaker options at: key ifAbsent: []) ifNotNil:
+ [:option| option == false ifTrue: [^nil]]].
- vmMaker := VMClass getVMMaker.
- ((Cogit withAllSubclasses anySatisfy: [:c| c name = key])
- and: [vmMaker cogitClassName ~= key]) ifTrue:
- [^nil].
(aClass bindingOf: key) ifNotNil:
[:binding|
binding value == false ifTrue: [^nil]].
(VMBasicConstants bindingOf: key) ifNotNil:
[:binding|
+ binding value == false ifTrue: [^nil]]].
- binding value == false ifTrue: [^nil]].
- (vmMaker options at: key ifAbsent: []) ifNotNil:
- [:option| option == false ifTrue: [^nil]]].
tmethod := self addMethod: (self compileToTMethodSelector: selector in: aClass).
"If the method has a macro then add the macro. But keep the method
for analysis purposes (e.g. its variable accesses)."
(method pragmaAt: #cmacro:) ifNotNil:
[:pragma|
self addMacro: (pragma argumentAt: 1) for: selector.
tmethod inline: false].
(method propertyValueAt: #cmacro:) ifNotNil:
[:macro|
self addMacro: macro for: selector.
tmethod inline: false].
^tmethod!
Item was added:
+ ----- Method: CCodeGenerator>>generateTruncateTo:on:indent: (in category 'C translation') -----
+ generateTruncateTo: msgNode on: aStream indent: level
+ "Generate the C code for this message onto the given stream."
+
+ self assert: msgNode args first isConstant.
+ self assert: msgNode args first value isInteger.
+ self assert: msgNode args first value isPowerOfTwo.
+ aStream nextPut: $(.
+ self emitCExpression: msgNode receiver on: aStream.
+ aStream nextPutAll: ' & ~'; print: msgNode args first value - 1; nextPut: $)!
Item was changed:
----- Method: CCodeGenerator>>initializeCTranslationDictionary (in category 'C translation') -----
initializeCTranslationDictionary
"Initialize the dictionary mapping message names to actions for C code generation."
| pairs |
translationDict := Dictionary new: 200.
pairs := #(
#& #generateAnd:on:indent:
#| #generateOr:on:indent:
#and: #generateSequentialAnd:on:indent:
#or: #generateSequentialOr:on:indent:
#not #generateNot:on:indent:
#+ #generatePlus:on:indent:
#- #generateMinus:on:indent:
#negated #generateNegated:on:indent:
#* #generateTimes:on:indent:
#/ #generateDivide:on:indent:
#// #generateDivide:on:indent:
#\\ #generateModulo:on:indent:
#<< #generateShiftLeft:on:indent:
#>> #generateShiftRight:on:indent:
#min: #generateMin:on:indent:
#max: #generateMax:on:indent:
#between:and: #generateBetweenAnd:on:indent:
#bitAnd: #generateBitAnd:on:indent:
#bitOr: #generateBitOr:on:indent:
#bitXor: #generateBitXor:on:indent:
#bitShift: #generateBitShift:on:indent:
#signedBitShift: #generateSignedBitShift:on:indent:
#bitInvert32 #generateBitInvert32:on:indent:
#bitClear: #generateBitClear:on:indent:
+ #truncateTo: #generateTruncateTo:on:indent:
#< #generateLessThan:on:indent:
#<= #generateLessThanOrEqual:on:indent:
#= #generateEqual:on:indent:
#> #generateGreaterThan:on:indent:
#>= #generateGreaterThanOrEqual:on:indent:
#~= #generateNotEqual:on:indent:
#== #generateEqual:on:indent:
#~~ #generateNotEqual:on:indent:
#isNil #generateIsNil:on:indent:
#notNil #generateNotNil:on:indent:
#whileTrue: #generateWhileTrue:on:indent:
#whileFalse: #generateWhileFalse:on:indent:
#whileTrue #generateDoWhileTrue:on:indent:
#whileFalse #generateDoWhileFalse:on:indent:
#to:do: #generateToDo:on:indent:
#to:by:do: #generateToByDo:on:indent:
#repeat #generateRepeat:on:indent:
#ifTrue: #generateIfTrue:on:indent:
#ifFalse: #generateIfFalse:on:indent:
#ifTrue:ifFalse: #generateIfTrueIfFalse:on:indent:
#ifFalse:ifTrue: #generateIfFalseIfTrue:on:indent:
#ifNotNil: #generateIfNotNil:on:indent:
#ifNil: #generateIfNil:on:indent:
#ifNotNil:ifNil: #generateIfNotNilIfNil:on:indent:
#ifNil:ifNotNil: #generateIfNilIfNotNil:on:indent:
#at: #generateAt:on:indent:
#at:put: #generateAtPut:on:indent:
#basicAt: #generateAt:on:indent:
#basicAt:put: #generateAtPut:on:indent:
#integerValueOf: #generateIntegerValueOf:on:indent:
#integerObjectOf: #generateIntegerObjectOf:on:indent:
#isIntegerObject: #generateIsIntegerObject:on:indent:
#cCode: #generateInlineCCode:on:indent:
#cCode:inSmalltalk: #generateInlineCCode:on:indent:
#cPreprocessorDirective: #generateInlineCPreprocessorDirective:on:indent:
#cppIf:ifTrue:ifFalse: #generateInlineCppIfElse:on:indent:
#cppIf:ifTrue: #generateInlineCppIfElse:on:indent:
#cCoerce:to: #generateCCoercion:on:indent:
#cCoerceSimple:to: #generateCCoercion:on:indent:
#addressOf: #generateAddressOf:on:indent:
#signedIntFromLong #generateSignedIntFromLong:on:indent:
#signedIntToLong #generateSignedIntToLong:on:indent:
#signedIntFromShort #generateSignedIntFromShort:on:indent:
#signedIntToShort #generateSignedIntToShort:on:indent:
#preIncrement #generatePreIncrement:on:indent:
#preDecrement #generatePreDecrement:on:indent:
#inline: #generateInlineDirective:on:indent:
#asFloat #generateAsFloat:on:indent:
#asInteger #generateAsInteger:on:indent:
#asUnsignedInteger #generateAsUnsignedInteger:on:indent:
#asLong #generateAsLong:on:indent:
#asUnsignedLong #generateAsUnsignedLong:on:indent:
#asSymbol #generateAsSymbol:on:indent:
#flag: #generateFlag:on:indent:
#anyMask: #generateBitAnd:on:indent:
#raisedTo: #generateRaisedTo:on:indent:
#touch: #generateTouch:on:indent:
#bytesPerWord #generateBytesPerWord:on:indent:
#wordSize #generateBytesPerWord:on:indent:
#baseHeaderSize #generateBaseHeaderSize:on:indent:
#sharedCodeNamed:inCase: #generateSharedCodeDirective:on:indent:
#perform: #generatePerform:on:indent:
#perform:with: #generatePerform:on:indent:
#perform:with:with: #generatePerform:on:indent:
#perform:with:with:with: #generatePerform:on:indent:
#perform:with:with:with:with: #generatePerform:on:indent:
#perform:with:with:with:with:with: #generatePerform:on:indent:
#value #generateValue:on:indent:
#value: #generateValue:on:indent:
#value:value: #generateValue:on:indent:
#shouldNotImplement #generateSmalltalkMetaError:on:indent:
#shouldBeImplemented #generateSmalltalkMetaError:on:indent:
#subclassResponsibility #generateSmalltalkMetaError:on:indent:
).
1 to: pairs size by: 2 do: [:i |
translationDict at: (pairs at: i) put: (pairs at: i + 1)].
pairs := #(
#ifTrue: #generateIfTrueAsArgument:on:indent:
#ifFalse: #generateIfFalseAsArgument:on:indent:
#ifTrue:ifFalse: #generateIfTrueIfFalseAsArgument:on:indent:
#ifFalse:ifTrue: #generateIfFalseIfTrueAsArgument:on:indent:
#ifNotNil: #generateIfNotNilAsArgument:on:indent:
#ifNil: #generateIfNilAsArgument:on:indent:
#ifNotNil:ifNil: #generateIfNotNilIfNilAsArgument:on:indent:
#ifNil:ifNotNil: #generateIfNilIfNotNilAsArgument:on:indent:
#cCode: #generateInlineCCodeAsArgument:on:indent:
#cCode:inSmalltalk: #generateInlineCCodeAsArgument:on:indent:
#cppIf:ifTrue:ifFalse: #generateInlineCppIfElseAsArgument:on:indent:
#cppIf:ifTrue: #generateInlineCppIfElseAsArgument:on:indent:
).
asArgumentTranslationDict := Dictionary new: 8.
1 to: pairs size by: 2 do: [:i |
asArgumentTranslationDict at: (pairs at: i) put: (pairs at: i + 1)].
!
Item was added:
+ ----- Method: CCodeGenerator>>selectorReturnsStruct: (in category 'C code generator') -----
+ selectorReturnsStruct: selector "<Symbol>"
+ | tMethod |
+ ^(tMethod := methods
+ at: selector
+ ifAbsent:
+ [apiMethods ifNotNil:
+ [apiMethods at: selector ifAbsent: []]]) notNil
+ and: [VMStructType isTypeStruct: tMethod returnType]!
Item was changed:
----- Method: CoInterpreter>>checkOkayFields: (in category 'debug support') -----
checkOkayFields: oop
"Check if the argument is an ok object.
If this is a pointers object, check that its fields are all okay oops."
| hasYoung i fieldOop |
(oop = nil or: [oop = 0]) ifTrue: [ ^true ]. "?? eem 1/16/2013"
(objectMemory isIntegerObject: oop) ifTrue: [ ^true ].
(objectMemory checkOkayOop: oop) ifFalse: [ ^false ].
(objectMemory checkOopHasOkayClass: oop) ifFalse: [ ^false ].
+ ((objectMemory isPointersNonImm: oop) or: [objectMemory isCompiledMethod: oop]) ifFalse: [ ^true ].
- ((objectMemory isPointersNonInt: oop) or: [objectMemory isCompiledMethod: oop]) ifFalse: [ ^true ].
hasYoung := objectMemory isYoung: (objectMemory fetchClassOfNonImm: oop).
(objectMemory isCompiledMethod: oop)
ifTrue:
[i := (self literalCountOf: oop) + LiteralStart - 1]
ifFalse:
[(objectMemory isContext: oop)
ifTrue: [i := CtxtTempFrameStart + (self fetchStackPointerOf: oop) - 1]
ifFalse: [i := (objectMemory lengthOf: oop) - 1]].
[i >= 0] whileTrue:
[fieldOop := objectMemory fetchPointer: i ofObject: oop.
(objectMemory isNonIntegerObject: fieldOop) ifTrue:
[(i = 0 and: [objectMemory isCompiledMethod: oop])
ifTrue:
[(cogMethodZone methodFor: (self pointerForOop: fieldOop)) = 0 ifTrue:
[self print: 'method '; printHex: oop; print: ' has an invalid cog method reference'.
^false]]
ifFalse:
[hasYoung := hasYoung or: [objectMemory isYoung: fieldOop].
(objectMemory checkOkayOop: fieldOop) ifFalse: [ ^false ].
(self checkOopHasOkayClass: fieldOop) ifFalse: [ ^false ]]].
i := i - 1].
hasYoung ifTrue:
[^objectMemory checkOkayYoungReferrer: oop].
^true!
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 getLongFromFile: 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 ~= 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: InterpreterPrimitives>>primitiveClipboardText (in category 'I/O primitives') -----
primitiveClipboardText
"When called with a single string argument, post the string to
the clipboard. When called with zero arguments, return a
string containing the current clipboard contents."
| s sz |
argumentCount = 1
+ ifTrue:
+ [s := self stackTop.
+ (objectMemory isBytes: s) ifFalse: [^ self primitiveFail].
+ self successful ifTrue:
+ [sz := objectMemory byteLengthOf: s.
+ self clipboardWrite: sz From: s + objectMemory baseHeaderSize At: 0.
+ self pop: 1]]
+ ifFalse:
+ [sz := self clipboardSize.
+ objectMemory hasSpurMemoryManagerAPI
+ ifTrue:
+ [s := objectMemory allocateBytes: sz classIndex: ClassByteStringCompactIndex.
+ s ifNil: [^self primitiveFail]]
+ ifFalse:
+ [(objectMemory sufficientSpaceToAllocate: sz) ifFalse: [^self primitiveFail].
+ s := objectMemory instantiateClass: (objectMemory splObj: ClassByteString) indexableSize: sz].
+ self clipboardRead: sz Into: s + objectMemory baseHeaderSize At: 0.
+ self pop: 1 thenPush: s]!
- ifTrue: [s := self stackTop.
- (objectMemory isBytes: s) ifFalse: [^ self primitiveFail].
- self successful
- ifTrue: [sz := self stSizeOf: s.
- self clipboardWrite: sz From: s + BaseHeaderSize At: 0.
- self pop: 1]]
- ifFalse: [sz := self clipboardSize.
- (objectMemory sufficientSpaceToAllocate: sz) ifFalse:[^self primitiveFail].
- s := objectMemory instantiateClass: (objectMemory splObj: ClassByteString) indexableSize: sz.
- self clipboardRead: sz Into: s + BaseHeaderSize At: 0.
- self pop: 1 thenPush: s]!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveFullGC (in category 'memory space primitives') -----
primitiveFullGC
"Do a full garbage collection and return the number of bytes available (including swap space if dynamic memory management is supported)."
objectMemory fullGCLock > 0 ifTrue:
[^self primitiveFailFor: PrimErrInappropriate].
+ objectMemory hasSpurMemoryManagerAPI ifFalse:
+ [objectMemory incrementalGC]. "maximimize space for forwarding table"
- objectMemory incrementalGC. "maximimize space for forwarding table"
objectMemory fullGC.
self pop: 1 thenPushInteger: (objectMemory bytesLeft: true).!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveInvokeObjectAsMethod (in category 'control primitives') -----
primitiveInvokeObjectAsMethod
"Primitive. 'Invoke' an object like a function, sending the special message
run: originalSelector with: arguments in: aReceiver.
"
<returnTypeC: #void>
| runReceiver runArgs lookupClassTag |
+ runArgs := objectMemory hasSpurMemoryManagerAPI
+ ifTrue: [objectMemory
+ eeInstantiateClassIndex: ClassArrayCompactIndex
+ format: objectMemory arrayFormat
+ numSlots: argumentCount]
+ ifFalse: [objectMemory
+ eeInstantiateClass: (objectMemory splObj: ClassArray)
+ indexableSize: argumentCount].
- runArgs := objectMemory eeInstantiateClass: (objectMemory splObj: ClassArray) indexableSize: argumentCount.
argumentCount - 1 to: 0 by: -1 do:
[:i| objectMemory storePointerUnchecked: i ofObject: runArgs withValue: self popStack].
runReceiver := self popStack.
"setup send of newMethod run: originalSelector with: runArgs in: runReceiver"
self push: newMethod. "newReceiver"
self push: messageSelector "original selector".
self push: runArgs.
self push: runReceiver.
"stack is clean here"
messageSelector := objectMemory splObj: SelectorRunWithIn.
argumentCount := 3.
lookupClassTag := objectMemory fetchClassTagOf: newMethod.
self findNewMethodInClassTag: lookupClassTag.
self executeNewMethod. "Recursive xeq affects successFlag"
self initPrimCall!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveIsRoot (in category 'memory space primitives') -----
primitiveIsRoot
"Primitive. Answer whether the argument to the primitive is a root for young space"
| oop |
<export: true>
+ <option: #SqueakV3ObjectMemory>
oop := self stackObjectValue: 0.
self successful ifTrue:
[self
pop: argumentCount + 1
thenPushBool: (objectMemory isYoungRoot: oop)]!
Item was changed:
----- Method: MessageNode>>asTranslatorNodeIn: (in category '*VMMaker-C translation') -----
asTranslatorNodeIn: aTMethod
"make a CCodeGenerator equivalent of me"
"selector is sometimes a Symbol, sometimes a SelectorNode!!
On top of this, numArgs is needed due to the (truly grody) use of
arguments as a place to store the extra expressions needed to generate
code for in-line to:by:do:, etc. see below, where it is used."
| rcvrOrNil sel args |
rcvrOrNil := receiver ifNotNil: [receiver asTranslatorNodeIn: aTMethod].
(rcvrOrNil notNil
and: [rcvrOrNil isVariable
and: [rcvrOrNil name = 'super']]) ifTrue:
[^aTMethod superExpansionNodeFor: selector key args: arguments].
sel := selector isSymbol ifTrue: [selector] ifFalse: [selector key].
((sel = #cCode:inSmalltalk: "extracting here rather than in translation allows inlining in the block."
or: [sel = #cCode:])
and: [arguments first isBlockNode]) ifTrue:
[| block |
^(block := arguments first asTranslatorNodeIn: aTMethod) statements size = 1
ifTrue: [block statements first]
ifFalse: [block]].
args := (1 to: sel numArgs) collect:
[:i | (arguments at: i) asTranslatorNodeIn: aTMethod].
(sel = #to:by:do: and: [arguments size = 7 and: [(arguments at: 7) notNil]]) ifTrue:
["Restore limit expr that got moved by transformToDo:"
args := {(arguments at: 7) value asTranslatorNodeIn: aTMethod.
args second.
args third. "add the limit var as a hidden extra argument; we may need it later"
TVariableNode new setName: arguments first key}].
+ (sel == #ifTrue:ifFalse: and: [arguments first isJust: NodeNil]) ifTrue:
+ [sel := #ifFalse:. args := {args last}].
+ (sel == #ifTrue:ifFalse: and: [arguments last isJust: NodeNil]) ifTrue:
+ [sel := #ifTrue:. args := {args first}].
+ (sel == #ifFalse:ifTrue: and: [arguments first isJust: NodeNil]) ifTrue:
+ [sel := #ifTrue:. args := {args last}].
+ (sel == #ifFalse:ifTrue: and: [arguments last isJust: NodeNil]) ifTrue:
+ [sel := #ifTrue:. args := {args first}].
((sel = #ifFalse: or: [sel = #or:])
and: [arguments size = 2 and: [(arguments at: 2) notNil]]) ifTrue:
["Restore argument block that got moved by transformOr: or transformIfFalse:"
args at: 1 put: ((arguments at: 2) asTranslatorNodeIn: aTMethod)].
^TSendNode new
setSelector: sel
receiver: rcvrOrNil
arguments: args!
Item was changed:
----- Method: ObjectMemory class>>initializeWithOptions: (in category 'initialization') -----
initializeWithOptions: optionsDictionary
"ObjectMemory initializeWithOptions: Dictionary new"
self initBytesPerWord: (optionsDictionary at: #BytesPerWord ifAbsent: [4]).
BytesPerOop := optionsDictionary at: #BytesPerOop ifAbsent: [BytesPerWord].
"Translation flags (booleans that control code generation via conditional translation):"
"generate assertion checks"
DoAssertionChecks := optionsDictionary at: #DoAssertionChecks ifAbsent: [false].
DoExpensiveAssertionChecks := optionsDictionary at: #DoExpensiveAssertionChecks ifAbsent: [false].
+ self initializeObjectHeaderConstants. "Initializes BaseHeaderSize so do early"
self initializeImmediates.
self initializeSpecialObjectIndices.
self initializeCompactClassIndices.
self initializePrimitiveErrorCodes.
- self initializeObjectHeaderConstants.
NilContext := 1. "the oop for the integer 0; used to mark the end of context lists"
RemapBufferSize := 25.
RootTableSize := 2500. "number of root table entries (4 bytes/entry)"
RootTableRedZone := RootTableSize - 100. "red zone of root table - when reached we force IGC"
WeakRootTableSize := RootTableSize + RemapBufferSize + 100.
"tracer actions"
StartField := 1.
StartObj := 2.
Upward := 3.
Done := 4.
ExtraRootSize := 2048. "max. # of external roots"!
Item was changed:
----- Method: ObjectMemory>>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
endOfMemory
memoryLimit
specialObjectsOop
lastHash
"
"di 11/18/2000 fix slow full GC"
<inline: false>
+ "Catch mis-initializations leading to bad translations to C"
+ self assert: BaseHeaderSize = BytesPerWord.
"set the start of the young object space"
youngStart := endOfMemory.
"image may be at a different address; adjust oops for new location"
totalObjectCount := self adjustAllOopsBy: bytesToShift.
self initializeMemoryFirstFree: endOfMemory. "initializes endOfMemory, freeBlock"
specialObjectsOop := specialObjectsOop + bytesToShift.
"heavily used special objects"
nilObj := self splObj: NilObject.
falseObj := self splObj: FalseObject.
trueObj := self splObj: TrueObject.
rootTableCount := 0.
rootTableOverflowed := false.
freeContexts := NilContext.
freeLargeContexts := NilContext.
allocationCount := 0.
lowSpaceThreshold := 0.
signalLowSpace := false.
compStart := 0.
compEnd := 0.
fwdTableNext := 0.
fwdTableLast := 0.
remapBufferCount := 0.
allocationsBetweenGCs := 4000. "do incremental GC after this many allocations"
tenuringThreshold := 2000. "tenure all suriving objects if count is over this threshold"
growHeadroom := 4*1024*1024. "four megabyte of headroom when growing"
shrinkThreshold := 8*1024*1024. "eight megabyte 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.
gcStartUsecs := 0!
Item was added:
+ ----- Method: Spur32BitMemoryManager>>changeClassOf:to: (in category 'interpreter access') -----
+ changeClassOf: rcvr to: argClass
+ "Attempt to change the class of the receiver to the argument given that the
+ format of the receiver matches the format of the argument. If successful,
+ answer 0, otherwise answer an error code indicating the reason for failure.
+ Fail if the format of the receiver is incompatible with the format of the argument,
+ or if the argument is a fixed class and the receiver's size differs from the size
+ that an instance of the argument should have."
+ <inline: false>
+ | classFormat fixedFields instFormat normalizedInstFormat newFormat classIndex |
+ classFormat := self formatOfClass: argClass.
+ fixedFields := self fixedFieldsOfClassFormat: classFormat.
+ instFormat := self formatOf: rcvr.
+ normalizedInstFormat := self classFormatForInstanceFormat: instFormat.
+
+ normalizedInstFormat = classFormat
+ ifTrue: [newFormat := instFormat]
+ ifFalse:
+ [normalizedInstFormat <= self lastPointerFormat
+ ifTrue:
+ [classFormat > self lastPointerFormat ifTrue:
+ [^PrimErrInappropriate].
+ (self numSlotsOf: rcvr) < fixedFields ifTrue:
+ [^PrimErrBadReceiver].
+ newFormat := classFormat]
+ ifFalse:
+ [| instBytes |
+ instBytes := self byteLengthOf: rcvr.
+ normalizedInstFormat caseOf: {
+ [self sixtyFourBitIndexableFormat] ->
+ [(classFormat < self sixtyFourBitIndexableFormat
+ or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
+ [^PrimErrInappropriate].
+ newFormat := classFormat].
+ [self firstLongFormat] ->
+ [(classFormat < self sixtyFourBitIndexableFormat
+ or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
+ [^PrimErrInappropriate].
+ (classFormat = self sixtyFourBitIndexableFormat and: [instBytes anyMask: 1]) ifTrue:
+ [^PrimErrBadReceiver].
+ newFormat := classFormat].
+ [self firstShortFormat] ->
+ [(classFormat < self sixtyFourBitIndexableFormat
+ or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
+ [^PrimErrInappropriate].
+ classFormat caseOf: {
+ [self sixtyFourBitIndexableFormat]
+ -> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver].
+ newFormat := classFormat].
+ [self firstLongFormat]
+ -> [(instBytes anyMask: 1) ifTrue: [^PrimErrBadReceiver].
+ newFormat := classFormat].
+ [self firstByteFormat]
+ -> [newFormat := classFormat + (4 - instBytes bitAnd: 3)] }].
+ [self firstByteFormat] ->
+ [(classFormat < self sixtyFourBitIndexableFormat
+ or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
+ [^PrimErrInappropriate].
+ classFormat caseOf: {
+ [self sixtyFourBitIndexableFormat]
+ -> [(instBytes anyMask: 7) ifTrue: [^PrimErrBadReceiver]].
+ [self firstLongFormat]
+ -> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver]].
+ [self firstShortFormat]
+ -> [(instBytes anyMask: 1) ifTrue: [^PrimErrBadReceiver]] }.
+ newFormat := classFormat].
+ [self firstCompiledMethodFormat] ->
+ [classFormat ~= self firstCompiledMethodFormat ifTrue:
+ [^PrimErrInappropriate].
+ newFormat := instFormat] }]].
+
+ (classIndex := self ensureBehaviorHash: argClass) < 0 ifTrue:
+ [^classIndex negated].
+
+ self setFormatOf: rcvr to: newFormat;
+ setClassIndexOf: rcvr to: classIndex.
+ "ok"
+ ^0!
Item was added:
+ ----- Method: Spur64BitMemoryManager>>changeClassOf:to: (in category 'interpreter access') -----
+ changeClassOf: rcvr to: argClass
+ "Attempt to change the class of the receiver to the argument given that the
+ format of the receiver matches the format of the argument. If successful,
+ answer 0, otherwise answer an error code indicating the reason for failure.
+ Fail if the format of the receiver is incompatible with the format of the argument,
+ or if the argument is a fixed class and the receiver's size differs from the size
+ that an instance of the argument should have."
+ <inline: false>
+ | classFormat fixedFields instFormat normalizedInstFormat newFormat classIndex |
+ classFormat := self formatOfClass: argClass.
+ fixedFields := self fixedFieldsOfClassFormat: classFormat.
+ instFormat := self formatOf: rcvr.
+ normalizedInstFormat := self classFormatForInstanceFormat: instFormat.
+
+ normalizedInstFormat = classFormat
+ ifTrue: [newFormat := instFormat]
+ ifFalse:
+ [normalizedInstFormat <= self lastPointerFormat
+ ifTrue:
+ [classFormat > self lastPointerFormat ifTrue:
+ [^PrimErrInappropriate].
+ (self numSlotsOf: rcvr) < fixedFields ifTrue:
+ [^PrimErrBadReceiver].
+ newFormat := classFormat]
+ ifFalse:
+ [| instBytes |
+ instBytes := self byteLengthOf: rcvr.
+ normalizedInstFormat caseOf: {
+ [self sixtyFourBitIndexableFormat] ->
+ [(classFormat < self sixtyFourBitIndexableFormat
+ or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
+ [^PrimErrInappropriate].
+ newFormat := classFormat].
+ [self firstLongFormat] ->
+ [(classFormat < self sixtyFourBitIndexableFormat
+ or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
+ [^PrimErrInappropriate].
+ (classFormat = self sixtyFourBitIndexableFormat and: [instBytes anyMask: 1]) ifTrue:
+ [^PrimErrBadReceiver].
+ newFormat := classFormat].
+ [self firstShortFormat] ->
+ [(classFormat < self sixtyFourBitIndexableFormat
+ or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
+ [^PrimErrInappropriate].
+ classFormat caseOf: {
+ [self sixtyFourBitIndexableFormat]
+ -> [(instBytes anyMask: 7) ifTrue: [^PrimErrBadReceiver].
+ newFormat := classFormat].
+ [self firstLongFormat]
+ -> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver].
+ newFormat := classFormat + (2 - instBytes bitAnd: 1)].
+ [self firstByteFormat]
+ -> [newFormat := classFormat + (8 - instBytes bitAnd: 7)] }].
+ [self firstByteFormat] ->
+ [(classFormat < self sixtyFourBitIndexableFormat
+ or: [classFormat >= self firstCompiledMethodFormat]) ifTrue:
+ [^PrimErrInappropriate].
+ classFormat caseOf: {
+ [self sixtyFourBitIndexableFormat]
+ -> [(instBytes anyMask: 7) ifTrue: [^PrimErrBadReceiver].
+ newFormat := classFormat].
+ [self firstLongFormat]
+ -> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver].
+ newFormat := classFormat + (2 - instBytes bitAnd: 1)].
+ [self firstShortFormat]
+ -> [(instBytes anyMask: 1) ifTrue: [^PrimErrBadReceiver].
+ newFormat := classFormat + (4 - instBytes bitAnd: 3)] }.
+ newFormat := classFormat].
+ [self firstCompiledMethodFormat] ->
+ [classFormat ~= self firstCompiledMethodFormat ifTrue:
+ [^PrimErrInappropriate].
+ newFormat := instFormat] }]].
+
+ (classIndex := self ensureBehaviorHash: argClass) < 0 ifTrue:
+ [^classIndex negated].
+
+ self setFormatOf: rcvr to: newFormat;
+ setClassIndexOf: rcvr to: classIndex.
+ "ok"
+ ^0!
Item was changed:
----- Method: SpurMemoryManager class>>initializeWithOptions: (in category 'class initialization') -----
initializeWithOptions: optionsDictionary
"SpurMemoryManager initializeWithOptions: Dictionary new"
super initializeWithOptions: optionsDictionary.
self initBytesPerWord: (self == SpurMemoryManager
ifTrue: [optionsDictionary at: #BytesPerWord ifAbsent: [4]]
ifFalse: [self wordSize]).
BytesPerOop := optionsDictionary at: #BytesPerOop ifAbsent: [BytesPerWord].
+ self initializeObjectHeaderConstants. "Initializes BaseHeaderSize so do early"
self initializeSpurObjectRepresentationConstants.
self initializeSpecialObjectIndices.
self initializeCompactClassIndices.
self initializePrimitiveErrorCodes.
- self initializeObjectHeaderConstants.
SpurGenerationScavenger initialize!
Item was added:
+ ----- 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 wordSize - 1 // self wordSize)
+ format: self firstByteFormat + (self wordSize - numBytes bitAnd: self wordSize - 1)
+ classIndex: classIndex!
Item was added:
+ ----- Method: SpurMemoryManager>>changeClassOf:to: (in category 'interpreter access') -----
+ changeClassOf: rcvr to: argClass
+ "Attempt to change the class of the receiver to the argument given that the
+ format of the receiver matches the format of the argument. If successful,
+ answer 0, otherwise answer an error code indicating the reason for failure.
+ Fail if the format of the receiver is incompatible with the format of the argument,
+ or if the argument is a fixed class and the receiver's size differs from the size
+ that an instance of the argument should have."
+ self subclassResponsibility!
Item was added:
+ ----- Method: SpurMemoryManager>>characterTable (in category 'accessing') -----
+ characterTable
+ self shouldNotImplement!
Item was added:
+ ----- Method: SpurMemoryManager>>checkOopHasOkayClass: (in category 'debug support') -----
+ checkOopHasOkayClass: obj
+ "Attempt to verify that the given obj has a reasonable behavior. The class must be a
+ valid, non-integer oop and must not be nilObj. It must be a pointers object with three
+ or more fields. Finally, the instance specification field of the behavior must match that
+ of the instance. If OK answer true. If not, print reason and answer false."
+
+ <api>
+ <var: #oop type: #usqInt>
+ | objClass objFormat |
+ <var: #oopClass type: #usqInt>
+
+ (self checkOkayOop: obj) ifFalse:
+ [^false].
+ objClass := self cCoerce: (self fetchClassOfNonImm: obj) to: #usqInt.
+
+ (self isImmediate: objClass) ifTrue:
+ [self print: 'obj '; printHex: obj; print: ' an immediate is not a valid class or behavior'; cr. ^false].
+ (self okayOop: objClass) ifFalse:
+ [self print: 'obj '; printHex: obj; print: ' class obj is not ok'; cr. ^false].
+ ((self isPointersNonImm: objClass) and: [(self numSlotsOf: objClass) >= 3]) ifFalse:
+ [self print: 'obj '; printHex: obj; print: ' a class (behavior) must be a pointers object of size >= 3'; cr. ^false].
+ objFormat := (self isBytes: obj)
+ ifTrue: [(self formatOf: obj) bitClear: 7] "ignore extra bytes size bits"
+ ifFalse: [self formatOf: obj].
+
+ (self instSpecOfClass: objClass) ~= objFormat ifTrue:
+ [self print: 'obj '; printHex: obj; print: ' and its class (behavior) formats differ'; cr. ^false].
+ ^true!
Item was added:
+ ----- Method: SpurMemoryManager>>classAlien (in category 'accessing') -----
+ classAlien
+ ^self splObj: ClassAlien!
Item was added:
+ ----- Method: SpurMemoryManager>>classExternalAddress (in category 'accessing') -----
+ classExternalAddress
+ ^self splObj: ClassExternalAddress!
Item was added:
+ ----- Method: SpurMemoryManager>>classExternalData (in category 'accessing') -----
+ classExternalData
+ ^self splObj: ClassExternalData!
Item was added:
+ ----- Method: SpurMemoryManager>>classExternalFunction (in category 'accessing') -----
+ classExternalFunction
+ ^self splObj: ClassExternalFunction!
Item was added:
+ ----- Method: SpurMemoryManager>>classExternalLibrary (in category 'accessing') -----
+ classExternalLibrary
+ ^self splObj: ClassExternalLibrary!
Item was added:
+ ----- Method: SpurMemoryManager>>classFormatForInstanceFormat: (in category 'header format') -----
+ classFormatForInstanceFormat: aFormat
+ "Clear any odd bits from the format so that it matches its class's format"
+ aFormat < self firstLongFormat ifTrue:
+ [^aFormat].
+ aFormat >= self firstByteFormat ifTrue:
+ [^aFormat bitAnd: -8].
+ ^aFormat >= self firstShortFormat
+ ifTrue: [aFormat bitAnd: -4]
+ ifFalse: [aFormat bitAnd: -2]!
Item was added:
+ ----- Method: SpurMemoryManager>>classString (in category 'accessing') -----
+ classString
+ ^self splObj: ClassByteString!
Item was added:
+ ----- Method: SpurMemoryManager>>classUnsafeAlien (in category 'accessing') -----
+ classUnsafeAlien
+ ^self splObj: ClassUnsafeAlien!
Item was added:
+ ----- Method: SpurMemoryManager>>fullGCLock (in category 'garbage collection') -----
+ fullGCLock
+ "Spur never has a need to lock GC because it does not move pinned objects."
+ ^0!
Item was added:
+ ----- Method: SpurMemoryManager>>incrementalGC (in category 'garbage collection') -----
+ incrementalGC
+ self shouldNotImplement!
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 |
+ "Catch mis-initializations leading to bad translations to C"
+ self assert: BaseHeaderSize = self baseHeaderSize.
+
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].
"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 initializeNewSpaceVariables.
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>>isInMemory: (in category 'plugin support') -----
+ isInMemory: address
+ "Return true if the given address is in ST object memory"
+ ^(self oop: address isGreaterThanOrEqualTo: startOfMemory)
+ and: [(self oop: address isLessThan: newSpaceLimit)
+ or: [segmentManager isInSegments: address]]!
Item was added:
+ ----- Method: SpurMemoryManager>>loadImageSegmentFrom:outPointers: (in category 'primitive support') -----
+ loadImageSegmentFrom: segmentWordArray outPointers: outPointerArray
+ "This primitive is called from Squeak as...
+ <imageSegment> loadSegmentFrom: aWordArray outPointers: anArray."
+
+ "This primitive will load a binary image segment created by primitiveStoreImageSegment. It expects the outPointer array to be of the proper size, and the wordArray to be well formed. It will return as its value the original array of roots, and the erstwhile segmentWordArray will have been truncated to a size of zero. If this primitive should fail, the segmentWordArray will, sadly, have been reduced to an unrecognizable and unusable jumble. But what more could you have done with it anyway?"
+
+ ^PrimErrUnsupported!
Item was added:
+ ----- Method: SpurMemoryManager>>maxIdentityHash (in category 'accessing') -----
+ maxIdentityHash
+ ^self identityHashHalfWordMask!
Item was added:
+ ----- Method: SpurMemoryManager>>maybeSplObj: (in category 'interpreter access') -----
+ maybeSplObj: index
+ <api>
+ "Answer one of the objects in the SpecialObjectsArray, if in range, otherwise answer nil."
+ ^index < (self numSlotsOf: specialObjectsOop) ifTrue:
+ [self fetchPointer: index ofObject: specialObjectsOop]!
Item was added:
+ ----- Method: SpurMemoryManager>>oldSpaceSize (in category 'accessing') -----
+ oldSpaceSize
+ ^segmentManager totalBytesInSegments!
Item was added:
+ ----- Method: SpurMemoryManager>>primitiveErrorTable (in category 'accessing') -----
+ primitiveErrorTable
+ <api>
+ ^self splObj: PrimErrTableIndex!
Item was added:
+ ----- Method: SpurMemoryManager>>statCompMoveCount (in category 'accessing') -----
+ statCompMoveCount
+ "Spur never compacts by moving"
+ ^0!
Item was added:
+ ----- Method: SpurMemoryManager>>statRootTableCount (in category 'accessing') -----
+ statRootTableCount
+ ^scavenger rememberedSetSize!
Item was added:
+ ----- Method: SpurMemoryManager>>storeImageSegmentInto:outPointers:roots: (in category 'primitive support') -----
+ storeImageSegmentInto: segmentWordArray outPointers: outPointerArray roots: arrayOfRoots
+ "This primitive is called from Squeak as...
+ <imageSegment> storeSegmentFor: arrayOfRoots into: aWordArray outPointers: anArray."
+
+ "This primitive will store a binary image segment (in the same format as the Squeak image file) of the receiver and every object in its proper tree of subParts (ie, that is not refered to from anywhere else outside the tree). All pointers from within the tree to objects outside the tree will be copied into the array of outpointers. In their place in the image segment will be an oop equal to the offset in the outPointer array (the first would be 4). but with the high bit set."
+
+ "The primitive expects the array and wordArray to be more than adequately long. In this case it returns normally, and truncates the two arrays to exactly the right size. To simplify truncation, both incoming arrays are required to be 256 bytes or more long (ie with 3-word headers). If either array is too small, the primitive will fail, but in no other case.
+
+ During operation of the primitive, it is necessary to convert from both internal and external oops to their mapped values. To make this fast, the headers of the original objects in question are replaced by the mapped values (and this is noted by adding the forbidden XX header type). Tables are kept of both kinds of oops, as well as of the original headers for restoration.
+
+ To be specific, there are two similar two-part tables, the outpointer array, and one in the upper fifth of the segmentWordArray. Each grows oops from the bottom up, and preserved headers from halfway up.
+
+ In case of either success or failure, the headers must be restored. In the event of primitive failure, the table of outpointers must also be nilled out (since the garbage in the high half will not have been discarded."
+
+ ^PrimErrUnsupported!
Item was added:
+ ----- Method: SpurSegmentManager>>isInSegments: (in category 'testing') -----
+ isInSegments: address
+ 0 to: numSegments - 1 do:
+ [:i|
+ address < (segments at: i) segStart ifTrue:
+ [^false].
+ address < ((segments at: i) segStart + (segments at: i) segSize) ifTrue:
+ [^true]].
+ ^false!
Item was changed:
----- Method: StackInterpreter>>checkOkayFields: (in category 'debug support') -----
checkOkayFields: oop
"Check if the argument is an ok object.
If this is a pointers object, check that its fields are all okay oops."
| hasYoung i fieldOop |
(oop = nil or: [oop = 0]) ifTrue: [ ^true ]. "?? eem 1/16/2013"
(objectMemory isIntegerObject: oop) ifTrue: [ ^true ].
(objectMemory checkOkayOop: oop) ifFalse: [ ^false ].
(objectMemory checkOopHasOkayClass: oop) ifFalse: [ ^false ].
+ ((objectMemory isPointersNonImm: oop) or: [objectMemory isCompiledMethod: oop]) ifFalse: [ ^true ].
- ((objectMemory isPointersNonInt: oop) or: [objectMemory isCompiledMethod: oop]) ifFalse: [ ^true ].
hasYoung := objectMemory isYoung: (objectMemory fetchClassOfNonImm: oop).
(objectMemory isCompiledMethod: oop)
ifTrue:
[i := (self literalCountOf: oop) + LiteralStart - 1]
ifFalse:
[(objectMemory isContext: oop)
ifTrue: [i := CtxtTempFrameStart + (self fetchStackPointerOf: oop) - 1]
ifFalse: [i := (objectMemory lengthOf: oop) - 1]].
[i >= 0] whileTrue:
[fieldOop := objectMemory fetchPointer: i ofObject: oop.
(objectMemory isIntegerObject: fieldOop) ifFalse:
[hasYoung := hasYoung or: [objectMemory isYoung: fieldOop].
(objectMemory checkOkayOop: fieldOop) ifFalse: [ ^false ].
(self checkOopHasOkayClass: fieldOop) ifFalse: [ ^false ]].
i := i - 1].
hasYoung ifTrue:
[^objectMemory checkOkayYoungReferrer: oop].
^true!
Item was changed:
----- Method: StackInterpreter>>okayFields: (in category 'debug support') -----
okayFields: oop
"Check if the argument is an ok object.
If this is a pointers object, check that its fields are all okay oops."
| i fieldOop |
(oop = nil or: [oop = 0]) ifTrue: [ ^true ].
(objectMemory isIntegerObject: oop) ifTrue: [ ^true ].
(objectMemory okayOop: oop) ifFalse: [ ^false ].
(objectMemory oopHasOkayClass: oop) ifFalse: [ ^false ].
+ ((objectMemory isPointersNonImm: oop) or: [objectMemory isCompiledMethod: oop]) ifFalse: [ ^true ].
- ((objectMemory isPointersNonInt: oop) or: [objectMemory isCompiledMethod: oop]) ifFalse: [ ^true ].
(objectMemory isCompiledMethod: oop)
ifTrue:
[i := (self literalCountOf: oop) + LiteralStart - 1]
ifFalse:
[(objectMemory isContext: oop)
ifTrue: [i := CtxtTempFrameStart + (self fetchStackPointerOf: oop) - 1]
ifFalse: [i := (objectMemory lengthOf: oop) - 1]].
[i >= 0] whileTrue: [
fieldOop := objectMemory fetchPointer: i ofObject: oop.
(objectMemory isIntegerObject: fieldOop) ifFalse: [
(objectMemory okayOop: fieldOop) ifFalse: [ ^false ].
(self oopHasOkayClass: fieldOop) ifFalse: [ ^false ].
].
i := i - 1.
].
^true!
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 getLongFromFile: 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 ~= 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: StackInterpreter>>signed32BitIntegerFor: (in category 'primitive support') -----
signed32BitIntegerFor: integerValue
"Return a full 32 bit integer object for the given integer value"
| newLargeInteger value largeClass |
<inline: false>
+ (objectMemory isIntegerValue: integerValue) ifTrue:
+ [^objectMemory integerObjectOf: integerValue].
+ objectMemory hasSpurMemoryManagerAPI
+ ifTrue:
+ [integerValue < 0
+ ifTrue: [largeClass := ClassLargeNegativeIntegerCompactIndex.
+ value := 0 - integerValue]
+ ifFalse: [largeClass := ClassLargePositiveIntegerCompactIndex.
+ value := integerValue].
+ objectMemory allocateBytes: 4 classIndex: largeClass]
+ ifFalse:
+ [integerValue < 0
+ ifTrue: [largeClass := objectMemory classLargeNegativeInteger.
+ value := 0 - integerValue]
+ ifFalse: [largeClass := objectMemory classLargePositiveInteger.
+ value := integerValue].
+ newLargeInteger := objectMemory eeInstantiateClass: largeClass indexableSize: 4].
- (objectMemory isIntegerValue: integerValue)
- ifTrue: [^ objectMemory integerObjectOf: integerValue].
- integerValue < 0
- ifTrue:[ largeClass := objectMemory classLargeNegativeInteger.
- value := 0 - integerValue]
- ifFalse:[ largeClass := objectMemory classLargePositiveInteger.
- value := integerValue].
- newLargeInteger := objectMemory eeInstantiateClass: largeClass indexableSize: 4.
objectMemory storeByte: 3 ofObject: newLargeInteger withValue: ((value >> 24) bitAnd: 16rFF).
objectMemory storeByte: 2 ofObject: newLargeInteger withValue: ((value >> 16) bitAnd: 16rFF).
objectMemory storeByte: 1 ofObject: newLargeInteger withValue: ((value >> 8) bitAnd: 16rFF).
objectMemory storeByte: 0 ofObject: newLargeInteger withValue: (value bitAnd: 16rFF).
^newLargeInteger!
Item was changed:
----- Method: StackInterpreterPrimitives>>primitiveFullGC (in category 'memory space primitives') -----
primitiveFullGC
"Do a full garbage collection and return the number of bytes available (including swap space if dynamic memory management is supported)."
objectMemory fullGCLock > 0 ifTrue:
[^self primitiveFailFor: PrimErrInappropriate].
self externalWriteBackHeadFramePointers.
+ objectMemory hasSpurMemoryManagerAPI ifFalse:
+ [objectMemory incrementalGC]. "maximimize space for forwarding table"
- objectMemory incrementalGC. "maximimize space for forwarding table"
objectMemory fullGC.
self pop: 1 thenPushInteger: (objectMemory bytesLeft: true).!
Item was changed:
----- Method: TMethod>>prepareMethodIn: (in category 'transformations') -----
prepareMethodIn: aCodeGen
"Record sends of builtin operators, map sends of the special selector dispatchOn:in:
with case statement nodes, and map sends of caseOf:[otherwise:] to switch statements.
- Note: Only replaces top-level sends of dispatchOn:in: et al and caseOf:[otherwise:].
- These must be top-level statements; they cannot appear in expressions.
As a hack also update the types of variables introduced to implement cascades correctly.
This has to be done at the same time as this is done, so why not piggy back here?"
- | replacements |
extraVariableNumber ifNotNil:
[declarations keysAndValuesDo:
[:varName :decl|
decl isBlock ifTrue:
[self assert: ((varName beginsWith: 'cascade') and: [varName last isDigit]).
locals add: varName.
self declarationAt: varName
put: (decl value: self value: aCodeGen), ' ', varName]]].
- replacements := IdentityDictionary new.
aCodeGen
pushScope: declarations
+ while:"N.B. nodesWithParentsDo: is bottom-up, hence replacement is destructive and conserved."
- while:
[parseTree nodesWithParentsDo:
[:node :parent|
node isSend ifTrue:
[(aCodeGen isBuiltinSelector: node selector)
ifTrue:
[node isBuiltinOperator: true.
"If a to:by:do:'s limit has side-effects, declare the limit variable, otherwise delete it from the args"
(node selector = #to:by:do:
and: [node args size = 4]) ifTrue:
[| limitExpr |
limitExpr := node args first.
(limitExpr anySatisfy:
[:subNode|
subNode isSend
and: [(aCodeGen isBuiltinSelector: subNode selector) not
and: [(subNode isStructSend: aCodeGen) not]]])
ifTrue: [locals add: node args last name]
ifFalse:
[node arguments: node args allButLast]]]
ifFalse:
[(CaseStatements includes: node selector) ifTrue:
+ [parent replaceNodesIn: (Dictionary newFromPairs: { node. self buildCaseStmt: node})].
- [replacements at: node put: (self buildCaseStmt: node)].
(#(caseOf: #caseOf:otherwise:) includes: node selector) ifTrue:
+ [parent replaceNodesIn: (Dictionary newFromPairs: { node. self buildSwitchStmt: node parent: parent })]]]]]!
- [replacements at: node put: (self buildSwitchStmt: node parent: parent)]]].
- ((node isAssignment or: [node isReturn])
- and: [node expression isSwitch]) ifTrue:
- [replacements at: node put: (self transformSwitchExpression: node)]]].
- replacements isEmpty ifFalse:
- [parseTree := parseTree replaceNodesIn: replacements]!
Item was changed:
----- Method: TSendNode>>structTargetKind: (in category 'testing') -----
structTargetKind: aCodeGen
"Answer if the recever evaluates to a struct or struct pointer
and hence can be dereferenced using . or ->. Answer any of
#struct #pointer or nil. Right now we don't need or support
structure return so this method answers either #pointer or nil."
selector == #cCoerceSimple:to: ifTrue:
[^(VMStructType isTypePointerToStruct: arguments last value) ifTrue:
[#pointer]].
+ selector == #addressOf: ifTrue:
+ [^#pointer].
+
selector == #at: ifTrue:
[receiver isVariable ifTrue:
[(aCodeGen typeOfVariable: receiver name) ifNotNil:
[:type| | derefType |
type last = $* ifFalse:
[^receiver structTargetKind: aCodeGen].
+ (VMStructType isTypeStruct: (aCodeGen
- (Smalltalk classNamed: (aCodeGen
extractTypeFor: receiver name
+ fromDeclaration: type allButLast)) ifTrue:
+ [^#struct]]].
- fromDeclaration: type allButLast)) ifNotNil:
- [:class|
- class isStructClass ifTrue:
- [^#struct]]]].
(receiver structTargetKind: aCodeGen) ifNotNil:
[:kind| ^kind]].
+ (aCodeGen selectorReturnsPointerToStruct: selector) ifTrue:
+ [^#pointer].
+
+ (aCodeGen selectorReturnsStruct: selector) ifTrue:
+ [^#struct].
+
+ ^nil!
- ^(aCodeGen selectorReturnsPointerToStruct: selector) ifTrue:
- [#pointer]!
Item was changed:
----- Method: TStmtListNode>>nodesDo:parent: (in category 'enumerating') -----
nodesDo: aBlock parent: parent
"Apply aBlock to all nodes in the receiver with each node's parent.
N.B. This is assumed to be bottom-up, leaves first."
+ statements do: [:s| s nodesDo: aBlock parent: self].
- statements do: [:s| s nodesDo: aBlock parent: self.].
aBlock value: self value: parent!
Item was changed:
----- 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:
- { cogitClass. self interpreterClass } 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 changed:
----- 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).
- (cg structClassesForTranslationClasses: interpreterClasses) do:
- [:structClass| structClass initialize].
- cg addStructClasses: (cg structClassesForTranslationClasses: 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: VMStructType class>>isTypeStruct: (in category 'translation') -----
+ isTypeStruct: type
+ StructTypeNameCache ifNil:
+ [StructTypeNameCache := Set new.
+ self allSubclassesDo:
+ [:sc| StructTypeNameCache add: sc name; add: sc structTypeName]].
+ ^type notNil
+ and: [StructTypeNameCache anySatisfy:
+ [:structType|
+ type = structType]]!
More information about the Vm-dev
mailing list