tools/util/ncidef2pasm.pl

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