rpms/ghc/devel ghc-6.4-dsforeign-x86_64-1097471.patch, NONE, 1.1 ghc-6.4-powerpc.patch, NONE, 1.1 ghc-6.4-rts-adjustor-x86_64-1097471.patch, NONE, 1.1 ghc.spec, NONE, 1.1 rts-GCCompact.h-x86_64.patch, NONE, 1.1 .cvsignore, 1.1, 1.2 sources, 1.1, 1.2

Jens Petersen (petersen) fedora-extras-commits at redhat.com
Thu May 12 07:37:45 UTC 2005


Author: petersen

Update of /cvs/extras/rpms/ghc/devel
In directory cvs-int.fedora.redhat.com:/tmp/cvs-serv15149/devel

Modified Files:
	.cvsignore sources 
Added Files:
	ghc-6.4-dsforeign-x86_64-1097471.patch ghc-6.4-powerpc.patch 
	ghc-6.4-rts-adjustor-x86_64-1097471.patch ghc.spec 
	rts-GCCompact.h-x86_64.patch 
Log Message:
auto-import ghc-6.4-8 on branch devel from ghc-6.4-8.src.rpm
initial import to Extras

ghc-6.4-dsforeign-x86_64-1097471.patch:

--- NEW FILE ghc-6.4-dsforeign-x86_64-1097471.patch ---
diff -u ghc-6.4/ghc/compiler/deSugar/DsForeign.lhs ghc-6.5/ghc/compiler/deSugar/DsForeign.lhs
--- ghc-6.4/ghc/compiler/deSugar/DsForeign.lhs	2005-05-07 11:51:04.000000000 +0900
+++ ghc-6.5/ghc/compiler/deSugar/DsForeign.lhs	2005-05-07 11:51:04.000000000 +0900
@@ -24,14 +24,14 @@
 import Type		( isUnLiftedType )
 #endif
 import MachOp		( machRepByteWidth, MachRep(..) )
-import SMRep		( argMachRep, primRepToCgRep )
+import SMRep		( argMachRep, typeCgRep )
 import CoreUtils	( exprType, mkInlineMe )
 import Id		( Id, idType, idName, mkSysLocal, setInlinePragma )
 import Literal		( Literal(..), mkStringLit )
 import Module		( moduleString )
 import Name		( getOccString, NamedThing(..) )
 import OccName		( encodeFS )
