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

commits at source.squeak.org commits at source.squeak.org
Sun Dec 11 02:34:01 UTC 2016


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

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

Name: VMMaker.oscog-eem.2034
Author: eem
Time: 10 December 2016, 6:33:12.743145 pm
UUID: ff192a4b-8ebc-4734-9e4e-cdc301d6c9e0
Ancestors: VMMaker.oscog-eem.2033

Fix some assert fails, in particular ones arising in StackToRegisterMappingCogit from first-pass compiling of V3Closures blocks with initial temp := nil statements (which are ambiguous with the alas explicit push nils to init temps).  This because Cadence regression tests are run on assert VMs and hence we can't tolerate false positives.

More debugging for stack imbalance on callback return; remember the stack pointer on return from a callback.

In the simulator, handle dialog cancel as end-of-file.

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

Item was changed:
  ----- Method: FakeStdinStream>>next (in category 'accessing') -----
  next
  	"Answer the next object in the Stream represented by the receiver.
  	 If there are no more elements in the stream fill up the buffer by prompting for input"
  	| sem threadIndex inputLine next |
  	position >= readLimit ifTrue:
  		[simulator isThreadedVM
  			ifTrue:
  				["(simulator cogit singleStep not
  				  and: [UIManager confirm: 'Single step?']) ifTrue:
  					[simulator cogit singleStep: true]."
  				 threadIndex := simulator disownVM: DisownVMLockOutFullGC.
  				 simulator forceInterruptCheckFromHeartbeat.
  				 sem := Semaphore new.
  				 WorldState addDeferredUIMessage:
  					[inputLine := UIManager default request: 'Input please!!'.
  					 sem signal].
  				 sem wait]
  			ifFalse: "simulate line-oriented input"
  				[inputLine := FillInTheBlankMorph
  								request: 'Input please!!'
  								initialAnswer: ''
  								centerAt: ActiveHand cursorPoint
  								inWorld: ActiveWorld
  								onCancelReturn: nil 
  								acceptOnCR: true.
+ 				inputLine ifNil: [self atEnd: true. ^nil]].
- 				inputLine ifNil: [self halt]].
  		 collection size <= inputLine size ifTrue:
  			[collection := collection species new: inputLine size + 1].
  		 collection
  			replaceFrom: 1 to: inputLine size with: inputLine startingAt: 1;
  		 	at: (readLimit := inputLine size + 1) put: Character lf.
  		 position := 0.
  		 simulator isThreadedVM ifTrue:
  			[simulator ownVM: threadIndex]].
  	next := collection at: (position := position + 1).
  	"This is set temporarily to allow (FilePluginSimulator>>#sqFile:Read:Into:At:
  	 to brwak out of its loop.  sqFile:Read:Into:At: resets it on the way out."
  	atEnd := position >= readLimit.
  	^next
  	
  
  " This does it with workspaces:
  | ws r s |
  s := Semaphore new.
  ws := Workspace new contents: ''.
  ws acceptAction: [:t| r := t asString. s signal].
  [ws openLabel: 'Yo!!'; shouldStyle: false.
  (ws dependents detect: [:dep | dep isKindOf: PluggableTextMorph] ifNone: [nil]) ifNotNil:
  	[:textMorph| textMorph acceptOnCR: true; hasUnacceptedEdits: true]] fork.
  Processor activeProcess ==  Project uiProcess
  	ifTrue: [[r isNil] whileTrue: [World doOneCycle]]
  	ifFalse: [s wait].
  ws topView delete.
  s wait. s signal.
  r"!

Item was changed:
  ----- Method: FilePluginSimulator>>sqFile:Read:Into:At: (in category 'simulation') -----
  sqFile: file Read: count Into: byteArrayIndexArg At: startIndex
  	| interpreter byteArrayIndex |
  	interpreter := interpreterProxy interpreter.
  	byteArrayIndex := byteArrayIndexArg isInteger ifTrue: [byteArrayIndexArg] ifFalse: [byteArrayIndexArg cPtrAsOop].
  	[[startIndex to: startIndex + count - 1 do:
  		[ :i |
  		file atEnd ifTrue:
  			[(file isKindOf: FakeStdinStream) ifTrue: [file atEnd: false].
  			 ^i - startIndex].
  		interpreter
  			byteAt: byteArrayIndex + i
+ 			put: (file next ifNil: [(file isKindOf: FakeStdinStream) ifTrue: [^0]] ifNotNil: [:c| c asInteger])]]
- 			put: file next asInteger]]
  			on: Error
  			do: [:ex|
  				(file isKindOf: TranscriptStream) ifFalse: [ex pass].
  				^0]]
  		ensure: [self recordStateOf: file].
  	^count!

Item was changed:
  ----- Method: InterpreterPrimitives>>noInlineSigned32BitValueGutsOf: (in category 'primitive support') -----
  noInlineSigned32BitValueGutsOf: oop
  	"Convert the given object into an integer value.
  	The object may be a four-byte LargeInteger."
  	| value negative ok magnitude |
  	<notOption: #Spur64BitMemoryManager>
  	<inline: false>
  	<returnTypeC: #int>
  	<var: #value type: #int>
  	<var: #magnitude type: #'unsigned int'>
  	self deny: objectMemory hasSixtyFourBitImmediates.
+ 	self deny: (objectMemory isIntegerObject: oop).
- 	self deny: (objectMemory isIntegerValue: oop).
  
  	(objectMemory isNonIntegerImmediate: oop) ifTrue:
  		[self primitiveFail.
  		 ^0].
  
  	ok := objectMemory
  			isClassOfNonImm: oop
  			equalTo: (objectMemory splObj: ClassLargePositiveInteger)
  			compactClassIndex: ClassLargePositiveIntegerCompactIndex.
  	ok
  		ifTrue: [negative := false]
  		ifFalse:
  			[negative := true.
  			 ok := objectMemory isClassOfNonImm: oop
  							equalTo: (objectMemory splObj: ClassLargeNegativeInteger)
  							compactClassIndex: ClassLargeNegativeIntegerCompactIndex.
  			 ok ifFalse:
  				[self primitiveFail.
  				 ^0]].
  	(objectMemory numBytesOfBytes: oop) > 4 ifTrue:
  		[^self primitiveFail].
  
  	magnitude := self cCoerceSimple: (objectMemory byteSwapped32IfBigEndian: (objectMemory fetchLong32: 0 ofObject: oop)) to: #'unsigned int'.
  
  	(negative
  		ifTrue: [magnitude > 16r80000000]
  		ifFalse: [magnitude >= 16r80000000])
  			ifTrue:
  				[self primitiveFail.
  				^0].
  	negative
  		ifTrue: [value := 0 - magnitude]
  		ifFalse: [value := magnitude].
  	^value!

Item was changed:
  InterpreterPrimitives subclass: #StackInterpreter
+ 	instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue localAbsentReceiver localAbsentReceiverOrZero extA extB primitiveFunctionPointer methodCache nsMethodCache atCache lkupClassTag lkupClass methodDictLinearSearchLimit highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptKeycode interruptPending savedWindowSize imageHeaderFlags fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory interpreterProxy showSurfaceFn primitiveTable primitiveAccessorDepthTable externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassNumSlots interruptCheckChain suppressHeartbeatFlag breakSelector breakSelectorLength l
 ongRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered checkAllocFiller tempOop tempOop2 tempOop3 theUnknownShort the2ndUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite gcSemaphoreIndex classByteArrayCompactIndex checkedPluginName statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents statPendingFinalizationSignals nativeSP nativeStackPointer lowcodeCalloutState shadowCallStackPointer debugCallbackPath callbackReturnSP'
- 	instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue localAbsentReceiver localAbsentReceiverOrZero extA extB primitiveFunctionPointer methodCache nsMethodCache atCache lkupClassTag lkupClass methodDictLinearSearchLimit highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptKeycode interruptPending savedWindowSize imageHeaderFlags fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory interpreterProxy showSurfaceFn primitiveTable primitiveAccessorDepthTable externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassNumSlots interruptCheckChain suppressHeartbeatFlag breakSelector breakSelectorLength l
 ongRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered checkAllocFiller tempOop tempOop2 tempOop3 theUnknownShort the2ndUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite gcSemaphoreIndex classByteArrayCompactIndex checkedPluginName statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents statPendingFinalizationSignals nativeSP nativeStackPointer lowcodeCalloutState shadowCallStackPointer debugCallbackPath'
  	classVariableNames: 'AccessModifierPrivate AccessModifierProtected AccessModifierPublic AltBytecodeEncoderClassName AltLongStoreBytecode AlternateHeaderHasPrimFlag AlternateHeaderIsOptimizedFlag AlternateHeaderNumLiteralsMask AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BytecodeEncoderClassName BytecodeTable CacheProbeMax DirBadPath DirEntryFound DirNoMoreEntries DumpStackOnLowSpace EnclosingMixinIndex EnclosingObjectIndex EnforceAccessControl FailImbalancedPrimitives LongStoreBytecode MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MaxQuickPrimitiveIndex MethodHeaderArgCountShift MethodHeaderFlagBitPosition MethodHeaderTempCountShift MixinIndex PrimNumberDoExternalCall PrimNumberExternalCall PrimNumberFFICall PrimitiveExternalCallIndex PrimitiveTable StackPageReachedButUntraced StackPageTraceInvalid StackPageTraced StackPageUnreached V3PrimitiveBitsMask'
  	poolDictionaries: 'VMBasicConstants VMBytecodeConstants VMMethodCacheConstants VMObjectIndices VMSpurObjectRepresentationConstants VMSqueakClassIndices VMStackFrameOffsets'
  	category: 'VMMaker-Interpreter'!
  
  !StackInterpreter commentStamp: 'eem 12/5/2014 11:32' prior: 0!
  This class is a complete implementation of the Smalltalk-80 virtual machine, derived originally from the Blue Book specification but quite different in some areas.  This VM supports Closures but *not* old-style BlockContexts.
  
  It has been modernized with 32-bit pointers, better management of Contexts (see next item), and attention to variable use that allows the CCodeGenerator (qv) to keep, eg, the instruction pointer and stack pointer in registers as well as keeping most simple variables in a global array that seems to improve performance for most platforms.
  
  The VM does not use Contexts directly.  Instead Contexts serve as proxies for a more conventional stack format that is invisible to the image.  There is considerable explanation at http://www.mirandabanda.org/cogblog/2009/01/14/under-cover-contexts-and-the-big-frame-up.  The VM maintains a fixed-size stack zone divided into pages, each page being capable of holding several method/block activations.  A send establishes a new frame in the current stack page, a return returns to the previous frame.  This eliminates allocation/deallocation of contexts and the moving of receiver and arguments from caller to callee on each send/return.  Contexts are created lazily when an activation needs a context (creating a block, explicit use of thisContext, access to sender when sender is a frame, or linking of stack pages together).  Contexts are either conventional and heap-resident ("single") or "married" and serve as proxies for their corresponding frame or "widowed", meaning that their spouse f
 rame has been returned from (died).  A married context is specially marked (more details in the code) and refers to its frame.  Likewise a married frame is specially marked and refers to its context.
  
  In addition to SmallInteger arithmetic and Floats, the VM supports logic on 32-bit PositiveLargeIntegers, thus allowing it to simulate itself much more effectively than would otherwise be the case.
  
  StackInterpreter and subclasses support multiple memory managers.  Currently there are two.  NewMemoryManager is a slightly refined version of ObjectMemory, and is the memory manager and garbage collector for the original Squeak object representation as described in "Back to the Future The Story of Squeak, A Practical Smalltalk Written in Itself", see http://ftp.squeak.org/docs/OOPSLA.Squeak.html.  Spur is a faster, more regular object representation that is designed for more performance and functionality, and to have a common header format for both 32-bit and 64-bit versions.  You can read about it in SpurMemoryManager's class comment.  There is also a video of a presentation at ESUG 2014 (https://www.youtube.com/watch?v=k0nBNS1aHZ4), along with slides (http://www.slideshare.net/esug/spur-a-new-object-representation-for-cog?related=1).!

Item was changed:
  ----- Method: StackInterpreter class>>mustBeGlobal: (in category 'translation') -----
  mustBeGlobal: var
  	"Answer if a variable must be global and exported.  Used for inst vars that are accessed from VM support code."
  
  	^(super mustBeGlobal: var)
  	   or: [(self objectMemoryClass mustBeGlobal: var)
  	   or: [(#('interpreterProxy' 'interpreterVersion' 'inIOProcessEvents'
  			'deferDisplayUpdates' 'extraVMMemory' 'showSurfaceFn'
  			'desiredNumStackPages' 'desiredEdenBytes'
  			'breakSelector' 'breakSelectorLength' 'sendTrace' 'checkAllocFiller' 'checkedPluginName'
+ 			'suppressHeartbeatFlag' 'debugCallbackPath' 'callbackReturnSP') includes: var)
- 			'suppressHeartbeatFlag' 'debugCallbackPath') includes: var)
  	   or: [ "This allows slow machines to define bytecodeSetSelector as 0
  			to avoid the interpretation overhead."
  			MULTIPLEBYTECODESETS not and: [var = 'bytecodeSetSelector']]]]!

