[Vm-dev] VM Maker: VMMaker-oscog-GuillermoPolito.241.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Jun 19 12:59:02 UTC 2013


Guillermo Polito uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker-oscog-GuillermoPolito.241.mcz

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

Name: VMMaker-oscog-GuillermoPolito.241
Author: GuillermoPolito
Time: 17 June 2013, 6:37:02.254 pm
UUID: b67733cc-447a-478d-b979-eb90acc9e04f
Ancestors: VMMaker-oscog-GuillermoPolito.240

moving to use filesystem

=============== Diff against VMMaker-oscog-GuillermoPolito.240 ===============

Item was changed:
  ----- Method: ADPCMCodecPlugin class>>translateInDirectory:doInlining: (in category 'translation') -----
  translateInDirectory: directory doInlining: inlineFlag
  "handle a special case code string rather than generated code"
  "Not currently hooked into the timeStamp mechanism for VMMaker since this would mean replicating code from InterpreterPlugin; waiting for a more elegant solution to appear. In the meantime this means that this plugin will always get regenerated even if the file is uptodate"
  	| cg |
  	self initialize.
  
  	cg := self buildCodeGeneratorUpTo: InterpreterPlugin.
  
  	cg addMethodsForPrimitives: ADPCMCodec translatedPrimitives.
  	inlineFlag ifTrue:[
  		"now remove a few which will be inlined but not pruned"
  		cg pruneMethods: #(indexForDeltaFrom:to: nextBits: nextBits:put:)].
+ 	self storeString: cg generateCodeStringForPrimitives onFileNamed: (directory asFileReference / self moduleName, '.c') fullName.
- 	self storeString: cg generateCodeStringForPrimitives onFileNamed: (directory fullNameFor: self moduleName, '.c').
  	^cg exportedPrimitiveNames asArray
  !

Item was changed:
  ----- Method: CrossPlatformVMMaker>>interpreterExportsFilePath (in category 'generate sources') -----
  interpreterExportsFilePath
  	"Return the full path for the interpreter exports file.  Since we're leaving it up to
  	 platform makefiles to specify the actual named prims, just produce an example file."
+ 	^(self coreVMDirectory / 'exampleSqNamedPrims.h') fullPath!
- 	^self coreVMDirectory fullNameFor: 'exampleSqNamedPrims.h'!

Item was changed:
  ----- Method: FilePluginSimulator>>sqFileRenameOld:Size:New:Size: (in category 'simulation') -----
  sqFileRenameOld: oldNameIndex Size: oldNameSize New: newNameIndex Size: newNameSize
  	| oldPath newPath |
+ 	oldPath := (interpreterProxy interpreter asString: oldNameIndex size: oldNameSize) asFileReference fullName.
+ 	newPath := (interpreterProxy interpreter asString: newNameIndex size: newNameSize) asFileReference fullName.
- 	oldPath := FileSystem workingDirectory fullNameFor: (interpreterProxy interpreter asString: oldNameIndex size: oldNameSize).
- 	newPath := FileSystem workingDirectory fullNameFor: (interpreterProxy interpreter asString: newNameIndex size: newNameSize).
  	((StandardFileStream isAFileNamed: oldPath)
  	 and: [(StandardFileStream isAFileNamed: newPath) not]) ifFalse:
  		[^interpreterProxy primitiveFail].
  	[FileSystem workingDirectory primRename: oldPath to: newPath]
  		on: Error
  		do: [:ex| interpreterProxy primitiveFail]!

Item was changed:
  ----- Method: Gnuifier>>gnuify (in category 'as yet unclassified') -----
  gnuify
  	"This Gnuifier produces a file compatible with gcc 3.x and gcc 4.x.
  	 We label the gnuified VM so one can identify the valid gcc version.
  	 The script run on Wndows, platforms/win32/misc/gnuify, produces
  	 something compatible with gcc 2.95 (gack)."
+ 	(directory asFileReference / ('gcc3x-', interpreterFilename)) ensureDeleted.
- 	(directory fileExists: 'gcc3x-', interpreterFilename) ifTrue:
- 		[directory deleteFileNamed: 'gcc3x-', interpreterFilename].
  	self
+ 		gnuifyFrom: (FileStream oldFileNamed: (directory asFileReference / interpreterFilename) fullName)
+ 		to: 			(VMMaker forceNewFileNamed: (directory asFileReference / 'gcc3x-', interpreterFilename) fullName )
- 		gnuifyFrom: (directory oldFileNamed: interpreterFilename)
- 		to: 			(VMMaker forceNewFileNamed: (directory fullNameFor: 'gcc3x-', interpreterFilename))
  	
  !

Item was changed:
  ----- Method: InterpreterPlugin class>>translateInDirectory:doInlining: (in category 'translation') -----
  translateInDirectory: directory doInlining: inlineFlag
  "This is the default method for writing out sources for a plugin. Several classes need special handling, so look at all implementors of this message"
+ 	| cg fname fstat reference |
- 	| cg fname fstat |
  	 fname := self moduleName, '.c'.
  
  	"don't translate if the file is newer than my timeStamp"
+ 	reference := directory asFileReference / name.
+ 	fstat := reference exists ifTrue: [ reference entry ] ifFalse: [nil].
- 	fstat := directory entryAt: fname ifAbsent:[nil].
  	fstat ifNotNil:
  		[((self pluginClassesUpTo: self) allSatisfy:
  				[ :aPluginClass| aPluginClass timeStamp < fstat modificationTime asSeconds ]) ifTrue:
  			[^nil]].
  
  	self initialize.
  	cg := self buildCodeGeneratorUpTo: self.
+ 	cg storeCodeOnFile:  (directory asFileReference / fname) fullName doInlining: inlineFlag.
- 	cg storeCodeOnFile:  (directory fullNameFor: fname) doInlining: inlineFlag.
  	^cg exportedPrimitiveNames asArray!

Item was changed:
  ----- Method: MiscPrimitivePlugin class>>translateInDirectory:doInlining: (in category 'translation') -----
  translateInDirectory: directory doInlining: inlineFlag
  "handle a special case code string rather than normal generated code."
+ 	| cg fname fstat reference |
- 	| cg fname fstat |
  	 fname := self moduleName, '.c'.
  
+ 	reference := directory asFileReference / fname.
+ 	fstat := reference exists ifTrue: [ reference entry ] ifFalse: [nil].
- 	"don't translate if the file is newer than my timeStamp"
- 	fstat := directory entryAt: fname ifAbsent:[nil].
  	fstat ifNotNil:[self timeStamp < fstat modificationTime asSeconds ifTrue:[^nil]].
  
  	self initialize.
  	cg := self buildCodeGeneratorUpTo: InterpreterPlugin.
  	cg addMethodsForPrimitives: self translatedPrimitives.
+ 	self storeString: cg generateCodeStringForPrimitives onFileNamed: (directory asFileReference / fname) fullName.
- 	self storeString: cg generateCodeStringForPrimitives onFileNamed: (directory fullNameFor: fname).
  	^cg exportedPrimitiveNames asArray
  !

Item was changed:
  ----- Method: RiscOSVMMaker class>>generateSqueakStackVM (in category 'configurations') -----
  generateSqueakStackVM
  	"RISC OS version; build needed plugins, make sure filename tweaking is used"
  "RiscOSVMMaker generateSqueakStackVM"
  	^self
  		generate: StackInterpreter
+ 		to: 'stacksrc' asFileReference fullName
+ 		platformDir: 'platforms' asFileReference fullName
- 		to: (FileSystem workingDirectory directoryNamed: 'stacksrc') fullName
- 		platformDir: (FileSystem workingDirectory directoryNamed: 'platforms') fullName
  		excluding: #(AsynchFilePlugin BrokenPlugin CroquetPlugin FFIPlugin IA32ABIPlugin ImmX11Plugin InternetConfigPlugin JoystickTabletPlugin MIDIPlugin MacMenubarPlugin Mpeg3Plugin NewsqueakIA32ABIPlugin QuicktimePlugin SerialPlugin  TestOSAPlugin ThreadedARMFFIPlugin ThreadedFFIPlugin ThreadedIA32FFIPlugin ThreadedPPCBEFFIPlugin UUIDPlugin VMProfileMacSupportPlugin)!

Item was changed:
  ----- Method: RiscOSVMMaker>>export:forExternalPlugin: (in category 'generate sources') -----
  export: exportList forExternalPlugin: aPlugin
  "it may be useful on certain platforms to do something with the export list of external plugins, just as the internal plugins' exports get added to the VM list. Default is to do nothing though."
  "For RiscOS using the 'rink' external linker each plugin needs a 'dsc' file that looks like
  id:SqueakSO
  main_version:100
  code_version:001
  
  entries:
  //
  named_entries:
  getModuleName
  //
  with all the exported names in the list. We also need a '/o' directory for the object files"
  
  	"open a file called plugindir/pluginname.dsc and write into it"
  	| f fd dfd |
+ 	fd := (self externalPluginsDirectoryFor: aPlugin) asFileReference.
- 	fd := self externalPluginsDirectoryFor: aPlugin.
  
  	"If we get an error to do with opening the .dsc file, we need to raise an application error to suit"
+ 	[(fd / 'dsc') isDirectory ifFalse: [(fd / 'dsc') ensureDirectory].
+ 	dfd := fd / 'dsc'.
- 	[(fd directoryExists: 'dsc') ifFalse:[fd createDirectory: 'dsc'].
- 	dfd := fd directoryNamed: 'dsc'.
  	f := VMMaker forceNewFileNamed: (dfd fullNameFor: aPlugin moduleName)] on: FileStreamException do:[^self couldNotOpenFile: (dfd fullNameFor: aPlugin moduleName)].
  
  	f nextPutAll: 'id:SqueakSO
  main_version:100
  code_version:001
  
  entries:
  //
  named_entries:
  '.
  	exportList do:[:el|
  		f nextPutAll: el.
  		f cr].
  	f nextPutAll: '//'; cr.
  	f close.
+ 	(fd / 'o') assureExistence
- 	(fd directoryNamed: 'o') assureExistence
  !

Item was changed:
  ----- Method: RiscOSVMMaker>>needsToRegenerateInterpreterFile (in category 'initialize') -----
  needsToRegenerateInterpreterFile
  "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"
  
+ 	| tStamp fstat reference |
- 	| tStamp fstat |
  	tStamp := (self interpreterClass withAllSuperclasses copyUpTo: ObjectMemory superclass),
  				self interpreterClass ancilliaryClasses
  					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].
  
+ 	reference := self coreVMDirectory asFileReference / 'c' / self interpreterFilename.
+ 	fstat := reference exists ifTrue: [ reference entry ] ifFalse: [nil].
- 	fstat := (self coreVMDirectory directoryNamed: 'c') entryAt: self interpreterFilename ifAbsent:[nil].
  	fstat ifNotNil:[tStamp < fstat modificationTime ifTrue:[^false]].
  	^true
  !

Item was changed:
  ----- Method: SoundGenerationPlugin class>>translateInDirectory:doInlining: (in category 'accessing') -----
  translateInDirectory: directory doInlining: inlineFlag
  "handle a special case code string rather than generated code. 
  NB sqOldSoundsPrims IS NOT FULLY INTEGRATED - it still isn't included in the exports list"
  	| cg |
  	self initialize.
  
  	cg := self buildCodeGeneratorUpTo: InterpreterPlugin.
  
  	cg addMethodsForPrimitives: AbstractSound translatedPrimitives.
+ 	self storeString: cg generateCodeStringForPrimitives onFileNamed: (directory asFileReference / self moduleName, '.c') fullName.
- 	self storeString: cg generateCodeStringForPrimitives onFileNamed: (directory fullNameFor: self moduleName, '.c').
  	"What we need here is some way to derive the prim names from sqOldSoundPrims - or dump it entirely. Perhaps add this class (without then generating the file again) using fake entry points like SurfacePlugin does"
  
  	^cg exportedPrimitiveNames asArray
  !

Item was changed:
  ----- Method: VMMaker class>>generateSqueakStackVM (in category 'configurations') -----
  generateSqueakStackVM
  	"No primitives since we can use those for the Cog VM"
  	^VMMaker
  		generate: StackInterpreter
+ 		to: 'oscogvm/stacksrc' asFileReference fullName
+ 		platformDir: 'oscogvm/platforms' asFileReference fullName
- 		to: (FileSystem workingDirectory directoryNamed: 'oscogvm/stacksrc') fullName
- 		platformDir: (FileSystem workingDirectory directoryNamed: 'oscogvm/platforms') fullName
  		excluding: (InterpreterPlugin withAllSubclasses collect: [:ea| ea name])!

Item was changed:
  ----- Method: VMMaker>>coreVMDirectory (in category 'target directories') -----
  coreVMDirectory
  	"return the target directory for the main VM sources, interp.c etc"
  	| fd |
+ 	fd := self sourceDirectory / self class coreVMDirName.
+ 	fd ensureDirectory.
- 	fd := self sourceDirectory directoryNamed: self class coreVMDirName.
- 	fd assureExistence.
  	^ fd!

Item was changed:
  ----- Method: VMMaker>>crossPlatformDirectory (in category 'source directories') -----
  crossPlatformDirectory
  	"return the directory where we should find the cross-platform literal 
  	sources - <sq.h> etc"
  	| fd machDirNm |
+ 	fd := self platformRootDirectory asFileReference.
+ 	(fd / (machDirNm := 'Cross')) exists
- 	fd := self platformRootDirectory.
- 	(fd directoryExists: (machDirNm := 'Cross'))
  		ifFalse: ["The supposed directory for the actual cross-platform code  
  			does not exist."
  			^ self couldNotFindPlatformDirectoryFor: 'cross-platform '].
+ 	^ fd / machDirNm!
- 	^ fd directoryNamed: machDirNm!

Item was changed:
  ----- Method: VMMaker>>crossPlatformPluginsDirectory (in category 'source directories') -----
  crossPlatformPluginsDirectory
  	"return the directory where we should find the cross-platform plugin specific sources"
  
+ 	(self crossPlatformDirectory / self class pluginsDirName) exists
- 	(self crossPlatformDirectory directoryExists: self class pluginsDirName)
  		ifFalse: ["The supposed directory for the plugins code does not 
  					exist. We need to raise a suitable exception, but cant 
  					think of one right now."
  					^self couldNotFindPlatformDirectoryFor: 'any plugins needing cross-platform'].
+ 	^self crossPlatformDirectory / self class pluginsDirName!
- 	^self crossPlatformDirectory directoryNamed: self class pluginsDirName!

Item was changed:
  ----- Method: VMMaker>>externalPluginsDirectory (in category 'target directories') -----
  externalPluginsDirectory
  	"return the target directory for the external plugins sources"
  	| fd |
+ 	fd := self sourceDirectory / self class pluginsDirName.
+ 	fd ensureDirectory.
- 	fd := self sourceDirectory directoryNamed: self class pluginsDirName.
- 	fd assureExistence.
  	^fd!

Item was changed:
  ----- Method: VMMaker>>externalPluginsDirectoryFor: (in category 'target directories') -----
  externalPluginsDirectoryFor: plugin
  	"return the directory for the external plugin sources"
  	|fd|
+ 	fd := self externalPluginsDirectory / plugin moduleName.
+ 	fd ensureDirectory.
- 	fd := self externalPluginsDirectory directoryNamed: plugin moduleName.
- 	fd assureExistence.
  	^fd!

Item was changed:
  ----- Method: VMMaker>>generateCogitFile (in category 'generate sources') -----
  generateCogitFile
  	"Translate the Smalltalk description of the virtual machine into C.  If 'self doInlining' is true, small method bodies are inlined to reduce procedure call overhead.  On the PPC, this results in a factor of three speedup with only 30% increase in code size.  Subclasses can use specialised versions of CCodeGenerator and interpreterClass."
  
  	| cg cogitClass |
  	self interpreterClass needsCogit ifFalse: [^nil].
  	cg := [self buildCodeGeneratorForCogit]
  			on: Notification
  			do: [:ex|
  				ex tag == #getVMMaker
  					ifTrue: [ex resume: self]
  					ifFalse: [(ex respondsTo: #rearmHandlerDuring:)
  								ifTrue: [ex rearmHandlerDuring: [ex pass]]
  								ifFalse: [ex pass]]].
  	self needsToRegenerateCogitFile ifFalse: [^nil].
  	cogitClass := self cogitClass.
  	cg removeUnneededBuiltins.
  	cg vmClass preGenerationHook: cg.
  	cg storeCodeOnFile: (self sourceFilePathFor: cogitClass sourceFileName) doInlining: cogitClass doInlining.
  	cg vmClass additionalHeadersDo:
  		[:headerName :headerContents| | filePath |
+ 		 filePath := (self coreVMDirectory / headerName) fullName.
- 		 filePath := self coreVMDirectory fullNameFor: headerName.
  		 (cg needToGenerateHeader: headerName file: filePath contents: headerContents) ifTrue:
  			 [cg storeHeaderOnFile: filePath contents: headerContents]].
  	cogitClass apiExportHeaderName ifNotNil:
  		[cg storeAPIExportHeader: cogitClass apiExportHeaderName
  			OnFile: (self sourceFilePathFor: cogitClass apiExportHeaderName)]!

Item was changed:
  ----- Method: VMMaker>>generateInterpreterFile (in category 'generate sources') -----
  generateInterpreterFile
  	"Translate the Smalltalk description of the virtual machine into C.  If 'self doInlining' is true, small method bodies are inlined to reduce procedure call overhead.  On the PPC, this results in a factor of three speedup with only 30% increase in code size.  Subclasses can use specialised versions of CCodeGenerator and interpreterClass."
  
  	| cg vmHeaderContents |
  	cg := [self buildCodeGeneratorForInterpreter]
  			on: Notification
  			do: [:ex|
  				ex tag == #getVMMaker
  					ifTrue: [ex resume: self]
  					ifFalse: [(ex respondsTo: #rearmHandlerDuring:)
  								ifTrue: [ex rearmHandlerDuring: [ex pass]]
  								ifFalse: [ex pass]]].
  	self needsToRegenerateInterpreterFile ifFalse: [^nil].
  	cg removeUnneededBuiltins.
  	self interpreterClass preGenerationHook: cg.
  
  	vmHeaderContents := cg vmHeaderContentsWithBytesPerWord: self bytesPerWord.
  	(cg needToGenerateHeader: self interpreterHeaderName file: self interpreterHeaderPath contents: vmHeaderContents) ifTrue:
  		[cg storeHeaderOnFile: self interpreterHeaderPath contents: vmHeaderContents].
  	cg storeCodeOnFile: (self sourceFilePathFor: self interpreterClass sourceFileName) doInlining: self doInlining.
  	self interpreterClass additionalHeadersDo:
  		[:headerName :headerContents| | filePath |
+ 		 filePath := (self coreVMDirectory asFileReference / headerName) fullName.
- 		 filePath := self coreVMDirectory fullNameFor: headerName.
  		 (cg needToGenerateHeader: headerName file: filePath contents: headerContents) ifTrue:
  			 [cg storeHeaderOnFile: filePath contents: headerContents]].
  	self interpreterClass apiExportHeaderName ifNotNil:
  		[cg storeAPIExportHeader: self interpreterClass apiExportHeaderName
  			OnFile: (self sourceFilePathFor: self interpreterClass apiExportHeaderName)].
  	self gnuifyInterpreterFile!

Item was changed:
  ----- Method: VMMaker>>internalPluginsDirectory (in category 'target directories') -----
  internalPluginsDirectory
  	"return the directory for the internal plugins sources"
  	|fd|
+ 	fd := self coreVMDirectory / 'intplugins'.
+ 	fd ensureDirectory.
- 	fd := self coreVMDirectory directoryNamed: 'intplugins'.
- 	fd assureExistence.
  	^fd!

Item was changed:
  ----- Method: VMMaker>>internalPluginsDirectoryFor: (in category 'target directories') -----
  internalPluginsDirectoryFor: plugin
  	"return the directory for the internal plugin sources"
  	|fd|
+ 	fd := self internalPluginsDirectory / plugin moduleName.
+ 	fd ensureDirectory.
- 	fd := self internalPluginsDirectory directoryNamed: plugin moduleName.
- 	fd assureExistence.
  	^fd!

Item was changed:
  ----- Method: VMMaker>>interpreterExportsFilePath (in category 'generate sources') -----
  interpreterExportsFilePath
  	"return the full path for the interpreter exports file"
+ 	^(self coreVMDirectory / 'sqNamedPrims.h') fullPath!
- 	^self coreVMDirectory fullNameFor: 'sqNamedPrims.h'!

Item was changed:
  ----- Method: VMMaker>>interpreterHeaderPath (in category 'generate sources') -----
  interpreterHeaderPath
  	"Answer the fully-qualified path for the generated interpreter header file."
  
+ 	^(self coreVMDirectory / self interpreterHeaderName) fullPath!
- 	^self coreVMDirectory fullNameFor: self interpreterHeaderName!

Item was changed:
  ----- Method: VMMaker>>needsToRegenerateCogitFile (in category 'generate sources') -----
  needsToRegenerateCogitFile
  "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"
  
+ 	| cogitClass cogitClasses tStamp fstat reference |
- 	| cogitClass cogitClasses tStamp fstat |
  	cogitClass := self cogitClass.
  	cogitClasses := cogitClass withAllSuperclasses copyUpThrough: Cogit.
  	cogitClasses addAllLast: cogitClass ancilliaryClasses.
  	tStamp := cogitClasses inject: 0 into: [:tS :cl| tS max: cl timeStamp].
  	cogitClasses do:
  		[:c|
  		tStamp := c ancilliaryStructClasses inject: tStamp into: [:tS :cl| tS max: cl timeStamp]].
  
  	"don't translate if the file is newer than my timeStamp"
+ 	reference := self coreVMDirectory asFileReference / cogitClass sourceFileName.
+ 	fstat := reference exists ifTrue: [ reference entry ] ifFalse: [nil].
- 	fstat := self coreVMDirectory entryAt: cogitClass sourceFileName ifAbsent:[nil].
  	fstat ifNotNil:[ tStamp < fstat modificationTime asSeconds ifTrue:
  		[^self confirm: 'The ', cogitClass printString, ' classes have not been modified since\ the source file was last generated.\Do you still want to regenerate it?' withCRs]].
  	^true
  !

Item was changed:
  ----- Method: VMMaker>>needsToRegenerateInterpreterFile (in category 'initialize') -----
  needsToRegenerateInterpreterFile
  "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 reference |
- 	| 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].
  	classes copy do:
  		[:class| classes addAllLast: class ancilliaryStructClasses].
  	tStamp := classes inject: 0 into: [:tS :cl| tS max: cl timeStamp].
  
  	"don't translate if the file is newer than my timeStamp"
+ 	reference := self coreVMDirectory asFileReference / self interpreterFilename.
+ 	fstat := reference exists ifTrue: [ reference entry ] ifFalse: [nil].
- 	fstat := self coreVMDirectory entryAt: self interpreterFilename ifAbsent:[nil].
  	fstat ifNotNil:[ tStamp < fstat modificationTime asSeconds ifTrue:
  		[^self confirm: 'The interpreter classes have not been modified since\ the interpreter file was last generated.\Do you still want to regenerate their source file?' withCRs]].
  	^true
  !

Item was changed:
  ----- Method: VMMaker>>platformDirectories (in category 'target directories') -----
  platformDirectories
  	| root |
  	^((root := self platformRootDirectory) directoryNames
  		reject: [:dirName|
  				dirName first = $. ".svn .git et al"
  				or: [dirName ='CVS']])
  		collect: [:dirName|
+ 				root / dirName]!
- 				root directoryNamed: dirName]!

Item was changed:
  ----- Method: VMMaker>>platformDirectory (in category 'source directories') -----
  platformDirectory
  	"return the directory where we should find the platform specific sources"
  	| fd platNm |
+ 	fd := self platformRootDirectory asFileReference.
+ 	(fd / (platNm := self platformName)) exists
- 	fd := self platformRootDirectory.
- 	(fd directoryExists: (platNm := self platformName))
  		ifFalse: ["The supposed directory for the actual platform code  
  			does not exist."
  			^ self couldNotFindPlatformDirectoryFor: platNm].
+ 	^ fd / platNm!
- 	^ fd directoryNamed: platNm!

Item was changed:
  ----- Method: VMMaker>>platformPluginsDirectories (in category 'target directories') -----
  platformPluginsDirectories
  
  	^self platformDirectories
+ 		select: [:dir| (dir / self class pluginsDirName) exists]
+ 		thenCollect: [:dir| (dir / self class pluginsDirName) exists]!
- 		select: [:dir| dir directoryExists: self class pluginsDirName]
- 		thenCollect: [:dir| dir directoryNamed: self class pluginsDirName]!

Item was changed:
  ----- Method: VMMaker>>platformPluginsDirectory (in category 'source directories') -----
  platformPluginsDirectory
  	"return the directory where we should find the platform plugin specific sources"
  
  	(self platformDirectory directoryExists: self class pluginsDirName)
  		ifFalse: ["The supposed directory for the plugins code does not 
  					exist. We need to raise a suitable exception, but cant 
  					think of one right now."
  					^self couldNotFindPlatformDirectoryFor: 'any plugins needing ', self platformName].
+ 	^self platformDirectory / self class pluginsDirName!
- 	^self platformDirectory directoryNamed: self class pluginsDirName!

Item was changed:
  ----- Method: VMMaker>>platformRootDirectory (in category 'source directories') -----
  platformRootDirectory
  	"return the directory where we should find all platform's sources"
  
  	(platformRootDirName ifNil: [ self class platformsDirName ]) asFileReference isDirectory
  		ifFalse: [ 
  			"The supposed directory for the platforms code does not  
  			exist."
  			^ self couldNotFindDirectory: 'the platform code tree' ].
+ 	^ (platformRootDirName ifNil: [ self class platformsDirName ]) fullName!
- 	^ FileSystem workingDirectory directoryNamed: (platformRootDirName ifNil: [ self class platformsDirName ])!

Item was changed:
  ----- Method: VMMaker>>sourceDirectory (in category 'target directories') -----
  sourceDirectory
  	| fd |
+ 	fd := (sourceDirName ifNil: [self class sourceDirName, self vmBitnessString]) asFileReference.
+ 	fd ensureDirectory.
- 	fd := FileSystem workingDirectory directoryNamed: (sourceDirName
- 		ifNil: [self class sourceDirName, self vmBitnessString]).
- 	fd assureExistence.
  	^ fd!

Item was changed:
  ----- Method: VMMaker>>sourceFilePathFor: (in category 'generate sources') -----
  sourceFilePathFor: sourceFileName
  	"Answer the fully-qualified path for the generated source file."
+ 	^(self coreVMDirectory / sourceFileName) fullName!
- 	^self coreVMDirectory fullNameFor: sourceFileName!

Item was changed:
  ----- Method: VMMaker>>storeExternalPluginList (in category 'exports') -----
  storeExternalPluginList
  	| contents filePath fileStream |
  	contents := String streamContents:
  		[:s|
  		s nextPutAll:'# Automatically generated makefile include for external plugins'.
  		s cr; nextPutAll:'EXTERNAL_PLUGINS ='.
  		self externalPluginsDo:
  			[:cls|
  			s space; nextPut: $\; cr; nextPutAll: cls moduleName].
  		s cr].
+ 	filePath := self makefileDirectory / self externalPluginListName.
- 	filePath := self makefileDirectory fullNameFor: self externalPluginListName.
  	(CCodeGenerator basicNew needToGenerateHeader: filePath file: filePath contents: contents) ifTrue:
  		[[fileStream := VMMaker forceNewFileNamed: filePath] 
  			on: FileDoesNotExistException 
  			do:[^self couldNotOpenFile: filePath].
  		 fileStream nextPutAll: contents; close]!

Item was changed:
  ----- Method: VMMaker>>storeInternalPluginList (in category 'exports') -----
  storeInternalPluginList
  	| contents filePath fileStream |
  	contents := String streamContents:
  		[:s|
  		s nextPutAll:'# Automatically generated makefile include for internal plugins'.
  		s cr; nextPutAll:'INTERNAL_PLUGINS ='.
  		self internalPluginsDo:
  			[:cls|
  			s space; nextPut: $\; cr; nextPutAll: cls moduleName].
  		s cr].
+ 	filePath := self makefileDirectory / self internalPluginListName.
- 	filePath := self makefileDirectory fullNameFor: self internalPluginListName.
  	(CCodeGenerator basicNew needToGenerateHeader: filePath file: filePath contents: contents) ifTrue:
  		[[fileStream := VMMaker forceNewFileNamed: filePath] 
  			on: FileDoesNotExistException 
  			do:[^self couldNotOpenFile: filePath].
  		 fileStream nextPutAll: contents; close]!

Item was changed:
  ----- Method: VMMakerTool>>findPlatformsPathFrom:informing: (in category 'path access') -----
  findPlatformsPathFrom: fd informing: bar
  	| dirNames possiblePath |
  	bar value: 'Searching in ', fd pathName.
  	dirNames := fd directoryNames.
  	(dirNames includes: 'platforms') ifTrue:[
  		possiblePath := fd pathName, fd pathNameDelimiter asString, 'platforms'.
  		(self confirm: 'Found a platforms directory at
  ', possiblePath,'
  Do you want me to use it?') ifTrue:[^possiblePath].
  	].
  	dirNames do:[:dd|
+ 		possiblePath := self findPlatformsPathFrom: (fd asFileReference / dd) fullName informing: bar.
- 		possiblePath := self findPlatformsPathFrom: (fd directoryNamed: dd) informing: bar.
  		possiblePath ifNotNil:[^possiblePath].
  	].
  	^nil!



More information about the Vm-dev mailing list