| ; 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" | 
 |      () | 
 |      "decsz $fr" | 
 |      (+ OP6_DECSZ 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 (zflag fr) | 
 | 		   (skip 1))) | 
 |      () | 
 | ) | 
 |  | 
 | (dni decszw_fr "Skip if W=fr-1 zero" | 
 |      () | 
 |      "decsz W,$fr" | 
 |      (+ OP6_DECSZ DIR_TO_W fr) | 
 |      (sequence () | 
 | 	       (set w (sub fr 1)) | 
 | 	       (if (zflag w) | 
 | 		   (skip 1))) | 
 |      () | 
 | ) | 
 |  | 
 | (dni inc_fr "Increment fr" | 
 |      () | 
 |      "inc $fr" | 
 |      (+ OP6_INC 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)) | 
 |            ) | 
 | 	       (set zbit (zflag fr))) | 
 |      () | 
 | ) | 
 |  | 
 | (dni incw_fr "Increment fr into w" | 
 |      () | 
 |      "inc W,$fr" | 
 |      (+ OP6_INC DIR_TO_W fr) | 
 |      (sequence () | 
 | 	       (set w (add fr 1)) | 
 | 	       (set zbit (zflag w))) | 
 |      () | 
 | ) | 
 |  | 
 | (dni not_fr "Invert fr" | 
 |      () | 
 |      "not $fr" | 
 |      (+ OP6_NOT DIR_NOTTO_W fr) | 
 |      (sequence () | 
 | 	       (set fr (inv fr)) | 
 | 	       (set zbit (zflag fr))) | 
 |      () | 
 | ) | 
 |  | 
 | (dni notw_fr "Invert fr into w" | 
 |      () | 
 |      "not W,$fr" | 
 |      (+ OP6_NOT DIR_TO_W fr) | 
 |      (sequence () | 
 | 	       (set w (inv fr)) | 
 | 	       (set zbit (zflag w))) | 
 |      () | 
 | ) | 
 |  | 
 | (dni test_fr "Test fr" | 
 |      () | 
 |      "test $fr" | 
 |      (+ OP6_TEST DIR_NOTTO_W fr) | 
 |      (sequence () | 
 | 	       (set zbit (zflag fr))) | 
 |      () | 
 | ) | 
 |  | 
 | (dni movw_l "MOV W,literal" | 
 |      () | 
 |      "mov W,#$lit8" | 
 |      (+ OP4_LITERAL OP4MID_MOV_L lit8) | 
 |      (set w lit8) | 
 |      () | 
 | ) | 
 |  | 
 | (dni movfr_w "Move/test w into fr" | 
 |      () | 
 |      "mov $fr,W" | 
 |      (+ OP6_OTHER1 DIR_NOTTO_W fr) | 
 |      (set fr w) | 
 |      () | 
 | ) | 
 |  | 
 | (dni movw_fr "Move/test fr into w" | 
 |      () | 
 |      "mov W,$fr" | 
 |      (+ OP6_TEST DIR_TO_W fr) | 
 |      (sequence () | 
 | 	       (set w fr) | 
 | 	       (set zbit (zflag w))) | 
 |      () | 
 | ) | 
 |  | 
 |  | 
 | (dni addfr_w "Add fr,W" | 
 |      () | 
 |      "add $fr,W" | 
 |      (+ OP6_ADD DIR_NOTTO_W fr) | 
 |      (sequence ((QI result) (QI isLreg) (HI 16bval)) | 
 | 	       (set cbit (add-cflag w fr 0)) | 
 | 	       (set dcbit (add-dcflag w fr 0)) | 
 |                (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() | 
 |                      (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 (add HI (and w #xFF) 16bval)) | 
 |                      (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 0)) ;; else part | 
 |                ) | 
 | 	       (set zbit (zflag result)) | 
 | 	       (set fr result)) | 
 |      () | 
 | ) | 
 |  | 
 | (dni addw_fr "Add W,fr" | 
 |      () | 
 |      "add W,$fr" | 
 |      (+ OP6_ADD DIR_TO_W fr) | 
 |      (sequence ((QI result)) | 
 | 	       (set cbit (add-cflag w fr 0)) | 
 | 	       (set dcbit (add-dcflag w fr 0)) | 
 | 	       (set result (addc w fr 0)) | 
 | 	       (set zbit (zflag result)) | 
 | 	       (set w result)) | 
 |      () | 
 | ) | 
 |  | 
 | (dni xorfr_w "XOR fr,W" | 
 |      () | 
 |      "xor $fr,W" | 
 |      (+ OP6_XOR DIR_NOTTO_W fr) | 
 |      (sequence () | 
 | 	       (set fr (xor w fr)) | 
 | 	       (set zbit (zflag fr))) | 
 |      () | 
 | ) | 
 |  | 
 | (dni xorw_fr "XOR W,fr" | 
 |      () | 
 |      "xor W,$fr" | 
 |      (+ OP6_XOR DIR_TO_W fr) | 
 |      (sequence () | 
 | 	       (set w (xor fr w)) | 
 | 	       (set zbit (zflag w))) | 
 |      () | 
 | ) | 
 |  | 
 | (dni andfr_w "AND fr,W" | 
 |      () | 
 |      "and $fr,W" | 
 |      (+ OP6_AND DIR_NOTTO_W fr) | 
 |      (sequence () | 
 | 	       (set fr (and w fr)) | 
 | 	       (set zbit (zflag fr))) | 
 |      () | 
 | ) | 
 |  | 
 | (dni andw_fr "AND W,fr" | 
 |      () | 
 |      "and W,$fr" | 
 |      (+ OP6_AND DIR_TO_W fr) | 
 |      (sequence () | 
 | 	       (set w (and fr w)) | 
 | 	       (set zbit (zflag w))) | 
 |      () | 
 | ) | 
 |  | 
 | (dni orfr_w "OR fr,W" | 
 |      () | 
 |      "or $fr,W" | 
 |      (+ OP6_OR DIR_NOTTO_W fr) | 
 |      (sequence () | 
 | 	       (set fr (or w fr)) | 
 | 	       (set zbit (zflag fr))) | 
 |      () | 
 | ) | 
 |  | 
 | (dni orw_fr "OR W,fr" | 
 |      () | 
 |      "or W,$fr" | 
 |      (+ OP6_OR DIR_TO_W fr) | 
 |      (sequence () | 
 | 	       (set w (or fr w)) | 
 | 	       (set zbit (zflag w))) | 
 |      () | 
 | ) | 
 |  | 
 | (dni dec_fr "Decrement fr" | 
 |      () | 
 |      "dec $fr" | 
 |      (+ OP6_DEC 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)) | 
 | 	  ) | 
 | 	     (set zbit (zflag fr))) | 
 |      () | 
 | ) | 
 |  | 
 | (dni decw_fr "Decrement fr into w" | 
 |      () | 
 |      "dec W,$fr" | 
 |      (+ OP6_DEC DIR_TO_W fr) | 
 |      (sequence () | 
 | 	       (set w (sub fr 1)) | 
 | 	       (set zbit (zflag w))) | 
 |      () | 
 | ) | 
 |  | 
 | (dni subfr_w "Sub fr,W" | 
 |      () | 
 |      "sub $fr,W" | 
 |      (+ OP6_SUB DIR_NOTTO_W fr) | 
 |      (sequence ((QI result) (QI isLreg) (HI 16bval)) | 
 | 	       (set cbit (not (sub-cflag fr w 0))) | 
 | 	       (set dcbit (not (sub-dcflag fr w 0))) | 
 |                (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 (and w #xFF))) | 
 |                      ; 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 0)) | 
 |                ) | 
 | 	       (set zbit (zflag result)) | 
 | 	       (set fr result)) | 
 |      () | 
 | ) | 
 |  | 
 | (dni subw_fr "Sub W,fr" | 
 |      () | 
 |      "sub W,$fr" | 
 |      (+ OP6_SUB DIR_TO_W fr) | 
 |      (sequence ((QI result)) | 
 | 	       (set cbit (not (sub-cflag fr w 0))) | 
 | 	       (set dcbit (not (sub-dcflag fr w 0))) | 
 | 	       (set result (subc fr w 0)) | 
 | 	       (set zbit (zflag result)) | 
 | 	       (set w result)) | 
 |      () | 
 | ) | 
 |  | 
 | (dni clr_fr "Clear fr" | 
 |      () | 
 |      "clr $fr" | 
 |      (+ OP6_OTHER2 (f-dir 1) fr) | 
 |      (sequence () | 
 | 	       (set fr 0) | 
 | 	       (set zbit (zflag fr))) | 
 |      () | 
 | ) | 
 |  | 
 | (dni cmpw_fr "CMP W,fr" | 
 |      () | 
 |      "cmp W,$fr" | 
 |      (+ OP6_OTHER2 (f-dir 0) fr) | 
 |      (sequence () | 
 | 	       (set cbit (not (sub-cflag fr w 0))) | 
 | 	       (set dcbit (not (sub-dcflag fr w 0))) | 
 | 	       (set zbit (zflag (sub w fr)))) | 
 |      () | 
 | ) | 
 |  | 
 | (dni speed "Set speed" | 
 |      () | 
 |      "speed #$lit8" | 
 |      (+ (f-op8 1) lit8) | 
 |      (set (reg h-registers #x0E) lit8) | 
 |      () | 
 | ) | 
 |  | 
 | (dni ireadi "Insn memory read with increment" | 
 |      () | 
 |      "ireadi" | 
 |      (+ OP6_OTHER1 (f-op6-10low #x1D)) | 
 |      (c-call "do_insn_read") | 
 |      () | 
 | ) | 
 |  | 
 | (dni iwritei "Insn memory write with increment" | 
 |      () | 
 |      "iwritei" | 
 |      (+ OP6_OTHER1 (f-op6-10low #x1C)) | 
 |      (c-call "do_insn_write") | 
 |      () | 
 | ) | 
 |  | 
 | (dni fread "Flash read" | 
 |      () | 
 |      "fread" | 
 |      (+ OP6_OTHER1 (f-op6-10low #x1B)) | 
 |      (c-call "do_flash_read") | 
 |      () | 
 | ) | 
 |  | 
 | (dni fwrite "Flash write" | 
 |      () | 
 |      "fwrite" | 
 |      (+ OP6_OTHER1 (f-op6-10low #x1A)) | 
 |      (c-call "do_flash_write") | 
 |      () | 
 | ) | 
 |  | 
 | (dni iread "Insn memory read" | 
 |      () | 
 |      "iread" | 
 |      (+ OP6_OTHER1 (f-op6-10low #x19)) | 
 |      (c-call "do_insn_read") | 
 |      () | 
 | ) | 
 |  | 
 | (dni iwrite "Insn memory write" | 
 |      () | 
 |      "iwrite" | 
 |      (+ OP6_OTHER1 (f-op6-10low #x18)) | 
 |      (c-call "do_insn_write") | 
 |      () | 
 | ) | 
 |  | 
 | (dni page "Set insn page" | 
 |      (EXT-SKIP-INSN) | 
 |      ;"page $page3" | 
 |      "page $addr16p" | 
 |      ;(+ OP6_OTHER1 (f-op6-7low #x2) page3) | 
 |      ;(set pabits (srl page3 13)) | 
 |      (+ OP6_OTHER1 (f-op6-7low #x2) addr16p) | 
 |      (set pabits addr16p) | 
 |      () | 
 | ) | 
 |  | 
 | (dni system "System call" | 
 |      () | 
 |      "system" | 
 |      (+ OP6_OTHER1 (f-op6-10low #xff)) | 
 |      (c-call "do_system") | 
 |      () | 
 | ) | 
 |  | 
 | (dni reti "Return from interrupt" | 
 |      () | 
 |      "reti #$reti3" | 
 |      (+ OP6_OTHER1 (f-op6-7low #x1) reti3) | 
 |      (c-call "do_reti" reti3) | 
 |      () | 
 | ) | 
 |  | 
 | (dni ret "Return" | 
 |      () | 
 |      "ret" | 
 |      (+ OP6_OTHER1 (f-op6-10low #x07)) | 
 |      (sequence ((USI new_pc)) | 
 | 	       (set new_pc (c-call UHI "pop_pc_stack")) | 
 | 	       (set pabits (srl new_pc 13)) | 
 | 	       (set pc new_pc)) | 
 |      () | 
 | ) | 
 |  | 
 | (dni int "Software interrupt" | 
 |      () | 
 |      "int" | 
 |      (+ OP6_OTHER1 (f-op6-10low #x6)) | 
 |      (nop) | 
 |      () | 
 | ) | 
 |  | 
 | (dni breakx "Breakpoint with extended skip" | 
 |      (EXT-SKIP-INSN) | 
 |      "breakx" | 
 |      (+ OP6_OTHER1 (f-op6-10low #x5)) | 
 |      (c-call "do_break" pc) | 
 |      () | 
 | ) | 
 |  | 
 | (dni cwdt "Clear watchdog timer" | 
 |      () | 
 |      "cwdt" | 
 |      (+ OP6_OTHER1 (f-op6-10low #x4)) | 
 |      (c-call "do_clear_wdt") | 
 |      () | 
 | ) | 
 |  | 
 | (dni ferase "Flash erase" | 
 |      () | 
 |      "ferase" | 
 |      (+ OP6_OTHER1 (f-op6-10low #x3)) | 
 |      (c-call "do_flash_erase") | 
 |      () | 
 | ) | 
 |  | 
 | (dni retnp "Return, no page" | 
 |      () | 
 |      "retnp" | 
 |      (+ OP6_OTHER1 (f-op6-10low #x2)) | 
 |      (sequence ((USI new_pc)) | 
 | 	       (set new_pc (c-call UHI "pop_pc_stack")) | 
 | 	       (set pc new_pc)) | 
 |      () | 
 | ) | 
 |  | 
 | (dni break "Breakpoint" | 
 |      () | 
 |      "break" | 
 |      (+ OP6_OTHER1 (f-op6-10low #x1)) | 
 |      (c-call "do_break" pc) | 
 |      () | 
 | ) | 
 |  | 
 | (dni nop "No operation" | 
 |      () | 
 |      "nop" | 
 |      (+ OP6_OTHER1 (f-op6-10low #x0)) | 
 |      (nop) | 
 |      () | 
 | ) | 
 | 			    | 
 |  | 
 | ; Macro instructions | 
 | (dnmi sc "Skip on carry" | 
 |       () | 
 |       "sc" | 
 |       (emit sb (bitno 0) (fr #xB)) ; sb status.0 | 
 | ) | 
 |  | 
 | (dnmi snc "Skip on no carry" | 
 |       () | 
 |       "snc" | 
 |       (emit snb (bitno 0) (fr #xB)) ; snb status.0 | 
 | ) | 
 |        | 
 | (dnmi sz "Skip on zero" | 
 |       () | 
 |       "sz" | 
 |       (emit sb (bitno 2) (fr #xB)) ; sb status.2 | 
 | ) | 
 |  | 
 | (dnmi snz "Skip on no zero" | 
 |       () | 
 |       "snz" | 
 |       (emit snb (bitno 2) (fr #xB)) ; snb status.2 | 
 | ) | 
 |  | 
 | (dnmi skip "Skip always" | 
 |       (SKIPA) | 
 |       "skip" | 
 |       (emit snb (bitno 0) (fr 9)) ; snb pcl.0 | (pcl&1)<<12 | 
 | ) | 
 |  | 
 | (dnmi skipb "Skip always" | 
 |       (SKIPA) | 
 |       "skip" | 
 |       (emit sb (bitno 0) (fr 9)) ; sb pcl.0 | (pcl&1)<<12 | 
 | ) | 
 |  |