#line 1 "/build/ecl/src/ecl-26.5.5/src/c/package.d"
/* -*- Mode: C; c-basic-offset: 2; indent-tabs-mode: nil -*- */
/* vim: set filetype=c tabstop=2 shiftwidth=2 expandtab: */

/*
 * package.d - packages
 *
 * Copyright (c) 1984 Taiichi Yuasa and Masami Hagiya
 * Copyright (c) 1990 Giuseppe Attardi
 * Copyright (c) 2001 Juan Jose Garcia Ripoll
 * Copyright (c) 2017 Daniel Kochmański
 *
 * See file 'LICENSE' for the copyright details.
 *
 */

#include <string.h>
#include <ecl/ecl.h>
#include <ecl/internal.h>
#include <ecl/ecl-inl.h>

/******************************* ------- ******************************/
/*
 * NOTE 1: we only need to use the package locks when reading/writing the hash
 * tables, or changing the fields of a package.  We do not need the locks to
 * read lists from the packages (i.e. list of shadowing symbols, used
 * packages, etc), or from the global environment (cl_core.packages_list) if
 * we do not destructively modify them (For instance, use ecl_remove_eq
 * instead of ecl_delete_eq).
 */
/*
 * NOTE 2: Operations between locks must be guaranteed not fail, or, if
 * they signal an error, they should undo all locks they had before.
 */

static cl_object find_symbol_inner(cl_object name, cl_object p, int *intern_flag);

static void
FEpackage_error(const char *message, cl_object package, int narg, ...)
{
  ecl_va_list args;
  cl_object rest;
  ecl_va_start(args, narg, narg, 0);
  rest = narg? cl_grab_rest_args(args) : cl_list(1,package);
  ecl_va_end(args);
  si_signal_simple_error(6,
                         ECL_SYM("PACKAGE-ERROR",620),
                         ECL_NIL, /* not correctable */
                         ecl_make_constant_base_string(message,-1), /* format control */
                         rest, /* format args */
                         ECL_SYM(":PACKAGE",1321), package); /* extra arguments */
}

void
CEpackage_error(const char *message, const char *continue_message, cl_object package, int narg, ...)
{
  ecl_va_list args;
  cl_object arg;
  ecl_va_start(args, narg, narg, 0);
  arg = narg? cl_grab_rest_args(args) : cl_list(1,package);
  ecl_va_end(args);
  si_signal_simple_error(6,
                         ECL_SYM("PACKAGE-ERROR",620),
                         ecl_make_constant_base_string(continue_message,-1),
                         ecl_make_constant_base_string(message,-1), /* format control */
                         arg,
                         ECL_SYM(":PACKAGE",1321), package);
}

static bool
member_string_eq(cl_object x, cl_object l)
{
  /* INV: l is a proper list */
  loop_for_on_unsafe(l) {
    if (ecl_string_eq(x, ECL_CONS_CAR(l)))
      return TRUE;
  } end_loop_for_on_unsafe(l);
  return FALSE;
}

#if defined(__cplusplus) || (defined(__GNUC__) && !defined(__STRICT_ANSI__))
#define INLINE inline
#else
#define INLINE
#endif

static INLINE void
symbol_remove_package(cl_object s, cl_object p)
{
  if (Null(s))
    s = ECL_NIL_SYMBOL;
  if (s->symbol.hpack == p)
    s->symbol.hpack = ECL_NIL;
}

static INLINE void
symbol_add_package(cl_object s, cl_object p)
{
  if (Null(s))
    s = ECL_NIL_SYMBOL;
  if (s->symbol.hpack == ECL_NIL)
    s->symbol.hpack = p;
}

/*
  ecl_make_package(n, ns, ul, lns) makes a package with name n, which
  must be a string or a symbol, and nicknames ns, which must be a list
  of strings or symbols, and uses packages in list ul, which must be a
  list of packages or package names i.e. strings or symbols. lns is an
  alist (local-nickname . package) which is used for having private
  nicknames for other packages.
*/
static cl_object
make_package_hashtable()
{
  return cl__make_hash_table(ECL_SYM("PACKAGE",619), /* package hash table */
                             ecl_make_fixnum(128), /* initial size */
                             cl_core.rehash_size,
                             cl_core.rehash_threshold);
}

static cl_object
alloc_package(cl_object name)
{
  cl_object p = ecl_alloc_object(t_package);
  p->pack.internal = make_package_hashtable();
  p->pack.external = make_package_hashtable();
  p->pack.name = name;
  p->pack.nicknames = ECL_NIL;
  p->pack.local_nicknames = ECL_NIL;
  p->pack.nicknamedby = ECL_NIL;
  p->pack.shadowings = ECL_NIL;
  p->pack.uses = ECL_NIL;
  p->pack.usedby = ECL_NIL;
  p->pack.locked = FALSE;
  return p;
}

cl_object
_ecl_package_to_be_created(const cl_env_ptr env, cl_object name)
{
  cl_object package = ecl_assoc(name, env->packages_to_be_created);
  if (Null(package)) {
    const cl_env_ptr env = ecl_process_env();
    package = alloc_package(name);
    env->packages_to_be_created =
      cl_acons(name, package, env->packages_to_be_created);
  } else {
    package = ECL_CONS_CDR(package);
  }
  return package;
}

static cl_object
find_pending_package(cl_env_ptr env, cl_object name, cl_object nicknames)
{
  cl_object l = env->packages_to_be_created;
  while (!Null(l)) {
    cl_object pair = ECL_CONS_CAR(l);
    cl_object other_name = ECL_CONS_CAR(pair);
    if (ecl_equal(other_name, name) ||
        _ecl_funcall5(ECL_SYM("MEMBER",554), other_name, nicknames,
                      ECL_SYM(":TEST",1353), ECL_SYM("STRING=",825)) != ECL_NIL)
      {
        cl_object x = ECL_CONS_CDR(pair);
        env->packages_to_be_created =
          ecl_remove_eq(pair,
                        env->packages_to_be_created);
        return x;
      }
    l = ECL_CONS_CDR(l);
  }
  return ECL_NIL;
}

static cl_object
find_local_nickname_package(cl_object name) {
  cl_object p = ecl_symbol_value(ECL_SYM("*PACKAGE*",45));
  if (ECL_PACKAGEP(p)) {
    p = ecl_assoc(name, p->pack.local_nicknames);
    if (!Null(p)) return ECL_CONS_CDR(p);
  }
  return ECL_NIL;
}

static cl_object
process_nicknames(cl_object nicknames)
{
  cl_object l;
  nicknames = cl_copy_list(nicknames);
  for (l = nicknames; l != ECL_NIL; l = ECL_CONS_CDR(l))
    ECL_RPLACA(l, cl_string(ECL_CONS_CAR(l)));
  return nicknames;
}

static cl_object
process_package_list(cl_object packages)
{
  cl_object l;
  packages = cl_copy_list(packages);
  for (l = packages; l != ECL_NIL; l = ECL_CONS_CDR(l))
    ECL_RPLACA(l, si_coerce_to_package(ECL_CONS_CAR(l)));
  return packages;
}

static cl_object
process_local_nicknames_tree(cl_object local_nicknames)
{
  cl_object l, nl;
  local_nicknames = cl_copy_tree(local_nicknames);
  for (l = local_nicknames; l != ECL_NIL; l = ECL_CONS_CDR(l)) {
    nl = ECL_CONS_CAR(l);
    ECL_RPLACA(nl, cl_string(ECL_CONS_CAR(nl)));
    ECL_RPLACD(nl, si_coerce_to_package(ECL_CONS_CDR(nl)));
  }
  return local_nicknames;
}

cl_object
ecl_make_package(cl_object name, cl_object nicknames,
                 cl_object use_list, cl_object local_nicknames)
{
  const cl_env_ptr env = ecl_process_env();
  cl_object x, other = ECL_NIL;

  /* Type checking, coercions, and the like, happen before we
   * acquire the lock */
  name = cl_string(name);
  nicknames = process_nicknames(nicknames);
  use_list = process_package_list(use_list);
  local_nicknames = process_local_nicknames_tree(local_nicknames);

  ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(env) {
    if (ecl_option_values[ECL_OPT_BOOTED]) {
      /* Find a similarly named package in the list of packages to be created
       * and use it or try to build a new package. */
      x = find_pending_package(env, name, nicknames);
      if (Null(x)) {
        other = ecl_find_package_nolock(name);
        if (other != ECL_NIL) {
          goto OUTPUT;
        } else {
          x = alloc_package(name);
        }
      }
      loop_for_in(nicknames) {
        cl_object nick = ECL_CONS_CAR(nicknames);
        other = ecl_find_package_nolock(nick);
        if (other != ECL_NIL) {
          name = nick;
          goto OUTPUT;
        }
        x->pack.nicknames = CONS(nick, x->pack.nicknames);
      } end_loop_for_in;
    } else {
      /* When we are not booted yet, then we are certain that there are no
         duplicated package definitions (nor pending packages or nicknames
         overlapping with existing packages). */
      x = alloc_package(name);
      x->pack.nicknames = nicknames;
    }
    loop_for_in(use_list) {
      cl_object y = ECL_CONS_CAR(use_list);
      x->pack.uses = CONS(y, x->pack.uses);
      y->pack.usedby = CONS(x, y->pack.usedby);
    } end_loop_for_in;
    loop_for_in(local_nicknames) {
      cl_object y = ECL_CONS_CAR(local_nicknames);
      cl_object nicknamed = ECL_CONS_CDR(y);
      x->pack.local_nicknames = CONS(y, x->pack.local_nicknames);
      nicknamed->pack.nicknamedby = CONS(x, nicknamed->pack.nicknamedby);
    } end_loop_for_in;
    /* Finally, add it to the list of packages */
    cl_core.packages = CONS(x, cl_core.packages);
  OUTPUT:
    (void)0;
  } ECL_WITH_GLOBAL_ENV_WRLOCK_END;
  if (!Null(other)) {
    CEpackage_error("A package with the name ~A already exists.",
                    "Return existing package",
                    other, 1, name);
    return other;
  }
  return x;
}

cl_object
ecl_rename_package(cl_object x, cl_object name, cl_object nicknames)
{
  bool error;

  name = cl_string(name);
  nicknames = process_nicknames(nicknames);
  x = si_coerce_to_package(x);
  if (x->pack.locked
      && ECL_SYM_VAL(ecl_process_env(),
                     ECL_SYM("SI::*IGNORE-PACKAGE-LOCKS*",1128)) == ECL_NIL) {
    CEpackage_error("Cannot rename locked package ~S.",
                    "Ignore lock and proceed.", x, 0);
  }
  nicknames = ecl_cons(name, nicknames);
  error = 0;
  ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(ecl_process_env()) {
    cl_object l;
    for (l = nicknames; l != ECL_NIL; l = ECL_CONS_CDR(l)) {
      cl_object nick = ECL_CONS_CAR(l);
      cl_object p = ecl_find_package_nolock(nick);
      if ((p != ECL_NIL) && (p != x)) {
        name = nick;
        error = 1;
        break;
      }
    }
    if (!error) {
      x->pack.name = name;
      x->pack.nicknames = ECL_CONS_CDR(nicknames);
    }
  } ECL_WITH_GLOBAL_ENV_WRLOCK_END;
  if (error) {
    FEpackage_error("A package with name ~S already exists.", x,
                    1, name);
  }
  return x;
}

/*
  ecl_find_package_nolock(n) seaches for a package with name n, where n is
  a valid string designator, or simply outputs n if it is a
  package.

  This is not a locking routine and someone may replace the list of
  packages while we are scanning it. Nevertheless, the list IS NOT
  be destructively modified, which means that we are on the safe side.
  Routines which need to ensure that the package list remains constant
  should enforce a global lock with PACKAGE_OP_LOCK().
*/
cl_object
ecl_find_package_nolock(cl_object name)
{
  cl_object l, p;

  if (ECL_PACKAGEP(name))
    return name;
  name = cl_string(name);

  p = find_local_nickname_package(name);
  if (!Null(p)) return p;

  l = cl_core.packages;
  loop_for_on_unsafe(l) {
    p = ECL_CONS_CAR(l);
    if (ecl_string_eq(name, p->pack.name))
      return p;
    if (member_string_eq(name, p->pack.nicknames))
      return p;
  } end_loop_for_on_unsafe(l);
  return ECL_NIL;
}

cl_object
ecl_find_package(const char *p)
{
  ecl_def_ct_base_string(pack_name,p,strlen(p),,);
  return cl_find_package(pack_name);
}

cl_object
si_coerce_to_package(cl_object p)
{
  /* INV: ecl_find_package_nolock() signals an error if "p" is neither a package
     nor a string */
  cl_object pp = ecl_find_package_nolock(p);
  if (Null(pp)) {
    FEpackage_error("There exists no package with name ~S", p, 0);
  }
  {
#line 375
	const cl_env_ptr the_env = ecl_process_env();
#line 375
	#line 375
	cl_object __value0 = pp;
#line 375
	the_env->nvalues = 1;
#line 375
	the_env->values[0] = __value0;
#line 375
	#line 375
	return __value0;
#line 375
}
;
}

cl_object
ecl_current_package(void)
{
  const cl_env_ptr env = ecl_process_env();
  cl_object x = ecl_cmp_symbol_value(env, ECL_SYM("*PACKAGE*",45));
  unlikely_if (!ECL_PACKAGEP(x)) {
    ECL_SETQ(env, ECL_SYM("*PACKAGE*",45), cl_core.user_package);
    FEerror("The value of *PACKAGE*, ~S, was not a package",
            1, x);
  }
  return x;
}

/*
  Ecl_Intern(st, p) interns string st in package p.
*/
cl_object
_ecl_intern(const char *s, cl_object p)
{
  int intern_flag;
  cl_object str = ecl_make_constant_base_string(s,-1);
  return ecl_intern(str, p, &intern_flag);
}

cl_object
ecl_intern(cl_object name, cl_object p, int *intern_flag)
{
  cl_object s;
  bool error, ignore_error = 0;

  if (ecl_unlikely(!ECL_STRINGP(name)))
    FEwrong_type_nth_arg(ecl_make_fixnum(/*INTERN*/444), 1, name, ecl_make_fixnum(/*STRING*/808));
  p = si_coerce_to_package(p);
 AGAIN:
  ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(ecl_process_env()) {
    s = find_symbol_inner(name, p, intern_flag);
    if (*intern_flag) {
      error = 0;
    } else if (p->pack.locked
               && !ignore_error
               && ECL_SYM_VAL(ecl_process_env(),
                              ECL_SYM("SI::*IGNORE-PACKAGE-LOCKS*",1128)) == ECL_NIL) {
      error = 1;
    } else {
      s = cl_make_symbol(name);
      s->symbol.hpack = p;
      *intern_flag = 0;
      if (p == cl_core.keyword_package) {
        ecl_symbol_type_set(s, ecl_symbol_type(s) | ecl_stp_constant);
        ECL_SET(s, s);
        p->pack.external =
          _ecl_sethash(name, p->pack.external, s);
      } else {
        p->pack.internal =
          _ecl_sethash(name, p->pack.internal, s);
      }
      error = 0;
    }
  } ECL_WITH_GLOBAL_ENV_WRLOCK_END;
  if (error) {
    CEpackage_error("Cannot intern symbol ~S in locked package ~S.",
                    "Ignore lock and proceed.", p, 2, name, p);
    ignore_error = 1;
    goto AGAIN;
  }
  return s;
}

