Quelle error.c Sprache: C

/****************************************************************************
**
**  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 implements functions for raising user errors and interacting
**  with the break loop.
**
*/

#include "error.h"

#include "bool.h"
#include "code.h"
#include "exprs.h"
#include "funcs.h"
#include "gapstate.h"
#include "gaputils.h"
#include "io.h"
#include "lists.h"
#include "modules.h"
#include "plist.h"
#include "precord.h"
#include "records.h"
#include "stats.h"
#include "stringobj.h"
#include "sysstr.h"
#include "trycatch.h"
#include "vars.h"

#ifdef HPCGAP
#include "hpc/thread.h"
#endif

#include <stdio.h>  // for fprintf

static Obj ErrorInner;
static Obj ERROR_OUTPUT = NULL;
static Obj IsOutputStream;

/****************************************************************************
**
*F * * * * * * * * * * * * * * error functions * * * * * * * * * * * * * * *
*/

/****************************************************************************
**
*F  OpenErrorOutput()  . . . . . . . open the file or stream assigned to the
**                                   ERROR_OUTPUT global variable defined in
**                                   error.g, or "*errout*" otherwise
*/
UInt OpenErrorOutput(TypOutputFile * output)
{
    // Try to print the output to stream. Use *errout* as a fallback.
    UInt ret = 0;

    if (ERROR_OUTPUT != NULL) {
        if (IsStringConv(ERROR_OUTPUT)) {
            ret = OpenOutput(output, CONST_CSTR_STRING(ERROR_OUTPUT), FALSE);
        }
        else {
            if (CALL_1ARGS(IsOutputStream, ERROR_OUTPUT) == True) {
                ret = OpenOutputStream(output, ERROR_OUTPUT);
            }
        }
    }

    if (!ret) {
        // It may be we already tried and failed to open *errout* above but
        // but this is an extreme case so it can't hurt to try again
        // anyways
        ret = OpenOutput(output, "*errout*", FALSE);
        if (ret) {
            Pr("failed to open error stream\n", 0, 0);
        }
        else {
            Panic("failed to open *errout*");
        }
    }

    return ret;
}

/****************************************************************************
**
*F  FuncDownEnv( <self>, <level> )  . . . . . . . . .  change the environment
*/
static Obj FuncDownEnv(Obj self, Obj args)
{
    Int depth;

    if (LEN_PLIST(args) == 0) {
        depth = 1;
    }
    else if (LEN_PLIST(args) == 1 && IS_INTOBJ(ELM_PLIST(args, 1))) {
        depth = INT_INTOBJ(ELM_PLIST(args, 1));
    }
    else {
        ErrorQuit("usage: DownEnv( [ ] )", 0, 0);
    }
    if (IsBottomLVars(STATE(ErrorLVars))) {
        Pr("not in any function\n", 0, 0);
        return (Obj)0;
    }

    STATE(ErrorLLevel) += depth;;
    return (Obj)0;
}

static Obj FuncUpEnv(Obj self, Obj args)
{
    Int depth;
    if (LEN_PLIST(args) == 0) {
        depth = 1;
    }
    else if (LEN_PLIST(args) == 1 && IS_INTOBJ(ELM_PLIST(args, 1))) {
        depth = INT_INTOBJ(ELM_PLIST(args, 1));
    }
    else {
        ErrorQuit("usage: UpEnv( [ ] )", 0, 0);
    }
    if (IsBottomLVars(STATE(ErrorLVars))) {
        Pr("not in any function\n", 0, 0);
        return (Obj)0;
    }

    STATE(ErrorLLevel) -= depth;
    return (Obj)0;
}

static Obj FuncCURRENT_STATEMENT_LOCATION(Obj self, Obj context)
{
    if (IsBottomLVars(context))
        return Fail;

    Obj func = FUNC_LVARS(context);
    GAP_ASSERT(func);
    Stat call = STAT_LVARS(context);
    if (IsKernelFunction(func)) {
        return Fail;
    }
    Obj body = BODY_FUNC(func);
    if (call < OFFSET_FIRST_STAT ||
        call > SIZE_BAG(body) - sizeof(StatHeader)) {
        return Fail;
    }

    Obj filename = GET_FILENAME_BODY(body);
    if (!filename) {
        return Fail;
    }

    Obj currLVars = SWITCH_TO_OLD_LVARS(context);

    Obj retlist = Fail;
    Int type = TNUM_STAT(call);
    if ((FIRST_STAT_TNUM <= type && type <= LAST_STAT_TNUM) ||
        (FIRST_EXPR_TNUM <= type && type <= LAST_EXPR_TNUM)) {
        Int line = LINE_STAT(call);
        retlist = NewPlistFromArgs(filename, INTOBJ_INT(line));
    }
    SWITCH_TO_OLD_LVARS(currLVars);
    return retlist;
}

static Obj FuncPRINT_CURRENT_STATEMENT(Obj self, Obj stream, Obj context)
{
    if (IsBottomLVars(context))
        return 0;

    // HACK: we want to redirect output
    // Try to print the output to stream. Use *errout* as a fallback.
    TypOutputFile output = { 0 };
    if ((IsStringConv(stream) &&
         !OpenOutput(&output, CONST_CSTR_STRING(stream), FALSE)) ||
        (!IS_STRING(stream) && !OpenOutputStream(&output, stream))) {
        if (OpenOutput(&output, "*errout*", FALSE)) {
            Pr("PRINT_CURRENT_STATEMENT: failed to open error stream\n", 0, 0);
        }
        else {
            Panic("failed to open *errout*");
        }
    }

    BOOL rethrow = FALSE;
    GAP_TRY
    {
        Obj func = FUNC_LVARS(context);
        GAP_ASSERT(func);
        Stat call = STAT_LVARS(context);
        Obj  body = BODY_FUNC(func);
        Obj  filename = GET_FILENAME_BODY(body);
        if (IsKernelFunction(func)) {
            PrintKernelFunction(func);
            Obj funcname = NAME_FUNC(func);
            if (funcname) {
                Pr(" in function %g", (Int)funcname, 0);
            }
        }
        else if (call < OFFSET_FIRST_STAT ||
                 call > SIZE_BAG(body) - sizeof(StatHeader)) {
            Pr(" ", 0, 0);
        }
        else if (filename) {
            Obj currLVars = SWITCH_TO_OLD_LVARS(context);

            Int type = TNUM_STAT(call);
            if (FIRST_STAT_TNUM <= type && type <= LAST_STAT_TNUM) {
                PrintStat(call);
                Pr(" at %g:%d", (Int)filename, LINE_STAT(call));
            }
            else if (FIRST_EXPR_TNUM <= type && type <= LAST_EXPR_TNUM) {
                PrintExpr(call);
                Pr(" at %g:%d", (Int)filename, LINE_STAT(call));
            }
            SWITCH_TO_OLD_LVARS(currLVars);
        }
    }
    GAP_CATCH
    {
        rethrow = TRUE;
    }

    // HACK: close the output again
    CloseOutput(&output);

    if (rethrow)
        GAP_THROW();

    return 0;
}

/****************************************************************************
**
*F  FuncCALL_WITH_CATCH( <self>, <func> )
**
*/
static Obj FuncCALL_WITH_CATCH(Obj self, Obj func, Obj args)
{
    return CALL_WITH_CATCH(func, args);
}

Obj CALL_WITH_CATCH(Obj func, volatile Obj args)
{
    volatile Obj       res;
    volatile Obj       currLVars;
    volatile Obj       tilde;

    RequireFunction("CALL_WITH_CATCH", func);
    if (!IS_LIST(args))
        RequireArgument("CALL_WITH_CATCH", args, "must be a list");
#ifdef HPCGAP
    if (!IS_PLIST(args)) {
        args = PLAIN_LIST_COPY(args);
    }
#endif

    currLVars = STATE(CurrLVars);
    tilde = STATE(Tilde);
    res = NEW_PLIST_IMM(T_PLIST_DENSE, 2);
#ifdef HPCGAP
    int      lockSP = RegionLockSP();
    Region * savedRegion = TLS(currentRegion);
#endif
    GAP_TRY
    {
        Obj result = CallFuncList(func, args);
        // Make an explicit check if an interrupt occurred
        // in case func was a kernel function.
        TakeInterrupt();
#ifdef HPCGAP
        // There should be no locks to pop off the stack, but better safe than
        // sorry.
        PopRegionLocks(lockSP);
        TLS(currentRegion) = savedRegion;
#endif
        SET_ELM_PLIST(res, 1, True);
        if (result) {
            SET_LEN_PLIST(res, 2);
            SET_ELM_PLIST(res, 2, result);
            CHANGED_BAG(res);
        }
        else
            SET_LEN_PLIST(res, 1);
    }
    GAP_CATCH
    {
        SET_LEN_PLIST(res, 2);
        SET_ELM_PLIST(res, 1, False);
        SET_ELM_PLIST(res, 2, STATE(ThrownObject));
        CHANGED_BAG(res);
        STATE(ThrownObject) = 0;
        SWITCH_TO_OLD_LVARS(currLVars);
        STATE(Tilde) = tilde;
#ifdef HPCGAP
        PopRegionLocks(lockSP);
        TLS(currentRegion) = savedRegion;
        if (TLS(CurrentHashLock))
            HashUnlock(TLS(CurrentHashLock));
#endif
    }
    return res;
}

