Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: b65a7d1cfb
Fetching contributors…

Cannot retrieve contributors at this time

247 lines (194 sloc) 5.913 kb
#! perl
# Copyright (C) 2004-2008, Parrot Foundation.
=head1 NAME
tools/build/c2str.pl
=head1 DESCRIPTION
constant string support
=cut
use warnings;
use strict;
use Fcntl qw( :DEFAULT :flock );
use IO::File ();
use lib 'lib';
use Parrot::BuildUtil;
my $outfile = 'all_cstring.str';
my $string_private_h = 'src/string/private_cstring.h';
# add read/write permissions even if we don't read/write the file
# for example, Solaris requires write permissions for exclusive locks
my $ALL = IO::File->new($outfile, O_CREAT | O_RDWR)
or die "Can't open '$outfile': $!\n";
flock( $ALL, LOCK_EX ) or die "Can't lock '$outfile': $!\n";
$ALL->seek(2, 0); # in case its been appended to while we waited for the lock
my ( $do_all, $do_init, $file );
$do_all = 1 if $ARGV[0] eq "--all";
$do_init = 1 if $ARGV[0] eq "--init";
$do_all and do {
read_all();
create_c_include();
exit;
};
$do_init and do {
close $ALL;
unlink $outfile;
exit;
};
$file = shift @ARGV;
$file =~ s/\.c$//;
my $infile = $file . '.c';
die "$0: $infile: $!" unless -e $infile;
my %known_strings;
my @all_strings;
read_all();
process_cfile();
# the literal length of the string in source code is NOT its length in C terms
sub get_length {
my $s = shift;
$s =~ s{\\x\d+}{.}g;
$s =~ s{\\.}{.}g;
return length $s;
}
sub read_all {
$ALL->seek(0, 0);
while (<$ALL>) {
# len hashval "string"
if (/(\d+)\s+"(.*)"/) {
push @all_strings, [ $1, $2 ];
$known_strings{$2} = @all_strings;
}
}
return;
}
sub process_cfile {
open my $IN, '<', $infile or die "Can't read '$infile': $!";
my $line = 0;
print <<"HEADER";
/* ex: set ro:
* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
*
* This file is generated automatically from '$infile'
* by $0.
*
* Any changes made here will be lost!
*
*/
/* HEADERIZER HFILE: none */
/* HEADERIZER STOP */
#define CONCAT(a,b) a##b
#define _CONST_STRING(i, l) (i)->const_cstring_table[CONCAT(_CONST_STRING_, l)]
#define CONST_STRING(i, s) _CONST_STRING(i, __LINE__)
#define CONST_STRING_GEN(i, s) _CONST_STRING_GEN(i, __LINE__)
#define _CONST_STRING_GEN(i, l) \\
(i)->const_cstring_table[CONCAT(_CONST_STRING_GEN_, l)]
HEADER
print $ALL "# $infile\n";
my %this_file_seen;
# NOTE: when CONST_STRING gets used it and any macro invocations
# that it is used in *should not* be split across more than one
# line, because some compilers generate line numbers in such cases
# differently from the way gcc does this (a case in point is
# Intel's C compiler, icc) and hence the #defined CONST_STRING
# won't be found by the compiler.
# There is a chance that the same __LINE__ will reoccur if #line directives
# are used.
my $prev_line;
my %lines_seen;
while (<$IN>) {
if (m/^\s*#\s*line\s+(\d+)/) {
# #line directive
$line = $1 - 1;
$prev_line = $_;
next;
}
$line++;
# otherwise ignore preprocessor
do { $prev_line = $_; next } if m/^\s*#/;
do { $prev_line = $_; next }
unless s/.*\bCONST_STRING(_GEN)?\s*\(\w+\s*,//;
my $const_string = defined $1 ? 'CONST_STRING_GEN' : 'CONST_STRING';
if ( $lines_seen{"$line:$const_string"}++ ) {
die "Seen line $line before in $infile - can't continue";
}
# semicolons, blank lines, opening braces, closing parens, #directives
# comments, labels, else keyword
if ($prev_line !~ /([{});:]|\*\/|\w+:|else)$/
&& $prev_line !~ /^\s*(#.*)?$/) {
die "CONST_STRING split across lines at $line in $infile\n";
}
my ($str) = m/^\s*"((?:\\"|[^"])*)"/;
## print STDERR "** '$str' $line\n";
my $n;
if ( $n = $known_strings{$str} ) {
if ( $this_file_seen{"$const_string:$str"} ) {
print "#define _${const_string}_$line _${const_string}_",
$this_file_seen{"$const_string:$str"}, "\n";
}
else {
print "#define _${const_string}_$line $n\n";
}
$this_file_seen{"$const_string:$str"} = $line;
$prev_line = $_;
next;
}
my $len = get_length($str);
push @all_strings, [ $len, $str ];
$n = @all_strings;
$known_strings{$str} = $n;
$this_file_seen{"$const_string:$str"} = $line;
print "#define _${const_string}_$line $n\n";
print $ALL qq!$len\t"$str"\n!;
}
close($IN);
return;
}
sub create_c_include {
open my $OUT, '>', $string_private_h
or die "Can't write '$string_private_h': $!";
add_to_generated($string_private_h, '[]', '');
print $OUT <<"HEADER";
/* ex: set ro:
* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
*
* This file is generated automatically from '$outfile'
* by $0.
*
* Any changes made here will be lost!
*
*/
/* HEADERIZER HFILE: none */
/* HEADERIZER STOP */
#ifndef PARROT_SRC_STRING_PRIVATE_CSTRING_H_GUARD
#define PARROT_SRC_STRING_PRIVATE_CSTRING_H_GUARD
static PARROT_OBSERVER const struct _cstrings {
UINTVAL len;
PARROT_OBSERVER const char *string;
} parrot_cstrings[] = {
{ 0, "" },
HEADER
my @all;
for my $s (@all_strings) {
push @all, qq! {$s->[0], "$s->[1]"}!;
}
print $OUT join( ",\n", @all );
print $OUT <<HEADER;
};
HEADER
# append the C code coda
print $OUT <<HEADER;
#endif /* PARROT_SRC_STRING_PRIVATE_CSTRING_H_GUARD */
/*
* Local variables:
* c-file-style: "parrot"
* buffer-read-only: t
* End:
* vim: expandtab shiftwidth=4:
*/
HEADER
close $OUT;
return;
}
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4:
Jump to Line
Something went wrong with that request. Please try again.