/*
* Save an array subscript - returns true if matching bracket found, false
* if eof or newline was found.
* (Returned string double null terminated)
*/
static int
arraysub(char **strp)
{
XString ws;
char *wp;
char c;
int depth = 1; /* we are just past the initial [ */
Xinit(ws, wp, 32, ATEMP);
do {
c = getsc();
Xcheck(ws, wp);
*wp++ = c;
if (c == '[')
depth++;
else if (c == ']')
depth--;
} while (depth > 0 && c && c != '\n');
*wp++ = '\0';
*strp = Xclose(ws, wp);
return depth == 0 ? 1 : 0;
}
/*
* Save an array subscript - returns true if matching bracket found, false
* if eof or newline was found.
* (Returned string double null terminated)
*/
static bool
arraysub(char **strp)
{
XString ws;
char *wp, c;
/* we are just past the initial [ */
unsigned int depth = 1;
Xinit(ws, wp, 32, ATEMP);
do {
c = getsc();
Xcheck(ws, wp);
*wp++ = c;
if (c == '[')
depth++;
else if (c == ']')
depth--;
} while (depth > 0 && c && c != '\n');
*wp++ = '\0';
*strp = Xclose(ws, wp);
return (tobool(depth == 0));
}
void MessageErreur(char message[])
{
XEvent avrtEvent;
Arg args[2];
XmString label;
Xinit("xrec");
if (errorWidget == NULL)
{
errorWidget = (Widget) CreateErrorDialog(SuperWidget.topLevel);
}
label = XmStringCreateLtoR(message, XmSTRING_DEFAULT_CHARSET);
XtSetArg(args[0], XmNmessageString, label);
XtSetValues(errorWidget, args, 1);
widgetCourant = errorWidget;
XmStringFree(label);
XtManageChild(errorWidget);
FlusherTousLesEvenements();
avrtSelectionTerminee = False;
while (0 == 0)
{
XtAppNextEvent(SuperWidget.contexte, &(avrtEvent));
XtDispatchEvent(&(avrtEvent));
}
}
static void
readhere(struct ioword *iop)
{
int c;
char *volatile eof;
char *eofp;
int skiptabs;
XString xs;
char *xp;
int xpos;
eof = evalstr(iop->delim, 0);
if (!(iop->flag & IOEVAL))
ignore_backslash_newline++;
Xinit(xs, xp, 256, ATEMP);
for (;;) {
eofp = eof;
skiptabs = iop->flag & IOSKIP;
xpos = Xsavepos(xs, xp);
while ((c = getsc()) != 0) {
if (skiptabs) {
if (c == '\t')
continue;
skiptabs = 0;
}
if (c != *eofp)
break;
Xcheck(xs, xp);
Xput(xs, xp, c);
eofp++;
}
/* Allow EOF here so commands with out trailing newlines
* will work (eg, ksh -c '...', $(...), etc).
*/
if (*eofp == '\0' && (c == 0 || c == '\n')) {
xp = Xrestpos(xs, xp, xpos);
break;
}
ungetsc(c);
while ((c = getsc()) != '\n') {
if (c == 0)
yyerror("here document `%s' unclosed\n", eof);
Xcheck(xs, xp);
Xput(xs, xp, c);
}
Xcheck(xs, xp);
Xput(xs, xp, c);
}
Xput(xs, xp, '\0');
iop->heredoc = Xclose(xs, xp);
if (!(iop->flag & IOEVAL))
ignore_backslash_newline--;
}
/*
* search for command with PATH
*/
const char *
search_path(const char *name, const char *lpath,
/* R_OK or X_OK */
int mode,
/* set if candidate found, but not suitable */
int *errnop)
{
const char *sp, *p;
char *xp;
XString xs;
size_t namelen;
int ec = 0, ev;
if (vstrchr(name, '/')) {
if ((ec = search_access(name, mode)) == 0) {
search_path_ok:
if (errnop)
*errnop = 0;
return (name);
}
goto search_path_err;
}
namelen = strlen(name) + 1;
Xinit(xs, xp, 128, ATEMP);
sp = lpath;
while (sp != NULL) {
xp = Xstring(xs, xp);
if (!(p = cstrchr(sp, ':')))
p = sp + strlen(sp);
if (p != sp) {
XcheckN(xs, xp, p - sp);
memcpy(xp, sp, p - sp);
xp += p - sp;
*xp++ = '/';
}
sp = p;
XcheckN(xs, xp, namelen);
memcpy(xp, name, namelen);
if ((ev = search_access(Xstring(xs, xp), mode)) == 0) {
name = Xclose(xs, xp + namelen);
goto search_path_ok;
}
/* accumulate non-ENOENT errors only */
if (ev != ENOENT && ec == 0)
ec = ev;
if (*sp++ == '\0')
sp = NULL;
}
Xfree(xs, xp);
search_path_err:
if (errnop)
*errnop = ec ? ec : ENOENT;
return (NULL);
}
int f77name(xinit)(char nomApplication[], F2Cl flenNomApplication)
{
char copieNomApplication[256];
int lenNomApplication=flenNomApplication;
strncpy(copieNomApplication, nomApplication, lenNomApplication);
copieNomApplication[lenNomApplication] = '\0';
Xinit(copieNomApplication);
}
char *
get_phys_path(const char *path)
{
XString xs;
char *xp;
Xinit(xs, xp, strlen(path) + 1, ATEMP);
xp = do_phys_path(&xs, xp, path);
if (!xp)
return ((char *) 0);
if (Xlength(xs, xp) == 0)
Xput(xs, xp, '/');
Xput(xs, xp, '\0');
return (Xclose(xs, xp));
}
Source *
pushs(int type, Area *areap)
{
Source *s;
s = (Source *) alloc(sizeof(Source), areap);
s->type = type;
s->str = null;
s->start = NULL;
s->line = 0;
s->errline = 0;
s->file = NULL;
s->flags = 0;
s->next = NULL;
s->areap = areap;
if (type == SFILE || type == SSTDIN) {
char *dummy;
Xinit(s->xs, dummy, 256, s->areap);
} else
memset(&s->xs, 0, sizeof(s->xs));
return s;
}
/*<----------------------------------------------------------------------------------------->*/
void InitPanneauEdition()
{
Arg args[10];
XmString label;
XmStringTable labelTable;
register int n;
char nomShell[128];
int lng = 0;
Xinit("xrec");
lng = c_getulng();
memset(&champOriginal, '\000', sizeof(_Champ));
n = 0;
strcpy(nomShell, XtName(SuperWidget.topLevel));
strcat(nomShell, nomPanneauEdition[lng]);
peTopLevel = XtAppCreateShell(nomShell, nomShell,
applicationShellWidgetClass,
XtDisplay(SuperWidget.topLevel), args, n);
peForme = (Widget) XmCreateForm(peTopLevel, "form", NULL, 0);
XtManageChild(peForme);
n = 0;
XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
XtSetArg(args[n], XmNrightAttachment, XmATTACH_FORM); n++;
peFermer = (Widget)XmCreatePushButton(peForme, labelFermer[lng], args, n);
XtAddCallback(peFermer, XmNactivateCallback, (XtCallbackProc) PeFermer, NULL);
XtManageChild(peFermer);
n = 0;
XtSetArg(args[n], XmNtopAttachment, XmATTACH_FORM); n++;
XtSetArg(args[n], XmNrightAttachment, XmATTACH_WIDGET); n++;
XtSetArg(args[n], XmNrightWidget, peFermer); n++;
peAfficher = (Widget)XmCreatePushButton(peForme, labelAfficher[lng], args, n);
XtAddCallback(peAfficher, XmNactivateCallback, (XtCallbackProc) PeAfficher, NULL);
XtManageChild(peAfficher);
n = 0;
XtSetArg(args[n], XmNtopAttachment, XmATTACH_WIDGET); n++;
XtSetArg(args[n], XmNtopWidget, peFermer); n++;
XtSetArg(args[n], XmNleftAttachment, XmATTACH_FORM); n++;
peFrame = (Widget) XmCreateFrame(peForme, "form", args, n);
XtManageChild(peFrame);
n = 0;
XtSetArg (args[n], XmNorientation, XmVERTICAL); n++;
XtSetArg (args[n], XmNnumColumns, 1); n++;
peRC = (Widget) XmCreateRowColumn(peFrame, "RC", args, n);
XtManageChild(peRC);
n=0;
XtSetArg (args[n], XmNorientation, XmVERTICAL); n++;
XtSetArg (args[n], XmNpacking, XmPACK_COLUMN); n++;
XtSetArg (args[n], XmNnumColumns, 2); n++;
peRCBoutons = (Widget) XmCreateRowColumn(peRC, "RCBoutons", args, n);
XtManageChild(peRCBoutons);
label = XmStringCreateLtoR(EditerValeurs[lng], XmSTRING_DEFAULT_CHARSET);
n = 0;
XtSetArg(args[n], XmNlabelString, label); n++;
XtSetArg (args[n], XmNsensitive, False); n++;
peEditerValeurs = (Widget) XmCreatePushButton(peRCBoutons, EditerValeurs[lng], args, n);
XtAddCallback(peEditerValeurs, XmNactivateCallback, (XtCallbackProc) PeEditerValeurs, MODIFIER);
XtManageChild(peEditerValeurs);
XmStringFree(label);
label = XmStringCreateLtoR(AnnulerEdition[lng], XmSTRING_DEFAULT_CHARSET);
n = 0;
XtSetArg(args[n], XmNlabelString, label); n++;
XtSetArg (args[n], XmNsensitive, False); n++;
peAnnulerEdition = (Widget) XmCreatePushButton(peRCBoutons, AnnulerEdition[lng], args, n);
XtAddCallback(peAnnulerEdition, XmNactivateCallback, (XtCallbackProc) PeAnnulerEdition, NULL);
XtManageChild(peAnnulerEdition);
XmStringFree(label);
label = XmStringCreateLtoR(Enregistrer[lng], XmSTRING_DEFAULT_CHARSET);
n = 0;
XtSetArg(args[n], XmNlabelString, label); n++;
XtSetArg (args[n], XmNsensitive, False); n++;
peEnregistrer = (Widget) XmCreatePushButton(peRCBoutons, Enregistrer[lng], args, n);
XtAddCallback(peEnregistrer, XmNactivateCallback, (XtCallbackProc) PeEnregistrer, NULL);
XtManageChild(peEnregistrer);
XmStringFree(label);
label = XmStringCreateLtoR(RemettreValeurs[lng], XmSTRING_DEFAULT_CHARSET);
n = 0;
XtSetArg(args[n], XmNlabelString, label); n++;
XtSetArg(args[n], XmNsensitive, False); n++;
peRemettreValeurs = (Widget) XmCreatePushButton(peRCBoutons, RemettreValeurs[lng], args, n);
XtAddCallback(peRemettreValeurs, XmNactivateCallback, (XtCallbackProc) PeEditerValeurs, (XtPointer) REMETTRE);
XtManageChild(peRemettreValeurs);
XmStringFree(label);
label = XmStringCreateLtoR(RefaireEdition[lng], XmSTRING_DEFAULT_CHARSET);
n = 0;
XtSetArg(args[n], XmNlabelString, label); n++;
XtSetArg (args[n], XmNsensitive, False); n++;
peRefaireEdition = (Widget) XmCreatePushButton(peRCBoutons, RefaireEdition[lng], args, n);
XtAddCallback(peRefaireEdition, XmNactivateCallback, (XtCallbackProc) PeRefaireEdition, NULL);
XtManageChild(peRefaireEdition);
XmStringFree(label);
label = XmStringCreateLtoR(AnnulerToutesModifs[lng], XmSTRING_DEFAULT_CHARSET);
n = 0;
XtSetArg(args[n], XmNlabelString, label); n++;
XtSetArg (args[n], XmNsensitive, False); n++;
peAnnulerToutesModifs = (Widget) XmCreatePushButton(peRCBoutons, AnnulerToutesModifs[lng], args, n);
XtAddCallback(peAnnulerToutesModifs, XmNactivateCallback, (XtCallbackProc) PeAnnulerToutesModifs, NULL);
XtManageChild(peAnnulerToutesModifs);
XmStringFree(label);
n = 0;
peSeparateurs[0] = (Widget) XmCreateSeparator(peRC, "sep 1", args, n);
XtManageChild(peSeparateurs[0]);
labelTable = (XmString *)calloc(1, sizeof(XmString *));
labelTable[0] = label;
n=0;
XtSetArg (args[n], XmNorientation, XmVERTICAL); n++;
XtSetArg (args[n], XmNnumColumns, 1); n++;
peRCValRemplacement = (Widget) XmCreateRowColumn(peRC, "Val", args, n);
XtManageChild(peRCValRemplacement);
label = XmStringCreateLtoR(NouvelleValeur[lng], XmSTRING_DEFAULT_CHARSET);
n=0;
peLabelValRemplacement = (Widget) XmCreateLabel(peRCValRemplacement, NouvelleValeur[lng], args, n);
XtManageChild(peLabelValRemplacement);
XmStringFree(label);
n = 0;
XtSetArg (args[n], XmNvalue, "0.0000"); n++;
XtSetArg (args[n], XmNblinkRate, 0); n++;
peTextValRemplacement = (Widget) XmCreateTextField(peRCValRemplacement, "text", args, n);
XtManageChild(peTextValRemplacement);
n = 0;
peSeparateurs[2] = (Widget) XmCreateSeparator(peRC, "sep 2", args, n);
XtManageChild(peSeparateurs[2]);
n=0;
XtSetArg (args[n], XmNorientation, XmVERTICAL); n++;
XtSetArg (args[n], XmNnumColumns, 1); n++;
peRCEtikRemplacement = (Widget) XmCreateRowColumn(peRC, "Etik", args, n);
XtManageChild(peRCEtikRemplacement);
label = XmStringCreateLtoR(NouvelleEtiquette[lng], XmSTRING_DEFAULT_CHARSET);
n=0;
peLabelEtikRemplacement = (Widget) XmCreateLabel(peRCEtikRemplacement, NouvelleEtiquette[lng], args, n);
XtManageChild(peLabelEtikRemplacement);
XmStringFree(label);
n = 0;
XtSetArg (args[n], XmNmaxLength, 8); n++;
XtSetArg (args[n], XmNvalue, EtiquetteDefaut[lng]); n++;
XtSetArg (args[n], XmNblinkRate, 0); n++;
peTextEtikRemplacement = (Widget) XmCreateTextField(peRCEtikRemplacement, "text", args, n);
XtManageChild(peTextEtikRemplacement);
peInfo = (Widget) CreateInfoDialog(peTopLevel);
peWarning = (Widget) CreateWarningDialog(peTopLevel);
peWarningWithCancel = (Widget) CreateWarningDialogWithCancelBox(peTopLevel);
}
int
c_read(char **wp)
{
int c = 0;
int expand = 1, history = 0;
int expanding;
int ecode = 0;
char *cp;
int fd = 0;
struct shf *shf;
int optc;
const char *emsg;
XString cs, xs;
struct tbl *vp;
char *xp = NULL;
while ((optc = ksh_getopt(wp, &builtin_opt, "prsu,")) != -1)
switch (optc) {
case 'p':
if ((fd = coproc_getfd(R_OK, &emsg)) < 0) {
bi_errorf("-p: %s", emsg);
return 1;
}
break;
case 'r':
expand = 0;
break;
case 's':
history = 1;
break;
case 'u':
if (!*(cp = builtin_opt.optarg))
fd = 0;
else if ((fd = check_fd(cp, R_OK, &emsg)) < 0) {
bi_errorf("-u: %s: %s", cp, emsg);
return 1;
}
break;
case '?':
return 1;
}
wp += builtin_opt.optind;
if (*wp == NULL)
*--wp = "REPLY";
/* Since we can't necessarily seek backwards on non-regular files,
* don't buffer them so we can't read too much.
*/
shf = shf_reopen(fd, SHF_RD | SHF_INTERRUPT | can_seek(fd), shl_spare);
if ((cp = strchr(*wp, '?')) != NULL) {
*cp = 0;
if (isatty(fd)) {
/* at&t ksh says it prints prompt on fd if it's open
* for writing and is a tty, but it doesn't do it
* (it also doesn't check the interactive flag,
* as is indicated in the Kornshell book).
*/
shellf("%s", cp+1);
}
}
/* If we are reading from the co-process for the first time,
* make sure the other side of the pipe is closed first. This allows
* the detection of eof.
*
* This is not compatible with at&t ksh... the fd is kept so another
* coproc can be started with same output, however, this means eof
* can't be detected... This is why it is closed here.
* If this call is removed, remove the eof check below, too.
* coproc_readw_close(fd);
*/
if (history)
Xinit(xs, xp, 128, ATEMP);
expanding = 0;
Xinit(cs, cp, 128, ATEMP);
for (; *wp != NULL; wp++) {
for (cp = Xstring(cs, cp); ; ) {
if (c == '\n' || c == EOF)
break;
while (1) {
c = shf_getc(shf);
if (c == '\0')
continue;
if (c == EOF && shf_error(shf) &&
shf_errno(shf) == EINTR) {
/* Was the offending signal one that
* would normally kill a process?
* If so, pretend the read was killed.
*/
ecode = fatal_trap_check();
/* non fatal (eg, CHLD), carry on */
if (!ecode) {
shf_clearerr(shf);
continue;
}
}
break;
}
if (history) {
Xcheck(xs, xp);
Xput(xs, xp, c);
}
Xcheck(cs, cp);
if (expanding) {
expanding = 0;
if (c == '\n') {
c = 0;
if (Flag(FTALKING_I) && isatty(fd)) {
/* set prompt in case this is
* called from .profile or $ENV
*/
set_prompt(PS2, NULL);
pprompt(prompt, 0);
}
} else if (c != EOF)
Xput(cs, cp, c);
continue;
}
if (expand && c == '\\') {
expanding = 1;
continue;
}
if (c == '\n' || c == EOF)
break;
if (ctype(c, C_IFS)) {
if (Xlength(cs, cp) == 0 && ctype(c, C_IFSWS))
continue;
if (wp[1])
break;
}
Xput(cs, cp, c);
}
/* strip trailing IFS white space from last variable */
if (!wp[1])
while (Xlength(cs, cp) && ctype(cp[-1], C_IFS) &&
ctype(cp[-1], C_IFSWS))
cp--;
Xput(cs, cp, '\0');
vp = global(*wp);
/* Must be done before setting export. */
if (vp->flag & RDONLY) {
shf_flush(shf);
bi_errorf("%s is read only", *wp);
return 1;
}
if (Flag(FEXPORT))
typeset(*wp, EXPORT, 0, 0, 0);
if (!setstr(vp, Xstring(cs, cp), KSH_RETURN_ERROR)) {
shf_flush(shf);
return 1;
}
}
shf_flush(shf);
if (history) {
Xput(xs, xp, '\0');
source->line++;
histsave(source->line, Xstring(xs, xp), 1);
Xfree(xs, xp);
}
/* if this is the co-process fd, close the file descriptor
* (can get eof if and only if all processes are have died, ie,
* coproc.njobs is 0 and the pipe is closed).
*/
if (c == EOF && !ecode)
coproc_read_close(fd);
return ecode ? ecode : c == EOF;
}
int BlockDACG::reSolve(int numEigen, Epetra_MultiVector &Q, double *lambda, int startingEV) {
// Computes the smallest eigenvalues and the corresponding eigenvectors
// of the generalized eigenvalue problem
//
// K X = M X Lambda
//
// using a Block Deflation Accelerated Conjugate Gradient algorithm.
//
// Note that if M is not specified, then K X = X Lambda is solved.
//
// Ref: P. Arbenz & R. Lehoucq, "A comparison of algorithms for modal analysis in the
// absence of a sparse direct method", SNL, Technical Report SAND2003-1028J
// With the notations of this report, the coefficient beta is defined as
// diag( H^T_{k} G_{k} ) / diag( H^T_{k-1} G_{k-1} )
//
// Input variables:
//
// numEigen (integer) = Number of eigenmodes requested
//
// Q (Epetra_MultiVector) = Converged eigenvectors
// The number of columns of Q must be equal to numEigen + blockSize.
// The rows of Q are distributed across processors.
// At exit, the first numEigen columns contain the eigenvectors requested.
//
// lambda (array of doubles) = Converged eigenvalues
// At input, it must be of size numEigen + blockSize.
// At exit, the first numEigen locations contain the eigenvalues requested.
//
// startingEV (integer) = Number of existing converged eigenmodes
//
// Return information on status of computation
//
// info >= 0 >> Number of converged eigenpairs at the end of computation
//
// // Failure due to input arguments
//
// info = - 1 >> The stiffness matrix K has not been specified.
// info = - 2 >> The maps for the matrix K and the matrix M differ.
// info = - 3 >> The maps for the matrix K and the preconditioner P differ.
// info = - 4 >> The maps for the vectors and the matrix K differ.
// info = - 5 >> Q is too small for the number of eigenvalues requested.
// info = - 6 >> Q is too small for the computation parameters.
//
// info = - 10 >> Failure during the mass orthonormalization
//
// info = - 20 >> Error in LAPACK during the local eigensolve
//
// info = - 30 >> MEMORY
//
// Check the input parameters
if (numEigen <= startingEV) {
return startingEV;
}
int info = myVerify.inputArguments(numEigen, K, M, Prec, Q, numEigen + blockSize);
if (info < 0)
return info;
int myPid = MyComm.MyPID();
// Get the weight for approximating the M-inverse norm
Epetra_Vector *vectWeight = 0;
if (normWeight) {
vectWeight = new Epetra_Vector(View, Q.Map(), normWeight);
}
int knownEV = startingEV;
int localVerbose = verbose*(myPid==0);
// Define local block vectors
//
// MX = Working vectors (storing M*X if M is specified, else pointing to X)
// KX = Working vectors (storing K*X)
//
// R = Residuals
//
// H = Preconditioned residuals
//
// P = Search directions
// MP = Working vectors (storing M*P if M is specified, else pointing to P)
// KP = Working vectors (storing K*P)
int xr = Q.MyLength();
Epetra_MultiVector X(View, Q, numEigen, blockSize);
X.Random();
int tmp;
tmp = (M == 0) ? 5*blockSize*xr : 7*blockSize*xr;
double *work1 = new (nothrow) double[tmp];
if (work1 == 0) {
if (vectWeight)
delete vectWeight;
info = -30;
return info;
}
memRequested += sizeof(double)*tmp/(1024.0*1024.0);
highMem = (highMem > currentSize()) ? highMem : currentSize();
double *tmpD = work1;
Epetra_MultiVector KX(View, Q.Map(), tmpD, xr, blockSize);
tmpD = tmpD + xr*blockSize;
Epetra_MultiVector MX(View, Q.Map(), (M) ? tmpD : X.Values(), xr, blockSize);
tmpD = (M) ? tmpD + xr*blockSize : tmpD;
Epetra_MultiVector R(View, Q.Map(), tmpD, xr, blockSize);
tmpD = tmpD + xr*blockSize;
Epetra_MultiVector H(View, Q.Map(), tmpD, xr, blockSize);
tmpD = tmpD + xr*blockSize;
Epetra_MultiVector P(View, Q.Map(), tmpD, xr, blockSize);
tmpD = tmpD + xr*blockSize;
Epetra_MultiVector KP(View, Q.Map(), tmpD, xr, blockSize);
tmpD = tmpD + xr*blockSize;
Epetra_MultiVector MP(View, Q.Map(), (M) ? tmpD : P.Values(), xr, blockSize);
// Define arrays
//
// theta = Store the local eigenvalues (size: 2*blockSize)
// normR = Store the norm of residuals (size: blockSize)
//
// oldHtR = Store the previous H_i^T*R_i (size: blockSize)
// currentHtR = Store the current H_i^T*R_i (size: blockSize)
//
// MM = Local mass matrix (size: 2*blockSize x 2*blockSize)
// KK = Local stiffness matrix (size: 2*blockSize x 2*blockSize)
//
// S = Local eigenvectors (size: 2*blockSize x 2*blockSize)
int lwork2;
lwork2 = 5*blockSize + 12*blockSize*blockSize;
double *work2 = new (nothrow) double[lwork2];
if (work2 == 0) {
if (vectWeight)
delete vectWeight;
delete[] work1;
info = -30;
return info;
}
highMem = (highMem > currentSize()) ? highMem : currentSize();
tmpD = work2;
double *theta = tmpD;
tmpD = tmpD + 2*blockSize;
double *normR = tmpD;
tmpD = tmpD + blockSize;
double *oldHtR = tmpD;
tmpD = tmpD + blockSize;
double *currentHtR = tmpD;
tmpD = tmpD + blockSize;
memset(currentHtR, 0, blockSize*sizeof(double));
double *MM = tmpD;
tmpD = tmpD + 4*blockSize*blockSize;
double *KK = tmpD;
tmpD = tmpD + 4*blockSize*blockSize;
double *S = tmpD;
memRequested += sizeof(double)*lwork2/(1024.0*1024.0);
// Define an array to store the residuals history
if (localVerbose > 2) {
resHistory = new (nothrow) double[maxIterEigenSolve*blockSize];
if (resHistory == 0) {
if (vectWeight)
delete vectWeight;
delete[] work1;
delete[] work2;
info = -30;
return info;
}
historyCount = 0;
}
// Miscellaneous definitions
bool reStart = false;
numRestart = 0;
int localSize;
int twoBlocks = 2*blockSize;
int nFound = blockSize;
int i, j;
if (localVerbose > 0) {
cout << endl;
cout << " *|* Problem: ";
if (M)
cout << "K*Q = M*Q D ";
else
cout << "K*Q = Q D ";
if (Prec)
cout << " with preconditioner";
cout << endl;
cout << " *|* Algorithm = DACG (block version)" << endl;
cout << " *|* Size of blocks = " << blockSize << endl;
cout << " *|* Number of requested eigenvalues = " << numEigen << endl;
cout.precision(2);
cout.setf(ios::scientific, ios::floatfield);
cout << " *|* Tolerance for convergence = " << tolEigenSolve << endl;
cout << " *|* Norm used for convergence: ";
if (normWeight)
cout << "weighted L2-norm with user-provided weights" << endl;
else
cout << "L^2-norm" << endl;
if (startingEV > 0)
cout << " *|* Input converged eigenvectors = " << startingEV << endl;
cout << "\n -- Start iterations -- \n";
}
timeOuterLoop -= MyWatch.WallTime();
for (outerIter = 1; outerIter <= maxIterEigenSolve; ++outerIter) {
highMem = (highMem > currentSize()) ? highMem : currentSize();
if ((outerIter == 1) || (reStart == true)) {
reStart = false;
localSize = blockSize;
if (nFound > 0) {
Epetra_MultiVector X2(View, X, blockSize-nFound, nFound);
Epetra_MultiVector MX2(View, MX, blockSize-nFound, nFound);
Epetra_MultiVector KX2(View, KX, blockSize-nFound, nFound);
// Apply the mass matrix to X
timeMassOp -= MyWatch.WallTime();
if (M)
M->Apply(X2, MX2);
timeMassOp += MyWatch.WallTime();
massOp += nFound;
if (knownEV > 0) {
// Orthonormalize X against the known eigenvectors with Gram-Schmidt
// Note: Use R as a temporary work space
Epetra_MultiVector copyQ(View, Q, 0, knownEV);
timeOrtho -= MyWatch.WallTime();
info = modalTool.massOrthonormalize(X, MX, M, copyQ, nFound, 0, R.Values());
timeOrtho += MyWatch.WallTime();
// Exit the code if the orthogonalization did not succeed
if (info < 0) {
info = -10;
delete[] work1;
delete[] work2;
if (vectWeight)
delete vectWeight;
return info;
}
}
// Apply the stiffness matrix to X
timeStifOp -= MyWatch.WallTime();
K->Apply(X2, KX2);
timeStifOp += MyWatch.WallTime();
stifOp += nFound;
} // if (nFound > 0)
} // if ((outerIter == 1) || (reStart == true))
else {
// Apply the preconditioner on the residuals
if (Prec != 0) {
timePrecOp -= MyWatch.WallTime();
Prec->ApplyInverse(R, H);
timePrecOp += MyWatch.WallTime();
precOp += blockSize;
}
else {
memcpy(H.Values(), R.Values(), xr*blockSize*sizeof(double));
}
// Compute the product H^T*R
timeSearchP -= MyWatch.WallTime();
memcpy(oldHtR, currentHtR, blockSize*sizeof(double));
H.Dot(R, currentHtR);
// Define the new search directions
if (localSize == blockSize) {
P.Scale(-1.0, H);
localSize = twoBlocks;
} // if (localSize == blockSize)
else {
bool hasZeroDot = false;
for (j = 0; j < blockSize; ++j) {
if (oldHtR[j] == 0.0) {
hasZeroDot = true;
break;
}
callBLAS.SCAL(xr, currentHtR[j]/oldHtR[j], P.Values() + j*xr);
}
if (hasZeroDot == true) {
// Restart the computation when there is a null dot product
if (localVerbose > 0) {
cout << endl;
cout << " !! Null dot product -- Restart the search space !!\n";
cout << endl;
}
if (blockSize == 1) {
X.Random();
nFound = blockSize;
}
else {
Epetra_MultiVector Xinit(View, X, j, blockSize-j);
Xinit.Random();
nFound = blockSize - j;
} // if (blockSize == 1)
reStart = true;
numRestart += 1;
info = 0;
continue;
}
callBLAS.AXPY(xr*blockSize, -1.0, H.Values(), P.Values());
} // if (localSize == blockSize)
timeSearchP += MyWatch.WallTime();
// Apply the mass matrix on P
timeMassOp -= MyWatch.WallTime();
if (M)
M->Apply(P, MP);
timeMassOp += MyWatch.WallTime();
massOp += blockSize;
if (knownEV > 0) {
// Orthogonalize P against the known eigenvectors
// Note: Use R as a temporary work space
Epetra_MultiVector copyQ(View, Q, 0, knownEV);
timeOrtho -= MyWatch.WallTime();
modalTool.massOrthonormalize(P, MP, M, copyQ, blockSize, 1, R.Values());
timeOrtho += MyWatch.WallTime();
}
// Apply the stiffness matrix to P
timeStifOp -= MyWatch.WallTime();
K->Apply(P, KP);
timeStifOp += MyWatch.WallTime();
stifOp += blockSize;
} // if ((outerIter == 1) || (reStart == true))
// Form "local" mass and stiffness matrices
// Note: Use S as a temporary workspace
timeLocalProj -= MyWatch.WallTime();
modalTool.localProjection(blockSize, blockSize, xr, X.Values(), xr, KX.Values(), xr,
KK, localSize, S);
modalTool.localProjection(blockSize, blockSize, xr, X.Values(), xr, MX.Values(), xr,
MM, localSize, S);
if (localSize > blockSize) {
modalTool.localProjection(blockSize, blockSize, xr, X.Values(), xr, KP.Values(), xr,
KK + blockSize*localSize, localSize, S);
modalTool.localProjection(blockSize, blockSize, xr, P.Values(), xr, KP.Values(), xr,
KK + blockSize*localSize + blockSize, localSize, S);
modalTool.localProjection(blockSize, blockSize, xr, X.Values(), xr, MP.Values(), xr,
MM + blockSize*localSize, localSize, S);
modalTool.localProjection(blockSize, blockSize, xr, P.Values(), xr, MP.Values(), xr,
MM + blockSize*localSize + blockSize, localSize, S);
} // if (localSize > blockSize)
timeLocalProj += MyWatch.WallTime();
// Perform a spectral decomposition
timeLocalSolve -= MyWatch.WallTime();
int nevLocal = localSize;
info = modalTool.directSolver(localSize, KK, localSize, MM, localSize, nevLocal,
S, localSize, theta, localVerbose,
(blockSize == 1) ? 1: 0);
timeLocalSolve += MyWatch.WallTime();
if (info < 0) {
// Stop when spectral decomposition has a critical failure
break;
}
// Check for restarting
if ((theta[0] < 0.0) || (nevLocal < blockSize)) {
if (localVerbose > 0) {
cout << " Iteration " << outerIter;
cout << "- Failure for spectral decomposition - RESTART with new random search\n";
}
if (blockSize == 1) {
X.Random();
nFound = blockSize;
}
else {
Epetra_MultiVector Xinit(View, X, 1, blockSize-1);
Xinit.Random();
nFound = blockSize - 1;
} // if (blockSize == 1)
reStart = true;
numRestart += 1;
info = 0;
continue;
} // if ((theta[0] < 0.0) || (nevLocal < blockSize))
if ((localSize == twoBlocks) && (nevLocal == blockSize)) {
for (j = 0; j < nevLocal; ++j)
memcpy(S + j*blockSize, S + j*twoBlocks, blockSize*sizeof(double));
localSize = blockSize;
}
// Check the direction of eigenvectors
// Note: This sign check is important for convergence
for (j = 0; j < nevLocal; ++j) {
double coeff = S[j + j*localSize];
if (coeff < 0.0)
callBLAS.SCAL(localSize, -1.0, S + j*localSize);
}
// Compute the residuals
timeResidual -= MyWatch.WallTime();
callBLAS.GEMM('N', 'N', xr, blockSize, blockSize, 1.0, KX.Values(), xr,
S, localSize, 0.0, R.Values(), xr);
if (localSize == twoBlocks) {
callBLAS.GEMM('N', 'N', xr, blockSize, blockSize, 1.0, KP.Values(), xr,
S + blockSize, localSize, 1.0, R.Values(), xr);
}
for (j = 0; j < blockSize; ++j)
callBLAS.SCAL(localSize, theta[j], S + j*localSize);
callBLAS.GEMM('N', 'N', xr, blockSize, blockSize, -1.0, MX.Values(), xr,
S, localSize, 1.0, R.Values(), xr);
if (localSize == twoBlocks) {
callBLAS.GEMM('N', 'N', xr, blockSize, blockSize, -1.0, MP.Values(), xr,
S + blockSize, localSize, 1.0, R.Values(), xr);
}
for (j = 0; j < blockSize; ++j)
callBLAS.SCAL(localSize, 1.0/theta[j], S + j*localSize);
timeResidual += MyWatch.WallTime();
// Compute the norms of the residuals
timeNorm -= MyWatch.WallTime();
if (vectWeight)
R.NormWeighted(*vectWeight, normR);
else
R.Norm2(normR);
// Scale the norms of residuals with the eigenvalues
// Count the converged eigenvectors
nFound = 0;
for (j = 0; j < blockSize; ++j) {
normR[j] = (theta[j] == 0.0) ? normR[j] : normR[j]/theta[j];
if (normR[j] < tolEigenSolve)
nFound += 1;
}
timeNorm += MyWatch.WallTime();
// Store the residual history
if (localVerbose > 2) {
memcpy(resHistory + historyCount*blockSize, normR, blockSize*sizeof(double));
historyCount += 1;
}
// Print information on current iteration
if (localVerbose > 0) {
cout << " Iteration " << outerIter << " - Number of converged eigenvectors ";
cout << knownEV + nFound << endl;
}
if (localVerbose > 1) {
cout << endl;
cout.precision(2);
cout.setf(ios::scientific, ios::floatfield);
for (i=0; i<blockSize; ++i) {
cout << " Iteration " << outerIter << " - Scaled Norm of Residual " << i;
cout << " = " << normR[i] << endl;
}
cout << endl;
cout.precision(2);
for (i=0; i<blockSize; ++i) {
cout << " Iteration " << outerIter << " - Ritz eigenvalue " << i;
cout.setf((fabs(theta[i]) < 0.01) ? ios::scientific : ios::fixed, ios::floatfield);
cout << " = " << theta[i] << endl;
}
cout << endl;
}
if (nFound == 0) {
// Update the spaces
// Note: Use H as a temporary work space
timeLocalUpdate -= MyWatch.WallTime();
memcpy(H.Values(), X.Values(), xr*blockSize*sizeof(double));
callBLAS.GEMM('N', 'N', xr, blockSize, blockSize, 1.0, H.Values(), xr, S, localSize,
0.0, X.Values(), xr);
memcpy(H.Values(), KX.Values(), xr*blockSize*sizeof(double));
callBLAS.GEMM('N', 'N', xr, blockSize, blockSize, 1.0, H.Values(), xr, S, localSize,
0.0, KX.Values(), xr);
if (M) {
memcpy(H.Values(), MX.Values(), xr*blockSize*sizeof(double));
callBLAS.GEMM('N', 'N', xr, blockSize, blockSize, 1.0, H.Values(), xr, S, localSize,
0.0, MX.Values(), xr);
}
if (localSize == twoBlocks) {
callBLAS.GEMM('N', 'N', xr, blockSize, blockSize, 1.0, P.Values(), xr,
S + blockSize, localSize, 1.0, X.Values(), xr);
callBLAS.GEMM('N', 'N', xr, blockSize, blockSize, 1.0, KP.Values(), xr,
S + blockSize, localSize, 1.0, KX.Values(), xr);
if (M) {
callBLAS.GEMM('N', 'N', xr, blockSize, blockSize, 1.0, MP.Values(), xr,
S + blockSize, localSize, 1.0, MX.Values(), xr);
}
} // if (localSize == twoBlocks)
timeLocalUpdate += MyWatch.WallTime();
// When required, monitor some orthogonalities
if (verbose > 2) {
if (knownEV == 0) {
accuracyCheck(&X, &MX, &R, 0, (localSize>blockSize) ? &P : 0);
}
else {
Epetra_MultiVector copyQ(View, Q, 0, knownEV);
accuracyCheck(&X, &MX, &R, ©Q, (localSize>blockSize) ? &P : 0);
}
} // if (verbose > 2)
continue;
} // if (nFound == 0)
// Order the Ritz eigenvectors by putting the converged vectors at the beginning
int firstIndex = blockSize;
for (j = 0; j < blockSize; ++j) {
if (normR[j] >= tolEigenSolve) {
firstIndex = j;
break;
}
} // for (j = 0; j < blockSize; ++j)
while (firstIndex < nFound) {
for (j = firstIndex; j < blockSize; ++j) {
if (normR[j] < tolEigenSolve) {
// Swap the j-th and firstIndex-th position
callFortran.SWAP(localSize, S + j*localSize, 1, S + firstIndex*localSize, 1);
callFortran.SWAP(1, theta + j, 1, theta + firstIndex, 1);
callFortran.SWAP(1, normR + j, 1, normR + firstIndex, 1);
break;
}
} // for (j = firstIndex; j < blockSize; ++j)
for (j = 0; j < blockSize; ++j) {
if (normR[j] >= tolEigenSolve) {
firstIndex = j;
break;
}
} // for (j = 0; j < blockSize; ++j)
} // while (firstIndex < nFound)
// Copy the converged eigenvalues
memcpy(lambda + knownEV, theta, nFound*sizeof(double));
// Convergence test
if (knownEV + nFound >= numEigen) {
callBLAS.GEMM('N', 'N', xr, nFound, blockSize, 1.0, X.Values(), xr,
S, localSize, 0.0, R.Values(), xr);
if (localSize > blockSize) {
callBLAS.GEMM('N', 'N', xr, nFound, blockSize, 1.0, P.Values(), xr,
S + blockSize, localSize, 1.0, R.Values(), xr);
}
memcpy(Q.Values() + knownEV*xr, R.Values(), nFound*xr*sizeof(double));
knownEV += nFound;
if (localVerbose == 1) {
cout << endl;
cout.precision(2);
cout.setf(ios::scientific, ios::floatfield);
for (i=0; i<blockSize; ++i) {
cout << " Iteration " << outerIter << " - Scaled Norm of Residual " << i;
cout << " = " << normR[i] << endl;
}
cout << endl;
}
break;
}
// Store the converged eigenvalues and eigenvectors
callBLAS.GEMM('N', 'N', xr, nFound, blockSize, 1.0, X.Values(), xr,
S, localSize, 0.0, Q.Values() + knownEV*xr, xr);
if (localSize == twoBlocks) {
callBLAS.GEMM('N', 'N', xr, nFound, blockSize, 1.0, P.Values(), xr,
S + blockSize, localSize, 1.0, Q.Values() + knownEV*xr, xr);
}
knownEV += nFound;
// Define the restarting vectors
timeRestart -= MyWatch.WallTime();
int leftOver = (nevLocal < blockSize + nFound) ? nevLocal - nFound : blockSize;
double *Snew = S + nFound*localSize;
memcpy(H.Values(), X.Values(), blockSize*xr*sizeof(double));
callBLAS.GEMM('N', 'N', xr, leftOver, blockSize, 1.0, H.Values(), xr,
Snew, localSize, 0.0, X.Values(), xr);
memcpy(H.Values(), KX.Values(), blockSize*xr*sizeof(double));
callBLAS.GEMM('N', 'N', xr, leftOver, blockSize, 1.0, H.Values(), xr,
Snew, localSize, 0.0, KX.Values(), xr);
if (M) {
memcpy(H.Values(), MX.Values(), blockSize*xr*sizeof(double));
callBLAS.GEMM('N', 'N', xr, leftOver, blockSize, 1.0, H.Values(), xr,
Snew, localSize, 0.0, MX.Values(), xr);
}
if (localSize == twoBlocks) {
callBLAS.GEMM('N', 'N', xr, leftOver, blockSize, 1.0, P.Values(), xr,
Snew+blockSize, localSize, 1.0, X.Values(), xr);
callBLAS.GEMM('N', 'N', xr, leftOver, blockSize, 1.0, KP.Values(), xr,
Snew+blockSize, localSize, 1.0, KX.Values(), xr);
if (M) {
callBLAS.GEMM('N', 'N', xr, leftOver, blockSize, 1.0, MP.Values(), xr,
Snew+blockSize, localSize, 1.0, MX.Values(), xr);
}
} // if (localSize == twoBlocks)
if (nevLocal < blockSize + nFound) {
// Put new random vectors at the end of the block
Epetra_MultiVector Xtmp(View, X, leftOver, blockSize - leftOver);
Xtmp.Random();
}
else {
nFound = 0;
} // if (nevLocal < blockSize + nFound)
reStart = true;
timeRestart += MyWatch.WallTime();
} // for (outerIter = 1; outerIter <= maxIterEigenSolve; ++outerIter)
timeOuterLoop += MyWatch.WallTime();
highMem = (highMem > currentSize()) ? highMem : currentSize();
// Clean memory
delete[] work1;
delete[] work2;
if (vectWeight)
delete vectWeight;
// Sort the eigenpairs
timePostProce -= MyWatch.WallTime();
if ((info == 0) && (knownEV > 0)) {
mySort.sortScalars_Vectors(knownEV, lambda, Q.Values(), Q.MyLength());
}
timePostProce += MyWatch.WallTime();
return (info == 0) ? knownEV : info;
}
int Davidson::reSolve(int numEigen, Epetra_MultiVector &Q, double *lambda, int startingEV) {
// Computes the smallest eigenvalues and the corresponding eigenvectors
// of the generalized eigenvalue problem
//
// K X = M X Lambda
//
// using a generalized Davidson algorithm
//
// Note that if M is not specified, then K X = X Lambda is solved.
//
// Input variables:
//
// numEigen (integer) = Number of eigenmodes requested
//
// Q (Epetra_MultiVector) = Converged eigenvectors
// The number of columns of Q must be at least numEigen + blockSize.
// The rows of Q are distributed across processors.
// At exit, the first numEigen columns contain the eigenvectors requested.
//
// lambda (array of doubles) = Converged eigenvalues
// At input, it must be of size numEigen + blockSize.
// At exit, the first numEigen locations contain the eigenvalues requested.
//
// startingEV (integer) = Number of existing converged eigenvectors
// We assume that the user has check the eigenvectors and
// their M-orthonormality.
//
// Return information on status of computation
//
// info >= 0 >> Number of converged eigenpairs at the end of computation
//
// // Failure due to input arguments
//
// info = - 1 >> The stiffness matrix K has not been specified.
// info = - 2 >> The maps for the matrix K and the matrix M differ.
// info = - 3 >> The maps for the matrix K and the preconditioner P differ.
// info = - 4 >> The maps for the vectors and the matrix K differ.
// info = - 5 >> Q is too small for the number of eigenvalues requested.
// info = - 6 >> Q is too small for the computation parameters.
//
// info = - 8 >> The number of blocks is too small for the number of eigenvalues.
//
// info = - 10 >> Failure during the mass orthonormalization
//
// info = - 30 >> MEMORY
//
// Check the input parameters
if (numEigen <= startingEV) {
return startingEV;
}
int info = myVerify.inputArguments(numEigen, K, M, Prec, Q, minimumSpaceDimension(numEigen));
if (info < 0)
return info;
int myPid = MyComm.MyPID();
if (numBlock*blockSize < numEigen) {
if (myPid == 0) {
cerr << endl;
cerr << " !!! The space dimension (# of blocks x size of blocks) must be greater than ";
cerr << " the number of eigenvalues !!!\n";
cerr << " Number of blocks = " << numBlock << endl;
cerr << " Size of blocks = " << blockSize << endl;
cerr << " Number of eigenvalues = " << numEigen << endl;
cerr << endl;
}
return -8;
}
// Get the weight for approximating the M-inverse norm
Epetra_Vector *vectWeight = 0;
if (normWeight) {
vectWeight = new Epetra_Vector(View, Q.Map(), normWeight);
}
int knownEV = startingEV;
int localVerbose = verbose*(myPid==0);
// Define local block vectors
//
// MX = Working vectors (storing M*X if M is specified, else pointing to X)
// KX = Working vectors (storing K*X)
//
// R = Residuals
int xr = Q.MyLength();
int dimSearch = blockSize*numBlock;
Epetra_MultiVector X(View, Q, 0, dimSearch + blockSize);
if (knownEV > 0) {
Epetra_MultiVector copyX(View, Q, knownEV, blockSize);
copyX.Random();
}
else {
X.Random();
}
int tmp;
tmp = (M == 0) ? 2*blockSize*xr : 3*blockSize*xr;
double *work1 = new (nothrow) double[tmp];
if (work1 == 0) {
if (vectWeight)
delete vectWeight;
info = -30;
return info;
}
memRequested += sizeof(double)*tmp/(1024.0*1024.0);
highMem = (highMem > currentSize()) ? highMem : currentSize();
double *tmpD = work1;
Epetra_MultiVector KX(View, Q.Map(), tmpD, xr, blockSize);
tmpD = tmpD + xr*blockSize;
Epetra_MultiVector MX(View, Q.Map(), (M) ? tmpD : X.Values(), xr, blockSize);
tmpD = (M) ? tmpD + xr*blockSize : tmpD;
Epetra_MultiVector R(View, Q.Map(), tmpD, xr, blockSize);
// Define arrays
//
// theta = Store the local eigenvalues (size: dimSearch)
// normR = Store the norm of residuals (size: blockSize)
//
// KK = Local stiffness matrix (size: dimSearch x dimSearch)
//
// S = Local eigenvectors (size: dimSearch x dimSearch)
//
// tmpKK = Local workspace (size: blockSize x blockSize)
int lwork2 = blockSize + dimSearch + 2*dimSearch*dimSearch + blockSize*blockSize;
double *work2 = new (nothrow) double[lwork2];
if (work2 == 0) {
if (vectWeight)
delete vectWeight;
delete[] work1;
info = -30;
return info;
}
memRequested += sizeof(double)*lwork2/(1024.0*1024.0);
highMem = (highMem > currentSize()) ? highMem : currentSize();
tmpD = work2;
double *theta = tmpD;
tmpD = tmpD + dimSearch;
double *normR = tmpD;
tmpD = tmpD + blockSize;
double *KK = tmpD;
tmpD = tmpD + dimSearch*dimSearch;
memset(KK, 0, dimSearch*dimSearch*sizeof(double));
double *S = tmpD;
tmpD = tmpD + dimSearch*dimSearch;
double *tmpKK = tmpD;
// Define an array to store the residuals history
if (localVerbose > 2) {
resHistory = new (nothrow) double[maxIterEigenSolve*blockSize];
spaceSizeHistory = new (nothrow) int[maxIterEigenSolve];
if ((resHistory == 0) || (spaceSizeHistory == 0)) {
if (vectWeight)
delete vectWeight;
delete[] work1;
delete[] work2;
info = -30;
return info;
}
historyCount = 0;
}
// Miscellaneous definitions
bool reStart = false;
numRestart = 0;
bool criticalExit = false;
int bStart = 0;
int offSet = 0;
numBlock = (dimSearch/blockSize) - (knownEV/blockSize);
int nFound = blockSize;
int i, j;
if (localVerbose > 0) {
cout << endl;
cout << " *|* Problem: ";
if (M)
cout << "K*Q = M*Q D ";
else
cout << "K*Q = Q D ";
if (Prec)
cout << " with preconditioner";
cout << endl;
cout << " *|* Algorithm = Davidson algorithm (block version)" << endl;
cout << " *|* Size of blocks = " << blockSize << endl;
cout << " *|* Largest size of search space = " << numBlock*blockSize << endl;
cout << " *|* Number of requested eigenvalues = " << numEigen << endl;
cout.precision(2);
cout.setf(ios::scientific, ios::floatfield);
cout << " *|* Tolerance for convergence = " << tolEigenSolve << endl;
cout << " *|* Norm used for convergence: ";
if (vectWeight)
cout << "weighted L2-norm with user-provided weights" << endl;
else
cout << "L^2-norm" << endl;
if (startingEV > 0)
cout << " *|* Input converged eigenvectors = " << startingEV << endl;
cout << "\n -- Start iterations -- \n";
}
int maxBlock = (dimSearch/blockSize) - (knownEV/blockSize);
timeOuterLoop -= MyWatch.WallTime();
outerIter = 0;
while (outerIter <= maxIterEigenSolve) {
highMem = (highMem > currentSize()) ? highMem : currentSize();
int nb;
for (nb = bStart; nb < maxBlock; ++nb) {
outerIter += 1;
if (outerIter > maxIterEigenSolve)
break;
int localSize = nb*blockSize;
Epetra_MultiVector Xcurrent(View, X, localSize + knownEV, blockSize);
timeMassOp -= MyWatch.WallTime();
if (M)
M->Apply(Xcurrent, MX);
timeMassOp += MyWatch.WallTime();
massOp += blockSize;
// Orthonormalize X against the known eigenvectors and the previous vectors
// Note: Use R as a temporary work space
timeOrtho -= MyWatch.WallTime();
if (nb == bStart) {
if (nFound > 0) {
if (knownEV == 0) {
info = modalTool.massOrthonormalize(Xcurrent, MX, M, Q, nFound, 2, R.Values());
}
else {
Epetra_MultiVector copyQ(View, X, 0, knownEV + localSize);
info = modalTool.massOrthonormalize(Xcurrent, MX, M, copyQ, nFound, 0, R.Values());
}
}
nFound = 0;
}
else {
Epetra_MultiVector copyQ(View, X, 0, knownEV + localSize);
info = modalTool.massOrthonormalize(Xcurrent, MX, M, copyQ, blockSize, 0, R.Values());
}
timeOrtho += MyWatch.WallTime();
// Exit the code when the number of vectors exceeds the space dimension
if (info < 0) {
delete[] work1;
delete[] work2;
if (vectWeight)
delete vectWeight;
return -10;
}
timeStifOp -= MyWatch.WallTime();
K->Apply(Xcurrent, KX);
timeStifOp += MyWatch.WallTime();
stifOp += blockSize;
// Check the orthogonality properties of X
if (verbose > 2) {
if (knownEV + localSize == 0)
accuracyCheck(&Xcurrent, &MX, 0);
else {
Epetra_MultiVector copyQ(View, X, 0, knownEV + localSize);
accuracyCheck(&Xcurrent, &MX, ©Q);
}
if (localVerbose > 0)
cout << endl;
} // if (verbose > 2)
// Define the local stiffness matrix
// Note: S is used as a workspace
timeLocalProj -= MyWatch.WallTime();
for (j = 0; j <= nb; ++j) {
callBLAS.GEMM('T', 'N', blockSize, blockSize, xr,
1.0, X.Values()+(knownEV+j*blockSize)*xr, xr, KX.Values(), xr,
0.0, tmpKK, blockSize);
MyComm.SumAll(tmpKK, S, blockSize*blockSize);
int iC;
for (iC = 0; iC < blockSize; ++iC) {
double *Kpointer = KK + localSize*dimSearch + j*blockSize + iC*dimSearch;
memcpy(Kpointer, S + iC*blockSize, blockSize*sizeof(double));
}
}
timeLocalProj += MyWatch.WallTime();
// Perform a spectral decomposition
timeLocalSolve -= MyWatch.WallTime();
int nevLocal = localSize + blockSize;
info = modalTool.directSolver(localSize+blockSize, KK, dimSearch, 0, 0,
nevLocal, S, dimSearch, theta, localVerbose, 10);
timeLocalSolve += MyWatch.WallTime();
if (info != 0) {
// Stop as spectral decomposition has a critical failure
if (info < 0) {
criticalExit = true;
break;
}
// Restart as spectral decomposition failed
if (localVerbose > 0) {
cout << " Iteration " << outerIter;
cout << "- Failure for spectral decomposition - RESTART with new random search\n";
}
reStart = true;
numRestart += 1;
timeRestart -= MyWatch.WallTime();
Epetra_MultiVector Xinit(View, X, knownEV, blockSize);
Xinit.Random();
timeRestart += MyWatch.WallTime();
nFound = blockSize;
bStart = 0;
break;
} // if (info != 0)
// Update the search space
// Note: Use KX as a workspace
timeLocalUpdate -= MyWatch.WallTime();
callBLAS.GEMM('N', 'N', xr, blockSize, localSize+blockSize, 1.0, X.Values()+knownEV*xr, xr,
S, dimSearch, 0.0, KX.Values(), xr);
timeLocalUpdate += MyWatch.WallTime();
// Apply the mass matrix for the next block
timeMassOp -= MyWatch.WallTime();
if (M)
M->Apply(KX, MX);
timeMassOp += MyWatch.WallTime();
massOp += blockSize;
// Apply the stiffness matrix for the next block
timeStifOp -= MyWatch.WallTime();
K->Apply(KX, R);
timeStifOp += MyWatch.WallTime();
stifOp += blockSize;
// Form the residuals
timeResidual -= MyWatch.WallTime();
if (M) {
for (j = 0; j < blockSize; ++j) {
callBLAS.AXPY(xr, -theta[j], MX.Values() + j*xr, R.Values() + j*xr);
}
}
else {
// Note KX contains the updated block
for (j = 0; j < blockSize; ++j) {
callBLAS.AXPY(xr, -theta[j], KX.Values() + j*xr, R.Values() + j*xr);
}
}
timeResidual += MyWatch.WallTime();
residual += blockSize;
// Compute the norm of residuals
timeNorm -= MyWatch.WallTime();
if (vectWeight) {
R.NormWeighted(*vectWeight, normR);
}
else {
R.Norm2(normR);
}
// Scale the norms of residuals with the eigenvalues
// Count the number of converged eigenvectors
nFound = 0;
for (j = 0; j < blockSize; ++j) {
normR[j] = (theta[j] == 0.0) ? normR[j] : normR[j]/theta[j];
if (normR[j] < tolEigenSolve)
nFound += 1;
} // for (j = 0; j < blockSize; ++j)
timeNorm += MyWatch.WallTime();
// Store the residual history
if (localVerbose > 2) {
memcpy(resHistory + historyCount*blockSize, normR, blockSize*sizeof(double));
spaceSizeHistory[historyCount] = localSize + blockSize;
historyCount += 1;
}
maxSpaceSize = (maxSpaceSize > localSize+blockSize) ? maxSpaceSize : localSize+blockSize;
sumSpaceSize += localSize + blockSize;
// Print information on current iteration
if (localVerbose > 0) {
cout << " Iteration " << outerIter << " - Number of converged eigenvectors ";
cout << knownEV + nFound << endl;
} // if (localVerbose > 0)
if (localVerbose > 1) {
cout << endl;
cout.precision(2);
cout.setf(ios::scientific, ios::floatfield);
for (i=0; i<blockSize; ++i) {
cout << " Iteration " << outerIter << " - Scaled Norm of Residual " << i;
cout << " = " << normR[i] << endl;
}
cout << endl;
cout.precision(2);
for (i=0; i<nevLocal; ++i) {
cout << " Iteration " << outerIter << " - Ritz eigenvalue " << i;
cout.setf((fabs(theta[i]) < 0.01) ? ios::scientific : ios::fixed, ios::floatfield);
cout << " = " << theta[i] << endl;
}
cout << endl;
}
// Exit the loop to treat the converged eigenvectors
if (nFound > 0) {
nb += 1;
offSet = 0;
break;
}
// Apply the preconditioner on the residuals
// Note: Use KX as a workspace
if (maxBlock == 1) {
if (Prec) {
timePrecOp -= MyWatch.WallTime();
Prec->ApplyInverse(R, Xcurrent);
timePrecOp += MyWatch.WallTime();
precOp += blockSize;
}
else {
memcpy(Xcurrent.Values(), R.Values(), blockSize*xr*sizeof(double));
}
timeRestart -= MyWatch.WallTime();
Xcurrent.Update(1.0, KX, -1.0);
timeRestart += MyWatch.WallTime();
break;
} // if (maxBlock == 1)
if (nb == maxBlock - 1) {
nb += 1;
break;
}
Epetra_MultiVector Xnext(View, X, knownEV+localSize+blockSize, blockSize);
if (Prec) {
timePrecOp -= MyWatch.WallTime();
Prec->ApplyInverse(R, Xnext);
timePrecOp += MyWatch.WallTime();
precOp += blockSize;
}
else {
memcpy(Xnext.Values(), R.Values(), blockSize*xr*sizeof(double));
}
} // for (nb = bStart; nb < maxBlock; ++nb)
if (outerIter > maxIterEigenSolve)
break;
if (reStart == true) {
reStart = false;
continue;
}
if (criticalExit == true)
break;
// Store the final converged eigenvectors
if (knownEV + nFound >= numEigen) {
for (j = 0; j < blockSize; ++j) {
if (normR[j] < tolEigenSolve) {
memcpy(X.Values() + knownEV*xr, KX.Values() + j*xr, xr*sizeof(double));
lambda[knownEV] = theta[j];
knownEV += 1;
}
}
if (localVerbose == 1) {
cout << endl;
cout.precision(2);
cout.setf(ios::scientific, ios::floatfield);
for (i=0; i<blockSize; ++i) {
cout << " Iteration " << outerIter << " - Scaled Norm of Residual " << i;
cout << " = " << normR[i] << endl;
}
cout << endl;
}
break;
} // if (knownEV + nFound >= numEigen)
// Treat the particular case of 1 block
if (maxBlock == 1) {
if (nFound > 0) {
double *Xpointer = X.Values() + (knownEV+nFound)*xr;
nFound = 0;
for (j = 0; j < blockSize; ++j) {
if (normR[j] < tolEigenSolve) {
memcpy(X.Values() + knownEV*xr, KX.Values() + j*xr, xr*sizeof(double));
lambda[knownEV] = theta[j];
knownEV += 1;
nFound += 1;
}
else {
memcpy(Xpointer + (j-nFound)*xr, KX.Values() + j*xr, xr*sizeof(double));
}
}
Epetra_MultiVector Xnext(View, X, knownEV + blockSize - nFound, nFound);
Xnext.Random();
}
else {
nFound = blockSize;
}
continue;
}
// Define the restarting block when maxBlock > 1
if (nFound > 0) {
int firstIndex = blockSize;
for (j = 0; j < blockSize; ++j) {
if (normR[j] >= tolEigenSolve) {
firstIndex = j;
break;
}
} // for (j = 0; j < blockSize; ++j)
while (firstIndex < nFound) {
for (j = firstIndex; j < blockSize; ++j) {
if (normR[j] < tolEigenSolve) {
// Swap the j-th and firstIndex-th position
callFortran.SWAP(nb*blockSize, S + j*dimSearch, 1, S + firstIndex*dimSearch, 1);
callFortran.SWAP(1, theta + j, 1, theta + firstIndex, 1);
callFortran.SWAP(1, normR + j, 1, normR + firstIndex, 1);
break;
}
} // for (j = firstIndex; j < blockSize; ++j)
for (j = 0; j < blockSize; ++j) {
if (normR[j] >= tolEigenSolve) {
firstIndex = j;
break;
}
} // for (j = 0; j < blockSize; ++j)
} // while (firstIndex < nFound)
// Copy the converged eigenvalues
memcpy(lambda + knownEV, theta, nFound*sizeof(double));
} // if (nFound > 0)
// Define the restarting size
bStart = ((nb - offSet) > 2) ? (nb - offSet)/2 : 0;
// Define the restarting space and local stiffness
timeRestart -= MyWatch.WallTime();
memset(KK, 0, nb*blockSize*dimSearch*sizeof(double));
for (j = 0; j < bStart*blockSize; ++j) {
KK[j + j*dimSearch] = theta[j + nFound];
}
// Form the restarting space
int oldCol = nb*blockSize;
int newCol = nFound + (bStart+1)*blockSize;
newCol = (newCol > oldCol) ? oldCol : newCol;
callFortran.GEQRF(oldCol, newCol, S, dimSearch, theta, R.Values(), xr*blockSize, &info);
callFortran.ORMQR('R', 'N', xr, oldCol, newCol, S, dimSearch, theta,
X.Values()+knownEV*xr, xr, R.Values(), blockSize*xr, &info);
timeRestart += MyWatch.WallTime();
if (nFound == 0)
offSet += 1;
knownEV += nFound;
maxBlock = (dimSearch/blockSize) - (knownEV/blockSize);
// Put random vectors if the Rayleigh Ritz vectors are not enough
newCol = nFound + (bStart+1)*blockSize;
if (newCol > oldCol) {
Epetra_MultiVector Xnext(View, X, knownEV+blockSize-nFound, nFound);
Xnext.Random();
continue;
}
nFound = 0;
} // while (outerIter <= maxIterEigenSolve)
timeOuterLoop += MyWatch.WallTime();
highMem = (highMem > currentSize()) ? highMem : currentSize();
// Clean memory
delete[] work1;
delete[] work2;
if (vectWeight)
delete vectWeight;
// Sort the eigenpairs
timePostProce -= MyWatch.WallTime();
if ((info == 0) && (knownEV > 0)) {
mySort.sortScalars_Vectors(knownEV, lambda, Q.Values(), Q.MyLength());
}
timePostProce += MyWatch.WallTime();
return (info == 0) ? knownEV : info;
}
char *
do_realpath(const char *upath)
{
char *xp, *ip, *tp, *ipath, *ldest = NULL;
XString xs;
size_t pos, len;
int llen;
struct stat sb;
#ifdef MKSH__NO_PATH_MAX
size_t ldestlen = 0;
#define pathlen sb.st_size
#define pathcnd (ldestlen < (pathlen + 1))
#else
#define pathlen PATH_MAX
#define pathcnd (!ldest)
#endif
/* max. recursion depth */
int symlinks = 32;
if (mksh_abspath(upath)) {
/* upath is an absolute pathname */
strdupx(ipath, upath, ATEMP);
} else {
/* upath is a relative pathname, prepend cwd */
if ((tp = ksh_get_wd()) == NULL || !mksh_abspath(tp))
return (NULL);
ipath = shf_smprintf("%s%s%s", tp, "/", upath);
afree(tp, ATEMP);
}
/* ipath and upath are in memory at the same time -> unchecked */
Xinit(xs, xp, strlen(ip = ipath) + 1, ATEMP);
/* now jump into the deep of the loop */
goto beginning_of_a_pathname;
while (*ip) {
/* skip slashes in input */
while (*ip == '/')
++ip;
if (!*ip)
break;
/* get next pathname component from input */
tp = ip;
while (*ip && *ip != '/')
++ip;
len = ip - tp;
/* check input for "." and ".." */
if (tp[0] == '.') {
if (len == 1)
/* just continue with the next one */
continue;
else if (len == 2 && tp[1] == '.') {
/* strip off last pathname component */
while (xp > Xstring(xs, xp))
if (*--xp == '/')
break;
/* then continue with the next one */
continue;
}
}
/* store output position away, then append slash to output */
pos = Xsavepos(xs, xp);
/* 1 for the '/' and len + 1 for tp and the NUL from below */
XcheckN(xs, xp, 1 + len + 1);
Xput(xs, xp, '/');
/* append next pathname component to output */
memcpy(xp, tp, len);
xp += len;
*xp = '\0';
/* lstat the current output, see if it's a symlink */
if (mksh_lstat(Xstring(xs, xp), &sb)) {
/* lstat failed */
if (errno == ENOENT) {
/* because the pathname does not exist */
while (*ip == '/')
/* skip any trailing slashes */
++ip;
/* no more components left? */
if (!*ip)
/* we can still return successfully */
break;
/* more components left? fall through */
}
/* not ENOENT or not at the end of ipath */
goto notfound;
}
/* check if we encountered a symlink? */
if (S_ISLNK(sb.st_mode)) {
#ifndef MKSH__NO_SYMLINK
/* reached maximum recursion depth? */
if (!symlinks--) {
/* yep, prevent infinite loops */
errno = ELOOP;
goto notfound;
}
/* get symlink(7) target */
if (pathcnd) {
#ifdef MKSH__NO_PATH_MAX
if (notoktoadd(pathlen, 1)) {
errno = ENAMETOOLONG;
goto notfound;
}
#endif
ldest = aresize(ldest, pathlen + 1, ATEMP);
}
llen = readlink(Xstring(xs, xp), ldest, pathlen);
if (llen < 0)
/* oops... */
goto notfound;
ldest[llen] = '\0';
/*
* restart if symlink target is an absolute path,
* otherwise continue with currently resolved prefix
*/
/* append rest of current input path to link target */
tp = shf_smprintf("%s%s%s", ldest, *ip ? "/" : "", ip);
afree(ipath, ATEMP);
ip = ipath = tp;
if (!mksh_abspath(ldest)) {
/* symlink target is a relative path */
xp = Xrestpos(xs, xp, pos);
} else
#endif
{
/* symlink target is an absolute path */
xp = Xstring(xs, xp);
beginning_of_a_pathname:
/* assert: (ip == ipath)[0] == '/' */
/* assert: xp == xs.beg => start of path */
/* exactly two leading slashes? (SUSv4 3.266) */
if (ip[1] == '/' && ip[2] != '/') {
/* keep them, e.g. for UNC pathnames */
Xput(xs, xp, '/');
}
}
}
/* otherwise (no symlink) merely go on */
}
/*
* either found the target and successfully resolved it,
* or found its parent directory and may create it
*/
if (Xlength(xs, xp) == 0)
/*
* if the resolved pathname is "", make it "/",
* otherwise do not add a trailing slash
*/
Xput(xs, xp, '/');
Xput(xs, xp, '\0');
/*
* if source path had a trailing slash, check if target path
* is not a non-directory existing file
*/
if (ip > ipath && ip[-1] == '/') {
if (stat(Xstring(xs, xp), &sb)) {
if (errno != ENOENT)
goto notfound;
} else if (!S_ISDIR(sb.st_mode)) {
errno = ENOTDIR;
goto notfound;
}
/* target now either does not exist or is a directory */
}
/* return target path */
if (ldest != NULL)
afree(ldest, ATEMP);
afree(ipath, ATEMP);
return (Xclose(xs, xp));
notfound:
/* save; freeing memory might trash it */
llen = errno;
if (ldest != NULL)
afree(ldest, ATEMP);
afree(ipath, ATEMP);
Xfree(xs, xp);
errno = llen;
return (NULL);
#undef pathlen
#undef pathcnd
}
/* Construction de l'interface graphique */
void BuildGUI(int IsFather)
{
int i;
if (scriptprop->font==NULL)
x11base->font=strdup("fixed");
else
x11base->font=scriptprop->font;
if (scriptprop->forecolor==NULL)
x11base->forecolor=strdup("black");
else
x11base->forecolor=scriptprop->forecolor;
if (scriptprop->backcolor==NULL)
x11base->backcolor=strdup("white");
else
x11base->backcolor=scriptprop->backcolor;
if (scriptprop->shadcolor==NULL)
x11base->shadcolor=strdup("black");
else
x11base->shadcolor=scriptprop->shadcolor;
if (scriptprop->licolor==NULL)
x11base->licolor=strdup("black");
else
x11base->licolor=scriptprop->licolor;
x11base->icon=scriptprop->icon;
x11base->size.x=scriptprop->x;
x11base->size.y=scriptprop->y;
x11base->size.width=scriptprop->width;
x11base->size.height=scriptprop->height;
x11base->title=scriptprop->titlewin;
/* Initialisation du serveur X et de la fenetre */
Xinit(IsFather);
OpenWindow();
/* Parcour de tous les objets graphiques */
nbobj++;
for (i=0;i<nbobj;i++)
{
tabxobj[i]=(struct XObj*)calloc(1,sizeof(struct XObj));
tabxobj[i]->id=(*tabobj)[i].id;
tabxobj[i]->x=(*tabobj)[i].x;
tabxobj[i]->y=(*tabobj)[i].y;
tabxobj[i]->width=(*tabobj)[i].width;
tabxobj[i]->height=(*tabobj)[i].height;
if (tabxobj[i]->width==0) tabxobj[i]->width=1;
if (tabxobj[i]->height==0) tabxobj[i]->height=1;
tabxobj[i]->value=(*tabobj)[i].value;
tabxobj[i]->value2=(*tabobj)[i].value2;
tabxobj[i]->value3=(*tabobj)[i].value3;
tabxobj[i]->flags[0]=(*tabobj)[i].flags[0];
tabxobj[i]->flags[1]=(*tabobj)[i].flags[1];
tabxobj[i]->flags[2]=(*tabobj)[i].flags[2];
tabxobj[i]->icon=(*tabobj)[i].icon;
tabxobj[i]->swallow=(*tabobj)[i].swallow;
if ((*tabobj)[i].title==NULL)
tabxobj[i]->title=(char*)calloc(1,200);
else
tabxobj[i]->title=(*tabobj)[i].title;
if ((*tabobj)[i].font==NULL)
tabxobj[i]->font=(char*)strdup(x11base->font);
else
tabxobj[i]->font=(*tabobj)[i].font;
if ((*tabobj)[i].forecolor==NULL)
tabxobj[i]->forecolor=(char*)strdup(x11base->forecolor);
else
tabxobj[i]->forecolor=(*tabobj)[i].forecolor;
if ((*tabobj)[i].backcolor==NULL)
tabxobj[i]->backcolor=(char*)strdup(x11base->backcolor);
else
tabxobj[i]->backcolor=(*tabobj)[i].backcolor;
if ((*tabobj)[i].shadcolor==NULL)
tabxobj[i]->shadcolor=(char*)strdup(x11base->shadcolor);
else
tabxobj[i]->shadcolor=(*tabobj)[i].shadcolor;
if ((*tabobj)[i].licolor==NULL)
tabxobj[i]->licolor=strdup(x11base->licolor);
else
tabxobj[i]->licolor=(*tabobj)[i].licolor;
ChooseFunction(tabxobj[i],(*tabobj)[i].type);
tabxobj[i]->gc=x11base->gc;
tabxobj[i]->display=x11base->display;
tabxobj[i]->ParentWin=&(x11base->win);
tabxobj[i]->Screen=x11base->screen;
tabxobj[i]->colormap=&(x11base->colormap);
tabxobj[i]->iconPixmap=None;
tabxobj[i]->icon_maskPixmap=None;
LoadIcon(tabxobj[i]); /* Chargement de l'icone du widget */
tabxobj[i]->InitObj(tabxobj[i]);
}
/* Enregistrement du bloc de taches periodic */
x11base->periodictasks=scriptprop->periodictasks;
/*Si un bloc d'initialisation du script existe, on l'execute ici */
if (scriptprop->initbloc!=NULL)
{
ExecBloc(scriptprop->initbloc);
free(scriptprop->initbloc->TabInstr);
free(scriptprop->initbloc);
}
free(tabobj);
free(scriptprop);
XMapRaised(x11base->display,x11base->win);
for (i=0;i<nbobj;i++)
if (tabxobj[i]->flags[0]!=True)
XMapWindow(x11base->display,tabxobj[i]->win);
}
static void
glob_path(int flags, const char *pat, XPtrV *wp, const char *path)
{
const char *sp, *p;
char *xp;
int staterr;
int pathlen;
int patlen;
int oldsize, newsize, i, j;
char **words;
XString xs;
patlen = strlen(pat) + 1;
sp = path;
Xinit(xs, xp, patlen + 128, ATEMP);
while (sp) {
xp = Xstring(xs, xp);
if (!(p = strchr(sp, ':')))
p = sp + strlen(sp);
pathlen = p - sp;
if (pathlen) {
/* Copy sp into xp, stuffing any MAGIC characters
* on the way
*/
const char *s = sp;
XcheckN(xs, xp, pathlen * 2);
while (s < p) {
if (ISMAGIC(*s))
*xp++ = MAGIC;
*xp++ = *s++;
}
*xp++ = '/';
pathlen++;
}
sp = p;
XcheckN(xs, xp, patlen);
memcpy(xp, pat, patlen);
oldsize = XPsize(*wp);
glob_str(Xstring(xs, xp), wp, 1); /* mark dirs */
newsize = XPsize(*wp);
/* Check that each match is executable... */
words = (char **) XPptrv(*wp);
for (i = j = oldsize; i < newsize; i++) {
staterr = 0;
if ((search_access(words[i], X_OK, &staterr) >= 0) ||
(staterr == EISDIR)) {
words[j] = words[i];
if (!(flags & XCF_FULLPATH))
memmove(words[j], words[j] + pathlen,
strlen(words[j] + pathlen) + 1);
j++;
} else
afree(words[i], ATEMP);
}
wp->cur = (void **) &words[j];
if (!*sp++)
break;
}
Xfree(xs, xp);
}
int
yylex(int cf)
{
Lex_state states[STATE_BSIZE], *statep;
State_info state_info;
int c, state;
XString ws; /* expandable output word */
char *wp; /* output word pointer */
char *sp, *dp;
int c2;
Again:
states[0].ls_state = -1;
states[0].ls_info.base = (Lex_state *) 0;
statep = &states[1];
state_info.base = states;
state_info.end = &states[STATE_BSIZE];
Xinit(ws, wp, 64, ATEMP);
backslash_skip = 0;
ignore_backslash_newline = 0;
if (cf&ONEWORD)
state = SWORD;
else if (cf&LETEXPR) {
*wp++ = OQUOTE; /* enclose arguments in (double) quotes */
state = SLETPAREN;
statep->ls_sletparen.nparen = 0;
} else { /* normal lexing */
state = (cf & HEREDELIM) ? SHEREDELIM : SBASE;
while ((c = getsc()) == ' ' || c == '\t')
;
if (c == '#') {
ignore_backslash_newline++;
while ((c = getsc()) != '\0' && c != '\n')
;
ignore_backslash_newline--;
}
ungetsc(c);
}
if (source->flags & SF_ALIAS) { /* trailing ' ' in alias definition */
source->flags &= ~SF_ALIAS;
/* In POSIX mode, a trailing space only counts if we are
* parsing a simple command
*/
if (!Flag(FPOSIX) || (cf & CMDWORD))
cf |= ALIAS;
}
/* Initial state: one of SBASE SHEREDELIM SWORD SASPAREN */
statep->ls_state = state;
/* collect non-special or quoted characters to form word */
while (!((c = getsc()) == 0
|| ((state == SBASE || state == SHEREDELIM)
&& ctype(c, C_LEX1))))
{
Xcheck(ws, wp);
switch (state) {
case SBASE:
if (Flag(FCSHHISTORY) && (source->flags & SF_TTY) && c == '!') {
char **replace = NULL;
c2 = getsc();
if (c2 == '\0')
;
else if (c2 == ' ' || c2 == '\t')
ungetsc(c2);
else if (c2 == '!')
replace = hist_get_newest(0);
else if (isdigit(c2) || c2 == '-' ||
isalpha(c2)) {
int get = !isalpha(c2);
char match[200], *str = match;
*str++ = c2;
do {
if ((c2 = getsc()) == '\0')
break;
if (c2 == '\t' || c2 == ' ' ||
c2 == '\n') {
ungetsc(c2);
break;
}
*str++ = c2;
} while (str < &match[sizeof(match)-1]);
*str = '\0';
if (get) {
int h = findhistrel(match);
if (h >= 0)
replace = &history[h];
} else {
int h = findhist(-1, 0, match, true);
if (h >= 0)
replace = &history[h];
}
}
/*
* XXX ksh history buffer saves un-expanded
* commands. Until the history buffer code is
* changed to contain expanded commands, we
* ignore the bad commands (spinning sucks)
*/
if (replace && **replace == '!')
ungetsc(c2);
else if (replace) {
Source *s;
/* do not strdup replacement via alloc */
s = pushs(SREREAD,
source->areap);
s->start = s->str = *replace;
s->next = source;
source = s;
continue;
} else
ungetsc(c2);
}
if (c == '[' && (cf & (VARASN|ARRAYVAR))) {
*wp = EOS; /* temporary */
if (is_wdvarname(Xstring(ws, wp), false))
{
char *p, *tmp;
if (arraysub(&tmp)) {
*wp++ = CHAR;
*wp++ = c;
for (p = tmp; *p; ) {
Xcheck(ws, wp);
*wp++ = CHAR;
*wp++ = *p++;
}
afree(tmp, ATEMP);
break;
} else {
Source *s;
s = pushs(SREREAD,
source->areap);
s->start = s->str
= s->u.freeme = tmp;
s->next = source;
source = s;
}
}
*wp++ = CHAR;
*wp++ = c;
break;
}
/* fall through.. */
Sbase1: /* includes *(...|...) pattern (*+?@!) */
if (c == '*' || c == '@' || c == '+' || c == '?'
|| c == '!')
{
c2 = getsc();
if (c2 == '(' /*)*/ ) {
*wp++ = OPAT;
*wp++ = c;
PUSH_STATE(SPATTERN);
break;
}
ungetsc(c2);
}
/* fall through.. */
Sbase2: /* doesn't include *(...|...) pattern (*+?@!) */
switch (c) {
case '\\':
c = getsc();
if (c) /* trailing \ is lost */
*wp++ = QCHAR, *wp++ = c;
break;
case '\'':
*wp++ = OQUOTE;
ignore_backslash_newline++;
PUSH_STATE(SSQUOTE);
break;
case '"':
*wp++ = OQUOTE;
PUSH_STATE(SDQUOTE);
break;
default:
goto Subst;
}
break;
Subst:
switch (c) {
case '\\':
c = getsc();
switch (c) {
case '"': case '\\':
case '$': case '`':
*wp++ = QCHAR, *wp++ = c;
break;
default:
Xcheck(ws, wp);
if (c) { /* trailing \ is lost */
*wp++ = CHAR, *wp++ = '\\';
*wp++ = CHAR, *wp++ = c;
}
break;
}
break;
case '$':
c = getsc();
if (c == '(') /*)*/ {
c = getsc();
if (c == '(') /*)*/ {
PUSH_STATE(SASPAREN);
statep->ls_sasparen.nparen = 2;
statep->ls_sasparen.start =
Xsavepos(ws, wp);
*wp++ = EXPRSUB;
} else {
ungetsc(c);
PUSH_STATE(SCSPAREN);
statep->ls_scsparen.nparen = 1;
statep->ls_scsparen.csstate = 0;
*wp++ = COMSUB;
}
} else if (c == '{') /*}*/ {
*wp++ = OSUBST;
*wp++ = '{'; /*}*/
wp = get_brace_var(&ws, wp);
c = getsc();
/* allow :# and :% (ksh88 compat) */
if (c == ':') {
*wp++ = CHAR, *wp++ = c;
c = getsc();
}
/* If this is a trim operation,
* treat (,|,) specially in STBRACE.
*/
if (c == '#' || c == '%') {
ungetsc(c);
PUSH_STATE(STBRACE);
} else {
ungetsc(c);
PUSH_STATE(SBRACE);
}
} else if (ctype(c, C_ALPHA)) {
*wp++ = OSUBST;
*wp++ = 'X';
do {
Xcheck(ws, wp);
*wp++ = c;
c = getsc();
} while (ctype(c, C_ALPHA|C_DIGIT));
*wp++ = '\0';
*wp++ = CSUBST;
*wp++ = 'X';
ungetsc(c);
} else if (ctype(c, C_DIGIT|C_VAR1)) {
Xcheck(ws, wp);
*wp++ = OSUBST;
*wp++ = 'X';
*wp++ = c;
*wp++ = '\0';
*wp++ = CSUBST;
*wp++ = 'X';
} else {
*wp++ = CHAR, *wp++ = '$';
ungetsc(c);
}
break;
case '`':
PUSH_STATE(SBQUOTE);
*wp++ = COMSUB;
/* Need to know if we are inside double quotes
* since sh/at&t-ksh translate the \" to " in
* "`..\"..`".
* This is not done in posix mode (section
* 3.2.3, Double Quotes: "The backquote shall
* retain its special meaning introducing the
* other form of command substitution (see
* 3.6.3). The portion of the quoted string
* from the initial backquote and the
* characters up to the next backquote that
* is not preceded by a backslash (having
* escape characters removed) defines that
* command whose output replaces `...` when
* the word is expanded."
* Section 3.6.3, Command Substitution:
* "Within the backquoted style of command
* substitution, backslash shall retain its
* literal meaning, except when followed by
* $ ` \.").
*/
statep->ls_sbquote.indquotes = 0;
if (!Flag(FPOSIX)) {
Lex_state *s = statep;
Lex_state *base = state_info.base;
while (1) {
for (; s != base; s--) {
if (s->ls_state == SDQUOTE) {
statep->ls_sbquote.indquotes = 1;
break;
}
}
if (s != base)
break;
if (!(s = s->ls_info.base))
break;
base = s-- - STATE_BSIZE;
}
}
break;
default:
*wp++ = CHAR, *wp++ = c;
}
break;
case SSQUOTE:
if (c == '\'') {
POP_STATE();
*wp++ = CQUOTE;
ignore_backslash_newline--;
} else
*wp++ = QCHAR, *wp++ = c;
break;
case SDQUOTE:
if (c == '"') {
POP_STATE();
*wp++ = CQUOTE;
} else
goto Subst;
break;
case SCSPAREN: /* $( .. ) */
/* todo: deal with $(...) quoting properly
* kludge to partly fake quoting inside $(..): doesn't
* really work because nested $(..) or ${..} inside
* double quotes aren't dealt with.
*/
switch (statep->ls_scsparen.csstate) {
case 0: /* normal */
switch (c) {
case '(':
statep->ls_scsparen.nparen++;
break;
case ')':
statep->ls_scsparen.nparen--;
break;
case '\\':
statep->ls_scsparen.csstate = 1;
break;
case '"':
statep->ls_scsparen.csstate = 2;
break;
case '\'':
statep->ls_scsparen.csstate = 4;
ignore_backslash_newline++;
break;
}
break;
case 1: /* backslash in normal mode */
case 3: /* backslash in double quotes */
--statep->ls_scsparen.csstate;
break;
case 2: /* double quotes */
if (c == '"')
statep->ls_scsparen.csstate = 0;
else if (c == '\\')
statep->ls_scsparen.csstate = 3;
break;
case 4: /* single quotes */
if (c == '\'') {
statep->ls_scsparen.csstate = 0;
ignore_backslash_newline--;
}
break;
}
if (statep->ls_scsparen.nparen == 0) {
POP_STATE();
*wp++ = 0; /* end of COMSUB */
} else
*wp++ = c;
break;
case SASPAREN: /* $(( .. )) */
/* todo: deal with $((...); (...)) properly */
/* XXX should nest using existing state machine
* (embed "..", $(...), etc.) */
if (c == '(')
statep->ls_sasparen.nparen++;
else if (c == ')') {
statep->ls_sasparen.nparen--;
if (statep->ls_sasparen.nparen == 1) {
/*(*/
if ((c2 = getsc()) == ')') {
POP_STATE();
*wp++ = 0; /* end of EXPRSUB */
break;
} else {
char *s;
ungetsc(c2);
/* mismatched parenthesis -
* assume we were really
* parsing a $(..) expression
*/
s = Xrestpos(ws, wp,
statep->ls_sasparen.start);
memmove(s + 1, s, wp - s);
*s++ = COMSUB;
*s = '('; /*)*/
wp++;
statep->ls_scsparen.nparen = 1;
statep->ls_scsparen.csstate = 0;
state = statep->ls_state
= SCSPAREN;
}
}
}
*wp++ = c;
break;
case SBRACE:
/*{*/
if (c == '}') {
POP_STATE();
*wp++ = CSUBST;
*wp++ = /*{*/ '}';
} else
goto Sbase1;
break;
case STBRACE:
/* Same as SBRACE, except (,|,) treated specially */
/*{*/
if (c == '}') {
POP_STATE();
*wp++ = CSUBST;
*wp++ = /*{*/ '}';
} else if (c == '|') {
*wp++ = SPAT;
} else if (c == '(') {
*wp++ = OPAT;
*wp++ = ' '; /* simile for @ */
PUSH_STATE(SPATTERN);
} else
goto Sbase1;
break;
case SBQUOTE:
if (c == '`') {
*wp++ = 0;
POP_STATE();
} else if (c == '\\') {
switch (c = getsc()) {
case '\\':
case '$': case '`':
*wp++ = c;
break;
case '"':
if (statep->ls_sbquote.indquotes) {
*wp++ = c;
break;
}
/* fall through.. */
default:
if (c) { /* trailing \ is lost */
*wp++ = '\\';
*wp++ = c;
}
break;
}
} else
*wp++ = c;
break;
case SWORD: /* ONEWORD */
goto Subst;
case SLETPAREN: /* LETEXPR: (( ... )) */
/*(*/
if (c == ')') {
if (statep->ls_sletparen.nparen > 0)
--statep->ls_sletparen.nparen;
/*(*/
else if ((c2 = getsc()) == ')') {
c = 0;
*wp++ = CQUOTE;
goto Done;
} else
ungetsc(c2);
} else if (c == '(')
/* parenthesis inside quotes and backslashes
* are lost, but at&t ksh doesn't count them
* either
*/
++statep->ls_sletparen.nparen;
goto Sbase2;
case SHEREDELIM: /* <<,<<- delimiter */
/* XXX chuck this state (and the next) - use
* the existing states ($ and \`..` should be
* stripped of their specialness after the
* fact).
*/
/* here delimiters need a special case since
* $ and `..` are not to be treated specially
*/
if (c == '\\') {
c = getsc();
if (c) { /* trailing \ is lost */
*wp++ = QCHAR;
*wp++ = c;
}
} else if (c == '\'') {
PUSH_STATE(SSQUOTE);
*wp++ = OQUOTE;
ignore_backslash_newline++;
} else if (c == '"') {
state = statep->ls_state = SHEREDQUOTE;
*wp++ = OQUOTE;
} else {
*wp++ = CHAR;
*wp++ = c;
}
break;
case SHEREDQUOTE: /* " in <<,<<- delimiter */
if (c == '"') {
*wp++ = CQUOTE;
state = statep->ls_state = SHEREDELIM;
} else {
if (c == '\\') {
switch (c = getsc()) {
case '\\': case '"':
case '$': case '`':
break;
default:
if (c) { /* trailing \ lost */
*wp++ = CHAR;
*wp++ = '\\';
}
break;
}
}
*wp++ = CHAR;
*wp++ = c;
}
break;
case SPATTERN: /* in *(...|...) pattern (*+?@!) */
if ( /*(*/ c == ')') {
*wp++ = CPAT;
POP_STATE();
} else if (c == '|') {
*wp++ = SPAT;
} else if (c == '(') {
*wp++ = OPAT;
*wp++ = ' '; /* simile for @ */
PUSH_STATE(SPATTERN);
} else
goto Sbase1;
break;
}
}
Done:
Xcheck(ws, wp);
if (statep != &states[1])
/* XXX figure out what is missing */
yyerror("no closing quote\n");
/* This done to avoid tests for SHEREDELIM wherever SBASE tested */
if (state == SHEREDELIM)
state = SBASE;
dp = Xstring(ws, wp);
if ((c == '<' || c == '>') && state == SBASE
&& ((c2 = Xlength(ws, wp)) == 0
|| (c2 == 2 && dp[0] == CHAR && digit(dp[1]))))
{
struct ioword *iop =
(struct ioword *) alloc(sizeof(*iop), ATEMP);
if (c2 == 2)
iop->unit = dp[1] - '0';
else
iop->unit = c == '>'; /* 0 for <, 1 for > */
c2 = getsc();
/* <<, >>, <> are ok, >< is not */
if (c == c2 || (c == '<' && c2 == '>')) {
iop->flag = c == c2 ?
(c == '>' ? IOCAT : IOHERE) : IORDWR;
if (iop->flag == IOHERE) {
if ((c2 = getsc()) == '-')
iop->flag |= IOSKIP;
else
ungetsc(c2);
}
} else if (c2 == '&')
iop->flag = IODUP | (c == '<' ? IORDUP : 0);
else {
iop->flag = c == '>' ? IOWRITE : IOREAD;
if (c == '>' && c2 == '|')
iop->flag |= IOCLOB;
else
ungetsc(c2);
}
iop->name = (char *) 0;
iop->delim = (char *) 0;
iop->heredoc = (char *) 0;
Xfree(ws, wp); /* free word */
yylval.iop = iop;
return REDIR;
}
if (wp == dp && state == SBASE) {
Xfree(ws, wp); /* free word */
/* no word, process LEX1 character */
switch (c) {
default:
return c;
case '|':
case '&':
case ';':
if ((c2 = getsc()) == c)
c = (c == ';') ? BREAK :
(c == '|') ? LOGOR :
(c == '&') ? LOGAND :
YYERRCODE;
else if (c == '|' && c2 == '&')
c = COPROC;
else
ungetsc(c2);
return c;
case '\n':
gethere();
if (cf & CONTIN)
goto Again;
return c;
case '(': /*)*/
if (!Flag(FSH)) {
if ((c2 = getsc()) == '(') /*)*/
/* XXX need to handle ((...); (...)) */
c = MDPAREN;
else
ungetsc(c2);
}
return c;
/*(*/
case ')':
return c;
}
}
*wp++ = EOS; /* terminate word */
yylval.cp = Xclose(ws, wp);
if (state == SWORD || state == SLETPAREN) /* ONEWORD? */
return LWORD;
ungetsc(c); /* unget terminator */
/* copy word to unprefixed string ident */
for (sp = yylval.cp, dp = ident; dp < ident+IDENT && (c = *sp++) == CHAR; )
*dp++ = *sp++;
/* Make sure the ident array stays '\0' padded */
memset(dp, 0, (ident+IDENT) - dp + 1);
if (c != EOS)
*ident = '\0'; /* word is not unquoted */
if (*ident != '\0' && (cf&(KEYWORD|ALIAS))) {
struct tbl *p;
int h = hash(ident);
/* { */
if ((cf & KEYWORD) && (p = tsearch(&keywords, ident, h))
&& (!(cf & ESACONLY) || p->val.i == ESAC || p->val.i == '}'))
{
afree(yylval.cp, ATEMP);
return p->val.i;
}
if ((cf & ALIAS) && (p = tsearch(&aliases, ident, h))
&& (p->flag & ISSET))
{
Source *s;
for (s = source; s->type == SALIAS; s = s->next)
if (s->u.tblp == p)
return LWORD;
/* push alias expansion */
s = pushs(SALIAS, source->areap);
s->start = s->str = p->val.s;
s->u.tblp = p;
s->next = source;
source = s;
afree(yylval.cp, ATEMP);
goto Again;
}
}
return LWORD;
}
int
yylex(int cf)
{
Lex_state states[STATE_BSIZE], *statep, *s2, *base;
State_info state_info;
int c, c2, state;
size_t cz;
XString ws; /* expandable output word */
char *wp; /* output word pointer */
char *sp, *dp;
Again:
states[0].type = SINVALID;
states[0].ls_base = NULL;
statep = &states[1];
state_info.base = states;
state_info.end = &state_info.base[STATE_BSIZE];
Xinit(ws, wp, 64, ATEMP);
backslash_skip = 0;
ignore_backslash_newline = 0;
if (cf & ONEWORD)
state = SWORD;
else if (cf & LETEXPR) {
/* enclose arguments in (double) quotes */
*wp++ = OQUOTE;
state = SLETPAREN;
statep->nparen = 0;
} else {
/* normal lexing */
state = (cf & HEREDELIM) ? SHEREDELIM : SBASE;
while ((c = getsc()) == ' ' || c == '\t')
;
if (c == '#') {
ignore_backslash_newline++;
while ((c = getsc()) != '\0' && c != '\n')
;
ignore_backslash_newline--;
}
ungetsc(c);
}
if (source->flags & SF_ALIAS) {
/* trailing ' ' in alias definition */
source->flags &= ~SF_ALIAS;
/* POSIX: trailing space only counts if parsing simple cmd */
if (!Flag(FPOSIX) || (cf & CMDWORD))
cf |= ALIAS;
}
/* Initial state: one of SWORD SLETPAREN SHEREDELIM SBASE */
statep->type = state;
/* collect non-special or quoted characters to form word */
while (!((c = getsc()) == 0 ||
((state == SBASE || state == SHEREDELIM) && ctype(c, C_LEX1)))) {
if (state == SBASE &&
subshell_nesting_type == /*{*/ '}' &&
c == /*{*/ '}')
/* possibly end ${ :;} */
break;
Xcheck(ws, wp);
switch (state) {
case SADELIM:
if (c == '(')
statep->nparen++;
else if (c == ')')
statep->nparen--;
else if (statep->nparen == 0 && (c == /*{*/ '}' ||
c == (int)statep->ls_adelim.delimiter)) {
*wp++ = ADELIM;
*wp++ = c;
if (c == /*{*/ '}' || --statep->ls_adelim.num == 0)
POP_STATE();
if (c == /*{*/ '}')
POP_STATE();
break;
}
/* FALLTHROUGH */
case SBASE:
if (c == '[' && (cf & (VARASN|ARRAYVAR))) {
/* temporary */
*wp = EOS;
if (is_wdvarname(Xstring(ws, wp), false)) {
char *p, *tmp;
if (arraysub(&tmp)) {
*wp++ = CHAR;
*wp++ = c;
for (p = tmp; *p; ) {
Xcheck(ws, wp);
*wp++ = CHAR;
*wp++ = *p++;
}
afree(tmp, ATEMP);
break;
} else {
Source *s;
s = pushs(SREREAD,
source->areap);
s->start = s->str =
s->u.freeme = tmp;
s->next = source;
source = s;
}
}
*wp++ = CHAR;
*wp++ = c;
break;
}
/* FALLTHROUGH */
Sbase1: /* includes *(...|...) pattern (*+?@!) */
if (c == '*' || c == '@' || c == '+' || c == '?' ||
c == '!') {
c2 = getsc();
if (c2 == '(' /*)*/ ) {
*wp++ = OPAT;
*wp++ = c;
PUSH_STATE(SPATTERN);
break;
}
ungetsc(c2);
}
/* FALLTHROUGH */
Sbase2: /* doesn't include *(...|...) pattern (*+?@!) */
switch (c) {
case '\\':
getsc_qchar:
if ((c = getsc())) {
/* trailing \ is lost */
*wp++ = QCHAR;
*wp++ = c;
}
break;
case '\'':
open_ssquote_unless_heredoc:
if ((cf & HEREDOC))
goto store_char;
*wp++ = OQUOTE;
ignore_backslash_newline++;
PUSH_STATE(SSQUOTE);
break;
case '"':
open_sdquote:
*wp++ = OQUOTE;
PUSH_STATE(SDQUOTE);
break;
case '$':
/*
* processing of dollar sign belongs into
* Subst, except for those which can open
* a string: $'…' and $"…"
*/
subst_dollar_ex:
c = getsc();
switch (c) {
case '"':
goto open_sdquote;
case '\'':
goto open_sequote;
default:
goto SubstS;
}
default:
goto Subst;
}
break;
Subst:
switch (c) {
case '\\':
c = getsc();
switch (c) {
case '"':
if ((cf & HEREDOC))
goto heredocquote;
/* FALLTHROUGH */
case '\\':
case '$': case '`':
store_qchar:
*wp++ = QCHAR;
*wp++ = c;
break;
default:
heredocquote:
Xcheck(ws, wp);
if (c) {
/* trailing \ is lost */
*wp++ = CHAR;
*wp++ = '\\';
*wp++ = CHAR;
*wp++ = c;
}
break;
}
break;
case '$':
c = getsc();
SubstS:
if (c == '(') /*)*/ {
c = getsc();
if (c == '(') /*)*/ {
*wp++ = EXPRSUB;
PUSH_SRETRACE(SASPAREN);
statep->nparen = 2;
*retrace_info->xp++ = '(';
} else {
ungetsc(c);
subst_command:
c = COMSUB;
subst_command2:
sp = yyrecursive(c);
cz = strlen(sp) + 1;
XcheckN(ws, wp, cz);
*wp++ = c;
memcpy(wp, sp, cz);
wp += cz;
}
} else if (c == '{') /*}*/ {
if ((c = getsc()) == '|') {
/*
* non-subenvironment
* value substitution
*/
c = VALSUB;
goto subst_command2;
} else if (ctype(c, C_IFSWS)) {
/*
* non-subenvironment
* "command" substitution
*/
c = FUNSUB;
goto subst_command2;
}
ungetsc(c);
*wp++ = OSUBST;
*wp++ = '{'; /*}*/
wp = get_brace_var(&ws, wp);
c = getsc();
/* allow :# and :% (ksh88 compat) */
if (c == ':') {
*wp++ = CHAR;
*wp++ = c;
c = getsc();
if (c == ':') {
*wp++ = CHAR;
*wp++ = '0';
*wp++ = ADELIM;
*wp++ = ':';
PUSH_STATE(SBRACE);
PUSH_STATE(SADELIM);
statep->ls_adelim.delimiter = ':';
statep->ls_adelim.num = 1;
statep->nparen = 0;
break;
} else if (ksh_isdigit(c) ||
c == '('/*)*/ || c == ' ' ||
/*XXX what else? */
c == '$') {
/* substring subst. */
if (c != ' ') {
*wp++ = CHAR;
*wp++ = ' ';
}
ungetsc(c);
PUSH_STATE(SBRACE);
PUSH_STATE(SADELIM);
statep->ls_adelim.delimiter = ':';
statep->ls_adelim.num = 2;
statep->nparen = 0;
break;
}
} else if (c == '/') {
*wp++ = CHAR;
*wp++ = c;
if ((c = getsc()) == '/') {
*wp++ = ADELIM;
*wp++ = c;
} else
ungetsc(c);
PUSH_STATE(SBRACE);
PUSH_STATE(SADELIM);
statep->ls_adelim.delimiter = '/';
statep->ls_adelim.num = 1;
statep->nparen = 0;
break;
}
/*
* If this is a trim operation,
* treat (,|,) specially in STBRACE.
*/
if (ctype(c, C_SUBOP2)) {
ungetsc(c);
if (Flag(FSH))
PUSH_STATE(STBRACEBOURNE);
else
PUSH_STATE(STBRACEKORN);
} else {
ungetsc(c);
if (state == SDQUOTE ||
state == SQBRACE)
PUSH_STATE(SQBRACE);
else
PUSH_STATE(SBRACE);
}
} else if (ksh_isalphx(c)) {
*wp++ = OSUBST;
*wp++ = 'X';
do {
Xcheck(ws, wp);
*wp++ = c;
c = getsc();
} while (ksh_isalnux(c));
*wp++ = '\0';
*wp++ = CSUBST;
*wp++ = 'X';
ungetsc(c);
} else if (ctype(c, C_VAR1 | C_DIGIT)) {
Xcheck(ws, wp);
*wp++ = OSUBST;
*wp++ = 'X';
*wp++ = c;
*wp++ = '\0';
*wp++ = CSUBST;
*wp++ = 'X';
} else {
*wp++ = CHAR;
*wp++ = '$';
ungetsc(c);
}
break;
case '`':
subst_gravis:
PUSH_STATE(SBQUOTE);
*wp++ = COMSUB;
/*
* We need to know whether we are within double
* quotes, since most shells translate \" to "
* within "…`…\"…`…". This is not done in POSIX
* mode (§2.2.3 Double-Quotes: “The backquote
* shall retain its special meaning introducing
* the other form of command substitution (see
* Command Substitution). The portion of the
* quoted string from the initial backquote and
* the characters up to the next backquote that
* is not preceded by a <backslash>, having
* escape characters removed, defines that
* command whose output replaces "`...`" when
* the word is expanded.”; §2.6.3 Command
* Substitution: “Within the backquoted style
* of command substitution, <backslash> shall
* retain its literal meaning, except when
* followed by: '$', '`', or <backslash>. The
* search for the matching backquote shall be
* satisfied by the first unquoted non-escaped
* backquote; during this search, if a
* non-escaped backquote is encountered[…],
* undefined results occur.”).
*/
statep->ls_bool = false;
if (Flag(FPOSIX))
break;
s2 = statep;
base = state_info.base;
while (/* CONSTCOND */ 1) {
for (; s2 != base; s2--) {
if (s2->type == SDQUOTE) {
statep->ls_bool = true;
break;
}
}
if (s2 != base)
break;
if (!(s2 = s2->ls_base))
break;
base = s2-- - STATE_BSIZE;
}
break;
case QCHAR:
if (cf & LQCHAR) {
*wp++ = QCHAR;
*wp++ = getsc();
break;
}
/* FALLTHROUGH */
default:
store_char:
*wp++ = CHAR;
*wp++ = c;
}
break;
case SEQUOTE:
if (c == '\'') {
POP_STATE();
*wp++ = CQUOTE;
ignore_backslash_newline--;
} else if (c == '\\') {
if ((c2 = unbksl(true, s_get, s_put)) == -1)
c2 = s_get();
if (c2 == 0)
statep->ls_bool = true;
if (!statep->ls_bool) {
char ts[4];
if ((unsigned int)c2 < 0x100) {
*wp++ = QCHAR;
*wp++ = c2;
} else {
cz = utf_wctomb(ts, c2 - 0x100);
ts[cz] = 0;
cz = 0;
do {
*wp++ = QCHAR;
*wp++ = ts[cz];
} while (ts[++cz]);
}
}
} else if (!statep->ls_bool) {
*wp++ = QCHAR;
*wp++ = c;
}
break;
case SSQUOTE:
if (c == '\'') {
POP_STATE();
if ((cf & HEREDOC) || state == SQBRACE)
goto store_char;
*wp++ = CQUOTE;
ignore_backslash_newline--;
} else {
*wp++ = QCHAR;
*wp++ = c;
}
break;
case SDQUOTE:
if (c == '"') {
POP_STATE();
*wp++ = CQUOTE;
} else
goto Subst;
break;
/* $(( ... )) */
case SASPAREN:
if (c == '(')
statep->nparen++;
else if (c == ')') {
statep->nparen--;
if (statep->nparen == 1) {
/* end of EXPRSUB */
POP_SRETRACE();
if ((c2 = getsc()) == /*(*/ ')') {
cz = strlen(sp) - 2;
XcheckN(ws, wp, cz);
memcpy(wp, sp + 1, cz);
wp += cz;
afree(sp, ATEMP);
*wp++ = '\0';
break;
} else {
Source *s;
ungetsc(c2);
/*
* mismatched parenthesis -
* assume we were really
* parsing a $(...) expression
*/
--wp;
s = pushs(SREREAD,
source->areap);
s->start = s->str =
s->u.freeme = sp;
s->next = source;
source = s;
goto subst_command;
}
}
}
/* reuse existing state machine */
goto Sbase2;
case SQBRACE:
if (c == '\\') {
/*
* perform POSIX "quote removal" if the back-
* slash is "special", i.e. same cases as the
* {case '\\':} in Subst: plus closing brace;
* in mksh code "quote removal" on '\c' means
* write QCHAR+c, otherwise CHAR+\+CHAR+c are
* emitted (in heredocquote:)
*/
if ((c = getsc()) == '"' || c == '\\' ||
c == '$' || c == '`' || c == /*{*/'}')
goto store_qchar;
goto heredocquote;
}
goto common_SQBRACE;
case SBRACE:
if (c == '\'')
goto open_ssquote_unless_heredoc;
else if (c == '\\')
goto getsc_qchar;
common_SQBRACE:
if (c == '"')
goto open_sdquote;
else if (c == '$')
goto subst_dollar_ex;
else if (c == '`')
goto subst_gravis;
else if (c != /*{*/ '}')
goto store_char;
POP_STATE();
*wp++ = CSUBST;
*wp++ = /*{*/ '}';
break;
/* Same as SBASE, except (,|,) treated specially */
case STBRACEKORN:
if (c == '|')
*wp++ = SPAT;
else if (c == '(') {
*wp++ = OPAT;
/* simile for @ */
*wp++ = ' ';
PUSH_STATE(SPATTERN);
} else /* FALLTHROUGH */
case STBRACEBOURNE:
if (c == /*{*/ '}') {
POP_STATE();
*wp++ = CSUBST;
*wp++ = /*{*/ '}';
} else
goto Sbase1;
break;
case SBQUOTE:
if (c == '`') {
*wp++ = 0;
POP_STATE();
} else if (c == '\\') {
switch (c = getsc()) {
case 0:
/* trailing \ is lost */
break;
case '$':
case '`':
case '\\':
*wp++ = c;
break;
case '"':
if (statep->ls_bool) {
*wp++ = c;
break;
}
/* FALLTHROUGH */
default:
*wp++ = '\\';
*wp++ = c;
break;
}
} else
*wp++ = c;
break;
/* ONEWORD */
case SWORD:
goto Subst;
/* LETEXPR: (( ... )) */
case SLETPAREN:
if (c == /*(*/ ')') {
if (statep->nparen > 0)
--statep->nparen;
else if ((c2 = getsc()) == /*(*/ ')') {
c = 0;
*wp++ = CQUOTE;
goto Done;
} else {
Source *s;
ungetsc(c2);
/*
* mismatched parenthesis -
* assume we were really
* parsing a (...) expression
*/
*wp = EOS;
sp = Xstring(ws, wp);
dp = wdstrip(sp + 1, WDS_TPUTS);
s = pushs(SREREAD, source->areap);
s->start = s->str = s->u.freeme = dp;
s->next = source;
source = s;
return ('('/*)*/);
}
} else if (c == '(')
/*
* parentheses inside quotes and
* backslashes are lost, but AT&T ksh
* doesn't count them either
*/
++statep->nparen;
goto Sbase2;
/* << or <<- delimiter */
case SHEREDELIM:
/*
* here delimiters need a special case since
* $ and `...` are not to be treated specially
*/
switch (c) {
case '\\':
if ((c = getsc())) {
/* trailing \ is lost */
*wp++ = QCHAR;
*wp++ = c;
}
break;
case '\'':
goto open_ssquote_unless_heredoc;
case '$':
if ((c2 = getsc()) == '\'') {
open_sequote:
*wp++ = OQUOTE;
ignore_backslash_newline++;
PUSH_STATE(SEQUOTE);
statep->ls_bool = false;
break;
} else if (c2 == '"') {
/* FALLTHROUGH */
case '"':
PUSH_SRETRACE(SHEREDQUOTE);
break;
}
ungetsc(c2);
/* FALLTHROUGH */
default:
*wp++ = CHAR;
*wp++ = c;
}
break;
/* " in << or <<- delimiter */
case SHEREDQUOTE:
if (c != '"')
goto Subst;
POP_SRETRACE();
dp = strnul(sp) - 1;
/* remove the trailing double quote */
*dp = '\0';
/* store the quoted string */
*wp++ = OQUOTE;
XcheckN(ws, wp, (dp - sp) * 2);
dp = sp;
while ((c = *dp++)) {
if (c == '\\') {
switch ((c = *dp++)) {
case '\\':
case '"':
case '$':
case '`':
break;
default:
*wp++ = CHAR;
*wp++ = '\\';
break;
}
}
*wp++ = CHAR;
*wp++ = c;
}
afree(sp, ATEMP);
*wp++ = CQUOTE;
state = statep->type = SHEREDELIM;
break;
/* in *(...|...) pattern (*+?@!) */
case SPATTERN:
if (c == /*(*/ ')') {
*wp++ = CPAT;
POP_STATE();
} else if (c == '|') {
*wp++ = SPAT;
} else if (c == '(') {
*wp++ = OPAT;
/* simile for @ */
*wp++ = ' ';
PUSH_STATE(SPATTERN);
} else
goto Sbase1;
break;
}
}
Done:
Xcheck(ws, wp);
if (statep != &states[1])
/* XXX figure out what is missing */
yyerror("no closing quote\n");
/* This done to avoid tests for SHEREDELIM wherever SBASE tested */
if (state == SHEREDELIM)
state = SBASE;
dp = Xstring(ws, wp);
if (state == SBASE && (
#ifndef MKSH_LEGACY_MODE
(c == '&' && !Flag(FSH) && !Flag(FPOSIX)) ||
#endif
c == '<' || c == '>')) {
struct ioword *iop = alloc(sizeof(struct ioword), ATEMP);
if (Xlength(ws, wp) == 0)
iop->unit = c == '<' ? 0 : 1;
else for (iop->unit = 0, c2 = 0; c2 < Xlength(ws, wp); c2 += 2) {
if (dp[c2] != CHAR)
goto no_iop;
if (!ksh_isdigit(dp[c2 + 1]))
goto no_iop;
iop->unit = iop->unit * 10 + ksh_numdig(dp[c2 + 1]);
if (iop->unit >= FDBASE)
goto no_iop;
}
if (c == '&') {
if ((c2 = getsc()) != '>') {
ungetsc(c2);
goto no_iop;
}
c = c2;
iop->ioflag = IOBASH;
} else
iop->ioflag = 0;
c2 = getsc();
/* <<, >>, <> are ok, >< is not */
if (c == c2 || (c == '<' && c2 == '>')) {
iop->ioflag |= c == c2 ?
(c == '>' ? IOCAT : IOHERE) : IORDWR;
if (iop->ioflag == IOHERE) {
if ((c2 = getsc()) == '-')
iop->ioflag |= IOSKIP;
else if (c2 == '<')
iop->ioflag |= IOHERESTR;
else
ungetsc(c2);
}
} else if (c2 == '&')
iop->ioflag |= IODUP | (c == '<' ? IORDUP : 0);
else {
iop->ioflag |= c == '>' ? IOWRITE : IOREAD;
if (c == '>' && c2 == '|')
iop->ioflag |= IOCLOB;
else
ungetsc(c2);
}
iop->ioname = NULL;
iop->delim = NULL;
iop->heredoc = NULL;
/* free word */
Xfree(ws, wp);
yylval.iop = iop;
return (REDIR);
no_iop:
afree(iop, ATEMP);
}
if (wp == dp && state == SBASE) {
/* free word */
Xfree(ws, wp);
/* no word, process LEX1 character */
if ((c == '|') || (c == '&') || (c == ';') || (c == '('/*)*/)) {
if ((c2 = getsc()) == c)
c = (c == ';') ? BREAK :
(c == '|') ? LOGOR :
(c == '&') ? LOGAND :
/* c == '(' ) */ MDPAREN;
else if (c == '|' && c2 == '&')
c = COPROC;
else if (c == ';' && c2 == '|')
c = BRKEV;
else if (c == ';' && c2 == '&')
c = BRKFT;
else
ungetsc(c2);
#ifndef MKSH_SMALL
if (c == BREAK) {
if ((c2 = getsc()) == '&')
c = BRKEV;
else
ungetsc(c2);
}
#endif
} else if (c == '\n') {
if (cf & HEREDELIM)
ungetsc(c);
else {
gethere();
if (cf & CONTIN)
goto Again;
}
}
return (c);
}
/* terminate word */
*wp++ = EOS;
yylval.cp = Xclose(ws, wp);
if (state == SWORD || state == SLETPAREN
/* XXX ONEWORD? */)
return (LWORD);
/* unget terminator */
ungetsc(c);
/*
* note: the alias-vs-function code below depends on several
* interna: starting from here, source->str is not modified;
* the way getsc() and ungetsc() operate; etc.
*/
/* copy word to unprefixed string ident */
sp = yylval.cp;
dp = ident;
while ((dp - ident) < IDENT && (c = *sp++) == CHAR)
*dp++ = *sp++;
if (c != EOS)
/* word is not unquoted */
dp = ident;
/* make sure the ident array stays NUL padded */
memset(dp, 0, (ident + IDENT) - dp + 1);
if (!(cf & (KEYWORD | ALIAS)))
return (LWORD);
if (*ident != '\0') {
struct tbl *p;
uint32_t h = hash(ident);
if ((cf & KEYWORD) && (p = ktsearch(&keywords, ident, h)) &&
(!(cf & ESACONLY) || p->val.i == ESAC ||
p->val.i == /*{*/ '}')) {
afree(yylval.cp, ATEMP);
return (p->val.i);
}
if ((cf & ALIAS) && (p = ktsearch(&aliases, ident, h)) &&
(p->flag & ISSET)) {
/*
* this still points to the same character as the
* ungetsc'd terminator from above
*/
const char *cp = source->str;
/* prefer POSIX but not Korn functions over aliases */
while (*cp == ' ' || *cp == '\t')
/*
* this is like getsc() without skipping
* over Source boundaries (including not
* parsing ungetsc'd characters that got
* pushed into an SREREAD) which is what
* we want here anyway: find out whether
* the alias name is followed by a POSIX
* function definition
*/
++cp;
/* prefer functions over aliases */
if (cp[0] != '(' || cp[1] != ')') {
Source *s = source;
while (s && (s->flags & SF_HASALIAS))
if (s->u.tblp == p)
return (LWORD);
else
s = s->next;
/* push alias expansion */
s = pushs(SALIAS, source->areap);
s->start = s->str = p->val.s;
s->u.tblp = p;
s->flags |= SF_HASALIAS;
s->next = source;
if (source->type == SEOF) {
/* prevent infinite recursion at EOS */
source->u.tblp = p;
source->flags |= SF_HASALIAS;
}
source = s;
afree(yylval.cp, ATEMP);
goto Again;
}
}
} else if (cf & ALIAS) {
/* retain typeset et al. even when quoted */
if (assign_command((dp = wdstrip(yylval.cp, 0))))
strlcpy(ident, dp, sizeof(ident));
afree(dp, ATEMP);
}
return (LWORD);
}
static void
readhere(struct ioword *iop)
{
int c;
const char *eof, *eofp;
XString xs;
char *xp;
size_t xpos;
eof = evalstr(iop->delim, 0);
if (!(iop->ioflag & IOEVAL))
ignore_backslash_newline++;
Xinit(xs, xp, 256, ATEMP);
heredoc_read_line:
/* beginning of line */
eofp = eof;
xpos = Xsavepos(xs, xp);
if (iop->ioflag & IOSKIP) {
/* skip over leading tabs */
while ((c = getsc()) == '\t')
; /* nothing */
goto heredoc_parse_char;
}
heredoc_read_char:
c = getsc();
heredoc_parse_char:
/* compare with here document marker */
if (!*eofp) {
/* end of here document marker, what to do? */
switch (c) {
case /*(*/ ')':
if (!subshell_nesting_type)
/*-
* not allowed outside $(...) or (...)
* => mismatch
*/
break;
/* allow $(...) or (...) to close here */
ungetsc(/*(*/ ')');
/* FALLTHROUGH */
case 0:
/*
* Allow EOF here to commands without trailing
* newlines (mksh -c '...') will work as well.
*/
case '\n':
/* Newline terminates here document marker */
goto heredoc_found_terminator;
}
} else if (c == *eofp++)
/* store; then read and compare next character */
goto heredoc_store_and_loop;
/* nope, mismatch; read until end of line */
while (c != '\n') {
if (!c)
/* oops, reached EOF */
yyerror("%s '%s' unclosed\n", "here document", eof);
/* store character */
Xcheck(xs, xp);
Xput(xs, xp, c);
/* read next character */
c = getsc();
}
/* we read a newline as last character */
heredoc_store_and_loop:
/* store character */
Xcheck(xs, xp);
Xput(xs, xp, c);
if (c == '\n')
goto heredoc_read_line;
goto heredoc_read_char;
heredoc_found_terminator:
/* jump back to saved beginning of line */
xp = Xrestpos(xs, xp, xpos);
/* terminate, close and store */
Xput(xs, xp, '\0');
iop->heredoc = Xclose(xs, xp);
if (!(iop->ioflag & IOEVAL))
ignore_backslash_newline--;
}
