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

commits at source.squeak.org commits at source.squeak.org
Sat Oct 1 23:43:28 UTC 2016


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

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

Name: VMMaker.oscog-eem.1956
Author: eem
Time: 1 October 2016, 4:41:38.186285 pm
UUID: b3575eed-1a33-4094-9847-124892efeac2
Ancestors: VMMaker.oscog-EstebanLorenzano.1955

Fix a bogus assert fail in checkIsStillMarriedContext:currentFP:

In the Cogit, eliminate stale dependent values in the instructions used for generating trampolines as part of each zeroOpcodeIndex.  Split out the basic zeroing into zeroOpcodeIndexForNewOpcodes.

Get non-Lowcode cogitFOO.c files to compile by marking the relevant routines as <option: #LowcodeVM>

Fix some asserts by typing inlineCacheValueForSelector:in:at:.  Although this looks like a regression in the inliner; inlineCacheValueForSelector:in:at: should be completely inlined but isn't.  Was it ever?

In 1956 the hard disk drive is invented by an IBM team led by Reynold B. Johnson, the submarine transatlantic telephone cable opens, and the Suez Crisis occurs.

=============== Diff against VMMaker.oscog-EstebanLorenzano.1955 ===============

Item was changed:
  ----- Method: CogAbstractInstruction>>genWriteCSecondResultIntoReg: (in category 'abi') -----
  genWriteCSecondResultIntoReg: abstractRegister
+ 	<option: #LowcodeVM>
  	| cResultReg |
  	cResultReg := self cResultRegisterHigh.
  	abstractRegister ~= cResultReg ifTrue:
  		[cogit gen: MoveRR operand: cResultReg operand: abstractRegister]!

Item was changed:
  ----- Method: CogObjectRepresentation>>generateLowcodeObjectTrampolines (in category 'initialization') -----
  generateLowcodeObjectTrampolines
+ 	<option: #LowcodeVM>
  	ceFloatObjectOfTrampoline := cogit genTrampolineFor: #floatObjectOf:
  												called: 'ceFloatObjectOfTrampoline'
  												floatArg: DPFPReg0
  												result: TempReg.
  	ceFloatValueOfTrampoline := cogit genTrampolineFor: #floatValueOf:
  												called: 'ceFloatValueOfTrampoline'
  												arg: ReceiverResultReg
  												floatResult: DPFPReg0.
  	ceInstantiateClassIndexableSizeTrampoline := cogit genTrampolineFor: #instantiateClass:indexableSize:
  												called: 'ceInstantiateClassIndexableSizeTrampoline'
  												arg: ReceiverResultReg
  												arg: Arg0Reg
  												result: TempReg.
  	ceInstantiateClassTrampoline := cogit genTrampolineFor: #instantiateClass:indexableSize:
  												called: 'ceInstantiateClassTrampoline'
  												arg: ReceiverResultReg
  												arg: 0
  												result: TempReg.
  	ceByteSizeOfTrampoline := cogit genTrampolineFor: #byteSizeOf:
  												called: 'ceByteSizeOfTrampoline'
  												arg: ReceiverResultReg
  												arg: Arg0Reg
  												result: TempReg.
  	BytesPerOop = 4 ifTrue: [
  		cePositive64BitIntegerTrampoline := cogit genTrampolineFor: #positive64BitIntegerFor:
  													called: 'cePositive64BitIntegerTrampoline'
  													arg: ReceiverResultReg
  													arg: Arg0Reg
  													result: TempReg.
  		cePositive64BitValueOfTrampoline := cogit genTrampolineFor: #positive64BitValueOf:
  													called: 'cePositive64BitValueOfTrampoline'
  													arg: ReceiverResultReg
  													result: TempReg
  													result: Arg0Reg.
  		ceSigned64BitIntegerTrampoline := cogit genTrampolineFor: #signed64BitIntegerFor:
  													called: 'ceSigned64BitIntegerTrampoline'
  													arg: ReceiverResultReg
  													arg: Arg0Reg
  													result: TempReg.
  		ceSigned64BitValueOfTrampoline := cogit genTrampolineFor: #signed64BitValueOf:
  													called: 'ceSigned64BitValueOfTrampoline'
  													arg: ReceiverResultReg
  													result: TempReg
  													result: Arg0Reg.
  	] ifFalse: [
  		cePositive64BitIntegerTrampoline := cogit genTrampolineFor: #positive64BitIntegerFor:
  													called: 'cePositive64BitIntegerTrampoline'
  													arg: ReceiverResultReg
  													result: TempReg.
  		cePositive64BitValueOfTrampoline := cogit genTrampolineFor: #positive64BitValueOf:
  													called: 'cePositive64BitValueOfTrampoline'
  													arg: ReceiverResultReg
  													result: TempReg.
  		ceSigned64BitIntegerTrampoline := cogit genTrampolineFor: #signed64BitIntegerFor:
  													called: 'ceSigned64BitIntegerTrampoline'
  													arg: ReceiverResultReg
  													result: TempReg.
  		ceSigned64BitValueOfTrampoline := cogit genTrampolineFor: #signed64BitValueOf:
  													called: 'ceSigned64BitValueOfTrampoline'
  													arg: ReceiverResultReg
  													result: TempReg.
  	]!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>generateLowcodeObjectTrampolines (in category 'initialization') -----
  generateLowcodeObjectTrampolines
