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

commits at source.squeak.org commits at source.squeak.org
Wed Mar 7 01:15:45 UTC 2018


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

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

Name: VMMaker.oscog-eem.2344
Author: eem
Time: 6 March 2018, 5:11:30.627397 pm
UUID: b785e3d3-3c99-4902-83fc-fac211e891de
Ancestors: VMMaker.oscog-eem.2343

Cogit:
Fix the macro definition for simSelf (it must take arguments).

VMMakerTool:
Have the tool open up with the default directories as specified in VMMaker's DirNames dictionary.  Regularise and simplify the directrory checking, even though the code is still really messy.  Delete some unsent methods.  Fix a deprecation warning.

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

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>simSelf (in category 'accessing') -----
  simSelf
+ 	<cmacro: '() simStack'>
- 	<cmacro: ' simStack'>
  	<returnTypeC: #'CogSimStackEntry *'>
  	^self simStackAt: 0!

Item was added:
+ ----- Method: VMMaker class>>rootDirectory (in category 'accessing') -----
+ rootDirectory
+ 	^FileDirectory default directoryNamed: self sourceTree!

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"
+ 	| dir |
+ 	dir := self platformRootDirectory directoryNamed: 'Cross'.
+ 	dir exists ifFalse: "The supposed directory for the actual cross-platform code does not exist."
+ 		[^self couldNotFindPlatformDirectoryFor: 'cross-platform '].
+ 	^dir!
- 	| fd machDirNm |
- 	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 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"
+ 	| dir |
+ 	dir := self crossPlatformDirectory directoryNamed: self class pluginsDirName.
+ 	dir exists ifFalse: "The supposed directory for the plugins code does not exist.
+ 					  We need to raise a suitable exception, but can't think of one right now."
+ 		[^self couldNotFindPlatformDirectoryFor: 'any plugins needing cross-platform'].
+ 	^dir!
- 
- 	(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 directoryNamed: self class pluginsDirName!

Item was removed:
- ----- Method: VMMaker>>externalFilesRequiredFor: (in category 'plugin lists') -----
- externalFilesRequiredFor: plugin
- 	^plugin requiresCrossPlatformFiles or:[plugin requiresPlatformFiles]!

Item was removed:
- ----- Method: VMMaker>>externalModuleNames (in category 'plugin lists') -----
- externalModuleNames
- 	"return the list of all the external plugins' moduleNames"
- 	^Array streamContents:[:strm| self externalPluginsDo:[:pl| strm nextPut: pl moduleName ]]!

Item was changed:
  ----- Method: VMMaker>>initialize (in category 'initialize') -----
  initialize
  	logger := Transcript.
  	inline := true.
  	forBrowser := false.
  	internalPlugins := SortedCollection new.
  	externalPlugins := SortedCollection new.
  	platformName := self class machinesDirName.
  	is64BitVM := false.
+ 	interpreterClassName := StackInterpreterPrimitives name.
- 	interpreterClassName := Interpreter name.
  	optionsDictionary := Dictionary newFromPairs: {#BytesPerWord. 4}.
  	VMStructType voidStructTypeCache!

Item was removed:
- ----- Method: VMMaker>>initializeAllExternal (in category 'initialize') -----
- initializeAllExternal
- 	"add all the plugins to the external list and make sure the internal list is empty"
- 
- 	self initializeInternal: #() external: self availablePlugins !

Item was removed:
- ----- Method: VMMaker>>initializeAllExternalBut: (in category 'initialize') -----
- initializeAllExternalBut: arrayOfInternalPluginNames
- 	"add all the plugins to the external list except for those listed, which should be added to the internal list"
- 
- 	self initializeInternal: arrayOfInternalPluginNames external: (self availablePlugins copyWithoutAll: arrayOfInternalPluginNames )!

Item was removed:
- ----- Method: VMMaker>>initializeAllInternal (in category 'initialize') -----
- initializeAllInternal
- 	"add all the plugins to the internal list and make sure the external list is empty"
- 
- 	self initializeInternal: self availablePlugins  external: #()!

Item was removed:
- ----- Method: VMMaker>>initializeAllInternalBut: (in category 'initialize') -----
- initializeAllInternalBut: arrayOfExternalPluginNames
- 	"add all the plugins to the internal list except for those listed, which should be added to the external list"
- 
- 	self initializeInternal: (self availablePlugins copyWithoutAll: arrayOfExternalPluginNames) external:  arrayOfExternalPluginNames!

Item was removed:
- ----- Method: VMMaker>>internalModuleNames (in category 'plugin lists') -----
- internalModuleNames
- 	"return the list of all the internal plugins' moduleNames"
- 	^Array streamContents:[:strm| self internalPluginsDo:[:pl| strm nextPut: pl moduleName ]]!

Item was removed:
- ----- Method: VMMaker>>isFor32BitVM (in category 'initialize') -----
- isFor32BitVM
- "is my flag to make a 32bit pointer model VM?"
- 	^is64BitVM not!

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

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

Item was changed:
  ----- Method: VMMaker>>platformRootDirectory (in category 'source directories') -----
  platformRootDirectory
+ 	"Answer the directory where we should find all platform's sources"
+ 	| dir |
+ 	dir := FileDirectory default directoryNamed: self platformRootDirectoryName.
+ 	dir exists ifFalse: "The supposed directory for the platforms code does not exist."
+ 		 [^self couldNotFindDirectory: 'the platform code tree'].
+ 	^dir!
- 	"return the directory where we should find all platform's sources"
- 	(FileDirectory default
- 			directoryExists: (platformRootDirName
- 					ifNil: [self class platformsDirName]))
- 		ifFalse: ["The supposed directory for the platforms code does not  
- 			exist."
- 			^ self couldNotFindDirectory: 'the platform code tree'].
- 	^ FileDirectory default
- 		directoryNamed: (platformRootDirName
- 				ifNil: [self class platformsDirName])!

Item was changed:
  ----- Method: VMMaker>>platformRootDirectoryName (in category 'source directories') -----
  platformRootDirectoryName
  	"Answer the name of the directory where we should find all platform's sources"
+ 	^platformRootDirName ifNil:
+ 		[self class rootDirectory fullNameFor: self class platformsDirName]!
- 	^platformRootDirName!

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

Item was changed:
  ----- Method: VMMaker>>sourceDirectoryName (in category 'target directories') -----
  sourceDirectoryName
+ 	^sourceDirName ifNil:
+ 		[self class rootDirectory fullNameFor: self class sourceDirName]!
- 	^sourceDirName!

Item was removed:
- ----- Method: VMMaker>>sourceFileNameFor: (in category 'target directories') -----
- sourceFileNameFor: aVMClass
- 	"Answer the source file name for a VM class."
- 
- 	^aVMClass sourceFileName!

Item was removed:
- ----- Method: VMMaker>>vmBitnessString (in category 'target directories') -----
- vmBitnessString
- 	"Return a string of 32 or 64 depending on the is64BitVM valuse"
- 	^is64BitVM ifTrue:['64'] ifFalse:['32']!

Item was changed:
  ----- Method: VMMakerTool>>entryRowWithLabel:balloonText:getFieldText:setFieldText:buttonLabel:buttonAction:buttonBalloonText: (in category 'window construction') -----
  entryRowWithLabel: label balloonText: balloonText getFieldText: getTextSelector setFieldText: setTextSelector buttonLabel: buttonLabel buttonAction: buttonAction buttonBalloonText: buttonBalloonText 
  	| row lWidth |
  	lWidth := TextStyle defaultFont pixelSize * 11.
  	row := Morph new color: Color transparent;
  				 hResizing: #spaceFill;
  				 vResizing: #spaceFill;
  				 extent: 550 @ 40;
  				 layoutPolicy: ProportionalLayout new;
  				 borderWidth: 2;
  				 setBalloonText: balloonText translated;
  				 yourself.
  	row
  		addMorph: (TextMorph new contents: label translated asText allBold) lock
  		fullFrame: (LayoutFrame
  				fractions: (0 @ 0 corner: 0 @ 1)
  				offsets: (3 @ 3 corner: lWidth @ -3)).
  	row
  		addMorph: ((PluggableTextMorph
  				on: self
  				text: getTextSelector
+ 				accept: setTextSelector) vScrollBarPolicy: #never;
- 				accept: setTextSelector) hideVScrollBarIndefinitely: true;
  				 acceptOnCR: true)
  		fullFrame: (LayoutFrame
  				fractions: (0 @ 0 corner: 1 @ 1)
  				offsets: (lWidth + 10 @ 0 corner: (lWidth / 1.8 + 10) negated @ 0)).
  	buttonAction
  		ifNotNil: [row
  				addMorph: (SimpleButtonMorph new target: self;
  						 label: buttonLabel translated;
  						 actionSelector: buttonAction;
  						 hResizing: #spaceFill;
  						 setBalloonText: buttonBalloonText translated)
  				fullFrame: (LayoutFrame
  						fractions: (1 @ 0 corner: 1 @ 1)
  						offsets: ((lWidth / 1.8 + 5) negated @ 3 corner: -5 @ -3))].
  	^ row!



More information about the Vm-dev mailing list