[Vm-dev] VM Maker: VMMaker.oscog-lw.195.mcz
commits at source.squeak.org
commits at source.squeak.org
Wed Aug 8 12:46:49 UTC 2012
Lars Wassermann uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-lw.195.mcz
==================== Summary ====================
Name: VMMaker.oscog-lw.195
Author: lw
Time: 8 August 2012, 2:41:47.364 pm
UUID: 688e3bfe-33cb-a74f-a6df-a41bee506615
Ancestors: VMMaker.oscog-lw.194
Changed runCmpRdRd to allow compiler without FP support to skip this abstract test.
Fixed two bugs in connection with conditional jumps, which make the three abstract conditional jump tests green.
=============== Diff against VMMaker.oscog-lw.194 ===============
Item was changed:
----- Method: AbstractInstructionTests>>runBinaryConditionalJumps: (in category 'running') -----
runBinaryConditionalJumps: assertPrintBar
"self defaultTester runBinaryConditionalJumps: false"
| mask reg1 reg2 reg3 |
mask := (1 << self processor bitsInWord) - 1.
self concreteCompilerClass dataRegistersWithAccessorsDo:
[:n :get :set|
n = 0 ifTrue: [reg1 := get].
n = 1 ifTrue: [reg2 := set].
n = 2 ifTrue: [reg3 := set]].
#( (JumpAbove > unsigned) (JumpBelowOrEqual <= unsigned)
(JumpBelow < unsigned) (JumpAboveOrEqual >= unsigned)
(JumpGreater > signed) (JumpLessOrEqual <= signed)
(JumpLess < signed) (JumpGreaterOrEqual >= signed)
(JumpZero = signed) (JumpNonZero ~= signed)) do:
[:triple|
[:opName :relation :signednessOrResult| | opcode jumpNotTaken jumpTaken nop memory bogus |
self resetGen.
opcode := CogRTLOpcodes classPool at: opName.
self gen: CmpRR operand: 2 operand: 1.
jumpTaken := self gen: opcode.
self gen: MoveCqR operand: 0 operand: 0.
jumpNotTaken := self gen: Jump.
jumpTaken jmpTarget: (self gen: MoveCqR operand: 1 operand: 0).
jumpNotTaken jmpTarget: (nop := self gen: Nop).
memory := self generateInstructions.
+ "self processor disassembleFrom: 0 to: memory size in: memory on: Transcript"
bogus := false.
self pairs: (-2 to: 2) do:
[:a :b| | taken |
self processor
reset;
perform: reg2 with: a signedIntToLong;
perform: reg3 with: b signedIntToLong.
[self processor singleStepIn: memory.
self processor pc ~= nop address] whileTrue.
taken := (self processor perform: reg1) = 1.
assertPrintBar
ifTrue:
[self assert: taken = (signednessOrResult == #unsigned
ifTrue: [(a bitAnd: mask) perform: relation with: (b bitAnd: mask)]
ifFalse: [a perform: relation with: b])]
ifFalse:
[Transcript
nextPutAll: reg2; nextPut: $(; print: a; nextPutAll: ') '; nextPutAll: relation; space;
nextPutAll: reg3; nextPut: $(; print: b; nextPutAll: ') = ';
print: taken; cr; flush.
taken = (signednessOrResult == #unsigned
ifTrue: [(a bitAnd: mask) perform: relation with: (b bitAnd: mask)]
ifFalse: [a perform: relation with: b]) ifFalse:
[bogus := true]]].
bogus ifTrue:
[self processor printRegistersOn: Transcript.
Transcript show: (self processor disassembleInstructionAt: jumpTaken address In: memory); cr]]
valueWithArguments: triple]!
Item was changed:
----- Method: AbstractInstructionTests>>runCmpRdRd: (in category 'running') -----
runCmpRdRd: assertPrintBar
"self defaultTester runCmpRdRd: false"
"self defaultTester runCmpRdRd: true"
| resultReg result reg1 reg2 setreg1 setreg2 |
+ self concreteCompilerClass new hasDoublePrecisionFloatingPointSupport ifFalse: [^true].
resultReg := 0.
self concreteCompilerClass dataRegistersWithAccessorsDo:
[:n :get :set| n = resultReg ifTrue: [result := get]].
self concreteCompilerClass fp64RegistersWithAccessorsDo:
[:n :get :set|
n = DPFPReg0 ifTrue: [reg1 := get. setreg1 := set].
n = DPFPReg1 ifTrue: [reg2 := set. setreg2 := set]].
#( (genJumpFPGreater: > false nan) (genJumpFPLessOrEqual: <= false nil)
(genJumpFPLess: < false nil) (genJumpFPGreaterOrEqual: <= true nan)
(genJumpFPGreater: < true nan) (genJumpFPGreaterOrEqual: >= false nan)
(genJumpFPEqual: = false nan) (genJumpFPNotEqual: ~= false nan)) do:
[:tuple|
[:opName :relation :invert :nan| | them inst jumpNotTaken jumpTaken nop memory |
them := nan ifNil: [-2.0 to: 2.0] ifNotNil: [(-2.0 to: 2.0), { Float nan }].
self resetGen.
inst := invert
ifTrue: [self gen: CmpRdRd operand: DPFPReg0 operand: DPFPReg1]
ifFalse: [self gen: CmpRdRd operand: DPFPReg1 operand: DPFPReg0].
jumpTaken := inst perform: opName with: 0.
self gen: MoveCqR operand: 0 operand: resultReg.
jumpNotTaken := self gen: Jump.
jumpTaken jmpTarget: (self gen: MoveCqR operand: 1 operand: resultReg).
jumpNotTaken jmpTarget: (nop := self gen: Nop).
memory := self generateInstructions.
assertPrintBar ifFalse:
[Transcript print: tuple; cr.
self disassembleOpcodesIn: memory to: Transcript].
them do:
[:a|
them do:
[:b| | taken expected |
self processor
reset;
perform: setreg1 with: a asIEEE64BitWord;
perform: setreg2 with: b asIEEE64BitWord.
[self processor singleStepIn: memory.
self processor pc ~= nop address] whileTrue.
taken := (self processor perform: result) = 1.
expected := a perform: relation with: b.
assertPrintBar
ifTrue:
[self assert: taken = expected]
ifFalse:
[Transcript
nextPutAll: 'CmpRdRd ', reg1, ' ', reg2; tab; tab;
nextPutAll: reg1; nextPut: $(; print: a; nextPut: $); space;
nextPutAll: relation; space;
nextPutAll: reg2; nextPut: $(; print: b; nextPut: $); space;
nextPutAll: ' = '; print: taken; nextPutAll: ' ('; print: expected; nextPut: $).
taken ~= expected ifTrue:
[Transcript nextPutAll: ' !!!!'; cr.
self processor printRegistersOn: Transcript.].
Transcript cr; flush]]]]
valueWithArguments: tuple]!
Item was changed:
----- Method: CogARMCompiler>>computeMaximumSize (in category 'generate machine code') -----
computeMaximumSize
"Because we don't use Thumb, each instruction has a multiple of 4 bytes. Most have exactly 4, but some abstract opcodes need more than one instruction."
({CmpCqR. AddCqR. SubCqR. AndCqR. OrCqR. XorCqR}
anySatisfy: [ :each | each = opcode])
ifTrue: [^self rotateable8bitImmediate: (operands at: 0)
ifTrue: [:r :i| maxSize := 4]
ifFalse: [maxSize := 20]].
({CmpCwR. AddCwR. SubCwR. AndCwR. OrCwR. XorCwR}
anySatisfy: [ :each | each = opcode])
ifTrue: [^maxSize := 20].
({Jump. JumpR. JumpZero. JumpNonZero. JumpNegative. JumpNonNegative. JumpOverflow.
JumpOverflow. JumpNoOverflow. JumpCarry. JumpNoCarry. JumpLess. JumpGreaterOrEqual. JumpGreater. JumpLessOrEqual. JumpBelow. JumpAboveOrEqual}
anySatisfy: [ :each | each = opcode])
+ ifTrue: [^maxSize := 16].
- ifTrue: [^maxSize := 20].
opcode
caseOf: {
[Label] -> [^maxSize := 0].
[AlignmentNops] -> [^maxSize := (operands at: 0) - 1].
[MoveAwR] -> [^maxSize := 16].
[MoveCqR] -> [^self rotateable8bitImmediate: (operands at: 0)
ifTrue: [:r :i| maxSize := 4]
ifFalse: [maxSize := 16]].
[MoveCwR] -> [^maxSize := 16].
[MoveRAw] -> [^maxSize := 16].
[MoveRMwr] -> [self is12BitValue: (operands at: 1)
ifTrue: [ :u :i | ^maxSize := 4]
ifFalse: [ ^maxSize := 20 ]].
[MoveRMbr] -> [self is12BitValue: (operands at: 1)
ifTrue: [ :u :i | ^maxSize := 4]
ifFalse: [ ^maxSize := 20 ]].
[MoveMwrR] -> [self is12BitValue: (operands at: 0)
ifTrue: [ :u :i | ^maxSize := 4]
ifFalse: [ ^maxSize := 20 ]].
[MoveMbrR] -> [self is12BitValue: (operands at: 0)
ifTrue: [ :u :i | ^maxSize := 4]
ifFalse: [ ^maxSize := 20 ]].
[PrefetchAw] -> [^maxSize := 16].
[RetN] -> [^(operands at: 0) = 0
ifTrue: [maxSize := 4]
ifFalse: [maxSize := 8]].
[JumpR] -> [^maxSize := 8].
[JumpFPEqual] -> [^maxSize := 8].
[JumpFPNotEqual] -> [^maxSize := 8].
[JumpFPLess] -> [^maxSize := 8].
[JumpFPGreaterOrEqual] -> [^maxSize := 8].
[JumpFPGreater] -> [^maxSize := 8].
[JumpFPLessOrEqual] -> [^maxSize := 8].
[JumpFPOrdered] -> [^maxSize := 8].
[JumpFPUnordered] -> [^maxSize := 8].
+ [JumpLong] -> [^maxSize := 16].
+ [JumpLongZero] -> [^maxSize := 16].
+ [JumpLongNonZero] -> [^maxSize := 16].
- [JumpLong] -> [^maxSize := 20].
- [JumpLongZero] -> [^maxSize := 20].
- [JumpLongNonZero] -> [^maxSize := 20].
[LoadEffectiveAddressMwrR] -> [self rotateable8bitImmediate: (operands at: 0)
ifTrue: [ :r :i | ^maxSize := 4]
ifFalse: [^maxSize := 20]].
[PushCw] -> [^maxSize := 20].
}
otherwise: [^maxSize := 4].
^4 "to keep C compiler quiet"
!
Item was changed:
----- Method: CogARMCompiler>>concretizeCall (in category 'generate machine code - concretize') -----
concretizeCall
"Will get inlined into concretizeAt: switch."
<inline: true>
| offset |
self assert: (operands at: 0) ~= 0.
self assert: (operands at: 0) \\ 4 = 0.
offset := (operands at: 0) signedIntFromLong - (address + 8) signedIntFromLong.
(self isQuick: offset)
ifTrue: [
self machineCodeAt: 0 put: (self t: 5 o: 8) + (offset >> 2 bitAnd: 16r00FFFFFF). "BL offset"
^machineCodeSize := 4]
ifFalse: [
+
+ self concretizeConditionalJumpLong: AL.
+ self machineCodeAt: 16 put: (self machineCodeAt: 12).
+ "mov lr, pc"
+ "Because the pc always points to the actual address + 8, the value at pc is the address of the instruction after the branch (add pc, r3, #<byte0>"
+ self machineCodeAt: 12 put: (self t: 0 o: 16rD s: 0 rn: 0 rd: LR shifterOperand: PC).
+ ^machineCodeSize := 20]
- self notYetImplemented]
"We should push at least lr. The problem is, that any push added here is only executed after return, and therefore useless."!
Item was changed:
----- Method: CogARMCompiler>>concretizeConditionalJump: (in category 'generate machine code - concretize') -----
concretizeConditionalJump: conditionCode
"Will get inlined into concretizeAt: switch."
"Sizing/generating jumps.
Jump targets can be to absolute addresses or other abstract instructions.
Generating initial trampolines instructions may have no maxSize and be to absolute addresses.
Otherwise instructions must have a machineCodeSize which must be kept to."
<inline: true>
| offset |
offset := self computeJumpTargetOffsetPlus: 8.
(self isQuick: offset)
ifTrue: [
+ self machineCodeAt: 0 put: (self c: conditionCode t: 5 o: 0 s: 0) + (offset >> 2 bitAnd: 16r00FFFFFF). "B offset"
- self machineCodeAt: 0 put: (self t: 5 o: 8) + (offset >> 2 bitAnd: 16r00FFFFFF). "BL offset"
^machineCodeSize := 4]
ifFalse: [
^self concretizeConditionalJumpLong: conditionCode]!
Item was changed:
----- Method: CogARMCompiler>>concretizeConditionalJumpLong: (in category 'generate machine code - concretize') -----
concretizeConditionalJumpLong: conditionCode
"Will get inlined into concretizeAt: switch."
"Sizing/generating jumps.
Jump targets can be to absolute addresses or other abstract instructions.
Generating initial trampolines instructions may have no maxSize and be to absolute addresses.
Otherwise instructions must have a machineCodeSize which must be kept to."
<inline: true>
| jumpTarget |
<var: #jumpTarget type: #'AbstractInstruction *'>
jumpTarget := self longJumpTargetAddress.
self at: 0 moveCw: jumpTarget intoR: RISCTempReg.
- "mov lr, pc"
- "Because the pc always points to the actual address + 8, the value at pc is the address of the instruction after the branch (add pc, r3, #<byte0>"
- self machineCodeAt: 12 put: (self t: 0 o: 16rD s: 0 rn: 0 rd: LR shifterOperand: PC).
"add pc, r3, #<byte 0>"
+ self machineCodeAt: 12 put: (self t: 1 o: 4 s: 0 rn: RISCTempReg rd: PC shifterOperand: (jumpTarget bitAnd: 16rFF)).
+ ^machineCodeSize := 16!
- self machineCodeAt: 16 put: (self t: 1 o: 4 s: 0 rn: RISCTempReg rd: PC shifterOperand: (jumpTarget bitAnd: 16rFF)).
- ^machineCodeSize := 20!
Item was changed:
----- Method: CogARMCompiler>>dispatchConcretize (in category 'generate machine code') -----
dispatchConcretize
"Attempt to generate concrete machine code for the instruction at address.
This is the inner dispatch of concretizeAt: actualAddress which exists only
to get around the branch size limits in the SqueakV3 (blue book derived)
bytecode set."
opcode caseOf: {
"Noops & Pseudo Ops"
[Label] -> [^self concretizeLabel].
[AlignmentNops] -> [^self concretizeAlignmentNops].
[Fill16] -> [^self concretizeFill16].
[Fill32] -> [^self concretizeFill32].
[FillFromWord] -> [^self concretizeFillFromWord].
[Nop] -> [^self concretizeNop].
"Specific Control/Data Movement"
"[LDM] -> [^self concretizeLDM].
[STM] -> [^self concretizeSTM]."
"Control"
[Call] -> [^self concretizeCall].
[JumpR] -> [^self concretizeJumpR].
[JumpLong] -> [^self concretizeConditionalJumpLong: AL].
[JumpLongZero] -> [^self concretizeConditionalJumpLong: EQ].
[JumpLongNonZero] -> [^self concretizeConditionalJumpLong: NE].
[Jump] -> [^self concretizeConditionalJump: AL].
[JumpZero] -> [^self concretizeConditionalJump: EQ].
[JumpNonZero] -> [^self concretizeConditionalJump: NE].
[JumpNegative] -> [^self concretizeConditionalJump: MI].
[JumpNonNegative] -> [^self concretizeConditionalJump: PL].
[JumpOverflow] -> [^self concretizeConditionalJump: VS].
[JumpNoOverflow] -> [^self concretizeConditionalJump: VC].
[JumpCarry] -> [^self concretizeConditionalJump: CS].
[JumpNoCarry] -> [^self concretizeConditionalJump: CC].
[JumpLess] -> [^self concretizeConditionalJump: LT].
[JumpGreaterOrEqual] -> [^self concretizeConditionalJump: GE].
[JumpGreater] -> [^self concretizeConditionalJump: GT].
[JumpLessOrEqual] -> [^self concretizeConditionalJump: LE].
+ [JumpBelow] -> [^self concretizeConditionalJump: CC]. "unsigned lower"
+ [JumpAboveOrEqual] -> [^self concretizeConditionalJump: CS]. "unsigned greater or equal"
- [JumpBelow] -> [^self concretizeConditionalJump: CS]. "according to http://courses.engr.illinois.edu/ece390/books/labmanual/assembly.html"
- [JumpAboveOrEqual] -> [^self concretizeConditionalJump: CC]. " --""-- "
[JumpAbove] -> [^self concretizeConditionalJump: HI].
[JumpBelowOrEqual] -> [^self concretizeConditionalJump: LS].
[JumpFPEqual] -> [^self concretizeFPConditionalJump: EQ].
[JumpFPNotEqual] -> [^self concretizeFPConditionalJump: NE].
"[JumpFPLess] -> [^self concretizeFPConditionalJump: LT].
[JumpFPGreaterOrEqual] -> [^self concretizeFPConditionalJump: GE].
[JumpFPGreater] -> [^self concretizeFPConditionalJump: GT].
[JumpFPLessOrEqual] -> [^self concretizeFPConditionalJump: LE].
[JumpFPOrdered] -> [^self concretizeFPConditionalJump: VC].
[JumpFPUnordered] -> [^self concretizeFPConditionalJump: VS]."
[RetN] -> [^self concretizeRetN].
"Arithmetic"
[AddCqR] -> [^self concretizeAddCqR].
[AddCwR] -> [^self concretizeDataOperationCwR: 4].
[AddRR] -> [^self concretizeDataOperationRR: 4].
"[AddRdRd] -> [^self concretizeSEE2OpRdRd: 16r58]."
[AndCqR] -> [^self concretizeDataOperationCqR: 0].
[AndCwR] -> [^self concretizeDataOperationCwR: 0].
[AndRR] -> [^self concretizeDataOperationRR: 0].
[CmpCqR] -> [^self concretizeCmpCqR].
[CmpCwR] -> [^self concretizeCmpCwR].
[CmpRR] -> [^self concretizeCmpRR].
[CmpRdRd] -> [^self concretizeCmpRdRd].
"[DivRdRd] -> [^self concretizeSEE2OpRdRd: 16r5E].
[MulRdRd] -> [^self concretizeSEE2OpRdRd: 16r59]."
[OrCqR] -> [^self concretizeDataOperationCqR: 16rC].
[OrCwR] -> [^self concretizeDataOperationCwR: 16rC].
[OrRR] -> [^self concretizeDataOperationRR: 16rC].
[SubCqR] -> [^self concretizeSubCqR].
[SubCwR] -> [^self concretizeDataOperationCwR: 2].
[SubRR] -> [^self concretizeDataOperationRR: 2].
"[SubRdRd] -> [^self concretizeSEE2OpRdRd: 16r5C]."
[SqrtRd] -> [^self concretizeSqrtRd].
[XorCqR] -> [^self concretizeDataOperationCqR: 1].
[XorCwR] -> [^self concretizeDataOperationCwR: 1].
[XorRR] -> [^self concretizeDataOperationRR: 1].
[NegateR] -> [^self concretizeNegateR].
[LoadEffectiveAddressMwrR] -> [^self concretizeLoadEffectiveAddressMwrR].
[ArithmeticShiftRightCqR] -> [^self concretizeArithmeticShiftRightCqR].
[LogicalShiftRightCqR] -> [^self concretizeLogicalShiftRightCqR].
[LogicalShiftLeftCqR] -> [^self concretizeLogicalShiftLeftCqR].
[ArithmeticShiftRightRR] -> [^self concretizeArithmeticShiftRightRR].
[LogicalShiftLeftRR] -> [^self concretizeLogicalShiftLeftRR].
[LogicalShiftRightRR] -> [^self concretizeLogicalShiftRightRR].
"Data Movement"
[MoveCqR] -> [^self concretizeMoveCqR].
[MoveCwR] -> [^self concretizeMoveCwR].
[MoveRR] -> [^self concretizeMoveRR].
[MoveAwR] -> [^self concretizeMoveAwR].
[MoveRAw] -> [^self concretizeMoveRAw].
"While the two MoveMbR and MoveMwR are quite similar (off by 1 bit), they differ way more to
MoveM16R and MoveM64R. Because of that, they are not merged."
[MoveMbrR] -> [^self concretizeMoveMbrR].
[MoveRMbr] -> [^self concretizeMoveRMbr].
[MoveM16rR] -> [^self concretizeMoveM16rR].
[MoveM64rRd] -> [^self concretizeMoveM64rRd].
[MoveMwrR] -> [^self concretizeMoveMwrR].
[MoveXbrRR] -> [^self concretizeMoveXbrRR].
[MoveXwrRR] -> [^self concretizeMoveXwrRR].
[MoveRXwrR] -> [^self concretizeMoveRXwrR].
[MoveRMwr] -> [^self concretizeMoveRMwr].
[MoveRdM64r] -> [^self concretizeMoveRdM64r].
[PopR] -> [^self concretizePopR].
[PushR] -> [^self concretizePushR].
[PushCw] -> [^self concretizePushCw].
[PrefetchAw] -> [^self concretizePrefetchAw].
"Conversion"
[ConvertRRd] -> [^self concretizeConvertRRd].
"ARM specific opcodes"
[LDMFD] -> [^self concretizeLDMFD].
[STMFD] -> [^self concretizeSTMFD] }!
Item was added:
+ ----- Method: CogARMCompiler>>isCallPreceedingReturnPC: (in category 'testing') -----
+ isCallPreceedingReturnPC: mcpc
+ "Assuming mcpc is a return pc answer if the instruction before it is a call."
+ "There are two types of calls: BL and (MOV, ORR, ORR, MOV, ADD)"
+ ^(objectMemory byteAt: mcpc - 3) >> 4 = 16rB
+ or: [ (objectMemory longAt: mcpc - 8) = 16rE1A0E00F "MOV pc, lr" ]
+ "MOV pc, lr is sufficient as a test, because call instructions are the only insturctions, during which lr is loaded from pc."!
Item was added:
+ ----- Method: CogARMCompiler>>machineCodeAt: (in category 'accessing') -----
+ machineCodeAt: anOffset
+ "read aWord from machineCode, with little endian"
+ <inline: true>
+ ^((machineCode at: anOffset"+0")"<< 0" bitOr: (machineCode at: anOffset + 1) << 8)
+ bitOr: ((machineCode at: anOffset + 2) << 16 bitOr: (machineCode at: anOffset + 3) << 24)
+ !
Item was changed:
----- Method: CogARMCompiler>>sizePCDependentInstructionAt: (in category 'generate machine code') -----
sizePCDependentInstructionAt: eventualAbsoluteAddress
"Size a jump and set its address. The target may be another instruction
or an absolute address. On entry the address inst var holds our virtual
address. On exit address is set to eventualAbsoluteAddress, which is
where this instruction will be output. The span of a jump to a following
instruction is therefore between that instruction's address and this
instruction's address ((which are both still their virtual addresses), but the
span of a jump to a preceeding instruction or to an absolute address is
between that instruction's address (which by now is its eventual absolute
address) or absolute address and eventualAbsoluteAddress."
| target maximumSpan |
<var: #abstractInstruction type: #'AbstractInstruction *'>
opcode = AlignmentNops ifTrue:
[| alignment |
address := eventualAbsoluteAddress.
alignment := operands at: 0.
^machineCodeSize := (eventualAbsoluteAddress + (alignment - 1) bitAnd: alignment negated)
- eventualAbsoluteAddress].
self assert: (self isJump or: [opcode = Call]).
self isJump ifTrue: [self resolveJumpTarget].
target := operands at: 0.
"maximumSpan calculation copied from CogIA32Compiler TODO: extract method?"
(self isAnInstruction: (cogit cCoerceSimple: target to: #'void *'))
ifTrue:
[| abstractInstruction |
abstractInstruction := cogit cCoerceSimple: target to: #'AbstractInstruction *'.
maximumSpan := abstractInstruction address
- (((cogit abstractInstruction: self follows: abstractInstruction)
ifTrue: [eventualAbsoluteAddress]
ifFalse: [address]) + 2)]
ifFalse:
[maximumSpan := target - (eventualAbsoluteAddress + 2)].
address := eventualAbsoluteAddress.
^machineCodeSize := (self isLongJump not and: [self isQuick: maximumSpan])
ifTrue: [4] "branch"
+ ifFalse: [16] "load address to register, add"!
- ifFalse: [20] "load address to register, add"!
Item was changed:
----- Method: Cogit>>simulateCogCodeAt: (in category 'simulation only') -----
simulateCogCodeAt: address "<Integer>"
<doNotGenerate>
| stackZoneBase |
stackZoneBase := coInterpreter stackZoneBase.
+ processor pc: address.
- processor eip: address.
[[[singleStep ifTrue:
[[processor sp < stackZoneBase ifTrue: [self halt].
self recordRegisters.
printRegisters ifTrue:
[processor printRegistersOn: coInterpreter transcript].
self recordLastInstruction.
printInstructions ifTrue:
[coInterpreter transcript nextPutAll: lastNInstructions last; cr; flush].
(breakPC isInteger
ifTrue:
[processor pc = breakPC
and: [breakBlock value: self]]
ifFalse:
[breakBlock value: self]) ifTrue:
["printRegisters := printInstructions := true"
"self reportLastNInstructions"
"coInterpreter printExternalHeadFrame"
"coInterpreter printFrameAndCallers: coInterpreter framePointer SP: coInterpreter stackPointer"
"coInterpreter shortPrintFrameAndCallers: coInterpreter framePointer"
"coInterpreter printFrame: processor fp WithSP: processor sp"
"coInterpreter printFrameAndCallers: processor fp SP: processor sp"
"coInterpreter shortPrintFrameAndCallers: processor fp"
"self disassembleMethodFor: processor pc"
coInterpreter changed: #byteCountText.
self halt: 'machine code breakpoint at ',
(breakPC isInteger
ifTrue: [breakPC hex]
ifFalse: [String streamContents: [:s| breakBlock decompile printOn: s indent: 0]])]] value]. "So that the Debugger's Over steps over all this"
singleStep
ifTrue: [processor
singleStepIn: coInterpreter memory
minimumAddress: guardPageSize
readOnlyBelow: coInterpreter cogCodeSize]
ifFalse: [processor
runInMemory: coInterpreter memory
minimumAddress: guardPageSize
readOnlyBelow: coInterpreter cogCodeSize].
((printRegisters or: [printInstructions]) and: [clickConfirm]) ifTrue:
[(self confirm: 'continue?') ifFalse:
[self halt]].
true] whileTrue]
on: ProcessorSimulationTrap
do: [:ex| self handleSimulationTrap: ex].
true] whileTrue!
More information about the Vm-dev
mailing list