text: /*  Part of SWI-Prolog
  
      Author:        Jan Wielemaker
      E-mail:        J.Wielemaker@vu.nl
      WWW:           http://www.swi-prolog.org
      Copyright (c)  2011-2020, University of Amsterdam
                                VU University Amsterdam
  			      CWI, Amsterdam
      All rights reserved.
  
      Redistribution and use in source and binary forms, with or without
      modification, are permitted provided that the following conditions
      are met:
  
      1. Redistributions of source code must retain the above copyright
         notice, this list of conditions and the following disclaimer.
  
      2. Redistributions in binary form must reproduce the above copyright
         notice, this list of conditions and the following disclaimer in
         the documentation and/or other materials provided with the
         distribution.
  
      THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
      "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
      LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
      FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
      COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
      INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
      BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
      LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
      CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
      LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
      ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
      POSSIBILITY OF SUCH DAMAGE.
  */
  
  /*#define O_DEBUG 1*/
  #ifdef __WINDOWS__
  #include <winsock2.h>
  #include <windows.h>
  #include <process.h>			/* getpid() */
  #endif
  #include "pl-incl.h"
  #include "pl-arith.h"
  #include "pl-tabling.h"
  #include "pl-ctype.h"
  #include <ctype.h>
  #ifdef HAVE_SYS_TIME_H
  #include <sys/time.h>
  #endif
  #include <time.h>
  
  
  		 /*******************************
  		 *	PROLOG FLAG HANDLING	*
  		 *******************************/
  
  /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  ISO Prolog flags are properties of the   running  Prolog system. Some of
  these flags can be set  by  the   user,  such  as whether read/1 honours
  character-escapes, whether garbage-collection is enabled,  etc. Some are
  global and read-only, such as whether the operating system is unix.
  
  In  the  multi-threading  version,  Prolog  flags  have  to  be  changed
  thread-local. Therefore two flag-tables have been  defined: a global one
  which is used as long as there is only  one thread, and a local one that
  is used to write changes to  after   multiple  threads  exist. On thread
  creation this table is copied from  the   parent  and on destruction the
  local table is destroyed.  Note  that   the  flag-mask  for  fast access
  (truePrologFlag(*PLFLAG_)) is always copied to the local thread-data.
  
  Altogether  this  module  is  a  bit  too  complex,  but  I  see  little
  alternative. I considered creating  copy-on-write   hash-tables,  but in
  combination to the table-enumator  objects  this   proves  very  hard to
  implement safely. Using plain Prolog is not  a good option too: they are
  used before we can  use  any  Prolog   at  startup,  predicates  are not
  thread-local and some of the prolog flags  require very fast access from
  C (the booleans in the mask).
  
  Just using a local table and  copy   it  on  thread-creation would be an
  option, but 90% of the prolog flags   are read-only or never changed and
  we want to be able to have a lot of flags and don't harm thread_create/3
  too much.
  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  
  static void setArgvPrologFlag(const char *flag, int argc, char **argv);
  static void setTmpDirPrologFlag(void);
  static void setTZPrologFlag(void);
  static void setVersionPrologFlag(void);
  static void initPrologFlagTable(void);
  
  
  typedef struct _prolog_flag
  { short		flags;			/* Type | Flags */
    short		index;			/* index in PLFLAG_ mask */
    union
    { atom_t	a;			/* value as atom */
      int64_t	i;			/* value as integer */
      double	f;			/* value as float */
      record_t	t;			/* value as term */
    } value;
  } prolog_flag;
  
  
  /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  C-interface for defining Prolog  flags.  Depending   on  the  type,  the
  following arguments are to be provided:
  
      FT_BOOL	TRUE/FALSE, *PLFLAG_
      FT_INTEGER  intptr_t
      FT_INT64    int64_t
      FT_FLOAT	double
      FT_ATOM	const char *
      FT_TERM	a term
  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  
  static int
  indexOfBoolMask(unsigned int mask)
  { int i=1;
  
    if ( !mask )
      return -1;
  
    while(!(mask & 0x1))
    { i++;
      mask >>= 1;
    }
    return i;
  }
  
  
  void
  setPrologFlag(const char *name, int flags, ...)
  { GET_LD
    atom_t an = PL_new_atom(name);
    prolog_flag *f;
    va_list args;
    int type = (flags & FT_MASK);
    int first_def = FALSE;
  
    initPrologFlagTable();
  
    if ( type == FT_INT64 )
      flags = (flags & ~FT_MASK)|FT_INTEGER;
  
    if ( (f = lookupHTable(GD->prolog_flag.table, (void *)an)) )
    { assert((f->flags & FT_MASK) == (flags & FT_MASK));
      if ( flags & FF_KEEP )
        return;
    } else
    { f = allocHeapOrHalt(sizeof(*f));
      f->index = -1;
      f->flags = flags;
      addNewHTable(GD->prolog_flag.table, (void *)an, f);
      first_def = TRUE;
    }
  
    va_start(args, flags);
    switch(type)
    { case FT_BOOL:
      { int           val = va_arg(args, int);
        unsigned int mask = va_arg(args, unsigned int);
  
        if ( !first_def && mask && f->index < 0 )	/* type definition */
        { f->index = indexOfBoolMask(mask);
  	val = (f->value.a == ATOM_true);
        } else if ( first_def )			/* 1st definition */
        { f->index = indexOfBoolMask(mask);
  	DEBUG(MSG_PROLOG_FLAG,
  	      Sdprintf("Prolog flag %s at 0x%08lx\n", name, mask));
        }
  
        f->value.a = (val ? ATOM_true : ATOM_false);
        if ( f->index >= 0 )
        { mask = (unsigned int)1 << (f->index-1);
  
  	if ( val )
  	  setPrologFlagMask(mask);
  	else
  	  clearPrologFlagMask(mask);
        }
        break;
      }
      case FT_INTEGER:
      { intptr_t val = va_arg(args, intptr_t);
        f->value.i = val;
        break;
      }
      case FT_FLOAT:
      { double val = va_arg(args, double);
        f->value.f = val;
        break;
      }
      case FT_INT64:
      { int64_t val = va_arg(args, int64_t);
        f->value.i = val;
        break;
      }
      case FT_ATOM:
      { PL_chars_t text;
  
        text.text.t    = va_arg(args, char *);
        text.encoding  = ENC_UTF8;
        text.storage   = PL_CHARS_HEAP;
        text.length    = strlen(text.text.t);
        text.canonical = FALSE;
  
        f->value.a = textToAtom(&text);	/* registered: ok */
        PL_free_text(&text);
  
        break;
      }
      case FT_TERM:
      { term_t t = va_arg(args, term_t);
  
        f->value.t = PL_record(t);
        break;
      }
      default:
        assert(0);
    }
    va_end(args);
  }
  
  
  static void
  freePrologFlag(prolog_flag *f)
  { switch((f->flags & FT_MASK))
    { case FT_TERM:
        PL_erase(f->value.t);
        break;
      case FT_ATOM:
        PL_unregister_atom(f->value.a);
        break;
      default:
        ;
    }
  
    freeHeap(f, sizeof(*f));
  }
  
  
  #ifdef O_PLMT
  static prolog_flag *
  copy_prolog_flag(const prolog_flag *f)
  { prolog_flag *copy = allocHeapOrHalt(sizeof(*copy));
  
    *copy = *f;
    switch((f->flags & FT_MASK))
    { case FT_TERM:
        copy->value.t = PL_duplicate_record(f->value.t);
        break;
      case FT_ATOM:
        PL_register_atom(copy->value.a);
        break;
      default:
        ;
    }
  
    return copy;
  }
  
  
  static void
  copySymbolPrologFlagTable(void *name, void **value)
  { atom_t key = (atom_t)name;
    prolog_flag *f = *value;
  
    PL_register_atom(key);
    *value = copy_prolog_flag(f);
  }
  
  
  static void
  freeSymbolPrologFlagTable(void *name, void *value)
  { atom_t key = (atom_t)name;
  
    PL_unregister_atom(key);
    freePrologFlag(value);
  }
  #endif
  
  
  int
  setDoubleQuotes(atom_t a, unsigned int *flagp)
  { GET_LD
    unsigned int flags;
  
    if ( a == ATOM_chars )
      flags = DBLQ_CHARS;
    else if ( a == ATOM_codes )
      flags = 0;
    else if ( a == ATOM_atom )
      flags = DBLQ_ATOM;
    else if ( a == ATOM_string )
      flags = DBLQ_STRING;
    else
    { term_t value = PL_new_term_ref();
  
      PL_put_atom(value, a);
      return PL_error(NULL, 0, NULL, ERR_DOMAIN,
  		    ATOM_double_quotes, value);
    }
  
    *flagp &= ~DBLQ_MASK;
    *flagp |= flags;
  
    succeed;
  }
  
  
  int
  setBackQuotes(atom_t a, unsigned int *flagp)
  { GET_LD
    unsigned int flags;
  
    if ( a == ATOM_string )
      flags = BQ_STRING;
    else if ( a == ATOM_symbol_char )
      flags = 0;
    else if ( a == ATOM_codes )
      flags = BQ_CODES;
    else if ( a == ATOM_chars )
      flags = BQ_CHARS;
    else
    { term_t value = PL_new_term_ref();
  
      PL_put_atom(value, a);
      return PL_error(NULL, 0, NULL, ERR_DOMAIN,
  		    ATOM_back_quotes, value);
    }
  
    *flagp &= ~BQ_MASK;
    *flagp |= flags;
  
    succeed;
  }
  
  
  int
  setRationalSyntax(atom_t a, unsigned int *flagp)
  { GET_LD
    unsigned int flags;
  
    if	  ( a == ATOM_natural )
      flags = RAT_NATURAL;
    else if ( a == ATOM_compatibility )
      flags = RAT_COMPAT;
    else
    { term_t value = PL_new_term_ref();
  
      PL_put_atom(value, a);
      return PL_error(NULL, 0, NULL, ERR_DOMAIN,
  		    ATOM_rational_syntax, value);
    }
  
    *flagp &= ~RAT_MASK;
    *flagp |= flags;
  
    succeed;
  }
  
  
  
  static int
  setUnknown(term_t value, atom_t a, Module m)
  { unsigned int flags = m->flags & ~(UNKNOWN_MASK);
  
    if ( a == ATOM_error )
      flags |= UNKNOWN_ERROR;
    else if ( a == ATOM_warning )
      flags |= UNKNOWN_WARNING;
    else if ( a == ATOM_fail )
      flags |= UNKNOWN_FAIL;
    else
      return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_unknown, value);
  
    if ( !(flags&UNKNOWN_ERROR) && (m == MODULE_user || m == MODULE_system) )
    { GET_LD
  
      if ( m == MODULE_system && !SYSTEM_MODE )
      { term_t key = PL_new_term_ref();
  
        PL_put_atom(key, ATOM_unknown);
        return PL_error(NULL, 0, NULL, ERR_PERMISSION,
  		      ATOM_modify, ATOM_flag, key);
      }
  
      if ( !SYSTEM_MODE )
      { if ( !printMessage(ATOM_warning, PL_CHARS, "unknown_in_module_user") )
  	return FALSE;
      }
    }
  
    m->flags = flags;
  
    return TRUE;
  }
  
  
  static int
  setFileNameCaseHandling(atom_t a)
  { GET_LD
  
    if ( a == ATOM_case_sensitive )
    { setPrologFlagMask(PLFLAG_FILE_CASE|PLFLAG_FILE_CASE_PRESERVING);
    } else if ( a == ATOM_case_preserving )
    { setPrologFlagMask(PLFLAG_FILE_CASE_PRESERVING);
      clearPrologFlagMask(PLFLAG_FILE_CASE);
    } else if ( a == ATOM_case_insensitive )
    { clearPrologFlagMask(PLFLAG_FILE_CASE|PLFLAG_FILE_CASE_PRESERVING);
    } else
    { term_t value = PL_new_term_ref();
  
      PL_put_atom(value, a);
      return PL_error(NULL, 0, NULL, ERR_DOMAIN,
  		    ATOM_file_name_case_handling, value);
    }
  
    return TRUE;
  }
  
  
  static atom_t
  currentFileNameCaseHandling(void)
  { GET_LD
  
    switch ( LD->prolog_flag.mask.flags &
  	   (PLFLAG_FILE_CASE|PLFLAG_FILE_CASE_PRESERVING) )
    { case 0:
        return ATOM_case_insensitive;
      case PLFLAG_FILE_CASE_PRESERVING:
        return ATOM_case_preserving;
      case PLFLAG_FILE_CASE|PLFLAG_FILE_CASE_PRESERVING:
        return ATOM_case_sensitive;
      default:
        return ATOM_unknown;
    }
  }
  
  
  static int
  setWriteAttributes(atom_t a)
  { GET_LD
    int mask = writeAttributeMask(a);
  
    if ( mask )
    { LD->prolog_flag.write_attributes = mask;
      succeed;
    } else
    { term_t value = PL_new_term_ref();
  
      PL_put_atom(value, a);
      return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_write_attributes, value);
    }
  }
  
  
  static int
  setAccessLevelFromAtom(atom_t a)
  { GET_LD
  
    if ( getAccessLevelMask(a, &LD->prolog_flag.access_level) )
    { succeed;
    } else
    { term_t value = PL_new_term_ref();
  
      PL_put_atom(value, a);
      return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_access_level, value);
    }
  }
  
  
  static int
  getOccursCheckMask(atom_t a, occurs_check_t *val)
  { if ( a == ATOM_false )
    { *val = OCCURS_CHECK_FALSE;
    } else if ( a == ATOM_true )
    { *val = OCCURS_CHECK_TRUE;
    } else if ( a == ATOM_error )
    { *val = OCCURS_CHECK_ERROR;
    } else
      fail;
  
    succeed;
  }
  
  
  static int
  setOccursCheck(atom_t a)
  { GET_LD
  
    if ( getOccursCheckMask(a, &LD->prolog_flag.occurs_check) )
    { updateAlerted(LD);
      succeed;
    } else
    { term_t value = PL_new_term_ref();
  
      PL_put_atom(value, a);
      return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_occurs_check, value);
    }
  }
  
  
  static int
  setEncoding(atom_t a)
  { GET_LD
    IOENC enc = atom_to_encoding(a);
  
    if ( enc == ENC_UNKNOWN )
    { term_t value = PL_new_term_ref();
  
      PL_put_atom(value, a);
      return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_encoding, value);
    }
  
    LD->encoding = enc;
  
    succeed;
  }
  
  
  static int
  setStreamTypeCheck(atom_t a)
  { GET_LD
    st_check check;
  
    if ( a == ATOM_false )
      check = ST_FALSE;
    else if ( a == ATOM_loose )
      check = ST_LOOSE;
    else if ( a == ATOM_true )
      check = ST_TRUE;
    else
    { term_t value = PL_new_term_ref();
  
      PL_put_atom(value, a);
      return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_stream_type_check, value);
    }
  
    LD->IO.stream_type_check = check;
    return TRUE;
  }
  
  
  static int
  setAutoload(atom_t a)
  { GET_LD
  
    if ( a == ATOM_false )
      clearPrologFlagMask(PLFLAG_AUTOLOAD);
    else if ( a == ATOM_explicit ||
  	    a == ATOM_true ||
  	    a == ATOM_user ||
  	    a == ATOM_user_or_explicit )
      setPrologFlagMask(PLFLAG_AUTOLOAD);
    else
    { term_t value = PL_new_term_ref();
  
      PL_put_atom(value, a);
      return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_autoload, value);
    }
  
    return TRUE;
  }
  
  
  static int
  propagateAutoload(term_t val ARG_LD)
  { if ( !GD->bootsession )
    { predicate_t pred;
      term_t av;
  
      pred = PL_predicate("set_autoload", 1, "$autoload");
      return ( (av=PL_new_term_refs(2)) &&
  	     PL_put_term(av+0, val) &&
  	     PL_call_predicate(NULL, PL_Q_PASS_EXCEPTION, pred, av) );
    } else
    { return TRUE;
    }
  }
  
  
  #if O_XOS
  typedef struct access_id
  { char *name;
    int   value;
  } access_id;
  
  static const access_id access_id_list[] =
  { { "access",          XOS_ACCESS_ACCESS },
    { "getfilesecurity", XOS_ACCESS_GETFILESECURITY },
    { "openclose",       XOS_ACCESS_OPENCLOSE },
    { NULL,              -1 }
  };
  
  
  static int
  set_win_file_access_check(term_t a)
  { char *s;
    const access_id *p;
  
    if ( PL_get_chars(a, &s, CVT_ATOM) )
    { for(p=access_id_list; p->name; p++)
      { if ( strcmp(s, p->name) == 0 )
        { _xos_set_win_file_access_check(p->value);
  	return TRUE;
        }
      }
    }
  
    return PL_domain_error("win_file_access_check", a);
  }
  
  static char*
  get_win_file_access_check(void)
  { const access_id *p;
    int id = _xos_get_win_file_access_check();
  
    for(p=access_id_list; p->name; p++)
    { if ( p->value == id )
        return p->name;
    }
    return "unknown";
  }
  #endif
  
  static word
  set_prolog_flag_unlocked(Module m, atom_t k, term_t value, int flags ARG_LD)
  { prolog_flag *f;
    int rval = TRUE;
  
  					/* set existing Prolog flag */
  #ifdef O_PLMT
    if ( LD->prolog_flag.table &&
         (f = lookupHTable(LD->prolog_flag.table, (void *)k)) )
    { if ( flags & FF_KEEP )
        return TRUE;
    } else
  #endif
    if ( (f = lookupHTable(GD->prolog_flag.table, (void *)k)) )
    { if ( flags & FF_KEEP )
        return TRUE;
      if ( (f->flags&FF_READONLY) && !(flags&FF_FORCE) )
      { term_t key;
  
        return ( (key = PL_new_term_ref()) &&
  	       PL_put_atom(key, k) &&
  	       PL_error(NULL, 0, NULL, ERR_PERMISSION,
  			ATOM_modify, ATOM_flag, key) );
      }
  
      if ( tbl_is_restraint_flag(k) )
        return tbl_set_restraint_flag(value, k PASS_LD);
      if ( is_arith_flag(k) )
        return set_arith_flag(value, k PASS_LD);
  
  #ifdef O_PLMT
      if ( GD->statistics.threads_created > 1 )
      { f = copy_prolog_flag(f);
  
        if ( !LD->prolog_flag.table )
        { LD->prolog_flag.table = newHTable(4);
  
  	LD->prolog_flag.table->copy_symbol = copySymbolPrologFlagTable;
  	LD->prolog_flag.table->free_symbol = freeSymbolPrologFlagTable;
        }
  
        addNewHTable(LD->prolog_flag.table, (void *)k, f);
        PL_register_atom(k);
        DEBUG(MSG_PROLOG_FLAG,
  	    Sdprintf("Localised Prolog flag %s\n", PL_atom_chars(k)));
      }
  #endif
    } else if ( !(flags & FF_NOCREATE) )	/* define new Prolog flag */
    { prolog_flag *f;
      atom_t a;
      int64_t i;
      double d;
  
    anyway:
      PL_register_atom(k);
      f = allocHeapOrHalt(sizeof(*f));
      f->index = -1;
  
      switch( (flags & FT_MASK) )
      { case FT_FROM_VALUE:
        { if ( PL_get_atom(value, &a) )
  	{ if ( a == ATOM_true || a == ATOM_false ||
  	       a == ATOM_on || a == ATOM_off )
  	    f->flags = FT_BOOL;
  	  else
  	    f->flags = FT_ATOM;
  	  f->value.a = a;
  	  PL_register_atom(a);
  	} else if ( PL_get_int64(value, &i) )
  	{ f->flags = FT_INTEGER;
  	  f->value.i = i;
  	} else if ( PL_get_float(value, &d) )
  	{ f->flags = FT_FLOAT;
  	  f->value.f = d;
  	} else
  	{ f->flags = FT_TERM;
  	  if ( !PL_is_ground(value) )
  	  { PL_error(NULL, 0, NULL, ERR_INSTANTIATION);
  	    goto wrong_type;
  	  }
  	  if ( !(f->value.t = PL_record(value)) )
  	  { freeHeap(f, sizeof(*f));
  	    return FALSE;
  	  }
  	}
  	break;
        }
        case FT_ATOM:
  	if ( !PL_get_atom_ex(value, &f->value.a) )
  	{ wrong_type:
  	  freeHeap(f, sizeof(*f));
  	  return FALSE;
  	}
          f->flags = FT_ATOM;
          PL_register_atom(f->value.a);
  	break;
        case FT_BOOL:
        { int b;
  	if ( !PL_get_bool_ex(value, &b) )
  	  goto wrong_type;
          f->flags = FT_BOOL;
  	f->value.a = (b ? ATOM_true : ATOM_false);
  	break;
        }
        case FT_INTEGER:
  	if ( !PL_get_int64_ex(value, &f->value.i) )
  	  goto wrong_type;
          f->flags = FT_INTEGER;
  	break;
        case FT_FLOAT:
  	if ( !PL_get_float_ex(value, &f->value.f) )
  	  goto wrong_type;
          f->flags = FT_FLOAT;
  	break;
        case FT_TERM:
  	if ( !PL_is_ground(value) )
  	{ PL_error(NULL, 0, NULL, ERR_INSTANTIATION);
  	  goto wrong_type;
  	}
          if ( !(f->value.t = PL_record(value)) )
  	  goto wrong_type;
          f->flags = FT_TERM;
  	break;
      }
  
      if ( (flags & FF_READONLY) )
        f->flags |= FF_READONLY;
  
      addNewHTable(GD->prolog_flag.table, (void *)k, f);
      if ( !(lookupHTable(GD->prolog_flag.table, (void *)k) == f) )
      { freePrologFlag(f);
        Sdprintf("OOPS; failed to set Prolog flag!?\n");
      }
  
      succeed;
    } else
    { atom_t how;
  
      if ( PL_current_prolog_flag(ATOM_user_flags, PL_ATOM, &how) )
      { if ( how == ATOM_error )
        { term_t key;
  
  	return ( (key = PL_new_term_ref()) &&
  		 PL_put_atom(key, k) &&
  		 PL_error(NULL, 0, NULL, ERR_EXISTENCE,
  			  ATOM_prolog_flag, key) );
        } else if ( how == ATOM_warning )
  	Sdprintf("WARNING: Flag %s: new Prolog flags must be created using "
  		 "create_prolog_flag/3\n", stringAtom(k));
      }
  
      goto anyway;
    }
  
    switch(f->flags & FT_MASK)
    { case FT_BOOL:
      { int val;
  
        if ( !PL_get_bool_ex(value, &val) )
  	return FALSE;
  
  					/* deal with side-effects */
        if ( k == ATOM_character_escapes )
        { if ( val )
  	  set(m, M_CHARESCAPE);
  	else
  	  clear(m, M_CHARESCAPE);
        } else if ( k == ATOM_var_prefix )
        { if ( val )
  	  set(m, M_VARPREFIX);
  	else
  	  clear(m, M_VARPREFIX);
        } else if ( k == ATOM_debug )
        { if ( val )
  	{ rval = debugmode(DBG_ALL, NULL);
  	} else
  	{ rval = ( tracemode(FALSE, NULL) &&
  		   debugmode(DBG_OFF, NULL) );
  	}
        } else if ( k == ATOM_debugger_show_context )
        { debugstatus.showContext = val;
  #ifdef O_PLMT
        } else if ( k == ATOM_threads )
        { if ( val )
  	{ rval = enableThreads(val);
  	  PL_LOCK(L_PLFLAG);
  	} else
  	{ PL_UNLOCK(L_PLFLAG);
  	  rval = enableThreads(val);
  	}
  	if ( !rval )
  	  break;			/* don't change value */
  #endif
        } else if ( k == ATOM_tty_control )
        { if ( val != (f->value.a == ATOM_true) )
  	{ if ( !val && ttymodified )
  	  { PopTty(Sinput, &ttytab, FALSE);
  	  } else if ( val )
  	  { setPrologFlagMask(PLFLAG_TTY_CONTROL);
  	    PushTty(Sinput, &ttytab, TTY_SAVE);
  	  }
  	}
        } else if ( k == ATOM_debug_on_interrupt )
        {	rval = enable_debug_on_interrupt(val);
        } else if ( k == ATOM_protect_static_code )
        { if ( val != (f->value.a == ATOM_true) && val == FALSE )
  	{ term_t ex;
  
  	  if ( (ex = PL_new_term_ref()) &&
  	       PL_put_atom(ex, ATOM_protect_static_code) )
  	    return PL_permission_error("set", "prolog_flag", ex);
  	  return FALSE;
  	}
        }
  					/* set the flag value */
        if ( f->index > 0 && rval )
        { unsigned int mask = (unsigned int)1 << (f->index-1);
  
  	if ( val )
  	  setPrologFlagMask(mask);
  	else
  	  clearPrologFlagMask(mask);
        }
        f->value.a = (val ? ATOM_true : ATOM_false);
  
        break;
      }
      case FT_ATOM:
      { atom_t a;
  
        if ( !PL_get_atom_ex(value, &a) )
  	return FALSE;
  
        if ( k == ATOM_double_quotes )
        { rval = setDoubleQuotes(a, &m->flags);
        } else if ( k == ATOM_back_quotes )
        { rval = setBackQuotes(a, &m->flags);
        } else if ( k == ATOM_rational_syntax )
        { rval = setRationalSyntax(a, &m->flags);
        } else if ( k == ATOM_unknown )
        { rval = setUnknown(value, a, m);
        } else if ( k == ATOM_write_attributes )
        { rval = setWriteAttributes(a);
        } else if ( k == ATOM_occurs_check )
        { rval = setOccursCheck(a);
        } else if ( k == ATOM_access_level )
        { rval = setAccessLevelFromAtom(a);
        } else if ( k == ATOM_encoding )
        { rval = setEncoding(a);
        } else if ( k == ATOM_stream_type_check )
        { rval = setStreamTypeCheck(a);
        } else if ( k == ATOM_file_name_case_handling )
        { rval = setFileNameCaseHandling(a);
        } else if ( k == ATOM_autoload )
        { rval = setAutoload(a);
        } else if ( k == ATOM_table_monotonic )
        { rval = setMonotonicMode(a);
  #if O_XOS
        } else if ( k == ATOM_win_file_access_check )
        { rval = set_win_file_access_check(value);
  #endif
        }
        if ( !rval )
  	fail;
  
        if ( f->value.a != a )
        { PL_unregister_atom(f->value.a);
  	f->value.a = a;
  	PL_register_atom(a);
        }
        break;
      }
      case FT_INTEGER:
      { int64_t i;
  
        if ( !PL_get_int64_ex(value, &i) )
  	return FALSE;
        f->value.i = i;
  
  #ifdef O_ATOMGC
        if ( k == ATOM_agc_margin )
  	GD->atoms.margin = (size_t)i;
        else
  #endif
        if ( k == ATOM_table_space )
        { if ( !LD->tabling.node_pool )
  	  LD->tabling.node_pool = new_alloc_pool("private_table_space", i);
  	else
  	  LD->tabling.node_pool->limit = (size_t)i;
        }
  #ifdef O_PLMT
        else if ( k == ATOM_shared_table_space )
        { if ( !GD->tabling.node_pool )
  	{ alloc_pool *pool = new_alloc_pool("shared_table_space", i);
  	  if ( pool && !COMPARE_AND_SWAP_PTR(&GD->tabling.node_pool, NULL, pool) )
  	    free_alloc_pool(pool);
  	} else
  	  GD->tabling.node_pool->limit = (size_t)i;
        }
  #endif
        else if ( k == ATOM_stack_limit )
        { if ( !set_stack_limit((size_t)i) )
  	  return FALSE;
        } else if ( k == ATOM_string_stack_tripwire )
        { LD->fli.string_buffers.tripwire = (unsigned int)i;
        }
        break;
      }
      case FT_FLOAT:
      { double d;
  
        if ( !PL_get_float_ex(value, &d) )
  	return FALSE;
        f->value.f = d;
        break;
      }
      case FT_TERM:
      { if ( f->value.t )
  	PL_erase(f->value.t);
        f->value.t = PL_record(value);
        break;
      }
      default:
        assert(0);
    }
  
    return rval;
  }
  
  
  int
  set_prolog_flag(term_t key, term_t value, int flags)
  { GET_LD
    atom_t k;
    Module m = MODULE_parse;
    int rc;
  
    if ( !PL_strip_module(key, &m, key) ||
         !PL_get_atom_ex(key, &k) )
      return FALSE;
  
    if ( k == ATOM_autoload && !propagateAutoload(value PASS_LD) )
      return FALSE;
  
    PL_LOCK(L_PLFLAG);
    rc = set_prolog_flag_unlocked(m, k, value, flags PASS_LD);
    PL_UNLOCK(L_PLFLAG);
  
    return rc;
  }
  
  /** set_prolog_flag(+Key, +Value) is det.
  */
  
  static
  PRED_IMPL("set_prolog_flag", 2, set_prolog_flag, PL_FA_ISO)
  { return set_prolog_flag(A1, A2, FF_NOCREATE|FT_FROM_VALUE);
  }
  
  
  /** create_prolog_flag(+Key, +Value, +Options) is det.
  */
  
  static const opt_spec prolog_flag_options[] =
  { { ATOM_type,   OPT_ATOM },
    { ATOM_access, OPT_ATOM },
    { ATOM_keep,   OPT_BOOL },
    { NULL_ATOM,   0 }
  };
  
  static
  PRED_IMPL("create_prolog_flag", 3, create_prolog_flag, PL_FA_ISO)
  { PRED_LD
    int flags = 0;
    atom_t type = 0;
    atom_t access = ATOM_read_write;
    int keep = FALSE;
  
    if ( !scan_options(A3, 0, ATOM_prolog_flag_option, prolog_flag_options,
  		     &type, &access, &keep) )
      return FALSE;
  
    if ( type == 0 )
      flags |= FT_FROM_VALUE;
    else if ( type == ATOM_boolean )
      flags |= FT_BOOL;
    else if ( type == ATOM_integer )
      flags |= FT_INTEGER;
    else if ( type == ATOM_float )
      flags |= FT_FLOAT;
    else if ( type == ATOM_atom )
      flags |= FT_ATOM;
    else if ( type == ATOM_term )
      flags |= FT_TERM;
    else
    { term_t a = PL_new_term_ref();
      PL_put_atom(a, type);
  
      return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_prolog_flag_type, a);
    }
  
    if ( access == ATOM_read_only )
      flags |= FF_READONLY;
    else if ( access != ATOM_read_write )
    { term_t a = PL_new_term_ref();
      PL_put_atom(a, access);
      return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_prolog_flag_access, a);
    }
  
    if ( keep )
      flags |= FF_KEEP;
  
    return set_prolog_flag(A1, A2, flags);
  }
  
  
  static prolog_flag *
  lookupFlag(atom_t key)
  { GET_LD
  #ifdef O_PLMT
    prolog_flag *f = NULL;
  
    if ( LD->prolog_flag.table &&
         (f = lookupHTable(LD->prolog_flag.table, (void *)key)) )
    { return f;
    } else
  #endif
    { return lookupHTable(GD->prolog_flag.table, (void *)key);
    }
  }
  
  
  int
  PL_current_prolog_flag(atom_t name, int type, void *value)
  { prolog_flag *f;
  
    if ( (f=lookupFlag(name)) )
    { switch(type)
      { case PL_ATOM:
  	if ( (f->flags&FT_MASK) == FT_ATOM )
  	{ atom_t *vp = value;
  	  *vp = f->value.a;
  	  return TRUE;
  	}
          return FALSE;
        case PL_INTEGER:
  	if ( (f->flags&FT_MASK) == FT_INTEGER )
  	{ int64_t *vp = value;
  	  *vp = f->value.i;
  	  return TRUE;
  	}
          return FALSE;
        case PL_FLOAT:
  	if ( (f->flags&FT_MASK) == FT_FLOAT )
  	{ double *vp = value;
  	  *vp = f->value.f;
  	  return TRUE;
  	}
          return FALSE;
        case PL_TERM:
  	if ( (f->flags&FT_MASK) == FT_TERM )
  	{ term_t *vp = value;
  	  term_t t = *vp;
  
  	  return PL_recorded(f->value.t, t);
  	}
          return FALSE;
      }
    }
  
    return FALSE;
  }
  
  
  
  static int
  unify_prolog_flag_value(Module m, atom_t key, prolog_flag *f, term_t val)
  { GET_LD
  
    if ( key == ATOM_character_escapes )
    { return PL_unify_bool(val, true(m, M_CHARESCAPE));
    } else if ( key == ATOM_var_prefix )
    { return PL_unify_bool(val, true(m, M_VARPREFIX));
    } else if ( key == ATOM_double_quotes )
    { atom_t v;
  
      if ( true(m, DBLQ_CHARS) )
        v = ATOM_chars;
      else if ( true(m, DBLQ_ATOM) )
        v = ATOM_atom;
      else if ( true(m, DBLQ_STRING) )
        v = ATOM_string;
      else
        v = ATOM_codes;
  
      return PL_unify_atom(val, v);
    } else if ( key == ATOM_back_quotes )
    { atom_t v;
  
      if ( true(m, BQ_STRING) )
        v = ATOM_string;
      else if ( true(m, BQ_CODES) )
        v = ATOM_codes;
      else if ( true(m, BQ_CHARS) )
        v = ATOM_chars;
      else
        v = ATOM_symbol_char;
  
      return PL_unify_atom(val, v);
    } else if ( key == ATOM_rational_syntax )
    { atom_t v;
  
      switch(m->flags&RAT_MASK)
      { case RAT_NATURAL: v = ATOM_natural;       break;
        case RAT_COMPAT:  v = ATOM_compatibility; break;
        default:		v = 0; assert(0);
      }
  
      return PL_unify_atom(val, v);
    } else if ( key == ATOM_unknown )
    { atom_t v;
  
      switch ( getUnknownModule(m) )
      { case UNKNOWN_ERROR:
  	v = ATOM_error;
          break;
        case UNKNOWN_WARNING:
  	v = ATOM_warning;
          break;
        case UNKNOWN_FAIL:
  	v = ATOM_fail;
          break;
        default:
  	assert(0);
          return FALSE;
      }
  
      return PL_unify_atom(val, v);
  #ifdef O_PLMT
    } else if ( key == ATOM_system_thread_id )
    { return PL_unify_integer(val, system_thread_id(NULL));
  #endif
    } else if ( key == ATOM_debug )
    { return PL_unify_bool_ex(val, debugstatus.debugging);
    } else if ( key == ATOM_debugger_show_context )
    { return PL_unify_bool_ex(val, debugstatus.showContext);
    } else if ( key == ATOM_break_level )
    { int bl = currentBreakLevel();
  
      if ( bl >= 0 )
        return PL_unify_integer(val, bl);
      return FALSE;
    } else if ( key == ATOM_access_level )
    { return PL_unify_atom(val, accessLevel());
    } else if ( key == ATOM_stack_limit )
    { return PL_unify_int64(val, LD->stacks.limit);
    } else if ( tbl_is_restraint_flag(key) )
    { return tbl_get_restraint_flag(val, key PASS_LD) == TRUE;
    } else if ( is_arith_flag(key) )
    { return get_arith_flag(val, key PASS_LD) == TRUE;
    }
  
    switch(f->flags & FT_MASK)
    { case FT_BOOL:
        if ( f->index >= 0 )
        { unsigned int mask = (unsigned int)1 << (f->index-1);
  
  	return PL_unify_bool_ex(val, truePrologFlag(mask) != FALSE);
        }
        /*FALLTHROUGH*/
      case FT_ATOM:
        return PL_unify_atom(val, f->value.a);
      case FT_INTEGER:
        return PL_unify_int64(val, f->value.i);
      case FT_FLOAT:
        return PL_unify_float(val, f->value.f);
      case FT_TERM:
      { term_t tmp = PL_new_term_ref();
  
        if ( PL_recorded(f->value.t, tmp) )
  	return PL_unify(val, tmp);
        else
  	return raiseStackOverflow(GLOBAL_OVERFLOW);
      }
      default:
        assert(0);
        fail;
    }
  }
  
  
  static int
  unify_prolog_flag_access(prolog_flag *f, term_t access)
  { GET_LD
  
    if ( f->flags & FF_READONLY )
      return PL_unify_atom(access, ATOM_read);
    else
      return PL_unify_atom(access, ATOM_write);
  }
  
  
  static int
  unify_prolog_flag_type(prolog_flag *f, term_t type)
  { GET_LD
    atom_t a;
  
    switch(f->flags & FT_MASK)
    { case FT_BOOL:
        a = ATOM_boolean;
        break;
      case FT_ATOM:
        a = ATOM_atom;
        break;
      case FT_INTEGER:
        a = ATOM_integer;
        break;
      case FT_FLOAT:
        a = ATOM_float;
        break;
      case FT_TERM:
        a = ATOM_term;
        break;
      default:
        assert(0);
        fail;
    }
  
    return PL_unify_atom(type, a);
  }
  
  
  typedef struct
  { TableEnum table_enum;
    atom_t scope;
    int explicit_scope;
    Module module;
  } prolog_flag_enum;
  
  word
  pl_prolog_flag5(term_t key, term_t value,
  	    word scope, word access, word type,
  	    control_t h)
  { GET_LD
    prolog_flag_enum *e;
    fid_t fid;
    Module module;
  
    switch( ForeignControl(h) )
    { case FRG_FIRST_CALL:
      { atom_t k;
  
        module = MODULE_parse;
        if ( !PL_strip_module(key, &module, key) )
  	return FALSE;
  
        if ( PL_get_atom(key, &k) )
        { prolog_flag *f;
  
  #ifdef O_PLMT
  	if ( LD->prolog_flag.table &&
  	     (f = lookupHTable(LD->prolog_flag.table, (void *)k)) )
  	  return unify_prolog_flag_value(module, k, f, value);
  #endif
  	if ( (f = lookupHTable(GD->prolog_flag.table, (void *)k)) )
  	{ if ( unify_prolog_flag_value(module, k, f, value) &&
  	       (!access || unify_prolog_flag_access(f, access)) &&
  	       (!type   || unify_prolog_flag_type(f, type)) )
  	    succeed;
  	}
  
  	fail;
        } else if ( PL_is_variable(key) )
        { e = allocHeapOrHalt(sizeof(*e));
  
  	e->module = module;
  
  	if ( scope && PL_get_atom(scope, &e->scope) )
  	{ e->explicit_scope = TRUE;
  	  if ( !(e->scope == ATOM_local || e->scope == ATOM_global) )
  	  { freeHeap(e, sizeof(*e));
  	    return PL_error(NULL, 0, NULL, ERR_DOMAIN,
  			    PL_new_atom("scope"), scope);
  	  }
  	} else
  	{ e->explicit_scope = FALSE;
  
  	  if ( LD->prolog_flag.table )
  	    e->scope = ATOM_local;
  	  else
  	    e->scope = ATOM_global;
  	}
  
  	if ( e->scope == ATOM_local )
  	  e->table_enum = newTableEnum(LD->prolog_flag.table);
  	else
  	  e->table_enum = newTableEnum(GD->prolog_flag.table);
  
  	break;
        } else
  	return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_atom, key);
      }
      case FRG_REDO:
        e = ForeignContextPtr(h);
        break;
      case FRG_CUTTED:
        e = ForeignContextPtr(h);
        if ( e )
        { freeTableEnum(e->table_enum);
  	freeHeap(e, sizeof(*e));
        }
      default:
        succeed;
    }
  
    fid = PL_open_foreign_frame();
    PL_LOCK(L_PLFLAG);
    for(;;)
    { atom_t fn;
      prolog_flag *f;
      while( advanceTableEnum(e->table_enum, (void**)&fn, (void**)&f) )
      { if ( e->explicit_scope == FALSE &&
  	   e->scope == ATOM_global &&
  	   LD->prolog_flag.table &&
  	   lookupHTable(LD->prolog_flag.table, (void *)fn) )
  	continue;
  
        if ( PL_unify_atom(key, fn) &&
  	   unify_prolog_flag_value(e->module, fn, f, value) &&
  	   (!scope  || PL_unify_atom(scope, e->scope)) &&
  	   (!access || unify_prolog_flag_access(f, access)) &&
  	   (!type   || unify_prolog_flag_type(f, type)) )
        { PL_UNLOCK(L_PLFLAG);
  	ForeignRedoPtr(e);
        }
        if ( exception_term )
        { exception_term = 0;
  	setVar(*valTermRef(exception_bin));
        }
        PL_rewind_foreign_frame(fid);
      }
  
      if ( e->scope == ATOM_local )
      { e->scope = ATOM_global;
        freeTableEnum(e->table_enum);
        e->table_enum = newTableEnum(GD->prolog_flag.table);
      } else
        break;
    }
    PL_UNLOCK(L_PLFLAG);
  
    freeTableEnum(e->table_enum);
    freeHeap(e, sizeof(*e));
  
    fail;
  }
  
  
  foreign_t
  pl_prolog_flag(term_t name, term_t value, control_t h)
  { return pl_prolog_flag5(name, value, 0, 0, 0, h);
  }
  
  
  		 /*******************************
  		 *	INITIALISE FEATURES	*
  		 *******************************/
  
  #ifndef SO_EXT
  #define SO_EXT "so"
  #endif
  #ifndef SO_PATH
  #define SO_PATH "LD_LIBRARY_PATH"
  #endif
  #ifndef C_LIBPLSO
  #define C_LIBPLSO ""
  #endif
  
  static void
  initPrologFlagTable(void)
  { if ( !GD->prolog_flag.table )
    { initPrologThreads();	/* may be called before PL_initialise() */
  
      GD->prolog_flag.table = newHTable(64);
    }
  }
  
  
  void
  initPrologFlags(void)
  { GET_LD
    setPrologFlag("iso",  FT_BOOL, FALSE, PLFLAG_ISO);
    setPrologFlag("arch", FT_ATOM|FF_READONLY, PLARCH);
  #if __WINDOWS__
    setPrologFlag("windows",	FT_BOOL|FF_READONLY, TRUE, 0);
    const char *wine_version;
    if ( (wine_version=PL_w32_running_under_wine()) )
      setPrologFlag("wine_version", FT_ATOM|FF_READONLY, wine_version, 0);
  #endif
  #if O_XOS
    setPrologFlag("win_file_access_check", FT_ATOM,
  		get_win_file_access_check(), 0);
  #endif
    setPrologFlag("file_name_case_handling", FT_ATOM,
  		stringAtom(currentFileNameCaseHandling()));
    setPrologFlag("version", FT_INTEGER|FF_READONLY, PLVERSION);
    setPrologFlag("dialect", FT_ATOM|FF_READONLY, "swi");
    if ( systemDefaults.home )
      setPrologFlag("home", FT_ATOM|FF_READONLY, systemDefaults.home);
  #ifdef PLSHAREDHOME
    setPrologFlag("shared_home", FT_ATOM|FF_READONLY, PLSHAREDHOME);
  #endif
    if ( GD->paths.executable )
      setPrologFlag("executable", FT_ATOM|FF_READONLY, GD->paths.executable);
  #if defined(HAVE_GETPID) || defined(EMULATE_GETPID)
    setPrologFlag("pid", FT_INTEGER|FF_READONLY, getpid());
  #endif
    setPrologFlag("optimise", FT_BOOL, GD->cmdline.optimise, PLFLAG_OPTIMISE);
    setPrologFlag("optimise_debug", FT_ATOM, "default", 0);
    setPrologFlag("generate_debug_info", FT_BOOL,
  		truePrologFlag(PLFLAG_DEBUGINFO), PLFLAG_DEBUGINFO);
    setPrologFlag("protect_static_code", FT_BOOL, FALSE,
  		PLFLAG_PROTECT_STATIC_CODE);
    setPrologFlag("last_call_optimisation", FT_BOOL, TRUE, PLFLAG_LASTCALL);
    setPrologFlag("warn_override_implicit_import", FT_BOOL, TRUE,
  		PLFLAG_WARN_OVERRIDE_IMPLICIT_IMPORT);
    setPrologFlag("c_cc",	     FT_ATOM, C_CC);
    setPrologFlag("c_libs",    FT_ATOM, C_LIBS);
  #ifdef C_LIBDIR
    setPrologFlag("c_libdir",  FT_ATOM, C_LIBDIR);
  #endif
    setPrologFlag("c_libplso", FT_ATOM, C_LIBPLSO);
    setPrologFlag("c_ldflags", FT_ATOM, C_LDFLAGS);
    setPrologFlag("c_cflags",  FT_ATOM, C_CFLAGS);
    setPrologFlag("tmp_dir", FT_ATOM, SWIPL_TMP_DIR);
  #if defined(O_LARGEFILES) || SIZEOF_LONG == 8
    setPrologFlag("large_files", FT_BOOL|FF_READONLY, TRUE, 0);
  #endif
    setPrologFlag("unload_foreign_libraries", FT_BOOL, FALSE, 0);
    setPrologFlag("gc",	  FT_BOOL,	       TRUE,  PLFLAG_GC);
    setPrologFlag("trace_gc",  FT_BOOL,	       FALSE, PLFLAG_TRACE_GC);
  #ifdef O_ATOMGC
    setPrologFlag("agc_margin",FT_INTEGER,	       GD->atoms.margin);
  #endif
    setPrologFlag("table_space", FT_INTEGER, GD->options.tableSpace);
  #ifdef O_PLMT
    setPrologFlag("shared_table_space", FT_INTEGER, GD->options.sharedTableSpace);
  #endif
    setPrologFlag("stack_limit", FT_INTEGER, LD->stacks.limit);
  #if defined(HAVE_DLOPEN) || defined(HAVE_SHL_LOAD) || defined(EMULATE_DLOPEN)
    setPrologFlag("open_shared_object",	  FT_BOOL|FF_READONLY, TRUE, 0);
    setPrologFlag("shared_object_extension",	  FT_ATOM|FF_READONLY, SO_EXT);
    setPrologFlag("shared_object_search_path", FT_ATOM|FF_READONLY, SO_PATH);
  #endif
    setPrologFlag("address_bits", FT_INTEGER|FF_READONLY, sizeof(void*)*8);
  #ifdef HAVE_POPEN
    setPrologFlag("pipe", FT_BOOL, TRUE, 0);
  #endif
  #ifdef O_PLMT
    setPrologFlag("threads",	FT_BOOL, !GD->options.nothreads, 0);
    if ( GD->options.xpce >= 0 )
      setPrologFlag("xpce",	FT_BOOL, GD->options.xpce, 0);
    setPrologFlag("system_thread_id", FT_INTEGER|FF_READONLY, 0, 0);
    setPrologFlag("gc_thread",    FT_BOOL,
  		!GD->options.nothreads &&
  		truePrologFlag(PLFLAG_GCTHREAD), PLFLAG_GCTHREAD);
  #else
    setPrologFlag("threads",	FT_BOOL|FF_READONLY, FALSE, 0);
    setPrologFlag("gc_thread",    FT_BOOL|FF_READONLY, FALSE, PLFLAG_GCTHREAD);
  #endif
  #ifdef O_DDE
    setPrologFlag("dde", FT_BOOL|FF_READONLY, TRUE, 0);
  #endif
  #ifdef O_RUNTIME
    setPrologFlag("runtime",	FT_BOOL|FF_READONLY, TRUE, 0);
    setPrologFlag("debug_on_error", FT_BOOL|FF_READONLY, FALSE,
  	     PLFLAG_DEBUG_ON_ERROR);
    setPrologFlag("report_error",	FT_BOOL|FF_READONLY, FALSE,
  	     PLFLAG_REPORT_ERROR);
  #else
    setPrologFlag("debug_on_error",	FT_BOOL, TRUE, PLFLAG_DEBUG_ON_ERROR);
    setPrologFlag("report_error",	FT_BOOL, TRUE, PLFLAG_REPORT_ERROR);
  #endif
    setPrologFlag("break_level", FT_INTEGER|FF_READONLY, 0, 0);
    setPrologFlag("user_flags", FT_ATOM, "silent");
    setPrologFlag("editor", FT_ATOM, "default");
    setPrologFlag("debugger_show_context", FT_BOOL, FALSE, 0);
    setPrologFlag("autoload",  FT_ATOM, "true");
    setPrologFlagMask(PLFLAG_AUTOLOAD);
  #ifndef O_GMP
    setPrologFlag("max_integer",	   FT_INT64|FF_READONLY, PLMAXINT);
    setPrologFlag("min_integer",	   FT_INT64|FF_READONLY, PLMININT);
  #endif
    setPrologFlag("max_tagged_integer", FT_INTEGER|FF_READONLY, PLMAXTAGGEDINT);
    setPrologFlag("min_tagged_integer", FT_INTEGER|FF_READONLY, PLMINTAGGEDINT);
  #ifdef O_GMP
    setPrologFlag("bounded",	      FT_BOOL|FF_READONLY,	   FALSE, 0);
    setPrologFlag("prefer_rationals", FT_BOOL, O_PREFER_RATIONALS, PLFLAG_RATIONAL);
    setPrologFlag("rational_syntax",  FT_ATOM,
  		O_RATIONAL_SYNTAX == RAT_NATURAL ? "natural" :
  		                                   "compatibility");
  #ifdef __GNU_MP__
    setPrologFlag("gmp_version",	   FT_INTEGER|FF_READONLY, __GNU_MP__);
  #endif
  #else
    setPrologFlag("bounded",		   FT_BOOL|FF_READONLY,	   TRUE, 0);
  #endif
    if ( (-3 / 2) == -2 )
      setPrologFlag("integer_rounding_function", FT_ATOM|FF_READONLY, "down");
    else
      setPrologFlag("integer_rounding_function", FT_ATOM|FF_READONLY, "toward_zero");
    setPrologFlag("max_char_code", FT_INTEGER|FF_READONLY, PLMAXWCHAR);
    setPrologFlag("max_arity", FT_ATOM|FF_READONLY, "unbounded");
    setPrologFlag("answer_format", FT_ATOM, "~p");
    setPrologFlag("colon_sets_calling_context", FT_BOOL|FF_READONLY, TRUE, 0);
    setPrologFlag("character_escapes", FT_BOOL, TRUE, PLFLAG_CHARESCAPE);
    setPrologFlag("var_prefix", FT_BOOL, FALSE, PLFLAG_VARPREFIX);
    setPrologFlag("char_conversion", FT_BOOL, FALSE, PLFLAG_CHARCONVERSION);
  #ifdef O_QUASIQUOTATIONS
    setPrologFlag("quasi_quotations", FT_BOOL, TRUE, PLFLAG_QUASI_QUOTES);
  #endif
    setPrologFlag("write_attributes", FT_ATOM, "ignore");
    setPrologFlag("stream_type_check", FT_ATOM, "loose");
    setPrologFlag("occurs_check", FT_ATOM, "false");
    setPrologFlag("access_level", FT_ATOM, "user");
    setPrologFlag("double_quotes", FT_ATOM,
  		GD->options.traditional ? "codes" : "string");
    setPrologFlag("back_quotes", FT_ATOM,
  		GD->options.traditional ? "symbol_char" : "codes");
    setPrologFlag("portable_vmi", FT_BOOL, TRUE, PLFLAG_PORTABLE_VMI);
    setPrologFlag("traditional", FT_BOOL|FF_READONLY, GD->options.traditional, 0);
    setPrologFlag("unknown", FT_ATOM, "error");
    setPrologFlag("debug", FT_BOOL, FALSE, 0);
    setPrologFlag("debug_on_interrupt", FT_BOOL,
  		truePrologFlag(PLFLAG_DEBUG_ON_INTERRUPT),
  		PLFLAG_DEBUG_ON_INTERRUPT);
    setPrologFlag("verbose", FT_ATOM|FF_KEEP, GD->options.silent ? "silent" : "normal");
    setPrologFlag("verbose_load", FT_ATOM, "silent");
    setPrologFlag("verbose_autoload", FT_BOOL, FALSE, 0);
    setPrologFlag("verbose_file_search", FT_BOOL, FALSE, 0);
    setPrologFlag("sandboxed_load", FT_BOOL, FALSE, 0);
    setPrologFlag("allow_variable_name_as_functor", FT_BOOL, FALSE,
  		ALLOW_VARNAME_FUNCTOR);
    setPrologFlag("allow_dot_in_atom", FT_BOOL, FALSE,
  		PLFLAG_DOT_IN_ATOM);
    setPrologFlag("toplevel_var_size", FT_INTEGER, 1000);
    setPrologFlag("toplevel_print_anon", FT_BOOL, TRUE, 0);
    setPrologFlag("toplevel_prompt", FT_ATOM, "~m~d~l~! ?- ");
    setPrologFlag("file_name_variables", FT_BOOL, FALSE, PLFLAG_FILEVARS);
    setPrologFlag("fileerrors", FT_BOOL, TRUE, PLFLAG_FILEERRORS);
  #ifdef O_DEBUG
    setPrologFlag("prolog_debug", FT_BOOL|FF_READONLY, TRUE, 0);
  #endif
  #ifdef __EMSCRIPTEN__
    setPrologFlag("emscripten", FT_BOOL|FF_READONLY, TRUE, 0);
  #else
  #ifdef __unix__
    setPrologFlag("unix", FT_BOOL|FF_READONLY, TRUE, 0);
  #endif
  #ifdef __APPLE__
    setPrologFlag("apple", FT_BOOL|FF_READONLY, TRUE, 0);
  #endif
  #ifdef __ANDROID__
    setPrologFlag("android", FT_BOOL|FF_READONLY, TRUE, 0);
  # ifdef __ANDROID_API__
    setPrologFlag("android_api",FT_INTEGER|FF_READONLY, __ANDROID_API__);
  # endif
  #endif
  #endif
  
    setPrologFlag("encoding", FT_ATOM, stringAtom(encoding_to_atom(LD->encoding)));
  
    setPrologFlag("tty_control", FT_BOOL,
  		truePrologFlag(PLFLAG_TTY_CONTROL), PLFLAG_TTY_CONTROL);
    setPrologFlag("signals", FT_BOOL|FF_READONLY,
  		truePrologFlag(PLFLAG_SIGNALS), PLFLAG_SIGNALS);
    setPrologFlag("packs", FT_BOOL, GD->cmdline.packs, 0);
  
  #if defined(__WINDOWS__) && defined(_DEBUG)
    setPrologFlag("kernel_compile_mode", FT_ATOM|FF_READONLY, "debug");
  #endif
  
  #if defined(BUILD_TIME) && defined(BUILD_DATE)
    setPrologFlag("compiled_at", FT_ATOM|FF_READONLY, BUILD_DATE ", " BUILD_TIME);
  #elif defined(__DATE__) && defined(__TIME__)
    setPrologFlag("compiled_at", FT_ATOM|FF_READONLY, __DATE__ ", " __TIME__);
  #endif
    setPrologFlag("error_ambiguous_stream_pair", FT_BOOL, FALSE,
  		PLFLAG_ERROR_AMBIGUOUS_STREAM_PAIR);
  #ifdef O_MITIGATE_SPECTRE
    setPrologFlag("mitigate_spectre", FT_BOOL, FALSE, PLFLAG_MITIGATE_SPECTRE);
  #endif
  #ifdef POSIX_SHELL
    setPrologFlag("posix_shell", FT_ATOM, POSIX_SHELL);
  #endif
  
    setPrologFlag("table_incremental", FT_BOOL, FALSE, PLFLAG_TABLE_INCREMENTAL);
    setPrologFlag("table_subsumptive", FT_BOOL, FALSE, 0);
    setPrologFlag("table_shared",      FT_BOOL, FALSE, PLFLAG_TABLE_SHARED);
  
    setTmpDirPrologFlag();
    setTZPrologFlag();
    setOSPrologFlags();
    setVersionPrologFlag();
    setArgvPrologFlag("os_argv", GD->cmdline.os_argc,   GD->cmdline.os_argv);
    setArgvPrologFlag("argv",    GD->cmdline.appl_argc, GD->cmdline.appl_argv);
  }
  
  
  static void
  setTmpDirPrologFlag(void)
   { char envbuf[MAXPATHLEN];
     char *td = NULL;
  
  #ifdef __unix__
     td=Getenv("TMP", envbuf, sizeof(envbuf));
  #elif __WINDOWS__
     td=Getenv("TEMP", envbuf, sizeof(envbuf));
  #endif
  
     if (td == (char *) NULL)
       td = SWIPL_TMP_DIR;
  
     setPrologFlag("tmp_dir", FT_ATOM, td);
  }
  
  static void
  setArgvPrologFlag(const char *flag, int argc, char **argv)
  { GET_LD
    fid_t fid = PL_open_foreign_frame();
    term_t e = PL_new_term_ref();
    term_t l = PL_new_term_ref();
    int n;
  
    PL_put_nil(l);
    for(n=argc-1; n>= 0; n--)
    { PL_put_variable(e);
      if ( !PL_unify_chars(e, PL_ATOM|REP_FN, -1, argv[n]) ||
  	 !PL_cons_list(l, e, l) )
        fatalError("Could not set Prolog flag argv: not enough stack");
    }
  
    setPrologFlag(flag, FT_TERM, l);
    PL_discard_foreign_frame(fid);
  }
  
  
  static void
  setTZPrologFlag(void)
  { tzset();
  
  #ifdef _MSC_VER
  #define timezone _timezone
  #endif
  
    setPrologFlag("timezone", FT_INTEGER|FF_READONLY, timezone);
  }
  
  
  static void
  setVersionPrologFlag(void)
  { GET_LD
    fid_t fid = PL_open_foreign_frame();
    term_t t = PL_new_term_ref();
    term_t o = PL_new_term_ref();
    int major = PLVERSION/10000;
    int minor = (PLVERSION/100)%100;
    int patch = (PLVERSION%100);
  
    PL_put_nil(o);
  
  #ifdef PLVERSION_TAG
    { const char *tag = PLVERSION_TAG;
      if ( tag && *tag )
      { int rc;
        term_t tt;
  
        rc = ( (tt=PL_new_term_ref()) &&
  	     PL_put_atom_chars(tt, tag) &&
  	     PL_cons_functor(tt, FUNCTOR_tag1, tt) &&
  	     PL_cons_functor(o,  FUNCTOR_dot2, tt, o) );
        (void)rc;
      }
    }
  #endif
  
    if ( !PL_unify_term(t,
  		      PL_FUNCTOR_CHARS, PLNAME, 4,
  		        PL_INT, major,
  		        PL_INT, minor,
  		        PL_INT, patch,
  		        PL_TERM, o) )
      sysError("Could not set version");
  
    setPrologFlag("version_data", FF_READONLY|FT_TERM, t);
    PL_discard_foreign_frame(fid);
  
    setGITVersion();
  }
  
  static int
  abi_version_dict(term_t dict)
  { GET_LD
    const atom_t keys[] = { ATOM_foreign_interface,
  			  ATOM_record,
  			  ATOM_qlf,
  			  ATOM_qlf_min_load,
  			  ATOM_vmi,
  			  ATOM_built_in };
    term_t values = PL_new_term_refs(6);
  
    return ( PL_unify_integer(values+0, PL_version(PL_VERSION_FLI)) &&
  	   PL_unify_integer(values+1, PL_version(PL_VERSION_REC)) &&
  	   PL_unify_integer(values+2, PL_version(PL_VERSION_QLF)) &&
  	   PL_unify_integer(values+3, PL_version(PL_VERSION_QLF_LOAD)) &&
  	   PL_unify_integer(values+4, PL_version(PL_VERSION_VM)) &&
  	   PL_unify_integer(values+5, PL_version(PL_VERSION_BUILT_IN)) &&
  
  	   PL_put_dict(dict, ATOM_abi, 6, keys, values) );
  }
  
  
  void
  setABIVersionPrologFlag(void)
  { GET_LD
    fid_t fid = PL_open_foreign_frame();
    term_t t = PL_new_term_ref();
  
    if ( abi_version_dict(t) )
      setPrologFlag("abi_version", FF_READONLY|FT_TERM, t);
  
    PL_discard_foreign_frame(fid);
  }
  
  
  void
  cleanupPrologFlags(void)
  { if ( GD->prolog_flag.table )
    { Table t = GD->prolog_flag.table;
  
      GD->prolog_flag.table = NULL;
  #ifdef O_PLMT
      t->free_symbol = freeSymbolPrologFlagTable;
  #else
      t->free_symbol = NULL;
  #endif
      destroyHTable(t);
    }
  }
  
  
  
  		 /*******************************
  		 *      PUBLISH PREDICATES	*
  		 *******************************/
  
  BeginPredDefs(prologflag)
    PRED_DEF("set_prolog_flag",    2, set_prolog_flag,    PL_FA_ISO)
    PRED_DEF("create_prolog_flag", 3, create_prolog_flag, 0)
  EndPredDefs
  