[Vm-dev] VM Maker: VMMaker.oscog-eem.873.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Sep 8 18:38:55 UTC 2014


Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.873.mcz

==================== Summary ====================

Name: VMMaker.oscog-eem.873
Author: eem
Time: 8 September 2014, 11:36:16.145 am
UUID: b4a15623-1d81-4824-87e9-d081a7c73331
Ancestors: VMMaker.oscog-eem.872

Slang:
Base the computation of what's in the primitiveTable on the
interpreterClass, not on StackInterpreter.

Rewrite CCodeGenerator>>shouldIncludeMethodFor:selector:
to ask the methodClass for the cogClass, interpreterClass
and objectMemoryCLass, instead of assuming there's a vmMaker on hand.  These classes can be computed from
the class inst var initializationOptions, and hence be available
even at run-time when Spur is computing accessor depths.

Recategorize these methods.

Drop CoInterpreter's CogitClass class var and a few
methods as a result.

Clean up the class hierarchuy computations in VMMaker's
buildCodeGeneratorFor... methods.

Harmonize RiscOSVMMaker & VMMaker's time stamp calculation.

=============== Diff against VMMaker.oscog-eem.872 ===============

Item was changed:
  ----- Method: CCodeGenerator>>shouldIncludeMethodFor:selector: (in category 'utilities') -----
  shouldIncludeMethodFor: aClass selector: selector
  	"Answer whether a method shoud be translated.  Process optional methods by
  	 interpreting the argument to the option: pragma as either a Cogit class name
  	 or a class variable name or a variable name in VMBasicConstants.  Exclude
  	 methods with the doNotGenerate pragma."
  	| pragmas |
