Static Stmt *proc_fwritebytes()
{
Expr *ex, *ex2, *vex, *fex;
Type *type;
if (!skipopenparen())
return NULL;
fex = p_expr(tp_text);
if (!skipcomma())
return NULL;
vex = p_expr(NULL);
if (!skipcomma())
return NULL;
ex2 = p_expr(tp_integer);
skipcloseparen();
type = vex->val.type;
ex = makeexpr_bicall_4("fwrite", tp_integer,
makeexpr_addr(vex),
convert_size(type, ex2, "FWRITEBYTES"),
makeexpr_long(1),
filebasename(copyexpr(fex)));
if (checkfilewrite) {
ex = makeexpr_bicall_2(name_SETIO, tp_void,
makeexpr_rel(EK_EQ, ex, makeexpr_long(1)),
makeexpr_long(3));
}
return wrapopencheck(makestmt_call(ex), fex);
}
static void
orderexpr(Node **np, NodeList **out)
{
Node *n;
int lno;
n = *np;
if(n == N)
return;
lno = setlineno(n);
orderinit(n, out);
switch(n->op) {
default:
orderexpr(&n->left, out);
orderexpr(&n->right, out);
orderexprlist(n->list, out);
orderexprlist(n->rlist, out);
break;
case OANDAND:
case OOROR:
orderexpr(&n->left, out);
orderexprinplace(&n->right);
break;
case OCALLFUNC:
case OCALLMETH:
case OCALLINTER:
ordercall(n, out);
n = copyexpr(n, n->type, out);
break;
case ORECV:
n = copyexpr(n, n->type, out);
break;
}
lineno = lno;
*np = n;
}
/************************************************************************
* solveeqs solves the equations in canoneqf *
* in the variables canonvars, writing the answers in outfile *
* With new solprint, it also enter their values in numsols *
* (new, April 14, 2001), which must be created and sized before *
* entering here. It also now makes a working copy of canoneqf, *
* to present to checkeqs, which will destroy it, so as to *
* preserve the original for checksol *
* After giving all the solutions, it lists, if any, *
* <PARTSLVV> followed by linear equations not solved numerically. *
* <UNSLVEQS> followed by equations not solved and not linear *
* <UNSLVVARS> followed by variables used in equations but not *
* solved for *
* <UNUSEDVARS> followed by variables not used in any equation *
* (and therefore not solved for) *
* returns true if there are no UNSLVEQS or UNSLVVARSQ *
************************************************************************/
bool solveeqs(ostream & outfile){
int k;
bool isokay = true;
vector<varindx> *vars = new vector<varindx>;
vector<binopexp *> * eqn = new vector<binopexp *>(canoneqf->size(),
(binopexp *)NULL);
expr * eqexpr;
expr * dimtroub;
for (k = 0; k < canoneqf->size(); k++) {
eqexpr = copyexpr((*canoneqf)[k]);
eqnumsimp(eqexpr,true);
dimtroub = dimenchk(true,eqexpr);
if (dimtroub != (expr *)NULL) {
DBG( cout << "Dimenchk trouble on equation " << eqexpr->getInfix()
<< ", trouble at " << endl;
dimtroub->dbgprint(4); );
throw(string("dimensional inconsistency in input equation ")
+ eqexpr->getInfix()); // AW: show bad eqn in msg
}
/************************************************************************
* int checksol(eqn,sols,reltverr) *
* plugs the solution values in sols into the equation eqn. *
* compares descrepancy with expection using relative err reltverr *
* returns *
* 0 if seems within error bars *
* 1 if within 100 * error bars *
* 2 if not within 100 * error bars *
* 3 floating point error (really, really not ok) *
* NOTE: currently the error bar calculation has faults *
************************************************************************/
int checksol(const binopexp* const eqn, const vector<double>* const sols,
const double reltverr) {
DBG(cout << "entered checksol" << endl);
#ifdef WITHDBG // for debugging
recall=0;
#endif
answitherr* value;
expr* eqexpr = copyexpr(eqn); // g++ refused this without copyexpr
try {
value = evalexpr(eqexpr, sols, reltverr);
}
catch (string &err) {
// don't delete value, it has never been assigned.
eqexpr->destroy();
DBG(cout << " ERROR " << err << endl);
if(FPE_handler==err.substr(0,FPE_handler.length())) //if beginning matches
return(3);
else {
throw(err);
}
}
eqexpr->destroy();
DBGM(cout << "Eqn " << eqn->getInfix() <<
" balenced with discrepancy " << value->value
<< " and absolute error " << value->abserr << endl);
if ((fabs(value->value) <= value->abserr)) {
DBG(cout << " seems OK" << endl);
delete value;
return(0);
} else if ((fabs(value->value) <= 100 * value->abserr)) {
DBG(cout << " NOT REALLY OK" << endl);
delete value;
return(1);
} else {
DBG(cout << " seems VERY NOT OK on" << endl; cout << eqn->getInfix()
<< endl);
delete value;
return(2);
}
}
