<commit_before>/*  $Id$

    Part of SWI-Prolog

    Author:        <NAME>
    E-mail:        <EMAIL>
    WWW:           http://www.swi-prolog.org
    Copyright (C): 1985-2009, University of Amsterdam

    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Lesser General Public
    License as published by the Free Software Foundation; either
    version 2.1 of the License, or (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the Free Software
    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
*/

#ifdef SECURE_GC
#define O_DEBUG 1			/* include checkData() */
#endif
#include "pl-incl.h"


		/********************************
		*    CALLING THE INTERPRETER    *
		*********************************/

static int
resetProlog(int clear_stacks)
{ GET_LD
  IOSTREAM *in = Suser_input;

  if ( Sferror(in) )
  { Sclearerr(in);
    LD->prompt.next = TRUE;
  }

  Scurin  = in;
  Scurout = Suser_output;

  PL_clear_exception();
  resetTracer();

  if ( clear_stacks )
  { if ( !LD->gvar.nb_vars )		/* we would loose nb_setval/2 vars */
      emptyStacks();

    gc_status.blocked        = 0;
    LD->shift_status.blocked = 0;
    LD->in_arithmetic        = 0;
    LD->in_print_message     = 0;
  }

#ifdef O_LIMIT_DEPTH
  depth_limit   = (uintptr_t)DEPTH_NO_LIMIT;
#endif

  updateAlerted(LD);

  return TRUE;
}


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
query_loop() runs a zero-argument goal on   behalf  of the toplevel. The
reason for this to be in C is to   be able to handle exceptions that are
considered unhandled and thus  can  trap   the  debugger.  I.e., if goal
terminates due to an exception, the exception   is  reported and goal is
restarted. Before the restart, the system is   restored to a sane state.
This notably affects I/O  (reset  current  I/O   to  user  I/O)  and the
debugger.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

