+On IA64, tail calls are converted to branches at this point. The mangler
+searches for function calls immediately followed by a '--- TAILCALL ---'
+token. Since the compiler can put various combinations of labels, bundling
+directives, nop instructions, stops, and a move of the return value
+between the branch and the tail call, proper matching of the tail call
+gets a little hairy. This subroutine does the mangling.
+
+Here is an example of a tail call before mangling:
+
+\begin{verbatim}
+ br.call.sptk.many b0 = b6
+.L211
+ ;;
+ .mmi
+ mov r1 = r32
+ ;;
+ nop.m 0
+ nop.i 0
+ ;;
+ --- TAILCALL --
+ ;;
+.L123
+\end{verbatim}
+
+\begin{code}
+sub ia64_mangle_tailcalls {
+ # Function input and output are in $c
+
+ # Construct the tailcall-mangling expression the first time this function
+ # is called.
+ if (!defined($IA64_MATCH_TAILCALL)) {
+ # One-line pattern matching constructs. None of these
+ # should bind references; all parenthesized terms
+ # should be (?:) terms.
+ my $stop = q/(?:\t;;\n)/;
+ my $bundle = q/(?:\t\.(?:mii|mib|mmi|mmb|mfi|mfb|mbb|bbb)\n)/;
+ my $nop = q/(?:\tnop(?:\.[mifb])?\s+\d+\n)/;
+ my $movgp = q/(?:\tmov r1 = r\d+\n)/;
+ my $postbr = q/(?:\tbr \.L\d+\n)/;
+
+ my $noeffect = "(?:$stop$bundle?|$nop)*";
+ my $postbundle = "(?:$bundle?$nop?$nop?$postbr)?";
+
+ # Important parts of the pattern match. The branch target
+ # and subsequent jump label are bound to $1 and $2
+ # respectively. Sometimes there is no label.
+ my $callbr = q/^\tbr\.call\.sptk\.many b0 = (.*)\n/;
+ my $label = q/(?:^\.L([0-9]*):\n)/;
+ my $tailcall = q/\t--- TAILCALL ---\n/;
+
+ $IA64_MATCH_TAILCALL =
+ $callbr . $label . '?' . $noeffect . $movgp . '?' . $noeffect .
+ $tailcall . $stop . '?' . '(?:' . $postbundle . ')?';
+ }
+
+ # Find and mangle tailcalls
+ while ($c =~ s/$IA64_MATCH_TAILCALL/\tbr\.few $1\n/om) {
+ # Eek, the gcc optimiser is getting smarter... if we see a jump to the
+ # --- TAILCALL --- marker then we reapply the substitution at the source sites
+ $c =~ s/^\tbr \.L$2\n/\t--- TAILCALL ---\n/gm if ($2);
+ }
+
+ # Verify that all instances of TAILCALL were processed
+ if ($c =~ /^\t--- TAILCALL ---\n/m) {
+ die "Unmangled TAILCALL tokens remain after mangling"
+ }
+}
+\end{code}
+
+The number of registers allocated on the IA64 register stack is set
+upon entry to the runtime with an `alloc' instruction at the entry
+point of \verb+StgRun()+. Gcc uses its own `alloc' to allocate
+however many registers it likes in each function. When we discard
+gcc's alloc, we have to reconcile its register assignment with what
+the STG uses.
+
+There are three stack areas: fixed registers, input/local registers,
+and output registers. We move the output registers to the output
+register space and leave the other registers where they are.
+
+\begin{code}
+sub ia64_rename_registers() {
+ # The text to be mangled is in $c
+ # Find number of registers in each stack area
+ my ($loc, $out) = @_;
+ my $cout;
+ my $first_out_reg;
+ my $regnum;
+ my $fragment;
+
+ # These are the register numbers used in the STG runtime
+ my $STG_FIRST_OUT_REG = 32 + 34;
+ my $STG_LAST_OUT_REG = $STG_FIRST_OUT_REG + 7;
+
+ $first_out_reg = 32 + $loc;
+
+ if ($first_out_reg > $STG_FIRST_OUT_REG) {
+ die "Too many local registers allocated by gcc";
+ }
+
+ # Split the string into fragments containing one register name each.
+ # Rename the register in each fragment and concatenate.
+ $cout = "";
+ foreach $fragment (split(/(?=r\d+[^a-zA-Z0-9_.])/sm, $c)) {
+ if ($fragment =~ /^r(\d+)((?:[^a-zA-Z0-9_.].*)?)$/sm) {
+ $regnum = $1;
+
+ if ($regnum < $first_out_reg) {
+ # This is a local or fixed register
+
+ # Local registers 32 and 33 (r64 and r65) are
+ # used to hold saved state; they shouldn't be touched
+ if ($regnum == 64 || $regnum == 65) {
+ die "Reserved register $regnum is in use";
+ }
+ }
+ else {
+ # This is an output register
+ $regnum = $regnum - $first_out_reg + $STG_FIRST_OUT_REG;
+ if ($regnum > $STG_LAST_OUT_REG) {
+ die "Register number ($regnum) is out of expected range";
+ }
+ }
+
+ # Update this fragment
+ $fragment = "r" . $regnum . $2;
+ }
+ $cout .= $fragment;
+ }
+
+ $c = $cout;
+}
+
+\end{code}
+