[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