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

commits at source.squeak.org commits at source.squeak.org
Sat Nov 20 00:41:52 UTC 2021


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

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

Name: VMMaker.oscog-eem.3102
Author: eem
Time: 19 November 2021, 4:41:40.684801 pm
UUID: bbe98378-63f2-4143-bc22-fb1bc9fd8981
Ancestors: VMMaker.oscog-eem.3101

CoInterpreter: fix a slip in printStringDataOf:on:.

SpurMemoryManager: move changeClassOf:to: up and use bytesPerOop to eliminate duplication of the whole method.

Slang: eliminate an obsolete halt.

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

Item was changed:
  ----- Method: ObjectMemory>>printStringDataOf:on: (in category 'debug printing interpreter support') -----
  printStringDataOf: oop on: aStream
  	<var: 'aStream' type: #'FILE *'>
+ 	| i n limit |
- 	| i limit n |
  	<var: 'buffer' type: #'char *'>
  	<var: 'wideBuffer' type: #'unsigned int *'>
  	(self isBytesNonImm: oop)
  		ifTrue:
  			[| buffer byte |
  			 buffer := self alloca: 256 * 4.
  			 n := i := 0.
  			 limit := (self numBytesOfBytes: oop) min: 256.
  			 [i < limit] whileTrue:
  				[byte := self fetchByte: i ofObject: oop.
+ 				 i := i + 1.
  				 (byte < 32 "space" and: [byte ~= 9 "tab"])
  					ifTrue:
  						[buffer at: n put: $<. n := n + 1.
  						 (byte = 10 or: [byte = 13])
  							ifTrue:
  								[byte = 10
  									ifTrue: [buffer at: n put: $L; at: n + 1 put: $F]
  									ifFalse: [buffer at: n put: $C; at: n + 1 put: $R].
  								 n := n + 2]
  							ifFalse:
  								[byte >= 10 ifTrue:
  									[buffer at: n put: byte // 10 + $0 asInteger. n := n + 1].
  								 buffer at: n put: byte \\ 10 + $0 asInteger. n := n + 1].
  						 buffer at: n put: $>. n := n + 1]
  					ifFalse: [buffer at: n put: byte. n := n + 1]].
  			 '%.*s%s\n' f: aStream printf: { n. buffer. (self numBytesOfBytes: oop) > limit ifTrue: ['...'] ifFalse: [''] }]
  		ifFalse:
  			[| wideBuffer word |
  			 self assert: (self isWordsNonImm: oop).
  			 wideBuffer := self cCoerce: (self alloca: 1024 * 4) to: 'int *'.
  			 n := i := 0.
  			 limit := (self lengthOf: oop) min: 256.
  			 [i < limit] whileTrue:
  				[word := self fetchLong32: i ofObject: oop.
+ 				 i := i + 1.
  				 (word < 32 "space" and: [word ~= 9 "tab"])
  					ifTrue:
  						[wideBuffer at: n put: $<. n := n + 1.
  						 (word = 10 or: [word = 13])
  							ifTrue:
  								[word = 10
  									ifTrue: [wideBuffer at: n put: $L; at: n + 1 put: $F]
  									ifFalse: [wideBuffer at: n put: $C; at: n + 1 put: $R].
  								 n := n + 2]
  							ifFalse:
  								[word >= 10 ifTrue:
  									[wideBuffer at: n put: word // 10 + $0 asInteger. n := n + 1].
  								 wideBuffer at: n put: word \\ 10 + $0 asInteger. n := n + 1].
  						 wideBuffer at: n put: $>. n := n + 1]
  					ifFalse: [wideBuffer at: n put: word. n := n + 1]].
  			 '%.*s%s\n' f: aStream wprintf: { n. wideBuffer. (self lengthOf: oop) > limit ifTrue: ['...'] ifFalse: [''] }]!

Item was removed:
- ----- Method: Spur32BitMemoryManager>>changeClassOf:to: (in category 'interpreter access') -----
- changeClassOf: rcvr to: argClass
- 	"Attempt to change the class of the receiver to the argument given that the
- 	 format of the receiver matches the format of the argument.  If successful,
- 	 answer 0, otherwise answer an error code indicating the reason for failure. 
- 	 Fail if the format of the receiver is incompatible with the format of the argument,
- 	 or if the argument is a fixed class and the receiver's size differs from the size
- 	 that an instance of the argument should have."
- 	<inline: false>
- 	| classFormat fixedFields instFormat newFormat classIndex instSlots instBytes |
- 	(self isObjImmutable: rcvr) ifTrue:
- 		[^PrimErrNoModification].
- 	classFormat := self formatOfClass: argClass.
- 	fixedFields := self fixedFieldsOfClassFormat: classFormat.
- 	classFormat := self instSpecOfClassFormat: classFormat.
- 	instFormat := self formatOf: rcvr.
- 
- 	"Fail for inability to access classIndex before making contexts snapshot-safe."
- 	(classIndex := self ensureBehaviorHash: argClass) < 0 ifTrue:
- 		[^classIndex negated].
- 
- 	"Now check the instance for compatibility and compute odd bits if necessary."
- 	classFormat <= self lastPointerFormat
- 		ifTrue:
- 			[instFormat > self lastPointerFormat ifTrue:
- 				[^PrimErrInappropriate].
- 			 ((instSlots := self numSlotsOf: rcvr) < fixedFields
- 			  or: [instSlots > fixedFields and: [self isFixedSizePointerFormat: classFormat]]) ifTrue:
- 				[^PrimErrBadReceiver].
- 			 (instFormat = self indexablePointersFormat
- 			  and: [self isContextNonImm: rcvr]) ifTrue:
- 				[coInterpreter makeContextSnapshotSafe: rcvr].
- 			 newFormat := classFormat]
- 		ifFalse:
- 			["Fail if the class's format is somehow invalid."
- 			 classFormat ~= (self classFormatFromInstFormat: classFormat) ifTrue:
- 				[^PrimErrBadArgument].
- 
- 			 instBytes := self numBytesOf: rcvr.
- 			 classFormat
- 				caseOf: {
- 				[self sixtyFourBitIndexableFormat]
- 					-> [(instBytes anyMask: 7) ifTrue: [^PrimErrBadReceiver].
- 						newFormat := classFormat].
- 				[self firstLongFormat] 		
- 					-> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver].
- 						newFormat := classFormat].
- 				[self firstShortFormat] 		
- 					-> [(instBytes anyMask: 1) ifTrue: [^PrimErrBadReceiver].
- 						newFormat := classFormat + (2 - (instBytes >> 1) bitAnd: 1)].
- 				[self firstByteFormat]
- 					-> [newFormat := classFormat + (4 - instBytes bitAnd: 3)].
- 				[self firstCompiledMethodFormat]
- 					-> [classFormat ~= self firstCompiledMethodFormat ifTrue:
- 							[^PrimErrInappropriate].
- 						newFormat := instFormat] }
- 				otherwise: "bits instances cannot be adopted by pointer-like classes..."
- 					[^PrimErrInappropriate]].
- 
- 	self set: rcvr classIndexTo: classIndex formatTo: newFormat.
- 
- 	self assert: (self numBytesOf: rcvr) = (classFormat <= self lastPointerFormat
- 											ifTrue: [instSlots * self bytesPerOop]
- 											ifFalse: [instBytes]).
- 	"ok"
- 	^0!

