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

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
1 message Options
Reply | Threaded
Open this post in threaded view
|

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

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

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

Name: VMMaker.oscog-eem.1953
Author: eem
Time: 27 September 2016, 11:49:39.85675 am
UUID: 1f1e4603-f82c-48df-915b-7bf0d38e3b60
Ancestors: VMMaker.oscog-eem.1952

Make MULTIPLEBYTECODESETS a generation-time-only option.
For the generation-time-only options (PharoVM NewspeakVM SistaVM LowcodeVM MULTIPLEBYTECODESETS) make sure these are tested via ifTrue: et al, not via cppIf:ifTrue: et al, so they are included or eliminated completely at generation time.

Make sure the 64-bit Squeak Spur VMs mirror the 32-bit ones in including the SqueakV3PlusClosures & SistaV1 bytecode sets.

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

Item was changed:
  ----- Method: CoInterpreter>>commonCallerReturn (in category 'return bytecodes') -----
  commonCallerReturn
  "Return to the previous context/frame (sender for method activations, caller for block activations)."
  <sharedCodeNamed: 'commonCallerReturn' inCase: #returnTopFromBlock>
  | callersFPOrNull doWeHaveANativeFrame |
  <var: #callersFPOrNull type: #'char *'>
 
  "TODO: Store/restore the nativeSP more properly, when it exists"
