tools/dev/ncidef2pasm.pl

   1 #! perl
   2
   3 # Copyright (C) 2003-2007, Parrot Foundation.
   4 # $Id$
   5
   6 =head1 NAME
   7
   8 tools/dev/ncidef2asm.pl - Turn an NCI library definition file into PASM
   9
  10 =head1 SYNOPSIS
  11
  12     perl tools/dev/ncidef2asm.pl path/to/from_file [ path/to/to_file ]
  13
  14 =head1 DESCRIPTION
  15
  16 This program takes an NCI library definition file and turns it into PASM.
  17
  18 An NCI library definition file provides the information needed to
  19 generate a parrot wrapper for the named library (or libraries). Its
  20 format is simple, and looks like:
  21
  22   [package]
  23   ncurses
  24
  25   [lib]
  26   libform.so
  27
  28   [defs]
  29   p new_field i i i i i i
  30
  31   [lib]
  32   libncurses.so
  33
  34   [defs]
  35   i is_term_resized i i
  36
  37 Note that the assembly file is generated in the order you specify, so
  38 if there are library dependencies, make sure you have them in the
  39 correct order.
  40
  41 =head2 package
  42
  43 Declares the package that all subsequent sub PMCs will be put
  44 into. The name is a simple concatenation of the package name, double
  45 colon, and the routine name, with no preceding punctuation.
  46
  47 =head2 lib
  48
  49 The name of the library to be loaded. Should be as qualified as
  50 necessary for your platform--generally the full filename is required,
  51 though the directory generally isn't.
  52
  53 You may load multiple libraries here, but only the last one loaded
  54 will be exposed to subsequent defs.
  55
  56 =head2 defs
  57
  58 This section holds the definitions of functions. Each function is
  59 assumed to be in the immediate preceding library. The definition of
  60 the function is:
  61
  62   return_type name [param [param [param ...]]]
  63
  64 The param and return_type parameters use the NCI standard, which for
  65 reference is:
  66
  67 =over 4
  68
  69 =item p
  70
  71 Parameter is a void pointer, taken from the PMC's data pointer. PMC is
  72 assumed to be an unmanagedstruct or child class.
  73
  74 Taken from a P register
  75
  76 =item c
  77
  78 Parameter is a character.
  79
  80 Taken from an I register
  81
  82 =item s
  83
  84 Parameter is a short
  85
  86 Taken from an I register
  87
  88 =item i
  89
  90 Parameter is an int
  91
  92 Taken from an I register
  93
  94 =item l
  95
  96 Parameter is a long
  97
  98 Taken from an I register
  99
 100 =item f
 101
 102 Paramter is a float
 103
 104 Taken from an N register.
 105
 106 =item d
 107
 108 Parameter is a double.
 109
 110 Taken from an N register.
 111
 112 =item t
 113
 114 Paramter is a char *, presumably a C string
 115
 116 Taken from an S register
 117
 118 =item v
 119
 120 Void. Only valid as a return type, noting that the function returns no data.
 121
 122 =item I
 123
 124 Interpreter pointer. The current interpreter pointer is passed in
 125
 126 =item P
 127
 128 PMC.
 129
 130 =item 2
 131
 132 Pointer to short.
 133
 134 Taken from an I register.
 135
 136 =item 3
 137
 138 Pointer to int.
 139
 140 Taken from an I register
 141
 142 =item 4
 143
 144 Pointer to long
 145
 146 Taken from an I register
 147
 148 =back
 149
 150 =cut
 151
 152 use strict;
 153 use warnings;
 154
 155 my ( $from_file, $to_file ) = @ARGV;
 156
 157 # If there is no destination file, strip off the extension of the
 158 # source file and add a .pasm to it
 159 if ( !defined $to_file ) {
 160     $to_file = $from_file;
 161     $to_file =~ s/\..*$//;
 162     $to_file .= ".pasm";
 163 }
 164
 165 open my $INPUT,  '<', "$from_file" or die "Can't open up $from_file, error $!";
 166 open my $OUTPUT, '>', "$to_file"   or die "Can't open up $to_file, error $!";
 167
 168 # To start, save all the registers, just in case
 169 print $OUTPUT "saveall\n";
 170
 171 my @libs;
 172 my ( $cur_package, $line, $cur_section );
 173
 174 # Our dispatch table
 175 my (%dispatch) = (
 176     package => \&package_line,
 177     lib     => \&lib_line,
 178     defs    => \&def_line,
 179 );
 180
 181 while ( $line = <$INPUT> ) {
 182
 183     # Throw away trailing newlines, comments, and whitespace. If the
 184     # line's empty, then off to the next line
 185     chomp $line;
 186     $line =~ s/#.*//;
 187     $line =~ s/\s*$//;
 188     next unless $line;
 189
 190     # Is it a section line? If so, extract the section and set it.
 191     if ( $line =~ /\[(\w+)\]/ ) {
 192         $cur_section = $1;
 193         next;
 194     }
 195
 196     # Everything else goes to the handler
 197     $dispatch{$cur_section}->($line);
 198
 199 }
 200
 201 # Put the registers back and end
 202 print $OUTPUT "restoreall\n";
 203 print $OUTPUT "end\n";
 204 close $OUTPUT;
 205
 206 sub package_line {
 207     my $line = shift;
 208
 209     # Trim leading and trailing spaces
 210     $line =~ s/^\s*//;
 211     $line =~ s/\s*$//;
 212
 213     # Set the global current package
 214     $cur_package = $line;
 215
 216 }
 217
 218 sub lib_line {
 219     my $line = shift;
 220     print $OUTPUT "loadlib P1, '$line'\n";
 221 }
 222
 223 sub def_line {
 224     my $line = shift;
 225     my ( $return_type, $name, @params ) = split ' ', $line;
 226     unshift @params, $return_type;
 227     my $signature = join( "", @params );
 228     print $OUTPUT "dlfunc P2, P1, '$name', '$signature'\n";
 229     print $OUTPUT "store_global '${cur_package}::${name}', P2\n";
 230 }
 231
 232 # Local Variables:
 233 #   mode: cperl
 234 #   cperl-indent-level: 4
 235 #   fill-column: 100
 236 # End:
 237 # vim: expandtab shiftwidth=4: