[Vm-dev] VM Maker: VMMaker.oscog-eem.1323.mcz
commits at source.squeak.org
commits at source.squeak.org
Sun May 24 02:09:38 UTC 2015
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1323.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.1323
Author: eem
Time: 23 May 2015, 7:07:35.921 pm
UUID: 95fb28f1-4ac9-434c-adb9-b0a3111e70ad
Ancestors: VMMaker.oscog-EstebanLorenzano.1322
Merge with Pharo (with VMMaker.oscog-EstebanLorenzano.1322).
Fix PIC creation on ARM to jive with new pc-relative addressing
support (addressIsInCurrentCompilation:).
Move the specifics of NoDbgRegParms out of VMMaker.
Assume it is defined in the various sqPlatformSpecific.h (see r3356).
=============== Diff against VMMaker.oscog-EstebanLorenzano.1322 ===============
Item was changed:
+ SystemOrganization addCategory: #'VMMaker-Building'!
+ SystemOrganization addCategory: #'VMMaker-Interpreter'!
+ SystemOrganization addCategory: #'VMMaker-InterpreterSimulation'!
+ SystemOrganization addCategory: #'VMMaker-InterpreterSimulation-Morphic'!
+ SystemOrganization addCategory: #'VMMaker-JIT'!
+ SystemOrganization addCategory: #'VMMaker-JITSimulation'!
+ SystemOrganization addCategory: #'VMMaker-Multithreading'!
+ SystemOrganization addCategory: #'VMMaker-Plugins'!
+ SystemOrganization addCategory: #'VMMaker-Plugins-Alien'!
+ SystemOrganization addCategory: #'VMMaker-Plugins-IOS'!
+ SystemOrganization addCategory: #'VMMaker-PostProcessing'!
+ SystemOrganization addCategory: #'VMMaker-SmartSyntaxPlugins'!
+ SystemOrganization addCategory: #'VMMaker-SpurMemoryManager'!
+ SystemOrganization addCategory: #'VMMaker-SpurMemoryManagerSimulation'!
+ SystemOrganization addCategory: #'VMMaker-Support'!
+ SystemOrganization addCategory: #'VMMaker-Tests'!
+ SystemOrganization addCategory: #'VMMaker-Translation to C'!
- SystemOrganization addCategory: #VMMaker!
- SystemOrganization addCategory: 'VMMaker-Building'!
- SystemOrganization addCategory: 'VMMaker-Interpreter'!
- SystemOrganization addCategory: 'VMMaker-InterpreterSimulation'!
- SystemOrganization addCategory: 'VMMaker-InterpreterSimulation-Morphic'!
- SystemOrganization addCategory: 'VMMaker-JIT'!
- SystemOrganization addCategory: 'VMMaker-JITSimulation'!
- SystemOrganization addCategory: 'VMMaker-Multithreading'!
- SystemOrganization addCategory: 'VMMaker-Plugins'!
- SystemOrganization addCategory: 'VMMaker-Plugins-Alien'!
- SystemOrganization addCategory: 'VMMaker-Plugins-IOS'!
- SystemOrganization addCategory: 'VMMaker-PostProcessing'!
- SystemOrganization addCategory: 'VMMaker-SmartSyntaxPlugins'!
- SystemOrganization addCategory: 'VMMaker-SpurMemoryManager'!
- SystemOrganization addCategory: 'VMMaker-SpurMemoryManagerSimulation'!
- SystemOrganization addCategory: 'VMMaker-Support'!
- SystemOrganization addCategory: 'VMMaker-Tests'!
- SystemOrganization addCategory: 'VMMaker-Translation to C'!
Item was changed:
----- Method: CCodeGenerator>>emitCFunctionPrototypes:on: (in category 'C code generator') -----
emitCFunctionPrototypes: methodList on: aStream
"Store prototype declarations for all non-inlined methods on the given stream."
| exporting |
aStream cr; nextPutAll: '/*** Function Prototypes ***/'; cr.
+ "Add a define for a NoDbgRegParms attribute for static functions used for debugging.
+ gcc and other compilers will use non-standard calling conventions for static functions
+ when optimizing. This can render the functions unusable in gdb. The sqConfig.h file
+ for the platform should define PlatformNoDbgRegParms suitably for the platform's
+ compiler, if the compiler can be persuaded not to generate such functions."
+ "Add a define for a NeverInline attribute that tells the compiler never to inline functions
+ with the attribute. We mark functions we want to observe in a profiler as NeverInline.
+ The sqConfig.h file for the platform should define NeverInline suitably for the platform's
+ compiler, if the compiler can be persuaded not to inline certain functions."
- "Hmm, this should be in the sqConfig.h files. For now put it here..."
- "Feel free to add equivalents for other compilers"
vmClass notNil ifTrue:
[NoRegParmsInAssertVMs ifTrue:
+ [aStream nextPutAll: '\\#if !!PRODUCTION && defined(PlatformNoDbgRegParms)\# define NoDbgRegParms PlatformNoDbgRegParms\#endif' withCRs.
- [aStream nextPutAll: '\\#if !!PRODUCTION && defined(__GNUC__) && !!(defined(__MINGW32__) || defined(__MINGW64__)) && !!defined(NoDbgRegParms)\# define NoDbgRegParms __attribute__ ((regparm (0)))\#endif' withCRs.
aStream nextPutAll: '\\#if !!defined(NoDbgRegParms)\# define NoDbgRegParms /*empty*/\#endif\\' withCRs].
- aStream nextPutAll: '\\#if defined(__GNUC__) && !!defined(NeverInline)\# define NeverInline __attribute__ ((noinline))\#endif' withCRs.
aStream nextPutAll: '\\#if !!defined(NeverInline)\# define NeverInline /*empty*/\#endif\\' withCRs].
exporting := false.
(methodList select: [:m| m isRealMethod
and: [self shouldGenerateMethod: m]]) do:
[:m |
self emitExportPragma ifTrue:
[m export
ifTrue: [exporting ifFalse:
[aStream nextPutAll: '#pragma export on'; cr.
exporting := true]]
ifFalse: [exporting ifTrue:
[aStream nextPutAll: '#pragma export off'; cr.
exporting := false]]].
m emitCFunctionPrototype: aStream generator: self.
(NoRegParmsInAssertVMs and: [vmClass notNil and: [m export not and: [m isStatic and: [m args notEmpty]]]]) ifTrue:
[aStream nextPutAll: ' NoDbgRegParms'].
(vmClass notNil and: [m inline == #never]) ifTrue:
[aStream nextPutAll: ' NeverInline'].
aStream nextPut: $; ; cr].
exporting ifTrue: [aStream nextPutAll: '#pragma export off'; cr].
aStream cr!
Item was changed:
----- Method: CCodeGenerator>>emitGlobalCVariablesOn: (in category 'C code generator') -----
emitGlobalCVariablesOn: aStream
"Store the global variable declarations on the given stream."
aStream cr; nextPutAll: '/*** Global Variables ***/'; cr.
(self sortStrings: (variables select: [:v| vmClass mustBeGlobal: v])) do:
[:var | | varString decl |
varString := var asString.
decl := variableDeclarations at: varString ifAbsent: ['sqInt ' , varString].
decl first == $# "support cgen var: #bytecodeSetSelector declareC: '#define bytecodeSetSelector 0' hack"
ifTrue:
[aStream nextPutAll: decl; cr]
ifFalse:
+ [(decl includesSubString: ' private ') ifFalse: "work-around hack to prevent localization of variables only referenced once."
+ [(decl beginsWith: 'static') ifFalse: [aStream nextPutAll: 'VM_EXPORT '].
- [
- ((decl includesSubString: ' private ')
- "or: [decl beginsWith: 'static']") ifFalse: "work-around hack to prevent localization of variables only referenced once."
- [
- PharoVM ifTrue:
- [(decl beginsWith: 'static') ifFalse: [aStream nextPutAll: 'VM_EXPORT ']].
(decl includes: $=) ifTrue:
[decl := decl copyFrom: 1 to: (decl indexOf: $=) - 1].
aStream
nextPutAll: decl;
nextPut: $;;
cr]]].
aStream cr!
Item was changed:
----- Method: CCodeGenerator>>interpreterVersion (in category 'accessing') -----
interpreterVersion
+ ^self vmClass interpreterVersion, '[', self vmClass objectMemoryClass memoryManagerVersion, ']'!
- | memoryManagerVersion |
- memoryManagerVersion := (self options at: #ObjectMemory ifAbsent: [ #ObjectMemory ]) asClass memoryManagerVersion.
- ^ self vmClass interpreterVersion, '[', memoryManagerVersion,']'!
Item was removed:
- ----- Method: CCodeGenerator>>isThreadedVM (in category 'testing') -----
- isThreadedVM
- ^ self vmClass isThreadedVM!
Item was changed:
----- Method: CCodeGenerator>>storeAPIExportHeader:OnFile: (in category 'public') -----
storeAPIExportHeader: headerName OnFile: fullHeaderPath
"Store C header code on the given file. Evaluate
aBlock with the stream to generate its contents."
| header |
header := String streamContents:
[:s|
s nextPutAll: (self fileHeaderVersionStampForSourceClass: nil); cr.
self emitCAPIExportHeaderOn: s].
(self needToGenerateHeader: headerName file: fullHeaderPath contents: header) ifTrue:
[self storeHeaderOnFile: fullHeaderPath contents: header]!
Item was changed:
----- Method: CCodeGenerator>>storeHeaderOnFile:contents: (in category 'public') -----
storeHeaderOnFile: fileName contents: contents
"Store C header code on the given file. Evaluate
aBlock with the stream to generate its contents."
| aStream |
aStream := VMMaker forceNewFileNamed: fileName.
aStream ifNil: [Error signal: 'Could not open C header file: ', fileName].
[(contents beginsWith: '/* Automatic') ifFalse:
[aStream nextPutAll: (self fileHeaderVersionStampForSourceClass: nil); cr].
aStream nextPutAll: contents]
ensure: [aStream close]!
Item was changed:
----- Method: CCodeGenerator>>structClassesForTranslationClasses: (in category 'utilities') -----
structClassesForTranslationClasses: classes
"Answer in superclass order (any superclass precedes any subclass)
the ancilliaryClasses that are struct classes for all the given classes."
| theStructClasses |
theStructClasses := OrderedCollection new.
classes do:
[:aTranslationClass|
([aTranslationClass ancilliaryClasses: self options]
on: MessageNotUnderstood
do: [:ex|
ex message selector == #ancilliaryClasses:
ifTrue: [#()]
ifFalse: [ex pass]]) do:
[:class|
(class isStructClass
and: [(vmClass isNil or: [vmClass isAcceptableAncilliaryClass: class])
and: [(theStructClasses includes: class) not]]) ifTrue:
[theStructClasses addLast: class]]].
^ChangeSet superclassOrder: theStructClasses!
Item was changed:
----- Method: CoInterpreter class>>declareCVarsIn: (in category 'translation') -----
declareCVarsIn: aCCodeGenerator
"Override to avoid repeating StackInterpreter's declarations and add our own extensions"
self class == thisContext methodClass ifFalse: [^self]. "Don't duplicate decls in subclasses"
aCCodeGenerator
addHeaderFile:'"sqCogStackAlignment.h"';
addHeaderFile:'"cogmethod.h"'.
NewspeakVM ifTrue:
[aCCodeGenerator addHeaderFile:'"nssendcache.h"'].
aCCodeGenerator
+ addHeaderFile: (aCCodeGenerator vmClass isThreadedVM
- addHeaderFile: (aCCodeGenerator isThreadedVM
ifTrue: ['"cointerpmt.h"']
ifFalse: ['"cointerp.h"']);
addHeaderFile:'"cogit.h"'.
aCCodeGenerator vmClass
declareInterpreterVersionIn: aCCodeGenerator
defaultName: aCCodeGenerator interpreterVersion.
aCCodeGenerator
var: #heapBase type: #usqInt;
var: #statCodeCompactionUsecs type: #usqLong;
var: #maxLiteralCountForCompile
declareC: 'sqInt maxLiteralCountForCompile = MaxLiteralCountForCompile /* ', MaxLiteralCountForCompile printString, ' */';
var: #minBackwardJumpCountForCompile
declareC: 'sqInt minBackwardJumpCountForCompile = MinBackwardJumpCountForCompile /* ', MinBackwardJumpCountForCompile printString, ' */'.
aCCodeGenerator
var: #reenterInterpreter
declareC: 'jmp_buf reenterInterpreter; /* private export */'.
aCCodeGenerator
var: #primTraceLogIndex type: #'unsigned char';
var: #primTraceLog declareC: 'sqInt primTraceLog[256]';
var: #traceLog
declareC: 'sqInt traceLog[TraceBufferSize /* ', TraceBufferSize printString, ' */]';
var: #traceSources type: #'char *' array: TraceSources!
Item was changed:
----- Method: CogARMCompiler>>sub:rn:imm:ror: (in category 'ARM convenience instructions') -----
sub: destReg rn: srcReg imm: immediate ror: rot
" Remember the ROR is doubled by the cpu so use 30>>1 etc
SUB destReg, srcReg, #immediate ROR rot"
^self type: 1 op: SubOpcode set: 0 rn: srcReg rd: destReg shifterOperand: ((rot>>1) <<8 bitOr: immediate)!
Item was changed:
----- Method: CogMethodSurrogate32 class>>alignedByteSize (in category 'accessing') -----
alignedByteSize
^20 + self baseHeaderSize!
Item was changed:
----- Method: CogMethodSurrogate64 class>>alignedByteSize (in category 'accessing') -----
alignedByteSize
^32 + self baseHeaderSize!
Item was changed:
----- Method: CogObjectRepresentationFor32BitSpur>>genGetInlineCacheClassTagFrom:into:forEntry: (in category 'compile abstract instructions') -----
genGetInlineCacheClassTagFrom: sourceReg into: destReg forEntry: forEntry
"Extract the inline cache tag for the object in sourceReg into destReg. The inline
cache tag for a given object is the value loaded in inline caches to distinguish
objects of different classes. In Spur this is either the tags for immediates, (with
1 & 3 collapsed to 1 for SmallIntegers, and 2 collapsed to 0 for Characters), or
the receiver's classIndex.
If forEntry is true answer the entry label at which control is to enter (cmEntryOffset).
If forEntry is false, control enters at the start.
+ If forEntry is true, generate something like this:
- If forEntry is false, generate something like this:
Limm:
andl $0x1, rDest
j Lcmp
Lentry:
movl rSource, rDest
andl $0x3, rDest
jnz Limm
movl 0(%edx), rDest
andl $0x3fffff, rDest
Lcmp:
+ If forEntry is false, generate something like the following.
- If forEntry is true, generate something like the following.
At least on a 2.2GHz Intel Core i7 the following is slightly faster than the above,
136m sends/sec vs 130m sends/sec for nfib in tinyBenchmarks
Lentry:
movl rSource, rDest
andl $0x3, rDest
jz LnotImm
andl $1, rDest
j Lcmp
LnotImm:
movl 0(%edx), rDest
andl $0x3fffff, rDest
Lcmp:
But we expect most SmallInteger arithmetic to be performed in-line and so prefer the
version that is faster for non-immediates (because it branches for immediates only)."
| immLabel jumpNotImm entryLabel jumpCompare |
<var: #immLabel type: #'AbstractInstruction *'>
<var: #jumpNotImm type: #'AbstractInstruction *'>
<var: #entryLabel type: #'AbstractInstruction *'>
<var: #jumpCompare type: #'AbstractInstruction *'>
forEntry
ifFalse:
[entryLabel := cogit Label.
cogit AndCq: objectMemory tagMask R: sourceReg R: destReg.
jumpNotImm := cogit JumpZero: 0.
cogit AndCq: 1 R: destReg.
jumpCompare := cogit Jump: 0.
"Get least significant half of header word in destReg"
self flag: #endianness.
jumpNotImm jmpTarget:
(cogit MoveMw: 0 r: sourceReg R: destReg).
jumpCompare jmpTarget:
(cogit AndCq: objectMemory classIndexMask R: destReg)]
ifTrue:
[cogit AlignmentNops: objectMemory wordSize.
immLabel := cogit Label.
cogit AndCq: 1 R: destReg.
jumpCompare := cogit Jump: 0.
cogit AlignmentNops: objectMemory wordSize.
entryLabel := cogit Label.
cogit AndCq: objectMemory tagMask R: sourceReg R: destReg.
cogit JumpNonZero: immLabel.
self flag: #endianness.
"Get least significant half of header word in destReg"
cogit MoveMw: 0 r: sourceReg R: destReg.
cogit AndCq: objectMemory classIndexMask R: destReg.
jumpCompare jmpTarget: cogit Label].
^entryLabel!
Item was changed:
----- Method: Cogit>>cogExtendPIC:CaseNMethod:tag:isMNUCase: (in category 'in-line cacheing') -----
cogExtendPIC: cPIC CaseNMethod: caseNMethod tag: caseNTag isMNUCase: isMNUCase
"Extend the cPIC with the supplied case. If caseNMethod is cogged dispatch direct to
its unchecked entry-point. If caseNMethod is not cogged, jump to the fast interpreter
dispatch, and if isMNUCase then dispatch to fast MNU invocation and mark the cPIC as
having the MNU case for cache flushing."
<var: #cPIC type: #'CogMethod *'>
| operand target address size end |
"stack allocate the various collections so that they
are effectively garbage collected on return."
coInterpreter
compilationBreak: cPIC selector
point: (objectMemory numBytesOf: cPIC selector)
isMNUCase: isMNUCase.
self allocateOpcodes: 5 bytecodes: 0.
+ methodLabel address: cPIC asUnsignedInteger; dependent: nil. "for pc-relative MoveCw: cPIC R: ClassReg"
self assert: (objectRepresentation inlineCacheTagIsYoung: caseNTag) not.
"Caller patches to open pic if caseNMethod is young."
self assert: (caseNMethod notNil and: [(objectMemory isYoung: caseNMethod) not]).
(isMNUCase not
and: [coInterpreter methodHasCogMethod: caseNMethod])
ifTrue:
[operand := 0.
target := (coInterpreter cogMethodOf: caseNMethod) asInteger + cmNoCheckEntryOffset]
ifFalse:
[isMNUCase ifTrue:
[cPIC cpicHasMNUCase: true].
operand := caseNMethod.
target := cPIC asInteger
+ (isMNUCase
ifTrue: [self sizeof: CogMethod]
ifFalse: [self interpretOffset - backEnd callInstructionByteSize])].
self CmpCw: caseNTag R: TempReg.
self MoveCw: operand R: SendNumArgsReg.
self JumpLongZero: target.
+ self MoveCw: cPIC asUnsignedInteger R: ClassReg.
- self MoveCw: cPIC asInteger R: ClassReg.
self JumpLong: (self cPICMissTrampolineFor: cPIC cmNumArgs).
-
self computeMaximumSizes.
address := self addressOfEndOfCase: cPIC cPICNumCases - 1 inCPIC: cPIC.
size := self generateInstructionsAt: address.
end := self outputInstructionsAt: address.
processor flushICacheFrom: cPIC asInteger to: cPIC asInteger + closedPICSize.
cPIC cPICNumCases: cPIC cPICNumCases + 1.
^0!
Item was changed:
----- Method: Cogit>>cogMNUPICSelector:receiver:methodOperand:numArgs: (in category 'in-line cacheing') -----
cogMNUPICSelector: selector receiver: rcvr methodOperand: methodOperand numArgs: numArgs
<api>
"Attempt to create a one-case PIC for an MNU.
The tag for the case is at the send site and so doesn't need to be generated."
<returnTypeC: #'CogMethod *'>
| startAddress size end |
((objectMemory isYoung: selector)
or: [(objectRepresentation inlineCacheTagForInstance: rcvr) = self picAbortDiscriminatorValue]) ifTrue:
[^0].
coInterpreter
compilationBreak: selector
point: (objectMemory numBytesOf: selector)
isMNUCase: true.
self assert: endCPICCase0 notNil.
startAddress := methodZone allocate: closedPICSize.
startAddress = 0 ifTrue:
[coInterpreter callForCogCompiledCodeCompaction.
^0].
- methodLabel
- address: startAddress;
- dependent: nil.
"stack allocate the various collections so that they
are effectively garbage collected on return."
self allocateOpcodes: numPICCases * 7 bytecodes: 0.
+ methodLabel address: startAddress; dependent: nil. "for pc-relative MoveCw: cPIC R: ClassReg"
self compileMNUCPIC: (self cCoerceSimple: startAddress to: #'CogMethod *')
methodOperand: methodOperand
numArgs: numArgs.
self computeMaximumSizes.
- methodLabel concretizeAt: startAddress.
size := self generateInstructionsAt: startAddress + (self sizeof: CogMethod).
end := self outputInstructionsAt: startAddress + (self sizeof: CogMethod).
"The missOffset is the same as the interpretOffset. On RISCs it includes an additional instruction."
self assert: missOffset = ((backEnd hasLinkRegister ifTrue: [backEnd callInstructionByteSize] ifFalse: [0])
+ picInterpretAbort address + picInterpretAbort machineCodeSize - startAddress).
self assert: startAddress + cmEntryOffset = entry address.
^self
fillInCPICHeader: (self cCoerceSimple: startAddress to: #'CogMethod *')
numArgs: numArgs
numCases: 1
hasMNUCase: true
selector: selector !
Item was changed:
----- Method: Cogit>>cogPICSelector:numArgs:Case0Method:Case1Method:tag:isMNUCase: (in category 'in-line cacheing') -----
cogPICSelector: selector numArgs: numArgs Case0Method: case0CogMethod Case1Method: case1MethodOrNil tag: case1Tag isMNUCase: isMNUCase
"Attempt to create a two-case PIC for case0CogMethod and case1Method,case1Tag.
The tag for case0CogMethod is at the send site and so doesn't need to be generated.
case1Method may be any of
- a Cog method; link to its unchecked entry-point
- a CompiledMethod; link to ceInterpretMethodFromPIC:
- a CompiledMethod; link to ceMNUFromPICMNUMethod:receiver:"
<var: #case0CogMethod type: #'CogMethod *'>
<returnTypeC: #'CogMethod *'>
| startAddress size end |
(objectMemory isYoung: selector) ifTrue:
[^self cCoerceSimple: YoungSelectorInPIC to: #'CogMethod *'].
coInterpreter
compilationBreak: selector
point: (objectMemory numBytesOf: selector)
isMNUCase: isMNUCase.
startAddress := methodZone allocate: closedPICSize.
startAddress = 0 ifTrue:
[^self cCoerceSimple: InsufficientCodeSpace to: #'CogMethod *'].
- methodLabel
- address: startAddress;
- dependent: nil.
"stack allocate the various collections so that they
are effectively garbage collected on return."
self allocateOpcodes: numPICCases * 7 bytecodes: 0.
+ methodLabel address: startAddress; dependent: nil. "for pc-relative MoveCw: cPIC R: ClassReg"
self compileCPIC: (self cCoerceSimple: startAddress to: #'CogMethod *')
Case0: case0CogMethod
Case1Method: case1MethodOrNil
tag: case1Tag
isMNUCase: isMNUCase
numArgs: numArgs.
self computeMaximumSizes.
- methodLabel concretizeAt: startAddress.
size := self generateInstructionsAt: startAddress + (self sizeof: CogMethod).
end := self outputInstructionsAt: startAddress + (self sizeof: CogMethod).
"The missOffset is the same as the interpretOffset. On RISCs it includes an additional instruction."
self assert: missOffset = ((backEnd hasLinkRegister ifTrue: [backEnd callInstructionByteSize] ifFalse: [0])
+ picInterpretAbort address + picInterpretAbort machineCodeSize - startAddress).
self assert: startAddress + cmEntryOffset = entry address.
self assert: endCPICCase0 address = (startAddress + firstCPICCaseOffset).
self assert: endCPICCase1 address = (startAddress + firstCPICCaseOffset + cPICCaseSize).
^self
fillInCPICHeader: (self cCoerceSimple: startAddress to: #'CogMethod *')
numArgs: numArgs
numCases: 2
hasMNUCase: isMNUCase
selector: selector !
Item was changed:
----- Method: Cogit>>compileCPIC:Case0:Case1Method:tag:isMNUCase:numArgs: (in category 'in-line cacheing') -----
compileCPIC: cPIC Case0: case0CogMethod Case1Method: case1Method tag: case1Tag isMNUCase: isMNUCase numArgs: numArgs
"Compile the code for a two-case PIC for case0CogMethod and case1Method,case1Tag.
The tag for case0CogMethod is at the send site and so doesn't need to be generated.
case1Method may be any of
- a Cog method; jump to its unchecked entry-point
- a CompiledMethod; jump to the ceInterpretFromPIC trampoline
- nil; call ceMNUFromPIC"
<var: #cPIC type: #'CogMethod *'>
| operand targetEntry jumpNext |
<var: #case0CogMethod type: #'CogMethod *'>
<var: #targetEntry type: #'void *'>
<var: #jumpNext type: #'AbstractInstruction *'>
self assert: case1Method notNil.
self compilePICAbort: numArgs.
self assert: (objectRepresentation inlineCacheTagIsYoung: case1Tag) not.
(isMNUCase not
and: [coInterpreter methodHasCogMethod: case1Method])
ifTrue:
[operand := 0.
targetEntry := ((coInterpreter cogMethodOf: case1Method) asInteger + cmNoCheckEntryOffset) asVoidPointer]
ifFalse: "We do not scavenge PICs, hence we cannot cache the MNU method if it is in new space."
[operand := (case1Method isNil or: [objectMemory isYoungObject: case1Method])
ifTrue: [0]
ifFalse: [case1Method].
targetEntry := case1Method isNil ifTrue: [picMNUAbort] ifFalse: [picInterpretAbort]].
jumpNext := self compileCPICEntry.
self MoveCw: 0 R: SendNumArgsReg.
self JumpLong: case0CogMethod asInteger + cmNoCheckEntryOffset.
endCPICCase0 := self CmpCw: case1Tag R: TempReg.
jumpNext jmpTarget: endCPICCase0.
self MoveCw: operand R: SendNumArgsReg.
self JumpLongZero: (isMNUCase ifTrue: [picMNUAbort] ifFalse: [targetEntry]) asInteger.
+ endCPICCase1 := self MoveCw: cPIC asUnsignedInteger R: ClassReg.
- endCPICCase1 := self MoveCw: cPIC asInteger R: ClassReg.
self JumpLong: (self cPICMissTrampolineFor: numArgs).
^0
!
Item was changed:
----- Method: Cogit>>compileClosedPICPrototype (in category 'in-line cacheing') -----
compileClosedPICPrototype
"Compile the abstract instructions for a full closed PIC used to initialize closedPICSize.
The loads into SendNumArgsReg are those for optional method objects which may be
used in MNU cases."
+ <inline: true>
| numArgs jumpNext |
<var: #jumpNext type: #'AbstractInstruction *'>
numArgs := 0.
self compilePICAbort: numArgs.
jumpNext := self compileCPICEntry.
self MoveCw: 16r5EAF00D R: SendNumArgsReg.
self JumpLong: methodZoneBase + 16rCA5E10.
jumpNext jmpTarget: (endCPICCase0 := self Label).
1 to: numPICCases - 1 do:
[:h|
self CmpCw: 16rBABE1F15+h R: TempReg.
self MoveCw: 16rBADA550 + h R: SendNumArgsReg.
self JumpLongZero: 16rCA5E10 + (h * 16).
h = 1 ifTrue:
[endCPICCase1 := self Label]].
+ self MoveCw: methodLabel address R: ClassReg.
- self MoveCw: methodZoneBase R: ClassReg.
self JumpLong: (self cPICMissTrampolineFor: numArgs).
^0!
Item was changed:
----- Method: Cogit>>compileMNUCPIC:methodOperand:numArgs: (in category 'in-line cacheing') -----
compileMNUCPIC: cPIC methodOperand: methodOperand numArgs: numArgs
"Compile the code for a one-case MNU PIC that calls ceMNUFromPIC for case0Tag
The tag for case0 is at the send site and so doesn't need to be generated."
<var: #cPIC type: #'CogMethod *'>
| jumpNext operand |
<var: #jumpNext type: #'AbstractInstruction *'>
self compilePICAbort: numArgs.
jumpNext := self compileCPICEntry.
"We do not scavenge PICs, hence we cannot cache the MNU method if it is in new space."
operand := (methodOperand isNil or: [objectMemory isYoungObject: methodOperand])
ifTrue: [0]
ifFalse: [methodOperand].
self MoveCw: operand R: SendNumArgsReg.
self JumpLong: picMNUAbort asInteger.
+ jumpNext jmpTarget: (self MoveCw: cPIC asUnsignedInteger R: ClassReg).
- jumpNext jmpTarget: (self MoveCw: cPIC asInteger R: ClassReg).
self JumpLong: (self cPICMissTrampolineFor: numArgs).
^0
!
Item was changed:
----- Method: Cogit>>generateClosedPICPrototype (in category 'initialization') -----
generateClosedPICPrototype
"Generate the prototype ClosedPIC to determine how much space as full PIC takes.
When we first allocate a closed PIC it only has one or two cases and we want to grow it.
So we have to determine how big a full one is before hand."
numPICCases := 6.
- methodLabel
- address: methodZoneBase;
- dependent: nil.
"stack allocate the various collections so that they
are effectively garbage collected on return."
self allocateOpcodes: numPICCases * 7 bytecodes: 0.
+ methodLabel address: methodZoneBase; dependent: nil. "for pc-relative MoveCw: cPIC R: ClassReg"
self compileClosedPICPrototype.
self computeMaximumSizes.
- methodLabel concretizeAt: methodZoneBase.
closedPICSize := (self sizeof: CogMethod) + (self generateInstructionsAt: methodZoneBase + (self sizeof: CogMethod)).
firstCPICCaseOffset := endCPICCase0 address - methodZoneBase.
cPICCaseSize := endCPICCase1 address - endCPICCase0 address.
cPICEndSize := closedPICSize - (numPICCases - 1 * cPICCaseSize + firstCPICCaseOffset).
closedPICSize := methodZone roundUpLength: closedPICSize
"self cCode: ''
inSmalltalk:
[| end |
end := self outputInstructionsAt: methodZoneBase + headerSize.
self disassembleFrom: methodZoneBase + headerSize to: end - 1.
self halt]"!
Item was changed:
----- Method: FilePlugin>>makeDirEntryName:size:createDate:modDate:isDir:fileSize:posixPermissions:isSymlink: (in category 'directory primitives') -----
makeDirEntryName: entryName size: entryNameSize createDate: createDate modDate: modifiedDate isDir: dirFlag fileSize: fileSize posixPermissions: posixPermissions isSymlink: symlinkFlag
+ <var: 'entryName' type: 'char *'>
+ <var: 'fileSize' type: 'squeakFileOffsetType '>
+ <option: #PharoVM>
| modDateOop createDateOop nameString results stringPtr posixPermissionsOop fileSizeOop |
-
- <var: 'entryName' type: 'char *'>
<var: 'stringPtr' type: 'char *'>
- <var: 'fileSize' type: 'squeakFileOffsetType '>
"allocate storage for results, remapping newly allocated
oops in case GC happens during allocation"
interpreterProxy pushRemappableOop:
(interpreterProxy instantiateClass: (interpreterProxy classArray) indexableSize: 7).
interpreterProxy pushRemappableOop:
(interpreterProxy instantiateClass: (interpreterProxy classString) indexableSize: entryNameSize).
interpreterProxy pushRemappableOop:
(interpreterProxy positive32BitIntegerFor: createDate).
interpreterProxy pushRemappableOop:
(interpreterProxy positive32BitIntegerFor: modifiedDate).
interpreterProxy pushRemappableOop:
(interpreterProxy positive64BitIntegerFor: fileSize).
interpreterProxy pushRemappableOop:
(interpreterProxy positive32BitIntegerFor: posixPermissions).
posixPermissionsOop := interpreterProxy popRemappableOop.
fileSizeOop := interpreterProxy popRemappableOop.
modDateOop := interpreterProxy popRemappableOop.
createDateOop := interpreterProxy popRemappableOop.
nameString := interpreterProxy popRemappableOop.
results := interpreterProxy popRemappableOop.
"copy name into Smalltalk string"
stringPtr := interpreterProxy firstIndexableField: nameString.
0 to: entryNameSize - 1 do: [ :i |
stringPtr at: i put: (entryName at: i).
].
interpreterProxy storePointer: 0 ofObject: results withValue: nameString.
interpreterProxy storePointer: 1 ofObject: results withValue: createDateOop.
interpreterProxy storePointer: 2 ofObject: results withValue: modDateOop.
dirFlag
ifTrue: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy trueObject ]
ifFalse: [ interpreterProxy storePointer: 3 ofObject: results withValue: interpreterProxy falseObject ].
interpreterProxy storePointer: 4 ofObject: results withValue: fileSizeOop.
interpreterProxy storePointer: 5 ofObject: results withValue: posixPermissionsOop.
symlinkFlag
ifTrue: [ interpreterProxy storePointer: 6 ofObject: results withValue: interpreterProxy trueObject ]
ifFalse: [ interpreterProxy storePointer: 6 ofObject: results withValue: interpreterProxy falseObject ].
^ results!
Item was changed:
----- Method: Integer>>asUnsignedInteger (in category '*VMMaker-interpreter simulator') -----
asUnsignedInteger
self assert: self >= 0.
^self!
Item was changed:
----- Method: InterpreterPlugin class>>shouldBeTranslated (in category 'translation') -----
shouldBeTranslated
"is this class intended to be translated as a plugin? Most subclasses should answer true, but some such as:-
TestInterpreterPlugin
FlippArrayPlugin2
InflatePlugin
should answer false for various reasons."
^true!
Item was changed:
----- Method: InterpreterPlugin class>>shouldBeTranslatedFor: (in category 'translation') -----
shouldBeTranslatedFor: platformName
"Is this class intended to be translated as a plugin, perhaps specific to a platform?
Most subclasses should answer true, but some such as simulation-only versions
should answer false for various reasons."
^self shouldBeTranslated!
Item was changed:
----- Method: InterpreterProxy>>isImmediate: (in category 'testing') -----
isImmediate: anObject
<option: #(atLeastVMProxyMajor:minor: 1 13)>
^StackInterpreter objectMemoryClass isImmediate: anObject!
Item was changed:
----- Method: SpurGenerationScavenger>>copyAndForward: (in category 'scavenger') -----
copyAndForward: survivor
"copyAndForward: survivor copies a survivor object either to
futureSurvivorSpace or, if it is to be promoted, to oldSpace.
It leaves a forwarding pointer behind. If the object is weak
then corpse is threaded onto the weakList for later treatment."
<inline: false>
| bytesInObj format tenure newLocation |
self assert: ((manager isInEden: survivor) "cog methods should be excluded."
or: [manager isInPastSpace: survivor]).
bytesInObj := manager bytesInObject: survivor.
format := manager formatOf: survivor.
tenure := self shouldBeTenured: survivor. "Allow Slang to inline."
newLocation := (tenure or: [futureSurvivorStart + bytesInObj > futureSpace limit])
ifTrue: [self copyToOldSpace: survivor bytes: bytesInObj format: format]
ifFalse: [self copyToFutureSpace: survivor bytes: bytesInObj].
manager forwardSurvivor: survivor to: newLocation.
"if weak or ephemeron add to the relevant list for subsequent scanning."
(manager isWeakFormat: format) ifTrue:
[self addToWeakList: survivor].
((manager isEphemeronFormat: format)
and: [(self isScavengeSurvivor: (manager keyOfEphemeron: newLocation)) not]) ifTrue:
[self addToEphemeronList: survivor].
^newLocation!
Item was changed:
----- Method: SpurMemoryManager>>isForwarded: (in category 'object testing') -----
isForwarded: objOop
"Answer if objOop is that if a forwarder. Take advantage of isForwardedObjectClassIndexPun
being a power of two to generate a more efficient test than the straight-forward
(self classIndexOf: objOop) = self isForwardedObjectClassIndexPun
at the cost of this being ambiguous with free chunks. So either never apply this to free chunks
or guard with (self isFreeObject: foo) not. So far the idiom has been to guard with isFreeObject:"
<api>
<inline: true>
"self assert: (self isFreeObject: objOop) not."
^(self longAt: objOop) noMask: self classIndexMask - self isForwardedObjectClassIndexPun!
Item was changed:
----- Method: StackInterpreter>>codeGeneratorToComputeAccessorDepth (in category 'primitive support') -----
codeGeneratorToComputeAccessorDepth
^VMMaker new
buildCodeGeneratorForInterpreter: self class primitivesClass
includeAPIMethods: false
initializeClasses: false!
Item was changed:
----- Method: StackInterpreter>>primitiveIndexOfMethod:header: (in category 'compiled methods') -----
primitiveIndexOfMethod: theMethod header: methodHeader
"Note: With the Squeak V0 format we now have 10 bits of primitive index, but they are in
two places for temporary backward compatibility. The time to unpack is negligible,
since the derived primitive function pointer is stored in the method cache. With the new
format we assume a 3-byte CallPrimitive with a little-endian 16-bit primitive index."
<api>
<inline: true>
| firstBytecode |
^objectMemory hasSpurMemoryManagerAPI
ifTrue:
[(self alternateHeaderHasPrimitiveFlag: methodHeader)
ifTrue:
[firstBytecode := self firstBytecodeOfAlternateHeader: methodHeader method: theMethod.
(objectMemory byteAt: firstBytecode + 1) + ((objectMemory byteAt: firstBytecode + 2) << 8)]
ifFalse:
[0]]
ifFalse:
[MULTIPLEBYTECODESETS
ifTrue:
[(self headerIndicatesAlternateBytecodeSet: methodHeader)
ifTrue:
[(self alternateHeaderHasPrimitiveFlag: methodHeader)
ifTrue:
[firstBytecode := self firstBytecodeOfAlternateHeader: methodHeader method: theMethod.
(objectMemory byteAt: firstBytecode + 1) + ((objectMemory byteAt: firstBytecode + 2) << 8)]
ifFalse:
[0]]
ifFalse:
[| primBits |
primBits := objectMemory integerValueOf: methodHeader.
(primBits bitAnd: 16r1FF) + (primBits >> 19 bitAnd: 16r200)]]
ifFalse:
[| primBits |
primBits := objectMemory integerValueOf: methodHeader.
(primBits bitAnd: 16r1FF) + (primBits >> 19 bitAnd: 16r200)]]!
Item was changed:
----- Method: StackInterpreterSimulator>>runAtEachStep: (in category 'testing') -----
runAtEachStep: aBlock
self initStackPages.
self loadInitialContext.
self internalizeIPandSP.
self fetchNextBytecode.
[true] whileTrue:
[self assertValidExecutionPointers.
aBlock value: currentBytecode.
self dispatchOn: currentBytecode in: BytecodeTable.
self incrementByteCount].
localIP := localIP - 1.
"undo the pre-increment of IP before returning"
self externalizeIPandSP!
Item was changed:
----- Method: TAssignmentNode>>emitCCodeAsExpressionOn:level:generator: (in category 'C code generation') -----
emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen
aStream nextPut: $(.
self emitCCodeOn: aStream level: level generator: aCodeGen.
aStream nextPut: $)!
Item was changed:
----- Method: TParseNode>>emitCCodeAsArgumentOn:level:generator: (in category 'C code generation') -----
emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen
^self emitCCodeOn: aStream level: level generator: aCodeGen!
Item was changed:
----- Method: TParseNode>>emitCCodeAsExpressionOn:level:generator: (in category 'C code generation') -----
emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen
^self emitCCodeOn: aStream level: level generator: aCodeGen!
Item was changed:
----- Method: TSendNode>>emitCCodeAsExpressionOn:level:generator: (in category 'C code generation') -----
emitCCodeAsExpressionOn: aStream level: level generator: aCodeGen
^self emitCCodeAsArgumentOn: aStream level: level generator: aCodeGen!
Item was changed:
----- Method: VMClass class>>initializePrimitiveErrorCodes (in category 'initialization') -----
initializePrimitiveErrorCodes
"Define the VM's primitive error codes. N.B. these are
replicated in platforms/Cross/vm/sqVirtualMachine.h."
"VMClass initializePrimitiveErrorCodes"
| pet |
PrimErrTableIndex := 51. "Zero-relative"
"See SmalltalkImage>>recreateSpecialObjectsArray for the table definition.
If the table exists and is large enough the corresponding entry is returned as
the primitive error, otherwise the error is answered numerically."
pet := Smalltalk specialObjectsArray at: PrimErrTableIndex + 1 ifAbsent: [#()].
pet isArray ifFalse: [pet := #()].
PrimNoErr := 0. "for helper methods that need to answer success or an error code."
PrimErrGenericFailure := pet indexOf: nil ifAbsent: 1.
PrimErrBadReceiver := pet indexOf: #'bad receiver' ifAbsent: 2.
PrimErrBadArgument := pet indexOf: #'bad argument' ifAbsent: 3.
PrimErrBadIndex := pet indexOf: #'bad index' ifAbsent: 4.
PrimErrBadNumArgs := pet indexOf: #'bad number of arguments' ifAbsent: 5.
PrimErrInappropriate := pet indexOf: #'inappropriate operation' ifAbsent: 6.
PrimErrUnsupported := pet indexOf: #'unsupported operation' ifAbsent: 7.
PrimErrNoModification := pet indexOf: #'no modification' ifAbsent: 8.
PrimErrNoMemory := pet indexOf: #'insufficient object memory' ifAbsent: 9.
PrimErrNoCMemory := pet indexOf: #'insufficient C memory' ifAbsent: 10.
PrimErrNotFound := pet indexOf: #'not found' ifAbsent: 11.
PrimErrBadMethod := pet indexOf: #'bad method' ifAbsent: 12.
PrimErrNamedInternal := pet indexOf: #'internal error in named primitive machinery' ifAbsent: 13.
PrimErrObjectMayMove := pet indexOf: #'object may move' ifAbsent: 14.
PrimErrLimitExceeded := pet indexOf: #'resource limit exceeded' ifAbsent: 15.
PrimErrObjectIsPinned := pet indexOf: #'object is pinned' ifAbsent: 16.
PrimErrWritePastObject := pet indexOf: #'primitive write beyond end of object' ifAbsent: 17!
More information about the Vm-dev
mailing list