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.2 and 1.3

version 1.2, 2003/02/18 10:42:09 version 1.3, 2003/02/23 17:38:24
Line 11  sub addid {
Line 11  sub addid {
         }          }
 }  }
   
 #sub meth_add {  my %def_meth = (
 #       my $l = shift;          "has_method" => "co_has_method",
 #       my $o = shift;          "clone" => "co_clone"
 #       my $m = shift;  );
 #       my $argl = shift;  
 #       my %meth;  
 #}  
   
 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 @objs;
         while (s/CO_METH_INI$ws*\((.*?),(.*?)(?:,(.*?)|)\)//) {          while (s/CO_METH_INI$ws*\((.*?),(.*?)(?:,(.*?)|)\)//) {
                 my $o = $1;                  my $o = $1;
                 my $m = $2;                  my $m = $2;
Line 40  sub meth {
Line 38  sub meth {
                         $def .= "$_ = va_arg (ap, $t); ";                          $def .= "$_ = va_arg (ap, $t); ";
                 }                  }
                 print OUT "$def\n";                  print OUT "$def\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 ($o 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 -> __co_meth_ar, COM ($m),"
                         ." (co_msg_h) ${o}_$m);\n";                          ." (co_msg_h) ${o}_$m);\n";
                   push @objs, $o unless grep /^$o$/, @objs;
         }          }
         my $o;          my $o;
         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") {
                         $o = $2;                          $o = $2;
                           #push @objs, $o;
                           push @objs, $o unless grep /^$o$/, @objs;
                 } else {                  } else {
                         my ($t, $m) = split /,/, $2;                          my ($t, $m) = split /,/, $2;
                         #my $m = $2;                          #my $m = $2;
                         $o =~ s/^$ws+|$ws+$//g;                          $o =~ s/^$ws+|$ws+$//g;
                         $t =~ s/^$ws+|$ws+$//g;                          $t =~ s/^$ws+|$ws+$//g;
                         $m =~ s/^$ws+|$ws+$//g;                          $m =~ s/^$ws+|$ws+$//g;
                         $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\tCO_RETURN (${t}_p, "                          #$msg{$o} .= "\tCO_MH_CASE (message, $m) {\n\t\tCO_RETURN (${t}_p, "
                                 ."&(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 -> __co_meth_ar, COM ($m),"
Line 70  sub meth {
Line 71  sub meth {
                                 ." ap)\n{\n\tCO_RETURN (${t}_p, &(this -> $m));\n}\n";                                  ." ap)\n{\n\tCO_RETURN (${t}_p, &(this -> $m));\n}\n";
                 }                  }
         }          }
         for (keys %msg) {          for (@objs) {
                   $o = $_;
                   for (keys %def_meth) {
                           $fwd{$o} .= "co_v $def_meth{$_} (co this, co self, "
                                   ."co_id_t message, va_list ap);\n";
                           $tab{$o} .= "\tco_meth_add (o -> __co_meth_ar,"
                                   ." COM ($_), $def_meth{$_});\n";
                   }
           }
           for (@objs) {
                 print OUT "\n";                  print OUT "\n";
                 print OUT $fwd{$_}."\n";                  print OUT $fwd{$_}."\n";
                 print OUT "/* static co_v ${_}_msg (co __this, co self, co_id_t"                  #print OUT "/* static co_v ${_}_msg (co __this, co self, co_id_t"
                         ." message, va_list ap) {\n";                  #       ." message, va_list ap) {\n";
                 print OUT "$_ this = __this;\n";                  #print OUT "$_ this = __this;\n";
                 print OUT $msg{$_};                  #print OUT $msg{$_};
                 if ($in =~ /CO_MSG_DEFAULT$ws*\($ws*$_$ws*,(.*?)\)/) {                  #if ($in =~ /CO_MSG_DEFAULT$ws*\($ws*$_$ws*,(.*?)\)/) {
                         print OUT "\tCO_MH_DEFAULT(message) {\n\t\treturn CO_D_V "                  #       print OUT "\tCO_MH_DEFAULT(message) {\n\t\treturn CO_D_V "
                                 ."($1, self, message, ap);\n\t}\n";                  #               ."($1, self, message, ap);\n\t}\n";
                 }                  #}
                 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_head_full o = object;\n";
                 print OUT "\to -> __co_meth_ar = co_meth_array_new ();\n";                  print OUT "\to -> __co_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 -> __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 "}\n\n";
         }          }
Line 185  while (scalar @ARGV) {
Line 195  while (scalar @ARGV) {
 sub getf {  sub getf {
         my $file = shift;          my $file = shift;
         my $in;          my $in;
         open (IN, $file);  
         $in .= $_ while (<IN>);  
         close (IN);  
         if ($header) {          if ($header) {
                 open (IN, $header);                  open (IN, $header);
                 $in .= $_ while (<IN>);                  $in .= $_ while (<IN>);
                 close (IN);                  close (IN);
         }          }
           open (IN, $file);
           $in .= $_ while (<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;
Line 232  sub meta {
Line 242  sub meta {
                 &append ($in, qr/\bM$ws*\(.*?,(.*?)[,)]/, \@list, "M");                  &append ($in, qr/\bM$ws*\(.*?,(.*?)[,)]/, \@list, "M");
                 &append ($in, qr/\bE$ws*\(.*?,(.*?)[,)]/, \@list, "E");                  &append ($in, qr/\bE$ws*\(.*?,(.*?)[,)]/, \@list, "E");
         }          }
         &addid (\@list, "Mhas_method"); # FIXME?          #if ($in =~ /CO_OBJECT/) { # FIXME
                   &addid (\@list, "Mhas_method");
                   &addid (\@list, "Mclone");
           #}
   
         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";
Line 249  sub meta {
Line 262  sub meta {
                 $hash = "";                  $hash = "";
         }          }
   
         print OUT "void __co_mod_init_${file}$hash (co_super super);\n";          print OUT "void __co_file_init_${file}$hash (co_super super);\n";
         print OUT "void __co_mod_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";
         &dump2 ($defs, \@list);          &dump2 ($defs, \@list);
         print OUT "}\n";          print OUT "}\n";
         close OUT;          close OUT;
Line 275  sub init {
Line 289  sub init {
         }          }
         print OUT "#include <co_super.h>\n";          print OUT "#include <co_super.h>\n";
         for (keys %ifcs) {          for (keys %ifcs) {
                 print OUT "void __co_mod_init_${_}_$ifcs{$_} (co);\n";                  print OUT "void __co_file_init_${_}_$ifcs{$_} (co);\n";
         }          }
         print OUT "void __co_mod_init (co_super super) {\n";          print OUT "void __co_mod_autoinit (co_super super) {\n";
         for (keys %ifcs) {          for (keys %ifcs) {
                 print OUT "__co_mod_init_${_}_$ifcs{$_} (super);\n";                  print OUT "__co_file_init_${_}_$ifcs{$_} (super);\n";
         }          }
         print OUT "}\n";          print OUT "}\n";
         close OUT;          close OUT;
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
Platon Group <platon@platon.org> http://platon.org/
Copyright © 2002-2006 Platon Group
Site powered by Metafox CMS 		Go to Top