PowerPC is now supported!

LICENSE

@@ -1,4 +1,4 @@
-Copyright (c) 2005, Eijiro Sumii
+Copyright (c) 2005-2008, Eijiro Sumii, Moe Masuko, and Kenichi Asai
 All rights reserved.
 
 Redistribution and use in source and binary forms, with or without
@@ -15,9 +15,11 @@ met:
 
  - Neither the name of Information-Technology Promotion Agency, the
    name of University of Pennsylvania, the name of University of
-   Tokyo, the name of Tohoku University, nor the name of Eijiro Sumii
-   may be used to endorse or promote products derived from this
-   software without specific prior written permission.
+   Tokyo, the name of Tohoku University, the name of Ochanomizu
+   University, the name of Eijiro Sumii, the name of Moe Masuko, nor
+   the name of Kenichi Asai may be used to endorse or promote products
+   derived from this software without specific prior written
+   permission.
 
 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT

Makefile

@@ -16,8 +16,8 @@ SOURCES = float.c type.ml id.ml m.ml s.ml \
 syntax.ml parser.mly lexer.mll typing.mli typing.ml kNormal.mli kNormal.ml \
 alpha.mli alpha.ml beta.mli beta.ml assoc.mli assoc.ml \
 inline.mli inline.ml constFold.mli constFold.ml elim.mli elim.ml \
-closure.mli closure.ml sparcAsm.mli sparcAsm.ml virtual.mli virtual.ml \
-simm13.mli simm13.ml regAlloc.mli regAlloc.ml emit.mli emit.ml \
+closure.mli closure.ml asm.mli asm.ml virtual.mli virtual.ml \
+simm.mli simm.ml regAlloc.mli regAlloc.ml emit.mli emit.ml \
 main.mli main.ml
 
 # ↓テストプログラムが増えたら、これも増やす
@@ -47,8 +47,8 @@ min-caml.html: main.mli main.ml id.ml m.ml s.ml \
 		syntax.ml type.ml parser.mly lexer.mll typing.mli typing.ml kNormal.mli kNormal.ml \
 		alpha.mli alpha.ml beta.mli beta.ml assoc.mli assoc.ml \
 		inline.mli inline.ml constFold.mli constFold.ml elim.mli elim.ml \
-		closure.mli closure.ml sparcAsm.mli sparcAsm.ml virtual.mli virtual.ml \
-		simm13.mli simm13.ml regAlloc.mli regAlloc.ml emit.mli emit.ml		
+		closure.mli closure.ml asm.mli asm.ml virtual.mli virtual.ml \
+		simm.mli simm.ml regAlloc.mli regAlloc.ml emit.mli emit.ml		
 	caml2html -o min-caml.html $^
 	sed 's/.*<\/title>/MinCaml Source Code<\/title>/g' < min-caml.html > min-caml.tmp.html
 	mv min-caml.tmp.html min-caml.html

PowerPC/asm.ml