-import Type		( repType, coreEqType, typePrimRep )
+import Type		( repType, coreEqType )
 import TcType		( Type, mkFunTys, mkForAllTys, mkTyConApp,
 			  mkFunTy, tcSplitTyConApp_maybe, 
 			  tcSplitForAllTys, tcSplitFunTys, tcTyConAppArgs,
@@ -52,7 +52,7 @@
 import BasicTypes	( Activation( NeverActive ) )
 import SrcLoc		( Located(..), unLoc )
 import Outputable
-import Maybe 		( fromJust )
+import Maybe 		( fromJust, isNothing )
 import FastString
 \end{code}
 
@@ -95,7 +95,7 @@
   combine (ForeignStubs acc_h acc_c acc_hdrs acc_feb, acc_f) 
 	  (L loc (ForeignExport (L _ id) _ (CExport (CExportStatic ext_nm cconv)) depr))
     = dsFExport id (idType id) 
-		ext_nm cconv False                 `thenDs` \(h, c, _) ->
+		ext_nm cconv False                 `thenDs` \(h, c, _, _) ->
       warnDepr depr loc				   `thenDs` \_              ->
       returnDs (ForeignStubs (h $$ acc_h) (c $$ acc_c) acc_hdrs (id:acc_feb), 
 		acc_f)
@@ -292,7 +292,8 @@
 				-- 	   the first argument's stable pointer
 	  -> DsM ( SDoc		-- contents of Module_stub.h
 		 , SDoc		-- contents of Module_stub.c
-		 , [Type]       -- primitive arguments expected by stub function.
+		 , [MachRep]    -- primitive arguments expected by stub function
+		 , Int		-- size of args to stub function
 		 )
 
 dsFExport fn_id ty ext_name cconv isDyn
@@ -371,7 +372,8 @@
      in
      dsLookupGlobalId bindIOName		`thenDs` \ bindIOId ->
      newSysLocalDs stable_ptr_ty		`thenDs` \ stbl_value ->
-     dsFExport id export_ty fe_nm cconv True  	`thenDs` \ (h_code, c_code, stub_args) ->
+     dsFExport id export_ty fe_nm cconv True  	
+		`thenDs` \ (h_code, c_code, arg_reps, args_size) ->
      let
       stbl_app cont ret_ty = mkApps (Var bindIOId)
 				    [ Type stable_ptr_ty
@@ -395,9 +397,7 @@
 	-- (probably in the RTS.) 
       adjustor	 = FSLIT("createAdjustor")
       
-      arg_type_info = drop 2 $ map (repCharCode.argMachRep
-                                   .primRepToCgRep.typePrimRep)
-                                   stub_args
+      arg_type_info = map repCharCode arg_reps
       repCharCode F32 = 'f'
       repCharCode F64 = 'd'
       repCharCode I64 = 'l'
@@ -407,17 +407,9 @@
 	-- so that we can attach the '@N' suffix to its label if it is a
 	-- stdcall on Windows.
       mb_sz_args = case cconv of
-		      StdCallConv -> Just (sum (map ty_size stub_args))
+		      StdCallConv -> Just args_size
 		      _ 	  -> Nothing
 
-	-- NB. the calculation here isn't strictly speaking correct.
-	-- We have a primitive Haskell type (eg. Int#, Double#), and
-	-- we want to know the size, when passed on the C stack, of
-	-- the associated C type (eg. HsInt, HsDouble).  We don't have
-	-- this information to hand, but we know what GHC's conventions
-	-- are for passing around the primitive Haskell types, so we
-	-- use that instead.  I hope the two coincide --SDM
-      ty_size = machRepByteWidth.argMachRep.primRepToCgRep.typePrimRep
      in
      dsCCall adjustor adj_args PlayRisky io_res_ty	`thenDs` \ ccall_adj ->
 	-- PlayRisky: the adjustor doesn't allocate in the Haskell heap or do a callback
@@ -464,33 +456,33 @@
 	       -> CCallConv 
 	       -> (SDoc, 
 		   SDoc,
-		   [Type] 	-- the *primitive* argument types
+		   [MachRep], 	-- the argument reps
+		   Int		-- total size of arguments
 		  )
 mkFExportCBits c_nm maybe_target arg_htys res_hty is_IO_res_ty cc 
- = (header_bits, c_bits, all_prim_arg_tys)
+ = (header_bits, c_bits, 
+    [rep | (_,_,_,rep) <- arg_info],  -- just the real args
+    sum [ machRepByteWidth rep | (_,_,_,rep) <- aug_arg_info] -- all the args
+    )
  where
-  -- Create up types and names for the real args
-  arg_cnames, arg_ctys :: [SDoc]
-  arg_cnames = mkCArgNames 1 arg_htys
-  arg_ctys   = map showStgType arg_htys
-
-  -- and also for auxiliary ones; the stable ptr in the dynamic case, and
-  -- a slot for the dummy return address in the dynamic + ccall case
-  extra_cnames_and_tys
-     = case maybe_target of
-          Nothing -> [((text "the_stableptr", text "StgStablePtr"), mkStablePtrPrimTy alphaTy)]
-          other   -> []
-       ++
-       case (maybe_target, cc) of
-          (Nothing, CCallConv) -> [((text "original_return_addr", text "void*"), addrPrimTy)]
-          other                -> []
-
-  all_cnames_and_ctys :: [(SDoc, SDoc)]
-  all_cnames_and_ctys 
-     = map fst extra_cnames_and_tys ++ zip arg_cnames arg_ctys
-
-  all_prim_arg_tys
-     = map snd extra_cnames_and_tys ++ map getPrimTyOf arg_htys
+  -- list the arguments to the C function
+  arg_info :: [(SDoc, 		-- arg name
+		SDoc,		-- C type
+	        Type,		-- Haskell type
+		MachRep)]	-- the MachRep
+  arg_info  = [ (text ('a':show n), showStgType ty, ty, 
+		 typeMachRep (getPrimTyOf ty))
+	      | (ty,n) <- zip arg_htys [1..] ]
+
+  -- add some auxiliary args; the stable ptr in the wrapper case, and
+  -- a slot for the dummy return address in the wrapper + ccall case
+  aug_arg_info
+    | isNothing maybe_target = stable_ptr_arg : insertRetAddr cc arg_info
+    | otherwise              = arg_info
+
+  stable_ptr_arg = 
+	(text "the_stableptr", text "StgStablePtr", undefined,
+	 typeMachRep (mkStablePtrPrimTy alphaTy))
 
   -- stuff to do with the return type of the C function
   res_hty_is_unit = res_hty `coreEqType` unitTy	-- Look through any newtypes
@@ -506,8 +498,8 @@
   header_bits = ptext SLIT("extern") <+> fun_proto <> semi
 
   fun_proto = cResType <+> pprCconv <+> ftext c_nm <>
-	      parens (hsep (punctuate comma (map (\(nm,ty) -> ty <+> nm) 
-                                                 all_cnames_and_ctys)))
+	      parens (hsep (punctuate comma (map (\(nm,ty,_,_) -> ty <+> nm) 
+                                                 aug_arg_info)))
 
   -- the target which will form the root of what we ask rts_evalIO to run
   the_cfun
@@ -517,9 +509,9 @@
 
   -- the expression we give to rts_evalIO
   expr_to_run
-     = foldl appArg the_cfun (zip arg_cnames arg_htys)
+     = foldl appArg the_cfun arg_info -- NOT aug_arg_info
        where
-          appArg acc (arg_cname, arg_hty) 
+          appArg acc (arg_cname, _, arg_hty, _) 
              = text "rts_apply" 
                <> parens (acc <> comma <> mkHObj arg_hty <> parens arg_cname)
 
@@ -538,6 +530,30 @@
           Nothing -> empty
           Just hs_fn -> text "extern StgClosure " <> ppr hs_fn <> text "_closure" <> semi
 
+   -- the only reason for making the mingw32 (anything targetting PE, really) stick
+   -- out here is that the GHCi linker isn't capable of handling .ctors sections
+  useStaticConstructors 
+#if defined(mingw32_HOST_OS)
+	= False
+#else
+	= True
+#endif  
+
+  initialiser
+     = case maybe_target of
+          Nothing -> empty
+          Just hs_fn 
+	   | not useStaticConstructors -> empty
+	   | otherwise ->
+            vcat
+             [ text "static void stginit_export_" <> ppr hs_fn
+                  <> text "() __attribute__((constructor));"
+             , text "static void stginit_export_" <> ppr hs_fn <> text "()"
+             , braces (text "getStablePtr"
+                <> parens (text "(StgPtr) &" <> ppr hs_fn <> text "_closure")
+                <> semi)
+             ]
+
   -- finally, the whole darn thing
   c_bits =
     space $$
@@ -568,11 +584,17 @@
      ,   if res_hty_is_unit then empty
             else text "return cret;"
      , rbrace
-     ]
-
+     ] $$
+    initialiser
 
-mkCArgNames :: Int -> [a] -> [SDoc]
-mkCArgNames n as = zipWith (\ _ n -> text ('a':show n)) as [n..] 
+-- NB. the calculation here isn't strictly speaking correct.
+-- We have a primitive Haskell type (eg. Int#, Double#), and
+-- we want to know the size, when passed on the C stack, of
+-- the associated C type (eg. HsInt, HsDouble).  We don't have
+-- this information to hand, but we know what GHC's conventions
+-- are for passing around the primitive Haskell types, so we
+-- use that instead.  I hope the two coincide --SDM
+typeMachRep ty = argMachRep (typeCgRep ty)
 
 mkHObj :: Type -> SDoc
 mkHObj t = text "rts_mk" <> text (showFFIType t)
@@ -590,6 +612,26 @@
 	    Just (tc,_) -> tc
 	    Nothing	-> pprPanic "showFFIType" (ppr t)
 
+#if !defined(x86_64_TARGET_ARCH)
+insertRetAddr CCallConv args = ret_addr_arg : args
+insertRetAddr _ args = args
+#else
+-- On x86_64 we insert the return address after the 6th
+-- integer argument, because this is the point at which we
+-- need to flush a register argument to the stack (See rts/Adjustor.c for
+-- details).
+insertRetAddr CCallConv args = go 0 args
+  where  go 6 args = ret_addr_arg : args
+	 go n (arg@(_,_,_,rep):args)
+	  | I64 <- rep = arg : go (n+1) args
+	  | otherwise  = arg : go n     args
+	 go n [] = []
+insertRetAddr _ args = args
+#endif
+
+ret_addr_arg = (text "original_return_addr", text "void*", undefined, 
+		typeMachRep addrPrimTy)
+
 -- This function returns the primitive type associated with the boxed
 -- type argument to a foreign export (eg. Int ==> Int#).  It assumes
 -- that all the types we are interested in have a single constructor

ghc-6.4-powerpc.patch:

--- NEW FILE ghc-6.4-powerpc.patch ---
diff -ur ghc-6.4/distrib/configure-bin.ac ghc-6.4/distrib/configure-bin.ac
--- ghc-6.4/distrib/configure-bin.ac	2005-03-10 09:10:09.000000000 -0500
+++ ghc-6.4/distrib/configure-bin.ac	2005-03-14 21:37:20.356380744 -0500
@@ -78,6 +78,10 @@
 	TargetPlatform=rs6000-ibm-aix;;
 powerpc-apple-darwin*)
 	TargetPlatform=powerpc-apple-darwin;;
+powerpc-*-linux*)
+	TargetPlatform=powerpc-unknown-linux;;
+powerpc64-*-linux*)
+	TargetPlatform=powerpc64-unknown-linux;;
 sparc-sun-sunos4*)
 	TargetPlatform=sparc-sun-sunos4;;
 sparc-sun-solaris2*)
