[Vm-dev] VM Maker: VMMaker.oscog-eem.513.mcz
commits at source.squeak.org
commits at source.squeak.org
Mon Nov 18 18:49:23 UTC 2013
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.513.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.513
Author: eem
Time: 17 November 2013, 3:08:08.722 pm
UUID: be833738-0c93-4c1a-8f13-d4c083687ffa
Ancestors: VMMaker.oscog-eem.512
Fix slip in addToFreeTree:bytes:.
Slang:
Add a configuration for the Spur Cog VM.
Eliminate translation-time errors and warnings for the Spur Cog VM.
Improve error reporting for inst var masking for dtl's jenkins build.
Don't raise a confliuct error when adding a method override in a
subclass.
Abstract away filtering implicit non-argument inst vars into
CCodeGenerator>>instVarNamesForClass:.
=============== Diff against VMMaker.oscog-eem.512 ===============
Item was changed:
----- Method: CCodeGenerator>>addClass: (in category 'public') -----
addClass: aClass
"Add the variables and methods of the given class to the code base."
aClass prepareToBeAddedToCodeGenerator: self.
self checkClassForNameConflicts: aClass.
self addClassVarsFor: aClass.
"ikp..."
self addPoolVarsFor: aClass.
(aClass inheritsFrom: VMStructType) ifFalse:
+ [variables addAll: (self instVarNamesForClass: aClass)].
- [variables addAll: (vmClass
- ifNil: [aClass instVarNames]
- ifNotNil: [aClass instVarNames reject:
- [:ivn| vmClass isNonArgumentImplicitReceiverVariableName: ivn]])].
self retainMethods: (aClass requiredMethodNames: self options).
'Adding Class ' , aClass name , '...'
displayProgressAt: Sensor cursorPoint
from: 0
to: aClass selectors size
during:
[:bar |
aClass selectors doWithIndex:
[:sel :i | | source |
bar value: i.
self addMethodFor: aClass selector: sel]].
aClass declareCVarsIn: self!
Item was changed:
----- Method: CCodeGenerator>>addMethod: (in category 'utilities') -----
addMethod: aTMethod
"Add the given method to the code base and answer it.
Only allow duplicate definitions for struct accessors, since we don't actually
generate code for these methods and hence the conflict doesn't matter."
(methods at: aTMethod selector ifAbsent: []) ifNotNil:
[:conflict |
aTMethod compiledMethod isSubclassResponsibility ifTrue:
[^nil].
(conflict isStructAccessor
and: [aTMethod isStructAccessor
and: [conflict compiledMethod decompileString = aTMethod compiledMethod decompileString]]) ifTrue:
[^nil].
+ (conflict definingClass inheritsFrom: aTMethod definingClass) ifTrue:
+ [^nil].
self error: 'Method name conflict: ', aTMethod selector].
^methods at: aTMethod selector put: aTMethod!
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].
+ method isSubclassResponsibility ifTrue:
+ [^nil].
(self shouldIncludeMethodFor: aClass selector: selector) ifFalse:
[^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 changed:
----- Method: CCodeGenerator>>checkClassForNameConflicts: (in category 'error notification') -----
checkClassForNameConflicts: aClass
"Verify that the given class does not have constant, variable, or method names that conflict with
those of previously added classes. Raise an error if a conflict is found, otherwise just return."
"check for constant name collisions in class pools"
aClass classPool associationsDo:
[:assoc |
(constants includesKey: assoc key asString) ifTrue:
[self error: 'Constant ', assoc key, ' was defined in a previously added class']].
"and in shared pools"
(aClass sharedPools reject: [:pool| pools includes: pool]) do:
[:pool |
pool bindingsDo:
[:assoc |
(constants includesKey: assoc key asString) ifTrue:
[self error: 'Constant ', assoc key, ' was defined in a previously added class']]].
"check for instance variable name collisions"
(aClass inheritsFrom: VMStructType) ifFalse:
+ [(self instVarNamesForClass: aClass) do:
- [aClass instVarNames do:
[:varName |
(variables includes: varName) ifTrue:
[self error: 'Instance variable ', varName, ' was defined in a previously added class']]].
"check for method name collisions"
aClass selectors do:
+ [:sel | | tmeth meth |
+ ((tmeth := methods at: sel ifAbsent: nil) notNil
- [:sel | | meth |
- ((methods includesKey: sel)
and: [(aClass isStructClass and: [(aClass isAccessor: sel)
and: [(methods at: sel) isStructAccessor]]) not
and: [((meth := aClass compiledMethodAt: sel) pragmaAt: #doNotGenerate) isNil
+ and: [meth isSubclassResponsibility not
+ and: [(tmeth definingClass inheritsFrom: aClass) not]]]]) ifTrue:
- and: [meth isSubclassResponsibility not]]]) ifTrue:
[self error: 'Method ', sel, ' was defined in a previously added class.']]!
Item was added:
+ ----- Method: CCodeGenerator>>instVarNamesForClass: (in category 'utilities') -----
+ instVarNamesForClass: aClass
+ ((vmClass
+ ifNil: [aClass instVarNames]
+ ifNotNil: [aClass instVarNames reject:
+ [:ivn| vmClass isNonArgumentImplicitReceiverVariableName: ivn]]) includes: 'manager') ifTrue:
+ [self halt: aClass name].
+ ^vmClass
+ ifNil: [aClass instVarNames]
+ ifNotNil: [aClass instVarNames reject:
+ [:ivn| vmClass isNonArgumentImplicitReceiverVariableName: ivn]]!
Item was changed:
----- Method: CCodeGenerator>>prepareMethods (in category 'utilities') -----
prepareMethods
| globals |
globals := Set new: 200.
globals addAll: variables.
methods do:
[:m |
m locals, m args do:
[:var |
(globals includes: var) ifTrue:
+ [self error: 'Local variable ''', var, ''' may mask global when inlining ', m selector].
- [self error: 'Local variable name may mask global when inlining: ' , var].
((methods at: var ifAbsent: [nil]) ifNil: [false] ifNotNil: [:m1| m1 isStructAccessor not]) ifTrue:
[logger
ensureCr;
+ nextPutAll: 'Local variable name ''', var, ''' in ';
- nextPutAll: 'Local variable name ', var, ' in ';
nextPutAll: m selector;
+ nextPutAll: ' may mask method when inlining']].
- nextPutAll: ' may mask method when inlining: ' , var]].
m bindClassVariablesIn: constants.
m prepareMethodIn: self]!
Item was changed:
----- Method: CoInterpreter class>>isNonArgumentImplicitReceiverVariableName: (in category 'translation') -----
isNonArgumentImplicitReceiverVariableName: aString
+ ^(#('self' 'stackPages' 'cogit' 'coInterpreter' 'cogMethodZone' 'interpreter' 'objectMemory') includes: aString)
+ or: [self objectMemoryClass isNonArgumentImplicitReceiverVariableName: aString]!
- ^#('self' 'stackPages' 'cogit' 'coInterpreter' 'cogMethodZone' 'objectMemory' 'interpreter' 'heapMap') includes: aString!
Item was changed:
----- Method: CoInterpreter>>commonCallerReturn (in category 'return bytecodes') -----
commonCallerReturn
"Return to the previous context/frame (sender for method activations, caller for block activations)."
<sharedCodeNamed: 'commonCallerReturn' inCase: #returnTopFromBlock>
| callersFPOrNull |
<var: #callersFPOrNull type: #'char *'>
callersFPOrNull := self frameCallerFP: localFP.
callersFPOrNull == 0 "baseFrame" ifTrue:
[self assert: localFP = stackPage baseFP.
^self baseFrameReturn].
localIP := self frameCallerSavedIP: localFP.
localSP := localFP + (self frameStackedReceiverOffset: localFP).
localFP := callersFPOrNull.
localIP asUnsignedInteger < objectMemory startOfMemory ifTrue:
[localIP asUnsignedInteger ~= cogit ceReturnToInterpreterPC ifTrue:
["localIP in the cog method zone indicates a return to machine code."
^self returnToMachineCodeFrame].
localIP := self pointerForOop: (self iframeSavedIP: localFP)].
self setMethod: (self iframeMethod: localFP).
self fetchNextBytecode.
+ self internalStackTopPut: localReturnValue!
- ^self internalStackTopPut: localReturnValue!
Item was changed:
----- Method: CoInterpreter>>itemporary:in:put: (in category 'internal interpreter access') -----
itemporary: offset in: theFP put: valueOop
"Temporary access for an interpreter frame only."
"See StackInterpreter class>>initializeFrameIndices"
| frameNumArgs |
<inline: true>
<var: #theFP type: #'char *'>
+ ^offset < (frameNumArgs := self iframeNumArgs: theFP)
- offset < (frameNumArgs := self iframeNumArgs: theFP)
ifTrue: [stackPages longAt: theFP + FoxCallerSavedIP + ((frameNumArgs - offset) * BytesPerWord) put: valueOop]
ifFalse: [stackPages longAt: theFP + FoxIFReceiver - BytesPerWord + ((frameNumArgs - offset) * BytesPerWord) put: valueOop]!
Item was changed:
----- Method: CogObjectRepresentation>>genInnerPrimitiveNewWithArg: (in category 'primitive generators') -----
genInnerPrimitiveNewWithArg: retNoffset
+ self subclassResponsibility!
- self subclassResponsibility.
- ^0!
Item was changed:
----- Method: CogObjectRepresentationFor32BitSpur>>genInnerPrimitiveAt: (in category 'primitive generators') -----
genInnerPrimitiveAt: retNoffset
"Implement the guts of primitiveAt; dispatch on size"
- <returnTypeC: #'AbstractInstruction *'>
| formatReg jumpNotIndexable jumpSmallSize jumpImmediate jumpBadIndex
jumpBytesDone jumpShortsDone jumpWordsDone jumpFixedFieldsDone
jumpIsBytes jumpIsShorts jumpIsWords jumpWordTooBig jumpIsArray jumpHasFixedFields jumpIsContext
jumpBytesOutOfBounds jumpShortsOutOfBounds jumpWordsOutOfBounds jumpArrayOutOfBounds jumpFixedFieldsOutOfBounds |
<inline: true>
"c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
<var: #jumpIsBytes type: #'AbstractInstruction *'>
<var: #jumpIsShorts type: #'AbstractInstruction *'>
<var: #jumpBadIndex type: #'AbstractInstruction *'>
<var: #jumpSmallSize type: #'AbstractInstruction *'>
<var: #jumpIsContext type: #'AbstractInstruction *'>
<var: #jumpImmediate type: #'AbstractInstruction *'>
<var: #jumpBytesDone type: #'AbstractInstruction *'>
<var: #jumpShortsDone type: #'AbstractInstruction *'>
<var: #jumpWordsDone type: #'AbstractInstruction *'>
<var: #jumpWordTooBig type: #'AbstractInstruction *'>
<var: #jumpNotIndexable type: #'AbstractInstruction *'>
<var: #jumpHasFixedFields type: #'AbstractInstruction *'>
<var: #jumpFixedFieldsDone type: #'AbstractInstruction *'>
<var: #jumpArrayOutOfBounds type: #'AbstractInstruction *'>
<var: #jumpBytesOutOfBounds type: #'AbstractInstruction *'>
<var: #jumpShortsOutOfBounds type: #'AbstractInstruction *'>
<var: #jumpWordsOutOfBounds type: #'AbstractInstruction *'>
<var: #jumpFixedFieldsOutOfBounds type: #'AbstractInstruction *'>
cogit MoveR: ReceiverResultReg R: TempReg.
jumpImmediate := self genJumpImmediateInScratchReg: TempReg.
cogit MoveR: Arg0Reg R: TempReg.
jumpBadIndex := self genJumpNotSmallIntegerInScratchReg: TempReg.
self genConvertSmallIntegerToIntegerInScratchReg: Arg0Reg.
cogit SubCq: 1 R: Arg0Reg. "1-rel => 0-rel"
formatReg := SendNumArgsReg.
cogit
MoveMw: 0 r: ReceiverResultReg R: formatReg; "formatReg := least significant half of self baseHeader: receiver"
MoveR: formatReg R: TempReg;
LogicalShiftRightCq: objectMemory formatShift R: formatReg;
AndCq: objectMemory formatMask R: formatReg. "formatReg := self formatOfHeader: destReg"
"get numSlots into ClassReg."
cogit MoveCq: 0 R: ClassReg. "N.B. MoveMb:r:R: does not zero other bits"
cogit MoveMb: 7 r: ReceiverResultReg R: ClassReg. "MSB of header"
cogit CmpCq: objectMemory numSlotsMask R: ClassReg.
jumpSmallSize := cogit JumpLess: 0.
cogit MoveMw: -8 r: ReceiverResultReg R: ClassReg. "LSW of overflow size header"
"dispatch on format in a combination of highest dynamic frequency order first and convenience.
0 = 0 sized objects (UndefinedObject True False et al)
1 = non-indexable objects with inst vars (Point et al)
2 = indexable objects with no inst vars (Array et al)
3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
4 = weak indexable objects with inst vars (WeakArray et al)
5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
6 unused, reserved for exotic pointer objects?
7 Forwarded Object, 1st field is pointer, rest of fields are ignored
8 unused, reserved for exotic non-pointer objects?
9 (?) 64-bit indexable
10 - 11 32-bit indexable
12 - 15 16-bit indexable
16 - 23 byte indexable
24 - 31 compiled method"
jumpSmallSize jmpTarget:
(cogit CmpCq: objectMemory firstByteFormat R: formatReg).
jumpIsBytes := cogit JumpGreaterOrEqual: 0.
cogit CmpCq: objectMemory arrayFormat R: formatReg.
jumpIsArray := cogit JumpZero: 0.
jumpNotIndexable := cogit JumpLess: 0.
cogit CmpCq: objectMemory weakArrayFormat R: formatReg.
jumpHasFixedFields := cogit JumpLessOrEqual: 0.
cogit CmpCq: objectMemory firstShortFormat R: formatReg.
jumpIsShorts := cogit JumpGreaterOrEqual: 0.
cogit CmpCq: objectMemory firstLongFormat R: formatReg.
jumpIsWords := cogit JumpGreaterOrEqual: 0.
"For now ignore 64-bit indexability."
jumpNotIndexable jmpTarget: cogit Label.
jumpNotIndexable := cogit Jump: 0.
jumpIsBytes jmpTarget:
(cogit LogicalShiftLeftCq: objectMemory shiftForWord R: ClassReg).
cogit AndCq: objectMemory wordSize - 1 R: formatReg.
cogit SubR: formatReg R: ClassReg;
CmpR: Arg0Reg R: ClassReg.
jumpBytesOutOfBounds := cogit JumpAboveOrEqual: 0.
cogit AddCq: objectMemory baseHeaderSize R: Arg0Reg.
cogit MoveXbr: Arg0Reg R: ReceiverResultReg R: ReceiverResultReg.
self genConvertIntegerToSmallIntegerInScratchReg: ReceiverResultReg.
jumpBytesDone := cogit Jump: 0.
jumpIsShorts jmpTarget:
(cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: ClassReg).
cogit AndCq: 1 R: formatReg.
cogit SubR: formatReg R: ClassReg;
CmpR: Arg0Reg R: ClassReg.
jumpShortsOutOfBounds := cogit JumpAboveOrEqual: 0.
cogit AddR: Arg0Reg R: ReceiverResultReg.
cogit MoveM16: objectMemory baseHeaderSize r: ReceiverResultReg R: ReceiverResultReg.
self genConvertIntegerToSmallIntegerInScratchReg: ReceiverResultReg.
jumpShortsDone := cogit Jump: 0.
jumpIsWords jmpTarget:
(cogit CmpR: Arg0Reg R: ClassReg).
jumpWordsOutOfBounds := cogit JumpAboveOrEqual: 0.
cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
cogit MoveXwr: Arg0Reg R: ReceiverResultReg R: TempReg.
cogit SubCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
jumpWordTooBig := self jumpNotSmallIntegerUnsignedValueInRegister: TempReg.
cogit MoveR: TempReg R: ReceiverResultReg.
self genConvertIntegerToSmallIntegerInScratchReg: ReceiverResultReg.
jumpWordsDone := cogit Jump: 0.
jumpHasFixedFields jmpTarget:
(cogit AndCq: objectMemory classIndexMask R: TempReg).
cogit CmpCq: ClassMethodContextCompactIndex R: TempReg.
cogit MoveR: TempReg R: formatReg.
cogit CmpCq: ClassMethodContextCompactIndex R: TempReg.
jumpIsContext := cogit JumpZero: 0.
cogit PushR: ClassReg.
self genGetClassObjectOfClassIndex: formatReg into: ClassReg scratchReg: TempReg.
self genLoadSlot: InstanceSpecificationIndex sourceReg: ClassReg destReg: formatReg.
cogit PopR: ClassReg.
self genConvertSmallIntegerToIntegerInScratchReg: formatReg.
cogit
AndCq: objectMemory fixedFieldsOfClassFormatMask R: formatReg;
SubR: formatReg R: ClassReg;
CmpR: Arg0Reg R: ClassReg.
jumpFixedFieldsOutOfBounds := cogit JumpAboveOrEqual: 0.
"index is (formatReg (fixed fields) + Arg0Reg (0-rel index)) * wordSize + baseHeaderSize"
cogit AddR: formatReg R: Arg0Reg.
cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
cogit MoveXwr: Arg0Reg R: ReceiverResultReg R: ReceiverResultReg.
jumpFixedFieldsDone := cogit Jump: 0.
jumpIsArray jmpTarget:
(cogit CmpR: Arg0Reg R: ClassReg).
jumpArrayOutOfBounds := cogit JumpAboveOrEqual: 0.
cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
cogit MoveXwr: Arg0Reg R: ReceiverResultReg R: ReceiverResultReg.
jumpFixedFieldsDone jmpTarget:
(jumpWordsDone jmpTarget:
(jumpShortsDone jmpTarget:
(jumpBytesDone jmpTarget:
(cogit RetN: retNoffset)))).
jumpFixedFieldsOutOfBounds jmpTarget:
(jumpArrayOutOfBounds jmpTarget:
(jumpBytesOutOfBounds jmpTarget:
(jumpShortsOutOfBounds jmpTarget:
(jumpWordsOutOfBounds jmpTarget:
(jumpWordTooBig jmpTarget:
(jumpNotIndexable jmpTarget:
(jumpIsContext jmpTarget: cogit Label))))))).
cogit AddCq: 1 R: Arg0Reg. "0-rel => 1-rel"
self genConvertIntegerToSmallIntegerInScratchReg: Arg0Reg.
(jumpBadIndex jmpTarget: (jumpImmediate jmpTarget: cogit Label)).
^0!
Item was changed:
----- Method: CogObjectRepresentationFor32BitSpur>>genInnerPrimitiveStringAt: (in category 'primitive generators') -----
genInnerPrimitiveStringAt: retNoffset
"Implement the guts of primitiveStringAt; dispatch on size"
- <returnTypeC: #'AbstractInstruction *'>
| formatReg jumpNotIndexable jumpSmallSize jumpBadIndex done
jumpIsBytes jumpIsShorts jumpIsWords jumpWordTooBig
jumpBytesOutOfBounds jumpShortsOutOfBounds jumpWordsOutOfBounds |
<inline: true>
"c.f. StackInterpreter>>stSizeOf: SpurMemoryManager>>lengthOf:format: fixedFieldsOf:format:length:"
<var: #done type: #'AbstractInstruction *'>
<var: #jumpIsBytes type: #'AbstractInstruction *'>
<var: #jumpIsShorts type: #'AbstractInstruction *'>
<var: #jumpIsWords type: #'AbstractInstruction *'>
<var: #jumpBadIndex type: #'AbstractInstruction *'>
<var: #jumpSmallSize type: #'AbstractInstruction *'>
<var: #jumpWordTooBig type: #'AbstractInstruction *'>
<var: #jumpNotIndexable type: #'AbstractInstruction *'>
<var: #jumpBytesOutOfBounds type: #'AbstractInstruction *'>
<var: #jumpShortsOutOfBounds type: #'AbstractInstruction *'>
<var: #jumpWordsOutOfBounds type: #'AbstractInstruction *'>
cogit MoveR: Arg0Reg R: TempReg.
jumpBadIndex := self genJumpNotSmallIntegerInScratchReg: TempReg.
self genConvertSmallIntegerToIntegerInScratchReg: Arg0Reg.
cogit SubCq: 1 R: Arg0Reg. "1-rel => 0-rel"
formatReg := SendNumArgsReg.
cogit
MoveMw: 0 r: ReceiverResultReg R: formatReg; "formatReg := least significant half of self baseHeader: receiver"
MoveR: formatReg R: TempReg;
LogicalShiftRightCq: objectMemory formatShift R: formatReg;
AndCq: objectMemory formatMask R: formatReg. "formatReg := self formatOfHeader: destReg"
"get numSlots into ClassReg."
cogit MoveCq: 0 R: ClassReg. "N.B. MoveMb:r:R: does not zero other bits"
cogit MoveMb: 7 r: ReceiverResultReg R: ClassReg. "MSB of header"
cogit CmpCq: objectMemory numSlotsMask R: ClassReg.
jumpSmallSize := cogit JumpLess: 0.
cogit MoveMw: -8 r: ReceiverResultReg R: ClassReg. "LSW of overflow size header"
"dispatch on format in a combination of highest dynamic frequency order first and convenience.
0 = 0 sized objects (UndefinedObject True False et al)
1 = non-indexable objects with inst vars (Point et al)
2 = indexable objects with no inst vars (Array et al)
3 = indexable objects with inst vars (MethodContext AdditionalMethodState et al)
4 = weak indexable objects with inst vars (WeakArray et al)
5 = weak non-indexable objects with inst vars (ephemerons) (Ephemeron)
6 unused, reserved for exotic pointer objects?
7 Forwarded Object, 1st field is pointer, rest of fields are ignored
8 unused, reserved for exotic non-pointer objects?
9 (?) 64-bit indexable
10 - 11 32-bit indexable
12 - 15 16-bit indexable
16 - 23 byte indexable
24 - 31 compiled method"
jumpSmallSize jmpTarget:
(cogit CmpCq: objectMemory firstByteFormat R: formatReg).
jumpIsBytes := cogit JumpGreaterOrEqual: 0.
cogit CmpCq: objectMemory firstShortFormat R: formatReg.
jumpIsShorts := cogit JumpGreaterOrEqual: 0.
cogit CmpCq: objectMemory firstLongFormat R: formatReg.
jumpIsWords := cogit JumpGreaterOrEqual: 0.
jumpNotIndexable := cogit Jump: 0.
jumpIsBytes jmpTarget:
(cogit LogicalShiftLeftCq: objectMemory shiftForWord R: ClassReg).
cogit AndCq: objectMemory wordSize - 1 R: formatReg.
cogit SubR: formatReg R: ClassReg;
CmpR: Arg0Reg R: ClassReg.
jumpBytesOutOfBounds := cogit JumpAboveOrEqual: 0.
cogit AddCq: objectMemory baseHeaderSize R: Arg0Reg.
cogit MoveXbr: Arg0Reg R: ReceiverResultReg R: ReceiverResultReg.
done := cogit Label.
self genConvertIntegerToCharacterInScratchReg: ReceiverResultReg.
cogit RetN: retNoffset.
jumpIsShorts jmpTarget:
(cogit LogicalShiftLeftCq: objectMemory shiftForWord - 1 R: ClassReg).
cogit AndCq: 1 R: formatReg.
cogit SubR: formatReg R: ClassReg;
CmpR: Arg0Reg R: ClassReg.
jumpShortsOutOfBounds := cogit JumpAboveOrEqual: 0.
cogit AddR: Arg0Reg R: ReceiverResultReg.
cogit MoveM16: objectMemory baseHeaderSize r: ReceiverResultReg R: ReceiverResultReg.
cogit Jump: done.
jumpIsWords jmpTarget:
(cogit CmpR: Arg0Reg R: ClassReg).
jumpWordsOutOfBounds := cogit JumpAboveOrEqual: 0.
cogit AddCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
cogit MoveXwr: Arg0Reg R: ReceiverResultReg R: TempReg.
cogit SubCq: objectMemory baseHeaderSize >> objectMemory shiftForWord R: Arg0Reg.
jumpWordTooBig := self jumpNotCharacterUnsignedValueInRegister: TempReg.
cogit MoveR: TempReg R: ReceiverResultReg.
cogit Jump: done.
jumpBytesOutOfBounds jmpTarget:
(jumpShortsOutOfBounds jmpTarget:
(jumpWordsOutOfBounds jmpTarget:
(jumpWordTooBig jmpTarget:
(jumpNotIndexable jmpTarget: cogit Label)))).
cogit AddCq: 1 R: Arg0Reg. "0-rel => 1-rel"
self genConvertIntegerToSmallIntegerInScratchReg: Arg0Reg.
jumpBadIndex jmpTarget: cogit Label.
^0!
Item was changed:
----- Method: Cogit class>>isNonArgumentImplicitReceiverVariableName: (in category 'translation') -----
isNonArgumentImplicitReceiverVariableName: aString
^#('cogit' 'coInterpreter'
'methodZone'
+ 'objectMemory' 'objectRepresentation' 'manager') includes: aString!
- 'objectMemory' 'objectRepresentation') includes: aString!
Item was changed:
----- Method: InterpreterPrimitives>>primitiveCompareBytes (in category 'indexing primitives') -----
primitiveCompareBytes
"Primitive. Compare two byte-indexed objects for equality"
| arg1 arg2 len1 len2 |
<export: true>
+ argumentCount = 1 ifFalse:[self primitiveFail. ^self].
- argumentCount = 1 ifFalse:[^self primitiveFail].
arg1 := self stackValue: 1.
arg2 := self stackValue: 0.
((objectMemory isBytes: arg1) and:[objectMemory isBytes: arg2])
+ ifFalse:[self primitiveFail. ^self].
- ifFalse:[^self primitiveFail].
"Quick identity test"
(arg1 = arg2) ifTrue:[^self pop: 2 thenPush: objectMemory trueObject].
len1 := objectMemory byteSizeOf: arg1.
len2 := objectMemory byteSizeOf: arg2.
len1 = len2 ifFalse:[^self pop: 2 thenPush: objectMemory falseObject].
0 to: len1-1 do:[:i|
(objectMemory fetchByte: i ofObject: arg1) = (objectMemory fetchByte: i ofObject: arg2)
ifFalse:[^self pop: 2 thenPush: objectMemory falseObject]].
self pop: 2 thenPush: objectMemory trueObject.
!
Item was changed:
----- Method: SpurMemoryManager>>addToFreeTree:bytes: (in category 'free space') -----
addToFreeTree: freeChunk bytes: chunkBytes
"Add freeChunk to the large free chunk tree.
For the benefit of sortedFreeObject:, answer the treeNode it is added
to, if it is added to the next list of a freeTreeNode, otherwise answer 0."
| childBytes parent child |
self assert: chunkBytes = (self bytesInObject: freeChunk).
self assert: chunkBytes / self allocationUnit >= self numFreeLists.
self
storePointer: self freeChunkNextIndex ofFreeChunk: freeChunk withValue: 0;
storePointer: self freeChunkParentIndex ofFreeChunk: freeChunk withValue: 0;
storePointer: self freeChunkSmallerIndex ofFreeChunk: freeChunk withValue: 0;
storePointer: self freeChunkLargerIndex ofFreeChunk: freeChunk withValue: 0.
"Large chunk list organized as a tree, each node of which is a list of chunks of the same size.
Beneath the node are smaller and larger blocks."
parent := 0.
child := freeLists at: 0.
[child ~= 0] whileTrue:
[childBytes := self bytesInObject: child.
childBytes = chunkBytes ifTrue: "size match; add to list at node."
[self storePointer: self freeChunkNextIndex
ofFreeChunk: freeChunk
withValue: (self fetchPointer: self freeChunkNextIndex ofObject: child);
storePointer: self freeChunkNextIndex
ofFreeChunk: child
withValue: freeChunk.
^child].
"walk down the tree"
parent := child.
child := self fetchPointer: (childBytes > chunkBytes
ifTrue: [self freeChunkSmallerIndex]
ifFalse: [self freeChunkLargerIndex])
+ ofFreeChunk: child].
- ofObject: child].
parent = 0 ifTrue:
[self assert: (freeLists at: 0) = 0.
freeLists at: 0 put: freeChunk.
freeListsMask := freeListsMask bitOr: 1.
^0].
self assert: (freeListsMask anyMask: 1).
"insert in tree"
self storePointer: self freeChunkParentIndex
ofFreeChunk: freeChunk
withValue: parent.
self storePointer: (childBytes > chunkBytes
ifTrue: [self freeChunkSmallerIndex]
ifFalse: [self freeChunkLargerIndex])
ofFreeChunk: parent
withValue: freeChunk.
^0!
Item was changed:
----- Method: SpurMemoryManager>>setHeapBase:memoryLimit:endOfMemory: (in category 'snapshot') -----
+ setHeapBase: baseOfHeap memoryLimit: memLimit endOfMemory: memEnd
- setHeapBase: heapBase memoryLimit: memLimit endOfMemory: memEnd
"Transcript
+ cr; nextPutAll: 'heapBase: '; print: baseOfHeap; nextPut: $/; nextPutAll: baseOfHeap hex;
- cr; nextPutAll: 'heapBase: '; print: heapBase; nextPut: $/; nextPutAll: heapBase hex;
nextPutAll: ' memLimit '; print: memLimit; nextPut: $/; nextPutAll: memLimit hex;
nextPutAll: ' memEnd '; print: memEnd; nextPut: $/; nextPutAll: memEnd hex; cr; flush."
+ startOfMemory := baseOfHeap.
+ newSpaceLimit := baseOfHeap
- startOfMemory := heapBase.
- newSpaceLimit := heapBase
+ self newSpaceBytes
+ coInterpreter interpreterAllocationReserveBytes.
freeOldSpaceStart := memEnd.
endOfMemory := memLimit.
scavenger
+ newSpaceStart: baseOfHeap
+ newSpaceBytes: newSpaceLimit - baseOfHeap
+ edenBytes: newSpaceLimit - baseOfHeap
- newSpaceStart: heapBase
- newSpaceBytes: newSpaceLimit - heapBase
- edenBytes: newSpaceLimit - heapBase
* (self scavengerDenominator - self numSurvivorSpaces) // self scavengerDenominator.
freeStart := scavenger eden start.
pastSpaceStart := scavenger pastSpace start!
Item was changed:
----- Method: StackInterpreter>>followField:in: (in category 'lazy become') -----
followField: fieldIndex in: anObject
"Make sure the oop at fieldIndex in anObject is not forwarded (follow the
+ forwarder there-in if so). Answer the (possibly followed) oop at fieldIndex.
+ N.B. the oop is assumed to be non-immediate."
+ | objOop |
+ objOop := objectMemory fetchPointer: fieldIndex ofObject: anObject.
+ self assert: (objectMemory isNonImmediate: objOop).
+ (objectMemory isForwarded: objOop) ifTrue:
+ [objOop := objectMemory followForwarded: objOop.
+ objectMemory storePointer: fieldIndex ofObject: anObject withValue: objOop].
+ ^objOop!
- forwarder there-in if so). Answer the (possibly followed) oop at fieldIndex."
- | field |
- field := objectMemory fetchPointer: fieldIndex ofObject: anObject.
- (objectMemory isForwarded: field) ifTrue:
- [field := objectMemory followForwarded: field.
- objectMemory storePointer: fieldIndex ofObject: anObject withValue: field].
- ^field!
Item was changed:
----- Method: StackInterpreter>>printOop: (in category 'debug printing') -----
printOop: oop
| cls fmt lastIndex startIP bytecodesPerLine column |
<inline: false>
(objectMemory isImmediate: oop) ifTrue:
[^self shortPrintOop: oop].
self printHex: oop.
(objectMemory addressCouldBeObj: oop) ifFalse:
+ [^self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
- [self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
ifTrue: [' is misaligned']
+ ifFalse: [' is not on the heap']); cr].
- ifFalse: [' is not on the heap']); cr.
- ^nil].
(objectMemory isFreeObject: oop) ifTrue:
+ [^self print: ' is a free chunk of size '; printNum: (objectMemory sizeOfFree: oop); cr].
- [self print: ' is a free chunk of size '; printNum: (objectMemory sizeOfFree: oop); cr.
- ^nil].
(objectMemory isForwarded: oop) ifTrue:
+ [^self
- [self
print: ' is a forwarded object to '; printHex: (objectMemory followForwarded: oop);
+ print: ' of slot size '; printNum: (objectMemory numSlotsOfAny: oop); cr].
- print: ' of slot size '; printNum: (objectMemory numSlotsOfAny: oop); cr.
- ^nil].
self print: ': a(n) '.
self printNameOfClass: (cls := objectMemory fetchClassOfNonImm: oop) count: 5.
cls = (objectMemory splObj: ClassFloat) ifTrue:
+ [^self cr; printFloat: (self dbgFloatValueOf: oop); cr].
- [self cr; printFloat: (self dbgFloatValueOf: oop); cr.
- ^nil].
fmt := objectMemory formatOf: oop.
fmt > objectMemory lastPointerFormat ifTrue:
[self print: ' nbytes '; printNum: (objectMemory byteLengthOf: oop)].
self cr.
(fmt between: objectMemory firstLongFormat and: objectMemory firstCompiledMethodFormat - 1) ifTrue:
["This will answer false if splObj: ClassAlien is nilObject"
(self is: oop KindOfClass: (objectMemory splObj: ClassAlien)) ifTrue:
[self print: ' datasize '; printNum: (self sizeOfAlienData: oop).
self print: ((self isIndirectAlien: oop)
ifTrue: [' indirect @ ']
ifFalse:
[(self isPointerAlien: oop)
ifTrue: [' pointer @ ']
ifFalse: [' direct @ ']]).
+ ^self printHex: (self startOfAlienData: oop) asUnsignedInteger; cr].
- self printHex: (self startOfAlienData: oop) asUnsignedInteger; cr.
- ^nil].
(objectMemory isWords: oop) ifTrue:
[lastIndex := 64 min: ((objectMemory byteLengthOf: oop) / BytesPerWord).
lastIndex > 0 ifTrue:
[1 to: lastIndex do:
[:index|
self space; printHex: (objectMemory fetchLong32: index - 1 ofObject: oop).
(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
[self cr]].
(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
[self cr]].
+ ^self].
- ^nil].
^self printStringOf: oop; cr].
"this is nonsense. apologies."
startIP := (objectMemory lastPointerOf: oop) + BytesPerOop - objectMemory baseHeaderSize / BytesPerOop.
lastIndex := 256 min: startIP.
lastIndex > 0 ifTrue:
[1 to: lastIndex do:
[:index|
self cCode: [self printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space]
inSmalltalk: [self space; printHex: (objectMemory fetchPointer: index - 1 ofObject: oop); space.
self print: (self shortPrint: (objectMemory fetchPointer: index - 1 ofObject: oop))].
(index \\ self elementsPerPrintOopLine) = 0 ifTrue:
[self cr]].
(lastIndex \\ self elementsPerPrintOopLine) = 0 ifFalse:
[self cr]].
(objectMemory isCompiledMethod: oop)
ifFalse:
[startIP > 64 ifTrue: [self print: '...'; cr]]
ifTrue:
[startIP := startIP * BytesPerWord + 1.
lastIndex := objectMemory lengthOf: oop.
lastIndex - startIP > 100 ifTrue:
[lastIndex := startIP + 100].
bytecodesPerLine := 8.
column := 1.
startIP to: lastIndex do:
[:index| | byte |
column = 1 ifTrue:
[self cCode: 'printf("0x%08x: ", oop+BaseHeaderSize+index-1)'
inSmalltalk: [self print: (oop+BaseHeaderSize+index-1) hex; print: ': ']].
byte := objectMemory fetchByte: index - 1 ofObject: oop.
self cCode: 'printf(" %02x/%-3d", byte,byte)'
inSmalltalk: [self space; print: (byte radix: 16); printChar: $/; printNum: byte].
column := column + 1.
column > bytecodesPerLine ifTrue:
[column := 1. self cr]].
column = 1 ifFalse:
[self cr]]!
Item was changed:
----- Method: StackInterpreter>>shortPrintOop: (in category 'debug printing') -----
shortPrintOop: oop
<inline: false>
self printHexnp: oop.
(objectMemory isImmediate: oop) ifTrue:
[(objectMemory isImmediateCharacter: oop) ifTrue:
+ [self
- [^self
cCode: 'printf("=$%ld ($%lc)\n", (long)characterValueOf(oop), (wint_t)characterValueOf(oop))'
inSmalltalk: [self print: (self shortPrint: oop); cr]].
+ (objectMemory isIntegerObject: oop) ifTrue:
+ [self
+ cCode: 'printf("=%ld\n", (long)integerValueOf(oop))'
+ inSmalltalk: [self print: (self shortPrint: oop); cr]].
+ ^self].
- ^self
- cCode: 'printf("=%ld\n", (long)integerValueOf(oop))'
- inSmalltalk: [self print: (self shortPrint: oop); cr]].
(objectMemory addressCouldBeObj: oop) ifFalse:
+ [^self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
- [self print: ((oop bitAnd: objectMemory allocationUnit - 1) ~= 0
ifTrue: [' is misaligned']
+ ifFalse: [' is not on the heap']); cr].
- ifFalse: [' is not on the heap']); cr.
- ^nil].
((objectMemory isFreeObject: oop)
or: [objectMemory isForwarded: oop]) ifTrue:
[^self printOop: oop].
self print: ': a(n) '.
self printNameOfClass: (objectMemory fetchClassOfNonImm: oop) count: 5.
self cr!
Item was changed:
----- Method: StackInterpreter>>storeLiteralVariable:withValue: (in category 'stack bytecodes') -----
storeLiteralVariable: literalIndex withValue: anObject
| litVar |
litVar := self literal: literalIndex.
"push/store/popLiteralVariable all fetch a literal, and either read or write the literal's value field.
The fetch of the literal needs an explicit check (otherwise we would have to scan all literals in
all methods in the stack zone, and the entire method on return, and global variables are relatively
rare; in my work image 8.7% of literals are globals)."
(objectMemory isForwarded: litVar) ifTrue:
[litVar := objectMemory followForwarded: litVar].
+ ^objectMemory storePointer: ValueIndex ofObject: litVar withValue: anObject!
- objectMemory storePointer: ValueIndex ofObject: litVar withValue: anObject!
Item was changed:
----- Method: TMethod>>inferReturnTypeFromReturnsIn: (in category 'type inference') -----
inferReturnTypeFromReturnsIn: aCodeGen
"Attempt to infer the return type of the receiver from returns in the parse tree."
+ "this for determining which returns have which return types:"
+ "aCodeGen
+ pushScope: declarations
+ while: [parseTree
+ nodesSelect: [:n| n isReturn]
+ thenCollect: [:n| | s |
+ s := Set new.
+ self addTypesFor: n expression to: s in: aCodeGen.
+ {n. s}]]"
returnType ifNil: "the initial default"
[aCodeGen
pushScope: declarations
while:
[| hasReturn returnTypes |
hasReturn := false.
returnTypes := Set new.
parseTree nodesDo:
[:node|
node isReturn ifTrue:
[hasReturn := true.
self addTypesFor: node expression to: returnTypes in: aCodeGen]].
returnTypes remove: #implicit ifAbsent: [].
returnTypes := aCodeGen harmonizeReturnTypesIn: returnTypes.
hasReturn
ifTrue:
[returnTypes size > 1 ifTrue:
[aCodeGen logger show:
(String streamContents:
[:s|
s nextPutAll: 'conflicting return types '.
returnTypes
do: [:t| s nextPutAll: t]
separatedBy: [s nextPutAll: ', '].
s nextPutAll: ' in '; nextPutAll: selector; cr])].
returnTypes size = 1 ifTrue:
[self returnType: returnTypes anyOne]]
ifFalse:
[self returnType: (aCodeGen implicitReturnTypeFor: selector)]]]!
Item was added:
+ ----- Method: TParseNode>>nodesSelect:thenCollect: (in category 'enumerating') -----
+ nodesSelect: selectBlock thenCollect: collectBlock
+ | result |
+ result := OrderedCollection new.
+ self nodesDo:
+ [:node|
+ (selectBlock value: node) ifTrue:
+ [result addLast: (collectBlock value: node)]].
+ ^result!
Item was added:
+ ----- Method: VMMaker class>>generateSqueakSpurCogVM (in category 'configurations') -----
+ generateSqueakSpurCogVM
+ ^VMMaker
+ generate: (Smalltalk at: ([:choices| choices at: (UIManager default chooseFrom: choices) ifAbsent: [^self]]
+ value: #(CoInterpreter CoInterpreterMT)))
+ and: StackToRegisterMappingCogit
+ with: #( ObjectMemory Spur32BitCoMemoryManager
+ MULTIPLEBYTECODESETS false
+ NewspeakVM false)
+ to: (FileDirectory default pathFromURI: 'oscogvm/spursrc')
+ platformDir: (FileDirectory default pathFromURI: 'oscogvm/platforms')
+ including:#()!
More information about the Vm-dev
mailing list