assembler-0.0.1: src/Text/Assembler/PPC64.hs

-----------------------------------------------------------------------------
--
-- Module      :  Text.Assembler.PPC64
-- Copyright   : (c) Jeff Douglas
-- License     :  BSD3
--
-- Maintainer  : Jeff Douglas
-- Stability   : experimental
-- Portability : portable
--
-- |
--
-----------------------------------------------------------------------------

module Text.Assembler.PPC64 (instruction,parseInstructions) where

import Prelude hiding (and,or)

import Data.Bits hiding (xor)
import qualified Data.Map as Map
import Data.Word
import Text.Parsec
import Text.Parsec.String
import Text.Parsec.Combinator
import Control.Monad
import Control.Applicative hiding ((<|>))

parseInstructions = many1 instruction

-- parsing --
instruction :: Parser Word32
instruction = foldl1 (<|>) (fmap try instructions) <* char '\n'

instructions = [
  b,ba,b,bla,bc,bca,bcl,bcla,bclr ,bclrl ,bcctr ,bcctrl ,
  sc ,
  crand ,cror ,crxor ,crnand ,crnor ,creqv ,crandc ,crorc ,
  mcrf ,
  lbz,lbzx,lbzu,lbzux,lhz,lhzx,lhzu,lhzux,lha,lhax,lhau,lhaux,lwz,lwzx,lwzu,lwzux,lwa,lwax,lwaux,ld,ldx,ldu,ldux,
  stb ,stbx ,stbu ,stbux ,sth ,sthx ,sthu ,sthux ,stw ,stwx ,stwu ,stwux ,std ,stdx ,stdu ,stdux ,
  lhbrx ,lwbrx ,sthbrx ,stwbrx ,
  lmw,stmw,
  lswi ,lswx ,stswi ,stswx ,
  addi,addis,add,add_,addo,addo_,subf,subf_,subfo,subfo_,addic,addic_,subfic,addc,addc_,addco,addco_,subfc,subfc_,subfco,
  subfco_,adde,adde_,addeo,addeo_,subfe,subfe_,subfeo,subfeo_,addme,addme_,addmeo,addmeo_,subfme,subfme_,
  subfmeo,subfmeo_,addze,addze_,addzeo,addzeo_,subfze,subfze_,subfzeo,subfzeo_,neg,neg_,nego,nego_,mulli,mulld,
  mulld_,mulldo,mulldo_,mullw,mullw_,mullwo,mullwo_,mulhd,mulhd_,mulhw,mulhw_,mulhdu,mulhdu_,mulhwu,
  mulhwu_,divd,divd_,divdo,divdo_,divw,divw_,divwo,divwo_,divdu,divdu_,divduo,divduo_,divwu,divwu_,divwuo,divwuo_,
  cmpi,cmp,cmpli,cmpl,
  tdi,twi,td,tw,
  andi_ ,andis_ ,ori ,oris ,xori ,xors ,and ,and_ ,or ,or_ ,xor ,xor_ ,nand ,nand_ ,nor ,nor_ ,eqv ,eqv_ ,andc ,andc_ ,orc ,orc_ ,extsb ,extsb_ ,extsh ,extsh_ ,extsw ,extsw_ ,cntlzd ,cntlzd_ ,popcntb ,cntlzw ,cntlzw_ ,
  rldicl  ,rldicl_ ,rldicr  ,rldicr_ ,rldic  ,rldic_ ,rlwinm  ,rlwinm_ ,rldcl  ,rldcl_ ,rldcr  ,rldcr_ ,rlwnm  ,rlwnm_ ,rldimi  ,rldimi_ ,rlwimi  ,rlwimi_ ,
  sld  ,sld_ ,slw  ,slw_ ,srd  ,srd_ ,srw  ,srw_ ,sradi  ,sradi_ ,srawi  ,srawi_ ,srad ,srad_ ,sraw ,sraw_ ,
  mtspr ,mfspr ,mtcrf ,
  lfs
  ]

comma = char ','
mnem m = string m >> space

iLit :: Parser Word32
iLit = liftM read (many1 digit)

