Skip to content
GitLab
Commit 33425381 authored by Pfeiffer, Götz's avatar Pfeiffer, Götz
Browse files

hgen.pl was extracted from bii_scripts, all tab characters were removed. 

This repository contains all patches of hgen.pl which was formerly a part of
bii_scripts. Patches before 2015-01-21 originally were patches in bii_scripts.

Additionally, with this patch all tab characters in hgen.pl have been removed.
parent 3e6402d6
Hide whitespace changes
Inline Side-by-side
bin/hgen.pl
View file @ 33425381
......@@ -131,7 +131,7 @@ if (defined $org_header)
{
unlink($org_header) || die "unable to remove $opt_header\n";
rename($opt_header,$org_header) ||
die "unable to rename $opt_header to $org_header\n";
die "unable to rename $opt_header to $org_header\n";
if (!$opt_quiet)
{ print "header generated: $opt_header\n"; };
};
......@@ -166,214 +166,214 @@ sub process_file
while(my $line=<$in>)
{
chomp($line);
if ($emit_flag>0)
{ $emit_flag--;
if (($emit_flag==0) && (defined $old_emit_flag))
{ $emit_flag= $old_emit_flag;
$old_emit_flag= undef;
};
};
$skip_emit=0;
$cmt_start= -1;
$in_string= 0;
print "IN----------|$line|\n" if ($dump_input);
for(;;)
{
chomp($line);
if ($emit_flag>0)
{ $emit_flag--;
if (($emit_flag==0) && (defined $old_emit_flag))
{ $emit_flag= $old_emit_flag;
$old_emit_flag= undef;
};
};
$skip_emit=0;
$cmt_start= -1;
$in_string= 0;
print "IN----------|$line|\n" if ($dump_input);
for(;;)
{
# scan for comment-starts:
if ($in_string)
{
if ($line=~ /\G.*?(\\\"|\")/g)
{ my $match= $1;
if ($match eq '\"') # quoted double-quote
{ next; }
elsif ($match eq '"') # double-quote
{ $in_string=0; next; }
else
{ die "internal error"; };
}
else
{ last; }; # leave for-loop
};
if ($in_comment==0)
if ($in_string)
{
if ($line=~ /\G.*?(\\\"|\")/g)
{ my $match= $1;
if ($match eq '\"') # quoted double-quote
{ next; }
elsif ($match eq '"') # double-quote
{ $in_string=0; next; }
else
{ die "internal error"; };
}
else
{ last; }; # leave for-loop
};
if ($in_comment==0)
{
if ($line=~ /\G.*?(\\"|"|\/\/|\/\*)/g)
{ my $match= $1;
if ($match eq '\"') # quoted double-quote
{ next; }
elsif ($match eq '"') # double-quote
{
$in_string=1; next;
}
elsif ($match eq '/*') # c-comment
{ $in_comment= 1;
$cmt_start= pos($line)-2;
next;
}
elsif ($match eq '//')
{ $in_comment= -1;
$cmt_start= pos($line)-2;
next;
}
else
{ die "internal error"; };
}
else
{ last; }; # leave for-loop
}
else
{
if ($line=~ /\G.*?(\\"|"|\/\/|\/\*)/g)
{ my $match= $1;
if ($match eq '\"') # quoted double-quote
{ next; }
elsif ($match eq '"') # double-quote
{
$in_string=1; next;
}
elsif ($match eq '/*') # c-comment
{ $in_comment= 1;
$cmt_start= pos($line)-2;
next;
}
elsif ($match eq '//')
{ $in_comment= -1;
$cmt_start= pos($line)-2;
next;
}
else
{ die "internal error"; };
}
else
{ last; }; # leave for-loop
}
else
{
# within comments, scan for commands in the form "@CCC"
# where C is an upper-case char
while ($line=~ /\G.*?(\*\/|\@(?:U|IL|EL|ITI|IT|ETI|ET|
EM|EXI|EX|PS|PE))/gx)
{
my $cmd = $1;
my $epos= pos($line)-1;
EM|EXI|EX|PS|PE))/gx)
{
my $cmd = $1;
my $epos= pos($line)-1;
my $mpos= pos($line)-length($cmd);
# ^^^ save match-position,
if ($cmd eq '*/') # comment-end found
{ if ($uncomment)
{ $old_emit_flag= undef;
$emit_flag= 1; $skip_emit=0;
my $pos= pos($line)-2;
substr($line,$pos,2)= "";
$uncomment=0;
};
$in_comment= 0;
last; # leave while-loop
}
elsif ($cmd eq '@PS')
{ if (!($line=~ /\G\((.*?)\)/gc))
{ die '@PS' . ": args missing\n"; };
my $arg= $1;
$epos= pos($line)-1; # save match-position
$found_parts{$arg}=1;
$active= check_part(\%wanted_parts,\%found_parts);
}
elsif ($cmd eq '@PE')
{ if (!($line=~ /\G\((.*?)\)/gc))
{ die '@PE' . ": args missing\n"; };
my $arg= $1;
$epos= pos($line)-1; # save match-position
$found_parts{$arg}=0;
$active= check_part(\%wanted_parts,\%found_parts);
}
elsif (!$active) # do not eval commands when not active
{ next; }
elsif ($cmd eq '@U')
{ substr($line,$mpos,$epos-$mpos+1)= "";
substr($line,$cmt_start,2)= "";
pos($line)= $cmt_start;
$uncomment=1;
$old_emit_flag= undef;
$emit_flag= -1; $skip_emit=0;
next;
}
elsif ($cmd eq '@IL')
{ $old_emit_flag= $emit_flag; $emit_flag= 1; }
elsif ($cmd eq '@EL')
{ $skip_emit= 1; }
elsif ($cmd eq '@IT')
{ $old_emit_flag= undef; $emit_flag= -1; $skip_emit=1; }
elsif ($cmd eq '@ITI')
{ $old_emit_flag= undef; $emit_flag= -1; $skip_emit=0; }
elsif ($cmd eq '@ET')
{ $old_emit_flag= undef; $emit_flag= 1; }
elsif ($cmd eq '@ETI')
{ $old_emit_flag= undef; $emit_flag= 0; }
elsif ($cmd eq '@EM')
{
if (!($line=~ /\G\(\"(.*?)\"\)/gc))
{ die '@EM' . ": args missing\n"; };
my $arg= $1;
# direct like my $arg= ($line=~....) doesn't set
# pos($line) correctly !!
$epos= pos($line)-1; # save match-position
emit(conv_text($arg),$active,$out);
}
elsif ($cmd=~ /^\@EX/)
{ my $immediate= ($cmd eq '@EXI');
my $arg= 1;
# support the old and the
# new style like '@EX' '@EX1' or '@EX(1)':
if ($cmd eq '*/') # comment-end found
{ if ($uncomment)
{ $old_emit_flag= undef;
$emit_flag= 1; $skip_emit=0;
my $pos= pos($line)-2;
substr($line,$pos,2)= "";
$uncomment=0;
};
$in_comment= 0;
last; # leave while-loop
}
elsif ($cmd eq '@PS')
{ if (!($line=~ /\G\((.*?)\)/gc))
{ die '@PS' . ": args missing\n"; };
my $arg= $1;
$epos= pos($line)-1; # save match-position
$found_parts{$arg}=1;
$active= check_part(\%wanted_parts,\%found_parts);
}
elsif ($cmd eq '@PE')
{ if (!($line=~ /\G\((.*?)\)/gc))
{ die '@PE' . ": args missing\n"; };
my $arg= $1;
$epos= pos($line)-1; # save match-position
$found_parts{$arg}=0;
$active= check_part(\%wanted_parts,\%found_parts);
}
elsif (!$active) # do not eval commands when not active
{ next; }
elsif ($cmd eq '@U')
{ substr($line,$mpos,$epos-$mpos+1)= "";
substr($line,$cmt_start,2)= "";
pos($line)= $cmt_start;
$uncomment=1;
$old_emit_flag= undef;
$emit_flag= -1; $skip_emit=0;
next;
}
elsif ($cmd eq '@IL')
{ $old_emit_flag= $emit_flag; $emit_flag= 1; }
elsif ($cmd eq '@EL')
{ $skip_emit= 1; }
elsif ($cmd eq '@IT')
{ $old_emit_flag= undef; $emit_flag= -1; $skip_emit=1; }
elsif ($cmd eq '@ITI')
{ $old_emit_flag= undef; $emit_flag= -1; $skip_emit=0; }
elsif ($cmd eq '@ET')
{ $old_emit_flag= undef; $emit_flag= 1; }
elsif ($cmd eq '@ETI')
{ $old_emit_flag= undef; $emit_flag= 0; }
elsif ($cmd eq '@EM')
{
if (!($line=~ /\G\(\"(.*?)\"\)/gc))
{ die '@EM' . ": args missing\n"; };
my $arg= $1;
# direct like my $arg= ($line=~....) doesn't set
# pos($line) correctly !!
$epos= pos($line)-1; # save match-position
emit(conv_text($arg),$active,$out);
}
elsif ($cmd=~ /^\@EX/)
{ my $immediate= ($cmd eq '@EXI');
my $arg= 1;
# support the old and the
# new style like '@EX' '@EX1' or '@EX(1)':
if ($line=~ /\G(\d+)/gc)
{ $arg= $1;
$epos= pos($line)-1; # save match-position
}
elsif ($line=~ /\G\((.*?)\)/gc)
{ $arg= $1;
$epos= pos($line)-1; # save match-position
};
$old_emit_flag= $emit_flag;
if ($immediate)
{ $emit_flag= $arg; $skip_emit=0; }
else
{ $arg= $1;
$epos= pos($line)-1; # save match-position
}
elsif ($line=~ /\G\((.*?)\)/gc)
{ $arg= $1;
$epos= pos($line)-1; # save match-position
};
$old_emit_flag= $emit_flag;
if ($immediate)
{ $emit_flag= $arg; $skip_emit=0; }
else
{ $emit_flag= $arg + 1; $skip_emit=1; };
$pre= "extern ";
$indent= length($pre);
$post= ';';
$postre= 's/=[^\)]+$//';
}
else
{ print STDERR "unknown command: $cmd\n"; };
# now remove the command from the string:
my $ch;
if ($epos>= length($line)-1)
{ $ch= undef; }
else
{ $ch= substr($line,$epos+1,1);
if (($ch eq '*') || ($ch eq '@'))
{ $ch= undef; };
};
if ($ch)
{ substr($line,$mpos,$epos-$mpos+1)=
$ch x ($epos-$mpos+1);
}
else
{ substr($line,$mpos,$epos-$mpos+1)= ""; };
pos($line)= $mpos;
}; # while ($line=~ /.../)
last; # no further commands and no comment-end
} # if ($in_comment==0) ... else ...
}; # for(;;)
# emit the line, if necessary
if ((!$skip_emit) && ($emit_flag!=0))
{ pos($line)=0;
$line=~ s/\/\*\s*?\*\///g;
$line=~ s/\/\/\s*$//;
$pre= "extern ";
$indent= length($pre);
$post= ';';
$postre= 's/=[^\)]+$//';
}
else
{ print STDERR "unknown command: $cmd\n"; };
# now remove the command from the string:
my $ch;
if ($epos>= length($line)-1)
{ $ch= undef; }
else
{ $ch= substr($line,$epos+1,1);
if (($ch eq '*') || ($ch eq '@'))
{ $ch= undef; };
};
if ($ch)
{ substr($line,$mpos,$epos-$mpos+1)=
$ch x ($epos-$mpos+1);
}
else
{ substr($line,$mpos,$epos-$mpos+1)= ""; };
pos($line)= $mpos;
}; # while ($line=~ /.../)
last; # no further commands and no comment-end
} # if ($in_comment==0) ... else ...
}; # for(;;)
# emit the line, if necessary
if ((!$skip_emit) && ($emit_flag!=0))
{ pos($line)=0;
$line=~ s/\/\*\s*?\*\///g;
$line=~ s/\/\/\s*$//;
$line=~ s/\s+$//;
if (($indent>0) && (!$pre))
{ $line= (" " x $indent) . $line; };
if (($indent>0) && (!$pre))
{ $line= (" " x $indent) . $line; };
if (($line) && ($pre))
{ $line= $pre . $line;
$pre= undef;
};
{ $line= $pre . $line;
$pre= undef;
};
if (($emit_flag==1) && ($post) && ($line))
# add_char && last line
{ # eval('$line=~ ' . $postre) if ($postre);
# the following is less generic but faster:
$line=~ s/=[^\)]+$//;
$postre= undef;
$line.= $post;
$post= undef;
};
if ($emit_flag==1)
{ $indent= 0; }; # remove indent
$line.= "\n";
emit($line,$active,$out); # if ($line);
};
# remove comment-status for C++ comments
if ($in_comment==-1)
{ $in_comment=0; };
{ # eval('$line=~ ' . $postre) if ($postre);
# the following is less generic but faster:
$line=~ s/=[^\)]+$//;
$postre= undef;
$line.= $post;
$post= undef;
};
if ($emit_flag==1)
{ $indent= 0; }; # remove indent
$line.= "\n";
emit($line,$active,$out); # if ($line);
};
# remove comment-status for C++ comments
if ($in_comment==-1)
{ $in_comment=0; };
};
}
......@@ -386,7 +386,7 @@ sub check_part
foreach my $key (keys %$r_current)
{ next if (!$r_current->{$key});
if ($r_wanted->{$key})
{ return(1); };
{ return(1); };
};
return(0);
}
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment