URL https://opencores.org/ocsvn/socgen/socgen/trunk

Subversion Repositories socgen

[/] [socgen/] [trunk/] [tools/] [math/] [lib.pm] - Blame information for rev 134

Details | Compare with Previous | View Log


#/**********************************************************************/
#/*                                                                    */
#/*             -------                                                */
#/*            /   SOC  \                                              */
#/*           /    GEN   \                                             */
#/*          /    TOOL    \                                            */
#/*          ==============                                            */
#/*          |            |                                            */
#/*          |____________|                                            */
#/*                                                                    */
#/*                                                                    */
#/*                                                                    */
#/*  Author(s):                                                        */
#/*      - John Eaton, jt_eaton@opencores.org                          */
#/*                                                                    */
#/**********************************************************************/
#/*                                                                    */
#/*    Copyright (C) <2010-2015>  <Ouabache Design Works>              */
#/*                                                                    */
#/*  This source file may be used and distributed without              */
#/*  restriction provided that this copyright statement is not         */
#/*  removed from the file and that any derivative work contains       */
#/*  the original copyright notice and the associated disclaimer.      */
#/*                                                                    */
#/*  This source file is free software; you can redistribute it        */
#/*  and/or modify it under the terms of the GNU Lesser General        */
#/*  Public License as published by the Free Software Foundation;      */
#/*  either version 2.1 of the License, or (at your option) any        */
#/*  later version.                                                    */
#/*                                                                    */
#/*  This source is distributed in the hope that it will be            */
#/*  useful, but WITHOUT ANY WARRANTY; without even the implied        */
#/*  warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR           */
#/*  PURPOSE.  See the GNU Lesser General Public License for more      */
#/*  details.                                                          */
#/*                                                                    */
#/*  You should have received a copy of the GNU Lesser General         */
#/*  Public License along with this source; if not, download it        */
#/*  from http://www.opencores.org/lgpl.shtml                          */
#/*                                                                    */
#/**********************************************************************/
 
use strict;
use warnings;
 
package math::lib;
 
