Sep 30, 1995, 3:11 AM
Post #8 of 14
(2203 views)
Permalink
I tried my own ("real life") extension, and now it compiles and runs
(not sure that it does it correct, though). I needed some additions to
the posted code.
Target of the patch below is to make it possible to patch a portion of
.h file into .xs file without any change. I succeeded in my particular
case. For this I needed a new TYPEDEF section in .xs, and needed to
allow trailing comments in descriptions of structures.
Here is a piece of code _from_ my .xs:
============================================================
TYPEDEFS
typedef U32 ULONG;
typedef unsigned short USHORT;
typedef unsigned char UCHAR;
typedef I8 CHAR;
typedef void VOID;
typedef U32 UINT;
TYPE HASH
typedef struct qsGrec_s {
ULONG cThrds; /* number of threads in use */
ULONG Reserved1;
ULONG Reserved2;
}qsGrec_t;
/**********************************/
/* Thread record */
/**********************************/
typedef struct qsTrec_s {
ULONG RecType; /* Record Type */
/* Thread rectype = 100 */
USHORT tid; /* thread ID */
USHORT slot; /* "unique" thread slot number */
ULONG sleepid; /* sleep id thread is sleeping on */
ULONG priority; /* thread priority */
ULONG systime; /* thread system time */
ULONG usertime; /* thread user time */
UCHAR state; /* thread state */
CHAR pad1;
} qsTrec_t;
============================================================
What I'm missing a lot is FIRSTKEY and friends, to make examination of
structures from debugger simpler.
Ilya
PS A patch below corrects a couple of errors in the code as well, and
makes 3 or 4 cosmetic changes to make editing with emacs simpler.
*** F:/ckermit/get/XSUBPP-2.000a1/xsubpp Mon Jul 24 05:08:10 1995
--- xsubpp Sat Sep 30 02:41:14 1995
***************
*** 40,45 ****
--- 40,59 ----
$_[0] =~ s/^\s+|\s+$//go ;
}
+ sub TrimTrailingComment
+ {
+ $_[0] =~ s,/\*([^*]|\*[^/])*\*+/\s*$,,go ; # hairy enough?
+ }
+
+ sub SubstTypedefs {
+ my $first, $rest;
+ while (1) {
+ ($first, $rest) = ( $_[0] =~ /^([\w_]+)(.*)$/ );
+ last unless defined $first and defined $Typedefs{$first};
+ $_[0] = $Typedefs{$first} . $rest;
+ }
+ }
+
sub TidyType
{
local ($_) = @_ ;
***************
*** 54,62 ****
--- 68,82 ----
# change multiple whitespace into a single space
s/\s+/ /g ;
+ # trim trailing comment
+ TrimTrailingComment($_) ;
+
# trim leading & trailing whitespace
TrimWhitespace($_) ;
+ # Process typedefs
+ SubstTypedefs($_) ;
+
$_ ;
}
***************
*** 147,153 ****
# Return: the matched keyword if found, otherwise 0
sub check_keyword {
$_ = shift(@line) while !/\S/ && @line;
! s/^(\s*)($_[0])\s*:\s*(?:#.*)?/$1/s && $2;
}
--- 167,173 ----
# Return: the matched keyword if found, otherwise 0
sub check_keyword {
$_ = shift(@line) while !/\S/ && @line;
! s/^(\s*)($_[0])\s*:\s*(?:\#.*)?/$1/s && $2;
}
***************
*** 272,278 ****
print <<"EOF" ;
/*
* This file was generated automatically by xsubpp version $XSUBPP_version from the
! * contents of $filename. Don't edit this file, edit $filename instead.
*
* ANY CHANGES MADE HERE WILL BE LOST!
*
--- 292,298 ----
print <<"EOF" ;
/*
* This file was generated automatically by xsubpp version $XSUBPP_version from the
! * contents of $filename. Do not edit this file, edit $filename instead.
*
* ANY CHANGES MADE HERE WILL BE LOST!
*
***************
*** 333,338 ****
--- 353,401 ----
1;
}
+ sub TrimLeadingComments { # Delete whole comment lines from beg of @line
+ my $start;
+ while (@line) {
+ $start = shift @line;
+ TrimTrailingComment($start);
+ if ($start !~ /^\s*$/) {
+ unshift @line, $start;
+ last;
+ }
+ }
+ }
+
+ %Typedefs = ();
+
+ sub ParseTypedefs {
+ my ($copy, $source, $dest, @words);
+ for $line (@_) {
+ $copy = $line;
+
+ # remove any trailing ;
+ $line =~ s/\s*;\s*$// ;
+
+ # trim whitespace
+ TrimWhitespace($line);
+
+ #
+ blurt("Error: invalid typedef in line '$copy'"), next
+ unless ($line =~ s/^\s*typedef\s+//);
+ @words = split ' ', $line;
+
+ # We consider only the case when the source is the last word on the line
+ $source = pop @words;
+ $dest = join ' ', @words;
+
+ # move leading stars from source to destination
+ $dest .= $1 if $source =~ s/^(\*+)//;
+ blurt("Error: invalid source '$source' in line '$copy'"), next
+ unless ($source =~ /^[\w_]+$/);
+ $Typedefs{$source} = $dest;
+ }
+ }
+
+
$Section = 'XSUB' ;
PARAGRAPH:
***************
*** 358,363 ****
--- 421,427 ----
undef(%arg_list) ;
+ TrimLeadingComments;
$_ = shift(@line);
if (check_keyword("BOOT")) {
&check_cpp;
***************
*** 369,375 ****
my($ret_type) = TidyType($_);
# Check for change of section
! if ($ret_type =~ s/^(TYPE|XSUB|VAR)\s*//) {
$Section = $1 ;
if ($Section eq 'TYPE') {
--- 433,439 ----
my($ret_type) = TidyType($_);
# Check for change of section
! if ($ret_type =~ s/^(TYPE(DEFS)?|XSUB|VAR)\s*//) {
$Section = $1 ;
if ($Section eq 'TYPE') {
***************
*** 402,407 ****
--- 466,476 ----
next PARAGRAPH ;
}
+ if ($Section eq 'TYPEDEFS') {
+ ParseTypedefs($ret_type, @line) ;
+ next PARAGRAPH ;
+ }
+
# Default section is XSUB
# a function definition needs at least 2 lines
***************
*** 742,749 ****
$subexpr =~ s/ntype/subtype/g;
$subexpr =~ s/\$arg/ST(ix_$var)/g;
$subexpr =~ s/\n\t/\n\t\t/g;
! $subexpr =~ s/is not of (.*")/[arg %d] is not of $1, ix_$var + 1/g;
! $subexpr =~ s/\$var/${var}[ix_$var - $argoff]/;
$expr =~ s/DO_ARRAY_ELEM/$subexpr/;
}
if (defined($defaults{$var})) {
--- 811,818 ----
$subexpr =~ s/ntype/subtype/g;
$subexpr =~ s/\$arg/ST(ix_$var)/g;
$subexpr =~ s/\n\t/\n\t\t/g;
! $subexpr =~ s/is not of (.*\")/[arg %d] is not of $1, ix_$var + 1/g;
! $subexpr =~ s/\$var/$ {var}[ix_$var - $argoff]/;
$expr =~ s/DO_ARRAY_ELEM/$subexpr/;
}
if (defined($defaults{$var})) {
***************
*** 1406,1411 ****
--- 1475,1483 ----
my ($array_size) ;
my ($got_array) = 0 ;
+ # remove trailing comment
+ TrimTrailingComment($line) ;
+
# remove leading & trailing whitespace
TrimWhitespace($line) ;
***************
*** 1455,1469 ****
my (%tailor) ;
my (%elements) ;
my (%methods) ;
blurt ("Error: No structure definition for $struct_name"), return
unless @line ;
# remove any trailing {
! $struct_name =~ s/\s*{\s*$// ;
# trim whitespace
TrimWhitespace($struct_name) ;
$struct_type = $struct_name ;
# fatal error if no structure name present
--- 1527,1543 ----
my (%tailor) ;
my (%elements) ;
my (%methods) ;
+ my $typedefed;
blurt ("Error: No structure definition for $struct_name"), return
unless @line ;
# remove any trailing {
! $struct_name =~ s/\s*\{\s*$// ;
# trim whitespace
TrimWhitespace($struct_name) ;
+ $typedefed = 1 if $struct_name =~ s/^\s*(typedef)\s+// ;
$struct_type = $struct_name ;
# fatal error if no structure name present
***************
*** 1491,1498 ****
$_ = shift(@line) ;
! s/^\s*{\s*// ;
! s/\s*}\s*;?\s*$// ;
next if /^\s*$/ ;
#my ($decl, $init) = split(/\s*=\s*/, $_, 2) ;
--- 1565,1583 ----
$_ = shift(@line) ;
! s/^\s*\{\s*// ;
!
! TrimTrailingComment($_);
!
! s/\s*\}\s*;?\s*$// ;
!
! if ($typedefed
! && s/\s*\}\s*([\w_]+[\s,]*)+\s*;?\s*$//) { # process typedefs
! foreach $word (split /[,\s]+/, $1) {
! $Typedefs{$word} = "struct $struct_name";
! }
! }
!
next if /^\s*$/ ;
#my ($decl, $init) = split(/\s*=\s*/, $_, 2) ;
***************
*** 1584,1590 ****
#
# ST(0) = Ref2Tied($t_HASH, "${Package}::$struct_name",
# sizeof($struct_type), 1,
# ) ;
EOF
foreach $element (@struct) {
--- 1669,1675 ----
#
# ST(0) = Ref2Tied($t_HASH, "${Package}::$struct_name",
# sizeof($struct_type), 1,
# ) ;
EOF
foreach $element (@struct) {
***************
*** 1829,1835 ****
#
# ST(0) = Ref2Tied($t_ARRAY, "${Package}::$array_name",
# sizeof($array_type) , $array_size,
# ) ;
# XSRETURN(1);
#]]
--- 1914,1920 ----
#
# ST(0) = Ref2Tied($t_ARRAY, "${Package}::$array_name",
# sizeof($array_type) , $array_size,
# ) ;
# XSRETURN(1);
#]]
***************
*** 2038,2044 ****
#
# ST(0) = Ref2Tied($t_SCALAR, "${Package}::$scalar_name",
# sizeof($scalar_type), 1,
# ) ;
# XSRETURN(1);
#]]
--- 2123,2129 ----
#
# ST(0) = Ref2Tied($t_SCALAR, "${Package}::$scalar_name",
# sizeof($scalar_type), 1,
# ) ;
# XSRETURN(1);
#]]
***************
*** 2202,2207 ****
--- 2287,2293 ----
#int type ;
#char * name ;
#unsigned size ;
+ #unsigned count ;
#void * pointer ;
#int clone ;
#[[