ghc/driver/ghc-asm-sgi.prl

   1 # line 10 "ghc-asm-sgi.lprl"
   2 sub mangle_asm {
   3
   4     local($in_asmf, $out_asmf) = @_;
   5     local($fun_code);
   6
   7     # multi-line regexp matching:
   8     local($*) = 1;
   9     local($i, $c);
  10     &init_FUNNY_THINGS();
  11
  12     open(INASM, "< $in_asmf")
  13         || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
  14     open(OUTASM,"> $out_asmf")
  15         || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
  16
  17     # just copy through now...
  18     while (<INASM>) {
  19         print OUTASM $_;
  20     }
  21
  22     close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
  23     close(INASM)  || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
  24 }
  25 # line 36 "ghc-asm-sgi.lprl"
  26 sub init_FUNNY_THINGS {
  27     print STDERR "SGI: init_FUNNY_THINGS\n";
  28 }
  29 # line 48 "ghc-asm-sgi.lprl"
  30 sub rev_tbl {
  31     local($symb, $tbl, $discard1) = @_;
  32
  33     local($before) = '';
  34     local($label) = '';
  35     local(@words) = ();
  36     local($after) = '';
  37     local(@lines) = split(/\n/, $tbl);
  38     local($i);
  39
  40     for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\t\.word\s+/; $i++) {
  41         $label .= $lines[$i] . "\n",
  42             next if $lines[$i] =~ /^[A-Za-z0-9_]+:$/
  43                  || $lines[$i] =~ /^\t\.global/;
  44
  45         $before .= $lines[$i] . "\n"; # otherwise...
  46     }
  47
  48     for ( ; $i <= $#lines && $lines[$i] =~ /^\t\.word\s+/; $i++) {
  49         push(@words, $lines[$i]);
  50     }
  51     # now throw away the first word (entry code):
  52     shift(@words) if $discard1;
  53
  54     for (; $i <= $#lines; $i++) {
  55         $after .= $lines[$i] . "\n";
  56     }
  57
  58     $tbl = $before . join("\n", (reverse @words)) . "\n" . $label . $after;
  59
  60 #    print STDERR "before=$before\n";
  61 #    print STDERR "label=$label\n";
  62 #    print STDERR "words=",(reverse @words),"\n";
  63 #    print STDERR "after=$after\n";
  64
  65     $tbl;
  66 }
  67 # line 88 "ghc-asm-sgi.lprl"
  68 # make "require"r happy...
  69 1;