#2098: validate fails for PPC Mac OS X 10.4
----------------------------+-----------------------------------------------
    Reporter:  thorkilnaur  |       Owner:          
        Type:  bug          |      Status:  new     
    Priority:  normal       |   Component:  Compiler
     Version:  6.9          |    Severity:  normal  
    Keywords:               |    Testcase:          
Architecture:  powerpc      |          Os:  MacOS X 
----------------------------+-----------------------------------------------
 Lately (http://www.haskell.org/pipermail/cvs-
 ghc/2008-February/041135.html) validate has been failing for PPC Mac OS X
 10.4 as follows:
 {{{
 ../compiler/stage1/ghc-inplace -no-user-package-conf -Werror -H64m -Onot
 -fasm  -istage2/utils  -istage2/basicTypes  -istage2/types  -istage2/hsSyn
 -istage2/prelude  -istage2/rename  -istage2/typecheck  -istage2/deSugar
 -istage2/coreSyn  -istage2/vectorise  -istage2/specialise
 -istage2/simplCore  -istage2/stranal  -istage2/stgSyn  -istage2/simplStg
 -istage2/codeGen  -istage2/main  -istage2/profiling  -istage2/parser
 -istage2/cprAnalysis  -istage2/ndpFlatten  -istage2/iface  -istage2/cmm
 -istage2/nativeGen  -istage2/ghci -Wall -fno-warn-name-shadowing -fno-
 warn-orphans -Istage2 -package hpc -package bytestring -DGHCI -package
 template-haskell -DGHCI_TABLES_NEXT_TO_CODE -package readline
 -DUSE_READLINE -cpp -fglasgow-exts -fno-generics -Rghc-timing -I. -Iparser
 -package unix -package Cabal -ignore-package lang -recomp -Rghc-timing
 -Onot -fasm -H16M '-#include "cutils.h"' -package-name  ghc-6.9.20080208
 -fgenerics    -c ghci/ByteCodeFFI.lhs -o stage2/ghci/ByteCodeFFI.o  -ohi
 stage2/ghci/ByteCodeFFI.hi

 ghci/ByteCodeFFI.lhs:690:18:
     Couldn't match expected type `PrimRep'
            against inferred type `CgRep'
     In the pattern: FloatArg
     In a case alternative:
         FloatArg
           | nextFPR < 14
           -> (3223257088 .|. (fromIntegral haskellArgOffset .&. 65535)
           .|.
             (fromIntegral nextFPR `shiftL` 21))
            : pass_parameters args (nextFPR + 1) offsetW'
     In the expression:
         let
           haskellArgOffset = a_offW * bytes_per_word
           offsetW' = offsetW + primRepSizeW a_rep
           pass_word w | offsetW + w < 8 = [...]
                       | otherwise = [...]
                       where
                           src = ...
                           ....
         in
           case a_rep of
             FloatArg
               | nextFPR < 14
               -> (3223257088 .|. (fromIntegral haskellArgOffset .&. 65535)
               .|.
                 (fromIntegral nextFPR `shiftL` 21))
                : pass_parameters args (nextFPR + 1) offsetW'
             DoubleArg
               | nextFPR < 14
               -> (3357474816 .|. (fromIntegral haskellArgOffset .&. 65535)
               .|.
                 (fromIntegral nextFPR `shiftL` 21))
                : pass_parameters args (nextFPR + 1) offsetW'
             _ -> concatMap pass_word ([0 .. primRepSizeW a_rep - 1])
                ++
                  pass_parameters args nextFPR offsetW'

 ghci/ByteCodeFFI.lhs:705:12:
     Couldn't match expected type `PrimRep'
            against inferred type `CgRep'
     In the pattern: VoidArg
     In a case alternative: VoidArg -> []
     In the expression:
         case r_rep of
           VoidArg -> []
           FloatArg -> [3493789696 .|. (fromIntegral result_off .&. 65535)]
           DoubleArg -> [3628007424 .|. (fromIntegral result_off .&.
 65535)]
           _ | primRepSizeW r_rep == 2
             -> [2424242176 .|. (fromIntegral result_off .&. 65535),
                 2426339328 .|. (fromIntegral (result_off + 4) .&. 65535)]
           _ | primRepSizeW r_rep == 1
             -> [2424242176 .|. (fromIntegral result_off .&. 65535)]
 <<ghc: 47687720 bytes, 9 GCs, 2690342/5255332 avg/max bytes residency (2
 samples), 17M in use, 0.01 INIT (0.00 elapsed), 0.87 MUT (2.73 elapsed),
 0.61 GC (1.47 elapsed) :ghc>>
 make[2]: *** [stage2/ghci/ByteCodeFFI.o] Error 1
 make[2]: *** Waiting for unfinished jobs....
 <<ghc: 208607448 bytes, 28 GCs, 3604469/5941884 avg/max bytes residency (3
 samples), 20M in use, 0.01 INIT (0.00 elapsed), 4.79 MUT (11.39 elapsed),
 1.36 GC (2.55 elapsed) :ghc>>
 make[1]: *** [stage2] Error 2
 make: *** [bootstrap2] Error 2
 }}}
 Best regards
 Thorkil

-- 
Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/2098>
GHC <http://www.haskell.org/ghc/>
The Glasgow Haskell Compiler
_______________________________________________
Glasgow-haskell-bugs mailing list
Glasgow-haskell-bugs@haskell.org
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs

Reply via email to