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