Item was added:
+ ----- Method: StackInterpreter>>frameLastArgumentOffset (in category 'frame access') -----
+ frameLastArgumentOffset
+ 	"Answer the offset in bytes from the frame pointer to the last argument,
+ 	 which is simply the address of the word above the saved ip.  See the
+ 	 diagram in StackInterpreter class>>initializeFrameIndices."
+ 	<inline: true>
+ 	^FoxCallerSavedIP + objectMemory wordSize!

Item was changed:
  ----- Method: StackInterpreter>>returnAs:ThroughCallback:Context: (in category 'callback support') -----
  returnAs: returnTypeOop ThroughCallback: vmCallbackContext Context: callbackMethodContext
  	"callbackMethodContext is an activation of invokeCallback:[stack:registers:jmpbuf:].
  	 Its sender is the VM's state prior to the callback.  Reestablish that state (via longjmp),
  	 and mark callbackMethodContext as dead."
  	<export: true>
  	<var: #vmCallbackContext type: #'VMCallbackContext *'>
  	| calloutMethodContext theFP thePage |
  	<var: #theFP type: #'char *'>
  	<var: #thePage type: #'StackPage *'>
  	debugCallbackPath := 0.
  	((self isIntegerObject: returnTypeOop)
  	 and: [self isLiveContext: callbackMethodContext]) ifFalse:
  		[debugCallbackPath := 1.
  		 ^false].
  	calloutMethodContext := self externalInstVar: SenderIndex ofContext: callbackMethodContext.
  	(self isLiveContext: calloutMethodContext) ifFalse:
  		[debugCallbackPath := 2.
  		 ^false].
  	debugCallbackPath := 4.
  	"We're about to leave this stack page; must save the current frame's instructionPointer."
  	self push: instructionPointer.
  	self externalWriteBackHeadFramePointers.
  	"Mark callbackMethodContext as dead; the common case is that it is the current frame.
  	 We go the extra mile for the debugger."
  	(self isSingleContext: callbackMethodContext)
  		ifTrue: [self markContextAsDead: callbackMethodContext. debugCallbackPath := debugCallbackPath bitOr: 8]
  		ifFalse:
  			[debugCallbackPath := debugCallbackPath bitOr: 16.
  			 theFP := self frameOfMarriedContext: callbackMethodContext.
  			 framePointer = theFP "common case"
  				ifTrue:
  					[debugCallbackPath := debugCallbackPath bitOr: 32.
  					 (self isBaseFrame: theFP)
  						ifTrue: [stackPages freeStackPage: stackPage. debugCallbackPath := debugCallbackPath bitOr: 64]
  						ifFalse: "calloutMethodContext is immediately below on the same page.  Make it current."
  							[debugCallbackPath := debugCallbackPath bitOr: 128.
  							 instructionPointer := (self frameCallerSavedIP: framePointer) asUnsignedInteger.
  							 stackPointer := framePointer + (self frameStackedReceiverOffset: framePointer) + objectMemory wordSize.
  							 framePointer := self frameCallerFP: framePointer.
  							 self setMethod: (self frameMethodObject: framePointer).
  							 self restoreCStackStateForCallbackContext: vmCallbackContext.
+ 							 callbackReturnSP := stackPointer.
  							 "N.B. siglongjmp is defines as _longjmp on non-win32 platforms.
  							  This matches the use of _setjmp in ia32abicc.c."
  							 self siglong: vmCallbackContext trampoline jmp: (self integerValueOf: returnTypeOop).
  							 ^true]]
  				ifFalse:
  					[debugCallbackPath := debugCallbackPath bitOr: 256.
  					 self externalDivorceFrame: theFP andContext: callbackMethodContext.
  					 self markContextAsDead: callbackMethodContext]].
  	"Make the calloutMethodContext the active frame.  The case where calloutMethodContext
  	 is immediately below callbackMethodContext on the same page is handled above."
  	(self isStillMarriedContext: calloutMethodContext)
  		ifTrue:
  			[debugCallbackPath := debugCallbackPath bitOr: 512.
  			 theFP := self frameOfMarriedContext: calloutMethodContext.
  			 thePage := stackPages stackPageFor: theFP.
  			 "findSPOf:on: points to the word beneath the instructionPointer, but
  			  there is no instructionPointer on the top frame of the current page."
  			 self assert: thePage ~= stackPage.
  			 stackPointer := (self findSPOf: theFP on: thePage) - objectMemory wordSize.
  			 framePointer := theFP]
  		ifFalse:
  			[debugCallbackPath := debugCallbackPath bitOr: 1024.
  			 thePage := self makeBaseFrameFor: calloutMethodContext.
  			 framePointer := thePage headFP.
  			 stackPointer := thePage headSP].
  	instructionPointer := self popStack.
  	self setMethod: (objectMemory fetchPointer: MethodIndex ofObject: calloutMethodContext).
  	self setStackPageAndLimit: thePage.
  	self restoreCStackStateForCallbackContext: vmCallbackContext.
  	debugCallbackPath := debugCallbackPath bitOr: 2048.
