[Vm-dev] VM Maker: VMMaker.oscog-eem.1103.mcz

Nicolas Cellier nicolas.cellier.aka.nice at gmail.com
Fri Mar 20 20:32:49 UTC 2015


2015-03-20 0:21 GMT+01:00 <commits at source.squeak.org>:

>
> Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
> http://source.squeak.org/VMMaker/VMMaker.oscog-eem.1103.mcz
>
> ==================== Summary ====================
>
> Name: VMMaker.oscog-eem.1103
> Author: eem
> Time: 19 March 2015, 4:20:02.926 pm
> UUID: 64ddd2e1-e5f5-4ad0-b512-b1d0e32e99f7
> Ancestors: VMMaker.oscog-eem.1102
>
> Fix some Slang issues with ARM methods (clashing
> arg names).
>
> Provide an abstraction for saving & restoring link reg
> around calls.
>
> =============== Diff against VMMaker.oscog-eem.1102 ===============
>
> Item was changed:
>   ----- Method: CoInterpreter>>ceTraceLinkedSend: (in category 'debug
> support') -----
>   ceTraceLinkedSend: theReceiver
>         | cogMethod |
>         <api>
>         <var: #cogMethod type: #'CogMethod *'>
>         cogMethod := self cCoerceSimple: (self stackTop - cogit
> traceLinkedSendOffset)
>                                                 to: #'CogMethod *'.
>         self cCode: [] inSmalltalk:
>                 [cogit checkStackDepthOnSend ifTrue:
>                         [self maybeCheckStackDepth: (cogMethod cmNumArgs >
> cogit numRegArgs
>
>               ifTrue: [cogMethod cmNumArgs + 1]
>
>               ifFalse: [0])
>                                 sp: stackPointer + objectMemory wordSize
>                                 pc: (self stackValue: 1)]].
>         "cogit recordSendTrace ifTrue: is implicit; wouldn't compile the
> call otherwise."
>         self recordTrace: (objectMemory fetchClassOf: theReceiver)
>                 thing: cogMethod selector
>                 source: TraceIsFromMachineCode.
>         cogit printOnTrace ifTrue:
>                 [self printActivationNameFor: cogMethod methodObject
>                         receiver: theReceiver
>                         isBlock: false
> +                       firstTemporary: (self cCode: [nil] inSmalltalk:
> [0]);
> -                       firstTemporary: nil;
>                         cr].
>         self sendBreakpoint: cogMethod selector receiver: theReceiver!
>
> Item was changed:
>   ----- Method: CogARMCompiler>>concretizeDataOperationCqR: (in category
> 'generate machine code - concretize') -----
> + concretizeDataOperationCqR: armOpcode
> - concretizeDataOperationCqR: opcode
>         "Will get inlined into concretizeAt: switch."
>         "4 == Add, 2 == Sub, Xor == 1, And == 0, Or == 12, Bic == 14"
>         <inline: true>
>         self
>                 rotateable8bitImmediate: (operands at: 0)
>                 ifTrue: [:rot :immediate | | rd rn |
>                         rn := self concreteRegister: (operands at: 1).
>                         rd := opcode = CmpOpcode ifTrue: [0] ifFalse:[rn].
> +                       self machineCodeAt: 0 put: (self type: 1 op:
> armOpcode set: 1 rn: rn rd: rd shifterOperand: ((rot>>1)"in this usage we
> have to halve the rot value" << 8 bitOr: immediate)).
> -                       self machineCodeAt: 0 put: (self type: 1 op:
> opcode set: 1 rn: rn rd: rd shifterOperand: ((rot>>1)"in this usage we have
> to halve the rot value" << 8 bitOr: immediate)).
>                         ^machineCodeSize := 4]
> +               ifFalse: [^self concretizeDataOperationCwR: armOpcode].
> -               ifFalse: [^self concretizeDataOperationCwR: opcode].
>         !
>
> Item was changed:
>   ----- Method: CogARMCompiler>>concretizeDataOperationCwR: (in category
> 'generate machine code - concretize') -----
> + concretizeDataOperationCwR: armOpcode
> - concretizeDataOperationCwR: opcode
>         "Will get inlined into concretizeAt: switch."
>         "Load the word into the RISCTempReg, then cmp R, RISCTempReg"
>         <inline: true>
>         | constant rn rd instrOffset|
>         constant := operands at: 0.
>         rn := (self concreteRegister: (operands at: 1)).
> +       rd := armOpcode = CmpOpcode ifTrue: [0] ifFalse:[rn].
> -       rd := opcode = CmpOpcode ifTrue: [0] ifFalse:[rn].
>         instrOffset := self at: 0 moveCw: constant intoR: RISCTempReg.
>         self machineCodeAt: instrOffset
> +               put: (self type: 0 op: armOpcode set: 1 rn: rn rd: rd
> shifterOperand: RISCTempReg).
> -               put: (self type: 0 op: opcode set: 1 rn: rn rd: rd
> shifterOperand: RISCTempReg).
>         ^machineCodeSize := instrOffset + 4!
>
> Item was changed:
>   ----- Method: CogARMCompiler>>concretizeDataOperationRR: (in category
> 'generate machine code - concretize') -----
> + concretizeDataOperationRR: armOpcode
> - concretizeDataOperationRR: opcode
>         "Will get inlined into concretizeAt: switch."
>         "Load the word into the RISCTempReg, then op R, RISCTempReg"
>         <inline: true>
>         | rn rd srcReg |
>         srcReg := self concreteRegister: (operands at: 0).
>         rn := (self concreteRegister: (operands at: 1)).
> +       rd := armOpcode = CmpOpcode ifTrue: [0] ifFalse: [rn].
> -       rd := opcode = CmpOpcode ifTrue: [0] ifFalse: [rn].
>         self machineCodeAt: 0
> +               put: (self type: 0 op: armOpcode set: 1 rn: rn rd: rd
> shifterOperand: srcReg).
> -               put: (self type: 0 op: opcode set: 1 rn: rn rd: rd
> shifterOperand: srcReg).
>         ^machineCodeSize := 4.!
>
> Item was changed:
>   ----- Method: CogARMCompiler>>extractOffsetFromBXAt: (in category
> 'testing') -----
> + extractOffsetFromBXAt: addr
> - extractOffsetFromBXAt: address
>   "this should return the long call/jump target"
> +       ^(objectMemory byteAt: addr -4)
> +               + ((objectMemory byteAt: addr - 8) << 8)
> +               + ((objectMemory byteAt: addr - 12) << 16)
> +               + ((objectMemory byteAt: addr - 16) << 24)!
> -       ^(objectMemory byteAt: address -4)
> -               + ((objectMemory byteAt: address - 8) << 8)
> -               + ((objectMemory byteAt: address - 12) << 16)
> -               + ((objectMemory byteAt: address - 16) << 24)!
>
> Item was added:
> + ----- Method: CogARMCompiler>>saveAndRestoreLinkRegAround: (in category
> 'abi') -----
> + saveAndRestoreLinkRegAround: aBlock
> +       "If the processor's ABI includes a link register, generate
> instructions
> +        to save and restore it around aBlock, which is assumed to
> generate code."
> +       <inline: true>
> +       | inst |
> +       inst := cogit PushR: LinkReg.
> +       aBlock value.
> +       cogit PopR: LinkReg.
> +       ^inst!
>
> Item was added:
> + ----- Method: CogAbstractInstruction>>saveAndRestoreLinkRegAround: (in
> category 'abi') -----
> + saveAndRestoreLinkRegAround: aBlock
> +       "If the processor's ABI includes a link register, generate
> instructions
> +        to save and restore it around aBlock, which is assumed to
> generate code."
> +       <inline: true>
> +       self subclassResponsibility!
>
> Item was added:
> + ----- Method: CogIA32Compiler>>saveAndRestoreLinkRegAround: (in category
> 'abi') -----
> + saveAndRestoreLinkRegAround: aBlock
> +       "If the processor's ABI includes a link register, generate
> instructions
> +        to save and restore it around aBlock, which is assumed to
> generate code."
> +       <inline: true>
> +       ^aBlock value!
>
>
Hmm, the generater doesn't know how to deal with this one...
It tries to inline the formal parameter (block) rather than the actual
block passed by the sender.

Nicolas


> Item was changed:
>   ----- Method: Cogit>>compileEntry (in category 'compile abstract
> instructions') -----
>   compileEntry
>         "The entry code to a method checks that the class of the current
> receiver matches
>          that in the inline cache.  Other non-obvious elements are that
> its alignment must be
>          different from the alignment of the noCheckEntry so that the
> method map machinery
>          can distinguish normal and super sends (super sends bind to the
> noCheckEntry).
>          In Newspeak we also need to distinguish dynSuperSends from normal
> and super
>          and so on Nespeak, bind the dynSuperEntry to the preceeding nop
> (on x86 there
>          happens to be one anyway)."
>
>         self cppIf: NewspeakVM ifTrue:
>                 [self Nop. "1st nop differentiates dynSuperEntry from
> no-check entry if using nextMethod"
>                  dynSuperEntry := self Nop].
>         entry := objectRepresentation genGetInlineCacheClassTagFrom:
> ReceiverResultReg into: TempReg forEntry: true.
>         self CmpR: ClassReg R: TempReg.
>         self JumpNonZero: sendMiss.
>         noCheckEntry := self Label.
>         self compileSendTrace ifTrue:
> +               [backEnd saveAndRestoreLinkRegAround:
> +                       [self CallRT: ceTraceLinkedSendTrampoline]]!
> -               [backEnd hasLinkRegister ifTrue:
> -                       [self PushR: LinkReg].
> -                self CallRT: ceTraceLinkedSendTrampoline.
> -                backEnd hasLinkRegister ifTrue:
> -                       [self PopR: LinkReg]]!
>
> Item was changed:
>   ----- Method:
> StackToRegisterMappingCogit>>genFramelessStorePop:ReceiverVariable: (in
> category 'bytecode generators') -----
>   genFramelessStorePop: popBoolean ReceiverVariable: slotIndex
>         <inline: false>
>         | topReg valueReg constVal |
>         self assert: needsFrame not.
>         self ssFlushUpThroughReceiverVariable: slotIndex.
>         "Avoid store check for immediate values"
>         constVal := self ssTop maybeConstant.
>         (self ssTop type = SSConstant
>          and: [(objectRepresentation shouldAnnotateObjectReference:
> constVal) not]) ifTrue:
>                 [self ensureReceiverResultRegContainsSelf.
>                  self ssStorePop: popBoolean toPreferredReg: TempReg.
>                  traceStores > 0 ifTrue:
> +                       [backEnd saveAndRestoreLinkRegAround:
> +                               [self CallRT: ceTraceStoreTrampoline]].
> -                       [self CallRT: ceTraceStoreTrampoline].
>                  ^objectRepresentation
>                         genStoreImmediateInSourceReg: TempReg
>                         slotIndex: slotIndex
>                         destReg: ReceiverResultReg].
>         (topReg := self ssTop registerOrNil) isNil ifTrue:
>                 [topReg := ClassReg].
>         valueReg := self ssStorePop: popBoolean toPreferredReg: topReg.
>         "Note that ReceiverResultReg remains live after
> ceStoreCheckTrampoline."
>         self ensureReceiverResultRegContainsSelf.
>          traceStores > 0 ifTrue:
>                 [self MoveR: valueReg R: TempReg.
> +                backEnd saveAndRestoreLinkRegAround:
> +                       [self CallRT: ceTraceStoreTrampoline]].
> -                self CallRT: ceTraceStoreTrampoline].
>         ^objectRepresentation
>                 genStoreSourceReg: valueReg
>                 slotIndex: slotIndex
>                 destReg: ReceiverResultReg
>                 scratchReg: TempReg!
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.squeakfoundation.org/pipermail/vm-dev/attachments/20150320/16961635/attachment-0001.htm


More information about the Vm-dev mailing list