VM Maker: VMMaker.oscog-eem.2730.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.2730.mcz

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

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

Name: VMMaker.oscog-eem.2730
Author: eem
Time: 20 March 2020, 1:44:08.110458 pm
UUID: 7bdafef9-a92d-4d1d-b0c5-5008cb285687
Ancestors: VMMaker.oscog-eem.2729

Cogit:
Refactor the compilation breakpoints so they don't take a selector length.  Leave it up to CoInterpeeter to derive the byte length of the selector using numBytesOf:.  Hence no longer mark lengthOf: as <api>.

Use a writable method when setting cpicHasMNUCase: in cogExtendPIC:CaseNMethod:tag:isMNUCase:.  ARMv8 is getting there...

Slang: do constant folding in left and right shifts.

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

Item was changed:
  ----- Method: CCodeGenerator>>generateShiftLeft:on:indent: (in category 'C translation') -----
  generateShiftLeft: msgNode on: aStream indent: level
  "Generate a C bitShift.  If the receiver type is unsigned avoid C99 undefined behaviour of
  left shifting negative values (what?!!?!!? such quiche eating idiocy to treat this like anything
  other than a truncated left shift) by casting signed receiver types to unsigned and back.
  If we can determine the result would overflow the word size, cast to a long integer."
  | rcvr arg castToLong type mustCastBackToSign mustCastToUnsigned canSuffixTheConstant typeIsUnsigned |
+ (self generateAsConstantExpression: msgNode on: aStream) ifTrue:
+ [^self].
  rcvr := msgNode receiver.
  arg := msgNode args first.
  castToLong := false.
  (rcvr constantNumbericValueIfAtAllPossibleOrNilIn: self) ifNotNil:
  [:rcvrVal |
  (arg constantNumbericValueIfAtAllPossibleOrNilIn: self)
  ifNil: [castToLong := vmClass notNil and: [vmClass objectMemoryClass wordSize = 8]]
  ifNotNil:
  [:argVal |
  | valueBeyondInt |
  valueBeyondInt := 1 bitShift: 32. "The default type of const << N is int."
  castToLong := rcvrVal < valueBeyondInt
   and: [(rcvrVal bitShift: argVal) >= valueBeyondInt]]].
  canSuffixTheConstant := rcvr isConstant and: [rcvr name isEmpty and: [rcvr value >= 0]].
  canSuffixTheConstant ifTrue:
  [aStream nextPutAll: (self cLiteralForUnsignedInteger: rcvr value longlong: castToLong).
  aStream nextPutAll: ' << '.
  self emitCExpression: arg on: aStream indent: level.
  ^self].
  type := self typeFor: rcvr in: currentMethod.
  castToLong := castToLong and: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong)].
  typeIsUnsigned := type first = $u.
  mustCastToUnsigned := typeIsUnsigned not
  or: [castToLong
  or: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqInt)]].
  mustCastBackToSign := typeIsUnsigned not.
  mustCastBackToSign ifTrue:
  [| promotedType |
  promotedType := castToLong
  ifTrue: [#sqLong]
  ifFalse: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #sqInt)
  ifTrue: [#sqInt]
  ifFalse: [type]].
  aStream nextPutAll: '(('; nextPutAll: promotedType; nextPut: $)].
  mustCastToUnsigned ifTrue:
  [| unsigned |
  unsigned := castToLong
  ifTrue: [#usqLong]
  ifFalse: [(self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong)
  ifTrue: [#usqInt]
  ifFalse: [self unsignedTypeForIntegralType: type]].
  aStream nextPutAll: '(('; nextPutAll: unsigned; nextPutAll: ')('].
  self emitCExpression: rcvr on: aStream indent: level.
  mustCastToUnsigned ifTrue: [aStream nextPut: $)].
 
  aStream nextPutAll: ' << '.
  self emitCExpression: arg on: aStream indent: level.
 
  mustCastToUnsigned ifTrue: [aStream nextPut: $)].
+ mustCastBackToSign ifTrue: [aStream nextPut: $)]!
- mustCastBackToSign ifTrue: [aStream nextPut: $)].!