(<.>) p n = p<*comma<*>n
(<@>) p n = p<*char '('<*>n<*char ')'
infixl 1 <.>
infixl 1 <@>

-- branch instructions
b = ins "b" v1 $ iform 18 0 0
ba = ins "ba" v1 $ iform 18 1 0
bl = ins "bl" v1 $ iform 18 0 1
bla = ins "bla" v1 $ iform 18 1 1

bc = ins "bc" csv3 $ bform 16 0 0
bca = ins "bca" csv3 $ bform 16 1 0
bcl = ins "bcl" csv3 $ bform 16 0 1
bcla = ins "bcla" csv3 $ bform 16 1 1

bclr = ins "bclr" csv3 $ xlform'b 19 16 0
bclrl = ins "bclrl" csv3 $ xlform'b 19 16 1

bcctr = ins "bcctr" csv3 $ xlform'b 19 528 0
bcctrl = ins "bcctrl" csv3 $ xlform'b 19 528 1

-- system call instruction
sc = ins "sc" v1 $ scform 17

-- condition register logical instructions
crand = ins "crand" csv3 $ xlform'a 19 257
cror = ins "cror" csv3 $ xlform'a 19 449
crxor = ins "cxor" csv3 $ xlform'a 19 193
crnand = ins "crnand" csv3 $ xlform'a 19 225
crnor = ins "crnor" csv3 $ xlform'a 19 33
creqv = ins "creqv" csv3 $ xlform'a 19 289
crandc = ins "crandc" csv3 $ xlform'a 19 129
crorc = ins "crorc" csv3 $ xlform'a 19 417

-- condition register field instruction
mcrf = ins "mcrf" csv2 $ xlform'c 19 0

-- fixed point load instructions
lbz = ins "lbz" csv3 $ dform'a 34
lbzx = ins "lbzx" csv3 $ xform'a 31 87
lbzu = ins "lbzu" csv3 $ dform'a 35
lbzux = ins "lbzux" csv3 $ xform'a 31 119
lhz = ins "lhz" csv3 $ dform'a 40
lhzx = ins "lhz" csv3 $ xform'a 31 279
lhzu = ins "lhzu" csv3 $ dform'a 41
lhzux = ins "lhzux" csv3 $ xform'a 31 311
lha = ins "lha" csv3 $ dform'a 42
lhax = ins "lhax" csv3 $ xform'a 31 343
lhau = ins "lhau" csv3 $ dform'a 43
lhaux = ins "lhaux" csv3 $ xform'a 31 375
lwz = ins "lwz" csv3 $ dform'a 32
lwzx = ins "lwzx" csv3 $ xform'a 31 23
lwzu = ins "lwzu" csv3 $ dform'a 33
lwzux = ins "lwzux" csv3 $ xform'a 31 55
lwa = ins "lwa" csv3 $ dsform 58 2
lwax = ins "lwax" csv3 $ xform'a  31 341
lwaux = ins "lwaux" csv3 $ xform'a 31 373
ld = ins "ld" csv3 $ dsform 58 151
ldx = ins "ldx" csv3 $ xform'a 31 21
ldu = ins "ldu" csv3 $ dsform 58 1
ldux = ins "ldux" csv3 $ xform'a 31 53

-- fixed point store instructions
stb = ins "stb" csv3 $ dform'a 38
stbx = ins "stbx" csv3 $ xform'a 31 215
stbu = ins "stbu" csv3 $ dform'a 39
stbux = ins "stbux" csv3 $ xform'a 31 247
sth = ins "sth" csv3 $ dform'a 44
sthx = ins "sthx" csv3 $ xform'a 31 407
sthu = ins "sthu" csv3 $ dform'a 45
sthux = ins "sthux" csv3 $ xform'a 31 439
stw = ins "stw" csv3 $ dform'a 36
stwx = ins "stwx" csv3 $ xform'a 31 151
stwu = ins "stwu" csv3 $ dform'a 37
stwux = ins "stwux" csv3 $ xform'a 31 183
std = ins "std" csv3 $ dsform 62 0
stdx = ins "stdx" csv3 $ xform'a 31 149
stdu = ins "stdu" csv3 $ dsform 37 1
stdux = ins "stdux" csv3 $ xform'a 31 181

