VTYPE term_() {
VTYPE v = factor_();
VTYPE tmp;
while(error_() == 0) {
switch(ch_) {
case ' ':
case '\t':
ch_ = *tx_++;
break;
case '*':
ch_ = *tx_++;
v *= factor_();
break;
case '%':
ch_ = *tx_++;
tmp = factor_();
if(tmp == 0) {
error_.set(error::zero_divide);
break;
}
v /= tmp;
break;
case '/':
ch_ = *tx_++;
if(ch_ == '/') {
ch_ = *tx_++;
tmp = factor_();
if(tmp == 0) {
error_.set(error::zero_divide);
break;
}
v %= tmp;
} else {
tmp = factor_();
if(tmp == 0) {
error_.set(error::zero_divide);
break;
}
v /= tmp;
}
break;
case '<':
ch_ = *tx_++;
if(ch_ == '<') {
ch_ = *tx_++;
v <<= factor_();
} else {
error_.set(error::fatal);
}
break;
case '>':
ch_ = *tx_++;
if(ch_ == '>') {
ch_ = *tx_++;
v <<= factor_();
} else {
error_.set(error::fatal);
}
break;
default:
return v;
break;
}
}
return v;
}
VTYPE number_() {
bool inv = false;
/// bool neg = false;
bool point = false;
uint32_t v = 0;
uint32_t fp = 0;
uint32_t fs = 1;
skip_space_();
// 符号、反転の判定
if(ch_ == '-') {
inv = true;
ch_ = *tx_++;
} else if(ch_ == '+') {
ch_ = *tx_++;
// } else if(ch_ == '!' || ch_ == '~') {
// neg = true;
// ch_ = *tx_++;
}
skip_space_();
if(ch_ == '(') {
v = factor_();
} else {
skip_space_();
if((ch_ >= 'A' && ch_ <= 'Z') || (ch_ >= 'a' && ch_ <= 'z')) {
const char* src = tx_ - 1;
while(ch_ != 0) {
ch_ = *tx_++;
if((ch_ >= 'A' && ch_ <= 'Z') || (ch_ >= 'a' && ch_ <= 'z')) ;
else if(ch_ >= '0' && ch_ <= '9') ;
else if(ch_ == '_') ;
else break;
}
if(!symbol_.find(src, tx_ - src)) {
error_.set(error::symbol_fatal);
return 0;
}
v = symbol_.get(src, tx_ - src);
} else {
while(ch_ != 0) {
if(ch_ == '+') break;
else if(ch_ == '-') break;
else if(ch_ == '*') break;
else if(ch_ == '/') break;
else if(ch_ == '&') break;
else if(ch_ == '^') break;
else if(ch_ == '|') break;
else if(ch_ == '%') break;
else if(ch_ == ')') break;
else if(ch_ == '<') break;
else if(ch_ == '>') break;
else if(ch_ == '!') break;
else if(ch_ == '~') break;
else if(ch_ == '.') {
if(point) {
error_.set(error::fatal);
break;
} else {
point = true;
}
} else if(ch_ >= '0' && ch_ <= '9') {
if(point) {
fp *= 10;
fp += ch_ - '0';
fs *= 10;
} else {
v *= 10;
v += ch_ - '0';
}
} else {
error_.set(error::number_fatal);
return 0;
}
ch_ = *tx_++;
}
}
}
if(inv) { v = -v; }
/// if(neg) { v = ~v; }
if(point) {
return static_cast<VTYPE>(v) + static_cast<VTYPE>(fp) / static_cast<VTYPE>(fs);
} else {
return static_cast<VTYPE>(v);
}
}
VTYPE number_() {
bool inv = false;
/// bool neg = false;
bool point = false;
uint32_t v = 0;
uint32_t fp = 0;
uint32_t fs = 1;
skip_space_();
// 符号、反転の判定
if(ch_ == '-') {
inv = true;
ch_ = *tx_++;
} else if(ch_ == '+') {
ch_ = *tx_++;
// } else if(ch_ == '!' || ch_ == '~') {
// neg = true;
// ch_ = *tx_++;
}
skip_space_();
if(ch_ == '(') {
v = factor_();
} else {
skip_space_();
// if(ch_ >= 'A' && ch_ <= 'Z') symbol = true;
// else if(ch_ >= 'a' && ch_ <= 'z') symbol = true;
// else if(ch_ == '_' || ch_ == '?') symbol = true;
while(ch_ != 0) {
if(ch_ == '+') break;
else if(ch_ == '-') break;
else if(ch_ == '*') break;
else if(ch_ == '/') break;
else if(ch_ == '&') break;
else if(ch_ == '^') break;
else if(ch_ == '|') break;
else if(ch_ == '%') break;
else if(ch_ == ')') break;
else if(ch_ == '<') break;
else if(ch_ == '>') break;
else if(ch_ == '!') break;
else if(ch_ == '~') break;
else if(ch_ == '.') {
if(point) {
error_.set(error::fatal);
break;
} else {
point = true;
}
} else if(ch_ >= '0' && ch_ <= '9') {
if(point) {
fp *= 10;
fp += ch_ - '0';
fs *= 10;
} else {
v *= 10;
v += ch_ - '0';
}
}
ch_ = *tx_++;
}
#if 0
if(symbol) {
symbol_map_cit cit = symbol_.find(sym);
if(cit != symbol_.end()) {
v = (*cit).second;
} else {
error_.set(error::symbol_fatal);
}
}
#endif
}
if(inv) { v = -v; }
/// if(neg) { v = ~v; }
if(point) {
return static_cast<VTYPE>(v) + static_cast<VTYPE>(fp) / static_cast<VTYPE>(fs);
} else {
return static_cast<VTYPE>(v);
}
}
/* See http://pdp-10.trailing-edge.com/red405a2/11/uetp/lib/467.for */
/* Subroutine */ int dxpose_(doublereal *a, integer *n1, integer *n2, integer
*n12, logical *moved, integer *nwork)
{
/* System generated locals */
integer i__1, i__2, i__3;
/* Local variables */
static integer i__, m, n, i1, i2, ip, ia1, ia2, idiv, iexp[8], nexp[8],
mmia1, mmia2, i1min, i1max, ifact[8];
static doublereal atemp, btemp;
static integer isoid, itest, mmist;
extern /* Subroutine */ int factor_(integer *, integer *, integer *,
integer *, integer *);
static integer ipower[8], ncount, istart, npower;
/* TRANSPOSITION OF A RECTANGULAR MATRIX IN SITU. */
/* BY NORMAN BRENNER, MIT, 1/72. CF. ALG. 380, CACM, 5/70. */
/* TRANSPOSITION OF THE N1 BY N2 MATRIX A AMOUNTS TO */
/* REPLACING THE ELEMENT AT VECTOR POSITION I (0-ORIGIN) */
/* WITH THE ELEMENT AT POSITION N1*I (MOD N1*N2-I). */
/* EACH SUBCYCLE OF THIS PERMUTATION IS COMPLETED IN ORDER. */
/* MOVED IS A LOGICAL WORK ARRAY OF LENGTH NWORK. */
/* REALLY A(N1,N2), BUT N12 = N1*N2 */
/* Parameter adjustments */
--a;
--moved;
/* Function Body */
if (*n1 < 2 || *n2 < 2) {
return 0;
}
n = *n1;
m = *n1 * *n2 - 1;
if (*n1 != *n2) {
goto L30;
}
/* SQUARE MATRICES ARE DONE SEPARATELY FOR SPEED */
i1min = 2;
i__1 = m;
i__2 = n;
for (i1max = n; i__2 < 0 ? i1max >= i__1 : i1max <= i__1; i1max += i__2) {
i2 = i1min + n - 1;
i__3 = i1max;
for (i1 = i1min; i1 <= i__3; ++i1) {
atemp = a[i1];
a[i1] = a[i2];
a[i2] = atemp;
i2 += n;
/* L10: */
}
i1min = i1min + n + 1;
/* L20: */
}
return 0;
/* MODULUS M IS FACTORED INTO PRIME POWERS. EIGHT FACTORS */
/* SUFFICE UP TO M = 2*3*5*7*11*13*17*19 = 9,767,520. */
L30:
factor_(&m, ifact, ipower, nexp, &npower);
i__2 = npower;
for (ip = 1; ip <= i__2; ++ip) {
iexp[ip - 1] = 0;
/* L40: */
}
/* GENERATE EVERY DIVISOR OF M LESS THAN M/2 */
idiv = 1;
L50:
if (idiv >= m / 2) {
goto L190;
}
/* THE NUMBER OF ELEMENTS WHOSE INDEX IS DIVISIBLE BY IDIV */
/* AND BY NO OTHER DIVISOR OF M IS THE EULER TOTIENT */
/* FUNCTION, PHI(M/IDIV). */
ncount = m / idiv;
i__2 = npower;
for (ip = 1; ip <= i__2; ++ip) {
if (iexp[ip - 1] == nexp[ip - 1]) {
goto L60;
}
ncount = ncount / ifact[ip - 1] * (ifact[ip - 1] - 1);
L60:
;
}
i__2 = *nwork;
for (i__ = 1; i__ <= i__2; ++i__) {
moved[i__] = FALSE_;
/* L70: */
}
/* THE STARTING POINT OF A SUBCYCLE IS DIVISIBLE ONLY BY IDIV */
/* AND MUST NOT APPEAR IN ANY OTHER SUBCYCLE. */
istart = idiv;
L80:
mmist = m - istart;
if (istart == idiv) {
goto L120;
}
if (istart > *nwork) {
goto L90;
}
if (moved[istart]) {
goto L160;
}
L90:
isoid = istart / idiv;
i__2 = npower;
for (ip = 1; ip <= i__2; ++ip) {
if (iexp[ip - 1] == nexp[ip - 1]) {
goto L100;
}
if (isoid % ifact[ip - 1] == 0) {
goto L160;
}
L100:
;
}
if (istart <= *nwork) {
goto L120;
}
itest = istart;
L110:
itest = n * itest % m;
if (itest < istart || itest > mmist) {
goto L160;
}
if (itest > istart && itest < mmist) {
goto L110;
}
L120:
atemp = a[istart + 1];
btemp = a[mmist + i__];
ia1 = istart;
L130:
ia2 = n * ia1 % m;
mmia1 = m - ia1;
mmia2 = m - ia2;
if (ia1 <= *nwork) {
moved[ia1] = TRUE_;
}
if (mmia1 <= *nwork) {
moved[mmia1] = TRUE_;
}
ncount += -2;
/* MOVE TWO ELEMENTS, THE SECOND FROM THE NEGATIVE */
/* SUBCYCLE. CHECK FIRST FOR SUBCYCLE CLOSURE. */
if (ia2 == istart) {
goto L140;
}
if (mmia2 == istart) {
goto L150;
}
a[ia1 + 1] = a[ia2 + 1];
a[mmia1 + 1] = a[mmia2 + 1];
ia1 = ia2;
goto L130;
L140:
a[ia1 + 1] = atemp;
a[mmia1 + 1] = btemp;
goto L160;
L150:
a[ia1 + 1] = btemp;
a[mmia1 + 1] = atemp;
L160:
istart += idiv;
if (ncount > 0) {
goto L80;
}
i__2 = npower;
for (ip = 1; ip <= i__2; ++ip) {
if (iexp[ip - 1] == nexp[ip - 1]) {
goto L170;
}
++iexp[ip - 1];
idiv *= ifact[ip - 1];
goto L50;
L170:
iexp[ip - 1] = 0;
idiv /= ipower[ip - 1];
/* L180: */
}
L190:
return 0;
} /* dxpose_ */
bool factor()
{
return factor_();
}
