From 4d1b970fe7ae5e25a54a7bce03c2501f07f27211 Mon Sep 17 00:00:00 2001 From: sewardj Date: Mon, 11 Dec 2000 16:42:26 +0000 Subject: [PATCH] [project @ 2000-12-11 16:42:26 by sewardj] head -> head bootability wibbles (rm disallowed OPTIONS pragmas) --- ghc/compiler/Makefile | 6 +++--- ghc/compiler/ghci/ByteCodeGen.lhs | 24 ++++++++++++++---------- ghc/compiler/ghci/StgInterp.lhs | 5 ++++- ghc/compiler/main/HscMain.lhs | 3 ++- ghc/compiler/main/Main.hs | 4 ++-- ghc/compiler/utils/Outputable.lhs | 3 --- ghc/compiler/utils/StringBuffer.lhs | 2 +- 7 files changed, 26 insertions(+), 21 deletions(-) diff --git a/ghc/compiler/Makefile b/ghc/compiler/Makefile index 6fc7daf..d28fdea 100644 --- a/ghc/compiler/Makefile +++ b/ghc/compiler/Makefile @@ -1,5 +1,5 @@ # ----------------------------------------------------------------------------- -# $Id: Makefile,v 1.117 2000/11/22 10:13:43 sewardj Exp $ +# $Id: Makefile,v 1.118 2000/12/11 16:42:26 sewardj Exp $ TOP = .. include $(TOP)/mk/boilerplate.mk @@ -164,7 +164,7 @@ space:= $(empty) $(empty) SRC_HC_OPTS += \ -cpp -fglasgow-exts \ - -Rghc-timing -I. -IcodeGen -InativeGen -Iparser \ + -I. -IcodeGen -InativeGen -Iparser \ -i$(subst $(space),:,$(DIRS)) ghc_407_at_least = $(shell expr "$(GhcMinVersion)" \>= 7) @@ -282,7 +282,7 @@ endif # We need -optC here because the driver before 3.02 didn't understand # the -funfolding flags. -utils/PrimPacked_HC_OPTS = -fvia-C -monly-3-regs -optC-funfolding-interface-threshold7 +utils/PrimPacked_HC_OPTS = -fvia-C -monly-3-regs -funfolding-interface-threshold7 # Strictness analyser misbehaving in 2.10, fails to terminate on # UpdAnal.lhs due to weird recursive datatype. Bug was exposed by a diff --git a/ghc/compiler/ghci/ByteCodeGen.lhs b/ghc/compiler/ghci/ByteCodeGen.lhs index b044538..f7b4c88 100644 --- a/ghc/compiler/ghci/ByteCodeGen.lhs +++ b/ghc/compiler/ghci/ByteCodeGen.lhs @@ -71,17 +71,21 @@ data BCInstr | PUSH_LL Int Int{-2 offsets-} | PUSH_LLL Int Int Int{-3 offsets-} | PUSH_G Name - | PUSH_AS Name -- push alts and BCO_ptr_ret_info - | PUSHT_I Int - | PUSHT_F Float - | PUSHT_D Double - | PUSHU_I Int - | PUSHU_F Float - | PUSHU_D Double + | PUSH_AS Name Int -- push alts and BCO_ptr_ret_info + -- Int is lit pool offset for itbl + | PUSH_LIT Int -- push literal word from offset pool + | PUSH_TAG Int -- push this tag on the stack + +-- | PUSHT_I Int +-- | PUSHT_F Float +-- | PUSHT_D Double +-- | PUSHU_I Int +-- | PUSHU_F Float +-- | PUSHU_D Double | SLIDE Int{-this many-} Int{-down by this much-} -- To do with the heap - | ALLOC Int - | MKAP Int{-place ptr to heap this far down stack-} Int{-# words-} + | ALLOC Int -- make an AP_UPD with this many payload words, zeroed + | MKAP Int{-ptr to AP_UPD is this far down stack-} Int{-# words-} | UNPACK Int -- unpack N ptr words from t.o.s Constr | UNPACK_I Int -- unpack and tag an Int, from t.o.s Constr @ offset | UNPACK_F Int -- unpack and tag a Float, from t.o.s Constr @ offset @@ -933,7 +937,7 @@ mkALit a -#include "../rts/Bytecodes.h" +#include "Bytecodes.h" i_ARGCHECK = (bci_ARGCHECK :: Int) i_PUSH_L = (bci_PUSH_L :: Int) diff --git a/ghc/compiler/ghci/StgInterp.lhs b/ghc/compiler/ghci/StgInterp.lhs index c69be22..ca48587 100644 --- a/ghc/compiler/ghci/StgInterp.lhs +++ b/ghc/compiler/ghci/StgInterp.lhs @@ -801,7 +801,10 @@ evalP (ConAppGen itbl args) de let c' = setDoubleOffClosure c off d# in c' `seq` loop c' (off +# 2#) as } -evalP (PrimOpP IntEqOp [e1,e2]) de = unsafeCoerce# (evalI e1 de ==# evalI e2 de) +evalP (PrimOpP IntEqOp [e1,e2]) de + = case evalI e1 de of + i1# -> case evalI e2 de of + i2# -> unsafeCoerce# (i1# ==# i2#) evalP (PrimOpP primop _) de = error ("evalP: unhandled primop: " ++ showSDoc (ppr primop)) diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs index d6769bc..07f717a 100644 --- a/ghc/compiler/main/HscMain.lhs +++ b/ghc/compiler/main/HscMain.lhs @@ -72,6 +72,7 @@ import Module ( Module, lookupModuleEnvByName ) import Monad ( when ) import Maybe ( isJust ) import IO +import List ( intersperse ) \end{code} @@ -372,7 +373,7 @@ myCoreToStg dflags this_mod tidy_binds -- thoroughout code generation --let bcos = byteCodeGen tidy_binds - --putStrLn (showSDoc (vcat (map ppr bcos))) + --putStrLn ("\n\n" ++ showSDocDebug (vcat (intersperse (char ' ') (map ppr bcos)))) -- _scc_ "Core2Stg" stg_binds <- coreToStg dflags this_mod tidy_binds diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs index a7adcdd..5786dec 100644 --- a/ghc/compiler/main/Main.hs +++ b/ghc/compiler/main/Main.hs @@ -1,6 +1,6 @@ -{-# OPTIONS -W -fno-warn-incomplete-patterns #-} +{-# OPTIONS -fno-warn-incomplete-patterns #-} ----------------------------------------------------------------------------- --- $Id: Main.hs,v 1.35 2000/11/24 17:09:52 simonmar Exp $ +-- $Id: Main.hs,v 1.36 2000/12/11 16:42:26 sewardj Exp $ -- -- GHC Driver program -- diff --git a/ghc/compiler/utils/Outputable.lhs b/ghc/compiler/utils/Outputable.lhs index 1c989b4..4ffb74d 100644 --- a/ghc/compiler/utils/Outputable.lhs +++ b/ghc/compiler/utils/Outputable.lhs @@ -7,9 +7,6 @@ Defines classes for pretty-printing and forcing, both forms of ``output.'' \begin{code} -{-# OPTIONS -fno-prune-tydecls #-} --- Hopefully temporary; 3.02 complained about not being able --- to see the consructors for ForeignObj module Outputable ( Outputable(..), -- Class diff --git a/ghc/compiler/utils/StringBuffer.lhs b/ghc/compiler/utils/StringBuffer.lhs index d776c5f..91ce638 100644 --- a/ghc/compiler/utils/StringBuffer.lhs +++ b/ghc/compiler/utils/StringBuffer.lhs @@ -6,7 +6,7 @@ Buffers for scanning string input stored in external arrays. \begin{code} -{-# OPTIONS -fno-prune-tydecls #-} + module StringBuffer ( StringBuffer, -- 1.7.10.4