Platon Technologies
not logged in Login Registration
EnglishSlovak
open source software development celebrating 10 years of open source development! Saturday, October 17, 2026
[BACK] [TXT][DIR] Up to [Platon] / libco / utils

Diff for libco/utils/copp between version 1.4 and 1.5

version 1.4, 2003/03/09 10:32:38 version 1.5, 2003/03/15 15:23:17
Line 1 
Line 1 
 #!/usr/bin/perl  #!/usr/bin/perl
   
   # FIXME: this badly needs cleanup
   
   #use strict;
   
 my $ws = "[ \t\n]";  my $ws = "[ \t\n]";
   
 sub addid {  sub addid {
         my $l = shift;          my $l = shift;
         my $id = shift;          my $id = shift;
         unless (grep /^$T$id$/, @$l) {          unless (grep /^$id$/, @$l) {
                 #print STDERR "adding new id: $T - $id\n";                  #print STDERR "adding new id: $T - $id\n";
                 push @$l, "$T$id"                  push @$l, "$id"
         }          }
 }  }
   
Line 20  my %def_meth = (
Line 24  my %def_meth = (
         "fclone_c" => "co_clone_clean_full"          "fclone_c" => "co_clone_clean_full"
 );  );
   
   my %ptsmap = (
           "char *" => "s",
           "int" => "i",
           "long int" => "l"
   );
   
   my $initfunc_add;
   
 sub meth {  sub meth {
         my $in = shift;          my $in = shift;
         $_ = $in; my %msg; my %fwd; my %tab;          $_ = $in; my %msg; my %fwd; my %tab; my %pmtab;
         my @objs;          my @objs;
         while (s/CO_METH_INI$ws*\((.*?),(.*?)(?:,(.*?)|)\)//) {          while (s/CO_METH_INI$ws*\((.*?),(.*?)(?:,(.*?)|)\)//sm) {
                 my $o = $1;                  my $o = $1;
                 my $m = $2;                  my $m = $2;
                 my $argl = $3;                  my $argl = $3;
Line 33  sub meth {
Line 45  sub meth {
                 my $def = "#define CO_METH_INI_${o}_$m ";                  my $def = "#define CO_METH_INI_${o}_$m ";
                 #print STDERR "${o}_$m ($argl)\n";                  #print STDERR "${o}_$m ($argl)\n";
                 my @arg = split /,/, $argl;                  my @arg = split /,/, $argl;
                   my $pwrap = "static PyObject *${o}_${m}_PyWrap (PyObject * self,"
                           ."PyObject *args)\n";
                   my $pargdecl;
                   my $pargstr;
                   my $parglst;
                   my $carglst;
                 for (@arg) {                  for (@arg) {
                         s/^$ws+|$ws+$//g;                          s/^$ws+|$ws+$//g;
                         my $t = $_;                          my $t = $_;
                           my $n = $_;
                         $t =~ s/[a-zA-Z_@]+$//;                          $t =~ s/[a-zA-Z_@]+$//;
                         $t =~ s/^$ws+|$ws+$//g;                          $t =~ s/^$ws+|$ws+$//g;
                         #print STDERR "arg: $_ = va_arg (ap, $t);\n";                          #print STDERR "arg: $_ = va_arg (ap, $t);\n";
                           $n =~ s/.*?([a-zA-Z_@]+)$/$1/;
                           $n =~ s/^$ws+|$ws+$//g;
                         $def .= "$_ = va_arg (ap, $t); ";                          $def .= "$_ = va_arg (ap, $t); ";
                           $pargstr .= $ptsmap{$t};
                           $pargdecl .= "\t$_;\n";
                           $parglst .= "&$n, ";
                           $carglst .= "$n, ";
                 }                  }
                   $parglst =~ s/, $//;
                   $carglst =~ s/, $//;
                   $pwrap .= "{\n\tint __ok;\n$pargdecl\n\t__ok = PyArg_ParseTuple "
                           ."(args, \"$pargstr\"";
                   $pwrap .= ", $parglst" if ($parglst);
                   $pwrap .= ");";
                   $pwrap .= "\n\tCO_M (((co_o_python) self) -> co_object, $m";
                   $pwrap .= ", $carglst" if ($carglst);
                   $pwrap .= ");\n";
                   $pwrap .= "\treturn Py_BuildValue (\"i\", 0); \n}"; # FIXME
                   $def =~ s/; $//;
                 print OUT "$def\n";                  print OUT "$def\n";
                   print OUT "$pwrap\n";
                 #$msg{$o} = "\tCO_MH_BEGIN;\n" unless ($msg{$o});                  #$msg{$o} = "\tCO_MH_BEGIN;\n" unless ($msg{$o});
                 #$msg{$o} .= "\tCO_MH_CASE (message, $m) {\n\t\treturn "                  #$msg{$o} .= "\tCO_MH_CASE (message, $m) {\n\t\treturn "
                 #       ."${o}_$m (this, self, message, ap);\n\t}\n";                  #       ."${o}_$m (this, self, message, ap);\n\t}\n";
Line 49  sub meth {
Line 86  sub meth {
                         ." ap);\n";                          ." ap);\n";
                 $tab{$o} .= "\tco_meth_add (o -> __co_meth_ar, COM ($m),"                  $tab{$o} .= "\tco_meth_add (o -> __co_meth_ar, COM ($m),"
                         ." (co_msg_h) ${o}_$m);\n";                          ." (co_msg_h) ${o}_$m);\n";
                   $pmtab{$o} .= "{ \"$m\", ${o}_${m}_PyWrap, METH_VARARGS, \"$o: $m\"},";
                 push @objs, $o unless grep /^$o$/, @objs;                  push @objs, $o unless grep /^$o$/, @objs;
         }          }
         my $o;          my $o;
Line 105  sub meth {
Line 143  sub meth {
                 #print OUT "\tco_meth_add (o -> __co_meth_ar, COM (has_method),"                  #print OUT "\tco_meth_add (o -> __co_meth_ar, COM (has_method),"
                 #       ." co_has_method);\n";                  #       ." co_has_method);\n";
                 print OUT $tab{$_};                  print OUT $tab{$_};
                 print OUT "}\n\n";                  print OUT "}";
   print OUT <<EOF
   static PyObject *${_}_PyNew (PyObject *self, PyObject *args);
   
   static co ${_}_new2 (void)
   {
           co o;
           o = new (${_}_s);
           ${_}_meth_ar_init (o);
           CO_BLESS (o, $_, 0);
           return o;
   }
   
   static PyMethodDef ${_}_PyMethods[] = {
           {"new", ${_}_PyNew, METH_VARARGS, "create new $_"},
           {NULL, NULL, 0, NULL}
   };
   
   static PyMethodDef ${_}_PyObjMethods[] = {
           $pmtab{$_}
           {NULL, NULL, 0, NULL}
   };
   
   static PyObject *${_}_PyGetattr (PyObject *self, char *name)
   {
           CO_DEBUG (1, "get attr: \%s", name);
           return Py_FindMethod (${_}_PyObjMethods, self, name);
   }
   
   static PyTypeObject ${_}_PyTypeObject = {
           PyObject_HEAD_INIT(NULL)
           0,
           \"$_\",
           sizeof (co_o_python_s),
           0,
           co_o_python_del,
           0,
           ${_}_PyGetattr,
           0 /* setattr */
   };
   static PyObject * ${_}_PyNew (PyObject *self, PyObject *args) {
           co_o_python nwobj;
           nwobj = PyObject_New (co_o_python_s, &${_}_PyTypeObject);
           nwobj -> co_object = ${_}_new2 ();
           CO_DEBUG (1, "create obj: \%p", nwobj -> co_object);
           return nwobj;
   }
   EOF
   ;
                   $initfunc_add .= "\n\t${_}_PyTypeObject . ob_type = &PyType_Type;";
                   $initfunc_add .= "\n\tPy_InitModule (\"$_\", ${_}_PyMethods);";
         }          }
         #return \%msg;          #return \%msg;
 }  }
Line 170  while (scalar @ARGV) {
Line 258  while (scalar @ARGV) {
         $_ = shift @ARGV;          $_ = shift @ARGV;
         #print STDERR "'$_'\n";          #print STDERR "'$_'\n";
         if ($_ eq "-m") {          if ($_ eq "-m") {
                 &erruse if ($mode);                  #&erruse if ($mode);
                 $cmd = "meta";                  $cmd = "meta";
                 push @args, (shift @ARGV);                  push @args, (shift @ARGV);
         } elsif ($_ eq "-i") {          } elsif ($_ eq "-i") {
Line 256  sub meta {
Line 344  sub meta {
                 &addid (\@list, "M$_");                  &addid (\@list, "M$_");
         }          }
   
           print OUT "#include <co_python.h>\n";
         print OUT "#include <co_object.h>\n";          print OUT "#include <co_object.h>\n";
         print OUT "#include <co_super.h>\n";          print OUT "#include <co_super.h>\n";
         print OUT "#include <co_type.h>\n";          print OUT "#include <co_type.h>\n";
Line 275  sub meta {
Line 364  sub meta {
         print OUT "void __co_file_init_${file}$hash (co_super super) {\n";          print OUT "void __co_file_init_${file}$hash (co_super super) {\n";
         print OUT "\tCO_DEBUG (3, \"called\");\n";          print OUT "\tCO_DEBUG (3, \"called\");\n";
         &dump2 ($defs, \@list);          &dump2 ($defs, \@list);
           print OUT $initfunc_add;
         print OUT "}\n";          print OUT "}\n";
         close OUT;          close OUT;
 }  }
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5
Platon Group <platon@platon.org> http://platon.org/
Copyright © 2002-2006 Platon Group
Site powered by Metafox CMS 		Go to Top