qfrontend.cpp

来自「算断裂的」· C++ 代码 · 共 775 行 · 第 1/2 页

}


 





QMG::FrontEnd::ReturnValType::ReturnValType() {
  nargout_ = -1;
}

QMG::FrontEnd::ReturnValType::~ReturnValType() {
  if (nargout_ >= 0) {
    for (int j = 0; j < nargout_; ++j) {
      if (returnvals_[j]) {
        Tcl_DecrRefCount(returnvals_[j]);
      }
    }
    delete[] returnvals_;
  }
}

void 
QMG::FrontEnd::ReturnValType::verify_nargout(int nargoutmin, 
                                             int nargoutmax, 
                                             const char* routine_name) {
  if (nargout_ != -1)
    throw_error("verify_nargout called twice");
  nargout_ = nargoutmax;
  returnvals_ = new Tcl_Obj*[(nargout_ <= 0)?  1 : nargout_];
  for (int j = 0; j < nargout_; ++j)
    returnvals_[j] = 0;
}

void QMG::FrontEnd::ReturnValType::checkarg_(int idx) {
  if (idx < 0 || idx >= nargout_) 
    throw_error("returnval put called for index out of range");
  if (returnvals_[idx] != 0)
    throw_error("put called twice for same argument");
}


int QMG::FrontEnd::ReturnValType::nargout() const {
  return nargout_;
}


void 
QMG::FrontEnd::ReturnValType::put_simpcomp(int argidx, SimpComplex_Under_Construction& sc) {
#ifdef DEBUGGING
  checkarg_(argidx);
#endif
  Cptc_MshDesc* mesh = sc.release();
  Tcl_Obj* newobj = new_simpcomp_obj(mesh);
  returnvals_[argidx] = newobj;
  Tcl_IncrRefCount(newobj);
}

void 
QMG::FrontEnd::ReturnValType::put_brep(int argidx, Brep_Under_Construction& b) {
#ifdef DEBUGGING
  checkarg_(argidx);
#endif
  Cptc_GeomDesc* geo = b.release();
  Tcl_Obj* newobj = new_brep_obj(geo);
  returnvals_[argidx] = newobj;
  Tcl_IncrRefCount(newobj);
}

void 
QMG::FrontEnd::ReturnValType::put_double(int argidx, double val) {
#ifdef DEBUGGING
  checkarg_(argidx);
#endif
  Tcl_Obj* newobj = Tcl_NewDoubleObj(val);
  returnvals_[argidx] = newobj;
  Tcl_IncrRefCount(newobj);
}

void 
QMG::FrontEnd::ReturnValType::put_int(int argidx, int val) {
#ifdef DEBUGGING
  checkarg_(argidx);
#endif
  Tcl_Obj* newobj = Tcl_NewIntObj(val);
  returnvals_[argidx] = newobj;
  Tcl_IncrRefCount(newobj);
}

void 
QMG::FrontEnd::ReturnValType::put_string(int argidx, const string& s) {
#ifdef DEBUGGING
  checkarg_(argidx);
#endif
  Tcl_Obj* newobj = 
    Tcl_NewStringObj(const_cast<char*>(s.data()), s.length());
  returnvals_[argidx] = newobj;
  Tcl_IncrRefCount(newobj);
}


void 
QMG::FrontEnd::ReturnValType::put_matrix(int argidx, Matrix& m) {
#ifdef DEBUGGING
  checkarg_(argidx);
#endif
  int nr = m.numrows();
  int nc = m.numcols();
  Tcl_Obj** onerow = new Tcl_Obj*[nc];
  Tcl_Obj** rowlist = new Tcl_Obj*[nr];
  for (int i = 0; i < nr; ++i) {
    for (int j = 0; j < nc; ++j)
      onerow[j] = Tcl_NewDoubleObj(m(i,j));
    rowlist[i] = Tcl_NewListObj(nc, onerow);
  }
  Tcl_Obj* newobj = Tcl_NewListObj(nr, rowlist);
  delete[] rowlist;
  delete[] onerow;
  returnvals_[argidx] = newobj;
  Tcl_IncrRefCount(newobj);
}