diff -ur ghc-6.4/ghc/includes/MachRegs.h ghc-6.4/ghc/includes/MachRegs.h
--- ghc-6.4/ghc/includes/MachRegs.h	2005-01-28 07:55:51.000000000 -0500
+++ ghc-6.4/ghc/includes/MachRegs.h	2005-03-14 21:37:31.825368128 -0500
@@ -457,7 +457,7 @@
 #define REG_R7    	r20
 #define REG_R8    	r21
 
-#ifdef darwin_REGS
+#if darwin_REGS
 
 #define REG_F1		f14
 #define REG_F2		f15

ghc-6.4-rts-adjustor-x86_64-1097471.patch:

--- NEW FILE ghc-6.4-rts-adjustor-x86_64-1097471.patch ---
diff -u ghc-6.4/ghc/rts/Adjustor.c ghc-6.5/ghc/rts/Adjustor.c
--- ghc-6.4/ghc/rts/Adjustor.c	2005-05-07 11:46:10.000000000 +0900
+++ ghc-6.5/ghc/rts/Adjustor.c	2005-05-07 11:46:11.000000000 +0900
@@ -46,13 +46,18 @@
 #include <windows.h>
 #endif
 
-#if defined(openbsd_HOST_OS)
+#if defined(openbsd_HOST_OS) || defined(linux_HOST_OS)
 #include <unistd.h>
 #include <sys/types.h>
 #include <sys/mman.h>
 
 /* no C99 header stdint.h on OpenBSD? */