/*
  find_symbol_inner(st, len, p) searches for string st of length
  len in package p.
*/
static cl_object
find_symbol_inner(cl_object name, cl_object p, int *intern_flag)
{
  cl_object s, ul;

  s = ecl_gethash_safe(name, p->pack.external, OBJNULL);
  if (s != OBJNULL) {
    *intern_flag = ECL_EXTERNAL;
    goto OUTPUT;
  }
  if (p == cl_core.keyword_package)
    goto NOTHING;
  s = ecl_gethash_safe(name, p->pack.internal, OBJNULL);
  if (s != OBJNULL) {
    *intern_flag = ECL_INTERNAL;
    goto OUTPUT;
  }
  ul = p->pack.uses;
  loop_for_on_unsafe(ul) {
    s = ecl_gethash_safe(name, ECL_CONS_CAR(ul)->pack.external, OBJNULL);
    if (s != OBJNULL) {
      *intern_flag = ECL_INHERITED;
      goto OUTPUT;
    }
  } end_loop_for_on_unsafe(ul);
 NOTHING:
  *intern_flag = 0;
  s = ECL_NIL;
 OUTPUT:
  return s;
}

cl_object
ecl_find_symbol(cl_object n, cl_object p, int *intern_flag)
{
  cl_object s;
  if (ecl_unlikely(!ECL_STRINGP(n)))
    FEwrong_type_nth_arg(ecl_make_fixnum(/*FIND-SYMBOL*/371), 1, n, ecl_make_fixnum(/*STRING*/808));
  p = si_coerce_to_package(p);
  ECL_WITH_GLOBAL_ENV_RDLOCK_BEGIN(ecl_process_env()) {
    s = find_symbol_inner(n, p, intern_flag);
  } ECL_WITH_GLOBAL_ENV_RDLOCK_END;
  return s;
}

static cl_object
potential_unintern_conflict(cl_object name, cl_object s, cl_object p)
{
  cl_object x = OBJNULL;
  cl_object l = p->pack.uses;
  loop_for_on_unsafe(l) {
    cl_object other_p = ECL_CONS_CAR(l);
    cl_object y = ecl_gethash_safe(name, other_p->pack.external, OBJNULL);
    if (y != OBJNULL) {
      if (x == OBJNULL) {
        x = y;
      } else if (x != y) {
        return ecl_cons(x, y);
      }
    }
  } end_loop_for_on_unsafe(l);
  return ECL_NIL;
}

bool
ecl_unintern(cl_object s, cl_object p)
{
  cl_object conflict;
  bool output = FALSE;
  cl_object name = ecl_symbol_name(s);

  p = si_coerce_to_package(p);
  if (p->pack.locked
      && ECL_SYM_VAL(ecl_process_env(),
                     ECL_SYM("SI::*IGNORE-PACKAGE-LOCKS*",1128)) == ECL_NIL) {
    CEpackage_error("Cannot unintern symbol ~S from locked package ~S.",
                    "Ignore lock and proceed.", p, 2, s, p);
  }
  conflict = ECL_NIL;
  ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(ecl_process_env()) {
    cl_object hash = p->pack.internal;
    cl_object x = ecl_gethash_safe(name, hash, OBJNULL);
    if (x != s) {
      hash = p->pack.external;
      x = ecl_gethash_safe(name, hash, OBJNULL);
      if (x != s)
        goto OUTPUT;
    }
    if (ecl_member_eq(s, p->pack.shadowings)) {
      conflict = potential_unintern_conflict(name, s, p);
      if (conflict != ECL_NIL) {
        goto OUTPUT;
      }
      p->pack.shadowings = ecl_remove_eq(s, p->pack.shadowings);
    }
    ecl_remhash(name, hash);
    symbol_remove_package(s, p);
    output = TRUE;
  OUTPUT:
    (void)0;
  } ECL_WITH_GLOBAL_ENV_WRLOCK_END;
  if (conflict != ECL_NIL) {
    FEpackage_error("Cannot unintern the shadowing symbol ~S~%"
                    "from ~S,~%"
                    "because ~S and ~S will cause~%"
                    "a name conflict.", p, 4, s, p,
                    ECL_CONS_CAR(conflict), ECL_CONS_CDR(conflict));
  }
  return output;
}

static cl_object
potential_export_conflict(cl_object name, cl_object s, cl_object p)
{
  cl_object l = p->pack.usedby;
  loop_for_on_unsafe(l) {
    int intern_flag;
    cl_object other_p = ECL_CONS_CAR(l);
    cl_object x = find_symbol_inner(name, other_p, &intern_flag);
    if (intern_flag && s != x &&
        !ecl_member_eq(x, other_p->pack.shadowings)) {
      return other_p;
    }
  } end_loop_for_on_unsafe(l);
  return ECL_NIL;
}

void
cl_export2(cl_object s, cl_object p)
{
  int intern_flag, error;
  cl_object other_p = ECL_NIL, name = ecl_symbol_name(s);
  p = si_coerce_to_package(p);
  if (p->pack.locked
      && ECL_SYM_VAL(ecl_process_env(),
                     ECL_SYM("SI::*IGNORE-PACKAGE-LOCKS*",1128)) == ECL_NIL)
    CEpackage_error("Cannot export symbol ~S from locked package ~S.",
                    "Ignore lock and proceed.", p, 2, s, p);
 AGAIN:
  ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(ecl_process_env()) {
    cl_object x = find_symbol_inner(name, p, &intern_flag);
    if (!intern_flag) {
      error = 1;
    } else if (x != s) {
      error = 2;
    } else if (intern_flag == ECL_EXTERNAL) {
      error = 0;
    } else if ((other_p = potential_export_conflict(name, s, p)) != ECL_NIL) {
      error = 3;
    } else {
      if (intern_flag == ECL_INTERNAL)
        ecl_remhash(name, p->pack.internal);
      p->pack.external = _ecl_sethash(name, p->pack.external, s);
      error = 0;
    }
  } ECL_WITH_GLOBAL_ENV_WRLOCK_END;
  if (error == 1) {
    CEpackage_error("The symbol ~S is not accessible from ~S "
                    "and cannot be exported.",
                    "Import the symbol in the package and proceed.",
                    p, 2, s, p);
    cl_import2(s, p);
    goto AGAIN;
  } else if (error == 2) {
    FEpackage_error("Cannot export the symbol ~S from ~S,~%"
                    "because there is already a symbol with the same name~%"
                    "in the package.", p, 2, s, p);
  } else if (error == 3) {
    FEpackage_error("Cannot export the symbol ~S~%"
                    "from ~S,~%"
                    "because it will cause a name conflict~%"
                    "in ~S.", p, 3, s, p, other_p);
  } 
}

