cgcc 10 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358
  1. #!/usr/bin/perl -w
  2. # -----------------------------------------------------------------------------
  3. use strict;
  4. use warnings;
  5. my $cc = $ENV{'REAL_CC'} || 'cc';
  6. my $check = $ENV{'CHECK'} || 'sparse';
  7. my $ccom = $cc;
  8. my $m32 = 0;
  9. my $m64 = 0;
  10. my $has_specs = 0;
  11. my $gendeps = 0;
  12. my $do_check = 0;
  13. my $do_compile = 1;
  14. my $gcc_base_dir;
  15. my $multiarch_dir;
  16. my $verbose = 0;
  17. my $nargs = 0;
  18. while (@ARGV) {
  19. $_ = shift(@ARGV);
  20. if ($nargs) {
  21. $nargs--;
  22. goto add_option;
  23. }
  24. # Look for a .c file. We don't want to run the checker on .o or .so files
  25. # in the link run.
  26. $do_check = 1 if /^[^-].*\.c$/;
  27. # Ditto for stdin.
  28. $do_check = 1 if $_ eq '-';
  29. if (/^-(o|MF|MT|MQ)$/) {
  30. # Need to be checked explicitly since otherwise
  31. # the argument would be processed as a
  32. # (non-existant) source file or as an option.
  33. die ("$0: missing argument for $_") if !@ARGV;
  34. $nargs = 1;
  35. }
  36. # Ignore the extension if '-x c' is given.
  37. if ($_ eq '-x') {
  38. die ("$0: missing argument for $_") if !@ARGV;
  39. die ("$0: invalid argument for $_") if $ARGV[0] ne 'c';
  40. $do_check = 1;
  41. $nargs = 1;
  42. }
  43. $m32 = 1 if /^-m32$/;
  44. $m64 = 1 if /^-m64$/;
  45. $gendeps = 1 if /^-(M|MM)$/;
  46. if (/^-target=(.*)$/) {
  47. $check .= &add_specs ($1);
  48. $has_specs = 1;
  49. next;
  50. }
  51. if ($_ eq '-no-compile') {
  52. $do_compile = 0;
  53. next;
  54. }
  55. if (/^-gcc-base-dir$/) {
  56. $gcc_base_dir = shift @ARGV;
  57. die ("$0: missing argument for -gcc-base-dir option") if !$gcc_base_dir;
  58. next;
  59. }
  60. if (/^-multiarch-dir$/) {
  61. $multiarch_dir = shift @ARGV;
  62. die ("$0: missing argument for -multiarch-dir option") if !$multiarch_dir;
  63. next;
  64. }
  65. # If someone adds "-E", don't pre-process twice.
  66. $do_compile = 0 if $_ eq '-E';
  67. $verbose = 1 if $_ eq '-v';
  68. add_option:
  69. my $this_arg = ' ' . &quote_arg ($_);
  70. $cc .= $this_arg unless &check_only_option ($_);
  71. $check .= $this_arg;
  72. }
  73. if ($gendeps) {
  74. $do_compile = 1;
  75. $do_check = 0;
  76. }
  77. if ($do_check) {
  78. if (!$has_specs) {
  79. $check .= &add_specs ('host_arch_specs');
  80. $check .= &add_specs ('host_os_specs');
  81. }
  82. $gcc_base_dir = qx($ccom -print-file-name=) if !$gcc_base_dir;
  83. chomp($gcc_base_dir); # possibly remove '\n' from compiler
  84. $check .= " -gcc-base-dir " . $gcc_base_dir if $gcc_base_dir;
  85. $multiarch_dir = qx($ccom -print-multiarch) if ! defined $multiarch_dir;
  86. chomp($multiarch_dir); # possibly remove '\n' from compiler
  87. $check .= " -multiarch-dir " . $multiarch_dir if $multiarch_dir;
  88. print "$check\n" if $verbose;
  89. if ($do_compile) {
  90. system ($check) == 0 or exit 1;
  91. } else {
  92. exec ($check);
  93. }
  94. }
  95. if ($do_compile) {
  96. print "$cc\n" if $verbose;
  97. exec ($cc);
  98. }
  99. exit 0;
  100. # -----------------------------------------------------------------------------
  101. # Check if an option is for "check" only.
  102. sub check_only_option {
  103. my ($arg) = @_;
  104. return 1 if $arg =~ /^-W(no-?)?(address-space|bitwise|cast-to-as|cast-truncate|constant-suffix|context|decl|default-bitfield-sign|designated-init|do-while|enum-mismatch|external-function-has-definition|init-cstring|memcpy-max-count|non-pointer-null|old-initializer|one-bit-signed-bitfield|override-init-all|paren-string|ptr-subtraction-blows|return-void|sizeof-bool|sparse-all|sparse-error|transparent-union|typesign|undef|unknown-attribute)$/;
  105. return 1 if $arg =~ /^-v(no-?)?(entry|dead)$/;
  106. return 1 if $arg =~ /^-f(dump-ir|memcpy-max-count|diagnostic-prefix)(=\S*)?$/;
  107. return 1 if $arg =~ /^-f(mem2reg|optim)(-enable|-disable|=last)?$/;
  108. return 1 if $arg =~ /^-msize-(long|llp64)$/;
  109. return 0;
  110. }
  111. # -----------------------------------------------------------------------------
  112. # Simple arg-quoting function. Just adds backslashes when needed.
  113. sub quote_arg {
  114. my ($arg) = @_;
  115. return "''" if $arg eq '';
  116. return join ('',
  117. map {
  118. m|^[-a-zA-Z0-9._/,=]+$| ? $_ : "\\" . $_;
  119. } (split (//, $arg)));
  120. }
  121. # -----------------------------------------------------------------------------
  122. sub float_types {
  123. my ($has_inf,$has_qnan,$dec_dig,@bitsizes) = @_;
  124. my $result = " -D__FLT_RADIX__=2";
  125. $result .= " -D__FINITE_MATH_ONLY__=" . ($has_inf || $has_qnan ? '0' : '1');
  126. $result .= " -D__DECIMAL_DIG__=$dec_dig";
  127. my %constants =
  128. (24 =>
  129. {
  130. 'MIN' => '1.17549435e-38',
  131. 'MAX' => '3.40282347e+38',
  132. 'EPSILON' => '1.19209290e-7',
  133. 'DENORM_MIN' => '1.40129846e-45',
  134. },
  135. 53 =>
  136. {
  137. 'MIN' => '2.2250738585072014e-308',
  138. 'MAX' => '1.7976931348623157e+308',
  139. 'EPSILON' => '2.2204460492503131e-16',
  140. 'DENORM_MIN' => '4.9406564584124654e-324',
  141. },
  142. 64 =>
  143. {
  144. 'MIN' => '3.36210314311209350626e-4932',
  145. 'MAX' => '1.18973149535723176502e+4932',
  146. 'EPSILON' => '1.08420217248550443401e-19',
  147. 'DENORM_MIN' => '3.64519953188247460253e-4951',
  148. },
  149. 113 =>
  150. {
  151. 'MIN' => '3.36210314311209350626267781732175260e-4932',
  152. 'MAX' => '1.18973149535723176508575932662800702e+4932',
  153. 'EPSILON' => '1.92592994438723585305597794258492732e-34',
  154. 'DENORM_MIN' => '6.47517511943802511092443895822764655e-4966',
  155. },
  156. );
  157. my @types = (['FLT','F'], ['DBL',''], ['LDBL','L']);
  158. while (@types) {
  159. my ($mant_bits,$exp_bits) = @{ shift @bitsizes };
  160. my ($name,$suffix) = @{ shift @types };
  161. my $h = $constants{$mant_bits};
  162. die "$0: weird number of mantissa bits." unless $h;
  163. my $mant_dig = int (($mant_bits - 1) * log (2) / log (10));
  164. my $max_exp = 1 << ($exp_bits - 1);
  165. my $min_exp = 3 - $max_exp;
  166. my $max_10_exp = int ($max_exp * log (2) / log (10));
  167. my $min_10_exp = -int (-$min_exp * log (2) / log (10));
  168. $result .= " -D__${name}_MANT_DIG__=$mant_bits";
  169. $result .= " -D__${name}_DIG__=$mant_dig";
  170. $result .= " -D__${name}_MIN_EXP__='($min_exp)'";
  171. $result .= " -D__${name}_MAX_EXP__=$max_exp";
  172. $result .= " -D__${name}_MIN_10_EXP__='($min_10_exp)'";
  173. $result .= " -D__${name}_MAX_10_EXP__=$max_10_exp";
  174. $result .= " -D__${name}_HAS_INFINITY__=" . ($has_inf ? '1' : '0');
  175. $result .= " -D__${name}_HAS_QUIET_NAN__=" . ($has_qnan ? '1' : '0');;
  176. foreach my $inf (sort keys %$h) {
  177. $result .= " -D__${name}_${inf}__=" . $h->{$inf} . $suffix;
  178. }
  179. }
  180. return $result;
  181. }
  182. # -----------------------------------------------------------------------------
  183. sub add_specs {
  184. my ($spec) = @_;
  185. if ($spec eq 'sunos') {
  186. return " --os=$spec" .
  187. ' -DSVR4=1' .
  188. ' -D__STDC__=0' .
  189. ' -D_REENTRANT' .
  190. ' -D_SOLARIS_THREADS' .
  191. ' -DNULL="((void *)0)"';
  192. } elsif ($spec eq 'linux') {
  193. return " --os=$spec";
  194. } elsif ($spec eq 'gnu/kfreebsd') {
  195. return &add_specs ('unix') .
  196. ' -D__FreeBSD_kernel__=1';
  197. } elsif ($spec eq 'openbsd') {
  198. return " --os=$spec";
  199. } elsif ($spec eq 'freebsd') {
  200. return " --os=$spec";
  201. } elsif ($spec eq 'netbsd') {
  202. return " --os=$spec";
  203. } elsif ($spec eq 'darwin') {
  204. return " --os=$spec";
  205. } elsif ($spec eq 'gnu') { # Hurd
  206. return &add_specs ('unix') . # So, GNU is Unix, uh?
  207. ' -D__GNU__=1 -D__gnu_hurd__=1 -D__MACH__=1';
  208. } elsif ($spec eq 'unix') {
  209. return ' -Dunix=1 -D__unix=1 -D__unix__=1';
  210. } elsif ( $spec =~ /^cygwin/) {
  211. return ' --os=cygwin';
  212. } elsif ($spec eq 'i386') {
  213. $m32 = 1;
  214. return (
  215. ' --arch=i386' .
  216. &float_types (1, 1, 21, [24,8], [53,11], [64,15]));
  217. } elsif ($spec eq 'sparc') {
  218. return (
  219. ' --arch=sparc' .
  220. &float_types (1, 1, 33, [24,8], [53,11], [113,15]));
  221. } elsif ($spec eq 'sparc64') {
  222. return (
  223. ' --arch=sparc64' .
  224. &float_types (1, 1, 33, [24,8], [53,11], [113,15]));
  225. } elsif ($spec eq 'x86_64') {
  226. return (' --arch=x86_64' .
  227. &float_types (1, 1, 33, [24,8], [53,11], [113,15]));
  228. } elsif ($spec eq 'ppc') {
  229. return (' --arch=ppc' .
  230. &float_types (1, 1, 21, [24,8], [53,11], [113,15]));
  231. } elsif ($spec eq 'ppc64') {
  232. return (
  233. ' --arch=ppc64' .
  234. &float_types (1, 1, 21, [24,8], [53,11], [113,15]));
  235. } elsif ($spec eq 'ppc64be') {
  236. return &add_specs ('ppc64') . ' -mbig-endian -D_CALL_ELF=1';
  237. } elsif ($spec eq 'ppc64le') {
  238. return &add_specs ('ppc64') . ' -mlittle-endian -D_CALL_ELF=2';
  239. } elsif ($spec eq 's390x') {
  240. return (' -D_BIG_ENDIAN' .
  241. ' --arch=s390x' .
  242. &float_types (1, 1, 36, [24,8], [53,11], [113,15]));
  243. } elsif ($spec eq 'riscv32') {
  244. return (' --arch=riscv32' .
  245. &float_types (1, 1, 33, [24,8], [53,11], [53,11]));
  246. } elsif ($spec eq 'riscv64') {
  247. return (' --arch=riscv64' .
  248. &float_types (1, 1, 33, [24,8], [53,11], [113,15]));
  249. } elsif ($spec eq 'arm') {
  250. return (' --arch=arm' .
  251. &float_types (1, 1, 36, [24,8], [53,11], [53, 11]));
  252. } elsif ($spec eq 'arm+hf') {
  253. return &add_specs ('arm') . ' -mfloat-abi=hard';
  254. } elsif ($spec eq 'aarch64') {
  255. return (' --arch=aarch64' .
  256. &float_types (1, 1, 36, [24,8], [53,11], [113,15]));
  257. } elsif ($spec eq 'host_os_specs') {
  258. my $os = `uname -s`;
  259. chomp $os;
  260. return &add_specs (lc $os);
  261. } elsif ($spec eq 'host_arch_specs') {
  262. my $gccmachine;
  263. my $arch;
  264. $gccmachine = `$ccom -dumpmachine`;
  265. chomp $gccmachine;
  266. if ($gccmachine =~ '^aarch64-') {
  267. return &add_specs ('aarch64');
  268. } elsif ($gccmachine =~ '^arm-.*eabihf$') {
  269. return &add_specs ('arm+hf');
  270. } elsif ($gccmachine =~ '^arm-') {
  271. return &add_specs ('arm');
  272. } elsif ($gccmachine =~ '^i[23456]86-') {
  273. return &add_specs ('i386');
  274. } elsif ($gccmachine =~ '^(powerpc|ppc)64le-') {
  275. return &add_specs ('ppc64le');
  276. } elsif ($gccmachine =~ '^s390x-') {
  277. return &add_specs ('s390x');
  278. } elsif ($gccmachine eq 'x86_64-linux-gnux32') {
  279. return &add_specs ('x86_64') . ' -mx32';
  280. } elsif ($gccmachine =~ '^x86_64-') {
  281. return &add_specs ('x86_64');
  282. }
  283. # fall back to uname -m to determine the specifics.
  284. # Note: this is only meaningful when using natively
  285. # since information about the host is used to
  286. # guess characteristics of the target.
  287. $arch = `uname -m`;
  288. chomp $arch;
  289. if ($arch =~ /^(i.?86|athlon)$/i) {
  290. return &add_specs ('i386');
  291. } elsif ($arch =~ /^(sun4u)$/i) {
  292. return &add_specs ('sparc');
  293. } elsif ($arch =~ /^(x86_64)$/i) {
  294. return &add_specs ('x86_64');
  295. } elsif ($arch =~ /^(ppc)$/i) {
  296. return &add_specs ('ppc');
  297. } elsif ($arch =~ /^(ppc64)$/i) {
  298. return &add_specs ('ppc64be');
  299. } elsif ($arch =~ /^(ppc64le)$/i) {
  300. return &add_specs ('ppc64le');
  301. } elsif ($arch =~ /^(s390x)$/i) {
  302. return &add_specs ('s390x');
  303. } elsif ($arch =~ /^(sparc64)$/i) {
  304. return &add_specs ('sparc64');
  305. } elsif ($arch =~ /^arm(?:v[78]l)?$/i) {
  306. return &add_specs ('arm');
  307. } elsif ($arch =~ /^(aarch64)$/i) {
  308. return &add_specs ('aarch64');
  309. }
  310. } else {
  311. die "$0: invalid specs: $spec\n";
  312. }
  313. }
  314. # -----------------------------------------------------------------------------