static Obj FuncJUMP_TO_CATCH(Obj self, Obj payload)
{
    STATE(ThrownObject) = payload;
    if (STATE(JumpToCatchCallback) != 0) {
        (*STATE(JumpToCatchCallback))();
    }
    GAP_THROW();
    return 0;
}

static Obj FuncSetUserHasQuit(Obj Self, Obj value)
{
    STATE(UserHasQuit) = INT_INTOBJ(value);
    return 0;
}

/****************************************************************************
**
*F  RegisterBreakloopObserver( <func> )
*/

static intfunc signalBreakFuncList[16];

Int RegisterBreakloopObserver(intfunc func)
{
    Int i;
    for (i = 0; i < ARRAY_SIZE(signalBreakFuncList); ++i) {
        if (signalBreakFuncList[i] == 0) {
            signalBreakFuncList[i] = func;
            return 1;
        }
    }
    return 0;
}

/****************************************************************************
**
*F  ErrorMessageToGAPString( <msg>, <arg1>, <arg2> )
*/

static Obj ErrorMessageToGAPString(const Char * msg, Int arg1, Int arg2)
{
    Char message[1024];
    SPrTo(message, sizeof(message), msg, arg1, arg2);
    message[sizeof(message) - 1] = '\0';
    return MakeImmString(message);
}

static Obj CallErrorInner(const Char * msg,
                          Int          arg1,
                          Int          arg2,
                          UInt         justQuit,
                          UInt         mayReturnVoid,
                          UInt         mayReturnObj,
                          Obj          lateMessage,
                          UInt         printThisStatement)
{
    // Must do this before creating any other GAP objects,
    // as one of the args could be a pointer into a Bag.
    Obj EarlyMsg = ErrorMessageToGAPString(msg, arg1, arg2);

    if (!ErrorInner || !IS_FUNC(ErrorInner)) {
        fprintf(stderr, "%s\n", CONST_CSTR_STRING(EarlyMsg));
        if (!ErrorInner)
            Panic("error handler not yet initialized");
        else
            Panic("error handler must be a function");
    }

    Obj r = NEW_PREC(0);
    Obj l;
    Int i;

#ifdef HPCGAP
    Region * savedRegion = TLS(currentRegion);
    TLS(currentRegion) = TLS(threadRegion);
#endif
    AssPRec(r, RNamName("context"), STATE(CurrLVars));
    AssPRec(r, RNamName("justQuit"), justQuit ? True : False);
    AssPRec(r, RNamName("mayReturnObj"), mayReturnObj ? True : False);
    AssPRec(r, RNamName("mayReturnVoid"), mayReturnVoid ? True : False);
    AssPRec(r, RNamName("printThisStatement"),
            printThisStatement ? True : False);
    AssPRec(r, RNamName("lateMessage"), lateMessage);
    l = NewPlistFromArgs(EarlyMsg);
    MakeImmutableNoRecurse(l);

    // Signal functions about entering and leaving break loop
    for (i = 0; i < ARRAY_SIZE(signalBreakFuncList) && signalBreakFuncList[i];
         ++i)
        (signalBreakFuncList[i])(1);
    Obj res = CALL_2ARGS(ErrorInner, r, l);
    for (i = 0; i < ARRAY_SIZE(signalBreakFuncList) && signalBreakFuncList[i];
         ++i)
        (signalBreakFuncList[i])(0);
#ifdef HPCGAP
    TLS(currentRegion) = savedRegion;
#endif
    return res;
}

void ErrorQuit(const Char * msg, Int arg1, Int arg2)
{
    CallErrorInner(msg, arg1, arg2, 1, 0, 0, False, 1);
    Panic("ErrorQuit must not return");
}

/****************************************************************************
**
*F  ErrorMayQuitNrArgs( <narg>, <actual> ) . . . .  wrong number of arguments
*/
void ErrorMayQuitNrArgs(Int narg, Int actual)
{
    ErrorMayQuit("Function: number of arguments must be %d (not %d)",
                 narg, actual);
}

/****************************************************************************
**
*F  ErrorMayQuitNrAtLeastArgs( <narg>, <actual> ) . . .  not enough arguments
*/
void ErrorMayQuitNrAtLeastArgs(Int narg, Int actual)
{
    ErrorMayQuit(
        "Function: number of arguments must be at least %d (not %d)",
        narg, actual);
}

/****************************************************************************
**
*F  ErrorReturnObj( <msg>, <arg1>, <arg2>, <msg2> ) . .  print and return obj
*/
Obj ErrorReturnObj(const Char * msg, Int arg1, Int arg2, const Char * msg2)
{
    Obj LateMsg;
    LateMsg = MakeString(msg2);
    return CallErrorInner(msg, arg1, arg2, 0, 0, 1, LateMsg, 1);
}

/****************************************************************************
**
*F  ErrorReturnVoid( <msg>, <arg1>, <arg2>, <msg2> )  . . .  print and return
*/
void ErrorReturnVoid(const Char * msg, Int arg1, Int arg2, const Char * msg2)
{
    Obj LateMsg;
    LateMsg = MakeString(msg2);
    CallErrorInner(msg, arg1, arg2, 0, 1, 0, LateMsg, 1);
    // ErrorMode( msg, arg1, arg2, (Obj)0, msg2, 'x' );
}

/****************************************************************************
**
*F  ErrorMayQuit( <msg>, <arg1>, <arg2> )  . . .  print and return
*/
void ErrorMayQuit(const Char * msg, Int arg1, Int arg2)
{
    Obj LateMsg = MakeString("type 'quit;' to quit to outer loop");
    CallErrorInner(msg, arg1, arg2, 0, 0, 0, LateMsg, 1);
    Panic("ErrorMayQuit must not return");
}

/****************************************************************************
**
*F  CheckIsPossList( <desc>, <poss> ) . . . . . . . . . . check for poss list
*/
void CheckIsPossList(const Char * desc, Obj poss)
{
    if ( ! IS_POSS_LIST( poss ) ) {
        ErrorMayQuit("%s: must be a dense list of positive integers",
            (Int)desc, 0 );
    }
}

/****************************************************************************
**
*F  CheckIsDenseList( <desc>, <listName>, <list> ) . . . check for dense list
*/
void CheckIsDenseList(const Char * desc, const Char * listName, Obj list)
{
    if (!IS_DENSE_LIST(list)) {
        ErrorMayQuit("%s: <%s> must be a dense list", (Int)desc, (Int)listName);
    }
}

/****************************************************************************
**
*F  CheckSameLength
*/
void CheckSameLength(const Char * desc,
                     const Char * name1,
                     const Char * name2,
                     Obj          op1,
                     Obj          op2)
{
    UInt len1 = LEN_LIST(op1);
    UInt len2 = LEN_LIST(op2);
    if (len1 != len2) {
        Char message[1024];
        snprintf(message, sizeof(message),
                 "%s: <%s> must have the same length as <%s> "
                 "(lengths are %d and %d)",
                 desc, name1, name2, (int)len1, (int)len2);
        ErrorMayQuit(message, 0, 0);
    }
}

/****************************************************************************
**
*F  RequireArgumentEx
*/
void RequireArgumentEx(const char * funcname,
                       Obj          op,
                       const char * argname,
                       const char * msg)
{
    char msgbuf[1024] = { 0 };
    Int  arg1 = 0;

    if (funcname) {
        gap_strlcat(msgbuf, funcname, sizeof(msgbuf));
        gap_strlcat(msgbuf, ": ", sizeof(msgbuf));
    }
    if (argname) {
        gap_strlcat(msgbuf, argname, sizeof(msgbuf));
        gap_strlcat(msgbuf, " ", sizeof(msgbuf));
    }
    gap_strlcat(msgbuf, msg, sizeof(msgbuf));
    if (IS_INTOBJ(op)) {
        gap_strlcat(msgbuf, " (not the integer %d)", sizeof(msgbuf));
        arg1 = INT_INTOBJ(op);
    }
    else if (op == True)
        gap_strlcat(msgbuf, " (not the value 'true')", sizeof(msgbuf));
    else if (op == False)
        gap_strlcat(msgbuf, " (not the value 'false')", sizeof(msgbuf));
    else if (op == Fail)
        gap_strlcat(msgbuf, " (not the value 'fail')", sizeof(msgbuf));
    else {
        const char * tnam = TNAM_OBJ(op);
        // heuristic to choose between 'a' and 'an': use 'an' before a vowel
        // and 'a' otherwise; however, that's not always correct, e.g. it is
        // "an FFE", so we add a special case for that as well
        if (TNUM_OBJ(op) == T_FFE || tnam[0] == 'a' || tnam[0] == 'e' ||
            tnam[0] == 'i' || tnam[0] == 'o' || tnam[0] == 'u')
            gap_strlcat(msgbuf, " (not an %s)", sizeof(msgbuf));
        else
            gap_strlcat(msgbuf, " (not a %s)", sizeof(msgbuf));
        arg1 = (Int)tnam;
    }

    ErrorMayQuit(msgbuf, arg1, 0);
}