cl_object
cl_delete_package(cl_object p)
{
  cl_object hash, l;
  cl_index i;

  /* 1) Try to remove the package from the global list */
  p = ecl_find_package_nolock(p);
  if (Null(p)) {
    CEpackage_error("Package ~S not found. Cannot delete it.",
                    "Ignore error and continue.", p, 0);
    {
#line 636
	const cl_env_ptr the_env = ecl_process_env();
#line 636
	#line 636
	cl_object __value0 = ECL_NIL;
#line 636
	the_env->nvalues = 1;
#line 636
	the_env->values[0] = __value0;
#line 636
	#line 636
	return __value0;
#line 636
}
;
  }
  if (p->pack.locked
      && ECL_SYM_VAL(ecl_process_env(),
                     ECL_SYM("SI::*IGNORE-PACKAGE-LOCKS*",1128)) == ECL_NIL)
    CEpackage_error("Cannot delete locked package ~S.",
                    "Ignore lock and proceed.", p, 0);
  if (p == cl_core.lisp_package || p == cl_core.keyword_package) {
    FEpackage_error("Cannot remove package ~S", p, 0);
  }

  /* 2) Now remove the package from the other packages that use it and
     empty the package. */
  if (Null(p->pack.name)) {
    {
#line 650
	const cl_env_ptr the_env = ecl_process_env();
#line 650
	#line 650
	cl_object __value0 = ECL_NIL;
#line 650
	the_env->nvalues = 1;
#line 650
	the_env->values[0] = __value0;
#line 650
	#line 650
	return __value0;
#line 650
}
;
  }
  while (!Null(l = p->pack.uses)) {
    ecl_unuse_package(ECL_CONS_CAR(l), p);
  }
  while (!Null(l = p->pack.usedby)) {
    ecl_unuse_package(p, ECL_CONS_CAR(l));
  }

  /* 3) Now remove local nickname related bits. */
  while (!Null(l = p->pack.local_nicknames)) {
    cl_object nickname = ECL_CONS_CAR(l);
    si_remove_package_local_nickname(ECL_CONS_CAR(nickname), p);
  }

  while (!Null(l = p->pack.nicknamedby)) {
    cl_object nicknaming = ECL_CONS_CAR(l);
    cl_object nicklist = nicknaming->pack.local_nicknames;
    loop_for_in(nicklist) {
      cl_object nickname = ECL_CONS_CAR(nicklist);
      if (ECL_CONS_CDR(nickname) == p) {
        si_remove_package_local_nickname(ECL_CONS_CAR(nickname), nicknaming);
        break;
      }
    } end_loop_for_in;
  }

  ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(ecl_process_env()) {
    for (hash = p->pack.internal, i = 0; i < hash->hash.size; i++)
      if (hash->hash.data[i].key != OBJNULL) {
        cl_object s = hash->hash.data[i].value;
        symbol_remove_package(s, p);
      }
    cl_clrhash(p->pack.internal);
    for (hash = p->pack.external, i = 0; i < hash->hash.size; i++)
      if (hash->hash.data[i].key != OBJNULL) {
        cl_object s = hash->hash.data[i].value;
        symbol_remove_package(s, p);
      }
    cl_clrhash(p->pack.external);
    p->pack.shadowings = ECL_NIL;
    p->pack.name = ECL_NIL;
    /* 4) Only at the end, remove the package from the list of packages. */
    cl_core.packages = ecl_remove_eq(p, cl_core.packages);
  } ECL_WITH_GLOBAL_ENV_WRLOCK_END;
  {
#line 695
	const cl_env_ptr the_env = ecl_process_env();
#line 695
	#line 695
	cl_object __value0 = ECL_T;
#line 695
	the_env->nvalues = 1;
#line 695
	the_env->values[0] = __value0;
#line 695
	#line 695
	return __value0;
#line 695
}
;
}

void
cl_unexport2(cl_object s, cl_object p)
{
  cl_object name = ecl_symbol_name(s);
  bool error;
  p = si_coerce_to_package(p);
  if (p == cl_core.keyword_package) {
    FEpackage_error("Cannot unexport a symbol from the keyword package.",
                    cl_core.keyword_package, 0);
  }
  if (p->pack.locked
      && ECL_SYM_VAL(ecl_process_env(),
                     ECL_SYM("SI::*IGNORE-PACKAGE-LOCKS*",1128)) == ECL_NIL) {
    CEpackage_error("Cannot unexport symbol ~S from locked package ~S.",
                    "Ignore lock and proceed.", p, 2, s, p);
  }
  ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(ecl_process_env()) {
    int intern_flag;
    cl_object x = find_symbol_inner(name, p, &intern_flag);
    if (intern_flag == 0 || x != s) {
      error = 1;
    } else if (intern_flag != ECL_EXTERNAL) {
      /* According to ANSI & Cltl, internal symbols are
         ignored in unexport */
      error = 0;
    } else {
      ecl_remhash(name, p->pack.external);
      p->pack.internal = _ecl_sethash(name, p->pack.internal, s);
      error = 0;
    }
  } ECL_WITH_GLOBAL_ENV_WRLOCK_END;
  if (error) {
    FEpackage_error("Cannot unexport ~S because it does not "
                    "belong to package ~S.",
                    p, 2, s, p);
  }
}

void
cl_import2(cl_object s, cl_object p)
{
  int intern_flag, error, ignore_error = 0;
  cl_object name = ecl_symbol_name(s);
  p = si_coerce_to_package(p);
  if (p->pack.locked
      && ECL_SYM_VAL(ecl_process_env(),
                     ECL_SYM("SI::*IGNORE-PACKAGE-LOCKS*",1128)) == ECL_NIL) {
    CEpackage_error("Cannot import symbol ~S into locked package ~S.",
                    "Ignore lock and proceed.", p, 2, s, p);
  }
  ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(ecl_process_env()) {
    cl_object x = find_symbol_inner(name, p, &intern_flag);
    if (intern_flag) {
      if (x != s && !ignore_error) {
        error = 1;
        goto OUTPUT;
      }
      if (intern_flag == ECL_INTERNAL || intern_flag == ECL_EXTERNAL) {
        error = 0;
        goto OUTPUT;
      }
    }
    p->pack.internal = _ecl_sethash(name, p->pack.internal, s);
    symbol_add_package(s, p);
    error = 0;
  OUTPUT:
    (void)0;
  } ECL_WITH_GLOBAL_ENV_WRLOCK_END;
  if (error) {
    CEpackage_error("Cannot import the symbol ~S "
                    "from package ~A,~%"
                    "because there is already a symbol with the same name~%"
                    "in the package.",
                    "Ignore conflict and proceed.", p, 2, s, p);
    ignore_error = 1;
  }
}

void
ecl_shadowing_import(cl_object s, cl_object p)
{
  int intern_flag;
  cl_object x;
  cl_object name = ecl_symbol_name(s);
  p = si_coerce_to_package(p);
  if (p->pack.locked
      && ECL_SYM_VAL(ecl_process_env(),
                     ECL_SYM("SI::*IGNORE-PACKAGE-LOCKS*",1128)) == ECL_NIL)
    CEpackage_error("Cannot shadowing-import symbol ~S into "
                    "locked package ~S.",
                    "Ignore lock and proceed.", p, 2, s, p);

  ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(ecl_process_env()) {
    x = find_symbol_inner(name, p, &intern_flag);
    if (intern_flag && intern_flag != ECL_INHERITED) {
      if (x == s) {
        if (!ecl_member_eq(x, p->pack.shadowings))
          p->pack.shadowings
            = CONS(x, p->pack.shadowings);
        goto OUTPUT;
      }
      if(ecl_member_eq(x, p->pack.shadowings))
        p->pack.shadowings =
          ecl_remove_eq(x, p->pack.shadowings);
      if (intern_flag == ECL_INTERNAL)
        ecl_remhash(name, p->pack.internal);
      else
        ecl_remhash(name, p->pack.external);
      symbol_remove_package(x, p);
    }
    p->pack.shadowings = CONS(s, p->pack.shadowings);
    p->pack.internal = _ecl_sethash(name, p->pack.internal, s);
  OUTPUT:
    (void)0;
  } ECL_WITH_GLOBAL_ENV_WRLOCK_END;
}

void
ecl_shadow(cl_object s, cl_object p)
{
  int intern_flag;
  cl_object x;

  /* Contrary to CLTL, in ANSI CL, SHADOW operates on strings. */
  s = cl_string(s);
  p = si_coerce_to_package(p);
  if (p->pack.locked
      && ECL_SYM_VAL(ecl_process_env(),
                     ECL_SYM("SI::*IGNORE-PACKAGE-LOCKS*",1128)) == ECL_NIL)
    CEpackage_error("Cannot shadow symbol ~S in locked package ~S.",
                    "Ignore lock and proceed.", p, 2, s, p);
  ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(ecl_process_env()) {
    x = find_symbol_inner(s, p, &intern_flag);
    if (intern_flag != ECL_INTERNAL && intern_flag != ECL_EXTERNAL) {
      x = cl_make_symbol(s);
      p->pack.internal = _ecl_sethash(s, p->pack.internal, x);
      x->symbol.hpack = p;
    }
    if (!ecl_member_eq(x, p->pack.shadowings))
      p->pack.shadowings = CONS(x, p->pack.shadowings);
  } ECL_WITH_GLOBAL_ENV_WRLOCK_END;
}

