cpu/ip2k.cpu

   1 ; Ubicom IP2K CPU description.  -*- Scheme -*-
   2 ; Copyright (C) 2002, 2009, 2011 Free Software Foundation, Inc.
   3 ;
   4 ; Contributed by Red Hat Inc;
   5 ;
   6 ; This file is part of the GNU Binutils.
   7 ;
   8 ; This program is free software; you can redistribute it and/or modify
   9 ; it under the terms of the GNU General Public License as published by
  10 ; the Free Software Foundation; either version 3 of the License, or
  11 ; (at your option) any later version.
  12 ;
  13 ; This program is distributed in the hope that it will be useful,
  14 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ; GNU General Public License for more details.
  17 ;
  18 ; You should have received a copy of the GNU General Public License
  19 ; along with this program; if not, write to the Free Software
  20 ; Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
  21 ; MA 02110-1301, USA.
  22
  23 (define-rtl-version 0 8)
  24
  25 (include "simplify.inc")
  26
  27 ; define-arch must appear first
  28
  29 (define-arch
  30   (name ip2k) ; name of cpu family
  31   (comment "Ubicom IP2000 family")
  32   (default-alignment aligned)
  33   (insn-lsb0? #t)
  34   (machs ip2022 ip2022ext)
  35   (isas ip2k)
  36 )
  37
  38 ; Attributes.
  39
  40 (define-attr
  41   (for insn)
  42   (type boolean)
  43   (name EXT-SKIP-INSN)
  44   (comment "instruction is a PAGE, LOADL, LOADH or BREAKX instruction")
  45 )
  46
  47 (define-attr
  48   (for insn)
  49   (type boolean)
  50   (name SKIPA)
  51   (comment "instruction is a SKIP instruction")
  52 )
  53
  54 ; Instruction set parameters.
  55
  56 (define-isa
  57   (name ip2k)
  58   (comment "Ubicom IP2000 ISA")
  59
  60   (default-insn-word-bitsize 16)
  61   (default-insn-bitsize 16)
  62   (base-insn-bitsize 16)
  63 )
  64 \f
  65 ; Cpu family definitions.
  66
  67
  68 (define-cpu
  69   ; cpu names must be distinct from the architecture name and machine names.
  70   (name ip2kbf)
  71   (comment "Ubicom IP2000 Family")
  72   (endian big)
  73   (word-bitsize 16)
  74 )
  75
  76 (define-mach
  77   (name ip2022)
  78   (comment "Ubicom IP2022")
  79   (cpu ip2kbf)
  80 )
  81
  82 (define-mach
  83   (name ip2022ext)
  84   (comment "Ubicom IP2022 extended")
  85   (cpu ip2kbf)
  86 )
  87
  88 \f
  89 ; Model descriptions.
  90
  91 (define-model
  92   (name ip2k) (comment "VPE 2xxx") (attrs)
  93   (mach ip2022ext)
  94
  95   (unit u-exec "Execution Unit" ()
  96         1 1 ; issue done
  97         () ; state
  98         () ; inputs
  99         () ; outputs
 100         () ; profile action (default)
 101         )
 102 )
 103
 104
 105 ; FIXME: It might simplify things to separate the execute process from the
 106 ; one that updates the PC.
 107 \f
 108 ; Instruction fields.
 109 ;
 110 ; Attributes:
 111 ; XXX: what VPE attrs
 112 ; PCREL-ADDR: pc relative value (for reloc and disassembly purposes)
 113 ; ABS-ADDR: absolute address (for reloc and disassembly purposes?)
 114 ; RESERVED: bits are not used to decode insn, must be all 0
 115 ; RELOC: there is a relocation associated with this field (experiment)
 116
 117
 118 (dnf f-imm8      "imm8"                () 7 8)
 119 (dnf f-reg       "reg"         (ABS-ADDR) 8 9)
 120 (dnf f-addr16cjp "addr16cjp"   (ABS-ADDR) 12 13)
 121 (dnf f-dir       "dir"                 () 9 1)
 122 (dnf f-bitno     "bit number"          () 11 3)
 123 (dnf f-op3       "op3"                 () 15 3)
 124 (dnf f-op4       "op4"                 () 15 4)
 125 (dnf f-op4mid    "op4mid"              () 11 4)
 126 (dnf f-op6       "op6"                 () 15 6)
 127 (dnf f-op8       "op8"                 () 15 8)
 128 (dnf f-op6-10low "op6-10low"           () 9 10)
 129 (dnf f-op6-7low  "op6-7low"            () 9 7)
 130 (dnf f-reti3     "reti3"               () 2 3)
 131 (dnf f-skipb     "sb/snb"      (ABS-ADDR) 12 1)
 132 (dnf f-page3     "page3"               ()  2 3)
 133 ;(define-ifield (name f-page3) (comment "page3") (attrs) (start 2) (length 3)
 134 ;  (encode (value pc) (srl WI value 13))
 135 ;  (decode (value pc) (sll WI value 13))
 136 ;)
 137 ; To fix the page/call asymmetry
 138 ;(define-ifield (name f-page3) (comment "page3") (attrs) (start 2) (length 3)
 139 ;  (encode (value pc) (srl WI value 13))
 140 ;  (decode (value pc) (sll WI value 13))
 141 ;)
 142
 143
 144 \f
 145 ; Enums.
 146
 147 ; insn-op6: bits 15-10
 148 (define-normal-insn-enum insn-op6 "op6 enums" () OP6_ f-op6
 149   (OTHER1 OTHER2 SUB DEC OR AND XOR ADD
 150    TEST NOT INC DECSZ RR RL SWAP INCSZ
 151    CSE POP SUBC DECSNZ MULU MULS INCSNZ  ADDC
 152    - - - - - - - -
 153    - - - - - - - -
 154    - - - - - - - -
 155    - - - - - - - -
 156    - - - - - - - -
 157    )
 158 )
 159
 160 ; insn-dir: bit 9
 161 (define-normal-insn-enum insn-dir "dir enums" () DIR_ f-dir
 162   ; This bit specifies the polarity of many two-operand instructions:
 163   ; TO_W writes result to W regiser  (eg. ADDC W,$fr)
 164   ; NOTTO_W writes result in general register  (eg. ADDC $fr,W)
 165   (TO_W NOTTO_W)
 166 )
 167
 168
 169 ; insn-op4: bits 15-12
 170 (define-normal-insn-enum insn-op4 "op4 enums" () OP4_ f-op4
 171   (- - - - - - - LITERAL
 172    CLRB SETB SNB SB - - - -
 173    )
 174 )
 175
 176 ; insn-op4mid: bits 11-8
 177 ; used for f-op4=LITERAL
 178 (define-normal-insn-enum insn-op4mid "op4mid enums" () OP4MID_ f-op4mid
 179   (LOADH_L LOADL_L MULU_L MULS_L PUSH_L  -  CSNE_L CSE_L
 180    RETW_L CMP_L SUB_L ADD_L MOV_L OR_L AND_L XOR_L)
 181 )
 182
 183 ; insn-op3: bits 15-13
 184 (define-normal-insn-enum insn-op3 "op3 enums" () OP3_ f-op3
 185   (- - - - - - CALL JMP)
 186 )
 187
 188
 189
 190 ; Hardware pieces.
 191
 192 ; Bank-relative general purpose registers
 193
 194 ; (define-pmacro (build-reg-name n) (.splice (.str "$" n) n))
 195
 196 (define-keyword
 197   (name register-names)
 198   (enum-prefix H-REGISTERS-)
 199   (values
 200    ; These are the "Special Purpose Registers" that are not reserved
 201    ("ADDRSEL" #x2) ("ADDRX" #x3)
 202    ("IPH" #x4) ("IPL" #x5) ("SPH" #x6) ("SPL" #x7)
 203    ("PCH" #x8) ("PCL" #x9) ("WREG" #xA) ("STATUS" #xB)
 204    ("DPH" #xC) ("DPL" #xD) ("SPDREG" #xE) ("MULH" #xF)
 205    ("ADDRH" #x10) ("ADDRL" #x11) ("DATAH" #x12) ("DATAL" #x13)
 206    ("INTVECH" #x14) ("INTVECL" #x15) ("INTSPD" #x16) ("INTF" #x17)
 207    ("INTE" #x18) ("INTED" #x19) ("FCFG" #x1A) ("TCTRL" #x1B)
 208    ("XCFG" #x1C) ("EMCFG" #x1D) ("IPCH" #x1E) ("IPCL" #x1F)
 209    ("RAIN" #x20) ("RAOUT" #x21) ("RADIR" #x22) ("LFSRH" #x23)
 210    ("RBIN" #x24) ("RBOUT" #x25) ("RBDIR" #x26) ("LFSRL" #x27)
 211    ("RCIN" #x28) ("RCOUT" #x29) ("RCDIR" #x2A) ("LFSRA" #x2B)
 212    ("RDIN" #x2C) ("RDOUT" #x2D) ("RDDIR" #x2E)
 213    ("REIN" #x30) ("REOUT" #x31) ("REDIR" #x32)
 214    ("RFIN" #x34) ("RFOUT" #x35) ("RFDIR" #x36)
 215                  ("RGOUT" #x39) ("RGDIR" #x3A)
 216    ("RTTMR" #x40) ("RTCFG" #x41) ("T0TMR" #x42) ("T0CFG" #x43)
 217    ("T1CNTH" #x44) ("T1CNTL" #x45) ("T1CAP1H" #x46) ("T1CAP1L" #x47)
 218    ("T1CAP2H" #x48) ("T1CMP2H" #x48) ("T1CAP2L" #x49) ("T1CMP2L" #x49) ; note aliases
 219                                      ("T1CMP1H" #x4A) ("T1CMP1L" #x4B)
 220    ("T1CFG1H" #x4C) ("T1CFG1L" #x4D) ("T1CFG2H" #x4E) ("T1CFG2L" #x4F)
 221    ("ADCH" #x50) ("ADCL" #x51) ("ADCCFG" #x52) ("ADCTMR" #x53)
 222    ("T2CNTH" #x54) ("T2CNTL" #x55) ("T2CAP1H" #x56) ("T2CAP1L" #x57)
 223    ("T2CAP2H" #x58) ("T2CMP2H" #x58) ("T2CAP2L" #x59) ("T2CMP2L" #x59) ; note aliases
 224                                      ("T2CMP1H" #x5A) ("T2CMP1L" #x5B)
 225    ("T2CFG1H" #x5C) ("T2CFG1L" #x5D) ("T2CFG2H" #x5E) ("T2CFG2L" #x5F)
 226    ("S1TMRH" #x60) ("S1TMRL" #x61) ("S1TBUFH" #x62) ("S1TBUFL" #x63)
 227    ("S1TCFG" #x64) ("S1RCNT" #x65) ("S1RBUFH" #x66) ("S1RBUFL" #x67)
 228    ("S1RCFG" #x68) ("S1RSYNC" #x69) ("S1INTF" #x6A) ("S1INTE" #x6B)
 229    ("S1MODE" #x6C) ("S1SMASK" #x6D) ("PSPCFG" #x6E) ("CMPCFG" #x6F)
 230    ("S2TMRH" #x70) ("S2TMRL" #x71) ("S2TBUFH" #x72) ("S2TBUFL" #x73)
 231    ("S2TCFG" #x74) ("S2RCNT" #x75) ("S2RBUFH" #x76) ("S2RBUFL" #x77)
 232    ("S2RCFG" #x78) ("S2RSYNC" #x79) ("S2INTF" #x7A) ("S2INTE" #x7B)
 233    ("S2MODE" #x7C) ("S2SMASK" #x7D) ("CALLH" #x7E) ("CALLL" #x7F))
 234   )
 235
 236 (define-hardware
 237   (name h-spr)
 238   (comment "special-purpose registers")
 239   (type register QI (128))
 240   (get (index) (c-call QI "get_spr" index ))
 241   (set (index newval) (c-call VOID "set_spr" index newval ))
 242 )
 243
 244
 245 ;;(define-hardware
 246 ;;  (name h-gpr-global)
 247 ;;  (comment "gpr registers - global")
 248 ;;  (type register QI (128))
 249 ;;)
 250
 251 ; The general register
 252
 253 (define-hardware
 254   (name h-registers)
 255   (comment "all addressable registers")
 256   (attrs VIRTUAL)
 257   (type register QI (512))
 258   (get (index) (c-call QI "get_h_registers" index ))
 259   (set (index newval) (c-call VOID "set_h_registers" index newval ))
 260 )
 261
 262 ; The hardware stack.
 263 ; Use {push,pop}_pc_stack c-calls to operate on this hardware element.
 264
 265 (define-hardware
 266   (name h-stack)
 267   (comment "hardware stack")
 268   (type register UHI (16))
 269 )
 270
 271 (dsh h-pabits "page bits" () (register QI))
 272 (dsh h-zbit "zero bit" () (register BI))
 273 (dsh h-cbit "carry bit" () (register BI))
 274 (dsh h-dcbit "digit-carry bit" () (register BI))
 275 (dnh h-pc "program counter" (PC PROFILE) (pc) () () ())
 276
 277
 278 ; Operands
 279
 280 (define-operand (name addr16cjp) (comment "13-bit address") (attrs)
 281   (type h-uint) (index f-addr16cjp) (handlers (parse "addr16_cjp") (print "dollarhex_cj"))) ; overload lit8 printer
 282 (define-operand (name fr) (comment "register") (attrs)
 283   (type h-registers) (index f-reg) (handlers (parse "fr") (print "fr")))
 284 (define-operand (name lit8) (comment "8-bit signed literal") (attrs)
 285   (type h-sint) (index f-imm8) (handlers (parse "lit8") (print "dollarhex8")))
 286 (define-operand (name bitno) (comment "bit number") (attrs)
 287   (type h-uint) (index f-bitno) (handlers (parse "bit3")(print "decimal")))
 288 (define-operand (name addr16p) (comment "page number") (attrs)
 289   (type h-uint) (index f-page3) (handlers (parse "addr16_cjp") (print "dollarhex_p")))
 290 (define-operand (name addr16h) (comment "high 8 bits of address") (attrs)
 291   (type h-uint) (index f-imm8) (handlers (parse "addr16") (print "dollarhex_addr16h")))
 292 (define-operand (name addr16l) (comment "low 8 bits of address") (attrs)
 293   (type h-uint) (index f-imm8) (handlers (parse "addr16") (print "dollarhex_addr16l")))
 294 (define-operand (name reti3) (comment "reti flags") (attrs)
 295   (type h-uint) (index f-reti3) (handlers (print "dollarhex")))
 296 (dnop pabits   "page bits"                 () h-pabits f-nil)
 297 (dnop zbit     "zero bit"                  () h-zbit f-nil)
 298 (dnop cbit     "carry bit"                 () h-cbit f-nil)
 299 (dnop dcbit    "digit carry bit"           () h-dcbit f-nil)
 300 ;;(dnop bank     "bank register"             () h-bank-no f-nil)
 301
 302 (define-pmacro w     (reg h-spr #x0A))
 303 (define-pmacro mulh  (reg h-spr #x0F))
 304 (define-pmacro dph   (reg h-spr #x0C))
 305 (define-pmacro dpl   (reg h-spr #x0D))
 306 (define-pmacro sph   (reg h-spr #x06))
 307 (define-pmacro spl   (reg h-spr #x07))
 308 (define-pmacro iph   (reg h-spr #x04))
 309 (define-pmacro ipl   (reg h-spr #x05))
 310 (define-pmacro addrh (reg h-spr #x10))
 311 (define-pmacro addrl (reg h-spr #x11))
 312
 313
 314
 315 ; Pseudo-RTL for DC flag calculations
 316 ; "DC" = "digit carry", ie carry between nibbles
 317 (define-pmacro (add-dcflag a b c)
 318   (add-cflag (sll QI a 4) (sll QI b 4) c)
 319 )
 320
 321 (define-pmacro (sub-dcflag a b c)
 322   (sub-cflag (sll QI a 4) (sll QI b 4) c)
 323 )
 324
 325 ; Check to see if an fr is one of IPL, SPL, DPL, ADDRL, PCL.
 326 (define-pmacro (LregCheck isLreg fr9bit)
 327    (sequence()
 328       (set isLreg #x0) ;; Assume it's not an Lreg
 329       (if (or (or (eq fr9bit #x5) (eq fr9bit #x7))
 330               (or (eq fr9bit #x9)
 331                   (or (eq fr9bit #xd) (eq fr9bit #x11))))
 332           (set isLreg #x1)
 333       )
 334    )
 335 )
 336
 337
 338 ; Instructions, in order of the "Instruction Set Map" table on
 339 ; pp 19-20 of IP2022 spec V1.09
 340
 341 (dni jmp "Jump"
 342      ()
 343      "jmp $addr16cjp"
 344      (+ OP3_JMP addr16cjp)
 345      (set pc (or (sll pabits 13) addr16cjp))
 346      ()
 347 )
 348
 349 ; note that in call, we push pc instead of pc + 1 because the ip2k increments
 350 ; the pc prior to execution of the instruction
 351 (dni call "Call"
 352      ()
 353      "call $addr16cjp"
 354      (+ OP3_CALL addr16cjp)
 355      (sequence ()
 356                (c-call "push_pc_stack" pc)
 357                (set pc (or (sll pabits 13) addr16cjp)))
 358      ()
 359 )
 360
 361 (dni sb "Skip if bit set"
 362      ()
 363      "sb $fr,$bitno"
 364      (+ OP4_SB bitno fr)
 365      (if (and fr (sll 1 bitno))
 366          (skip 1))
 367      ()
 368 )
 369
 370 (dni snb "Skip if bit clear"
 371      ()
 372      "snb $fr,$bitno"
 373      (+ OP4_SNB bitno fr)
 374      (if (not (and fr (sll 1 bitno)))
 375          (skip 1))
 376      ()
 377 )
 378
 379 (dni setb "Set bit"
 380      ()
 381      "setb $fr,$bitno"
 382      (+ OP4_SETB bitno fr)
 383      (set fr (or fr (sll 1 bitno)))
 384      ()
 385 )
 386
 387 (dni clrb "Clear bit"
 388      ()
 389      "clrb $fr,$bitno"
 390      (+ OP4_CLRB bitno fr)
 391      (set fr (and fr (inv (sll 1 bitno))))
 392      ()
 393 )
 394
 395 (dni xorw_l "XOR W,literal"
 396      ()
 397      "xor W,#$lit8"
 398      (+ OP4_LITERAL OP4MID_XOR_L lit8)
 399      (sequence ()
 400                (set w (xor w lit8))
 401                (set zbit (zflag w)))
 402      ()
 403 )
 404
 405 (dni andw_l "AND W,literal"
 406      ()
 407      "and W,#$lit8"
 408      (+ OP4_LITERAL OP4MID_AND_L lit8)
 409      (sequence ()
 410                (set w (and w lit8))
 411                (set zbit (zflag w)))
 412      ()
 413 )
 414
 415 (dni orw_l "OR W,literal"
 416      ()
 417      "or W,#$lit8"
 418      (+ OP4_LITERAL OP4MID_OR_L lit8)
 419      (sequence ()
 420                (set w (or w lit8))
 421                (set zbit (zflag w)))
 422      ()
 423 )
 424
 425 (dni addw_l "ADD W,literal"
 426      ()
 427      "add W,#$lit8"
 428      (+ OP4_LITERAL OP4MID_ADD_L lit8)
 429      (sequence ()
 430                (set cbit (add-cflag w lit8 0))
 431                (set dcbit (add-dcflag w lit8 0))
 432                (set w (add w lit8))
 433                (set zbit (zflag w)))
 434      ()
 435 )
 436
 437 (dni subw_l "SUB W,literal"
 438      ()
 439      "sub W,#$lit8"
 440      (+ OP4_LITERAL OP4MID_SUB_L lit8)
 441      (sequence ()
 442                (set cbit (not (sub-cflag lit8 w 0)))
 443                (set dcbit (not (sub-dcflag lit8 w 0)))
 444                (set zbit (zflag (sub w lit8)))
 445                (set w (sub lit8 w)))
 446      ()
 447 )
 448
 449 (dni cmpw_l "CMP W,literal"
 450      ()
 451      "cmp W,#$lit8"
 452      (+ OP4_LITERAL OP4MID_CMP_L lit8)
 453      (sequence ()
 454                (set cbit (not (sub-cflag lit8 w 0)))
 455                (set dcbit (not (sub-dcflag lit8 w 0)))
 456                (set zbit (zflag (sub w lit8))))
 457      ()
 458 )
 459
 460 (dni retw_l "RETW literal"
 461      ()
 462      "retw #$lit8"
 463      (+ OP4_LITERAL OP4MID_RETW_L lit8)
 464      (sequence ((USI new_pc))
 465                (set w lit8)
 466                (set new_pc (c-call UHI "pop_pc_stack"))
 467                (set pabits (srl new_pc 13))
 468                (set pc new_pc))
 469      ()
 470 )
 471
 472 (dni csew_l "CSE W,literal"
 473      ()
 474      "cse W,#$lit8"
 475      (+ OP4_LITERAL OP4MID_CSE_L lit8)
 476      (if (eq w lit8)
 477          (skip 1))
 478      ()
 479 )
 480
 481 (dni csnew_l "CSNE W,literal"
 482      ()
 483      "csne W,#$lit8"
 484      (+ OP4_LITERAL OP4MID_CSNE_L lit8)
 485      (if (not (eq w lit8))
 486          (skip 1))
 487      ()
 488 )
 489
 490 (dni push_l "Push #lit8"
 491      ()
 492      "push #$lit8"
 493      (+ OP4_LITERAL OP4MID_PUSH_L lit8)
 494      (sequence ()
 495         (c-call "push" lit8)
 496         (c-call VOID "adjuststackptr" (const -1))
 497
 498      )
 499      ()
 500 )
 501
 502 (dni mulsw_l "Multiply W,literal (signed)"
 503      ()
 504      "muls W,#$lit8"
 505      (+ OP4_LITERAL OP4MID_MULS_L lit8)
 506      (sequence ((SI tmp))
 507                (set tmp (mul (ext SI w) (ext SI (and UQI #xff lit8))))
 508                (set w (and tmp #xFF))
 509                (set mulh (srl tmp 8)))
 510      ()
 511 )
 512
 513 (dni muluw_l "Multiply W,literal (unsigned)"
 514      ()
 515      "mulu W,#$lit8"
 516      (+ OP4_LITERAL OP4MID_MULU_L lit8)
 517      (sequence ((USI tmp))
 518                (set tmp (and #xFFFF (mul (zext USI w) (zext USI lit8))))
 519                (set w (and tmp #xFF))
 520                (set mulh (srl tmp 8)))
 521      ()
 522 )
 523
 524 (dni loadl_l "LoadL literal"
 525     (EXT-SKIP-INSN)
 526     "loadl #$lit8"
 527     (+ OP4_LITERAL OP4MID_LOADL_L lit8)
 528     (set dpl (and lit8 #x00FF))
 529     ()
 530 )
 531
 532 (dni loadh_l "LoadH literal"
 533     (EXT-SKIP-INSN)
 534     "loadh #$lit8"
 535     (+ OP4_LITERAL OP4MID_LOADH_L lit8)
 536     (set dph (and lit8 #x00FF))
 537     ()
 538 )
 539
 540 (dni loadl_a "LoadL addr16l"
 541     (EXT-SKIP-INSN)
 542     "loadl $addr16l"
 543     (+ OP4_LITERAL OP4MID_LOADL_L addr16l)
 544     (set dpl (and addr16l #x00FF))
 545     ()
 546 )
 547
 548 (dni loadh_a "LoadH addr16h"
 549     (EXT-SKIP-INSN)
 550     "loadh $addr16h"
 551     (+ OP4_LITERAL OP4MID_LOADH_L addr16h)
 552     (set dph (and addr16l #x0FF00))
 553     ()
 554 )
 555
 556 ;; THIS NO LONGER EXISTS -> Now LOADL
 557 ;;(dni bank_l "Bank literal"
 558 ;;     ()
 559 ;;     "bank #$lit8"
 560 ;;     (+ OP4_LITERAL OP4MID_BANK_L lit8)
 561 ;;     (set bank lit8)
 562 ;;     ()
 563 ;;)
 564
 565 (dni addcfr_w "Add w/carry fr,W"
 566      ()
 567      "addc $fr,W"
 568      (+ OP6_ADDC DIR_NOTTO_W fr)
 569      (sequence ((QI result) (BI newcbit) (QI isLreg) (HI 16bval))
 570                (set newcbit (add-cflag w fr cbit))
 571                (set dcbit (add-dcflag w fr cbit))
 572                ;; If fr is an Lreg, then we have to do 16-bit arithmetic.
 573                ;; We can take advantage of the fact that by a lucky
 574                ;; coincidence, the address of register xxxH is always
 575                ;; one lower than the address of register xxxL.
 576                (LregCheck isLreg (ifield f-reg))
 577                (if (eq isLreg #x1)
 578                   (sequence()
 579                      (set 16bval (reg h-spr (sub (ifield f-reg) 1)))
 580                      (set 16bval (sll 16bval 8))
 581                      (set 16bval (or 16bval (and (reg h-spr (ifield f-reg)) #xFF)))
 582                      (set 16bval (addc HI 16bval w cbit))
 583                      (set (reg h-spr (ifield f-reg)) (and 16bval #xFF))
 584                      (set (reg h-spr (sub (ifield f-reg) 1))
 585                           (and (srl 16bval 8) #xFF))
 586                      (set result (reg h-spr (ifield f-reg)))
 587                   )
 588                (set result (addc w fr cbit)) ;; else part
 589                )
 590
 591                (set zbit (zflag result))
 592                (set cbit newcbit)
 593                (set fr result))
 594      ()
 595 )
 596
 597 (dni addcw_fr "Add w/carry W,fr"
 598      ()
 599      "addc W,$fr"
 600      (+ OP6_ADDC DIR_TO_W fr)
 601      (sequence ((QI result) (BI newcbit))
 602                (set newcbit (add-cflag w fr cbit))
 603                (set dcbit (add-dcflag w fr cbit))
 604                (set result (addc w fr cbit))
 605                (set zbit (zflag result))
 606                (set cbit newcbit)
 607                (set w result))
 608      ()
 609 )
 610
 611
 612 (dni incsnz_fr "Skip if fr++ not zero"
 613      ()
 614      "incsnz $fr"
 615      (+ OP6_INCSNZ DIR_NOTTO_W fr)
 616      (sequence ((QI isLreg) (HI 16bval))
 617         (LregCheck isLreg (ifield f-reg))
 618         ;; If fr is an Lreg, then we have to do 16-bit arithmetic.
 619         ;; We can take advantage of the fact that by a lucky
 620         ;; coincidence, the address of register xxxH is always
 621         ;; one lower than the address of register xxxL.
 622         (if (eq isLreg #x1)
 623            (sequence()
 624               ; Create the 16 bit value
 625               (set 16bval (reg h-spr (sub (ifield f-reg) 1)))
 626               (set 16bval (sll 16bval 8))
 627               (set 16bval (or 16bval (and (reg h-spr (ifield f-reg)) #xFF)))
 628               ; Do 16 bit arithmetic.
 629               (set 16bval (add HI 16bval 1))
 630               ; Separate the 16 bit values into the H and L regs
 631               (set (reg h-spr (ifield f-reg)) (and 16bval #xFF))
 632               (set (reg h-spr (sub (ifield f-reg) 1))
 633                    (and (srl 16bval 8) #xFF))
 634               (set fr (reg h-spr (ifield f-reg)))
 635            )
 636            (set fr (add fr 1)) ; Do 8 bit arithmetic.
 637         )
 638         (if (not (zflag fr))
 639            (skip 1)))
 640      ()
 641 )
 642
 643 (dni incsnzw_fr "Skip if W=fr+1  not zero"
 644      ()
 645      "incsnz W,$fr"
 646      (+ OP6_INCSNZ DIR_TO_W fr)
 647      (sequence ()
 648                (set w (add fr 1))
 649                (if (not (zflag w))
 650                    (skip 1)))
 651      ()
 652 )
 653
 654 (dni mulsw_fr "Multiply W,fr (signed)"
 655      ()
 656      "muls W,$fr"
 657      (+ OP6_MULS DIR_TO_W fr)
 658      (sequence ((SI tmp))
 659                (set tmp (mul (ext SI w) (ext SI fr)))
 660                (set w (and tmp #xFF))
 661                (set mulh (srl tmp 8)))
 662      ()
 663 )
 664
 665 (dni muluw_fr "Multiply W,fr (unsigned)"
 666      ()
 667      "mulu W,$fr"
 668      (+ OP6_MULU DIR_TO_W fr)
 669      (sequence ((USI tmp))
 670                (set tmp (and #xFFFF (mul (zext USI w) (zext USI fr))))
 671                (set w (and tmp #xFF))
 672                (set mulh (srl tmp 8)))
 673      ()
 674 )
 675
 676 (dni decsnz_fr "Skip if fr-- not zero"
 677      ()
 678      "decsnz $fr"
 679      (+ OP6_DECSNZ DIR_NOTTO_W fr)
 680      (sequence ((QI isLreg) (HI 16bval))
 681          (LregCheck isLreg (ifield f-reg))
 682          ;; If fr is an Lreg, then we have to do 16-bit arithmetic.
 683          ;; We can take advantage of the fact that by a lucky
 684          ;; coincidence, the address of register xxxH is always
 685          ;; one lower than the address of register xxxL.
 686          (if (eq isLreg #x1)
 687             (sequence()
 688                ; Create the 16 bit value
 689                (set 16bval (reg h-spr (sub (ifield f-reg) 1)))
 690                (set 16bval (sll 16bval 8))
 691                (set 16bval (or 16bval (and (reg h-spr (ifield f-reg)) #xFF)))
 692                ; New 16 bit instruction
 693                (set 16bval (sub HI 16bval 1))
 694                ; Separate the 16 bit values into the H and L regs
 695                (set (reg h-spr (ifield f-reg)) (and 16bval #xFF))
 696                (set (reg h-spr (sub (ifield f-reg) 1))
 697                     (and (srl 16bval 8) #xFF))
 698                (set fr (reg h-spr (ifield f-reg)))
 699             )
 700             ; Original instruction
 701             (set fr (sub fr 1))
 702          )
 703             (if (not (zflag fr))
 704                (skip 1)))
 705      ()
 706 )
 707
 708 (dni decsnzw_fr "Skip if W=fr-1 not zero"
 709      ()
 710      "decsnz W,$fr"
 711      (+ OP6_DECSNZ DIR_TO_W fr)
 712      (sequence ()
 713                (set w (sub fr 1))
 714                (if (not (zflag w))
 715                    (skip 1)))
 716      ()
 717 )
 718
 719 (dni subcw_fr "Subract w/carry W,fr"
 720      ()
 721      "subc W,$fr"
 722      (+ OP6_SUBC DIR_TO_W fr)
 723      (sequence ((QI result) (BI newcbit))
 724                (set newcbit (not (sub-cflag fr w (not cbit))))
 725                (set dcbit (not (sub-dcflag fr w (not cbit))))
 726                (set result (subc fr w (not cbit)))
 727                (set zbit (zflag result))
 728                (set cbit newcbit)
 729                (set w result))
 730      ()
 731 )
 732
 733 (dni subcfr_w "Subtract w/carry fr,W"
 734      ()
 735      "subc $fr,W"
 736      (+ OP6_SUBC DIR_NOTTO_W fr)
 737      (sequence ((QI result) (BI newcbit) (QI isLreg) (HI 16bval))
 738                (set newcbit (not (sub-cflag fr w (not cbit))))
 739                (set dcbit (not (sub-dcflag fr w (not cbit))))
 740                (LregCheck isLreg (ifield f-reg))
 741                ;; If fr is an Lreg, then we have to do 16-bit arithmetic.
 742                ;; We can take advantage of the fact that by a lucky
 743                ;; coincidence, the address of register xxxH is always
 744                ;; one lower than the address of register xxxL.
 745                (if (eq isLreg #x1)
 746                   (sequence()
 747                      ; Create the 16 bit value
 748                      (set 16bval (reg h-spr (sub (ifield f-reg) 1)))
 749                      (set 16bval (sll 16bval 8))
 750                      (set 16bval (or 16bval (and (reg h-spr (ifield f-reg)) #xFF)))
 751                      ; New 16 bit instruction
 752                      (set 16bval (subc HI 16bval w (not cbit)))
 753                      ; Separate the 16 bit values into the H and L regs
 754                      (set (reg h-spr (ifield f-reg)) (and 16bval #xFF))
 755                      (set (reg h-spr (sub (ifield f-reg) 1))
 756                           (and (srl 16bval 8) #xFF))
 757                      (set result (reg h-spr (ifield f-reg)))
 758                   )
 759                ; Original instruction
 760                (set result (subc fr w (not cbit)))
 761                )
 762
 763
 764                (set zbit (zflag result))
 765                (set cbit newcbit)
 766                (set fr result))
 767      ()
 768 )
 769
 770
 771 (dni pop_fr "Pop fr"
 772      ()
 773      "pop $fr"
 774      (+ OP6_POP (f-dir 1) fr)
 775      (sequence()
 776         (set fr (c-call QI "pop"))
 777         (c-call VOID "adjuststackptr" (const 1))
 778      )
 779      ()
 780 )
 781
 782 (dni push_fr "Push fr"
 783      ()
 784      "push $fr"
 785      (+ OP6_POP (f-dir 0) fr)
 786      (sequence()
 787         (c-call "push" fr)
 788         (c-call VOID "adjuststackptr" (const -1))
 789      )
 790      ()
 791 )
 792
 793 (dni csew_fr "Skip if equal W,fr"
 794      ()
 795      "cse W,$fr"
 796      (+ OP6_CSE (f-dir 1) fr)
 797      (if (eq w fr)
 798          (skip 1))
 799      ()
 800 )
 801
 802 (dni csnew_fr "Skip if not-equal W,fr"
 803      ()
 804      "csne W,$fr"
 805      (+ OP6_CSE (f-dir 0) fr)
 806      (if (not (eq w fr))
 807          (skip 1))
 808      ()
 809 )
 810
 811 ;;(dni csaw_fr "Skip if W above fr"
 812 ;;     ((MACH ip2022ext))
 813 ;;     "csa W,$fr"
 814 ;;     (+ OP6_CSAB (f-dir 1) fr)
 815 ;;     (if (gt w fr)
 816 ;;       (skip 1))
 817 ;;    ()
 818 ;;)
 819
 820 ;;(dni csbw_fr "Skip if W below fr"
 821 ;;     ((MACH ip2022ext))
 822 ;;     "csb W,$fr"
 823 ;;     (+ OP6_CSAB (f-dir 0) fr)
 824 ;;     (if (lt w fr)
 825 ;;       (skip 1))
 826 ;;    ()
 827 ;;)
 828
 829 (dni incsz_fr "Skip if fr++ zero"
 830      ()
 831      "incsz $fr"
 832      (+ OP6_INCSZ DIR_NOTTO_W fr)
 833      (sequence ((QI isLreg) (HI 16bval))
 834           (LregCheck isLreg (ifield f-reg))
 835           ;; If fr is an Lreg, then we have to do 16-bit arithmetic.
 836           ;; We can take advantage of the fact that by a lucky
 837           ;; coincidence, the address of register xxxH is always
 838           ;; one lower than the address of register xxxL.
 839           (if (eq isLreg #x1)
 840              (sequence()
 841                 ; Create the 16 bit value
 842                 (set 16bval (reg h-spr (sub (ifield f-reg) 1)))
 843                 (set 16bval (sll 16bval 8))
 844                 (set 16bval (or 16bval (and (reg h-spr (ifield f-reg)) #xFF)))
 845                 ; New 16 bit instruction
 846                 (set 16bval (add HI 16bval 1))
 847                 ; Separate the 16 bit values into the H and L regs
 848                 (set (reg h-spr (ifield f-reg)) (and 16bval #xFF))
 849                 (set (reg h-spr (sub (ifield f-reg) 1))
 850                      (and (srl 16bval 8) #xFF))
 851                 (set fr (reg h-spr (ifield f-reg)))
 852              )
 853              ; Original instruction
 854              (set fr (add fr 1))
 855           )
 856                (if (zflag fr)
 857                    (skip 1)))
 858      ()
 859 )
 860
 861 (dni incszw_fr "Skip if W=fr+1 zero"
 862      ()
 863      "incsz W,$fr"
 864      (+ OP6_INCSZ DIR_TO_W fr)
 865      (sequence ()
 866                (set w (add fr 1))
 867                (if (zflag w)
 868                    (skip 1)))
 869      ()
 870 )
 871
 872 (dni swap_fr "Swap fr nibbles"
 873      ()
 874      "swap $fr"
 875      (+ OP6_SWAP DIR_NOTTO_W fr)
 876      (set fr (or (and (sll fr 4) #xf0)
 877                  (and (srl fr 4) #x0f)))
 878      ()
 879 )
 880
 881 (dni swapw_fr "Swap fr nibbles into W"
 882      ()
 883      "swap W,$fr"
 884      (+ OP6_SWAP DIR_TO_W fr)
 885      (set w (or (and (sll fr 4) #xf0)
 886                 (and (srl fr 4) #x0f)))
 887      ()
 888 )
 889
 890 (dni rl_fr "Rotate fr left with carry"
 891      ()
 892      "rl $fr"
 893      (+ OP6_RL DIR_NOTTO_W fr)
 894      (sequence ((QI newfr) (BI newc))
 895                (set newc (and fr #x80))
 896                (set newfr (or (sll fr 1) (if QI cbit 1 0)))
 897                (set cbit (if QI newc 1 0))
 898                (set fr newfr))
 899      ()
 900 )
 901
 902 (dni rlw_fr "Rotate fr left with carry into W"
 903      ()
 904      "rl W,$fr"
 905      (+ OP6_RL DIR_TO_W fr)
 906      (sequence ((QI newfr) (BI newc))
 907                (set newc (and fr #x80))
 908                (set newfr (or (sll fr 1) (if QI cbit 1 0)))
 909                (set cbit (if QI newc 1 0))
 910                (set w newfr))
 911      ()
 912 )
 913
 914 (dni rr_fr "Rotate fr right with carry"
 915      ()
 916      "rr $fr"
 917      (+ OP6_RR DIR_NOTTO_W fr)
 918      (sequence ((QI newfr) (BI newc))
 919                (set newc (and fr #x01))
 920                (set newfr (or (srl fr 1) (if QI cbit #x80 #x00)))
 921                (set cbit (if QI newc 1 0))
 922                (set fr newfr))
 923      ()
 924 )
 925
 926 (dni rrw_fr "Rotate fr right with carry into W"
 927      ()
 928      "rr W,$fr"
 929      (+ OP6_RR DIR_TO_W fr)
 930      (sequence ((QI newfr) (BI newc))
 931                (set newc (and fr #x01))
 932                (set newfr (or (srl fr 1) (if QI cbit #x80 #x00)))
 933                (set cbit (if QI newc 1 0))
 934                (set w newfr))
 935      ()
 936 )
 937
 938 (dni decsz_fr "Skip if fr-- zero"
 939      ()
 940      "decsz $fr"
 941      (+ OP6_DECSZ DIR_NOTTO_W fr)
 942      (sequence ((QI isLreg) (HI 16bval))
 943           (LregCheck isLreg (ifield f-reg))
 944           ;; If fr is an Lreg, then we have to do 16-bit arithmetic.
 945           ;; We can take advantage of the fact that by a lucky
 946           ;; coincidence, the address of register xxxH is always
 947           ;; one lower than the address of register xxxL.
 948           (if (eq isLreg #x1)
 949              (sequence()
 950                 ; Create the 16 bit value
 951                 (set 16bval (reg h-spr (sub (ifield f-reg) 1)))
 952                 (set 16bval (sll 16bval 8))
 953                 (set 16bval (or 16bval (and (reg h-spr (ifield f-reg)) #xFF)))
 954                 ; New 16 bit instruction
 955                 (set 16bval (sub HI 16bval 1))
 956                 ; Separate the 16 bit values into the H and L regs
 957                 (set (reg h-spr (ifield f-reg)) (and 16bval #xFF))
 958                 (set (reg h-spr (sub (ifield f-reg) 1))
 959                      (and (srl 16bval 8) #xFF))
 960                 (set fr (reg h-spr (ifield f-reg)))
 961              )
 962              ; Original instruction
 963              (set fr (sub fr 1))
 964           )
 965                (if (zflag fr)
 966                    (skip 1)))
 967      ()
 968 )
 969
 970 (dni decszw_fr "Skip if W=fr-1 zero"
 971      ()
 972      "decsz W,$fr"
 973      (+ OP6_DECSZ DIR_TO_W fr)
 974      (sequence ()
 975                (set w (sub fr 1))
 976                (if (zflag w)
 977                    (skip 1)))
 978      ()
 979 )
 980
 981 (dni inc_fr "Increment fr"
 982      ()
 983      "inc $fr"
 984      (+ OP6_INC DIR_NOTTO_W fr)
 985      (sequence ((QI isLreg) (HI 16bval))
 986           (LregCheck isLreg (ifield f-reg))
 987           ;; If fr is an Lreg, then we have to do 16-bit arithmetic.
 988           ;; We can take advantage of the fact that by a lucky
 989           ;; coincidence, the address of register xxxH is always
 990           ;; one lower than the address of register xxxL.
 991           (if (eq isLreg #x1)
 992              (sequence()
 993                 ; Create the 16 bit value
 994                 (set 16bval (reg h-spr (sub (ifield f-reg) 1)))
 995                 (set 16bval (sll 16bval 8))
 996                 (set 16bval (or 16bval (and (reg h-spr (ifield f-reg)) #xFF)))
 997                 ; New 16 bit instruction
 998                 (set 16bval (add HI 16bval 1))
 999                 ; Separate the 16 bit values into the H and L regs
1000                 (set (reg h-spr (ifield f-reg)) (and 16bval #xFF))
1001                 (set (reg h-spr (sub (ifield f-reg) 1))
1002                      (and (srl 16bval 8) #xFF))
1003                 (set fr (reg h-spr (ifield f-reg)))
1004              )
1005              ; Original instruction
1006              (set fr (add fr 1))
1007            )
1008                (set zbit (zflag fr)))
1009      ()
1010 )
1011
1012 (dni incw_fr "Increment fr into w"
1013      ()
1014      "inc W,$fr"
1015      (+ OP6_INC DIR_TO_W fr)
1016      (sequence ()
1017                (set w (add fr 1))
1018                (set zbit (zflag w)))
1019      ()
1020 )
1021
1022 (dni not_fr "Invert fr"
1023      ()
1024      "not $fr"
1025      (+ OP6_NOT DIR_NOTTO_W fr)
1026      (sequence ()
1027                (set fr (inv fr))
1028                (set zbit (zflag fr)))
1029      ()
1030 )
1031
1032 (dni notw_fr "Invert fr into w"
1033      ()
1034      "not W,$fr"
1035      (+ OP6_NOT DIR_TO_W fr)
1036      (sequence ()
1037                (set w (inv fr))
1038                (set zbit (zflag w)))
1039      ()
1040 )
1041
1042 (dni test_fr "Test fr"
1043      ()
1044      "test $fr"
1045      (+ OP6_TEST DIR_NOTTO_W fr)
1046      (sequence ()
1047                (set zbit (zflag fr)))
1048      ()
1049 )
1050
1051 (dni movw_l "MOV W,literal"
1052      ()
1053      "mov W,#$lit8"
1054      (+ OP4_LITERAL OP4MID_MOV_L lit8)
1055      (set w lit8)
1056      ()
1057 )
1058
1059 (dni movfr_w "Move/test w into fr"
1060      ()
1061      "mov $fr,W"
1062      (+ OP6_OTHER1 DIR_NOTTO_W fr)
1063      (set fr w)
1064      ()
1065 )
1066
1067 (dni movw_fr "Move/test fr into w"
1068      ()
1069      "mov W,$fr"
1070      (+ OP6_TEST DIR_TO_W fr)
1071      (sequence ()
1072                (set w fr)
1073                (set zbit (zflag w)))
1074      ()
1075 )
1076
1077
1078 (dni addfr_w "Add fr,W"
1079      ()
1080      "add $fr,W"
1081      (+ OP6_ADD DIR_NOTTO_W fr)
1082      (sequence ((QI result) (QI isLreg) (HI 16bval))
1083                (set cbit (add-cflag w fr 0))
1084                (set dcbit (add-dcflag w fr 0))
1085                (LregCheck isLreg (ifield f-reg))
1086
1087                ;; If fr is an Lreg, then we have to do 16-bit arithmetic.
1088                ;; We can take advantage of the fact that by a lucky
1089                ;; coincidence, the address of register xxxH is always
1090                ;; one lower than the address of register xxxL.
1091                (if (eq isLreg #x1)
1092                   (sequence()
1093                      (set 16bval (reg h-spr (sub (ifield f-reg) 1)))
1094                      (set 16bval (sll 16bval 8))
1095                      (set 16bval (or 16bval (and (reg h-spr (ifield f-reg)) #xFF)))
1096                      (set 16bval (add HI (and w #xFF) 16bval))
1097                      (set (reg h-spr (ifield f-reg)) (and 16bval #xFF))
1098                      (set (reg h-spr (sub (ifield f-reg) 1))
1099                           (and (srl 16bval 8) #xFF))
1100                      (set result (reg h-spr (ifield f-reg)))
1101                   )
1102                (set result (addc w fr 0)) ;; else part
1103                )
1104                (set zbit (zflag result))
1105                (set fr result))
1106      ()
1107 )
1108
1109 (dni addw_fr "Add W,fr"
1110      ()
1111      "add W,$fr"
1112      (+ OP6_ADD DIR_TO_W fr)
1113      (sequence ((QI result))
1114                (set cbit (add-cflag w fr 0))
1115                (set dcbit (add-dcflag w fr 0))
1116                (set result (addc w fr 0))
1117                (set zbit (zflag result))
1118                (set w result))
1119      ()
1120 )
1121
1122 (dni xorfr_w "XOR fr,W"
1123      ()
1124      "xor $fr,W"
1125      (+ OP6_XOR DIR_NOTTO_W fr)
1126      (sequence ()
1127                (set fr (xor w fr))
1128                (set zbit (zflag fr)))
1129      ()
1130 )
1131
1132 (dni xorw_fr "XOR W,fr"
1133      ()
1134      "xor W,$fr"
1135      (+ OP6_XOR DIR_TO_W fr)
1136      (sequence ()
1137                (set w (xor fr w))
1138                (set zbit (zflag w)))
1139      ()
1140 )
1141
1142 (dni andfr_w "AND fr,W"
1143      ()
1144      "and $fr,W"
1145      (+ OP6_AND DIR_NOTTO_W fr)
1146      (sequence ()
1147                (set fr (and w fr))
1148                (set zbit (zflag fr)))
1149      ()
1150 )
1151
1152 (dni andw_fr "AND W,fr"
1153      ()
1154      "and W,$fr"
1155      (+ OP6_AND DIR_TO_W fr)
1156      (sequence ()
1157                (set w (and fr w))
1158                (set zbit (zflag w)))
1159      ()
1160 )
1161
1162 (dni orfr_w "OR fr,W"
1163      ()
1164      "or $fr,W"
1165      (+ OP6_OR DIR_NOTTO_W fr)
1166      (sequence ()
1167                (set fr (or w fr))
1168                (set zbit (zflag fr)))
1169      ()
1170 )
1171
1172 (dni orw_fr "OR W,fr"
1173      ()
1174      "or W,$fr"
1175      (+ OP6_OR DIR_TO_W fr)
1176      (sequence ()
1177                (set w (or fr w))
1178                (set zbit (zflag w)))
1179      ()
1180 )
1181
1182 (dni dec_fr "Decrement fr"
1183      ()
1184      "dec $fr"
1185      (+ OP6_DEC DIR_NOTTO_W fr)
1186      (sequence ((QI isLreg) (HI 16bval))
1187           (LregCheck isLreg (ifield f-reg))
1188           ;; If fr is an Lreg, then we have to do 16-bit arithmetic.
1189           ;; We can take advantage of the fact that by a lucky
1190           ;; coincidence, the address of register xxxH is always
1191           ;; one lower than the address of register xxxL.
1192           (if (eq isLreg #x1)
1193              (sequence()
1194                 ; Create the 16 bit value
1195                 (set 16bval (reg h-spr (sub (ifield f-reg) 1)))
1196                 (set 16bval (sll 16bval 8))
1197                 (set 16bval (or 16bval (and (reg h-spr (ifield f-reg)) #xFF)))
1198                 ; New 16 bit instruction
1199                 (set 16bval (sub HI 16bval 1))
1200                 ; Separate the 16 bit values into the H and L regs
1201                 (set (reg h-spr (ifield f-reg)) (and 16bval #xFF))
1202                 (set (reg h-spr (sub (ifield f-reg) 1))
1203                      (and (srl 16bval 8) #xFF))
1204                 (set fr (reg h-spr (ifield f-reg)))
1205              )
1206              ; Original instruction
1207              (set fr (sub fr 1))
1208           )
1209              (set zbit (zflag fr)))
1210      ()
1211 )
1212
1213 (dni decw_fr "Decrement fr into w"
1214      ()
1215      "dec W,$fr"
1216      (+ OP6_DEC DIR_TO_W fr)
1217      (sequence ()
1218                (set w (sub fr 1))
1219                (set zbit (zflag w)))
1220      ()
1221 )
1222
1223 (dni subfr_w "Sub fr,W"
1224      ()
1225      "sub $fr,W"
1226      (+ OP6_SUB DIR_NOTTO_W fr)
1227      (sequence ((QI result) (QI isLreg) (HI 16bval))
1228                (set cbit (not (sub-cflag fr w 0)))
1229                (set dcbit (not (sub-dcflag fr w 0)))
1230                (LregCheck isLreg (ifield f-reg))
1231                ;; If fr is an Lreg, then we have to do 16-bit arithmetic.
1232                ;; We can take advantage of the fact that by a lucky
1233                ;; coincidence, the address of register xxxH is always
1234                ;; one lower than the address of register xxxL.
1235                (if (eq isLreg #x1)
1236                   (sequence()
1237                      ; Create the 16 bit value
1238                      (set 16bval (reg h-spr (sub (ifield f-reg) 1)))
1239                      (set 16bval (sll 16bval 8))
1240                      (set 16bval (or 16bval (and (reg h-spr (ifield f-reg)) #xFF)))
1241                      ; New 16 bit instruction
1242                      (set 16bval (sub HI 16bval (and w #xFF)))
1243                      ; Separate the 16 bit values into the H and L regs
1244                      (set (reg h-spr (ifield f-reg)) (and 16bval #xFF))
1245                      (set (reg h-spr (sub (ifield f-reg) 1))
1246                           (and (srl 16bval 8) #xFF))
1247                      (set result (reg h-spr (ifield f-reg)))
1248                   )
1249                ; Original instruction
1250                (set result (subc fr w 0))
1251                )
1252                (set zbit (zflag result))
1253                (set fr result))
1254      ()
1255 )
1256
1257 (dni subw_fr "Sub W,fr"
1258      ()
1259      "sub W,$fr"
1260      (+ OP6_SUB DIR_TO_W fr)
1261      (sequence ((QI result))
1262                (set cbit (not (sub-cflag fr w 0)))
1263                (set dcbit (not (sub-dcflag fr w 0)))
1264                (set result (subc fr w 0))
1265                (set zbit (zflag result))
1266                (set w result))
1267      ()
1268 )
1269
1270 (dni clr_fr "Clear fr"
1271      ()
1272      "clr $fr"
1273      (+ OP6_OTHER2 (f-dir 1) fr)
1274      (sequence ()
1275                (set fr 0)
1276                (set zbit (zflag fr)))
1277      ()
1278 )
1279
1280 (dni cmpw_fr "CMP W,fr"
1281      ()
1282      "cmp W,$fr"
1283      (+ OP6_OTHER2 (f-dir 0) fr)
1284      (sequence ()
1285                (set cbit (not (sub-cflag fr w 0)))
1286                (set dcbit (not (sub-dcflag fr w 0)))
1287                (set zbit (zflag (sub w fr))))
1288      ()
1289 )
1290
1291 (dni speed "Set speed"
1292      ()
1293      "speed #$lit8"
1294      (+ (f-op8 1) lit8)
1295      (set (reg h-registers #x0E) lit8)
1296      ()
1297 )
1298
1299 (dni ireadi "Insn memory read with increment"
1300      ()
1301      "ireadi"
1302      (+ OP6_OTHER1 (f-op6-10low #x1D))
1303      (c-call "do_insn_read")
1304      ()
1305 )
1306
1307 (dni iwritei "Insn memory write with increment"
1308      ()
1309      "iwritei"
1310      (+ OP6_OTHER1 (f-op6-10low #x1C))
1311      (c-call "do_insn_write")
1312      ()
1313 )
1314
1315 (dni fread "Flash read"
1316      ()
1317      "fread"
1318      (+ OP6_OTHER1 (f-op6-10low #x1B))
1319      (c-call "do_flash_read")
1320      ()
1321 )
1322
1323 (dni fwrite "Flash write"
1324      ()
1325      "fwrite"
1326      (+ OP6_OTHER1 (f-op6-10low #x1A))
1327      (c-call "do_flash_write")
1328      ()
1329 )
1330
1331 (dni iread "Insn memory read"
1332      ()
1333      "iread"
1334      (+ OP6_OTHER1 (f-op6-10low #x19))
1335      (c-call "do_insn_read")
1336      ()
1337 )
1338
1339 (dni iwrite "Insn memory write"
1340      ()
1341      "iwrite"
1342      (+ OP6_OTHER1 (f-op6-10low #x18))
1343      (c-call "do_insn_write")
1344      ()
1345 )
1346
1347 (dni page "Set insn page"
1348      (EXT-SKIP-INSN)
1349      ;"page $page3"
1350      "page $addr16p"
1351      ;(+ OP6_OTHER1 (f-op6-7low #x2) page3)
1352      ;(set pabits (srl page3 13))
1353      (+ OP6_OTHER1 (f-op6-7low #x2) addr16p)
1354      (set pabits addr16p)
1355      ()
1356 )
1357
1358 (dni system "System call"
1359      ()
1360      "system"
1361      (+ OP6_OTHER1 (f-op6-10low #xff))
1362      (c-call "do_system")
1363      ()
1364 )
1365
1366 (dni reti "Return from interrupt"
1367      ()
1368      "reti #$reti3"
1369      (+ OP6_OTHER1 (f-op6-7low #x1) reti3)
1370      (c-call "do_reti" reti3)
1371      ()
1372 )
1373
1374 (dni ret "Return"
1375      ()
1376      "ret"
1377      (+ OP6_OTHER1 (f-op6-10low #x07))
1378      (sequence ((USI new_pc))
1379                (set new_pc (c-call UHI "pop_pc_stack"))
1380                (set pabits (srl new_pc 13))
1381                (set pc new_pc))
1382      ()
1383 )
1384
1385 (dni int "Software interrupt"
1386      ()
1387      "int"
1388      (+ OP6_OTHER1 (f-op6-10low #x6))
1389      (nop)
1390      ()
1391 )
1392
1393 (dni breakx "Breakpoint with extended skip"
1394      (EXT-SKIP-INSN)
1395      "breakx"
1396      (+ OP6_OTHER1 (f-op6-10low #x5))
1397      (c-call "do_break" pc)
1398      ()
1399 )
1400
1401 (dni cwdt "Clear watchdog timer"
1402      ()
1403      "cwdt"
1404      (+ OP6_OTHER1 (f-op6-10low #x4))
1405      (c-call "do_clear_wdt")
1406      ()
1407 )
1408
1409 (dni ferase "Flash erase"
1410      ()
1411      "ferase"
1412      (+ OP6_OTHER1 (f-op6-10low #x3))
1413      (c-call "do_flash_erase")
1414      ()
1415 )
1416
1417 (dni retnp "Return, no page"
1418      ()
1419      "retnp"
1420      (+ OP6_OTHER1 (f-op6-10low #x2))
1421      (sequence ((USI new_pc))
1422                (set new_pc (c-call UHI "pop_pc_stack"))
1423                (set pc new_pc))
1424      ()
1425 )
1426
1427 (dni break "Breakpoint"
1428      ()
1429      "break"
1430      (+ OP6_OTHER1 (f-op6-10low #x1))
1431      (c-call "do_break" pc)
1432      ()
1433 )
1434
1435 (dni nop "No operation"
1436      ()
1437      "nop"
1438      (+ OP6_OTHER1 (f-op6-10low #x0))
1439      (nop)
1440      ()
1441 )
1442
1443
1444 ; Macro instructions
1445 (dnmi sc "Skip on carry"
1446       ()
1447       "sc"
1448       (emit sb (bitno 0) (fr #xB)) ; sb status.0
1449 )
1450
1451 (dnmi snc "Skip on no carry"
1452       ()
1453       "snc"
1454       (emit snb (bitno 0) (fr #xB)) ; snb status.0
1455 )
1456
1457 (dnmi sz "Skip on zero"
1458       ()
1459       "sz"
1460       (emit sb (bitno 2) (fr #xB)) ; sb status.2
1461 )
1462
1463 (dnmi snz "Skip on no zero"
1464       ()
1465       "snz"
1466       (emit snb (bitno 2) (fr #xB)) ; snb status.2
1467 )
1468
1469 (dnmi skip "Skip always"
1470       (SKIPA)
1471       "skip"
1472       (emit snb (bitno 0) (fr 9)) ; snb pcl.0 | (pcl&1)<<12
1473 )
1474
1475 (dnmi skipb "Skip always"
1476       (SKIPA)
1477       "skip"
1478       (emit sb (bitno 0) (fr 9)) ; sb pcl.0 | (pcl&1)<<12
1479 )
1480