1 //===- PIC16InstrInfo.td - PIC16 Instruction defs -------------*- tblgen-*-===//
3 // The LLVM Compiler Infrastructure
5 // This file is distributed under the University of Illinois Open Source
6 // License. See LICENSE.TXT for details.
8 //===----------------------------------------------------------------------===//
10 // This file describes the PIC16 instructions in TableGen format.
12 //===----------------------------------------------------------------------===//
14 //===----------------------------------------------------------------------===//
15 // PIC16 Specific Type Constraints.
16 //===----------------------------------------------------------------------===//
17 class SDTCisI8<int OpNum> : SDTCisVT<OpNum, i8>;
18 class SDTCisI16<int OpNum> : SDTCisVT<OpNum, i16>;
20 //===----------------------------------------------------------------------===//
21 // PIC16 Specific Type Profiles.
22 //===----------------------------------------------------------------------===//
24 // Generic type profiles for i8/i16 unary/binary operations.
25 // Taking one i8 or i16 and producing void.
26 def SDTI8VoidOp : SDTypeProfile<0, 1, [SDTCisI8<0>]>;
27 def SDTI16VoidOp : SDTypeProfile<0, 1, [SDTCisI16<0>]>;
29 // Taking one value and producing an output of same type.
30 def SDTI8UnaryOp : SDTypeProfile<1, 1, [SDTCisI8<0>, SDTCisI8<1>]>;
31 def SDTI16UnaryOp : SDTypeProfile<1, 1, [SDTCisI16<0>, SDTCisI16<1>]>;
33 // Taking two values and producing an output of same type.
34 def SDTI8BinOp : SDTypeProfile<1, 2, [SDTCisI8<0>, SDTCisI8<1>, SDTCisI8<2>]>;
35 def SDTI16BinOp : SDTypeProfile<1, 2, [SDTCisI16<0>, SDTCisI16<1>,
38 // Node specific type profiles.
39 def SDT_PIC16Load : SDTypeProfile<1, 3, [SDTCisI8<0>, SDTCisI8<1>,
40 SDTCisI8<2>, SDTCisI8<3>]>;
42 def SDT_PIC16Store : SDTypeProfile<0, 4, [SDTCisI8<0>, SDTCisI8<1>,
43 SDTCisI8<2>, SDTCisI8<3>]>;
45 def SDT_PIC16Connect : SDTypeProfile<1, 2, [SDTCisI8<0>, SDTCisI8<1>,
48 // PIC16ISD::CALL type prorile
49 def SDT_PIC16call : SDTypeProfile<0, -1, [SDTCisInt<0>]>;
50 def SDT_PIC16callw : SDTypeProfile<1, -1, [SDTCisInt<0>]>;
53 def SDT_PIC16Brcond: SDTypeProfile<0, 2,
54 [SDTCisVT<0, OtherVT>, SDTCisI8<1>]>;
57 def SDT_PIC16Selecticc: SDTypeProfile<1, 3,
58 [SDTCisI8<0>, SDTCisI8<1>, SDTCisI8<2>,
61 //===----------------------------------------------------------------------===//
62 // PIC16 addressing modes matching via DAG.
63 //===----------------------------------------------------------------------===//
64 def diraddr : ComplexPattern<i8, 1, "SelectDirectAddr", [], []>;
66 //===----------------------------------------------------------------------===//
67 // PIC16 Specific Node Definitions.
68 //===----------------------------------------------------------------------===//
69 def PIC16callseq_start : SDNode<"ISD::CALLSEQ_START", SDTI8VoidOp,
70 [SDNPHasChain, SDNPOutFlag]>;
71 def PIC16callseq_end : SDNode<"ISD::CALLSEQ_END", SDTI8VoidOp,
72 [SDNPHasChain, SDNPOptInFlag, SDNPOutFlag]>;
74 // Low 8-bits of GlobalAddress.
75 def PIC16Lo : SDNode<"PIC16ISD::Lo", SDTI8BinOp>;
77 // High 8-bits of GlobalAddress.
78 def PIC16Hi : SDNode<"PIC16ISD::Hi", SDTI8BinOp>;
80 // The MTHI and MTLO nodes are used only to match them in the incoming
81 // DAG for replacement by corresponding set_fsrhi, set_fsrlo insntructions.
82 // These nodes are not used for defining any instructions.
83 def MTLO : SDNode<"PIC16ISD::MTLO", SDTI8UnaryOp>;
84 def MTHI : SDNode<"PIC16ISD::MTHI", SDTI8UnaryOp>;
85 def MTPCLATH : SDNode<"PIC16ISD::MTPCLATH", SDTI8UnaryOp>;
87 // Node to generate Bank Select for a GlobalAddress.
88 def Banksel : SDNode<"PIC16ISD::Banksel", SDTI8UnaryOp>;
90 // Node to match a direct store operation.
91 def PIC16Store : SDNode<"PIC16ISD::PIC16Store", SDT_PIC16Store, [SDNPHasChain]>;
92 def PIC16StWF : SDNode<"PIC16ISD::PIC16StWF", SDT_PIC16Store,
93 [SDNPHasChain, SDNPInFlag, SDNPOutFlag]>;
95 // Node to match a direct load operation.
96 def PIC16Load : SDNode<"PIC16ISD::PIC16Load", SDT_PIC16Load, [SDNPHasChain]>;
97 def PIC16LdArg : SDNode<"PIC16ISD::PIC16LdArg", SDT_PIC16Load, [SDNPHasChain]>;
98 def PIC16LdWF : SDNode<"PIC16ISD::PIC16LdWF", SDT_PIC16Load,
99 [SDNPHasChain, SDNPInFlag, SDNPOutFlag]>;
100 def PIC16Connect: SDNode<"PIC16ISD::PIC16Connect", SDT_PIC16Connect, []>;
102 // Node to match PIC16 call
103 def PIC16call : SDNode<"PIC16ISD::CALL", SDT_PIC16call,
104 [SDNPHasChain , SDNPOptInFlag, SDNPOutFlag]>;
105 def PIC16callw : SDNode<"PIC16ISD::CALLW", SDT_PIC16callw,
106 [SDNPHasChain , SDNPOptInFlag, SDNPOutFlag]>;
108 // Node to match a comparison instruction.
109 def PIC16Subcc : SDNode<"PIC16ISD::SUBCC", SDTI8BinOp, [SDNPOutFlag]>;
111 // Node to match a conditional branch.
112 def PIC16Brcond : SDNode<"PIC16ISD::BRCOND", SDT_PIC16Brcond,
113 [SDNPHasChain, SDNPInFlag]>;
115 def PIC16Selecticc : SDNode<"PIC16ISD::SELECT_ICC", SDT_PIC16Selecticc,
118 def PIC16ret : SDNode<"PIC16ISD::RET", SDTNone, [SDNPHasChain]>;
120 //===----------------------------------------------------------------------===//
121 // PIC16 Operand Definitions.
122 //===----------------------------------------------------------------------===//
123 def i8mem : Operand<i8>;
124 def brtarget: Operand<OtherVT>;
126 // Operand for printing out a condition code.
127 let PrintMethod = "printCCOperand" in
128 def CCOp : Operand<i8>;
130 include "PIC16InstrFormats.td"
132 //===----------------------------------------------------------------------===//
133 // PIC16 Common Classes.
134 //===----------------------------------------------------------------------===//
136 // W = W Op F : Load the value from F and do Op to W.
137 let isTwoAddress = 1, mayLoad = 1 in
138 class BinOpFW<bits<6> OpCode, string OpcStr, SDNode OpNode>:
139 ByteFormat<OpCode, (outs GPR:$dst),
140 (ins GPR:$src, i8imm:$offset, i8mem:$ptrlo, i8imm:$ptrhi),
141 !strconcat(OpcStr, " $ptrlo + $offset, W"),
142 [(set GPR:$dst, (OpNode GPR:$src, (PIC16Load diraddr:$ptrlo,
144 (i8 imm:$offset))))]>;
146 // F = F Op W : Load the value from F, do op with W and store in F.
147 // This insn class is not marked as TwoAddress because the reg is
148 // being used as a source operand only. (Remember a TwoAddress insn
149 // needs a copyRegToReg.)
151 class BinOpWF<bits<6> OpCode, string OpcStr, SDNode OpNode>:
152 ByteFormat<OpCode, (outs),
153 (ins GPR:$src, i8imm:$offset, i8mem:$ptrlo, i8imm:$ptrhi),
154 !strconcat(OpcStr, " $ptrlo + $offset"),
155 [(PIC16Store (OpNode GPR:$src, (PIC16Load diraddr:$ptrlo,
159 (i8 imm:$ptrhi), (i8 imm:$offset)
162 // W = W Op L : Do Op of L with W and place result in W.
163 let isTwoAddress = 1 in
164 class BinOpLW<bits<6> opcode, string OpcStr, SDNode OpNode> :
165 LiteralFormat<opcode, (outs GPR:$dst),
166 (ins GPR:$src, i8imm:$literal),
167 !strconcat(OpcStr, " $literal"),
168 [(set GPR:$dst, (OpNode GPR:$src, (i8 imm:$literal)))]>;
170 //===----------------------------------------------------------------------===//
171 // PIC16 Instructions.
172 //===----------------------------------------------------------------------===//
174 // Pseudo-instructions.
175 def ADJCALLSTACKDOWN : Pseudo<(outs), (ins i8imm:$amt),
176 "!ADJCALLSTACKDOWN $amt",
177 [(PIC16callseq_start imm:$amt)]>;
179 def ADJCALLSTACKUP : Pseudo<(outs), (ins i8imm:$amt),
180 "!ADJCALLSTACKUP $amt",
181 [(PIC16callseq_end imm:$amt)]>;
183 //-----------------------------------
184 // Vaious movlw insn patterns.
185 //-----------------------------------
186 let isReMaterializable = 1 in {
187 // Move 8-bit literal to W.
188 def movlw : BitFormat<12, (outs GPR:$dst), (ins i8imm:$src),
190 [(set GPR:$dst, (i8 imm:$src))]>;
192 // Move a Lo(TGA) to W.
193 def movlw_lo_1 : BitFormat<12, (outs GPR:$dst), (ins i8imm:$src, i8imm:$src2),
194 "movlw LOW(${src} + ${src2})",
195 [(set GPR:$dst, (PIC16Lo tglobaladdr:$src, imm:$src2 ))]>;
197 // Move a Lo(TES) to W.
198 def movlw_lo_2 : BitFormat<12, (outs GPR:$dst), (ins i8imm:$src, i8imm:$src2),
199 "movlw LOW(${src} + ${src2})",
200 [(set GPR:$dst, (PIC16Lo texternalsym:$src, imm:$src2 ))]>;
202 // Move a Hi(TGA) to W.
203 def movlw_hi_1 : BitFormat<12, (outs GPR:$dst), (ins i8imm:$src, i8imm:$src2),
204 "movlw HIGH(${src} + ${src2})",
205 [(set GPR:$dst, (PIC16Hi tglobaladdr:$src, imm:$src2))]>;
207 // Move a Hi(TES) to W.
208 def movlw_hi_2 : BitFormat<12, (outs GPR:$dst), (ins i8imm:$src, i8imm:$src2),
209 "movlw HIGH(${src} + ${src2})",
210 [(set GPR:$dst, (PIC16Hi texternalsym:$src, imm:$src2))]>;
213 //-------------------
214 // FSR setting insns.
215 //-------------------
216 // These insns are matched via a DAG replacement pattern.
218 ByteFormat<0, (outs FSR16:$fsr),
223 let isTwoAddress = 1 in
225 ByteFormat<0, (outs FSR16:$dst),
226 (ins FSR16:$src, GPR:$val),
231 ByteFormat<0, (outs PCLATHR:$dst),
234 [(set PCLATHR:$dst , (MTPCLATH GPR:$val))]>;
236 //----------------------------
238 // copyRegToReg insns. These are dummy. They should always be deleted
239 // by the optimizer and never be present in the final generated code.
240 // if they are, then we have to write correct macros for these insns.
241 //----------------------------
243 Pseudo<(outs FSR16:$dst), (ins FSR16:$src), "copy_fsr $dst, $src", []>;
246 Pseudo<(outs GPR:$dst), (ins GPR:$src), "copy_w $dst, $src", []>;
248 class SAVE_FSR<string OpcStr>:
250 (ins FSR16:$src, i8imm:$offset, i8mem:$ptrlo, i8imm:$ptrhi),
251 !strconcat(OpcStr, " $ptrlo, $offset"),
254 def save_fsr0: SAVE_FSR<"save_fsr0">;
255 def save_fsr1: SAVE_FSR<"save_fsr1">;
257 class RESTORE_FSR<string OpcStr>:
258 Pseudo<(outs FSR16:$dst),
259 (ins i8imm:$offset, i8mem:$ptrlo, i8imm:$ptrhi),
260 !strconcat(OpcStr, " $ptrlo, $offset"),
263 def restore_fsr0: RESTORE_FSR<"restore_fsr0">;
264 def restore_fsr1: RESTORE_FSR<"restore_fsr1">;
266 //--------------------------
268 //-------------------------
271 // Input operands are: val = W, ptrlo = GA, offset = offset, ptrhi = banksel.
273 class MOVWF_INSN<bits<6> OpCode, SDNode OpNodeDest, SDNode Op>:
274 ByteFormat<0, (outs),
275 (ins GPR:$val, i8imm:$offset, i8mem:$ptrlo, i8imm:$ptrhi),
276 "movwf ${ptrlo} + ${offset}",
277 [(Op GPR:$val, OpNodeDest:$ptrlo, (i8 imm:$ptrhi),
280 // Store W to a Global Address.
281 def movwf : MOVWF_INSN<0, tglobaladdr, PIC16Store>;
283 // Store W to an External Symobol.
284 def movwf_1 : MOVWF_INSN<0, texternalsym, PIC16Store>;
286 // Store with InFlag and OutFlag
287 // This is same as movwf_1 but has a flag. A flag is required to
288 // order the stores while passing the params to function.
289 def movwf_2 : MOVWF_INSN<0, texternalsym, PIC16StWF>;
291 // Indirect store. Matched via a DAG replacement pattern.
293 ByteFormat<0, (outs),
294 (ins GPR:$val, FSR16:$fsr, i8imm:$offset),
295 "movwi $offset[$fsr]",
298 //----------------------------
300 //----------------------------
302 // Input Operands are: ptrlo = GA, offset = offset, ptrhi = banksel.
304 let Defs = [STATUS], mayLoad = 1 in
305 class MOVF_INSN<bits<6> OpCode, SDNode OpNodeSrc, SDNode Op>:
306 ByteFormat<0, (outs GPR:$dst),
307 (ins i8imm:$offset, i8mem:$ptrlo, i8imm:$ptrhi),
308 "movf ${ptrlo} + ${offset}, W",
310 (Op OpNodeSrc:$ptrlo, (i8 imm:$ptrhi),
311 (i8 imm:$offset)))]>;
314 def movf : MOVF_INSN<0, tglobaladdr, PIC16Load>;
317 def movf_1 : MOVF_INSN<0, texternalsym, PIC16Load>;
318 def movf_1_1 : MOVF_INSN<0, texternalsym, PIC16LdArg>;
320 // Load with InFlag and OutFlag
321 // This is same as movf_1 but has a flag. A flag is required to
322 // order the loads while copying the return value of a function.
323 def movf_2 : MOVF_INSN<0, texternalsym, PIC16LdWF>;
325 // Indirect load. Matched via a DAG replacement pattern.
327 ByteFormat<0, (outs GPR:$dst),
328 (ins FSR16:$fsr, i8imm:$offset),
329 "moviw $offset[$fsr]",
332 //-------------------------
333 // Bitwise operations patterns
334 //--------------------------
336 let Defs = [STATUS] in {
337 def OrFW : BinOpFW<0, "iorwf", or>;
338 def XOrFW : BinOpFW<0, "xorwf", xor>;
339 def AndFW : BinOpFW<0, "andwf", and>;
342 def OrWF : BinOpWF<0, "iorwf", or>;
343 def XOrWF : BinOpWF<0, "xorwf", xor>;
344 def AndWF : BinOpWF<0, "andwf", and>;
346 //-------------------------
347 // Various add/sub patterns.
348 //-------------------------
351 def addfw_1: BinOpFW<0, "addwf", add>;
352 def addfw_2: BinOpFW<0, "addwf", addc>;
354 let Uses = [STATUS] in
355 def addfwc: BinOpFW<0, "addwfc", adde>; // With Carry.
358 def addwf_1: BinOpWF<0, "addwf", add>;
359 def addwf_2: BinOpWF<0, "addwf", addc>;
360 let Uses = [STATUS] in
361 def addwfc: BinOpWF<0, "addwfc", adde>; // With Carry.
364 // W -= [F] ; load from F and sub the value from W.
365 let isTwoAddress = 1, mayLoad = 1 in
366 class SUBFW<bits<6> OpCode, string OpcStr, SDNode OpNode>:
367 ByteFormat<OpCode, (outs GPR:$dst),
368 (ins GPR:$src, i8imm:$offset, i8mem:$ptrlo, i8imm:$ptrhi),
369 !strconcat(OpcStr, " $ptrlo + $offset, W"),
370 [(set GPR:$dst, (OpNode (PIC16Load diraddr:$ptrlo,
371 (i8 imm:$ptrhi), (i8 imm:$offset)),
373 let Defs = [STATUS] in {
374 def subfw_1: SUBFW<0, "subwf", sub>;
375 def subfw_2: SUBFW<0, "subwf", subc>;
377 let Uses = [STATUS] in
378 def subfwb: SUBFW<0, "subwfb", sube>; // With Borrow.
381 let Defs = [STATUS], isTerminator = 1 in
382 def subfw_cc: SUBFW<0, "subwf", PIC16Subcc>;
386 class SUBWF<bits<6> OpCode, string OpcStr, SDNode OpNode>:
387 ByteFormat<OpCode, (outs),
388 (ins GPR:$src, i8imm:$offset, i8mem:$ptrlo, i8imm:$ptrhi),
389 !strconcat(OpcStr, " $ptrlo + $offset"),
390 [(PIC16Store (OpNode (PIC16Load diraddr:$ptrlo,
391 (i8 imm:$ptrhi), (i8 imm:$offset)),
392 GPR:$src), diraddr:$ptrlo,
393 (i8 imm:$ptrhi), (i8 imm:$offset))]>;
395 let Defs = [STATUS] in {
396 def subwf_1: SUBWF<0, "subwf", sub>;
397 def subwf_2: SUBWF<0, "subwf", subc>;
399 let Uses = [STATUS] in
400 def subwfb: SUBWF<0, "subwfb", sube>; // With Borrow.
402 def subwf_cc: SUBWF<0, "subwf", PIC16Subcc>;
406 let Defs = [STATUS] in {
407 def addlw_1 : BinOpLW<0, "addlw", add>;
408 def addlw_2 : BinOpLW<0, "addlw", addc>;
410 let Uses = [STATUS] in
411 def addlwc : BinOpLW<0, "addlwc", adde>; // With Carry. (Assembler macro).
413 // bitwise operations involving a literal and w.
414 def andlw : BinOpLW<0, "andlw", and>;
415 def xorlw : BinOpLW<0, "xorlw", xor>;
416 def orlw : BinOpLW<0, "iorlw", or>;
420 // W = C - W ; sub W from literal. (Without borrow).
421 let isTwoAddress = 1 in
422 class SUBLW<bits<6> opcode, SDNode OpNode> :
423 LiteralFormat<opcode, (outs GPR:$dst),
424 (ins GPR:$src, i8imm:$literal),
426 [(set GPR:$dst, (OpNode (i8 imm:$literal), GPR:$src))]>;
428 let Defs = [STATUS] in {
429 def sublw_1 : SUBLW<0, sub>;
430 def sublw_2 : SUBLW<0, subc>;
432 let Defs = [STATUS], isTerminator = 1 in
433 def sublw_cc : SUBLW<0, PIC16Subcc>;
437 Defs = [W, FSR0, FSR1] in {
438 def CALL: LiteralFormat<0x1, (outs), (ins i8imm:$func),
439 //"call ${func} + 2",
441 [(PIC16call diraddr:$func)]>;
445 Defs = [W, FSR0, FSR1] in {
446 def CALL_1: LiteralFormat<0x1, (outs), (ins GPR:$func, PCLATHR:$pc),
448 [(PIC16call (PIC16Connect GPR:$func, PCLATHR:$pc))]>;
452 Defs = [FSR0, FSR1] in {
453 def CALLW: LiteralFormat<0x1, (outs GPR:$dest),
454 (ins GPR:$func, PCLATHR:$pc),
456 [(set GPR:$dest, (PIC16callw (PIC16Connect GPR:$func, PCLATHR:$pc)))]>;
459 let Uses = [STATUS], isBranch = 1, isTerminator = 1, hasDelaySlot = 0 in
460 def pic16brcond: ControlFormat<0x0, (outs), (ins brtarget:$dst, CCOp:$cc),
462 [(PIC16Brcond bb:$dst, imm:$cc)]>;
464 // Unconditional branch.
465 let isBranch = 1, isTerminator = 1, hasDelaySlot = 0 in
466 def br_uncond: ControlFormat<0x0, (outs), (ins brtarget:$dst),
470 // SELECT_CC_* - Used to implement the SELECT_CC DAG operation. Expanded by the
471 // scheduler into a branch sequence.
472 let usesCustomDAGSchedInserter = 1 in { // Expanded by the scheduler.
473 def SELECT_CC_Int_ICC
474 : Pseudo<(outs GPR:$dst), (ins GPR:$T, GPR:$F, i8imm:$Cond),
475 "; SELECT_CC_Int_ICC PSEUDO!",
476 [(set GPR:$dst, (PIC16Selecticc GPR:$T, GPR:$F,
496 let isTerminator = 1, isBarrier = 1, isReturn = 1 in
498 ControlFormat<0, (outs), (ins), "return", [(PIC16ret)]>;
500 //===----------------------------------------------------------------------===//
501 // PIC16 Replacment Patterns.
502 //===----------------------------------------------------------------------===//
504 // Identify an indirect store and select insns for it.
505 def : Pat<(PIC16Store GPR:$val, (MTLO GPR:$loaddr), (MTHI GPR:$hiaddr),
507 (store_indirect GPR:$val,
508 (set_fsrhi (set_fsrlo GPR:$loaddr), GPR:$hiaddr),
511 def : Pat<(PIC16StWF GPR:$val, (MTLO GPR:$loaddr), (MTHI GPR:$hiaddr),
513 (store_indirect GPR:$val,
514 (set_fsrhi (set_fsrlo GPR:$loaddr), GPR:$hiaddr),
517 // Identify an indirect load and select insns for it.
518 def : Pat<(PIC16Load (MTLO GPR:$loaddr), (MTHI GPR:$hiaddr),
520 (load_indirect (set_fsrhi (set_fsrlo GPR:$loaddr), GPR:$hiaddr),
523 def : Pat<(PIC16LdWF (MTLO GPR:$loaddr), (MTHI GPR:$hiaddr),
525 (load_indirect (set_fsrhi (set_fsrlo GPR:$loaddr), GPR:$hiaddr),