void 
QMG::FrontEnd::ReturnValType::put_intmatrix(int argidx, IntMatrix& m) {
#ifdef DEBUGGING
  checkarg_(argidx);
#endif
  int nr = m.numrows();
  int nc = m.numcols();
  Tcl_Obj** onerow = new Tcl_Obj*[nc];
  Tcl_Obj** rowlist = new Tcl_Obj*[nr];
  for (int i = 0; i < nr; ++i) {
    for (int j = 0; j < nc; ++j)
      onerow[j] = Tcl_NewIntObj(m(i,j));
    rowlist[i] = Tcl_NewListObj(nc, onerow);
  }
  Tcl_Obj* newobj = Tcl_NewListObj(nr, rowlist);
  delete[] rowlist;
  delete[] onerow;
  returnvals_[argidx] = newobj;
  Tcl_IncrRefCount(newobj);
}

void 
QMG::FrontEnd::ReturnValType::put_intvector(int argidx, vector<int>& m) {
#ifdef DEBUGGING
  checkarg_(argidx);
#endif
  int nr = m.size();
  Tcl_Obj** vec = new Tcl_Obj*[nr];
  for (int i = 0; i < nr; ++i) {
    vec[i] = Tcl_NewIntObj(m[i]);
  }
  Tcl_Obj* newobj = Tcl_NewListObj(nr, vec);
  delete[] vec;
  returnvals_[argidx] = newobj;
  Tcl_IncrRefCount(newobj);
}



void 
QMG::FrontEnd::ReturnValType::put_doublevector(int argidx, vector<double>& m) {
#ifdef DEBUGGING
  checkarg_(argidx);
#endif
  int nr = m.size();
  Tcl_Obj** vec = new Tcl_Obj*[nr];
  for (int i = 0; i < nr; ++i) {
    vec[i] = Tcl_NewDoubleObj(m[i]);
  }
  Tcl_Obj* newobj = Tcl_NewListObj(nr, vec);
  delete[] vec;
  returnvals_[argidx] = newobj;
  Tcl_IncrRefCount(newobj);
}



void QMG::FrontEnd::ReturnValType::set_result(Tcl_Interp* interp) {
#ifdef DEBUGGING
  if (nargout_ < 0)
    throw_error("set_result called when nargout < 0");
  for (int j = 0; j < nargout_; ++j)
    if (!returnvals_[j])
      throw_error("set_result called with an unset return val");
#endif
  if (nargout_ == 0) {
  }
  else if (nargout_ == 1)
    Tcl_SetObjResult(interp, returnvals_[0]);
  else {
    Tcl_Obj* listptr = Tcl_NewListObj(nargout_, returnvals_);
    Tcl_SetObjResult(interp, listptr);
  }
}


namespace {

  using namespace QMG;
  using namespace QMG::FrontEnd;
  using std::streambuf;
#ifndef OLD_STYLE_STREAMBUF
  using std::char_traits;
  typedef char_traits<char> char_traits_char;
  int local_eof() {
    return char_traits_char::eof();
  }
#else
  int local_eof() {
    return EOF;
  }
#endif

  const int STREAMBUF_BUFLEN = 100;
  class TclStreambuf: public streambuf {
  private:
    void put_buffer();
    void put_char(int);
    Tcl_Interp* interp_;
    char my_buffer[STREAMBUF_BUFLEN];
    int buffer_next;
    void print_buffer_();
    bool channel_;
    Tcl_Obj* cmd1_[4];
    Tcl_Obj* cmd2_[4];
    Tcl_Obj* tmp1_;
    Tcl_Obj* tmp2_;
    Tcl_Obj* tmp3_;
  protected:
    int overflow(int);
    int underflow() { return 0; }
    int sync();
  public:
    TclStreambuf(Tcl_Interp* interp, char* channel);
    ~TclStreambuf();
  };
  
  TclStreambuf::TclStreambuf(Tcl_Interp* interp, char* channel) : streambuf(), interp_(interp) {
    setp(0,0);
    setg(0,0,0);
    buffer_next = 0;
    tmp1_= Tcl_NewStringObj("puts", -1);
    Tcl_IncrRefCount(tmp1_);
    tmp2_ = Tcl_NewStringObj("-nonewline", -1);
    Tcl_IncrRefCount(tmp2_);
    if (channel) {
      channel_ = true;
      tmp3_ = Tcl_NewStringObj(channel, -1);
      Tcl_IncrRefCount(tmp3_);
      cmd1_[0] = tmp1_;
      cmd1_[1] = tmp3_;
      cmd2_[0] = tmp1_;
      cmd2_[1] = tmp2_;
      cmd2_[2] = tmp3_;
    }
    else {
      channel_ = false;
      tmp3_ = 0;
      cmd1_[0] = tmp1_;
      cmd2_[0] = tmp1_;
      cmd2_[1] = tmp2_;
    }
  }
  
  
  TclStreambuf::~TclStreambuf() {
    sync();
    Tcl_DecrRefCount(tmp1_);
    Tcl_DecrRefCount(tmp2_);
    if (channel_) {
      Tcl_DecrRefCount(tmp3_);
    }
  }
  
