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

Diff for libco/utils/copp between version 1.6 and 1.7

version 1.6, 2003/03/23 11:02:38 version 1.7, 2003/03/30 10:27:46
Line 16  sub addid {
Line 16  sub addid {
 }  }
   
 my %def_meth = (  my %def_meth = (
         "has_method" => "co_has_method",          "event" => "co_o_default_event",
         "sclone" => "#OBJ#_clone_shallow",          "delete" => "co_o_#FLAV#_delete",
         "dclone" => "co_clone_deep",          "clone" => "co_o_#FLAV#_clone",
         "fclone" => "co_clone_full",          "destroy2" => "co_o_#FLAV#_destroy"
         "dclone_c" => "co_clone_clean",          #"has_method" => "co_os_method",
         "fclone_c" => "co_clone_clean_full"          #"sclone" => "#OBJ#_clone_shallow",
           #"dclone" => "co_clone_deep",
           #"fclone" => "co_clone_full",
           #"dclone_c" => "co_clone_clean",
           #"fclone_c" => "co_clone_clean_full"
 );  );
   
 my %ptsmap = (  my %ptsmap = (
Line 35  my $initfunc_add;
Line 39  my $initfunc_add;
 sub meth {  sub meth {
         my $in = shift;          my $in = shift;
         $_ = $in; my %msg; my %fwd; my %tab; my %pmtab;          $_ = $in; my %msg; my %fwd; my %tab; my %pmtab;
           my %flav;
         my @objs;          my @objs;
         while (s/CO_METH_INI$ws*\((.*?),(.*?)(?:,(.*?)|)\)//sm) {          while (s/CO_METH$ws*\((.*?),(.*?)(?:,(.*?)|)\)//sm) {
                 my $o = $1;                  my $o = $1;
                 my $m = $2;                  my $m = $2;
                 my $argl = $3;                  my $argl = $3;
Line 76  sub meth {
Line 81  sub meth {
                 $pwrap .= ", $carglst" if ($carglst);                  $pwrap .= ", $carglst" if ($carglst);
                 $pwrap .= ");\n";                  $pwrap .= ");\n";
                 $pwrap .= "\treturn Py_BuildValue (\"i\", 0); \n}"; # FIXME                  $pwrap .= "\treturn Py_BuildValue (\"i\", 0); \n}"; # FIXME
                 $def =~ s/; $//;                  #$def =~ s/; $//;
                   $def .= "$o td CO_POSSIBLY_UNUSED = this -> data";
                 print OUT "$def\n";                  print OUT "$def\n";
                 print OUT "$pwrap\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";
                 $fwd{$o} .= "co_v ${o}_$m ($o this, co self, co_id_t message, va_list"                  $fwd{$o} .= "co_v ${o}_$m (co_o_minimal this, co self, co_id_t message, va_list"
                         ." ap);\n";                          ." ap);\n";
                 $tab{$o} .= "\tco_meth_add (o -> __co_meth_ar, COM ($m),"                  $tab{$o} .= "\tco_meth_add (o -> meth_ar, COM ($m),"
                         ." (co_msg_h) ${o}_$m);\n";                          ." (co_message_handler) ${o}_$m);\n";
                 $pmtab{$o} .= "{ \"$m\", ${o}_${m}_PyWrap, METH_VARARGS, \"$o: $m\"},";                  $pmtab{$o} .= "{ \"$m\", ${o}_${m}_PyWrap, METH_VARARGS, \"$o: $m\"},";
                 push @objs, $o unless grep /^$o$/, @objs;                  push @objs, $o unless grep /^$o$/, @objs;
         }          }
Line 93  sub meth {
Line 99  sub meth {
         while (s/(CO_OBJECT|CO_ATTR)$ws*\((.*?)\)//) {          while (s/(CO_OBJECT|CO_ATTR)$ws*\((.*?)\)//) {
                 my $match = $1;                  my $match = $1;
                 if ($match eq "CO_OBJECT") {                  if ($match eq "CO_OBJECT") {
                           my $fl;
                         $o = $2;                          $o = $2;
                           $o =~ s/(.*?),(.*)/$1/;
                           $fl = $2;
                           $fl =~ s/^[ \t]*|[ \t]*$//g;
                           $flav{$o} = $fl;
                         #push @objs, $o;                          #push @objs, $o;
                         push @objs, $o unless grep /^$o$/, @objs;                          push @objs, $o unless grep /^$o$/, @objs;
                 } else {                  } else {
Line 107  sub meth {
Line 118  sub meth {
                         #       ."&(this -> $m));\n\t}\n";                          #       ."&(this -> $m));\n\t}\n";
                         #$fwd{$o} .= "co_v ${o}_$m (co this, co self, co_id_t message, va_list"                          #$fwd{$o} .= "co_v ${o}_$m (co this, co self, co_id_t message, va_list"
                         #       ." ap);\n";                          #       ." ap);\n";
                         $tab{$o} .= "\tco_meth_add (o -> __co_meth_ar, COM ($m),"                          $tab{$o} .= "\tco_meth_add (o -> meth_ar, COM ($m),"
                                 ." (co_msg_h) ${o}_$m);\n";                                  ." (co_message_handler) ${o}_$m);\n";
                         $fwd{$o} .= "static co_v ${o}_$m ($o this, co self"                          $fwd{$o} .= "
                                 . " CO_POSSIBLY_UNUSED, co_id_t message CO_POSSIBLY_UNUSED,"  static co_v ${o}_$m (co this,
                                 . " va_list ap CO_POSSIBLY_UNUSED)\n"          co self CO_POSSIBLY_UNUSED,
                                 . "{\n\tCO_RETURN (${t}_p, &(this -> $m));\n}\n";          co_id_t message CO_POSSIBLY_UNUSED,
           va_list ap CO_POSSIBLY_UNUSED)
   {
           $o td = ((co_o_minimal) this) -> data;
           CO_RETURN (${t}_p, &(td -> $m));
   }";
                 }                  }
         }          }
         for (@objs) {          for (@objs) {
Line 120  sub meth {
Line 136  sub meth {
                 for (keys %def_meth) {                  for (keys %def_meth) {
                         my $meth = $def_meth{$_};                          my $meth = $def_meth{$_};
                         $meth =~ s/#OBJ#/$o/;                          $meth =~ s/#OBJ#/$o/;
                           $meth =~ s/#FLAV#/$flav{$o}/;
                         #$fwd{$o} .= "co_v $def_meth{$_} (co this, co self, "                          #$fwd{$o} .= "co_v $def_meth{$_} (co this, co self, "
                         #       ."co_id_t message, va_list ap);\n";                          #       ."co_id_t message, va_list ap);\n";
                         $tab{$o} .= "\tco_meth_add (o -> __co_meth_ar,"                          $tab{$o} .= "\tco_meth_add (o -> meth_ar,"
                                 ." COM ($_), $meth);\n";                                  ." COM ($_), $meth);\n";
                 }                  }
         }          }
         for (@objs) {          for (@objs) {
                 print OUT "\n";                  print OUT "\n// FWD FOR $_\n";
                 print OUT $fwd{$_}."\n";                  print OUT $fwd{$_}."\n";
 print OUT <<EOF  print OUT <<EOF
 static co_v ${_}_clone_shallow (co _src)  static co_v ${_}_clone_shallow (co _src)
Line 152  EOF
Line 169  EOF
                 #print OUT "\tCO_RETURN (int, 0xBAD0);\n";                  #print OUT "\tCO_RETURN (int, 0xBAD0);\n";
                 #print OUT "} */\n";                  #print OUT "} */\n";
                 print OUT "\nstatic void ${_}_meth_ar_init (co object) {\n";                  print OUT "\nstatic void ${_}_meth_ar_init (co object) {\n";
                 print OUT "\tco_o_head_full o = object;\n";                  print OUT "\tco_o_small o = object;\n";
                 print OUT "\to -> __co_meth_ar = co_meth_array_new ();\n";                  print OUT "\to -> meth_ar = co_meth_array_new ();\n";
                 #print OUT "\tco_meth_add (o -> __co_meth_ar, COM (has_method),"                  #print OUT "\tco_meth_add (o -> meth_ar, COM (has_method),"
                 #       ." co_has_method);\n";                  #       ." co_has_method);\n";
                 print OUT $tab{$_};                  print OUT $tab{$_};
                 print OUT "}";                  print OUT "}";
                   my $flavor = $flav{$_};
 print OUT <<EOF  print OUT <<EOF
 static PyObject *${_}_PyNew (PyObject *self, PyObject *args);  static PyObject *${_}_PyNew (PyObject *self, PyObject *args);
   
 static co ${_}_new2 (void)  // create new (unblessed) object - blessings shalt be received later
   co ${_}_new (void)
 {  {
         co o;          co o = co_o_${flavor}_new ();
         o = new (${_}_s);  
         ${_}_meth_ar_init (o);          ${_}_meth_ar_init (o);
         CO_BLESS (o, $_, 0);          CO_M (o, init);
         return o;          return o;
 }  }
   
Line 200  static PyTypeObject ${_}_PyTypeObject =
Line 218  static PyTypeObject ${_}_PyTypeObject =
 static PyObject * ${_}_PyNew (PyObject *self, PyObject *args) {  static PyObject * ${_}_PyNew (PyObject *self, PyObject *args) {
         co_o_python nwobj;          co_o_python nwobj;
         nwobj = PyObject_New (co_o_python_s, &${_}_PyTypeObject);          nwobj = PyObject_New (co_o_python_s, &${_}_PyTypeObject);
         nwobj -> co_object = ${_}_new2 ();          nwobj -> co_object = ${_}_new ();
         CO_DEBUG (1, "create obj: \%p", nwobj -> co_object);          CO_DEBUG (1, "create obj: \%p", nwobj -> co_object);
         return nwobj;          return nwobj;
 }  }
Line 267  my $suff = ".cometa";
Line 285  my $suff = ".cometa";
 my $check = 1;  my $check = 1;
 my $ahash = 1;  my $ahash = 1;
 my $header = "";  my $header = "";
   my $hash;
   
 while (scalar @ARGV) {  while (scalar @ARGV) {
         $_ = shift @ARGV;          $_ = shift @ARGV;
Line 300  while (scalar @ARGV) {
Line 319  while (scalar @ARGV) {
   
 &$cmd (@args);  &$cmd (@args);
   
   
 sub getf {  sub getf {
         my $file = shift;          my $file = shift;
         my $in;          my $in;
           my $noh;
         if ($header) {          if ($header) {
                 open (IN, $header);                  open (IN, $header);
                 $in .= $_ while (<IN>);                  $in .= $_ while (<IN>);
                 close (IN);                  close (IN);
         }          }
         open (IN, $file);          open (IN, $file);
         $in .= $_ while (<IN>);          while (<IN>) {
                   $in .= $_;
                   $noh .= $_;
           }
         close (IN);          close (IN);
         $in =~ s!(\#if 0\n).*?(\#endif /\* 0 \*/\n)!!gsm;          $in =~ s!(\#if 0\n).*?(\#endif /\* 0 \*/\n)!!gsm;
         $in =~ s/\/\*.*?\*\///gsm;          $in =~ s/\/\*.*?\*\///gsm;
         $in =~ s/\/\/.*?$//gsm;          $in =~ s/\/\/.*?$//gsm;
           $noh =~ s!(\#if 0\n).*?(\#endif /\* 0 \*/\n)!!gsm;
           $noh =~ s/\/\*.*?\*\///gsm;
           $noh =~ s/\/\/.*?$//gsm;
           $hash = &Digest::SHA1::sha1_hex ($noh);
         return $in;          return $in;
 }  }
   
Line 323  sub meta {
Line 351  sub meta {
         #print STDERR "out: \">$out\"\n";          #print STDERR "out: \">$out\"\n";
         open (OUT, ">$out");          open (OUT, ">$out");
   
         my $hash = &Digest::SHA1::sha1_hex ($in);  
   
         my @list;          my @list;
         &append ($in, qr/\bCO_CNT$ws*\(.*?,(.*?),/, \@list, "E");          &append ($in, qr/\bCO_CNT$ws*\(.*?,(.*?),/, \@list, "E");
         &append ($in, qr/\bCO_CNT$ws*\(.*?,.*?,.*?,(.*?)\)/, \@list, "M");          &append ($in, qr/\bCO_CNT$ws*\(.*?,.*?,.*?,(.*?)\)/, \@list, "M");
Line 333  sub meta {
Line 359  sub meta {
         &append ($in, qr/\bCO_ATTR$ws*\(.*?,(.*?)[,)]/, \@list, "M");          &append ($in, qr/\bCO_ATTR$ws*\(.*?,(.*?)[,)]/, \@list, "M");
         &append ($in, qr/\bCO_METH$ws*\(.*?,(.*?)[,)]/, \@list, "M");          &append ($in, qr/\bCO_METH$ws*\(.*?,(.*?)[,)]/, \@list, "M");
         &append ($in, qr/\bCO_METH$ws*\((.*?),/, \@list, "T");          &append ($in, qr/\bCO_METH$ws*\((.*?),/, \@list, "T");
         &append ($in, qr/\bCO_OBJECT$ws*\((.*?)\)/, \@list, "T");          &append ($in, qr/\bCO_OBJECT$ws*\((.*?),/, \@list, "T");
         &append ($in, qr/\bCO_EV$ws*\(.*?,(.*?)[,)]/, \@list, "E");          &append ($in, qr/\bCO_EV$ws*\(.*?,(.*?)[,)]/, \@list, "E");
         &append ($in, qr/\bCO_P$ws*\(.*?,(.*?)[,)]/, \@list, "P");          &append ($in, qr/\bCO_P$ws*\(.*?,(.*?)[,)]/, \@list, "P");
           &append ($in, qr/\bCO_A$ws*\(.*?,.*?,(.*?)[,)]/, \@list, "M");
         &append ($in, qr/\bCO_PH_RET$ws*\(.*?,(.*?)[,)]/, \@list, "P");          &append ($in, qr/\bCO_PH_RET$ws*\(.*?,(.*?)[,)]/, \@list, "P");
         &append ($in, qr/\bCO_PH_RET_C$ws*\(.*?,(.*?)[,)]/, \@list, "P");          &append ($in, qr/\bCO_PH_RET_C$ws*\(.*?,(.*?)[,)]/, \@list, "P");
         &append ($in, qr/\bCO_MH_CASE$ws*\(.*?,(.*?)[,)]/, \@list, "M");          &append ($in, qr/\bCO_MH_CASE$ws*\(.*?,(.*?)[,)]/, \@list, "M");
Line 359  sub meta {
Line 386  sub meta {
         }          }
   
         print OUT "#include <co_python.h>\n";          print OUT "#include <co_python.h>\n";
         print OUT "#include <co_object.h>\n";          print OUT "#include <co_o_default.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";
         &dump2 ($decls, \@list);          &dump2 ($decls, \@list);
         &meth ($in);          &meth ($in);
   
         $file =~ s#.*?/##g;          $file =~ s#.*?/##g;
         $file =~ s/\./_/g;          $file =~ s/\.|-/_/g;
   
         if ($ahash) {          if ($ahash) {
                 $hash = "_$hash";                  $hash = "_$hash";
Line 374  sub meta {
Line 401  sub meta {
                 $hash = "";                  $hash = "";
         }          }
   
         print OUT "void __co_file_init_${file}$hash (co_super super);\n";          print OUT "void __co_file_init_${file}$hash (co_o_small _super);\n";
         print OUT "void __co_file_init_${file}$hash (co_super super) {\n";          print OUT "void __co_file_init_${file}$hash (co_o_small _super) {\n";
           print OUT "co_super super = _super -> data;\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 $initfunc_add;
Line 397  sub init {
Line 425  sub init {
                         next unless ($in =~ /^#include$ws*[<"]$b$suff[">]/sm);                          next unless ($in =~ /^#include$ws*[<"]$b$suff[">]/sm);
                 }                  }
                 $f =~ s#.*?/##g;                  $f =~ s#.*?/##g;
                 $f =~ s/\./_/g;                  $f =~ s/\.|-/_/g;
                 $ifcs{$f} = &Digest::SHA1::sha1_hex ($in);                  $ifcs{$f} = &Digest::SHA1::sha1_hex ($in);
         }          }
         print OUT "#include <co_super.h>\n";          print OUT "#include <co_super.h>\n";
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7
Platon Group <platon@platon.org> http://platon.org/
Copyright © 2002-2006 Platon Group
Site powered by Metafox CMS 		Go to Top