#/*********************************************************************************************/
#/                                                                                            */
#/  Arithmetic parser                                                                         */
#/                                                                                            */
#/  parse a line and replace all occurrences of symbol with its value                         */
#/                                                                                            */
#/  my $line = math::lib::parse($line,$symbol,$value);                                        */
#/                                                                                            */
#/                                                                                            */
#/*********************************************************************************************/
 
 
sub parse {
    my $line  = shift;
    my $symbol  = shift;
    my $value  = shift;
 
    my $len = length $line;
    my $state         = "math";
    my $start_sym     = -1;
    my $stop_sym      = -1;
    my $match         = "___";
    my $math_only     = 0;
 
 
 
 
#    print "PARSE   $line $symbol $value $len  \n";
    if($symbol eq $value )
       {
       print "DANGER WILL ROBINSON      $line $symbol $value $len             \n";
       return();
       }
 
    for (my $i=0; $i < $len; $i++)
        {
        my $char = substr($line,$i,1);
        $_ = $char;
 
 
        unless ($state eq "constant")
               {
               if(/[a-zA-Z_]/)
                 {
                 $state = "symbol";
                 $math_only = $math_only +1;
                 if($start_sym eq "-1") {$start_sym = $i;}
                 }
               }
        if(/[0-9+-\/]/)
          {
          if($state eq "symbol") {$stop_sym = $i;}
          $state = "math";
          }
 
        if(/[\*]/)
          {
          if($state eq "symbol")            {    $stop_sym = $i;}
          $state = "math";
          }
 
 
        if(/['`]/)
          {
          $state = "constant";
          $math_only = $math_only +1;
          }
 
        if(($state ne "symbol") && (($stop_sym ne "-1")  ) )
          {
          my $str_len  = $stop_sym-$start_sym;
          my $substring = substr($line,$start_sym,$str_len);
          if($substring eq $symbol)
            {
            $match = "MATCH";
            $math_only = $math_only - $str_len;
            my $new_line = "";
            my $end_line = "";
 
            if($start_sym  eq "0") { $new_line  =$value; }
            else
               {
               $new_line  = substr($line,0,$start_sym);
               $new_line  ="${new_line}${value}";
               }
            my $line_len = $len - $stop_sym;
            $end_line = substr($line,$stop_sym,$line_len);
            $new_line  ="${new_line}${end_line}";
#            print "$substring $stop_sym  $start_sym  $str_len $match ==  $new_line  \n";
            $new_line = parse($new_line,$symbol,$value) ;
            return($new_line);
            }
          else
            {
            $match = "NO_MATCH";
#            print "$substring $stop_sym  $start_sym  $str_len $match \n";
            }
          $start_sym  = -1;
          $stop_sym = -1;
          }
 
#        print "$i   $char  $state  $start_sym $stop_sym       \n";
 
        if(($state eq "symbol") && ($i eq $len -1) )
           {
           my $str_len  = $len-$start_sym;
           my $substring = substr($line,$start_sym,$str_len );
 
           if($substring eq $symbol)
              {
              $match = "MATCH";
              $math_only = $math_only - $str_len;
#              print "MATCH $substring $start_sym $str_len  \n";
              my $new_line = "";
              my $end_line = "";
              if($start_sym  eq "0") { $new_line  =$value;}
              else
                {
                $new_line  = substr($line,0,$start_sym);
                $new_line  ="${new_line}${value}";
                }
 
#              print "Recursion  $math_only  $new_line  \n";
              return(parse($new_line,$symbol,$value));
 
              }
           else
              {
              $match = "NO_MATCH";
#              print "$substring $stop_sym  $start_sym  $str_len $match \n";
              }
           }
 
         }
#     print "$math_only  $line  \n";
     if($math_only eq 0)     { return (  solve($line));}
     else                    { return ($line);}
 
}
 
 
 
 
sub solve {
 
my $line  = shift;
#   print "SOLVE $line  \n";
 
$line = "0${line}";
#my $result = `./tools/math/perl_arith $line `;
#chomp($result);
#print   "MMMMMMMMM  $line  || $result  ||";
 
 
my $result = `./tools/math/c_arith $line `;
chomp($result);
 
#if($result ne  $result2)
#   {
#   print " $result2    MISMATCH \n";
#   }
#else
#   {
#   print " $result2 \n";
#   }
 
return ($result);
}
1
 
 
 
 

Browse

Tools

Subversion Repositories socgen

[/] [socgen/] [trunk/] [tools/] [math/] [lib.pm] - Blame information for rev 134

Line No.	Rev	Author	Line
1	134	jt_eaton	`#/**********************************************************************/`
2			`#/* */`
3			`#/* ------- */`
4			`#/* / SOC \ */`
5			`#/* / GEN \ */`
6			`#/* / TOOL \ */`
7			`#/* ============== */`
8			`#/* \| \| */`
9			`#/* \|____________\| */`
10			`#/* */`
11			`#/* */`
12			`#/* */`
13			`#/* Author(s): */`
14			`#/* - John Eaton, jt_eaton@opencores.org */`
15			`#/* */`
16			`#/**********************************************************************/`
17			`#/* */`
18			`#/* Copyright (C) <2010-2015> <Ouabache Design Works> */`
19			`#/* */`
20			`#/* This source file may be used and distributed without */`
21			`#/* restriction provided that this copyright statement is not */`
22			`#/* removed from the file and that any derivative work contains */`
23			`#/* the original copyright notice and the associated disclaimer. */`
24			`#/* */`
25			`#/* This source file is free software; you can redistribute it */`
26			`#/* and/or modify it under the terms of the GNU Lesser General */`
27			`#/* Public License as published by the Free Software Foundation; */`
28			`#/* either version 2.1 of the License, or (at your option) any */`
29			`#/* later version. */`
30			`#/* */`
31			`#/* This source is distributed in the hope that it will be */`
32			`#/* useful, but WITHOUT ANY WARRANTY; without even the implied */`
33			`#/* warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR */`
34			`#/* PURPOSE. See the GNU Lesser General Public License for more */`
35			`#/* details. */`
36			`#/* */`
37			`#/* You should have received a copy of the GNU Lesser General */`
38			`#/* Public License along with this source; if not, download it */`
39			`#/* from http://www.opencores.org/lgpl.shtml */`
40			`#/* */`
41			`#/**********************************************************************/`
42
43			`use strict;`
44			`use warnings;`
45
46			`package math::lib;`
47
48			`#/*********************************************************************************************/`
49			`#/ */`
50			`#/ Arithmetic parser */`
51			`#/ */`
52			`#/ parse a line and replace all occurrences of symbol with its value */`
53			`#/ */`
54			`#/ my $line = math::lib::parse($line,$symbol,$value); */`
55			`#/ */`
56			`#/ */`
57			`#/*********************************************************************************************/`
58
59
60			`sub parse {`
61			`my $line = shift;`
62			`my $symbol = shift;`
63			`my $value = shift;`
64
65			`my $len = length $line;`
66			`my $state = "math";`
67			`my $start_sym = -1;`
68			`my $stop_sym = -1;`
69			`my $match = "___";`
70			`my $math_only = 0;`
71
72
73
74
75			`# print "PARSE $line $symbol $value $len \n";`
76			`if($symbol eq $value )`
77			`{`
78			`print "DANGER WILL ROBINSON $line $symbol $value $len \n";`
79			`return();`
80			`}`
81
82			`for (my $i=0; $i < $len; $i++)`
83			`{`
84			`my $char = substr($line,$i,1);`
85			`$_ = $char;`
86
87
88			`unless ($state eq "constant")`
89			`{`
90			`if(/[a-zA-Z_]/)`
91			`{`
92			`$state = "symbol";`
93			`$math_only = $math_only +1;`
94			`if($start_sym eq "-1") {$start_sym = $i;}`
95			`}`
96			`}`
97			`if(/[0-9+-\/]/)`
98			`{`
99			`if($state eq "symbol") {$stop_sym = $i;}`
100			`$state = "math";`
101			`}`
102
103			`if(/[\*]/)`
104			`{`
105			`if($state eq "symbol") { $stop_sym = $i;}`
106			`$state = "math";`
107			`}`
108
109
110			if(/['`]/)
111			`{`
112			`$state = "constant";`
113			`$math_only = $math_only +1;`
114			`}`
115
116			`if(($state ne "symbol") && (($stop_sym ne "-1") ) )`
117			`{`
118			`my $str_len = $stop_sym-$start_sym;`
119			`my $substring = substr($line,$start_sym,$str_len);`
120			`if($substring eq $symbol)`
121			`{`
122			`$match = "MATCH";`
123			`$math_only = $math_only - $str_len;`
124			`my $new_line = "";`
125			`my $end_line = "";`
126
127			`if($start_sym eq "0") { $new_line =$value; }`
128			`else`
129			`{`
130			`$new_line = substr($line,0,$start_sym);`
131			`$new_line ="${new_line}${value}";`
132			`}`
133			`my $line_len = $len - $stop_sym;`
134			`$end_line = substr($line,$stop_sym,$line_len);`
135			`$new_line ="${new_line}${end_line}";`
136			`# print "$substring $stop_sym $start_sym $str_len $match == $new_line \n";`
137			`$new_line = parse($new_line,$symbol,$value) ;`
138			`return($new_line);`
139			`}`
140			`else`
141			`{`
142			`$match = "NO_MATCH";`
143			`# print "$substring $stop_sym $start_sym $str_len $match \n";`
144			`}`
145			`$start_sym = -1;`
146			`$stop_sym = -1;`
147			`}`
148
149			`# print "$i $char $state $start_sym $stop_sym \n";`
150
151			`if(($state eq "symbol") && ($i eq $len -1) )`
152			`{`
153			`my $str_len = $len-$start_sym;`
154			`my $substring = substr($line,$start_sym,$str_len );`
155
156			`if($substring eq $symbol)`
157			`{`
158			`$match = "MATCH";`
159			`$math_only = $math_only - $str_len;`
160			`# print "MATCH $substring $start_sym $str_len \n";`
161			`my $new_line = "";`
162			`my $end_line = "";`
163			`if($start_sym eq "0") { $new_line =$value;}`
164			`else`
165			`{`
166			`$new_line = substr($line,0,$start_sym);`
167			`$new_line ="${new_line}${value}";`
168			`}`
169
170			`# print "Recursion $math_only $new_line \n";`
171			`return(parse($new_line,$symbol,$value));`
172
173			`}`
174			`else`
175			`{`
176			`$match = "NO_MATCH";`
177			`# print "$substring $stop_sym $start_sym $str_len $match \n";`
178			`}`
179			`}`
180
181			`}`
182			`# print "$math_only $line \n";`
183			`if($math_only eq 0) { return ( solve($line));}`
184			`else { return ($line);}`
185
186			`}`
187
188
189
190
191			`sub solve {`
192
193			`my $line = shift;`
194			`# print "SOLVE $line \n";`
195
196			`$line = "0${line}";`
197			#my $result = `./tools/math/perl_arith $line `;
198			`#chomp($result);`
199			`#print "MMMMMMMMM $line \|\| $result \|\|";`
200
201
202			my $result = `./tools/math/c_arith $line `;
203			`chomp($result);`
204
205			`#if($result ne $result2)`
206			`# {`
207			`# print " $result2 MISMATCH \n";`
208			`# }`
209			`#else`
210			`# {`
211			`# print " $result2 \n";`
212			`# }`
213
214			`return ($result);`
215			`}`
216			`1`
217
218
219
220