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

commits at source.squeak.org commits at source.squeak.org
Thu Jul 8 06:04:49 UTC 2021


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

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

Name: VMMaker.oscog-eem.2981
Author: eem
Time: 7 July 2021, 11:04:39.038464 pm
UUID: 4705bb90-a5ad-4096-98ac-5893176f0014
Ancestors: VMMaker.oscog-eem.2980

CogARMv8Compiler: provide two ways to detect features (determine cache parameters and atomic instruction availability). 

Slang fixes (noMask et al shouldn't use bit and directly). Simplifications.  Add __APPLE__ & __MACH__ to names defines at compile time.

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

Item was changed:
  ----- Method: CCodeGenerator>>emitBuiltinConstructAsArgumentFor:on:level: (in category 'utilities') -----
  emitBuiltinConstructAsArgumentFor: msgNode on: aStream level: level
  	"If the given selector is in the translation dictionary, translate it into a target code construct and return true. Otherwise, do nothing and return false."
  
- 	| action |
  	(self shouldGenerateAsInterpreterProxySend: msgNode) ifTrue:
  		[^false].
+ 	^(asArgumentTranslationDict
+ 			at: msgNode selector
+ 			ifAbsent: [translationDict at: msgNode selector ifAbsent: nil])
+ 		ifNil: [false]
+ 		ifNotNil: [:action|
+ 				self perform: action with: msgNode with: aStream with: level.
+ 				true]!
- 	action := asArgumentTranslationDict
- 				at: msgNode selector
- 				ifAbsent: [translationDict at: msgNode selector ifAbsent: [ ^false ]].
- 	self perform: action with: msgNode with: aStream with: level.
- 	^true!

Item was changed:
  ----- Method: CCodeGenerator>>emitBuiltinConstructFor:on:level: (in category 'utilities') -----
  emitBuiltinConstructFor: msgNode on: aStream level: level
  	"If the given selector is in the translation dictionary, translate it into a target code construct and return true. Otherwise, do nothing and return false."
  
- 	| action |
  	(self shouldGenerateAsInterpreterProxySend: msgNode) ifTrue:
  		[^false].
+ 	^(translationDict at: msgNode selector ifAbsent: nil)
+ 		ifNil: [false]
+ 		ifNotNil: [:action|
+ 				self perform: action with: msgNode with: aStream with: level.
+ 				true]!
- 	action := translationDict at: msgNode selector ifAbsent: [ ^false ].
- 	self perform: action with: msgNode with: aStream with: level.
- 	^true!

Item was added:
+ ----- Method: CCodeGenerator>>generateAnyMask:on:indent: (in category 'C translation') -----
+ generateAnyMask: msgNode on: aStream indent: level
+ 	"Generate the C code for this message onto the given stream."
+ 
+ 	aStream nextPutAll: '(('.
+ 	self generateBitAnd: msgNode on: aStream indent: level.
+ 	aStream nextPutAll: ') !!= 0)'!

Item was changed:
  ----- Method: CCodeGenerator>>generateNoMask:on:indent: (in category 'C translation') -----
  generateNoMask: msgNode on: aStream indent: level
  	"Generate the C code for this message onto the given stream."
  
+ 	aStream nextPutAll: '(!!('.
- 	aStream nextPut: $(.
  	self generateBitAnd: msgNode on: aStream indent: level.
+ 	aStream nextPutAll: '))'!
- 	aStream nextPutAll: ') == 0'!

Item was changed:
  ----- Method: CCodeGenerator>>initializeCTranslationDictionary (in category 'C translation support') -----
  initializeCTranslationDictionary 
  	"Initialize the dictionary mapping message names to actions for C code generation."
  
  	| pairs |
  	
  	translationDict := Dictionary new: 200.
  	pairs := #(
  	#&				#generateAnd:on:indent:
  	#|				#generateOr:on:indent:
  	#abs			#generateAbs:on:indent:
  	#and:			#generateSequentialAnd:on:indent:
  	#or:			#generateSequentialOr:on:indent:
  	#not			#generateNot:on:indent:
  
  	#+				#generatePlus:on:indent:
  	#-				#generateMinus:on:indent:
  	#negated		#generateNegated:on:indent:
  	#*				#generateTimes:on:indent:
  	#/				#generateDivide:on:indent:
  	#//				#generateDivide:on:indent:
  	#\\				#generateModulo:on:indent:
  	#<<			#generateShiftLeft:on:indent:
  	#>>			#generateShiftRight:on:indent:
  	#>>>			#generateSignedShiftRight:on:indent:
  	#,				#generateComma:on:indent:
  	#min:			#generateMin:on:indent:
  	#max:			#generateMax:on:indent:
  	#between:and:	#generateBetweenAnd:on:indent:
  
  	#bitAnd:			#generateBitAnd:on:indent:
  	#bitOr:				#generateBitOr:on:indent:
  	#bitXor:			#generateBitXor:on:indent:
  	#bitShift:			#generateBitShift:on:indent:
  	#signedBitShift:	#generateSignedBitShift:on:indent:
  	#bitInvert32		#generateBitInvert:on:indent:
  	#bitInvert64		#generateBitInvert:on:indent:
  	#bitClear:			#generateBitClear:on:indent:
  	#truncateTo:		#generateTruncateTo:on:indent:
  	#rounded			#generateRounded:on:indent:
  	#even				#generateEven:on:indent:
  	#odd				#generateOdd:on:indent:
  
  	#byteSwap32		#generateByteSwap32:on:indent:
  	#byteSwap64		#generateByteSwap64:on:indent:
  	#byteSwapped32IfBigEndian:	generateByteSwap32IfBigEndian:on:indent:
  	#byteSwapped64IfBigEndian:	generateByteSwap64IfBigEndian:on:indent:
  	
  	#<				#generateLessThan:on:indent:
  	#<=			#generateLessThanOrEqual:on:indent:
  	#=				#generateEqual:on:indent:
  	#>				#generateGreaterThan:on:indent:
  	#>=			#generateGreaterThanOrEqual:on:indent:
  	#~=			#generateNotEqual:on:indent:
  	#==			#generateEqual:on:indent:
  	#~~			#generateNotEqual:on:indent:
  	#isNil			#generateIsNil:on:indent:
  	#notNil			#generateNotNil:on:indent:
  
  	#whileTrue: 	#generateWhileTrue:on:indent:
  	#whileFalse:	#generateWhileFalse:on:indent:
  	#whileTrue 	#generateDoWhileTrue:on:indent:
  	#whileFalse		#generateDoWhileFalse:on:indent:
  	#to:do:			#generateToDo:on:indent:
  	#to:by:do:		#generateToByDo:on:indent:
  	#repeat 		#generateRepeat:on:indent:
  	#timesRepeat:	#generateTimesRepeat:on:indent:
  
  	#ifTrue:			#generateIfTrue:on:indent:
  	#ifFalse:		#generateIfFalse:on:indent:
  	#ifTrue:ifFalse:	#generateIfTrueIfFalse:on:indent:
  	#ifFalse:ifTrue:	#generateIfFalseIfTrue:on:indent:
  
  	#ifNotNil:		#generateIfNotNil:on:indent:
  	#ifNil:			#generateIfNil:on:indent:
  	#ifNotNil:ifNil:	#generateIfNotNilIfNil:on:indent:
  	#ifNil:ifNotNil:	#generateIfNilIfNotNil:on:indent:
  
  	#at:			#generateAt:on:indent:
  	#at:put:		#generateAtPut:on:indent:
  	#basicAt:		#generateAt:on:indent:
  	#basicAt:put:	#generateAtPut:on:indent:
  
  	#integerValueOf:			#generateIntegerValueOf:on:indent:
  	#integerObjectOf:			#generateIntegerObjectOf:on:indent:
  	#isIntegerObject: 			#generateIsIntegerObject:on:indent:
  	#cCode:					#generateInlineCCode:on:indent:
  	#cCode:inSmalltalk:		#generateInlineCCode:on:indent:
  	#cPreprocessorDirective:	#generateInlineCPreprocessorDirective:on:indent:
  	#cppIf:ifTrue:ifFalse:				#generateInlineCppIfElse:on:indent:
  	#cppIf:ifTrue:cppIf:ifTrue:ifFalse:	#generateInlineCppIfElse:on:indent:
  	#cppIf:ifTrue:						#generateInlineCppIfElse:on:indent:
  	#cppIf:ifFalse:						#generateInlineCppIfElse:on:indent:
  	#cCoerce:to:				#generateCCoercion:on:indent:
  	#cCoerceSimple:to:			#generateCCoercion:on:indent:
  	#addressOf:				#generateAddressOf:on:indent:
  	#addressOf:put:			#generateAddressOf:on:indent:
  	#asAddress:put:			#generateAsAddress:on:indent:
  	#signedIntFromLong64	#generateSignedIntFromLong64:on:indent:
  	#signedIntFromLong		#generateSignedIntFromLong:on:indent:
  	#signedIntFromShort		#generateSignedIntFromShort:on:indent:
  	#signedIntToLong64		#generateSignedIntToLong64:on:indent:
  	#signedIntToLong			#generateSignedIntToLong:on:indent:
  	#signedIntToShort			#generateSignedIntToShort:on:indent:
  	#preIncrement				#generatePreIncrement:on:indent:
  	#preDecrement			#generatePreDecrement:on:indent:
  	#inline:						#generateInlineDirective:on:indent:
  	#asFloat					#generateAsFloat:on:indent:
  	#asInteger					#generateAsInteger:on:indent:
  	#asIntegerPtr				#generateAsIntegerPtr:on:indent:
  	#asUnsignedInteger		#generateAsUnsignedInteger:on:indent:
  	#asUnsignedIntegerPtr		#generateAsUnsignedIntegerPtr:on:indent:
  	#asLong					#generateAsLong:on:indent:
  	#asUnsignedLong			#generateAsUnsignedLong:on:indent:
  	#asUnsignedLongLong		#generateAsUnsignedLongLong:on:indent:
  	#asVoidPointer				#generateAsVoidPointer:on:indent:
  	#asSymbol					#generateAsSymbol:on:indent:
  	#flag:						#generateFlag:on:indent:
+ 	#anyMask:					#generateAnyMask:on:indent:
- 	#anyMask:					#generateBitAnd:on:indent:
  	#allMask:					#generateAllMask:on:indent:
  	#noMask:					#generateNoMask:on:indent:
  	#raisedTo:					#generateRaisedTo:on:indent:
  	#touch:					#generateTouch:on:indent:
  
  	#bytesPerOop 				#generateBytesPerOop:on:indent:
  	#bytesPerWord 			#generateBytesPerWord:on:indent:
  	#wordSize		 			#generateBytesPerWord:on:indent:
  	#baseHeaderSize			#generateBaseHeaderSize:on:indent:
  	#minSmallInteger			#generateSmallIntegerConstant:on:indent:
  	#maxSmallInteger			#generateSmallIntegerConstant:on:indent:
  	
  	#sharedCodeNamed:inCase:		#generateSharedCodeDirective:on:indent:
  
  	#perform:							#generatePerform:on:indent:
  	#perform:with:						#generatePerform:on:indent:
  	#perform:with:with:				#generatePerform:on:indent:
  	#perform:with:with:with:			#generatePerform:on:indent:
  	#perform:with:with:with:with:		#generatePerform:on:indent:
  	#perform:with:with:with:with:with:	#generatePerform:on:indent:
  
  	#value									#generateValue:on:indent:
  	#value:									#generateValue:on:indent:
  	#value:value:							#generateValue:on:indent:
  	#value:value:value:						#generateValue:on:indent:
  	#value:value:value:value:				#generateValue:on:indent:
  	#value:value:value:value:value:			#generateValue:on:indent:
  	#value:value:value:value:value:value:	#generateValue:on:indent:
  
  	#deny:								#generateDeny:on:indent:
  
  	#shouldNotImplement				#generateSmalltalkMetaError:on:indent:
  	#shouldBeImplemented			#generateSmalltalkMetaError:on:indent:
  	#subclassResponsibility				#generateSmalltalkMetaError:on:indent:
  	).
  
  	1 to: pairs size by: 2 do: [:i |
  		translationDict at: (pairs at: i) put: (pairs at: i + 1)].
  
  	pairs := #(
  	#ifTrue:				#generateIfTrueAsArgument:on:indent:	
  	#ifFalse:				#generateIfFalseAsArgument:on:indent:
  	#ifTrue:ifFalse:			#generateIfTrueIfFalseAsArgument:on:indent:
  	#ifFalse:ifTrue:			#generateIfFalseIfTrueAsArgument:on:indent:
  	#ifNotNil:				#generateIfNotNilAsArgument:on:indent:	
  	#ifNil:					#generateIfNilAsArgument:on:indent:
  	#ifNotNil:ifNil:			#generateIfNotNilIfNilAsArgument:on:indent:
  	#ifNil:ifNotNil:			#generateIfNilIfNotNilAsArgument:on:indent:
  	#cCode:				#generateInlineCCodeAsArgument:on:indent:
  	#cCode:inSmalltalk:	#generateInlineCCodeAsArgument:on:indent:
  	#cppIf:ifTrue:ifFalse:	#generateInlineCppIfElseAsArgument:on:indent:
  	#cppIf:ifTrue:			#generateInlineCppIfElseAsArgument:on:indent:
  
  	#value					#generateValueAsArgument:on:indent:
  	#value:					#generateValueAsArgument:on:indent:
  	#value:value:			#generateValueAsArgument:on:indent:
  	).
  
  	asArgumentTranslationDict := Dictionary new: 8.
  	1 to: pairs size by: 2 do: [:i |
  		asArgumentTranslationDict at: (pairs at: i) put: (pairs at: i + 1)].
  !

