Add all the assignment code.

Signed-off-by: jmug <u.g.a.mariano@gmail.com>

README.md

@@ -1,3 +1,7 @@
 # CS153
 
-Following Harvard's CS153 compiler class
+Following Harvard's CS153 compiler class
+
+Link from Harvard: https://canvas.harvard.edu/courses/124796
+Link from UPenn: https://www.seas.upenn.edu/~cis5521/current/
+Another alternative link: https://ilyasergey.net/CS4212/

hw1/.devcontainer/.zshrc

@@ -0,0 +1,13 @@
+autoload -U colors && colors
+precmd() {
+   drawline=""
+   for i in {1..$COLUMNS}; drawline=" $drawline"
+   drawline="%U${drawline}%u"
+   PS1="%F{252}${drawline}
+%B%F{124}%n:%~>%b%f "
+}
+
+eval $(opam env)
+
+alias ls="ls --color"
+

hw1/.devcontainer/Dockerfile

@@ -0,0 +1,79 @@
+FROM ubuntu:20.04
+
+## BEGIN: RUNS AS ROOT
+
+# Create a user
+
+ARG USERNAME=cs131
+ARG USER_UID=1000
+ARG USER_GID=$USER_UID
+
+ENV TZ='Asia/Shanghai'
+# !!![zjy] apt change ustc source
+RUN apt-get update -y \
+    && apt-get install -y --no-install-recommends \
+    apt-transport-https \
+    ca-certificates \
+    dos2unix \
+    tzdata \
+    && sed -i "s@http://.*.ubuntu.com@https://mirrors.ustc.edu.cn@g" /etc/apt/sources.list \
+    && rm -rf /var/apt/cache/*
+
+RUN groupadd --gid $USER_GID $USERNAME \
+    # [Optional] Add sudo support. Omit if you don't need to install software after connecting.
+    && apt-get update \
+    && apt-get install -y sudo \
+    && echo $USERNAME ALL=\(root\) NOPASSWD:ALL > /etc/sudoers.d/$USERNAME \
+    && chmod 0440 /etc/sudoers.d/$USERNAME
+
+
+## Hack needs root permissions
+
+# See hack.sh
+COPY hack.sh /tmp/hack.sh
+# windows compatibility
+RUN dos2unix /tmp/hack.sh
+RUN chmod +x /tmp/hack.sh
+RUN /tmp/hack.sh
+
+RUN apt-get update -y
+RUN apt-get install -y build-essential
+RUN apt-get install -y m4
+RUN apt-get install -y opam
+RUN apt-get install -y clang
+RUN apt-get install -y time
+RUN apt-get install -y zip
+# !!![zjy] install zsh first then set user
+RUN apt-get install -y zsh
+
+# !!![zjy] install zsh first then set user
+RUN useradd --uid $USER_UID --gid $USER_GID -m $USERNAME --shell /bin/zsh 
+
+
+## Set up user environmnent
+COPY .zshrc /home/$USERNAME/
+RUN dos2unix /home/$USERNAME/.zshrc
+RUN chown $USERNAME /home/$USERNAME/.zshrc
+
+## Run in usermode
+
+# [Optional] Set the default user. Omit if you want to keep the default as root.
+USER $USERNAME
+
+RUN mkdir -p /home/$USERNAME/.local/state/
+RUN touch /home/$USERNAME/.local/state/utop-history
+
+# Configure opam/ocaml
+# !!![zjy] change default repo to github (SJTU repo is failed)
+# RUN opam init --yes --disable-sandboxing default https://github.com/ocaml/opam-repository.git
+RUN opam init -y --disable-sandboxing --compiler=4.14.1
+# RUN opam switch create 4.14.1 ocaml-base-compiler.4.14.1
+RUN opam switch 4.14.1
+RUN opam install --yes dune
+RUN opam install --yes num
+RUN opam install --yes menhir
+RUN opam install -y utop
+RUN opam install -y ocamlformat
+RUN opam install -y ocaml-lsp-server
+RUN eval `opam config env`
+

hw1/.devcontainer/devcontainer.json

@@ -0,0 +1,30 @@
+// For format details, see https://aka.ms/devcontainer.json. For config options, see the
+// README at: https://github.com/devcontainers/templates/tree/main/src/ubuntu
+{
+	"name": "Ubuntu",
+	// Or use a Dockerfile or Docker Compose file. More info: https://containers.dev/guide/dockerfile
+	"build": { 
+		"dockerfile": "Dockerfile"
+	},
+	
+	// Features to add to the dev container. More info: https://containers.dev/features.
+	// "features": {},
+
+	// Use 'forwardPorts' to make a list of ports inside the container available locally.
+	// "forwardPorts": [],
+
+	// Use 'postCreateCommand' to run commands after the container is created.
+	// "postCreateCommand": "uname -a",
+
+	// Configure tool-specific properties.
+	"customizations": {
+		"vscode": {
+			"extensions": [
+				"ocamllabs.ocaml-platform"
+			]
+		}
+	}
+
+	// Uncomment to connect as root instead. More info: https://aka.ms/dev-containers-non-root.
+	// "remoteUser": "root"
+}

hw1/.devcontainer/hack.sh

@@ -0,0 +1,17 @@
+#!/usr/bin/env bash
+
+### HACK - workaround ubuntu libc6 version number bug see: https://forum.odroid.com/viewtopic.php?p=344373
+
+mv /bin/uname /bin/uname.orig
+tee -a /bin/uname <<EOF
+#!/bin/bash
+if [[ \$1 == "-r" ]]; then
+echo '4.9.250';
+exit
+else
+uname.orig \$1
+fi
+EOF
+
+chmod 755 /bin/uname
+### END HACK

hw1/.gitignore

@@ -0,0 +1,6 @@
+.vscode
+_build
+bin/main.exe
+oatc
+ocamlbin
+*~

hw1/.ocamlformat

@@ -0,0 +1,2 @@
+profile = default
+version = 0.26.1

hw1/.ocamlinit

@@ -0,0 +1,6 @@
+#use "topfind";;
+#require "str";;
+#require "unix";;
+
+#use_output "dune top";;
+

hw1/Makefile

@@ -0,0 +1,30 @@
+SUBMIT := $(shell cat submit_zip_contents.txt)
+HWNAME := hw1
+TIMESTAMP := $(shell /bin/date "+%Y-%m-%d-%H:%M:%S")
+ZIPNAME := $(HWNAME)-submit-$(TIMESTAMP).zip
+
+.PHONY: all oatc test clean zip
+
+all: oatc
+
+dev:
+	dune build --watch --terminal-persistence=clear-on-rebuild
+
+oatc: 
+	dune build
+	@cp bin/main.exe oatc
+
+test: oatc
+	./oatc --test
+
+utop:
+	utop
+
+zip: $(SUBMIT)
+	zip '$(ZIPNAME)' $(SUBMIT)	
+
+clean:
+	dune clean
+	rm -rf oatc ocamlbin bin/main.exe
+
+# 

hw1/README.md

@@ -0,0 +1,11 @@
+# HW1: Hellocaml!
+
+Quick Start:
+
+1. open the folder in VSCode (it will prompt you to "Reopen in dev container" -- do that)
+2. start an OCaml sandbox terminal
+3. run `make test` from the command line
+4. open `bin/hellocaml.ml`
+
+See the general toolchain and project instructions on the course web site. The course web pages have a link to the html version of the homework instructions, [HW1: Hellocaml — CS131 2024](https://faculty.sist.shanghaitech.edu.cn/cs131/hw1/doc/hw1-hellocaml.html), which are also included [here](doc/hw1-hellocaml.rst).
+

hw1/bin/dune

@@ -0,0 +1,21 @@
+(library
+ (name hellocaml)
+ (modules hellocaml))
+
+(env
+ (dev
+  (flags
+   (:standard -w "+a-4-7-9-27-29-30-32..42-44-45-48-50-60-66..70")
+   ))) 
+
+(executable
+ (public_name main)
+ (name main)
+ (modules main)
+ (promote (until-clean))
+ (libraries
+; OCaml standard libraries  
+; project libraries
+  util
+  studenttests
+  gradedtests))

hw1/bin/main.ml

@@ -0,0 +1,45 @@
+(* CIS341 main test harness *)
+(* Author: Steve Zdancewic  *)
+
+(* Do NOT modify this file -- we will overwrite it with our *)
+(* own version when we test your homework.                  *)
+
+open Util.Assert
+open Arg
+
+exception Ran_tests
+
+let worklist = ref []
+
+let suite = ref (Studenttests.student_tests @ Gradedtests.graded_tests)
+
+let exec_tests () =
+  let o = run_suite !suite in
+  Printf.printf "%s\n" (outcome_to_string o) ;
+  raise Ran_tests
+
+
+let do_one_file fn =
+  let _ = Printf.printf "Processing: %s\n" fn in
+  ()
+
+
+(* Use the --test option to run unit tests and the quit the program. *)
+let argspec =
+  [ ("--test", Unit exec_tests, "run the test suite, ignoring other inputs") ]
+  
+
+let _ =
+  try
+    Arg.parse
+      argspec
+      (fun f -> worklist := f :: !worklist)
+      "CIS341 main test harness \n" ;
+    match !worklist with
+    | [] ->
+        print_endline "* Nothing to do"
+    | _ ->
+        List.iter do_one_file !worklist
+  with
+  | Ran_tests ->
+      ()

hw1/doc/hw1-hellocaml.rst

@@ -0,0 +1,141 @@
+.. -*- mode: rst -*-
+
+.. include:: course.links
+   
+.. _hellocaml:
+
+HW1: Hellocaml
+==============
+
+Overview
+--------
+
+This project provides a refresher on OCaml programming and some
+warm-up exercises involving tree manipulation and recursive
+programming (both of which will be highly useful when building the
+compiler). It will also familiarize you with the basic workflow of the
+projects in this course, including the testing framework that we will
+use to (partially) automate the grading of your projects.
+
+Before you begin
+----------------
+
+For help on how to get started with OCaml see the :ref:`toolchain web pages <toolchain>`
+and the `OCaml web site <https://ocaml.org/>`_.
+
+Please also take some time to skim the available resources on the
+course homepage -- in particular, the book `Introduction to Objective
+Caml <../../../current/_static/files/ocaml-book.pdf>`_
+provides a very good reference for learning OCaml. In the problems
+below when you see a note like "See IOC 5.2" please refer to the
+corresponding section of the book.
+
+
+**Getting Started**
+
+Unlike future projects, most of the instructions for this project are
+found as comments in the source files. To get started on this project, 
+run ``make`` from the project root directory (in VSCode or in a terminal) 
+and then continue to the ``bin/hellocaml.ml`` file and follow the instructions 
+(in comments) there.
+
+**Building the Project**
+
+It is recommended that you compile your projects from the command
+line, using ``make``. We have included a ``Makefile`` that provides
+several make targets that can help you with the homework::
+
+  make       --  builds oatc using dune
+  make dev   --  runs dune build in "watch" mode for more interactive errors
+  make test  --  runs the test suite
+  make clean --  cleans your project directory
+  make utop  --  starts a utop for the project
+  make zip   --  creates a zip file with the code you need to submit
+
+For example, using make we can build the project and run the tests all
+in one go::
+
+  > make test
+  dune build
+  ... [[ warnings omitted ]]
+  ./oatc --test        
+  Running test Student-Provided Tests For Problem 1-3
+  Running test Problem1-1
+  Running test Problem1-2
+  ...
+
+Command-line Running and Testing Projects
+-----------------------------------------
+
+After compiling the project, you can run it from the command line.
+
+The projects in this course are designed to have a single, top-level
+entry point in the file ``main.ml``. Upon running ``make``, it compiles to
+an executable ``main.exe``, and copies it as ``oatc`` to the root of the project.
+
+The ``oatc`` program provides a test harness that can be used from the command
+line with a variety of switches and command-line arguments, just like
+any other compiler. You can always check which command-line switches
+are available by using the ``-help`` or ``--help`` flags. For example,
+HW1 supports only one interesting command-line option ``--test``::
+
+ > ./oatc -help
+ Main test harness 
+
+   --test run the test suite, ignoring other inputs
+   -help  Display this list of options
+   --help  Display this list of options
+
+All of our projects will support the ``--test`` option, which will
+simply run the project's unit tests, print a summary of the results
+and then exit. It might give output something like this (bogus sample)
+that will give you some idea about how much of the project you've
+completed::
+
+ > ./oatc --test
+
+ Test1:
+   case1: failed - not equal
+   case2: failed - assert fail
+   case3: failed - test threw an unknown exception
+ Test2:
+   OK
+ Test3 (3/10 points)
+   case1: failed - not equal
+   case2: failed - not equal
+   case3: passed
+ Test4-Manual (0/3 points = 0/1 tests)
+ FAILED - manually: assert fail
+ Test5 (??/20 points):
+   Hidden
+ Test5 (10/10 points):
+   OK
+ ---------------------------------------------------
+ Passed: 5/10
+ Failed: 5/10
+ Score: 13/20 (given)
+        ??/20 (hidden)
+
+**Note:** problems that will be manually graded after you submit the
+homework are considered to "fail" according to the test harness.
+	
+Once the compiler projects reach the stage where we can generate good
+assembly output, ``oatc`` will support more interesting
+command-line options and be able to process input files in a way that
+should be familiar if you've ever used gcc or another compiler.
+
+Grading
+-------
+
+Submit your solution to this assignment by following the :ref:`submission instructions <submit>`
+
+**Projects that do not compile will receive no credit!**
+
+Your grade for this project will be based on:
+
+* 64 Points for the test cases that are visible to you
+* 23 Points for the hidden test cases
+* 13 Points of manually graded parts
+   * 3 points for the type annotations in problem 2-1 (manually graded)
+   * 5 points for proper tail call implementation in 3-4 (manually graded)
+   * 5 points for "Style" and additional test cases for 4-3 and 5 (manually graded)

hw1/dune-project

@@ -0,0 +1,2 @@
+(lang dune 2.9)
+(name hw1)

hw1/lib/util/assert.ml

@@ -0,0 +1,195 @@
+(* CIS341 Assertion Testing and Grading Infrastructure *)
+(* Author: Steve Zdancewic                             *)
+
+(* Do NOT modify this file -- we will overwrite it     *)
+(* with our own version when testing your code.        *)
+
+(* An assertion is just a unit->unit function that either *)
+(* succeeds silently or throws an Failure exception.       *)
+type assertion = unit -> unit
+
+type 'a test =
+  | GradedTest of string * int * (string * 'a) list
+  | Test of string * (string * 'a) list
+
+type suite = assertion test list
+
+(**************)
+(* Assertions *)
+
+let assert_eq v1 v2 : assertion =
+ fun () -> if v1 <> v2 then failwith "not equal" else ()
+
+
+let assert_eqf f v2 : assertion =
+ fun () -> if f () <> v2 then failwith "not equal" else ()
+
+
+let assert_eqfs f v2 : assertion =
+ fun () ->
+  let s1 = f () in
+  if s1 <> v2
+  then failwith @@ Printf.sprintf "not equal\n\texpected:%s\n\tgot:%s\n" v2 s1
+  else ()
+
+
+let assert_fail : assertion = fun () -> failwith "assert fail"
+
+exception Timeout
+
+let timeout_assert (time : int) (a : assertion) : assertion =
+ fun () ->
+  let handler = Sys.Signal_handle (fun _ -> raise Timeout) in
+  let old = Sys.signal Sys.sigalrm handler in
+  let reset_sigalrm () = Sys.set_signal Sys.sigalrm old in
+  ignore (Unix.alarm time) ;
+  try
+    a () ;
+    reset_sigalrm ()
+  with
+  | Timeout ->
+      reset_sigalrm () ;
+      failwith @@ Printf.sprintf "Timed out after %d seconds" time
+  | exc ->
+      reset_sigalrm () ;
+      raise exc
+
+
+let timeout_test (time : int) (t : assertion test) : assertion test =
+  let map_timeout l = List.map (fun (i, a) -> (i, timeout_assert time a)) l in
+  match t with
+  | GradedTest (s, i, ls) ->
+      GradedTest (s, i, map_timeout ls)
+  | Test (s, ls) ->
+      Test (s, map_timeout ls)
+
+
+let timeout_suite (time : int) (s : suite) : suite =
+  List.map (timeout_test time) s
+
+
+(***************************)
+(* Generating Test Results *)
+
+type result =
+  | Pass
+  | Fail of string
+
+type outcome = result test list
+
+let run_assertion (f : assertion) : result =
+  try
+    f () ;
+    Pass
+  with
+  | Failure m ->
+      Fail m
+  | e ->
+      Fail ("test threw exception: " ^ Printexc.to_string e)
+
+
+let run_test (t : assertion test) : result test =
+  let run_case (cn, f) = (cn, run_assertion f) in
+  match t with
+  | GradedTest (n, s, cases) ->
+      Printf.eprintf "Running test %s\n%!" n ;
+      GradedTest (n, s, List.map run_case cases)
+  | Test (n, cases) ->
+      Printf.eprintf "Running test %s\n%!" n ;
+      Test (n, List.map run_case cases)
+
+
+let run_suite (s : suite) : outcome = List.map run_test s
+
+(***********************)
+(* Reporting functions *)
+
+let result_test_to_string (name_pts : string) (r : result test) : string =
+  let string_of_case (name, res) =
+    match res with
+    | Pass ->
+        "passed - " ^ name
+    | Fail msg ->
+        "FAILED - " ^ name ^ ": " ^ msg
+  in
+  match r with
+  | GradedTest (_, _, cases) | Test (_, cases) ->
+      name_pts
+      ^ List.fold_left
+          (fun rest case -> rest ^ "\n" ^ string_of_case case)
+          ""
+          cases
+
+
+(* Number of digits of precision for a float x. Argument p is the number of decimal places desired (must be at least 1) *)
+let prec_digits p x = (int_of_float @@ floor @@ log10 x) + (1 + p)
+
+(* returns (name_pts, passed, failed, total, points_earned, max_given, max_hidden) *)
+let get_results (t : result test) =
+  let num_passed cases =
+    List.fold_left
+      (fun cnt (_, r) -> match r with Pass -> cnt + 1 | _ -> cnt)
+      0
+      cases
+  in
+  let num_failed cases =
+    List.fold_left
+      (fun cnt (_, r) -> match r with Fail _ -> cnt + 1 | _ -> cnt)
+      0
+      cases
+  in
+  match t with
+  | GradedTest (name, pts, cases) ->
+      let passed = num_passed cases in
+      let failed = num_failed cases in
+      let total = List.length cases in
+      if total > 0 
+      then
+        let points_earned = ((float_of_int passed) /. (float_of_int total)) *. (float_of_int pts) in
+        let name_pts = 
+          Printf.sprintf "%s (%1.*g/%d points = %d/%d tests)" name (prec_digits 1 points_earned) points_earned pts passed total 
+        in
+        (name_pts, passed, failed, total, points_earned, pts, 0)
+      else
+        let name_pts = Printf.sprintf "%s (?/%d points)" name pts in
+        (name_pts, passed, failed, total, 0.0, 0, pts)
+  | Test (name, cases) ->
+      let total = List.length cases in
+      let passed = num_passed cases in
+      let failed = num_failed cases in
+      (name, passed, failed, total, 0.0, 0, 0)
+
+
+let outcome_to_string (o : outcome) : string =
+  let sep = "\n---------------------------------------------------\n" in
+  let helper (passed, failed, total, pts, maxg, maxh, str) (t : result test) =
+    let name_pts, p, f, tot, s, mg, mh = get_results t in
+    ( passed + p
+    , failed + f
+    , total + tot
+    , s +. pts
+    , maxg + mg
+    , maxh + mh
+    , str
+      ^ "\n"
+      ^
+      if f > 0
+      then result_test_to_string name_pts t
+      else if tot > 0
+      then name_pts ^ ":\n  OK"
+      else name_pts ^ ":\n  Hidden" )
+  in
+  let p, f, tot, pts, maxg, maxh, str =
+    List.fold_left helper (0, 0, 0, 0.0, 0, 0, "") o
+  in
+  str
+  ^ sep
+  ^ Printf.sprintf
+      "Passed: %d/%d\n\
+       Failed: %d/%d\n\
+       Score: %1.1f/%d (given)\n\
+      \       ?/%d (hidden)"
+      p tot
+      f tot
+      pts maxg
+      maxh

hw1/lib/util/assert.mli

@@ -0,0 +1,57 @@
+(* CIS341 Assertion Testing and Grading Infrastructure *)
+(* Author: Steve Zdancewic                             *)
+
+(* Do NOT modify this file -- we will overwrite it     *)
+(* with our own version when testing your code.        *)
+
+exception Timeout
+
+(* An assertion is just a unit->unit function that either *)
+(* succeeds silently or throws an Failure exception.       *)
+type assertion = unit -> unit
+
+type 'a test =
+  | GradedTest of string * int * (string * 'a) list
+  | Test of string * (string * 'a) list
+
+type suite = assertion test list
+
+(**************)
+(* Assertions *)
+
+val assert_eq : 'a -> 'a -> assertion
+
+val assert_eqf : (unit -> 'a) -> 'a -> assertion
+
+val assert_eqfs : (unit -> string) -> string -> assertion
+
+val assert_fail : assertion
+
+val timeout_assert : int -> assertion -> assertion
+
+val timeout_test : int -> assertion test -> assertion test
+
+val timeout_suite : int -> suite -> suite
+
+(***************************)
+(* Generating Test Results *)
+
+type result =
+  | Pass
+  | Fail of string
+
+type outcome = result test list
+
+val run_assertion : assertion -> result
+
+val run_test : assertion test -> result test
+
+val run_suite : suite -> outcome
+
+(***********************)
+(* Reporting functions *)
+
+val result_test_to_string : string -> result test -> string
+
+(* val get_results result test -> (string * int * int * int * float * int * int) *)
+val outcome_to_string : outcome -> string

hw1/lib/util/dune

@@ -0,0 +1,3 @@
+(library
+  (name util)
+  (libraries str unix))

hw1/lib/util/platform.ml

@@ -0,0 +1,237 @@
+(* -------------------------------------------------------------------------- *)
+(** Assembling and linking for X86.  Depends on the underlying OS platform    *)
+
+open Printf
+open Unix
+
+exception PlatformError of string * string
+
+(* paths -------------------------------------------------------------------- *)
+let path_sep = "/"
+
+let bin_path = "./bin"
+
+let dot_path = "./"
+
+let executable_name = ref "a.out"
+
+let output_path = ref "output"
+
+let libs = ref []
+
+let lib_paths = ref []
+
+let lib_search_paths = ref []
+
+let include_paths = ref []
+
+(* unix utility scripts ----------------------------------------------------- *)
+let pp_cmd = ref "cpp -E "
+
+let rm_cmd = ref "rm -rf "
+
+(* -------------------------------------------------------------------------- *)
+(* Platform specific configuration: Unix/Linux vs. Mac OS X                   *)
+
+let os =
+  let ic = Unix.open_process_in "uname -s" in
+  let uname = input_line ic in
+  let () = close_in ic in
+  uname
+
+let cpu = 
+  let ic = Unix.open_process_in "uname -m" in
+  let cpuname = input_line ic in
+  let () = close_in ic in
+  cpuname
+
+(* One of "Darwin" or "Linux" *)
+
+let linux = ref false
+
+let mangle name = if !linux then name else "_" ^ name
+
+let osx_target_triple = "x86_64-apple-macosx10.13.0"
+
+let linux_target_triple = "x86_64-unknown-linux"
+
+let target_triple = ref osx_target_triple
+
+let platform_flags = ref ""
+
+(* Set the link commands properly, ensure output directory exists *)
+let configure_os () =
+  if os = "Linux"
+  then (
+    linux := true ;
+    target_triple := linux_target_triple ;
+    platform_flags := "" )
+  else if os = "Darwin"
+  then (
+    linux := false ;
+    target_triple := osx_target_triple ;
+    platform_flags := "-fno-asynchronous-unwind-tables -mstackrealign" )
+  else failwith @@ "Unsupported OS detected: " ^ os
+
+
+(* verbose compiler output -------------------------------------------------- *)
+let verbose = ref false
+
+let verb msg =
+  if !verbose
+  then (
+    print_string msg ;
+    flush Stdlib.stdout )
+
+
+let verb_os () =
+  verb
+  @@ Printf.sprintf
+       "* PLATFORM: %s TRIPLE: %s FLAGS %s\n"
+       os
+       !target_triple
+       !platform_flags
+
+
+let enable_verbose () =
+  verbose := true ;
+  verb_os ()
+
+
+(* create the output directory, which is assumed to exist *)
+let create_output_dir () =
+  try ignore (stat !output_path) with
+  | Unix_error (ENOENT, _, _) ->
+      verb @@ Printf.sprintf "creating output directory: %s\n" !output_path ;
+      mkdir !output_path 0o755
+
+
+(* clang invocation stuff --------------------------------------------------- *)
+let common_flags = "-Wno-override-module"
+
+let link_flags = "-Wno-unused-command-line-argument -mstackrealign"
+
+let clang_ll_mode = "-S"
+
+let as_mode = "-c"
+
+let rosetta_prefix = "arch -x86_64 "
+
+let prefix = if cpu = "arm64" then rosetta_prefix else ""
+
+let opt_level = ref "-O1 -Wall"
+
+let clang args = Printf.sprintf "%sclang %s -o " prefix (String.concat " " args)
+
+let clang_cmd () =
+  clang [ clang_ll_mode; !opt_level; common_flags; !platform_flags ]
+
+
+let as_cmd () = clang [ as_mode; !opt_level; common_flags; !platform_flags ]
+
+let link_cmd () = clang [ common_flags; !opt_level; !platform_flags; link_flags ]
+
+(* filename munging --------------------------------------------------------- *)
+let path_to_basename_ext (path : string) : string * string =
+  (* The path is of the form ... "foo/bar/baz/<file>.ext" *)
+  let paths = Str.split (Str.regexp_string path_sep) path in
+  let _ =
+    if List.length paths = 0 then failwith @@ sprintf "bad path: %s" path
+  in
+  let filename = List.hd (List.rev paths) in
+  match Str.split (Str.regexp_string ".") filename with
+  | [ root ] ->
+      (root, "")
+  | [ root; ext ] ->
+      (root, ext)
+  | _ ->
+      failwith @@ sprintf "bad filename: %s" filename
+
+
+(* compilation and shell commands-------------------------------------------- *)
+
+(* Platform independent shell command *)
+let sh (cmd : string) (ret : string -> int -> 'a) : 'a =
+  verb (sprintf "* %s\n" cmd) ;
+  match system cmd with
+  | WEXITED i ->
+      ret cmd i
+  | WSIGNALED i ->
+      raise (PlatformError (cmd, sprintf "Signaled with %d." i))
+  | WSTOPPED i ->
+      raise (PlatformError (cmd, sprintf "Stopped with %d." i))
+
+(* Platform independent shell command with a timeout (in seconds) *)
+let timeout_sh (time: int)(cmd : string) (ret : string -> int -> 'a) : 'a =
+  let timeout_cmd = sprintf "%s/timeout3 -t %d %s" bin_path time cmd in
+  verb (sprintf "* %s\n" timeout_cmd) ;
+  match system timeout_cmd with
+  | WEXITED i ->
+      ret cmd i
+  | WSIGNALED i ->
+      if i == Sys.sigterm
+      then raise (PlatformError (cmd, sprintf "Timed-out after %d s" time))
+      else raise (PlatformError (cmd, sprintf "Signaled with %d." i))
+  | WSTOPPED i ->
+      raise (PlatformError (cmd, sprintf "Stopped with %d." i))
+
+
+(* Generate a file name that does not already exist.
+   basedir includes the path separator
+*)
+let gen_name (basedir : string) (basen : string) (baseext : string) : string =
+  let rec nocollide ofs =
+    let nfn =
+      sprintf
+        "%s/%s%s%s"
+        basedir
+        basen
+        (if ofs = 0 then "" else "_" ^ string_of_int ofs)
+        baseext
+    in
+    try
+      ignore (stat nfn) ;
+      nocollide (ofs + 1)
+    with
+    | Unix_error (ENOENT, _, _) ->
+        nfn
+  in
+  nocollide 0
+
+
+let raise_error cmd i =
+  if i <> 0 then raise (PlatformError (cmd, sprintf "Exited with status %d." i))
+
+
+let ignore_error _ _ = ()
+
+let preprocess (dot_oat : string) (dot_i : string) : unit =
+  sh
+    (sprintf
+       "%s%s %s %s"
+       !pp_cmd
+       (List.fold_left (fun s i -> s ^ " -I" ^ i) "" !include_paths)
+       dot_oat
+       dot_i)
+    raise_error
+
+
+let clang_compile (dot_ll : string) (dot_s : string) : unit =
+  sh (sprintf "%s%s %s" (clang_cmd ()) dot_s dot_ll) raise_error
+
+
+let assemble (dot_s : string) (dot_o : string) : unit =
+  sh (sprintf "%s%s %s" (as_cmd ()) dot_o dot_s) raise_error
+
+
+let link (mods : string list) (out_fn : string) : unit =
+  sh
+    (sprintf
+       "%s%s %s %s %s %s"
+       (link_cmd ())
+       out_fn
+       (String.concat " " (mods @ !lib_paths))
+       (List.fold_left (fun s i -> s ^ " -L" ^ i) "" !lib_search_paths)
+       (List.fold_left (fun s i -> s ^ " -I" ^ i) "" !include_paths)
+       (List.fold_left (fun s l -> s ^ " -l" ^ l) "" !libs))
+    raise_error

hw1/lib/util/range.ml

@@ -0,0 +1,56 @@
+open Lexing
+
+type pos = int * int (* Line number and column *)
+
+type t = string * pos * pos
+
+let line_of_pos (l, _) = l
+
+let col_of_pos (_, c) = c
+
+let mk_pos line col = (line, col)
+
+let file_of_range (f, _, _) = f
+
+let start_of_range (_, s, _) = s
+
+let end_of_range (_, _, e) = e
+
+let mk_range f s e = (f, s, e)
+
+let valid_pos (l, c) = l >= 0 && c >= 0
+
+let merge_range ((f, s1, e1) as r1) ((f', s2, e2) as r2) =
+  if f <> f'
+  then
+    failwith
+    @@ Printf.sprintf "merge_range called on different files: %s and %s" f f'
+  else if not (valid_pos s1)
+  then r2
+  else if not (valid_pos s2)
+  then r1
+  else mk_range f (min s1 s2) (max e1 e2)
+
+
+let string_of_range (f, (sl, sc), (el, ec)) =
+  Printf.sprintf "%s:[%d.%d-%d.%d]" f sl sc el ec
+
+
+let ml_string_of_range (f, (sl, sc), (el, ec)) =
+  Printf.sprintf "(\"%s\", (%d, %d), (%d, %d))" f sl sc el ec
+
+
+let norange = ("__internal", (0, 0), (0, 0))
+
+(* Creates a Range.pos from the Lexing.position data *)
+let pos_of_lexpos (p : position) : pos =
+  mk_pos p.pos_lnum (p.pos_cnum - p.pos_bol)
+
+
+let mk_lex_range (p1 : position) (p2 : position) : t =
+  mk_range p1.pos_fname (pos_of_lexpos p1) (pos_of_lexpos p2)
+
+
+(* Expose the lexer state as a Range.t value *)
+let lex_range lexbuf : t =
+  mk_lex_range (lexeme_start_p lexbuf) (lexeme_end_p lexbuf)

hw1/lib/util/range.mli

@@ -0,0 +1,53 @@
+(* Ranges and utilities on ranges. *)
+
+(* A range represents a segment of text in a given file; it has a
+ * beginning and ending position specified in terms of line and column
+ * numbers. A range is associated with tokens during lexing to allow
+ * the compiler to give better error messages during lexing and
+ * parsing.  
+ *)
+
+(* a position in the source file; line number and column *)
+type pos = int * int
+
+(* a range of positions in a particular file *)
+type t = string * pos * pos
+
+(* line of position *)
+val line_of_pos : pos -> int
+
+(* column of position *)
+val col_of_pos : pos -> int
+
+(* new position with given line and col *)
+val mk_pos : int -> int -> pos
+
+(* the filename a range is in *)
+val file_of_range : t -> string
+
+(* the beginning of the range *)
+val start_of_range : t -> pos
+
+(* the end of the range *)
+val end_of_range : t -> pos
+
+(* create a new range from the given filename and start, end positions *)
+val mk_range : string -> pos -> pos -> t
+
+(* merge two ranges together *)
+val merge_range : t -> t -> t
+
+(* pretty-print a range *)
+val string_of_range : t -> string
+
+(* print a range as an ocaml value *)
+val ml_string_of_range : t -> string
+
+(* use to tag generated AST nodes where range does not apply *)
+val norange : t
+
+val pos_of_lexpos : Lexing.position -> pos
+
+val mk_lex_range : Lexing.position -> Lexing.position -> t
+
+val lex_range : Lexing.lexbuf -> t

hw1/submit_zip_contents.txt

@@ -0,0 +1,2 @@
+bin/hellocaml.ml
+test/studenttests.ml

hw1/test/dune

@@ -0,0 +1,11 @@
+(library
+  (name studenttests)
+  (modules studenttests)
+  (libraries util hellocaml))
+
+(library
+ (name gradedtests)
+ (modules gradedtests)
+ (libraries util hellocaml))
+
+

hw1/test/gradedtests.ml

@@ -0,0 +1,187 @@
+open Util.Assert
+open Hellocaml
+
+(* Test suite for hellocaml.ml *)
+
+(* Do NOT modify this file -- we will overwrite it with our *)
+(* own version when we test your project.                   *)
+
+(* These tests will be used to grade your assignment *)
+
+(*** Part 1 Tests ***)
+let part1_tests : suite = [
+  
+  (* assert_eq asserts that the two values are equal *)
+  GradedTest ("Problem1-1", 3, [
+    ("pieces", assert_eq pieces 8);  
+
+  (* assert_eqf f v 
+   * asserts that applying a unit-accepting function f 
+   * returns the value v *)
+    ("cube0", assert_eqf (fun () -> cube 0) 0);
+    ("cube1", assert_eqf (fun () -> cube 1) 1);
+    ("cube2", assert_eqf (fun () -> cube 2) 8);
+    ("cube3", assert_eqf (fun () -> cube (-1)) (-1));
+  ]);
+  
+  
+  
+  GradedTest ("Problem1-2", 3, [
+    ("cents_of1", assert_eqf (fun () -> cents_of 0 0 0 0) 0);
+    ("cents_of2", assert_eqf (fun () -> cents_of 1 1 1 1) 41);
+    ("cents_of3", assert_eqf (fun () -> cents_of 1 2 3 4) 64);
+    ("cents_of4", assert_eqf (fun () -> cents_of 1 0 0 0) 25);
+    ("cents_of5", assert_eqf (fun () -> cents_of 0 1 0 0) 10);
+    ("cents_of6", assert_eqf (fun () -> cents_of 0 0 1 0) 5);
+    ("cents_of7", assert_eqf (fun () -> cents_of 0 0 0 1) 1);
+  ]);
+  
+  GradedTest ("Problem1-3", 3, [
+    
+  ]);
+]
+
+(*** Part 2 Tests ***)
+let part2_tests : suite = [
+  GradedTest ("Problem2-1", 3, [
+    ("third_of_three1", assert_eqf (fun () -> third_of_three triple) "some string");
+    ("third_of_three2", assert_eqf (fun () -> third_of_three (1,2,3)) 3);
+    ("third_of_three3", assert_eqf (fun () -> third_of_three ((),"a",false)) false);
+  ]);
+  
+  GradedTest ("Problem2-1Manual", 3, [
+    
+  ]);
+  
+  GradedTest ("Problem2-2", 5, 
+    let id (x:int) : int = x in
+    let const3 (_:string) : int = 3 in [
+    ("compose_pair1", assert_eqf (fun () -> compose_pair (id, const3) "a") 3);
+    ("compose_pair2", assert_eqf (fun () -> compose_pair (fst, pair_up) "a") "a");
+    ("compose_pair3", assert_eqf (fun () -> compose_pair (double, fst) (pair_up 5)) 10); 
+  ]);
+]
+
+(*** Part 3 Tests ***)
+let part3_tests : suite = [
+  GradedTest ("Problem3-1", 5, [
+    ("list_to_mylist1", assert_eqf (fun () -> list_to_mylist []) Nil);
+    ("list_to_mylist2", assert_eqf (fun () -> list_to_mylist [1]) (Cons(1,Nil)));
+    ("list_to_mylist3", assert_eqf (fun () -> list_to_mylist ["a";"b"]) (Cons("a",Cons("b",Nil))));
+    ("list_to_mylist4", assert_eqf (fun () -> mylist_to_list (list_to_mylist [1;2;3;4;5])) [1;2;3;4;5]);
+  ]);
+  
+  GradedTest ("Problem3-2", 5, [
+    ("append1", assert_eqf (fun () -> append [] []) []);
+    ("append2", assert_eqf (fun () -> append [] [1]) [1]);
+    ("append3", assert_eqf (fun () -> append [1] []) [1]);
+    ("append4", assert_eqf (fun () -> append [1] [1]) [1;1]);
+    ("append5", assert_eqf (fun () -> append [1;2] [3]) [1;2;3]);
+    ("append6", assert_eqf (fun () -> append [1] [2;3]) [1;2;3]);
+    ("append7", assert_eqf (fun () -> append [true] [false]) [true;false]);
+  ]);
+  
+  GradedTest ("Problem3-3", 5, [
+    ("rev1", assert_eqf (fun () -> rev []) []);
+    ("rev2", assert_eqf (fun () -> rev [1]) [1]);
+    ("rev3", assert_eqf (fun () -> rev [1;2]) [2;1]);
+    ("rev4", assert_eqf (fun () -> rev ["a";"b"]) ["b";"a"]);
+    ("rev5", assert_eqf (fun () -> rev [1;2;3;4]) [4;3;2;1]);
+  ]);
+  
+  GradedTest ("Problem3-4", 5, [
+    ("rev_t1", assert_eqf (fun () -> rev_t []) []);
+    ("rev_t2", assert_eqf (fun () -> rev_t [1]) [1]);
+    ("rev_t3", assert_eqf (fun () -> rev_t [1;2]) [2;1]);
+    ("rev_t4", assert_eqf (fun () -> rev_t ["a";"b"]) ["b";"a"]);
+    ("rev_t5", assert_eqf (fun () -> rev_t [1;2;3;4]) [4;3;2;1]);
+  ]);
+  
+  GradedTest ("Problem3-4Manual", 5, [
+    
+  ]);
+  
+  GradedTest ("Problem3-5", 5, [
+    ("insert1", assert_eqf (fun () -> insert 1 []) [1]);
+    ("insert2", assert_eqf (fun () -> insert 1 [1]) [1]);
+    ("insert3", assert_eqf (fun () -> insert 1 [2]) [1;2]);
+    ("insert4", assert_eqf (fun () -> insert 1 [0]) [0;1]);
+    ("insert5", assert_eqf (fun () -> insert 1 [0;2]) [0;1;2]);
+    ("insert6", assert_eqf (fun () -> insert "b" ["a";"c"]) ["a";"b";"c"]);
+  ]); 
+  
+  GradedTest ("Problem3-6", 5, [
+    ("union1", assert_eqf (fun () -> union [] []) []);
+    ("union2", assert_eqf (fun () -> union [1] []) [1]);
+    ("union3", assert_eqf (fun () -> union [] [1]) [1]);
+    ("union4", assert_eqf (fun () -> union [1] [1]) [1]);
+    ("union5", assert_eqf (fun () -> union [1] [2]) [1;2]);
+    ("union6", assert_eqf (fun () -> union [2] [1]) [1;2]);
+    ("union7", assert_eqf (fun () -> union [1;3] [0;2]) [0;1;2;3]);
+    ("union8", assert_eqf (fun () -> union [0;2] [1;3]) [0;1;2;3]);
+  ]);
+]
+
+
+(*** Part 4 Tests ***)
+
+
+
+let part4_tests : suite = [
+  GradedTest ("Problem4-1", 5, [
+    ("vars_of1", assert_eqf (fun () -> vars_of e1) []);
+    ("vars_of2", assert_eqf (fun () -> vars_of e2) ["x"]);
+    ("vars_of3", assert_eqf (fun () -> vars_of e3) ["x"; "y"]);
+
+  ]);
+  
+  GradedTest ("Problem4-2", 5, [
+    ("lookup1", assert_eqf (fun () -> lookup "x" ctxt1) 3L);
+    ("lookup2", assert_eqf (fun () -> lookup "x" ctxt2) 2L);
+    ("lookup3", assert_eqf (fun () -> lookup "y" ctxt2) 7L);
+    ("lookup4", (fun () -> try ignore (lookup "y" ctxt1); failwith "bad lookup" with Not_found -> ()));
+    ("lookup5", assert_eqf (fun () -> lookup "x" [("x", 1L);("x", 2L)]) 1L);
+
+  ]);
+  
+  GradedTest ("Problem4-3", 5, [
+    ("interpret1", assert_eqf (fun () -> interpret ctxt1 e1) 6L);
+    ("interpret2", assert_eqf (fun () -> interpret ctxt1 e2) 4L);
+    ("interpret3", (fun () -> try ignore (interpret ctxt1 e3); failwith "bad interpret" with Not_found -> ()));
+  ]);
+  
+  GradedTest ("Problem4-3harder", 5, [
+  
+  ]);
+  
+  GradedTest ("Problem4-4", 5, [
+    ("optimize1", assert_eqf (fun () -> optimize (Add(Const 3L, Const 4L))) (Const 7L));
+    ("optimize2", assert_eqf (fun () -> optimize (Mult(Const 0L, Var "x"))) (Const 0L));
+    ("optimize3", assert_eqf (fun () -> optimize (Add(Const 3L, Mult(Const 0L, Var "x")))) (Const 3L));
+  ]);
+  
+  GradedTest ("Problem4-4harder", 5, [
+    
+  ]);
+  
+  GradedTest ("Problem4-4hardest", 5, [
+  
+  ]);
+ 
+  GradedTest ("Problem5", 5, [
+  
+  ]);
+]
+
+let style_test : suite = [
+  GradedTest ("StyleManual", 5, [
+  
+  ]);
+]
+
+let graded_tests : suite = 
+  part1_tests @
+  part2_tests @
+  part3_tests @
+  part4_tests @
+  style_test

hw1/test/studenttests.ml

@@ -0,0 +1,16 @@
+open Util.Assert
+open Hellocaml
+
+(* These tests are provided by you -- they will be graded manually *)
+
+(* You should also add additional test cases here to help you   *)
+(* debug your program.                                          *)
+
+let student_tests : suite = [
+  Test ("Student-Provided Tests For Problem 1-3", [
+    ("case1", assert_eqf (fun () -> failwith "Problem 3 case1 test unimplemented") prob3_ans );
+    ("case2", assert_eqf (fun () -> failwith "Problem 3 case2 test unimplemented") (prob3_case2 17) );
+    ("case3", assert_eqf (fun () -> prob3_case3) 0);
+  ]);
+  
+] 

hw2/.devcontainer/.zshrc

@@ -0,0 +1,13 @@
+autoload -U colors && colors
+precmd() {
+   drawline=""
+   for i in {1..$COLUMNS}; drawline=" $drawline"
+   drawline="%U${drawline}%u"
+   PS1="%F{252}${drawline}
+%B%F{124}%n:%~>%b%f "
+}
+
+eval $(opam env)
+
+alias ls="ls --color"
+

hw2/.devcontainer/Dockerfile

@@ -0,0 +1,73 @@
+FROM ubuntu:20.04
+
+## BEGIN: RUNS AS ROOT
+
+# Create a user
+
+ARG USERNAME=cis3410
+ARG USER_UID=1000
+ARG USER_GID=$USER_UID
+
+ENV TZ='Asia/Shanghai'
+# !!![zjy] apt change ustc source
+RUN apt-get update -y\
+    && apt-get install -y --no-install-recommends \
+    apt-transport-https \
+    ca-certificates \
+    tzdata \
+    && sed -i "s@http://.*.ubuntu.com@https://mirrors.ustc.edu.cn@g" /etc/apt/sources.list \
+    && rm -rf /var/apt/cache/*
+
+RUN groupadd --gid $USER_GID $USERNAME \
+    #
+    # [Optional] Add sudo support. Omit if you don't need to install software after connecting.
+    && apt-get update -y \
+    && apt-get install -y sudo \
+    && echo $USERNAME ALL=\(root\) NOPASSWD:ALL > /etc/sudoers.d/$USERNAME \
+    && chmod 0440 /etc/sudoers.d/$USERNAME
+
+## Hack needs root permissions
+
+# See hack.sh
+COPY hack.sh /tmp/hack.sh
+RUN chmod +x /tmp/hack.sh
+RUN /tmp/hack.sh
+
+RUN apt-get update -y
+RUN apt-get install -y build-essential
+RUN apt-get install -y m4
+RUN apt-get install -y opam
+RUN apt-get install -y clang
+RUN apt-get install -y time
+RUN apt-get install -y zip
+# !!![zjy] install zsh first then set user
+RUN apt-get install -y zsh
+
+# !!![zjy] install zsh first then set user
+RUN useradd --uid $USER_UID --gid $USER_GID -m $USERNAME --shell /bin/zsh 
+
+## Set up user environmnent
+COPY .zshrc /home/$USERNAME/
+RUN chown $USERNAME /home/$USERNAME/.zshrc
+
+## Run in usermode
+
+# [Optional] Set the default user. Omit if you want to keep the default as root.
+USER $USERNAME
+
+RUN mkdir -p /home/$USERNAME/.local/state/
+RUN touch /home/$USERNAME/.local/state/utop-history
+
+# Configure opam/ocaml
+# !!![zjy] change default repo to github (SJTU repo is failed)
+RUN opam init --yes --disable-sandboxing default https://github.com/ocaml/opam-repository.git
+RUN opam switch create 4.14.1 ocaml-base-compiler.4.14.1
+RUN opam switch 4.14.1
+RUN opam install -y dune
+RUN opam install -y num
+RUN opam install -y menhir
+RUN opam install -y utop
+RUN opam install -y ocamlformat
+RUN opam install -y ocaml-lsp-server
+RUN eval `opam config env`
+

hw2/.devcontainer/devcontainer.json

@@ -0,0 +1,31 @@
+// For format details, see https://aka.ms/devcontainer.json. For config options, see the
+// README at: https://github.com/devcontainers/templates/tree/main/src/ubuntu
+{
+	"name": "Ubuntu",
+	// Or use a Dockerfile or Docker Compose file. More info: https://containers.dev/guide/dockerfile
+	"build": { 
+		"dockerfile": "Dockerfile"
+	},
+	
+	// Features to add to the dev container. More info: https://containers.dev/features.
+	// "features": {},
+
+	// Use 'forwardPorts' to make a list of ports inside the container available locally.
+	// "forwardPorts": [],
+
+	// Use 'postCreateCommand' to run commands after the container is created.
+	// "postCreateCommand": "uname -a",
+
+	// Configure tool-specific properties.
+	"customizations": {
+		"vscode": {
+			"extensions": [
+			    "ocamllabs.ocaml-platform",
+			    "allanblanchard.ocp-indent"
+			]
+		}
+	}
+
+	// Uncomment to connect as root instead. More info: https://aka.ms/dev-containers-non-root.
+	// "remoteUser": "root"
+}

hw2/.devcontainer/hack.sh

@@ -0,0 +1,17 @@
+#!/usr/bin/env bash
+
+### HACK - workaround ubuntu libc6 version number bug see: https://forum.odroid.com/viewtopic.php?p=344373
+
+mv /bin/uname /bin/uname.orig
+tee -a /bin/uname <<EOF
+#!/bin/bash
+if [[ \$1 == "-r" ]]; then
+echo '4.9.250';
+exit
+else
+uname.orig \$1
+fi
+EOF
+
+chmod 755 /bin/uname
+### END HACK

hw2/.gitignore

@@ -0,0 +1,6 @@
+.vscode
+_build
+bin/main.exe
+oatc
+ocamlbin
+*~

hw2/.ocamlformat

@@ -0,0 +1,2 @@
+profile = janestreet
+version = 0.26.1

hw2/.ocamlinit

@@ -0,0 +1,6 @@
+#use "topfind";;
+#require "str";;
+#require "unix";;
+
+#use_output "dune top"
+

hw2/Makefile

@@ -0,0 +1,30 @@
+SUBMIT := $(shell cat submit_zip_contents.txt)
+HWNAME := hw2
+TIMESTAMP := $(shell /bin/date "+%Y-%m-%d-%H:%M:%S")
+ZIPNAME := $(HWNAME)-submit-$(TIMESTAMP).zip
+
+.PHONY: all oatc test clean zip
+
+all: oatc
+
+dev:
+	dune build --watch --terminal-persistence=clear-on-rebuild
+
+oatc: 
+	dune build
+	@cp bin/main.exe oatc
+
+test: oatc
+	./oatc --test
+
+utop:
+	utop
+
+zip: $(SUBMIT)
+	zip '$(ZIPNAME)' $(SUBMIT)
+
+clean:
+	dune clean
+	rm -rf oatc ocamlbin bin/main.exe
+
+# 

hw2/README.md

@@ -0,0 +1,13 @@
+# HW2: x86lite simulator
+
+Quick Start:
+
+1. clone this repository using `git clone`
+2. open the folder in VSCode (it will prompt you to "Reopen in dev container" -- do that)
+3. start an OCaml sandbox terminal
+4. run `make test` from the command line
+5. open `bin/simulator.ml`
+
+See the general toolchain and project instructions on the course web site. The
+course web pages have a link to the html version of the homework instructions.
+

hw2/bin/dune

@@ -0,0 +1,22 @@
+(library
+ (name sim)
+ (modules simulator int64_overflow)
+ (libraries x86 num))
+
+(env
+ (dev
+  (flags
+   (:standard -g -w "+a-4-7-9-26-27-29-30-32..42-44-45-48-50-60-66..70"))))
+
+(executable
+ (public_name main)
+ (name main)
+ (modules main)
+ (promote (until-clean))
+ (libraries
+  ; OCaml standard libraries  
+  ; project libraries
+  util
+  x86
+  studenttests
+  gradedtests))

hw2/bin/int64_overflow.ml

@@ -0,0 +1,27 @@
+open Big_int
+type t = { value : int64; overflow : bool }
+
+let ok i = { value = i; overflow = false }
+
+exception Overflow
+
+let with_overflow1 g f i =
+  let res = f i in 
+  { value = res
+  ; overflow = not @@ eq_big_int (big_int_of_int64 res) (g @@ big_int_of_int64 i)
+  } 
+  
+let with_overflow2 g f i j =
+  let res = f i j in
+  { value = res
+  ; overflow = not @@ eq_big_int (big_int_of_int64 res) 
+		                 (g (big_int_of_int64 i) (big_int_of_int64 j))
+  } 
+
+let neg = with_overflow1 minus_big_int Int64.neg
+let succ = with_overflow1 succ_big_int Int64.succ
+let pred = with_overflow1 pred_big_int Int64.pred
+
+let add = with_overflow2 add_big_int Int64.add
+let sub = with_overflow2 sub_big_int Int64.sub
+let mul = with_overflow2 mult_big_int Int64.mul

hw2/bin/int64_overflow.mli

@@ -0,0 +1,13 @@
+exception Overflow
+
+type t = { value : int64; overflow : bool }
+
+val ok : int64 -> t
+
+val neg : int64 -> t
+val succ : int64 -> t
+val pred : int64 -> t
+
+val add : int64 -> int64 -> t
+val sub : int64 -> int64 -> t
+val mul : int64 -> int64 -> t

hw2/bin/main.ml

@@ -0,0 +1,31 @@
+open Util.Assert
+open Arg
+open X86
+open Sim.Simulator
+
+exception Ran_tests
+let worklist = ref []
+
+let suite = ref (timeout_suite 5 (Studenttests.provided_tests @ Gradedtests.graded_tests))
+
+let exec_tests () =
+  let o = run_suite !suite in
+  Printf.printf "%s\n" (outcome_to_string o);
+  raise Ran_tests
+
+let do_one_file fn =
+  let _ = Printf.printf "Processing: %s\n" fn in ()
+
+(* Use the --test option to run unit tests and the quit the program. *)
+let argspec = [
+  ("--test", Unit exec_tests, "run the test suite, ignoring other inputs");
+] 
+
+let _ =
+  try
+    Arg.parse argspec (fun f -> worklist := f :: !worklist)
+        "CIS341 main test harness \n";
+    match !worklist with
+    | [] -> print_endline "* Nothing to do"
+    | _ -> List.iter do_one_file !worklist
+  with Ran_tests -> ()

hw2/bin/simulator.ml

@@ -0,0 +1,304 @@
+(* X86lite Simulator *)
+
+(* See the documentation in the X86lite specification, available on the 
+   course web pages, for a detailed explanation of the instruction
+   semantics.
+*)
+
+open X86
+
+(* simulator machine state -------------------------------------------------- *)
+
+let mem_bot = 0x400000L          (* lowest valid address *)
+let mem_top = 0x410000L          (* one past the last byte in memory *)
+let mem_size = Int64.to_int (Int64.sub mem_top mem_bot)
+let nregs = 17                   (* including Rip *)
+let ins_size = 8L                (* assume we have a 8-byte encoding *)
+let exit_addr = 0xfdeadL         (* halt when m.regs(%rip) = exit_addr *)
+
+(* The simulator memory maps addresses to symbolic bytes.  Symbolic
+   bytes are either actual data indicated by the Byte constructor or
+   'symbolic instructions' that take up eight bytes for the purposes of
+   layout.
+
+   The symbolic bytes abstract away from the details of how
+   instructions are represented in memory.  Each instruction takes
+   exactly eight consecutive bytes, where the first byte InsB0 stores
+   the actual instruction, and the next sevent bytes are InsFrag
+   elements, which aren't valid data.
+
+   For example, the two-instruction sequence:
+        at&t syntax             ocaml syntax
+      movq %rdi, (%rsp)       Movq,  [~%Rdi; Ind2 Rsp]
+      decq %rdi               Decq,  [~%Rdi]
+
+   is represented by the following elements of the mem array (starting
+   at address 0x400000):
+
+       0x400000 :  InsB0 (Movq,  [~%Rdi; Ind2 Rsp])
+       0x400001 :  InsFrag
+       0x400002 :  InsFrag
+       0x400003 :  InsFrag
+       0x400004 :  InsFrag
+       0x400005 :  InsFrag
+       0x400006 :  InsFrag
+       0x400007 :  InsFrag
+       0x400008 :  InsB0 (Decq,  [~%Rdi])
+       0x40000A :  InsFrag
+       0x40000B :  InsFrag
+       0x40000C :  InsFrag
+       0x40000D :  InsFrag
+       0x40000E :  InsFrag
+       0x40000F :  InsFrag
+       0x400010 :  InsFrag
+*)
+type sbyte = InsB0 of ins       (* 1st byte of an instruction *)
+           | InsFrag            (* 2nd - 8th bytes of an instruction *)
+           | Byte of char       (* non-instruction byte *)
+
+(* memory maps addresses to symbolic bytes *)
+type mem = sbyte array
+
+(* Flags for condition codes *)
+type flags = { mutable fo : bool
+             ; mutable fs : bool
+             ; mutable fz : bool
+             }
+
+(* Register files *)
+type regs = int64 array
+
+(* Complete machine state *)
+type mach = { flags : flags
+            ; regs : regs
+            ; mem : mem
+            }
+
+(* simulator helper functions ----------------------------------------------- *)
+
+(* The index of a register in the regs array *)
+let rind : reg -> int = function
+  | Rip -> 16
+  | Rax -> 0  | Rbx -> 1  | Rcx -> 2  | Rdx -> 3
+  | Rsi -> 4  | Rdi -> 5  | Rbp -> 6  | Rsp -> 7
+  | R08 -> 8  | R09 -> 9  | R10 -> 10 | R11 -> 11
+  | R12 -> 12 | R13 -> 13 | R14 -> 14 | R15 -> 15
+
+(* Helper functions for reading/writing sbytes *)
+
+(* Convert an int64 to its sbyte representation *)
+let sbytes_of_int64 (i:int64) : sbyte list =
+  let open Char in 
+  let open Int64 in
+  List.map (fun n -> Byte (shift_right i n |> logand 0xffL |> to_int |> chr))
+           [0; 8; 16; 24; 32; 40; 48; 56]
+
+(* Convert an sbyte representation to an int64 *)
+let int64_of_sbytes (bs:sbyte list) : int64 =
+  let open Char in
+  let open Int64 in
+  let f b i = match b with
+    | Byte c -> logor (shift_left i 8) (c |> code |> of_int)
+    | _ -> 0L
+  in
+  List.fold_right f bs 0L
+
+(* Convert a string to its sbyte representation *)
+let sbytes_of_string (s:string) : sbyte list =
+  let rec loop acc = function
+    | i when i < 0 -> acc
+    | i -> loop (Byte s.[i]::acc) (pred i)
+  in
+  loop [Byte '\x00'] @@ String.length s - 1
+
+(* Serialize an instruction to sbytes *)
+let sbytes_of_ins (op, args:ins) : sbyte list =
+  let check = function
+    | Imm (Lbl _) | Ind1 (Lbl _) | Ind3 (Lbl _, _) -> 
+      invalid_arg "sbytes_of_ins: tried to serialize a label!"
+    | _ -> ()
+  in
+  List.iter check args;
+  [InsB0 (op, args); InsFrag; InsFrag; InsFrag;
+   InsFrag; InsFrag; InsFrag; InsFrag]
+
+(* Serialize a data element to sbytes *)
+let sbytes_of_data : data -> sbyte list = function
+  | Quad (Lit i) -> sbytes_of_int64 i
+  | Asciz s -> sbytes_of_string s
+  | Quad (Lbl _) -> invalid_arg "sbytes_of_data: tried to serialize a label!"
+
+
+(* It might be useful to toggle printing of intermediate states of your 
+   simulator. Our implementation uses this mutable flag to turn on/off
+   printing.  For instance, you might write something like:
+
+     [if !debug_simulator then print_endline @@ string_of_ins u; ...]
+
+*)
+let debug_simulator = ref false
+
+
+(* override some useful operators  *)
+let ( +. ) = Int64.add
+let ( -. ) = Int64.sub
+let ( *. ) = Int64.mul
+let ( <. ) a b = (Int64.compare a b) < 0
+let ( >. ) a b = (Int64.compare a b) > 0
+let ( <=. ) a b = (Int64.compare a b) <= 0
+let ( >=. ) a b = (Int64.compare a b) >= 0
+
+(* Interpret a condition code with respect to the given flags. *)
+(* !!! Check the Specification for Help *)
+let interp_cnd {fo; fs; fz} : cnd -> bool = fun x -> failwith "interp_cnd unimplemented"
+
+
+(* Maps an X86lite address into Some OCaml array index,
+   or None if the address is not within the legal address space. *)
+let map_addr (addr:quad) : int option =
+  failwith "map_addr not implemented"
+
+(* Your simulator should raise this exception if it tries to read from or
+   store to an address not within the valid address space. *)
+exception X86lite_segfault
+
+(* Raise X86lite_segfault when addr is invalid. *)
+let map_addr_segfault (addr:quad) : int =
+  failwith "map_addr_segfault not implemented"
+
+(* Simulates one step of the machine:
+    - fetch the instruction at %rip
+    - compute the source and/or destination information from the operands
+    - simulate the instruction semantics
+    - update the registers and/or memory appropriately
+    - set the condition flags
+
+  We provide the basic structure of step function and helper functions.
+  Implement the subroutine below to complete the step function.
+  See step function to understand each subroutine and how they 
+  are glued together.
+*)
+
+let readquad (m:mach) (addr:quad) : quad =
+  failwith "readquad not implemented"
+
+
+let writequad (m:mach) (addr:quad) (w:quad) : unit =
+  failwith "writequad not implemented"
+
+let fetchins (m:mach) (addr:quad) : ins =
+  failwith "fetchins not implemented"
+
+(* Compute the instruction result.
+ * NOTE: See int64_overflow.ml for the definition of the return type
+*  Int64_overflow.t. *)
+let interp_opcode (m: mach) (o:opcode) (args:int64 list) : Int64_overflow.t = 
+    let open Int64 in
+    let open Int64_overflow in
+    match o, args with
+      | _ -> failwith "interp_opcode not implemented"
+
+(** Update machine state with instruction results. *)
+let ins_writeback (m: mach) : ins -> int64 -> unit  = 
+  failwith "ins_writeback not implemented"
+
+
+(* mem addr ---> mem array index *)
+let interp_operands (m:mach) : ins -> int64 list = 
+  failwith "interp_operands not implemented"
+
+let validate_operands : ins -> unit = function
+  | _ -> failwith "validate_operands not implemented"
+
+
+let crack : ins -> ins list = function
+  | _ -> failwith "crack not implemented"
+
+ 
+(* TODO: double check against spec *)
+let set_flags (m:mach) (op:opcode) (ws: quad list) (w : Int64_overflow.t) : unit =
+  failwith "set_flags not implemented"
+
+let step (m:mach) : unit =
+  (* execute an instruction *)
+  let (op, args) as ins = fetchins m m.regs.(rind Rip) in
+  validate_operands ins;
+  
+  (* Some instructions involve running two or more basic instructions. 
+   * For other instructions, just return a list of one instruction.
+   * See the X86lite specification for details. *)
+  let uops: ins list = crack (op,args) in
+
+  m.regs.(rind Rip) <- m.regs.(rind Rip) +. ins_size;
+
+  List.iter
+    (fun (uop,_ as u) ->
+     if !debug_simulator then print_endline @@ string_of_ins u;
+     let ws = interp_operands m u in
+     let res = interp_opcode m uop ws in
+     ins_writeback m u @@ res.Int64_overflow.value;
+     set_flags m op ws res
+    ) uops
+
+(* Runs the machine until the rip register reaches a designated
+   memory address. Returns the contents of %rax when the 
+   machine halts. *)
+let run (m:mach) : int64 = 
+  while m.regs.(rind Rip) <> exit_addr do step m done;
+  m.regs.(rind Rax)
+
+(* assembling and linking --------------------------------------------------- *)
+
+(* A representation of the executable *)
+type exec = { entry    : quad              (* address of the entry point *)
+            ; text_pos : quad              (* starting address of the code *)
+            ; data_pos : quad              (* starting address of the data *)
+            ; text_seg : sbyte list        (* contents of the text segment *)
+            ; data_seg : sbyte list        (* contents of the data segment *)
+            }
+
+(* Assemble should raise this when a label is used but not defined *)
+exception Undefined_sym of lbl
+
+(* Assemble should raise this when a label is defined more than once *)
+exception Redefined_sym of lbl
+
+(* Convert an X86 program into an object file:
+   - separate the text and data segments
+   - compute the size of each segment
+      Note: the size of an Asciz string section is (1 + the string length)
+            due to the null terminator
+
+   - resolve the labels to concrete addresses and 'patch' the instructions to 
+     replace Lbl values with the corresponding Imm values.
+     HINT: consider building a mapping from symboli Lbl to memory address
+
+   - the text segment starts at the lowest address
+   - the data segment starts after the text segment
+
+  HINT: List.fold_left and List.fold_right are your friends.
+ *)
+let is_size (is: ins list): quad = 
+  failwith "is_size not implemented"
+
+let ds_size (ds: data list): quad = 
+  failwith "ds_size not implemented"
+
+let assemble (p:prog) : exec =
+  failwith "assemble unimplemented"
+
+(* Convert an object file into an executable machine state. 
+    - allocate the mem array
+    - set up the memory state by writing the symbolic bytes to the 
+      appropriate locations 
+    - create the inital register state
+      - initialize rip to the entry point address
+      - initializes rsp to the last word in memory 
+      - the other registers are initialized to 0
+    - the condition code flags start as 'false'
+
+  Hint: The Array.make, Array.blit, and Array.of_list library functions 
+  may be of use.
+*)
+let load {entry; text_pos; data_pos; text_seg; data_seg} : mach = 
+   failwith "load not implemented"

hw2/dune-project

@@ -0,0 +1,2 @@
+(lang dune 3.0)
+(name hw2)

hw2/lib/util/assert.ml

@@ -0,0 +1,195 @@
+(* CIS341 Assertion Testing and Grading Infrastructure *)
+(* Author: Steve Zdancewic                             *)
+
+(* Do NOT modify this file -- we will overwrite it     *)
+(* with our own version when testing your code.        *)
+
+(* An assertion is just a unit->unit function that either *)
+(* succeeds silently or throws an Failure exception.       *)
+type assertion = unit -> unit
+
+type 'a test =
+  | GradedTest of string * int * (string * 'a) list
+  | Test of string * (string * 'a) list
+
+type suite = assertion test list
+
+(**************)
+(* Assertions *)
+
+let assert_eq v1 v2 : assertion =
+ fun () -> if v1 <> v2 then failwith "not equal" else ()
+
+
+let assert_eqf f v2 : assertion =
+ fun () -> if f () <> v2 then failwith "not equal" else ()
+
+
+let assert_eqfs f v2 : assertion =
+ fun () ->
+  let s1 = f () in
+  if s1 <> v2
+  then failwith @@ Printf.sprintf "not equal\n\texpected:%s\n\tgot:%s\n" v2 s1
+  else ()
+
+
+let assert_fail : assertion = fun () -> failwith "assert fail"
+
+exception Timeout
+
+let timeout_assert (time : int) (a : assertion) : assertion =
+ fun () ->
+  let handler = Sys.Signal_handle (fun _ -> raise Timeout) in
+  let old = Sys.signal Sys.sigalrm handler in
+  let reset_sigalrm () = Sys.set_signal Sys.sigalrm old in
+  ignore (Unix.alarm time) ;
+  try
+    a () ;
+    reset_sigalrm ()
+  with
+  | Timeout ->
+      reset_sigalrm () ;
+      failwith @@ Printf.sprintf "Timed out after %d seconds" time
+  | exc ->
+      reset_sigalrm () ;
+      raise exc
+
+
+let timeout_test (time : int) (t : assertion test) : assertion test =
+  let map_timeout l = List.map (fun (i, a) -> (i, timeout_assert time a)) l in
+  match t with
+  | GradedTest (s, i, ls) ->
+      GradedTest (s, i, map_timeout ls)
+  | Test (s, ls) ->
+      Test (s, map_timeout ls)
+
+
+let timeout_suite (time : int) (s : suite) : suite =
+  List.map (timeout_test time) s
+
+
+(***************************)
+(* Generating Test Results *)
+
+type result =
+  | Pass
+  | Fail of string
+
+type outcome = result test list
+
+let run_assertion (f : assertion) : result =
+  try
+    f () ;
+    Pass
+  with
+  | Failure m ->
+      Fail m
+  | e ->
+      Fail ("test threw exception: " ^ Printexc.to_string e)
+
+
+let run_test (t : assertion test) : result test =
+  let run_case (cn, f) = (cn, run_assertion f) in
+  match t with
+  | GradedTest (n, s, cases) ->
+      Printf.eprintf "Running test %s\n%!" n ;
+      GradedTest (n, s, List.map run_case cases)
+  | Test (n, cases) ->
+      Printf.eprintf "Running test %s\n%!" n ;
+      Test (n, List.map run_case cases)
+
+
+let run_suite (s : suite) : outcome = List.map run_test s
+
+(***********************)
+(* Reporting functions *)
+
+let result_test_to_string (name_pts : string) (r : result test) : string =
+  let string_of_case (name, res) =
+    match res with
+    | Pass ->
+        "passed - " ^ name
+    | Fail msg ->
+        "FAILED - " ^ name ^ ": " ^ msg
+  in
+  match r with
+  | GradedTest (_, _, cases) | Test (_, cases) ->
+      name_pts
+      ^ List.fold_left
+          (fun rest case -> rest ^ "\n" ^ string_of_case case)
+          ""
+          cases
+
+
+(* Number of digits of precision for a float x. Argument p is the number of decimal places desired (must be at least 1) *)
+let prec_digits p x = (int_of_float @@ floor @@ log10 x) + (1 + p)
+
+(* returns (name_pts, passed, failed, total, points_earned, max_given, max_hidden) *)
+let get_results (t : result test) =
+  let num_passed cases =
+    List.fold_left
+      (fun cnt (_, r) -> match r with Pass -> cnt + 1 | _ -> cnt)
+      0
+      cases
+  in
+  let num_failed cases =
+    List.fold_left
+      (fun cnt (_, r) -> match r with Fail _ -> cnt + 1 | _ -> cnt)
+      0
+      cases
+  in
+  match t with
+  | GradedTest (name, pts, cases) ->
+      let passed = num_passed cases in
+      let failed = num_failed cases in
+      let total = List.length cases in
+      if total > 0 
+      then
+        let points_earned = ((float_of_int passed) /. (float_of_int total)) *. (float_of_int pts) in
+        let name_pts = 
+          Printf.sprintf "%s (%1.*g/%d points = %d/%d tests)" name (prec_digits 1 points_earned) points_earned pts passed total 
+        in
+        (name_pts, passed, failed, total, points_earned, pts, 0)
+      else
+        let name_pts = Printf.sprintf "%s (?/%d points)" name pts in
+        (name_pts, passed, failed, total, 0.0, 0, pts)
+  | Test (name, cases) ->
+      let total = List.length cases in
+      let passed = num_passed cases in
+      let failed = num_failed cases in
+      (name, passed, failed, total, 0.0, 0, 0)
+
+
+let outcome_to_string (o : outcome) : string =
+  let sep = "\n---------------------------------------------------\n" in
+  let helper (passed, failed, total, pts, maxg, maxh, str) (t : result test) =
+    let name_pts, p, f, tot, s, mg, mh = get_results t in
+    ( passed + p
+    , failed + f
+    , total + tot
+    , s +. pts
+    , maxg + mg
+    , maxh + mh
+    , str
+      ^ "\n"
+      ^
+      if f > 0
+      then result_test_to_string name_pts t
+      else if tot > 0
+      then name_pts ^ ":\n  OK"
+      else name_pts ^ ":\n  Hidden" )
+  in
+  let p, f, tot, pts, maxg, maxh, str =
+    List.fold_left helper (0, 0, 0, 0.0, 0, 0, "") o
+  in
+  str
+  ^ sep
+  ^ Printf.sprintf
+      "Passed: %d/%d\n\
+       Failed: %d/%d\n\
+       Score: %1.1f/%d (given)\n\
+      \       ?/%d (hidden)"
+      p tot
+      f tot
+      pts maxg
+      maxh

hw2/lib/util/assert.mli

@@ -0,0 +1,57 @@
+(* CIS341 Assertion Testing and Grading Infrastructure *)
+(* Author: Steve Zdancewic                             *)
+
+(* Do NOT modify this file -- we will overwrite it     *)
+(* with our own version when testing your code.        *)
+
+exception Timeout
+
+(* An assertion is just a unit->unit function that either *)
+(* succeeds silently or throws an Failure exception.       *)
+type assertion = unit -> unit
+
+type 'a test =
+  | GradedTest of string * int * (string * 'a) list
+  | Test of string * (string * 'a) list
+
+type suite = assertion test list
+
+(**************)
+(* Assertions *)
+
+val assert_eq : 'a -> 'a -> assertion
+
+val assert_eqf : (unit -> 'a) -> 'a -> assertion
+
+val assert_eqfs : (unit -> string) -> string -> assertion
+
+val assert_fail : assertion
+
+val timeout_assert : int -> assertion -> assertion
+
+val timeout_test : int -> assertion test -> assertion test
+
+val timeout_suite : int -> suite -> suite
+
+(***************************)
+(* Generating Test Results *)
+
+type result =
+  | Pass
+  | Fail of string
+
+type outcome = result test list
+
+val run_assertion : assertion -> result
+
+val run_test : assertion test -> result test
+
+val run_suite : suite -> outcome
+
+(***********************)
+(* Reporting functions *)
+
+val result_test_to_string : string -> result test -> string
+
+(* val get_results result test -> (string * int * int * int * float * int * int) *)
+val outcome_to_string : outcome -> string

hw2/lib/util/dune

@@ -0,0 +1,3 @@
+(library
+  (name util)
+  (libraries str unix))

hw2/lib/util/platform.ml

@@ -0,0 +1,237 @@
+(* -------------------------------------------------------------------------- *)
+(** Assembling and linking for X86.  Depends on the underlying OS platform    *)
+
+open Printf
+open Unix
+
+exception PlatformError of string * string
+
+(* paths -------------------------------------------------------------------- *)
+let path_sep = "/"
+
+let bin_path = "./bin"
+
+let dot_path = "./"
+
+let executable_name = ref "a.out"
+
+let output_path = ref "output"
+
+let libs = ref []
+
+let lib_paths = ref []
+
+let lib_search_paths = ref []
+
+let include_paths = ref []
+
+(* unix utility scripts ----------------------------------------------------- *)
+let pp_cmd = ref "cpp -E "
+
+let rm_cmd = ref "rm -rf "
+
+(* -------------------------------------------------------------------------- *)
+(* Platform specific configuration: Unix/Linux vs. Mac OS X                   *)
+
+let os =
+  let ic = Unix.open_process_in "uname -s" in
+  let uname = input_line ic in
+  let () = close_in ic in
+  uname
+
+let cpu = 
+  let ic = Unix.open_process_in "uname -m" in
+  let cpuname = input_line ic in
+  let () = close_in ic in
+  cpuname
+
+(* One of "Darwin" or "Linux" *)
+
+let linux = ref false
+
+let mangle name = if !linux then name else "_" ^ name
+
+let osx_target_triple = "x86_64-apple-macosx10.13.0"
+
+let linux_target_triple = "x86_64-unknown-linux"
+
+let target_triple = ref osx_target_triple
+
+let platform_flags = ref ""
+
+(* Set the link commands properly, ensure output directory exists *)
+let configure_os () =
+  if os = "Linux"
+  then (
+    linux := true ;
+    target_triple := linux_target_triple ;
+    platform_flags := "" )
+  else if os = "Darwin"
+  then (
+    linux := false ;
+    target_triple := osx_target_triple ;
+    platform_flags := "-fno-asynchronous-unwind-tables -mstackrealign" )
+  else failwith @@ "Unsupported OS detected: " ^ os
+
+
+(* verbose compiler output -------------------------------------------------- *)
+let verbose = ref false
+
+let verb msg =
+  if !verbose
+  then (
+    print_string msg ;
+    flush Stdlib.stdout )
+
+
+let verb_os () =
+  verb
+  @@ Printf.sprintf
+       "* PLATFORM: %s TRIPLE: %s FLAGS %s\n"
+       os
+       !target_triple
+       !platform_flags
+
+
+let enable_verbose () =
+  verbose := true ;
+  verb_os ()
+
+
+(* create the output directory, which is assumed to exist *)
+let create_output_dir () =
+  try ignore (stat !output_path) with
+  | Unix_error (ENOENT, _, _) ->
+      verb @@ Printf.sprintf "creating output directory: %s\n" !output_path ;
+      mkdir !output_path 0o755
+
+
+(* clang invocation stuff --------------------------------------------------- *)
+let common_flags = "-Wno-override-module"
+
+let link_flags = "-Wno-unused-command-line-argument -mstackrealign"
+
+let clang_ll_mode = "-S"
+
+let as_mode = "-c"
+
+let rosetta_prefix = "arch -x86_64 "
+
+let prefix = if cpu = "arm64" then rosetta_prefix else ""
+
+let opt_level = ref "-O1 -Wall"
+
+let clang args = Printf.sprintf "%sclang %s -o " prefix (String.concat " " args)
+
+let clang_cmd () =
+  clang [ clang_ll_mode; !opt_level; common_flags; !platform_flags ]
+
+
+let as_cmd () = clang [ as_mode; !opt_level; common_flags; !platform_flags ]
+
+let link_cmd () = clang [ common_flags; !opt_level; !platform_flags; link_flags ]
+
+(* filename munging --------------------------------------------------------- *)
+let path_to_basename_ext (path : string) : string * string =
+  (* The path is of the form ... "foo/bar/baz/<file>.ext" *)
+  let paths = Str.split (Str.regexp_string path_sep) path in
+  let _ =
+    if List.length paths = 0 then failwith @@ sprintf "bad path: %s" path
+  in
+  let filename = List.hd (List.rev paths) in
+  match Str.split (Str.regexp_string ".") filename with
+  | [ root ] ->
+      (root, "")
+  | [ root; ext ] ->
+      (root, ext)
+  | _ ->
+      failwith @@ sprintf "bad filename: %s" filename
+
+
+(* compilation and shell commands-------------------------------------------- *)
+
+(* Platform independent shell command *)
+let sh (cmd : string) (ret : string -> int -> 'a) : 'a =
+  verb (sprintf "* %s\n" cmd) ;
+  match system cmd with
+  | WEXITED i ->
+      ret cmd i
+  | WSIGNALED i ->
+      raise (PlatformError (cmd, sprintf "Signaled with %d." i))
+  | WSTOPPED i ->
+      raise (PlatformError (cmd, sprintf "Stopped with %d." i))
+
+(* Platform independent shell command with a timeout (in seconds) *)
+let timeout_sh (time: int)(cmd : string) (ret : string -> int -> 'a) : 'a =
+  let timeout_cmd = sprintf "%s/timeout3 -t %d %s" bin_path time cmd in
+  verb (sprintf "* %s\n" timeout_cmd) ;
+  match system timeout_cmd with
+  | WEXITED i ->
+      ret cmd i
+  | WSIGNALED i ->
+      if i == Sys.sigterm
+      then raise (PlatformError (cmd, sprintf "Timed-out after %d s" time))
+      else raise (PlatformError (cmd, sprintf "Signaled with %d." i))
+  | WSTOPPED i ->
+      raise (PlatformError (cmd, sprintf "Stopped with %d." i))
+
+
+(* Generate a file name that does not already exist.
+   basedir includes the path separator
+*)
+let gen_name (basedir : string) (basen : string) (baseext : string) : string =
+  let rec nocollide ofs =
+    let nfn =
+      sprintf
+        "%s/%s%s%s"
+        basedir
+        basen
+        (if ofs = 0 then "" else "_" ^ string_of_int ofs)
+        baseext
+    in
+    try
+      ignore (stat nfn) ;
+      nocollide (ofs + 1)
+    with
+    | Unix_error (ENOENT, _, _) ->
+        nfn
+  in
+  nocollide 0
+
+
+let raise_error cmd i =
+  if i <> 0 then raise (PlatformError (cmd, sprintf "Exited with status %d." i))
+
+
+let ignore_error _ _ = ()
+
+let preprocess (dot_oat : string) (dot_i : string) : unit =
+  sh
+    (sprintf
+       "%s%s %s %s"
+       !pp_cmd
+       (List.fold_left (fun s i -> s ^ " -I" ^ i) "" !include_paths)
+       dot_oat
+       dot_i)
+    raise_error
+
+
+let clang_compile (dot_ll : string) (dot_s : string) : unit =
+  sh (sprintf "%s%s %s" (clang_cmd ()) dot_s dot_ll) raise_error
+
+
+let assemble (dot_s : string) (dot_o : string) : unit =
+  sh (sprintf "%s%s %s" (as_cmd ()) dot_o dot_s) raise_error
+
+
+let link (mods : string list) (out_fn : string) : unit =
+  sh
+    (sprintf
+       "%s%s %s %s %s %s"
+       (link_cmd ())
+       out_fn
+       (String.concat " " (mods @ !lib_paths))
+       (List.fold_left (fun s i -> s ^ " -L" ^ i) "" !lib_search_paths)
+       (List.fold_left (fun s i -> s ^ " -I" ^ i) "" !include_paths)
+       (List.fold_left (fun s l -> s ^ " -l" ^ l) "" !libs))
+    raise_error

hw2/lib/util/range.ml

@@ -0,0 +1,56 @@
+open Lexing
+
+type pos = int * int (* Line number and column *)
+
+type t = string * pos * pos
+
+let line_of_pos (l, _) = l
+
+let col_of_pos (_, c) = c
+
+let mk_pos line col = (line, col)
+
+let file_of_range (f, _, _) = f
+
+let start_of_range (_, s, _) = s
+
+let end_of_range (_, _, e) = e
+
+let mk_range f s e = (f, s, e)
+
+let valid_pos (l, c) = l >= 0 && c >= 0
+
+let merge_range ((f, s1, e1) as r1) ((f', s2, e2) as r2) =
+  if f <> f'
+  then
+    failwith
+    @@ Printf.sprintf "merge_range called on different files: %s and %s" f f'
+  else if not (valid_pos s1)
+  then r2
+  else if not (valid_pos s2)
+  then r1
+  else mk_range f (min s1 s2) (max e1 e2)
+
+
+let string_of_range (f, (sl, sc), (el, ec)) =
+  Printf.sprintf "%s:[%d.%d-%d.%d]" f sl sc el ec
+
+
+let ml_string_of_range (f, (sl, sc), (el, ec)) =
+  Printf.sprintf "(\"%s\", (%d, %d), (%d, %d))" f sl sc el ec
+
+
+let norange = ("__internal", (0, 0), (0, 0))
+
+(* Creates a Range.pos from the Lexing.position data *)
+let pos_of_lexpos (p : position) : pos =
+  mk_pos p.pos_lnum (p.pos_cnum - p.pos_bol)
+
+
+let mk_lex_range (p1 : position) (p2 : position) : t =
+  mk_range p1.pos_fname (pos_of_lexpos p1) (pos_of_lexpos p2)
+
+
+(* Expose the lexer state as a Range.t value *)
+let lex_range lexbuf : t =
+  mk_lex_range (lexeme_start_p lexbuf) (lexeme_end_p lexbuf)

hw2/lib/util/range.mli

@@ -0,0 +1,53 @@
+(* Ranges and utilities on ranges. *)
+
+(* A range represents a segment of text in a given file; it has a
+ * beginning and ending position specified in terms of line and column
+ * numbers. A range is associated with tokens during lexing to allow
+ * the compiler to give better error messages during lexing and
+ * parsing.  
+ *)
+
+(* a position in the source file; line number and column *)
+type pos = int * int
+
+(* a range of positions in a particular file *)
+type t = string * pos * pos
+
+(* line of position *)
+val line_of_pos : pos -> int
+
+(* column of position *)
+val col_of_pos : pos -> int
+
+(* new position with given line and col *)
+val mk_pos : int -> int -> pos
+
+(* the filename a range is in *)
+val file_of_range : t -> string
+
+(* the beginning of the range *)
+val start_of_range : t -> pos
+
+(* the end of the range *)
+val end_of_range : t -> pos
+
+(* create a new range from the given filename and start, end positions *)
+val mk_range : string -> pos -> pos -> t
+
+(* merge two ranges together *)
+val merge_range : t -> t -> t
+
+(* pretty-print a range *)
+val string_of_range : t -> string
+
+(* print a range as an ocaml value *)
+val ml_string_of_range : t -> string
+
+(* use to tag generated AST nodes where range does not apply *)
+val norange : t
+
+val pos_of_lexpos : Lexing.position -> pos
+
+val mk_lex_range : Lexing.position -> Lexing.position -> t
+
+val lex_range : Lexing.lexbuf -> t

hw2/lib/x86/dune

@@ -0,0 +1,3 @@
+(library
+  (name x86)
+  (modules x86))

hw2/lib/x86/x86.ml

@@ -0,0 +1,165 @@
+(* X86lite language representation. *)
+
+(* assembler syntax --------------------------------------------------------- *)
+
+(* Labels for code blocks and global data. *)
+type lbl = string
+
+type quad = int64
+
+(* Immediate operands *)
+type imm = Lit of quad
+         | Lbl of lbl
+
+(* Registers:
+    instruction pointer: rip
+    arguments: rdi, rsi, rdx, rcx, r09, r08
+    callee-save: rbx, rbp, r12-r15 
+*)
+type reg = Rip
+         | Rax | Rbx | Rcx | Rdx | Rsi | Rdi | Rbp | Rsp
+         | R08 | R09 | R10 | R11 | R12 | R13 | R14 | R15
+
+type operand = Imm of imm            (* immediate *)
+             | Reg of reg            (* register *)
+             | Ind1 of imm           (* indirect: displacement *)
+             | Ind2 of reg           (* indirect: (%reg) *)
+             | Ind3 of (imm * reg)   (* indirect: displacement(%reg) *)
+
+(* Condition Codes *)
+type cnd = Eq | Neq | Gt | Ge | Lt | Le
+
+type opcode = Movq | Pushq | Popq
+            | Leaq
+            | Incq | Decq | Negq | Notq
+            | Addq | Subq | Imulq | Xorq | Orq | Andq
+            | Shlq | Sarq | Shrq
+            | Jmp | J of cnd
+            | Cmpq  | Set of cnd
+            | Callq | Retq
+
+(* An instruction is an opcode plus its operands.
+   Note that arity and other constraints about the operands 
+   are not checked. *)
+type ins = opcode * operand list              
+
+type data = Asciz of string
+          | Quad of imm
+
+type asm = Text of ins list    (* code *)
+         | Data of data list   (* data *)
+
+(* labeled blocks of data or code *)
+type elem = { lbl: lbl; global: bool; asm: asm }
+
+type prog = elem list
+
+(* Provide some syntactic sugar for writing x86 code in OCaml files. *)
+module Asm = struct
+  let (~$) i  = Imm (Lit (Int64.of_int i))      (* int64 constants *)
+  let (~$$) l = Imm (Lbl l)                    (* label constants *)
+  let (~%) r  = Reg r                           (* registers *)
+
+  (* helper functions for building blocks of data or code *)
+  let data l ds  = { lbl = l; global = true; asm = Data ds }
+  let text l is  = { lbl = l; global = false; asm = Text is }
+  let gtext l is = { lbl = l; global = true; asm = Text is }
+end
+
+(* pretty printing ----------------------------------------------------------- *)
+
+let string_of_reg : reg -> string = function
+  | Rip -> "%rip"
+  | Rax -> "%rax" | Rbx -> "%rbx" | Rcx -> "%rcx" | Rdx -> "%rdx"
+  | Rsi -> "%rsi" | Rdi -> "%rdi" | Rbp -> "%rbp" | Rsp -> "%rsp"
+  | R08 -> "%r8 " | R09 -> "%r9 " | R10 -> "%r10" | R11 -> "%r11"
+  | R12 -> "%r12" | R13 -> "%r13" | R14 -> "%r14" | R15 -> "%r15"
+
+let string_of_byte_reg : reg -> string = function
+  | Rip -> failwith "%rip used as byte register"
+  | Rax -> "%al"   | Rbx -> "%bl"   | Rcx -> "%cl"   | Rdx -> "%dl"
+  | Rsi -> "%sil"  | Rdi -> "%dil"  | Rbp -> "%bpl"  | Rsp -> "%spl"
+  | R08 -> "%r8b"  | R09 -> "%r9b"  | R10 -> "%r10b" | R11 -> "%r11b"
+  | R12 -> "%r12b" | R13 -> "%r13b" | R14 -> "%r14b" | R15 -> "%r15b"
+
+let string_of_lbl (l:lbl) : string = l
+
+let string_of_imm : imm -> string = function
+  | Lit i -> Int64.to_string i
+  | Lbl l -> string_of_lbl l
+
+let string_of_operand : operand -> string = function
+  | Imm i -> "$" ^ string_of_imm i
+  | Reg r -> string_of_reg r
+  | Ind1 i -> string_of_imm i
+  | Ind2 r -> "(" ^ string_of_reg r ^ ")"
+  | Ind3 (i, r) -> string_of_imm i ^ "(" ^ string_of_reg r ^ ")"
+
+let string_of_byte_operand : operand -> string = function
+  | Imm i -> "$" ^ string_of_imm i
+  | Reg r -> string_of_byte_reg r
+  | Ind1 i -> string_of_imm i
+  | Ind2 r -> "(" ^ string_of_reg r ^ ")"
+  | Ind3 (i, r) -> string_of_imm i ^ "(" ^ string_of_reg r ^ ")"
+
+let string_of_jmp_operand : operand -> string = function
+  | Imm i -> string_of_imm i
+  | Reg r -> "*" ^ string_of_reg r
+  | Ind1 i -> "*" ^ string_of_imm i
+  | Ind2 r -> "*" ^ "(" ^ string_of_reg r ^ ")"
+  | Ind3 (i, r) -> "*" ^ string_of_imm i ^ "(" ^ string_of_reg r ^ ")"
+
+let string_of_cnd : cnd -> string = function
+  | Eq -> "e"  | Neq -> "ne" | Gt -> "g"
+  | Ge -> "ge" | Lt -> "l"   | Le -> "le"
+
+let string_of_opcode : opcode -> string = function
+  | Movq -> "movq" | Pushq -> "pushq" | Popq -> "popq"
+  | Leaq -> "leaq"
+  | Incq -> "incq" | Decq -> "decq" | Negq -> "negq" | Notq -> "notq"
+  | Addq -> "addq" | Subq -> "subq" | Imulq -> "imulq"
+  | Xorq -> "xorq" | Orq -> "orq"  | Andq -> "andq"
+  | Shlq -> "shlq" | Sarq -> "sarq" | Shrq -> "shrq"
+  | Jmp  -> "jmp"  | J c -> "j" ^ string_of_cnd c 
+  | Cmpq -> "cmpq" | Set c -> "set" ^ string_of_cnd c
+  | Callq -> "callq" | Retq -> "retq"
+
+let map_concat s f l = String.concat s @@ List.map f l
+
+let string_of_shift op = function
+  | [ Imm _i ; _dst ] as args ->
+    "\t" ^ string_of_opcode op ^ "\t" ^ map_concat ", " string_of_operand args
+  | [ Reg Rcx ; dst ] ->
+    Printf.sprintf "\t%s\t%%cl, %s" (string_of_opcode op) (string_of_operand dst)
+  | args -> failwith (Printf.sprintf "shift instruction has invalid operands: %s\n" 
+                     (map_concat ", " string_of_operand args))
+                   
+let string_of_ins (op, args: ins) : string =
+  match op with
+  | Shlq | Sarq | Shrq -> string_of_shift op args
+  | _ ->
+  let f = match op with
+    | J _ | Jmp | Callq -> string_of_jmp_operand 
+    | Set _ -> string_of_byte_operand
+    | _ -> string_of_operand 
+  in
+  "\t" ^ string_of_opcode op ^ "\t" ^ map_concat ", " f args
+
+let string_of_data : data -> string = function
+  | Asciz s -> "\t.asciz\t" ^ "\"" ^ (String.escaped s) ^ "\""
+  | Quad i -> "\t.quad\t" ^ string_of_imm i
+
+let string_of_asm : asm -> string = function
+  | Text is -> "\t.text\n" ^ map_concat "\n" string_of_ins is
+  | Data ds -> "\t.data\n" ^ map_concat "\n" string_of_data ds
+
+let string_of_elem {lbl; global; asm} : string =
+  let sec, body = match asm with
+    | Text is -> "\t.text\n", map_concat "\n" string_of_ins is
+    | Data ds -> "\t.data\n", map_concat "\n" string_of_data ds
+  in
+  let glb = if global then "\t.globl\t" ^ string_of_lbl lbl ^ "\n" else "" in
+  sec ^ glb ^ string_of_lbl lbl ^ ":\n" ^ body
+
+let string_of_prog (p:prog) : string =
+  String.concat "\n" @@ List.map string_of_elem p

hw2/submit_zip_contents.txt

@@ -0,0 +1,2 @@
+bin/simulator.ml
+test/studenttests.ml

hw2/test/dune

@@ -0,0 +1,17 @@
+(env
+ (dev
+  (flags
+   (:standard -g -w "+a-4-7-9-26-27-29-30-32..42-44-45-48-50-60-66..70"))))
+
+(library
+ (name studenttests)
+ (modules studenttests)
+ (libraries util sim x86 gradedtests))
+
+(library
+ (name gradedtests)
+ (modules
+  gradedtests
+  ; project libraries
+  )
+ (libraries util sim x86))

hw2/test/gradedtests.ml

@@ -0,0 +1,655 @@
+open Util.Assert
+open Sim.Simulator
+open X86
+open Asm
+
+(* Test suite for asm.ml *)
+
+(* Do NOT modify this file -- we will overwrite it with our *)
+(* own version when we test your project.                   *)
+
+(* These tests will be used to grade your assignment *)
+
+(* Example Programs *)
+
+let helloworld = [ text "foo"
+                            [ Xorq, [~%Rax; ~%Rax]
+                            ; Movq, [~$100; ~%Rax]
+                            ; Retq, []
+                            ]
+                     ; text "main" 
+                            [ Xorq, [~%Rax; ~%Rax]
+                            ; Movq, [Ind1 (Lbl "baz"); ~%Rax]
+                            ; Retq, []
+                            ]
+                     ; data "baz" 
+                            [ Quad (Lit 99L)
+                            ; Asciz "Hello, world!"
+                            ]
+                     ]
+
+let factorial_iter n = [ text "main"
+                                  [ Movq,  [~$1; ~%Rax]
+                                  ; Movq,  [~$n; ~%Rdi]
+                                  ]
+                           ; text "loop"
+                                  [ Cmpq,  [~$0; ~%Rdi]
+                                  ; J Eq,  [~$$"exit"]
+                                  ; Imulq, [~%Rdi; ~%Rax]
+                                  ; Decq,  [~%Rdi]
+                                  ; Jmp,   [~$$"loop"]
+                                  ]
+                           ; text "exit"
+                                  [ Retq,  [] 
+                                  ]
+                           ]
+
+let factorial_rec n = [ text "fac"
+                                 [ Subq,  [~$8; ~%Rsp]
+                                 ; Cmpq,  [~$1; ~%Rdi]
+                                 ; J Le,  [~$$"exit"]
+                                 ; Movq,  [~%Rdi; Ind2 Rsp]
+                                 ; Decq,  [~%Rdi]
+                                 ; Callq, [~$$"fac"]
+                                 ; Imulq, [Ind2 Rsp; ~%Rax]
+                                 ; Addq,  [~$8; ~%Rsp]
+                                 ; Retq,  []
+                                 ]
+                          ; text "exit"
+                                 [ Movq,  [~$1; ~%Rax]
+                                 ; Addq,  [~$8; ~%Rsp]
+                                 ; Retq,  [] 
+                                 ]
+                          ; gtext "main"
+                                 [ Movq,  [~$n; ~%Rdi]
+                                 ; Callq, [~$$"fac"]
+                                 ; Retq,  []
+                                 ]
+                      ]
+
+(* Object Builders *)
+
+let sbyte_list (a: sbyte array) (start: int) : sbyte list =
+  Array.to_list (Array.sub a start 8)
+
+let stack_offset (i: quad) : operand = Ind3 (Lit i, Rsp)
+
+let test_exec: exec =
+  { entry = 0x400008L
+  ; text_pos = 0x400000L
+  ; data_pos = 0x400064L
+  ; text_seg = [] 
+  ; data_seg = []
+  }
+
+
+
+let test_machine (bs: sbyte list): mach =
+  let mem = (Array.make mem_size (Byte '\x00')) in
+  Array.blit (Array.of_list bs) 0 mem 0 (List.length bs);
+  let regs = Array.make nregs 0L in
+  regs.(rind Rip) <- mem_bot;
+  regs.(rind Rsp) <- Int64.sub mem_top 8L;
+  { flags = {fo = false; fs = false; fz = false};
+    regs = regs;
+    mem = mem
+  }
+
+let helloworld_dataseg =
+  [ Byte 'c'; Byte '\x00'; Byte '\x00'; Byte '\x00'
+  ; Byte '\x00'; Byte '\x00'; Byte '\x00'; Byte '\x00'
+  ; Byte 'H'; Byte 'e' ; Byte 'l'; Byte 'l'
+  ; Byte 'o'; Byte ','; Byte ' '; Byte 'w'
+  ; Byte 'o'; Byte 'r'; Byte 'l'; Byte 'd'
+  ; Byte '!'; Byte '\x00' ]
+
+let helloworld_textseg =
+  [ InsB0 (Xorq, [Reg Rax; Reg Rax]);              InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ; InsB0 (Movq, [Imm (Lit 100L); Reg Rax]);       InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ; InsB0 (Retq, []);                              InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ; InsB0 (Xorq, [Reg Rax; Reg Rax]);              InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ; InsB0 (Movq, [Ind1 (Lit 0x400030L); Reg Rax]); InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ; InsB0 (Retq, []);                              InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ]
+
+(* Testing Functions *)
+
+let interp_cnd_test (fo, fs, fz) tru () =
+  let flags = {fo = fo; fs = fs; fz = fz} in
+  let all = [Eq;Neq;Gt;Ge;Lt;Le] in
+  let fls = List.filter (fun c -> not (List.mem c tru)) all in
+  let fn = interp_cnd flags in
+  let tru' = List.filter fn all in
+  let fls' = List.filter (fun c -> not (List.mem c tru')) all in
+  List.iter (fun c ->
+    if not (List.mem c tru)
+    then failwith (Printf.sprintf "o:%b s:%b f:%b %s expected"
+      fo fs fz (string_of_cnd c))
+    else ()
+  ) tru';
+  List.iter (fun c ->
+    if not (List.mem c fls)
+    then failwith (Printf.sprintf "o:%b s:%b f:%b %s !expected"
+      fo fs fz (string_of_cnd c))
+    else ()
+  ) fls'
+
+
+  
+
+let cc_test (s:string) (n: int) (m: mach) (fo', fs', fz') (f: mach -> bool) () =
+  let m' = {m with flags = {fo=fo';fs=fs';fz=fz'}} in
+  for _ri=1 to n do step m' done;
+  if (f m') then () else failwith s
+
+let cs_test (n:int) (m:mach) (fo',fs',fz') =
+  cc_test (Printf.sprintf "expected OF:%b SF:%b ZF:%b" fo' fs' fz')
+    n m (not fo',not fs',not fz')
+    (fun m -> m.flags.fo = fo' && m.flags.fs = fs' && m.flags.fz = fz')
+    
+let cso_test (n: int) (m:mach) (fo':bool) =
+  cc_test (Printf.sprintf "expected OF:%b" fo') n m (not fo',false,false)
+    (fun m -> m.flags.fo = fo')
+
+let csi_test (n: int) (m:mach) =
+  cc_test "expected TTT ccodes" n m (true,true,true)
+    (fun m -> m.flags.fo && m.flags.fs && m.flags.fz)
+
+let segfault_test addr () =
+  match map_addr addr with 
+    | Some _ -> failwith "Should have raised X86_segmentation_fault"
+    | None -> ()
+
+let undefinedsym_test (p:prog) () =
+  try ignore (assemble p);
+    failwith "Should have raised Undefined_sym"
+  with 
+    | Undefined_sym _ -> ()
+    | _ -> failwith "Should have raised Undefined_sym"
+
+let machine_test (s:string) (n: int) (m: mach) (f:mach -> bool) () =
+  for _i=1 to n do step m done;
+  if (f m) then () else failwith ("expected " ^ s)
+
+let program_test (p:prog) (ans:int64) () =
+    let res = assemble p |> load |> run in
+    if res <> ans
+    then failwith (Printf.sprintf("Expected %Ld but got %Ld") ans res)
+    else ()
+
+
+(* Tests *)
+
+let map_addr_tests = [
+    ("map_addr1", assert_eqf (fun () -> (map_addr 0x40FFF8L)) (Some 65528));
+    ("map_addr2", assert_eqf (fun () -> (map_addr 0x4000FFL)) (Some 255));
+    ("map_addr3", assert_eqf (fun () -> (map_addr 0x400000L)) (Some 0));
+    ("map_addr4", segfault_test 0x0000000000000000L);
+    ("map_addr5", segfault_test 0xFFFFFFFFFFFFFFFDL);
+    (* we expect your segfault function works correctly *)
+    ("map_addr_seg_error", assert_eqf (fun () -> try map_addr_segfault 0xFFFFFFFFFFFFFFFDL with X86lite_segfault -> 42;) 42);
+    ("map_addr_seg_valid", assert_eqf (fun () -> map_addr_segfault 0x40FFF8L) 65528)
+]
+
+let read_write_quad_tests = 
+  (* kkkk *)
+  let test_code = [
+    InsB0 (Movq, [~$42; ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ] in 
+  let m = test_machine test_code in
+  let test_addr = 0x40FFF8L in 
+  [
+  ("read_quad1", assert_eqf (fun () -> readquad m test_addr) (0L));
+  ("read_write_quad", assert_eqf (fun ()-> 
+    let _ = (writequad m test_addr 114514L) in 
+    readquad m test_addr)  (114514L))
+]
+
+let set_flags_tests = 
+  (* see manual for more information *)
+  let test_code = [
+    InsB0 (Movq, [~$42; ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ] in 
+  let m = test_machine test_code in
+  let opcode = Sarq in
+  let oprands = [2L; 1L] in
+    [("set_flags", assert_eqf 
+      (fun () -> let ()  = set_flags m opcode oprands {value=0L; overflow=false} in  m.flags)
+      ({fo=false; fs=false; fz=true}))
+      ] 
+  
+
+
+let fetch_ins_tests = 
+  let test_code = [
+    InsB0 (Movq, [~$42; ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ] in 
+  let m = test_machine test_code in
+  let rip : quad = m.regs.(rind Rip) in 
+  let instr : ins = (Movq, [~$42; ~%Rax]) in 
+  [
+    ("fetch instruction", 
+      assert_eqf (fun () -> fetchins m rip) instr)
+  ]
+
+
+let interp_cnd_tests = [
+    ("ccs_fff", interp_cnd_test (false,false,false) [Neq;Gt;Ge] );
+    ("ccs_fft", interp_cnd_test (false,false,true)  [Eq;Le;Ge]  );
+    ("ccs_ftf", interp_cnd_test (false,true,false)  [Neq;Le;Lt] );
+    ("ccs_ftt", interp_cnd_test (false,true,true)   [Eq;Le;Lt]  );
+    ("ccs_tff", interp_cnd_test (true,false,false)  [Neq;Le;Lt] );
+    ("ccs_tft", interp_cnd_test (true,false,true)   [Eq;Le;Lt]  );
+    ("ccs_ttf", interp_cnd_test (true,true,false)   [Neq;Gt;Ge] );
+    ("ccs_ttt", interp_cnd_test (true,true,true)    [Eq;Le;Ge]  );
+]
+
+let mov_ri = test_machine
+  [InsB0 (Movq, [~$42; ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag]
+
+
+
+let add = test_machine
+  [InsB0 (Addq, [~$1; ~%Rax])            ;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ;InsB0 (Addq, [~%Rax; ~%Rbx])          ;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ;InsB0 (Addq, [~%Rbx; stack_offset 0L]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ]
+
+
+
+let hidden_functionality_tests = [
+
+]
+
+let functionality_tests = [
+  ("mov_ri", machine_test "rax=42" 1 mov_ri
+    (fun m -> m.regs.(rind Rax) = 42L)
+  );
+  ("add", machine_test "rax=rbx=*66528=1" 3 add
+    (fun m -> m.regs.(rind Rax) = 1L
+           && m.regs.(rind Rbx) = 1L
+           && int64_of_sbytes (sbyte_list m.mem (mem_size-8)) = 1L
+    )
+  );
+]
+
+let mov_mr = test_machine
+  [InsB0 (Movq, [~$42; ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ;InsB0 (Movq, [~%Rax; stack_offset (-8L)]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag]
+
+
+let subq = test_machine
+    [InsB0 (Subq, [~$1; ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ;InsB0 (Subq, [~%Rax; ~%Rbx]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ;InsB0 (Subq, [~%Rbx; stack_offset 0L]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag]
+
+let andq = test_machine
+    [InsB0 (Movq, [~$2; ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ;InsB0 (Movq, [~$3; ~%Rbx]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ;InsB0 (Movq, [~$255; ~%Rcx]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ;InsB0 (Movq, [~$1; stack_offset 0L]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ;InsB0 (Andq, [~%Rax; ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ;InsB0 (Andq, [~$2; ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ;InsB0 (Andq, [~%Rax; ~%Rbx]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ;InsB0 (Andq, [stack_offset 0L; ~%Rcx]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ]
+
+
+let negq = test_machine
+    [InsB0 (Movq, [~$42; ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ;InsB0 (Movq, [~$(-24); stack_offset 0L]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ;InsB0 (Movq, [Imm (Lit Int64.min_int); ~%Rbx]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ;InsB0 (Negq, [~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ;InsB0 (Negq, [stack_offset 0L]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ;InsB0 (Negq, [~%Rbx]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ]
+
+
+let shl = test_machine
+    [InsB0 (Movq, [~$1; ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ;InsB0 (Movq, [~$2; stack_offset 0L]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ;InsB0 (Movq, [~$3; ~%Rcx]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ;InsB0 (Shlq, [~$2; ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ;InsB0 (Shlq, [~%Rcx; stack_offset 0L]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ]
+
+
+let imul = test_machine
+    [InsB0 (Movq, [~$2; ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ;InsB0 (Movq, [~$22; ~%Rbx]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ;InsB0 (Imulq, [~%Rbx; ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ]
+
+let pushq = test_machine
+    [InsB0 (Pushq, [~$42]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag]
+
+let popq = test_machine
+    [InsB0 (Addq, [~$(-8); ~%Rsp]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ;InsB0 (Movq, [~$42; stack_offset 0L]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ;InsB0 (Popq, [~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ]
+
+let cmpq = test_machine
+    [InsB0 (Movq, [~$4; ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ;InsB0 (Movq, [~$2; stack_offset 0L]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ;InsB0 (Cmpq, [~$1; ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ;InsB0 (Cmpq, [~%Rax; ~%Rbx]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ;InsB0 (Cmpq, [~%Rbx; stack_offset 0L]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+    ]
+
+let hidden_instruction_tests = [
+
+]
+
+let instruction_tests = [
+  ("mov_mr", machine_test "*65520=42" 2 mov_mr
+    (fun m -> int64_of_sbytes (sbyte_list m.mem (mem_size-16)) = 42L)
+  );
+  ("subq", machine_test "rax=*65528=-1L; rbx=1" 3 subq
+    (fun m -> m.regs.(rind Rax) = (Int64.neg 1L)
+           && m.regs.(rind Rbx) = 1L
+           && int64_of_sbytes (sbyte_list m.mem (mem_size-8)) = (Int64.neg 1L)
+    )
+  );
+  ("andq", machine_test "rax=2 rbx=2 rcx=1 *65528=1" 8 andq
+    (fun m -> m.regs.(rind Rax) = 2L
+           && m.regs.(rind Rbx) = 2L
+           && m.regs.(rind Rcx) = 1L
+           && int64_of_sbytes (sbyte_list m.mem (mem_size-8)) = 1L
+    )
+  );
+  ("negq", machine_test "rax=-42 rbx=min_int64 *65528=24" 6 negq
+    (fun m -> m.regs.(rind Rax) = Int64.neg 42L
+           && m.regs.(rind Rbx) = Int64.min_int
+           && int64_of_sbytes (sbyte_list m.mem (mem_size-8)) = 24L
+    )
+  );
+  ("shl", machine_test "rax=4 *65528=16" 5 shl
+    (fun m -> m.regs.(rind Rax) = 4L
+           && int64_of_sbytes (sbyte_list m.mem (mem_size-8)) = 16L
+    )
+  );
+  ("imul", machine_test "rax=44 *65528=2" 3 imul
+    (fun m -> m.regs.(rind Rax) = 44L)
+  );
+  ("pushq", machine_test "rsp=4 *65520=2A" 1 pushq
+    (fun m -> m.regs.(rind Rsp) = 0x0040FFF0L
+           && int64_of_sbytes (sbyte_list m.mem (mem_size-16)) = 0x2AL
+    )
+  );
+  ("popq", machine_test "rsp=4259832 rax=2A" 3 popq
+    (fun m -> m.regs.(rind Rax) = 0x2AL
+           && m.regs.(rind Rsp) = 0x0040FFF8L
+    )
+  );
+  ("cmpq", machine_test "rax=4 rbx=0" 5 cmpq
+    (fun m -> m.regs.(rind Rax) = 4L
+           && m.regs.(rind Rbx) = 0L
+           && int64_of_sbytes (sbyte_list m.mem (mem_size-8)) = 2L
+    )
+  );
+]
+
+let cc_add_1 = test_machine
+  [InsB0 (Movq, [Imm (Lit 0xFFFFFFFFFFFFFFFFL); ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ;InsB0 (Addq, [~$1; ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ]
+
+let cc_add_2 = test_machine
+  [InsB0 (Movq, [Imm (Lit 0xFFFFFFFFFFFFFFFFL); ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ;InsB0 (Addq, [Imm (Lit 0xFFFFFFFFFFFFFFFFL); ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ]
+
+let cc_add_3 = test_machine
+  [InsB0 (Movq, [Imm (Lit 0x7FFFFFFFFFFFFFFFL); ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ;InsB0 (Addq, [~$42; ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ]
+
+let cc_add_4 = test_machine
+  [InsB0 (Movq, [Imm (Lit 0x9000000000000000L); ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ;InsB0 (Addq, [Imm (Lit 0xA000000000000000L); ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+
+  ]
+
+let cc_neg_1 = test_machine
+  [InsB0 (Movq, [Imm (Lit Int64.min_int); ~%Rbx]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ;InsB0 (Negq, [~%Rbx]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ]
+
+let cc_neg_2 = test_machine
+  [InsB0 (Movq, [~$1; ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ;InsB0 (Negq, [~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ]
+
+
+let cc_cmp_1 = test_machine
+  [InsB0 (Movq, [~$0; ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ;InsB0 (Cmpq, [Imm (Lit 0x8000000000000000L); ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ]
+
+let cc_cmp_2 = test_machine
+  [InsB0 (Movq, [Imm (Lit 0x8000000000000000L); ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ;InsB0 (Cmpq, [~$0; ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ]
+
+
+let cc_imul_1 = test_machine
+  [InsB0 (Movq, [~$(-1); ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ;InsB0 (Imulq, [~$(-1); ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ]
+
+
+let cc_and = test_machine
+  [InsB0 (Movq, [Imm (Lit 0x0F0F0F0FL); ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ;InsB0 (Andq, [Imm (Lit 0xF0F0F0F0L); ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ]
+
+let cc_or = test_machine
+  [InsB0 (Movq, [~$0xFFFFFFF; ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ;InsB0 (Orq, [~$0xF0F0F0F0; ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ]
+
+
+let cc_set = test_machine
+  [InsB0 (Set Neq, [~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag]
+
+let cc_push = test_machine
+  [InsB0 (Pushq, [~$0]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag]
+
+let cc_pop = test_machine
+  [InsB0 (Popq, [~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag]
+
+let cc_ret = test_machine
+  [InsB0 (Retq, []);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag]
+
+let cc_mov = test_machine
+  [InsB0 (Movq, [~$0; ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag]
+
+let cc_jmp = test_machine
+  [InsB0 (Jmp, [~$0x400008]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag]
+
+let cc_js = test_machine
+  [InsB0 (J Neq, [~$0x400008]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag]
+
+let cc_jf = test_machine
+  [InsB0 (J Eq, [~$0x400008]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag]
+
+let cc_call = test_machine
+  [InsB0 (Callq, [~$0x400008]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag]
+
+let cc_lea = test_machine
+  [InsB0 (Movq, [~$0x400600; ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ;InsB0 (Movq, [~$0x408000; ~%Rcx]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ;InsB0 (Leaq, [Ind2 Rax; ~%R08]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ;InsB0 (Movq, [~%R08; Ind2 Rcx]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag]
+
+
+
+let hidden_condition_flag_set_tests = [
+
+]
+
+let condition_flag_set_tests =
+  [ ("cc_add_1", cs_test 2 cc_add_1 (false, false, true))
+  ; ("cc_add_2", cs_test 2 cc_add_2 (false, true, false))
+  ; ("cc_add_3", cs_test 2 cc_add_3 (true, true, false))
+  ; ("cc_add_4", cs_test 2 cc_add_4 (true, false, false))
+  ; ("cc_neg_1", cs_test 2 cc_neg_1 (true, true, false))
+  ; ("cc_neg_2", cs_test 2 cc_neg_2 (false, true, false))
+  ; ("cc_cmp_1", cs_test 2 cc_cmp_1 (true, true, false))
+  ; ("cc_cmp_2", cs_test 2 cc_cmp_2 (false, true, false))
+  ; ("cc_imul_1", cso_test 2 cc_imul_1 false)
+  ; ("cc_and", cs_test 2 cc_and (false, false, true))
+  ; ("cc_or", cs_test 2 cc_or (false, false, false))
+  ; ("cc_push", csi_test 1 cc_push)
+  ; ("cc_pop", csi_test 1 cc_pop)
+  ; ("cc_set", csi_test 1 cc_set)
+  ; ("cc_ret", csi_test 1 cc_ret)
+  ; ("cc_mov", csi_test 1 cc_mov)
+  ; ("cc_jmp", csi_test 1 cc_jmp)
+  ; ("cc_jmp", csi_test 1 cc_js)
+  ; ("cc_jmp", csi_test 1 cc_jf)
+  ; ("cc_call", csi_test 1 cc_call)
+  ; ("cc_lea", csi_test 3 cc_lea)
+  ]
+
+
+let interpret_opcode_tests = 
+  (* kkkk *)
+  let open Int64 in 
+  let open Sim.Simulator in 
+  let open Sim.Int64_overflow in 
+  let test_code = [
+    InsB0 (Movq, [~$42; ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ] in 
+  let m = test_machine test_code in
+  let opcode, args = (Movq, [~$42; ~%Rax]) in 
+  let expected_state = ok 42L in 
+
+  [
+    ("intepret_opcode", assert_eqf  (fun()-> 
+    let ws = interp_operands m (opcode, args) in
+    interp_opcode m opcode ws) expected_state);
+    ]
+  
+
+let crack_tests = 
+  let open Asm in 
+  let i = (Pushq, [~$42]) in
+  [
+    ("crack_pushq", assert_eqf (fun() -> 
+      crack i) ([ Subq, [Imm (Lit 8L); Reg Rsp]
+                       ; Movq, [~$42; Ind2 Rsp] ]))  
+  ;]
+
+
+(* Test Suites *)
+
+let ins_writeback_tests = 
+  let test_code = [
+    InsB0 (Movq, [~$42; ~%Rax]);InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag;InsFrag
+  ] in 
+  let m = test_machine test_code in
+    [
+      ("instruction write back unit", assert_eqf 
+      (fun () -> 
+        let closure = ins_writeback m (Movq, [~$45; ~%Rax]) in
+         closure 99L; m.regs.(rind Rax))
+      99L)
+    ]
+
+    let load_chunk_size_tests= 
+      let inss = [
+        (Movq, [~$42; ~%Rax]);
+    (Movq, [~$43; ~%Rbx]);
+    (Movq, [~$44; ~%Rcx]);
+    (Movq, [~$45; ~%Rdx])] in
+
+    let data = [
+      Quad (Lit 99L)
+      ; Asciz "Hello, world!"
+    ] in 
+      [
+        ("ins size", assert_eqf (fun () -> is_size(inss)) 32L);
+      ("data size", assert_eqf (fun () -> ds_size(data)) 22L)
+    ]
+
+
+let easy_tests : suite =
+[
+  GradedTest("Map AddressesUnit", 1, map_addr_tests);
+  GradedTest("Read Write Quad Unit", 1, read_write_quad_tests);
+  
+  GradedTest("Condition Codes Unit", 1, interp_cnd_tests);
+  GradedTest("Fetch Instructions Unit", 1, fetch_ins_tests);
+  GradedTest("Interpret Opcode Unit", 1, interpret_opcode_tests);
+  GradedTest("Crack Ops Unit", 1, crack_tests);
+  GradedTest("Set Flag Unit", 1, set_flags_tests);
+  GradedTest("Ins Write Back Unit", 1, ins_writeback_tests);
+
+  
+  GradedTest("Data Chunk Size Unit", 2, load_chunk_size_tests);
+  GradedTest("Easy Assemble Tests", 2, [
+    ("assemble1", assert_eqf (fun () -> (assemble helloworld).text_pos) 0x400000L );
+    ("assemble2", assert_eqf (fun () -> (assemble helloworld).data_pos) 0x400030L );
+  ]);
+
+  
+
+  GradedTest("Easy Load Tests", 3, [
+    ("load_flags", assert_eqf (fun () -> (load test_exec).flags)
+                              {fo = false; fs = false; fz = false});
+    ("load_rip", assert_eqf (fun () -> (load test_exec).regs.(rind Rip))
+                             0x400008L);
+    ("load_rsp", assert_eqf (fun () -> (load test_exec).regs.(rind Rsp))
+                             0x40FFF8L);
+  ]);
+]
+
+let medium_tests : suite = [
+  GradedTest("Medium Assemble Tests", 5,[
+    ("assemble1", assert_eqf (fun () -> (assemble helloworld).text_seg) helloworld_textseg );
+    ("assemble2", undefinedsym_test [text "foo" [Retq,[]]]);
+    ("assemble3", assert_eqf (fun () -> (assemble helloworld).data_seg) helloworld_dataseg );
+    ("assemble4", undefinedsym_test [text "main" [Jmp,[~$$"loop"];Retq,[]]]);
+  ]);
+  GradedTest("Medium Load Tests", 5,[
+    ("load_exit_addr", assert_eqf (fun () ->
+          let m = load test_exec in
+          int64_of_sbytes (sbyte_list m.mem 0x0fff8)
+    ) exit_addr);
+  ]);
+  GradedTest("Functionality Tests", 3, functionality_tests);
+  GradedTest("Hidden Functionality Tests", 2, hidden_functionality_tests);  
+  GradedTest("Instruction Tests", 5, instruction_tests);
+  GradedTest("Hidden Instruction Tests", 5, hidden_instruction_tests);  
+  GradedTest("Condition Flag Set Tests", 3, condition_flag_set_tests);
+  GradedTest("Hidden Condition Flag Set Tests", 2, hidden_condition_flag_set_tests);
+]
+
+let hard_tests : suite = [
+  GradedTest ("End-to-end Factorial", 10, [
+    ("fact6", program_test (factorial_rec 6) 720L);
+  ]);
+  GradedTest ("Hidden End-to-end Hard", 20,
+                []
+    )]
+
+let manual_tests : suite = [
+  GradedTest ("PartIIITestCase (manual)", 10, [
+      
+    ]);
+  GradedTest ("Other Team Tests (manual)", 10, 
+      []
+    );
+  GradedTest ("Style (manual)", 5, [
+      
+    ]);
+]
+
+let graded_tests : suite =
+  timeout_suite 3 (
+  easy_tests @
+  medium_tests @
+  hard_tests @
+  manual_tests)

hw2/test/studenttests.ml

@@ -0,0 +1,57 @@
+open Util.Assert
+open X86
+open Sim.Simulator
+open Gradedtests
+open Asm 
+(* These tests are provided by you -- they will be graded manually *)
+
+(* You should also add additional test cases here to help you   *)
+(* debug your program.                                          *)
+
+
+let test_my =
+  let bin = [
+    InsB0 (Movq, Asm.[ ~$42; ~%Rax ]);
+    InsFrag;
+    InsFrag;
+    InsFrag;
+    InsFrag;
+    InsFrag;
+    InsFrag;
+    InsFrag;
+    ] 
+  
+  in 
+
+  let asm =  [gtext "main"
+  [ 
+    Movq,  [~$42; ~%Rax]];
+  ] in 
+
+  (assert_eqf (fun() ->  (assemble asm).text_seg) bin )
+
+ 
+let mov_ri =
+ test_machine
+ [
+ InsB0 (Movq, Asm.[ ~$42; ~%Rax ]);
+ InsFrag;
+ InsFrag;
+ InsFrag;
+ InsFrag;
+ InsFrag;
+ InsFrag;
+ InsFrag;
+ ]
+
+let provided_tests : suite = [
+  
+  Test ("My Tests", [
+    ("assert", test_my)
+  ]);
+
+  Test ("Student-Provided Big Test for Part III: Score recorded as PartIIITestCase", [
+    
+  ]);
+
+] 

hw3/Makefile

@@ -0,0 +1,22 @@
+all: main.native
+
+.PHONY: test
+test: main.native
+	./main.native --test
+
+main.native:
+	ocamlbuild -Is util,x86,ll,grading -libs unix,str,nums main.native -use-menhir
+
+main.byte:
+	ocamlbuild -Is util,x86,ll,grading -libs unix,str,nums main.byte -use-menhir
+
+.PHONY: utop repl
+utop: main.byte
+	utop -require unix,str,num
+
+repl: utop
+
+.PHONY: clean
+clean:
+	ocamlbuild -clean
+	rm -rf output a.out

hw3/README

@@ -0,0 +1,76 @@
+Using main.native:
+
+main.native acts like the clang compiler.  Given several .ll, .c, and .o files,
+it will compile the .ll files to .s files (using the compilerdesign backend) and then combine
+the results with the .c and .o files to produce an executable named a.out.  You can
+also compile the .ll files using clang instead of the compilerdesign backend, which can
+be useful for testing purposes.
+
+
+* To run the automated test harness do:
+  ./main.native --test              
+
+* To compile ll files using the compilerdesign backend:
+  ./main.native path/to/foo.ll 
+
+  - creates output/foo.s   backend assembly code
+  - creates output/foo.o   assembled object file
+  - creates a.out          linked executable
+
+ NOTE: by default the .s and .o files are created in 
+ a directory called output, and the filenames are 
+ chosen so that multiple runs of the compiler will
+ not overwrite previous outputs.  foo.ll will be 
+ compiled first to foo.s then foo_1.s, foo_2.s, etc.
+
+
+* To compile ll files using the clang backend:
+  ./main.native --clang path/to/foo.ll
+
+* Useful flags:
+
+  --print-ll 
+    echoes the ll program to the terminal
+
+  --print-x86
+    echoes the resulting .s file to the terminal
+
+  --interpret-ll
+    runs the ll file through the reference interpreter
+    and outputs the results to the console
+
+  --simulate-x86
+    runs the resulting .s file through the reference 
+    x86 simulator and outputs the result to the console
+
+  --execute-x86
+    runs the resulting a.out file natively
+    (applies to either the compilerdesign backend or clang-compiled code)
+
+  -v
+    generates verbose output, showing which commands are used
+    for linking, etc.
+
+  -op <dirname>
+    change the output path [DEFAULT=output]
+
+  -o 
+    change the generated executable's name [DEFAULT=a.out]
+
+  -S
+    stop after generating .s files 
+
+  -c 
+    stop after generating .o files 
+
+  -h or --help
+    display the list of options
+
+* Example uses:
+
+Run the test case /programs/factrect.ll using the compilerdesign backend:
+
+
+./main.native --execute-x86 programs/factrect.ll 
+--------------------------------------------------------------- Executing: a.out
+* a.out returned 120

hw3/backend.ml

@@ -0,0 +1,309 @@
+(* ll ir compilation -------------------------------------------------------- *)
+
+open Ll
+open X86
+
+(* Overview ----------------------------------------------------------------- *)
+
+(* We suggest that you spend some time understanding this entire file and
+   how it fits with the compiler pipeline before making changes.  The suggested
+   plan for implementing the compiler is provided on the project web page.
+*)
+
+
+(* helpers ------------------------------------------------------------------ *)
+
+(* Map LL comparison operations to X86 condition codes *)
+let compile_cnd = function
+  | Ll.Eq  -> X86.Eq
+  | Ll.Ne  -> X86.Neq
+  | Ll.Slt -> X86.Lt
+  | Ll.Sle -> X86.Le
+  | Ll.Sgt -> X86.Gt
+  | Ll.Sge -> X86.Ge
+
+
+
+(* locals and layout -------------------------------------------------------- *)
+
+(* One key problem in compiling the LLVM IR is how to map its local
+   identifiers to X86 abstractions.  For the best performance, one
+   would want to use an X86 register for each LLVM %uid.  However,
+   since there are an unlimited number of %uids and only 16 registers,
+   doing so effectively is quite difficult.  We will see later in the
+   course how _register allocation_ algorithms can do a good job at
+   this.
+
+   A simpler, but less performant, implementation is to map each %uid
+   in the LLVM source to a _stack slot_ (i.e. a region of memory in
+   the stack).  Since LLVMlite, unlike real LLVM, permits %uid locals
+   to store only 64-bit data, each stack slot is an 8-byte value.
+
+   [ NOTE: For compiling LLVMlite, even i1 data values should be
+   represented as a 8-byte quad. This greatly simplifies code
+   generation. ]
+
+   We call the datastructure that maps each %uid to its stack slot a
+   'stack layout'.  A stack layout maps a uid to an X86 operand for
+   accessing its contents.  For this compilation strategy, the operand
+   is always an offset from %rbp (in bytes) that represents a storage slot in
+   the stack.
+*)
+
+type layout = (uid * X86.operand) list
+
+(* A context contains the global type declarations (needed for getelementptr
+   calculations) and a stack layout. *)
+type ctxt = { tdecls : (tid * ty) list
+            ; layout : layout
+            }
+
+(* useful for looking up items in tdecls or layouts *)
+let lookup m x = List.assoc x m
+
+
+(* compiling operands  ------------------------------------------------------ *)
+
+(* LLVM IR instructions support several kinds of operands.
+
+   LL local %uids live in stack slots, whereas global ids live at
+   global addresses that must be computed from a label.  Constants are
+   immediately available, and the operand Null is the 64-bit 0 value.
+
+     NOTE: two important facts about global identifiers:
+
+     (1) You should use (Platform.mangle gid) to obtain a string
+     suitable for naming a global label on your platform (OS X expects
+     "_main" while linux expects "main").
+
+     (2) 64-bit assembly labels are not allowed as immediate operands.
+     That is, the X86 code: movq _gid %rax which looks like it should
+     put the address denoted by _gid into %rax is not allowed.
+     Instead, you need to compute an %rip-relative address using the
+     leaq instruction:   leaq _gid(%rip).
+
+   One strategy for compiling instruction operands is to use a
+   designated register (or registers) for holding the values being
+   manipulated by the LLVM IR instruction. You might find it useful to
+   implement the following helper function, whose job is to generate
+   the X86 instruction that moves an LLVM operand into a designated
+   destination (usually a register).
+*)
+let compile_operand (ctxt:ctxt) (dest:X86.operand) : Ll.operand -> ins =
+  function _ -> failwith "compile_operand unimplemented"
+
+
+
+(* compiling call  ---------------------------------------------------------- *)
+
+(* You will probably find it helpful to implement a helper function that
+   generates code for the LLVM IR call instruction.
+
+   The code you generate should follow the x64 System V AMD64 ABI
+   calling conventions, which places the first six 64-bit (or smaller)
+   values in registers and pushes the rest onto the stack.  Note that,
+   since all LLVM IR operands are 64-bit values, the first six
+   operands will always be placed in registers.  (See the notes about
+   compiling fdecl below.)
+
+   [ NOTE: It is the caller's responsibility to clean up arguments
+   pushed onto the stack, so you must free the stack space after the
+   call returns. ]
+
+   [ NOTE: Don't forget to preserve caller-save registers (only if
+   needed). ]
+*)
+
+
+
+
+(* compiling getelementptr (gep)  ------------------------------------------- *)
+
+(* The getelementptr instruction computes an address by indexing into
+   a datastructure, following a path of offsets.  It computes the
+   address based on the size of the data, which is dictated by the
+   data's type.
+
+   To compile getelementptr, you must generate x86 code that performs
+   the appropriate arithmetic calculations.
+*)
+
+(* [size_ty] maps an LLVMlite type to a size in bytes.
+    (needed for getelementptr)
+
+   - the size of a struct is the sum of the sizes of each component
+   - the size of an array of t's with n elements is n * the size of t
+   - all pointers, I1, and I64 are 8 bytes
+   - the size of a named type is the size of its definition
+
+   - Void, i8, and functions have undefined sizes according to LLVMlite.
+     Your function should simply return 0 in those cases
+*)
+let rec size_ty (tdecls:(tid * ty) list) (t:Ll.ty) : int =
+failwith "size_ty not implemented"
+
+
+
+
+(* Generates code that computes a pointer value.
+
+   1. op must be of pointer type: t*
+
+   2. the value of op is the base address of the calculation
+
+   3. the first index in the path is treated as the index into an array
+     of elements of type t located at the base address
+
+   4. subsequent indices are interpreted according to the type t:
+
+     - if t is a struct, the index must be a constant n and it
+       picks out the n'th element of the struct. [ NOTE: the offset
+       within the struct of the n'th element is determined by the
+       sizes of the types of the previous elements ]
+
+     - if t is an array, the index can be any operand, and its
+       value determines the offset within the array.
+
+     - if t is any other type, the path is invalid
+
+   5. if the index is valid, the remainder of the path is computed as
+      in (4), but relative to the type f the sub-element picked out
+      by the path so far
+*)
+let compile_gep (ctxt:ctxt) (op : Ll.ty * Ll.operand) (path: Ll.operand list) : ins list =
+failwith "compile_gep not implemented"
+
+
+
+(* compiling instructions  -------------------------------------------------- *)
+
+(* The result of compiling a single LLVM instruction might be many x86
+   instructions.  We have not determined the structure of this code
+   for you. Some of the instructions require only a couple of assembly
+   instructions, while others require more.  We have suggested that
+   you need at least compile_operand, compile_call, and compile_gep
+   helpers; you may introduce more as you see fit.
+
+   Here are a few notes:
+
+   - Icmp:  the Setb instruction may be of use.  Depending on how you
+     compile Cbr, you may want to ensure that the value produced by
+     Icmp is exactly 0 or 1.
+
+   - Load & Store: these need to dereference the pointers. Const and
+     Null operands aren't valid pointers.  Don't forget to
+     Platform.mangle the global identifier.
+
+   - Alloca: needs to return a pointer into the stack
+
+   - Bitcast: does nothing interesting at the assembly level
+*)
+let compile_insn (ctxt:ctxt) ((uid:uid), (i:Ll.insn)) : X86.ins list =
+      failwith "compile_insn not implemented"
+
+
+
+(* compiling terminators  --------------------------------------------------- *)
+
+(* prefix the function name [fn] to a label to ensure that the X86 labels are 
+   globally unique . *)
+let mk_lbl (fn:string) (l:string) = fn ^ "." ^ l
+
+(* Compile block terminators is not too difficult:
+
+   - Ret should properly exit the function: freeing stack space,
+     restoring the value of %rbp, and putting the return value (if
+     any) in %rax.
+
+   - Br should jump
+
+   - Cbr branch should treat its operand as a boolean conditional
+
+   [fn] - the name of the function containing this terminator
+*)
+let compile_terminator (fn:string) (ctxt:ctxt) (t:Ll.terminator) : ins list =
+  failwith "compile_terminator not implemented"
+
+
+(* compiling blocks --------------------------------------------------------- *)
+
+(* We have left this helper function here for you to complete. 
+   [fn] - the name of the function containing this block
+   [ctxt] - the current context
+   [blk]  - LLVM IR code for the block
+*)
+let compile_block (fn:string) (ctxt:ctxt) (blk:Ll.block) : ins list =
+  failwith "compile_block not implemented"
+
+let compile_lbl_block fn lbl ctxt blk : elem =
+  Asm.text (mk_lbl fn lbl) (compile_block fn ctxt blk)
+
+
+
+(* compile_fdecl ------------------------------------------------------------ *)
+
+
+(* This helper function computes the location of the nth incoming
+   function argument: either in a register or relative to %rbp,
+   according to the calling conventions.  You might find it useful for
+   compile_fdecl.
+
+   [ NOTE: the first six arguments are numbered 0 .. 5 ]
+*)
+let arg_loc (n : int) : operand =
+failwith "arg_loc not implemented"
+
+
+(* We suggest that you create a helper function that computes the
+   stack layout for a given function declaration.
+
+   - each function argument should be copied into a stack slot
+   - in this (inefficient) compilation strategy, each local id
+     is also stored as a stack slot.
+   - see the discussion about locals
+
+*)
+let stack_layout (args : uid list) ((block, lbled_blocks):cfg) : layout =
+failwith "stack_layout not implemented"
+
+(* The code for the entry-point of a function must do several things:
+
+   - since our simple compiler maps local %uids to stack slots,
+     compiling the control-flow-graph body of an fdecl requires us to
+     compute the layout (see the discussion of locals and layout)
+
+   - the function code should also comply with the calling
+     conventions, typically by moving arguments out of the parameter
+     registers (or stack slots) into local storage space.  For our
+     simple compilation strategy, that local storage space should be
+     in the stack. (So the function parameters can also be accounted
+     for in the layout.)
+
+   - the function entry code should allocate the stack storage needed
+     to hold all of the local stack slots.
+*)
+let compile_fdecl (tdecls:(tid * ty) list) (name:string) ({ f_ty; f_param; f_cfg }:fdecl) : prog =
+failwith "compile_fdecl unimplemented"
+
+
+
+(* compile_gdecl ------------------------------------------------------------ *)
+(* Compile a global value into an X86 global data declaration and map
+   a global uid to its associated X86 label.
+*)
+let rec compile_ginit : ginit -> X86.data list = function
+  | GNull     -> [Quad (Lit 0L)]
+  | GGid gid  -> [Quad (Lbl (Platform.mangle gid))]
+  | GInt c    -> [Quad (Lit c)]
+  | GString s -> [Asciz s]
+  | GArray gs | GStruct gs -> List.map compile_gdecl gs |> List.flatten
+  | GBitcast (t1,g,t2) -> compile_ginit g
+
+and compile_gdecl (_, g) = compile_ginit g
+
+
+(* compile_prog ------------------------------------------------------------- *)
+let compile_prog {tdecls; gdecls; fdecls} : X86.prog =
+  let g = fun (lbl, gdecl) -> Asm.data (Platform.mangle lbl) (compile_gdecl gdecl) in
+  let f = fun (name, fdecl) -> compile_fdecl tdecls name fdecl in
+  (List.map g gdecls) @ (List.map f fdecls |> List.flatten)

hw3/cinterop.c

@@ -0,0 +1,32 @@
+#include <stdint.h>
+#include <stdlib.h>
+#include <string.h>
+#include <stdio.h>
+
+void ll_puts(int8_t *s) {
+  puts((char *)s);
+}
+
+int8_t* ll_strcat(int8_t* s1, int8_t* s2) {
+  int l1 = strlen((char*)s1);
+  int l2 = strlen((char*)s2);
+  char* buf = (char*)calloc(l1 + l2 + 1, sizeof(char));
+  strncpy(buf, (char*)s1, l1);
+  strncpy(buf + l1, (char*)s2, l2+1);
+  return (int8_t*) buf;
+}
+
+int64_t ll_callback(int64_t (*fun)(int64_t, int64_t)) {
+  int64_t x = 19L;
+  return fun(x, x);
+}
+
+int8_t* ll_ltoa(int64_t i) {
+  char* buf = (char*)calloc(20, sizeof(char));
+  snprintf((char *)buf, 20, "%ld", (long)i);
+  return (int8_t *)buf;
+}
+
+void *ll_malloc(int64_t n, int64_t size) {
+  return calloc(n, size);
+}

hw3/driver.ml

@@ -0,0 +1,171 @@
+open Printf
+open Platform
+
+(* configuration flags ------------------------------------------------------ *)
+let interpret_ll = ref false   (* run the ll interpreter? *)
+let print_ll_flag = ref false       (* print the generated ll code? *)
+let print_x86_flag = ref false      (* print the generated x86 code? *)
+let clang = ref false          (* use the clang backend? *)
+let assemble = ref true        (* assemble the .s to .o files? *)
+let link = ref true            (* combine multiple .o files executable? *)
+let execute_x86 = ref false    (* run the resulting x86 program? *)
+let executable_filename = ref "a.out"
+
+
+(* files processed during this run of the compiler *)
+let files : string list ref = ref []
+
+let link_files = ref []
+let add_link_file path =
+  link_files := path :: (!link_files)
+
+
+(* terminal output ---------------------------------------------------------- *)
+  
+let print_banner s =
+  let rec dashes n = if n = 0 then "" else "-"^(dashes (n-1)) in
+  printf "%s %s\n%!" (dashes (79 - (String.length s))) s
+
+let print_ll file ll_ast =
+    print_banner (file ^ ".ll");
+    print_endline (Llutil.string_of_prog ll_ast)
+
+let print_x86 file asm_str =
+    print_banner file;
+    print_endline asm_str
+
+(* file i/o ----------------------------------------------------------------- *)
+
+let read_file (file:string) : string =
+  let lines = ref [] in
+  let channel = open_in file in
+  try while true; do
+      lines := input_line channel :: !lines
+  done; ""
+  with End_of_file ->
+    close_in channel;
+    String.concat "\n" (List.rev !lines)
+
+let write_file (file:string) (out:string) =
+  let channel = open_out file in
+  fprintf channel "%s" out;
+  close_out channel
+
+
+(* running the generated code ----------------------------------------------- *)
+
+let interpret program args : string =
+  let result = Llinterp.interp_prog program args in
+  Llinterp.string_of_sval result
+
+let string_of_file (f:in_channel) : string =
+  let rec _string_of_file (stream:string list) (f:in_channel) : string list=
+    try 
+      let s = input_line f in
+      _string_of_file (s::stream) f
+    with
+      | End_of_file -> stream
+  in 
+    String.concat "\n" (List.rev (_string_of_file [] f))
+
+let run_executable arg pr =
+  let cmd = sprintf "%s%s %s" dot_path pr arg in
+  sh cmd (fun _ i -> i)
+  
+let run_executable_to_tmpfile arg pr tmp =
+  let cmd = sprintf "%s%s %d > %s 2>&1" dot_path pr arg tmp in
+  sh cmd ignore_error
+
+
+let run_program (args:string) (executable:string) (tmp_out:string) : string =
+  let _ = 
+    let cmd = sprintf "%s%s %s > %s 2>&1" dot_path executable args tmp_out in
+    sh cmd ignore_error
+  in
+  let fi = open_in tmp_out in
+  let result = string_of_file fi in
+  let _ = close_in fi in
+    result
+
+
+(* compiler pipeline -------------------------------------------------------- *)
+
+(* These functions implement the compiler pipeline for a single ll file:
+     - parse the file 
+     - compile to a .s file using either clang or backend.ml
+     - assemble the .s to a .o file using clang
+*)
+let parse_ll_file filename =
+  let program = read_file filename |> 
+                Lexing.from_string |>
+                Llparser.prog Lllexer.token
+  in
+  program
+
+
+let process_ll_ast path file ll_ast =
+  let _ = if !print_ll_flag then print_ll file ll_ast in
+
+  (* Optionally interpret it using the compilerdesign reference interperter. *)
+  let _ = if !interpret_ll then
+      let result = interpret ll_ast [] in
+      Printf.printf "Interpreter Result: %s\n" result
+  in
+
+  (* generated file names *)
+  let dot_s_file = Platform.gen_name !Platform.output_path file ".s" in
+  let dot_o_file = Platform.gen_name !Platform.output_path file ".o" in
+
+  let _ =
+    if !clang then begin
+      Platform.verb "* compiling with clang";
+      Platform.clang_compile path dot_s_file;
+      if !print_x86_flag then begin
+        print_banner dot_s_file;
+        Platform.sh (Printf.sprintf "cat %s" dot_s_file) Platform.raise_error
+      end
+    end else begin
+      Platform.verb "* compiling with compilerdesign backend";
+      let asm_ast = Backend.compile_prog ll_ast in
+      let asm_str = X86.string_of_prog asm_ast in
+      let _ = if !print_x86_flag then print_x86 dot_s_file asm_str in
+      let _ = write_file dot_s_file asm_str in
+      ()
+    end
+  in
+  let _ = if !assemble then Platform.assemble dot_s_file dot_o_file in
+  let _ = add_link_file dot_o_file in 
+  ()
+
+let process_ll_file path file =
+  let _ = Platform.verb @@ Printf.sprintf "* processing file: %s\n" path in
+  let ll_ast = parse_ll_file path in
+  process_ll_ast path file ll_ast
+
+(* process files based on extension ----------------------------------------- *)
+
+let process_file path =
+  let basename, ext = Platform.path_to_basename_ext path in
+  begin match ext with
+    | "ll" -> process_ll_file path basename
+    | "o" -> add_link_file path
+    | "c" -> add_link_file path
+    | _ -> failwith @@ Printf.sprintf "found unsupported file type: %s" path
+  end
+
+(* process each file separately and then link all of them together *)
+let process_files files =
+  if (List.length files) > 0 then begin
+
+    List.iter process_file files;
+
+    ( if !assemble && !link then
+        Platform.link (List.rev !link_files) !executable_filename );
+
+    ( if !assemble && !link && !execute_x86 then
+        let ret = run_executable "" !executable_filename in
+        print_banner @@ Printf.sprintf "Executing: %s" !executable_filename;
+        Printf.printf "* %s returned %d\n" !executable_filename ret )
+  end
+
+

hw3/gradedtests.ml

@@ -0,0 +1,182 @@
+open Assert
+open X86
+open Ll
+open Backend
+
+(* Do NOT modify this file -- we will overwrite it with our *)
+(* own version when we test your project.                   *)
+
+(* These tests will be used to grade your assignment *)
+
+let size_ty_tests =
+  [ ("ty_size1", assert_eqf (fun () -> size_ty [] I1) 8)
+  ; ("ty_size3", assert_eqf (fun () -> size_ty [] I64) 8)
+  ; ("ty_size4", assert_eqf (fun () -> size_ty [] (Ptr Void)) 8)
+  ; ("ty_size2", assert_eqf (fun () -> size_ty [] (Ptr I1)) 8)
+  ; ("ty_size5", assert_eqf (fun () -> size_ty [] (Array (3, I64))) 24)
+  ; ("ty_size6", assert_eqf
+    (fun () -> size_ty [] (Struct [I64; I1; Ptr I8; Ptr I64; Array (10, I1) ])) 112)
+  ; ("ty size7", assert_eqf
+    (fun () -> size_ty [("O", I1);("S", I64)] (Struct [Namedt "O"; (Array (2, Namedt "S"))])) 24)
+  ]
+
+let arg_loc_tests =
+  []
+
+let exec_e2e_ast ll_ast args extra_files =
+  let output_path = !Platform.output_path in
+  let dot_s_file = Platform.gen_name output_path "test" ".s" in
+  let exec_file = Platform.gen_name output_path "exec" "" in
+  let asm_ast = Backend.compile_prog ll_ast in
+  let asm_str = X86.string_of_prog asm_ast in
+  let _ = Driver.write_file dot_s_file asm_str in
+  let _ = Platform.link (dot_s_file::extra_files) exec_file in
+  let result = Driver.run_executable args exec_file in
+  let _ = Platform.sh (Printf.sprintf "rm -f %s %s" dot_s_file exec_file) Platform.ignore_error in
+  let _ = Platform.verb @@ Printf.sprintf "** Executable exited with: %d\n" result in
+  Int64.of_int result
+
+
+let exec_e2e_file path args =
+  let ast = Driver.parse_ll_file path in
+  exec_e2e_ast ast args []
+
+let io_test path args =
+  let ll_ast = Driver.parse_ll_file path in
+  let output_path = !Platform.output_path in
+  let dot_s_file = Platform.gen_name output_path "test" ".s" in
+  let exec_file = Platform.gen_name output_path "exec" "" in
+  let tmp_file = Platform.gen_name output_path "tmp" ".txt" in
+  let asm_ast = Backend.compile_prog ll_ast in
+  let asm_str = X86.string_of_prog asm_ast in
+  let _ = Driver.write_file dot_s_file asm_str in
+  let _ = Platform.link (dot_s_file::["cinterop.c"]) exec_file in
+  let args = String.concat " " args in
+  let result = Driver.run_program args exec_file tmp_file in
+  let _ = Platform.sh (Printf.sprintf "rm -f %s %s %s" dot_s_file exec_file tmp_file) Platform.ignore_error in
+  let _ = Platform.verb @@ Printf.sprintf "** Executable output:\n%s\n" result in
+  result
+
+let c_link_test c_files path args =
+  let ll_ast = Driver.parse_ll_file path in
+  let output_path = !Platform.output_path in
+  let dot_s_file = Platform.gen_name output_path "test" ".s" in
+  let exec_file = Platform.gen_name output_path "exec" "" in
+  let asm_ast = Backend.compile_prog ll_ast in
+  let asm_str = X86.string_of_prog asm_ast in
+  let _ = Driver.write_file dot_s_file asm_str in
+  let _ = Platform.link (dot_s_file::c_files) exec_file in
+  let args = String.concat " " args in
+  let result = Driver.run_executable args exec_file in
+  let _ = Platform.sh (Printf.sprintf "rm -f %s %s" dot_s_file exec_file) Platform.ignore_error in
+    Int64.of_int result
+
+let executed tests =
+  List.map (fun (fn, ans) ->
+      fn, assert_eqf (fun () -> exec_e2e_file fn "") ans)
+    tests
+
+let executed_io tests =
+  List.map (fun (fn, args, ans) ->
+      (fn ^ ":" ^ (String.concat " " args)), assert_eqf (fun () -> io_test fn args) ans)
+    tests
+
+let executed_c_link tests =
+  List.map (fun (c_file, fn, args, ans) ->
+      (fn ^ ":" ^ (String.concat " " args)), assert_eqf (fun () -> c_link_test c_file fn args) ans)
+    tests
+
+let binop_tests =
+  [ "llprograms/add.ll", 14L
+  ; "llprograms/sub.ll", 1L
+  ; "llprograms/mul.ll", 45L
+  ; "llprograms/and.ll", 0L
+  ; "llprograms/or.ll",  1L
+  ; "llprograms/xor.ll", 0L
+  ; "llprograms/shl.ll", 168L
+  ; "llprograms/lshr.ll", 10L
+  ; "llprograms/ashr.ll", 5L ]
+
+let calling_convention_tests =
+  [ "llprograms/call.ll", 42L
+  ; "llprograms/call1.ll", 17L
+  ; "llprograms/call2.ll", 19L
+  ; "llprograms/call3.ll", 34L
+  ; "llprograms/call4.ll", 34L
+  ; "llprograms/call5.ll", 24L
+  ; "llprograms/call6.ll", 26L
+  ]
+
+let memory_tests =
+  [ "llprograms/alloca1.ll", 17L
+  ; "llprograms/alloca2.ll", 17L
+  ; "llprograms/global1.ll", 12L
+  ]
+
+let terminator_tests =
+  [ "llprograms/return.ll", 0L
+  ; "llprograms/return42.ll", 42L
+  ; "llprograms/br1.ll", 9L
+  ; "llprograms/br2.ll", 17L
+  ; "llprograms/cbr1.ll", 7L
+  ; "llprograms/cbr2.ll", 9L
+  ; "llprograms/duplicate_lbl.ll", 1L
+  ]
+
+let bitcast_tests =
+  [ "llprograms/bitcast1.ll", 3L
+  ]
+
+let gep_tests =
+  [ "llprograms/gep1.ll", 6L
+  ; "llprograms/gep2.ll", 4L
+  ; "llprograms/gep3.ll", 1L
+  ; "llprograms/gep4.ll", 2L
+  ; "llprograms/gep5.ll", 4L
+  ; "llprograms/gep6.ll", 7L
+  ; "llprograms/gep7.ll", 7L
+  ; "llprograms/gep8.ll", 2L
+  ]
+
+let io_tests =
+  [ "llprograms/helloworld.ll", [], "hello, world!"
+  ; "llprograms/string1.ll", [], "hello, world!hello, world!"
+  ; "llprograms/callback1.ll", [], "38"
+  ; "llprograms/args1.ll", ["hello"], "argc < 3"
+  ; "llprograms/args1.ll", ["hello"; "compilerdesign"], "hellocompilerdesign"
+  ; "llprograms/args1.ll", ["hello"; "compilerdesign"; "foo"], "argc > 3"
+  ]
+
+
+
+
+(* Hidden *)
+let hidden_large_tests =
+  []
+
+let large_tests = [ "llprograms/list1.ll", 3L
+                  ; "llprograms/cbr.ll", 42L
+                  ; "llprograms/factorial.ll", 120L
+                  ; "llprograms/factrect.ll", 120L
+                  ; "llprograms/duplicate_factorial.ll", 240L
+                  ]
+
+
+
+let tests : suite =
+  [ GradedTest("size_ty tests", 5, size_ty_tests)
+  ; GradedTest("arg_loc tests", 5, arg_loc_tests)
+  ; GradedTest("executed binop tests", 5, executed binop_tests)
+  ; GradedTest("terminator tests", 10, executed terminator_tests)
+  ; GradedTest("memory tests", 10, executed memory_tests)
+  ; GradedTest("calling convention tests", 15, executed calling_convention_tests)
+  ; GradedTest("bitcast tests", 2, executed bitcast_tests)
+  ; GradedTest("gep tests", 10, executed gep_tests)
+  ; GradedTest("large tests", 10, executed large_tests)
+  ; GradedTest("hidden large tests", 18, hidden_large_tests)
+  ; GradedTest("io tests", 10, executed_io io_tests)
+  ]
+
+
+let graded_tests : suite =
+  tests

hw3/ll/ll.ml

@@ -0,0 +1,98 @@
+(* LLVMlite: A simplified subset of LLVM IR *)
+
+(* Local identifiers *)
+type uid = string
+
+(* Global identifiers *)
+type gid = string
+
+(* Named types *)
+type tid = string
+
+(* Labels *)
+type lbl = string
+
+(* LLVM types *)
+type ty =
+| Void
+| I1
+| I8
+| I64
+| Ptr of ty
+| Struct of ty list
+| Array of int * ty
+| Fun of ty list * ty
+| Namedt of tid
+
+(* Function type: argument types and return type *)
+type fty = ty list * ty
+
+(* Syntactic Values *)
+type operand =
+| Null
+| Const of int64
+| Gid of gid
+| Id of uid
+
+(* Binary i64 Operations *)
+type bop =
+| Add
+| Sub
+| Mul
+| Shl
+| Lshr
+| Ashr
+| And
+| Or
+| Xor
+
+(* Comparison Operators *)
+type cnd =
+| Eq
+| Ne
+| Slt
+| Sle
+| Sgt
+| Sge
+
+(* Instructions *)
+type insn =
+| Binop of bop * ty * operand * operand
+| Alloca of ty
+| Load of ty * operand
+| Store of ty * operand * operand
+| Icmp of cnd * ty * operand * operand
+| Call of ty * operand * (ty * operand) list
+| Bitcast of ty * operand * ty
+| Gep of ty * operand * operand list
+
+type terminator =
+| Ret of ty * operand option
+| Br of lbl
+| Cbr of operand * lbl * lbl
+
+(* Basic Blocks *)
+type block = { insns : (uid * insn) list; term : (uid * terminator) }
+
+(* Control Flow Graphs: entry and labeled blocks *)
+type cfg = block * (lbl * block) list
+
+(* Function Declarations *)
+type fdecl = { f_ty : fty; f_param : uid list; f_cfg : cfg }
+
+(* Global Data Initializers *)
+type ginit =
+| GNull
+| GGid of gid
+| GInt of int64
+| GString of string
+| GArray of (ty * ginit) list
+| GStruct of (ty * ginit) list
+| GBitcast of ty * ginit * ty
+
+(* Global Declarations *)
+type gdecl = ty * ginit
+
+(* LLVMlite Programs *)
+type prog = { tdecls : (tid * ty) list; gdecls : (gid * gdecl) list;
+              fdecls : (gid * fdecl) list; edecls : (gid * ty) list }

hw3/ll/llinterp.ml

@@ -0,0 +1,470 @@
+open Ll
+open Llutil
+
+(* LLVMlite interpreter *)
+
+type mid = int                  (* memory block id *)
+type fid = int                  (* stack frame id *)
+type idx = int                  (* index *)
+
+(* Memory block identifier *)
+type bid = GlobId of gid
+         | HeapId of mid
+         | StckId of fid
+         | NullId
+
+(* Pointers are tagged with a description of the block they reference
+   offsets are represented as paths into memory values *)
+type ptr = ty * bid * idx list
+
+(* "Simple" or stack values  *)
+type sval = 
+  | VUndef
+  | VInt of int64
+  | VPtr of ptr
+
+(* Memory values *)
+type mtree = MWord of sval
+           | MStr of string
+           | MNode of mval
+and mval = mtree list
+
+(* Locals *)
+type locals = uid -> sval
+
+(* The memory state *)
+type config =
+  { globals : (gid * mval) list
+  ; heap    : (mid * mval) list
+  ; stack   : (fid * mval) list
+  }
+
+(* Create memory value for global declaration *)
+let mval_of_gdecl (gd:gdecl) : mval =
+  let rec mtree_of_gdecl : gdecl -> mtree = function
+    | ty, GNull              -> MWord (VPtr (ty, NullId, [0]))
+    | ty, GGid g             -> MWord (VPtr (ty, GlobId g, [0]))
+    | _, GBitcast (t1, v,t2) -> mtree_of_gdecl (t1, v)
+    | _, GInt i              -> MWord (VInt i)
+    | _, GString s           -> MStr s
+    | _, GArray gs
+    | _, GStruct gs          -> MNode (List.map mtree_of_gdecl gs)
+  in [mtree_of_gdecl gd]
+
+(* Create fully undefined memory value for a type *)
+let mval_of_ty (nt:tid -> ty) (t:ty) : mval =
+  let rec mtree_of_ty : ty -> mtree = function
+    | I1 | I8 | I64 | Ptr _ -> MWord VUndef
+    | Array (n, I8) -> MStr (String.make n '\x00')
+    | Array (n, t)  -> MNode Array.(make n (MWord VUndef) |> to_list)
+    | Struct ts     -> MNode (List.map mtree_of_ty ts)
+    | Fun _ | Void  -> failwith "mval_of_ty: mval for bad type"
+    | Namedt id     -> mtree_of_ty (nt id)
+  in [mtree_of_ty t]
+
+
+(* Printing machine states *)
+let mapcat s f l = String.concat s @@ List.map f l
+let prefix p f a = p ^ f a
+let ( ^. ) s t = if s = "" || t = "" then "" else s ^ t
+let pp = Printf.sprintf
+
+let string_of_bid = function
+  | GlobId gid -> "@" ^ gid
+  | HeapId mid -> "M" ^ (string_of_int mid)
+  | StckId fid -> "S" ^ (string_of_int fid)
+  | NullId -> "null"
+
+let string_of_ptr (t, b, i) =
+  pp "%s %s %s" (string_of_ty t) (string_of_bid b)
+    (mapcat ", " string_of_int i)
+
+let string_of_sval (sv:sval) : string =
+  match sv with
+  | VUndef -> "undef"
+  | VInt x -> Int64.to_string x
+  | VPtr p -> string_of_ptr p
+      
+let rec string_of_mval (mv:mval) : string =
+  "[" ^ (mapcat " " string_of_mtree mv) ^ "]"
+
+and string_of_mtree = function
+  | MWord sv -> string_of_sval sv
+  | MStr s -> "\"" ^ s ^ "\""
+  | MNode m -> string_of_mval m
+
+
+(* Varieties of undefined behavior. Can be raised by load/store *)
+exception OOBIndexDeref         (* mem access not in bounds of an array *)
+exception NullPtrDeref          (* deref Null *)
+exception UndefPtrDeref         (* deref Undef pointer (from bad GEP) *)
+exception IncompatTagDeref      (* deref pointer at wrong type (bad bitcast) *)
+exception UndefMemDeref         (* read uninitialized memory *)
+exception UninitMemLoad         (* uninitialized memory load *)
+exception UseAfterFree          (* deref freed stack/heap memory *)
+
+
+(* Arithmetic operations are all signed 64bit 2s compliment (mod In64.max_int)  *)
+let interp_bop (b:bop) (v1:sval) (v2:sval) : sval =
+  let i, j = match v1, v2 with
+    | VInt i, VInt j -> i, j
+    | _ -> invalid_arg "interp_bop"
+  in
+  let open Int64 in
+  let f = match b with
+    | Add -> add | Sub -> sub | Mul -> mul
+    | And -> logand | Or -> logor | Xor -> logxor
+    | Shl -> fun i j -> shift_left i @@ to_int j
+    | Lshr -> fun i j -> shift_right_logical i @@ to_int j
+    | Ashr -> fun i j -> shift_right i @@ to_int j
+  in VInt (f i j)
+                                               
+let interp_cnd (c:cnd) (v1:sval) (v2:sval) =
+  let f = match c with 
+    | Eq -> (=) | Ne -> (<>) | Slt -> (<)
+    | Sle -> (<=) | Sgt -> (>) | Sge -> (>=)
+  in
+  match v1, v2, c with
+    | VPtr (_,b1,i1), VPtr (_,b2,i2), Eq
+    | VPtr (_,b1,i1), VPtr (_,b2,i2), Ne ->
+       VInt (if f (b1,i1) (b2,i2) then 1L else 0L)
+    | VInt i, VInt j, _ ->
+       VInt (if f i j then 1L else 0L)
+    | _ -> invalid_arg "interp_cnd"
+
+let interp_i1 : sval -> bool = function
+  | VInt 0L -> false
+  | VInt 1L -> true
+  | _ -> invalid_arg "interp_i1"
+
+let rec interp_operand (nt:tid -> ty) (locs:locals) (ty:ty) (o:operand) : sval =
+  match ty, o with
+  | I64, Const i  -> VInt i
+  | Ptr ty, Null  -> VPtr (ty, NullId, [0])
+  | Ptr ty, Gid g -> VPtr (ty, GlobId g, [0])
+  | _, Id u       -> locs u
+  | Namedt id, o  -> interp_operand nt locs (nt id) o
+  | _             -> failwith @@ "interp_operand: malformed operand " ^ soo o ^ ":" ^ sot ty 
+
+
+(* Some utility functions *)
+let update f k v = fun k' -> if k = k' then v else f k'
+
+let rec is_prefix (l:'a list) (m:'a list) : bool =
+  match l, m with
+  | [], _ -> true
+  | _, [] -> false
+  | a::l, b::m -> a = b && is_prefix l m
+
+let replace_assoc (l:('a * 'b) list) (a:'a) (b:'b) : ('a * 'b) list =
+  let rec loop acc = function
+    | [] -> List.rev @@ (a,b)::acc
+    | (a',_)::l' when a = a' -> List.rev_append acc @@ (a,b):: l'
+    | e::l' -> loop (e::acc) l'
+  in
+  loop [] l
+
+let replace_nth (l:'a list) (n:int) (a:'a) : 'a list =
+  let rec loop acc n  = function
+    | [] -> raise Not_found
+    | a'::l' -> if n = 0 then List.rev_append acc (a::l')
+                         else loop (a'::acc) (pred n) l'
+  in
+  loop [] n l
+
+
+(* Memory access *)
+let rec load_idxs (m:mval) (idxs:idx list) : mtree =
+  match idxs with
+  | [] -> MNode m
+  | i::idxs' ->
+     let len = List.length m in
+     if len <= i || i < 0 then raise OOBIndexDeref else
+     match idxs', List.nth m i with
+     | [],  mt       -> mt
+     | [0], MStr s   -> MStr s  (* [n x i8]* %p and gep [n x i8]* %p, 0, 0 alias *)
+     | _,   MWord v  -> failwith "load_idxs: attempted to index into word"
+     | _,   MStr _   -> failwith "load_idxs: attempted to index into string"
+     | _,   MNode m' -> load_idxs m' idxs'
+
+let rec store_idxs (m:mval) (idxs:idx list) (mt:mtree) : mval =
+  match idxs with
+  | [] -> [mt]
+  | i::idxs' ->
+     let len = List.length m in
+     if len <= i || i < 0 then raise OOBIndexDeref else
+     match idxs', List.nth m i with
+     | [], _        -> replace_nth m i mt
+     | _,  MWord v  -> failwith "store_idxs: attempted to index into word"
+     | _,  MStr _   -> failwith "store_idxs: attempted to index into string"
+     | _,  MNode m' -> replace_nth m i @@ MNode (store_idxs m' idxs' mt)
+
+let load_bid (c:config) (bid:bid) : mval =
+  match bid with
+  | NullId -> raise NullPtrDeref
+  | HeapId mid -> 
+     (try List.assoc mid c.heap 
+      with Not_found -> raise UseAfterFree)
+  | GlobId gid ->
+     (try List.assoc gid c.globals 
+      with Not_found -> failwith "Load: bogus gid")
+  | StckId fid ->
+     (try List.assoc fid c.stack 
+      with Not_found -> raise UseAfterFree)
+
+
+let load_ptr (c:config) (_, bid, idxs:ptr) : mtree = 
+  load_idxs (load_bid c bid) idxs
+
+let store_ptr (c:config) (_, bid, idxs:ptr) (mt:mtree) : config =
+  let mval = load_bid c bid in
+  match bid with
+  | NullId -> raise NullPtrDeref
+  | HeapId mid -> 
+     let mval' = store_idxs mval idxs mt in
+     let heap = replace_assoc c.heap mid mval' in
+     {c with heap}
+  | GlobId gid ->
+     let mval' = store_idxs mval idxs mt in
+     let globals = replace_assoc c.globals gid mval' in
+     {c with globals}
+  | StckId fid ->
+     let frame' = store_idxs mval idxs mt in
+     let stack = replace_assoc c.stack fid frame' in
+     {c with stack}
+
+
+(* Tag and GEP implementation *)
+let effective_tag (nt:tid -> ty) (tag, _, idxs :ptr) : ty =
+  let rec loop tag idxs = 
+    match tag, idxs with
+    | t, []                  -> t
+    | Struct ts,    i::idxs' -> if List.length ts <= i 
+                                then failwith "effective_tag: index oob of struct"
+                                else loop (List.nth ts i) idxs'
+    | Array (n, t), i::idxs' -> loop t idxs' (* Don't check if OOB! *)
+    | Namedt id,    _        -> loop (nt id) idxs
+    | _,            _::_     -> failwith "effective_tag: index into non-aggregate"
+  in
+  loop tag @@ try List.tl idxs
+              with Failure _ -> failwith "effective_tag: invalid pointer missing first index"
+
+
+let rec gep_idxs (p:idx list) (idxs:idx list) : idx list =
+  match p, idxs with
+  | [], _ | _, [] -> failwith "gep_idxs: invalid indices"
+  | [i], j::idxs' -> i+j::idxs'
+  | i::p', _ -> i::gep_idxs p' idxs
+
+
+let legal_gep (nt:tid -> ty) (sty:ty) (tag:ty) : bool =
+  let rec ptrtoi8 : ty -> ty = function
+    | Ptr _ -> Ptr I8
+    | Struct ts -> Struct (List.map ptrtoi8 ts)
+    | Array (n, t) -> Array (n, ptrtoi8 t)
+    | Namedt id -> ptrtoi8 (nt id)
+    | t -> t
+  in
+  let rec flatten_ty : ty -> ty list = function
+    | Struct ts -> List.(concat @@ map flatten_ty ts)
+    | t -> [t]
+  in
+  is_prefix (flatten_ty @@ ptrtoi8 sty) (flatten_ty @@ ptrtoi8 tag)
+  
+let gep_ptr (nt:tid -> ty) (ot:ty) (p:ptr) (idxs':idx list) : sval =
+  if not (legal_gep nt ot @@ effective_tag nt p) then VUndef else
+    match p with
+    | t, NullId, idxs -> VUndef
+    | t, bid, idxs ->
+       VPtr (t, bid, gep_idxs idxs idxs')
+
+
+(* LLVMlite reference interpreter *)
+let interp_prog {tdecls; gdecls; fdecls} (args:string list) : sval =
+  
+  let globals = List.map (fun (g,gd) -> g,mval_of_gdecl gd) gdecls in
+
+  let nt (id:tid) : ty =
+    try List.assoc id tdecls
+    with Not_found -> failwith @@ "interp_prog: undefined named type " ^ id
+  in
+
+  let interp_op = interp_operand nt in
+
+  let next_id : unit -> fid = 
+    let c = ref 0 in
+    fun () -> c := succ !c; !c
+  in
+
+  (* Global identifiers that will be interpreted as external functions *)
+  let runtime_fns = [ "ll_puts"; "ll_strcat"; "ll_ltoa" ] 
+  in
+
+  (* External function implementation *)
+  let runtime_call (t:ty) (fn:gid) (args:sval list) (c:config) : config * sval = 
+    let load_strptr p = match load_ptr c p with
+      | MStr s -> s
+      | _ -> failwith "runtime_call: non string-ptr arg"
+    in
+    match t, fn, args with
+    | Void, "ll_puts", [VPtr p] -> 
+       let s = load_strptr p in
+       print_endline s; 
+       c, VUndef
+    | Ptr t, "ll_strcat", [VPtr ps1; VPtr ps2] -> 
+       let s1 = load_strptr ps1 in
+       let s2 = load_strptr ps2 in
+       let mid = next_id () in
+       let mv = [MStr (s1 ^ s2)] in
+       let heap = (mid, mv)::c.heap in
+       {c with heap}, VPtr (t, HeapId mid, [0])
+    | I64, "ll_ltoa", [VInt i; VPtr dst] ->
+       let mid = next_id () in
+       let mv = [MStr (Int64.to_string i)] in
+       let heap = (mid, mv)::c.heap in
+       {c with heap}, VPtr (t, HeapId mid, [0])
+    | _ -> failwith @@ "runtime_call: invalid call to " ^ fn
+  in
+
+
+  (* Interprety the body of a function *)
+  let rec interp_cfg (k, blocks:cfg) (locs:locals) (c:config) : config * sval =
+    match k.insns, k.term with
+
+    | (u, Binop (b, t, o1, o2))::insns, _ ->
+       let v1 = interp_op locs t o1 in
+       let v2 = interp_op locs t o2 in
+       let vr = interp_bop b v1 v2 in
+       let locs' = update locs u vr in
+       interp_cfg ({k with insns}, blocks) locs' c
+       
+    | (u, Icmp (cnd, t, o1, o2))::insns, _ ->
+       let v1 = interp_op locs t o1 in
+       let v2 = interp_op locs t o2 in
+       let vr = interp_cnd cnd v1 v2 in
+       let locs' = update locs u vr in
+       interp_cfg ({k with insns}, blocks) locs' c
+
+    | (u, Alloca ty)::insns, _ ->
+       begin match c.stack with
+       | [] -> failwith "stack empty"
+       | (fid,frame)::stack' -> 
+          let ptr = VPtr (ty, StckId fid, [List.length frame]) in
+          let stack = (fid, frame @ [MWord VUndef])::stack' in
+          let locs' = update locs u ptr in
+          interp_cfg ({k with insns}, blocks) locs' {c with stack}
+       end
+
+    | (u, Load (Ptr t, o))::insns, _ ->
+       let mt = match interp_op locs (Ptr t) o with
+         | VPtr p ->
+            if effective_tag nt p <> t 
+            then raise IncompatTagDeref 
+            else load_ptr c p
+         | VUndef -> raise UndefPtrDeref
+         | VInt _ -> failwith "non-ptr arg for load"
+       in
+       let v = match mt with
+         | MWord VUndef -> raise UninitMemLoad
+         | MWord v -> v
+         | _ -> failwith "load: returned aggregate"
+       in
+       let locs' = update locs u v in
+       interp_cfg ({k with insns}, blocks) locs' c
+
+    | (_, Store (t, os, od))::insns, _ ->
+       let vs = interp_op locs t os in
+       let vd = interp_op locs (Ptr t) od in
+       let c' = match vd with
+         | VPtr p ->
+            if effective_tag nt p <> t 
+            then raise IncompatTagDeref 
+            else store_ptr c p (MWord vs)
+         | VUndef -> raise UndefPtrDeref
+         | VInt _ -> failwith "non-vptr arg for load"
+       in
+       interp_cfg ({k with insns}, blocks) locs c'
+       
+    | (u, Call (t, ofn, ato))::insns, _ ->
+       let ats, aos = List.split ato in
+       let ft = Ptr (Fun (ats, t)) in
+       let g = match interp_op locs ft ofn with
+         | VPtr (_, GlobId g, [0]) -> g
+         | _ -> failwith "bad call arg"
+       in
+       let args = List.map2 (interp_op locs) ats aos in
+       let c', r = interp_call t g args c in
+       let locs' = update locs u r in
+       interp_cfg ({k with insns}, blocks) locs' c'
+
+    | (u, Bitcast (t1, o, _))::insns, _ ->
+       let v = interp_op locs t1 o in
+       let locs' = update locs u v in
+       interp_cfg ({k with insns}, blocks) locs' c
+
+    | (u, Gep (Ptr t, o, os))::insns, _ ->
+       let idx_of_sval : sval -> idx = function
+         | VInt i -> Int64.to_int i
+         | _ -> failwith "idx_of_sval: non-integer value"
+       in
+       let vs = List.map (interp_op locs I64) os in
+       let idxs' = List.map idx_of_sval vs in
+       let v' = match interp_op locs (Ptr t) o with
+         | VPtr p -> gep_ptr nt t p idxs'
+         | VUndef -> VUndef
+         | VInt _ -> failwith "non-ptr arg for gep"
+       in           
+       let locs' = update locs u v' in
+       interp_cfg ({k with insns}, blocks) locs' c
+
+    | [], (_, Ret (_, None)) -> 
+       {c with stack = List.tl c.stack}, VUndef
+
+    | [], (_, Ret (t, Some o)) -> 
+       {c with stack = List.tl c.stack}, interp_op locs t o
+
+    | [], (_, Br l) -> 
+       let k' = List.assoc l blocks in
+       interp_cfg (k', blocks) locs c
+
+    | [], (_, Cbr (o, l1, l2)) -> 
+       let v = interp_op locs I1 o in
+       let l' = if interp_i1 v then l1 else l2 in
+       let k' = List.assoc l' blocks in
+       interp_cfg (k', blocks) locs c
+
+    | (u,i)::_, _ ->  failwith @@ "interp_cfg: invalid instruction \"" 
+                                  ^ string_of_insn i ^ "\" at %" ^ u
+
+  and interp_call (ty:ty) (fn:gid) (args:sval list) (c:config) : config * sval =
+    if List.mem fn runtime_fns
+    then runtime_call ty fn args c
+    else
+    let {f_param; f_cfg} = try List.assoc fn fdecls 
+                       with Not_found -> failwith @@ "interp_call: undefined function " ^ fn
+    in
+    if List.(length f_param <> length args) then
+      failwith @@ "interp_call: wrong no. arguments for " ^ fn;
+    let init_locs l = failwith @@ "interp_call: undefined local " ^ l in
+    let locs = List.fold_left2 update init_locs f_param args in
+    let stack = (next_id(), [])::c.stack in
+    interp_cfg f_cfg locs {c with stack}
+  in
+
+  let mkarg a (p,h) = 
+    let id = next_id () in
+    VPtr (I8, HeapId id, [0])::p, (id, [MStr a])::h
+  in
+  let ptrs, heap = List.fold_right mkarg ("LLINTERP"::args) ([],[]) in
+
+  let narg = List.length args + 1 in
+  let argc = VInt (Int64.of_int @@ narg) in
+  let aid = next_id () in
+  let argv = VPtr (Array (narg, Ptr I8), HeapId aid, [0; 0]) in
+  let amval = List.map (fun p -> MWord p) ptrs in
+  let heap = (aid, [MNode amval])::heap in
+
+  let _, r = interp_call I64 "main" [argc; argv] {globals; heap; stack=[]} in
+  r
+
+

hw3/ll/lllexer.mll

@@ -0,0 +1,83 @@
+{ open Lexing
+  open Llparser
+
+  exception SyntaxError of string
+}
+
+let newline = '\n' | ('\r' '\n') | '\r'
+let whitespace = ['\t' ' ']
+let lowercase = ['a'-'z']
+let uppercase = ['A'-'Z']
+let character = lowercase | uppercase
+let digit = '-'? ['0'-'9']
+let identifier = (character | digit | '_' ) (character | digit | '_' | '.')*
+
+rule token = parse
+  | eof                { EOF       }
+  | whitespace+        { token lexbuf }
+  | newline+           { token lexbuf }
+  | "c\""              { read_string (Buffer.create 17) lexbuf }
+  | '*'                { STAR      }
+  | ','                { COMMA     }
+  | ':'                { COLON     }
+  | '='                { EQUALS    }
+  | '('                { LPAREN    }
+  | ')'                { RPAREN    }
+  | '{'                { LBRACE    }
+  | '}'                { RBRACE    }
+  | '['                { LBRACKET  }
+  | ']'                { RBRACKET  }
+  | "i1"               { I1 }
+  | "i8"               { I8 }
+  | "i32"              { I32 }
+  | "i64"              { I64 }
+  | "to"               { TO }
+  | "br"               { BR }
+  | "eq"               { EQ }
+  | "ne"               { NE }
+  | "or"               { OR }
+  | "and"              { AND }
+  | "add"              { ADD }
+  | "sub"              { SUB }
+  | "mul"              { MUL }
+  | "xor"              { XOR }
+  | "slt"              { SLT }
+  | "sle"              { SLE }
+  | "sgt"              { SGT }
+  | "sge"              { SGE }
+  | "shl"              { SHL }
+  | "ret"              { RET }
+  | "getelementptr"    { GEP }
+  | "type"             { TYPE }
+  | "null"             { NULL }
+  | "lshr"             { LSHR }
+  | "ashr"             { ASHR }
+  | "call"             { CALL }
+  | "icmp"             { ICMP }
+  | "void"             { VOID }
+  | "load"             { LOAD }
+  | "entry"            { ENTRY }
+  | "store"            { STORE }
+  | "label"            { LABEL }
+  | "global"           { GLOBAL }
+  | "define"           { DEFINE }
+  | "declare"          { DECLARE }
+  | "external"         { EXTERNAL }
+  | "alloca"           { ALLOCA }
+  | "bitcast"          { BITCAST }
+  | '%' ('.' ?) (identifier as i) { UID i }
+  | '@' ('.' ?) (identifier as i) { GID i }
+  | "x"                           { CROSS } (* for Array types *)
+  | digit+ as d                   { INT (int_of_string d) }
+  | identifier as i               { LBL i }
+  | ";" ([^ '\n' '\r'])* newline  { token lexbuf } (* comments *)
+  | "declare" ([^ '\n' '\r'])* newline { token lexbuf }  (* declare acts as a comment for our IR *)
+  | _ as c { raise @@ SyntaxError ("Unexpected character: " ^ Char.escaped c) }
+
+and read_string buf = parse
+  | '\\' "00" '"'   { STRING (Buffer.contents buf) }
+  | '\\'            { Buffer.add_char buf '\\'; read_string buf lexbuf }
+  | [^ '"' '\\']+   { Buffer.add_string buf (Lexing.lexeme lexbuf)
+                    ; read_string buf lexbuf }
+  | _ { raise (SyntaxError ("Illegal string character: " ^ Lexing.lexeme lexbuf)) }
+  | eof { raise (SyntaxError ("String is not terminated")) }

hw3/ll/llparser.mly

@@ -0,0 +1,298 @@
+%{ open Ll
+   open Llutil.Parsing
+
+%}
+
+(* Symbols *)
+%token STAR             (* * *)    
+%token COMMA            (* , *)
+%token COLON            (* : *)
+%token EQUALS           (* = *)
+%token LPAREN           (* ( *)
+%token RPAREN           (* ) *)
+%token LBRACE           (* { *)
+%token RBRACE           (* } *)
+%token LBRACKET         (* [ *)
+%token RBRACKET         (* ] *)
+%token EOF
+
+(* Reserved Words *)
+%token CROSS            (* x *)
+%token I1               (* i1 *)
+%token I8               (* i8 *)
+%token I32              (* i32 *)
+%token I64              (* i64 *)
+%token TO               (* to *)
+%token BR               (* br *)
+%token EQ               (* eq *)
+%token NE               (* ne *)
+%token OR               (* or *)
+%token AND              (* and *)
+%token ADD              (* add *)
+%token SUB              (* sub *)
+%token MUL              (* mul *)
+%token XOR              (* xor *)
+%token SLT              (* slt *)
+%token SLE              (* sle *)
+%token SGT              (* sgt *)
+%token SGE              (* sge *)
+%token SHL              (* shl *)
+%token RET              (* ret *)
+%token TYPE             (* type *)
+%token NULL             (* null *)
+%token LSHR             (* lshr *)
+%token ASHR             (* ashr *)
+%token CALL             (* call *)
+%token ICMP             (* icmp *)
+%token VOID             (* void *)
+%token LOAD             (* load *)
+%token STORE            (* store *)
+%token LABEL            (* label *)
+%token ENTRY            (* entry *)
+%token GLOBAL           (* global *)
+%token DEFINE           (* define *)
+%token DECLARE          (* define *)
+%token EXTERNAL         (* external *)
+%token ALLOCA           (* alloca *)
+%token BITCAST          (* bitcast *)
+%token GEP              (* getelementptr *)
+
+%token <int> INT        (* int64 values *)
+%token <string> LBL     (* labels *)
+%token <string> GID     (* global identifier *)
+%token <string> UID     (* local identifier *)
+%token <string> STRING  (* string literals *)
+
+%start <Ll.prog> prog
+%%
+
+prog:
+  | ds=decls EOF
+    { ds }
+
+decls:
+  | ds = decls_rev
+    { { tdecls = List.rev ds.tdecls
+      ; gdecls = List.rev ds.gdecls
+      ; fdecls = List.rev ds.fdecls
+      ; edecls = List.rev ds.edecls
+    } }
+
+decls_rev:
+  | (* empty *)
+    { { tdecls = [] ; gdecls = [] ; fdecls = [] ; edecls = [] } }
+  | ds=decls_rev f=fdecl
+    { { ds with fdecls = f :: ds.fdecls }  }
+  | ds=decls_rev g=gdecl
+    { { ds with gdecls = g :: ds.gdecls }  }
+  | ds=decls_rev t=tdecl
+    { { ds with tdecls = t :: ds.tdecls }  }
+  | ds=decls_rev e=edecl
+    { { ds with edecls = e :: ds.edecls }  }
+
+fdecl:
+  | DEFINE t=ty l=GID LPAREN a=arg_list RPAREN
+    LBRACE eb=entry_block bs=block_list RBRACE
+    { (l, { f_ty = (List.map fst a, t)
+          ; f_param = List.map snd a
+          ; f_cfg = (eb, bs)
+          }
+    ) }
+
+gdecl:
+  | g=GID EQUALS GLOBAL t=ty gi=ginit
+    { (g, (t,gi)) }
+
+tdecl:
+  | tid=UID EQUALS TYPE t=ty
+    { (tid, t) }
+
+edecl:
+  | DECLARE rt=ty g=GID LPAREN ts=separated_list(COMMA, ty) RPAREN
+    { (g, Fun (ts,rt)) }
+  | g=GID EQUALS EXTERNAL GLOBAL t=ty
+    { (g, t) }
+
+nonptr_ty: 
+  | VOID { Void }
+  | I1 { I1 }
+  | I8 { I8 }    
+  | I64 { I64 }
+  | LBRACE ts=ty_list RBRACE
+    { Struct ts }
+  | LBRACKET i=INT CROSS t=ty RBRACKET
+    { Array (i,t) }
+  | rt=ty LPAREN ts=ty_list RPAREN
+    { Fun (ts, rt) }
+  | t=UID
+    { Namedt t }
+
+ty:
+  | t=ty STAR
+    { Ptr t }
+  | t=nonptr_ty
+    { t }
+
+ty_list_rev:
+  | t=ty
+    { [t] }
+  | ts=ty_list_rev COMMA t=ty
+    { t::ts }
+
+ty_list:
+  | ts=ty_list_rev
+    { List.rev ts }
+
+arg:
+  | t=ty u=UID { (t,u) }
+
+arg_list_rev:
+  | (* empty *)
+    { [] }
+  | a=arg
+    { [a] }
+  | args=arg_list_rev COMMA a=arg
+    { a::args }
+
+arg_list:
+  | a=arg_list_rev
+    { List.rev a }
+
+operand:
+  | NULL
+    { Null }
+  | i=INT
+    { Const (Int64.of_int i) }
+  | g=GID
+    { Gid g }
+  | u=UID
+    { Id u }
+
+ty_operand_list_rev:
+  | (* empty *)
+    { [] }
+  | t=ty o=operand
+    { [(t,o)] }
+  | tos=ty_operand_list_rev COMMA t=ty o=operand
+    { (t,o)::tos }
+
+ty_operand_list:
+  | tos=ty_operand_list_rev
+    { List.rev tos }
+
+i_operand_list_rev:
+  | (* empty *)
+    { [] }
+  | I64 o=operand
+      { [o] }
+  | I32 o=operand
+    { [o] }
+  | os=i_operand_list_rev COMMA I64 o=operand
+    { o::os }
+  | os=i_operand_list_rev COMMA I32 o=operand
+    { o::os }
+
+i_operand_list:
+  | os=i_operand_list_rev
+    { List.rev os }
+
+terminator:
+  | RET t=ty o=operand
+    { Ret (t, Some o) }
+  | RET t=ty
+    { Ret (t, None) }
+  | BR LABEL l=UID
+    { Br l }
+  | BR I1 o=operand COMMA LABEL l1=UID COMMA LABEL l2=UID
+    { Cbr (o,l1,l2) }
+
+block:
+  | is=insn_list t=terminator
+    { { insns = is; term=(gensym "tmn", t) }  }
+
+block_list_rev:
+  | (* empty *)
+    { [] }
+  | bs=block_list_rev l=LBL COLON b=block
+    { (l,b) :: bs }
+
+block_list:
+  | bs=block_list_rev
+    { List.rev bs }
+
+entry_block:
+  | ENTRY COLON b=block
+    { b }
+  | b=block
+    { b }
+
+bop:
+  | OR { Or }
+  | ADD { Add }
+  | SUB { Sub }
+  | MUL { Mul }
+  | SHL { Shl }
+  | XOR { Xor }      
+  | AND { And }
+  | LSHR { Lshr }
+  | ASHR { Ashr }
+
+cnd:
+  | EQ { Eq }
+  | NE { Ne }
+  | SLT { Slt }
+  | SLE { Sle }
+  | SGT { Sgt }
+  | SGE { Sge }
+
+insn:
+  | u=UID EQUALS b=bop t=ty o1=operand COMMA o2=operand
+    { (u, Binop (b,t,o1,o2)) }
+  | u=UID EQUALS ALLOCA t=ty
+    { (u, Alloca t) }
+  | u=UID EQUALS LOAD ty COMMA t=ty o=operand
+    { (u, Load (t,o)) }
+  | STORE t1=ty o1=operand COMMA t2=ty o2=operand
+    { (gensym "store", Store (t1,o1,o2)) }
+  | u=UID EQUALS ICMP c=cnd t=ty o1=operand COMMA o2=operand
+    { (u, Icmp (c,t,o1,o2)) }
+  | CALL t=ty o=operand LPAREN args=ty_operand_list RPAREN
+    { (gensym "call", Call (t, o, args)) }
+  | u=UID EQUALS CALL t=ty o=operand LPAREN args=ty_operand_list RPAREN
+    { (u, Call (t, o, args)) }
+  | u=UID EQUALS BITCAST t1=ty o=operand TO t2=ty
+    { (u, Bitcast (t1,o,t2)) }
+  | u=UID EQUALS GEP ty COMMA t=ty o=operand COMMA os=i_operand_list
+    { (u, Gep (t,o,os)) }
+
+insn_list:
+  | is=list(insn)
+    { is }
+
+gdecl_list_rev:
+  | (* empty *)
+    { [] }
+  | t=ty g=ginit
+    { [(t,g)] }
+  | gs=gdecl_list_rev COMMA t=ty g=ginit
+    { (t,g)::gs }
+
+gdecl_list:
+  | gs=gdecl_list_rev
+    { List.rev gs }
+
+ginit:
+  | NULL
+    { GNull }
+  | g=GID
+    { GGid g }
+  | i=INT
+    { GInt (Int64.of_int i) }
+  | s=STRING
+    { GString s }
+  | LBRACKET gs=gdecl_list RBRACKET
+    { GArray gs }
+  | LBRACE gs=gdecl_list RBRACE
+    { GStruct gs }
+  | BITCAST LPAREN t1=ty g=ginit TO  t2=ty RPAREN 
+    { GBitcast (t1, g, t2) }

hw3/ll/llutil.ml

@@ -0,0 +1,170 @@
+;; open Ll
+
+(* serializing --------------------------------------------------------------- *)
+
+let mapcat s f l = String.concat s @@ List.map f l
+let prefix p f a = p ^ f a
+let ( ^. ) s t = if s = "" || t = "" then "" else s ^ t
+let pp = Printf.sprintf
+
+let rec string_of_ty : ty -> string = function
+  | Void         -> "void" 
+  | I1           -> "i1" 
+  | I8           -> "i8"
+  | I64          -> "i64"
+  | Ptr ty       -> pp "%s*" (string_of_ty ty)
+  | Struct ts    -> pp "{ %s }" (mapcat ", " string_of_ty ts)
+  | Array (n, t) -> pp "[%s x %s]" (string_of_int n) (string_of_ty t)
+  | Fun (ts,t)   -> pp "%s (%s)" (string_of_ty t) (mapcat ", " string_of_ty ts)
+  | Namedt s     -> pp "%%%s" s
+
+let sot = string_of_ty
+
+let dptr = function
+  | Ptr t -> t
+  | _ -> failwith "PP: expected pointer type"
+
+let string_of_operand : operand -> string = function
+  | Null    -> "null"
+  | Const i -> Int64.to_string i
+  | Gid g   -> "@" ^ g
+  | Id u    -> "%" ^ u
+
+let soo = string_of_operand
+
+let soop (t,v:ty * operand) : string =
+  pp "%s %s" (sot t) (soo v)
+
+let string_of_bop : bop -> string = function
+    | Add -> "add"  | Sub  -> "sub"  | Mul  -> "mul" 
+    | Shl -> "shl"  | Lshr -> "lshr" | Ashr -> "ashr"
+    | And -> "and"  | Or   -> "or"   | Xor  -> "xor"
+
+let string_of_cnd : cnd -> string = function
+    | Eq  -> "eq"  | Ne  -> "ne"  | Slt -> "slt" 
+    | Sle -> "sle" | Sgt -> "sgt" | Sge -> "sge"
+
+let string_of_gep_index : operand -> string = function
+  | Const i -> "i32 " ^ Int64.to_string i
+  | o       -> "i64 " ^ soo o
+
+let string_of_insn : insn -> string = function
+  | Binop (b, t, o1, o2) -> pp "%s %s %s, %s"
+                               (string_of_bop b) (sot t) (soo o1) (soo o2)
+  | Alloca t             -> pp "alloca %s" (sot t)
+  | Load (t, o)          -> pp "load %s, %s %s" (sot (dptr t)) (sot t) (soo o)
+  | Store (t, os, od)    -> pp "store %s %s, %s %s" 
+                               (sot t) (soo os) (sot (Ptr t)) (soo od)
+  | Icmp (c, t, o1, o2)  -> pp "icmp %s %s %s, %s" 
+                               (string_of_cnd c) (sot t) (soo o1) (soo o2)
+  | Call (t, o, oa)      -> pp "call %s %s(%s)"
+                               (sot t) (soo o) (mapcat ", " soop oa)
+  | Bitcast (t1, o, t2)  -> pp "bitcast %s %s to %s" (sot t1) (soo o) (sot t2)
+  | Gep (t, o, oi)       -> pp "getelementptr %s, %s %s, %s" (sot (dptr t)) (sot t) (soo o) 
+                               (mapcat ", " string_of_gep_index oi)
+
+let string_of_named_insn (u,i:uid * insn) : string =
+  match i with
+  | Store _ | Call (Void, _, _) -> string_of_insn i
+  | _ -> pp "%%%s = %s" u (string_of_insn i)
+
+let string_of_terminator : terminator -> string = function
+  | Ret (_, None)   -> "ret void"
+  | Ret (t, Some o) -> pp "ret %s %s" (sot t) (soo o)
+  | Br l            -> pp "br label %%%s" l
+  | Cbr (o, l, m)   -> pp "br i1 %s, label %%%s, label %%%s" (soo o) l m
+
+let string_of_block (b:block) : string =
+  (mapcat "\n" (prefix "  " string_of_named_insn) b.insns ^. "\n")
+  ^ (prefix "  " string_of_terminator) (snd b.term)
+
+let string_of_cfg (e,bs:cfg) : string =
+  let string_of_named_block (l,b) = l ^ ":\n" ^ string_of_block b in
+  string_of_block e ^ "\n" ^. mapcat "\n" string_of_named_block bs
+
+let string_of_named_fdecl (g,f:gid * fdecl) : string =
+  let string_of_arg (t,u) = pp "%s %%%s" (sot t) u in
+  let ts, t = f.f_ty in
+  pp "define %s @%s(%s) {\n%s\n}\n" (sot t) g 
+     (mapcat ", " string_of_arg List.(combine ts f.f_param))
+     (string_of_cfg f.f_cfg)
+
+let rec string_of_ginit : ginit -> string = function
+  | GNull       -> "null"
+  | GGid g      -> pp "@%s" g
+  | GInt i      -> Int64.to_string i
+  | GString s   -> pp "c\"%s\\00\"" s
+  | GArray gis  -> pp "[ %s ]" (mapcat ", " string_of_gdecl gis)
+  | GStruct gis -> pp "{ %s }" (mapcat ", " string_of_gdecl gis)
+  | GBitcast (t1,g,t2) -> pp "bitcast (%s %s to %s)" (sot t1) (string_of_ginit g) (sot t2)
+
+and string_of_gdecl (t,gi:gdecl) : string =
+  pp "%s %s" (sot t) (string_of_ginit gi)
+
+let string_of_named_gdecl (g,gd:gid * gdecl) : string =
+  pp "@%s = global %s" g (string_of_gdecl gd)
+
+let string_of_named_tdecl (n,t:tid * ty) : string =
+  pp "%%%s = type %s" n (sot t)
+
+let string_of_named_edecl (g,t:gid * ty) : string =
+  match t with
+  | Fun (ts, rt) -> pp "declare %s @%s(%s)" (string_of_ty rt) g 
+                       (mapcat ", " string_of_ty ts)
+  | _ -> pp "@%s = external global %s" g (string_of_ty t)
+
+let string_of_prog (p:prog) : string =
+    (mapcat "\n" string_of_named_tdecl p.tdecls ^. "\n\n")
+  ^ (mapcat "\n" string_of_named_gdecl p.gdecls ^. "\n\n")
+  ^ (mapcat "\n" string_of_named_fdecl p.fdecls ^. "\n\n")
+  ^ (mapcat "\n" string_of_named_edecl p.edecls)
+
+(* comparison for testing ----------------------------------------------------- *)
+
+(* delete dummy uids before comparison *)
+let compare_block (b:block) (c:block) : int =
+  let del_dummy (u,i) =
+    match i with
+    | Store (_, _, _) -> "", i
+    | Call (Void, _, _) -> "", i
+    | _ -> u, i
+  in
+  let del_term (u,t) = ("", t)
+  in
+  Pervasives.compare
+    {insns=List.map del_dummy b.insns; term=del_term b.term}
+    {insns=List.map del_dummy c.insns; term=del_term c.term}
+
+
+
+(* helper module for AST ------------------------------------------------------ *)
+
+module IR = struct
+    let define t gid args f_cfg =
+      let ats, f_param = List.split args in
+      gid, { f_ty=ats,t; f_param; f_cfg}
+
+    (* ignore first label *)
+    let cfg (lbs:(lbl * block) list) : cfg =
+      match lbs with
+      | [] -> failwith "cfg: no blocks!"
+      | (_,b)::lbs -> b, lbs
+
+    let entry insns term : (lbl * block) = "", { insns; term }
+    let label lbl insns term = lbl, { insns; term }
+
+    (* terminators *)
+    let ret_void = Ret (Void, None)
+    let ret t op = Ret (t, Some op)
+    let br l = Br l
+    let cbr op l1 l2 = Cbr (op, l1, l2)
+end
+
+module Parsing = struct
+
+let gensym, reset =
+  let c = ref 0 in
+    ( fun (s:string) -> incr c; Printf.sprintf "_%s__%d" s (!c) )
+  , ( fun () -> c := 0 )
+
+end

hw3/llprograms/add.ll

@@ -0,0 +1,5 @@
+define i64 @main(i64 %argc, i8** %arcv) {
+  %1 = add i64 5, 9
+  ret i64 %1
+}
+

hw3/llprograms/add_twice.ll

@@ -0,0 +1,6 @@
+define i64 @main(i64 %argc, i8** %arcv) {
+  %1 = add i64 5, 9
+  %2 = add i64 %1, 15
+  ret i64 %2
+}
+

hw3/llprograms/alloca1.ll

@@ -0,0 +1,7 @@
+define i64 @main(i64 %argc, i8** %arcv) {
+  %1 = alloca i64
+  store i64 17, i64* %1
+  %2 = load i64, i64* %1
+  ret i64 %2
+}
+

hw3/llprograms/alloca2.ll

@@ -0,0 +1,10 @@
+define i64 @main(i64 %argc, i8** %arcv) {
+  %1 = alloca i64
+  store i64 17, i64* %1
+  %2 = alloca i64*
+  store i64* %1, i64** %2
+  %3 = load i64*, i64** %2
+  %4 = load i64, i64* %3
+  ret i64 %4
+}
+

hw3/llprograms/analysis1.ll

@@ -0,0 +1,10 @@
+define i64 @program(i64 %argc, i8** %arcv) {
+  %1 = mul i64 7, 7
+  %2 = add i64 42, %argc
+  %3 = alloca i64
+  br label %l1
+l1:
+  %4 = bitcast i64* %3 to i8*
+  ret i64 %1
+}
+

hw3/llprograms/analysis10.ll

@@ -0,0 +1,29 @@
+define i64 @program(i64 %argc, i8** %argv) {
+  %1 = add i64 30, 0
+  %2 = sub i64 %1, 24
+  %3 = sub i64 9, %2
+  %4 = alloca i64
+  store i64 %3, i64* %4
+  %5 = load i64, i64* %4
+  %6 = mul i64 %3, 4
+  %7 = alloca i64
+  store i64 %6, i64* %7
+  %8 = load i64, i64* %7
+  %9 = icmp sgt i64 %6, 10
+  br i1 %9, label %then, label %else
+then:
+  %10 = load i64, i64* %7
+  %11 = sub i64 %10, 10
+  store i64 %11, i64* %7
+  br label %merge
+else:
+  %12 = load i64, i64* %7
+  %13 = add i64 %12, 10
+  store i64 %13, i64* %7
+  br label %merge
+merge:
+  %14 = load i64, i64* %7
+  %15 = sub i64 60, %1
+  %16 = mul i64 %14, %15
+  ret i64 %16
+}

hw3/llprograms/analysis10_cf_opt.ll

@@ -0,0 +1,30 @@
+define i64 @program(i64 %argc, i8** %argv) {
+  %1 = add i64 30, 0
+  %2 = sub i64 30, 24
+  %3 = sub i64 9, 6
+  %4 = alloca i64
+  store i64 3, i64* %4
+  %5 = load i64, i64* %4
+  %6 = mul i64 3, 4
+  %7 = alloca i64
+  store i64 12, i64* %7
+  %8 = load i64, i64* %7
+  %9 = icmp sgt i64 12, 10
+  br i1 1, label %then, label %else
+else:
+  %12 = load i64, i64* %7
+  %13 = add i64 %12, 10
+  store i64 %13, i64* %7
+  br label %merge
+merge:
+  %14 = load i64, i64* %7
+  %15 = sub i64 60, 30
+  %16 = mul i64 %14, 30
+  ret i64 %16
+then:
+  %10 = load i64, i64* %7
+  %11 = sub i64 %10, 10
+  store i64 %11, i64* %7
+  br label %merge
+}
+

hw3/llprograms/analysis10_dce_opt.ll

@@ -0,0 +1,22 @@
+define i64 @program(i64 %argc, i8** %argv) {
+  %4 = alloca i64
+  store i64 3, i64* %4
+  %7 = alloca i64
+  store i64 12, i64* %7
+  br i1 1, label %then, label %else
+else:
+  %12 = load i64, i64* %7
+  %13 = add i64 %12, 10
+  store i64 %13, i64* %7
+  br label %merge
+merge:
+  %14 = load i64, i64* %7
+  %16 = mul i64 %14, 30
+  ret i64 %16
+then:
+  %10 = load i64, i64* %7
+  %11 = sub i64 %10, 10
+  store i64 %11, i64* %7
+  br label %merge
+}
+

hw3/llprograms/analysis11.ll

@@ -0,0 +1,18 @@
+define i64 @program(i64 %argc, i8** %argv) {
+  %1 = add i64 0, 1
+  %2 = add i64 0, 2
+  %3 = add i64 %1, %2
+  ret i64 %3
+
+foo:
+  %4 = alloca i64
+  store i64 1, i64* %4
+  %5 = alloca i64
+  store i64 2, i64* %5
+  %6 = load i64, i64* %4
+  %7 = load i64, i64* %5
+  %8 = add i64 %6, %7
+  %9 = add i64 %8, 10
+  ret i64 %9
+}
+

hw3/llprograms/analysis11_cf_opt.ll

@@ -0,0 +1,17 @@
+define i64 @program(i64 %argc, i8** %argv) {
+  %1 = add i64 0, 1
+  %2 = add i64 0, 2
+  %3 = add i64 1, 2
+  ret i64 3
+foo:
+  %4 = alloca i64
+  store i64 1, i64* %4
+  %5 = alloca i64
+  store i64 2, i64* %5
+  %6 = load i64, i64* %4
+  %7 = load i64, i64* %5
+  %8 = add i64 %6, %7
+  %9 = add i64 %8, 10
+  ret i64 %9
+}
+

hw3/llprograms/analysis11_dce_opt.ll

@@ -0,0 +1,14 @@
+define i64 @program(i64 %argc, i8** %argv) {
+  ret i64 3
+foo:
+  %4 = alloca i64
+  store i64 1, i64* %4
+  %5 = alloca i64
+  store i64 2, i64* %5
+  %6 = load i64, i64* %4
+  %7 = load i64, i64* %5
+  %8 = add i64 %6, %7
+  %9 = add i64 %8, 10
+  ret i64 %9
+}
+

hw3/llprograms/analysis12.ll

@@ -0,0 +1,13 @@
+define i64 @program(i64 %argc, i8** %arcv) {
+  %1 = add i64 5, 9
+  %2 = sub i64 %1, 15
+  %3 = mul i64 %2, %2
+  %4 = shl i64 %3, 1
+  %5 = lshr i64 %4, %1
+  %6 = ashr i64 %5, 3
+  %7 = and i64 %2, %1
+  %8 = or i64 %5, %7
+  %9 = xor i64 %1, %5
+  ret i64 %9
+}
+

hw3/llprograms/analysis12_cf_opt.ll

@@ -0,0 +1,13 @@
+define i64 @program(i64 %argc, i8** %arcv) {
+  %1 = add i64 5, 9
+  %2 = sub i64 14, 15
+  %3 = mul i64 -1, -1
+  %4 = shl i64 1, 1
+  %5 = lshr i64 2, 14
+  %6 = ashr i64 0, 3
+  %7 = and i64 -1, 14
+  %8 = or i64 0, 14
+  %9 = xor i64 14, 0
+  ret i64 14
+}
+

hw3/llprograms/analysis12_dce_opt.ll

@@ -0,0 +1,4 @@
+define i64 @program(i64 %argc, i8** %arcv) {
+  ret i64 14
+}
+

hw3/llprograms/analysis13.ll

@@ -0,0 +1,31 @@
+define i64 @program(i64 %argc, i8** %arcv) {
+  %1 = add i64 0, 0
+  %2 = add i64 0, 1
+  %3 = add i64 0, 2
+  %4 = add i64 0, 3
+  %5 = add i64 0, 4
+  %6 = add i64 0, 5
+  %7 = add i64 0, 7
+  %cmp1 = icmp sgt i64 3, 0
+  br i1 %cmp1, label %one, label %wrong
+one:
+  %cmp2 = icmp eq i64 1, %2
+  br i1 %cmp2, label %two, label %wrong
+two:
+  %cmp3 = icmp ne i64 %3, 3
+  br i1 %cmp3, label %three, label %wrong
+three:
+  %cmp4 = icmp slt i64 %4, 4
+  br i1 %cmp4, label %four, label %wrong
+four:
+  %cmp5 = icmp sle i64 %5, 10
+  br i1 %cmp5, label %five, label %wrong
+five:
+  %cmp6 = icmp sge i64 10, %6
+  br i1 %cmp6, label %correct, label %wrong
+correct:
+  ret i64 %7
+wrong:
+  ret i64 %1
+}
+

hw3/llprograms/analysis13_cf_opt.ll

@@ -0,0 +1,31 @@
+define i64 @program(i64 %argc, i8** %arcv) {
+  %1 = add i64 0, 0
+  %2 = add i64 0, 1
+  %3 = add i64 0, 2
+  %4 = add i64 0, 3
+  %5 = add i64 0, 4
+  %6 = add i64 0, 5
+  %7 = add i64 0, 7
+  %cmp1 = icmp sgt i64 3, 0
+  br i1 1, label %one, label %wrong
+correct:
+  ret i64 7
+five:
+  %cmp6 = icmp sge i64 10, 5
+  br i1 1, label %correct, label %wrong
+four:
+  %cmp5 = icmp sle i64 4, 10
+  br i1 1, label %five, label %wrong
+one:
+  %cmp2 = icmp eq i64 1, 1
+  br i1 1, label %two, label %wrong
+three:
+  %cmp4 = icmp slt i64 3, 4
+  br i1 1, label %four, label %wrong
+two:
+  %cmp3 = icmp ne i64 2, 3
+  br i1 1, label %three, label %wrong
+wrong:
+  ret i64 0
+}
+

hw3/llprograms/analysis13_dce_opt.ll

@@ -0,0 +1,18 @@
+define i64 @program(i64 %argc, i8** %arcv) {
+  br i1 1, label %one, label %wrong
+correct:
+  ret i64 7
+five:
+  br i1 1, label %correct, label %wrong
+four:
+  br i1 1, label %five, label %wrong
+one:
+  br i1 1, label %two, label %wrong
+three:
+  br i1 1, label %four, label %wrong
+two:
+  br i1 1, label %three, label %wrong
+wrong:
+  ret i64 0
+}
+

hw3/llprograms/analysis14.ll

@@ -0,0 +1,8 @@
+define i64 @program(i64 %argc, i8** %arcv) {
+  %1 = alloca i64
+  %2 = bitcast i64* %1 to i8*
+  %3 = mul i64 1, 2
+  %4 = icmp slt i64 2, %3
+  ret i64 42
+}
+

hw3/llprograms/analysis14_cf_opt.ll

@@ -0,0 +1,8 @@
+define i64 @program(i64 %argc, i8** %arcv) {
+  %1 = alloca i64
+  %2 = bitcast i64* %1 to i8*
+  %3 = mul i64 1, 2
+  %4 = icmp slt i64 2, 2
+  ret i64 42
+}
+

hw3/llprograms/analysis14_dce_opt.ll

@@ -0,0 +1,5 @@
+define i64 @program(i64 %argc, i8** %arcv) {
+  %1 = alloca i64
+  ret i64 42
+}
+

hw3/llprograms/analysis15.ll

@@ -0,0 +1,18 @@
+%node = type { i64, %node* }
+
+@hd = global %node { i64 1, %node* @md }
+@md = global %node { i64 2, %node* @tl }
+@tl = global %node { i64 3, %node* null }
+
+define i64 @program(i64 %argc, i8** %arcv) {
+  %head = getelementptr %node, %node* @hd, i32 0, i32 0
+  %link = getelementptr %node, %node* @hd, i32 0, i32 1
+  %next = load %node*, %node** %link
+  %val = getelementptr %node, %node* %next, i32 0, i32 0
+  %link2 = getelementptr %node, %node* %next, i32 0, i32 1
+  %next2 = load %node*, %node** %link2
+  %val2 = getelementptr %node, %node* %next2, i32 0, i32 0
+  %1 = load i64, i64* %val
+  ret i64 %1
+}
+

hw3/llprograms/analysis15_cf_opt.ll

@@ -0,0 +1,18 @@
+%node = type { i64, %node* }
+
+@hd = global %node { i64 1, %node* @md }
+@md = global %node { i64 2, %node* @tl }
+@tl = global %node { i64 3, %node* null }
+
+define i64 @program(i64 %argc, i8** %arcv) {
+  %head = getelementptr %node, %node* @hd, i32 0, i32 0
+  %link = getelementptr %node, %node* @hd, i32 0, i32 1
+  %next = load %node*, %node** %link
+  %val = getelementptr %node, %node* %next, i32 0, i32 0
+  %link2 = getelementptr %node, %node* %next, i32 0, i32 1
+  %next2 = load %node*, %node** %link2
+  %val2 = getelementptr %node, %node* %next2, i32 0, i32 0
+  %1 = load i64, i64* %val
+  ret i64 %1
+}
+

hw3/llprograms/analysis15_dce_opt.ll

@@ -0,0 +1,16 @@
+%node = type { i64, %node* }
+
+@hd = global %node { i64 1, %node* @md }
+@md = global %node { i64 2, %node* @tl }
+@tl = global %node { i64 3, %node* null }
+
+define i64 @program(i64 %argc, i8** %arcv) {
+  %link = getelementptr %node, %node* @hd, i32 0, i32 1
+  %next = load %node*, %node** %link
+  %val = getelementptr %node, %node* %next, i32 0, i32 0
+  %link2 = getelementptr %node, %node* %next, i32 0, i32 1
+  %next2 = load %node*, %node** %link2
+  %1 = load i64, i64* %val
+  ret i64 %1
+}
+

hw3/llprograms/analysis16.ll

@@ -0,0 +1,40 @@
+define i64 @program(i64 %argc, i8** %arcv) {
+  %1 = alloca i64
+  %2 = alloca i64
+  store i64 6, i64* %1
+  store i64 7, i64* %2
+  br label %foo
+
+foo:
+  %3 = load i64, i64* %1
+  %4 = icmp eq i64 0, %3
+  br i1 %4, label %retb, label %loop
+
+loop:
+  %5 = load i64, i64* %2
+  %6 = icmp eq i64 0, %5
+  br i1 %6, label %reta, label %continue_loop
+
+continue_loop:
+  %7 = load i64, i64* %1
+  %8 = icmp sgt i64 %7, %5
+  br i1 %8, label %if, label %else
+  
+if:
+  %9 = sub i64 %7, %5
+  store i64 %9, i64* %1
+  br label %loop
+
+else:
+  %10 = sub i64 %5, %7
+  store i64 %10, i64* %2
+  br label %loop
+
+reta:
+  %11 = load i64, i64* %1
+  ret i64 %11
+
+retb:
+  %12 = load i64, i64* %2
+  ret i64 %12
+}

hw3/llprograms/analysis16_cf_opt.ll

@@ -0,0 +1,34 @@
+define i64 @program(i64 %argc, i8** %arcv) {
+  %1 = alloca i64
+  %2 = alloca i64
+  store i64 6, i64* %1
+  store i64 7, i64* %2
+  br label %foo
+continue_loop:
+  %7 = load i64, i64* %1
+  %8 = icmp sgt i64 %7, %5
+  br i1 %8, label %if, label %else
+else:
+  %10 = sub i64 %5, %7
+  store i64 %10, i64* %2
+  br label %loop
+foo:
+  %3 = load i64, i64* %1
+  %4 = icmp eq i64 0, %3
+  br i1 %4, label %retb, label %loop
+if:
+  %9 = sub i64 %7, %5
+  store i64 %9, i64* %1
+  br label %loop
+loop:
+  %5 = load i64, i64* %2
+  %6 = icmp eq i64 0, %5
+  br i1 %6, label %reta, label %continue_loop
+reta:
+  %11 = load i64, i64* %1
+  ret i64 %11
+retb:
+  %12 = load i64, i64* %2
+  ret i64 %12
+}
+

hw3/llprograms/analysis16_dce_opt.ll

@@ -0,0 +1,34 @@
+define i64 @program(i64 %argc, i8** %arcv) {
+  %1 = alloca i64
+  %2 = alloca i64
+  store i64 6, i64* %1
+  store i64 7, i64* %2
+  br label %foo
+continue_loop:
+  %7 = load i64, i64* %1
+  %8 = icmp sgt i64 %7, %5
+  br i1 %8, label %if, label %else
+else:
+  %10 = sub i64 %5, %7
+  store i64 %10, i64* %2
+  br label %loop
+foo:
+  %3 = load i64, i64* %1
+  %4 = icmp eq i64 0, %3
+  br i1 %4, label %retb, label %loop
+if:
+  %9 = sub i64 %7, %5
+  store i64 %9, i64* %1
+  br label %loop
+loop:
+  %5 = load i64, i64* %2
+  %6 = icmp eq i64 0, %5
+  br i1 %6, label %reta, label %continue_loop
+reta:
+  %11 = load i64, i64* %1
+  ret i64 %11
+retb:
+  %12 = load i64, i64* %2
+  ret i64 %12
+}
+

hw3/llprograms/analysis17.ll

@@ -0,0 +1,19 @@
+define i64 @program(i64 %x, i64 %y) {
+  %sx = alloca i64
+  store i64 %x, i64* %sx
+  %sy = alloca i64
+  store i64 %y, i64* %sy
+  %i1 = add i64 0, 2
+  %i2 = add i64 0, 3
+  %v1 = add i64 %x, %y
+  %v2 = sub i64 %v1, %i1
+  %v3 = mul i64 %v2, %i2
+  br label %l1
+
+l1:
+  %a1 = alloca i64
+  store i64 0, i64* %a1
+  %arg1 = add i64 0, 12
+  %v4 = call i64 @foo(i64 %arg1, i64 2)
+  ret i64 %v3
+}

hw3/llprograms/analysis17_cf_opt.ll

@@ -0,0 +1,19 @@
+define i64 @program(i64 %x, i64 %y) {
+  %sx = alloca i64
+  store i64 %x, i64* %sx
+  %sy = alloca i64
+  store i64 %y, i64* %sy
+  %i1 = add i64 0, 2
+  %i2 = add i64 0, 3
+  %v1 = add i64 %x, %y
+  %v2 = sub i64 %v1, 2
+  %v3 = mul i64 %v2, 3
+  br label %l1
+l1:
+  %a1 = alloca i64
+  store i64 0, i64* %a1
+  %arg1 = add i64 0, 12
+  %v4 = call i64 @foo(i64 12, i64 2)
+  ret i64 %v3
+}
+

hw3/llprograms/analysis17_dce_opt.ll

@@ -0,0 +1,13 @@
+define i64 @program(i64 %x, i64 %y) {
+  %sx = alloca i64
+  %sy = alloca i64
+  %v1 = add i64 %x, %y
+  %v2 = sub i64 %v1, 2
+  %v3 = mul i64 %v2, 3
+  br label %l1
+l1:
+  %a1 = alloca i64
+  %v4 = call i64 @foo(i64 12, i64 2)
+  ret i64 %v3
+}
+

hw3/llprograms/analysis18.ll

@@ -0,0 +1,24 @@
+define i64 @program(i64 %argc, i8** %arcv) {
+  %1 = alloca i64
+  %2 = add i64 5, 9
+  %3 = mul i64 3, %2
+  %4 = sub i64 %3, 2
+  br label %bar
+bar:
+  %sa = alloca i64
+  %sb = alloca i64
+  %sc = alloca i64
+  store i64 %2, i64* %sa
+  store i64 %3, i64* %sb
+  store i64 %4, i64* %sb
+  br label %foo
+foo:
+  %v1 = load i64, i64* %sa
+  %v2 = load i64, i64* %sa
+  %v3 = load i64, i64* %sa
+  %v4 = add i64 %v1, %v2
+  %res = add i64 %v4, %v3
+  store i64 %res, i64* %1
+  ret i64 %res
+}
+

hw3/llprograms/analysis18_cf_opt.ll

@@ -0,0 +1,24 @@
+define i64 @program(i64 %argc, i8** %arcv) {
+  %1 = alloca i64
+  %2 = add i64 5, 9
+  %3 = mul i64 3, 14
+  %4 = sub i64 42, 2
+  br label %bar
+bar:
+  %sa = alloca i64
+  %sb = alloca i64
+  %sc = alloca i64
+  store i64 14, i64* %sa
+  store i64 42, i64* %sb
+  store i64 40, i64* %sb
+  br label %foo
+foo:
+  %v1 = load i64, i64* %sa
+  %v2 = load i64, i64* %sa
+  %v3 = load i64, i64* %sa
+  %v4 = add i64 %v1, %v2
+  %res = add i64 %v4, %v3
+  store i64 %res, i64* %1
+  ret i64 %res
+}
+

hw3/llprograms/analysis18_dce_opt.ll

@@ -0,0 +1,18 @@
+define i64 @program(i64 %argc, i8** %arcv) {
+  %1 = alloca i64
+  br label %bar
+bar:
+  %sa = alloca i64
+  %sb = alloca i64
+  store i64 14, i64* %sa
+  store i64 42, i64* %sb
+  br label %foo
+foo:
+  %v1 = load i64, i64* %sa
+  %v2 = load i64, i64* %sa
+  %v3 = load i64, i64* %sa
+  %v4 = add i64 %v1, %v2
+  %res = add i64 %v4, %v3
+  ret i64 %res
+}
+

hw3/llprograms/analysis19.ll

@@ -0,0 +1,11 @@
+%arr = type [5 x i64]
+
+@tmp = global %arr [ i64 1, i64 2, i64 3, i64 4, i64 5 ]
+
+define i64 @program(i64 %argc, i8** %arcv) {
+  %1 = alloca i64
+  %2 = getelementptr %arr, %arr* @tmp, i32 0, i32 3
+  %3 = load i64, i64* %1
+  ret i64 5
+}
+

hw3/llprograms/analysis19_cf_opt.ll

@@ -0,0 +1,11 @@
+%arr = type [5 x i64]
+
+@tmp = global %arr [ i64 1, i64 2, i64 3, i64 4, i64 5 ]
+
+define i64 @program(i64 %argc, i8** %arcv) {
+  %1 = alloca i64
+  %2 = getelementptr %arr, %arr* @tmp, i32 0, i32 3
+  %3 = load i64, i64* %1
+  ret i64 5
+}
+

hw3/llprograms/analysis19_dce_opt.ll

@@ -0,0 +1,9 @@
+%arr = type [5 x i64]
+
+@tmp = global %arr [ i64 1, i64 2, i64 3, i64 4, i64 5 ]
+
+define i64 @program(i64 %argc, i8** %arcv) {
+  %1 = alloca i64
+  ret i64 5
+}
+