+ 	"where is pragmasAt: ??"
  	(pragmas := (aClass >> selector) pragmas select: [:p| p keyword == #option:]) notEmpty ifTrue:
  		[pragmas do:
  			[:pragma| | key |
  			 key := pragma argumentAt: 1.
+ 			 "If the option is the name of a subclass of Cogit, include it if it inherits from the Cogit class."
+ 			 (Smalltalk classNamed: key) ifNotNil:
+ 				[:optionClass|
+ 				 aClass cogitClass ifNotNil:
+ 					[:cogitClass|
+ 					 (Cogit withAllSubclasses anySatisfy: [:c| c = cogitClass]) ifTrue:
+ 						[^cogitClass includesBehavior: optionClass]]].
+ 			 "Lookup options in options, class variables of the defining class, VMBasicConstants, the interpreterClass and the objectMemoryClass"
+ 			 {aClass initializationOptions.
+ 			   aClass.
+ 			   VMBasicConstants.
+ 			   aClass interpreterClass.
+ 			   aClass objectMemoryClass} do:
+ 				[:scopeOrNil|
+ 				 scopeOrNil ifNotNil:
+ 					[:scope|
+ 					 (scope bindingOf: key) ifNotNil:
+ 						[:binding|
+ 						binding value ~~ false ifTrue: [^true]]]]].
- 			 vmMaker ifNotNil:
- 				[vmMaker cogitClassName ifNotNil:
- 					[(Cogit withAllSubclasses anySatisfy: [:c| c name = key]) ifTrue:
- 						[| cogitClass optionClass |
- 						 cogitClass := Smalltalk classNamed: vmMaker cogitClassName.
- 						 optionClass := Smalltalk classNamed: key.
- 						 ^cogitClass includesBehavior: optionClass]].
- 				((vmClass
- 					ifNotNil: [vmClass initializationOptions]
- 					ifNil: [vmMaker options]) at: key ifAbsent: [false]) ifNotNil:
- 					[:option| option ~~ false ifTrue: [^true]]].
- 			 "Lookup options in class variables of the defining class, VMMaker, the interpreterClass and the objectMemoryClass"
- 			 ((vmMaker notNil and: [vmMaker interpreterClass notNil])
- 					ifTrue: [{aClass. VMBasicConstants. vmMaker interpreterClass. vmMaker interpreterClass objectMemoryClass}]
- 					ifFalse: [{aClass. VMBasicConstants}]) do:
- 				[:scope|
- 				 (scope bindingOf: key) ifNotNil:
- 					[:binding|
- 					binding value ~~ false ifTrue: [^true]]]].
  		^false].
  	^(aClass >> selector pragmaAt: #doNotGenerate) isNil!

Item was changed:
  StackInterpreterPrimitives subclass: #CoInterpreter
  	instanceVariableNames: 'cogit cogMethodZone gcMode cogCodeSize desiredCogCodeSize heapBase lastCoggableInterpretedBlockMethod reenterInterpreter deferSmash deferredSmash primTraceLog primTraceLogIndex traceLog traceLogIndex traceSources cogCompiledCodeCompactionCalledFor statCodeCompactionCount statCodeCompactionUsecs lastUncoggableInterpretedBlockMethod processHasThreadId flagInterpretedMethods maxLiteralCountForCompile minBackwardJumpCountForCompile noThreadingOfGUIThread'
+ 	classVariableNames: 'CSCallbackEnter CSCallbackLeave CSCheckEvents CSEnterCriticalSection CSExitCriticalSection CSOwnVM CSResume CSSignal CSSuspend CSSwitchIfNeccessary CSThreadBind CSThreadSchedulingLoop CSWait CSYield HasBeenReturnedFromMCPC MFMethodFlagFrameIsMarkedFlag MinBackwardJumpCountForCompile PrimTraceLogSize ReturnToInterpreter RumpCStackSize TraceBlockActivation TraceBlockCreation TraceBufferSize TraceCodeCompaction TraceContextSwitch TraceDisownVM TraceFullGC TraceIncrementalGC TraceIsFromInterpreter TraceIsFromMachineCode TraceOwnVM TracePreemptDisowningThread TraceSources TraceStackOverflow TraceThreadSwitch TraceVMCallback TraceVMCallbackReturn'
- 	classVariableNames: 'CSCallbackEnter CSCallbackLeave CSCheckEvents CSEnterCriticalSection CSExitCriticalSection CSOwnVM CSResume CSSignal CSSuspend CSSwitchIfNeccessary CSThreadBind CSThreadSchedulingLoop CSWait CSYield CogitClass HasBeenReturnedFromMCPC MFMethodFlagFrameIsMarkedFlag MinBackwardJumpCountForCompile PrimTraceLogSize ReturnToInterpreter RumpCStackSize TraceBlockActivation TraceBlockCreation TraceBufferSize TraceCodeCompaction TraceContextSwitch TraceDisownVM TraceFullGC TraceIncrementalGC TraceIsFromInterpreter TraceIsFromMachineCode TraceOwnVM TracePreemptDisowningThread TraceSources TraceStackOverflow TraceThreadSwitch TraceVMCallback TraceVMCallbackReturn'
  	poolDictionaries: 'CogMethodConstants VMStackFrameOffsets'
  	category: 'VMMaker-JIT'!
  
  !CoInterpreter commentStamp: '<historical>' prior: 0!
  I am a variant of the StackInterpreter that can co-exist with the Cog JIT.  I interpret unjitted methods, either because they have been found for the first time or because they are judged to be too big to JIT.  See CogMethod class's comment for method interoperability.!

Item was changed:
+ ----- Method: CoInterpreter class>>cogitClass (in category 'accessing class hierarchy') -----
- ----- Method: CoInterpreter class>>cogitClass (in category 'translation') -----
  cogitClass
+ 	^Smalltalk classNamed: (initializationOptions
+ 								at: #Cogit
+ 								ifAbsent: [#SimpleStackBasedCogit])!
- 	"CogitClass := SimpleStackBasedCogit"
- 	"CogitClass := StackToRegisterMappingCogit"
- 	CogitClass isNil ifTrue: [CogitClass := SimpleStackBasedCogit].
- 	^CogitClass!

Item was changed:
+ ----- Method: CoInterpreter class>>primitivesClass (in category 'accessing class hierarchy') -----
- ----- Method: CoInterpreter class>>primitivesClass (in category 'translation') -----
  primitivesClass
  	^CoInterpreterPrimitives!

Item was changed:
+ ----- Method: CoInterpreterMT class>>primitivesClass (in category 'accessing class hierarchy') -----
- ----- Method: CoInterpreterMT class>>primitivesClass (in category 'translation') -----
  primitivesClass
  	^CoInterpreterMT!

Item was changed:
+ ----- Method: CogObjectRepresentationFor32BitSpur class>>defaultObjectMemoryClass (in category 'accessing class hierarchy') -----
- ----- Method: CogObjectRepresentationFor32BitSpur class>>defaultObjectMemoryClass (in category 'accessing') -----
  defaultObjectMemoryClass
  	"For in-image compilation."
  	^Spur32BitCoMemoryManager!

Item was changed:
+ ----- Method: CogObjectRepresentationFor64BitSpur class>>defaultObjectMemoryClass (in category 'accessing class hierarchy') -----
- ----- Method: CogObjectRepresentationFor64BitSpur class>>defaultObjectMemoryClass (in category 'accessing') -----
  defaultObjectMemoryClass
  	"For in-image compilation.  Spur64BitCoMemoryManager is as yet undefined."
  	^Smalltalk classNamed: #Spur64BitCoMemoryManager!

Item was changed:
+ ----- Method: CogObjectRepresentationForSqueakV3 class>>defaultObjectMemoryClass (in category 'accessing class hierarchy') -----
- ----- Method: CogObjectRepresentationForSqueakV3 class>>defaultObjectMemoryClass (in category 'accessing') -----
  defaultObjectMemoryClass
  	"For in-image compilation."
  	^NewCoObjectMemory!

Item was removed:
- ----- Method: CogVMSimulator class>>chooseAndInitCogitClassWithOpts: (in category 'instance creation') -----
- chooseAndInitCogitClassWithOpts: opts
- 	| classOrSymbol |
- 	classOrSymbol := opts at: #Cogit ifAbsent: [Cogit chooseCogitClass].
- 	classOrSymbol isSymbol ifTrue:
- 		[classOrSymbol := Smalltalk classNamed: classOrSymbol].
- 	(CoInterpreter classPool at: #CogitClass put: (classOrSymbol)) initializeWithOptions: opts!

Item was changed:
  ----- Method: CogVMSimulator class>>initializeWithOptions:objectMemoryClass: (in category 'class initialization') -----
  initializeWithOptions: optionsDictionaryOrArray objectMemoryClass: objectMemoryClassOrNil
  	"The relevant ObjectMemory, Interpreter and Cogit classes must be initialized in order.
  	 This happens notionally every time we start the simulator,
  	 but in fact happens when ever we instantiate a simulator."
- 	| cogitClassOrName |
  	initializationOptions := optionsDictionaryOrArray isArray
  							ifTrue: [Dictionary newFromPairs: optionsDictionaryOrArray]
  							ifFalse: [optionsDictionaryOrArray].
  	(objectMemoryClassOrNil ifNil: [self objectMemoryClass])
  		initializeWithOptions: initializationOptions.
  
  	self initializeWithOptions: initializationOptions.
  
  	((initializationOptions at: #COGMTVM ifAbsent: [false])
  			ifTrue: [CoInterpreterMT]
  			ifFalse: [CoInterpreter])
  		initializeWithOptions: initializationOptions.
  
- 	(initializationOptions includesKey: #Cogit) ifTrue:
- 		[cogitClassOrName := initializationOptions at: #Cogit.
- 		 cogitClassOrName isSymbol ifTrue:
- 			[cogitClassOrName := Smalltalk classNamed: cogitClassOrName].
- 		CoInterpreter classPool at: #CogitClass put: cogitClassOrName].
- 
  	(self cogitClass withAllSuperclasses copyUpTo: Cogit) reverseDo:
  		[:c| c initializeWithOptions: initializationOptions]!

Item was changed:
  ----- Method: CogVMSimulator>>codeGeneratorToComputeAccessorDepth (in category 'primitive support') -----
  codeGeneratorToComputeAccessorDepth
  	^VMMaker new
+ 		cogitClass: self class cogitClass;
- 		cogitClass: (Smalltalk classNamed: (self class initializationOptions
- 												at: #Cogit
- 												ifAbsent: [self class cogitClass name]));
  		buildCodeGeneratorForInterpreter: CoInterpreterPrimitives
  		includeAPIMethods: false
  		initializeClasses: false!

Item was changed:
+ ----- Method: Cogit class>>chooseCogitClass (in category 'accessing class hierarchy') -----
- ----- Method: Cogit class>>chooseCogitClass (in category 'accessing') -----
  chooseCogitClass
  	^Smalltalk at: ([:choices| choices at: (UIManager default chooseFrom: choices) ifAbsent: [^nil]]
  						value: (Cogit allSubclasses collect: [:ea| ea  name]) sorted)!

Item was changed:
+ ----- Method: Cogit class>>defaultObjectMemoryClass (in category 'accessing class hierarchy') -----
- ----- Method: Cogit class>>defaultObjectMemoryClass (in category 'accessing') -----
  defaultObjectMemoryClass
  	^NewCoObjectMemory!

Item was changed:
+ ----- Method: CurrentImageCoInterpreterFacade class>>objectMemoryClass (in category 'accessing class hierarchy') -----
- ----- Method: CurrentImageCoInterpreterFacade class>>objectMemoryClass (in category 'accessing') -----
  objectMemoryClass
  	^self subclassResponsibility!

Item was changed:
+ ----- Method: CurrentImageCoInterpreterFacade class>>objectRepresentationClass (in category 'accessing class hierarchy') -----
- ----- Method: CurrentImageCoInterpreterFacade class>>objectRepresentationClass (in category 'accessing') -----
  objectRepresentationClass
  	^self subclassResponsibility!

Item was changed:
+ ----- Method: CurrentImageCoInterpreterFacadeForSpurObjectRepresentation class>>objectMemoryClass (in category 'accessing class hierarchy') -----
- ----- Method: CurrentImageCoInterpreterFacadeForSpurObjectRepresentation class>>objectMemoryClass (in category 'accessing') -----
  objectMemoryClass
  	^Spur32BitCoMemoryManager!

Item was changed:
+ ----- Method: CurrentImageCoInterpreterFacadeForSpurObjectRepresentation class>>objectRepresentationClass (in category 'accessing class hierarchy') -----
- ----- Method: CurrentImageCoInterpreterFacadeForSpurObjectRepresentation class>>objectRepresentationClass (in category 'accessing') -----
  objectRepresentationClass
  	^CogObjectRepresentationFor32BitSpur!

Item was changed:
+ ----- Method: CurrentImageCoInterpreterFacadeForSqueakV3ObjectRepresentation class>>objectMemoryClass (in category 'accessing class hierarchy') -----
- ----- Method: CurrentImageCoInterpreterFacadeForSqueakV3ObjectRepresentation class>>objectMemoryClass (in category 'accessing') -----
  objectMemoryClass
  	^NewCoObjectMemory!

Item was changed:
+ ----- Method: CurrentImageCoInterpreterFacadeForSqueakV3ObjectRepresentation class>>objectRepresentationClass (in category 'accessing class hierarchy') -----
- ----- Method: CurrentImageCoInterpreterFacadeForSqueakV3ObjectRepresentation class>>objectRepresentationClass (in category 'accessing') -----
  objectRepresentationClass
  	^CogObjectRepresentationForSqueakV3!

Item was changed:
  ----- Method: RiscOSVMMaker>>needsToRegenerateInterpreterFile (in category 'initialize') -----
  needsToRegenerateInterpreterFile
+ 	"Check the timestamp for the relevant classes and then the timestamp for the main
+ 	 source file (e.g. interp.c) if it already exists.  Answer if the file needs regenerating."
- "check the timestamp for the relevant classes and then the timestamp for the interp.c file if it already exists. Return true if the file needs regenerating, false if not"
  
+ 	| classes tStamp fstat |
+ 	classes := self interpreterClass withAllSuperclasses copyUpTo: VMClass.
+ 	self interpreterClass objectMemoryClass ifNotNil:
+ 		[:objectMemoryClass|
+ 		classes addAllLast: (objectMemoryClass withAllSuperclasses copyUpTo: VMClass)].
+ 	classes copy do:
+ 		[:class| classes addAllLast: (class ancilliaryClasses: self options)].
+ 	tStamp := classes inject: 0 into: [:tS :cl| tS max: cl timeStamp].
- 	| tStamp fstat |
- 	tStamp := (self interpreterClass withAllSuperclasses copyUpTo: ObjectMemory superclass),
- 				(self interpreterClass ancilliaryClasses: self options)
- 					inject: 0 into: [:tS :cl| tS max: cl timeStamp].
  
  	"don't translate if the file is newer than my timeStamp"
  	"RiscOS keeps the interp file in a 'c' subdirectory of coreVMDirectory"
  	(self coreVMDirectory directoryExists: 'c') ifFalse:[^true].
  
  	fstat := (self coreVMDirectory directoryNamed: 'c') entryAt: self interpreterFilename ifAbsent:[nil].
  	fstat ifNotNil:[tStamp < fstat modificationTime ifTrue:[^false]].
  	^true
  !

Item was changed:
+ ----- Method: SpurMemoryManager class>>objectRepresentationClass (in category 'accessing class hierarchy') -----
- ----- Method: SpurMemoryManager class>>objectRepresentationClass (in category 'accessing') -----
  objectRepresentationClass
  	^self subclassResponsibility!

Item was changed:
  ----- Method: StackInterpreter class>>primitiveTable (in category 'constants') -----
  primitiveTable
  	| cg |
  	cg := CCodeGenerator new.
+ 	cg vmClass: self.
- 	cg vmClass: StackInterpreter.
  	^PrimitiveTable collect:
  		[:thing|
  		(thing isInteger "quick prims, 0 for fast primitve fail"
  		 or: [thing == #primitiveFail])
  			ifTrue: [thing]
  			ifFalse:
  				[(self primitivesClass whichClassIncludesSelector: thing)
  					ifNil: [#primitiveFail]
  					ifNotNil:
  						[:class|
  						 (cg shouldIncludeMethodFor: class selector: thing)
  							ifTrue: [thing]
  							ifFalse: [#primitiveFail]]]]!

Item was changed:
+ ----- Method: StackInterpreter class>>primitivesClass (in category 'accessing class hierarchy') -----
- ----- Method: StackInterpreter class>>primitivesClass (in category 'translation') -----
  primitivesClass
  	^StackInterpreterPrimitives!

Item was added:
+ ----- Method: VMClass class>>cogitClass (in category 'accessing class hierarchy') -----
+ cogitClass
+ 	^nil!

Item was changed:
+ ----- Method: VMClass class>>coreInterpreterClass (in category 'accessing class hierarchy') -----
- ----- Method: VMClass class>>coreInterpreterClass (in category 'translation') -----
  coreInterpreterClass
  	"While the interpreterClass/vmClass for translation may be
  	 a subclass that holds a few primitives we want the actual
  	 interpreter name at the head of the generated file."
  	^((name endsWith: 'Primitives')
  	   and: [name beginsWith: superclass name])
  		ifTrue: [superclass]
  		ifFalse: [self]!

Item was added:
+ ----- Method: VMClass class>>interpreterClass (in category 'accessing class hierarchy') -----
+ interpreterClass
+ 	^self isInterpreterClass ifTrue: [self]!

Item was changed:
  ----- Method: VMMaker>>buildCodeGeneratorForCogit:includeAPIMethods:initializeClasses: (in category 'generate sources') -----
  buildCodeGeneratorForCogit: cogitClass includeAPIMethods: getAPIMethods initializeClasses: initializeClasses
  	"Answer the code generator for translating the cogit."
  
+ 	| cg cogitClasses apicg |
- 	| cg aClass cogitClasses apicg |
  	cg := self createCogitCodeGenerator.
  
  	cg vmClass: cogitClass.
  	initializeClasses ifTrue:
  		[{ cogitClass. self interpreterClass. self interpreterClass objectMemoryClass } do:
  			[:cgc|
  			(cgc respondsTo: #initializeWithOptions:)
  				ifTrue: [cgc initializeWithOptions: optionsDictionary]
  				ifFalse: [cgc initialize]]].
  
+ 	cogitClasses := OrderedCollection withAll: (cogitClass withAllSuperclasses copyUpThrough: VMClass) reverse.
- 	cogitClasses := OrderedCollection new.
- 	aClass := cogitClass.
- 	[cogitClasses addFirst: aClass.
- 	 aClass ~~ Cogit
- 	 and: [aClass inheritsFrom: Cogit]] whileTrue:
- 		[aClass := aClass superclass].
- 	cogitClasses addFirst: VMClass.
  	cogitClasses addAllLast: ((cogitClass ancilliaryClasses: optionsDictionary) reject: [:class| class isStructClass]).
  	cogitClasses do: [:cgc| cg addClass: cgc].
  	cg addStructClasses: (cg structClassesForTranslationClasses: cogitClasses).
  
  	getAPIMethods ifTrue:
  		[apicg := self
  					buildCodeGeneratorForInterpreter: self interpreterClass
  					includeAPIMethods: false
  					initializeClasses: false.
  		 cg apiMethods: apicg selectAPIMethods].
  
  	cg removeConstant: #VMBIGENDIAN. "this should be defined in platforms/??/vm/sqConfig.h"
  
  	^cg!

Item was changed:
  ----- Method: VMMaker>>buildCodeGeneratorForInterpreter:includeAPIMethods:initializeClasses: (in category 'generate sources') -----
  buildCodeGeneratorForInterpreter: interpreterClass includeAPIMethods: getAPIMethods initializeClasses: initializeClasses
  	"Answer the code generator for translating the interpreter."
  
+ 	| cg interpreterClasses apicg |
- 	| cg theClass interpreterClasses apicg |
- 	interpreterClasses := OrderedCollection new.
- 
  	initializeClasses ifTrue:
  		[interpreterClass initializeWithOptions: optionsDictionary].
  
  	(cg := self createCodeGenerator) vmClass: interpreterClass.
  
+ 	"Construct interpreterClasses as all classes from interpreterClass &
+ 	 objectMemoryClass up to VMClass in superclass to subclass order."
+ 	interpreterClasses := OrderedCollection new.
+ 	{interpreterClass. interpreterClass objectMemoryClass} do:
+ 		[:vmClass| | theClass |
+ 		 theClass := vmClass.
+ 		 [theClass ~~ VMClass] whileTrue:
- 	theClass := interpreterClass.
- 	[theClass ~~ VMClass] whileTrue:
- 		[interpreterClasses addFirst: theClass.
- 		 theClass := theClass superclass].
- 	
- 	cg vmClass objectMemoryClass ifNotNil:
- 		[:objectMemoryClass|
- 		theClass := objectMemoryClass.
- 		[theClass ~~ VMClass] whileTrue:
  			[interpreterClasses addFirst: theClass.
  			 theClass := theClass superclass]].
+ 	interpreterClasses
+ 		addFirst: VMClass;
+ 		addAllLast: (cg nonStructClassesForTranslationClasses: interpreterClasses).
  
- 	interpreterClasses addFirst: VMClass.
- 	interpreterClasses addAllLast: (cg nonStructClassesForTranslationClasses: interpreterClasses).
- 
  	initializeClasses ifTrue:
  		[interpreterClasses do:
  			[:ic|
  			(ic respondsTo: #initializeWithOptions:)
  				ifTrue: [ic initializeWithOptions: optionsDictionary]
  				ifFalse: [ic initialize]].
  		 (cg structClassesForTranslationClasses: interpreterClasses) do:
  			[:structClass| structClass initialize]].
  
  	cg addStructClasses: (cg structClassesForTranslationClasses: interpreterClasses).
  
  	interpreterClasses do: [:ic| cg addClass: ic].
  
  	(getAPIMethods
+ 	 and: [self interpreterClass needsCogit]) ifTrue:
- 	and: [self interpreterClass needsCogit]) ifTrue:
  		[apicg := self
  					buildCodeGeneratorForCogit: self cogitClass
  					includeAPIMethods: false
  					initializeClasses: false.
  		 cg apiMethods: apicg selectAPIMethods].
  
  	cg removeConstant: #VMBIGENDIAN. "this should be defined in platforms/??/vm/sqConfig.h"
  
  	^cg!

Item was changed:
  ----- Method: VMMaker>>needsToRegenerateInterpreterFile (in category 'initialize') -----
  needsToRegenerateInterpreterFile
  	"Check the timestamp for the relevant classes and then the timestamp for the main
  	 source file (e.g. interp.c) if it already exists.  Answer if the file needs regenerating."
  
  	| classes tStamp |
  	classes := self interpreterClass withAllSuperclasses copyUpTo: VMClass.
  	self interpreterClass objectMemoryClass ifNotNil:
  		[:objectMemoryClass|
+ 		classes addAllLast: (objectMemoryClass withAllSuperclasses copyUpTo: VMClass)].
- 		classes addAllLast: (objectMemoryClass  withAllSuperclasses copyUpTo: VMClass)].
  	classes copy do:
  		[:class| classes addAllLast: (class ancilliaryClasses: self options)].
  	tStamp := classes inject: 0 into: [:tS :cl| tS max: cl timeStamp].
  
  	"don't translate if the file is newer than my timeStamp"
  	(self coreVMDirectory entryAt: self interpreterFilename ifAbsent: [nil]) ifNotNil:
  		[:fstat|
  		tStamp < fstat modificationTime ifTrue:
  			[^self confirm: 'The ', self configurationNameIfAny, 'interpreter classes have not been modified since\ the interpreter file was last generated.\Do you still want to regenerate the source file?' withCRs]].
  	^true
  !



More information about the Vm-dev mailing list