mirror of
https://github.com/open-simh/simtools.git
synced 2026-01-22 02:25:35 +00:00
66e00b9900
Too much to list all, but includes (in no particular order): - Cleanup for 64-bit builds, MSVC warnings. - Structured help - Help file compiler. - Supports volsets, writes/create work. - Support for I18n in messages, help. - Makefiles. - Initialize volume/volset - Command line editing/history Builds and works on Linux and Windows (VS). Not recently built or tested on other platforms, but not intentinonally broken.
1189 lines
39 KiB
Perl
Executable File
1189 lines
39 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
|
|
# T. Litt March 2016
|
|
# Copyright (C) 2016 Timothe Litt
|
|
#
|
|
# Input from unmessage of VMS VAX message files, generated by
|
|
# ftp://ftp.decuserve.org/decus/vms/sig_tapes/vax88b1/meadows/unmessage/unmessage.exe
|
|
#
|
|
# Because these don't include the message severity (well, they
|
|
# do, but they're all 0 ("warning"), we also take a concatenated
|
|
# .h file of all the random definition files we can find.
|
|
# These are parsed for #defines that look interesting, and those
|
|
# are used to correct the severity code.
|
|
# The .h file must come first to have any effect.
|
|
#
|
|
# message vms_msgdefs.h ods2.msg vms_msgdump.msg ssdef.h
|
|
#
|
|
# Also include the message file for ODS2 itself, as that simplifes
|
|
# generating its message catalog.
|
|
#
|
|
# Currently, the useful VMS messages have been reconstructed into
|
|
# vms_messages.msg (by this utility); that file + ods2.msg are the
|
|
# only files necessary to rebuild the english language version of
|
|
# ODS2. The long procedure (documented in the output file) is only
|
|
# useful if you need to refresh the VMS-sourced messages, e.g.
|
|
# for an I18n translation.
|
|
|
|
our $VERSION = 0.1;
|
|
|
|
use warnings;
|
|
use strict;
|
|
|
|
use File::Copy qw(move);
|
|
|
|
use Getopt::Std;
|
|
$Getopt::Std::STANDARD_HELP_VERSION = 1;
|
|
|
|
# Facilities of interest
|
|
|
|
my %wanted = map { $_ => 1} (qw/DISM$ INIT$ MOUNT$ RMS$ SHR$ SS$ SYSTEM$/,
|
|
qw/COPY CREATE DELETE DIFF DIRECT DISM EXTEND/,
|
|
qw/HELP INIT IO MOUNT ODS2 RENAME SEARCH SHR TYPE/);
|
|
# Symbols NOT of interest
|
|
# These are known to have no text message for various reasons.
|
|
|
|
my %ign = map { $_ => 1 } (
|
|
qw/SS$_CONTINUE SS$_WASCLR SS$_WASSET/, # Overlaid codes
|
|
qw/SS$_NOPRIVSTRT SS$_NOPRIVEND SS$_EXQUOTASTRT SS$_EXQUOTAEND/,
|
|
qw/SS$_SYSAPMAX SS$_SYSAPMIN/ # Range markers
|
|
);
|
|
|
|
our( $opt_b, $opt_h, $opt_m, $opt_q, $opt_t );
|
|
|
|
my $argv = join( ' ', @ARGV );
|
|
|
|
getopts( 'bhqmt' );
|
|
|
|
if( $opt_h ) {
|
|
print( << 'HELP' );
|
|
message [-hmq] in out
|
|
|
|
in and out default to "-".
|
|
|
|
in is any mixture of .h and .msg files.
|
|
|
|
out will be a .h or .msg, the old version will be .bak or .bak.n.
|
|
|
|
CAUTION: if more than one file is specified, the last file will be
|
|
over-written. Use -b.
|
|
|
|
options:
|
|
-b backup output file to .bak (or .bak.n)
|
|
-h this message
|
|
-m generate a reconstructed .msg file
|
|
-q Suppress informational messages
|
|
-t Include text in .h output
|
|
|
|
HELP
|
|
|
|
exit;
|
|
}
|
|
|
|
my( $in, $out ) = ( \*STDIN, \*STDOUT );
|
|
my $infile = '-';
|
|
my $at;
|
|
|
|
my %symtab = ( fac => { name => {}, num => {}, }, # Facility name <=> number
|
|
msgno => {}, # By message number
|
|
name => {}, # By name
|
|
literals => {}, # Unresolved literal expressions
|
|
);
|
|
|
|
my $facname;
|
|
my $facno = 0;
|
|
my $sharedfac = 0;
|
|
my $sysfac = '';
|
|
my $nextmsgno = 1;
|
|
my $defsev;
|
|
|
|
# Magic numbers in condition codes:
|
|
#
|
|
# F000 0000 - Control bits, ignored here
|
|
# 0800 0000 - Customer-assigned code (not /SYSTEM, no $)
|
|
# 07FF 0000 - Facility number [0-2047]
|
|
# 0000 8000 - Message is facility-specific (not /SHARED)
|
|
# 0000 7FFC - Message number [0-4095) (without facility-specific bit)
|
|
# 0000 0007 - Message severity code
|
|
#
|
|
# Within the DEC-controlled shared message space:
|
|
# 4096 - 8191 - Shared message numbers (SHR$ prefix, facility 0, no severity encoded)
|
|
# 0 - 4095, 8192 - 32767 - System service message number (SS$ prefix, facility 0)
|
|
# - Note that >= 32768 for facility 0 are unshared, SYSTEM$ prefix, facility 0)
|
|
#
|
|
# Deviations from VMS Message:
|
|
#
|
|
# - Continuation lines are not implemented,
|
|
#
|
|
# - /PREFIX not supported - instead, the SYSTEM facility is treated as three separate
|
|
# facilities: SS, SHR and SYSTEM
|
|
#
|
|
# - .LITERAL supports limited syntax:
|
|
# only symbol = expression
|
|
# no right shift
|
|
# Perl operators not detected, Perl precedence used.
|
|
#
|
|
# - MESSAGE generates foo$_ FACILITY, even for customer facilities. message generates
|
|
# foo_FACILITY for customer facilities; this enables MOUNT$ and MOUNT to co-exist.
|
|
#
|
|
# - Convention for SHR_foo is to encode severity by adding SHR_{WARN,SUCCESS,ERROR,INFO,SEVERE}
|
|
# where used. (e.g. .LITERAL FAC_foo = (FAC_FACILITY@16) + SHR_foo + SHR_SUCCESS
|
|
#
|
|
|
|
|
|
# Severity codes as input (includes abbreviations)
|
|
|
|
my %sev = ( warning => 0, warn => 0,
|
|
success => 1,
|
|
error => 2,
|
|
info => 3, informational => 3,
|
|
severe => 4, fatal => 4 );
|
|
|
|
# Severity codes as output
|
|
|
|
my %sevnam = reverse ( warning => 0, success => 1, error => 2,
|
|
info => 3, severe => 4, fatal => 4,
|
|
undef5 => 5, undef6 => 6, undef7 => 7 );
|
|
|
|
# Select output file, backing up output if requested
|
|
|
|
if( @ARGV > 1 ) {
|
|
if( $ARGV[-1] ne '-' ) {
|
|
if( $opt_b && -f $ARGV[-1] ) {
|
|
my( $fn, $bak, $n ) = ( $ARGV[-1], '', 0 );
|
|
while( -f ($fn . $bak) ) {
|
|
$bak = '.bak';
|
|
$bak .= '.' . $n if( $n );
|
|
++$n;
|
|
}
|
|
if( move( $ARGV[-1], $fn . $bak ) ) {
|
|
print STDERR ( "Saved $ARGV[-1] as $fn$bak\n" ) unless( $opt_q );
|
|
} else {
|
|
print STDER( "Can't backup $ARGV[-1]: $!\n" );
|
|
exit;
|
|
}
|
|
}
|
|
if( !open( $out, '>', $ARGV[-1] ) ) {
|
|
print STDERR ( "Cant open $ARGV[-1]: $!\n" );
|
|
exit;
|
|
}
|
|
}
|
|
pop @ARGV;
|
|
}
|
|
|
|
# Read each input file
|
|
|
|
do {
|
|
if( @ARGV ) {
|
|
if( $ARGV[0] ne "-" ) {
|
|
undef $in;
|
|
if( !open( $in, '<', $ARGV[0] ) ) {
|
|
print STDERR ( "Cant open $ARGV[0]: $!\n" );
|
|
exit;
|
|
}
|
|
$infile = $ARGV[0];
|
|
print STDERR ( "Processing $infile\n" ) unless( $opt_q );
|
|
}
|
|
shift @ARGV;
|
|
}
|
|
|
|
while( <$in> ) {
|
|
s/\r//g;
|
|
chomp;
|
|
|
|
$at = sprintf( "at line %u of %s\n", $., $infile );
|
|
|
|
# Facility names are the portion of a symbol name before
|
|
# the first '_'. Those ending in '$' are 'system" (DEC) facilities.
|
|
# Others are customer-defined facilities.
|
|
#
|
|
# Process #define foo$_FACILITY and foo$_anything else.
|
|
# This includes things that are not messages (such as item codes)
|
|
# but those won't be used. Toss unwanted facilities.
|
|
#
|
|
# Only #define FOO$?_BAR n lines are recognized. n can be a simple
|
|
# decimal, octal or hex constant.
|
|
#
|
|
# Because decompiled message.exe files don't contain symbol or
|
|
# severity information, the #defines pre-populate the symbol table.
|
|
|
|
if( !defined($facname) &&
|
|
m/^\s*#\s*define\s*(((\w+?)([\$]?))_(\w+))\s+((?i:0x)?[[:xdigit:]]+)/ ) {
|
|
my( $symname, $facid, $facname, $factype, $id, $val ) =
|
|
( $1, $2, $3, $4, $5, $6 );
|
|
|
|
next if( $ign{$symname} || !$wanted{$facid} );
|
|
|
|
if( $val =~ /^0/ ) {
|
|
$val = oct( $val );
|
|
} else {
|
|
$val = 0+$val;
|
|
}
|
|
|
|
if( $id eq 'FACILITY' ) {
|
|
$symtab{fac}{name}{$facid} = $val;
|
|
$symtab{fac}{num}{$val} = $facid;
|
|
} else {
|
|
# Exact forward and reverse entries.
|
|
# Tentative entry for fuzzy lookup
|
|
|
|
$symtab{name}{$symname}{val} = $val;
|
|
$symtab{msgno}{$val}{exact} = $symname;
|
|
my $msgno = $val & 0x0FFFFFF8;
|
|
$symtab{msgno}{$msgno}{default}{sev} = $val & 0x7;
|
|
$symtab{msgno}{$msgno}{default}{sym} = $symname;
|
|
$symtab{msgno}{$msgno}{default}{fac} = $facid;
|
|
$symtab{msgno}{$msgno}{default}{ft} = $factype;
|
|
}
|
|
|
|
next;
|
|
}
|
|
|
|
# Process message compiler directives. These don't look like
|
|
# anything that might be found in a .h file, so there's no test
|
|
# for file type. Only process data between .FACILITY and .END
|
|
# This is a subset of the VMS Message language.
|
|
|
|
# Blank and comment lines
|
|
|
|
next if( m/^\s*(?:!.*)?$/ );
|
|
|
|
if( s{^\s*\.FACILITY\s+([^,]+),\s*([^\s/]+)}{}i ) {
|
|
$facname = uc $1;
|
|
$facno = decodenum( $2, '.FACILITY' );
|
|
unless( defined $facno ) {
|
|
undef $facname;
|
|
next;
|
|
}
|
|
if( $facno >= 2048 ) {
|
|
print STDERR ("$facname facility number ($facno) is too big $at" );
|
|
undef $facname;
|
|
next;
|
|
}
|
|
if( s,/SHARED,,i ) {
|
|
$sharedfac = 1;
|
|
} else {
|
|
$sharedfac = 0;
|
|
}
|
|
if( s,/SYSTEM,,i ) {
|
|
$sysfac = '$';
|
|
} else {
|
|
$sysfac = '';
|
|
}
|
|
s/\s*!.*$//;
|
|
s/\s+//g;
|
|
|
|
if( length ) {
|
|
print STDERR ( "Unrecognized .FACILITY directive content '$_' for $facname $at\n" );
|
|
}
|
|
$facno |= 0x0800 unless( $sysfac );
|
|
|
|
my @fac = ( $facname );
|
|
push @fac, ( qw/SS SHR/ ) if( $sysfac &&
|
|
( $facname eq 'SYSTEM' ||
|
|
$facname eq 'SHR' ) );
|
|
foreach my $fac (@fac ) {
|
|
my $facid = $fac . $sysfac;
|
|
if( $wanted{$facid} ) {
|
|
$symtab{fac}{name}{$facid} = $facno;
|
|
$symtab{fac}{num}{$facno} = $facid;
|
|
} elsif( !$opt_q ) {
|
|
printf STDERR ( ".FACILITY %s is not wanted, will not process $at", $facid );
|
|
}
|
|
}
|
|
$nextmsgno = 1;
|
|
undef $defsev;
|
|
next;
|
|
}
|
|
|
|
if( defined($facname) && m/^\s*\.END\b/i ) {
|
|
undef $facname;
|
|
next;
|
|
}
|
|
next unless( defined $facname && $wanted{$facname.$sysfac} );
|
|
|
|
if( m/^\s*\.IDENT\b.*$/i ) {
|
|
next;
|
|
}
|
|
|
|
if( m/^\s*\.PAGE\b.*$/i ) {
|
|
next;
|
|
}
|
|
|
|
if( m/^\s*\.TITLE\b.*$/i ) {
|
|
next;
|
|
}
|
|
|
|
if( s/^\s*\.BASE\s+(\S+)//i ) {
|
|
$nextmsgno = decodenum( $1, '.BASE' );
|
|
unless( defined $nextmsgno ) {
|
|
undef $facname;
|
|
next;
|
|
}
|
|
if( $nextmsgno > 4095 ) {
|
|
undef $facname;
|
|
printf STDERR ("Message number too big for .BASE $at");
|
|
next;
|
|
}
|
|
s/\s*!.*$//;
|
|
s/\s+//g;
|
|
if( length ) {
|
|
printf STDERR ("Unrecognized content in .BASE directive $at");
|
|
undef $facname;
|
|
next;
|
|
}
|
|
next;
|
|
}
|
|
|
|
if( s/^\s*\.SEVERITY\s+(WARNING|SUCCESS|ERROR|INFO|SEVERE)\b//i ) {
|
|
unless( exists $sev{lc $1} ) {
|
|
print STDERR ("Unknown severity $1 in .SEVERITY $at" );
|
|
undef $facname;
|
|
next;
|
|
}
|
|
s/\s*!.*$//;
|
|
s/\s+//g;
|
|
if( length ) {
|
|
printf STDERR ("Unrecognized content in .SEVERITY $at");
|
|
undef $facname;
|
|
next;
|
|
}
|
|
|
|
$defsev = $sev{lc $1};
|
|
next;
|
|
}
|
|
|
|
if( m/^\s*\.LITERAL\s+([\$\w]+)\s*=\s*(.+?)\s*(?:!.*)?$/i ) { # Subset
|
|
my( $symname, $expr ) = ( uc $1, uc $2 );
|
|
|
|
# Save the original expression.
|
|
# Evaluate any simple constant, converting to decimal.
|
|
# If only simple constants, make a symbol table entry.
|
|
# Otherwise, queue for evaluation.
|
|
|
|
my $oe = $expr;
|
|
$expr =~ s/\^[dD]0*(\d+)/$1/g;
|
|
$expr =~ s/\^[xX]([[:xdigit:]]+)/oct( '0x' . $1 )/ge;
|
|
$expr =~ s/\^[oO]([0-7]+)/oct( '0' . $1 )/ge;
|
|
# Shift operator - n.b. only left shift supported here.
|
|
$expr =~ s/\@/<</g;
|
|
|
|
# See if whe have a constant
|
|
my $tmp = $expr;
|
|
$tmp =~ s/\s+//g;
|
|
|
|
# Remove any paired ()
|
|
1 while( $tmp =~ s/^\((.*)\)\s*$/$1/ );
|
|
|
|
if( $tmp =~ /^\d+$/ ) {
|
|
my $val = 0 + $tmp;
|
|
my( undef, $facid, $facname, $factype, $id ) =
|
|
$symname =~ /^(((\w+?)([\$]?))_(\w+))$/;
|
|
|
|
$factype ||= '';
|
|
if( $id eq 'FACILITY' ) {
|
|
$symtab{fac}{name}{$facid} = $val;
|
|
$symtab{fac}{num}{$val} = $facid;
|
|
} else {
|
|
$symtab{name}{$symname}{val} = $val;
|
|
|
|
my $msgno = $val & 0x0FFFFFF8;
|
|
$symtab{msgno}{$val}{exact} = $symname;
|
|
$symtab{msgno}{$msgno}{default}{sev} = $val & 0x7;
|
|
$symtab{msgno}{$msgno}{default}{sym} = $symname;
|
|
if( defined $facid ) {
|
|
$symtab{msgno}{$msgno}{default}{fac} = $facid;
|
|
$symtab{msgno}{$msgno}{default}{ft} = $factype;
|
|
}
|
|
}
|
|
} else {
|
|
$symtab{literals}{uc $symname}{expr} = $expr;
|
|
$symtab{literals}{uc $symname}{oe} = $oe;
|
|
$symtab{literals}{uc $symname}{at} = $at;
|
|
}
|
|
next;
|
|
}
|
|
|
|
# Evaluate message lines
|
|
|
|
my( $id, $symname, $msgno, $text, $mods);
|
|
|
|
# Names are assigned sequentially following last or .BASE
|
|
# message compiled. The symbols from decompiled .MSG files
|
|
# are simply the message number in hex preceeded by _. As these are
|
|
# not useful to humans, we don't treat those as "real" symbols, and
|
|
# attempt to find a better name.
|
|
#
|
|
# Simplification: Qualifiers are only processed after the message text.
|
|
|
|
if( s/^\s*(\w+)\s+<([^>]+)>\s*(.*)$// ||
|
|
s/^\s*(\w+)\s+"([^"]+)"\s*(.*)$// ) {
|
|
if( $nextmsgno > 4096 ) {
|
|
undef $facname;
|
|
printf STDERR ("Message number $nextmsgno too big $at");
|
|
next;
|
|
}
|
|
$msgno = ($nextmsgno << 3) | ($facno << 16) | (!$sharedfac << 15);
|
|
$nextmsgno = (($msgno & 0x7FF8) >> 3) +1;
|
|
$symname = uc $1;
|
|
$text = $2;
|
|
$mods = uc $3;
|
|
undef $symname if( $symname =~ /^_[[:xdigit:]]{8}$/ );
|
|
} else {
|
|
printf STDERR ( "Ignored unrecognized line '$_' in message definitions $at" );
|
|
next;
|
|
}
|
|
|
|
my( $fac, $facid, $shrmsg );
|
|
my( $mt, $msgsev, $fao, $other );
|
|
|
|
# Classify message as system or user and shared or not
|
|
|
|
$mt = ($msgno & 0x08000000)? '': '$';
|
|
|
|
$shrmsg = !($msgno & 0x8000);
|
|
if( $shrmsg && $mt eq '$' ) {
|
|
if( $msgno >= 4096 && $msgno < 8192 ) {
|
|
$fac = 'SHR';
|
|
} else {
|
|
$fac = 'SS';
|
|
}
|
|
} elsif( $facno == 0 ) {
|
|
$fac = 'SYSTEM';
|
|
} else {
|
|
$fac = $facname;
|
|
}
|
|
$facid = $fac . $mt;
|
|
|
|
# Qualifiers:
|
|
|
|
# Assign message ID, which is the symbol name unless /IDENT specified
|
|
|
|
$id = $symname;
|
|
if( $mods =~ s,/IDENT(?:IFICATION)?[=:](\S+),,i ) {
|
|
$id = $1;
|
|
}
|
|
|
|
# Severity: from .SEVERITY or qualifier
|
|
# May be updated later from a registered symbol
|
|
|
|
$msgsev = $defsev;
|
|
if( $mods =~ s,/(SUCCESS|INFO(?:RMATIONAL)|WARN(?:ING)|ERROR|SEVERE|FATAL),,i ) {
|
|
$msgsev = $sev{lc $1};
|
|
}
|
|
|
|
# FAO argument count
|
|
|
|
$fao = 0;
|
|
if( $mods =~ s,/FAO(?:_COUNT)?[=:]([^\s/]+),,i ) {
|
|
$fao = decodenum( $1, '/FAO_COUNT' );
|
|
unless( defined $fao ) {
|
|
undef $facname;
|
|
next;
|
|
}
|
|
}
|
|
|
|
# Catch any unimplemented or unrecognized qualifiers
|
|
|
|
$mods =~ s/^\s+//g;
|
|
$mods =~ s/\s*!.*$//;
|
|
$mods = s/\s+$//g;
|
|
|
|
if( length $mods ) {
|
|
printf STDERR ("Unrecognized content '$mods' in message definition $at");
|
|
undef $facname;
|
|
next;
|
|
}
|
|
|
|
if( !defined $msgsev ) {
|
|
print STDERR ( "No .SEVERITY or /<severity> found for message $symname $at" );
|
|
undef $facname;
|
|
next;
|
|
}
|
|
|
|
$msgno |= 0+$msgsev;
|
|
|
|
# Grab the real severity and symbol from a #define if we have one.
|
|
|
|
if( defined( $symname ) ) {
|
|
$symname = $facid . '_' . $symname;
|
|
} elsif( exists $symtab{msgno}{$msgno}{exact} ) {
|
|
$symname = $symtab{msgno}{$msgno}{exact};
|
|
$msgno = ($msgno & ~0x7) | $symtab{msgno}{$msgno}{default}{sev};
|
|
} elsif( exists $symtab{msgno}{$msgno}{default} ) {
|
|
my $def = $symtab{msgno}{$msgno}{default};
|
|
if( $def->{fac} eq $facid ) {
|
|
$symname = $def->{sym};
|
|
$msgno = ($msgno & ~0x7) | $def->{sev};
|
|
}
|
|
}
|
|
|
|
# At this point, the symbol name should have been found.
|
|
# It's undefined if it came from an unmessage symbol.
|
|
# Otherwise, it's either explicit in the definition line,
|
|
# or found in the symbol table.
|
|
|
|
if( !defined $symname ) {
|
|
if( !defined( $id ) ) {
|
|
print STDERR ( "Neither symbol nor id found in $_ in $facname at line $.\n" );
|
|
undef $facname;
|
|
next;
|
|
}
|
|
$symname = $facid . '_' . $id;
|
|
}
|
|
|
|
# Ignore handles the wierd cases of message codes without text
|
|
# aliased to numbers that have text. SS$_WASSET is the classic.
|
|
|
|
next if( $ign{$symname} );
|
|
|
|
unless( $opt_m ) {
|
|
# Attempt to convert FAO directives to printf. These aren't
|
|
# exact. N.B. FAO count == 0 can still have other directives.
|
|
|
|
# Quote %, \ and " for C
|
|
|
|
$text =~ s/%/%%/g;
|
|
$text =~ s,\\,\\\\,g;
|
|
$text =~ s,",\\",g;
|
|
|
|
# ASCII directives map to %s
|
|
|
|
# -- one arg: Counted, Descriptor, ASCIZ
|
|
$text =~ s/!(\d+)?A[CSZ]/'%' . (defined $1? "-$1": '') . 's'/ge;
|
|
|
|
# -- len, addr: ASCII, Formatted ASCII
|
|
$text =~ s/!(\d+)?A[DF]/'%' . (defined $1? "-$1": '') . '.*s'/ge;
|
|
|
|
# Numeric: PRIxN codes must be listed in genmsg
|
|
|
|
# Octal of various sizes, 0-fill, signed, optional field width
|
|
# Oddly, there is no space-fill or minimal width directive for
|
|
# octal or hex.
|
|
|
|
$text =~ s/!(\d+)?OB/'%0' . (defined $1? $1:3) . '"PRIo8"'/ge;
|
|
$text =~ s/!(\d+)?OW/'%0' . (defined $1? $1:6) . '"PRIo16"'/ge;
|
|
$text =~ s/!(\d+)?OL/'%0' . (defined $1? $1:11) . '"PRIo32"'/ge;
|
|
$text =~ s/!(\d+)?OQ/'%0' . (defined $1? $1:22) . '"PRIo64"'/ge;
|
|
$text =~ s/!(\d+)?OA/'%0' . (defined $1? $1:11) . '%p"'/ge;
|
|
|
|
# Decimal signed
|
|
|
|
$text =~ s/!(\d+)?ZB/'%0' . (defined $1? $1:3) . '"PRIu8"'/ge;
|
|
$text =~ s/!(\d+)?ZW/'%0' . (defined $1? $1:6) . '"PRIu16"'/ge;
|
|
$text =~ s/!(\d+)?ZL/'%0' . (defined $1? $1:11) . '"PRIu32"'/ge;
|
|
$text =~ s/!(\d+)?ZQ/'%0' . (defined $1? $1:22) . '"PRIu64"'/ge;
|
|
$text =~ s/!(\d+)?ZA/'%0' . (defined $1? $1:11) . '%p"'/ge;
|
|
|
|
# Hex
|
|
|
|
$text =~ s/!(\d+)?XB/'%0' . (defined $1? $1:2) . '"PRIX8"'/ge;
|
|
$text =~ s/!(\d+)?XW/'%0' . (defined $1? $1:4) . '"PRIX16"'/ge;
|
|
$text =~ s/!(\d+)?XL/'%0' . (defined $1? $1:8) . '"PRIX32"'/ge;
|
|
$text =~ s/!(\d+)?XQ/'%0' . (defined $1? $1:16) . '"PRIX64"'/ge;
|
|
|
|
|
|
# Unsigned, space fill
|
|
|
|
$text =~ s/!(\d+)?UB/'%' . (defined $1? $1:'') . '"PRIu8"'/ge;
|
|
$text =~ s/!(\d+)?UW/'%' . (defined $1? $1:'') . '"PRIu16"'/ge;
|
|
$text =~ s/!(\d+)?UL/'%' . (defined $1? $1:'') . '"PRIu32"'/ge;
|
|
$text =~ s/!(\d+)?UQ/'%' . (defined $1? $1:'') . '"PRIu64"'/ge;
|
|
|
|
# Decimal, space fill
|
|
|
|
$text =~ s/!(\d+)?SB/'%' . (defined $1? $1:'') . '"PRId8"'/ge;
|
|
$text =~ s/!(\d+)?SW/'%' . (defined $1? $1:'') . '"PRId16"'/ge;
|
|
$text =~ s/!(\d+)?SL/'%' . (defined $1? $1:'') . '"PRId32"'/ge;
|
|
$text =~ s/!(\d+)?SQ/'%' . (defined $1? $1:'') . '"PRId64"'/ge;
|
|
|
|
# CR-LF
|
|
|
|
$text =~ s/!\//\\n/g;
|
|
|
|
# Arg number movements (Not supported, but remove the directive)
|
|
# Might handle with %n$, but that's not supported everwhere, and
|
|
# fortunately, no message that we use requires it.
|
|
|
|
$text =~ s/!(?:\d+)?(?:\+|--)//g;
|
|
|
|
# Character expansion
|
|
|
|
$text =~ s/!(\d+)?\*(.)/defined $1? ($2 x $1) : $1/ge;
|
|
|
|
# Special items: Date, Time, plural, UIC
|
|
# The %% is because of the % substitution earlier
|
|
|
|
$text =~ s/!%%D/%s/g;
|
|
$text =~ s/!%%T/%s/g;
|
|
$text =~ s/!%%S/(s)/g;
|
|
$text =~ s/!%%U/[%o,%o]/g;
|
|
|
|
# n-ary IF / ELSE /FI
|
|
if( 0 ) {
|
|
$text =~ s/!(\d+)%%C//g;
|
|
$text =~ s/!%%E//g;
|
|
$text =~ s/!%%F//g;
|
|
}
|
|
|
|
# !! => !
|
|
$text =~ s/!!/!/g;
|
|
|
|
if( $text =~ /!/ ) {
|
|
print STDERR ( "Unknown \$FAO code in $text\n" );
|
|
}
|
|
}
|
|
|
|
# Detect duplicate symbols
|
|
# Ignore differences caused by fuzzy symbol entries.
|
|
|
|
if( exists $symtab{name}{$symname} &&
|
|
$symtab{name}{$symname}{val} != $msgno ) {
|
|
my( $v1, $v2 ) = ( $symtab{name}{$symname}{val}, $msgno );
|
|
|
|
if( (($v1 ^ $v2) & 0x0FFFFFF8) ||
|
|
((($v1 ^ $v2)& 0x7) != 0 && ($v1 & 0x7) != 0) ) {
|
|
my $n = ++$symtab{name}{$symname}{dups};
|
|
|
|
my $len;
|
|
unless( $opt_q ) {
|
|
printf STDERR ( "Duplicate symbol $symname, using $symname.$n instead $at" );
|
|
$len = length( $symname . $n );
|
|
printf STDERR ( " %-*s %08x %u\n", $len, $symname,
|
|
$symtab{name}{$symname}{val},
|
|
$symtab{name}{$symname}{val} );
|
|
}
|
|
$symname .= $n;
|
|
unless( $opt_q ) {
|
|
printf STDERR ( " %-*s %08x %u\n", $len, $symname, $msgno, $msgno );
|
|
printf STDERR ( " %-*s %08x\n", $len, 'XOR', ($v1+0) ^ ($v2+0) );
|
|
}
|
|
}
|
|
}
|
|
|
|
# Create symbol table entry for this message
|
|
|
|
$symtab{name}{$symname}{val} = $msgno;
|
|
|
|
$symtab{msgno}{$msgno}{default}{fac} = $facid;
|
|
$symtab{msgno}{$msgno}{default}{ft} = $mt;
|
|
$symtab{msgno}{$msgno}{default}{sev} = $msgno & 0x7;
|
|
$symtab{msgno}{$msgno}{exact} = $symname;
|
|
|
|
$symtab{msgno}{$msgno}{sym} = $symname;
|
|
$symtab{msgno}{$msgno}{text} = $text;
|
|
$symtab{msgno}{$msgno}{fao} = $fao;
|
|
$symtab{msgno}{$msgno}{id} = $id;
|
|
} # Each line of file
|
|
|
|
if( $in != \*STDIN ) {
|
|
close( $in );
|
|
printf STDERR ("\n" ) unless( $opt_q );
|
|
undef $infile;
|
|
}
|
|
|
|
undef $facname;
|
|
$facno = 0;
|
|
$sharedfac = 0;
|
|
$nextmsgno = 1;
|
|
undef $defsev;
|
|
} while( @ARGV );
|
|
|
|
# Decode Message language number
|
|
# ^D - decimal
|
|
# ^O - octal
|
|
# ^X - hex
|
|
#
|
|
# Default is decimal
|
|
#
|
|
# Not supported: ^O( 10 + 10 ); (^O10 + ^O10) is OK
|
|
|
|
sub decodenum {
|
|
my $num = shift;
|
|
my $thing = shift;
|
|
|
|
if( $num =~ /^\s*\^[xX]([[:xdigit:]]+)\s*(?:!.*)?$/ ) {
|
|
return oct( '0x' . $1);
|
|
}
|
|
if( $num =~ /^\s*\^[oO]([0-7]+)\s*(?:!.*)?$/ ) {
|
|
return oct( '0' . $1);
|
|
}
|
|
if( $num =~ /^\s*(?:\^[dD])?0*([0-9]+)\s*(?:!.*)?$/ ) {
|
|
return 0+$num;
|
|
}
|
|
printf STDERR ( "Unrecognized value for $thing $at" );
|
|
return undef;
|
|
}
|
|
|
|
sub msgsort { # Increasing group shared, then severity, msg # within group
|
|
return
|
|
($a & 0x8000) <=> ($b & 0x8000) ||
|
|
($b & 1) <=> ($a & 1) ||
|
|
($a & 6) <=> ($b & 6) ||
|
|
($a & 0xFFF8) <=> ($b & 0xFFF8);
|
|
}
|
|
|
|
# Resolve literal expressions
|
|
#
|
|
# This isn't a full implementation of the VMS message language.
|
|
# The more important points:
|
|
# No right shift (- @)
|
|
# Perl precedence - and Perl operators illegal in Message accepted
|
|
# No multiple assignments/directive or default values
|
|
# This is intended to be just enough to allow expressions of
|
|
# the form ( (foo$_facility@16) + SHR$_bar + 4
|
|
# to enable defining symbols so shared messages can be used.
|
|
|
|
sub symval {
|
|
my( $v, $pass ) = @_;
|
|
|
|
if( $v =~ /^\d+$/ ) {
|
|
return 0+$v;
|
|
}
|
|
|
|
if( exists $symtab{name}{$v} &&
|
|
exists $symtab{name}{$v}{val} ) {
|
|
return $symtab{name}{$v}{val};
|
|
}
|
|
|
|
if( $v =~ /^([^_]+)_FACILITY$/ && exists $symtab{fac}{name}{$1} ) {
|
|
return $symtab{fac}{name}{$1};
|
|
}
|
|
|
|
return $v if( $pass < 2 );
|
|
|
|
return "Undef";
|
|
}
|
|
|
|
for( my $pass = 1; $pass <= 2; $pass++ ) {
|
|
foreach my $symname (keys%{$symtab{literals}}) {
|
|
my( $expr, $oe, $at ) = @{$symtab{literals}{$symname}}{qw/expr oe at/};
|
|
|
|
$expr =~ s{\b([\$\w]+)\b}{symval($1, $pass)}gex;
|
|
|
|
if( $expr =~ m{[^()+*\@/\d\s-]} && $pass < 2 ) {
|
|
$symtab{literals}{$symname}{expr} = $expr;
|
|
next;
|
|
}
|
|
|
|
if( $expr =~ /Undef/ ) {
|
|
chomp $at;
|
|
printf STDERR ( "Undefined symbol in expression $at: $oe => $expr\n" );
|
|
} else {
|
|
my $val = eval "$expr";
|
|
if( $@ ) {
|
|
chomp $at;
|
|
printf STDERR ( "Unable to evaluate expression $at: $oe => $expr: $@\n" );
|
|
} else {
|
|
my( undef, $facid, $facname, $factype, $id ) =
|
|
$symname =~ /^(((\w+?)([\$]?))_(\w+))$/;
|
|
$factype ||= '';
|
|
unless( defined $id ) {
|
|
print STDERR ( "$symname can't be parsed (should be facility$?_id) $at" );
|
|
next;
|
|
}
|
|
if( $id eq 'FACILITY' ) {
|
|
$symtab{fac}{name}{$facid} = $val;
|
|
$symtab{fac}{num}{$val} = $facid;
|
|
} else {
|
|
$symtab{name}{$symname}{val} = $val;
|
|
|
|
my $msgno = $val & 0x0FFFFFF8;
|
|
$symtab{msgno}{$val}{exact} = $symname;
|
|
$symtab{msgno}{$msgno}{default}{sev} = $val & 0x7;
|
|
$symtab{msgno}{$msgno}{default}{sym} = $symname;
|
|
if( defined $facid ) {
|
|
$symtab{msgno}{$msgno}{default}{fac} = $facid;
|
|
$symtab{msgno}{$msgno}{default}{ft} = $factype;
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
if( $opt_m ) {
|
|
# Generate a .msg file as output
|
|
# Sort and format for human consumption.
|
|
printf( << 'HEADING', $VERSION, $argv );
|
|
! This is an automatically-generated file. message version %s
|
|
!
|
|
! Command: message %s
|
|
!
|
|
! It uses a subset of the VMS Message utility language.
|
|
! The message definitions can be processed by the message
|
|
! Perl script, which will compile them into a .h file usable
|
|
! by sysmsg.c and all the ODS2 modules that rely on condition
|
|
! codes.
|
|
!
|
|
! This technlology was developed by Timothe Litt, and is
|
|
! free to use with the ODS2 package, originally developed by
|
|
! Paul Nankervis <Paulnank@au1.ibm.com>.
|
|
!
|
|
! ODS2 may be freely distributed within the VMS community
|
|
! providing that the contributions of the original author and
|
|
! subsequent contributors are acknowledged in the help text and
|
|
! source files. This is free software; no warranty is offered,
|
|
! and while we believe it to be useful, you use it at your own risk.
|
|
!
|
|
|
|
HEADING
|
|
|
|
my $infac;
|
|
|
|
foreach my $facid ( sort keys %{$symtab{fac}{name}} ) {
|
|
my $facno = $symtab{fac}{name}{$facid};
|
|
|
|
my( $facname, $sharedfac, $nextmsgno, $lastsev );
|
|
$facname = $facid;
|
|
$facname =~ s/\$$//;
|
|
|
|
$sharedfac = 100;
|
|
$nextmsgno = 1;
|
|
$lastsev = 99;
|
|
|
|
foreach my $msgno (sort msgsort grep {
|
|
exists $symtab{msgno}{$_}{default}{fac} &&
|
|
$symtab{msgno}{$_}{default}{fac} eq $facid }
|
|
keys %{ $symtab{msgno}}) {
|
|
|
|
my $msg = $symtab{msgno}{$msgno};
|
|
my $mshr = (~(0+$msgno)) & 0x8000;
|
|
|
|
# New facility (also if /SHARED changes)
|
|
|
|
my $mt = ($facno & 0x0800)? '': '$';
|
|
if( $mshr != $sharedfac ) {
|
|
print( "\n .END\n" ) if ($infac );
|
|
printf( "\n .FACILITY %s,%u",
|
|
$facname,
|
|
$facno & ~0x0800 );
|
|
if( !($facno & 0x0800) ) {
|
|
print( " /SYSTEM" );
|
|
}
|
|
if( $mshr ) {
|
|
print( " /SHARED" );
|
|
}
|
|
print( "\n" );
|
|
$sharedfac = $mshr;
|
|
$infac = 1;
|
|
}
|
|
|
|
# Generate .LITERAL for symbols without message text
|
|
|
|
if( !exists $msg->{text} ) { # Typ. Shared message codes
|
|
next if( exists $msg->{default}{sev} && # This partial def was resolved
|
|
exists $symtab{msgno}{($msgno & ~7) |
|
|
$msg->{default}{sev}}{text} );
|
|
|
|
my $symnam = $msg->{default}{sym};
|
|
printf( " .LITERAL %-*s = (",
|
|
(length($facid)+1+15),
|
|
$symnam );
|
|
# Try to create a symbolic expression for the value
|
|
my( $mfac, $mnum, $msev ) = (
|
|
($msgno & 0x0FFF0000) >> 16,
|
|
($msgno & 0xFFF8),
|
|
$msgno & 7 );
|
|
my $expr = '';
|
|
if( !($msgno & 0x8000) ) {
|
|
if( $mfac ) {
|
|
my $fs = $mfac;
|
|
$fs = $symtab{fac}{num}{$mfac} . '_FACILITY'
|
|
if( exists $symtab{fac}{num}{$mfac} );
|
|
|
|
$msev = $symtab{msgno}{$msgno}{default}{sev}
|
|
if( exists $symtab{msgno}{$msgno}{default}{sev} );
|
|
|
|
$expr .= '(' . $fs . '@16)';
|
|
if( exists
|
|
$symtab{msgno}{$msgno}{exact} &&
|
|
$symtab{msgno}{$msgno}{exact} ne $symnam ) {
|
|
$expr .= ' + '. $symtab{msgno}{$msgno}{exact};
|
|
} elsif( exists
|
|
$symtab{msgno}{$mnum | $msev}{exact} &&
|
|
$symtab{msgno}{$mnum | $msev}{exact} ne $symnam ) {
|
|
$expr .= ' + '.
|
|
$symtab{msgno}{$mnum | $msev}{exact};
|
|
} elsif( exists
|
|
$symtab{msgno}{$mnum}{exact} &&
|
|
$symtab{msgno}{$mnum}{exact} ne $symnam ) {
|
|
$expr .= ' + '.
|
|
$symtab{msgno}{$mnum}{exact};
|
|
$expr .= ' + '. $msev;
|
|
} elsif( $mnum ) {
|
|
$expr .= sprintf( ' + (^D%u@3) + %u',
|
|
($mnum >> 3), $msev );
|
|
} else {
|
|
$expr .= sprintf( '+ %u', $msev );
|
|
}
|
|
}
|
|
}
|
|
unless( length $expr ) {
|
|
if( exists $msg->{default}{sev} ) {
|
|
$expr = ($msgno & ~7) | $msg->{default}{sev};
|
|
} else {
|
|
$expr = $msgno;
|
|
}
|
|
}
|
|
|
|
$expr .= ')';
|
|
printf( "%-50s ! 0x%08x %s\n", $expr,
|
|
($mfac << 16) | $mnum | $msev, ucfirst $sevnam{$msev} );
|
|
|
|
if( $msgno & 0x8000 || $symtab{fac}{name}{$facid} == 0 ) {
|
|
print STDERR ( "No text found for $msg->{default}{sym}\n" );
|
|
next;
|
|
}
|
|
next;
|
|
}
|
|
|
|
# See if a new .SEVERITY is necessary
|
|
|
|
my $thissev = $msgno & 7;
|
|
my $nl = 1;
|
|
if( $thissev != $lastsev ) {
|
|
printf( "\n .SEVERITY %s\n", uc $sevnam{$thissev} );
|
|
$lastsev = $thissev;
|
|
$nl = 0;
|
|
}
|
|
|
|
# Or a new .BASE
|
|
|
|
my $mno = ($msgno & 0x7FFF) >> 3;
|
|
if( $mno != $nextmsgno ) {
|
|
if( $nl ) {
|
|
print( "\n" );
|
|
$nl = 0;
|
|
}
|
|
printf( " .BASE %u\n", $mno );
|
|
}
|
|
$nextmsgno = $mno + 1;
|
|
|
|
# Message definition line
|
|
|
|
{
|
|
my @delim = $msg->{text} =~ /[<>]/? ('"', '"'): ('<', '>');
|
|
my( $symname, $facid, $facname, $factype, $sid ) =
|
|
$msg->{sym} =~ /^(((\w+?)([\$]?))_(\w+))$/;
|
|
|
|
printf( "%-16s %s%s%s",
|
|
$sid,
|
|
$delim[0], $msg->{text}, $delim[1] );
|
|
if( $msg->{id} ne $sid ) {
|
|
printf( " /IDENT=%s", $msg->{id} );
|
|
}
|
|
}
|
|
if( $msg->{fao} ) {
|
|
printf( " /FAO=%u", $msg->{fao} );
|
|
}
|
|
print( "\n" );
|
|
} # each message number in facility
|
|
|
|
print( "\n .END\n" ) if( $infac );
|
|
$infac = 0;
|
|
print ("\n" );
|
|
} # each facility
|
|
|
|
exit;
|
|
}
|
|
|
|
# Output the header file in sections:
|
|
#
|
|
# Prolog
|
|
# Standard macro definitions for condition names
|
|
# Entries for the facility definition structure
|
|
# Entries for the message text definition structure
|
|
#
|
|
# The last two are enabled by a magic #define in the caller.
|
|
|
|
printf( << '__EOF', $VERSION, $argv );
|
|
#ifndef _SDEF_H
|
|
#define _SSDEF_H
|
|
/* ** MACHINE GENERATED FILE by message version %s: ODS2 Message catalog */
|
|
|
|
/* Command: message %s
|
|
*/
|
|
/*
|
|
* This is part of ODS2 written by Paul Nankervis,
|
|
* email address: Paulnank@au1.ibm.com
|
|
*
|
|
* ODS2 may be freely distributed within the VMS community
|
|
* providing that the contributions of the original author and
|
|
* subsequent contributors are acknowledged in the help text and
|
|
* source files. This is free software; no warranty is offered,
|
|
* and while we believe it to be useful, you use it at your own risk.
|
|
*
|
|
__EOF
|
|
|
|
print( << '__EOF' ) if( $opt_t );
|
|
* This file contains #defines for condition codes as well as initialization
|
|
* data for the structures used to print them. It is compiled from VMS
|
|
* Message utility language, however the translations from $FAO to printf
|
|
* are approximate, which means that those messages sourced from VMS
|
|
* may not work in exactly the same way if compiled with VMS Message.
|
|
*
|
|
__EOF
|
|
|
|
printf( << '__EOF' );
|
|
* Note: This file was automatically generated, and may contain many
|
|
* messages that are not used by ODS2. It was easier than finding each one.
|
|
* To rebuild it using the VMS files, you need some sources from a standard
|
|
* VMS system. But you can probably skip to the SHORT procedure...unless
|
|
* you are producing an I18n translation, and want the translated VMS messages...
|
|
*
|
|
* The full procedure is:
|
|
*
|
|
* On a VMS system:
|
|
* Obtain unmessage for VMS from a SIG tape, Freeware CD, or
|
|
* ftp://ftp.decuserve.org/decus/vms/sig_tapes/vax88b1/meadows/unmessage/unmessage.exe
|
|
*
|
|
* $ set command unmessage.cld
|
|
* $ unmessage sys$message:sysmsg.exe /output=vms_msgdump.msg
|
|
*
|
|
* $ copy sys$library:*.h vms_msgdefs.h
|
|
*
|
|
* The rest of the process does not require a VMS system:
|
|
*
|
|
* You can run the Perl script "message" on any convenient machine.
|
|
*
|
|
* perl message -b vms_msgdefs.h ods2.msg vms_msgdump.msg ssdef.h
|
|
*
|
|
* Note "ods2.msg" in the middle; this is the ODS2 message catalog and
|
|
* ssdef.h (the last file) is the output.
|
|
*
|
|
* Symbols come from the #defines in the .h files, which also contribute the
|
|
* message severity codes. The output is this .h file, which includes the
|
|
__EOF
|
|
|
|
if( $opt_t ) {
|
|
printf( << '__EOF' );
|
|
* #defines and table data used by sysmsg.c.
|
|
__EOF
|
|
} else {
|
|
printf( << '__EOF' );
|
|
* #defines for message codes. To get the message definitions, use message -t.
|
|
__EOF
|
|
}
|
|
|
|
printf( << '__EOF' );
|
|
*
|
|
* The compiler can also produce a .msg file as output (use -m). This
|
|
* provides a reconstructed .msg file with the correct severity codes and
|
|
* IDENT mappings. This can be used to populate ods2msg.msg by removing
|
|
* unsused messages
|
|
*
|
|
* perl message -bm vms_msgdefs.h vms_msgdump.msg vms_messages.msg
|
|
*
|
|
* At this point, you can get just the VMS messages in ssdef.h form with:
|
|
* perl message -b vms_messages.msg vms_messages.h
|
|
*
|
|
* But you really want the ODS2 version:
|
|
* perl message -b vms_messages.msg ods2.msg ssdef.h
|
|
*
|
|
* Currently, the interesting VMS messages are distributed as vms_messages.msg,
|
|
* so the SHORT procedure is:
|
|
* perl message -b vms_message.msg ods2.msg ssdef.h.
|
|
*
|
|
*/
|
|
|
|
__EOF
|
|
|
|
# define foo$?_FACILITY
|
|
|
|
my $maxflen = 0;
|
|
foreach my $facid (keys %{$symtab{fac}{name}} ) {
|
|
my $len = length( $facid . '_FACILITY' );
|
|
|
|
$maxflen = $len if( $len > $maxflen );
|
|
}
|
|
|
|
foreach my $facid ( sort keys %{$symtab{fac}{name}} ) {
|
|
printf( "#define %-*s %u\n", $maxflen,
|
|
$facid . '_FACILITY', $symtab{fac}{name}{$facid} );
|
|
}
|
|
|
|
# define other symbols
|
|
|
|
my $maxslen = 0;
|
|
foreach my $symname (keys %{$symtab{name}}) {
|
|
my $len = length $symname;
|
|
$maxslen = $len if( $len > $maxslen );
|
|
}
|
|
|
|
foreach my $symname (sort keys %{$symtab{name}}) {
|
|
my $val = $symtab{name}{$symname}{val};
|
|
|
|
unless( defined $val ) {
|
|
print STDERR ("Undefined value for $symname\n");
|
|
next;
|
|
}
|
|
printf( "#define %-*s %9u", $maxslen, $symname, $val );
|
|
|
|
printf( " /* %08x %s */", $val, ucfirst $sevnam{$val & 7} );
|
|
|
|
print( "\n" );
|
|
}
|
|
|
|
print( "#endif\n" );
|
|
|
|
exit unless( $opt_t );
|
|
|
|
# Facility table
|
|
|
|
print( "#ifdef GENERATE_FACTAB\n#undef GENERATE_FACTAB\n/* { code, \"string\" }, */\n" );
|
|
foreach my $facid ( sort keys %{$symtab{fac}{name}} ) {
|
|
my $facno = $symtab{fac}{name}{$facid};
|
|
|
|
printf( "FAC(%-*s, %-*s) /* %-4u",
|
|
$maxflen, $facid . '_FACILITY',
|
|
$maxflen, ($facid =~ /\$$/)? substr( $facid, 0, -1 ): $facid,
|
|
$facno & 0x07FF );
|
|
if( $facno & 0x0800 ) {
|
|
printf( " + customer = %-4u", $symtab{fac}{name}{$facid} );
|
|
} else {
|
|
print( " " );
|
|
}
|
|
print (" */\n" );
|
|
}
|
|
print( "#endif\n" );
|
|
|
|
# Message table
|
|
|
|
print( "#ifdef GENERATE_MSGTAB\n#undef GENERATE_MSGTAB\n/* MSG( code, facility, \"text \", #args) */\n" );
|
|
|
|
my $maxilen = 0;
|
|
$maxslen = 0;
|
|
foreach my $msgno (keys %{$symtab{msgno}}) {
|
|
my $msg = $symtab{msgno}{$msgno};
|
|
|
|
if( exists $msg->{text} ) {
|
|
my $len = length $msg->{id};
|
|
$maxilen = $len if( $len > $maxilen );
|
|
$len = length $msg->{sym};
|
|
$maxslen = $len if( $len > $maxslen );
|
|
}
|
|
}
|
|
|
|
foreach my $msgno (sort msgsort keys %{$symtab{msgno}}) {
|
|
my $msg = $symtab{msgno}{$msgno};
|
|
|
|
if( exists $msg->{text} ) {
|
|
my $symname;
|
|
|
|
my $m = 'MSG(' . $msg->{sym} . (' ' x ($maxslen - length $msg->{sym})) .
|
|
', ' . $msg->{id} . ( ' ' x ($maxilen - length $msg->{id})) .
|
|
', "' . $msg->{text} . '", ' . $msg->{fao} . ')';
|
|
|
|
if( length $m > 95 ) {
|
|
$m .= "\n" . (' ' x 95 );
|
|
} else {
|
|
$m .= ' ' x (95 - length( $m ));
|
|
}
|
|
$m .= sprintf( "/* %08x %s */\n", $msgno, ucfirst $sevnam{$msgno & 0x7} );
|
|
print( $m );
|
|
}
|
|
}
|
|
print( "#endif\n" );
|
|
exit;
|