summaryrefslogtreecommitdiffstats
path: root/scilab/modules/intersci
diff options
context:
space:
mode:
authorBruno JOFRET <bruno.jofret@scilab-enterprises.com>2012-01-13 08:22:26 +0100
committerAllan CORNET <allan.cornet@scilab.org>2012-01-16 11:21:42 +0100
commit158ded1146180e37230e2ef13092071bd4c87562 (patch)
tree987bc0f46731aa6f4d06e99e85a170437cfbaec8 /scilab/modules/intersci
parent94f30dbc65765baf3cd6bfdb46004a5b18652858 (diff)
parent84760bd6477062829ce71f86949644912bfc0f5e (diff)
downloadscilab-158ded1146180e37230e2ef13092071bd4c87562.zip
scilab-158ded1146180e37230e2ef13092071bd4c87562.tar.gz
Merge remote-tracking branch 'origin/master' into YaSp
Conflicts: scilab/Makefile.am scilab/Makefile.in scilab/Scilab.sln scilab/configure scilab/configure.ac scilab/etc/classpath.xml.vc scilab/etc/modules.xml.in scilab/etc/modules.xml.vc scilab/libs/DetectFrameWork2/DetectFramework.vcxproj.filters scilab/libs/GetWindowsVersion/GetWindowsVersion.rc scilab/libs/MALLOC/MALLOC.rc scilab/libs/doublylinkedlist/doublylinkedlist.rc scilab/libs/dynamiclibrary/dynamiclibrary.rc scilab/libs/hashtable/hashtable.rc scilab/libs/libst/libst.rc scilab/modules/Makefile.am scilab/modules/Makefile.in scilab/modules/action_binding/sci_gateway/cpp/sci_notify.cpp scilab/modules/api_scilab/src/cpp/api_boolean.cpp scilab/modules/api_scilab/src/cpp/api_boolean_sparse.cpp scilab/modules/api_scilab/src/cpp/api_int.cpp scilab/modules/api_scilab/src/cpp/api_poly.cpp scilab/modules/api_scilab/src/cpp/api_sparse.cpp scilab/modules/api_scilab/src/cpp/api_string.cpp scilab/modules/arnoldi/Makefile.in scilab/modules/boolean/Makefile.in scilab/modules/call_scilab/src/c/SendScilabJobs.c scilab/modules/commons/src/c/commons.vcxproj scilab/modules/commons/src/jni/ScilabCommons.i scilab/modules/commons/src/jni/ScilabCommons_wrap.c scilab/modules/completion/Makefile.am scilab/modules/completion/Makefile.in scilab/modules/console/Makefile.am scilab/modules/console/Makefile.in scilab/modules/console/src/c/GetCommandLine.c scilab/modules/console/src/noconsole/noconsole.vcxproj scilab/modules/core/Makefile.am scilab/modules/core/Makefile.in scilab/modules/core/sci_gateway/c/sci_exit.c scilab/modules/core/sci_gateway/c/sci_getversion.c scilab/modules/core/sci_gateway/c/sci_lasterror.c scilab/modules/core/src/c/banier.c scilab/modules/core/src/c/core.vcxproj scilab/modules/core/src/c/getdynamicDebugInfo_Windows.c scilab/modules/core/src/c/stack2.c scilab/modules/core/src/fortran/fact.f scilab/modules/core/src/java/org/scilab/modules/core/Scilab.java scilab/modules/data_structures/Makefile.am scilab/modules/data_structures/Makefile.in scilab/modules/development_tools/macros/test_run.sci scilab/modules/dynamic_link/Makefile.in scilab/modules/elementary_functions/Makefile.am scilab/modules/elementary_functions/Makefile.in scilab/modules/elementary_functions/includes/gw_elementary_functions.h scilab/modules/elementary_functions/sci_gateway/c/gw_elementary_functions.c scilab/modules/elementary_functions/sci_gateway/c/sci_frexp.c scilab/modules/elementary_functions/sci_gateway/c/sci_size.c scilab/modules/elementary_functions/src/c/convertbase.h scilab/modules/elementary_functions/src/c/elementary_functions.vcxproj scilab/modules/elementary_functions/src/c/elementary_functions.vcxproj.filters scilab/modules/elementary_functions/src/fortran/eispack/eispack_f.rc scilab/modules/fileio/Makefile.in scilab/modules/fileio/fileio.vcxproj scilab/modules/fileio/fileio.vcxproj.filters scilab/modules/fileio/macros/fullfile.sci scilab/modules/fileio/sci_gateway/c/sci_basename.c scilab/modules/fileio/sci_gateway/c/sci_copyfile.c scilab/modules/fileio/sci_gateway/c/sci_fileparts.c scilab/modules/fileio/sci_gateway/c/sci_findfiles.c scilab/modules/fileio/sci_gateway/c/sci_fprintfMat.c scilab/modules/fileio/sci_gateway/c/sci_fscanfMat.c scilab/modules/fileio/sci_gateway/c/sci_fullpath.c scilab/modules/fileio/sci_gateway/c/sci_isdir.c scilab/modules/fileio/sci_gateway/c/sci_isfile.c scilab/modules/fileio/sci_gateway/c/sci_mgetl.c scilab/modules/fileio/sci_gateway/c/sci_movefile.c scilab/modules/fileio/sci_gateway/c/sci_mputl.c scilab/modules/fileio/sci_gateway/c/sci_pathconvert.c scilab/modules/fileio/src/c/mget.c scilab/modules/fileio/src/c/mopen.c scilab/modules/functions/sci_gateway/c/sci_whereis.c scilab/modules/gui/etc/main_menubar.xml scilab/modules/gui/gui.iss scilab/modules/gui/src/c/LibScilab_Import.def scilab/modules/gui/src/c/gui.vcxproj scilab/modules/gui/src/c/gui.vcxproj.filters scilab/modules/hdf5/Makefile.am scilab/modules/hdf5/Makefile.in scilab/modules/hdf5/sci_gateway/cpp/sci_import_from_hdf5.cpp scilab/modules/hdf5/src/c/h5_readDataFromFile.c scilab/modules/hdf5/src/c/h5_writeDataToFile.c scilab/modules/helptools/Makefile.in scilab/modules/helptools/data/pages/homepage-en_US.html scilab/modules/helptools/data/pages/homepage-fr_FR.html scilab/modules/helptools/includes/gw_helptools.h scilab/modules/helptools/macros/xmltoformat.sci scilab/modules/helptools/sci_gateway/c/gw_helptools.c scilab/modules/helptools/sci_gateway/cpp/sci_buildDoc.cpp scilab/modules/helptools/sci_gateway/cpp/sci_buildDocv2.cpp scilab/modules/helptools/sci_gateway/helptools_gateway.xml scilab/modules/history_manager/sci_gateway/c/sci_saveafterncommands.c scilab/modules/history_manager/src/c/getCommentDateSession.c scilab/modules/history_manager/src/c/getCommentDateSession.h scilab/modules/history_manager/src/cpp/HistoryManager.cpp scilab/modules/integer/Makefile.in scilab/modules/intersci/src/exe/intersci-n.c scilab/modules/io/Makefile.in scilab/modules/io/sci_gateway/c/sci_file.c scilab/modules/io/sci_gateway/c/sci_getenv.c scilab/modules/javasci/src/c/javasci2_helper.c scilab/modules/javasci/src/java/org/scilab/modules/javasci/Scilab.java scilab/modules/javasci/tests/java/javasci-JAVA-tests.vcxproj scilab/modules/jvm/src/c/InitializeJVM.c scilab/modules/linear_algebra/Makefile.in scilab/modules/linear_algebra/tests/unit_tests/bdiag.dia.ref scilab/modules/linear_algebra/tests/unit_tests/bdiag.tst scilab/modules/localization/src/c/setgetlanguage.c scilab/modules/maple2scilab/Makefile.in scilab/modules/maple2scilab/maple2scilab.iss scilab/modules/mexlib/Makefile.in scilab/modules/output_stream/Makefile.in scilab/modules/output_stream/output_stream.iss scilab/modules/output_stream/sci_gateway/c/sci_msprintf.c scilab/modules/output_stream/src/java/output_stream-JAVA.vcxproj scilab/modules/polynomials/src/c/polynomials.rc scilab/modules/prebuildjava/Makefile.in scilab/modules/signal_processing/Makefile.am scilab/modules/signal_processing/Makefile.in scilab/modules/signal_processing/includes/gw_signal.h scilab/modules/signal_processing/sci_gateway/c/gw_signal.c scilab/modules/signal_processing/sci_gateway/signal_processing_gateway.xml scilab/modules/signal_processing/src/c/Libscilab_Import.def scilab/modules/signal_processing/src/c/signal_processing.vcxproj scilab/modules/signal_processing/src/c/signal_processing.vcxproj.filters scilab/modules/special_functions/src/c/LibScilab_Import.def scilab/modules/spreadsheet/src/c/xls.c scilab/modules/statistics/src/dcdflib/dcd_f/dcd_f.rc scilab/modules/string/Makefile.am scilab/modules/string/Makefile.in scilab/modules/string/sci_gateway/c/sci_isalphanum.c scilab/modules/string/sci_gateway/c/sci_isdigit.c scilab/modules/string/sci_gateway/c/sci_length.c scilab/modules/string/sci_gateway/c/sci_strchr.c scilab/modules/string/sci_gateway/c/sci_strsplit.c scilab/modules/string/sci_gateway/c/sci_strsubst.c scilab/modules/string/src/c/string.vcxproj scilab/modules/string/src/c/string.vcxproj.filters scilab/modules/texmacs/texmacs.iss scilab/modules/time/Makefile.in scilab/modules/types/Makefile.am scilab/modules/types/Makefile.in scilab/modules/types/src/java/org/scilab/modules/types/ScilabInteger.java scilab/modules/types/types.iss scilab/modules/types/types.vcxproj scilab/modules/types/types.vcxproj.filters scilab/modules/ui_data/Makefile.am scilab/modules/ui_data/Makefile.in scilab/modules/ui_data/sci_gateway/c/gw_ui_data.c scilab/modules/ui_data/sci_gateway/cpp/sci_browsevar.cpp scilab/modules/ui_data/sci_gateway/cpp/sci_editvar.cpp scilab/modules/ui_data/src/c/ui_data.vcxproj scilab/modules/ui_data/src/c/ui_data.vcxproj.filters scilab/modules/ui_data/src/cpp/UpdateBrowseVar.cpp scilab/modules/umfpack/src/c/taucs_scilab.c scilab/modules/windows_tools/sci_gateway/c/sci_winqueryreg.c scilab/modules/windows_tools/src/c/LibScilab_Import.def scilab/modules/windows_tools/src/c/WScilex/WScilex.rc scilab/modules/xcos/sci_gateway/c/gw_xcos.c scilab/modules/xcos/sci_gateway/cpp/sci_xcosConfigureXmlFile.cpp scilab/modules/xml/Makefile.am scilab/modules/xml/Makefile.in scilab/modules/xml/sci_gateway/cpp/sci_xmlDelete.cpp scilab/modules/xml/sci_gateway/cpp/sci_xmlGetOpenDocs.cpp scilab/modules/xml/sci_gateway/cpp/sci_xmlWrite.cpp scilab/modules/xml/sci_gateway/cpp/sci_xmlXPath.cpp scilab/modules/xml/xml.vcxproj scilab/scilab-lib.properties.vc scilab/tools/innosetup/code_modules.iss scilab/tools/innosetup/components.iss Change-Id: If35768ca5ba97e9508c0004f5b0ea8d4fa4e0e9f
Diffstat (limited to 'scilab/modules/intersci')
-rw-r--r--scilab/modules/intersci/Makefile.am5
-rw-r--r--scilab/modules/intersci/Makefile.in40
-rw-r--r--scilab/modules/intersci/src/exe/intersci-n.c848
-rw-r--r--scilab/modules/intersci/src/exe/intersci.c3297
-rw-r--r--scilab/modules/intersci/src/lib/intersci.rc2
5 files changed, 2198 insertions, 1994 deletions
diff --git a/scilab/modules/intersci/Makefile.am b/scilab/modules/intersci/Makefile.am
index 6a9f0e8..6828334 100644
--- a/scilab/modules/intersci/Makefile.am
+++ b/scilab/modules/intersci/Makefile.am
@@ -24,7 +24,12 @@ src/exe/check.c
24libsciintersci_la_includedir=$(pkgincludedir) 24libsciintersci_la_includedir=$(pkgincludedir)
25libsciintersci_la_include_HEADERS = includes/libinter.h 25libsciintersci_la_include_HEADERS = includes/libinter.h
26 26
27if MAINTAINER_MODE
27pkglib_LTLIBRARIES = libsciintersci.la 28pkglib_LTLIBRARIES = libsciintersci.la
29else
30noinst_LTLIBRARIES = libsciintersci.la
31endif
32
28 33
29libsciintersci_la_LDFLAGS = -version-number $(SCILAB_LIBRARY_VERSION) 34libsciintersci_la_LDFLAGS = -version-number $(SCILAB_LIBRARY_VERSION)
30 35
diff --git a/scilab/modules/intersci/Makefile.in b/scilab/modules/intersci/Makefile.in
index 0cd851a..290bb53 100644
--- a/scilab/modules/intersci/Makefile.in
+++ b/scilab/modules/intersci/Makefile.in
@@ -112,7 +112,7 @@ am__installdirs = "$(DESTDIR)$(pkglibdir)" "$(DESTDIR)$(bindir)" \
112 "$(DESTDIR)$(libsciintersci_la_etcdir)" \ 112 "$(DESTDIR)$(libsciintersci_la_etcdir)" \
113 "$(DESTDIR)$(libsciintersci_la_rootdir)" \ 113 "$(DESTDIR)$(libsciintersci_la_rootdir)" \
114 "$(DESTDIR)$(libsciintersci_la_includedir)" 114 "$(DESTDIR)$(libsciintersci_la_includedir)"
115LTLIBRARIES = $(pkglib_LTLIBRARIES) 115LTLIBRARIES = $(noinst_LTLIBRARIES) $(pkglib_LTLIBRARIES)
116libsciintersci_la_LIBADD = 116libsciintersci_la_LIBADD =
117am__objects_1 = libsciintersci_la-libinter.lo libsciintersci_la-out.lo 117am__objects_1 = libsciintersci_la-libinter.lo libsciintersci_la-out.lo
118am_libsciintersci_la_OBJECTS = $(am__objects_1) 118am_libsciintersci_la_OBJECTS = $(am__objects_1)
@@ -121,6 +121,8 @@ libsciintersci_la_LINK = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) \
121 $(LIBTOOLFLAGS) --mode=link $(CCLD) \ 121 $(LIBTOOLFLAGS) --mode=link $(CCLD) \
122 $(libsciintersci_la_CFLAGS) $(CFLAGS) \ 122 $(libsciintersci_la_CFLAGS) $(CFLAGS) \
123 $(libsciintersci_la_LDFLAGS) $(LDFLAGS) -o $@ 123 $(libsciintersci_la_LDFLAGS) $(LDFLAGS) -o $@
124@MAINTAINER_MODE_FALSE@am_libsciintersci_la_rpath =
125@MAINTAINER_MODE_TRUE@am_libsciintersci_la_rpath = -rpath $(pkglibdir)
124PROGRAMS = $(bin_PROGRAMS) 126PROGRAMS = $(bin_PROGRAMS)
125am__objects_2 = intersci-intersci-n.$(OBJEXT) \ 127am__objects_2 = intersci-intersci-n.$(OBJEXT) \
126 intersci-getrhs.$(OBJEXT) intersci-crerhs.$(OBJEXT) \ 128 intersci-getrhs.$(OBJEXT) intersci-crerhs.$(OBJEXT) \
@@ -161,6 +163,7 @@ AMTAR = @AMTAR@
161ANT = @ANT@ 163ANT = @ANT@
162ANTLR = @ANTLR@ 164ANTLR = @ANTLR@
163AR = @AR@ 165AR = @AR@
166ARPACK_LIBS = @ARPACK_LIBS@
164AUTOCONF = @AUTOCONF@ 167AUTOCONF = @AUTOCONF@
165AUTOHEADER = @AUTOHEADER@ 168AUTOHEADER = @AUTOHEADER@
166AUTOMAKE = @AUTOMAKE@ 169AUTOMAKE = @AUTOMAKE@
@@ -170,6 +173,7 @@ BATIK = @BATIK@
170BLAS_LIBS = @BLAS_LIBS@ 173BLAS_LIBS = @BLAS_LIBS@
171BSH = @BSH@ 174BSH = @BSH@
172CC = @CC@ 175CC = @CC@
176CCACHE = @CCACHE@
173CCDEPMODE = @CCDEPMODE@ 177CCDEPMODE = @CCDEPMODE@
174CFLAGS = @CFLAGS@ 178CFLAGS = @CFLAGS@
175CHECKSTYLE = @CHECKSTYLE@ 179CHECKSTYLE = @CHECKSTYLE@
@@ -235,6 +239,7 @@ JAVA_G = @JAVA_G@
235JAVA_HOME = @JAVA_HOME@ 239JAVA_HOME = @JAVA_HOME@
236JAVA_JNI_INCLUDE = @JAVA_JNI_INCLUDE@ 240JAVA_JNI_INCLUDE = @JAVA_JNI_INCLUDE@
237JAVA_JNI_LIBS = @JAVA_JNI_LIBS@ 241JAVA_JNI_LIBS = @JAVA_JNI_LIBS@
242JCOMMANDER = @JCOMMANDER@
238JDB = @JDB@ 243JDB = @JDB@
239JEUCLID_CORE = @JEUCLID_CORE@ 244JEUCLID_CORE = @JEUCLID_CORE@
240JGRAPHX = @JGRAPHX@ 245JGRAPHX = @JGRAPHX@
@@ -428,7 +433,8 @@ src/exe/check.c
428 433
429libsciintersci_la_includedir = $(pkgincludedir) 434libsciintersci_la_includedir = $(pkgincludedir)
430libsciintersci_la_include_HEADERS = includes/libinter.h 435libsciintersci_la_include_HEADERS = includes/libinter.h
431pkglib_LTLIBRARIES = libsciintersci.la 436@MAINTAINER_MODE_TRUE@pkglib_LTLIBRARIES = libsciintersci.la
437@MAINTAINER_MODE_FALSE@noinst_LTLIBRARIES = libsciintersci.la
432libsciintersci_la_LDFLAGS = -version-number $(SCILAB_LIBRARY_VERSION) 438libsciintersci_la_LDFLAGS = -version-number $(SCILAB_LIBRARY_VERSION)
433intersci_SOURCES = $(INTERSCI_EXE_C_SOURCES) 439intersci_SOURCES = $(INTERSCI_EXE_C_SOURCES)
434intersci_CFLAGS = -I$(top_srcdir)/modules/string/includes 440intersci_CFLAGS = -I$(top_srcdir)/modules/string/includes
@@ -551,6 +557,15 @@ $(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps)
551$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps) 557$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps)
552 cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh 558 cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh
553$(am__aclocal_m4_deps): 559$(am__aclocal_m4_deps):
560
561clean-noinstLTLIBRARIES:
562 -test -z "$(noinst_LTLIBRARIES)" || rm -f $(noinst_LTLIBRARIES)
563 @list='$(noinst_LTLIBRARIES)'; for p in $$list; do \
564 dir="`echo $$p | sed -e 's|/[^/]*$$||'`"; \
565 test "$$dir" != "$$p" || dir=.; \
566 echo "rm -f \"$${dir}/so_locations\""; \
567 rm -f "$${dir}/so_locations"; \
568 done
554install-pkglibLTLIBRARIES: $(pkglib_LTLIBRARIES) 569install-pkglibLTLIBRARIES: $(pkglib_LTLIBRARIES)
555 @$(NORMAL_INSTALL) 570 @$(NORMAL_INSTALL)
556 test -z "$(pkglibdir)" || $(MKDIR_P) "$(DESTDIR)$(pkglibdir)" 571 test -z "$(pkglibdir)" || $(MKDIR_P) "$(DESTDIR)$(pkglibdir)"
@@ -583,7 +598,7 @@ clean-pkglibLTLIBRARIES:
583 rm -f "$${dir}/so_locations"; \ 598 rm -f "$${dir}/so_locations"; \
584 done 599 done
585libsciintersci.la: $(libsciintersci_la_OBJECTS) $(libsciintersci_la_DEPENDENCIES) 600libsciintersci.la: $(libsciintersci_la_OBJECTS) $(libsciintersci_la_DEPENDENCIES)
586 $(libsciintersci_la_LINK) -rpath $(pkglibdir) $(libsciintersci_la_OBJECTS) $(libsciintersci_la_LIBADD) $(LIBS) 601 $(libsciintersci_la_LINK) $(am_libsciintersci_la_rpath) $(libsciintersci_la_OBJECTS) $(libsciintersci_la_LIBADD) $(LIBS)
587install-binPROGRAMS: $(bin_PROGRAMS) 602install-binPROGRAMS: $(bin_PROGRAMS)
588 @$(NORMAL_INSTALL) 603 @$(NORMAL_INSTALL)
589 test -z "$(bindir)" || $(MKDIR_P) "$(DESTDIR)$(bindir)" 604 test -z "$(bindir)" || $(MKDIR_P) "$(DESTDIR)$(bindir)"
@@ -1025,7 +1040,7 @@ maintainer-clean-generic:
1025clean: clean-am 1040clean: clean-am
1026 1041
1027clean-am: clean-binPROGRAMS clean-generic clean-libtool clean-local \ 1042clean-am: clean-binPROGRAMS clean-generic clean-libtool clean-local \
1028 clean-pkglibLTLIBRARIES mostlyclean-am 1043 clean-noinstLTLIBRARIES clean-pkglibLTLIBRARIES mostlyclean-am
1029 1044
1030distclean: distclean-am 1045distclean: distclean-am
1031 -rm -rf ./$(DEPDIR) 1046 -rm -rf ./$(DEPDIR)
@@ -1103,14 +1118,15 @@ uninstall-am: uninstall-binPROGRAMS \
1103 1118
1104.PHONY: CTAGS GTAGS all all-am all-local check check-am check-local \ 1119.PHONY: CTAGS GTAGS all all-am all-local check check-am check-local \
1105 clean clean-binPROGRAMS clean-generic clean-libtool \ 1120 clean clean-binPROGRAMS clean-generic clean-libtool \
1106 clean-local clean-pkglibLTLIBRARIES ctags distclean \ 1121 clean-local clean-noinstLTLIBRARIES clean-pkglibLTLIBRARIES \
1107 distclean-compile distclean-generic distclean-libtool \ 1122 ctags distclean distclean-compile distclean-generic \
1108 distclean-local distclean-tags distdir dvi dvi-am html html-am \ 1123 distclean-libtool distclean-local distclean-tags distdir dvi \
1109 info info-am install install-am install-binPROGRAMS \ 1124 dvi-am html html-am info info-am install install-am \
1110 install-data install-data-am install-data-local install-dvi \ 1125 install-binPROGRAMS install-data install-data-am \
1111 install-dvi-am install-exec install-exec-am install-html \ 1126 install-data-local install-dvi install-dvi-am install-exec \
1112 install-html-am install-html-local install-info \ 1127 install-exec-am install-html install-html-am \
1113 install-info-am install-libsciintersci_la_etcDATA \ 1128 install-html-local install-info install-info-am \
1129 install-libsciintersci_la_etcDATA \
1114 install-libsciintersci_la_includeHEADERS \ 1130 install-libsciintersci_la_includeHEADERS \
1115 install-libsciintersci_la_rootDATA install-man install-pdf \ 1131 install-libsciintersci_la_rootDATA install-man install-pdf \
1116 install-pdf-am install-pkglibLTLIBRARIES install-ps \ 1132 install-pdf-am install-pkglibLTLIBRARIES install-ps \
diff --git a/scilab/modules/intersci/src/exe/intersci-n.c b/scilab/modules/intersci/src/exe/intersci-n.c
index a6f698e..8ca81a3 100644
--- a/scilab/modules/intersci/src/exe/intersci-n.c
+++ b/scilab/modules/intersci/src/exe/intersci-n.c
@@ -22,35 +22,37 @@
22 22
23/* global variables */ 23/* global variables */
24 24
25int icre=1; /* incremental counter for variable creation */ 25int icre = 1; /* incremental counter for variable creation */
26int indent = 0; /* incremental counter for code indentation */ 26int indent = 0; /* incremental counter for code indentation */
27int pass = 0 ; /* flag for couting pass on code generation */ 27int pass = 0; /* flag for couting pass on code generation */
28char target = 'C'; /* langage for generation */ 28char target = 'C'; /* langage for generation */
29 29
30VARPTR variables[MAXVAR]; /* array of VAR structures */ 30VARPTR variables[MAXVAR]; /* array of VAR structures */
31int nVariable; /* number of variables */ 31int nVariable; /* number of variables */
32BASFUNPTR basfun; /* SCILAB function structure */ 32BASFUNPTR basfun; /* SCILAB function structure */
33FORSUBPTR forsub; /* FORTRAN subroutine structure */ 33FORSUBPTR forsub; /* FORTRAN subroutine structure */
34int nFun; /* total number of functions in "desc" file */ 34int nFun; /* total number of functions in "desc" file */
35char *funNames[MAXFUN]; /* array of function names */ 35char *funNames[MAXFUN]; /* array of function names */
36char str1[4*MAXNAM]; 36char str1[4 * MAXNAM];
37char str2[4*MAXNAM]; 37char str2[4 * MAXNAM];
38 38
39static void GenBuilder ( char *file,char *files,char *libs ); 39static void GenBuilder(char *file, char *files, char *libs);
40void CheckCreateOrder(void); 40void CheckCreateOrder(void);
41
41/* local variables */ 42/* local variables */
42 43
43int main( int argc,char ** argv) 44int main(int argc, char **argv)
44{ 45{
45 char *files,*libs; 46 char *files, *libs;
46 char *file; 47 char *file;
47 int SciLabinterface = 0 ; 48 int SciLabinterface = 0;
49
48 switch (argc) 50 switch (argc)
49 { 51 {
50 case 2: 52 case 2:
51 file = argv[1]; 53 file = argv[1];
52 target = 'C'; 54 target = 'C';
53 SciLabinterface = 0; 55 SciLabinterface = 0;
54 files = NULL; 56 files = NULL;
55 libs = NULL; 57 libs = NULL;
56 break; 58 break;
@@ -77,18 +79,20 @@ int main( int argc,char ** argv)
77 break; 79 break;
78 } 80 }
79 basfun = BasfunAlloc(); 81 basfun = BasfunAlloc();
80 if (basfun == 0) { 82 if (basfun == 0)
83 {
81 printf("Running out of memory\n"); 84 printf("Running out of memory\n");
82 exit(1); 85 exit(1);
83 } 86 }
84 forsub = ForsubAlloc(); 87 forsub = ForsubAlloc();
85 if (forsub == 0) { 88 if (forsub == 0)
89 {
86 printf("Running out of memory\n"); 90 printf("Running out of memory\n");
87 exit(1); 91 exit(1);
88 } 92 }
89 Generate(file); 93 Generate(file);
90 GenFundef(file,SciLabinterface); 94 GenFundef(file, SciLabinterface);
91 GenBuilder(file,files,libs); 95 GenBuilder(file, files, libs);
92 exit(0); 96 exit(0);
93} 97}
94 98
@@ -103,32 +107,36 @@ void Generate(char *file)
103 FILE *fin, *fout, *foutv; 107 FILE *fin, *fout, *foutv;
104 char filout[MAXNAM]; 108 char filout[MAXNAM];
105 char filin[MAXNAM]; 109 char filin[MAXNAM];
106 sprintf(filin,"%s.desc",file); 110
107 fin = fopen(filin,"rt"); 111 sprintf(filin, "%s.desc", file);
108 if (fin == 0) { 112 fin = fopen(filin, "rt");
109 printf("Interface file \"%s\" does not exist\n",filin); 113 if (fin == 0)
114 {
115 printf("Interface file \"%s\" does not exist\n", filin);
110 exit(1); 116 exit(1);
111 } 117 }
112 Copyright(); 118 Copyright();
113 strcpy(filout,file); 119 strcpy(filout, file);
114 strcat(filout,(target == 'F' ) ? ".f" : ".c" ); 120 strcat(filout, (target == 'F') ? ".f" : ".c");
115 fout = fopen(filout,"wt"); 121 fout = fopen(filout, "wt");
116 strcpy(filout,file); 122 strcpy(filout, file);
117 strcat(filout,".tmp"); 123 strcat(filout, ".tmp");
118 foutv = fopen(filout,"wt"); 124 foutv = fopen(filout, "wt");
119 InitDeclare(); 125 InitDeclare();
120 nFun = 0; 126 nFun = 0;
121 Fprintf(fout,indent,"#include \"stack-c.h\"\n"); 127 Fprintf(fout, indent, "#include \"stack-c.h\"\n");
122 while(ReadFunction(fin)) { 128 while (ReadFunction(fin))
129 {
123 nFun++; 130 nFun++;
124 if (nFun > MAXFUN) { 131 if (nFun > MAXFUN)
125 printf("Too many SCILAB functions. The maximum is %d\n",MAXFUN); 132 {
133 printf("Too many SCILAB functions. The maximum is %d\n", MAXFUN);
126 exit(1); 134 exit(1);
127 } 135 }
128 pass=0; 136 pass = 0;
129 /** changing stack_positions (external variables are not in the stack)**/ 137 /** changing stack_positions (external variables are not in the stack)**/
130 FixStackPositions(); 138 FixStackPositions();
131 icrekp=icre; 139 icrekp = icre;
132 FixForNames(); 140 FixForNames();
133 ResetDeclare(); 141 ResetDeclare();
134 /** ShowVariables();**/ 142 /** ShowVariables();**/
@@ -138,15 +146,15 @@ void Generate(char *file)
138 ForNameClean(); 146 ForNameClean();
139 FixForNames(); 147 FixForNames();
140 /* scond pass to produce code */ 148 /* scond pass to produce code */
141 pass=1; 149 pass = 1;
142 icre=icrekp; 150 icre = icrekp;
143 WriteFunctionCode(fout); 151 WriteFunctionCode(fout);
144 /** WriteInfoCode(fout); **/ 152 /** WriteInfoCode(fout); **/
145 } 153 }
146 /* WriteMain(fout,file); */ 154 /* WriteMain(fout,file); */
147 printf("C file \"%s.c\" has been created\n",file); 155 printf("C file \"%s.c\" has been created\n", file);
148 /* WriteAddInter(file) ; 156 /* WriteAddInter(file) ;
149 printf("Scilab file \"%s.sce\" has been created\n",file);*/ 157 * printf("Scilab file \"%s.sce\" has been created\n",file); */
150 fclose(fout); 158 fclose(fout);
151 fclose(fin); 159 fclose(fin);
152} 160}
@@ -155,23 +163,25 @@ void Generate(char *file)
155* Interface function 163* Interface function
156***************************************************************/ 164***************************************************************/
157 165
158void WriteMain(FILE *f,char *file) 166void WriteMain(FILE * f, char *file)
159{ 167{
160 int i; 168 int i;
161 FCprintf(f,"\n/**********************\n"); 169
162 FCprintf(f," * interface function\n"); 170 FCprintf(f, "\n/**********************\n");
163 FCprintf(f," ********************/\n"); 171 FCprintf(f, " * interface function\n");
164 Fprintf(f,indent++,"static TabF Tab[]={\n"); 172 FCprintf(f, " ********************/\n");
165 for (i = 0; i < nFun; i++) { 173 Fprintf(f, indent++, "static TabF Tab[]={\n");
166 Fprintf(f,indent,"{ ints%s, \"%s\"},\n",funNames[i],funNames[i]); 174 for (i = 0; i < nFun; i++)
175 {
176 Fprintf(f, indent, "{ ints%s, \"%s\"},\n", funNames[i], funNames[i]);
167 } 177 }
168 Fprintf(f,--indent,"};\n\n"); 178 Fprintf(f, --indent, "};\n\n");
169 Fprintf(f,indent,"int C2F(%s)()\n",file); 179 Fprintf(f, indent, "int C2F(%s)()\n", file);
170 Fprintf(f,indent++,"{\n"); 180 Fprintf(f, indent++, "{\n");
171 Fprintf(f,indent,"Rhs=Max(0,Rhs);\n"); 181 Fprintf(f, indent, "Rhs=Max(0,Rhs);\n");
172 Fprintf(f,indent,"(*(Tab[Fin-1].f))(Tab[Fin-1].name);\n"); 182 Fprintf(f, indent, "(*(Tab[Fin-1].f))(Tab[Fin-1].name);\n");
173 Fprintf(f,indent,"return 0;\n"); 183 Fprintf(f, indent, "return 0;\n");
174 Fprintf(f,--indent,"};\n"); 184 Fprintf(f, --indent, "};\n");
175 185
176} 186}
177 187
@@ -184,32 +194,32 @@ void WriteAddInter(char *file)
184 FILE *fout; 194 FILE *fout;
185 int i; 195 int i;
186 char filout[MAXNAM]; 196 char filout[MAXNAM];
187 strcpy(filout,file); 197
188 strcat(filout,".sce"); 198 strcpy(filout, file);
189 fout = fopen(filout,"w"); 199 strcat(filout, ".sce");
190 if ( fout != (FILE*) 0) 200 fout = fopen(filout, "w");
201 if (fout != (FILE *) 0)
191 { 202 {
192 fprintf(fout,"// Addinter for file %s\n",file); 203 fprintf(fout, "// Addinter for file %s\n", file);
193 fprintf(fout,"// for hppa/sun-solaris/linux/dec\n"); 204 fprintf(fout, "// for hppa/sun-solaris/linux/dec\n");
194 fprintf(fout,"//--------------------------------\n"); 205 fprintf(fout, "//--------------------------------\n");
195 fprintf(fout,"//Scilab functions\n"); 206 fprintf(fout, "//Scilab functions\n");
196 fprintf(fout,"%s_funs=[...\n",file); 207 fprintf(fout, "%s_funs=[...\n", file);
197 for (i = 0; i < nFun -1; i++) 208 for (i = 0; i < nFun - 1; i++)
198 fprintf(fout," '%s';\n",funNames[i]); 209 fprintf(fout, " '%s';\n", funNames[i]);
199 fprintf(fout," '%s']\n",funNames[nFun-1]); 210 fprintf(fout, " '%s']\n", funNames[nFun - 1]);
200 fprintf(fout,"// interface file to link: ifile='%s.o'\n",file); 211 fprintf(fout, "// interface file to link: ifile='%s.o'\n", file);
201 fprintf(fout,"// user's files to link: ufiles=['file1.o','file2.o',....]\n"); 212 fprintf(fout, "// user's files to link: ufiles=['file1.o','file2.o',....]\n");
202 fprintf(fout,"addinter([files],'%s',%s_funs);\n",file,file); 213 fprintf(fout, "addinter([files],'%s',%s_funs);\n", file, file);
203 fclose(fout); 214 fclose(fout);
204 } 215 }
205 else 216 else
206 fprintf(stderr,"Can't open file %s\n",file); 217 fprintf(stderr, "Can't open file %s\n", file);
207} 218}
208 219
209
210void Copyright() 220void Copyright()
211{ 221{
212 printf("\nINTERSCI Version %s (%s)\n",VERSION,DATE); 222 printf("\nINTERSCI Version %s (%s)\n", VERSION, DATE);
213 printf(" Copyright (C) INRIA/ENPC All rights reserved\n\n"); 223 printf(" Copyright (C) INRIA/ENPC All rights reserved\n\n");
214} 224}
215 225
@@ -217,104 +227,99 @@ void Copyright()
217Code generation 227Code generation
218***************************************************************/ 228***************************************************************/
219 229
220void WriteHeader(FILE *f, char *fname0,char *fname) 230void WriteHeader(FILE * f, char *fname0, char *fname)
221{ 231{
222 Fprintf(f,indent,"\nint %s%s(char *fname)\n",fname0,fname); 232 Fprintf(f, indent, "\nint %s%s(char *fname)\n", fname0, fname);
223 Fprintf(f,indent,"{\n");indent++; 233 Fprintf(f, indent, "{\n");
234 indent++;
224 WriteDeclaration(f); 235 WriteDeclaration(f);
225} 236}
226 237
227void WriteFunctionCode(FILE *f) 238void WriteFunctionCode(FILE * f)
228{ 239{
229 int i; 240 int i;
230 IVAR ivar; 241 IVAR ivar;
231 if ( pass == 1) 242
243 if (pass == 1)
232 { 244 {
233 printf(" generating C interface for function (%s) Scilab function\"%s\"\n", 245 printf(" generating C interface for function (%s) Scilab function\"%s\"\n", forsub->name, basfun->name);
234 forsub->name,
235 basfun->name);
236 } 246 }
237 FCprintf(f,"/******************************************\n"); 247 FCprintf(f, "/******************************************\n");
238 FCprintf(f," * SCILAB function : %s, fin = %d\n",basfun->name,nFun); 248 FCprintf(f, " * SCILAB function : %s, fin = %d\n", basfun->name, nFun);
239 FCprintf(f," ******************************************/\n"); 249 FCprintf(f, " ******************************************/\n");
240 250
241 WriteHeader(f,"ints",basfun->name); 251 WriteHeader(f, "ints", basfun->name);
242 252
243 /* optional arguments : new style */ 253 /* optional arguments : new style */
244 /** XXXXXX basfun->NewMaxOpt= basfun->maxOpt; */ 254 /** XXXXXX basfun->NewMaxOpt= basfun->maxOpt; */
245 basfun->NewMaxOpt= basfun->maxOpt; 255 basfun->NewMaxOpt = basfun->maxOpt;
246 if ( basfun->NewMaxOpt > 0 ) 256 if (basfun->NewMaxOpt > 0)
247 { 257 {
248 /** optional arguments **/ 258 /** optional arguments **/
249 AddDeclare(DEC_INT,"nopt"); 259 AddDeclare(DEC_INT, "nopt");
250 AddDeclare(DEC_INT,"iopos"); 260 AddDeclare(DEC_INT, "iopos");
251 Fprintf(f,indent,"nopt=NumOpt();\n"); 261 Fprintf(f, indent, "nopt=NumOpt();\n");
252 } 262 }
253 263
254 /* rhs argument number checking */ 264 /* rhs argument number checking */
255 265
256 if ( basfun->NewMaxOpt > 0 ) 266 if (basfun->NewMaxOpt > 0)
257 Fprintf(f,indent,"CheckRhs(%d,%d+nopt);\n",basfun->nin - basfun->maxOpt, 267 Fprintf(f, indent, "CheckRhs(%d,%d+nopt);\n", basfun->nin - basfun->maxOpt, basfun->nin - basfun->maxOpt);
258 basfun->nin-basfun->maxOpt);
259 else 268 else
260 Fprintf(f,indent,"CheckRhs(%d,%d);\n",basfun->nin - basfun->maxOpt,basfun->nin); 269 Fprintf(f, indent, "CheckRhs(%d,%d);\n", basfun->nin - basfun->maxOpt, basfun->nin);
261
262 270
263 /* lhs argument number checking */ 271 /* lhs argument number checking */
264 ivar = basfun->out; 272 ivar = basfun->out;
265 if ( ivar == 0) 273 if (ivar == 0)
266 { 274 {
267 Fprintf(f,indent,"CheckLhs(0,1);\n"); 275 Fprintf(f, indent, "CheckLhs(0,1);\n");
268 } 276 }
269 else 277 else
270 { 278 {
271 if ((variables[ivar-1]->length == 0) 279 if ((variables[ivar - 1]->length == 0) || (variables[ivar - 1]->type == LIST) || (variables[ivar - 1]->type == TLIST))
272 || (variables[ivar-1]->type == LIST)
273 || (variables[ivar-1]->type == TLIST))
274 { 280 {
275 Fprintf(f,indent,"CheckLhs(1,1);\n"); 281 Fprintf(f, indent, "CheckLhs(1,1);\n");
276 } 282 }
277 else 283 else
278 { 284 {
279 Fprintf(f,indent,"CheckLhs(1,%d);\n",variables[ivar-1]->length); 285 Fprintf(f, indent, "CheckLhs(1,%d);\n", variables[ivar - 1]->length);
280 } 286 }
281 } 287 }
282 /* SCILAB argument checking */ 288 /* SCILAB argument checking */
283 for (i = 0; i < basfun->nin - basfun->NewMaxOpt ; i++) 289 for (i = 0; i < basfun->nin - basfun->NewMaxOpt; i++)
284 { 290 {
285 switch ( variables[i]->type ) 291 switch (variables[i]->type)
286 { 292 {
287 case LIST : 293 case LIST:
288 WriteListAnalysis(f,i,"l"); 294 WriteListAnalysis(f, i, "l");
289 break; 295 break;
290 case TLIST: 296 case TLIST:
291 WriteListAnalysis(f,i,"t"); 297 WriteListAnalysis(f, i, "t");
292 break; 298 break;
293 case MLIST : 299 case MLIST:
294 WriteListAnalysis(f,i,"m"); 300 WriteListAnalysis(f, i, "m");
295 break; 301 break;
296 default: 302 default:
297 WriteArgCheck(f,i); 303 WriteArgCheck(f, i);
298 break; 304 break;
299 } 305 }
300 } 306 }
301 307
302 if ( basfun->NewMaxOpt != 0) 308 if (basfun->NewMaxOpt != 0)
303 { 309 {
304 sprintf(str1,"rhs_opts opts[]={\n"); 310 sprintf(str1, "rhs_opts opts[]={\n");
305 for (i = basfun->nin -basfun->NewMaxOpt ; i < basfun->nin ; i++) 311 for (i = basfun->nin - basfun->NewMaxOpt; i < basfun->nin; i++)
306 { 312 {
307 sprintf(str2,"\t{-1,\"%s\",\"%s\",0,0,0},\n",variables[i]->name, 313 sprintf(str2, "\t{-1,\"%s\",\"%s\",0,0,0},\n", variables[i]->name, SGetForTypeAbrev(variables[i]));
308 SGetForTypeAbrev(variables[i])); 314 strcat(str1, str2);
309 strcat(str1,str2);
310 } 315 }
311 strcat(str1,"\t{-1,NULL,NULL,NULL,0,0}}"); 316 strcat(str1, "\t{-1,NULL,NULL,NULL,0,0}}");
312 AddDeclare(DEC_DATA,str1); 317 AddDeclare(DEC_DATA, str1);
313 Fprintf(f,indent,"iopos=Rhs;\n"); 318 Fprintf(f, indent, "iopos=Rhs;\n");
314 Fprintf(f,indent,"if ( get_optionals(fname,opts) == 0) return 0;\n"); 319 Fprintf(f, indent, "if ( get_optionals(fname,opts) == 0) return 0;\n");
315 for (i = basfun->nin -basfun->NewMaxOpt ; i < basfun->nin ; i++) 320 for (i = basfun->nin - basfun->NewMaxOpt; i < basfun->nin; i++)
316 { 321 {
317 WriteOptArgPhase2(f,i); 322 WriteOptArgPhase2(f, i);
318 } 323 }
319 } 324 }
320 325
@@ -331,56 +336,56 @@ void WriteFunctionCode(FILE *f)
331 WriteOutput(f); 336 WriteOutput(f);
332} 337}
333 338
334 339void WriteInfoCode(FILE * f)
335void WriteInfoCode(FILE *f)
336{ 340{
337 int i,iout; 341 int i, iout;
338 IVAR ivar; 342 IVAR ivar;
339 VARPTR var,vout; 343 VARPTR var, vout;
340 344
341 iout = GetExistOutVar(); 345 iout = GetExistOutVar();
342 vout = variables[iout -1]; 346 vout = variables[iout - 1];
343 347
344 switch (vout->type) { 348 switch (vout->type)
345 case LIST: 349 {
346 case TLIST: 350 case LIST:
347 /* loop on output variables */ 351 case TLIST:
348 printf("list("); 352 /* loop on output variables */
349 for (i = 0; i < vout->length; i++) 353 printf("list(");
350 { 354 for (i = 0; i < vout->length; i++)
351 ivar = vout->el[i]; 355 {
352 var = variables[ivar-1]; 356 ivar = vout->el[i];
353 printf("%s",var->name); 357 var = variables[ivar - 1];
354 if ( i != vout->length -1 ) 358 printf("%s", var->name);
355 printf(","); 359 if (i != vout->length - 1)
356 else 360 printf(",");
357 printf(")"); 361 else
358 } 362 printf(")");
359 break ; 363 }
360 case SEQUENCE: 364 break;
361 /* loop on output variables */ 365 case SEQUENCE:
362 printf("["); 366 /* loop on output variables */
363 for (i = 0; i < vout->length; i++) 367 printf("[");
364 { 368 for (i = 0; i < vout->length; i++)
365 ivar = vout->el[i]; 369 {
366 var = variables[ivar-1]; 370 ivar = vout->el[i];
367 printf("%s",var->name); 371 var = variables[ivar - 1];
368 if ( i != vout->length -1 ) 372 printf("%s", var->name);
369 printf(","); 373 if (i != vout->length - 1)
370 else 374 printf(",");
371 printf("]"); 375 else
372 } 376 printf("]");
373 break; 377 }
374 case EMPTY: 378 break;
375 printf("[]\n"); 379 case EMPTY:
376 break; 380 printf("[]\n");
381 break;
377 } 382 }
378 383
379 printf("=%s(",basfun->name); 384 printf("=%s(", basfun->name);
380 for (i = 0; i < basfun->nin; i++) 385 for (i = 0; i < basfun->nin; i++)
381 { 386 {
382 printf("%s(%s)",variables[i]->name,SGetSciType(variables[i]->type)); 387 printf("%s(%s)", variables[i]->name, SGetSciType(variables[i]->type));
383 if ( i != basfun->nin -1 ) 388 if (i != basfun->nin - 1)
384 printf(","); 389 printf(",");
385 } 390 }
386 printf(")\n"); 391 printf(")\n");
@@ -388,23 +393,23 @@ void WriteInfoCode(FILE *f)
388} 393}
389 394
390/************************************************************* 395/*************************************************************
391* Ckecking and getting infos for datas coming from scilab calling 396* Ckecking and getting infos for data coming from scilab calling
392* sequence ( datas on the stack ) 397* sequence ( data on the stack )
393***********************************************************/ 398***********************************************************/
394 399
395void WriteArgCheck(FILE *f,int i) 400void WriteArgCheck(FILE * f, int i)
396{ 401{
397 int i1; 402 int i1;
398 VARPTR var = variables[basfun->in[i]-1]; 403 VARPTR var = variables[basfun->in[i] - 1];
399 404
400 i1 = i + 1; 405 i1 = i + 1;
401 406
402 Fprintf(f,indent,"/* checking variable %s */\n",var->name); 407 Fprintf(f, indent, "/* checking variable %s */\n", var->name);
403 408
404 if (var->opt_type != 0) 409 if (var->opt_type != 0)
405 { 410 {
406 /* Optional Arguments */ 411 /* Optional Arguments */
407 WriteOptArg(f,var); 412 WriteOptArg(f, var);
408 } 413 }
409 else 414 else
410 { 415 {
@@ -412,42 +417,39 @@ void WriteArgCheck(FILE *f,int i)
412 * generate the code for getting a Scilab argument 417 * generate the code for getting a Scilab argument
413 * and check some dimensions property if necessary 418 * and check some dimensions property if necessary
414 **/ 419 **/
415 if (RHSTAB[var->type].type != var->type ) 420 if (RHSTAB[var->type].type != var->type)
416 { 421 {
417 fprintf(stderr,"Bug in intersci : Something wrong in RHSTAB\n"); 422 fprintf(stderr, "Bug in intersci : Something wrong in RHSTAB\n");
418 } 423 }
419 (*(RHSTAB[var->type].fonc))(f,var,0); 424 (*(RHSTAB[var->type].fonc)) (f, var, 0);
420 } 425 }
421} 426}
422 427
423
424
425/************************************************************* 428/*************************************************************
426* cross checking dimensions 429* cross checking dimensions
427***********************************************************/ 430***********************************************************/
428 431
429void WriteCrossCheck(FILE *f) 432void WriteCrossCheck(FILE * f)
430{ 433{
431 int i, j; 434 int i, j;
432 VARPTR var; 435 VARPTR var;
433 Fprintf(f,indent,"/* cross variable size checking */\n"); 436
437 Fprintf(f, indent, "/* cross variable size checking */\n");
434 for (i = 0; i < nVariable; i++) 438 for (i = 0; i < nVariable; i++)
435 { 439 {
436 var = variables[i]; 440 var = variables[i];
437 if ( var->type == DIMFOREXT ) 441 if (var->type == DIMFOREXT)
438 { 442 {
439 if ( var->nfor_name > 1) 443 if (var->nfor_name > 1)
440 { 444 {
441 for ( j = 1 ; j < var->nfor_name ; j++) 445 for (j = 1; j < var->nfor_name; j++)
442 { 446 {
443 /** we do not check square variables : this is done elsewhere */ 447 /** we do not check square variables : this is done elsewhere */
444 /* we do not check external values since they are not known here */ 448 /* we do not check external values since they are not known here */
445 if ( (var->for_name_orig[j] != var->for_name_orig[j-1]) 449 if ((var->for_name_orig[j] != var->for_name_orig[j - 1]) && (var->for_name[j - 1][1] != 'e' && var->for_name[j][1] != 'e'))
446 && ( var->for_name[j-1][1] != 'e' && var->for_name[j][1] != 'e' ))
447 { 450 {
448 Fprintf(f,indent,"CheckDimProp(%d,%d,%s != %s);\n", 451 Fprintf(f, indent, "CheckDimProp(%d,%d,%s != %s);\n",
449 var->for_name_orig[j-1], var->for_name_orig[j], 452 var->for_name_orig[j - 1], var->for_name_orig[j], var->for_name[j - 1], var->for_name[j]);
450 var->for_name[j-1], var->for_name[j]);
451 } 453 }
452 } 454 }
453 } 455 }
@@ -455,67 +457,62 @@ void WriteCrossCheck(FILE *f)
455 else if (var->type == SCALAR) 457 else if (var->type == SCALAR)
456 { 458 {
457 /** some dimensions are given by a scalar input argument **/ 459 /** some dimensions are given by a scalar input argument **/
458 if ( var->nfor_name > 1) 460 if (var->nfor_name > 1)
459 { 461 {
460 for ( j = 1 ; j < var->nfor_name ; j++) 462 for (j = 1; j < var->nfor_name; j++)
461 { 463 {
462 int dim=2; 464 int dim = 2;
463 if ( var->for_name[j][0]=='m') dim=1; 465
464 if ( var->for_name[j][1] != 'e' ) /* do not check external variables */ 466 if (var->for_name[j][0] == 'm')
467 dim = 1;
468 if (var->for_name[j][1] != 'e') /* do not check external variables */
465 { 469 {
466 if ( strncmp(var->for_name[0],"istk",4)==0) 470 if (strncmp(var->for_name[0], "istk", 4) == 0)
467 Fprintf(f,indent,"CheckOneDim(%d,%d,%s,*%s);\n", 471 Fprintf(f, indent, "CheckOneDim(%d,%d,%s,*%s);\n", var->for_name_orig[j], dim, var->for_name[j], var->for_name[0]);
468 var->for_name_orig[j], dim , var->for_name[j],var->for_name[0]);
469 else 472 else
470 Fprintf(f,indent,"CheckOneDim(%d,%d,%s,%s);\n", 473 Fprintf(f, indent, "CheckOneDim(%d,%d,%s,%s);\n", var->for_name_orig[j], dim, var->for_name[j], var->for_name[0]);
471 var->for_name_orig[j], dim , var->for_name[j],var->for_name[0]);
472 } 474 }
473 } 475 }
474 } 476 }
475 } 477 }
476 } 478 }
477 /* 479 /*
478 FCprintf(f,"/ * cross formal parameter checking\n"); 480 * FCprintf(f,"/ * cross formal parameter checking\n");
479 FCprintf(f," * not implemented yet * /\n"); */ 481 * FCprintf(f," * not implemented yet * /\n"); */
480} 482}
481 483
482 484void WriteEqualCheck(FILE * f)
483
484
485void WriteEqualCheck(FILE *f)
486{ 485{
487 /*Fprintf(f,indent,"/ * cross equal output variable checking\n"); 486 /*Fprintf(f,indent,"/ * cross equal output variable checking\n");
488 Fprintf(f,indent," not implemented yet* /\n"); */ 487 * Fprintf(f,indent," not implemented yet* /\n"); */
489} 488}
490 489
491/*************************************************************** 490/***************************************************************
492* Scilab argument of type list 491* Scilab argument of type list
493***************************************************************/ 492***************************************************************/
494 493
495void WriteListAnalysis(FILE *f,int i,char *list_type) 494void WriteListAnalysis(FILE * f, int i, char *list_type)
496{ 495{
497 int k,i1; 496 int k, i1;
498 VARPTR var; 497 VARPTR var;
499 i1=i+1; 498
500 499 i1 = i + 1;
501 AddDeclare1(DEC_INT,"m%d",i1); 500
502 AddDeclare1(DEC_INT,"n%d",i1); 501 AddDeclare1(DEC_INT, "m%d", i1);
503 AddDeclare1(DEC_INT,"l%d",i1); 502 AddDeclare1(DEC_INT, "n%d", i1);
504 Fprintf(f,indent,"GetRhsVar(%d,\"%s\",&m%d,&n%d,&l%d);\n", 503 AddDeclare1(DEC_INT, "l%d", i1);
505 i1,list_type,i1,i1,i1); 504 Fprintf(f, indent, "GetRhsVar(%d,\"%s\",&m%d,&n%d,&l%d);\n", i1, list_type, i1, i1, i1);
506 for (k = 0; k < nVariable ; k++) 505 for (k = 0; k < nVariable; k++)
507 { 506 {
508 var = variables[k]; 507 var = variables[k];
509 if ((var->list_el != 0) && 508 if ((var->list_el != 0) && (strcmp(var->list_name, variables[i]->name) == 0) && var->present)
510 (strcmp(var->list_name,variables[i]->name) == 0) &&
511 var->present)
512 { 509 {
513 Fprintf(f,indent,"/* list element %d %s */\n",var->list_el,var->name); 510 Fprintf(f, indent, "/* list element %d %s */\n", var->list_el, var->name);
514 if (RHSTAB[var->type].type != var->type ) 511 if (RHSTAB[var->type].type != var->type)
515 { 512 {
516 fprintf(stderr,"Bug in intersci : Something wrong in RHSTAB\n"); 513 fprintf(stderr, "Bug in intersci : Something wrong in RHSTAB\n");
517 } 514 }
518 (*(RHSTAB[var->type].fonc))(f,var,0); 515 (*(RHSTAB[var->type].fonc)) (f, var, 0);
519 } 516 }
520 } 517 }
521} 518}
@@ -528,41 +525,38 @@ void WriteListAnalysis(FILE *f,int i,char *list_type)
528 525
529void CheckCreateOrder() 526void CheckCreateOrder()
530{ 527{
531 int ivar,min= 10000; 528 int ivar, min = 10000;
532 int i,count=0; 529 int i, count = 0;
533 if ( forsub->narg == 0) return ; 530
531 if (forsub->narg == 0)
532 return;
534 for (i = 0; i < forsub->narg; i++) 533 for (i = 0; i < forsub->narg; i++)
535 { 534 {
536 ivar = forsub->arg[i]; 535 ivar = forsub->arg[i];
537 if (variables[ivar-1]->list_el == 0 536 if (variables[ivar - 1]->list_el == 0
538 && variables[ivar-1]->is_sciarg == 0 537 && variables[ivar - 1]->is_sciarg == 0 && variables[ivar - 1]->for_type != EXTERNAL && variables[ivar - 1]->for_type != CSTRINGV)
539 && variables[ivar-1]->for_type != EXTERNAL
540 && variables[ivar-1]->for_type != CSTRINGV )
541 { 538 {
542 count++; 539 count++;
543 if ( min != 10000 && variables[ivar-1]->stack_position !=0 540 if (min != 10000 && variables[ivar - 1]->stack_position != 0 && variables[ivar - 1]->stack_position < min)
544 && variables[ivar-1]->stack_position < min)
545 { 541 {
546 fprintf(stderr,"Error: declaration for local variables\n"); 542 fprintf(stderr, "Error: declaration for local variables\n");
547 fprintf(stderr,"\t must respect the order given in the calling sequence\n"); 543 fprintf(stderr, "\t must respect the order given in the calling sequence\n");
548 fprintf(stderr,"\t declaration for %s must be moved downward\n", 544 fprintf(stderr, "\t declaration for %s must be moved downward\n", variables[ivar - 1]->name);
549 variables[ivar-1]->name);
550 exit(1); 545 exit(1);
551 } 546 }
552 if ( variables[ivar-1]->stack_position !=0 ) 547 if (variables[ivar - 1]->stack_position != 0)
553 min = variables[ivar-1]->stack_position; 548 min = variables[ivar - 1]->stack_position;
554 } 549 }
555 } 550 }
556} 551}
557 552
558 553void WriteFortranCall(FILE * f)
559void WriteFortranCall(FILE *f)
560{ 554{
561 int i, ind; 555 int i, ind;
562 IVAR ivar, iivar; 556 IVAR ivar, iivar;
563 char call[MAXCALL]; 557 char call[MAXCALL];
564 558
565 sprintf(call,"C2F(%s)(",forsub->name); 559 sprintf(call, "C2F(%s)(", forsub->name);
566 560
567 CheckCreateOrder(); 561 CheckCreateOrder();
568 562
@@ -572,36 +566,37 @@ void WriteFortranCall(FILE *f)
572 { 566 {
573 ivar = forsub->arg[i]; 567 ivar = forsub->arg[i];
574 ind = 0; 568 ind = 0;
575 if (variables[ivar-1]->list_el != 0) 569 if (variables[ivar - 1]->list_el != 0)
576 { 570 {
577 /* FORTRAN argument is a list element */ 571 /* FORTRAN argument is a list element */
578 iivar = GetExistVar(variables[ivar-1]->list_name); 572 iivar = GetExistVar(variables[ivar - 1]->list_name);
579 if ( variables[iivar-1]->is_sciarg == 0) 573 if (variables[iivar - 1]->is_sciarg == 0)
580 { 574 {
581 printf("list or tlist \"%s\" must be an argument of SCILAB function\n", 575 printf("list or tlist \"%s\" must be an argument of SCILAB function\n", variables[ivar - 1]->list_name);
582 variables[ivar-1]->list_name);
583 exit(1); 576 exit(1);
584 } 577 }
585 strcat(call,variables[ivar-1]->for_name[0]); 578 strcat(call, variables[ivar - 1]->for_name[0]);
586 strcat(call,","); 579 strcat(call, ",");
587 } 580 }
588 else 581 else
589 { 582 {
590 int bCheck = 0; 583 int bCheck = 0;
591 if ( variables[ivar-1]->is_sciarg != 1) 584
585 if (variables[ivar - 1]->is_sciarg != 1)
592 { 586 {
593 /* FORTRAN argument is not a SCILAB argument */ 587 /* FORTRAN argument is not a SCILAB argument */
594 /* a new variable is created on the stack for each 588 /* a new variable is created on the stack for each
595 Fortran argument */ 589 * Fortran argument */
596 (*(CRERHSTAB[variables[ivar-1]->type].fonc))(f,variables[ivar-1]); 590 (*(CRERHSTAB[variables[ivar - 1]->type].fonc)) (f, variables[ivar - 1]);
597 } 591 }
598#ifdef _MSC_VER 592#ifdef _MSC_VER
599 _try 593 _try
600 { 594 {
601 bCheck = (variables[ivar-1]->C_name[0] != NULL); 595 bCheck = (variables[ivar - 1]->C_name[0] != NULL);
602 if (bCheck) 596 if (bCheck)
603 { 597 {
604 char *buffertmp = os_strdup(variables[ivar-1]->C_name[0]); 598 char *buffertmp = os_strdup(variables[ivar - 1]->C_name[0]);
599
605 if (buffertmp) 600 if (buffertmp)
606 { 601 {
607 free(buffertmp); 602 free(buffertmp);
@@ -609,39 +604,41 @@ void WriteFortranCall(FILE *f)
609 } 604 }
610 } 605 }
611 } 606 }
612 _except (EXCEPTION_EXECUTE_HANDLER) 607 _except(EXCEPTION_EXECUTE_HANDLER)
613 { 608 {
614 bCheck = 0; 609 bCheck = 0;
615 } 610 }
616#else 611#else
617 bCheck = (variables[ivar-1]->C_name[0] != NULL); 612 bCheck = (variables[ivar - 1]->C_name[0] != NULL);
618#endif 613#endif
619 if (target == 'C' && bCheck) 614 if (target == 'C' && bCheck)
620 { 615 {
621 strcat(call,"&"); 616 strcat(call, "&");
622 strcat(call,variables[ivar-1]->C_name[0]); 617 strcat(call, variables[ivar - 1]->C_name[0]);
623 } 618 }
624 else strcat(call,variables[ivar-1]->for_name[0]); 619 else
625 strcat(call,","); 620 strcat(call, variables[ivar - 1]->for_name[0]);
621 strcat(call, ",");
626 } 622 }
627 } 623 }
628 if (forsub->narg == 0) 624 if (forsub->narg == 0)
629 strcat(call,")"); 625 strcat(call, ")");
630 else 626 else
631 call[strlen(call)-1] = ')'; 627 call[strlen(call) - 1] = ')';
632 628
633 if (target == 'C' ) strcat(call,";\n"); 629 if (target == 'C')
634 Fprintf(f,indent,call); 630 strcat(call, ";\n");
631 Fprintf(f, indent, call);
635 632
636 for ( i=0 ; i < nVariable ; i++) 633 for (i = 0; i < nVariable; i++)
637 { 634 {
638 if ( strcmp(variables[i]->name,"err")==0) 635 if (strcmp(variables[i]->name, "err") == 0)
639 { 636 {
640 AddDeclare(DEC_INT,"err=0"); 637 AddDeclare(DEC_INT, "err=0");
641 Fprintf(f,indent++,"if (err > 0) {\n"); 638 Fprintf(f, indent++, "if (err > 0) {\n");
642 Fprintf(f,indent,"Scierror(999,\"%%s: Internal Error \\n\",fname);\n"); 639 Fprintf(f, indent, "Scierror(999,\"%%s: Internal Error \\n\",fname);\n");
643 Fprintf(f,indent,"return 0;\n"); 640 Fprintf(f, indent, "return 0;\n");
644 Fprintf(f,--indent,"};\n"); 641 Fprintf(f, --indent, "};\n");
645 break; 642 break;
646 } 643 }
647 } 644 }
@@ -652,60 +649,56 @@ void WriteFortranCall(FILE *f)
652* for lhs variables creation 649* for lhs variables creation
653*****************************************************/ 650*****************************************************/
654 651
655void WriteOutput(FILE *f) 652void WriteOutput(FILE * f)
656{ 653{
657 IVAR iout,ivar; 654 IVAR iout, ivar;
658 VARPTR var,vout; 655 VARPTR var, vout;
659 int i; 656 int i;
660 657
661 iout = CheckOutVar(); 658 iout = CheckOutVar();
662 659
663 if ( iout == 0) 660 if (iout == 0)
664 { 661 {
665 Fprintf(f,indent,"LhsVar(1)=0;\n;return 0;\n"); 662 Fprintf(f, indent, "LhsVar(1)=0;\n;return 0;\n");
666 } 663 }
667 else 664 else
668 { 665 {
669 vout = variables[iout-1]; 666 vout = variables[iout - 1];
670 switch (vout->type) 667 switch (vout->type)
671 { 668 {
672 case LIST: 669 case LIST:
673 case TLIST: 670 case TLIST:
674 case MLIST: 671 case MLIST:
675 Fprintf(f,indent,"/* Creation of output %s of length %d*/\n", 672 Fprintf(f, indent, "/* Creation of output %s of length %d*/\n", SGetSciType(vout->type), vout->length);
676 SGetSciType(vout->type),vout->length);
677 vout->stack_position = icre; 673 vout->stack_position = icre;
678 icre++; 674 icre++;
679 Fprintf(f,indent,"Create%s(%d,%d);\n", 675 Fprintf(f, indent, "Create%s(%d,%d);\n", SGetSciType(vout->type), vout->stack_position, vout->length);
680 SGetSciType(vout->type),
681 vout->stack_position,
682 vout->length);
683 /* loop on output variables */ 676 /* loop on output variables */
684 for (i = 0; i < vout->length; i++) 677 for (i = 0; i < vout->length; i++)
685 { 678 {
686 ivar = vout->el[i]; 679 ivar = vout->el[i];
687 var = variables[ivar-1]; 680 var = variables[ivar - 1];
688 Fprintf(f,indent,"/* Element %d: %s*/\n",i+1,var->name); 681 Fprintf(f, indent, "/* Element %d: %s*/\n", i + 1, var->name);
689 WriteVariable(f,var,ivar,1,i+1); 682 WriteVariable(f, var, ivar, 1, i + 1);
690 } 683 }
691 Fprintf(f,indent,"LhsVar(1)= %d;\nreturn 0;",vout->stack_position); 684 Fprintf(f, indent, "LhsVar(1)= %d;\nreturn 0;", vout->stack_position);
692 break; 685 break;
693 case SEQUENCE: 686 case SEQUENCE:
694 /* loop on output variables */ 687 /* loop on output variables */
695 for (i = 0; i < vout->length; i++) 688 for (i = 0; i < vout->length; i++)
696 { 689 {
697 ivar = vout->el[i]; 690 ivar = vout->el[i];
698 var = variables[ivar-1]; 691 var = variables[ivar - 1];
699 WriteVariable(f,var,ivar,0,0); 692 WriteVariable(f, var, ivar, 0, 0);
700 } 693 }
701 Fprintf(f,indent,"return 0;\n"); 694 Fprintf(f, indent, "return 0;\n");
702 break; 695 break;
703 case EMPTY: 696 case EMPTY:
704 Fprintf(f,indent,"LhsVar(1)=0;\n;return 0;\n"); 697 Fprintf(f, indent, "LhsVar(1)=0;\n;return 0;\n");
705 break; 698 break;
706 } 699 }
707 } 700 }
708 Fprintf(f,--indent,"}\n"); 701 Fprintf(f, --indent, "}\n");
709} 702}
710 703
711/*********************************************** 704/***********************************************
@@ -715,7 +708,7 @@ void WriteOutput(FILE *f)
715* of the variable in the list 708* of the variable in the list
716***********************************************/ 709***********************************************/
717 710
718void WriteVariable(FILE *f, VARPTR var,IVAR ivar,int insidelist,int nel) 711void WriteVariable(FILE * f, VARPTR var, IVAR ivar, int insidelist, int nel)
719{ 712{
720 IVAR ivar2, barg, farg; 713 IVAR ivar2, barg, farg;
721 VARPTR var2; 714 VARPTR var2;
@@ -734,7 +727,7 @@ void WriteVariable(FILE *f, VARPTR var,IVAR ivar,int insidelist,int nel)
734 /* external type */ 727 /* external type */
735 if (barg != 0) 728 if (barg != 0)
736 { 729 {
737 printf("output variable with external type \"%s\"\n",var->name); 730 printf("output variable with external type \"%s\"\n", var->name);
738 printf(" cannot be an input argument of SCILAB function\n"); 731 printf(" cannot be an input argument of SCILAB function\n");
739 exit(1); 732 exit(1);
740 } 733 }
@@ -750,43 +743,39 @@ void WriteVariable(FILE *f, VARPTR var,IVAR ivar,int insidelist,int nel)
750 printf(" an argument of FORTRAN subroutine"); 743 printf(" an argument of FORTRAN subroutine");
751 exit(1); 744 exit(1);
752 } 745 }
753 WriteExternalVariableOutput(f,var,insidelist,nel); 746 WriteExternalVariableOutput(f, var, insidelist, nel);
754 } 747 }
755 else 748 else
756 { 749 {
757 if ( insidelist == 0 && var->list_el == 0 ) 750 if (insidelist == 0 && var->list_el == 0)
758 { 751 {
759 if ( var->opt_type != 0) 752 if (var->opt_type != 0)
760 { 753 {
761 Fprintf(f,indent,"LhsVar(%d)= opts[%d].position /* %s */;\n", 754 Fprintf(f, indent, "LhsVar(%d)= opts[%d].position /* %s */;\n",
762 var->out_position, 755 var->out_position, var->stack_position - basfun->NewMaxOpt + 1, var->name);
763 var->stack_position - basfun->NewMaxOpt+1,
764 var->name);
765 } 756 }
766 else 757 else
767 { 758 {
768 759
769 if ( var->for_type == CSTRINGV) 760 if (var->for_type == CSTRINGV)
770 /* variable is recreated fro output */ 761 /* variable is recreated fro output */
771 Fprintf(f,indent,"LhsVar(%d)= %d;\n", 762 Fprintf(f, indent, "LhsVar(%d)= %d;\n", var->out_position, icre);
772 var->out_position,icre);
773 else 763 else
774 Fprintf(f,indent,"LhsVar(%d)= %d;\n", 764 Fprintf(f, indent, "LhsVar(%d)= %d;\n", var->out_position, var->stack_position);
775 var->out_position,var->stack_position);
776 } 765 }
777 } 766 }
778 if (var->equal != 0) 767 if (var->equal != 0)
779 { 768 {
780 /* SCILAB type convertion */ 769 /* SCILAB type convertion */
781 if (barg !=0 || farg!= 0) 770 if (barg != 0 || farg != 0)
782 { 771 {
783 printf("output variable with convertion \"%s\" must not be\n",var->name); 772 printf("output variable with convertion \"%s\" must not be\n", var->name);
784 printf(" an input variable of SCILAB function or an argument\n"); 773 printf(" an input variable of SCILAB function or an argument\n");
785 printf(" of FORTRAN subroutine\n"); 774 printf(" of FORTRAN subroutine\n");
786 exit(1); 775 exit(1);
787 } 776 }
788 ivar2 = var->equal; 777 ivar2 = var->equal;
789 var2 = variables[ivar2-1]; 778 var2 = variables[ivar2 - 1];
790 /* get number of equal variable in SCILAB calling list */ 779 /* get number of equal variable in SCILAB calling list */
791 barg = 0; 780 barg = 0;
792 for (j = 0; j < basfun->nin; j++) 781 for (j = 0; j < basfun->nin; j++)
@@ -799,77 +788,79 @@ void WriteVariable(FILE *f, VARPTR var,IVAR ivar,int insidelist,int nel)
799 } 788 }
800 if (barg == 0) 789 if (barg == 0)
801 { 790 {
802 printf("output variable with convertion \"%s\" must be\n", 791 printf("output variable with convertion \"%s\" must be\n", var->name);
803 var->name);
804 printf(" an input variable of SCILAB function\n"); 792 printf(" an input variable of SCILAB function\n");
805 exit(1); 793 exit(1);
806 } 794 }
807 /* get number of equal variable in FORTRAN calling list */ 795 /* get number of equal variable in FORTRAN calling list */
808 farg = 0; 796 farg = 0;
809 for (j = 0; j < forsub->narg; j++) { 797 for (j = 0; j < forsub->narg; j++)
810 if (ivar2 == forsub->arg[j]) { 798 {
799 if (ivar2 == forsub->arg[j])
800 {
811 farg = j + 1; 801 farg = j + 1;
812 break; 802 break;
813 } 803 }
814 } 804 }
815 if (farg == 0) 805 if (farg == 0)
816 { 806 {
817 printf("output variable with convertion \"%s\" must be\n", 807 printf("output variable with convertion \"%s\" must be\n", var->name);
818 var->name);
819 printf(" an argument FORTRAN subroutine"); 808 printf(" an argument FORTRAN subroutine");
820 exit(1); 809 exit(1);
821 } 810 }
822 var->for_type = var2->for_type; 811 var->for_type = var2->for_type;
823 WriteVariableOutput(f,var,1,insidelist,nel); 812 WriteVariableOutput(f, var, 1, insidelist, nel);
824 } 813 }
825 else 814 else
826 { 815 {
827 /* no SCILAB type convertion */ 816 /* no SCILAB type convertion */
828 if ( var->type == LIST || var->type == TLIST ) 817 if (var->type == LIST || var->type == TLIST)
829 { 818 {
830 /** il faut alors verifier la condition pour 819 /** il faut alors verifier la condition pour
831 tous les arguments de la liste **/ 820 tous les arguments de la liste **/
832 WriteVariableOutput(f,var,0,insidelist,nel); 821 WriteVariableOutput(f, var, 0, insidelist, nel);
833 return; 822 return;
834 } 823 }
835 if (farg == 0 ) { 824 if (farg == 0)
836 printf("variable without convertion \"%s\" must be an argument\n", 825 {
837 var->name); 826 printf("variable without convertion \"%s\" must be an argument\n", var->name);
838 printf(" of FORTRAN subroutine\n"); 827 printf(" of FORTRAN subroutine\n");
839 exit(1); 828 exit(1);
840 } 829 }
841 830
842 WriteVariableOutput(f,var,0,insidelist,nel); 831 WriteVariableOutput(f, var, 0, insidelist, nel);
843 } 832 }
844 } 833 }
845} 834}
846 835
847
848int GetNumberInScilabCall(int ivar) 836int GetNumberInScilabCall(int ivar)
849{ 837{
850 int j; 838 int j;
839
851 for (j = 0; j < basfun->nin; j++) 840 for (j = 0; j < basfun->nin; j++)
852 { 841 {
853 if (ivar == basfun->in[j]) { 842 if (ivar == basfun->in[j])
854 return(j+1); 843 {
844 return (j + 1);
855 break; 845 break;
856 } 846 }
857 } 847 }
858 return(0); 848 return (0);
859} 849}
860 850
861int GetNumberInFortranCall(int ivar) 851int GetNumberInFortranCall(int ivar)
862{ 852{
863 int j; 853 int j;
854
864 for (j = 0; j < forsub->narg; j++) 855 for (j = 0; j < forsub->narg; j++)
865 { 856 {
866 if (ivar == forsub->arg[j]) 857 if (ivar == forsub->arg[j])
867 { 858 {
868 return( j + 1); 859 return (j + 1);
869 break; 860 break;
870 } 861 }
871 } 862 }
872 return(0); 863 return (0);
873} 864}
874 865
875/******************************************** 866/********************************************
@@ -877,159 +868,208 @@ int GetNumberInFortranCall(int ivar)
877* if str begins with stk or return str unchanged 868* if str begins with stk or return str unchanged
878********************************************/ 869********************************************/
879 870
880char unknown[]="ukn"; 871char unknown[] = "ukn";
881 872
882char *Forname2Int(VARPTR var,int i) 873char *Forname2Int(VARPTR var, int i)
883{ 874{
884 int l; 875 int l;
885 char *p; 876 char *p;
886 if ( var->for_name[i] == (char *) 0) 877
878 if (var->for_name[i] == (char *)0)
887 { 879 {
888 printf("Error in Forname2Int for variable %s\n",var->name); 880 printf("Error in Forname2Int for variable %s\n", var->name);
889 printf("Maybe an internal variable has a dimension\n"); 881 printf("Maybe an internal variable has a dimension\n");
890 printf("which can't be evaluated\n"); 882 printf("which can't be evaluated\n");
891 abort(); 883 abort();
892 return(unknown); 884 return (unknown);
893 } 885 }
894 if ( var->C_name[i] != (char *) 0) 886 if (var->C_name[i] != (char *)0)
895 return var->C_name[i]; 887 return var->C_name[i];
896 if (strncmp(var->for_name[i],"stk",3) == 0) { 888 if (strncmp(var->for_name[i], "stk", 3) == 0)
889 {
897 l = (int)strlen(var->for_name[i]); 890 l = (int)strlen(var->for_name[i]);
898 p = (char *)malloc((unsigned)(l + 6)); 891 p = (char *)malloc((unsigned)(l + 6));
899 sprintf(p,"int(%s)",var->for_name[i]); 892 sprintf(p, "int(%s)", var->for_name[i]);
900 return p; 893 return p;
901 } 894 }
902 else return var->for_name[i]; 895 else
896 return var->for_name[i];
903} 897}
904 898
905void GenFundef(char *file,int interf) 899void GenFundef(char *file, int interf)
906{ 900{
907 FILE *fout; 901 FILE *fout;
908 char filout[MAXNAM]; 902 char filout[MAXNAM];
909 int i,j; 903 int i, j;
910 if (interf != 0 ) 904
905 if (interf != 0)
911 { 906 {
912 strcpy(filout,file); 907 strcpy(filout, file);
913 strcat(filout,".fundef"); 908 strcat(filout, ".fundef");
914 fout = fopen(filout,"wt"); 909 fout = fopen(filout, "wt");
915 fprintf(fout,"#define IN_%s %.2d\n",file,interf); 910 fprintf(fout, "#define IN_%s %.2d\n", file, interf);
916 for (i = 0; i < nFun; i++) { 911 for (i = 0; i < nFun; i++)
917 fprintf(fout,"{\"%s\",",funNames[i]); 912 {
918 for (j = 0; j < 25 - (int)strlen(funNames[i]); j++) fprintf(fout," "); 913 fprintf(fout, "{\"%s\",", funNames[i]);
919 fprintf(fout,"\t\tIN_%s,\t%d,\t3},\n",file,i+1); 914 for (j = 0; j < 25 - (int)strlen(funNames[i]); j++)
915 fprintf(fout, " ");
916 fprintf(fout, "\t\tIN_%s,\t%d,\t3},\n", file, i + 1);
920 } 917 }
921 printf("\nfile \"%s\" has been created\n",filout); 918 printf("\nfile \"%s\" has been created\n", filout);
922 fclose(fout); 919 fclose(fout);
923 } 920 }
924} 921}
925 922
926static void GenBuilder(char *file,char *files,char *libs) 923static void GenBuilder(char *file, char *files, char *libs)
927{ 924{
928 FILE *fout; 925 FILE *fout;
929 char filout[MAXNAM]; 926 char filout[MAXNAM];
930 int i; 927 int i;
928
931 strcpy(filout, file); 929 strcpy(filout, file);
932 strcat(filout, "_builder.sce"); 930 strcat(filout, "_builder.sce");
933 fout = fopen(filout, "wt"); 931 fout = fopen(filout, "wt");
934 fprintf(fout,"// generated with intersci\n"); 932 fprintf(fout, "// generated with intersci\n");
935 fprintf(fout,"ilib_name = 'lib%s'\t\t// interface library name\n",file); 933 fprintf(fout, "ilib_name = 'lib%s'\t\t// interface library name\n", file);
936 934
937 /* files = 'file1.o file2.o ....' delimiter = ' ' */ 935 /* files = 'file1.o file2.o ....' delimiter = ' ' */
938 while ( files != NULL) 936 while (files != NULL)
939 { 937 {
940 static int first =1; 938 static int first = 1;
941 if ( first ==1 ) { fprintf(fout,"files =['%s.o';\n\t'",file);first ++;} 939
942 else { fprintf(fout,"\t'");} 940 if (first == 1)
943 while ( *files != 0 && *files != ' ' ) { fprintf(fout,"%c",*files); files++;} 941 {
944 while ( *files == ' ') files++; 942 fprintf(fout, "files =['%s.o';\n\t'", file);
945 if ( *files == 0 ) { fprintf(fout,"'];\n"); break;} 943 first++;
946 else { fprintf(fout,"'\n");} ; 944 }
945 else
946 {
947 fprintf(fout, "\t'");
948 }
949 while (*files != 0 && *files != ' ')
950 {
951 fprintf(fout, "%c", *files);
952 files++;
953 }
954 while (*files == ' ')
955 files++;
956 if (*files == 0)
957 {
958 fprintf(fout, "'];\n");
959 break;
960 }
961 else
962 {
963 fprintf(fout, "'\n");
964 };
947 } 965 }
948 966
949 while ( libs != NULL) 967 while (libs != NULL)
950 { 968 {
951 static int first =1; 969 static int first = 1;
952 if ( first ==1 ) { fprintf(fout,"libs =['");first ++;} 970
953 else { fprintf(fout,"\t'");} 971 if (first == 1)
954 while ( *libs != 0 && *libs != ' ' ) { fprintf(fout,"%c",*libs); libs++;} 972 {
955 while ( *libs == ' ') libs++; 973 fprintf(fout, "libs =['");
956 if ( *libs == 0 ) { fprintf(fout,"'];\n"); break;} 974 first++;
957 else { fprintf(fout,"'\n");} ; 975 }
976 else
977 {
978 fprintf(fout, "\t'");
979 }
980 while (*libs != 0 && *libs != ' ')
981 {
982 fprintf(fout, "%c", *libs);
983 libs++;
984 }
985 while (*libs == ' ')
986 libs++;
987 if (*libs == 0)
988 {
989 fprintf(fout, "'];\n");
990 break;
991 }
992 else
993 {
994 fprintf(fout, "'\n");
995 };
958 } 996 }
959 997
960 fprintf(fout,"\ntable =["); 998 fprintf(fout, "\ntable =[");
961 i=0; 999 i = 0;
962 if ( nFun == 1) 1000 if (nFun == 1)
963 fprintf(fout,"\"%s\",\"ints%s\"];\n",funNames[i],funNames[i]); 1001 fprintf(fout, "\"%s\",\"ints%s\"];\n", funNames[i], funNames[i]);
964 else 1002 else
965 { 1003 {
966 fprintf(fout,"\"%s\",\"ints%s\";\n",funNames[i],funNames[i]); 1004 fprintf(fout, "\"%s\",\"ints%s\";\n", funNames[i], funNames[i]);
967 for (i = 1; i < nFun-1; i++) { 1005 for (i = 1; i < nFun - 1; i++)
968 fprintf(fout,"\t\"%s\",\"ints%s\";\n",funNames[i],funNames[i]); 1006 {
1007 fprintf(fout, "\t\"%s\",\"ints%s\";\n", funNames[i], funNames[i]);
969 } 1008 }
970 i=nFun-1; 1009 i = nFun - 1;
971 fprintf(fout,"\t\"%s\",\"ints%s\"];\n",funNames[i],funNames[i]); 1010 fprintf(fout, "\t\"%s\",\"ints%s\"];\n", funNames[i], funNames[i]);
972 } 1011 }
973 fprintf(fout,"ilib_build(ilib_name,table,files,libs);\n"); 1012 fprintf(fout, "ilib_build(ilib_name,table,files,libs);\n");
974 printf("\nfile \"%s\" has been created\n",filout); 1013 printf("\nfile \"%s\" has been created\n", filout);
975 fclose(fout); 1014 fclose(fout);
976} 1015}
977 1016
978
979
980
981/********************************************************** 1017/**********************************************************
982Dealing With Fortran OutPut 1018Dealing With Fortran OutPut
983taking into account indentation and line breaks after column 72 1019taking into account indentation and line breaks after column 72
984***********************************************************/ 1020***********************************************************/
985 1021
986
987#define MAXBUF 4096 1022#define MAXBUF 4096
988char sbuf[MAXBUF]; 1023char sbuf[MAXBUF];
989 1024
990#include <stdarg.h> 1025#include <stdarg.h>
991 1026
992void Fprintf(FILE *f,int indent2,char *format,...) 1027void Fprintf(FILE * f, int indent2, char *format, ...)
993{ 1028{
994 int i; 1029 int i;
995 static int count=0; 1030 static int count = 0;
996 va_list ap; 1031 va_list ap;
997 va_start(ap,format);
998 1032
999 vsprintf(sbuf,format,ap); 1033 va_start(ap, format);
1000 1034
1001 for ( i = 0 ; i < (int) strlen(sbuf); i++) 1035 vsprintf(sbuf, format, ap);
1036
1037 for (i = 0; i < (int)strlen(sbuf); i++)
1002 { 1038 {
1003 if ( count == 0) 1039 if (count == 0)
1004 { 1040 {
1005 white(f,indent2); 1041 white(f, indent2);
1006 count = indent2; 1042 count = indent2;
1007 } 1043 }
1008 if ( count >= 100 && sbuf[i] != '\n' && (sbuf[i] == ' ' || sbuf[i]== ',' || sbuf[i] == ';' || sbuf[i] == '(' ) ) 1044 if (count >= 100 && sbuf[i] != '\n' && (sbuf[i] == ' ' || sbuf[i] == ',' || sbuf[i] == ';' || sbuf[i] == '('))
1009 { 1045 {
1010 fprintf(f,"\n"); 1046 fprintf(f, "\n");
1011 white(f,indent2);count=indent2; 1047 white(f, indent2);
1048 count = indent2;
1012 } 1049 }
1013 if ( sbuf[i] == '\n') count = -1 ; 1050 if (sbuf[i] == '\n')
1014 fprintf(f,"%c",sbuf[i]); 1051 count = -1;
1052 fprintf(f, "%c", sbuf[i]);
1015 count++; 1053 count++;
1016 } 1054 }
1017 va_end(ap); 1055 va_end(ap);
1018} 1056}
1019 1057
1020void white(FILE *f,int ind) 1058void white(FILE * f, int ind)
1021{ 1059{
1022 int i ; 1060 int i;
1023 for (i =0 ; i < ind ; i++) fprintf(f," ");
1024}
1025 1061
1062 for (i = 0; i < ind; i++)
1063 fprintf(f, " ");
1064}
1026 1065
1027void FCprintf(FILE *f,char *format,...) 1066void FCprintf(FILE * f, char *format, ...)
1028{ 1067{
1029 va_list ap; 1068 va_list ap;
1030 va_start(ap,format);
1031 1069
1032 vfprintf(f,format,ap); 1070 va_start(ap, format);
1071
1072 vfprintf(f, format, ap);
1033 va_end(ap); 1073 va_end(ap);
1034} 1074}
1035 1075
@@ -1039,15 +1079,15 @@ void FCprintf(FILE *f,char *format,...)
1039 1079
1040VARPTR VarAlloc() 1080VARPTR VarAlloc()
1041{ 1081{
1042 return((VARPTR) malloc(sizeof(VAR))); 1082 return ((VARPTR) malloc(sizeof(VAR)));
1043} 1083}
1044 1084
1045BASFUNPTR BasfunAlloc() 1085BASFUNPTR BasfunAlloc()
1046{ 1086{
1047 return((BASFUNPTR) malloc(sizeof(BASFUN))); 1087 return ((BASFUNPTR) malloc(sizeof(BASFUN)));
1048} 1088}
1049 1089
1050FORSUBPTR ForsubAlloc() 1090FORSUBPTR ForsubAlloc()
1051{ 1091{
1052 return((FORSUBPTR) malloc(sizeof(FORSUB))); 1092 return ((FORSUBPTR) malloc(sizeof(FORSUB)));
1053} 1093}
diff --git a/scilab/modules/intersci/src/exe/intersci.c b/scilab/modules/intersci/src/exe/intersci.c
index 944c9d5..b319065 100644
--- a/scilab/modules/intersci/src/exe/intersci.c
+++ b/scilab/modules/intersci/src/exe/intersci.c
@@ -11,7 +11,6 @@
11* 11*
12*/ 12*/
13 13
14
15#ifdef _MSC_VER 14#ifdef _MSC_VER
16#include <windows.h> 15#include <windows.h>
17#include <stdio.h> 16#include <stdio.h>
@@ -24,150 +23,162 @@
24 23
25static char buf[1024]; 24static char buf[1024];
26 25
27static int icre=1; /* incremental counter for variable creation */ 26static int icre = 1; /* incremental counter for variable creation */
28static int indent = 0; /* incremental counter for code indentation */ 27static int indent = 0; /* incremental counter for code indentation */
29static int pass = 0 ; /* flag for couting pass on code generation */ 28static int pass = 0; /* flag for couting pass on code generation */
30 29
31#ifdef _MSC_VER 30#ifdef _MSC_VER
32static void SciEnv (); 31static void SciEnv();
32
33#define putenv _putenv 33#define putenv _putenv
34#pragma comment(lib,"../../../../../bin/libintl.lib") 34#pragma comment(lib,"../../../../../bin/libintl.lib")
35#endif 35#endif
36 36
37int main(argc,argv) 37int main(argc, argv)
38unsigned int argc; 38 unsigned int argc;
39char **argv; 39 char **argv;
40{ 40{
41 int InterFace = 0 ; 41 int InterFace = 0;
42
42#ifdef _MSC_VER 43#ifdef _MSC_VER
43 SciEnv(); 44 SciEnv();
44#endif 45#endif
45 switch (argc) { 46 switch (argc)
46 case 2: 47 {
47 InterFace = 0; break; 48 case 2:
48 case 3: 49 InterFace = 0;
49 InterFace = atoi(argv[2]);break; 50 break;
50 default: 51 case 3:
51 printf("usage: intersci <interface file> <interface number>\n"); 52 InterFace = atoi(argv[2]);
52 exit(1); 53 break;
53 break; 54 default:
55 printf("usage: intersci <interface file> <interface number>\n");
56 exit(1);
57 break;
54 } 58 }
55 basfun = BasfunAlloc(); 59 basfun = BasfunAlloc();
56 if (basfun == 0) { 60 if (basfun == 0)
61 {
57 printf("Running out of memory\n"); 62 printf("Running out of memory\n");
58 exit(1); 63 exit(1);
59 } 64 }
60 forsub = ForsubAlloc(); 65 forsub = ForsubAlloc();
61 if (forsub == 0) { 66 if (forsub == 0)
67 {
62 printf("Running out of memory\n"); 68 printf("Running out of memory\n");
63 exit(1); 69 exit(1);
64 } 70 }
65 ISCIReadFile(argv[1]); 71 ISCIReadFile(argv[1]);
66 GenFundef(argv[1],InterFace); 72 GenFundef(argv[1], InterFace);
67 return 0; 73 return 0;
68} 74}
69 75
70void ISCIReadFile(file) 76void ISCIReadFile(file)
71char *file; 77 char *file;
72{ 78{
73 FILE *fin, *fout, *foutv; 79 FILE *fin, *fout, *foutv;
74 char filout[MAXNAM]; 80 char filout[MAXNAM];
75 char filin[MAXNAM]; 81 char filin[MAXNAM];
76 sprintf(filin,"%s.desc",file); 82
77 fin = fopen(filin,"r"); 83 sprintf(filin, "%s.desc", file);
78 if (fin == 0) { 84 fin = fopen(filin, "r");
79 printf("Interface file \"%s\" does not exist\n",filin); 85 if (fin == 0)
86 {
87 printf("Interface file \"%s\" does not exist\n", filin);
80 exit(1); 88 exit(1);
81 } 89 }
82 Copyright(); 90 Copyright();
83 strcpy(filout,file); 91 strcpy(filout, file);
84 strcat(filout,".f"); 92 strcat(filout, ".f");
85 fout = fopen(filout,"w"); 93 fout = fopen(filout, "w");
86 strcpy(filout,file); 94 strcpy(filout, file);
87 strcat(filout,".tmp"); 95 strcat(filout, ".tmp");
88 foutv = fopen(filout,"w"); 96 foutv = fopen(filout, "w");
89 InitDeclare(); 97 InitDeclare();
90 nFun = 0; 98 nFun = 0;
91 while(ReadFunction(fin)) { 99 while (ReadFunction(fin))
100 {
92 nFun++; 101 nFun++;
93 if (nFun > MAXFUN) { 102 if (nFun > MAXFUN)
94 printf("Too many SCILAB functions. The maximum is %d\n",MAXFUN); 103 {
104 printf("Too many SCILAB functions. The maximum is %d\n", MAXFUN);
95 exit(1); 105 exit(1);
96 } 106 }
97 ResetDeclare(); 107 ResetDeclare();
98 /* first pass to collect declarations */ 108 /* first pass to collect declarations */
99 pass=0; 109 pass = 0;
100 WriteFunctionCode(foutv); 110 WriteFunctionCode(foutv);
101 /* cleaning added Fornames before pass 2 */ 111 /* cleaning added Fornames before pass 2 */
102 ForNameClean(); 112 ForNameClean();
103 /* scond pass to produce code */ 113 /* scond pass to produce code */
104 pass=1; 114 pass = 1;
105 WriteFunctionCode(fout); 115 WriteFunctionCode(fout);
106 /** WriteInfoCode(fout); **/ 116 /** WriteInfoCode(fout); **/
107 } 117 }
108 WriteMain(fout,file); 118 WriteMain(fout, file);
109 printf("FORTRAN file \"%s.f\" has been created\n",file); 119 printf("FORTRAN file \"%s.f\" has been created\n", file);
110 WriteAddInter(file) ; 120 WriteAddInter(file);
111 printf("Scilab file \"%s.sce\" has been created\n",file); 121 printf("Scilab file \"%s.sce\" has been created\n", file);
112 fclose(fout); 122 fclose(fout);
113 fclose(fin); 123 fclose(fin);
114} 124}
115 125
116void WriteMain(f,file) 126void WriteMain(f, file)
117FILE *f; 127 FILE *f;
118char* file; 128 char *file;
119{ 129{
120 int i; 130 int i;
121 FCprintf(f,"\nc interface function\n"); 131
122 FCprintf(f,"c ********************\n"); 132 FCprintf(f, "\nc interface function\n");
123 WriteMainHeader(f,file); 133 FCprintf(f, "c ********************\n");
124 Fprintf(f,indent,"goto ("); 134 WriteMainHeader(f, file);
125 for (i = 1; i < nFun ; i++) { 135 Fprintf(f, indent, "goto (");
126 Fprintf(f,indent,"%d,",i); 136 for (i = 1; i < nFun; i++)
127 } 137 {
128 Fprintf(f,indent,"%d) fin\nreturn\n",nFun); 138 Fprintf(f, indent, "%d,", i);
129 for (i = 0; i < nFun; i++) { 139 }
130 FCprintf(f,"%d call ints%s('%s')\n",i+1,funNames[i],funNames[i]); 140 Fprintf(f, indent, "%d) fin\nreturn\n", nFun);
131 Fprintf(f,indent,"return\n"); 141 for (i = 0; i < nFun; i++)
132 } 142 {
133 Fprintf(f,indent,"end\n"); 143 FCprintf(f, "%d call ints%s('%s')\n", i + 1, funNames[i], funNames[i]);
144 Fprintf(f, indent, "return\n");
145 }
146 Fprintf(f, indent, "end\n");
134} 147}
135 148
136void WriteAddInter(file) 149void WriteAddInter(file)
137char *file; 150 char *file;
138{ 151{
139 FILE *fout; 152 FILE *fout;
140 int i; 153 int i;
141 char filout[MAXNAM]; 154 char filout[MAXNAM];
142 strcpy(filout,file); 155
143 strcat(filout,".sce"); 156 strcpy(filout, file);
144 fout = fopen(filout,"w"); 157 strcat(filout, ".sce");
145 if ( fout != (FILE*) 0) 158 fout = fopen(filout, "w");
146 { 159 if (fout != (FILE *) 0)
147 fprintf(fout,"// Addinter for file %s\n",file); 160 {
148 fprintf(fout,"// for hppa/sun-solaris/linux/dec\n"); 161 fprintf(fout, "// Addinter for file %s\n", file);
149 fprintf(fout,"//--------------------------------\n"); 162 fprintf(fout, "// for hppa/sun-solaris/linux/dec\n");
150 fprintf(fout,"//Scilab functions\n"); 163 fprintf(fout, "//--------------------------------\n");
151 fprintf(fout,"%s_funs=[...\n",file); 164 fprintf(fout, "//Scilab functions\n");
152 for (i = 0; i < nFun -1; i++) 165 fprintf(fout, "%s_funs=[...\n", file);
153 fprintf(fout," '%s';\n",funNames[i]); 166 for (i = 0; i < nFun - 1; i++)
154 fprintf(fout," '%s']\n",funNames[nFun-1]); 167 fprintf(fout, " '%s';\n", funNames[i]);
155 fprintf(fout,"// interface file to link: ifile='%s.o'\n",file); 168 fprintf(fout, " '%s']\n", funNames[nFun - 1]);
156 fprintf(fout,"// user's files to link: ufiles=['file1.o','file2.o',....]\n"); 169 fprintf(fout, "// interface file to link: ifile='%s.o'\n", file);
157 fprintf(fout,"// files = [ifile,ufiles]\n"); 170 fprintf(fout, "// user's files to link: ufiles=['file1.o','file2.o',....]\n");
158 fprintf(fout,"addinter(files,'%s',%s_funs);\n",file,file); 171 fprintf(fout, "// files = [ifile,ufiles]\n");
172 fprintf(fout, "addinter(files,'%s',%s_funs);\n", file, file);
159 fclose(fout); 173 fclose(fout);
160 } 174 }
161 else 175 else
162 fprintf(stderr,"Can't open file %s\n",file); 176 fprintf(stderr, "Can't open file %s\n", file);
163} 177}
164 178
165
166
167
168void Copyright() 179void Copyright()
169{ 180{
170 printf("\nINTERSCI Version %s (%s)\n",VERSION,DATE); 181 printf("\nINTERSCI Version %s (%s)\n", VERSION, DATE);
171 printf(" Copyright (C) INRIA All rights reserved\n\n"); 182 printf(" Copyright (C) INRIA All rights reserved\n\n");
172} 183}
173 184
@@ -176,7 +187,7 @@ void Copyright()
176**********************************************************/ 187**********************************************************/
177 188
178int ReadFunction(f) 189int ReadFunction(f)
179FILE *f; 190 FILE *f;
180{ 191{
181 int i, j, l, type, ftype; 192 int i, j, l, type, ftype;
182 char s[MAXLINE]; 193 char s[MAXLINE];
@@ -193,69 +204,71 @@ FILE *f;
193 fline1 = 0; 204 fline1 = 0;
194 infor = 0; 205 infor = 0;
195 out1 = 0; 206 out1 = 0;
196 while (fgets(s,MAXLINE,f)) 207 while (fgets(s, MAXLINE, f))
197 { 208 {
198 /* analysis of one line */ 209 /* analysis of one line */
199 if (line1 != 1) nwords = ParseLine(s,words); 210 if (line1 != 1)
200 else nwords = ParseScilabLine(s,words); 211 nwords = ParseLine(s, words);
212 else
213 nwords = ParseScilabLine(s, words);
201 /* end of description */ 214 /* end of description */
202 if (words[0][0] == '*') return(1); 215 if (words[0][0] == '*')
216 return (1);
203 if (line1 == 1) 217 if (line1 == 1)
204 { 218 {
205 /* SCILAB function description */ 219 /* SCILAB function description */
206 if ((int)strlen(words[0]) > nlgh) 220 if ((int)strlen(words[0]) > nlgh)
207 { 221 {
208 printf("SCILAB function name too long: \"%s\"\n",words[0]); 222 printf("SCILAB function name too long: \"%s\"\n", words[0]);
209 exit(1); 223 exit(1);
210 } 224 }
211 basfun->name = (char *)malloc((unsigned)(strlen(words[0])+1)); 225 basfun->name = (char *)malloc((unsigned)(strlen(words[0]) + 1));
212 strcpy(basfun->name,words[0]); 226 strcpy(basfun->name, words[0]);
213 printf("**************************\n"); 227 printf("**************************\n");
214 printf("processing SCILAB function \"%s\"\n",words[0]); 228 printf("processing SCILAB function \"%s\"\n", words[0]);
215 funNames[nFun] = basfun->name; 229 funNames[nFun] = basfun->name;
216 i = nwords - 1; 230 i = nwords - 1;
217 if (i > MAXARG) 231 if (i > MAXARG)
218 { 232 {
219 printf("too may input arguments for SCILAB function\"%s\"\n", 233 printf("too may input arguments for SCILAB function\"%s\"\n", words[0]);
220 words[0]);
221 printf(" augment constant \"MAXARG\" and recompile intersci\n"); 234 printf(" augment constant \"MAXARG\" and recompile intersci\n");
222 exit(1); 235 exit(1);
223 } 236 }
224 basfun->nin = i; 237 basfun->nin = i;
225 for (i = 0; i < nwords - 1; i++) 238 for (i = 0; i < nwords - 1; i++)
226 { 239 {
227 if (words[i+1][0] == '{') 240 if (words[i + 1][0] == '{')
228 { 241 {
229 maxOpt++; 242 maxOpt++;
230 nopt = ParseLine(words[i+1]+1,optwords); 243 nopt = ParseLine(words[i + 1] + 1, optwords);
231 if (nopt != 2) { 244 if (nopt != 2)
245 {
232 printf("Bad syntax for optional argument. Two variables needed\n"); 246 printf("Bad syntax for optional argument. Two variables needed\n");
233 exit(1); 247 exit(1);
234 } 248 }
235 ivar = GetVar(optwords[0],1); 249 ivar = GetVar(optwords[0], 1);
236 basfun->in[i] = ivar; 250 basfun->in[i] = ivar;
237 variables[ivar-1]->opt_type = NAME; 251 variables[ivar - 1]->opt_type = NAME;
238 variables[ivar-1]->opt_name = 252 variables[ivar - 1]->opt_name = (char *)malloc((unsigned)(strlen(optwords[1]) + 1));
239 (char *)malloc((unsigned)(strlen(optwords[1])+1)); 253 strcpy(variables[ivar - 1]->opt_name, optwords[1]);
240 strcpy(variables[ivar-1]->opt_name,optwords[1]);
241 } 254 }
242 else if (words[i+1][0] == '[') 255 else if (words[i + 1][0] == '[')
243 { 256 {
244 maxOpt++; 257 maxOpt++;
245 nopt = ParseLine(words[i+1]+1,optwords); 258 nopt = ParseLine(words[i + 1] + 1, optwords);
246 if (nopt != 2) 259 if (nopt != 2)
247 { 260 {
248 printf("Bad syntax for optional argument. Two variables needed\n"); 261 printf("Bad syntax for optional argument. Two variables needed\n");
249 exit(1); 262 exit(1);
250 } 263 }
251 ivar = GetVar(optwords[0],1); 264 ivar = GetVar(optwords[0], 1);
252 basfun->in[i] = ivar; 265 basfun->in[i] = ivar;
253 variables[ivar-1]->opt_type = VALUE; 266 variables[ivar - 1]->opt_type = VALUE;
254 variables[ivar-1]->opt_name = 267 variables[ivar - 1]->opt_name = (char *)malloc((unsigned)(strlen(optwords[1]) + 1));
255 (char *)malloc((unsigned)(strlen(optwords[1])+1)); 268 strcpy(variables[ivar - 1]->opt_name, optwords[1]);
256 strcpy(variables[ivar-1]->opt_name,optwords[1]);
257 } 269 }
258 else basfun->in[i] = GetVar(words[i+1],1); 270 else
271 basfun->in[i] = GetVar(words[i + 1], 1);
259 } 272 }
260 line1 = 0; 273 line1 = 0;
261 inbas = 1; 274 inbas = 1;
@@ -271,11 +284,11 @@ FILE *f;
271 else 284 else
272 { 285 {
273 /* SCILAB variable description */ 286 /* SCILAB variable description */
274 ivar = GetVar(words[0],1); 287 ivar = GetVar(words[0], 1);
275 i = ivar - 1; 288 i = ivar - 1;
276 if (nwords == 1) 289 if (nwords == 1)
277 { 290 {
278 printf("type missing for variable \"%s\"\n",words[0]); 291 printf("type missing for variable \"%s\"\n", words[0]);
279 exit(1); 292 exit(1);
280 } 293 }
281 type = GetBasType(words[1]); 294 type = GetBasType(words[1]);
@@ -298,20 +311,20 @@ FILE *f;
298 if (nwords != 3) 311 if (nwords != 3)
299 { 312 {
300 printf("bad type specification for variable \"%s\"\n", words[0]); 313 printf("bad type specification for variable \"%s\"\n", words[0]);
301 printf("only %d argument given and %d are expected\n", nwords,3); 314 printf("only %d argument given and %d are expected\n", nwords, 3);
302 exit(1); 315 exit(1);
303 } 316 }
304 variables[i]->el[0] = GetVar(words[2],1); 317 variables[i]->el[0] = GetVar(words[2], 1);
305 break; 318 break;
306 case LIST: 319 case LIST:
307 case TLIST: 320 case TLIST:
308 if (nwords != 3) 321 if (nwords != 3)
309 { 322 {
310 printf("bad type specification for variable \"%s\"\n", words[0]); 323 printf("bad type specification for variable \"%s\"\n", words[0]);
311 printf("only %d argument given and %d are expected\n", nwords,3); 324 printf("only %d argument given and %d are expected\n", nwords, 3);
312 exit(1); 325 exit(1);
313 } 326 }
314 ReadListFile(words[2],words[0],i); 327 ReadListFile(words[2], words[0], i);
315 break; 328 break;
316 case POLYNOM: 329 case POLYNOM:
317 case MATRIX: 330 case MATRIX:
@@ -319,45 +332,43 @@ FILE *f;
319 case STRINGMAT: 332 case STRINGMAT:
320 if (nwords != 4) 333 if (nwords != 4)
321 { 334 {
322 printf("bad type specification for variable \"%s\"\n",words[0]); 335 printf("bad type specification for variable \"%s\"\n", words[0]);
323 printf("%d argument given and %d are expected\n", nwords,4); 336 printf("%d argument given and %d are expected\n", nwords, 4);
324 exit(1); 337 exit(1);
325 } 338 }
326 variables[i]->el[0] = GetVar(words[2],1); 339 variables[i]->el[0] = GetVar(words[2], 1);
327 variables[i]->el[1] = GetVar(words[3],1); 340 variables[i]->el[1] = GetVar(words[3], 1);
328 break; 341 break;
329 case IMATRIX: 342 case IMATRIX:
330 if (nwords != 5) 343 if (nwords != 5)
331 { 344 {
332 printf("bad type specification for variable \"%s\"\n",words[0]); 345 printf("bad type specification for variable \"%s\"\n", words[0]);
333 printf("%d argument given and %d are expected\n", nwords,5); 346 printf("%d argument given and %d are expected\n", nwords, 5);
334 exit(1); 347 exit(1);
335 } 348 }
336 variables[i]->el[0] = GetVar(words[2],1); 349 variables[i]->el[0] = GetVar(words[2], 1);
337 variables[i]->el[1] = GetVar(words[3],1); 350 variables[i]->el[1] = GetVar(words[3], 1);
338 variables[i]->el[2] = GetVar(words[4],1); 351 variables[i]->el[2] = GetVar(words[4], 1);
339 break; 352 break;
340 case SPARSE: 353 case SPARSE:
341 if (nwords != 6) 354 if (nwords != 6)
342 { 355 {
343 printf("bad type specification for variable \"%s\"\n",words[0]); 356 printf("bad type specification for variable \"%s\"\n", words[0]);
344 printf("%d argument given and %d are expected\n", nwords,6); 357 printf("%d argument given and %d are expected\n", nwords, 6);
345 printf("name sparse m n nel it\n"); 358 printf("name sparse m n nel it\n");
346 exit(1); 359 exit(1);
347 } 360 }
348 variables[i]->el[0] = GetVar(words[2],1); 361 variables[i]->el[0] = GetVar(words[2], 1);
349 variables[i]->el[1] = GetVar(words[3],1); 362 variables[i]->el[1] = GetVar(words[3], 1);
350 variables[i]->el[2] = GetVar(words[4],1); 363 variables[i]->el[2] = GetVar(words[4], 1);
351 variables[i]->el[3] = GetVar(words[5],1); 364 variables[i]->el[3] = GetVar(words[5], 1);
352 break; 365 break;
353 case SEQUENCE: 366 case SEQUENCE:
354 printf("variable \"%s\" cannot have type \"SEQUENCE\"\n", 367 printf("variable \"%s\" cannot have type \"SEQUENCE\"\n", words[0]);
355 words[0]);
356 exit(1); 368 exit(1);
357 break; 369 break;
358 case EMPTY: 370 case EMPTY:
359 printf("variable \"%s\" cannot have type \"EMPTY\"\n", 371 printf("variable \"%s\" cannot have type \"EMPTY\"\n", words[0]);
360 words[0]);
361 exit(1); 372 exit(1);
362 break; 373 break;
363 } 374 }
@@ -366,20 +377,19 @@ FILE *f;
366 else if (fline1 == 1) 377 else if (fline1 == 1)
367 { 378 {
368 /* FORTRAN subroutine description */ 379 /* FORTRAN subroutine description */
369 forsub->name = (char *)malloc((unsigned)(strlen(words[0])+1)); 380 forsub->name = (char *)malloc((unsigned)(strlen(words[0]) + 1));
370 strcpy(forsub->name,words[0]); 381 strcpy(forsub->name, words[0]);
371 i = nwords - 1; 382 i = nwords - 1;
372 if (i > MAXARG) 383 if (i > MAXARG)
373 { 384 {
374 printf("too many argument for FORTRAN subroutine \"%s\"\n", 385 printf("too many argument for FORTRAN subroutine \"%s\"\n", words[0]);
375 words[0]);
376 printf(" augment constant \"MAXARG\" and recompile intersci\n"); 386 printf(" augment constant \"MAXARG\" and recompile intersci\n");
377 exit(1); 387 exit(1);
378 } 388 }
379 forsub->narg = i; 389 forsub->narg = i;
380 for (i = 0; i < nwords - 1; i++) 390 for (i = 0; i < nwords - 1; i++)
381 { 391 {
382 forsub->arg[i] = GetExistVar(words[i+1]); 392 forsub->arg[i] = GetExistVar(words[i + 1]);
383 } 393 }
384 fline1 = 0; 394 fline1 = 0;
385 infor = 1; 395 infor = 1;
@@ -397,56 +407,54 @@ FILE *f;
397 /* FORTRAN variable description */ 407 /* FORTRAN variable description */
398 if (nwords == 1) 408 if (nwords == 1)
399 { 409 {
400 printf("type missing for FORTRAN argument \"%s\"\n", 410 printf("type missing for FORTRAN argument \"%s\"\n", words[0]);
401 words[0]);
402 exit(1); 411 exit(1);
403 } 412 }
404 ivar = GetExistVar(words[0]); 413 ivar = GetExistVar(words[0]);
405 ftype = GetForType(words[1]); 414 ftype = GetForType(words[1]);
406 variables[ivar-1]->for_type = ftype; 415 variables[ivar - 1]->for_type = ftype;
407 if (ftype == EXTERNAL) 416 if (ftype == EXTERNAL)
408 { 417 {
409 strcpy((char *)(variables[ivar-1]->fexternal),words[1]); 418 strcpy((char *)(variables[ivar - 1]->fexternal), words[1]);
410 switch (variables[ivar-1]->type) 419 switch (variables[ivar - 1]->type)
411 { 420 {
412 case COLUMN: 421 case COLUMN:
413 case POLYNOM: 422 case POLYNOM:
414 case ROW: 423 case ROW:
415 case STRING: 424 case STRING:
416 case VECTOR: 425 case VECTOR:
417 sprintf(str,"ne%d",ivar); 426 sprintf(str, "ne%d", ivar);
418 AddForName(variables[ivar-1]->el[0],str); 427 AddForName(variables[ivar - 1]->el[0], str);
419 break; 428 break;
420 case SPARSE: 429 case SPARSE:
421 sprintf(str,"me%d",ivar); 430 sprintf(str, "me%d", ivar);
422 AddForName(variables[ivar-1]->el[0],str); 431 AddForName(variables[ivar - 1]->el[0], str);
423 sprintf(str,"ne%d",ivar); 432 sprintf(str, "ne%d", ivar);
424 AddForName(variables[ivar-1]->el[1],str); 433 AddForName(variables[ivar - 1]->el[1], str);
425 sprintf(str,"nel%d",ivar); 434 sprintf(str, "nel%d", ivar);
426 AddForName(variables[ivar-1]->el[2],str); 435 AddForName(variables[ivar - 1]->el[2], str);
427 sprintf(str,"it%d",ivar); 436 sprintf(str, "it%d", ivar);
428 AddForName(variables[ivar-1]->el[3],str); 437 AddForName(variables[ivar - 1]->el[3], str);
429 break; 438 break;
430 case IMATRIX: 439 case IMATRIX:
431 sprintf(str,"me%d",ivar); 440 sprintf(str, "me%d", ivar);
432 AddForName(variables[ivar-1]->el[0],str); 441 AddForName(variables[ivar - 1]->el[0], str);
433 sprintf(str,"ne%d",ivar); 442 sprintf(str, "ne%d", ivar);
434 AddForName(variables[ivar-1]->el[1],str); 443 AddForName(variables[ivar - 1]->el[1], str);
435 sprintf(str,"it%d",ivar); 444 sprintf(str, "it%d", ivar);
436 AddForName(variables[ivar-1]->el[2],str); 445 AddForName(variables[ivar - 1]->el[2], str);
437 break; 446 break;
438 case MATRIX: 447 case MATRIX:
439 case BMATRIX: 448 case BMATRIX:
440 case STRINGMAT: 449 case STRINGMAT:
441 sprintf(str,"me%d",ivar); 450 sprintf(str, "me%d", ivar);
442 AddForName(variables[ivar-1]->el[0],str); 451 AddForName(variables[ivar - 1]->el[0], str);
443 sprintf(str,"ne%d",ivar); 452 sprintf(str, "ne%d", ivar);
444 AddForName(variables[ivar-1]->el[1],str); 453 AddForName(variables[ivar - 1]->el[1], str);
445 break; 454 break;
446 default: 455 default:
447 printf("FORTRAN argument \"%s\" with external type \"%s\"\n", 456 printf("FORTRAN argument \"%s\" with external type \"%s\"\n", variables[ivar - 1]->name, words[1]);
448 variables[ivar-1]->name,words[1]); 457 printf(" cannot have a variable type of \"%s\"\n", SGetSciType(variables[ivar - 1]->type));
449 printf(" cannot have a variable type of \"%s\"\n",SGetSciType(variables[ivar-1]->type));
450 exit(1); 458 exit(1);
451 break; 459 break;
452 } 460 }
@@ -480,7 +488,7 @@ FILE *f;
480 exit(1); 488 exit(1);
481 } 489 }
482 for (j = 0; j < l; j++) 490 for (j = 0; j < l; j++)
483 variables[i]->el[j] = GetExistVar(words[j+2]); 491 variables[i]->el[j] = GetExistVar(words[j + 2]);
484 variables[i]->length = l; 492 variables[i]->length = l;
485 break; 493 break;
486 case EMPTY: 494 case EMPTY:
@@ -498,12 +506,12 @@ FILE *f;
498 { 506 {
499 /* possibly equal variables */ 507 /* possibly equal variables */
500 ivar = GetExistVar(words[0]); 508 ivar = GetExistVar(words[0]);
501 i = ivar -1 ; 509 i = ivar - 1;
502 variables[i]->equal = GetExistVar(words[1]); 510 variables[i]->equal = GetExistVar(words[1]);
503 } 511 }
504 } 512 }
505 /* end of description file */ 513 /* end of description file */
506 return(0); 514 return (0);
507} 515}
508 516
509/* 517/*
@@ -513,72 +521,89 @@ return the number of words with checking syntax of optional variables:
513"[f v]" => 1 word "[f v\n" 521"[f v]" => 1 word "[f v\n"
514*/ 522*/
515 523
516int ParseScilabLine(char *s,char *words[]) 524int ParseScilabLine(char *s, char *words[])
517{ 525{
518 char w[MAXNAM]; 526 char w[MAXNAM];
519 int nwords = 0; 527 int nwords = 0;
520 int inword = 1; 528 int inword = 1;
521 int inopt1 = 0; /* { } */ 529 int inopt1 = 0; /* { } */
522 int inopt2 = 0; /* [ ] */ 530 int inopt2 = 0; /* [ ] */
523 int i = 0; 531 int i = 0;
524 if (*s == ' ' || *s == '\t') inword = 0; 532
525 if (*s == '{') inopt1 = 1; 533 if (*s == ' ' || *s == '\t')
526 if (*s == '[') inopt2 = 1; 534 inword = 0;
527 while (*s) { 535 if (*s == '{')
528 if (inopt1) { 536 inopt1 = 1;
537 if (*s == '[')
538 inopt2 = 1;
539 while (*s)
540 {
541 if (inopt1)
542 {
529 w[i++] = *s++; 543 w[i++] = *s++;
530 if (*s == '{' || *s == '[' || *s == ']' || *s == '\n') { 544 if (*s == '{' || *s == '[' || *s == ']' || *s == '\n')
545 {
531 printf("Bad syntax for optional argument. No matching \"}\"\n"); 546 printf("Bad syntax for optional argument. No matching \"}\"\n");
532 exit(1); 547 exit(1);
533 } 548 }
534 else if (*s == '}') { 549 else if (*s == '}')
550 {
535 w[i++] = '\n'; 551 w[i++] = '\n';
536 w[i] = '\0'; 552 w[i] = '\0';
537 words[nwords] = (char *)malloc((unsigned)(i+1)); 553 words[nwords] = (char *)malloc((unsigned)(i + 1));
538 strcpy(words[nwords],w); 554 strcpy(words[nwords], w);
539 nwords++; 555 nwords++;
540 inopt1 = 0; 556 inopt1 = 0;
541 inword = 0; 557 inword = 0;
542 } 558 }
543 } 559 }
544 else if (inopt2) { 560 else if (inopt2)
561 {
545 w[i++] = *s++; 562 w[i++] = *s++;
546 if (*s == '[' || *s == '{' || *s == '}' || *s == '\n') { 563 if (*s == '[' || *s == '{' || *s == '}' || *s == '\n')
564 {
547 printf("Bad syntax for optional argument. No matching \"]\"\n"); 565 printf("Bad syntax for optional argument. No matching \"]\"\n");
548 exit(1); 566 exit(1);
549 } 567 }
550 else if (*s == ']') { 568 else if (*s == ']')
569 {
551 w[i++] = '\n'; 570 w[i++] = '\n';
552 w[i] = '\0'; 571 w[i] = '\0';
553 words[nwords] = (char *)malloc((unsigned)(i+1)); 572 words[nwords] = (char *)malloc((unsigned)(i + 1));
554 strcpy(words[nwords],w); 573 strcpy(words[nwords], w);
555 nwords++; 574 nwords++;
556 inopt2 = 0; 575 inopt2 = 0;
557 inword = 0; 576 inword = 0;
558 } 577 }
559 } 578 }
560 else if (inword) { 579 else if (inword)
580 {
561 w[i++] = *s++; 581 w[i++] = *s++;
562 if (*s == ' ' || *s == '\t' || *s == '\n') { 582 if (*s == ' ' || *s == '\t' || *s == '\n')
583 {
563 w[i] = '\0'; 584 w[i] = '\0';
564 words[nwords] = (char *)malloc((unsigned)(i+1)); 585 words[nwords] = (char *)malloc((unsigned)(i + 1));
565 strcpy(words[nwords],w); 586 strcpy(words[nwords], w);
566 nwords++; 587 nwords++;
567 inword = 0; 588 inword = 0;
568 } 589 }
569 } 590 }
570 else { 591 else
571 s++; /* *s++; */ 592 {
572 if (*s != ' ' && *s != '\t') { 593 s++; /* *s++; */
594 if (*s != ' ' && *s != '\t')
595 {
573 /* beginning of a word */ 596 /* beginning of a word */
574 i = 0; 597 i = 0;
575 inword = 1; 598 inword = 1;
576 if (*s == '{') inopt1 = 1; 599 if (*s == '{')
577 if (*s == '[') inopt2 = 1; 600 inopt1 = 1;
601 if (*s == '[')
602 inopt2 = 1;
578 } 603 }
579 } 604 }
580 } 605 }
581 return(nwords); 606 return (nwords);
582} 607}
583 608
584/* put the words of line "s" in "words" and return the number of words */ 609/* put the words of line "s" in "words" and return the number of words */
@@ -589,25 +614,27 @@ int ParseLine(char *s, char *words[])
589 int nwords = 0; 614 int nwords = 0;
590 int inword = 1; 615 int inword = 1;
591 int i = 0; 616 int i = 0;
592 if(*s == ' ' || *s == '\t') inword = 0; 617
593 while (*s) 618 if (*s == ' ' || *s == '\t')
619 inword = 0;
620 while (*s)
594 { 621 {
595 if (inword) 622 if (inword)
596 { 623 {
597 w[i++] = *s++; 624 w[i++] = *s++;
598 if (*s == ' ' || *s == '\t' || *s == '\n') 625 if (*s == ' ' || *s == '\t' || *s == '\n')
599 { 626 {
600 w[i] = '\0'; 627 w[i] = '\0';
601 words[nwords] = (char *)malloc((unsigned)(i+1)); 628 words[nwords] = (char *)malloc((unsigned)(i + 1));
602 strcpy(words[nwords],w); 629 strcpy(words[nwords], w);
603 nwords++; 630 nwords++;
604 inword = 0; 631 inword = 0;
605 } 632 }
606 } 633 }
607 else 634 else
608 { 635 {
609 s++; /* *s++; */ 636 s++; /* *s++; */
610 if (*s != ' ' && *s != '\t') 637 if (*s != ' ' && *s != '\t')
611 { 638 {
612 i = 0; 639 i = 0;
613 inword = 1; 640 inword = 1;
@@ -619,37 +646,34 @@ int ParseLine(char *s, char *words[])
619 if (i > 1) 646 if (i > 1)
620 { 647 {
621 w[i] = '\0'; 648 w[i] = '\0';
622 words[nwords] = (char *)malloc((unsigned)(i+1)); 649 words[nwords] = (char *)malloc((unsigned)(i + 1));
623 strcpy(words[nwords],w); 650 strcpy(words[nwords], w);
624 nwords++; 651 nwords++;
625 } 652 }
626 653
627 return(nwords); 654 return (nwords);
628} 655}
629 656
630 657void ReadListFile(listname, varlistname, ivar)
631 658 char *listname;
632void ReadListFile(listname,varlistname,ivar) 659 char *varlistname;
633char *listname; 660 IVAR ivar;
634char *varlistname;
635IVAR ivar;
636{ 661{
637 FILE *fin; 662 FILE *fin;
638 char filin[MAXNAM]; 663 char filin[MAXNAM];
639 int nel; 664 int nel;
640 665
641 sprintf(filin,"%s.list",listname); 666 sprintf(filin, "%s.list", listname);
642 fin = fopen(filin,"r"); 667 fin = fopen(filin, "r");
643 if (fin == 0) 668 if (fin == 0)
644 { 669 {
645 printf("description file for list or tlist \"%s\" does not exist\n", 670 printf("description file for list or tlist \"%s\" does not exist\n", filin);
646 filin);
647 exit(1); 671 exit(1);
648 } 672 }
649 printf("reading description file for list or tlist \"%s\"\n", listname); 673 printf("reading description file for list or tlist \"%s\"\n", listname);
650 674
651 nel = 0; 675 nel = 0;
652 while(ReadListElement(fin,varlistname,ivar,nel)) 676 while (ReadListElement(fin, varlistname, ivar, nel))
653 { 677 {
654 nel++; 678 nel++;
655 } 679 }
@@ -657,19 +681,20 @@ IVAR ivar;
657 fclose(fin); 681 fclose(fin);
658} 682}
659 683
660int ReadListElement(f,varlistname,iivar,nel) 684int ReadListElement(f, varlistname, iivar, nel)
661FILE *f; 685 FILE *f;
662char *varlistname; 686 char *varlistname;
663int nel; 687 int nel;
664IVAR iivar; 688 IVAR iivar;
665{ 689{
666 char s[MAXLINE]; 690 char s[MAXLINE];
667 char *words[MAXLINE]; 691 char *words[MAXLINE];
668 int i, nline, nwords, type; 692 int i, nline, nwords, type;
669 IVAR ivar; 693 IVAR ivar;
670 char str[MAXNAM]; 694 char str[MAXNAM];
695
671 nline = 0; 696 nline = 0;
672 while (fgets(s,MAXLINE,f) != NULL) 697 while (fgets(s, MAXLINE, f) != NULL)
673 { 698 {
674 /* analyse of one line */ 699 /* analyse of one line */
675 nline++; 700 nline++;
@@ -679,22 +704,22 @@ IVAR iivar;
679 break; 704 break;
680 case 2: 705 case 2:
681 /* SCILAB variable description */ 706 /* SCILAB variable description */
682 nwords = ParseLine(s,words); 707 nwords = ParseLine(s, words);
683 sprintf(str,"%s(%s)",words[0],varlistname); 708 sprintf(str, "%s(%s)", words[0], varlistname);
684 ivar = GetVar(str,0); 709 ivar = GetVar(str, 0);
685 i = ivar - 1; 710 i = ivar - 1;
686 if (nwords == 1) 711 if (nwords == 1)
687 { 712 {
688 printf("type missing for variable \"%s\"\n",words[0]); 713 printf("type missing for variable \"%s\"\n", words[0]);
689 exit(1); 714 exit(1);
690 } 715 }
691 type = GetBasType(words[1]); 716 type = GetBasType(words[1]);
692 variables[i]->type = type; 717 variables[i]->type = type;
693 variables[i]->list_name = (char *)malloc((unsigned)(strlen(varlistname)+1)); 718 variables[i]->list_name = (char *)malloc((unsigned)(strlen(varlistname) + 1));
694 strcpy(variables[i]->list_name,varlistname); 719 strcpy(variables[i]->list_name, varlistname);
695 variables[i]->list_el = nel+1; 720 variables[i]->list_el = nel + 1;
696 sprintf(str,"stk(l%de%d)",iivar+1,nel+1); 721 sprintf(str, "stk(l%de%d)", iivar + 1, nel + 1);
697 AddForName(ivar,str); 722 AddForName(ivar, str);
698 switch (type) 723 switch (type)
699 { 724 {
700 case SCALAR: 725 case SCALAR:
@@ -706,18 +731,17 @@ IVAR iivar;
706 case VECTOR: 731 case VECTOR:
707 if (nwords != 3) 732 if (nwords != 3)
708 { 733 {
709 printf("bad type for variable \"%s\"\n", 734 printf("bad type for variable \"%s\"\n", words[0]);
710 words[0]);
711 exit(1); 735 exit(1);
712 } 736 }
713 if (isdigit(words[2][0])) 737 if (isdigit(words[2][0]))
714 { 738 {
715 variables[i]->el[0] = GetVar(words[2],0); 739 variables[i]->el[0] = GetVar(words[2], 0);
716 } 740 }
717 else 741 else
718 { 742 {
719 sprintf(str,"%s(%s)",words[2],varlistname); 743 sprintf(str, "%s(%s)", words[2], varlistname);
720 variables[i]->el[0] = GetVar(str,0); 744 variables[i]->el[0] = GetVar(str, 0);
721 } 745 }
722 break; 746 break;
723 case POLYNOM: 747 case POLYNOM:
@@ -726,130 +750,123 @@ IVAR iivar;
726 case STRINGMAT: 750 case STRINGMAT:
727 if (nwords != 4) 751 if (nwords != 4)
728 { 752 {
729 printf("bad type for variable \"%s\"\n", 753 printf("bad type for variable \"%s\"\n", words[0]);
730 words[0]);
731 exit(1); 754 exit(1);
732 } 755 }
733 if (isdigit(words[2][0])) 756 if (isdigit(words[2][0]))
734 { 757 {
735 variables[i]->el[0] = GetVar(words[2],0); 758 variables[i]->el[0] = GetVar(words[2], 0);
736 } 759 }
737 else 760 else
738 { 761 {
739 sprintf(str,"%s(%s)",words[2],varlistname); 762 sprintf(str, "%s(%s)", words[2], varlistname);
740 variables[i]->el[0] = GetVar(str,0); 763 variables[i]->el[0] = GetVar(str, 0);
741 } 764 }
742 if (isdigit(words[3][0])) 765 if (isdigit(words[3][0]))
743 { 766 {
744 variables[i]->el[1] = GetVar(words[3],0); 767 variables[i]->el[1] = GetVar(words[3], 0);
745 } 768 }
746 else 769 else
747 { 770 {
748 sprintf(str,"%s(%s)",words[3],varlistname); 771 sprintf(str, "%s(%s)", words[3], varlistname);
749 variables[i]->el[1] = GetVar(str,0); 772 variables[i]->el[1] = GetVar(str, 0);
750 } 773 }
751 break; 774 break;
752 case IMATRIX: 775 case IMATRIX:
753 if (nwords != 6) 776 if (nwords != 6)
754 { 777 {
755 printf("bad type for variable \"%s\"\n", 778 printf("bad type for variable \"%s\"\n", words[0]);
756 words[0]);
757 exit(1); 779 exit(1);
758 } 780 }
759 if (isdigit(words[2][0])) 781 if (isdigit(words[2][0]))
760 { 782 {
761 variables[i]->el[0] = GetVar(words[2],0); 783 variables[i]->el[0] = GetVar(words[2], 0);
762 } 784 }
763 else 785 else
764 { 786 {
765 sprintf(str,"%s(%s)",words[2],varlistname); 787 sprintf(str, "%s(%s)", words[2], varlistname);
766 variables[i]->el[0] = GetVar(str,0); 788 variables[i]->el[0] = GetVar(str, 0);
767 } 789 }
768 if (isdigit(words[3][0])) 790 if (isdigit(words[3][0]))
769 { 791 {
770 variables[i]->el[1] = GetVar(words[3],0); 792 variables[i]->el[1] = GetVar(words[3], 0);
771 } 793 }
772 else 794 else
773 { 795 {
774 sprintf(str,"%s(%s)",words[3],varlistname); 796 sprintf(str, "%s(%s)", words[3], varlistname);
775 variables[i]->el[1] = GetVar(str,0); 797 variables[i]->el[1] = GetVar(str, 0);
776 } 798 }
777 sprintf(str,"%s(%s)",words[4],varlistname); 799 sprintf(str, "%s(%s)", words[4], varlistname);
778 variables[i]->el[2] = GetVar(str,0); 800 variables[i]->el[2] = GetVar(str, 0);
779 break; 801 break;
780 case SPARSE: 802 case SPARSE:
781 if (nwords != 6) 803 if (nwords != 6)
782 { 804 {
783 printf("bad type for variable \"%s\"\n", 805 printf("bad type for variable \"%s\"\n", words[0]);
784 words[0]);
785 exit(1); 806 exit(1);
786 } 807 }
787 if (isdigit(words[2][0])) 808 if (isdigit(words[2][0]))
788 { 809 {
789 variables[i]->el[0] = GetVar(words[2],0); 810 variables[i]->el[0] = GetVar(words[2], 0);
790 } 811 }
791 else 812 else
792 { 813 {
793 sprintf(str,"%s(%s)",words[2],varlistname); 814 sprintf(str, "%s(%s)", words[2], varlistname);
794 variables[i]->el[0] = GetVar(str,0); 815 variables[i]->el[0] = GetVar(str, 0);
795 } 816 }
796 if (isdigit(words[3][0])) 817 if (isdigit(words[3][0]))
797 { 818 {
798 variables[i]->el[1] = GetVar(words[3],0); 819 variables[i]->el[1] = GetVar(words[3], 0);
799 } 820 }
800 else 821 else
801 { 822 {
802 sprintf(str,"%s(%s)",words[3],varlistname); 823 sprintf(str, "%s(%s)", words[3], varlistname);
803 variables[i]->el[1] = GetVar(str,0); 824 variables[i]->el[1] = GetVar(str, 0);
804 } 825 }
805 if (isdigit(words[4][0])) 826 if (isdigit(words[4][0]))
806 { 827 {
807 variables[i]->el[2] = GetVar(words[4],0); 828 variables[i]->el[2] = GetVar(words[4], 0);
808 } 829 }
809 else 830 else
810 { 831 {
811 sprintf(str,"%s(%s)",words[4],varlistname); 832 sprintf(str, "%s(%s)", words[4], varlistname);
812 variables[i]->el[2] = GetVar(str,0); 833 variables[i]->el[2] = GetVar(str, 0);
813 } 834 }
814 sprintf(str,"%s(%s)",words[5],varlistname); 835 sprintf(str, "%s(%s)", words[5], varlistname);
815 variables[i]->el[3] = GetVar(str,0); 836 variables[i]->el[3] = GetVar(str, 0);
816 break; 837 break;
817 case WORK: 838 case WORK:
818 case SEQUENCE: 839 case SEQUENCE:
819 case EMPTY: 840 case EMPTY:
820 case LIST: 841 case LIST:
821 case TLIST: 842 case TLIST:
822 printf("variable \"%s\" cannot have type \"%s\"\n", 843 printf("variable \"%s\" cannot have type \"%s\"\n", words[0], SGetSciType(type));
823 words[0],SGetSciType(type));
824 exit(1); 844 exit(1);
825 default: 845 default:
826 printf("variable \"%s\" has unknown type \"%s\"\n", 846 printf("variable \"%s\" has unknown type \"%s\"\n", words[0], SGetSciType(type));
827 words[0],SGetSciType(type));
828 } 847 }
829 break; 848 break;
830 default: 849 default:
831 /* end of description */ 850 /* end of description */
832 if (s[0] == '*') 851 if (s[0] == '*')
833 { 852 {
834 return(1); 853 return (1);
835 } 854 }
836 else 855 else
837 { 856 {
838 printf("bad description file for list or tlist \"%s\"\n", 857 printf("bad description file for list or tlist \"%s\"\n", varlistname);
839 varlistname);
840 exit(1); 858 exit(1);
841 } 859 }
842 break; 860 break;
843 } 861 }
844 } 862 }
845 return(0); 863 return (0);
846} 864}
847 865
848/********************************************************************* 866/*********************************************************************
849Dealing with the set of variables 867Dealing with the set of variables
850*********************************************************************/ 868*********************************************************************/
851 869
852
853/* return the variable number of variable name. if it does not already exist, 870/* return the variable number of variable name. if it does not already exist,
854it is created and "nVariable" is incremented 871it is created and "nVariable" is incremented
855p corresponds to the present slot of var structure: 872p corresponds to the present slot of var structure:
@@ -857,36 +874,42 @@ p corresponds to the present slot of var structure:
857- if the variable exists it is created with (p or 0) value 874- if the variable exists it is created with (p or 0) value
858*/ 875*/
859 876
860IVAR GetVar(name,p) 877IVAR GetVar(name, p)
861char *name; 878 char *name;
862int p; 879 int p;
863{ 880{
864 int i; 881 int i;
865 VARPTR var; 882 VARPTR var;
866 if (strcmp(name,"out") == 0) { 883
884 if (strcmp(name, "out") == 0)
885 {
867 printf("the name of a variable which is not the output variable\n"); 886 printf("the name of a variable which is not the output variable\n");
868 printf(" of SCILAB function cannot be \"out\"\n"); 887 printf(" of SCILAB function cannot be \"out\"\n");
869 exit(1); 888 exit(1);
870 } 889 }
871 for (i = 0; i < nVariable; i++) { 890 for (i = 0; i < nVariable; i++)
891 {
872 var = variables[i]; 892 var = variables[i];
873 if (strcmp(var->name,name) == 0) { 893 if (strcmp(var->name, name) == 0)
894 {
874 var->present = var->present || p; 895 var->present = var->present || p;
875 return(i+1); 896 return (i + 1);
876 } 897 }
877 } 898 }
878 if (nVariable == MAXVAR) { 899 if (nVariable == MAXVAR)
900 {
879 printf("too many variables\n"); 901 printf("too many variables\n");
880 printf(" augment constant \"MAXVAR\" and recompile intersci\n"); 902 printf(" augment constant \"MAXVAR\" and recompile intersci\n");
881 exit(1); 903 exit(1);
882 } 904 }
883 var = VarAlloc(); 905 var = VarAlloc();
884 if (var == 0) { 906 if (var == 0)
907 {
885 printf("Running out of memory\n"); 908 printf("Running out of memory\n");
886 exit(1); 909 exit(1);
887 } 910 }
888 var->name = (char *)malloc((unsigned)(strlen(name) + 1)); 911 var->name = (char *)malloc((unsigned)(strlen(name) + 1));
889 strcpy(var->name,name); 912 strcpy(var->name, name);
890 var->type = 0; 913 var->type = 0;
891 var->length = 0; 914 var->length = 0;
892 var->for_type = 0; 915 var->for_type = 0;
@@ -896,9 +919,9 @@ int p;
896 var->list_el = 0; 919 var->list_el = 0;
897 var->opt_type = 0; 920 var->opt_type = 0;
898 var->present = p; 921 var->present = p;
899 var->list_name = 0; ;/* bug fixed : an uninitialized pointer */ 922 var->list_name = 0;; /* bug fixed : an uninitialized pointer */
900 variables[nVariable++] = var; 923 variables[nVariable++] = var;
901 return(nVariable); 924 return (nVariable);
902} 925}
903 926
904/* return the variable number of variable name which must already exist */ 927/* return the variable number of variable name which must already exist */
@@ -907,22 +930,27 @@ IVAR GetExistVar(char *name)
907{ 930{
908 int i; 931 int i;
909 VARPTR var; 932 VARPTR var;
910 if (strcmp(name,"out") == 0) { 933
934 if (strcmp(name, "out") == 0)
935 {
911 printf("the name of a variable which is not the output variable\n"); 936 printf("the name of a variable which is not the output variable\n");
912 printf(" of SCILAB function cannot be \"out\"\n"); 937 printf(" of SCILAB function cannot be \"out\"\n");
913 exit(1); 938 exit(1);
914 } 939 }
915 for (i = 0; i < nVariable; i++) { 940 for (i = 0; i < nVariable; i++)
941 {
916 var = variables[i]; 942 var = variables[i];
917 if (strcmp(var->name,name) == 0) { 943 if (strcmp(var->name, name) == 0)
944 {
918 /* always present */ 945 /* always present */
919 var->present = 1; 946 var->present = 1;
920 return(i+1); 947 return (i + 1);
921 } 948 }
922 } 949 }
923 i=CreatePredefVar(name); 950 i = CreatePredefVar(name);
924 if ( i != -1) return(i); 951 if (i != -1)
925 printf("variable \"%s\" must exist\n",name); 952 return (i);
953 printf("variable \"%s\" must exist\n", name);
926 exit(1); 954 exit(1);
927} 955}
928 956
@@ -932,47 +960,50 @@ it's done without aby checks
932*/ 960*/
933 961
934int CreatePredefVar(name) 962int CreatePredefVar(name)
935char *name; 963 char *name;
936{ 964{
937 VARPTR var; 965 VARPTR var;
938 if (strcmp(name,"err") == 0 966
939 || strcmp(name,"rhs") == 0 967 if (strcmp(name, "err") == 0 || strcmp(name, "rhs") == 0 || strcmp(name, "lhs") == 0 || strcmp(name, "fname") == 0)
940 || strcmp(name,"lhs") == 0 968 {
941 || strcmp(name,"fname") == 0) 969 int num;
942 { 970
943 int num ; 971 num = GetVar(name, 1);
944 num=GetVar(name,1); 972 var = variables[num - 1];
945 var = variables[num-1];
946 var->for_type = PREDEF; 973 var->for_type = PREDEF;
947 return(num); 974 return (num);
948 } 975 }
949 return(-1); 976 return (-1);
950} 977}
951 978
952/* return the variable number of variable "out" 979/* return the variable number of variable "out"
953which is created and "nVariable" is incremented */ 980which is created and "nVariable" is incremented */
954 981
955IVAR GetOutVar(name) 982IVAR GetOutVar(name)
956char *name; 983 char *name;
957{ 984{
958 VARPTR var; 985 VARPTR var;
959 if (strcmp(name,"out") != 0) { 986
987 if (strcmp(name, "out") != 0)
988 {
960 printf("the name of output variable of SCILAB function\n"); 989 printf("the name of output variable of SCILAB function\n");
961 printf(" must be \"out\"\n"); 990 printf(" must be \"out\"\n");
962 exit(1); 991 exit(1);
963 } 992 }
964 if (nVariable == MAXVAR) { 993 if (nVariable == MAXVAR)
994 {
965 printf("too many variables\n"); 995 printf("too many variables\n");
966 printf(" augmente constant \"MAXVAR\" and recompile intersci\n"); 996 printf(" augmente constant \"MAXVAR\" and recompile intersci\n");
967 exit(1); 997 exit(1);
968 } 998 }
969 var = VarAlloc(); 999 var = VarAlloc();
970 if (var == 0) { 1000 if (var == 0)
1001 {
971 printf("Running out of memory\n"); 1002 printf("Running out of memory\n");
972 exit(1); 1003 exit(1);
973 } 1004 }
974 var->name = (char *)malloc((unsigned)(strlen(name) + 1)); 1005 var->name = (char *)malloc((unsigned)(strlen(name) + 1));
975 strcpy(var->name,name); 1006 strcpy(var->name, name);
976 var->type = 0; 1007 var->type = 0;
977 var->length = 0; 1008 var->length = 0;
978 var->for_type = 0; 1009 var->for_type = 0;
@@ -983,7 +1014,7 @@ char *name;
983 var->opt_type = 0; 1014 var->opt_type = 0;
984 var->present = 0; 1015 var->present = 0;
985 variables[nVariable++] = var; 1016 variables[nVariable++] = var;
986 return(nVariable); 1017 return (nVariable);
987} 1018}
988 1019
989/* return the variable number of variable "out" 1020/* return the variable number of variable "out"
@@ -993,10 +1024,12 @@ IVAR GetExistOutVar()
993{ 1024{
994 int i; 1025 int i;
995 char str[4]; 1026 char str[4];
996 strcpy(str,"out"); 1027
997 for (i = 0; i < nVariable; i++) { 1028 strcpy(str, "out");
998 if (strcmp(variables[i]->name,str) == 0) 1029 for (i = 0; i < nVariable; i++)
999 return(i+1); 1030 {
1031 if (strcmp(variables[i]->name, str) == 0)
1032 return (i + 1);
1000 } 1033 }
1001 printf("variable \"out\" must exist\n"); 1034 printf("variable \"out\" must exist\n");
1002 exit(1); 1035 exit(1);
@@ -1007,43 +1040,47 @@ IVAR GetExistOutVar()
1007* field of variable ivar 1040* field of variable ivar
1008***************************/ 1041***************************/
1009 1042
1010void AddForName(ivar,name) 1043void AddForName(ivar, name)
1011IVAR ivar; 1044 IVAR ivar;
1012char* name; 1045 char *name;
1013{ 1046{
1014 VARPTR var; 1047 VARPTR var;
1015 int l; 1048 int l;
1016 var = variables[ivar-1]; 1049
1050 var = variables[ivar - 1];
1017 l = var->nfor_name; 1051 l = var->nfor_name;
1018 if (l == MAXARG) { 1052 if (l == MAXARG)
1019 printf("too many \"for_name\" for variable \"%s\"\n",var->name); 1053 {
1054 printf("too many \"for_name\" for variable \"%s\"\n", var->name);
1020 printf(" augment constant \"MAXARG\" and recompile intersci\n"); 1055 printf(" augment constant \"MAXARG\" and recompile intersci\n");
1021 exit(1); 1056 exit(1);
1022 } 1057 }
1023 var->for_name[l] = (char *)malloc((unsigned)(strlen(name) + 1)); 1058 var->for_name[l] = (char *)malloc((unsigned)(strlen(name) + 1));
1024 strcpy(var->for_name[l],name); 1059 strcpy(var->for_name[l], name);
1025 var->nfor_name = l + 1; 1060 var->nfor_name = l + 1;
1026} 1061}
1027 1062
1028void AddForName1(ivar,name) 1063void AddForName1(ivar, name)
1029IVAR ivar; 1064 IVAR ivar;
1030char* name; 1065 char *name;
1031{ 1066{
1032 VARPTR var; 1067 VARPTR var;
1033 int l; 1068 int l;
1034 var = variables[ivar-1]; 1069
1070 var = variables[ivar - 1];
1035 l = var->nfor_name; 1071 l = var->nfor_name;
1036 if ( pass == 0 && var->kp_state == -1 ) 1072 if (pass == 0 && var->kp_state == -1)
1037 { 1073 {
1038 var->kp_state = var->nfor_name ; 1074 var->kp_state = var->nfor_name;
1039 } 1075 }
1040 if (l == MAXARG) { 1076 if (l == MAXARG)
1041 printf("too many \"for_name\" for variable \"%s\"\n",var->name); 1077 {
1078 printf("too many \"for_name\" for variable \"%s\"\n", var->name);
1042 printf(" augment constant \"MAXARG\" and recompile intersci\n"); 1079 printf(" augment constant \"MAXARG\" and recompile intersci\n");
1043 exit(1); 1080 exit(1);
1044 } 1081 }
1045 var->for_name[l] = (char *)malloc((unsigned)(strlen(name) + 1)); 1082 var->for_name[l] = (char *)malloc((unsigned)(strlen(name) + 1));
1046 strcpy(var->for_name[l],name); 1083 strcpy(var->for_name[l], name);
1047 var->nfor_name = l + 1; 1084 var->nfor_name = l + 1;
1048} 1085}
1049 1086
@@ -1051,27 +1088,31 @@ void ForNameClean()
1051{ 1088{
1052 VARPTR var; 1089 VARPTR var;
1053 int i; 1090 int i;
1054 for (i = 0; i < nVariable; i++) { 1091
1092 for (i = 0; i < nVariable; i++)
1093 {
1055 var = variables[i]; 1094 var = variables[i];
1056 if ( var->kp_state != -1 ) 1095 if (var->kp_state != -1)
1057 { 1096 {
1058 var->nfor_name = var->kp_state ; 1097 var->nfor_name = var->kp_state;
1059 } 1098 }
1060 } 1099 }
1061} 1100}
1062 1101
1063void ChangeForName(ivar,name) 1102void ChangeForName(ivar, name)
1064IVAR ivar; 1103 IVAR ivar;
1065char* name; 1104 char *name;
1066{ 1105{
1067 VARPTR var; 1106 VARPTR var;
1068 int l; 1107 int l;
1069 var = variables[ivar-1]; 1108
1109 var = variables[ivar - 1];
1070 l = var->nfor_name; 1110 l = var->nfor_name;
1071 var->for_name[0] = (char *)malloc((unsigned)(strlen(name) + 1)); 1111 var->for_name[0] = (char *)malloc((unsigned)(strlen(name) + 1));
1072 strcpy(var->for_name[0],name); 1112 strcpy(var->for_name[0], name);
1073 /* useful ??? */ 1113 /* useful ??? */
1074 if (l == 0) var->nfor_name = 1; 1114 if (l == 0)
1115 var->nfor_name = 1;
1075} 1116}
1076 1117
1077/*********************************************************** 1118/***********************************************************
@@ -1082,93 +1123,141 @@ pour les types Scilab et les types Fortran
1082 1123
1083/* Attention tableau en ordre alphabetique */ 1124/* Attention tableau en ordre alphabetique */
1084 1125
1085static struct btype { char *sname ; 1126static struct btype
1086int code ;} 1127{
1087SType[] = { 1128 char *sname;
1088 {"any", ANY}, 1129 int code;
1089 {"bmatrix", BMATRIX}, 1130}
1090 {"bpointer", SCIBPOINTER}, 1131SType[] =
1091 {"column", COLUMN}, 1132{
1092 {"empty", EMPTY}, 1133 {
1093 {"imatrix", IMATRIX}, 1134 "any", ANY},
1094 {"list", LIST}, 1135 {
1095 {"lpointer", SCILPOINTER}, 1136 "bmatrix", BMATRIX},
1096 {"matrix", MATRIX}, 1137 {
1097 {"mpointer", SCIMPOINTER}, 1138 "bpointer", SCIBPOINTER},
1098 {"opointer", SCIOPOINTER}, 1139 {
1099 {"polynom", POLYNOM}, 1140 "column", COLUMN},
1100 {"row", ROW}, 1141 {
1101 {"scalar", SCALAR}, 1142 "empty", EMPTY},
1102 {"sequence", SEQUENCE}, 1143 {
1103 {"smpointer", SCISMPOINTER}, 1144 "imatrix", IMATRIX},
1104 {"sparse", SPARSE}, 1145 {
1105 {"string", STRING}, 1146 "list", LIST},
1106 {"stringmat", STRINGMAT}, 1147 {
1107 {"tlist", TLIST}, 1148 "lpointer", SCILPOINTER},
1108 {"vector", VECTOR}, 1149 {
1109 {"work", WORK}, 1150 "matrix", MATRIX},
1110 {(char *) 0 , -1} 1151 {
1152 "mpointer", SCIMPOINTER},
1153 {
1154 "opointer", SCIOPOINTER},
1155 {
1156 "polynom", POLYNOM},
1157 {
1158 "row", ROW},
1159 {
1160 "scalar", SCALAR},
1161 {
1162 "sequence", SEQUENCE},
1163 {
1164 "smpointer", SCISMPOINTER},
1165 {
1166 "sparse", SPARSE},
1167 {
1168 "string", STRING},
1169 {
1170 "stringmat", STRINGMAT},
1171 {
1172 "tlist", TLIST},
1173 {
1174 "vector", VECTOR},
1175 {
1176 "work", WORK},
1177 {
1178 (char *)0, -1}
1111}; 1179};
1112 1180
1113/* Type Scilab: renvoit un codage du type en nombre entier etant donne une chaine */ 1181/* Type Scilab: renvoit un codage du type en nombre entier etant donne une chaine */
1114 1182
1115int GetBasType(sname) 1183int GetBasType(sname)
1116char *sname; 1184 char *sname;
1117{ 1185{
1118 int i=0; 1186 int i = 0;
1119 while ( SType[i].sname != (char *) NULL) 1187
1188 while (SType[i].sname != (char *)NULL)
1120 { 1189 {
1121 int j ; 1190 int j;
1122 j = strcmp(sname,SType[i].sname); 1191
1123 if ( j == 0 ) 1192 j = strcmp(sname, SType[i].sname);
1193 if (j == 0)
1124 { 1194 {
1125 return(SType[i].code); 1195 return (SType[i].code);
1126 } 1196 }
1127 else 1197 else
1128 { 1198 {
1129 if ( j <= 0) 1199 if (j <= 0)
1130 break; 1200 break;
1131 else i++; 1201 else
1202 i++;
1132 } 1203 }
1133 } 1204 }
1134 printf("the type of variable \"%s\" is unknown\n",sname); 1205 printf("the type of variable \"%s\" is unknown\n", sname);
1135 exit(1); 1206 exit(1);
1136} 1207}
1137 1208
1138/* Type Scilab : Renvoit la description (string) d'un type a partir de son code */ 1209/* Type Scilab : Renvoit la description (string) d'un type a partir de son code */
1139 1210
1140char *SGetSciType(type) 1211char *SGetSciType(type)
1141int type; 1212 int type;
1142{ 1213{
1143 int i=0; 1214 int i = 0;
1144 while ( SType[i].code != -1 ) 1215
1216 while (SType[i].code != -1)
1145 { 1217 {
1146 if ( SType[i].code == type ) 1218 if (SType[i].code == type)
1147 return(SType[i].sname); 1219 return (SType[i].sname);
1148 else 1220 else
1149 i++; 1221 i++;
1150 } 1222 }
1151 return("unknown"); 1223 return ("unknown");
1152} 1224}
1153 1225
1154/* Attention tableau en ordre alphabetique */ 1226/* Attention tableau en ordre alphabetique */
1155 1227
1156static struct ftype { char *fname ; 1228static struct ftype
1157int code ;} 1229{
1158FType[] = { 1230 char *fname;
1159 {"Cstringv",CSTRINGV}, 1231 int code;
1160 {"bpointer",BPOINTER}, 1232}
1161 {"char",CHAR}, 1233FType[] =
1162 {"double", DOUBLE}, 1234{
1163 {"int",INT}, 1235 {
1164 {"integer",INT}, 1236 "Cstringv", CSTRINGV},
1165 {"lpointer",LPOINTER}, 1237 {
1166 {"mpointer",MPOINTER}, 1238 "bpointer", BPOINTER},
1167 {"opointer",OPOINTER}, 1239 {
1168 {"predef",PREDEF}, 1240 "char", CHAR},
1169 {"real",REAL}, 1241 {
1170 {"smpointer",SMPOINTER}, 1242 "double", DOUBLE},
1171 {(char *) 0 , -1} 1243 {
1244 "int", INT},
1245 {
1246 "integer", INT},
1247 {
1248 "lpointer", LPOINTER},
1249 {
1250 "mpointer", MPOINTER},
1251 {
1252 "opointer", OPOINTER},
1253 {
1254 "predef", PREDEF},
1255 {
1256 "real", REAL},
1257 {
1258 "smpointer", SMPOINTER},
1259 {
1260 (char *)0, -1}
1172}; 1261};
1173 1262
1174/* Type Fortran: renvoit un codage du type en nombre entier etant donne une chaine */ 1263/* Type Fortran: renvoit un codage du type en nombre entier etant donne une chaine */
@@ -1176,129 +1265,132 @@ FType[] = {
1176 1265
1177int GetForType(char *type) 1266int GetForType(char *type)
1178{ 1267{
1179 int i=0; 1268 int i = 0;
1180 while ( FType[i].fname != (char *) NULL) 1269
1270 while (FType[i].fname != (char *)NULL)
1181 { 1271 {
1182 int j; 1272 int j;
1183 j = strcmp(type,FType[i].fname); 1273
1184 if ( j == 0 ) 1274 j = strcmp(type, FType[i].fname);
1275 if (j == 0)
1185 { 1276 {
1186 return(FType[i].code); 1277 return (FType[i].code);
1187 } 1278 }
1188 else 1279 else
1189 { 1280 {
1190 if ( j <= 0) 1281 if (j <= 0)
1191 break; 1282 break;
1192 else i++; 1283 else
1284 i++;
1193 } 1285 }
1194 } 1286 }
1195 return(EXTERNAL); 1287 return (EXTERNAL);
1196} 1288}
1197 1289
1198/* Type Scilab : Renvoit la description (string) d'un type a partir de son code */ 1290/* Type Scilab : Renvoit la description (string) d'un type a partir de son code */
1199 1291
1200char *SGetForType(int type) 1292char *SGetForType(int type)
1201{ 1293{
1202 int i=0; 1294 int i = 0;
1203 while ( FType[i].code != -1 ) 1295
1296 while (FType[i].code != -1)
1204 { 1297 {
1205 if ( FType[i].code == type ) 1298 if (FType[i].code == type)
1206 return(FType[i].fname); 1299 return (FType[i].fname);
1207 else 1300 else
1208 i++; 1301 i++;
1209 } 1302 }
1210 return("External"); 1303 return ("External");
1211} 1304}
1212 1305
1213/*************************************************************** 1306/***************************************************************
1214Code generation 1307Code generation
1215***************************************************************/ 1308***************************************************************/
1216 1309
1217void WriteMainHeader(FILE *f,char *fname) 1310void WriteMainHeader(FILE * f, char *fname)
1218{ 1311{
1219 Fprintf(f,indent,"subroutine %s\n",fname); 1312 Fprintf(f, indent, "subroutine %s\n", fname);
1220 /* path of stack.h must be defined in FFLAGS */ 1313 /* path of stack.h must be defined in FFLAGS */
1221 /* same behaviour that others definitions of this include see line 1232 */ 1314 /* same behaviour that others definitions of this include see line 1232 */
1222 Fprintf(f,indent,"include 'stack.h'\n"); 1315 Fprintf(f, indent, "include 'stack.h'\n");
1223 Fprintf(f,indent,"rhs = max(0,rhs)\n"); 1316 Fprintf(f, indent, "rhs = max(0,rhs)\n");
1224 FCprintf(f,"c\n"); 1317 FCprintf(f, "c\n");
1225} 1318}
1226 1319
1227void WriteHeader(FILE *f,char *fname0,char *fname) 1320void WriteHeader(FILE * f, char *fname0, char *fname)
1228{ 1321{
1229 Fprintf(f,indent,"subroutine %s%s(fname)\n",fname0,fname); 1322 Fprintf(f, indent, "subroutine %s%s(fname)\n", fname0, fname);
1230 FCprintf(f,"c\n"); 1323 FCprintf(f, "c\n");
1231 Fprintf(f,indent,"character*(*) fname\n"); 1324 Fprintf(f, indent, "character*(*) fname\n");
1232 Fprintf(f,indent,"include 'stack.h'\n"); 1325 Fprintf(f, indent, "include 'stack.h'\n");
1233 FCprintf(f,"c\n"); 1326 FCprintf(f, "c\n");
1234 Fprintf(f,indent,"integer iadr, sadr\n"); 1327 Fprintf(f, indent, "integer iadr, sadr\n");
1235 WriteDeclaration(f); 1328 WriteDeclaration(f);
1236 Fprintf(f,indent,"iadr(l)=l+l-1\n"); 1329 Fprintf(f, indent, "iadr(l)=l+l-1\n");
1237 Fprintf(f,indent,"sadr(l)=(l/2)+1\n"); 1330 Fprintf(f, indent, "sadr(l)=(l/2)+1\n");
1238 Fprintf(f,indent,"rhs = max(0,rhs)\n"); 1331 Fprintf(f, indent, "rhs = max(0,rhs)\n");
1239 FCprintf(f,"c\n"); 1332 FCprintf(f, "c\n");
1240} 1333}
1241 1334
1242void WriteFunctionCode(FILE *f) 1335void WriteFunctionCode(FILE * f)
1243{ 1336{
1244 int i; 1337 int i;
1245 IVAR ivar; 1338 IVAR ivar;
1246 icre=1; 1339
1247 if ( pass == 1) 1340 icre = 1;
1341 if (pass == 1)
1248 { 1342 {
1249 printf(" generating code for SCILAB function\"%s\"\n", 1343 printf(" generating code for SCILAB function\"%s\"\n", basfun->name);
1250 basfun->name); 1344 printf(" and FORTRAN subroutine\"%s\"\n", forsub->name);
1251 printf(" and FORTRAN subroutine\"%s\"\n",forsub->name);
1252 } 1345 }
1253 FCprintf(f,"c SCILAB function : %s, fin = %d\n",basfun->name,nFun); 1346 FCprintf(f, "c SCILAB function : %s, fin = %d\n", basfun->name, nFun);
1254 WriteHeader(f,"ints",basfun->name); 1347 WriteHeader(f, "ints", basfun->name);
1255 1348
1256 /* possibly init for string flag */ 1349 /* possibly init for string flag */
1257 for (i = 0; i < forsub->narg; i++) 1350 for (i = 0; i < forsub->narg; i++)
1258 { 1351 {
1259 if (variables[forsub->arg[i]-1]->for_type == CHAR) 1352 if (variables[forsub->arg[i] - 1]->for_type == CHAR)
1260 { 1353 {
1261 Fprintf(f,indent,"lbuf = 1\n"); 1354 Fprintf(f, indent, "lbuf = 1\n");
1262 break; 1355 break;
1263 } 1356 }
1264 } 1357 }
1265 1358
1266 /* init for work space */ 1359 /* init for work space */
1267 1360
1268 AddDeclare(DEC_INT,"topk"); 1361 AddDeclare(DEC_INT, "topk");
1269 AddDeclare(DEC_INT,"rhsk"); 1362 AddDeclare(DEC_INT, "rhsk");
1270 Fprintf(f,indent,"topk = top\n"); 1363 Fprintf(f, indent, "topk = top\n");
1271 Fprintf(f,indent,"rhsk = rhs\n"); 1364 Fprintf(f, indent, "rhsk = rhs\n");
1272 1365
1273 /* rhs argument number checking */ 1366 /* rhs argument number checking */
1274 AddDeclare(DEC_LOGICAL,"checkrhs"); 1367 AddDeclare(DEC_LOGICAL, "checkrhs");
1275 Fprintf(f,indent,"if(.not.checkrhs(fname,%d,%d)) return\n",basfun->nin - maxOpt,basfun->nin); 1368 Fprintf(f, indent, "if(.not.checkrhs(fname,%d,%d)) return\n", basfun->nin - maxOpt, basfun->nin);
1276 1369
1277 /* lhs argument number checking */ 1370 /* lhs argument number checking */
1278 ivar = basfun->out; 1371 ivar = basfun->out;
1279 if ((variables[ivar-1]->length == 0) || (variables[ivar-1]->type == LIST) 1372 if ((variables[ivar - 1]->length == 0) || (variables[ivar - 1]->type == LIST) || (variables[ivar - 1]->type == TLIST))
1280 || (variables[ivar-1]->type == TLIST))
1281 { 1373 {
1282 AddDeclare(DEC_LOGICAL,"checklhs"); 1374 AddDeclare(DEC_LOGICAL, "checklhs");
1283 Fprintf(f,indent,"if(.not.checklhs(fname,1,1)) return\n"); 1375 Fprintf(f, indent, "if(.not.checklhs(fname,1,1)) return\n");
1284 } 1376 }
1285 else 1377 else
1286 { 1378 {
1287 AddDeclare(DEC_LOGICAL,"checklhs"); 1379 AddDeclare(DEC_LOGICAL, "checklhs");
1288 Fprintf(f,indent,"if(.not.checklhs(fname,1,%d)) return\n",variables[ivar-1]->length); 1380 Fprintf(f, indent, "if(.not.checklhs(fname,1,%d)) return\n", variables[ivar - 1]->length);
1289 } 1381 }
1290 1382
1291 /* SCILAB argument checking */ 1383 /* SCILAB argument checking */
1292 for (i = 0; i < basfun->nin; i++) 1384 for (i = 0; i < basfun->nin; i++)
1293 { 1385 {
1294 switch ( variables[i]->type ) 1386 switch (variables[i]->type)
1295 { 1387 {
1296 case LIST : 1388 case LIST:
1297 case TLIST: 1389 case TLIST:
1298 WriteListAnalysis(f,i); 1390 WriteListAnalysis(f, i);
1299 break; 1391 break;
1300 default: 1392 default:
1301 WriteArgCheck(f,i); 1393 WriteArgCheck(f, i);
1302 break; 1394 break;
1303 } 1395 }
1304 } 1396 }
@@ -1317,70 +1409,70 @@ void WriteFunctionCode(FILE *f)
1317 WriteOutput(f); 1409 WriteOutput(f);
1318} 1410}
1319 1411
1320
1321void WriteInfoCode(f) 1412void WriteInfoCode(f)
1322FILE* f; 1413 FILE *f;
1323{ 1414{
1324 int i,iout; 1415 int i, iout;
1325 IVAR ivar; 1416 IVAR ivar;
1326 VARPTR var,vout; 1417 VARPTR var, vout;
1327 1418
1328 iout = GetExistOutVar(); 1419 iout = GetExistOutVar();
1329 vout = variables[iout -1]; 1420 vout = variables[iout - 1];
1330 1421
1331 switch (vout->type) { 1422 switch (vout->type)
1332 case LIST: 1423 {
1333 case TLIST: 1424 case LIST:
1334 /* loop on output variables */ 1425 case TLIST:
1335 printf("list("); 1426 /* loop on output variables */
1336 for (i = 0; i < vout->length; i++) 1427 printf("list(");
1337 { 1428 for (i = 0; i < vout->length; i++)
1338 ivar = vout->el[i]; 1429 {
1339 var = variables[ivar-1]; 1430 ivar = vout->el[i];
1340 printf("%s",var->name); 1431 var = variables[ivar - 1];
1341 if ( i != vout->length -1 ) 1432 printf("%s", var->name);
1342 printf(","); 1433 if (i != vout->length - 1)
1343 else 1434 printf(",");
1344 printf(")"); 1435 else
1345 } 1436 printf(")");
1346 break ; 1437 }
1347 case SEQUENCE: 1438 break;
1348 /* loop on output variables */ 1439 case SEQUENCE:
1349 printf("["); 1440 /* loop on output variables */
1350 for (i = 0; i < vout->length; i++) 1441 printf("[");
1351 { 1442 for (i = 0; i < vout->length; i++)
1352 ivar = vout->el[i]; 1443 {
1353 var = variables[ivar-1]; 1444 ivar = vout->el[i];
1354 printf("%s",var->name); 1445 var = variables[ivar - 1];
1355 if ( i != vout->length -1 ) 1446 printf("%s", var->name);
1356 printf(","); 1447 if (i != vout->length - 1)
1357 else 1448 printf(",");
1358 printf("]"); 1449 else
1359 } 1450 printf("]");
1360 break; 1451 }
1361 case EMPTY: 1452 break;
1362 printf("[]\n"); 1453 case EMPTY:
1363 break; 1454 printf("[]\n");
1364 } 1455 break;
1365 1456 }
1366 printf("=%s(",basfun->name); 1457
1458 printf("=%s(", basfun->name);
1367 for (i = 0; i < basfun->nin; i++) 1459 for (i = 0; i < basfun->nin; i++)
1368 { 1460 {
1369 printf("%s(%s)",variables[i]->name,SGetSciType(variables[i]->type)); 1461 printf("%s(%s)", variables[i]->name, SGetSciType(variables[i]->type));
1370 if ( i != basfun->nin -1 ) 1462 if (i != basfun->nin - 1)
1371 printf(","); 1463 printf(",");
1372 } 1464 }
1373 printf(")\n"); 1465 printf(")\n");
1374 1466
1375} 1467}
1376 1468
1377/* Ckecking and getting infos for datas coming from scilab calling 1469/* Ckecking and getting infos for data coming from scilab calling
1378sequence ( datas on the stack ) 1470sequence ( data on the stack )
1379*/ 1471*/
1380 1472
1381void WriteArgCheck(f,i) 1473void WriteArgCheck(f, i)
1382FILE *f; 1474 FILE *f;