Initial import of htcd system 1.0

Signed-off-by: Henrik Rydberg <rydberg@euromail.se>

1 files changed, 150 insertions, 0 deletions

diff --git a/src/lang/ops.cc b/src/lang/ops.cc
new file mode 100644
index 0000000..7916d96
--- /dev/null
+++ b/src/lang/ops.cc
@@ -0,0 +1,150 @@
+/*************************************************************************
+ *
+ * HTCd - Copyright (C) 1998-2006 Henrik Rydberg
+ *
+ * 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 2 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, write to the Free Software
+ * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
+ */
+
+#include <lang/env.h>
+
+//////////////////////////////////////////////////////
+
+struct xop_t : public op_t {
+  typedef void (*xop1_t)(mstream&,Env&,const sref&);
+  typedef void (*xop2_t)(mstream&,Env&,const sref&,const sref&);
+  xop_t(const mstring& s,int p1,int p2,int l,int r,
+        xop1_t op1,xop2_t op2,const mstring& d):
+    op_t(s,p1,p2,l,r,(op1_t)op1,(op2_t)op2,d) {}
+};
+
+//////////////////////////////////////////////////////
+
+#define X1_IMPL(name) \
+static void impl_##name(mstream& out,Env& env,const sref& a) throw(merror_t)
+#define X2_IMPL(name) \
+static void impl_##name(mstream& out,Env& env,const sref& L,const sref& R) throw(merror_t)
+
+#define X1_ADDN(p,l,r,f,n,d) M.add(new xop_t(#n,p,0,l,r,impl_##f,0,d))
+#define X2_ADDN(p,l,r,f,n,d) M.add(new xop_t(#n,0,p,l,r,0,impl_##f,d))
+
+//////////////////////////////////////////////////////
+
+X1_IMPL(exist) {
+  mstring name;
+  swrite sw(name);
+  env.eval(sw,a,0);
+  out<<env.gloc_find(name);
+}
+
+X2_IMPL(new) {
+  mstring name;
+  swrite sw(name);
+  env.eval(sw,L,0);
+  env.aloc(name,R);
+}
+
+X2_IMPL(assign) {
+  mstring name;
+  swrite sw(name);
+  env.eval(sw,L,0);
+  env.sloc(name,R);
+}
+
+X2_IMPL(incr) {
+  mstring name;
+  swrite sw(name);
+  env.eval(sw,L,0);
+  env.sloc(name,ftoa(atof(env.gloc(name))+atof(R)));
+}
+
+X2_IMPL(decr) {
+  mstring name;
+  swrite sw(name);
+  env.eval(sw,L,0);
+  env.sloc(name,ftoa(atof(env.gloc(name))-atof(R)));
+}
+
+//////////////////////////////////////////////////////
+
+X2_IMPL(new_rec) {
+  if(*L=='@') env.gloc_adb(L.popf(),R);
+  else {
+    rpile list; env.gloc_list(list,R);
+    int n=*R=='@'?R.size()-1:R.size();
+    for(int i=0;i<list.size();i++) env.aloc(L+list[i].right(n),env.gloc(list[i]));
+  }
+}
+
+X2_IMPL(copy_rec) {
+  rpile list; env.gloc_list(list,L);
+  int n=*L=='@'?L.size()-1:L.size();
+  for(int i=0;i<list.size();i++) env.sloc(R+list[i].right(n),env.gloc(list[i]));
+}
+
+//////////////////////////////////////////////////////
+
+void envAddOps(opmap& M,tokmap& T)
+{
+  opAddHEXP(M);
+  X1_ADDN(40,0,1,exist,?,
+          "True if a exist\n"
+          "Syntax: ? (varname)\n"
+          "Returns: (int)\n"
+          );
+  X2_ADDN(4,1,2,new,:=,
+          "New assignment\n"
+          "Syntax: (varname) := (expr)\n"
+          "Returns: nothing\n"
+          ); 
+  X2_ADDN(4,1,2,assign,=,
+          "Assignment to existing variable\n"
+          "Syntax: (varname) = (expr)\n"
+          "Returns: nothing\n"
+          ); 
+  X2_ADDN(4,1,2,incr,+=,
+          "Increment operator\n"
+          "Syntax: (varname) += (real)\n"
+          "Returns: nothing\n"
+          ); 
+  X2_ADDN(4,1,2,decr,-=,
+          "Decrement operator\n"
+          "Syntax: (varname) -= (real)\n"
+          "Returns: nothing\n"
+          ); 
+  
+  X2_ADDN(4,1,1,new_rec,<-,
+          "New local record\n"
+          "Syntax: (partial name) <- (partial name)\n"
+          "Returns: nothing\n"
+          "\n"
+          "If the partial name @ is given as the left argument,\n"
+          "a new record is created or silently updated, depending\n"
+          "on whether it is unique or not according to the default order.\n"
+          "The index table must however exist in the right argument.\n"
+          "\n"
+          "The default order may only be set at creation or when saving\n"
+          "a database to disk.\n"
+          ); 
+  X2_ADDN(4,1,1,copy_rec,->,
+          "Copy local record\n"
+          "Syntax: (partial name) -> (partial name)\n"
+          "Returns: nothing\n"
+          "\n"
+          "The partial name @ for data base records works in both arguments.\n"
+          "\n"
+          "Generates an error if any of the expanded names of the right\n"
+          "partial argument does not exist.\n"
+          ); 
+}