Vm-dev August 2012

vm-dev@lists.squeakfoundation.org

18 participants
60 discussions

VM Maker: VMMaker.oscog-lw.197.mcz
by commits＠source.squeak.org 09 Aug '12

09 Aug '12

Lars Wassermann uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-lw.197.mcz ==================== Summary ==================== Name: VMMaker.oscog-lw.197 Author: lw Time: 9 August 2012, 9:20:25.228 pm UUID: 083108ce-456b-f845-be3e-9178a073a073 Ancestors: VMMaker.oscog-eem.196 Fix of #concretizeConditionalJumpLong:. Refactoring of computeMaximumSize, with the goal to be translatable to C. =============== Diff against VMMaker.oscog-eem.196 =============== Item was added: + ----- Method: CogARMCompiler>>c:t:o:s:rn:rd: (in category 'encoding') ----- + c: conditionCode t: type o: flagsOrOpcode s: doUpdateStatusRegister rn: sourceRegister rd: targetRegister + <inline: true> + ^(self c: conditionCode t: type o: flagsOrOpcode s: doUpdateStatusRegister) + bitOr: (sourceRegister << 16 bitOr: targetRegister << 12)! Item was added: + ----- Method: CogARMCompiler>>c:t:o:s:rn:rd:shifterOperand: (in category 'encoding') ----- + c: conditionCode t: type o: flagsOrOpcode s: doUpdateStatusRegister rn: sourceRegister rd: targetRegister shifterOperand: so + <inline: true> + ^(self c: conditionCode t: type o: flagsOrOpcode s: doUpdateStatusRegister rn: sourceRegister rd: targetRegister) bitOr: so! Item was changed: ----- Method: CogARMCompiler>>computeMaximumSize (in category 'generate machine code') ----- computeMaximumSize + "Because we don't use Thumb, each ARM instruction has 4 bytes. Some abstract opcodes need more than one instruction." - "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." + | rotateableAt0then4or20Block | + rotateableAt0then4or20Block := [^self rotateable8bitImmediate: (operands at: 0) - ({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]. + (opcode between: FirstShortJump and: LastJump) ifTrue: [^maxSize := 16]. + 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]]. + [CmpCqR] -> [rotateableAt0then4or20Block value]. + [AddCqR] -> [rotateableAt0then4or20Block value]. + [SubCqR] -> [rotateableAt0then4or20Block value]. + [AndCqR] -> [rotateableAt0then4or20Block value]. + [OrCqR] -> [rotateableAt0then4or20Block value]. + [XorCqR] -> [rotateableAt0then4or20Block value]. + [CmpCwR] -> [^maxSize := 20]. + [AddCwR] -> [^maxSize := 20]. + [SubCwR] -> [^maxSize := 20]. + [AndCwR] -> [^maxSize := 20]. + [OrCwR] -> [^maxSize := 20]. + [XorCwR] -> [^maxSize := 20]. + [JumpR] -> [^maxSize := 4]. - [JumpR] -> [^maxSize := 8]. [JumpFPEqual] -> [^maxSize := 8]. [JumpFPNotEqual] -> [^maxSize := 8]. [JumpFPLess] -> [^maxSize := 8]. + [JumpFPGreaterOrEqual]-> [^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]. + [LoadEffectiveAddressMwrR] -> [rotateableAt0then4or20Block value]. - [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. + "move the actual jump one instruction later, insterting the pc back up to lr." 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] + "We should push also lr. The problem is, that any push added here is only executed after return, and therefore useless."! - "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>>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. "add pc, r3, #<byte 0>" + self machineCodeAt: 12 put: (self c: conditionCode t: 1 o: 4 s: 0 rn: RISCTempReg rd: PC shifterOperand: (jumpTarget bitAnd: 16rFF)). - self machineCodeAt: 12 put: (self t: 1 o: 4 s: 0 rn: RISCTempReg rd: PC shifterOperand: (jumpTarget bitAnd: 16rFF)). ^machineCodeSize := 16! Item was changed: ----- Method: CogARMCompiler>>concretizeJumpR (in category 'generate machine code - concretize') ----- concretizeJumpR "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> | reg | reg := self concreteRegister: (operands at: 0). - "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: 0 put: (self t: 0 o: 16rD s: 0 rn: 0 rd: LR shifterOperand: PC). "mov pc, r?, #0" + self machineCodeAt: 0 put: (self t: 0 o: 16rD s: 0 rn: 0 rd: PC shifterOperand: reg). + ^machineCodeSize := 4! - self machineCodeAt: 4 put: (self t: 0 o: 16rD s: 0 rn: 0 rd: PC shifterOperand: reg). - ^machineCodeSize := 8! Item was changed: ----- Method: CogARMCompiler>>concretizeMoveRMbr (in category 'generate machine code - concretize') ----- concretizeMoveRMbr "Will get inlined into concretizeAt: switch." <inline: true> | srcReg offset destReg | srcReg := self concreteRegister: (operands at: 0). offset := operands at: 1. destReg := self concreteRegister: (operands at: 2). self is12BitValue: offset ifTrue: [ :u :immediate | - "ldr: (self t: 2 o: (8 bitOr: u <<2) s: 1 rn: srcReg rd: destReg shifterOperand: immediate)." self machineCodeAt: 0 "strb destReg, [srcReg, #immediate]" put: (self t: 2 o: (16rA bitOr: u<<2) s: 0 rn: destReg rd: srcReg shifterOperand: immediate). ^machineCodeSize := 4] ifFalse: [ self at: 0 moveCw: offset intoR: RISCTempReg. "strb destReg, [srcReg, RISCTempReg]" self machineCodeAt: 16 put: (self t: 3 o: 16rE s: 0 rn: srcReg rd: destReg shifterOperand: RISCTempReg). ^machineCodeSize := 20 ]! Item was changed: ----- Method: CogARMCompiler>>concretizeMoveRMwr (in category 'generate machine code - concretize') ----- concretizeMoveRMwr "Will get inlined into concretizeAt: switch." <inline: true> | srcReg offset destReg | srcReg := self concreteRegister: (operands at: 0). offset := operands at: 1. destReg := self concreteRegister: (operands at: 2). self is12BitValue: offset ifTrue: [ :u :immediate | - "ldr (self t: 2 o: (8 bitOr: u <<2) s: 1 rn: srcReg rd: destReg shifterOperand: immediate)." self machineCodeAt: 0 "strb destReg, [srcReg, #immediate]" put: (self t: 2 o: (8 bitOr: u<<2) s: 0 rn: destReg rd: srcReg shifterOperand: immediate). ^machineCodeSize := 4] ifFalse: [ self at: 0 moveCw: offset intoR: RISCTempReg. "strb destReg, [srcReg, RISCTempReg]" self machineCodeAt: 16 put: (self t: 3 o: 16rC s: 0 rn: srcReg rd: destReg shifterOperand: RISCTempReg). ^machineCodeSize := 20 ]!

1 0

VM Maker: Cog-lw.53.mcz
by commits＠source.squeak.org 09 Aug '12

09 Aug '12

