CVS: sml-dist/src/compiler/CodeGen/cpscompile cps-c-calls.sml,1.4,1.5

Update of /cvsroot/smlnj/sml-dist/src/compiler/CodeGen/cpscompile
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv12815/src/compiler/CodeGen/cpscompile

Modified Files:
	cps-c-calls.sml 
Log Message:
experimental code for passing long long arguments via NLFFI (untested)

Index: cps-c-calls.sml
===================================================================
RCS file: /cvsroot/smlnj/sml-dist/src/compiler/CodeGen/cpscompile/cps-c-calls.sml,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** cps-c-calls.sml	14 Jul 2004 23:07:35 -0000	1.4
--- cps-c-calls.sml	3 Feb 2005 22:11:49 -0000	1.5
***************
*** 274,292 ****
         fun build_args vl = let 
             open CTypes
!            fun m (C_double, v :: vl) = (CCalls.FARG (fregbind v), vl)
               | m (C_float, v :: vl) =
!                  (CCalls.FARG (M.CVTF2F (32, 64, fregbind v)), vl)
               | m ((C_unsigned (I_char | I_short | I_int | I_long) |
                     C_signed (I_char | I_short | I_int | I_long) |
                     C_PTR),
!                   v :: vl) = (CCalls.ARG (regbind v), vl)
               | m ((C_STRUCT _ | C_UNION _), v :: vl) =
                   (* pass struct using the pointer to its beginning *)
!                  (CCalls.ARG (regbind v), vl)
               | m (_, []) = error "RCC: not enough ML args"
!              | m _ = error "RCC: unexpected C-type"
             and ml (tl, vl) = let 
                    fun one (t, (ral, vl)) = let val (a, vl') = m (t, vl)
!                                            in (a :: ral, vl') end
                    val (ral, vl') = foldl one ([], vl) tl
                 in (rev ral, vl')
--- 274,300 ----
         fun build_args vl = let 
             open CTypes
!            fun m (C_double, v :: vl) = ([CCalls.FARG (fregbind v)], vl)
               | m (C_float, v :: vl) =
!                  ([CCalls.FARG (M.CVTF2F (32, 64, fregbind v))], vl)
               | m ((C_unsigned (I_char | I_short | I_int | I_long) |
                     C_signed (I_char | I_short | I_int | I_long) |
                     C_PTR),
!                   v :: vl) = ([CCalls.ARG (regbind v)], vl)
               | m ((C_STRUCT _ | C_UNION _), v :: vl) =
                   (* pass struct using the pointer to its beginning *)
!                  ([CCalls.ARG (regbind v)], vl)
! 	     | m ((C_signed I_long_long | C_unsigned I_long_long), v :: vl) =
! 	         ([CCalls.ARG (M.LOAD (ity, ea (regbind v, 4), R.memory)),
! 		   CCalls.ARG (M.LOAD (ity, regbind v, R.memory))],
! 		  vl)
! 	     | m (C_long_double, _) =
! 	         error "RCC: unexpected long double argument"
! 	     | m (C_ARRAY _, _) = error "RCC: unexpected array argument"
! 	     | m (C_void, _) = error "RCC: unexpected void argument"
               | m (_, []) = error "RCC: not enough ML args"
! 
             and ml (tl, vl) = let 
                    fun one (t, (ral, vl)) = let val (a, vl') = m (t, vl)
!                                            in (a @ ral, vl') end
                    val (ral, vl') = foldl one ([], vl) tl
                 in (rev ral, vl')



-------------------------------------------------------
This SF.Net email is sponsored by: IntelliVIEW -- Interactive Reporting
Tool for open source databases. Create drag-&-drop reports. Save time
by over 75%! Publish reports on the web. Export to DOC, XLS, RTF, etc.
Download a FREE copy at http://www.intelliview.com/go/osdn_nl