+#if defined(openbsd_HOST_OS)
 typedef unsigned long my_uintptr_t;
+#else
+#include <stdint.h>
+typedef uintptr_t my_uintptr_t;
+#endif
 #endif
 
 #if defined(powerpc_HOST_ARCH) && defined(linux_HOST_OS)
@@ -80,7 +85,7 @@
     barf("mallocBytesRWX: failed to protect 0x%p; error=%lu; old protection: %lu\n",
          addr, (unsigned long)GetLastError(), (unsigned long)dwOldProtect);
   }
-#elif defined(openbsd_HOST_OS)
+#elif defined(openbsd_HOST_OS) || defined(linux_HOST_OS)
   /* malloced memory isn't executable by default on OpenBSD */
   my_uintptr_t pageSize         = sysconf(_SC_PAGESIZE);
   my_uintptr_t mask             = ~(pageSize - 1);
@@ -94,8 +99,46 @@
   return addr;
 }
 
+#ifdef LEADING_UNDERSCORE
+#define UNDERSCORE "_"
+#else 
+#define UNDERSCORE ""
+#endif
 #if defined(i386_HOST_ARCH)
-static unsigned char *obscure_ccall_ret_code;
+/* 
+  Now here's something obscure for you:
+
+  When generating an adjustor thunk that uses the C calling
+  convention, we have to make sure that the thunk kicks off
+  the process of jumping into Haskell with a tail jump. Why?
+  Because as a result of jumping in into Haskell we may end
+  up freeing the very adjustor thunk we came from using
+  freeHaskellFunctionPtr(). Hence, we better not return to
+  the adjustor code on our way  out, since it could by then
+  point to junk.
+  
+  The fix is readily at hand, just include the opcodes
+  for the C stack fixup code that we need to perform when
+  returning in some static piece of memory and arrange
+  to return to it before tail jumping from the adjustor thunk.
+*/
+__asm__ (
+   ".globl " UNDERSCORE "obscure_ccall_ret_code\n"
+   UNDERSCORE "obscure_ccall_ret_code:\n\t"
+   "addl $0x4, %esp\n\t"
+   "ret"
+  );
+extern void obscure_ccall_ret_code(void);
+#endif
+
+#if defined(x86_64_HOST_ARCH)
+__asm__ (
+   ".globl " UNDERSCORE "obscure_ccall_ret_code\n"
+   UNDERSCORE "obscure_ccall_ret_code:\n\t"
+   "addq $0x8, %rsp\n\t"
+   "ret"
+  );
+extern void obscure_ccall_ret_code(void);
 #endif
 
 #if defined(alpha_HOST_ARCH)
@@ -195,7 +238,7 @@
 createAdjustor(int cconv, StgStablePtr hptr,
 	       StgFunPtr wptr,
 	       char *typeString
-#if !defined(powerpc_HOST_ARCH) && !defined(powerpc64_HOST_ARCH)
+#if !defined(powerpc_HOST_ARCH) && !defined(powerpc64_HOST_ARCH) && !defined(x86_64_HOST_ARCH)
 	          STG_UNUSED
 #endif
               )
@@ -279,6 +322,111 @@
 	adj_code[0x0f] = (unsigned char)0xff; /* jmp *%eax */
 	adj_code[0x10] = (unsigned char)0xe0; 
     }
