[Vm-dev] VM Maker: VMMaker.oscog-eem.2721.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Feb 26 03:19:37 UTC 2020
Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-eem.2721.mcz
==================== Summary ====================
Name: VMMaker.oscog-eem.2721
Author: eem
Time: 25 February 2020, 7:19:16.40806 pm
UUID: ae80c101-9b76-4d26-907a-6466e4269ad7
Ancestors: VMMaker.oscog-eem.2720
Interpreter: Change the signature of the core selector send breakpointing routines from taking the receiver to taking a class tag. (Requires corresponding changes in platforms/Cross/vm/dispdbg.h).
Add an accessor for breakLookupClassTag and add couldBeContext:. Comment fetchClassTagOf:. [This was all to track down a bug with ARMv8 do do with register save/restore across the call in ceScheduleScavengeTrampoline that caused contexts to appear where blocks were expected].
Cogit: rename the accessor for codeToDataDelta to getCodeToDataDelta to allow codeToDataDelta to be defined as 0 in the non DUAL_MAPPED_CODE_ZONE regime. Consequently find and fix a slip in NewspeakCogMethod class>>initialize. Don't attempt to take the address of 0 in the DUAL_MAPPED_CODE_ZONE regime.
Fix genLoadCStackPointer(s) to use NativeSPReg
Slang: add support for even and odd.
Simulator:
Extend machine code breakpojnt framework to allow CogMethodSurrogates to function as breakpoints.
Recategorize the breakpoint routines. Fix a slip in Integer>>addBreakpoint:.
=============== Diff against VMMaker.oscog-eem.2720 ===============
Item was changed:
+ ----- Method: Array>>addBreakpoint: (in category '*VMMaker-breakpoints') -----
+ addBreakpoint: bkpt
+ ^self, {bkpt}!
- ----- Method: Array>>addBreakpoint: (in category '*VMMaker-interpreter simulator') -----
- addBreakpoint: address
- ^self, {address}!
Item was changed:
+ ----- Method: Array>>isActiveBreakpoint (in category '*VMMaker-breakpoints') -----
- ----- Method: Array>>isActiveBreakpoint (in category '*VMMaker-interpreter simulator') -----
isActiveBreakpoint
^self size > 0!
Item was changed:
+ ----- Method: Array>>isBreakpointFor: (in category '*VMMaker-breakpoints') -----
- ----- Method: Array>>isBreakpointFor: (in category '*VMMaker-interpreter simulator') -----
isBreakpointFor: address
1 to: self size do:
[:i| (self at: i) = address ifTrue: [^true]].
^false!
Item was changed:
+ ----- Method: Array>>menuPrompt (in category '*VMMaker-breakpoints') -----
- ----- Method: Array>>menuPrompt (in category '*VMMaker-interpreter simulator') -----
menuPrompt
^String streamContents:
[:s|
s space; nextPut: $(.
+ self do: [:bkpt| s nextPutAll: bkpt menuPrompt]
- self do: [:address| s nextPutAll: address hex]
separatedBy: [s space].
s nextPut: $)]!
Item was changed:
+ ----- Method: Array>>removeBreakpoint: (in category '*VMMaker-breakpoints') -----
- ----- Method: Array>>removeBreakpoint: (in category '*VMMaker-interpreter simulator') -----
removeBreakpoint: address
^(self copyWithout: address) ifEmpty: nil!
Item was changed:
+ ----- Method: Array>>singleStepRequiredToTriggerIn: (in category '*VMMaker-breakpoints') -----
- ----- Method: Array>>singleStepRequiredToTriggerIn: (in category '*VMMaker-interpreter simulator') -----
singleStepRequiredToTriggerIn: aCogit
^self anySatisfy: [:address| address between: aCogit cogCodeBase and: aCogit methodZone limitZony]!
Item was changed:
+ ----- Method: Boolean>>isBreakpointFor: (in category '*VMMaker-breakpoints') -----
- ----- Method: Boolean>>isBreakpointFor: (in category '*VMMaker-interpreter simulator') -----
isBreakpointFor: address
^self!
Item was changed:
+ ----- Method: Boolean>>menuPrompt (in category '*VMMaker-breakpoints') -----
- ----- Method: Boolean>>menuPrompt (in category '*VMMaker-interpreter simulator') -----
menuPrompt
^' (CLICK STEPPING!!!!)'!
Item was changed:
+ ----- Method: Boolean>>singleStepRequiredToTriggerIn: (in category '*VMMaker-breakpoints') -----
- ----- Method: Boolean>>singleStepRequiredToTriggerIn: (in category '*VMMaker-interpreter simulator') -----
singleStepRequiredToTriggerIn: aCogit
^self!
Item was added:
+ ----- Method: CCodeGenerator>>generateEven:on:indent: (in category 'C translation') -----
+ generateEven: msgNode on: aStream indent: level
+ "Generate the C code for even or odd onto the given stream."
+
+ aStream nextPutAll: '(!!('.
+ self emitCExpression: msgNode receiver on: aStream.
+ aStream nextPutAll: ' & 1))'!
Item was added:
+ ----- Method: CCodeGenerator>>generateOdd:on:indent: (in category 'C translation') -----
+ generateOdd: msgNode on: aStream indent: level
+ "Generate the C code for even or odd onto the given stream."
+
+ aStream nextPut: $(.
+ self emitCExpression: msgNode receiver on: aStream.
+ aStream nextPutAll: ' & 1)'!
Item was changed:
----- Method: CCodeGenerator>>initializeCTranslationDictionary (in category 'C translation support') -----
initializeCTranslationDictionary
"Initialize the dictionary mapping message names to actions for C code generation."
| pairs |
translationDict := Dictionary new: 200.
pairs := #(
#& #generateAnd:on:indent:
#| #generateOr:on:indent:
#abs #generateAbs:on:indent:
#and: #generateSequentialAnd:on:indent:
#or: #generateSequentialOr:on:indent:
#not #generateNot:on:indent:
#+ #generatePlus:on:indent:
#- #generateMinus:on:indent:
#negated #generateNegated:on:indent:
#* #generateTimes:on:indent:
#/ #generateDivide:on:indent:
#// #generateDivide:on:indent:
#\\ #generateModulo:on:indent:
#<< #generateShiftLeft:on:indent:
#>> #generateShiftRight:on:indent:
#>>> #generateSignedShiftRight:on:indent:
#, #generateComma:on:indent:
#min: #generateMin:on:indent:
#max: #generateMax:on:indent:
#between:and: #generateBetweenAnd:on:indent:
#bitAnd: #generateBitAnd:on:indent:
#bitOr: #generateBitOr:on:indent:
#bitXor: #generateBitXor:on:indent:
#bitShift: #generateBitShift:on:indent:
#signedBitShift: #generateSignedBitShift:on:indent:
#bitInvert32 #generateBitInvert:on:indent:
#bitInvert64 #generateBitInvert:on:indent:
#bitClear: #generateBitClear:on:indent:
#truncateTo: #generateTruncateTo:on:indent:
#rounded #generateRounded:on:indent:
+ #even #generateEven:on:indent:
+ #odd #generateOdd:on:indent:
#byteSwap32 #generateByteSwap32:on:indent:
#byteSwap64 #generateByteSwap64:on:indent:
#byteSwapped32IfBigEndian: generateByteSwap32IfBigEndian:on:indent:
#byteSwapped64IfBigEndian: generateByteSwap64IfBigEndian:on:indent:
#< #generateLessThan:on:indent:
#<= #generateLessThanOrEqual:on:indent:
#= #generateEqual:on:indent:
#> #generateGreaterThan:on:indent:
#>= #generateGreaterThanOrEqual:on:indent:
#~= #generateNotEqual:on:indent:
#== #generateEqual:on:indent:
#~~ #generateNotEqual:on:indent:
#isNil #generateIsNil:on:indent:
#notNil #generateNotNil:on:indent:
#whileTrue: #generateWhileTrue:on:indent:
#whileFalse: #generateWhileFalse:on:indent:
#whileTrue #generateDoWhileTrue:on:indent:
#whileFalse #generateDoWhileFalse:on:indent:
#to:do: #generateToDo:on:indent:
#to:by:do: #generateToByDo:on:indent:
#repeat #generateRepeat:on:indent:
#timesRepeat: #generateTimesRepeat:on:indent:
#ifTrue: #generateIfTrue:on:indent:
#ifFalse: #generateIfFalse:on:indent:
#ifTrue:ifFalse: #generateIfTrueIfFalse:on:indent:
#ifFalse:ifTrue: #generateIfFalseIfTrue:on:indent:
#ifNotNil: #generateIfNotNil:on:indent:
#ifNil: #generateIfNil:on:indent:
#ifNotNil:ifNil: #generateIfNotNilIfNil:on:indent:
#ifNil:ifNotNil: #generateIfNilIfNotNil:on:indent:
#at: #generateAt:on:indent:
#at:put: #generateAtPut:on:indent:
#basicAt: #generateAt:on:indent:
#basicAt:put: #generateAtPut:on:indent:
#integerValueOf: #generateIntegerValueOf:on:indent:
#integerObjectOf: #generateIntegerObjectOf:on:indent:
#isIntegerObject: #generateIsIntegerObject:on:indent:
#cCode: #generateInlineCCode:on:indent:
#cCode:inSmalltalk: #generateInlineCCode:on:indent:
#cPreprocessorDirective: #generateInlineCPreprocessorDirective:on:indent:
#cppIf:ifTrue:ifFalse: #generateInlineCppIfElse:on:indent:
#cppIf:ifTrue: #generateInlineCppIfElse:on:indent:
#cCoerce:to: #generateCCoercion:on:indent:
#cCoerceSimple:to: #generateCCoercion:on:indent:
#addressOf: #generateAddressOf:on:indent:
#addressOf:put: #generateAddressOf:on:indent:
#asAddress:put: #generateAsAddress:on:indent:
#signedIntFromLong64 #generateSignedIntFromLong64:on:indent:
#signedIntFromLong #generateSignedIntFromLong:on:indent:
#signedIntFromShort #generateSignedIntFromShort:on:indent:
#signedIntToLong64 #generateSignedIntToLong64:on:indent:
#signedIntToLong #generateSignedIntToLong:on:indent:
#signedIntToShort #generateSignedIntToShort:on:indent:
#preIncrement #generatePreIncrement:on:indent:
#preDecrement #generatePreDecrement:on:indent:
#inline: #generateInlineDirective:on:indent:
#asFloat #generateAsFloat:on:indent:
#asInteger #generateAsInteger:on:indent:
#asIntegerPtr #generateAsIntegerPtr:on:indent:
#asUnsignedInteger #generateAsUnsignedInteger:on:indent:
#asUnsignedIntegerPtr #generateAsUnsignedIntegerPtr:on:indent:
#asLong #generateAsLong:on:indent:
#asUnsignedLong #generateAsUnsignedLong:on:indent:
#asUnsignedLongLong #generateAsUnsignedLongLong:on:indent:
#asVoidPointer #generateAsVoidPointer:on:indent:
#asSymbol #generateAsSymbol:on:indent:
#flag: #generateFlag:on:indent:
#anyMask: #generateBitAnd:on:indent:
#allMask: #generateAllMask:on:indent:
#noMask: #generateNoMask:on:indent:
#raisedTo: #generateRaisedTo:on:indent:
#touch: #generateTouch:on:indent:
#bytesPerOop #generateBytesPerOop:on:indent:
#bytesPerWord #generateBytesPerWord:on:indent:
#wordSize #generateBytesPerWord:on:indent:
#baseHeaderSize #generateBaseHeaderSize:on:indent:
#minSmallInteger #generateSmallIntegerConstant:on:indent:
#maxSmallInteger #generateSmallIntegerConstant:on:indent:
#sharedCodeNamed:inCase: #generateSharedCodeDirective:on:indent:
#perform: #generatePerform:on:indent:
#perform:with: #generatePerform:on:indent:
#perform:with:with: #generatePerform:on:indent:
#perform:with:with:with: #generatePerform:on:indent:
#perform:with:with:with:with: #generatePerform:on:indent:
#perform:with:with:with:with:with: #generatePerform:on:indent:
#value #generateValue:on:indent:
#value: #generateValue:on:indent:
#value:value: #generateValue:on:indent:
#value:value:value: #generateValue:on:indent:
#value:value:value:value: #generateValue:on:indent:
#value:value:value:value:value: #generateValue:on:indent:
#value:value:value:value:value:value: #generateValue:on:indent:
#deny: #generateDeny:on:indent:
#shouldNotImplement #generateSmalltalkMetaError:on:indent:
#shouldBeImplemented #generateSmalltalkMetaError:on:indent:
#subclassResponsibility #generateSmalltalkMetaError:on:indent:
).
1 to: pairs size by: 2 do: [:i |
translationDict at: (pairs at: i) put: (pairs at: i + 1)].
pairs := #(
#ifTrue: #generateIfTrueAsArgument:on:indent:
#ifFalse: #generateIfFalseAsArgument:on:indent:
#ifTrue:ifFalse: #generateIfTrueIfFalseAsArgument:on:indent:
#ifFalse:ifTrue: #generateIfFalseIfTrueAsArgument:on:indent:
#ifNotNil: #generateIfNotNilAsArgument:on:indent:
#ifNil: #generateIfNilAsArgument:on:indent:
#ifNotNil:ifNil: #generateIfNotNilIfNilAsArgument:on:indent:
#ifNil:ifNotNil: #generateIfNilIfNotNilAsArgument:on:indent:
#cCode: #generateInlineCCodeAsArgument:on:indent:
#cCode:inSmalltalk: #generateInlineCCodeAsArgument:on:indent:
#cppIf:ifTrue:ifFalse: #generateInlineCppIfElseAsArgument:on:indent:
#cppIf:ifTrue: #generateInlineCppIfElseAsArgument:on:indent:
#value #generateValueAsArgument:on:indent:
#value: #generateValueAsArgument:on:indent:
#value:value: #generateValueAsArgument:on:indent:
).
asArgumentTranslationDict := Dictionary new: 8.
1 to: pairs size by: 2 do: [:i |
asArgumentTranslationDict at: (pairs at: i) put: (pairs at: i + 1)].
!
Item was changed:
----- Method: CoInterpreter>>ceMNUFromPICMNUMethod:receiver: (in category 'trampolines') -----
ceMNUFromPICMNUMethod: aMethodObj receiver: rcvr
<api>
| cPIC primitiveIndex |
<var: #cPIC type: #'CogMethod *'>
self assert: (objectMemory addressCouldBeOop: rcvr).
self assert: (aMethodObj = 0
or: [(objectMemory addressCouldBeObj: aMethodObj)
and: [objectMemory isOopCompiledMethod: aMethodObj]]).
+ self sendBreakpoint: (objectMemory splObj: SelectorDoesNotUnderstand) receiver: rcvr.
cPIC := self cCoerceSimple: self popStack - cogit mnuOffset to: #'CogMethod *'.
self assert: (cPIC cmType = CMClosedPIC or: [cPIC cmType = CMOpenPIC]).
argumentCount := cPIC cmNumArgs.
messageSelector := cPIC selector.
aMethodObj ~= 0 ifTrue:
[instructionPointer := self popStack.
self createActualMessageTo: (objectMemory fetchClassOf: rcvr).
(self maybeMethodHasCogMethod: aMethodObj) ifTrue:
[self push: instructionPointer.
self executeCogMethod: (self cogMethodOf: aMethodObj)
fromUnlinkedSendWithReceiver: rcvr.
"NOTREACHED"
self assert: false].
newMethod := aMethodObj.
primitiveIndex := self primitiveIndexOf: aMethodObj.
primitiveFunctionPointer := self functionPointerFor: primitiveIndex inClass: objectMemory nilObject.
^self interpretMethodFromMachineCode].
"handleMNU:InMachineCodeTo:classForMessage: assumes lkupClass is set, since every other use is
after a lookupMethodNoMNUEtcInClass: call, which sets lkupClass. Here we must set it manually.
Global variables. Bah!!"
self handleMNU: SelectorDoesNotUnderstand
InMachineCodeTo: rcvr
classForMessage: (lkupClass := objectMemory fetchClassOf: rcvr).
"NOTREACHED"
self assert: false!
Item was added:
+ ----- 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 changed:
----- Method: CogAbstractInstruction>>genLoadCStackPointer (in category 'smalltalk calling convention') -----
genLoadCStackPointer
"Load the stack pointer register with that of the C stack, effecting
a switch to the C stack. Used when machine code calls into the
CoInterpreter run-time (e.g. to invoke interpreter primitives)."
+ cogit MoveAw: cogit cStackPointerAddress R: NativeSPReg.
- cogit MoveAw: cogit cStackPointerAddress R: SPReg.
^0!
Item was changed:
----- Method: CogAbstractInstruction>>genLoadCStackPointers (in category 'smalltalk calling convention') -----
genLoadCStackPointers
"Load the frame and stack pointer registers with those of the C stack,
effecting a switch to the C stack. Used when machine code calls into
the CoInterpreter run-time (e.g. to invoke interpreter primitives)."
+ cogit MoveAw: cogit cStackPointerAddress R: NativeSPReg.
- cogit MoveAw: cogit cStackPointerAddress R: SPReg.
cogit MoveAw: cogit cFramePointerAddress R: FPReg.
^0!
Item was changed:
----- Method: CogBlockMethod class>>setter:bitPosition:bitWidth:type: (in category 'code generation') -----
setter: getter bitPosition: bitPosition bitWidth: bitWidth type: typeOrNil
^String streamContents:
[:s| | startByte endByte shift alignedPowerOf2 accessor mask |
startByte := bitPosition // 8.
endByte := bitPosition + bitWidth - 1 // 8.
shift := bitPosition \\ 8.
alignedPowerOf2 := (#(8 16 32 64) includes: bitWidth) and: [shift = 0].
accessor := 'unsigned'
, (#('Byte' 'Short' 'Long' 'Long')
at: endByte - startByte + 1
ifAbsent: ['Long64'])
, 'At: index'.
mask := #(16rFF 16rFFFF 16rFFFFFFFF 16rFFFFFFFF)
at: endByte - startByte + 1
ifAbsent: [(2 raisedTo: 64) - 1].
s nextPutAll: getter; nextPutAll: ': aValue'; crtab: 1.
s crtab: 1; nextPutAll: '| index delta |'; crtab: 1.
s nextPutAll: 'index := address + '.
(self offsetForInstVar: getter) ifNotNil:
[:offsetExpr| s nextPutAll: offsetExpr, ' + '].
s print: startByte + 1; nextPut: $.; crtab: 1.
(typeOrNil notNil or: [alignedPowerOf2]) ifFalse:
[s nextPutAll: 'self assert: (aValue between: 0 and: '; nextPutAll: ((1 << bitWidth) - 1) hex; nextPutAll: ').'; crtab: 1].
+ s nextPutAll: '(delta := cogit getCodeToDataDelta) > 0 ifTrue:'; crtab: 2.
- s nextPutAll: '(delta := cogit codeToDataDelta) > 0 ifTrue:'; crtab: 2.
s nextPutAll: '[self assert: (cogit addressIsInCodeZone: address - delta).'; crtab: 2; space.
self putAtPut: accessor, ' - delta'
type: typeOrNil
mask: (alignedPowerOf2 ifFalse: [mask - ((1 << bitWidth - 1) << shift)])
shift: shift
on: s
indent: 3.
s nextPutAll: '].'; crtab: 1.
alignedPowerOf2 ifTrue:
[s nextPut: $^].
self putAtPut: accessor
type: typeOrNil
mask: (alignedPowerOf2 ifFalse: [mask - ((1 << bitWidth - 1) << shift)])
shift: shift
on: s
indent: 2.
alignedPowerOf2 ifFalse:
[s nextPut: $.; crtab: 1; nextPutAll: '^aValue']]!
Item was changed:
----- Method: CogBlockMethodSurrogate32>>padToWord: (in category 'accessing generated') -----
padToWord: aValue
| index delta |
index := address + 5.
+ (delta := cogit getCodeToDataDelta) > 0 ifTrue:
- (delta := cogit codeToDataDelta) > 0 ifTrue:
[self assert: (cogit addressIsInCodeZone: address - delta).
memory
unsignedLongAt: index - delta
put: aValue].
^memory
unsignedLongAt: index
put: aValue!
Item was changed:
----- Method: CogBlockMethodSurrogate64>>padToWord: (in category 'accessing generated') -----
padToWord: aValue
| index delta |
index := address + 5.
+ (delta := cogit getCodeToDataDelta) > 0 ifTrue:
- (delta := cogit codeToDataDelta) > 0 ifTrue:
[self assert: (cogit addressIsInCodeZone: address - delta).
memory
unsignedLong64At: index - delta
put: aValue].
^memory
unsignedLong64At: index
put: aValue!
Item was added:
+ ----- Method: CogMethodSurrogate>>addBreakpoint: (in category 'breakpoints') -----
+ addBreakpoint: bkpt
+ ^{self. bkpt}!
Item was changed:
----- Method: CogMethodSurrogate>>cbUsesInstVars: (in category 'accessing generated') -----
cbUsesInstVars: aValue
| index delta |
index := address + baseHeaderSize + 3.
+ (delta := cogit getCodeToDataDelta) > 0 ifTrue:
- (delta := cogit codeToDataDelta) > 0 ifTrue:
[self assert: (cogit addressIsInCodeZone: address - delta).
memory
unsignedByteAt: index - delta
put: (((memory unsignedByteAt: index - delta) bitAnd: 16rFD) + (aValue ifTrue: [2] ifFalse: [0]))].
memory
unsignedByteAt: index
put: (((memory unsignedByteAt: index) bitAnd: 16rFD) + (aValue ifTrue: [2] ifFalse: [0])).
^aValue!
Item was changed:
----- Method: CogMethodSurrogate>>cmHasMovableLiteral: (in category 'accessing generated') -----
cmHasMovableLiteral: aValue
| index delta |
index := address + baseHeaderSize + 3.
+ (delta := cogit getCodeToDataDelta) > 0 ifTrue:
- (delta := cogit codeToDataDelta) > 0 ifTrue:
[self assert: (cogit addressIsInCodeZone: address - delta).
memory
unsignedByteAt: index - delta
put: (((memory unsignedByteAt: index - delta) bitAnd: 16rFB) + (aValue ifTrue: [4] ifFalse: [0]))].
memory
unsignedByteAt: index
put: (((memory unsignedByteAt: index) bitAnd: 16rFB) + (aValue ifTrue: [4] ifFalse: [0])).
^aValue!
Item was changed:
----- Method: CogMethodSurrogate>>cmNumArgs: (in category 'accessing generated') -----
cmNumArgs: aValue
| index delta |
index := address + baseHeaderSize + 1.
+ (delta := cogit getCodeToDataDelta) > 0 ifTrue:
- (delta := cogit codeToDataDelta) > 0 ifTrue:
[self assert: (cogit addressIsInCodeZone: address - delta).
memory
unsignedByteAt: index - delta
put: aValue].
^memory
unsignedByteAt: index
put: aValue!
Item was changed:
----- Method: CogMethodSurrogate>>cmRefersToYoung: (in category 'accessing generated') -----
cmRefersToYoung: aValue
| index delta |
index := address + baseHeaderSize + 2.
+ (delta := cogit getCodeToDataDelta) > 0 ifTrue:
- (delta := cogit codeToDataDelta) > 0 ifTrue:
[self assert: (cogit addressIsInCodeZone: address - delta).
memory
unsignedByteAt: index - delta
put: (((memory unsignedByteAt: index - delta) bitAnd: 16rF7) + (aValue ifTrue: [8] ifFalse: [0]))].
memory
unsignedByteAt: index
put: (((memory unsignedByteAt: index) bitAnd: 16rF7) + (aValue ifTrue: [8] ifFalse: [0])).
^aValue!
Item was changed:
----- Method: CogMethodSurrogate>>cmType: (in category 'accessing generated') -----
cmType: aValue
| index delta |
index := address + baseHeaderSize + 2.
self assert: (aValue between: 0 and: 16r7).
+ (delta := cogit getCodeToDataDelta) > 0 ifTrue:
- (delta := cogit codeToDataDelta) > 0 ifTrue:
[self assert: (cogit addressIsInCodeZone: address - delta).
memory
unsignedByteAt: index - delta
put: ((memory unsignedByteAt: index - delta) bitAnd: 16rF8) + aValue].
memory
unsignedByteAt: index
put: ((memory unsignedByteAt: index) bitAnd: 16rF8) + aValue.
^aValue!
Item was changed:
----- Method: CogMethodSurrogate>>cmUsageCount: (in category 'accessing generated') -----
cmUsageCount: aValue
| index delta |
index := address + baseHeaderSize + 2.
self assert: (aValue between: 0 and: 16r7).
+ (delta := cogit getCodeToDataDelta) > 0 ifTrue:
- (delta := cogit codeToDataDelta) > 0 ifTrue:
[self assert: (cogit addressIsInCodeZone: address - delta).
memory
unsignedByteAt: index - delta
put: ((memory unsignedByteAt: index - delta) bitAnd: 16r1F) + (aValue bitShift: 5)].
memory
unsignedByteAt: index
put: ((memory unsignedByteAt: index) bitAnd: 16r1F) + (aValue bitShift: 5).
^aValue!
Item was changed:
----- Method: CogMethodSurrogate>>cmUsesPenultimateLit: (in category 'accessing generated') -----
cmUsesPenultimateLit: aValue
| index delta |
index := address + baseHeaderSize + 3.
+ (delta := cogit getCodeToDataDelta) > 0 ifTrue:
- (delta := cogit codeToDataDelta) > 0 ifTrue:
[self assert: (cogit addressIsInCodeZone: address - delta).
memory
unsignedByteAt: index - delta
put: (((memory unsignedByteAt: index - delta) bitAnd: 16rFE) + (aValue ifTrue: [1] ifFalse: [0]))].
memory
unsignedByteAt: index
put: (((memory unsignedByteAt: index) bitAnd: 16rFE) + (aValue ifTrue: [1] ifFalse: [0])).
^aValue!
Item was changed:
----- Method: CogMethodSurrogate>>cpicHasMNUCaseOrCMIsFullBlock: (in category 'accessing generated') -----
cpicHasMNUCaseOrCMIsFullBlock: aValue
| index delta |
index := address + baseHeaderSize + 2.
+ (delta := cogit getCodeToDataDelta) > 0 ifTrue:
- (delta := cogit codeToDataDelta) > 0 ifTrue:
[self assert: (cogit addressIsInCodeZone: address - delta).
memory
unsignedByteAt: index - delta
put: (((memory unsignedByteAt: index - delta) bitAnd: 16rEF) + (aValue ifTrue: [16] ifFalse: [0]))].
memory
unsignedByteAt: index
put: (((memory unsignedByteAt: index) bitAnd: 16rEF) + (aValue ifTrue: [16] ifFalse: [0])).
^aValue!
Item was changed:
----- Method: CogMethodSurrogate>>homeOffset: (in category 'accessing generated') -----
homeOffset: aValue
| index delta |
index := address + 1.
+ (delta := cogit getCodeToDataDelta) > 0 ifTrue:
- (delta := cogit codeToDataDelta) > 0 ifTrue:
[self assert: (cogit addressIsInCodeZone: address - delta).
memory
unsignedShortAt: index - delta
put: aValue].
^memory
unsignedShortAt: index
put: aValue!
Item was added:
+ ----- Method: CogMethodSurrogate>>isActiveBreakpoint (in category 'breakpoints') -----
+ isActiveBreakpoint
+ ^address < cogit methodZone freeStart!
Item was added:
+ ----- Method: CogMethodSurrogate>>isBreakpointFor: (in category 'breakpoints') -----
+ isBreakpointFor: anAddress
+ ^anAddress >= (address + self class baseHeaderSize)
+ and: [anAddress < (address + self blockSize)]!
Item was added:
+ ----- Method: CogMethodSurrogate>>menuPrompt (in category 'breakpoints') -----
+ menuPrompt
+ ^String streamContents:
+ [:s|
+ s
+ nextPut: $(;
+ nextPutAll: (#('CMFree ' 'CMMethod' 'CMBlock' 'CMClosedPIC' 'CMOpenPIC') at: self cmType);
+ space;
+ nextPutAll: address hex;
+ space.
+ (self cmType = CMMethod or: [self cmType = CMClosedPIC or: [self cmType = CMOpenPIC]]) ifTrue:
+ [s nextPutAll: ((cogit objectMemory isBytes: self selector)
+ ifTrue: [cogit coInterpreter stringOf: self selector]
+ ifFalse: [self selector = cogit objectMemory nilObject
+ ifTrue: ['(nil)']
+ ifFalse: [self selector hex]])].
+ s nextPut: $)]!
Item was changed:
----- Method: CogMethodSurrogate>>objectHeader: (in category 'accessing') -----
objectHeader: aValue
| delta |
+ (delta := cogit getCodeToDataDelta) > 0 ifTrue:
- (delta := cogit codeToDataDelta) > 0 ifTrue:
[self assert: (cogit addressIsInCodeZone: address - delta).
baseHeaderSize = 8
ifTrue: [memory long64At: address - delta + 1 put: aValue]
ifFalse: [memory longAt: address - delta + 1 put: aValue]].
^baseHeaderSize = 8
ifTrue: [memory long64At: address + 1 put: aValue]
ifFalse: [memory longAt: address + 1 put: aValue]!
Item was added:
+ ----- Method: CogMethodSurrogate>>removeBreakpoint: (in category 'breakpoints') -----
+ removeBreakpoint: address
+ ^nil!
Item was added:
+ ----- Method: CogMethodSurrogate>>singleStepRequiredToTriggerIn: (in category 'breakpoints') -----
+ singleStepRequiredToTriggerIn: aCogit
+ ^true!
Item was changed:
----- Method: CogMethodSurrogate>>stackCheckOffset: (in category 'accessing generated') -----
stackCheckOffset: aValue
| index delta |
index := address + baseHeaderSize + 3.
self assert: (aValue between: 0 and: 16rFFF).
+ (delta := cogit getCodeToDataDelta) > 0 ifTrue:
- (delta := cogit codeToDataDelta) > 0 ifTrue:
[self assert: (cogit addressIsInCodeZone: address - delta).
memory
unsignedShortAt: index - delta
put: ((memory unsignedShortAt: index - delta) bitAnd: 16rF) + (aValue bitShift: 4)].
memory
unsignedShortAt: index
put: ((memory unsignedShortAt: index) bitAnd: 16rF) + (aValue bitShift: 4).
^aValue!
Item was changed:
----- Method: CogMethodSurrogate>>startpc: (in category 'accessing generated') -----
startpc: aValue
| index delta |
index := address + 3.
+ (delta := cogit getCodeToDataDelta) > 0 ifTrue:
- (delta := cogit codeToDataDelta) > 0 ifTrue:
[self assert: (cogit addressIsInCodeZone: address - delta).
memory
unsignedShortAt: index - delta
put: aValue].
^memory
unsignedShortAt: index
put: aValue!
Item was changed:
----- Method: CogMethodSurrogate32>>blockEntryOffset: (in category 'accessing generated') -----
blockEntryOffset: aValue
| index delta |
index := address + baseHeaderSize + 7.
+ (delta := cogit getCodeToDataDelta) > 0 ifTrue:
- (delta := cogit codeToDataDelta) > 0 ifTrue:
[self assert: (cogit addressIsInCodeZone: address - delta).
memory
unsignedShortAt: index - delta
put: aValue].
^memory
unsignedShortAt: index
put: aValue!
Item was changed:
----- Method: CogMethodSurrogate32>>blockSize: (in category 'accessing generated') -----
blockSize: aValue
| index delta |
index := address + baseHeaderSize + 5.
+ (delta := cogit getCodeToDataDelta) > 0 ifTrue:
- (delta := cogit codeToDataDelta) > 0 ifTrue:
[self assert: (cogit addressIsInCodeZone: address - delta).
memory
unsignedShortAt: index - delta
put: aValue].
^memory
unsignedShortAt: index
put: aValue!
Item was changed:
----- Method: CogMethodSurrogate32>>methodHeader: (in category 'accessing generated') -----
methodHeader: aValue
| index delta |
index := address + baseHeaderSize + 13.
+ (delta := cogit getCodeToDataDelta) > 0 ifTrue:
- (delta := cogit codeToDataDelta) > 0 ifTrue:
[self assert: (cogit addressIsInCodeZone: address - delta).
memory
unsignedLongAt: index - delta
put: aValue].
^memory
unsignedLongAt: index
put: aValue!
Item was changed:
----- Method: CogMethodSurrogate32>>methodObject: (in category 'accessing generated') -----
methodObject: aValue
| index delta |
index := address + baseHeaderSize + 9.
+ (delta := cogit getCodeToDataDelta) > 0 ifTrue:
- (delta := cogit codeToDataDelta) > 0 ifTrue:
[self assert: (cogit addressIsInCodeZone: address - delta).
memory
unsignedLongAt: index - delta
put: aValue].
^memory
unsignedLongAt: index
put: aValue!
Item was changed:
----- Method: CogMethodSurrogate32>>selector: (in category 'accessing generated') -----
selector: aValue
| index delta |
index := address + baseHeaderSize + 17.
+ (delta := cogit getCodeToDataDelta) > 0 ifTrue:
- (delta := cogit codeToDataDelta) > 0 ifTrue:
[self assert: (cogit addressIsInCodeZone: address - delta).
memory
unsignedLongAt: index - delta
put: aValue].
^memory
unsignedLongAt: index
put: aValue!
Item was changed:
----- Method: CogMethodSurrogate64>>blockEntryOffset: (in category 'accessing generated') -----
blockEntryOffset: aValue
| index delta |
index := address + baseHeaderSize + 7.
+ (delta := cogit getCodeToDataDelta) > 0 ifTrue:
- (delta := cogit codeToDataDelta) > 0 ifTrue:
[self assert: (cogit addressIsInCodeZone: address - delta).
memory
unsignedShortAt: index - delta
put: aValue].
^memory
unsignedShortAt: index
put: aValue!
Item was changed:
----- Method: CogMethodSurrogate64>>blockSize: (in category 'accessing generated') -----
blockSize: aValue
| index delta |
index := address + baseHeaderSize + 5.
+ (delta := cogit getCodeToDataDelta) > 0 ifTrue:
- (delta := cogit codeToDataDelta) > 0 ifTrue:
[self assert: (cogit addressIsInCodeZone: address - delta).
memory
unsignedShortAt: index - delta
put: aValue].
^memory
unsignedShortAt: index
put: aValue!
Item was changed:
----- Method: CogMethodSurrogate64>>methodHeader: (in category 'accessing generated') -----
methodHeader: aValue
| index delta |
index := address + baseHeaderSize + 17.
+ (delta := cogit getCodeToDataDelta) > 0 ifTrue:
- (delta := cogit codeToDataDelta) > 0 ifTrue:
[self assert: (cogit addressIsInCodeZone: address - delta).
memory
unsignedLong64At: index - delta
put: aValue].
^memory
unsignedLong64At: index
put: aValue!
Item was changed:
----- Method: CogMethodSurrogate64>>methodObject: (in category 'accessing generated') -----
methodObject: aValue
| index delta |
index := address + baseHeaderSize + 9.
+ (delta := cogit getCodeToDataDelta) > 0 ifTrue:
- (delta := cogit codeToDataDelta) > 0 ifTrue:
[self assert: (cogit addressIsInCodeZone: address - delta).
memory
unsignedLong64At: index - delta
put: aValue].
^memory
unsignedLong64At: index
put: aValue!
Item was changed:
----- Method: CogMethodSurrogate64>>selector: (in category 'accessing generated') -----
selector: aValue
| index delta |
index := address + baseHeaderSize + 25.
+ (delta := cogit getCodeToDataDelta) > 0 ifTrue:
- (delta := cogit codeToDataDelta) > 0 ifTrue:
[self assert: (cogit addressIsInCodeZone: address - delta).
memory
unsignedLong64At: index - delta
put: aValue].
^memory
unsignedLong64At: index
put: aValue!
Item was changed:
----- Method: CogMethodZone>>addToOpenPICList: (in category 'accessing') -----
addToOpenPICList: anOpenPIC
<var: #anOpenPIC type: #'CogMethod *'>
self assert: anOpenPIC cmType = CMOpenPIC.
self assert: (openPICList == nil
or: [openPICList cmType = CMOpenPIC]).
cogit assertValidDualZoneWriteAddress: anOpenPIC.
anOpenPIC nextOpenPIC: openPICList asUnsignedInteger.
+ openPICList := cogit cCoerceSimple: anOpenPIC asUnsignedInteger - cogit getCodeToDataDelta to: #'CogMethod *'.
- openPICList := cogit cCoerceSimple: anOpenPIC asUnsignedInteger - cogit codeToDataDelta to: #'CogMethod *'.
self cCode: '' inSmalltalk: [self deny: openPICList isInteger]!
Item was changed:
----- Method: CogMethodZone>>addToUnpairedMethodList: (in category 'accessing') -----
addToUnpairedMethodList: aCogMethod
<option: #NewspeakVM>
<var: #aCogMethod type: #'CogMethod *'>
self assert: aCogMethod cmType = CMMethod.
self assert: (cogit noAssertMethodClassAssociationOf: aCogMethod methodObject) = objectMemory nilObject.
self assert: (unpairedMethodList == nil
or: [(self cCoerceSimple: unpairedMethodList to: #'CogMethod *') cmType = CMMethod]).
cogit assertValidDualZoneWriteAddress: aCogMethod.
aCogMethod nextMethodOrIRCs: unpairedMethodList.
+ unpairedMethodList := aCogMethod asUnsignedInteger - cogit getCodeToDataDelta!
- unpairedMethodList := aCogMethod asUnsignedInteger - cogit codeToDataDelta!
Item was changed:
----- Method: CogMethodZone>>addToYoungReferrers: (in category 'young referers') -----
addToYoungReferrers: cogMethod
<var: #cogMethod type: #'CogMethod *'>
cogit assertValidDualZoneWriteAddress: cogMethod.
self assert: (self occurrencesInYoungReferrers: cogMethod) = 0.
self assert: cogMethod cmRefersToYoung.
self assert: (youngReferrers <= limitAddress
and: [youngReferrers >= (limitAddress - (methodCount * objectMemory wordSize))]).
(self asserta: limitAddress - (methodCount * objectMemory wordSize) >= mzFreeStart) ifFalse:
[self error: 'no room on youngReferrers list'].
youngReferrers := youngReferrers - objectMemory wordSize.
cogit
codeLongAt: youngReferrers
+ put: cogMethod asUnsignedInteger - cogit getCodeToDataDelta!
- put: cogMethod asUnsignedInteger - cogit codeToDataDelta!
Item was changed:
----- Method: CogNewspeakMethodSurrogate32>>nextMethodOrIRCs: (in category 'accessing generated') -----
nextMethodOrIRCs: aValue
| index delta |
index := address + baseHeaderSize + 21.
+ (delta := cogit getCodeToDataDelta) > 0 ifTrue:
- (delta := cogit codeToDataDelta) > 0 ifTrue:
[self assert: (cogit addressIsInCodeZone: address - delta).
memory
+ unsignedLongAt: index - delta
- unsignedLongAt: index
put: aValue].
^memory
unsignedLongAt: index
put: aValue!
Item was changed:
----- Method: CogNewspeakMethodSurrogate64>>nextMethodOrIRCs: (in category 'accessing generated') -----
nextMethodOrIRCs: aValue
| index delta |
index := address + baseHeaderSize + 33.
+ (delta := cogit getCodeToDataDelta) > 0 ifTrue:
- (delta := cogit codeToDataDelta) > 0 ifTrue:
[self assert: (cogit addressIsInCodeZone: address - delta).
memory
+ unsignedLong64At: index - delta
- unsignedLong64At: index
put: aValue].
^memory
unsignedLong64At: index
put: aValue!
Item was changed:
----- Method: CogSistaMethodSurrogate32>>counters: (in category 'accessing generated') -----
counters: aValue
| index delta |
index := address + baseHeaderSize + 21.
+ (delta := cogit getCodeToDataDelta) > 0 ifTrue:
- (delta := cogit codeToDataDelta) > 0 ifTrue:
[self assert: (cogit addressIsInCodeZone: address - delta).
memory
unsignedLongAt: index - delta
put: aValue].
^memory
unsignedLongAt: index
put: aValue!
Item was changed:
----- Method: CogSistaMethodSurrogate64>>counters: (in category 'accessing generated') -----
counters: aValue
| index delta |
index := address + baseHeaderSize + 33.
+ (delta := cogit getCodeToDataDelta) > 0 ifTrue:
- (delta := cogit codeToDataDelta) > 0 ifTrue:
[self assert: (cogit addressIsInCodeZone: address - delta).
memory
unsignedLong64At: index - delta
put: aValue].
^memory
unsignedLong64At: index
put: aValue!
Item was added:
+ ----- Method: CogVMSimulator>>printCogMethod:on: (in category 'simulation only') -----
+ printCogMethod: cogMethod on: aStream
+ <doNotGenerate>
+ | oldTranscript |
+ oldTranscript := transcript.
+ transcript := aStream.
+ [self printCogMethod: cogMethod] ensure:
+ [transcript := oldTranscript]!
Item was removed:
- ----- Method: Cogit>>codeToDataDelta (in category 'generate machine code - dual mapped zone support') -----
- codeToDataDelta
- "If non-zero this is the delta between the read/execute method zone and the
- read/write mapping of the method zone. On operating systems where it is
- entirely disallowed to execute code in a writable region this split is necessary
- to be able to modify code. In this regime all writes must be made to the
- read/write mapped zone."
- <cmacro: '() codeToDataDelta'>
- ^codeToDataDelta!
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
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"
[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
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>>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
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 added:
+ ----- Method: Cogit>>getCodeToDataDelta (in category 'generate machine code - dual mapped zone support') -----
+ getCodeToDataDelta
+ "If non-zero this is the delta between the read/execute method zone and the
+ read/write mapping of the method zone. On operating systems where it is
+ entirely disallowed to execute code in a writable region this split is necessary
+ to be able to modify code. In this regime all writes must be made to the
+ read/write mapped zone."
+ <cmacro: '() codeToDataDelta'>
+ ^codeToDataDelta!
Item was changed:
----- Method: Cogit>>initializeCodeZoneFrom:upTo: (in category 'initialization') -----
initializeCodeZoneFrom: startAddress upTo: endAddress
<api>
self initializeBackend.
self sqMakeMemoryExecutableFrom: startAddress
To: endAddress
+ CodeToDataDelta: (self cppIf: #DUAL_MAPPED_CODE_ZONE
+ ifTrue: [self addressOf: codeToDataDelta put: [:v| codeToDataDelta := v]]
+ ifFalse: [nil]).
- CodeToDataDelta: (self addressOf: codeToDataDelta put: [:v| codeToDataDelta := v]).
backEnd stopsFrom: startAddress to: endAddress - 1.
self cCode: '' inSmalltalk:
[self initializeProcessor.
backEnd stopsFrom: 0 to: guardPageSize - 1].
codeBase := methodZoneBase := startAddress.
minValidCallAddress := (codeBase min: coInterpreter interpretAddress)
min: coInterpreter primitiveFailAddress.
methodZone manageFrom: methodZoneBase to: endAddress.
self assertValidDualZone.
self maybeGenerateCheckFeatures.
self maybeGenerateCheckLZCNT.
self maybeGenerateCacheFlush.
self generateVMOwnerLockFunctions.
self genGetLeafCallStackPointers.
self generateStackPointerCapture.
self generateTrampolines.
self computeEntryOffsets.
self computeFullBlockEntryOffsets.
self generateClosedPICPrototype.
self alignMethodZoneBase.
"None of the above is executed beyond ceCheckFeatures & ceCheckLZCNTFunction,
so a bulk flush now is the leanest thing to do."
self maybeFlushWritableZoneFrom: startAddress to: methodZoneBase asUnsignedInteger.
"repeat so that now the methodZone ignores the generated run-time"
methodZone manageFrom: methodZoneBase to: endAddress.
"N.B. this is assumed to be the last thing done in initialization; see Cogit>>initialized"
self generateOpenPICPrototype!
Item was changed:
----- Method: Cogit>>promptForBreakPC (in category 'simulation only') -----
promptForBreakPC
<doNotGenerate>
+ | s first bkpt |
- | s first pc |
s := UIManager default request: 'Break pc (hex, + to add, - to remove)'.
s := s withBlanksTrimmed.
s isEmpty ifTrue: [^self].
('+-' includes: s first) ifTrue: [first := s first. s := s allButFirst].
(s isEmpty and: [first = $-]) ifTrue:
[^self breakPC: nil].
+ bkpt := (s includes: $r)
- pc := (s includes: $r)
ifTrue:
[Number readFrom: s readStream]
ifFalse:
[(#('0x' '-0x') detect: [:prefix| s beginsWith: prefix] ifNone: []) ifNotNil:
[:prefix|
s := s allButFirst: prefix size.
prefix first = $- ifTrue: [s := '-', s]].
Integer readFrom: s readStream base: 16].
+ ((methodZone addressIsLikelyCogMethod: bkpt)
+ and: [UIManager confirm: 'pc is method; break anywhere within method?']) ifTrue:
+ [bkpt := methodZone methodFor: bkpt].
- ((methodZone addressIsLikelyCogMethod: pc)
- and: [UIManager confirm: 'pc is method; interpret as no check entry point?']) ifTrue:
- [pc := pc + cmNoCheckEntryOffset].
first = $+ ifTrue:
+ [^self breakPC: (breakPC addBreakpoint: bkpt)].
- [^self breakPC: (breakPC addBreakpoint: pc)].
first = $- ifTrue:
+ [^self breakPC: (breakPC removeBreakpoint: bkpt)].
+ self breakPC: bkpt!
- [^self breakPC: (breakPC removeBreakpoint: pc)].
- self breakPC: pc!
Item was changed:
----- Method: Cogit>>recordInstruction: (in category 'simulation only') -----
recordInstruction: thing
<doNotGenerate>
lastNInstructions addLast: thing.
+ [lastNInstructions size > 320"160""80"] whileTrue:
- [lastNInstructions size > 160"80"] whileTrue:
[lastNInstructions removeFirst.
lastNInstructions size * 2 > lastNInstructions capacity ifTrue:
[lastNInstructions makeRoomAtLast]].
^thing!
Item was removed:
- ----- Method: CogitFaker>>codeToDataDelta (in category 'accessing') -----
- codeToDataDelta
- ^0!
Item was added:
+ ----- Method: CogitFaker>>getCodeToDataDelta (in category 'accessing') -----
+ getCodeToDataDelta
+ ^0!
Item was added:
+ ----- Method: CurrentImageCoInterpreterFacade>>compilationBreak:point:classTag:isMNUCase: (in category 'debug support') -----
+ compilationBreak: aString point: length classTag: classTag isMNUCase: isMNUCase
+ ^self!
Item was changed:
+ ----- Method: Integer>>addBreakpoint: (in category '*VMMaker-breakpoints') -----
+ addBreakpoint: bkpt
+ ^{self. bkpt}!
- ----- Method: Integer>>addBreakpoint: (in category '*VMMaker-interpreter simulator') -----
- addBreakpoint: address
- ^{self. address}!
Item was changed:
+ ----- Method: Integer>>isActiveBreakpoint (in category '*VMMaker-breakpoints') -----
- ----- Method: Integer>>isActiveBreakpoint (in category '*VMMaker-interpreter simulator') -----
isActiveBreakpoint
^true!
Item was changed:
+ ----- Method: Integer>>isBreakpointFor: (in category '*VMMaker-breakpoints') -----
- ----- Method: Integer>>isBreakpointFor: (in category '*VMMaker-interpreter simulator') -----
isBreakpointFor: address
^self = address!
Item was changed:
+ ----- Method: Integer>>menuPrompt (in category '*VMMaker-breakpoints') -----
- ----- Method: Integer>>menuPrompt (in category '*VMMaker-interpreter simulator') -----
menuPrompt
^' (', self hex, ')'!
Item was changed:
+ ----- Method: Integer>>removeBreakpoint: (in category '*VMMaker-breakpoints') -----
- ----- Method: Integer>>removeBreakpoint: (in category '*VMMaker-interpreter simulator') -----
removeBreakpoint: address
^nil!
Item was changed:
+ ----- Method: Integer>>singleStepRequiredToTriggerIn: (in category '*VMMaker-breakpoints') -----
- ----- Method: Integer>>singleStepRequiredToTriggerIn: (in category '*VMMaker-interpreter simulator') -----
singleStepRequiredToTriggerIn: aCogit
^self between: aCogit cogCodeBase and: aCogit methodZone limitZony!
Item was changed:
----- Method: NewObjectMemory>>fetchClassTagOf: (in category 'interpreter access') -----
fetchClassTagOf: oop
"Compatibility with SpurObjectMemory. In ObjectMemory there is no distinction between a
classTag in the first-level method cache and a class itself."
+ <api>
^self fetchClassOf: oop!
Item was changed:
----- Method: NewspeakCogMethod class>>initialize (in category 'class initialization') -----
initialize
"self initialize"
+ (Smalltalk classNamed: #CogNewspeakMethodSurrogate32) ifNotNil:
- (Smalltalk classNamed: #NewspeakCogMethodSurrogate32) ifNotNil:
[:cms32|
self checkGenerateSurrogate: cms32 bytesPerWord: 4].
+ (Smalltalk classNamed: #CogNewspeakMethodSurrogate64) ifNotNil:
- (Smalltalk classNamed: #NewspeakCogMethodSurrogate64) ifNotNil:
[:cms64|
self checkGenerateSurrogate: cms64 bytesPerWord: 8]!
Item was added:
+ ----- Method: ObjectMemory>>fetchClassTagOfClass: (in category 'interpreter access') -----
+ fetchClassTagOfClass: classObj
+ <inline: #always>
+ ^classObj!
Item was changed:
+ ----- Method: SmallInteger>>isBreakpointFor: (in category '*VMMaker-breakpoints') -----
- ----- Method: SmallInteger>>isBreakpointFor: (in category '*VMMaker-interpreter simulator') -----
isBreakpointFor: address
<primitive: 7>
^self = address!
Item was changed:
----- Method: Spur32BitMemoryManager>>fetchClassTagOf: (in category 'interpreter access') -----
fetchClassTagOf: oop
+ "Answer the tag used in lookup caches for a receiver. This is the receiver's classIndex."
<api>
| tagBits |
^(tagBits := oop bitAnd: self tagMask) ~= 0
ifTrue: [(tagBits bitAnd: 1) ~= 0 ifTrue: [1] ifFalse: [tagBits]]
ifFalse: [self classIndexOf: oop]!
Item was changed:
----- Method: Spur64BitMemoryManager>>fetchClassTagOf: (in category 'interpreter access') -----
fetchClassTagOf: oop
+ "Answer the tag used in lookup caches for a receiver. This is the receiver's classIndex."
<api>
| tagBits |
^(tagBits := oop bitAnd: self tagMask) ~= 0
ifTrue: [tagBits]
ifFalse: [self classIndexOf: oop]!
Item was changed:
----- Method: SpurMemoryManager>>fetchClassTagOf: (in category 'interpreter access') -----
fetchClassTagOf: oop
+ "Answer the tag used in lookup caches for a receiver. This is the receiver's classIndex."
+ <api>
self subclassResponsibility!
Item was added:
+ ----- Method: SpurMemoryManager>>fetchClassTagOfClass: (in category 'interpreter access') -----
+ fetchClassTagOfClass: classObj
+ <inline: #always>
+ ^self rawHashBitsOf: classObj!
Item was added:
+ ----- Method: StackInterpreter>>couldBeContext: (in category 'simulation support') -----
+ couldBeContext: anAddress
+ ^(objectMemory addressCouldBeObj: anAddress)
+ and: [objectMemory isContextNonImm: anAddress]!
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].
+ breakLookupClassTag ifNil: [breakLookupClassTag := -1]].
- [breakSelectorLength := objectMemory minSmallInteger]].
methodDictLinearSearchLimit := 8.
self initialCleanup.
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 min: 16rFFFFFFFF)) asInteger]].
metaAccessorDepth := -2.
super initializeInterpreter: bytesToShift!
Item was changed:
----- Method: StackInterpreter>>lookupBreakFor: (in category 'debug support') -----
lookupBreakFor: lookupClass
<inline: true>
+ (breakSelectorLength <= 0
+ and: [objectMemory shouldBreakForLookupIn: lookupClass given: breakLookupClassTag]) ifTrue:
- (objectMemory shouldBreakForLookupIn: lookupClass given: breakLookupClassTag) ifTrue:
[self
cCode: [self warning: 'lookup class send break (heartbeat suppressed)']
inSmalltalk: [self halt: 'Lookup in class ', lookupClass hex]]!
Item was changed:
----- Method: StackInterpreter>>lookupMethodInClass: (in category 'message sending') -----
lookupMethodInClass: class
| currentClass dictionary found |
<inline: false>
self assert: (self addressCouldBeClassObj: class).
self lookupBreakFor: class.
currentClass := class.
[currentClass ~= objectMemory nilObject] whileTrue:
[dictionary := objectMemory followObjField: MethodDictionaryIndex ofObject: currentClass.
dictionary = objectMemory nilObject ifTrue:
["MethodDict pointer is nil (hopefully due a swapped out stub)
-- raise exception #cannotInterpret:."
self createActualMessageTo: class.
messageSelector := objectMemory splObj: SelectorCannotInterpret.
self sendBreakpoint: messageSelector receiver: nil.
^self lookupMethodInClass: (self superclassOf: currentClass)].
found := self lookupMethodInDictionary: dictionary.
found ifTrue: [^currentClass].
currentClass := self superclassOf: currentClass].
"Could not find #doesNotUnderstand: -- unrecoverable error."
messageSelector = (objectMemory splObj: SelectorDoesNotUnderstand) ifTrue:
[self error: 'Recursive not understood error encountered'].
"Cound not find a normal message -- raise exception #doesNotUnderstand:"
self createActualMessageTo: class.
messageSelector := objectMemory splObj: SelectorDoesNotUnderstand.
self sendBreak: messageSelector + objectMemory baseHeaderSize
point: (objectMemory lengthOf: messageSelector)
+ classTag: (objectMemory fetchClassTagOfClass: class).
- receiver: nil.
^self lookupMethodInClass: class!
Item was added:
+ ----- Method: StackInterpreter>>sendBreak:point:classTag: (in category 'debug support') -----
+ sendBreak: selectorString point: selectorLength classTag: classTag
+ <doNotGenerate> "C version is in platforms/Cross/vm/dispdbg.h"
+ "self shortPrintFrameAndCallers: localFP"
+ | i |
+ breakSelectorLength = selectorLength ifTrue:
+ [i := breakSelectorLength.
+ [i > 0] whileTrue:
+ [(objectMemory byteAt: selectorString + i - 1) = (breakSelector at: i) asInteger
+ ifTrue:
+ [((i := i - 1) = 0
+ and: [breakLookupClassTag < 0 or: [breakLookupClassTag = classTag]]) ifTrue:
+ [self changed: #byteCountText.
+ self halt: 'Send of ', breakSelector]]
+ ifFalse: [i := 0]]]!
Item was removed:
- ----- Method: StackInterpreter>>sendBreak:point:receiver: (in category 'debug support') -----
- sendBreak: selectorString point: selectorLength receiver: receiverOrNil
- <doNotGenerate> "C version is in platforms/Cross/vm/dispdbg.h"
- "self shortPrintFrameAndCallers: localFP"
- | i |
- breakSelectorLength = selectorLength ifTrue:
- [i := breakSelectorLength.
- [i > 0] whileTrue:
- [(objectMemory byteAt: selectorString + i - 1) = (breakSelector at: i) asInteger
- ifTrue: [(i := i - 1) = 0 ifTrue:
- [self changed: #byteCountText.
- self halt: 'Send of '
- , breakSelector,
- (receiverOrNil
- ifNotNil: [' to ', (self shortPrint: receiverOrNil)]
- ifNil: [''])]]
- ifFalse: [i := 0]]]!
Item was changed:
----- Method: StackInterpreter>>sendBreakpoint:receiver: (in category 'debug support') -----
sendBreakpoint: selector receiver: rcvr
<inline: true>
self sendBreak: (objectMemory firstFixedFieldOfMaybeImmediate: selector)
point: (objectMemory lengthOfMaybeImmediate: selector)
+ classTag: (objectMemory fetchClassTagOf: rcvr)!
- receiver: rcvr!
Item was added:
+ ----- Method: StackInterpreter>>setBreakLookupClassTag: (in category 'debug support') -----
+ setBreakLookupClassTag: aClassTag
+ breakLookupClassTag := aClassTag!
Item was changed:
+ ----- Method: UndefinedObject>>addBreakpoint: (in category '*VMMaker-breakpoints') -----
+ addBreakpoint: bkpt
+ ^bkpt!
- ----- Method: UndefinedObject>>addBreakpoint: (in category '*VMMaker-interpreter simulator') -----
- addBreakpoint: address
- ^address!
Item was changed:
+ ----- Method: UndefinedObject>>isActiveBreakpoint (in category '*VMMaker-breakpoints') -----
- ----- Method: UndefinedObject>>isActiveBreakpoint (in category '*VMMaker-interpreter simulator') -----
isActiveBreakpoint
^false!
Item was changed:
+ ----- Method: UndefinedObject>>isBreakpointFor: (in category '*VMMaker-breakpoints') -----
- ----- Method: UndefinedObject>>isBreakpointFor: (in category '*VMMaker-interpreter simulator') -----
isBreakpointFor: address
^false!
Item was changed:
+ ----- Method: UndefinedObject>>menuPrompt (in category '*VMMaker-breakpoints') -----
- ----- Method: UndefinedObject>>menuPrompt (in category '*VMMaker-interpreter simulator') -----
menuPrompt
^''!
Item was changed:
+ ----- Method: UndefinedObject>>singleStepRequiredToTriggerIn: (in category '*VMMaker-breakpoints') -----
- ----- Method: UndefinedObject>>singleStepRequiredToTriggerIn: (in category '*VMMaker-interpreter simulator') -----
singleStepRequiredToTriggerIn: aCogit
^false!
More information about the Vm-dev
mailing list