Item was changed:
  ----- Method: CCodeGenerator>>optionIsFalse:in: (in category 'utilities') -----
+ optionIsFalse: key in: aClass
+ 	"Answer whether a notOption: is false in the context of aClass. The key either a
+ 	 Cogit class name or a class variable name or a variable name in VMBasicConstants."
- optionIsFalse: pragma in: aClass
- 	"Answer whether a notOption: pragma is false in the context of aClass.
- 	 The argument to the option: pragma is interpreted as either a Cogit class name
- 	 or a class variable name or a variable name in VMBasicConstants."
- 	| key |
- 	key := pragma argumentAt: 1.
  
- 	"If the option is one to be defined at compile time we'll generate a
- 	 conditional around its declaration and definition."
- 	((vmClass ifNil: [VMBasicConstants]) defineAtCompileTime: key) ifTrue:
- 		[^true].
- 
  	"If the option is the name of a subclass of Cogit, include it if it dfoesn't inherit from the Cogit class."
  	(Smalltalk classNamed: key) ifNotNil:
  		[:optionClass|
  		 aClass cogitClass ifNotNil:
  			[:cogitClass|
  			 (optionClass includesBehavior: Cogit) ifTrue:
  				[^(cogitClass includesBehavior: optionClass) not]].
  		 aClass objectMemoryClass ifNotNil:
  			[:objectMemoryClass|
  			 ((optionClass includesBehavior: ObjectMemory)
  			   or: [optionClass includesBehavior: SpurMemoryManager]) ifTrue:
  				[^(objectMemoryClass includesBehavior: optionClass) not]]].
  	"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 ~~ true ifTrue: [^true]]]].
  	^false!

Item was changed:
  ----- Method: CCodeGenerator>>optionIsTrue:in: (in category 'utilities') -----
+ optionIsTrue: key in: aClass
+ 	"Answer whether an option: is true in the context of aClass. The key either a
+ 	 Cogit class name or a class variable name or a variable name in VMBasicConstants."
- optionIsTrue: pragma in: aClass
- 	"Answer whether an option: or notOption: pragma is true in the context of aClass.
- 	 The argument to the option: pragma is interpreted as either a Cogit class name
- 	 or a class variable name or a variable name in VMBasicConstants."
- 	| key |
- 	key := pragma argumentAt: 1.
  
- 	"If the option is one to be defined at compile time we'll generate a
- 	 conditional around its declaration and definition."
- 	((vmClass ifNil: [VMBasicConstants]) defineAtCompileTime: key) ifTrue:
- 		[^true].
- 
  	"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|
  			 (optionClass includesBehavior: Cogit) ifTrue:
  				[^cogitClass includesBehavior: optionClass]].
  		 aClass objectMemoryClass ifNotNil:
  			[:objectMemoryClass|
  			 ((optionClass includesBehavior: ObjectMemory)
  			   or: [optionClass includesBehavior: SpurMemoryManager]) ifTrue:
  				[^objectMemoryClass 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]]]].
  	^false!

Item was changed:
  ----- Method: CCodeGenerator>>shouldIncludeMethodFor:selector: (in category 'utilities') -----
  shouldIncludeMethodFor: aClass selector: selector
