// 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; \
}
/* Special marker value to denote that a function returned no value, so we *canproduceausefulerrormessage.Thisvalueonlyeverappearsonthe *stack,andshouldneverbevisibleoutsidethePushandPopmethodsbelow * *Theonlyplaceotherthanthesemethodswhichaccessthestackis *thepermutationreader,butitonlydirectlyaccessesvaluesitwrote,
* 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);
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) { case6: SET_ELM_PLIST(args,6,a6); case5: SET_ELM_PLIST(args,5,a5); case4: SET_ELM_PLIST(args,4,a4); case3: SET_ELM_PLIST(args,3,a3); case2: SET_ELM_PLIST(args,2,a2); case1: 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);
}
/**************************************************************************** ** *FIntrFuncExprBegin(<narg>,<nloc>,<nams>).interpretfunctionexpr,begin *FIntrFuncExprEnd(<nr>)...........interpretfunctionexpr,end ** **'IntrFuncExprBegin'isanactiontointerpretafunctionexpression.It **iscalledwhenthereaderencountersthebeginningofafunction **expression.<narg>isthenumberofarguments(-1ifthefunctiontakes **avariablenumberofarguments),<nloc>isthenumberoflocals,<nams> **isalistoflocalvariablenames. ** **'IntrFuncExprEnd'isanactiontointerpretafunctionexpression.Itis **calledwhenthereaderencounterstheendofafunctionexpression.<nr> **isthenumberofstatementsinthebodyofthefunction.
*/ 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 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, "<expr>", "must be 'true' or 'false'");
}
// if the condition is 'false', ignore the body if ( cond == False ) {
intr->ignoring = 1;
}
}
// '?' 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);
}
/**************************************************************************** ** *FIntrOrL()..........interpretor-expression,leftoperandread *FIntrOr()..........interpretor-expression,rightoperandread ** **'IntrOrL'isanactiontointerpretanor-expression.Itiscalledwhen **thereaderencountersthe'or'keyword,i.e.,*after*theleftoperandis **readbut*before*therightoperandisread. ** **'IntrOr'isanactiontointerpretanor-expression.Itiscalledwhen **thereaderencounteredtheendoftheexpression,i.e.,*after*both **operandsareread.
*/ 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, "<expr>", "must be 'true' or 'false'");
}
}
// signal an error else {
RequireArgumentEx(0, opL, "<expr>", "must be 'true' or 'false'");
}
}
/**************************************************************************** ** *FIntrAndL().........interpretand-expression,leftoperandread *FIntrAnd().........interpretand-expression,rightoperandread ** **'IntrAndL'isanactiontointerpretanand-expression.Itiscalled **whenthereaderencountersthe'and'keyword,i.e.,*after*theleft **operandisreadbut*before*therightoperandisread. ** **'IntrAnd'isanactiontointerpretanand-expression.Itiscalledwhen **thereaderencounteredtheendoftheexpression,i.e.,*after*both **operandsareread.
*/ 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, "<expr>", "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, "<expr>", "must be 'true' or 'false' or a filter");
}
}
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);
}
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);
}
/**************************************************************************** ** *FIntrListExprBegin(<top>)..........interpretlistexpr,begin *FIntrListExprBeginElm(<pos>).....interpretlistexpr,beginelement *FIntrListExprEndElm().........interpretlistexpr,endelement *FIntrListExprEnd(<nr>,<range>,<top>,<tilde>)..interpretlistexpr,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, "<first>");
// get the increment if ( nr == 3 ) {
val = ELM_LIST( list, 2 ); Int v = GetSmallIntEx("Range", val, "<second>"); if ( v == low ) {
ErrorQuit("Range: <second> must not be equal to <first> (%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, "<last>"); if ( (v - low) % inc != 0 ) {
ErrorQuit( "Range: <last>-<first> (%d) must be divisible by <inc> (%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);
}
}
/**************************************************************************** ** *FIntrRecExprBegin(<top>)..........interpretrecordexpr,begin *FIntrRecExprBeginElmName(<rnam>)..interpretrecordexpr,beginelement *FIntrRecExprBeginElmExpr().....interpretrecordexpr,beginelement *FIntrRecExprEndElmExpr().......interpretrecordexpr,endelement *FIntrRecExprEnd(<nr>,<top>,<tilde>).....interpretrecordexpr,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);
// assign the value into the record
ASS_REC( record, rnam, val );
// push the record again
PushObj(intr, record);
}
void IntrRecExprEnd(IntrState * intr, UInt nr, UInt top, UInt tilde)
{
Obj record; // record that is currently made
Obj old; // old value of '~'
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeRecExprEnd(intr->cs, nr, top, tilde); return;
}
// if this was a top level expression, restore the value of '~' if ( top ) {
record = PopObj(intr);
old = PopVoidObj(intr);
STATE(Tilde) = old;
PushObj(intr, record);
}
}
// remember the name on the values stack
PushObj(intr, (Obj)rnam);
}
void IntrFuncCallOptionsBeginElmExpr(IntrState * intr)
{
UInt rnam; // record name
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeFuncCallOptionsBeginElmExpr(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 IntrFuncCallOptionsEndElm(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) {
CodeFuncCallOptionsEndElm(intr->cs); return;
}
// get the value
val = PopObj(intr);
// get the record name
rnam = (UInt)PopObj(intr);
// get the record
record = PopObj(intr);
// assign the value into the record
ASS_REC( record, rnam, val );
// push the record again
PushObj(intr, record);
}
void IntrFuncCallOptionsEndElmEmpty(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) {
CodeFuncCallOptionsEndElmEmpty(intr->cs); return;
}
// get the value
val = True;
// get the record name
rnam = (UInt)PopObj(intr);
// get the record
record = PopObj(intr);
// assign the value into the record
ASS_REC( record, rnam, val );
// otherwise must be coding if (intr->coding > 0)
CodeRefLVar(intr->cs, lvar);
// or in the break loop
else {
val = OBJ_LVAR(lvar); if (val == 0) {
ErrorMayQuit("Variable: '%g' must have an assigned value",
(Int)NAME_LVAR(lvar), 0);
}
PushObj(intr, val);
}
}
// otherwise must be coding if (intr->coding > 0)
CodeAssHVar(intr->cs, hvar); // Or in the break loop else {
val = PopObj(intr);
ASS_HVAR(hvar, val);
PushObj(intr, val);
}
}
// otherwise must be coding if (intr->coding > 0)
CodeRefHVar(intr->cs, hvar); // or debugging else {
val = OBJ_HVAR(hvar); while (val == 0) {
ErrorMayQuit("Variable: '%g' must have an assigned value",
(Int)NAME_HVAR((UInt)(hvar)), 0);
}
PushObj(intr, val);
}
}
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING();
if (intr->coding > 0) {
ErrorQuit( "Variable: <debug-variable-%d-%d> cannot be used here",
dvar >> MAX_FUNC_LVARS_BITS, dvar & MAX_FUNC_LVARS_MASK );
}
// assign the right hand side
context = STATE(ErrorLVars); while (depth--)
context = PARENT_LVARS(context);
ASS_HVAR_WITH_CONTEXT(context, dvar, (Obj)0);
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING();
if (intr->coding > 0) {
ErrorQuit( "Variable: <debug-variable-%d-%d> cannot be used here",
dvar >> MAX_FUNC_LVARS_BITS, dvar & MAX_FUNC_LVARS_MASK );
}
// get and check the value
context = STATE(ErrorLVars); while (depth--)
context = PARENT_LVARS(context);
val = OBJ_HVAR_WITH_CONTEXT(context, dvar); if ( val == 0 ) {
ErrorQuit( "Variable: <debug-variable-%d-%d> must have a value",
dvar >> MAX_FUNC_LVARS_BITS, dvar & MAX_FUNC_LVARS_MASK );
}
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeIsbGVar(intr->cs, gvar); return;
}
// get the value
val = ValAutoGVar( gvar );
// push the value
PushObj(intr, val != 0 ? True : False);
}
/**************************************************************************** ** *FIntrAssList()..............interpretassignmenttoalist *FIntrAsssList().........interpretmultipleassignmenttoalist *FIntrAssListLevel(<level>).....interpretassignmenttoseverallists *FIntrAsssListLevel(<level>)..intrmultipleassignmenttoseverallists
*/ void IntrAssList(IntrState * intr, Int narg)
{
Obj list; // list
Obj pos; // position
Obj rhs; // right hand side
GAP_ASSERT(narg == 1 || narg == 2);
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeAssList(intr->cs, narg); return;
}
// get the right hand side
rhs = PopObj(intr);
if (narg == 1) { // get the position
pos = PopObj(intr);
// get the list (checking is done by 'ASS_LIST' or 'ASSB_LIST')
list = PopObj(intr);
// assign to the element of the list if (IS_POS_INTOBJ(pos)) {
ASS_LIST( list, INT_INTOBJ(pos), rhs );
} else {
ASSB_LIST(list, pos, rhs);
}
} elseif (narg == 2) {
Obj col = PopObj(intr);
Obj row = PopObj(intr);
list = PopObj(intr);
ASS_MAT(list, row, col, rhs);
}
// push the right hand side again
PushObj(intr, rhs);
}
void IntrAsssList(IntrState * intr)
{
Obj list; // list
Obj poss; // positions
Obj rhss; // right hand sides
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeAsssList(intr->cs); return;
}
// get the right hand sides
rhss = PopObj(intr);
RequireDenseList("List Assignments", rhss);
// get and check the positions
poss = PopObj(intr);
CheckIsPossList("List Assignments", poss);
RequireSameLength("List Assignments", rhss, poss);
// get the list (checking is done by 'ASSS_LIST')
list = PopObj(intr);
// assign to several elements of the list
ASSS_LIST( list, poss, rhss );
// push the right hand sides again
PushObj(intr, rhss);
}
void IntrAssListLevel(IntrState * intr, Int narg, UInt level)
{
Obj lists; // lists, left operand
Obj pos; // position, left operand
Obj rhss; // right hand sides, right operand
Obj ixs; Int i;
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeAssListLevel(intr->cs, narg, level); return;
}
// get right hand sides (checking is done by 'AssListLevel')
rhss = PopObj(intr);
ixs = NEW_PLIST(T_PLIST, narg); for (i = narg; i > 0; i--) { // get and check the position
pos = PopObj(intr);
SET_ELM_PLIST(ixs, i, pos);
CHANGED_BAG(ixs);
}
SET_LEN_PLIST(ixs, narg);
// get lists (if this works, then <lists> is nested <level> deep, // checking it is nested <level>+1 deep is done by 'AssListLevel')
lists = PopObj(intr);
// assign the right hand sides to the elements of several lists
AssListLevel( lists, ixs, rhss, level );
// push the assigned values again
PushObj(intr, rhss);
}
void IntrAsssListLevel(IntrState * intr, UInt level)
{
Obj lists; // lists, left operand
Obj poss; // position, left operand
Obj rhss; // right hand sides, right operand
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeAsssListLevel(intr->cs, level); return;
}
// get right hand sides (checking is done by 'AsssListLevel')
rhss = PopObj(intr);
// get and check the positions
poss = PopObj(intr);
CheckIsPossList("List Assignments", poss);
// get lists (if this works, then <lists> is nested <level> deep, // checking it is nested <level>+1 deep is done by 'AsssListLevel')
lists = PopObj(intr);
// assign the right hand sides to several elements of several lists
AsssListLevel( lists, poss, rhss, level );
// push the assigned values again
PushObj(intr, rhss);
}
void IntrUnbList(IntrState * intr, Int narg)
{
Obj list; // list
Obj pos; // position
GAP_ASSERT(narg == 1 || narg == 2);
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeUnbList(intr->cs, narg); return;
}
if (narg == 1) { // get and check the position
pos = PopObj(intr);
// get the list (checking is done by 'UNB_LIST' or 'UNBB_LIST')
list = PopObj(intr);
// unbind the element if (IS_POS_INTOBJ(pos)) {
UNB_LIST( list, INT_INTOBJ(pos) );
} else {
UNBB_LIST(list, pos);
}
} elseif (narg == 2) {
Obj col = PopObj(intr);
Obj row = PopObj(intr);
list = PopObj(intr);
UNB_MAT(list, row, col);
}
// push void
PushVoidObj(intr);
}
/**************************************************************************** ** *FIntrElmList()...............interpretselectionofalist *FIntrElmsList().........interpretmultipleselectionofalist *FIntrElmListLevel(<level>).....interpretselectionofseverallists *FIntrElmsListLevel(<level>)..intrmultipleselectionofseverallists
*/ void IntrElmList(IntrState * intr, Int narg)
{
Obj elm; // element, result
Obj list; // list, left operand
Obj pos; // position, right operand
GAP_ASSERT(narg == 1 || narg == 2);
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeElmList(intr->cs, narg); return;
}
if (narg == 1) { // get the position
pos = PopObj(intr);
// get the list (checking is done by 'ELM_LIST')
list = PopObj(intr);
// get the element of the list if (IS_POS_INTOBJ(pos)) {
elm = ELM_LIST( list, INT_INTOBJ( pos ) );
} else {
elm = ELMB_LIST( list, pos );
}
} else/*if (narg == 2)*/ {
Obj col = PopObj(intr);
Obj row = PopObj(intr);
list = PopObj(intr);
elm = ELM_MAT(list, row, col);
}
// push the element
PushObj(intr, elm);
}
void IntrElmsList(IntrState * intr)
{
Obj elms; // elements, result
Obj list; // list, left operand
Obj poss; // positions, right operand
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeElmsList(intr->cs); return;
}
// get and check the positions
poss = PopObj(intr);
CheckIsPossList("List Elements", poss);
// get the list (checking is done by 'ELMS_LIST')
list = PopObj(intr);
// select several elements from the list
elms = ELMS_LIST( list, poss );
// push the elements
PushObj(intr, elms);
}
void IntrElmListLevel(IntrState * intr, Int narg, UInt level)
{
Obj lists; // lists, left operand
Obj pos; // position, right operand
Obj ixs; Int i;
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeElmListLevel(intr->cs, narg, level); return;
}
// get the positions
ixs = NEW_PLIST(T_PLIST, narg); for (i = narg; i > 0; i--) {
pos = PopObj(intr);
SET_ELM_PLIST(ixs, i, pos);
CHANGED_BAG(ixs);
}
SET_LEN_PLIST(ixs, narg);
// get lists (if this works, then <lists> is nested <level> deep, // checking it is nested <level>+1 deep is done by 'ElmListLevel')
lists = PopObj(intr);
// select the elements from several lists (store them in <lists>)
ElmListLevel( lists, ixs, level );
// push the elements
PushObj(intr, lists);
}
void IntrElmsListLevel(IntrState * intr, UInt level)
{
Obj lists; // lists, left operand
Obj poss; // positions, right operand
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeElmsListLevel(intr->cs, level); return;
}
// get and check the positions
poss = PopObj(intr);
CheckIsPossList("List Elements", poss);
// get lists (if this works, then <lists> is nested <level> deep, // checking it is nested <level>+1 deep is done by 'ElmsListLevel')
lists = PopObj(intr);
// select several elements from several lists (store them in <lists>)
ElmsListLevel( lists, poss, level );
// push the elements
PushObj(intr, lists);
}
void IntrIsbList(IntrState * intr, Int narg)
{
Obj isb; // isbound, result
Obj list; // list, left operand
Obj pos; // position, right operand
GAP_ASSERT(narg == 1 || narg == 2);
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeIsbList(intr->cs, narg); return;
}
if (narg == 1) { // get and check the position
pos = PopObj(intr);
// get the list (checking is done by 'ISB_LIST' or 'ISBB_LIST')
list = PopObj(intr);
// get the result if (IS_POS_INTOBJ(pos)) {
isb = ISB_LIST( list, INT_INTOBJ(pos) ) ? True : False;
} else {
isb = ISBB_LIST( list, pos ) ? True : False;
}
} else/*if (narg == 2)*/ {
Obj col = PopObj(intr);
Obj row = PopObj(intr);
list = PopObj(intr);
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeUnbRecName(intr->cs, rnam); return;
}
// get the record (checking is done by 'UNB_REC')
record = PopObj(intr);
// assign the right hand side to the element of the record
UNB_REC( record, rnam );
// push void
PushVoidObj(intr);
}
void IntrUnbRecExpr(IntrState * intr)
{
Obj record; // record, left operand
UInt rnam; // name, left operand
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeUnbRecExpr(intr->cs); return;
}
// get the name and convert it to a record name
rnam = RNamObj(PopObj(intr));
// get the record (checking is done by 'UNB_REC')
record = PopObj(intr);
// assign the right hand side to the element of the record
UNB_REC( record, rnam );
// push void
PushVoidObj(intr);
}
/**************************************************************************** ** *FIntrElmRecName(<rnam>).........interpretselectionofarecord *FIntrElmRecExpr()............interpretselectionofarecord
*/ void IntrElmRecName(IntrState * intr, UInt rnam)
{
Obj elm; // element, result
Obj record; // the record, left operand
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeElmRecName(intr->cs, rnam); return;
}
// get the record (checking is done by 'ELM_REC')
record = PopObj(intr);
// select the element of the record
elm = ELM_REC( record, rnam );
// push the element
PushObj(intr, elm);
}
void IntrElmRecExpr(IntrState * intr)
{
Obj elm; // element, result
Obj record; // the record, left operand
UInt rnam; // the name, right operand
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeElmRecExpr(intr->cs); return;
}
// get the name and convert it to a record name
rnam = RNamObj(PopObj(intr));
// get the record (checking is done by 'ELM_REC')
record = PopObj(intr);
// select the element of the record
elm = ELM_REC( record, rnam );
// push the element
PushObj(intr, elm);
}
void IntrIsbRecName(IntrState * intr, UInt rnam)
{
Obj isb; // element, result
Obj record; // the record, left operand
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeIsbRecName(intr->cs, rnam); return;
}
// get the record (checking is done by 'ISB_REC')
record = PopObj(intr);
// get the result
isb = (ISB_REC( record, rnam ) ? True : False);
// push the result
PushObj(intr, isb);
}
void IntrIsbRecExpr(IntrState * intr)
{
Obj isb; // element, result
Obj record; // the record, left operand
UInt rnam; // the name, right operand
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeIsbRecExpr(intr->cs); return;
}
// get the name and convert it to a record name
rnam = RNamObj(PopObj(intr));
// get the record (checking is done by 'ISB_REC')
record = PopObj(intr);
// get the result
isb = (ISB_REC( record, rnam ) ? True : False);
// push the result
PushObj(intr, isb);
}
/**************************************************************************** ** *FIntrAssPosObj()............interpretassignmenttoaposobj
*/ void IntrAssPosObj(IntrState * intr)
{
Obj posobj; // posobj
Obj pos; // position Int p; // position, as a C integer
Obj rhs; // right hand side
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeAssPosObj(intr->cs); return;
}
// get the right hand side
rhs = PopObj(intr);
// get and check the position
pos = PopObj(intr);
p = GetPositiveSmallIntEx("PosObj Assignment", pos, "<position>");
// get the posobj (checking is done by 'AssPosObj')
posobj = PopObj(intr);
// assign to the element of the posobj
AssPosObj(posobj, p, rhs);
// push the right hand side again
PushObj(intr, rhs);
}
void IntrUnbPosObj(IntrState * intr)
{
Obj posobj; // posobj
Obj pos; // position Int p; // position, as a C integer
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeUnbPosObj(intr->cs); return;
}
// get and check the position
pos = PopObj(intr);
p = GetPositiveSmallIntEx("PosObj Assignment", pos, "<position>");
// get the posobj (checking is done by 'UnbPosObj')
posobj = PopObj(intr);
// unbind the element
UnbPosObj(posobj, p);
// push void
PushVoidObj(intr);
}
/**************************************************************************** ** *FIntrElmPosObj().............interpretselectionofaposobj
*/ void IntrElmPosObj(IntrState * intr)
{
Obj elm; // element, result
Obj posobj; // posobj, left operand
Obj pos; // position, right operand Int p; // position, as C integer
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeElmPosObj(intr->cs); return;
}
// get and check the position
pos = PopObj(intr);
p = GetPositiveSmallIntEx("PosObj Element", pos, "<position>");
// get the posobj (checking is done by 'ElmPosObj')
posobj = PopObj(intr);
// get the element of the posobj
elm = ElmPosObj(posobj, p);
// push the element
PushObj(intr, elm);
}
void IntrIsbPosObj(IntrState * intr)
{
Obj isb; // isbound, result
Obj posobj; // posobj, left operand
Obj pos; // position, right operand Int p; // position, as C integer
// ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeIsbPosObj(intr->cs); return;
}
// get and check the position
pos = PopObj(intr);
p = GetPositiveSmallIntEx("PosObj Element", pos, "<position>");
// get the posobj (checking is done by 'IsbPosObj')
posobj = PopObj(intr);
// get the result
isb = IsbPosObj(posobj, p) ? True : False;
void IntrInfoBegin(IntrState * intr)
{ // ignore or code
SKIP_IF_RETURNING();
SKIP_IF_IGNORING(); if (intr->coding > 0) {
CodeInfoBegin(intr->cs); return;
}
}
void IntrInfoMiddle(IntrState * intr)
{
Obj selectors; // first argument of Info
Obj level; // second argument of Info
Obj selected; /* GAP Boolean answer to whether this message
gets printed or not */
// ignore or code
SKIP_IF_RETURNING(); if (intr->ignoring > 0) {
intr->ignoring++; return;
} if (intr->coding > 0) {
CodeInfoMiddle(intr->cs); return;
}
// The work of handling options is also delegated
ImportFuncFromLibrary( "PushOptions", &PushOptions );
ImportFuncFromLibrary( "PopOptions", &PopOptions );
return0;
}
/**************************************************************************** ** *FInitInfoIntrprtr()...............tableofinitfunctions
*/ static StructInitInfo module = { // init struct using C99 designated initializers; for a full list of // fields, please refer to the definition of StructInitInfo
.type = MODULE_BUILTIN,
.name = "intrprtr",
.initKernel = InitKernel,
};
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 und die Messung sind noch experimentell.