void
ecl_use_package(cl_object x, cl_object p)
{
  struct ecl_hashtable_entry *hash_entries;
  cl_index i, hash_length;
  cl_object here, there, name;
  int intern_flag, error = 0;

  x = si_coerce_to_package(x);
  if (x == cl_core.keyword_package)
    FEpackage_error("Cannot use keyword package.",
                    cl_core.keyword_package, 0);
  p = si_coerce_to_package(p);
  if (p == x)
    return;
  if (ecl_member_eq(x, p->pack.uses))
    return;
  if (p == cl_core.keyword_package)
    FEpackage_error("Cannot apply USE-PACKAGE on keyword package.",
                    cl_core.keyword_package, 0);
  if (p->pack.locked
      && ECL_SYM_VAL(ecl_process_env(),
                     ECL_SYM("SI::*IGNORE-PACKAGE-LOCKS*",1128)) == ECL_NIL)
    CEpackage_error("Cannot use package ~S in locked package ~S.",
                    "Ignore lock and proceed.",
                    p, 2, x, p);

  ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(ecl_process_env()) {
    hash_entries = x->pack.external->hash.data;
    hash_length = x->pack.external->hash.size;
    for (i = 0, error = 0;  i < hash_length;  i++) {
      if (hash_entries[i].key != OBJNULL) {
        here = hash_entries[i].value;
        name = ecl_symbol_name(here);
        there = find_symbol_inner(name, p, &intern_flag);
        if (intern_flag && here != there
            && ! ecl_member_eq(there, p->pack.shadowings)) {
          error = 1;
          break;
        }
      }
    }
    if (!error) {
      p->pack.uses = CONS(x, p->pack.uses);
      x->pack.usedby = CONS(p, x->pack.usedby);
    }
  } ECL_WITH_GLOBAL_ENV_WRLOCK_END;
  if (error) {
    FEpackage_error("Cannot use ~S~%"
                    "from ~S,~%"
                    "because ~S and ~S will cause~%"
                    "a name conflict.", p, 4, x, p, here, there);
  }
}

void
ecl_unuse_package(cl_object x, cl_object p)
{
  x = si_coerce_to_package(x);
  p = si_coerce_to_package(p);
  if (p->pack.locked
      && ECL_SYM_VAL(ecl_process_env(),
                     ECL_SYM("SI::*IGNORE-PACKAGE-LOCKS*",1128)) == ECL_NIL)
    CEpackage_error("Cannot unuse package ~S from locked package ~S.",
                    "Ignore lock and proceed.",
                    p, 2, x, p);
  ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(ecl_process_env()) {
    p->pack.uses = ecl_remove_eq(x, p->pack.uses);
    x->pack.usedby = ecl_remove_eq(p, x->pack.usedby);
  } ECL_WITH_GLOBAL_ENV_WRLOCK_END;
}

#line 916
cl_object cl_make_package(cl_narg narg, cl_object pack_name, ...)
{
#line 916

#line 918
#if defined(__clang__) || defined(__GNUC__)
	__attribute__((unused)) const cl_env_ptr the_env = ecl_process_env();
#else
	const cl_env_ptr the_env = ecl_process_env();
#endif
#line 918
	static cl_object KEYS[3] = {(cl_object)(cl_symbols+1313), (cl_object)(cl_symbols+1361), (cl_object)(cl_symbols+1304)};
	cl_object nicknames;
	cl_object use;
	cl_object local_nicknames;
#line 918
	cl_object KEY_VARS[6];
#line 918
	ecl_va_list ARGS;
	ecl_va_start(ARGS, pack_name, narg, 1);
#line 918
	if (ecl_unlikely(narg < 1)) FEwrong_num_arguments(ecl_make_fixnum(532));
#line 918
	cl_parse_key(ARGS, 3, KEYS, KEY_VARS, NULL, 0);
#line 918
	if (KEY_VARS[3]==ECL_NIL) {
#line 918
	  nicknames = ECL_NIL;
	} else {
#line 918
	  nicknames = KEY_VARS[0];
	}
#line 918
	if (KEY_VARS[4]==ECL_NIL) {
#line 918
	  use = CONS(cl_core.lisp_package, ECL_NIL);
	} else {
#line 918
	  use = KEY_VARS[1];
	}
#line 918
	if (KEY_VARS[5]==ECL_NIL) {
#line 918
	  local_nicknames = ECL_NIL;
	} else {
#line 918
	  local_nicknames = KEY_VARS[2];
	}
#line 918
  /* INV: ecl_make_package() performs type checking */
  {
#line 919
	#line 919
	cl_object __value0 = ecl_make_package(pack_name, nicknames, use, local_nicknames);
#line 919
	the_env->nvalues = 1;
#line 919
	the_env->values[0] = __value0;
#line 919
	ecl_va_end(ARGS);
#line 919
	return __value0;
#line 919
}
;
}

cl_object
si_select_package(cl_object pack_name)
{
  const cl_env_ptr the_env = ecl_process_env();
  cl_object p = si_coerce_to_package(pack_name);
  ecl_return1(the_env, ECL_SETQ(the_env, ECL_SYM("*PACKAGE*",45), p));
}

cl_object
cl_find_package(cl_object p)
{
  {
#line 933
	const cl_env_ptr the_env = ecl_process_env();
#line 933
	#line 933
	cl_object __value0 = ecl_find_package_nolock(p);
#line 933
	the_env->nvalues = 1;
#line 933
	the_env->values[0] = __value0;
#line 933
	#line 933
	return __value0;
#line 933
}
;
}

cl_object
cl_package_name(cl_object p)
{
  p = si_coerce_to_package(p);
  return cl_copy_seq(p->pack.name);
}

cl_object
cl_package_nicknames(cl_object p)
{
  p = si_coerce_to_package(p);
  return cl_copy_list(p->pack.nicknames);
}

#line 950
cl_object cl_rename_package(cl_narg narg, cl_object pack, cl_object new_name, ...)
{
#line 950

#line 952
#if defined(__clang__) || defined(__GNUC__)
	__attribute__((unused)) const cl_env_ptr the_env = ecl_process_env();
#else
	const cl_env_ptr the_env = ecl_process_env();
#endif
#line 952
	cl_object new_nicknames;
#line 952
	va_list ARGS;
	va_start(ARGS, new_name);
#line 952
	if (ecl_unlikely(narg < 2|| narg > 3)) FEwrong_num_arguments(ecl_make_fixnum(719));
#line 952
	if (narg > 2) {
#line 952
		new_nicknames = va_arg(ARGS,cl_object);
#line 952
	} else {
#line 952
		new_nicknames = ECL_NIL;
#line 952
	}
#line 952
  /* INV: ecl_rename_package() type checks and coerces pack to package */
  {
#line 953
	#line 953
	cl_object __value0 = ecl_rename_package(pack, new_name, new_nicknames);
#line 953
	the_env->nvalues = 1;
#line 953
	the_env->values[0] = __value0;
#line 953
	va_end(ARGS);
#line 953
	return __value0;
#line 953
}
;
}

cl_object
cl_package_use_list(cl_object p)
{
  return cl_copy_list(si_coerce_to_package(p)->pack.uses);
}

cl_object
cl_package_used_by_list(cl_object p)
{
  return cl_copy_list(si_coerce_to_package(p)->pack.usedby);
}

cl_object
cl_package_shadowing_symbols(cl_object p)
{
  p = si_coerce_to_package(p);
  return cl_copy_list(p->pack.shadowings);
}

cl_object
si_package_lock(cl_object p, cl_object t)
{
  bool previous;
  p = si_coerce_to_package(p);
  previous = p->pack.locked;
  p->pack.locked = (t != ECL_NIL);
  {
#line 982
	const cl_env_ptr the_env = ecl_process_env();
#line 982
	#line 982
	cl_object __value0 = (previous? ECL_T : ECL_NIL);
#line 982
	the_env->nvalues = 1;
#line 982
	the_env->values[0] = __value0;
#line 982
	#line 982
	return __value0;
#line 982
}
;
}

