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

commits at source.squeak.org commits at source.squeak.org
Thu Jul 31 05:46:01 UTC 2014


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

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

Name: VMMaker.oscog-eem.839
Author: eem
Time: 30 July 2014, 7:41:05.928 pm
UUID: 11079ac8-603b-476f-8f5f-a4b551d0421f
Ancestors: VMMaker.oscog-eem.838

Spur:
Fix initialization of the heap-resident remembered set added
by VMMaker.oscog-eem.827.  It must be created /after/ old
space is initialized.

Sista:
More work defining the Sista bytecodes in
SistaStackToRegisterMappingCogit.

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

Item was changed:
  ----- Method: Cogit>>generateTrampolines (in category 'initialization') -----
  generateTrampolines
  	"Generate the run-time entries and exits at the base of the native code zone and update the base.
  	 Read the class-side method trampolines for documentation on the various trampolines"
  	| methodZoneStart |
  	methodZoneStart := methodZoneBase.
  	self allocateOpcodes: 80 bytecodes: 0.
  	initialPC := 0.
  	endPC := numAbstractOpcodes - 1.
  	hasYoungReferent := false.
  	self generateSendTrampolines.
  	self generateMissAbortTrampolines.
  	objectRepresentation generateObjectRepresentationTrampolines.
  	self generateRunTimeTrampolines.
  	self cppIf: NewspeakVM ifTrue: 	[self generateNewspeakRuntime].
+ 	self cppIf: SistaVM ifTrue: [self generateSistaRuntime].
  	self generateEnilopmarts.
  	self generateTracingTrampolines.
  
  	"finish up"
  	self recordGeneratedRunTime: 'methodZoneBase' address: methodZoneBase.
  	processor flushICacheFrom: methodZoneStart to: methodZoneBase!

Item was changed:
  ----- Method: ObjectMemory>>isArrayNonImm: (in category 'header access') -----
  isArrayNonImm: oop
+ 	<api>
+ 	"Answer if this is an indexable object with pointer elements, e.g., an array"
- 	"Answer true if this is an indexable object with pointer elements, e.g., an array"
  	^ (self formatOf: oop) = 2!

