From 75ac069d82ccf8f4d1d516d18a47b7525085d6d1 Mon Sep 17 00:00:00 2001 From: Bruno JOFRET Date: Wed, 13 Feb 2013 18:37:04 +0100 Subject: [PATCH] Rewrite clear GW in C. Change-Id: I7179c0ba9d6eae5465d430e91d9d4499b6cc835c --- scilab/modules/core/Makefile.am | 2 +- scilab/modules/core/Makefile.in | 13 +- scilab/modules/core/sci_gateway/c/sci_clear.c | 144 +++++++++++++++++++- .../modules/core/sci_gateway/fortran/sci_f_clear.f | 103 -------------- scilab/modules/core/src/fortran/core_f.vfproj | 1 - scilab/modules/core/src/fortran/core_f2c.vcxproj | 2 - .../core/src/fortran/core_f2c.vcxproj.filters | 6 - scilab/modules/core/tests/unit_tests/clear.dia.ref | 2 +- scilab/modules/core/tests/unit_tests/clear.tst | 4 +- 9 files changed, 149 insertions(+), 128 deletions(-) delete mode 100644 scilab/modules/core/sci_gateway/fortran/sci_f_clear.f diff --git a/scilab/modules/core/Makefile.am b/scilab/modules/core/Makefile.am index 587fd6f..66ff496 100644 --- a/scilab/modules/core/Makefile.am +++ b/scilab/modules/core/Makefile.am @@ -268,7 +268,6 @@ sci_gateway/fortran/sci_f_ieee.f \ sci_gateway/fortran/sci_f_macrovar.f \ sci_gateway/fortran/sci_f_exists.f \ sci_gateway/fortran/sci_f_errcatch.f \ -sci_gateway/fortran/sci_f_clear.f \ sci_gateway/fortran/sci_f_argn.f \ sci_gateway/fortran/sci_f_setbpt.f \ sci_gateway/fortran/sci_f_clearglobal.f \ @@ -297,6 +296,7 @@ libscicore_la_CPPFLAGS = -I$(srcdir)/includes/ \ -I$(top_srcdir)/modules/history_manager/includes/ \ -I$(top_srcdir)/modules/preferences/includes/ \ -I$(top_srcdir)/modules/external_objects/includes/ \ + -I$(top_srcdir)/modules/functions/includes/ \ $(XML_FLAGS) \ $(AM_CPPFLAGS) diff --git a/scilab/modules/core/Makefile.in b/scilab/modules/core/Makefile.in index 6b87412..559adce 100644 --- a/scilab/modules/core/Makefile.in +++ b/scilab/modules/core/Makefile.in @@ -358,9 +358,9 @@ am__objects_6 = libscicore_la-sci_stacksize.lo \ am__objects_7 = sci_f_global.lo sci_f_mtlb_mode.lo sci_f_resume.lo \ sci_f_dispbpt.lo sci_f_intppty.lo sci_f_ieee.lo \ sci_f_macrovar.lo sci_f_exists.lo sci_f_errcatch.lo \ - sci_f_clear.lo sci_f_argn.lo sci_f_setbpt.lo \ - sci_f_clearglobal.lo sci_f_delbpt.lo where.lo sci_f_iserror.lo \ - sci_f_comp.lo sci_f_isglobal.lo + sci_f_argn.lo sci_f_setbpt.lo sci_f_clearglobal.lo \ + sci_f_delbpt.lo where.lo sci_f_iserror.lo sci_f_comp.lo \ + sci_f_isglobal.lo am_libscicore_la_OBJECTS = $(am__objects_6) $(am__objects_7) libscicore_la_OBJECTS = $(am_libscicore_la_OBJECTS) libscicore_la_LINK = $(LIBTOOL) --tag=F77 $(AM_LIBTOOLFLAGS) \ @@ -808,7 +808,6 @@ sci_gateway/fortran/sci_f_ieee.f \ sci_gateway/fortran/sci_f_macrovar.f \ sci_gateway/fortran/sci_f_exists.f \ sci_gateway/fortran/sci_f_errcatch.f \ -sci_gateway/fortran/sci_f_clear.f \ sci_gateway/fortran/sci_f_argn.f \ sci_gateway/fortran/sci_f_setbpt.f \ sci_gateway/fortran/sci_f_clearglobal.f \ @@ -836,7 +835,8 @@ libscicore_la_CPPFLAGS = -I$(srcdir)/includes/ -I$(srcdir)/src/c/ \ -I$(top_srcdir)/modules/history_manager/includes/ \ -I$(top_srcdir)/modules/preferences/includes/ \ -I$(top_srcdir)/modules/external_objects/includes/ \ - $(XML_FLAGS) $(AM_CPPFLAGS) $(am__append_3) + -I$(top_srcdir)/modules/functions/includes/ $(XML_FLAGS) \ + $(AM_CPPFLAGS) $(am__append_3) @MAINTAINER_MODE_TRUE@pkglib_LTLIBRARIES = libscicore.la @MAINTAINER_MODE_FALSE@noinst_LTLIBRARIES = libscicore-algo.la libscicore.la @MAINTAINER_MODE_TRUE@noinst_LTLIBRARIES = libscicore-algo.la @@ -2646,9 +2646,6 @@ sci_f_exists.lo: sci_gateway/fortran/sci_f_exists.f sci_f_errcatch.lo: sci_gateway/fortran/sci_f_errcatch.f $(LIBTOOL) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS) -c -o sci_f_errcatch.lo `test -f 'sci_gateway/fortran/sci_f_errcatch.f' || echo '$(srcdir)/'`sci_gateway/fortran/sci_f_errcatch.f -sci_f_clear.lo: sci_gateway/fortran/sci_f_clear.f - $(LIBTOOL) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS) -c -o sci_f_clear.lo `test -f 'sci_gateway/fortran/sci_f_clear.f' || echo '$(srcdir)/'`sci_gateway/fortran/sci_f_clear.f - sci_f_argn.lo: sci_gateway/fortran/sci_f_argn.f $(LIBTOOL) --tag=F77 $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) --mode=compile $(F77) $(AM_FFLAGS) $(FFLAGS) -c -o sci_f_argn.lo `test -f 'sci_gateway/fortran/sci_f_argn.f' || echo '$(srcdir)/'`sci_gateway/fortran/sci_f_argn.f diff --git a/scilab/modules/core/sci_gateway/c/sci_clear.c b/scilab/modules/core/sci_gateway/c/sci_clear.c index 43c0f5c..d71ef4e 100644 --- a/scilab/modules/core/sci_gateway/c/sci_clear.c +++ b/scilab/modules/core/sci_gateway/c/sci_clear.c @@ -1,22 +1,156 @@ /* * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab * Copyright (C) 2006 - INRIA - Allan CORNET - * + * Copyright (C) 2011 - DIGITEO - Allan CORNET + * * This file must be used under the terms of the CeCILL. * This source file is licensed as described in the file COPYING, which * you should have received as part of this distribution. The terms - * are also available at + * are also available at * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt * */ +#include +#include +#include #include "gw_core.h" #include "machine.h" +#include "stack-c.h" +#include "BOOL.h" +#include "localization.h" +#include "Scierror.h" +#include "MALLOC.h" +#include "call_scilab.h" +#include "isScilabFunction.h" +#include "api_scilab.h" + +/*--------------------------------------------------------------------------*/ +static int clearAllVariablesOnStack(void); +/*--------------------------------------------------------------------------*/ +static int sci_clear_no_rhs(const char *fname); +static int sci_clear_n_rhs(const char *fname); /*--------------------------------------------------------------------------*/ -extern int C2F(intclear)(char *fname,unsigned long fname_len); +extern int C2F(stackp)(int *, int *); /* fortran subroutine */ /*--------------------------------------------------------------------------*/ int C2F(sci_clear)(char *fname,unsigned long fname_len) { - C2F(intclear)(fname,fname_len); - return 0; + if (Rhs == 0) + { + sci_clear_no_rhs(fname); + } + else + { + sci_clear_n_rhs(fname); + } + return 0; +} +/*--------------------------------------------------------------------------*/ +static int sci_clear_no_rhs(const char *fname) +{ + if (C2F(recu).macr != 0 || C2F(recu).paus != 0) + { + int k = 0; + if (C2F(recu).rstk[C2F(recu).pt - 3] == 909) + { + /* clear within an exec'd macro */ + return clearAllVariablesOnStack(); + } + /* clear within a macro, an execstr, an exec or a pause */ + k = C2F(iop).lpt[0] - 19; + if (C2F(iop).lin[k + 6] != 0 && ((int *)&C2F(stack))[C2F(iop).lin[k + 5] - 1] == 10) + { + PutLhsVar(); + return 0; + } + /* clear within a macro, an exec or a pause */ + /* Computing MIN */ + Bot = Min(C2F(vstk).bbot, C2F(iop).lin[k + 4]); + PutLhsVar(); + return 0; + } + return clearAllVariablesOnStack(); } /*--------------------------------------------------------------------------*/ +static int sci_clear_n_rhs(const char *fname) +{ + int k = 0; + int i = 0; + int nbVariables = Rhs; + char **VariableNameToClear = (char **)MALLOC(sizeof(char*) * nbVariables); + + if (!VariableNameToClear) + { + Scierror(999,_("%s: No more memory.\n"), fname); + return 0; + } + + for (k = 0; k < nbVariables; k++) + { + int *piAddressVar = NULL; + SciErr sciErr = getVarAddressFromPosition(pvApiCtx, k + 1, &piAddressVar); + if (!sciErr.iErr) + { + if (isScalar(pvApiCtx, piAddressVar) && isStringType(pvApiCtx, piAddressVar)) + { + char *variablename = NULL; + if (getAllocatedSingleString(pvApiCtx, piAddressVar, &variablename) == 0) + { + VariableNameToClear[i] = variablename; + i++; + } + else + { + freeAllocatedMatrixOfString(i, 1, VariableNameToClear); + VariableNameToClear = NULL; + Scierror(999,_("%s: No more memory.\n"), fname); + return 0; + } + } + else + { + freeAllocatedMatrixOfString(i, 1, VariableNameToClear); + VariableNameToClear = NULL; + + if (isScalar(pvApiCtx, piAddressVar)) + { + Scierror(201, _("%s: Wrong type for argument %d: Valid variable name expected.\n"), fname, k + 1); + return 0; + } + else + { + Scierror(999, _("%s: Wrong size for argument %d: Valid variable name expected.\n"), fname, k + 1); + return 0; + } + } + } + } + + for (k = 0; k < nbVariables; k++) + { + deleteNamedVariable(NULL, VariableNameToClear[k]); + } + + if (VariableNameToClear) + { + freeAllocatedMatrixOfString(nbVariables, 1, VariableNameToClear); + VariableNameToClear = NULL; + } + PutLhsVar(); + return 0; +} +/*--------------------------------------------------------------------------*/ +int clearAllVariablesOnStack(void) +{ + /* clear all variables */ + int il = 0; + Fin = 0; + C2F(adre).is = Fin; + Bot = C2F(vstk).bbot; + + //create a null matrix a the Top of the stack + Top = Top + 1; + il = iadr(*Lstk(Top)); + *istk(il) = 0; + *Lstk(Top + 1) = *Lstk(Top) + 1; + return 0; +} diff --git a/scilab/modules/core/sci_gateway/fortran/sci_f_clear.f b/scilab/modules/core/sci_gateway/fortran/sci_f_clear.f deleted file mode 100644 index 359e844..0000000 --- a/scilab/modules/core/sci_gateway/fortran/sci_f_clear.f +++ /dev/null @@ -1,103 +0,0 @@ -c Scilab ( http://www.scilab.org/ ) - This file is part of Scilab -c Copyright (C) INRIA -c -c This file must be used under the terms of the CeCILL. -c This source file is licensed as described in the file COPYING, which -c you should have received as part of this distribution. The terms -c are also available at -c http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt - subroutine intclear(fname) - include 'stack.h' -c - parameter (nz3=nsiz-3,nz2=nsiz-2) - character*(*) fname - integer top0,id(nsiz) - logical getsmat,checkval,checklhs - integer iadr - integer a, blank,percen,helps(nsiz) - - - data a/10/,blank/40/,percen/56/ - data helps /353243448,673717273,nz2*673720360/ - - iadr(l)=l+l-1 - -c - if(.not.checklhs(fname,1,1)) return - - if(rhs.le.0) then - if (macr.ne.0 .or. paus.ne.0) then - if(rstk(pt-2).eq.909) then -c . clear within an exec'd macro - goto 01 - endif -c . clear within a macro, an execstr, an exec or a pause - k = lpt(1) - (13+nsiz) - if(lin(k+7).ne.0.and.istk(lin(k+6)).eq.10) goto 02 -c . clear within a macro, an exec or a pause - bot = min(bbot,lin(k+5)) - goto 02 - endif - - 01 continue -c . clear all variable - -c . preserve %help variable - i1=bbot - fin=-1 - call stackg(helps) - if(err.gt.0) return - if (fin.gt.0) i1=min(fin,i1) - - fin=0 - call stackg(helps) - if(err.gt.0) return - ih=fin - - fin=0 - is=fin - bot = bbot - if(ih.eq.-1) then - call stackp(helps,0) - if(err.gt.0) return - endif - 02 top=top+1 - il = iadr(lstk(top)) - istk(il) = 0 - lstk(top+1) = lstk(top) + 1 - return - endif - - top0=top - do 10 k=1,rhs - if(.not.getsmat(fname,top0,top,m,n,1,1,lr,nlr)) return - if(.not.checkval(fname,m*n,1)) return - if(nlr.eq.0) then - top=top-1 - goto 10 - endif -c . check for valid variable name - do 05 i=0,nlr-1 - ic=abs(istk(lr+i)) - if((ic.gt.blank.and.(i.gt.0.and.ic.eq.percen)).or. - $ (i.eq.0.and.ic.lt.a)) then - err=rhs+1-k - call error(248) - return - endif - 05 continue - call namstr(id,istk(lr),nlr,0) - il = iadr(lstk(top)) - istk(il) = 0 - lstk(top+1) = lstk(top) + 1 - rhs = 0 - call stackp(id,0) - if (err .gt. 0.or.err1.gt.0) return - fin = 1 - 10 continue - top=top+1 - il = iadr(lstk(top)) - istk(il) = 0 - lstk(top+1) = lstk(top) + 1 - end - diff --git a/scilab/modules/core/src/fortran/core_f.vfproj b/scilab/modules/core/src/fortran/core_f.vfproj index ce1eac1..ee72082 100644 --- a/scilab/modules/core/src/fortran/core_f.vfproj +++ b/scilab/modules/core/src/fortran/core_f.vfproj @@ -136,7 +136,6 @@ - diff --git a/scilab/modules/core/src/fortran/core_f2c.vcxproj b/scilab/modules/core/src/fortran/core_f2c.vcxproj index d014152..38756ee 100644 --- a/scilab/modules/core/src/fortran/core_f2c.vcxproj +++ b/scilab/modules/core/src/fortran/core_f2c.vcxproj @@ -321,7 +321,6 @@ cd .. - @@ -430,7 +429,6 @@ cd .. - diff --git a/scilab/modules/core/src/fortran/core_f2c.vcxproj.filters b/scilab/modules/core/src/fortran/core_f2c.vcxproj.filters index 8c61bf4..e78c0df 100644 --- a/scilab/modules/core/src/fortran/core_f2c.vcxproj.filters +++ b/scilab/modules/core/src/fortran/core_f2c.vcxproj.filters @@ -279,9 +279,6 @@ Source Files - - Source Files - Source Files @@ -598,9 +595,6 @@ Fortran Files - - Fortran Files - Fortran Files diff --git a/scilab/modules/core/tests/unit_tests/clear.dia.ref b/scilab/modules/core/tests/unit_tests/clear.dia.ref index f3fdc94..543ba09 100644 --- a/scilab/modules/core/tests/unit_tests/clear.dia.ref +++ b/scilab/modules/core/tests/unit_tests/clear.dia.ref @@ -32,7 +32,7 @@ msg_ref = msprintf(gettext("Redefining permanent variable.\n")); assert_checkequal (msg_err, msg_ref); ierr = execstr("clear(1)", "errcatch"); assert_checkequal(ierr, 201); -msg_ref = msprintf(gettext("%s: Wrong type for argument #%d: String matrix expected.\n"), "clear", 1); +msg_ref = msprintf(gettext("%s: Wrong type for argument %d: Valid variable name expected.\n"), "clear", 1); assert_checkerror ("clear(1)", msg_ref); ierr = execstr("clear toto", "errcatch"); assert_checkequal(ierr, 0); diff --git a/scilab/modules/core/tests/unit_tests/clear.tst b/scilab/modules/core/tests/unit_tests/clear.tst index 02d3301..bb169f6 100644 --- a/scilab/modules/core/tests/unit_tests/clear.tst +++ b/scilab/modules/core/tests/unit_tests/clear.tst @@ -7,6 +7,8 @@ // <-- CLI SHELL MODE --> // +// <-- JVM NOT MANDATORY --> + A = 2; B = 4; C = 6; @@ -37,7 +39,7 @@ assert_checkequal (msg_err, msg_ref); ierr = execstr("clear(1)", "errcatch"); assert_checkequal(ierr, 201); -msg_ref = msprintf(gettext("%s: Wrong type for argument #%d: String matrix expected.\n"), "clear", 1); +msg_ref = msprintf(gettext("%s: Wrong type for argument %d: Valid variable name expected.\n"), "clear", 1); assert_checkerror ("clear(1)", msg_ref); ierr = execstr("clear toto", "errcatch"); -- 1.7.9.5