DidaWiki

Back

"asm.ml"

(** some support to the analysis of D-RISC code on pipeline processors
    This includes the possibility to find dependencies in linear 
    D-RISC code and to execute D-RISC instructions with a given 
    configuration of registers and memory (with no cache).
    @author Marco Danelutto 
    @year 2011
*)
 
open Printf;;
 
(** the type modelling registers *)
type reg = Reg of int;;
 
(** the type modelling labels: either strings or offsets *)
type label = LabOff of int | LabLab of string;;
 
(** the type modelling the constants: e.g. #i -> Const(i) *)
type const = Const of int;;
 
(** the assembler opcodes *)
type asm = 
   ADD of reg*reg*reg
|  SUB of reg*reg*reg
|  MUL of reg*reg*reg
|  DIV of reg*reg*reg
|  ADDI of reg*const*reg
|  SUBI of reg*const*reg
|  INC of reg
|  DEC of reg
|  LD of reg*reg*reg
|  LDI of reg*const*reg
|  ST of reg*reg*reg
|  STI of reg*const*reg
|  CALL of reg*reg
|  GOTOR of reg
|  GOTOL of label
|  IFLEQ of reg*reg*label
|  IFLE of reg*reg*label
|  IFGEQ of reg*reg*label
|  IFGE of reg*reg*label
|  IFEQ of reg*reg*label
|  IFNEQ of reg*reg*label
|  END
;;
 
(** the assembler instruction: may have a label *)
type instruction = 
   Instr of asm 
|  LabInstr of label*asm;;
 
(** returns the domain of an instruction *)
let domain = function 
   ADD(a,b,c) -> [a;b]
|  SUB(a,b,c) -> [a;b]
|  MUL(a,b,c) -> [a;b]
|  DIV(a,b,c) -> [a;b]
|  ADDI(a,b,c) -> [a]
|  SUBI(a,b,c) -> [a]
|  INC(a) -> [a]
|  DEC(a) -> [a]
|  LD(a,b,c) -> [a;b]
|  ST(a,b,c) -> [a;b;c]
|  LDI(a,b,c) -> [a]
|  STI(a,b,c) -> [a;c]
|  CALL(a,b) -> [a]
|  GOTOR(a) -> [a]
|  GOTOL(a) -> []
|  IFLEQ(a,b,c) -> [a;b]
|  IFLE(a,b,c) -> [a;b]
|  IFGEQ(a,b,c) -> [a;b]
|  IFGE(a,b,c) -> [a;b]
|  IFEQ(a,b,c) -> [a;b]
|  IFNEQ(a,b,c) -> [a;b]
|  END -> []
;;
 
(** returns the range of an instruction *)
let codomain = function 
   ADD(a,b,c) -> [c]
|  SUB(a,b,c) -> [c]
|  MUL(a,b,c) -> [c]
|  DIV(a,b,c) -> [c]
|  ADDI(a,b,c) -> [c]
|  SUBI(a,b,c) -> [c]
|  INC(a) -> [a]
|  DEC(a) -> [a]
|  LD(a,b,c) -> [c]
|  ST(a,b,c) -> []
|  LDI(a,b,c) -> [c]
|  STI(a,b,c) -> []
|  CALL(a,b) -> []
|  GOTOR(a) -> []
|  GOTOL(a) -> []
|  IFLEQ(a,b,c) -> []
|  IFLE(a,b,c) -> []
|  IFGEQ(a,b,c) -> []
|  IFGE(a,b,c) -> []
|  IFEQ(a,b,c) -> []
|  IFNEQ(a,b,c) -> []
|  END -> []
;;
 
(** function computing the intersection of two lists. 
    This is used to compute Bernstein conditions *)
let intersect l1 l2 = 
  let a1 = Array.of_list l1 in
  let a2 = Array.of_list l2 in
  let res = ref [] in 
  let n1 = Array.length a1 in 
  let n2 = Array.length a2 in 
  for i=0 to (n1-1) do 
    for j=0 to (n2-1) do 
      if(a1.(i) = a2.(j))
      then res := a2.(j) :: !res 
    done
  done; 
  !res
;;
 
(** checks if an instruction is "executed" on the IU *)
let iu_instruction = function
    IFLEQ(a,b,c) -> true
  | IFLE(a,b,c)  -> true
  | IFGEQ(a,b,c) -> true
  | IFGE(a,b,c)  -> true
  | IFEQ(a,b,c)  -> true
  | IFNEQ(a,b,c) -> true
  | LD(a,b,c)    -> true
  | LDI(a,b,c)   -> true
  | ST(a,b,c)    -> true
  | STI(a,b,c)   -> true
  | _ -> false
;;
 
(** data dependency: 
	instructions inducing the data dependencies
	interested register(s) 
	"distance"
	"N"
*) 
type datadep = 
  NoDataDep 
| DataDep of int * asm * int * asm * reg list * int * int ;;
 
(** removes labels from an instruction, if present, 
    and returns the assembler instruction only *)
let delab = function
  LabInstr(l,i) -> i 
| Instr(i) -> i;;
 
(** check whether there is a data dependency among instructions
    @param a1 the address of the first instruction
    @param a2 the address of the second instruction
    @param li1 the first instruction 
    @param li2 the second instruction 
    @param dist the distance between instructions 
    @param n the N parameter
*)
let data_dep_i a1 a2 li1 li2 dist n = 
  let i1 = delab li1 in 
  let i2 = delab li2 in
  let wrs = codomain(i1) in
  let rds = domain(i2) in 
  let regset = (intersect rds wrs) in 
  if(iu_instruction i2 && not(regset = []))
    then DataDep(a1,i1,a2,i2,(intersect rds wrs),dist,n)
    else NoDataDep;;
 
(** checks whether there is a load in the sequence 
    leading to the dependency 
    @param i1 the starting point of the sequence
    @param i2 the ending point of the sequence 
    @param prog the program with the sequence *)
let loadsinsequence prog i1 i2 = 
  let aprog = Array.of_list prog in 
  let bign  = ref false in 
  for i=i1 to (i2-1) do
    let asmi = match aprog.(i) with 
	    	Instr(ai) -> ai
	       |LabInstr(l,ai) -> ai in
    bign := match asmi with 
		LD(a,b,c) -> true
	    |   LDI(a,b,c) -> true
	    |   _ -> !bign
  done; 
  !bign
;; 
 
(** finds all data dependencies in a program 
    @param prog the program *)
let data_deps prog = 
  let aprog = Array.of_list prog in
  let n     = Array.length aprog in 
  let res   = ref [] in
  let start = ref 0 in 
  for i=0 to (n-2) do
    for j=(i+1) to (n-1) do
      let i1 = aprog.(i) in 
      let i2 = aprog.(j) in 
      let dd = (data_dep_i i j i1 i2 (j-i) 0) in (* N=0 TODO *)
        match dd with 
          NoDataDep -> ()
        | DataDep(i,i1,j,i2,regs,dist,n) -> 
	    let hasloads = loadsinsequence prog !start (j-1) in
   	    let bign = if(hasloads) then 2 else 1 in
            let dd = DataDep(i,i1,j,i2,regs,dist,bign) in
 
	    start := j;
	    res := (List.append (!res) [dd])
    done
  done;
  !res
;;
 
(** bernstein conditions check *)
let bernstein i1 i2 = 
  let d1 = domain i1 in 
  let d2 = domain i2 in 
  let c1 = codomain i1 in 
  let c2 = codomain i2 in
  let d1c2 = intersect d1 c2 in 
  let d2c1 = intersect d2 c1 in 
  if(d1c2 = [] && d2c1 = []) 
  then true
  else false
;;
 
(** pretty print a register *) 
let pp_reg = function
  Reg(x) -> printf " R_%d " x ;;
 
(** pretty print a list of registers *)
let rec pp_regs = function 
  [] -> ()
| r::rr -> (pp_reg r);(pp_regs rr);;
 
(** pretty print the register set
    Used in pretty print of the 
    environment of execution of a program *)
let pp_reg_set r = 
  let n = Array.length r in 
  for i=0 to (n-1) do
    printf " R%d=%d " i !(r.(i))
  done; 
  printf "\n"
;;
 
(** pretty print a memory state. Used in pretty print of the 
    environment of execution of a program *)
let pp_mem r = 
  let n = Array.length r in 
  for i=0 to (n-1) do
    if(i mod 5 == 0) 
    then printf " M%d=%d " i !(r.(i))
    else printf " %d " !(r.(i));
    if(i mod 19 == 0 && not (i = 0)) 
    then printf "\n"
  done; 
  printf "\n"
;;
 
(** pretty print a label *)
let pp_lab = function 
  LabLab(s) -> printf " %s " s
| LabOff(o) -> printf "L(%d) " o;;
 
(** pretty print a constant *)
let pp_const = function 
  Const c -> printf " #%d " c;;
 
(** pretty print a D-RISC instruction 
    This should still be completed. 
    In case you see a NOFORMATAVAILABLE you should add a clause
    to handle the missing instruction print *)
let pp_asm = function 
  ADD(a,b,c) -> printf "ADD "; pp_reg(a); pp_reg(b); pp_reg(c)
| INC(a) -> printf "INC"; pp_reg(a)
| IFLE(r1,r2,l) -> printf "IF< "; pp_reg(r1); pp_reg(r2); pp_lab(l)
| IFEQ(r1,r2,l) -> printf "IF= "; pp_reg(r1); pp_reg(r2); pp_lab(l)
| LD(a,b,c) -> printf "LOAD "; pp_reg(a); pp_reg(b); pp_reg(c)
| ST(a,b,c) -> printf "STORE "; pp_reg(a); pp_reg(b); pp_reg(c)
| END -> printf "END "
| _ -> printf "NOFORMATAVAILABLE"
;;
 
(** pretty print an instruction, possibly with a label *)
let pp_instr add = function 
  Instr(i) -> printf "%d.\t" add; pp_asm(i); printf "\n"
| LabInstr(l,i) -> printf "%d. " add; 	
		   pp_lab(l); printf ":"; pp_asm(i); printf "\n"
;;
 
(** pretty print a whole program, starting with at a given address *)
let rec pp_prog add = function 
  [] -> printf "\n"
| i::ri -> (pp_instr add i); (pp_prog (add+1) ri)
;;
 
(** pretty print a program, assuming it is allocated from address 0 *)
let pp_program p = (pp_prog 1 p);;
 
 
(** pretty print a data dependency *) 
let pp_dd = function 
  NoDataDep -> ()
| DataDep(a1,i1,a2,i2,regl,d,n) -> 
   printf "DD:: "; 
   printf "%d. " a1; pp_asm i1; printf " ==>> "; 
   printf "%d. " a2; pp_asm i2; 
   printf " (d=%d N=%d) due to reg(s)" d n;
   pp_regs regl;
   printf "\n";;
 
(** pretty print a list of dependencies *)
let rec pp_deps = function 
   [] -> ()
|  d::rd -> (pp_dd d);(pp_deps rd);;
 
 
(** transforms a list of instructions (with labels) into  
    a list of assembler instruction (with no labels) *)
let rec prog_to_asm p = 
  List.map delab p;;

Back