+-- Lift StStrings out of top-level StDatas, putting them at the end of
+-- the block, and replacing them with StCLbls which refer to the lifted-out strings.
+{- Motivation for this hackery provided by the following bug:
+ Stix:
+ (DataSegment)
+ Bogon.ping_closure :
+ (Data P_ Addr.A#_static_info)
+ (Data StgAddr (Str `alalal'))
+ (Data P_ (0))
+ results in:
+ .data
+ .align 8
+ .global Bogon_ping_closure
+ Bogon_ping_closure:
+ .long Addr_Azh_static_info
+ .long .Ln1a8
+ .Ln1a8:
+ .byte 0x61
+ .byte 0x6C
+ .byte 0x61
+ .byte 0x6C
+ .byte 0x61
+ .byte 0x6C
+ .byte 0x00
+ .long 0
+ ie, the Str is planted in-line, when what we really meant was to place
+ a _reference_ to the string there. liftStrings will lift out all such
+ strings in top-level data and place them at the end of the block.
+
+ This is still a rather half-baked solution -- to do the job entirely right
+ would mean a complete traversal of all the Stixes, but there's currently no
+ real need for it, and it would be slow. Also, potentially there could be
+ literal types other than strings which need lifting out?
+-}
+
+liftStrings :: [StixStmt] -> UniqSM [StixStmt]
+liftStrings stmts
+ = liftStrings_wrk stmts [] []
+
+liftStrings_wrk :: [StixStmt] -- originals
+ -> [StixStmt] -- (reverse) originals with strings lifted out
+ -> [(CLabel, FastString)] -- lifted strs, and their new labels
+ -> UniqSM [StixStmt]
+
+-- First, examine the original trees and lift out strings in top-level StDatas.
+liftStrings_wrk (st:sts) acc_stix acc_strs
+ = case st of
+ StData sz datas
+ -> lift datas acc_strs `thenUs` \ (datas_done, acc_strs1) ->
+ liftStrings_wrk sts ((StData sz datas_done):acc_stix) acc_strs1
+ other
+ -> liftStrings_wrk sts (other:acc_stix) acc_strs
+ where
+ -- Handle a top-level StData
+ lift [] acc_strs = returnUs ([], acc_strs)
+ lift (d:ds) acc_strs
+ = lift ds acc_strs `thenUs` \ (ds_done, acc_strs1) ->
+ case d of
+ StString s
+ -> getUniqueUs `thenUs` \ unq ->
+ let lbl = mkAsmTempLabel unq in
+ returnUs ((StCLbl lbl):ds_done, ((lbl,s):acc_strs1))
+ other
+ -> returnUs (other:ds_done, acc_strs1)
+
+-- When we've run out of original trees, emit the lifted strings.
+liftStrings_wrk [] acc_stix acc_strs
+ = returnUs (reverse acc_stix ++ concatMap f acc_strs)
+ where
+ f (lbl,str) = [StSegment RoDataSegment,
+ StLabel lbl,
+ StDataString str,
+ StSegment TextSegment]
+\end{code}
+
+The NCG's monad.
+
+The monad keeps a UniqSupply, the current stack delta and
+a list of imported entities, which is only used for
+Darwin (Mac OS X).
+
+\begin{code}
+data NatM_State = NatM_State UniqSupply Int [FastString]