Lars Wassermann uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-lw.53.mcz ==================== Summary ==================== Name: Cog-lw.53 Author: lw Time: 9 August 2012, 9:15:44.451 pm UUID: f12f20e9-6b2f-764a-95cd-6dcae41f853a Ancestors: Cog-lw.52 pushed up the disassemble methods from BochsIA32ProcessorAlien to CogProcessorAlien. For that to work, I also changed the specifict register names to their abstract counterpart. Started implementing the ProcessorTrapSignal way of telling the simulator what kind of error occured in the emulator. There might be a huge problem down the road, because the ARM simulator traps branches and jumps, only after the pc has been changed. For calls, this is no problem, because we have the lr. But what about long jumps? Removed the opcode-methods, which were only used in filling the OpcodeTable for ProcessorTraps. This way of identifying the last instruction was not applicable, because some of those opcodes are implemented in several ways, some of which require more than one ARM instruction. For now, see #instructionTypeAt:in:. =============== Diff against Cog-lw.52 =============== Item was removed: - ----- Method: BochsIA32Alien>>disassembleFrom:to:in:for:labels:on: (in category 'disassembly') ----- - disassembleFrom: startAddress to: endAddress in: memory for: aSymbolManager "<Cogit>" labels: labelDictionary on: aStream - | address | - address := startAddress. - [address <= endAddress] whileTrue: - [[:size :string| - (aSymbolManager labelForPC: address) ifNotNil: - [:label| aStream nextPutAll: label; nextPut: $:; cr]. - (labelDictionary at: address ifAbsent: []) ifNotNil: - [:label| aStream nextPutAll: label; nextPut: $:; cr]. - aStream nextPutAll: (self decorateDisassembly: string for: aSymbolManager); cr; flush. - address := address + size] - valueWithArguments: (self - primitiveDisassembleAt: address - inMemory: memory)]! Item was removed: - ----- Method: BochsIA32Alien>>disassembleNextInstructionIn:for: (in category 'disassembly') ----- - disassembleNextInstructionIn: memory for: aSymbolManager "<Cogit|nil>" - | string | - string := (self primitiveDisassembleAt: self eip inMemory: memory) last. - ^aSymbolManager - ifNil: [string] - ifNotNil: [self decorateDisassembly: string for: aSymbolManager]! Item was added: + ----- Method: CogProcessorAlien>>disassembleFrom:to:in:for:labels:on: (in category 'disassembly') ----- + disassembleFrom: startAddress to: endAddress in: memory for: aSymbolManager "<Cogit>" labels: labelDictionary on: aStream + | address | + address := startAddress. + [address <= endAddress] whileTrue: + [[:size :string| + (aSymbolManager labelForPC: address) ifNotNil: + [:label| aStream nextPutAll: label; nextPut: $:; cr]. + (labelDictionary at: address ifAbsent: []) ifNotNil: + [:label| aStream nextPutAll: label; nextPut: $:; cr]. + aStream nextPutAll: (self decorateDisassembly: string for: aSymbolManager); cr; flush. + address := address + size] + valueWithArguments: (self + primitiveDisassembleAt: address + inMemory: memory)]! Item was changed: ----- Method: CogProcessorAlien>>disassembleFrom:to:in:on: (in category 'disassembly') ----- disassembleFrom: startAddress to: endAddress in: memory on: aStream | address | address := startAddress. [address < endAddress] whileTrue: [[:size :string| + aStream nextPutAll: (address printStringBase: 16 length: 8 padded: true); nextPut: $:; tab; tab; nextPutAll: string; cr; flush. - aStream nextPutAll: (address printStringBase: 16 length: 8 padded: true); nextPut: $:; tab; nextPutAll: string; cr; flush. address := address + size] valueWithArguments: (self primitiveDisassembleAt: address inMemory: memory)]! Item was added: + ----- Method: CogProcessorAlien>>disassembleNextInstructionIn:for: (in category 'disassembly') ----- + disassembleNextInstructionIn: memory for: aSymbolManager "<Cogit|nil>" + | string | + string := (self primitiveDisassembleAt: self pc inMemory: memory) last. + ^aSymbolManager + ifNil: [string] + ifNotNil: [self decorateDisassembly: string for: aSymbolManager]! Item was changed: CogProcessorAlien variableByteSubclass: #GdbARMAlien instanceVariableNames: '' + classVariableNames: 'PostBuildStackDelta' - classVariableNames: 'OpcodeExceptionMap PostBuildStackDelta' poolDictionaries: '' category: 'Cog-Processors'! Item was changed: ----- Method: GdbARMAlien>>branchAndLinkOpcodeWithOffset: (in category 'opcodes') ----- branchAndLinkOpcodeWithOffset: aNumber | offset | + offset := (aNumber - 8) asInteger. + (offset between: -33554432 and: 33554428) ifFalse: [self error: 'The offset is to far. ARM does not support such far jumps.']. + ^ 16reb000000 bitOr: (offset >> 2 bitAnd: 16r00FFFFFF) + ! - offset := (aNumber - 8) asInteger >> 2. - (offset bitAnd: 16rFF000000) ~= 0 ifTrue: [self error: 'The offset is to far. ARM does not support such far jumps.']. - ^ 16reb000000 bitOr: (offset bitAnd: 16r00FFFFFF)! Item was removed: - ----- Method: GdbARMAlien>>callOpcode (in category 'opcodes') ----- - callOpcode - "The call command does not generally exist. The most similar would be bl <offset>" - ^ self branchAndLinkOpcodeWithOffset: 0.! Item was added: + ----- Method: GdbARMAlien>>decorateDisassembly:for: (in category 'disassembly') ----- + decorateDisassembly: anInstructionString for: aSymbolManager "<Cogit>" + | string i1 i2 v | + string := anInstructionString. + (i1 := string indexOfSubCollection: '%ds:0x') > 0 ifTrue: + [i2 := i1 + 6. + ['0123456789abcdef' includes: (string at: i2)] whileTrue: [i2 := i2 + 1]. + string := string + copyReplaceFrom: i1 + 4 + to: i2 - 1 + with: (aSymbolManager lookupCHexString: (string copyFrom: i1 + 4 to: i2 - 1))]. + (i1 := string indexOfSubCollection: '%ss:0x') > 0 ifTrue: + [i2 := i1 + 6. + ['0123456789abcdef' includes: (string at: i2)] whileTrue: [i2 := i2 + 1]. + ((string at: i2) = $( + and: [(string at: i2 + 1) = $%]) ifTrue: + [v := Integer readFrom: (ReadStream on: string from: i1 + 6 to: i2 - 1) base: 16. + string := string + copyReplaceFrom: i1 + to: i2 - 1 + with: ((v bitAnd: (1 bitShift: 31) - 1) - (v bitAnd: (1 bitShift: 31))) printString]]. + (i1 := string indexOfSubCollection: '$0x') > 0 ifTrue: + [i2 := i1 + 3. + ['0123456789abcdef' includes: (string at: i2)] whileTrue: [i2 := i2 + 1]. + string := string + copyReplaceFrom: i1 + 1 + to: i2 - 1 + with: (aSymbolManager lookupCHexString: (string copyFrom: i1 + 1 to: i2 - 1))]. + ((i1 := string indexOf: $() > 1 + and: [(string at: i1 + 1) isDigit + and: [i1 < (i2 := string indexOf: $))]]) ifTrue: + [string := string + copyReplaceFrom: i1 + 1 + to: i2 - 1 + with: (aSymbolManager lookupCHexString: (string copyFrom: i1 + 1 to: i2 - 1))]. + ^string! Item was added: + ----- Method: GdbARMAlien>>handleCallFailureAt:in:readOnlyBelow: (in category 'error handling') ----- + handleCallFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>" readOnlyBelow: minimumWritableAddress "<Integer>" + "Convert an execution primitive failure for a call into a ProcessorSimulationTrap signal." + | relativeJump callAddress | + ((memoryArray byteAt: pc + 4) bitAnd: 16rF) = 16rB "BL opcode" + ifTrue: ["short jump via BL, therefore we have a 24bit signed integer offset" + relativeJump := (memoryArray unsignedLongAt: pc + 1 bigEndian: false) bitAnd: 16r00FFFFFF. + relativeJump := (relativeJump bitAt: 24) = 1 + ifTrue: [((relativeJump bitOr: 16r3F000000) << 2) signedIntFromLong] + ifFalse: [relativeJump << 2]. + callAddress := (pc + 8 + relativeJump)] + + ifFalse: ["long jump using RISCTempReg" + "The memoryArray starts indexing from 1, whereas the pc is based on 0-indexing, therefore all access-offsets are one greater than expected" + callAddress := (memoryArray byteAt: pc + 4) + + ((memoryArray byteAt: pc - 4) << 24) + + ((memoryArray byteAt: pc - 8) << 16) + + ((memoryArray byteAt: pc - 12) << 8)]. + ^(ProcessorSimulationTrap + pc: pc + nextpc: pc + 4 + address: callAddress signedIntToLong + type: #call) + signal! Item was added: + ----- Method: GdbARMAlien>>handleExecutionPrimitiveFailureAt:in:readOnlyBelow: (in category 'error handling') ----- + handleExecutionPrimitiveFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>" readOnlyBelow: minimumWritableAddress "<Integer>" + "Handle an execution primitive failure for an unhandled opcode." + ^self reportPrimitiveFailure! Item was changed: ----- Method: GdbARMAlien>>handleExecutionPrimitiveFailureIn:minimumAddress:readOnlyBelow: (in category 'error handling') ----- handleExecutionPrimitiveFailureIn: memoryArray "<Bitmap|ByteArray>" minimumAddress: minimumAddress "<Integer>" readOnlyBelow: minimumWritableAddress "<Integer>" "Handle an execution primitive failure. Convert out-of-range call and absolute memory read into register instructions into ProcessorSimulationTrap signals." - "self printIntegerRegistersOn: Transcript" "self printRegistersOn: Transcript" + | pc | - - "| pc opcode | ((pc := self pc) between: minimumAddress and: memoryArray byteSize - 1) ifTrue: + [(self instructionTypeAt: pc in: memoryArray) + caseOf: { + [#Call] -> [^self handleCallFailureAt: pc in: memoryArray readOnlyBelow: minimumWritableAddress]. + [#Jump] -> [^self handleJmpFailureAt: pc in: memoryArray readOnlyBelow: minimumWritableAddress]. + [#MoveAwR] -> [^self handleMoveAwRFailureAt: pc in: memoryArray readOnlyBelow: minimumWritableAddress]. + [#MoveMbrR] -> [^self handleMoveMbrRFailureAt: pc in: memoryArray readOnlyBelow: minimumWritableAddress]. + [#MoveRAw] -> [^self handleMoveRAwFailureAt: pc in: memoryArray readOnlyBelow: minimumWritableAddress]. + [#MoveRMbr] -> [^self handleMoveRMbrFailureAt: pc in: memoryArray readOnlyBelow: minimumWritableAddress]. + [#Ret] -> [^self handleRetFailureAt: pc in: memoryArray readOnlyBelow: minimumWritableAddress].} + otherwise: [^self handleExecutionPrimitiveFailureAt: pc in: memoryArray readOnlyBelow: minimumWritableAddress]]. + ((pc := self lr - 4) between: minimumAddress and: memoryArray byteSize - 1) ifTrue: + [(self instructionTypeAt: pc in: memoryArray) + caseOf: { + [#Call] -> [^self handleCallFailureAt: pc in: memoryArray readOnlyBelow: minimumWritableAddress]. + [#Jump] -> [^self handleJmpFailureAt: pc in: memoryArray readOnlyBelow: minimumWritableAddress]. + [#Ret] -> [^self handleRetFailureAt: pc in: memoryArray readOnlyBelow: minimumWritableAddress].} + otherwise: [^self handleExecutionPrimitiveFailureAt: pc in: memoryArray readOnlyBelow: minimumWritableAddress]]. - [opcode := memoryArray byteAt: pc + 1. - ^self - perform: (OpcodeExceptionMap at: opcode + 1) - with: pc - with: memoryArray - with: minimumWritableAddress]." ^self reportPrimitiveFailure! Item was added: + ----- Method: GdbARMAlien>>handleJmpFailureAt:in:readOnlyBelow: (in category 'error handling') ----- + handleJmpFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>" readOnlyBelow: minimumWritableAddress "<Integer>" + "Convert an execution primitive failure for a jmp into a ProcessorSimulationTrap signal." + | relativeJump | + self halt. + relativeJump := memoryArray longAt: pc + 2 bigEndian: false. + ^(ProcessorSimulationTrap + pc: pc + nextpc: pc + 5 + address: (pc + 5 + relativeJump) signedIntToLong + type: #jump) + signal! Item was added: + ----- Method: GdbARMAlien>>handleMoveAwRFailureAt:in:readOnlyBelow: (in category 'error handling') ----- + handleMoveAwRFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>" readOnlyBelow: minimumWritableAddress "<Integer>" + "Convert an execution primitive failure for a register load from an Address into a ProcessorSimulationTrap signal." + ((memoryArray byteAt: pc + 4) = 16rE5 "test for E593 as the most significant two bytes" + and: [(memoryArray byteAt: pc + 3) = (16r90 + (CogARMCompiler classPool at: #RISCTempReg))]) + ifTrue: + [(ProcessorSimulationTrap + pc: pc + nextpc: pc + 4 + address: (memoryArray byteAt: pc + 1) "address, combined from four instructions" + + ((memoryArray byteAt: pc - 3) << 24) + + ((memoryArray byteAt: pc - 7) << 16) + + ((memoryArray byteAt: pc - 11) << 8) + type: #read + accessor: (self registerStateSetters at: ((memoryArray byteAt: pc + 2) >> 4) + 1)) + signal] + ifFalse: + [self reportPrimitiveFailure]! Item was added: + ----- Method: GdbARMAlien>>handleMoveMbrRFailureAt:in:readOnlyBelow: (in category 'error handling') ----- + handleMoveMbrRFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>" readOnlyBelow: minimumWritableAddress "<Integer>" + "Convert an execution primitive failure for a byte register load into a ProcessorSimulationTrap signal." + "MoveMbrR" + | modrmByte | + self halt. + ^(((modrmByte := memoryArray byteAt: pc + 2) bitAnd: 16rC0) = 16r80) "ModRegRegDisp32" + ifTrue: + [(ProcessorSimulationTrap + pc: pc + nextpc: pc + 6 + address: ((self perform: (#(eax ecx edx ebx esp ebp esi edi) at: (modrmByte bitAnd: 7) + 1)) + + (memoryArray unsignedLongAt: pc + 3 bigEndian: false) + bitAnd: 16rFFFFFFFF) + type: #read + accessor: (#(al: cl: dl: bl: ah: ch: dh: bh:) at: ((modrmByte >> 3 bitAnd: 7) + 1))) + signal] + ifFalse: + [self reportPrimitiveFailure]! Item was added: + ----- Method: GdbARMAlien>>handleMoveRAwFailureAt:in:readOnlyBelow: (in category 'error handling') ----- + handleMoveRAwFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>" readOnlyBelow: minimumWritableAddress "<Integer>" + "Convert an execution primitive failure for a register write into Memory at a predefined address into a ProcessorSimulationTrap signal." + ^((memoryArray byteAt: pc + 4) = 16rE5 + and: [(memoryArray byteAt: pc + 3) = (16r80 + (CogARMCompiler classPool at: #RISCTempReg))]) + ifTrue: + [(ProcessorSimulationTrap + pc: pc + nextpc: pc + 4 + address: (memoryArray byteAt: pc + 1) + + ((memoryArray byteAt: pc - 3) << 24) + + ((memoryArray byteAt: pc - 7) << 16) + + ((memoryArray byteAt: pc - 11) << 8) + type: #write + accessor: (self registerStateNames at: ((memoryArray byteAt: pc + 2) >> 4) + 1)) + signal] + ifFalse: + [self reportPrimitiveFailure]! Item was added: + ----- Method: GdbARMAlien>>handleMoveRMbrFailureAt:in:readOnlyBelow: (in category 'error handling') ----- + handleMoveRMbrFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>" readOnlyBelow: minimumWritableAddress "<Integer>" + "Convert an execution primitive failure for a byte register write into a ProcessorSimulationTrap signal." + "MoveRMbr" + | modrmByte | + self halt. + ^(((modrmByte := memoryArray byteAt: pc + 2) bitAnd: 16rC0) = 16r80) "ModRegRegDisp32" + ifTrue: + [(ProcessorSimulationTrap + pc: pc + nextpc: pc + 6 + address: ((self perform: (#(eax ecx edx ebx esp ebp esi edi) at: (modrmByte bitAnd: 7) + 1)) + + (memoryArray unsignedLongAt: pc + 3 bigEndian: false) + bitAnd: 16rFFFFFFFF) + type: #write + accessor: (#(al cl dl bl ah ch dh bh) at: ((modrmByte >> 3 bitAnd: 7) + 1))) + signal] + ifFalse: + [self reportPrimitiveFailure]! Item was added: + ----- Method: GdbARMAlien>>handleRetFailureAt:in:readOnlyBelow: (in category 'error handling') ----- + handleRetFailureAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>" readOnlyBelow: minimumWritableAddress "<Integer>" + "Convert an execution primitive failure for a ret into a ProcessorSimulationTrap signal." + self halt. + ^(ProcessorSimulationTrap + pc: pc + nextpc: pc + 4 + address: (memoryArray unsignedLongAt: self sp + 1) + type: #return + accessor: #pc:) + signal! Item was added: + ----- Method: GdbARMAlien>>instructionTypeAt:in: (in category 'error handling') ----- + instructionTypeAt: pc "<Integer>" in: memoryArray "<Bitmap|ByteArray>" + "Identify which type of instruction is at pc in memoryArray. For the time beeing, only those instructions needed for PrimitiveFailure are identified." + | RISCTempReg lastInstruction typeOperandStatus | + RISCTempReg := CogARMCompiler classPool at: #RISCTempReg. + lastInstruction := memoryArray unsignedLongAt: pc + 1 bigEndian: false. + "self disassembleFrom: pc - 16 to: pc + 3 in: memoryArray on: Transcript cr" + + "Ret" + lastInstruction = 16rE8BD8000 ifTrue: [#Ret]. + + "Call" + (((memoryArray byteAt: pc + 4) bitAnd: 16rF) = 16rB "BL opcode" + or: [(memoryArray unsignedLongAt: pc - 3 bigEndian: false) = 16rE1A0E00F]) ifTrue: [^#Call]. + + "Jump" + ((memoryArray byteAt: pc + 3) >> 4 = 16rA "B opcode, for short jumps" + or: [(lastInstruction >> 12 bitAnd: 16r0FFFF) = + (16r0280F + (RISCTempReg << 4)) "ADD? PC, RISCTempReg, #anything, for JumpLong-Instructions"]) + ifTrue: [^#Jump]. + + typeOperandStatus := lastInstruction >> 20 bitAnd: 16rFF. + "MoveRMbr" + (typeOperandStatus = 16r54 or: [typeOperandStatus = 16r5C] or: [typeOperandStatus = 16r7C]) + ifTrue: [^#MoveRMbr]. + + "MoveRAw" + (typeOperandStatus = 16r58 and: [(lastInstruction >> 16 bitAnd: 16rF) = RISCTempReg]) + ifTrue: [^#MoveRAw]. + + "MoveMbrR" + (typeOperandStatus = 16r55 or: [typeOperandStatus = 16r5D] or: [typeOperandStatus = 16r7D]) + ifTrue: [^#MoveMbrR]. + + "MoveAwR" + ((typeOperandStatus = 16r59) and: [(lastInstruction >> 16 bitAnd: 16rF) = RISCTempReg]) + ifTrue: [^#MoveAwR]. + + + ^#UnidentifiedInstruction! Item was changed: ----- Method: GdbARMAlien>>primitiveDisassembleAt:inMemory: (in category 'primitives') ----- primitiveDisassembleAt: address inMemory: memoryArray "<Bitmap|ByteArray>" "Answer an Array of the size and the disassembled code string for the instruction at the current instruction pointer in memory." <primitive: 'primitiveDisassembleAtInMemory' module: 'GdbARMPlugin'> + ^self reportPrimitiveFailure! - ^self primitiveFailed! Item was changed: ----- Method: GdbARMAlien>>registerStateNames (in category 'accessing-abstract') ----- registerStateNames + ^#( r0 r1 r2 r3 r4 r5 r6 r7 r8 r9 r10 fp r12 sp lr pc eflags)! - ^#( r0 r1 r2 r3 r4 r5 r6 r7 r8 r9 r10 r11 r12 sp lr pc eflags)! Item was added: + ----- Method: GdbARMAlien>>registerStateSetters (in category 'accessing-abstract') ----- + registerStateSetters + ^#( r0: r1: r2: r3: r4: r5: r6: r7: r8: r9: r10: fp: r12: sp: lr: pc:)! Item was removed: - ----- Method: GdbARMAlien>>retOpcode (in category 'opcodes') ----- - retOpcode - "the ret command does not generally exist. the most similar would be mov pc, lr" - ^ self notYetImplemented! Item was added: + ----- Method: GdbARMAlien>>simulateCallOf:nextpc:memory: (in category 'execution simulation') ----- + simulateCallOf: address nextpc: nextpc memory: aMemory + "Simulate a frame-building call of address. Build a frame since + a) this is used for calls into the run-time which are unlikely to be leaf-calls, and + b) stack alignment needs to be realistic for assert checking for platforms such as Mac OS X" + self lr: nextpc. + self pc: address! Item was removed: - ----- Method: GdbARMAlienTests>>callTrapPerformance: (in category 'tests') ----- - callTrapPerformance: n - "Call a function that is out-of-range. Ensure the call is trapped." - "self new testCallTrap" - | memory | - "The address is out of range of memory every which way (whether relative or absolute and whether big-endian or little." - memory := ByteArray new: 1024. - memory replaceFrom: 1 to: 5 with: { self processor callOpcode. 0. 16r80. 16r80. 0. } asByteArray. - self processor - eip: 0; - esp: (memory size - 4). "Room for return address" - 1 to: n do: - [:ign| - [self processor singleStepIn: memory] - on: ProcessorSimulationTrap - do: [:ex|]]. - - "QSystemProfiler spyOn: [GdbARMAlienTests new callTrapPerformance: 1024*128]" - "Time millisecondsToRun: [GdbARMAlienTests new callTrapPerformance: 1024*128] 2463" - "Time millisecondsToRun: [1 to: 1024*1024*64 do: [:ign| nil yourself]] 636" - "Time millisecondsToRun: [1 to: 1024*1024*64 do: [:ign| nil perform: #ifNotNilDo: with: nil]] 3639" - "Time millisecondsToRun: [1 to: 1024*1024*64 do: [:ign| nil perform: #ifNotNilDo:ifNil: with: nil with: nil]] 12401"! Item was changed: ----- Method: GdbARMAlienTests>>runNFib:disassemble:printRegisters: (in category 'execution') ----- runNFib: n disassemble: disassemble printRegisters: printRegisters "Run nfib wth the argument. Answer the result." "self new runNFib: 5 disassemble: true printRegisters: true" | memory | + memory := Bitmap new: 1024 * 2 withAll: self processor nopOpcode. - memory := WordArray new: 1024 * 2 withAll: self processor nopOpcode. memory replaceFrom: 1 to: self nfib size with: self nfib asWordArray startingAt: 1. self processor r0: n;"argument n" lr: memory size * 2; "return address" pc: 0; sp: (memory size * 4) - 16. printRegisters ifTrue: [self processor printRegistersOn: Transcript. Transcript cr; flush]. "run until something goes wrong." self processor runInMemory: memory readExecuteOnlyBelow: memory size / 2. printRegisters ifTrue: [self processor printRegistersOn: Transcript. Transcript cr; flush]. ^self processor r0! Item was changed: ----- Method: GdbARMAlienTests>>testCallTrap (in category 'tests') ----- testCallTrap "Call a function that is out-of-range. Ensure the call is trapped." "self new testCallTrap" | memory | memory := Bitmap new: 256 withAll: self processor nopOpcode. memory longAt: 1 put: (self processor branchAndLinkOpcodeWithOffset: 1024) bigEndian: false. memory := memory asByteArray. self processor pc: 0; sp: (memory size - 4); "Room for return address" singleStepIn: memory. "We have to step twice, because the first step only changes the pc, but does not fetch anything from the address it points to." self should: [self processor singleStepIn: memory] raise: Error withExceptionDo: [:pst| self assert: self processor pc = 1024. self assert: self processor lr = 4. + self assert: pst pc = 0. + self assert: pst nextpc = 4. + self assert: pst address = 1024. + self assert: pst type = #call].! - self assert: pst messageText = 'Error 0: Illegal Instruction fetch address (0x00000400).'].!