  int TclStreambuf::overflow(int c) {
    put_buffer();
    if (c != local_eof())
      if (pbase() == epptr())
        put_char(c);
      else 
        sputc(c);
      return 0;
  }

  void TclStreambuf::print_buffer_() {
    my_buffer[buffer_next] = 0;
    Tcl_Obj* newcmd;
    if (buffer_next > 0 && my_buffer[buffer_next - 1] == '\n') {
      Tcl_Obj* strobj = Tcl_NewStringObj(my_buffer, buffer_next - 1);
      int p = (channel_)? 2 : 1;
      cmd1_[p] = strobj;
      newcmd = Tcl_NewListObj(p + 1, cmd1_);
    }
    else {
      Tcl_Obj* strobj = Tcl_NewStringObj(my_buffer, buffer_next);
      int p = (channel_)? 3 : 2;
      cmd2_[p] = strobj;
      newcmd = Tcl_NewListObj(p + 1, cmd2_);
    }
    Tcl_IncrRefCount(newcmd);
    Tcl_EvalObj(interp_, newcmd);
    Tcl_DecrRefCount(newcmd);
    buffer_next = 0;
  }

  int TclStreambuf::sync() {
    put_buffer();
    print_buffer_();
    return 0;
  }
  
  void TclStreambuf::put_char(int c) {
    my_buffer[buffer_next++] = c;
    if (buffer_next == STREAMBUF_BUFLEN - 1 || c == '\n' || c == 0) {
      print_buffer_();
    }
  }

  void TclStreambuf::put_buffer() {
    ptrdiff_t len = pptr() - pbase();
    if (len != 0) {
      if (buffer_next + len + 2 > STREAMBUF_BUFLEN) {
        if (buffer_next > 0) {
          print_buffer_();
        }
        int p = (channel_)? 3 : 2;
        cmd2_[p] = Tcl_NewStringObj(pbase(), len);
        Tcl_Obj* newcmd = Tcl_NewListObj(p + 1, cmd2_);
        Tcl_IncrRefCount(newcmd);
        Tcl_EvalObj(interp_, newcmd);
        Tcl_DecrRefCount(newcmd);
      }
      else {
        for (int j = 0; j < len; j++)
          my_buffer[buffer_next++] = pbase()[j];
      }
    }
    setp(pbase(), epptr());
  }
}



QMG::FrontEnd::InterpOStream::InterpOStream(Interpreter& interp1) :
sb_(0), os_(0) {
  Tcl_Interp* interp = interp1.get_interp();
  Tcl_Obj* namePtr = Tcl_NewStringObj("gm_redirect_stdout", -1);
  Tcl_Obj* redirect = Tcl_ObjGetVar2(interp, namePtr, 0, 0);
  char* redirect_chan =  (redirect)?
    Tcl_GetStringFromObj(redirect, 0) : 0;

  sb_ = new TclStreambuf(interp, redirect_chan);
  os_ = new QMG::ostream(sb_);
}

QMG::FrontEnd::InterpOStream::~InterpOStream() {
  if (os_) delete os_;
  if (sb_) delete sb_;
}


// ------------------------------------------------------------------
// qmg_default_tol
// get the default tolerance from global variable gm_default_tol
// ------------------------------------------------------------------

double QMG::FrontEnd::default_tol(Interpreter& interp1) {
  Tcl_Interp* interp = interp1.get_interp();
  Tcl_Obj* namePtr = Tcl_NewStringObj("gm_default_tol", -1);
  Tcl_Obj* default1 = Tcl_ObjGetVar2(interp, namePtr, 0, TCL_GLOBAL_ONLY);
  if (!default1) {
    throw_error("gm_default_tol global variable absent");
  }
  double x;
  int returncode = Tcl_GetDoubleFromObj(interp, default1, &x);
  if (returncode != TCL_OK || x <= 0 || x > 1) {
    throw_error("gm_default_tol not a number or out of range");
    return 0;
  }
  return x;
}