-- fixed-point load and store with byte reversal instructions
lhbrx = ins "lhbrx" csv3 $ xform'a 31 790
lwbrx = ins "lwbrx" csv3 $ xform'a 31 534
sthbrx = ins "sthbrx" csv3 $ xform'a 31 918
stwbrx = ins "stwbrx" csv3 $ xform'a 31 662

-- fixed point load and store multiple instructions
lmw = ins "lmw" csv3 $ dform'a 46
stmw = ins "stmw" csv3 $ dform'a 47

-- fixed point move assist instructions
lswi = ins "lswi" csv3 $ xform'a 31 597
lswx = ins "lswx" csv3 $ xform'a 31 533
stswi = ins "stswi" csv3 $ xform'a 31 725
stswx = ins "stswx" csv3 $ xform'a 31 661

--fixed point arithmetic instructions
addi = ins "addi" csv3 $ dform'a 14
addis = ins "addis" csv3 $ dform'a 15

add = ins "add" csv3 $ xoform 31 266 0 0
add_ = ins "add." csv3 $ xoform 31 266 0 1
addo = ins "addo" csv3 $ xoform 31 266 1 0
addo_ = ins "addo." csv3 $ xoform 31 266 1 1
subf = ins "subf" csv3 $ xoform 31 40 0 0
subf_ = ins "subf." csv3 $ xoform 31 40 0 1
subfo = ins "subfo" csv3 $ xoform 31 40 1 0
subfo_ = ins "subfo." csv3 $ xoform 31 40 1 1

addic = ins "addic" csv3 $ dform'a 12
addic_ = ins "addic." csv3 $ dform'a 13
subfic = ins "subfic" csv3 $ dform'a 8

addc = ins "addc" csv3 $ xoform 31 10 0 0
addc_ = ins "addc." csv3 $ xoform 31 10 0 1
addco = ins "addco" csv3 $ xoform 31 10 1 0
addco_ = ins "addco." csv3 $ xoform 31 10 1 1

subfc = ins "subfc" csv3 $ xoform 31 8 0 0
subfc_ = ins "subfc." csv3 $ xoform 31 8 0 1
subfco = ins "subfco" csv3 $ xoform 31 8 1 1
subfco_ = ins "subfco." csv3 $ xoform 31 8 1 1

adde = ins "adde" csv3 $ xoform 31 138 0 0
adde_ = ins "adde." csv3 $ xoform 31 138 0 1
addeo = ins "addeo" csv3 $ xoform 31 138 1 0
addeo_ = ins "addeo." csv3 $ xoform 31 138 1 1

subfe = ins "subfe" csv3 $ xoform 31 136 0 0
subfe_ = ins "subfe." csv3 $ xoform 31 136 0 1
subfeo = ins "subfeo" csv3 $ xoform 31 136 1 0
subfeo_ = ins "subfeo." csv3 $ xoform 31 136 1 1

addme = ins "addme" csv2 $ xoform' 31 234 0 0
addme_ = ins "addme." csv2 $ xoform' 31 234 0 1
addmeo = ins "addmeo" csv2 $ xoform' 31 234 1 0
addmeo_ = ins "addmeo." csv2 $ xoform' 31 234 1 1

subfme = ins "subfme" csv2 $ xoform' 31 232 0 0
subfme_ = ins "subfme." csv2 $ xoform' 31 232 0 1
subfmeo = ins "subfmeo" csv2 $ xoform' 31 232 1 0
subfmeo_ = ins "subfmeo." csv2 $ xoform' 31 232 1 1

addze = ins "addze" csv2 $ xoform' 31 202 0 0
addze_ = ins "addze." csv2 $ xoform' 31 202 0 1
addzeo = ins "addzeo" csv2 $ xoform' 31 202 1 0
addzeo_ = ins "addzeo." csv2 $ xoform' 31 202 1 1

subfze = ins "subfze" csv2 $ xoform' 31 202 0 0
subfze_ = ins "subfze." csv2 $ xoform' 31 202 0 1
subfzeo = ins "subfzeo" csv2 $ xoform' 31 202 1 0
subfzeo_ = ins "subfzeo." csv2 $ xoform' 31 202 1 1

