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