pptok.pl 7.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272
  1. #!/usr/bin/perl
  2. ## --------------------------------------------------------------------------
  3. ##
  4. ## Copyright 1996-2009 The NASM Authors - All Rights Reserved
  5. ## See the file AUTHORS included with the NASM distribution for
  6. ## the specific copyright holders.
  7. ##
  8. ## Redistribution and use in source and binary forms, with or without
  9. ## modification, are permitted provided that the following
  10. ## conditions are met:
  11. ##
  12. ## * Redistributions of source code must retain the above copyright
  13. ## notice, this list of conditions and the following disclaimer.
  14. ## * Redistributions in binary form must reproduce the above
  15. ## copyright notice, this list of conditions and the following
  16. ## disclaimer in the documentation and/or other materials provided
  17. ## with the distribution.
  18. ##
  19. ## THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND
  20. ## CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
  21. ## INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
  22. ## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  23. ## DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
  24. ## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  25. ## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
  26. ## NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
  27. ## LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  28. ## HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
  29. ## CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
  30. ## OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
  31. ## EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  32. ##
  33. ## --------------------------------------------------------------------------
  34. #
  35. # Produce pptok.c, pptok.h and pptok.ph from pptok.dat
  36. #
  37. require 'phash.ph';
  38. my($what, $in, $out) = @ARGV;
  39. #
  40. # Read pptok.dat
  41. #
  42. open(IN, '<', $in) or die "$0: cannot open: $in\n";
  43. while (defined($line = <IN>)) {
  44. $line =~ s/\r?\n$//; # Remove trailing \r\n or \n
  45. $line =~ s/^\s+//; # Remove leading whitespace
  46. $line =~ s/\s*\#.*$//; # Remove comments and trailing whitespace
  47. next if ($line eq '');
  48. if ($line =~ /^\%(.*)\*$/) {
  49. push(@cctok, $1);
  50. } elsif ($line =~ /^\%(.*)$/) {
  51. push(@pptok, $1);
  52. } elsif ($line =~ /^\*(.*)$/) {
  53. push(@cond, $1);
  54. }
  55. }
  56. close(IN);
  57. @cctok = sort @cctok;
  58. @cond = sort @cond;
  59. @pptok = sort @pptok;
  60. # Generate the expanded list including conditionals. The conditionals
  61. # are at the beginning, padded to a power of 2, with the inverses
  62. # interspersed; this allows a simple mask to pick out the condition.
  63. while ((scalar @cond) & (scalar @cond)-1) {
  64. push(@cond, undef);
  65. }
  66. @cptok = ();
  67. foreach $ct (@cctok) {
  68. foreach $cc (@cond) {
  69. if (defined($cc)) {
  70. push(@cptok, $ct.$cc);
  71. push(@cptok, $ct.'n'.$cc);
  72. } else {
  73. push(@cptok, undef, undef);
  74. }
  75. }
  76. }
  77. $first_uncond = $pptok[0];
  78. @pptok = (@cptok, @pptok);
  79. open(OUT, '>', $out) or die "$0: cannot open: $out\n";
  80. #
  81. # Output pptok.h
  82. #
  83. if ($what eq 'h') {
  84. print OUT "/* Automatically generated from $in by $0 */\n";
  85. print OUT "/* Do not edit */\n";
  86. print OUT "\n";
  87. print OUT "enum preproc_token {\n";
  88. $n = 0;
  89. foreach $pt (@pptok) {
  90. if (defined($pt)) {
  91. printf OUT " %-16s = %3d,\n", "PP_\U$pt\E", $n;
  92. }
  93. $n++;
  94. }
  95. printf OUT " %-16s = %3d\n", 'PP_INVALID', -1;
  96. print OUT "};\n";
  97. print OUT "\n";
  98. print OUT "enum pp_conditional {\n";
  99. $n = 0;
  100. $c = '';
  101. foreach $cc (@cond) {
  102. if (defined($cc)) {
  103. printf OUT "$c %-16s = %3d", "PPC_IF\U$cc\E", $n;
  104. $c = ',';
  105. }
  106. $n += 2;
  107. }
  108. print OUT "\n};\n\n";
  109. printf OUT "#define PP_COND(x) ((enum pp_conditional)((x) & 0x%x))\n",
  110. (scalar(@cond)-1) << 1;
  111. print OUT "#define PP_IS_COND(x) ((unsigned int)(x) < PP_\U$first_uncond\E)\n";
  112. print OUT "#define PP_NEGATIVE(x) ((x) & 1)\n";
  113. print OUT "\n";
  114. foreach $ct (@cctok) {
  115. print OUT "#define CASE_PP_\U$ct\E";
  116. $pref = " \\\n";
  117. foreach $cc (@cond) {
  118. if (defined($cc)) {
  119. print OUT "$pref\tcase PP_\U${ct}${cc}\E: \\\n";
  120. print OUT "\tcase PP_\U${ct}N${cc}\E";
  121. $pref = ":\\\n";
  122. }
  123. }
  124. print OUT "\n"; # No colon or newline on the last one
  125. }
  126. }
  127. #
  128. # Output pptok.c
  129. #
  130. if ($what eq 'c') {
  131. print OUT "/* Automatically generated from $in by $0 */\n";
  132. print OUT "/* Do not edit */\n";
  133. print OUT "\n";
  134. my %tokens = ();
  135. my @tokendata = ();
  136. my $n = 0;
  137. foreach $pt (@pptok) {
  138. if (defined($pt)) {
  139. $tokens{'%'.$pt} = $n;
  140. if ($pt =~ /[\@\[\]\\_]/) {
  141. # Fail on characters which look like upper-case letters
  142. # to the quick-and-dirty downcasing in the prehash
  143. # (see below)
  144. die "$in: invalid character in token: $pt";
  145. }
  146. }
  147. $n++;
  148. }
  149. my @hashinfo = gen_perfect_hash(\%tokens);
  150. if (!@hashinfo) {
  151. die "$0: no hash found\n";
  152. }
  153. # Paranoia...
  154. verify_hash_table(\%tokens, \@hashinfo);
  155. ($n, $sv, $g) = @hashinfo;
  156. $sv2 = $sv+2;
  157. die if ($n & ($n-1));
  158. print OUT "#include \"compiler.h\"\n";
  159. print OUT "#include <ctype.h>\n";
  160. print OUT "#include \"nasmlib.h\"\n";
  161. print OUT "#include \"hashtbl.h\"\n";
  162. print OUT "#include \"preproc.h\"\n";
  163. print OUT "\n";
  164. # Note that this is global.
  165. printf OUT "const char * const pp_directives[%d] = {\n", scalar(@pptok);
  166. foreach $d (@pptok) {
  167. if (defined($d)) {
  168. print OUT " \"%$d\",\n";
  169. } else {
  170. print OUT " NULL,\n";
  171. }
  172. }
  173. print OUT "};\n";
  174. printf OUT "const uint8_t pp_directives_len[%d] = {\n", scalar(@pptok);
  175. foreach $d (@pptok) {
  176. printf OUT " %d,\n", defined($d) ? length($d)+1 : 0;
  177. }
  178. print OUT "};\n";
  179. print OUT "enum preproc_token pp_token_hash(const char *token)\n";
  180. print OUT "{\n";
  181. # Put a large value in unused slots. This makes it extremely unlikely
  182. # that any combination that involves unused slot will pass the range test.
  183. # This speeds up rejection of unrecognized tokens, i.e. identifiers.
  184. print OUT "#define UNUSED (65535/3)\n";
  185. print OUT " static const int16_t hash1[$n] = {\n";
  186. for ($i = 0; $i < $n; $i++) {
  187. my $h = ${$g}[$i*2+0];
  188. print OUT " ", defined($h) ? $h : 'UNUSED', ",\n";
  189. }
  190. print OUT " };\n";
  191. print OUT " static const int16_t hash2[$n] = {\n";
  192. for ($i = 0; $i < $n; $i++) {
  193. my $h = ${$g}[$i*2+1];
  194. print OUT " ", defined($h) ? $h : 'UNUSED', ",\n";
  195. }
  196. print OUT " };\n";
  197. print OUT " uint32_t k1, k2;\n";
  198. print OUT " uint64_t crc;\n";
  199. # For correct overflow behavior, "ix" should be unsigned of the same
  200. # width as the hash arrays.
  201. print OUT " uint16_t ix;\n";
  202. print OUT "\n";
  203. printf OUT " crc = crc64i(UINT64_C(0x%08x%08x), token);\n",
  204. $$sv[0], $$sv[1];
  205. print OUT " k1 = (uint32_t)crc;\n";
  206. print OUT " k2 = (uint32_t)(crc >> 32);\n";
  207. print OUT "\n";
  208. printf OUT " ix = hash1[k1 & 0x%x] + hash2[k2 & 0x%x];\n", $n-1, $n-1;
  209. printf OUT " if (ix >= %d)\n", scalar(@pptok);
  210. print OUT " return PP_INVALID;\n";
  211. print OUT "\n";
  212. print OUT " if (!pp_directives[ix] || nasm_stricmp(pp_directives[ix], token))\n";
  213. print OUT " return PP_INVALID;\n";
  214. print OUT "\n";
  215. print OUT " return ix;\n";
  216. print OUT "}\n";
  217. }
  218. #
  219. # Output pptok.ph
  220. #
  221. if ($what eq 'ph') {
  222. print OUT "# Automatically generated from $in by $0\n";
  223. print OUT "# Do not edit\n";
  224. print OUT "\n";
  225. print OUT "%pptok_hash = (\n";
  226. $n = 0;
  227. foreach $tok (@pptok) {
  228. if (defined($tok)) {
  229. printf OUT " '%%%s' => %d,\n", $tok, $n;
  230. }
  231. $n++;
  232. }
  233. print OUT ");\n";
  234. print OUT "1;\n";
  235. }