diff options
31 files changed, 1816 insertions, 383 deletions
diff --git a/ghc/driver/Main.hs b/ghc/driver/Main.hs index 2e235bf8ee..fba1d994a9 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 581c9c5978..d6571ec632 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 22fbf4b454..448c76648c 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 0000000000..c176130649 --- /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 605b6c2ad4..8e03615158 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 852e978a22..e4bddab236 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 b76ba60378..8c2b03e7c3 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 9a0730a3c9..ededcc96b5 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 df6c82cc03..a8b3faab80 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 f6070e37ee..1161d16215 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 f0fd6a6503..fd0152ea20 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 07bd9de886..3c7633a7d1 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 cce4638149..0ae5a89a39 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 48258eb1bc..4ce5bf3a25 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 13f4aac597..52c6148047 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 a548426d7a..01b7182b23 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 183fa20dde..95ffb8a147 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 e93410ffd1..70f52c855f 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 6b48b1f910..be14cef708 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 a0de32b340..dfa87a0fdb 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 4e4303332f..16ec304e34 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 609e8828e9..0000000000 --- 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 35a09fd8b7..fd5ad0d9f6 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 4ff8d8cdd0..b92318923a 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 f5c45f3084..b571db3819 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 79996c38d5..89d9799262 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 e469c0c48b..1e53f8f514 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 5671727fdd..7a7c6b1a99 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 0000000000..9288c700e6 --- /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 0000000000..8d1c8b69c3 --- /dev/null +++ b/ghc/tests/typecheck/should_compile/tc108.stderr @@ -0,0 +1 @@ + diff --git a/ghc/utils/Makefile b/ghc/utils/Makefile index 7d2f25c3aa..0c25b05c4b 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 \ |