int
query_loop(atom_t goal, int loop)
{ GET_LD
  int rc;
  int clear_stacks = (LD->query == NULL);

  do
  { fid_t fid;
    qid_t qid = 0;
    term_t except = 0;
    predicate_t p;

    if ( !resetProlog(clear_stacks) )
      goto error;
    if ( !(fid = PL_open_foreign_frame()) )
      goto error;

    p = PL_pred(PL_new_functor(goal, 0), MODULE_system);

    if ( (qid = PL_open_query(MODULE_system, PL_Q_NORMAL, p, 0)) )
    { rc = PL_next_solution(qid);
    } else
    { error:
      except = exception_term;
      rc = FALSE;			/* Won't get any better */
      break;
    }

    if ( !rc && (except = PL_exception(qid)) )
    { atom_t a;

      tracemode(FALSE, NULL);
      debugmode(DBG_OFF, NULL);
      setPrologFlagMask(PLFLAG_LASTCALL);
      if ( PL_get_atom(except, &a) && a == ATOM_aborted )
      { callEventHook(PLEV_ABORT);
        printMessage(ATOM_informational, PL_ATOM, ATOM_aborted);
      }
    }

    if ( qid ) PL_close_query(qid);
    if ( fid ) PL_discard_foreign_frame(fid);
    if ( !except )
      break;
  } while(loop);

  return rc;
}


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Starts a new Prolog toplevel.  Resets I/O to point to the user and stops
the debugger.  Restores I/O and debugger on exit.  The Prolog  predicate
`$break' is called to actually built the break environment.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

static int
pl_break1(atom_t goal)
{ GET_LD
  int rc;
  int old_level = LD->break_level;

  IOSTREAM *inSave  = Scurin;
  IOSTREAM *outSave = Scurout;
  intptr_t skipSave = debugstatus.skiplevel;
  int  suspSave     = debugstatus.suspendTrace;
  int  traceSave;
  debug_type debugSave;

  tracemode(FALSE, &traceSave);
  debugmode(DBG_OFF, &debugSave);

  Scurin  = Sinput;
  Scurout = Soutput;

  LD->break_level++;
  if ( LD->break_level > 0 )
  { printMessage(ATOM_informational,
		 PL_FUNCTOR, FUNCTOR_break2,
	           PL_ATOM, ATOM_begin,
		   PL_INT,  LD->break_level);
  }

  rc = query_loop(goal, TRUE);

  if ( LD->break_level > 0 )
  { printMessage(ATOM_informational,
		 PL_FUNCTOR, FUNCTOR_break2,
	           PL_ATOM, ATOM_end,
		   PL_INT,  LD->break_level);
  }
  LD->break_level = old_level;

  debugstatus.suspendTrace = suspSave;
  debugstatus.skiplevel    = skipSave;
  tracemode(traceSave, NULL);
  debugmode(debugSave, NULL);

  Scurout = outSave;
  Scurin  = inSave;

  return rc;
}


/** break

Run a nested toplevel. Do not  use   PRED_IMPL()  for this because it is
very handy to use from e.g., the gdb debugger.
*/

word
pl_break(void)
{ GET_LD
  wakeup_state wstate;

  if ( saveWakeup(&wstate, TRUE PASS_LD) )
  { word rc;

    rc = pl_break1(ATOM_dquery_loop);
    restoreWakeup(&wstate PASS_LD);

    return rc;
  }

  return FALSE;
}


int
currentBreakLevel(void)
{ GET_LD

  return LD->break_level;
}


word
pl_notrace1(term_t goal)
{ GET_LD
  bool rval;

  uintptr_t  skipSave  = debugstatus.skiplevel;
  bool	     traceSave = debugstatus.tracing;

  rval = callProlog(NULL, goal, PL_Q_NODEBUG, NULL);

  debugstatus.skiplevel    = skipSave;
  debugstatus.tracing      = traceSave;

  return rval;
}

#undef LD
#define LD LOCAL_LD

/** '$sig_atomic'(:Goal) is semidet.

Execute Goal as once/1 while blocking signals.

@see setup_call_catcher_cleanup/4 in boot/init.pl
@see callCleanupHandler() uses the same mechanism to protect the cleanup
*/

static
PRED_IMPL("$sig_atomic", 1, sig_atomic, PL_FA_TRANSPARENT)
{ PRED_LD
  term_t ex;
  int rval;

  startCritical;
  rval = callProlog(NULL, A1, PL_Q_CATCH_EXCEPTION, &ex);
  if ( !endCritical )
    fail;				/* aborted */

  if ( !rval && ex )
    return PL_raise_exception(ex);

  return rval;
}


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Call a prolog goal from C. The argument must  be  an  instantiated  term
like for the Prolog predicate call/1.

Note that the caller must provide a   foreign context. We cannot do that
here because closing will loose the exception.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

int
callProlog(Module module, term_t goal, int flags, term_t *ex)
{ GET_LD
  term_t reset, g, ex2;
  functor_t fd;
  Procedure proc;

  assert((Word)lTop == refFliP(fli_context, fli_context->size));

  if ( ex )
  { if ( !(ex2=PL_new_term_ref()) )
      goto error;
    reset = ex2;
    *ex = 0;
  } else
  { reset = 0;
    ex2 = 0;				/* keep compiler happy */
  }

  if ( !(g=PL_new_term_ref()) )
  { error:
    if ( ex )
      *ex = exception_term;
    return FALSE;
  }
  if ( !reset )
    reset = g;

  if ( !PL_strip_module(goal, &module, g) )
    return FALSE;
  if ( !PL_get_functor(g, &fd) )
  { PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_callable, goal);
    if ( ex )
      *ex = exception_term;

    PL_reset_term_refs(g);
    fail;
  }

  proc = resolveProcedure(fd, module);

  { int arity = arityFunctor(fd);
    term_t args;
    qid_t qid = 0;
    int n, rval;

    if ( (args = PL_new_term_refs(arity)) )
    { for(n=0; n<arity; n++)
	_PL_get_arg(n+1, g, args+n);

      if ( (qid = PL_open_query(module, flags, proc, args)) )
      { rval = PL_next_solution(qid);
      } else
	goto error;
    } else
      goto error;

    if ( !rval && ex )
    { term_t qex = PL_exception(qid);

      if ( qex )
      { PL_put_term(ex2, qex);
	*ex = ex2;
	reset = g;
      } else
      { *ex = 0;
      }
    }
    PL_cut_query(qid);

    PL_reset_term_refs(reset);
    return rval;
  }
}


int
abortProlog(void)
{ GET_LD
  fid_t fid;
  term_t ex;
  int rc = FALSE;

  pl_notrace();
  Sreset();				/* Discard pending IO */

  LD->exception.processing = TRUE;	/* allow using spare stack */

  if ( (fid = PL_open_foreign_frame()) &&
       (ex = PL_new_term_ref()) )
  { clearSegStack(&LD->cycle.lstack);	/* can do no harm */<commit_msg>FIXED: callProlog(): make sure exception term handle remains valid.<commit_after>/*  $Id$

    Part of SWI-Prolog

    Author:        <NAME>
    E-mail:        <EMAIL>
    WWW:           http://www.swi-prolog.org
    Copyright (C): 1985-2009, University of Amsterdam

    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Lesser General Public
    License as published by the Free Software Foundation; either
    version 2.1 of the License, or (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the Free Software
    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
*/

#ifdef SECURE_GC
#define O_DEBUG 1			/* include checkData() */
#endif
#include "pl-incl.h"


		/********************************
		*    CALLING THE INTERPRETER    *
		*********************************/

static int
resetProlog(int clear_stacks)
{ GET_LD
  IOSTREAM *in = Suser_input;

  if ( Sferror(in) )
  { Sclearerr(in);
    LD->prompt.next = TRUE;
  }

  Scurin  = in;
  Scurout = Suser_output;

  PL_clear_exception();
  resetTracer();

  if ( clear_stacks )
  { if ( !LD->gvar.nb_vars )		/* we would loose nb_setval/2 vars */
      emptyStacks();

    gc_status.blocked        = 0;
    LD->shift_status.blocked = 0;
    LD->in_arithmetic        = 0;
    LD->in_print_message     = 0;
  }

#ifdef O_LIMIT_DEPTH
  depth_limit   = (uintptr_t)DEPTH_NO_LIMIT;
#endif

  updateAlerted(LD);

  return TRUE;
}


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
query_loop() runs a zero-argument goal on   behalf  of the toplevel. The
reason for this to be in C is to   be able to handle exceptions that are
considered unhandled and thus  can  trap   the  debugger.  I.e., if goal
terminates due to an exception, the exception   is  reported and goal is
restarted. Before the restart, the system is   restored to a sane state.
This notably affects I/O  (reset  current  I/O   to  user  I/O)  and the
debugger.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

int
query_loop(atom_t goal, int loop)
{ GET_LD
  int rc;
  int clear_stacks = (LD->query == NULL);

  do
  { fid_t fid;
    qid_t qid = 0;
    term_t except = 0;
    predicate_t p;

    if ( !resetProlog(clear_stacks) )
      goto error;
    if ( !(fid = PL_open_foreign_frame()) )
      goto error;

    p = PL_pred(PL_new_functor(goal, 0), MODULE_system);

    if ( (qid = PL_open_query(MODULE_system, PL_Q_NORMAL, p, 0)) )
    { rc = PL_next_solution(qid);
    } else
    { error:
      except = exception_term;
      rc = FALSE;			/* Won't get any better */
      break;
    }

    if ( !rc && (except = PL_exception(qid)) )
    { atom_t a;

      tracemode(FALSE, NULL);
      debugmode(DBG_OFF, NULL);
      setPrologFlagMask(PLFLAG_LASTCALL);
      if ( PL_get_atom(except, &a) && a == ATOM_aborted )
      { callEventHook(PLEV_ABORT);
        printMessage(ATOM_informational, PL_ATOM, ATOM_aborted);
      }
    }

    if ( qid ) PL_close_query(qid);
    if ( fid ) PL_discard_foreign_frame(fid);
    if ( !except )
      break;
  } while(loop);

  return rc;
}


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Starts a new Prolog toplevel.  Resets I/O to point to the user and stops
the debugger.  Restores I/O and debugger on exit.  The Prolog  predicate
`$break' is called to actually built the break environment.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

