/*--------------------------------------------------------------------------*/
char *TerminalGetString(char *prompt)
{
if (InitTerm)
{
InitializeTerminal();
InitTerm = FALSE;
}
newLine();
setCurrentPrompt(prompt);
/* print the prompt */
displayPrompt();
/* initialize history search */
setSearchedTokenInScilabHistory(NULL);
for (;;)
{
unsigned char cur_char = TerminalGetchar();
if (cur_char <= 0)
{
return NULL;
}
/* http://bugzilla.scilab.org/show_bug.cgi?id=1052 */
if (ismenu () == 1)
{
/* Abort current line */
return NULL;
}
if ( (cur_char == CR_1) || (cur_char == CR_2) )
{
if ( isHistorySearch() )
{
putLineSearchedHistory();
}
else
{
char *line = getCurrentLine();
TerminalPutc('\n');
appendLineToScilabHistory(line);
return line;
}
}
else
{
TerminalPutc(cur_char);
addCharacterCurrentLine(cur_char);
}
}
return NULL;
}
/*--------------------------------------------------------------------------*/
int TCL_EvalScilabCmd(ClientData clientData,Tcl_Interp * theinterp,int objc,CONST char ** argv)
{
int ierr = 0,seq = 0;
char *command;
char *comm[arbitrary_max_queued_callbacks];
int seqf[arbitrary_max_queued_callbacks];
int nc,ncomm=-1;
if (C2F(iop).ddt==-1)
{
/* trace for debugging */
int argc=1;
char *msg=_("TCL_EvalScilabCmd %s");
sciprint_full(msg,argv[1]);
while (argv[++argc]) sciprint(" %s",argv[argc]);
sciprint("\n");
}
if (argv[1] != (char *)0)
{
command = strdup(argv[1]);
if (command == (char *) 0)
{
sciprint(_("%s: No more memory.\n"),"TCL_EvalScilabCmd");
return TCL_ERROR;
}
if ( (argv[2] != (char *)0) && (strncmp(argv[2],"sync",4)==0) )
{
/* sync or sync seq
* TODO : Scilab is supposed to be busy there. Add mutex lock...
* C2F(tksynchro)(&c_n1);
* set sciprompt to -1 (scilab busy)
*/
seq= ( (argv[3] != (char *)0) && (strncmp(argv[3],"seq",3)==0) );
if (C2F(iop).ddt==-1)
{
char *msg=_("Execution starts for %s");
sciprint_full(msg,command);
sciprint("\n");
}
/*
int ns=(int)strlen(command);
Was : syncexec(command,&ns,&ierr,&seq,ns);
So far as Tcl has it's own thread now mixing global values
and threads within parse makes Scilab crash often.
*/
StorePrioritaryCommandWithFlag(command, seq);
ierr = 0;
if (C2F(iop).ddt==-1)
{
char *msg=_("Execution ends for %s");
sciprint_full(msg,command);
sciprint("\n");
}
// TODO : Scilab is supposed to be busy there. Add mutex lock...
// C2F(tksynchro)(&C2F(recu).paus);
if (ierr != 0) return TCL_ERROR;
}
else if (strncmp(command,"flush",5)==0)
{
/* flush */
if (C2F(iop).ddt==-1) sciprint(_(" Flushing starts for queued commands.\n"));
while (ismenu() && ncomm<arbitrary_max_queued_callbacks-1)
{
ncomm++;
comm[ncomm] = (char *) MALLOC (bsiz+1);
if (comm[ncomm] == (char *) 0)
{
sciprint(_("%s: No more memory.\n"),"TCL_EvalScilabCmd");
return TCL_ERROR;
}
seqf[ncomm]=GetCommand (comm[ncomm]);
}
if (ismenu()) sciprint(_("Warning: Too many callbacks in queue!\n"));
for (nc = 0 ; nc <= ncomm ; nc++ )
{
// TODO : Scilab is supposed to be busy there. Add mutex lock...
// C2F(tksynchro)(&c_n1); // set sciprompt to -1 (scilab busy)
if (C2F(iop).ddt==-1)
{
if (seqf[nc]==0)
{
char *msg=_("Flushed execution starts for %s - No option");
sciprint_full(msg,comm[nc]);
sciprint("\n");
}
else
{
char *msg=_("Flushed execution starts for %s - seq");
sciprint_full(msg,comm[nc]);
sciprint("\n");
}
}
/*
Was : syncexec(comm[nc],&ns,&ierr,&(seqf[nc]),ns);
So far as Tcl has it's own thread now mixing global values
and threads within parse makes Scilab crash often.
*/
StorePrioritaryCommandWithFlag(comm[nc], seqf[nc]);
if (C2F(iop).ddt==-1)
{
char *msg=_("Flushed execution ends for %s");
sciprint_full(msg,comm[nc]);
sciprint("\n");
}
FREE(comm[nc]);
// TODO : Scilab is supposed to be busy there. Add mutex lock...
// C2F(tksynchro)(&C2F(recu).paus);
if (ierr != 0) return TCL_ERROR;
}
if (C2F(iop).ddt==-1) sciprint(_("Flushing ends\n"));
}
else
{
if ( (argv[2] != (char *)0) && (strncmp(argv[2],"seq",3)==0) )
{
/* seq */
StoreCommandWithFlag(command, 1);
}
else
{
/* no option or unknown option (TODO: no error for this latter case?) */
StoreCommand(command);
Tcl_SetResult(theinterp,NULL,NULL);
}
}
FREE(command);
}
else
{
/* ScilabEval called without argument */
Scierror(999,_("%s: Wrong number of input argument(s): at least one expected.\n"),"TCL_EvalScilabCmd");
}
return TCL_OK;
}
/* @TODO : this code is for a part duplicated from gui/src/c/xsci/inter.c
with some stuff removed (TCL/TK and a few other things)
*/
int Xorgetchar(int interrupt){
int i;
int inter_max_plus1 = 0;
static fd_set Select_mask_ref;
static fd_set select_mask;
static fd_set Write_mask_ref;
static fd_set write_mask;
static struct timeval select_timeout;
static int fd_in=0,fd_out=0,fd_err=0 ;
static int state = 0;
fd_in = fileno(stdin) ;
fd_out = fileno(stdout);
fd_err = fileno(stderr);
FD_ZERO(&Select_mask_ref);
FD_SET(fd_in , &Select_mask_ref);
FD_ZERO(&Write_mask_ref);
inter_max_plus1 = fd_in;
inter_max_plus1 = Max(fd_out,inter_max_plus1);
inter_max_plus1 = Max(fd_err,inter_max_plus1);
inter_max_plus1++;
for( ; ; ) {
fflush(stdout);
fflush(stderr);
/* Initialize masks */
select_mask = Select_mask_ref;
write_mask = Write_mask_ref;
select_timeout.tv_sec = 0;
select_timeout.tv_usec = 10;
i = select(inter_max_plus1, &select_mask, &write_mask, (fd_set *)NULL, &select_timeout);
if (i < 0) {
if (errno != EINTR) /* EINTR A signal was caught. */
{
sciprint(_("Error. A signal has been caught.\n"));
exit(0);
continue;
}
}
/* if there's something to output */
if ( FD_ISSET(fd_out,&write_mask)) {
fflush(stdout);
}
if ( FD_ISSET(fd_err,&write_mask)) {
fflush(stderr);
}
/* if there's something to read */
if (FD_ISSET(fd_in,&select_mask))
state=1;
if (state) {
i=getchar();
if (i==LF) state=0;
return(i);
}
if (interrupt&&(ismenu()==1)) return(-1);
}
}
/*
* Previously called zzledt... Called by Fortran...
* Now renamed to EventLoopPrompt
* @TODO remove unused arg buf_size, menusflag, modex & dummy1
*/
void C2F(eventloopprompt) (char *buffer, int *buf_size, int *len_line, int *eof)
{
if (getScilabMode() == SCILAB_API)
{
return;
}
if (!initialJavaHooks && getScilabMode() != SCILAB_NWNI)
{
initialJavaHooks = TRUE;
// Execute the initial hooks registered in Scilab.java
ExecuteInitialHooks();
}
/* if not an interactive terminal */
#ifdef _MSC_VER
/* if file descriptor returned is -2 stdin is not associated with an input stream */
/* example : echo plot3d | scilex -nw -e */
if (!isatty(fileno(stdin)) && (fileno(stdin) != -2) && getScilabMode() != SCILAB_STD)
#else
if (!isatty(fileno(stdin)) && getScilabMode() != SCILAB_STD)
#endif
{
/* remove newline character if there */
if (__CommandLine != NULL)
{
/* read a line into the buffer, but not too
* big */
*eof = (fgets(__CommandLine, *buf_size, stdin) == NULL);
*len_line = (int)strlen(__CommandLine);
/* remove newline character if there */
if (__CommandLine[*len_line - 1] == '\n')
{
(*len_line)--;
}
return;
}
}
if (!initialized)
{
initAll();
}
__LockSignal(pReadyForLaunch);
if (__CommandLine)
{
FREE(__CommandLine);
__CommandLine = NULL;
}
__CommandLine = strdup("");
if (ismenu() == 0)
{
if (!WatchGetCmdLineThreadAlive)
{
if (WatchGetCmdLineThread)
{
__WaitThreadDie(WatchGetCmdLineThread);
}
if (getScilabMode() != SCILAB_NWNI)
{
char *cwd = NULL;
int err = 0;
UpdateBrowseVar(TRUE);
cwd = scigetcwd(&err);
if (cwd)
{
FileBrowserChDir(cwd);
FREE(cwd);
}
}
__CreateThread(&WatchGetCmdLineThread, &watchGetCommandLine);
WatchGetCmdLineThreadAlive = TRUE;
}
if (!WatchStoreCmdThreadAlive)
{
if (WatchStoreCmdThread)
{
__WaitThreadDie(WatchStoreCmdThread);
}
__CreateThread(&WatchStoreCmdThread, &watchStoreCommand);
WatchStoreCmdThreadAlive = TRUE;
}
__Wait(&TimeToWork, pReadyForLaunch);
}
__UnLockSignal(pReadyForLaunch);
/*
** WARNING : Old crappy f.... code
** do not change reference to buffer
** or fortran will be lost !!!!
*/
if (__CommandLine)
{
strcpy(buffer, __CommandLine);
}
else
{
strcpy(buffer, "");
}
*len_line = (int)strlen(buffer);
*eof = FALSE;
}
/*--------------------------------------------------------------------------*/
static unsigned char TerminalGetchar(void)
{
INPUT_RECORD irBuffer;
DWORD n = 0;
unsigned char ch = 0;
do
{
/* http://bugzilla.scilab.org/show_bug.cgi?id=1052 */
if ( ismenu() == 1 )
{
return 0;
}
WaitForSingleObject(Win32InputStream, INFINITE);
PeekConsoleInput (Win32InputStream, &irBuffer, 1, &n);
switch (irBuffer.EventType)
{
case KEY_EVENT:
{
if (irBuffer.Event.KeyEvent.bKeyDown)
{
if (irBuffer.Event.KeyEvent.dwControlKeyState)
{
if (isCTRLPressed(irBuffer.Event.KeyEvent.dwControlKeyState))
{
char c = actionControlKey();
if (c)
{
ReadConsoleInputW (Win32InputStream, &irBuffer, 1, &n);
return c;
}
else
{
if (irBuffer.Event.KeyEvent.uChar.AsciiChar != '\0')
{
ReadConsoleInputW (Win32InputStream, &irBuffer, 1, &n);
c = irBuffer.Event.KeyEvent.uChar.AsciiChar;
if ( (c > 0) && !iscntrl(c) )
{
return c;
}
}
else
{
ReadConsoleInput (Win32InputStream, &irBuffer, 1, &n);
}
}
break;
}
if (isALTPressed(irBuffer.Event.KeyEvent.dwControlKeyState))
{
if (irBuffer.Event.KeyEvent.uChar.AsciiChar != '\0')
{
ReadConsole (Win32InputStream, &ch, 1, &n, NULL);
return ch;
}
else
{
DWORD stateKey = 0;
WORD vk = 0;
ReadConsoleInput (Win32InputStream, &irBuffer, 1, &n);
stateKey = irBuffer.Event.KeyEvent.dwControlKeyState;
vk = irBuffer.Event.KeyEvent.wVirtualKeyCode;
switch (vk)
{
case VK_F4:
ALTF4_Command();
break;
default:
break;
}
}
break;
}
}
if (irBuffer.Event.KeyEvent.uChar.AsciiChar != '\0')
{
ReadConsole (Win32InputStream, &ch, 1, &n, NULL);
switch (ch)
{
case VK_TAB:
TermCompletion();
break;
case VK_BACK:
deletePreviousChar();
break;
default:
{
if ( !iscntrl(ch) || (ch == CR_1) || (ch == CR_2) )
{
return ch;
}
}
break;
}
}
else
{
WORD vk = 0;
ReadConsoleInput (Win32InputStream, &irBuffer, 1, &n);
vk = irBuffer.Event.KeyEvent.wVirtualKeyCode;
switch (vk)
{
case VK_F1:
case VK_HELP:
F1_Command();
break;
case VK_F2:
F2_Command();
break;
case VK_LEFT:
moveBackSingleChar();
break;
case VK_RIGHT:
moveForwardSingleChar();
break;
case VK_UP:
moveBackHistory();
break;
case VK_DOWN:
moveForwardHistory();
break;
case VK_DELETE:
deleteCurrentChar();
break;
case VK_HOME:
moveBeginningLine();
break;
case VK_END:
moveEndLine();
break;
default:
break;
}
}
}
else
{
ReadConsoleInput (Win32InputStream, &irBuffer, 1, &n);
}
}
break;
case MOUSE_EVENT:
{
/* Read mouse Input but not used */
ReadConsoleInput (Win32InputStream, &irBuffer, 1, &n);
}
break;
case WINDOW_BUFFER_SIZE_EVENT:
{
/* Read resize event Input */
setColumnsSize(irBuffer.Event.WindowBufferSizeEvent.dwSize.X);
setLinesSize(irBuffer.Event.WindowBufferSizeEvent.dwSize.Y);
ReadConsoleInput (Win32InputStream, &irBuffer, 1, &n);
}
break;
case MENU_EVENT:
{
ReadConsoleInput (Win32InputStream, &irBuffer, 1, &n);
}
break;
case FOCUS_EVENT:
{
ReadConsoleInput (Win32InputStream, &irBuffer, 1, &n);
}
break;
default:
{
/* Read Input but not used */
ReadConsoleInput (Win32InputStream, &irBuffer, 1, &n);
}
break;
}
}
while (TRUE);
}
/*--------------------------------------------------------------------------*/
int C2F(parse)(void)
{
/* Initialized data */
static int ans[6] = { 672929546, 673720360, 673720360, 673720360,
673720360, 673720360
};
static int varargout[6] = { 169544223, 504893467, 673720349, 673720360,
673720360, 673720360
};
/* static int catch[6] = {203229708,673720337,673720360,673720360, 673720360,673720360 };*/
static int *Ids = C2F(recu).ids - nsiz - 1;
static int *Rstk = C2F(recu).rstk - 1;
static int *Pstk = C2F(recu).pstk - 1;
static int *Lstk = C2F(vstk).lstk - 1;
static int *Lin = C2F(iop).lin - 1;
static int *Lct = C2F(iop).lct - 1;
static int *Lpt = C2F(iop).lpt - 1;
/* System generated locals */
int i__2, i__3;
/* Local variables */
static int iesc, ndel, ifin, ibpt;
static int iret;
static int topk;
static int lpts, next;
static int ierr;
static int k, p, r;
static int imode, schar;
static int itime, where_;
static int found;
static int excnt;
static int l1;
static int id[6], lb, io, ir;
static int dotsep;
static int icount;
static int nentry, lastindpos;
static int job, nlc, pts;
static char tmp[80];
/* Used to manage space between prompts */
static int returnFromCallbackExec = FALSE;
/* Retrieve the current Scilab Mode */
/* scilabMode sciMode=getScilabMode();*/
itime = 10000;
L1:
r = 0;
if (Pt > 0)
{
r = Rstk[Pt];
}
if (C2F(iop).ddt == 4)
{
sprintf(tmp, " TOP pt:%d rstk(pt):%d icall: %d niv: %d err:%d",
Pt, Rstk[Pt], C2F(recu).icall, C2F(recu).niv, Err);
C2F(basout)(&io, &C2F(iop).wte, tmp, (long)strlen(tmp));
}
if (C2F(recu).icall == 5)
{
goto L88;
}
if (Pt > 0)
{
goto L86;
}
if (Err > 0)
{
goto L98;
}
/* initialization */
/* ------------------- */
L5:
C2F(com).sym = eol;
job = 0;
if (C2F(iop).rio == -1)
{
job = -1;
}
Top = 0;
Fin = 0;
C2F(recu).macr = 0;
C2F(recu).paus = 0;
C2F(recu).icall = 0;
C2F(iop).rio = C2F(iop).rte;
Lct[3] = 0;
Lct[4] = 2;
Lpt[1] = 1;
if (job == -1)
{
goto L13;
}
L10:
if (C2F(com).sym != eol)
{
goto L15;
}
if (C2F(com).comp[0] == 0)
{
goto L12;
}
if (Lin[Lpt[4] + 1] == eol)
{
goto L88;
}
/* get a new line */
/* ------------------- */
L12:
if (Lct[4] <= -10)
{
Lct[4] = -Lct[4] - 11;
}
else
{
if (Lct[4] / 2 % 2 == 1)
{
i__2 = Lct[4] / 4;
/* Manage space between two prompts */
if (!returnFromCallbackExec)
{
/* Space added only if Scilab does not return from a callback execution */
C2F(prompt)(&i__2, &iesc);
}
else
{
/* Reset the flag indicating a callback has just been executed */
returnFromCallbackExec = FALSE;
}
if (iesc == 1)
{
/* interrupted line acquisition (mode=7) */
iret = 3;
goto L96;
}
Lct[1] = 0;
if (C2F(recu).paus == 0 &&
C2F(iop).rio == C2F(iop).rte &&
C2F(recu).macr == 0)
{
if (Pt != 0)
{
Msgs(30, 0);
Pt = 0;
}
if (Top != 0)
{
Msgs(31, 0);
Top = 0;
}
}
}
}
L13:
//C2F(tksynchro)(&C2F(recu).paus);
C2F(getlin)(&job, &c__1);
ClearTemporaryPrompt();
//C2F(tksynchro)(&c_n1);
if (Fin == -3)
{
/* interrupted line acquisition */
iret = 2;
goto L96;
}
else if (Fin == -1)
{
/* Continuation line handling when scilab is called as a routine */
C2F(com).fun = 99;
return 0;
}
job = 0;
Err = 0;
if (Pt != 0)
{
goto L15;
}
L14:
handle_onprompt(&where_);
if (Err > 0)
{
goto L98;
}
switch ((int)where_)
{
case 1:
goto L85;
case 2:
goto L88;
}
/* Beginning of a new statement, clause expression or command */
/* ------------------------------------------------------------ */
L15:
if (ismenu() == 1 && C2F(basbrk).interruptible)
{
iret = 1;
goto L96;
}
r = 0;
if (Pt > 0)
{
r = Rstk[Pt];
}
if (C2F(iop).ddt == 4)
{
sprintf(tmp, " parse pt:%d rstk(pt):%d top: %d niv: %d err:%d",
Pt, r, Top, C2F(recu).niv, Err);
C2F(basout)(&io, &C2F(iop).wte, tmp, (long)strlen(tmp));
}
excnt = 0;
if (! C2F(basbrk).iflag || C2F(com).comp[0] != 0 )
{
goto L18;
}
/* Handling of pauses */
L16:
if (Eptover(1))
{
goto L98;
}
Pstk[Pt] = C2F(iop).rio;
Ids[2 + Pt * nsiz] = Top;
C2F(iop).rio = C2F(iop).rte;
Rstk[Pt] = 701;
C2F(basbrk).iflag = FALSE;
Fin = 2;
if (Lct[4] <= -10)
{
Fin = -1;
Lct[4] = -Lct[4] - 11;
}
/* *call* macro */
goto L88;
/* pauses termination */
L17:
C2F(iop).rio = Pstk[Pt];
Top = Ids[2 + Pt * nsiz];
--Pt;
goto L15;
L18:
Lhs = 1;
excnt = 0;
C2F(putid)(id, ans);
/* preserve current character position */
lpts = Lpt[4] - 1;
pts = Pt;
C2F(getsym)();
if (C2F(com).sym == right || C2F(com).sym == rparen || C2F(com).sym == less ||
C2F(com).sym == great)
{
/* Incorrect assignment. */
SciError(1);
goto L98;
}
else if (C2F(com).sym == semi || C2F(com).sym == comma || C2F(com).sym == eol)
{
goto L77;
}
else if (C2F(com).sym == cmt)
{
C2F(parsecomment)();
goto L77;
}
else if (C2F(com).sym == name)
{
lpts = Lpt[3] - 1;
/* try to avoid the command call whenever it is possible */
if (C2F(com).char1 == equal)
{
goto L25;
}
/* if (char1 .eq. lparen) then */
/* one can get this case with "if ( ) then" */
/* endif */
if (Lpt[4] >= 2)
{
if (Lin[Lpt[4] - 2] == blank)
{
goto L20;
}
}
if (C2F(com).char1 == dot)
{
/* name.x */
schar = C2F(com).char1;
goto L30;
}
goto L20;
}
else if (C2F(com).sym == left)
{
/* is there an explicit affectation */
lpts = Lpt[3] - 1;
Lpt[4] = lpts;
Lpt[3] = lpts;
C2F(com).char1 = blank;
C2F(findequal)(&found);
if (Err > 0)
{
goto L98;
}
if (found)
{
/* multiple lhs */
goto L40;
}
else
{
/* no ==> implicit lhs */
goto L50;
}
}
else
{
/* not lhs defined */
/* set ans for lhs */
if (Eptover(1))
{
goto L98;
}
C2F(putid)(&Ids[1 + Pt * nsiz], ans);
Lhs = 1;
Pstk[Pt] = 0;
/* go to rhs analysis */
goto L60;
}
/* lhs begins with name */
/* ------------------------- */
/* check if it is a simple command like clear,... */
L20:
C2F(command)(C2F(com).syn, &c__0);
if (Err > 0)
{
goto L98;
}
if (Fin == 0)
{
goto L21;
}
if (C2F(com).fun == 99)
{
return 0;
}
if (C2F(com).fun != 0)
{
goto L93;
}
if (Fin < 0)
{
goto L80;
}
if (Fin == 2)
{
goto L88;
}
if (Fin == 3)
{
goto L16;
}
if (Fin == 4)
{
goto L5;
}
if (Fin > 0)
{
goto L77;
}
/* name is not a command */
L21:
Rhs = 0;
Fin = -5;
/* IL y a p avec fin=-5 (on ne trouve pas les macros parce que l'on ne */
/* veut pas que les macros sans arg soient vues comme des commandes */
/* mais pourquoi pas il suffirait de dire que pour visualiser une macro */
/* il faut faire disp() */
C2F(com).fun = 0;
C2F(funs)(C2F(com).syn);
if (Fin > 0)
{
/* name is a builtin name */
if (C2F(com).char1 == equal)
{
/* fun=expr is not allowed */
C2F(putid)(&Ids[1 + (Pt + 1) * nsiz], C2F(com).syn);
/* Bad call to primitive */
SciError(25);
goto L98;
}
/* skip lhs analysis */
if (Eptover(1))
{
goto L98;
}
C2F(putid)(&Ids[1 + Pt * nsiz], id);
Lhs = 1;
Pstk[Pt] = 0;
/* go to rhs analysis */
goto L60;
}
/* peek one character ahead */
if (C2F(com).char1 == semi || C2F(com).char1 == comma || C2F(com).char1 == eol)
{
C2F(putid)(id, C2F(com).syn);
}
if (C2F(com).char1 == lparen)
{
schar = C2F(com).char1;
goto L30;
}
/* instruction is just "name", skip lhs analysis */
/* record name as lhs */
if (Eptover(1))
{
goto L98;
}
C2F(putid)(&Ids[1 + Pt * nsiz], id);
Lhs = 1;
Pstk[Pt] = 0;
/* go to rhs analysis */
goto L60;
/* name = expr or name == expr syntax */
/* ---------------------------------------- */
L25:
C2F(putid)(id, C2F(com).syn);
lpts = Lpt[2];
C2F(getsym)();
if (C2F(com).char1 == equal)
{
/* name == expr syntax ==> implicit lhs */
goto L50;
}
else
{
/* lhs found */
/* record it */
if (Eptover(1))
{
goto L98;
}
C2F(putid)(&Ids[1 + Pt * nsiz], id);
Lhs = 1;
Pstk[Pt] = 0;
C2F(getsym)();
/* go to rhs analysis */
goto L60;
}
/* lhs is name(...) or name.x... */
/* ----------------------------------- */
L30:
Lpt[5] = Lpt[4];
C2F(putid)(id, C2F(com).syn);
/* looking for equal to check if it is really an lhs */
C2F(findequal)(&found);
if (Err > 0)
{
goto L98;
}
if (! found)
{
goto L50;
}
/* It is really a lhs (insertion syntax) */
L32:
Lpt[4] = Lpt[5];
C2F(com).char1 = schar;
/* 35 call parseindexlist(excnt) */
/* if(err.gt.0) goto 98 */
if (Compil(21, &c__0, 0, 0, 0))
{
if (Err > 0)
{
return 0;
}
}
/* begin the index lists */
icount = 0;
C2F(getsym)();
L33:
/* begin a new index list (.,..) or .name */
++icount;
dotsep = C2F(com).sym == dot;
C2F(getsym)();
if (dotsep)
{
/* --> new index list is .name */
if (C2F(com).sym != name)
{
/* Invalid index.*/
SciError(21);
if (Err > 0)
{
return 0;
}
}
if (C2F(com).comp[0] != 0)
{
if (Compil(23, C2F(com).syn, 0, 0, 0))
{
if (Err > 0)
{
return 0;
}
}
}
else
{
C2F(name2var)(C2F(com).syn);
}
C2F(getsym)();
/* icount=icount+1 */
if (C2F(com).sym == dot)
{
goto L33;
}
dotsep = FALSE;
excnt = 1;
goto L36;
}
/* --> new index list is (.,..) */
L34:
/* add a new index in index list (i,...) */
++excnt;
if (Eptover(1))
{
goto L98;
}
C2F(putid)(&Ids[1 + Pt * nsiz], id);
Pstk[Pt] = excnt + icount * 1000;
Rstk[Pt] = 702;
/* *call* expr */
goto L81;
L35:
C2F(putid)(id, &Ids[1 + Pt * nsiz]);
icount = Pstk[Pt] / 1000;
excnt = Pstk[Pt] - icount * 1000;
--Pt;
if (C2F(com).sym == comma)
{
/* current syntax is (i,j,..) */
C2F(getsym)();
goto L34;
}
if (C2F(com).sym == rparen)
{
/* end of the current index list */
C2F(getsym)();
}
else
{
/* Waiting for right parenthesis */
SciError(3);
if (Err > 0)
{
goto L98;
}
}
L36:
if (C2F(com).sym == lparen || C2F(com).sym == dot)
{
/* begining of a new index list */
/* first memorize the previous one */
if (excnt > 1)
{
/* previously analysed syntax is (i,j,..)( */
if (C2F(com).comp[0] == 0)
{
/* form list with individual indexes i,j,.. */
C2F(mkindx)(&c__0, &excnt);
if (Err > 0)
{
return 0;
}
}
else
{
if (Compil(19, &c__0, excnt, 0, 0))
{
if (Err > 0)
{
return 0;
}
}
}
excnt = 1;
}
/* open a new index list */
excnt = 0;
/* icount=icount+1 */
goto L33;
}
/* end of all the index lists */
if (icount > 1)
{
/* form list with individual indexes */
if (C2F(com).comp[0] == 0)
{
C2F(mkindx)(&icount, &excnt);
if (Err > 0)
{
return 0;
}
}
else
{
if (Compil(19, &icount, excnt, 0, 0))
{
if (Err > 0)
{
return 0;
}
}
}
excnt = 1;
}
/* end of code for recursive index */
if (Rstk[Pt] == 711)
{
goto L42;
}
if (C2F(com).sym == equal)
{
/* name(...) = expr syntax */
/* record name as lhs */
if (Eptover(1))
{
goto L98;
}
C2F(putid)(&Ids[1 + Pt * nsiz], id);
Pstk[Pt] = excnt;
Lhs = 1;
C2F(getsym)();
/* go to rhs analysis */
goto L60;
}
else
{
/* this should never happen. this case has been detected above */
/* when lookin for equal sign */
/* name(...) syntax ==> really an rhs */
if (Eptover(1))
{
goto L98;
}
C2F(putid)(&Ids[1 + Pt * nsiz], ans);
Lhs = 1;
Pstk[Pt] = 0;
goto L60;
}
/* multiple lhs [a,...]= or [a(..),..] */
/* ---------------------------------------- */
L40:
Lpt[4] = lpts;
Lpt[3] = lpts;
C2F(com).char1 = blank;
Lhs = 0;
C2F(getsym)();
/* start lhs arguments list */
C2F(getsym)();
L41:
/* begin analysis of a new lhs argument */
if (C2F(com).sym != name)
{
/* Instruction left hand side: waiting for a name */
SciError(274);
goto L98;
}
if (C2F(eqid)(C2F(com).syn, varargout))
{
/* varargout keyword cannot be used here */
SciError(275);
goto L98;
}
C2F(putid)(id, C2F(com).syn);
excnt = 0;
next = Lin[Lpt[4] - 2];
if (next == blank || C2F(com).char1 == comma || C2F(com).char1 == right)
{
/* argument followed by a blank, a comma or a ] ==> it is a simple name */
C2F(getsym)();
goto L44;
}
else if (C2F(com).char1 != lparen && C2F(com).char1 != dot)
{
/* invalid lhs */
SciError(273);
goto L98;
}
/* lhs argument is name(..) or name.xx */
if (Eptover(1))
{
goto L98;
}
Rstk[Pt] = 711;
Lpt[5] = Lpt[4];
schar = C2F(com).char1;
goto L32;
/* *parse* index */
L42:
--Pt;
goto L44;
L44:
/* record current lhs arg */
if (Eptover(1))
{
goto L98;
}
C2F(putid)(&Ids[1 + Pt * nsiz], id);
++Lhs;
Pstk[Pt] = excnt;
Rstk[Pt] = 0;
/* end analysis of a current lhs arg */
if (C2F(com).sym == right)
{
goto L46;
}
if (C2F(com).sym == comma)
{
C2F(getsym)();
}
/* loop on lhs args */
goto L41;
L46:
C2F(getsym)();
if (C2F(com).sym == equal && C2F(com).char1 != equal)
{
/* really found a lhs go to the rhs analysis part */
C2F(getsym)();
goto L60;
}
/* lhs revealed to be an rhs */
/* ------------------------------------- */
L50:
/* no equal symbol */
goto L51;
L51:
/* lhs is in fact an rhs */
/* 1 - reinititialise the parser at the instruction beginning */
Pt = pts;
Lpt[4] = lpts;
Lpt[3] = lpts;
C2F(com).char1 = blank;
/* L52: */
C2F(getsym)();
/* if(sym.eq.comma.or.sym.eq.semi) goto 52 */
/* 2 - make "ans" the lhs */
if (Eptover(1))
{
goto L98;
}
C2F(putid)(&Ids[1 + Pt * nsiz], ans);
Pstk[Pt] = 0;
Lhs = 1;
/* 3 - go to the rhs analysis part */
goto L60;
/* lhs finished, start rhs */
/* ---------------------------- */
L60:
Rstk[Pt] = 703;
/* *call* expr */
goto L81;
L65:
if (Rstk[Pt - Lhs] == 313)
{
/* store new variable as "named" at the top of the stack */
if (C2F(com).sym == rparen || C2F(com).sym == comma)
{
C2F(mrknmd)();
if (Err > 0)
{
goto L98;
}
goto L83;
}
else
{
/* Waiting for end of command. */
SciError(40);
goto L98;
}
}
if (C2F(com).sym == semi || C2F(com).sym == comma || C2F(com).sym == eol || C2F(com).sym == cmt)
{
goto L70;
}
if (Rstk[Pt - Lhs] == 808) /* syntax error while in try */
{
/* set back the standard error handling ++++*/
Pt = Pt - Lhs;
C2F(errgst).errct = Ids[2 + Pt * nsiz];
C2F(errgst).errpt = Ids[5 + Pt * nsiz];
/* forgot the catch error */
C2F(errgst).err1 = Ids[3 + Pt * nsiz];
C2F(errgst).err2 = Ids[4 + Pt * nsiz];
C2F(com).comp[0] = 0;
Lpt[2] = Lpt[3] + 1;
/* Missing operator, comma, or semicolon. */
SciError(276);
Pt = Pt - 1;
goto L98;
}
else
{
Lpt[2] = Lpt[3] + 1;
/* Missing operator, comma, or semicolon. */
SciError(276);
goto L98;
}
/* store results */
/* ------------------- */
L70:
Lhs = Max(Lhs, 1);
if (Compil(29, &(Lhs), C2F(com).sym, 0, 0))
{
if (Err > 0)
{
return 0;
}
Pt -= Lhs;
Lhs = 0;
goto L77;
}
ndel = 0;
L71:
Rhs = Pstk[Pt];
lastindpos = Top - Lhs - ndel;
if (C2F(errgst).err1 != 0)
{
goto L76;
}
if (Rhs == 0)
{
/* goto simple affectation */
C2F(stackp)(&Ids[1 + Pt * nsiz], &c__0);
if (Err > 0)
{
goto L98;
}
if (C2F(errgst).err1 > 0)
{
if (C2F(errgst).err1 != 13 || Rstk[Pt] != 502)
{
--Pt;
}
--Lhs;
goto L98;
}
/* topk points on the newly saved variable */
topk = Fin;
/* go to print */
goto L73;
}
/* partial variable affectation (insertion) */
if (lastindpos + 1 != Top)
{
/* create reference variables to get index1,...,indexn, value at */
/* the top of the stack in this order */
/* create reference variables pointing to the indices */
i__2 = Rhs;
for (ir = 1; ir <= i__2; ++ir)
{
i__3 = lastindpos - Rhs + ir;
C2F(createref1)(&i__3);
}
/* create reference variable pointing to the value */
i__2 = Top - Rhs;
C2F(createref1)(&i__2);
/* remind to remove the original indices */
ndel += Rhs;
}
lastindpos -= Rhs;
/* put a reference to the lhs variable */
Fin = -3;
C2F(stackg)(&Ids[1 + Pt * nsiz]);
if (Err > 0)
{
goto L98;
}
/* perform insertion operation */
/* index1,...,indexn, value ==> updated lhs value (or pointer to) */
if (Eptover(1))
{
goto L98;
}
Pstk[Pt] = Lhs;
C2F(putid)(&Ids[1 + Pt * nsiz], &Ids[1 + (Pt - 1) * nsiz]);
Ids[1 + (Pt - 1) * nsiz] = ndel;
Ids[2 + (Pt - 1) * nsiz] = lastindpos;
Rstk[Pt] = 704;
Rhs += 2;
Lhs = 1;
Fin = insert;
/* *call* allops(insert) */
goto L91;
L72:
Lhs = Pstk[Pt];
ndel = Ids[1 + (Pt - 1) * nsiz];
lastindpos = Ids[2 + (Pt - 1) * nsiz];
C2F(putid)(&Ids[1 + (Pt - 1) * nsiz], &Ids[1 + Pt * nsiz]);
--Pt;
/* store the updated value */
C2F(stackp)(&Ids[1 + Pt * nsiz], &c__0);
if (Err > 0)
{
goto L98;
}
if (C2F(errgst).err1 > 0)
{
--Pt;
--Lhs;
goto L98;
}
/* topk points on the newly saved variable */
topk = Fin;
/* remove variable containing the value if required */
if (lastindpos != Top)
{
--Top;
}
L73:
/* print if required */
/* ---------------------- */
if (Lct[4] < 0 || Fin == 0)
{
goto L76;
}
if (! ((C2F(com).sym != semi && Lct[3] == 0) || (C2F(com).sym == semi &&
Lct[3] == 1)))
{
goto L76;
}
L74:
C2F(print)(&Ids[1 + Pt * nsiz], &topk, &C2F(iop).wte);
if (Err > 0)
{
goto L98;
}
if (topk == 0)
{
goto L76;
}
/* overloaded display, call a macro */
if (Eptover(1))
{
goto L98;
}
Rstk[Pt] = 708;
Pstk[Pt] = C2F(com).sym;
Ids[1 + Pt * nsiz] = C2F(com).sym;
Ids[2 + Pt * nsiz] = ndel;
Ids[3 + Pt * nsiz] = Lhs;
if (C2F(com).fun == 0)
{
goto L88;
}
goto L85;
L75:
C2F(com).sym = Pstk[Pt];
ndel = Ids[2 + Pt * nsiz];
Lhs = Ids[3 + Pt * nsiz];
--Pt;
goto L74;
L76:
--Pt;
--Lhs;
if (Lhs > 0)
{
goto L71;
}
Top -= ndel;
/* finish statement */
/* --------------------- */
L77:
Fin = 0;
p = 0;
r = 0;
if (Pt > 0)
{
p = Pstk[Pt];
}
if (Pt > 0)
{
r = Rstk[Pt];
}
if (C2F(iop).ddt == 4)
{
sprintf(tmp, " finish pt:%d rstk(pt):%d pstk(pt):%d lpt(1): %d niv: %d macr:%d, paus:%d",
Pt, r, p, Lpt[1], C2F(recu).niv, C2F(recu).macr, C2F(recu).paus);
C2F(basout)(&io, &C2F(iop).wte, tmp, (long)strlen(tmp));
}
ExternalObjects_goDown();
if (C2F(errgst).err1 != 0)
{
/* a catched error has occurred */
if (r == 808)
{
/* in try instructions */
goto L80;
}
else if (Ids[1 + (Pt - 1) * nsiz] != 0)
{
/* execution is explicitly required to be stopped */
if (r == 502 && Rstk[Pt - 1] == 903)
{
/* in an execstr(...,'errcatch') instruction */
goto L88;
}
else if (r == 502 && Rstk[Pt - 1] == 909)
{
/* in an exec(function,'errcatch') instruction */
goto L88;
}
else if (r == 503 && Rstk[Pt - 1] == 902)
{
/* in an exec(file,'errcatch') instruction */
goto L88;
}
}
if (C2F(errgst).err2 == 0)
{
C2F(errgst).err2 = C2F(errgst).err1;
}
if (C2F(errgst).errcatch > 0)
{
/* running under errcatch(num,....) */
C2F(errgst).err1 = 0;
if (Pt < C2F(errgst).errpt)
{
C2F(errgst).errcatch = 0;
}
}
imode = (i__2 = C2F(errgst).errct / 100000, abs(i__2));
if (imode - (imode / 8 << 3) == 2)
{
C2F(basbrk).iflag = TRUE;
goto L16;
}
}
C2F(errgst).toperr = Top;
/* fin instruction */
if (C2F(com).sym != eol)
{
if (C2F(com).sym == cmt)
{
C2F(parsecomment)();
}
else
{
goto L15;
}
}
/* gestion des points d'arrets dynamiques */
if (C2F(dbg).nmacs != 0) /* there are breakpoints set */
{
int kfin = C2F(dbg).wmac - 1; /*the stack index of the current function*/
/* first test if the function has breakpoints */
int kmac;
int curline;
for (kmac = 0; kmac < C2F(dbg).nmacs; kmac++) /* loop on table of functions containing breakpoints */
{
/* does the name of the current funtion fit the registered name*/
if (C2F(eqid)(&(C2F(vstk).idstk[kfin * nsiz]), &(C2F(dbg).macnms[kmac * nsiz]))) /* yes */
{
/* test if there is a registered breakpoint at the current line*/
i__2 = Lpt[2] - 1;
C2F(whatln)(&Lpt[1], &i__2, &Lpt[6], &nlc, &l1, &ifin);
i__2 = C2F(dbg).lgptrs[kmac + 1] - 1;
curline = Lct[8] - nlc - 1;
for (ibpt = C2F(dbg).lgptrs[kmac]; ibpt <= i__2; ++ibpt)
{
//sciprint("la Lct[8]-nlc =%d, bptlg=%d\n",Lct[8] - nlc,C2F(dbg).bptlg[ibpt - 1]);
if (curline == C2F(dbg).bptlg[ibpt - 1]) /* yes */
{
/* display a message */
C2F(cvname)(&C2F(dbg).macnms[kmac * nsiz], tmp, &c__1, nlgh);
sprintf(C2F(cha1).buf, "%s %5d", tmp, curline);
Msgs(32, 0);
/* raise the interruption flag */
C2F(basbrk).iflag = TRUE;
goto L79;
}
}
break;
}
}
}
L79:
if (C2F(com).comp[0] != 0)
{
C2F(seteol)();
}
/* EOL */
if (r / 100 != 8)
{
goto L10;
}
/* end of an instruction or a clause */
if (C2F(com).comp[0] != 0)
{
k = Lpt[6];
if (Lin[k - 1] == eol && Lin[k] == eol)
{
/* end or else is missing... */
SciError(47);
goto L98;
}
}
if (Lpt[4] == Lpt[6])
{
/* call getlin(1,0) */
goto L13;
}
else
{
++Lpt[4];
C2F(getsym)();
}
goto L15;
/* simulate recursion */
/* ----------------------- */
L80:
C2F(recu).icall = 0;
C2F(clause)();
if (Err > 0)
{
goto L98;
}
switch ((int)C2F(recu).icall)
{
case 1:
goto L81;
case 2:
goto L82;
case 3:
goto L83;
case 4:
goto L91;
case 5:
goto L88;
case 6:
goto L90;
case 7:
goto L15;
case 8:
goto L80;
case 9:
goto L85;
}
if (Pt <= 0)
{
goto L15;
}
r = Rstk[Pt] / 100;
switch ((int)r)
{
case 1:
goto L81;
case 2:
goto L82;
case 3:
goto L83;
case 4:
goto L91;
case 5:
goto L88;
case 6:
goto L90;
case 7:
goto L92;
case 8:
goto L80;
case 9:
goto L85;
}
goto L99;
L81:
C2F(recu).icall = 0;
C2F(expr)();
if (Err > 0)
{
goto L98;
}
switch ((int)C2F(recu).icall)
{
case 1:
goto L81;
case 2:
goto L82;
case 3:
goto L83;
case 4:
goto L91;
case 5:
goto L88;
case 6:
goto L90;
case 7:
goto L15;
case 8:
goto L80;
case 9:
goto L85;
}
r = Rstk[Pt] / 100;
switch ((int)r)
{
case 1:
goto L81;
case 2:
goto L82;
case 3:
goto L83;
case 4:
goto L91;
case 5:
goto L88;
case 6:
goto L90;
case 7:
goto L92;
case 8:
goto L80;
case 9:
goto L85;
}
goto L99;
L82:
C2F(recu).icall = 0;
C2F(terme)();
if (Err > 0)
{
goto L98;
}
switch ((int)C2F(recu).icall)
{
case 1:
goto L81;
case 2:
goto L82;
case 3:
goto L83;
case 4:
goto L91;
case 5:
goto L88;
case 6:
goto L90;
case 7:
goto L15;
case 8:
goto L80;
case 9:
goto L85;
}
r = Rstk[Pt] / 100;
switch ((int)r)
{
case 1:
goto L81;
case 2:
goto L82;
case 3:
goto L83;
case 4:
goto L91;
case 5:
goto L88;
case 6:
goto L90;
case 7:
goto L92;
case 8:
goto L80;
case 9:
goto L85;
}
goto L99;
L83:
C2F(recu).icall = 0;
C2F(fact)();
if (Err > 0)
{
goto L98;
}
switch ((int)C2F(recu).icall)
{
case 1:
goto L81;
case 2:
goto L82;
case 3:
goto L83;
case 4:
goto L91;
case 5:
goto L88;
case 6:
goto L90;
case 7:
goto L15;
case 8:
goto L80;
case 9:
goto L85;
}
r = Rstk[Pt] / 100;
switch ((int)r)
{
case 1:
goto L81;
case 2:
goto L82;
case 3:
goto L83;
case 4:
goto L91;
case 5:
goto L88;
case 6:
goto L90;
case 7:
goto L92;
case 8:
goto L80;
case 9:
goto L85;
}
goto L99;
L85:
C2F(recu).icall = 0;
if (C2F(com).fun == C2F(recu).krec)
{
if (C2F(com).fun > 0)
{
/* Recursion problems. Sorry */
SciError(22);
goto L98;
}
}
if (C2F(errgst).err1 != 0)
{
if (Rstk[Pt] / 100 == 9)
{
if (Rstk[Pt] >= 901 && Rstk[Pt] <= 909)
{
/* *call* matfns */
return 0;
}
else
{
--Pt;
goto L86;
}
}
else
{
goto L86;
}
}
/* compilation matfns: <100*fun rhs lhs fin> */
if (Compil( C2F(com).fun * 100, &(Rhs), Lhs, Fin, 0))
{
if (Err > 0)
{
goto L98;
}
goto L86;
}
else
{
/* *call* matfns */
return 0;
}
L86:
if (Err > 0)
{
goto L98;
}
switch ((int)C2F(recu).icall)
{
case 1:
goto L81;
case 2:
goto L82;
case 3:
goto L83;
case 4:
goto L91;
case 5:
goto L88;
case 6:
goto L90;
case 7:
goto L15;
case 8:
goto L80;
case 9:
goto L85;
}
r = Rstk[Pt] / 100;
switch ((int)r)
{
case 1:
goto L81;
case 2:
goto L82;
case 3:
goto L83;
case 4:
goto L91;
case 5:
goto L88;
case 6:
goto L90;
case 7:
goto L92;
case 8:
goto L80;
case 9:
goto L85;
}
goto L98;
L88:
C2F(recu).icall = 0;
C2F(macro)();
if (Err > 0)
{
goto L98;
}
switch ((int)C2F(recu).icall)
{
case 1:
goto L81;
case 2:
goto L82;
case 3:
goto L83;
case 4:
goto L91;
case 5:
goto L88;
case 6:
goto L90;
case 7:
goto L10;
case 8:
goto L80;
case 9:
goto L85;
}
r = Rstk[Pt] / 100;
switch ((int)r)
{
case 1:
goto L81;
case 2:
goto L82;
case 3:
goto L83;
case 4:
goto L91;
case 5:
goto L88;
case 6:
goto L90;
case 7:
goto L92;
case 8:
goto L80;
case 9:
goto L85;
case 10:
goto L89;
}
goto L99;
L89:
C2F(com).fun = 99;
return 0;
L90:
C2F(recu).icall = 0;
C2F(run)();
if (Err > 0)
{
goto L98;
}
if (C2F(com).fun == 99)
{
return 0;
}
/* last label is used to handle return from abort */
switch ((int)C2F(recu).icall)
{
case 1:
goto L81;
case 2:
goto L82;
case 3:
goto L83;
case 4:
goto L91;
case 5:
goto L88;
case 6:
goto L90;
case 7:
goto L15;
case 8:
goto L80;
case 9:
goto L85;
case 10:
goto L5;
}
r = Rstk[Pt] / 100;
switch ((int)r)
{
case 1:
goto L81;
case 2:
goto L82;
case 3:
goto L83;
case 4:
goto L91;
case 5:
goto L88;
case 6:
goto L90;
case 7:
goto L92;
case 8:
goto L80;
case 9:
goto L85;
case 10:
goto L89;
}
goto L99;
L91:
C2F(recu).icall = 0;
C2F(allops)();
if (Err > 0)
{
goto L98;
}
switch ((int)C2F(recu).icall)
{
case 1:
goto L81;
case 2:
goto L82;
case 3:
goto L83;
case 4:
goto L91;
case 5:
goto L88;
case 6:
goto L90;
case 7:
goto L15;
case 8:
goto L80;
case 9:
goto L85;
}
r = Rstk[Pt] / 100;
switch ((int)r)
{
case 1:
goto L81;
case 2:
goto L82;
case 3:
goto L83;
case 4:
goto L91;
case 5:
goto L88;
case 6:
goto L90;
case 7:
goto L92;
case 8:
goto L80;
case 9:
goto L85;
}
goto L98;
L92:
switch ((int)(Rstk[Pt] - 700))
{
case 1:
goto L17;
case 2:
goto L35;
case 3:
goto L65;
case 4:
goto L72;
case 5:
goto L65;
case 6:
goto L97;
case 7:
goto L94;
case 8:
goto L75;
case 9:
goto L99;
case 10:
goto L14;
}
goto L99;
L93:
/* command like function and macro call */
/* store ans as lhs */
if (Eptover(1))
{
goto L98;
}
C2F(putid)(&Ids[1 + Pt * nsiz], ans);
Pstk[Pt] = 0;
Rstk[Pt] = 707;
if (C2F(com).fun > 0)
{
/* *call* matfns */
goto L85;
}
else
{
if (C2F(com).comp[0] != 0)
{
++Rhs;
Fin = extrac;
/* *call* allops(extrac) */
goto L91;
}
else
{
Fin = Lstk[C2F(com).fin];
/* *call* macro */
goto L88;
}
}
L94:
/* go to store code */
goto L70;
L96:
/* asynchronous events handling */
C2F(basbrk).interruptible = C2F(getmen)(C2F(cha1).buf, &lb, &nentry) == 0;
C2F(bexec)(C2F(cha1).buf, &lb, &ierr);
if (ierr != 0)
{
goto L15;
}
if (Eptover(1))
{
goto L98;
}
Pstk[Pt] = Top;
Rstk[Pt] = 706;
Ids[1 + Pt * nsiz] = iret;
/* *call* macro */
goto L88;
L97:
/* Rstk[Pt] == 706 indicates we return from a callback execution */
if (Rstk[Pt] == 706)
{
returnFromCallbackExec = TRUE;
}
Top = Pstk[Pt] - 1;
C2F(basbrk).interruptible = TRUE;
iret = Ids[1 + Pt * nsiz];
--Pt;
if (iret == 1)
{
goto L15;
}
else if (iret == 2)
{
if (Lpt[6] == Lpt[1])
{
job = 0;
}
else
{
/* go ahead with interrupted continuation line */
job = 3;
}
C2F(com).sym = eol;
goto L13;
}
else if (iret == 3)
{
job = 0;
goto L12;
}
else if (iret == 4)
{
return 0;
}
L98:
C2F(basbrk).interruptible = TRUE;
/* error recovery */
/* ------------------- */
imode = abs(C2F(errgst).errct) / 100000;
imode -= imode / 8 << 3;
if (imode == 3)
{
C2F(com).fun = 99;
return 0;
}
/* error in an external (niv), during compilation (comp) or in a pause */
if (Pt != 0)
{
if (Rstk[Pt] == 503 && C2F(iop).rio == C2F(iop).rte)
{
C2F(com).comp[0] = 0;
goto L12;
}
if (C2F(errgst).err1 != 0 && Rstk[Pt] == 502) /* catched error while compiling */
{
goto L88;
}
if (C2F(errgst).err1 != 0 && Rstk[Pt] == 808) /* catched error in a try */
{
goto L80;
}
}
if (C2F(recu).niv > 0) /* error in an external */
{
C2F(com).fun = 99;
return 0;
}
else if (C2F(recu).paus > 0) /* error in a pause */
{
C2F(com).comp[0] = 0;
goto L5;
}
else if (Err > 0)
{
Pt = 0;
C2F(errgst).errct = -1;
C2F(errgst).errpt = 0;
C2F(com).comp[0] = 0;
goto L5;
}
else
{
C2F(com).comp[0] = 0;
goto L5;
}
L99:
/* Recursion problems. Sorry */
SciError(22);
goto L1;
}
int C2F(run)(void)
{
/* Initialized data */
/* Fortran common data equivalence */
static int *Ids = C2F(recu).ids - nsiz - 1;
static int *Rstk = C2F(recu).rstk - 1;
static int *Pstk = C2F(recu).pstk - 1;
static int *Lstk = C2F(vstk).lstk - 1;
static int *Lin = C2F(iop).lin - 1;
static int *Lpt = C2F(iop).lpt - 1;
static int *Infstk = C2F(vstk).infstk - 1;
static int *Lct = C2F(iop).lct - 1;
static double equiv_4[1];
#define x (equiv_4)
#define ix ((int *)equiv_4)
/* Local variables */
static int ifin, iesc, ibpt, tref, ifun;
static int ierr, ndel;
static int j, k, m, n, p, r, t;
static int lname, imode;
static int l0;
static int id[6], lc, kc, nc, lb, li, il, io, ip;
static int ok;
static int ir, lr, op;
static int mm1;
static int nn1;
static int nentry, lastindpos;
static int lcc, kid, nlr;
int i2;
static char tmp[80]; /*string for sending debug messages*/
tref = 0;
/* set debug trace mode on */
if (C2F(iop).ddt == 4)
{
sprintf(tmp, " run pt:%d rstk(pt):%d", Pt, Rstk[Pt]);
C2F(basout)(&io, &C2F(iop).wte, tmp, (long)strlen(tmp));
}
l0 = 0;
nc = 0;
if (Ptover(0))
{
return 0;
}
r = Rstk[Pt];
ir = r / 100;
if (ir != 6)
{
goto L1;
}
switch ((int)(r - 600))
{
case 1:
goto L33;
case 2:
goto L66;
case 3:
goto L82;
case 4:
goto L92;
case 5:
goto L58;
case 6:
goto L116;
case 7:
goto L250;
case 8: /*Rstk[Pt]=1101;*/
goto L254;
case 9: /*Rstk[Pt]=1101;*/
goto L240;
}
L1: /* Start execution of a "compiled" function */
tref = clock();
C2F(errgst).toperr = Top;
k = Lpt[1] - (13 + nsiz);
lc = Lin[k + 7];
L10: /* Current opcode finished handle error, interruptions,...*/
if (Err > 0)
{
return 0;
}
if (C2F(basbrk).iflag)
{
C2F(basbrk).iflag = FALSE;
goto L91;
}
if (C2F(errgst).err1 != 0 )
{
if ((C2F(errgst).errpt > 0) && (Pt >= C2F(errgst).errpt) && (Rstk[C2F(errgst).errpt] == 618))
{
/* error under try catch */
for (p = Pt; p >= C2F(errgst).errpt; p--)
{
if (Rstk[p] <= 502 && Rstk[p] >= 501)
{
k = Lpt[1] - (13 + nsiz);
Lpt[1] = Lin[k + 1];
Lpt[2] = Lin[k + 2];
Lpt[3] = Lin[k + 3];
Lpt[4] = Lin[k + 4];
Lpt[6] = k;
C2F(recu).macr--;
if (Rstk[p - 1] == 909)
{
Top--; /* execed function*/
}
}
/* may it will be necessary to take care of for loop variables */
}
Pt = C2F(errgst).errpt;
goto L271;
}
/* errcatch in exec(function,'errcatch')
* or catched error in an external
* or errcatch in execstr('foo()','errcatch') */
if (C2F(errgst).errcatch == 0)
{
goto L999;
}
/* error under errcatch(....,'continue') */
/* @TODO : replace 903 909 1001 1002 by a #define ... */
if (Rstk[Pt - 1] == 903 || Rstk[Pt - 1] == 909 || Rstk[Pt] == 1001 || Rstk[Pt] == 1002)
{
return 0;
}
}
if (lc - l0 == nc) /* is current opcodes block (if, for, .. structure) finished ?*/
{
/* yes */
r = Rstk[Pt] - 610;
switch (r)
{
case 1:
goto L46;
case 2:
goto L47;
case 3:
goto L52;
case 4:
goto L56;
case 5:
goto L57;
case 6:
goto L61;
case 8:
goto L271;
case 9:
goto L272;
}
}
L11: /* next opcode */
op = *istk(lc);
/* label 49 retains to be able issue a compatibility error message */
switch ((int)op) /* step to corresponding part*/
{
case 1:
goto L20;
case 2:
goto L25;
case 3:
goto L40;
case 4:
goto L42;
case 5:
goto L30;
case 6:
goto L41;
case 7:
goto L45;
case 8:
goto L49;
case 9:
goto L49;
case 10:
goto L55;
case 11:
goto L270;/* try */
case 12:
goto L90;
case 13:
goto L95;
case 14:
goto L100;
case 15:
goto L105;
case 16:
goto L110;
case 17:
goto L120;
case 18:
goto L130;
case 19:
goto L140;
case 20:
goto L150;
case 21:
goto L160;
case 22:
goto L170;
case 23:
goto L180;
case 24:
goto L190;
case 25:
goto L200;
case 26:
goto L210;
case 27:
goto L220;
case 28:
goto L97;
case 29:
goto L230;
case 30:
goto L260;
case 31:
goto L261;
}
if (op >= 100)
{
/* ------------- primitive call (matfn's) -------------- */
goto L80;
}
if (op == 99)
{
/* ------------- return -------------------------------- */
/* check if "return" occurred in a for loop */
p = Pt + 1;
L12:
--p;
if (Rstk[p] == 612)
{
/* yes, remove the for loop variable */
--Top;
goto L12;
}
else if (Rstk[p] != 501)
{
goto L12;
}
Fin = 2;
goto L998;
}
if (op <= 0)
{
/* ------------- nop ---------------------------------- */
lc += *istk(1 + lc);
goto L11;
}
SciError(60);
return 0;
L20: /* stackp, retplaced by assign */
/* retained for 2.7 and earlier versions compatibility */
C2F(stackp)(istk(1 + lc), &c__0);
/* store info if printing is required see code 22 */
C2F(putid)(id, istk(1 + lc));
kid = Fin;
lc += 7;
goto L10;
L25: /* stackg */
Fin = *istk(7 + lc);
ifin = Fin;
Rhs = *istk(8 + lc);
lname = lc + 1;
L26:
C2F(stackg)(istk(lname));
if (Err > 0 || C2F(errgst).err1 > 0)
{
lc += 9;
goto L10;
}
if (Fin != 0) /* variable exists */
{
goto L28;
}
C2F(funs)(istk(1 + lc)); /* check if it is a function */
if (Err > 0 || C2F(errgst).err1 > 0)
{
lc += 9;
goto L10;
}
if (C2F(com).fun != -2)
{
C2F(putid)(&Ids[1 + (Pt + 1) * nsiz ], istk(1 + lc));
if (C2F(com).fun == 0)
{
/* the search variable is neither a regular variable nor a function in a librar */
/* it may be a simple variable in a lib */
C2F(stackg)(istk(lname));
if (Err > 0 || C2F(errgst).err1 > 0)
{
lc += 9;
goto L10;
}
if (Fin == 0)
{
SciError(4);
if (Err > 0 || C2F(errgst).err1 > 0)
{
lc += 9;
goto L10;
}
}
}
else
{
/* referenced name was function at compile time it is now a
* primitive. Modify the code for further use */
if (ifin != -4 && ifin != 0)
{
/* function call */
/* change current opcode to nop */
*istk(lc) = 0;
*istk(1 + lc) = 9;
lc += 9;
/* change the following opcode to matfn opcode */
op = C2F(com).fun * 100;
*istk(lc) = op;
*istk(1 + lc) = *istk(2 + lc) - 1;
*istk(2 + lc) = *istk(3 + lc);
*istk(3 + lc) = Fin;
goto L80;
}
else
{
/* only reference to a function */
/* stackg opcode replaced by varfun opcode */
*istk(lc) = 27;
*istk(1 + lc) = C2F(com).fun;
*istk(2 + lc) = Fin;
C2F(putid)(istk(3 + lc), &Ids[1 + (Pt + 1) * nsiz]);
goto L10;
}
}
lc += 9;
goto L10;
}
Fin = *istk(7 + lc);
goto L26;
L28:
if (Rhs == 0 && ((*istk(7 + lc) == -2) || (*istk(7 + lc) == -1)) && Fin == -1)
{
lc += 9;
if (*istk(7 + lc - 9) == -2)
{
/* instruction reduced to <name> with name not a function, replace */
/* next two op code by a single store */
/* skip extract op-code <5 3 1 1> */
if (*istk(lc) != 5 || *istk(1 + lc) != 3)
{
strcpy(C2F(cha1).buf, _("Unexpected opcode, please report into the Scilab bug tracker."));
SciError(9999);
return 0;
}
lc += 4;
}
/* skip assignment op_code <29 43 ans 0> */
if (*istk(lc) != 29)
{
strcpy(C2F(cha1).buf, _("Unexpected opcode, please report into the Scilab bug tracker."));
SciError(9999);
return 0;
}
lc += 10;
/* store */
Rhs = 1;
C2F(ref2val)();
C2F(stackp)(istk(lname), &c__0);
if (Err > 0 || C2F(errgst).err1 > 0)
{
goto L10;
}
goto L10;
}
lc += 9;
if (Fin > 0)
{
goto L65;
}
goto L10;
/* allops */
L30:
Fin = *istk(1 + lc);
Rhs = *istk(2 + lc);
Lhs = *istk(3 + lc);
lc += 4;
if (Fin == extrac)
{
C2F(isafunptr)(&Top, id, &ifun, &ifin);
if (ifun != 0)
{
--Top;
--Rhs;
C2F(com).fun = ifun;
Fin = ifin;
C2F(adjustrhs)();
goto L81;
}
}
if (Fin == extrac || Fin == insert)
{
C2F(adjustrhs)();
}
++Pt;
Rstk[Pt] = 601;
Ids[1 + Pt * nsiz] = tref;
Ids[3 + Pt * nsiz] = l0;
Ids[4 + Pt * nsiz] = nc;
C2F(recu).icall = 4;
/* pstk(pt) is used by allops to get the name of output variable (insertion) */
Pstk[Pt] = lc;
/* *call* allops */
return 0;
L33:
tref = Ids[1 + Pt * nsiz];
l0 = Ids[3 + Pt * nsiz];
nc = Ids[4 + Pt * nsiz];
lc = Pstk[Pt];
--Pt;
goto L70;
/* string */
L40:
n = *istk(1 + lc);
if (C2F(errgst).err1 <= 0)
{
++Top;
if (C2F(cresmat)("run", &Top, &c__1, &c__1, &n, 3L))
{
C2F(getsimat)("run", &Top, &Top, &mm1, &nn1, &c__1, &
c__1, &lr, &nlr, 3L);
C2F(icopy)(&n, istk(2 + lc), &c__1, istk(lr), &c__1);
}
}
lc = lc + n + 2;
goto L10;
/* num */
L41:
if (C2F(errgst).err1 <= 0)
{
if (C2F(getendian)() == 1)
{
ix[0] = *istk(1 + lc);
ix[1] = *istk(2 + lc);
}
else
{
ix[1] = *istk(1 + lc);
ix[0] = *istk(2 + lc);
}
++Top;
if (C2F(cremat)("run", &Top, &c__0, &c__1, &c__1, &lr, &lcc, 3L))
{
*stk(lr) = *x;
}
}
lc += 3;
goto L10;
L42:
C2F(defmat)();
++lc;
goto L10;
/* for */
L45:
nc = *istk(1 + lc);
lc += 2;
l0 = lc;
if (Ptover(1))
{
lc += nc;
lc = lc + nsiz + *istk(lc);
goto L10;
}
Rstk[Pt] = 611;
Ids[1 + Pt * nsiz] = l0;
Ids[2 + Pt * nsiz] = nc;
goto L10;
L46:
nc = *istk(lc);
l0 = lc + 7;
if (C2F(errgst).errcatch >= 1 && C2F(errgst).err1 > 0)
{
/*an error occurred in the loop variable expression evaluation, in 'continue' mode
skip all the for codes*/
lc = l0;
goto L48;
}
Rstk[Pt] = 612;
Pstk[Pt] = 0;
Ids[1 + Pt * nsiz] = l0;
Ids[2 + Pt * nsiz] = Lct[8];
Ids[3 + Pt * nsiz] = Top;
Ids[4 + Pt * nsiz] = C2F(errgst).toperr;
C2F(errgst).toperr = Top;
L47:
lc = l0;
if (Top != Ids[3 + Pt * nsiz])
{
SciError(115);
goto L48;
}
C2F(nextj)(istk(1 + l0 - 7), &Pstk[Pt]);
if (Pstk[Pt] != 0)
{
Lct[8] = Ids[2 + Pt * nsiz];
if (ismenu() == 1 && C2F(basbrk).interruptible)
{
goto L115;
}
goto L10;
}
/* fin for */
L48:
lc += nc;
C2F(errgst).toperr = Ids[4 + Pt * nsiz];
--Pt;
goto L70;
/* Very old if - while (removed) */
L49:
if (*istk(1 + lc) < 0)
{
goto L55;
}
L52:
strcpy(C2F(cha1).buf, _("Functions compiled with very old versions are no more handled."));
SciError(997);
return 0;
/* "select- case" or "if elseif else end" */
L55:
if (Ptover(1))
{
lc += (i2 = *istk(1 + lc), abs(i2));
goto L10;
}
Pstk[Pt] = lc;
Ids[3 + Pt * nsiz] = C2F(errgst).toperr;
L551:
if (*istk(1 + lc) > 0)
{
/* first expression */
nc = *istk(3 + lc);
Rstk[Pt] = 614;
lc += 4;
l0 = lc;
Ids[1 + Pt * nsiz] = l0;
Ids[2 + Pt * nsiz] = nc;
goto L10;
}
else
{
lc += 4;
}
/* expri */
L56:
if (C2F(errgst).errcatch >= 1 && C2F(errgst).err1 > 0 )
{
/*an error occurred in the first expression evaluation, in 'continue' mode
skip all the control structure codes*/
goto L62;
}
if (*istk(Pstk[Pt]) == 10)
{
/* copy first expression */
i2 = Top + 1;
if (! C2F(vcopyobj)("run", &Top, &i2, 3L))
{
return 0;
}
++Top;
}
nc = *istk(lc);
Rstk[Pt] = 615;
++lc;
l0 = lc;
Ids[1 + Pt * nsiz] = l0;
Ids[2 + Pt * nsiz] = nc;
goto L10;
/* instructions i */
L57:
if (C2F(errgst).errcatch >= 1 && C2F(errgst).err1 > 0 )
{
/*an error occurred in the first expression evaluation, in 'continue' mode
skip all the control structure codes*/
goto L62;
}
if (nc == 0)
{
/* if nc=0 the instruction correspond to the else */
ok = TRUE;
if (*istk(Pstk[Pt]) == 10)
{
--Top;
}
goto L59;
}
else if (*istk(Pstk[Pt]) != 10)
{
ok = Istrue(1);
if (Err > 0 || C2F(errgst).err1 > 0)
{
goto L10;
}
goto L59;
}
++Pt;
Fin = equal;
Rhs = 2;
Lhs = 1;
Rstk[Pt] = 605;
C2F(recu).icall = 4;
Pstk[Pt] = lc;
Ids[1 + Pt * nsiz] = tref;
/* *call* allops(equal) */
return 0;
L58:
if (C2F(errgst).errcatch >= 1 && C2F(errgst).err1 > 0 )
{
/*an error occurred in the first expression evaluation, in 'continue' mode
skip all the control structure codes*/
goto L62;
}
lc = Pstk[Pt];
tref = Ids[1 + Pt * nsiz];
--Pt;
ok = Istrue(1);
if (Err > 0 || C2F(errgst).err1 > 0)
{
goto L10;
}
L59:
nc = *istk(lc);
C2F(errgst).toperr = Top;
if (ok)
{
++lc;
if (*istk(Pstk[Pt]) == 10)
{
--Top;
}
l0 = lc;
Ids[1 + Pt * nsiz] = l0;
Ids[2 + Pt * nsiz] = nc;
Rstk[Pt] = 616;
if (ismenu() == 1 && C2F(basbrk).interruptible)
{
goto L115;
}
goto L10;
}
else
{
if (*istk(Pstk[Pt]) == 9)
{
goto L62;
}
lc = lc + nc + 1;
goto L56;
}
L61:
/* fin if while select/case */
l0 = Pstk[Pt];
if (*istk(Pstk[Pt]) == 9)
{
lc = l0 + 4;
goto L56;
}
L62:
l0 = Pstk[Pt];
lc = l0 + (i2 = *istk(1 + l0), abs(i2));
C2F(errgst).toperr = Ids[3 + Pt * nsiz];
--Pt;
goto L70;
/* macro */
L65:
i2 = *istk(2 + lc) - 1;
Rhs = Max(i2, 0);
C2F(adjustrhs)();
Lhs = *istk(3 + lc);
lc += 4;
if (Ptover(1))
{
goto L10;
}
Rstk[Pt] = 602;
Pstk[Pt] = lc;
/* Ids[1 + Pt * nsiz] = C2F(dbg).wmac; *//*moved into macro.f*/
Ids[2 + Pt * nsiz] = tref;
Ids[3 + Pt * nsiz] = l0;
Ids[4 + Pt * nsiz] = nc;
C2F(recu).icall = 5;
C2F(com).fun = 0;
/* *call* macro */
return 0;
L66:
lc = Pstk[Pt];
/*C2F(dbg).wmac = Ids[1 + Pt * nsiz];*//*moved into macro.f*/
tref = Ids[2 + Pt * nsiz];
l0 = Ids[3 + Pt * nsiz];
nc = Ids[4 + Pt * nsiz];
--Pt;
goto L70;
L70:
/* re entering run to continue macro evaluation */
if (ismenu() == 1 && C2F(basbrk).interruptible)
{
goto L115;
}
L71:
/* reset proper values for l0 and nc if a control structure had been escaped*/
r = Rstk[Pt] - 610;
switch ((int)r)
{
case 1:
l0 = Ids[1 + Pt * nsiz];
nc = Ids[2 + Pt * nsiz];
goto L10;
case 2: /* back to a for */
j = Pstk[Pt];
l0 = Ids[1 + Pt * nsiz];
nc = *istk(l0 - 7);
goto L10;
case 3: /* back to an if or a while */
li = Ids[1 + Pt * nsiz];
kc = Ids[2 + Pt * nsiz];
nc = *istk(2 + li);
l0 = li + 5;
if (kc == 0)
{
goto L10;
}
l0 += nc;
nc = *istk(3 + li);
if (kc == 1)
{
goto L10;
}
l0 += nc;
nc = *istk(4 + li);
goto L10;
case 4:
case 5:
case 6:
/* back to a select case */
l0 = Ids[1 + Pt * nsiz];
nc = Ids[2 + Pt * nsiz];
goto L10;
case 8: /*back to a try*/
l0 = Ids[1 + Pt * nsiz];
nc = *istk(l0 - 2);
goto L10;
case 9: /*back to a catch*/
l0 = Ids[1 + Pt * nsiz];
nc = *istk(l0 - 1);
l0 = l0 + *istk(l0 - 2);
goto L10;
default :
goto L10;
}
L80:
C2F(com).fun = op / 100;
Rhs = *istk(1 + lc);
C2F(adjustrhs)();
Lhs = *istk(2 + lc);
Fin = *istk(3 + lc);
lc += 4;
L81:
++Pt;
Rstk[Pt] = 603;
Pstk[Pt] = lc;
C2F(recu).icall = 9;
Ids[2 + Pt * nsiz] = 0;
Ids[3 + Pt * nsiz] = tref;
Ids[4 + Pt * nsiz] = l0;
Ids[5 + Pt * nsiz] = nc;
/* *call* matfns */
return 0;
L82:
/* warning if builtin is "resume" control is passed to macro and not here */
lc = Pstk[Pt];
tref = Ids[3 + Pt * nsiz];
l0 = Ids[4 + Pt * nsiz];
nc = Ids[5 + Pt * nsiz];
--Pt;
goto L70;
/* pause */
L90:
++lc;
L91:
if (Ptover(1))
{
goto L10;
}
Pstk[Pt] = C2F(iop).rio;
C2F(iop).rio = C2F(iop).rte;
Fin = 2;
if (Lct[4] <= -10)
{
Fin = -1;
Lct[4] = -Lct[4] - 11;
}
Ids[1 + Pt * nsiz] = lc;
Ids[2 + Pt * nsiz] = Top;
Ids[3 + Pt * nsiz] = tref;
Ids[4 + Pt * nsiz] = l0;
Ids[5 + Pt * nsiz] = nc;
Rstk[Pt] = 604;
C2F(recu).icall = 5;
/* *call* macro */
return 0;
L92:
lc = Ids[1 + Pt * nsiz];
Top = Ids[2 + Pt * nsiz];
tref = Ids[3 + Pt * nsiz];
l0 = Ids[4 + Pt * nsiz];
nc = Ids[5 + Pt * nsiz];
C2F(iop).rio = Pstk[Pt];
--Pt;
goto L70;
/* break */
L95:
p = Pt + 1;
L96:
--p;
if (p == 0)
{
++lc;
goto L10;
}
if (Rstk[p] == 612)
{
/* break in a for */
l0 = Ids[1 + p * nsiz];
lc = l0 + *istk(1 + l0 - 8);
Pt = p - 1;
--Top;
goto L70;
}
else if (Rstk[p] == 616 && *istk(1 + Pstk[p] - 1) == 9)
{
/* break in a while */
l0 = Pstk[p];
lc = l0 + (i2 = *istk(1 + l0), abs(i2));
Pt = p - 1;
goto L70;
}
else if (Rstk[p] == 501 || Rstk[p] == 502 ||
Rstk[p] == 503)
{
/* going outside a function an exec (break ignored) */
++lc;
goto L10;
}
else
{
goto L96;
}
/* continue */
L97:
p = Pt + 1;
L98:
--p;
if (p == 0)
{
++lc;
goto L10;
}
if (Rstk[p] == 612)
{
/* continue in a for */
l0 = Ids[1 + p * nsiz];
/* nc is required for the end of loop */
lc = l0 - 7;
nc = *istk(lc);
Pt = p;
goto L47;
}
else if (Rstk[p] == 616 && *istk(1 + Pstk[p] - 1) == 9)
{
/* continue in a while */
l0 = Pstk[p];
lc = l0;
nc = *istk(lc);
Pt = p;
goto L551;
}
else
{
goto L98;
}
/* abort */
L100:
++Pt;
L101:
--Pt;
if (Pt == 0)
{
goto L102;
}
if (Rstk[Pt] / 100 == 5)
{
k = Lpt[1] - (13 + nsiz);
Lpt[1] = Lin[1 + k];
Lpt[2] = Lin[2 + k];
Lpt[3] = Lin[3 + k];
Lpt[4] = Lin[4 + k];
Lct[4] = Lin[6 + k ];
Lpt[6] = k;
if (Rstk[Pt] <= 502)
{
if (Pt > 1)
{
if (Rstk[Pt - 1] != 903 && Rstk[Pt - 1] != 909 && Rstk[Pt - 1] != 706)
{
Bot = Lin[5 + k];
}
}
else
{
Bot = Lin[5 + k];
}
}
else if (Rstk[Pt] == 503)
{
if (C2F(iop).rio == C2F(iop).rte)
{
/* abort in a pause mode */
C2F(iop).rio = Pstk[Pt - 1];
C2F(recu).paus--;
Bot = Lin[5 + k];
}
else
{
int mode[3];
int lunit = -C2F(iop).rio;
/* abort in an exec*/
mode[0] = 0;
C2F(clunit)(&lunit, C2F(cha1).buf, mode);
C2F(iop).rio = Pstk[Pt - 1];
}
}
}
goto L101;
L102:
C2F(recu).icall = 10;
Top = 0;
C2F(com).comp[0] = 0;
if (C2F(recu).niv > 1)
{
Err = 9999999;
}
return 0;
L105:
/* eol */
/* la gestion de la recuperation des erreurs devrait plutot se trouver */
/* a la fin de l'instruction (mais il n'y a pas actuellement d'indicateur */
/* de fin d'instruction dans les macros */
if (C2F(errgst).err1 != 0)
{
if (C2F(errgst).err2 == 0)
{
C2F(errgst).err2 = C2F(errgst).err1;
}
if (C2F(errgst).errcatch > 0)
{
/* running under errcatch(num,....) */
if (Rstk[Pt] != 614 && Rstk[Pt] != 615 && Rstk[Pt] != 605)
{
C2F(errgst).err1 = 0;
}
if (Pt < C2F(errgst).errpt)
{
C2F(errgst).errcatch = 0;
}
}
imode = (i2 = C2F(errgst).errct / 100000, abs(i2));
if (imode - (imode / 8 << 3) == 2)
{
C2F(basbrk).iflag = TRUE;
}
}
/* gestion des points d'arrets dynamiques */
if (C2F(dbg).nmacs != 0) /* there are breakpoints set */
{
int kfin = C2F(dbg).wmac - 1; /*the stack index of the current function*/
/* first test if the function has breakpoints */
int kmac;
for (kmac = 0; kmac < C2F(dbg).nmacs; kmac++) /* loop on table of functions containing breakpoints */
{
/* does the name of the current function fit the registered name*/
if (C2F(eqid)(&(C2F(vstk).idstk[kfin * nsiz]), &(C2F(dbg).macnms[kmac * nsiz]))) /* yes */
{
/* test if there is a registered breakpoint at the current line*/
i2 = C2F(dbg).lgptrs[kmac + 1] - 1;
for (ibpt = C2F(dbg).lgptrs[kmac]; ibpt <= i2; ++ibpt)
{
if (Lct[8] == C2F(dbg).bptlg[ibpt - 1]) /* yes */
{
/* display a message */
C2F(cvname)(&C2F(dbg).macnms[kmac * nsiz], tmp, &c__1, 24L);
sprintf(C2F(cha1).buf, "%s %5d", tmp, Lct[8]);
Msgs(32, 0);
/* raise the interruption flag */
C2F(basbrk).iflag = TRUE;
goto L107;
}
}
break;
}
}
}
L107:
if (Lct[4] / 2 % 2 == 1)
{
i2 = Lct[4] / 4;
C2F(prompt)(&i2, &iesc);
}
++Lct[8];
++lc;
if (ismenu() == 1 && C2F(basbrk).interruptible)
{
goto L115;
}
goto L10;
/* set line number.
*
* Au debut de chaque expression liee a un then et a la fin de
* chaque clause, le compilateur (compcl) inscrit la valeur de la
* ligne. ceci permet de mettre rapidement a jour le compteur de
* ligne sans avoir a analyser la suite des codes operatoires */
L110:
Lct[8] = *istk(1 + lc);
lc += 2;
goto L10;
/* gestion des evements asynchrones "interpretes" */
L115:
C2F(basbrk).interruptible = C2F(getmen)(C2F(cha1).buf, &lb, &nentry) == 0;
C2F(bexec)(C2F(cha1).buf, &lb, &ierr);
if (ierr != 0)
{
goto L10;
}
++Pt;
Ids[1 + Pt * nsiz] = lc;
Ids[2 + Pt * nsiz] = l0;
Ids[3 + Pt * nsiz] = nc;
Ids[4 + Pt * nsiz] = tref;
Rstk[Pt] = 606;
C2F(recu).icall = 5;
/* *call* macro */
return 0;
L116:
C2F(basbrk).interruptible = TRUE;
lc = Ids[1 + Pt * nsiz];
l0 = Ids[2 + Pt * nsiz];
nc = Ids[3 + Pt * nsiz];
tref = Ids[4 + Pt * nsiz];
--Top;
--Pt;
goto L71;
/* r = Rstk[Pt] - 610;
switch ((int)r) {
case 1: goto L74;
case 2: goto L71;
case 3: goto L72;
case 4: goto L73;
case 5: goto L73;
case 6: goto L73;
}
goto L10;*/
/* quit */
L120:
if (C2F(recu).paus != 0)
{
/* quit in a pause: decrease recursion level up to the pause one (Rstk[Pt] == 503) */
Pt = Pt + 1;
L121:
Pt = Pt - 1;
/* suppress loop variables if any */
if (Rstk[Pt] == 802 || Rstk[Pt] == 612 ||
(Rstk[Pt] == 805 && Ids[1 + Pt * nsiz] == iselect) ||
(Rstk[Pt] == 616 && Pstk[Pt] == 10))
{
Top--;
}
if (Rstk[Pt] != 503)
{
goto L121;
}
/* recall macro to terminate the pause level */
C2F(com).fun = 0;
return 0;
}
else
{
C2F(com).fun = 99;
}
return 0;
/* named variable */
L130:
Infstk[Top] = 1;
C2F(putid)(&C2F(vstk).idstk[Top * nsiz - nsiz], istk(1 + lc));
lc += 7;
goto L10;
/* form recursive extraction list */
L140:
m = *istk(2 + lc);
if (Rstk[Pt] == 617)
{
/* runtime arg count (list extraction) */
m += Pstk[Pt];
Pstk[Pt] = 0;
}
C2F(mkindx)(istk(1 + lc), &m);
lc += 3;
goto L10;
/* exit */
L150:
++lc;
if (C2F(recu).niv > 0)
{
sciquit();
exit(0); /* stop */
}
C2F(com).fun = 99;
goto L10;
/* begrhs - for run time rhs value computation */
/* syntax like: l=list(...); a(l(:)) */
L160:
++lc;
++Pt;
Rstk[Pt] = 617;
Pstk[Pt] = 0;
goto L10;
/* printmode */
L170:
/* print stored variable */
if (Lct[4] >= 0 && *istk(1 + lc) != semi && kid != 0)
{
C2F(print)(id, &kid, &C2F(iop).wte);
}
lc += 2;
goto L10;
L180:
/* name2var */
C2F(name2var)(istk(1 + lc));
lc += 7;
goto L10;
L190:
/* deffnull */
++lc;
++Top;
C2F(objvide)(" ", &Top, 1L);
goto L10;
L200:
/* profile */
++*istk(1 + lc);
t = clock();
*istk(2 + lc) = *istk(2 + lc) + t - tref;
tref = t;
lc += 3;
goto L10;
L210:
/* character string vector */
if (C2F(errgst).err1 <= 0)
{
n = *istk(1 + lc) **istk(2 + lc);
nc = *istk(lc + 4 + n) - 1;
++Top;
il = Lstk[Top] + Lstk[Top] - 1;
i2 = il + 5 + n + nc;
Err = i2 / 2 + 1 - Lstk[Bot];
if (Err > 0 || C2F(errgst).err1 > 0)
{
SciError(17);
lc = lc + 5 + n + nc;
goto L10;
}
i2 = n + 5 + nc;
C2F(icopy)(&i2, istk(lc), &c__1, istk(il), &c__1);
*istk(il) = 10;
i2 = il + 5 + n + nc;
Lstk[1 + Top] = i2 / 2 + 1;
}
lc = lc + 5 + n + nc;
goto L10;
L220:
/* varfun */
C2F(varfunptr)(istk(3 + lc), istk(1 + lc), istk(2 + lc));
lc += 9;
goto L10;
L230:
/* affectation */
Lhs = *istk(1 + lc);
ip = *istk(2 + lc);
li = lc + 3;
lc = li + Lhs * 7;
/* following code is an adaptation of corresponding code in parse.f */
ndel = 0;
L231:
Rhs = *istk(6 + li);
lastindpos = Top - Lhs - ndel;
if (C2F(errgst).err1 != 0)
{
goto L253;
}
if (Rhs == 0)
{
/* goto simple affectation */
C2F(stackp)(istk(li), &c__0);
if (Err > 0 || C2F(errgst).err1 > 0)
{
goto L10;
}
if (C2F(errgst).err1 > 0)
{
goto L253;
}
/* fin points on the newly saved variable */
if (!(Lct[4] >= 0 && ip != semi && Fin != 0))
{
goto L253;
}
ifin = Fin;
L232:
C2F(print)(istk(li), &ifin, &C2F(iop).wte);
if (Rstk[Pt] != 1101)
{
goto L253;
}
++Pt;
Pstk[Pt] = li;
Ids[1 + Pt * nsiz] = ndel;
Ids[2 + Pt * nsiz] = lastindpos;
Ids[3 + Pt * nsiz] = tref;
Ids[4 + Pt * nsiz] = l0;
Ids[5 + Pt * nsiz] = Lhs;
Ids[6 + Pt * nsiz] = nc;
Rstk[Pt] = 609;
return 0;
L240:
li = Pstk[Pt];
ip = *istk(li - 1);
ndel = Ids[1 + Pt * nsiz];
lastindpos = Ids[2 + Pt * nsiz];
tref = Ids[3 + Pt * nsiz];
l0 = Ids[4 + Pt * nsiz];
Lhs = Ids[5 + Pt * nsiz];
nc = Ids[6 + Pt * nsiz];
--Pt;
/*goto L253;*/
goto L232;
}
/* take rhs (number of indices) computed at runtime into account */
C2F(adjustrhs)();
/* partial variable affectation (insertion) */
if (lastindpos + 1 != Top)
{
/* create reference variables to get index1,...,indexn, value at */
/* the top of the stack in this order */
/* create reference variables pointing to the indices */
for (ir = 1; ir <= Rhs; ++ir)
{
i2 = lastindpos - Rhs + ir;
C2F(createref1)(&i2);
}
/* create reference variable pointing to the value */
i2 = Top - Rhs;
C2F(createref1)(&i2);
/* remind to remove the original indices */
ndel += Rhs;
}
lastindpos -= Rhs;
/* put a reference to the lhs variable */
Fin = -3;
C2F(stackg)(istk(li));
if (Err > 0 || C2F(errgst).err1 > 0)
{
goto L10;
}
/* perform insertion operation */
/* index1,...,indexn, value ==> updated lhs value (or pointer to) */
if (Eptover(1))
{
return 0;
}
/* pstk(pt) is used by allops to get the name of output variable */
Pstk[Pt] = li;
Ids[1 + Pt * nsiz] = ndel;
Ids[2 + Pt * nsiz] = lastindpos;
Ids[3 + Pt * nsiz] = tref;
Ids[4 + Pt * nsiz] = l0;
Ids[5 + Pt * nsiz] = Lhs;
Ids[6 + Pt * nsiz] = nc;
Rstk[Pt] = 607;
Rhs += 2;
Lhs = 1;
C2F(recu).icall = 4;
Fin = insert;
/* *call* allops(insert) */
return 0;
L250:
li = Pstk[Pt];
ip = *istk(li - 1);
ndel = Ids[1 + Pt * nsiz];
lastindpos = Ids[2 + Pt * nsiz];
tref = Ids[3 + Pt * nsiz];
l0 = Ids[4 + Pt * nsiz];
Lhs = Ids[5 + Pt * nsiz];
nc = Ids[6 + Pt * nsiz];
--Pt;
/* store the updated value */
C2F(stackp)(istk(li), &c__0);
if (Err > 0 || C2F(errgst).err1 > 0)
{
goto L10;
}
if (C2F(errgst).err1 > 0)
{
goto L253;
}
/* fin points on the newly saved variable */
if (!(Lct[4] >= 0 && ip != semi && Fin != 0))
{
goto L252;
}
ifin = Fin;
L251:
C2F(print)(istk(li), &ifin, &C2F(iop).wte);
if (Rstk[Pt] != 1101)
{
goto L252;
}
++Pt;
Pstk[Pt] = li;
Ids[1 + Pt * nsiz] = ndel;
Ids[2 + Pt * nsiz] = lastindpos;
Ids[3 + Pt * nsiz] = tref;
Ids[4 + Pt * nsiz] = l0;
Ids[5 + Pt * nsiz] = Lhs;
Ids[6 + Pt * nsiz] = nc;
Rstk[Pt] = 608;
return 0;
L254:
li = Pstk[Pt];
ip = *istk(li - 1);
ndel = Ids[1 + Pt * nsiz];
lastindpos = Ids[2 + Pt * nsiz];
tref = Ids[3 + Pt * nsiz];
l0 = Ids[4 + Pt * nsiz];
Lhs = Ids[5 + Pt * nsiz];
nc = Ids[6 + Pt * nsiz];
--Pt;
goto L251;
L252:
/* remove variable containing the value if required */
if (lastindpos != Top)
{
--Top;
}
L253:
li += 7;
--Lhs;
if (Lhs > 0)
{
goto L231;
}
Top -= ndel;
lc = li;
goto L10;
/* logical expression shortcircuit */
L260:
if (*istk(1 + lc) == 1)
{
/* | case */
if (C2F(gettype)(&Top) != sci_ints && Istrue(0))
{
lc += *istk(2 + lc);
}
}
else
{
/* & case */
if (C2F(gettype)(&Top) != sci_ints && ! Istrue(0))
{
lc += *istk(2 + lc);
}
}
lc += 3;
goto L10;
/* comment */
L261:
lc += 2 + *istk(1 + lc);
goto L10;
/* try catch */
L270:
nc = *istk(1 + lc);
lc += 3;
l0 = lc;
if (Ptover(1))
{
lc += nc;
lc += nsiz + *istk(lc);
goto L10;
}
Rstk[Pt] = 618;
Ids[1 + Pt * nsiz] = l0;
/* preserve current error modes */
Ids[2 + Pt * nsiz] = C2F(errgst).errct;
Ids[3 + Pt * nsiz] = C2F(errgst).err2;
Ids[4 + Pt * nsiz] = C2F(errgst).err1;
Ids[5 + Pt * nsiz] = C2F(errgst).errpt;
Ids[6 + Pt * nsiz] = (Lct[4] + 100) + 10000 * C2F(com).sym;
/* set error recovery mode without message*/
C2F(errgst).errct = -(900000 + 1);
C2F(errgst).errpt = Pt;
Pstk[Pt] = Top;
goto L10;
L271:
/* try op-codes finished*/
l0 = Ids[1 + Pt * nsiz];
/*check if an error occurred*/
ok = Max(C2F(errgst).err2, C2F(errgst).err1) <= 0;
/* restore preserved error modes */
C2F(errgst).errct = Ids[2 + Pt * nsiz];
C2F(errgst).err2 = Ids[3 + Pt * nsiz];
C2F(errgst).err1 = Ids[4 + Pt * nsiz];
C2F(errgst).errpt = Ids[5 + Pt * nsiz];
C2F(com).sym = Ids[6 + Pt * nsiz] / 10000;
Lct[4] = Ids[6 + Pt * nsiz] - 10000 * C2F(com).sym - 100;
if (ok)
{
/* no error occurred in the try part*/
nc = *istk(l0 - 1);
lc += nc; /*skip catch instructions*/
/* finish try catch context and continue*/
--Pt;
goto L70;
}
/*an error occurred in the try part*/
lc = l0 + *istk(l0 - 2); /*skip remaining try instruction*/
nc = *istk(l0 - 1);
/*execute catch instructions (next op-codes)*/
l0 = lc;
Rstk[Pt] = 619;
goto L10;
L272:
/* catch op-codes finished*/
/* close "try catch" context and continue*/
--Pt;
goto L70;
L998:
Lhs = 0;
L999:
/*remove context down to current running macro */
if (Rstk[Pt] != 501)
{
--Pt;
goto L999;
}
C2F(com).fun = 0;
return 0;
#undef ix
#undef x
}