+#elif defined(x86_64_HOST_ARCH)
+    /*
+      stack at call:
+               argn
+	       ...
+	       arg7
+               return address
+	       %rdi,%rsi,%rdx,%rcx,%r8,%r9 = arg0..arg6
+
+      if there are <6 integer args, then we can just push the
+      StablePtr into %edi and shuffle the other args up.
+
+      If there are >=6 integer args, then we have to flush one arg
+      to the stack, and arrange to adjust the stack ptr on return.
+      The stack will be rearranged to this:
+
+             argn
+	     ...
+	     arg7
+	     return address  *** <-- dummy arg in stub fn.
+	     arg6
+	     obscure_ccall_ret_code
+
+      This unfortunately means that the type of the stub function
+      must have a dummy argument for the original return address
+      pointer inserted just after the 6th integer argument.
+
+      Code for the simple case:
+
+   0:   4d 89 c1                mov    %r8,%r9
+   3:   49 89 c8                mov    %rcx,%r8
+   6:   48 89 d1                mov    %rdx,%rcx
+   9:   48 89 f2                mov    %rsi,%rdx
+   c:   48 89 fe                mov    %rdi,%rsi
+   f:   48 8b 3d 0a 00 00 00    mov    10(%rip),%rdi
+  16:   e9 00 00 00 00          jmpq   stub_function
+  ... 
+  20: .quad 0  # aligned on 8-byte boundary
+
+
+  And the version for >=6 integer arguments:
+
+   0:   41 51                   push   %r9
+   2:   68 00 00 00 00          pushq  $obscure_ccall_ret_code
+   7:   4d 89 c1                mov    %r8,%r9
+   a:   49 89 c8                mov    %rcx,%r8
+   d:   48 89 d1                mov    %rdx,%rcx
+  10:   48 89 f2                mov    %rsi,%rdx
+  13:   48 89 fe                mov    %rdi,%rsi
+  16:   48 8b 3d 0b 00 00 00    mov    11(%rip),%rdi
+  1d:   e9 00 00 00 00          jmpq   stub_function
+  ...
+  28: .quad 0  # aligned on 8-byte boundary
+    */
+
+    /* we assume the small code model (gcc -mcmmodel=small) where
+     * all symbols are <2^32, so hence wptr should fit into 32 bits.
+     */
+    ASSERT(((long)wptr >> 32) == 0);
+
+    {  
+	int i = 0;
+	char *c;
+
+	// determine whether we have 6 or more integer arguments,
+	// and therefore need to flush one to the stack.
+	for (c = typeString; *c != '\0'; c++) {
+	    if (*c == 'i' || *c == 'l') i++;
+	    if (i == 6) break;
+	}
+
+	if (i < 6) {
+	    adjustor = mallocBytesRWX(40);
+
+	    *(StgInt32 *)adjustor      = 0x49c1894d;
+	    *(StgInt32 *)(adjustor+4)  = 0x8948c889;
+	    *(StgInt32 *)(adjustor+8)  = 0xf28948d1;
+	    *(StgInt32 *)(adjustor+12) = 0x48fe8948;
+	    *(StgInt32 *)(adjustor+16) = 0x000a3d8b;
+	    *(StgInt32 *)(adjustor+20) = 0x00e90000;
+	    
+	    *(StgInt32 *)(adjustor+23) = 
+		(StgInt32)((StgInt64)wptr - (StgInt64)adjustor - 27);
+	    *(StgInt64 *)(adjustor+32) = (StgInt64)hptr;
+	}
+	else
+	{
+	    adjustor = mallocBytesRWX(48);
+
+	    *(StgInt32 *)adjustor      = 0x00685141;
+	    *(StgInt32 *)(adjustor+4)  = 0x4d000000;
+	    *(StgInt32 *)(adjustor+8)  = 0x8949c189;
+	    *(StgInt32 *)(adjustor+12) = 0xd18948c8;
+	    *(StgInt32 *)(adjustor+16) = 0x48f28948;
+	    *(StgInt32 *)(adjustor+20) = 0x8b48fe89;
+	    *(StgInt32 *)(adjustor+24) = 0x00000b3d;
+	    *(StgInt32 *)(adjustor+28) = 0x0000e900;
+	    
+	    *(StgInt32 *)(adjustor+3) = 
+		(StgInt32)(StgInt64)obscure_ccall_ret_code;
+	    *(StgInt32 *)(adjustor+30) = 
+		(StgInt32)((StgInt64)wptr - (StgInt64)adjustor - 34);
+	    *(StgInt64 *)(adjustor+40) = (StgInt64)hptr;
+	}
+    }
 #elif defined(sparc_HOST_ARCH)
   /* Magic constant computed by inspecting the code length of the following
      assembly language snippet (offset and machine code prefixed):
@@ -848,7 +996,16 @@
     freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x01)));
  } else {
     freeStablePtr(*((StgStablePtr*)((unsigned char*)ptr + 0x02)));
- }    
+ }
+#elif defined(x86_64_HOST_ARCH)
+ if ( *(StgWord16 *)ptr == 0x894d ) {
+     freeStablePtr(*(StgStablePtr*)(ptr+32));
+ } else if ( *(StgWord16 *)ptr == 0x5141 ) {
+     freeStablePtr(*(StgStablePtr*)(ptr+40));
+ } else {
+   errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
+   return;
+ }
 #elif defined(sparc_HOST_ARCH)
  if ( *(unsigned long*)ptr != 0x9C23A008UL ) {
    errorBelch("freeHaskellFunctionPtr: not for me, guv! %p\n", ptr);
@@ -906,30 +1063,4 @@
 void
 initAdjustor(void)
 {
-#if defined(i386_HOST_ARCH)
-  /* Now here's something obscure for you:
-
-  When generating an adjustor thunk that uses the C calling
-  convention, we have to make sure that the thunk kicks off
-  the process of jumping into Haskell with a tail jump. Why?
-  Because as a result of jumping in into Haskell we may end
-  up freeing the very adjustor thunk we came from using
-  freeHaskellFunctionPtr(). Hence, we better not return to
-  the adjustor code on our way  out, since it could by then
-  point to junk.
-
-  The fix is readily at hand, just include the opcodes
-  for the C stack fixup code that we need to perform when
-  returning in some static piece of memory and arrange
-  to return to it before tail jumping from the adjustor thunk.
-  */
-
-  obscure_ccall_ret_code = mallocBytesRWX(4);
-
-  obscure_ccall_ret_code[0x00] = (unsigned char)0x83;  /* addl $0x4, %esp */
-  obscure_ccall_ret_code[0x01] = (unsigned char)0xc4;
-  obscure_ccall_ret_code[0x02] = (unsigned char)0x04;
-
-  obscure_ccall_ret_code[0x03] = (unsigned char)0xc3;  /* ret */
-#endif
 }


