Merge : re-applies missing part of fix for Bug 2901,Add export for s60ibymacros.pm
#!/usr/bin/perl
# Copyright (c) 2002-2009 Nokia Corporation and/or its subsidiary(-ies).
# All rights reserved.
# This component and the accompanying materials are made available
# under the terms of "Eclipse Public License v1.0"
# which accompanies this distribution, and is available
# at the URL "http://www.eclipse.org/legal/epl-v10.html".
#
# Initial Contributors:
# Nokia Corporation - initial contribution.
#
# Contributors:
#
# Description:
# e32toolp\e32util\h2inc.pl
# Convert structures in C++ include files to assembler format
# Syntax:
# perl h2inc.pl <input.h> <output.inc> <format>
# where <format>=arm or x86
#
#
# Version
my $MajorVersion = 1;
my $MinorVersion = 1;
my $PatchVersion = 0;
%basictypes = (
TInt8 => 1,
TUint8 => 1,
TInt16 => 2,
TUint16 => 2,
TInt32 => 4,
TUint32 => 4,
TInt => 4,
TUint => 4,
TInt64 => 8,
TUint64 => 8,
TLinAddr => 4,
TVersion => 4,
TPde => 4,
TPte => 4,
TProcessPriority => 4
);
if (scalar(@ARGV)!=3) {
die "H2INC format management tools V$MajorVersion.$MinorVersion.$PatchVersion\nperl h2inc.pl <input.h> <output.inc> <format>\n";
}
my ($infile, $outfile, $format) = @ARGV;
open IN, $infile or die "Can't open $infile for input\n";
my $in;
while (<IN>) {
$in.=$_;
}
close IN;
$format = uc($format);
$format_sub = undef();
$comment_sub = undef();
$end_sub = undef();
if ($format eq "ARMASM") {
$format_sub = \&armasm_format;
$comment_sub = \&armasm_comment;
$end_sub = \&armasm_end;
} elsif ($format eq "AS") {
$format_sub = \&as_format;
$comment_sub = \&as_comment;
$end_sub = \&as_end;
} elsif ($format eq "TASM") {
$format_sub = \&tasm_format;
$comment_sub = \&tasm_comment;
$end_sub = \&tasm_end;
} else {
die "Format $format unknown\nOnly ARMASM, AS or TASM supported\n";
}
# First remove any backslash-newline combinations
$in =~ s/\\\n//gms;
# Change escaped quotes to double quotes
$in =~ s/\\\"/\"\"/gms;
$in =~ s/\\\'/\'\'/gms;
# Remove any character constants
$in =~ s/\'(.?(${0})*?)\'//gms;
# Remove any string literals
$in =~ s/\"(.*?)\"//gms;
# Strip comments
$in =~ s/\/\*(.*?)\*\//\n/gms;
$in =~ s/\/\/(.*?)\n/\n/gms;
# Collapse whitespace into a single space or newline
$in =~ s/\t/\ /gms;
$in =~ s/\r/\ /gms;
$in =~ s/(\ )+/\ /gms;
$in =~ s/\n(\ )*/\n/gms;
$in =~ s/(\ )*\n/\n/gms;
# Tokenize on non-identifier characters
my @tokens0 = split(/(\W)/,$in);
my @tokens;
foreach $t (@tokens0) {
next if ($t eq " " or $t eq "");
push @tokens, $t;
}
my %macros;
my %filescope;
$filescope{file}=1;
$filescope{name}='*** FILE SCOPE ***';
my @ftypedefs;
$filescope{typedefs}=\@ftypedefs;
my $line=1;
parse_scope(\%filescope, \@tokens, \$line);
my @output;
push @output, &$comment_sub('*' x 80);
push @output, &$comment_sub($outfile);
push @output, &$comment_sub('*' x 80);
push @output, &$comment_sub("GENERATED FILE - DO NOT EDIT");
push @output, "";
output_scope(\%filescope, \@output);
push @output, &$end_sub();
push @output, "";
open OUT, ">$outfile" or die "Can't open $outfile for write\n";
print OUT join("\n", @output);
print OUT "\n\n";
close OUT;
sub get_token($$) {
my ($tokenlist,$line) = @_;
while (scalar(@$tokenlist)) {
my $t = shift @$tokenlist;
return $t if (!defined($t));
return $t if ($t !~ /^\s*$/);
++$$line;
}
}
sub skip_qualifiers($) {
my ($tokens) = @_;
my $f=0;
my %quals = (
EXPORT_C => 1,
IMPORT_C => 1,
inline => 1,
const => 0,
volatile => 0,
static => 0,
extern => 0,
LOCAL_C => 0,
LOCAL_D => 0,
GLDEF_C => 0,
GLREF_C => 0,
GLDEF_D => 0,
GLREF_D => 0
);
for (;;) {
my $t = $$tokens[0];
my $q = $quals{$t};
last unless (defined ($q));
$f |= $q;
shift @$tokens;
}
return $f;
}
sub parse_indirection($) {
my ($tokens) = @_;
my $level = 0;
for (;;) {
my $t = $$tokens[0];
if ($t eq '*') {
++$level;
shift @$tokens;
next;
}
last if ($t ne "const" and $t ne "volatile");
shift @$tokens;
}
return $level;
}
sub parse_scope($$$) {
my ($scope, $tokens, $line) = @_;
my $state = 0;
my %values;
my @classes;
my @enums;
my $curr_offset=0;
my $overall_align=0;
$scope->{values}=\%values;
$scope->{classes}=\@classes;
$scope->{enums}=\@enums;
while (scalar(@$tokens)) {
my $t = shift @$tokens;
if ($state>=-1 and $t eq "\n") {
++$$line;
$state=1;
next;
} elsif ($state==-1 and $t ne "\n") {
next;
} elsif ($state==-2 and $t ne ';') {
next;
}
if ($state>0 and $t eq '#') {
if ($scope->{scope}) {
warn "Preprocessor directive in class/struct at line $$line\n";
}
$t = shift @$tokens;
if ($t eq 'define') {
my $ident = shift @$tokens;
my $defn = shift @$tokens;
if ($defn ne '(') { # don't do macros with parameters
$macros{$ident} = $defn;
}
}
$state=-1; # skip to next line
next;
}
if ($t eq "struct" or $t eq "class") {
next if ($state==0);
$state=0;
my %cl;
$cl{specifier}=$t;
$cl{scope}=$scope;
my @members;
my @typedefs;
$cl{members}=\@members;
$cl{typedefs}=\@typedefs;
my $new_class = \%cl;
my $n = get_token($tokens,$line);
if ($n !~ /\w+/) {
die "Unnamed $t not supported at line $$line\n";
}
$new_class->{name}=$n;
my @class_match = grep {$_->{name} eq $n} @classes;
my $exists = scalar(@class_match);
my $b = get_token($tokens,$line);
if ($b eq ':') {
die "Inheritance not supported at line $$line\n";
} elsif ($b eq ';') {
# forward declaration
push @classes, $new_class unless ($exists);
next;
} elsif ($b ne '{') {
die "Syntax error at line $$line\n";
}
if ($exists) {
$new_class = $class_match[0];
if ($new_class->{complete}) {
die "Duplicate definition of $cl{specifier} $n\n";
}
}
push @classes, $new_class unless ($exists);
parse_scope($new_class, $tokens, $line);
next;
} elsif ($t eq "enum") {
$state=0;
my $n = get_token($tokens,$line);
my $name="";
if ($n =~ /\w+/) {
$name = $n;
$n = get_token($tokens,$line);
}
push @enums, $name;
if ($n ne '{') {
die "Syntax error at line $$line\n";
}
parse_enum($scope, $tokens, $line, $name);
next;
} elsif ($t eq '}') {
$state=0;
if ($scope->{scope}) {
$t = get_token($tokens,$line);
if ($t eq ';') {
$scope->{complete}=1;
last;
}
}
die "Syntax error at line $$line\n";
}
$state=0;
if ($scope->{scope}) {
if ($t eq "public" or $t eq "private" or $t eq "protected") {
if (shift (@$tokens) eq ':') {
next; # ignore access specifiers
}
die "Syntax error at line $$line\n";
}
}
unshift @$tokens, $t;
my @currdecl = parse_decl_def($scope, $tokens, $line);
if ($t eq 'static') {
next; # skip static members
}
my $typedef;
if ($t eq 'typedef') {
$typedef = 1;
$t = shift @currdecl;
$t = $currdecl[0];
} else {
$typedef = 0;
}
next if (scalar(@currdecl)==0);
if ($t eq "const") {
# check for constant declaration
my $ctype = lookup_type($scope, $currdecl[1]);
if ($ctype->{basic} and $currdecl[2]=~/^\w+$/ and $currdecl[3] eq '=') {
if ($typedef!=0) {
die "Syntax error at line $$line\n";
}
shift @currdecl;
shift @currdecl;
my $type = $ctype->{name};
my $name = shift @currdecl;
my $size = $ctype->{size};
shift @currdecl;
my $value = get_constant_expr($scope,\@currdecl,$line);
$values{$name} = {type=>$type, size=>$size, value=>$value};
next;
}
}
if (skip_qualifiers(\@currdecl)!=0 or ($scope->{file} and !$typedef)) {
next; # function declaration or stuff at file scope
}
my $type1 = shift @currdecl; # type, type pointed to or return type
if ($type1 !~ /^\w+$/) {
die "Syntax error at line $$line\n";
}
my $ind1 = parse_indirection(\@currdecl);
my $ident; # identifier being declared
my $size = -1;
my $array = -1;
my $align = 0;
my $alias;
my $category;
if ($currdecl[0] eq '(' and $currdecl[1] eq '*' and $currdecl[2]=~/^\w+$/) {
# function pointer
$ident = $currdecl[2];
$size = 4;
$category = 'fptr';
shift @currdecl;
shift @currdecl;
shift @currdecl;
} elsif ($currdecl[0]=~/^\w+$/) {
$ident = shift @currdecl;
if ($currdecl[0] ne '(') {
# not function declaration
if ($ind1>0) {
# pointer
$category = 'ptr';
$size = 4;
} else {
my $type2 = lookup_type($scope, $type1);
if (!defined($type2)) {
die "Unrecognised type $type1 at line $$line\n";
}
if ($type2->{basic}) {
$alias = $type2->{name};
$size = $type2->{size};
$category = 'basic';
} elsif ($type2->{enum}) {
$alias = $type2->{name};
$category = 'enum';
$size = 4;
} elsif ($type2->{class}) {
$alias = $type2->{name};
$size = $type2->{class}->{size};
$category = 'class';
$align = $type2->{class}->{align};
} elsif ($type->{ptr}) {
$size = 4;
$category = 'ptr';
$align = 4;
} elsif ($type->{fptr}) {
$size = 4;
$category = 'ptr';
$align = 4;
}
}
}
}
if ($size>0) {
# data member declared
# check for array
if ($currdecl[0] eq '[') {
shift @currdecl;
$array = get_constant_expr($scope, \@currdecl, $line);
if ($array<=0) {
die "Bad array size at line $$line\n";
}
if ($currdecl[0] ne ']') {
die "Syntax error at line $$line\n";
}
}
my $members = $scope->{members};
my $typedefs = $scope->{typedefs};
if ($align==0) {
$align = $size;
}
my $am = $align-1;
unless ($typedef) {
my $al = $curr_offset & $am;
if ($align==8 and $al!=0) {
die "Bad alignment of 64-bit data $ident at line $$line\n";
}
$curr_offset += ($align-$al) if ($al!=0);
}
if ($array>0) {
$size = ($size + $am) &~ $am;
if ($typedef) {
push @$typedefs, {name=>$ident, category=>$category, alias=>$alias, size=>$size*$array, spacing=>$size, array=>$array};
} else {
push @$members, {name=>$ident, size=>$size*$array, offset=>$curr_offset, spacing=>$size};
}
$size *= $array;
} else {
if ($typedef) {
push @$typedefs, {name=>$ident, category=>$category, alias=>$alias, size=>$size};
} else {
push @$members, {name=>$ident, size=>$size, offset=>$curr_offset};
}
}
unless ($typedef) {
$curr_offset += $size;
if ($align > $overall_align) {
$overall_align = $align;
}
}
}
}
if ($scope->{scope}) {
if ($state==-2) {
die "Missing ; at end of file\n";
}
if (!$scope->{complete}) {
die "Unexpected end of file at line $$line\n";
}
my $total_size = ($curr_offset + $overall_align - 1) &~ ($overall_align - 1);
$scope->{size} = $total_size;
$scope->{align} = $overall_align;
}
}
sub get_operand($$$) {
my ($scope,$tokens,$line) = @_;
my $t = get_token($tokens,$line);
if ($t eq '-') {
my $x = get_operand($scope,$tokens,$line);
return -$x;
} elsif ($t eq '+') {
my $x = get_operand($scope,$tokens,$line);
return $x;
} elsif ($t eq '~') {
my $x = get_operand($scope,$tokens,$line);
return ~$x;
} elsif ($t eq '!') {
my $x = get_operand($scope,$tokens,$line);
return $x ? 0 : 1;
} elsif ($t eq '(') {
my $x = get_constant_expr($scope,$tokens,$line);
my $t = get_token($tokens,$line);
if ($t ne ')') {
die "Missing ) at line $$line\n";
}
return $x;
} elsif ($t eq "sizeof") {
my $ident = get_token($tokens,$line);
if ($ident eq '(') {
$ident = get_token($tokens,$line);
my $cb = get_token($tokens,$line);
if ($cb ne ')') {
die "Bad sizeof() syntax at line $$line\n";
}
}
$ident = look_through_macros($ident);
if ($ident !~ /^\w+$/) {
die "Bad sizeof() syntax at line $$line\n";
}
my $type = lookup_type($scope, $ident);
if (!defined $type) {
die "Unrecognised type $ident at line $$line\n";
}
if ($type->{basic}) {
return $type->{size};
} elsif ($type->{enum}) {
return 4;
} elsif ($type->{ptr}) {
return 4;
} elsif ($type->{fptr}) {
return 4;
}
my $al = $type->{class}->{align};
my $sz = $type->{class}->{size};
return ($sz+$al-1)&~($al-1);
}
$t = look_through_macros($t);
if ($t =~ /^0x[0-9a-f]+/i) {
return oct($t);
} elsif ($t =~ /^\d/) {
return $t;
} elsif ($t =~ /^\w+$/) {
my $x = lookup_value($scope,$t);
die "Unrecognised identifier '$t' at line $$line\n" unless defined($x);
return $x;
} else {
die "Syntax error at line $$line\n";
}
}
sub look_through_macros($) {
my ($ident) = @_;
while ($ident and $macros{$ident}) {
$ident = $macros{$ident};
}
return $ident;
}
sub lookup_value($$) {
my ($scope,$ident) = @_;
while ($scope) {
my $vl = $scope->{values};
if (defined($vl->{$ident})) {
return $vl->{$ident}->{value};
}
$scope = $scope->{scope};
}
return undef();
}
sub lookup_type($$) {
my ($scope,$ident) = @_;
if ($basictypes{$ident}) {
return {scope=>$scope, basic=>1, name=>$ident, size=>$basictypes{$ident} };
}
while ($scope) {
if ($basictypes{$ident}) {
return {scope=>$scope, basic=>1, name=>$ident, size=>$basictypes{$ident} };
}
my $el = $scope->{enums};
my $cl = $scope->{classes};
my $td = $scope->{typedefs};
if (grep {$_ eq $ident} @$el) {
return {scope=>$scope, enum=>1, name=>$ident, size=>4 };
}
my @match_class = (grep {$_->{name} eq $ident} @$cl);
if (scalar(@match_class)) {
return {scope=>$scope, class=>$match_class[0]};
}
my @match_td = (grep {$_->{name} eq $ident} @$td);
if (scalar(@match_td)) {
my $tdr = $match_td[0];
my $cat = $tdr->{category};
if ($cat eq 'basic' or $cat eq 'enum' or $cat eq 'class') {
$ident = $tdr->{alias};
next;
} else {
return { scope=>$scope, $cat=>1, $size=>$tdr->{size} };
}
}
$scope = $scope->{scope};
}
return undef();
}
sub get_mult_expr($$$) {
my ($scope,$tokens,$line) = @_;
my $x = get_operand($scope,$tokens,$line);
my $t;
for (;;) {
$t = get_token($tokens,$line);
if ($t eq '*') {
my $y = get_operand($scope,$tokens,$line);
$x = $x * $y;
} elsif ($t eq '/') {
my $y = get_operand($scope,$tokens,$line);
$x = int($x / $y);
} elsif ($t eq '%') {
my $y = get_operand($scope,$tokens,$line);
$x = int($x % $y);
} else {
last;
}
}
unshift @$tokens, $t;
return $x;
}
sub get_add_expr($$$) {
my ($scope,$tokens,$line) = @_;
my $x = get_mult_expr($scope,$tokens,$line);
my $t;
for (;;) {
$t = get_token($tokens,$line);
if ($t eq '+') {
my $y = get_mult_expr($scope,$tokens,$line);
$x = $x + $y;
} elsif ($t eq '-') {
my $y = get_mult_expr($scope,$tokens,$line);
$x = $x - $y;
} else {
last;
}
}
unshift @$tokens, $t;
return $x;
}
sub get_shift_expr($$$) {
my ($scope,$tokens,$line) = @_;
my $x = get_add_expr($scope,$tokens,$line);
my $t, $t2;
for (;;) {
$t = get_token($tokens,$line);
if ($t eq '<' or $t eq '>') {
$t2 = get_token($tokens,$line);
if ($t2 ne $t) {
unshift @$tokens, $t2;
last;
}
}
if ($t eq '<') {
my $y = get_add_expr($scope,$tokens,$line);
$x = $x << $y;
} elsif ($t eq '>') {
my $y = get_add_expr($scope,$tokens,$line);
$x = $x >> $y;
} else {
last;
}
}
unshift @$tokens, $t;
return $x;
}
sub get_and_expr($$$) {
my ($scope,$tokens,$line) = @_;
my $x = get_shift_expr($scope,$tokens,$line);
my $t;
for (;;) {
$t = get_token($tokens,$line);
if ($t eq '&') {
my $y = get_shift_expr($scope,$tokens,$line);
$x = $x & $y;
} else {
last;
}
}
unshift @$tokens, $t;
return $x;
}
sub get_xor_expr($$$) {
my ($scope,$tokens,$line) = @_;
my $x = get_and_expr($scope,$tokens,$line);
my $t;
for (;;) {
$t = get_token($tokens,$line);
if ($t eq '^') {
my $y = get_and_expr($scope,$tokens,$line);
$x = $x ^ $y;
} else {
last;
}
}
unshift @$tokens, $t;
return $x;
}
sub get_ior_expr($$$) {
my ($scope,$tokens,$line) = @_;
my $x = get_xor_expr($scope,$tokens,$line);
my $t;
for (;;) {
$t = get_token($tokens,$line);
if ($t eq '|') {
my $y = get_xor_expr($scope,$tokens,$line);
$x = $x | $y;
} else {
last;
}
}
unshift @$tokens, $t;
return $x;
}
sub get_constant_expr($$$) {
my ($scope,$tokens,$line) = @_;
my $x = get_ior_expr($scope,$tokens,$line);
return $x;
}
sub parse_enum($$$$) {
my ($scope,$tokens,$line,$enum_name) = @_;
my $vl = $scope->{values};
my $x = 0;
for (;;) {
my $t = get_token($tokens,$line);
last if ($t eq '}');
if (!defined($t)) {
die "Unexpected end of file at line $$line\n";
}
if ($t !~ /^\w+$/) {
die "Syntax error at line $$line\n";
}
if (defined($vl->{$t})) {
die "Duplicate identifier at line $$line\n";
}
my $t2 = get_token($tokens,$line);
if ($t2 eq ',') {
$vl->{$t} = {type=>$enum_name, size=>4, value=>$x, enum=>1};
++$x;
} elsif ($t2 eq '}') {
$vl->{$t} = {type=>$enum_name, size=>4, value=>$x, enum=>1};
++$x;
last;
} elsif ($t2 eq '=') {
$x = get_constant_expr($scope, $tokens, $line);
$vl->{$t} = {type=>$enum_name, size=>4, value=>$x, enum=>1};
++$x;
$t2 = get_token($tokens,$line);
last if ($t2 eq '}');
next if ($t2 eq ',');
die "Syntax error at line $$line\n";
} else {
unshift @$tokens, $t2;
}
}
my $t = get_token($tokens,$line);
if ($t ne ';') {
die "Missing ; at line $$line\n";
}
}
sub parse_decl_def($$$) {
my ($scope,$tokens,$line) = @_;
my $level=0;
my @decl;
while ( scalar(@$tokens) ) {
my $t = get_token($tokens, $line);
if ($t eq ';' and $level==0) {
return @decl;
}
push @decl, $t;
if ($t eq '{') {
++$level;
}
if ($t eq '}') {
if ($level==0) {
die "Syntax error at line $$line\n";
}
if (--$level==0) {
return (); # end of function definition reached
}
}
}
die "Unexpected end of file at line $$line\n";
}
sub dump_scope($) {
my ($scope) = @_;
my $el = $scope->{enums};
my $cl = $scope->{classes};
my $vl = $scope->{values};
print "SCOPE: $scope->{name}\n";
if (scalar(@$el)) {
print "\tenums:\n";
foreach (@$el) {
print "\t\t$_\n";
}
}
if (scalar(keys(%$vl))) {
print "\tvalues:\n";
foreach $vname (keys(%$vl)) {
my $v = $vl->{$vname};
my $x = $v->{value};
my $t = $v->{type};
my $sz = $v->{size};
if ($v->{enum}) {
print "\t\t$vname\=$x (enum $t) size=$sz\n";
} else {
print "\t\t$vname\=$x (type $t) size=$sz\n";
}
}
}
if ($scope->{scope}) {
my $members = $scope->{members};
foreach (@$members) {
my $n = $_->{name};
my $sz = $_->{size};
my $off = $_->{offset};
my $spc = $_->{spacing};
if (defined $spc) {
print "\t$n\[\]\: spacing $spc size $sz offset $off\n";
} else {
print "\t$n\: size $sz offset $off\n";
}
}
print "\tOverall size : $scope->{size}\n";
print "\tOverall align: $scope->{align}\n";
}
foreach $s (@$cl) {
dump_scope($s);
}
}
sub output_scope($$) {
my ($scope, $out) = @_;
my $el = $scope->{enums};
my $cl = $scope->{classes};
my $vl = $scope->{values};
my $sn = scope_full_name($scope);
my $sp = ($scope->{file}) ? "" : $sn."_";
if ($scope->{file}) {
push @$out, "";
push @$out, &$comment_sub("FILE SCOPE");
push @$out, "";
} else {
push @$out, "";
push @$out, &$comment_sub($scope->{specifier}." ".$scope->{name});
push @$out, "";
}
if (scalar(keys(%$vl))) {
foreach $vname (keys(%$vl)) {
my $v = $vl->{$vname};
my $x = $v->{value};
my $t = $v->{type};
my $sz = $v->{size};
push @$out, &$format_sub($sp.$vname, $x);
}
}
if ($scope->{scope}) {
my $members = $scope->{members};
foreach (@$members) {
my $n = $_->{name};
my $sz = $_->{size};
my $off = $_->{offset};
my $spc = $_->{spacing};
push @$out, &$format_sub($sp.$n, $off);
if (defined $spc) {
push @$out, &$format_sub($sp.$n."_spc", $spc);
}
}
push @$out, &$format_sub($sp."sz", $scope->{size});
}
foreach $s (@$cl) {
if ($s->{complete}) {
output_scope($s, $out);
}
}
}
sub scope_full_name($) {
my ($scope) = @_;
if ($scope->{file}) {
return "";
}
my $parent = $scope->{scope};
if ($parent->{file}) {
return $scope->{name};
}
return scope_full_name($parent)."_".$scope->{name};
}
sub pad($$) {
my ($lineref, $n) = @_;
my $l = length ($$lineref);
if ($l < $n) {
$$lineref .= ' 'x($n-$l);
}
}
#
# Subroutines for ARMASM compatible output
#
sub armasm_format($$;$) {
my ($name, $value, $comment) = @_;
my $r = "$name ";
pad(\$r, 40);
$r .= sprintf("EQU 0x%08x", $value & 0xFFFFFFFF);
if ($comment and $comment!~/^\s*$/) {
$r .= " ";
pad(\$r, 60);
$r .= "; $comment";
}
return $r;
}
sub armasm_comment($) {
my ($comment) = @_;
return "; $comment";
}
sub armasm_end() {
return "\n\tEND\n";
}
#
# Subroutines for GNU AS compatible output
#
sub as_format($$;$) {
my ($name, $value, $comment) = @_;
my $r = " .equ $name, ";
pad(\$r, 50);
$r .= sprintf("0x%08x", $value & 0xFFFFFFFF);
if ($comment and $comment!~/^\s*$/) {
$r .= " ";
pad(\$r, 65);
$r .= "/* $comment */";
}
return $r;
}
sub as_comment($) {
my ($comment) = @_;
if (length ($comment) > 0) {
return "/* $comment */";
} else {
return "";
}
}
sub as_end() {
return "";
}
#
# Subroutines for Turbo Assembler compatible output
#
sub tasm_format($$;$) {
my ($name, $value, $comment) = @_;
my $r = "$name ";
pad(\$r, 40);
$r .= sprintf("EQU 0%08xh", $value & 0xFFFFFFFF);
if ($comment and $comment!~/^\s*$/) {
$r .= " ";
pad(\$r, 60);
$r .= "; $comment";
}
return $r;
}
sub tasm_comment($) {
my ($comment) = @_;
return "; $comment";
}
sub tasm_end() {
return "";
}