cl_object
si_package_locked_p (cl_object p)
{
  p = si_coerce_to_package(p);
  return (p->pack.locked ? ECL_T : ECL_NIL);
}

/* --- local nicknames ---------------------------------------------------- */
cl_object
si_package_local_nicknames(cl_object p)
{
  p = si_coerce_to_package(p);
  return cl_copy_tree(p->pack.local_nicknames);
}

cl_object
si_package_locally_nicknamed_by_list(cl_object p)
{
  p = si_coerce_to_package(p);
  return cl_copy_list(p->pack.nicknamedby);
}

cl_object
si_add_package_local_nickname(cl_object local_nickname,
                              cl_object actual_package,
                              cl_object target_package) {

  local_nickname = cl_string(local_nickname);
  actual_package = si_coerce_to_package(actual_package);
  target_package = si_coerce_to_package(target_package);

  cl_object existing = target_package->pack.local_nicknames;
  cl_object cell = ecl_assoc(local_nickname, existing);

  if (target_package->pack.locked
      && ECL_SYM_VAL(ecl_process_env(), ECL_SYM("SI::*IGNORE-PACKAGE-LOCKS*",1128)) == ECL_NIL) {
    CEpackage_error("Cannot nickname package ~S from locked package ~S.",
                    "Ignore lock and proceed.",
                    target_package, 2, actual_package, target_package);
  }

  if (!Null(cell)) {
    cl_object old_package = ECL_CONS_CDR(cell);
    if (old_package != actual_package) {
      FEpackage_error("Cannot add ~A as local nickname for ~A:~%"
                      "already a nickname for ~A.",
                      target_package, 3,
                      local_nickname, actual_package, old_package);
    }
    return target_package;
  }

  ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(ecl_process_env()) {
    cl_object nickname_cons = CONS(local_nickname, actual_package);

    target_package->pack.local_nicknames
      = CONS(nickname_cons, target_package->pack.local_nicknames);

    actual_package->pack.nicknamedby
      = CONS(target_package, actual_package->pack.nicknamedby);
  } ECL_WITH_GLOBAL_ENV_WRLOCK_END;

  return target_package;
}

cl_object
si_remove_package_local_nickname(cl_object old_nickname,
                                 cl_object target_package) {
  old_nickname = cl_string(old_nickname);
  target_package = si_coerce_to_package(target_package);

  if (target_package->pack.locked
      && ECL_SYM_VAL(ecl_process_env(),
                     ECL_SYM("SI::*IGNORE-PACKAGE-LOCKS*",1128)) == ECL_NIL) {
    CEpackage_error("Cannot remove local package nickname ~S from locked package ~S.",
                    "Ignore lock and proceed.",
                    target_package, 2, old_nickname, target_package);
  }

  cl_object actual_package = ECL_NIL;
  ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(ecl_process_env()) {
    cl_object cell = ecl_assoc(old_nickname, target_package->pack.local_nicknames);
    if (!Null(cell)) {
      actual_package = ECL_CONS_CDR(cell);
      target_package->pack.local_nicknames
        = ecl_delete_eq(cell, target_package->pack.local_nicknames);
      actual_package->pack.nicknamedby
        = ecl_delete_eq(target_package, actual_package->pack.nicknamedby);
    }
  } ECL_WITH_GLOBAL_ENV_WRLOCK_END;
  return Null(actual_package) ? ECL_NIL : ECL_T;
}
/* ------------------------------------------------------------------------ */

cl_object
cl_list_all_packages()
{
  return cl_copy_list(cl_core.packages);
}

#line 1085
cl_object cl_intern(cl_narg narg, cl_object strng, ...)
{
#line 1085

  int intern_flag;
#line 1088
#if defined(__clang__) || defined(__GNUC__)
	__attribute__((unused)) const cl_env_ptr the_env = ecl_process_env();
#else
	const cl_env_ptr the_env = ecl_process_env();
#endif
#line 1088
	cl_object p;
#line 1088
	cl_object sym;
#line 1088
	va_list ARGS;
	va_start(ARGS, strng);
#line 1088
	if (ecl_unlikely(narg < 1|| narg > 2)) FEwrong_num_arguments(ecl_make_fixnum(444));
#line 1088
	if (narg > 1) {
#line 1088
		p = va_arg(ARGS,cl_object);
#line 1088
	} else {
#line 1088
		p = ecl_current_package();
#line 1088
	}
#line 1088
	sym = ECL_NIL;
#line 1088
  sym = ecl_intern(strng, p, &intern_flag);
  if (intern_flag == ECL_INTERNAL) {
    {
#line 1090
	#line 1090
	cl_object __value0 = sym;
#line 1090
	cl_object __value1 = ECL_SYM(":INTERNAL",1293);
#line 1090
	the_env->nvalues = 2;
#line 1090
	the_env->values[1] = __value1;
#line 1090
	the_env->values[0] = __value0;
#line 1090
	va_end(ARGS);
#line 1090
	return __value0;
#line 1090
}
;
  }
  if (intern_flag == ECL_EXTERNAL) {
    {
#line 1093
	#line 1093
	cl_object __value0 = sym;
#line 1093
	cl_object __value1 = ECL_SYM(":EXTERNAL",1266);
#line 1093
	the_env->nvalues = 2;
#line 1093
	the_env->values[1] = __value1;
#line 1093
	the_env->values[0] = __value0;
#line 1093
	va_end(ARGS);
#line 1093
	return __value0;
#line 1093
}
;
  }
  if (intern_flag == ECL_INHERITED) {
    {
#line 1096
	#line 1096
	cl_object __value0 = sym;
#line 1096
	cl_object __value1 = ECL_SYM(":INHERITED",1285);
#line 1096
	the_env->nvalues = 2;
#line 1096
	the_env->values[1] = __value1;
#line 1096
	the_env->values[0] = __value0;
#line 1096
	va_end(ARGS);
#line 1096
	return __value0;
#line 1096
}
;
  }
  {
#line 1098
	#line 1098
	cl_object __value0 = sym;
#line 1098
	cl_object __value1 = ECL_NIL;
#line 1098
	the_env->nvalues = 2;
#line 1098
	the_env->values[1] = __value1;
#line 1098
	the_env->values[0] = __value0;
#line 1098
	va_end(ARGS);
#line 1098
	return __value0;
#line 1098
}
;
}

#line 1101
cl_object cl_find_symbol(cl_narg narg, cl_object strng, ...)
{
#line 1101

  cl_object x;
  int intern_flag;
#line 1105
#if defined(__clang__) || defined(__GNUC__)
	__attribute__((unused)) const cl_env_ptr the_env = ecl_process_env();
#else
	const cl_env_ptr the_env = ecl_process_env();
#endif
#line 1105
	cl_object p;
#line 1105
	va_list ARGS;
	va_start(ARGS, strng);
#line 1105
	if (ecl_unlikely(narg < 1|| narg > 2)) FEwrong_num_arguments(ecl_make_fixnum(371));
#line 1105
	if (narg > 1) {
#line 1105
		p = va_arg(ARGS,cl_object);
#line 1105
	} else {
#line 1105
		p = ecl_current_package();
#line 1105
	}
#line 1105
  x = ecl_find_symbol(strng, p, &intern_flag);
  if (intern_flag == ECL_INTERNAL) {
    {
#line 1107
	#line 1107
	cl_object __value0 = x;
#line 1107
	cl_object __value1 = ECL_SYM(":INTERNAL",1293);
#line 1107
	the_env->nvalues = 2;
#line 1107
	the_env->values[1] = __value1;
#line 1107
	the_env->values[0] = __value0;
#line 1107
	va_end(ARGS);
#line 1107
	return __value0;
#line 1107
}
;
  }
  if (intern_flag == ECL_EXTERNAL) {
    {
#line 1110
	#line 1110
	cl_object __value0 = x;
#line 1110
	cl_object __value1 = ECL_SYM(":EXTERNAL",1266);
#line 1110
	the_env->nvalues = 2;
#line 1110
	the_env->values[1] = __value1;
#line 1110
	the_env->values[0] = __value0;
#line 1110
	va_end(ARGS);
#line 1110
	return __value0;
#line 1110
}
;
  }
  if (intern_flag == ECL_INHERITED) {
    {
#line 1113
	#line 1113
	cl_object __value0 = x;
#line 1113
	cl_object __value1 = ECL_SYM(":INHERITED",1285);
#line 1113
	the_env->nvalues = 2;
#line 1113
	the_env->values[1] = __value1;
#line 1113
	the_env->values[0] = __value0;
#line 1113
	va_end(ARGS);
#line 1113
	return __value0;
#line 1113
}
;
  }
  {
#line 1115
	#line 1115
	cl_object __value0 = ECL_NIL;
#line 1115
	cl_object __value1 = ECL_NIL;
#line 1115
	the_env->nvalues = 2;
#line 1115
	the_env->values[1] = __value1;
#line 1115
	the_env->values[0] = __value0;
#line 1115
	va_end(ARGS);
#line 1115
	return __value0;
#line 1115
}
;
}

#line 1118
cl_object cl_unintern(cl_narg narg, cl_object symbl, ...)
{
#line 1118

#line 1120
#if defined(__clang__) || defined(__GNUC__)
	__attribute__((unused)) const cl_env_ptr the_env = ecl_process_env();
#else
	const cl_env_ptr the_env = ecl_process_env();
#endif
#line 1120
	cl_object p;
#line 1120
	va_list ARGS;
	va_start(ARGS, symbl);
#line 1120
	if (ecl_unlikely(narg < 1|| narg > 2)) FEwrong_num_arguments(ecl_make_fixnum(884));
#line 1120
	if (narg > 1) {
#line 1120
		p = va_arg(ARGS,cl_object);
#line 1120
	} else {
#line 1120
		p = ecl_current_package();
#line 1120
	}
#line 1120
  {
#line 1120
	#line 1120
	cl_object __value0 = (ecl_unintern(symbl, p) ? ECL_T : ECL_NIL);
#line 1120
	the_env->nvalues = 1;
#line 1120
	the_env->values[0] = __value0;
#line 1120
	va_end(ARGS);
#line 1120
	return __value0;
#line 1120
}
;
}

#line 1123
cl_object cl_export(cl_narg narg, cl_object symbols, ...)
{
#line 1123

#line 1125
#if defined(__clang__) || defined(__GNUC__)
	__attribute__((unused)) const cl_env_ptr the_env = ecl_process_env();
#else
	const cl_env_ptr the_env = ecl_process_env();
#endif
#line 1125
	cl_object pack;
#line 1125
	va_list ARGS;
	va_start(ARGS, symbols);
#line 1125
	if (ecl_unlikely(narg < 1|| narg > 2)) FEwrong_num_arguments(ecl_make_fixnum(346));
#line 1125
	if (narg > 1) {
#line 1125
		pack = va_arg(ARGS,cl_object);
#line 1125
	} else {
#line 1125
		pack = ecl_current_package();
#line 1125
	}
#line 1125
  switch (ecl_t_of(symbols)) {
  case t_symbol:
    cl_export2(symbols, pack);
    break;
  case t_list:
    pack = si_coerce_to_package(pack);
    loop_for_in(symbols) {
      cl_export2(ECL_CONS_CAR(symbols), pack);
    } end_loop_for_in;
    break;
  default:
    FEwrong_type_nth_arg(ecl_make_fixnum(/*EXPORT*/346),1,symbols,
                         cl_list(3,ECL_SYM("OR",616),ECL_SYM("SYMBOL",843),ECL_SYM("LIST",483)));
  }
  {
#line 1139
	#line 1139
	cl_object __value0 = ECL_T;
#line 1139
	the_env->nvalues = 1;
#line 1139
	the_env->values[0] = __value0;
#line 1139
	va_end(ARGS);
#line 1139
	return __value0;
#line 1139
}
;
}

#line 1142
cl_object cl_unexport(cl_narg narg, cl_object symbols, ...)
{
#line 1142

#line 1144
#if defined(__clang__) || defined(__GNUC__)
	__attribute__((unused)) const cl_env_ptr the_env = ecl_process_env();
#else
	const cl_env_ptr the_env = ecl_process_env();
#endif
#line 1144
	cl_object pack;
#line 1144
	va_list ARGS;
	va_start(ARGS, symbols);
#line 1144
	if (ecl_unlikely(narg < 1|| narg > 2)) FEwrong_num_arguments(ecl_make_fixnum(883));
#line 1144
	if (narg > 1) {
#line 1144
		pack = va_arg(ARGS,cl_object);
#line 1144
	} else {
#line 1144
		pack = ecl_current_package();
#line 1144
	}
#line 1144
  switch (ecl_t_of(symbols)) {
  case t_symbol:
    cl_unexport2(symbols, pack);
    break;
  case t_list:
    pack = si_coerce_to_package(pack);
    loop_for_in(symbols) {
      cl_unexport2(ECL_CONS_CAR(symbols), pack);
    } end_loop_for_in;
    break;
  default:
    FEwrong_type_nth_arg(ecl_make_fixnum(/*UNEXPORT*/883),1,symbols,
                         cl_list(3,ECL_SYM("OR",616),ECL_SYM("SYMBOL",843),ECL_SYM("LIST",483)));
  }
  {
#line 1158
	#line 1158
	cl_object __value0 = ECL_T;
#line 1158
	the_env->nvalues = 1;
#line 1158
	the_env->values[0] = __value0;
#line 1158
	va_end(ARGS);
#line 1158
	return __value0;
#line 1158
}
;
}

#line 1161
cl_object cl_import(cl_narg narg, cl_object symbols, ...)
{
#line 1161

#line 1163
#if defined(__clang__) || defined(__GNUC__)
	__attribute__((unused)) const cl_env_ptr the_env = ecl_process_env();
#else
	const cl_env_ptr the_env = ecl_process_env();
#endif
#line 1163
	cl_object pack;
#line 1163
	va_list ARGS;
	va_start(ARGS, symbols);
#line 1163
	if (ecl_unlikely(narg < 1|| narg > 2)) FEwrong_num_arguments(ecl_make_fixnum(433));
#line 1163
	if (narg > 1) {
#line 1163
		pack = va_arg(ARGS,cl_object);
#line 1163
	} else {
#line 1163
		pack = ecl_current_package();
#line 1163
	}
#line 1163
  switch (ecl_t_of(symbols)) {
  case t_symbol:
    cl_import2(symbols, pack);
    break;
  case t_list:
    pack = si_coerce_to_package(pack);
    loop_for_in(symbols) {
      cl_import2(ECL_CONS_CAR(symbols), pack);
    } end_loop_for_in;
    break;
  default:
    FEwrong_type_nth_arg(ecl_make_fixnum(/*IMPORT*/433),1,symbols,
                         cl_list(3,ECL_SYM("OR",616),ECL_SYM("SYMBOL",843),ECL_SYM("LIST",483)));
  }
  {
#line 1177
	#line 1177
	cl_object __value0 = ECL_T;
#line 1177
	the_env->nvalues = 1;
#line 1177
	the_env->values[0] = __value0;
#line 1177
	va_end(ARGS);
#line 1177
	return __value0;
#line 1177
}
;
}

