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

commits at source.squeak.org commits at source.squeak.org
Wed Nov 11 03:46:14 UTC 2020


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

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

Name: VMMaker.oscog-eem.2876
Author: eem
Time: 10 November 2020, 7:46:01.852115 pm
UUID: e5dba4f0-62a2-4385-a1aa-67c8617b9fd2
Ancestors: VMMaker.oscog-eem.2875

Cogit:
Fix a sign bug in addressIsInCodeZone: which could affect 32-bit VMs.
Fix NumTrampolines for COGMTVM, moving the computation to where it belongs, in Cogit.  Add a range-check assert to catch overrunning the trampolineTable (failure modes are confusing; e.g. limitAddress got smashed which made Open PIC generation break).

Fix the mis-assumption in postGCUpdateDisplayBits that Display bits is always an object (it could be a surface handle).

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

Item was changed:
  ----- Method: CogObjectRepresentationForSpur class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCodeGen
- 	"Deal wuth the fact that the number of trampolines depends on IMMUTABILITY
- 	 and that IMMUTABILITY can be defined at compile time.  Yes, this is a mess."
- 	| current values |
- 	current := InitializationOptions at: #IMMUTABILITY ifAbsent: nil.
- 	values := #(true false) collect:
- 				[:bool|
- 				 InitializationOptions at: #IMMUTABILITY put: bool.
- 				 self cogitClass initializeNumTrampolines.
- 				 (Cogit classPool at: #NumTrampolines) printString].
- 	current
- 		ifNil: [InitializationOptions removeKey: #IMMUTABILITY]
- 		ifNotNil: [InitializationOptions at: #IMMUTABILITY put: current].
- 	values first ~= values last ifTrue:
- 		[aCodeGen addConstantForBinding: #NumTrampolines -> ('(IMMUTABILITY ? ' , values first , ' : ' , values last , ')')].
  	aCodeGen
  		var: #ceStoreTrampolines
+ 			declareC: '#if IMMUTABILITY\sqInt ceStoreTrampolines[', NumStoreTrampolines printString, '];\#endif'!
- 		declareC: '#if IMMUTABILITY\sqInt ceStoreTrampolines[', NumStoreTrampolines printString, '];\#endif'!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur class>>numTrampolines (in category 'trampoline support') -----
  numTrampolines
  	^super numTrampolines
  		 + (SistaV1BytecodeSet
  			ifTrue: [9] "(small,large)x(method,block,fullBlock) context creation,
  						 ceNewHashTrampoline, ceStoreCheckContextReceiverTrampoline and ceScheduleScavengeTrampoline"
  			ifFalse: [7] "(small,large)x(method,block) context creation, 
  						 ceNewHashTrampoline, ceStoreCheckContextReceiverTrampoline and ceScheduleScavengeTrampoline")
+ 		 + (IMMUTABILITY
+ 			ifTrue: [NumStoreTrampolines]
+ 			ifFalse: [0])
- 		 + NumStoreTrampolines
  		 + (SistaVM
  			ifTrue: [1] "inline newHash"
  			ifFalse: [0])!

Item was changed:
  ----- Method: CogX64Compiler>>isWithinMwOffsetRange: (in category 'testing') -----
  isWithinMwOffsetRange: anAddress
  	"Answer if an address can be accessed using the offset in a MoveMw:r:R: or similar instruction.
  	 We assume this is true for 32-bit processors and expect 64-bit processors to answer false
  	 for values in the interpreter or the object memory.    Restrict our use of offsets to reference
+ 	 addresses within the method zone, rather than checking for a 32-bit offset, so as to keep the
- 	 addresses within the method zone, rather than checking for a 32-bit offset, si as to keep the
  	 simulator and real VM in sync."
  
  	^cogit addressIsInCodeZone: anAddress!

Item was added:
+ ----- Method: Cogit class>>bindingForNumTrampolines (in category 'translation') -----
+ bindingForNumTrampolines
+ 	"The number of trampolines depends on some translation-time constants and some compile-time constants.
+ 	  This answers a binding the computes the right value for the compile-time defintions."
+ 	| mtValues roValues |
+ 	mtValues := self numTrampolineValuesFor: #COGMTVM.
+ 	roValues := self numTrampolineValuesFor: #IMMUTABILITY.
+ 	^#NumTrampolines -> ('(', (mtValues min min: roValues min) printString,
+ 							' + (COGMTVM ? ', (mtValues max - mtValues min) printString, ' : 0)',
+ 							' + (IMMUTABILITY ? ', (roValues max - roValues min) printString, ' : 0))')
+ 
+ 	"self bindingForNumTrampolines"!

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 removeConstant: #COGMTVM. "this should be defined at compile time"
  	aCCodeGenerator
  		addHeaderFile:'<stddef.h>'; "for e.g. offsetof"
  		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\uintptr_t (*ceTryLockVMOwner)(uintptr_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 class>>numTrampolineValuesFor: (in category 'translation') -----
+ numTrampolineValuesFor: option
+ 	| current values |
+ 	current := VMBasicConstants classPool at: option.
+ 	values := #(true false) collect:
+ 				[:bool|
+ 				 VMBasicConstants classPool at: option put: bool.
+ 				 self cogitClass initializeNumTrampolines.
+ 				 Cogit classPool at: #NumTrampolines].
+ 	VMBasicConstants classPool at: option put: current.
+ 	^values!

Item was changed:
  ----- Method: Cogit class>>numTrampolines (in category 'trampoline support') -----
  numTrampolines
  	^37 "29 + 4 each for self and super sends"
+ 	+ (COGMTVM ifTrue: [1] ifFalse: [0]) "try lock routine"
- 	+ (COGMTVM ifTrue: [2] ifFalse: [0]) "try lock/unlock routines"
  	+ (LowcodeVM ifTrue: [3] ifFalse: [0])
  	+ CogCompilerClass numTrampolines
  
  	"self withAllSubclasses collect: [:c| {c. (c instVarNames select: [:ea| ea beginsWith: 'ce']) size}]"!

Item was changed:
  ----- Method: Cogit>>addressIsInCodeZone: (in category 'testing') -----
  addressIsInCodeZone: address
  	<inline: true>
  	^address asUnsignedInteger >= codeBase
+ 	  and: [address asUnsignedInteger < methodZone zoneEnd]!
- 	  and: [address < methodZone zoneEnd]!

Item was changed:
  ----- Method: Cogit>>recordGeneratedRunTime:address: (in category 'initialization') -----
  recordGeneratedRunTime: aString address: address
  	<var: #aString type: #'char *'>
+ 	self assert: trampolineTableIndex + 2 <= (NumTrampolines * 2).
  	trampolineAddresses
  		at: trampolineTableIndex put: aString;
  		at: trampolineTableIndex + 1 put: (self cCoerceSimple: address to: #'char *').
+ 	trampolineTableIndex := trampolineTableIndex + 2
+ 
+ 	"self printTrampolineTable"!
- 	trampolineTableIndex := trampolineTableIndex + 2!

Item was changed:
  ----- Method: StackInterpreter>>ioBeDisplay:width:height:depth: (in category 'I/O primitive support') -----
  ioBeDisplay: bitsOrHandle width: width height: height depth: depth
  	"Record the position and dimensions of the display bitmap, and inform
  	 the display subsystem of the installation of a new display bitmap."
  	<var: #bitsOrHandle type: #'void *'>
- 	| changed |
- 	changed := displayBits ~= bitsOrHandle.
  	displayBits := bitsOrHandle.
  	displayWidth := width.
  	displayHeight := height.
  	displayDepth := depth.
  	self ioNoteDisplayChanged: bitsOrHandle width: width height: height depth: depth!

Item was changed:
  ----- Method: StackInterpreter>>postGCUpdateDisplayBits (in category 'object memory support') -----
  postGCUpdateDisplayBits
  	"Update the displayBits after a GC may have moved it.
+ 	 Answer if the displayBits appear valid.  The wrinkle here is that the displayBits could be a surface handle."
- 	 Answer if the displayBits appear valid"
  	<inline: false>
  	| displayObj bitsOop bitsNow |
  	displayObj := objectMemory splObj: TheDisplay.
  	((objectMemory isPointers: displayObj)
+ 	 and: [(objectMemory lengthOf: displayObj) >= 4]) ifFalse:
- 	 and: [(objectMemory lengthOf: displayObj) >= 4
- 	 and: [objectMemory isWordsOrBytes: (bitsOop := objectMemory fetchPointer: 0 ofObject: displayObj)]]) ifFalse:
  		[^false].
+ 	
+ 	bitsOop := objectMemory fetchPointer: 0 ofObject: displayObj.
+ 	(objectMemory isIntegerObject: bitsOop) ifTrue: "It's a surface; our work here is done..."
+ 		[^true].
  
+ 	((objectMemory addressCouldBeObj: bitsOop)
+ 	 and: [objectMemory isWordsOrBytes: bitsOop]) ifFalse:
+ 		[^false].
+ 
  	(objectMemory hasSpurMemoryManagerAPI
  	 and: [objectMemory isPinned: bitsOop]) ifFalse:
  		[bitsNow := self cCode: [objectMemory firstIndexableField: bitsOop]
  					inSmalltalk: [(objectMemory firstIndexableField: bitsOop) asInteger].
  		 displayBits ~= bitsNow ifTrue:
  			[displayBits := bitsNow.
+ 			 self ioNoteDisplayChanged: displayBits width: displayWidth height: displayHeight depth: displayDepth].
+ 		 objectMemory hasSpurMemoryManagerAPI ifTrue:
+ 			[objectMemory pinObject: bitsOop]].
- 			 self ioNoteDisplayChanged: displayBits width: displayWidth height: displayHeight depth: displayDepth]].
  	^true!



More information about the Vm-dev mailing list