neg = ins "neg" csv2 $ xoform' 31 104 0 0
neg_ = ins "neg." csv2 $ xoform' 31 104 0 1
nego = ins "nego" csv2 $ xoform' 31 104 1 0
nego_ = ins "nego." csv2 $ xoform' 31 104 1 1

mulli = ins "mulli" csv3 $ dform'a 7

mulld = ins "mulld" csv3 $ xoform 31 233 0 0
mulld_ = ins "mulld." csv3 $ xoform 31 233 0 1
mulldo = ins "mulldo" csv3 $ xoform 31 233 1 0
mulldo_ = ins "mulldo." csv3 $ xoform 31 233 1 1

mullw = ins "mullw" csv3 $ xoform 31 235 0 0
mullw_ = ins "mullw." csv3 $ xoform 31 235 0 1
mullwo = ins "mullwo" csv3 $ xoform 31 235 1 0
mullwo_ = ins "mullwo." csv3 $ xoform 31 235 1 1

mulhd = ins "mulhd" csv3 $ xoform 31 73 0 0
mulhd_ = ins "mulhd." csv3 $ xoform 31 73 0 1

mulhw = ins "mulhw" csv3 $ xoform 31 75 0 0
mulhw_ = ins "mulhw." csv3 $ xoform 31 75 0 1

mulhdu = ins "mulhdu" csv3 $ xoform 31 9 0 0
mulhdu_ = ins "mulhdu." csv3 $ xoform 31 9 0 1

mulhwu = ins "mulhwu" csv3 $ xoform 31 11 0 0
mulhwu_ = ins "mulhwu." csv3 $ xoform 31 11 0 1

divd = ins "divd" csv3 $ xoform 31 489 0 0
divd_ = ins "divd." csv3 $ xoform 31 489 0 1
divdo = ins "divdo" csv3 $ xoform 31 489 1 0
divdo_ = ins "divdo." csv3 $ xoform 31 489 1 1

divw = ins "divw" csv3 $ xoform 31 491 0 0
divw_ = ins "divw." csv3 $ xoform 31 491 0 1
divwo = ins "divwo" csv3 $ xoform 31 491 1 0
divwo_ = ins "divwo." csv3 $ xoform 31 491 1 1

divdu = ins "divdu" csv3 $ xoform 31 457 0 0
divdu_ = ins "divdu." csv3 $ xoform 31 457 0 1
divduo = ins "divduo" csv3 $ xoform 31 457 1 0
divduo_ = ins "divduo." csv3 $ xoform 31 457 1 1

divwu = ins "divwu" csv3 $ xoform 31 459 0 0
divwu_ = ins "divwu." csv3 $ xoform 31 459 0 1
divwuo = ins "divdwo" csv3 $ xoform 31 459 1 0
divwuo_ = ins "divdwo." csv3 $ xoform 31 459 1 1

-- fixed-point compare instructions
-- check out bit 9 in cmp
cmpi = ins "cmpi" csv3 $ dform'b 11 0
-- check out bit 9 in cmp
cmp = ins "cmp" csv3 $ xform'b 31 0 0
-- check out bit 9 in cmpli
cmpli = ins "cmpli" csv3 $ dform'b 10 0
-- check out bit 9 in cmpl
cmpl = ins "cmpl" csv3 $ xform'b 32 0 0

-- fixed-point trap instructions
tdi = ins "tdi" csv3 $ dform'a 2
twi = ins "twi" csv3 $ dform'a 3
td = ins "td" csv3 $ xform'a 31 68
tw = ins "tw" csv3 $ xform'a 31 4

