/********************************************************************
This file is part of the abs 0.907 distribution. abs is a spreadsheet
with graphical user interface.
Copyright (C) 1998-2001 André Bertin (Andre.Bertin@ping.be)
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 if in the same spirit as version 2.
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., 675 Mass Ave, Cambridge, MA 02139, USA.
Concact: abs@pi.be
http://home.pi.be/bertin/abs.shtml
*********************************************************************/
#include <stdio.h>
#include "interpret.h"
#include "y.tab.h"
#include "oper.h"
#include "symboltable.h"
#include "libfct.h"
#include "properties.h"
#include "project.h"
#include "io.h"
#include "abv.h"
static nodeType ***argnode = NULL;
static obj **argu = NULL;
static obj **arguref = NULL;
static int *nargnode = NULL;
static int routinedeep = -1;
static int initconst = 0;
static int dobreak = 0;
void
cb_Break ()
{
dobreak = 1;
fprintf (stderr, "Break!\n");
return;
}
void
resetbreak ()
{
dobreak = 0;
return;
}
int
settype (nodeType * p)
{
if (p != NULL)
{
int type = p->opr.oper.rec.i;
if (type == NEW)
{
symbol_settype (type, 1);
}
else
{
symbol_settype (type, 0);
}
}
else
symbol_settype (VARIANT, 0);
return 0;
}
static int scope = 1;
int
setscope (int a)
{
scope = a;
return 0;
}
int
setcstscope (nodeType * p)
{
if (p != NULL)
{
int sc = p->opr.oper.rec.i;
if (sc == PRIVATE)
{
scope = 4;
}
else
{
scope = 2;
}
}
else
symbol_settype (VARIANT, 0);
return 0;
}
static int Transmit = BYREF;
static int
settransmit (nodeType * p)
{
if (p != NULL)
{
int mode = p->opr.oper.rec.i;
if (mode == BYVAL)
{
Transmit = BYVAL;
}
else
{
Transmit = BYREF;
}
}
else
Transmit = BYREF;
return 0;
}
static char *
setfilemode (nodeType * p)
{
char *ret = "rw";
int mode = p->opr.oper.rec.i;
if (mode == APPEND)
ret = "a+";
if (mode == BINARY)
ret = "r+b";
if (mode == INPUT)
ret = "r";
if (mode == OUTPUT)
ret = "w";
if (mode == RANDOM)
ret = "r+";
return ret;
}
obj
exdecl (nodeType * p)
{
obj o;
if (dobreak)
return o;
if (!p)
return o;
switch (p->type)
{
case typeCon:
{
return p->con.value;
}
case typeMember:
{
o = p->member.member;
if (o.type == MEMBER)
{
o.type = classname2classpos (o.label);
if (o.type == -1)
o.type = MEMBER;
}
return o;
}
case typeId:
{
Idval *val;
if (p->id.id.type == BUILTINFUNCTION)
{
o = check4property (p->id.id);
if (o.type != BUILTINFUNCTION)
return o;
}
if (p->id.id.type == PROPERTY)
{
o = property2obj (p->id.id);
return o;
}
val = look (p->id.id.label, 1);
o.rec.s = (char *) val;
o.type = p->id.id.type;
o.label = p->id.id.label;
return o;
}
case typeOpr1:
switch (p->opr1.oper.rec.i)
{
case UMINUS:
return mkuminus (exdecl (p->opr1.op1));
}
case typeOpr2:
switch (p->opr2.oper.rec.i)
{
case '=':
{
obj o1 = exdecl (p->opr2.op2);
obj o0 = exdecl (p->opr2.op1);
o = mkassign (o0, o1);
freenocstobj (o1);
return o;
}
case '+':
{
obj o1, o2, o3;
o1 = exdecl (p->opr2.op1);
o2 = exdecl (p->opr2.op2);
o3 = mksum (o1, o2);
freenocstobj (o1);
freenocstobj (o2);
return o3;
}
case '-':
{
obj o1, o2, o3;
o1 = exdecl (p->opr2.op1);
o2 = exdecl (p->opr2.op2);
o3 = mkdiff (o1, o2);
freenocstobj (o1);
freenocstobj (o2);
return o3;
}
case '*':
{
obj o1, o2, o3;
o1 = exdecl (p->opr2.op1);
o2 = exdecl (p->opr2.op2);
o3 = mkmult (o1, o2);
freenocstobj (o1);
freenocstobj (o2);
return o3;
}
case '/':
{
obj o1, o2, o3;
o1 = exdecl (p->opr2.op1);
o2 = exdecl (p->opr2.op2);
o3 = mkdiv (o1, o2);
freenocstobj (o1);
freenocstobj (o2);
return o3;
}
case MOD:
{
obj o1, o2, o3;
o1 = exdecl (p->opr2.op1);
o2 = exdecl (p->opr2.op2);
o3 = mkmod (o1, o2);
freenocstobj (o1);
freenocstobj (o2);
return o3;
}
case '\\':
{
obj o1, o2, o3;
o1 = exdecl (p->opr2.op1);
o2 = exdecl (p->opr2.op2);
o3 = mkintdiv (o1, o2);
freenocstobj (o1);
freenocstobj (o2);
return o3;
}
case '^':
{
obj o1, o2, o3;
o1 = exdecl (p->opr2.op1);
o2 = exdecl (p->opr2.op2);
o3 = mkpow (o1, o2);
freenocstobj (o1);
freenocstobj (o2);
return o3;
}
}
case typeOpr:
switch (p->opr.oper.rec.i)
{
case NEWLINE:
{
int i;
int nops = p->opr.nops;
for (i = 0; i < nops; i++)
{
exdecl (p->opr.op[i]);
}
return o;
}
case IDLIST:
{
int nops = p->opr.nops;
Idval *val;
nodeType *pp;
if (nops == 5)
{
exdecl (p->opr.op[0]);
settype (p->opr.op[3]);
pp = p->opr.op[1];
val = look (pp->id.id.label, scope);
symbol_settype (VARIANT, 0);
if (initconst && p->opr.op[4] != NULL)
{
obj o;
o.rec.s = (char *) val;
pp = p->opr.op[4];
o1eqo2 (&o, exdecl (pp));
val->protect = 1;
}
}
else
{
settype (p->opr.op[2]);
pp = p->opr.op[0];
val = look (pp->id.id.label, scope);
symbol_settype (VARIANT, 0);
if (initconst && p->opr.op[3] != NULL)
{
obj o;
o.rec.s = (char *) val;
pp = p->opr.op[3];
o1eqo2 (&o, exdecl (pp));
val->protect = 1;
}
}
return o;
}
case CONST:
{
int nops = p->opr.nops;
initconst = 1;
if (nops == 2)
{
nodeType *pp = p->opr.op[0];
int sc = pp->opr.oper.rec.i;
if (sc == PUBLIC)
setscope (2);
else
setscope (4);
exdecl (p->opr.op[1]);
}
else
{
setscope (4);
exdecl (p->opr.op[0]);
}
setscope (1);
initconst = 0;
return o;
}
case DIM:
{
setscope (2);
exdecl (p->opr.op[0]);
setscope (1);
return o;
}
case PUBLIC:
{
setscope (4);
exdecl (p->opr.op[0]);
setscope (1);
return o;
}
case PRIVATE:
{
setscope (2);
exdecl (p->opr.op[0]);
setscope (1);
return o;
}
case '.':
{
switch (p->opr.nops)
{
case 1:
{
}
case 2:
{
return mkderef (exdecl (p->opr.op[0]), exdecl (p->opr.op[1]));
}
}
return o;
}
}
}
return o;
}
static nodeType *selexpr[20];
static int caseelse[20];
static int nsel = -1;
obj
exint (nodeType * p)
{
obj o;
if (!p)
return o;
switch (p->type)
{
case typeCon:
{
return p->con.value;
}
case typeMember:
{
o = p->member.member;
if (o.type == MEMBER)
{
o.type = classname2classpos (o.label);
if (o.type == -1)
o.type = MEMBER;
}
return o;
}
case typeId:
{
Idval *val;
if (p->id.id.type == BUILTINFUNCTION)
{
o = check4property (p->id.id);
if (o.type != BUILTINFUNCTION)
return o;
}
if (p->id.id.type == PROPERTY)
{
o = property2obj (p->id.id);
return o;
}
val = look (p->id.id.label, scope);
o.rec.s = (char *) val;
o.type = p->id.id.type;
o.label = p->id.id.label;
return o;
}
case typeOpr1:
switch (p->opr1.oper.rec.i)
{
case UMINUS:
return mkuminus (exint (p->opr1.op1));
}
case typeOpr2:
switch (p->opr2.oper.rec.i)
{
case '=':
{
obj o1 = exint (p->opr2.op2);
obj o0 = exint (p->opr2.op1);
o = mkassign (o0, o1);
freenocstobj (o1);
return o;
}
case '+':
{
obj o1, o2, o3;
o1 = exint (p->opr2.op1);
o2 = exint (p->opr2.op2);
o3 = mksum (o1, o2);
freenocstobj (o1);
freenocstobj (o2);
return o3;
}
case '-':
{
obj o1, o2, o3;
o1 = exint (p->opr2.op1);
o2 = exint (p->opr2.op2);
o3 = mkdiff (o1, o2);
freenocstobj (o1);
freenocstobj (o2);
return o3;
}
case '*':
{
obj o1, o2, o3;
o1 = exint (p->opr2.op1);
o2 = exint (p->opr2.op2);
o3 = mkmult (o1, o2);
freenocstobj (o1);
freenocstobj (o2);
return o3;
}
case '/':
{
obj o1, o2, o3;
o1 = exint (p->opr2.op1);
o2 = exint (p->opr2.op2);
o3 = mkdiv (o1, o2);
freenocstobj (o1);
freenocstobj (o2);
return o3;
}
case MOD:
{
obj o1, o2, o3;
o1 = exint (p->opr2.op1);
o2 = exint (p->opr2.op2);
o3 = mkmod (o1, o2);
freenocstobj (o1);
freenocstobj (o2);
return o3;
}
case '\\':
{
obj o1, o2, o3;
o1 = exint (p->opr2.op1);
o2 = exint (p->opr2.op2);
o3 = mkintdiv (o1, o2);
freenocstobj (o1);
freenocstobj (o2);
return o3;
}
case '^':
{
obj o1, o2, o3;
o1 = exint (p->opr2.op1);
o2 = exint (p->opr2.op2);
o3 = mkpow (o1, o2);
freenocstobj (o1);
freenocstobj (o2);
return o3;
}
}
case typeOpr:
switch (p->opr.oper.rec.i)
{
case WHILE:
{
while (obj2double (exint (p->opr.op[0])))
{
exint (p->opr.op[1]);
}
return o;
}
case UNTIL:
{
while (!obj2double (exint (p->opr.op[0])))
{
exint (p->opr.op[1]);
}
return o;
}
case LOOPWHILE:
{
do
{
exint (p->opr.op[1]);
}
while (obj2double (exint (p->opr.op[0])));
return o;
}
case LOOPUNTIL:
{
do
{
exint (p->opr.op[1]);
}
while (!obj2double (exint (p->opr.op[0])));
return o;
}
case SELECT:
{
nsel++;
if (nsel > 19)
{
fprintf (stderr, "Select case inside other one limited to 20 levels!\n");
nsel--;
return o;
}
selexpr[nsel] = p->opr.op[0];
caseelse[nsel] = 1;
exint (p->opr.op[1]);
nsel--;
return o;
}
case CASE:
{
switch (p->opr.nops)
{
case 2:
if (objcmp (exint (selexpr[nsel]), exint (p->opr.op[0])))
{
exint (p->opr.op[1]);
caseelse[nsel] = 0;
}
break;
case 3:
exint (p->opr.op[0]);
if (objcmp (exint (selexpr[nsel]), exint (p->opr.op[1])))
{
exint (p->opr.op[2]);
caseelse[nsel] = 0;
}
}
return o;
}
case CASEELSE:
{
switch (p->opr.nops)
{
case 1:
if (caseelse[nsel])
exint (p->opr.op[0]);
break;
case 2:
exint (p->opr.op[0]);
if (caseelse[nsel])
exint (p->opr.op[1]);
}
return o;
}
case FOR:
{
int negstep = 0;
if (p->opr.nops > 5 && obj2double (exint (p->opr.op[3])) < 0)
negstep = 1;
else if (p->opr.nops < 6 && obj2double (exint (p->opr.op[1])) > obj2double (exint (p->opr.op[2])))
negstep = 1;
o = mkassign (exint (p->opr.op[0]), (exint (p->opr.op[1])));
if (!negstep)
{
while (obj2int (mkle (exint (p->opr.op[0]), (exint (p->opr.op[2])))))
{
if (p->opr.nops > 5)
{
o = exint (p->opr.op[4]);
mksumassign (exint (p->opr.op[0]), exint (p->opr.op[3]));
}
else
{
o = exint (p->opr.op[3]);
mkplusplus (exint (p->opr.op[0]));
}
}
}
else
{
while (obj2int (mkge (exint (p->opr.op[0]), (exint (p->opr.op[2])))))
{
if (p->opr.nops > 5)
{
o = exint (p->opr.op[4]);
mksumassign (exint (p->opr.op[0]), exint (p->opr.op[3]));
}
else
{
o = exint (p->opr.op[3]);
mkminusminus (exint (p->opr.op[0]));
}
}
}
return o;
};
case EACH:
{
int start = 1;
int end = 0;
obj index;
obj collection = exint (p->opr.op[1]);
end = obj2int ((arrayclass[collection.type].data[0].getfct) ());
index.type = INTEGER;
for (index.rec.i = start; index.rec.i <= end; index.rec.i++)
{
mkassign (exint (p->opr.op[0]),
(arrayclass[collection.type].fct[0].fct) (1, &index));
o = exint (p->opr.op[2]);
}
return o;
};
case IF:
{
if (obj2double (exint (p->opr.op[0])))
o = exint (p->opr.op[1]);
else if (p->opr.nops > 2)
o = exint (p->opr.op[2]);
return o;
}
case IDLIST:
{
int nops = p->opr.nops;
Idval *val;
nodeType *pp;
if (nops == 5)
{
exint (p->opr.op[0]);
settype (p->opr.op[3]);
pp = p->opr.op[1];
val = look (pp->id.id.label, scope);
symbol_settype (VARIANT, 0);
if (initconst && p->opr.op[4] != NULL)
{
obj o;
o.rec.s = (char *) val;
pp = p->opr.op[4];
o1eqo2 (&o, exint (pp));
val->protect = 1;
}
}
else
{
settype (p->opr.op[2]);
pp = p->opr.op[0];
val = look (pp->id.id.label, scope);
symbol_settype (VARIANT, 0);
if (initconst && p->opr.op[3] != NULL)
{
obj o;
o.rec.s = (char *) val;
pp = p->opr.op[3];
o1eqo2 (&o, exint (pp));
val->protect = 1;
}
}
return o;
}
case CONST:
{
int nops = p->opr.nops;
initconst = 1;
setscope (2);
exint (p->opr.op[nops - 1]);
setscope (1);
initconst = 0;
return o;
}
case DIM:
{
setscope (2);
exint (p->opr.op[0]);
setscope (1);
return o;
}
case STATIC:
{
setscope (3);
exint (p->opr.op[0]);
setscope (1);
return o;
}
case SUB:
{
argsub ();
if (p->opr.op[1] != NULL)
exint (p->opr.op[1]);
exint (p->opr.op[2]);
return o;
}
case CALL:
{
argcall ();
exint (p->opr.op[1]);
switch ((p->opr.op[0])->id.id.type)
{
case IDENTIFIER:
{
o = mkcall (exint (p->opr.op[0]));
argendcall ();
break;
}
case BUILTINFUNCTION:
{
o = mkcallbuiltin ((p->opr.op[0])->id.id);
argendcallbuiltin ();
break;
}
}
return o;
}
case WITH:
{
withenter (exint (p->opr.op[0]));
o = exint (p->opr.op[1]);
withend ();
return o;
}
case ARG:
{
switch (p->opr.nops)
{
case 1:
{
mkarg (p->opr.op[0]);
return o;
}
case 2:
{
o = exint (p->opr.op[0]);
mkarg (p->opr.op[1]);
return o;
}
}
return o;
}
case SUBARG:
{
switch (p->opr.nops)
{
case 3:
{
settransmit (p->opr.op[0]);
settype (p->opr.op[2]);
setscope (2);
mkarg (p->opr.op[1]);
symbol_settype (VARIANT, 0);
setscope (1);
return o;
}
case 4:
{
o = exint (p->opr.op[0]);
settransmit (p->opr.op[1]);
settype (p->opr.op[3]);
setscope (2);
mkarg (p->opr.op[2]);
symbol_settype (VARIANT, 0);
setscope (1);
return o;
}
}
return o;
}
case BUILTINFUNCTION:
{
argcall ();
exint (p->opr.op[1]);
o = mkcallbuiltin ((p->opr.op[0])->id.id);
argendcallbuiltin ();
return o;
}
case NEWLINE:
{
int i;
int nops = p->opr.nops;
for (i = 0; i < nops; i++)
{
exint (p->opr.op[i]);
}
return o;
}
case OPEN:
{
o.rec.i = io_open (obj2string (exint (p->opr.op[0])),
setfilemode (p->opr.op[1]),
obj2int (exint (p->opr.op[2])));
o.type = INTEGER;
return o;
};
case CLOSE:
{
o.rec.i = io_close (obj2int (exint (p->opr.op[0])));
o.type = INTEGER;
return o;
};
case SPC:
{
o.rec.i = obj2int (exint (p->opr.op[0]));
o.type = INTEGER;
return o;
};
case TAB:
{
o.rec.i = -obj2int (exint (p->opr.op[0]));
o.type = INTEGER;
return o;
};
case PRINT:
{
int tabspc = 0;
if (p->opr.op[1] != NULL)
tabspc = obj2int (exint (p->opr.op[1]));
argcall ();
exint (p->opr.op[2]);
o.rec.i = io_print (obj2int (exint (p->opr.op[0])),
tabspc,
nargnode[routinedeep],
argu[routinedeep]);
argendcallbuiltin ();
o.type = INTEGER;
return o;
};
case WRITE:
{
argcall ();
exint (p->opr.op[1]);
o.rec.i = io_write (obj2int (exint (p->opr.op[0])),
nargnode[routinedeep],
argu[routinedeep]);
argendcallbuiltin ();
o.type = INTEGER;
return o;
};
case INPUT:
{
int i;
argcall ();
exint (p->opr.op[1]);
for (i = 0; i < nargnode[routinedeep]; i++)
{
argu[routinedeep][i] = io_input (obj2int (exint (p->opr.op[0])));
}
argsub ();
return exint (p->opr.op[1]);
argendcall ();
};
case LT:
{
obj o1, o2, o3;
o1 = exint (p->opr.op[0]);
o2 = exint (p->opr.op[1]);
o3 = mklt (o1, o2);
freenocstobj (o1);
freenocstobj (o2);
return o3;
}
case GT:
{
obj o1, o2, o3;
o1 = exint (p->opr.op[0]);
o2 = exint (p->opr.op[1]);
o3 = mkgt (o1, o2);
freenocstobj (o1);
freenocstobj (o2);
return o3;
}
case GE:
{
obj o1, o2, o3;
o1 = exint (p->opr.op[0]);
o2 = exint (p->opr.op[1]);
o3 = mkge (o1, o2);
freenocstobj (o1);
freenocstobj (o2);
return o3;
}
case LE:
{
obj o1, o2, o3;
o1 = exint (p->opr.op[0]);
o2 = exint (p->opr.op[1]);
o3 = mkle (o1, o2);
freenocstobj (o1);
freenocstobj (o2);
return o3;
}
case NE:
{
obj o1, o2, o3;
o1 = exint (p->opr.op[0]);
o2 = exint (p->opr.op[1]);
o3 = mkne (o1, o2);
freenocstobj (o1);
freenocstobj (o2);
return o3;
}
case EQ:
{
obj o1, o2, o3;
o1 = exint (p->opr.op[0]);
o2 = exint (p->opr.op[1]);
o3 = mkeq (o1, o2);
freenocstobj (o1);
freenocstobj (o2);
return o3;
}
case OR:
{
obj o1, o2, o3;
o1 = exint (p->opr.op[0]);
o2 = exint (p->opr.op[1]);
o3 = mkor (o1, o2);
freenocstobj (o1);
freenocstobj (o2);
return o3;
}
case AND:
{
obj o1, o2, o3;
o1 = exint (p->opr.op[0]);
o2 = exint (p->opr.op[1]);
o3 = mkand (o1, o2);
freenocstobj (o1);
freenocstobj (o2);
return o3;
}
case XOR:
{
obj o1, o2, o3;
o1 = exint (p->opr.op[0]);
o2 = exint (p->opr.op[1]);
o3 = mkxor (o1, o2);
freenocstobj (o1);
freenocstobj (o2);
return o3;
}
case '&':
{
obj o1, o2, o3;
o1 = exint (p->opr.op[0]);
o2 = exint (p->opr.op[1]);
o3 = mkconcat (o1, o2);
freenocstobj (o1);
freenocstobj (o2);
return o3;
}
case NOT:
{
obj o1, o3;
o1 = exint (p->opr.op[0]);
o3 = mknot (o1);
freenocstobj (o1);
return o3;
}
case BASEOBJECT:
{
return check_with ((p->opr.op[0])->id.id);
}
case RETURNOBJECT:
{
o = exint (p->opr.op[0]);
return mkderef (o, exint (p->opr.op[1]));
};
case ALONEOBJ:
{
o = exint (p->opr.op[0]);
o = mkcallalone (o);
return o;
}
case MEMBERFUNCTION:
{
exint (p->opr.op[1]);
o = (exint (p->opr.op[0]));
o.type = MEMBERFUNCTION;
return o;
}
case OBJMEMBERFCT:
{
obj base = exint (p->opr.op[0]);
argcall ();
o = exint (p->opr.op[1]);
o = mkcallmember (base, o);
argendcall ();
return o;
}
case FCTMEMBERFCT:
{
obj base = exint (p->opr.op[0]);
argcall ();
o = exint (p->opr.op[1]);
o = mkcallmember (base, o);
argendcall ();
return o;
}
case '.':
{
switch (p->opr.nops)
{
case 1:
{
}
case 2:
{
return mkderef (exint (p->opr.op[0]), exint (p->opr.op[1]));
}
}
return o;
}
}
}
return o;
}
obj
mkcall (obj identifier)
{
if (identifier.type == IDENTIFIER)
{
gotolabel (identifier.label);
}
return id2val (identifier);
}
typedef enum
{
call, sub
}
Arg_use;
static Arg_use arg_use;
int
argsub ()
{
arg_use = sub;
return 0;
}
int
argcall ()
{
arg_use = call;
routinedeep++;
argnode = (nodeType ***) absrealloc (argnode, sizeof (nodeType **) * (routinedeep + 1), "argcall:argnode ");
argu = (obj **) absrealloc (argu, sizeof (obj *) * (routinedeep + 1), "argcall:argu ");
arguref = (obj **) absrealloc (arguref, sizeof (obj *) * (routinedeep + 1), "argcall:arguref ");
nargnode = (int *) absrealloc (nargnode, sizeof (int) * (routinedeep + 1), "argcall:nargnode");
argnode[routinedeep] = NULL;
argu[routinedeep] = NULL;
arguref[routinedeep] = NULL;
nargnode[routinedeep] = 0;
return 0;
}
int
argendcall ()
{
arg_use = sub;
if (argnode[routinedeep] != NULL)
absfree (argnode[routinedeep], "argendcall:argnode[routinedeep]");
if (argu[routinedeep] != NULL)
absfree (argu[routinedeep], "argendcall:argu [routinedeep]");
if (arguref[routinedeep] != NULL)
absfree (arguref[routinedeep], "argendcall:arguref[routinedeep]");
routinedeep--;
if (routinedeep < 0)
{
absfree (argnode, "argendcall:argnode ");
argnode = NULL;
absfree (argu, "argendcall:argu ");
argu = NULL;
absfree (arguref, "argendcall:arguref ");
arguref = NULL;
absfree (nargnode, "argendcall:nargnode");
nargnode = NULL;
}
else
{
argnode = (nodeType ***) absrealloc (argnode, sizeof (nodeType **) * (routinedeep + 1), "argcall:argnode ");
argu = (obj **) absrealloc (argu, sizeof (obj *) * (routinedeep + 1), "argcall:argu ");
arguref = (obj **) absrealloc (arguref, sizeof (obj *) * (routinedeep + 1), "argcall:arguref ");
nargnode = (int *) absrealloc (nargnode, sizeof (int) * (routinedeep + 1), "argcall:nargnode");
}
return 0;
}
int
argendcallbuiltin ()
{
argendcall ();
arg_use = call;
return 0;
}
obj
mkarg (nodeType * arg)
{
obj o, id;
int i;
int narg;
if (arg_use == call)
{
narg = nargnode[routinedeep];
argnode[routinedeep] = (nodeType **) absrealloc (argnode[routinedeep], sizeof (nodeType *) * (narg + 1), "mkarg:argnode");
argu[routinedeep] = (obj *) absrealloc (argu[routinedeep], sizeof (obj) * (narg + 1), "mkarg:argu ");
arguref[routinedeep] = (obj *) absrealloc (arguref[routinedeep], sizeof (obj) * (narg + 1), "mkarg:arguref");
argnode[routinedeep][narg] = arg;
argu[routinedeep][narg] = id2val (exint (arg));
arguref[routinedeep][narg] = exint (arg);
nargnode[routinedeep]++;
}
else
{
nargnode[routinedeep]--;
if (nargnode[routinedeep] >= 0)
{
o = argu[routinedeep][0];
id = arguref[routinedeep][0];
for (i = 0; i < nargnode[routinedeep]; i++)
{
argu[routinedeep][i] = argu[routinedeep][i + 1];
arguref[routinedeep][i] = arguref[routinedeep][i + 1];
}
if (id.type == IDENTIFIER && Transmit == BYREF)
setrefid (id);
else
unsetrefid ();
return mkassign (exint (arg), o);
}
}
return o;
}
obj
mkcallbuiltin (obj identifier)
{
obj o;
int narg;
obj arg[10];
int i;
narg = nargnode[routinedeep];
for (i = 0; i < nargnode[routinedeep]; i++)
arg[i] = argu[routinedeep][i];
if (identifier.type == BUILTINFUNCTION)
{
o = (arrayfct[identifier.rec.i].fct) (narg, arg);
}
return o;
}
obj
mkcallmember (base, identifier)
obj base, identifier;
{
obj o;
int narg;
obj arg[10];
int i, found;
if (base.type == IDENTIFIER)
base = id2val (base);
narg = nargnode[routinedeep];
for (i = 0; i < narg; i++)
arg[i + 1] = argu[routinedeep][i];
narg++;
arg[0] = base;
found = 0;
i = 0;
if (base.type > NUMBER_OF_CLASS || base.type < 0)
{
fprintf (stderr, "unknown class %s type %d\n", base.label, base.type);
return o;
}
while (arrayclass[base.type].fct[i].name != NULL && found == 0)
{
if (strcasecmp (identifier.label, arrayclass[base.type].fct[i].name) == 0)
found = 1;
i++;
}
i--;
if (found)
{
o = (arrayclass[base.type].fct[i].fct) (narg, arg);
}
else
{
fprintf (stderr, "function %s is not member of type %d\n", identifier.label, base.type);
printobj (base);
}
return o;
}
obj
mkcallalone (member)
obj member;
{
obj o;
int narg;
obj arg[10];
obj base;
int i, found;
if (member.type == MEMBER)
base = *((obj *) member.rec.s);
else
return o;
narg = 1;
arg[0] = base;
found = 0;
i = 0;
if (base.type > NUMBER_OF_CLASS || base.type < 0)
{
fprintf (stderr, "unknown class %s type %d\n", base.label, base.type);
return o;
}
while (arrayclass[base.type].fct[i].name != NULL && found == 0)
{
if (strcasecmp (member.label, arrayclass[base.type].fct[i].name) == 0)
found = 1;
i++;
}
i--;
if (found)
{
o = (arrayclass[base.type].fct[i].fct) (narg, arg);
}
else
fprintf (stderr, "function %s is not member of type %d\n", member.label, base.type);
return o;
}
syntax highlighted by Code2HTML, v. 0.9.1