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/compiler/FLINT/cps/convert.sml
[smlnj] / sml / trunk / compiler / FLINT / cps / convert.sml  
ViewVC logotype

Diff of /sml/trunk/compiler/FLINT/cps/convert.sml

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

revision 777, Fri Jan 12 12:17:38 2001 UTC revision 1174, Sat Mar 23 21:14:40 2002 UTC
# Line 228  Line 228 
228    
229       | AP.RAW_LOAD nk => PKL (P.rawload { kind = numkind nk })       | AP.RAW_LOAD nk => PKL (P.rawload { kind = numkind nk })
230       | AP.RAW_STORE nk => PKS (P.rawstore { kind = numkind nk })       | AP.RAW_STORE nk => PKS (P.rawstore { kind = numkind nk })
231         | AP.RAW_RECORD{tag=false,sz=4} => PKP (P.rawrecord NONE)
232         | AP.RAW_RECORD{tag=true,sz=4} => PKP (P.rawrecord(SOME RK_I32BLOCK))
233         | AP.RAW_RECORD{tag=true,sz=8} => PKP (P.rawrecord(SOME RK_FBLOCK))
234    
235       | _ => bug ("bad primop in map_primop: " ^ (AP.prPrimop p) ^ "\n"))       | _ => bug ("bad primop in map_primop: " ^ (AP.prPrimop p) ^ "\n"))
236    
# Line 599  Line 602 
602                                             loop(e,c)))))))))                                             loop(e,c)))))))))
603                end                end
604    
605            | F.PRIMOP ((_,AP.RAW_CCALL NONE,_,_),[_,_,a],v,e) =>            | F.PRIMOP ((_,AP.RAW_CCALL NONE,_,_), _::_::a::_,v,e) =>
606              (* code generated here should never be executed anyway,              (* code generated here should never be executed anyway,
607               * so we just fake it... *)               * so we just fake it... *)
608              (print "*** pro-forma raw-ccall\n";              (print "*** pro-forma raw-ccall\n";
609               newname (v, lpvar a); loop(e,c))               newname (v, lpvar a); loop(e,c))
610    
611            | F.PRIMOP ((_,AP.RAW_CCALL (SOME i),lt,ts),[f,a,_],v,e) => let            | F.PRIMOP ((_,AP.RAW_CCALL (SOME i),lt,ts),f::a::_::_,v,e) => let
612                  val { c_proto = p, ml_flt_args, ml_flt_res_opt } = i                  val { c_proto = p, ml_args, ml_res_opt, reentrant } = i
613                  fun cty true = FLTt                  fun cty AP.CCALL_REAL64 = FLTt
614                    | cty false = INT32t                    | cty AP.CCALL_INT32 = INT32t
615                      | cty AP.CCALL_ML_PTR = BOGt
616                  val a' = lpvar a                  val a' = lpvar a
617                    val rcckind = if reentrant then REENTRANT_RCC else FAST_RCC
618                  fun rcc args = let                  fun rcc args = let
619                      val al = lpvar f :: map VAR args                      val al = map VAR args
620                  in                      val (al,linkage) =
621                      case ml_flt_res_opt of                          case f of
622                          NONE => RCC (p, al, v, INTt, loop (e, c))                            F.STRING linkage => (al, linkage)
623                            | _  => (lpvar f :: al, "")
624                    in  case ml_res_opt of
625                            NONE => RCC (rcckind, linkage,
626                                         p, al, v, INTt, loop (e, c))
627                        | SOME rt => let                        | SOME rt => let
628                              val v' = mkv ()                              val v' = mkv ()
629                              val res_cty = cty rt                              val res_cty = cty rt
630                          in                          in
631                              RCC (p, al, v', res_cty,                              RCC (rcckind, linkage, p, al, v', res_cty,
632                                   PURE(primwrap res_cty, [VAR v'], v, BOGt,                                   PURE(primwrap res_cty, [VAR v'], v, BOGt,
633                                        loop (e, c)))                                        loop (e, c)))
634                          end                          end
# Line 633  Line 642 
642                          sel (i, a', v, t, build (ftl, v :: rvl, i + 1))                          sel (i, a', v, t, build (ftl, v :: rvl, i + 1))
643                      end                      end
644              in              in
645                  case ml_flt_args of                  case ml_args of
646                      [ft] => let                      [ft] => let
647                          (* if there is precisely one arg, then it will not                          (* if there is precisely one arg, then it will not
648                           * come packaged into a record *)                           * come packaged into a record *)
# Line 642  Line 651 
651                      in                      in
652                          PURE (primunwrap t, [a'], v, t, rcc [v])                          PURE (primunwrap t, [a'], v, t, rcc [v])
653                      end                      end
654                    | _ => build (ml_flt_args, [], 0)                    | _ => build (ml_args, [], 0)
655              end              end
656    
657            | F.PRIMOP ((_,AP.RAW_CCALL _,_,_),_,_,_) => bug "bad raw_ccall"            | F.PRIMOP ((_,AP.RAW_CCALL _,_,_),_,_,_) => bug "bad raw_ccall"
658    
659              | F.PRIMOP ((_,AP.RAW_RECORD _,_,_),[x as F.VAR _],v,e) =>
660                (* code generated here should never be executed anyway,
661                 * so we just fake it... *)
662                (print "*** pro-forma raw-record\n";
663                 newname (v, lpvar x); loop(e,c))
664    
665            | F.PRIMOP(po as (_,p,lt,ts), ul, v, e) =>            | F.PRIMOP(po as (_,p,lt,ts), ul, v, e) =>
666                let val ct =                let val ct =
667                      case (#3(LT.ltd_arrow(LT.lt_pinst (lt, ts))))                      case (#3(LT.ltd_arrow(LT.lt_pinst (lt, ts))))
Legend:
Removed from v.777  
changed lines
  Added in v.1174
root@smlnj-gforge.cs.uchicago.edu
 ViewVC Help
Powered by ViewVC 1.0.0  
Powered By FusionForge