; OpenRISC Basic Instruction Set 32-bit (ORBIS)  -*- Scheme -*-
; Copyright 2000-2014 Free Software Foundation, Inc.
; Contributed for OR32 by Johan Rydberg, jrydberg@opencores.org
; Modified by Julius Baxter, juliusbaxter@gmail.com
; Modified by Peter Gavin, pgavin@gmail.com
;
; 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, see <http://www.gnu.org/licenses/>

; Instruction fields.

; Hardware for immediate operands
(dnh h-simm16      "16-bit signed immediate"   ((MACH ORBIS-MACHS)) (immediate (INT 16)) () () ())
(dnh h-uimm16      "16-bit unsigned immediate" ()                   (immediate (UINT 16)) () () ())
(dnh h-uimm6       "6-bit unsigned immediate"  ()                   (immediate (UINT 6)) () () ())

; Hardware for the (internal) atomic registers
(dsh h-atomic-reserve "atomic reserve flag" () (register BI))
(dsh h-atomic-address "atomic reserve address" () (register SI))

; Instruction classes.
(dnf f-opcode      "insn opcode"               ((MACH ORBIS-MACHS)) 31 6)

; Register fields.
(dnf f-r1          "r1"                        ((MACH ORBIS-MACHS)) 25 5)
(dnf f-r2          "r2"                        ((MACH ORBIS-MACHS)) 20 5)
(dnf f-r3          "r3"                        ((MACH ORBIS-MACHS)) 15 5)

; Sub fields
(dnf f-op-25-2     "op-25-2"                   ((MACH ORBIS-MACHS)) 25 2) ;; nop
(dnf f-op-25-5     "op-25-5"                   ((MACH ORBIS-MACHS)) 25 5) ;; sys, trap, *sync, sf*
(dnf f-op-16-1     "op-16-1"                   ((MACH ORBIS-MACHS)) 16 1) ;; movhi,macrc
(dnf f-op-7-4      "op-7-4"                    ((MACH ORBIS-MACHS)) 7 4)
(dnf f-op-3-4      "op-3-4"                    ((MACH ORBIS-MACHS)) 3 4)
(dnf f-op-9-2      "op-9-2"                    ((MACH ORBIS-MACHS)) 9 2) ;; alu ops upper opcode
(dnf f-op-9-4      "op-9-4"                    ((MACH ORBIS-MACHS)) 9 4) ;;
(dnf f-op-7-8      "op-7-8"                    ((MACH ORBIS-MACHS)) 7 8)
(dnf f-op-7-2      "op-7-2"                    ((MACH ORBIS-MACHS)) 7 2) ;; alu lower upper opc,shroti

; Reserved fields
(dnf f-resv-25-26  "resv-25-26"                ((MACH ORBIS-MACHS) RESERVED) 25 26)
(dnf f-resv-25-10  "resv-25-10"                ((MACH ORBIS-MACHS) RESERVED) 25 10)
(dnf f-resv-25-5   "resv-25-5"                 ((MACH ORBIS-MACHS) RESERVED) 25 5)
(dnf f-resv-23-8   "resv-23-8"                 ((MACH ORBIS-MACHS) RESERVED) 23 8)
(dnf f-resv-20-5   "resv-20-5"                 ((MACH ORBIS-MACHS) RESERVED) 20 5)
(dnf f-resv-20-4   "resv-20-4"                 ((MACH ORBIS-MACHS) RESERVED) 20 4)
(dnf f-resv-15-8   "resv-15-8"                 ((MACH ORBIS-MACHS) RESERVED) 15 8)
(dnf f-resv-15-6   "resv-15-6"                 ((MACH ORBIS-MACHS) RESERVED) 15 6)
(dnf f-resv-10-11  "resv-10-11"                ((MACH ORBIS-MACHS) RESERVED) 10 11)
(dnf f-resv-10-7   "resv-10-7"                 ((MACH ORBIS-MACHS) RESERVED) 10 7)
(dnf f-resv-10-3   "resv-10-3"                 ((MACH ORBIS-MACHS) RESERVED) 10 3)
(dnf f-resv-10-1   "resv-10-1"                 ((MACH ORBIS-MACHS) RESERVED) 10 1)
(dnf f-resv-7-4    "resv-7-4"                  ((MACH ORBIS-MACHS) RESERVED) 7 4)
(dnf f-resv-5-2    "resv-5-2"                  ((MACH ORBIS-MACHS) RESERVED) 5 2)

(dnf f-imm16-25-5  "imm16-25-5"                ((MACH ORBIS-MACHS)) 25  5)
(dnf f-imm16-10-11 "imm16-10-11"               ((MACH ORBIS-MACHS)) 10 11)

; PC relative, 26-bit (2 shifted to right)
(df f-disp26
    "disp26"
    ((MACH ORBIS-MACHS) PCREL-ADDR)
    25
    26
    INT
    ((value pc) (sra SI (sub IAI value pc) (const 2)))
    ((value pc) (add IAI (sll IAI value (const 2)) pc))
    )

