Merge branch 'pharo-10' into fix-vmmaker-command-2

CHANGELOG.md

@@ -1,5 +1,16 @@
 # Change log
 
+## v10.1.0
+* Fixing undefined behaviors that Clang 15 removes by @tesonep in https://github.com/pharo-project/pharo-vm/pull/731
+* Fix ‘doReport’ to take into account that ‘fopen’ can return NULL by @Rinzwind in https://github.com/pharo-project/pharo-vm/pull/739
+* Change custom command in ‘vmmaker.cmake’ to take into account that the ‘CMAKE_CURRENT_BINARY_DIR_TO_OUT’ can contain spaces by @Rinzwind in https://github.com/pharo-project/pharo-vm/pull/738
+* Integrating new format by @tesonep in https://github.com/pharo-project/pharo-vm/pull/734
+
+ New Contributors
+* @Rinzwind made their first contribution in https://github.com/pharo-project/pharo-vm/pull/739
+
+**Full Changelog**: https://github.com/pharo-project/pharo-vm/compare/v10.0.9...v10.1.0
+
 ## v10.0.9
 
 * Improves in PermSpace by @tesonep in https://github.com/pharo-project/pharo-vm/pull/684

CMakeLists.txt

@@ -41,7 +41,6 @@ set(APPNAME			"Pharo"         CACHE STRING                 "VM Application name"
 set(FLAVOUR			"CoInterpreter" CACHE STRING                 "The kind of VM to generate. Possible values: StackVM, CoInterpreter")
 set(PHARO_LIBRARY_PATH		"@executable_path/Plugins" CACHE STRING      "The RPATH to use in the build")
 set(ICEBERG_DEFAULT_REMOTE	"scpUrl"        CACHE STRING                 "If Iceberg uses HTTPS (httpsUrl) or tries first with SSH (scpUrl)")
-set(IMAGE_FORMAT	"SpurFormat"	CACHE STRING				 "Image Format to use in the builtVM (SpurFormat / ComposedFormat)")
 
 if(VERBOSE_BUILD)
     set(CMAKE_VERBOSE_MAKEFILE TRUE)
@@ -52,8 +51,8 @@ include(cmake/versionExtraction.cmake)
 extractVCSInformation(GIT_COMMIT_HASH GIT_DESCRIBE GIT_COMMIT_DATE)
 
 set(VERSION_MAJOR 10)
-set(VERSION_MINOR 0)
-set(VERSION_PATCH_NUMBER 9)
+set(VERSION_MINOR 1)
+set(VERSION_PATCH_NUMBER 0)
 
 if(BUILD_IS_RELEASE)
 	set(VERSION_PATCH "${VERSION_PATCH_NUMBER}")

Jenkinsfile

@@ -493,9 +493,6 @@ try{
 				timeout(40){
 					runBuild(platform, "StackVM")
 				}
-				timeout(40){
-					runBuild("${platform}-ComposedFormat", "CoInterpreter", true, " -DIMAGE_FORMAT=ComposedFormat ")
-				}
 				timeout(40){
 					// Only build the Stock replacement version in the main branch
 					if(isMainBranch()){

cmake/vmmaker.cmake

@@ -144,7 +144,7 @@ if(GENERATE_SOURCES)
     #Custom command that generates the vm source code from VMMaker into the generated folder
     add_custom_command(
         OUTPUT ${VMSOURCEFILES} ${PLUGIN_GENERATED_FILES}
-        COMMAND ${VMMAKER_VM} --headless ${VMMAKER_IMAGE} --no-default-preferences perform PharoVMMaker generate:outputDirectory:imageFormat: ${FLAVOUR} ${CMAKE_CURRENT_BINARY_DIR_TO_OUT} ${IMAGE_FORMAT}
+        COMMAND ${VMMAKER_VM} --headless ${VMMAKER_IMAGE} --no-default-preferences perform PharoVMMaker generate:outputDirectory: ${FLAVOUR} ${CMAKE_CURRENT_BINARY_DIR_TO_OUT}
         VERBATIM
         DEPENDS vmmaker ${VMMAKER_IMAGE} ${VMMAKER_VM}
         COMMENT "Generating VM files for flavour: ${FLAVOUR}")

include/pharovm/imageAccess.h

@@ -19,6 +19,7 @@ typedef struct {
 	size_t (*imageFileWrite)(void* ptr, size_t sz, size_t count, sqImageFile f);
 	int (*imageFileExists)(const char* aPath);
 	void (*imageReportProgress)(size_t totalSize, size_t currentSize);
+	int (*imageIsDirectory)(const char* aPath);
 } _FileAccessHandler;
 
 typedef _FileAccessHandler FileAccessHandler;
@@ -38,6 +39,8 @@ EXPORT(void) setFileAccessHandler(FileAccessHandler* aFileAccessHandler);
 
 #define sqImageFileExists(aPath)			currentFileAccessHandler()->imageFileExists(aPath)
 
+#define sqImageIsDirectory(aPath)			currentFileAccessHandler()->imageIsDirectory(aPath)
+
 #define sqImageFileStartLocation(fileRef, fileName, size)  0
 #define sqImageReportProgress(totalSize, currentSize)	currentFileAccessHandler()->imageReportProgress(totalSize, currentSize)
 

smalltalksrc/Melchor/VMClass.class.st

@@ -287,6 +287,14 @@ VMClass class >> objectRepresentationClass [
 	^self objectMemoryClass objectRepresentationClass
 ]
 
+{ #category : #translation }
+VMClass class >> renameSelectorIfStaticallyResolved: aString [
+
+	^ (self staticallyResolvedSelectors includes: aString)
+		  ifTrue: [ self staticallyResolvePolymorphicSelector: aString ]
+		  ifFalse: [ ^ aString ]
+]
+
 { #category : #translation }
 VMClass class >> shouldGenerateTypedefFor: aStructClass [
 	"Hack to work-around multiple definitions.  Sometimes a type has been defined in an include."
@@ -331,6 +339,12 @@ VMClass class >> staticallyResolvePolymorphicSelector: aSelectorSymbol [
 	^((self name select: [:ea| ea isUppercase]), '_', aSelectorSymbol) asSymbol
 ]
 
+{ #category : #translation }
+VMClass class >> staticallyResolvedSelectors [
+
+	^ #()
+]
+
 { #category : #translation }
 VMClass class >> timeStamp [
 	^timeStamp ifNil:[0]

smalltalksrc/Slang/CCodeGenerator.class.st

@@ -704,43 +704,51 @@ CCodeGenerator >> checkClassForNameConflicts: aClass [
 	 those of previously added classes. Raise an error if a conflict is found, otherwise just return."
 
 	"check for constant name collisions in class pools"
-	aClass classPool associationsDo:
-		[:assoc |
-		(constants includesKey: assoc key) ifTrue:
-			[self error: 'Constant ', assoc key, ' was defined in a previously added class']].
+
+	| tmeth renamedSelector |
+	aClass classPool associationsDo: [ :assoc |
+		(constants includesKey: assoc key) ifTrue: [
+			self error:
+				'Constant ' , assoc key
+				, ' was defined in a previously added class' ] ].
 
 	"and in shared pools"
-	(aClass sharedPools reject: [:pool| pools includes: pool]) do:
-		[:pool |
-		pool bindingsDo:
-			[:assoc |
-			(constants includesKey: assoc key) ifTrue:
-				[self error: 'Constant ', assoc key, ' was defined in a previously added class']]].
+	(aClass sharedPools reject: [ :pool | pools includes: pool ]) do: [
+		:pool |
+		pool bindingsDo: [ :assoc |
+			(constants includesKey: assoc key) ifTrue: [
+				self error:
+					'Constant ' , assoc key
+					, ' was defined in a previously added class' ] ] ].
 
 	"check for instance variable name collisions"
-	(aClass inheritsFrom: SlangStructType) ifFalse:
-		[(self instVarNamesForClass: aClass) do:
-			[:varName |
-			(variables includes: varName) ifTrue:
-				[self error: 'Instance variable ', varName, ' was defined in a previously added class']]].
+	(aClass inheritsFrom: SlangStructType) ifFalse: [
+		(self instVarNamesForClass: aClass) do: [ :varName |
+			(variables includes: varName) ifTrue: [
+				self error: 'Instance variable ' , varName
+					, ' was defined in a previously added class' ] ] ].
 
 	"check for method name collisions"
-	aClass selectors do:
-		[:sel | | tmeth meth |
-		((self shouldIncludeMethodFor: aClass selector: sel)
-		and: [(tmeth := methods at: sel ifAbsent: nil) notNil
-		and: [(aClass isStructClass and: [(aClass isAccessor: sel)
-				and: [(methods at: sel) isStructAccessor]]) not
-		and: [(meth := aClass >> sel) isSubclassResponsibility not
-		and: [(aClass includesBehavior: tmeth definingClass) not]]]]) ifTrue:
-			[((aClass >>sel) pragmaAt: #option:)
-				ifNil: [self error: 'Method ', sel, ' was defined in a previously added class.']
-				ifNotNil:
-					[logger
+	aClass selectors do: [ :sel |
+		renamedSelector := aClass renameSelectorIfStaticallyResolved: sel.
+		(self
+			 isDuplicatedSelector: sel
+			 translatedName: renamedSelector
+			 fromClass: aClass) ifTrue: [
+			(aClass >> renamedSelector pragmaAt: #option:)
+				ifNil: [
+					self error: 'Method ' , renamedSelector
+						, ' was defined in a previously added class.' ]
+				ifNotNil: [
+					tmeth := methods at: renamedSelector.
+
+					logger
 						newLine;
-						show: 'warning, method ', aClass name, '>>', sel storeString,
-								' overrides ', tmeth definingClass, '>>', sel storeString;
-						cr]]]
+						show:
+							'warning, method ' , aClass name , '>>'
+							, renamedSelector storeString , ' overrides '
+							, tmeth definingClass , '>>' , renamedSelector storeString;
+						cr ] ] ]
 ]
 
 { #category : #utilities }
@@ -2990,19 +2998,24 @@ CCodeGenerator >> harmonizeReturnTypesIn: aSetOfTypes [
 ]
 
 { #category : #public }
-CCodeGenerator >> ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn: aSendNode [
+CCodeGenerator >> ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn: aSendNode inMethod: aTMethod [
 	"We allow a limited amount of polymorphism; if a class chooses, its selectoers can be
 	 prefixed with a given string to disambiguate. This hack allows us to use two different
 	 compaction algorithms with the same API at the same time; the selection being done
 	 by a class which holds the flag stating which algorithm is in effect at the current time."
+
 	| class |
-	staticallyResolvedPolymorphicReceivers ifNil: [^self].
-	aSendNode receiver isVariable ifFalse:
-		[^self].
-	class := staticallyResolvedPolymorphicReceivers
-				at: aSendNode receiver name
-				ifAbsent: [^self].
-	aSendNode selector: (class staticallyResolvePolymorphicSelector: aSendNode selector)
+	staticallyResolvedPolymorphicReceivers ifNil: [ ^ self ].
+	aSendNode receiver isVariable ifFalse: [ ^ self ].
+
+	class := (aSendNode isSelfReference: aSendNode receiver in: self)
+		ifTrue: [ aTMethod definingClass ] 
+		ifFalse: [ staticallyResolvedPolymorphicReceivers
+		         at: aSendNode receiver name
+		         ifAbsent: [ ^ self ] ].
+	
+	aSendNode selector:
+		(class renameSelectorIfStaticallyResolved: aSendNode selector)
 ]
 
 { #category : #'type inference' }
@@ -3427,6 +3440,27 @@ CCodeGenerator >> isControlFlowNode: aNode [
 		#(ifTrue: ifTrue:ifFalse: ifFalse: ifFalse:ifTrue: and: or:) includes: aNode selector ]
 ]
 
+{ #category : #testing }
+CCodeGenerator >> isDuplicatedSelector: sel translatedName: translatedSelector fromClass: aClass [
+
+	| tmeth meth |
+	(self shouldIncludeMethodFor: aClass selector: sel) ifFalse: [
+		^ false ].
+
+	"I have to search in the included methods with the translated selector, as this is the one that is added"
+	tmeth := methods at: translatedSelector ifAbsent: [ ^ false ].
+
+	(aClass isStructClass and: [
+		 (aClass isAccessor: sel) and: [ (methods at: sel) isStructAccessor ] ])
+		ifTrue: [ ^ false ].
+
+	(meth := aClass >> sel) isSubclassResponsibility ifTrue: [ ^ false ].
+	(aClass includesBehavior: tmeth definingClass) ifTrue: [ ^ false ].
+
+
+	^ true
+]
+
 { #category : #utilities }
 CCodeGenerator >> isDynamicCall: aNode [
 	"Dynamic calls are calls to functions/methods determined at runtime.
@@ -4731,12 +4765,11 @@ CCodeGenerator >> staticallyResolveMethodNamed: selector forClass: aClass to: st
 	 prefixed with a given string to disambiguate. This hack allows us to use two different
 	 compaction algorithms with the same API at the same time; the selection being done
 	 by a class which holds the flag stating which algorithm is in effect at the current time."
+
 	| method |
-	method := methods
-					removeKey: selector
-					ifAbsent:
-						[self logger cr; nextPutAll: 'warning: did not find ', selector, ' to be able to map to ', staticallyResolvedSelector.
-						^self].
+
+1halt.
+
 	method selector: staticallyResolvedSelector.
 	methods at: staticallyResolvedSelector put: method
 ]
@@ -4749,7 +4782,11 @@ CCodeGenerator >> staticallyResolvedPolymorphicReceiver: variableName to: aClass
 	 by a class which holds the flag stating which algorithm is in effect at the current time."
 	(staticallyResolvedPolymorphicReceivers ifNil: [staticallyResolvedPolymorphicReceivers := Dictionary new])
 		at: variableName
-		put: aClass
+		put: aClass.
+	
+	"When the variable is statically defined it should be implicit"
+	self declareVar: variableName type: #implicit
+
 ]
 
 { #category : #'C translation support' }

smalltalksrc/Slang/SlangClass.class.st

@@ -40,6 +40,12 @@ SlangClass class >> prepareToBeAddedToCodeGenerator: aCCodeGenerator [
 	 superclass's methods by deleting them before it adds its own."
 ]
 
+{ #category : #'as yet unclassified' }
+SlangClass class >> renameSelectorIfStaticallyResolved: aString [ 
+
+	^ aString
+]
+
 { #category : #translation }
 SlangClass class >> requiredMethodNames: options [
 	"Answer a list of method names that should be retained for export or other

smalltalksrc/Slang/TMethod.class.st

@@ -2226,41 +2226,53 @@ TMethod >> prepareMethodIn: aCodeGen [
 	 Declare limit variables for to:[by:]do: loops with limits that potentially have side-effects.
 	 As a hack also update the types of variables introduced to implement cascades correctly.
 	 This has to be done at the same time as this is done, so why not piggy back here?"
-	extraVariableNumber ifNotNil:
-		[declarations keysAndValuesDo:
-			[:varName :decl|
-			decl isBlock ifTrue:
-				[self assert: ((varName beginsWith: 'cascade') and: [varName last isDigit]).
+
+	extraVariableNumber ifNotNil: [
+		declarations keysAndValuesDo: [ :varName :decl |
+			decl isBlock ifTrue: [
+				self assert:
+					((varName beginsWith: 'cascade') and: [ varName last isDigit ]).
 				cachedLocals := nil.
-				 self locals add: varName.
-				 self declarationAt: varName
-					put: (decl value: self value: aCodeGen), ' ', varName]]].
+				self locals add: varName.
+				self
+					declarationAt: varName
+					put: (decl value: self value: aCodeGen) , ' ' , varName ] ] ].
 	aCodeGen
 		pushScope: self
-		while:"N.B.  nodesWithParentsDo: is bottom-up, hence replacement is destructive and conserved."
-			[parseTree nodesWithParentsDo:
-				[:node :parent|
-				 node isSend ifTrue:
-					[aCodeGen ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn: node.
-					 (aCodeGen isBuiltinSelector: node selector)
-						ifTrue:
-							[node isBuiltinOperator: true.
+		while: [ "N.B.  nodesWithParentsDo: is bottom-up, hence replacement is destructive and conserved."
+			parseTree nodesWithParentsDo: [ :node :parent |
+				node isSend ifTrue: [
+					aCodeGen
+						ifStaticallyResolvedPolymorphicReceiverThenUpdateSelectorIn:
+						node
+						inMethod: self.
+					(aCodeGen isBuiltinSelector: node selector)
+						ifTrue: [
+							node isBuiltinOperator: true.
 							"If a to:by:do:'s limit has side-effects, declare the limit variable, otherwise delete it from the args"
-							 node selector = #to:by:do: ifTrue:
-								[self ensureToByDoLoopLimitIsSafeAndEfficient: node in: aCodeGen]]
-						ifFalse:
-							[(CaseStatements includes: node selector) ifTrue:
-								[parent replaceNodesIn: (Dictionary newFromPairs: { node. self buildCaseStmt: node in: aCodeGen})].
-							 (#(caseOf: #caseOf:otherwise:) includes: node selector) ifTrue:
-								[parent replaceNodesIn: (Dictionary newFromPairs: { node. self buildSwitchStmt: node parent: parent })].
-							 (#(printf: f:printf:) includes: node selector) ifTrue:
-								[| map |
+							node selector = #to:by:do: ifTrue: [
+								self
+									ensureToByDoLoopLimitIsSafeAndEfficient: node
+									in: aCodeGen ] ]
+						ifFalse: [
+							(CaseStatements includes: node selector) ifTrue: [
+								parent replaceNodesIn: (Dictionary newFromPairs: {
+											 node.
+											 (self buildCaseStmt: node in: aCodeGen) }) ].
+							(#( caseOf: #caseOf:otherwise: ) includes: node selector)
+								ifTrue: [
+									parent replaceNodesIn: (Dictionary newFromPairs: {
+												 node.
+												 (self buildSwitchStmt: node parent: parent) }) ].
+							(#( printf: #f:printf: ) includes: node selector) ifTrue: [
+								| map |
 								map := Dictionary new.
-								node nodesDo:
-									[:subNode|
-									 (subNode isConstant and: [subNode value isString and: [subNode value includes: $%]]) ifTrue:
-										[map at: subNode put: subNode asPrintfFormatStringNode].
-								node replaceNodesIn: map]]]]]]
+								node nodesDo: [ :subNode |
+									(subNode isConstant and: [
+										 subNode value isString and: [ subNode value includes: $% ] ])
+										ifTrue: [
+										map at: subNode put: subNode asPrintfFormatStringNode ].
+									node replaceNodesIn: map ] ] ] ] ] ]
 ]
 
 { #category : #'primitive compilation' }

smalltalksrc/Slang/TSendNode.class.st

@@ -584,7 +584,7 @@ TSendNode >> shouldExcludeReceiverAsFirstArgument: aCodeGen [
 	| m |
 	(aCodeGen isAssertSelector: selector) ifTrue:
 		[^true].
-
+	
 	(receiver isSend
 	 and: [(receiver shouldExcludeReceiverAsFirstArgument: aCodeGen)
 		or: [receiver receiver isVariable