1 0

How does Time>millisecondClockValue get a resolution of 1 millisecond?
by Louis LaBrunda 09 Aug '12

09 Aug '12

Hi VM Guys, How does Squeak's Time>millisecondClockValue get a resolution of 1 millisecond? It is primitive: 135. I thought it was based upon an OS function that kept a millisecond clock from when the OS was booted like in my case for Windows GetTickCount. The resolution of the GetTickCount function is limited to the resolution of the system timer, which is typically in the range of 10 milliseconds to 16 milliseconds. On my machine with VA Smalltalk the resolution seems to be about 15 milliseconds. Yet, in Squeak it is 1 millisecond. So it would seem the Squeak VM is using something else. Lou ----------------------------------------------------------- Louis LaBrunda Keystone Software Corp. SkypeMe callto://PhotonDemon mailto:Lou@Keystone-Software.com http://www.Keystone-Software.com

2 4

VM Maker: VMMaker.oscog-eem.196.mcz
by commits＠source.squeak.org 08 Aug '12

08 Aug '12

Eliot Miranda uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-eem.196.mcz ==================== Summary ==================== Name: VMMaker.oscog-eem.196 Author: eem Time: 8 August 2012, 2:36:30.063 pm UUID: 01753d70-0311-46ec-a06b-a8be6d8697fb Ancestors: VMMaker.oscog-lw.195 Fix generation of CogAbstractInstruction typedefs now there are multiple concrete subclasses. Eliminate a few warnings by setting return type of startOfMemory. Fix bug in inliner with leaf methods. Fix ^self slip uncovered by fix. Elimnate unnecessary blocks around first args of cppIf:ifTrue:... =============== Diff against VMMaker.oscog-lw.195 =============== Item was changed: ----- Method: CCodeGenerator>>emitCTypesOn: (in category 'C code generator') ----- emitCTypesOn: aStream "Store local type declarations on the given stream." vmClass ifNotNil: [vmClass ancilliaryStructClasses do: [:structClass| + (structClass isAbstract not + and: [vmClass shouldGenerateTypedefFor: structClass]) ifTrue: - (vmClass shouldGenerateTypedefFor: structClass) ifTrue: [structClass printTypedefOn: aStream. aStream cr; cr]]]! Item was changed: ----- Method: CogARMCompiler>>numberOfSaveableRegisters (in category 'abi') ----- numberOfSaveableRegisters "Answer the number of registers to be saved in a trampoline call that saves registers. R0 through R12, See genSaveRegisters." + <cmacro: '(self) 13'> - <cmacro: '() 13'> ^13! Item was changed: ----- Method: CogAbstractInstruction class>>instVarNamesAndTypesForTranslationDo: (in category 'translation') ----- instVarNamesAndTypesForTranslationDo: aBinaryBlock "enumerate aBinaryBlock with the names and C type strings for the inst vars to include in an AbstractInstruction struct." + "{CogAbstractInstruction. CogIA32Compiler. CogARMCompiler} do: + [:c| Transcript print: c; cr. c printTypedefOn: Transcript]" - "CogIA32Compiler printTypedefOn: Transcript" - "CogARMCompiler printTypedefOn: Transcript" | machineCodeBytes | machineCodeBytes := self == CogAbstractInstruction ifTrue: [0] + ifFalse: [self basicNew machineCodeBytes]. + (self filteredInstVarNames copyWithout: 'machineCode'), #('machineCode') do: - ifFalse: [Cogit cogCompilerClass basicNew machineCodeBytes]. - self filteredInstVarNames do: [:ivn| ivn ~= 'bcpc' ifTrue: [aBinaryBlock value: ivn value: (ivn caseOf: { ['address'] -> ['unsigned long']. ['machineCode'] -> [{'unsigned char'. '[', machineCodeBytes printString, ']'}]. ['operands'] -> [#('unsigned long' '[3]')]. ['dependent'] -> ['struct _AbstractInstruction *']} otherwise: [#char])]]! Item was added: + ----- Method: CogAbstractInstruction class>>isAbstract (in category 'testing') ----- + isAbstract + ^self == CogAbstractInstruction! Item was changed: ----- Method: CogAbstractInstruction class>>structTypeName (in category 'translation') ----- structTypeName + ^'AbstractInstruction'! - ^self name allButFirst: 3 "Drop initial Cog"! Item was changed: ----- Method: CogIA32Compiler>>numberOfSaveableRegisters (in category 'abi') ----- numberOfSaveableRegisters "Answer the number of registers to be saved in a trampoline call that saves registers. See genSaveRegisters" + <cmacro: '(self) 6'> - <cmacro: '() 6'> ^6! Item was changed: ----- Method: CogIA32Compiler>>padIfPossibleWithNopsFrom:to: (in category 'generate machine code') ----- padIfPossibleWithNopsFrom: startAddr to: endAddr + self nopsFrom: startAddr to: endAddr! - ^self nopsFrom: startAddr to: endAddr! Item was removed: - ----- Method: Cogit class>>cogCompilerClass (in category 'accessing') ----- - cogCompilerClass - "Answer the concrete subclass of CogAbstractCompiler in current use." - ^ProcessorClass basicNew abstractInstructionCompilerClass! Item was changed: ----- Method: IA32ABIPlugin>>primCallOutDoubleReturn (in category 'primitives-callouts') ----- primCallOutDoubleReturn "Call a foreign function that answers a double-precision floating-point result in %f0 according to IA32-ish ABI rules. The primitive will have a signature of the form functionAddress <Alien> primFFICallResult: result <Alien|Object> with: firstArg <Alien | Integer> ... with: lastArg <Alien | Integer> ^<Alien> <primitive: 'primCallOutDoubleReturn' error: errorCode module: 'IA32ABI'>. Answer result. If result is an Alien the value answered by the call will be assigned to result." | errCode mac result | <export: true> mac := interpreterProxy methodArgumentCount. + self cppIf: STACKVM - self cppIf: [STACKVM] ifTrue: "In the STACKVM stacks grow down" [self cCode: 'errCode = callIA32DoubleReturn(interpreterProxy->getStackPointer() + mac - 2, /* arg vec */ 1 - mac /* nargs */, mac /* funcOffset*/, mac - 1 /* resultOffset */)' inSmalltalk: [errCode := PrimErrUnsupported]] ifFalse: [self cCode: 'errCode = callIA32DoubleReturn(interpreterProxy->getStackPointer() - mac + 2, /* arg vec */ mac - 1 /* nargs */, mac /* funcOffset*/, mac - 1 /* resultOffset */)' inSmalltalk: [errCode := PrimErrUnsupported]]. errCode ~= 0 ifTrue: [^interpreterProxy primitiveFailFor: errCode]. result := interpreterProxy stackValue: mac - 1. interpreterProxy pop: mac + 1 thenPush: result! Item was changed: ----- Method: NewCoObjectMemory>>startOfMemory (in category 'accessing') ----- startOfMemory "Return the start of object memory. This is immediately after the native code zone. N.B. the stack zone is alloca'ed." <api> + <returnTypeC: #usqInt> ^coInterpreter heapBase! Item was changed: ----- Method: NewObjectMemory>>newObjectHash (in category 'allocation') ----- newObjectHash "Derive the new object hash from the allocation pointer. This is less costly than using lastHash because it avoids the read-modify-write cycle to update lastHash. Since the size of eden is a power of two and larger than the hash range this provides a well-distributed and fairly random set of values." <inline: true> + ^freeStart >> ShiftForWord! - ^freeStart >> BytesPerWord! Item was changed: ----- Method: NewspeakInterpreter>>highBit: (in category 'process primitive support') ----- highBit: anUnsignedValue "This is a C implementation needed by ioSetMaxExtSemTableSize." | shifted bitNo | <api> <var: #anUnsignedValue type: #usqInt> <var: #shifted type: #usqInt> shifted := anUnsignedValue. bitNo := 0. + self cppIf: BytesPerWord > 4 - self cppIf: [BytesPerWord > 4] ifTrue: [shifted < (1 << 32) ifFalse: [shifted := shifted >> 32. bitNo := bitNo + 32]]. shifted < (1 << 16) ifFalse: [shifted := shifted >> 16. bitNo := bitNo + 16]. shifted < (1 << 8) ifFalse: [shifted := shifted >> 8. bitNo := bitNo + 8]. shifted < (1 << 4) ifFalse: [shifted := shifted >> 4. bitNo := bitNo + 4]. shifted < (1 << 2) ifFalse: [shifted := shifted >> 2. bitNo := bitNo + 2]. shifted < (1 << 1) ifFalse: [shifted := shifted >> 1. bitNo := bitNo + 1]. "shifted 0 or 1 now" ^bitNo + shifted! Item was changed: ----- Method: ObjectMemory>>startOfMemory (in category 'object enumeration') ----- startOfMemory "Return the start of object memory." + <returnTypeC: #usqInt> - ^memory! Item was changed: ----- Method: StackInterpreter>>convertFloatsToPlatformOrderFrom:to: (in category 'image save/restore') ----- convertFloatsToPlatformOrderFrom: startOop to: stopAddr "Byte-swap the words of all bytes objects in a range of the image, including Strings, ByteArrays, and CompiledMethods. This returns these objects to their original byte ordering after blindly byte-swapping the entire image. For compiled methods, byte-swap only their bytecodes part. Ensure floats are in platform-order." | oop temp | objectMemory vmEndianness = imageFloatsBigEndian ifTrue: + [^nil]. - [^self]. self assert: ClassFloatCompactIndex ~= 0. oop := startOop. [self oop: oop isLessThan: stopAddr] whileTrue: [(objectMemory isFreeObject: oop) ifFalse: [(objectMemory compactClassIndexOf: oop) = ClassFloatCompactIndex ifTrue: [temp := self longAt: oop + BaseHeaderSize. self longAt: oop + BaseHeaderSize put: (self longAt: oop + BaseHeaderSize + 4). self longAt: oop + BaseHeaderSize + 4 put: temp]]. oop := objectMemory objectAfter: oop]! Item was changed: ----- Method: StackInterpreter>>highBit: (in category 'stack pages') ----- highBit: anUnsignedValue "This is a C implementation needed by stackPageByteSize when translated." | shifted bitNo | <var: #anUnsignedValue type: #usqInt> <var: #shifted type: #usqInt> shifted := anUnsignedValue. bitNo := 0. + self cppIf: BytesPerWord > 4 - self cppIf: [BytesPerWord > 4] ifTrue: [shifted < (1 << 32) ifFalse: [shifted := shifted >> 32. bitNo := bitNo + 32]]. shifted < (1 << 16) ifFalse: [shifted := shifted >> 16. bitNo := bitNo + 16]. shifted < (1 << 8) ifFalse: [shifted := shifted >> 8. bitNo := bitNo + 8]. shifted < (1 << 4) ifFalse: [shifted := shifted >> 4. bitNo := bitNo + 4]. shifted < (1 << 2) ifFalse: [shifted := shifted >> 2. bitNo := bitNo + 2]. shifted < (1 << 1) ifFalse: [shifted := shifted >> 1. bitNo := bitNo + 1]. "shifted 0 or 1 now" ^bitNo + shifted! Item was changed: ----- Method: StackToRegisterMappingCogit>>availableRegisterOrNil (in category 'simulation stack') ----- availableRegisterOrNil + <returnTypeC: #sqInt> - <returnType: #sqInt> | liveRegs | liveRegs := self liveRegisters. (liveRegs anyMask: (self registerMaskFor: Arg1Reg)) ifFalse: [^Arg1Reg]. (liveRegs anyMask: (self registerMaskFor: Arg0Reg)) ifFalse: [^Arg0Reg]. (liveRegs anyMask: (self registerMaskFor: SendNumArgsReg)) ifFalse: [^SendNumArgsReg]. (liveRegs anyMask: (self registerMaskFor: ClassReg)) ifFalse: [^ClassReg]. (liveRegs anyMask: (self registerMaskFor: ReceiverResultReg)) ifFalse: [^ReceiverResultReg]. ^nil! Item was changed: ----- Method: TMethod>>exitVar:label: (in category 'inlining') ----- exitVar: exitVar label: exitLabel "Replace each return statement in this method with an assignment to the exit variable followed by a goto to the given label. Return true if a goto was generated." "Optimization: If exitVar is nil, the return value of the inlined method is not being used, so don't add the assignment statement." | labelUsed | labelUsed := false. parseTree nodesDo: [:node | | newStmts | node isStmtList ifTrue: [newStmts := OrderedCollection new: 100. node statements do: [:stmt | stmt isReturn ifTrue: [exitVar ifNil: + [false "eem 8/8/2012 14:18 why exclude leaves explicity? Makes no sense to me and breaks inlining of asimple accessors" + ifTrue: + [stmt expression isLeaf ifFalse: "evaluate return expression even though value isn't used" + [newStmts add: stmt expression]] + ifFalse: [newStmts add: stmt expression]] - [stmt expression isLeaf ifFalse: "evaluate return expression even though value isn't used" - [newStmts add: stmt expression]] ifNotNil: "assign return expression to exit variable" [newStmts add: (TAssignmentNode new setVariable: (TVariableNode new setName: exitVar) expression: stmt expression)]. stmt ~~ parseTree statements last ifTrue: "generate a goto (this return is NOT the last statement in the method)" [newStmts add: (TGoToNode new setLabel: exitLabel). labelUsed := true]] ifFalse: [newStmts addLast: stmt]]. node setStatements: newStmts asArray]]. ^labelUsed! Item was changed: ----- Method: TMethod>>inlineSend:directReturn:exitVar:in: (in category 'inlining') ----- inlineSend: aSendNode directReturn: directReturn exitVar: exitVar in: aCodeGen "Answer a collection of statements to replace the given send. directReturn indicates that the send is the expression in a return statement, so returns can be left in the body of the inlined method. If exitVar is nil, the value returned by the send is not used; thus, returns need not assign to the output variable. Types are propagated to as-yet-untyped variables when inlining a send that is assigned, otherwise the assignee variable type must match the return type of the inlinee. Return types are not propagated." + | sel meth exitLabel inlineStmts label exitType | - | sel meth exitLabel labelUsed inlineStmts label exitType | sel := aSendNode selector. meth := aCodeGen methodNamed: sel. meth args size = aSendNode args size ifFalse: [^nil]. meth args with: aSendNode args do: [:formal :actual| (actual isVariable and: [(aCodeGen variableOfType: (self typeFor: formal) acceptsValueOfType: (self typeFor: actual name in: aCodeGen)) not]) ifTrue: [aCodeGen logger nextPutAll: 'type mismatch for formal ', formal, ' and actual ', actual name, ' when inlining ', sel, ' in ', selector, '. Use a cast.'; cr; flush]]. meth := meth copy. "Propagate the return type of an inlined method" (directReturn or:[exitVar notNil]) ifTrue:[ exitType := directReturn ifTrue:[returnType] ifFalse:[(self typeFor: exitVar in: aCodeGen) ifNil:[#sqInt]]. (exitType = #void or:[exitType = meth returnType]) ifFalse:[meth propagateReturnIn: aCodeGen]]. meth renameVarsForInliningInto: self except: #() in: aCodeGen. meth renameLabelsForInliningInto: self. self addVarsDeclarationsAndLabelsOf: meth except: #(). meth hasReturn ifTrue:[ directReturn ifFalse:[ exitLabel := self unusedLabelForInliningInto: self. + (meth exitVar: exitVar label: exitLabel) "is label used?" - (labelUsed := meth exitVar: exitVar label: exitLabel) ifTrue: [ labels add: exitLabel ] ifFalse: [ exitLabel := nil ]]]. (inlineStmts := OrderedCollection new: 100) add: (label := TLabeledCommentNode new setComment: 'begin ', sel); addAll: (self argAssignmentsFor: meth args: aSendNode args in: aCodeGen); addAll: meth statements. "method body" "Vile hacks to prevent too many labels. If the C compiler inlines functions it can duplicate labels and cause compilation to fail. The second statement prevents us creating labels in anything other than the interpreter. If we add labels to small functions that may be inlined by the C compiler then the label can be duplicated by the C compiler and cause the assembler to fail. eem 9/20/2008 12:29" (aCodeGen wantsLabels and: [meth asmLabel and: [meth mustAsmLabel or: [meth hasMoreSendsThan: 20]]]) ifTrue: [label asmLabel: sel]. (directReturn and: [meth endsWithReturn not]) ifTrue: [inlineStmts add: (TReturnNode new setExpression: (TVariableNode new setName: 'nil'))]. exitLabel ~= nil ifTrue: [inlineStmts add: (TLabeledCommentNode new setLabel: exitLabel comment: 'end ', meth selector)]. ^inlineStmts! Item was added: + ----- Method: VMStructType class>>isAbstract (in category 'accessing class hierarchy') ----- + isAbstract + ^self == VMStructType!

