/**************************************************************************** ** ** This file is part of GAP, a system for computational discrete algebra. ** ** Copyright of GAP belongs to its developers, whose names are too numerous ** to list here. Please refer to the COPYRIGHT file for details. ** ** SPDX-License-Identifier: GPL-2.0-or-later ** ** This file contains the functions of the immediate interpreter package. ** ** The immediate interpreter package is the part of the interpreter that ** interprets code immediately (while it is read). Its functions are called ** from the reader. When it encounters constructs that it cannot interpret ** immediately, it switches into coding mode, and delegates the work to the ** coder.
*/
// INTERPRETER_PROFILE_HOOK deals with profiling of immediately executed // code. // If intr->coding is true, profiling is handled by the AST // generation and execution. Otherwise, we always mark the line as // read, and mark as executed if intr->returning and intr->ignoring // are both false. // // IgnoreLevel gives the highest value of IntrIgnoring which means this // statement is NOT ignored (this is usually, but not always, 0) staticvoid INTERPRETER_PROFILE_HOOK(IntrState * intr, int ignoreLevel)
{ if (!intr->coding) {
InterpreterHook(
intr->gapnameid, intr->startLine,
intr->returning != STATUS_END || (intr->ignoring > ignoreLevel));
}
intr->startLine = 0;
}
// Put the profiling hook into SKIP_IF_RETURNING, as this is run in // (nearly) every part of the interpreter, avoid lots of extra code. #define SKIP_IF_RETURNING() \
INTERPRETER_PROFILE_HOOK(intr, 0); \
SKIP_IF_RETURNING_NO_PROFILE_HOOK();
// Need to #define SKIP_IF_RETURNING_NO_PROFILE_HOOK() \ if (intr->returning != STATUS_END) { \ return; \
}
/**************************************************************************** ** *F PushObj(<val>) . . . . . . . . . . . . . . . . push value onto the stack *F PushVoidObj() . . . . . . . . . . . . . . push void value onto the stack *F PopObj() . . . . . . . . . . . . . . . . . . . pop value from the stack *F PopVoidObj() . . . . . . . . . . . . . . . . . pop value from the stack ** ** 'intr->StackObj' is the stack of values. ** ** 'PushObj' pushes the value <val> onto the values stack. It is an error ** to push the void value. The stack is automatically resized if necessary. ** ** 'PushVoidObj' pushes the void value onto the values stack. This value is ** the value of if-statements and loops and procedure calls. ** ** 'PopObj' returns the top element from the values stack and pops it. It ** is an error if the stack is empty or if the top element is void. ** ** 'PopVoidObj' returns the top element from the values stack and pops it. ** It is an error if the stack is empty but not if the top element is void.
*/
/* Special marker value to denote that a function returned no value, so we * can produce a useful error message. This value only ever appears on the * stack, and should never be visible outside the Push and Pop methods below * * The only place other than these methods which access the stack is * the permutation reader, but it only directly accesses values it wrote,
* so it will not see this magic value. */ static Obj VoidReturnMarker;
// code a function expression (with no arguments and locals)
Obj nams = NEW_PLIST(T_PLIST, 0);
// If we are in the break loop, then a local variable context may well // exist, and we have to create an empty local variable names list to // match the function expression that we are creating. // // Without this, access to variables defined in the existing local // variable context will be coded as LVAR accesses; but when we then // execute this code, they will not actually be available in the current // context, but rather one level up, i.e., they really should have been // coded as HVARs. // // If we are not in a break loop, then this would be a waste of time and // effort if (LEN_PLIST(stackNams) > 0) {
PushPlist(stackNams, nams);
}
// code a function expression (with one statement in the body)
CodeFuncExprEnd(intr->cs, 1, TRUE, 0);
// switch back to immediate mode and get the function
Obj func = CodeEnd(intr->cs, 0);
// If we are in a break loop, then we will have created a "dummy" local // variable names list to get the counts right. Remove it. const UInt len = LEN_PLIST(stackNams); if (len > 0)
PopPlist(stackNams);
// call the function
CALL_0ARGS(func);
// push void
PushVoidObj(intr);
}
/**************************************************************************** ** *F IntrBegin(<intr>) . . . . . . . . . . . . . . . . . start an interpreter *F IntrEnd(<intr>,<error>,<result>) . . . . . . . . . . stop an interpreter ** ** 'IntrBegin' starts a new interpreter. ** ** 'IntrEnd' stops the given interpreter. ** ** If <error> is non-zero a syntax error was found by the reader, and the ** interpreter only clears up the mess. ** ** If 'IntrEnd' returns 'STATUS_END', then no return-statement or ** quit-statement was interpreted. If 'IntrEnd' returns 'STATUS_RETURN', ** then a return-statement was interpreted. If a value was returned, and the ** <result> is non-zero, then the returned value is assigned to the address ** <result> points at. If 'IntrEnd' returns 'STATUS_QUIT', then a ** quit-statement was interpreted. If 'IntrEnd' returns 'STATUS_QQUIT', then ** a QUIT-statement was interpreted.
*/ void IntrBegin(IntrState * intr)
{ // allocate a new values stack
intr->StackObj = NEW_PLIST(T_PLIST, 64);
// must be in immediate (non-ignoring, non-coding) mode
GAP_ASSERT(intr->ignoring == 0);
GAP_ASSERT(intr->coding == 0);
// no return-statement was yet interpreted
intr->returning = STATUS_END;
}
ExecStatus IntrEnd(IntrState * intr, BOOL error, Obj * result)
{ // if everything went fine if ( ! error ) {
// must be back in immediate (non-ignoring, non-coding) mode
GAP_ASSERT(intr->ignoring == 0);
GAP_ASSERT(intr->coding == 0);
// and the stack must contain the result value (which may be void)
GAP_ASSERT(LEN_PLIST(intr->StackObj) == 1); if (result)
*result = PopVoidObj(intr);
return intr->returning;
}
// otherwise clean up the mess else {
// clean up the coder too if (intr->coding > 0) {
CodeEnd(intr->cs, 1);
}
// dummy result value (probably ignored) if (result)
*result = 0;
// indicate that we had an error return STATUS_ERROR;
}
}
/**************************************************************************** ** *F IntrFuncCallBegin() . . . . . . . . . . . interpret function call, begin *F IntrFuncCallEnd(<funccall>,<options>, <nr>) interpret function call, end ** ** 'IntrFuncCallBegin' is an action to interpret a function call. It is ** called by the reader when it encounters the parenthesis '(', i.e., ** *after* the function expression is read. ** ** 'IntrFuncCallEnd' is an action to interpret a function call. It is ** called by the reader when it encounters the parenthesis ')', i.e., ** *after* the argument expressions are read. <funccall> is 1 if this is a ** function call, and 0 if this is a procedure call. <nr> is the number of ** arguments. <options> is 1 if options were present after the ':' in which ** case the options have been read already.
*/ void IntrFuncCallBegin(IntrState * intr)
{ // ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeFuncCallBegin(intr->cs); return;
}
}
static Obj PushOptions; static Obj PopOptions;
void IntrFuncCallEnd(IntrState * intr, UInt funccall, UInt options, UInt nr)
{
Obj func; // function
Obj a1; // first argument
Obj a2; // second argument
Obj a3; // third argument
Obj a4; // fourth argument
Obj a5; // fifth argument
Obj a6; // sixth argument
Obj args; // argument list
Obj argi; // <i>-th argument
Obj val; // return value of function
Obj opts; // record of options
UInt i; // loop variable
// ignore or code
SKIP_IF_RETURNING_NO_PROFILE_HOOK();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeFuncCallEnd(intr->cs, funccall, options, nr); return;
}
if (options) {
opts = PopObj(intr);
CALL_1ARGS(PushOptions, opts);
}
// get the arguments from the stack
a1 = a2 = a3 = a4 = a5 = a6 = args = 0; if ( nr <= 6 ) { if ( 6 <= nr ) { a6 = PopObj(intr); } if ( 5 <= nr ) { a5 = PopObj(intr); } if ( 4 <= nr ) { a4 = PopObj(intr); } if ( 3 <= nr ) { a3 = PopObj(intr); } if ( 2 <= nr ) { a2 = PopObj(intr); } if ( 1 <= nr ) { a1 = PopObj(intr); }
} else {
args = NEW_PLIST( T_PLIST, nr );
SET_LEN_PLIST( args, nr ); for ( i = nr; 1 <= i; i-- ) {
argi = PopObj(intr);
SET_ELM_PLIST( args, i, argi );
}
}
// get and check the function from the stack
func = PopObj(intr); if ( TNUM_OBJ(func) != T_FUNCTION ) { if ( nr <= 6 ) {
args = NEW_PLIST( T_PLIST_DENSE, nr );
SET_LEN_PLIST( args, nr ); switch(nr) { case 6: SET_ELM_PLIST(args,6,a6); case 5: SET_ELM_PLIST(args,5,a5); case 4: SET_ELM_PLIST(args,4,a4); case 3: SET_ELM_PLIST(args,3,a3); case 2: SET_ELM_PLIST(args,2,a2); case 1: SET_ELM_PLIST(args,1,a1);
}
}
val = DoOperation2Args(CallFuncListOper, func, args);
} else { // call the function if ( 0 == nr ) { val = CALL_0ARGS( func ); } elseif ( 1 == nr ) { val = CALL_1ARGS( func, a1 ); } elseif ( 2 == nr ) { val = CALL_2ARGS( func, a1, a2 ); } elseif ( 3 == nr ) { val = CALL_3ARGS( func, a1, a2, a3 ); } elseif ( 4 == nr ) { val = CALL_4ARGS( func, a1, a2, a3, a4 ); } elseif ( 5 == nr ) { val = CALL_5ARGS( func, a1, a2, a3, a4, a5 ); } elseif ( 6 == nr ) { val = CALL_6ARGS( func, a1, a2, a3, a4, a5, a6 ); } else { val = CALL_XARGS( func, args ); }
if (STATE(UserHasQuit) || STATE(UserHasQUIT)) { // the procedure must have called READ() and the user quit from a break loop // inside it; or a file containing a `QUIT` statement was read at the top // execution level (e.g. in init.g, before the primary REPL starts) after // which the procedure was called, and now we are returning from that
GAP_THROW();
}
}
if (options)
CALL_0ARGS(PopOptions);
// push the value onto the stack if ( val == 0 )
PushFunctionVoidReturn(intr); else
PushObj(intr, val);
}
/**************************************************************************** ** *F IntrFuncExprBegin(<narg>,<nloc>,<nams>) . interpret function expr, begin *F IntrFuncExprEnd(<nr>) . . . . . . . . . . . interpret function expr, end ** ** 'IntrFuncExprBegin' is an action to interpret a function expression. It ** is called when the reader encounters the beginning of a function ** expression. <narg> is the number of arguments (-1 if the function takes ** a variable number of arguments), <nloc> is the number of locals, <nams> ** is a list of local variable names. ** ** 'IntrFuncExprEnd' is an action to interpret a function expression. It is ** called when the reader encounters the end of a function expression. <nr> ** is the number of statements in the body of the function.
*/ void IntrFuncExprBegin(
IntrState * intr, Int narg, Int nloc, Obj nams, Int startLine)
{ // ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING();
if (intr->coding == 0) {
CodeBegin(intr->cs);
}
intr->coding++;
// code a function expression
CodeFuncExprBegin(intr->cs, narg, nloc, nams, intr->gapnameid, startLine);
}
if (intr->coding == 0) { // switch back to immediate mode and get the function
Obj func = CodeEnd(intr->cs, 0);
// push the function
PushObj(intr, func);
}
}
/**************************************************************************** ** *F IntrIfBegin() . . . . . . . . interpret if-statement, begin of statement *F IntrIfElif() . . . . . . . interpret if-statement, begin of elif-branch *F IntrIfElse() . . . . . . . interpret if-statement, begin of else-branch *F IntrIfBeginBody() . . . . . . . . . interpret if-statement, begin of body *F IntrIfEndBody(<nr>) . . . . . . . . . interpret if-statement, end of body *F IntrIfEnd(<nr>) . . . . . . . . interpret if-statement, end of statement ** ** 'IntrIfBegin' is an action to interpret an if-statement. It is called ** when the reader encounters the 'if', i.e., *before* the condition is ** read. ** ** 'IntrIfElif' is an action to interpret an if-statement. It is called ** when the reader encounters an 'elif', i.e., *before* the condition is ** read. ** ** 'IntrIfElse' is an action to interpret an if-statement. It is called ** when the reader encounters an 'else'. ** ** 'IntrIfBeginBody' is an action to interpret an if-statement. It is ** called when the reader encounters the beginning of the statement body of ** an 'if', 'elif', or 'else' branch, i.e., *after* the condition is read. ** ** 'IntrIfEndBody' is an action to interpret an if-statement. It is called ** when the reader encounters the end of the statements body of an 'if', ** 'elif', or 'else' branch. <nr> is the number of statements in the body. ** ** 'IntrIfEnd' is an action to interpret an if-statement. It is called when ** the reader encounters the end of the statement. <nr> is the number of ** 'if', 'elif', or 'else' branches.
*/ void IntrIfBegin(IntrState * intr)
{ // ignore or code
SKIP_IF_RETURNING();
// if IntrIgnoring is positive, increment it, as IntrIgnoring == 1 has a // special meaning when parsing if-statements -- it is used to skip // interpreting or coding branches of the if-statement which never will // be executed, either because a previous branch is always executed // (i.e., it has a 'true' condition), or else because the current branch // has a 'false' condition if (intr->ignoring > 0) {
intr->ignoring++; return;
} if (intr->coding > 0) {
CodeIfBegin(intr->cs); return;
}
}
void IntrIfElif(IntrState * intr)
{ // ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeIfElif(intr->cs); return;
}
}
void IntrIfElse(IntrState * intr)
{ // ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeIfElse(intr->cs); return;
}
// push 'true' (to execute body of else-branch)
PushObj(intr, True);
}
void IntrIfBeginBody(IntrState * intr)
{
Obj cond; // value of condition
// ignore or code
SKIP_IF_RETURNING(); if (intr->ignoring > 0) {
intr->ignoring++; return;
} if (intr->coding > 0) {
intr->ignoring = CodeIfBeginBody(intr->cs); return;
}
// get and check the condition
cond = PopObj(intr); if ( cond != True && cond != False ) {
RequireArgumentEx(0, cond, "", "must be 'true' or 'false'");
}
// if the condition is 'false', ignore the body if ( cond == False ) {
intr->ignoring = 1;
}
}
if (intr->ignoring > 1) {
intr->ignoring--; return;
}
// if one branch was executed (ignoring the others), reset IntrIgnoring if (intr->ignoring == 1) {
intr->ignoring = 0;
}
if (intr->coding > 0) {
CodeIfEnd(intr->cs, nr); return;
}
PushVoidObj(intr);
}
/**************************************************************************** ** *F IntrForBegin() . . . . . . . interpret for-statement, begin of statement *F IntrForIn() . . . . . . . . . . . . . interpret for-statement, 'in'-read *F IntrForBeginBody() . . . . . . . interpret for-statement, begin of body *F IntrForEndBody(<nr>) . . . . . . . interpret for-statement, end of body *F IntrForEnd() . . . . . . . . . interpret for-statement, end of statement ** ** 'IntrForBegin' is an action to interpret a for-statement. It is called ** when the reader encounters the 'for', i.e., *before* the variable is ** read. ** ** 'IntrForIn' is an action to interpret a for-statement. It is called when ** the reader encounters the 'in', i.e., *after* the variable is read, but ** *before* the list expression is read. ** ** 'IntrForBeginBody' is an action to interpret a for-statement. It is ** called when the reader encounters the beginning of the statement body, ** i.e., *after* the list expression is read. ** ** 'IntrForEndBody' is an action to interpret a for-statement. It is called ** when the reader encounters the end of the statement body. <nr> is the ** number of statements in the body. ** ** 'IntrForEnd' is an action to interpret a for-statement. It is called ** when the reader encounters the end of the statement, i.e., immediately ** after 'IntrForEndBody'. ** ** Since loops cannot be interpreted immediately, the interpreter calls the ** coder to create a procedure (with no arguments) and calls that.
*/ void IntrForBegin(IntrState * intr, Obj stackNams)
{ // ignore
SKIP_IF_RETURNING();
SKIP_IF_IGNORING();
if (intr->coding == 0)
StartFakeFuncExpr(intr, stackNams);
// otherwise must be coding
GAP_ASSERT(intr->coding > 0);
intr->coding--;
CodeForEnd(intr->cs);
if (intr->coding == 0)
FinishAndCallFakeFuncExpr(intr, stackNams);
}
/**************************************************************************** ** *F IntrWhileBegin() . . . . . interpret while-statement, begin of statement *F IntrWhileBeginBody() . . . . . interpret while-statement, begin of body *F IntrWhileEndBody(<nr>) . . . . . interpret while-statement, end of body *F IntrWhileEnd() . . . . . . . interpret while-statement, end of statement ** ** 'IntrWhileBegin' is an action to interpret a while-statement. It is ** called when the reader encounters the 'while', i.e., *before* the ** condition is read. ** ** 'IntrWhileBeginBody' is an action to interpret a while-statement. It is ** called when the reader encounters the beginning of the statement body, ** i.e., *after* the condition is read. ** ** 'IntrWhileEndBody' is an action to interpret a while-statement. It is ** called when the reader encounters the end of the statement body. <nr> is ** the number of statements in the body. ** ** 'IntrWhileEnd' is an action to interpret a while-statement. It is called ** when the reader encounters the end of the statement, i.e., immediate ** after 'IntrWhileEndBody'. ** ** Since loops cannot be interpreted immediately, the interpreter calls the ** coder to create a procedure (with no arguments) and calls that.
*/ void IntrWhileBegin(IntrState * intr, Obj stackNams)
{ // ignore
SKIP_IF_RETURNING();
SKIP_IF_IGNORING();
if (intr->coding == 0)
StartFakeFuncExpr(intr, stackNams);
// otherwise must be coding
GAP_ASSERT(intr->coding > 0);
CodeQualifiedExprEnd(intr->cs);
}
/**************************************************************************** ** *F IntrAtomicBegin() . . . . interpret atomic-statement, begin of statement *F IntrAtomicBeginBody(<nrexprs>) interpret atomic-statement, begin of body *F IntrAtomicEndBody(<nrstats>) . . interpret atomic-statement, end of body *F IntrAtomicEnd() . . . . . . interpret atomic-statement, end of statement ** ** 'IntrAtomicBegin' is an action to interpret an atomic-statement. It is ** called when the reader encounters the 'atomic', i.e., *before* the ** expressions to be locked are read. ** ** 'IntrAtomicBeginBody' is an action to interpret an atomic-statement. It ** is called when the reader encounters the beginning of the statement body, ** i.e., *after* the expressions to be locked are read. <nrexprs> is the ** number of expressions to be locked ** ** 'IntrAtomicEndBody' is an action to interpret an atomic-statement. It is ** called when the reader encounters the end of the statement body. ** <nrstats> is the number of statements in the body. ** ** 'IntrAtomicEnd' is an action to interpret an atomic-statement. It is ** called when the reader encounters the end of the statement, i.e., ** immediately after 'IntrAtomicEndBody'. ** ** These functions only do something meaningful inside HPC-GAP; in plain ** GAP, they are simply placeholders.
*/ void IntrAtomicBegin(IntrState * intr, Obj stackNams)
{ // ignore
SKIP_IF_RETURNING();
SKIP_IF_IGNORING();
if (intr->coding == 0)
StartFakeFuncExpr(intr, stackNams);
// otherwise must be coding
GAP_ASSERT(intr->coding > 0);
intr->coding--;
CodeAtomicEnd(intr->cs);
if (intr->coding == 0)
FinishAndCallFakeFuncExpr(intr, stackNams);
}
/**************************************************************************** ** *F IntrRepeatBegin() . . . . interpret repeat-statement, begin of statement *F IntrRepeatBeginBody() . . . . . interpret repeat-statement, begin of body *F IntrRepeatEndBody(<nr>) . . . . . interpret repeat-statement, end of body *F IntrRepeatEnd() . . . . . . interpret repeat-statement, end of statement ** ** 'IntrRepeatBegin" is an action to interpret a repeat-statement. It is ** called when the read encounters the 'repeat'. ** ** 'IntrRepeatBeginBody' is an action to interpret a repeat-statement. It ** is called when the reader encounters the beginning of the statement body, ** i.e., immediately after 'IntrRepeatBegin'. ** ** 'IntrRepeatEndBody' is an action to interpret a repeat-statement. It is ** called when the reader encounters the end of the statement body, i.e., ** *before* the condition is read. <nr> is the number of statements in the ** body. ** ** 'IntrRepeatEnd' is an action to interpret a repeat-statement. It is ** called when the reader encounters the end of the statement, i.e., *after* ** the condition is read. ** ** Since loops cannot be interpreted immediately, the interpreter calls the ** coder to create a procedure (with no arguments) and calls that.
*/ void IntrRepeatBegin(IntrState * intr, Obj stackNams)
{ // ignore
SKIP_IF_RETURNING();
SKIP_IF_IGNORING();
if (intr->coding == 0)
StartFakeFuncExpr(intr, stackNams);
intr->coding++;
// code a repeat loop
CodeRepeatBegin(intr->cs);
}
// otherwise must be coding
GAP_ASSERT(intr->coding > 0);
intr->coding--;
CodeRepeatEnd(intr->cs);
if (intr->coding == 0)
FinishAndCallFakeFuncExpr(intr, stackNams);
}
/**************************************************************************** ** *F IntrBreak() . . . . . . . . . . . . . . . . . . interpret break-statement ** ** 'IntrBreak' is the action to interpret a break-statement. It is called ** when the reader encounters a 'break;'. ** ** Break-statements are always coded (if they are not ignored), since they ** can only appear in loops.
*/ void IntrBreak(IntrState * intr)
{ // ignore
SKIP_IF_RETURNING();
SKIP_IF_IGNORING();
// otherwise must be coding
GAP_ASSERT(intr->coding > 0);
CodeBreak(intr->cs);
}
/**************************************************************************** ** *F IntrContinue() . . . . . . . . . . . . . . . interpret continue-statement ** ** 'IntrContinue' is the action to interpret a continue-statement. It is ** called when the reader encounters a 'continue;'. ** ** Continue-statements are always coded (if they are not ignored), since ** they can only appear in loops.
*/ void IntrContinue(IntrState * intr)
{ // ignore
SKIP_IF_RETURNING();
SKIP_IF_IGNORING();
// otherwise must be coding
GAP_ASSERT(intr->coding > 0);
CodeContinue(intr->cs);
}
/**************************************************************************** ** *F IntrReturnObj() . . . . . . . . . . . . interpret return-value-statement ** ** 'IntrReturnObj' is the action to interpret a return-value-statement. It ** is called when the reader encounters a 'return <expr>;', but *after* ** reading the expression <expr>.
*/ void IntrReturnObj(IntrState * intr)
{
Obj val; // return value
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeReturnObj(intr->cs); return;
}
// empty the values stack and push the return value
val = PopObj(intr);
SET_LEN_PLIST(intr->StackObj, 0);
PushObj(intr, val);
// indicate that a return-statement was interpreted
intr->returning = STATUS_RETURN;
}
/**************************************************************************** ** *F IntrReturnVoid() . . . . . . . . . . . . interpret return-void-statement ** ** 'IntrReturnVoid' is the action to interpret a return-void-statement. It ** is called when the reader encounters a 'return;'.
*/ void IntrReturnVoid(IntrState * intr)
{ // ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeReturnVoid(intr->cs); return;
}
// empty the values stack and push the void value
SET_LEN_PLIST(intr->StackObj, 0);
PushVoidObj(intr);
// indicate that a return-statement was interpreted
intr->returning = STATUS_RETURN;
}
/**************************************************************************** ** *F IntrQuit() . . . . . . . . . . . . . . . . . . interpret quit-statement ** ** 'IntrQuit' is the action to interpret a quit-statement. It is called ** when the reader encounters a 'quit;'.
*/ void IntrQuit(IntrState * intr)
{ // ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING();
// 'quit' is not allowed in functions (by the reader)
GAP_ASSERT(intr->coding == 0);
// empty the values stack and push the void value
SET_LEN_PLIST(intr->StackObj, 0);
PushVoidObj(intr);
// indicate that a quit-statement was interpreted
intr->returning = STATUS_QUIT;
}
/**************************************************************************** ** *F IntrQUIT() . . . . . . . . . . . . . . . . . . interpret quit-statement ** ** 'IntrQUIT' is the action to interpret a quit-statement. It is called ** when the reader encounters a 'QUIT;'.
*/ void IntrQUIT(IntrState * intr)
{ // ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING();
// 'QUIT' is not allowed in functions (by the reader)
GAP_ASSERT(intr->coding == 0);
// empty the values stack and push the void value
SET_LEN_PLIST(intr->StackObj, 0);
PushVoidObj(intr);
// indicate that a QUIT-statement was interpreted
intr->returning = STATUS_QQUIT;
}
/**************************************************************************** ** *F IntrHelp() ** ** 'IntrHelp' is the action to interpret a help statement. **
*/ void IntrHelp(IntrState * intr, Obj topic)
{
UInt hgvar;
Obj help;
Obj res;
SKIP_IF_RETURNING();
SKIP_IF_IGNORING();
// '?' is not allowed in functions (by the reader)
GAP_ASSERT(intr->coding == 0);
// FIXME: Hard coded function name
hgvar = GVarName("HELP");
help = ValGVar(hgvar); if (!help) {
ErrorQuit( "Global variable \"HELP\" is not defined. Cannot access help", 0,
0);
} if (!IS_FUNC(help)) {
ErrorQuit( "Global variable \"HELP\" is not a function. Cannot access help",
0, 0);
}
res = CALL_1ARGS(help, topic); if (res)
PushObj(intr, res); else
PushVoidObj(intr);
}
/**************************************************************************** ** *F IntrOrL() . . . . . . . . . . interpret or-expression, left operand read *F IntrOr() . . . . . . . . . . interpret or-expression, right operand read ** ** 'IntrOrL' is an action to interpret an or-expression. It is called when ** the reader encounters the 'or' keyword, i.e., *after* the left operand is ** read but *before* the right operand is read. ** ** 'IntrOr' is an action to interpret an or-expression. It is called when ** the reader encountered the end of the expression, i.e., *after* both ** operands are read.
*/ void IntrOrL(IntrState * intr)
{
Obj opL; // value of left operand
// ignore or code
SKIP_IF_RETURNING(); if (intr->ignoring > 0) {
intr->ignoring++; return;
} if (intr->coding > 0) {
CodeOrL(intr->cs); return;
}
// if the left operand is 'true', ignore the right operand
opL = PopObj(intr);
PushObj(intr, opL); if ( opL == True ) {
PushObj(intr, opL);
intr->ignoring = 1;
}
}
void IntrOr(IntrState * intr)
{
Obj opL; // value of left operand
Obj opR; // value of right operand
// ignore or code
SKIP_IF_RETURNING(); if (intr->ignoring > 1) {
intr->ignoring--; return;
} if (intr->coding > 0) {
CodeOr(intr->cs); return;
}
// stop ignoring things now
intr->ignoring = 0;
// get the operands
opR = PopObj(intr);
opL = PopObj(intr);
// if the left operand is 'true', this is the result if ( opL == True ) {
PushObj(intr, opL);
}
// if the left operand is 'false', the result is the right operand elseif ( opL == False ) { if ( opR == True || opR == False ) {
PushObj(intr, opR);
} else {
RequireArgumentEx(0, opR, "", "must be 'true' or 'false'");
}
}
// signal an error else {
RequireArgumentEx(0, opL, "", "must be 'true' or 'false'");
}
}
/**************************************************************************** ** *F IntrAndL() . . . . . . . . . interpret and-expression, left operand read *F IntrAnd() . . . . . . . . . interpret and-expression, right operand read ** ** 'IntrAndL' is an action to interpret an and-expression. It is called ** when the reader encounters the 'and' keyword, i.e., *after* the left ** operand is read but *before* the right operand is read. ** ** 'IntrAnd' is an action to interpret an and-expression. It is called when ** the reader encountered the end of the expression, i.e., *after* both ** operands are read.
*/ void IntrAndL(IntrState * intr)
{
Obj opL; // value of left operand
// ignore or code
SKIP_IF_RETURNING(); if (intr->ignoring > 0) {
intr->ignoring++; return;
} if (intr->coding > 0) {
CodeAndL(intr->cs); return;
}
// if the left operand is 'false', ignore the right operand
opL = PopObj(intr);
PushObj(intr, opL); if ( opL == False ) {
PushObj(intr, opL);
intr->ignoring = 1;
}
}
void IntrAnd(IntrState * intr)
{
Obj opL; // value of left operand
Obj opR; // value of right operand
// ignore or code
SKIP_IF_RETURNING(); if (intr->ignoring > 1) {
intr->ignoring--; return;
} if (intr->coding > 0) {
CodeAnd(intr->cs); return;
}
// stop ignoring things now
intr->ignoring = 0;
// get the operands
opR = PopObj(intr);
opL = PopObj(intr);
// if the left operand is 'false', this is the result if ( opL == False ) {
PushObj(intr, opL);
}
// if the left operand is 'true', the result is the right operand elseif ( opL == True ) { if ( opR == False || opR == True ) {
PushObj(intr, opR);
} else {
RequireArgumentEx(0, opR, "", "must be 'true' or 'false'");
}
}
// handle the 'and' of two filters elseif (IS_FILTER(opL)) {
PushObj(intr, NewAndFilter(opL, opR));
}
// signal an error else {
RequireArgumentEx(0, opL, "", "must be 'true' or 'false' or a filter");
}
}
/**************************************************************************** ** *F IntrNot() . . . . . . . . . . . . . . . . . . . interpret not-expression ** ** 'IntrNot' is the action to interpret a not-expression. It is called when ** the reader encounters a not-expression, *after* the operand is read.
*/ void IntrNot(IntrState * intr)
{
Obj val; // value, result
Obj op; // operand
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeNot(intr->cs); return;
}
// get and check the operand
op = PopObj(intr); if ( op != True && op != False ) {
RequireArgumentEx(0, op, "", "must be 'true' or 'false'");
}
// negate the operand
val = (op == False ? True : False);
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeSum(intr->cs); return;
}
// get the operands
opR = PopObj(intr);
opL = PopObj(intr);
// compute the sum
val = SUM( opL, opR );
// push the result
PushObj(intr, val);
}
void IntrAInv(IntrState * intr)
{
Obj val; // value, result
Obj opL; // left operand
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeAInv(intr->cs); return;
}
// get the operand
opL = PopObj(intr);
// compute the additive inverse
val = AINV_SAMEMUT(opL);
// push the result
PushObj(intr, val);
}
void IntrDiff(IntrState * intr)
{
Obj val; // value, result
Obj opL; // left operand
Obj opR; // right operand
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeDiff(intr->cs); return;
}
// get the operands
opR = PopObj(intr);
opL = PopObj(intr);
// compute the difference
val = DIFF( opL, opR );
// push the result
PushObj(intr, val);
}
void IntrProd(IntrState * intr)
{
Obj val; // value, result
Obj opL; // left operand
Obj opR; // right operand
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeProd(intr->cs); return;
}
// get the operands
opR = PopObj(intr);
opL = PopObj(intr);
// compute the product
val = PROD( opL, opR );
// push the result
PushObj(intr, val);
}
void IntrQuo(IntrState * intr)
{
Obj val; // value, result
Obj opL; // left operand
Obj opR; // right operand
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeQuo(intr->cs); return;
}
// get the operands
opR = PopObj(intr);
opL = PopObj(intr);
// compute the quotient
val = QUO( opL, opR );
// push the result
PushObj(intr, val);
}
void IntrMod(IntrState * intr)
{
Obj val; // value, result
Obj opL; // left operand
Obj opR; // right operand
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeMod(intr->cs); return;
}
// get the operands
opR = PopObj(intr);
opL = PopObj(intr);
// compute the remainder
val = MOD( opL, opR );
// push the result
PushObj(intr, val);
}
void IntrPow(IntrState * intr)
{
Obj val; // value, result
Obj opL; // left operand
Obj opR; // right operand
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodePow(intr->cs); return;
}
// get the operands
opR = PopObj(intr);
opL = PopObj(intr);
// compute the power
val = POW( opL, opR );
// push the result
PushObj(intr, val);
}
/**************************************************************************** ** *F IntrIntExpr(<str>) . . . . . . . . interpret literal integer expression ** ** 'IntrIntExpr' is the action to interpret a literal integer expression. ** <str> is the integer as a (null terminated) C character string.
*/ void IntrIntExpr(IntrState * intr, Obj string, Char * str)
{ // ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING();
Obj val = IntStringInternal(string, str);
GAP_ASSERT(val != Fail);
if (intr->coding > 0) {
CodeIntExpr(intr->cs, val);
} else { // push the integer value
PushObj(intr, val);
}
}
/**************************************************************************** ** *F IntrFloatExpr(<str>) . . . . . . . . interpret literal float expression ** ** 'IntrFloatExpr' is the action to interpret a literal float expression. ** <str> is the float as a (null terminated) C character string.
*/
static Obj CONVERT_FLOAT_LITERAL_EAGER;
static Obj ConvertFloatLiteralEager(Obj str)
{ Char * chars = (Char *)CHARS_STRING(str);
UInt len = GET_LEN_STRING(str); Char mark = '\0'; if (chars[len - 1] == '_') {
SET_LEN_STRING(str, len - 1);
chars[len - 1] = '\0';
} elseif (chars[len - 2] == '_') {
mark = chars[len - 1];
SET_LEN_STRING(str, len - 2);
chars[len - 2] = '\0';
}
Obj res = CALL_2ARGS(CONVERT_FLOAT_LITERAL_EAGER, str, ObjsChar[(UInt)mark]); if (res == Fail)
ErrorQuit("failed to convert float literal", 0, 0); return res;
}
/**************************************************************************** ** *F IntrIntObjExpr() . . . . . . . 'interpret' a GAP small integer ** ** 'IntrIntObjExpr' is the action to 'interpret' a existing GAP small ** integer. This is used for implementing constants.
*/ void IntrIntObjExpr(IntrState * intr, Obj val)
{ // ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeIntExpr(intr->cs, val); return;
}
// push the value
PushObj(intr, val);
}
/**************************************************************************** ** *F IntrTrueExpr() . . . . . . . . . . . . interpret literal true expression ** ** 'IntrTrueExpr' is the action to interpret a literal true expression.
*/ void IntrTrueExpr(IntrState * intr)
{ // ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeTrueExpr(intr->cs); return;
}
// push the value
PushObj(intr, True);
}
/**************************************************************************** ** *F IntrFalseExpr() . . . . . . . . . . . interpret literal false expression ** ** 'IntrFalseExpr' is the action to interpret a literal false expression.
*/ void IntrFalseExpr(IntrState * intr)
{ // ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeFalseExpr(intr->cs); return;
}
// push the value
PushObj(intr, False);
}
/**************************************************************************** ** *F IntrTildeExpr() . . . . . . . . . . . . . . . interpret tilde expression ** ** 'IntrTildeExpr' is the action to interpret a tilde expression. **
*/ void IntrTildeExpr(IntrState * intr)
{ // ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeTildeExpr(intr->cs); return;
}
if (!STATE(Tilde)) { // this code should be impossible to reach, the parser won't allow us // to get here; but we leave it here out of paranoia
ErrorQuit("'~' does not have a value here", 0, 0);
}
// push the value
PushObj(intr, STATE(Tilde));
}
/**************************************************************************** ** *F IntrCharExpr(<chr>) . . . . . . . interpret literal character expression ** ** 'IntrCharExpr' is the action to interpret a literal character expression. ** <chr> is the C character.
*/ void IntrCharExpr(IntrState * intr, Char chr)
{ // ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeCharExpr(intr->cs, chr); return;
}
// push the value
PushObj(intr, ObjsChar[(UChar)chr]);
}
void IntrPermCycle(IntrState * intr, UInt nrx, UInt nrc)
{
Obj perm; // permutation
UInt m; // maximal entry in permutation
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodePermCycle(intr->cs, nrx, nrc); return;
}
// get the permutation (allocate for the first cycle) if ( nrc == 1 ) {
m = 0;
perm = NEW_PERM4( 0 );
} else { const UInt countObj = LEN_PLIST(intr->StackObj);
m = INT_INTOBJ(ELM_LIST(intr->StackObj, countObj - nrx));
perm = ELM_LIST(intr->StackObj, countObj - nrx - 1);
}
m = ScanPermCycle(perm, m, (Obj)intr, nrx, GetFromStack);
// push the permutation (if necessary, drop permutation first) if (nrc != 1) {
PopObj(intr);
PopObj(intr);
}
PushObj(intr, perm);
PushObj(intr, INTOBJ_INT(m));
}
void IntrPerm(IntrState * intr, UInt nrc)
{
Obj perm; // permutation, result
UInt m; // maximal entry in permutation
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodePerm(intr->cs, nrc); return;
}
// special case for identity permutation if ( nrc == 0 ) {
perm = NEW_PERM2( 0 );
}
// otherwise else {
// get the permutation and its maximal entry
m = INT_INTOBJ(PopObj(intr));
perm = PopObj(intr);
// if possible represent the permutation with short entries
TrimPerm(perm, m);
}
// push the result
PushObj(intr, perm);
}
/**************************************************************************** ** *F IntrListExprBegin(<top>) . . . . . . . . . . interpret list expr, begin *F IntrListExprBeginElm(<pos>) . . . . . interpret list expr, begin element *F IntrListExprEndElm() . . . . . . . . . interpret list expr, end element *F IntrListExprEnd(<nr>,<range>,<top>,<tilde>) . . interpret list expr, end
*/ void IntrListExprBegin(IntrState * intr, UInt top)
{
Obj list; // new list
Obj old; // old value of '~'
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeListExprBegin(intr->cs, top); return;
}
// allocate the new list
list = NewEmptyPlist();
// if this is an outmost list, save it for reference in '~' // (and save the old value of '~' on the values stack) if ( top ) {
old = STATE(Tilde); if (old != 0) {
PushObj(intr, old);
} else {
PushVoidObj(intr);
}
STATE(Tilde) = list;
}
// remember this position on the values stack
PushObj(intr, INTOBJ_INT(pos));
}
void IntrListExprEndElm(IntrState * intr)
{
Obj list; // list that is currently made
Obj pos; // position
UInt p; // position, as a C integer
Obj val; // value to assign into list
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeListExprEndElm(intr->cs); return;
}
// get the value
val = PopObj(intr);
// get the position
pos = PopObj(intr);
p = INT_INTOBJ( pos );
// get the list
list = PopObj(intr);
// assign the element into the list
ASS_LIST( list, p, val );
// push the list again
PushObj(intr, list);
}
void IntrListExprEnd(
IntrState * intr, UInt nr, UInt range, UInt top, UInt tilde)
{
Obj list; // the list, result
Obj old; // old value of '~' Int low; // low value of range Int inc; // increment of range Int high; // high value of range
Obj val; // temporary value
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeListExprEnd(intr->cs, nr, range, top, tilde); return;
}
// if this was a top level expression, restore the value of '~' if ( top ) {
list = PopObj(intr);
old = PopVoidObj(intr);
STATE(Tilde) = old;
PushObj(intr, list);
}
// if this was a range, convert the list to a range if ( range ) { // get the list
list = PopObj(intr);
// get the low value
val = ELM_LIST( list, 1 );
low = GetSmallIntEx("Range", val, "");
// get the increment if ( nr == 3 ) {
val = ELM_LIST( list, 2 ); Int v = GetSmallIntEx("Range", val, ""); if ( v == low ) {
ErrorQuit("Range: must not be equal to (%d)",
(Int)low, 0);
}
inc = v - low;
} else {
inc = 1;
}
// get and check the high value
val = ELM_LIST( list, LEN_LIST(list) ); Int v = GetSmallIntEx("Range", val, ""); if ( (v - low) % inc != 0 ) {
ErrorQuit( "Range: - (%d) must be divisible by (%d)",
(Int)(v-low), (Int)inc );
}
high = v;
// if <low> is larger than <high> the range is empty if ( (0 < inc && high < low) || (inc < 0 && low < high) ) {
list = NewEmptyPlist();
}
// if <low> is equal to <high> the range is a singleton list elseif ( low == high ) {
list = NEW_PLIST( T_PLIST_CYC_SSORT, 1 );
SET_LEN_PLIST( list, 1 );
SET_ELM_PLIST( list, 1, INTOBJ_INT(low) );
}
// else make the range else { // length must be a small integer as well if ((high-low) / inc >= INT_INTOBJ_MAX) {
ErrorQuit("Range: the length of a range must be a small integer",
0, 0);
}
// push the list again
PushObj(intr, list);
} else { // give back unneeded memory
list = PopObj(intr); // Might have transformed into another type of list if (IS_PLIST(list)) {
SHRINK_PLIST(list, LEN_PLIST(list));
}
PushObj(intr, list);
}
}
// push the string, already newly created
PushObj(intr, string);
}
void IntrPragma(IntrState * intr, Obj pragma)
{
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodePragma(intr->cs, pragma);
} else { // Push a void when interpreting
PushVoidObj(intr);
}
}
/**************************************************************************** ** *F IntrRecExprBegin(<top>) . . . . . . . . . . interpret record expr, begin *F IntrRecExprBeginElmName(<rnam>) . . interpret record expr, begin element *F IntrRecExprBeginElmExpr() . . . . . interpret record expr, begin element *F IntrRecExprEndElmExpr() . . . . . . . interpret record expr, end element *F IntrRecExprEnd(<nr>,<top>,<tilde>) . . . . . interpret record expr, end
*/ void IntrRecExprBegin(IntrState * intr, UInt top)
{
Obj record; // new record
Obj old; // old value of '~'
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeRecExprBegin(intr->cs, top); return;
}
// allocate the new record
record = NEW_PREC( 0 );
// if this is an outmost record, save it for reference in '~' // (and save the old value of '~' on the values stack) if ( top ) {
old = STATE(Tilde); if (old != 0) {
PushObj(intr, old);
} else {
PushVoidObj(intr);
}
STATE(Tilde) = record;
}
// remember the name on the values stack
PushObj(intr, (Obj)rnam);
}
void IntrRecExprBeginElmExpr(IntrState * intr)
{
UInt rnam; // record name
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeRecExprBeginElmExpr(intr->cs); return;
}
// convert the expression to a record name
rnam = RNamObj(PopObj(intr));
// remember the name on the values stack
PushObj(intr, (Obj)rnam);
}
void IntrRecExprEndElm(IntrState * intr)
{
Obj record; // record that is currently made
UInt rnam; // name of record element
Obj val; // value of record element
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeRecExprEndElm(intr->cs); return;
}
// get the value
val = PopObj(intr);
// get the record name
rnam = (UInt)PopObj(intr);
// get the record
record = PopObj(intr);
--> --------------------
--> maximum size reached
--> --------------------
¤ Dauer der Verarbeitung: 0.71 Sekunden
(vorverarbeitet)
¤
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.