--- NEW FILE ghc.spec ---
%define build_version 6.4
%define ghcver ghc64

# speed up test builds by not building profiled libraries
%define build_prof 1
%define build_doc 0

# ghc-6.4 doesn't build with gcc-4.0 yet
%define _with_gcc32 %{nil}

Name:		ghc
Version:	6.4
Release:	8
Summary:	Glasgow Haskell Compilation system
License:	BSD style
Group:		Development/Languages
Source:		http://www.haskell.org/ghc/dist/%{version}/ghc-%{version}-src.tar.bz2
URL:		http://haskell.org/ghc/
Requires:	%{ghcver} = %{version}-%{release}
BuildRoot:	%{_tmppath}/%{name}-%{version}-%{release}-root-%(%{__id_u} -n)
BuildRequires: sed, %{ghcver}, %{?_with_gcc32: compat-gcc-32}
Buildrequires: gmp-devel, readline-devel, xorg-x11-devel, freeglut-devel, openal-devel
%if %{build_doc}
# haddock generates libraries/ docs
Buildrequires: libxslt, docbook-style-xsl, haddock
%endif
Prefix: %{_prefix}
Patch1: ghc-6.4-powerpc.patch
Patch2: rts-GCCompact.h-x86_64.patch
Patch3: ghc-6.4-dsforeign-x86_64-1097471.patch
Patch4: ghc-6.4-rts-adjustor-x86_64-1097471.patch

%description
GHC is a state-of-the-art programming suite for Haskell, a purely
functional programming language.  It includes an optimising compiler
generating good code for a variety of platforms, together with an
interactive system for convenient, quick development.  The
distribution includes space and time profiling facilities, a large
collection of libraries, and support for various language
extensions, including concurrency, exceptions, and a foreign language
interface.

%package -n %{ghcver}
Summary:	Documentation for GHC
Group:		Development/Languages
Requires:	gcc gmp-devel readline-devel

%description -n %{ghcver}
GHC is a state-of-the-art programming suite for Haskell, a purely
functional programming language.  It includes an optimising compiler
generating good code for a variety of platforms, together with an
interactive system for convenient, quick development.  The
distribution includes space and time profiling facilities, a large
collection of libraries, and support for various language
extensions, including concurrency, exceptions, and a foreign language
interfaces.

This package contains all the main files and libraries of version %{version}.

%if %{build_prof}
%package -n %{ghcver}-prof
Summary:	Profiling libraries for GHC
Group:		Development/Libraries
Requires:	%{ghcver} = %{version}-%{release}
Obsoletes:	ghc-prof

%description -n %{ghcver}-prof
Profiling libraries for Glorious Glasgow Haskell Compilation System
(GHC).  They should be installed when GHC's profiling subsystem is
needed.
%endif

%package doc
Summary:	Documentation for GHC
Group:		Development/Languages

%description doc
Preformatted documentation for the Glorious Glasgow Haskell
Compilation System (GHC) and its libraries.  It should be installed if
you like to have local access to the documentation in HTML format.

# the debuginfo subpackage is currently empty anyway, so don't generate it
%define debug_package %{nil}
%define __spec_install_post /usr/lib/rpm/brp-compress

%prep
%setup -q -n ghc-%{version}
%patch1 -p1 -b .1-ppc
%patch2 -p1 -b .2-x86_64
%patch3 -p1 -b .3-x86_64
%patch4 -p1 -b .4-x86_64

%build
%ifarch x86_64
echo "SplitObjs = NO" >> mk/build.mk
echo "GhcWithInterpreter = NO" >> mk/build.mk
%endif
%if !%{build_prof}
echo "GhcLibWays=" >> mk/build.mk
echo "GhcRTSWays=thr debug" >> mk/build.mk
%endif

./configure --prefix=%{_prefix} --libdir=%{_libdir} --with-ghc=ghc-%{build_version} %{?_with_gcc32: --with-gcc=%{_bindir}/gcc32}

make all
%if %{build_doc}
make html
%endif

%install
rm -rf $RPM_BUILD_ROOT

make prefix=$RPM_BUILD_ROOT%{_prefix} libdir=$RPM_BUILD_ROOT%{_libdir}/%{name}-%{version} install

%if %{build_doc}
make datadir=$RPM_BUILD_ROOT%{_docdir}/ghc-%{version} XMLDocWays="html" install-docs
%endif

SRC_TOP=$PWD
rm -f rpm-*-filelist rpm-*.files
( cd $RPM_BUILD_ROOT
  find .%{_libdir}/%{name}-%{version} \( -type d -fprintf $SRC_TOP/rpm-dir.files "%%%%dir %%p\n" \) -o \( -type f \( -name '*.p_hi' -o -name '*_p.a' \) -fprint $SRC_TOP/rpm-prof.files \) -o \( -not -name 'package.conf' -fprint $SRC_TOP/rpm-lib.files \)
)

# make paths absolute (filter "./usr" to "/usr")
sed -i -e "s|\.%{_prefix}|%{_prefix}|" rpm-*.files

