From c4c72cb2a7b414b4c97ffa1e9abe1a94e483ee48 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Wed, 22 Aug 2001 15:54:02 +0000
Subject: [PATCH] [project @ 2001-08-22 15:54:02 by simonpj] Test for only 4
 words of args on SPARC foreign export dynamic

---
 ghc/compiler/typecheck/TcForeign.lhs |   26 +++++++++++++++++++++++++-
 1 file changed, 25 insertions(+), 1 deletion(-)

diff --git a/ghc/compiler/typecheck/TcForeign.lhs b/ghc/compiler/typecheck/TcForeign.lhs
index 00c39a7..440ef58 100644
--- a/ghc/compiler/typecheck/TcForeign.lhs
+++ b/ghc/compiler/typecheck/TcForeign.lhs
@@ -39,6 +39,8 @@ import TysWiredIn	( isFFIArgumentTy, isFFIImportResultTy,
 			  isFFIExternalTy, isFFIDynArgumentTy, isFFIDynResultTy,
 			  isFFILabelTy
 			)
+import PrimRep		( getPrimRepSize )
+import Type		( typePrimRep )
 import TcType		( Type, tcSplitFunTys, tcSplitTyConApp_maybe, tcSplitForAllTys )
 import ForeignCall	( CCallSpec(..), CExportSpec(..), CCallTarget(..), isDynamicTarget, isCasmTarget )
 import CStrings		( CLabelString, isCLabelString )
@@ -105,7 +107,8 @@ tcCheckFIType sig_ty arg_tys res_ty (CDynImport _)
     case arg_tys of
 	[arg1_ty] -> checkForeignArgs isFFIExternalTy arg1_tys			`thenNF_Tc_`
 		     checkForeignRes nonIOok  isFFIExportResultTy res1_ty	`thenNF_Tc_`
-		     checkForeignRes mustBeIO isFFIDynResultTy	  res_ty
+		     checkForeignRes mustBeIO isFFIDynResultTy	  res_ty	`thenNF_Tc_`
+		     checkFEDArgs arg1_tys
 		  where
 		     (arg1_tys, res1_ty) = tcSplitFunTys arg1_ty
         other -> addErrTc (illegalForeignTyErr empty sig_ty)
@@ -139,6 +142,27 @@ checkCTarget (CasmTarget _)
   = checkCg checkC
 \end{code}
 
+On a SPARC, with foreign export dynamic, due to a giant hack when building
+adjustor thunks, we only allow 16 bytes of arguments!
+
+So for example, args (Int,Double,Int) would be OK (1+2+1)
+as would (Int,Int,Int,Int) (1+1+1+1) but not (Int,Double,Double) (1+2+2).
+
+The check is needed for both via-C and native-code routes
+
+\begin{code}
+#include "nativeGen/NCG.h"
+#if sparc_TARGET_ARCH
+checkFEDArgs arg_tys
+  = check (words_of_args <= 4) err
+  where
+    words_of_args = sum (map (getPrimRepSize . typePrimRep) arg_tys)
+    err = ptext SLIT("On SPARC, I can only handle 4 words of arguments to foreign export dynamic")
+#else
+checkFEDArgs arg_tys = returnNF_Tc ()
+#endif
+\end{code}
+
 
 %************************************************************************
 %*									*
-- 
1.7.10.4