X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcForeign.lhs;h=73fd449d32ce7e9bcb87fe255e238664e130af6b;hp=935127c587dcbbacf885e2a9a175784e319a2a19;hb=5cfe9e92a92201043d5dbb1c4e10fef0ed0d9f49;hpb=49a8e5c021009430d373d6224b29004c7d18c408

diff --git a/compiler/typecheck/TcForeign.lhs b/compiler/typecheck/TcForeign.lhs
index 935127c..73fd449 100644
--- a/compiler/typecheck/TcForeign.lhs
+++ b/compiler/typecheck/TcForeign.lhs
@@ -30,10 +30,6 @@ import TcEnv
 import ForeignCall
 import ErrUtils
 import Id
-#if alpha_TARGET_ARCH
-import Type
-import SMRep
-#endif
 import Name
 import TcType
 import DynFlags
@@ -113,7 +109,6 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety _ CWrapper) = do
         [arg1_ty] -> do checkForeignArgs isFFIExternalTy arg1_tys
                         checkForeignRes nonIOok  isFFIExportResultTy res1_ty
                         checkForeignRes mustBeIO isFFIDynResultTy    res_ty
-                        checkFEDArgs arg1_tys
                   where
                      (arg1_tys, res1_ty) = tcSplitFunTys arg1_ty
         _ -> addErrTc (illegalForeignTyErr empty sig_ty)
@@ -137,7 +132,7 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety _ (CFunction tar
           return idecl
   | cconv == PrimCallConv = do
       dflags <- getDOpts
-      check (dopt Opt_GHCForeignImportPrim dflags)
+      check (xopt Opt_GHCForeignImportPrim dflags)
             (text "Use -XGHCForeignImportPrim to allow `foreign import prim'.")
       checkCg (checkCOrAsmOrLlvmOrDotNetOrInterp)
       checkCTarget target
@@ -178,31 +173,6 @@ checkMissingAmpersand dflags arg_tys res_ty
   = return ()
 \end{code}
 
-On an Alpha, with foreign export dynamic, due to a giant hack when
-building adjustor thunks, we only allow 4 integer arguments with
-foreign export dynamic (i.e., 32 bytes of arguments after padding each
-argument to a quadword, excluding floating-point arguments).
-
-The check is needed for both via-C and native-code routes
-
-\begin{code}
-#include "nativeGen/NCG.h"
-
-checkFEDArgs :: [Type] -> TcM ()
-#if alpha_TARGET_ARCH
-checkFEDArgs arg_tys
-  = check (integral_args <= 32) err
-  where
-    integral_args = sum [ (widthInBytes . argMachRep . primRepToCgRep) prim_rep
-			| prim_rep <- map typePrimRep arg_tys,
-			  primRepHint prim_rep /= FloatHint ]
-    err = ptext (sLit "On Alpha, I can only handle 32 bytes of non-floating-point arguments to foreign export dynamic")
-#else
-checkFEDArgs _ = return ()
-#endif
-\end{code}
-
-
 %************************************************************************
 %*									*
 \subsection{Exports}
@@ -340,7 +310,8 @@ checkCConv CCallConv  = return ()
 #if i386_TARGET_ARCH
 checkCConv StdCallConv = return ()
 #else
-checkCConv StdCallConv = addErrTc (text "calling convention not supported on this platform: stdcall")
+-- This is a warning, not an error. see #3336
+checkCConv StdCallConv = addWarnTc (text "the 'stdcall' calling convention is unsupported on this platform,"$$ text "treating as ccall")
 #endif
 checkCConv PrimCallConv = addErrTc (text "The `prim' calling convention can only be used with `foreign import'")
 checkCConv CmmCallConv = panic "checkCConv CmmCallConv"
@@ -365,7 +336,7 @@ illegalForeignTyErr :: SDoc -> Type -> SDoc
 illegalForeignTyErr arg_or_res ty
   = hang (hsep [ptext (sLit "Unacceptable"), arg_or_res, 
                 ptext (sLit "type in foreign declaration:")])
-	 4 (hsep [ppr ty])
+       2 (hsep [ppr ty])
 
 -- Used for 'arg_or_res' argument to illegalForeignTyErr
 argument, result :: SDoc
@@ -379,6 +350,6 @@ badCName target
 foreignDeclCtxt :: ForeignDecl Name -> SDoc
 foreignDeclCtxt fo
   = hang (ptext (sLit "When checking declaration:"))
-         4 (ppr fo)
+       2 (ppr fo)
 \end{code}