+ 	callbackReturnSP := stackPointer.
  	 "N.B. siglongjmp is defines as _longjmp on non-win32 platforms.
  	  This matches the use of _setjmp in ia32abicc.c."
  	self siglong: vmCallbackContext trampoline jmp: (self integerValueOf: returnTypeOop).
  	"NOTREACHED"
  	^true!

Item was changed:
  SimpleStackBasedCogit subclass: #StackToRegisterMappingCogit
+ 	instanceVariableNames: 'prevBCDescriptor numPushNilsFunction pushNilSizeFunction methodOrBlockNumTemps regArgsHaveBeenPushed simSelf simStack simStackPtr simSpillBase optStatus ceCallCogCodePopReceiverArg0Regs ceCallCogCodePopReceiverArg1Arg0Regs methodAbortTrampolines picAbortTrampolines picMissTrampolines ceCall0ArgsPIC ceCall1ArgsPIC ceCall2ArgsPIC debugStackPointers debugFixupBreaks realCECallCogCodePopReceiverArg0Regs realCECallCogCodePopReceiverArg1Arg0Regs deadCode useTwoPaths currentCallCleanUpSize simNativeStack simNativeStackPtr simNativeSpillBase simNativeStackSize hasNativeFrame blockPass'
- 	instanceVariableNames: 'prevBCDescriptor numPushNilsFunction pushNilSizeFunction methodOrBlockNumTemps regArgsHaveBeenPushed simSelf simStack simStackPtr simSpillBase optStatus ceCallCogCodePopReceiverArg0Regs ceCallCogCodePopReceiverArg1Arg0Regs methodAbortTrampolines picAbortTrampolines picMissTrampolines ceCall0ArgsPIC ceCall1ArgsPIC ceCall2ArgsPIC debugStackPointers debugFixupBreaks realCECallCogCodePopReceiverArg0Regs realCECallCogCodePopReceiverArg1Arg0Regs deadCode useTwoPaths currentCallCleanUpSize simNativeStack simNativeStackPtr simNativeSpillBase simNativeStackSize hasNativeFrame'
  	classVariableNames: 'NeedsMergeFixupFlag NeedsNonMergeFixupFlag'
  	poolDictionaries: 'CogCompilationConstants VMMethodCacheConstants VMObjectIndices VMStackFrameOffsets'
  	category: 'VMMaker-JIT'!
  StackToRegisterMappingCogit class
  	instanceVariableNames: 'numPushNilsFunction pushNilSizeFunction'!
  
  !StackToRegisterMappingCogit commentStamp: 'eem 6/1/2016 14:50' prior: 0!
  StackToRegisterMappingCogit is an optimizing code generator that eliminates a lot of stack operations and inlines some special selector arithmetic.  It does so by a simple stack-to-register mapping scheme based on deferring the generation of code to produce operands until operand-consuming operations.  The operations that consume operands are sends, stores and returns.
  
  See methods in the class-side documentation protocol for more detail.
  
  Instance Variables
  	callerSavedRegMask:							<Integer>
  	ceEnter0ArgsPIC:								<Integer>
  	ceEnter1ArgsPIC:								<Integer>
  	ceEnter2ArgsPIC:								<Integer>
  	ceEnterCogCodePopReceiverArg0Regs:		<Integer>
  	ceEnterCogCodePopReceiverArg1Arg0Regs:	<Integer>
  	debugBytecodePointers:						<Set of Integer>
  	debugFixupBreaks:								<Set of Integer>
  	debugStackPointers:							<CArrayAccessor of (Integer|nil)>
  	methodAbortTrampolines:						<CArrayAccessor of Integer>
  	methodOrBlockNumTemps:						<Integer>
  	optStatus:										<Integer>
  	picAbortTrampolines:							<CArrayAccessor of Integer>
  	picMissTrampolines:							<CArrayAccessor of Integer>
  	realCEEnterCogCodePopReceiverArg0Regs:		<Integer>
  	realCEEnterCogCodePopReceiverArg1Arg0Regs:	<Integer>
  	regArgsHaveBeenPushed:						<Boolean>
  	simSelf:											<CogSimStackEntry>
  	simSpillBase:									<Integer>
  	simStack:										<CArrayAccessor of CogSimStackEntry>
  	simStackPtr:									<Integer>
  	traceSimStack:									<Integer>
  	useTwoPaths									<Boolean>
  
  callerSavedRegMask
  	- the bitmask of the ABI's caller-saved registers
  
  ceEnter0ArgsPIC ceEnter1ArgsPIC ceEnter2ArgsPIC
  	- the trampoline for entering an N-arg PIC
  
  ceEnterCogCodePopReceiverArg0Regs ceEnterCogCodePopReceiverArg1Arg0Regs
  	- teh trampoline for entering a method with N register args
  	
  debugBytecodePointers
  	- a Set of bytecode pcs for setting breakpoints (simulation only)
  
  debugFixupBreaks
  	- a Set of fixup indices for setting breakpoints (simulation only)
  
  debugStackPointers
  	- an Array of stack depths for each bytecode for code verification
  
  methodAbortTrampolines
  	- a CArrayAccessor of abort trampolines for 0, 1, 2 and N args
  
  methodOrBlockNumTemps
  	- the number of method or block temps (including args) in the current compilation unit (method or block)
  
  optStatus
  	- the variable used to track the status of ReceiverResultReg for avoiding reloading that register with self between adjacent inst var accesses
  
  picAbortTrampolines
  	- a CArrayAccessor of abort trampolines for 0, 1, 2 and N args
  
  picMissTrampolines
  	- a CArrayAccessor of abort trampolines for 0, 1, 2 and N args
  
  realCEEnterCogCodePopReceiverArg0Regs realCEEnterCogCodePopReceiverArg1Arg0Regs
  	- the real trampolines for ebtering machine code with N reg args when in the Debug regime
  
  regArgsHaveBeenPushed
  	- whether the register args have been pushed before frame build (e.g. when an interpreter primitive is called)
  
  simSelf
  	- the simulation stack entry representing self in the current compilation unit
  
  simSpillBase
  	- the variable tracking how much of the simulation stack has been spilled to the real stack
  
  simStack
  	- the simulation stack itself
  
  simStackPtr
  	- the pointer to the top of the simulation stack
  
  useTwoPaths
  	- a variable controlling whether to create two paths through a method based on the existence of inst var stores.  With immutability this causes a frameless path to be generated if an otherwise frameless method is frameful simply because of inst var stores.  In this case the test to take the first frameless path is if the receiver is not immutable.  Without immutability, if a frameless method contains two or more inst var stores, the first path will be code with no store check, chosen by a single check for the receiver being in new space.
  !
  StackToRegisterMappingCogit class
  	instanceVariableNames: 'numPushNilsFunction pushNilSizeFunction'!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>compileBlockBodies (in category 'compile abstract instructions') -----
  compileBlockBodies
  	<inline: false>
  	| result compiledBlocksCount blockStart savedNeedsFrame savedNumArgs savedNumTemps
  	  initialStackPtr initialOpcodeIndex initialIndexOfIRC initialCounterIndex |
  	<var: #blockStart type: #'BlockStart *'>
  	self assert: blockCount > 0.
  	"scanBlock: in compileBlockEntry: sets both of these appropriately for each block."
  	savedNeedsFrame := needsFrame.
  	savedNumArgs := methodOrBlockNumArgs.
  	savedNumTemps := methodOrBlockNumTemps.
  	inBlock := InVanillaBlock.
  	compiledBlocksCount := 0.
  	[compiledBlocksCount < blockCount] whileTrue:
