Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: nwellnhof/comp…
Fetching contributors…

Cannot retrieve contributors at this time

executable file 240 lines (155 sloc) 4.554 kb
#! perl
# Copyright (C) 2003-2011, Parrot Foundation.
=head1 NAME
tools/dev/ncidef2pir.pl - Turn an NCI library definition file into PIR
=head1 SYNOPSIS
perl tools/dev/ncidef2pir.pl path/to/from_file [ path/to/to_file ]
=head1 DESCRIPTION
This program takes an NCI library definition file and creates a PIR file
which loads the described library.
An NCI library definition file provides the information needed to
generate a parrot wrapper for the named library (or libraries). Its
format is simple, and looks like:
[package]
ncurses
[lib]
libform.so
[defs]
p new_field i i i i i i
[lib]
libncurses.so
[defs]
i is_term_resized i i
Note that the assembly file is generated in the order you specify, so
if there are library dependencies, make sure you have them in the
correct order.
=head2 package
Declares the package that all subsequent sub PMCs will be put
into. Double colon is used to to delimit namespaces.
=head2 lib
The name of the library to be loaded. Should be as qualified as
necessary for your platform--generally the full filename is required,
though the directory generally isn't.
You may load multiple libraries here, but only the last one loaded
will be exposed to subsequent defs.
=head2 defs
This section holds the definitions of functions. Each function is
assumed to be in the immediate preceding library. The definition of
the function is:
return_type name [param [param [param ...]]]
The param and return_type parameters use the NCI standard, which for
reference is:
=over 4
=item p
Parameter is a void pointer, taken from the PMC's data pointer. PMC is
assumed to be an unmanagedstruct or child class.
Taken from a P register
=item c
Parameter is a character.
Taken from an I register
=item s
Parameter is a short
Taken from an I register
=item i
Parameter is an int
Taken from an I register
=item l
Parameter is a long
Taken from an I register
=item f
Parameter is a float
Taken from an N register.
=item d
Parameter is a double.
Taken from an N register.
=item t
Parameter is a char *, presumably a C string
Taken from an S register
=item v
Void. Only valid as a return type, noting that the function returns no data.
=item I
Interpreter pointer. The current interpreter pointer is passed in
=item P
PMC.
=item 2
Pointer to short.
Taken from an I register.
=item 3
Pointer to int.
Taken from an I register
=item 4
Pointer to long
Taken from an I register
=back
=cut
use strict;
use warnings;
my ( $from_file, $to_file ) = @ARGV;
# If there is no destination file, strip off the extension of the
# source file and add a .pasm to it
if ( !defined $to_file ) {
$to_file = $from_file;
$to_file =~ s/\.[^.]*$//;
$to_file .= ".pir";
}
open my $INPUT, '<', "$from_file" or die "Can't open up $from_file, error $!";
open my $OUTPUT, '>', "$to_file" or die "Can't open up $to_file, error $!";
# Have the library initialized on load
print $OUTPUT <<EOR;
.sub '' :anon :load
.local pmc lib, nci
EOR
my @libs;
my ( $cur_package, $line, $cur_section );
# Our dispatch table
my (%dispatch) = (
package => \&package_line,
lib => \&lib_line,
defs => \&def_line,
);
while ( $line = <$INPUT> ) {
# Throw away trailing newlines, comments, and whitespace. If the
# line's empty, then off to the next line
chomp $line;
$line =~ s/#.*//;
$line =~ s/\s*$//;
next unless $line;
# Is it a section line? If so, extract the section and set it.
if ( $line =~ /\[(\w+)\]/ ) {
$cur_section = $1;
next;
}
# Everything else goes to the handler
$dispatch{$cur_section}->($line);
}
# Put the registers back and end
print $OUTPUT ".end\n";
close $OUTPUT;
sub package_line {
my $line = shift;
# Trim leading and trailing spaces
$line =~ s/^\s*//;
$line =~ s/\s*$//;
# Set the global current package
$cur_package = [ split /::/, $line ];
}
sub lib_line {
my $line = shift;
print $OUTPUT " loadlib lib, '$line'\n";
}
sub def_line {
my $line = shift;
my ( $return_type, $name, @params ) = split ' ', $line;
unshift @params, $return_type;
my $signature = join( "", @params );
print $OUTPUT " dlfunc nci, lib, '$name', '$signature'\n";
print $OUTPUT " set_global " .
"[" . (join ";", (map {"'$_'"} @$cur_package)) . "]" .
", '${name}', nci\n";
}
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4:
Jump to Line
Something went wrong with that request. Please try again.