// --------------------------------------------------------------------------- // - Interp.cpp - // - afnix engine - interpreter class implementation - // --------------------------------------------------------------------------- // - This program is free software; you can redistribute it and/or modify - // - it provided that this copyright notice is kept intact. - // - - // - 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. In no event shall - // - the copyright holder be liable for any direct, indirect, incidental or - // - special damages arising in any way out of the use of this software. - // --------------------------------------------------------------------------- // - copyright (c) 1999-2007 amaury darsch - // --------------------------------------------------------------------------- #include "Set.hpp" #include "Enum.hpp" #include "Byte.hpp" #include "Real.hpp" #include "Meta.hpp" #include "List.hpp" #include "Heap.hpp" #include "Queue.hpp" #include "Mutex.hpp" #include "Regex.hpp" #include "Plist.hpp" #include "Thread.hpp" #include "Logger.hpp" #include "Interp.hpp" #include "Return.hpp" #include "Reader.hpp" #include "Module.hpp" #include "System.hpp" #include "Method.hpp" #include "BitSet.hpp" #include "Symbol.hpp" #include "Lexical.hpp" #include "Relatif.hpp" #include "Condvar.hpp" #include "Library.hpp" #include "Printer.hpp" #include "Builtin.hpp" #include "Boolean.hpp" #include "Closure.hpp" #include "Instance.hpp" #include "Librarian.hpp" #include "Function.hpp" #include "Character.hpp" #include "HashTable.hpp" #include "QuarkZone.hpp" #include "Exception.hpp" #include "PrintTable.hpp" namespace afnix { // ------------------------------------------------------------------------- // - private section - // ------------------------------------------------------------------------- // this procedure initialize the interpreter global nameset static void gset_init (Interp* interp) { // initialize the global set Nameset* nset = interp->getgset (); // bind standard constants nset->symcst ("...", nset); nset->symcst ("nil", (Object*) nilp); nset->symcst ("true", new Boolean (true)); nset->symcst ("false", new Boolean (false)); nset->symcst ("interp", interp); // builtin functions interp->mkrsv ("if", new Function (builtin_if)); interp->mkrsv ("do", new Function (builtin_do)); interp->mkrsv ("for", new Function (builtin_for)); interp->mkrsv ("try", new Function (builtin_try)); interp->mkrsv ("eval", new Function (builtin_eval)); interp->mkrsv ("sync", new Function (builtin_sync)); interp->mkrsv ("loop", new Function (builtin_loop)); interp->mkrsv ("enum", new Function (builtin_enum)); interp->mkrsv ("const", new Function (builtin_const)); interp->mkrsv ("trans", new Function (builtin_trans)); interp->mkrsv ("class", new Function (builtin_class)); interp->mkrsv ("block", new Function (builtin_block)); interp->mkrsv ("while", new Function (builtin_while)); interp->mkrsv ("gamma", new Function (builtin_gamma)); interp->mkrsv ("throw", new Function (builtin_throw)); interp->mkrsv ("force", new Function (builtin_force)); interp->mkrsv ("delay", new Function (builtin_delay)); interp->mkrsv ("lambda", new Function (builtin_lambda)); interp->mkrsv ("switch", new Function (builtin_switch)); interp->mkrsv ("return", new Function (builtin_return)); interp->mkrsv ("launch", new Function (builtin_launch)); interp->mkrsv ("daemon", new Function (builtin_daemon)); interp->mkrsv ("protect", new Function (builtin_protect)); interp->mkrsv ("nameset", new Function (builtin_nameset)); // builtin operators interp->mkrsv ("+", new Function (builtin_add)); interp->mkrsv ("-", new Function (builtin_sub)); interp->mkrsv ("*", new Function (builtin_mul)); interp->mkrsv ("/", new Function (builtin_div)); interp->mkrsv ("==", new Function (builtin_eql)); interp->mkrsv ("!=", new Function (builtin_neq)); interp->mkrsv (">=", new Function (builtin_geq)); interp->mkrsv (">", new Function (builtin_gth)); interp->mkrsv ("<=", new Function (builtin_leq)); interp->mkrsv ("<", new Function (builtin_lth)); interp->mkrsv ("assert", new Function (builtin_assert)); // logical operators interp->mkrsv ("or", new Function (builtin_or)); interp->mkrsv ("not", new Function (builtin_not)); interp->mkrsv ("and", new Function (builtin_and)); // standard printer objects interp->mkrsv ("print", new Printer (Printer::OUTPUT)); interp->mkrsv ("println", new Printer (Printer::OUTPUTLN)); interp->mkrsv ("error", new Printer (Printer::ERROR)); interp->mkrsv ("errorln", new Printer (Printer::ERRORLN)); // standard predicates interp->mkrsv ("nil-p", new Function (builtin_nilp)); interp->mkrsv ("set-p", new Function (builtin_setp)); interp->mkrsv ("eval-p", new Function (builtin_evlp)); interp->mkrsv ("cons-p", new Function (builtin_consp)); interp->mkrsv ("list-p", new Function (builtin_listp)); interp->mkrsv ("byte-p", new Function (builtin_bytep)); interp->mkrsv ("real-p", new Function (builtin_realp)); interp->mkrsv ("enum-p", new Function (builtin_enump)); interp->mkrsv ("item-p", new Function (builtin_itemp)); interp->mkrsv ("hash-p", new Function (builtin_hashp)); interp->mkrsv ("heap-p", new Function (builtin_heapp)); interp->mkrsv ("regex-p", new Function (builtin_regexp)); interp->mkrsv ("queue-p", new Function (builtin_queuep)); interp->mkrsv ("class-p", new Function (builtin_clsp)); interp->mkrsv ("plist-p", new Function (builtin_plistp)); interp->mkrsv ("string-p", new Function (builtin_strp)); interp->mkrsv ("thread-p", new Function (builtin_thrp)); interp->mkrsv ("vector-p", new Function (builtin_vecp)); interp->mkrsv ("bitset-p", new Function (builtin_bitsp)); interp->mkrsv ("number-p", new Function (builtin_nump)); interp->mkrsv ("symbol-p", new Function (builtin_symp)); interp->mkrsv ("logger-p", new Function (builtin_logp)); interp->mkrsv ("lexical-p", new Function (builtin_lexp)); interp->mkrsv ("condvar-p", new Function (builtin_condp)); interp->mkrsv ("promise-p", new Function (builtin_prmp)); interp->mkrsv ("boolean-p", new Function (builtin_boolp)); interp->mkrsv ("integer-p", new Function (builtin_intp)); interp->mkrsv ("relatif-p", new Function (builtin_rltp)); interp->mkrsv ("literal-p", new Function (builtin_litp)); interp->mkrsv ("closure-p", new Function (builtin_clop)); interp->mkrsv ("nameset-p", new Function (builtin_nstp)); interp->mkrsv ("instance-p", new Function (builtin_instp)); interp->mkrsv ("resolver-p", new Function (builtin_rslvp)); interp->mkrsv ("property-p", new Function (builtin_propp)); interp->mkrsv ("hashtable-p", new Function (builtin_ashp)); interp->mkrsv ("character-p", new Function (builtin_charp)); interp->mkrsv ("qualified-p", new Function (builtin_qualp)); interp->mkrsv ("librarian-p", new Function (builtin_lbrnp)); interp->mkrsv ("print-table-p", new Function (builtin_ptblp)); // standard objects interp->mkrsv ("Set", new Meta (Set::mknew)); interp->mkrsv ("Enum", new Meta (Enum::mknew)); interp->mkrsv ("Byte", new Meta (Byte::mknew)); interp->mkrsv ("Real", new Meta (Real::mknew)); interp->mkrsv ("Cons", new Meta (Cons::mknew)); interp->mkrsv ("List", new Meta (List::mknew)); interp->mkrsv ("Heap", new Meta (Heap::mknew)); interp->mkrsv ("Regex", new Meta (Regex::mknew)); interp->mkrsv ("Queue", new Meta (Queue::mknew)); interp->mkrsv ("Plist", new Meta (Plist::mknew)); interp->mkrsv ("String", new Meta (String::mknew)); interp->mkrsv ("Buffer", new Meta (Buffer::mknew)); interp->mkrsv ("Vector", new Meta (Vector::mknew)); interp->mkrsv ("BitSet", new Meta (BitSet::mknew)); interp->mkrsv ("Symbol", new Meta (Symbol::mknew)); interp->mkrsv ("Logger", new Meta (Logger::mknew)); interp->mkrsv ("Lexical", new Meta (Lexical::mknew)); interp->mkrsv ("Condvar", new Meta (Condvar::mknew)); interp->mkrsv ("Relatif", new Meta (Relatif::mknew)); interp->mkrsv ("Integer", new Meta (Integer::mknew)); interp->mkrsv ("Boolean", new Meta (Boolean::mknew)); interp->mkrsv ("Closure", new Meta (Closure::mknew)); interp->mkrsv ("Instance", new Meta (Instance::mknew)); interp->mkrsv ("Resolver", new Meta (Resolver::mknew)); interp->mkrsv ("Property", new Meta (Property::mknew)); interp->mkrsv ("Character", new Meta (Character::mknew)); interp->mkrsv ("HashTable", new Meta (HashTable::mknew)); interp->mkrsv ("Librarian", new Meta (Librarian::mknew)); interp->mkrsv ("PrintTable", new Meta (PrintTable::mknew)); } // ------------------------------------------------------------------------- // - public section - // ------------------------------------------------------------------------- // the options messages static const String U_CLS_MSG = "axi [options] [file] [arguments]"; static const String H_OPT_MSG = " [h] \t print this help message"; static const String V_OPT_MSG = " [v] \t print system version"; static const String I_OPT_MSG = " [i path]\t add a resolver path"; static const String E_OPT_MSG = " [e mode]\t force the encoding mode"; static const String F_ASR_MSG = " [f assert]\t enable assertion checks"; static const String F_NOP_MSG = " [f nopath]\t do not set initial path"; // get an interpreter option class Options* Interp::getopts (void) { // create the option class Options* opts = new Options (U_CLS_MSG); // add the list options opts->add ('f', "nopath", F_NOP_MSG); opts->add ('f', "assert", F_ASR_MSG); // add the string options opts->add (Options::SOPT, 'e', E_OPT_MSG); opts->add (Options::VOPT, 'i', I_OPT_MSG); // add the uniq options opts->add (Options::UNIQ, 'v', V_OPT_MSG); opts->add (Options::UNIQ, 'h', H_OPT_MSG); // set the debug flag and return opts->setdbg ('f', "assert"); return opts; } // ------------------------------------------------------------------------- // - class section - // ------------------------------------------------------------------------- // create a default interpreter Interp::Interp (void) { // initialize default values d_assert = false; d_cloned = false; d_next = false; // create a default terminal Object::iref (p_term = new Terminal); // save streams Object::iref (p_is = p_term); Object::iref (p_os = p_term); Object::iref (p_es = new OutputTerm (OutputTerm::ERROR)); // clear the post object p_posted = nilp; // initialize the arguments vector Object::iref (p_argv = new Vector); // initialize the resolver Object::iref (p_rslv = new Resolver); // initialize the global nameset Object::iref (p_gset = new Superset); gset_init (this); // create the execution stack p_stk = new Stack; // reset the runnable form p_rform = nilp; // create the library loader Object::iref (p_shld = new Loader); // bind the main thread Thread::setrobj (this); } // create a new interpreter with or without a terminal Interp::Interp (const bool tflg) { // initialize default values d_assert = false; d_cloned = false; d_next = false; // set the streams if (tflg == true) { Object::iref (p_term = new Terminal); Object::iref (p_is = p_term); Object::iref (p_os = p_term); Object::iref (p_es = new OutputTerm (OutputTerm::ERROR)); } else { p_term = nilp; p_is = nilp; p_os = nilp; p_es = nilp; } // clear the post object p_posted = nilp; // initialize the arguments vector Object::iref (p_argv = new Vector); // initialize the resolver Object::iref (p_rslv = new Resolver); // initialize the global nameset Object::iref (p_gset = new Superset); gset_init (this); // create the execution stack p_stk = new Stack; // reset the runnable form p_rform = nilp; // create the libary loader Object::iref (p_shld = new Loader); // bind the main thread Thread::setrobj (this); } // create a new interpreter with the specified streams Interp::Interp (Input* is, Output* os, Output* es) { // initialize default values d_assert = false; d_cloned = false; d_next = false; p_term = nilp; // save streams Object::iref (p_is = is); Object::iref (p_os = os); Object::iref (p_es = es); // clear the post object p_posted = nilp; // initialize the arguments vector Object::iref (p_argv = new Vector); // initialize the resolver Object::iref (p_rslv = new Resolver); // initialize the global nameset Object::iref (p_gset = new Superset); gset_init (this); // create the execution stack p_stk = new Stack; // reset the runnable form p_rform = nilp; // create the libary loader Object::iref (p_shld = new Loader); // bind the main thread Thread::setrobj (this); } // copy constructor Interp::Interp (const Interp& that) { // initialize default value d_assert = that.d_assert; d_cloned = true; d_next = false; // copy the terminal Object::iref (p_term = that.p_term); // copy the streams Object::iref (p_is = that.p_is); Object::iref (p_os = that.p_os); Object::iref (p_es = that.p_es); // clear the post object p_posted = nilp; // copy the vector arguments Object::iref (p_argv = that.p_argv); // copy the file path Object::iref (p_rslv = that.p_rslv); // copy the global nameset Object::iref (p_gset = that.p_gset); // create the execution stack p_stk = new Stack; // reset the runnable form p_rform = nilp; // copy the library loader Object::iref (p_shld = that.p_shld); } // delete this interpreter Interp::~Interp (void) { // protect us Object::iref (this); // clear the posted object Object::dref (p_posted); p_posted = nilp; // eventually reset the globalset if (d_cloned == false) p_gset->reset (); // clean the objects first Object::dref (p_is); Object::dref (p_os); Object::dref (p_es); Object::dref (p_term); Object::dref (p_gset); Object::dref (p_argv); Object::dref (p_rslv); Object::dref (p_rform); Object::dref (p_shld); // clean the rest delete p_stk; } // return the class name String Interp::repr (void) const { return "Interp"; } // make this interpreter a shared object void Interp::mksho (void) { if (p_shared != nilp) return; Object::mksho (); if (p_term != nilp) p_term->mksho (); if (p_is != nilp) p_is->mksho (); if (p_os != nilp) p_os->mksho (); if (p_es != nilp) p_es->mksho (); if (p_argv != nilp) p_argv->mksho (); if (p_rslv != nilp) p_rslv->mksho (); if (p_gset != nilp) p_gset->mksho (); if (p_shld != nilp) p_shld->mksho (); } // post an object in this interpreter void Interp::post (Object* object) { if (object == p_posted) return; Object::iref (object); Object::dref (p_posted); p_posted = object; } // clone this interpreter Object* Interp::clone (void) { return new Interp (*this); } // duplicate this interpreter and set the runnable form Interp* Interp::dup (Object* form) const { Interp* interp = new Interp (*this); interp->p_rform = Object::iref (form); return interp; } // duplicate this stream by setting the terminal Interp* Interp::dup (Terminal* term) const { Interp* interp = new Interp (*this); // check that we have a valid terminal if (term == nilp) term = new Terminal; // update the terminal and the other stream Object::iref (term); Object::dref (interp->p_term); interp->p_term = term; // update the input stream Object::iref (term); Object::dref (interp->p_is); interp->p_is = term; // update the output stream Object::iref (term); Object::dref (interp->p_os); interp->p_os = term; // update the error stream Object::iref (term); Object::dref (interp->p_es); interp->p_es = term; // the new interpeter return interp; } // duplicate this interpreter withthe associated stream Interp* Interp::dup (Input* is, Output* os, Output*es) const { Interp* interp = new Interp (*this); // update the input stream if (is != nilp) { Object::iref (is); Object::dref (interp->p_is); interp->p_is = is; } // update the output stream if (os != nilp) { Object::iref (os); Object::dref (interp->p_os); interp->p_os = os; } // update the output stream if (es != nilp) { Object::iref (es); Object::dref (interp->p_es); interp->p_es = es; } return interp; } // evaluate the runnable form Object* Interp::run (void) { Object* result = nilp; try { result = (p_rform == nilp) ? nilp : p_rform->eval (this, p_gset); } catch (const Exception& e) { getes()->errorln (e); if (e.getabf () == true) Thread::exit (); } catch (const Return& r) { result = r.getobj (); } catch (...) { getes()->errorln ("fatal: unknown exception trapped"); result = nilp; } this->post (result); return result; } // execute a form in a thread by cloning this interpreter Object* Interp::launch (Object* form) { // mark everything shared mksho (); // make the form a shared object if (form != nilp) form->mksho (); // create a new thread Interp* interp = dup (form); return new Thread (Thread::NORMAL, interp); } // execute a form in a daemon thread by cloning this interpreter Object* Interp::daemon (Object* form) { // mark everything shared mksho (); // make the form a shared object if (form != nilp) form->mksho (); // create a new thread Interp* interp = dup (form); return new Thread (Thread::DAEMON, interp); } // return the interpreter input stream Input* Interp::getis (void) const { wrlock (); if (p_is != nilp) { unlock (); return p_is; } Object::iref (p_is = new InputTerm); p_is->setemod (d_emod); unlock (); return p_is; } // return the interpreter output stream Output* Interp::getos (void) const { wrlock (); if (p_os != nilp) { unlock (); return p_os; } Object::iref (p_os = new OutputTerm (OutputTerm::OUTPUT)); p_os->setemod (d_emod); unlock (); return p_os; } // return the interpreter error stream Output* Interp::getes (void) const { wrlock (); if (p_es != nilp) { unlock (); return p_es; } Object::iref (p_es = new OutputTerm (OutputTerm::ERROR)); p_es->setemod (d_emod); unlock (); return p_es; } // set the primary prompt void Interp::setpp (const String& value) { wrlock (); if (p_term != nilp) p_term->setpp (value); unlock (); } // get the primary prompt String Interp::getpp (void) const { rdlock (); String result; if (p_term != nilp) result = p_term->getpp (); unlock (); return result; } // set the secondary prompt void Interp::setsp (const String& value) { wrlock (); if (p_term != nilp) p_term->setsp (value); unlock (); } // get the secondary prompt String Interp::getsp (void) const { rdlock (); String result; if (p_term != nilp) result = p_term->getsp (); unlock (); return result; } // set the interpreter encoding mode void Interp::setemod (const String& emod) { wrlock (); try { // save the encodig mode d_emod = emod; // set the terminal if (p_term != nilp) p_term->Input::setemod (emod); if (p_term != nilp) p_term->Output::setemod (emod); // set the base streams if (p_is != nilp) p_is->setemod (emod); if (p_os != nilp) p_os->setemod (emod); if (p_es != nilp) p_es->setemod (emod); } catch (...) { unlock (); throw; } } // return the interpreter stack Stack* Interp::getstk (void) const { return p_stk; } // return the interpreter global nameset Nameset* Interp::getgset (void) const { return p_gset; } // set the assert flag void Interp::setasrt (const bool flag) { wrlock (); d_assert = flag; unlock (); } // return the assert flag bool Interp::getasrt (void) const { rdlock (); bool result = d_assert; unlock (); return result; } // set the interpreter arguments void Interp::setargs (const Strvec& args) { wrlock (); try { // reset the vector p_argv->reset (); // fill in the arguments long len = args.length (); for (long i = 0; i < len; i++) { p_argv->append (new String (args.get (i))); } } catch (...) { unlock (); throw; } } // get the interpreter arguments Strvec Interp::getargs (void) const { rdlock (); try { Strvec result; long len = p_argv->length (); for (long i = 0; i < len; i++) { String* str = dynamic_cast (p_argv->get (i)); if (str == nilp) continue; result.add (*str); } return result; } catch (...) { unlock (); throw; } } // add a new path entry in the resolver void Interp::addpath (const String& path) { wrlock (); try { p_rslv->add (path); } catch (...) { unlock (); throw; } } // set the path resolver void Interp::setpath (const Strvec& path) { wrlock (); try { long len = path.length (); for (long i = 0; i < len; i++) p_rslv->add (path.get (i)); } catch (...) { unlock (); throw; } } // create a new reserved entry in the global nameset void Interp::mkrsv (const String& name, Object* object) { wrlock (); try { p_gset->symcst (name, object); Token::mkrsv (name); } catch (...) { unlock (); throw; } } // create a child nameset by name Nameset* Interp::mknset (const String& name) { wrlock (); try { Nameset* result = p_gset->mknset (name); unlock (); return result; } catch (...) { unlock (); throw; } } // return the interpreter loader Loader* Interp::getld (void) const { return p_shld; } // register a library by name and handle void Interp::reglib (const String& name, void* hand) { wrlock (); try { p_shld->add (name, hand); unlock (); } catch (...) { unlock (); throw; } } // open a new dynamic library by name Object* Interp::library (const String& name, Vector* argv) { wrlock (); try { // optionnal add the libary and find it p_shld->add (name); Library* lib = p_shld->lookup (name); // call the initialize procedure now Object::cref (lib->dlinit (this, argv)); // post and return the library post (lib); unlock (); return lib; } catch (...) { unlock (); throw; } } // set the next flag void Interp::setnext (const bool flag) { wrlock (); d_next = flag; unlock (); } // return the next flag bool Interp::getnext (void) const { rdlock (); bool result = d_next; unlock (); return result; } // break the interpreter in a nameset with an object bool Interp::bpt (Nameset* nset, Object* object) { if (object != nilp) object->eval (this, nset); return true; } // loop on the standard input by doing a read-eval loop // this procedure return false is something bad happen bool Interp::loop (void) { // initialize status bool status = true; // loop in the standard input try { status = loop (p_gset, getis ()); } catch (const Exception& e) { getes()->errorln (e); if (e.getabf () == true) System::exit (1); } catch (...) { status = false; getes()->errorln ("fatal: unknown exception trapped"); } // wait for all threads to terminate - this works only for the // master thread - for other threads, this does nothing Thread::waitall (); return status; } // loop on the standard input in a nameset context bool Interp::loop (Nameset* nset, Input* is) { // initialize the status bool status = true; // create a new reader Reader* rd = new Reader (is); // loop until we have an eof while (true) { Form* form = nilp; try { form = rd->parse (); if (form == nilp) break; Object::cref (form->eval (this, p_gset)); Object::dref (form); } catch (const Exception& e) { if (e.getabf () == true) throw; status = false; getes()->errorln (e); Object::dref (form); } catch (const Return& r) { this->post (r.getobj ()); Object::dref (form); } catch (...) { Object::dref (form); delete rd; throw; } } delete rd; return status; } // loop with an input file by doing a read-eval loop // this procedure return false is something bad happen bool Interp::loop (const String& fname) { // load the file bool status = true; try { load (fname); } catch (const Exception& e) { status = false; getes()->errorln (e); if (e.getabf () == true) System::exit (1); } catch (...) { status = false; getes()->errorln ("fatal: unknown exception trapped"); } // wait for all threads to terminate if (status == true) Thread::waitall (); return status; } // loop with an input file by doing a read-eval loop - no thread wait void Interp::load (const String& fname) { // try to open the module Input* ms = p_rslv->alplkp (fname); String mn = p_rslv->alpname (fname); Module* mp = new Module (ms, mn); // get the interpreter encoding/transcoding modes if (ms != nilp) { // set encoding mode if (p_is == nilp) { ms->settmod (System::getstm ()); ms->setemod (System::getsem ()); } else { ms->settmod (p_is->gettmod ()); ms->setemod (p_is->getemod ()); } // eventually overwrite it ms->setemod (d_emod); } // loop until we have an eof while (true) { Form* form = nilp; try { form = mp->parse (); if (form == nilp) break; Object::cref (form->eval (this, p_gset)); Object::dref (form); } catch (Exception& e) { e.updname (fname); if (form == nilp) e.updlnum (mp->getlnum ()); else e.updlnum (form->getlnum ()); delete mp; throw; } catch (const Return& r) { Object::dref (form); this->post (r.getobj ()); } catch (...) { Object::dref (form); delete mp; throw; } } // clean the module delete mp; } // compile from an input stream into an output stream void Interp::compile (const String& name, Output& os) { // try to open the module and write Input* ms = p_rslv->lookup (name); String mn = p_rslv->getpath (name); Module* mp = new Module (ms, mn); // get the interpreter encoding/transcoding modes if (ms != nilp) { // set the encoding mode if (p_is == nilp) { ms->settmod (System::getstm ()); ms->setemod (System::getsem ()); } else { ms->settmod (p_is->gettmod ()); ms->setemod (p_is->getemod ()); } // eventually overwrite it ms->setemod (d_emod); } try { mp->write (os); } catch (const Exception& e) { Integer line = mp->getlnum (); String msg = name + ':' + line.tostring (); delete mp; throw Exception (msg, e.getval ()); } } // ------------------------------------------------------------------------- // - object section - // ------------------------------------------------------------------------- // the quark zone static const long QUARK_ZONE_LENGTH = 27; static QuarkZone zone (QUARK_ZONE_LENGTH); // the interpreter supported quarks static const long QUARK_DUP = zone.intern ("dup"); static const long QUARK_URI = zone.intern ("afnix-uri"); static const long QUARK_LOAD = zone.intern ("load"); static const long QUARK_ROLL = zone.intern ("roll"); static const long QUARK_ARGV = zone.intern ("argv"); static const long QUARK_MACHS = zone.intern ("machine-size"); static const long QUARK_MAJOR = zone.intern ("major-version"); static const long QUARK_MINOR = zone.intern ("minor-version"); static const long QUARK_PATCH = zone.intern ("patch-version"); static const long QUARK_GETIS = zone.intern ("get-input-stream"); static const long QUARK_GETOS = zone.intern ("get-output-stream"); static const long QUARK_GETES = zone.intern ("get-error-stream"); static const long QUARK_GETPP = zone.intern ("get-primary-prompt"); static const long QUARK_GETSP = zone.intern ("get-secondary-prompt"); static const long QUARK_SETPP = zone.intern ("set-primary-prompt"); static const long QUARK_SETSP = zone.intern ("set-secondary-prompt"); static const long QUARK_LOADER = zone.intern ("loader"); static const long QUARK_LAUNCH = zone.intern ("launch"); static const long QUARK_DAEMON = zone.intern ("daemon"); static const long QUARK_OSNAME = zone.intern ("os-name"); static const long QUARK_OSTYPE = zone.intern ("os-type"); static const long QUARK_GETEPS = zone.intern ("get-epsilon"); static const long QUARK_SETEPS = zone.intern ("set-epsilon"); static const long QUARK_VERSION = zone.intern ("version"); static const long QUARK_PGMNAME = zone.intern ("program-name"); static const long QUARK_LIBRARY = zone.intern ("library"); static const long QUARK_SETMDBG = zone.intern ("set-memory-debug"); // return true if the given quark is defined bool Interp::isquark (const long quark, const bool hflg) const { rdlock (); if (zone.exists (quark) == true) { unlock (); return true; } bool result = hflg ? Object::isquark (quark, hflg) : false; unlock (); return result; } // evaluate an object in this interpreter Object* Interp::eval (Object* object) { if (object == nilp) return nilp; rdlock (); try { Object* result = object->eval (this, p_gset); post (result); unlock (); return result; } catch (...) { unlock (); throw; } } // evaluate an interpreter method by quark Object* Interp::eval (Runnable* robj, Nameset* nset, const long quark) { // standard builtin name if (quark == QUARK_URI) return new String (System::geturi ()); if (quark == QUARK_MACHS) return new String (System::machs ()); if (quark == QUARK_MAJOR) return new String (System::major ()); if (quark == QUARK_MINOR) return new String (System::minor ()); if (quark == QUARK_PATCH) return new String (System::patch ()); if (quark == QUARK_OSTYPE) return new String (System::ostype ()); if (quark == QUARK_OSNAME) return new String (System::osname ()); if (quark == QUARK_VERSION) return new String (System::version ()); if (quark == QUARK_PGMNAME) return new String (System::getpgm ()); if (quark == QUARK_ARGV) { Object* result = p_argv; post (result); return result; } if (quark == QUARK_LOADER) { Object* result = p_shld; post (result); return result; } // look the object return Object::eval (robj, nset, quark); } // apply this object with a set of arguments and a quark Object* Interp::apply (Runnable* robj, Nameset* nset, const long quark, Vector* argv) { // get the number of arguments long argc = (argv == nilp) ? 0 : argv->length (); // special case for library with any arguments if ((quark == QUARK_LIBRARY) && (argc > 0)) { String lname = argv->getstring (0); return library (lname, argv); } // check for 0 argument if (argc == 0) { if (quark == QUARK_ROLL) return new Boolean (loop (p_gset, p_is)); if (quark == QUARK_GETPP) return new String (getpp ()); if (quark == QUARK_GETSP) return new String (getsp ()); if (quark == QUARK_GETEPS) return new Real (Real::d_eps); if (quark == QUARK_GETIS) { wrlock (); try { Object* result = getis (); post (result); unlock (); return result; } catch (...) { unlock (); throw; } } if (quark == QUARK_GETOS) { wrlock (); try { Object* result = getos (); post (result); unlock (); return result; } catch (...) { unlock (); throw; } } if (quark == QUARK_GETES) { wrlock (); try { Object* result = getes (); post (result); unlock (); return result; } catch (...) { unlock (); throw; } } if (quark == QUARK_DUP){ Terminal* term = nilp; return dup (term); } } // check for 1 argument if (argc == 1) { if (quark == QUARK_SETEPS) { Real::d_eps = argv->getreal (0); return nilp; } if (quark == QUARK_LOAD) { String name = argv->getstring (0); load (name); return nilp; } if (quark == QUARK_LAUNCH) { Object* form = argv->get(0); Object* result = this->launch (form); return result; } if (quark == QUARK_DAEMON) { Object* form = argv->get(0); Object* result = this->daemon (form); return result; } if (quark == QUARK_DUP) { Object* obj = argv->get (0); Terminal* term = dynamic_cast (obj); if (term == nilp) { throw Exception ("type-error", "invalid terminal object", Object::repr (obj)); } return dup (term); } if (quark == QUARK_SETPP) { String val = argv->getstring (0); setpp (val); return nilp; } if (quark == QUARK_SETSP) { String val = argv->getstring (0); setsp (val); return nilp; } if (quark == QUARK_SETMDBG) { bool flag = argv->getbool (0); Object::setmdbg (flag); return nilp; } } // check for 2 arguments if (argc == 2) { if (quark == QUARK_DUP) { // get the input stream Object* iobj = argv->get (0); Input* is = dynamic_cast (iobj); if (is == nilp) { throw Exception ("type-error", "invalid input stream object", Object::repr (iobj)); } // get the output/error stream Object* oobj = argv->get (1); Output* os = dynamic_cast (oobj); if (os == nilp) { throw Exception ("type-error", "invalid output stream object", Object::repr (oobj)); } return dup (is, os, os); } } // check for 3 arguments if (argc == 3) { if (quark == QUARK_DUP) { // get the input stream Object* iobj = argv->get (0); Input* is = dynamic_cast (iobj); if (is == nilp) { throw Exception ("type-error", "invalid input stream object", Object::repr (iobj)); } // get the output stream Object* oobj = argv->get (1); Output* os = dynamic_cast (oobj); if (os == nilp) { throw Exception ("type-error", "invalid output stream object", Object::repr (oobj)); } // get the error stream Object* eobj = argv->get (2); Output* es = dynamic_cast (eobj); if (es == nilp) { throw Exception ("type-error", "invalid error stream object", Object::repr (eobj)); } return dup (is, os, es); } } // call the object method return Object::apply (robj, nset, quark, argv); } }