@@ -0,0 +1,107 @@
+(* PowerPC assembly with a few virtual instructions *)
+
+type id_or_imm = V of Id.t | C of int
+type t = (* 命令の列 *)
+  | Ans of exp
+  | Let of (Id.t * Type.t) * exp * t
+and exp = (* 一つ一つの命令に対応する式 *)
+  | Nop
+  | Li of int
+  | FLi of Id.l
+  | SetL of Id.l
+  | Mr of Id.t
+  | Neg of Id.t
+  | Add of Id.t * id_or_imm
+  | Sub of Id.t * id_or_imm
+  | Slw of Id.t * id_or_imm
+  | Lwz of Id.t * id_or_imm
+  | Stw of Id.t * Id.t * id_or_imm
+  | FMr of Id.t 
+  | FNeg of Id.t
+  | FAdd of Id.t * Id.t
+  | FSub of Id.t * Id.t
+  | FMul of Id.t * Id.t
+  | FDiv of Id.t * Id.t
+  | Lfd of Id.t * id_or_imm
+  | Stfd of Id.t * Id.t * id_or_imm
+  | Comment of string
+  (* virtual instructions *)
+  | IfEq of Id.t * id_or_imm * t * t
+  | IfLE of Id.t * id_or_imm * t * t
+  | IfGE of Id.t * id_or_imm * t * t
+  | IfFEq of Id.t * Id.t * t * t
+  | IfFLE of Id.t * Id.t * t * t
+  (* closure address, integer arguments, and float arguments *)
+  | CallCls of Id.t * Id.t list * Id.t list
+  | CallDir of Id.l * Id.t list * Id.t list
+  | Save of Id.t * Id.t (* レジスタ変数の値をスタック変数へ保存 *)
+  | Restore of Id.t (* スタック変数から値を復元 *)
+type fundef =
+    { name : Id.l; args : Id.t list; fargs : Id.t list; body : t; ret : Type.t }
+(* プログラム全体 = 浮動小数点数テーブル + トップレベル関数 + メインの式 *)
+type prog = Prog of (Id.l * float) list * fundef list * t
+
+(* shorthand of Let for float *)
+(* fletd : Id.t * exp * t -> t *)
+let fletd (x, e1, e2) = Let ((x, Type.Float), e1, e2)
+(* shorthand of Let for unit *)
+(* seq : exp * t -> t *)
+let seq (e1, e2) = Let ((Id.gentmp Type.Unit, Type.Unit), e1, e2)
+
+let regs = [| "%r2"; "%r5"; "%r6"; "%r7"; "%r8"; "%r9"; "%r10"; 
+  "%r11"; "%r12"; "%r13"; "%r14"; "%r15"; "%r16"; "%r17"; "%r18"; 
+  "%r19"; "%r20"; "%r21"; "%r22"; "%r23"; "%r24"; "%r25"; "%r26"; 
+  "%r27"; "%r28"; "%r29"; "%r30" |]
+(* let regs = Array.init 27 (fun i -> Printf.sprintf "_R_%d" i) *)
+let fregs = Array.init 32 (fun i -> Printf.sprintf "%%f%d" i)
+let allregs = Array.to_list regs
+let allfregs = Array.to_list fregs
+let reg_cl = regs.(Array.length regs - 1) (* closure address *)
+let reg_sw = regs.(Array.length regs - 2) (* temporary for swap *)
+let reg_fsw = fregs.(Array.length fregs - 1) (* temporary for swap *)
+let reg_hp = "%r4"
+let reg_sp = "r3"
+let reg_tmp = "r31"
+
+(* is_reg : Id.t -> bool *)
+let is_reg x = x.[0] = '%'
+
+(* remove_and_uniq : S.t -> Id.t list -> Id.t list *)
+let rec remove_and_uniq xs = function 
+  | [] -> []
+  | x :: ys when S.mem x xs -> remove_and_uniq xs ys
+  | x :: ys -> x :: remove_and_uniq (S.add x xs) ys
+
+(* free variables in the order of use (for spilling) *)
+(* fv_id_or_imm : id_or_imm -> Id.t list *)
+let fv_id_or_imm = function V (x) -> [x] | _ -> []
+(* fv_exp : Id.t list -> t -> S.t list *)
+let rec fv_exp = function
+  | Nop | Li (_) | FLi (_) | SetL (_) | Comment (_) | Restore (_) -> []
+  | Mr (x) | Neg (x) | FMr (x) | FNeg (x) | Save (x, _) -> [x]
+  | Add (x, y') | Sub (x, y') | Slw (x, y') | Lfd (x, y') | Lwz (x, y') -> 
+      x :: fv_id_or_imm y'
+  | FAdd (x, y) | FSub (x, y) | FMul (x, y) | FDiv (x, y) ->
+      [x; y]
+  | Stw (x, y, z') | Stfd (x, y, z') -> x :: y :: fv_id_or_imm z'
+  | IfEq (x, y', e1, e2) | IfLE (x, y', e1, e2) | IfGE (x, y', e1, e2) -> 
+      x :: fv_id_or_imm y' @ remove_and_uniq S.empty (fv e1 @ fv e2)
+  | IfFEq (x, y, e1, e2) | IfFLE (x, y, e1, e2) ->
+      x :: y :: remove_and_uniq S.empty (fv e1 @ fv e2)
+  | CallCls (x, ys, zs) -> x :: ys @ zs
+  | CallDir (_, ys, zs) -> ys @ zs
+and fv = function 
+  | Ans (exp) -> fv_exp exp
+  | Let ((x, t), exp, e) ->
+      fv_exp exp @ remove_and_uniq (S.singleton x) (fv e)
+
+(* fv : t -> Id.t list *)
+let fv e = remove_and_uniq S.empty (fv e)
+
+(* concat : t -> Id.t * Type.t -> t -> t *)
+let rec concat e1 xt e2 = match e1 with
+  | Ans (exp) -> Let (xt, exp, e2)
+  | Let (yt, exp, e1') -> Let (yt, exp, concat e1' xt e2)
+
+(* align : int -> int *)
+let align i = if i mod 8 = 0 then i else i + 4

PowerPC/asm.mli

@@ -0,0 +1,59 @@
+type id_or_imm = V of Id.t | C of int
+type t = 
+  | Ans of exp
+  | Let of (Id.t * Type.t) * exp * t
+and exp = 
+  | Nop
+  | Li of int
+  | FLi of Id.l
+  | SetL of Id.l
+  | Mr of Id.t
+  | Neg of Id.t
+  | Add of Id.t * id_or_imm
+  | Sub of Id.t * id_or_imm
+  | Slw of Id.t * id_or_imm
+  | Lwz of Id.t * id_or_imm
+  | Stw of Id.t * Id.t * id_or_imm
+  | FMr of Id.t 
+  | FNeg of Id.t
+  | FAdd of Id.t * Id.t
+  | FSub of Id.t * Id.t
+  | FMul of Id.t * Id.t
+  | FDiv of Id.t * Id.t
+  | Lfd of Id.t * id_or_imm
+  | Stfd of Id.t * Id.t * id_or_imm
+  | Comment of string
+  (* virtual instructions *)
+  | IfEq of Id.t * id_or_imm * t * t
+  | IfLE of Id.t * id_or_imm * t * t
+  | IfGE of Id.t * id_or_imm * t * t (* for simm *)
+  | IfFEq of Id.t * Id.t * t * t
+  | IfFLE of Id.t * Id.t * t * t
+  (* closure address, integer arguments, and float arguments *)
+  | CallCls of Id.t * Id.t list * Id.t list
+  | CallDir of Id.l * Id.t list * Id.t list
+  | Save of Id.t * Id.t (* レジスタ変数の値をスタック変数へ保存 *)
+  | Restore of Id.t (* スタック変数から値を復元 *)
+type fundef =
+    { name : Id.l; args : Id.t list; fargs : Id.t list; body : t; ret : Type.t }
+type prog = Prog of (Id.l * float) list * fundef list * t
+
+val fletd : Id.t * exp * t -> t (* shorthand of Let for float *)
+val seq : exp * t -> t (* shorthand of Let for unit *)
+
+val regs : Id.t array
+val fregs : Id.t array
+val allregs : Id.t list
+val allfregs : Id.t list
+val reg_cl : Id.t
+val reg_sw : Id.t
+val reg_fsw : Id.t
+val reg_hp : Id.t
+val reg_sp : Id.t
+val reg_tmp : Id.t
+val is_reg : Id.t -> bool
+
+val fv : t -> Id.t list
+val concat : t -> Id.t * Type.t -> t -> t
+
+val align : int -> int