cat rpm-dir.files rpm-lib.files > rpm-base-filelist
%if %{build_prof}
cat rpm-dir.files rpm-prof.files > rpm-prof-filelist
%endif

%clean
rm -rf $RPM_BUILD_ROOT

%post
## tweak prefix in drivers scripts if relocating
if [ "${RPM_INSTALL_PREFIX}" != "%{_prefix}" ]; then
  BINDIR=`echo %{_bindir} | sed -e "s|%{_prefix}|${RPM_INSTALL_PREFIX}|"`
  sed -i "s|%{_prefix}|${RPM_INSTALL_PREFIX}|" ${BINDIR}/{ghcprof,hsc2hs}
fi

%post -n %{ghcver}
## tweak prefix in drivers scripts if relocating
if [ "${RPM_INSTALL_PREFIX}" != "%{_prefix}" ]; then
  BINDIR=`echo %{_bindir} | sed -e "s|%{_prefix}|${RPM_INSTALL_PREFIX}|"`
  LIBDIR=`echo %{_libdir} | sed -e "s|%{_prefix}|${RPM_INSTALL_PREFIX}|"`
  sed -i "s|%{_prefix}|${RPM_INSTALL_PREFIX}|" ${BINDIR}/ghc*-%{version} ${LIBDIR}/ghc-%{version}/package.conf
fi