+ LowcodeVM ifTrue: [
- self cppIf: LowcodeVM ifTrue: [
  doWeHaveANativeFrame := self frameHasNativeFrame: localFP.
  doWeHaveANativeFrame ifTrue: [
  nativeStackPointer := (self nativePreviousStackPointerIn: localFP) - 1.
  nativeSP := 0.
  self setFrameHasNotNativeFrame: localFP.
  ].
  ].
 
  callersFPOrNull := self frameCallerFP: localFP.
  callersFPOrNull == 0 "baseFrame" ifTrue:
  [self assert: localFP = stackPage baseFP.
  ^self baseFrameReturn].
 
  localIP := self frameCallerSavedIP: localFP.
  localSP := localFP + (self frameStackedReceiverOffset: localFP).
  localFP := callersFPOrNull.
  localIP asUnsignedInteger < objectMemory startOfMemory ifTrue:
  [localIP asUnsignedInteger ~= cogit ceReturnToInterpreterPC ifTrue:
  ["localIP in the cog method zone indicates a return to machine code."
  ^self returnToMachineCodeFrame].
  localIP := self pointerForOop: (self iframeSavedIP: localFP)].
  self setMethod: (self iframeMethod: localFP).
  self fetchNextBytecode.
  self internalStackTopPut: localReturnValue!

Item was changed:
  ----- Method: CoInterpreter>>internalizeIPandSP (in category 'utilities') -----
  internalizeIPandSP
  "Copy the instruction, stack and frame pointers to local variables for rapid access within the interpret loop."
 
  self assert: instructionPointer ~= cogit ceReturnToInterpreterPC.
  localIP := self pointerForOop: instructionPointer.
  localSP := self pointerForOop: stackPointer.
  localFP := self pointerForOop: framePointer.
+ LowcodeVM ifTrue: [ nativeSP := 0. ]!
- self cppIf: LowcodeVM ifTrue: [ nativeSP := 0. ]!

Item was changed:
  ----- Method: CogObjectRepresentationForSpur>>generateObjectRepresentationTrampolines (in category 'initialization') -----
  generateObjectRepresentationTrampolines
  "Do the store check.  Answer the argument for the benefit of the code generator;
  ReceiverResultReg may be caller-saved and hence smashed by this call.  Answering
  it allows the code generator to reload ReceiverResultReg cheaply.
  In Spur the only thing we leave to the run-time is adding the receiver to the
  remembered set and setting its isRemembered bit."
  self
  cppIf: IMMUTABILITY
  ifTrue:
  [self cCode: [] inSmalltalk:
  [ceStoreTrampolines := CArrayAccessor on: (Array new: NumStoreTrampolines)].
  0 to: NumStoreTrampolines - 1 do:
  [:instVarIndex |
  ceStoreTrampolines
  at: instVarIndex
  put: (self
  genStoreTrampolineCalled: (cogit
  trampolineName: 'ceStoreTrampoline'
  numArgs: instVarIndex
  limit: NumStoreTrampolines - 2)
  instVarIndex: instVarIndex)]].
  ceStoreCheckTrampoline := self genStoreCheckTrampoline.
  ceStoreCheckContextReceiverTrampoline := self genStoreCheckContextReceiverTrampoline.
  ceScheduleScavengeTrampoline := cogit
  genTrampolineFor: #ceScheduleScavenge
  called: 'ceScheduleScavengeTrampoline'
  regsToSave: CallerSavedRegisterMask.
  ceSmallActiveContextInMethodTrampoline := self genActiveContextTrampolineLarge: false inBlock: 0 called: 'ceSmallMethodContext'.
  ceSmallActiveContextInBlockTrampoline := self genActiveContextTrampolineLarge: false inBlock: InVanillaBlock called: 'ceSmallBlockContext'.
  SistaV1BytecodeSet ifTrue:
  [ceSmallActiveContextInFullBlockTrampoline := self genActiveContextTrampolineLarge: false inBlock: InFullBlock called: 'ceSmallFullBlockContext'].
  ceLargeActiveContextInMethodTrampoline := self genActiveContextTrampolineLarge: true inBlock: 0 called: 'ceLargeMethodContext'.
  ceLargeActiveContextInBlockTrampoline := self genActiveContextTrampolineLarge: true inBlock: InVanillaBlock called: 'ceLargeBlockContext'.
  SistaV1BytecodeSet ifTrue:
  [ceLargeActiveContextInFullBlockTrampoline := self genActiveContextTrampolineLarge: true inBlock: InFullBlock called: 'ceLargeFullBlockContext'].
 
+ LowcodeVM ifTrue: [ self generateLowcodeObjectTrampolines ]!
- self cppIf: LowcodeVM ifTrue: [ self generateLowcodeObjectTrampolines ]!

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

Item was changed:
  ----- Method: CogSSBytecodeFixup>>reinitialize (in category 'accessing') -----
  reinitialize
  <inline: true>
  targetInstruction := 0.
  simStackPtr := 0.
+ LowcodeVM ifTrue: [
- self cppIf: LowcodeVM ifTrue: [
  simNativeStackPtr := 0.
  ]!

Item was changed:
  ----- Method: CogSSBytecodeFixup>>setIsBackwardBranchFixup (in category 'accessing') -----
  setIsBackwardBranchFixup
  <inline: true>
  simStackPtr := UnknownSimStackPtrFlag.
+ LowcodeVM ifTrue: [
- self cppIf: LowcodeVM ifTrue: [
  simNativeStackPtr := UnknownSimStackPtrFlag.
  simNativeStackSize := 0.
  ]
  !

Item was changed:
  ----- Method: Cogit>>checkIfValidOopRef:pc:cogMethod: (in category 'garbage collection') -----
  checkIfValidOopRef: annotation pc: mcpc cogMethod: cogMethod
  "Check for a valid object reference, if any, at a map entry.  Answer a code unique to each error for debugging."
  <var: #mcpc type: #'char *'>
  <var: #nsSendCache type: #'NSSendCache *'>
  annotation = IsObjectReference ifTrue:
  [| literal |
  literal := literalsManager fetchLiteralAtAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
  (objectRepresentation checkValidOopReference: literal) ifFalse:
  [coInterpreter print: 'object ref leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
  ^1]].
 
+ NewspeakVM ifTrue:
- self cppIf: NewspeakVM ifTrue:
  [annotation = IsNSSendCall ifTrue:
  [| nsSendCache enclosingObject |
  nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  [(objectRepresentation checkValidOopReference: nsSendCache selector) ifFalse:
  [coInterpreter print: 'selector leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
  ^1]].
  (enclosingObject := nsSendCache enclosingObject) ~= 0 ifTrue:
  [[(objectRepresentation checkValidOopReference: enclosingObject) ifFalse:
  [coInterpreter print: 'enclosing object leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
  ^1]]]]].
 
  (self isPureSendAnnotation: annotation) ifTrue:
  [| entryPoint selectorOrCacheTag offset |
  entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  entryPoint <= methodZoneBase
  ifTrue:
  [offset := entryPoint]
  ifFalse:
  [self
  offsetAndSendTableFor: entryPoint
  annotation: annotation
  into: [:off :table| offset := off]].
  selectorOrCacheTag := backEnd inlineCacheTagAt: mcpc asInteger.
  (entryPoint > methodZoneBase
   and: [offset ~= cmNoCheckEntryOffset
   and: [(self cCoerceSimple: entryPoint - offset to: #'CogMethod *') cmType ~= CMOpenPIC]])
  ifTrue: "linked non-super send, cacheTag is a cacheTag"
  [(objectRepresentation validInlineCacheTag: selectorOrCacheTag) ifFalse:
  [coInterpreter print: 'cache tag leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
  ^1]]
  ifFalse: "unlinked send or super send; cacheTag is a selector unless 64-bit, in which case it is an index."
  [(self inlineCacheTagsAreIndexes
   or: [objectRepresentation checkValidOopReference: selectorOrCacheTag]) ifFalse:
  [coInterpreter print: 'selector leak in CM '; printHex: cogMethod asInteger; print: ' @ '; printHex: mcpc asInteger; cr.
  ^1]]].
  ^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>checkIfValidOopRefAndTarget:pc:cogMethod: (in category 'garbage collection') -----
  checkIfValidOopRefAndTarget: annotation pc: mcpc cogMethod: cogMethod
  "Check for a valid object reference, if any, at a map entry.  Answer a code unique to each error for debugging."
  <var: #mcpc type: #'char *'>
  <var: #nsSendCache type: #'NSSendCache *'>
  | literal entryPoint |
  annotation = IsObjectReference ifTrue:
  [literal := literalsManager fetchLiteralAtAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
  (self asserta: (objectRepresentation checkValidOopReference: literal)) ifFalse:
  [^1].
  ((objectRepresentation couldBeObject: literal)
  and: [objectMemory isReallyYoungObject: literal]) ifTrue:
  [(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmRefersToYoung) ifFalse:
  [^2]]].
 
+ NewspeakVM ifTrue:
- self cppIf: NewspeakVM ifTrue:
  [annotation = IsNSSendCall ifTrue:
  [| nsSendCache classTag enclosingObject nsTargetMethod |
  nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  (self asserta: (objectRepresentation checkValidOopReference: nsSendCache selector)) ifFalse:
  [^9].
  classTag := nsSendCache classTag.
  (self asserta: (classTag = 0 or: [objectRepresentation validInlineCacheTag: classTag])) ifFalse:
  [^10].
  enclosingObject := nsSendCache enclosingObject.
  (self asserta: (enclosingObject = 0 or: [objectRepresentation checkValidOopReference: enclosingObject])) ifFalse:
  [^11].
  entryPoint := nsSendCache target.
  entryPoint ~= 0 ifTrue: [
  nsTargetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
  (self asserta: (nsTargetMethod cmType = CMMethod)) ifFalse:
  [^12]]]].
 
  (self isPureSendAnnotation: annotation) ifTrue:
  [(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmType = CMMethod) ifFalse:
  [^3].
  self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
  [:offset :cacheTag :tagCouldBeObject|
  tagCouldBeObject
  ifTrue:
  [(objectRepresentation couldBeObject: cacheTag)
  ifTrue:
  [(self asserta: (objectRepresentation checkValidOopReference: cacheTag)) ifFalse:
  [^4]]
  ifFalse:
  [(self asserta: (objectRepresentation validInlineCacheTag: cacheTag)) ifFalse:
  [^5]].
  ((objectRepresentation couldBeObject: cacheTag)
  and: [objectMemory isReallyYoungObject: cacheTag]) ifTrue:
  [(self asserta: (self cCoerceSimple: cogMethod to: #'CogMethod *') cmRefersToYoung) ifFalse:
  [^6]]]
  ifFalse:
  [(self asserta: (objectRepresentation validInlineCacheTag: cacheTag)) ifFalse:
  [^7]]].
  entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  entryPoint > methodZoneBase ifTrue:
  ["It's a linked send; find which kind."
  self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
  [:targetMethod :sendTable|
  (self asserta: (targetMethod cmType = CMMethod
    or: [targetMethod cmType = CMClosedPIC
    or: [targetMethod cmType = CMOpenPIC]])) ifFalse:
  [^8]]]].
  ^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>generateRunTimeTrampolines (in category 'initialization') -----
  generateRunTimeTrampolines
  "Generate the run-time entries at the base of the native code zone and update the base."
 
  ceSendMustBeBooleanAddFalseTrampoline := self genMustBeBooleanTrampolineFor: objectMemory falseObject
  called: 'ceSendMustBeBooleanAddFalseTrampoline'.
  ceSendMustBeBooleanAddTrueTrampoline := self genMustBeBooleanTrampolineFor: objectMemory trueObject
  called: 'ceSendMustBeBooleanAddTrueTrampoline'.
  ceNonLocalReturnTrampoline := self genNonLocalReturnTrampoline.
  ceCheckForInterruptTrampoline := self genCheckForInterruptsTrampoline.
  "Neither of the context inst var access trampolines save registers.  Their operation could cause
  arbitrary update of stack frames, so the assumption is that callers flush the stack before calling
  the context inst var access trampolines, and that everything except the result is dead afterwards."
  ceFetchContextInstVarTrampoline := self genTrampolineFor: #ceContext:instVar:
  called: 'ceFetchContextInstVarTrampoline'
  arg: ReceiverResultReg
  arg: SendNumArgsReg
  result: SendNumArgsReg.
  ceStoreContextInstVarTrampoline := self genTrampolineFor: #ceContext:instVar:value:
  called: 'ceStoreContextInstVarTrampoline'
  arg: ReceiverResultReg
  arg: SendNumArgsReg
  arg: ClassReg
  result: ReceiverResultReg. "to keep ReceiverResultReg live.".
  ceCannotResumeTrampoline := self genTrampolineFor: #ceCannotResume
  called: 'ceCannotResumeTrampoline'.
  "These two are unusual; they are reached by return instructions."
  ceBaseFrameReturnTrampoline := self genReturnTrampolineFor: #ceBaseFrameReturn:
  called: 'ceBaseFrameReturnTrampoline'
  arg: ReceiverResultReg.
  ceReturnToInterpreterTrampoline := self
  genReturnTrampolineFor: #ceReturnToInterpreter:
  called: 'ceReturnToInterpreterTrampoline'
  arg: ReceiverResultReg.
  ceMallocTrampoline := self genTrampolineFor: #ceMalloc:
  called: 'ceMallocTrampoline'
  arg: ReceiverResultReg
  result: TempReg.
  ceFreeTrampoline := self genTrampolineFor: #ceFree:
  called: 'ceFreeTrampoline'
  arg: ReceiverResultReg.
+ LowcodeVM ifTrue: [
- self cppIf: LowcodeVM ifTrue: [
  ceFFICalloutTrampoline := self genFFICalloutTrampoline.
  ]!

Item was changed:
  ----- Method: Cogit>>incrementUsageOfTargetIfLinkedSend:mcpc:ignored: (in category 'compaction') -----
  incrementUsageOfTargetIfLinkedSend: annotation mcpc: mcpc ignored: superfluity
  <var: #mcpc type: #'char *'>
  <var: #nsSendCache type: #'NSSendCache *'>
  | entryPoint |
 
+ NewspeakVM ifTrue:
- self cppIf: NewspeakVM ifTrue:
  [annotation = IsNSSendCall ifTrue:
  [| nsSendCache |
  nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  nsSendCache classTag ~= objectRepresentation illegalClassTag ifTrue: "send is linked"
  [ | targetMethod |
  entryPoint := nsSendCache target.
  targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
  self assert: (self isPCWithinMethodZone: targetMethod).
  targetMethod cmUsageCount < (CMMaxUsageCount // 2) ifTrue:
  [targetMethod cmUsageCount: targetMethod cmUsageCount + 1]]]].
 
  (self isPureSendAnnotation: annotation) ifTrue:
  [self assert: annotation ~= IsNSSendCall.
  entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  entryPoint > methodZoneBase ifTrue: "It's a linked send."
  [self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
  [:targetMethod :sendTable|
  targetMethod cmUsageCount < (CMMaxUsageCount // 2) ifTrue:
  [targetMethod cmUsageCount: targetMethod cmUsageCount + 1]]]].
 
  ^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>markLiterals:pc:method: (in category 'garbage collection') -----
  markLiterals: annotation pc: mcpc method: cogMethod
  "Mark and trace literals.
  Additionally in Newspeak, void push implicits that have unmarked classes."
  <var: #mcpc type: #'char *'>
  <var: #nsSendCache type: #'NSSendCache *'>
  | literal |
  annotation = IsObjectReference ifTrue:
  [literal := literalsManager fetchLiteralAtAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
  (objectRepresentation
  markAndTraceLiteral: literal
  in: (self cCoerceSimple: cogMethod to: #'CogMethod *')
  atpc: mcpc asUnsignedInteger) ifTrue:
  [codeModified := true]].
 
+ NewspeakVM ifTrue:
- self cppIf: NewspeakVM ifTrue:
  [annotation = IsNSSendCall ifTrue:
  [| nsSendCache sel eo |
  nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  sel := nsSendCache selector.
  (objectMemory isForwarded: sel)
  ifFalse: [objectMemory markAndTrace: sel]
  ifTrue: [sel := objectMemory followForwarded: literal.
  nsSendCache selector: sel.
  self markAndTraceUpdatedLiteral: sel in: (self cCoerceSimple: cogMethod to: #'CogMethod *')].
  eo := nsSendCache enclosingObject.
  eo ~= 0 ifTrue:
  [(objectMemory isForwarded: eo)
  ifFalse: [objectMemory markAndTrace: eo]
  ifTrue: [eo := objectMemory followForwarded: literal.
  nsSendCache enclosingObject: eo.
  self markAndTraceUpdatedLiteral: eo in: (self cCoerceSimple: cogMethod to: #'CogMethod *')]]]].
 
  (self isPureSendAnnotation: annotation) ifTrue:
  [self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
  [:entryPoint :cacheTag :tagCouldBeObj |
  tagCouldBeObj ifTrue:
  [(objectRepresentation
  markAndTraceCacheTagLiteral: cacheTag
  in: (self cCoerceSimple: cogMethod to: #'CogMethod *')
  atpc: mcpc asUnsignedInteger) ifTrue:
  ["cacheTag is selector" codeModified := true]]]].
 
  ^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>markLiteralsAndUnlinkIfUnmarkedSend:pc:method: (in category 'garbage collection') -----
  markLiteralsAndUnlinkIfUnmarkedSend: annotation pc: mcpc method: cogMethod
  "Mark and trace literals.  Unlink sends that have unmarked cache tags or targets."
  <var: #mcpc type: #'char *'>
  <var: #nsSendCache type: #'NSSendCache *'>
  | literal |
  annotation = IsObjectReference ifTrue:
  [literal := literalsManager fetchLiteralAtAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
  (objectRepresentation
  markAndTraceLiteral: literal
  in: (self cCoerceSimple: cogMethod to: #'CogMethod *')
  atpc: mcpc asUnsignedInteger) ifTrue:
  [codeModified := true]].
 
+ NewspeakVM ifTrue:
- self cppIf: NewspeakVM ifTrue:
  [annotation = IsNSSendCall ifTrue:
  [| nsSendCache entryPoint targetMethod sel eo |
  nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  entryPoint := nsSendCache target.
  entryPoint ~= 0 ifTrue: "Send is linked"
  [targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
  (self markAndTraceOrFreeCogMethod: targetMethod
  firstVisit: targetMethod asUnsignedInteger > mcpc asUnsignedInteger) ifTrue:
  [self voidNSSendCache: nsSendCache]].
  sel := nsSendCache selector.
  (objectMemory isForwarded: sel)
  ifFalse: [objectMemory markAndTrace: sel]
  ifTrue: [sel := objectMemory followForwarded: literal.
  nsSendCache selector: sel.
  self markAndTraceUpdatedLiteral: sel in: (self cCoerceSimple: cogMethod to: #'CogMethod *')].
  eo := nsSendCache enclosingObject.
  eo ~= 0 ifTrue:
  [(objectMemory isForwarded: eo)
  ifFalse: [objectMemory markAndTrace: eo]
  ifTrue: [eo := objectMemory followForwarded: literal.
  nsSendCache enclosingObject: eo.
  self markAndTraceUpdatedLiteral: eo in: (self cCoerceSimple: cogMethod to: #'CogMethod *')]]]].
 
  (self isPureSendAnnotation: annotation) ifTrue:
  [self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
  [:entryPoint :cacheTag :tagCouldBeObj | | cacheTagMarked |
  cacheTagMarked := tagCouldBeObj and: [objectRepresentation cacheTagIsMarked: cacheTag].
  entryPoint > methodZoneBase
  ifTrue: "It's a linked send."
  [self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
  [:targetMethod :sendTable|
  (cacheTagMarked not
   or: [self markAndTraceOrFreeCogMethod: targetMethod
  firstVisit: targetMethod asUnsignedInteger > mcpc asUnsignedInteger]) ifTrue:
  ["Either the cacheTag is unmarked (e.g. new class) or the target
   has been freed (because it is unmarked), so unlink the send."
  self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable.
  objectRepresentation
  markAndTraceLiteral: targetMethod selector
  in: targetMethod
  at: (self addressOf: targetMethod selector put: [:val| targetMethod selector: val])]]]
  ifFalse:  "cacheTag is selector"
  [(objectRepresentation
  markAndTraceCacheTagLiteral: cacheTag
  in: (self cCoerceSimple: cogMethod to: #'CogMethod *')
  atpc: mcpc asUnsignedInteger) ifTrue:
  [codeModified := true]]]].
 
  ^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>markYoungObjects:pc:method: (in category 'garbage collection') -----
  markYoungObjects: annotation pc: mcpc method: cogMethod
  "Mark and trace young literals."
  <var: #mcpc type: #'char *'>
  <var: #nsSendCache type: #'NSSendCache *'>
  | literal |
  annotation = IsObjectReference ifTrue:
  [literal := literalsManager fetchLiteralAtAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
  objectRepresentation markAndTraceLiteralIfYoung: literal].
 
+ NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
- self cppIf: NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
  [| nsSendCache |
  nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  objectRepresentation markAndTraceLiteralIfYoung: nsSendCache selector.
  nsSendCache enclosingObject ~= 0 ifTrue:
  [objectRepresentation markAndTraceLiteralIfYoung: nsSendCache enclosingObject]]].
 
  (self isPureSendAnnotation: annotation) ifTrue:
  [self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
  [:entryPoint :cacheTag :tagCouldBeObj |
  tagCouldBeObj ifTrue:
  [objectRepresentation markAndTraceLiteralIfYoung: cacheTag]]].
 
  ^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>printPCMapPairsFor: (in category 'method map') -----
  printPCMapPairsFor: cogMethod
  <api>
  <var: 'cogMethod' type: #'CogMethod *'>
  <var: 'mapByte' type: #'unsigned char'>
  | mcpc map mapByte annotation value |
  mcpc := self firstMappedPCFor: cogMethod.
  map := self mapStartFor: cogMethod.
  [(mapByte := objectMemory byteAt: map) ~= MapEnd] whileTrue:
  [annotation := mapByte >> AnnotationShift.
  annotation = IsAnnotationExtension
  ifTrue:
  [value := (mapByte bitAnd: DisplacementMask) + IsSendCall]
  ifFalse:
  [value := annotation.
  mcpc := mcpc + (backEnd codeGranularity
  * (annotation = IsDisplacementX2N
  ifTrue: [mapByte - DisplacementX2N << AnnotationShift]
  ifFalse: [mapByte bitAnd: DisplacementMask]))].
  coInterpreter
  printHexnp: map;
  print: ': '.
  self
  cCode: [self print: '%02x' f: mapByte]
  inSmalltalk:
  [mapByte < 16 ifTrue:
  [coInterpreter putchar: $0].
  coInterpreter printHexnp: mapByte].
  coInterpreter
  printChar: $ ;
  printNum: annotation;
  print: ' ('.
+ NewspeakVM
- self cppIf: NewspeakVM
  ifTrue:
  [value
  caseOf: {
  [IsDisplacementX2N] -> [coInterpreter print: 'IsDisplacementX2N'].
  [IsAnnotationExtension] -> [coInterpreter print: 'IsAnnotationExtension'].
  [IsObjectReference] -> [coInterpreter print: 'IsObjectReference'].
  [IsAbsPCReference] -> [coInterpreter print: 'IsAbsPCReference'].
  [HasBytecodePC] -> [coInterpreter print: 'HasBytecodePC'].
  [IsRelativeCall] -> [coInterpreter print: 'IsRelativeCall'].
  [IsNSSendCall] -> [coInterpreter print: 'IsNSSendCall'].
  [IsSendCall] -> [coInterpreter print: 'IsSendCall'].
  [IsSuperSend] -> [coInterpreter print: 'IsSuperSend'].
  [IsDirectedSuperSend] -> [coInterpreter print: 'IsDirectedSuperSend'].
  [IsNSSelfSend] -> [coInterpreter print: 'IsNSSelfSend'].
  [IsNSDynamicSuperSend] -> [coInterpreter print: 'IsNSDynamicSuperSend'].
  [IsNSImplicitReceiverSend] -> [coInterpreter print: 'IsNSImplicitReceiverSend'] }
  otherwise: [coInterpreter print: '??? '; printHexnp: value]]
  ifFalse:
  [value
  caseOf: {
  [IsDisplacementX2N] -> [coInterpreter print: 'IsDisplacementX2N'].
  [IsAnnotationExtension] -> [coInterpreter print: 'IsAnnotationExtension'].
  [IsObjectReference] -> [coInterpreter print: 'IsObjectReference'].
  [IsAbsPCReference] -> [coInterpreter print: 'IsAbsPCReference'].
  [HasBytecodePC] -> [coInterpreter print: 'HasBytecodePC'].
  [IsRelativeCall] -> [coInterpreter print: 'IsRelativeCall'].
  [IsSendCall] -> [coInterpreter print: 'IsSendCall'].
  [IsSuperSend] -> [coInterpreter print: 'IsSuperSend'].
  [IsDirectedSuperSend] -> [coInterpreter print: 'IsDirectedSuperSend'] }
  otherwise: [coInterpreter print: '??? '; printHexnp: value]].
  coInterpreter
  print: ') ';
  printHexnp: (mapByte bitAnd: DisplacementMask);
  printChar: $ ;
  putchar: $@;
  printHex: mcpc;
  cr;
  flush.
  map := map - 1]!

Item was changed:
  ----- Method: Cogit>>relocateIfCallOrMethodReference:mcpc:delta: (in category 'compaction') -----
  relocateIfCallOrMethodReference: annotation mcpc: mcpc delta: refDelta
  <var: #mcpc type: #'char *'>
  | callDelta entryPoint targetMethod unlinkedRoutine |
  <var: #targetMethod type: #'CogMethod *'>
  <var: #nsSendCache type: #'NSSendCache *'>
 
  callDelta := backEnd zoneCallsAreRelative ifTrue: [refDelta] ifFalse: [0].
 
+ NewspeakVM ifTrue:
- self cppIf: NewspeakVM ifTrue:
  [| nsSendCache |
  annotation = IsNSSendCall ifTrue:
  ["Retrieve the send cache before relocating the stub call. Fetching the send
   cache asserts the stub call points below all the cogged methods, but
   until this method is actually moved, the adjusted stub call may appear to
   point to somewhere in the method zone."
  nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
 
  "Fix call to trampoline. This method is moving [delta] bytes, and calls are
  relative, so adjust the call by -[delta] bytes"
  backEnd relocateCallBeforeReturnPC: mcpc asInteger by: callDelta negated.
 
  nsSendCache target ~= 0 ifTrue: "Send is linked"
  [entryPoint := nsSendCache target.
  targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
  targetMethod cmType = CMMethod
  ifTrue: "send target not freed; just relocate. The cache has an absolute
  target, so only adjust by the target method's displacement."
  [nsSendCache target: entryPoint + targetMethod objectHeader]
  ifFalse: "send target was freed, unlink"
  [self voidNSSendCache: nsSendCache]].
  ^0]].
 
  (self isPureSendAnnotation: annotation) ifTrue:
  [entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  entryPoint <= methodZoneBase ifTrue: "send is not linked; just relocate"
  [backEnd relocateCallBeforeReturnPC: mcpc asInteger by: callDelta negated.
  ^0].
  "It's a linked send; find which kind."
  self
  offsetAndSendTableFor: entryPoint
  annotation: annotation
  into: [:offset :sendTable|
  targetMethod := self cCoerceSimple: entryPoint - offset to: #'CogMethod *'.
  targetMethod cmType ~= CMFree ifTrue: "send target not freed; just relocate."
  [backEnd
  relocateCallBeforeReturnPC: mcpc asInteger
  by: (callDelta - targetMethod objectHeader) negated.
  SistaVM ifTrue: "See comment in planCompaction"
  [methodZone restorePICUsageCount: targetMethod].
  ^0].
  "Target was freed; map back to an unlinked send; but include this method's reocation"
  unlinkedRoutine := sendTable at: (targetMethod cmNumArgs min: NumSendTrampolines - 1).
  unlinkedRoutine := unlinkedRoutine - callDelta.
  backEnd
  rewriteInlineCacheAt: mcpc asInteger
  tag: (self inlineCacheValueForSelector: targetMethod selector in: enumeratingCogMethod at: mcpc)
  target: unlinkedRoutine.
  ^0]].
 
  annotation = IsRelativeCall ifTrue:
  [backEnd relocateCallBeforeReturnPC: mcpc asInteger by: callDelta negated.
  ^0].
 
  annotation = IsAbsPCReference ifTrue:
  [backEnd relocateMethodReferenceBeforeAddress: mcpc asInteger by: refDelta].
 
  ^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>remapIfObjectRef:pc:hasYoung: (in category 'garbage collection') -----
  remapIfObjectRef: annotation pc: mcpc hasYoung: hasYoungPtr
  <var: #mcpc type: #'char *'>
  <var: #targetMethod type: #'CogMethod *'>
  <var: #nsSendCache type: #'NSSendCache *'>
  annotation = IsObjectReference ifTrue:
  [| literal mappedLiteral |
  literal := literalsManager fetchLiteralAtAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
  (objectRepresentation couldBeObject: literal) ifTrue:
  [mappedLiteral := objectRepresentation remapObject: literal.
  literal ~= mappedLiteral ifTrue:
  [literalsManager storeLiteral: mappedLiteral atAnnotatedAddress: mcpc asUnsignedInteger using: backEnd.
  codeModified := true].
  (hasYoungPtr ~= 0
   and: [objectMemory isYoung: mappedLiteral]) ifTrue:
  [(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]]].
 
+ NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
- self cppIf: NewspeakVM ifTrue: [annotation = IsNSSendCall ifTrue:
  [| nsSendCache oop mappedOop |
  nsSendCache := self nsSendCacheFromReturnAddress: mcpc.
  oop := nsSendCache selector.
  mappedOop := objectRepresentation remapObject: oop.
  oop ~= mappedOop ifTrue:
  [nsSendCache selector: mappedOop.
  (hasYoungPtr ~= 0 and: [objectMemory isYoung: mappedOop]) ifTrue:
  [(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]].
  oop := nsSendCache enclosingObject.
  oop ~= 0 ifTrue: [
  mappedOop := objectRepresentation remapObject: oop.
  oop ~= mappedOop ifTrue:
  [nsSendCache enclosingObject: mappedOop.
  (hasYoungPtr ~= 0 and: [objectMemory isYoung: mappedOop]) ifTrue:
  [(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]]].
  ^0 "keep scanning"]].
 
  (self isPureSendAnnotation: annotation) ifTrue:
  [self offsetCacheTagAndCouldBeObjectAt: mcpc annotation: annotation into:
  [:entryPoint :cacheTag :tagCouldBeObj | | mappedCacheTag |
  (tagCouldBeObj
   and: [objectRepresentation couldBeObject: cacheTag]) ifTrue:
  [mappedCacheTag := objectRepresentation remapObject: cacheTag.
  cacheTag ~= mappedCacheTag ifTrue:
  [backEnd rewriteInlineCacheTag: mappedCacheTag at: mcpc asUnsignedInteger.
  codeModified := true].
  (hasYoungPtr ~= 0
   and: [objectMemory isYoung: mappedCacheTag]) ifTrue:
  [(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]].
  hasYoungPtr ~= 0 ifTrue:
  ["Since the unlinking routines may rewrite the cacheTag to the send's selector, and
   since they don't have the cogMethod to hand and can't add it to youngReferrers,
   the method must remain in youngReferrers if the targetMethod's selector is young."
  entryPoint > methodZoneBase ifTrue: "It's a linked send."
  [self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
  [:targetMethod :ignored|
  (objectMemory isYoung: targetMethod selector) ifTrue:
  [(self cCoerceSimple: hasYoungPtr to: #'sqInt *') at: 0 put: true]]]]]].
  ^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>scanMethod (in category 'compile abstract instructions') -----
  scanMethod
  "Scan the method (and all embedded blocks) to determine
  - what the last bytecode is; extra bytes at the end of a method are used to encode things like source pointers or temp names
  - if the method needs a frame or not
  - what are the targets of any backward branches.
  - how many blocks it creates
  - if it contans an unknown bytecode
  Answer the block count or on error a negative error code"
  | latestContinuation nExts descriptor pc numBlocks distance targetPC framelessStackDelta |
  <var: #descriptor type: #'BytecodeDescriptor *'>
  needsFrame := false.
  NewspeakVM ifTrue:
  [numIRCs := 0].
  (primitiveIndex > 0
  and: [coInterpreter isQuickPrimitiveIndex: primitiveIndex]) ifTrue:
  [^0].
  pc := latestContinuation := initialPC.
  numBlocks := framelessStackDelta := nExts := extA := extB := 0.
  extBFirstZero := false.
  [pc <= endPC] whileTrue:
  [byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
  descriptor := self generatorAt: byte0.
  descriptor isExtension ifTrue:
  [descriptor opcode = Nop ifTrue: "unknown bytecode tag; see Cogit class>>#generatorTableFrom:"
  [^EncounteredUnknownBytecode].
  self loadSubsequentBytesForDescriptor: descriptor at: pc.
  self perform: descriptor generator].
  (descriptor isReturn
   and: [pc >= latestContinuation]) ifTrue:
  [endPC := pc].
  needsFrame ifFalse:
  [(descriptor needsFrameFunction isNil
   or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
  ifTrue: [needsFrame := true]
  ifFalse: [framelessStackDelta := framelessStackDelta + descriptor stackDelta]].
  descriptor isBranch ifTrue:
  [distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
  targetPC := pc + descriptor numBytes + distance.
  (self isBackwardBranch: descriptor at: pc exts: nExts in: methodObj)
  ifTrue: [self initializeFixupAt: targetPC - initialPC]
  ifFalse: [latestContinuation := latestContinuation max: targetPC]].
  descriptor isBlockCreation ifTrue:
  [numBlocks := numBlocks + 1.
  distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
  targetPC := pc + descriptor numBytes + distance.
  latestContinuation := latestContinuation max: targetPC].
+ NewspeakVM ifTrue:
- self cppIf: NewspeakVM ifTrue:
  [descriptor hasIRC ifTrue:
  [numIRCs := numIRCs + 1]].
  pc := pc + descriptor numBytes.
  descriptor isExtension
  ifTrue: [nExts := nExts + 1]
  ifFalse: [nExts := extA := extB := 0]].
  ^numBlocks!

Item was changed:
  ----- Method: Cogit>>unlinkIfFreeOrLinkedSend:pc:of: (in category 'in-line cacheing') -----
  unlinkIfFreeOrLinkedSend: annotation pc: mcpc of: theSelector
  <var: #mcpc type: #'char *'>
  <var: #nsSendCache type: #'NSSendCache *'>
  | entryPoint |
 
+ NewspeakVM ifTrue:
- self cppIf: NewspeakVM ifTrue:
  [| nsSendCache |
  annotation = IsNSSendCall ifTrue:
  [nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  (entryPoint := nsSendCache target) ~= 0 ifTrue:
  [ | targetMethod |
  targetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
  (targetMethod cmType = CMFree or: [nsSendCache selector = theSelector]) ifTrue:
  [self voidNSSendCache: nsSendCache]].
  ^0 "keep scanning"]].
 
  (self isPureSendAnnotation: annotation) ifTrue:
  [entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  entryPoint > methodZoneBase
  ifTrue: "It's a linked send."
  [self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
  [:targetMethod :sendTable|
  (targetMethod cmType = CMFree
   or: [targetMethod selector = theSelector]) ifTrue:
  [self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable]]]].
 
  ^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>unlinkIfInvalidClassSend:pc:ignored: (in category 'in-line cacheing') -----
  unlinkIfInvalidClassSend: annotation pc: mcpc ignored: superfluity
  <var: #mcpc type: #'char *'>
  <var: #nsSendCache type: #'NSSendCache *'>
  | entryPoint |
 
+ NewspeakVM ifTrue:
- self cppIf: NewspeakVM ifTrue:
  [| nsSendCache |
  annotation = IsNSSendCall ifTrue:
  [nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  (nsSendCache classTag ~= objectRepresentation illegalClassTag
   and: [objectMemory isForwardedClassIndex: nsSendCache classTag]) ifTrue:
  [self voidNSSendCache: nsSendCache]].
  "Should we check if the enclosing object's class is forwarded as well?"
  ^0 "keep scanning"].
 
  (self isPureSendAnnotation: annotation) ifTrue:
  [entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  entryPoint > methodZoneBase ifTrue: "It's a linked send, but maybe a super send or linked to an OpenPIC, in which case the cache tag will be a selector...."
  [self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
  [:targetMethod :sendTable|
  ((self annotationIsForUncheckedEntryPoint: annotation)
   or: [targetMethod cmType = CMOpenPIC]) ifFalse:
  [(objectMemory isValidClassTag: (backEnd inlineCacheTagAt: mcpc asInteger)) ifFalse:
  [self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable]]]]].
 
  ^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>unlinkIfLinkedSend:pc:ignored: (in category 'in-line cacheing') -----
  unlinkIfLinkedSend: annotation pc: mcpc ignored: superfluity
  <var: #mcpc type: #'char *'>
  <var: #nsSendCache type: #'NSSendCache *'>
  | entryPoint |
 
+ NewspeakVM ifTrue:
- self cppIf: NewspeakVM ifTrue:
  [| nsSendCache |
  annotation = IsNSSendCall ifTrue:
  [nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  nsSendCache classTag ~= objectRepresentation illegalClassTag ifTrue: "Send is linked"
  [self voidNSSendCache: nsSendCache].
  ^0 "keep scanning"]].
 
  (self isPureSendAnnotation: annotation) ifTrue:
  [entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  entryPoint > methodZoneBase
  ifTrue: "It's a linked send."
  [self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
  [:targetMethod :sendTable|
  self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable]]].
 
  ^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>unlinkIfLinkedSend:pc:of: (in category 'in-line cacheing') -----
  unlinkIfLinkedSend: annotation pc: mcpc of: theSelector
  <var: #mcpc type: #'char *'>
  <var: #nsSendCache type: #'NSSendCache *'>
  | entryPoint |
 
+ NewspeakVM ifTrue:
- self cppIf: NewspeakVM ifTrue:
  [| nsSendCache |
  annotation = IsNSSendCall ifTrue:
  [nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  nsSendCache selector = theSelector ifTrue:
  [self voidNSSendCache: nsSendCache].
  ^0 "keep scanning"]].
 
  (self isPureSendAnnotation: annotation) ifTrue:
  [entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  entryPoint > methodZoneBase
  ifTrue: "It's a linked send."
  [self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
  [:targetMethod :sendTable|
  targetMethod selector = theSelector ifTrue:
  [self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable]]]].
 
  ^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>unlinkIfLinkedSend:pc:to: (in category 'in-line cacheing') -----
  unlinkIfLinkedSend: annotation pc: mcpc to: theCogMethod
  <var: #mcpc type: #'char *'>
  <var: #nsSendCache type: #'NSSendCache *'>
  | entryPoint |
 
+ NewspeakVM ifTrue:
- self cppIf: NewspeakVM ifTrue:
  [| nsSendCache |
  annotation = IsNSSendCall ifTrue:
  [nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  (entryPoint := nsSendCache target) ~= 0 ifTrue:
  [ | targetMethod |
  targetMethod := entryPoint - cmNoCheckEntryOffset.
  targetMethod = theCogMethod ifTrue:
  [self voidNSSendCache: nsSendCache]].
  ^0 "keep scanning"]].
 
  (self isPureSendAnnotation: annotation) ifTrue:
  [entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  entryPoint > methodZoneBase
  ifTrue: "It's a linked send."
  [self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
  [:targetMethod :sendTable|
  targetMethod asInteger = theCogMethod ifTrue:
  [self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable]]]].
 
  ^0 "keep scanning"!

Item was changed:
  ----- Method: Cogit>>unlinkIfLinkedSendToFree:pc:ignored: (in category 'in-line cacheing') -----
  unlinkIfLinkedSendToFree: annotation pc: mcpc ignored: superfluity
  <var: #mcpc type: #'char *'>
  <var: #nsSendCache type: #'NSSendCache *'>
  <var: #nsTargetMethod type: #'CogMethod *'>
  | entryPoint |
 
+ NewspeakVM ifTrue:
- self cppIf: NewspeakVM ifTrue:
  [| nsSendCache nsTargetMethod |
  annotation = IsNSSendCall ifTrue:
  [nsSendCache := self nsSendCacheFromReturnAddress: mcpc asInteger.
  (entryPoint := nsSendCache target) ~= 0 ifTrue: "It's a linked send."
  [nsTargetMethod := self cCoerceSimple: entryPoint - cmNoCheckEntryOffset to: #'CogMethod *'.
  nsTargetMethod cmType = CMFree ifTrue:
  [self voidNSSendCache: nsSendCache]].
  ^0 "keep scanning"]].
 
  (self isPureSendAnnotation: annotation) ifTrue:
  [entryPoint := backEnd callTargetFromReturnAddress: mcpc asInteger.
  entryPoint > methodZoneBase ifTrue: "It's a linked send."
  [self targetMethodAndSendTableFor: entryPoint annotation: annotation into:
  [:targetMethod :sendTable|
  targetMethod cmType = CMFree ifTrue:
  [self unlinkSendAt: mcpc targetMethod: targetMethod sendTable: sendTable]]]].
 
  ^0 "keep scanning"!

Item was changed:
  ----- Method: StackInterpreter>>callPrimitiveBytecode (in category 'miscellaneous bytecodes') -----
  callPrimitiveBytecode
  "V4: 249 11111001 i i i i i i i i jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)
  SistaV1: 248 11111000 iiiiiiii mjjjjjjj Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution.
  V3/Spur: 139 10001011 i i i i i i i i jjjjjjjj Call Primitive #iiiiiiii + (jjjjjjjj * 256)"
  "Note that we simply skip a callPrimitiveBytecode at the start of a method
  that contains a primitive.  This because methods like Context(Part)>>reset
  have to be updated to skip the callPrimtiive bytecode otherwise."
+ SistaVM
- self cppIf: SistaVM
  ifTrue:
  [| byte1 byte2 prim primSet header |
  byte1 := self fetchByte.
  byte2 := self fetchByte.
  self fetchNextBytecode.
  byte2 < 128 ifTrue:
  [header := objectMemory methodHeaderOf: method.
  ((self methodHeaderHasPrimitive: header)
   and: [localIP asUnsignedInteger
  = (self initialPCForHeader: header method: method) + (self sizeOfCallPrimitiveBytecode: header)]) ifTrue:
  [^self].
  localIP := localIP - 3.
  ^self respondToUnknownBytecode].
  prim := byte2 - 128 << 8 + byte1.
  primSet := prim >> 13 bitAnd: 3.
  prim := prim bitAnd: 8191.
  primSet = 0 ifTrue: [
 
  prim < 1000 ifTrue:
  [^self nullaryInlinePrimitive: prim].
 
  prim < 2000 ifTrue:
  [^self unaryInlinePrimitive: prim - 1000].
 
  prim < 3000 ifTrue:
  [^self binaryInlinePrimitive: prim - 2000].
 
  prim < 4000 ifTrue:
  [^self trinaryInlinePrimitive: prim - 3000].
  ].
 
+ LowcodeVM ifTrue: [
- self cppIf: LowcodeVM
- ifTrue: [
  primSet = 1 ifTrue: [
  prim < 1000 ifTrue:
  [^self lowcodeNullaryInlinePrimitive: prim].
 
  prim < 2000 ifTrue:
  [^self lowcodeUnaryInlinePrimitive: prim - 1000].
 
  prim < 3000 ifTrue:
  [^self lowcodeBinaryInlinePrimitive: prim - 2000].
 
  prim < 4000 ifTrue:
  [^self lowcodeTrinaryInlinePrimitive: prim - 3000].
  ].
  ].
 
  localIP := localIP - 3.
  ^self respondToUnknownBytecode]
  ifFalse:
  [| header |
  header := objectMemory methodHeaderOf: method.
  ((self methodHeaderHasPrimitive: header)
   and: [localIP asInteger = (self initialPCForHeader: header method: method)])
  ifTrue:
  [localIP := localIP + (self sizeOfCallPrimitiveBytecode: header) - 1.
  ^self fetchNextBytecode]
  ifFalse:
  [^self respondToUnknownBytecode]]!

Item was changed:
  ----- Method: StackInterpreter>>commonCallerReturn (in category 'return bytecodes') -----
  commonCallerReturn
  "Return to the previous context/frame (sender for method activations, caller for block activations)."
  <sharedCodeInCase: #returnTopFromBlock>
  | callersFPOrNull doWeHaveANativeFrame |
  <var: #callersFPOrNull type: #'char *'>
 
  "TODO: Store/restore the nativeSP more properly, when it exists"
+ LowcodeVM ifTrue: [
- self cppIf: LowcodeVM ifTrue: [
  doWeHaveANativeFrame := self frameHasNativeFrame: localFP.
  doWeHaveANativeFrame ifTrue: [
  nativeStackPointer := (self nativePreviousStackPointerIn: localFP) - 1.
  nativeSP := 0.
  self setFrameHasNotNativeFrame: localFP.
  ].
  ].
 
  callersFPOrNull := self frameCallerFP: localFP.
  callersFPOrNull == 0 "baseFrame" ifTrue:
  [self assert: localFP = stackPage baseFP.
  ^self baseFrameReturn].
 
  localIP := self frameCallerSavedIP: localFP.
  localSP := localFP + (self frameStackedReceiverOffset: localFP).
  localFP := callersFPOrNull.
  self setMethod: (self frameMethod: localFP).
  self fetchNextBytecode.
  self internalStackTopPut: localReturnValue!

Item was changed:
  ----- Method: StackInterpreter>>initializeInterpreter: (in category 'initialization') -----
  initializeInterpreter: bytesToShift
  "Initialize Interpreter state before starting execution of a new image."
  interpreterProxy := self sqGetInterpreterProxy.
  self dummyReferToProxy.
  objectMemory initializeObjectMemory: bytesToShift.
  self checkAssumedCompactClasses.
  self initializeExtraClassInstVarIndices.
  method := newMethod := objectMemory nilObject.
  self cCode: '' inSmalltalk:
  [breakSelectorLength ifNil:
  [breakSelectorLength := objectMemory minSmallInteger]].
  methodDictLinearSearchLimit := 8.
  self initialCleanup.
+ LowcodeVM ifTrue: [ self setupNativeStack ].
- self cppIf: LowcodeVM ifTrue: [ self setupNativeStack ].
  profileSemaphore := profileProcess := profileMethod := objectMemory nilObject.
  interruptKeycode := 2094. "cmd-. as used for Mac but no other OS"
  [globalSessionID = 0] whileTrue:
  [globalSessionID := self
  cCode: [(self time: #NULL) + self ioMSecs]
  inSmalltalk: [(Random new next * SmallInteger maxVal) asInteger]]!

Item was changed:
  ----- Method: StackInterpreter>>internalizeIPandSP (in category 'utilities') -----
  internalizeIPandSP
  "Copy the instruction, stack and frame pointers to local variables for rapid access within the interpret loop."
 
  localIP := self pointerForOop: instructionPointer.
  localSP := self pointerForOop: stackPointer.
  localFP := self pointerForOop: framePointer.
+ LowcodeVM ifTrue: [ nativeSP := 0. ]!
- self cppIf: LowcodeVM ifTrue: [ nativeSP := 0. ]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>ensureFixupAt: (in category 'compile abstract instructions') -----
  ensureFixupAt: targetIndex
  "Make sure there's a flagged fixup at the targetIndex (pc relative to first pc) in fixups.
  Initially a fixup's target is just a flag.  Later on it is replaced with a proper instruction."
  <returnTypeC: #'BytecodeFixup *'>
  | fixup |
  <var: #fixup type: #'BytecodeFixup *'>
  fixup := self fixupAt: targetIndex.
  self traceFixup: fixup.
  self cCode: '' inSmalltalk:
  [self assert: simStackPtr = (self debugStackPointerFor: targetIndex + initialPC).
  (fixup isMergeFixupOrIsFixedUp
   and: [fixup isBackwardBranchFixup not]) ifTrue: "ignore backward branch targets"
  [self assert: fixup simStackPtr = simStackPtr]].
  fixup isNonMergeFixupOrNotAFixup
  ifTrue: "convert a non-merge into a merge"
  [fixup becomeMergeFixup.
  fixup simStackPtr: simStackPtr.
+ LowcodeVM ifTrue: [
- self cppIf: LowcodeVM ifTrue: [
  fixup simNativeStackPtr: simNativeStackPtr.
  fixup simNativeStackSize: simNativeStackSize.]]
  ifFalse:
  [fixup isBackwardBranchFixup
  ifTrue: ["this is the target of a backward branch and
  so doesn't have a simStackPtr assigned yet."
  fixup simStackPtr: simStackPtr.
+ LowcodeVM ifTrue: [
- self cppIf: LowcodeVM ifTrue: [
  fixup simNativeStackPtr: simNativeStackPtr.
  fixup simNativeStackSize: simNativeStackSize.]]
  ifFalse: [
  self assert: fixup simStackPtr = simStackPtr.
+ LowcodeVM ifTrue: [
- self cppIf: LowcodeVM ifTrue: [
  self assert: fixup simNativeStackPtr = simNativeStackPtr.
  self assert: fixup simNativeStackSize = simNativeStackSize.]]].
  ^fixup!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genCallPrimitiveBytecode (in category 'bytecode generators') -----
  genCallPrimitiveBytecode
  "SistaV1: 248 11111000 iiiiiiii mjjjjjjj Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution.
  See EncoderForSistaV1's class comment and StackInterpreter>>#inlinePrimitiveBytecode:"
  | prim primSet |
  byte2 < 128 ifTrue:
  [^bytecodePC = initialPC
  ifTrue: [0]
  ifFalse: [EncounteredUnknownBytecode]].
  prim := byte2 - 128 << 8 + byte1.
  primSet := prim >> 13 bitAnd: 3.
  prim := prim bitAnd: 8191.
+ LowcodeVM
- self cppIf: LowcodeVM
  ifTrue:
  [
  primSet = 1 ifTrue: [
  prim < 1000 ifTrue:
  [^self genLowcodeNullaryInlinePrimitive: prim].
 
  prim < 2000 ifTrue:
  [^self genLowcodeUnaryInlinePrimitive: prim - 1000].
 
  prim < 3000 ifTrue:
  [^ self genLowcodeBinaryInlinePrimitive: prim - 2000].
 
  prim < 4000 ifTrue:
  [^self genLowcodeTrinaryInlinePrimitive: prim - 3000].
  ]
  ].
 
  ^EncounteredUnknownBytecode!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genUpArrowReturn (in category 'bytecode generators') -----
  genUpArrowReturn
  "Generate a method return from within a method or a block.
  Frameless method activation looks like
  CISCs (x86):
  receiver
  args
  sp-> ret pc.
  RISCs (ARM):
  receiver
  args
  ret pc in LR.
  A fully framed activation is described in CoInterpreter class>initializeFrameIndices.
  Return pops receiver and arguments off the stack.  Callee pushes the result."
  | framelessReturn |
  deadCode := true. "can't fall through"
  inBlock > 0 ifTrue:
  [self assert: needsFrame.
  self CallRT: ceNonLocalReturnTrampoline.
  self annotateBytecode: self Label.
  ^0].
  self
  cppIf: IMMUTABILITY
  ifTrue: [framelessReturn := needsFrame and: [useTwoPaths not]]
  ifFalse: [framelessReturn := needsFrame].
  framelessReturn
  ifTrue:
  [
+ LowcodeVM ifTrue: [ hasNativeFrame ifTrue: [ self leaveNativeFrame ] ].
- self cppIf: LowcodeVM ifTrue: [ hasNativeFrame ifTrue: [ self leaveNativeFrame ] ].
  self MoveR: FPReg R: SPReg.
  self PopR: FPReg.
  backEnd hasLinkRegister ifTrue:
  [self PopR: LinkReg].
  self RetN: methodOrBlockNumArgs + 1 * objectMemory wordSize]
  ifFalse:
  [self RetN: ((methodOrBlockNumArgs > self numRegArgs
  "A method with an interpreter prim will push its register args for the prim.  If the failure
  body is frameless the args must still be popped, see e.g. Behavior>>nextInstance."
  or: [regArgsHaveBeenPushed])
  ifTrue: [methodOrBlockNumArgs + 1 * objectMemory wordSize]
  ifFalse: [0])].
  ^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>initSimStackForFramefulMethod: (in category 'simulation stack') -----
  initSimStackForFramefulMethod: startpc
  <var: #desc type: #'CogSimStackEntry *'>
  simSelf
  type: SSBaseOffset;
  spilled: true;
  register: FPReg;
  offset: FoxMFReceiver.
  optStatus
  isReceiverResultRegLive: false;
  ssEntry: (self addressOf: simSelf).
  simSpillBase := methodOrBlockNumTemps. "N.B. Includes num args"
  simStackPtr := simSpillBase - 1.
+ LowcodeVM ifTrue: [
- self cppIf: LowcodeVM ifTrue: [
  simNativeSpillBase := simNativeStackPtr := -1.
  simNativeStackSize := 0.
  ].
  "args"
  0 to: methodOrBlockNumArgs - 1 do:
  [:i| | desc |
  desc := self simStackAt: i.
  desc
  type: SSBaseOffset;
  spilled: true;
  register: FPReg;
  offset: FoxCallerSavedIP + ((methodOrBlockNumArgs - i) * objectMemory wordSize);
  bcptr: startpc].
  "temps"
  methodOrBlockNumArgs to: simStackPtr do:
  [:i| | desc |
  desc := self simStackAt: i.
  desc
  type: SSBaseOffset;
  spilled: true;
  register: FPReg;
  offset: FoxMFReceiver - (i - methodOrBlockNumArgs + 1 * objectMemory wordSize);
  bcptr: startpc]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>initSimStackForFramelessBlock: (in category 'simulation stack') -----
  initSimStackForFramelessBlock: startpc
  "The register receiver (the closure itself) and args are pushed by the closure value primitive(s)
  and hence a frameless block has all arguments and copied values pushed to the stack.  However,
  the method receiver (self) is put in the ReceiverResultRegister by the block entry."
  | desc |
  <var: #desc type: #'CogSimStackEntry *'>
  simSelf
  type: SSRegister;
  spilled: false;
  register: ReceiverResultReg.
  optStatus
  isReceiverResultRegLive: true;
  ssEntry: (self addressOf: simSelf).
  self assert: methodOrBlockNumTemps >= methodOrBlockNumArgs.
  0 to: methodOrBlockNumTemps - 1 do:
  [:i|
  desc := self simStackAt: i.
  desc
  type: SSBaseOffset;
  spilled: true;
  register: SPReg;
  offset: ((backEnd hasLinkRegister
  ifTrue: [methodOrBlockNumArgs - 1- i]
  ifFalse: [methodOrBlockNumArgs - i]) * objectMemory wordSize);
  bcptr: startpc].
  simSpillBase := simStackPtr := methodOrBlockNumTemps - 1.
+ LowcodeVM ifTrue: [
- self cppIf: LowcodeVM ifTrue: [
  simNativeSpillBase := simNativeStackPtr := -1.
  simNativeStackSize := 0.
  ].!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>initSimStackForFramelessMethod: (in category 'simulation stack') -----
  initSimStackForFramelessMethod: startpc
  | desc |
  <var: #desc type: #'CogSimStackEntry *'>
  simSelf
  type: SSRegister;
  spilled: false;
  register: ReceiverResultReg.
  optStatus
  isReceiverResultRegLive: true;
  ssEntry: (self addressOf: simSelf).
  self assert: methodOrBlockNumTemps = methodOrBlockNumArgs.
  self assert: self numRegArgs <= 2.
  (methodOrBlockNumArgs between: 1 and: self numRegArgs)
  ifTrue:
  [desc := self simStackAt: 0.
  desc
  type: SSRegister;
  spilled: false;
  register: Arg0Reg;
  bcptr: startpc.
  methodOrBlockNumArgs > 1 ifTrue:
  [desc := self simStackAt: 1.
  desc
  type: SSRegister;
  spilled: false;
  register: Arg1Reg;
  bcptr: startpc]]
  ifFalse:
  [0 to: methodOrBlockNumArgs - 1 do:
  [:i|
  desc := self simStackAt: i.
  desc
  type: SSBaseOffset;
  register: SPReg;
  spilled: true;
  offset: ((backEnd hasLinkRegister
  ifTrue: [methodOrBlockNumArgs - 1- i]
  ifFalse: [methodOrBlockNumArgs - i]) * objectMemory wordSize);
  bcptr: startpc]].
  simSpillBase := simStackPtr := methodOrBlockNumArgs - 1.
+ LowcodeVM ifTrue: [
- self cppIf: LowcodeVM ifTrue: [
  simNativeSpillBase := simNativeStackPtr := -1.
  simNativeStackSize := 0.
  ].!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>liveFloatRegisters (in category 'simulation stack') -----
  liveFloatRegisters
  | regsSet |
  regsSet := 0.
  (simSpillBase max: 0) to: simStackPtr do:
  [:i|
  regsSet := regsSet bitOr: (self simStackAt: i) floatRegisterMask].
+ LowcodeVM ifTrue: [
- self cppIf: LowcodeVM ifTrue: [
  (simNativeSpillBase max: 0) to: simNativeStackPtr do:
  [:i|
  regsSet := regsSet bitOr: (self simNativeStackAt: i) nativeFloatRegisterMask].
  ].
  ^regsSet!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>liveRegisters (in category 'simulation stack') -----
  liveRegisters
  | regsSet |
  needsFrame
  ifTrue: [regsSet := 0]
  ifFalse:
  [regsSet := self registerMaskFor: ReceiverResultReg.
  (methodOrBlockNumArgs <= self numRegArgs
   and: [methodOrBlockNumArgs > 0]) ifTrue:
  [regsSet := regsSet bitOr: (self registerMaskFor: Arg0Reg).
  (self numRegArgs > 1 and: [methodOrBlockNumArgs > 1]) ifTrue:
  [regsSet := regsSet bitOr: (self registerMaskFor: Arg1Reg)]]].
  (simSpillBase max: 0) to: simStackPtr do:
  [:i|
  regsSet := regsSet bitOr: (self simStackAt: i) registerMask].
+ LowcodeVM ifTrue: [
- self cppIf: LowcodeVM ifTrue: [
  (simNativeSpillBase max: 0) to: simNativeStackPtr do:
  [:i|
  regsSet := regsSet bitOr: (self simNativeStackAt: i) nativeRegisterMask].
  ].
  ^regsSet!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>mergeWithFixupIfRequired: (in category 'simulation stack') -----
  mergeWithFixupIfRequired: fixup
  "If this bytecode has a fixup, some kind of merge needs to be done. There are 4 cases:
  1) the bytecode has no fixup (fixup isNotAFixup)
  do nothing
  2) the bytecode has a non merge fixup
  the fixup has needsNonMergeFixup.
  The code generating non merge fixup (currently only special selector code) is responsible
  for the merge so no need to do it.
  We set deadCode to false as the instruction can be reached from jumps.
  3) the bytecode has a merge fixup, but execution flow *cannot* fall through to the merge point.
  the fixup has needsMergeFixup and deadCode = true.
  ignores the current simStack as it does not mean anything
  restores the simStack to the state the jumps to the merge point expects it to be.
  4) the bytecode has a merge fixup and execution flow *can* fall through to the merge point.
  the fixup has needsMergeFixup and deadCode = false.
  flushes the stack to the stack pointer so the fall through execution path simStack is
  in the state the merge point expects it to be.
  restores the simStack to the state the jumps to the merge point expects it to be.
 
  In addition, if this is a backjump merge point, we patch the fixup to hold the current simStackPtr
  for later assertions."
 
  <var: #fixup type: #'BytecodeFixup *'>
  "case 1"
  fixup notAFixup ifTrue: [^ 0].
 
  "case 2"
  fixup isNonMergeFixup ifTrue: [deadCode := false. ^ 0 ].
 
  "cases 3 and 4"
  self assert: fixup isMergeFixup.
  self traceMerge: fixup.
  deadCode ifTrue: [
  "case 3"
  simStackPtr := fixup simStackPtr.
+ LowcodeVM ifTrue: [
- self cppIf: LowcodeVM ifTrue: [
  simNativeStackPtr := fixup simNativeStackPtr.
  simNativeStackSize := fixup simNativeStackSize.
  ]
  ] ifFalse: [
  "case 4"
  self ssFlushTo: simStackPtr
  ].
 
  "cases 3 and 4"
  deadCode := false.
  fixup isBackwardBranchFixup ifTrue: [
  fixup simStackPtr: simStackPtr.
+ LowcodeVM ifTrue: [
- self cppIf: LowcodeVM ifTrue: [
  fixup simNativeStackPtr: simNativeStackPtr.
  fixup simNativeStackSize: simNativeStackSize.
  ]
  ].
  fixup targetInstruction: self Label.
  self assert: simStackPtr = fixup simStackPtr.
+ LowcodeVM ifTrue: [
- self cppIf: LowcodeVM ifTrue: [
  self assert: simNativeStackPtr = fixup simNativeStackPtr.
  self assert: simNativeStackSize = fixup simNativeStackSize.
  ].
 
  self cCode: '' inSmalltalk:
  [self assert: fixup simStackPtr = (self debugStackPointerFor: bytecodePC)].
  self restoreSimStackAtMergePoint: fixup.
 
  ^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>restoreSimStackAtMergePoint: (in category 'simulation stack') -----
  restoreSimStackAtMergePoint: fixup
  <inline: true>
  "All the execution paths reaching a merge point expect everything to be
  spilled on stack and the optStatus is unknown. Throw away all simStack and
  optStatus optimization state."
  simSpillBase := methodOrBlockNumTemps.
  optStatus isReceiverResultRegLive: false.
  methodOrBlockNumTemps to: simStackPtr do:
  [:i|
  (self simStackAt: i)
  type: SSSpill;
  offset: FoxMFReceiver - (i - methodOrBlockNumArgs + 1 * objectMemory bytesPerOop);
  register: FPReg;
  spilled: true].
+ LowcodeVM ifTrue: [
- self cppIf: LowcodeVM ifTrue: [
  0 to: simNativeStackPtr do: [ :i |
  (self simNativeStackAt: i)
  ensureIsMarkedAsSpilled
  ].
  simNativeSpillBase := simNativeStackPtr + 1
  ].
  ^ 0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>scanBlock: (in category 'compile abstract instructions') -----
  scanBlock: blockStart
  "Scan the block to determine if the block needs a frame or not"
  | descriptor pc end framelessStackDelta nExts pushingNils numPushNils |
  <var: #blockStart type: #'BlockStart *'>
  <var: #descriptor type: #'BytecodeDescriptor *'>
  needsFrame := false.
+ LowcodeVM ifTrue: [ hasNativeFrame := false ].
- self cppIf: LowcodeVM ifTrue: [ hasNativeFrame := false ].
  prevBCDescriptor := nil.
  methodOrBlockNumArgs := blockStart numArgs.
  inBlock := InVanillaBlock.
  pc := blockStart startpc.
  end := blockStart startpc + blockStart span.
  framelessStackDelta := nExts := extA := extB := 0.
  extBFirstZero := false.
  pushingNils := true.
  [pc < end] whileTrue:
  [byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
  descriptor := self generatorAt: byte0.
  descriptor isExtension ifTrue:
  [self loadSubsequentBytesForDescriptor: descriptor at: pc.
  self perform: descriptor generator].
  needsFrame ifFalse:
  [(descriptor needsFrameFunction isNil
   or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
  ifTrue: [needsFrame := true]
  ifFalse: [framelessStackDelta := framelessStackDelta + descriptor stackDelta]].
  objectRepresentation maybeNoteDescriptor: descriptor blockStart: blockStart.
  (pushingNils
   and: [descriptor isExtension not]) ifTrue:
  ["Count the initial number of pushed nils acting as temp initializers.  We can't tell
   whether an initial pushNil is an operand reference or a temp initializer, except
   when the pushNil is a jump target (has a fixup), which never happens:
  self systemNavigation browseAllSelect:
  [:m| | ebc |
  (ebc := m embeddedBlockClosures
  select: [:ea| ea decompile statements first isMessage]
  thenCollect: [:ea| ea decompile statements first selector]) notEmpty
  and: [(#(whileTrue whileFalse whileTrue: whileFalse:) intersection: ebc) notEmpty]]
   or if the bytecode set has a push multiple nils bytecode.  We simply count initial nils.
   Rarely we may end up over-estimating.  We will correct by checking the stack depth
   at the end of the block in compileBlockBodies."
  (numPushNils := self numPushNils: descriptor pc: pc nExts: nExts method: methodObj) > 0
  ifTrue:
  [self assert: (descriptor numBytes = 1
  or: [descriptor generator == #genPushClosureTempsBytecode]).
  blockStart numInitialNils: blockStart numInitialNils + numPushNils]
  ifFalse:
  [pushingNils := false]].
  pc := self nextBytecodePCFor: descriptor at: pc exts: nExts in: methodObj.
  descriptor isExtension
  ifTrue: [nExts := nExts + 1]
  ifFalse: [nExts := extA := extB := 0].
  prevBCDescriptor := descriptor].
  "It would be nice of this wasn't necessary but alas we need to do the eager
  scan for frameless methods so that we don't end up popping too much off
  the simulated stack, e.g. for pushNil; returnTopFromBlock methods."
  needsFrame ifFalse:
  [self assert: (framelessStackDelta >= 0 and: [blockStart numInitialNils >= framelessStackDelta]).
  blockStart numInitialNils: blockStart numInitialNils - framelessStackDelta].
  ^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>scanMethod (in category 'compile abstract instructions') -----
  scanMethod
  "Scan the method (and all embedded blocks) to determine
  - what the last bytecode is; extra bytes at the end of a method are used to encode things like source pointers or temp names
  - if the method needs a frame or not
  - what are the targets of any backward branches.
  - how many blocks it creates
  Answer the block count or on error a negative error code"
  | latestContinuation nExts descriptor pc numBlocks distance targetPC framelessStackDelta seenInstVarStore |
  <var: #descriptor type: #'BytecodeDescriptor *'>
  needsFrame := useTwoPaths := seenInstVarStore := false.
+ LowcodeVM ifTrue: [ hasNativeFrame := false ].
- self cppIf: LowcodeVM ifTrue: [ hasNativeFrame := false ].
  self maybeInitNumFixups.
  self maybeInitNumCounters.
  prevBCDescriptor := nil.
  NewspeakVM ifTrue:
  [numIRCs := 0].
  (primitiveIndex > 0
  and: [coInterpreter isQuickPrimitiveIndex: primitiveIndex]) ifTrue:
  [^0].
  pc := latestContinuation := initialPC.
  numBlocks := framelessStackDelta := nExts := extA := extB := 0.
  extBFirstZero := false.
  [pc <= endPC] whileTrue:
  [byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
  descriptor := self generatorAt: byte0.
  descriptor isExtension ifTrue:
  [descriptor opcode = Nop ifTrue: "unknown bytecode tag; see Cogit class>>#generatorTableFrom:"
  [^EncounteredUnknownBytecode].
  self loadSubsequentBytesForDescriptor: descriptor at: pc.
  self perform: descriptor generator].
  (descriptor isReturn
   and: [pc >= latestContinuation]) ifTrue:
  [endPC := pc].
 
   needsFrame ifFalse:
  [(descriptor needsFrameFunction isNil
   or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
  ifTrue:
  ["With immutability we win simply by avoiding a frame build if the receiver is young and not immutable."
  self cppIf: IMMUTABILITY
  ifTrue: [descriptor is1ByteInstVarStore
  ifTrue: [useTwoPaths := true]
  ifFalse: [needsFrame := true. useTwoPaths := false]]
  ifFalse: [needsFrame := true. useTwoPaths := false]]
  ifFalse:
  [framelessStackDelta := framelessStackDelta + descriptor stackDelta.
  "Without immutability we win if there are two or more stores and the receiver is new."
  self cppIf: IMMUTABILITY
  ifTrue: []
  ifFalse:
  [descriptor is1ByteInstVarStore ifTrue:
  [seenInstVarStore
  ifTrue: [useTwoPaths := true]
  ifFalse: [seenInstVarStore := true]]]]].
 
  descriptor isBranch ifTrue:
  [distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
  targetPC := pc + descriptor numBytes + distance.
  (self isBackwardBranch: descriptor at: pc exts: nExts in: methodObj)
  ifTrue: [self initializeFixupAt: targetPC - initialPC]
  ifFalse:
  [latestContinuation := latestContinuation max: targetPC.
  self maybeCountFixup.
  self maybeCountCounter]].
  descriptor isBlockCreation ifTrue:
  [numBlocks := numBlocks + 1.
  distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
  targetPC := pc + descriptor numBytes + distance.
  latestContinuation := latestContinuation max: targetPC.
  self maybeCountFixup].
 
  NewspeakVM ifTrue:
  [descriptor hasIRC ifTrue:
  [numIRCs := numIRCs + 1]].
  pc := pc + descriptor numBytes.
  descriptor isExtension
  ifTrue: [nExts := nExts + 1]
  ifFalse: [nExts := extA := extB := 0].
  prevBCDescriptor := descriptor].
  ^numBlocks!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>ssAllocateRequiredFloatRegMask:upThrough:upThroughNative: (in category 'simulation stack') -----
  ssAllocateRequiredFloatRegMask: requiredRegsMask upThrough: stackPtr upThroughNative: nativeStackPtr
  | lastRequired lastRequiredNative liveRegs |
  lastRequired := -1.
  lastRequiredNative := -1.
  "compute live regs while noting the last occurrence of required regs.
  If these are not free we must spill from simSpillBase to last occurrence.
  Note we are conservative here; we could allocate FPReg in frameless methods."
  liveRegs := NoReg.
  (simSpillBase max: 0) to: stackPtr do:
  [:i|
  liveRegs := liveRegs bitOr: (self simStackAt: i) registerMask.
  ((self simStackAt: i) floatRegisterMask bitAnd: requiredRegsMask) ~= 0 ifTrue:
  [lastRequired := i]].
+ LowcodeVM ifTrue: [
- self cppIf: LowcodeVM ifTrue: [
  (simNativeSpillBase max: 0) to: nativeStackPtr do:
  [:i|
  liveRegs := liveRegs bitOr: (self simNativeStackAt: i) nativeRegisterMask.
  ((self simNativeStackAt: i) floatRegisterMask bitAnd: requiredRegsMask) ~= 0 ifTrue:
  [lastRequiredNative := i]].
  ].
 
  "If any of requiredRegsMask are live we must spill."
  (liveRegs bitAnd: requiredRegsMask) = 0 ifFalse:
  ["Some live, must spill"
  self ssFlushTo: lastRequired nativeFlushTo: lastRequiredNative.
  self assert: (self liveFloatRegisters bitAnd: requiredRegsMask) = 0]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>ssAllocateRequiredRegMask:upThrough:upThroughNative: (in category 'simulation stack') -----
  ssAllocateRequiredRegMask: requiredRegsMask upThrough: stackPtr upThroughNative: nativeStackPtr
  | lastRequired lastRequiredNative liveRegs |
  lastRequired := -1.
  lastRequiredNative := -1.
  "compute live regs while noting the last occurrence of required regs.
  If these are not free we must spill from simSpillBase to last occurrence.
  Note we are conservative here; we could allocate FPReg in frameless methods."
  liveRegs := self registerMaskFor: FPReg and: SPReg.
  (simSpillBase max: 0) to: stackPtr do:
  [:i|
  liveRegs := liveRegs bitOr: (self simStackAt: i) registerMask.
  ((self simStackAt: i) registerMask bitAnd: requiredRegsMask) ~= 0 ifTrue:
  [lastRequired := i]].
+ LowcodeVM ifTrue: [
- self cppIf: LowcodeVM ifTrue: [
  (simNativeSpillBase max: 0) to: nativeStackPtr do:
  [:i|
  liveRegs := liveRegs bitOr: (self simNativeStackAt: i) nativeRegisterMask.
  ((self simNativeStackAt: i) nativeRegisterMask bitAnd: requiredRegsMask) ~= 0 ifTrue:
  [lastRequiredNative := i]].
  ].
  "If any of requiredRegsMask are live we must spill."
  (liveRegs bitAnd: requiredRegsMask) = 0 ifFalse:
  ["Some live, must spill"
  self ssFlushTo: lastRequired nativeFlushTo: lastRequiredNative.
  self assert: (self liveRegisters bitAnd: requiredRegsMask) = 0]!

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

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>ssFlushUpThroughReceiverVariable: (in category 'simulation stack') -----
  ssFlushUpThroughReceiverVariable: slotIndex
  "Any occurrences on the stack of the value being stored (which is the top of stack)
  must be flushed, and hence any values colder than them stack."
  <var: #desc type: #'CogSimStackEntry *'>
+ LowcodeVM ifTrue: [ self ssNativeFlushTo: simNativeStackPtr. ].
- self cppIf: LowcodeVM ifTrue: [ self ssNativeFlushTo: simNativeStackPtr. ].
  self ssFlushUpThrough:
  [ :desc |  
  desc type = SSBaseOffset
  and: [desc register = ReceiverResultReg
  and: [desc offset = (objectRepresentation slotOffsetOfInstVarIndex: slotIndex) ] ] ]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>ssFlushUpThroughRegister: (in category 'simulation stack') -----
  ssFlushUpThroughRegister: reg
  "Any occurrences on the stack of the register must be
  flushed, and hence any values colder than them stack."
  <var: #desc type: #'CogSimStackEntry *'>
+ LowcodeVM ifTrue: [ self ssNativeFlushTo: simNativeStackPtr ].
- self cppIf: LowcodeVM ifTrue: [ self ssNativeFlushTo: simNativeStackPtr ].
  self ssFlushUpThrough: [ :desc | desc type = SSRegister and: [ desc register = reg ] ]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>ssFlushUpThroughTemporaryVariable: (in category 'simulation stack') -----
  ssFlushUpThroughTemporaryVariable: tempIndex
  "Any occurrences on the stack of the value being stored (which is the top of stack)
  must be flushed, and hence any values colder than them stack."
  <var: #desc type: #'CogSimStackEntry *'>
+ LowcodeVM ifTrue: [ self ssNativeFlushTo: simNativeStackPtr ].
- self cppIf: LowcodeVM ifTrue: [ self ssNativeFlushTo: simNativeStackPtr ].
  self ssFlushUpThrough:
  [ :desc |
  desc type = SSBaseOffset
  and: [desc register = FPReg
  and: [desc offset = (self frameOffsetOfTemporary: tempIndex) ] ] ]!

Item was changed:
  ----- Method: VMClass class>>initializeMiscConstants (in category 'initialization') -----
  initializeMiscConstants
  "Falsify the `what type of VM is this?' flags that are defined in the various interp.h files.
  Subclass implementations need to include a super initializeMiscConstants"
 
  | omc |
  VMBIGENDIAN class. "Mention this for the benefit of CCodeGenerator>>emitCConstantsOn:"
  SPURVM := STACKVM := COGVM := COGMTVM := false.
 
  initializationOptions ifNil: [self initializationOptions: Dictionary new].
  omc := initializationOptions at: #ObjectMemory ifAbsent: nil.
  (omc isNil and: [self defaultObjectMemoryClass notNil]) ifTrue:
  [omc := initializationOptions at: #ObjectMemory put: self defaultObjectMemoryClass name].
  initializationOptions
  at: #SqueakV3ObjectMemory "the good ole default"
  ifAbsentPut: (omc
  ifNil: [true]
  ifNotNil: [(Smalltalk at: omc) includesBehavior: ObjectMemory]);
  at: #SpurObjectMemory "the new contender"
  ifAbsentPut: (omc
  ifNil: [false]
  ifNotNil: [(Smalltalk at: omc) includesBehavior: SpurMemoryManager]).
 
  "Use ifAbsentPut: so that they will get copied back to the
  VMMaker's options and dead code will likely be eliminated."
  PharoVM := initializationOptions at: #PharoVM ifAbsentPut: [false].
  NewspeakVM := initializationOptions at: #NewspeakVM ifAbsentPut: [false].
  SistaVM := initializationOptions at: #SistaVM ifAbsentPut: [false].
  LowcodeVM := initializationOptions at: #LowcodeVM ifAbsentPut: [false].
+ MULTIPLEBYTECODESETS := initializationOptions at: #MULTIPLEBYTECODESETS ifAbsentPut: [false].
  "But not these; they're compile-time"
- MULTIPLEBYTECODESETS := initializationOptions at: #MULTIPLEBYTECODESETS ifAbsent: [false].
  IMMUTABILITY := initializationOptions at: #IMMUTABILITY ifAbsent: [false].
 
  "These must be set only if specified, not defaulted, because they are set on the command line or in include files."
  initializationOptions
  at: #VMBIGENDIAN ifPresent: [:value| VMBIGENDIAN := value];
  at: #ObjectMemory ifPresent: [:value| SPURVM := value beginsWith: 'Spur'];
  at: #STACKVM ifPresent: [:value| STACKVM := value];
  at: #COGVM ifPresent: [:value| COGVM := initializationOptions at: #COGVM];
  at: #COGMTVM ifPresent: [:value| COGMTVM := initializationOptions at: #COGMTVM]!

Item was changed:
  ----- Method: VMMaker class>>generateSqueakSpurCog64VM (in category 'configurations') -----
  generateSqueakSpurCog64VM
  "No primitives since we can use those for the Cog VM"
  ^VMMaker
  generate: CoInterpreter
  and: StackToRegisterMappingCogit
+ with: #(ObjectMemory Spur64BitCoMemoryManager
+ MULTIPLEBYTECODESETS true
+ bytecodeTableInitializer initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid)
- with: #(ObjectMemory Spur64BitCoMemoryManager)
  to: (FileDirectory default pathFromURI: self sourceTree, '/spur64src')
  platformDir: (FileDirectory default pathFromURI: self sourceTree, '/platforms')
  including:#()!

Item was changed:
  ----- Method: VMMaker class>>generateSqueakSpurStack64VM (in category 'configurations') -----
  generateSqueakSpurStack64VM
  "No primitives since we can use those from the Cog VM"
  ^VMMaker
  generate: StackInterpreter
  with: #(ObjectMemory Spur64BitMemoryManager
+ FailImbalancedPrimitives false
+ MULTIPLEBYTECODESETS true
+ bytecodeTableInitializer initializeBytecodeTableForSqueakV3PlusClosuresSistaV1Hybrid)
- FailImbalancedPrimitives false)
  to: (FileDirectory default pathFromURI: self sourceTree, '/spurstack64src')
  platformDir: (FileDirectory default pathFromURI: self sourceTree, '/platforms')
  including: #()!