The Base Package Compiles

[Wolfgang Thaller]

Hi everyone,

I've got a shiny new libHSbase.a for Mac OS X on my hard now. Yipee!
In fact, GHC went right ahead and compiled the other packages, too 
(well, I didn't enable OpenGL or X11 or anything fancy).

Of course, the generated code is slightly bogus - I can't even link a 
program yet, because there are undefined references to some closures 
(well, to 2888 different closures, to be exact).

I had to make two more changes to the codeGen - diffs are attached.
Number one is in CgUtils.hs - mk_switch was _emitting_ some 
instructions, when it was just supposed to return them.
The second one is in CodeGen.hs; module_registered used to be generated 
as a rts data label, which was externally visible (but shouldn't be).

That's it for today. I've had some wine since I made the changes below, 
so I better don't touch any more code until I'm completely sober 
again...

Cheers,

Wolfgang


-- cut here --

Index: compiler/codeGen/CgUtils.hs
===================================================================
RCS file: /home/cvs/root/fptools/ghc/compiler/codeGen/Attic/CgUtils.hs,v
retrieving revision 1.1.2.22
diff -c -r1.1.2.22 CgUtils.hs
*** compiler/codeGen/CgUtils.hs	6 Feb 2004 15:13:09 -0000	1.1.2.22
--- compiler/codeGen/CgUtils.hs	10 Feb 2004 22:58:35 -0000
***************
*** 311,322 ****
   	; return (BasicBlock blk_id [switch_stmt] : deflt_blks ++ 
other_blocks) }

     | otherwise	-- Use an if-tree
!   = do	{ tag_expr' <- assignTemp tag_expr	-- To avoid duplication
   	; lo_blks <- mk_switch tag_expr' lo_branches mb_deflt lo_tag 
(mid_tag-1)
   	; hi_blks <- mk_switch tag_expr' hi_branches mb_deflt mid_tag hi_tag
   	; let cond = cmmULtWord tag_expr' (CmmLit (mkIntCLit mid_tag))
   	      branch_stmt = CmmCondBranch cond (getEntryIdB lo_blks)
! 	; return (consStmtB branch_stmt hi_blks ++ lo_blks) }
     where
       other_blocks = concat (map snd branches)
       use_switch 	 = ASSERT( n_branches > 1 && n_tags > 1 )
--- 311,323 ----
   	; return (BasicBlock blk_id [switch_stmt] : deflt_blks ++ 
other_blocks) }

     | otherwise	-- Use an if-tree
!   = do	{ (maybe_assign_tmp, tag_expr')
!                 <- assignTemp' tag_expr -- To avoid duplication
   	; lo_blks <- mk_switch tag_expr' lo_branches mb_deflt lo_tag 
(mid_tag-1)
   	; hi_blks <- mk_switch tag_expr' hi_branches mb_deflt mid_tag hi_tag
   	; let cond = cmmULtWord tag_expr' (CmmLit (mkIntCLit mid_tag))
   	      branch_stmt = CmmCondBranch cond (getEntryIdB lo_blks)
! 	; return (maybe_assign_tmp (consStmtB branch_stmt hi_blks) ++ 
lo_blks) }
     where
       other_blocks = concat (map snd branches)
       use_switch 	 = ASSERT( n_branches > 1 && n_tags > 1 )
***************
*** 357,362 ****
--- 358,369 ----

       jump_to_impossible
         = CmmJump (mkLblExpr (mkRtsCodeLabel SLIT("ImpossibleBranch"))) 
[]
+
+     assignTemp' e
+         | isTrivialCmmExpr e = return (id, e)
+         | otherwise          = do { reg <- newTemp (cmmExprRep e)
+                                   ; return (consStmtB (CmmAssign reg 
e),
+                                             CmmReg reg) }


   emitLitSwitch :: CmmExpr			-- Tag to switch on
Index: compiler/codeGen/CodeGen.lhs
===================================================================
RCS file: /home/cvs/root/fptools/ghc/compiler/codeGen/CodeGen.lhs,v
retrieving revision 1.58.2.5
diff -c -r1.58.2.5 CodeGen.lhs
*** compiler/codeGen/CodeGen.lhs	3 Feb 2004 22:47:03 -0000	1.58.2.5
--- compiler/codeGen/CodeGen.lhs	10 Feb 2004 22:58:36 -0000
***************
*** 34,40 ****
   import CgUtils		( cmmRegOffW, emitIf, emitDataLits, cmmEqWord )
   import CLabel		( mkSRTLabel, mkClosureLabel,
   			  mkPlainModuleInitLabel, mkModuleInitLabel,
! 			  mkRtsDataLabel )
   import Cmm
   import CmmUtils		( zeroCLit, mkIntCLit, mkLblExpr )
   import PprCmm		( pprCmms )
--- 34,40 ----
   import CgUtils		( cmmRegOffW, emitIf, emitDataLits, cmmEqWord )
   import CLabel		( mkSRTLabel, mkClosureLabel,
   			  mkPlainModuleInitLabel, mkModuleInitLabel,
! 			  mkRtsDataLabel, moduleRegdLabel )
   import Cmm
   import CmmUtils		( zeroCLit, mkIntCLit, mkLblExpr )
   import PprCmm		( pprCmms )
***************
*** 157,163 ****

   	-- Allocate the static boolean that records if this
   	-- module has been registered already
! 	; emitData Data [CmmDataLabel mod_reg_lbl,
   			 CmmStaticLit zeroCLit]

   	; emitSimpleProc real_init_lbl $ do
--- 157,163 ----

   	-- Allocate the static boolean that records if this
   	-- module has been registered already
! 	; emitData Data [CmmDataLabel moduleRegdLabel,
   			 CmmStaticLit zeroCLit]

   	; emitSimpleProc real_init_lbl $ do
***************
*** 195,206 ****

       jump_to_init = absC (CmmJump (mkLblExpr real_init_lbl) [])

!     mod_reg_lbl = mkRtsDataLabel SLIT("_module_registered")
!     mod_reg_val = CmmLoad (mkLblExpr mod_reg_lbl) wordRep

       mod_init_code = do
   	{ 	-- Set mod_reg to 1 to record that we've been here
! 	  absC (CmmStore (mkLblExpr mod_reg_lbl) (CmmLit (mkIntCLit 1)))

   		-- Now do local stuff
   	; registerForeignExports foreign_stubs
--- 195,205 ----

       jump_to_init = absC (CmmJump (mkLblExpr real_init_lbl) [])

!     mod_reg_val = CmmLoad (mkLblExpr moduleRegdLabel) wordRep

       mod_init_code = do
   	{ 	-- Set mod_reg to 1 to record that we've been here
! 	  absC (CmmStore (mkLblExpr moduleRegdLabel) (CmmLit (mkIntCLit 1)))

   		-- Now do local stuff
   	; registerForeignExports foreign_stubs