Subversion Repositories open8_urisc

; Ubicom IP2K CPU description.  -*- Scheme -*-

; Copyright (C) 2002, 2009, 2011 Free Software Foundation, Inc.

;

; Contributed by Red Hat Inc;

;

; This file is part of the GNU Binutils.

;

; This program is free software; you can redistribute it and/or modify

; it under the terms of the GNU General Public License as published by

; the Free Software Foundation; either version 3 of the License, or

; (at your option) any later version.

;

; This program is distributed in the hope that it will be useful,

; but WITHOUT ANY WARRANTY; without even the implied warranty of

; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

; GNU General Public License for more details.

;

; You should have received a copy of the GNU General Public License

; along with this program; if not, write to the Free Software

; Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,

; MA 02110-1301, USA.

(define-rtl-version 0 8)

(include "simplify.inc")

; define-arch must appear first

(define-arch

  (name ip2k) ; name of cpu family

  (comment "Ubicom IP2000 family")

  (default-alignment aligned)

  (insn-lsb0? #t)

  (machs ip2022 ip2022ext)

  (isas ip2k)

)

; Attributes.

(define-attr

  (for insn)

  (type boolean)

  (name EXT-SKIP-INSN)

  (comment "instruction is a PAGE, LOADL, LOADH or BREAKX instruction")

)

(define-attr

  (for insn)

  (type boolean)

  (name SKIPA)

  (comment "instruction is a SKIP instruction")

)

; Instruction set parameters.

(define-isa

  (name ip2k)

  (comment "Ubicom IP2000 ISA")

  (default-insn-word-bitsize 16)

  (default-insn-bitsize 16)

  (base-insn-bitsize 16)

)

; Cpu family definitions.

(define-cpu

  ; cpu names must be distinct from the architecture name and machine names.

  (name ip2kbf)

  (comment "Ubicom IP2000 Family")

  (endian big)

  (word-bitsize 16)

)

(define-mach

  (name ip2022)

  (comment "Ubicom IP2022")

  (cpu ip2kbf)

)

(define-mach

  (name ip2022ext)

  (comment "Ubicom IP2022 extended")

  (cpu ip2kbf)

)

; Model descriptions.

(define-model

  (name ip2k) (comment "VPE 2xxx") (attrs)

  (mach ip2022ext)

  (unit u-exec "Execution Unit" ()

        1 1 ; issue done

        () ; state

        () ; inputs

        () ; outputs

        () ; profile action (default)

        )

)

; FIXME: It might simplify things to separate the execute process from the

; one that updates the PC.

; Instruction fields.

;

; Attributes:

; XXX: what VPE attrs

; PCREL-ADDR: pc relative value (for reloc and disassembly purposes)

; ABS-ADDR: absolute address (for reloc and disassembly purposes?)

; RESERVED: bits are not used to decode insn, must be all 0

; RELOC: there is a relocation associated with this field (experiment)

(dnf f-imm8      "imm8"                () 7 8)

(dnf f-reg       "reg"         (ABS-ADDR) 8 9)

(dnf f-addr16cjp "addr16cjp"   (ABS-ADDR) 12 13)

(dnf f-dir       "dir"                 () 9 1)

(dnf f-bitno     "bit number"          () 11 3)

(dnf f-op3       "op3"                 () 15 3)

(dnf f-op4       "op4"                 () 15 4)

(dnf f-op4mid    "op4mid"              () 11 4)

(dnf f-op6       "op6"                 () 15 6)

(dnf f-op8       "op8"                 () 15 8)

(dnf f-op6-10low "op6-10low"           () 9 10)

(dnf f-op6-7low  "op6-7low"            () 9 7)

(dnf f-reti3     "reti3"               () 2 3)

(dnf f-skipb     "sb/snb"      (ABS-ADDR) 12 1)

(dnf f-page3     "page3"               ()  2 3)

;(define-ifield (name f-page3) (comment "page3") (attrs) (start 2) (length 3)

;  (encode (value pc) (srl WI value 13))

;  (decode (value pc) (sll WI value 13))

;)

; To fix the page/call asymmetry

;(define-ifield (name f-page3) (comment "page3") (attrs) (start 2) (length 3)

;  (encode (value pc) (srl WI value 13))

;  (decode (value pc) (sll WI value 13))

;)

; Enums.

; insn-op6: bits 15-10

(define-normal-insn-enum insn-op6 "op6 enums" () OP6_ f-op6

  (OTHER1 OTHER2 SUB DEC OR AND XOR ADD

   TEST NOT INC DECSZ RR RL SWAP INCSZ

   CSE POP SUBC DECSNZ MULU MULS INCSNZ  ADDC

   - - - - - - - -

   - - - - - - - -

   - - - - - - - -

   - - - - - - - -

   - - - - - - - -

   )

)

; insn-dir: bit 9

(define-normal-insn-enum insn-dir "dir enums" () DIR_ f-dir

  ; This bit specifies the polarity of many two-operand instructions:

  ; TO_W writes result to W regiser  (eg. ADDC W,$fr)

  ; NOTTO_W writes result in general register  (eg. ADDC $fr,W)

  (TO_W NOTTO_W)

)

; insn-op4: bits 15-12

(define-normal-insn-enum insn-op4 "op4 enums" () OP4_ f-op4

  (- - - - - - - LITERAL

   CLRB SETB SNB SB - - - -

   )

)

; insn-op4mid: bits 11-8

; used for f-op4=LITERAL

(define-normal-insn-enum insn-op4mid "op4mid enums" () OP4MID_ f-op4mid

  (LOADH_L LOADL_L MULU_L MULS_L PUSH_L  -  CSNE_L CSE_L

   RETW_L CMP_L SUB_L ADD_L MOV_L OR_L AND_L XOR_L)

)

; insn-op3: bits 15-13

(define-normal-insn-enum insn-op3 "op3 enums" () OP3_ f-op3

  (- - - - - - CALL JMP)

)

; Hardware pieces.

; Bank-relative general purpose registers

; (define-pmacro (build-reg-name n) (.splice (.str "$" n) n))

(define-keyword

  (name register-names)

  (enum-prefix H-REGISTERS-)

  (values

   ; These are the "Special Purpose Registers" that are not reserved

   ("ADDRSEL" #x2) ("ADDRX" #x3)

   ("IPH" #x4) ("IPL" #x5) ("SPH" #x6) ("SPL" #x7)

   ("PCH" #x8) ("PCL" #x9) ("WREG" #xA) ("STATUS" #xB)

   ("DPH" #xC) ("DPL" #xD) ("SPDREG" #xE) ("MULH" #xF)

   ("ADDRH" #x10) ("ADDRL" #x11) ("DATAH" #x12) ("DATAL" #x13)

   ("INTVECH" #x14) ("INTVECL" #x15) ("INTSPD" #x16) ("INTF" #x17)

   ("INTE" #x18) ("INTED" #x19) ("FCFG" #x1A) ("TCTRL" #x1B)

   ("XCFG" #x1C) ("EMCFG" #x1D) ("IPCH" #x1E) ("IPCL" #x1F)

   ("RAIN" #x20) ("RAOUT" #x21) ("RADIR" #x22) ("LFSRH" #x23)

   ("RBIN" #x24) ("RBOUT" #x25) ("RBDIR" #x26) ("LFSRL" #x27)

   ("RCIN" #x28) ("RCOUT" #x29) ("RCDIR" #x2A) ("LFSRA" #x2B)

   ("RDIN" #x2C) ("RDOUT" #x2D) ("RDDIR" #x2E)

   ("REIN" #x30) ("REOUT" #x31) ("REDIR" #x32)

   ("RFIN" #x34) ("RFOUT" #x35) ("RFDIR" #x36)

                 ("RGOUT" #x39) ("RGDIR" #x3A)

   ("RTTMR" #x40) ("RTCFG" #x41) ("T0TMR" #x42) ("T0CFG" #x43)

   ("T1CNTH" #x44) ("T1CNTL" #x45) ("T1CAP1H" #x46) ("T1CAP1L" #x47)

   ("T1CAP2H" #x48) ("T1CMP2H" #x48) ("T1CAP2L" #x49) ("T1CMP2L" #x49) ; note aliases

                                     ("T1CMP1H" #x4A) ("T1CMP1L" #x4B)

   ("T1CFG1H" #x4C) ("T1CFG1L" #x4D) ("T1CFG2H" #x4E) ("T1CFG2L" #x4F)

   ("ADCH" #x50) ("ADCL" #x51) ("ADCCFG" #x52) ("ADCTMR" #x53)

   ("T2CNTH" #x54) ("T2CNTL" #x55) ("T2CAP1H" #x56) ("T2CAP1L" #x57)

   ("T2CAP2H" #x58) ("T2CMP2H" #x58) ("T2CAP2L" #x59) ("T2CMP2L" #x59) ; note aliases

                                     ("T2CMP1H" #x5A) ("T2CMP1L" #x5B)

   ("T2CFG1H" #x5C) ("T2CFG1L" #x5D) ("T2CFG2H" #x5E) ("T2CFG2L" #x5F)

   ("S1TMRH" #x60) ("S1TMRL" #x61) ("S1TBUFH" #x62) ("S1TBUFL" #x63)

   ("S1TCFG" #x64) ("S1RCNT" #x65) ("S1RBUFH" #x66) ("S1RBUFL" #x67)

   ("S1RCFG" #x68) ("S1RSYNC" #x69) ("S1INTF" #x6A) ("S1INTE" #x6B)

   ("S1MODE" #x6C) ("S1SMASK" #x6D) ("PSPCFG" #x6E) ("CMPCFG" #x6F)

   ("S2TMRH" #x70) ("S2TMRL" #x71) ("S2TBUFH" #x72) ("S2TBUFL" #x73)

   ("S2TCFG" #x74) ("S2RCNT" #x75) ("S2RBUFH" #x76) ("S2RBUFL" #x77)

   ("S2RCFG" #x78) ("S2RSYNC" #x79) ("S2INTF" #x7A) ("S2INTE" #x7B)

   ("S2MODE" #x7C) ("S2SMASK" #x7D) ("CALLH" #x7E) ("CALLL" #x7F))

  )

(define-hardware

  (name h-spr)

  (comment "special-purpose registers")

  (type register QI (128))

  (get (index) (c-call QI "get_spr" index ))

  (set (index newval) (c-call VOID "set_spr" index newval ))

)

;;(define-hardware

;;  (name h-gpr-global)

;;  (comment "gpr registers - global")

;;  (type register QI (128))

;;)

; The general register

(define-hardware

  (name h-registers)

  (comment "all addressable registers")

  (attrs VIRTUAL)

  (type register QI (512))

  (get (index) (c-call QI "get_h_registers" index ))

  (set (index newval) (c-call VOID "set_h_registers" index newval ))

)

; The hardware stack.

; Use {push,pop}_pc_stack c-calls to operate on this hardware element.

(define-hardware

  (name h-stack)

  (comment "hardware stack")

  (type register UHI (16))

)

(dsh h-pabits "page bits" () (register QI))

(dsh h-zbit "zero bit" () (register BI))

(dsh h-cbit "carry bit" () (register BI))

(dsh h-dcbit "digit-carry bit" () (register BI))

(dnh h-pc "program counter" (PC PROFILE) (pc) () () ())

; Operands

(define-operand (name addr16cjp) (comment "13-bit address") (attrs)

  (type h-uint) (index f-addr16cjp) (handlers (parse "addr16_cjp") (print "dollarhex_cj"))) ; overload lit8 printer

(define-operand (name fr) (comment "register") (attrs)

  (type h-registers) (index f-reg) (handlers (parse "fr") (print "fr")))

(define-operand (name lit8) (comment "8-bit signed literal") (attrs)

  (type h-sint) (index f-imm8) (handlers (parse "lit8") (print "dollarhex8")))

(define-operand (name bitno) (comment "bit number") (attrs)

  (type h-uint) (index f-bitno) (handlers (parse "bit3")(print "decimal")))

(define-operand (name addr16p) (comment "page number") (attrs)

  (type h-uint) (index f-page3) (handlers (parse "addr16_cjp") (print "dollarhex_p")))

(define-operand (name addr16h) (comment "high 8 bits of address") (attrs)

  (type h-uint) (index f-imm8) (handlers (parse "addr16") (print "dollarhex_addr16h")))

(define-operand (name addr16l) (comment "low 8 bits of address") (attrs)

  (type h-uint) (index f-imm8) (handlers (parse "addr16") (print "dollarhex_addr16l")))

(define-operand (name reti3) (comment "reti flags") (attrs)

  (type h-uint) (index f-reti3) (handlers (print "dollarhex")))

(dnop pabits   "page bits"                 () h-pabits f-nil)

(dnop zbit     "zero bit"                  () h-zbit f-nil)

(dnop cbit     "carry bit"                 () h-cbit f-nil)

(dnop dcbit    "digit carry bit"           () h-dcbit f-nil)

;;(dnop bank     "bank register"             () h-bank-no f-nil)

(define-pmacro w     (reg h-spr #x0A))

(define-pmacro mulh  (reg h-spr #x0F))

(define-pmacro dph   (reg h-spr #x0C))

(define-pmacro dpl   (reg h-spr #x0D))

(define-pmacro sph   (reg h-spr #x06))

(define-pmacro spl   (reg h-spr #x07))

(define-pmacro iph   (reg h-spr #x04))

(define-pmacro ipl   (reg h-spr #x05))

(define-pmacro addrh (reg h-spr #x10))

(define-pmacro addrl (reg h-spr #x11))

; Pseudo-RTL for DC flag calculations

; "DC" = "digit carry", ie carry between nibbles

(define-pmacro (add-dcflag a b c)

  (add-cflag (sll QI a 4) (sll QI b 4) c)

)

(define-pmacro (sub-dcflag a b c)

  (sub-cflag (sll QI a 4) (sll QI b 4) c)

)

; Check to see if an fr is one of IPL, SPL, DPL, ADDRL, PCL.

(define-pmacro (LregCheck isLreg fr9bit)

   (sequence()

      (set isLreg #x0) ;; Assume it's not an Lreg

      (if (or (or (eq fr9bit #x5) (eq fr9bit #x7))

              (or (eq fr9bit #x9)

                  (or (eq fr9bit #xd) (eq fr9bit #x11))))

          (set isLreg #x1)

      )

   )

)

; Instructions, in order of the "Instruction Set Map" table on

; pp 19-20 of IP2022 spec V1.09

(dni jmp "Jump"

     ()

     "jmp $addr16cjp"

     (+ OP3_JMP addr16cjp)

     (set pc (or (sll pabits 13) addr16cjp))

     ()

)

; note that in call, we push pc instead of pc + 1 because the ip2k increments

; the pc prior to execution of the instruction

(dni call "Call"

     ()

     "call $addr16cjp"

     (+ OP3_CALL addr16cjp)

     (sequence ()

               (c-call "push_pc_stack" pc)

               (set pc (or (sll pabits 13) addr16cjp)))

     ()

)

(dni sb "Skip if bit set"

     ()

     "sb $fr,$bitno"

     (+ OP4_SB bitno fr)

     (if (and fr (sll 1 bitno))

         (skip 1))

     ()

)

(dni snb "Skip if bit clear"

     ()

     "snb $fr,$bitno"

     (+ OP4_SNB bitno fr)

     (if (not (and fr (sll 1 bitno)))

         (skip 1))

     ()

)

(dni setb "Set bit"

     ()

     "setb $fr,$bitno"

     (+ OP4_SETB bitno fr)

     (set fr (or fr (sll 1 bitno)))

     ()

)

(dni clrb "Clear bit"

     ()

     "clrb $fr,$bitno"

     (+ OP4_CLRB bitno fr)

     (set fr (and fr (inv (sll 1 bitno))))

     ()

)

(dni xorw_l "XOR W,literal"

     ()

     "xor W,#$lit8"

     (+ OP4_LITERAL OP4MID_XOR_L lit8)

     (sequence ()

               (set w (xor w lit8))

               (set zbit (zflag w)))

     ()

)

(dni andw_l "AND W,literal"

     ()

     "and W,#$lit8"

     (+ OP4_LITERAL OP4MID_AND_L lit8)

     (sequence ()

               (set w (and w lit8))

               (set zbit (zflag w)))

     ()

)

(dni orw_l "OR W,literal"

     ()

     "or W,#$lit8"

     (+ OP4_LITERAL OP4MID_OR_L lit8)

     (sequence ()

               (set w (or w lit8))

               (set zbit (zflag w)))

     ()

)

(dni addw_l "ADD W,literal"

     ()

     "add W,#$lit8"

     (+ OP4_LITERAL OP4MID_ADD_L lit8)

     (sequence ()

               (set cbit (add-cflag w lit8 0))

               (set dcbit (add-dcflag w lit8 0))

               (set w (add w lit8))

               (set zbit (zflag w)))

     ()

)

(dni subw_l "SUB W,literal"

     ()

     "sub W,#$lit8"

     (+ OP4_LITERAL OP4MID_SUB_L lit8)

     (sequence ()

               (set cbit (not (sub-cflag lit8 w 0)))

               (set dcbit (not (sub-dcflag lit8 w 0)))

               (set zbit (zflag (sub w lit8)))

               (set w (sub lit8 w)))

     ()

)

(dni cmpw_l "CMP W,literal"

     ()

     "cmp W,#$lit8"

     (+ OP4_LITERAL OP4MID_CMP_L lit8)

     (sequence ()

               (set cbit (not (sub-cflag lit8 w 0)))

               (set dcbit (not (sub-dcflag lit8 w 0)))

               (set zbit (zflag (sub w lit8))))

     ()

)

(dni retw_l "RETW literal"

     ()

     "retw #$lit8"

     (+ OP4_LITERAL OP4MID_RETW_L lit8)

     (sequence ((USI new_pc))

               (set w lit8)

               (set new_pc (c-call UHI "pop_pc_stack"))

               (set pabits (srl new_pc 13))

               (set pc new_pc))

     ()

)

(dni csew_l "CSE W,literal"

     ()

     "cse W,#$lit8"

     (+ OP4_LITERAL OP4MID_CSE_L lit8)

     (if (eq w lit8)

         (skip 1))

     ()

)

(dni csnew_l "CSNE W,literal"

     ()

     "csne W,#$lit8"

     (+ OP4_LITERAL OP4MID_CSNE_L lit8)

     (if (not (eq w lit8))

         (skip 1))

     ()

)

(dni push_l "Push #lit8"

     ()

     "push #$lit8"

     (+ OP4_LITERAL OP4MID_PUSH_L lit8)

     (sequence ()

        (c-call "push" lit8)

        (c-call VOID "adjuststackptr" (const -1))

     )

     ()

)

(dni mulsw_l "Multiply W,literal (signed)"

     ()

     "muls W,#$lit8"

     (+ OP4_LITERAL OP4MID_MULS_L lit8)

     (sequence ((SI tmp))

               (set tmp (mul (ext SI w) (ext SI (and UQI #xff lit8))))

               (set w (and tmp #xFF))

               (set mulh (srl tmp 8)))

     ()

)

(dni muluw_l "Multiply W,literal (unsigned)"

     ()

     "mulu W,#$lit8"

     (+ OP4_LITERAL OP4MID_MULU_L lit8)

     (sequence ((USI tmp))

               (set tmp (and #xFFFF (mul (zext USI w) (zext USI lit8))))

               (set w (and tmp #xFF))

               (set mulh (srl tmp 8)))

     ()

)

(dni loadl_l "LoadL literal"

    (EXT-SKIP-INSN)

    "loadl #$lit8"

    (+ OP4_LITERAL OP4MID_LOADL_L lit8)

    (set dpl (and lit8 #x00FF))

    ()

)

(dni loadh_l "LoadH literal"

    (EXT-SKIP-INSN)

    "loadh #$lit8"

    (+ OP4_LITERAL OP4MID_LOADH_L lit8)

    (set dph (and lit8 #x00FF))

    ()

)

(dni loadl_a "LoadL addr16l"

    (EXT-SKIP-INSN)

    "loadl $addr16l"

    (+ OP4_LITERAL OP4MID_LOADL_L addr16l)

    (set dpl (and addr16l #x00FF))

    ()

)

(dni loadh_a "LoadH addr16h"

    (EXT-SKIP-INSN)

    "loadh $addr16h"

    (+ OP4_LITERAL OP4MID_LOADH_L addr16h)

    (set dph (and addr16l #x0FF00))

    ()

)

;; THIS NO LONGER EXISTS -> Now LOADL

;;(dni bank_l "Bank literal"

;;     ()

;;     "bank #$lit8"

;;     (+ OP4_LITERAL OP4MID_BANK_L lit8)

;;     (set bank lit8)

;;     ()

;;)

(dni addcfr_w "Add w/carry fr,W"

     ()

     "addc $fr,W"

     (+ OP6_ADDC DIR_NOTTO_W fr)

     (sequence ((QI result) (BI newcbit) (QI isLreg) (HI 16bval))

               (set newcbit (add-cflag w fr cbit))

               (set dcbit (add-dcflag w fr cbit))

               ;; If fr is an Lreg, then we have to do 16-bit arithmetic.

               ;; We can take advantage of the fact that by a lucky

               ;; coincidence, the address of register xxxH is always

               ;; one lower than the address of register xxxL.

               (LregCheck isLreg (ifield f-reg))

               (if (eq isLreg #x1)

                  (sequence()

                     (set 16bval (reg h-spr (sub (ifield f-reg) 1)))

                     (set 16bval (sll 16bval 8))

                     (set 16bval (or 16bval (and (reg h-spr (ifield f-reg)) #xFF)))

                     (set 16bval (addc HI 16bval w cbit))

                     (set (reg h-spr (ifield f-reg)) (and 16bval #xFF))

                     (set (reg h-spr (sub (ifield f-reg) 1))

                          (and (srl 16bval 8) #xFF))

                     (set result (reg h-spr (ifield f-reg)))

                  )

               (set result (addc w fr cbit)) ;; else part

               )

               (set zbit (zflag result))

               (set cbit newcbit)

               (set fr result))

     ()

)

(dni addcw_fr "Add w/carry W,fr"

     ()

     "addc W,$fr"

     (+ OP6_ADDC DIR_TO_W fr)

     (sequence ((QI result) (BI newcbit))

               (set newcbit (add-cflag w fr cbit))

               (set dcbit (add-dcflag w fr cbit))

               (set result (addc w fr cbit))

               (set zbit (zflag result))

               (set cbit newcbit)

               (set w result))

     ()

)

(dni incsnz_fr "Skip if fr++ not zero"

     ()

     "incsnz $fr"

     (+ OP6_INCSNZ DIR_NOTTO_W fr)

     (sequence ((QI isLreg) (HI 16bval))

        (LregCheck isLreg (ifield f-reg))

        ;; If fr is an Lreg, then we have to do 16-bit arithmetic.

        ;; We can take advantage of the fact that by a lucky

        ;; coincidence, the address of register xxxH is always

        ;; one lower than the address of register xxxL.

        (if (eq isLreg #x1)

           (sequence()

              ; Create the 16 bit value

              (set 16bval (reg h-spr (sub (ifield f-reg) 1)))

              (set 16bval (sll 16bval 8))

              (set 16bval (or 16bval (and (reg h-spr (ifield f-reg)) #xFF)))

              ; Do 16 bit arithmetic.

              (set 16bval (add HI 16bval 1))

              ; Separate the 16 bit values into the H and L regs

              (set (reg h-spr (ifield f-reg)) (and 16bval #xFF))

              (set (reg h-spr (sub (ifield f-reg) 1))

                   (and (srl 16bval 8) #xFF))

              (set fr (reg h-spr (ifield f-reg)))

           )

           (set fr (add fr 1)) ; Do 8 bit arithmetic.

        )

        (if (not (zflag fr))

           (skip 1)))

     ()

)

(dni incsnzw_fr "Skip if W=fr+1  not zero"

     ()

     "incsnz W,$fr"

     (+ OP6_INCSNZ DIR_TO_W fr)

     (sequence ()

               (set w (add fr 1))

               (if (not (zflag w))

                   (skip 1)))

     ()

)

(dni mulsw_fr "Multiply W,fr (signed)"

     ()

     "muls W,$fr"

     (+ OP6_MULS DIR_TO_W fr)

     (sequence ((SI tmp))

               (set tmp (mul (ext SI w) (ext SI fr)))

               (set w (and tmp #xFF))

               (set mulh (srl tmp 8)))

     ()

)

(dni muluw_fr "Multiply W,fr (unsigned)"

     ()

     "mulu W,$fr"

     (+ OP6_MULU DIR_TO_W fr)

     (sequence ((USI tmp))

               (set tmp (and #xFFFF (mul (zext USI w) (zext USI fr))))

               (set w (and tmp #xFF))

               (set mulh (srl tmp 8)))

     ()

)

(dni decsnz_fr "Skip if fr-- not zero"

     ()

     "decsnz $fr"

     (+ OP6_DECSNZ DIR_NOTTO_W fr)

     (sequence ((QI isLreg) (HI 16bval))

         (LregCheck isLreg (ifield f-reg))

         ;; If fr is an Lreg, then we have to do 16-bit arithmetic.

         ;; We can take advantage of the fact that by a lucky

         ;; coincidence, the address of register xxxH is always

         ;; one lower than the address of register xxxL.

         (if (eq isLreg #x1)

            (sequence()

               ; Create the 16 bit value

               (set 16bval (reg h-spr (sub (ifield f-reg) 1)))

               (set 16bval (sll 16bval 8))

               (set 16bval (or 16bval (and (reg h-spr (ifield f-reg)) #xFF)))

               ; New 16 bit instruction

               (set 16bval (sub HI 16bval 1))

               ; Separate the 16 bit values into the H and L regs

               (set (reg h-spr (ifield f-reg)) (and 16bval #xFF))

               (set (reg h-spr (sub (ifield f-reg) 1))

                    (and (srl 16bval 8) #xFF))

               (set fr (reg h-spr (ifield f-reg)))

            )

            ; Original instruction

            (set fr (sub fr 1))

         )

            (if (not (zflag fr))

               (skip 1)))

     ()

)

(dni decsnzw_fr "Skip if W=fr-1 not zero"

     ()

     "decsnz W,$fr"

     (+ OP6_DECSNZ DIR_TO_W fr)

     (sequence ()

               (set w (sub fr 1))

               (if (not (zflag w))

                   (skip 1)))

     ()

)

(dni subcw_fr "Subract w/carry W,fr"

     ()

     "subc W,$fr"

     (+ OP6_SUBC DIR_TO_W fr)

     (sequence ((QI result) (BI newcbit))

               (set newcbit (not (sub-cflag fr w (not cbit))))

               (set dcbit (not (sub-dcflag fr w (not cbit))))

               (set result (subc fr w (not cbit)))

               (set zbit (zflag result))

               (set cbit newcbit)

               (set w result))

     ()

)

(dni subcfr_w "Subtract w/carry fr,W"

     ()

     "subc $fr,W"

     (+ OP6_SUBC DIR_NOTTO_W fr)

     (sequence ((QI result) (BI newcbit) (QI isLreg) (HI 16bval))

               (set newcbit (not (sub-cflag fr w (not cbit))))

               (set dcbit (not (sub-dcflag fr w (not cbit))))

               (LregCheck isLreg (ifield f-reg))

               ;; If fr is an Lreg, then we have to do 16-bit arithmetic.

               ;; We can take advantage of the fact that by a lucky

               ;; coincidence, the address of register xxxH is always

               ;; one lower than the address of register xxxL.

               (if (eq isLreg #x1)

                  (sequence()

                     ; Create the 16 bit value

                     (set 16bval (reg h-spr (sub (ifield f-reg) 1)))

                     (set 16bval (sll 16bval 8))

                     (set 16bval (or 16bval (and (reg h-spr (ifield f-reg)) #xFF)))

                     ; New 16 bit instruction

                     (set 16bval (subc HI 16bval w (not cbit)))

                     ; Separate the 16 bit values into the H and L regs

                     (set (reg h-spr (ifield f-reg)) (and 16bval #xFF))

                     (set (reg h-spr (sub (ifield f-reg) 1))

                          (and (srl 16bval 8) #xFF))

                     (set result (reg h-spr (ifield f-reg)))

                  )

               ; Original instruction

               (set result (subc fr w (not cbit)))

               )

               (set zbit (zflag result))

               (set cbit newcbit)

               (set fr result))

     ()

)

(dni pop_fr "Pop fr"

     ()

     "pop $fr"

     (+ OP6_POP (f-dir 1) fr)

     (sequence()

        (set fr (c-call QI "pop"))

        (c-call VOID "adjuststackptr" (const 1))

     )

     ()

)

(dni push_fr "Push fr"

     ()

     "push $fr"

     (+ OP6_POP (f-dir 0) fr)

     (sequence()

        (c-call "push" fr)

        (c-call VOID "adjuststackptr" (const -1))

     )

     ()

)

(dni csew_fr "Skip if equal W,fr"

     ()

     "cse W,$fr"

     (+ OP6_CSE (f-dir 1) fr)

     (if (eq w fr)

         (skip 1))

     ()

)

(dni csnew_fr "Skip if not-equal W,fr"

     ()

     "csne W,$fr"

     (+ OP6_CSE (f-dir 0) fr)

     (if (not (eq w fr))

         (skip 1))

     ()

)

;;(dni csaw_fr "Skip if W above fr"

;;     ((MACH ip2022ext))

;;     "csa W,$fr"

;;     (+ OP6_CSAB (f-dir 1) fr)

;;     (if (gt w fr)

;;       (skip 1))

;;    ()

;;)

;;(dni csbw_fr "Skip if W below fr"

;;     ((MACH ip2022ext))

;;     "csb W,$fr"

;;     (+ OP6_CSAB (f-dir 0) fr)

;;     (if (lt w fr)

;;       (skip 1))

;;    ()

;;)

(dni incsz_fr "Skip if fr++ zero"

     ()

     "incsz $fr"

     (+ OP6_INCSZ DIR_NOTTO_W fr)

     (sequence ((QI isLreg) (HI 16bval))

          (LregCheck isLreg (ifield f-reg))

          ;; If fr is an Lreg, then we have to do 16-bit arithmetic.

          ;; We can take advantage of the fact that by a lucky

          ;; coincidence, the address of register xxxH is always

          ;; one lower than the address of register xxxL.

          (if (eq isLreg #x1)

             (sequence()

                ; Create the 16 bit value

                (set 16bval (reg h-spr (sub (ifield f-reg) 1)))

                (set 16bval (sll 16bval 8))

                (set 16bval (or 16bval (and (reg h-spr (ifield f-reg)) #xFF)))

                ; New 16 bit instruction

                (set 16bval (add HI 16bval 1))

                ; Separate the 16 bit values into the H and L regs

                (set (reg h-spr (ifield f-reg)) (and 16bval #xFF))

                (set (reg h-spr (sub (ifield f-reg) 1))

                     (and (srl 16bval 8) #xFF))

                (set fr (reg h-spr (ifield f-reg)))

             )

             ; Original instruction

             (set fr (add fr 1))

          )

               (if (zflag fr)

                   (skip 1)))

     ()

)

(dni incszw_fr "Skip if W=fr+1 zero"

     ()

     "incsz W,$fr"

     (+ OP6_INCSZ DIR_TO_W fr)

     (sequence ()

               (set w (add fr 1))

               (if (zflag w)

                   (skip 1)))

     ()

)

(dni swap_fr "Swap fr nibbles"

     ()

     "swap $fr"

     (+ OP6_SWAP DIR_NOTTO_W fr)

     (set fr (or (and (sll fr 4) #xf0)

                 (and (srl fr 4) #x0f)))

     ()

)

(dni swapw_fr "Swap fr nibbles into W"

     ()

     "swap W,$fr"

     (+ OP6_SWAP DIR_TO_W fr)

     (set w (or (and (sll fr 4) #xf0)

                (and (srl fr 4) #x0f)))

     ()

)

(dni rl_fr "Rotate fr left with carry"

     ()

     "rl $fr"

     (+ OP6_RL DIR_NOTTO_W fr)

     (sequence ((QI newfr) (BI newc))

               (set newc (and fr #x80))

               (set newfr (or (sll fr 1) (if QI cbit 1 0)))

               (set cbit (if QI newc 1 0))

               (set fr newfr))

     ()

)

(dni rlw_fr "Rotate fr left with carry into W"

     ()

     "rl W,$fr"

     (+ OP6_RL DIR_TO_W fr)

     (sequence ((QI newfr) (BI newc))

               (set newc (and fr #x80))

               (set newfr (or (sll fr 1) (if QI cbit 1 0)))

               (set cbit (if QI newc 1 0))

               (set w newfr))

     ()

)

(dni rr_fr "Rotate fr right with carry"

     ()

     "rr $fr"

     (+ OP6_RR DIR_NOTTO_W fr)

     (sequence ((QI newfr) (BI newc))

               (set newc (and fr #x01))

               (set newfr (or (srl fr 1) (if QI cbit #x80 #x00)))

               (set cbit (if QI newc 1 0))

               (set fr newfr))

     ()

)

(dni rrw_fr "Rotate fr right with carry into W"

     ()

     "rr W,$fr"

     (+ OP6_RR DIR_TO_W fr)

     (sequence ((QI newfr) (BI newc))

               (set newc (and fr #x01))

               (set newfr (or (srl fr 1) (if QI cbit #x80 #x00)))

               (set cbit (if QI newc 1 0))

               (set w newfr))

     ()

)

(dni decsz_fr "Skip if fr-- zero"

     ()