generrh.pl

open(F,"<errors.def") or die "Can not open errors.def";

open(OUT,">errcodes.c") or die "Can not output errcodes.c";
open(BAS,">include/error.bas") or die "Can nor output include/error.bas";

open(Q,"<build.txt") or die "Can not open the build file.";
$BUILD = <Q>;
close Q;
chomp $BUILD;

print BAS <<BASEND;
' This file was automatically generated by the program generrh.pl
' using the error code definition file errors.def from the
' ScriptBasic distribution
'
' This file is part of the ScriptBasic distribution and is
' specific to the actual build it was shipped. Do not use
' this file for any version or build of the ScriptBasic
' interpreter other than the one this file was shipped.
'
' THIS FILE IS FOR V1.0 BUILD $BUILD
'
Global Const sbErrorOK = 0
Global Const sbErrorMemory = 1

BASEND

print OUT <<END;
/* 
FILE: errcodes.c
HEADER: errcodes.h

This file was automatically generated by generrh.pl from the file errors.def
Do not edit this file. Modify errors.def and run generrh.pl to regenerate this file.

TO_HEADER:

END

$module = '';
$CurrentErrorCode = 2;
$LastErrorCode = 0;
$TextHashes = {};
$ErrorType = 0; # 0 is compile type, 1 is run time error

while( <F> ){
  chomp;
  s/\n$//;
  s/\r$//;
  next if /^\s*$/;

  next if /^\s*\#/;

  if( /\%RT\s*$/ ){
    $ErrorType = 1;
    next;
    }

  if( /\%CT\s*$/ ){
    $ErrorType = 0;
    next;
    }

  if( /\%MODULE\s+(.*)\s*$/ ){
    $module = $1;
    print OUT "#define ${module}_ERROR_SUCCESS 0\n";
    print OUT "#define ${module}_ERROR_MEMORY_LOW 1\n";
    $TextHashes->{'en'}->[1] = 'Not enough memory';
    $LastErrorSymbol = '';
    next;
    }


  if( m{(\w\w)/(.*)} ){
    my $language = $1;
    my $message = $2;
    $TextHashes->{$language} = [] unless defined $TextHashes->{$language};
    $TextHashes->{$language}->[$LastErrorCode] = $message;
    if( $language eq 'en' && $ErrorType ){
      print BAS "' $message\n' ";
      print BAS "-" x length($message) ,"\n\n";
      }
    next;
    }
  if( /^(.+)\s+(.+)$/ ){
    $_ = $1;
    $ErrorSymbol = $2;
    }else{
    $ErrorSymbol = undef;
    }
  if( $ErrorType ){
    $ErrorSymbol = lc $_ unless defined $ErrorSymbol;
    my $i;
    for( $i=0 ; $i < length $ErrorSymbol ; $i++ ){
      if( substr($ErrorSymbol,$i,1) eq "_" ){
        substr($ErrorSymbol,$i+1,1) = uc substr($ErrorSymbol,$i+1,1);
        }
      }
    substr($ErrorSymbol,0,1) = uc substr($ErrorSymbol,0,1);
    $ErrorSymbol =~ s/\_//g;
    print BAS "Global Const sbError$ErrorSymbol = $CurrentErrorCode\n";
    }
  print OUT "#define ${module}_ERROR_$_ $CurrentErrorCode\n";
  $LastErrorCode = $CurrentErrorCode++;

  }
close F;

print OUT "#define MAX_ERROR_CODE $CurrentErrorCode\n";

print OUT "typedef struct { char *language; char **array; } tErrorMessageArray;\n";
print OUT "extern tErrorMessageArray ErrorMessageArray[];\n";

while( ($language,$array) = each %{$TextHashes} ){
  print OUT "extern char  *${language}_error_messages[];\n";
  }

print OUT "*/\n";

print OUT "#include <stdio.h>\n#include \"errcodes.h\"\n";

while( ($language,$array) = each %{$TextHashes} ){
  $TextHashes->{$language}->[0] = "SUCCESS";
  print OUT "char *${language}_error_messages[] ={\n";
  for( $i = 0 ; $i < $CurrentErrorCode ; $i++ ){
    print OUT '"',$TextHashes->{$language}->[$i],'"',",\n";
    }
  print OUT "NULL\n};\n";
  }

print OUT "tErrorMessageArray ErrorMessageArray[]={\n";
while( ($language,$array) = each %{$TextHashes} ){
  print OUT "\"$language\",${language}_error_messages,\n";
  }
print OUT "NULL,NULL\n};\n";
close OUT;