%files
%defattr(-,root,root,-)
%{_bindir}/*
%exclude %{_bindir}/ghc*%{version}

%files -n %{ghcver} -f rpm-base-filelist
%defattr(-,root,root,-)
%doc ghc/ANNOUNCE ghc/LICENSE ghc/README
%{_bindir}/ghc*%{version}
%config(noreplace) %{_libdir}/ghc-%{version}/package.conf

%if %{build_prof}
%files -n %{ghcver}-prof -f rpm-prof-filelist
%defattr(-,root,root,-)
%endif

%if %{build_doc}
%files doc
%defattr(-,root,root,-)
%{_docdir}/%{name}-%{version}
%endif

%changelog
* Thu May 12 2005 Jens Petersen <petersen at redhat.com> - 6.4-8
- initial import into Fedora Extras

* Thu May 12 2005 Jens Petersen <petersen at haskell.org>
- add build_prof and build_doc switches for -doc and -prof subpackages
- add _with_gcc32 switch since ghc-6.4 doesn't build with gcc-4.0

* Wed May 11 2005 Jens Petersen <petersen at haskell.org> - 6.4-7
- make package relocatable (ghc#1084122)
  - add post install scripts to replace prefix in driver scripts
- buildrequire libxslt and docbook-style-xsl instead of docbook-utils and flex

* Fri May  6 2005 Jens Petersen <petersen at haskell.org> - 6.4-6
- add ghc-6.4-dsforeign-x86_64-1097471.patch and
  ghc-6.4-rts-adjustor-x86_64-1097471.patch from trunk to hopefully fix
  ffi support on x86_64 (Simon Marlow, ghc#1097471)
- use XMLDocWays instead of SGMLDocWays to build documentation fully

* Mon May  2 2005 Jens Petersen <petersen at haskell.org> - 6.4-5
- add rts-GCCompact.h-x86_64.patch to fix GC issue on x86_64 (Simon Marlow)

* Thu Mar 17 2005 Jens Petersen <petersen at haskell.org> - 6.4-4
- add ghc-6.4-powerpc.patch (Ryan Lortie)
- disable building interpreter rather than install and delete on x86_64

* Wed Mar 16 2005 Jens Petersen <petersen at haskell.org> - 6.4-3
- make ghc require ghcver of same ver-rel
- on x86_64 remove ghci for now since it doesn't work and all .o files

* Tue Mar 15 2005 Jens Petersen <petersen at haskell.org> - 6.4-2
- ghc requires ghcver (Amanda Clare)

* Sat Mar 12 2005 Jens Petersen <petersen at haskell.org> - 6.4-1
- 6.4 release
  - x86_64 build no longer unregisterised
- use sed instead of perl to tidy filelists
- buildrequire ghc64 instead of ghc-6.4
- no epoch for ghc64-prof's ghc64 requirement
- install docs directly in docdir

* Fri Jan 21 2005 Jens Petersen <petersen at haskell.org> - 6.2.2-2
- add x86_64 port
  - build unregistered and without splitobjs
  - specify libdir to configure and install
- rename ghc-prof to ghcXYZ-prof, which obsoletes ghc-prof

* Mon Dec  6 2004 Jens Petersen <petersen at haskell.org> - 6.2.2-1
- move ghc requires to ghcXYZ

* Wed Nov 24 2004 Jens Petersen <petersen at haskell.org> - 6.2.2-0.fdr.1
- ghc622
  - provide ghc = %%version
- require gcc, gmp-devel and readline-devel

* Fri Oct 15 2004 Gerard Milmeister <gemi at bluewin.ch> - 6.2.2-0.fdr.1
- New Version 6.2.2

* Mon Mar 22 2004 Gerard Milmeister <gemi at bluewin.ch> - 6.2.1-0.fdr.1
- New Version 6.2.1

* Tue Dec 16 2003 Gerard Milmeister <gemi at bluewin.ch> - 6.2-0.fdr.1
- New Version 6.2

* Tue Dec 16 2003 Gerard Milmeister <gemi at bluewin.ch> - 6.0.1-0.fdr.3
- A few minor specfile tweaks

* Mon Dec 15 2003 Gerard Milmeister <gemi at bluewin.ch> - 6.0.1-0.fdr.2
- Different file list generation

* Mon Oct 20 2003 Gerard Milmeister <gemi at bluewin.ch> - 6.0.1-0.fdr.1
- First Fedora release
- Added generated html docs, so that haddock is not needed

* Wed Sep 26 2001 Manuel Chakravarty
- small changes for 5.04

* Wed Sep 26 2001 Manuel Chakravarty
- split documentation off into a separate package
- adapt to new docbook setup in RH7.1

* Mon Apr 16 2001 Manuel Chakravarty
- revised for 5.00
- also runs autoconf automagically if no ./configure found

* Thu Jun 22 2000 Sven Panne
- removed explicit usage of hslibs/docs, it belongs to ghc/docs/set

* Sun Apr 23 2000 Manuel Chakravarty
- revised for ghc 4.07; added suggestions from Pixel <pixel at mandrakesoft.com>
- added profiling package

* Tue Dec 7 1999 Manuel Chakravarty
- version for use from CVS

* Thu Sep 16 1999 Manuel Chakravarty
- modified for GHC 4.04, patchlevel 1 (no more 62 tuple stuff); minimises use
  of patch files - instead emits a build.mk on-the-fly

* Sat Jul 31 1999 Manuel Chakravarty
- modified for GHC 4.04

* Wed Jun 30 1999 Manuel Chakravarty
- some more improvements from vbzoli

* Fri Feb 26 1999 Manuel Chakravarty
- modified for GHC 4.02

* Thu Dec 24 1998 Zoltan Vorosbaranyi 
- added BuildRoot
- files located in /usr/local/bin, /usr/local/lib moved to /usr/bin, /usr/lib

* Tue Jul 28 1998 Manuel Chakravarty
- original version

rts-GCCompact.h-x86_64.patch:

--- NEW FILE rts-GCCompact.h-x86_64.patch ---
--- fptools/ghc/rts/GCCompact.h	2004/09/12 11:27:14	1.4
+++ fptools/ghc/rts/GCCompact.h	2005/04/29 16:18:58	1.5
@@ -12,7 +12,7 @@ mark(StgPtr p, bdescr *bd)
     nat offset_within_block = p - bd->start; // in words
     StgPtr bitmap_word = (StgPtr)bd->u.bitmap + 
 	(offset_within_block / (sizeof(W_)*BITS_PER_BYTE));
-    nat bit_mask = 1 << (offset_within_block & (sizeof(W_)*BITS_PER_BYTE - 1));
+    StgWord bit_mask = (StgWord)1 << (offset_within_block & (sizeof(W_)*BITS_PER_BYTE - 1));
     *bitmap_word |= bit_mask;
 }
 
@@ -22,17 +22,17 @@ unmark(StgPtr p, bdescr *bd)
     nat offset_within_block = p - bd->start; // in words
     StgPtr bitmap_word = (StgPtr)bd->u.bitmap + 
 	(offset_within_block / (sizeof(W_)*BITS_PER_BYTE));
-    nat bit_mask = 1 << (offset_within_block & (sizeof(W_)*BITS_PER_BYTE - 1));
+    StgWord bit_mask = (StgWord)1 << (offset_within_block & (sizeof(W_)*BITS_PER_BYTE - 1));
     *bitmap_word &= ~bit_mask;
 }
 
-INLINE_HEADER int
+INLINE_HEADER StgWord
 is_marked(StgPtr p, bdescr *bd)
 {
     nat offset_within_block = p - bd->start; // in words
     StgPtr bitmap_word = (StgPtr)bd->u.bitmap + 
 	(offset_within_block / (sizeof(W_)*BITS_PER_BYTE));
-    nat bit_mask = 1 << (offset_within_block & (sizeof(W_)*BITS_PER_BYTE - 1));
+    StgWord bit_mask = (StgWord)1 << (offset_within_block & (sizeof(W_)*BITS_PER_BYTE - 1));
     return (*bitmap_word & bit_mask);
 }
 


Index: .cvsignore
===================================================================
RCS file: /cvs/extras/rpms/ghc/devel/.cvsignore,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- .cvsignore	12 May 2005 07:35:42 -0000	1.1
+++ .cvsignore	12 May 2005 07:37:43 -0000	1.2
@@ -0,0 +1 @@
+ghc-6.4-src.tar.bz2


Index: sources
===================================================================
RCS file: /cvs/extras/rpms/ghc/devel/sources,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- sources	12 May 2005 07:35:42 -0000	1.1
+++ sources	12 May 2005 07:37:43 -0000	1.2
@@ -0,0 +1 @@
+45ea4e15f135698feb88d12c5000aaf8  ghc-6.4-src.tar.bz2




More information about the fedora-extras-commits mailing list