+ 	<option: #LowcodeVM>
  	super generateLowcodeObjectTrampolines.
  	cePositive32BitIntegerTrampoline := cogit genTrampolineFor: #positive32BitIntegerFor:
  												called: 'cePositive32BitIntegerTrampoline'
  												arg: ReceiverResultReg
  												result: TempReg.
  	cePositive32BitValueOfTrampoline := cogit genTrampolineFor: #positive32BitValueOf:
  												called: 'cePositive32BitValueOfTrampoline'
  												arg: ReceiverResultReg
  												result: TempReg.
  	ceSigned32BitIntegerTrampoline := cogit genTrampolineFor: #signed32BitIntegerFor:
  												called: 'ceSigned32BitIntegerTrampoline'
  												arg: ReceiverResultReg
  												result: TempReg.
  	ceSigned32BitValueOfTrampoline := cogit genTrampolineFor: #signed32BitValueOf:
  												called: 'ceSigned32BitValueOfTrampoline'
  												arg: ReceiverResultReg
  												result: TempReg.!

Item was changed:
  ----- Method: CogObjectRepresentationForSqueakV3>>generateObjectRepresentationTrampolines (in category 'initialization') -----
  generateObjectRepresentationTrampolines
  	"Do the store check.  Answer the argument for the benefit of the code generator;
  	 ReceiverResultReg may be caller-saved and hence smashed by this call.  Answering
  	 it allows the code generator to reload ReceiverResultReg cheaply."
+ 	<option: #LowcodeVM>
  	ceStoreCheckTrampoline := cogit
  									genTrampolineFor: #ceStoreCheck:
  									called: 'ceStoreCheckTrampoline'
  									arg: ReceiverResultReg
  									regsToSave: (CallerSavedRegisterMask bitClear: (cogit registerMaskFor: ReceiverResultReg))
  									result: cogit returnRegForStoreCheck.
  	ceCreateNewArrayTrampoline := cogit genTrampolineFor: #ceNewArraySlotSize:
  											called: 'ceCreateNewArrayTrampoline'
  											arg: SendNumArgsReg
  											regsToSave: (CallerSavedRegisterMask bitClear: (cogit registerMaskFor: ReceiverResultReg))
  											result: ReceiverResultReg.
  	cePositive32BitIntegerTrampoline := cogit genTrampolineFor: #positive32BitIntegerFor:
  												called: 'cePositive32BitIntegerTrampoline'
  												arg: ReceiverResultReg
  												regsToSave: (CallerSavedRegisterMask bitClear: (cogit registerMaskFor: ReceiverResultReg))
  												result: TempReg.
  	ceActiveContextTrampoline := self genActiveContextTrampoline.
  	ceClosureCopyTrampoline := cogit genTrampolineFor: #ceClosureCopyDescriptor:
  										called: 'ceClosureCopyTrampoline'
  										arg: SendNumArgsReg
  										regsToSave: (CallerSavedRegisterMask bitClear: (cogit registerMaskFor: ReceiverResultReg))
  										result: ReceiverResultReg.
  										
+ 	LowcodeVM ifTrue:
+ 		[cePositive32BitValueOfTrampoline := cogit genTrampolineFor: #positive32BitValueOf:
- 	LowcodeVM ifTrue: [
- 		cePositive32BitValueOfTrampoline := cogit genTrampolineFor: #positive32BitValueOf:
  													called: 'cePositive32BitValueOfTrampoline'
  													arg: ReceiverResultReg
  													result: TempReg.
  		ceSigned32BitIntegerTrampoline := cogit genTrampolineFor: #signed32BitIntegerFor:
  													called: 'ceSigned32BitIntegerTrampoline'
  													arg: ReceiverResultReg
  													result: TempReg.
  		ceSigned32BitValueOfTrampoline := cogit genTrampolineFor: #signed32BitValueOf:
  													called: 'ceSigned32BitValueOfTrampoline'
  													arg: ReceiverResultReg
  													result: TempReg.
  
+ 		self generateLowcodeObjectTrampolines]!
- 		self generateLowcodeObjectTrampolines
- 	]!