-- fixed-point logical instructions
andi_ = ins "andi." csv3 $ dform'a 28
andis_ = ins "andis" csv3 $ dform'a 29
ori = ins "ori" csv3 $ dform'a 24
oris = ins "oris" csv3 $ dform'a 25
xori = ins "ori" csv3 $ dform'a 26
xors = ins "oris" csv3 $ dform'a 27
and = ins "and" csv3 $ xform'c 31 28 0
and_ = ins "and." csv3 $ xform'c 31 28 1
or = ins "or" csv3 $ xform'c 31 444 0
or_ = ins "or." csv3 $ xform'c 31 444 1
xor = ins "xor" csv3 $ xform'c 31 316 0
xor_ = ins "xor." csv3 $ xform'c 31 316 1
nand = ins "nand" csv3 $ xform'c 31 476 0
nand_ = ins "nand." csv3 $ xform'c 31 476 1
nor = ins "nor" csv3 $ xform'c 31 124 0
nor_ = ins "nor." csv3 $ xform'c 31 124 1
eqv = ins "eqv" csv3 $ xform'c 31 284 0
eqv_ = ins "eqv." csv3 $ xform'c 31 284 1
andc = ins "andc" csv3 $ xform'c 31 60 0
andc_ = ins "andc." csv3 $ xform'c 31 60 1
orc = ins "orc" csv3 $ xform'c 31 412 0
orc_ = ins "orc." csv3 $ xform'c 31 412 1
extsb = ins "extsb" csv2 $ xform'd 31 954 0
extsb_ = ins "extsb." csv2 $ xform'd 31 954 1
extsh = ins "extsh" csv2 $ xform'd 31 922 0
extsh_ = ins "extsh." csv2 $ xform'd 31 922 1
extsw = ins "extsw" csv2 $ xform'd 31 986 0
extsw_ = ins "extsw." csv2 $ xform'd 31 986 1
cntlzd = ins "cntlzd" csv2 $ xform'd 31 58 0
cntlzd_ = ins "cntlzd." csv2 $ xform'd 31 58 1
popcntb = ins "popcntb" csv2 $ xform'd 31 122 0
cntlzw = ins "cntlzw" csv2 $ xform'd 31 26 0
cntlzw_ = ins "cntlzw." csv2 $ xform'd 31 26 1

-- fixed-point rotate and shift instructions
rldicl  = ins "rldicl"  csv4 $ mdform 30 0 0
rldicl_ = ins "rldicl." csv4 $ mdform 30 0 1
rldicr  = ins "rldicr"  csv4 $ mdform 30 1 0
rldicr_ = ins "rldicr." csv4 $ mdform 30 1 1
rldic  = ins "rldic"  csv4 $ mdform 30 2 0
rldic_ = ins "rldic." csv4 $ mdform 30 2 1
rlwinm  = ins "rlwinm"  csv5 $ mform 21 0
rlwinm_ = ins "rlwinm." csv5 $ mform 21 1
rldcl  = ins "rldcl"  csv4 $ mdsform 30 8 0
rldcl_ = ins "rldcl." csv4 $ mdsform 30 8 1
rldcr  = ins "rldcr"  csv4 $ mdsform 30 9 0
rldcr_ = ins "rldcr." csv4 $ mdsform 30 9 1
rlwnm  = ins "rlwnm"  csv5 $ mform 23 0
rlwnm_ = ins "rlwnm." csv5 $ mform 23 1
rldimi  = ins "rldimi"  csv4 $ mdform 30 3 0
rldimi_ = ins "rldimi." csv4 $ mdform 30 3 1
rlwimi  = ins "rlwimi"  csv5 $ mform 20 0
rlwimi_ = ins "rlwimi." csv5 $ mform 20 1

-- fixed-point shift instructions
sld  = ins "sld"  csv3 $ xform'c 31 27 0
sld_ = ins "sld." csv3 $ xform'c 31 27 1
slw  = ins "slw"  csv3 $ xform'c 31 24 0
slw_ = ins "slw." csv3 $ xform'c 31 24 1
srd  = ins "srd"  csv3 $ xform'c 31 539 0
srd_ = ins "srd." csv3 $ xform'c 31 539 1
srw  = ins "srw"  csv3 $ xform'c 31 536 0
srw_ = ins "srw." csv3 $ xform'c 31 536 1
sradi  = ins "sradi"  csv3 $ xsform 31 413 0
sradi_ = ins "sradi." csv3 $ xsform 31 413 1
srawi  = ins "srawi"  csv3 $ xform'c 31 824 0
srawi_ = ins "srawi." csv3 $ xform'c 31 824 1
srad = ins "srad" csv3 $ xform'c 31 794 0
srad_ = ins "srad." csv3 $ xform'c 31 794 1
sraw = ins "sraw" csv3 $ xform'c 31 792 0
sraw_ = ins "sraw." csv3 $ xform'c 31 792 1