+ 	"Answer whether a method should be translated.  Process optional methods by
- 	"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."
+ 	| options notOptions |
+ 
- 	| optionPragmas notOptionPragmas |
  	(aClass >> selector pragmaAt: #doNotGenerate) ifNotNil:
  		[^false].
  
  	"where is pragmasAt: ??"
+ 	options := (aClass >> selector) pragmas select: [:p| p keyword == #option:] thenCollect: [:p| p argumentAt: 1].
+ 	notOptions := (aClass >> selector) pragmas select: [:p| p keyword == #notOption:] thenCollect: [:p| p argumentAt: 1].
+ 	(options notEmpty or: [notOptions notEmpty]) ifTrue:
+ 		["Anything defined at compile tiome must be included."
+ 		((options anySatisfy: [:option| (vmClass ifNil: [VMBasicConstants]) defineAtCompileTime: option])
+ 		 or: [notOptions anySatisfy: [:option| (vmClass ifNil: [VMBasicConstants]) defineAtCompileTime: option]]) ifTrue:
+ 			[^true].
+ 		"We have to include the method if either
- 	optionPragmas := (aClass >> selector) pragmas select: [:p| p keyword == #option:].
- 	notOptionPragmas := (aClass >> selector) pragmas select: [:p| p keyword == #notOption:].
- 	(optionPragmas notEmpty or: [notOptionPragmas notEmpty]) ifTrue:
- 		["We have to include the method if either
  			- any one of the options is false (because we want #if option...)
  			- any one of the notOptions is true (because we want #if !!option...)
  			- all of the options is true and all of the notOptions are false (because they have all been satisfied)"
+ 		^((options anySatisfy: [:option| (self optionIsTrue: option in: aClass) not])
+ 		    and: [notOptions anySatisfy: [:option| (self optionIsFalse: option in: aClass) not]])
+ 		   or: [(options allSatisfy: [:option| self optionIsTrue: option in: aClass])
+ 			and: [notOptions allSatisfy: [:option| self optionIsFalse: option in: aClass]]]].
- 		^((optionPragmas anySatisfy: [:pragma| (self optionIsTrue: pragma in: aClass) not])
- 		    and: [notOptionPragmas anySatisfy: [:pragma| (self optionIsFalse: pragma in: aClass) not]])
- 		   or: [(optionPragmas allSatisfy: [:pragma| self optionIsTrue: pragma in: aClass])
- 			and: [notOptionPragmas allSatisfy: [:pragma| self optionIsFalse: pragma in: aClass]]]].
  
  	^true!

Item was changed:
  CogAbstractInstruction subclass: #CogARMv8Compiler
  	instanceVariableNames: ''
+ 	classVariableNames: 'AL ArithmeticAdd ArithmeticAddS ArithmeticSub ArithmeticSubS CASAL CArg0Reg CArg1Reg CArg2Reg CArg3Reg CArg4Reg CArg5Reg CArg6Reg CBNZ CBZ CC CCMPNE CLREX CS CSET D0 D1 D10 D11 D12 D13 D14 D15 D16 D17 D18 D19 D2 D20 D21 D22 D23 D24 D25 D26 D27 D28 D29 D3 D30 D31 D4 D5 D6 D7 D8 D9 DC DC_CISW DC_CIVAC DC_CSW DC_CVAC DC_CVAU DC_ISW DC_IVAC DC_ZVA DMB DSB DSB_ALL DSB_ALLSY DSB_ISH DSB_NSH DSB_OSH DSB_READS DSB_SY DSB_WRITES DataCacheFlushRequired DataCacheLineLength DivRRR EQ FP GE GT HI HasAtomicInstructions IC IC_IALLU IC_IALLUIS IC_IVAU ISB InstructionCacheFlushRequired InstructionCacheLineLength LDAXR LE LR LS LT LogicalAnd LogicalAndS LogicalOr LogicalXor MI MRS_CTR_EL0 MRS_ID_AA64ISAR0_EL1 MSubRRR MoveAwRR MoveRRAw MulOverflowRRR MulRRR NE NativePopRR NativePushRR PL R0 R1 R10 R11 R12 R13 R14 R15 R16 R17 R18 R19 R2 R20 R21 R22 R23 R24 R25 R26 R27 R28 R29 R3 R30 R31 R4 R5 R6 R7 R8 R9 SMULHRRR SP STLR STLXR SXTB SXTH SXTW SXTX UXTB UXTH UXTW UXTX VC VS XZR'
- 	classVariableNames: 'AL ArithmeticAdd ArithmeticAddS ArithmeticSub ArithmeticSubS CASAL CArg0Reg CArg1Reg CArg2Reg CArg3Reg CArg4Reg CArg5Reg CArg6Reg CBNZ CBZ CC CCMPNE CLREX CS CSET D0 D1 D10 D11 D12 D13 D14 D15 D16 D17 D18 D19 D2 D20 D21 D22 D23 D24 D25 D26 D27 D28 D29 D3 D30 D31 D4 D5 D6 D7 D8 D9 DC DC_CISW DC_CIVAC DC_CSW DC_CVAC DC_CVAU DC_ISW DC_IVAC DC_ZVA DMB DSB DSB_ALL DSB_ALLSY DSB_ISH DSB_NSH DSB_OSH DSB_READS DSB_SY DSB_WRITES DivRRR EQ FP GE GT HI IC IC_IALLU IC_IALLUIS IC_IVAU ISB LDAXR LE LR LS LT LogicalAnd LogicalAndS LogicalOr LogicalXor MI MRS_CTR_EL0 MRS_ID_AA64ISAR0_EL1 MSubRRR MoveAwRR MoveRRAw MulOverflowRRR MulRRR NE NativePopRR NativePushRR PL R0 R1 R10 R11 R12 R13 R14 R15 R16 R17 R18 R19 R2 R20 R21 R22 R23 R24 R25 R26 R27 R28 R29 R3 R30 R31 R4 R5 R6 R7 R8 R9 SMULHRRR SP STLR STLXR SXTB SXTH SXTW SXTX UXTB UXTH UXTW UXTX VC VS XZR'
  	poolDictionaries: 'ARMv8A64Opcodes'
  	category: 'VMMaker-JIT'!
- CogARMv8Compiler class
- 	instanceVariableNames: 'ctrEl0 idISAR0'!
  
+ !CogARMv8Compiler commentStamp: 'eem 1/7/2021 23:01' prior: 0!
- !CogARMv8Compiler commentStamp: '' prior: 0!
  I generate ARMv8 machine code instructions from CogAbstractInstructions with CogRTLOpcodes.
  Here in "Arm ARM" refers to
  	Arm® Architecture Reference Manual
  	Armv8, for Armv8-A architecture profile
  https://developer.arm.com/docs/ddi0487/latest/arm-architecture-reference-manual-armv8-for-armv8-a-architecture-profile
  
  Some things to know about ARMv8 instructions:
  Whether 31 in a register field implies the zero register or the SP register(s) depends on the specific instruction.
  
  C3.2.1 Load/Store register
  If a Load instruction specifies writeback and the register being loaded is also the base register,
  then behavior is CONSTRAINED UNPREDICTABLE and one of the following behaviors must occur:
  - The instruction is treated as UNDEFINED.
  - The instruction is treated as a NOP.
  - The instruction performs the load using the specified addressing mode and the base register
    becomes UNKNOWN.  In addition, if an exception occurs during the execution of such an
    instruction, the base address might be corrupted so that the instruction cannot be repeated.
  If a Store instruction performs a writeback and the register that is stored is also the base register,
  then behavior is CONSTRAINED UNPREDICTABLE and one of the following behaviors must occur:
  - The instruction is treated as UNDEFINED.
  - The instruction is treated as a NOP.
  - The instruction performs the store to the designated register using the specified addressing
    mode, but the value stored is UNKNOWN.!
- CogARMv8Compiler class
- 	instanceVariableNames: 'ctrEl0 idISAR0'!

Item was removed:
- ----- Method: CogARMv8Compiler class>>ctrEl0 (in category 'accessing') -----
- ctrEl0
- 	^ctrEl0!

Item was changed:
  ----- Method: CogARMv8Compiler class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
+ 		
+ 	#('hasAtomicInstructions' 'instructionCacheLineLength' 'instructionCacheFlushRequired' 'dataCacheLineLength' 'dataCacheFlushRequired') do:
+ 		[:varName|
+ 		aCCodeGenerator
+ 			declareVar: varName type: #'unsigned char';
+ 			removeConstant: varName capitalized]!
- 	aCCodeGenerator
- 		declareVar: 'ctrEl0' type: #usqIntptr_t;
- 		declareVar: 'idISAR0' type: #usqIntptr_t!

Item was added:
+ ----- Method: CogARMv8Compiler class>>extraClassVariableNames (in category 'class initialization') -----
+ extraClassVariableNames
+ 	"self extraClassVariableNames"
+ 	^(organization listAtCategoryNamed: #'feature detection')
+ 		inject: Set new
+ 		into: [:them :selector|
+ 			(self >> selector) literalsDo:
+ 				[:l| (l isVariableBinding and: [classPool includesKey: l key]) ifTrue: [them add: l key]].
+ 			them]!

Item was removed:
- ----- Method: CogARMv8Compiler class>>idISAR0 (in category 'accessing') -----
- idISAR0
- 	^idISAR0!

Item was added:
+ ----- Method: CogARMv8Compiler class>>printCTR_EL0: (in category 'debug printing') -----
+ printCTR_EL0: ctr_el0
+ 	<doNotGenerate>
+ 	^String streamContents:
+ 		[:s| | fieldPrinter l1ip |
+ 		fieldPrinter := [:name :startBit| | field |
+ 						s nextPutAll: name; nextPutAll: ', ['; print: startBit + 3; nextPut: $,; print: startBit; nextPutAll: ']		log2 words: '.
+ 						s print: (field := ctr_el0 >> startBit bitAnd: 15); nextPutAll: ' ('; print: 8 << field; nextPutAll: ' bytes)'; cr].
+ 		s
+ 			nextPutAll: 'DIC, bit [29]	Instruction cache invalidation requirements for instruction to data coherence. The meaning of this bit is:';
+ 			crtab;
+ 			nextPutAll: ((ctr_el0 noMask: 1 << 29)
+ 							ifTrue: ['0b0 Instruction cache invalidation to the Point of Unification is required for instruction to data coherence.']
+ 							ifFalse: ['0b1 Instruction cache cleaning to the Point of Unification is not required for instruction to data coherence.']);
+ 			cr.
+ 		s
+ 			nextPutAll: 'IDC, bit [28]	Data cache clean requirements for instruction to data coherence. The meaning of this bit is:';
+ 			crtab;
+ 			nextPutAll: ((ctr_el0 noMask: 1 << 28)
+ 							ifTrue: ['0b0 Data cache clean to the Point of Unification is required for instruction to data coherence, unless CLIDR.LoC == 0b000 or (CLIDR.LoUIS == 0b000 && CLIDR.LoUU == 0b000).']
+ 							ifFalse: ['0b1 Data cache clean to the Point of Unification is not required for instruction to data coherence.']);
+ 			cr.
+ 
+ 		fieldPrinter
+ 			value: 'Cache writeback granule' value: 24;
+ 			value: 'Exclusives reservation granule' value: 20;
+ 			value: 'DminLine' value: 16;
+ 			value: 'IminLine' value: 0.
+ 		s
+ 			nextPutAll: 'Level 1 instruction cache policy: '; print: (l1ip := ctr_el0 >> 14 bitAnd: 2); space;
+ 			nextPutAll: (#(	'VMID aware Physical Index, Physical tag (VPIPT)'
+ 							'ASID-tagged Virtual Index, Virtual Tag (AIVIVT)'
+ 							'Virtual Index, Physical Tag (VIPT)'
+ 							'Physical Index, Physical Tag (PIPT)') at: l1ip + 1);
+ 			cr]!

Item was changed:
  ----- Method: CogARMv8Compiler class>>specificOpcodes (in category 'class initialization') -----
  specificOpcodes
  	"Answer the processor-specific opcodes for this class.
  	 They're all in an Array literal in the initialize method."
+ 	^(self class >> #initialize) literals detect: [:l| l isArray and: [l includes: #MulRR]] ifNone: [#()]!
- 	^(self class >> #initialize) literals detect: [:l| l isArray and: [l includes: #MulRR]]!

Item was removed:
- ----- Method: CogARMv8Compiler>>ctrEl0 (in category 'feature detection') -----
- ctrEl0
- 	<cmacro: '(ign) ctrEl0'>
- 	"For want of somewhere to put the variable..."
- 	^self class ctrEl0!

Item was added:
+ ----- Method: CogARMv8Compiler>>dataCacheFlushRequired (in category 'feature detection') -----
+ dataCacheFlushRequired
+ 	<cmacro: '(ign) dataCacheFlushRequired'>
+ 	"For want of somewhere to put the variable that doesn't bloat an instance of the receiver..."
+ 	^DataCacheFlushRequired!

Item was added:
+ ----- Method: CogARMv8Compiler>>dataCacheLineLength (in category 'feature detection') -----
+ dataCacheLineLength
+ 	<cmacro: '(ign) dataCacheLineLength'>
+ 	"For want of somewhere to put the variable that doesn't bloat an instance of the receiver..."
+ 	^DataCacheLineLength!

Item was changed:
  ----- Method: CogARMv8Compiler>>detectFeatures (in category 'feature detection') -----
  detectFeatures
+ 	<inline: #always>
+ 	self cppIf: #__APPLE__
+ 		ifTrue: [self detectFeaturesOnMacOS]
+ 		ifFalse: [self detectFeaturesOnLinux]!
- 	"Do throw-away compilations to read CTR_EL0 & ID_AA64ISAR0_EL1 and initialize ctrEl0 & idISAR0"
- 	| startAddress getFeatureReg |
- 	<var: 'getFeatureReg' declareC: 'usqIntptr_t (*getFeatureReg)(void)'>
- 	startAddress := cogit methodZoneBase.
- 	cogit allocateOpcodes: 4 bytecodes: 0.
- 	getFeatureReg := cogit cCoerceSimple: startAddress to: #'usqIntptr_t (*)(void)'.
- 	"Return the value of CTR_EL0; that's the control register that defines the vital statistics of the processor's caches."
- 	cogit
- 		gen: NOP; "do something anodyne so it is easy to distinguish MRS_CTR_EL0 being an illegal instruction rather than the code zone not being executable."
- 		gen: MRS_CTR_EL0 operand: ABIResultReg;
- 		RetN: 0.
- 	cogit outputInstructionsForGeneratedRuntimeAt: startAddress.
- 	cogit resetMethodZoneBase: startAddress.
- 	cogit ensureExecutableCodeZoneWithin:
- 		[self setCtrEl0: (self cCode: 'getFeatureReg()' inSmalltalk: [cogit simulateLeafCallOf: startAddress])].
- 	cogit zeroOpcodeIndexForNewOpcodes.
- 	cogit
- 		gen: NOP; "do something anodyne so it is easy to distinguish MRS_CTR_EL0 being an illegal instruction rather than the code zone not being executable."
- 		gen: MRS_ID_AA64ISAR0_EL1 operand: ABIResultReg;
- 		RetN: 0.
- 	cogit outputInstructionsForGeneratedRuntimeAt: startAddress.
- 	cogit resetMethodZoneBase: startAddress.
- 	cogit ensureExecutableCodeZoneWithin:
- 		[self setIdISAR0: (self cCode: 'getFeatureReg()' inSmalltalk: [cogit simulateLeafCallOf: startAddress])]!

Item was added:
+ ----- Method: CogARMv8Compiler>>detectFeaturesOnLinux (in category 'feature detection') -----
+ detectFeaturesOnLinux
+ 	"Do throw-away compilations to read CTR_EL0 & ID_AA64ISAR0_EL1 and initialize ctrEl0 & idISAR0"
+ 	<notOption: #__APPLE__>
+ 	| startAddress getFeatureReg ctrEL0 idISAR0 |
+ 	<var: 'getFeatureReg' declareC: 'usqIntptr_t (*getFeatureReg)(void)'>
+ 	startAddress := cogit methodZoneBase.
+ 	cogit allocateOpcodes: 4 bytecodes: 0.
+ 	getFeatureReg := cogit cCoerceSimple: startAddress to: #'usqIntptr_t (*)(void)'.
+ 	"Return the value of CTR_EL0; that's the control register that defines the vital statistics of the processor's caches."
+ 	cogit
+ 		gen: Nop; "do something anodyne so it is easy to distinguish MRS_CTR_EL0 being an illegal instruction rather than the code zone not being executable."
+ 		gen: MRS_CTR_EL0 operand: ABIResultReg;
+ 		RetN: 0.
+ 	cogit outputInstructionsForGeneratedRuntimeAt: startAddress.
+ 	cogit resetMethodZoneBase: startAddress.
+ 	cogit ensureExecutableCodeZoneWithin:
+ 		[ctrEL0 := (self cCode: 'getFeatureReg()' inSmalltalk: [cogit simulateLeafCallOf: startAddress]).
+ 		 "see e.g. CogARMv8Compiler class>>printCTR_EL0:"
+ 		 self setDataCacheFlushRequired: (ctrEL0 noMask: 1 << 28).
+ 		 self setDataCacheLineLength: 4 << (ctrEL0 >> 16 bitAnd: 15).
+ 		 self setInstructionCacheFlushRequired: (ctrEL0 noMask: 1 << 29).
+ 		 self setInstructionCacheLineLength: 4 << (ctrEL0 bitAnd: 15)].
+ 	cogit zeroOpcodeIndexForNewOpcodes.
+ 	cogit
+ 		gen: Nop; "do something anodyne so it is easy to distinguish MRS_CTR_EL0 being an illegal instruction rather than the code zone not being executable."
+ 		gen: MRS_ID_AA64ISAR0_EL1 operand: ABIResultReg;
+ 		RetN: 0.
+ 	cogit outputInstructionsForGeneratedRuntimeAt: startAddress.
+ 	cogit resetMethodZoneBase: startAddress.
+ 	cogit ensureExecutableCodeZoneWithin:
+ 		[idISAR0 := (self cCode: 'getFeatureReg()' inSmalltalk: [cogit simulateLeafCallOf: startAddress]).
+ 		 self setHasAtomicInstructions: (idISAR0 >> 20 bitAnd: 2r1111) = 2r10]!

Item was added:
+ ----- Method: CogARMv8Compiler>>detectFeaturesOnMacOS (in category 'memory access') -----
+ detectFeaturesOnMacOS
+ 	<option: #__APPLE__>
+ 	"MacOS does not allow access to ctl_el0, so derive cache information etc from sysctl"
+ 	"Here are values from sysctl(8), hardwired for now rather than derived through sysctl(3)
+ 		hw.cacheconfig: 8 1 1 0 0 0 0 0 0 0 (we speculate that the 1's indicate cache flush required)
+ 		hw.cachelinesize: 128
+ 		hw.l1icachesize: 131072
+ 		hw.l1dcachesize: 131072
+ 		hw.optional.neon: 1
+ 		hw.optional.neon_hpfp: 1
+ 		hw.optional.neon_fp16: 1
+ 		hw.optional.armv8_1_atomics: 1"
+ 
+ 	self setDataCacheLineLength: 128.
+ 	self setDataCacheFlushRequired: true.
+ 	self setInstructionCacheLineLength: 128.
+ 	self setInstructionCacheFlushRequired: true.
+ 	self setHasAtomicInstructions: true!

Item was changed:
  ----- Method: CogARMv8Compiler>>generateDCacheFlush (in category 'inline cacheing') -----
  generateDCacheFlush
  	"Use the DC instruction to implement ceFlushDCache(void *start, void *end); see flushDCacheFrom:to:.
  	 If there is a dual mapped zone then clean data via DC_CVAU as address + codeToDataDelta,
  	 then invalidate data at address via CIVAC."
  
  	"D4.4.7		About cache maintenance in AArch64 state													D4-2478
  
  		Terminology for Clean, Invalidate, and Clean and Invalidate instructions									D4-2479
  		...
  		-	For instructions operating by VA, the following conceptual points are defined:						D4-2480
  		Point of Unification (PoU)							
  			The PoU for a PE is the point by which the instruction and data caches and the translation table walks of that
  			PE are guaranteed to see the same copy of a memory location. In many cases, the Point of Unification is the
  			point in a uniprocessor memory system by which the instruction and data caches and the translation table
  			walks have merged.
  
  			The PoU for an Inner Shareable shareability domain is the point by which the instruction and data caches
  			and the translation table walks of all the PEs in that Inner Shareable shareability domain are guaranteed to
  			see the same copy of a memory location. Defining this point permits self-modifying software to ensure future
  			instruction fetches are associated with the modified version of the software by using the standard correctness
  			policy of:
  				1. Clean data cache entry by address.
  				2. Invalidate instruction cache entry by address.
  
  		Example code for cache maintenance instructions D4-2490 - D4-2491"
+ 	| dataCacheMinLineLength mask loop |
- 	| ctrEL0 dataCacheMinLineLength mask loop |
  	self assert: cogit getCodeToDataDelta ~= 0.
- 	ctrEL0 := self ctrEl0.
  	"See concretizeCacheControlOp1:CRm:Op2: & 
  	 http://infocenter.arm.com/help/index.jsp?topic=/com.arm.doc.100403_0200_00_en/lau1443435580346.html
  	 DminLine & IminLine are Log2 words; 16 words miniumum"
+ 	(dataCacheMinLineLength := self dataCacheLineLength) = 0 ifTrue:
- 	(dataCacheMinLineLength := ctrEL0 >> 16 bitAnd: 15) = 0 ifTrue:
  		[dataCacheMinLineLength := 4].
  	dataCacheMinLineLength := 4 << dataCacheMinLineLength.
  	"Mask is large enough to encompass the method zone and has the correct minimum alignment."
  	mask := 1 << (cogit coInterpreter highBit: cogit methodZone zoneEnd) - dataCacheMinLineLength.
  
  	"Since this is used from C code we must use only caller-saved registers.
  	 C arg registers 2 & 3 are such a convenient pair of caller-saved registers."
  	cogit AndCq: mask R: CArg0Reg R: CArg2Reg. "CArg2Reg = aligned pointer to start of each data cache line"
  	cogit AddCq: cogit getCodeToDataDelta R: CArg2Reg R: CArg3Reg.
  	loop := cogit Label.
  	"see concretizeDataCacheControl"
  	cogit gen: DC operand: CArg3Reg operand: DC_CVAU.	"clean (flush) address + codeToDataDelta"
  	cogit gen: DC operand: CArg2Reg operand: DC_CIVAC.	"invalidate address"
  	cogit
  		AddCq: dataCacheMinLineLength R: CArg2Reg;
  		AddCq: dataCacheMinLineLength R: CArg3Reg;
  		CmpR: CArg1Reg R: CArg2Reg;
  		JumpBelowOrEqual: loop.
  	cogit RetN: 0!

Item was changed:
  ----- Method: CogARMv8Compiler>>generateICacheFlush (in category 'inline cacheing') -----
  generateICacheFlush
  	"Use DC VAUC, DSB, IC IVAU, and ISB instructions to implement ceFlushICache(void *start, void *end); see flushICacheFrom:to:.
  	 One might think that if there is a dual zone then data at address + codeToDataDelta must be cleaned,
  	 but this isn't the case.  All we need to do is clean data at address via DC VAUC and instructions via IC IVAU."
  
  	"B2.2.5		Concurrent modification and execution of instructions											B2-112
  
  		...to avoid UNPREDICTABLE or CONSTRAINED UNPREDICTABLE behavior, instruction modifications must be explicitly synchronized before they are executed. The required synchronization is as follows:
  
  		1.	No PE must be executing an instruction when another PE is modifying that instruction.
  
  		2.	To ensure that the modified instructions are observable, a PE that is writing the instructions must issue the following sequence of instructions and operations:
  
  			; Coherency example for data and instruction accesses within the same Inner Shareable domain.
  			; enter this code with <Wt> containing a new 32-bit instruction, to be held in Cacheable space at a location pointed to by Xn.
  
  			STR Wt, [Xn]
  			DC CVAU, Xn		; Clean data cache by VA to point of unification (PoU)
  			DSB ISH			; Ensure visibility of the data cleaned from cache
  			IC IVAU, Xn			; Invalidate instruction cache by VA to PoU
  			DSB ISH
  
  			Note
  			 -	The DC CVAU operation is not required if the area of memory is either Non-cacheable or Write-Through Cacheable.
  			 -	If the contents of physical memory differ between the mappings, changing the mapping of VAs to PAs can cause
  				the instructions to be concurrently modified by one PE and executed by another PE. If the modifications affect
  				instructions other than those listed as being acceptable for modification, synchronization must be used to avoid
  				UNPREDICTABLE or CONSTRAINED UNPREDICTABLE behavior.
  
  		3.	In a multiprocessor system, the IC IVAU is broadcast to all PEs within the Inner Shareable domain of the PE running this sequence.
  			However, when the modified instructions are observable, each PE that is executing the modified instructions must issue the following
  			instruction to ensure execution of the modified instructions:
  
  			ISB					; Synchronize fetched instruction stream"
  
  	"D4.4.7		About cache maintenance in AArch64 state													D4-2478
  
  		Terminology for Clean, Invalidate, and Clean and Invalidate instructions									D4-2479
  		...
  		-	For instructions operating by VA, the following conceptual points are defined:						D4-2480
  		Point of Unification (PoU)							
  			The PoU for a PE is the point by which the instruction and data caches and the translation table walks of that
  			PE are guaranteed to see the same copy of a memory location. In many cases, the Point of Unification is the
  			point in a uniprocessor memory system by which the instruction and data caches and the translation table
  			walks have merged.
  
  			The PoU for an Inner Shareable shareability domain is the point by which the instruction and data caches
  			and the translation table walks of all the PEs in that Inner Shareable shareability domain are guaranteed to
  			see the same copy of a memory location. Defining this point permits self-modifying software to ensure future
  			instruction fetches are associated with the modified version of the software by using the standard correctness
  			policy of:
  				1. Clean data cache entry by address.
  				2. Invalidate instruction cache entry by address.
  
  		Example code for cache maintenance instructions D4-2490 - D4-2491"
+ 	| dataCacheMinLineLength instrCacheMinLineLength mask loop |
- 	| ctrEL0 dataCacheMinLineLength instrCacheMinLineLength mask loop |
- 	ctrEL0 := self ctrEl0.
  	"See concretizeCacheControlOp1:CRm:Op2: & 
  	 http://infocenter.arm.com/help/index.jsp?topic=/com.arm.doc.100403_0200_00_en/lau1443435580346.html"
+ 	self dataCacheFlushRequired ifTrue: "CTR_EL0.IDC is zero; must clean data cache to point of unification."
- 	(ctrEL0 noMask: 1 << 28) ifTrue: "CTR_EL0.IDC disabled; must clean data cache to point of unification."
  		["Since this is used from C code we must use only caller-saved registers.
  		  C arg registers 2 & 3 are as such a convenient pair of caller-saved registers."
+ 		 dataCacheMinLineLength := self dataCacheLineLength.
- 		 dataCacheMinLineLength := 4 << (ctrEL0 >> 16 bitAnd: 15).
  		 "Mask is large enough to encompass the method zone and has the correct minimum alignment."
  		 mask := 1 << (cogit coInterpreter highBit: cogit methodZone zoneEnd) - dataCacheMinLineLength.
  		 cogit AndCq: mask R: CArg0Reg R: CArg2Reg. "CArg2Reg = aligned pointer to start of each data cache line"
  	
  		 loop := cogit Label.
  		 "see concretizeDataCacheControl"
  		 cogit
  			gen: DC operand: CArg2Reg operand: DC_CVAU;		"clean (flush) address"
  			AddCq: dataCacheMinLineLength R: CArg2Reg;
  			CmpR: CArg1Reg R: CArg2Reg;
  			JumpBelowOrEqual: loop].
  
  	cogit gen: DSB operand: DSB_ISH operand: DSB_ALL.		"Ensure visibility of the data cleaned from cache"
  
+ 	self instructionCacheFlushRequired ifTrue: "CTR_EL0.DIC is zero; must clean instruction cache to point of unification."
+ 		[instrCacheMinLineLength := self instructionCacheLineLength.
- 	(ctrEL0 noMask: 1 << 29) ifTrue: "CTR_EL0.DIC disabled; must clean instruction cache to point of unification."
- 		[instrCacheMinLineLength := 4 << (ctrEL0 bitAnd: 15).
  		 "Mask is large enough to encompass the method zone and has the correct minimum alignment."
  		 mask := 1 << (cogit coInterpreter highBit: cogit methodZone zoneEnd) - instrCacheMinLineLength.
  		 cogit AndCq: mask R: CArg0Reg R: CArg2Reg. "CArg2Reg = aligned pointer to start of each data cache line"
  	
  		 loop := cogit Label.
  		 "see concretizeDataCacheControl"
  		 cogit
  			gen: IC operand: CArg2Reg operand: IC_IVAU;		"clean (flush) address"
  			AddCq: instrCacheMinLineLength R: CArg2Reg;
  			CmpR: CArg1Reg R: CArg2Reg;
  			JumpBelowOrEqual: loop.
  
  		 cogit gen: DSB operand: DSB_ISH operand: DSB_ALL].
  
  	cogit
  		gen: ISB;
  		RetN: 0!

Item was changed:
  ----- Method: CogARMv8Compiler>>hasAtomicInstructions (in category 'feature detection') -----
  hasAtomicInstructions
+ 	<cmacro: '(ign) hasAtomicInstructions'>
+ 	"For want of somewhere to put the variable that doesn't bloat an instance of the receiver..."
+ 	^HasAtomicInstructions!
- 	"D13.2.53		ID_AA64ISAR0_EL1, AArch64 Instruction Set Attribute Register 0		D13-3096
- 
- 	 The ID_AA64ISAR0_EL1 characteristics are:
- 	 Purpose
- 		Provides information about the instructions implemented in AArch64 state.
- 	 ...
- 	 Atomic, bits [23:20]
- 		From ARMv8.1:
- 		Atomic instructions implemented in AArch64 state. Defined values are:
- 			0b0000 No Atomic instructions implemented.
- 			0b0010 LDADD, LDCLR, LDEOR, LDSET, LDSMAX, LDSMIN, LDUMAX, LDUMIN, CAS, CASP, and SWP instructions implemented.
- 			All other values are reserved.
- 			ARMv8.1-LSE implements the functionality identified by the value 0b0010.
- 			From Armv8.1, the only permitted value is 0b0010.
- 		Otherwise:
- 			Reserved, RES0."
- 
- 	^(self idISAR0 >> 20 bitAnd: 2r1111) = 2r10!

Item was removed:
- ----- Method: CogARMv8Compiler>>idISAR0 (in category 'feature detection') -----
- idISAR0
- 	<cmacro: '(ign) idISAR0'>
- 	"For want of somewhere to put the variable..."
- 	^self class idISAR0!

Item was added:
+ ----- Method: CogARMv8Compiler>>instructionCacheFlushRequired (in category 'feature detection') -----
+ instructionCacheFlushRequired
+ 	<cmacro: '(ign) instructionCacheFlushRequired'>
+ 	"For want of somewhere to put the variable that doesn't bloat an instance of the receiver..."
+ 	^InstructionCacheFlushRequired!

Item was added:
+ ----- Method: CogARMv8Compiler>>instructionCacheLineLength (in category 'feature detection') -----
+ instructionCacheLineLength
+ 	<cmacro: '(ign) instructionCacheLineLength'>
+ 	"For want of somewhere to put the variable that doesn't bloat an instance of the receiver..."
+ 	^InstructionCacheLineLength!

Item was removed:
- ----- Method: CogARMv8Compiler>>printCTR_EL0 (in category 'feature detection') -----
- printCTR_EL0
- 	<doNotGenerate>
- 	^String streamContents:
- 		[:s| | ctr_el0 fieldPrinter l1ip |
- 		ctr_el0 := self ctrEl0.
- 		fieldPrinter := [:name :startBit| | field |
- 						s nextPutAll: name; nextPutAll: ', ['; print: startBit + 3; nextPut: $,; print: startBit; nextPutAll: ']		log2 words: '.
- 						s print: (field := ctr_el0 >> startBit bitAnd: 15); nextPutAll: ' ('; print: 8 << field; nextPutAll: ' bytes)'; cr].
- 		s
- 			nextPutAll: 'DIC, bit [29]	Instruction cache invalidation requirements for instruction to data coherence. The meaning of this bit is:';
- 			crtab;
- 			nextPutAll: ((ctr_el0 noMask: 1 << 29)
- 							ifTrue: ['0b0 Instruction cache invalidation to the Point of Unification is required for instruction to data coherence.']
- 							ifFalse: ['0b1 Instruction cache cleaning to the Point of Unification is not required for instruction to data coherence.']);
- 			cr.
- 		s
- 			nextPutAll: 'IDC, bit [28]	Data cache clean requirements for instruction to data coherence. The meaning of this bit is:';
- 			crtab;
- 			nextPutAll: ((ctr_el0 noMask: 1 << 28)
- 							ifTrue: ['0b0 Data cache clean to the Point of Unification is required for instruction to data coherence, unless CLIDR.LoC == 0b000 or (CLIDR.LoUIS == 0b000 && CLIDR.LoUU == 0b000).']
- 							ifFalse: ['0b1 Data cache clean to the Point of Unification is not required for instruction to data coherence.']);
- 			cr.
- 
- 		fieldPrinter
- 			value: 'Cache writeback granule' value: 24;
- 			value: 'Exclusives reservation granule' value: 20;
- 			value: 'DminLine' value: 16;
- 			value: 'IminLine' value: 0.
- 		s
- 			nextPutAll: 'Level 1 instruction cache policy: '; print: (l1ip := ctr_el0 >> 14 bitAnd: 2); space;
- 			nextPutAll: (#(	'VMID aware Physical Index, Physical tag (VPIPT)'
- 							'ASID-tagged Virtual Index, Virtual Tag (AIVIVT)'
- 							'Virtual Index, Physical Tag (VIPT)'
- 							'Physical Index, Physical Tag (PIPT)') at: l1ip + 1);
- 			cr]!

Item was removed:
- ----- Method: CogARMv8Compiler>>setCtrEl0: (in category 'feature detection') -----
- setCtrEl0: n
- 	<cmacro: '(ign,n) ctrEl0 = n'>
- 	"For want of somewhere to put the variable..."
- 	self class instVarNamed: 'ctrEl0' put: n!

Item was added:
+ ----- Method: CogARMv8Compiler>>setDataCacheFlushRequired: (in category 'feature detection') -----
+ setDataCacheFlushRequired: boolean
+ 	<cmacro: '(ign,b) dataCacheFlushRequired = b'>
+ 	"For want of somewhere to put the variable that doesn't bloat an instance of the receiver..."
+ 	DataCacheFlushRequired := boolean!

Item was added:
+ ----- Method: CogARMv8Compiler>>setDataCacheLineLength: (in category 'feature detection') -----
+ setDataCacheLineLength: n
+ 	<cmacro: '(ign,n) dataCacheLineLength = n'>
+ 	"For want of somewhere to put the variable that doesn't bloat an instance of the receiver..."
+ 	DataCacheLineLength := n!

Item was added:
+ ----- Method: CogARMv8Compiler>>setHasAtomicInstructions: (in category 'feature detection') -----
+ setHasAtomicInstructions: boolean
+ 	<cmacro: '(ign,b) hasAtomicInstructions = b'>
+ 	"For want of somewhere to put the variable that doesn't bloat an instance of the receiver..."
+ 	HasAtomicInstructions := boolean!

Item was removed:
- ----- Method: CogARMv8Compiler>>setIdISAR0: (in category 'feature detection') -----
- setIdISAR0: n
- 	<cmacro: '(ign,n) idISAR0 = n'>
- 	"For want of somewhere to put the variable..."
- 	self class instVarNamed: 'idISAR0' put: n!

Item was added:
+ ----- Method: CogARMv8Compiler>>setInstructionCacheFlushRequired: (in category 'feature detection') -----
+ setInstructionCacheFlushRequired: boolean
+ 	<cmacro: '(ign,b) instructionCacheFlushRequired = b'>
+ 	"For want of somewhere to put the variable that doesn't bloat an instance of the receiver..."
+ 	InstructionCacheFlushRequired := boolean!

Item was added:
+ ----- Method: CogARMv8Compiler>>setInstructionCacheLineLength: (in category 'feature detection') -----
+ setInstructionCacheLineLength: n
+ 	<cmacro: '(ign,n) instructionCacheLineLength = n'>
+ 	"For want of somewhere to put the variable that doesn't bloat an instance of the receiver..."
+ 	InstructionCacheLineLength := n!

Item was added:
+ ----- Method: CogAbstractInstruction class>>extraClassVariableNames (in category 'class initialization') -----
+ extraClassVariableNames
+ 	^#()!

Item was changed:
  ----- Method: CogAbstractInstruction class>>initializeSpecificOpcodes:in: (in category 'class initialization') -----
  initializeSpecificOpcodes: opcodeSymbolSequence in: initializeMethod
  	"Declare as class variables, the opcodes in opcodeSymbolSequence.
  	 Assign values to them from LastRTLOpcode on.  Undeclare any obsolete
  	 class vars.  The assumption is that initializeMethod defines all class vars
  	 in the class. This method should be used by subclasses wishing to declare
  	 their own specific opcodes."
+ 	^self initializeSpecificOpcodes: opcodeSymbolSequence in: initializeMethod extraClassVarNames: self extraClassVariableNames!
- 	^self initializeSpecificOpcodes: opcodeSymbolSequence in: initializeMethod extraClassVarNames: #()!

Item was changed:
  CogClass subclass: #Cogit
(excessive size, no diff calculated)

Item was changed:
  ----- Method: Cogit class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	| backEnd |
  	backEnd := CogCompilerClass basicNew.
  	#(	'coInterpreter' 'objectMemory' 'methodZone' 'objectRepresentation'
  		'cogBlockMethodSurrogateClass' 'cogMethodSurrogateClass' 'nsSendCacheSurrogateClass'
  		'threadManager' 'processor' 'lastNInstructions' 'simulatedAddresses'
  		'simulatedTrampolines' 'simulatedVariableGetters' 'simulatedVariableSetters'
  		'processorFrameValid' 'printRegisters' 'printInstructions' 'clickConfirm' 'singleStep') do:
  			[:simulationVariableNotNeededForRealVM|
  			aCCodeGenerator removeVariable: simulationVariableNotNeededForRealVM].
  	NewspeakVM ifFalse:
  		[#(	'selfSendTrampolines' 'dynamicSuperSendTrampolines'
  			'implicitReceiverSendTrampolines' 'outerSendTrampolines'
  			'ceEnclosingObjectTrampoline' 'numIRCs' 'indexOfIRC' 'theIRCs') do:
  				[:variableNotNeededInNormalVM|
  				aCCodeGenerator removeVariable: variableNotNeededInNormalVM]].
+ 	aCCodeGenerator
+ 		removeVariable: 'codeZoneIsExecutableNotWritable'; "these two are for simulation time assertion support"
+ 		removeVariable: 'debugAPISelector';
+ 		removeConstant: #COGMTVM. "this should be defined at compile time"
- 	aCCodeGenerator removeConstant: #COGMTVM. "this should be defined at compile time"
  	"N.B. We *do not* include sq.h; it pulls in conflicting definitions now that sqVirtualMachine.h
  	 declares cointerp's functions, and declares some of them inaccurately for histrical reasons.
  	 We pull in CoInterpreter's api via cointerp.h which is accurate."
  	aCCodeGenerator
  		addHeaderFile:'<stddef.h>'; "for e.g. offsetof"
  		addHeaderFile:'<stdio.h>';
  		addHeaderFile:'<stdlib.h>';
  		addHeaderFile:'<string.h>';
  		addHeaderFile:'"sqConfig.h"';
  		addHeaderFile:'"sqPlatformSpecific.h"'; "e.g. solaris overrides things for sqCogStackAlignment.h"
  		addHeaderFile:'"sqMemoryAccess.h"';
  		addHeaderFile:'"sqCogStackAlignment.h"';
  		addHeaderFile:'"dispdbg.h"'; "must precede cointerp.h & cogit.h otherwise NoDbgRegParms gets screwed up"
  		addHeaderFile:'"cogmethod.h"'.
  	NewspeakVM ifTrue:
  		[aCCodeGenerator addHeaderFile:'"nssendcache.h"'].
  	aCCodeGenerator
  		addHeaderFile:'#if COGMTVM';
  		addHeaderFile:'"cointerpmt.h"';
  		addHeaderFile:'#else';
  		addHeaderFile:'"cointerp.h"';
  		addHeaderFile:'#endif';
  		addHeaderFile:'"cogit.h"'.
  	aCCodeGenerator
  		var: #ceGetFP
  			declareC: 'usqIntptr_t (*ceGetFP)(void)';
  		var: #ceGetSP
  			declareC: 'usqIntptr_t (*ceGetSP)(void)';
  		var: #ceCaptureCStackPointers
  			declareC: 'void (*ceCaptureCStackPointers)(void)';
  		var: #ceInvokeInterpret
  			declareC: 'void (*ceInvokeInterpret)(void)';
  		var: #ceEnterCogCodePopReceiverReg
  			declareC: 'void (*ceEnterCogCodePopReceiverReg)(void)';
  		var: #realCEEnterCogCodePopReceiverReg
  			declareC: 'void (*realCEEnterCogCodePopReceiverReg)(void)';
  		var: #ceCallCogCodePopReceiverReg
  			declareC: 'void (*ceCallCogCodePopReceiverReg)(void)';
  		var: #realCECallCogCodePopReceiverReg
  			declareC: 'void (*realCECallCogCodePopReceiverReg)(void)';
  		var: #ceCallCogCodePopReceiverAndClassRegs
  			declareC: 'void (*ceCallCogCodePopReceiverAndClassRegs)(void)';
  		var: #realCECallCogCodePopReceiverAndClassRegs
  			declareC: 'void (*realCECallCogCodePopReceiverAndClassRegs)(void)';
  		var: #postCompileHook
  			declareC: 'void (*postCompileHook)(CogMethod *)';
  		var: #openPICList declareC: 'CogMethod *openPICList = 0';
  		var: #maxMethodBefore type: #'CogBlockMethod *';
  		var: 'enumeratingCogMethod' type: #'CogMethod *'.
  	
  	aCCodeGenerator
  		var: #ceTryLockVMOwner
  		declareC: '#if COGMTVM\usqIntptr_t (*ceTryLockVMOwner)(usqIntptr_t)\#endif'.
  
  	backEnd numICacheFlushOpcodes > 0 ifTrue:
  		[aCCodeGenerator
  			var: #ceFlushICache
  				declareC: 'static void (*ceFlushICache)(usqIntptr_t from, usqIntptr_t to)'].
  	aCCodeGenerator
  		var: #ceFlushDCache
  			declareC: '#if DUAL_MAPPED_CODE_ZONE\static void (*ceFlushDCache)(usqIntptr_t from, usqIntptr_t to)\#endif';
  		var: #codeToDataDelta
  			declareC: '#if DUAL_MAPPED_CODE_ZONE\static sqInt codeToDataDelta\#else\# define codeToDataDelta 0\#endif'.
  
  	aCCodeGenerator
  		declareVar: 'aMethodLabel' type: #'AbstractInstruction'; "Has to come lexicographically before backEnd & methodLabel"
  		var: #backEnd declareC: 'AbstractInstruction * const backEnd = &aMethodLabel';
  		var: #methodLabel declareC: 'AbstractInstruction * const methodLabel = &aMethodLabel'.
  	self declareC: #(abstractOpcodes stackCheckLabel
  					blockEntryLabel blockEntryNoContextSwitch
  					stackOverflowCall sendMiss
  					entry noCheckEntry selfSendEntry dynSuperEntry
  					fullBlockNoContextSwitchEntry fullBlockEntry
  					picMNUAbort picInterpretAbort  endCPICCase0 endCPICCase1 cPICEndOfCodeLabel)
  			as: #'AbstractInstruction *'
  				in: aCCodeGenerator.
  	aCCodeGenerator
  		declareVar: #cPICPrototype type: #'CogMethod *';
  		declareVar: #blockStarts type: #'BlockStart *';
  		declareVar: #fixups type: #'BytecodeFixup *';
  		declareVar: #methodZoneBase type: #usqInt.
  	aCCodeGenerator
  		var: #ordinarySendTrampolines
  			declareC: 'sqInt ordinarySendTrampolines[NumSendTrampolines]';
  		var: #superSendTrampolines
  			declareC: 'sqInt superSendTrampolines[NumSendTrampolines]'.
  	BytecodeSetHasDirectedSuperSend ifTrue:
  		[aCCodeGenerator
  			var: #directedSuperSendTrampolines
  				declareC: 'sqInt directedSuperSendTrampolines[NumSendTrampolines]';
  			var: #directedSuperBindingSendTrampolines
  				declareC: 'sqInt directedSuperBindingSendTrampolines[NumSendTrampolines]'].
  	NewspeakVM ifTrue:
  		[aCCodeGenerator
  			var: #selfSendTrampolines
  				declareC: 'sqInt selfSendTrampolines[NumSendTrampolines]';
  			var: #dynamicSuperSendTrampolines
  				declareC: 'sqInt dynamicSuperSendTrampolines[NumSendTrampolines]';
  			var: #implicitReceiverSendTrampolines
  				declareC: 'sqInt implicitReceiverSendTrampolines[NumSendTrampolines]';
  			var: #outerSendTrampolines
  				declareC: 'sqInt outerSendTrampolines[NumSendTrampolines]'].
  	aCCodeGenerator
  		addConstantForBinding: self bindingForNumTrampolines;
  		var: #trampolineAddresses
  			declareC: 'static char *trampolineAddresses[NumTrampolines*2]';
  		var: #objectReferencesInRuntime
  			declareC: 'static usqInt objectReferencesInRuntime[NumObjRefsInRuntime+1]';
  		var: #labelCounter
  			type: #int;
  		var: #traceFlags
  			declareC: 'int traceFlags = 8 /* prim trace log on by default */';
  		var: #cStackAlignment
  			declareC: 'const int cStackAlignment = STACK_ALIGN_BYTES'.
  	aCCodeGenerator
  		declareVar: #minValidCallAddress type: #'usqIntptr_t'.
  	aCCodeGenerator vmClass generatorTable ifNotNil:
  		[:bytecodeGenTable|
  		aCCodeGenerator
  			var: #generatorTable
  				declareC: 'static BytecodeDescriptor generatorTable[', bytecodeGenTable size printString, ']',
  							(self tableInitializerFor: bytecodeGenTable
  								in: aCCodeGenerator)].
  	"In C the abstract opcode names clash with the Smalltalk generator syntactic sugar.
  	 Most of the syntactic sugar is inlined, but alas some remains.  Rename the syntactic
  	 sugar to avoid the clash."
  	(self organization listAtCategoryNamed: #'abstract instructions') do:
  		[:s|
  		aCCodeGenerator addSelectorTranslation: s to: 'g', (aCCodeGenerator cFunctionNameFor: s)].
  	aCCodeGenerator addSelectorTranslation: #halt: to: 'haltmsg'.
  	self declareFlagVarsAsByteIn: aCCodeGenerator!

Item was added:
+ ----- Method: Cogit>>debugAPISelector (in category 'debugging') -----
+ debugAPISelector
+ 	"Answer the selector theCoInterpereter called in on. Simulation only.
+ 	 Used to help the codeZoneIsExecutableNotWritable assert work."
+ 	<doNotGenerate>
+ 	^(thisContext findContextSuchThat: [:ctxt| ctxt sender notNil and: [ctxt sender receiver == coInterpreter]]) selector!

Item was changed:
+ ----- Method: Cogit>>ensureExecutableCodeZone (in category 'memory access') -----
- ----- Method: Cogit>>ensureExecutableCodeZone (in category 'support') -----
  ensureExecutableCodeZone
  	"On some platforms run-time calls may be required to enable execution and disable
  	 write-protect of the code zone. This is sequenced by ensuring that the code zone is
  	 executable most of the time.  Note that any code space modification requires an
  	 icache flush (on processors with such an icache). Hence the least invasive time to
  	 ensure code is executable is post icache flush.  Making sure code is writable can be
  	 done either before any bulk edit (e.g. code zone reclamation) or as part of any fine-
  	 grained code modification (e.g. setting an anonymous method's selector)."
  	<inline: #always>
  	
  	self cppIf: #DUAL_MAPPED_CODE_ZONE
  		ifFalse:
  			[backEnd needsCodeZoneExecuteWriteSwitch ifTrue:
+ 				[self cCode: nil inSmalltalk: [self assert: (codeZoneIsExecutableNotWritable not
+ 														"this happens when the CoInterpreter sends
+ 														 mapObjectReferencesInMachineCode: followed by cogitPostGCAction:"
+ 														or: [debugAPISelector == self debugAPISelector
+ 															or: [debugAPISelector == #mapObjectReferencesInMachineCode:]])].
+ 				 backEnd makeCodeZoneExecutable.
+ 				 self cCode: nil inSmalltalk: [codeZoneIsExecutableNotWritable := true. debugAPISelector := self debugAPISelector]]]!
- 				[codeZoneIsExecutableNotWritable ifFalse:
- 					[backEnd makeCodeZoneExecutable.
- 					 codeZoneIsExecutableNotWritable := true]]]!

Item was changed:
+ ----- Method: Cogit>>ensureExecutableCodeZoneWithin: (in category 'memory access') -----
- ----- Method: Cogit>>ensureExecutableCodeZoneWithin: (in category 'support') -----
  ensureExecutableCodeZoneWithin: aBlock
  	"On some platforms run-time calls may be required to enable execution and disable
  	 write-protect of the code zone. See the comment in ensureExecutableCodeZone."
  	<inline: #always>
  	self ensureExecutableCodeZone.
  	aBlock value.
  	self ensureWritableCodeZone!

Item was changed:
+ ----- Method: Cogit>>ensureWritableCodeZone (in category 'memory access') -----
- ----- Method: Cogit>>ensureWritableCodeZone (in category 'support') -----
  ensureWritableCodeZone
  	"On some platforms run-time calls may be required to enable execution and disable
  	 write-protect of the code zone. See the comment in ensureExecutableCodeZone."
  	<inline: #always>
  	self cppIf: #DUAL_MAPPED_CODE_ZONE
  		ifFalse:
+ 			[backEnd needsCodeZoneExecuteWriteSwitch ifTrue:
+ 				[self cCode: nil inSmalltalk: [debugAPISelector ifNil: [debugAPISelector := self debugAPISelector].
+ 											self assert: (codeZoneIsExecutableNotWritable or: [debugAPISelector == self debugAPISelector])].
+ 				 backEnd makeCodeZoneWritable.
+ 				 self cCode: nil inSmalltalk: [codeZoneIsExecutableNotWritable := false. debugAPISelector := self debugAPISelector]]]!
- 			[(backEnd needsCodeZoneExecuteWriteSwitch
- 			  and: [codeZoneIsExecutableNotWritable]) ifTrue:
- 				[backEnd makeCodeZoneWritable.
- 				codeZoneIsExecutableNotWritable := false]]!

Item was changed:
  ----- Method: Cogit>>followMovableLiteralsAndUpdateYoungReferrers (in category 'garbage collection') -----
  followMovableLiteralsAndUpdateYoungReferrers
  	"To avoid runtime checks on literal variable and literal accesses in == and ~~, 
  	 we follow literals in methods having movable literals in the postBecome action.
  	 To avoid scanning every method, we annotate cogMethods with the 
  	 cmHasMovableLiteral flag."
  	<option: #SpurObjectMemory>
  	<api>
  	<returnTypeC: #void>
  	| cogMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	self assert: methodZone kosherYoungReferrers.
  	"methodZone firstBogusYoungReferrer"
  	"methodZone occurrencesInYoungReferrers: methodZone firstBogusYoungReferrer"
  	codeModified := false.
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	[cogMethod < methodZone limitZony] whileTrue:
  		[cogMethod cmType ~= CMFree ifTrue:
  			[cogMethod cmHasMovableLiteral ifTrue:
  				[self followForwardedLiteralsIn: cogMethod]].
  		 cogMethod := methodZone methodAfter: cogMethod]..
  	methodZone pruneYoungReferrers.
  	codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
+ 		[backEnd flushICacheFrom: codeBase asUnsignedInteger to: methodZone freeStart]!
- 		[backEnd flushICacheFrom: codeBase asUnsignedInteger to: methodZone limitZony asUnsignedInteger]!

Item was changed:
  ----- Method: Cogit>>generateStackPointerCapture (in category 'initialization') -----
  generateStackPointerCapture
  	"Generate a routine ceCaptureCStackPointers that will capture the C stack pointer,
  	 and, if it is in use, the C frame pointer.  These are used in trampolines to call
  	 run-time routines in the interpreter from machine-code."
  
  	| oldMethodZoneBase oldTrampolineTableIndex |
  	cFramePointerInUse := false. "For the benefit of the following assert, assume the minimum at first."
  	self assertCStackWellAligned.
  	oldMethodZoneBase := methodZoneBase.
  	oldTrampolineTableIndex := trampolineTableIndex.
  	self generateCaptureCStackPointers: true.
  	self perform: #ceCaptureCStackPointers.
+ 	self ensureWritableCodeZone.
  	(cFramePointerInUse := coInterpreter checkIfCFramePointerInUse) ifFalse:
  		[methodZoneBase := oldMethodZoneBase.
  		 trampolineTableIndex := oldTrampolineTableIndex.
+ 		 self generateCaptureCStackPointers: false.
+ 		 self ensureWritableCodeZone].
- 		 self generateCaptureCStackPointers: false].
  	self assertCStackWellAligned!

Item was changed:
  ----- Method: Cogit>>lookupAddress: (in category 'disassembly') -----
  lookupAddress: address
  	<doNotGenerate>
  	address < methodZone freeStart ifTrue:
  		[^address >= methodZoneBase
  			ifTrue:
  				[(methodZone methodFor: address) ifNotNil:
  					[:cogMethod|
  					 ((cogMethod selector ~= objectMemory nilObject
  					    and: [objectRepresentation couldBeObject: cogMethod selector])
  						ifTrue: [coInterpreter stringOf: cogMethod selector]
  						ifFalse: [cogMethod asInteger hex]),
  					   '@', ((address - cogMethod asInteger) hex allButFirst: 3)]]
  			ifFalse:
  				[(self trampolineRangeFor: address) ifNotNil:
  					[:range|
+ 					 (self codeEntryNameFor: range first) ifNotNil:
+ 						[:name| name, (address = range first ifTrue: [''] ifFalse: [' + ', (address - range first) hex])]]]].
- 					 (self codeEntryNameFor: range first), (address = range first ifTrue: [''] ifFalse: [' + ', (address - range first) hex])]]].
  	(simulatedTrampolines includesKey: address) ifTrue:
  		[^self labelForSimulationAccessor: (simulatedTrampolines at: address)].
  	(simulatedVariableGetters includesKey: address) ifTrue:
  		[^self labelForSimulationAccessor: (simulatedVariableGetters at: address)].
  	^(coInterpreter lookupAddress: address) ifNil:
  		[address = self cStackPointerAddress
  			ifTrue: [#CStackPointer]
  			ifFalse:
  				[address = self cFramePointerAddress ifTrue:
  					[#CFramePointer]]]!

Item was changed:
  ----- Method: Cogit>>mapObjectReferencesInMachineCodeForBecome (in category 'garbage collection') -----
  mapObjectReferencesInMachineCodeForBecome
  	"Update all references to objects in machine code for a become.
  	 Unlike incrementalGC or fullGC a method that does not refer to young may
  	 refer to young as a result of the become operation.  Unlike incrementalGC
  	 or fullGC the reference from a Cog method to its methodObject *must not*
  	 change since the two are two halves of the same object."
  	| cogMethod writableCogMethod hasYoungObj hasYoungObjPtr freedPIC |
  	hasYoungObj := false.
  	hasYoungObjPtr := (self addressOf: hasYoungObj put: [:val| hasYoungObj := val]) asInteger.
  	codeModified := freedPIC := false.
  	self mapObjectReferencesInGeneratedRuntime.
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	[cogMethod < methodZone limitZony] whileTrue:
  		[self assert: hasYoungObj not.
  		 cogMethod cmType ~= CMFree ifTrue:
  			[self assert: (self cogMethodDoesntLookKosher: cogMethod) = 0.
  			 writableCogMethod := self writableMethodFor: cogMethod.
  			 writableCogMethod selector: (objectRepresentation remapOop: cogMethod selector).
  			 cogMethod cmType = CMClosedPIC
  				ifTrue:
  					[((objectMemory isYoung: cogMethod selector)
  					   or: [self mapObjectReferencesInClosedPIC: cogMethod]) ifTrue:
  						[freedPIC := true.
  						 methodZone freeMethod: cogMethod]]
  				ifFalse:
  					[(objectMemory isYoung: cogMethod selector) ifTrue:
  						[hasYoungObj := true].
  					 cogMethod cmType = CMMethod ifTrue:
  						[| remappedMethod |
  						 self assert: cogMethod objectHeader = objectMemory nullHeaderForMachineCodeMethod.
  						 remappedMethod := objectRepresentation remapOop: cogMethod methodObject.
  						 remappedMethod ~= cogMethod methodObject ifTrue:
  							[(coInterpreter methodHasCogMethod: remappedMethod) ifTrue:
  								[self error: 'attempt to become two cogged methods'].
  							 (objectMemory
  									withoutForwardingOn: cogMethod methodObject
  									and: remappedMethod
  									with: cogMethod cmUsesPenultimateLit
  									sendToCogit: #method:hasSameCodeAs:checkPenultimate:) ifFalse:
  								[self error: 'attempt to become cogged method into different method'].
  							 "For non-Newspeak there should ne a one-to-one mapping between bytecoded and
  							  cog methods.  For Newspeak not necessarily, but only for anonymous accessors."
  							 "Only reset the method object's header if it is referring to this CogMethod."
  							 (coInterpreter rawHeaderOf: cogMethod methodObject) = cogMethod asInteger
  								ifTrue:
  									[coInterpreter
  										rawHeaderOf: cogMethod methodObject
  										put: cogMethod methodHeader.
  									 writableCogMethod
  										methodHeader: (coInterpreter rawHeaderOf: remappedMethod);
  										methodObject: remappedMethod.
  									 coInterpreter
  										rawHeaderOf: remappedMethod
  										put: cogMethod asInteger]
  								ifFalse:
  									[self assert: (self noAssertMethodClassAssociationOf: cogMethod methodObject)
  													= objectMemory nilObject.
  									 writableCogMethod
  										methodHeader: (coInterpreter rawHeaderOf: remappedMethod);
  										methodObject: remappedMethod]].
  						 (objectMemory isYoung: cogMethod methodObject) ifTrue:
  							[hasYoungObj := true]].
  					 self mapFor: cogMethod
  						 performUntil: #remapIfObjectRef:pc:hasYoung:
  						 arg: hasYoungObjPtr.
  					 hasYoungObj
  						ifTrue:
  							[methodZone ensureInYoungReferrers: cogMethod.
  							hasYoungObj := false]
  						ifFalse:
  							[cogMethod cmRefersToYoung: false]]].
  		cogMethod := methodZone methodAfter: cogMethod].
  	"we /must/ prune youngReferrers here because a) the [cogMethod cmRefersToYoung: false]
  	 block could have removed a method and subsequently it could be added back, and b) we
  	 can not tolerate duplicates in the youngReferrers list."  
  	methodZone pruneYoungReferrers.
  	freedPIC ifTrue:
  		[self unlinkSendsToFree].
  	codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
+ 		[backEnd flushICacheFrom: codeBase asUnsignedInteger to: methodZone freeStart]!
- 		[backEnd flushICacheFrom: codeBase asUnsignedInteger to: methodZone limitZony asUnsignedInteger]!

Item was changed:
  ----- Method: Cogit>>mapObjectReferencesInMachineCodeForFullGC (in category 'garbage collection') -----
  mapObjectReferencesInMachineCodeForFullGC
  	"Update all references to objects in machine code for a full gc.  Since
  	 the current (New)ObjectMemory GC makes everything old in a full GC
  	 a method not referring to young will not refer to young afterwards"
  	| cogMethod writableCogMethod |
  	codeModified := false.
  	self mapObjectReferencesInGeneratedRuntime.
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	[cogMethod < methodZone limitZony] whileTrue:
  		[cogMethod cmType ~= CMFree ifTrue:
  			[self assert: (self cogMethodDoesntLookKosher: cogMethod) = 0.
  			 writableCogMethod := self writableMethodFor: cogMethod.
  			 writableCogMethod selector: (objectRepresentation remapOop: cogMethod selector).
  			 cogMethod cmType = CMClosedPIC
  				ifTrue:
  					[self assert: cogMethod cmRefersToYoung not.
  					 self mapObjectReferencesInClosedPIC: cogMethod]
  				ifFalse:
  					[cogMethod cmType = CMMethod ifTrue:
  						[self assert: cogMethod objectHeader = objectMemory nullHeaderForMachineCodeMethod.
  						 writableCogMethod methodObject: (objectRepresentation remapOop: cogMethod methodObject)].
  					 self mapFor: cogMethod
  						 performUntil: #remapIfObjectRef:pc:hasYoung:
  						 arg: 0.
  					 (cogMethod cmRefersToYoung
  					  and: [objectRepresentation allYoungObjectsAgeInFullGC]) ifTrue:
  						[writableCogMethod cmRefersToYoung: false]]].
  		cogMethod := methodZone methodAfter: cogMethod].
  	methodZone pruneYoungReferrers.
  	codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
+ 		[backEnd flushICacheFrom: codeBase asUnsignedInteger to: methodZone freeStart]!
- 		[backEnd flushICacheFrom: codeBase asUnsignedInteger to: methodZone limitZony asUnsignedInteger]!

Item was changed:
  ----- Method: Cogit>>mapObjectReferencesInMachineCodeForYoungGC (in category 'garbage collection') -----
  mapObjectReferencesInMachineCodeForYoungGC
  	"Update all references to objects in machine code for either a Spur scavenging gc
  	 or a Squeak V3 incremental GC.  Avoid scanning all code by using the youngReferrers
  	 list.  In a young gc a method referring to young may no longer refer to young, but a
  	 method not referring to young cannot and will not refer to young afterwards."
  	| pointer cogMethod hasYoungObj hasYoungObjPtr |
  	hasYoungObj := false.
  	hasYoungObjPtr := (self addressOf: hasYoungObj put: [:val| hasYoungObj := val]) asInteger.
  	codeModified := false.
  	pointer := methodZone youngReferrers.
  	[pointer < methodZone zoneEnd] whileTrue:
  		[self assert: hasYoungObj not.
  		 cogMethod := coInterpreter cCoerceSimple: (objectMemory longAt: pointer) to: #'CogMethod *'.
  		 cogMethod cmType = CMFree
  			ifTrue: [self assert: cogMethod cmRefersToYoung not]
  			ifFalse:
  				[self assert: (self cogMethodDoesntLookKosher: cogMethod) = 0.
  				 cogMethod cmRefersToYoung ifTrue:
  					[| writableCogMethod |
  					 self assert: (cogMethod cmType = CMMethod
  								or: [cogMethod cmType = CMOpenPIC]).
  					 writableCogMethod := self writableMethodFor: cogMethod.
  					 writableCogMethod selector: (objectRepresentation remapOop: cogMethod selector).
  					 (objectMemory isYoung: cogMethod selector) ifTrue:
  						[hasYoungObj := true].
  					 cogMethod cmType = CMMethod ifTrue:
  						[self assert: cogMethod objectHeader = objectMemory nullHeaderForMachineCodeMethod.
  						 writableCogMethod methodObject: (objectRepresentation remapOop: cogMethod methodObject).
  						 (objectMemory isYoung: cogMethod methodObject) ifTrue:
  							[hasYoungObj := true]].
  					 self mapFor: cogMethod
  						 performUntil: #remapIfObjectRef:pc:hasYoung:
  						 arg: hasYoungObjPtr.
  					 hasYoungObj
  						ifTrue: [hasYoungObj := false]
  						ifFalse: [writableCogMethod cmRefersToYoung: false]]].
  		 pointer := pointer + objectMemory wordSize].
  	methodZone pruneYoungReferrers.
  	codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
+ 		[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone freeStart]!
- 		[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone limitZony asUnsignedInteger]!

Item was changed:
  ----- Method: Cogit>>markAndTraceMachineCodeForNewSpaceGC (in category 'jit - api') -----
  markAndTraceMachineCodeForNewSpaceGC
  	"Free any methods that refer to unmarked objects, unlinking sends to freed methods."
  	| pointer cogMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	objectMemory leakCheckNewSpaceGC ifTrue:
  		[self asserta: self allMachineCodeObjectReferencesValid].
  	codeModified := false.
  	pointer := methodZone youngReferrers.
  	[pointer < methodZone zoneEnd] whileTrue:
  		[cogMethod := coInterpreter cCoerceSimple: (objectMemory longAt: pointer) to: #'CogMethod *'.
  		 cogMethod cmRefersToYoung ifTrue:
  			[self assert: (self cogMethodDoesntLookKosher: cogMethod) = 0.
  			 self assert: (cogMethod cmType = CMMethod
  						or: [cogMethod cmType = CMOpenPIC]).
  			 (objectMemory isYoung: cogMethod selector) ifTrue:
  				[objectMemory markAndTrace: cogMethod selector].
  			 cogMethod cmType = CMMethod ifTrue:
  				[(objectMemory isYoung: cogMethod methodObject) ifTrue:
  					[objectMemory markAndTrace: cogMethod methodObject].
  				self markYoungObjectsIn: cogMethod]].
  		 pointer := pointer + objectMemory wordSize].
  	objectMemory leakCheckNewSpaceGC ifTrue:
  		[self asserta: self allMachineCodeObjectReferencesValid].
  	codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
+ 		[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone freeStart]!
- 		[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone limitZony asUnsignedInteger]!

Item was changed:
  ----- Method: Cogit>>markAndTraceMachineCodeOfMarkedMethods (in category 'jit - api') -----
  markAndTraceMachineCodeOfMarkedMethods
  	"Mark objects in machine-code of marked methods (or open PICs with marked selectors)."
  	<api>
  	<option: #SpurObjectMemory>
  	| cogMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	objectMemory leakCheckFullGC ifTrue:
  		[self asserta: self allMachineCodeObjectReferencesValid].
  	codeModified := false.
  	self markAndTraceObjectReferencesInGeneratedRuntime.
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	[cogMethod < methodZone limitZony] whileTrue:
  		[(cogMethod cmType = CMMethod
  		  and: [objectMemory isMarked: cogMethod methodObject]) ifTrue:
  			[self markAndTraceLiteralsIn: cogMethod].
  		 (cogMethod cmType = CMOpenPIC
  		  and: [(objectMemory isImmediate: cogMethod selector)
  				or: [objectMemory isMarked: cogMethod selector]]) ifTrue:
  			[self markAndTraceLiteralsIn: cogMethod].
  		 cogMethod := methodZone methodAfter: cogMethod].
  	objectMemory leakCheckFullGC ifTrue:
  		[self asserta: self allMachineCodeObjectReferencesValid].
  	codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
+ 		[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone freeStart]!
- 		[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone limitZony asUnsignedInteger]!

Item was changed:
  ----- Method: Cogit>>markAndTraceOrFreeMachineCodeForFullGC (in category 'jit - api') -----
  markAndTraceOrFreeMachineCodeForFullGC
  	"Free any methods that refer to unmarked objects, unlinking sends to freed methods."
  	| cogMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	objectMemory leakCheckFullGC ifTrue:
  		[self asserta: self allMachineCodeObjectReferencesValid].
  	codeModified := false.
  	self markAndTraceObjectReferencesInGeneratedRuntime.
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	[cogMethod < methodZone limitZony] whileTrue:
  		[self markAndTraceOrFreeCogMethod: cogMethod firstVisit: true.
  		 cogMethod := methodZone methodAfter: cogMethod].
  	objectMemory leakCheckFullGC ifTrue:
  		[self asserta: self allMachineCodeObjectReferencesValid].
  	codeModified ifTrue: "After updating oops in inline caches we need to flush the icache."
+ 		[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone freeStart]!
- 		[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone limitZony asUnsignedInteger]!

Item was changed:
  ----- Method: Cogit>>unlinkAllSends (in category 'jit - api') -----
  unlinkAllSends
  	<api>
  	"Unlink all sends in cog methods."
  	| cogMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	methodZoneBase ifNil: [^self].
  	self ensureWritableCodeZone.
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	methodZone voidOpenPICList.
  	[cogMethod < methodZone limitZony] whileTrue:
  		[cogMethod cmType = CMMethod
  			ifTrue:
  				[self mapFor: cogMethod
  					 performUntil: #unlinkIfLinkedSend:pc:ignored:
  					 arg: 0]
  			ifFalse:
  				[cogMethod cmType ~= CMFree ifTrue:
  					[methodZone freeMethod: cogMethod]].
  		cogMethod := methodZone methodAfter: cogMethod].
  	"After updating inline caches we need to flush the icache."
+ 	backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone freeStart!
- 	backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone limitZony asUnsignedInteger!

Item was changed:
  ----- Method: Cogit>>unlinkSendsLinkedForInvalidClasses (in category 'jit - api') -----
  unlinkSendsLinkedForInvalidClasses
  	<api>
  	<option: #SpurObjectMemory>
  	"Unlink all sends in cog methods whose class tag is that of a forwarded class."
  	| cogMethod freedPIC |
  	<var: #cogMethod type: #'CogMethod *'>
  	methodZoneBase ifNil: [^self].
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	codeModified := freedPIC := false.
  	[cogMethod < methodZone limitZony] whileTrue:
  		[cogMethod cmType = CMMethod
  			ifTrue:
  				[self mapFor: cogMethod
  					 performUntil: #unlinkIfInvalidClassSend:pc:ignored:
  					 arg: 0]
  			ifFalse:
  				[(cogMethod cmType = CMClosedPIC
  				  and: [self cPICHasForwardedClass: cogMethod]) ifTrue:
  					[methodZone freeMethod: cogMethod.
  					 freedPIC := true]].
  		cogMethod := methodZone methodAfter: cogMethod].
  	freedPIC
  		ifTrue: [self unlinkSendsToFree]
  		ifFalse:
  			[codeModified ifTrue: "After possibly updating inline caches we need to flush the icache."
+ 				[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone freeStart]]!
- 				[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone limitZony asUnsignedInteger]]!

Item was changed:
  ----- Method: Cogit>>unlinkSendsOf:isMNUSelector: (in category 'jit - api') -----
  unlinkSendsOf: selector isMNUSelector: isMNUSelector
  	<api>
  	"Unlink all sends in cog methods. Free all Closed PICs with the selector,
  	 or with an MNU case if isMNUSelector.  First check if any method actually
  	 has the selector; if not there can't be any linked send to it.  This routine
  	 (including descendents) is performance critical.  It contributes perhaps
  	 30% of entire execution time in Compiler recompileAll."
  	| cogMethod mustScanAndUnlink |
  	<var: #cogMethod type: #'CogMethod *'>
  	methodZoneBase ifNil: [^self].
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	mustScanAndUnlink := false.
  	isMNUSelector
  		ifTrue:
  			[[cogMethod < methodZone limitZony] whileTrue:
  				[cogMethod cmType ~= CMFree ifTrue:
  					[cogMethod cpicHasMNUCase
  						ifTrue:
  							[self assert: cogMethod cmType = CMClosedPIC.
  							 methodZone freeMethod: cogMethod.
  							 mustScanAndUnlink := true]
  						ifFalse:
  							[cogMethod selector = selector ifTrue:
  								[mustScanAndUnlink := true.
  								 cogMethod cmType = CMClosedPIC ifTrue:
  									[methodZone freeMethod: cogMethod]]]].
  				 cogMethod := methodZone methodAfter: cogMethod]]
  		ifFalse:
  			[[cogMethod < methodZone limitZony] whileTrue:
  				[(cogMethod cmType ~= CMFree
  				  and: [cogMethod selector = selector]) ifTrue:
  					[mustScanAndUnlink := true.
  					 cogMethod cmType = CMClosedPIC ifTrue:
  						[methodZone freeMethod: cogMethod]].
  				 cogMethod := methodZone methodAfter: cogMethod]].
  	mustScanAndUnlink ifFalse:
  		[^self].
  	codeModified := false.
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	[cogMethod < methodZone limitZony] whileTrue:
  		[cogMethod cmType = CMMethod ifTrue:
  			[self mapFor: cogMethod
  				 performUntil: #unlinkIfFreeOrLinkedSend:pc:of:
  				 arg: selector].
  		cogMethod := methodZone methodAfter: cogMethod].
  	codeModified ifTrue: "After possibly updating inline caches we need to flush the icache."
+ 		[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone freeStart]!
- 		[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone limitZony asUnsignedInteger]!

Item was changed:
  ----- Method: Cogit>>unlinkSendsTo:andFreeIf: (in category 'jit - api') -----
  unlinkSendsTo: targetMethodObject andFreeIf: freeIfTrue
  	<api>
  	"Unlink all sends in cog methods to a particular target method.
  	 If targetMethodObject isn't actually a method (perhaps being
  	 used via invokeAsMethod) then there's nothing to do."
  	| cogMethod targetMethod freedPIC |
  	<var: #cogMethod type: #'CogMethod *'>
  	<var: #targetMethod type: #'CogMethod *'>
  	((objectMemory isOopCompiledMethod: targetMethodObject)
  	and: [coInterpreter methodHasCogMethod: targetMethodObject]) ifFalse:
  		[^self].
  	targetMethod := coInterpreter cogMethodOf: targetMethodObject.
  	methodZoneBase ifNil: [^self].
  	codeModified := freedPIC := false.
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	[cogMethod < methodZone limitZony] whileTrue:
  		[cogMethod cmType = CMMethod
  			ifTrue:
  				[self mapFor: cogMethod
  					 performUntil: #unlinkIfLinkedSend:pc:to:
  					 arg: targetMethod asInteger]
  			ifFalse:
  				[(cogMethod cmType = CMClosedPIC
  				  and: [self cPIC: cogMethod HasTarget: targetMethod]) ifTrue:
  					[methodZone freeMethod: cogMethod.
  					 freedPIC := true]].
  		cogMethod := methodZone methodAfter: cogMethod].
  	freeIfTrue ifTrue: [self freeMethod: targetMethod].
  	freedPIC
  		ifTrue: [self unlinkSendsToFree]
  		ifFalse:
  			[codeModified ifTrue: "After possibly updating inline caches we need to flush the icache."
+ 				[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone freeStart]]!
- 				[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone limitZony asUnsignedInteger]]!

Item was changed:
  ----- Method: Cogit>>unlinkSendsToFree (in category 'garbage collection') -----
  unlinkSendsToFree
  	<api>
  	"Unlink all sends in cog methods to free methods and/or pics."
  	| cogMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	methodZoneBase ifNil: [^self].
  	codeModified := false.
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	[cogMethod < methodZone limitZony] whileTrue:
  		[cogMethod cmType = CMMethod
  			ifTrue:
  				[self mapFor: cogMethod
  					 performUntil: #unlinkIfLinkedSendToFree:pc:ignored:
  					 arg: 0]
  			ifFalse:
  				[cogMethod cmType = CMClosedPIC ifTrue:
  					[self assert: (self noTargetsFreeInClosedPIC: cogMethod)]].
  		cogMethod := methodZone methodAfter: cogMethod].
  	codeModified ifTrue: "After possibly updating inline caches we need to flush the icache."
+ 		[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone freeStart]!
- 		[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone limitZony asUnsignedInteger]!

Item was changed:
  ----- Method: Cogit>>unlinkSendsToMachineCodePrimitiveMethodsAndFreeIf: (in category 'jit - api') -----
  unlinkSendsToMachineCodePrimitiveMethodsAndFreeIf: freeIfTrue
  	<api>
  	"Unlink all sends in cog methods to methods with a machine code
  	 primitive, and free machine code primitive methods if freeIfTrue.
  	 To avoid having to scan PICs, free any and all PICs"
  	| cogMethod freedSomething |
  	<var: #cogMethod type: #'CogMethod *'>
  	methodZoneBase ifNil: [^self].
  	codeModified := freedSomething := false.
  	cogMethod := self cCoerceSimple: methodZoneBase to: #'CogMethod *'.
  	[cogMethod < methodZone limitZony] whileTrue:
  		[cogMethod cmType = CMMethod
  			ifTrue:
  				[(freeIfTrue
  				  and: [self cogMethodHasMachineCodePrim: cogMethod])
  					ifTrue:
  						[methodZone freeMethod: cogMethod.
  						 freedSomething := true]
  					ifFalse:
  						[self mapFor: cogMethod
  							 performUntil: #unlinkIfLinkedSend:pc:toMachineCodePrim:
  							 arg: 0]]
  			ifFalse:
  				[cogMethod cmType = CMClosedPIC ifTrue:
  					[methodZone freeMethod: cogMethod.
  					 freedSomething := true]].
  		cogMethod := methodZone methodAfter: cogMethod].
  	freedSomething
  		ifTrue: [self unlinkSendsToFree]
  		ifFalse:
  			[codeModified ifTrue: "After possibly updating inline caches we need to flush the icache."
+ 				[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone freeStart]]!
- 				[backEnd flushICacheFrom: methodZoneBase asUnsignedInteger to: methodZone limitZony asUnsignedInteger]]!

Item was changed:
  ----- Method: TMethod>>hasUnrenamableCCode (in category 'utilities') -----
  hasUnrenamableCCode
+ 	"Answer if the receiver uses inlined C strings which
- 	"Answer true if the receiver uses inlined C which
  	 is not currently renamed properly by the the inliner."
  
+ 	^parseTree anySatisfy: [:node| node isStringishCCode]!
- 	^parseTree anySatisfy:
- 		[:node| node isNonNullCCode]!

Item was added:
+ ----- Method: TParseNode>>isNullCCode (in category 'testing') -----
+ isNullCCode
+ 	"overridden in TSendNode"
+ 	^false!

Item was added:
+ ----- Method: TParseNode>>isStringishCCode (in category 'testing') -----
+ isStringishCCode
+ 	"overridden in TSendNode"
+ 	^false!

Item was changed:
  ----- Method: TSendNode>>hasEffect (in category 'testing') -----
  hasEffect
  	"Answer if this node has an effect on execution state (does something).
  	 Statements that don't have any effect can be elided if their value is unused."
  	selector == #not ifTrue:
  		[^receiver hasEffect].
+ 	selector == #cCode:inSmalltalk: ifTrue:
+ 		[^(arguments first isConstant and: [arguments first value isString and: [arguments first value notEmpty]])
+ 			or: [arguments first hasEffect]].
  	self isBinaryArithmeticOrConditional ifTrue:
  		[^receiver hasEffect or: [arguments first hasEffect]].
  	self isUnaryCast ifTrue:
  		[^receiver hasEffect].
  	self isBinaryCast ifTrue:
  		[^arguments first hasEffect].
  	^true!

Item was changed:
  ----- Method: TSendNode>>isEffectFree (in category 'testing') -----
  isEffectFree
+ 	^self hasEffect not!
- 	^(self isUnaryCast and: [receiver isEffectFree])
- 	 or: [(self isBinaryCast and: [arguments first isEffectFree])
- 	 or: [self isBinaryArithmeticOrConditional and: [receiver isEffectFree and: [arguments first isEffectFree]]]]!

Item was changed:
  ----- Method: TSendNode>>isNonNullCCode (in category 'testing') -----
  isNonNullCCode
  	^(#(cCode: cCode:inSmalltalk:) includes: selector)
  	   and: [arguments first isConstant
+ 			ifTrue: [arguments first value isString
+ 					and: [arguments first value notEmpty]]
+ 			ifFalse: [arguments first hasEffect]]!
- 	   and: [arguments first value isString
- 	   and: [arguments first value notEmpty]]]!

Item was added:
+ ----- Method: TSendNode>>isNullCCode (in category 'testing') -----
+ isNullCCode
+ 	| node |
+ 	(#(cCode: cCode:inSmalltalk:) includes: selector) ifFalse:
+ 		[^false].
+ 	"all of cCode: nil ..., cCode: []..., cCode: '' are null"
+ 	node := arguments first.
+ 	node isConstant ifTrue:
+ 		[^(node value isString
+ 		   and: [node value notEmpty]) not].
+ 	^node hasEffect not!

Item was added:
+ ----- Method: TSendNode>>isStringishCCode (in category 'testing') -----
+ isStringishCCode
+ 	^(#(cCode: cCode:inSmalltalk:) includes: selector)
+ 	   and: [arguments first isConstant
+ 	   and: [arguments first value isString
+ 	   and: [arguments first value notEmpty]]]!

Item was changed:
  ----- Method: TSwitchStmtNode>>hasEffect (in category 'testing') -----
  hasEffect
  	"Answer if this node has an effect on execution state (does something).
  	 Statements that don't have any effect can be elided if their value is unused."
  	^expression hasEffect
  	  or: [(otherwiseOrNil notNil and: [otherwiseOrNil hasEffect])
+ 	  or: [cases anySatisfy:
+ 			[:tuple|
+ 			(tuple first anySatisfy: [:array| array anySatisfy: [:node| node hasEffect]])
+ 			or: [tuple second hasEffect]]]]!
- 	  or: [cases anySatisfy: [:node| node hasEffect]]]!

Item was changed:
  ----- Method: VMBasicConstants class>>namesDefinedAtCompileTime (in category 'C translation') -----
  namesDefinedAtCompileTime
  	"Answer the set of names for variables that should be defined at compile time.
  	 Some of these get default values during simulation, and hence get defaulted in
  	 the various initializeMiscConstants methods.  But that they have values should
  	 /not/ cause the code generator to do dead code elimination based on their
  	 default values.  In particular, methods marked with <option: ANameDefinedAtCompileTime>
  	 will be emitted within #if defined(ANameDefinedAtCompileTime)...#endif.
  
  	And of course this is backwards.  We'd like to define names that are defined at translation time."
  	^#(VMBIGENDIAN
  		IMMUTABILITY
  		STACKVM COGVM COGMTVM SPURVM
  		PharoVM								"Pharo vs Squeak"
  		TerfVM VM_TICKER						"Terf vs Squeak & Qwaq/Teleplace/Terf high-priority thread support"
  		EnforceAccessControl					"Newspeak"
  		CheckRememberedInTrampoline		"IMMUTABILITY"
  		BIT_IDENTICAL_FLOATING_POINT PLATFORM_SPECIFIC_FLOATING_POINT	"Alternatives for using fdlibm for floating-point"
  		TestingPrimitives
  		OBSOLETE_ALIEN_PRIMITIVES			"Ancient crap in the IA32ABI plugin"
  		LLDB									"As of lldb-370.0.42 Swift-3.1, passing function parameters to printOopsSuchThat fails with Internal error [IRForTarget]: Couldn't rewrite one of the arguments of a function call.  Turning off link time optimization with -fno-lto has no effect.  hence we define some debugging functions as being <option: LLDB>"
  
  		"processor related"
  		__ARM_ARCH__ __arm__ __arm32__ ARM32 __arm64__ ARM64
  		_M_I386 _X86_ i386 i486 i586 i686 __i386__ __386__ X86 I386
  		x86_64 __amd64 __x86_64 __amd64__ __x86_64__ _M_AMD64 _M_X64
  		__mips__ __mips
  		__powerpc __powerpc__ __powerpc64__ __POWERPC__
  		__ppc__ __ppc64__ __PPC__ __PPC64__
  		__sparc__ __sparc __sparc_v8__ __sparc_v9__ __sparcv8 __sparcv9
  
  		"Compiler brand related"
  		__ACK__
  		__CC_ARM
  		__clang__
  		__GNUC__
  		_MSC_VER
  		__ICC
  		__SUNPRO_C
  		
  		"os related"
  		ACORN
  		_AIX
  		__ANDROID__
+ 		__APPLE__
  		__BEOS__
  		__linux__
+ 		__MACH__
  		__MINGW32__
  		__FreeBSD__ __NetBSD__ __OpenBSD__
  		__osf__
  		EPLAN9
  		__unix__ __unix UNIX
  		WIN32 _WIN32 _WIN32_WCE
  		WIN64 _WIN64 _WIN64_WCE)!

Item was changed:
  ----- Method: VMClass class>>shouldIncludeMethodForSelector: (in category 'translation') -----
  shouldIncludeMethodForSelector: selector
  	"Answer whether a primitive method should be translated.  Emit a warning to the transcript if the method doesn't exist."
+ 	selector == #detectFeaturesOnMacOS ifTrue: [self halt].
  	^(self whichClassIncludesSelector: selector)
  		ifNotNil:
  			[:c|
  			 (c >> selector pragmaAt: #option:)
  				ifNotNil:
  					[:pragma|
  					(VMBasicConstants defineAtCompileTime: pragma arguments first)
  					 or: [InitializationOptions
  							at: pragma arguments first
  							ifAbsent: [(self bindingOf: pragma arguments first)
  										ifNil: [false]
  										ifNotNil: [:binding| binding value ~~ #undefined]]]]
  				ifNil: [true]]
  		ifNil:
  			[Transcript nextPutAll: 'Cannot find implementation of '; nextPutAll: selector; nextPutAll: ' in hierarchy of '; print: self; cr; flush.
  			 false]!




More information about the Vm-dev mailing list