CVS: sml-dist/src/compiler/FLINT/cps convert.sml,1.19,1.20 cps.sig,1.10,1.11 cps.sml,1.11,1.12 cpstrans.sml,1.7,1.8 ppcps.sml,1.11,1.12

Matthias Blume <[email protected]>
Newsgroups gmane.comp.lang.sml.smlnj.commits
Message-ID <[email protected]>
Update of /cvsroot/smlnj/sml-dist/src/compiler/FLINT/cps
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv18358/src/compiler/FLINT/cps

Modified Files:
	convert.sml cps.sig cps.sml cpstrans.sml ppcps.sml 
Log Message:
long long results implemented

Index: convert.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/cps/convert.sml,v
retrieving revision 1.19
retrieving revision 1.20
diff -C2 -d -r1.19 -r1.20
*** convert.sml	28 Aug 2003 21:59:04 -0000	1.19
--- convert.sml	10 Feb 2005 23:54:04 -0000	1.20
***************
*** 621,625 ****
  		  | cty AP.CCI32 = INT32t
  		  | cty AP.CCML = BOGt
! 		  | cty AP.CCI64 = bug "CCI64 calling convention unimplemented"
  		val a' = lpvar a
                  val rcckind = if reentrant then REENTRANT_RCC else FAST_RCC
--- 621,625 ----
  		  | cty AP.CCI32 = INT32t
  		  | cty AP.CCML = BOGt
! 		  | cty AP.CCI64 = BOGt
  		val a' = lpvar a
                  val rcckind = if reentrant then REENTRANT_RCC else FAST_RCC
***************
*** 632,641 ****
  		in  case ml_res_opt of
  			NONE => RCC (rcckind, linkage, 
!                                      p, al, v, INTt, loop (e, c))
  		      | SOME rt => let
  			    val v' = mkv ()
  			    val res_cty = cty rt
  			in
! 			    RCC (rcckind, linkage, p, al, v', res_cty,
  				 PURE(primwrap res_cty, [VAR v'], v, BOGt,
  				      loop (e, c)))
--- 632,649 ----
  		in  case ml_res_opt of
  			NONE => RCC (rcckind, linkage, 
!                                      p, al, [(v, INTt)], loop (e, c))
! 		      | SOME AP.CCI64 =>
! 			let val (v1, v2) = (mkv (), mkv ())
! 			in
! 			    RCC (rcckind, linkage, p, al,
! 				 [(v1, INT32t), (v2, INT32t)],
! 				 recordNM([VAR v1, VAR v2],[INT32t,INT32t],
! 					  v, loop (e, c)))
! 			end
  		      | SOME rt => let
  			    val v' = mkv ()
  			    val res_cty = cty rt
  			in
! 			    RCC (rcckind, linkage, p, al, [(v', res_cty)],
  				 PURE(primwrap res_cty, [VAR v'], v, BOGt,
  				      loop (e, c)))

Index: cps.sig
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/cps/cps.sig,v
retrieving revision 1.10
retrieving revision 1.11
diff -C2 -d -r1.10 -r1.11
*** cps.sig	28 Aug 2003 21:59:06 -0000	1.10
--- cps.sig	10 Feb 2005 23:54:04 -0000	1.11
***************
*** 173,177 ****
     *      shared library name/name of the C function. 
     *) 
!   | RCC of rcc_kind * string * CTypes.c_proto * value list * lvar * cty * cexp
  and rcc_kind = FAST_RCC | REENTRANT_RCC
  withtype function = fun_kind * lvar * lvar list * cty list * cexp
--- 173,178 ----
     *      shared library name/name of the C function. 
     *) 
!   | RCC of rcc_kind * string * CTypes.c_proto * value list *
! 	   (lvar * cty) list * cexp
  and rcc_kind = FAST_RCC | REENTRANT_RCC
  withtype function = fun_kind * lvar * lvar list * cty list * cexp

Index: cps.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/cps/cps.sml,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** cps.sml	28 Aug 2003 21:59:06 -0000	1.11
--- cps.sml	10 Feb 2005 23:54:04 -0000	1.12
***************
*** 205,209 ****
    | PURE of P.pure * value list * lvar * cty * cexp
    (* experimental "raw C call" (Blume, 1/2001) *)
!   | RCC of rcc_kind * string * CTypes.c_proto * value list * lvar * cty * cexp
  and rcc_kind = FAST_RCC | REENTRANT_RCC
  withtype function = fun_kind * lvar * lvar list * cty list * cexp
--- 205,209 ----
    | PURE of P.pure * value list * lvar * cty * cexp
    (* experimental "raw C call" (Blume, 1/2001) *)
!   | RCC of rcc_kind * string * CTypes.c_proto * value list * (lvar * cty) list * cexp
  and rcc_kind = FAST_RCC | REENTRANT_RCC
  withtype function = fun_kind * lvar * lvar list * cty list * cexp

Index: cpstrans.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/cps/cpstrans.sml,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** cpstrans.sml	23 Mar 2002 21:14:39 -0000	1.7
--- cpstrans.sml	10 Feb 2005 23:54:04 -0000	1.8
***************
*** 221,226 ****
      | ARITH(p,vl,w,t,ce) => 
            (addty(w,t); ARITH(p, map vtrans vl, w, t, cexptrans ce))
!     | RCC(k,l,p,vl,w,t,ce) =>
!           (addty(w,t); RCC(k, l, p, map vtrans vl, w, t, cexptrans ce))
  
      
--- 221,227 ----
      | ARITH(p,vl,w,t,ce) => 
            (addty(w,t); ARITH(p, map vtrans vl, w, t, cexptrans ce))
!     | RCC(k,l,p,vl,wtl,ce) =>
!           (app addty wtl;
! 	   RCC(k, l, p, map vtrans vl, wtl, cexptrans ce))
  
      

Index: ppcps.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/FLINT/cps/ppcps.sml,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** ppcps.sml	28 Aug 2003 21:59:06 -0000	1.11
--- ppcps.sml	10 Feb 2005 23:54:04 -0000	1.12
***************
*** 252,261 ****
  		    space n; say "else\n";
  		    indent (n+3) e2)
! 	      | RCC(k,l,p,vl,w,t,e) =>
  		   (space n; 
                      if k = REENTRANT_RCC then say "reentrant " else ();
                      if l = "" then () else (say l; say " ");
!                     say "rcc("; sayvlist vl; say ") -> "; sayv(VAR w);
! 		    sayt(t);nl(); f e)
           in f
          end
--- 252,262 ----
  		    space n; say "else\n";
  		    indent (n+3) e2)
! 	      | RCC(k,l,p,vl,wtl,e) =>
  		   (space n; 
                      if k = REENTRANT_RCC then say "reentrant " else ();
                      if l = "" then () else (say l; say " ");
!                     say "rcc("; sayvlist vl; say ") -> ";
! 		    app (fn (w, t) => (sayv (VAR w); sayt(t))) wtl;
! 		    nl(); f e)
           in f
          end



-------------------------------------------------------
SF email is sponsored by - The IT Product Guide
Read honest & candid reviews on hundreds of IT Products from real users.
Discover which products truly live up to the hype. Start reading now.
http://ads.osdn.com/?ad_id=6595&alloc_id=14396&op=click
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.