1 0

Android Cog VM/Pharo Builds at INRIA Jenkins
by Dmitry Golubovsky 08 Aug '12

08 Aug '12

Hi, There are two CI (continuous integration) jobs running periodically at the INRIA Jenkins server: CogDroid and PharoDroid. The former is an unbundled NonJIT Cog VM for Android which can run any Smalltalk image original Cog VM can run. The latter is the same Cog VM bundled with a generic Pharo 1.4 Smalltalk image. These two builds complement each other, and together they comprise an Android analog of the one-click Pharo distribution: a practically usable piece of software ready for development and exploration of possible uses of Smalltalk on mobile devices. Whoever is interested to try Pharo and other compatible Smalltalk implementations on Android devices are welcome to use these builds. A brief overview with installation and usage recommendations can be found here: http://code.google.com/p/squeakvm-tablet/wiki/JenkinsBuilds The developer of CogDroid and PharoDroid hopes that these new Android applications will help the adoption of Smalltalk for writing applications for mobile devices. Any thoughts, suggestions and critics are welcome. Thanks. -- Dmitry Golubovsky Anywhere on the Web

3 4

Pulse audio Scratch plugin causes seg fault on 64bit Ubuntu installation
by Amos Blanton 08 Aug '12

08 Aug '12

To reproduce: 1. Execute Scratch using current VM and pulse plugin (on Ubuntu 12.04, 64 bit system): Executing: /usr/lib/squeak/4.4.7-2357/squeakvm -encoding UTF-8 -vm-display-x11 -xshm -plugins /usr/lib/scratch/plugins/:/usr/lib/squeak/4.4.7-2357/ -vm-sound-pulse /usr/share/scratch/Scratch.image (There is no pulse plugin in /usr/lib/scratch/plugins in my installation package, so it must be using the one in /usr/lib/squeak/4.4.7-2357) 2. Click "Sounds" tab, click play icon next to meow. That results in: Segmentation fault 10273532 [] in SoundPlayer class>playLoop 10262332 Semaphore>critical: 10262240 SoundPlayer class>playLoop 10273228 [] in SoundPlayer class>startPlayerProcessBufferSize:rate:stereo: 10273320 [] in BlockContext>newProcess Aborted (core dumped) Note that the same package on 32 bit systems does not produce the error (playback and recording both work). The issue is also described here: https://bugs.launchpad.net/ubuntu/+source/squeak-vm/+bug/1009080 If someone can take a look and patch this, we'd very much appreciate it! This is the last major (known) issue we've got with Scratch running on Ubuntu. -Amos

