Mercurial > jwe > octave
changeset 143:7849db4b6dbc
[project @ 1993-10-04 02:36:45 by jwe]
| author | jwe |
|---|---|
| date | Mon, 04 Oct 1993 02:36:58 +0000 |
| parents | 6906d6591452 |
| children | 29a6bd3d88a2 |
| files | src/arith-ops.cc src/error.cc src/error.h src/gripes.cc src/gripes.h src/lex.h src/lex.l src/octave.cc src/parse.y src/pt-base.h src/pt-const.cc src/pt-plot.cc src/tc-assign.cc src/tc-extras.cc src/tc-index.cc src/tc-inlines.h src/tree.h.old src/utils.cc |
| diffstat | 18 files changed, 1034 insertions(+), 795 deletions(-) [+] |
line wrap: on
line diff
--- a/src/arith-ops.cc Mon Oct 04 00:40:57 1993 +0000 +++ b/src/arith-ops.cc Mon Oct 04 02:36:58 1993 +0000 @@ -76,6 +76,129 @@ }; /* + * Check row and column dimensions for binary matrix operations. + */ +static inline int +m_add_conform (Matrix& a, Matrix& b, int warn) +{ + int ar = a.rows (); + int ac = a.columns (); + int br = b.rows (); + int bc = b.columns (); + + int ok = (ar == br && ac == bc); + + if (! ok && warn) + gripe_nonconformant (ar, ac, br, bc); + + return ok; +} + +static inline int +m_add_conform (Matrix& a, ComplexMatrix& b, int warn) +{ + int ar = a.rows (); + int ac = a.columns (); + int br = b.rows (); + int bc = b.columns (); + + int ok = (ar == br && ac == bc); + + if (! ok && warn) + gripe_nonconformant (ar, ac, br, bc); + + return ok; +} + +static inline int +m_add_conform (ComplexMatrix& a, Matrix& b, int warn) +{ + int ar = a.rows (); + int ac = a.columns (); + int br = b.rows (); + int bc = b.columns (); + + int ok = (ar == br && ac == bc); + + if (! ok && warn) + gripe_nonconformant (ar, ac, br, bc); + + return ok; +} + +static inline int +m_add_conform (ComplexMatrix& a, ComplexMatrix& b, int warn) +{ + int ar = a.rows (); + int ac = a.columns (); + int br = b.rows (); + int bc = b.columns (); + + int ok = (ar == br && ac == bc); + + if (! ok && warn) + gripe_nonconformant (ar, ac, br, bc); + + return ok; +} + +static inline int +m_mul_conform (Matrix& a, Matrix& b, int warn) +{ + int ac = a.columns (); + int br = b.rows (); + + int ok = (ac == br); + + if (! ok && warn) + gripe_nonconformant (a.rows (), ac, br, b.columns ()); + + return ok; +} + +static inline int +m_mul_conform (Matrix& a, ComplexMatrix& b, int warn) +{ + int ac = a.columns (); + int br = b.rows (); + + int ok = (ac == br); + + if (! ok && warn) + gripe_nonconformant (a.rows (), ac, br, b.columns ()); + + return ok; +} + +static inline int +m_mul_conform (ComplexMatrix& a, Matrix& b, int warn) +{ + int ac = a.columns (); + int br = b.rows (); + + int ok = (ac == br); + + if (! ok && warn) + gripe_nonconformant (a.rows (), ac, br, b.columns ()); + + return ok; +} + +static inline int +m_mul_conform (ComplexMatrix& a, ComplexMatrix& b, int warn) +{ + int ac = a.columns (); + int br = b.rows (); + + int ok = (a.columns () == br); + + if (! ok && warn) + gripe_nonconformant (a.rows (), ac, br, b.columns ()); + + return ok; +} + +/* * Stupid binary comparison operations like the ones Matlab provides. * One for each type combination, in the order given here: * @@ -97,7 +220,9 @@ { int ar = a.rows (); int ac = a.columns (); + Matrix t (ar, ac); + for (int j = 0; j < ac; j++) for (int i = 0; i < ar; i++) { @@ -132,6 +257,7 @@ break; } } + return t; } @@ -141,7 +267,9 @@ { int ar = a.rows (); int ac = a.columns (); + Matrix t (ar, ac); + for (int j = 0; j < ac; j++) for (int i = 0; i < ar; i++) { @@ -176,6 +304,7 @@ break; } } + return t; } @@ -185,7 +314,9 @@ { int ar = a.rows (); int ac = a.columns (); + Matrix t (ar, ac); + for (int j = 0; j < ac; j++) for (int i = 0; i < ar; i++) { @@ -220,6 +351,7 @@ break; } } + return t; } @@ -229,7 +361,9 @@ { int ar = a.rows (); int ac = a.columns (); + Matrix t (ar, ac); + for (int j = 0; j < ac; j++) for (int i = 0; i < ar; i++) { @@ -264,6 +398,7 @@ break; } } + return t; } @@ -271,15 +406,12 @@ static Matrix mx_stupid_bool_op (Matrix_bool_op op, Matrix& a, Matrix& b) { + if (! m_add_conform (a, b, 1)) + return Matrix (); + int ar = a.rows (); int ac = a.columns (); - if (ar != b.rows () || ac != b.columns ()) - { - gripe_nonconformant (); - jump_to_top_level (); - } - Matrix c (ar, ac); for (int j = 0; j < ac; j++) @@ -316,6 +448,7 @@ break; } } + return c; } @@ -323,15 +456,12 @@ static Matrix mx_stupid_bool_op (Matrix_bool_op op, Matrix& a, ComplexMatrix& b) { + if (! m_add_conform (a, b, 1)) + return Matrix (); + int ar = a.rows (); int ac = a.columns (); - if (ar != b.rows () || ac != b.columns ()) - { - gripe_nonconformant (); - jump_to_top_level (); - } - Matrix c (ar, ac); for (int j = 0; j < ac; j++) @@ -377,7 +507,9 @@ { int ar = a.rows (); int ac = a.columns (); + Matrix t (ar, ac); + for (int j = 0; j < ac; j++) for (int i = 0; i < ar; i++) { @@ -412,6 +544,7 @@ break; } } + return t; } @@ -421,7 +554,9 @@ { int ar = a.rows (); int ac = a.columns (); + Matrix t (ar, ac); + for (int j = 0; j < ac; j++) for (int i = 0; i < ar; i++) { @@ -456,6 +591,7 @@ break; } } + return t; } @@ -465,7 +601,9 @@ { int ar = a.rows (); int ac = a.columns (); + Matrix t (ar, ac); + for (int j = 0; j < ac; j++) for (int i = 0; i < ar; i++) { @@ -500,6 +638,7 @@ break; } } + return t; } @@ -509,7 +648,9 @@ { int ar = a.rows (); int ac = a.columns (); + Matrix t (ar, ac); + for (int j = 0; j < ac; j++) for (int i = 0; i < ar; i++) { @@ -544,6 +685,7 @@ break; } } + return t; } @@ -551,15 +693,12 @@ static Matrix mx_stupid_bool_op (Matrix_bool_op op, ComplexMatrix& a, Matrix& b) { + if (! m_add_conform (a, b, 1)) + return Matrix (); + int ar = a.rows (); int ac = a.columns (); - if (ar != b.rows () || ac != b.columns ()) - { - gripe_nonconformant (); - jump_to_top_level (); - } - Matrix c (ar, ac); for (int j = 0; j < ac; j++) @@ -603,15 +742,12 @@ static Matrix mx_stupid_bool_op (Matrix_bool_op op, ComplexMatrix& a, ComplexMatrix& b) { + if (! m_add_conform (a, b, 1)) + return Matrix (); + int ar = a.rows (); int ac = a.columns (); - if (ar != b.rows () || ac != b.columns ()) - { - gripe_nonconformant (); - jump_to_top_level (); - } - Matrix c (ar, ac); for (int j = 0; j < ac; j++) @@ -648,85 +784,11 @@ break; } } + return c; } /* - * Check row and column dimensions for binary matrix operations. - */ -static inline int -m_add_conform (Matrix& m1, Matrix& m2, int warn) -{ - int ok = (m1.rows () == m2.rows () && m1.columns () == m2.columns ()); - if (!ok && warn) - gripe_nonconformant (); - return ok; -} - -static inline int -m_add_conform (Matrix& m1, ComplexMatrix& m2, int warn) -{ - int ok = (m1.rows () == m2.rows () && m1.columns () == m2.columns ()); - if (!ok && warn) - gripe_nonconformant (); - return ok; -} - -static inline int -m_add_conform (ComplexMatrix& m1, Matrix& m2, int warn) -{ - int ok = (m1.rows () == m2.rows () && m1.columns () == m2.columns ()); - if (!ok && warn) - gripe_nonconformant (); - return ok; -} - -static inline int -m_add_conform (ComplexMatrix& m1, ComplexMatrix& m2, int warn) -{ - int ok = (m1.rows () == m2.rows () && m1.columns () == m2.columns ()); - if (!ok && warn) - gripe_nonconformant (); - return ok; -} - -static inline int -m_mul_conform (Matrix& m1, Matrix& m2, int warn) -{ - int ok = (m1.columns () == m2.rows ()); - if (!ok && warn) - gripe_nonconformant (); - return ok; -} - -static inline int -m_mul_conform (Matrix& m1, ComplexMatrix& m2, int warn) -{ - int ok = (m1.columns () == m2.rows ()); - if (!ok && warn) - gripe_nonconformant (); - return ok; -} - -static inline int -m_mul_conform (ComplexMatrix& m1, Matrix& m2, int warn) -{ - int ok = (m1.columns () == m2.rows ()); - if (!ok && warn) - gripe_nonconformant (); - return ok; -} - -static inline int -m_mul_conform (ComplexMatrix& m1, ComplexMatrix& m2, int warn) -{ - int ok = (m1.columns () == m2.rows ()); - if (!ok && warn) - gripe_nonconformant (); - return ok; -} - -/* * Unary operations. One for each numeric data type: * * scalar @@ -740,6 +802,7 @@ do_unary_op (double d, tree::expression_type t) { double result = 0.0; + switch (t) { case tree::not: @@ -764,6 +827,7 @@ do_unary_op (Matrix& a, tree::expression_type t) { Matrix result; + switch (t) { case tree::not: @@ -788,6 +852,7 @@ do_unary_op (Complex& c, tree::expression_type t) { Complex result = 0.0; + switch (t) { case tree::not: @@ -814,6 +879,7 @@ do_unary_op (ComplexMatrix& a, tree::expression_type t) { ComplexMatrix result; + switch (t) { case tree::not: @@ -857,6 +923,7 @@ do_binary_op (double a, double b, tree::expression_type t) { double result = 0.0; + switch (t) { case tree::add: @@ -914,6 +981,9 @@ break; } + if (error_state) + return tree_constant (); + return tree_constant (result); } @@ -922,6 +992,7 @@ do_binary_op (double a, Matrix& b, tree::expression_type t) { Matrix result; + switch (t) { case tree::add: @@ -944,8 +1015,7 @@ return x_el_div (a, b); break; case tree::divide: - error ("nonconformant right division"); - return tree_constant (); + gripe_nonconformant (1, 1, b.rows (), b.columns ()); break; case tree::power: return xpow (a, b); @@ -982,6 +1052,9 @@ break; } + if (error_state) + return tree_constant (); + return tree_constant (result); } @@ -994,6 +1067,7 @@ double result = 0.0; Complex complex_result; + switch (t) { case tree::add: @@ -1064,7 +1138,11 @@ break; } + if (error_state) + return tree_constant (); + assert (result_type != RT_unknown); + if (result_type == RT_real) return tree_constant (result); else @@ -1080,6 +1158,7 @@ Matrix result; ComplexMatrix complex_result; + switch (t) { case tree::add: @@ -1105,8 +1184,7 @@ return x_el_div (a, b); break; case tree::divide: - error ("nonconformant right division"); - return tree_constant (); + gripe_nonconformant (1, 1, b.rows (), b.columns ()); break; case tree::power: return xpow (a, b); @@ -1151,7 +1229,11 @@ break; } + if (error_state) + return tree_constant (); + assert (result_type != RT_unknown); + if (result_type == RT_real) return tree_constant (result); else @@ -1163,6 +1245,7 @@ do_binary_op (Matrix& a, double b, tree::expression_type t) { Matrix result; + switch (t) { case tree::add: @@ -1183,8 +1266,7 @@ return x_el_div (b, a); break; case tree::leftdiv: - error ("nonconformant left division"); - return tree_constant (); + gripe_nonconformant (a.rows (), a.columns (), 1, 1); break; case tree::power: return xpow (a, b); @@ -1221,6 +1303,9 @@ break; } + if (error_state) + return tree_constant (); + return tree_constant (result); } @@ -1230,45 +1315,31 @@ { Matrix result; - int error_cond = 0; - switch (t) { case tree::add: if (m_add_conform (a, b, 1)) result = a + b; - else - error_cond = 1; break; case tree::subtract: if (m_add_conform (a, b, 1)) result = a - b; - else - error_cond = 1; break; case tree::el_mul: if (m_add_conform (a, b, 1)) result = a.product (b); - else - error_cond = 1; break; case tree::multiply: if (m_mul_conform (a, b, 1)) result = a * b; - else - error_cond = 1; break; case tree::el_div: if (m_add_conform (a, b, 1)) result = a.quotient (b); - else - error_cond = 1; break; case tree::el_leftdiv: if (m_add_conform (a, b, 1)) result = b.quotient (a); - else - error_cond = 1; break; case tree::leftdiv: return xleftdiv (a, b); @@ -1278,71 +1349,52 @@ break; case tree::power: error ("can't do A ^ B for A and B both matrices"); - error_cond = 1; break; case tree::elem_pow: if (m_add_conform (a, b, 1)) return elem_xpow (a, b); - else - error_cond = 1; break; case tree::cmp_lt: if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_LT, a, b); - else - error_cond = 1; break; case tree::cmp_le: if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_LE, a, b); - else - error_cond = 1; break; case tree::cmp_eq: if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_EQ, a, b); - else - error_cond = 1; break; case tree::cmp_ge: if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_GE, a, b); - else - error_cond = 1; break; case tree::cmp_gt: if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_GT, a, b); - else - error_cond = 1; break; case tree::cmp_ne: if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_NE, a, b); - else - error_cond = 1; break; case tree::and: if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_AND, a, b); - else - error_cond = 1; break; case tree::or: if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_OR, a, b); - else - error_cond = 1; break; default: panic_impossible (); break; } - if (error_cond) + if (error_state) return tree_constant (); - else - return tree_constant (result); + + return tree_constant (result); } /* 7 */ @@ -1354,6 +1406,7 @@ Matrix result; ComplexMatrix complex_result; + switch (t) { case tree::add: @@ -1378,8 +1431,7 @@ return x_el_div (b, a); break; case tree::leftdiv: - error ("nonconformant left division"); - return tree_constant (); + gripe_nonconformant (a.rows (), a.columns (), 1, 1); break; case tree::power: return xpow (a, b); @@ -1424,7 +1476,11 @@ break; } + if (error_state) + return tree_constant (); + assert (result_type != RT_unknown); + if (result_type == RT_real) return tree_constant (result); else @@ -1440,49 +1496,38 @@ Matrix result; ComplexMatrix complex_result; + switch (t) { case tree::add: result_type = RT_complex; if (m_add_conform (a, b, 1)) complex_result = a + b; - else - return tree_constant (); break; case tree::subtract: result_type = RT_complex; if (m_add_conform (a, b, 1)) complex_result = a - b; - else - return tree_constant (); break; case tree::el_mul: result_type = RT_complex; if (m_add_conform (a, b, 1)) complex_result = a.product (b); - else - return tree_constant (); break; case tree::multiply: result_type = RT_complex; if (m_mul_conform (a, b, 1)) complex_result = a * b; - else - return tree_constant (); break; case tree::el_div: result_type = RT_complex; if (m_add_conform (a, b, 1)) complex_result = a.quotient (b); - else - return tree_constant (); break; case tree::el_leftdiv: result_type = RT_complex; if (m_add_conform (a, b, 1)) complex_result = b.quotient (a); - else - return tree_constant (); break; case tree::leftdiv: return xleftdiv (a, b); @@ -1492,76 +1537,61 @@ break; case tree::power: error ("can't do A ^ B for A and B both matrices"); - return tree_constant (); break; case tree::elem_pow: if (m_add_conform (a, b, 1)) return elem_xpow (a, b); - else - return tree_constant (); break; case tree::cmp_lt: result_type = RT_real; if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_LT, a, b); - else - return tree_constant (); break; case tree::cmp_le: result_type = RT_real; if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_LE, a, b); - else - return tree_constant (); break; case tree::cmp_eq: result_type = RT_real; if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_EQ, a, b); - else - return tree_constant (); break; case tree::cmp_ge: result_type = RT_real; if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_GE, a, b); - else - return tree_constant (); break; case tree::cmp_gt: result_type = RT_real; if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_GT, a, b); - else - return tree_constant (); break; case tree::cmp_ne: result_type = RT_real; if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_NE, a, b); - else - return tree_constant (); break; case tree::and: result_type = RT_real; if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_AND, a, b); - else - return tree_constant (); break; case tree::or: result_type = RT_real; if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_OR, a, b); - else - return tree_constant (); break; default: panic_impossible (); break; } + if (error_state) + return tree_constant (); + assert (result_type != RT_unknown); + if (result_type == RT_real) return tree_constant (result); else @@ -1577,6 +1607,7 @@ double result = 0.0; Complex complex_result; + switch (t) { case tree::add: @@ -1647,7 +1678,11 @@ break; } + if (error_state) + return tree_constant (); + assert (result_type != RT_unknown); + if (result_type == RT_real) return tree_constant (result); else @@ -1663,6 +1698,7 @@ Matrix result; ComplexMatrix complex_result; + switch (t) { case tree::add: @@ -1688,8 +1724,7 @@ return x_el_div (a, b); break; case tree::divide: - error ("nonconformant right division"); - return tree_constant (); + gripe_nonconformant (1, 1, b.rows (), b.columns ()); break; case tree::power: return xpow (a, b); @@ -1734,7 +1769,11 @@ break; } + if (error_state) + return tree_constant (); + assert (result_type != RT_unknown); + if (result_type == RT_real) return tree_constant (result); else @@ -1750,6 +1789,7 @@ double result = 0.0; Complex complex_result; + switch (t) { case tree::add: @@ -1820,7 +1860,11 @@ break; } + if (error_state) + return tree_constant (); + assert (result_type != RT_unknown); + if (result_type == RT_real) return tree_constant (result); else @@ -1836,6 +1880,7 @@ Matrix result; ComplexMatrix complex_result; + switch (t) { case tree::add: @@ -1861,8 +1906,7 @@ return x_el_div (a, b); break; case tree::divide: - error ("nonconformant right division"); - return tree_constant (); + gripe_nonconformant (1, 1, b.rows (), b.columns ()); break; case tree::power: return xpow (a, b); @@ -1907,7 +1951,11 @@ break; } + if (error_state) + return tree_constant (); + assert (result_type != RT_unknown); + if (result_type == RT_real) return tree_constant (result); else @@ -1923,6 +1971,7 @@ Matrix result; ComplexMatrix complex_result; + switch (t) { case tree::add: @@ -1947,8 +1996,7 @@ return x_el_div (b, a); break; case tree::leftdiv: - error ("nonconformant left division"); - return tree_constant (); + gripe_nonconformant (a.rows (), a.columns (), 1, 1); break; case tree::power: return xpow (a, b); @@ -1993,7 +2041,11 @@ break; } + if (error_state) + return tree_constant (); + assert (result_type != RT_unknown); + if (result_type == RT_real) return tree_constant (result); else @@ -2009,49 +2061,38 @@ Matrix result; ComplexMatrix complex_result; + switch (t) { case tree::add: result_type = RT_complex; if (m_add_conform (a, b, 1)) complex_result = a + b; - else - return tree_constant (); break; case tree::subtract: result_type = RT_complex; if (m_add_conform (a, b, 1)) complex_result = a - b; - else - return tree_constant (); break; case tree::el_mul: result_type = RT_complex; if (m_add_conform (a, b, 1)) complex_result = a.product (b); - else - return tree_constant (); break; case tree::multiply: result_type = RT_complex; if (m_mul_conform (a, b, 1)) complex_result = a * b; - else - return tree_constant (); break; case tree::el_div: result_type = RT_complex; if (m_add_conform (a, b, 1)) complex_result = a.quotient (b); - else - return tree_constant (); break; case tree::el_leftdiv: result_type = RT_complex; if (m_add_conform (a, b, 1)) complex_result = a.quotient (b); - else - return tree_constant (); break; case tree::leftdiv: return xleftdiv (a, b); @@ -2061,76 +2102,61 @@ break; case tree::power: error ("can't do A ^ B for A and B both matrices"); - return tree_constant (); break; case tree::elem_pow: if (m_add_conform (a, b, 1)) return elem_xpow (a, b); - else - return tree_constant (); break; case tree::cmp_lt: result_type = RT_real; if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_LT, a, b); - else - return tree_constant (); break; case tree::cmp_le: result_type = RT_real; if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_LE, a, b); - else - return tree_constant (); break; case tree::cmp_eq: result_type = RT_real; if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_EQ, a, b); - else - return tree_constant (); break; case tree::cmp_ge: result_type = RT_real; if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_GE, a, b); - else - return tree_constant (); break; case tree::cmp_gt: result_type = RT_real; if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_GT, a, b); - else - return tree_constant (); break; case tree::cmp_ne: result_type = RT_real; if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_NE, a, b); - else - return tree_constant (); break; case tree::and: result_type = RT_real; if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_AND, a, b); - else - return tree_constant (); break; case tree::or: result_type = RT_real; if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_OR, a, b); - else - return tree_constant (); break; default: panic_impossible (); break; } + if (error_state) + return tree_constant (); + assert (result_type != RT_unknown); + if (result_type == RT_real) return tree_constant (result); else @@ -2146,6 +2172,7 @@ Matrix result; ComplexMatrix complex_result; + switch (t) { case tree::add: @@ -2170,8 +2197,7 @@ return x_el_div (b, a); break; case tree::leftdiv: - error ("nonconformant left division"); - return tree_constant (); + gripe_nonconformant (a.rows (), a.columns (), 1, 1); break; case tree::power: return xpow (a, b); @@ -2216,7 +2242,11 @@ break; } + if (error_state) + return tree_constant (); + assert (result_type != RT_unknown); + if (result_type == RT_real) return tree_constant (result); else @@ -2232,49 +2262,38 @@ Matrix result; ComplexMatrix complex_result; + switch (t) { case tree::add: result_type = RT_complex; if (m_add_conform (a, b, 1)) complex_result = a + b; - else - return tree_constant (); break; case tree::subtract: result_type = RT_complex; if (m_add_conform (a, b, 1)) complex_result = a - b; - else - return tree_constant (); break; case tree::el_mul: result_type = RT_complex; if (m_add_conform (a, b, 1)) complex_result = a.product (b); - else - return tree_constant (); break; case tree::multiply: result_type = RT_complex; if (m_mul_conform (a, b, 1)) complex_result = a * b; - else - return tree_constant (); break; case tree::el_div: result_type = RT_complex; if (m_add_conform (a, b, 1)) complex_result = a.quotient (b); - else - return tree_constant (); break; case tree::el_leftdiv: result_type = RT_complex; if (m_add_conform (a, b, 1)) complex_result = b.quotient (a); - else - return tree_constant (); break; case tree::leftdiv: return xleftdiv (a, b); @@ -2284,76 +2303,61 @@ break; case tree::power: error ("can't do A ^ B for A and B both matrices"); - return tree_constant (); break; case tree::elem_pow: if (m_add_conform (a, b, 1)) return elem_xpow (a, b); - else - return tree_constant (); break; case tree::cmp_lt: result_type = RT_real; if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_LT, a, b); - else - return tree_constant (); break; case tree::cmp_le: result_type = RT_real; if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_LE, a, b); - else - return tree_constant (); break; case tree::cmp_eq: result_type = RT_real; if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_EQ, a, b); - else - return tree_constant (); break; case tree::cmp_ge: result_type = RT_real; if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_GE, a, b); - else - return tree_constant (); break; case tree::cmp_gt: result_type = RT_real; if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_GT, a, b); - else - return tree_constant (); break; case tree::cmp_ne: result_type = RT_real; if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_NE, a, b); - else - return tree_constant (); break; case tree::and: result_type = RT_real; if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_AND, a, b); - else - return tree_constant (); break; case tree::or: result_type = RT_real; if (m_add_conform (a, b, 1)) result = mx_stupid_bool_op (Matrix_OR, a, b); - else - return tree_constant (); break; default: panic_impossible (); break; } + if (error_state) + return tree_constant (); + assert (result_type != RT_unknown); + if (result_type == RT_real) return tree_constant (result); else
--- a/src/error.cc Mon Oct 04 00:40:57 1993 +0000 +++ b/src/error.cc Mon Oct 04 02:36:58 1993 +0000 @@ -31,6 +31,9 @@ #include "error.h" +// Current error state. +int error_state; + static void verror (const char *name, const char *fmt, va_list args) { @@ -72,6 +75,9 @@ void error (const char *fmt, ...) { + if (! error_state) + error_state = 1; + va_list args; va_start (args, fmt); verror ("error", fmt, args);
--- a/src/error.h Mon Oct 04 00:40:57 1993 +0000 +++ b/src/error.h Mon Oct 04 02:36:58 1993 +0000 @@ -38,6 +38,9 @@ extern void error (const char *fmt, ...); extern void volatile panic (const char *fmt, ...); +// Current error state. +extern int error_state; + #endif /*
--- a/src/gripes.cc Mon Oct 04 00:40:57 1993 +0000 +++ b/src/gripes.cc Mon Oct 04 02:36:58 1993 +0000 @@ -47,6 +47,13 @@ } void +gripe_nonconformant (int r1, int c1, int r2, int c2) +{ + error ("nonconformant matrices (op1 is %dx%d, op2 is %dx%d)", + r1, c1, r2, c2); +} + +void gripe_empty_arg (const char *name, int is_error) { if (is_error)
--- a/src/gripes.h Mon Oct 04 00:40:57 1993 +0000 +++ b/src/gripes.h Mon Oct 04 02:36:58 1993 +0000 @@ -31,6 +31,7 @@ extern void gripe_string_invalid (void); extern void gripe_range_invalid (void); extern void gripe_nonconformant (void); +extern void gripe_nonconformant (int r1, int c1, int r2, int c2); extern void gripe_empty_arg (const char *name, int is_error); extern void gripe_square_matrix_required (const char *name); extern void gripe_user_supplied_eval (const char *name);
--- a/src/lex.h Mon Oct 04 00:40:57 1993 +0000 +++ b/src/lex.h Mon Oct 04 02:36:58 1993 +0000 @@ -24,6 +24,54 @@ #if !defined (_lex_h) #define _lex_h 1 +// Arrange to get input via readline. + +#ifdef YY_INPUT +#undef YY_INPUT +#define YY_INPUT(buf,result,max_size) \ + if ((result = octave_read (buf, max_size)) < 0) \ + YY_FATAL_ERROR ("octave_read () in flex scanner failed"); +#endif + +// Try to avoid crashing out completely on fatal scanner errors. + +#ifdef YY_FATAL_ERROR +#undef YY_FATAL_ERROR +#define YY_FATAL_ERROR(msg) \ + do \ + { \ + error (msg); \ + jump_to_top_level (); \ + } \ + while (0) +#endif + +#define DO_COMMA_INSERT_CHECK yyless (do_comma_insert_check ()) + +#define TOK_RETURN(tok) \ + do \ + { \ + current_input_column += yyleng; \ + quote_is_transpose = 0; \ + cant_be_identifier = 0; \ + convert_spaces_to_comma = 1; \ + return (tok); \ + } \ + while (0) + +#define BIN_OP_RETURN(tok,convert) \ + do \ + { \ + yylval.tok_val = new token (input_line_number, current_input_column); \ + token_stack.push (yylval.tok_val); \ + current_input_column += yyleng; \ + quote_is_transpose = 0; \ + cant_be_identifier = 0; \ + convert_spaces_to_comma = convert; \ + return (tok); \ + } \ + while (0) + typedef struct yy_buffer_state *YY_BUFFER_STATE; // Associate a buffer with a new file to read.
--- a/src/lex.l Mon Oct 04 00:40:57 1993 +0000 +++ b/src/lex.l Mon Oct 04 02:36:58 1993 +0000 @@ -30,52 +30,19 @@ %{ -// Arrange to get input via readline. - -#ifdef YY_INPUT -#undef YY_INPUT -#define YY_INPUT(buf,result,max_size) \ - if ((result = octave_read (buf, max_size)) < 0) \ - YY_FATAL_ERROR ("octave_read () in flex scanner failed"); -#endif - -// Try to avoid crashing out completely on fatal scanner errors. - -#ifdef YY_FATAL_ERROR -#undef YY_FATAL_ERROR -#define YY_FATAL_ERROR(msg) \ - do \ - { \ - error (msg); \ - jump_to_top_level (); \ - } \ - while (0) -#endif - #include "input.h" - -// The type of an END token. This declaration is repeated in parse.y. -// It must appear before y.tab.h is included. -enum end_tok_type - { - simple_end, - for_end, - function_end, - if_end, - while_end, - }; - -// The type of a PLOT token. This declaration is repeated in parse.y. -// It must appear before y.tab.h is included. -enum plot_tok_type - { - two_dee = 2, - three_dee = 3, - }; +#include "token.h" #include "SLStack.h" +// Stack to hold tokens so that we can delete them when the parser is +// reset and avoid growing forever just because we are stashing some +// information. This has to appear before lex.h is included, because +// one of the macros defined there uses token_stack. +static SLStack <token*> token_stack; + #include "variables.h" +#include "octave.h" #include "symtab.h" #include "error.h" #include "utils.h" @@ -128,30 +95,6 @@ static int next_token_is_postfix_unary_op (int spc_prev, char *yytext); static char *strip_trailing_whitespace (char *s); -#define DO_COMMA_INSERT_CHECK yyless (do_comma_insert_check ()) - -#define RETURN(token) \ - do \ - { \ - current_input_column += yyleng; \ - quote_is_transpose = 0; \ - cant_be_identifier = 0; \ - convert_spaces_to_comma = 1; \ - return (token); \ - } \ - while (0) - -#define BIN_OP_RETURN(token) \ - do \ - { \ - current_input_column += yyleng; \ - quote_is_transpose = 0; \ - cant_be_identifier = 0; \ - convert_spaces_to_comma = 0; \ - return (token); \ - } \ - while (0) - %} D [0-9] @@ -182,14 +125,14 @@ <COMMENT>\n { BEGIN 0; - current_input_column = 0; + current_input_column = 1; quote_is_transpose = 0; cant_be_identifier = 0; convert_spaces_to_comma = 1; return '\n'; } -<COMMENT><<EOF>> { RETURN (END_OF_INPUT); } +<COMMENT><<EOF>> { TOK_RETURN (END_OF_INPUT); } <COMMENT>.*$ { current_input_column += yyleng; } @@ -206,7 +149,7 @@ <HELP_FCN>\n | <TEXT_FCN>\n { BEGIN 0; - current_input_column = 0; + current_input_column = 1; quote_is_transpose = 0; cant_be_identifier = 0; convert_spaces_to_comma = 1; @@ -216,43 +159,47 @@ <TEXT_FCN>[\;\,] { if (doing_set) { - yylval.string = strsave (yytext); - RETURN (TEXT); + yylval.tok_val = new token (yytext); + token_stack.push (yylval.tok_val); + TOK_RETURN (TEXT); } else { BEGIN 0; - RETURN (','); + TOK_RETURN (','); } } <HELP_FCN>[^ \t\n]*{S}* | <TEXT_FCN>[^ \t\n\;\,]*{S}* { - - static char *tok = (char *) NULL; - delete [] tok; - tok = strip_trailing_whitespace (yytext); - - yylval.string = strsave (tok); - RETURN (TEXT); - } + static char *tok = (char *) NULL; + delete [] tok; + tok = strip_trailing_whitespace (yytext); + yylval.tok_val = new token (tok); + token_stack.push (yylval.tok_val); + TOK_RETURN (TEXT); + } <TEXT_FCN>\'{QSTR}*[\n\'] { if (yytext[yyleng-1] == '\n') { error ("unterminated string constant"); - current_input_column = 0; + current_input_column = 1; jump_to_top_level (); } else { + static char *tok = (char *) NULL; + delete [] tok; int off1 = doing_set ? 0 : 1; int off2 = doing_set ? 0 : 2; - yylval.string = strsave (&yytext[off1]); - yylval.string[yyleng-off2] = '\0'; + tok = strsave (&yytext[off1]); + tok[yyleng-off2] = '\0'; + do_string_escapes (tok); + yylval.tok_val = new token (tok); + token_stack.push (yylval.tok_val); current_input_column += yyleng; } - do_string_escapes (yylval.string); return TEXT; } @@ -260,18 +207,22 @@ if (yytext[yyleng-1] == '\n') { error ("unterminated string constant"); - current_input_column = 0; + current_input_column = 1; jump_to_top_level (); } else { + static char *tok = (char *) NULL; + delete [] tok; int off1 = doing_set ? 0 : 1; int off2 = doing_set ? 0 : 2; - yylval.string = strsave (&yytext[off1]); - yylval.string[yyleng-off2] = '\0'; + tok = strsave (&yytext[off1]); + tok[yyleng-off2] = '\0'; + do_string_escapes (tok); + yylval.tok_val = new token (tok); + token_stack.push (yylval.tok_val); current_input_column += yyleng; } - do_string_escapes (yylval.string); return TEXT; } @@ -286,19 +237,23 @@ if (yytext[yyleng-1] == '\n') { error ("unterminated string constant"); - current_input_column = 0; + current_input_column = 1; jump_to_top_level (); } else { - yylval.string = strsave (yytext); - yylval.string[yyleng-1] = '\0'; + static char *tok = (char *) NULL; + delete [] tok; + tok = strsave (yytext); + tok[yyleng-1] = '\0'; + do_string_escapes (tok); + yylval.tok_val = new token (tok); + token_stack.push (yylval.tok_val); + quote_is_transpose = 1; + cant_be_identifier = 1; + convert_spaces_to_comma = 1; current_input_column += yyleng; } - do_string_escapes (yylval.string); - quote_is_transpose = 1; - cant_be_identifier = 1; - convert_spaces_to_comma = 1; return TEXT; } @@ -312,19 +267,23 @@ if (yytext[yyleng-1] == '\n') { error ("unterminated string constant"); - current_input_column = 0; + current_input_column = 1; jump_to_top_level (); } else { - yylval.string = strsave (yytext); - yylval.string[yyleng-1] = '\0'; + static char *tok = (char *) NULL; + delete [] tok; + tok = strsave (yytext); + tok[yyleng-1] = '\0'; + do_string_escapes (tok); + yylval.tok_val = new token (tok); + token_stack.push (yylval.tok_val); + quote_is_transpose = 1; + cant_be_identifier = 1; + convert_spaces_to_comma = 1; current_input_column += yyleng; } - do_string_escapes (yylval.string); - quote_is_transpose = 1; - cant_be_identifier = 1; - convert_spaces_to_comma = 1; return TEXT; } @@ -347,7 +306,7 @@ braceflag--; if (braceflag == 0) { - if (!defining_func) + if (! defining_func) promptflag++; BEGIN 0; } @@ -364,7 +323,7 @@ if (braceflag == 0) { BEGIN 0; - if (!defining_func) + if (! defining_func) promptflag++; } fixup_column_count (yytext); @@ -384,7 +343,7 @@ braceflag--; if (braceflag == 0) { - if (!defining_func) + if (! defining_func) promptflag++; BEGIN 0; } @@ -417,7 +376,7 @@ return ']'; } -<MATRIX>{S}*\,{S}* { RETURN (','); } +<MATRIX>{S}*\,{S}* { TOK_RETURN (','); } <MATRIX>{S}+ { int bin_op = next_token_is_bin_op (1, yytext); @@ -427,7 +386,7 @@ if (! (postfix_un_op || bin_op) && in_brace_or_paren.top () && convert_spaces_to_comma) - RETURN (','); + TOK_RETURN (','); } <MATRIX>{SN}*\;{SN}* | @@ -446,22 +405,27 @@ if (plotting && ! past_plot_range) { in_plot_range = 0; - RETURN (CLOSE_BRACE); + TOK_RETURN (CLOSE_BRACE); } else - RETURN (']'); + TOK_RETURN (']'); } {D}+{EXPON}?{Im} | {D}+\.{D}*{EXPON}?{Im} | \.{D}+{EXPON}?{Im} { - int nread = sscanf (yytext, "%lf", &(yylval.number)); + double value; + int nread = sscanf (yytext, "%lf", &value); assert (nread == 1); quote_is_transpose = 1; cant_be_identifier = 1; convert_spaces_to_comma = 1; if (plotting && ! in_plot_range) past_plot_range = 1; + yylval.tok_val = new token (value, + input_line_number, + current_input_column); + token_stack.push (yylval.tok_val); current_input_column += yyleng; DO_COMMA_INSERT_CHECK; return IMAG_NUM; @@ -471,13 +435,18 @@ {D}+\.{D}*{EXPON}? | \.{D}+{EXPON}? | { - int nread = sscanf (yytext, "%lf", &(yylval.number)); + double value; + int nread = sscanf (yytext, "%lf", &value); assert (nread == 1); quote_is_transpose = 1; cant_be_identifier = 1; convert_spaces_to_comma = 1; if (plotting && ! in_plot_range) past_plot_range = 1; + yylval.tok_val = new token (value, + input_line_number, + current_input_column); + token_stack.push (yylval.tok_val); current_input_column += yyleng; DO_COMMA_INSERT_CHECK; return NUM; @@ -488,7 +457,7 @@ if (plotting && ! past_plot_range) { in_plot_range = 1; - RETURN (OPEN_BRACE); + TOK_RETURN (OPEN_BRACE); } if (do_comma_insert) @@ -506,7 +475,7 @@ braceflag++; promptflag--; BEGIN NEW_MATRIX; - RETURN ('['); + TOK_RETURN ('['); } } @@ -517,10 +486,10 @@ // Line continuation. promptflag--; - current_input_column = 0; + current_input_column = 1; } -<<EOF>> RETURN (END_OF_INPUT); +<<EOF>> TOK_RETURN (END_OF_INPUT); {IDENT}{S}* { @@ -533,7 +502,7 @@ int kw_token = is_keyword (tok); if (kw_token) - RETURN (kw_token); + TOK_RETURN (kw_token); if (plotting && cant_be_identifier) { @@ -556,11 +525,12 @@ char *sty = plot_style_token (&tok[1]); if (sty != (char *) NULL) { - yylval.string = strsave (sty); + yylval.tok_val = new token (sty); + token_stack.push (yylval.tok_val); if (in_plot_style) { in_plot_style = 0; - RETURN (STYLE); + TOK_RETURN (STYLE); } } } @@ -577,14 +547,25 @@ BEGIN TEXT_FCN; if (strcmp (tok, "clear") == 0) - return CLEAR; + { + symbol_record *sr = + global_sym_tab->lookup ("clear", 1, 0); + assert (sr != (symbol_record *) NULL); + yylval.tok_val = new token (sr, input_line_number, + current_input_column); + token_stack.push (yylval.tok_val); + return CLEAR; + } else if (strcmp (tok, "help") == 0) BEGIN HELP_FCN; else if (strcmp (tok, "set") == 0) doing_set = 1; } - yylval.sym_rec = lookup_identifier (tok); + yylval.tok_val = new token (lookup_identifier (tok), + input_line_number, + current_input_column); + token_stack.push (yylval.tok_val); quote_is_transpose = 1; current_input_column += yyleng; @@ -631,7 +612,7 @@ int kw_token = is_keyword (yytext); if (kw_token) - RETURN (kw_token); + TOK_RETURN (kw_token); if (plotting && cant_be_identifier) { @@ -657,7 +638,15 @@ BEGIN TEXT_FCN; if (strcmp (yytext, "clear") == 0) - return CLEAR; + { + symbol_record *sr = + global_sym_tab->lookup ("clear", 1, 0); + assert (sr != (symbol_record *) NULL); + yylval.tok_val = new token (sr, input_line_number, + current_input_column); + token_stack.push (yylval.tok_val); + return CLEAR; + } else if (strcmp (yytext, "help") == 0) BEGIN HELP_FCN; else if (strcmp (yytext, "set") == 0) @@ -667,7 +656,10 @@ if (defining_func && maybe_screwed) curr_sym_tab = tmp_local_sym_tab; - yylval.sym_rec = lookup_identifier (yytext); + yylval.tok_val = new token (lookup_identifier (yytext), + input_line_number, + current_input_column); + token_stack.push (yylval.tok_val); convert_spaces_to_comma = 1; current_input_column += yyleng; @@ -686,7 +678,7 @@ "\n" { quote_is_transpose = 0; cant_be_identifier = 0; - current_input_column = 0; + current_input_column = 1; convert_spaces_to_comma = 1; return '\n'; } @@ -706,65 +698,65 @@ ":" { if (plotting && (in_plot_range || in_plot_using)) - RETURN (COLON); + BIN_OP_RETURN (COLON, 1); else - BIN_OP_RETURN (':'); + BIN_OP_RETURN (':', 0); } \" { BEGIN DQSTRING; } -".**" { BIN_OP_RETURN (EPOW); } -".*" { BIN_OP_RETURN (EMUL); } -"./" { BIN_OP_RETURN (EDIV); } -".\\" { BIN_OP_RETURN (ELEFTDIV); } -".^" { BIN_OP_RETURN (EPOW); } -".'" { DO_COMMA_INSERT_CHECK; RETURN (TRANSPOSE); } -"++" { DO_COMMA_INSERT_CHECK; RETURN (PLUS_PLUS); } -"--" { DO_COMMA_INSERT_CHECK; RETURN (MINUS_MINUS); } -"<=" { BIN_OP_RETURN (EXPR_LE); } -"==" { BIN_OP_RETURN (EXPR_EQ); } -"~=" { BIN_OP_RETURN (EXPR_NE); } -"!=" { BIN_OP_RETURN (EXPR_NE); } -"<>" { BIN_OP_RETURN (EXPR_NE); } -">=" { BIN_OP_RETURN (EXPR_GE); } -"||" { BIN_OP_RETURN (EXPR_OR); } -"&&" { BIN_OP_RETURN (EXPR_AND); } -"|" { BIN_OP_RETURN (EXPR_OR); } -"&" { BIN_OP_RETURN (EXPR_AND); } +".**" { BIN_OP_RETURN (EPOW, 0); } +".*" { BIN_OP_RETURN (EMUL, 0); } +"./" { BIN_OP_RETURN (EDIV, 0); } +".\\" { BIN_OP_RETURN (ELEFTDIV, 0); } +".^" { BIN_OP_RETURN (EPOW, 0); } +".'" { DO_COMMA_INSERT_CHECK; BIN_OP_RETURN (TRANSPOSE, 1); } +"++" { DO_COMMA_INSERT_CHECK; BIN_OP_RETURN (PLUS_PLUS, 1); } +"--" { DO_COMMA_INSERT_CHECK; BIN_OP_RETURN (MINUS_MINUS, 1); } +"<=" { BIN_OP_RETURN (EXPR_LE, 0); } +"==" { BIN_OP_RETURN (EXPR_EQ, 0); } +"~=" { BIN_OP_RETURN (EXPR_NE, 0); } +"!=" { BIN_OP_RETURN (EXPR_NE, 0); } +"<>" { BIN_OP_RETURN (EXPR_NE, 0); } +">=" { BIN_OP_RETURN (EXPR_GE, 0); } +"||" { BIN_OP_RETURN (EXPR_OR, 0); } +"&&" { BIN_OP_RETURN (EXPR_AND, 0); } +"|" { BIN_OP_RETURN (EXPR_OR, 0); } +"&" { BIN_OP_RETURN (EXPR_AND, 0); } "!" { if (plotting && ! in_plot_range) past_plot_range = 1; - RETURN (EXPR_NOT); + BIN_OP_RETURN (EXPR_NOT, 1); } "~" { if (plotting && ! in_plot_range) past_plot_range = 1; - BIN_OP_RETURN (EXPR_NOT); + BIN_OP_RETURN (EXPR_NOT, 0); } -"<" { BIN_OP_RETURN (EXPR_LT); } -">" { BIN_OP_RETURN (EXPR_GT); } +"<" { BIN_OP_RETURN (EXPR_LT, 0); } +">" { BIN_OP_RETURN (EXPR_GT, 0); } "+" { if (plotting && ! in_plot_range) past_plot_range = 1; - BIN_OP_RETURN ('+'); + BIN_OP_RETURN ('+', 0); } "-" { if (plotting && ! in_plot_range) past_plot_range = 1; - BIN_OP_RETURN ('-'); + BIN_OP_RETURN ('-', 0); } -"**" { BIN_OP_RETURN (POW); } -"*" { BIN_OP_RETURN ('*'); } -"/" { BIN_OP_RETURN ('/'); } -"\\" { BIN_OP_RETURN (LEFTDIV); } -";" { RETURN (';'); } -"," { RETURN (','); } -"^" { BIN_OP_RETURN (POW); } -"=" { RETURN ('='); } +"**" { BIN_OP_RETURN (POW, 0); } +"*" { BIN_OP_RETURN ('*', 0); } +"/" { BIN_OP_RETURN ('/', 0); } +"\\" { BIN_OP_RETURN (LEFTDIV, 0); } +";" { BIN_OP_RETURN (';', 1); } +"," { BIN_OP_RETURN (',', 1); } +"^" { BIN_OP_RETURN (POW, 0); } +"=" { BIN_OP_RETURN ('=', 1); } "(" { if (plotting && ! in_plot_range) past_plot_range = 1; in_brace_or_paren.push (0); - RETURN ('('); + TOK_RETURN ('('); } ")" { if (! in_brace_or_paren.empty ()) @@ -780,7 +772,7 @@ // We return everything else as single character tokens, which should // eventually result in a parse error. - RETURN (yytext[0]); + TOK_RETURN (yytext[0]); } %% @@ -801,7 +793,8 @@ } /* - * Fix things up for errors or interrupts. + * Fix things up for errors or interrupts. This could use a few + * comments now, eh? */ void reset_parser (void) @@ -820,7 +813,9 @@ curr_sym_tab = top_level_sym_tab; get_input_from_eval_string = 0; quote_is_transpose = 0; - current_input_column = 0; + current_input_column = 1; +// Might have been reset by defining a function. + input_line_number = current_command_number - 1; do_comma_insert = 0; plotting = 0; past_plot_range = 0; @@ -831,6 +826,8 @@ convert_spaces_to_comma = 1; beginning_of_function = 0; in_brace_or_paren.clear (); + while (! token_stack.empty ()) + delete token_stack.pop (); yyrestart (stdin); } @@ -906,7 +903,7 @@ while ((c = *s++) != '\0') { if (c == '\n') - current_input_column = 0; + current_input_column = 1; else current_input_column++; } @@ -1027,32 +1024,68 @@ if (sty != (char *) NULL) { in_plot_style = 0; - yylval.string = strsave (sty); + yylval.tok_val = new token (sty); + token_stack.push (yylval.tok_val); return STYLE; } } + int l = input_line_number; + int c = current_input_column; + int end_found = 0; if (strcmp ("break", s) == 0) - return BREAK; + { + return BREAK; + } else if (strcmp ("continue", s) == 0) - return CONTINUE; + { + return CONTINUE; + } else if (strcmp ("else", s) == 0) - { return ELSE; } + { + return ELSE; + } else if (strcmp ("elseif", s) == 0) - { return ELSEIF; } + { + return ELSEIF; + } else if (strcmp ("end", s) == 0) - { end_found = 1; yylval.ettype = simple_end; } + { + end_found = 1; + yylval.tok_val = new token (token::simple_end, l, c); + token_stack.push (yylval.tok_val); + } else if (strcmp ("endfor", s) == 0) - { end_found = 1; yylval.ettype = for_end; } + { + end_found = 1; + yylval.tok_val = new token (token::for_end, l, c); + token_stack.push (yylval.tok_val); + } else if (strcmp ("endfunction", s) == 0) - { end_found = 1; yylval.ettype = function_end; } + { + end_found = 1; + yylval.tok_val = new token (token::function_end, l, c); + token_stack.push (yylval.tok_val); + } else if (strcmp ("endif", s) == 0) - { end_found = 1; yylval.ettype = if_end; } + { + end_found = 1; + yylval.tok_val = new token (token::if_end, l, c); + token_stack.push (yylval.tok_val); + } else if (strcmp ("endwhile", s) == 0) - { end_found = 1; yylval.ettype = while_end; } + { + end_found = 1; + yylval.tok_val = new token (token::while_end, l, c); + token_stack.push (yylval.tok_val); + } else if (strcmp ("for", s) == 0) - { promptflag--; looping++; return FOR; } + { + promptflag--; + looping++; + return FOR; + } else if (strcmp ("function", s) == 0) { if (defining_func) @@ -1068,25 +1101,47 @@ promptflag--; beginning_of_function = 1; help_buf[0] = '\0'; + input_line_number = 1; return FCN; } } else if (strcmp ("global", s) == 0) - return GLOBAL; + { + return GLOBAL; + } else if (strcmp ("gplot", s) == 0) - { plotting = 1; yylval.pttype = two_dee; return PLOT; } + { + plotting = 1; + yylval.tok_val = new token (token::two_dee, l, c); + return PLOT; + } else if (strcmp ("gsplot", s) == 0) - { plotting = 1; yylval.pttype = three_dee; return PLOT; } + { + plotting = 1; + yylval.tok_val = new token (token::three_dee, l, c); + token_stack.push (yylval.tok_val); + return PLOT; + } else if (strcmp ("if", s) == 0) - { iffing++; promptflag--; return IF; } + { + iffing++; + promptflag--; + return IF; + } else if (strcmp ("return", s) == 0) - return FUNC_RET; + { + return FUNC_RET; + } else if (strcmp ("while", s) == 0) - { promptflag--; looping++; return WHILE; } + { + promptflag--; + looping++; + return WHILE; + } if (end_found) { - if (!defining_func && !looping) + if (! defining_func && ! looping) promptflag++; return END; }
--- a/src/octave.cc Mon Oct 04 00:40:57 1993 +0000 +++ b/src/octave.cc Mon Oct 04 02:36:58 1993 +0000 @@ -229,7 +229,7 @@ unwind_protect_int (echo_input); input_line_number = 0; - current_input_column = 0; + current_input_column = 1; echo_input = 0; parse_and_execute (f, print); @@ -479,6 +479,7 @@ retval = yyparse (); if (retval == 0 && global_command != NULL_TREE) { + error_state = 0; global_command->eval (1); delete global_command; current_command_number++;
--- a/src/parse.y Mon Oct 04 00:40:57 1993 +0000 +++ b/src/parse.y Mon Oct 04 02:36:58 1993 +0000 @@ -1,4 +1,4 @@ -/* parse.y -*- text -*- +/* parse.y -*- text -*- Copyright (C) 1992, 1993 John W. Eaton @@ -43,6 +43,7 @@ #include "octave.h" #include "parse.h" #include "lex.h" +#include "token.h" // Identifier to define if we are reading an M-fie. tree_identifier *id_to_define; @@ -79,7 +80,7 @@ int input_line_number = 0; // The column of the current token. -int current_input_column = 0; +int current_input_column = 1; // Buffer for help text snagged from M-files. // Probably shouldn't be a fixed size... @@ -101,25 +102,11 @@ // Nonzero means we're looking at the style part of a plot command. int in_plot_style = 0; -// The type of an END token. This declaration is repeated in lex.l. -enum end_tok_type - { - simple_end, - for_end, - function_end, - if_end, - while_end, - }; - -// The type of a PLOT token. This declaration is repeated in lex.l. -enum plot_tok_type - { - two_dee = 2, - three_dee = 3, - }; +// Check to see that end statements are properly matched. +static int check_end (token *tok, token::end_tok_type expected); // Error mesages for mismatched end statements. -static void end_error (char *type, end_tok_type ettype); +static void end_error (char *type, token::end_tok_type ettype, int l, int c); // Generic error messages. static void yyerror (char *s); @@ -147,6 +134,10 @@ */ %union { +// The type of the basic tokens returned by the lexer. + token *tok_val; + +// Types for the nonterminals we generate. tree *tree_type; tree_constant *tree_constant_type; tree_matrix *tree_matrix_type; @@ -167,91 +158,49 @@ tree_plot_range *tree_plot_range_type; tree_subplot_using *tree_subplot_using_type; tree_subplot_style *tree_subplot_style_type; - symbol_record *sym_rec; - double number; - char *string; - end_tok_type ettype; - plot_tok_type pttype; } -/* - * There are 20 shift/reduce conflicts, ok? - */ -%expect 20 +// Tokens with line and column information. +%token <tok_val> '=' ':' '-' '+' '*' '/' +%token <tok_val> EXPR_AND EXPR_OR EXPR_NOT +%token <tok_val> EXPR_LT EXPR_LE EXPR_EQ EXPR_NE EXPR_GE EXPR_GT +%token <tok_val> LEFTDIV EMUL EDIV ELEFTDIV QUOTE TRANSPOSE +%token <tok_val> PLUS_PLUS MINUS_MINUS POW EPOW +%token <tok_val> NUM IMAG_NUM +%token <tok_val> NAME SCREW CLEAR +%token <tok_val> END +%token <tok_val> PLOT +%token <tok_val> TEXT STYLE -/* - * Reserved words. - */ +// Other tokens. %token FOR WHILE IF ELSEIF ELSE FCN BREAK CONTINUE FUNC_RET SCREW_TWO -%token END_OF_INPUT GLOBAL CLEAR - +%token END_OF_INPUT GLOBAL %token USING TITLE WITH COLON OPEN_BRACE CLOSE_BRACE -// tree +// Nonterminals we construct. %type <tree_type> input command %type <tree_type> ans_expression expression simple_expr simple_expr1 %type <tree_type> title - -// tree_matrix %type <tree_matrix_type> matrix - -// tree_identifier %type <tree_identifier_type> identifier - -// tree_function %type <tree_function_type> func_def func_def1 func_def2 func_def3 - -// tree_index_expression %type <tree_index_expression_type> variable - -// tree_colon_expression %type <tree_colon_expression_type> colon_expr - -// tree_argument_list %type <tree_argument_list_type> arg_list arg_list1 - -// tree_parameter_list %type <tree_parameter_list_type> param_list param_list1 func_def1a - -// tree_word_list %type <tree_word_list_type> word_list word_list1 - -// tree_command %type <tree_command_type> statement - -// tree_if_command %type <tree_if_command_type> elseif - -// tree_command_list %type <tree_command_list_type> simple_list simple_list1 list list1 opt_list - -// tree_word_list_command %type <tree_word_list_command_type> word_list_cmd - -// tree_plot_command %type <tree_plot_command_type> plot_command - -// tree_subplot_list %type <tree_subplot_list_type> plot_command1 plot_command2 plot_options - -// tree_plot_limits %type <tree_plot_limits_type> ranges - -// tree_plot_range %type <tree_plot_range_type> ranges1 - -// tree_subplot_using %type <tree_subplot_using_type> using using1 - -// tree_subplot_style %type <tree_subplot_style_type> style -%token <number> NUM IMAG_NUM -%token <sym_rec> NAME SCREW -%token <string> TEXT STYLE -%token <ettype> END -%token <pttype> PLOT - +// Precedence and associativity. %left ';' ',' '\n' %right '=' %left EXPR_AND EXPR_OR @@ -263,6 +212,10 @@ %left UNARY PLUS_PLUS MINUS_MINUS EXPR_NOT %right POW EPOW +// There are 20 shift/reduce conflicts, ok? +%expect 20 + +// Where to start. %start input /* @@ -397,7 +350,7 @@ plot_command : PLOT plot_command1 { tree_subplot_list *tmp = $2->reverse (); - $$ = new tree_plot_command (tmp, $1); + $$ = new tree_plot_command (tmp, $1->pttype ()); plotting = 0; past_plot_range = 0; in_plot_range = 0; @@ -407,7 +360,7 @@ | PLOT ranges plot_command1 { tree_subplot_list *tmp = $3->reverse (); - $$ = new tree_plot_command (tmp, $2, $1); + $$ = new tree_plot_command (tmp, $2, $1->pttype ()); plotting = 0; past_plot_range = 0; in_plot_range = 0; @@ -506,11 +459,11 @@ ; style : WITH STYLE - { $$ = new tree_subplot_style ($2); } + { $$ = new tree_subplot_style ($2->string ()); } | WITH STYLE expression - { $$ = new tree_subplot_style ($2, $3); } + { $$ = new tree_subplot_style ($2->string (), $3); } | WITH STYLE expression bogus_syntax expression - { $$ = new tree_subplot_style ($2, $3, $5); } + { $$ = new tree_subplot_style ($2->string (), $3, $5); } ; bogus_syntax : // empty @@ -525,23 +478,27 @@ ; global_decl1 : NAME - { force_global ($1->name ()); } + { force_global ($1->sym_rec()->name ()); } | NAME '=' expression { - symbol_record *sr = force_global ($1->name ()); - tree_identifier *id = new tree_identifier (sr); + symbol_record *sr = force_global ($1->sym_rec()->name ()); + tree_identifier *id = new tree_identifier + (sr, $1->line (), $1->column ()); tree_simple_assignment_expression *expr = - new tree_simple_assignment_expression (id, $3); + new tree_simple_assignment_expression + (id, $3, $2->line () , $2->column ()); expr->eval (0); } | global_decl1 optcomma NAME - { force_global ($3->name ()); } + { force_global ($3->sym_rec()->name ()); } | global_decl1 optcomma NAME '=' expression { - symbol_record *sr = force_global ($3->name ()); - tree_identifier *id = new tree_identifier (sr); + symbol_record *sr = force_global ($3->sym_rec()->name ()); + tree_identifier *id = new tree_identifier + (sr, $3->line (), $3->column ()); tree_simple_assignment_expression *expr = - new tree_simple_assignment_expression (id, $5); + new tree_simple_assignment_expression + (id, $5, $4->line (), $4->column ()); expr->eval (0); } ; @@ -558,47 +515,31 @@ statement : WHILE expression optsep opt_list END { maybe_warn_assign_as_truth_value ($2); - if ($5 != while_end && $5 != simple_end) - { - yyerror ("parse error"); - end_error ("while", $5); - ABORT_PARSE; - } + if (check_end ($5, token::while_end)) + ABORT_PARSE; looping--; $$ = new tree_while_command ($2, $4); } | FOR variable '=' expression optsep opt_list END { - if ($7 != for_end && $7 != simple_end) - { - yyerror ("parse error"); - end_error ("for", $7); - ABORT_PARSE; - } + if (check_end ($7, token::for_end)) + ABORT_PARSE; looping--; $$ = new tree_for_command ($2, $4, $6); } | IF expression optsep opt_list END { maybe_warn_assign_as_truth_value ($2); - if ($5 != if_end && $5 != simple_end) - { - yyerror ("parse error"); - end_error ("if", $5); - ABORT_PARSE; - } + if (check_end ($5, token::if_end)) + ABORT_PARSE; iffing--; $$ = new tree_if_command ($2, $4); } | IF expression optsep opt_list ELSE optsep opt_list END { maybe_warn_assign_as_truth_value ($2); - if ($8 != if_end && $8 != simple_end) - { - yyerror ("parse error"); - end_error ("if", $8); - ABORT_PARSE; - } + if (check_end ($8, token::if_end)) + ABORT_PARSE; iffing--; tree_if_command *t1 = new tree_if_command ($7); $$ = t1->chain ($2, $4); @@ -606,12 +547,8 @@ | IF expression optsep opt_list elseif END { maybe_warn_assign_as_truth_value ($2); - if ($6 != if_end && $6 != simple_end) - { - yyerror ("parse error"); - end_error ("if", $6); - ABORT_PARSE; - } + if (check_end ($6, token::if_end)) + ABORT_PARSE; iffing--; tree_if_command *t1 = $5->reverse (); // Add the if list to the new head of the elseif @@ -621,12 +558,8 @@ | IF expression optsep opt_list elseif ELSE optsep opt_list END { maybe_warn_assign_as_truth_value ($2); - if ($9 != if_end && $9 != simple_end) - { - yyerror ("parse error"); - end_error ("if", $9); - ABORT_PARSE; - } + if (check_end ($9, token::if_end)) + ABORT_PARSE; iffing--; // Add the else list to the head of the elseif list, // then reverse the list. @@ -699,12 +632,13 @@ ; expression : variable '=' expression - { $$ = new tree_simple_assignment_expression ($1, $3); } + { $$ = new tree_simple_assignment_expression + ($1, $3, $2->line (), $2->column ()); } | '[' screwed_again matrix_row SCREW_TWO '=' expression { // Will need a way to convert the matrix list to a list of -// identifiers. If that fails, we can abort here, without losing +// identifiers. If that fails, we can abort here, without losing // anything -- no other possible syntax is valid if we've seen the // equals sign as the next token after the `]'. @@ -716,12 +650,13 @@ if (id_list == NULL_TREE) { yyerror ("parse error"); - error ("invalid identifier list for assignment"); + error ("invalid identifier list for assignment"); $$ = (tree_multi_assignment_expression *) NULL; ABORT_PARSE; } else - $$ = new tree_multi_assignment_expression (id_list, $6); + $$ = new tree_multi_assignment_expression + (id_list, $6, $5->line (), $5->column ()); } | NUM '=' expression { @@ -737,58 +672,79 @@ simple_expr : simple_expr1 { $$ = $1; } | identifier PLUS_PLUS - { $$ = new tree_postfix_expression ($1, tree::increment); } + { $$ = new tree_postfix_expression + ($1, tree::increment, $2->line (), $2->column ()); } | identifier MINUS_MINUS - { $$ = new tree_postfix_expression ($1, tree::decrement); } + { $$ = new tree_postfix_expression + ($1, tree::decrement, $2->line (), $2->column ()); } | simple_expr QUOTE - { $$ = new tree_unary_expression ($1, tree::hermitian); } + { $$ = new tree_unary_expression + ($1, tree::hermitian, $2->line (), $2->column ()); } | simple_expr TRANSPOSE - { $$ = new tree_unary_expression ($1, tree::transpose); } + { $$ = new tree_unary_expression + ($1, tree::transpose, $2->line (), $2->column ()); } | simple_expr POW simple_expr - { $$ = new tree_binary_expression ($1, $3, tree::power); } + { $$ = new tree_binary_expression + ($1, $3, tree::power, $2->line (), $2->column ()); } | simple_expr EPOW simple_expr - { $$ = new tree_binary_expression ($1, $3, tree::elem_pow); } + { $$ = new tree_binary_expression + ($1, $3, tree::elem_pow, $2->line (), $2->column ()); } | simple_expr '+' simple_expr - { $$ = new tree_binary_expression ($1, $3, tree::add); } + { $$ = new tree_binary_expression + ($1, $3, tree::add, $2->line (), $2->column ()); } | simple_expr '-' simple_expr - { $$ = new tree_binary_expression ($1, $3, tree::subtract); } + { $$ = new tree_binary_expression + ($1, $3, tree::subtract, $2->line (), $2->column ()); } | simple_expr '*' simple_expr - { $$ = new tree_binary_expression ($1, $3, tree::multiply); } + { $$ = new tree_binary_expression + ($1, $3, tree::multiply, $2->line (), $2->column ()); } | simple_expr '/' simple_expr - { $$ = new tree_binary_expression ($1, $3, tree::divide); } + { $$ = new tree_binary_expression + ($1, $3, tree::divide, $2->line (), $2->column ()); } | simple_expr EMUL simple_expr - { $$ = new tree_binary_expression ($1, $3, tree::el_mul); } + { $$ = new tree_binary_expression + ($1, $3, tree::el_mul, $2->line (), $2->column ()); } | simple_expr EDIV simple_expr - { $$ = new tree_binary_expression ($1, $3, tree::el_div); } + { $$ = new tree_binary_expression + ($1, $3, tree::el_div, $2->line (), $2->column ()); } | simple_expr LEFTDIV simple_expr - { $$ = new tree_binary_expression ($1, $3, tree::leftdiv); } + { $$ = new tree_binary_expression + ($1, $3, tree::leftdiv, $2->line (), $2->column ()); } | simple_expr ELEFTDIV simple_expr - { $$ = new tree_binary_expression ($1, $3, - tree::el_leftdiv); } + { $$ = new tree_binary_expression + ($1, $3, tree::el_leftdiv, $2->line (), $2->column ()); } | simple_expr EXPR_LT simple_expr - { $$ = new tree_binary_expression ($1, $3, tree::cmp_lt); } + { $$ = new tree_binary_expression + ($1, $3, tree::cmp_lt, $2->line (), $2->column ()); } | simple_expr EXPR_LE simple_expr - { $$ = new tree_binary_expression ($1, $3, tree::cmp_le); } + { $$ = new tree_binary_expression + ($1, $3, tree::cmp_le, $2->line (), $2->column ()); } | simple_expr EXPR_EQ simple_expr - { $$ = new tree_binary_expression ($1, $3, tree::cmp_eq); } + { $$ = new tree_binary_expression + ($1, $3, tree::cmp_eq, $2->line (), $2->column ()); } | simple_expr EXPR_GE simple_expr - { $$ = new tree_binary_expression ($1, $3, tree::cmp_ge); } + { $$ = new tree_binary_expression + ($1, $3, tree::cmp_ge, $2->line (), $2->column ()); } | simple_expr EXPR_GT simple_expr - { $$ = new tree_binary_expression ($1, $3, tree::cmp_gt); } + { $$ = new tree_binary_expression + ($1, $3, tree::cmp_gt, $2->line (), $2->column ()); } | simple_expr EXPR_NE simple_expr - { $$ = new tree_binary_expression ($1, $3, tree::cmp_ne); } + { $$ = new tree_binary_expression + ($1, $3, tree::cmp_ne, $2->line (), $2->column ()); } | simple_expr EXPR_AND simple_expr - { $$ = new tree_binary_expression ($1, $3, tree::and); } + { $$ = new tree_binary_expression + ($1, $3, tree::and, $2->line (), $2->column ()); } | simple_expr EXPR_OR simple_expr - { $$ = new tree_binary_expression ($1, $3, tree::or); } + { $$ = new tree_binary_expression + ($1, $3, tree::or, $2->line (), $2->column ()); } ; simple_expr1 : NUM - { $$ = new tree_constant ($1); } + { $$ = new tree_constant ($1->number ()); } | IMAG_NUM - { $$ = new tree_constant (Complex (0.0, $1)); } + { $$ = new tree_constant (Complex (0.0, $1->number ())); } | TEXT - { $$ = new tree_constant ($1); } + { $$ = new tree_constant ($1->string ()); } | word_list_cmd { $$ = $1; } | '(' expression ')' @@ -804,19 +760,24 @@ | colon_expr { $$ = $1; } | PLUS_PLUS identifier %prec UNARY - { $$ = new tree_prefix_expression ($2, tree::increment); } + { $$ = new tree_prefix_expression + ($2, tree::increment, $1->line (), $1->column ()); } | MINUS_MINUS identifier %prec UNARY - { $$ = new tree_prefix_expression ($2, tree::decrement); } + { $$ = new tree_prefix_expression + ($2, tree::decrement, $1->line (), $1->column ()); } | EXPR_NOT simple_expr - { $$ = new tree_unary_expression ($2, tree::not); } + { $$ = new tree_unary_expression + ($2, tree::not, $1->line (), $1->column ()); } | '+' simple_expr %prec UNARY { $$ = $2; } | '-' simple_expr %prec UNARY - { $$ = new tree_unary_expression ($2, tree::uminus); } + { $$ = new tree_unary_expression + ($2, tree::uminus, $1->line (), $1->column ()); } ; colon_expr : simple_expr ':' simple_expr - { $$ = new tree_colon_expression ($1, $3); } + { $$ = new tree_colon_expression + ($1, $3, $2->line (), $2->column ()); } | colon_expr ':' simple_expr { $$ = $1->chain ($3); @@ -838,9 +799,8 @@ error ("clear: invalid within function body"); ABORT_PARSE; } - symbol_record *sr = global_sym_tab->lookup ("clear", 1, 0); - assert (sr != (symbol_record *) NULL); - tree_identifier *tmp = new tree_identifier (sr); + tree_identifier *tmp = new tree_identifier + ($1->sym_rec (), $1->line (), $1->column ()); $$ = new tree_word_list_command (tmp, (tree_word_list *) NULL); } @@ -852,9 +812,8 @@ error ("clear: invalid within function body"); ABORT_PARSE; } - symbol_record *sr = global_sym_tab->lookup ("clear", 1, 0); - assert (sr != (symbol_record *) NULL); - tree_identifier *tmp = new tree_identifier (sr); + tree_identifier *tmp = new tree_identifier + ($1->sym_rec (), $1->line (), $1->column ()); $$ = new tree_word_list_command (tmp, $2); } ; @@ -864,9 +823,9 @@ ; word_list1 : TEXT - { $$ = new tree_word_list ($1); } + { $$ = new tree_word_list ($1->string ()); } | word_list1 TEXT - { $$ = $1->chain ($2); } + { $$ = $1->chain ($2->string ()); } ; // This is truly disgusting. @@ -903,7 +862,8 @@ func_def1 : SCREW safe g_symtab '=' func_def2 { - tree_identifier *tmp = new tree_identifier ($1); + tree_identifier *tmp = new tree_identifier + ($1->sym_rec (), $1->line (), $1->column ()); tree_parameter_list *tpl = new tree_parameter_list (tmp); tpl = tpl->reverse (); tpl->mark_as_formal_parameters (); @@ -958,6 +918,7 @@ top_level_sym_tab->clear (id_name); } + $4->stash_function_name (id_name); $$ = $4; } ; @@ -975,12 +936,8 @@ fcn_end_or_eof : END { - if ($1 != function_end && $1 != simple_end) - { - yyerror ("parse error"); - end_error ("function", $1); + if (check_end ($1, token::function_end)) ABORT_PARSE; - } if (reading_m_file) check_for_garbage_after_fcn_def (); @@ -1035,7 +992,8 @@ ; identifier : NAME - { $$ = new tree_identifier ($1); } + { $$ = new tree_identifier + ($1->sym_rec (), $1->line (), $1->column ()); } arg_list : arg_list1 { $$ = $1->reverse (); } @@ -1101,7 +1059,7 @@ { mlnm.pop (); mlnm.push (0); - tree_matrix *tmp = new tree_matrix ($1, tree::md_none); + tree_matrix *tmp = new tree_matrix ($1, tree::md_none); ml.push (tmp); } else @@ -1126,7 +1084,7 @@ yyerror (char *s) { char *line = current_input_line; - int err_col = current_input_column; + int err_col = current_input_column - 1; if (err_col == 0) err_col = strlen (current_input_line) + 1; @@ -1152,25 +1110,62 @@ fprintf (stderr, ":\n\n %s\n %*s\n\n", line, err_col, "^"); } +static int +check_end (token *tok, token::end_tok_type expected) +{ + token::end_tok_type ettype = tok->ettype (); + if (ettype != expected && ettype != token::simple_end) + { + yyerror ("parse error"); + + int l = tok->line (); + int c = tok->column (); + + switch (expected) + { + case token::for_end: + end_error ("for", ettype, l, c); + break; + case token::function_end: + end_error ("function", ettype, l, c); + break; + case token::if_end: + end_error ("if", ettype, l, c); + break; + case token::while_end: + end_error ("while", ettype, l, c); + break; + default: + panic_impossible (); + break; + } + return 1; + } + else + return 0; +} + static void -end_error (char *type, end_tok_type ettype) +end_error (char *type, token::end_tok_type ettype, int l, int c) { + static char *fmt = "%s command matched by `%s' near line %d column %d"; + switch (ettype) { - case simple_end: - error ("%s command matched by `end'", type); + case token::simple_end: + error (fmt, type, "end", l, c); break; - case for_end: - error ("%s command matched by `endfor'", type); + case token::for_end: + error (fmt, type, "endfor", l, c); break; - case function_end: - error ("%s command matched by `endfunction'", type); + case token::function_end: + error (fmt, type, "endfunction", l, c); break; - case if_end: - error ("%s command matched by `endif'", type); + case token::if_end: + error (fmt, type, "endif", l, c); break; - case while_end: - error ("%s command matched by `endwhile'", type); + case token::while_end: + error (fmt, type, "endwhile", l, c); break; default: panic_impossible ();
--- a/src/pt-base.h Mon Oct 04 00:40:57 1993 +0000 +++ b/src/pt-base.h Mon Oct 04 02:36:58 1993 +0000 @@ -151,6 +151,13 @@ virtual int save (ostream& os, int mark_as_global = 0) { assert (0); return 0; } + + virtual int line (void) { return line_num; } + virtual int column (void) { return column_num; } + +protected: + int line_num; + int column_num; }; #endif
--- a/src/pt-const.cc Mon Oct 04 00:40:57 1993 +0000 +++ b/src/pt-const.cc Mon Oct 04 02:36:58 1993 +0000 @@ -865,6 +865,8 @@ tree_constant do_binary_op (tree_constant& a, tree_constant& b, tree::expression_type t) { + tree_constant ans; + int first_empty = (a.rows () == 0 || a.columns () == 0); int second_empty = (b.rows () == 0 || b.columns () == 0); @@ -876,7 +878,7 @@ else if (flag == 0) { error ("invalid binary operation on empty matrix"); - jump_to_top_level (); + return ans; } } @@ -891,8 +893,6 @@ Complex c1, c2; ComplexMatrix cm1, cm2; - tree_constant ans; - switch (a_type) { case tree_constant_rep::scalar_constant: @@ -1010,6 +1010,8 @@ tree_constant do_unary_op (tree_constant& a, tree::expression_type t) { + tree_constant ans; + if (a.rows () == 0 || a.columns () == 0) { int flag = user_pref.propagate_empty_matrices; @@ -1018,14 +1020,12 @@ else if (flag == 0) { error ("invalid unary operation on empty matrix"); - jump_to_top_level (); + return ans; } } tree_constant tmp_a = a.make_numeric (); - tree_constant ans; - switch (tmp_a.const_type ()) { case tree_constant_rep::scalar_constant: @@ -1118,6 +1118,9 @@ void tree_constant_rep::eval (int print) { + if (error_state) + return; + switch (type_tag) { case complex_scalar_constant: @@ -1149,11 +1152,44 @@ break; } + int nr = rows (); + int nc = columns (); + + if (nr == 1 && nc == 1) + { + switch (type_tag) + { + case matrix_constant: + { + double d = matrix->elem (0, 0); + delete matrix; + scalar = d; + type_tag = scalar_constant; + } + break; + case complex_matrix_constant: + { + Complex c = complex_matrix->elem (0, 0); + delete complex_matrix; + complex_scalar = new Complex (c); + type_tag = complex_scalar_constant; + } + break; + case range_constant: + { + double d = range->base (); + delete range; + scalar = d; + type_tag = scalar_constant; + } + break; + default: + break; + } + } + if (print) { - int nr = rows (); - int nc = columns (); - ostrstream output_buf; switch (type_tag) { @@ -1206,6 +1242,9 @@ tree_constant_rep::eval (tree_constant *args, int nargin, int nargout, int print) { + if (error_state) + return NULL_TREE_CONST; + tree_constant *retval = new tree_constant [2]; switch (type_tag) {
--- a/src/pt-plot.cc Mon Oct 04 00:40:57 1993 +0000 +++ b/src/pt-plot.cc Mon Oct 04 02:36:58 1993 +0000 @@ -81,6 +81,9 @@ { tree_constant retval; + if (error_state) + return retval; + ostrstream plot_buf; switch (ndim)
--- a/src/tc-assign.cc Mon Oct 04 00:40:57 1993 +0000 +++ b/src/tc-assign.cc Mon Oct 04 02:36:58 1993 +0000 @@ -88,7 +88,7 @@ else { error ("invalid assignment to scalar"); - jump_to_top_level (); + return; } } else @@ -106,12 +106,14 @@ else { error ("invalid assignment to scalar"); - jump_to_top_level (); + return; } } } else if (user_pref.resize_on_range_error) { + tree_constant_rep::constant_type old_type_tag = type_tag; + if (type_tag == complex_scalar_constant) { Complex *old_complex = complex_scalar; @@ -124,18 +126,30 @@ matrix = new Matrix (1, 1, scalar); type_tag = matrix_constant; } + +// If there is an error, the call to do_matrix_assignment should not +// destroy the current value. tree_constant_rep::eval(int) will take +// care of converting single element matrices back to scalars. + do_matrix_assignment (rhs, args, nargs); + +// I don't think there's any other way to revert back to unknown +// constant types, so here it is. + + if (old_type_tag == unknown_constant && error_state) + { + if (type_tag == matrix_constant) + delete matrix; + else if (type_tag == complex_matrix_constant) + delete complex_matrix; + + type_tag = unknown_constant; + } } else if (nargs > 3 || nargs < 2) - { - error ("invalid index expression for scalar type"); - jump_to_top_level (); - } + error ("invalid index expression for scalar type"); else - { - error ("index invalid or out of range for scalar type"); - jump_to_top_level (); - } + error ("index invalid or out of range for scalar type"); } void @@ -228,11 +242,12 @@ case scalar_constant: { int i = NINT (tmp_i.double_value ()); - index_check (i-1, ""); + if (index_check (i-1, "") < 0) + return; if (nr <= 1 || nc <= 1) maybe_resize (i-1); - else - range_max_check (i-1, nr * nc); + else if (range_max_check (i-1, nr * nc) < 0) + return; nr = rows (); nc = columns (); @@ -240,7 +255,7 @@ if (! indexed_assign_conforms (1, 1, rhs_nr, rhs_nc)) { error ("for A(int) = X: X must be a scalar"); - jump_to_top_level (); + return; } int ii = fortran_row (i, nr) - 1; int jj = fortran_column (i, nr) - 1; @@ -257,14 +272,14 @@ if (nr <= 1 || nc <= 1) maybe_resize (imax-1); - else - range_max_check (imax-1, len); + else if (range_max_check (imax-1, len) < 0) + return; if (ii.capacity () != rhs_nr * rhs_nc) { error ("A(matrix) = X: X and matrix must have the same\ number of elements"); - jump_to_top_level (); + return; } fortran_style_matrix_assignment (rhs, ii); } @@ -303,7 +318,8 @@ case scalar_constant: { int i = tree_to_mat_idx (tmp_i.double_value ()); - index_check (i, ""); + if (index_check (i, "") < 0) + return; do_vector_assign (rhs, i); } break; @@ -329,7 +345,8 @@ else { int imax; - index_check (ri, imax, ""); + if (index_check (ri, imax, "") < 0) + return; do_vector_assign (rhs, ri, imax); } } @@ -342,7 +359,7 @@ if (! indexed_assign_conforms (nr, nc, rhs_nr, rhs_nc)) { error ("A(:) = X: X and A must have the same dimensions"); - jump_to_top_level (); + return; } do_matrix_assignment (rhs, magic_colon, magic_colon); } @@ -363,29 +380,20 @@ if (nr == 1 && nc == 1) // No orientation to preserve { if (! ( ilen == rhs_nr || ilen == rhs_nc)) - { - error ("A(%s) = X: X and %s must have the same number of\ + error ("A(%s) = X: X and %s must have the same number of\ elements", rm, rm); - jump_to_top_level (); - } } else if (nr == 1) // Preserve current row orientation { if (! (rhs_nr == 1 && rhs_nc == ilen)) - { - error ("A(%s) = X: where A is a row vector, X must also be a\ + error ("A(%s) = X: where A is a row vector, X must also be a\ row vector with the same number of elements as %s", rm, rm); - jump_to_top_level (); - } } else if (nc == 1) // Preserve current column orientation { if (! (rhs_nc == 1 && rhs_nr == ilen)) - { - error ("A(%s) = X: where A is a column vector, X must also\ + error ("A(%s) = X: where A is a column vector, X must also\ be a column vector with the same number of elements as %s", rm, rm); - jump_to_top_level (); - } } else panic_impossible (); @@ -400,7 +408,7 @@ if (! indexed_assign_conforms (1, 1, rhs_nr, rhs_nc)) { error ("for A(int) = X: X must be a scalar"); - jump_to_top_level (); + return; } maybe_resize (i); @@ -530,7 +538,7 @@ else if (nr*nc != rhs_size) { error ("A(:) = X: X and A must have the same number of elements"); - jump_to_top_level (); + return; } if (rhs.const_type () == matrix_constant) @@ -588,10 +596,7 @@ } } else - { - error ("number of rows and columns must match for indexed assignment"); - jump_to_top_level (); - } + error ("number of rows and columns must match for indexed assignment"); } void @@ -603,16 +608,14 @@ tree_constant_rep::constant_type itype = tmp_i.const_type (); -// index_check() and matrix_to_index_vector() jump to the top level on -// errors. - switch (itype) { case complex_scalar_constant: case scalar_constant: { int i = tree_to_mat_idx (tmp_i.double_value ()); - index_check (i, "row"); + if (index_check (i, "row") < 0) + return; do_matrix_assignment (rhs, i, j_arg); } break; @@ -637,7 +640,8 @@ else { int imax; - index_check (ri, imax, "row"); + if (index_check (ri, imax, "row") < 0) + return; do_matrix_assignment (rhs, ri, imax, j_arg); } } @@ -662,20 +666,18 @@ int rhs_nr = rhs.rows (); int rhs_nc = rhs.columns (); -// index_check() and matrix_to_index_vector() jump to the top level on -// errors. - switch (jtype) { case complex_scalar_constant: case scalar_constant: { int j = tree_to_mat_idx (tmp_j.double_value ()); - index_check (j, "column"); + if (index_check (j, "column") < 0) + return; if (! indexed_assign_conforms (1, 1, rhs_nr, rhs_nc)) { error ("A(int,int) = X, X must be a scalar"); - jump_to_top_level (); + return; } maybe_resize (i, j); do_matrix_assignment (rhs, i, j); @@ -691,7 +693,7 @@ { error ("A(int,matrix) = X: X must be a row vector with the\ same number of elements as matrix"); - jump_to_top_level (); + return; } maybe_resize (i, jv.max ()); do_matrix_assignment (rhs, i, jv); @@ -707,7 +709,7 @@ { error ("A(int,range) = X: X must be a row vector with the\ same number of elements as range"); - jump_to_top_level (); + return; } if (columns () == 2 && is_zero_one (rj) && rhs_nc == 1) { @@ -716,7 +718,8 @@ else { int jmax; - index_check (rj, jmax, "column"); + if (index_check (rj, jmax, "column") < 0) + return; maybe_resize (i, jmax); do_matrix_assignment (rhs, i, rj); } @@ -745,7 +748,7 @@ { error ("A(int,:) = X: X must be a row vector with the\ same number of columns as A"); - jump_to_top_level (); + return; } do_matrix_assignment (rhs, i, magic_colon); @@ -768,21 +771,19 @@ int rhs_nr = rhs.rows (); int rhs_nc = rhs.columns (); -// index_check() and matrix_to_index_vector() jump to the top level on -// errors. - switch (jtype) { case complex_scalar_constant: case scalar_constant: { int j = tree_to_mat_idx (tmp_j.double_value ()); - index_check (j, "column"); + if (index_check (j, "column") < 0) + return; if (! indexed_assign_conforms (iv.capacity (), 1, rhs_nr, rhs_nc)) { error ("A(matrix,int) = X: X must be a column vector with\ the same number of elements as matrix"); - jump_to_top_level (); + return; } maybe_resize (iv.max (), j); do_matrix_assignment (rhs, iv, j); @@ -800,7 +801,7 @@ error ("A(r_matrix,c_matrix) = X: the number of rows in X\ must match the number of elements in r_matrix and the number of\ columns in X must match the number of elements in c_matrix"); - jump_to_top_level (); + return; } maybe_resize (iv.max (), jv.max ()); do_matrix_assignment (rhs, iv, jv); @@ -818,7 +819,7 @@ error ("A(matrix,range) = X: the number of rows in X must\ match the number of elements in matrix and the number of columns in X\ must match the number of elements in range"); - jump_to_top_level (); + return; } if (columns () == 2 && is_zero_one (rj) && rhs_nc == 1) { @@ -827,7 +828,8 @@ else { int jmax; - index_check (rj, jmax, "column"); + if (index_check (rj, jmax, "column") < 0) + return; maybe_resize (iv.max (), jmax); do_matrix_assignment (rhs, iv, rj); } @@ -841,7 +843,7 @@ error ("A(matrix,:) = X: the number of rows in X must\ match the number of elements in matrix, and the number of columns in\ X must match the number of columns in A"); - jump_to_top_level (); + return; } maybe_resize (iv.max (), nc-1); do_matrix_assignment (rhs, iv, magic_colon); @@ -865,22 +867,19 @@ int rhs_nr = rhs.rows (); int rhs_nc = rhs.columns (); -// index_check() and matrix_to_index_vector() jump to the top level on -// errors. - switch (jtype) { case complex_scalar_constant: case scalar_constant: { int j = tree_to_mat_idx (tmp_j.double_value ()); - index_check (j, "column"); + if (index_check (j, "column") < 0) + return; if (! indexed_assign_conforms (ri.nelem (), 1, rhs_nr, rhs_nc)) { error ("A(range,int) = X: X must be a column vector with\ the same number of elements as range"); - jump_to_top_level (); - jump_to_top_level (); + return; } maybe_resize (imax, j); do_matrix_assignment (rhs, ri, j); @@ -898,7 +897,7 @@ error ("A(range,matrix) = X: the number of rows in X must\ match the number of elements in range and the number of columns in X\ must match the number of elements in matrix"); - jump_to_top_level (); + return; } maybe_resize (imax, jv.max ()); do_matrix_assignment (rhs, ri, jv); @@ -916,7 +915,7 @@ error ("A(r_range,c_range) = X: the number of rows in X\ must match the number of elements in r_range and the number of\ columns in X must match the number of elements in c_range\n"); - jump_to_top_level (); + return; } if (columns () == 2 && is_zero_one (rj) && rhs_nc == 1) { @@ -925,7 +924,8 @@ else { int jmax; - index_check (rj, jmax, "column"); + if (index_check (rj, jmax, "column") < 0) + return; maybe_resize (imax, jmax); do_matrix_assignment (rhs, ri, rj); } @@ -939,7 +939,7 @@ error ("A(range,:) = X: the number of rows in X must match\ the number of elements in range, and the number of columns in X must\ match the number of columns in A"); - jump_to_top_level (); + return; } maybe_resize (imax, nc-1); do_matrix_assignment (rhs, ri, magic_colon); @@ -963,16 +963,14 @@ int rhs_nr = rhs.rows (); int rhs_nc = rhs.columns (); -// index_check() and matrix_to_index_vector() jump to the top level on -// errors. - switch (jtype) { case complex_scalar_constant: case scalar_constant: { int j = tree_to_mat_idx (tmp_j.double_value ()); - index_check (j, "column"); + if (index_check (j, "column") < 0) + return; int nr = rows (); if (nr == 0 && columns () == 0 && rhs_nc == 1) { @@ -994,7 +992,7 @@ { error ("A(:,int) = X: X must be a column vector with the\ same number of rows as A"); - jump_to_top_level (); + return; } do_matrix_assignment (rhs, magic_colon, j); @@ -1012,7 +1010,7 @@ error ("A(:,matrix) = X: the number of rows in X must\ match the number of rows in A, and the number of columns in X must\ match the number of elements in matrix"); - jump_to_top_level (); + return; } maybe_resize (nr-1, jv.max ()); do_matrix_assignment (rhs, magic_colon, jv); @@ -1030,7 +1028,7 @@ error ("A(:,range) = X: the number of rows in X must match\ the number of rows in A, and the number of columns in X must match\ the number of elements in range"); - jump_to_top_level (); + return; } if (columns () == 2 && is_zero_one (rj) && rhs_nc == 1) { @@ -1039,7 +1037,8 @@ else { int jmax; - index_check (rj, jmax, "column"); + if (index_check (rj, jmax, "column") < 0) + return; maybe_resize (nr-1, jmax); do_matrix_assignment (rhs, magic_colon, rj); }
--- a/src/tc-extras.cc Mon Oct 04 00:40:57 1993 +0000 +++ b/src/tc-extras.cc Mon Oct 04 02:36:58 1993 +0000 @@ -104,7 +104,7 @@ nc = a.columns (); } - check_dimensions (nr, nc, warn_for); // No return on error. + check_dimensions (nr, nc, warn_for); // May set error_state. } static void @@ -119,20 +119,20 @@ nr = NINT (tmpa.double_value ()); nc = NINT (tmpb.double_value ()); - check_dimensions (nr, nc, warn_for); // No return on error. + check_dimensions (nr, nc, warn_for); // May set error_state. } else - { - error ("%s: expecting two scalar arguments", warn_for); - jump_to_top_level (); - } + error ("%s: expecting two scalar arguments", warn_for); } tree_constant fill_matrix (tree_constant& a, double val, char *warn_for) { int nr, nc; - get_dimensions (a, warn_for, nr, nc); // No return on error. + get_dimensions (a, warn_for, nr, nc); + + if (error_state) + return tree_constant (); Matrix m (nr, nc, val); @@ -143,7 +143,10 @@ fill_matrix (tree_constant& a, tree_constant& b, double val, char *warn_for) { int nr, nc; - get_dimensions (a, b, warn_for, nr, nc); // No return on error. + get_dimensions (a, b, warn_for, nr, nc); // May set error_state. + + if (error_state) + return tree_constant (); Matrix m (nr, nc, val); @@ -154,7 +157,10 @@ identity_matrix (tree_constant& a) { int nr, nc; - get_dimensions (a, "eye", nr, nc); // No return on error. + get_dimensions (a, "eye", nr, nc); // May set error_state. + + if (error_state) + return tree_constant (); Matrix m (nr, nc, 0.0); @@ -172,7 +178,10 @@ identity_matrix (tree_constant& a, tree_constant& b) { int nr, nc; - get_dimensions (a, b, "eye", nr, nc); // No return on error. + get_dimensions (a, b, "eye", nr, nc); // May set error_state. + + if (error_state) + return tree_constant (); Matrix m (nr, nc, 0.0);
--- a/src/tc-index.cc Mon Oct 04 00:40:57 1993 +0000 +++ b/src/tc-index.cc Mon Oct 04 02:36:58 1993 +0000 @@ -47,8 +47,6 @@ tree_constant tree_constant_rep::do_scalar_index (tree_constant *args, int nargs) { - tree_constant retval; - if (valid_scalar_indices (args, nargs)) { if (type_tag == scalar_constant) @@ -133,15 +131,13 @@ break; default: error ("illegal number of arguments for scalar type"); - jump_to_top_level (); + return tree_constant (); break; } } error ("index invalid or out of range for scalar type"); - jump_to_top_level (); - - return retval; + return tree_constant (); } tree_constant @@ -215,8 +211,10 @@ int i = NINT (tmp_i.double_value ()); int ii = fortran_row (i, nr) - 1; int jj = fortran_column (i, nr) - 1; - index_check (i-1, ""); - range_max_check (i-1, nr * nc); + if (index_check (i-1, "") < 0) + return tree_constant (); + if (range_max_check (i-1, nr * nc) < 0) + return tree_constant (); retval = do_matrix_index (ii, jj); } break; @@ -238,11 +236,9 @@ break; case string_constant: gripe_string_invalid (); - jump_to_top_level (); break; case range_constant: gripe_range_invalid (); - jump_to_top_level (); break; case magic_colon: retval = do_matrix_index (magic_colon); @@ -334,7 +330,7 @@ error ("empty matrix invalid as index"); else error ("invalid matrix index"); - jump_to_top_level (); + return tree_constant (); } return retval; @@ -364,15 +360,18 @@ case scalar_constant: { int i = tree_to_mat_idx (tmp_i.double_value ()); - index_check (i, ""); + if (index_check (i, "") < 0) + return tree_constant (); if (swap_indices) { - range_max_check (i, nc); + if (range_max_check (i, nc) < 0) + return tree_constant (); retval = do_matrix_index (0, i); } else { - range_max_check (i, nr); + if (range_max_check (i, nr) < 0) + return tree_constant (); retval = do_matrix_index (i, 0); } } @@ -392,12 +391,14 @@ int imax = iv.max (); if (swap_indices) { - range_max_check (imax, nc); + if (range_max_check (imax, nc) < 0) + return tree_constant (); retval = do_matrix_index (0, iv); } else { - range_max_check (imax, nr); + if (range_max_check (imax, nr) < 0) + return tree_constant (); retval = do_matrix_index (iv, 0); } } @@ -419,15 +420,18 @@ else { int imax; - index_check (ri, imax, ""); + if (index_check (ri, imax, "") < 0) + return tree_constant (); if (swap_indices) { - range_max_check (imax, nc); + if (range_max_check (imax, nc) < 0) + return tree_constant (); retval = do_matrix_index (0, ri); } else { - range_max_check (imax, nr); + if (range_max_check (imax, nr) < 0) + return tree_constant (); retval = do_matrix_index (ri, 0); } } @@ -462,7 +466,8 @@ case scalar_constant: { int i = tree_to_mat_idx (tmp_i.double_value ()); - index_check (i, "row"); + if (index_check (i, "row") < 0) + return tree_constant (); retval = do_matrix_index (i, j_arg); } break; @@ -493,7 +498,8 @@ else { int imax; - index_check (ri, imax, "row"); + if (index_check (ri, imax, "row") < 0) + return tree_constant (); retval = do_matrix_index (ri, imax, j_arg); } } @@ -527,8 +533,10 @@ case scalar_constant: { int j = tree_to_mat_idx (tmp_j.double_value ()); - index_check (j, "column"); - range_max_check (i, j, nr, nc); + if (index_check (j, "column") < 0) + return tree_constant (); + if (range_max_check (i, j, nr, nc) < 0) + return tree_constant (); retval = do_matrix_index (i, j); } break; @@ -544,7 +552,8 @@ } else { - range_max_check (i, jv.max (), nr, nc); + if (range_max_check (i, jv.max (), nr, nc) < 0) + return tree_constant (); retval = do_matrix_index (i, jv); } } @@ -562,14 +571,17 @@ else { int jmax; - index_check (rj, jmax, "column"); - range_max_check (i, jmax, nr, nc); + if (index_check (rj, jmax, "column") < 0) + return tree_constant (); + if (range_max_check (i, jmax, nr, nc) < 0) + return tree_constant (); retval = do_matrix_index (i, rj); } } break; case magic_colon: - range_max_check (i, 0, nr, nc); + if (range_max_check (i, 0, nr, nc) < 0) + return tree_constant (); retval = do_matrix_index (i, magic_colon); break; default: @@ -598,8 +610,10 @@ case scalar_constant: { int j = tree_to_mat_idx (tmp_j.double_value ()); - index_check (j, "column"); - range_max_check (iv.max (), j, nr, nc); + if (index_check (j, "column") < 0) + return tree_constant (); + if (range_max_check (iv.max (), j, nr, nc) < 0) + return tree_constant (); retval = do_matrix_index (iv, j); } break; @@ -615,7 +629,8 @@ } else { - range_max_check (iv.max (), jv.max (), nr, nc); + if (range_max_check (iv.max (), jv.max (), nr, nc) < 0) + return tree_constant (); retval = do_matrix_index (iv, jv); } } @@ -633,14 +648,17 @@ else { int jmax; - index_check (rj, jmax, "column"); - range_max_check (iv.max (), jmax, nr, nc); + if (index_check (rj, jmax, "column") < 0) + return tree_constant (); + if (range_max_check (iv.max (), jmax, nr, nc) < 0) + return tree_constant (); retval = do_matrix_index (iv, rj); } } break; case magic_colon: - range_max_check (iv.max (), 0, nr, nc); + if (range_max_check (iv.max (), 0, nr, nc) < 0) + return tree_constant (); retval = do_matrix_index (iv, magic_colon); break; default: @@ -669,8 +687,10 @@ case scalar_constant: { int j = tree_to_mat_idx (tmp_j.double_value ()); - index_check (j, "column"); - range_max_check (imax, j, nr, nc); + if (index_check (j, "column") < 0) + return tree_constant (); + if (range_max_check (imax, j, nr, nc) < 0) + return tree_constant (); retval = do_matrix_index (ri, j); } break; @@ -686,7 +706,8 @@ } else { - range_max_check (imax, jv.max (), nr, nc); + if (range_max_check (imax, jv.max (), nr, nc) < 0) + return tree_constant (); retval = do_matrix_index (ri, jv); } } @@ -704,8 +725,10 @@ else { int jmax; - index_check (rj, jmax, "column"); - range_max_check (imax, jmax, nr, nc); + if (index_check (rj, jmax, "column") < 0) + return tree_constant (); + if (range_max_check (imax, jmax, nr, nc) < 0) + return tree_constant (); retval = do_matrix_index (ri, rj); } } @@ -740,8 +763,10 @@ case scalar_constant: { int j = tree_to_mat_idx (tmp_j.double_value ()); - index_check (j, "column"); - range_max_check (0, j, nr, nc); + if (index_check (j, "column") < 0) + return tree_constant (); + if (range_max_check (0, j, nr, nc) < 0) + return tree_constant (); retval = do_matrix_index (magic_colon, j); } break; @@ -757,7 +782,8 @@ } else { - range_max_check (0, jv.max (), nr, nc); + if (range_max_check (0, jv.max (), nr, nc) < 0) + return tree_constant (); retval = do_matrix_index (magic_colon, jv); } } @@ -775,8 +801,10 @@ else { int jmax; - index_check (rj, jmax, "column"); - range_max_check (0, jmax, nr, nc); + if (index_check (rj, jmax, "column") < 0) + return tree_constant (); + if (range_max_check (0, jmax, nr, nc) < 0) + return tree_constant (); retval = do_matrix_index (magic_colon, rj); } }
--- a/src/tc-inlines.h Mon Oct 04 00:40:57 1993 +0000 +++ b/src/tc-inlines.h Mon Oct 04 02:36:58 1993 +0000 @@ -39,28 +39,31 @@ if (i > imax) { error ("matrix index = %d exceeds maximum dimension = %d", i, imax); - jump_to_top_level (); + return -1; } + return 0; } static inline int range_max_check (int i, int j, int nr, int nc) { + int status = 0; i++; if (i > nr) { error ("matrix row index = %d exceeds maximum row dimension = %d", i, nr); - jump_to_top_level (); + status = -1; } j++; if (j > nc) { error ("matrix column index = %d exceeds maximum column dimension = %d", - j, nc); - jump_to_top_level (); + j, nc); + status = -1; } + return status; } static inline int @@ -77,43 +80,46 @@ return (NINT (b) == 0 && NINT (l) == 1 && r.nelem () == 2); } -static inline void +static inline int index_check (int i, char *rc) { if (i < 0) { error ("invalid %s index = %d", rc, i+1); - jump_to_top_level (); + return -1; } + return 0; } -static inline void +static inline int index_check (const Range& r, int& max_val, char *rc) { - double b = r.base (); - int ib = tree_to_mat_idx (b); - if (r.nelem () < 1) { error ("range invalid as %s index", rc); - jump_to_top_level (); + return -1; } + double b = r.base (); + int ib = tree_to_mat_idx (b); + if (ib < 0) { error ("invalid %s index = %d", rc, ib+1); - jump_to_top_level (); + return -1; } double lim = r.limit (); max_val = tree_to_mat_idx (lim); + + return 0; } -static inline void +static inline int index_check (const Range& r, char *rc) { int max_val; - index_check (r, max_val, rc); + return index_check (r, max_val, rc); } static inline int
--- a/src/tree.h.old Mon Oct 04 00:40:57 1993 +0000 +++ b/src/tree.h.old Mon Oct 04 02:36:58 1993 +0000 @@ -175,8 +175,8 @@ friend class tree_index_expression; public: - tree_identifier (void); - tree_identifier (symbol_record *s); + tree_identifier (int l = -1, int c = -1); + tree_identifier (symbol_record *s, int l = -1, int c = -1); ~tree_identifier (void); @@ -240,6 +240,9 @@ char *m_file_name (void); time_t time_parsed (void); + void stash_function_name (char *s); + char *function_name (void); + tree_constant eval (int print); tree_constant *eval (int print, int nargout); @@ -250,14 +253,17 @@ int max_expected_args (void); + void traceback_error (void); + private: int call_depth; tree_parameter_list *param_list; tree_parameter_list *ret_list; symbol_table *sym_tab; tree *cmd_list; + char *file_name; + char *fcn_name; time_t t_parsed; - char *file_name; }; /* @@ -284,13 +290,16 @@ tree_prefix_expression : public tree_expression { public: - tree_prefix_expression (void); - tree_prefix_expression (tree_identifier *t, tree::expression_type et); + tree_prefix_expression (int l = -1, int c = -1); + tree_prefix_expression (tree_identifier *t, tree::expression_type et, + int l = -1, int c = -1); ~tree_prefix_expression (void); tree_constant eval (int print); + void eval_error (void); + private: tree_identifier *id; }; @@ -302,13 +311,16 @@ tree_postfix_expression : public tree_expression { public: - tree_postfix_expression (void); - tree_postfix_expression (tree_identifier *t, tree::expression_type et); + tree_postfix_expression (int l = -1, int c = -1); + tree_postfix_expression (tree_identifier *t, tree::expression_type et, + int l = -1, int c = -1); ~tree_postfix_expression (void); tree_constant eval (int print); + void eval_error (void); + private: tree_identifier *id; }; @@ -320,13 +332,16 @@ tree_unary_expression : public tree_expression { public: - tree_unary_expression (void); - tree_unary_expression (tree *a, tree::expression_type t); + tree_unary_expression (int l = -1, int c = -1); + tree_unary_expression (tree *a, tree::expression_type t, int l = -1, + int c = -1); ~tree_unary_expression (void); tree_constant eval (int print); + void eval_error (void); + private: tree *op; }; @@ -338,13 +353,16 @@ tree_binary_expression : public tree_expression { public: - tree_binary_expression (void); - tree_binary_expression (tree *a, tree *b, tree::expression_type t); + tree_binary_expression (int l = -1, int c = -1); + tree_binary_expression (tree *a, tree *b, tree::expression_type t, + int l = -1, int c = -1); ~tree_binary_expression (void); tree_constant eval (int print); + void eval_error (void); + private: tree *op1; tree *op2; @@ -375,14 +393,18 @@ tree_simple_assignment_expression : public tree_assignment_expression { public: - tree_simple_assignment_expression (void); - tree_simple_assignment_expression (tree_identifier *i, tree *r); - tree_simple_assignment_expression (tree_index_expression *idx_expr, tree *r); + tree_simple_assignment_expression (int l = -1, int c = -1); + tree_simple_assignment_expression (tree_identifier *i, tree *r, + int l = -1, int c = -1); + tree_simple_assignment_expression (tree_index_expression *idx_expr, + tree *r, int l = -1, int c = -1); ~tree_simple_assignment_expression (void); tree_constant eval (int print); + void eval_error (void); + private: tree_identifier *lhs; tree_argument_list *index; @@ -396,8 +418,9 @@ tree_multi_assignment_expression : public tree_assignment_expression { public: - tree_multi_assignment_expression (void); - tree_multi_assignment_expression (tree_return_list *l, tree *r); + tree_multi_assignment_expression (int l = -1, int c = -1); + tree_multi_assignment_expression (tree_return_list *lst, tree *r, + int l = -1, int c = -1); ~tree_multi_assignment_expression (void); @@ -405,6 +428,8 @@ tree_constant *eval (int print, int nargout); + void eval_error (void); + private: tree_return_list *lhs; tree *rhs; @@ -417,8 +442,8 @@ tree_colon_expression : public tree_expression { public: - tree_colon_expression (void); - tree_colon_expression (tree *a, tree *b); + tree_colon_expression (int l = -1, int c = -1); + tree_colon_expression (tree *a, tree *b, int l = -1, int c = -1); ~tree_colon_expression (void); @@ -426,6 +451,8 @@ tree_constant eval (int print); + void eval_error (const char *s); + private: tree *op1; tree *op2; @@ -439,9 +466,10 @@ tree_index_expression : public tree_expression { public: - tree_index_expression (void); - tree_index_expression (tree_identifier *i); - tree_index_expression (tree_identifier *i, tree_argument_list *l); + tree_index_expression (int l = -1, int c = -1); + tree_index_expression (tree_identifier *i, int l = -1, int c = -1); + tree_index_expression (tree_identifier *i, tree_argument_list *lst, + int l = -1, int c = -1); ~tree_index_expression (void); @@ -455,6 +483,8 @@ tree_constant *eval (int print, int nargout); + void eval_error (void); + private: tree_identifier *id; tree_argument_list *list; @@ -619,7 +649,7 @@ public: tree_while_command (void); tree_while_command (tree *e); - tree_while_command (tree *e, tree *l); + tree_while_command (tree *e, tree *lst); ~tree_while_command (void); @@ -638,7 +668,7 @@ { public: tree_for_command (void); - tree_for_command (tree_index_expression *id, tree *e, tree *l); + tree_for_command (tree_index_expression *id, tree *e, tree *lst); ~tree_for_command (void);
--- a/src/utils.cc Mon Oct 04 00:40:57 1993 +0000 +++ b/src/utils.cc Mon Oct 04 02:36:58 1993 +0000 @@ -190,10 +190,8 @@ if (user_pref.treat_neg_dim_as_zero) nr = nc = 0; else - { - message (warnfor, "can't create a matrix with negative dimensions"); - jump_to_top_level (); - } + error ("%s: can't create a matrix with negative dimensions", + warnfor); } }