VM Maker: VMMaker.oscog-eem.1596.mcz

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

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

Name: VMMaker.oscog-eem.1596
Author: eem
Time: 15 December 2015, 10:53:18.704 am
UUID: b5172901-ebc3-4132-b421-446d4a1d080f
Ancestors: VMMaker.oscog-rmacnak.1595

64 vs 32 bits.  Clarify translation of signedInt[From|To]Long[64].  signedInt[From|To]Long always operates on 32-bits and signedInt[From|To]Long64 always operates on 64-bits; there is no signedInt[From|To]MachineInteger.

Refactor casting -1 as a stack limit into allOnesAsCharStar.

Cogit: Fix regression in x86's register save/restore.
Nuke uses of thirtyTwoBitLiteralBefore: in favour of preexisting literal32BeforeFollowingAddress:.

Slang:
Make sure functional methods that answer char * (allOnesAsCharStar) can be inlined.
Plugins:
Fix the Alien plugins for 64-bits

=============== Diff against VMMaker.oscog-rmacnak.1595 ===============

Item was added:
+ ----- Method: CCodeGenerator>>generateSignedIntFromLong64:on:indent: (in category 'C translation') -----
+ generateSignedIntFromLong64: msgNode on: aStream indent: level
+ "Generate the C code for this message onto the given stream."
+
+ aStream nextPutAll: '((sqLong) '.
+ self emitCExpression: msgNode receiver on: aStream.
+ aStream nextPut: $)!

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

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

Item was added:
+ ----- Method: CCodeGenerator>>generateSignedIntToLong64:on:indent: (in category 'C translation') -----
+ generateSignedIntToLong64: msgNode on: aStream indent: level
+ "Generate the C code for this message onto the given stream."
+
+ aStream nextPutAll: '((usqInt) '.
+ self emitCExpression: msgNode receiver on: aStream.
+ aStream nextPut: $)!

Item was changed:
  ----- Method: CCodeGenerator>>generateSignedIntToLong:on:indent: (in category 'C translation') -----
  generateSignedIntToLong: msgNode on: aStream indent: level
  "Generate the C code for this message onto the given stream."
 
  aStream nextPutAll: '((usqInt) '.
+ vmClass objectMemoryClass wordSize = 8 ifTrue:
+ [aStream nextPutAll: '(int)'].
  self emitCExpression: msgNode receiver on: aStream.
+ aStream nextPut: $)!
- aStream nextPut: $)
-
- !

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

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

Item was changed:
  StackInterpreterPrimitives subclass: #CoInterpreter
  instanceVariableNames: 'cogit cogMethodZone gcMode cogCodeSize desiredCogCodeSize heapBase lastCoggableInterpretedBlockMethod reenterInterpreter deferSmash deferredSmash primTraceLog primTraceLogIndex traceLog traceLogIndex traceSources cogCompiledCodeCompactionCalledFor statCodeCompactionCount statCodeCompactionUsecs lastUncoggableInterpretedBlockMethod flagInterpretedMethods maxLiteralCountForCompile minBackwardJumpCountForCompile'
+ classVariableNames: 'CSCallbackEnter CSCallbackLeave CSCheckEvents CSEnterCriticalSection CSExitCriticalSection CSOwnVM CSResume CSSignal CSSuspend CSSwitchIfNeccessary CSThreadBind CSThreadSchedulingLoop CSWait CSYield HasBeenReturnedFromMCPC HasBeenReturnedFromMCPCOop MFMethodFlagFrameIsMarkedFlag MinBackwardJumpCountForCompile PrimTraceLogSize ReturnToInterpreter RumpCStackSize TraceBlockActivation TraceBlockCreation TraceBufferSize TraceCodeCompaction TraceContextSwitch TraceDisownVM TraceFullGC TraceIncrementalGC TraceIsFromInterpreter TraceIsFromMachineCode TraceOwnVM TracePreemptDisowningThread TracePrimitiveFailure TracePrimitiveRetry TraceSources TraceStackOverflow TraceThreadSwitch TraceVMCallback TraceVMCallbackReturn'
- classVariableNames: 'CSCallbackEnter CSCallbackLeave CSCheckEvents CSEnterCriticalSection CSExitCriticalSection CSOwnVM CSResume CSSignal CSSuspend CSSwitchIfNeccessary CSThreadBind CSThreadSchedulingLoop CSWait CSYield HasBeenReturnedFromMCPC MFMethodFlagFrameIsMarkedFlag MinBackwardJumpCountForCompile PrimTraceLogSize ReturnToInterpreter RumpCStackSize TraceBlockActivation TraceBlockCreation TraceBufferSize TraceCodeCompaction TraceContextSwitch TraceDisownVM TraceFullGC TraceIncrementalGC TraceIsFromInterpreter TraceIsFromMachineCode TraceOwnVM TracePreemptDisowningThread TracePrimitiveFailure TracePrimitiveRetry TraceSources TraceStackOverflow TraceThreadSwitch TraceVMCallback TraceVMCallbackReturn'
  poolDictionaries: 'CogMethodConstants VMStackFrameOffsets'
  category: 'VMMaker-JIT'!
 
  !CoInterpreter commentStamp: '<historical>' prior: 0!
  I am a variant of the StackInterpreter that can co-exist with the Cog JIT.  I interpret unjitted methods, either because they have been found for the first time or because they are judged to be too big to JIT.  See CogMethod class's comment for method interoperability.!

Item was changed:
  ----- Method: CoInterpreter class>>initializeContextIndices (in category 'initialization') -----
  initializeContextIndices
  super initializeContextIndices.
 
+ HasBeenReturnedFromMCPC := -1.
+ HasBeenReturnedFromMCPCOop := self objectMemoryClass basicNew integerObjectOf: HasBeenReturnedFromMCPC!
- HasBeenReturnedFromMCPC := self objectMemoryClass basicNew integerObjectOf: -1!

Item was changed:
  ----- Method: CoInterpreter>>ceBaseFrameReturn: (in category 'trampolines') -----
  ceBaseFrameReturn: returnValue
  "Return across a page boundary.  The context to return to (which may be married)
  is stored in the first word of the stack.  We get here when a return instruction jumps
  to the ceBaseFrameReturn: address that is the return pc for base frames.  A consequence
  of this is that the current frame is no longer valid since an interrupt may have overwritten
  its state as soon as the stack pointer has been cut-back beyond the return pc.  So to have
  a context to send the cannotReturn: message to we also store the base frame's context
  in the second word of the stack page."
  <api>
  | contextToReturnTo contextToReturnFrom isAContext thePage newPage frameAbove |
  <var: #thePage type: #'StackPage *'>
  <var: #newPage type: #'StackPage *'>
  <var: #frameAbove type: #'char *'>
  self assert: (stackPages stackPageFor: stackPointer) = stackPage.
  self assert: stackPages mostRecentlyUsedPage = stackPage.
  cogit assertCStackWellAligned.
  self assert: framePointer = 0.
  self assert: stackPointer <= (stackPage baseAddress - objectMemory wordSize).
  self assert: stackPage baseFP + (2 * objectMemory wordSize) < stackPage baseAddress.
  "We would like to use the following assert but we can't since the stack pointer will be above the
  base frame pointer in the base frame return and hence the 0 a base frame pointer points at could
  be overwritten which will cause the isBaseFrame assert in frameCallerContext: to fail."
  "self assert: (self frameCallerContext: stackPage baseFP) = (stackPages longAt: stackPage baseAddress)."
  self assert: ((objectMemory addressCouldBeObj: (stackPages longAt: stackPage baseAddress - objectMemory wordSize))
  and: [objectMemory isContext: (stackPages longAt: stackPage baseAddress - objectMemory wordSize)]).
- self assert: ((objectMemory addressCouldBeObj: (stackPages longAt: stackPage baseAddress))
- and: [objectMemory isContext: (stackPages longAt: stackPage baseAddress)]).
  contextToReturnTo := stackPages longAt: stackPage baseAddress.
+ self assert: (objectMemory addressCouldBeObj: contextToReturnTo).
 
  "The stack page is effectively free now, so free it.  We must free it to be
  correct in determining if contextToReturnTo is still married, and in case
  makeBaseFrameFor: cogs a method, which may cause a code compaction,
  in which case the frame must be free to avoid the relocation machinery
  tracing the dead frame.  Since freeing now temporarily violates the page-list
  ordering invariant, use the assert-free version."
  stackPages freeStackPageNoAssert: stackPage.
  isAContext := objectMemory isContext: contextToReturnTo.
  (isAContext
  and: [self isStillMarriedContext: contextToReturnTo])
  ifTrue:
  [framePointer := self frameOfMarriedContext: contextToReturnTo.
  thePage := stackPages stackPageFor: framePointer.
  framePointer = thePage headFP
  ifTrue:
  [stackPointer := thePage headSP]
  ifFalse:
  ["Returning to some interior frame, presumably because of a sender assignment.
   Move the frames above to another page (they may be in use, e.g. via coroutining).
   Make the interior frame the top frame."
  frameAbove := self findFrameAbove: framePointer inPage: thePage.
  "Since we've just deallocated a page we know that newStackPage won't deallocate an existing one."
  newPage := stackPages newStackPage.
  self assert: newPage = stackPage.
  self moveFramesIn: thePage through: frameAbove toPage: newPage.
  stackPages markStackPageMostRecentlyUsed: newPage.
  framePointer := thePage headFP.
  stackPointer := thePage headSP]]
  ifFalse:
  [(isAContext
   and: [objectMemory isIntegerObject: (objectMemory fetchPointer: InstructionPointerIndex ofObject: contextToReturnTo)]) ifFalse:
  [contextToReturnFrom := stackPages longAt: stackPage baseAddress - objectMemory wordSize.
  self tearDownAndRebuildFrameForCannotReturnBaseFrameReturnFrom: contextToReturnFrom
  to: contextToReturnTo
  returnValue: returnValue.
  ^self externalCannotReturn: returnValue from: contextToReturnFrom].
  "void the instructionPointer to stop it being incorrectly updated in a code
  compaction in makeBaseFrameFor:."
  instructionPointer := 0.
  thePage := self makeBaseFrameFor: contextToReturnTo.
  framePointer := thePage headFP.
  stackPointer := thePage headSP].
  self setStackPageAndLimit: thePage.
  self assert: (stackPages stackPageFor: framePointer) = stackPage.
  (self isMachineCodeFrame: framePointer) ifTrue:
  [self push: returnValue.
  cogit ceEnterCogCodePopReceiverReg.
  "NOTREACHED"].
  instructionPointer := self stackTop.
  instructionPointer = cogit ceReturnToInterpreterPC ifTrue:
  [instructionPointer := self iframeSavedIP: framePointer].
  self setMethod: (self iframeMethod: framePointer).
  self stackTopPut: returnValue. "a.k.a. pop saved ip then push result"
  self assert: (self checkIsStillMarriedContext: contextToReturnTo currentFP: framePointer).
  self siglong: reenterInterpreter jmp: ReturnToInterpreter.
  "NOTREACHED"
  ^nil!

Item was changed:
  ----- Method: CoInterpreter>>encodedNativePCOf:cogMethod: (in category 'frame access') -----
  encodedNativePCOf: mcpc cogMethod: cogMethod
  "Encode the mcpc in cogMethod as a value that can be stashed in a context.
  Mapping native pcs to bytecode pcs is quite expensive, requiring a search
  through the method map.  We mitigate this cost by deferring mapping until
  we really have to, which is when a context's instruction pointer is accessed
  by Smalltalk code.  But to defer mapping we have to be able to distinguish
  machine code from bytecode pcs, which we do by using negative values for
  machine code pcs.
 
  As a whorish performance hack we also include the block method offset in
  the pc of a block. The least significant 16 bits are the native pc and the most
  significant 15 bits are the block start, in block alignment units.  So when
  mapping back we can find the start of the block.
 
  See mustMapMachineCodePC:context: for the code that does the actual mapping."
  <var: #cogMethod type: #'CogBlockMethod *'>
  | homeMethod blockOffset |
  <var: #homeMethod type: #'CogMethod *'>
  mcpc = cogit ceCannotResumePC ifTrue:
+ [^HasBeenReturnedFromMCPCOop].
- [^HasBeenReturnedFromMCPC].
  cogMethod cmType = CMMethod ifTrue:
  [^objectMemory integerObjectOf: cogMethod asInteger - mcpc].
  homeMethod := cogMethod cmHomeMethod.
  blockOffset := homeMethod asInteger - cogMethod asInteger / cogit blockAlignment.
  ^objectMemory integerObjectOf: ((blockOffset bitShift: 16) bitOr: (cogMethod asInteger - mcpc bitAnd: 16rFFFF))!