Item was removed:
- ----- Method: Spur64BitMemoryManager>>changeClassOf:to: (in category 'interpreter access') -----
- changeClassOf: rcvr to: argClass
- 	"Attempt to change the class of the receiver to the argument given that the
- 	 format of the receiver matches the format of the argument.  If successful,
- 	 answer 0, otherwise answer an error code indicating the reason for failure. 
- 	 Fail if the format of the receiver is incompatible with the format of the argument,
- 	 or if the argument is a fixed class and the receiver's size differs from the size
- 	 that an instance of the argument should have."
- 	<inline: false>
- 	| classFormat fixedFields instFormat newFormat classIndex instSlots instBytes |
- 	(self isObjImmutable: rcvr) ifTrue:
- 		[^PrimErrNoModification].
- 	classFormat := self formatOfClass: argClass.
- 	fixedFields := self fixedFieldsOfClassFormat: classFormat.
- 	classFormat := self instSpecOfClassFormat: classFormat.
- 	instFormat := self formatOf: rcvr.
- 
- 	"Fail for inability to access classIndex before making contexts snapshot-safe."
- 	(classIndex := self ensureBehaviorHash: argClass) < 0 ifTrue:
- 		[^classIndex negated].
- 
- 	"Now check the instance for compatibility and compute odd bits if necessary."
- 	classFormat <= self lastPointerFormat
- 		ifTrue:
- 			[instFormat > self lastPointerFormat ifTrue:
- 				[^PrimErrInappropriate].
- 			 ((instSlots := self numSlotsOf: rcvr) < fixedFields
- 			  or: [instSlots > fixedFields and: [self isFixedSizePointerFormat: classFormat]]) ifTrue:
- 				[^PrimErrBadReceiver].
- 			 (instFormat = self indexablePointersFormat
- 			  and: [self isContextNonImm: rcvr]) ifTrue:
- 				[coInterpreter makeContextSnapshotSafe: rcvr].
- 			 newFormat := classFormat]
- 		ifFalse:
- 			["Fail if the class's format is somehow invalid."
- 			 classFormat ~= (self classFormatFromInstFormat: classFormat) ifTrue:
- 				[^PrimErrBadArgument].
- 
- 			 instBytes := self numBytesOf: rcvr.
- 			 classFormat
- 				caseOf: {
- 				[self sixtyFourBitIndexableFormat]
- 					-> [(instBytes anyMask: 7) ifTrue: [^PrimErrBadReceiver].
- 						newFormat := classFormat].
- 				[self firstLongFormat] 		
- 					-> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver].
- 						newFormat := classFormat + (2 - (instBytes >> 2) bitAnd: 1)].
- 				[self firstShortFormat] 		
- 					-> [(instBytes anyMask: 1) ifTrue: [^PrimErrBadReceiver].
- 						newFormat := classFormat + (4 - (instBytes >> 1) bitAnd: 3)].
- 				[self firstByteFormat]
- 					-> [newFormat := classFormat + (8 - instBytes bitAnd: 7)].
- 				[self firstCompiledMethodFormat]
- 					-> [classFormat ~= self firstCompiledMethodFormat ifTrue:
- 							[^PrimErrInappropriate].
- 						newFormat := instFormat] }
- 				otherwise: "bits instances cannot be adopted by pointer-like classes..."
- 					[^PrimErrInappropriate]].
- 
- 	self set: rcvr classIndexTo: classIndex formatTo: newFormat.
- 
- 	self assert: (self numBytesOf: rcvr) = (classFormat <= self lastPointerFormat
- 											ifTrue: [instSlots * self bytesPerOop]
- 											ifFalse: [instBytes]).
- 	"ok"
- 	^0!

