accessor.pl

#!/usr/bin/perl -w

# accessor.pl: generate accessor functions
# Copyright (c) 2003-2021 Philip Kendall, Sergio Baldoví

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

# Author contact information:

# E-mail: philip-fuse@shadowmagic.org.uk

use strict;

sub dump_accessor_declaration ($);
sub dump_accessor_initialisation ($);
sub dump_accessor_free ($);
sub dump_accessor_indexed ($$);
sub dump_accessor_simple ($$);

my @accessors;

while(<>) {

    # Blank lines
    next if /^\s*$/;

    # Perl comments
    next if /^\s*#/;

    my $item = { };

    # Leading C comment
    if( /^\s*\/\*/ ) {
      $item->{section_comment} = $_;
    } else {
       # Trailing C comment
       if( /^.+\/\*(.*)\*\// ) {
         $item->{line_comment} = $1;
         s/\/\*(.*)\*\///;
       }

       ( $item->{type}, $item->{name}, $item->{indexed}, $item->{value} ) = split;
    }

    push @accessors, $item;
}

print << "CODE";
/* snap_accessors.c: simple accessor functions for libspectrum_snap
   Copyright (c) 2003-2009 Philip Kendall

   This program is free software; you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 2 of the License, or
   (at your option) any later version.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License along
   with this program; if not, write to the Free Software Foundation, Inc.,
   51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

   Author contact information:

   E-mail: philip-fuse\@shadowmagic.org.uk

*/

/* NB: this file is autogenerated from snap_accessors.txt by accessor.pl */

#include "config.h"

#include "internals.h"

struct libspectrum_snap {
CODE

foreach my $item ( @accessors ) {
  dump_accessor_declaration( $item );
}

print << "CODE";
};

/* Initialise a libspectrum_snap structure */
libspectrum_snap*
libspectrum_snap_alloc( void )
{
  libspectrum_snap* snap;
  size_t i;

  snap = libspectrum_new( libspectrum_snap, 1 );
CODE

foreach my $item ( @accessors ) {
  dump_accessor_initialisation( $item );
}

print << "CODE";

  return snap;
}

/* Free all memory used by a libspectrum_snap structure (destructor...) */
libspectrum_error
libspectrum_snap_free( libspectrum_snap *snap )
{
  size_t i;
CODE

foreach my $item ( @accessors ) {
  dump_accessor_free( $item );
}

print << "CODE";

  libspectrum_free( snap );

  return LIBSPECTRUM_ERROR_NONE;
}

CODE

# Dump accessor functions
foreach my $item ( @accessors ) {
  next if $item->{section_comment};

  if( $item->{indexed} ) {
    dump_accessor_indexed( $item->{type}, $item->{name} );
  } else {
    dump_accessor_simple( $item->{type}, $item->{name} );
  }
}

sub dump_accessor_declaration ($) {

  my( $item ) = @_;

  if( $item->{section_comment} ) {
    print "\n  ", $item->{section_comment};
    return;
  }

  if( $item->{indexed} eq "1" ) {
    print "  $item->{type} $item->{name}\[1\];";
  } elsif( $item->{indexed} ) {
    print "  $item->{type} $item->{name}\[ $item->{indexed} \];";
  } else {
    print "  $item->{type} $item->{name};";
  }

  if( $item->{line_comment} ) {
    print "	/*$item->{line_comment}*/\n";
  } else {
    print "\n";
  }
}

sub dump_accessor_initialisation ($) {

  my( $item ) = @_;

  if( $item->{section_comment} ) {
    print "\n  ", $item->{section_comment};
    return;
  }

  my $value;
  if( $item->{value} ) {
    $value = $item->{value};
  } elsif( $item->{type} =~ /^(.*)\*/ ) {
    $value = "NULL";
  } else {
    $value = "0";
  }

  if( $item->{indexed} eq "1" ) {
    print "  libspectrum_snap_set_$item->{name}( snap, 0, $value );\n";
  } elsif( $item->{indexed} ) {
    print "  for( i = 0; i < $item->{indexed}; i++ )\n";
    print "    libspectrum_snap_set_$item->{name}( snap, i, $value );\n";
  } else {
    print "  libspectrum_snap_set_$item->{name}( snap, $value );\n";
  }

}

my $new_section = 0;

sub dump_accessor_free ($) {

  my( $item ) = @_;

  if( $item->{section_comment} ) {
    $new_section = 1;
    return;
  }

  # Free only pointers
  if( $item->{type} !~ /^(.*)\*/ ) {
    return;
  }

  # Cosmetic separator
  if( $new_section ) {
    print "\n" ;
    $new_section = 0;
  }

  if( $item->{indexed} eq "1" ) {
    print "  libspectrum_free( libspectrum_snap_$item->{name}( snap, 0 ) );\n";
  } elsif( $item->{indexed} ) {
    print "  for( i = 0; i < $item->{indexed}; i++ )\n";
    print "    libspectrum_free( libspectrum_snap_$item->{name}( snap, i ) );\n";
  } elsif( $item->{name} eq "slt_screen" ) {
    print "  libspectrum_free( libspectrum_snap_$item->{name}( snap ) );\n";
  } else {
    die "Unexpected data declaration: $item->{type} $item->{name}"
  }
}

sub dump_accessor_indexed ($$) {

  my( $type, $name ) = @_;

  print << "CODE";

$type
libspectrum_snap_$name( libspectrum_snap *snap, int idx )
{
  return snap->$name\[idx\];
}

void
libspectrum_snap_set_$name( libspectrum_snap *snap, int idx, $type $name )
{
  snap->$name\[idx\] = $name;
}
CODE

}

sub dump_accessor_simple ($$) {

  my( $type, $name ) = @_;

  print << "CODE";

$type
libspectrum_snap_$name( libspectrum_snap *snap )
{
  return snap->$name;
}

void
libspectrum_snap_set_$name( libspectrum_snap *snap, $type $name )
{
  snap->$name = $name;
}
CODE

}