Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/compiler/FLINT/cpsopt/contract.sml
ViewVC logotype

Diff of /sml/trunk/src/compiler/FLINT/cpsopt/contract.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1173, Sat Mar 23 04:18:51 2002 UTC revision 1174, Sat Mar 23 21:14:40 2002 UTC
# Line 158  Line 158 
158                     i=i' andalso all2 same (vl,vl') andalso samewith(w,w')(e,e')                     i=i' andalso all2 same (vl,vl') andalso samewith(w,w')(e,e')
159                | (PURE(i,vl,w,_,e),PURE(i',vl',w',_,e')) =>                | (PURE(i,vl,w,_,e),PURE(i',vl',w',_,e')) =>
160                     i=i' andalso all2 same (vl,vl') andalso samewith(w,w')(e,e')                     i=i' andalso all2 same (vl,vl') andalso samewith(w,w')(e,e')
161                | (RCC(p,vl,w,_,e),RCC(p',vl',w',_,e')) =>                | (RCC(k,l,p,vl,w,_,e),RCC(k',l',p',vl',w',_,e')) =>
162                  (* We don't need to compare protocol info:  The protocols are                  (* We don't need to compare protocol info:  The protocols are
163                   * the same iff the functions and arguments are the same. *)                   * the same iff the functions and arguments are the same. *)
164                    k = k' andalso l = l' andalso
165                  all2 same (vl,vl') andalso samewith(w,w')(e,e')                  all2 same (vl,vl') andalso samewith(w,w')(e,e')
166                | _ => false                | _ => false
167          in  sameexp          in  sameexp
# Line 405  Line 406 
406    | PURE(p as P.fwrap,[u],w,_,e) => (use u; enterWRP(w,p,u); g1 e)    | PURE(p as P.fwrap,[u],w,_,e) => (use u; enterWRP(w,p,u); g1 e)
407    | PURE(p as P.funwrap,[u],w,_,e) => (use u; enterWRP(w,p,u); g1 e)    | PURE(p as P.funwrap,[u],w,_,e) => (use u; enterWRP(w,p,u); g1 e)
408    | PURE(i,vl,w,_,e) => (app use vl; enterMISC0 w; g1 e)    | PURE(i,vl,w,_,e) => (app use vl; enterMISC0 w; g1 e)
409    | RCC(p,vl,w,t,e) => (app use vl; enterMISC0 w; g1 e)    | RCC(k,l,p,vl,w,t,e) => (app use vl; enterMISC0 w; g1 e)
410  in  g1  in  g1
411  end  end
412    
# Line 458  Line 459 
459    | drop_body(LOOKER(_,vl,_,_,e)) = (app use_less vl; drop_body e)    | drop_body(LOOKER(_,vl,_,_,e)) = (app use_less vl; drop_body e)
460    | drop_body(ARITH(_,vl,_,_,e)) = (app use_less vl; drop_body e)    | drop_body(ARITH(_,vl,_,_,e)) = (app use_less vl; drop_body e)
461    | drop_body(PURE(_,vl,_,_,e)) = (app use_less vl; drop_body e)    | drop_body(PURE(_,vl,_,_,e)) = (app use_less vl; drop_body e)
462    | drop_body(RCC(_,vl,_,_,e)) = (app use_less vl; drop_body e)    | drop_body(RCC(_,_,_,vl,_,_,e)) = (app use_less vl; drop_body e)
463  end (* local *)  end (* local *)
464    
465    
# Line 882  Line 883 
883                          else PURE(i, vl', w, t, e')                          else PURE(i, vl', w, t, e')
884                      end)                      end)
885        end        end
886     | RCC(p,vl,w,t,e) =>     | RCC(k,l,p,vl,w,t,e) =>
887       (* leave raw C calls alone *)       (* leave raw C calls alone *)
888       RCC (p, map ren vl, w, t, g' e)       RCC (k, l, p, map ren vl, w, t, g' e)
889     | BRANCH(i,vl,c,e1,e2) =>     | BRANCH(i,vl,c,e1,e2) =>
890        let val vl' = map ren vl        let val vl' = map ren vl
891    
892              (* Maximum number of speculatively executed conditional moves *)
893              val MAX_CONDMOVE_HOIST = 3
894    
895              (* This function creates conditional move from
896               * branches of the form:
897               *    BRANCH(i,vl,c,APP(f,[x1]),APP(f,[x2]))
898               *)
899              fun conditionalMove() =
900                  let (* Hoist conditional moves up from branches
901                       * This will make them speculatively.
902                       * We limit this number to MAX_CONDMOVE_HOIST, so
903                       * that we don't speculatively execute everything.
904                       *)
905                      fun hoist(e, 0) = (fn k => k, e)
906                        | hoist(PURE(p as P.condmove _,vl,x,t,e), n) =
907                          let val (k, e) = hoist(e, n-1)
908                              fun newK e = PURE(p,vl,x,t,k e)
909                          in  (newK, e)
910                          end
911                        | hoist(e, _) = (fn k => k, e)
912                      val (k1, e1) = hoist(g' e1, MAX_CONDMOVE_HOIST)
913                      val (k2, e2) = hoist(g' e2, MAX_CONDMOVE_HOIST)
914    
915                          (* The default does nothing *)
916                      fun default() = BRANCH(i, vl', c, k1 e1, k2 e2)
917    
918                          (* detemine the type of conditional move *)
919                      fun findType(f,x,y) =
920                      let fun getTy(x,again) =
921                             case x of
922                               STRING _ => SOME BOGt
923                             | LABEL _ => SOME BOGt
924                             | REAL _ => SOME FLTt
925                             | INT32 _ => SOME INT32t
926                             | INT _ => SOME BOGt
927                             | _ => again()
928                          fun findTy() =
929                              getTy(x, fn _ => getTy(y, fn _ => NONE))
930                      in  case #info(get f) of
931                             FNinfo{args=[f_arg], ...} =>
932                             (case #info(get f_arg) of
933                                MISCinfo t => SOME t (* found type *)
934                             | _ => findTy()
935                             )
936                           |  _ => findTy()
937                      end
938    
939                  in  case (i, e1, e2) of
940                        (* String compares are complex, so we punt on them *)
941                        ((P.streq | P.strneq), _, _) => default()
942                      | (_, APP(VAR f, [x]), APP(VAR f', [y])) =>
943                          if f = f' then
944                          (case findType(f,x,y) of
945                               SOME t =>
946                               let val r = LV.mkLvar()
947                               in  say "COND MOVE\n";
948                                   k1(k2(
949                                      PURE(P.condmove i,vl' @ [x,y],
950                                           r,t,APP(VAR f,[VAR r]))))
951                               end
952                          | _ => (say "COND MOVE failed\n"; default())
953                          )
954                          else default()
955                      | _ => default()
956                  end
957    
958              fun noConditionalMove() = BRANCH(i, vl', c, g' e1, g' e2)
959    
960            fun h() = (if !CG.branchfold andalso equalUptoAlpha(e1,e2)            fun h() = (if !CG.branchfold andalso equalUptoAlpha(e1,e2)
961                       then (click "z";                       then (click "z";
962                             app use_less vl';                             app use_less vl';
# Line 904  Line 974 
974                                       drop_body e1;                                       drop_body e1;
975                                       g' e2)                                       g' e2)
976                       else raise ConstFold)                       else raise ConstFold)
977                   handle ConstFold => BRANCH(i, vl', c, g' e1, g' e2)                   handle ConstFold => noConditionalMove()
978            fun getifidiom f =            fun getifidiom f =
979              let val f' = ren f              let val f' = ren f
980              in  case f'              in  case f'

Legend:
Removed from v.1173  
changed lines
  Added in v.1174

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0