Item was changed:
  ----- Method: CoInterpreter>>makeBaseFrameFor: (in category 'frame access') -----
  makeBaseFrameFor: aContext "<Integer>"
  "Marry aContext with the base frame of a new stack page.  Build the base
  frame to reflect the context's state.  Answer the new page.  Override to
  hold the caller context in a different place,  In the StackInterpreter we use
  the caller saved ip, but in the Cog VM caller saved ip is the ceBaseReturn:
  trampoline.  Simply hold the caller context in the first word of the stack."
  <returnTypeC: #'StackPage *'>
  | page pointer theMethod theIP numArgs stackPtrIndex maybeClosure rcvr |
  <inline: false>
  <var: #page type: #'StackPage *'>
  <var: #pointer type: #'char *'>
  <var: #cogMethod type: #'CogMethod *'>
  "theIP must be typed as signed because it is assigned ceCannotResumePC and so maybe implicitly typed as unsigned."
  <var: #theIP type: #sqInt>
  self assert: (objectMemory isContext: aContext).
  self assert: (self isSingleContext: aContext).
  self assert: (objectMemory goodContextSize: aContext).
  theIP := objectMemory fetchPointer: InstructionPointerIndex ofObject: aContext.
+ self assert: HasBeenReturnedFromMCPC < 0.
- self assert: HasBeenReturnedFromMCPC signedIntFromLong < 0.
  theIP := (objectMemory isIntegerObject: theIP)
  ifTrue: [objectMemory integerValueOf: theIP]
  ifFalse: [HasBeenReturnedFromMCPC].
  theMethod := objectMemory followObjField: MethodIndex ofObject: aContext.
  page := stackPages newStackPage.
  "first word on stack is caller context of base frame"
  stackPages
  longAt: (pointer := page baseAddress)
  put: (objectMemory followObjField: SenderIndex ofObject: aContext).
  "second word is the context itself; needed for cannotReturn processing; see ceBaseReturn:."
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: aContext.
  rcvr := objectMemory followField: ReceiverIndex ofObject: aContext.
  "If the frame is a closure activation then the closure should be on the stack in
+ the pushed receiver position (closures receive the value[:value:] messages).
- the pushed receiver position (closures receiver the value[:value:] messages).
  Otherwise it should be the receiver proper."
  maybeClosure := objectMemory fetchPointer: ClosureIndex ofObject: aContext.
  maybeClosure ~= objectMemory nilObject
  ifTrue:
  [(objectMemory isForwarded: maybeClosure) ifTrue:
  [maybeClosure := objectMemory fixFollowedField: ClosureIndex ofObject: aContext withInitialValue: maybeClosure].
  numArgs := self argumentCountOfClosure: maybeClosure.
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: maybeClosure]
  ifFalse:
  [| header |
  header := objectMemory methodHeaderOf: theMethod.
  numArgs := self argumentCountOfMethodHeader: header.
  "If this is a synthetic context its IP could be pointing at the CallPrimitive opcode.  If so, skip it."
+ ((self methodHeaderHasPrimitive: header)
+  and: [theIP = (1 + (objectMemory lastPointerOfMethodHeader: header))]) ifTrue:
- (theIP signedIntFromLong > 0
-  and: [(self methodHeaderHasPrimitive: header)
-  and: [theIP = (1 + (objectMemory lastPointerOfMethodHeader: header))]]) ifTrue:
  [theIP := theIP + (self sizeOfCallPrimitiveBytecode: header)].
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: rcvr].
  "Put the arguments on the stack"
  1 to: numArgs do:
  [:i|
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)].
  "saved caller ip is base return trampoline"
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: cogit ceBaseFrameReturnPC.
  "base frame's saved fp is null"
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: 0.
  "N.B.  Don't set the baseFP, which marks the page as in use, until after
  ensureMethodIsCogged: and/or instructionPointer:forContext:frame:. These
  can cause a compiled code compaction which, if marked as in use, will
  examine this partially initialized page and crash."
  page headFP: pointer.
  "Create either a machine code frame or an interpreter frame based on the pc.  If the pc is -ve
  it is a machine code pc and so we produce a machine code frame.  If +ve an interpreter frame.
  N.B. Do *not* change this to try and map from a bytecode pc to a machine code frame under
  any circumstances.  See ensureContextIsExecutionSafeAfterAssignToStackPointer:"
