Spracherkennung für: .c vermutete Sprache: Abap {ABAP[60] Cobol[52] Masm[40]} [Methode: maximale Elemente, drei Dimensionen]
/****************************************************************************
**
** 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( [ <depth> ] )", 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( [ <depth> ] )", 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("<corrupted statement> ", 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: <poss> 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;
}
