Here you find the specification of the ASM language,
and the ASM interpreter sources.
For instance, make fib
executes the ASM program fib.asm
.
type reg = string;; (* "$0" models register set to constant 0 *) type label = string;; (* empty string models no label *) type asmistr = AsmHalt | AsmNop | AsmAdd of reg * reg * reg | AsmAddi of reg * int * reg | AsmSub of reg * reg * reg | AsmMul of reg * reg * reg | AsmLoad of reg * reg * reg | AsmStore of reg * reg * reg | AsmJmp of label | AsmBne of reg * reg * label | AsmBeq of reg * reg * label | AsmSlt of reg * reg * reg ;; type asmprog = AsmProg of (label * asmistr) list;; type asmline = AsmIstr of label * asmistr | AsmComment of string | AsmDebugReg of reg | AsmDebugMem of int * int ;;
exception AsmException of string;; let bind f x v = fun y -> if y=x then v else f y;; (*** REGISTERS ***) let init_reg = fun x -> 0;; let write_reg regs i v = if i="0" then raise (AsmException "Register 0 cannot be written") else bind regs i v;; let read_reg regs i = regs i;; (*** MEMORY ***) let init_mem = fun x -> 0;; let write_mem mem i v = if i<0 || i>0x10000 then raise (AsmException "Memory index out of bounds") else bind mem i v;; let read_mem mem i = if i<0 || i>0x10000 then raise (AsmException "Memory index out of bounds") else mem i;; (*** PROGRAMS ***) let rec labels = function [] -> [] | (l,istr)::p -> if (l<>"") then l::(labels p) else labels p ;; let rec dup = function [] -> false | l::cont -> (List.mem l cont) || (dup cont) ;; let rec range a b = if a>b then [] else a::(range (a+1) b);; let join f g = fun x -> match (f x, g x) with (None,v) -> v | (v,None) -> v | (Some v, Some w) -> if v=w then Some v else failwith "join";; (* fun_of_prog: constructs a pair of functions from an ASM program fi: (partial) function from indices to instructions fi: (partial) function from labels to indices *) let fun_of_prog p = let n = List.length p in let p' = List.combine (range 0 (n-1)) p in let fi = List.fold_right (fun (n,(l,istr)) f -> bind f n (Some istr)) p' (fun i -> None) in let fl = List.fold_right (fun (n,(l,istr)) f -> if l="" then f else bind f l (Some n)) p' (fun l -> None) in (fi,fl) ;; let index_of_label fl l = match fl l with Some i -> i | None -> raise (AsmException ("Unknown label" ^ l));; let asm_exec_istr (fi,fl) (regs,mem,i) = match fi i with None -> raise (AsmException ("No ASM instruction at index " ^ (string_of_int i))) | Some istr -> (match istr with AsmHalt -> (regs, mem, -1) | AsmNop -> (regs, mem, i+1) | AsmAdd (a, b, c) -> (write_reg regs a ((read_reg regs b) + (read_reg regs c)), mem, i+1) | AsmAddi (a, v, c) -> (write_reg regs a (v + (read_reg regs c)), mem, i+1) | AsmSub (a, b, c) -> (write_reg regs a ((read_reg regs b) - (read_reg regs c)), mem, i+1) | AsmMul (a, b, c) -> (write_reg regs a ((read_reg regs b) * (read_reg regs c)), mem, i+1) | AsmLoad (a,b,off) -> (write_reg regs a (read_mem mem ((read_reg regs b) + (read_reg regs off))),mem,i+1) | AsmStore (b,off,a) -> (regs, write_mem mem ((read_reg regs b) + (read_reg regs off)) (read_reg regs a),i+1) | AsmJmp l -> (regs, mem, index_of_label fl l) | AsmBeq (a, b, l) -> let i' = if (read_reg regs a) = (read_reg regs b) then index_of_label fl l else i+1 in (regs,mem,i') | AsmBne (a, b, l) -> let i' = if (read_reg regs a) <> (read_reg regs b) then index_of_label fl l else i+1 in (regs,mem,i') | AsmSlt (a, b, c) -> let v = if (read_reg regs b) < (read_reg regs c) then 1 else 0 in (write_reg regs a v, mem, i+1)) ;; let rec loop p f x = if p x then x else loop p f (f x);; let asm_exec_prog (AsmProg p) = if dup (labels p) then raise (AsmException "Duplicate labels") else let (fi,fl) = fun_of_prog p in loop (fun (_,_,i) -> i=(-1)) (fun x -> asm_exec_istr (fi,fl) x) (init_reg,init_mem,0) ;;
let p0 = AsmProg [("", AsmAddi ("n", 5, "0")); ("", AsmAddi ("f", 1, "0")); ("", AsmAddi ("i", 1, "0")); ("Loop", AsmSlt ("t","n","i")); ("", AsmBne ("t","0","End")); ("", AsmMul ("f", "f", "i")); ("", AsmAddi ("i", 1, "i")); ("", AsmJmp "Loop"); ("End", AsmHalt)];; let get_regs_istr = function AsmHalt -> [] | AsmNop -> [] | AsmAdd (a, b, c) -> union [a] (union [b] [c]) | AsmAddi (a, v, c) -> union [a] [c] | AsmSub (a, b, c) -> union [a] (union [b] [c]) | AsmMul (a, b, c) -> union [a] (union [b] [c]) | AsmLoad (a,b,off) -> union [a] (union [b] [off]) | AsmStore (b,off,a) -> union [a] (union [b] [off]) | AsmJmp l -> [] | AsmBeq (a, b, l) -> union [a] [b] | AsmBne (a, b, l) -> union [a] [b] | AsmSlt (a, b, c) -> union [a] (union [b] [c]) ;; let rec get_regs = function [] -> [] | (l,i)::p -> union (get_regs_istr i) (get_regs p) ;; let rec dump_mem m (l0,l1) = if l0>l1 then [] else (l0,read_mem m l0)::(dump_mem m (l0+1,l1)) ;; let asm_dump_prog (AsmProg p) d = let (regs,mem,idx) = asm_exec_prog (AsmProg p) in let rl = intersect (fst d) (setminus "0" (get_regs p)) in let rdump = List.map (fun r -> (r,regs r)) rl in let mdump = List.flatten (List.map (dump_mem mem) (snd d)) in (rdump,mdump) ;;
let string_of_reg r = "$" ^ r;; let string_of_asmistr istr = match istr with AsmHalt -> "halt" | AsmNop -> "nop" | AsmAdd (a, b, c) -> "add " ^ (string_of_reg a) ^ " " ^ (string_of_reg b) ^ " " ^ (string_of_reg c) | AsmAddi (a, v, c) -> "addi " ^ (string_of_reg a) ^ " " ^ (string_of_int v) ^ " " ^ (string_of_reg c) | AsmSub (a, b, c) -> "sub " ^ (string_of_reg a) ^ " " ^ (string_of_reg b) ^ " " ^ (string_of_reg c) | AsmMul (a, b, c) -> "mul " ^ (string_of_reg a) ^ " " ^ (string_of_reg b) ^ " " ^ (string_of_reg c) | AsmLoad (a,b,off) -> "load " ^ (string_of_reg a) ^ " " ^ (string_of_reg b) ^ " " ^ (string_of_reg off) | AsmStore (b,off,a) -> "store " ^ (string_of_reg b) ^ " " ^ (string_of_reg off) ^ " " ^ (string_of_reg a) | AsmJmp l -> "jmp " ^ l | AsmBeq (a, b, l) -> "beq " ^ (string_of_reg a) ^ " " ^ (string_of_reg b) ^ " " ^ l | AsmBne (a, b, l) ->"bne " ^ (string_of_reg a) ^ " " ^ (string_of_reg b) ^ " " ^ l | AsmSlt (a, b, c) -> "slt " ^ (string_of_reg a) ^ " " ^ (string_of_reg b) ^ " " ^ (string_of_reg c) ;; let rec string_of_asmprog (AsmProg p) = match p with [] -> "" | (l,istr)::p -> let s = (if l="" then "\t" else l ^ ":\t") in s ^ (string_of_asmistr istr) ^ "\n" ^ (string_of_asmprog (AsmProg p)) ;; let rec string_of_regdump = function [] -> "" | (r,v)::d -> let s = (string_of_reg r) ^ " -> " ^ (string_of_int v) ^ "\n" in s ^ string_of_regdump d ;; let rec string_of_memdump = function [] -> "" | (x,v)::d -> let s = (string_of_int x) ^ " -> " ^ (string_of_int v) ^ "\n" in s ^ string_of_memdump d ;; let string_of_asmdump d = (if fst d <> [] then "Registers:\n" ^ (string_of_regdump (fst d)) ^ "\n" else "") ^ (if snd d <> [] then "Memory:\n" ^ (string_of_memdump (snd d)) else "");;
open Camlp4.PreCast ;; module AsmGram = MakeGram(Lexer) ;; let reg = AsmGram.Entry.mk "reg" ;; let label = AsmGram.Entry.mk "label" ;; let opt_comment = AsmGram.Entry.mk "opt_comment" ;; let asmistr = AsmGram.Entry.mk "asmistr" ;; let asmlistr = AsmGram.Entry.mk "asmlistr" ;; let asmline = AsmGram.Entry.mk "asmline" ;; EXTEND AsmGram reg: [ [ "$"; s=LIDENT -> s | "$"; n=INT -> n] ]; label: [ [ s=UIDENT -> s] ]; opt_comment: [ [ LIST0 [" "] -> "" | "//"; STRING -> "" ] ]; asmistr: [ [ ["HALT" | "halt"] -> AsmHalt | ["NOP" | "nop"] -> AsmNop | ["ADD" | "add"]; a=reg; b=reg; c=reg -> AsmAdd(a,b,c) | ["ADDI" | "addi"]; a=reg; `INT(v,_); c=reg -> AsmAddi(a,v,c) | ["SUB" | "sub"]; a=reg; b=reg; c=reg -> AsmSub(a,b,c) | ["MUL" | "mul"]; a=reg; b=reg; c=reg -> AsmMul(a,b,c) | ["LOAD" | "load"]; a=reg; b=reg; c=reg -> AsmLoad(a,b,c) | ["STORE" | "store"]; a=reg; b=reg; c=reg -> AsmStore(a,b,c) | ["JMP" | "jmp"]; l=label -> AsmJmp(l) | ["BEQ" | "beq"]; a=reg; b=reg; l=label -> AsmBeq(a,b,l) | ["BNE" | "bne"]; a=reg; b=reg; l=label -> AsmBne(a,b,l) | ["SLT" | "slt"]; a=reg; b=reg; c=reg -> AsmSlt(a,b,c) ] ]; asmlistr: [ [ l=label; ":"; i = asmistr -> (l,i) | i = asmistr -> ("",i) ] ]; asmline: [ [ l=label; ":"; i = asmistr; c=opt_comment -> AsmIstr (l,i) | i = asmistr; c=opt_comment -> AsmIstr ("",i) | c=opt_comment -> AsmComment c | "DEBUG"; "REG"; r=reg; c=opt_comment -> AsmDebugReg r | "DEBUG"; "MEM"; `INT(l0,_); `INT(l1,_); c=opt_comment -> AsmDebugMem (l0,l1) ] ]; END ;;
(* ocamlc -c -I +camlp4 -pp camlp4of.opt asmi.ml *) (* camlp4 main.cmo *) #use "set.ml";; #use "asm-syntax.ml";; #use "asm-prettyp.ml";; #use "asm-interpreter.ml";; #use "asm-parser.ml";; let parse_asmline s = AsmGram.parse_string asmline (Loc.mk "<string>") s;; let debug_reg r (dr,dm) = (union [r] dr, dm);; let debug_mem (l0,l1) (dr,dm) = (dr,union [(l0,l1)] dm);; let rec parse_loop p n d = try let s = read_line () in (match parse_asmline s with AsmIstr (l,istr) -> parse_loop ((l,istr)::p) (n+1) d | AsmComment c -> parse_loop p (n+1) d | AsmDebugReg r -> parse_loop p (n+1) (debug_reg r d) | AsmDebugMem (l0,l1) -> parse_loop p (n+1) (debug_mem (l0,l1) d)) with End_of_file -> (AsmProg (List.rev p),d) | Loc.Exc_located (_, x) -> failwith ("Parse error at line " ^ (string_of_int n)) ;; let _ = let (p,d) = parse_loop [] 1 ([],[]) in print_string ("Program:\n" ^ (string_of_asmprog p) ^ "\n"); print_string (string_of_asmdump (asm_dump_prog p d));;
#!/bin/bash ERROR=-1 # numero minimo di argomenti MINARGS=1 # numero massimo di argomenti (input_file, output_file e opzione check-array-bounds) MAXARGS=1 #numero di argomenti con cui e' stato chiamato lo script ARGC=$# if [ $ARGC -lt $MINARGS ]; then echo "asmi: no input file" exit $ERROR fi if [ $ARGC -gt $MAXARGS ]; then echo "asmi: wrong number of arguments" exit $ERROR fi if [ $ARGC -eq $MINARGS ] && [ -f $1 ]; then camlp4 asmi.cmo < $1 exit 0 else echo "asmi: file" $1 ": no such file" exit $ERROR fi