use v5.16.0; use strict; use warnings; BEGIN { unshift @INC, '.' } require './regen/regen_lib.pl'; require './regen/charset_translations.pl'; # Generates the EBCDIC translation tables that were formerly hard-coded into # utfebcdic.h my $out_fh = open_new('ebcdic_tables.h', '>', {style => '*', by => $0, }); sub output_table ($$;$) { my $table_ref = shift; my $name = shift; # Tables in hex easier to debug, but don't fit into 80 columns my $print_in_hex = shift // 1; die "Requres 256 entries in table $name, got @$table_ref" if @$table_ref != 256; print $out_fh "EXTCONST U8 $name\[\] = {\n"; my $column_numbers= "/*_0 _1 _2 _3 _4 _5 _6 _7 _8 _9 _A _B _C _D _E _F*/\n"; print $out_fh $column_numbers if $print_in_hex; for my $i (0 .. 255) { if ($print_in_hex) { # No row headings, so will fit in 80 cols. #printf $out_fh "/* %X_ */ ", $i / 16 if $i % 16 == 0; printf $out_fh "0x%02X", $table_ref->[$i]; } else { printf $out_fh "%4d", $table_ref->[$i]; } print $out_fh ",", if $i < 255; #print $out_fh ($i < 255) ? "," : " "; #printf $out_fh " /* %X_ */", $i / 16 if $print_in_hex && $i % 16 == 15; print $out_fh "\n" if $i % 16 == 15; } print $out_fh $column_numbers if $print_in_hex; print $out_fh "};\n\n"; } print $out_fh < 1 || ord $uc > 255) { $uc = "\N{LATIN SMALL LETTER Y WITH DIAERESIS}"; } $uc[$a2e[$i]] = $a2e[ord $uc]; } print $out_fh < 1 || ord $uc > 255; if ($lc ne $char) { $latin1_fold[$a2e[$i]] = $a2e[ord $lc]; } elsif ($uc ne $char) { $latin1_fold[$a2e[$i]] = $a2e[ord $uc]; } else { $latin1_fold[$a2e[$i]] = $a2e[$i]; } } print $out_fh < a; a => A, etc) in the 0-255 range. If no such equivalent, value is * the code point itself */ END output_table(\@latin1_fold, "PL_fold_latin1"); } print $out_fh get_conditional_compile_line_end(); } print $out_fh "\n#endif /* PERL_EBCDIC_TABLES_H_ */\n"; read_only_bottom_close_and_rename($out_fh);