Macintosh-Tools/Retro68
1
0
Fork 0
mirror of https://github.com/autc04/Retro68.git synced 2024-11-26 22:51:01 +00:00
Code Issues Projects Releases Wiki Activity
1e3f4b0031
Retro68/binutils/cpu/ip2k.cpu

1481 lines
38 KiB
Scheme
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

; Ubicom IP2K CPU description. -*- Scheme -*-
; Copyright (C) 2002, 2009, 2011 Free Software Foundation, Inc.
;
; Contributed by Red Hat Inc;
;
; This file is part of the GNU Binutils.
;
; This program is free software; you can redistribute it and/or modify
; it under the terms of the GNU General Public License as published by
; the Free Software Foundation; either version 3 of the License, or
; (at your option) any later version.
;
; This program is distributed in the hope that it will be useful,
; but WITHOUT ANY WARRANTY; without even the implied warranty of
; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
; GNU General Public License for more details.
;
; You should have received a copy of the GNU General Public License
; along with this program; if not, write to the Free Software
; Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston,
; MA 02110-1301, USA.
(define-rtl-version 0 8)
(include "simplify.inc")
; define-arch must appear first
(define-arch
(name ip2k) ; name of cpu family
(comment "Ubicom IP2000 family")
(default-alignment aligned)
(insn-lsb0? #t)
(machs ip2022 ip2022ext)
(isas ip2k)
)
; Attributes.
(define-attr
(for insn)
(type boolean)
(name EXT-SKIP-INSN)
(comment "instruction is a PAGE, LOADL, LOADH or BREAKX instruction")
)
(define-attr
(for insn)
(type boolean)
(name SKIPA)
(comment "instruction is a SKIP instruction")
)
; Instruction set parameters.
(define-isa
(name ip2k)
(comment "Ubicom IP2000 ISA")
(default-insn-word-bitsize 16)
(default-insn-bitsize 16)
(base-insn-bitsize 16)
)
; Cpu family definitions.
(define-cpu
; cpu names must be distinct from the architecture name and machine names.
(name ip2kbf)
(comment "Ubicom IP2000 Family")
(endian big)
(word-bitsize 16)
)
(define-mach
(name ip2022)
(comment "Ubicom IP2022")
(cpu ip2kbf)
)
(define-mach
(name ip2022ext)
(comment "Ubicom IP2022 extended")
(cpu ip2kbf)
)
; Model descriptions.
(define-model
(name ip2k) (comment "VPE 2xxx") (attrs)
(mach ip2022ext)
(unit u-exec "Execution Unit" ()
1 1 ; issue done
() ; state
() ; inputs
() ; outputs
() ; profile action (default)
)
)
; FIXME: It might simplify things to separate the execute process from the
; one that updates the PC.
; Instruction fields.
;
; Attributes:
; XXX: what VPE attrs
; PCREL-ADDR: pc relative value (for reloc and disassembly purposes)
; ABS-ADDR: absolute address (for reloc and disassembly purposes?)
; RESERVED: bits are not used to decode insn, must be all 0
; RELOC: there is a relocation associated with this field (experiment)
(dnf f-imm8 "imm8" () 7 8)
(dnf f-reg "reg" (ABS-ADDR) 8 9)
(dnf f-addr16cjp "addr16cjp" (ABS-ADDR) 12 13)
(dnf f-dir "dir" () 9 1)
(dnf f-bitno "bit number" () 11 3)
(dnf f-op3 "op3" () 15 3)
(dnf f-op4 "op4" () 15 4)
(dnf f-op4mid "op4mid" () 11 4)
(dnf f-op6 "op6" () 15 6)
(dnf f-op8 "op8" () 15 8)
(dnf f-op6-10low "op6-10low" () 9 10)
(dnf f-op6-7low "op6-7low" () 9 7)
(dnf f-reti3 "reti3" () 2 3)
(dnf f-skipb "sb/snb" (ABS-ADDR) 12 1)
(dnf f-page3 "page3" () 2 3)
;(define-ifield (name f-page3) (comment "page3") (attrs) (start 2) (length 3)
; (encode (value pc) (srl WI value 13))
; (decode (value pc) (sll WI value 13))
;)
; To fix the page/call asymmetry
;(define-ifield (name f-page3) (comment "page3") (attrs) (start 2) (length 3)
; (encode (value pc) (srl WI value 13))
; (decode (value pc) (sll WI value 13))
;)
; Enums.
; insn-op6: bits 15-10
(define-normal-insn-enum insn-op6 "op6 enums" () OP6_ f-op6
(OTHER1 OTHER2 SUB DEC OR AND XOR ADD
TEST NOT INC DECSZ RR RL SWAP INCSZ
CSE POP SUBC DECSNZ MULU MULS INCSNZ ADDC
- - - - - - - -
- - - - - - - -
- - - - - - - -
- - - - - - - -
- - - - - - - -
)
)
; insn-dir: bit 9
(define-normal-insn-enum insn-dir "dir enums" () DIR_ f-dir
; This bit specifies the polarity of many two-operand instructions:
; TO_W writes result to W regiser (eg. ADDC W,$fr)
; NOTTO_W writes result in general register (eg. ADDC $fr,W)
(TO_W NOTTO_W)
)
; insn-op4: bits 15-12
(define-normal-insn-enum insn-op4 "op4 enums" () OP4_ f-op4
(- - - - - - - LITERAL
CLRB SETB SNB SB - - - -
)
)
; insn-op4mid: bits 11-8
; used for f-op4=LITERAL
(define-normal-insn-enum insn-op4mid "op4mid enums" () OP4MID_ f-op4mid
(LOADH_L LOADL_L MULU_L MULS_L PUSH_L - CSNE_L CSE_L
RETW_L CMP_L SUB_L ADD_L MOV_L OR_L AND_L XOR_L)
)
; insn-op3: bits 15-13
(define-normal-insn-enum insn-op3 "op3 enums" () OP3_ f-op3
(- - - - - - CALL JMP)
)
; Hardware pieces.
; Bank-relative general purpose registers
; (define-pmacro (build-reg-name n) (.splice (.str "$" n) n))
(define-keyword
(name register-names)
(enum-prefix H-REGISTERS-)
(values
; These are the "Special Purpose Registers" that are not reserved
("ADDRSEL" #x2) ("ADDRX" #x3)
("IPH" #x4) ("IPL" #x5) ("SPH" #x6) ("SPL" #x7)
("PCH" #x8) ("PCL" #x9) ("WREG" #xA) ("STATUS" #xB)
("DPH" #xC) ("DPL" #xD) ("SPDREG" #xE) ("MULH" #xF)
("ADDRH" #x10) ("ADDRL" #x11) ("DATAH" #x12) ("DATAL" #x13)
("INTVECH" #x14) ("INTVECL" #x15) ("INTSPD" #x16) ("INTF" #x17)
("INTE" #x18) ("INTED" #x19) ("FCFG" #x1A) ("TCTRL" #x1B)
("XCFG" #x1C) ("EMCFG" #x1D) ("IPCH" #x1E) ("IPCL" #x1F)
("RAIN" #x20) ("RAOUT" #x21) ("RADIR" #x22) ("LFSRH" #x23)
("RBIN" #x24) ("RBOUT" #x25) ("RBDIR" #x26) ("LFSRL" #x27)
("RCIN" #x28) ("RCOUT" #x29) ("RCDIR" #x2A) ("LFSRA" #x2B)
("RDIN" #x2C) ("RDOUT" #x2D) ("RDDIR" #x2E)
("REIN" #x30) ("REOUT" #x31) ("REDIR" #x32)
("RFIN" #x34) ("RFOUT" #x35) ("RFDIR" #x36)
("RGOUT" #x39) ("RGDIR" #x3A)
("RTTMR" #x40) ("RTCFG" #x41) ("T0TMR" #x42) ("T0CFG" #x43)
("T1CNTH" #x44) ("T1CNTL" #x45) ("T1CAP1H" #x46) ("T1CAP1L" #x47)
("T1CAP2H" #x48) ("T1CMP2H" #x48) ("T1CAP2L" #x49) ("T1CMP2L" #x49) ; note aliases
("T1CMP1H" #x4A) ("T1CMP1L" #x4B)
("T1CFG1H" #x4C) ("T1CFG1L" #x4D) ("T1CFG2H" #x4E) ("T1CFG2L" #x4F)
("ADCH" #x50) ("ADCL" #x51) ("ADCCFG" #x52) ("ADCTMR" #x53)
("T2CNTH" #x54) ("T2CNTL" #x55) ("T2CAP1H" #x56) ("T2CAP1L" #x57)
("T2CAP2H" #x58) ("T2CMP2H" #x58) ("T2CAP2L" #x59) ("T2CMP2L" #x59) ; note aliases
("T2CMP1H" #x5A) ("T2CMP1L" #x5B)
("T2CFG1H" #x5C) ("T2CFG1L" #x5D) ("T2CFG2H" #x5E) ("T2CFG2L" #x5F)
("S1TMRH" #x60) ("S1TMRL" #x61) ("S1TBUFH" #x62) ("S1TBUFL" #x63)
("S1TCFG" #x64) ("S1RCNT" #x65) ("S1RBUFH" #x66) ("S1RBUFL" #x67)
("S1RCFG" #x68) ("S1RSYNC" #x69) ("S1INTF" #x6A) ("S1INTE" #x6B)
("S1MODE" #x6C) ("S1SMASK" #x6D) ("PSPCFG" #x6E) ("CMPCFG" #x6F)
("S2TMRH" #x70) ("S2TMRL" #x71) ("S2TBUFH" #x72) ("S2TBUFL" #x73)
("S2TCFG" #x74) ("S2RCNT" #x75) ("S2RBUFH" #x76) ("S2RBUFL" #x77)
("S2RCFG" #x78) ("S2RSYNC" #x79) ("S2INTF" #x7A) ("S2INTE" #x7B)
("S2MODE" #x7C) ("S2SMASK" #x7D) ("CALLH" #x7E) ("CALLL" #x7F))
)
(define-hardware
(name h-spr)
(comment "special-purpose registers")
(type register QI (128))
(get (index) (c-call QI "get_spr" index ))
(set (index newval) (c-call VOID "set_spr" index newval ))
)
;;(define-hardware
;; (name h-gpr-global)
;; (comment "gpr registers - global")
;; (type register QI (128))
;;)
; The general register
(define-hardware
(name h-registers)
(comment "all addressable registers")
(attrs VIRTUAL)
(type register QI (512))
(get (index) (c-call QI "get_h_registers" index ))
(set (index newval) (c-call VOID "set_h_registers" index newval ))
)
; The hardware stack.
; Use {push,pop}_pc_stack c-calls to operate on this hardware element.
(define-hardware
(name h-stack)
(comment "hardware stack")
(type register UHI (16))
)
(dsh h-pabits "page bits" () (register QI))
(dsh h-zbit "zero bit" () (register BI))
(dsh h-cbit "carry bit" () (register BI))
(dsh h-dcbit "digit-carry bit" () (register BI))
(dnh h-pc "program counter" (PC PROFILE) (pc) () () ())
; Operands
(define-operand (name addr16cjp) (comment "13-bit address") (attrs)
(type h-uint) (index f-addr16cjp) (handlers (parse "addr16_cjp") (print "dollarhex_cj"))) ; overload lit8 printer
(define-operand (name fr) (comment "register") (attrs)
(type h-registers) (index f-reg) (handlers (parse "fr") (print "fr")))
(define-operand (name lit8) (comment "8-bit signed literal") (attrs)
(type h-sint) (index f-imm8) (handlers (parse "lit8") (print "dollarhex8")))
(define-operand (name bitno) (comment "bit number") (attrs)
(type h-uint) (index f-bitno) (handlers (parse "bit3")(print "decimal")))
(define-operand (name addr16p) (comment "page number") (attrs)
(type h-uint) (index f-page3) (handlers (parse "addr16_cjp") (print "dollarhex_p")))
(define-operand (name addr16h) (comment "high 8 bits of address") (attrs)
(type h-uint) (index f-imm8) (handlers (parse "addr16") (print "dollarhex_addr16h")))
(define-operand (name addr16l) (comment "low 8 bits of address") (attrs)
(type h-uint) (index f-imm8) (handlers (parse "addr16") (print "dollarhex_addr16l")))
(define-operand (name reti3) (comment "reti flags") (attrs)
(type h-uint) (index f-reti3) (handlers (print "dollarhex")))
(dnop pabits "page bits" () h-pabits f-nil)
(dnop zbit "zero bit" () h-zbit f-nil)
(dnop cbit "carry bit" () h-cbit f-nil)
(dnop dcbit "digit carry bit" () h-dcbit f-nil)
;;(dnop bank "bank register" () h-bank-no f-nil)
(define-pmacro w (reg h-spr #x0A))
(define-pmacro mulh (reg h-spr #x0F))
(define-pmacro dph (reg h-spr #x0C))
(define-pmacro dpl (reg h-spr #x0D))
(define-pmacro sph (reg h-spr #x06))
(define-pmacro spl (reg h-spr #x07))
(define-pmacro iph (reg h-spr #x04))
(define-pmacro ipl (reg h-spr #x05))
(define-pmacro addrh (reg h-spr #x10))
(define-pmacro addrl (reg h-spr #x11))
; Pseudo-RTL for DC flag calculations
; "DC" = "digit carry", ie carry between nibbles
(define-pmacro (add-dcflag a b c)
(add-cflag (sll QI a 4) (sll QI b 4) c)
)
(define-pmacro (sub-dcflag a b c)
(sub-cflag (sll QI a 4) (sll QI b 4) c)
)
; Check to see if an fr is one of IPL, SPL, DPL, ADDRL, PCL.
(define-pmacro (LregCheck isLreg fr9bit)
(sequence()
(set isLreg #x0) ;; Assume it's not an Lreg
(if (or (or (eq fr9bit #x5) (eq fr9bit #x7))
(or (eq fr9bit #x9)
(or (eq fr9bit #xd) (eq fr9bit #x11))))
(set isLreg #x1)
)
)
)
; Instructions, in order of the "Instruction Set Map" table on
; pp 19-20 of IP2022 spec V1.09
(dni jmp "Jump"
()
"jmp $addr16cjp"
(+ OP3_JMP addr16cjp)
(set pc (or (sll pabits 13) addr16cjp))
()
)
; note that in call, we push pc instead of pc + 1 because the ip2k increments
; the pc prior to execution of the instruction
(dni call "Call"
()
"call $addr16cjp"
(+ OP3_CALL addr16cjp)
(sequence ()
(c-call "push_pc_stack" pc)
(set pc (or (sll pabits 13) addr16cjp)))
()
)
(dni sb "Skip if bit set"
()
"sb $fr,$bitno"
(+ OP4_SB bitno fr)
(if (and fr (sll 1 bitno))
(skip 1))
()
)
(dni snb "Skip if bit clear"
()
"snb $fr,$bitno"
(+ OP4_SNB bitno fr)
(if (not (and fr (sll 1 bitno)))
(skip 1))
()
)
(dni setb "Set bit"
()
"setb $fr,$bitno"
(+ OP4_SETB bitno fr)
(set fr (or fr (sll 1 bitno)))
()
)
(dni clrb "Clear bit"
()
"clrb $fr,$bitno"
(+ OP4_CLRB bitno fr)
(set fr (and fr (inv (sll 1 bitno))))
()
)
(dni xorw_l "XOR W,literal"
()
"xor W,#$lit8"
(+ OP4_LITERAL OP4MID_XOR_L lit8)
(sequence ()
(set w (xor w lit8))
(set zbit (zflag w)))
()
)
(dni andw_l "AND W,literal"
()
"and W,#$lit8"
(+ OP4_LITERAL OP4MID_AND_L lit8)
(sequence ()
(set w (and w lit8))
(set zbit (zflag w)))
()
)
(dni orw_l "OR W,literal"
()
"or W,#$lit8"
(+ OP4_LITERAL OP4MID_OR_L lit8)
(sequence ()
(set w (or w lit8))
(set zbit (zflag w)))
()
)
(dni addw_l "ADD W,literal"
()
"add W,#$lit8"
(+ OP4_LITERAL OP4MID_ADD_L lit8)
(sequence ()
(set cbit (add-cflag w lit8 0))
(set dcbit (add-dcflag w lit8 0))
(set w (add w lit8))
(set zbit (zflag w)))
()
)
(dni subw_l "SUB W,literal"
()
"sub W,#$lit8"
(+ OP4_LITERAL OP4MID_SUB_L lit8)
(sequence ()
(set cbit (not (sub-cflag lit8 w 0)))
(set dcbit (not (sub-dcflag lit8 w 0)))
(set zbit (zflag (sub w lit8)))
(set w (sub lit8 w)))
()
)
(dni cmpw_l "CMP W,literal"
()
"cmp W,#$lit8"
(+ OP4_LITERAL OP4MID_CMP_L lit8)
(sequence ()
(set cbit (not (sub-cflag lit8 w 0)))
(set dcbit (not (sub-dcflag lit8 w 0)))
(set zbit (zflag (sub w lit8))))
()
)
(dni retw_l "RETW literal"
()
"retw #$lit8"
(+ OP4_LITERAL OP4MID_RETW_L lit8)
(sequence ((USI new_pc))
(set w lit8)
(set new_pc (c-call UHI "pop_pc_stack"))
(set pabits (srl new_pc 13))
(set pc new_pc))
()
)
(dni csew_l "CSE W,literal"
()
"cse W,#$lit8"
(+ OP4_LITERAL OP4MID_CSE_L lit8)
(if (eq w lit8)
(skip 1))
()
)
(dni csnew_l "CSNE W,literal"
()
"csne W,#$lit8"
(+ OP4_LITERAL OP4MID_CSNE_L lit8)
(if (not (eq w lit8))
(skip 1))
()
)
(dni push_l "Push #lit8"
()
"push #$lit8"
(+ OP4_LITERAL OP4MID_PUSH_L lit8)
(sequence ()
(c-call "push" lit8)
(c-call VOID "adjuststackptr" (const -1))
)
()
)
(dni mulsw_l "Multiply W,literal (signed)"
()
"muls W,#$lit8"
(+ OP4_LITERAL OP4MID_MULS_L lit8)
(sequence ((SI tmp))
(set tmp (mul (ext SI w) (ext SI (and UQI #xff lit8))))
(set w (and tmp #xFF))
(set mulh (srl tmp 8)))
()
)
(dni muluw_l "Multiply W,literal (unsigned)"
()
"mulu W,#$lit8"
(+ OP4_LITERAL OP4MID_MULU_L lit8)
(sequence ((USI tmp))
(set tmp (and #xFFFF (mul (zext USI w) (zext USI lit8))))
(set w (and tmp #xFF))
(set mulh (srl tmp 8)))
()
)
(dni loadl_l "LoadL literal"
(EXT-SKIP-INSN)
"loadl #$lit8"
(+ OP4_LITERAL OP4MID_LOADL_L lit8)
(set dpl (and lit8 #x00FF))
()
)
(dni loadh_l "LoadH literal"
(EXT-SKIP-INSN)
"loadh #$lit8"
(+ OP4_LITERAL OP4MID_LOADH_L lit8)
(set dph (and lit8 #x00FF))
()
)
(dni loadl_a "LoadL addr16l"
(EXT-SKIP-INSN)
"loadl $addr16l"
(+ OP4_LITERAL OP4MID_LOADL_L addr16l)
(set dpl (and addr16l #x00FF))
()
)
(dni loadh_a "LoadH addr16h"
(EXT-SKIP-INSN)
"loadh $addr16h"
(+ OP4_LITERAL OP4MID_LOADH_L addr16h)
(set dph (and addr16l #x0FF00))
()
)
;; THIS NO LONGER EXISTS -> Now LOADL
;;(dni bank_l "Bank literal"
;; ()
;; "bank #$lit8"
;; (+ OP4_LITERAL OP4MID_BANK_L lit8)
;; (set bank lit8)
;; ()
;;)
(dni addcfr_w "Add w/carry fr,W"
()
"addc $fr,W"
(+ OP6_ADDC DIR_NOTTO_W fr)
(sequence ((QI result) (BI newcbit) (QI isLreg) (HI 16bval))
(set newcbit (add-cflag w fr cbit))
(set dcbit (add-dcflag w fr cbit))
;; If fr is an Lreg, then we have to do 16-bit arithmetic.
;; We can take advantage of the fact that by a lucky
;; coincidence, the address of register xxxH is always
;; one lower than the address of register xxxL.
(LregCheck isLreg (ifield f-reg))
(if (eq isLreg #x1)
(sequence()
(set 16bval (reg h-spr (sub (ifield f-reg) 1)))
(set 16bval (sll 16bval 8))
(set 16bval (or 16bval (and (reg h-spr (ifield f-reg)) #xFF)))
(set 16bval (addc HI 16bval w cbit))
(set (reg h-spr (ifield f-reg)) (and 16bval #xFF))
(set (reg h-spr (sub (ifield f-reg) 1))
(and (srl 16bval 8) #xFF))
(set result (reg h-spr (ifield f-reg)))
)
(set result (addc w fr cbit)) ;; else part
)
(set zbit (zflag result))
(set cbit newcbit)
(set fr result))
()
)
(dni addcw_fr "Add w/carry W,fr"
()
"addc W,$fr"
(+ OP6_ADDC DIR_TO_W fr)
(sequence ((QI result) (BI newcbit))
(set newcbit (add-cflag w fr cbit))
(set dcbit (add-dcflag w fr cbit))
(set result (addc w fr cbit))
(set zbit (zflag result))
(set cbit newcbit)
(set w result))
()
)
(dni incsnz_fr "Skip if fr++ not zero"
()
"incsnz $fr"
(+ OP6_INCSNZ DIR_NOTTO_W fr)
(sequence ((QI isLreg) (HI 16bval))
(LregCheck isLreg (ifield f-reg))
;; If fr is an Lreg, then we have to do 16-bit arithmetic.
;; We can take advantage of the fact that by a lucky
;; coincidence, the address of register xxxH is always
;; one lower than the address of register xxxL.
(if (eq isLreg #x1)
(sequence()
; Create the 16 bit value
(set 16bval (reg h-spr (sub (ifield f-reg) 1)))
(set 16bval (sll 16bval 8))
(set 16bval (or 16bval (and (reg h-spr (ifield f-reg)) #xFF)))
; Do 16 bit arithmetic.
(set 16bval (add HI 16bval 1))
; Separate the 16 bit values into the H and L regs
(set (reg h-spr (ifield f-reg)) (and 16bval #xFF))
(set (reg h-spr (sub (ifield f-reg) 1))
(and (srl 16bval 8) #xFF))
(set fr (reg h-spr (ifield f-reg)))
)
(set fr (add fr 1)) ; Do 8 bit arithmetic.
)
(if (not (zflag fr))
(skip 1)))
()
)
(dni incsnzw_fr "Skip if W=fr+1 not zero"
()
"incsnz W,$fr"
(+ OP6_INCSNZ DIR_TO_W fr)
(sequence ()
(set w (add fr 1))
(if (not (zflag w))
(skip 1)))
()
)
(dni mulsw_fr "Multiply W,fr (signed)"
()
"muls W,$fr"
(+ OP6_MULS DIR_TO_W fr)
(sequence ((SI tmp))
(set tmp (mul (ext SI w) (ext SI fr)))
(set w (and tmp #xFF))
(set mulh (srl tmp 8)))
()
)
(dni muluw_fr "Multiply W,fr (unsigned)"
()
"mulu W,$fr"
(+ OP6_MULU DIR_TO_W fr)
(sequence ((USI tmp))
(set tmp (and #xFFFF (mul (zext USI w) (zext USI fr))))
(set w (and tmp #xFF))
(set mulh (srl tmp 8)))
()
)
(dni decsnz_fr "Skip if fr-- not zero"
()
"decsnz $fr"
(+ OP6_DECSNZ DIR_NOTTO_W fr)
(sequence ((QI isLreg) (HI 16bval))
(LregCheck isLreg (ifield f-reg))
;; If fr is an Lreg, then we have to do 16-bit arithmetic.
;; We can take advantage of the fact that by a lucky
;; coincidence, the address of register xxxH is always
;; one lower than the address of register xxxL.
(if (eq isLreg #x1)
(sequence()
; Create the 16 bit value
(set 16bval (reg h-spr (sub (ifield f-reg) 1)))
(set 16bval (sll 16bval 8))
(set 16bval (or 16bval (and (reg h-spr (ifield f-reg)) #xFF)))
; New 16 bit instruction
(set 16bval (sub HI 16bval 1))
; Separate the 16 bit values into the H and L regs
(set (reg h-spr (ifield f-reg)) (and 16bval #xFF))
(set (reg h-spr (sub (ifield f-reg) 1))
(and (srl 16bval 8) #xFF))
(set fr (reg h-spr (ifield f-reg)))
)
; Original instruction
(set fr (sub fr 1))
)
(if (not (zflag fr))
(skip 1)))
()
)
(dni decsnzw_fr "Skip if W=fr-1 not zero"
()
"decsnz W,$fr"
(+ OP6_DECSNZ DIR_TO_W fr)
(sequence ()
(set w (sub fr 1))
(if (not (zflag w))
(skip 1)))
()
)
(dni subcw_fr "Subract w/carry W,fr"
()
"subc W,$fr"
(+ OP6_SUBC DIR_TO_W fr)
(sequence ((QI result) (BI newcbit))
(set newcbit (not (sub-cflag fr w (not cbit))))
(set dcbit (not (sub-dcflag fr w (not cbit))))
(set result (subc fr w (not cbit)))
(set zbit (zflag result))
(set cbit newcbit)
(set w result))
()
)
(dni subcfr_w "Subtract w/carry fr,W"
()
"subc $fr,W"
(+ OP6_SUBC DIR_NOTTO_W fr)
(sequence ((QI result) (BI newcbit) (QI isLreg) (HI 16bval))
(set newcbit (not (sub-cflag fr w (not cbit))))
(set dcbit (not (sub-dcflag fr w (not cbit))))
(LregCheck isLreg (ifield f-reg))
;; If fr is an Lreg, then we have to do 16-bit arithmetic.
;; We can take advantage of the fact that by a lucky
;; coincidence, the address of register xxxH is always
;; one lower than the address of register xxxL.
(if (eq isLreg #x1)
(sequence()
; Create the 16 bit value
(set 16bval (reg h-spr (sub (ifield f-reg) 1)))
(set 16bval (sll 16bval 8))
(set 16bval (or 16bval (and (reg h-spr (ifield f-reg)) #xFF)))
; New 16 bit instruction
(set 16bval (subc HI 16bval w (not cbit)))
; Separate the 16 bit values into the H and L regs
(set (reg h-spr (ifield f-reg)) (and 16bval #xFF))
(set (reg h-spr (sub (ifield f-reg) 1))
(and (srl 16bval 8) #xFF))
(set result (reg h-spr (ifield f-reg)))
)
; Original instruction
(set result (subc fr w (not cbit)))
)
(set zbit (zflag result))
(set cbit newcbit)
(set fr result))
()
)
(dni pop_fr "Pop fr"
()
"pop $fr"
(+ OP6_POP (f-dir 1) fr)
(sequence()
(set fr (c-call QI "pop"))
(c-call VOID "adjuststackptr" (const 1))
)
()
)
(dni push_fr "Push fr"
()
"push $fr"
(+ OP6_POP (f-dir 0) fr)
(sequence()
(c-call "push" fr)
(c-call VOID "adjuststackptr" (const -1))
)
()
)
(dni csew_fr "Skip if equal W,fr"
()
"cse W,$fr"
(+ OP6_CSE (f-dir 1) fr)
(if (eq w fr)
(skip 1))
()
)
(dni csnew_fr "Skip if not-equal W,fr"
()
"csne W,$fr"
(+ OP6_CSE (f-dir 0) fr)
(if (not (eq w fr))
(skip 1))
()
)
;;(dni csaw_fr "Skip if W above fr"
;; ((MACH ip2022ext))
;; "csa W,$fr"
;; (+ OP6_CSAB (f-dir 1) fr)
;; (if (gt w fr)
;; (skip 1))
;; ()
;;)
;;(dni csbw_fr "Skip if W below fr"
;; ((MACH ip2022ext))
;; "csb W,$fr"
;; (+ OP6_CSAB (f-dir 0) fr)
;; (if (lt w fr)
;; (skip 1))
;; ()
;;)
(dni incsz_fr "Skip if fr++ zero"
()
"incsz $fr"
(+ OP6_INCSZ DIR_NOTTO_W fr)
(sequence ((QI isLreg) (HI 16bval))
(LregCheck isLreg (ifield f-reg))
;; If fr is an Lreg, then we have to do 16-bit arithmetic.
;; We can take advantage of the fact that by a lucky
;; coincidence, the address of register xxxH is always
;; one lower than the address of register xxxL.
(if (eq isLreg #x1)
(sequence()
; Create the 16 bit value
(set 16bval (reg h-spr (sub (ifield f-reg) 1)))
(set 16bval (sll 16bval 8))
(set 16bval (or 16bval (and (reg h-spr (ifield f-reg)) #xFF)))
; New 16 bit instruction
(set 16bval (add HI 16bval 1))
; Separate the 16 bit values into the H and L regs
(set (reg h-spr (ifield f-reg)) (and 16bval #xFF))
(set (reg h-spr (sub (ifield f-reg) 1))
(and (srl 16bval 8) #xFF))
(set fr (reg h-spr (ifield f-reg)))
)
; Original instruction
(set fr (add fr 1))
)
(if (zflag fr)
(skip 1)))
()
)
(dni incszw_fr "Skip if W=fr+1 zero"
()
"incsz W,$fr"
(+ OP6_INCSZ DIR_TO_W fr)
(sequence ()
(set w (add fr 1))
(if (zflag w)
(skip 1)))
()
)
(dni swap_fr "Swap fr nibbles"
()
"swap $fr"
(+ OP6_SWAP DIR_NOTTO_W fr)
(set fr (or (and (sll fr 4) #xf0)
(and (srl fr 4) #x0f)))
()
)
(dni swapw_fr "Swap fr nibbles into W"
()
"swap W,$fr"
(+ OP6_SWAP DIR_TO_W fr)
(set w (or (and (sll fr 4) #xf0)
(and (srl fr 4) #x0f)))
()
)
(dni rl_fr "Rotate fr left with carry"
()
"rl $fr"
(+ OP6_RL DIR_NOTTO_W fr)
(sequence ((QI newfr) (BI newc))
(set newc (and fr #x80))
(set newfr (or (sll fr 1) (if QI cbit 1 0)))
(set cbit (if QI newc 1 0))
(set fr newfr))
()
)
(dni rlw_fr "Rotate fr left with carry into W"
()
"rl W,$fr"
(+ OP6_RL DIR_TO_W fr)
(sequence ((QI newfr) (BI newc))
(set newc (and fr #x80))
(set newfr (or (sll fr 1) (if QI cbit 1 0)))
(set cbit (if QI newc 1 0))
(set w newfr))
()
)
(dni rr_fr "Rotate fr right with carry"
()
"rr $fr"
(+ OP6_RR DIR_NOTTO_W fr)
(sequence ((QI newfr) (BI newc))
(set newc (and fr #x01))
(set newfr (or (srl fr 1) (if QI cbit #x80 #x00)))
(set cbit (if QI newc 1 0))
(set fr newfr))
()
)
(dni rrw_fr "Rotate fr right with carry into W"
()
"rr W,$fr"
(+ OP6_RR DIR_TO_W fr)
(sequence ((QI newfr) (BI newc))
(set newc (and fr #x01))
(set newfr (or (srl fr 1) (if QI cbit #x80 #x00)))
(set cbit (if QI newc 1 0))
(set w newfr))
()
)
(dni decsz_fr "Skip if fr-- zero"
()
"decsz $fr"
(+ OP6_DECSZ DIR_NOTTO_W fr)
(sequence ((QI isLreg) (HI 16bval))
(LregCheck isLreg (ifield f-reg))
;; If fr is an Lreg, then we have to do 16-bit arithmetic.
;; We can take advantage of the fact that by a lucky
;; coincidence, the address of register xxxH is always
;; one lower than the address of register xxxL.
(if (eq isLreg #x1)
(sequence()
; Create the 16 bit value
(set 16bval (reg h-spr (sub (ifield f-reg) 1)))
(set 16bval (sll 16bval 8))
(set 16bval (or 16bval (and (reg h-spr (ifield f-reg)) #xFF)))
; New 16 bit instruction
(set 16bval (sub HI 16bval 1))
; Separate the 16 bit values into the H and L regs
(set (reg h-spr (ifield f-reg)) (and 16bval #xFF))
(set (reg h-spr (sub (ifield f-reg) 1))
(and (srl 16bval 8) #xFF))
(set fr (reg h-spr (ifield f-reg)))
)
; Original instruction
(set fr (sub fr 1))
)
(if (zflag fr)
(skip 1)))
()
)
(dni decszw_fr "Skip if W=fr-1 zero"
()
"decsz W,$fr"
(+ OP6_DECSZ DIR_TO_W fr)
(sequence ()
(set w (sub fr 1))
(if (zflag w)
(skip 1)))
()
)
(dni inc_fr "Increment fr"
()
"inc $fr"
(+ OP6_INC DIR_NOTTO_W fr)
(sequence ((QI isLreg) (HI 16bval))
(LregCheck isLreg (ifield f-reg))
;; If fr is an Lreg, then we have to do 16-bit arithmetic.
;; We can take advantage of the fact that by a lucky
;; coincidence, the address of register xxxH is always
;; one lower than the address of register xxxL.
(if (eq isLreg #x1)
(sequence()
; Create the 16 bit value
(set 16bval (reg h-spr (sub (ifield f-reg) 1)))
(set 16bval (sll 16bval 8))
(set 16bval (or 16bval (and (reg h-spr (ifield f-reg)) #xFF)))
; New 16 bit instruction
(set 16bval (add HI 16bval 1))
; Separate the 16 bit values into the H and L regs
(set (reg h-spr (ifield f-reg)) (and 16bval #xFF))
(set (reg h-spr (sub (ifield f-reg) 1))
(and (srl 16bval 8) #xFF))
(set fr (reg h-spr (ifield f-reg)))
)
; Original instruction
(set fr (add fr 1))
)
(set zbit (zflag fr)))
()
)
(dni incw_fr "Increment fr into w"
()
"inc W,$fr"
(+ OP6_INC DIR_TO_W fr)
(sequence ()
(set w (add fr 1))
(set zbit (zflag w)))
()
)
(dni not_fr "Invert fr"
()
"not $fr"
(+ OP6_NOT DIR_NOTTO_W fr)
(sequence ()
(set fr (inv fr))
(set zbit (zflag fr)))
()
)
(dni notw_fr "Invert fr into w"
()
"not W,$fr"
(+ OP6_NOT DIR_TO_W fr)
(sequence ()
(set w (inv fr))
(set zbit (zflag w)))
()
)
(dni test_fr "Test fr"
()
"test $fr"
(+ OP6_TEST DIR_NOTTO_W fr)
(sequence ()
(set zbit (zflag fr)))
()
)
(dni movw_l "MOV W,literal"
()
"mov W,#$lit8"
(+ OP4_LITERAL OP4MID_MOV_L lit8)
(set w lit8)
()
)
(dni movfr_w "Move/test w into fr"
()
"mov $fr,W"
(+ OP6_OTHER1 DIR_NOTTO_W fr)
(set fr w)
()
)
(dni movw_fr "Move/test fr into w"
()
"mov W,$fr"
(+ OP6_TEST DIR_TO_W fr)
(sequence ()
(set w fr)
(set zbit (zflag w)))
()
)
(dni addfr_w "Add fr,W"
()
"add $fr,W"
(+ OP6_ADD DIR_NOTTO_W fr)
(sequence ((QI result) (QI isLreg) (HI 16bval))
(set cbit (add-cflag w fr 0))
(set dcbit (add-dcflag w fr 0))
(LregCheck isLreg (ifield f-reg))
;; If fr is an Lreg, then we have to do 16-bit arithmetic.
;; We can take advantage of the fact that by a lucky
;; coincidence, the address of register xxxH is always
;; one lower than the address of register xxxL.
(if (eq isLreg #x1)
(sequence()
(set 16bval (reg h-spr (sub (ifield f-reg) 1)))
(set 16bval (sll 16bval 8))
(set 16bval (or 16bval (and (reg h-spr (ifield f-reg)) #xFF)))
(set 16bval (add HI (and w #xFF) 16bval))
(set (reg h-spr (ifield f-reg)) (and 16bval #xFF))
(set (reg h-spr (sub (ifield f-reg) 1))
(and (srl 16bval 8) #xFF))
(set result (reg h-spr (ifield f-reg)))
)
(set result (addc w fr 0)) ;; else part
)
(set zbit (zflag result))
(set fr result))
()
)
(dni addw_fr "Add W,fr"
()
"add W,$fr"
(+ OP6_ADD DIR_TO_W fr)
(sequence ((QI result))
(set cbit (add-cflag w fr 0))
(set dcbit (add-dcflag w fr 0))
(set result (addc w fr 0))
(set zbit (zflag result))
(set w result))
()
)
(dni xorfr_w "XOR fr,W"
()
"xor $fr,W"
(+ OP6_XOR DIR_NOTTO_W fr)
(sequence ()
(set fr (xor w fr))
(set zbit (zflag fr)))
()
)
(dni xorw_fr "XOR W,fr"
()
"xor W,$fr"
(+ OP6_XOR DIR_TO_W fr)
(sequence ()
(set w (xor fr w))
(set zbit (zflag w)))
()
)
(dni andfr_w "AND fr,W"
()
"and $fr,W"
(+ OP6_AND DIR_NOTTO_W fr)
(sequence ()
(set fr (and w fr))
(set zbit (zflag fr)))
()
)
(dni andw_fr "AND W,fr"
()
"and W,$fr"
(+ OP6_AND DIR_TO_W fr)
(sequence ()
(set w (and fr w))
(set zbit (zflag w)))
()
)
(dni orfr_w "OR fr,W"
()
"or $fr,W"
(+ OP6_OR DIR_NOTTO_W fr)
(sequence ()
(set fr (or w fr))
(set zbit (zflag fr)))
()
)
(dni orw_fr "OR W,fr"
()
"or W,$fr"
(+ OP6_OR DIR_TO_W fr)
(sequence ()
(set w (or fr w))
(set zbit (zflag w)))
()
)
(dni dec_fr "Decrement fr"
()
"dec $fr"
(+ OP6_DEC DIR_NOTTO_W fr)
(sequence ((QI isLreg) (HI 16bval))
(LregCheck isLreg (ifield f-reg))
;; If fr is an Lreg, then we have to do 16-bit arithmetic.
;; We can take advantage of the fact that by a lucky
;; coincidence, the address of register xxxH is always
;; one lower than the address of register xxxL.
(if (eq isLreg #x1)
(sequence()
; Create the 16 bit value
(set 16bval (reg h-spr (sub (ifield f-reg) 1)))
(set 16bval (sll 16bval 8))
(set 16bval (or 16bval (and (reg h-spr (ifield f-reg)) #xFF)))
; New 16 bit instruction
(set 16bval (sub HI 16bval 1))
; Separate the 16 bit values into the H and L regs
(set (reg h-spr (ifield f-reg)) (and 16bval #xFF))
(set (reg h-spr (sub (ifield f-reg) 1))
(and (srl 16bval 8) #xFF))
(set fr (reg h-spr (ifield f-reg)))
)
; Original instruction
(set fr (sub fr 1))
)
(set zbit (zflag fr)))
()
)
(dni decw_fr "Decrement fr into w"
()
"dec W,$fr"
(+ OP6_DEC DIR_TO_W fr)
(sequence ()
(set w (sub fr 1))
(set zbit (zflag w)))
()
)
(dni subfr_w "Sub fr,W"
()
"sub $fr,W"
(+ OP6_SUB DIR_NOTTO_W fr)
(sequence ((QI result) (QI isLreg) (HI 16bval))
(set cbit (not (sub-cflag fr w 0)))
(set dcbit (not (sub-dcflag fr w 0)))
(LregCheck isLreg (ifield f-reg))
;; If fr is an Lreg, then we have to do 16-bit arithmetic.
;; We can take advantage of the fact that by a lucky
;; coincidence, the address of register xxxH is always
;; one lower than the address of register xxxL.
(if (eq isLreg #x1)
(sequence()
; Create the 16 bit value
(set 16bval (reg h-spr (sub (ifield f-reg) 1)))
(set 16bval (sll 16bval 8))
(set 16bval (or 16bval (and (reg h-spr (ifield f-reg)) #xFF)))
; New 16 bit instruction
(set 16bval (sub HI 16bval (and w #xFF)))
; Separate the 16 bit values into the H and L regs
(set (reg h-spr (ifield f-reg)) (and 16bval #xFF))
(set (reg h-spr (sub (ifield f-reg) 1))
(and (srl 16bval 8) #xFF))
(set result (reg h-spr (ifield f-reg)))
)
; Original instruction
(set result (subc fr w 0))
)
(set zbit (zflag result))
(set fr result))
()
)
(dni subw_fr "Sub W,fr"
()
"sub W,$fr"
(+ OP6_SUB DIR_TO_W fr)
(sequence ((QI result))
(set cbit (not (sub-cflag fr w 0)))
(set dcbit (not (sub-dcflag fr w 0)))
(set result (subc fr w 0))
(set zbit (zflag result))
(set w result))
()
)
(dni clr_fr "Clear fr"
()
"clr $fr"
(+ OP6_OTHER2 (f-dir 1) fr)
(sequence ()
(set fr 0)
(set zbit (zflag fr)))
()
)
(dni cmpw_fr "CMP W,fr"
()
"cmp W,$fr"
(+ OP6_OTHER2 (f-dir 0) fr)
(sequence ()
(set cbit (not (sub-cflag fr w 0)))
(set dcbit (not (sub-dcflag fr w 0)))
(set zbit (zflag (sub w fr))))
()
)
(dni speed "Set speed"
()
"speed #$lit8"
(+ (f-op8 1) lit8)
(set (reg h-registers #x0E) lit8)
()
)
(dni ireadi "Insn memory read with increment"
()
"ireadi"
(+ OP6_OTHER1 (f-op6-10low #x1D))
(c-call "do_insn_read")
()
)
(dni iwritei "Insn memory write with increment"
()
"iwritei"
(+ OP6_OTHER1 (f-op6-10low #x1C))
(c-call "do_insn_write")
()
)
(dni fread "Flash read"
()
"fread"
(+ OP6_OTHER1 (f-op6-10low #x1B))
(c-call "do_flash_read")
()
)
(dni fwrite "Flash write"
()
"fwrite"
(+ OP6_OTHER1 (f-op6-10low #x1A))
(c-call "do_flash_write")
()
)
(dni iread "Insn memory read"
()
"iread"
(+ OP6_OTHER1 (f-op6-10low #x19))
(c-call "do_insn_read")
()
)
(dni iwrite "Insn memory write"
()
"iwrite"
(+ OP6_OTHER1 (f-op6-10low #x18))
(c-call "do_insn_write")
()
)
(dni page "Set insn page"
(EXT-SKIP-INSN)
;"page $page3"
"page $addr16p"
;(+ OP6_OTHER1 (f-op6-7low #x2) page3)
;(set pabits (srl page3 13))
(+ OP6_OTHER1 (f-op6-7low #x2) addr16p)
(set pabits addr16p)
()
)
(dni system "System call"
()
"system"
(+ OP6_OTHER1 (f-op6-10low #xff))
(c-call "do_system")
()
)
(dni reti "Return from interrupt"
()
"reti #$reti3"
(+ OP6_OTHER1 (f-op6-7low #x1) reti3)
(c-call "do_reti" reti3)
()
)
(dni ret "Return"
()
"ret"
(+ OP6_OTHER1 (f-op6-10low #x07))
(sequence ((USI new_pc))
(set new_pc (c-call UHI "pop_pc_stack"))
(set pabits (srl new_pc 13))
(set pc new_pc))
()
)
(dni int "Software interrupt"
()
"int"
(+ OP6_OTHER1 (f-op6-10low #x6))
(nop)
()
)
(dni breakx "Breakpoint with extended skip"
(EXT-SKIP-INSN)
"breakx"
(+ OP6_OTHER1 (f-op6-10low #x5))
(c-call "do_break" pc)
()
)
(dni cwdt "Clear watchdog timer"
()
"cwdt"
(+ OP6_OTHER1 (f-op6-10low #x4))
(c-call "do_clear_wdt")
()
)
(dni ferase "Flash erase"
()
"ferase"
(+ OP6_OTHER1 (f-op6-10low #x3))
(c-call "do_flash_erase")
()
)
(dni retnp "Return, no page"
()
"retnp"
(+ OP6_OTHER1 (f-op6-10low #x2))
(sequence ((USI new_pc))
(set new_pc (c-call UHI "pop_pc_stack"))
(set pc new_pc))
()
)
(dni break "Breakpoint"
()
"break"
(+ OP6_OTHER1 (f-op6-10low #x1))
(c-call "do_break" pc)
()
)
(dni nop "No operation"
()
"nop"
(+ OP6_OTHER1 (f-op6-10low #x0))
(nop)
()
)
; Macro instructions
(dnmi sc "Skip on carry"
()
"sc"
(emit sb (bitno 0) (fr #xB)) ; sb status.0
)
(dnmi snc "Skip on no carry"
()
"snc"
(emit snb (bitno 0) (fr #xB)) ; snb status.0
)
(dnmi sz "Skip on zero"
()
"sz"
(emit sb (bitno 2) (fr #xB)) ; sb status.2
)
(dnmi snz "Skip on no zero"
()
"snz"
(emit snb (bitno 2) (fr #xB)) ; snb status.2
)
(dnmi skip "Skip always"
(SKIPA)
"skip"
(emit snb (bitno 0) (fr 9)) ; snb pcl.0 | (pcl&1)<<12
)
(dnmi skipb "Skip always"
(SKIPA)
"skip"
(emit sb (bitno 0) (fr 9)) ; sb pcl.0 | (pcl&1)<<12
)
Reference in New Issue View Git Blame Copy Permalink