Item was changed:
  ----- Method: CogRTLOpcodes class>>initialize (in category 'class initialization') -----
  initialize
  	"Abstract opcodes are a compound of a one word operation specifier and zero or more operand type specifiers.
  	 The assembler is in Cogit protocol abstract instructions and uses `at&t' syntax, assigning to the register on the
  	 right. e.g. MoveRR is the Move opcode with two register operand specifiers and defines a move register to
  	 register instruction from operand 0 to operand 1.  The word and register size is assumed to be either 32-bits
  	 on a 32-bit architecture or 64-bits on a 64-bit architecture.  The abstract machine is mostly a 2 address machine
  	 with the odd three address instruction added to better exploit RISCs.
  			(self initialize)
  	The operand specifiers are
  		R		- general purpose register
  		Rs		- single-precision floating-point register
  		Rd		- double-precision floating-point register
  		Cq		- a `quick' constant that can be encoded in the minimum space possible.
  		Cw		- a constant with word size where word is the default operand size for the Smalltalk VM, 32-bits
  				  for a 32-bit VM, 64-bits for a 64-bit VM.  The generated constant must occupy the default number
  				  of bits.  This allows e.g. a garbage collector to update the value without invalidating the code.
  		C32	- a constant with 32 bit size.  The generated constant must occupy 32 bits.
  		C64	- a constant with 64 bit size.  The generated constant must occupy 64 bits.
  		Aw		- memory word (32-bits for a 32-bit VM, 64-bits for a 64-bit VM) at an absolute address
  		Ab		- memory byte at an absolute address
  		A32	- memory 32-bit halfword at an absolute address
  		Mwr	- memory word whose address is at a constant offset from an address in a register
  		Mbr		- memory byte whose address is at a constant offset from an address in a register (zero-extended on read)
  		M16r	- memory 16-bit halfword whose address is at a constant offset from an address in a register
  		M32r	- memory 32-bit halfword whose address is at a constant offset from an address in a register
  		M64r	- memory 64-bit doubleword whose address is at a constant offset from an address in a register
  		Xbr		- memory byte whose address is r * byte size away from an address in a register
  		X16r	- memory 16-bit halfword whose address is r * (2 bytes size) away from an address in a register
  		X32r	- memory 32-bit halfword whose address is r * (4 bytes size) away from an address in a register
  		Xwr		- memory word whose address is r * word size away from an address in a register
  		Xowr	- memory word whose address is o + (r * word size) away from an address in a register (scaled indexed)
  
  	An alternative would be to decouple opcodes from operands, e.g.
  		Move := 1. Add := 2. Sub := 3...
  		RegisterOperand := 1. ConstantQuickOperand := 2. ConstantWordOperand := 3...
  	But not all combinations make sense and even fewer are used so we stick with the simple compound approach.
  
  	The assumption is that comparison and arithmetic instructions set condition codes and that move instructions
  	leave the condition codes unaffected.  In particular LoadEffectiveAddressMwrR does not set condition codes
  	although it can be used to do arithmetic.  On processors such as MIPS this distinction is invalid; there are no
  	condition codes.  So the backend is allowed to collapse operation, branch pairs to internal instruciton definitions
  	(see sender and implementors of noteFollowingConditionalBranch:). 
  
  	Not all of the definitions in opcodeDefinitions below are implemented.  In particular we do not implement the
  	XowrR scaled index addressing mode since it requires 4 operands.
  
  	Not all instructions make sense on all architectures.  MoveRRd and MoveRdR aqre meaningful only on 64-bit machines.
  
  	Note that there are no generic division instructions defined, but a processor may define some.
  
  	Branch/Call ranges.  Jump[Cond] can be generated as short as possible.  Call/Jump[Cond]Long must be generated
  	in the same number of bytes irrespective of displacement since their targets may be updated, but they need only
  	span 16Mb, the maximum size of the code zone.  This allows e.g. ARM to use single-word call and jump instructions
  	for most calls and jumps.  CallFull/JumpFull must also be generated in the same number of bytes irrespective of
  	displacement for the same reason, but they must be able to span the full (32-bit or 64-bit) address space because
  	they are used to call code in the C runtime, which may be distant from the code zone.  CallFull/JumpFull are allowed
  	to use the cResultRegister as a scratch if required (e.g. on x64 where there is no direct 64-bit call or jump).
  
  	Byte reads.  If the concrete compiler class answers true to byteReadsZeroExtend then byte reads must zero-extend
  	the byte read into the destination register.  If not, the other bits of the register should be left undisturbed and the
  	Cogit will add an instruction to zero the register as required.  Under no circumstances should byte reads sign-extend.
  
  	16-bit (and on 64-bits, 32-bit) reads.  These /are/ expected to always zero-extend."
  
  	| opcodeNames refs |
  	opcodeNames := #("Noops & Pseudo Ops"
  						Label
  						Literal			"a word-sized literal"
  						AlignmentNops
  						Fill32			"output four byte's worth of bytes with operand 0"
  						Nop
  
  						"Control"
  						Call					"call within the code zone"
  						CallFull				"call anywhere within the full address space"
  						CallR
  						RetN
  						JumpR				"Not a regular jump, i.e. not pc dependent."
  						Stop				"Halt the processor"
  