4 6

VM Maker: VMMaker.oscog-lw.195.mcz
by commits＠source.squeak.org 08 Aug '12

08 Aug '12

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!

1 0

VM Maker: Cog-lw.52.mcz
by commits＠source.squeak.org 08 Aug '12

08 Aug '12

Lars Wassermann uploaded a new version of Cog to project VM Maker: http://source.squeak.org/VMMaker/Cog-lw.52.mcz ==================== Summary ==================== Name: Cog-lw.52 Author: lw Time: 8 August 2012, 2:38:07.331 pm UUID: 034b9ff8-a7b0-6449-b4cb-b173a85473e0 Ancestors: Cog-lw.51 refactored smashRegisterAccessors to allow plugging in different register names to be smashed. added proper #printOn: to ARMAlien =============== Diff against Cog-lw.51 =============== Item was added: + ----- Method: BochsIA32Alien>>smashRegisterAccessors (in category 'accessing-abstract') ----- + smashRegisterAccessors + ^#(eax: ebx: ecx: edx: esi: edi:)! Item was removed: - ----- Method: BochsIA32Alien>>smashRegistersWithValuesFrom:by: (in category 'accessing-abstract') ----- - smashRegistersWithValuesFrom: base by: step - #(eax: ebx: ecx: edx: esi: edi:) - withIndexDo: - [:accessor :index| - self perform: accessor with: index - 1 * step + base]! Item was changed: ----- Method: CogProcessorAlien>>disassembleFrom:to:in:on: (in category 'disassembly') ----- disassembleFrom: startAddress to: endAddress in: memory on: aStream | address | address := startAddress. [address < endAddress] whileTrue: [[:size :string| + aStream nextPutAll: (address printStringBase: 16 length: 8 padded: true); nextPut: $:; tab; nextPutAll: string; cr; flush. - aStream nextPutAll: string; cr; flush. address := address + size] valueWithArguments: (self primitiveDisassembleAt: address inMemory: memory)]! Item was added: + ----- Method: CogProcessorAlien>>smashRegisterAccessors (in category 'accessing-abstract') ----- + smashRegisterAccessors + self subclassResponsibility! Item was added: + ----- Method: CogProcessorAlien>>smashRegistersWithValuesFrom:by: (in category 'accessing-abstract') ----- + smashRegistersWithValuesFrom: base by: step + self smashRegisterAccessors + withIndexDo: + [:accessor :index| + self perform: accessor with: index - 1 * step + base]! Item was changed: ----- Method: GdbARMAlien>>nopOpcode (in category 'opcodes') ----- nopOpcode "mov r0, r0" + ^ 16rE1A00000! - ^ 16rE1A01001! Item was added: + ----- Method: GdbARMAlien>>printOn: (in category 'printing') ----- + printOn: aStream + aStream nextPutAll: 'an ARMAlien('. + self registerState allButLast with: self registerStateNames allButLast do: [ :state :i | + aStream + << i << ': ' + << (state abs > 15 ifTrue: [state hex] ifFalse: [state asString]) + << ', ']. + aStream << 'NZCVIF: ' + << (self registerState last printStringBase: 2 length: 6 padded: true) << ')'.! Item was added: + ----- Method: GdbARMAlien>>registerStateNames (in category 'accessing-abstract') ----- + registerStateNames + ^#( r0 r1 r2 r3 r4 r5 r6 r7 r8 r9 r10 r11 r12 sp lr pc eflags)! Item was changed: ----- Method: GdbARMAlien>>retOpcode (in category 'opcodes') ----- retOpcode "the ret command does not generally exist. the most similar would be mov pc, lr" + ^ self notYetImplemented! - ^ self halt.! Item was added: + ----- Method: GdbARMAlien>>simulateLeafCallOf:nextpc:memory: (in category 'execution') ----- + simulateLeafCallOf: address nextpc: nextpc memory: aMemory + self lr: nextpc. + self pc: address! Item was added: + ----- Method: GdbARMAlien>>smashRegisterAccessors (in category 'accessing-abstract') ----- + smashRegisterAccessors + ^#(r0: r1: r2: r3: r4: r5: r6: r7: r8:)!

