diff --git a/ghc/driver/Main.hs b/ghc/driver/Main.hs
index 2e235bf8ee15ed58b4cdebfdcada8df527b31475..fba1d994a9a0f8b4e8c8dcb21264e11ee5353c19 100644
--- a/ghc/driver/Main.hs
+++ b/ghc/driver/Main.hs
@@ -1,6 +1,6 @@
{-# OPTIONS -W -fno-warn-incomplete-patterns #-}
-----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.68 2000/10/11 16:06:38 simonmar Exp $
+-- $Id: Main.hs,v 1.69 2000/11/07 10:42:55 simonmar Exp $
--
-- GHC Driver program
--
@@ -13,6 +13,8 @@
module Main (main) where
+import Utils
+
import GetImports
import Package
import Config
@@ -773,7 +775,6 @@ GLOBAL_VAR(build_tag, "", String)
data WayName
= WayProf
| WayUnreg
- | WayDll
| WayTicky
| WayPar
| WayGran
@@ -800,12 +801,9 @@ data WayName
GLOBAL_VAR(ways, [] ,[WayName])
--- ToDo: allow WayDll with any other allowed combination
-
-allowed_combinations =
- [ [WayProf,WayUnreg],
- [WayProf,WaySMP] -- works???
- ]
+allowed_combination ways = ways `elem` combs
+ where -- the sub-lists must be ordered according to WayName, because findBuildTag sorts them
+ combs = [ [WayProf,WayUnreg], [WayProf,WaySMP] ]
findBuildTag :: IO [String] -- new options
findBuildTag = do
@@ -818,7 +816,7 @@ findBuildTag = do
writeIORef build_tag (wayTag details)
return (wayOpts details)
- ws -> if ws `notElem` allowed_combinations
+ ws -> if allowed_combination ws
then throwDyn (OtherError $
"combination not supported: " ++
foldr1 (\a b -> a ++ '/':b)
@@ -862,9 +860,6 @@ way_details =
, "-funregisterised"
, "-fvia-C" ]),
- (WayDll, Way "dll" "DLLized"
- [ ]),
-
(WayPar, Way "mp" "Parallel"
[ "-fparallel"
, "-D__PARALLEL_HASKELL__"
@@ -952,9 +947,10 @@ machdepCCOpts
-- the fp (%ebp) for our register maps.
= do n_regs <- readState stolen_x86_regs
sta <- readIORef static
- return ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "" ],
+ return ( [ if sta then "-DDONT_WANT_WIN32_DLL_SUPPORT" else "",
+ if suffixMatch "mingw32" cTARGETPLATFORM then "-mno-cygwin" else "" ],
[ "-fno-defer-pop", "-fomit-frame-pointer",
- "-DSTOLEN_X86_REGS="++show n_regs ]
+ "-DSTOLEN_X86_REGS="++show n_regs]
)
| prefixMatch "mips" cTARGETPLATFORM
@@ -1190,7 +1186,7 @@ main =
-----------------------------------------------------------------------------
-- Which phase to stop at
-data ToDo = DoMkDependHS | DoMkDLL | StopBefore Phase | DoLink
+data ToDo = DoMkDependHS | StopBefore Phase | DoLink
deriving (Eq)
GLOBAL_VAR(v_todo, error "todo", ToDo)
@@ -1785,7 +1781,8 @@ run_phase Hsc basename suff input_fn output_fn
-- date wrt M.hs (or M.o doesn't exist) so we must recompile regardless.
do_recomp <- readIORef recomp
todo <- readIORef v_todo
- o_file <- odir_ify (basename ++ '.':phase_input_ext Ln)
+ o_file' <- odir_ify (basename ++ '.':phase_input_ext Ln)
+ o_file <- osuf_ify o_file'
source_unchanged <-
if not (do_recomp && ( todo == DoLink || todo == StopBefore Ln ))
then return ""
@@ -1843,7 +1840,7 @@ run_phase Hsc basename suff input_fn output_fn
run_something "Copy stub .c file"
(unwords [
"rm -f", stub_c, "&&",
- "echo \'#include \""++stub_h++"\"\' >"++stub_c, " &&",
+ "echo \'#include \"Stg.h\"\n#include \""++stub_h++"\"\' >"++stub_c, " &&",
"cat", tmp_stub_c, ">> ", stub_c
])
@@ -1922,9 +1919,6 @@ run_phase cc_phase _basename _suff input_fn output_fn
++ [ verb, "-S", "-Wimplicit", opt_flag ]
++ [ "-D__GLASGOW_HASKELL__="++cProjectVersionInt ]
++ cc_opts
-#ifdef mingw32_TARGET_OS
- ++ [" -mno-cygwin"]
-#endif
++ (if excessPrecision then [] else [ "-ffloat-store" ])
++ include_paths
++ pkg_extra_cc_opts
@@ -2027,10 +2021,15 @@ run_phase SplitAs basename _suff _input_fn _output_fn
-----------------------------------------------------------------------------
-- Linking
+GLOBAL_VAR(no_hs_main, False, Bool)
+
do_link :: [String] -> IO ()
do_link o_files = do
ln <- readIORef pgm_l
verb <- is_verbose
+ static <- readIORef static
+ let imp = if static then "" else "_imp"
+ no_hs_main <- readIORef no_hs_main
o_file <- readIORef output_file
let output_fn = case o_file of { Just s -> s; Nothing -> "a.out"; }
@@ -2041,7 +2040,7 @@ do_link o_files = do
let lib_path_opts = map ("-L"++) lib_paths
pkg_libs <- getPackageLibraries
- let pkg_lib_opts = map (\lib -> "-l"++lib) pkg_libs
+ let pkg_lib_opts = map (\lib -> "-l" ++ lib ++ imp) pkg_libs
libs <- readIORef cmdline_libraries
let lib_opts = map ("-l"++) (reverse libs)
@@ -2055,10 +2054,23 @@ do_link o_files = do
-- opts from -optl-<blah>
extra_ld_opts <- getOpts opt_l
+ rts_pkg <- getPackageDetails ["rts"]
+ std_pkg <- getPackageDetails ["std"]
+#ifdef mingw32_TARGET_OS
+ let extra_os = if static || no_hs_main
+ then []
+ else [ head (library_dirs (head rts_pkg)) ++ "/Main.dll_o",
+ head (library_dirs (head std_pkg)) ++ "/PrelMain.dll_o" ]
+#endif
+ (md_c_flags, _) <- machdepCCOpts
run_something "Linker"
- (unwords
+ (unwords
([ ln, verb, "-o", output_fn ]
+ ++ md_c_flags
++ o_files
+#ifdef mingw32_TARGET_OS
+ ++ extra_os
+#endif
++ extra_ld_inputs
++ lib_path_opts
++ lib_opts
@@ -2066,6 +2078,11 @@ do_link o_files = do
++ pkg_lib_opts
++ pkg_extra_ld_opts
++ extra_ld_opts
+#ifdef mingw32_TARGET_OS
+ ++ if static then [ "-u _PrelMain_mainIO_closure" , "-u ___init_PrelMain"] else []
+#else
+ ++ [ "-u PrelMain_mainIO_closure" , "-u __init_PrelMain"]
+#endif
)
)
@@ -2095,7 +2112,7 @@ run_something phase_name cmd
hPutStrLn h cmd
hClose h
exit_code <- system ("sh - " ++ tmp) `catchAllIO`
- (\e -> throwDyn (PhaseFailed phase_name (ExitFailure 1)))
+ (\_ -> throwDyn (PhaseFailed phase_name (ExitFailure 1)))
removeFile tmp
#endif
@@ -2144,7 +2161,6 @@ driver_opts =
------- ways --------------------------------------------------------
, ( "prof" , NoArg (addNoDups ways WayProf) )
, ( "unreg" , NoArg (addNoDups ways WayUnreg) )
- , ( "dll" , NoArg (addNoDups ways WayDll) )
, ( "ticky" , NoArg (addNoDups ways WayTicky) )
, ( "parallel" , NoArg (addNoDups ways WayPar) )
, ( "gransim" , NoArg (addNoDups ways WayGran) )
@@ -2177,6 +2193,7 @@ driver_opts =
, ( "cpp" , NoArg (updateState (\s -> s{ cpp_flag = True })) )
, ( "#include" , HasArg (addCmdlineHCInclude) )
, ( "no-link-chk" , NoArg (return ()) ) -- ignored for backwards compat
+ , ( "no-hs-main" , NoArg (writeIORef no_hs_main True) )
------- Output Redirection ------------------------------------------
, ( "odir" , HasArg (writeIORef output_dir . Just) )
@@ -2254,6 +2271,7 @@ driver_opts =
----- Linker --------------------------------------------------------
, ( "static" , NoArg (writeIORef static True) )
+ , ( "rdynamic" , NoArg (return ()) ) -- ignored for compat w/ gcc
------ Compiler RTS options -----------------------------------------
, ( "H" , HasArg (newHeapSize . decodeSize) )
@@ -2434,15 +2452,6 @@ my_prefix_match (p:pat) (r:rest)
| p == r = my_prefix_match pat rest
| otherwise = Nothing
-prefixMatch :: Eq a => [a] -> [a] -> Bool
-prefixMatch [] _str = True
-prefixMatch _pat [] = False
-prefixMatch (p:ps) (s:ss) | p == s = prefixMatch ps ss
- | otherwise = False
-
-postfixMatch :: String -> String -> Bool
-postfixMatch pat str = prefixMatch (reverse pat) (reverse str)
-
later = flip finally
my_catchDyn = flip catchDyn
diff --git a/ghc/driver/Makefile b/ghc/driver/Makefile
index 581c9c59783b623d28c4429098e5010caae55738..d6571ec632c5aa36e6c20765110f0d73517f4c05 100644
--- a/ghc/driver/Makefile
+++ b/ghc/driver/Makefile
@@ -1,5 +1,5 @@
#-----------------------------------------------------------------------------
-# $Id: Makefile,v 1.44 2000/09/05 10:16:41 simonmar Exp $
+# $Id: Makefile,v 1.45 2000/11/07 10:42:56 simonmar Exp $
#
TOP=..
@@ -22,8 +22,8 @@ SRC_HC_OPTS += -fglasgow-exts -cpp -syslib concurrent -syslib posix -syslib misc
endif
HS_PROG = ghc-$(ProjectVersion)
-HS_SRCS = Config.hs Package.hs GetImports.hs Main.hs
-MKDEPENDHS_SRCS = Config.hs Main.hs GetImports.hs PackageSrc.hs
+HS_SRCS = Config.hs Package.hs GetImports.hs Main.hs Utils.hs
+MKDEPENDHS_SRCS = Config.hs Main.hs GetImports.hs PackageSrc.hs Utils.hs
LINK = ghc
SUBDIRS = mangler split stats
@@ -58,7 +58,7 @@ Config.hs : $(FPTOOLS_TOP)/mk/config.mk Makefile
@echo "cGHC_SPLIT = \"$(GHC_SPLIT)\"" >> Config.hs
@echo "cGHC_STATS = \"$(GHC_STATS)\"" >> Config.hs
@echo "cGHC_SYSMAN = \"$(GHC_SYSMAN)\"" >> Config.hs
- @echo "cEnableWin32DLLs = \"$(EnableWin32DLLs)\"" >> Config.hs
+ @echo "cDLLized = \"$(DLLized)\"" >> Config.hs
@echo "cCP = \"$(CP)\"" >> Config.hs
@echo "cRM = \"$(RM)\"" >> Config.hs
@echo "cCONTEXT_DIFF = \"$(CONTEXT_DIFF)\"" >> Config.hs
@@ -95,8 +95,8 @@ CLEAN_FILES += ghc-inplace
all :: package.conf package.conf.inplace
-pkgconf : Config.o Package.o PackageSrc.o
- $(HC) $(HC_OPTS) $(LD_OPTS) Config.o Package.o PackageSrc.o -o pkgconf
+pkgconf : Config.o Package.o PackageSrc.o Utils.o
+ $(HC) $(HC_OPTS) $(LD_OPTS) Config.o Package.o PackageSrc.o Utils.o -o pkgconf
package.conf.inplace : pkgconf
./pkgconf in-place >$@
@@ -120,8 +120,12 @@ INSTALL_DATAS += ghc-usage.txt
include $(TOP)/mk/target.mk
-# we need the driver for generating dependencies...
-boot :: all
+# We need the driver for generating dependencies... so build it as
+# part of make boot. We need to do this using a recursive invocation
+# of $(MAKE), so that dependencies we just generated for the driver
+# itself are picked up.
+boot ::
+ $(MAKE) $(MFLAGS) all
# -----------------------------------------------------------------------------
# Create link to from ghc-x.xx to ghc...
diff --git a/ghc/driver/PackageSrc.hs b/ghc/driver/PackageSrc.hs
index 22fbf4b454a3a52d1b9b310c5b2b969ada6a438c..448c76648cae0ac0f04029d111553316d522a13e 100644
--- a/ghc/driver/PackageSrc.hs
+++ b/ghc/driver/PackageSrc.hs
@@ -1,5 +1,9 @@
+#include "../includes/config.h"
+
module Main (main) where
+import Utils
+
import IO
import System
import Config
@@ -52,37 +56,41 @@ package_details installing =
extra_cc_opts = [],
-- the RTS forward-references to a bunch of stuff in the prelude,
-- so we force it to be included with special options to ld.
- extra_ld_opts = [
- "-u PrelMain_mainIO_closure"
- , "-u PrelBase_Izh_static_info"
- , "-u PrelBase_Czh_static_info"
- , "-u PrelFloat_Fzh_static_info"
- , "-u PrelFloat_Dzh_static_info"
- , "-u PrelAddr_Azh_static_info"
- , "-u PrelAddr_Wzh_static_info"
- , "-u PrelAddr_I64zh_static_info"
- , "-u PrelAddr_W64zh_static_info"
- , "-u PrelStable_StablePtr_static_info"
- , "-u PrelBase_Izh_con_info"
- , "-u PrelBase_Czh_con_info"
- , "-u PrelFloat_Fzh_con_info"
- , "-u PrelFloat_Dzh_con_info"
- , "-u PrelAddr_Azh_con_info"
- , "-u PrelAddr_Wzh_con_info"
- , "-u PrelAddr_I64zh_con_info"
- , "-u PrelAddr_W64zh_con_info"
- , "-u PrelStable_StablePtr_con_info"
- , "-u PrelBase_False_closure"
- , "-u PrelBase_True_closure"
- , "-u PrelPack_unpackCString_closure"
- , "-u PrelIOBase_stackOverflow_closure"
- , "-u PrelIOBase_heapOverflow_closure"
- , "-u PrelIOBase_NonTermination_closure"
- , "-u PrelIOBase_PutFullMVar_closure"
- , "-u PrelIOBase_BlockedOnDeadMVar_closure"
- , "-u PrelWeak_runFinalizzerBatch_closure"
- , "-u __init_Prelude"
- , "-u __init_PrelMain"
+ extra_ld_opts = map (
+#ifndef LEADING_UNDERSCORE
+ "-u "
+#else
+ "-u _"
+#endif
+ ++ ) [
+ "PrelBase_Izh_static_info"
+ , "PrelBase_Czh_static_info"
+ , "PrelFloat_Fzh_static_info"
+ , "PrelFloat_Dzh_static_info"
+ , "PrelAddr_Azh_static_info"
+ , "PrelAddr_Wzh_static_info"
+ , "PrelAddr_I64zh_static_info"
+ , "PrelAddr_W64zh_static_info"
+ , "PrelStable_StablePtr_static_info"
+ , "PrelBase_Izh_con_info"
+ , "PrelBase_Czh_con_info"
+ , "PrelFloat_Fzh_con_info"
+ , "PrelFloat_Dzh_con_info"
+ , "PrelAddr_Azh_con_info"
+ , "PrelAddr_Wzh_con_info"
+ , "PrelAddr_I64zh_con_info"
+ , "PrelAddr_W64zh_con_info"
+ , "PrelStable_StablePtr_con_info"
+ , "PrelBase_False_closure"
+ , "PrelBase_True_closure"
+ , "PrelPack_unpackCString_closure"
+ , "PrelIOBase_stackOverflow_closure"
+ , "PrelIOBase_heapOverflow_closure"
+ , "PrelIOBase_NonTermination_closure"
+ , "PrelIOBase_PutFullMVar_closure"
+ , "PrelIOBase_BlockedOnDeadMVar_closure"
+ , "PrelWeak_runFinalizzerBatch_closure"
+ , "__init_Prelude"
]
},
@@ -104,7 +112,11 @@ package_details installing =
package_deps = [ "rts" ],
extra_ghc_opts = [],
extra_cc_opts = [],
- extra_ld_opts = [ "-lm" ]
+ extra_ld_opts = [ "-lm"
+#ifdef mingw32_TARGET_OS
+ , "-lwsock32"
+#endif
+ ]
},
Package {
@@ -191,7 +203,7 @@ package_details installing =
package_deps = [ "lang", "text" ],
extra_ghc_opts = [],
extra_cc_opts = [],
- extra_ld_opts = if postfixMatch "solaris2" cTARGETPLATFORM
+ extra_ld_opts = if suffixMatch "solaris2" cTARGETPLATFORM
then [ "-lnsl", "-lsocket" ]
else []
},
@@ -257,7 +269,11 @@ package_details installing =
then []
else [ cFPTOOLS_TOP_ABS ++ "/hslibs/util/cbits" ],
c_includes = [ "HsUtil.h" ],
- package_deps = [ "lang", "concurrent", "posix" ],
+ package_deps = [ "lang", "concurrent"
+#ifndef mingw32_TARGET_OS
+ , "posix"
+#endif
+ ],
extra_ghc_opts = [],
extra_cc_opts = [],
extra_ld_opts = []
@@ -322,12 +338,3 @@ package_details installing =
ghc_src_dir :: String -> String
ghc_src_dir path = cFPTOOLS_TOP_ABS ++ '/':cCURRENT_DIR ++ '/':path
-
-prefixMatch :: Eq a => [a] -> [a] -> Bool
-prefixMatch [] _str = True
-prefixMatch _pat [] = False
-prefixMatch (p:ps) (s:ss) | p == s = prefixMatch ps ss
- | otherwise = False
-
-postfixMatch :: String -> String -> Bool
-postfixMatch pat str = prefixMatch (reverse pat) (reverse str)
diff --git a/ghc/driver/Utils.hs b/ghc/driver/Utils.hs
new file mode 100644
index 0000000000000000000000000000000000000000..c176130649ae0e2d79edf7dd28e410c3b36f2054
--- /dev/null
+++ b/ghc/driver/Utils.hs
@@ -0,0 +1,10 @@
+module Utils where
+
+prefixMatch :: Eq a => [a] -> [a] -> Bool
+prefixMatch [] _str = True
+prefixMatch _pat [] = False
+prefixMatch (p:ps) (s:ss) | p == s = prefixMatch ps ss
+ | otherwise = False
+
+suffixMatch :: String -> String -> Bool
+suffixMatch pat str = prefixMatch (reverse pat) (reverse str)
diff --git a/ghc/driver/mangler/ghc-asm.lprl b/ghc/driver/mangler/ghc-asm.lprl
index 605b6c2ad438064bb3640db29eff980ed9cb7f55..8e03615158a79246e3ea01dcf68b98bd6a2a8584 100644
--- a/ghc/driver/mangler/ghc-asm.lprl
+++ b/ghc/driver/mangler/ghc-asm.lprl
@@ -13,6 +13,18 @@ stuff to do with the C stack.
Any other required tidying up.
\end{itemize}
+General note [chak]: Many regexps are very fragile because they rely on white
+space being in the right place. This caused trouble with gcc 2.95 (at least
+on Linux), where the use of white space in .s files generated by gcc suddenly
+changed. To guarantee compatibility across different versions of gcc, make
+sure (at least on i386-.*-linux) that regexps tolerate varying amounts of white
+space between an assembler statement and its arguments as well as after a the
+comma separating multiple arguments.
+
+\emph{For the time being, I have corrected the regexps for i386-.*-linux. I
+didn't touch all the regexps for other i386 platforms, as I don't have
+a box to test these changes.}
+
HPPA specific notes:
\begin{itemize}
\item
@@ -167,9 +179,9 @@ sub init_TARGET_STUFF {
$T_POST_LBL = ':';
$T_X86_PRE_LLBL_PAT = '\.L';
$T_X86_PRE_LLBL = '.L';
- $T_X86_BADJMP = '^\tjmp [^\.\*]';
+ $T_X86_BADJMP = '^\tjmp\s+[^\.\*]';
- $T_MOVE_DIRVS = '^(\s*(\.(p2)?align\s+\d+(,0x90)?|\.globl\s+\S+|\.text|\.data|\.section\s+.*|\.type\s+.*|\.Lfe.*\n\t\.size\s+.*|\.size\s+.*|\.ident.*)\n)';
+ $T_MOVE_DIRVS = '^(\s*(\.(p2)?align\s+\d+(,\s*0x90)?|\.globl\s+\S+|\.text|\.data|\.section\s+.*|\.type\s+.*|\.Lfe.*\n\s*\.size\s+.*|\.size\s+.*|\.ident.*)\n)';
$T_COPY_DIRVS = '\.(globl)';
if ( $TargetPlatform =~ /freebsd|netbsd_elf/ ) {
@@ -382,15 +394,6 @@ sub mangle_asm {
&init_TARGET_STUFF();
&init_FUNNY_THINGS();
- # perl4 on alphas SEGVs when give ${foo} substitutions in patterns.
- # To avoid them we declare some locals that allows to avoid using curlies.
- local($TUS) = ${T_US};
- local($TPOSTLBL) = ${T_POST_LBL};
- local($TMOVEDIRVS) = ${T_MOVE_DIRVS};
- local($TPREAPP) = ${T_PRE_APP};
- local($TCOPYDIRVS) = ${T_COPY_DIRVS};
- local($TDOTWORD) = ${T_DOT_WORD};
-
open(INASM, "< $in_asmf")
|| &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
open(OUTASM,"> $out_asmf")
@@ -414,10 +417,10 @@ sub mangle_asm {
$i = 0; $chkcat[0] = 'misc'; $chk[0] = '';
while (<INASM>) {
- next if $T_STABBY && /^\.stab.*$TUS[@]?__stg_split_marker/o;
+ next if $T_STABBY && /^\.stab.*${T_US}__stg_split_marker/o;
next if $T_STABBY && /^\.stab.*ghc.*c_ID/;
next if /^\t\.def.*endef$/;
- next if /$TPREAPP(NO_)?APP/o;
+ next if /${T_PRE_APP}(NO_)?APP/o;
next if /^;/ && $TargetPlatform =~ /^hppa/;
next if /(^$|^\t\.file\t|^ # )/ && $TargetPlatform =~ /^(mips|powerpc|rs6000)-/;
@@ -457,12 +460,12 @@ sub mangle_asm {
$chkcat[$i] = 'literal';
$chksymb[$i] = $1;
- } elsif ( /^$TUS[@]?__stg_split_marker(\d*)$TPOSTLBL[@]?$/o ) {
+ } elsif ( /^${T_US}__stg_split_marker(\d*)${T_POST_LBL}$/o ) {
$chk[++$i] = $_;
$chkcat[$i] = 'splitmarker';
$chksymb[$i] = $1;
- } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_info$TPOSTLBL[@]?$/o ) {
+ } elsif ( /^${T_US}([A-Za-z0-9_]+)_info${T_POST_LBL}$/o ) {
$symb = $1;
$chk[++$i] = $_;
$chkcat[$i] = 'infotbl';
@@ -472,50 +475,50 @@ sub mangle_asm {
$infochk{$symb} = $i;
- } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_(entry|ret)$TPOSTLBL[@]?$/o ) {
+ } elsif ( /^${T_US}([A-Za-z0-9_]+)_(entry|ret)${T_POST_LBL}$/o ) {
$chk[++$i] = $_;
$chkcat[$i] = 'slow';
$chksymb[$i] = $1;
$slowchk{$1} = $i;
- } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_fast\d*$TPOSTLBL[@]?$/o ) {
+ } elsif ( /^${T_US}([A-Za-z0-9_]+)_fast\d*${T_POST_LBL}$/o ) {
$chk[++$i] = $_;
$chkcat[$i] = 'fast';
$chksymb[$i] = $1;
$fastchk{$1} = $i;
- } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_closure$TPOSTLBL[@]?$/o ) {
+ } elsif ( /^${T_US}([A-Za-z0-9_]+)_closure${T_POST_LBL}$/o ) {
$chk[++$i] = $_;
$chkcat[$i] = 'closure';
$chksymb[$i] = $1;
$closurechk{$1} = $i;
- } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_srt$TPOSTLBL[@]?$/o ) {
+ } elsif ( /^${T_US}([A-Za-z0-9_]+)_srt${T_POST_LBL}$/o ) {
$chk[++$i] = $_;
$chkcat[$i] = 'srt';
$chksymb[$i] = $1;
$srtchk{$1} = $i;
- } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_ct$TPOSTLBL[@]?$/o ) {
+ } elsif ( /^${T_US}([A-Za-z0-9_]+)_ct${T_POST_LBL}$/o ) {
$chk[++$i] = $_;
$chkcat[$i] = 'data';
$chksymb[$i] = '';
- } elsif ( /^$TUS[@]?ghc.*c_ID$TPOSTLBL/o ) {
+ } elsif ( /^${T_US}ghc.*c_ID${T_POST_LBL}/o ) {
$chk[++$i] = $_;
$chkcat[$i] = 'consist';
- } elsif ( /^($TUS[@]?__gnu_compiled_c|gcc2_compiled\.)$TPOSTLBL/o ) {
+ } elsif ( /^(${T_US}__gnu_compiled_c|gcc2_compiled\.)${T_POST_LBL}/o ) {
; # toss it
- } elsif ( /^$TUS[A-Za-z0-9_]+\.\d+$TPOSTLBL[@]?$/o
- || /^$TUS[@]?.*_CAT$TPOSTLBL[@]?$/o # PROF: _entryname_CAT
- || /^$TUS[@]?.*_done$TPOSTLBL[@]?$/o # PROF: _module_done
- || /^$TUS[@]?_module_registered$TPOSTLBL[@]?$/o # PROF: _module_registered
+ } elsif ( /^${T_US}[A-Za-z0-9_]+\.\d+${T_POST_LBL}$/o
+ || /^${T_US}.*_CAT${T_POST_LBL}$/o # PROF: _entryname_CAT
+ || /^${T_US}.*_done${T_POST_LBL}$/o # PROF: _module_done
+ || /^${T_US}_module_registered${T_POST_LBL}$/o # PROF: _module_registered
) {
$chk[++$i] = $_;
$chkcat[$i] = 'data';
@@ -531,20 +534,20 @@ sub mangle_asm {
$chkcat[$i] = 'toc';
$chksymb[$i] = $1;
- } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_cc(s)?$TPOSTLBL[@]?$/o ) {
+ } elsif ( /^${T_US}([A-Za-z0-9_]+)_cc(s)?${T_POST_LBL}$/o ) {
# all CC_ symbols go in the data section...
$chk[++$i] = $_;
$chkcat[$i] = 'data';
$chksymb[$i] = '';
- } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_(alt|dflt)$TPOSTLBL[@]?$/o ) {
+ } elsif ( /^${T_US}([A-Za-z0-9_]+)_(alt|dflt)${T_POST_LBL}$/o ) {
$chk[++$i] = $_;
$chkcat[$i] = 'misc';
$chksymb[$i] = '';
#$symbtmp = $1;
#$chksymb[$i] = $symbtmp if ($TargetPlatform =~ /^powerpc-|^rs6000-/) ; #rm andre
- } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_vtbl$TPOSTLBL[@]?$/o ) {
+ } elsif ( /^${T_US}([A-Za-z0-9_]+)_vtbl${T_POST_LBL}$/o ) {
$chk[++$i] = $_;
$chkcat[$i] = 'vector';
$chksymb[$i] = $1;
@@ -575,7 +578,7 @@ sub mangle_asm {
$chkcat[$i] = 'toss';
$chksymb[$i] = $1;
- } elsif ( /^$TUS[@]?[A-Za-z0-9_]/o
+ } elsif ( /^${T_US}[A-Za-z0-9_]/o
&& ( $TargetPlatform !~ /^hppa/ # need to avoid local labels in this case
|| ! /^L\$\d+$/ )
&& ( $TargetPlatform !~ /^powerpc|^rs6000/ # ditto
@@ -584,11 +587,11 @@ sub mangle_asm {
chop($thing = $_);
print "Funny global thing?: $_"
unless $KNOWN_FUNNY_THING{$thing}
- || /^$TUS[@]?stg_.*$TPOSTLBL[@]?$/o # RTS internals
- || /^$TUS[@]__fexp_.*$TPOSTLBL$/o # foreign export
- || /^$TUS[@]?__init.*$TPOSTLBL$/o # __init<module>
- || /^$TUS[@]?.*_btm$TPOSTLBL$/o # large bitmaps
- || /^$TUS[@]?.*_closure_tbl$TPOSTLBL$/o; # closure tables
+ || /^${T_US}stg_.*${T_POST_LBL}$/o # RTS internals
+ || /^${T_US}__fexp_.*${T_POST_LBL}$/o # foreign export
+ || /^${T_US}__init.*${T_POST_LBL}$/o # __init<module>
+ || /^${T_US}.*_btm${T_POST_LBL}$/o # large bitmaps
+ || /^${T_US}.*_closure_tbl${T_POST_LBL}$/o; # closure tables
$chk[++$i] = $_;
$chkcat[$i] = 'misc';
if ($TargetPlatform =~ /^powerpc-|^rs6000-/)
@@ -668,11 +671,11 @@ sub mangle_asm {
if (($p, $r) = split(/--- BEGIN ---/, $c)) {
if ($TargetPlatform =~ /^i386-/) {
- $p =~ s/^\tpushl \%edi\n//;
- $p =~ s/^\tpushl \%esi\n//;
- $p =~ s/^\tpushl \%ebx\n//;
- $p =~ s/^\tsubl \$\d+,\%esp\n//;
- $p =~ s/^\tmovl \$\d+,\%eax\n\tcall __alloca\n// if ($TargetPlatform =~ /^.*-cygwin32/);
+ $p =~ s/^\tpushl\s+\%edi\n//;
+ $p =~ s/^\tpushl\s+\%esi\n//;
+ $p =~ s/^\tpushl\s+\%ebx\n//;
+ $p =~ s/^\tsubl\s+\$\d+,\s*\%esp\n//;
+ $p =~ s/^\tmovl\s+\$\d+,\s*\%eax\n\tcall\s+__alloca\n// if ($TargetPlatform =~ /^.*-cygwin32/);
} elsif ($TargetPlatform =~ /^m68k-/) {
$p =~ s/^\tlink a6,#-?\d.*\n//;
$p =~ s/^\tpea a6@\n\tmovel sp,a6\n//;
@@ -731,12 +734,12 @@ sub mangle_asm {
if (($r, $e) = split(/--- END ---/, $c)) {
if ($TargetPlatform =~ /^i386-/) {
$e =~ s/^\tret\n//;
- $e =~ s/^\tpopl \%edi\n//;
- $e =~ s/^\tpopl \%esi\n//;
- $e =~ s/^\tpopl \%edx\n//;
- $e =~ s/^\tpopl \%ecx\n//;
- $e =~ s/^\taddl \$\d+,\%esp\n//;
- $e =~ s/^\tsubl \$-\d+,\%esp\n//;
+ $e =~ s/^\tpopl\s+\%edi\n//;
+ $e =~ s/^\tpopl\s+\%esi\n//;
+ $e =~ s/^\tpopl\s+\%edx\n//;
+ $e =~ s/^\tpopl\s+\%ecx\n//;
+ $e =~ s/^\taddl\s+\$\d+,\s*\%esp\n//;
+ $e =~ s/^\tsubl\s+\$-\d+,\s*\%esp\n//;
} elsif ($TargetPlatform =~ /^m68k-/) {
$e =~ s/^\tunlk a6\n//;
$e =~ s/^\trts\n//;
@@ -757,8 +760,15 @@ sub mangle_asm {
# HWL HACK: dont die, just print a warning
#print stderr "HWL: this should die! Epilogue junk?: $e\n" if $e =~ /^\t[^\.]/
# && $TargetPlatform !~ /^powerpc-/; #ToDo: remove test
- die "Epilogue junk?: $e\n" if $e =~ /^\t[^\.\n]/
- && $TargetPlatform !~ /^powerpc-/; #ToDo: remove test
+
+ # ** FIXME:
+ # ** chak:
+ # Commented this out, because it complains about junk that
+ # is later removed in the FUNNY#END#THING loop - but as I am
+ # not sure how this could ever have worked, there may be a
+ # better solution...
+ #die "Epilogue junk?: $e\n" if $e =~ /^\t[^\.\n]/
+ # && $TargetPlatform !~ /^powerpc-/; #ToDo: remove test
# glue together what's left
$c = $r . $e;
@@ -778,7 +788,7 @@ sub mangle_asm {
# On Alphas, the prologue mangling is done a little later (below)
# toss all calls to __DISCARD__
- $c =~ s/^\t(call|jbsr|jal)\s+$TUS[@]?__DISCARD__\n//go;
+ $c =~ s/^\t(call|jbsr|jal)\s+${T_US}__DISCARD__\n//go;
# MIPS: that may leave some gratuitous asm macros around
# (no harm done; but we get rid of them to be tidier)
@@ -801,8 +811,7 @@ sub mangle_asm {
# pin a funny end-thing on (for easier matching):
$c .= 'FUNNY#END#THING';
- while ( $c =~ /$TMOVEDIRVS[@]?FUNNY#END#THING/o ) { # [@]? is a silly hack to avoid having to use curlies for T_PRE_APP
- # (this SEGVs perl4 on alphas, you see)
+ while ( $c =~ /${T_MOVE_DIRVS}FUNNY#END#THING/o ) {
$to_move = $1;
@@ -816,7 +825,7 @@ sub mangle_asm {
# blah_closure:
# ...
#
- if ( $TargetPlatform =~ /^(i386|sparc)/ && $to_move =~ /$TCOPYDIRVS/ ) {
+ if ( $TargetPlatform =~ /^(i386|sparc)/ && $to_move =~ /${T_COPY_DIRVS}/ ) {
$j = $i + 1;
while ( $j < $numchks && $chk[$j] =~ /$T_CONST_LBL/) {
$j++;
@@ -827,13 +836,13 @@ sub mangle_asm {
}
elsif ( $i < ($numchks - 1)
- && ( $to_move =~ /$TCOPYDIRVS/
+ && ( $to_move =~ /${T_COPY_DIRVS}/
|| ($TargetPlatform =~ /^hppa/ && $to_move =~ /align/ && $chkcat[$i+1] eq 'literal') )) {
$chk[$i + 1] = $to_move . $chk[$i + 1];
# otherwise they're tossed
}
- $c =~ s/$TMOVEDIRVS[@]?FUNNY#END#THING/FUNNY#END#THING/o; # [@]? is a hack (see above)
+ $c =~ s/${T_MOVE_DIRVS}FUNNY#END#THING/FUNNY#END#THING/o;
}
if ( $TargetPlatform =~ /^alpha-/ && $c =~ /^\t\.ent\s+(\S+)/ ) {
@@ -970,7 +979,7 @@ sub mangle_asm {
#
# -- 2/98 SOF
if ( $TargetPlatform =~ /^hppa/ ) {
- $chk[$i] =~ s/^$TUS[@]?ghc.*c_ID$TPOSTLBL/$consist/o;
+ $chk[$i] =~ s/^${T_US}ghc.*c_ID$TPOSTLBL/$consist/o;
$chk[$i] =~ s/\t$T_hsc_cc_PAT/$T_HDR_misc/o;
$consist = $chk[$i]; #clumsily
}
@@ -1058,12 +1067,12 @@ sub mangle_asm {
} elsif ( $TargetPlatform =~ /^i386-/ ) {
# Reg alloc depending, gcc generated code may jump to the fast entry point via
# a number of registers.
- $c =~ s/^\tmovl \$${T_US}${symb}_fast\d*,\%edx\n\tjmp \*\%edx\n//;
- $c =~ s/^\tmovl \$${T_US}${symb}_fast\d*,\%ecx\n\tjmp \*\%ecx\n//;
- $c =~ s/^\tmovl \$${T_US}${symb}_fast\d*,\%eax\n\tjmp \*\%eax\n//;
+ $c =~ s/^\tmovl\s+\$${T_US}${symb}_fast\d*,\s*\%edx\n\tjmp\s+\*\%edx\n//;
+ $c =~ s/^\tmovl\s+\$${T_US}${symb}_fast\d*,\s*\%ecx\n\tjmp\s+\*\%ecx\n//;
+ $c =~ s/^\tmovl\s+\$${T_US}${symb}_fast\d*,\s*\%eax\n\tjmp\s+\*\%eax\n//;
# The next two only apply if we're not stealing %esi or %edi.
- $c =~ s/^\tmovl \$${T_US}${symb}_fast\d*,\%esi\n\tjmp \*\%esi\n// if ($StolenX86Regs < 3);
- $c =~ s/^\tmovl \$${T_US}${symb}_fast\d*,\%edi\n\tjmp \*\%edi\n// if ($StolenX86Regs < 4);
+ $c =~ s/^\tmovl\s+\$${T_US}${symb}_fast\d*,\s*\%esi\n\tjmp\s+\*\%esi\n// if ($StolenX86Regs < 3);
+ $c =~ s/^\tmovl\s+\$${T_US}${symb}_fast\d*,\s*\%edi\n\tjmp\s+\*\%edi\n// if ($StolenX86Regs < 4);
} elsif ( $TargetPlatform =~ /^mips-/ ) {
$c =~ s/^\tjmp \$31,\(\$27\),0\n\t\.align 4\n\t\.end/\t.align 4\n\t.end/;
} elsif ( $TargetPlatform =~ /^m68k-/ ) {
@@ -1084,7 +1093,7 @@ sub mangle_asm {
# references to fast-entry point.
# (questionable re hppa and mips...)
print STDERR "still has jump to fast entry point:\n$c"
- if $c =~ /$TUS[@]?$symb[@]?_fast/; # NB: paranoia
+ if $c =~ /${T_US}${symb}_fast/;
}
print OUTASM $T_HDR_entry;
@@ -1256,26 +1265,22 @@ sub print_doctored {
# jmp *<bad-reg>
#
-# the short form may tickle perl bug:
-# s/^\tmovl \$${T_US}(.*),(\%e[abcd]x)\n\tjmp \*$2/\tjmp $T_US$1/g;
- s/^\tmovl \$${T_US}(.*),\%eax\n\tjmp \*\%eax/\tjmp $T_US$1/g;
- s/^\tmovl \$${T_US}(.*),\%ebx\n\tjmp \*\%ebx/\tjmp $T_US$1/g;
- s/^\tmovl \$${T_US}(.*),\%ecx\n\tjmp \*\%ecx/\tjmp $T_US$1/g;
- s/^\tmovl \$${T_US}(.*),\%edx\n\tjmp \*\%edx/\tjmp $T_US$1/g;
+# Because of Perl bug, needed separate cases for eax, ebx, ecx, edx in the past
+ s/^\tmovl \$${T_US}(.*),(\%e[abcd]x)\n\tjmp \*$2/\tjmp $T_US$1/g;
if ($StolenX86Regs <= 2 ) { # YURGH! spurious uses of esi?
- s/^\tmovl (.*),\%esi\n\tjmp \*%esi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
- s/^\tjmp \*(-?\d*)\((.*\%esi.*)\)\n/\tmovl $2,\%eax\n\tjmp \*$1\(\%eax\)\n/g;
- s/^\tjmp \*\%esi\n/\tmovl \%esi,\%eax\n\tjmp \*\%eax\n/g;
+ s/^\tmovl\s+(.*),\s*\%esi\n\tjmp\s+\*%esi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
+ s/^\tjmp\s+\*(-?\d*)\((.*\%esi.*)\)\n/\tmovl $2,\%eax\n\tjmp \*$1\(\%eax\)\n/g;
+ s/^\tjmp\s+\*\%esi\n/\tmovl \%esi,\%eax\n\tjmp \*\%eax\n/g;
die "$Pgm: (mangler) still have jump involving \%esi!\n$_"
- if /(jmp|call) .*\%esi/;
+ if /(jmp|call)\s+.*\%esi/;
}
if ($StolenX86Regs <= 3 ) { # spurious uses of edi?
- s/^\tmovl (.*),\%edi\n\tjmp \*%edi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
- s/^\tjmp \*(-?\d*\(.*\%edi.*\))\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
- s/^\tjmp \*\%edi\n/\tmovl \%edi,\%eax\n\tjmp \*\%eax\n/g;
+ s/^\tmovl\s+(.*),\s*\%edi\n\tjmp\s+\*%edi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
+ s/^\tjmp\s+\*(-?\d*\(.*\%edi.*\))\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
+ s/^\tjmp\s+\*\%edi\n/\tmovl \%edi,\%eax\n\tjmp \*\%eax\n/g;
die "$Pgm: (mangler) still have jump involving \%edi!\n$_"
- if /(jmp|call) .*\%edi/;
+ if /(jmp|call)\s+.*\%edi/;
}
# OK, now we can decide what our patch-up code is going to
@@ -1312,20 +1317,20 @@ sub print_doctored {
# fix _all_ non-local jumps:
- s/^\tjmp \*${T_X86_PRE_LLBL_PAT}/\tJMP___SL/go;
- s/^\tjmp ${T_X86_PRE_LLBL_PAT}/\tJMP___L/go;
+ s/^\tjmp\s+\*${T_X86_PRE_LLBL_PAT}/\tJMP___SL/go;
+ s/^\tjmp\s+${T_X86_PRE_LLBL_PAT}/\tJMP___L/go;
- s/^(\tjmp .*\n)/$exit_patch$1/g; # here's the fix...
+ s/^(\tjmp\s+.*\n)/$exit_patch$1/g; # here's the fix...
s/^\tJMP___SL/\tjmp \*${T_X86_PRE_LLBL}/go;
s/^\tJMP___L/\tjmp ${T_X86_PRE_LLBL}/go;
if ($StolenX86Regs == 2 ) {
die "ARGH! Jump uses \%esi or \%edi with -monly-2-regs:\n$_"
- if /^\t(jmp|call) .*\%e(si|di)/;
+ if /^\t(jmp|call)\s+.*\%e(si|di)/;
} elsif ($StolenX86Regs == 3 ) {
die "ARGH! Jump uses \%edi with -monly-3-regs:\n$_"
- if /^\t(jmp|call) .*\%edi/;
+ if /^\t(jmp|call)\s+.*\%edi/;
}
# --------------------------------------------------------
@@ -1369,29 +1374,23 @@ sub rev_tbl {
local(@lines) = split(/\n/, $tbl);
local($i, $j); #local ($i, $extra, $words_to_pad, $j);
- # see comment in mangleAsm as to why this silliness is needed.
- local($TDOTWORD) = ${T_DOT_WORD};
- local($TDOTGLOBAL) = ${T_DOT_GLOBAL};
- local($TUS) = ${T_US};
- local($TPOSTLBL) = ${T_POST_LBL};
-
# Deal with the header...
- for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\t?$TDOTWORD\s+/o; $i++) {
+ for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\t?${T_DOT_WORD}\s+/o; $i++) {
$label .= $lines[$i] . "\n",
- next if $lines[$i] =~ /^[A-Za-z0-9_]+_info$TPOSTLBL[@]?$/o
- || $lines[$i] =~ /$TDOTGLOBAL/o
- || $lines[$i] =~ /^$TUS[@]?\S+_vtbl$TPOSTLBL[@]?$/o;
+ next if $lines[$i] =~ /^[A-Za-z0-9_]+_info${T_POST_LBL}$/o
+ || $lines[$i] =~ /${T_DOT_GLOBAL}/o
+ || $lines[$i] =~ /^${T_US}\S+_vtbl${T_POST_LBL}$/o;
$before .= $lines[$i] . "\n"; # otherwise...
}
# Grab the table data...
if ( $TargetPlatform !~ /^hppa/ ) {
- for ( ; $i <= $#lines && $lines[$i] =~ /^\t?$TDOTWORD\s+/o; $i++) {
+ for ( ; $i <= $#lines && $lines[$i] =~ /^\t?${T_DOT_WORD}\s+/o; $i++) {
push(@words, $lines[$i]);
}
} else { # hppa weirdness
- for ( ; $i <= $#lines && $lines[$i] =~ /^\s+($TDOTWORD|\.IMPORT)/; $i++) {
+ for ( ; $i <= $#lines && $lines[$i] =~ /^\s+(${T_DOT_WORD}|\.IMPORT)/; $i++) {
if ($lines[$i] =~ /^\s+\.IMPORT/) {
push(@imports, $lines[$i]);
} else {
@@ -1407,7 +1406,7 @@ sub rev_tbl {
# The .zero business is for Linux/ELF.
# The .skip business is for Sparc/Solaris/ELF.
# The .blockz business is for HPPA.
- if ($discard1 && $words[0] =~ /^\t?($TDOTWORD\s+0|\.zero\s+4|\.skip\s+4|\.blockz\s+4)/) {
+ if ($discard1 && $words[0] =~ /^\t?(${T_DOT_WORD}\s+0|\.zero\s+4|\.skip\s+4|\.blockz\s+4)/) {
shift(@words)
}
diff --git a/ghc/includes/ClosureMacros.h b/ghc/includes/ClosureMacros.h
index 852e978a221cfee3055025e44c6c8f72a739ff41..e4bddab2361d4cf021e9647119d8d2117a4a029d 100644
--- a/ghc/includes/ClosureMacros.h
+++ b/ghc/includes/ClosureMacros.h
@@ -1,5 +1,5 @@
/* ----------------------------------------------------------------------------
- * $Id: ClosureMacros.h,v 1.26 2000/10/06 15:38:06 simonmar Exp $
+ * $Id: ClosureMacros.h,v 1.27 2000/11/07 10:42:56 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
@@ -10,6 +10,16 @@
#ifndef CLOSUREMACROS_H
#define CLOSUREMACROS_H
+/* Say whether the code comes before the heap; on mingwin this may not be the
+ case, not because of another random MS pathology, but because the static
+ program may reside in a DLL
+*/
+
+#undef TEXT_BEFORE_HEAP
+#ifndef mingw32_TARGET_OS
+#define TEXT_BEFORE_HEAP 1
+#endif
+
/* -----------------------------------------------------------------------------
Fixed Header Size
@@ -116,11 +126,11 @@ extern void* DATA_SECTION_END_MARKER_DECL;
#endif
-#ifdef ENABLE_WIN32_DLL_SUPPORT /* needed for mingw DietHEP */
- extern int is_heap_alloced(const void* x);
-# define HEAP_ALLOCED(x) (is_heap_alloced(x))
+#ifdef TEXT_BEFORE_HEAP
+# define HEAP_ALLOCED(x) IS_USER_PTR(x)
#else
-# define HEAP_ALLOCED(x) IS_USER_PTR(x)
+extern int is_heap_alloced(const void* x);
+# define HEAP_ALLOCED(x) (is_heap_alloced(x))
#endif
/* When working with Win32 DLLs, static closures are identified by
@@ -182,11 +192,11 @@ extern void* DATA_SECTION_END_MARKER_DECL;
# define IS_HUGS_CONSTR_INFO(info) 0 /* ToDo: more than mildly bogus */
#endif
-#ifdef ENABLE_WIN32_DLL_SUPPORT /* needed for mingw DietHEP */
+#ifdef TEXT_BEFORE_HEAP /* needed for mingw DietHEP */
+# define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(info)
+#else
# define LOOKS_LIKE_GHC_INFO(info) (!HEAP_ALLOCED(info) \
&& !LOOKS_LIKE_STATIC_CLOSURE(info))
-#else
-# define LOOKS_LIKE_GHC_INFO(info) IS_CODE_PTR(info)
#endif
/* -----------------------------------------------------------------------------
diff --git a/ghc/includes/PrimOps.h b/ghc/includes/PrimOps.h
index b76ba60378acb82708de3621dffe9b79044086c4..8c2b03e7c3fe84b4868edc8d0fa6b1738d5f6e8d 100644
--- a/ghc/includes/PrimOps.h
+++ b/ghc/includes/PrimOps.h
@@ -1,5 +1,5 @@
/* -----------------------------------------------------------------------------
- * $Id: PrimOps.h,v 1.64 2000/10/12 15:49:34 simonmar Exp $
+ * $Id: PrimOps.h,v 1.65 2000/11/07 10:42:56 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
@@ -436,6 +436,12 @@ EXTFUN_RTS(word2Integerzh_fast);
EXTFUN_RTS(decodeFloatzh_fast);
EXTFUN_RTS(decodeDoublezh_fast);
+/* Bit operations */
+EXTFUN_RTS(andIntegerzh_fast);
+EXTFUN_RTS(orIntegerzh_fast);
+EXTFUN_RTS(xorIntegerzh_fast);
+EXTFUN_RTS(complementIntegerzh_fast);
+
/* -----------------------------------------------------------------------------
Word64 PrimOps.
-------------------------------------------------------------------------- */
diff --git a/ghc/includes/StgDLL.h b/ghc/includes/StgDLL.h
index 9a0730a3c9353895bc3d148f46a39fc9fc0c4cb8..ededcc96b585ecb68123240bbea70b9749630948 100644
--- a/ghc/includes/StgDLL.h
+++ b/ghc/includes/StgDLL.h
@@ -28,12 +28,10 @@
#ifdef COMPILING_RTS
#define DLL_IMPORT DLLIMPORT
#define DLL_IMPORT_RTS
-#define DLL_IMPORT_DATA
#define DLL_IMPORT_DATA_VAR(x) x
#else
#define DLL_IMPORT
#define DLL_IMPORT_RTS DLLIMPORT
-#define DLL_IMPORT_DATA DLLIMPORT
# ifdef ENABLE_WIN32_DLL_SUPPORT
# define DLL_IMPORT_DATA_VAR(x) _imp__##x
# else
diff --git a/ghc/includes/StgMacros.h b/ghc/includes/StgMacros.h
index df6c82cc037fc5dbc07304bde758c3375f4972d4..a8b3faab8021a1fce21c268fa38e875c729d4ddc 100644
--- a/ghc/includes/StgMacros.h
+++ b/ghc/includes/StgMacros.h
@@ -1,5 +1,5 @@
/* -----------------------------------------------------------------------------
- * $Id: StgMacros.h,v 1.34 2000/08/15 14:22:24 simonmar Exp $
+ * $Id: StgMacros.h,v 1.35 2000/11/07 10:42:56 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
@@ -617,7 +617,7 @@ static inline StgInt64 PK_Int64(W_ p_src[])
Catch frames
-------------------------------------------------------------------------- */
-extern DLL_IMPORT_DATA const StgPolyInfoTable catch_frame_info;
+extern DLL_IMPORT_RTS const StgPolyInfoTable catch_frame_info;
/* -----------------------------------------------------------------------------
Seq frames
@@ -626,7 +626,7 @@ extern DLL_IMPORT_DATA const StgPolyInfoTable catch_frame_info;
an update...
-------------------------------------------------------------------------- */
-extern DLL_IMPORT_DATA const StgPolyInfoTable seq_frame_info;
+extern DLL_IMPORT_RTS const StgPolyInfoTable seq_frame_info;
#define PUSH_SEQ_FRAME(sp) \
{ \
@@ -643,7 +643,11 @@ extern DLL_IMPORT_DATA const StgPolyInfoTable seq_frame_info;
-------------------------------------------------------------------------- */
#if defined(USE_SPLIT_MARKERS)
+#if defined(cygwin32_TARGET_OS) || defined(mingw32_TARGET_OS)
+#define __STG_SPLIT_MARKER __asm__("\n___stg_split_marker:");
+#else
#define __STG_SPLIT_MARKER __asm__("\n__stg_split_marker:");
+#endif
#else
#define __STG_SPLIT_MARKER /* nothing */
#endif
diff --git a/ghc/includes/StgMiscClosures.h b/ghc/includes/StgMiscClosures.h
index f6070e37eea2a0759fd898bbbb25e2b086ed5412..1161d162150d7ef4f3a72c96ec463b12fe879314 100644
--- a/ghc/includes/StgMiscClosures.h
+++ b/ghc/includes/StgMiscClosures.h
@@ -1,5 +1,5 @@
/* -----------------------------------------------------------------------------
- * $Id: StgMiscClosures.h,v 1.20 2000/10/12 15:50:14 simonmar Exp $
+ * $Id: StgMiscClosures.h,v 1.21 2000/11/07 10:42:56 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
@@ -128,14 +128,14 @@ extern const vec_info_8 ret_bco_info;
/* closures */
-extern DLL_IMPORT_DATA StgClosure END_TSO_QUEUE_closure;
-extern DLL_IMPORT_DATA StgClosure END_MUT_LIST_closure;
-extern DLL_IMPORT_DATA StgClosure NO_FINALIZER_closure;
-extern DLL_IMPORT_DATA StgClosure dummy_ret_closure;
-extern DLL_IMPORT_DATA StgClosure forceIO_closure;
+extern DLL_IMPORT_RTS StgClosure END_TSO_QUEUE_closure;
+extern DLL_IMPORT_RTS StgClosure END_MUT_LIST_closure;
+extern DLL_IMPORT_RTS StgClosure NO_FINALIZER_closure;
+extern DLL_IMPORT_RTS StgClosure dummy_ret_closure;
+extern DLL_IMPORT_RTS StgClosure forceIO_closure;
-extern DLL_IMPORT_DATA StgIntCharlikeClosure CHARLIKE_closure[];
-extern DLL_IMPORT_DATA StgIntCharlikeClosure INTLIKE_closure[];
+extern DLL_IMPORT_RTS StgIntCharlikeClosure CHARLIKE_closure[];
+extern DLL_IMPORT_RTS StgIntCharlikeClosure INTLIKE_closure[];
/* standard entry points */
diff --git a/ghc/includes/TailCalls.h b/ghc/includes/TailCalls.h
index f0fd6a6503c05d075c35106b9cd44fb56dc2c4c1..fd0152ea20aa90c639d0218d4e029ddda0c5259b 100644
--- a/ghc/includes/TailCalls.h
+++ b/ghc/includes/TailCalls.h
@@ -1,5 +1,5 @@
/* -----------------------------------------------------------------------------
- * $Id: TailCalls.h,v 1.5 2000/04/05 14:26:31 panne Exp $
+ * $Id: TailCalls.h,v 1.6 2000/11/07 10:42:56 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
@@ -35,6 +35,13 @@ extern void __DISCARD__(void);
stack that GCC hasn't popped yet. Also possibly to fool any
optimisations (a function call often acts as a barrier). Not sure
if any of this is necessary now -- SDM
+
+ Comment to above note: I don't think the __DISCARD__() in JMP_ is
+ necessary. Arguments should be popped from the C stack immediately
+ after returning from a function, as long as we pass -fno-defer-pop
+ to gcc. Moreover, a goto to a first-class label acts as a barrier
+ for optimisations in the same way a function call does.
+ -= chak
*/
/* The goto here seems to cause gcc -O2 to delete all the code after
@@ -110,8 +117,17 @@ register void *_procedure __asm__("$27");
function and these markers is shredded by the mangler.
-------------------------------------------------------------------------- */
+/* The following __DISCARD__() has become necessary with gcc 2.96 on x86.
+ * It prevents gcc from moving stack manipulation code from the function
+ * body (aka the Real Code) into the function prologue, ie, from moving it
+ * over the --- BEGIN --- marker. It should be noted that (like some
+ * other black magic in GHC's code), there is no essential reason why gcc
+ * could not move some stack manipulation code across the __DISCARD__() -
+ * it just doesn't choose to do it at the moment.
+ * -= chak
+ */
#ifndef FB_
-#define FB_ __asm__ volatile ("--- BEGIN ---");
+#define FB_ __asm__ volatile ("--- BEGIN ---"); __DISCARD__ ();
#endif
#ifndef FE_
diff --git a/ghc/includes/Updates.h b/ghc/includes/Updates.h
index 07bd9de8863c65d15349e946b4086801cd85970c..3c7633a7d136299db18aa6c2b23d4b64b2a92ee1 100644
--- a/ghc/includes/Updates.h
+++ b/ghc/includes/Updates.h
@@ -1,5 +1,5 @@
/* -----------------------------------------------------------------------------
- * $Id: Updates.h,v 1.18 2000/05/15 14:38:11 simonmar Exp $
+ * $Id: Updates.h,v 1.19 2000/11/07 10:42:56 simonmar Exp $
*
* (c) The GHC Team, 1998-1999
*
@@ -172,7 +172,7 @@ extern void awakenBlockedQueue(StgTSO *q);
#define PUSH_STD_CCCS(frame)
#endif
-extern DLL_IMPORT_DATA const StgPolyInfoTable upd_frame_info;
+extern DLL_IMPORT_RTS const StgPolyInfoTable upd_frame_info;
#define PUSH_UPD_FRAME(target, Sp_offset) \
{ \
@@ -234,14 +234,14 @@ extern void newCAF_made_by_Hugs(StgCAF*);
DLL_IMPORT_RTS extern STGFUN(upd_frame_entry);
-extern DLL_IMPORT_DATA const StgInfoTable PAP_info;
+extern DLL_IMPORT_RTS const StgInfoTable PAP_info;
DLL_IMPORT_RTS STGFUN(PAP_entry);
EXTFUN_RTS(stg_update_PAP);
-extern DLL_IMPORT_DATA const StgInfoTable AP_UPD_info;
+extern DLL_IMPORT_RTS const StgInfoTable AP_UPD_info;
DLL_IMPORT_RTS STGFUN(AP_UPD_entry);
-extern DLL_IMPORT_DATA const StgInfoTable raise_info;
+extern DLL_IMPORT_RTS const StgInfoTable raise_info;
#endif /* UPDATES_H */
diff --git a/ghc/lib/std/Makefile b/ghc/lib/std/Makefile
index cce4638149585844cc6e89b6ddc11bddd6ff2bd5..0ae5a89a394ae74f0017cbe86df286cc70b2aac7 100644
--- a/ghc/lib/std/Makefile
+++ b/ghc/lib/std/Makefile
@@ -25,15 +25,15 @@ endif
HC = $(GHC_INPLACE)
MKDEPENDHS = $(GHC_INPLACE)
-ifneq "$(way)" "dll"
+ifneq "$(DLLized)" "YES"
PACKAGE = -package-name std
else
# Hack by SPJ to delay if-then-else until the pattern rule when we have $*
PACKAGE = $(subst ~, ,$(word $(words dummy $(findstring $(notdir $*), PrelMain )), -package-name~std))
endif
-LIBRARY = libHSstd$(_way).a
-LIBOBJS = $(HS_OBJS)
+HSLIB = std
+
ifeq "$(TARGETPLATFORM)" "i386-unknown-mingw32"
LIBOBJS = $(filter-out PrelHugs.$(way_)o,$(HS_OBJS))
endif
@@ -42,7 +42,7 @@ endif
# Setting the GHC compile options
SRC_HC_OPTS += -recomp -cpp -fglasgow-exts-no-lang -fvia-C -Rghc-timing $(GhcLibHcOpts) $(PACKAGE)
-ifneq "$(way)" "dll"
+ifneq "$(DLLized)" "YES"
SRC_HC_OPTS += -static
endif
@@ -87,21 +87,16 @@ PrelGHC.$(way_)hi : PrelGHC.hi-boot
boot :: PrelGHC.hi $(foreach way, $(WAYS), PrelGHC.$(way)_hi)
-DLL_NAME = HSstd.dll
DLL_DESCRIPTION="GHC-compiled Haskell Prelude"
-DLL_IMPLIB_NAME = libHSstd_imp.a
-SRC_BLD_DLL_OPTS += --export-all --output-def=HSstd.def DllVersionInfo.o
-SRC_BLD_DLL_OPTS += -lwinmm -lHSrts_imp -lHSstd_cbits_imp -lgmp_imp -L. -L../../rts/gmp -L../../rts -Lcbits
-ifeq "$(way)" "dll"
+ifeq "$(DLLized)" "YES"
HS_SRCS := $(filter-out PrelMain.lhs PrelHugs.lhs, $(HS_SRCS))
endif
# PrelMain.dll_o isn't to be included in the final .a,
# but it needs to be generated
-ifeq "$(way)" "dll"
-all :: PrelMain.dll_o DllVersionInfo.o
-
+ifeq "$(DLLized)" "YES"
+all :: PrelMain.dll_o
endif
CLEAN_FILES += PrelGHC.hi $(foreach way, $(WAYS), PrelGHC.$(way)_hi)
@@ -133,17 +128,12 @@ override datadir:=$(libdir)/imports/std
#
# Files to install from here
#
-INSTALL_LIBS += $(LIBRARY)
-ifeq "$(way)" "dll"
-INSTALL_PROGS += $(DLL_NAME)
+ifeq "$(DLLized)" "YES"
INSTALL_LIBS += PrelMain.dll_o
-else
-ifeq "$(EnableWin32Dlls)" "YES"
-$(patsubst %.a,%_imp.a, $(LIBRARY))
endif
-endif
-INSTALL_DATAS += $(HS_IFACES) PrelGHC.$(way_)hi
-ifeq "$(way)" "dll"
+
+INSTALL_DATAS += PrelGHC.$(way_)hi
+ifeq "$(DLLized)" "YES"
INSTALL_DATAS := $(filter-out PrelHugs.$(way_)hi,$(INSTALL_DATAS))
endif
diff --git a/ghc/lib/std/PrelAddr.lhs b/ghc/lib/std/PrelAddr.lhs
index 48258eb1bcf70ffe21965c88ec4eccc7acf14ffa..4ce5bf3a25faf5194ec901ad0a8433c224c7d2aa 100644
--- a/ghc/lib/std/PrelAddr.lhs
+++ b/ghc/lib/std/PrelAddr.lhs
@@ -1,5 +1,5 @@
% -----------------------------------------------------------------------------
-% $Id: PrelAddr.lhs,v 1.17 2000/06/30 13:39:35 simonmar Exp $
+% $Id: PrelAddr.lhs,v 1.18 2000/11/07 10:42:56 simonmar Exp $
%
% (c) The University of Glasgow, 1994-2000
%
@@ -11,11 +11,10 @@
module PrelAddr (
Addr(..)
- , AddrOff(..)
, nullAddr -- :: Addr
- , alignAddr -- :: Addr -> Int -> Addr
- , plusAddr -- :: Addr -> AddrOff -> Addr
- , minusAddr -- :: Addr -> Addr -> AddrOff
+ , alignAddr -- :: Addr -> Int -> Addr
+ , plusAddr -- :: Addr -> Int -> Addr
+ , minusAddr -- :: Addr -> Addr -> Int
, indexAddrOffAddr -- :: Addr -> Int -> Addr
@@ -37,8 +36,6 @@ infixl 5 `plusAddr`, `minusAddr`
data Addr = A# Addr# deriving (Eq, Ord)
data Word = W# Word# deriving (Eq, Ord)
-newtype AddrOff = AddrOff# Int
-
nullAddr :: Addr
nullAddr = A# (int2Addr# 0#)
@@ -49,11 +46,11 @@ alignAddr addr@(A# a) (I# i)
0# -> addr;
n -> A# (int2Addr# (ai +# (i -# n))) }}
-plusAddr :: Addr -> AddrOff -> Addr
-plusAddr (A# addr) (AddrOff# (I# off)) = A# (int2Addr# (addr2Int# addr +# off))
+plusAddr :: Addr -> Int -> Addr
+plusAddr (A# addr) (I# off) = A# (int2Addr# (addr2Int# addr +# off))
-minusAddr :: Addr -> Addr -> AddrOff
-minusAddr (A# a1) (A# a2) = AddrOff# (I# (addr2Int# a1 -# addr2Int# a2))
+minusAddr :: Addr -> Addr -> Int
+minusAddr (A# a1) (A# a2) = I# (addr2Int# a1 -# addr2Int# a2)
instance CCallable Addr
instance CReturnable Addr
diff --git a/ghc/lib/std/PrelGHC.hi-boot b/ghc/lib/std/PrelGHC.hi-boot
index 13f4aac59754bb32195895e454225a9c2d3d17d1..52c6148047e392a702c741a59b6dd2f3fdbbeb00 100644
--- a/ghc/lib/std/PrelGHC.hi-boot
+++ b/ghc/lib/std/PrelGHC.hi-boot
@@ -205,7 +205,11 @@ __export PrelGHC
integerToWord64zh
int64ToIntegerzh
word64ToIntegerzh
-
+ andIntegerzh
+ orIntegerzh
+ xorIntegerzh
+ complementIntegerzh
+
Arrayzh
ByteArrayzh
MutableArrayzh
diff --git a/ghc/lib/std/PrelHandle.lhs b/ghc/lib/std/PrelHandle.lhs
index a548426d7a1f137d8102df3f95d3a56ac5b33d8c..01b7182b235ca1f617a0e58cb13bb6cd22c5449c 100644
--- a/ghc/lib/std/PrelHandle.lhs
+++ b/ghc/lib/std/PrelHandle.lhs
@@ -1,5 +1,5 @@
% ------------------------------------------------------------------------------
-% $Id: PrelHandle.lhs,v 1.62 2000/09/14 14:24:02 simonmar Exp $
+% $Id: PrelHandle.lhs,v 1.63 2000/11/07 10:42:56 simonmar Exp $
%
% (c) The AQUA Project, Glasgow University, 1994-2000
%
@@ -62,7 +62,7 @@ mkBuffer__ fo sz_in_bytes = do
case sz_in_bytes of
0 -> return nullAddr -- this has the effect of overwriting the pointer to the old buffer.
_ -> do
- chunk <- allocMemory__ sz_in_bytes
+ chunk <- malloc sz_in_bytes
if chunk == nullAddr
then ioException (IOError Nothing ResourceExhausted "mkBuffer__" "not enough virtual memory")
else return chunk
@@ -162,15 +162,6 @@ mkClosedHandle__ =
haFilePath__ = "closed file",
haBuffers__ = []
}
-
-mkErrorHandle__ :: IOException -> Handle__
-mkErrorHandle__ ioe =
- Handle__ { haFO__ = nullFile__,
- haType__ = (ErrorHandle ioe),
- haBufferMode__ = NoBuffering,
- haFilePath__ = "error handle",
- haBuffers__ = []
- }
\end{code}
%*********************************************************
@@ -251,8 +242,7 @@ stdout = unsafePerformIO (do
#endif
return hdl
- _ -> do ioError <- constructError "stdout"
- newHandle (mkErrorHandle__ ioError)
+ _ -> constructErrorAndFail "stdout"
)
stdin = unsafePerformIO (do
@@ -277,8 +267,7 @@ stdin = unsafePerformIO (do
#endif
hConnectTerms stdout hdl
return hdl
- _ -> do ioError <- constructError "stdin"
- newHandle (mkErrorHandle__ ioError)
+ _ -> constructErrorAndFail "stdin"
)
@@ -303,8 +292,7 @@ stderr = unsafePerformIO (do
hConnectTo stdout hdl
return hdl
- _ -> do ioError <- constructError "stderr"
- newHandle (mkErrorHandle__ ioError)
+ _ -> constructErrorAndFail "stderr"
)
\end{code}
@@ -395,7 +383,6 @@ hClose :: Handle -> IO ()
hClose handle =
withHandle__ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> return handle_
_ -> do
rc <- closeFile (haFO__ handle_)
@@ -439,7 +426,6 @@ hFileSize :: Handle -> IO Integer
hFileSize handle =
withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> ioe_closedHandle "hFileSize" handle
SemiClosedHandle -> ioe_closedHandle "hFileSize" handle
#ifdef __HUGS__
@@ -539,7 +525,6 @@ hSetBuffering handle mode =
_ ->
withHandle__ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> ioe_closedHandle "hSetBuffering" handle
_ -> do
{- Note:
@@ -713,7 +698,6 @@ hIsOpen :: Handle -> IO Bool
hIsOpen handle =
withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> return False
SemiClosedHandle -> return False
_ -> return True
@@ -722,7 +706,6 @@ hIsClosed :: Handle -> IO Bool
hIsClosed handle =
withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> return True
_ -> return False
@@ -740,7 +723,6 @@ hIsReadable :: Handle -> IO Bool
hIsReadable handle =
withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> ioe_closedHandle "hIsReadable" handle
SemiClosedHandle -> ioe_closedHandle "hIsReadable" handle
htype -> return (isReadable htype)
@@ -753,7 +735,6 @@ hIsWritable :: Handle -> IO Bool
hIsWritable handle =
withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> ioe_closedHandle "hIsWritable" handle
SemiClosedHandle -> ioe_closedHandle "hIsWritable" handle
htype -> return (isWritable htype)
@@ -785,7 +766,6 @@ hGetBuffering :: Handle -> IO BufferMode
hGetBuffering handle =
withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> ioe_closedHandle "hGetBuffering" handle
_ ->
{-
@@ -800,7 +780,6 @@ hIsSeekable :: Handle -> IO Bool
hIsSeekable handle =
withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> ioe_closedHandle "hIsSeekable" handle
SemiClosedHandle -> ioe_closedHandle "hIsSeekable" handle
AppendHandle -> return False
@@ -831,7 +810,6 @@ hSetEcho handle on = do
else
withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> ioe_closedHandle "hSetEcho" handle
_ -> do
rc <- setTerminalEcho (haFO__ handle_) (if on then 1 else 0) -- ConcHask: SAFE, won't block
@@ -847,7 +825,6 @@ hGetEcho handle = do
else
withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> ioe_closedHandle "hGetEcho" handle
_ -> do
rc <- getTerminalEcho (haFO__ handle_) -- ConcHask: SAFE, won't block
@@ -860,7 +837,6 @@ hIsTerminalDevice :: Handle -> IO Bool
hIsTerminalDevice handle = do
withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> ioe_closedHandle "hIsTerminalDevice" handle
_ -> do
rc <- isTerminalDevice (haFO__ handle_) -- ConcHask: SAFE, won't block
@@ -914,7 +890,7 @@ slurpFile fname = do
ioError (userError "slurpFile: file too big")
else do
let sz_i = fromInteger sz
- chunk <- allocMemory__ sz_i
+ chunk <- malloc sz_i
if chunk == nullAddr
then do
hClose handle
@@ -939,7 +915,6 @@ getHandleFd :: Handle -> IO Int
getHandleFd handle =
withHandle_ handle $ \ handle_ -> do
case (haType__ handle_) of
- ErrorHandle theError -> ioException theError
ClosedHandle -> ioe_closedHandle "getHandleFd" handle
_ -> do
fd <- getFileFd (haFO__ handle_)
@@ -1038,7 +1013,6 @@ wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
wantReadableHandle fun handle act =
withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> ioe_closedHandle fun handle
SemiClosedHandle -> ioe_closedHandle fun handle
AppendHandle -> ioException not_readable_error
@@ -1061,7 +1035,6 @@ wantWriteableHandle_ fun handle act =
checkWriteableHandle fun handle handle_ act
= case haType__ handle_ of
- ErrorHandle theError -> ioError (IOException theError)
ClosedHandle -> ioe_closedHandle fun handle
SemiClosedHandle -> ioe_closedHandle fun handle
ReadHandle -> ioError not_writeable_error
@@ -1075,7 +1048,6 @@ wantRWHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
wantRWHandle fun handle act =
withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> ioe_closedHandle fun handle
SemiClosedHandle -> ioe_closedHandle fun handle
_ -> act handle_
@@ -1084,7 +1056,6 @@ wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
wantSeekableHandle fun handle act =
withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> ioe_closedHandle fun handle
SemiClosedHandle -> ioe_closedHandle fun handle
_ -> act handle_
diff --git a/ghc/lib/std/PrelHugs.lhs b/ghc/lib/std/PrelHugs.lhs
index 183fa20ddee0b623a9c4ceb37ac2c13449c1273d..95ffb8a147511906a959fc6744eede20ac532d75 100644
--- a/ghc/lib/std/PrelHugs.lhs
+++ b/ghc/lib/std/PrelHugs.lhs
@@ -1,5 +1,5 @@
% ------------------------------------------------------------------------------
-% $Id: PrelHugs.lhs,v 1.13 2000/06/30 13:39:35 simonmar Exp $
+% $Id: PrelHugs.lhs,v 1.14 2000/11/07 10:42:56 simonmar Exp $
%
% (c) The University of Glasgow, 2000
%
@@ -41,7 +41,7 @@ import PrelRead(Read,ReadS,lex,reads)
import PrelFloat(Double)
import PrelReal(Fractional,fromRational,toRational)
import PrelAddr(Addr(..),nullAddr)
-import PrelStable(StablePtr,makeStablePtr)
+import PrelStable(StablePtr,newStablePtr)
import PrelErr(error)
import PrelPack(unpackCString)
import List(length)
@@ -87,7 +87,7 @@ foreign import "malloc" unsafe malloc
:: Int -> IO Addr
hugsprimCreateAdjThunk :: (a -> b) -> String -> Char -> IO Addr
hugsprimCreateAdjThunk fun typestr callconv
- = do sp <- makeStablePtr fun
+ = do sp <- newStablePtr fun
p <- copy_String_to_cstring typestr -- is never freed
a <- hugsCreateAdjThunk sp p callconv
return a
diff --git a/ghc/lib/std/PrelIO.lhs b/ghc/lib/std/PrelIO.lhs
index e93410ffd133e9523f4a890ae374d9ef31e07162..70f52c855f38c922e45e2a145a167fb91173ac44 100644
--- a/ghc/lib/std/PrelIO.lhs
+++ b/ghc/lib/std/PrelIO.lhs
@@ -1,5 +1,5 @@
% ------------------------------------------------------------------------------
-% $Id: PrelIO.lhs,v 1.15 2000/07/25 15:20:10 simonmar Exp $
+% $Id: PrelIO.lhs,v 1.16 2000/11/07 10:42:56 simonmar Exp $
%
% (c) The University of Glasgow, 1992-2000
%
@@ -26,7 +26,7 @@ import PrelNum
import PrelRead ( Read(..), readIO )
import PrelShow
import PrelMaybe ( Maybe(..) )
-import PrelAddr ( Addr(..), AddrOff(..), nullAddr, plusAddr )
+import PrelAddr ( Addr(..), nullAddr, plusAddr )
import PrelList ( concat, reverse, null )
import PrelPack ( unpackNBytesST, unpackNBytesAccST )
import PrelException ( ioError, catch, catchException, throw )
@@ -229,7 +229,6 @@ hGetContents handle =
-- the handle.
withHandle handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> ioException theError
ClosedHandle -> ioe_closedHandle "hGetContents" handle
SemiClosedHandle -> ioe_closedHandle "hGetContents" handle
AppendHandle -> ioException not_readable_error
@@ -379,7 +378,7 @@ getBuffer handle_ = do
case mode of
NoBuffering -> return (handle_, (mode, nullAddr, 0))
_ -> case bufs of
- [] -> do buf <- allocMemory__ sz
+ [] -> do buf <- malloc sz
return (handle_, (mode, buf, sz))
(b:bs) -> return (handle_{ haBuffers__ = bs }, (mode, b, sz))
@@ -481,7 +480,7 @@ commitAndReleaseBuffer hdl@(Handle h) buf sz count flush = do
-- not flushing, and there's enough room in the buffer:
-- just copy the data in and update bufWPtr.
- else do memcpy (plusAddr fo_buf (AddrOff# fo_wptr)) buf count
+ else do memcpy (plusAddr fo_buf fo_wptr) buf count
setBufWPtr fo (fo_wptr + count)
handle_ <- freeBuffer handle_ buf sz
ok handle_
@@ -535,7 +534,7 @@ commitBuffer handle buf sz count flush = do
if (rc < 0) then constructErrorAndFail "commitBuffer"
else return ()
- else do memcpy (plusAddr fo_buf (AddrOff# new_wptr)) buf count
+ else do memcpy (plusAddr fo_buf new_wptr) buf count
setBufWPtr fo (new_wptr + count)
return ()
diff --git a/ghc/lib/std/PrelIOBase.lhs b/ghc/lib/std/PrelIOBase.lhs
index 6b48b1f9106eca3ebb2e2db96d9bc7f1f367e013..be14cef708a8c22172c6956940574a12a628b111 100644
--- a/ghc/lib/std/PrelIOBase.lhs
+++ b/ghc/lib/std/PrelIOBase.lhs
@@ -1,5 +1,5 @@
% ------------------------------------------------------------------------------
-% $Id: PrelIOBase.lhs,v 1.28 2000/09/25 12:58:39 simonpj Exp $
+% $Id: PrelIOBase.lhs,v 1.29 2000/11/07 10:42:56 simonmar Exp $
%
% (c) The University of Glasgow, 1994-2000
%
@@ -23,7 +23,7 @@ import PrelST
import PrelBase
import PrelNum ( fromInteger ) -- Integer literals
import PrelMaybe ( Maybe(..) )
-import PrelAddr ( Addr(..) )
+import PrelAddr ( Addr(..), nullAddr )
import PrelShow
import PrelList
import PrelDynamic
@@ -223,8 +223,7 @@ data Handle__
of the following:
-}
data Handle__Type
- = ErrorHandle IOException
- | ClosedHandle
+ = ClosedHandle
| SemiClosedHandle
| ReadHandle
| WriteHandle
@@ -251,7 +250,6 @@ type FilePath = String
instance Show Handle__Type where
showsPrec p t =
case t of
- ErrorHandle iot -> showString "error " . showsPrec p iot
ClosedHandle -> showString "closed"
SemiClosedHandle -> showString "semi-closed"
ReadHandle -> showString "readable"
@@ -287,7 +285,6 @@ instance Show Handle where
showHdl ht cont =
case ht of
ClosedHandle -> showsPrec p ht . showString "}\n"
- ErrorHandle _ -> showsPrec p ht . showString "}\n"
_ -> cont
showBufMode :: FILE_OBJECT -> BufferMode -> ShowS
@@ -360,9 +357,16 @@ Foreign import declarations to helper routines:
foreign import "libHS_cbits" "getErrStr__" unsafe getErrStr__ :: IO Addr
foreign import "libHS_cbits" "getErrNo__" unsafe getErrNo__ :: IO Int
foreign import "libHS_cbits" "getErrType__" unsafe getErrType__ :: IO Int
+
+malloc :: Int -> IO Addr
+malloc sz = do
+ a <- _malloc sz
+ if (a == nullAddr)
+ then ioException (IOError Nothing ResourceExhausted "malloc" "")
+ else return a
+
+foreign import "malloc" unsafe _malloc :: Int -> IO Addr
-foreign import "libHS_cbits" "allocMemory__" unsafe
- allocMemory__ :: Int -> IO Addr
foreign import "libHS_cbits" "getBufSize" unsafe
getBufSize :: FILE_OBJECT -> IO Int
foreign import "libHS_cbits" "setBuf" unsafe
diff --git a/ghc/lib/std/PrelStable.lhs b/ghc/lib/std/PrelStable.lhs
index a0de32b3404e7d61e7e6d6b7d5b149f357a31131..dfa87a0fdb3b87f85d61349b1a23df2958aa167f 100644
--- a/ghc/lib/std/PrelStable.lhs
+++ b/ghc/lib/std/PrelStable.lhs
@@ -1,5 +1,5 @@
% -----------------------------------------------------------------------------
-% $Id: PrelStable.lhs,v 1.7 2000/06/30 13:39:36 simonmar Exp $
+% $Id: PrelStable.lhs,v 1.8 2000/11/07 10:42:57 simonmar Exp $
%
% (c) The GHC Team, 1992-2000
%
@@ -11,7 +11,7 @@
module PrelStable
( StablePtr(..)
- , makeStablePtr -- :: a -> IO (StablePtr a)
+ , newStablePtr -- :: a -> IO (StablePtr a)
, deRefStablePtr -- :: StablePtr a -> a
, freeStablePtr -- :: StablePtr a -> IO ()
) where
@@ -27,11 +27,11 @@ data StablePtr a = StablePtr (StablePtr# a)
instance CCallable (StablePtr a)
instance CReturnable (StablePtr a)
-makeStablePtr :: a -> IO (StablePtr a)
+newStablePtr :: a -> IO (StablePtr a)
deRefStablePtr :: StablePtr a -> IO a
-foreign import "freeStablePtr" unsafe freeStablePtr :: StablePtr a -> IO ()
+foreign import unsafe freeStablePtr :: StablePtr a -> IO ()
-makeStablePtr a = IO $ \ s ->
+newStablePtr a = IO $ \ s ->
case makeStablePtr# a s of (# s', sp #) -> (# s', StablePtr sp #)
deRefStablePtr (StablePtr sp) = IO $ \s -> deRefStablePtr# sp s
diff --git a/ghc/lib/std/cbits/Makefile b/ghc/lib/std/cbits/Makefile
index 4e4303332f400b8c3146cdb75dc81f8cff861933..16ec304e34c0b14c30451fe756d29372d8e06e0c 100644
--- a/ghc/lib/std/cbits/Makefile
+++ b/ghc/lib/std/cbits/Makefile
@@ -1,41 +1,22 @@
-# $Id: Makefile,v 1.23 2000/08/07 16:09:03 rrt Exp $
+# $Id: Makefile,v 1.24 2000/11/07 10:42:57 simonmar Exp $
TOP = ../../..
include $(TOP)/mk/boilerplate.mk
-WAYS=$(GhcLibWays)
-
-ifeq "$(filter dll,$(WAYS))" "dll"
-override WAYS=dll
-else
override WAYS=
-endif
-LIBRARY=libHSstd_cbits$(_way).a
+HSLIB = std
+IS_CBITS_LIB = YES
C_SRCS= $(wildcard *.c)
C_OBJS = $(C_SRCS:.c=.$(way_)o)
LIBOBJS = $(C_OBJS)
-SRC_CC_OPTS += -O -I$(GHC_INCLUDE_DIR) -I$(GHC_RUNTIME_DIR) $(GhcLibCcOpts) -Wall
-
-ifneq "$(way)" "dll"
+SRC_CC_OPTS += -O $(GhcLibCcOpts) -Wall -optc-DCOMPILING_STDLIB
+ifneq "$(DLLized)" "YES"
SRC_CC_OPTS += -static
endif
-ifeq "$(way)" "dll"
-all :: DllVersionInfo.o
-
-$(DLL_NAME) : DllVersionInfo.o
-endif
-
-DLL_NAME = HSstd_cbits.dll
-DLL_IMPLIB_NAME = libHSstd_cbits_imp.a
-DLL_DESCRIPTION = "Haskell Prelude helpers"
-SRC_BLD_DLL_OPTS += --export-all --output-def=HSstdcbits.def DllVersionInfo.o
-SRC_BLD_DLL_OPTS += -lwinmm -lwsock32 -lHSrts_imp -lgmp -L. -L../../../rts/gmp -L../../../rts
-SRC_CC_OPTS += -optc-DCOMPILING_STDLIB
-
#
# Compile the files using the Haskell compiler (ghc really).
#
@@ -44,15 +25,6 @@ CC=$(GHC_INPLACE)
# -----------------------------------------------------------------------------
# Installation
-INSTALL_LIBS+=$(LIBRARY)
-
-ifeq "$(EnableWin32DLLs)" "YES"
-INSTALL_PROGS += $(DLL_NAME)
-ifneq "$(way)" "dll"
-INSTALL_LIBS += $(patsubst %.a, %_imp.a, $(LIBRARY))
-endif
-endif
-
override datadir:=$(libdir)/includes
INSTALL_DATAS += HsStd.h stgio.h stgerror.h fileObject.h
diff --git a/ghc/lib/std/cbits/allocMem.c b/ghc/lib/std/cbits/allocMem.c
deleted file mode 100644
index 609e8828e952ee37a72f4141c321edbcb4a47b5b..0000000000000000000000000000000000000000
--- a/ghc/lib/std/cbits/allocMem.c
+++ /dev/null
@@ -1,24 +0,0 @@
-/*
- * (c) The GRASP/AQUA Project, Glasgow University, 1994-1998
- *
- * $Id: allocMem.c,v 1.3 1999/11/25 16:54:14 simonmar Exp $
- *
- * malloc interface
- */
-
-#include "Rts.h"
-#include "stgio.h"
-
-StgAddr
-allocMemory__(StgInt sz/* bytes */)
-{
- StgAddr ptr;
-
- if ( (ptr = malloc(sz*sizeof(char))) == NULL) {
- ghc_errtype = ERR_RESOURCEEXHAUSTED;
- ghc_errstr = "malloc failed";
- return NULL;
- }
- return ptr;
-
-}
diff --git a/ghc/lib/std/cbits/stgio.h b/ghc/lib/std/cbits/stgio.h
index 35a09fd8b792aa87e6cc4b30aadff048960ee0b2..fd5ad0d9f629618bf63b90e81b856eaa31ea0c9a 100644
--- a/ghc/lib/std/cbits/stgio.h
+++ b/ghc/lib/std/cbits/stgio.h
@@ -1,5 +1,5 @@
/* -----------------------------------------------------------------------------
- * $Id: stgio.h,v 1.23 2000/08/24 10:27:01 simonmar Exp $
+ * $Id: stgio.h,v 1.24 2000/11/07 10:42:57 simonmar Exp $
*
* (c) The GRASP/AQUA Project, Glasgow University, 1994-1999
*
@@ -10,6 +10,8 @@
#ifndef STGIO_H
#define STGIO_H
+#include "StgDLL.h" /* for DLL_IMPORT_STDLIB */
+
#include "stgerror.h"
#include "fileObject.h"
@@ -57,9 +59,9 @@ int _setenv (char *);
int delenv (char *);
/* errno.c */
-extern int ghc_errno;
-extern int ghc_errtype;
-extern char* ghc_errstr;
+DLL_IMPORT_STDLIB extern int ghc_errno;
+DLL_IMPORT_STDLIB extern int ghc_errtype;
+DLL_IMPORT_STDLIB extern char* ghc_errstr;
void cvtErrno(void);
void stdErrno(void);
diff --git a/ghc/rts/Makefile b/ghc/rts/Makefile
index 4ff8d8cdd054ed9e9323029eecf79bb92588b75c..b92318923a969608b31622aa830b32aa25d4e426 100644
--- a/ghc/rts/Makefile
+++ b/ghc/rts/Makefile
@@ -1,5 +1,5 @@
#-----------------------------------------------------------------------------
-# $Id: Makefile,v 1.38 2000/11/01 11:41:47 simonmar Exp $
+# $Id: Makefile,v 1.39 2000/11/07 10:42:57 simonmar Exp $
#
# This is the Makefile for the runtime-system stuff.
# This stuff is written in C (and cannot be written in Haskell).
@@ -26,7 +26,7 @@ SRCS_RTS_C = $(wildcard *.c) $(wildcard hooks/*.c) $(filter-out parallel/SysMan
SRCS_RTS_S = $(wildcard *.S)
SRCS_RTS_HC = $(wildcard *.hc) $(wildcard parallel/*.hc)
-ifneq "$(way)" "dll"
+ifneq "$(DLLized)" "YES"
SRCS_RTS_C := $(filter-out RtsDllMain.c, $(SRCS_RTS_C))
else
SRCS_RTS_C := $(filter-out Main.c, $(SRCS_RTS_C))
@@ -35,7 +35,6 @@ endif
#-----------------------------------------------------------------------------
# creating and installing libHSrts.a (in its many flavors)
#
-LIBRARY = libHSrts$(_way).a
LIBOBJS = $(patsubst %.c,%.$(way_)o,$(SRCS_RTS_C)) \
$(patsubst %.hc,%.$(way_)o,$(SRCS_RTS_HC)) \
$(patsubst %.S,%.$(way_)o,$(SRCS_RTS_S))
@@ -63,7 +62,7 @@ WARNING_OPTS += -optc-Wbad-function-cast
SRC_HC_OPTS += -I../includes -I. -Iparallel $(WARNING_OPTS) $(GhcRtsHcOpts) -optc-DCOMPILING_RTS
SRC_CC_OPTS = $(GhcRtsCcOpts)
-ifneq "$(way)" "dll"
+ifneq "$(DLLized)" "YES"
SRC_HC_OPTS += -static
endif
# SRC_HC_OPTS += -optc-fPIC
@@ -112,15 +111,15 @@ unexport CC
# -----------------------------------------------------------------------------
#
# Building DLLs is only supported on mingw32 at the moment.
-#
-DLL_NAME = HSrts.dll
-ifeq "$(way)" "dll"
-DLL_IMPLIB_NAME = libHSrts_imp.a
+#
+HSLIB = rts
-SRC_BLD_DLL_OPTS += --output-def=HSrts.def --export-all -L. -Lgmp -lwinmm \
- -lHS_imp_stub -lgmp_imp
+ifeq "$(DLLized)" "YES"
+SRC_BLD_DLL_OPTS += -lHS_imp_stub -lgmp_imp
+
+# It's not included in the DLL, but we need to compile it up separately.
+all :: Main.dll_o
-#
# Need an import library containing the symbols the RTS uses from the Prelude.
# So, to avoid bootstrapping trouble, we build one containing just the syms
# we need. Weirdly named to avoid clashing later on when compiling the contents
@@ -129,14 +128,11 @@ SRC_BLD_DLL_OPTS += --output-def=HSrts.def --export-all -L. -Lgmp -lwinmm \
# Note: if you do change the name of the Prelude DLL, the "--dllname <nm>.dll"
# below will need to be updated as well.
-$(DLL_PEN)/$(DLL_NAME) :: libHS_imp_stub.a
+$(DLL_PEN)/HSrts$(_way).dll :: libHS_imp_stub.a
libHS_imp_stub.a :
dlltool --output-lib libHS_imp_stub.a --def HSprel.def --dllname HSstd.dll
-# It's not included in the DLL, but we need to compile it up separately.
-all :: Main.dll_o
-
endif
# -----------------------------------------------------------------------------
@@ -153,7 +149,7 @@ boot ::
all :: gmp/libgmp.a
-ifeq "$(way)" "dll"
+ifeq "$(DLLized)" "YES"
all :: $(DLL_PEN)/gmp.dll
$(DLL_PEN)/gmp.dll:
@@ -204,13 +200,10 @@ endif
# Just libHSrts is installed uniformly across ways
#
INSTALL_LIBS += $(LIBRARY)
-ifeq "$(EnableWin32DLLs)" "YES"
+ifeq "$(DLLized)" "YES"
INSTALL_PROGS += $(DLL_NAME) gmp/gmp.dll
-ifneq "$(way)" "dll"
-INSTALL_LIBS += $(patsubst %.a, %_imp.a, $(LIBARY))
-endif
+INSTALL_LIBS += $(patsubst %.a,%_imp.a,$(LIBARY))
INSTALL_LIBS += gmp/libgmp_imp.a Main.dll_o
endif
include $(TOP)/mk/target.mk
-
diff --git a/ghc/rts/PrimOps.hc b/ghc/rts/PrimOps.hc
index f5c45f30848e6319cc03ae337ad0b9d8efec87ff..b571db3819ccafc1c0ce16f8dd17a9134cff66c0 100644
--- a/ghc/rts/PrimOps.hc
+++ b/ghc/rts/PrimOps.hc
@@ -1,5 +1,5 @@
/* -----------------------------------------------------------------------------
- * $Id: PrimOps.hc,v 1.55 2000/09/26 16:45:35 simonpj Exp $
+ * $Id: PrimOps.hc,v 1.56 2000/11/07 10:42:57 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
@@ -649,6 +649,35 @@ FN_(name) \
FE_ \
}
+#define GMP_TAKE1_RET1(name,mp_fun) \
+FN_(name) \
+{ \
+ MP_INT arg1, result; \
+ I_ s1; \
+ StgArrWords* d1; \
+ FB_ \
+ \
+ /* call doYouWantToGC() */ \
+ MAYBE_GC(R2_PTR, name); \
+ \
+ d1 = (StgArrWords *)R2.p; \
+ s1 = R1.i; \
+ \
+ arg1._mp_alloc = d1->words; \
+ arg1._mp_size = (s1); \
+ arg1._mp_d = (unsigned long int *) (BYTE_ARR_CTS(d1)); \
+ \
+ STGCALL1(mpz_init,&result); \
+ \
+ /* Perform the operation */ \
+ STGCALL2(mp_fun,&result,&arg1); \
+ \
+ TICK_RET_UNBOXED_TUP(2); \
+ RET_NP(result._mp_size, \
+ result._mp_d-sizeofW(StgArrWords)); \
+ FE_ \
+}
+
#define GMP_TAKE2_RET2(name,mp_fun) \
FN_(name) \
{ \
@@ -694,6 +723,10 @@ GMP_TAKE2_RET1(gcdIntegerzh_fast, mpz_gcd);
GMP_TAKE2_RET1(quotIntegerzh_fast, mpz_tdiv_q);
GMP_TAKE2_RET1(remIntegerzh_fast, mpz_tdiv_r);
GMP_TAKE2_RET1(divExactIntegerzh_fast, mpz_divexact);
+GMP_TAKE2_RET1(andIntegerzh_fast, mpz_and);
+GMP_TAKE2_RET1(orIntegerzh_fast, mpz_ior);
+GMP_TAKE2_RET1(xorIntegerzh_fast, mpz_xor);
+GMP_TAKE1_RET1(complementIntegerzh_fast, mpz_com);
GMP_TAKE2_RET2(quotRemIntegerzh_fast, mpz_tdiv_qr);
GMP_TAKE2_RET2(divModIntegerzh_fast, mpz_fdiv_qr);
diff --git a/ghc/rts/Schedule.c b/ghc/rts/Schedule.c
index 79996c38d5f59231a6341c31ac74aa98f1a81909..89d9799262a23f8541fbdbe228c8193502c6274d 100644
--- a/ghc/rts/Schedule.c
+++ b/ghc/rts/Schedule.c
@@ -1,5 +1,5 @@
/* ---------------------------------------------------------------------------
- * $Id: Schedule.c,v 1.79 2000/10/10 09:12:19 simonmar Exp $
+ * $Id: Schedule.c,v 1.80 2000/11/07 10:42:57 simonmar Exp $
*
* (c) The GHC Team, 1998-2000
*
@@ -214,6 +214,12 @@ Capability MainRegTable; /* for non-SMP, we have one global capability */
StgTSO *CurrentTSO;
#endif
+/* This is used in `TSO.h' and gcc 2.96 insists that this variable actually
+ * exists - earlier gccs apparently didn't.
+ * -= chak
+ */
+StgTSO dummy_tso;
+
rtsBool ready_to_gc;
/* All our current task ids, saved in case we need to kill them later.
diff --git a/ghc/tests/numeric/should_run/arith011.hs b/ghc/tests/numeric/should_run/arith011.hs
index e469c0c48b09ab76b0c6b011d07a7868a8df01b1..1e53f8f51445bf267a98a7f706cea02fb36e6e38 100644
--- a/ghc/tests/numeric/should_run/arith011.hs
+++ b/ghc/tests/numeric/should_run/arith011.hs
@@ -17,6 +17,7 @@ test = do
testIntlike "Word8" (0::Word8)
testIntlike "Word16" (0::Word16)
testIntlike "Word32" (0::Word32)
+ testInteger
testIntlikeNoBits :: (Bounded a, Integral a, Ix a, Read a) => String -> a -> IO ()
testIntlikeNoBits name zero = do
@@ -32,11 +33,24 @@ testIntlikeNoBits name zero = do
testReal zero
testIntegral zero
+testInteger = do
+ let zero = 0 :: Integer
+ putStrLn $ "--------------------------------"
+ putStrLn $ "--Testing Integer
+ putStrLn $ "--------------------------------"
+ testEnum zero
+ testReadShow zero
+ testEq zero
+ testOrd zero
+ testNum zero
+ testReal zero
+ testIntegral zero
+ testBits zero False
testIntlike :: (Bounded a, Integral a, Ix a, Read a, Bits a) => String -> a -> IO ()
testIntlike name zero = do
testIntlikeNoBits name zero
- testBits zero
+ testBits zero True
-- In all these tests, zero is a dummy element used to get
@@ -125,7 +139,7 @@ testIntegral zero = do
where
(xs,ys) = samples zero
-testBits zero = do
+testBits zero do_bitsize = do
putStrLn "testBits"
table2 ".&. " (.&.) xs ys
table2 ".|. " (.|.) xs ys
@@ -139,7 +153,7 @@ testBits zero = do
table2 "`clearBit`" clearBit xs ([0..3] ++ [32])
table2 "`complementBit`" complementBit xs ([0..3] ++ [32])
table2 "`testBit`" testBit xs ([0..3] ++ [32])
- table1 "bitSize" bitSize xs
+ if do_bitsize then table1 "bitSize" bitSize xs else return ()
table1 "isSigned" isSigned xs
where
(xs,ys) = samples zero
diff --git a/ghc/tests/numeric/should_run/arith011.stdout b/ghc/tests/numeric/should_run/arith011.stdout
index 5671727fdd632bd4e8e383e0d9cdaeeb119933f5..7a7c6b1a99d867959451aff9e94bddac199d2cf9 100644
--- a/ghc/tests/numeric/should_run/arith011.stdout
+++ b/ghc/tests/numeric/should_run/arith011.stdout
@@ -9303,3 +9303,1392 @@ isSigned 1 = False
isSigned 2 = False
isSigned 3 = False
#
+--------------------------------
+--Testing Integer
+ putStrLn $
+testEnum
+[0,1,2,3,4,5,6,7,8,9]
+[0,2,4,6,8,10,12,14,16,18]
+[0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20]
+[0,2,4,6,8,10,12,14,16,18,20]
+testReadShow
+[-3,-2,-1,0,1,2,3]
+[-3,-2,-1,0,1,2,3]
+testEq
+-3 == -3 = True
+-3 == -2 = False
+-3 == -1 = False
+-3 == 0 = False
+-3 == 1 = False
+-3 == 2 = False
+-3 == 3 = False
+
+-2 == -3 = False
+-2 == -2 = True
+-2 == -1 = False
+-2 == 0 = False
+-2 == 1 = False
+-2 == 2 = False
+-2 == 3 = False
+
+-1 == -3 = False
+-1 == -2 = False
+-1 == -1 = True
+-1 == 0 = False
+-1 == 1 = False
+-1 == 2 = False
+-1 == 3 = False
+
+0 == -3 = False
+0 == -2 = False
+0 == -1 = False
+0 == 0 = True
+0 == 1 = False
+0 == 2 = False
+0 == 3 = False
+
+1 == -3 = False
+1 == -2 = False
+1 == -1 = False
+1 == 0 = False
+1 == 1 = True
+1 == 2 = False
+1 == 3 = False
+
+2 == -3 = False
+2 == -2 = False
+2 == -1 = False
+2 == 0 = False
+2 == 1 = False
+2 == 2 = True
+2 == 3 = False
+
+3 == -3 = False
+3 == -2 = False
+3 == -1 = False
+3 == 0 = False
+3 == 1 = False
+3 == 2 = False
+3 == 3 = True
+
+#
+-3 /= -3 = False
+-3 /= -2 = True
+-3 /= -1 = True
+-3 /= 0 = True
+-3 /= 1 = True
+-3 /= 2 = True
+-3 /= 3 = True
+
+-2 /= -3 = True
+-2 /= -2 = False
+-2 /= -1 = True
+-2 /= 0 = True
+-2 /= 1 = True
+-2 /= 2 = True
+-2 /= 3 = True
+
+-1 /= -3 = True
+-1 /= -2 = True
+-1 /= -1 = False
+-1 /= 0 = True
+-1 /= 1 = True
+-1 /= 2 = True
+-1 /= 3 = True
+
+0 /= -3 = True
+0 /= -2 = True
+0 /= -1 = True
+0 /= 0 = False
+0 /= 1 = True
+0 /= 2 = True
+0 /= 3 = True
+
+1 /= -3 = True
+1 /= -2 = True
+1 /= -1 = True
+1 /= 0 = True
+1 /= 1 = False
+1 /= 2 = True
+1 /= 3 = True
+
+2 /= -3 = True
+2 /= -2 = True
+2 /= -1 = True
+2 /= 0 = True
+2 /= 1 = True
+2 /= 2 = False
+2 /= 3 = True
+
+3 /= -3 = True
+3 /= -2 = True
+3 /= -1 = True
+3 /= 0 = True
+3 /= 1 = True
+3 /= 2 = True
+3 /= 3 = False
+
+#
+testOrd
+-3 <= -3 = True
+-3 <= -2 = True
+-3 <= -1 = True
+-3 <= 0 = True
+-3 <= 1 = True
+-3 <= 2 = True
+-3 <= 3 = True
+
+-2 <= -3 = False
+-2 <= -2 = True
+-2 <= -1 = True
+-2 <= 0 = True
+-2 <= 1 = True
+-2 <= 2 = True
+-2 <= 3 = True
+
+-1 <= -3 = False
+-1 <= -2 = False
+-1 <= -1 = True
+-1 <= 0 = True
+-1 <= 1 = True
+-1 <= 2 = True
+-1 <= 3 = True
+
+0 <= -3 = False
+0 <= -2 = False
+0 <= -1 = False
+0 <= 0 = True
+0 <= 1 = True
+0 <= 2 = True
+0 <= 3 = True
+
+1 <= -3 = False
+1 <= -2 = False
+1 <= -1 = False
+1 <= 0 = False
+1 <= 1 = True
+1 <= 2 = True
+1 <= 3 = True
+
+2 <= -3 = False
+2 <= -2 = False
+2 <= -1 = False
+2 <= 0 = False
+2 <= 1 = False
+2 <= 2 = True
+2 <= 3 = True
+
+3 <= -3 = False
+3 <= -2 = False
+3 <= -1 = False
+3 <= 0 = False
+3 <= 1 = False
+3 <= 2 = False
+3 <= 3 = True
+
+#
+-3 < -3 = False
+-3 < -2 = True
+-3 < -1 = True
+-3 < 0 = True
+-3 < 1 = True
+-3 < 2 = True
+-3 < 3 = True
+
+-2 < -3 = False
+-2 < -2 = False
+-2 < -1 = True
+-2 < 0 = True
+-2 < 1 = True
+-2 < 2 = True
+-2 < 3 = True
+
+-1 < -3 = False
+-1 < -2 = False
+-1 < -1 = False
+-1 < 0 = True
+-1 < 1 = True
+-1 < 2 = True
+-1 < 3 = True
+
+0 < -3 = False
+0 < -2 = False
+0 < -1 = False
+0 < 0 = False
+0 < 1 = True
+0 < 2 = True
+0 < 3 = True
+
+1 < -3 = False
+1 < -2 = False
+1 < -1 = False
+1 < 0 = False
+1 < 1 = False
+1 < 2 = True
+1 < 3 = True
+
+2 < -3 = False
+2 < -2 = False
+2 < -1 = False
+2 < 0 = False
+2 < 1 = False
+2 < 2 = False
+2 < 3 = True
+
+3 < -3 = False
+3 < -2 = False
+3 < -1 = False
+3 < 0 = False
+3 < 1 = False
+3 < 2 = False
+3 < 3 = False
+
+#
+-3 > -3 = False
+-3 > -2 = False
+-3 > -1 = False
+-3 > 0 = False
+-3 > 1 = False
+-3 > 2 = False
+-3 > 3 = False
+
+-2 > -3 = True
+-2 > -2 = False
+-2 > -1 = False
+-2 > 0 = False
+-2 > 1 = False
+-2 > 2 = False
+-2 > 3 = False
+
+-1 > -3 = True
+-1 > -2 = True
+-1 > -1 = False
+-1 > 0 = False
+-1 > 1 = False
+-1 > 2 = False
+-1 > 3 = False
+
+0 > -3 = True
+0 > -2 = True
+0 > -1 = True
+0 > 0 = False
+0 > 1 = False
+0 > 2 = False
+0 > 3 = False
+
+1 > -3 = True
+1 > -2 = True
+1 > -1 = True
+1 > 0 = True
+1 > 1 = False
+1 > 2 = False
+1 > 3 = False
+
+2 > -3 = True
+2 > -2 = True
+2 > -1 = True
+2 > 0 = True
+2 > 1 = True
+2 > 2 = False
+2 > 3 = False
+
+3 > -3 = True
+3 > -2 = True
+3 > -1 = True
+3 > 0 = True
+3 > 1 = True
+3 > 2 = True
+3 > 3 = False
+
+#
+-3 >= -3 = True
+-3 >= -2 = False
+-3 >= -1 = False
+-3 >= 0 = False
+-3 >= 1 = False
+-3 >= 2 = False
+-3 >= 3 = False
+
+-2 >= -3 = True
+-2 >= -2 = True
+-2 >= -1 = False
+-2 >= 0 = False
+-2 >= 1 = False
+-2 >= 2 = False
+-2 >= 3 = False
+
+-1 >= -3 = True
+-1 >= -2 = True
+-1 >= -1 = True
+-1 >= 0 = False
+-1 >= 1 = False
+-1 >= 2 = False
+-1 >= 3 = False
+
+0 >= -3 = True
+0 >= -2 = True
+0 >= -1 = True
+0 >= 0 = True
+0 >= 1 = False
+0 >= 2 = False
+0 >= 3 = False
+
+1 >= -3 = True
+1 >= -2 = True
+1 >= -1 = True
+1 >= 0 = True
+1 >= 1 = True
+1 >= 2 = False
+1 >= 3 = False
+
+2 >= -3 = True
+2 >= -2 = True
+2 >= -1 = True
+2 >= 0 = True
+2 >= 1 = True
+2 >= 2 = True
+2 >= 3 = False
+
+3 >= -3 = True
+3 >= -2 = True
+3 >= -1 = True
+3 >= 0 = True
+3 >= 1 = True
+3 >= 2 = True
+3 >= 3 = True
+
+#
+-3 `compare` -3 = EQ
+-3 `compare` -2 = LT
+-3 `compare` -1 = LT
+-3 `compare` 0 = LT
+-3 `compare` 1 = LT
+-3 `compare` 2 = LT
+-3 `compare` 3 = LT
+
+-2 `compare` -3 = GT
+-2 `compare` -2 = EQ
+-2 `compare` -1 = LT
+-2 `compare` 0 = LT
+-2 `compare` 1 = LT
+-2 `compare` 2 = LT
+-2 `compare` 3 = LT
+
+-1 `compare` -3 = GT
+-1 `compare` -2 = GT
+-1 `compare` -1 = EQ
+-1 `compare` 0 = LT
+-1 `compare` 1 = LT
+-1 `compare` 2 = LT
+-1 `compare` 3 = LT
+
+0 `compare` -3 = GT
+0 `compare` -2 = GT
+0 `compare` -1 = GT
+0 `compare` 0 = EQ
+0 `compare` 1 = LT
+0 `compare` 2 = LT
+0 `compare` 3 = LT
+
+1 `compare` -3 = GT
+1 `compare` -2 = GT
+1 `compare` -1 = GT
+1 `compare` 0 = GT
+1 `compare` 1 = EQ
+1 `compare` 2 = LT
+1 `compare` 3 = LT
+
+2 `compare` -3 = GT
+2 `compare` -2 = GT
+2 `compare` -1 = GT
+2 `compare` 0 = GT
+2 `compare` 1 = GT
+2 `compare` 2 = EQ
+2 `compare` 3 = LT
+
+3 `compare` -3 = GT
+3 `compare` -2 = GT
+3 `compare` -1 = GT
+3 `compare` 0 = GT
+3 `compare` 1 = GT
+3 `compare` 2 = GT
+3 `compare` 3 = EQ
+
+#
+testNum
+-3 + -3 = -6
+-3 + -2 = -5
+-3 + -1 = -4
+-3 + 0 = -3
+-3 + 1 = -2
+-3 + 2 = -1
+-3 + 3 = 0
+
+-2 + -3 = -5
+-2 + -2 = -4
+-2 + -1 = -3
+-2 + 0 = -2
+-2 + 1 = -1
+-2 + 2 = 0
+-2 + 3 = 1
+
+-1 + -3 = -4
+-1 + -2 = -3
+-1 + -1 = -2
+-1 + 0 = -1
+-1 + 1 = 0
+-1 + 2 = 1
+-1 + 3 = 2
+
+0 + -3 = -3
+0 + -2 = -2
+0 + -1 = -1
+0 + 0 = 0
+0 + 1 = 1
+0 + 2 = 2
+0 + 3 = 3
+
+1 + -3 = -2
+1 + -2 = -1
+1 + -1 = 0
+1 + 0 = 1
+1 + 1 = 2
+1 + 2 = 3
+1 + 3 = 4
+
+2 + -3 = -1
+2 + -2 = 0
+2 + -1 = 1
+2 + 0 = 2
+2 + 1 = 3
+2 + 2 = 4
+2 + 3 = 5
+
+3 + -3 = 0
+3 + -2 = 1
+3 + -1 = 2
+3 + 0 = 3
+3 + 1 = 4
+3 + 2 = 5
+3 + 3 = 6
+
+#
+-3 - -3 = 0
+-3 - -2 = -1
+-3 - -1 = -2
+-3 - 0 = -3
+-3 - 1 = -4
+-3 - 2 = -5
+-3 - 3 = -6
+
+-2 - -3 = 1
+-2 - -2 = 0
+-2 - -1 = -1
+-2 - 0 = -2
+-2 - 1 = -3
+-2 - 2 = -4
+-2 - 3 = -5
+
+-1 - -3 = 2
+-1 - -2 = 1
+-1 - -1 = 0
+-1 - 0 = -1
+-1 - 1 = -2
+-1 - 2 = -3
+-1 - 3 = -4
+
+0 - -3 = 3
+0 - -2 = 2
+0 - -1 = 1
+0 - 0 = 0
+0 - 1 = -1
+0 - 2 = -2
+0 - 3 = -3
+
+1 - -3 = 4
+1 - -2 = 3
+1 - -1 = 2
+1 - 0 = 1
+1 - 1 = 0
+1 - 2 = -1
+1 - 3 = -2
+
+2 - -3 = 5
+2 - -2 = 4
+2 - -1 = 3
+2 - 0 = 2
+2 - 1 = 1
+2 - 2 = 0
+2 - 3 = -1
+
+3 - -3 = 6
+3 - -2 = 5
+3 - -1 = 4
+3 - 0 = 3
+3 - 1 = 2
+3 - 2 = 1
+3 - 3 = 0
+
+#
+-3 * -3 = 9
+-3 * -2 = 6
+-3 * -1 = 3
+-3 * 0 = 0
+-3 * 1 = -3
+-3 * 2 = -6
+-3 * 3 = -9
+
+-2 * -3 = 6
+-2 * -2 = 4
+-2 * -1 = 2
+-2 * 0 = 0
+-2 * 1 = -2
+-2 * 2 = -4
+-2 * 3 = -6
+
+-1 * -3 = 3
+-1 * -2 = 2
+-1 * -1 = 1
+-1 * 0 = 0
+-1 * 1 = -1
+-1 * 2 = -2
+-1 * 3 = -3
+
+0 * -3 = 0
+0 * -2 = 0
+0 * -1 = 0
+0 * 0 = 0
+0 * 1 = 0
+0 * 2 = 0
+0 * 3 = 0
+
+1 * -3 = -3
+1 * -2 = -2
+1 * -1 = -1
+1 * 0 = 0
+1 * 1 = 1
+1 * 2 = 2
+1 * 3 = 3
+
+2 * -3 = -6
+2 * -2 = -4
+2 * -1 = -2
+2 * 0 = 0
+2 * 1 = 2
+2 * 2 = 4
+2 * 3 = 6
+
+3 * -3 = -9
+3 * -2 = -6
+3 * -1 = -3
+3 * 0 = 0
+3 * 1 = 3
+3 * 2 = 6
+3 * 3 = 9
+
+#
+negate -3 = 3
+negate -2 = 2
+negate -1 = 1
+negate 0 = 0
+negate 1 = -1
+negate 2 = -2
+negate 3 = -3
+#
+testReal
+toRational -3 = -3 % 1
+toRational -2 = -2 % 1
+toRational -1 = -1 % 1
+toRational 0 = 0 % 1
+toRational 1 = 1 % 1
+toRational 2 = 2 % 1
+toRational 3 = 3 % 1
+#
+testIntegral
+-3 `divMod` -3 = (1,0)
+-3 `divMod` -2 = (1,-1)
+-3 `divMod` -1 = (3,0)
+-3 `divMod` 1 = (-3,0)
+-3 `divMod` 2 = (-2,1)
+-3 `divMod` 3 = (-1,0)
+
+-2 `divMod` -3 = (0,-2)
+-2 `divMod` -2 = (1,0)
+-2 `divMod` -1 = (2,0)
+-2 `divMod` 1 = (-2,0)
+-2 `divMod` 2 = (-1,0)
+-2 `divMod` 3 = (-1,1)
+
+-1 `divMod` -3 = (0,-1)
+-1 `divMod` -2 = (0,-1)
+-1 `divMod` -1 = (1,0)
+-1 `divMod` 1 = (-1,0)
+-1 `divMod` 2 = (-1,1)
+-1 `divMod` 3 = (-1,2)
+
+0 `divMod` -3 = (0,0)
+0 `divMod` -2 = (0,0)
+0 `divMod` -1 = (0,0)
+0 `divMod` 1 = (0,0)
+0 `divMod` 2 = (0,0)
+0 `divMod` 3 = (0,0)
+
+1 `divMod` -3 = (-1,-2)
+1 `divMod` -2 = (-1,-1)
+1 `divMod` -1 = (-1,0)
+1 `divMod` 1 = (1,0)
+1 `divMod` 2 = (0,1)
+1 `divMod` 3 = (0,1)
+
+2 `divMod` -3 = (-1,-1)
+2 `divMod` -2 = (-1,0)
+2 `divMod` -1 = (-2,0)
+2 `divMod` 1 = (2,0)
+2 `divMod` 2 = (1,0)
+2 `divMod` 3 = (0,2)
+
+3 `divMod` -3 = (-1,0)
+3 `divMod` -2 = (-2,-1)
+3 `divMod` -1 = (-3,0)
+3 `divMod` 1 = (3,0)
+3 `divMod` 2 = (1,1)
+3 `divMod` 3 = (1,0)
+
+#
+-3 `div` -3 = 1
+-3 `div` -2 = 1
+-3 `div` -1 = 3
+-3 `div` 1 = -3
+-3 `div` 2 = -2
+-3 `div` 3 = -1
+
+-2 `div` -3 = 0
+-2 `div` -2 = 1
+-2 `div` -1 = 2
+-2 `div` 1 = -2
+-2 `div` 2 = -1
+-2 `div` 3 = -1
+
+-1 `div` -3 = 0
+-1 `div` -2 = 0
+-1 `div` -1 = 1
+-1 `div` 1 = -1
+-1 `div` 2 = -1
+-1 `div` 3 = -1
+
+0 `div` -3 = 0
+0 `div` -2 = 0
+0 `div` -1 = 0
+0 `div` 1 = 0
+0 `div` 2 = 0
+0 `div` 3 = 0
+
+1 `div` -3 = -1
+1 `div` -2 = -1
+1 `div` -1 = -1
+1 `div` 1 = 1
+1 `div` 2 = 0
+1 `div` 3 = 0
+
+2 `div` -3 = -1
+2 `div` -2 = -1
+2 `div` -1 = -2
+2 `div` 1 = 2
+2 `div` 2 = 1
+2 `div` 3 = 0
+
+3 `div` -3 = -1
+3 `div` -2 = -2
+3 `div` -1 = -3
+3 `div` 1 = 3
+3 `div` 2 = 1
+3 `div` 3 = 1
+
+#
+-3 `mod` -3 = 0
+-3 `mod` -2 = -1
+-3 `mod` -1 = 0
+-3 `mod` 1 = 0
+-3 `mod` 2 = 1
+-3 `mod` 3 = 0
+
+-2 `mod` -3 = -2
+-2 `mod` -2 = 0
+-2 `mod` -1 = 0
+-2 `mod` 1 = 0
+-2 `mod` 2 = 0
+-2 `mod` 3 = 1
+
+-1 `mod` -3 = -1
+-1 `mod` -2 = -1
+-1 `mod` -1 = 0
+-1 `mod` 1 = 0
+-1 `mod` 2 = 1
+-1 `mod` 3 = 2
+
+0 `mod` -3 = 0
+0 `mod` -2 = 0
+0 `mod` -1 = 0
+0 `mod` 1 = 0
+0 `mod` 2 = 0
+0 `mod` 3 = 0
+
+1 `mod` -3 = -2
+1 `mod` -2 = -1
+1 `mod` -1 = 0
+1 `mod` 1 = 0
+1 `mod` 2 = 1
+1 `mod` 3 = 1
+
+2 `mod` -3 = -1
+2 `mod` -2 = 0
+2 `mod` -1 = 0
+2 `mod` 1 = 0
+2 `mod` 2 = 0
+2 `mod` 3 = 2
+
+3 `mod` -3 = 0
+3 `mod` -2 = -1
+3 `mod` -1 = 0
+3 `mod` 1 = 0
+3 `mod` 2 = 1
+3 `mod` 3 = 0
+
+#
+-3 `quotRem` -3 = (1,0)
+-3 `quotRem` -2 = (1,-1)
+-3 `quotRem` -1 = (3,0)
+-3 `quotRem` 1 = (-3,0)
+-3 `quotRem` 2 = (-1,-1)
+-3 `quotRem` 3 = (-1,0)
+
+-2 `quotRem` -3 = (0,-2)
+-2 `quotRem` -2 = (1,0)
+-2 `quotRem` -1 = (2,0)
+-2 `quotRem` 1 = (-2,0)
+-2 `quotRem` 2 = (-1,0)
+-2 `quotRem` 3 = (0,-2)
+
+-1 `quotRem` -3 = (0,-1)
+-1 `quotRem` -2 = (0,-1)
+-1 `quotRem` -1 = (1,0)
+-1 `quotRem` 1 = (-1,0)
+-1 `quotRem` 2 = (0,-1)
+-1 `quotRem` 3 = (0,-1)
+
+0 `quotRem` -3 = (0,0)
+0 `quotRem` -2 = (0,0)
+0 `quotRem` -1 = (0,0)
+0 `quotRem` 1 = (0,0)
+0 `quotRem` 2 = (0,0)
+0 `quotRem` 3 = (0,0)
+
+1 `quotRem` -3 = (0,1)
+1 `quotRem` -2 = (0,1)
+1 `quotRem` -1 = (-1,0)
+1 `quotRem` 1 = (1,0)
+1 `quotRem` 2 = (0,1)
+1 `quotRem` 3 = (0,1)
+
+2 `quotRem` -3 = (0,2)
+2 `quotRem` -2 = (-1,0)
+2 `quotRem` -1 = (-2,0)
+2 `quotRem` 1 = (2,0)
+2 `quotRem` 2 = (1,0)
+2 `quotRem` 3 = (0,2)
+
+3 `quotRem` -3 = (-1,0)
+3 `quotRem` -2 = (-1,1)
+3 `quotRem` -1 = (-3,0)
+3 `quotRem` 1 = (3,0)
+3 `quotRem` 2 = (1,1)
+3 `quotRem` 3 = (1,0)
+
+#
+-3 `quot` -3 = 1
+-3 `quot` -2 = 1
+-3 `quot` -1 = 3
+-3 `quot` 1 = -3
+-3 `quot` 2 = -1
+-3 `quot` 3 = -1
+
+-2 `quot` -3 = 0
+-2 `quot` -2 = 1
+-2 `quot` -1 = 2
+-2 `quot` 1 = -2
+-2 `quot` 2 = -1
+-2 `quot` 3 = 0
+
+-1 `quot` -3 = 0
+-1 `quot` -2 = 0
+-1 `quot` -1 = 1
+-1 `quot` 1 = -1
+-1 `quot` 2 = 0
+-1 `quot` 3 = 0
+
+0 `quot` -3 = 0
+0 `quot` -2 = 0
+0 `quot` -1 = 0
+0 `quot` 1 = 0
+0 `quot` 2 = 0
+0 `quot` 3 = 0
+
+1 `quot` -3 = 0
+1 `quot` -2 = 0
+1 `quot` -1 = -1
+1 `quot` 1 = 1
+1 `quot` 2 = 0
+1 `quot` 3 = 0
+
+2 `quot` -3 = 0
+2 `quot` -2 = -1
+2 `quot` -1 = -2
+2 `quot` 1 = 2
+2 `quot` 2 = 1
+2 `quot` 3 = 0
+
+3 `quot` -3 = -1
+3 `quot` -2 = -1
+3 `quot` -1 = -3
+3 `quot` 1 = 3
+3 `quot` 2 = 1
+3 `quot` 3 = 1
+
+#
+-3 `rem` -3 = 0
+-3 `rem` -2 = -1
+-3 `rem` -1 = 0
+-3 `rem` 1 = 0
+-3 `rem` 2 = -1
+-3 `rem` 3 = 0
+
+-2 `rem` -3 = -2
+-2 `rem` -2 = 0
+-2 `rem` -1 = 0
+-2 `rem` 1 = 0
+-2 `rem` 2 = 0
+-2 `rem` 3 = -2
+
+-1 `rem` -3 = -1
+-1 `rem` -2 = -1
+-1 `rem` -1 = 0
+-1 `rem` 1 = 0
+-1 `rem` 2 = -1
+-1 `rem` 3 = -1
+
+0 `rem` -3 = 0
+0 `rem` -2 = 0
+0 `rem` -1 = 0
+0 `rem` 1 = 0
+0 `rem` 2 = 0
+0 `rem` 3 = 0
+
+1 `rem` -3 = 1
+1 `rem` -2 = 1
+1 `rem` -1 = 0
+1 `rem` 1 = 0
+1 `rem` 2 = 1
+1 `rem` 3 = 1
+
+2 `rem` -3 = 2
+2 `rem` -2 = 0
+2 `rem` -1 = 0
+2 `rem` 1 = 0
+2 `rem` 2 = 0
+2 `rem` 3 = 2
+
+3 `rem` -3 = 0
+3 `rem` -2 = 1
+3 `rem` -1 = 0
+3 `rem` 1 = 0
+3 `rem` 2 = 1
+3 `rem` 3 = 0
+
+#
+testBits
+-3 .&. -3 = -3
+-3 .&. -2 = -4
+-3 .&. -1 = -3
+-3 .&. 1 = 1
+-3 .&. 2 = 0
+-3 .&. 3 = 1
+
+-2 .&. -3 = -4
+-2 .&. -2 = -2
+-2 .&. -1 = -2
+-2 .&. 1 = 0
+-2 .&. 2 = 2
+-2 .&. 3 = 2
+
+-1 .&. -3 = -3
+-1 .&. -2 = -2
+-1 .&. -1 = -1
+-1 .&. 1 = 1
+-1 .&. 2 = 2
+-1 .&. 3 = 3
+
+0 .&. -3 = 0
+0 .&. -2 = 0
+0 .&. -1 = 0
+0 .&. 1 = 0
+0 .&. 2 = 0
+0 .&. 3 = 0
+
+1 .&. -3 = 1
+1 .&. -2 = 0
+1 .&. -1 = 1
+1 .&. 1 = 1
+1 .&. 2 = 0
+1 .&. 3 = 1
+
+2 .&. -3 = 0
+2 .&. -2 = 2
+2 .&. -1 = 2
+2 .&. 1 = 0
+2 .&. 2 = 2
+2 .&. 3 = 2
+
+3 .&. -3 = 1
+3 .&. -2 = 2
+3 .&. -1 = 3
+3 .&. 1 = 1
+3 .&. 2 = 2
+3 .&. 3 = 3
+
+#
+-3 .|. -3 = -3
+-3 .|. -2 = -1
+-3 .|. -1 = -1
+-3 .|. 1 = -3
+-3 .|. 2 = -1
+-3 .|. 3 = -1
+
+-2 .|. -3 = -1
+-2 .|. -2 = -2
+-2 .|. -1 = -1
+-2 .|. 1 = -1
+-2 .|. 2 = -2
+-2 .|. 3 = -1
+
+-1 .|. -3 = -1
+-1 .|. -2 = -1
+-1 .|. -1 = -1
+-1 .|. 1 = -1
+-1 .|. 2 = -1
+-1 .|. 3 = -1
+
+0 .|. -3 = -3
+0 .|. -2 = -2
+0 .|. -1 = -1
+0 .|. 1 = 1
+0 .|. 2 = 2
+0 .|. 3 = 3
+
+1 .|. -3 = -3
+1 .|. -2 = -1
+1 .|. -1 = -1
+1 .|. 1 = 1
+1 .|. 2 = 3
+1 .|. 3 = 3
+
+2 .|. -3 = -1
+2 .|. -2 = -2
+2 .|. -1 = -1
+2 .|. 1 = 3
+2 .|. 2 = 2
+2 .|. 3 = 3
+
+3 .|. -3 = -1
+3 .|. -2 = -1
+3 .|. -1 = -1
+3 .|. 1 = 3
+3 .|. 2 = 3
+3 .|. 3 = 3
+
+#
+-3 `xor` -3 = 0
+-3 `xor` -2 = 3
+-3 `xor` -1 = 2
+-3 `xor` 1 = -4
+-3 `xor` 2 = -1
+-3 `xor` 3 = -2
+
+-2 `xor` -3 = 3
+-2 `xor` -2 = 0
+-2 `xor` -1 = 1
+-2 `xor` 1 = -1
+-2 `xor` 2 = -4
+-2 `xor` 3 = -3
+
+-1 `xor` -3 = 2
+-1 `xor` -2 = 1
+-1 `xor` -1 = 0
+-1 `xor` 1 = -2
+-1 `xor` 2 = -3
+-1 `xor` 3 = -4
+
+0 `xor` -3 = -3
+0 `xor` -2 = -2
+0 `xor` -1 = -1
+0 `xor` 1 = 1
+0 `xor` 2 = 2
+0 `xor` 3 = 3
+
+1 `xor` -3 = -4
+1 `xor` -2 = -1
+1 `xor` -1 = -2
+1 `xor` 1 = 0
+1 `xor` 2 = 3
+1 `xor` 3 = 2
+
+2 `xor` -3 = -1
+2 `xor` -2 = -4
+2 `xor` -1 = -3
+2 `xor` 1 = 3
+2 `xor` 2 = 0
+2 `xor` 3 = 1
+
+3 `xor` -3 = -2
+3 `xor` -2 = -3
+3 `xor` -1 = -4
+3 `xor` 1 = 2
+3 `xor` 2 = 1
+3 `xor` 3 = 0
+
+#
+complement -3 = 2
+complement -2 = 1
+complement -1 = 0
+complement 0 = -1
+complement 1 = -2
+complement 2 = -3
+complement 3 = -4
+#
+-3 `shiftL` 0 = -3
+-3 `shiftL` 1 = -6
+-3 `shiftL` 2 = -12
+-3 `shiftL` 3 = -24
+-3 `shiftL` 32 = -12884901888
+
+-2 `shiftL` 0 = -2
+-2 `shiftL` 1 = -4
+-2 `shiftL` 2 = -8
+-2 `shiftL` 3 = -16
+-2 `shiftL` 32 = -8589934592
+
+-1 `shiftL` 0 = -1
+-1 `shiftL` 1 = -2
+-1 `shiftL` 2 = -4
+-1 `shiftL` 3 = -8
+-1 `shiftL` 32 = -4294967296
+
+0 `shiftL` 0 = 0
+0 `shiftL` 1 = 0
+0 `shiftL` 2 = 0
+0 `shiftL` 3 = 0
+0 `shiftL` 32 = 0
+
+1 `shiftL` 0 = 1
+1 `shiftL` 1 = 2
+1 `shiftL` 2 = 4
+1 `shiftL` 3 = 8
+1 `shiftL` 32 = 4294967296
+
+2 `shiftL` 0 = 2
+2 `shiftL` 1 = 4
+2 `shiftL` 2 = 8
+2 `shiftL` 3 = 16
+2 `shiftL` 32 = 8589934592
+
+3 `shiftL` 0 = 3
+3 `shiftL` 1 = 6
+3 `shiftL` 2 = 12
+3 `shiftL` 3 = 24
+3 `shiftL` 32 = 12884901888
+
+#
+-3 `shiftR` 0 = -3
+-3 `shiftR` 1 = -2
+-3 `shiftR` 2 = -1
+-3 `shiftR` 3 = -1
+-3 `shiftR` 32 = -1
+
+-2 `shiftR` 0 = -2
+-2 `shiftR` 1 = -1
+-2 `shiftR` 2 = -1
+-2 `shiftR` 3 = -1
+-2 `shiftR` 32 = -1
+
+-1 `shiftR` 0 = -1
+-1 `shiftR` 1 = -1
+-1 `shiftR` 2 = -1
+-1 `shiftR` 3 = -1
+-1 `shiftR` 32 = -1
+
+0 `shiftR` 0 = 0
+0 `shiftR` 1 = 0
+0 `shiftR` 2 = 0
+0 `shiftR` 3 = 0
+0 `shiftR` 32 = 0
+
+1 `shiftR` 0 = 1
+1 `shiftR` 1 = 0
+1 `shiftR` 2 = 0
+1 `shiftR` 3 = 0
+1 `shiftR` 32 = 0
+
+2 `shiftR` 0 = 2
+2 `shiftR` 1 = 1
+2 `shiftR` 2 = 0
+2 `shiftR` 3 = 0
+2 `shiftR` 32 = 0
+
+3 `shiftR` 0 = 3
+3 `shiftR` 1 = 1
+3 `shiftR` 2 = 0
+3 `shiftR` 3 = 0
+3 `shiftR` 32 = 0
+
+#
+-3 `rotate` -3 = -1
+-3 `rotate` -2 = -1
+-3 `rotate` -1 = -2
+-3 `rotate` 0 = -3
+-3 `rotate` 1 = -6
+-3 `rotate` 2 = -12
+-3 `rotate` 3 = -24
+
+-2 `rotate` -3 = -1
+-2 `rotate` -2 = -1
+-2 `rotate` -1 = -1
+-2 `rotate` 0 = -2
+-2 `rotate` 1 = -4
+-2 `rotate` 2 = -8
+-2 `rotate` 3 = -16
+
+-1 `rotate` -3 = -1
+-1 `rotate` -2 = -1
+-1 `rotate` -1 = -1
+-1 `rotate` 0 = -1
+-1 `rotate` 1 = -2
+-1 `rotate` 2 = -4
+-1 `rotate` 3 = -8
+
+0 `rotate` -3 = 0
+0 `rotate` -2 = 0
+0 `rotate` -1 = 0
+0 `rotate` 0 = 0
+0 `rotate` 1 = 0
+0 `rotate` 2 = 0
+0 `rotate` 3 = 0
+
+1 `rotate` -3 = 0
+1 `rotate` -2 = 0
+1 `rotate` -1 = 0
+1 `rotate` 0 = 1
+1 `rotate` 1 = 2
+1 `rotate` 2 = 4
+1 `rotate` 3 = 8
+
+2 `rotate` -3 = 0
+2 `rotate` -2 = 0
+2 `rotate` -1 = 1
+2 `rotate` 0 = 2
+2 `rotate` 1 = 4
+2 `rotate` 2 = 8
+2 `rotate` 3 = 16
+
+3 `rotate` -3 = 0
+3 `rotate` -2 = 0
+3 `rotate` -1 = 1
+3 `rotate` 0 = 3
+3 `rotate` 1 = 6
+3 `rotate` 2 = 12
+3 `rotate` 3 = 24
+
+#
+bit 0 = 1
+bit 1 = 2
+bit 2 = 4
+bit 3 = 8
+#
+-3 `setBit` 0 = -3
+-3 `setBit` 1 = -1
+-3 `setBit` 2 = -3
+-3 `setBit` 3 = -3
+-3 `setBit` 32 = -3
+
+-2 `setBit` 0 = -1
+-2 `setBit` 1 = -2
+-2 `setBit` 2 = -2
+-2 `setBit` 3 = -2
+-2 `setBit` 32 = -2
+
+-1 `setBit` 0 = -1
+-1 `setBit` 1 = -1
+-1 `setBit` 2 = -1
+-1 `setBit` 3 = -1
+-1 `setBit` 32 = -1
+
+0 `setBit` 0 = 1
+0 `setBit` 1 = 2
+0 `setBit` 2 = 4
+0 `setBit` 3 = 8
+0 `setBit` 32 = 4294967296
+
+1 `setBit` 0 = 1
+1 `setBit` 1 = 3
+1 `setBit` 2 = 5
+1 `setBit` 3 = 9
+1 `setBit` 32 = 4294967297
+
+2 `setBit` 0 = 3
+2 `setBit` 1 = 2
+2 `setBit` 2 = 6
+2 `setBit` 3 = 10
+2 `setBit` 32 = 4294967298
+
+3 `setBit` 0 = 3
+3 `setBit` 1 = 3
+3 `setBit` 2 = 7
+3 `setBit` 3 = 11
+3 `setBit` 32 = 4294967299
+
+#
+-3 `clearBit` 0 = -4
+-3 `clearBit` 1 = -3
+-3 `clearBit` 2 = -7
+-3 `clearBit` 3 = -11
+-3 `clearBit` 32 = -4294967299
+
+-2 `clearBit` 0 = -2
+-2 `clearBit` 1 = -4
+-2 `clearBit` 2 = -6
+-2 `clearBit` 3 = -10
+-2 `clearBit` 32 = -4294967298
+
+-1 `clearBit` 0 = -2
+-1 `clearBit` 1 = -3
+-1 `clearBit` 2 = -5
+-1 `clearBit` 3 = -9
+-1 `clearBit` 32 = -4294967297
+
+0 `clearBit` 0 = 0
+0 `clearBit` 1 = 0
+0 `clearBit` 2 = 0
+0 `clearBit` 3 = 0
+0 `clearBit` 32 = 0
+
+1 `clearBit` 0 = 0
+1 `clearBit` 1 = 1
+1 `clearBit` 2 = 1
+1 `clearBit` 3 = 1
+1 `clearBit` 32 = 1
+
+2 `clearBit` 0 = 2
+2 `clearBit` 1 = 0
+2 `clearBit` 2 = 2
+2 `clearBit` 3 = 2
+2 `clearBit` 32 = 2
+
+3 `clearBit` 0 = 2
+3 `clearBit` 1 = 1
+3 `clearBit` 2 = 3
+3 `clearBit` 3 = 3
+3 `clearBit` 32 = 3
+
+#
+-3 `complementBit` 0 = -4
+-3 `complementBit` 1 = -1
+-3 `complementBit` 2 = -7
+-3 `complementBit` 3 = -11
+-3 `complementBit` 32 = -4294967299
+
+-2 `complementBit` 0 = -1
+-2 `complementBit` 1 = -4
+-2 `complementBit` 2 = -6
+-2 `complementBit` 3 = -10
+-2 `complementBit` 32 = -4294967298
+
+-1 `complementBit` 0 = -2
+-1 `complementBit` 1 = -3
+-1 `complementBit` 2 = -5
+-1 `complementBit` 3 = -9
+-1 `complementBit` 32 = -4294967297
+
+0 `complementBit` 0 = 1
+0 `complementBit` 1 = 2
+0 `complementBit` 2 = 4
+0 `complementBit` 3 = 8
+0 `complementBit` 32 = 4294967296
+
+1 `complementBit` 0 = 0
+1 `complementBit` 1 = 3
+1 `complementBit` 2 = 5
+1 `complementBit` 3 = 9
+1 `complementBit` 32 = 4294967297
+
+2 `complementBit` 0 = 3
+2 `complementBit` 1 = 0
+2 `complementBit` 2 = 6
+2 `complementBit` 3 = 10
+2 `complementBit` 32 = 4294967298
+
+3 `complementBit` 0 = 2
+3 `complementBit` 1 = 1
+3 `complementBit` 2 = 7
+3 `complementBit` 3 = 11
+3 `complementBit` 32 = 4294967299
+
+#
+-3 `testBit` 0 = True
+-3 `testBit` 1 = False
+-3 `testBit` 2 = True
+-3 `testBit` 3 = True
+-3 `testBit` 32 = True
+
+-2 `testBit` 0 = False
+-2 `testBit` 1 = True
+-2 `testBit` 2 = True
+-2 `testBit` 3 = True
+-2 `testBit` 32 = True
+
+-1 `testBit` 0 = True
+-1 `testBit` 1 = True
+-1 `testBit` 2 = True
+-1 `testBit` 3 = True
+-1 `testBit` 32 = True
+
+0 `testBit` 0 = False
+0 `testBit` 1 = False
+0 `testBit` 2 = False
+0 `testBit` 3 = False
+0 `testBit` 32 = False
+
+1 `testBit` 0 = True
+1 `testBit` 1 = False
+1 `testBit` 2 = False
+1 `testBit` 3 = False
+1 `testBit` 32 = False
+
+2 `testBit` 0 = False
+2 `testBit` 1 = True
+2 `testBit` 2 = False
+2 `testBit` 3 = False
+2 `testBit` 32 = False
+
+3 `testBit` 0 = True
+3 `testBit` 1 = True
+3 `testBit` 2 = False
+3 `testBit` 3 = False
+3 `testBit` 32 = False
+
+#
+isSigned -3 = True
+isSigned -2 = True
+isSigned -1 = True
+isSigned 0 = True
+isSigned 1 = True
+isSigned 2 = True
+isSigned 3 = True
+#
diff --git a/ghc/tests/typecheck/should_compile/tc108.hs b/ghc/tests/typecheck/should_compile/tc108.hs
new file mode 100644
index 0000000000000000000000000000000000000000..9288c700e6753b8bb1d7125b08c6dc027dabe5d5
--- /dev/null
+++ b/ghc/tests/typecheck/should_compile/tc108.hs
@@ -0,0 +1,18 @@
+-- !!! Scopes in kind checking
+
+-- Exposes a bizarre bug in 4.08.1
+-- TestSh.hs:6:
+-- `Shape' is not in scope
+-- When checking kinds in `HasConfigValue Shape nodeTypeParms'
+-- In the class declaration for `HasShape'
+
+module ShouldCompile where
+
+data Shape value = Box | Circle
+
+class HasConfigValue Shape nodeTypeParms => HasShape nodeTypeParms where {}
+
+class HasConfigValue option configuration where
+ ($$$) :: option value -> configuration value -> configuration value
+
+
diff --git a/ghc/tests/typecheck/should_compile/tc108.stderr b/ghc/tests/typecheck/should_compile/tc108.stderr
new file mode 100644
index 0000000000000000000000000000000000000000..8d1c8b69c3fce7bea45c73efd06983e3c419a92f
--- /dev/null
+++ b/ghc/tests/typecheck/should_compile/tc108.stderr
@@ -0,0 +1 @@
+
diff --git a/ghc/utils/Makefile b/ghc/utils/Makefile
index 7d2f25c3aa2d2f5136a752ef53b0c5779031a276..0c25b05c4b231752d23b1a316b47e603beaa17ec 100644
--- a/ghc/utils/Makefile
+++ b/ghc/utils/Makefile
@@ -6,6 +6,7 @@ ifneq "$(BIN_DIST_NAME)" ""
SUBDIRS = hp2ps stat2resid unlit
else
SUBDIRS = hp2ps \
+ hsc2hs \
parallel \
stat2resid \
prof \