+ 						"N.B.  Jumps are contiguous.  Long and Full jumps are contiguous within them.  See FirstJump et al below"
- 						"N.B.  Jumps are contiguous.  Long and Full jumps are contigiuous within them.  See FirstJump et al below"
  						JumpFull			"Jump anywhere within the address space"
  						JumpLong			"Jump anywhere within the 16mb code zone."
  						JumpLongZero			"a.k.a. JumpLongEqual"
  						JumpLongNonZero		"a.k.a. JumpLongNotEqual"
  						Jump				"short jumps; can be encoded in as few bytes as possible; will not be disturbed by GC or relocation."
  						JumpZero				"a.k.a. JumpEqual"
  						JumpNonZero			"a.k.a. JumpNotEqual"
  						JumpNegative
  						JumpNonNegative
  						JumpOverflow
  						JumpNoOverflow
  						JumpCarry
  						JumpNoCarry
  						JumpLess			"signed"
  						JumpGreaterOrEqual
  						JumpGreater
  						JumpLessOrEqual
  						JumpBelow			"unsigned"
  						JumpAboveOrEqual
  						JumpAbove
  						JumpBelowOrEqual
  
  						JumpFPEqual
  						JumpFPNotEqual
  						JumpFPLess
  						JumpFPLessOrEqual
  						JumpFPGreater
  						JumpFPGreaterOrEqual
  						JumpFPOrdered
  						JumpFPUnordered
  
  						"Data Movement; destination is always last operand"
  						MoveRR
  						MoveAwR MoveA32R
  						MoveRAw MoveRA32
  						MoveAbR
  						MoveRAb
  						MoveMwrR MoveRMwr MoveXwrRR MoveRXwrR MoveXowrR MoveRXowr
  						MoveM8rR MoveMs8rR MoveRM8r 
  						MoveM16rR MoveRM16r MoveX16rRR MoveRX16rR
  						MoveM32rR MoveRM32r MoveX32rRR MoveRX32rR
  						MoveMbrR MoveRMbr MoveXbrRR MoveRXbrR
  						MoveCqR MoveCwR MoveC32R MoveC64R
  						MoveRRd MoveRdR MoveRdRd MoveM64rRd MoveRdM64r
  						MoveRsRs MoveM32rRs MoveRsM32r
  						PopR PushR PushCq PushCw
  						PrefetchAw
  
  						"Arithmetic; destination is always last operand except Cmp; CmpXR is SubRX with no update of result"
  						LoadEffectiveAddressMwrR LoadEffectiveAddressXowrR "Variants of add/multiply"
  						NegateR "2's complement negation"
  						NotR
  						ArithmeticShiftRightCqR ArithmeticShiftRightRR
  						LogicalShiftRightCqR LogicalShiftRightRR
  						LogicalShiftLeftCqR LogicalShiftLeftRR
  						RotateLeftCqR RotateRightCqR
  
  						CmpRR AddRR SubRR AndRR OrRR XorRR
  						CmpCqR AddCqR SubCqR AndCqR OrCqR TstCqR XorCqR
  						CmpCwR CmpC32R AddCwR SubCwR AndCwR OrCwR XorCwR
  						AddcRR AddcCqR SubbRR
  
  						AndCqRR "Three address ops for RISCs; feel free to add and extend"
  
  						CmpRdRd AddRdRd SubRdRd MulRdRd DivRdRd SqrtRd XorRdRd
  						CmpRsRs AddRsRs SubRsRs MulRsRs DivRsRs SqrtRs XorRsRs
  
  						"Conversion"
  						ConvertRRd ConvertRdR
  						ConvertRsRd ConvertRdRs ConvertRsR ConvertRRs
  
  						SignExtend8RR SignExtend16RR
  						ZeroExtend8RR ZeroExtend16RR
  
  						LastRTLCode).
  
  	"Magic auto declaration. Add to the classPool any new variables and nuke any obsolete ones, and assign values"
  	"Find the variables directly referenced by this method"
  	refs := (thisContext method literals select: [:l| l isVariableBinding and: [classPool includesKey: l key]]) collect:
  				[:ea| ea key].
  	"Move to Undeclared any opcodes in classPool not in opcodes or this method."
  	(classPool keys reject: [:k| (opcodeNames includes: k) or: [refs includes: k]]) do:
  		[:k|
  		Undeclared declare: k from: classPool].
  	"Declare as class variables and number elements of opcodeArray above"
  	opcodeNames withIndexDo:
  		[:classVarName :value|
  		self classPool
  			declare: classVarName from: Undeclared;
  			at: classVarName put: value].
  
  	"For CogAbstractInstruction>>isJump etc..."
  	FirstJump := JumpFull.
  	LastJump := JumpFPUnordered.
  	FirstShortJump := Jump.
  
  	"And now initialize the backends; they add their own opcodes and hence these must be reinitialized."
  	(Smalltalk classNamed: #CogAbstractInstruction) ifNotNil:
  		[:cogAbstractInstruction| cogAbstractInstruction allSubclasses do: [:sc| sc initialize]]!

Item was changed:
  ----- Method: Cogit class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  	#(	'coInterpreter' 'objectMemory' 'methodZone' 'objectRepresentation'
  		'cogBlockMethodSurrogateClass' 'cogMethodSurrogateClass' 'nsSendCacheSurrogateClass'
  		'threadManager' 'processor' 'lastNInstructions' 'simulatedAddresses'
  		'simulatedTrampolines' 'simulatedVariableGetters' 'simulatedVariableSetters'
  		'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: 'unsigned long (*ceGetFP)(void)';
  		var: #ceGetSP
  			declareC: 'unsigned long (*ceGetSP)(void)';
  		var: #ceCaptureCStackPointers
  			declareC: 'void (*ceCaptureCStackPointers)(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: #ceFlushICache
  			declareC: 'static void (*ceFlushICache)(unsigned long from, unsigned long to)';
  		var: #ceCheckFeaturesFunction
  			declareC: 'static unsigned long (*ceCheckFeaturesFunction)(void)';
  		var: #ceTryLockVMOwner
  			declareC: 'unsigned long (*ceTryLockVMOwner)(void)';
  		var: #ceUnlockVMOwner
  			declareC: 'void (*ceUnlockVMOwner)(void)';
  		var: #postCompileHook
  			declareC: 'void (*postCompileHook)(CogMethod *)';
  		var: #openPICList declareC: 'CogMethod *openPICList = 0';
+ 		var: #maxMethodBefore type: #'CogBlockMethod *';
+ 		var: 'enumeratingCogMethod' type: #'CogMethod *'.
- 		var: #maxMethodBefore type: #'CogBlockMethod *'.
- 	self objectMemoryClass wordSize = 8 ifTrue:
- 		[aCCodeGenerator var: 'enumeratingCogMethod' type: #'CogMethod *'].
  	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: #blockStarts type: #'BlockStart *';
  		declareVar: #fixups type: #'BytecodeFixup *'.
  	aCCodeGenerator
  		var: #ordinarySendTrampolines
  			declareC: 'sqInt ordinarySendTrampolines[NumSendTrampolines]';
  		var: #superSendTrampolines
  			declareC: 'sqInt superSendTrampolines[NumSendTrampolines]';
  		var: #directedSuperSendTrampolines
  			declareC: 'sqInt directedSuperSendTrampolines[NumSendTrampolines]';
  		var: #selfSendTrampolines
  			declareC: 'sqInt selfSendTrampolines[NumSendTrampolines]';
  		var: #dynamicSuperSendTrampolines
  			declareC: 'sqInt dynamicSuperSendTrampolines[NumSendTrampolines]';
  		var: #implicitReceiverSendTrampolines
  			declareC: 'sqInt implicitReceiverSendTrampolines[NumSendTrampolines]';
  		var: #outerSendTrampolines
  			declareC: 'sqInt outerSendTrampolines[NumSendTrampolines]';
  		var: #trampolineAddresses
  			declareC: 'static char *trampolineAddresses[NumTrampolines*2]';
  		var: #objectReferencesInRuntime
  			declareC: 'static usqInt objectReferencesInRuntime[NumObjRefsInRuntime]';
  		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: #CFramePointer type: #'void *';
  		declareVar: #CStackPointer type: #'void *';
  		declareVar: #minValidCallAddress type: #'unsigned long';
  		declareVar: #debugPrimCallStackOffset type: #'unsigned long'.
  	aCCodeGenerator vmClass generatorTable ifNotNil:
  		[:bytecodeGenTable|
  		aCCodeGenerator
  			var: #generatorTable
  				declareC: 'static BytecodeDescriptor generatorTable[', bytecodeGenTable size, ']',
  							(self tableInitializerFor: bytecodeGenTable
  								in: aCCodeGenerator)].
  	"In C the abstract opcode names clash with the Smalltak 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'!

Item was changed:
  ----- Method: Cogit>>allocateOpcodes:bytecodes: (in category 'initialization') -----
  allocateOpcodes: numberOfAbstractOpcodes bytecodes: numberOfBytecodes
  	"Allocate the various arrays needed to compile abstract instructions.
  	 Notionally we only need as many fixups as there are bytecodes.  But we
  	 reuse fixups to record pc-dependent instructions in generateInstructionsAt:
  	 and so need at least as many as there are abstract opcodes.
  
  	 This *must* be inlined since the arrays are alloca'ed (stack allocated)
  	 so that they are freed when compilation is done.
  
  	 N.B. We do one single alloca to save embarrassing C optimizers that
  	 generate incorrect code as both gcc and the intel compiler do on x86."
  	<inline: true>
  	numAbstractOpcodes := numberOfAbstractOpcodes.
  	self
  		cCode:
  			[| opcodeSize fixupSize|
  			 opcodeSize := (self sizeof: CogAbstractInstruction) * numAbstractOpcodes.
  			 fixupSize := (self sizeof: CogBytecodeFixup) * numAbstractOpcodes.
  			 abstractOpcodes := self alloca: opcodeSize + fixupSize.
  			 self b: abstractOpcodes zero: opcodeSize + fixupSize.
  			 fixups := (abstractOpcodes asUnsignedInteger + opcodeSize) asVoidPointer]
  		inSmalltalk:
  			[abstractOpcodes := CArrayAccessor on:
  									 ((1 to: numAbstractOpcodes) collect: [:ign| CogCompilerClass for: self]).
  			 fixups := CArrayAccessor on:
  						((1 to: numAbstractOpcodes) collect: [:ign| self bytecodeFixupClass for: self])].
+ 	self zeroOpcodeIndexForNewOpcodes.
- 	self zeroOpcodeIndex.
  	labelCounter := 0!

Item was changed:
  ----- Method: Cogit>>allocateOpcodes:bytecodes:ifFail: (in category 'initialization') -----
  allocateOpcodes: numberOfAbstractOpcodes bytecodes: numberOfBytecodes ifFail: failBlock
  	"Allocate the various arrays needed to compile abstract instructions, failing if the size
  	 needed is considered too high.  Notionally we only need as many fixups as there are
  	 bytecodes.  But we reuse fixups to record pc-dependent instructions in
  	 generateInstructionsAt: and so need at least as many as there are abstract opcodes.
  
  	 This *must* be inlined since the arrays are alloca'ed (stack allocated)
  	 so that they are freed when compilation is done.
  
  	 N.B. We do one single alloca to save embarrassing C optimizers that
  	 generate incorrect code as both gcc and the intel compiler do on x86."
  	<inline: true>
  	| opcodeBytes fixupBytes allocBytes |
  	numAbstractOpcodes := numberOfAbstractOpcodes.
  	opcodeBytes := (self sizeof: CogAbstractInstruction) * numAbstractOpcodes.
  	fixupBytes := (self sizeof: CogBytecodeFixup) * numAbstractOpcodes.
  	allocBytes := opcodeBytes + fixupBytes.
  	allocBytes > MaxStackAllocSize ifTrue: [^failBlock value].
  	self
  		cCode:
  			[abstractOpcodes := self alloca: allocBytes.
  			 self b: abstractOpcodes zero: allocBytes.
  			 fixups := (abstractOpcodes asUnsignedInteger + opcodeBytes) asVoidPointer]
  		inSmalltalk:
  			[abstractOpcodes := CArrayAccessor on:
  									 ((1 to: numAbstractOpcodes) collect: [:ign| CogCompilerClass for: self]).
  			 fixups := CArrayAccessor on:
  						((1 to: numAbstractOpcodes) collect: [:ign| self bytecodeFixupClass for: self])].
+ 	self zeroOpcodeIndexForNewOpcodes.
- 	self zeroOpcodeIndex.
  	labelCounter := 0!

Item was changed:
  ----- Method: Cogit>>compileCallFor:numArgs:floatArg:floatArg:floatArg:floatArg:resultReg:regsToSave: (in category 'initialization') -----
  compileCallFor: aRoutine numArgs: numArgs floatArg: regOrConst0 floatArg: regOrConst1 floatArg: regOrConst2 floatArg: regOrConst3 resultReg: resultRegOrNone regsToSave: regMask
  	"Generate a call to aRoutine with up to 4 arguments.  If resultRegOrNone is not
  	 NoReg assign the C result to resultRegOrNone.  If saveRegs, save all registers.
  	 Hack: a negative arg value indicates an abstract register, a non-negative value
  	 indicates a constant."
+ 	<option: #LowcodeVM>
  	<var: #aRoutine type: #'void *'>
  	<inline: false>
  	| regsToSave |
  	regsToSave := resultRegOrNone = NoReg
  						ifTrue: [regMask]
  						ifFalse: [regMask bitClear: (self registerMaskFor: resultRegOrNone)].
  	cStackAlignment > objectMemory wordSize ifTrue:
  		[backEnd
  			genAlignCStackSavingRegisters: regsToSave
  			numArgs: numArgs
  			wordAlignment: cStackAlignment / objectMemory wordSize].
  	backEnd
  		genSaveRegs: regsToSave;
  		genMarshallNArgs: numArgs floatArg: regOrConst0 floatArg: regOrConst1 floatArg: regOrConst2 floatArg: regOrConst3.
  	self CallFullRT: (self cCode: [aRoutine asUnsignedInteger]
  						inSmalltalk: [self simulatedTrampolineFor: aRoutine]).
  	resultRegOrNone ~= NoReg ifTrue:
  		[backEnd genWriteCResultIntoReg: resultRegOrNone].
  	 numArgs > 0 ifTrue:
  		[backEnd genRemoveNFloatArgsFromStack: numArgs].
  	backEnd genRestoreRegs: regsToSave!

Item was changed:
  ----- Method: Cogit>>compileTrampolineFor:numArgs:floatArg:floatArg:floatArg:floatArg:regsToSave:pushLinkReg:resultReg: (in category 'initialization') -----
  compileTrampolineFor: aRoutine numArgs: numArgs floatArg: regOrConst0 floatArg: regOrConst1 floatArg: regOrConst2 floatArg: regOrConst3 regsToSave: regMask pushLinkReg: pushLinkReg resultReg: resultRegOrNone
  	"Generate a trampoline with up to four arguments.  Generate either a call or a jump to aRoutine
  	 as requested by callJumpBar.  If generating a call and resultRegOrNone is not NoReg pass the C
  	 result back in resultRegOrNone.
  	 Hack: a negative value indicates an abstract register, a non-negative value indicates a constant."
+ 	<option: #LowcodeVM>
  	<var: #aRoutine type: #'void *'>
  	<inline: false>
  	self genSmalltalkToCStackSwitch: pushLinkReg.
  	self
  		compileCallFor: aRoutine
  		numArgs: numArgs
  		floatArg: regOrConst0
  		floatArg: regOrConst1
  		floatArg: regOrConst2
  		floatArg: regOrConst3
  		resultReg: resultRegOrNone
  		regsToSave: regMask.
  	backEnd genLoadStackPointers.
  	(pushLinkReg and: [backEnd hasLinkRegister])
  		ifTrue:
  			[backEnd hasPCRegister
  				ifTrue: [self PopR: PCReg]
  				ifFalse: [self PopR: LinkReg. 
  						self RetN: 0]]
  		ifFalse: [self RetN: 0]!

Item was changed:
  ----- Method: Cogit>>genTrampolineFor:called:arg:result:result: (in category 'initialization') -----
  genTrampolineFor: aRoutine called: aString arg: regOrConst0 result: resultReg result: resultReg2
  	"Generate a trampoline with one argument that answers a result.
  	 Hack: a negative value indicates an abstract register, a non-negative value indicates a constant."
+ 	<option: #LowcodeVM>
  	<var: #aRoutine type: #'void *'>
  	<var: #aString type: #'char *'>
  	^self
  		genTrampolineFor: aRoutine
  		called: aString
  		numArgs: 1
  		arg: regOrConst0
  		arg: nil
  		arg: nil
  		arg: nil
  		regsToSave: self emptyRegisterMask
  		pushLinkReg: true
  		resultReg: resultReg
  		resultReg: resultReg2
  		appendOpcodes: false!

Item was changed:
  ----- Method: Cogit>>genTrampolineFor:called:numArgs:floatArg:floatArg:floatArg:floatArg:regsToSave:pushLinkReg:resultReg:appendOpcodes: (in category 'initialization') -----
  genTrampolineFor: aRoutine called: trampolineName numArgs: numArgs floatArg: regOrConst0 floatArg: regOrConst1 floatArg: regOrConst2 floatArg: regOrConst3 regsToSave: regMask pushLinkReg: pushLinkReg resultReg: resultRegOrNone appendOpcodes: appendBoolean
  	"Generate a trampoline with up to four arguments.  Generate either a call or a jump to aRoutineOrNil
  	 as requested by callJumpBar.  If generating a call and resultRegOrNone is not NoReg pass the C result
  	 back in resultRegOrNone.
  	 Hack: a negative value indicates an abstract register, a non-negative value indicates a constant."
+ 	<option: #LowcodeVM>
  	<var: #aRoutine type: #'void *'>
  	<var: #trampolineName type: #'char *'>
  	| startAddress |
  	<inline: false>
  	startAddress := methodZoneBase.
  	appendBoolean ifFalse:
  		[self zeroOpcodeIndex].
  	self compileTrampolineFor: aRoutine
  		numArgs: numArgs
  		floatArg: regOrConst0
  		floatArg: regOrConst1
  		floatArg: regOrConst2
  		floatArg: regOrConst3
  		regsToSave: regMask
  		pushLinkReg: pushLinkReg
  		resultReg: resultRegOrNone.
  	self outputInstructionsForGeneratedRuntimeAt: startAddress.
  	self recordGeneratedRunTime: trampolineName address: startAddress.
  	self recordRunTimeObjectReferences.
  	^startAddress!

Item was changed:
  ----- Method: Cogit>>inlineCacheValueForSelector:in:at: (in category 'in-line cacheing') -----
  inlineCacheValueForSelector: selector in: aCogMethod at: mcpc
  	"Answer the value to put in an inline-cache that is being loaded with the selector.
  	 Usually this is simply the selector, but in 64-bits the cache is only 32-bits wide
  	 and so the cache is loaded with the index of the selector."
+ 	<var: #aCogMethod type: #'CogMethod *'>
  	<inline: true>
  	^self inlineCacheTagsAreIndexes
  		ifTrue: [self indexForSelector: selector in: aCogMethod at: mcpc]
  		ifFalse: [selector]!

Item was changed:
  ----- Method: Cogit>>zeroOpcodeIndex (in category 'accessing') -----
  zeroOpcodeIndex
  	"Access for the object representations when they need to prepend code to trampolines."
+ 	"Eliminate stale dependent info."
+ 	0 to: opcodeIndex - 1 do:
+ 		[:i| (abstractOpcodes at: i) dependent: nil].
+ 	self zeroOpcodeIndexForNewOpcodes!
- 	opcodeIndex := 0.
- 	literalsManager resetLiterals!

Item was added:
+ ----- Method: Cogit>>zeroOpcodeIndexForNewOpcodes (in category 'accessing') -----
+ zeroOpcodeIndexForNewOpcodes
+ 	"Access for the object representations when they need to prepend code to trampolines."
+ 	opcodeIndex := 0.
+ 	literalsManager resetLiterals!

Item was changed:
  ----- Method: StackInterpreter>>checkIsStillMarriedContext:currentFP: (in category 'frame access') -----
  checkIsStillMarriedContext: aContext currentFP: currentFP
  	"Another version of isWidowedContext: for debugging.
  	 This will not bereave a widowed context."
  	| thePage maybeFP limitFP maybeFrameCtxt |
  	<inline: false>
  	<var: #currentFP type: #'char *'>
  	<var: #thePage type: #'StackPage *'>
  	<var: #maybeFP type: #'char *'>
  	<var: #limitFP type: #'char *'>
  	((objectMemory isContext: aContext)
  	 and: [self isMarriedOrWidowedContext: aContext]) ifFalse:
  		[^false].
  	maybeFP := self frameOfMarriedContext: aContext.
  	thePage := stackPages stackPageFor: maybeFP.
  	limitFP := (thePage = stackPage and: [currentFP notNil])
  				ifTrue: [currentFP]
  				ifFalse: [thePage headFP].
  	(maybeFP >= limitFP
  	 and: [(objectMemory isNonImmediate: (self frameCallerFP: maybeFP) asInteger)
  	 and: [(self withSmallIntegerTags: (self frameCallerFP: maybeFP))
  			= (objectMemory fetchPointer: InstructionPointerIndex ofObject: aContext)
  	 and: [self frameHasContext: maybeFP]]]) ifFalse:
  		[^false].
  	maybeFrameCtxt := self frameContext: maybeFP.
  	"On Spur we need to follow the context to check for a match, but since the VM is
  	 only speculating about maybeFrame being a frame, and only speculating about
  	 maybeContext being a context, we need to be sure before we can safely follow."
  	(objectMemory hasSpurMemoryManagerAPI
+ 	 and: [(stackPages isFree: thePage) not
  	 and: [(self isFrame: maybeFP onPage: thePage)
+ 	 and: [objectMemory isForwarded: maybeFrameCtxt]]]) ifTrue:
- 	 and: [objectMemory isForwarded: maybeFrameCtxt]]) ifTrue:
  		[maybeFrameCtxt := objectMemory followForwarded: maybeFrameCtxt].
  	^maybeFrameCtxt = aContext!



More information about the Vm-dev mailing list