Item was changed:
  ----- Method: SimpleStackBasedCogit class>>initializeBytecodeTableForSistaV1 (in category 'class initialization') -----
  initializeBytecodeTableForSistaV1
  	"SimpleStackBasedCogit initializeBytecodeTableForSistaV1"
  
  	self flag:
  'Special selector send class must be inlined to agree with the interpreter, which
   inlines class.  If class is sent to e.g. a general instance of ProtoObject then unless
   class is inlined there will be an MNU.  It must be that the Cointerpreter and Cogit
   have identical semantics.  We get away with not hardwiring the other special
   selectors either because in the Cointerpreter they are not inlined or because they
   are inlined only to instances of classes for which there will always be a method.'.
  	self generatorTableFrom: #(
  		"1 byte bytecodes"
  		"pushes"
  		(1    0   15 genPushReceiverVariableBytecode)
  		(1  16   31 genPushLiteralVariable16CasesBytecode	needsFrameNever: 1)
  		(1  32   63 genPushLiteralConstantBytecode			needsFrameNever: 1)
  		(1  64   75 genPushTemporaryVariableBytecode)
  		(1  76   76 genPushReceiverBytecode)
  		(1  77   77 genPushConstantTrueBytecode				needsFrameNever: 1)
  		(1  78   78 genPushConstantFalseBytecode			needsFrameNever: 1)
  		(1  79   79 genPushConstantNilBytecode				needsFrameNever: 1)
  		(1  80   80 genPushConstantZeroBytecode				needsFrameNever: 1)
  		(1  81   81 genPushConstantOneBytecode				needsFrameNever: 1)
  		(1  82   82 genExtPushPseudoVariable)
  		(1  83   83 duplicateTopBytecode						needsFrameNever: 1)
  
  		(1  84   87 unknownBytecode)
  
  		"returns"
  		(1  88   88 genReturnReceiver				return needsFrameIfInBlock: isMappedInBlock 0)
  		(1  89   89 genReturnTrue					return needsFrameIfInBlock: isMappedInBlock 0)
  		(1  90   90 genReturnFalse					return needsFrameIfInBlock: isMappedInBlock 0)
  		(1  91   91 genReturnNil					return needsFrameIfInBlock: isMappedInBlock 0)
  		(1  92   92 genReturnTopFromMethod		return needsFrameIfInBlock: isMappedInBlock -1)
  		(1  93   93 genReturnNilFromBlock			return needsFrameNever: -1)
  		(1  94   94 genReturnTopFromBlock		return needsFrameNever: -1)
  		(1  95   95 genExtNopBytecode			needsFrameNever: 0)
  
  		"sends"
  		(1   96 117 genSpecialSelectorSend isMapped) "#+ #- #< #> #<= #>= #= #~= #* #/ #\\ #@ #bitShift: #// #bitAnd: #bitOr: #at: #at:put: #size #next #nextPut: #atEnd"
  		(1 118 118 genSpecialSelectorEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)"
  		(1 119 119 genSpecialSelectorClass needsFrameNever: notMapped 0) "not mapped because it is directly inlined (for now)"
  		(1 120 127 genSpecialSelectorSend isMapped) "#blockCopy: #value #value: #do: #new #new: #x #y"
  
  		(1 128 143 genSendLiteralSelector0ArgsBytecode isMapped)
  		(1 144 159 genSendLiteralSelector1ArgBytecode isMapped)
  		(1 160 175 genSendLiteralSelector2ArgsBytecode isMapped)
  
  		"jumps"
  		(1 176 183 genShortUnconditionalJump	branch v3:ShortForward:Branch:Distance:)
  		(1 184 191 genShortJumpIfTrue			branch isBranchTrue isMapped "because of mustBeBoolean"
  													v3:ShortForward:Branch:Distance:)
  		(1 192 199 genShortJumpIfFalse			branch isBranchFalse isMapped "because of mustBeBoolean"
  													v3:ShortForward:Branch:Distance:)
  
  		"stores"
  		(1 200 207 genStoreAndPopReceiverVariableBytecode needsFrameNever: -1) "N.B. not frameless if immutability"
  		(1 208 215 genStoreAndPopTemporaryVariableBytecode)
  
  		(1 216 216 genPopStackBytecode needsFrameNever: -1)
  
  		(1 217 223 unknownBytecode)
  
  		"2 byte bytecodes"
  		(2 224 224 extABytecode extension)
  		(2 225 225 extBBytecode extension)
  
  		"pushes"
  		(2 226 226 genExtPushReceiverVariableBytecode)
  		(2 227 227 genExtPushLiteralVariableBytecode		needsFrameNever: 1)
  		(2 228 228 genExtPushLiteralBytecode					needsFrameNever: 1)
  		(2 229 229 genLongPushTemporaryVariableBytecode)
  		(2 230 230 genPushClosureTempsBytecode)
  		(2 231 231 genPushNewArrayBytecode)
  		(2 232 232 genExtPushIntegerBytecode				needsFrameNever: 1)
  		(2 233 233 genExtPushCharacterBytecode				needsFrameNever: 1)
  
  		"returns"
  		"sends"
  		(2 234 234 genExtSendBytecode isMapped)
  		(2 235 235 genExtSendSuperBytecode isMapped)
  
  		"sista bytecodes"
  		(2 236 236 genExtTrapIfNotInstanceOfBehaviorsBytecode isMapped)
  
  		"jumps"
  		(2 237 237 genExtUnconditionalJump	branch isMapped "because of interrupt check" v4:Long:Branch:Distance:)
  		(2 238 238 genExtJumpIfTrue			branch isBranchTrue isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
  		(2 239 239 genExtJumpIfFalse			branch isBranchFalse isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
  
  		"stores"
  		(2 240 240 genExtStoreAndPopReceiverVariableBytecode)
  		(2 241 241 genExtStoreAndPopLiteralVariableBytecode)
  		(2 242 242 genLongStoreAndPopTemporaryVariableBytecode)
  		(2 243 243 genExtStoreReceiverVariableBytecode)
  		(2 244 244 genExtStoreLiteralVariableBytecode)
  		(2 245 245 genLongStoreTemporaryVariableBytecode)
  
  		(2 246 247	unknownBytecode)
  
  		"3 byte bytecodes"
+ 		(3 248 248 genCallPrimitiveBytecode)
- 		(3 248 248 callPrimitiveBytecode)
  		(3 249 249 unknownBytecode) "reserved for Push Float"
  		(3 250 250 genExtPushClosureBytecode block v4:Block:Code:Size:)
  		(3 251 251 genPushRemoteTempLongBytecode)
  		(3 252 252 genStoreRemoteTempLongBytecode)
  		(3 253 253 genStoreAndPopRemoteTempLongBytecode)
  
  		(3 254 255	unknownBytecode))!

Item was added:
+ ----- Method: SimpleStackBasedCogit>>genExtTrapIfNotInstanceOfBehaviorsBytecode (in category 'bytecode generators') -----
+ genExtTrapIfNotInstanceOfBehaviorsBytecode
+ 	"SistaV1: *	236		11101100	iiiiiiii		Trap If Not Instance Of Behavior/Array Of Behavior #iiiiiiii (+ Extend A * 256, where Extend A >= 0)"
+ 	"THis realy makes sense only for the optimizing JITs"
+ 	^EncounteredUnknownBytecode!

Item was added:
+ ----- Method: SimpleStackBasedCogit>>genPushClosureTempsBytecode (in category 'bytecode generators') -----
+ genPushClosureTempsBytecode
+ 	"SistaV1: 230		11100110	iiiiiiii		PushNClosureTemps iiiiiiii"
+ 	1 to: byte1 do:
+ 		[:i| self genPushLiteral: objectMemory nilObject]!

Item was changed:
  StackToRegisterMappingCogit subclass: #SistaStackToRegisterMappingCogit
+ 	instanceVariableNames: 'picDataIndex picData numCounters counters counterIndex initialCounterValue prevMapAbsPCMcpc ceClassTrapTrampoline'
- 	instanceVariableNames: 'picDataIndex picData numCounters counters counterIndex initialCounterValue prevMapAbsPCMcpc'
  	classVariableNames: 'CounterBytes MaxCounterValue'
  	poolDictionaries: 'VMSqueakClassIndices'
  	category: 'VMMaker-JIT'!
  
  !SistaStackToRegisterMappingCogit commentStamp: 'eem 4/7/2014 12:23' prior: 0!
  A SistaStackToRegisterMappingCogit is a refinement of StackToRegisterMappingCogit that generates code suitable for dynamic optimization by Sista, the Speculative Inlining Smalltalk Architecture, a project by Clément Bera and Eliot Miranda.  Sista is an optimizer that exists in the Smalltalk image, /not/ in the VM,  and optimizes by substituting normal bytecoded methods by optimized bytecoded methods that may use special bytecodes for which the Cogit can generate faster code.  These bytecodes eliminate overheads such as bounds checks or polymorphic code (indexing Array, ByteArray, String etc).  But the bulk of the optimization performed is in inlining blocks and sends for the common path.
  
  The basic scheme is that SistaStackToRegisterMappingCogit generates code containing performance counters.  When these counters trip, a callback into the image is performed, at which point Sista analyses some portion of the stack, looking at performance data for the methods on the stack, and optimises based on the stack and performance data.  Execution then resumes in the optimized code.
  
  SistaStackToRegisterMappingCogit adds counters to conditional branches.  Each branch has an executed and a taken count, implemented at the two 16-bit halves of a single 32-bit word.  Each counter pair is initialized with initialCounterValue.  On entry to the branch the executed count is decremented and if the count goes below zero the ceMustBeBooleanAdd[True|False] trampoline called.  The trampoline distinguishes between true mustBeBoolean and counter trips because in the former the register temporarily holding the counter value will contain zero.  Then the condition is tested, and if the branch is taken the taken count is decremented.  The two counter values allow an optimizer to collect basic block execution paths and to know what are the "hot" paths through execution that are worth agressively optimizing.  Since conditional branches are about 1/6 as frequent as sends, and since they can be used to determine the hot path through code, they are a better choice to count than, for example, method or block entry.
  
  SistaStackToRegisterMappingCogit implements picDataFor:into: that fills an Array with the state of the counters in a method and the state of each linked send in a method.  This is used to implement a primitive used by the optimizer to answer the branch and send data for a method as an Array.
  
  Instance Variables
  	counterIndex:			<Integer>
  	counterMethodCache:	<CogMethod>
  	counters:				<Array of AbstractInstruction>
  	initialCounterValue:		<Integer>
  	numCounters:			<Integer>
  	picData:				<Integer Oop>
  	picDataIndex:			<Integer>
  	prevMapAbsPCMcpc:	<Integer>
  
  counterIndex
  	- xxxxx
  
  counterMethodCache
  	- xxxxx
  
  counters
  	- xxxxx
  
  initialCounterValue
  	- xxxxx
  
  numCounters
  	- xxxxx
  
  picData
  	- xxxxx
  
  picDataIndex
  	- xxxxx
  
  prevMapAbsPCMcpc
  	- xxxxx
  !

Item was added:
+ ----- Method: SistaStackToRegisterMappingCogit>>genExtTrapIfNotInstanceOfBehaviorsBytecode (in category 'bytecode generators') -----
+ genExtTrapIfNotInstanceOfBehaviorsBytecode
+ 	"SistaV1: *	236		11101100	iiiiiiii		Trap If Not Instance Of Behavior/Array Of Behavior #iiiiiiii (+ Extend A * 256, where Extend A >= 0)"
+ 	| litIndex literal branches label numBranches |
+ 	<var: #branches type: #'AbstractInstruction **'>
+ 	self ssStorePop: false toPreferredReg: ReceiverResultReg.
+ 	litIndex := extA * 256 + byte1.
+ 	extA := 0.
+ 	literal := self getLiteral: litIndex.
+ 	numBranches := (objectMemory isArrayNonImm: literal)
+ 						ifTrue: [objectMemory numSlotsOf: literal]
+ 						ifFalse: [1].
+ 	branches := self alloca: numBranches type: (self cCoerceSimple: CogAbstractInstruction to: #'AbstractInstruction *').
+ 	(objectMemory isArrayNonImm: literal)
+ 		ifTrue: [objectRepresentation branchIfInstanceOfBehaviors: literal branches: branches]
+ 		ifFalse: [objectRepresentation branchIfInstanceOfBehavior: literal branches: branches].
+ 	"Only flush teh stack if the class trap traps.  Use ssFlushNoUpdateTo: so we continue compiling as if
+ 	 the stack had not been fliushed.  Control does not return after the ceClassTrapTrampoline call."
+ 	self ssFlushNoUpdateTo: simStackPtr.
+ 	self CallRT: ceClassTrapTrampoline.
+ 	label := self Label.
+ 	0 to: numBranches - 1 do:
+ 		[:i|
+ 		(branches at: i) jmpTarget: label].
+ 	^0!

Item was added:
+ ----- Method: SistaStackToRegisterMappingCogit>>generateSistaRuntime (in category 'initialization') -----
+ generateSistaRuntime
+ 	"Class trap sends class trap message to context with top of stack, so we on't need any arguments..."
+ 	ceClassTrapTrampoline := self genTrampolineFor: #ceClassTrap
+ 									called: 'ceClassTrapTrampoline'!

Item was added:
+ ----- Method: SistaStackToRegisterMappingCogit>>ssFlushNoUpdateTo: (in category 'simulation stack') -----
+ ssFlushNoUpdateTo: index
+ 	"This version of ssFlushTo: does /not/ update the simulation stack; it merely h=generates the spill code.
+ 	 It is used to spill all valiues to teh stack on a rare failing branch (the class trap) when we don't want to
+ 	 flush the stack on the main path and hence mustn't update the simulation stack if there is no spill."
+ 	<var: 'copiedEntry' type: #CogSimStackEntry>
+ 	self assert: needsFrame.
+ 	methodOrBlockNumTemps to: simSpillBase - 1 do:
+ 		[:i| self assert: (self simStackAt: i) spilled].
+ 	simSpillBase <= index ifTrue:
+ 		[(simSpillBase max: 0) to: index do:
+ 			[:i| | copiedEntry |
+ 			copiedEntry := self cCode: [simStack at: index]
+ 								inSmalltalk: [(simStack at: index) copy].
+ 			copiedEntry
+ 				ensureSpilledAt: (self frameOffsetOfTemporary: i)
+ 				from: FPReg]]!

Item was changed:
  ----- Method: SpurMemoryManager>>initializeObjectMemory: (in category 'initialization') -----
  initializeObjectMemory: bytesToShift
  	"Initialize object memory variables at startup time. Assume endOfMemory at al are
  	 initialised by the image-reading code via setHeapBase:memoryLimit:endOfMemory:.
  	 endOfMemory is assumed to point to the end of the last object in the image.
  	 Assume: image reader also initializes the following variables:
  		specialObjectsOop
  		lastHash"
  	<inline: false>
  	| freeListObj |
  	"Catch mis-initializations leading to bad translations to C"
  	self assert: BaseHeaderSize = self baseHeaderSize.
  	self assert: (self maxSlotsForAlloc * BytesPerWord) asInteger > 0.
  	self bootstrapping ifFalse:
  		[self
  			initSegmentBridgeWithBytes: self bridgeSize
  			at: endOfMemory - self bridgeSize].
  	segmentManager adjustSegmentSwizzlesBy: bytesToShift.
  	"image may be at a different address; adjust oops for new location"
  	self adjustAllOopsBy: bytesToShift.
  	specialObjectsOop := segmentManager swizzleObj: specialObjectsOop.
  
  	"heavily used special objects"
  	nilObj		:= self splObj: NilObject.
  	falseObj	:= self splObj: FalseObject.
  	trueObj		:= self splObj: TrueObject.
  
  	"In Cog we insist that nil, true & false are next to each other (Cogit generates tighter
  	 conditional branch code as a result).  In addition, Spur places the free lists and
  	 class table root page immediately following them."
  	self assert: nilObj = oldSpaceStart.
  	self assert: falseObj = (self objectAfter: nilObj).
  	self assert: trueObj = (self objectAfter: falseObj).
  	freeListObj := self objectAfter: trueObj.
  	self reInitializeClassTablePostLoad: (self objectAfter: freeListObj).
  	markStack := self swizzleObjStackAt: MarkStackRootIndex.
  	weaklingStack := self swizzleObjStackAt: WeaklingStackRootIndex.
  	ephemeronQueue := self swizzleObjStackAt: EphemeronQueueRootIndex.
  	self assert: self validObjStacks.
  	self assert: (self isEmptyObjStack: markStack).
  	self assert: (self isEmptyObjStack: weaklingStack).
  
  	self initializeFreeSpacePostLoad: freeListObj.
  	segmentManager collapseSegmentsPostSwizzle.
  	self computeFreeSpacePostSwizzle.
+ 	self initializeOldSpaceFirstFree: freeOldSpaceStart. "initializes endOfMemory, freeStart, free space"
  	self bootstrapping ifFalse:
  		[self initializeNewSpaceVariables.
  		 scavenger initializeRememberedSet].
- 	self initializeOldSpaceFirstFree: freeOldSpaceStart. "initializes endOfMemory, freeStart"
  	segmentManager checkSegments.
  
  	numCompactionPasses := CompactionPassesForGC.
  
  	"These defaults should depend on machine size; e.g. too small on a powerful laptop, too big on a Pi."
  	growHeadroom := 16*1024*1024.		"headroom when growing"
  	shrinkThreshold := 32*1024*1024.		"free space before shrinking"
  	self setHeapSizeAtPreviousGC.
  	heapGrowthToSizeGCRatio := 0.333333. "By default GC after scavenge if heap has grown by a third since the last GC"!

Item was changed:
  ----- Method: SpurMemoryManager>>isArrayNonImm: (in category 'object testing') -----
  isArrayNonImm: oop
+ 	<api>
+ 	"Answer if this is an indexable object with pointer elements, e.g., an array"
- 	"Answer true if this is an indexable object with pointer elements, e.g., an array"
  	^ (self formatOf: oop) = self arrayFormat!

Item was changed:
  ----- Method: StackToRegisterMappingCogit class>>initializeBytecodeTableForSistaV1 (in category 'class initialization') -----
  initializeBytecodeTableForSistaV1
  	"StackToRegisterMappingCogit initializeBytecodeTableForSistaV1"
  
  	numPushNilsFunction := #sistaV1:Num:Push:Nils:.
  	pushNilSizeFunction := #sistaV1PushNilSize:.
  	self flag:
  'Special selector send class must be inlined to agree with the interpreter, which
   inlines class.  If class is sent to e.g. a general instance of ProtoObject then unless
   class is inlined there will be an MNU.  It must be that the Cointerpreter and Cogit
   have identical semantics.  We get away with not hardwiring the other special
   selectors either because in the Cointerpreter they are not inlined or because they
   are inlined only to instances of classes for which there will always be a method.'.
  	self generatorTableFrom: #(
  		"1 byte bytecodes"
  		"pushes"
  		(1    0   15 genPushReceiverVariableBytecode			needsFrameNever: 1)
  		(1  16   31 genPushLiteralVariable16CasesBytecode	needsFrameNever: 1)
  		(1  32   63 genPushLiteralConstantBytecode			needsFrameNever: 1)
  		(1  64   75 genPushTemporaryVariableBytecode		needsFrameIfMod16GENumArgs: 1)
  		(1  76   76 genPushReceiverBytecode					needsFrameNever: 1)
  		(1  77   77 genPushConstantTrueBytecode				needsFrameNever: 1)
  		(1  78   78 genPushConstantFalseBytecode			needsFrameNever: 1)
  		(1  79   79 genPushConstantNilBytecode				needsFrameNever: 1)
  		(1  80   80 genPushConstantZeroBytecode				needsFrameNever: 1)
  		(1  81   81 genPushConstantOneBytecode				needsFrameNever: 1)
  		(1  82   82 genExtPushPseudoVariable)
  		(1  83   83 duplicateTopBytecode						needsFrameNever: 1)
  
  		(1  84   87 unknownBytecode)
  
  		"returns"
  		(1  88   88 genReturnReceiver				return needsFrameIfInBlock: isMappedInBlock 0)
  		(1  89   89 genReturnTrue					return needsFrameIfInBlock: isMappedInBlock 0)
  		(1  90   90 genReturnFalse					return needsFrameIfInBlock: isMappedInBlock 0)
  		(1  91   91 genReturnNil					return needsFrameIfInBlock: isMappedInBlock 0)
  		(1  92   92 genReturnTopFromMethod		return needsFrameIfInBlock: isMappedInBlock -1)
  		(1  93   93 genReturnNilFromBlock			return needsFrameNever: -1)
  		(1  94   94 genReturnTopFromBlock		return needsFrameNever: -1)
  		(1  95   95 genExtNopBytecode			needsFrameNever: 0)
  
  		"sends"
  		(1  96   96 genSpecialSelectorArithmetic isMapped AddRR)
  		(1  97   97 genSpecialSelectorArithmetic isMapped SubRR)
  		(1  98   98 genSpecialSelectorComparison isMapped JumpLess)
  		(1  99   99 genSpecialSelectorComparison isMapped JumpGreater)
  		(1 100 100 genSpecialSelectorComparison isMapped JumpLessOrEqual)
  		(1 101 101 genSpecialSelectorComparison isMapped JumpGreaterOrEqual)
  		(1 102 102 genSpecialSelectorComparison isMapped JumpZero)
  		(1 103 103 genSpecialSelectorComparison isMapped JumpNonZero)
  		(1 104 109 genSpecialSelectorSend isMapped)	 " #* #/ #\\ #@ #bitShift: //"
  		(1 110 110 genSpecialSelectorArithmetic isMapped AndRR)
  		(1 111 111 genSpecialSelectorArithmetic isMapped OrRR)
  		(1 112 117 genSpecialSelectorSend isMapped) "#at: #at:put: #size #next #nextPut: #atEnd"
  		(1 118 118 genSpecialSelectorEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)"
  		(1 119 119 genSpecialSelectorClass needsFrameIfStackGreaterThanOne: notMapped 0) "not mapped because it is directly inlined (for now)"
  		(1 120 127 genSpecialSelectorSend isMapped) "#blockCopy: #value #value: #do: #new #new: #x #y"
  
  		(1 128 143 genSendLiteralSelector0ArgsBytecode isMapped)
  		(1 144 159 genSendLiteralSelector1ArgBytecode isMapped)
  		(1 160 175 genSendLiteralSelector2ArgsBytecode isMapped)
  
  		"jumps"
  		(1 176 183 genShortUnconditionalJump	branch v3:ShortForward:Branch:Distance:)
  		(1 184 191 genShortJumpIfTrue			branch isBranchTrue isMapped "because of mustBeBoolean"
  													v3:ShortForward:Branch:Distance:)
  		(1 192 199 genShortJumpIfFalse			branch isBranchFalse isMapped "because of mustBeBoolean"
  													v3:ShortForward:Branch:Distance:)
  
  		"stores"
  		(1 200 207 genStoreAndPopReceiverVariableBytecode needsFrameNever: -1) "N.B. not frameless if immutability"
  		(1 208 215 genStoreAndPopTemporaryVariableBytecode)
  
  		(1 216 216 genPopStackBytecode needsFrameNever: -1)
  
  		(1 217 223 unknownBytecode)
  
  		"2 byte bytecodes"
  		(2 224 224 extABytecode extension)
  		(2 225 225 extBBytecode extension)
  
  		"pushes"
  		(2 226 226 genExtPushReceiverVariableBytecode		needsFrameNever: 1)
  		(2 227 227 genExtPushLiteralVariableBytecode		needsFrameNever: 1)
  		(2 228 228 genExtPushLiteralBytecode					needsFrameNever: 1)
  		(2 229 229 genLongPushTemporaryVariableBytecode)
  		(2 230 230 genPushClosureTempsBytecode)
  		(2 231 231 genPushNewArrayBytecode)
  		(2 232 232 genExtPushIntegerBytecode				needsFrameNever: 1)
  		(2 233 233 genExtPushCharacterBytecode				needsFrameNever: 1)
  
  		"returns"
  		"sends"
  		(2 234 234 genExtSendBytecode isMapped)
  		(2 235 235 genExtSendSuperBytecode isMapped)
  
  		"sista bytecodes"
  		(2 236 236 genExtTrapIfNotInstanceOfBehaviorsBytecode isMapped)
  
  		"jumps"
  		(2 237 237 genExtUnconditionalJump	branch isMapped "because of interrupt check" v4:Long:Branch:Distance:)
  		(2 238 238 genExtJumpIfTrue			branch isBranchTrue isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
  		(2 239 239 genExtJumpIfFalse			branch isBranchFalse isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
  
  		"stores"
  		(2 240 240 genExtStoreAndPopReceiverVariableBytecode)
  		(2 241 241 genExtStoreAndPopLiteralVariableBytecode)
  		(2 242 242 genLongStoreAndPopTemporaryVariableBytecode)
  		(2 243 243 genExtStoreReceiverVariableBytecode)
  		(2 244 244 genExtStoreLiteralVariableBytecode)
  		(2 245 245 genLongStoreTemporaryVariableBytecode)
  
  		(2 246 247	unknownBytecode)
  
  		"3 byte bytecodes"
+ 		(3 248 248 genCallPrimitiveBytecode)
- 		(3 248 248 callPrimitiveBytecode)
  		(3 249 249 unknownBytecode) "reserved for Push Float"
  		(3 250 250 genExtPushClosureBytecode block v4:Block:Code:Size:)
  		(3 251 251 genPushRemoteTempLongBytecode)
  		(3 252 252 genStoreRemoteTempLongBytecode)
  		(3 253 253 genStoreAndPopRemoteTempLongBytecode)
  
  		(3 254 255	unknownBytecode))!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>sistaV1PushNilSize: (in category 'span functions') -----
+ sistaV1PushNilSize: aMethodObj
+ 	"230		11100110	iiiiiiii		PushNClosureTemps iiiiiiii"
+ 	<inline: true>
+ 	^2!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>squeakV3orSistaV1PushNilSize: (in category 'span functions') -----
+ squeakV3orSistaV1PushNilSize: aMethodObj
+ 	^(coInterpreter methodUsesAlternateBytecodeSet: aMethodObj)
+ 		ifTrue: [self sistaV1PushNilSize: aMethodObj]
+ 		ifFalse: [self v3PushNilSize: aMethodObj]!

Item was added:
+ ----- Method: VMClass>>alloca:type: (in category 'C library extensions') -----
+ alloca: numElements type: elementType
+ 	<cmacro: '(numElements, elementType) alloca((numElements)*sizeof(elementType))'>
+ 	^CArrayAccessor on: ((1 to: numElements) collect: [:ign| elementType new])!



More information about the Vm-dev mailing list