#line 1180
cl_object cl_shadowing_import(cl_narg narg, cl_object symbols, ...)
{
#line 1180

#line 1182
#if defined(__clang__) || defined(__GNUC__)
	__attribute__((unused)) const cl_env_ptr the_env = ecl_process_env();
#else
	const cl_env_ptr the_env = ecl_process_env();
#endif
#line 1182
	cl_object pack;
#line 1182
	va_list ARGS;
	va_start(ARGS, symbols);
#line 1182
	if (ecl_unlikely(narg < 1|| narg > 2)) FEwrong_num_arguments(ecl_make_fixnum(757));
#line 1182
	if (narg > 1) {
#line 1182
		pack = va_arg(ARGS,cl_object);
#line 1182
	} else {
#line 1182
		pack = ecl_current_package();
#line 1182
	}
#line 1182
  switch (ecl_t_of(symbols)) {
  case t_symbol:
    ecl_shadowing_import(symbols, pack);
    break;
  case t_list:
    pack = si_coerce_to_package(pack);
    loop_for_in(symbols) {
      ecl_shadowing_import(ECL_CONS_CAR(symbols), pack);
    } end_loop_for_in;
    break;
  default:
    FEwrong_type_nth_arg(ecl_make_fixnum(/*SHADOWING-IMPORT*/757),1,symbols,
                         cl_list(3,ECL_SYM("OR",616),ECL_SYM("SYMBOL",843),ECL_SYM("LIST",483)));
  }
  {
#line 1196
	#line 1196
	cl_object __value0 = ECL_T;
#line 1196
	the_env->nvalues = 1;
#line 1196
	the_env->values[0] = __value0;
#line 1196
	va_end(ARGS);
#line 1196
	return __value0;
#line 1196
}
;
}

#line 1199
cl_object cl_shadow(cl_narg narg, cl_object symbols, ...)
{
#line 1199

#line 1201
#if defined(__clang__) || defined(__GNUC__)
	__attribute__((unused)) const cl_env_ptr the_env = ecl_process_env();
#else
	const cl_env_ptr the_env = ecl_process_env();
#endif
#line 1201
	cl_object pack;
#line 1201
	va_list ARGS;
	va_start(ARGS, symbols);
#line 1201
	if (ecl_unlikely(narg < 1|| narg > 2)) FEwrong_num_arguments(ecl_make_fixnum(756));
#line 1201
	if (narg > 1) {
#line 1201
		pack = va_arg(ARGS,cl_object);
#line 1201
	} else {
#line 1201
		pack = ecl_current_package();
#line 1201
	}
#line 1201
  switch (ecl_t_of(symbols)) {
#ifdef ECL_UNICODE
  case t_string:
#endif
  case t_base_string:
  case t_symbol:
  case t_character:
    /* Arguments to SHADOW may be: string designators ... */
    ecl_shadow(symbols, pack);
    break;
  case t_list:
    /* ... or lists of string designators */
    pack = si_coerce_to_package(pack);
    loop_for_in(symbols) {
      ecl_shadow(ECL_CONS_CAR(symbols), pack);
    } end_loop_for_in;
    break;
  default:
    FEwrong_type_nth_arg(ecl_make_fixnum(/*SHADOW*/756),1,symbols,
                         cl_list(3,ECL_SYM("OR",616),ECL_SYM("SYMBOL",843),ECL_SYM("LIST",483)));
  }
  {
#line 1222
	#line 1222
	cl_object __value0 = ECL_T;
#line 1222
	the_env->nvalues = 1;
#line 1222
	the_env->values[0] = __value0;
#line 1222
	va_end(ARGS);
#line 1222
	return __value0;
#line 1222
}
;
}

#line 1225
cl_object cl_use_package(cl_narg narg, cl_object pack, ...)
{
#line 1225

#line 1227
#if defined(__clang__) || defined(__GNUC__)
	__attribute__((unused)) const cl_env_ptr the_env = ecl_process_env();
#else
	const cl_env_ptr the_env = ecl_process_env();
#endif
#line 1227
	cl_object pa;
#line 1227
	va_list ARGS;
	va_start(ARGS, pack);
#line 1227
	if (ecl_unlikely(narg < 1|| narg > 2)) FEwrong_num_arguments(ecl_make_fixnum(896));
#line 1227
	if (narg > 1) {
#line 1227
		pa = va_arg(ARGS,cl_object);
#line 1227
	} else {
#line 1227
		pa = ecl_current_package();
#line 1227
	}
#line 1227
  switch (ecl_t_of(pack)) {
  case t_symbol:
  case t_character:
  case t_base_string:
#ifdef ECL_UNICODE
  case t_string:
#endif
  case t_package:
    ecl_use_package(pack, pa);
    break;
  case t_list:
    pa = si_coerce_to_package(pa);
    loop_for_in(pack) {
      ecl_use_package(ECL_CONS_CAR(pack), pa);
    } end_loop_for_in;
    break;
  default:
    FEwrong_type_nth_arg(ecl_make_fixnum(/*USE-PACKAGE*/896), 1, pack,
                         ecl_read_from_cstring("(OR SYMBOL CHARACTER STRING LIST PACKAGE)"));
  }
  {
#line 1247
	#line 1247
	cl_object __value0 = ECL_T;
#line 1247
	the_env->nvalues = 1;
#line 1247
	the_env->values[0] = __value0;
#line 1247
	va_end(ARGS);
#line 1247
	return __value0;
#line 1247
}
;
}

#line 1250
cl_object cl_unuse_package(cl_narg narg, cl_object pack, ...)
{
#line 1250

#line 1252
#if defined(__clang__) || defined(__GNUC__)
	__attribute__((unused)) const cl_env_ptr the_env = ecl_process_env();
#else
	const cl_env_ptr the_env = ecl_process_env();
#endif
#line 1252
	cl_object pa;
#line 1252
	va_list ARGS;
	va_start(ARGS, pack);
#line 1252
	if (ecl_unlikely(narg < 1|| narg > 2)) FEwrong_num_arguments(ecl_make_fixnum(891));
#line 1252
	if (narg > 1) {
#line 1252
		pa = va_arg(ARGS,cl_object);
#line 1252
	} else {
#line 1252
		pa = ecl_current_package();
#line 1252
	}
#line 1252
  switch (ecl_t_of(pack)) {
  case t_symbol:
  case t_character:
  case t_base_string:
#ifdef ECL_UNICODE
  case t_string:
#endif
  case t_package:
    ecl_unuse_package(pack, pa);
    break;
  case t_list:
    pa = si_coerce_to_package(pa);
    loop_for_in(pack) {
      ecl_unuse_package(ECL_CONS_CAR(pack), pa);
    } end_loop_for_in;
    break;
  default:
    FEwrong_type_nth_arg(ecl_make_fixnum(/*UNUSE-PACKAGE*/891), 1, pack,
                         ecl_read_from_cstring("(OR SYMBOL CHARACTER STRING LIST PACKAGE)"));
  }
  {
#line 1272
	#line 1272
	cl_object __value0 = ECL_T;
#line 1272
	the_env->nvalues = 1;
#line 1272
	the_env->values[0] = __value0;
#line 1272
	va_end(ARGS);
#line 1272
	return __value0;
#line 1272
}
;
}

cl_object
si_package_hash_tables(cl_object p)
{
  const cl_env_ptr the_env = ecl_process_env();
  cl_object he, hi, u;
  unlikely_if (!ECL_PACKAGEP(p))
    FEwrong_type_only_arg(ecl_make_fixnum(/*SI::PACKAGE-HASH-TABLES*/1141), p, ecl_make_fixnum(/*PACKAGE*/619));
  ECL_WITH_GLOBAL_ENV_WRLOCK_BEGIN(the_env) {
    he = si_copy_hash_table(p->pack.external);
    hi = si_copy_hash_table(p->pack.internal);
    u = cl_copy_list(p->pack.uses);
  } ECL_WITH_GLOBAL_ENV_WRLOCK_END;
  {
#line 1287
	const cl_env_ptr the_env = ecl_process_env();
#line 1287
	#line 1287
	cl_object __value0 = he;
#line 1287
	cl_object __value1 = hi;
#line 1287
	cl_object __value2 = u;
#line 1287
	the_env->nvalues = 3;
#line 1287
	the_env->values[2] = __value2;
#line 1287
	the_env->values[1] = __value1;
#line 1287
	the_env->values[0] = __value0;
#line 1287
	#line 1287
	return __value0;
#line 1287
}
;
}