Item was changed:
  ----- Method: SpurMemoryManager>>changeClassOf:to: (in category 'interpreter access') -----
  changeClassOf: rcvr to: argClass
  	"Attempt to change the class of the receiver to the argument given that the
  	 format of the receiver matches the format of the argument.  If successful,
  	 answer 0, otherwise answer an error code indicating the reason for failure. 
  	 Fail if the format of the receiver is incompatible with the format of the argument,
  	 or if the argument is a fixed class and the receiver's size differs from the size
  	 that an instance of the argument should have."
+ 	<inline: false>
+ 	| classFormat fixedFields instFormat newFormat classIndex instSlots instBytes |
+ 	(self isObjImmutable: rcvr) ifTrue:
+ 		[^PrimErrNoModification].
+ 	classFormat := self formatOfClass: argClass.
+ 	fixedFields := self fixedFieldsOfClassFormat: classFormat.
+ 	classFormat := self instSpecOfClassFormat: classFormat.
+ 	instFormat := self formatOf: rcvr.
+ 
+ 	"Fail for inability to access classIndex before making contexts snapshot-safe."
+ 	(classIndex := self ensureBehaviorHash: argClass) < 0 ifTrue:
+ 		[^classIndex negated].
+ 
+ 	"Now check the instance for compatibility and compute odd bits if necessary."
+ 	classFormat <= self lastPointerFormat
+ 		ifTrue:
+ 			[instFormat > self lastPointerFormat ifTrue:
+ 				[^PrimErrInappropriate].
+ 			 ((instSlots := self numSlotsOf: rcvr) < fixedFields
+ 			  or: [instSlots > fixedFields and: [self isFixedSizePointerFormat: classFormat]]) ifTrue:
+ 				[^PrimErrBadReceiver].
+ 			 (instFormat = self indexablePointersFormat
+ 			  and: [self isContextNonImm: rcvr]) ifTrue:
+ 				[coInterpreter makeContextSnapshotSafe: rcvr].
+ 			 newFormat := classFormat]
+ 		ifFalse:
+ 			["Fail if the class's format is somehow invalid."
+ 			 classFormat ~= (self classFormatFromInstFormat: classFormat) ifTrue:
+ 				[^PrimErrBadArgument].
+ 
+ 			 instBytes := self numBytesOf: rcvr.
+ 			 classFormat
+ 				caseOf: {
+ 				[self sixtyFourBitIndexableFormat]
+ 					-> [(instBytes anyMask: 7) ifTrue: [^PrimErrBadReceiver].
+ 						newFormat := classFormat].
+ 				[self firstLongFormat] 		
+ 					-> [(instBytes anyMask: 3) ifTrue: [^PrimErrBadReceiver].
+ 						newFormat := self bytesPerOop = 4
+ 										ifTrue: [classFormat]
+ 										ifFalse: [classFormat + (2 - (instBytes >> 2) bitAnd: 1)]].
+ 				[self firstShortFormat] 		
+ 					-> [(instBytes anyMask: 1) ifTrue: [^PrimErrBadReceiver].
+ 						newFormat := self bytesPerOop = 4
+ 										ifTrue: [classFormat + (2 - (instBytes >> 1) bitAnd: 1)]
+ 										ifFalse: [classFormat + (4 - (instBytes >> 1) bitAnd: 3)]].
+ 				[self firstByteFormat]
+ 					-> [newFormat := self bytesPerOop = 4
+ 										ifTrue: [classFormat + (4 - instBytes bitAnd: 3)]
+ 										ifFalse: [classFormat + (8 - instBytes bitAnd: 7)]].
+ 				[self firstCompiledMethodFormat]
+ 					-> [classFormat ~= self firstCompiledMethodFormat ifTrue:
+ 							[^PrimErrInappropriate].
+ 						newFormat := instFormat] }
+ 				otherwise: "bits instances cannot be adopted by pointer-like classes..."
+ 					[^PrimErrInappropriate]].
+ 
+ 	self set: rcvr classIndexTo: classIndex formatTo: newFormat.
+ 
+ 	self assert: (self numBytesOf: rcvr) = (classFormat <= self lastPointerFormat
+ 											ifTrue: [instSlots * self bytesPerOop]
+ 											ifFalse: [instBytes]).
+ 	"ok"
+ 	^0!
- 	self subclassResponsibility!