-- move to/from system register instructions
mtspr = ins "mtspr" csv2 $ xfxform 31 467
mfspr = ins "mfspr" csv2 $ xfxform 31 339
mtcrf = ins "mtcrf" csv2 $ xfxform'b 31 0 144

-- floating-point processor instructions --
-- floating-point load instructions
lfs = ins "lfs" csv3 $ dform'a 48


---
ins m form e  = mnem m>>form e
v1 f = f<$>iLit
csv2 f =f<$>iLit<.>iLit
csv3 f = f<$>iLit<.>iLit<.>iLit
csv4 f = f<$>iLit<.>iLit<.>iLit<.>iLit
csv5 f = f<$>iLit<.>iLit<.>iLit<.>iLit<.>iLit

-- instruction fomats
iform opcd aa lk li = pack [(opcd,6),(li,30),(aa,31),(lk,0)]
bform opcd aa lk bo bi bd = pack [(opcd,6),(bo,11),(bi,16),(bd,30),(aa,31),(lk,0)]
scform opcd lev = pack [(opcd,6),(lev,27),(1,31)]
dform'a opcd rt ra d = pack [(opcd,6),(rt,11),(ra,16),(d,0)]
dform'b opcd bf l ra si = pack [(opcd,6),(bf,9),(0,10),(l,11),(ra,16),(si,0)]
dsform opcd rt ra ds xo = pack [(opcd,6),(rt,11),(ra,16),(ds,30),(xo,0)]
xform'a opcd rt ra rb xo = pack [(opcd,6),(rt,11),(ra,16),(rb,21),(xo,31)]
xform'b opcd xo bf l ra rb = pack [(opcd,6),(bf,9),(0,10),(l,11),(ra,16),(rb,21),(xo,31),(0,0)]
xform'c opcd xo rs ra rb rc = pack [(opcd,6),(rs,11),(ra,16),(rb,21),(xo,31),(rc,0)]
xform'd opcd xo rc rs ra = pack [(opcd,6),(rs,11),(ra,16),(0,21),(xo,31),(rc,0)]
xlform'a opcd xo bt ba bb = pack [(opcd,6),(bt,11),(ba,16),(bb,21),(xo,31)]
xlform'b opcd xo lk bo bi bh = pack [(opcd,6),(bo,11),(bi,16),(bh,21),(xo,31),(lk,0)]
xlform'c opcd xo bf bfa = pack [(opcd,6),(bf,9),(bfa,14),(xo,31)]
xfxform opcd xo rs spr = pack [(opcd,6),(rs,11),(spr,21),(xo,31)]
xfxform'b opcd h xo fxm rs = pack [(opcd,6),(rs,11),(h,12),(fxm,20),(xo,31)]
--xflform
-- fix xsform
xsform opcd xo rc ra rs sh = pack [(opcd,6),(rs,11),(ra,16),(sh,21),(xo,30),(sh,31),(rc,0)]
xoform opcd xo oe rc rt ra rb = pack [(opcd,6),(rt,11),(ra,16),(rb,21),(oe,22),(xo,31),(rc,0)]
xoform' opcd xo oe rc rt ra = pack [(opcd,6),(rt,11),(ra,16),(0,21),(oe,22),(xo,31),(rc,0)]
--aform
mform opcd rc ra rs sh mb me = pack [(opcd,6),(rs,11),(ra,16),(sh,21),(mb,26),(me,31),(rc,0)]
-- mdform needs to be fixed to handle sh correctly
mdform opcd h rc ra rs sh mb = pack [(opcd,6),(rs,11),(ra,16),(sh,21),(mb,27),(h,30),(sh,31),(rc,0)]
mdsform opcd h rc ra rs rb mb = pack [(opcd,6),(rs,11),(ra,16),(rb,21),(mb,27),(h,31),(rc,0)]

-- bit-packing --
pack bf = foldr1 (.|.) $ map (uncurry rotateR) bf