Item was changed:
  ----- Method: CCodeGenerator>>generateShiftRight:on:indent: (in category 'C translation') -----
  generateShiftRight: msgNode on: aStream indent: level
  "Generate the C code for this message onto the given stream.
  Note that this generates a Logical Shift (unsigned), not an Arithmetic Shift (signed)."
 
+ | type typeIsSigned mustCastToUnsigned unsignedType |
+ (self generateAsConstantExpression: msgNode on: aStream) ifTrue:
+ [^self].
- | type typeIsUnsigned mustCastToUnsigned unsignedType |
  type := self typeFor: msgNode receiver in: currentMethod.
+ typeIsSigned := type first ~= $u.
+ mustCastToUnsigned := typeIsSigned or:
- typeIsUnsigned := type first = $u.
- mustCastToUnsigned := typeIsUnsigned not or:
  ["cast to usqInt if the int is shorter: we want to avoid UB related to a shift exceeeding bit width"
  (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqInt)].
  "If not unsigned cast it to unsigned."
  mustCastToUnsigned
  ifTrue:
  ["If the variable is a 64-bit type then don't cast it to usqInt (typically a 32-bit type)"
  unsignedType := (self sizeOfIntegralCType: type) < (self sizeOfIntegralCType: #usqLong)
  ifTrue: [#usqInt]
  ifFalse: [self unsignedTypeForIntegralType: type].
  aStream nextPutAll: '(('; nextPutAll: unsignedType; nextPutAll: ')('.
  self emitCExpression: msgNode receiver on: aStream indent: level.
  aStream nextPutAll: '))']
  ifFalse:
  [aStream nextPutAll: '('.
  self emitCExpression: msgNode receiver on: aStream indent: level.
  aStream nextPut: $)].
  aStream nextPutAll: ' >> '.
  self emitCExpression: msgNode args first on: aStream indent: level!

Item was removed:
- ----- Method: CoInterpreter>>compilationBreak:point:classTag:isMNUCase: (in category 'debug support') -----
- compilationBreak: selectorOop point: selectorLength classTag: classTag isMNUCase: isMNUCase
- <api>
- <cmacro: '(sel, len, classTag, isMNU) do { \
- if ((len) == (isMNU ? -breakSelectorLength : breakSelectorLength) \
- && !!strncmp((char *)((sel) + BaseHeaderSize), breakSelector, (isMNU ? -breakSelectorLength : breakSelectorLength))) { \
- suppressHeartbeatFlag = 1; \
- compilationBreakpointFor(sel); \
- } \
- } while (0)'>
- | bsl i |
- isMNUCase
- ifTrue:
- [(breakSelectorLength = 18 "doesNotUnderastand: size"
-  and: [(self strncmp: 'doesNotUnderstand:' _: breakSelector _: 18) == 0]) ifTrue:
- [(breakLookupClassTag < 0 or: [breakLookupClassTag = classTag]) ifTrue:
- [^self compilationBreakpointFor: selectorOop]].
- bsl := breakSelectorLength negated]
- ifFalse: [bsl := breakSelectorLength].
- bsl = selectorLength ifTrue:
- [i := bsl.
- [i > 0] whileTrue:
- [(objectMemory byteAt: selectorOop + i + objectMemory baseHeaderSize - 1) = (breakSelector at: i) asInteger
- ifTrue:
- [((i := i - 1) = 0
-   and: [breakLookupClassTag < 0 or: [breakLookupClassTag = classTag]]) ifTrue:
- [self compilationBreakpointFor: selectorOop]]
- ifFalse: [i := 0]]]!

Item was removed:
- ----- Method: CoInterpreter>>compilationBreak:point:isMNUCase: (in category 'debug support') -----
- compilationBreak: selectorOop point: selectorLength isMNUCase: isMNUCase
- <api>
- <cmacro: '(sel, len, isMNU) do { \
- if ((len) == (isMNU ? -breakSelectorLength : breakSelectorLength) \
- && !!strncmp((char *)((sel) + BaseHeaderSize), breakSelector, (isMNU ? -breakSelectorLength : breakSelectorLength))) { \
- suppressHeartbeatFlag = 1; \
- compilationBreakpointFor(sel); \
- } \
- } while (0)'>
- | bsl i |
- bsl := isMNUCase ifTrue: [breakSelectorLength negated] ifFalse: [breakSelectorLength].
- bsl = selectorLength ifTrue:
- [i := bsl.
- [i > 0] whileTrue:
- [(objectMemory byteAt: selectorOop + i + objectMemory baseHeaderSize - 1) = (breakSelector at: i) asInteger
- ifTrue: [(i := i - 1) = 0 ifTrue:
- [self compilationBreakpointFor: selectorOop]]
- ifFalse: [i := 0]]]!

Item was added:
+ ----- Method: CoInterpreter>>compilationBreakpoint:classTag:isMNUCase: (in category 'debug support') -----
+ compilationBreakpoint: selectorOop classTag: classTag isMNUCase: isMNUCase
+ <api>
+ <cmacro: '(sel, classTag, isMNU) do { \
+ if (numBytesOf(sel) == (isMNU ? -breakSelectorLength : breakSelectorLength) \
+ && !!strncmp((char *)((sel) + BaseHeaderSize), breakSelector, (isMNU ? -breakSelectorLength : breakSelectorLength))) { \
+ suppressHeartbeatFlag = 1; \
+ compilationBreakpointFor(sel); \
+ } \
+ } while (0)'>
+ | bsl i |
+ isMNUCase
+ ifTrue:
+ [(breakSelectorLength = 18 "doesNotUnderstand: size"
+  and: [(self strncmp: 'doesNotUnderstand:' _: breakSelector _: 18) == 0]) ifTrue:
+ [(breakLookupClassTag < 0 or: [breakLookupClassTag = classTag]) ifTrue:
+ [^self compilationBreakpointFor: selectorOop]].
+ bsl := breakSelectorLength negated]
+ ifFalse: [bsl := breakSelectorLength].
+ bsl = (self numBytesOf: selectorOop) ifTrue:
+ [i := bsl.
+ [i > 0] whileTrue:
+ [(objectMemory byteAt: selectorOop + i + objectMemory baseHeaderSize - 1) = (breakSelector at: i) asInteger
+ ifTrue:
+ [((i := i - 1) = 0
+   and: [breakLookupClassTag < 0 or: [breakLookupClassTag = classTag]]) ifTrue:
+ [self compilationBreakpointFor: selectorOop]]
+ ifFalse: [i := 0]]]!

Item was added:
+ ----- Method: CoInterpreter>>compilationBreakpoint:isMNUCase: (in category 'debug support') -----
+ compilationBreakpoint: selectorOop isMNUCase: isMNUCase
+ <api>
+ <cmacro: '(sel, isMNU) do { \
+ if (numBytesOf(sel) == (isMNU ? -breakSelectorLength : breakSelectorLength) \
+ && !!strncmp((char *)((sel) + BaseHeaderSize), breakSelector, (isMNU ? -breakSelectorLength : breakSelectorLength))) { \
+ suppressHeartbeatFlag = 1; \
+ compilationBreakpointFor(sel); \
+ } \
+ } while (0)'>
+ | bsl i |
+ bsl := isMNUCase ifTrue: [breakSelectorLength negated] ifFalse: [breakSelectorLength].
+ bsl = (self numBytesOf: selectorOop) ifTrue:
+ [i := bsl.
+ [i > 0] whileTrue:
+ [(objectMemory byteAt: selectorOop + i + objectMemory baseHeaderSize - 1) = (breakSelector at: i) asInteger
+ ifTrue: [(i := i - 1) = 0 ifTrue:
+ [self compilationBreakpointFor: selectorOop]]
+ ifFalse: [i := 0]]]!

Item was changed:
  ----- Method: Cogit>>cog:selector: (in category 'jit - api') -----
  cog: aMethodObj selector: aSelectorOop
  "Attempt to produce a machine code method for the bytecode method
  object aMethodObj.  N.B. If there is no code memory available do *NOT*
  attempt to reclaim the method zone.  Certain clients (e.g. ceSICMiss:)
  depend on the zone remaining constant across method generation."
  <api>
  <returnTypeC: #'CogMethod *'>
  | selector cogMethod |
  <var: #cogMethod type: #'CogMethod *'>
  (self exclude: aMethodObj selector: aSelectorOop) ifTrue:
  [^nil].
  "In Newspeak we support anonymous accessors and hence tolerate the same
  method being cogged multiple times.  But only if the method class association is nil."
  NewspeakVM
  ifTrue:
  [(coInterpreter methodHasCogMethod: aMethodObj) ifTrue:
  [cogMethod := coInterpreter cogMethodOf: aMethodObj.
  self deny: cogMethod selector = aSelectorOop.
  cogMethod selector = aSelectorOop ifTrue:
  [^cogMethod].
  (coInterpreter methodClassAssociationOf: aMethodObj) ~= objectMemory nilObject ifTrue:
  [self cCode: 'extern void *firstIndexableField(sqInt)'. "Slang, au natural"
  self warnMultiple: cogMethod selectors: aSelectorOop.
  ^nil]]]
  ifFalse: [self deny: (coInterpreter methodHasCogMethod: aMethodObj)].
  self deny: (objectMemory isOopCompiledMethod: (coInterpreter ultimateLiteralOf: aMethodObj)).
  selector := aSelectorOop = objectMemory nilObject
  ifTrue: [coInterpreter maybeSelectorOfMethod: aMethodObj]
  ifFalse: [aSelectorOop].
  "coInterpreter stringOf: selector"
  selector ifNotNil:
+ [coInterpreter compilationBreakpoint: selector isMNUCase: false].
- [coInterpreter
- compilationBreak: selector
- point: (objectMemory lengthOf: selector)
- isMNUCase: false].
  aMethodObj = breakMethod ifTrue: [self halt: 'Compilation of breakMethod'].
  NewspeakVM ifTrue:
  [cogMethod := methodZone findPreviouslyCompiledVersionOf: aMethodObj with: aSelectorOop.
  cogMethod ifNotNil:
  [(coInterpreter methodHasCogMethod: aMethodObj) not ifTrue:
  [self assert: (coInterpreter rawHeaderOf: aMethodObj) = cogMethod methodHeader.
  cogMethod methodObject: aMethodObj.
  coInterpreter rawHeaderOf: aMethodObj put: cogMethod asInteger].
  ^cogMethod]].
  "If the generators for the alternate bytecode set are missing then interpret."
  (coInterpreter methodUsesAlternateBytecodeSet: aMethodObj)
  ifTrue:
  [(self numElementsIn: generatorTable) <= 256 ifTrue:
  [^nil].
  bytecodeSetOffset := 256]
  ifFalse:
  [bytecodeSetOffset := 0].
  objectRepresentation ensureNoForwardedLiteralsIn: aMethodObj.
  methodObj := aMethodObj.
  methodHeader := objectMemory methodHeaderOf: aMethodObj.
  receiverTags := objectMemory receiverTagBitsForMethod: methodObj.
  cogMethod := self compileCogMethod: aSelectorOop.
  (cogMethod asInteger between: MaxNegativeErrorCode and: -1) ifTrue:
  [cogMethod asInteger = InsufficientCodeSpace ifTrue:
  [coInterpreter callForCogCompiledCodeCompaction].
  self maybeFreeCounters.
  "Right now no errors should be reported, so nothing more to do."
  "self reportError: (self cCoerceSimple: cogMethod to: #sqInt)."
  ^nil].
  "self cCode: ''
  inSmalltalk:
  [coInterpreter printCogMethod: cogMethod.
  ""coInterpreter symbolicMethod: aMethodObj.""
  self assertValidMethodMap: cogMethod."
  "self disassembleMethod: cogMethod."
  "printInstructions := clickConfirm := true""]."
  ^cogMethod!

Item was changed:
  ----- Method: Cogit>>cogExtendPIC:CaseNMethod:tag:isMNUCase: (in category 'in-line cacheing') -----
  cogExtendPIC: cPIC CaseNMethod: caseNMethod tag: caseNTag isMNUCase: isMNUCase
  "Extend the cPIC with the supplied case.  If caseNMethod is cogged dispatch direct to
  its unchecked entry-point.  If caseNMethod is not cogged, jump to the fast interpreter
  dispatch, and if isMNUCase then dispatch to fast MNU invocation and mark the cPIC as
  having the MNU case for cache flushing."
    <var: #cPIC type: #'CogMethod *'>
  | operand target address |
 
+ coInterpreter compilationBreakpoint: cPIC selector classTag: caseNTag isMNUCase: isMNUCase.
- coInterpreter
- compilationBreak: cPIC selector
- point: (objectMemory numBytesOf: cPIC selector)
- classTag: caseNTag
- isMNUCase: isMNUCase.
 
  self assert: (objectRepresentation inlineCacheTagIsYoung: caseNTag) not.
  "Caller patches to open pic if caseNMethod is young."
  self assert: (caseNMethod notNil and: [(objectMemory isYoung: caseNMethod) not]).
  (isMNUCase not and: [coInterpreter methodHasCogMethod: caseNMethod])
  ifTrue: "this isn't an MNU and we have an already cogged method to jump to"
  [operand := 0.
  target := (coInterpreter cogMethodOf: caseNMethod) asInteger + cmNoCheckEntryOffset]
  ifFalse:
  [operand := caseNMethod.
  isMNUCase
  ifTrue: "this is an MNU so tag the CPIC header and setup a jump to the MNUAbort"
+ [(self writableMethodFor: cPIC) cpicHasMNUCase: true.
- [cPIC cpicHasMNUCase: true.
  target := cPIC asInteger + (self sizeof: CogMethod)]
  ifFalse: "setup a jump to the interpretAborth so we can cog the target method"
  [target := cPIC asInteger + self picInterpretAbortOffset]].
 
  "find the end address of the new case"
  address := self addressOfEndOfCase: cPIC cPICNumCases +1 inCPIC: cPIC.
 
  self rewriteCPICCaseAt: address tag: caseNTag objRef: operand target: target.
 
  "finally, rewrite the jump 3 instr  before firstCPICCaseOffset to jump to the beginning of this new case"
  self rewriteCPIC: cPIC caseJumpTo: address - cPICCaseSize.
 
  "This also implicitly flushes the read/write mapped dual zone to the read/execute zone."
  backEnd flushICacheFrom: cPIC asUnsignedInteger to: cPIC asUnsignedInteger + closedPICSize.
  "update the header flag for the number of cases"
  (self writableMethodFor: cPIC) cPICNumCases: cPIC cPICNumCases + 1.
  self assertValidDualZoneFrom: cPIC asUnsignedInteger to: cPIC asUnsignedInteger + closedPICSize!

Item was changed:
  ----- Method: Cogit>>cogMNUPICSelector:receiver:methodOperand:numArgs: (in category 'in-line cacheing') -----
  cogMNUPICSelector: selector receiver: rcvr methodOperand: methodOperand numArgs: numArgs
  <api>
  "Attempt to create a one-case PIC for an MNU.
  The tag for the case is at the send site and so doesn't need to be generated."
  <returnTypeC: #'CogMethod *'>
  | startAddress writablePIC actualPIC |
  ((objectMemory isYoung: selector)
  or: [(objectRepresentation inlineCacheTagForInstance: rcvr) = self picAbortDiscriminatorValue]) ifTrue:
  [^0].
+ coInterpreter compilationBreakpoint: selector classTag: (objectMemory fetchClassTagOf: rcvr) isMNUCase: true.
- coInterpreter
- compilationBreak: selector
- point: (objectMemory numBytesOf: selector)
- classTag: (objectMemory fetchClassTagOf: rcvr)
- isMNUCase: true.
  self assert: endCPICCase0 notNil.
 
  "get memory in the code zone for the CPIC; if that fails we return an error code for the sender to use to work out how to blow up"
  startAddress := methodZone allocate: closedPICSize.
  startAddress = 0 ifTrue:
  [coInterpreter callForCogCompiledCodeCompaction.
  ^0].
  self maybeBreakGeneratingFrom: startAddress to: startAddress + closedPICSize - 1.
 
  writablePIC := self writableMethodFor: startAddress.
  "memcpy the prototype across to our allocated space; because anything else would be silly"
  self codeMemcpy: writablePIC _: cPICPrototype _: closedPICSize.
 
  self
  fillInCPICHeader: writablePIC
  numArgs: numArgs
  numCases: 1
  hasMNUCase: true
  selector: selector.
 
  self configureMNUCPIC: (actualPIC := self cCoerceSimple: startAddress to: #'CogMethod *')
  methodOperand: methodOperand
  numArgs: numArgs
  delta: startAddress - cPICPrototype asUnsignedInteger.
 
  "This also implicitly flushes the read/write mapped dual zone to the read/execute zone."
  backEnd flushICacheFrom: startAddress to: startAddress + closedPICSize.
 
  self assert: (backEnd callTargetFromReturnAddress: startAddress + missOffset) = (self picAbortTrampolineFor: numArgs).
  self assertValidDualZoneFrom: startAddress to: startAddress + closedPICSize.
 
  ^actualPIC!

Item was changed:
  ----- Method: Cogit>>cogOpenPICSelector:numArgs: (in category 'in-line cacheing') -----
  cogOpenPICSelector: selector numArgs: numArgs
  "Create an Open PIC.  Temporarily create a direct call of ceSendFromOpenPIC:.
  Should become a probe of the first-level method lookup cache followed by a
  call of ceSendFromOpenPIC: if the probe fails."
  <returnTypeC: #'CogMethod *'>
  | startAddress codeSize mapSize end |
+ coInterpreter compilationBreakpoint: selector isMNUCase: false.
- coInterpreter
- compilationBreak: selector
- point: (objectMemory numBytesOf: selector)
- isMNUCase: false.
  startAddress := methodZone allocate: openPICSize.
  startAddress = 0 ifTrue:
  [^self cCoerceSimple: InsufficientCodeSpace to: #'CogMethod *'].
  methodLabel
  address: startAddress;
  dependent: nil.
  "stack allocate the various collections so that they
  are effectively garbage collected on return."
  self allocateOpcodes: 100 bytecodes: 0.
  self compileOpenPIC: selector numArgs: numArgs.
  self computeMaximumSizes.
  methodLabel concretizeAt: startAddress.
  codeSize := self generateInstructionsAt: startAddress + (self sizeof: CogMethod).
  mapSize := self generateMapAt: startAddress + openPICSize - 1 start: startAddress + cmNoCheckEntryOffset.
  self assert: entry address - startAddress = cmEntryOffset.
  self assert: (methodZone roundUpLength: (self sizeof: CogMethod) + codeSize) + (methodZone roundUpLength: mapSize) <= openPICSize.
  end := self outputInstructionsAt: startAddress + (self sizeof: CogMethod).
  self
  fillInOPICHeader: (self writableMethodFor: startAddress)
  numArgs: numArgs
  selector: selector.
  ^self cCoerceSimple: startAddress to: #'CogMethod *'!

Item was changed:
  ----- Method: Cogit>>cogPICSelector:numArgs:Case0Method:Case1Method:tag:isMNUCase: (in category 'in-line cacheing') -----
  cogPICSelector: selector numArgs: numArgs Case0Method: case0CogMethod Case1Method: case1MethodOrNil tag: case1Tag isMNUCase: isMNUCase
  "Attempt to create a two-case PIC for case0CogMethod and  case1Method,case1Tag.
  The tag for case0CogMethod is at the send site and so doesn't need to be generated.
  case1Method may be any of
  - a Cog method; link to its unchecked entry-point
  - a CompiledMethod; link to ceInterpretMethodFromPIC:
  - a CompiledMethod; link to ceMNUFromPICMNUMethod:receiver:"
  <var: #case0CogMethod type: #'CogMethod *'>
  <returnTypeC: #'CogMethod *'>
  | startAddress writablePIC actualPIC |
  (objectMemory isYoung: selector) ifTrue:
  [^self cCoerceSimple: YoungSelectorInPIC to: #'CogMethod *'].
+ coInterpreter compilationBreakpoint: selector classTag: case1Tag isMNUCase: isMNUCase.
- coInterpreter
- compilationBreak: selector
- point: (objectMemory numBytesOf: selector)
- classTag: case1Tag
- isMNUCase: isMNUCase.
 
  "get memory in the code zone for the CPIC; if that fails we return an error code for the sender to use to work out how to blow up"
  startAddress := methodZone allocate: closedPICSize.
  startAddress = 0 ifTrue:
  [^self cCoerceSimple: InsufficientCodeSpace to: #'CogMethod *'].
  self maybeBreakGeneratingFrom: startAddress to: startAddress + closedPICSize - 1.
 
  writablePIC := self writableMethodFor: startAddress.
  "memcpy the prototype across to our allocated space; because anything else would be silly"
  self codeMemcpy: writablePIC _: cPICPrototype _: closedPICSize.
 
  self
  fillInCPICHeader: writablePIC
  numArgs: numArgs
  numCases: 2
  hasMNUCase: isMNUCase
  selector: selector.
 
  self configureCPIC: (actualPIC := self cCoerceSimple: startAddress to: #'CogMethod *')
  Case0: case0CogMethod
  Case1Method: case1MethodOrNil
  tag: case1Tag
  isMNUCase: isMNUCase
  numArgs: numArgs
  delta: startAddress - cPICPrototype asUnsignedInteger.
 
  "This also implicitly flushes the read/write mapped dual zone to the read/execute zone."
  backEnd flushICacheFrom: startAddress to: startAddress + closedPICSize.
 
  self assert: (backEnd callTargetFromReturnAddress: startAddress + missOffset) = (self picAbortTrampolineFor: numArgs).
  self assertValidDualZoneFrom: startAddress to: startAddress + closedPICSize.
 
  ^actualPIC!

Item was changed:
  ----- Method: Cogit>>setSelectorOf:to: (in category 'jit - api') -----
  setSelectorOf: cogMethod to: aSelectorOop
  <api>
  "If a method is compiled to machine code via a block entry it won't have a selector.
  A subsequent send can find the method and hence fill in the selector."
  <var: #cogMethod type: #'CogMethod *'>
  "self disassembleMethod: cogMethod"
+ coInterpreter compilationBreakpoint: aSelectorOop isMNUCase: false.
- coInterpreter
- compilationBreak: aSelectorOop
- point: (objectMemory numBytesOf: aSelectorOop)
- isMNUCase: false.
  self assert: cogMethod cmType = CMMethod.
  (self writableMethodFor: cogMethod) selector: aSelectorOop.
  (objectMemory isYoung: aSelectorOop) ifTrue:
  [methodZone ensureInYoungReferrers: cogMethod]!

Item was removed:
- ----- Method: CurrentImageCoInterpreterFacade>>compilationBreak:point:classTag:isMNUCase: (in category 'debug support') -----
- compilationBreak: aString point: length classTag: classTag isMNUCase: isMNUCase
- ^self!

Item was removed:
- ----- Method: CurrentImageCoInterpreterFacade>>compilationBreak:point:isMNUCase: (in category 'debug support') -----
- compilationBreak: aString point: length isMNUCase: isMNUCase
- ^self!

Item was added:
+ ----- Method: CurrentImageCoInterpreterFacade>>compilationBreakpoint:classTag:isMNUCase: (in category 'debug support') -----
+ compilationBreakpoint: selectorOop classTag: classTag isMNUCase: isMNUCase
+ ^self!

Item was added:
+ ----- Method: CurrentImageCoInterpreterFacade>>compilationBreakpoint:isMNUCase: (in category 'debug support') -----
+ compilationBreakpoint: aString isMNUCase: isMNUCase
+ ^self!

Item was changed:
  ----- Method: ObjectMemory>>lengthOf: (in category 'object access') -----
  lengthOf: oop
  "Return the number of indexable bytes or words in the given object. Assume the argument is not an integer. For a CompiledMethod, the size of the method header (in bytes) should be subtracted from the result."
 
- <api>
  | header |
  <inline: true>
  header := self baseHeader: oop.
  ^self lengthOf: oop baseHeader: header format: (self formatOfHeader: header)!

Item was changed:
  ----- Method: SpurMemoryManager>>lengthOf: (in category 'object access') -----
  lengthOf: objOop
  "Answer the number of indexable units in the given object.
  For a CompiledMethod, the size of the method header (in bytes) should
  be subtracted from the result."
 
- <api>
  <inline: true>
  ^self lengthOf: objOop format: (self formatOf: objOop)!