Item was changed:
  ----- Method: SpurMemoryManager>>printStringDataOf:on: (in category 'debug printing interpreter support') -----
  printStringDataOf: oop on: aStream
  	<var: 'aStream' type: #'FILE *'>
+ 	| i n limit |
- 	| i limit n |
  	<var: 'buffer' type: #'char *'>
  	<var: 'wideBuffer' type: #'unsigned int *'>
  	(self isBytesNonImm: oop)
  		ifTrue:
  			[| buffer byte |
  			 buffer := self alloca: 256 * 4.
  			 n := i := 0.
  			 limit := (self numBytesOfBytes: oop) min: 256.
  			 [n < limit] whileTrue:
  				[byte := self fetchByte: i ofObject: oop.
+ 				 i := i + 1.
  				 (byte < 32 "space" and: [byte ~= 9 "tab"])
  					ifTrue:
  						[buffer at: n put: $<. n := n + 1.
  						 (byte = 10 or: [byte = 13])
  							ifTrue:
  								[byte = 10
  									ifTrue: [buffer at: n put: $L; at: n + 1 put: $F]
  									ifFalse: [buffer at: n put: $C; at: n + 1 put: $R].
  								 n := n + 2]
  							ifFalse:
  								[byte >= 10 ifTrue:
  									[buffer at: n put: byte // 10 + $0 asInteger. n := n + 1].
  								 buffer at: n put: byte \\ 10 + $0 asInteger. n := n + 1].
  						 buffer at: n put: $>. n := n + 1]
  					ifFalse: [buffer at: n put: byte. n := n + 1]].
  			 '%.*s%s\n' f: aStream printf: { n. buffer. (self numBytesOfBytes: oop) > limit ifTrue: ['...'] ifFalse: [''] }]
  		ifFalse:
  			[| wideBuffer word |
  			 self assert: (self isWordsNonImm: oop).
  			 wideBuffer := self cCoerce: (self alloca: 1024 * 4) to: 'int *'.
  			 n := i := 0.
  			 limit := (self lengthOf: oop) min: 256.
  			 [i < limit] whileTrue:
  				[word := self fetchLong32: i ofObject: oop.
+ 				 i := i + 1.
  				 (word < 32 "space" and: [word ~= 9 "tab"])
  					ifTrue:
  						[wideBuffer at: n put: $<. n := n + 1.
  						 (word = 10 or: [word = 13])
  							ifTrue:
  								[word = 10
  									ifTrue: [wideBuffer at: n put: $L; at: n + 1 put: $F]
  									ifFalse: [wideBuffer at: n put: $C; at: n + 1 put: $R].
  								 n := n + 2]
  							ifFalse:
  								[word >= 10 ifTrue:
  									[wideBuffer at: n put: word // 10 + $0 asInteger. n := n + 1].
  								 wideBuffer at: n put: word \\ 10 + $0 asInteger. n := n + 1].
  						 wideBuffer at: n put: $>. n := n + 1]
  					ifFalse: [wideBuffer at: n put: word. n := n + 1]].
  			 '%.*ls%s\n' f: aStream wprintf: { n. wideBuffer. (self lengthOf: oop) > limit ifTrue: ['...'] ifFalse: [''] }]!

Item was changed:
  ----- Method: TStmtListNode>>addReadBeforeAssignedIn:to:assignments:in: (in category 'utilities') -----
  addReadBeforeAssignedIn: variables to: readBeforeAssigned assignments: assigned in: aCodeGen
  	"Add any variables in variables that are read before written to readBeforeAssigned.
  	 Add unconditional assignments to assigned.  For convenience answer assigned."
+ 	self flag:  #todo. "Add case statements to the checks in the unless: block so that only variables assigned to in all arms are considered properly assigned".
  	self
  		nodesWithParentsDo:
  			[:node :parent|
  			(node isAssignment
  			 and: [variables includes: node variable name]) ifTrue:
  				[assigned add: node variable name].
  			(node isVariable
  			 and: [(variables includes: node name)
  			 and: [(assigned includes: node name) not
  			 and: [(#(nil pointer) includes: (node structTargetKindIn: aCodeGen))
  			 and: [(parent notNil and: [parent isAssignment and: [parent variable == node]]) not]]]]) ifTrue:
+ 				[readBeforeAssigned add: node name]]
- 				[node name = 'theCalloutState' ifTrue:
- 					[self halt].
- 				 readBeforeAssigned add: node name]]
  		unless:
  			[:node :parent| | conditionalAssignments mayHaveSideEffects |
  			node isSend
  				ifTrue:
  					["First deal with implicit assignments..."
  					node isValueExpansion ifTrue:
  						[assigned addAll: node receiver args].
  					(#(#'memcpy:_:_:' #'memmove:_:_:') includes: node selector) ifTrue:
  						[assigned add: (node args first detect: [:subnode| subnode isVariable]) name].
  					(#(to:do: to:by:do:) includes: node selector) ifTrue:
  						[assigned addAll: (node args at: node selector numArgs) args.
  						 mayHaveSideEffects := node args size = 4. "See TMethod>>prepareMethodIn:"
  						 mayHaveSideEffects ifTrue:
  							[assigned add: node args last name]].
  					"Then deal with read-before-written in the arms of conditionals..."
  					(#(ifTrue: ifFalse: ifNil: ifNotNil:) intersection: node selector keywords) notEmpty
  						ifTrue:
  							["First find assignments in the expression..."
  							 (TStmtListNode new setStatements: {node receiver}; yourself)
  								addReadBeforeAssignedIn: variables
  								to: readBeforeAssigned
  								assignments: assigned
  								in: aCodeGen.
  							 "Now find read-before-written in each arm, and collect the assignments to spot those assigned in both arms"
  							 conditionalAssignments :=
  								node args
  									collect:
  										[:block|
  										block isStmtList ifTrue:
  											[block
  												addReadBeforeAssignedIn: variables
  												to: readBeforeAssigned
  												assignments: assigned copy
  												in: aCodeGen]]
  									thenSelect: [:each| each notNil].
  							 "add to assigned those variables written to in both arms"
  							 conditionalAssignments size = 2 ifTrue:
  								[conditionalAssignments := conditionalAssignments collect: [:set| set difference: assigned].
  								 assigned addAll: (conditionalAssignments first intersection: conditionalAssignments last)].
  							 true]
  						ifFalse:
  							[false]]
  				ifFalse:
  					[false]].
  	^assigned!



More information about the Vm-dev mailing list