/*
    This file is part of GNU APL, a free implementation of the
    ISO/IEC Standard 13751, "Programming Language APL, Extended"

    Copyright © 2008-2025  Dr. Jürgen Sauermann

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

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

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
*/

/** @file
*/


#include <dlfcn.h>
#include <errno.h>
#include <string.h>

#include "Common.hh"
#include "Error.hh"
#include "NativeFunction.hh"
#include "Symbol.hh"
#include "Workspace.hh"

std::vector<NativeFunction *> NativeFunction::valid_functions;

//----------------------------------------------------------------------------
NativeFunction::NativeFunction(const UCS_string & so_name,
                               const UCS_string & apl_name)
   : Function(ID_USER_SYMBOL, TOK_FUN2),
     handle(0),
     name(apl_name),
     original_so_path(so_name),
     so_path(so_name),
     valid(false),
     close_fun(0)
{
UCS_string t4;
   handle = open_so_file(t4, so_path);
   if (handle == 0)
      {
         MORE_ERROR() << t4;
         return;
      }

   t4 = UCS_ASCII_string("shared library ");
   t4 << so_name << " ";

   // get the function multiplexer
   //
void * fmux = dlsym(handle, "get_function_mux");
     if (!fmux)
        {
          CERR << "shared library " << so_name << " is lacking the mandatory "
                  "function get_function_mux() !" << endl;
          t4 << "is invalid (no get_function_mux())";
          MORE_ERROR() = t4;
          return;
        }

void * (*get_function_mux)(const char *) =
                 reinterpret_cast<void * (*)(const char *)>(fmux);

   // get the mandatory function get_signature() which returns
   //  the function signature
   //
   {
     void * get_sig = get_function_mux("get_signature");
     if (!get_sig)
        {
          CERR << "shared library is lacking the mandatory "
                  "function signature() !" << endl;
          t4 << "is invalid (no get_signature())";
          MORE_ERROR() << t4;
          return;
        }


     signature = reinterpret_cast<Fun_signature (*)()>(get_sig)();
   }

   // get the optional function close_fun(), which is called before
   // this function disappears
   {
     void * cfun = get_function_mux("close_fun");
     if (cfun)   close_fun = reinterpret_cast
                             <bool (*)(Cause, const NativeFunction *)>(cfun);
     else        close_fun = 0;
   }

   // create an entry in the symbol table
   //
Symbol * sym = Workspace::lookup_symbol(apl_name);
   Assert(sym);

const char * why = sym->cant_be_defined();
   if (why)
      {
        MORE_ERROR() << why;
        return;
      }

   /// read function pointers...
   //
#define Th const NativeFunction * th

#define ev(fun, args) \
   f_ ## fun = reinterpret_cast<Token (*) args>(get_function_mux(#fun))

   ev(eval_        , (                                Th));

   ev(eval_B       , (                          Vr B, Th));
   ev(eval_AB      , (Vr A,                     Vr B, Th));
   ev(eval_XB      , (                    Vr X, Vr B, Th));
   ev(eval_AXB     , (Vr A,               Vr X, Vr B, Th));

   ev(eval_LB      , (      Fr LO,              Vr B, Th));
   ev(eval_ALB     , (Vr A, Fr LO,              Vr B, Th));
   ev(eval_LXB     , (      Fr LO,        Vr X, Vr B, Th));
   ev(eval_ALXB    , (Vr A, Fr LO,        Vr X, Vr B, Th));

   ev(eval_LRB     , (      Fr LO, Fr RO,       Vr B, Th));
   ev(eval_LRXB    , (      Fr LO, Fr RO, Vr X, Vr B, Th));
   ev(eval_ALRB    , (Vr A, Fr LO, Fr RO,       Vr B, Th));
   ev(eval_ALRXB   , (Vr A, Fr LO, Fr RO, Vr X, Vr B, Th));

   ev(eval_fill_B  , (                          Vr B, Th));
   ev(eval_fill_AB , (Vr A,                     Vr B, Th));
   ev(eval_ident_Bx, (Vr B,            sAxis x,       Th));
#undef ev

   // compute function tag based on the signature
   //
   if      (signature & SIG_RO)   tag = TOK_OPER2;
   else if (signature & SIG_LO)   tag = TOK_OPER1;
   else if (signature & SIG_B )   tag = TOK_FUN2;
   else                           tag = TOK_FUN0;

   if (is_operator())   sym->set_NC(NC_OPERATOR, this);
   else                 sym->set_NC(NC_FUNCTION, this);

   Workspace::more_error().clear();
   valid = true;
   valid_functions.push_back(this);
}
//----------------------------------------------------------------------------
NativeFunction::~NativeFunction()
{
  Log(LOG_UserFunction__enter_leave)
      get_CERR() << "Native function " << get_name() << " deleted." << endl;

   loop(v, valid_functions.size())
      {
        if (valid_functions[v] == this)
           {
             valid_functions.erase(valid_functions.begin() + v);
           }
      }
}
//----------------------------------------------------------------------------
void *
NativeFunction::try_one_file(const char * filename, UCS_string & t4)
{
const int t4_len = t4.size();
   t4 << "    file " << filename;

   if (access(filename, R_OK) != 0)
      {
        while (t4.ssize() < t4_len + 44)     t4 << UNI_SPACE;
        t4 << " (" << strerror(errno) << ")\n";
        return 0;
      }

void * handle = dlopen(filename, RTLD_LAZY);
   if (handle == 0)
      {
        const char * err = dlerror();
        if (strrchr(err, ':'))   err = 1 + strrchr(err, ':');

        while (t4.ssize() < t4_len + 44)     t4 << UNI_SPACE;
        t4 << " (" << err << " )\n";
      }

   return handle;
}
//----------------------------------------------------------------------------
void *
NativeFunction::open_so_file(UCS_string & t4, UCS_string & so_path)
{
   // prepare a )MORE error message containing the file names tried.
   //
   t4.clear();
   t4 << "Could not find shared library '" << so_path << "'\n"
         "The following directories and file names were tried:\n";

   // if the name starts with / (or \ on Windows) or .
   // then take it as is without changes.
   //
   if (so_path[0] == UNI_SLASH     ||
       so_path[0] == UNI_BACKSLASH ||
       so_path[0] == UNI_FULLSTOP)
      {
        UTF8_string filename(so_path);
        void * handle = try_one_file(filename.c_str(), t4);

        if (handle == 0)
           {
             t4 << "NOTE: Filename extensions are NOT automatically added "
                   "when a full path\n"
                   "      (i.e. a path starting with / or .) is used.";
           }
        return handle;
      }

   // otherwise try apl_DIR__pkglib, /usr/lib/apl and /usr/local/lib/apl,
   // avoiding duplicates
   //
UTF8_string utf_so_path(so_path);
const char * dirs[] =
{
  apl_DIR__pkglib,    // the normal case
  "/usr/lib/apl",
  "/usr/local/lib/apl",
  ".",
  "./native",             // if make install was not performed
  "./emacs_mode",         // if make install was not performed
};

   // most likely apl_DIR__pkglib is /usr/lib/apl or /usr/local/lib/apl.
   // don't try them twice.
   //
   if (!strcmp(apl_DIR__pkglib, dirs[1]))   dirs[1] = 0;
   if (!strcmp(apl_DIR__pkglib, dirs[2]))   dirs[2] = 0;

   loop(d, sizeof(dirs) / sizeof(*dirs))
       {
         if (dirs[d] == 0)   continue;

         UTF8_string dir_so_path(dirs[d]);
         dir_so_path += '/';
         dir_so_path << utf_so_path;

         UTF8_string dir_only(dir_so_path);
         dir_only[strrchr(dir_only.c_str(), '/') - dir_only.c_str()] = 0;
         if (access(dir_only.c_str(), R_OK | X_OK))
            {
              t4 << "    directory " << dir_only << UNI_LF;
              continue;   // new directory
            }

         // try filename, then filename.so, and then filename.dylib
         // unless the filename has an extension already.
         //
         const char * exts[] = { ".so", ".dylib", "" };

         bool has_extension = false;
         loop(e, sizeof(exts)/sizeof(*exts))
            {
              if (*exts[e])   // not "no extension"
                 {
                   const char * ext = exts[e];
                   const char * end = dir_so_path.c_str();
                   end += strlen(end) - strlen(ext);
                   if (!strcmp(exts[e],  end))
                      {
                        has_extension = true;
                        break;
                      }
                 }
            }

         loop(e, sizeof(exts)/sizeof(*exts))
             {
               if (has_extension && *exts[e])   continue;

               UTF8_string filename(dir_so_path);
               if (exts[e])   filename << UTF8_string(exts[e]);

               void * handle = try_one_file(filename.c_str(), t4);
               if (handle)   // found library
                  {
                    so_path = UCS_string(filename);   // update so_path
                    return handle;
                  }
             }
       }

   return 0;
}
//----------------------------------------------------------------------------
void
NativeFunction::cleanup()
{
   // delete in reverse construction order
   //
   while(valid_functions.size())
      {
        NativeFunction * fun = valid_functions.back();
        valid_functions.pop_back();

        if (fun->close_fun && fun->handle)
           {
             const bool do_dlclose = (*fun->close_fun)(CAUSE_SHUTDOWN, fun);
             if (do_dlclose)
                {
                  dlclose(fun->handle);
                  fun->handle = 0;
                }
           }

        // don't delete fun since this will be done when the symbol for the
        // fun is being deleted
      }
}
//----------------------------------------------------------------------------
void
NativeFunction::destroy()
{
   if (close_fun && handle)
      {
        const bool do_dlclose = (*close_fun)(CAUSE_ERASED, this);
        if (do_dlclose)
           {
             dlclose(handle);
             handle = 0;
             close_fun = 0;
           }
      }
   else if (handle)
      {
        dlclose(handle);
        handle = 0;
      }

   delete this;
}
//----------------------------------------------------------------------------
NativeFunction *
NativeFunction::fix(const UCS_string & so_name,
                    const UCS_string & function_name)
{
   // if the function already exists then return it.
   //
   loop(v, valid_functions.size())
      {
        NativeFunction * fun = valid_functions[v];
        if (so_name == fun->so_path)
           {
             // the NativeFunction object exists, but may have been
             // )ERASEd at APL level. If so, then re-install it.
             //
             Symbol * sym = Workspace::lookup_symbol(fun->get_name());
             Assert(sym);

             const char * why = sym->cant_be_defined();
             if (why)
                {
                  MORE_ERROR() << why;
                  return 0;
                }

             if (fun->is_operator())   sym->set_NC(NC_OPERATOR, fun);
             else                      sym->set_NC(NC_FUNCTION, fun);
             return fun;
           }
      }

NativeFunction * new_function = new NativeFunction(so_name, function_name);
   Log(LOG_delete)
      CERR << "new    " << voidP(new_function) << " at " LOC << endl;


   if (!new_function->valid)   // something went wrong
      {
        Log(LOG_delete)
          CERR << "delete " << voidP(new_function) << " at " LOC << endl;
        delete new_function;
        return 0;
      }

   return new_function;
}
//----------------------------------------------------------------------------
bool
NativeFunction::has_result() const
{
   return signature & SIG_Z;
}
//----------------------------------------------------------------------------
bool
NativeFunction::is_operator() const
{
   // this function is an operator if one of the eval functions with a
   // function argument is present...
   //
   return f_eval_LB
       || f_eval_ALB
       || f_eval_LRB
       || f_eval_ALRB
       || f_eval_LXB
       || f_eval_ALXB
       || f_eval_LRXB
       || f_eval_ALRXB;
}
//----------------------------------------------------------------------------
void
NativeFunction::print_properties(ostream & out, int indent) const
{
UCS_string ind(indent, UNI_SPACE);
   out << ind << "Native Function " << endl;
}
//----------------------------------------------------------------------------
UCS_string
NativeFunction::canonical(bool with_lines) const
{
   return original_so_path;
}
//----------------------------------------------------------------------------
ostream &
NativeFunction::print(std::ostream & out) const
{
   if (is_operator())   out << "native Operator " << name << endl;
   else                 out << "native Function " << name << endl;

   return out;
}
//----------------------------------------------------------------------------
UCS_string
NativeFunction::load_emacs_library(const char * emacs_arg)
{
UCS_string so_path(U"libemacs");
UCS_string t4;

void * handle = open_so_file(t4, so_path);
   if (handle == 0)   return t4;

   t4 = UCS_ASCII_string("found emacs library ");
   t4 << so_path;

void * emacs_start = dlsym(handle, "emacs_start");
   if (emacs_start == 0)
      {
        t4 << ", but it\n   it is lacking the mandatory "
                       "function emacs_start()\n";
        return t4;
      }

UTF8_string so_path_utf(so_path);
const int error =
    reinterpret_cast<int (*)(const char *, const char *)>(emacs_start)
            (emacs_arg, charP(so_path_utf.c_str()));

   if (error)
      {
        return t4 << ", but emacs_start()  returned error " << error << UNI_LF;
      }

   t4.clear();   // success
   return t4;
}
//----------------------------------------------------------------------------
Token
NativeFunction::eval_() const
{
   if (f_eval_)   return (*f_eval_)(this);

   SYNTAX_ERROR;
}
//----------------------------------------------------------------------------
Token
NativeFunction::eval_B(Value_P B) const
{
   if (f_eval_B)   return (*f_eval_B)(B, this);

   SYNTAX_ERROR;
}
//----------------------------------------------------------------------------
Token
NativeFunction::eval_AB(Value_P A, Value_P B) const
{
   if (f_eval_AB)   return (*f_eval_AB)(A, B, this);

   SYNTAX_ERROR;
}
//----------------------------------------------------------------------------
Token
NativeFunction::eval_LB(Token & LO, Value_P B) const
{
   if (f_eval_LB)   return (*f_eval_LB)(*LO.get_function(), B, this);

   SYNTAX_ERROR;
}
//----------------------------------------------------------------------------
Token
NativeFunction::eval_ALB(Value_P A, Token & LO, Value_P B) const
{
   if (f_eval_ALB)   return (*f_eval_ALB)(A, *LO.get_function(), B, this);

   SYNTAX_ERROR;
}
//----------------------------------------------------------------------------
Token
NativeFunction::eval_LRB(Token & LO, Token & RO, Value_P B) const
{
   if (f_eval_LRB)   return (*f_eval_LRB)(*LO.get_function(),
                                          *RO.get_function(), B, this);

   SYNTAX_ERROR;
}
//----------------------------------------------------------------------------
Token
NativeFunction::eval_ALRB(Value_P A, Token & LO, Token & RO, Value_P B) const
{
   if (f_eval_ALRB)   return (*f_eval_ALRB)(A, *LO.get_function(),
                                               *RO.get_function(), B, this);

   SYNTAX_ERROR;
}
//----------------------------------------------------------------------------
Token
NativeFunction::eval_XB(Value_P X, Value_P B) const
{
   // call axis variant if present, or else the non-axis variant.
   //
   if (f_eval_XB)   return (*f_eval_XB)(X, B, this);
   else             return eval_B(B);
}
//----------------------------------------------------------------------------
Token
NativeFunction::eval_AXB(Value_P A, Value_P X, Value_P B) const
{
   // call axis variant if present, or else the non-axis variant.
   //
   if (f_eval_AXB)   return (*f_eval_AXB)(A, X, B, this);
   else              return eval_AB(A, B);
}
//----------------------------------------------------------------------------
Token
NativeFunction::eval_LXB(Token & LO, Value_P X, Value_P B) const
{
   // call axis variant if present, or else the non-axis variant.
   //
   if (f_eval_LXB)   return (*f_eval_LXB)(*LO.get_function(), X, B, this);
   else              return eval_LB(LO, B);
}
//----------------------------------------------------------------------------
Token
NativeFunction::eval_ALXB(Value_P A, Token & LO, Value_P X, Value_P B) const
{
   // call axis variant if present, or else the non-axis variant.
   //
   if (f_eval_ALXB)   return (*f_eval_ALXB)(A, *LO.get_function(), X, B, this);
   else               return eval_ALB(A, LO, B);
}
//----------------------------------------------------------------------------
Token
NativeFunction::eval_LRXB(Token & LO, Token & RO, Value_P X, Value_P B) const
{
   // call axis variant if present, or else the non-axis variant.
   //
   if (f_eval_LRXB)   return (*f_eval_LRXB)(*LO.get_function(),
                                            *RO.get_function(), X, B, this);
   else                return eval_LRB(LO, RO, B);
}
//----------------------------------------------------------------------------
Token
NativeFunction::eval_ALRXB(Value_P A, Token & LO, Token & RO, Value_P X,
                           Value_P B) const
{
   // call axis variant if present, or else the non-axis variant.
   //
   if (f_eval_ALRXB)
      return (*f_eval_ALRXB)(A, *LO.get_function(), *RO.get_function(),
                             X, B, this);
   return eval_ALRB(A, LO, RO, B);
}
//----------------------------------------------------------------------------
Token
NativeFunction::eval_fill_B(Value_P B) const
{
   if (f_eval_fill_B)   return (*f_eval_fill_B)(B, this);

   SYNTAX_ERROR;
}
//----------------------------------------------------------------------------
Token
NativeFunction::eval_fill_AB(Value_P A, Value_P B) const
{
   if (f_eval_fill_AB)   return (*f_eval_fill_AB)(A, B, this);

   SYNTAX_ERROR;
}
//----------------------------------------------------------------------------
Token
NativeFunction::eval_identity_fun(Value_P B, sAxis axis) const
{
   if (f_eval_ident_Bx)   return (*f_eval_ident_Bx)(B, axis, this);

   SYNTAX_ERROR;
}
//----------------------------------------------------------------------------