+ 		[blockPass := 1.
+ 		 blockStart := self blockStartAt: compiledBlocksCount.
- 		[blockStart := self blockStartAt: compiledBlocksCount.
  		 (result := self scanBlock: blockStart) < 0 ifTrue: [^result].
  		 initialOpcodeIndex := opcodeIndex.
  		 initialCounterIndex := self maybeCounterIndex."for SistaCogit"
  		 literalsManager saveForBlockCompile.
  		 NewspeakVM ifTrue:
  			[initialIndexOfIRC := indexOfIRC].
  		 [self compileBlockEntry: blockStart.
  		  initialStackPtr := simStackPtr.
  		  (result := self compileAbstractInstructionsFrom: blockStart startpc + (self pushNilSize: methodObj numInitialNils: blockStart numInitialNils)
  						through: blockStart startpc + blockStart span - 1) < 0 ifTrue:
  			[^result].
  		  "If the final simStackPtr is less than the initial simStackPtr then scanBlock: over-
  		   estimated the number of initial nils (because it assumed one or more pushNils to
  		   produce an operand were pushNils to initialize temps.  This is very rare, so
  		   compensate by checking, adjusting numInitialNils and recompiling the block body.
  		   N.B.  No need to reinitialize the literalsManager because it answers existing literals."
  		  initialStackPtr = simStackPtr]
  			whileFalse:
  				[self assert: initialStackPtr > simStackPtr.
+ 				 blockPass := blockPass + 1. "for asserts :-("
  				 blockStart numInitialNils: blockStart numInitialNils + simStackPtr - initialStackPtr.
  				 blockStart fakeHeader dependent: nil.
  				 self reinitializeFixupsFrom: blockStart startpc + blockStart numInitialNils
  					through: blockStart startpc + blockStart span - 1.
  				 self cCode: 'bzero(abstractOpcodes + initialOpcodeIndex,
  									(opcodeIndex - initialOpcodeIndex) * sizeof(AbstractInstruction))'
  					inSmalltalk: [initialOpcodeIndex to: opcodeIndex - 1 do:
  									[:i| abstractOpcodes at: i put: (CogCompilerClass for: self)]].
  				 opcodeIndex := initialOpcodeIndex.
  				 self maybeSetCounterIndex: initialCounterIndex. "For SistaCogit"
  				 literalsManager resetForBlockCompile.
  				 NewspeakVM ifTrue:
  					[indexOfIRC := initialIndexOfIRC]].
  		compiledBlocksCount := compiledBlocksCount + 1].
  	needsFrame := savedNeedsFrame.
  	methodOrBlockNumArgs := savedNumArgs.
  	methodOrBlockNumTemps := savedNumTemps.
  	^0!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>maybeCompilingFirstPassOfBlockWithInitialPushNil (in category 'debugging') -----
+ maybeCompilingFirstPassOfBlockWithInitialPushNil
+ 	"For assert checking; or rather for avoiding assert fails when dealing with the hack for block temps in the SqueakV3PlusClosures bytecode set."
+ 	^inBlock = InVanillaBlock and: [methodOrBlockNumTemps > methodOrBlockNumArgs and: [blockPass = 1]]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>ssFlushTo:nativeFlushTo: (in category 'simulation stack') -----
  ssFlushTo: index nativeFlushTo: nativeIndex
  	LowcodeVM ifTrue:
  		[self ssNativeFlushTo: nativeIndex].
  	0 to: methodOrBlockNumTemps - 1 do:
+ 		[:i| self assert: ((self simStackAt: i) type = SSBaseOffset
+ 						or: [self maybeCompilingFirstPassOfBlockWithInitialPushNil])].
- 		[:i| self assert: (self simStackAt: i) type = SSBaseOffset].
  	methodOrBlockNumTemps to: simSpillBase - 1 do:
  		[:i| self assert: (self simStackAt: i) spilled].
  	simSpillBase <= index ifTrue:
  		[(simSpillBase max: methodOrBlockNumTemps) to: index do:
  			[:i|
  			self assert: needsFrame.
  			(self simStackAt: i)
  				ensureSpilledAt: (self frameOffsetOfTemporary: i)
  				from: FPReg].
  		 simSpillBase := index + 1]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>ssPop: (in category 'simulation stack') -----
  ssPop: n
  	self assert: (simStackPtr - n >= (methodOrBlockNumTemps - 1)
+ 				or: [(needsFrame not and: [simStackPtr - n >= -1])
+ 				or: [self maybeCompilingFirstPassOfBlockWithInitialPushNil]]).
- 				or: [needsFrame not and: [simStackPtr - n >= -1]]).
  	simStackPtr := simStackPtr - n!



More information about the Vm-dev mailing list