perl5.git.perl.org Git - perl5.git/blame_incremental

... / ...

Commit	Line	Data
	1	#!/usr/bin/perl -w
	2	# I'm assuming that you're running this on some kind of ASCII system, but
	3	# it will generate EBCDIC too. (TODO)
	4	use strict;
	5	use Encode;
	6	require 'regen/regen_lib.pl';
	7
	8	sub make_text {
	9	my ($chrmap, $letter, $unpredictable, $nocsum, $size, $condition) = @_;
	10	my $text = " /* $letter */ $size";
	11	$text .= " \| PACK_SIZE_UNPREDICTABLE" if $unpredictable;
	12	$text .= " \| PACK_SIZE_CANNOT_CSUM" if $nocsum;
	13	$text .= ",";
	14
	15	if ($condition) {
	16	$text = "#if $condition
	17	$text
	18	#else
	19	0,
	20	#endif";
	21	}
	22	return $text;
	23	}
	24
	25	sub make_tables {
	26	my %arrays;
	27
	28	my $chrmap = shift;
	29	foreach (@_) {
	30	my ($letter, $shriek, $unpredictable, $nocsum, $size, $condition) =
	31	/^([A-Za-z])(!?)\t(\S)\t(\S)\t([^\t\n]+)(?:\t+(.*))?$/ or
	32	die "Can't parse '$_'";
	33
	34	$size = "sizeof($size)" unless $size =~ s/^=//;
	35
	36	$arrays{$shriek ? 'shrieking' : 'normal'}{ord $chrmap->{$letter}} =
	37	make_text($chrmap, $letter,
	38	$unpredictable, $nocsum, $size, $condition);
	39	}
	40
	41	my $text = "STATIC const packprops_t packprops[512] = {\n";
	42	foreach my $arrayname (qw(normal shrieking)) {
	43	my $array = $arrays{$arrayname} \|\|
	44	die "No defined entries in $arrayname";
	45	$text .= " /* $arrayname */\n";
	46	for my $ch (0..255) {
	47	$text .= $array->{$ch} \|\| " 0,";
	48	$text .= "\n";
	49	}
	50	}
	51	# Join "0," entries together
	52	1 while $text =~ s/\b0,\s\n\s0,/0, 0,/g;
	53	# But split them up again if the sequence gets too long
	54	$text =~ s/((?:\b0, ){15}0,) /$1\n /g;
	55	# Clean up final ,
	56	$text =~ s/,$//;
	57	$text .= "};";
	58	return $text;
	59	}
	60
	61	my @lines = grep {
	62	s/#.*//;
	63	/\S/;
	64	} <DATA>;
	65
	66	my %asciimap = map {chr $_, chr $_} 0..255;
	67
	68	# Currently, all things generated by this on EBCDIC are alphabetics, whose
	69	# positions are all the same regardless of code page, so any EBCDIC encoding
	70	# will work; just choose one
	71	my %ebcdicmap = map {chr $_, Encode::encode("posix-bc", chr $_)} 0..255;
	72
	73	my $fh = open_new('packsizetables.c', '>', { by => $0, from => 'its data'});
	74
	75	print $fh <<"EOC";
	76	#if TYPE_IS_SHRIEKING != 0x100
	77	++++shriek offset should be 256
	78	#endif
	79
	80	typedef U8 packprops_t;
	81	#if 'J'-'I' == 1
	82	/* ASCII */
	83	@{[make_tables (\%asciimap, @lines)]}
	84	#else
	85	/* EBCDIC (or bust) */
	86	@{[make_tables (\%ebcdicmap, @lines)]}
	87	#endif
	88	EOC
	89
	90	read_only_bottom_close_and_rename($fh);
	91
	92	__DATA__
	93	#Symbol unpredictable
	94	# nocsum size
	95	c char
	96	C unsigned char
	97	W * unsigned char
	98	U * char
	99	s! short
	100	s =SIZE16
	101	S! unsigned short
	102	v =SIZE16
	103	n =SIZE16
	104	S =SIZE16
	105	v! =SIZE16
	106	n! =SIZE16
	107	i int
	108	i! int
	109	I unsigned int
	110	I! unsigned int
	111	j =IVSIZE
	112	J =UVSIZE
	113	l! long
	114	l =SIZE32
	115	L! unsigned long
	116	V =SIZE32
	117	N =SIZE32
	118	V! =SIZE32
	119	N! =SIZE32
	120	L =SIZE32
	121	p * char *
	122	w * * char
	123	q Quad_t IVSIZE >= 8
	124	Q Uquad_t IVSIZE >= 8
	125	f float
	126	d double
	127	F =NVSIZE
	128	D =LONG_DOUBLESIZE defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE)