API tools faq
paste
Advertisement
bitFlipper

asm4doxy.pl

bitFlipper
Apr 20th, 2016
1,102
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Perl 25.61 KB | None | 0 0
raw download clone embed print report
  1. #!/usr/bin/perl
  2. #
  3. # asm4doxy.pl - A script which transforms specially-formatted assembly
  4. #   language files into something Doxygen can understand.
  5. #
  6. #   Copyright (C) 2007-2008 Bogdan 'bogdro' Drozdowski
  7. #       (bogdandr AT op.pl, bogdro AT rudy.mif.pg.gda.pl)
  8. #
  9. #   License: GNU General Public Licence v3+
  10. #
  11. #   Last modified : 2008-05-18
  12. #
  13. #   Syntax:
  14. #       ./asmdoc.pl aaa.asm bbb.asm ccc/ddd.asm
  15. #       ./asmdoc.pl --help|-help|-h
  16. #
  17. #   Documentation comments should start with ';;' or '/**' and
  18. #    end with ';;' or '*/'.
  19. #
  20. #   Examples:
  21. #
  22. #   ;;
  23. #   ; This procedure reads data.
  24. #   ; @param CX - number of bytes
  25. #   ; @return DI - address of data
  26. #   ;;
  27. #   procedure01:
  28. #       ...
  29. #       ret
  30. #
  31. # This program is free software; you can redistribute it and/or
  32. # modify it under the terms of the GNU General Public License
  33. # as published by the Free Software Foundation; either version 3
  34. # of the License, or (at your option) any later version.
  35. #
  36. # This program is distributed in the hope that it will be useful,
  37. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  38. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  39. # GNU General Public License for more details.
  40. #
  41. # You should have received a copy of the GNU General Public License
  42. # along with this program; if not, write to the Free Software Foundation:
  43. #       Free Software Foundation
  44. #       51 Franklin Street, Fifth Floor
  45. #       Boston, MA 02110-1301
  46. #       USA
  47.  
  48. use strict;
  49. use warnings;
  50. use Cwd;
  51. use File::Spec::Functions ':ALL';
  52. use Getopt::Long;
  53. use PerlIO::encoding;
  54.  
  55.  
  56. if ( @ARGV == 0 ) {
  57.     print_help();
  58.     exit 1;
  59. }
  60.  
  61. Getopt::Long::Configure("ignore_case", "ignore_case_always");
  62.  
  63. my $help='';
  64. my $lic='';
  65. my $encoding='iso-8859-1';
  66.  
  67. if ( !GetOptions (
  68.     'encoding=s'        => \$encoding,
  69.     'h|help|?'      => \$help,
  70.     'license|licence|l' => \$lic,
  71.     )
  72.    )
  73. {
  74.     print_help();
  75.     exit 2;
  76. }
  77.  
  78. if ( $lic )
  79. {
  80.     print   "Asm4doxy - a program for converting specially-formatted assembly\n".
  81.         "language files into something Doxygen can understand.\n".
  82.         "See http://rudy.mif.pg.gda.pl/~bogdro/inne\n".
  83.         "Author: Bogdan 'bogdro' Drozdowski, bogdro # rudy.mif.pg.gda.pl.\n\n".
  84.         "    This program is free software; you can redistribute it and/or\n".
  85.         "    modify it under the terms of the GNU General Public License\n".
  86.         "    as published by the Free Software Foundation; either version 3\n".
  87.         "    of the License, or (at your option) any later version.\n\n".
  88.         "    This program is distributed in the hope that it will be useful,\n".
  89.         "    but WITHOUT ANY WARRANTY; without even the implied warranty of\n".
  90.         "    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n".
  91.         "    GNU General Public License for more details.\n\n".
  92.         "    You should have received a copy of the GNU General Public License\n".
  93.         "    along with this program; if not, write to the Free Software Foundation:\n".
  94.         "       Free Software Foundation\n".
  95.         "       51 Franklin Street, Fifth Floor\n".
  96.         "       Boston, MA 02110-1301\n".
  97.         "       USA\n";
  98.     exit 1;
  99. }
  100.  
  101. # if "HELP" is on the command line or no files are given, print syntax
  102. if ( $help || @ARGV == 0 )
  103. {
  104.     print_help();
  105.     exit 1;
  106. }
  107.  
  108. my ($dysk, $katalog, undef) = splitpath(cwd(), 1);
  109.  
  110. my @pliki = sort @ARGV;
  111. my %pliki_oryg;
  112. foreach my $p (@pliki)
  113. {
  114.     my $nowy;
  115.     ($nowy = $p) =~ s/\./-/g;
  116.     $nowy = (splitpath $nowy)[2];
  117.     $pliki_oryg{$nowy} = (splitpath $p)[2]; # =$p;
  118. }
  119.  
  120. $encoding     =~ tr/A-Z/a-z/;
  121.  
  122. # The hashes go like this:
  123. # file_description, file_variables, file_functions, file_variables_description,
  124. # file_function_description, file_variable_values, file_structures, file_structrues_description,
  125. # file_structure_variables, file_structure_variables_description, file_structure_variables_values,
  126. # file_macros, file_macros_description, file_includes, file_variables_type, file_structure_variables_types
  127. my (%pliki_opis, %pliki_zmienne, %pliki_funkcje, %pliki_zmienne_opis, %pliki_funkcje_opis,
  128.     %pliki_zmienne_wartosci, %pliki_struktury, %pliki_struktury_opis, %pliki_struktury_zmienne,
  129.     %pliki_struktury_zmienne_opis, %pliki_struktury_zmienne_wartosci,
  130.     %pliki_makra, %pliki_makra_opis, %pliki_include, %pliki_zmienne_typy,
  131.     %pliki_struktury_zmienne_typy);
  132.  
  133. # =================== Reading input files =================
  134. foreach my $p (@pliki)
  135. {
  136.     # Hash array key is the filename with dashes instead of dots.
  137.     my $key;
  138.     $key = (splitpath $p)[2];
  139.     $key =~ s/\./-/g;
  140.  
  141.     # Current variable (or function) and its description:
  142.     # (current_variable, current_variable_description, current_variable_value, function,
  143.     #   type, structure, inside_struc, structure name, macro, current_type)
  144.     my ($aktualna_zmienna, $aktualna_zmienna_opis, $aktualna_zmienna_wartosc, $funkcja, $typ,
  145.         $struktura, $inside_struc, $struc_name, $makro, $aktualny_typ);
  146.     $typ = 0;
  147.     $funkcja = 0;
  148.     $struktura = 0;
  149.     $inside_struc = 0;
  150.     $struc_name = "";
  151.     $makro = 0;
  152.     my $jest_opis;
  153.  
  154.     $pliki_zmienne{$key} = ();
  155.     $pliki_funkcje{$key} = ();
  156.     $pliki_struktury{$key} = ();
  157.     $pliki_makra{$key} = ();
  158.     $pliki_include{$key} = "";
  159.  
  160.     open(my $asm, "<:encoding($encoding)", catpath($dysk, $katalog, $p)) or
  161.         die "$0: ".catpath($dysk, $katalog, $p).": $!\n";
  162.  
  163.     $jest_opis = 0;
  164.     # find file description, if it exists
  165.     OPISGL: while ( <$asm> )
  166.     {
  167.         next if /^\s*$/;
  168.         $typ = 1 if ( /^\s*;;/ && $typ == 0 );
  169.         $typ = 2 if ( /^\s*\/\*\*/ && $typ == 0 );
  170.  
  171.         if ( /^\s*[\%\#]?include\s*['"]?([\\\/\w\.\-\!\~\(\)\$\@]+)['"]?/i )
  172.         {
  173.             $pliki_include{$key} .= "$1 ";
  174.         }
  175.  
  176.         if ( $typ == 1 )
  177.         {
  178.             last OPISGL if ( (! /^\s*;/) || /^\s*;;\s*$/ && $jest_opis );
  179.         }
  180.         elsif ( $typ == 2 )
  181.         {
  182.             last OPISGL if /^\s*\*\/\s*$/;
  183.         }
  184.  
  185.         # removing leading comment characters from the beginning of the line
  186.         s/^\s*;+//  if $typ == 1;
  187.         s/^\s*\/?\*+// if $typ == 2;
  188.  
  189.         $pliki_opis{$key} .= $_ if $typ != 0;
  190.         $jest_opis = 1;
  191.     }
  192.  
  193.     if ( ! defined $_ )
  194.     {
  195.         close $asm;
  196.         next;
  197.     }
  198.  
  199.     if ( /^\s*;;\s*$/ || /^\s*\*\/\s*$/ )
  200.     {
  201.         $_ = <$asm>;
  202.         if ( /^\s*[\%\#]?include\s*['"]?([\\\/\w\.\-\!\~\(\)\$\@]+)['"]?/i )
  203.         {
  204.             $pliki_include{$key} .= "$1 ";
  205.         }
  206.     }
  207.  
  208.     # if the first comment wasn't about the file
  209.     if ( ! /^\s*$/ )
  210.     {
  211.         # variable/type 1 constant (xxx equ yyy)
  212.         if ( /^\s*([\.\w]+)(:|\s+)\s*((times\s+\w+|(d|r|res)[bwudpfqt]\s|equ\s|=)+)\s*([\w\,\.\+\-\s\*\/\\\'\"\!\@\#\$\%\^\&\\(\)\{\}\[\]\<\>\?\=\|]*)/i )
  213.         {
  214.             my ($m1, $m3, $m5);
  215.             $m1 = $1;
  216.             $m3 = $3;
  217.             $m5 = $6;
  218.             # Can't be in a structure yet!
  219.             $pliki_zmienne{$key}[++$#{$pliki_zmienne{$key}}] = $m1;
  220.             $pliki_zmienne_opis{$key}{$m1} = $pliki_opis{$key};
  221.             $pliki_zmienne_typy{$key}{$m1} = "$m3 $m5";
  222.  
  223.             $funkcja = 0;
  224.             my $wartosc = $m5;
  225.             if ( $m3 =~ /equ/i || $m3 =~ /=/ )
  226.             {
  227.                 # Can't be in a structure yet!
  228.                 $pliki_zmienne_wartosci{$key}{$m1} = $wartosc;
  229.             }
  230.             else
  231.             {
  232.                 # Can't be in a structure yet!
  233.                 $pliki_zmienne_wartosci{$key}{$m1} = "";
  234.             }
  235.         }
  236.         # type 2 constant (.equ xxx yyy)
  237.         elsif ( /^\s*\.equ?\s*(\w+)\s*,\s*([\w\,\.\+\-\s\*\/\\\'\"\!\@\#\$\%\^\&\\(\)\{\}\[\]\<\>\?\=\|]*)/i )
  238.         {
  239.             # Can't be in a structure yet!
  240.             $pliki_zmienne{$key}[++$#{$pliki_zmienne{$key}}] = $1;
  241.             $pliki_zmienne_opis{$key}{$1} = $pliki_opis{$key};
  242.             $pliki_zmienne_wartosci{$key}{$1} = $2;
  243.         }
  244.         # traditional procedure beginning
  245.         elsif ( /^\s*(\w+)(:|\s*(proc|near|far){1,2})\s*($|;.*$)/i )
  246.         {
  247.             $pliki_funkcje{$key}[++$#{$pliki_funkcje{$key}}] = $1;
  248.             $pliki_funkcje_opis{$key}{$1} = $pliki_opis{$key};
  249.         }
  250.         # HLA syntax procedure
  251.         elsif ( /^\s*proc(edure)?\s+(\w+)/i )
  252.         {
  253.             $pliki_funkcje{$key}[++$#{$pliki_funkcje{$key}}] = $2;
  254.             $pliki_funkcje_opis{$key}{$2} = $pliki_opis{$key};
  255.         }
  256.         # structures
  257.         elsif ( /^\s*struc\s+(\w+)/i )
  258.         {
  259.             $pliki_struktury{$key}[++$#{$pliki_struktury{$key}}] = $1;
  260.             $pliki_struktury_opis{$key}{$1} = $pliki_opis{$key};
  261.             $struktura = 1;
  262.             $inside_struc = 1;
  263.             $struc_name = $1;
  264.         }
  265.         # macros
  266.         elsif ( /^\s*((\%i?)?|\.)macro\s+(\w+)/i )
  267.         {
  268.             $pliki_makra{$key}[++$#{$pliki_makra{$key}}] = $3;
  269.             $pliki_makra_opis{$key}{$3} = $pliki_opis{$key};
  270.         }
  271.         elsif ( /^\s*(\w+)\s+macro/i )
  272.         {
  273.             $pliki_makra{$key}[++$#{$pliki_makra{$key}}] = $1;
  274.             $pliki_makra_opis{$key}{$1} = $pliki_opis{$key};
  275.         }
  276.         # structure instances in NASM
  277.         elsif ( /^\s*(\w+):?\s+istruc\s+(\w+)/i )
  278.         {
  279.             $pliki_zmienne{$key}[++$#{$pliki_zmienne{$key}}] = $1;
  280.             $pliki_zmienne_opis{$key}{$1} = $pliki_opis{$key};
  281.             $pliki_zmienne_typy{$key}{$1} = "istruc $2";
  282.         }
  283.         # dup()
  284.         elsif ( /^\s*(\w+)\s+(d([bwudpfqt])\s+\w+\s*\(?\s*\bdup\b.*)/i )
  285.         {
  286.             $pliki_zmienne{$key}[++$#{$pliki_zmienne{$key}}] = $1;
  287.             $pliki_zmienne_opis{$key}{$1} = $pliki_opis{$key};
  288.             $pliki_zmienne_typy{$key}{$1} = "$2";
  289.         }
  290.         # some other type (like FASM structure instances)
  291.         elsif ( /^\s*(\w+):?\s+(\w+)/i )
  292.         {
  293.             $pliki_zmienne{$key}[++$#{$pliki_zmienne{$key}}] = $1;
  294.             $pliki_zmienne_opis{$key}{$1} = $pliki_opis{$key};
  295.             $pliki_zmienne_typy{$key}{$1} = "$2";
  296.         }
  297.         undef($pliki_opis{$key});
  298.     }
  299.  
  300.     while ( <$asm> )
  301.     {
  302.         if ( $inside_struc && /^\s*(endstruc|\})/i )
  303.         {
  304.             $struktura = 0;
  305.             $inside_struc = 0;
  306.         }
  307.         if ( /^\s*[\%\#]?include\s*['"]?([\\\/\w\.\-\!\~\(\)\$\@]+)['"]?/i )
  308.         {
  309.             $pliki_include{$key} .= "$1 ";
  310.         }
  311.  
  312.         # look for characters which start a comment
  313.         next if ! ( /^\s*;;/ || /^\s*\/\*\*/ );
  314.  
  315.         $typ = 1 if /^\s*;;/;
  316.         $typ = 2 if /^\s*\/\*\*/;
  317.         $aktualna_zmienna_opis = $_;
  318.         $aktualna_zmienna_opis =~ s/^\s*;+// if $typ == 1;
  319.         $aktualna_zmienna_opis =~ s/^\s*\/?\*+// if $typ == 2;
  320.  
  321.         $jest_opis = 0;
  322.         # Put all up to the first non-comment line into the current description
  323.         while ( <$asm> )
  324.         {
  325.             next if /^\s*$/;
  326.  
  327.             if ( $typ == 1 )
  328.             {
  329.                 last if ( (! /^\s*;/) || /^\s*;;\s*$/ && $jest_opis );
  330.             }
  331.             elsif ( $typ == 2 )
  332.             {
  333.                 last if /^\s*\*\/\s*$/;
  334.             }
  335.  
  336.             # removing leading comment characters from the beginning of the line
  337.             s/^\s*;+//  if $typ == 1;
  338.             s/^\s*\/?\*+// if $typ == 2;
  339.  
  340.             $aktualna_zmienna_opis .= $_ if $typ != 0;
  341.             $jest_opis = 1;
  342.         }
  343.         if ( /^\s*;;\s*$/ || /^\s*\*\/\s*$/ )
  344.         {
  345.             $_ = <$asm>;
  346.             if ( /^\s*[\%\#]?include\s*['"]?([\\\/\w\.\-\!\~\(\)\$\@]+)['"]?/i )
  347.             {
  348.                 $pliki_include{$key} .= "$1 ";
  349.             }
  350.         }
  351.  
  352.         # finding the name of the variable or function
  353.         # variable/type 1 constant (xxx equ yyy)
  354.         if ( /^\s*([\.\w]+)(:|\s+)\s*((times\s+\w+|(d|r|res)[bwudpfqt]\s|equ\s|=)+)\s*([\w\,\.\+\-\s\*\/\\\'\"\!\@\#\$\%\^\&\\(\)\{\}\[\]\<\>\?\=\|]*)/i )
  355.         {
  356.             my ($m1, $m3, $m5);
  357.             $m1 = $1;
  358.             $m3 = $3;
  359.             $m5 = $6;
  360.             $aktualna_zmienna = $m1;
  361.             $aktualny_typ = "$m3 $m5";
  362.             $funkcja = 0;
  363.             my $wartosc = $m5;
  364.             if ( $m3 =~ /equ/i || $m3 =~ /=/ )
  365.             {
  366.                 $aktualna_zmienna_wartosc = $wartosc;
  367.             }
  368.             else
  369.             {
  370.                 $aktualna_zmienna_wartosc = "";
  371.             }
  372.         }
  373.         # type 2 constant (.equ xxx yyy)
  374.         elsif ( /^\s*\.equ?\s*([\w\.]+)\s*,\s*([\w\,\.\+\-\s\*\/\\\'\"\!\@\#\$\%\^\&\\(\)\{\}\[\]\<\>\?\=\|]*)/i )
  375.         {
  376.             $aktualna_zmienna = $1;
  377.             $funkcja = 0;
  378.             $aktualna_zmienna_wartosc = $2;
  379.         }
  380.         # traditional procedure beginning
  381.         elsif ( /^\s*(\w+)(:|\s*(proc|near|far){1,2})\s*($|;.*$)/i )
  382.         {
  383.             $aktualna_zmienna = $1;
  384.             $funkcja = 1;
  385.             $aktualna_zmienna_wartosc = "";
  386.         }
  387.         # HLA syntax procedure
  388.         elsif ( /^\s*proc(edure)?\s*(\w+)/i )
  389.         {
  390.             $aktualna_zmienna = $2;
  391.             $funkcja = 1;
  392.             $aktualna_zmienna_wartosc = "";
  393.         }
  394.         # structures
  395.         elsif ( /^\s*struc\s+(\w+)/i )
  396.         {
  397.             $struc_name = $1;
  398.             $funkcja = 0;
  399.             $struktura = 1;
  400.             $inside_struc = 0;
  401.             $aktualna_zmienna_wartosc = "";
  402.         }
  403.         # macros
  404.         elsif ( /^\s*((\%i?)?|\.)macro\s+(\w+)/i )
  405.         {
  406.             $aktualna_zmienna = $3;
  407.             $makro = 1;
  408.             $aktualna_zmienna_wartosc = "";
  409.         }
  410.         elsif ( /^\s*(\w+)\s+macro/i )
  411.         {
  412.             $aktualna_zmienna = $1;
  413.             $makro = 1;
  414.             $aktualna_zmienna_wartosc = "";
  415.         }
  416.         # structure instances in NASM
  417.         elsif ( /^\s*(\w+):?\s+istruc\s+(\w+)/i )
  418.         {
  419.             $aktualna_zmienna = $1;
  420.             $aktualna_zmienna_wartosc = "";
  421.             $aktualny_typ = "istruc $2";
  422.         }
  423.         # dup()
  424.         elsif ( /^\s*(\w+)\s+(d([bwudpfqt])\s+\w+\s*\(?\s*\bdup\b.*)/i )
  425.         {
  426.             $aktualna_zmienna = $1;
  427.             $aktualna_zmienna_wartosc = "";
  428.             $aktualny_typ = "$2";
  429.         }
  430.         # some other type (like FASM structure instances)
  431.         elsif ( /^\s*(\w+):?\s+(\w+)/i )
  432.         {
  433.             $aktualna_zmienna = $1;
  434.             $aktualna_zmienna_wartosc = "";
  435.             $aktualny_typ = "$2";
  436.         }
  437.         else
  438.         {
  439.             chomp;
  440.             print "$0: $p: '$_' ???\n";
  441.             next;
  442.         }
  443.  
  444.         # {@value}
  445.         $aktualna_zmienna_opis =~ s/\{\s*(\@|\\)value\s*\}/$aktualna_zmienna_wartosc/ig;
  446.  
  447.         if ( $funkcja )
  448.         {
  449.             $pliki_funkcje{$key}[++$#{$pliki_funkcje{$key}}] = $aktualna_zmienna;
  450.             $pliki_funkcje_opis{$key}{$aktualna_zmienna} = $aktualna_zmienna_opis;
  451.         }
  452.         elsif ( $struktura )
  453.         {
  454.             $pliki_struktury{$key}[++$#{$pliki_struktury{$key}}] = $struc_name;
  455.             $pliki_struktury_opis{$key}{$struc_name} = $aktualna_zmienna_opis;
  456.             $pliki_struktury_zmienne{$key}{$struc_name} = ();
  457.             $pliki_struktury_zmienne_opis{$key}{$struc_name} = ();
  458.             $pliki_struktury_zmienne_wartosci{$key}{$struc_name} = ();
  459.             $inside_struc = 1;
  460.             $struktura = 0;
  461.         }
  462.         elsif ( $makro )
  463.         {
  464.             $pliki_makra{$key}[++$#{$pliki_makra{$key}}] = $aktualna_zmienna;
  465.             $pliki_makra_opis{$key}{$aktualna_zmienna} = $aktualna_zmienna_opis;
  466.             $makro = 0;
  467.         }
  468.         else
  469.         {
  470.             if ( $inside_struc )
  471.             {
  472.                 $pliki_struktury_zmienne{$key}{$struc_name}[++$#{$pliki_struktury_zmienne{$key}{$struc_name}}] = $aktualna_zmienna;
  473.                 $pliki_struktury_zmienne_opis{$key}{$struc_name}{$aktualna_zmienna} = $aktualna_zmienna_opis;
  474.                 $pliki_struktury_zmienne_wartosci{$key}{$struc_name}{$aktualna_zmienna} = $aktualna_zmienna_wartosc;
  475.                 $aktualna_zmienna =~ s/^\.//;
  476.                 $pliki_struktury_zmienne_typy{$key}{$struc_name}{$aktualna_zmienna} = $aktualny_typ;
  477.             }
  478.             else
  479.             {
  480.                 $pliki_zmienne{$key}[++$#{$pliki_zmienne{$key}}] = $aktualna_zmienna;
  481.                 $pliki_zmienne_opis{$key}{$aktualna_zmienna} = $aktualna_zmienna_opis;
  482.                 $pliki_zmienne_wartosci{$key}{$aktualna_zmienna} = $aktualna_zmienna_wartosc;
  483.                 $pliki_zmienne_typy{$key}{$aktualna_zmienna} = $aktualny_typ;
  484.  
  485.             }
  486.         }
  487.     }
  488.  
  489.     close $asm;
  490.  
  491.     if ( $#{$pliki_zmienne{$key}} >= 0 )
  492.     {
  493.         my @posort = sort @{$pliki_zmienne{$key}};
  494.         $pliki_zmienne{$key} = ();
  495.         foreach (@posort) { push @{$pliki_zmienne{$key}}, $_; }
  496.     }
  497.  
  498.     if ( $#{$pliki_struktury{$key}} >= 0 )
  499.     {
  500.         my @posort = sort @{$pliki_struktury{$key}};
  501.         $pliki_struktury{$key} = ();
  502.         foreach (@posort) { push @{$pliki_struktury{$key}}, $_; }
  503.     }
  504.  
  505.     if ( $#{$pliki_funkcje{$key}} >= 0 )
  506.     {
  507.         my @posort = sort @{$pliki_funkcje{$key}};
  508.         $pliki_funkcje{$key} = ();
  509.         foreach (@posort) { push @{$pliki_funkcje{$key}}, $_; }
  510.     }
  511.  
  512. }
  513.  
  514. # =================== Writing output files =================
  515. foreach my $p (@pliki)
  516. {
  517.     # Hash array key is the filename with dashes instead of dots.
  518.     my $key;
  519.     $key = (splitpath $p)[2];
  520.     $key =~ s/\./-/g;
  521.  
  522.     # don't do anything if file would be empty
  523.     next if !defined $pliki_opis{$key} && !defined $pliki_zmienne{$key} && !defined $pliki_funkcje{$key};
  524.  
  525.     $p = (splitpath $p)[2];
  526.     open(my $dox, ">:encoding($encoding)", $key.".c") or die "$0: $key.c: $!\n";
  527.  
  528.     if ( defined $pliki_opis{$key} )
  529.     {
  530.         print $dox "/**\n"
  531.             ." * \\file $key.c\n"
  532.             ." * \\brief $p\n\n"
  533.             .$pliki_opis{$key}
  534.             ."\n */\n\n\n";
  535.     }
  536.  
  537.     if ( $pliki_include{$key} ne "" )
  538.     {
  539.         my @incl = split /\s+/, $pliki_include{$key};
  540.         foreach (@incl)
  541.         {
  542.             print $dox "#include \"$_\"\n";
  543.         }
  544.         print $dox "\n";
  545.     }
  546.  
  547.     # write C-style comments into the file for all documented functions
  548.     # and variables/const. On each following line, write the variable/const
  549.     # or a C-style function prototype.
  550.  
  551.     if ( defined($pliki_zmienne{$key}) && (@{$pliki_zmienne{$key}} > 0) )
  552.     {
  553.         foreach (@{$pliki_zmienne{$key}})
  554.         {
  555.             # check if variable or constant
  556.             if ( defined  ($pliki_zmienne_wartosci{$key}{$_}) &&
  557.                 $pliki_zmienne_wartosci{$key}{$_} ne "" )
  558.             {
  559.                 # constant
  560.                 print $dox "/**\n"
  561.                     .$pliki_zmienne_opis{$key}{$_}
  562.                     ."\n */\n"
  563.                     ."#define $_ $pliki_zmienne_wartosci{$key}{$_}\n"
  564.                     ;
  565.             }
  566.             else
  567.             {
  568.                 # variable
  569.                 print $dox "/**\n"
  570.                     .$pliki_zmienne_opis{$key}{$_}
  571.                     ."\n */\n"
  572.                     .do_variable($pliki_zmienne_typy{$key}{$_})."\n"
  573.                     ;
  574.             }
  575.         }
  576.     }
  577.  
  578.     if ( defined($pliki_funkcje{$key}) && (@{$pliki_funkcje{$key}} > 0) )
  579.     {
  580.         foreach (@{$pliki_funkcje{$key}})
  581.         {
  582.             my $func_proto = "";
  583. #           if ( $pliki_funkcje_opis{$key}{$_} =~ /[\@\\]param[^\s]*\s+([\%\w]+):([\%\w]+)/i )
  584. #           {
  585. #               $pliki_funkcje_opis{$key}{$_} =~ s/[\@\\]param[^\s]*\s+([\%\w]+):([\%\w]+)/\@param $1$2/gi;
  586. #           }
  587.             print $dox "/**\n"
  588.                 .$pliki_funkcje_opis{$key}{$_}
  589.                 ."\n */\n";
  590.             if ( $pliki_funkcje_opis{$key}{$_} !~ /[\@\\]return/i )
  591.             {
  592.                 print $dox "void ";
  593.             }
  594.             print $dox "$_ (";
  595.             while ($pliki_funkcje_opis{$key}{$_} =~ /[\@\\]param[^\s]*\s+([\w\:\/\(\)\[\]\%]+)/i)
  596.             {
  597.                 my $par = $1;
  598.                 $par =~ s/\://g;
  599.                 $func_proto .= "$par, ";
  600.                 $pliki_funkcje_opis{$key}{$_} =~ s/[\@\\]param//i;
  601.             }
  602.             if ( $func_proto eq "" )
  603.             {
  604.                 $func_proto = "void";
  605.             }
  606.             else
  607.             {
  608.                 $func_proto =~ s/,\s*$//;
  609.             }
  610.             print $dox "$func_proto);\n";
  611.         }
  612.     }
  613.  
  614.     if ( defined($pliki_struktury{$key}) && (@{$pliki_struktury{$key}} > 0) )
  615.     {
  616.         foreach my $stru (@{$pliki_struktury{$key}})
  617.         {
  618.             if ( defined $pliki_struktury_opis{$key}{$stru} )
  619.             {
  620.                 print $dox "/**\n"
  621.                     .$pliki_struktury_opis{$key}{$stru}
  622.                     ."\n */\n"
  623.                     ."struct $stru \n{\n"
  624.                     ;
  625.             }
  626.             if ( defined($pliki_struktury_zmienne{$key}{$stru})
  627.                 && (@{$pliki_struktury_zmienne{$key}{$stru}} > 0) )
  628.             {
  629.                 foreach (@{$pliki_struktury_zmienne{$key}{$stru}})
  630.                 {
  631.                     # check if variable or constant
  632.                     if ( defined  ($pliki_struktury_zmienne_wartosci{$key}{$stru}{$_})
  633.                         && $pliki_struktury_zmienne_wartosci{$key}{$stru}{$_} ne "" )
  634.                     {
  635.                         # constant
  636.                         print $dox "/**\n"
  637.                             .$pliki_struktury_zmienne_opis{$key}{$stru}{$_}
  638.                             ."\n */\n"
  639.                             ."#define $_ $pliki_struktury_zmienne_wartosci{$key}{$stru}{$_}\n"
  640.                             ;
  641.                     }
  642.                     else
  643.                     {
  644.                         # variable
  645.                         print $dox "/**\n"
  646.                             .$pliki_struktury_zmienne_opis{$key}{$stru}{$_}
  647.                             ."\n */\n"
  648.                             ;
  649.                         s/^\.//;
  650.                         print $dox "\t".
  651.                             do_variable($pliki_struktury_zmienne_typy{$key}{$stru}{$_}).
  652.                             "\n"
  653.                             ;
  654.                     }
  655.                 }
  656.             }
  657.             print $dox "\n};\n";
  658.         }
  659.     }
  660.  
  661.     if ( defined($pliki_makra{$key}) && (@{$pliki_makra{$key}} > 0) )
  662.     {
  663.         foreach (@{$pliki_makra{$key}})
  664.         {
  665.             my $makro_proto = "";
  666. #           if ( $pliki_makra_opis{$key}{$_} =~ /[\@\\]param[^\s]*\s+([\%\w]+):([\%\w]+)/i )
  667. #           {
  668. #               $pliki_makra_opis{$key}{$_} =~ s/[\@\\]param[^\s]*\s+([\%\w]+):([\%\w]+)/\@param $1$2/gi;
  669. #           }
  670.             if ( $pliki_makra_opis{$key}{$_} =~ /[\@\\]param[^\s]*\s+\%(\d+)/i )
  671.             {
  672.                 $pliki_makra_opis{$key}{$_} =~ s/[\@\\]param[^\s]*\s+\%(\d+)/\@param par$1/gi;
  673.             }
  674.             print $dox "/**\n"
  675.                 .$pliki_makra_opis{$key}{$_}
  676.                 ."\n */\n"
  677.                 ."#define $_("
  678.                 ;
  679.             while ($pliki_makra_opis{$key}{$_} =~ /[\@\\]param[^\s]*\s+([\w\:\/\(\)\[\]\%]+)/i)
  680.             {
  681.                 my $mak_par = $1;
  682.                 $mak_par =~ s/\://g;
  683.                 $makro_proto .= "$mak_par, ";
  684.                 $pliki_makra_opis{$key}{$_} =~ s/[\@\\]param//i;
  685.             }
  686.             $makro_proto =~ s/,\s*$//;
  687.             print $dox "$makro_proto) /* $pliki_oryg{$key}, $_ */\n";
  688.         }
  689.     }
  690.  
  691.     close $dox;
  692. }
  693.  
  694. exit 0;
  695.  
  696. # ============================ print_help ===================================
  697.  
  698. sub print_help
  699. {
  700.     print   "Asm4doxy - a program for converting specially-commented assembly\n".
  701.         "language files into something Doxygen can understand.\n".
  702.         "See http://rudy.mif.pg.gda.pl/~bogdro/inne\n".
  703.         "Syntax: $0 [options] files\n\n".
  704.         "Options:\n".
  705.         "-encoding <name>\t\tSource files' character encoding\n".
  706.         "-h|--help|-help|-?\t\tShows the help screen\n".
  707.         "-L|--license\t\t\tShows the license for this program\n\n".
  708.         "Documentation comments should start with ';;' or '/**' and\n".
  709.         "end with ';;' or '*/'.\n\n".
  710.         "Examples:\n\n".
  711.         ";;\n".
  712.         "; This procedure reads data.\n".
  713.         "; \@param CX - number of bytes\n".
  714.         "; \@return DI - address of data\n".
  715.         ";;\n".
  716.         "procedure01:\n".
  717.         "\t...\n".
  718.         "\tret\n"
  719.         ;
  720. }
  721.  
  722. # ============================= do_variable ===================================
  723.  
  724. sub do_variable
  725. {
  726.     my $var;
  727.     my $typ = shift;
  728.     $var = "$_;";
  729.     # parse the variable type here
  730.     if ( defined ($typ) )
  731.     {
  732.         # times + resX/rX:
  733.         if ( $typ =~ /\btimes\s+(\w+)\s+(r|res)([bwudpfqt])\s+(\w+)/i )
  734.         {
  735.             my $type = $3;
  736.             my $liczba1 = $1;
  737.             my $liczba2 = $4;
  738.             if ( $liczba1 =~ /\d+h/i )
  739.             {
  740.                 $liczba1 = "0x$liczba1";
  741.                 $liczba1 =~ s/h$//i;
  742.             }
  743.             elsif ( $liczba1 =~ /\d+[qo]/i )
  744.             {
  745.                 $liczba1 = "0$liczba1";
  746.                 $liczba1 =~ s/[qo]$//i;
  747.             }
  748.             if ( $liczba2 =~ /\d+h/i )
  749.             {
  750.                 $liczba2 = "0x$liczba2";
  751.                 $liczba2 =~ s/h$//i;
  752.             }
  753.             elsif ( $liczba2 =~ /\d+[qo]/i )
  754.             {
  755.                 $liczba2 = "0$liczba2";
  756.                 $liczba2 =~ s/[qo]$//i;
  757.             }
  758.             if ( $type eq "b" )
  759.             {
  760.                 $var = "char $_ [$liczba1*$liczba2];";
  761.             }
  762.             elsif ( $type eq "w" || $type eq "u" )
  763.             {
  764.                 $var = "short $_ [$liczba1*$liczba2];";
  765.             }
  766.             elsif ( $type eq "d" )
  767.             {
  768.                 $var = "Dword $_ [$liczba1*$liczba2]; /* 32-bit integer or float or pointer */";
  769.             }
  770.             elsif ( $type eq "p" || $type eq "f" )
  771.             {
  772.                 $var = "far void * $_ [$liczba1*$liczba2]; /* 48-bit number */";
  773.             }
  774.             elsif ( $type eq "q" )
  775.             {
  776.                 $var = "Qword $_ [$liczba1*$liczba2]; /* 64-bit integer or double or pointer */";
  777.             }
  778.             else #if ( $type eq "t" )
  779.             {
  780.                 $var = "long double $_ [$liczba1*$liczba2]; /* 80-bit long double */";
  781.             }
  782.         }
  783.         # times + dX
  784.         elsif ( $typ =~ /\btimes\s+(\w+)\s+d([bwudpfqt])/i )
  785.         {
  786.             my $type = $2;
  787.             my $liczba = $1;
  788.             if ( $liczba =~ /\d+h/i )
  789.             {
  790.                 $liczba = "0x$liczba";
  791.                 $liczba =~ s/h$//i;
  792.             }
  793.             elsif ( $liczba =~ /\d+[qo]/i )
  794.             {
  795.                 $liczba = "0$liczba";
  796.                 $liczba =~ s/[qo]$//i;
  797.             }
  798.             if ( $type eq "b" )
  799.             {
  800.                 $var = "char $_ [$liczba];";
  801.             }
  802.             elsif ( $type eq "w" || $type eq "u" )
  803.             {
  804.                 $var = "short $_ [$liczba];";
  805.             }
  806.             elsif ( $type eq "d" )
  807.             {
  808.                 $var = "Dword $_ [$liczba]; /* 32-bit integer or float or pointer */";
  809.             }
  810.             elsif ( $type eq "p" || $type eq "f" )
  811.             {
  812.                 $var = "far void * $_ [$liczba]; /* 48-bit number */";
  813.             }
  814.             elsif ( $type eq "q" )
  815.             {
  816.                 $var = "Qword $_ [$liczba]; /* 64-bit integer or double or pointer */";
  817.             }
  818.             else #if ( $type eq "t" )
  819.             {
  820.                 $var = "long double $_ [$liczba]; /* 80-bit long double */";
  821.             }
  822.         }
  823.         # dup():
  824.         elsif  ( $typ =~ /^\s*d([bwudpfqt])\s+\w+\s*\(?\s*\bdup\b/i )
  825.         {
  826.             my $dim = 0;
  827.             my @dims = ();
  828.             my $type = $1;
  829.             while ( $typ =~ /(\w+)\s*\(?\s*dup/i )
  830.             {
  831.                 $dim++;
  832.                 push @dims, $1;
  833.                 $typ =~ s/(\w+)\s*\(?\s*dup//i;
  834.             }
  835.             if ( $type eq "b" )
  836.             {
  837.                 $var = "char $_ ";
  838.             }
  839.             elsif ( $type eq "w" || $type eq "u" )
  840.             {
  841.                 $var = "short $_ ";
  842.             }
  843.             elsif ( $type eq "d" )
  844.             {
  845.                 $var = "Dword $_ ";
  846.             }
  847.             elsif ( $type eq "p" || $type eq "f" )
  848.             {
  849.                 $var = "far void * $_ ";
  850.             }
  851.             elsif ( $type eq "q" )
  852.             {
  853.                 $var = "Qword $_ ";
  854.             }
  855.             else #if ( $type eq "t" )
  856.             {
  857.                 $var = "long double $_ ";
  858.             }
  859.             foreach my $i (@dims)
  860.             {
  861.                 $var .= "[$i]";
  862.             }
  863.             $var .= ";";
  864.         }
  865.         # istruc:
  866.         elsif  ( $typ =~ /\bistruc\s+(\w+)/i )
  867.         {
  868.             $var = "struct $1 $_;"
  869.         }
  870.         # resX / rX
  871.         elsif  ( $typ =~ /\b(res|r)([bwudpfqt])\s+(\w+)/i )
  872.         {
  873.             my $type = $2;
  874.             my $liczba = $3;
  875.             if ( $liczba =~ /\d+h/i )
  876.             {
  877.                 $liczba = "0x$liczba";
  878.                 $liczba =~ s/h$//i;
  879.             }
  880.             elsif ( $liczba =~ /\d+[qo]/i )
  881.             {
  882.                 $liczba = "0$liczba";
  883.                 $liczba =~ s/[qo]$//i;
  884.             }
  885.             if ( $type eq "b" )
  886.             {
  887.                 $var = "char $_ [$liczba];";
  888.             }
  889.             elsif ( $type eq "w" || $type eq "u" )
  890.             {
  891.                 $var = "short $_ [$liczba];";
  892.             }
  893.             elsif ( $type eq "d" )
  894.             {
  895.                 $var = "Dword $_ [$liczba]; /* 32-bit integer or float or pointer */";
  896.             }
  897.             elsif ( $type eq "p" || $type eq "f" )
  898.             {
  899.                 $var = "far void * $_ [$liczba]; /* 48-bit number */";
  900.             }
  901.             elsif ( $type eq "q" )
  902.             {
  903.                 $var = "Qword $_ [$liczba]; /* 64-bit integer or double or pointer */";
  904.             }
  905.             else #if ( $type eq "t" )
  906.             {
  907.                 $var = "long double $_ [$liczba]; /* 80-bit long double */";
  908.             }
  909.         }
  910.         # traditional d[bwudpfqt]
  911.         elsif  ( $typ =~ /\bd([bwudpfqt])\s+(.*)$/i )
  912.         {
  913.             my $type;
  914.             my $reszta;
  915.             $type = $1;
  916.             $reszta = $2;
  917.             if ( $type eq "b" )
  918.             {
  919.                 if ( $reszta =~ /["',]/ )
  920.                 {
  921.                     $var = "char $_ [];";
  922.                 }
  923.                 else
  924.                 {
  925.                     $var = "char $_;";
  926.                 }
  927.             }
  928.             elsif ( $type eq "w" || $type eq "u" )
  929.             {
  930.                 if ( $reszta =~ /["',]/ )
  931.                 {
  932.                     $var = "short $_ [];";
  933.                 }
  934.                 else
  935.                 {
  936.                     $var = "short $_;";
  937.                 }
  938.             }
  939.             elsif ( $type eq "d" )
  940.             {
  941.                 if ( $reszta =~ /["',]/ )
  942.                 {
  943.                     $var = "Dword $_ []; /* 32-bit integer or float or pointer */";
  944.                 }
  945.                 else
  946.                 {
  947.                     $var = "Dword $_; /* 32-bit integer or float or pointer */";
  948.                 }
  949.             }
  950.             elsif ( $type eq "p" || $type eq "f" )
  951.             {
  952.                 if ( $reszta =~ /["',]/ )
  953.                 {
  954.                     $var = "far void * $_ []; /* 48-bit number */";
  955.                 }
  956.                 else
  957.                 {
  958.                     $var = "far void * $_; /* 48-bit number */";
  959.                 }
  960.             }
  961.             elsif ( $type eq "q" )
  962.             {
  963.                 if ( $reszta =~ /["',]/ )
  964.                 {
  965.                     $var = "Qword $_ []; /* 64-bit integer or double or pointer */";
  966.                 }
  967.                 else
  968.                 {
  969.                     $var = "Qword $_; /* 64-bit integer or double or pointer */";
  970.                 }
  971.             }
  972.             else #if ( $type eq "t" )
  973.             {
  974.                 if ( $reszta =~ /["',]/ )
  975.                 {
  976.                     $var = "long double $_ []; /* 80-bit long double */";
  977.                 }
  978.                 else
  979.                 {
  980.                     $var = "long double $_; /* 80-bit long double */";
  981.                 }
  982.             }
  983.         }
  984.         # other type given:
  985.         else
  986.         {
  987.             $typ =~ /(\w+)/i;
  988.             $var = "$1 $_;"
  989.         }
  990.     }
  991.     return $var;
  992. }
  993.  
  994. END { close(STDOUT) || die "$0: Can't close stdout: $!"; }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!