Permalink
Browse files

added tables like a boss, and two flavors (slow and fast)

  • Loading branch information...
1 parent f3b1857 commit 532c86c2440fdf1112e7ded02a63e732bf7a4cc8 Bacon God committed Apr 10, 2012
Showing with 159 additions and 6 deletions.
  1. +1 −1 src/build
  2. +76 −0 src/d16xtable.ml
  3. +8 −5 src/main.ml
  4. +43 −0 tests/gold/tables.tables.tables.x.gold
  5. +31 −0 tests/tables.tables.tables.x
View
@@ -6,7 +6,7 @@
clear
rm ../d16x 2> /dev/null
ocamlfind ocamlc -package batteries -package batteries.syntax -syntax camlp4o -linkpkg \
- d16xparse.ml d16xasm.ml d16xutil.ml d16xmacro.ml d16xcompute.ml d16xtypes.ml main.ml -o d16x
+ d16xparse.ml d16xasm.ml d16xutil.ml d16xmacro.ml d16xcompute.ml d16xtypes.ml d16xtable.ml main.ml -o d16x
rm *.cm*
mv d16x ..
View
@@ -0,0 +1,76 @@
+(* makes building tables and word to word maps easy *)
+
+open Batteries_uni;;
+open D16xparse;;
+open D16xutil;;
+module StringMap = Map.Make (String);;
+
+exception TableWTF;;
+
+(* as we need to inject labels, this will generate them for us *)
+let tbl_cell_counter = ref 0;;
+let get_cell typ =
+ tbl_cell_counter := !tbl_cell_counter + 1; ("jump_" ^ typ ^ "_" ^ (string_of_int(!tbl_cell_counter)));;
+
+(* slow, but space efficient *)
+let slow_replace input output fixed =
+ let code_up = function (_, test, v) -> [TreeExpression("IFE",[input;test]); TreeExpression("SET",[output;v])] in
+ let code = (List.flatten (List.map code_up fixed)) in
+ TreeExpression("SEQ", code);;
+
+(* fast, but uses more space *)
+let fast_replace input output fixed =
+ let inner_fast_replace big_list input output end_label =
+ let find_split raw_list =
+ let list = List.map (function (x,_,_) -> x) raw_list in
+ let min = List.fold_left (function a -> function b -> if a < b then a else b) (List.hd list) list in
+ let max = List.fold_left (function a -> function b -> if a > b then a else b) (List.hd list) list in
+ (min + max) / 2 in
+ let partition list =
+ let split_at = find_split list in
+ List.partition (function (v, _, _) -> v <= split_at) list in
+ let rec inner list is_right =
+ let gotoend = TreeExpression("#", [TreeIdent(end_label)]) in
+ let code_to_gotoend = if is_right then TreeNoOp else TreeExpression("SET", [TreeIdent("PC");gotoend]) in
+ match list with
+ [(_, test, v)] -> [TreeExpression("IFE",[input;test]); TreeExpression("SET",[output;v]); code_to_gotoend ]
+ | [(_, test1, v1);(_, test2, v2)] ->
+ [ TreeExpression("IFE",[input;test1]); TreeExpression("SET",[output;v1]);
+ TreeExpression("IFE",[input;test2]); TreeExpression("SET",[output;v2]); code_to_gotoend
+ ]
+ | _ ->
+ let (left, right) = partition list in
+ let ati = (((function (v,_,_) -> v) (List.hd right)) - 1) in
+ let at = TreeInteger(ati) in
+ let mid_label = (get_cell ("fast_mid_" ^ (string_of_int ati))) in
+ let mid_code = [TreeExpression(":", [TreeIdent(mid_label)])] in
+ let goto_mid = TreeExpression("#", [TreeIdent(mid_label)]) in
+ let jump_ahead = [TreeExpression("IFG", [input;at]) ; TreeExpression("SET",[TreeIdent("PC");goto_mid])] in
+ jump_ahead @ (inner left false) @ mid_code @ (inner right is_right)
+ in inner big_list true in
+ let end_label = get_cell "fast_end" in
+ let end_code = [TreeExpression(":", [TreeIdent(end_label)])] in
+ let code = (inner_fast_replace fixed input output end_label) @ end_code in
+ TreeExpression("SEQ", code);;
+
+let compile_tables tree =
+ let extract_from_to item =
+ match item with
+ TreeExpression("element", [TreeInteger(src);v]) -> (src, TreeInteger(src),v)
+ | TreeExpression("e", [TreeInteger(src);v]) -> (src,TreeInteger(src),v)
+ | _ -> raise TableWTF in
+ let fix_up children =
+ let fixed = List.map extract_from_to children in
+ let cmp = (function (a,_,_) -> function (b,_,_) -> a - b) in
+ List.stable_sort cmp fixed in
+ let replace_meat algo input output children =
+ let fixed = fix_up children in
+ if algo = "slow" or algo = "compact" then
+ slow_replace input output fixed
+ else
+ fast_replace input output fixed in
+ let find = (function (name,_) -> name = "table") in
+ let replace = (function (name, t) -> match t with (TreeIdent(algo))::(src::(dest::children)) -> (replace_meat algo src dest children) | _ -> (raise TableWTF)) in
+ rewrite tree find replace
+ ;;
+
View
@@ -8,14 +8,17 @@ open D16xasm;;
open D16xmacro;;
open D16xcompute;;
open D16xtypes;;
+open D16xtable;;
let argv = Array.to_list Sys.argv in
let files = List.filter (function item -> (String.get item 1) != '-') (List.tl argv) in
let show_comments = (List.length (List.filter (function item -> (item = "--debug")) argv)) > 0 in
-let stage1 = parse_files files in
-let stage2 = compile_types stage1 in
-let stage3 = compile_computes stage2 in
-let stage4 = compile_macros stage3 in
-let machine_code = assemble stage4 in
+let staged = parse_files files in
+let staged = compile_types staged in
+let staged = compile_computes staged in
+let staged = compile_tables staged in
+let staged = compile_macros staged in
+let staged = compile_macros staged in
+let machine_code = assemble staged in
debug_code_print machine_code show_comments
@@ -0,0 +1,43 @@
+800c ;(IFE (REG A ) 0x0000 )
+8411 ;(SET (REG B ) 0x0001 )
+840c ;(IFE (REG A ) 0x0001 )
+8811 ;(SET (REG B ) 0x0002 )
+880c ;(IFE (REG A ) 0x0002 )
+8c11 ;(SET (REG B ) 0x0003 )
+7c11ffff ;(SET (REG B ) 0xffff )
+a40e ;(IFG (REG A ) 0x0009 )
+7dc10011 ;(SET PC (# jump_fast_mid_9_2 ) )
+800c ;(IFE (REG A ) 0x0000 )
+8421 ;(SET (REG C ) 0x0001 )
+940c ;(IFE (REG A ) 0x0005 )
+a821 ;(SET (REG C ) 0x000a )
+7dc10013 ;(SET PC (# jump_fast_end_1 ) )
+a80c ;(IFE (REG A ) 0x000a )
+9421 ;(SET (REG C ) 0x0005 )
+0000 ;Word 0
+7dc10014 ;(SET PC (# here ) )
+8c0e ;(IFG (REG A ) 0x0003 )
+7dc10028 ;(SET PC (# jump_fast_mid_3_4 ) )
+840e ;(IFG (REG A ) 0x0001 )
+7dc10022 ;(SET PC (# jump_fast_mid_1_6 ) )
+800c ;(IFE (REG A ) 0x0000 )
+8421 ;(SET (REG C ) 0x0001 )
+840c ;(IFE (REG A ) 0x0001 )
+8821 ;(SET (REG C ) 0x0002 )
+7dc10035 ;(SET PC (# jump_fast_end_3 ) )
+880c ;(IFE (REG A ) 0x0002 )
+8c21 ;(SET (REG C ) 0x0003 )
+8c0c ;(IFE (REG A ) 0x0003 )
+9021 ;(SET (REG C ) 0x0004 )
+7dc10035 ;(SET PC (# jump_fast_end_3 ) )
+940e ;(IFG (REG A ) 0x0005 )
+7dc10031 ;(SET PC (# jump_fast_mid_5_5 ) )
+900c ;(IFE (REG A ) 0x0004 )
+9421 ;(SET (REG C ) 0x0005 )
+940c ;(IFE (REG A ) 0x0005 )
+9821 ;(SET (REG C ) 0x0006 )
+7dc10035 ;(SET PC (# jump_fast_end_3 ) )
+980c ;(IFE (REG A ) 0x0006 )
+9c21 ;(SET (REG C ) 0x0007 )
+9c0c ;(IFE (REG A ) 0x0007 )
+a021 ;(SET (REG C ) 0x0008 )
@@ -0,0 +1,31 @@
+(table slow (REG A) (REG B)
+ (e 0 1)
+ (e 1 2)
+ (e 2 3)
+)
+
+(SET (REG B) 0xffff)
+
+(table fast (REG A) (REG C)
+ (e 0 1)
+ (e 5 10)
+ (e 10 5)
+)
+
+(WORD 0)
+(: here)
+(SET PC (# here))
+
+
+(table fast (REG A) (REG C)
+ (e 0 1)
+ (e 1 2)
+ (e 2 3)
+ (e 3 4)
+ (e 4 5)
+ (e 5 6)
+ (e 6 7)
+ (e 7 8)
+)
+
+

0 comments on commit 532c86c

Please sign in to comment.