1 0

[commit] r2581 - fix type pulse audio type declarations
by commits＠squeakvm.org 08 Aug '12

08 Aug '12

Author: piumarta Date: 2012-08-07 19:35:16 -0700 (Tue, 07 Aug 2012) New Revision: 2581 Modified: trunk/platforms/unix/vm-sound-pulse/sqUnixSoundPulseAudio.c Log: fix type pulse audio type declarations Modified: trunk/platforms/unix/vm-sound-pulse/sqUnixSoundPulseAudio.c =================================================================== --- trunk/platforms/unix/vm-sound-pulse/sqUnixSoundPulseAudio.c 2012-07-31 00:53:30 UTC (rev 2580) +++ trunk/platforms/unix/vm-sound-pulse/sqUnixSoundPulseAudio.c 2012-08-08 02:35:16 UTC (rev 2581) @@ -151,6 +151,7 @@ /* PULSE, Simple API parameters */ pa_simple *pa_conn; + int dummy; pa_sample_spec pa_spec; } audioIO_t; @@ -194,16 +195,16 @@ static int trace(); static sqInt sound_AvailableSpace(void); -static sqInt sound_InsertSamplesFromLeadTime(int frameCount, int srcBufPtr, int samplesOfLeadTime); -static sqInt sound_PlaySamplesFromAtLength(int frameCount, int arrayIndex, int startIndex); +static sqInt sound_InsertSamplesFromLeadTime(sqInt frameCount, void *srcBufPtr, sqInt samplesOfLeadTime); +static sqInt sound_PlaySamplesFromAtLength(sqInt frameCount, void *arrayIndex, sqInt startIndex); static sqInt sound_PlaySilence(void); -static sqInt sound_Start(int frameCount, int samplesPerSec, int stereo, int semaIndex); +static sqInt sound_Start(sqInt frameCount, sqInt samplesPerSec, sqInt stereo, sqInt semaIndex); static sqInt sound_Stop(void); -static sqInt sound_StartRecording(int desiredSamplesPerSec, int stereo, int semaIndex); +static sqInt sound_StartRecording(sqInt desiredSamplesPerSec, sqInt stereo, sqInt semaIndex); static sqInt sound_StopRecording(void); static double sound_GetRecordingSampleRate(void); -static sqInt sound_RecordSamplesIntoAtLength(int buf, int startSliceIndex, int bufferSizeInBytes); +static sqInt sound_RecordSamplesIntoAtLength(void *buf, sqInt startSliceIndex, sqInt bufferSizeInBytes); static int mixer_open(char *name); static void mixer_close(void); @@ -825,20 +826,20 @@ return ioFreeBytes(&audioOut); } -static sqInt sound_InsertSamplesFromLeadTime(int frameCount, int srcBufPtr, int samplesOfLeadTime) { +static sqInt sound_InsertSamplesFromLeadTime(sqInt frameCount, void *srcBufPtr, sqInt samplesOfLeadTime) { DBGMSG(">sound_InsertSamplesFromLeadTime()"); return 0; /* or maxBytes? */ } -static sqInt sound_PlaySamplesFromAtLength(int frameCount, int arrayIndex, int startIndex) { +static sqInt sound_PlaySamplesFromAtLength(sqInt frameCount, void *srcBufPtr, sqInt startIndex) { unsigned int bufferNext, samples, sampleBytes; if (0 >= frameCount) return 0; samples = MIN(audioOut.maxSamples, frameCount); - if (0 == (sampleBytes = ioAddPlayBuffer((void *)(arrayIndex + startIndex * 2 * audioOut.pa_spec.channels), samples))) + if (0 == (sampleBytes = ioAddPlayBuffer(srcBufPtr + startIndex * 2 * audioOut.pa_spec.channels, samples))) DBGMSG("sound_PlaySamplesFromAtLength(): No free buffers!"); sigSignal(&audioOut.sigRun); @@ -853,7 +854,7 @@ } -static sqInt sound_Start(int frameCount, int samplesPerSec, int stereo, int semaIndex) { +static sqInt sound_Start(sqInt frameCount, sqInt samplesPerSec, sqInt stereo, sqInt semaIndex) { int rc; DBGMSG(">sound_Start()"); @@ -928,7 +929,7 @@ /* ================================== AUDIO IN */ -static sqInt sound_StartRecording(int desiredSamplesPerSec, int stereo, int semaIndex) { +static sqInt sound_StartRecording(sqInt desiredSamplesPerSec, sqInt stereo, sqInt semaIndex) { int rc; pa_buffer_attr pa_buffer_metrics; /* For recording */ @@ -1017,7 +1018,7 @@ return (double)audioIn.pa_spec.rate; } -static sqInt sound_RecordSamplesIntoAtLength(int buf, int startSliceIndex, int bufferSizeInBytes) { +static sqInt sound_RecordSamplesIntoAtLength(void *buf, sqInt startSliceIndex, sqInt bufferSizeInBytes) { unsigned int bufferNext, bufferBytes, sampleBytes; bufferBytes = MAX(0, bufferSizeInBytes - (startSliceIndex * 2));

1 0

VM Maker: VMMaker.oscog-lw.194.mcz
by commits＠source.squeak.org 07 Aug '12

07 Aug '12

Lars Wassermann uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-lw.194.mcz ==================== Summary ==================== Name: VMMaker.oscog-lw.194 Author: lw Time: 7 August 2012, 8:54:48.906 pm UUID: c7f87bb5-3022-db47-9d6b-76fa8f5b2d13 Ancestors: VMMaker.oscog-lw.193 Results of a nice pair programming session with Eliot. - Changed nopsFrom:To: to padIfPossibleWithNopsFrom:To:, because on arm, a nop is 4 byte long. Therefore, on IA32, this is padded with nop, on ARM, all 4byte chunks are filled with nop, the rest is zero-padded. - Changed the addressSpaceMask, because ARM (without Thumb) can only jump to 4-divisible addresses. - Refactored printStateOn: to accomodate for register names which are not part of RTLOpcodes - Fixed bugs in the jump-construction in ARM. When you want to reset the state, go back as far as #cog:selector:. There, the state is reset and you can step into the generation, if needed. =============== Diff against VMMaker.oscog-lw.193 =============== Item was added: + ----- Method: CogARMCompiler>>callTargetFromReturnAddress: (in category 'inline cacheing') ----- + callTargetFromReturnAddress: callSiteReturnAddress + "Answer the address the call immediately preceeding callSiteReturnAddress will jump to." + | callDistance call | + call := self instructionBeforeAddress: callSiteReturnAddress. + (self isBranch: call) + ifTrue: [ callDistance := (call bitAnd: 16r00FFFFFF) << 2. + "The distance is a signed 24bit number. Therefore, the highest (26th) bit has to be expanded" + (callDistance bitAnd: 16r02000000) ~= 0 + ifTrue: [callDistance := callDistance bitOr: 16rFC000000]] + ifFalse: [ "A Long Jump. Extract the value saved to RISCTempReg from all the instructions before." + self notYetImplemented ]. + ^callSiteReturnAddress + 4 + callDistance signedIntFromLong! 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 notYetImplemented] - self halt] "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>>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. - jumpTarget := self jumpTargetAddress. 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: 16 put: (self t: 1 o: 4 s: 0 rn: RISCTempReg rd: PC shifterOperand: (jumpTarget bitAnd: 16rFF)). ^machineCodeSize := 20! Item was added: + ----- Method: CogARMCompiler>>genSubstituteReturnAddress: (in category 'abstract instructions') ----- + genSubstituteReturnAddress: retpc + <inline: true> + <returnTypeC: #'AbstractInstruction *'> + ^cogit MoveCw: retpc R: LR! Item was added: + ----- Method: CogARMCompiler>>instructionBeforeAddress: (in category 'inline cacheing') ----- + instructionBeforeAddress: followingAddress + "Answer the instruction immediately preceeding followingAddress." + ^ ((objectMemory byteAt: followingAddress - 1) << 24) + + ((objectMemory byteAt: followingAddress - 2) << 16) + + ((objectMemory byteAt: followingAddress - 3) << 8) + + (objectMemory byteAt: followingAddress - 4) + ! Item was added: + ----- Method: CogARMCompiler>>isBranch: (in category 'testing') ----- + isBranch: anInstruction + + ^ (anInstruction >> 24 bitAnd: 16r0E) = 16rA! Item was added: + ----- Method: CogARMCompiler>>nameForRegister: (in category 'printing') ----- + nameForRegister: reg "<Integer>" + "subclasses with special purpose registers may need to override." + <doNotGenerate> + ^#(LR SP PC) detect: [:sym| (self class classPool at: sym) = reg] ifNone: [super nameForRegister: reg]! Item was added: + ----- Method: CogARMCompiler>>padIfPossibleWithNopsFrom:to: (in category 'generate machine code - concretize') ----- + padIfPossibleWithNopsFrom: startAddr to: endAddr + | nullBytes | + nullBytes := (endAddr - startAddr + 1) \\ 4. + self nopsFrom: startAddr to: endAddr - nullBytes. + endAddr - nullBytes + 1 to: endAddr + do: [ :p | objectMemory byteAt: p put: 16r0]! 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: [20] "load address to register, add"! - ^machineCodeSize := (self isQuick: maximumSpan) - ifTrue: [4] "branch" - ifFalse: [20] "load address to register, mov"! Item was changed: ----- Method: CogAbstractInstruction>>computeJumpTargetOffsetPlus: (in category 'generate machine code') ----- + computeJumpTargetOffsetPlus: anPCOffset - computeJumpTargetOffsetPlus: anInteger <inline: true> "Since it's an extraction from other methods." | jumpTarget | <var: #jumpTarget type: #'AbstractInstruction *'> jumpTarget := self jumpTargetAddress. + ^jumpTarget signedIntFromLong - (address + anPCOffset) signedIntFromLong.! - ^jumpTarget signedIntFromLong - (address + anInteger) signedIntFromLong.! Item was added: + ----- Method: CogAbstractInstruction>>isLongJump (in category 'testing') ----- + isLongJump + ^opcode between: FirstJump and: FirstShortJump - 1! Item was added: + ----- Method: CogAbstractInstruction>>longJumpTargetAddress (in category 'generate machine code') ----- + longJumpTargetAddress + <inline: true> "Since it's an extraction from other methods." + "This needs to be digfferent from jumpTargetAddress because long jumps can + be to absolute addresses and hence we can't assert that the jump target is sane." + | jumpTarget | + <var: #jumpTarget type: #'AbstractInstruction *'> + jumpTarget := cogit cCoerceSimple: (operands at: 0) to: #'AbstractInstruction *'. + (self isAnInstruction: jumpTarget) ifTrue: + [jumpTarget := cogit cCoerceSimple: jumpTarget address to: #'AbstractInstruction *']. + self assert: jumpTarget ~= 0. + ^jumpTarget! Item was added: + ----- Method: CogAbstractInstruction>>nameForRegister: (in category 'printing') ----- + nameForRegister: reg "<Integer>" + "subclasses with special purpose registers may need to override." + <doNotGenerate> + ^CogRTLOpcodes nameForRegister: reg! Item was changed: ----- Method: CogAbstractInstruction>>printStateOn: (in category 'printing') ----- printStateOn: aStream | opcodeName orneryOperands format | <doNotGenerate> "Smalltalk-side only" opcode isNil ifTrue: [^self]. aStream space; nextPut: $(; nextPutAll: (opcodeName := self class nameForOpcode: opcode). orneryOperands := operands isCObjectAccessor ifTrue: [operands object] ifFalse: [operands]. (cogit isKindOf: Cogit) ifTrue: [format := CogRTLOpcodes printFormatForOpcodeName: opcodeName]. orneryOperands withIndexDo: [:operand :index| operand notNil ifTrue: [aStream space. index >= (orneryOperands identityIndexOf: nil ifAbsent: [orneryOperands size + 1]) ifTrue: [aStream print: index - 1; nextPut: $:]. (format notNil and: [(format at: index ifAbsent: nil) = $r]) + ifTrue: [aStream nextPutAll: (self nameForRegister: operand)] - ifTrue: [aStream nextPutAll: (CogRTLOpcodes nameForRegister: operand)] ifFalse: [aStream print: operand. (operand isInteger and: [operand > 16 and: [opcode ~= Label]]) ifTrue: [(operand allMask: 16r80000000) ifTrue: [aStream nextPut: $/; print: operand signedIntFromLong]. aStream nextPut: $/. operand printOn: aStream base: 16]]]]. machineCodeSize ifNotNil: [(machineCodeSize between: 1 and: machineCode size) ifTrue: [0 to: machineCodeSize - 1 do: [:i| aStream space. (machineCode at: i) printOn: aStream base: 16]]]. address ifNotNil: [aStream nextPut: $@. address printOn: aStream base: 16]. aStream nextPut: $)! Item was changed: ----- Method: CogAbstractInstruction>>resolveJumpTarget (in category 'generate machine code') ----- resolveJumpTarget <var: #fixup type: #'BytecodeFixup *'> | fixup | self assert: self isJump. fixup := cogit cCoerceSimple: (operands at: 0) to: #'BytecodeFixup *'. self cCode: [] inSmalltalk: [(fixup isKindOf: CogBytecodeFixup) ifTrue: [self assert: (self isAFixup: fixup)]]. (self isAFixup: fixup) ifTrue: [self assert: (cogit addressIsInInstructions: fixup targetInstruction). self jmpTarget: fixup targetInstruction]! Item was added: + ----- Method: CogIA32Compiler>>padIfPossibleWithNopsFrom:to: (in category 'generate machine code') ----- + padIfPossibleWithNopsFrom: startAddr to: endAddr + ^self nopsFrom: startAddr to: endAddr! Item was added: + ----- Method: CogRTLOpcodes class>>nameForAbstractRegister: (in category 'debug printing') ----- + nameForAbstractRegister: reg "<Integer>" + ^#(Arg0Reg Arg1Reg ClassReg FPReg ReceiverResultReg SPReg SendNumArgsReg TempReg + DPFPReg0 DPFPReg1 DPFPReg2 DPFPReg3 DPFPReg4 DPFPReg5 DPFPReg6 DPFPReg7) + detect: [:sym| (classPool at: sym) = reg]! Item was changed: ----- Method: Cogit class>>initializeCompilationWithConstantsOptions: (in category 'class initialization') ----- initializeCompilationWithConstantsOptions: optionsDictionary ProcessorClass := (optionsDictionary at: #ISA ifAbsent: [#IA32]) caseOf: { [#IA32] -> [BochsIA32Alien]. + [#ARMv5] -> [GdbARMAlien]. }. - [#ARMV5] -> [GdbARMAlien]. }. NumSendTrampolines := 4! Item was changed: ----- Method: Cogit>>addressSpaceMask (in category 'accessing') ----- addressSpaceMask <doNotGenerate> + "The first parenthesis generates a word of ones, -3 removes the two lowest bits because of ARM's requirement to have 4-aligned jumping addresses" + ^((1 << (8 * BytesPerWord)) - 1) - 3! - ^(1 << (8 * BytesPerWord)) - 1! Item was changed: ----- Method: Cogit>>generateCogMethod: (in category 'generate machine code') ----- generateCogMethod: selector "We handle jump sizing simply. First we make a pass that asks each instruction to compute its maximum size. Then we make a pass that sizes jumps based on the maxmimum sizes. Then we make a pass that fixes up jumps. When fixing up a jump the jump is not allowed to choose a smaller offset but must stick to the size set in the second pass." | codeSize headerSize mapSize totalSize startAddress result method | <var: #method type: #'CogMethod *'> <var: #blockStart type: #'BlockStart *'> <var: #headerReference type: #'AbstractInstruction *'> <returnTypeC: #'CogMethod *'> headerSize := self sizeof: CogMethod. methodLabel address: headerSize negated. self computeMaximumSizes. methodLabel concretizeAt: (methodZone allocate: 0). codeSize := self generateInstructionsAt: methodLabel address + headerSize. mapSize := self generateMapAt: 0 start: methodLabel address + cmNoCheckEntryOffset. totalSize := methodZone roundUpLength: headerSize + codeSize + mapSize. startAddress := methodZone allocate: totalSize. startAddress = 0 ifTrue: [^self cCoerceSimple: InsufficientCodeSpace to: #'CogMethod *']. self assert: startAddress + cmEntryOffset = entry address. self assert: startAddress + cmNoCheckEntryOffset = noCheckEntry address. result := self outputInstructionsAt: startAddress + headerSize. self assert: startAddress + headerSize + codeSize = result. + backEnd padIfPossibleWithNopsFrom: result to: startAddress + totalSize - mapSize. - backEnd nopsFrom: result to: startAddress + totalSize - mapSize. self generateMapAt: startAddress + totalSize - 1 start: startAddress + cmNoCheckEntryOffset. self fillInBlockHeadersAt: startAddress. method := self fillInMethodHeader: (self cCoerceSimple: startAddress to: #'CogMethod *') size: totalSize selector: selector. postCompileHook notNil ifTrue: [self perform: postCompileHook with: method with: primInvokeLabel. postCompileHook := nil]. processor flushICacheFrom: startAddress to: startAddress + headerSize + codeSize. ^method!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Vm-dev August 2012