static int
pl_break1(atom_t goal)
{ GET_LD
  int rc;
  int old_level = LD->break_level;

  IOSTREAM *inSave  = Scurin;
  IOSTREAM *outSave = Scurout;
  intptr_t skipSave = debugstatus.skiplevel;
  int  suspSave     = debugstatus.suspendTrace;
  int  traceSave;
  debug_type debugSave;

  tracemode(FALSE, &traceSave);
  debugmode(DBG_OFF, &debugSave);

  Scurin  = Sinput;
  Scurout = Soutput;

  LD->break_level++;
  if ( LD->break_level > 0 )
  { printMessage(ATOM_informational,
		 PL_FUNCTOR, FUNCTOR_break2,
	           PL_ATOM, ATOM_begin,
		   PL_INT,  LD->break_level);
  }

  rc = query_loop(goal, TRUE);

  if ( LD->break_level > 0 )
  { printMessage(ATOM_informational,
		 PL_FUNCTOR, FUNCTOR_break2,
	           PL_ATOM, ATOM_end,
		   PL_INT,  LD->break_level);
  }
  LD->break_level = old_level;

  debugstatus.suspendTrace = suspSave;
  debugstatus.skiplevel    = skipSave;
  tracemode(traceSave, NULL);
  debugmode(debugSave, NULL);

  Scurout = outSave;
  Scurin  = inSave;

  return rc;
}