; Immediates.
(dnf f-uimm16    "uimm16"                      ((MACH ORBIS-MACHS))          15 16)
(df  f-simm16    "simm16"                      ((MACH ORBIS-MACHS) SIGN-OPT) 15 16 INT #f #f)
(dnf f-uimm6     "uimm6"                       ((MACH ORBIS-MACHS))          5  6) ;; shroti

(define-multi-ifield
  (name f-uimm16-split)
  (comment "16-bit split unsigned immediate")
  (attrs (MACH ORBIS-MACHS))
  (mode UINT)
  (subfields f-imm16-25-5 f-imm16-10-11)
  (insert (sequence ()
                    (set (ifield f-imm16-25-5)
                         (and (srl (ifield f-uimm16-split)
                                   (const 11))
                              (const #x1f)))
                    (set (ifield f-imm16-10-11)
                         (and (ifield f-uimm16-split)
                              (const #x7ff)))))
  (extract 
           (set (ifield f-uimm16-split)
                (trunc UHI
                       (or (sll (ifield f-imm16-25-5)
                                (const 11))
                           (ifield f-imm16-10-11)))))
  )

(define-multi-ifield
  (name f-simm16-split)
  (comment "16-bit split signed immediate")
  (attrs (MACH ORBIS-MACHS) SIGN-OPT)
  (mode INT)
  (subfields f-imm16-25-5 f-imm16-10-11)
  (insert (sequence ()
                    (set (ifield f-imm16-25-5)
                         (and (sra (ifield f-simm16-split)
                                   (const 11))
                              (const #x1f)))
                    (set (ifield f-imm16-10-11)
                         (and (ifield f-simm16-split)
                              (const #x7ff)))))
  (extract 
           (set (ifield f-simm16-split)
                (trunc HI
                       (or (sll (ifield f-imm16-25-5)
                                (const 11))
                           (ifield f-imm16-10-11)))))
  )

; Enums.

; insn-opcode: bits 31-26
(define-normal-insn-enum 
  insn-opcode "insn main opcode enums" ((MACH ORBIS-MACHS)) OPC_ f-opcode
  (("J"            #x00)
   ("JAL"          #x01)
   ("BNF"          #x03)
   ("BF"           #x04)
   ("NOP"          #x05)
   ("MOVHIMACRC"   #x06)
   ("SYSTRAPSYNCS" #x08)
   ("RFE"          #x09)
   ("VECTOR"       #x0a)
   ("JR"           #x11)
   ("JALR"         #x12)
   ("MACI"         #x13)
   ("LWA"          #x1b)
   ("CUST1"        #x1c)
   ("CUST2"        #x1d)
   ("CUST3"        #x1e)
   ("CUST4"        #x1f)
   ("LD"           #x20)
   ("LWZ"          #x21)
   ("LWS"          #x22)
   ("LBZ"          #x23)
   ("LBS"          #x24)
   ("LHZ"          #x25)
   ("LHS"          #x26)
   ("ADDI"         #x27)
   ("ADDIC"        #x28)
   ("ANDI"         #x29)
   ("ORI"          #x2a)
   ("XORI"         #x2b)
   ("MULI"         #x2c)
   ("MFSPR"        #x2d)
   ("SHROTI"       #x2e)
   ("SFI"          #x2f)
   ("MTSPR"        #x30)
   ("MAC"          #x31)
   ("FLOAT"        #x32)
   ("SWA"          #x33)
   ("SD"           #x34)
   ("SW"           #x35)
   ("SB"           #x36)
   ("SH"           #x37)
   ("ALU"          #x38)
   ("SF"           #x39)
   ("CUST5"        #x3c)
   ("CUST6"        #x3d)
   ("CUST7"        #x3e)
   ("CUST8"        #x3f) 
  )
)

(define-normal-insn-enum insn-opcode-systrapsyncs 
  "systrapsync insn opcode enums" ((MACH ORBIS-MACHS)) 
  OPC_SYSTRAPSYNCS_ f-op-25-5
    (("SYSCALL" #x00 )
     ("TRAP" #x08 )
     ("MSYNC" #x10 )
     ("PSYNC" #x14 )
     ("CSYNC" #x18 )
    )
)

(define-normal-insn-enum insn-opcode-movehimacrc
  "movhi/macrc insn opcode enums" ((MACH ORBIS-MACHS))
  OPC_MOVHIMACRC_ f-op-16-1
  (("MOVHI" #x0)
   ("MACRC" #x1)
  )
)

(define-normal-insn-enum insn-opcode-mac
  "multiply/accumulate insn opcode enums" ((MACH ORBIS-MACHS))
  OPC_MAC_ f-op-3-4
  (("MAC" #x1)
   ("MSB" #x2)
   )
  )

(define-normal-insn-enum insn-opcode-shorts 
  "shift/rotate insn opcode enums" ((MACH ORBIS-MACHS))
  OPC_SHROTS_ f-op-7-2
    (("SLL" #x0 )
     ("SRL" #x1 )
     ("SRA" #x2 )
     ("ROR" #x3 )
    )
)

(define-normal-insn-enum insn-opcode-extbhs
  "extend byte/half opcode enums" ((MACH ORBIS-MACHS))
  OPC_EXTBHS_ f-op-9-4
  (("EXTHS" #x0)
   ("EXTBS" #x1)
   ("EXTHZ" #x2)
   ("EXTBZ" #x3)
   )
)

(define-normal-insn-enum insn-opcode-extws
  "extend word opcode enums" ((MACH ORBIS-MACHS))
  OPC_EXTWS_ f-op-9-4
  (("EXTWS" #x0)
   ("EXTWZ" #x1)
   )
)

(define-normal-insn-enum insn-opcode-alu-regreg 
  "alu reg/reg insn opcode enums" ((MACH ORBIS-MACHS))
  OPC_ALU_REGREG_ f-op-3-4
  (("ADD"   #x0)
   ("ADDC"  #x1)
   ("SUB"   #x2)
   ("AND"   #x3)
   ("OR"    #x4)
   ("XOR"   #x5)
   ("MUL"   #x6)
   ("SHROT" #x8)
   ("DIV"   #x9)
   ("DIVU"  #xA)
   ("MULU"  #xB)
   ("EXTBH" #xC)
   ("EXTW"  #xD)
   ("CMOV"  #xE)
   ("FFL1"  #xF)
   )
)

(define-normal-insn-enum insn-opcode-setflag
  "setflag insn opcode enums" ((MACH ORBIS-MACHS))
  OPC_SF_ f-op-25-5
    (("EQ"  #x00)
     ("NE"  #x01)
     ("GTU" #x02)
     ("GEU" #x03)
     ("LTU" #x04)
     ("LEU" #x05)
     ("GTS" #x0A)
     ("GES" #x0B)
     ("LTS" #x0C)
     ("LES" #x0D)
    )
)


; Instruction operands.

(dnop sys-sr            "supervision register"             ((MACH ORBIS-MACHS) SEM-ONLY) h-sys-sr            f-nil)
(dnop sys-esr0          "exception supervision register 0" ((MACH ORBIS-MACHS) SEM-ONLY) h-sys-esr0          f-nil)
(dnop sys-epcr0         "exception PC register 0"          ((MACH ORBIS-MACHS) SEM-ONLY) h-sys-epcr0         f-nil)

(dnop sys-sr-lee        "SR little endian enable bit"      ((MACH ORBIS-MACHS) SEM-ONLY) h-sys-sr-lee        f-nil)
(dnop sys-sr-f          "SR flag bit"                      ((MACH ORBIS-MACHS) SEM-ONLY) h-sys-sr-f          f-nil)
(dnop sys-sr-cy         "SR carry bit"                     ((MACH ORBIS-MACHS) SEM-ONLY) h-sys-sr-cy         f-nil)
(dnop sys-sr-ov         "SR overflow bit"                  ((MACH ORBIS-MACHS) SEM-ONLY) h-sys-sr-ov         f-nil)
(dnop sys-sr-ove        "SR overflow exception enable bit" ((MACH ORBIS-MACHS) SEM-ONLY) h-sys-sr-ove        f-nil)
(dnop sys-cpucfgr-ob64s "CPUCFGR ORBIS64 supported bit"    ((MACH ORBIS-MACHS) SEM-ONLY) h-sys-cpucfgr-ob64s f-nil)
(dnop sys-cpucfgr-nd    "CPUCFGR no delay bit"             ((MACH ORBIS-MACHS) SEM-ONLY) h-sys-cpucfgr-nd    f-nil)
(dnop sys-fpcsr-rm      "floating point round mode"        ((MACH ORBIS-MACHS) SEM-ONLY) h-sys-fpcsr-rm      f-nil)

(dnop mac-machi         "MAC HI result register"           ((MACH ORBIS-MACHS) SEM-ONLY) h-mac-machi         f-nil)
(dnop mac-maclo         "MAC LO result register"           ((MACH ORBIS-MACHS) SEM-ONLY) h-mac-maclo         f-nil)

(dnop atomic-reserve    "atomic reserve flag"              ((MACH ORBIS-MACHS) SEM-ONLY) h-atomic-reserve    f-nil)
(dnop atomic-address    "atomic address"                   ((MACH ORBIS-MACHS) SEM-ONLY) h-atomic-address    f-nil)

(dnop uimm6             "uimm6"                            ((MACH ORBIS-MACHS))          h-uimm6             f-uimm6)

(dnop rD                "destination register"             ((MACH ORBIS-MACHS))          h-gpr               f-r1)
(dnop rA                "source register A"                ((MACH ORBIS-MACHS))          h-gpr               f-r2)
(dnop rB                "source register B"                ((MACH ORBIS-MACHS))          h-gpr               f-r3)

(define-operand
  (name disp26)
  (comment "pc-rel 26 bit")
  (attrs (MACH ORBIS-MACHS))
  (type h-iaddr)
  (index f-disp26)
  (handlers (parse "disp26"))
  )

(define-operand
  (name simm16)
  (comment "16-bit signed immediate")
  (attrs (MACH ORBIS-MACHS) SIGN-OPT)
  (type h-simm16)
  (index f-simm16)
  (handlers (parse "simm16"))
  )

(define-operand
  (name uimm16)
  (comment "16-bit unsigned immediate")
  (attrs (MACH ORBIS-MACHS))
  (type h-uimm16)
  (index f-uimm16)
  (handlers (parse "uimm16"))
  )

(define-operand
  (name simm16-split)
  (comment "split 16-bit signed immediate")
  (attrs (MACH ORBIS-MACHS) SIGN-OPT)
  (type h-simm16)
  (index f-simm16-split)
  (handlers (parse "simm16"))
)

(define-operand
  (name uimm16-split)
  (comment "split 16-bit unsigned immediate")
  (attrs (MACH ORBIS-MACHS))
  (type h-uimm16)
  (index f-uimm16-split)
  (handlers (parse "uimm16"))
)

; Instructions.

; Branch releated instructions 

(define-pmacro (cti-link-return)
  (set IAI (reg h-gpr 9) (add pc (if sys-cpucfgr-nd 4 8)))
  )
(define-pmacro (cti-transfer-control condition target)
  ;; this mess is necessary because we're
  ;; skipping the delay slot, but it's
  ;; actually the start of the next basic
  ;; block
  (sequence ()
            (if condition
                (delay 1 (set IAI pc target))
                (if sys-cpucfgr-nd
                    (delay 1 (set IAI pc (add pc 4))))
                )
            (if sys-cpucfgr-nd
                (skip 1)
                )
            )
  )

(define-pmacro
  (define-cti
    cti-name
    cti-comment
    cti-attrs
    cti-syntax
    cti-format
    cti-semantics)
  (begin
    (dni
      cti-name
      cti-comment
      (.splice (MACH ORBIS-MACHS) DELAYED-CTI NOT-IN-DELAY-SLOT (.unsplice cti-attrs))
      cti-syntax
      cti-format
      (cti-semantics)
      ()
      )
    )
  )

(define-cti
  l-j
  "jump (pc-relative iaddr)"
  (!COND-CTI UNCOND-CTI)
  "l.j ${disp26}"
  (+ OPC_J disp26)
  (.pmacro ()
           (cti-transfer-control 1 disp26)
           )
  )

(define-cti
  l-jal
  "jump and link (pc-relative iaddr)"
  (!COND-CTI UNCOND-CTI)
  "l.jal ${disp26}"
  (+ OPC_JAL disp26)
  (.pmacro ()
           (sequence ()
                     (cti-link-return)
                     (cti-transfer-control 1 disp26)
                     )
           )
  )

(define-cti
  l-jr
  "jump register (absolute iaddr)"
  (!COND-CTI UNCOND-CTI)
  "l.jr $rB"
  (+ OPC_JR (f-resv-25-10 0) rB (f-resv-10-11 0))
  (.pmacro ()
           (cti-transfer-control 1 rB)
           )
  )

(define-cti
  l-jalr
  "jump register and link (absolute iaddr)"
  (!COND-CTI UNCOND-CTI)
  "l.jalr $rB"
  (+ OPC_JALR (f-resv-25-10 0) rB (f-resv-10-11 0) )
  (.pmacro ()
           (sequence ()
                     (cti-link-return)
                     (cti-transfer-control 1 rB)
                     )
           )
  )

(define-cti
  l-bnf
  "branch if condition bit not set (pc relative iaddr)"
  (COND-CTI !UNCOND-CTI)
  "l.bnf ${disp26}"
  (+ OPC_BNF disp26)
  (.pmacro ()
           (cti-transfer-control (not sys-sr-f) disp26)
           )
  )

(define-cti
  l-bf
  "branch if condition bit set (pc relative iaddr)"
  (COND-CTI !UNCOND-CTI)
  "l.bf ${disp26}"
  (+ OPC_BF disp26)
  (.pmacro ()
           (cti-transfer-control sys-sr-f disp26)
           )
  )

(dni l-trap "trap (exception)"
     ((MACH ORBIS-MACHS) NOT-IN-DELAY-SLOT)
     "l.trap ${uimm16}"
     (+ OPC_SYSTRAPSYNCS OPC_SYSTRAPSYNCS_TRAP (f-resv-20-5 0) uimm16)
     ; Do exception entry handling in C function, PC set based on SR state
     (raise-exception EXCEPT-TRAP)
     ()
)


(dni l-sys "syscall (exception)"
     ; This function may not be in delay slot
     ((MACH ORBIS-MACHS) NOT-IN-DELAY-SLOT)

     "l.sys ${uimm16}"
     (+ OPC_SYSTRAPSYNCS OPC_SYSTRAPSYNCS_SYSCALL (f-resv-20-5 0) uimm16)
     ; Do exception entry handling in C function, PC set based on SR state
     (raise-exception EXCEPT-SYSCALL)
     ()
)


(dni l-rfe "return from exception"
     ; This function may not be in delay slot
     ((MACH ORBIS-MACHS) NOT-IN-DELAY-SLOT FORCED-CTI)

     "l.rfe"
     (+ OPC_RFE (f-resv-25-26 0))
     (c-call VOID "@cpu@_rfe")
     ()
)


; Misc instructions

; l.nop with immediate must be first so it handles all l.nops in sim
(dni l-nop-imm "nop uimm16"
     ((MACH ORBIS-MACHS))
     "l.nop ${uimm16}"
     (+ OPC_NOP (f-op-25-2 #x1) (f-resv-23-8 0) uimm16)
     (c-call VOID "@cpu@_nop" (zext UWI uimm16))
     ()
     )

(if (application-is? SIMULATOR)
    (begin)
    (begin
      (dni l-nop "nop"
           ((MACH ORBIS-MACHS))
           "l.nop"
           (+ OPC_NOP (f-op-25-2 #x1) (f-resv-23-8 0) uimm16)
           (nop)
           ()
           )
      )
)

(dni l-movhi "movhi reg/uimm16"
     ((MACH ORBIS-MACHS))
     "l.movhi $rD,$uimm16"
     (+ OPC_MOVHIMACRC rD (f-resv-20-4 0) OPC_MOVHIMACRC_MOVHI uimm16)
     (set UWI rD (sll UWI (zext UWI uimm16) (const 16)))
     ()
)

(dni l-macrc "macrc reg"
     ((MACH ORBIS-MACHS))
     "l.macrc $rD"
     (+ OPC_MOVHIMACRC rD (f-resv-20-4 0) OPC_MOVHIMACRC_MACRC (f-uimm16 0))
     (sequence ()
               (set UWI rD mac-maclo)
               (set UWI mac-maclo 0)
               (set UWI mac-machi 0)
               )
     ()
     )


; System releated instructions

(dni l-mfspr "mfspr"
     ((MACH ORBIS-MACHS))
     "l.mfspr $rD,$rA,${uimm16}"
     (+ OPC_MFSPR rD rA uimm16)
     (set UWI rD (c-call UWI "@cpu@_mfspr" (or rA (zext UWI uimm16))))
     ()
)

(dni l-mtspr "mtspr"
     ((MACH ORBIS-MACHS))
     "l.mtspr $rA,$rB,${uimm16-split}"
     (+ OPC_MTSPR rA rB uimm16-split )
     (c-call VOID "@cpu@_mtspr" (or rA (zext WI uimm16-split)) rB)
     ()
)


; Load instructions
(define-pmacro (load-store-addr base offset size)
  (c-call AI "@cpu@_make_load_store_addr" base (ext SI offset) size))

(dni l-lwz "l.lwz reg/simm16(reg)"
     ((MACH ORBIS-MACHS))
     "l.lwz $rD,${simm16}($rA)"
     (+ OPC_LWZ rD rA simm16)
     (set UWI rD (zext UWI (mem USI (load-store-addr rA simm16 4))))
     ()
)


(dni l-lws "l.lws reg/simm16(reg)"
     ((MACH ORBIS-MACHS))
     "l.lws $rD,${simm16}($rA)"
     (+ OPC_LWS rD rA simm16)
     (set WI rD (ext WI (mem SI (load-store-addr rA simm16 4))))
     ()
)

(dni l-lwa "l.lwa reg/simm16(reg)"
     ((MACH ORBIS-MACHS))
     "l.lwa $rD,${simm16}($rA)"
     (+ OPC_LWA rD rA simm16)
     (sequence ()
               (set UWI rD (zext UWI (mem USI (load-store-addr rA simm16 4))))
               (set atomic-reserve (const 1))
               (set atomic-address (load-store-addr rA simm16 4))
               )
     ()
)

(dni l-lbz "l.lbz reg/simm16(reg)"
     ((MACH ORBIS-MACHS))
     "l.lbz $rD,${simm16}($rA)"
     (+ OPC_LBZ rD rA simm16)
     (set UWI rD (zext UWI (mem UQI (load-store-addr rA simm16 1))))
     ()
)

(dni l-lbs "l.lbs reg/simm16(reg)"
     ((MACH ORBIS-MACHS))
     "l.lbs $rD,${simm16}($rA)"
     (+ OPC_LBS rD rA simm16)
     (set WI rD (ext WI (mem QI (load-store-addr rA simm16 1))))
     ()
)

(dni l-lhz "l.lhz reg/simm16(reg)"
     ((MACH ORBIS-MACHS))
     "l.lhz $rD,${simm16}($rA)"
     (+ OPC_LHZ rD simm16 rA)
     (set UWI rD (zext UWI (mem UHI (load-store-addr rA simm16 2))))
     ()
)

(dni l-lhs "l.lhs reg/simm16(reg)"
     ((MACH ORBIS-MACHS))
     "l.lhs $rD,${simm16}($rA)"
     (+ OPC_LHS rD rA simm16)
     (set WI rD (ext WI (mem HI (load-store-addr rA simm16 2))))
     ()
)


; Store instructions

(define-pmacro (store-insn mnemonic opc-op mode size)
  (begin
     (dni (.sym l- mnemonic)
          (.str "l." mnemonic " simm16(reg)/reg")
          ((MACH ORBIS-MACHS))
          (.str "l." mnemonic " ${simm16-split}($rA),$rB")
          (+ opc-op rA rB simm16-split)
          (sequence ((SI addr))
		    (set addr (load-store-addr rA simm16-split size))
		    (set mode (mem mode addr) (trunc mode rB))
		    (if (eq (and addr #xffffffc) atomic-address)
			(set atomic-reserve (const 0))
			)
                    )
          ()
     )
   )
)

(store-insn sw OPC_SW USI 4)
(store-insn sb OPC_SB UQI 1)
(store-insn sh OPC_SH UHI 2)

(dni l-swa "l.swa simm16(reg)/reg"
     ((MACH ORBIS-MACHS))
     "l.swa ${simm16-split}($rA),$rB"
     (+ OPC_SWA rA rB simm16)
     (sequence ((SI addr) (BI flag))
	       (set addr (load-store-addr rA simm16-split 4))
	       (set sys-sr-f (and atomic-reserve (eq addr atomic-address)))
	       (if sys-sr-f
		   (set USI (mem USI addr) (trunc USI rB))
		   )
	       (set atomic-reserve (const 0))
	       )
     ()
)


; Shift and rotate instructions

(define-pmacro (shift-insn mnemonic)
  (begin
     (dni (.sym l- mnemonic)
          (.str "l." mnemonic " reg/reg/reg")
          ((MACH ORBIS-MACHS))
          (.str "l." mnemonic " $rD,$rA,$rB")
          (+ OPC_ALU rD rA rB (f-resv-10-3 0) (.sym OPC_SHROTS_ (.upcase mnemonic)) (f-resv-5-2 0) 
	     OPC_ALU_REGREG_SHROT )
          (set UWI rD (mnemonic rA rB))
          ()
     )
     (dni (.sym l- mnemonic "i")
          (.str "l." mnemonic " reg/reg/uimm6")
          ((MACH ORBIS-MACHS))
          (.str "l." mnemonic "i $rD,$rA,${uimm6}")
          (+ OPC_SHROTI rD rA (f-resv-15-8 0) (.sym OPC_SHROTS_ (.upcase mnemonic)) uimm6)
          (set rD (mnemonic rA uimm6))
          ()
     )
   )
)

(shift-insn sll)
(shift-insn srl)
(shift-insn sra)
(shift-insn ror)


; Arithmetic insns

; ALU op macro
(define-pmacro (alu-insn mnemonic)
  (begin
     (dni (.sym l- mnemonic)
          (.str "l." mnemonic " reg/reg/reg")
          ((MACH ORBIS-MACHS))
          (.str "l." mnemonic " $rD,$rA,$rB")
          (+ OPC_ALU rD rA rB (f-resv-10-7 0) (.sym OPC_ALU_REGREG_ (.upcase mnemonic)))
          (set rD (mnemonic rA rB))
          ()
     )
  )
)

(alu-insn and)
(alu-insn or)
(alu-insn xor)

(define-pmacro (alu-carry-insn mnemonic)
  (begin
    (dni (.sym l- mnemonic)
         (.str "l." mnemonic " reg/reg/reg")
         ((MACH ORBIS-MACHS))
         (.str "l." mnemonic " $rD,$rA,$rB")
         (+ OPC_ALU rD rA rB (f-resv-10-7 #x00) (.sym OPC_ALU_REGREG_ (.upcase mnemonic)))
         (sequence ()
                   (sequence ()
                             (set BI sys-sr-cy ((.sym mnemonic "c-cflag") WI rA rB 0))
                             (set BI sys-sr-ov ((.sym mnemonic "c-oflag") WI rA rB 0))
                             (set rD (mnemonic WI rA rB))
                             )
                   (if (andif sys-sr-ov sys-sr-ove)
                       (raise-exception EXCEPT-RANGE))
                   )
         ()
         )
    )
  )

(alu-carry-insn add)
(alu-carry-insn sub)

(dni (l-addc) "l.addc reg/reg/reg"
          ((MACH ORBIS-MACHS))
          ("l.addc $rD,$rA,$rB")
          (+ OPC_ALU rD rA rB (f-resv-10-7 #x00) OPC_ALU_REGREG_ADDC)
          (sequence ()
                    (sequence ((BI tmp-sys-sr-cy))
                              (set BI tmp-sys-sr-cy sys-sr-cy)
                              (set BI sys-sr-cy (addc-cflag WI rA rB tmp-sys-sr-cy))
                              (set BI sys-sr-ov (addc-oflag WI rA rB tmp-sys-sr-cy))
                              (set rD (addc WI rA rB tmp-sys-sr-cy))
                              )
                   (if (andif sys-sr-ov sys-sr-ove)
                       (raise-exception EXCEPT-RANGE))
                   )
          ()
)

(dni (l-mul) "l.mul reg/reg/reg"
          ((MACH ORBIS-MACHS))
          ("l.mul $rD,$rA,$rB")
          (+ OPC_ALU rD rA rB (f-resv-10-7 #x30) OPC_ALU_REGREG_MUL)
          (sequence ()
                    (sequence ()
                              ; 2's complement overflow
                              (set BI sys-sr-ov (mul-o2flag WI rA rB))
                              ; 1's complement overflow
                              (set BI sys-sr-cy (mul-o1flag WI rA rB))
                              (set rD (mul WI rA rB))
                              )
                    (if (andif sys-sr-ov sys-sr-ove)
                        (raise-exception EXCEPT-RANGE))
                    )
          ()
)

(dni (l-mulu) "l.mulu reg/reg/reg"
          ((MACH ORBIS-MACHS))
          ("l.mulu $rD,$rA,$rB")
          (+ OPC_ALU rD rA rB (f-resv-10-7 #x30) OPC_ALU_REGREG_MULU)
          (sequence ()
                    (sequence ()
                              ; 2's complement overflow
                              (set BI sys-sr-ov 0)
                              ; 1's complement overflow
                              (set BI sys-sr-cy (mul-o1flag UWI rA rB))
                              (set rD (mul UWI rA rB))
                              )
                    (if (andif sys-sr-ov sys-sr-ove)
                        (raise-exception EXCEPT-RANGE))
                    )
          ()
)

(dni l-div "divide (signed)"
          ((MACH ORBIS-MACHS))
          "l.div $rD,$rA,$rB"
          (+ OPC_ALU rD rA rB (f-resv-10-7 #x30) OPC_ALU_REGREG_DIV)
          (sequence ()
                    (if (ne rB 0)
                        (sequence ()
                                  (set BI sys-sr-cy 0)
                                  (set WI rD (div WI rA rB))
                                  )
                        (set BI sys-sr-cy 1)
                        )
                    (set BI sys-sr-ov 0)
                    (if (andif sys-sr-cy sys-sr-ove)
                        (raise-exception EXCEPT-RANGE))
                    )
          ()
)

(dni l-divu "divide (unsigned)"
          ((MACH ORBIS-MACHS))
          "l.divu $rD,$rA,$rB"
          (+ OPC_ALU rD rA rB (f-resv-10-7 #x30) OPC_ALU_REGREG_DIVU)
          (sequence ()
                    (if (ne rB 0)
                        (sequence ()
                                  (set BI sys-sr-cy 0)
                                  (set rD (udiv UWI rA rB))
                                  )
                        (set BI sys-sr-cy 1)
                        )
                    (set BI sys-sr-ov 0)
                    (if (andif sys-sr-cy sys-sr-ove)
                        (raise-exception EXCEPT-RANGE))
                    )
          ()
)

(dni l-ff1 "find first '1'"
          ((MACH ORBIS-MACHS))
          "l.ff1 $rD,$rA"
          (+ OPC_ALU rD rA rB (f-resv-10-7 #x00) OPC_ALU_REGREG_FFL1)
          (set rD (c-call UWI "@cpu@_ff1" rA))
          ()
)

(dni l-fl1 "find last '1'"
          ((MACH ORBIS-MACHS))
          "l.fl1 $rD,$rA"
          (+ OPC_ALU rD rA rB (f-resv-10-7 #x10) OPC_ALU_REGREG_FFL1)
          (set rD (c-call UWI "@cpu@_fl1" rA))
          ()
)


(define-pmacro (alu-insn-simm  mnemonic)
  (begin
      (dni (.sym l- mnemonic "i")
          (.str "l." mnemonic " reg/reg/simm16")
          ((MACH ORBIS-MACHS))
          (.str "l." mnemonic "i $rD,$rA,$simm16")
          (+ (.sym OPC_ (.upcase mnemonic) "I") rD rA simm16)
          (set rD (mnemonic rA (ext WI simm16)))
          ()
     )
   )
)

(define-pmacro (alu-insn-uimm  mnemonic)
  (begin
      (dni (.sym l- mnemonic "i")
          (.str "l." mnemonic " reg/reg/uimm16")
          ((MACH ORBIS-MACHS))
          (.str "l." mnemonic "i $rD,$rA,$uimm16")
          (+ (.sym OPC_ (.upcase mnemonic) "I") rD rA uimm16)
          (set rD (mnemonic rA (zext UWI uimm16)))
          ()
     )
   )
)

(alu-insn-uimm and)
(alu-insn-uimm or)
(alu-insn-simm xor)

(define-pmacro (alu-carry-insn-simm mnemonic)
  (begin
    (dni (.sym l- mnemonic "i")
         (.str "l." mnemonic "i reg/reg/simm16")
         ((MACH ORBIS-MACHS))
         (.str "l." mnemonic "i $rD,$rA,$simm16")
         (+ (.sym OPC_ (.upcase mnemonic) "I") rD rA simm16)
         (sequence ()
                   (sequence ()
                             (set BI sys-sr-cy ((.sym mnemonic "c-cflag") WI rA (ext WI simm16) 0))
                             (set BI sys-sr-ov ((.sym mnemonic "c-oflag") WI rA (ext WI simm16) 0))
                             (set rD (mnemonic WI rA (ext WI simm16)))
                             )
                   (if (andif sys-sr-ov sys-sr-ove)
                       (raise-exception EXCEPT-RANGE))
                   )
         ()
         )
    )
  )

(alu-carry-insn-simm add)

(dni (l-addic)
     ("l.addic reg/reg/simm16")
     ((MACH ORBIS-MACHS))
     ("l.addic $rD,$rA,$simm16")
     (+ OPC_ADDIC rD rA simm16)
     (sequence ()
               (sequence ((BI tmp-sys-sr-cy))
                         (set BI tmp-sys-sr-cy sys-sr-cy)
                         (set BI sys-sr-cy (addc-cflag WI rA (ext WI simm16) tmp-sys-sr-cy))
                         (set BI sys-sr-ov (addc-oflag WI rA (ext WI simm16) tmp-sys-sr-cy))
                         (set WI rD (addc WI rA (ext WI simm16) tmp-sys-sr-cy))
                         )
               (if (andif sys-sr-ov sys-sr-ove)
                   (raise-exception EXCEPT-RANGE))
               )
     ()
)

(dni (l-muli)
     "l.muli reg/reg/simm16"
     ((MACH ORBIS-MACHS))
     ("l.muli $rD,$rA,$simm16")
     (+ OPC_MULI rD rA simm16)
     (sequence ()
               (sequence ()
                         ; 2's complement overflow
                         (set sys-sr-ov (mul-o2flag WI rA (ext WI simm16)))
                         ; 1's complement overflow
                         (set sys-sr-cy (mul-o1flag UWI rA (ext UWI simm16)))
                         (set rD (mul WI rA (ext WI simm16)))
                         )
               (if (andif sys-sr-ov sys-sr-ove)
                   (raise-exception EXCEPT-RANGE))
               )
     ()
     )

(define-pmacro (extbh-insn mnemonic extop extmode truncmode)
  (begin
    (dni (.sym l- mnemonic)
         (.str "l." mnemonic " reg/reg")
         ((MACH ORBIS-MACHS))
         (.str "l." mnemonic " $rD,$rA")
         (+ OPC_ALU rD rA (f-resv-15-6 0) (.sym OPC_EXTBHS_ (.upcase mnemonic)) (f-resv-5-2 0) OPC_ALU_REGREG_EXTBH)
         (set rD (extop extmode (trunc truncmode rA)))
         ()
         )
    )
  )

(extbh-insn exths ext  WI  HI)
(extbh-insn extbs ext  WI  QI)
(extbh-insn exthz zext UWI UHI)
(extbh-insn extbz zext UWI UQI)

(define-pmacro (extw-insn mnemonic extop extmode truncmode)
  (begin
    (dni (.sym l- mnemonic)
         (.str "l." mnemonic " reg/reg")
         ((MACH ORBIS-MACHS))
         (.str "l." mnemonic " $rD,$rA")
         (+ OPC_ALU rD rA (f-resv-15-6 0) (.sym OPC_EXTWS_ (.upcase mnemonic)) (f-resv-5-2 0) OPC_ALU_REGREG_EXTW)
         (set rD (extop extmode (trunc truncmode rA)))
         ()
         )
    )
  )

(extw-insn extws ext  WI  SI)
(extw-insn extwz zext USI USI)

(dni l-cmov
     "l.cmov reg/reg/reg"
     ((MACH ORBIS-MACHS))
     "l.cmov $rD,$rA,$rB"
     (+ OPC_ALU rD rA rB (f-resv-10-1 0) (f-op-9-2 0) (f-resv-7-4 0) OPC_ALU_REGREG_CMOV)
     (if sys-sr-f
         (set UWI rD rA)
         (set UWI rD rB)
         )
     ()
     )

; Compare instructions

; Ordering compare
(define-pmacro (sf-insn op)
  (begin
     (dni (.sym l- "sf" op "s")                                               ; l-sfgts
          (.str "l.sf" op "s reg/reg")                                        ; "l.sfgts reg/reg"
          ((MACH ORBIS-MACHS))
          (.str "l.sf" op "s $rA,$rB")                                        ; "l.sfgts $rA,$rB"
          (+ OPC_SF (.sym "OPC_SF_" (.upcase op) "S") rA rB (f-resv-10-11 0)) ; (+ OPC_SF OPC_SF_GTS rA rB (f-resv-10-11 0))
          (set sys-sr-f (op WI rA rB))                                        ; (set sys-sr-f (gt WI rA rB))
          ()
          )
     (dni (.sym l- "sf" op "si")                                              ; l-sfgtsi
          (.str "l.sf" op "si reg/simm16")                                    ; "l.sfgtsi reg/simm16"
          ((MACH ORBIS-MACHS))
          (.str "l.sf" op "si $rA,$simm16")                                   ; "l.sfgtsi $rA,$simm16"
          (+ OPC_SFI (.sym "OPC_SF_" (.upcase op) "S") rA simm16)             ; (+ OPC_SFI OPC_SF_GTS rA simm16)
          (set sys-sr-f (op WI rA (ext WI simm16)))                           ; (set sys-sr-f (gt WI rA (ext WI simm16)))
          ()
          )
     (dni (.sym l- "sf" op "u")                                               ; l-sfgtu
          (.str "l.sf" op "u reg/reg")                                        ; "l.sfgtu reg/reg"
          ((MACH ORBIS-MACHS))
          (.str "l.sf" op "u $rA,$rB")                                        ; "l.sfgtu $rA,$rB"
          (+ OPC_SF (.sym "OPC_SF_" (.upcase op) "U") rA rB (f-resv-10-11 0)) ; (+ OPC_SF OPC_SF_GTU rA rB (f-resv-10-11 0))
          (set sys-sr-f ((.sym op "u") WI rA rB))                             ; (set sys-sr-f (gtu WI rA rB))
          ()
          )
     ; immediate is sign extended even for unsigned compare
     (dni (.sym l- "sf" op "ui")                                              ; l-sfgtui
          (.str "l.sf" op "ui reg/simm16")                                    ; "l.sfgtui reg/uimm16"
          ((MACH ORBIS-MACHS))
          (.str "l.sf" op "ui $rA,$simm16")                                   ; "l.sfgtui $rA,$simm16"
          (+ OPC_SFI (.sym "OPC_SF_" (.upcase op) "U") rA simm16)             ; (+ OPC_SFI OPC_SF_GTU rA simm16)
          (set sys-sr-f ((.sym op "u") WI rA (ext WI simm16)))                ; (set sys-sr-f (gtu WI rA (ext WI simm16)))
          ()
          )
     )
  )

(sf-insn gt)
(sf-insn ge)
(sf-insn lt)
(sf-insn le)

; Equality compare
(define-pmacro (sf-insn-eq op)
  (begin
     (dni (.sym l- "sf" op)
          (.str "l." op " reg/reg")
          ((MACH ORBIS-MACHS))
          (.str "l.sf" op " $rA,$rB")
          (+ OPC_SF (.sym "OPC_SF_" (.upcase op)) rA rB (f-resv-10-11 0))
          (set sys-sr-f (op WI rA rB))
          ()
     )
     (dni (.sym l- "sf" op "i")
          (.str "l.sf" op "i reg/simm16")
          ((MACH ORBIS-MACHS))
          (.str "l.sf" op "i $rA,$simm16")
          (+ OPC_SFI (.sym "OPC_SF_" (.upcase op)) rA simm16)
          (set sys-sr-f (op WI rA (ext WI simm16)))
          ()
     )
   )
)

(sf-insn-eq eq)
(sf-insn-eq ne)

(dni l-mac
     "l.mac reg/reg"
     ((MACH ORBIS-MACHS))
     "l.mac $rA,$rB"
     (+  OPC_MAC (f-op-25-5 0) rA rB (f-resv-10-7 0) OPC_MAC_MAC)
     (sequence ((WI prod) (DI result))
               (set WI prod (mul WI rA rB))
               (set DI result (add (join DI SI mac-machi mac-maclo) (ext DI prod)))
               (set SI mac-machi (subword SI result 0))
               (set SI mac-maclo (subword SI result 1))
               )
     ()
     )

(dni l-msb
     "l.msb reg/reg"
     ((MACH ORBIS-MACHS))
     "l.msb $rA,$rB"
     (+  OPC_MAC (f-op-25-5 0) rA rB (f-resv-10-7 0) OPC_MAC_MSB)
     (sequence ((WI prod) (DI result))
               (set WI prod (mul WI rA rB))
               (set DI result (sub (join DI SI mac-machi mac-maclo) (ext DI prod)))
               (set SI mac-machi (subword SI result 0))
               (set SI mac-maclo (subword SI result 1))
               )
     ()
     )

(dni l-maci
     "l.maci reg/simm16"
     ((MACH ORBIS-MACHS))
     "l.maci $rA,${simm16}"
     (+ OPC_MACI (f-resv-25-5 0) rA simm16)
     (sequence ((WI prod) (DI result))
               (set WI prod (mul WI (ext WI simm16) rA))
               (set DI result (add (join DI SI mac-machi mac-maclo) (ext DI prod)))
               (set SI mac-machi (subword SI result 0))
               (set SI mac-maclo (subword SI result 1))
               )
     ()
     )

(define-pmacro (cust-insn cust-num)
  (begin
    (dni (.sym l- "cust" cust-num)
         (.str "l.cust" cust-num)
         ((MACH ORBIS-MACHS))
         (.str "l.cust" cust-num)
         (+ (.sym OPC_CUST cust-num) (f-resv-25-26 0))
         (nop)
         ()
         )
    )
  )

(cust-insn "1")
(cust-insn "2")
(cust-insn "3")
(cust-insn "4")
(cust-insn "5")
(cust-insn "6")
(cust-insn "7")
(cust-insn "8")