const char * SELF_NAME_HELPER(Obj self, const char * func)
{
    if (self && NAME_FUNC(self))
        return CONST_CSTR_STRING(NAME_FUNC(self));
    return func;
}

void ErrorBoundedInt(
    const char * funcname, Obj op, const char * argname, int min, int max)
{
#define BOUNDED_INT_FORMAT "must be an integer between %d and %d"
    // The maximal number of decimal digits in a signed 64 bit value is 20, so
    // reserve space for that (actually, we would need a bit less because the
    // `%d` in the format string of course also adds to the length, but a
    // few bytes more or less don't matter).
    // Also note that in practice, `int` will be a 32 bit type anyway...
    char msg[sizeof(BOUNDED_INT_FORMAT) + 2 * 20];
    snprintf(msg, sizeof(msg), BOUNDED_INT_FORMAT, min, max);
    RequireArgumentEx(funcname, op, argname, msg);
#undef BOUNDED_INT_FORMAT
}

void AssertionFailure(void)
{
    ErrorReturnVoid("Assertion failure", 0, 0, "you may 'return;'");
}

void AssertionFailureWithMessage(Obj message)
{
    if (message == 0) {
        // this case is triggered by code like this: Assert(0, false, Error("boo"));
        // at least if the user enters `return;` into the break loop opened by this.
        AssertionFailure();
    }
    else if (IS_STRING_REP(message)) {
        ErrorReturnVoid("Assertion failure: %g", (Int)message, 0, "you may 'return;'");
    }
    else {
        PrintObj(message);
        Pr("\n", 0, 0);
        AssertionFailure();
    }
}

/****************************************************************************
**
*V  GVarFuncs . . . . . . . . . . . . . . . . . . list of functions to export
*/
static StructGVarFunc GVarFuncs[] = {

    GVAR_FUNC_XARGS(DownEnv, -1, "args"),
    GVAR_FUNC_XARGS(UpEnv, -1, "args"),

    GVAR_FUNC_2ARGS(CALL_WITH_CATCH, func, args),
    GVAR_FUNC_1ARGS(JUMP_TO_CATCH, payload),

    GVAR_FUNC_2ARGS(PRINT_CURRENT_STATEMENT, stream, context),
    GVAR_FUNC_1ARGS(CURRENT_STATEMENT_LOCATION, context),

    GVAR_FUNC_1ARGS(SetUserHasQuit, value),

    { 0, 0, 0, 0, 0 }

};

/****************************************************************************
**
*F  InitKernel( <module> )  . . . . . . . . initialise kernel data structures
*/
static Int InitKernel(StructInitInfo * module)
{
    STATE(ThrownObject) = 0;
    InitGlobalBag( &STATE(ThrownObject), "src/gap.c:ThrownObject"      );

    // init filters and functions
    InitHdlrFuncsFromTable(GVarFuncs);

    ImportGVarFromLibrary("ErrorInner", &ErrorInner);
    ImportFuncFromLibrary("IsOutputStream", &IsOutputStream);
    ImportGVarFromLibrary("ERROR_OUTPUT", &ERROR_OUTPUT);

    return 0;
}

/****************************************************************************
**
*F  InitLibrary( <module> ) . . . . . . .  initialise library data structures
*/
static Int InitLibrary(StructInitInfo * module)
{
    // init filters and functions
    InitGVarFuncsFromTable(GVarFuncs);

    return 0;
}

/****************************************************************************
**
*F  InitInfoError() . . . . . . . . . . . . . . . . . table of init functions
*/
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 = "error",
    .initKernel = InitKernel,
    .initLibrary = InitLibrary,
};

StructInitInfo * InitInfoError(void)
{
    return &module;
}

quality98%

¤ Dauer der Verarbeitung: 0.21 Sekunden (vorverarbeitet) ¤

Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

Haftungshinweis

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.