/** break

Run a nested toplevel. Do not  use   PRED_IMPL()  for this because it is
very handy to use from e.g., the gdb debugger.
*/

word
pl_break(void)
{ GET_LD
  wakeup_state wstate;

  if ( saveWakeup(&wstate, TRUE PASS_LD) )
  { word rc;

    rc = pl_break1(ATOM_dquery_loop);
    restoreWakeup(&wstate PASS_LD);

    return rc;
  }

  return FALSE;
}


int
currentBreakLevel(void)
{ GET_LD

  return LD->break_level;
}


word
pl_notrace1(term_t goal)
{ GET_LD
  bool rval;

  uintptr_t  skipSave  = debugstatus.skiplevel;
  bool	     traceSave = debugstatus.tracing;

  rval = callProlog(NULL, goal, PL_Q_NODEBUG, NULL);

  debugstatus.skiplevel    = skipSave;
  debugstatus.tracing      = traceSave;

  return rval;
}

#undef LD
#define LD LOCAL_LD

/** '$sig_atomic'(:Goal) is semidet.

Execute Goal as once/1 while blocking signals.

@see setup_call_catcher_cleanup/4 in boot/init.pl
@see callCleanupHandler() uses the same mechanism to protect the cleanup
*/

static
PRED_IMPL("$sig_atomic", 1, sig_atomic, PL_FA_TRANSPARENT)
{ PRED_LD
  term_t ex;
  int rval;

  startCritical;
  rval = callProlog(NULL, A1, PL_Q_CATCH_EXCEPTION, &ex);
  if ( !endCritical )
    fail;				/* aborted */

  if ( !rval && ex )
    return PL_raise_exception(ex);

  return rval;
}


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Call a prolog goal from C. The argument must  be  an  instantiated  term
like for the Prolog predicate call/1.

Note that the caller must provide a   foreign context. We cannot do that
here because closing will loose the exception.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

int
callProlog(Module module, term_t goal, int flags, term_t *ex)
{ GET_LD
  term_t reset=0, g, ex2 = 0;
  functor_t fd;
  Procedure proc;

  assert((Word)lTop == refFliP(fli_context, fli_context->size));

  if ( ex )
  { if ( !(ex2=PL_new_term_ref()) )
      goto error;
    *ex = 0;
  }

  if ( !(g=PL_new_term_ref()) )
  { error:
    if ( ex )
      *ex = exception_term;
    return FALSE;
  }

  if ( !PL_strip_module(goal, &module, g) )
    return FALSE;
  if ( !PL_get_functor(g, &fd) )
  { PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_callable, goal);
    if ( ex )
      *ex = exception_term;

    PL_reset_term_refs(g);
    fail;
  }

  proc = resolveProcedure(fd, module);

  { int arity = arityFunctor(fd);
    term_t args;
    qid_t qid = 0;
    int n, rval;

    if ( (args = PL_new_term_refs(arity)) )
    { for(n=0; n<arity; n++)
	_PL_get_arg(n+1, g, args+n);

      if ( (qid = PL_open_query(module, flags, proc, args)) )
      { rval = PL_next_solution(qid);
      } else
	goto error;
    } else
      goto error;

    if ( !rval && ex )
    { term_t qex = PL_exception(qid);

      if ( qex )
      { PL_put_term(ex2, qex);
	*ex = ex2;
	reset = g;
      } else
      { *ex = 0;
      }
    }

    PL_cut_query(qid);
    if ( !reset )
      reset = (ex2 ? ex2 : g);
    PL_reset_term_refs(reset);

    return rval;
  }
}


int
abortProlog(void)
{ GET_LD
  fid_t fid;
  term_t ex;
  int rc = FALSE;

  pl_notrace();
  Sreset();				/* Discard pending IO */

  LD->exception.processing = TRUE;	/* allow using spare stack */

  if ( (fid = PL_open_foreign_frame()) &&
       (ex = PL_new_term_ref()) )
  { clearSegStack(&LD->cycle.lstack);	/* can do no harm */
{'fraction_non_alphanumeric': 0.13412553321145643, 'fraction_numerical': 0.006946983546617916, 'mean_word_length': 2.360843743600246, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 45, 'https://': 0, 'lorem ipsum': 0, 'www.': 2, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 72, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2701057', 'n_tokens_mistral': 6387, 'n_tokens_neox': 6094, 'n_words': 1579}