+ theIP < 0
- theIP signedIntFromLong < 0
  ifTrue:
  [| cogMethod |
  "Since we would have to generate a machine-code method to be able to map
   the native pc anyway we should create a native method and native frame."
  cogMethod := self ensureMethodIsCogged: theMethod.
  theMethod := cogMethod asInteger.
  maybeClosure ~= objectMemory nilObject
  ifTrue:
  ["If the pc is the special HasBeenReturnedFromMCPC pc set the pc
   appropriately so that the frame stays in the cannotReturn: state."
+ theIP = HasBeenReturnedFromMCPC
- theIP = HasBeenReturnedFromMCPC signedIntFromLong
  ifTrue:
  [theMethod := (cogit findMethodForStartBcpc: (self startPCOfClosure: maybeClosure)
  inHomeMethod: (self cCoerceSimple: theMethod
  to: #'CogMethod *')) asInteger.
  theMethod = 0 ifTrue:
  [self error: 'cannot find machine code block matching closure''s startpc'].
  theIP := cogit ceCannotResumePC]
  ifFalse:
  [self assert: (theIP signedBitShift: -16) < -1. "See contextInstructionPointer:frame:"
  theMethod := theMethod - ((theIP signedBitShift: -16) * cogit blockAlignment).
  theIP := theMethod - theIP signedIntFromShort].
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: theMethod + MFMethodFlagHasContextFlag + MFMethodFlagIsBlockFlag]
  ifFalse:
  [self assert: (theIP signedBitShift: -16) >= -1.
  "If the pc is the special HasBeenReturnedFromMCPC pc set the pc
   appropriately so that the frame stays in the cannotReturn: state."
+ theIP := theIP = HasBeenReturnedFromMCPC
- theIP := theIP = HasBeenReturnedFromMCPC signedIntFromLong
  ifTrue: [cogit ceCannotResumePC]
  ifFalse: [theMethod asInteger - theIP].
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: theMethod + MFMethodFlagHasContextFlag].
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: aContext]
  ifFalse:
  [stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: theMethod.
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: aContext.
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: (self encodeFrameFieldHasContext: true isBlock: maybeClosure ~= objectMemory nilObject numArgs: numArgs).
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: 0. "FoxIFSavedIP"
  theIP := self iframeInstructionPointerForIndex: theIP method: theMethod].
  page baseFP: page headFP.
  self assert: (self frameHasContext: page baseFP).
  self assert: (self frameNumArgs: page baseFP) == numArgs.
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: rcvr.
  stackPtrIndex := self quickFetchInteger: StackPointerIndex ofObject: aContext.
  self assert: ReceiverIndex + stackPtrIndex < (objectMemory lengthOf: aContext).
  numArgs + 1 to: stackPtrIndex do:
  [:i|
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)].
  "top of stack is the instruction pointer"
  stackPages longAt: (pointer := pointer - objectMemory wordSize) put: theIP.
  page headSP: pointer.
  self assert: (self context: aContext hasValidInversePCMappingOf: theIP in: page baseFP).
 
  "Mark context as married by setting its sender to the frame pointer plus SmallInteger
  tags and the InstructionPointer to the saved fp (which ensures correct alignment
  w.r.t. the frame when we check for validity) plus SmallInteger tags."
  objectMemory storePointerUnchecked: SenderIndex
  ofObject: aContext
  withValue: (self withSmallIntegerTags: page baseFP).
  objectMemory storePointerUnchecked: InstructionPointerIndex
  ofObject: aContext
  withValue: (self withSmallIntegerTags: 0).
  self assert: (objectMemory isIntegerObject: (objectMemory fetchPointer: SenderIndex ofObject: aContext)).
  self assert: (self frameOfMarriedContext: aContext) = page baseFP.
  self assert: (self validStackPageBaseFrame: page).
  ^page!

Item was changed:
  ----- Method: CoInterpreter>>mustMapMachineCodePC:context: (in category 'frame access') -----
  mustMapMachineCodePC: theIP context: aOnceMarriedContext
  "Map the native pc theIP into a bytecode pc integer object and answer it.
  See contextInstructionPointer:frame: for the explanation."
  | maybeClosure methodObj cogMethod startBcpc bcpc |
  <inline: false>
  <var: #cogMethod type: #'CogMethod *'>
+ theIP = HasBeenReturnedFromMCPC ifTrue:
- theIP = HasBeenReturnedFromMCPC signedIntFromLong ifTrue:
  [^objectMemory nilObject].
  maybeClosure := objectMemory fetchPointer: ClosureIndex ofObject: aOnceMarriedContext.
  methodObj := objectMemory fetchPointer: MethodIndex ofObject: aOnceMarriedContext.
  maybeClosure ~= objectMemory nilObject
  ifTrue: [self assert: (theIP signedBitShift: -16) < -1.
  startBcpc := self startPCOfClosure: maybeClosure]
  ifFalse: [self assert: (theIP signedBitShift: -16) = -1.
  startBcpc := self startPCOfMethod: methodObj].
  cogMethod := self ensureMethodIsCogged: methodObj.
  bcpc := self bytecodePCFor: theIP cogMethod: cogMethod startBcpc: startBcpc.
  self assert: bcpc >= (self startPCOfMethod: methodObj).
  "If there's a CallPrimitive we need to skip it."
  (bcpc = startBcpc
  and: [maybeClosure = objectMemory nilObject
  and: [self methodHeaderHasPrimitive: cogMethod methodHeader]]) ifTrue:
  [bcpc := bcpc + (self sizeOfCallPrimitiveBytecode: cogMethod methodHeader)].
  ^objectMemory integerObjectOf: bcpc + 1!

Item was changed:
  ----- Method: CoInterpreter>>tearDownAndRebuildFrameForCannotReturnBaseFrameReturnFrom:to:returnValue: (in category 'return bytecodes') -----
  tearDownAndRebuildFrameForCannotReturnBaseFrameReturnFrom: contextToReturnFrom to: contextToReturnTo returnValue: returnValue
  "Handle the cannot return response for a base frame return to an invalid context.
  Build a new base frame for the context in the cannot resume state ready for the
  send of cannotReturn:.
 
  Since we have returned from the base frame of the page the context is effectively widowed.
  But its sender needs to be contextToReturnTo, and its pc needs to be the HasBeenReturnedFromMCPC
  marker.  So bereave it (as a side-effect of isWidowedContext:), assign contextToReturnTo to
  sender, and rebuild its frame, which will have the ceCannotResumePC as its pc.  Finally push
  returnValue and set instructionPointer to ceCannotResumePC in preparation for the send."
  | newPage |
  <inline: false>
  <var: #newPage type: #'StackPage *'>
  self assert: (stackPage ~= 0 and: [stackPage isFree]).
  self isWidowedContext: contextToReturnFrom.
  self assert: (self isMarriedOrWidowedContext: contextToReturnFrom) not.
+ objectMemory
+ storePointer: SenderIndex ofObject: contextToReturnFrom withValue: contextToReturnTo;
+ storePointer: InstructionPointerIndex ofObject: contextToReturnFrom withValue: HasBeenReturnedFromMCPCOop.
- objectMemory storePointer: SenderIndex ofObject: contextToReturnFrom withValue: contextToReturnTo.
- objectMemory storePointer: InstructionPointerIndex ofObject: contextToReturnFrom withValue: HasBeenReturnedFromMCPC.
  "void the instructionPointer to stop it being incorrectly updated in a code
  compaction in makeBaseFrameFor:."
  instructionPointer := 0.
  newPage := self makeBaseFrameFor: contextToReturnFrom.
  self assert: stackPage = newPage.
  self setStackPageAndLimit: newPage.
  framePointer := stackPage headFP.
  stackPointer := stackPage headSP.
  self assert: self stackTop = cogit ceCannotResumePC.
  "overwrite the ceSendCannotResumePC on the stack.  If ever re-executed
  the returnValue will be taken from top-of-stack by ceCannotResume."
  self stackTopPut: returnValue.
  "Assign it to instructionPointer as externalCannotReturn:from: pushes it."
+ instructionPointer := cogit ceCannotResumePC!
- instructionPointer := cogit ceCannotResumePC
- !

Item was changed:
  ----- Method: CogIA32Compiler>>genRestoreRegs (in category 'abi') -----
  genRestoreRegs
+ EAX to: EDI do:
+ [:reg|
+ (reg between: ESP and: EBP) ifFalse:
+ [cogit PopR: reg]].
- cogit
- PopR: EAX;
- PopR: EBX;
- PopR: ECX;
- PopR: EDX;
- PopR: ESI;
- PopR: EDI.
  ^0!

Item was changed:
  ----- Method: CogIA32Compiler>>genSaveRegisters (in category 'abi') -----
  genSaveRegisters
  "Save the general purpose registers for a trampoline call."
 
+ self assert: (EDI > EAX and: [EDI - EAX + 1 = 8]).
+ EDI to: EAX by: -1 do:
+ [:reg|
+ (reg between: ESP and: EBP) ifFalse:
+ [cogit PushR: reg]].
- self assert: (EDI > EAX and: [EDI - EAX + 1 = 6]).
- EDI to: EAX by: -1 do: [:reg| cogit PushR: reg].
  ^0!

Item was changed:
  ----- Method: CogIA32Compiler>>rewriteCallAt:target: (in category 'inline cacheing') -----
  rewriteCallAt: callSiteReturnAddress target: callTargetAddress
  "Rewrite a call instruction to call a different target.  This variant is used to link PICs
  in ceSendMiss et al, and to rewrite cached primitive calls.   Answer the extent of
  the code change which is used to compute the range of the icache to flush."
  <var: #callSiteReturnAddress type: #usqInt>
  <var: #callTargetAddress type: #usqInt>
  | callDistance |
  "self cCode: ''
  inSmalltalk: [cogit disassembleFrom: callSiteReturnAddress - 10 to: callSiteReturnAddress - 1]."
  false
  ifTrue: [self assert: callTargetAddress >= cogit minCallAddress]
  ifFalse: [callTargetAddress >= cogit minCallAddress ifFalse:
  [self error: 'linking callsite to invalid address']].
  callDistance := (callTargetAddress - callSiteReturnAddress) signedIntToLong.
  objectMemory
  byteAt: callSiteReturnAddress - 1 put: (callDistance >> 24 bitAnd: 16rFF);
  byteAt: callSiteReturnAddress - 2 put: (callDistance >> 16 bitAnd: 16rFF);
  byteAt: callSiteReturnAddress - 3 put: (callDistance >>   8 bitAnd: 16rFF);
  byteAt: callSiteReturnAddress - 4 put: (callDistance            bitAnd: 16rFF).
+ self assert: (self callTargetFromReturnAddress: callSiteReturnAddress) = callTargetAddress.
- self assert: (self callTargetFromReturnAddress: callSiteReturnAddress) signedIntToLong = callTargetAddress.
  "self cCode: ''
  inSmalltalk: [cogit disassembleFrom: callSiteReturnAddress - 10 to: callSiteReturnAddress - 1]."
  ^5!

Item was changed:
  ----- Method: CogInLineLiteralsX64Compiler>>inlineCacheTagAt: (in category 'inline cacheing') -----
  inlineCacheTagAt: callSiteReturnAddress
  "Answer the inline cache tag for the return address of a send."
+ ^self literal32BeforeFollowingAddress: callSiteReturnAddress - 5!
- ^self thirtyTwoBitLiteralBefore: callSiteReturnAddress - 5!

Item was changed:
  ----- Method: CogVMSimulator>>initialize (in category 'initialization') -----
  initialize
  "Initialize the CogVMSimulator when running the interpreter inside Smalltalk.  The
  primary responsibility of this method is to allocate Smalltalk Arrays for variables
  that will be declared as statically-allocated global arrays in the translated code."
  super initialize.
 
  transcript := Transcript.
 
  objectMemory ifNil:
  [objectMemory := self class objectMemoryClass simulatorClass new].
  cogit ifNil:
  [cogit := self class cogitClass new setInterpreter: self].
  objectMemory coInterpreter: self cogit: cogit.
 
  cogit numRegArgs > 0 ifTrue:
  [debugStackDepthDictionary := Dictionary new].
 
  cogThreadManager ifNotNil:
  [super initialize].
 
+ self assert: ConstMinusOne = (objectMemory integerObjectOf: -1).
+
- "Note: we must initialize ConstMinusOne & HasBeenReturnedFromMCPC differently
- for simulation, due to the fact that the simulator works only with +ve 32-bit values"
- ConstMinusOne := objectMemory integerObjectOf: -1.
- HasBeenReturnedFromMCPC := objectMemory integerObjectOf: -1.
  cogMethodZone := cogit methodZone. "Because Slang can't remove intermediate implicit receivers (cogit methodZone foo doesn't reduce to foo())"
  enableCog := true.
 
  methodCache := Array new: MethodCacheSize.
  nsMethodCache := Array new: NSMethodCacheSize.
  atCache := Array new: AtCacheTotalSize.
  self flushMethodCache.
  cogCompiledCodeCompactionCalledFor := false.
  gcSemaphoreIndex := 0.
  externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
  externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
  externalPrimitiveTableFirstFreeIndex := 0.
  primitiveTable := self class primitiveTable copy.
  mappedPluginEntries := OrderedCollection new.
  objectMemory hasSpurMemoryManagerAPI
  ifTrue:
  [primitiveAccessorDepthTable := Array new: primitiveTable size.
  pluginList := {}.
  self loadNewPlugin: '']
  ifFalse:
  [pluginList := {'' -> self }].
  desiredNumStackPages := desiredEdenBytes := desiredCogCodeSize := 0.
  "This is initialized on loading the image, but convenient for testing stack page values..."
  numStackPages := self defaultNumStackPages.
  startMicroseconds := Time totalSeconds * 1000000.
  maxLiteralCountForCompile := MaxLiteralCountForCompile.
  minBackwardJumpCountForCompile := MinBackwardJumpCountForCompile.
  flagInterpretedMethods := false.
 
  "initialize InterpreterSimulator variables used for debugging"
  byteCount := lastPollCount := sendCount := lookupCount := 0.
  quitBlock := [^ self].
  traceOn := true.
  printSends := printFrameAtEachStep := printBytecodeAtEachStep := false.
  myBitBlt := BitBltSimulator new setInterpreter: self.
  displayForm := fakeForm := 'Display has not yet been installed' asDisplayText form.
  eventQueue := SharedQueue new.
  suppressHeartbeatFlag := deferSmash := deferredSmash := false.
  systemAttributes := Dictionary new.
  primTraceLog := CArrayAccessor on: (Array new: 256 withAll: 0).
  primTraceLogIndex := 0.
  traceLog := CArrayAccessor on: (Array new: TraceBufferSize withAll: 0).
  traceLogIndex := 0.
  traceSources := TraceSources.
  statCodeCompactionCount := 0.
  statCodeCompactionUsecs := 0.
  extSemTabSize := 256!

Item was changed:
  ----- Method: CogX64Compiler>>callTargetFromReturnAddress: (in category 'inline cacheing') -----
  callTargetFromReturnAddress: callSiteReturnAddress
  "Answer the address the call immediately preceding callSiteReturnAddress will jump to."
  | callDistance |
+ callDistance := self literal32BeforeFollowingAddress: callSiteReturnAddress.
- callDistance := self thirtyTwoBitLiteralBefore: callSiteReturnAddress.
  ^callSiteReturnAddress + callDistance signedIntFromLong!

Item was changed:
  ----- Method: CogX64Compiler>>rewriteCallAt:target: (in category 'inline cacheing') -----
  rewriteCallAt: callSiteReturnAddress target: callTargetAddress
  "Rewrite a call instruction to call a different target.  This variant is used to link PICs
  in ceSendMiss et al, and to rewrite cached primitive calls.   Answer the extent of
  the code change which is used to compute the range of the icache to flush."
  <var: #callSiteReturnAddress type: #usqInt>
  <var: #callTargetAddress type: #usqInt>
  | callDistance |
  "self cCode: ''
  inSmalltalk: [cogit disassembleFrom: callSiteReturnAddress - 10 to: callSiteReturnAddress - 1]."
  false
  ifTrue: [self assert: callTargetAddress >= cogit minCallAddress]
  ifFalse: [callTargetAddress >= cogit minCallAddress ifFalse:
  [self error: 'linking callsite to invalid address']].
  callDistance := (callTargetAddress - callSiteReturnAddress) signedIntToLong.
  objectMemory
  byteAt: callSiteReturnAddress - 1 put: (callDistance >> 24 bitAnd: 16rFF);
  byteAt: callSiteReturnAddress - 2 put: (callDistance >> 16 bitAnd: 16rFF);
  byteAt: callSiteReturnAddress - 3 put: (callDistance >>   8 bitAnd: 16rFF);
  byteAt: callSiteReturnAddress - 4 put: (callDistance            bitAnd: 16rFF).
+ self assert: (self callTargetFromReturnAddress: callSiteReturnAddress) = callTargetAddress.
- self assert: (self callTargetFromReturnAddress: callSiteReturnAddress) signedIntToLong = callTargetAddress.
  "self cCode: ''
  inSmalltalk: [cogit disassembleFrom: callSiteReturnAddress - 10 to: callSiteReturnAddress - 1]."
  ^5!

Item was removed:
- ----- Method: CogX64Compiler>>thirtyTwoBitLiteralBefore: (in category 'inline cacheing') -----
- thirtyTwoBitLiteralBefore: followingAddress
- <inline: true>
- ^self unalignedLong32At: followingAddress - 4!

Item was changed:
  ----- Method: IA32ABIPlugin>>primSizeField (in category 'primitives-accessing') -----
  primSizeField
  "Answer the signed 32- or 64-bit integer comprising the size field (the first 32- or 64-bit field)."
  "<Alien> primSizeField ^<Integer>
  <primitive: 'primSizeField' error: errorCode module: 'IA32ABI'>"
  | rcvr value valueOop |
  <export: true>
 
  rcvr := interpreterProxy stackValue: 0.
+ value := self cppIf: interpreterProxy bytesPerOop = 8
+ ifTrue: [(self longAt: rcvr + interpreterProxy baseHeaderSize) signedIntFromLong64]
+ ifFalse: [(self longAt: rcvr + interpreterProxy baseHeaderSize) signedIntFromLong].
- value := (self longAt: rcvr + interpreterProxy baseHeaderSize) signedIntFromLong.
  valueOop := self signedMachineIntegerFor: value.
  ^interpreterProxy methodReturnValue: valueOop!

Item was changed:
  ----- Method: IA32ABIPlugin>>primSizeFieldPut (in category 'primitives-accessing') -----
  primSizeFieldPut
  "Store a signed integer into the size field (the first 32 bit field; little endian)."
  "<Alien> sizeFieldPut: value <Integer> ^<Integer>
  <primitive: 'primSizeFieldPut' error: errorCode module: 'IA32ABI'>"
  | rcvr value valueOop |
  <export: true>
 
  valueOop := interpreterProxy stackValue: 0.
  rcvr := interpreterProxy stackValue: 1.
  value := interpreterProxy signedMachineIntegerValueOf: valueOop.
  interpreterProxy failed ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ (self cppIf: interpreterProxy bytesPerOop = 8
+ ifTrue: [self longAt: rcvr + interpreterProxy baseHeaderSize put: value signedIntToLong64]
+ ifFalse: [self longAt: rcvr + interpreterProxy baseHeaderSize put: value signedIntToLong]).
- self longAt: rcvr + interpreterProxy baseHeaderSize put: value signedIntToLong.
  ^interpreterProxy methodReturnValue: valueOop!

Item was changed:
  ----- Method: NewsqueakIA32ABIPlugin>>primSizeField (in category 'primitives-accessing') -----
  primSizeField
  "Answer the signed 32- or 64-bit integer comprising the size field (the first 32- or 64-bit field)."
  "<Alien> primSizeField ^<Integer>
  <primitive: 'primSizeField' error: errorCode module: 'IA32ABI'>"
  | rcvr value valueOop |
  <export: true>
 
  rcvr := interpreterProxy stackValue: 0.
+ value := self cppIf: interpreterProxy bytesPerOop = 8
+ ifTrue: [(self longAt: rcvr + interpreterProxy baseHeaderSize) signedIntFromLong64]
+ ifFalse: [(self longAt: rcvr + interpreterProxy baseHeaderSize) signedIntFromLong].
- value := (self longAt: rcvr + interpreterProxy baseHeaderSize) signedIntFromLong.
  valueOop := self signedMachineIntegerFor: value.
  ^interpreterProxy methodReturnValue: valueOop!

Item was changed:
  ----- Method: NewsqueakIA32ABIPlugin>>primSizeFieldPut (in category 'primitives-accessing') -----
  primSizeFieldPut
  "Store a signed integer into the size field (the first 32 bit field; little endian)."
  "<Alien> sizeFieldPut: value <Integer> ^<Integer>
  <primitive: 'primSizeFieldPut' error: errorCode module: 'IA32ABI'>"
  | rcvr value valueOop |
  <export: true>
 
  valueOop := interpreterProxy stackValue: 0.
  rcvr := interpreterProxy stackValue: 1.
  value := interpreterProxy signedMachineIntegerValueOf: valueOop.
  interpreterProxy failed ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
+ (self cppIf: interpreterProxy bytesPerOop = 8
+ ifTrue: [self longAt: rcvr + interpreterProxy baseHeaderSize put: value signedIntToLong64]
+ ifFalse: [self longAt: rcvr + interpreterProxy baseHeaderSize put: value signedIntToLong]).
- (interpreterProxy isOopImmutable: rcvr) ifTrue:
- [^interpreterProxy primitiveFailFor: PrimErrNoModification].
- self longAt: rcvr + interpreterProxy baseHeaderSize put: value signedIntToLong.
  ^interpreterProxy methodReturnValue: valueOop!

Item was changed:
  ----- Method: SpurMemoryManager>>initialize (in category 'initialization') -----
  initialize
  "We can put all initializations that set something to 0 or to false here.
  In C all global variables are initialized to 0, and 0 is false."
  remapBuffer := Array new: RemapBufferSize.
  remapBufferCount := extraRootCount := 0. "see below"
  freeListsMask := totalFreeOldSpace := lowSpaceThreshold := 0.
  checkForLeaks := 0.
  needGCFlag := signalLowSpace := scavengeInProgress := marking := false.
  becomeEffectsFlags := 0.
  statScavenges := statIncrGCs := statFullGCs := 0.
  statScavengeGCUsecs := statIncrGCUsecs := statFullGCUsecs := statGCEndUsecs := 0.
  statSGCDeltaUsecs := statIGCDeltaUsecs := statFGCDeltaUsecs := 0.
  statGrowMemory := statShrinkMemory := statRootTableCount := statSurvivorCount := 0.
  statRootTableOverflows := statMarkCount := statSpecialMarkCount := statCompactPassCount := statCoalesces := 0.
 
  "We can initialize things that are allocated but are lazily initialized."
  unscannedEphemerons := SpurContiguousObjStack new.
 
  "we can initialize things that are virtual in C."
  scavenger := SpurGenerationScavengerSimulator new manager: self; yourself.
  segmentManager := SpurSegmentManager new manager: self; yourself.
 
  "We can also initialize here anything that is only for simulation."
  heapMap := CogCheck32BitHeapMap new.
 
  "N.B. We *don't* initialize extraRoots because we don't simulate it."
 
+ maxOldSpaceSize := self class initializationOptions ifNotNil: [:initOpts| initOpts at: #maxOldSpaceSize ifAbsent: [0]]!
- maxOldSpaceSize := self class initializationOptions at: #maxOldSpaceSize ifAbsent: [0]!

Item was added:
+ ----- Method: StackInterpreter>>allOnesAsCharStar (in category 'stack pages') -----
+ allOnesAsCharStar
+ <inline: true>
+ ^(self
+ cCoerceSimple: (objectMemory wordSize = 8
+ ifTrue: [-1 signedIntToLong64]
+ ifFalse: [-1 signedIntToLong])
+ to: #'char *')!

Item was changed:
  ----- Method: StackInterpreter>>assertValidStackLimits: (in category 'process primitive support') -----
  assertValidStackLimits: ln
  <returnTypeC: #void>
  "Order in the stackLimit checks is important because stackLimit is smashed by
  interrupts. So always check for unsmashed value first to avoid race condition."
  self assert: (stackLimit = stackPage realStackLimit
+ or: [stackLimit = self allOnesAsCharStar])
- or: [stackLimit = (self cCoerceSimple: -1 signedIntToLong to: #'char *')])
  l: ln.
  self assert: (stackPage stackLimit = stackPage realStackLimit
+ or: [stackPage stackLimit = self allOnesAsCharStar])
- or: [stackPage stackLimit = (self cCoerceSimple: -1 signedIntToLong to: #'char *')])
  l: ln!

Item was changed:
  ----- Method: StackInterpreter>>forceInterruptCheck (in category 'process primitive support') -----
  forceInterruptCheck
  "Force an interrupt check ASAP.
  Must set the stack page's limit before stackLimit to avoid
  a race condition if this is called from an interrupt handler."
  | thePage iccFunc |
  <inline: false>
  <var: #thePage type: #'StackPage *'>
  <var: #iccFunc declareC: 'void (*iccFunc)()'>
  "Do _not_ set stackLimit until the stack system has been initialized.
  stackLimit is the initialization flag for the stack system."
  stackLimit = 0 ifTrue:
  [^nil].
  thePage := stackPage.
  (thePage notNil and: [thePage ~= 0]) ifTrue:
+ [thePage stackLimit: self allOnesAsCharStar].
+ stackLimit := self allOnesAsCharStar.
- [thePage stackLimit: (self cCoerceSimple: -1 signedIntToLong to: #'char *')].
- stackLimit := self cCoerceSimple: -1 signedIntToLong to: #'char *'.
  self sqLowLevelMFence.
  "There is a race condition if we test the function and then dereference
  it a second time to call it.  This is called from interrupt code but at the
  same time other code could be clearing the interruptCheckChain via
  setInterruptCheckChain:."
  (iccFunc := interruptCheckChain) notNil ifTrue:
  [self perform: iccFunc].
  statForceInterruptCheck := statForceInterruptCheck + 1!

Item was changed:
  ----- Method: StackInterpreter>>makeBaseFrameFor: (in category 'frame access') -----
  makeBaseFrameFor: aContext "<Integer>"
  "Marry aContext with the base frame of a new stack page.  Build the base
  frame to reflect the context's state.  Answer the new page."
  <returnTypeC: #'StackPage *'>
  | page pointer theMethod theIP numArgs stackPtrIndex maybeClosure rcvr |
  <inline: false>
  <var: #page type: #'StackPage *'>
  <var: #pointer type: #'char *'>
  self assert: (objectMemory isContext: aContext).
  self assert: (self isSingleContext: aContext).
  self assert: (objectMemory goodContextSize: aContext).
  page := stackPages newStackPage.
  pointer := page baseAddress.
  theIP := objectMemory fetchPointer: InstructionPointerIndex ofObject: aContext.
  theMethod := objectMemory followObjField: MethodIndex ofObject: aContext.
  (objectMemory isIntegerObject: theIP) ifFalse:
  [self error: 'context is not resumable'].
  theIP := objectMemory integerValueOf: theIP.
  rcvr := objectMemory followField: ReceiverIndex ofObject: aContext.
  "If the frame is a closure activation then the closure should be on the stack in
+ the pushed receiver position (closures receive the value[:value:] messages).
- the pushed receiver position (closures receiver the value[:value:] messages).
  Otherwise it should be the receiver proper."
  maybeClosure := objectMemory fetchPointer: ClosureIndex ofObject: aContext.
  maybeClosure ~= objectMemory nilObject
  ifTrue:
  [(objectMemory isForwarded: maybeClosure) ifTrue:
  [maybeClosure := objectMemory fixFollowedField: ClosureIndex ofObject: aContext withInitialValue: maybeClosure].
  numArgs := self argumentCountOfClosure: maybeClosure.
  stackPages longAt: pointer put: maybeClosure]
  ifFalse:
  [| header |
  header := objectMemory methodHeaderOf: theMethod.
  numArgs := self argumentCountOfMethodHeader: header.
  "If this is a synthetic context its IP could be pointing at the CallPrimitive opcode.  If so, skip it."
+ ((self methodHeaderHasPrimitive: header)
+  and: [theIP = (1 + (objectMemory lastPointerOfMethodHeader: header))]) ifTrue:
- (theIP signedIntFromLong > 0
-  and: [(self methodHeaderHasPrimitive: header)
-  and: [theIP = (1 + (objectMemory lastPointerOfMethodHeader: header))]]) ifTrue:
  [theIP := theIP + (self sizeOfCallPrimitiveBytecode: header)].
  stackPages longAt: pointer put: rcvr].
  "Put the arguments on the stack"
  1 to: numArgs do:
  [:i|
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)].
  "saved caller ip is sender context in base frame"
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: (objectMemory followObjField: SenderIndex ofObject: aContext).
  "base frame's saved fp is null"
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: 0.
  page baseFP: pointer; headFP: pointer.
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: theMethod.
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: (self encodeFrameFieldHasContext: true isBlock: maybeClosure ~= objectMemory nilObject numArgs: numArgs).
  self assert: (self frameHasContext: page baseFP).
  self assert: (self frameNumArgs: page baseFP) == numArgs.
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: aContext.
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: rcvr.
  stackPtrIndex := self quickFetchInteger: StackPointerIndex ofObject: aContext.
  self assert: ReceiverIndex + stackPtrIndex < (objectMemory lengthOf: aContext).
  numArgs + 1 to: stackPtrIndex do:
  [:i|
  stackPages
  longAt: (pointer := pointer - objectMemory wordSize)
  put: (objectMemory fetchPointer: ReceiverIndex + i ofObject: aContext)].
  "top of stack is the instruction pointer"
  theIP := self iframeInstructionPointerForIndex: theIP method: theMethod.
  stackPages longAt: (pointer := pointer - objectMemory wordSize) put: theIP.
  page headSP: pointer.
  self assert: (self context: aContext hasValidInversePCMappingOf: theIP in: page baseFP).
 
  "Mark context as married by setting its sender to the frame pointer plus SmallInteger
  tags and the InstructionPointer to the saved fp (which ensures correct alignment
  w.r.t. the frame when we check for validity) plus SmallInteger tags."
  objectMemory storePointerUnchecked: SenderIndex
  ofObject: aContext
  withValue: (self withSmallIntegerTags: page baseFP).
  objectMemory storePointerUnchecked: InstructionPointerIndex
  ofObject: aContext
  withValue: (self withSmallIntegerTags: 0).
  self assert: (objectMemory isIntegerObject: (objectMemory fetchPointer: SenderIndex ofObject: aContext)).
  self assert: (self frameOfMarriedContext: aContext) = page baseFP.
  self assert: (self validStackPageBaseFrame: page).
  ^page!

Item was changed:
  ----- Method: StackInterpreter>>setStackPageAndLimit: (in category 'stack pages') -----
  setStackPageAndLimit: thePage
  "Set stackPage to a different page.  Set stackLimit unless it has
  been smashed.  Make the stackPage the most recently used"
  <inline: true>
  <var: #thePage type: #'StackPage *'>
  self assert: thePage ~= 0.
  stackPage := thePage.
+ stackLimit ~= self allOnesAsCharStar ifTrue:
- stackLimit ~= (self cCoerceSimple: -1 signedIntToLong to: #'char *') ifTrue:
  [stackLimit := stackPage stackLimit].
  stackPages markStackPageMostRecentlyUsed: thePage!

Item was changed:
  ----- Method: StackInterpreterSimulator>>initialize (in category 'initialization') -----
  initialize
  "Initialize the StackInterpreterSimulator when running the interpreter
  inside Smalltalk. The primary responsibility of this method is to allocate
  Smalltalk Arrays for variables that will be declared as statically-allocated
  global arrays in the translated code."
  super initialize.
 
  bootstrapping := false.
  transcript := Transcript.
 
  objectMemory ifNil:
  [objectMemory := self class objectMemoryClass simulatorClass new].
  objectMemory coInterpreter: self.
 
+ self assert: ConstMinusOne = (objectMemory integerObjectOf: -1).
- "Note: we must initialize ConstMinusOne differently for simulation,
- due to the fact that the simulator works only with +ve 32-bit values"
- ConstMinusOne := objectMemory integerObjectOf: -1.
 
  methodCache := Array new: MethodCacheSize.
  nsMethodCache := Array new: NSMethodCacheSize.
  atCache := Array new: AtCacheTotalSize.
  self flushMethodCache.
  gcSemaphoreIndex := 0.
  externalSemaphoreSignalRequests := externalSemaphoreSignalResponses := #().
  externalPrimitiveTable := CArrayAccessor on: (Array new: MaxExternalPrimitiveTableSize).
  externalPrimitiveTableFirstFreeIndex := 0.
  primitiveTable := self class primitiveTable copy.
  mappedPluginEntries := OrderedCollection new.
  objectMemory hasSpurMemoryManagerAPI
  ifTrue:
  [primitiveAccessorDepthTable := Array new: primitiveTable size.
  pluginList := {}.
  self loadNewPlugin: '']
  ifFalse:
  [pluginList := {'' -> self }].
  desiredNumStackPages := desiredEdenBytes := 0.
  "This is initialized on loading the image, but convenient for testing stack page values..."
  numStackPages := self defaultNumStackPages.
  startMicroseconds := Time totalSeconds * 1000000.
 
  "initialize InterpreterSimulator variables used for debugging"
  byteCount := sendCount := lookupCount := 0.
  quitBlock := [^self].
  traceOn := true.
  printSends := printReturns := printFrameAtEachStep := printBytecodeAtEachStep := false.
  myBitBlt := BitBltSimulator new setInterpreter: self.
  displayForm := fakeForm := 'Display has not yet been installed' asDisplayText form.
  eventQueue := SharedQueue new.
  suppressHeartbeatFlag := false.
  systemAttributes := Dictionary new.
  extSemTabSize := 256.
  disableBooleanCheat := false.
  assertVEPAES := true. "a flag so the assertValidExecutionPointers can be disabled for simulation speed"!

Item was changed:
  ----- Method: TMethod>>isFunctional (in category 'inlining') -----
  isFunctional
  "Answer true if the receiver is a functional method. That is, if it
  consists of a single return statement of an expression that contains
  no other returns.
 
  Answer false for methods with return types other than the simple
  integer types to work around bugs in the inliner."
 
  parseTree statements isEmpty ifTrue:
  [^false].
  parseTree statements last isReturn ifFalse:
  [^false].
  parseTree statements size = 1 ifFalse:
  [(parseTree statements size = 2
   and: [parseTree statements first isSend
   and: [parseTree statements first selector == #flag:]]) ifFalse:
  [^false]].
  parseTree statements last expression nodesDo:
  [ :n | n isReturn ifTrue: [^false]].
+ ^#(sqInt usqInt sqLong usqLong #'sqInt *' #'CogMethod *' #'char *') includes: returnType!
- ^#(sqInt usqInt sqLong usqLong #'sqInt *' #'CogMethod *') includes: returnType!

Item was changed:
+ ----- Method: TSendNode>>hasSideEffect (in category 'testing') -----
- ----- Method: TSendNode>>hasSideEffect (in category 'as yet unclassified') -----
  hasSideEffect
  "Answer if the parse tree rooted at this node has a side-effect or not."
  ^(#(#+ #- #* #/ #// #\\ #= #== #~= #~~) includes: selector) not!