-pprAbsC sty (CSimultaneous abs_c) c
- = uppBesides [uppStr "{{", pprAbsC sty abs_c c, uppStr "}}"]
-
-pprAbsC sty stmt@(CMacroStmt macro as) _
- = uppBesides [uppStr (show macro), uppLparen,
- uppIntersperse uppComma (map (ppr_amode sty) as),pp_paren_semi] -- no casting
-pprAbsC sty stmt@(CCallProfCtrMacro op as) _
- = uppBesides [uppPStr op, uppLparen,
- uppIntersperse uppComma (map (ppr_amode sty) as),pp_paren_semi]
-pprAbsC sty stmt@(CCallProfCCMacro op as) _
- = uppBesides [uppPStr op, uppLparen,
- uppIntersperse uppComma (map (ppr_amode sty) as),pp_paren_semi]
-
-pprAbsC sty (CCodeBlock label abs_C) _
- = ASSERT( maybeToBool(nonemptyAbsC abs_C) )
+pprAbsC stmt@(CSRT lbl closures) c
+ = case (pprTempAndExternDecls stmt) of { (_, pp_exts) ->
+ pp_exts
+ $$ ptext SLIT("SRT") <> lparen <> pprCLabel lbl <> rparen
+ $$ nest 2 (hcat (punctuate comma (map pp_closure_lbl closures)))
+ <> ptext SLIT("};")
+ }
+
+pprAbsC stmt@(CBitmap lbl mask) c
+ = vcat [
+ hcat [ ptext SLIT("BITMAP"), lparen,
+ pprCLabel lbl, comma,
+ int (length mask),
+ rparen ],
+ hcat (punctuate comma (map (int.intBS) mask)),
+ ptext SLIT("}};")
+ ]
+
+pprAbsC (CSimultaneous abs_c) c
+ = hcat [ptext SLIT("{{"), pprAbsC abs_c c, ptext SLIT("}}")]
+
+pprAbsC (CCheck macro as code) c
+ = hcat [ptext (cCheckMacroText macro), lparen,
+ hcat (punctuate comma (map ppr_amode as)), comma,
+ pprAbsC code c, pp_paren_semi
+ ]
+pprAbsC (CMacroStmt macro as) _
+ = hcat [ptext (cStmtMacroText macro), lparen,
+ hcat (punctuate comma (map ppr_amode as)),pp_paren_semi] -- no casting
+pprAbsC (CCallProfCtrMacro op as) _
+ = hcat [ptext op, lparen,
+ hcat (punctuate comma (map ppr_amode as)),pp_paren_semi]
+pprAbsC (CCallProfCCMacro op as) _
+ = hcat [ptext op, lparen,
+ hcat (punctuate comma (map ppr_amode as)),pp_paren_semi]
+pprAbsC stmt@(CCallTypedef is_tdef (CCall op_str is_asm may_gc cconv) results args) _
+ = hsep [ ptext (if is_tdef then SLIT("typedef") else SLIT("extern"))
+ , ccall_res_ty
+ , fun_nm
+ , parens (hsep (punctuate comma ccall_decl_ty_args))
+ ] <> semi
+ where
+ {-
+ In the non-casm case, to ensure that we're entering the given external
+ entry point using the correct calling convention, we have to do the following:
+
+ - When entering via a function pointer (the `dynamic' case) using the specified
+ calling convention, we emit a typedefn declaration attributed with the
+ calling convention to use together with the result and parameter types we're
+ assuming. Coerce the function pointer to this type and go.
+
+ - to enter the function at a given code label, we emit an extern declaration
+ for the label here, stating the calling convention together with result and
+ argument types we're assuming.
+
+ The C compiler will hopefully use this extern declaration to good effect,
+ reporting any discrepancies between our extern decl and any other that
+ may be in scope.
+
+ Re: calling convention, notice that gcc (2.8.1 and egcs-1.0.2) will for
+ the external function `foo' use the calling convention of the first `foo'
+ prototype it encounters (nor does it complain about conflicting attribute
+ declarations). The consequence of this is that you cannot override the
+ calling convention of `foo' using an extern declaration (you'd have to use
+ a typedef), but why you would want to do such a thing in the first place
+ is totally beyond me.
+
+ ToDo: petition the gcc folks to add code to warn about conflicting attribute
+ declarations.
+
+ -}
+
+ fun_nm
+ | is_tdef = parens (text (callConvAttribute cconv) <+> char '*' <> ccall_fun_ty)
+ | otherwise = text (callConvAttribute cconv) <+> ccall_fun_ty
+
+ ccall_fun_ty =
+ case op_str of
+ DynamicTarget u -> ptext SLIT("_ccall_fun_ty") <> ppr u
+ StaticTarget x -> pprCLabelString x
+
+ ccall_res_ty =
+ case non_void_results of
+ [] -> ptext SLIT("void")
+ [amode] -> text (showPrimRep (getAmodeRep amode))
+ _ -> panic "pprAbsC{CCallTypedef}: ccall_res_ty"
+
+ ccall_decl_ty_args
+ | is_tdef = tail ccall_arg_tys
+ | otherwise = ccall_arg_tys
+
+ ccall_arg_tys = map (text.showPrimRep.getAmodeRep) non_void_args
+
+ -- the first argument will be the "I/O world" token (a VoidRep)
+ -- all others should be non-void
+ non_void_args =
+ let nvas = init args
+ in ASSERT (all non_void nvas) nvas
+
+ -- there will usually be two results: a (void) state which we
+ -- should ignore and a (possibly void) result.
+ non_void_results =
+ let nvrs = grab_non_void_amodes results
+ in ASSERT (length nvrs <= 1) nvrs
+
+pprAbsC (CCodeBlock lbl abs_C) _
+ = if not (maybeToBool(nonemptyAbsC abs_C)) then
+ pprTrace "pprAbsC: curious empty code block for" (pprCLabel lbl) empty
+ else